[BACK]Return to zgsvj1.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zgsvj1.f between versions 1.3 and 1.4

version 1.3, 2016/08/27 15:34:48 version 1.4, 2017/06/17 10:54:13
Line 2 Line 2
 *  *
 *  =========== DOCUMENTATION ===========  *  =========== DOCUMENTATION ===========
 *  *
 * Online html documentation available at   * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/   *            http://www.netlib.org/lapack/explore-html/
 *  *
 *> \htmlonly  *> \htmlonly
 *> Download ZGSVJ1 + dependencies   *> Download ZGSVJ1 + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgsvj1.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgsvj1.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgsvj1.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgsvj1.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgsvj1.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgsvj1.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,  *       SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
 *                          EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )  *                          EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
 *   *
 *       .. Scalar Arguments ..  *       .. Scalar Arguments ..
 *       DOUBLE PRECISION   EPS, SFMIN, TOL  *       DOUBLE PRECISION   EPS, SFMIN, TOL
 *       INTEGER            INFO, LDA, LDV, LWORK, M, MV, N, N1, NSWEEP  *       INTEGER            INFO, LDA, LDV, LWORK, M, MV, N, N1, NSWEEP
 *       CHARACTER*1        JOBV  *       CHARACTER*1        JOBV
 *       ..  *       ..
 *       .. Array Arguments ..  *       .. Array Arguments ..
 *       COMPLEX*16     A( LDA, * ), D( N ), V( LDV, * ), WORK( LWORK )  *       COMPLEX*16         A( LDA, * ), D( N ), V( LDV, * ), WORK( LWORK )
 *       DOUBLE PRECISION           SVA( N )        *       DOUBLE PRECISION   SVA( N )
 *       ..  *       ..
 *    *
 *  *
 *> \par Purpose:  *> \par Purpose:
 *  =============  *  =============
Line 218 Line 218
 *  Authors:  *  Authors:
 *  ========  *  ========
 *  *
 *> \author Univ. of Tennessee   *> \author Univ. of Tennessee
 *> \author Univ. of California Berkeley   *> \author Univ. of California Berkeley
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.   *> \author NAG Ltd.
 *  *
 *> \date June 2016  *> \date June 2016
 *  *
 *> \ingroup complex16OTHERcomputational  *> \ingroup complex16OTHERcomputational
 *  *
 *> \par Contributors:  *> \par Contributor:
 *  ==================  *  ==================
 *>  *>
 *> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany)  *> Zlatko Drmac (Zagreb, Croatia)
 *  *
 *  =====================================================================  *  =====================================================================
       SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,        SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
      $                   EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )       $                   EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
 *  *
 *  -- LAPACK computational routine (version 3.6.1) --  *  -- LAPACK computational routine (version 3.7.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..--
 *     June 2016  *     June 2016
 *  *
       IMPLICIT NONE         IMPLICIT NONE
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       DOUBLE PRECISION   EPS, SFMIN, TOL        DOUBLE PRECISION   EPS, SFMIN, TOL
       INTEGER            INFO, LDA, LDV, LWORK, M, MV, N, N1, NSWEEP        INTEGER            INFO, LDA, LDV, LWORK, M, MV, N, N1, NSWEEP
Line 249 Line 249
 *     ..  *     ..
 *     .. Array Arguments ..  *     .. Array Arguments ..
       COMPLEX*16         A( LDA, * ), D( N ), V( LDV, * ), WORK( LWORK )        COMPLEX*16         A( LDA, * ), D( N ), V( LDV, * ), WORK( LWORK )
       DOUBLE PRECISION   SVA( N )         DOUBLE PRECISION   SVA( N )
 *     ..  *     ..
 *  *
 *  =====================================================================  *  =====================================================================
Line 261 Line 261
 *     .. Local Scalars ..  *     .. Local Scalars ..
       COMPLEX*16         AAPQ, OMPQ        COMPLEX*16         AAPQ, OMPQ
       DOUBLE PRECISION   AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG,        DOUBLE PRECISION   AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG,
      $                   BIGTHETA, CS, LARGE, MXAAPQ, MXSINJ, ROOTBIG,       $                   BIGTHETA, CS, MXAAPQ, MXSINJ, ROOTBIG,
      $                   ROOTEPS, ROOTSFMIN, ROOTTOL, SMALL, SN, T,       $                   ROOTEPS, ROOTSFMIN, ROOTTOL, SMALL, SN, T,
      $                   TEMP1, THETA, THSIGN       $                   TEMP1, THETA, THSIGN
       INTEGER            BLSKIP, EMPTSW, i, ibr, igl, IERR, IJBLSK,        INTEGER            BLSKIP, EMPTSW, i, ibr, igl, IERR, IJBLSK,
Line 271 Line 271
 *     ..  *     ..
 *     ..  *     ..
 *     .. Intrinsic Functions ..  *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DCONJG, DMAX1, DBLE, MIN0, DSIGN, DSQRT        INTRINSIC          ABS, CONJG, MAX, DBLE, MIN, SIGN, SQRT
 *     ..  *     ..
 *     .. External Functions ..  *     .. External Functions ..
       DOUBLE PRECISION   DZNRM2        DOUBLE PRECISION   DZNRM2
Line 281 Line 281
       EXTERNAL           IDAMAX, LSAME, ZDOTC, DZNRM2        EXTERNAL           IDAMAX, LSAME, ZDOTC, DZNRM2
 *     ..  *     ..
 *     .. External Subroutines ..  *     .. External Subroutines ..
 *     .. from BLAS        *     .. from BLAS
       EXTERNAL           ZCOPY, ZROT, ZSWAP        EXTERNAL           ZCOPY, ZROT, ZSWAP
 *     .. from LAPACK  *     .. from LAPACK
       EXTERNAL           ZLASCL, ZLASSQ, XERBLA        EXTERNAL           ZLASCL, ZLASSQ, XERBLA
Line 304 Line 304
          INFO = -6           INFO = -6
       ELSE IF( ( RSVEC.OR.APPLV ) .AND. ( MV.LT.0 ) ) THEN        ELSE IF( ( RSVEC.OR.APPLV ) .AND. ( MV.LT.0 ) ) THEN
          INFO = -9           INFO = -9
       ELSE IF( ( RSVEC.AND.( LDV.LT.N ) ).OR.         ELSE IF( ( RSVEC.AND.( LDV.LT.N ) ).OR.
      $         ( APPLV.AND.( LDV.LT.MV ) )  ) THEN       $         ( APPLV.AND.( LDV.LT.MV ) )  ) THEN
          INFO = -11           INFO = -11
       ELSE IF( TOL.LE.EPS ) THEN        ELSE IF( TOL.LE.EPS ) THEN
Line 330 Line 330
       END IF        END IF
       RSVEC = RSVEC .OR. APPLV        RSVEC = RSVEC .OR. APPLV
   
       ROOTEPS = DSQRT( EPS )        ROOTEPS = SQRT( EPS )
       ROOTSFMIN = DSQRT( SFMIN )        ROOTSFMIN = SQRT( SFMIN )
       SMALL = SFMIN / EPS        SMALL = SFMIN / EPS
       BIG = ONE / SFMIN        BIG = ONE / SFMIN
       ROOTBIG = ONE / ROOTSFMIN        ROOTBIG = ONE / ROOTSFMIN
       LARGE = BIG / DSQRT( DBLE( M*N ) )  *     LARGE = BIG / SQRT( DBLE( M*N ) )
       BIGTHETA = ONE / ROOTEPS        BIGTHETA = ONE / ROOTEPS
       ROOTTOL = DSQRT( TOL )        ROOTTOL = SQRT( TOL )
 *  *
 *     .. Initialize the right singular vector matrix ..  *     .. Initialize the right singular vector matrix ..
 *  *
Line 348 Line 348
 *  *
 *     .. Row-cyclic pivot strategy with de Rijk's pivoting ..  *     .. Row-cyclic pivot strategy with de Rijk's pivoting ..
 *  *
       KBL = MIN0( 8, N )        KBL = MIN( 8, N )
       NBLR = N1 / KBL        NBLR = N1 / KBL
       IF( ( NBLR*KBL ).NE.N1 )NBLR = NBLR + 1        IF( ( NBLR*KBL ).NE.N1 )NBLR = NBLR + 1
   
Line 359 Line 359
       BLSKIP = ( KBL**2 ) + 1        BLSKIP = ( KBL**2 ) + 1
 *[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL.  *[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL.
   
       ROWSKIP = MIN0( 5, KBL )        ROWSKIP = MIN( 5, KBL )
 *[TP] ROWSKIP is a tuning parameter.  *[TP] ROWSKIP is a tuning parameter.
       SWBAND = 0        SWBAND = 0
 *[TP] SWBAND is a tuning parameter. It is meaningful and effective  *[TP] SWBAND is a tuning parameter. It is meaningful and effective
Line 402 Line 402
             igl = ( ibr-1 )*KBL + 1              igl = ( ibr-1 )*KBL + 1
 *  *
 *            DO 2010 jbc = ibr + 1, NBL  *            DO 2010 jbc = ibr + 1, NBL
             DO 2010 jbc = 1, NBLC                  DO 2010 jbc = 1, NBLC
 *  *
                jgl = ( jbc-1 )*KBL + N1 + 1                 jgl = ( jbc-1 )*KBL + N1 + 1
 *  *
 *        doing the block at ( ibr, jbc )  *        doing the block at ( ibr, jbc )
 *  *
                IJBLSK = 0                 IJBLSK = 0
                DO 2100 p = igl, MIN0( igl+KBL-1, N1 )                 DO 2100 p = igl, MIN( igl+KBL-1, N1 )
 *  *
                   AAPP = SVA( p )                    AAPP = SVA( p )
                   IF( AAPP.GT.ZERO ) THEN                    IF( AAPP.GT.ZERO ) THEN
 *  *
                      PSKIPPED = 0                       PSKIPPED = 0
 *  *
                      DO 2200 q = jgl, MIN0( jgl+KBL-1, N )                       DO 2200 q = jgl, MIN( jgl+KBL-1, N )
 *  *
                         AAQQ = SVA( q )                          AAQQ = SVA( q )
                         IF( AAQQ.GT.ZERO ) THEN                          IF( AAQQ.GT.ZERO ) THEN
Line 433 Line 433
                                  ROTOK = ( SMALL*AAQQ ).LE.AAPP                                   ROTOK = ( SMALL*AAQQ ).LE.AAPP
                               END IF                                END IF
                               IF( AAPP.LT.( BIG / AAQQ ) ) THEN                                IF( AAPP.LT.( BIG / AAQQ ) ) THEN
                                  AAPQ = ( ZDOTC( M, A( 1, p ), 1,                                    AAPQ = ( ZDOTC( M, A( 1, p ), 1,
      $                                  A( 1, q ), 1 ) / AAQQ ) / AAPP       $                                  A( 1, q ), 1 ) / AAQQ ) / AAPP
                               ELSE                                ELSE
                                  CALL ZCOPY( M, A( 1, p ), 1,                                   CALL ZCOPY( M, A( 1, p ), 1,
Line 451 Line 451
                                  ROTOK = AAQQ.LE.( AAPP / SMALL )                                   ROTOK = AAQQ.LE.( AAPP / SMALL )
                               END IF                                END IF
                               IF( AAPP.GT.( SMALL / AAQQ ) ) THEN                                IF( AAPP.GT.( SMALL / AAQQ ) ) THEN
                                  AAPQ = ( ZDOTC( M, A( 1, p ), 1,                                    AAPQ = ( ZDOTC( M, A( 1, p ), 1,
      $                                   A( 1, q ), 1 ) / AAQQ ) / AAPP       $                                 A( 1, q ), 1 ) / MAX(AAQQ,AAPP) )
        $                                               / MIN(AAQQ,AAPP)
                               ELSE                                ELSE
                                  CALL ZCOPY( M, A( 1, q ), 1,                                   CALL ZCOPY( M, A( 1, q ), 1,
      $                                       WORK, 1 )       $                                       WORK, 1 )
Line 464 Line 465
                               END IF                                END IF
                            END IF                             END IF
 *  *
                            OMPQ = AAPQ / ABS(AAPQ)   *                           AAPQ = AAPQ * CONJG(CWORK(p))*CWORK(q)
 *                           AAPQ = AAPQ * DCONJG(CWORK(p))*CWORK(q)     
                            AAPQ1  = -ABS(AAPQ)                             AAPQ1  = -ABS(AAPQ)
                            MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )                             MXAAPQ = MAX( MXAAPQ, -AAPQ1 )
 *  *
 *        TO rotate or NOT to rotate, THAT is the question ...  *        TO rotate or NOT to rotate, THAT is the question ...
 *  *
                            IF( ABS( AAPQ1 ).GT.TOL ) THEN                             IF( ABS( AAPQ1 ).GT.TOL ) THEN
                                 OMPQ = AAPQ / ABS(AAPQ)
                               NOTROT = 0                                NOTROT = 0
 *[RTD]      ROTATED  = ROTATED + 1  *[RTD]      ROTATED  = ROTATED + 1
                               PSKIPPED = 0                                PSKIPPED = 0
Line 486 Line 487
 *  *
                                  IF( ABS( THETA ).GT.BIGTHETA ) THEN                                   IF( ABS( THETA ).GT.BIGTHETA ) THEN
                                     T  = HALF / THETA                                      T  = HALF / THETA
                                     CS = ONE                                       CS = ONE
                                     CALL ZROT( M, A(1,p), 1, A(1,q), 1,                                      CALL ZROT( M, A(1,p), 1, A(1,q), 1,
      $                                          CS, DCONJG(OMPQ)*T )       $                                          CS, CONJG(OMPQ)*T )
                                     IF( RSVEC ) THEN                                      IF( RSVEC ) THEN
                                         CALL ZROT( MVL, V(1,p), 1,                                           CALL ZROT( MVL, V(1,p), 1,
      $                                  V(1,q), 1, CS, DCONJG(OMPQ)*T )       $                                  V(1,q), 1, CS, CONJG(OMPQ)*T )
                                     END IF                                      END IF
                                     SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,                                      SVA( q ) = AAQQ*SQRT( MAX( ZERO,
      $                                         ONE+T*APOAQ*AAPQ1 ) )       $                                         ONE+T*APOAQ*AAPQ1 ) )
                                     AAPP = AAPP*DSQRT( DMAX1( ZERO,                                      AAPP = AAPP*SQRT( MAX( ZERO,
      $                                     ONE-T*AQOAP*AAPQ1 ) )       $                                     ONE-T*AQOAP*AAPQ1 ) )
                                     MXSINJ = DMAX1( MXSINJ, ABS( T ) )                                      MXSINJ = MAX( MXSINJ, ABS( T ) )
                                  ELSE                                   ELSE
 *  *
 *                 .. choose correct signum for THETA and rotate  *                 .. choose correct signum for THETA and rotate
 *  *
                                     THSIGN = -DSIGN( ONE, AAPQ1 )                                      THSIGN = -SIGN( ONE, AAPQ1 )
                                     IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN                                      IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN
                                     T = ONE / ( THETA+THSIGN*                                      T = ONE / ( THETA+THSIGN*
      $                                  DSQRT( ONE+THETA*THETA ) )       $                                  SQRT( ONE+THETA*THETA ) )
                                     CS = DSQRT( ONE / ( ONE+T*T ) )                                      CS = SQRT( ONE / ( ONE+T*T ) )
                                     SN = T*CS                                      SN = T*CS
                                     MXSINJ = DMAX1( MXSINJ, ABS( SN ) )                                      MXSINJ = MAX( MXSINJ, ABS( SN ) )
                                     SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,                                      SVA( q ) = AAQQ*SQRT( MAX( ZERO,
      $                                         ONE+T*APOAQ*AAPQ1 ) )       $                                         ONE+T*APOAQ*AAPQ1 ) )
                                     AAPP = AAPP*DSQRT( DMAX1( ZERO,                                        AAPP = AAPP*SQRT( MAX( ZERO,
      $                                         ONE-T*AQOAP*AAPQ1 ) )       $                                         ONE-T*AQOAP*AAPQ1 ) )
 *  *
                                     CALL ZROT( M, A(1,p), 1, A(1,q), 1,                                      CALL ZROT( M, A(1,p), 1, A(1,q), 1,
      $                                          CS, DCONJG(OMPQ)*SN )        $                                          CS, CONJG(OMPQ)*SN )
                                     IF( RSVEC ) THEN                                      IF( RSVEC ) THEN
                                         CALL ZROT( MVL, V(1,p), 1,                                           CALL ZROT( MVL, V(1,p), 1,
      $                                  V(1,q), 1, CS, DCONJG(OMPQ)*SN )       $                                  V(1,q), 1, CS, CONJG(OMPQ)*SN )
                                     END IF                                      END IF
                                  END IF                                   END IF
                                  D(p) = -D(q) * OMPQ                                   D(p) = -D(q) * OMPQ
Line 539 Line 540
                                     CALL ZLASCL( 'G', 0, 0, ONE, AAQQ,                                      CALL ZLASCL( 'G', 0, 0, ONE, AAQQ,
      $                                           M, 1, A( 1, q ), LDA,       $                                           M, 1, A( 1, q ), LDA,
      $                                           IERR )       $                                           IERR )
                                     SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,                                      SVA( q ) = AAQQ*SQRT( MAX( ZERO,
      $                                         ONE-AAPQ1*AAPQ1 ) )       $                                         ONE-AAPQ1*AAPQ1 ) )
                                     MXSINJ = DMAX1( MXSINJ, SFMIN )                                      MXSINJ = MAX( MXSINJ, SFMIN )
                                ELSE                                 ELSE
                                    CALL ZCOPY( M, A( 1, q ), 1,                                     CALL ZCOPY( M, A( 1, q ), 1,
      $                                          WORK, 1 )       $                                          WORK, 1 )
Line 551 Line 552
                                     CALL ZLASCL( 'G', 0, 0, AAPP, ONE,                                      CALL ZLASCL( 'G', 0, 0, AAPP, ONE,
      $                                           M, 1, A( 1, p ), LDA,       $                                           M, 1, A( 1, p ), LDA,
      $                                           IERR )       $                                           IERR )
                                     CALL ZAXPY( M, -DCONJG(AAPQ),                                       CALL ZAXPY( M, -CONJG(AAPQ),
      $                                   WORK, 1, A( 1, p ), 1 )       $                                   WORK, 1, A( 1, p ), 1 )
                                     CALL ZLASCL( 'G', 0, 0, ONE, AAPP,                                      CALL ZLASCL( 'G', 0, 0, ONE, AAPP,
      $                                           M, 1, A( 1, p ), LDA,       $                                           M, 1, A( 1, p ), LDA,
      $                                           IERR )       $                                           IERR )
                                     SVA( p ) = AAPP*DSQRT( DMAX1( ZERO,                                      SVA( p ) = AAPP*SQRT( MAX( ZERO,
      $                                         ONE-AAPQ1*AAPQ1 ) )       $                                         ONE-AAPQ1*AAPQ1 ) )
                                     MXSINJ = DMAX1( MXSINJ, SFMIN )                                      MXSINJ = MAX( MXSINJ, SFMIN )
                                END IF                                 END IF
                               END IF                                END IF
 *           END IF ROTOK THEN ... ELSE  *           END IF ROTOK THEN ... ELSE
Line 575 Line 576
                                     AAQQ = ONE                                      AAQQ = ONE
                                     CALL ZLASSQ( M, A( 1, q ), 1, T,                                      CALL ZLASSQ( M, A( 1, q ), 1, T,
      $                                           AAQQ )       $                                           AAQQ )
                                     SVA( q ) = T*DSQRT( AAQQ )                                      SVA( q ) = T*SQRT( AAQQ )
                                  END IF                                   END IF
                               END IF                                END IF
                               IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN                                IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN
Line 587 Line 588
                                     AAPP = ONE                                      AAPP = ONE
                                     CALL ZLASSQ( M, A( 1, p ), 1, T,                                      CALL ZLASSQ( M, A( 1, p ), 1, T,
      $                                           AAPP )       $                                           AAPP )
                                     AAPP = T*DSQRT( AAPP )                                      AAPP = T*SQRT( AAPP )
                                  END IF                                   END IF
                                  SVA( p ) = AAPP                                   SVA( p ) = AAPP
                               END IF                                END IF
Line 626 Line 627
                   ELSE                    ELSE
 *  *
                      IF( AAPP.EQ.ZERO )NOTROT = NOTROT +                       IF( AAPP.EQ.ZERO )NOTROT = NOTROT +
      $                   MIN0( jgl+KBL-1, N ) - jgl + 1       $                   MIN( jgl+KBL-1, N ) - jgl + 1
                      IF( AAPP.LT.ZERO )NOTROT = 0                       IF( AAPP.LT.ZERO )NOTROT = 0
 *  *
                   END IF                    END IF
Line 637 Line 638
 *     end of the jbc-loop  *     end of the jbc-loop
  2011       CONTINUE   2011       CONTINUE
 *2011 bailed out of the jbc-loop  *2011 bailed out of the jbc-loop
             DO 2012 p = igl, MIN0( igl+KBL-1, N )              DO 2012 p = igl, MIN( igl+KBL-1, N )
                SVA( p ) = ABS( SVA( p ) )                 SVA( p ) = ABS( SVA( p ) )
  2012       CONTINUE   2012       CONTINUE
 ***  ***
Line 652 Line 653
             T = ZERO              T = ZERO
             AAPP = ONE              AAPP = ONE
             CALL ZLASSQ( M, A( 1, N ), 1, T, AAPP )              CALL ZLASSQ( M, A( 1, N ), 1, T, AAPP )
             SVA( N ) = T*DSQRT( AAPP )              SVA( N ) = T*SQRT( AAPP )
          END IF           END IF
 *  *
 *     Additional steering devices  *     Additional steering devices
Line 660 Line 661
          IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.           IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
      $       ( ISWROT.LE.N ) ) )SWBAND = i       $       ( ISWROT.LE.N ) ) )SWBAND = i
 *  *
          IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )*           IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.SQRT( DBLE( N ) )*
      $       TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN       $       TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
             GO TO 1994              GO TO 1994
          END IF           END IF
Removed from v.1.3  
changed lines
  Added in v.1.4

CVSweb interface <joel.bertrand@systella.fr>