📄 lapacksubs.f
字号:
NB = 1 ELSE NB = 32 END IF ELSE IF( N4.LE.64 ) THEN NB = 1 ELSE NB = 32 END IF END IF END IF ELSE IF( C2.EQ.'PB' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN IF( N2.LE.64 ) THEN NB = 1 ELSE NB = 32 END IF ELSE IF( N2.LE.64 ) THEN NB = 1 ELSE NB = 32 END IF END IF END IF ELSE IF( C2.EQ.'TR' ) THEN IF( C3.EQ.'TRI' ) THEN IF( SNAME ) THEN NB = 64 ELSE NB = 64 END IF END IF ELSE IF( C2.EQ.'LA' ) THEN IF( C3.EQ.'UUM' ) THEN IF( SNAME ) THEN NB = 64 ELSE NB = 64 END IF END IF ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN IF( C3.EQ.'EBZ' ) THEN NB = 1 END IF END IF ILAENV = NB RETURN* 200 CONTINUE** ISPEC = 2: minimum block size* NBMIN = 2 IF( C2.EQ.'GE' ) THEN IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. $ C3.EQ.'QLF' ) THEN IF( SNAME ) THEN NBMIN = 2 ELSE NBMIN = 2 END IF ELSE IF( C3.EQ.'HRD' ) THEN IF( SNAME ) THEN NBMIN = 2 ELSE NBMIN = 2 END IF ELSE IF( C3.EQ.'BRD' ) THEN IF( SNAME ) THEN NBMIN = 2 ELSE NBMIN = 2 END IF ELSE IF( C3.EQ.'TRI' ) THEN IF( SNAME ) THEN NBMIN = 2 ELSE NBMIN = 2 END IF END IF ELSE IF( C2.EQ.'SY' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN NBMIN = 8 ELSE NBMIN = 8 END IF ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN NBMIN = 2 END IF ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN IF( C3.EQ.'TRD' ) THEN NBMIN = 2 END IF ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NBMIN = 2 END IF ELSE IF( C3( 1:1 ).EQ.'M' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NBMIN = 2 END IF END IF ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NBMIN = 2 END IF ELSE IF( C3( 1:1 ).EQ.'M' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NBMIN = 2 END IF END IF END IF ILAENV = NBMIN RETURN* 300 CONTINUE** ISPEC = 3: crossover point* NX = 0 IF( C2.EQ.'GE' ) THEN IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. $ C3.EQ.'QLF' ) THEN IF( SNAME ) THEN NX = 128 ELSE NX = 128 END IF ELSE IF( C3.EQ.'HRD' ) THEN IF( SNAME ) THEN NX = 128 ELSE NX = 128 END IF ELSE IF( C3.EQ.'BRD' ) THEN IF( SNAME ) THEN NX = 128 ELSE NX = 128 END IF END IF ELSE IF( C2.EQ.'SY' ) THEN IF( SNAME .AND. C3.EQ.'TRD' ) THEN NX = 32 END IF ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN IF( C3.EQ.'TRD' ) THEN NX = 32 END IF ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NX = 128 END IF END IF ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NX = 128 END IF END IF END IF ILAENV = NX RETURN* 400 CONTINUE** ISPEC = 4: number of shifts (used by xHSEQR)* ILAENV = 6 RETURN* 500 CONTINUE** ISPEC = 5: minimum column dimension (not used)* ILAENV = 2 RETURN* 600 CONTINUE ** ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)* ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 ) RETURN* 700 CONTINUE** ISPEC = 7: number of processors (not used)* ILAENV = 1 RETURN* 800 CONTINUE** ISPEC = 8: crossover point for multishift (used by xHSEQR)* ILAENV = 50 RETURN* 900 CONTINUE** ISPEC = 9: maximum size of the subproblems at the bottom of the* computation tree in the divide-and-conquer algorithm* (used by xGELSD and xGESDD)* ILAENV = 25 RETURN* 1000 CONTINUE** ISPEC = 10: ieee NaN arithmetic can be trusted not to trap*C ILAENV = 0 ILAENV = 1 IF( ILAENV.EQ.1 ) THEN ILAENV = IEEECK( 0, 0.0, 1.0 ) END IF RETURN* 1100 CONTINUE** ISPEC = 11: infinity arithmetic can be trusted not to trap*C ILAENV = 0 ILAENV = 1 IF( ILAENV.EQ.1 ) THEN ILAENV = IEEECK( 1, 0.0, 1.0 ) END IF RETURN** End of ILAENV* END SUBROUTINE SGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, $ INFO )** -- LAPACK routine (version 3.0) --* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,* Courant Institute, Argonne National Lab, and Rice University* September 30, 1994** .. Scalar Arguments .. CHARACTER JOB, SIDE INTEGER IHI, ILO, INFO, LDV, M, N* ..* .. Array Arguments .. REAL V( LDV, * ), SCALE( * )* ..** Purpose* =======** SGEBAK forms the right or left eigenvectors of a real general matrix* by backward transformation on the computed eigenvectors of the* balanced matrix output by SGEBAL.** Arguments* =========** JOB (input) CHARACTER*1* Specifies the type of backward transformation required:* = 'N', do nothing, return immediately;* = 'P', do backward transformation for permutation only;* = 'S', do backward transformation for scaling only;* = 'B', do backward transformations for both permutation and* scaling.* JOB must be the same as the argument JOB supplied to SGEBAL.** SIDE (input) CHARACTER*1* = 'R': V contains right eigenvectors;* = 'L': V contains left eigenvectors.** N (input) INTEGER* The number of rows of the matrix V. N >= 0.** ILO (input) INTEGER* IHI (input) INTEGER* The integers ILO and IHI determined by SGEBAL.* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.** SCALE (input) REAL array, dimension (N)* Details of the permutation and scaling factors, as returned* by SGEBAL.** M (input) INTEGER* The number of columns of the matrix V. M >= 0.** V (input/output) REAL array, dimension (LDV,M)* On entry, the matrix of right or left eigenvectors to be* transformed, as returned by SHSEIN or STREVC.* On exit, V is overwritten by the transformed eigenvectors.** LDV (input) INTEGER* The leading dimension of the array V. LDV >= max(1,N).** INFO (output) INTEGER* = 0: successful exit* < 0: if INFO = -i, the i-th argument had an illegal value.** =====================================================================** .. Parameters .. REAL ONE PARAMETER ( ONE = 1.0E+0 )* ..* .. Local Scalars .. LOGICAL LEFTV, RIGHTV INTEGER I, II, K REAL S* ..* .. External Functions .. LOGICAL LSAME EXTERNAL LSAME* ..* .. External Subroutines .. EXTERNAL SSCAL, SSWAP, XERBLA* ..* .. Intrinsic Functions .. INTRINSIC MAX* ..* .. Executable Statements ..** Decode and Test the input parameters* RIGHTV = LSAME( SIDE, 'R' ) LEFTV = LSAME( SIDE, 'L' )* INFO = 0 IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN INFO = -4 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN INFO = -5 ELSE IF( M.LT.0 ) THEN INFO = -7 ELSE IF( LDV.LT.MAX( 1, N ) ) THEN INFO = -9 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'SGEBAK', -INFO ) RETURN END IF** Quick return if possible* IF( N.EQ.0 ) $ RETURN IF( M.EQ.0 ) $ RETURN IF( LSAME( JOB, 'N' ) ) $ RETURN* IF( ILO.EQ.IHI ) $ GO TO 30** Backward balance* IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN* IF( RIGHTV ) THEN DO 10 I = ILO, IHI S = SCALE( I ) CALL SSCAL( M, S, V( I, 1 ), LDV ) 10 CONTINUE END IF* IF( LEFTV ) THEN DO 20 I = ILO, IHI S = ONE / SCALE( I ) CALL SSCAL( M, S, V( I, 1 ), LDV ) 20 CONTINUE END IF* END IF** Backward permutation** For I = ILO-1 step -1 until 1,* IHI+1 step 1 until N do --* 30 CONTINUE IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN IF( RIGHTV ) THEN DO 40 II = 1, N I = II IF( I.GE.ILO .AND. I.LE.IHI ) $ GO TO 40 IF( I.LT.ILO ) $ I = ILO - II K = SCALE( I ) IF( K.EQ.I ) $ GO TO 40 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 40 CONTINUE END IF* IF( LEFTV ) THEN DO 50 II = 1, N I = II IF( I.GE.ILO .AND. I.LE.IHI )⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -