~ubuntu-branches/ubuntu/maverick/openturns/maverick

« back to all changes in this revision

Viewing changes to lib/src/BlasLapack/dlaqr3.f

  • Committer: Bazaar Package Importer
  • Author(s): Fabrice Coutadeur
  • Date: 2010-05-10 17:27:55 UTC
  • mfrom: (1.1.4 upstream) (5.1.5 sid)
  • Revision ID: james.westby@ubuntu.com-20100510172755-cb5ynskknqqi5rhp
Tags: 0.13.2-2ubuntu1
* Merge with Debian testing. No changes left.
* ubuntu_fix-python-2.6.patch: fix detection of python 2.6 libs, to not use
  LOCALMODLIBS. This pulls a dependency on SSL and makes the package FTBFS.

Show diffs side-by-side

added added

removed removed

Lines of Context:
2
2
     $                   IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
3
3
     $                   LDT, NV, WV, LDWV, WORK, LWORK )
4
4
*
5
 
*  -- LAPACK auxiliary routine (version 3.1) --
6
 
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7
 
*     November 2006
 
5
*  -- LAPACK auxiliary routine (version 3.2.1)                        --
 
6
*     Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
 
7
*  -- April 2009                                                      --
8
8
*
9
9
*     .. Scalar Arguments ..
10
10
      INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
78
78
*          Specify the rows of Z to which transformations must be
79
79
*          applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
80
80
*
81
 
*     Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,IHI)
 
81
*     Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
82
82
*          IF WANTZ is .TRUE., then on output, the orthogonal
83
83
*          similarity transformation mentioned above has been
84
84
*          accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
153
153
*        Karen Braman and Ralph Byers, Department of Mathematics,
154
154
*        University of Kansas, USA
155
155
*
156
 
*     ==================================================================
 
156
*     ================================================================
157
157
*     .. Parameters ..
158
158
      DOUBLE PRECISION   ZERO, ONE
159
159
      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0 )
173
173
*     ..
174
174
*     .. External Subroutines ..
175
175
      EXTERNAL           DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR,
176
 
     $                   DLANV2, DLAQR4, DLARF, DLARFG, DLASET, DORGHR,
 
176
     $                   DLANV2, DLAQR4, DLARF, DLARFG, DLASET, DORMHR,
177
177
     $                   DTREXC
178
178
*     ..
179
179
*     .. Intrinsic Functions ..
193
193
         CALL DGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
194
194
         LWK1 = INT( WORK( 1 ) )
195
195
*
196
 
*        ==== Workspace query call to DORGHR ====
 
196
*        ==== Workspace query call to DORMHR ====
197
197
*
198
 
         CALL DORGHR( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
 
198
         CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
 
199
     $                WORK, -1, INFO )
199
200
         LWK2 = INT( WORK( 1 ) )
200
201
*
201
202
*        ==== Workspace query call to DLAQR4 ====
220
221
*     ... for an empty active block ... ====
221
222
      NS = 0
222
223
      ND = 0
 
224
      WORK( 1 ) = ONE
223
225
      IF( KTOP.GT.KBOT )
224
226
     $   RETURN
225
227
*     ... nor for an empty deflation window. ====
259
261
            IF( KWTOP.GT.KTOP )
260
262
     $         H( KWTOP, KWTOP-1 ) = ZERO
261
263
         END IF
 
264
         WORK( 1 ) = ONE
262
265
         RETURN
263
266
      END IF
264
267
*
342
345
               NS = NS - 2
343
346
            ELSE
344
347
*
345
 
*              ==== Undflatable. Move them up out of the way.
 
348
*              ==== Undeflatable. Move them up out of the way.
346
349
*              .    Fortunately, DTREXC does the right thing with
347
350
*              .    ILST in case of a rare exchange failure. ====
348
351
*
488
491
     $               LDH+1 )
489
492
*
490
493
*        ==== Accumulate orthogonal matrix in order update
491
 
*        .    H and Z, if requested.  (A modified version
492
 
*        .    of  DORGHR that accumulates block Householder
493
 
*        .    transformations into V directly might be
494
 
*        .    marginally more efficient than the following.) ====
 
494
*        .    H and Z, if requested.  ====
495
495
*
496
 
         IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
497
 
            CALL DORGHR( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
498
 
     $                   LWORK-JW, INFO )
499
 
            CALL DGEMM( 'N', 'N', JW, NS, NS, ONE, V, LDV, T, LDT, ZERO,
500
 
     $                  WV, LDWV )
501
 
            CALL DLACPY( 'A', JW, NS, WV, LDWV, V, LDV )
502
 
         END IF
 
496
         IF( NS.GT.1 .AND. S.NE.ZERO )
 
497
     $      CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
 
498
     $                   WORK( JW+1 ), LWORK-JW, INFO )
503
499
*
504
500
*        ==== Update vertical slab in H ====
505
501
*