floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Update LAPACK to 3.9.0

This commit is contained in:
Martin Kroeker 2019-12-29 23:31:40 +01:00 committed by GitHub
parent e3b07ca95d
commit ef93c62eb7
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
67 changed files with 2649 additions and 346 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lapack-netlib/SRC/ilaenv.f
View File

@ -132,7 +132,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \date November 2017 *> \date November 2019
* *
*> \ingroup OTHERauxiliary *> \ingroup OTHERauxiliary
* *
@ -162,10 +162,10 @@
* ===================================================================== * =====================================================================
INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
* *
* -- LAPACK auxiliary routine (version 3.8.0) -- * -- LAPACK auxiliary routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2017 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER*( * ) NAME, OPTS CHARACTER*( * ) NAME, OPTS
@ -271,7 +271,16 @@
* *
NB = 1 NB = 1
* *
IF( C2.EQ.'GE' ) THEN IF( SUBNAM(2:6).EQ.'LAORH' ) THEN
*
* This is for *LAORHR_GETRFNP routine
*
IF( SNAME ) THEN
NB = 32
ELSE
NB = 32
END IF
ELSE IF( C2.EQ.'GE' ) THEN
IF( C3.EQ.'TRF' ) THEN IF( C3.EQ.'TRF' ) THEN
IF( SNAME ) THEN IF( SNAME ) THEN
NB = 64 NB = 64

4
lapack-netlib/SRC/ilaenv2stage.f
View File

@ -39,9 +39,9 @@
*> *>
*> ILAENV2STAGE returns an INTEGER *> ILAENV2STAGE returns an INTEGER
*> if ILAENV2STAGE >= 0: ILAENV2STAGE returns the value of the parameter *> if ILAENV2STAGE >= 0: ILAENV2STAGE returns the value of the parameter
* specified by ISPEC *> specified by ISPEC
*> if ILAENV2STAGE < 0: if ILAENV2STAGE = -k, the k-th argument had an *> if ILAENV2STAGE < 0: if ILAENV2STAGE = -k, the k-th argument had an
* illegal value. *> illegal value.
*> *>
*> This version provides a set of parameters which should give good, *> This version provides a set of parameters which should give good,
*> but not optimal, performance on many of the currently available *> but not optimal, performance on many of the currently available

10
lapack-netlib/SRC/iparam2stage.F
View File

@ -35,7 +35,7 @@
*> \verbatim *> \verbatim
*> *>
*> This program sets problem and machine dependent parameters *> This program sets problem and machine dependent parameters
*> useful for xHETRD_2STAGE, xHETRD_H@2HB, xHETRD_HB2ST, *> useful for xHETRD_2STAGE, xHETRD_HE2HB, xHETRD_HB2ST,
*> xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD *> xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD
*> and related subroutines for eigenvalue problems. *> and related subroutines for eigenvalue problems.
*> It is called whenever ILAENV is called with 17 <= ISPEC <= 21. *> It is called whenever ILAENV is called with 17 <= ISPEC <= 21.
@ -53,7 +53,7 @@
*> return. *> return.
*> *>
*> ISPEC=17: the optimal blocksize nb for the reduction to *> ISPEC=17: the optimal blocksize nb for the reduction to
* BAND *> BAND
*> *>
*> ISPEC=18: the optimal blocksize ib for the eigenvectors *> ISPEC=18: the optimal blocksize ib for the eigenvectors
*> singular vectors update routine *> singular vectors update routine
@ -90,14 +90,14 @@
*> \param[in] NBI *> \param[in] NBI
*> \verbatim *> \verbatim
*> NBI is INTEGER which is the used in the reduciton, *> NBI is INTEGER which is the used in the reduciton,
* (e.g., the size of the band), needed to compute workspace *> (e.g., the size of the band), needed to compute workspace
* and LHOUS2. *> and LHOUS2.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] IBI *> \param[in] IBI
*> \verbatim *> \verbatim
*> IBI is INTEGER which represent the IB of the reduciton, *> IBI is INTEGER which represent the IB of the reduciton,
* needed to compute workspace and LHOUS2. *> needed to compute workspace and LHOUS2.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] NXI *> \param[in] NXI

6
lapack-netlib/SRC/iparmq.f
View File

@ -60,7 +60,7 @@
*> invest in an (expensive) multi-shift QR sweep. *> invest in an (expensive) multi-shift QR sweep.
*> If the aggressive early deflation subroutine *> If the aggressive early deflation subroutine
*> finds LD converged eigenvalues from an order *> finds LD converged eigenvalues from an order
*> NW deflation window and LD.GT.(NW*NIBBLE)/100, *> NW deflation window and LD > (NW*NIBBLE)/100,
*> then the next QR sweep is skipped and early *> then the next QR sweep is skipped and early
*> deflation is applied immediately to the *> deflation is applied immediately to the
*> remaining active diagonal block. Setting *> remaining active diagonal block. Setting
@ -184,8 +184,8 @@
*> This depends on ILO, IHI and NS, the *> This depends on ILO, IHI and NS, the
*> number of simultaneous shifts returned *> number of simultaneous shifts returned
*> by IPARMQ(ISPEC=15). The default for *> by IPARMQ(ISPEC=15). The default for
*> (IHI-ILO+1).LE.500 is NS. The default *> (IHI-ILO+1) <= 500 is NS. The default
*> for (IHI-ILO+1).GT.500 is 3*NS/2. *> for (IHI-ILO+1) > 500 is 3*NS/2.
*> *>
*> IPARMQ(ISPEC=14) Nibble crossover point. Default: 14. *> IPARMQ(ISPEC=14) Nibble crossover point. Default: 14.
*> *>

11
lapack-netlib/SRC/meson.build Normal file
View File

@ -0,0 +1,11 @@
ALLAUX = files('ilaenv.f', 'ilaenv2stage.f', 'ieeeck.f', 'lsamen.f', 'xerbla.f', 'xerbla_array.f', 'iparmq.f', 'iparam2stage.F', 'ilaprec.f', 'ilatrans.f', 'ilauplo.f', 'iladiag.f', 'chla_transtype.f', '../INSTALL/ilaver.f', '../INSTALL/lsame.f', '../INSTALL/slamch.f')
SCLAUX = files('sbdsdc.f', 'sbdsqr.f', 'sdisna.f', 'slabad.f', 'slacpy.f', 'sladiv.f', 'slae2.f', 'slaebz.f', 'slaed0.f', 'slaed1.f', 'slaed2.f', 'slaed3.f', 'slaed4.f', 'slaed5.f', 'slaed6.f', 'slaed7.f', 'slaed8.f', 'slaed9.f', 'slaeda.f', 'slaev2.f', 'slagtf.f', 'slagts.f', 'slamrg.f', 'slanst.f', 'slapy2.f', 'slapy3.f', 'slarnv.f', 'slarra.f', 'slarrb.f', 'slarrc.f', 'slarrd.f', 'slarre.f', 'slarrf.f', 'slarrj.f', 'slarrk.f', 'slarrr.f', 'slaneg.f', 'slartg.f', 'slaruv.f', 'slas2.f', 'slascl.f', 'slasd0.f', 'slasd1.f', 'slasd2.f', 'slasd3.f', 'slasd4.f', 'slasd5.f', 'slasd6.f', 'slasd7.f', 'slasd8.f', 'slasda.f', 'slasdq.f', 'slasdt.f', 'slaset.f', 'slasq1.f', 'slasq2.f', 'slasq3.f', 'slasq4.f', 'slasq5.f', 'slasq6.f', 'slasr.f', 'slasrt.f', 'slassq.f', 'slasv2.f', 'spttrf.f', 'sstebz.f', 'sstedc.f', 'ssteqr.f', 'ssterf.f', 'slaisnan.f', 'sisnan.f', 'slartgp.f', 'slartgs.f', '../INSTALL/second_INT_CPU_TIME.f')
DZLAUX = files('dbdsdc.f', 'dbdsqr.f', 'ddisna.f', 'dlabad.f', 'dlacpy.f', 'dladiv.f', 'dlae2.f', 'dlaebz.f', 'dlaed0.f', 'dlaed1.f', 'dlaed2.f', 'dlaed3.f', 'dlaed4.f', 'dlaed5.f', 'dlaed6.f', 'dlaed7.f', 'dlaed8.f', 'dlaed9.f', 'dlaeda.f', 'dlaev2.f', 'dlagtf.f', 'dlagts.f', 'dlamrg.f', 'dlanst.f', 'dlapy2.f', 'dlapy3.f', 'dlarnv.f', 'dlarra.f', 'dlarrb.f', 'dlarrc.f', 'dlarrd.f', 'dlarre.f', 'dlarrf.f', 'dlarrj.f', 'dlarrk.f', 'dlarrr.f', 'dlaneg.f', 'dlartg.f', 'dlaruv.f', 'dlas2.f', 'dlascl.f', 'dlasd0.f', 'dlasd1.f', 'dlasd2.f', 'dlasd3.f', 'dlasd4.f', 'dlasd5.f', 'dlasd6.f', 'dlasd7.f', 'dlasd8.f', 'dlasda.f', 'dlasdq.f', 'dlasdt.f', 'dlaset.f', 'dlasq1.f', 'dlasq2.f', 'dlasq3.f', 'dlasq4.f', 'dlasq5.f', 'dlasq6.f', 'dlasr.f', 'dlasrt.f', 'dlassq.f', 'dlasv2.f', 'dpttrf.f', 'dstebz.f', 'dstedc.f', 'dsteqr.f', 'dsterf.f', 'dlaisnan.f', 'disnan.f', 'dlartgp.f', 'dlartgs.f', '../INSTALL/dlamch.f', '../INSTALL/dsecnd_INT_CPU_TIME.f')
SLASRC = files('sbdsvdx.f', 'spotrf2.f', 'sgetrf2.f', 'sgbbrd.f', 'sgbcon.f', 'sgbequ.f', 'sgbrfs.f', 'sgbsv.f', 'sgbsvx.f', 'sgbtf2.f', 'sgbtrf.f', 'sgbtrs.f', 'sgebak.f', 'sgebal.f', 'sgebd2.f', 'sgebrd.f', 'sgecon.f', 'sgeequ.f', 'sgees.f', 'sgeesx.f', 'sgeev.f', 'sgeevx.f', 'sgehd2.f', 'sgehrd.f', 'sgelq2.f', 'sgelqf.f', 'sgels.f', 'sgelsd.f', 'sgelss.f', 'sgelsy.f', 'sgeql2.f', 'sgeqlf.f', 'sgeqp3.f', 'sgeqr2.f', 'sgeqr2p.f', 'sgeqrf.f', 'sgeqrfp.f', 'sgerfs.f', 'sgerq2.f', 'sgerqf.f', 'sgesc2.f', 'sgesdd.f', 'sgesv.f', 'sgesvd.f', 'sgesvdx.f', 'sgesvx.f', 'sgetc2.f', 'sgetf2.f', 'sgetri.f', 'sggbak.f', 'sggbal.f', 'sgges.f', 'sgges3.f', 'sggesx.f', 'sggev.f', 'sggev3.f', 'sggevx.f', 'sggglm.f', 'sgghrd.f', 'sgghd3.f', 'sgglse.f', 'sggqrf.f', 'sggrqf.f', 'sggsvd3.f', 'sggsvp3.f', 'sgtcon.f', 'sgtrfs.f', 'sgtsv.f', 'sgtsvx.f', 'sgttrf.f', 'sgttrs.f', 'sgtts2.f', 'shgeqz.f', 'shsein.f', 'shseqr.f', 'slabrd.f', 'slacon.f', 'slacn2.f', 'slaein.f', 'slaexc.f', 'slag2.f', 'slags2.f', 'slagtm.f', 'slagv2.f', 'slahqr.f', 'slahr2.f', 'slaic1.f', 'slaln2.f', 'slals0.f', 'slalsa.f', 'slalsd.f', 'slangb.f', 'slange.f', 'slangt.f', 'slanhs.f', 'slansb.f', 'slansp.f', 'slansy.f', 'slantb.f', 'slantp.f', 'slantr.f', 'slanv2.f', 'slapll.f', 'slapmt.f', 'slaqgb.f', 'slaqge.f', 'slaqp2.f', 'slaqps.f', 'slaqsb.f', 'slaqsp.f', 'slaqsy.f', 'slaqr0.f', 'slaqr1.f', 'slaqr2.f', 'slaqr3.f', 'slaqr4.f', 'slaqr5.f', 'slaqtr.f', 'slar1v.f', 'slar2v.f', 'ilaslr.f', 'ilaslc.f', 'slarf.f', 'slarfb.f', 'slarfg.f', 'slarfgp.f', 'slarft.f', 'slarfx.f', 'slarfy.f', 'slargv.f', 'slarrv.f', 'slartv.f', 'slarz.f', 'slarzb.f', 'slarzt.f', 'slaswp.f', 'slasy2.f', 'slasyf.f', 'slasyf_rook.f', 'slasyf_rk.f', 'slatbs.f', 'slatdf.f', 'slatps.f', 'slatrd.f', 'slatrs.f', 'slatrz.f', 'slauu2.f', 'slauum.f', 'sopgtr.f', 'sopmtr.f', 'sorg2l.f', 'sorg2r.f', 'sorgbr.f', 'sorghr.f', 'sorgl2.f', 'sorglq.f', 'sorgql.f', 'sorgqr.f', 'sorgr2.f', 'sorgrq.f', 'sorgtr.f', 'sorm2l.f', 'sorm2r.f', 'sorm22.f', 'sormbr.f', 'sormhr.f', 'sorml2.f', 'sormlq.f', 'sormql.f', 'sormqr.f', 'sormr2.f', 'sormr3.f', 'sormrq.f', 'sormrz.f', 'sormtr.f', 'spbcon.f', 'spbequ.f', 'spbrfs.f', 'spbstf.f', 'spbsv.f', 'spbsvx.f', 'spbtf2.f', 'spbtrf.f', 'spbtrs.f', 'spocon.f', 'spoequ.f', 'sporfs.f', 'sposv.f', 'sposvx.f', 'spotf2.f', 'spotri.f', 'spstrf.f', 'spstf2.f', 'sppcon.f', 'sppequ.f', 'spprfs.f', 'sppsv.f', 'sppsvx.f', 'spptrf.f', 'spptri.f', 'spptrs.f', 'sptcon.f', 'spteqr.f', 'sptrfs.f', 'sptsv.f', 'sptsvx.f', 'spttrs.f', 'sptts2.f', 'srscl.f', 'ssbev.f', 'ssbevd.f', 'ssbevx.f', 'ssbgst.f', 'ssbgv.f', 'ssbgvd.f', 'ssbgvx.f', 'ssbtrd.f', 'sspcon.f', 'sspev.f', 'sspevd.f', 'sspevx.f', 'sspgst.f', 'sspgv.f', 'sspgvd.f', 'sspgvx.f', 'ssprfs.f', 'sspsv.f', 'sspsvx.f', 'ssptrd.f', 'ssptrf.f', 'ssptri.f', 'ssptrs.f', 'sstegr.f', 'sstein.f', 'sstev.f', 'sstevd.f', 'sstevr.f', 'sstevx.f', 'ssycon.f', 'ssyev.f', 'ssyevd.f', 'ssyevr.f', 'ssyevx.f', 'ssygs2.f', 'ssygst.f', 'ssygv.f', 'ssygvd.f', 'ssygvx.f', 'ssyrfs.f', 'ssysv.f', 'ssysvx.f', 'ssytd2.f', 'ssytf2.f', 'ssytrd.f', 'ssytrf.f', 'ssytri.f', 'ssytri2.f', 'ssytri2x.f', 'ssyswapr.f', 'ssytrs.f', 'ssytrs2.f', 'ssyconv.f', 'ssyconvf.f', 'ssyconvf_rook.f', 'ssytf2_rook.f', 'ssytrf_rook.f', 'ssytrs_rook.f', 'ssytri_rook.f', 'ssycon_rook.f', 'ssysv_rook.f', 'ssytf2_rk.f', 'ssytrf_rk.f', 'ssytrs_3.f', 'ssytri_3.f', 'ssytri_3x.f', 'ssycon_3.f', 'ssysv_rk.f', 'slasyf_aa.f', 'ssysv_aa.f', 'ssytrf_aa.f', 'ssytrs_aa.f', 'ssysv_aa_2stage.f', 'ssytrf_aa_2stage.f', 'ssytrs_aa_2stage.f', 'stbcon.f', 'stbrfs.f', 'stbtrs.f', 'stgevc.f', 'stgex2.f', 'stgexc.f', 'stgsen.f', 'stgsja.f', 'stgsna.f', 'stgsy2.f', 'stgsyl.f', 'stpcon.f', 'stprfs.f', 'stptri.f', 'stptrs.f', 'strcon.f', 'strevc.f', 'strevc3.f', 'strexc.f', 'strrfs.f', 'strsen.f', 'strsna.f', 'strsyl.f', 'strti2.f', 'strtri.f', 'strtrs.f', 'stzrzf.f', 'sstemr.f', 'slansf.f', 'spftrf.f', 'spftri.f', 'spftrs.f', 'ssfrk.f', 'stfsm.f', 'stftri.f', 'stfttp.f', 'stfttr.f', 'stpttf.f', 'stpttr.f', 'strttf.f', 'strttp.f', 'sgejsv.f', 'sgesvj.f', 'sgsvj0.f', 'sgsvj1.f', 'sgeequb.f', 'ssyequb.f', 'spoequb.f', 'sgbequb.f', 'sbbcsd.f', 'slapmr.f', 'sorbdb.f', 'sorbdb1.f', 'sorbdb2.f', 'sorbdb3.f', 'sorbdb4.f', 'sorbdb5.f', 'sorbdb6.f', 'sorcsd.f', 'sorcsd2by1.f', 'sgeqrt.f', 'sgeqrt2.f', 'sgeqrt3.f', 'sgemqrt.f', 'stpqrt.f', 'stpqrt2.f', 'stpmqrt.f', 'stprfb.f', 'sgelqt.f', 'sgelqt3.f', 'sgemlqt.f', 'sgetsls.f', 'sgeqr.f', 'slatsqr.f', 'slamtsqr.f', 'sgemqr.f', 'sgelq.f', 'slaswlq.f', 'slamswlq.f', 'sgemlq.f', 'stplqt.f', 'stplqt2.f', 'stpmlqt.f', 'ssytrd_2stage.f', 'ssytrd_sy2sb.f', 'ssytrd_sb2st.F', 'ssb2st_kernels.f', 'ssyevd_2stage.f', 'ssyev_2stage.f', 'ssyevx_2stage.f', 'ssyevr_2stage.f', 'ssbev_2stage.f', 'ssbevx_2stage.f', 'ssbevd_2stage.f', 'ssygv_2stage.f', 'sgesvdq.f', 'scombssq.f')
DSLASRC = files('spotrs.f', 'sgetrs.f', 'spotrf.f', 'sgetrf.f')

2
lapack-netlib/SRC/sbdsvdx.f
View File

@ -165,7 +165,7 @@
*> *>
*> \param[out] Z *> \param[out] Z
*> \verbatim *> \verbatim
*> Z is REAL array, dimension (2*N,K) ) *> Z is REAL array, dimension (2*N,K)
*> If JOBZ = 'V', then if INFO = 0 the first NS columns of Z *> If JOBZ = 'V', then if INFO = 0 the first NS columns of Z
*> contain the singular vectors of the matrix B corresponding to *> contain the singular vectors of the matrix B corresponding to
*> the selected singular values, with U in rows 1 to N and V *> the selected singular values, with U in rows 1 to N and V

92
lapack-netlib/SRC/scombssq.f Normal file
View File

@ -0,0 +1,92 @@
*> \brief \b SCOMBSSQ adds two scaled sum of squares quantities
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*
* Definition:
* ===========
*
* SUBROUTINE SCOMBSSQ( V1, V2 )
*
* .. Array Arguments ..
* REAL V1( 2 ), V2( 2 )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SCOMBSSQ adds two scaled sum of squares quantities, V1 := V1 + V2.
*> That is,
*>
*> V1_scale**2 * V1_sumsq := V1_scale**2 * V1_sumsq
*> + V2_scale**2 * V2_sumsq
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in,out] V1
*> \verbatim
*> V1 is REAL array, dimension (2).
*> The first scaled sum.
*> V1(1) = V1_scale, V1(2) = V1_sumsq.
*> \endverbatim
*>
*> \param[in] V2
*> \verbatim
*> V2 is REAL array, dimension (2).
*> The second scaled sum.
*> V2(1) = V2_scale, V2(2) = V2_sumsq.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2018
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE SCOMBSSQ( V1, V2 )
*
* -- LAPACK auxiliary routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2018
*
* .. Array Arguments ..
REAL V1( 2 ), V2( 2 )
* ..
*
* =====================================================================
*
* .. Parameters ..
REAL ZERO
PARAMETER ( ZERO = 0.0D+0 )
* ..
* .. Executable Statements ..
*
IF( V1( 1 ).GE.V2( 1 ) ) THEN
IF( V1( 1 ).NE.ZERO ) THEN
V1( 2 ) = V1( 2 ) + ( V2( 1 ) / V1( 1 ) )**2 * V2( 2 )
END IF
ELSE
V1( 2 ) = V2( 2 ) + ( V1( 1 ) / V2( 1 ) )**2 * V1( 2 )
V1( 1 ) = V2( 1 )
END IF
RETURN
*
* End of SCOMBSSQ
*
END

10
lapack-netlib/SRC/sgbrfsx.f
View File

@ -308,7 +308,7 @@
*> information as described below. There currently are up to three *> information as described below. There currently are up to three
*> pieces of information returned for each right-hand side. If *> pieces of information returned for each right-hand side. If
*> componentwise accuracy is not requested (PARAMS(3) = 0.0), then *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most *> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most
*> the first (:,N_ERR_BNDS) entries are returned. *> the first (:,N_ERR_BNDS) entries are returned.
*> *>
*> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith
@ -344,14 +344,14 @@
*> \param[in] NPARAMS *> \param[in] NPARAMS
*> \verbatim *> \verbatim
*> NPARAMS is INTEGER *> NPARAMS is INTEGER
*> Specifies the number of parameters set in PARAMS. If .LE. 0, the *> Specifies the number of parameters set in PARAMS. If <= 0, the
*> PARAMS array is never referenced and default values are used. *> PARAMS array is never referenced and default values are used.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in,out] PARAMS *> \param[in,out] PARAMS
*> \verbatim *> \verbatim
*> PARAMS is REAL array, dimension NPARAMS *> PARAMS is REAL array, dimension NPARAMS
*> Specifies algorithm parameters. If an entry is .LT. 0.0, then *> Specifies algorithm parameters. If an entry is < 0.0, then
*> that entry will be filled with default value used for that *> that entry will be filled with default value used for that
*> parameter. Only positions up to NPARAMS are accessed; defaults *> parameter. Only positions up to NPARAMS are accessed; defaults
*> are used for higher-numbered parameters. *> are used for higher-numbered parameters.
@ -359,9 +359,9 @@
*> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative
*> refinement or not. *> refinement or not.
*> Default: 1.0 *> Default: 1.0
*> = 0.0 : No refinement is performed, and no error bounds are *> = 0.0: No refinement is performed, and no error bounds are
*> computed. *> computed.
*> = 1.0 : Use the double-precision refinement algorithm, *> = 1.0: Use the double-precision refinement algorithm,
*> possibly with doubled-single computations if the *> possibly with doubled-single computations if the
*> compilation environment does not support DOUBLE *> compilation environment does not support DOUBLE
*> PRECISION. *> PRECISION.

10
lapack-netlib/SRC/sgbsvxx.f
View File

@ -431,7 +431,7 @@
*> information as described below. There currently are up to three *> information as described below. There currently are up to three
*> pieces of information returned for each right-hand side. If *> pieces of information returned for each right-hand side. If
*> componentwise accuracy is not requested (PARAMS(3) = 0.0), then *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most *> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most
*> the first (:,N_ERR_BNDS) entries are returned. *> the first (:,N_ERR_BNDS) entries are returned.
*> *>
*> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith
@ -467,14 +467,14 @@
*> \param[in] NPARAMS *> \param[in] NPARAMS
*> \verbatim *> \verbatim
*> NPARAMS is INTEGER *> NPARAMS is INTEGER
*> Specifies the number of parameters set in PARAMS. If .LE. 0, the *> Specifies the number of parameters set in PARAMS. If <= 0, the
*> PARAMS array is never referenced and default values are used. *> PARAMS array is never referenced and default values are used.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in,out] PARAMS *> \param[in,out] PARAMS
*> \verbatim *> \verbatim
*> PARAMS is REAL array, dimension NPARAMS *> PARAMS is REAL array, dimension NPARAMS
*> Specifies algorithm parameters. If an entry is .LT. 0.0, then *> Specifies algorithm parameters. If an entry is < 0.0, then
*> that entry will be filled with default value used for that *> that entry will be filled with default value used for that
*> parameter. Only positions up to NPARAMS are accessed; defaults *> parameter. Only positions up to NPARAMS are accessed; defaults
*> are used for higher-numbered parameters. *> are used for higher-numbered parameters.
@ -482,9 +482,9 @@
*> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative
*> refinement or not. *> refinement or not.
*> Default: 1.0 *> Default: 1.0
*> = 0.0 : No refinement is performed, and no error bounds are *> = 0.0: No refinement is performed, and no error bounds are
*> computed. *> computed.
*> = 1.0 : Use the double-precision refinement algorithm, *> = 1.0: Use the double-precision refinement algorithm,
*> possibly with doubled-single computations if the *> possibly with doubled-single computations if the
*> compilation environment does not support DOUBLE *> compilation environment does not support DOUBLE
*> PRECISION. *> PRECISION.

8
lapack-netlib/SRC/sgebak.f
View File

@ -47,10 +47,10 @@
*> \verbatim *> \verbatim
*> JOB is CHARACTER*1 *> JOB is CHARACTER*1
*> Specifies the type of backward transformation required: *> Specifies the type of backward transformation required:
*> = 'N', do nothing, return immediately; *> = 'N': do nothing, return immediately;
*> = 'P', do backward transformation for permutation only; *> = 'P': do backward transformation for permutation only;
*> = 'S', do backward transformation for scaling only; *> = 'S': do backward transformation for scaling only;
*> = 'B', do backward transformations for both permutation and *> = 'B': do backward transformations for both permutation and
*> scaling. *> scaling.
*> JOB must be the same as the argument JOB supplied to SGEBAL. *> JOB must be the same as the argument JOB supplied to SGEBAL.
*> \endverbatim *> \endverbatim

2
lapack-netlib/SRC/sgeesx.f
View File

@ -583,7 +583,9 @@
IF( N.GT.I+1 ) IF( N.GT.I+1 )
$ CALL SSWAP( N-I-1, A( I, I+2 ), LDA, $ CALL SSWAP( N-I-1, A( I, I+2 ), LDA,
$ A( I+1, I+2 ), LDA ) $ A( I+1, I+2 ), LDA )
IF( WANTVS ) THEN
CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
END IF
A( I, I+1 ) = A( I+1, I ) A( I, I+1 ) = A( I+1, I )
A( I+1, I ) = ZERO A( I+1, I ) = ZERO
END IF END IF

52
lapack-netlib/SRC/sgejsv.f
View File

@ -82,7 +82,7 @@
*> desirable, then this option is advisable. The input matrix A *> desirable, then this option is advisable. The input matrix A
*> is preprocessed with QR factorization with FULL (row and *> is preprocessed with QR factorization with FULL (row and
*> column) pivoting. *> column) pivoting.
*> = 'G' Computation as with 'F' with an additional estimate of the *> = 'G': Computation as with 'F' with an additional estimate of the
*> condition number of B, where A=D*B. If A has heavily weighted *> condition number of B, where A=D*B. If A has heavily weighted
*> rows, then using this condition number gives too pessimistic *> rows, then using this condition number gives too pessimistic
*> error bound. *> error bound.
@ -133,7 +133,7 @@
*> specified range. If A .NE. 0 is scaled so that the largest singular *> 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 *> 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 *> 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, *> SQRT(SFMIN) (for JOBR = 'R'), or less than SMALL=SFMIN/EPSLN,
*> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E'). *> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E').
*> = 'N': Do not kill small columns of c*A. This option assumes that *> = 'N': Do not kill small columns of c*A. This option assumes that
*> BLAS and QR factorizations and triangular solvers are *> BLAS and QR factorizations and triangular solvers are
@ -230,7 +230,7 @@
*> If JOBU = 'F', then U contains on exit the M-by-M matrix of *> If JOBU = 'F', then U contains on exit the M-by-M matrix of
*> the left singular vectors, including an ONB *> the left singular vectors, including an ONB
*> of the orthogonal complement of the Range(A). *> of the orthogonal complement of the Range(A).
*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N), *> If JOBU = 'W' .AND. (JOBV = 'V' .AND. JOBT = 'T' .AND. M = N),
*> then U is used as workspace if the procedure *> then U is used as workspace if the procedure
*> replaces A with A^t. In that case, [V] is computed *> replaces A with A^t. In that case, [V] is computed
*> in U as left singular vectors of A^t and then *> in U as left singular vectors of A^t and then
@ -252,7 +252,7 @@
*> V is REAL array, dimension ( LDV, N ) *> V is REAL array, dimension ( LDV, N )
*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of *> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of
*> the right singular vectors; *> the right singular vectors;
*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N), *> If JOBV = 'W', AND (JOBU = 'U' AND JOBT = 'T' AND M = N),
*> then V is used as workspace if the pprocedure *> then V is used as workspace if the pprocedure
*> replaces A with A^t. In that case, [U] is computed *> replaces A with A^t. In that case, [U] is computed
*> in V as right singular vectors of A^t and then *> in V as right singular vectors of A^t and then
@ -278,7 +278,7 @@
*> of A. (See the description of SVA().) *> of A. (See the description of SVA().)
*> WORK(2) = See the description of WORK(1). *> WORK(2) = See the description of WORK(1).
*> WORK(3) = SCONDA is an estimate for the condition number of *> WORK(3) = SCONDA is an estimate for the condition number of
*> column equilibrated A. (If JOBA .EQ. 'E' or 'G') *> column equilibrated A. (If JOBA = 'E' or 'G')
*> SCONDA is an estimate of SQRT(||(R^t * R)^(-1)||_1). *> SCONDA is an estimate of SQRT(||(R^t * R)^(-1)||_1).
*> It is computed using SPOCON. It holds *> It is computed using SPOCON. It holds
*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA *> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
@ -297,7 +297,7 @@
*> triangular factor in the first QR factorization. *> triangular factor in the first QR factorization.
*> WORK(5) = an estimate of the scaled condition number of the *> WORK(5) = an estimate of the scaled condition number of the
*> triangular factor in the second QR factorization. *> triangular factor in the second QR factorization.
*> The following two parameters are computed if JOBT .EQ. 'T'. *> The following two parameters are computed if JOBT = 'T'.
*> They are provided for a developer/implementer who is familiar *> They are provided for a developer/implementer who is familiar
*> with the details of the method. *> with the details of the method.
*> *>
@ -313,8 +313,8 @@
*> Length of WORK to confirm proper allocation of work space. *> Length of WORK to confirm proper allocation of work space.
*> LWORK depends on the job: *> LWORK depends on the job:
*> *>
*> If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and *> If only SIGMA is needed ( JOBU = 'N', JOBV = 'N' ) and
*> -> .. no scaled condition estimate required (JOBE.EQ.'N'): *> -> .. no scaled condition estimate required (JOBE = 'N'):
*> LWORK >= max(2*M+N,4*N+1,7). This is the minimal requirement. *> LWORK >= max(2*M+N,4*N+1,7). This is the minimal requirement.
*> ->> For optimal performance (blocked code) the optimal value *> ->> 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 *> is LWORK >= max(2*M+N,3*N+(N+1)*NB,7). Here NB is the optimal
@ -330,7 +330,7 @@
*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF), *> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF),
*> N+N*N+LWORK(DPOCON),7). *> N+N*N+LWORK(DPOCON),7).
*> *>
*> If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'), *> If SIGMA and the right singular vectors are needed (JOBV = 'V'),
*> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). *> -> 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), *> -> For optimal performance, LWORK >= max(2*M+N,3*N+(N+1)*NB,7),
*> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQ, *> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQ,
@ -341,19 +341,19 @@
*> If SIGMA and the left singular vectors are needed *> If SIGMA and the left singular vectors are needed
*> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). *> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7).
*> -> For optimal performance: *> -> For optimal performance:
*> if JOBU.EQ.'U' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,7), *> if JOBU = '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), *> if JOBU = '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. *> where NB is the optimal block size for DGEQP3, DGEQRF, DORMQR.
*> In general, the optimal length LWORK is computed as *> In general, the optimal length LWORK is computed as
*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DPOCON), *> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DPOCON),
*> 2*N+LWORK(DGEQRF), N+LWORK(DORMQR)). *> 2*N+LWORK(DGEQRF), N+LWORK(DORMQR)).
*> Here LWORK(DORMQR) equals N*NB (for JOBU.EQ.'U') or *> Here LWORK(DORMQR) equals N*NB (for JOBU = 'U') or
*> M*NB (for JOBU.EQ.'F'). *> M*NB (for JOBU = 'F').
*> *>
*> If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and *> If the full SVD is needed: (JOBU = 'U' or JOBU = 'F') and
*> -> if JOBV.EQ.'V' *> -> if JOBV = 'V'
*> the minimal requirement is LWORK >= max(2*M+N,6*N+2*N*N). *> the minimal requirement is LWORK >= max(2*M+N,6*N+2*N*N).
*> -> if JOBV.EQ.'J' the minimal requirement is *> -> if JOBV = 'J' the minimal requirement is
*> LWORK >= max(2*M+N, 4*N+N*N,2*N+N*N+6). *> LWORK >= max(2*M+N, 4*N+N*N,2*N+N*N+6).
*> -> For optimal performance, LWORK should be additionally *> -> For optimal performance, LWORK should be additionally
*> larger than N+M*NB, where NB is the optimal block size *> larger than N+M*NB, where NB is the optimal block size
@ -369,7 +369,7 @@
*> of JOBA and JOBR. *> of JOBA and JOBR.
*> IWORK(2) = the number of the computed nonzero singular values *> IWORK(2) = the number of the computed nonzero singular values
*> IWORK(3) = if nonzero, a warning message: *> IWORK(3) = if nonzero, a warning message:
*> If IWORK(3).EQ.1 then some of the column norms of A *> If IWORK(3) = 1 then some of the column norms of A
*> were denormalized floats. The requested high accuracy *> were denormalized floats. The requested high accuracy
*> is not warranted by the data. *> is not warranted by the data.
*> \endverbatim *> \endverbatim
@ -377,9 +377,9 @@
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> < 0 : if INFO = -i, then the i-th argument had an illegal value. *> < 0: if INFO = -i, then the i-th argument had an illegal value.
*> = 0 : successful exit; *> = 0: successful exit;
*> > 0 : SGEJSV did not converge in the maximal allowed number *> > 0: SGEJSV did not converge in the maximal allowed number
*> of sweeps. The computed values may be inaccurate. *> of sweeps. The computed values may be inaccurate.
*> \endverbatim *> \endverbatim
* *
@ -953,7 +953,7 @@
IF ( L2ABER ) THEN IF ( L2ABER ) THEN
* Standard absolute error bound suffices. All sigma_i with * Standard absolute error bound suffices. All sigma_i with
* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an * sigma_i < N*EPSLN*||A|| are flushed to zero. This is an
* agressive enforcement of lower numerical rank by introducing a * aggressive enforcement of lower numerical rank by introducing a
* backward error of the order of N*EPSLN*||A||. * backward error of the order of N*EPSLN*||A||.
TEMP1 = SQRT(FLOAT(N))*EPSLN TEMP1 = SQRT(FLOAT(N))*EPSLN
DO 3001 p = 2, N DO 3001 p = 2, N
@ -965,7 +965,7 @@
3001 CONTINUE 3001 CONTINUE
3002 CONTINUE 3002 CONTINUE
ELSE IF ( L2RANK ) THEN ELSE IF ( L2RANK ) THEN
* .. similarly as above, only slightly more gentle (less agressive). * .. similarly as above, only slightly more gentle (less aggressive).
* Sudden drop on the diagonal of R1 is used as the criterion for * Sudden drop on the diagonal of R1 is used as the criterion for
* close-to-rank-deficient. * close-to-rank-deficient.
TEMP1 = SQRT(SFMIN) TEMP1 = SQRT(SFMIN)
@ -1294,7 +1294,7 @@
CALL SPOCON('Lower',NR,WORK(2*N+1),NR,ONE,TEMP1, CALL SPOCON('Lower',NR,WORK(2*N+1),NR,ONE,TEMP1,
$ WORK(2*N+NR*NR+1),IWORK(M+2*N+1),IERR) $ WORK(2*N+NR*NR+1),IWORK(M+2*N+1),IERR)
CONDR1 = ONE / SQRT(TEMP1) CONDR1 = ONE / SQRT(TEMP1)
* .. here need a second oppinion on the condition number * .. here need a second opinion on the condition number
* .. then assume worst case scenario * .. then assume worst case scenario
* R1 is OK for inverse <=> CONDR1 .LT. FLOAT(N) * R1 is OK for inverse <=> CONDR1 .LT. FLOAT(N)
* more conservative <=> CONDR1 .LT. SQRT(FLOAT(N)) * more conservative <=> CONDR1 .LT. SQRT(FLOAT(N))
@ -1335,7 +1335,7 @@
ELSE ELSE
* *
* .. ill-conditioned case: second QRF with pivoting * .. ill-conditioned case: second QRF with pivoting
* Note that windowed pivoting would be equaly good * Note that windowed pivoting would be equally good
* numerically, and more run-time efficient. So, in * numerically, and more run-time efficient. So, in
* an optimal implementation, the next call to SGEQP3 * an optimal implementation, the next call to SGEQP3
* should be replaced with eg. CALL SGEQPX (ACM TOMS #782) * should be replaced with eg. CALL SGEQPX (ACM TOMS #782)
@ -1388,7 +1388,7 @@
* *
IF ( CONDR2 .GE. COND_OK ) THEN IF ( CONDR2 .GE. COND_OK ) THEN
* .. save the Householder vectors used for Q3 * .. save the Householder vectors used for Q3
* (this overwrittes the copy of R2, as it will not be * (this overwrites the copy of R2, as it will not be
* needed in this branch, but it does not overwritte the * needed in this branch, but it does not overwritte the
* Huseholder vectors of Q2.). * Huseholder vectors of Q2.).
CALL SLACPY( 'U', NR, NR, V, LDV, WORK(2*N+1), N ) CALL SLACPY( 'U', NR, NR, V, LDV, WORK(2*N+1), N )
@ -1638,7 +1638,7 @@
* *
* This branch deploys a preconditioned Jacobi SVD with explicitly * This branch deploys a preconditioned Jacobi SVD with explicitly
* accumulated rotations. It is included as optional, mainly for * accumulated rotations. It is included as optional, mainly for
* experimental purposes. It does perfom well, and can also be used. * experimental purposes. It does perform well, and can also be used.
* In this implementation, this branch will be automatically activated * In this implementation, this branch will be automatically activated
* if the condition number sigma_max(A) / sigma_min(A) is predicted * if the condition number sigma_max(A) / sigma_min(A) is predicted
* to be greater than the overflow threshold. This is because the * to be greater than the overflow threshold. This is because the

19
lapack-netlib/SRC/sgelq.f
View File

@ -1,3 +1,4 @@
*> \brief \b SGELQ
* *
* Definition: * Definition:
* =========== * ===========
@ -17,7 +18,17 @@
* ============= * =============
*> *>
*> \verbatim *> \verbatim
*> SGELQ computes a LQ factorization of an M-by-N matrix A. *>
*> SGELQ computes an LQ factorization of a real M-by-N matrix A:
*>
*> A = ( L 0 ) * Q
*>
*> where:
*>
*> Q is a N-by-N orthogonal matrix;
*> L is an lower-triangular M-by-M matrix;
*> 0 is a M-by-(N-M) zero matrix, if M < N.
*>
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -138,7 +149,7 @@
*> \verbatim *> \verbatim
*> *>
*> These details are particular for this LAPACK implementation. Users should not *> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are unlikely not *> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants *> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface. *> to try to understand the code. They are not part of the interface.
*> *>
@ -159,10 +170,10 @@
SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
$ INFO ) $ INFO )
* *
* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
* December 2016 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, TSIZE, LWORK INTEGER INFO, LDA, M, N, TSIZE, LWORK

18
lapack-netlib/SRC/sgelq2.f
View File

@ -33,8 +33,16 @@
*> *>
*> \verbatim *> \verbatim
*> *>
*> SGELQ2 computes an LQ factorization of a real m by n matrix A: *> SGELQ2 computes an LQ factorization of a real m-by-n matrix A:
*> A = L * Q. *>
*> A = ( L 0 ) * Q
*>
*> where:
*>
*> Q is a n-by-n orthogonal matrix;
*> L is an lower-triangular m-by-m matrix;
*> 0 is a m-by-(n-m) zero matrix, if m < n.
*>
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -96,7 +104,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \date December 2016 *> \date November 2019
* *
*> \ingroup realGEcomputational *> \ingroup realGEcomputational
* *
@ -121,10 +129,10 @@
* ===================================================================== * =====================================================================
SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO ) SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO )
* *
* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N INTEGER INFO, LDA, M, N

16
lapack-netlib/SRC/sgelqf.f
View File

@ -34,7 +34,15 @@
*> \verbatim *> \verbatim
*> *>
*> SGELQF computes an LQ factorization of a real M-by-N matrix A: *> SGELQF computes an LQ factorization of a real M-by-N matrix A:
*> A = L * Q. *>
*> A = ( L 0 ) * Q
*>
*> where:
*>
*> Q is a N-by-N orthogonal matrix;
*> L is an lower-triangular M-by-M matrix;
*> 0 is a M-by-(N-M) zero matrix, if M < N.
*>
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -110,7 +118,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \date December 2016 *> \date November 2019
* *
*> \ingroup realGEcomputational *> \ingroup realGEcomputational
* *
@ -135,10 +143,10 @@
* ===================================================================== * =====================================================================
SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
* *
* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N INTEGER INFO, LDA, LWORK, M, N

2
lapack-netlib/SRC/sgelqt.f
View File

@ -1,3 +1,5 @@
*> \brief \b SGELQT
*
* Definition: * Definition:
* =========== * ===========
* *

2
lapack-netlib/SRC/sgelqt3.f
View File

@ -1,3 +1,5 @@
*> \brief \b SGELQT3
*
* Definition: * Definition:
* =========== * ===========
* *

3
lapack-netlib/SRC/sgemlq.f
View File

@ -1,3 +1,4 @@
*> \brief \b SGEMLQ
* *
* Definition: * Definition:
* =========== * ===========
@ -143,7 +144,7 @@
*> \verbatim *> \verbatim
*> *>
*> These details are particular for this LAPACK implementation. Users should not *> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are unlikely not *> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants *> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface. *> to try to understand the code. They are not part of the interface.
*> *>

2
lapack-netlib/SRC/sgemlqt.f
View File

@ -1,3 +1,5 @@
*> \brief \b SGEMLQT
*
* Definition: * Definition:
* =========== * ===========
* *

3
lapack-netlib/SRC/sgemqr.f
View File

@ -1,3 +1,4 @@
*> \brief \b SGEMQR
* *
* Definition: * Definition:
* =========== * ===========
@ -144,7 +145,7 @@
*> \verbatim *> \verbatim
*> *>
*> These details are particular for this LAPACK implementation. Users should not *> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are unlikely not *> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants *> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface. *> to try to understand the code. They are not part of the interface.
*> *>

20
lapack-netlib/SRC/sgeqr.f
View File

@ -1,3 +1,4 @@
*> \brief \b SGEQR
* *
* Definition: * Definition:
* =========== * ===========
@ -17,7 +18,18 @@
* ============= * =============
*> *>
*> \verbatim *> \verbatim
*> SGEQR computes a QR factorization of an M-by-N matrix A. *>
*> SGEQR computes a QR factorization of a real M-by-N matrix A:
*>
*> A = Q * ( R ),
*> ( 0 )
*>
*> where:
*>
*> Q is a M-by-M orthogonal matrix;
*> R is an upper-triangular N-by-N matrix;
*> 0 is a (M-N)-by-N zero matrix, if M > N.
*>
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -138,7 +150,7 @@
*> \verbatim *> \verbatim
*> *>
*> These details are particular for this LAPACK implementation. Users should not *> These details are particular for this LAPACK implementation. Users should not
*> take them for granted. These details may change in the future, and are unlikely not *> take them for granted. These details may change in the future, and are not likely
*> true for another LAPACK implementation. These details are relevant if one wants *> true for another LAPACK implementation. These details are relevant if one wants
*> to try to understand the code. They are not part of the interface. *> to try to understand the code. They are not part of the interface.
*> *>
@ -160,10 +172,10 @@
SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
$ INFO ) $ INFO )
* *
* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
* December 2016 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, TSIZE, LWORK INTEGER INFO, LDA, M, N, TSIZE, LWORK

19
lapack-netlib/SRC/sgeqr2.f
View File

@ -33,8 +33,17 @@
*> *>
*> \verbatim *> \verbatim
*> *>
*> SGEQR2 computes a QR factorization of a real m by n matrix A: *> SGEQR2 computes a QR factorization of a real m-by-n matrix A:
*> A = Q * R. *>
*> A = Q * ( R ),
*> ( 0 )
*>
*> where:
*>
*> Q is a m-by-m orthogonal matrix;
*> R is an upper-triangular n-by-n matrix;
*> 0 is a (m-n)-by-n zero matrix, if m > n.
*>
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -96,7 +105,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \date December 2016 *> \date November 2019
* *
*> \ingroup realGEcomputational *> \ingroup realGEcomputational
* *
@ -121,10 +130,10 @@
* ===================================================================== * =====================================================================
SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO ) SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO )
* *
* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N INTEGER INFO, LDA, M, N

20
lapack-netlib/SRC/sgeqr2p.f
View File

@ -33,8 +33,18 @@
*> *>
*> \verbatim *> \verbatim
*> *>
*> SGEQR2P computes a QR factorization of a real m by n matrix A: *> SGEQR2P computes a QR factorization of a real m-by-n matrix A:
*> A = Q * R. The diagonal entries of R are nonnegative. *>
*> A = Q * ( R ),
*> ( 0 )
*>
*> where:
*>
*> Q is a m-by-m orthogonal matrix;
*> R is an upper-triangular n-by-n matrix with nonnegative diagonal
*> entries;
*> 0 is a (m-n)-by-n zero matrix, if m > n.
*>
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -97,7 +107,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \date December 2016 *> \date November 2019
* *
*> \ingroup realGEcomputational *> \ingroup realGEcomputational
* *
@ -124,10 +134,10 @@
* ===================================================================== * =====================================================================
SUBROUTINE SGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) SUBROUTINE SGEQR2P( M, N, A, LDA, TAU, WORK, INFO )
* *
* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, M, N INTEGER INFO, LDA, M, N

17
lapack-netlib/SRC/sgeqrf.f
View File

@ -34,7 +34,16 @@
*> \verbatim *> \verbatim
*> *>
*> SGEQRF computes a QR factorization of a real M-by-N matrix A: *> SGEQRF computes a QR factorization of a real M-by-N matrix A:
*> A = Q * R. *>
*> A = Q * ( R ),
*> ( 0 )
*>
*> where:
*>
*> Q is a M-by-M orthogonal matrix;
*> R is an upper-triangular N-by-N matrix;
*> 0 is a (M-N)-by-N zero matrix, if M > N.
*>
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -111,7 +120,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \date December 2016 *> \date November 2019
* *
*> \ingroup realGEcomputational *> \ingroup realGEcomputational
* *
@ -136,10 +145,10 @@
* ===================================================================== * =====================================================================
SUBROUTINE SGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) SUBROUTINE SGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
* *
* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N INTEGER INFO, LDA, LWORK, M, N

20
lapack-netlib/SRC/sgeqrfp.f
View File

@ -33,8 +33,18 @@
*> *>
*> \verbatim *> \verbatim
*> *>
*> SGEQRFP computes a QR factorization of a real M-by-N matrix A: *> SGEQR2P computes a QR factorization of a real M-by-N matrix A:
*> A = Q * R. The diagonal entries of R are nonnegative. *>
*> A = Q * ( R ),
*> ( 0 )
*>
*> where:
*>
*> Q is a M-by-M orthogonal matrix;
*> R is an upper-triangular N-by-N matrix with nonnegative diagonal
*> entries;
*> 0 is a (M-N)-by-N zero matrix, if M > N.
*>
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -112,7 +122,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \date December 2016 *> \date November 2019
* *
*> \ingroup realGEcomputational *> \ingroup realGEcomputational
* *
@ -139,10 +149,10 @@
* ===================================================================== * =====================================================================
SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
* *
* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * November 2019
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N INTEGER INFO, LDA, LWORK, M, N

10
lapack-netlib/SRC/sgerfsx.f
View File

@ -283,7 +283,7 @@
*> information as described below. There currently are up to three *> information as described below. There currently are up to three
*> pieces of information returned for each right-hand side. If *> pieces of information returned for each right-hand side. If
*> componentwise accuracy is not requested (PARAMS(3) = 0.0), then *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most *> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most
*> the first (:,N_ERR_BNDS) entries are returned. *> the first (:,N_ERR_BNDS) entries are returned.
*> *>
*> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith
@ -319,14 +319,14 @@
*> \param[in] NPARAMS *> \param[in] NPARAMS
*> \verbatim *> \verbatim
*> NPARAMS is INTEGER *> NPARAMS is INTEGER
*> Specifies the number of parameters set in PARAMS. If .LE. 0, the *> Specifies the number of parameters set in PARAMS. If <= 0, the
*> PARAMS array is never referenced and default values are used. *> PARAMS array is never referenced and default values are used.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in,out] PARAMS *> \param[in,out] PARAMS
*> \verbatim *> \verbatim
*> PARAMS is REAL array, dimension NPARAMS *> PARAMS is REAL array, dimension NPARAMS
*> Specifies algorithm parameters. If an entry is .LT. 0.0, then *> Specifies algorithm parameters. If an entry is < 0.0, then
*> that entry will be filled with default value used for that *> that entry will be filled with default value used for that
*> parameter. Only positions up to NPARAMS are accessed; defaults *> parameter. Only positions up to NPARAMS are accessed; defaults
*> are used for higher-numbered parameters. *> are used for higher-numbered parameters.
@ -334,9 +334,9 @@
*> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative
*> refinement or not. *> refinement or not.
*> Default: 1.0 *> Default: 1.0
*> = 0.0 : No refinement is performed, and no error bounds are *> = 0.0: No refinement is performed, and no error bounds are
*> computed. *> computed.
*> = 1.0 : Use the double-precision refinement algorithm, *> = 1.0: Use the double-precision refinement algorithm,
*> possibly with doubled-single computations if the *> possibly with doubled-single computations if the
*> compilation environment does not support DOUBLE *> compilation environment does not support DOUBLE
*> PRECISION. *> PRECISION.

4
lapack-netlib/SRC/sgesc2.f
View File

@ -90,7 +90,7 @@
*> \verbatim *> \verbatim
*> SCALE is REAL *> SCALE is REAL
*> On exit, SCALE contains the scale factor. SCALE is chosen *> On exit, SCALE contains the scale factor. SCALE is chosen
*> 0 <= SCALE <= 1 to prevent owerflow in the solution. *> 0 <= SCALE <= 1 to prevent overflow in the solution.
*> \endverbatim *> \endverbatim
* *
* Authors: * Authors:
@ -151,7 +151,7 @@
* .. * ..
* .. Executable Statements .. * .. Executable Statements ..
* *
* Set constant to control owerflow * Set constant to control overflow
* *
EPS = SLAMCH( 'P' ) EPS = SLAMCH( 'P' )
SMLNUM = SLAMCH( 'S' ) / EPS SMLNUM = SLAMCH( 'S' ) / EPS

4
lapack-netlib/SRC/sgesdd.f
View File

@ -322,7 +322,7 @@
* *
IF( WNTQN ) THEN IF( WNTQN ) THEN
* sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) * sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6)
* keep 7*N for backwards compatability. * keep 7*N for backwards compatibility.
BDSPAC = 7*N BDSPAC = 7*N
ELSE ELSE
BDSPAC = 3*N*N + 4*N BDSPAC = 3*N*N + 4*N
@ -448,7 +448,7 @@
* *
IF( WNTQN ) THEN IF( WNTQN ) THEN
* sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) * sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6)
* keep 7*N for backwards compatability. * keep 7*N for backwards compatibility.
BDSPAC = 7*M BDSPAC = 7*M
ELSE ELSE
BDSPAC = 3*M*M + 4*M BDSPAC = 3*M*M + 4*M

1388
lapack-netlib/SRC/sgesvdq.f Normal file
View File

File diff suppressed because it is too large Load Diff

44
lapack-netlib/SRC/sgesvj.f
View File

@ -90,13 +90,13 @@
*> JOBV is CHARACTER*1 *> JOBV is CHARACTER*1
*> Specifies whether to compute the right singular vectors, that *> Specifies whether to compute the right singular vectors, that
*> is, the matrix V: *> is, the matrix V:
*> = 'V' : the matrix V is computed and returned in the array V *> = 'V': the matrix V is computed and returned in the array V
*> = 'A' : the Jacobi rotations are applied to the MV-by-N *> = 'A': the Jacobi rotations are applied to the MV-by-N
*> array V. In other words, the right singular vector *> array V. In other words, the right singular vector
*> matrix V is not computed explicitly; instead it is *> matrix V is not computed explicitly; instead it is
*> applied to an MV-by-N matrix initially stored in the *> applied to an MV-by-N matrix initially stored in the
*> first MV rows of V. *> first MV rows of V.
*> = 'N' : the matrix V is not computed and the array V is not *> = 'N': the matrix V is not computed and the array V is not
*> referenced *> referenced
*> \endverbatim *> \endverbatim
*> *>
@ -118,8 +118,8 @@
*> A is REAL array, dimension (LDA,N) *> A is REAL array, dimension (LDA,N)
*> On entry, the M-by-N matrix A. *> On entry, the M-by-N matrix A.
*> On exit, *> On exit,
*> If JOBU .EQ. 'U' .OR. JOBU .EQ. 'C': *> If JOBU = 'U' .OR. JOBU = 'C':
*> If INFO .EQ. 0 : *> If INFO = 0:
*> RANKA orthonormal columns of U are returned in the *> RANKA orthonormal columns of U are returned in the
*> leading RANKA columns of the array A. Here RANKA <= N *> leading RANKA columns of the array A. Here RANKA <= N
*> is the number of computed singular values of A that are *> is the number of computed singular values of A that are
@ -129,9 +129,9 @@
*> in the array WORK as RANKA=NINT(WORK(2)). Also see the *> in the array WORK as RANKA=NINT(WORK(2)). Also see the
*> descriptions of SVA and WORK. The computed columns of U *> descriptions of SVA and WORK. The computed columns of U
*> are mutually numerically orthogonal up to approximately *> are mutually numerically orthogonal up to approximately
*> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU.EQ.'C'), *> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU = 'C'),
*> see the description of JOBU. *> see the description of JOBU.
*> If INFO .GT. 0, *> If INFO > 0,
*> the procedure SGESVJ did not converge in the given number *> the procedure SGESVJ did not converge in the given number
*> of iterations (sweeps). In that case, the computed *> of iterations (sweeps). In that case, the computed
*> columns of U may not be orthogonal up to TOL. The output *> columns of U may not be orthogonal up to TOL. The output
@ -139,8 +139,8 @@
*> values in SVA(1:N)) and V is still a decomposition of the *> values in SVA(1:N)) and V is still a decomposition of the
*> input matrix A in the sense that the residual *> input matrix A in the sense that the residual
*> ||A-SCALE*U*SIGMA*V^T||_2 / ||A||_2 is small. *> ||A-SCALE*U*SIGMA*V^T||_2 / ||A||_2 is small.
*> If JOBU .EQ. 'N': *> If JOBU = 'N':
*> If INFO .EQ. 0 : *> If INFO = 0:
*> Note that the left singular vectors are 'for free' in the *> Note that the left singular vectors are 'for free' in the
*> one-sided Jacobi SVD algorithm. However, if only the *> one-sided Jacobi SVD algorithm. However, if only the
*> singular values are needed, the level of numerical *> singular values are needed, the level of numerical
@ -149,7 +149,7 @@
*> numerically orthogonal up to approximately M*EPS. Thus, *> numerically orthogonal up to approximately M*EPS. Thus,
*> on exit, A contains the columns of U scaled with the *> on exit, A contains the columns of U scaled with the
*> corresponding singular values. *> corresponding singular values.
*> If INFO .GT. 0 : *> If INFO > 0:
*> the procedure SGESVJ did not converge in the given number *> the procedure SGESVJ did not converge in the given number
*> of iterations (sweeps). *> of iterations (sweeps).
*> \endverbatim *> \endverbatim
@ -164,9 +164,9 @@
*> \verbatim *> \verbatim
*> SVA is REAL array, dimension (N) *> SVA is REAL array, dimension (N)
*> On exit, *> On exit,
*> If INFO .EQ. 0 : *> If INFO = 0 :
*> depending on the value SCALE = WORK(1), we have: *> depending on the value SCALE = WORK(1), we have:
*> If SCALE .EQ. ONE: *> If SCALE = ONE:
*> SVA(1:N) contains the computed singular values of A. *> SVA(1:N) contains the computed singular values of A.
*> During the computation SVA contains the Euclidean column *> During the computation SVA contains the Euclidean column
*> norms of the iterated matrices in the array A. *> norms of the iterated matrices in the array A.
@ -175,7 +175,7 @@
*> factored representation is due to the fact that some of the *> factored representation is due to the fact that some of the
*> singular values of A might underflow or overflow. *> singular values of A might underflow or overflow.
*> *>
*> If INFO .GT. 0 : *> If INFO > 0 :
*> the procedure SGESVJ did not converge in the given number of *> the procedure SGESVJ did not converge in the given number of
*> iterations (sweeps) and SCALE*SVA(1:N) may not be accurate. *> iterations (sweeps) and SCALE*SVA(1:N) may not be accurate.
*> \endverbatim *> \endverbatim
@ -183,7 +183,7 @@
*> \param[in] MV *> \param[in] MV
*> \verbatim *> \verbatim
*> MV is INTEGER *> MV is INTEGER
*> If JOBV .EQ. 'A', then the product of Jacobi rotations in SGESVJ *> If JOBV = 'A', then the product of Jacobi rotations in SGESVJ
*> is applied to the first MV rows of V. See the description of JOBV. *> is applied to the first MV rows of V. See the description of JOBV.
*> \endverbatim *> \endverbatim
*> *>
@ -201,16 +201,16 @@
*> \param[in] LDV *> \param[in] LDV
*> \verbatim *> \verbatim
*> LDV is INTEGER *> LDV is INTEGER
*> The leading dimension of the array V, LDV .GE. 1. *> The leading dimension of the array V, LDV >= 1.
*> If JOBV .EQ. 'V', then LDV .GE. max(1,N). *> If JOBV = 'V', then LDV >= max(1,N).
*> If JOBV .EQ. 'A', then LDV .GE. max(1,MV) . *> If JOBV = 'A', then LDV >= max(1,MV) .
*> \endverbatim *> \endverbatim
*> *>
*> \param[in,out] WORK *> \param[in,out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, dimension (LWORK) *> WORK is REAL array, dimension (LWORK)
*> On entry, *> On entry,
*> If JOBU .EQ. 'C' : *> If JOBU = 'C' :
*> WORK(1) = CTOL, where CTOL defines the threshold for convergence. *> WORK(1) = CTOL, where CTOL defines the threshold for convergence.
*> The process stops if all columns of A are mutually *> The process stops if all columns of A are mutually
*> orthogonal up to CTOL*EPS, EPS=SLAMCH('E'). *> orthogonal up to CTOL*EPS, EPS=SLAMCH('E').
@ -230,7 +230,7 @@
*> WORK(5) = max_{i.NE.j} |COS(A(:,i),A(:,j))| in the last sweep. *> WORK(5) = max_{i.NE.j} |COS(A(:,i),A(:,j))| in the last sweep.
*> This is useful information in cases when SGESVJ did *> This is useful information in cases when SGESVJ did
*> not converge, as it can be used to estimate whether *> not converge, as it can be used to estimate whether
*> the output is stil useful and for post festum analysis. *> the output is still useful and for post festum analysis.
*> WORK(6) = the largest absolute value over all sines of the *> WORK(6) = the largest absolute value over all sines of the
*> Jacobi rotation angles in the last sweep. It can be *> Jacobi rotation angles in the last sweep. It can be
*> useful for a post festum analysis. *> useful for a post festum analysis.
@ -245,9 +245,9 @@
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> = 0 : successful exit. *> = 0: successful exit.
*> < 0 : if INFO = -i, then the i-th argument had an illegal value *> < 0: if INFO = -i, then the i-th argument had an illegal value
*> > 0 : SGESVJ did not converge in the maximal allowed number (30) *> > 0: SGESVJ did not converge in the maximal allowed number (30)
*> of sweeps. The output may still be useful. See the *> of sweeps. The output may still be useful. See the
*> description of WORK. *> description of WORK.
*> \endverbatim *> \endverbatim

10
lapack-netlib/SRC/sgesvxx.f
View File

@ -411,7 +411,7 @@
*> information as described below. There currently are up to three *> information as described below. There currently are up to three
*> pieces of information returned for each right-hand side. If *> pieces of information returned for each right-hand side. If
*> componentwise accuracy is not requested (PARAMS(3) = 0.0), then *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most *> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most
*> the first (:,N_ERR_BNDS) entries are returned. *> the first (:,N_ERR_BNDS) entries are returned.
*> *>
*> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith
@ -447,14 +447,14 @@
*> \param[in] NPARAMS *> \param[in] NPARAMS
*> \verbatim *> \verbatim
*> NPARAMS is INTEGER *> NPARAMS is INTEGER
*> Specifies the number of parameters set in PARAMS. If .LE. 0, the *> Specifies the number of parameters set in PARAMS. If <= 0, the
*> PARAMS array is never referenced and default values are used. *> PARAMS array is never referenced and default values are used.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in,out] PARAMS *> \param[in,out] PARAMS
*> \verbatim *> \verbatim
*> PARAMS is REAL array, dimension NPARAMS *> PARAMS is REAL array, dimension NPARAMS
*> Specifies algorithm parameters. If an entry is .LT. 0.0, then *> Specifies algorithm parameters. If an entry is < 0.0, then
*> that entry will be filled with default value used for that *> that entry will be filled with default value used for that
*> parameter. Only positions up to NPARAMS are accessed; defaults *> parameter. Only positions up to NPARAMS are accessed; defaults
*> are used for higher-numbered parameters. *> are used for higher-numbered parameters.
@ -462,9 +462,9 @@
*> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative
*> refinement or not. *> refinement or not.
*> Default: 1.0 *> Default: 1.0
*> = 0.0 : No refinement is performed, and no error bounds are *> = 0.0: No refinement is performed, and no error bounds are
*> computed. *> computed.
*> = 1.0 : Use the double-precision refinement algorithm, *> = 1.0: Use the double-precision refinement algorithm,
*> possibly with doubled-single computations if the *> possibly with doubled-single computations if the
*> compilation environment does not support DOUBLE *> compilation environment does not support DOUBLE
*> PRECISION. *> PRECISION.

2
lapack-netlib/SRC/sgetc2.f
View File

@ -85,7 +85,7 @@
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> = 0: successful exit *> = 0: successful exit
*> > 0: if INFO = k, U(k, k) is likely to produce owerflow if *> > 0: if INFO = k, U(k, k) is likely to produce overflow if
*> we try to solve for x in Ax = b. So U is perturbed to *> we try to solve for x in Ax = b. So U is perturbed to
*> avoid the overflow. *> avoid the overflow.
*> \endverbatim *> \endverbatim

4
lapack-netlib/SRC/sgetsls.f
View File

@ -1,3 +1,5 @@
*> \brief \b SGETSLS
*
* Definition: * Definition:
* =========== * ===========
* *
@ -154,7 +156,7 @@
* *
*> \date June 2017 *> \date June 2017
* *
*> \ingroup doubleGEsolve *> \ingroup realGEsolve
* *
* ===================================================================== * =====================================================================
SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,

8
lapack-netlib/SRC/sggesx.f
View File

@ -131,10 +131,10 @@
*> \verbatim *> \verbatim
*> SENSE is CHARACTER*1 *> SENSE is CHARACTER*1
*> Determines which reciprocal condition numbers are computed. *> Determines which reciprocal condition numbers are computed.
*> = 'N' : None are computed; *> = 'N': None are computed;
*> = 'E' : Computed for average of selected eigenvalues only; *> = 'E': Computed for average of selected eigenvalues only;
*> = 'V' : Computed for selected deflating subspaces only; *> = 'V': Computed for selected deflating subspaces only;
*> = 'B' : Computed for both. *> = 'B': Computed for both.
*> If SENSE = 'E', 'V', or 'B', SORT must equal 'S'. *> If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
*> \endverbatim *> \endverbatim
*> *>

20
lapack-netlib/SRC/sgsvj0.f
View File

@ -117,7 +117,7 @@
*> \param[in] MV *> \param[in] MV
*> \verbatim *> \verbatim
*> MV is INTEGER *> MV is INTEGER
*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a *> If JOBV = 'A', then MV rows of V are post-multipled by a
*> sequence of Jacobi rotations. *> sequence of Jacobi rotations.
*> If JOBV = 'N', then MV is not referenced. *> If JOBV = 'N', then MV is not referenced.
*> \endverbatim *> \endverbatim
@ -125,9 +125,9 @@
*> \param[in,out] V *> \param[in,out] V
*> \verbatim *> \verbatim
*> V is REAL array, dimension (LDV,N) *> V is REAL array, dimension (LDV,N)
*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a *> If JOBV = 'V' then N rows of V are post-multipled by a
*> sequence of Jacobi rotations. *> sequence of Jacobi rotations.
*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a *> If JOBV = 'A' then MV rows of V are post-multipled by a
*> sequence of Jacobi rotations. *> sequence of Jacobi rotations.
*> If JOBV = 'N', then V is not referenced. *> If JOBV = 'N', then V is not referenced.
*> \endverbatim *> \endverbatim
@ -136,8 +136,8 @@
*> \verbatim *> \verbatim
*> LDV is INTEGER *> LDV is INTEGER
*> The leading dimension of the array V, LDV >= 1. *> The leading dimension of the array V, LDV >= 1.
*> If JOBV = 'V', LDV .GE. N. *> If JOBV = 'V', LDV >= N.
*> If JOBV = 'A', LDV .GE. MV. *> If JOBV = 'A', LDV >= MV.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] EPS *> \param[in] EPS
@ -157,7 +157,7 @@
*> TOL is REAL *> TOL is REAL
*> TOL is the threshold for Jacobi rotations. For a pair *> TOL is the threshold for Jacobi rotations. For a pair
*> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is
*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. *> applied only if ABS(COS(angle(A(:,p),A(:,q)))) > TOL.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] NSWEEP *> \param[in] NSWEEP
@ -175,14 +175,14 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> LWORK is the dimension of WORK. LWORK .GE. M. *> LWORK is the dimension of WORK. LWORK >= M.
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> = 0 : successful exit. *> = 0: successful exit.
*> < 0 : if INFO = -i, then the i-th argument had an illegal value *> < 0: if INFO = -i, then the i-th argument had an illegal value
*> \endverbatim *> \endverbatim
* *
* Authors: * Authors:
@ -1045,7 +1045,7 @@
1993 CONTINUE 1993 CONTINUE
* end i=1:NSWEEP loop * end i=1:NSWEEP loop
* #:) Reaching this point means that the procedure has comleted the given * #:) Reaching this point means that the procedure has completed the given
* number of iterations. * number of iterations.
INFO = NSWEEP - 1 INFO = NSWEEP - 1
GO TO 1995 GO TO 1995

20
lapack-netlib/SRC/sgsvj1.f
View File

@ -61,7 +61,7 @@
*> In terms of the columns of A, the first N1 columns are rotated 'against' *> 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 *> 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 *> 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. *> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parameter.
*> The number of sweeps is given in NSWEEP and the orthogonality threshold *> The number of sweeps is given in NSWEEP and the orthogonality threshold
*> is given in TOL. *> is given in TOL.
*> \endverbatim *> \endverbatim
@ -147,7 +147,7 @@
*> \param[in] MV *> \param[in] MV
*> \verbatim *> \verbatim
*> MV is INTEGER *> MV is INTEGER
*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a *> If JOBV = 'A', then MV rows of V are post-multipled by a
*> sequence of Jacobi rotations. *> sequence of Jacobi rotations.
*> If JOBV = 'N', then MV is not referenced. *> If JOBV = 'N', then MV is not referenced.
*> \endverbatim *> \endverbatim
@ -155,9 +155,9 @@
*> \param[in,out] V *> \param[in,out] V
*> \verbatim *> \verbatim
*> V is REAL array, dimension (LDV,N) *> V is REAL array, dimension (LDV,N)
*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a *> If JOBV = 'V' then N rows of V are post-multipled by a
*> sequence of Jacobi rotations. *> sequence of Jacobi rotations.
*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a *> If JOBV = 'A' then MV rows of V are post-multipled by a
*> sequence of Jacobi rotations. *> sequence of Jacobi rotations.
*> If JOBV = 'N', then V is not referenced. *> If JOBV = 'N', then V is not referenced.
*> \endverbatim *> \endverbatim
@ -166,8 +166,8 @@
*> \verbatim *> \verbatim
*> LDV is INTEGER *> LDV is INTEGER
*> The leading dimension of the array V, LDV >= 1. *> The leading dimension of the array V, LDV >= 1.
*> If JOBV = 'V', LDV .GE. N. *> If JOBV = 'V', LDV >= N.
*> If JOBV = 'A', LDV .GE. MV. *> If JOBV = 'A', LDV >= MV.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] EPS *> \param[in] EPS
@ -187,7 +187,7 @@
*> TOL is REAL *> TOL is REAL
*> TOL is the threshold for Jacobi rotations. For a pair *> TOL is the threshold for Jacobi rotations. For a pair
*> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is
*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. *> applied only if ABS(COS(angle(A(:,p),A(:,q)))) > TOL.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] NSWEEP *> \param[in] NSWEEP
@ -205,14 +205,14 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> LWORK is the dimension of WORK. LWORK .GE. M. *> LWORK is the dimension of WORK. LWORK >= M.
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> = 0 : successful exit. *> = 0: successful exit.
*> < 0 : if INFO = -i, then the i-th argument had an illegal value *> < 0: if INFO = -i, then the i-th argument had an illegal value
*> \endverbatim *> \endverbatim
* *
* Authors: * Authors:

44
lapack-netlib/SRC/shseqr.f
View File

@ -70,7 +70,7 @@
*> \param[in] N *> \param[in] N
*> \verbatim *> \verbatim
*> N is INTEGER *> N is INTEGER
*> The order of the matrix H. N .GE. 0. *> The order of the matrix H. N >= 0.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] ILO *> \param[in] ILO
@ -87,7 +87,7 @@
*> set by a previous call to SGEBAL, and then passed to ZGEHRD *> set by a previous call to SGEBAL, and then passed to ZGEHRD
*> when the matrix output by SGEBAL is reduced to Hessenberg *> when the matrix output by SGEBAL is reduced to Hessenberg
*> form. Otherwise ILO and IHI should be set to 1 and N *> 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. *> respectively. If N > 0, then 1 <= ILO <= IHI <= N.
*> If N = 0, then ILO = 1 and IHI = 0. *> If N = 0, then ILO = 1 and IHI = 0.
*> \endverbatim *> \endverbatim
*> *>
@ -100,20 +100,20 @@
*> (the Schur form); 2-by-2 diagonal blocks (corresponding to *> (the Schur form); 2-by-2 diagonal blocks (corresponding to
*> complex conjugate pairs of eigenvalues) are returned in *> complex conjugate pairs of eigenvalues) are returned in
*> standard form, with H(i,i) = H(i+1,i+1) and *> 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 *> H(i+1,i)*H(i,i+1) < 0. If INFO = 0 and JOB = 'E', the
*> contents of H are unspecified on exit. (The output value of *> contents of H are unspecified on exit. (The output value of
*> H when INFO.GT.0 is given under the description of INFO *> H when INFO > 0 is given under the description of INFO
*> below.) *> below.)
*> *>
*> Unlike earlier versions of SHSEQR, this subroutine may *> Unlike earlier versions of SHSEQR, this subroutine may
*> explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1 *> explicitly H(i,j) = 0 for i > j and j = 1, 2, ... ILO-1
*> or j = IHI+1, IHI+2, ... N. *> or j = IHI+1, IHI+2, ... N.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] LDH *> \param[in] LDH
*> \verbatim *> \verbatim
*> LDH is INTEGER *> LDH is INTEGER
*> The leading dimension of the array H. LDH .GE. max(1,N). *> The leading dimension of the array H. LDH >= max(1,N).
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] WR *> \param[out] WR
@ -128,8 +128,8 @@
*> The real and imaginary parts, respectively, of the computed *> The real and imaginary parts, respectively, of the computed
*> eigenvalues. If two eigenvalues are computed as a complex *> eigenvalues. If two eigenvalues are computed as a complex
*> conjugate pair, they are stored in consecutive elements of *> 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 *> WR and WI, say the i-th and (i+1)th, with WI(i) > 0 and
*> WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in *> WI(i+1) < 0. If JOB = 'S', the eigenvalues are stored in
*> the same order as on the diagonal of the Schur form returned *> 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 *> 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 *> diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
@ -148,7 +148,7 @@
*> if INFO = 0, Z contains Q*Z. *> if INFO = 0, Z contains Q*Z.
*> Normally Q is the orthogonal matrix generated by SORGHR *> Normally Q is the orthogonal matrix generated by SORGHR
*> after the call to SGEHRD which formed the Hessenberg matrix *> after the call to SGEHRD which formed the Hessenberg matrix
*> H. (The output value of Z when INFO.GT.0 is given under *> H. (The output value of Z when INFO > 0 is given under
*> the description of INFO below.) *> the description of INFO below.)
*> \endverbatim *> \endverbatim
*> *>
@ -156,7 +156,7 @@
*> \verbatim *> \verbatim
*> LDZ is INTEGER *> LDZ is INTEGER
*> The leading dimension of the array Z. if COMPZ = 'I' or *> The leading dimension of the array Z. if COMPZ = 'I' or
*> COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1. *> COMPZ = 'V', then LDZ >= MAX(1,N). Otherwise, LDZ >= 1.
*> \endverbatim *> \endverbatim
*> *>
*> \param[out] WORK *> \param[out] WORK
@ -169,7 +169,7 @@
*> \param[in] LWORK *> \param[in] LWORK
*> \verbatim *> \verbatim
*> LWORK is INTEGER *> LWORK is INTEGER
*> The dimension of the array WORK. LWORK .GE. max(1,N) *> The dimension of the array WORK. LWORK >= max(1,N)
*> is sufficient and delivers very good and sometimes *> is sufficient and delivers very good and sometimes
*> optimal performance. However, LWORK as large as 11*N *> optimal performance. However, LWORK as large as 11*N
*> may be required for optimal performance. A workspace *> may be required for optimal performance. A workspace
@ -188,20 +188,20 @@
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> = 0: successful exit *> = 0: successful exit
*> .LT. 0: if INFO = -i, the i-th argument had an illegal *> < 0: if INFO = -i, the i-th argument had an illegal
*> value *> value
*> .GT. 0: if INFO = i, SHSEQR failed to compute all of *> > 0: if INFO = i, SHSEQR failed to compute all of
*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
*> and WI contain those eigenvalues which have been *> and WI contain those eigenvalues which have been
*> successfully computed. (Failures are rare.) *> successfully computed. (Failures are rare.)
*> *>
*> If INFO .GT. 0 and JOB = 'E', then on exit, the *> If INFO > 0 and JOB = 'E', then on exit, the
*> remaining unconverged eigenvalues are the eigen- *> remaining unconverged eigenvalues are the eigen-
*> values of the upper Hessenberg matrix rows and *> values of the upper Hessenberg matrix rows and
*> columns ILO through INFO of the final, output *> columns ILO through INFO of the final, output
*> value of H. *> value of H.
*> *>
*> If INFO .GT. 0 and JOB = 'S', then on exit *> If INFO > 0 and JOB = 'S', then on exit
*> *>
*> (*) (initial value of H)*U = U*(final value of H) *> (*) (initial value of H)*U = U*(final value of H)
*> *>
@ -209,19 +209,19 @@
*> value of H is upper Hessenberg and quasi-triangular *> value of H is upper Hessenberg and quasi-triangular
*> in rows and columns INFO+1 through IHI. *> in rows and columns INFO+1 through IHI.
*> *>
*> If INFO .GT. 0 and COMPZ = 'V', then on exit *> If INFO > 0 and COMPZ = 'V', then on exit
*> *>
*> (final value of Z) = (initial value of Z)*U *> (final value of Z) = (initial value of Z)*U
*> *>
*> where U is the orthogonal matrix in (*) (regard- *> where U is the orthogonal matrix in (*) (regard-
*> less of the value of JOB.) *> less of the value of JOB.)
*> *>
*> If INFO .GT. 0 and COMPZ = 'I', then on exit *> If INFO > 0 and COMPZ = 'I', then on exit
*> (final value of Z) = U *> (final value of Z) = U
*> where U is the orthogonal matrix in (*) (regard- *> where U is the orthogonal matrix in (*) (regard-
*> less of the value of JOB.) *> less of the value of JOB.)
*> *>
*> If INFO .GT. 0 and COMPZ = 'N', then Z is not *> If INFO > 0 and COMPZ = 'N', then Z is not
*> accessed. *> accessed.
*> \endverbatim *> \endverbatim
* *
@ -261,8 +261,8 @@
*> This depends on ILO, IHI and NS. NS is the *> This depends on ILO, IHI and NS. NS is the
*> number of simultaneous shifts returned *> number of simultaneous shifts returned
*> by ILAENV(ISPEC=15). (See ISPEC=15 below.) *> by ILAENV(ISPEC=15). (See ISPEC=15 below.)
*> The default for (IHI-ILO+1).LE.500 is NS. *> The default for (IHI-ILO+1) <= 500 is NS.
*> The default for (IHI-ILO+1).GT.500 is 3*NS/2. *> The default for (IHI-ILO+1) > 500 is 3*NS/2.
*> *>
*> ISPEC=14: Nibble crossover point. (See IPARMQ for *> ISPEC=14: Nibble crossover point. (See IPARMQ for
*> details.) Default: 14% of deflation window *> details.) Default: 14% of deflation window
@ -341,8 +341,8 @@
PARAMETER ( NTINY = 11 ) PARAMETER ( NTINY = 11 )
* *
* ==== NL allocates some local workspace to help small matrices * ==== NL allocates some local workspace to help small matrices
* . through a rare SLAHQR failure. NL .GT. NTINY = 11 is * . through a rare SLAHQR failure. NL > NTINY = 11 is
* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom- * . required and NL <= NMIN = ILAENV(ISPEC=12,...) is recom-
* . mended. (The default value of NMIN is 75.) Using NL = 49 * . mended. (The default value of NMIN is 75.) Using NL = 49
* . allows up to six simultaneous shifts and a 16-by-16 * . allows up to six simultaneous shifts and a 16-by-16
* . deflation window. ==== * . deflation window. ====

4
lapack-netlib/SRC/sla_gbrcond.f
View File

@ -140,13 +140,13 @@
*> i > 0: The ith argument is invalid. *> i > 0: The ith argument is invalid.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, dimension (5*N). *> WORK is REAL array, dimension (5*N).
*> Workspace. *> Workspace.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] IWORK *> \param[out] IWORK
*> \verbatim *> \verbatim
*> IWORK is INTEGER array, dimension (N). *> IWORK is INTEGER array, dimension (N).
*> Workspace. *> Workspace.

12
lapack-netlib/SRC/sla_gbrfsx_extended.f
View File

@ -65,19 +65,19 @@
*> \verbatim *> \verbatim
*> PREC_TYPE is INTEGER *> PREC_TYPE is INTEGER
*> Specifies the intermediate precision to be used in refinement. *> Specifies the intermediate precision to be used in refinement.
*> The value is defined by ILAPREC(P) where P is a CHARACTER and *> The value is defined by ILAPREC(P) where P is a CHARACTER and P
*> P = 'S': Single *> = 'S': Single
*> = 'D': Double *> = 'D': Double
*> = 'I': Indigenous *> = 'I': Indigenous
*> = 'X', 'E': Extra *> = 'X' or 'E': Extra
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] TRANS_TYPE *> \param[in] TRANS_TYPE
*> \verbatim *> \verbatim
*> TRANS_TYPE is INTEGER *> TRANS_TYPE is INTEGER
*> Specifies the transposition operation on A. *> Specifies the transposition operation on A.
*> The value is defined by ILATRANS(T) where T is a CHARACTER and *> The value is defined by ILATRANS(T) where T is a CHARACTER and T
*> T = 'N': No transpose *> = 'N': No transpose
*> = 'T': Transpose *> = 'T': Transpose
*> = 'C': Conjugate transpose *> = 'C': Conjugate transpose
*> \endverbatim *> \endverbatim
@ -269,7 +269,7 @@
*> information as described below. There currently are up to three *> information as described below. There currently are up to three
*> pieces of information returned for each right-hand side. If *> pieces of information returned for each right-hand side. If
*> componentwise accuracy is not requested (PARAMS(3) = 0.0), then *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most *> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most
*> the first (:,N_ERR_BNDS) entries are returned. *> the first (:,N_ERR_BNDS) entries are returned.
*> *>
*> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith

4
lapack-netlib/SRC/sla_gercond.f
View File

@ -122,13 +122,13 @@
*> i > 0: The ith argument is invalid. *> i > 0: The ith argument is invalid.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, dimension (3*N). *> WORK is REAL array, dimension (3*N).
*> Workspace. *> Workspace.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] IWORK *> \param[out] IWORK
*> \verbatim *> \verbatim
*> IWORK is INTEGER array, dimension (N). *> IWORK is INTEGER array, dimension (N).
*> Workspace.2 *> Workspace.2

12
lapack-netlib/SRC/sla_gerfsx_extended.f
View File

@ -65,19 +65,19 @@
*> \verbatim *> \verbatim
*> PREC_TYPE is INTEGER *> PREC_TYPE is INTEGER
*> Specifies the intermediate precision to be used in refinement. *> Specifies the intermediate precision to be used in refinement.
*> The value is defined by ILAPREC(P) where P is a CHARACTER and *> The value is defined by ILAPREC(P) where P is a CHARACTER and P
*> P = 'S': Single *> = 'S': Single
*> = 'D': Double *> = 'D': Double
*> = 'I': Indigenous *> = 'I': Indigenous
*> = 'X', 'E': Extra *> = 'X' or 'E': Extra
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] TRANS_TYPE *> \param[in] TRANS_TYPE
*> \verbatim *> \verbatim
*> TRANS_TYPE is INTEGER *> TRANS_TYPE is INTEGER
*> Specifies the transposition operation on A. *> Specifies the transposition operation on A.
*> The value is defined by ILATRANS(T) where T is a CHARACTER and *> The value is defined by ILATRANS(T) where T is a CHARACTER and T
*> T = 'N': No transpose *> = 'N': No transpose
*> = 'T': Transpose *> = 'T': Transpose
*> = 'C': Conjugate transpose *> = 'C': Conjugate transpose
*> \endverbatim *> \endverbatim
@ -257,7 +257,7 @@
*> information as described below. There currently are up to three *> information as described below. There currently are up to three
*> pieces of information returned for each right-hand side. If *> pieces of information returned for each right-hand side. If
*> componentwise accuracy is not requested (PARAMS(3) = 0.0), then *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
*> ERRS_C is not accessed. If N_ERR_BNDS .LT. 3, then at most *> ERRS_C is not accessed. If N_ERR_BNDS < 3, then at most
*> the first (:,N_ERR_BNDS) entries are returned. *> the first (:,N_ERR_BNDS) entries are returned.
*> *>
*> The first index in ERRS_C(i,:) corresponds to the ith *> The first index in ERRS_C(i,:) corresponds to the ith

4
lapack-netlib/SRC/sla_porcond.f
View File

@ -112,13 +112,13 @@
*> i > 0: The ith argument is invalid. *> i > 0: The ith argument is invalid.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, dimension (3*N). *> WORK is REAL array, dimension (3*N).
*> Workspace. *> Workspace.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] IWORK *> \param[out] IWORK
*> \verbatim *> \verbatim
*> IWORK is INTEGER array, dimension (N). *> IWORK is INTEGER array, dimension (N).
*> Workspace. *> Workspace.

8
lapack-netlib/SRC/sla_porfsx_extended.f
View File

@ -65,11 +65,11 @@
*> \verbatim *> \verbatim
*> PREC_TYPE is INTEGER *> PREC_TYPE is INTEGER
*> Specifies the intermediate precision to be used in refinement. *> Specifies the intermediate precision to be used in refinement.
*> The value is defined by ILAPREC(P) where P is a CHARACTER and *> The value is defined by ILAPREC(P) where P is a CHARACTER and P
*> P = 'S': Single *> = 'S': Single
*> = 'D': Double *> = 'D': Double
*> = 'I': Indigenous *> = 'I': Indigenous
*> = 'X', 'E': Extra *> = 'X' or 'E': Extra
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -246,7 +246,7 @@
*> information as described below. There currently are up to three *> information as described below. There currently are up to three
*> pieces of information returned for each right-hand side. If *> pieces of information returned for each right-hand side. If
*> componentwise accuracy is not requested (PARAMS(3) = 0.0), then *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most *> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most
*> the first (:,N_ERR_BNDS) entries are returned. *> the first (:,N_ERR_BNDS) entries are returned.
*> *>
*> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith

4
lapack-netlib/SRC/sla_syrcond.f
View File

@ -118,13 +118,13 @@
*> i > 0: The ith argument is invalid. *> i > 0: The ith argument is invalid.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, dimension (3*N). *> WORK is REAL array, dimension (3*N).
*> Workspace. *> Workspace.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] IWORK *> \param[out] IWORK
*> \verbatim *> \verbatim
*> IWORK is INTEGER array, dimension (N). *> IWORK is INTEGER array, dimension (N).
*> Workspace. *> Workspace.

8
lapack-netlib/SRC/sla_syrfsx_extended.f
View File

@ -67,11 +67,11 @@
*> \verbatim *> \verbatim
*> PREC_TYPE is INTEGER *> PREC_TYPE is INTEGER
*> Specifies the intermediate precision to be used in refinement. *> Specifies the intermediate precision to be used in refinement.
*> The value is defined by ILAPREC(P) where P is a CHARACTER and *> The value is defined by ILAPREC(P) where P is a CHARACTER and P
*> P = 'S': Single *> = 'S': Single
*> = 'D': Double *> = 'D': Double
*> = 'I': Indigenous *> = 'I': Indigenous
*> = 'X', 'E': Extra *> = 'X' or 'E': Extra
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -255,7 +255,7 @@
*> information as described below. There currently are up to three *> information as described below. There currently are up to three
*> pieces of information returned for each right-hand side. If *> pieces of information returned for each right-hand side. If
*> componentwise accuracy is not requested (PARAMS(3) = 0.0), then *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then
*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most *> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most
*> the first (:,N_ERR_BNDS) entries are returned. *> the first (:,N_ERR_BNDS) entries are returned.
*> *>
*> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith

2
lapack-netlib/SRC/sla_syrpvgrw.f
View File

@ -101,7 +101,7 @@
*> as determined by SSYTRF. *> as determined by SSYTRF.
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] WORK *> \param[out] WORK
*> \verbatim *> \verbatim
*> WORK is REAL array, dimension (2*N) *> WORK is REAL array, dimension (2*N)
*> \endverbatim *> \endverbatim

2
lapack-netlib/SRC/sla_wwaddw.f
View File

@ -36,7 +36,7 @@
*> SLA_WWADDW adds a vector W into a doubled-single vector (X, Y). *> 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 *> This works for all extant IBM's hex and binary floating point
*> arithmetics, but not for decimal. *> arithmetic, but not for decimal.
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:

2
lapack-netlib/SRC/slaed4.f
View File

@ -82,7 +82,7 @@
*> \param[out] DELTA *> \param[out] DELTA
*> \verbatim *> \verbatim
*> DELTA is REAL array, dimension (N) *> DELTA is REAL array, dimension (N)
*> If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th *> If N > 2, DELTA contains (D(j) - lambda_I) in its j-th
*> component. If N = 1, then DELTA(1) = 1. If N = 2, see SLAED5 *> component. If N = 1, then DELTA(1) = 1. If N = 2, see SLAED5
*> for detail. The vector DELTA contains the information necessary *> for detail. The vector DELTA contains the information necessary
*> to construct the eigenvectors by SLAED3 and SLAED9. *> to construct the eigenvectors by SLAED3 and SLAED9.

2
lapack-netlib/SRC/slaed8.f
View File

@ -353,7 +353,7 @@
Z( I ) = W( INDX( I ) ) Z( I ) = W( INDX( I ) )
40 CONTINUE 40 CONTINUE
* *
* Calculate the allowable deflation tolerence * Calculate the allowable deflation tolerance
* *
IMAX = ISAMAX( N, Z, 1 ) IMAX = ISAMAX( N, Z, 1 )
JMAX = ISAMAX( N, D, 1 ) JMAX = ISAMAX( N, D, 1 )

6
lapack-netlib/SRC/slagtf.f
View File

@ -125,7 +125,7 @@
*> then IN(k) = 1, otherwise IN(k) = 0. The element IN(n) *> then IN(k) = 1, otherwise IN(k) = 0. The element IN(n)
*> returns the smallest positive integer j such that *> returns the smallest positive integer j such that
*> *>
*> abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL, *> abs( u(j,j) ) <= norm( (T - lambda*I)(j) )*TOL,
*> *>
*> where norm( A(j) ) denotes the sum of the absolute values of *> 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) *> the jth row of the matrix A. If no such j exists then IN(n)
@ -137,8 +137,8 @@
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> = 0 : successful exit *> = 0: successful exit
*> .lt. 0: if INFO = -k, the kth argument had an illegal value *> < 0: if INFO = -k, the kth argument had an illegal value
*> \endverbatim *> \endverbatim
* *
* Authors: * Authors:

10
lapack-netlib/SRC/slagts.f
View File

@ -122,12 +122,12 @@
*> \param[in,out] TOL *> \param[in,out] TOL
*> \verbatim *> \verbatim
*> TOL is REAL *> TOL is REAL
*> On entry, with JOB .lt. 0, TOL should be the minimum *> On entry, with JOB < 0, TOL should be the minimum
*> perturbation to be made to very small diagonal elements of U. *> perturbation to be made to very small diagonal elements of U.
*> TOL should normally be chosen as about eps*norm(U), where eps *> TOL should normally be chosen as about eps*norm(U), where eps
*> is the relative machine precision, but if TOL is supplied as *> is the relative machine precision, but if TOL is supplied as
*> non-positive, then it is reset to eps*max( abs( u(i,j) ) ). *> non-positive, then it is reset to eps*max( abs( u(i,j) ) ).
*> If JOB .gt. 0 then TOL is not referenced. *> If JOB > 0 then TOL is not referenced.
*> *>
*> On exit, TOL is changed as described above, only if TOL is *> On exit, TOL is changed as described above, only if TOL is
*> non-positive on entry. Otherwise TOL is unchanged. *> non-positive on entry. Otherwise TOL is unchanged.
@ -136,9 +136,9 @@
*> \param[out] INFO *> \param[out] INFO
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> = 0 : successful exit *> = 0: successful exit
*> .lt. 0: if INFO = -i, the i-th argument had an illegal value *> < 0: if INFO = -i, the i-th argument had an illegal value
*> .gt. 0: overflow would occur when computing the INFO(th) *> > 0: overflow would occur when computing the INFO(th)
*> element of the solution vector x. This can only occur *> element of the solution vector x. This can only occur
*> when JOB is supplied as positive and either means *> when JOB is supplied as positive and either means
*> that a diagonal element of U is very small, or that *> that a diagonal element of U is very small, or that

12
lapack-netlib/SRC/slahqr.f
View File

@ -151,25 +151,25 @@
*> \verbatim *> \verbatim
*> INFO is INTEGER *> INFO is INTEGER
*> = 0: successful exit *> = 0: successful exit
*> .GT. 0: If INFO = i, SLAHQR failed to compute all the *> > 0: If INFO = i, SLAHQR failed to compute all the
*> eigenvalues ILO to IHI in a total of 30 iterations *> eigenvalues ILO to IHI in a total of 30 iterations
*> per eigenvalue; elements i+1:ihi of WR and WI *> per eigenvalue; elements i+1:ihi of WR and WI
*> contain those eigenvalues which have been *> contain those eigenvalues which have been
*> successfully computed. *> successfully computed.
*> *>
*> If INFO .GT. 0 and WANTT is .FALSE., then on exit, *> If INFO > 0 and WANTT is .FALSE., then on exit,
*> the remaining unconverged eigenvalues are the *> the remaining unconverged eigenvalues are the
*> eigenvalues of the upper Hessenberg matrix rows *> eigenvalues of the upper Hessenberg matrix rows
*> and columns ILO thorugh INFO of the final, output *> and columns ILO through INFO of the final, output
*> value of H. *> value of H.
*> *>
*> If INFO .GT. 0 and WANTT is .TRUE., then on exit *> If INFO > 0 and WANTT is .TRUE., then on exit
*> (*) (initial value of H)*U = U*(final value of H) *> (*) (initial value of H)*U = U*(final value of H)
*> where U is an orthognal matrix. The final *> where U is an orthogonal matrix. The final
*> value of H is upper Hessenberg and triangular in *> value of H is upper Hessenberg and triangular in
*> rows and columns INFO+1 through IHI. *> rows and columns INFO+1 through IHI.
*> *>
*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit *> If INFO > 0 and WANTZ is .TRUE., then on exit
*> (final value of Z) = (initial value of Z)*U *> (final value of Z) = (initial value of Z)*U
*> where U is the orthogonal matrix in (*) *> where U is the orthogonal matrix in (*)
*> (regardless of the value of WANTT.) *> (regardless of the value of WANTT.)

2
lapack-netlib/SRC/slaln2.f
View File

@ -49,7 +49,7 @@
*> the first column of each being the real part and the second *> the first column of each being the real part and the second
*> being the imaginary part. *> being the imaginary part.
*> *>
*> "s" is a scaling factor (.LE. 1), computed by SLALN2, which is *> "s" is a scaling factor (<= 1), computed by SLALN2, which is
*> so chosen that X can be computed without overflow. X is further *> 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 *> scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
*> than overflow. *> than overflow.

1
lapack-netlib/SRC/slamswlq.f
View File

@ -1,3 +1,4 @@
*> \brief \b SLAMSWLQ
* *
* Definition: * Definition:
* =========== * ===========

1
lapack-netlib/SRC/slamtsqr.f
View File

@ -1,3 +1,4 @@
*> \brief \b SLAMTSQR
* *
* Definition: * Definition:
* =========== * ===========

26
lapack-netlib/SRC/slangb.f
View File

@ -129,6 +129,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER NORM CHARACTER NORM
INTEGER KL, KU, LDAB, N INTEGER KL, KU, LDAB, N
@ -139,22 +140,24 @@
* *
* ===================================================================== * =====================================================================
* *
*
* .. Parameters .. * .. Parameters ..
REAL ONE, ZERO REAL ONE, ZERO
PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
INTEGER I, J, K, L INTEGER I, J, K, L
REAL SCALE, SUM, VALUE, TEMP REAL SUM, VALUE, TEMP
* .. * ..
* .. External Subroutines .. * .. Local Arrays ..
EXTERNAL SLASSQ REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN EXTERNAL LSAME, SISNAN
* .. * ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT INTRINSIC ABS, MAX, MIN, SQRT
* .. * ..
@ -206,15 +209,22 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
* *
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
DO 90 J = 1, N DO 90 J = 1, N
L = MAX( 1, J-KU ) L = MAX( 1, J-KU )
K = KU + 1 - J + L K = KU + 1 - J + L
CALL SLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
90 CONTINUE 90 CONTINUE
VALUE = SCALE*SQRT( SUM ) VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANGB = VALUE SLANGB = VALUE

22
lapack-netlib/SRC/slange.f
View File

@ -119,6 +119,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER NORM CHARACTER NORM
INTEGER LDA, M, N INTEGER LDA, M, N
@ -135,10 +136,13 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
INTEGER I, J INTEGER I, J
REAL SCALE, SUM, VALUE, TEMP REAL SUM, VALUE, TEMP
* ..
* .. Local Arrays ..
REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SLASSQ EXTERNAL SLASSQ, SCOMBSSQ
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
@ -194,13 +198,19 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
* *
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
DO 90 J = 1, N DO 90 J = 1, N
CALL SLASSQ( M, A( 1, J ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( M, A( 1, J ), 1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
90 CONTINUE 90 CONTINUE
VALUE = SCALE*SQRT( SUM ) VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANGE = VALUE SLANGE = VALUE

25
lapack-netlib/SRC/slanhs.f
View File

@ -113,6 +113,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER NORM CHARACTER NORM
INTEGER LDA, N INTEGER LDA, N
@ -129,15 +130,18 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
INTEGER I, J INTEGER I, J
REAL SCALE, SUM, VALUE REAL SUM, VALUE
* .. * ..
* .. External Subroutines .. * .. Local Arrays ..
EXTERNAL SLASSQ REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN EXTERNAL LSAME, SISNAN
* .. * ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MIN, SQRT INTRINSIC ABS, MIN, SQRT
* .. * ..
@ -188,13 +192,20 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
* *
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
DO 90 J = 1, N DO 90 J = 1, N
CALL SLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( N, J+1 ), A( 1, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
90 CONTINUE 90 CONTINUE
VALUE = SCALE*SQRT( SUM ) VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANHS = VALUE SLANHS = VALUE

44
lapack-netlib/SRC/slansb.f
View File

@ -134,6 +134,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER NORM, UPLO CHARACTER NORM, UPLO
INTEGER K, LDAB, N INTEGER K, LDAB, N
@ -150,15 +151,18 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
INTEGER I, J, L INTEGER I, J, L
REAL ABSA, SCALE, SUM, VALUE REAL ABSA, SUM, VALUE
* .. * ..
* .. External Subroutines .. * .. Local Arrays ..
EXTERNAL SLASSQ REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN EXTERNAL LSAME, SISNAN
* .. * ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT INTRINSIC ABS, MAX, MIN, SQRT
* .. * ..
@ -225,29 +229,47 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
*
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
*
* Sum off-diagonals
* *
SCALE = ZERO
SUM = ONE
IF( K.GT.0 ) THEN IF( K.GT.0 ) THEN
IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( UPLO, 'U' ) ) THEN
DO 110 J = 2, N DO 110 J = 2, N
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), CALL SLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ),
$ 1, SCALE, SUM ) $ 1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
110 CONTINUE 110 CONTINUE
L = K + 1 L = K + 1
ELSE ELSE
DO 120 J = 1, N - 1 DO 120 J = 1, N - 1
CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, COLSSQ( 1 ) = ZERO
$ SUM ) COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
120 CONTINUE 120 CONTINUE
L = 1 L = 1
END IF END IF
SUM = 2*SUM SSQ( 2 ) = 2*SSQ( 2 )
ELSE ELSE
L = 1 L = 1
END IF END IF
CALL SLASSQ( N, AB( L, 1 ), LDAB, SCALE, SUM ) *
VALUE = SCALE*SQRT( SUM ) * Sum diagonal
*
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( N, AB( L, 1 ), LDAB, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANSB = VALUE SLANSB = VALUE

48
lapack-netlib/SRC/slansp.f
View File

@ -119,6 +119,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER NORM, UPLO CHARACTER NORM, UPLO
INTEGER N INTEGER N
@ -135,15 +136,18 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
INTEGER I, J, K INTEGER I, J, K
REAL ABSA, SCALE, SUM, VALUE REAL ABSA, SUM, VALUE
* .. * ..
* .. External Subroutines .. * .. Local Arrays ..
EXTERNAL SLASSQ REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN EXTERNAL LSAME, SISNAN
* .. * ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, SQRT INTRINSIC ABS, SQRT
* .. * ..
@ -217,31 +221,48 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
*
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
*
* Sum off-diagonals
* *
SCALE = ZERO
SUM = ONE
K = 2 K = 2
IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( UPLO, 'U' ) ) THEN
DO 110 J = 2, N DO 110 J = 2, N
CALL SLASSQ( J-1, AP( K ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( J-1, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
K = K + J K = K + J
110 CONTINUE 110 CONTINUE
ELSE ELSE
DO 120 J = 1, N - 1 DO 120 J = 1, N - 1
CALL SLASSQ( N-J, AP( K ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( N-J, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
K = K + N - J + 1 K = K + N - J + 1
120 CONTINUE 120 CONTINUE
END IF END IF
SUM = 2*SUM SSQ( 2 ) = 2*SSQ( 2 )
*
* Sum diagonal
*
K = 1 K = 1
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
DO 130 I = 1, N DO 130 I = 1, N
IF( AP( K ).NE.ZERO ) THEN IF( AP( K ).NE.ZERO ) THEN
ABSA = ABS( AP( K ) ) ABSA = ABS( AP( K ) )
IF( SCALE.LT.ABSA ) THEN IF( COLSSQ( 1 ).LT.ABSA ) THEN
SUM = ONE + SUM*( SCALE / ABSA )**2 COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2
SCALE = ABSA COLSSQ( 1 ) = ABSA
ELSE ELSE
SUM = SUM + ( ABSA / SCALE )**2 COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2
END IF END IF
END IF END IF
IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( UPLO, 'U' ) ) THEN
@ -250,7 +271,8 @@
K = K + N - I + 1 K = K + N - I + 1
END IF END IF
130 CONTINUE 130 CONTINUE
VALUE = SCALE*SQRT( SUM ) CALL SCOMBSSQ( SSQ, COLSSQ )
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANSP = VALUE SLANSP = VALUE

42
lapack-netlib/SRC/slansy.f
View File

@ -127,6 +127,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER NORM, UPLO CHARACTER NORM, UPLO
INTEGER LDA, N INTEGER LDA, N
@ -143,15 +144,18 @@
* .. * ..
* .. Local Scalars .. * .. Local Scalars ..
INTEGER I, J INTEGER I, J
REAL ABSA, SCALE, SUM, VALUE REAL ABSA, SUM, VALUE
* .. * ..
* .. External Subroutines .. * .. Local Arrays ..
EXTERNAL SLASSQ REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN EXTERNAL LSAME, SISNAN
* .. * ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, SQRT INTRINSIC ABS, SQRT
* .. * ..
@ -216,21 +220,39 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
*
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
*
* Sum off-diagonals
* *
SCALE = ZERO
SUM = ONE
IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( UPLO, 'U' ) ) THEN
DO 110 J = 2, N DO 110 J = 2, N
CALL SLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( J-1, A( 1, J ), 1, COLSSQ(1), COLSSQ(2) )
CALL SCOMBSSQ( SSQ, COLSSQ )
110 CONTINUE 110 CONTINUE
ELSE ELSE
DO 120 J = 1, N - 1 DO 120 J = 1, N - 1
CALL SLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( N-J, A( J+1, J ), 1, COLSSQ(1), COLSSQ(2) )
CALL SCOMBSSQ( SSQ, COLSSQ )
120 CONTINUE 120 CONTINUE
END IF END IF
SUM = 2*SUM SSQ( 2 ) = 2*SSQ( 2 )
CALL SLASSQ( N, A, LDA+1, SCALE, SUM ) *
VALUE = SCALE*SQRT( SUM ) * Sum diagonal
*
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( N, A, LDA+1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANSY = VALUE SLANSY = VALUE

57
lapack-netlib/SRC/slantb.f
View File

@ -145,6 +145,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER DIAG, NORM, UPLO CHARACTER DIAG, NORM, UPLO
INTEGER K, LDAB, N INTEGER K, LDAB, N
@ -162,15 +163,18 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL UDIAG LOGICAL UDIAG
INTEGER I, J, L INTEGER I, J, L
REAL SCALE, SUM, VALUE REAL SUM, VALUE
* .. * ..
* .. External Subroutines .. * .. Local Arrays ..
EXTERNAL SLASSQ REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN EXTERNAL LSAME, SISNAN
* .. * ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT INTRINSIC ABS, MAX, MIN, SQRT
* .. * ..
@ -311,46 +315,61 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
* *
IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( UPLO, 'U' ) ) THEN
IF( LSAME( DIAG, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE SSQ( 1 ) = ONE
SUM = N SSQ( 2 ) = N
IF( K.GT.0 ) THEN IF( K.GT.0 ) THEN
DO 280 J = 2, N DO 280 J = 2, N
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( J-1, K ), CALL SLASSQ( MIN( J-1, K ),
$ AB( MAX( K+2-J, 1 ), J ), 1, SCALE, $ AB( MAX( K+2-J, 1 ), J ), 1,
$ SUM ) $ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
280 CONTINUE 280 CONTINUE
END IF END IF
ELSE ELSE
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
DO 290 J = 1, N DO 290 J = 1, N
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), CALL SLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
$ 1, SCALE, SUM ) $ 1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
290 CONTINUE 290 CONTINUE
END IF END IF
ELSE ELSE
IF( LSAME( DIAG, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE SSQ( 1 ) = ONE
SUM = N SSQ( 2 ) = N
IF( K.GT.0 ) THEN IF( K.GT.0 ) THEN
DO 300 J = 1, N - 1 DO 300 J = 1, N - 1
CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, COLSSQ( 1 ) = ZERO
$ SUM ) COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
300 CONTINUE 300 CONTINUE
END IF END IF
ELSE ELSE
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
DO 310 J = 1, N DO 310 J = 1, N
CALL SLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, COLSSQ( 1 ) = ZERO
$ SUM ) COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
310 CONTINUE 310 CONTINUE
END IF END IF
END IF END IF
VALUE = SCALE*SQRT( SUM ) VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANTB = VALUE SLANTB = VALUE

55
lapack-netlib/SRC/slantp.f
View File

@ -129,6 +129,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER DIAG, NORM, UPLO CHARACTER DIAG, NORM, UPLO
INTEGER N INTEGER N
@ -146,15 +147,18 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL UDIAG LOGICAL UDIAG
INTEGER I, J, K INTEGER I, J, K
REAL SCALE, SUM, VALUE REAL SUM, VALUE
* .. * ..
* .. External Subroutines .. * .. Local Arrays ..
EXTERNAL SLASSQ REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN EXTERNAL LSAME, SISNAN
* .. * ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, SQRT INTRINSIC ABS, SQRT
* .. * ..
@ -306,45 +310,64 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
* *
IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( UPLO, 'U' ) ) THEN
IF( LSAME( DIAG, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE SSQ( 1 ) = ONE
SUM = N SSQ( 2 ) = N
K = 2 K = 2
DO 280 J = 2, N DO 280 J = 2, N
CALL SLASSQ( J-1, AP( K ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( J-1, AP( K ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
K = K + J K = K + J
280 CONTINUE 280 CONTINUE
ELSE ELSE
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
K = 1 K = 1
DO 290 J = 1, N DO 290 J = 1, N
CALL SLASSQ( J, AP( K ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( J, AP( K ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
K = K + J K = K + J
290 CONTINUE 290 CONTINUE
END IF END IF
ELSE ELSE
IF( LSAME( DIAG, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE SSQ( 1 ) = ONE
SUM = N SSQ( 2 ) = N
K = 2 K = 2
DO 300 J = 1, N - 1 DO 300 J = 1, N - 1
CALL SLASSQ( N-J, AP( K ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( N-J, AP( K ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
K = K + N - J + 1 K = K + N - J + 1
300 CONTINUE 300 CONTINUE
ELSE ELSE
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
K = 1 K = 1
DO 310 J = 1, N DO 310 J = 1, N
CALL SLASSQ( N-J+1, AP( K ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( N-J+1, AP( K ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
K = K + N - J + 1 K = K + N - J + 1
310 CONTINUE 310 CONTINUE
END IF END IF
END IF END IF
VALUE = SCALE*SQRT( SUM ) VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANTP = VALUE SLANTP = VALUE

58
lapack-netlib/SRC/slantr.f
View File

@ -146,6 +146,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016 * December 2016
* *
IMPLICIT NONE
* .. Scalar Arguments .. * .. Scalar Arguments ..
CHARACTER DIAG, NORM, UPLO CHARACTER DIAG, NORM, UPLO
INTEGER LDA, M, N INTEGER LDA, M, N
@ -163,15 +164,18 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL UDIAG LOGICAL UDIAG
INTEGER I, J INTEGER I, J
REAL SCALE, SUM, VALUE REAL SUM, VALUE
* .. * ..
* .. External Subroutines .. * .. Local Arrays ..
EXTERNAL SLASSQ REAL SSQ( 2 ), COLSSQ( 2 )
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME, SISNAN LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN EXTERNAL LSAME, SISNAN
* .. * ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MIN, SQRT INTRINSIC ABS, MIN, SQRT
* .. * ..
@ -281,7 +285,7 @@
END IF END IF
ELSE ELSE
IF( LSAME( DIAG, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN
DO 210 I = 1, N DO 210 I = 1, MIN( M, N )
WORK( I ) = ONE WORK( I ) = ONE
210 CONTINUE 210 CONTINUE
DO 220 I = N + 1, M DO 220 I = N + 1, M
@ -311,38 +315,56 @@
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
* *
* Find normF(A). * Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
* *
IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( UPLO, 'U' ) ) THEN
IF( LSAME( DIAG, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE SSQ( 1 ) = ONE
SUM = MIN( M, N ) SSQ( 2 ) = MIN( M, N )
DO 290 J = 2, N DO 290 J = 2, N
CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
290 CONTINUE 290 CONTINUE
ELSE ELSE
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
DO 300 J = 1, N DO 300 J = 1, N
CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( M, J ), A( 1, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
300 CONTINUE 300 CONTINUE
END IF END IF
ELSE ELSE
IF( LSAME( DIAG, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE SSQ( 1 ) = ONE
SUM = MIN( M, N ) SSQ( 2 ) = MIN( M, N )
DO 310 J = 1, N DO 310 J = 1, N
CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, COLSSQ( 1 ) = ZERO
$ SUM ) COLSSQ( 2 ) = ONE
CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
310 CONTINUE 310 CONTINUE
ELSE ELSE
SCALE = ZERO SSQ( 1 ) = ZERO
SUM = ONE SSQ( 2 ) = ONE
DO 320 J = 1, N DO 320 J = 1, N
CALL SLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( M-J+1, A( J, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
320 CONTINUE 320 CONTINUE
END IF END IF
END IF END IF
VALUE = SCALE*SQRT( SUM ) VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF END IF
* *
SLANTR = VALUE SLANTR = VALUE

8
lapack-netlib/SRC/slanv2.f
View File

@ -161,7 +161,6 @@
IF( C.EQ.ZERO ) THEN IF( C.EQ.ZERO ) THEN
CS = ONE CS = ONE
SN = ZERO SN = ZERO
GO TO 10
* *
ELSE IF( B.EQ.ZERO ) THEN ELSE IF( B.EQ.ZERO ) THEN
* *
@ -174,12 +173,12 @@
A = TEMP A = TEMP
B = -C B = -C
C = ZERO C = ZERO
GO TO 10 *
ELSE IF( (A-D).EQ.ZERO .AND. SIGN( ONE, B ).NE. ELSE IF( (A-D).EQ.ZERO .AND. SIGN( ONE, B ).NE.
$ SIGN( ONE, C ) ) THEN $ SIGN( ONE, C ) ) THEN
CS = ONE CS = ONE
SN = ZERO SN = ZERO
GO TO 10 *
ELSE ELSE
* *
TEMP = A - D TEMP = A - D
@ -207,6 +206,7 @@
SN = C / TAU SN = C / TAU
B = B - C B = B - C
C = ZERO C = ZERO
*
ELSE ELSE
* *
* Complex eigenvalues, or real (almost) equal eigenvalues. * Complex eigenvalues, or real (almost) equal eigenvalues.
@ -268,8 +268,6 @@
END IF END IF
* *
END IF END IF
*
10 CONTINUE
* *
* Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). * Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
* *

248
lapack-netlib/SRC/slaorhr_col_getrfnp.f Normal file
View File

@ -0,0 +1,248 @@
*> \brief \b SLAORHR_COL_GETRFNP
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SLAORHR_COL_GETRFNP + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaorhr_col_getrfnp.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaorhr_col_getrfnp.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaorhr_col_getrfnp.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE SLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO )
*
* .. Scalar Arguments ..
* INTEGER INFO, LDA, M, N
* ..
* .. Array Arguments ..
* REAL A( LDA, * ), D( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SLAORHR_COL_GETRFNP computes the modified LU factorization without
*> pivoting of a real general M-by-N matrix A. The factorization has
*> the form:
*>
*> A - S = L * U,
*>
*> where:
*> S is a m-by-n diagonal sign matrix with the diagonal D, so that
*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed
*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing
*> i-1 steps of Gaussian elimination. This means that the diagonal
*> element at each step of "modified" Gaussian elimination is
*> at least one in absolute value (so that division-by-zero not
*> not possible during the division by the diagonal element);
*>
*> L is a M-by-N lower triangular matrix with unit diagonal elements
*> (lower trapezoidal if M > N);
*>
*> and U is a M-by-N upper triangular matrix
*> (upper trapezoidal if M < N).
*>
*> This routine is an auxiliary routine used in the Householder
*> reconstruction routine SORHR_COL. In SORHR_COL, this routine is
*> applied to an M-by-N matrix A with orthonormal columns, where each
*> element is bounded by one in absolute value. With the choice of
*> the matrix S above, one can show that the diagonal element at each
*> step of Gaussian elimination is the largest (in absolute value) in
*> the column on or below the diagonal, so that no pivoting is required
*> for numerical stability [1].
*>
*> For more details on the Householder reconstruction algorithm,
*> including the modified LU factorization, see [1].
*>
*> This is the blocked right-looking version of the algorithm,
*> calling Level 3 BLAS to update the submatrix. To factorize a block,
*> this routine calls the recursive routine SLAORHR_COL_GETRFNP2.
*>
*> [1] "Reconstructing Householder vectors from tall-skinny QR",
*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen,
*> E. Solomonik, J. Parallel Distrib. Comput.,
*> vol. 85, pp. 3-31, 2015.
*> \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-S=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] D
*> \verbatim
*> D is REAL array, dimension min(M,N)
*> The diagonal elements of the diagonal M-by-N sign matrix S,
*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can
*> be only plus or minus one.
*> \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 2019
*
*> \ingroup realGEcomputational
*
*> \par Contributors:
* ==================
*>
*> \verbatim
*>
*> November 2019, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
*> \endverbatim
*
* =====================================================================
SUBROUTINE SLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO )
IMPLICIT NONE
*
* -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2019
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
* ..
* .. Array Arguments ..
REAL A( LDA, * ), D( * )
* ..
*
* =====================================================================
*
* .. Parameters ..
REAL ONE
PARAMETER ( ONE = 1.0E+0 )
* ..
* .. Local Scalars ..
INTEGER IINFO, J, JB, NB
* ..
* .. External Subroutines ..
EXTERNAL SGEMM, SLAORHR_COL_GETRFNP2, 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( 'SLAORHR_COL_GETRFNP', -INFO )
RETURN
END IF
*
* Quick return if possible
*
IF( MIN( M, N ).EQ.0 )
$ RETURN
*
* Determine the block size for this environment.
*
NB = ILAENV( 1, 'SLAORHR_COL_GETRFNP', ' ', M, N, -1, -1 )
IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
*
* Use unblocked code.
*
CALL SLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO )
ELSE
*
* Use blocked code.
*
DO J = 1, MIN( M, N ), NB
JB = MIN( MIN( M, N )-J+1, NB )
*
* Factor diagonal and subdiagonal blocks.
*
CALL SLAORHR_COL_GETRFNP2( M-J+1, JB, A( J, J ), LDA,
$ D( J ), IINFO )
*
IF( J+JB.LE.N ) THEN
*
* 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
END DO
END IF
RETURN
*
* End of SLAORHR_COL_GETRFNP
*
END

305
lapack-netlib/SRC/slaorhr_col_getrfnp2.f Normal file
View File

@ -0,0 +1,305 @@
*> \brief \b SLAORHR_COL_GETRFNP2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DLAORHR_GETRF2NP + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaorhr_col_getrfnp2.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaorhr_col_getrfnp2.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaorhr_col_getrfnp2.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* RECURSIVE SUBROUTINE SLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO )
*
* .. Scalar Arguments ..
* INTEGER INFO, LDA, M, N
* ..
* .. Array Arguments ..
* REAL A( LDA, * ), D( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SLAORHR_COL_GETRFNP2 computes the modified LU factorization without
*> pivoting of a real general M-by-N matrix A. The factorization has
*> the form:
*>
*> A - S = L * U,
*>
*> where:
*> S is a m-by-n diagonal sign matrix with the diagonal D, so that
*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed
*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing
*> i-1 steps of Gaussian elimination. This means that the diagonal
*> element at each step of "modified" Gaussian elimination is at
*> least one in absolute value (so that division-by-zero not
*> possible during the division by the diagonal element);
*>
*> L is a M-by-N lower triangular matrix with unit diagonal elements
*> (lower trapezoidal if M > N);
*>
*> and U is a M-by-N upper triangular matrix
*> (upper trapezoidal if M < N).
*>
*> This routine is an auxiliary routine used in the Householder
*> reconstruction routine SORHR_COL. In SORHR_COL, this routine is
*> applied to an M-by-N matrix A with orthonormal columns, where each
*> element is bounded by one in absolute value. With the choice of
*> the matrix S above, one can show that the diagonal element at each
*> step of Gaussian elimination is the largest (in absolute value) in
*> the column on or below the diagonal, so that no pivoting is required
*> for numerical stability [1].
*>
*> For more details on the Householder reconstruction algorithm,
*> including the modified LU factorization, see [1].
*>
*> This is the recursive version of the LU factorization algorithm.
*> Denote A - S by B. The algorithm divides the matrix B into four
*> submatrices:
*>
*> [ B11 | B12 ] where B11 is n1 by n1,
*> B = [ -----|----- ] B21 is (m-n1) by n1,
*> [ B21 | B22 ] B12 is n1 by n2,
*> B22 is (m-n1) by n2,
*> with n1 = min(m,n)/2, n2 = n-n1.
*>
*>
*> The subroutine calls itself to factor B11, solves for B21,
*> solves for B12, updates B22, then calls itself to factor B22.
*>
*> For more details on the recursive LU algorithm, see [2].
*>
*> SLAORHR_COL_GETRFNP2 is called to factorize a block by the blocked
*> routine SLAORHR_COL_GETRFNP, which uses blocked code calling
*. Level 3 BLAS to update the submatrix. However, SLAORHR_COL_GETRFNP2
*> is self-sufficient and can be used without SLAORHR_COL_GETRFNP.
*>
*> [1] "Reconstructing Householder vectors from tall-skinny QR",
*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen,
*> E. Solomonik, J. Parallel Distrib. Comput.,
*> vol. 85, pp. 3-31, 2015.
*>
*> [2] "Recursion leads to automatic variable blocking for dense linear
*> algebra algorithms", F. Gustavson, IBM J. of Res. and Dev.,
*> vol. 41, no. 6, pp. 737-755, 1997.
*> \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-S=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] D
*> \verbatim
*> D is REAL array, dimension min(M,N)
*> The diagonal elements of the diagonal M-by-N sign matrix S,
*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can
*> be only plus or minus one.
*> \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 2019
*
*> \ingroup realGEcomputational
*
*> \par Contributors:
* ==================
*>
*> \verbatim
*>
*> November 2019, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
*> \endverbatim
*
* =====================================================================
RECURSIVE SUBROUTINE SLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO )
IMPLICIT NONE
*
* -- LAPACK computational routine (version 3.9.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2019
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
* ..
* .. Array Arguments ..
REAL A( LDA, * ), D( * )
* ..
*
* =====================================================================
*
* .. Parameters ..
REAL ONE
PARAMETER ( ONE = 1.0E+0 )
* ..
* .. Local Scalars ..
REAL SFMIN
INTEGER I, IINFO, N1, N2
* ..
* .. External Functions ..
REAL SLAMCH
EXTERNAL SLAMCH
* ..
* .. External Subroutines ..
EXTERNAL SGEMM, SSCAL, STRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, SIGN, 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( 'SLAORHR_COL_GETRFNP2', -INFO )
RETURN
END IF
*
* Quick return if possible
*
IF( MIN( M, N ).EQ.0 )
$ RETURN
IF ( M.EQ.1 ) THEN
*
* One row case, (also recursion termination case),
* use unblocked code
*
* Transfer the sign
*
D( 1 ) = -SIGN( ONE, A( 1, 1 ) )
*
* Construct the row of U
*
A( 1, 1 ) = A( 1, 1 ) - D( 1 )
*
ELSE IF( N.EQ.1 ) THEN
*
* One column case, (also recursion termination case),
* use unblocked code
*
* Transfer the sign
*
D( 1 ) = -SIGN( ONE, A( 1, 1 ) )
*
* Construct the row of U
*
A( 1, 1 ) = A( 1, 1 ) - D( 1 )
*
* Scale the elements 2:M of the column
*
* Determine machine safe minimum
*
SFMIN = SLAMCH('S')
*
* Construct the subdiagonal elements of L
*
IF( ABS( A( 1, 1 ) ) .GE. SFMIN ) THEN
CALL SSCAL( M-1, ONE / A( 1, 1 ), A( 2, 1 ), 1 )
ELSE
DO I = 2, M
A( I, 1 ) = A( I, 1 ) / A( 1, 1 )
END DO
END IF
*
ELSE
*
* Divide the matrix B into four submatrices
*
N1 = MIN( M, N ) / 2
N2 = N-N1
*
* Factor B11, recursive call
*
CALL SLAORHR_COL_GETRFNP2( N1, N1, A, LDA, D, IINFO )
*
* Solve for B21
*
CALL STRSM( 'R', 'U', 'N', 'N', M-N1, N1, ONE, A, LDA,
$ A( N1+1, 1 ), LDA )
*
* Solve for B12
*
CALL STRSM( 'L', 'L', 'N', 'U', N1, N2, ONE, A, LDA,
$ A( 1, N1+1 ), LDA )
*
* Update B22, i.e. compute the Schur complement
* B22 := B22 - B21*B12
*
CALL SGEMM( 'N', 'N', M-N1, N2, N1, -ONE, A( N1+1, 1 ), LDA,
$ A( 1, N1+1 ), LDA, ONE, A( N1+1, N1+1 ), LDA )
*
* Factor B22, recursive call
*
CALL SLAORHR_COL_GETRFNP2( M-N1, N2, A( N1+1, N1+1 ), LDA,
$ D( N1+1 ), IINFO )
*
END IF
RETURN
*
* End of SLAORHR_COL_GETRFNP2
*
END