Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
41 changes: 25 additions & 16 deletions lapack-netlib/SRC/claqz0.f
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,13 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CLAQZ0 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/CLAQZ0.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/CLAQZ0.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/CLAQZ0.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -274,10 +272,11 @@
*
*> \date May 2020
*
*> \ingroup complexGEcomputational
*> \ingroup laqz0
*>
* =====================================================================
RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI,
$ A,
$ LDA, B, LDB, ALPHA, BETA, Q, LDQ, Z,
$ LDZ, WORK, LWORK, RWORK, REC,
$ INFO )
Expand Down Expand Up @@ -412,12 +411,14 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
NSR = MAX( 2, NSR-MOD( NSR, 2 ) )

RCOST = ILAENV( 17, 'CLAQZ0', JBCMPZ, N, ILO, IHI, LWORK )
ITEMP1 = INT( NSR/SQRT( 1+2*NSR/( REAL( RCOST )/100*N ) ) )
ITEMP1 = INT( REAL( NSR )/SQRT( 1+2*REAL( NSR )/
$ ( REAL( RCOST )/100*REAL( N ) ) ) )
ITEMP1 = ( ( ITEMP1-1 )/4 )*4+4
NBR = NSR+ITEMP1

IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN
CALL CHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB,
CALL CHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B,
$ LDB,
$ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK,
$ INFO )
RETURN
Expand All @@ -429,7 +430,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,

* Workspace query to CLAQZ2
NW = MAX( NWR, NMIN )
CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB,
CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B,
$ LDB,
$ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHA,
$ BETA, WORK, NW, WORK, NW, WORK, -1, RWORK, REC,
$ AED_INFO )
Expand All @@ -445,10 +447,10 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
WORK( 1 ) = REAL( LWORKREQ )
RETURN
ELSE IF ( LWORK .LT. LWORKREQ ) THEN
INFO = -19
INFO = -18
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLAQZ0', INFO )
CALL XERBLA( 'CLAQZ0', -INFO )
RETURN
END IF
*
Expand Down Expand Up @@ -536,17 +538,20 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
* to the top and deflate it

DO K2 = K, ISTART2+1, -1
CALL CLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1,
CALL CLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1,
$ S1,
$ TEMP )
B( K2-1, K2 ) = TEMP
B( K2-1, K2-1 ) = CZERO

CALL CROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1,
$ B( ISTARTM, K2-1 ), 1, C1, S1 )
CALL CROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM,
CALL CROT( MIN( K2+1, ISTOP )-ISTARTM+1,
$ A( ISTARTM,
$ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 )
IF ( ILZ ) THEN
CALL CROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1,
CALL CROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1,
$ C1,
$ S1 )
END IF

Expand All @@ -556,9 +561,11 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
A( K2, K2-1 ) = TEMP
A( K2+1, K2-1 ) = CZERO

CALL CROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1,
CALL CROT( ISTOPM-K2+1, A( K2, K2 ), LDA,
$ A( K2+1,
$ K2 ), LDA, C1, S1 )
CALL CROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1,
CALL CROT( ISTOPM-K2+1, B( K2, K2 ), LDB,
$ B( K2+1,
$ K2 ), LDB, C1, S1 )
IF( ILQ ) THEN
CALL CROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1,
Expand Down Expand Up @@ -620,7 +627,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
*
* Time for AED
*
CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA,
CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A,
$ LDA,
$ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED,
$ ALPHA, BETA, WORK, NW, WORK( NW**2+1 ), NW,
$ WORK( 2*NW**2+1 ), LWORK-2*NW**2, RWORK, REC,
Expand Down Expand Up @@ -663,7 +671,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
*
* Time for a QZ sweep
*
CALL CLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK,
CALL CLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS,
$ NBLOCK,
$ ALPHA( SHIFTPOS ), BETA( SHIFTPOS ), A, LDA, B,
$ LDB, Q, LDQ, Z, LDZ, WORK, NBLOCK, WORK( NBLOCK**
$ 2+1 ), NBLOCK, WORK( 2*NBLOCK**2+1 ),
Expand Down
42 changes: 26 additions & 16 deletions lapack-netlib/SRC/dlaqz0.f
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,13 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DLAQZ0 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqz0.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqz0.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqz0.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -296,10 +294,11 @@
*
*> \date May 2020
*
*> \ingroup doubleGEcomputational
*> \ingroup laqz0
*>
* =====================================================================
RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI,
$ A,
$ LDA, B, LDB, ALPHAR, ALPHAI, BETA,
$ Q, LDQ, Z, LDZ, WORK, LWORK, REC,
$ INFO )
Expand Down Expand Up @@ -439,7 +438,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
NBR = NSR+ITEMP1

IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN
CALL DHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB,
CALL DHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B,
$ LDB,
$ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
$ LWORK, INFO )
RETURN
Expand All @@ -451,7 +451,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,

* Workspace query to dlaqz3
NW = MAX( NWR, NMIN )
CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB,
CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B,
$ LDB,
$ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHAR,
$ ALPHAI, BETA, WORK, NW, WORK, NW, WORK, -1, REC,
$ AED_INFO )
Expand All @@ -470,14 +471,16 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
INFO = -19
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DLAQZ0', INFO )
CALL XERBLA( 'DLAQZ0', -INFO )
RETURN
END IF
*
* Initialize Q and Z
*
IF( IWANTQ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Q, LDQ )
IF( IWANTZ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Z, LDZ )
IF( IWANTQ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Q,
$ LDQ )
IF( IWANTZ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Z,
$ LDZ )

* Get machine constants
SAFMIN = DLAMCH( 'SAFE MINIMUM' )
Expand Down Expand Up @@ -570,17 +573,20 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
* to the top and deflate it

DO K2 = K, ISTART2+1, -1
CALL DLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1,
CALL DLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1,
$ S1,
$ TEMP )
B( K2-1, K2 ) = TEMP
B( K2-1, K2-1 ) = ZERO

CALL DROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1,
$ B( ISTARTM, K2-1 ), 1, C1, S1 )
CALL DROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM,
CALL DROT( MIN( K2+1, ISTOP )-ISTARTM+1,
$ A( ISTARTM,
$ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 )
IF ( ILZ ) THEN
CALL DROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1,
CALL DROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1,
$ C1,
$ S1 )
END IF

Expand All @@ -590,9 +596,11 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
A( K2, K2-1 ) = TEMP
A( K2+1, K2-1 ) = ZERO

CALL DROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1,
CALL DROT( ISTOPM-K2+1, A( K2, K2 ), LDA,
$ A( K2+1,
$ K2 ), LDA, C1, S1 )
CALL DROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1,
CALL DROT( ISTOPM-K2+1, B( K2, K2 ), LDB,
$ B( K2+1,
$ K2 ), LDB, C1, S1 )
IF( ILQ ) THEN
CALL DROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1,
Expand Down Expand Up @@ -654,7 +662,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
*
* Time for AED
*
CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA,
CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A,
$ LDA,
$ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED,
$ ALPHAR, ALPHAI, BETA, WORK, NW, WORK( NW**2+1 ),
$ NW, WORK( 2*NW**2+1 ), LWORK-2*NW**2, REC,
Expand Down Expand Up @@ -724,7 +733,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
*
* Time for a QZ sweep
*
CALL DLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK,
CALL DLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS,
$ NBLOCK,
$ ALPHAR( SHIFTPOS ), ALPHAI( SHIFTPOS ),
$ BETA( SHIFTPOS ), A, LDA, B, LDB, Q, LDQ, Z, LDZ,
$ WORK, NBLOCK, WORK( NBLOCK**2+1 ), NBLOCK,
Expand Down
43 changes: 27 additions & 16 deletions lapack-netlib/SRC/slaqz0.f
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,13 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SLAQZ0 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqz0.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqz0.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqz0.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -297,7 +295,8 @@
*> \ingroup laqz0
*>
* =====================================================================
RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI,
$ A,
$ LDA, B, LDB, ALPHAR, ALPHAI, BETA,
$ Q, LDQ, Z, LDZ, WORK, LWORK, REC,
$ INFO )
Expand Down Expand Up @@ -431,12 +430,14 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
NSR = MAX( 2, NSR-MOD( NSR, 2 ) )

RCOST = ILAENV( 17, 'SLAQZ0', JBCMPZ, N, ILO, IHI, LWORK )
ITEMP1 = INT( NSR/SQRT( 1+2*NSR/( REAL( RCOST )/100*N ) ) )
ITEMP1 = INT( REAL( NSR )/SQRT( 1+2*REAL( NSR )/
$ ( REAL( RCOST )/100*REAL( N ) ) ) )
ITEMP1 = ( ( ITEMP1-1 )/4 )*4+4
NBR = NSR+ITEMP1

IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN
CALL SHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB,
CALL SHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B,
$ LDB,
$ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
$ LWORK, INFO )
RETURN
Expand All @@ -448,7 +449,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,

* Workspace query to slaqz3
NW = MAX( NWR, NMIN )
CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB,
CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B,
$ LDB,
$ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHAR,
$ ALPHAI, BETA, WORK, NW, WORK, NW, WORK, -1, REC,
$ AED_INFO )
Expand All @@ -467,14 +469,16 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
INFO = -19
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SLAQZ0', INFO )
CALL XERBLA( 'SLAQZ0', -INFO )
RETURN
END IF
*
* Initialize Q and Z
*
IF( IWANTQ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Q, LDQ )
IF( IWANTZ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Z, LDZ )
IF( IWANTQ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Q,
$ LDQ )
IF( IWANTZ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Z,
$ LDZ )

* Get machine constants
SAFMIN = SLAMCH( 'SAFE MINIMUM' )
Expand Down Expand Up @@ -567,17 +571,20 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
* to the top and deflate it

DO K2 = K, ISTART2+1, -1
CALL SLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1,
CALL SLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1,
$ S1,
$ TEMP )
B( K2-1, K2 ) = TEMP
B( K2-1, K2-1 ) = ZERO

CALL SROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1,
$ B( ISTARTM, K2-1 ), 1, C1, S1 )
CALL SROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM,
CALL SROT( MIN( K2+1, ISTOP )-ISTARTM+1,
$ A( ISTARTM,
$ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 )
IF ( ILZ ) THEN
CALL SROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1,
CALL SROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1,
$ C1,
$ S1 )
END IF

Expand All @@ -587,9 +594,11 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
A( K2, K2-1 ) = TEMP
A( K2+1, K2-1 ) = ZERO

CALL SROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1,
CALL SROT( ISTOPM-K2+1, A( K2, K2 ), LDA,
$ A( K2+1,
$ K2 ), LDA, C1, S1 )
CALL SROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1,
CALL SROT( ISTOPM-K2+1, B( K2, K2 ), LDB,
$ B( K2+1,
$ K2 ), LDB, C1, S1 )
IF( ILQ ) THEN
CALL SROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1,
Expand Down Expand Up @@ -651,7 +660,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
*
* Time for AED
*
CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA,
CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A,
$ LDA,
$ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED,
$ ALPHAR, ALPHAI, BETA, WORK, NW, WORK( NW**2+1 ),
$ NW, WORK( 2*NW**2+1 ), LWORK-2*NW**2, REC,
Expand Down Expand Up @@ -721,7 +731,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
*
* Time for a QZ sweep
*
CALL SLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK,
CALL SLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS,
$ NBLOCK,
$ ALPHAR( SHIFTPOS ), ALPHAI( SHIFTPOS ),
$ BETA( SHIFTPOS ), A, LDA, B, LDB, Q, LDQ, Z, LDZ,
$ WORK, NBLOCK, WORK( NBLOCK**2+1 ), NBLOCK,
Expand Down
Loading
Loading