Skip to content

Commit 8544798

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #5852 from martin-frbg/lapack1273
Fix sign of error number returned by LWORK check in ?LAQZ0 (Reference-LAPACK PR 1273)
2 parents 4ba480e + 6409343 commit 8544798

2 files changed

Lines changed: 53 additions & 32 deletions

File tree

‎lapack-netlib/SRC/dlaqz0.f‎

Lines changed: 26 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download DLAQZ0 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqz0.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqz0.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqz0.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -296,10 +294,11 @@
296294
*
297295
*> \date May 2020
298296
*
299-
*> \ingroup doubleGEcomputational
297+
*> \ingroup laqz0
300298
*>
301299
* =====================================================================
302-
RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
300+
RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI,
301+
$ A,
303302
$ LDA, B, LDB, ALPHAR, ALPHAI, BETA,
304303
$ Q, LDQ, Z, LDZ, WORK, LWORK, REC,
305304
$ INFO )
@@ -439,7 +438,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
439438
NBR = NSR+ITEMP1
440439

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

452452
* Workspace query to dlaqz3
453453
NW = MAX( NWR, NMIN )
454-
CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB,
454+
CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B,
455+
$ LDB,
455456
$ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHAR,
456457
$ ALPHAI, BETA, WORK, NW, WORK, NW, WORK, -1, REC,
457458
$ AED_INFO )
@@ -470,14 +471,16 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
470471
INFO = -19
471472
END IF
472473
IF( INFO.NE.0 ) THEN
473-
CALL XERBLA( 'DLAQZ0', INFO )
474+
CALL XERBLA( 'DLAQZ0', -INFO )
474475
RETURN
475476
END IF
476477
*
477478
* Initialize Q and Z
478479
*
479-
IF( IWANTQ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Q, LDQ )
480-
IF( IWANTZ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Z, LDZ )
480+
IF( IWANTQ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Q,
481+
$ LDQ )
482+
IF( IWANTZ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Z,
483+
$ LDZ )
481484

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

572575
DO K2 = K, ISTART2+1, -1
573-
CALL DLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1,
576+
CALL DLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1,
577+
$ S1,
574578
$ TEMP )
575579
B( K2-1, K2 ) = TEMP
576580
B( K2-1, K2-1 ) = ZERO
577581

578582
CALL DROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1,
579583
$ B( ISTARTM, K2-1 ), 1, C1, S1 )
580-
CALL DROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM,
584+
CALL DROT( MIN( K2+1, ISTOP )-ISTARTM+1,
585+
$ A( ISTARTM,
581586
$ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 )
582587
IF ( ILZ ) THEN
583-
CALL DROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1,
588+
CALL DROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1,
589+
$ C1,
584590
$ S1 )
585591
END IF
586592

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

593-
CALL DROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1,
599+
CALL DROT( ISTOPM-K2+1, A( K2, K2 ), LDA,
600+
$ A( K2+1,
594601
$ K2 ), LDA, C1, S1 )
595-
CALL DROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1,
602+
CALL DROT( ISTOPM-K2+1, B( K2, K2 ), LDB,
603+
$ B( K2+1,
596604
$ K2 ), LDB, C1, S1 )
597605
IF( ILQ ) THEN
598606
CALL DROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1,
@@ -654,7 +662,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
654662
*
655663
* Time for AED
656664
*
657-
CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA,
665+
CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A,
666+
$ LDA,
658667
$ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED,
659668
$ ALPHAR, ALPHAI, BETA, WORK, NW, WORK( NW**2+1 ),
660669
$ NW, WORK( 2*NW**2+1 ), LWORK-2*NW**2, REC,
@@ -724,7 +733,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
724733
*
725734
* Time for a QZ sweep
726735
*
727-
CALL DLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK,
736+
CALL DLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS,
737+
$ NBLOCK,
728738
$ ALPHAR( SHIFTPOS ), ALPHAI( SHIFTPOS ),
729739
$ BETA( SHIFTPOS ), A, LDA, B, LDB, Q, LDQ, Z, LDZ,
730740
$ WORK, NBLOCK, WORK( NBLOCK**2+1 ), NBLOCK,

‎lapack-netlib/SRC/slaqz0.f‎

Lines changed: 27 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download SLAQZ0 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqz0.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqz0.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqz0.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -297,7 +295,8 @@
297295
*> \ingroup laqz0
298296
*>
299297
* =====================================================================
300-
RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
298+
RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI,
299+
$ A,
301300
$ LDA, B, LDB, ALPHAR, ALPHAI, BETA,
302301
$ Q, LDQ, Z, LDZ, WORK, LWORK, REC,
303302
$ INFO )
@@ -431,12 +430,14 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
431430
NSR = MAX( 2, NSR-MOD( NSR, 2 ) )
432431

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

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

449450
* Workspace query to slaqz3
450451
NW = MAX( NWR, NMIN )
451-
CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB,
452+
CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B,
453+
$ LDB,
452454
$ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHAR,
453455
$ ALPHAI, BETA, WORK, NW, WORK, NW, WORK, -1, REC,
454456
$ AED_INFO )
@@ -467,14 +469,16 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
467469
INFO = -19
468470
END IF
469471
IF( INFO.NE.0 ) THEN
470-
CALL XERBLA( 'SLAQZ0', INFO )
472+
CALL XERBLA( 'SLAQZ0', -INFO )
471473
RETURN
472474
END IF
473475
*
474476
* Initialize Q and Z
475477
*
476-
IF( IWANTQ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Q, LDQ )
477-
IF( IWANTZ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Z, LDZ )
478+
IF( IWANTQ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Q,
479+
$ LDQ )
480+
IF( IWANTZ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Z,
481+
$ LDZ )
478482

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

569573
DO K2 = K, ISTART2+1, -1
570-
CALL SLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1,
574+
CALL SLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1,
575+
$ S1,
571576
$ TEMP )
572577
B( K2-1, K2 ) = TEMP
573578
B( K2-1, K2-1 ) = ZERO
574579

575580
CALL SROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1,
576581
$ B( ISTARTM, K2-1 ), 1, C1, S1 )
577-
CALL SROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM,
582+
CALL SROT( MIN( K2+1, ISTOP )-ISTARTM+1,
583+
$ A( ISTARTM,
578584
$ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 )
579585
IF ( ILZ ) THEN
580-
CALL SROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1,
586+
CALL SROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1,
587+
$ C1,
581588
$ S1 )
582589
END IF
583590

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

590-
CALL SROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1,
597+
CALL SROT( ISTOPM-K2+1, A( K2, K2 ), LDA,
598+
$ A( K2+1,
591599
$ K2 ), LDA, C1, S1 )
592-
CALL SROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1,
600+
CALL SROT( ISTOPM-K2+1, B( K2, K2 ), LDB,
601+
$ B( K2+1,
593602
$ K2 ), LDB, C1, S1 )
594603
IF( ILQ ) THEN
595604
CALL SROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1,
@@ -651,7 +660,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
651660
*
652661
* Time for AED
653662
*
654-
CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA,
663+
CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A,
664+
$ LDA,
655665
$ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED,
656666
$ ALPHAR, ALPHAI, BETA, WORK, NW, WORK( NW**2+1 ),
657667
$ NW, WORK( 2*NW**2+1 ), LWORK-2*NW**2, REC,
@@ -721,7 +731,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A,
721731
*
722732
* Time for a QZ sweep
723733
*
724-
CALL SLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK,
734+
CALL SLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS,
735+
$ NBLOCK,
725736
$ ALPHAR( SHIFTPOS ), ALPHAI( SHIFTPOS ),
726737
$ BETA( SHIFTPOS ), A, LDA, B, LDB, Q, LDQ, Z, LDZ,
727738
$ WORK, NBLOCK, WORK( NBLOCK**2+1 ), NBLOCK,

0 commit comments

Comments
 (0)