Mercurial > octave-nkf

comparison libcruft/lapack/zungbr.f @ 3333:15cddaacbc2d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1999-11-03 19:53:59 by jwe]
author jwe
date Wed, 03 Nov 1999 19:54:52 +0000
parents 30c606bec7a8
children 68db500cb558
comparison
equal deleted inserted replaced
3332:7c03933635c6 3333:15cddaacbc2d
1 SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) 1 SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
2 * 2 *
3 * -- LAPACK routine (version 2.0) -- 3 * -- LAPACK routine (version 3.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5 * Courant Institute, Argonne National Lab, and Rice University 5 * Courant Institute, Argonne National Lab, and Rice University
6 * September 30, 1994 6 * June 30, 1999
7 * 7 *
8 * .. Scalar Arguments .. 8 * .. Scalar Arguments ..
9 CHARACTER VECT 9 CHARACTER VECT
10 INTEGER INFO, K, LDA, LWORK, M, N 10 INTEGER INFO, K, LDA, LWORK, M, N
11 * .. 11 * ..
12 * .. Array Arguments .. 12 * .. Array Arguments ..
13 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( LWORK ) 13 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
14 * .. 14 * ..
15 * 15 *
16 * Purpose 16 * Purpose
17 * ======= 17 * =======
18 * 18 *
82 * LWORK (input) INTEGER 82 * LWORK (input) INTEGER
83 * The dimension of the array WORK. LWORK >= max(1,min(M,N)). 83 * The dimension of the array WORK. LWORK >= max(1,min(M,N)).
84 * For optimum performance LWORK >= min(M,N)*NB, where NB 84 * For optimum performance LWORK >= min(M,N)*NB, where NB
85 * is the optimal blocksize. 85 * is the optimal blocksize.
86 * 86 *
87 * If LWORK = -1, then a workspace query is assumed; the routine
88 * only calculates the optimal size of the WORK array, returns
89 * this value as the first entry of the WORK array, and no error
90 * message related to LWORK is issued by XERBLA.
91 *
87 * INFO (output) INTEGER 92 * INFO (output) INTEGER
88 * = 0: successful exit 93 * = 0: successful exit
89 * < 0: if INFO = -i, the i-th argument had an illegal value 94 * < 0: if INFO = -i, the i-th argument had an illegal value
90 * 95 *
91 * ===================================================================== 96 * =====================================================================
94 COMPLEX*16 ZERO, ONE 99 COMPLEX*16 ZERO, ONE
95 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), 100 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
96 $ ONE = ( 1.0D+0, 0.0D+0 ) ) 101 $ ONE = ( 1.0D+0, 0.0D+0 ) )
97 * .. 102 * ..
98 * .. Local Scalars .. 103 * .. Local Scalars ..
99 LOGICAL WANTQ 104 LOGICAL LQUERY, WANTQ
100 INTEGER I, IINFO, J 105 INTEGER I, IINFO, J, LWKOPT, MN, NB
101 * .. 106 * ..
102 * .. External Functions .. 107 * .. External Functions ..
103 LOGICAL LSAME 108 LOGICAL LSAME
104 EXTERNAL LSAME 109 INTEGER ILAENV
110 EXTERNAL LSAME, ILAENV
105 * .. 111 * ..
106 * .. External Subroutines .. 112 * .. External Subroutines ..
107 EXTERNAL XERBLA, ZUNGLQ, ZUNGQR 113 EXTERNAL XERBLA, ZUNGLQ, ZUNGQR
108 * .. 114 * ..
109 * .. Intrinsic Functions .. 115 * .. Intrinsic Functions ..
113 * 119 *
114 * Test the input arguments 120 * Test the input arguments
115 * 121 *
116 INFO = 0 122 INFO = 0
117 WANTQ = LSAME( VECT, 'Q' ) 123 WANTQ = LSAME( VECT, 'Q' )
124 MN = MIN( M, N )
125 LQUERY = ( LWORK.EQ.-1 )
118 IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN 126 IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
119 INFO = -1 127 INFO = -1
120 ELSE IF( M.LT.0 ) THEN 128 ELSE IF( M.LT.0 ) THEN
121 INFO = -2 129 INFO = -2
122 ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M, 130 ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
125 INFO = -3 133 INFO = -3
126 ELSE IF( K.LT.0 ) THEN 134 ELSE IF( K.LT.0 ) THEN
127 INFO = -4 135 INFO = -4
128 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN 136 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
129 INFO = -6 137 INFO = -6
130 ELSE IF( LWORK.LT.MAX( 1, MIN( M, N ) ) ) THEN 138 ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
131 INFO = -9 139 INFO = -9
132 END IF 140 END IF
141 *
142 IF( INFO.EQ.0 ) THEN
143 IF( WANTQ ) THEN
144 NB = ILAENV( 1, 'ZUNGQR', ' ', M, N, K, -1 )
145 ELSE
146 NB = ILAENV( 1, 'ZUNGLQ', ' ', M, N, K, -1 )
147 END IF
148 LWKOPT = MAX( 1, MN )*NB
149 WORK( 1 ) = LWKOPT
150 END IF
151 *
133 IF( INFO.NE.0 ) THEN 152 IF( INFO.NE.0 ) THEN
134 CALL XERBLA( 'ZUNGBR', -INFO ) 153 CALL XERBLA( 'ZUNGBR', -INFO )
154 RETURN
155 ELSE IF( LQUERY ) THEN
135 RETURN 156 RETURN
136 END IF 157 END IF
137 * 158 *
138 * Quick return if possible 159 * Quick return if possible
139 * 160 *
215 CALL ZUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK, 236 CALL ZUNGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
216 $ LWORK, IINFO ) 237 $ LWORK, IINFO )
217 END IF 238 END IF
218 END IF 239 END IF
219 END IF 240 END IF
241 WORK( 1 ) = LWKOPT
220 RETURN 242 RETURN
221 * 243 *
222 * End of ZUNGBR 244 * End of ZUNGBR
223 * 245 *
224 END 246 END