00001 SUBROUTINE SGEQRF ( M, N, A, LDA, TAU, WORK, LWORK, INFO )
00002
00003
00004
00005
00006
00007
00008 INTEGER INFO, LDA, LWORK, M, N
00009
00010
00011 REAL A( LDA, * ), TAU( * ), WORK( * )
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094 LOGICAL LQUERY
00095 INTEGER I, IB, IINFO, IWS, J, K, LWKOPT, NB,
00096 $ NBMIN, NX, LBWORK, NT, LLWORK
00097
00098
00099 EXTERNAL SGEQR2, SLARFB, SLARFT, XERBLA
00100
00101
00102 INTRINSIC MAX, MIN
00103
00104
00105 INTEGER ILAENV
00106 REAL SCEIL
00107 EXTERNAL ILAENV, SCEIL
00108
00109
00110
00111 INFO = 0
00112 NBMIN = 2
00113 NX = 0
00114 IWS = N
00115 K = MIN( M, N )
00116 NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
00117
00118 IF( NB.GT.1 .AND. NB.LT.K ) THEN
00119
00120
00121
00122 NX = MAX( 0, ILAENV( 3, 'SGEQRF', ' ', M, N, -1, -1 ) )
00123 END IF
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135 NT = K-SCEIL(REAL(K-NX)/REAL(NB))*NB
00136
00137
00138
00139
00140 LLWORK = MAX (MAX((N-M)*K, (N-M)*NB), MAX(K*NB, NB*NB))
00141 LLWORK = SCEIL(REAL(LLWORK)/REAL(NB))
00142
00143 IF ( NT.GT.NB ) THEN
00144
00145 LBWORK = K-NT
00146
00147
00148
00149 LWKOPT = (LBWORK+LLWORK)*NB
00150 WORK( 1 ) = (LWKOPT+NT*NT)
00151
00152 ELSE
00153
00154 LBWORK = SCEIL(REAL(K)/REAL(NB))*NB
00155 LWKOPT = (LBWORK+LLWORK-NB)*NB
00156 WORK( 1 ) = LWKOPT
00157
00158 END IF
00159
00160
00161
00162
00163 LQUERY = ( LWORK.EQ.-1 )
00164 IF( M.LT.0 ) THEN
00165 INFO = -1
00166 ELSE IF( N.LT.0 ) THEN
00167 INFO = -2
00168 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
00169 INFO = -4
00170 ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
00171 INFO = -7
00172 END IF
00173 IF( INFO.NE.0 ) THEN
00174 CALL XERBLA( 'SGEQRF', -INFO )
00175 RETURN
00176 ELSE IF( LQUERY ) THEN
00177 RETURN
00178 END IF
00179
00180
00181
00182 IF( K.EQ.0 ) THEN
00183 WORK( 1 ) = 1
00184 RETURN
00185 END IF
00186
00187 IF( NB.GT.1 .AND. NB.LT.K ) THEN
00188
00189 IF( NX.LT.K ) THEN
00190
00191
00192
00193 IF ( NT.LE.NB ) THEN
00194 IWS = (LBWORK+LLWORK-NB)*NB
00195 ELSE
00196 IWS = (LBWORK+LLWORK)*NB+NT*NT
00197 END IF
00198
00199 IF( LWORK.LT.IWS ) THEN
00200
00201
00202
00203
00204 IF ( NT.LE.NB ) THEN
00205 NB = LWORK / (LLWORK+(LBWORK-NB))
00206 ELSE
00207 NB = (LWORK-NT*NT)/(LBWORK+LLWORK)
00208 END IF
00209
00210 NBMIN = MAX( 2, ILAENV( 2, 'SGEQRF', ' ', M, N, -1,
00211 $ -1 ) )
00212 END IF
00213 END IF
00214 END IF
00215
00216 IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
00217
00218
00219
00220 DO 10 I = 1, K - NX, NB
00221 IB = MIN( K-I+1, NB )
00222
00223
00224
00225 DO 20 J = 1, I - NB, NB
00226
00227
00228
00229 CALL SLARFB( 'Left', 'Transpose', 'Forward',
00230 $ 'Columnwise', M-J+1, IB, NB,
00231 $ A( J, J ), LDA, WORK(J), LBWORK,
00232 $ A( J, I ), LDA, WORK(LBWORK*NB+NT*NT+1),
00233 $ IB)
00234
00235 20 CONTINUE
00236
00237
00238
00239
00240 CALL SGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ),
00241 $ WORK(LBWORK*NB+NT*NT+1), IINFO )
00242
00243 IF( I+IB.LE.N ) THEN
00244
00245
00246
00247
00248 CALL SLARFT( 'Forward', 'Columnwise', M-I+1, IB,
00249 $ A( I, I ), LDA, TAU( I ),
00250 $ WORK(I), LBWORK )
00251
00252 END IF
00253 10 CONTINUE
00254 ELSE
00255 I = 1
00256 END IF
00257
00258
00259
00260 IF( I.LE.K ) THEN
00261
00262 IF ( I .NE. 1 ) THEN
00263
00264 DO 30 J = 1, I - NB, NB
00265
00266
00267
00268 CALL SLARFB( 'Left', 'Transpose', 'Forward',
00269 $ 'Columnwise', M-J+1, K-I+1, NB,
00270 $ A( J, J ), LDA, WORK(J), LBWORK,
00271 $ A( J, I ), LDA, WORK(LBWORK*NB+NT*NT+1),
00272 $ K-I+1)
00273 30 CONTINUE
00274
00275 CALL SGEQR2( M-I+1, K-I+1, A( I, I ), LDA, TAU( I ),
00276 $ WORK(LBWORK*NB+NT*NT+1),IINFO )
00277
00278 ELSE
00279
00280
00281
00282 CALL SGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ),
00283 $ WORK,IINFO )
00284
00285 END IF
00286 END IF
00287
00288
00289
00290
00291
00292 IF ( M.LT.N .AND. I.NE.1) THEN
00293
00294
00295
00296
00297 IF ( NT .LE. NB ) THEN
00298 CALL SLARFT( 'Forward', 'Columnwise', M-I+1, K-I+1,
00299 $ A( I, I ), LDA, TAU( I ), WORK(I), LBWORK )
00300 ELSE
00301 CALL SLARFT( 'Forward', 'Columnwise', M-I+1, K-I+1,
00302 $ A( I, I ), LDA, TAU( I ),
00303 $ WORK(LBWORK*NB+1), NT )
00304 END IF
00305
00306
00307
00308
00309 DO 40 J = 1, K-NX, NB
00310
00311 IB = MIN( K-J+1, NB )
00312
00313 CALL SLARFB( 'Left', 'Transpose', 'Forward',
00314 $ 'Columnwise', M-J+1, N-M, IB,
00315 $ A( J, J ), LDA, WORK(J), LBWORK,
00316 $ A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
00317 $ N-M)
00318
00319 40 CONTINUE
00320
00321 IF ( NT.LE.NB ) THEN
00322 CALL SLARFB( 'Left', 'Transpose', 'Forward',
00323 $ 'Columnwise', M-J+1, N-M, K-J+1,
00324 $ A( J, J ), LDA, WORK(J), LBWORK,
00325 $ A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
00326 $ N-M)
00327 ELSE
00328 CALL SLARFB( 'Left', 'Transpose', 'Forward',
00329 $ 'Columnwise', M-J+1, N-M, K-J+1,
00330 $ A( J, J ), LDA,
00331 $ WORK(LBWORK*NB+1),
00332 $ NT, A( J, M+1 ), LDA, WORK(LBWORK*NB+NT*NT+1),
00333 $ N-M)
00334 END IF
00335
00336 END IF
00337
00338 WORK( 1 ) = IWS
00339 RETURN
00340
00341
00342
00343 END