Fix operand number in errors of ?GGSVD3,?UN/ORBDB4, ?UN/ORCSD (Reference-LAPACK PR 1272)

lapack-netlib/SRC/cggsvd3.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGGSVD3 + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cggsvd3.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cggsvd3.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cggsvd3.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -351,6 +349,7 @@
       SUBROUTINE CGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
      $                    LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ,
      $                    WORK, LWORK, RWORK, IWORK, INFO )
+      IMPLICIT NONE
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -422,13 +421,14 @@ SUBROUTINE CGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
       ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
          INFO = -20
       ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
-         INFO = -24
+         INFO = -22
       END IF
 *
 *     Compute workspace
 *
       IF( INFO.EQ.0 ) THEN
-         CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA,
+         CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
+     $                 TOLA,
      $                 TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK,
      $                 WORK, WORK, -1, INFO )
          LWKOPT = N + INT( WORK( 1 ) )
@@ -455,8 +455,8 @@ SUBROUTINE CGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
 *
       ULP = SLAMCH( 'Precision' )
       UNFL = SLAMCH( 'Safe Minimum' )
-      TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP
-      TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP
+      TOLA = REAL( MAX( M, N ) )*MAX( ANORM, UNFL )*ULP
+      TOLB = REAL( MAX( P, N ) )*MAX( BNORM, UNFL )*ULP
 *
       CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA,
      $              TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK,

lapack-netlib/SRC/claqz0.f

@@ -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:
 *  ===========
@@ -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 )
@@ -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
@@ -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 )
@@ -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
 *
@@ -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
 
@@ -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,
@@ -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,
@@ -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 ),

lapack-netlib/SRC/claqz2.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CLAQZ2 + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/CLAQZ2.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/CLAQZ2.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/CLAQZ2.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -209,6 +207,7 @@
 *>          REC is INTEGER
 *>             REC indicates the current recursion level. Should be set
 *>             to 0 on first call.
+*> \endverbatim
 *>
 *> \param[out] INFO
 *> \verbatim
@@ -224,10 +223,11 @@
 *
 *> \date May 2020
 *
-*> \ingroup complexGEcomputational
+*> \ingroup laqz2
 *>
 *  =====================================================================
-      RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
+      RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI,
+     $                             NW,
      $                             A, LDA, B, LDB, Q, LDQ, Z, LDZ, NS,
      $                             ND, ALPHA, BETA, QC, LDQC, ZC, LDZC,
      $                             WORK, LWORK, RWORK, REC, INFO )
@@ -257,7 +257,7 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
       COMPLEX :: S, S1, TEMP
 
 *     External Functions
-      EXTERNAL :: XERBLA, CLAQZ0, CLAQZ1, SLABAD, CLACPY, CLASET, CGEMM,
+      EXTERNAL :: XERBLA, CLAQZ0, CLAQZ1, CLACPY, CLASET, CGEMM,
      $            CTGEXC, CLARTG, CROT
       REAL, EXTERNAL :: SLAMCH
 
@@ -282,10 +282,10 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
       LWORKREQ = MAX( LWORKREQ, N*NW, 2*NW**2+N )
       IF ( LWORK .EQ.-1 ) THEN
 *        workspace query, quick return
-         WORK( 1 ) = LWORKREQ
+         WORK( 1 ) = CMPLX( LWORKREQ )
          RETURN
       ELSE IF ( LWORK .LT. LWORKREQ ) THEN
-         INFO = -26
+         INFO = -25
       END IF
 
       IF( INFO.NE.0 ) THEN
@@ -296,7 +296,6 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
 *     Get machine constants
       SAFMIN = SLAMCH( 'SAFE MINIMUM' )
       SAFMAX = ONE/SAFMIN
-      CALL SLABAD( SAFMIN, SAFMAX )
       ULP = SLAMCH( 'PRECISION' )
       SMLNUM = SAFMIN*( REAL( N )/ULP )
 
@@ -319,7 +318,8 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
 
 *     Store window in case of convergence failure
       CALL CLACPY( 'ALL', JW, JW, A( KWTOP, KWTOP ), LDA, WORK, JW )
-      CALL CLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, WORK( JW**2+
+      CALL CLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB,
+     $             WORK( JW**2+
      $             1 ), JW )
 
 *     Transform window to real schur form
@@ -334,7 +334,8 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
 *        Convergence failure, restore the window and exit
          ND = 0
          NS = JW-QZ_SMALL_INFO
-         CALL CLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), LDA )
+         CALL CLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ),
+     $                LDA )
          CALL CLACPY( 'ALL', JW, JW, WORK( JW**2+1 ), JW, B( KWTOP,
      $                KWTOP ), LDB )
          RETURN
@@ -391,11 +392,14 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
             A( K, KWTOP-1 ) = TEMP
             A( K+1, KWTOP-1 ) = CZERO
             K2 = MAX( KWTOP, K-1 )
-            CALL CROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, C1,
+            CALL CROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA,
+     $                 C1,
      $                 S1 )
-            CALL CROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, K-1 ),
+            CALL CROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1,
+     $                 K-1 ),
      $                 LDB, C1, S1 )
-            CALL CROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, K+1-KWTOP+1 ),
+            CALL CROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1,
+     $                 K+1-KWTOP+1 ),
      $                 1, C1, CONJG( S1 ) )
          END DO
 
@@ -437,25 +441,29 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
      $                IHI+1 ), LDB )
       END IF
       IF ( ILQ ) THEN
-         CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, QC,
+         CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ,
+     $               QC,
      $               LDQC, CZERO, WORK, N )
          CALL CLACPY( 'ALL', N, JW, WORK, N, Q( 1, KWTOP ), LDQ )
       END IF
 
       IF ( KWTOP-1-ISTARTM+1 > 0 ) THEN
-         CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, A( ISTARTM,
+         CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE,
+     $               A( ISTARTM,
      $               KWTOP ), LDA, ZC, LDZC, CZERO, WORK,
      $               KWTOP-ISTARTM )
         CALL CLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM,
      $               A( ISTARTM, KWTOP ), LDA )
-         CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, B( ISTARTM,
+         CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE,
+     $               B( ISTARTM,
      $               KWTOP ), LDB, ZC, LDZC, CZERO, WORK,
      $               KWTOP-ISTARTM )
         CALL CLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM,
      $               B( ISTARTM, KWTOP ), LDB )
       END IF
       IF ( ILZ ) THEN
-         CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, ZC,
+         CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ,
+     $               ZC,
      $               LDZC, CZERO, WORK, N )
          CALL CLACPY( 'ALL', N, JW, WORK, N, Z( 1, KWTOP ), LDZ )
       END IF

lapack-netlib/SRC/cunbdb4.f

@@ -280,7 +280,7 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA,
          LWORKMIN = LWORKOPT
          WORK(1) = SROUNDUP_LWORK(LWORKOPT)
          IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN
-           INFO = -14
+           INFO = -15
          END IF
       END IF
       IF( INFO .NE. 0 ) THEN