The R Project SVN – R – Diff – /trunk/src/modules/lapack/cmplx.f

 *>          LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
 *> \endverbatim
 *>
 *> \param[out] RWORK
 *> \verbatim
-*>          RWORK is DOUBLE PRECISION array, dimension (4*N)
+*>          RWORK is DOUBLE PRECISION array, dimension (LRWORK)
+*>          LRWORK = 4*N, if NCVT = NRU = NCC = 0, and
+*>          LRWORK = 4*(N-1), otherwise
 *> \endverbatim
 *>
 *> \param[out] INFO
 *> \verbatim
 *>          INFO is INTEGER
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH
       EXTERNAL           LSAME, DLAMCH
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARTG, DLAS2, DLASQ1, DLASV2, XERBLA, ZDROT,
+      EXTERNAL           DLARTG, DLAS2, DLASQ1, DLASV2, XERBLA,
+     $                   ZDROT,
      $                   ZDSCAL, ZLASR, ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, MAX, MIN, SIGN, SQRT
 *     ..
 CONTINUE
+*
 *        Update singular vectors if desired
+*
          IF( NRU.GT.0 )
-     $      CALL ZLASR( 'R', 'V', 'F', NRU, N, RWORK( 1 ), RWORK( N ),
+     $      CALL ZLASR( 'R', 'V', 'F', NRU, N, RWORK( 1 ),
+     $                  RWORK( N ),
      $                  U, LDU )
          IF( NCC.GT.0 )
-     $      CALL ZLASR( 'L', 'V', 'F', N, NCC, RWORK( 1 ), RWORK( N ),
+     $      CALL ZLASR( 'L', 'V', 'F', N, NCC, RWORK( 1 ),
+     $                  RWORK( N ),
      $                  C, LDC )
       END IF
+*
 *     Compute singular values to relative accuracy TOL
 *     (By setting TOL to be negative, algorithm will compute
+*
          IF( NCVT.GT.0 )
      $      CALL ZDROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT,
      $                  COSR, SINR )
          IF( NRU.GT.0 )
-     $      CALL ZDROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL )
+     $      CALL ZDROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL,
+     $                  SINL )
          IF( NCC.GT.0 )
      $      CALL ZDROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
      $                  SINL )
          M = M - 2
          GO TO 60
             OLDCS = ONE
             DO 120 I = LL, M - 1
                CALL DLARTG( D( I )*CS, E( I ), CS, SN, R )
                IF( I.GT.LL )
      $            E( I-1 ) = OLDSN*R
-               CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
+               CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN,
+     $                      D( I ) )
                RWORK( I-LL+1 ) = CS
                RWORK( I-LL+1+NM1 ) = SN
                RWORK( I-LL+1+NM12 ) = OLDCS
                RWORK( I-LL+1+NM13 ) = OLDSN
 CONTINUE
+*
             IF( NCVT.GT.0 )
      $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCVT, RWORK( 1 ),
      $                     RWORK( N ), VT( LL, 1 ), LDVT )
             IF( NRU.GT.0 )
-     $         CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1, RWORK( NM12+1 ),
+     $         CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1,
+     $                     RWORK( NM12+1 ),
      $                     RWORK( NM13+1 ), U( 1, LL ), LDU )
             IF( NCC.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC, RWORK( NM12+1 ),
+     $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC,
+     $                     RWORK( NM12+1 ),
      $                     RWORK( NM13+1 ), C( LL, 1 ), LDC )
+*
 *           Test convergence
+*
             IF( ABS( E( M-1 ) ).LE.THRESH )
             OLDCS = ONE
             DO 130 I = M, LL + 1, -1
                CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
                IF( I.LT.M )
      $            E( I ) = OLDSN*R
-               CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
+               CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN,
+     $                      D( I ) )
                RWORK( I-LL ) = CS
                RWORK( I-LL+NM1 ) = -SN
                RWORK( I-LL+NM12 ) = OLDCS
                RWORK( I-LL+NM13 ) = -OLDSN
 CONTINUE
             E( LL ) = H*OLDSN
+*
 *           Update singular vectors
+*
             IF( NCVT.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT, RWORK( NM12+1 ),
+     $         CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT,
+     $                     RWORK( NM12+1 ),
      $                     RWORK( NM13+1 ), VT( LL, 1 ), LDVT )
             IF( NRU.GT.0 )
      $         CALL ZLASR( 'R', 'V', 'B', NRU, M-LL+1, RWORK( 1 ),
      $                     RWORK( N ), U( 1, LL ), LDU )
             IF( NCC.GT.0 )
+*
             IF( NCVT.GT.0 )
      $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCVT, RWORK( 1 ),
      $                     RWORK( N ), VT( LL, 1 ), LDVT )
             IF( NRU.GT.0 )
-     $         CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1, RWORK( NM12+1 ),
+     $         CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1,
+     $                     RWORK( NM12+1 ),
      $                     RWORK( NM13+1 ), U( 1, LL ), LDU )
             IF( NCC.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC, RWORK( NM12+1 ),
+     $         CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC,
+     $                     RWORK( NM12+1 ),
      $                     RWORK( NM13+1 ), C( LL, 1 ), LDC )
+*
 *           Test convergence
+*
             IF( ABS( E( M-1 ) ).LE.THRESH )
      $         E( LL ) = ZERO
+*
 *           Update singular vectors if desired
+*
             IF( NCVT.GT.0 )
-     $         CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT, RWORK( NM12+1 ),
+     $         CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT,
+     $                     RWORK( NM12+1 ),
      $                     RWORK( NM13+1 ), VT( LL, 1 ), LDVT )
             IF( NRU.GT.0 )
      $         CALL ZLASR( 'R', 'V', 'B', NRU, M-LL+1, RWORK( 1 ),
      $                     RWORK( N ), U( 1, LL ), LDU )
             IF( NCC.GT.0 )
+*
 *     All singular values converged, so make them positive
+*
 CONTINUE
       DO 170 I = 1, N
+         IF( D( I ).EQ.ZERO ) THEN
+*
+*           Avoid -ZERO
+*
+            D( I ) = ZERO
+         END IF
          IF( D( I ).LT.ZERO ) THEN
             D( I ) = -D( I )
+*
 *           Change sign of singular vectors, if desired
+*
      $         CALL ZSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( N+1-I, 1 ),
      $                     LDVT )
             IF( NRU.GT.0 )
      $         CALL ZSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 )
             IF( NCC.GT.0 )
-     $         CALL ZSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
+     $         CALL ZSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ),
+     $                     LDC )
          END IF
 CONTINUE
       GO TO 220
+*
 *     Maximum number of iterations exceeded, failure to converge
 *> \author NAG Ltd.
+*
 *> \ingroup gbcon
+*
 *  =====================================================================
-      SUBROUTINE ZGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND,
+      SUBROUTINE ZGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM,
+     $                   RCOND,
      $                   WORK, RWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
       DOUBLE PRECISION   DLAMCH
       COMPLEX*16         ZDOTC
       EXTERNAL           LSAME, IZAMAX, DLAMCH, ZDOTC
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZAXPY, ZDRSCL, ZLACN2, ZLATBS
+      EXTERNAL           XERBLA, ZAXPY, ZDRSCL, ZLACN2,
+     $                   ZLATBS
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DIMAG, MIN
 *     ..
 *     .. Statement Functions ..
                   T = WORK( JP )
                   IF( JP.NE.J ) THEN
                      WORK( JP ) = WORK( J )
                      WORK( J ) = T
                   END IF
-                  CALL ZAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 )
+                  CALL ZAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ),
+     $                        1 )
 CONTINUE
             END IF
+*
 *           Multiply by inv(U).
+*
-            CALL ZLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
+            CALL ZLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN,
+     $                   N,
      $                   KL+KU, AB, LDAB, WORK, SCALE, RWORK, INFO )
          ELSE
+*
 *           Multiply by inv(U**H).
+*
 *           Multiply by inv(L**H).
+*
             IF( LNOTI ) THEN
                DO 30 J = N - 1, 1, -1
                   LM = MIN( KL, N-J )
-                  WORK( J ) = WORK( J ) - ZDOTC( LM, AB( KD+1, J ), 1,
+                  WORK( J ) = WORK( J ) - ZDOTC( LM, AB( KD+1, J ),
+     $                  1,
      $                        WORK( J+1 ), 1 )
                   JP = IPIV( J )
                   IF( JP.NE.J ) THEN
                      T = WORK( JP )
                      WORK( JP ) = WORK( J )
 *> \author NAG Ltd.
+*
 *> \ingroup gbequ
+*
 *  =====================================================================
-      SUBROUTINE ZGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
+      SUBROUTINE ZGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND,
+     $                   COLCND,
      $                   AMAX, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *> \author NAG Ltd.
+*
 *> \ingroup gbrfs
+*
 *  =====================================================================
-      SUBROUTINE ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
+      SUBROUTINE ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
+     $                   LDAFB,
      $                   IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK,
      $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     ..
 *     .. Local Arrays ..
       INTEGER            ISAVE( 3 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZGBMV, ZGBTRS, ZLACN2
+      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZGBMV, ZGBTRS,
+     $                   ZLACN2
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DIMAG, MAX, MIN
 *     ..
 *     .. External Functions ..
+*
 *        Compute residual R = B - op(A) * X,
 *        where op(A) = A, A**T, or A**H, depending on TRANS.
+*
          CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 )
-         CALL ZGBMV( TRANS, N, N, KL, KU, -CONE, AB, LDAB, X( 1, J ), 1,
+         CALL ZGBMV( TRANS, N, N, KL, KU, -CONE, AB, LDAB, X( 1, J ),
+     $               1,
      $               CONE, WORK, 1 )
+*
 *        Compute componentwise relative backward error from formula
+*
 *        max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
          IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
      $       COUNT.LE.ITMAX ) THEN
+*
 *           Update solution and try again.
+*
-            CALL ZGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, WORK, N,
+            CALL ZGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, WORK,
+     $                   N,
      $                   INFO )
             CALL ZAXPY( N, CONE, WORK, 1, X( 1, J ), 1 )
             LSTRES = BERR( J )
             COUNT = COUNT + 1
             GO TO 20
 *>  + need not be set on entry, but are required by the routine to store
 *>  elements of U because of fill-in resulting from the row interchanges.
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
+      SUBROUTINE ZGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
+     $                  INFO )
+*
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       CALL ZGBTRF( N, N, KL, KU, AB, LDAB, IPIV, INFO )
       IF( INFO.EQ.0 ) THEN
+*
 *        Solve the system A*X = B, overwriting B with X.
+*
-         CALL ZGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV,
+         CALL ZGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB,
+     $                IPIV,
      $                B, LDB, INFO )
       END IF
       RETURN
+*
 *     End of ZGBSV
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH, ZLANGB, ZLANTB
       EXTERNAL           LSAME, DLAMCH, ZLANGB, ZLANTB
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZGBCON, ZGBEQU, ZGBRFS, ZGBTRF,
+      EXTERNAL           XERBLA, ZCOPY, ZGBCON, ZGBEQU, ZGBRFS,
+     $                   ZGBTRF,
      $                   ZGBTRS, ZLACPY, ZLAQGB
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, MAX, MIN
 *     ..
          BIGNUM = ONE / SMLNUM
       END IF
+*
 *     Test the input parameters.
+*
+      IF( .NOT.NOFACT .AND.
+     $    .NOT.EQUIL .AND.
-      IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
+     $    .NOT.LSAME( FACT, 'F' ) )
      $     THEN
          INFO = -1
       ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
      $         LSAME( TRANS, 'C' ) ) THEN
          INFO = -2
      $                AMAX, INFEQU )
          IF( INFEQU.EQ.0 ) THEN
+*
 *           Equilibrate the matrix.
+*
-            CALL ZLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
+            CALL ZLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND,
+     $                   COLCND,
      $                   AMAX, EQUED )
             ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
             COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
          END IF
       END IF
             DO 90 J = 1, INFO
                DO 80 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 )
                   ANORM = MAX( ANORM, ABS( AB( I, J ) ) )
 CONTINUE
 CONTINUE
-            RPVGRW = ZLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ),
+            RPVGRW = ZLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1,
+     $                       KL+KU ),
      $                       AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB,
      $                       RWORK )
             IF( RPVGRW.EQ.ZERO ) THEN
                RPVGRW = ONE
             ELSE
      $             INFO )
+*
 *     Use iterative refinement to improve the computed solution and
 *     compute error bounds and backward error estimates for it.
+*
-      CALL ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV,
+      CALL ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
+     $             IPIV,
      $             B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO )
+*
 *     Transform the solution matrix X to a solution of the original
 *     system.
+*
      $                     AB( KV+1, J ), LDAB-1 )
             IF( KM.GT.0 ) THEN
+*
 *              Compute multipliers.
+*
-               CALL ZSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 )
+               CALL ZSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ),
+     $                     1 )
+*
 *              Update trailing submatrix within the band.
+*
                IF( JU.GT.J )
      $            CALL ZGERU( KM, JU-J, -ONE, AB( KV+2, J ), 1,
 *     .. External Functions ..
       INTEGER            ILAENV, IZAMAX
       EXTERNAL           ILAENV, IZAMAX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZGBTF2, ZGEMM, ZGERU, ZLASWP,
+      EXTERNAL           XERBLA, ZCOPY, ZGBTF2, ZGEMM, ZGERU,
+     $                   ZLASWP,
      $                   ZSCAL, ZSWAP, ZTRSM
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
                      END IF
                   END IF
+*
 *                 Compute multipliers
+*
-                  CALL ZSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ),
+                  CALL ZSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2,
+     $                        JJ ),
      $                        1 )
+*
 *                 Update trailing submatrix within the band and within
 *                 the current block. JM is the index of the last column
 *                 which needs to be updated.
+*
                IF( J2.GT.0 ) THEN
+*
 *                 Update A12
+*
-                  CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
+                  CALL ZTRSM( 'Left', 'Lower', 'No transpose',
+     $                        'Unit',
      $                        JB, J2, ONE, AB( KV+1, J ), LDAB-1,
      $                        AB( KV+1-JB, J+JB ), LDAB-1 )
+*
                   IF( I2.GT.0 ) THEN
+*
 *                    Update A22
+*
-                     CALL ZGEMM( 'No transpose', 'No transpose', I2, J2,
+                     CALL ZGEMM( 'No transpose', 'No transpose', I2,
+     $                           J2,
      $                           JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
      $                           AB( KV+1-JB, J+JB ), LDAB-1, ONE,
      $                           AB( KV+1, J+JB ), LDAB-1 )
                   END IF
+*
                   IF( I3.GT.0 ) THEN
+*
 *                    Update A32
+*
-                     CALL ZGEMM( 'No transpose', 'No transpose', I3, J2,
+                     CALL ZGEMM( 'No transpose', 'No transpose', I3,
+     $                           J2,
      $                           JB, -ONE, WORK31, LDWORK,
      $                           AB( KV+1-JB, J+JB ), LDAB-1, ONE,
      $                           AB( KV+KL+1-JB, J+JB ), LDAB-1 )
                   END IF
                END IF
 CONTINUE
 CONTINUE
+*
 *                 Update A13 in the work array
+*
-                  CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
+                  CALL ZTRSM( 'Left', 'Lower', 'No transpose',
+     $                        'Unit',
      $                        JB, J3, ONE, AB( KV+1, J ), LDAB-1,
      $                        WORK13, LDWORK )
+*
                   IF( I2.GT.0 ) THEN
+*
 *                    Update A23
+*
-                     CALL ZGEMM( 'No transpose', 'No transpose', I2, J3,
+                     CALL ZGEMM( 'No transpose', 'No transpose', I2,
+     $                           J3,
      $                           JB, -ONE, AB( KV+1+JB, J ), LDAB-1,
      $                           WORK13, LDWORK, ONE, AB( 1+JB, J+KV ),
      $                           LDAB-1 )
                   END IF
+*
                   IF( I3.GT.0 ) THEN
+*
 *                    Update A33
+*
-                     CALL ZGEMM( 'No transpose', 'No transpose', I3, J3,
+                     CALL ZGEMM( 'No transpose', 'No transpose', I3,
+     $                           J3,
      $                           JB, -ONE, WORK31, LDWORK, WORK13,
      $                           LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 )
                   END IF
+*
 *                 Copy the lower triangle of A13 back into place
 *> \author NAG Ltd.
+*
 *> \ingroup gbtrs
+*
 *  =====================================================================
-      SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
+      SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B,
+     $                   LDB,
      $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMV, ZGERU, ZLACGV, ZSWAP, ZTBSV
+      EXTERNAL           XERBLA, ZGEMV, ZGERU, ZLACGV, ZSWAP,
+     $                   ZTBSV
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
             DO 10 J = 1, N - 1
                LM = MIN( KL, N-J )
                L = IPIV( J )
                IF( L.NE.J )
      $            CALL ZSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
-               CALL ZGERU( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ),
+               CALL ZGERU( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J,
+     $                     1 ),
      $                     LDB, B( J+1, 1 ), LDB )
 CONTINUE
          END IF
+*
          DO 20 I = 1, NRHS
+*
 *           Solve U*X = B, overwriting B with X.
+*
-            CALL ZTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU,
+            CALL ZTBSV( 'Upper', 'No transpose', 'Non-unit', N,
+     $                  KL+KU,
      $                  AB, LDAB, B( 1, I ), 1 )
 CONTINUE
+*
       ELSE IF( LSAME( TRANS, 'T' ) ) THEN
+*
+*
          DO 30 I = 1, NRHS
+*
 *           Solve U**T * X = B, overwriting B with X.
+*
-            CALL ZTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB,
+            CALL ZTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU,
+     $                  AB,
      $                  LDAB, B( 1, I ), 1 )
 CONTINUE
+*
 *        Solve L**T * X = B, overwriting B with X.
+*
+*
          DO 50 I = 1, NRHS
+*
 *           Solve U**H * X = B, overwriting B with X.
+*
-            CALL ZTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', N,
+            CALL ZTBSV( 'Upper', 'Conjugate transpose', 'Non-unit',
+     $                  N,
      $                  KL+KU, AB, LDAB, B( 1, I ), 1 )
 CONTINUE
+*
 *        Solve L**H * X = B, overwriting B with X.
+*
+*
       RIGHTV = LSAME( SIDE, 'R' )
       LEFTV = LSAME( SIDE, 'L' )
+*
       INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+      IF( .NOT.LSAME( JOB, 'N' ) .AND.
+     $    .NOT.LSAME( JOB, 'P' ) .AND.
+     $    .NOT.LSAME( JOB, 'S' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+     $                .NOT.LSAME( JOB, 'B' ) ) THEN
          INFO = -1
       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
          INFO = -2
       ELSE IF( N.LT.0 ) THEN
          INFO = -3
 *     ..
 *     .. External Functions ..
       LOGICAL            DISNAN, LSAME
       INTEGER            IZAMAX
       DOUBLE PRECISION   DLAMCH, DZNRM2
-      EXTERNAL           DISNAN, LSAME, IZAMAX, DLAMCH, DZNRM2
+      EXTERNAL           DISNAN, LSAME, IZAMAX, DLAMCH,
+     $                   DZNRM2
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DIMAG, MAX, MIN
+*
 *     Test the input parameters
+*
       INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+      IF( .NOT.LSAME( JOB, 'N' ) .AND.
+     $    .NOT.LSAME( JOB, 'P' ) .AND.
+     $    .NOT.LSAME( JOB, 'S' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+     $                .NOT.LSAME( JOB, 'B' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
+*
                IF( CANSWAP ) THEN
                   SCALE( L ) = I
                   IF( I.NE.L ) THEN
                      CALL ZSWAP( L, A( 1, I ), 1, A( 1, L ), 1 )
-                     CALL ZSWAP( N-K+1, A( I, K ), LDA, A( L, K ), LDA )
+                     CALL ZSWAP( N-K+1, A( I, K ), LDA, A( L, K ),
+     $                           LDA )
                   END IF
                   NOCONV = .TRUE.
+*
                   IF( L.EQ.1 ) THEN
                      ILO = 1
+*
                IF( CANSWAP ) THEN
                   SCALE( K ) = J
                   IF( J.NE.K ) THEN
                      CALL ZSWAP( L, A( 1, J ), 1, A( 1, K ), 1 )
-                     CALL ZSWAP( N-K+1, A( J, K ), LDA, A( K, K ), LDA )
+                     CALL ZSWAP( N-K+1, A( J, K ), LDA, A( K, K ),
+     $                           LDA )
                   END IF
                   NOCONV = .TRUE.
+*
                   K = K + 1
                END IF
 *     ..
+*
 *  =====================================================================
+*
 *     .. Parameters ..
-      COMPLEX*16         ZERO, ONE
+      COMPLEX*16         ZERO
-      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
+      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
-     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
-*     ..
 *     .. Local Scalars ..
       INTEGER            I
       COMPLEX*16         ALPHA
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF, ZLARFG
+      EXTERNAL           XERBLA, ZLACGV, ZLARF1F, ZLARFG
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCONJG, MAX, MIN
 *     ..
 *     .. Executable Statements ..
+*
             ALPHA = A( I, I )
             CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
      $                   TAUQ( I ) )
             D( I ) = DBLE( ALPHA )
-            A( I, I ) = ONE
+*
 *           Apply H(i)**H to A(i:m,i+1:n) from the left
+*
             IF( I.LT.N )
-     $         CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
+     $         CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
      $                     DCONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
             A( I, I ) = D( I )
+*
             IF( I.LT.N ) THEN
+*
                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
                ALPHA = A( I, I+1 )
                CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA,
      $                      TAUP( I ) )
                E( I ) = DBLE( ALPHA )
-               A( I, I+1 ) = ONE
+*
 *              Apply G(i) to A(i+1:m,i+1:n) from the right
+*
-               CALL ZLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
+               CALL ZLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA,
      $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
                A( I, I+1 ) = E( I )
             ELSE
                TAUP( I ) = ZERO
             CALL ZLACGV( N-I+1, A( I, I ), LDA )
             ALPHA = A( I, I )
             CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
      $                   TAUP( I ) )
             D( I ) = DBLE( ALPHA )
-            A( I, I ) = ONE
+*
 *           Apply G(i) to A(i+1:m,i:n) from the right
+*
             IF( I.LT.M )
-     $         CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
+     $         CALL ZLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
      $                     TAUP( I ), A( I+1, I ), LDA, WORK )
             CALL ZLACGV( N-I+1, A( I, I ), LDA )
             A( I, I ) = D( I )
+*
             IF( I.LT.M ) THEN
+*
                ALPHA = A( I+1, I )
                CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
      $                      TAUQ( I ) )
                E( I ) = DBLE( ALPHA )
-               A( I+1, I ) = ONE
+*
 *              Apply H(i)**H to A(i+1:m,i+1:n) from the left
+*
-               CALL ZLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
+               CALL ZLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1,
      $                     DCONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
      $                     WORK )
                A( I+1, I ) = E( I )
             ELSE
                TAUQ( I ) = ZERO
 *> \endverbatim
 *>
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of the array WORK.  LWORK >= max(1,M,N).
+*>          The length of the array WORK.
+*>          LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise.
 *>          For optimum performance LWORK >= (M+N)*NB, where NB
 *>          is the optimal blocksize.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
 *>          only calculates the optimal size of the WORK array, returns
       COMPLEX*16         ONE
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       LOGICAL            LQUERY
-      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
+      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT,
-     $                   NBMIN, NX, WS
+     $                   MINMN, NB, NBMIN, NX, WS
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZGEBD2, ZGEMM, ZLABRD
 *     ..
 *     .. Intrinsic Functions ..
 *     .. Executable Statements ..
+*
 *     Test the input parameters
+*
       INFO = 0
+      MINMN = MIN( M, N )
+      IF( MINMN.EQ.0 ) THEN
+         LWKMIN = 1
+         LWKOPT = 1
+      ELSE
+         LWKMIN = MAX( M, N )
-      NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) )
+         NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) )
-      LWKOPT = ( M+N )*NB
+         LWKOPT = ( M+N )*NB
+      END IF
       WORK( 1 ) = DBLE( LWKOPT )
+*
       LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
          INFO = -10
       END IF
       IF( INFO.LT.0 ) THEN
          CALL XERBLA( 'ZGEBRD', -INFO )
          RETURN
          RETURN
       END IF
+*
 *     Quick return if possible
+*
-      MINMN = MIN( M, N )
       IF( MINMN.EQ.0 ) THEN
          WORK( 1 ) = 1
          RETURN
       END IF
+*
          NX = MAX( NB, ILAENV( 3, 'ZGEBRD', ' ', M, N, -1, -1 ) )
+*
 *        Determine when to switch from blocked to unblocked code.
+*
          IF( NX.LT.MINMN ) THEN
-            WS = ( M+N )*NB
+            WS = LWKOPT
             IF( LWORK.LT.WS ) THEN
+*
 *              Not enough work space for the optimal NB, consider using
 *              a smaller block size.
+*
+*
 *        Reduce rows and columns i:i+ib-1 to bidiagonal form and return
 *        the matrices X and Y which are needed to update the unreduced
 *        part of the matrix
+*
-         CALL ZLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ),
+         CALL ZLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ),
+     $                E( I ),
      $                TAUQ( I ), TAUP( I ), WORK, LDWRKX,
      $                WORK( LDWRKX*NB+1 ), LDWRKY )
+*
 *        Update the trailing submatrix A(i+ib:m,i+ib:n), using
 *        an update of the form  A := A - V*Y**H - X*U**H
+*
          CALL ZGEMM( 'No transpose', 'Conjugate transpose', M-I-NB+1,
      $               N-I-NB+1, NB, -ONE, A( I+NB, I ), LDA,
      $               WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE,
      $               A( I+NB, I+NB ), LDA )
-         CALL ZGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1,
+         CALL ZGEMM( 'No transpose', 'No transpose', M-I-NB+1,
+     $               N-I-NB+1,
      $               NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA,
      $               ONE, A( I+NB, I+NB ), LDA )
+*
 *        Copy diagonal and off-diagonal elements of B back into A
+*
       IF( KASE.NE.0 ) THEN
          IF( KASE.EQ.KASE1 ) THEN
+*
 *           Multiply by inv(L).
+*
-            CALL ZLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
+            CALL ZLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N,
+     $                   A,
      $                   LDA, WORK, SL, RWORK, INFO )
+*
 *           Multiply by inv(U).
+*
-            CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
+            CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN,
+     $                   N,
      $                   A, LDA, WORK, SU, RWORK( N+1 ), INFO )
          ELSE
+*
 *           Multiply by inv(U**H).
+*
      $                   NORMIN, N, A, LDA, WORK, SU, RWORK( N+1 ),
      $                   INFO )
+*
 *           Multiply by inv(L**H).
+*
-            CALL ZLATRS( 'Lower', 'Conjugate transpose', 'Unit', NORMIN,
+            CALL ZLATRS( 'Lower', 'Conjugate transpose', 'Unit',
+     $                   NORMIN,
      $                   N, A, LDA, WORK, SL, RWORK, INFO )
          END IF
+*
 *        Divide X by 1/(SL*SU) if doing so will not cause overflow.
+*
 *     ..
 *     .. Local Arrays ..
       DOUBLE PRECISION   DUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD,
+      EXTERNAL           XERBLA, ZCOPY, ZGEBAK, ZGEBAL,
+     $                   ZGEHRD,
      $                   ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            ILAENV
       LQUERY = ( LWORK.EQ.-1 )
       WANTVS = LSAME( JOBVS, 'V' )
       WANTST = LSAME( SORT, 'S' )
       IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN
          INFO = -1
+      ELSE IF( ( .NOT.WANTST ) .AND.
-      ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
+     $         ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
          INFO = -2
       ELSE IF( N.LT.0 ) THEN
          INFO = -4
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -6
             HSWORK = INT( WORK( 1 ) )
+*
             IF( .NOT.WANTVS ) THEN
                MAXWRK = MAX( MAXWRK, HSWORK )
             ELSE
-               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
+               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1,
+     $                       'ZUNGHR',
      $                       ' ', N, 1, N, -1 ) )
                MAXWRK = MAX( MAXWRK, HSWORK )
             END IF
          END IF
          WORK( 1 ) = MAXWRK
+*
 *        Generate unitary matrix in VS
 *        (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
 *        (RWorkspace: none)
+*
-         CALL ZUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
+         CALL ZUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ),
+     $                WORK( IWRK ),
      $                LWORK-IWRK+1, IERR )
       END IF
+*
       SDIM = 0
+*
+*
 *        Reorder eigenvalues and transform Schur vectors
 *        (CWorkspace: none)
 *        (RWorkspace: none)
+*
-         CALL ZTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, W, SDIM,
+         CALL ZTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, W,
+     $                SDIM,
      $                S, SEP, WORK( IWRK ), LWORK-IWRK+1, ICOND )
       END IF
+*
       IF( WANTVS ) THEN
+*
 *        Undo balancing
 *        (CWorkspace: none)
 *        (RWorkspace: need N)
+*
-         CALL ZGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, LDVS,
+         CALL ZGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS,
+     $                LDVS,
      $                IERR )
       END IF
+*
       IF( SCALEA ) THEN
+*
 *  @precisions fortran z -> c
+*
 *> \ingroup geev
+*
 *  =====================================================================
-      SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
+      SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR,
+     $                  LDVR,
      $                  WORK, LWORK, RWORK, INFO )
       implicit none
+*
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     .. Local Arrays ..
       LOGICAL            SELECT( 1 )
       DOUBLE PRECISION   DUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, ZHSEQR,
+      EXTERNAL           XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,
+     $                   ZHSEQR,
      $                   ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZUNGHR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            IDAMAX, ILAENV
       DOUBLE PRECISION   DLAMCH, DZNRM2, ZLANGE
-      EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE
+      EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2,
+     $                   ZLANGE
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT
 *     ..
 *     .. Executable Statements ..
       LQUERY = ( LWORK.EQ.-1 )
       WANTVL = LSAME( JOBVL, 'V' )
       WANTVR = LSAME( JOBVR, 'V' )
       IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
          INFO = -1
+      ELSE IF( ( .NOT.WANTVR ) .AND.
-      ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
+     $         ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
          INFO = -2
       ELSE IF( N.LT.0 ) THEN
          INFO = -3
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -5
             MAXWRK = 1
          ELSE
             MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
             MINWRK = 2*N
             IF( WANTVL ) THEN
-               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
+               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1,
+     $                       'ZUNGHR',
      $                       ' ', N, 1, N, -1 ) )
                CALL ZTREVC3( 'L', 'B', SELECT, N, A, LDA,
      $                       VL, LDVL, VR, LDVR,
      $                       N, NOUT, WORK, -1, RWORK, -1, IERR )
                LWORK_TREVC = INT( WORK(1) )
                MAXWRK = MAX( MAXWRK, N + LWORK_TREVC )
                CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL,
      $                      WORK, -1, INFO )
             ELSE IF( WANTVR ) THEN
-               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
+               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1,
+     $                       'ZUNGHR',
      $                       ' ', N, 1, N, -1 ) )
                CALL ZTREVC3( 'R', 'B', SELECT, N, A, LDA,
      $                       VL, LDVL, VR, LDVR,
      $                       N, NOUT, WORK, -1, RWORK, -1, IERR )
                LWORK_TREVC = INT( WORK(1) )
+*
 *        Generate unitary matrix in VL
 *        (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
 *        (RWorkspace: none)
+*
-         CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
+         CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ),
+     $                WORK( IWRK ),
      $                LWORK-IWRK+1, IERR )
+*
 *        Perform QR iteration, accumulating Schur vectors in VL
 *        (CWorkspace: need 1, prefer HSWORK (see comments) )
 *        (RWorkspace: none)
+*
 *        Generate unitary matrix in VR
 *        (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
 *        (RWorkspace: none)
+*
-         CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
+         CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ),
+     $                WORK( IWRK ),
      $                LWORK-IWRK+1, IERR )
+*
 *        Perform QR iteration, accumulating Schur vectors in VR
 *        (CWorkspace: need 1, prefer HSWORK (see comments) )
 *        (RWorkspace: none)
 *        Compute left and/or right eigenvectors
 *        (CWorkspace: need 2*N, prefer N + 2*N*NB)
 *        (RWorkspace: need 2*N)
+*
          IRWORK = IBAL + N
-         CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
+         CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR,
+     $                 LDVR,
      $                 N, NOUT, WORK( IWRK ), LWORK-IWRK+1,
      $                 RWORK( IRWORK ), N, IERR )
       END IF
+*
       IF( WANTVL ) THEN
+*
 *        Undo balancing of left eigenvectors
 *        (CWorkspace: none)
 *        (RWorkspace: need N)
+*
-         CALL ZGEBAK( 'B', 'L', N, ILO, IHI, RWORK( IBAL ), N, VL, LDVL,
+         CALL ZGEBAK( 'B', 'L', N, ILO, IHI, RWORK( IBAL ), N, VL,
+     $                LDVL,
      $                IERR )
+*
 *        Normalize left eigenvectors and make largest component real
+*
          DO 20 I = 1, N
+*
 *        Undo balancing of right eigenvectors
 *        (CWorkspace: none)
 *        (RWorkspace: need N)
+*
-         CALL ZGEBAK( 'B', 'R', N, ILO, IHI, RWORK( IBAL ), N, VR, LDVR,
+         CALL ZGEBAK( 'B', 'R', N, ILO, IHI, RWORK( IBAL ), N, VR,
+     $                LDVR,
      $                IERR )
+*
 *        Normalize right eigenvectors and make largest component real
+*
          DO 40 I = 1, N
+*
 *     Undo scaling if necessary
+*
 CONTINUE
       IF( SCALEA ) THEN
-         CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ),
+         CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1,
+     $                W( INFO+1 ),
      $                MAX( N-INFO, 1 ), IERR )
          IF( INFO.GT.0 ) THEN
-            CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR )
+            CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N,
+     $                   IERR )
          END IF
       END IF
+*
       WORK( 1 ) = MAXWRK
       RETURN
 *  @precisions fortran z -> c
+*
 *> \ingroup geevx
+*
 *  =====================================================================
-      SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL,
+      SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W,
+     $                   VL,
      $                   LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE,
      $                   RCONDV, WORK, LWORK, RWORK, INFO )
       implicit none
+*
 *  -- LAPACK driver routine --
 *     .. Local Arrays ..
       LOGICAL            SELECT( 1 )
       DOUBLE PRECISION   DUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,
+      EXTERNAL           DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL,
+     $                   ZGEHRD,
      $                   ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZTRSNA,
      $                   ZUNGHR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            IDAMAX, ILAENV
       DOUBLE PRECISION   DLAMCH, DZNRM2, ZLANGE
-      EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE
+      EXTERNAL           LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2,
+     $                   ZLANGE
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT
 *     ..
 *     .. Executable Statements ..
       WANTVR = LSAME( JOBVR, 'V' )
       WNTSNN = LSAME( SENSE, 'N' )
       WNTSNE = LSAME( SENSE, 'E' )
       WNTSNV = LSAME( SENSE, 'V' )
       WNTSNB = LSAME( SENSE, 'B' )
-      IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) .OR.
+      IF( .NOT.( LSAME( BALANC, 'N' ) .OR.
+     $    LSAME( BALANC, 'S' ) .OR.
      $    LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) THEN
          INFO = -1
+      ELSE IF( ( .NOT.WANTVL ) .AND.
-      ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
+     $         ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
          INFO = -2
+      ELSE IF( ( .NOT.WANTVR ) .AND.
-      ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
+     $         ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
          INFO = -3
       ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR.
      $         ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND.
      $         WANTVR ) ) ) THEN
          INFO = -4
                MAXWRK = MAX( MAXWRK, LWORK_TREVC )
                CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR,
      $                WORK, -1, INFO )
             ELSE
                IF( WNTSNN ) THEN
-                  CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR,
+                  CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR,
+     $                         LDVR,
      $                WORK, -1, INFO )
                ELSE
-                  CALL ZHSEQR( 'S', 'N', N, 1, N, A, LDA, W, VR, LDVR,
+                  CALL ZHSEQR( 'S', 'N', N, 1, N, A, LDA, W, VR,
+     $                         LDVR,
      $                WORK, -1, INFO )
                END IF
             END IF
             HSWORK = INT( WORK(1) )
+*
             ELSE
                MINWRK = 2*N
                IF( .NOT.( WNTSNN .OR. WNTSNE ) )
      $            MINWRK = MAX( MINWRK, N*N + 2*N )
                MAXWRK = MAX( MAXWRK, HSWORK )
-               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR',
+               MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1,
+     $                       'ZUNGHR',
      $                       ' ', N, 1, N, -1 ) )
                IF( .NOT.( WNTSNN .OR. WNTSNE ) )
      $            MAXWRK = MAX( MAXWRK, N*N + 2*N )
                MAXWRK = MAX( MAXWRK, 2*N )
             END IF
+*
 *        Generate unitary matrix in VL
 *        (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
 *        (RWorkspace: none)
+*
-         CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
+         CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ),
+     $                WORK( IWRK ),
      $                LWORK-IWRK+1, IERR )
+*
 *        Perform QR iteration, accumulating Schur vectors in VL
 *        (CWorkspace: need 1, prefer HSWORK (see comments) )
 *        (RWorkspace: none)
+*
 *        Generate unitary matrix in VR
 *        (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
 *        (RWorkspace: none)
+*
-         CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
+         CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ),
+     $                WORK( IWRK ),
      $                LWORK-IWRK+1, IERR )
+*
 *        Perform QR iteration, accumulating Schur vectors in VR
 *        (CWorkspace: need 1, prefer HSWORK (see comments) )
 *        (RWorkspace: none)
+*
 *        Compute left and/or right eigenvectors
 *        (CWorkspace: need 2*N, prefer N + 2*N*NB)
 *        (RWorkspace: need N)
+*
-         CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
+         CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR,
+     $                 LDVR,
      $                 N, NOUT, WORK( IWRK ), LWORK-IWRK+1,
      $                 RWORK, N, IERR )
       END IF
+*
 *     Compute condition numbers if desired
 *     (CWorkspace: need N*N+2*N unless SENSE = 'E')
 *     (RWorkspace: need 2*N unless SENSE = 'E')
+*
       IF( .NOT.WNTSNN ) THEN
-         CALL ZTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
+         CALL ZTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR,
+     $                LDVR,
      $                RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, RWORK,
      $                ICOND )
       END IF
+*
       IF( WANTVL ) THEN
+*
 *     Undo scaling if necessary
+*
 CONTINUE
       IF( SCALEA ) THEN
-         CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ),
+         CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1,
+     $                W( INFO+1 ),
      $                MAX( N-INFO, 1 ), IERR )
          IF( INFO.EQ.0 ) THEN
             IF( ( WNTSNV .OR. WNTSNB ) .AND. ICOND.EQ.0 )
      $         CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, RCONDV, N,
      $                      IERR )
          ELSE
-            CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR )
+            CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N,
+     $                   IERR )
          END IF
       END IF
+*
       WORK( 1 ) = MAXWRK
       RETURN
       COMPLEX*16         ONE
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I
-      COMPLEX*16         ALPHA
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF, ZLARFG
+      EXTERNAL           XERBLA, ZLARF1F, ZLARFG
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCONJG, MAX, MIN
 *     ..
 *     .. Executable Statements ..
+*
       DO 10 I = ILO, IHI - 1
+*
 *        Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
+*
-         ALPHA = A( I+1, I )
-         CALL ZLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAU( I ) )
+         CALL ZLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
-         A( I+1, I ) = ONE
+     $                TAU( I ) )
+*
 *        Apply H(i) to A(1:ihi,i+1:ihi) from the right
+*
-         CALL ZLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
+         CALL ZLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
-     $               A( 1, I+1 ), LDA, WORK )
+     $                 A( 1, I+1 ), LDA, WORK )
+*
 *        Apply H(i)**H to A(i+1:ihi,i+1:n) from the left
+*
-         CALL ZLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1,
+         CALL ZLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1,
-     $               DCONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
+     $                 CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
+*
-         A( I+1, I ) = ALPHA
 CONTINUE
+*
       RETURN
+*
 *     End of ZGEHD2
 *>          zero.
 *> \endverbatim
 *>
 *> \param[out] WORK
 *> \verbatim
-*>          WORK is COMPLEX*16 array, dimension (LWORK)
+*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
 *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 *> \endverbatim
 *>
 *> \param[in] LWORK
 *> \verbatim
 *>  subroutine incorporating improvements proposed by Quintana-Orti and
 *>  Van de Geijn (2006). (See ZLAHR2.)
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
+      SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
 *     .. Scalar Arguments ..
       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16        A( LDA, * ), TAU( * ), WORK( * )
+      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( * )
 *     ..
+*
 *  =====================================================================
+*
 *     .. Parameters ..
       INTEGER            NBMAX, LDT, TSIZE
       PARAMETER          ( NBMAX = 64, LDT = NBMAX+1,
      $                     TSIZE = LDT*NBMAX )
-      COMPLEX*16        ZERO, ONE
+      COMPLEX*16         ZERO, ONE
       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
      $                     ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       LOGICAL            LQUERY
       INTEGER            I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB,
      $                   NBMIN, NH, NX
-      COMPLEX*16        EI
+      COMPLEX*16         EI
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB, ZTRMM,
+      EXTERNAL           ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB,
+     $                   ZTRMM,
      $                   XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
          INFO = -5
       ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
          INFO = -8
       END IF
+*
+      NH = IHI - ILO + 1
       IF( INFO.EQ.0 ) THEN
+*
 *        Compute the workspace requirements
+*
+         IF( NH.LE.1 ) THEN
+            LWKOPT = 1
+         ELSE
-         NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
+            NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI,
+     $                              -1 ) )
-         LWKOPT = N*NB + TSIZE
+            LWKOPT = N*NB + TSIZE
+         END IF
          WORK( 1 ) = LWKOPT
       ENDIF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGEHRD', -INFO )
          TAU( I ) = ZERO
 CONTINUE
+*
 *     Quick return if possible
+*
-      NH = IHI - ILO + 1
       IF( NH.LE.1 ) THEN
          WORK( 1 ) = 1
          RETURN
       END IF
+*
          NX = MAX( NB, ILAENV( 3, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
          IF( NX.LT.NH ) THEN
+*
 *           Determine if workspace is large enough for blocked code
+*
-            IF( LWORK.LT.N*NB+TSIZE ) THEN
+            IF( LWORK.LT.LWKOPT ) THEN
+*
 *              Not enough workspace to use optimal NB:  determine the
 *              minimum value of NB, and reduce NB or force use of
 *              unblocked code
+*
       COMPLEX*16         ONE
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, K
-      COMPLEX*16         ALPHA
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF, ZLARFG
+      EXTERNAL           XERBLA, ZLACGV, ZLARF1F, ZLARFG
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
       DO 10 I = 1, K
+*
 *        Generate elementary reflector H(i) to annihilate A(i,i+1:n)
+*
          CALL ZLACGV( N-I+1, A( I, I ), LDA )
-         ALPHA = A( I, I )
-         CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
+         CALL ZLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
      $                TAU( I ) )
          IF( I.LT.M ) THEN
+*
 *           Apply H(i) to A(i+1:m,i:n) from the right
+*
-            A( I, I ) = ONE
+            CALL ZLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
-            CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
+     $                    TAU( I ),
-     $                  A( I+1, I ), LDA, WORK )
+     $                    A( I+1, I ), LDA, WORK )
          END IF
-         A( I, I ) = ALPHA
          CALL ZLACGV( N-I+1, A( I, I ), LDA )
 CONTINUE
       RETURN
+*
 *     End of ZGELQ2
 *> \endverbatim
 *>
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The dimension of the array WORK.  LWORK >= max(1,M).
+*>          The dimension of the array WORK.
+*>          LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise.
 *>          For optimum performance LWORK >= M*NB, where NB is the
 *>          optimal blocksize.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
 *>          only calculates the optimal size of the WORK array, returns
 *     .. Executable Statements ..
+*
 *     Test the input arguments
+*
       INFO = 0
+      K = MIN( M, N )
       NB = ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
-      LWKOPT = M*NB
-      WORK( 1 ) = LWKOPT
       LQUERY = ( LWORK.EQ.-1 )
       IF( M.LT.0 ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
          INFO = -4
-      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
+      ELSE IF( .NOT.LQUERY ) THEN
+         IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) )
-         INFO = -7
+     $      INFO = -7
       END IF
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZGELQF', -INFO )
          RETURN
       ELSE IF( LQUERY ) THEN
+         IF( K.EQ.0 ) THEN
+            LWKOPT = 1
+         ELSE
+            LWKOPT = M*NB
+         END IF
+         WORK( 1 ) = LWKOPT
          RETURN
       END IF
+*
 *     Quick return if possible
+*
-      K = MIN( M, N )
       IF( K.EQ.0 ) THEN
          WORK( 1 ) = 1
          RETURN
       END IF
+*
             IF( I+IB.LE.M ) THEN
+*
 *              Form the triangular factor of the block reflector
 *              H = H(i) H(i+1) . . . H(i+ib-1)
+*
-               CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
+               CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I,
+     $                      I ),
      $                      LDA, TAU( I ), WORK, LDWORK )
+*
 *              Apply H to A(i+ib:m,i:n) from the right
+*
                CALL ZLARFB( 'Right', 'No transpose', 'Forward',
 *>
 *> \verbatim
 *>
 *> ZGELS solves overdetermined or underdetermined complex linear systems
 *> involving an M-by-N matrix A, or its conjugate-transpose, using a QR
+*> or LQ factorization of A.
+*>
+*> It is assumed that A has full rank, and only a rudimentary protection
+*> against rank-deficient matrices is provided. This subroutine only detects
+*> exact rank-deficiency, where a diagonal element of the triangular factor
+*> of A is exactly zero.
+*>
+*> It is conceivable for one (or more) of the diagonal elements of the triangular
+*> factor of A to be subnormally tiny numbers without this subroutine signalling
+*> an error. The solutions computed for such almost-rank-deficient matrices may
-*> or LQ factorization of A.  It is assumed that A has full rank.
+*> be less accurate due to a loss of numerical precision.
 *>
 *> The following options are provided:
 *>
 *> 1. If TRANS = 'N' and m >= n:  find the least squares solution of
 *>    an overdetermined system, i.e., solve the least squares problem
 *> \verbatim
 *>          INFO is INTEGER
 *>          = 0:  successful exit
 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 *>          > 0:  if INFO =  i, the i-th diagonal element of the
-*>                triangular factor of A is zero, so that A does not have
+*>                triangular factor of A is exactly zero, so that A does not have
 *>                full rank; the least squares solution could not be
 *>                computed.
 *> \endverbatim
+*
 *  Authors:
 *> \author NAG Ltd.
+*
 *> \ingroup gels
+*
 *  =====================================================================
-      SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
+      SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK,
+     $                  LWORK,
      $                  INFO )
+*
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
       INTEGER            ILAENV
       DOUBLE PRECISION   DLAMCH, ZLANGE
       EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANGE
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGELQF, ZGEQRF, ZLASCL, ZLASET,
+      EXTERNAL           XERBLA, ZGELQF, ZGEQRF, ZLASCL,
+     $                   ZLASET,
      $                   ZTRTRS, ZUNMLQ, ZUNMQR
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, MAX, MIN
 *     ..
 *     Test the input arguments.
+*
       INFO = 0
       MN = MIN( M, N )
       LQUERY = ( LWORK.EQ.-1 )
-      IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'C' ) ) ) THEN
+      IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
+     $    LSAME( TRANS, 'C' ) ) ) THEN
          INFO = -1
       ELSE IF( M.LT.0 ) THEN
          INFO = -2
       ELSE IF( N.LT.0 ) THEN
          INFO = -3
       END IF
+*
 *     Quick return if possible
+*
       IF( MIN( M, N, NRHS ).EQ.0 ) THEN
-         CALL ZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB )
+         CALL ZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B,
+     $                LDB )
          RETURN
       END IF
+*
 *     Get machine parameters
+*
+*
       IF( M.GE.N ) THEN
+*
 *        compute QR factorization of A
+*
-         CALL ZGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
+         CALL ZGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ),
+     $                LWORK-MN,
      $                INFO )
+*
 *        workspace at least N, optimally N*NB
+*
          IF( .NOT.TPSD ) THEN
+*
 *           Least-Squares Problem min || A * X - B ||
+*
 *           B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS)
+*
-            CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N, A,
+            CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N,
+     $                   A,
      $                   LDA, WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
      $                   INFO )
+*
 *           workspace at least NRHS, optimally NRHS*NB
+*
 *           B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
+*
-            CALL ZTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS,
+            CALL ZTRTRS( 'Upper', 'No transpose', 'Non-unit', N,
+     $                   NRHS,
      $                   A, LDA, B, LDB, INFO )
+*
             IF( INFO.GT.0 ) THEN
                RETURN
             END IF
+*
       ELSE
+*
 *        Compute LQ factorization of A
+*
-         CALL ZGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
+         CALL ZGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ),
+     $                LWORK-MN,
      $                INFO )
+*
 *        workspace at least M, optimally M*NB.
+*
          IF( .NOT.TPSD ) THEN
+*
 *           underdetermined system of equations A * X = B
+*
 *           B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
+*
-            CALL ZTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS,
+            CALL ZTRTRS( 'Lower', 'No transpose', 'Non-unit', M,
+     $                   NRHS,
      $                   A, LDA, B, LDB, INFO )
+*
             IF( INFO.GT.0 ) THEN
                RETURN
             END IF
 CONTINUE
 CONTINUE
+*
 *           B(1:N,1:NRHS) := Q(1:N,:)**H * B(1:M,1:NRHS)
+*
-            CALL ZUNMLQ( 'Left', 'Conjugate transpose', N, NRHS, M, A,
+            CALL ZUNMLQ( 'Left', 'Conjugate transpose', N, NRHS, M,
+     $                   A,
      $                   LDA, WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
      $                   INFO )
+*
 *           workspace at least NRHS, optimally NRHS*NB
+*
      $                   LDWORK, LIWORK, LRWORK, MAXMN, MAXWRK, MINMN,
      $                   MINWRK, MM, MNTHR, NLVL, NRWORK, NWORK, SMLSIZ
       DOUBLE PRECISION   ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLASCL, DLASET, XERBLA, ZGEBRD, ZGELQF, ZGEQRF,
+      EXTERNAL           DLASCL, DLASET, XERBLA, ZGEBRD, ZGELQF,
+     $                   ZGEQRF,
      $                   ZLACPY, ZLALSD, ZLASCL, ZLASET, ZUNMBR, ZUNMLQ,
      $                   ZUNMQR
 *     ..
 *     .. External Functions ..
       INTEGER            ILAENV
+*
 *              Path 1a - overdetermined, with many more rows than
 *                        columns.
+*
                MM = N
-               MAXWRK = MAX( MAXWRK, N*ILAENV( 1, 'ZGEQRF', ' ', M, N,
+               MAXWRK = MAX( MAXWRK, N*ILAENV( 1, 'ZGEQRF', ' ', M,
+     $                       N,
      $                       -1, -1 ) )
-               MAXWRK = MAX( MAXWRK, NRHS*ILAENV( 1, 'ZUNMQR', 'LC', M,
+               MAXWRK = MAX( MAXWRK, NRHS*ILAENV( 1, 'ZUNMQR', 'LC',
+     $                       M,
      $                       NRHS, N, -1 ) )
             END IF
             IF( M.GE.N ) THEN
+*
 *              Path 1 - overdetermined or exactly determined.
      $                     -1 )
                   MAXWRK = MAX( MAXWRK, M*M + 4*M + 2*M*ILAENV( 1,
      $                          'ZGEBRD', ' ', M, M, -1, -1 ) )
                   MAXWRK = MAX( MAXWRK, M*M + 4*M + NRHS*ILAENV( 1,
      $                          'ZUNMBR', 'QLC', M, NRHS, M, -1 ) )
+                  MAXWRK = MAX( MAXWRK,
-                  MAXWRK = MAX( MAXWRK, M*M + 4*M + ( M - 1 )*ILAENV( 1,
+     $                          M*M + 4*M + ( M - 1 )*ILAENV( 1,
      $                          'ZUNMLQ', 'LC', N, NRHS, M, -1 ) )
                   IF( NRHS.GT.1 ) THEN
                      MAXWRK = MAX( MAXWRK, M*M + M + M*NRHS )
                   ELSE
                      MAXWRK = MAX( MAXWRK, M*M + 2*M )
      $                 4*M+M*M+MAX( M, 2*M-4, NRHS, N-3*M ) )
                ELSE
+*
 *                 Path 2 - underdetermined.
+*
-                  MAXWRK = 2*M + ( N + M )*ILAENV( 1, 'ZGEBRD', ' ', M,
+                  MAXWRK = 2*M + ( N + M )*ILAENV( 1, 'ZGEBRD', ' ',
+     $                             M,
      $                     N, -1, -1 )
-                  MAXWRK = MAX( MAXWRK, 2*M + NRHS*ILAENV( 1, 'ZUNMBR',
+                  MAXWRK = MAX( MAXWRK, 2*M + NRHS*ILAENV( 1,
+     $                          'ZUNMBR',
      $                          'QLC', M, NRHS, M, -1 ) )
                   MAXWRK = MAX( MAXWRK, 2*M + M*ILAENV( 1, 'ZUNMBR',
      $                          'PLN', N, NRHS, M, -1 ) )
                   MAXWRK = MAX( MAXWRK, 2*M + M*NRHS )
                END IF
       IBSCL = 0
       IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
+*
 *        Scale matrix norm up to SMLNUM.
+*
-         CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 1
       ELSE IF( BNRM.GT.BIGNUM ) THEN
+*
 *        Scale matrix norm down to BIGNUM.
+*
-         CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 2
       END IF
+*
 *     If M < N make sure B(M+1:N,:) = 0
+*
       IF( M.LT.N )
-     $   CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), LDB )
+     $   CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ),
+     $                LDB )
+*
 *     Overdetermined case.
+*
       IF( M.GE.N ) THEN
+*
+*
 *           Multiply B by transpose(Q).
 *           (RWorkspace: need N)
 *           (CWorkspace: need NRHS, prefer NRHS*NB)
+*
-            CALL ZUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), B,
+            CALL ZUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ),
+     $                   B,
      $                   LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
+*
 *           Zero out below R.
+*
             IF( N.GT.1 ) THEN
      $                INFO )
+*
 *        Multiply B by transpose of left bidiagonalizing vectors of R.
 *        (CWorkspace: need 2*N+NRHS, prefer 2*N+NRHS*NB)
+*
-         CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, WORK( ITAUQ ),
+         CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA,
+     $                WORK( ITAUQ ),
      $                B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
+*
 *        Solve the bidiagonal least squares problem.
+*
          CALL ZLALSD( 'U', SMLSIZ, N, NRHS, S, RWORK( IE ), B, LDB,
             GO TO 10
          END IF
+*
 *        Multiply B by right bidiagonalizing vectors of R.
+*
-         CALL ZUNMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, WORK( ITAUP ),
+         CALL ZUNMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA,
+     $                WORK( ITAUP ),
      $                B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
+*
       ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+
      $         MAX( M, 2*M-4, NRHS, N-3*M ) ) THEN
+*
      $                WORK( ITAUP ), B, LDB, WORK( NWORK ),
      $                LWORK-NWORK+1, INFO )
+*
 *        Zero out below first M rows of B.
+*
-         CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), LDB )
+         CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ),
+     $                LDB )
          NWORK = ITAU + M
+*
 *        Multiply transpose(Q) by B.
 *        (CWorkspace: need NRHS, prefer NRHS*NB)
+*
      $                INFO )
+*
 *        Multiply B by transpose of left bidiagonalizing vectors.
 *        (CWorkspace: need 2*M+NRHS, prefer 2*M+NRHS*NB)
+*
-         CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAUQ ),
+         CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA,
+     $                WORK( ITAUQ ),
      $                B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
+*
 *        Solve the bidiagonal least squares problem.
+*
          CALL ZLALSD( 'L', SMLSIZ, M, NRHS, S, RWORK( IE ), B, LDB,
             GO TO 10
          END IF
+*
 *        Multiply B by right bidiagonalizing vectors of A.
+*
-         CALL ZUNMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, WORK( ITAUP ),
+         CALL ZUNMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA,
+     $                WORK( ITAUP ),
      $                B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO )
+*
       END IF
+*
 *     Undo scaling.
+*
       IF( IASCL.EQ.1 ) THEN
-         CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
      $                INFO )
       ELSE IF( IASCL.EQ.2 ) THEN
-         CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
      $                INFO )
       END IF
       IF( IBSCL.EQ.1 ) THEN
-         CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       END IF
+*
 CONTINUE
       WORK( 1 ) = MAXWRK
       IWORK( 1 ) = LIWORK
       LOGICAL            LQUERY
       INTEGER            FJB, IWS, J, JB, LWKOPT, MINMN, MINWS, NA, NB,
      $                   NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEQRF, ZLAQP2, ZLAQPS, ZSWAP, ZUNMQR
+      EXTERNAL           XERBLA, ZGEQRF, ZLAQP2, ZLAQPS, ZSWAP,
+     $                   ZUNMQR
 *     ..
 *     .. External Functions ..
       INTEGER            ILAENV
       DOUBLE PRECISION   DZNRM2
       EXTERNAL           ILAENV, DZNRM2
          IWS = MAX( IWS, INT( WORK( 1 ) ) )
          IF( NA.LT.N ) THEN
 *CC         CALL ZUNM2R( 'Left', 'Conjugate Transpose', M, N-NA,
 *CC  $                   NA, A, LDA, TAU, A( 1, NA+1 ), LDA, WORK,
 *CC  $                   INFO )
-            CALL ZUNMQR( 'Left', 'Conjugate Transpose', M, N-NA, NA, A,
+            CALL ZUNMQR( 'Left', 'Conjugate Transpose', M, N-NA, NA,
+     $                   A,
      $                   LDA, TAU, A( 1, NA+1 ), LDA, WORK, LWORK,
      $                   INFO )
             IWS = MAX( IWS, INT( WORK( 1 ) ) )
          END IF
       END IF
+*
 *                 Not enough workspace to use optimal NB: Reduce NB and
 *                 determine the minimum value of NB.
+*
                   NB = LWORK / ( SN+1 )
-                  NBMIN = MAX( 2, ILAENV( INBMIN, 'ZGEQRF', ' ', SM, SN,
+                  NBMIN = MAX( 2, ILAENV( INBMIN, 'ZGEQRF', ' ', SM,
+     $                         SN,
      $                    -1, -1 ) )
+*
+*
                END IF
             END IF
       COMPLEX*16         ONE
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, K
-      COMPLEX*16         ALPHA
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF, ZLARFG
+      EXTERNAL           XERBLA, ZLARF1F, ZLARFG
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCONJG, MAX, MIN
 *     ..
 *     .. Executable Statements ..
      $                TAU( I ) )
          IF( I.LT.N ) THEN
+*
 *           Apply H(i)**H to A(i:m,i+1:n) from the left
+*
-            ALPHA = A( I, I )
-            A( I, I ) = ONE
-            CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
+            CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
-     $                  DCONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
+     $                    CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK )
-            A( I, I ) = ALPHA
          END IF
 CONTINUE
       RETURN
+*
 *     End of ZGEQR2
 *> \author NAG Ltd.
+*
 *> \ingroup gerfs
+*
 *  =====================================================================
-      SUBROUTINE ZGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
+      SUBROUTINE ZGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
+     $                   LDB,
      $                   X, LDX, FERR, BERR, WORK, RWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH
       EXTERNAL           LSAME, DLAMCH
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGETRS, ZLACN2
+      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGETRS,
+     $                   ZLACN2
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DIMAG, MAX
 *     ..
 *     .. Statement Functions ..
+*
 *        Compute residual R = B - op(A) * X,
 *        where op(A) = A, A**T, or A**H, depending on TRANS.
+*
          CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 )
-         CALL ZGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK,
+         CALL ZGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE,
+     $               WORK,
      $               1 )
+*
 *        Compute componentwise relative backward error from formula
+*
 *        max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )
       INTEGER            IDUM( 1 )
       DOUBLE PRECISION   DUM( 1 )
       COMPLEX*16         CDUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DBDSDC, DLASCL, XERBLA, ZGEBRD, ZGELQF, ZGEMM,
+      EXTERNAL           DBDSDC, DLASCL, XERBLA, ZGEBRD, ZGELQF,
+     $                   ZGEMM,
      $                   ZGEQRF, ZLACP2, ZLACPY, ZLACRM, ZLARCM, ZLASCL,
      $                   ZLASET, ZUNGBR, ZUNGLQ, ZUNGQR, ZUNMBR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME, DISNAN
+*
             CALL ZGEBRD( N, N, CDUM(1), N, DUM(1), DUM(1), CDUM(1),
      $                   CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGEBRD_NN = INT( CDUM(1) )
+*
-            CALL ZGEQRF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR )
+            CALL ZGEQRF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1,
+     $                   IERR )
             LWORK_ZGEQRF_MN = INT( CDUM(1) )
+*
             CALL ZUNGBR( 'P', N, N, N, CDUM(1), N, CDUM(1), CDUM(1),
      $                   -1, IERR )
             LWORK_ZUNGBR_P_NN = INT( CDUM(1) )
+*
             CALL ZGEBRD( M, M, CDUM(1), M, DUM(1), DUM(1), CDUM(1),
      $                   CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGEBRD_MM = INT( CDUM(1) )
+*
-            CALL ZGELQF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR )
+            CALL ZGELQF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1,
+     $                   IERR )
             LWORK_ZGELQF_MN = INT( CDUM(1) )
+*
             CALL ZUNGBR( 'P', M, N, M, CDUM(1), M, CDUM(1), CDUM(1),
      $                   -1, IERR )
             LWORK_ZUNGBR_P_MN = INT( CDUM(1) )
 *              Compute A=Q*R
 *              CWorkspace: need   N [tau] + N    [work]
 *              CWorkspace: prefer N [tau] + N*NB [work]
 *              RWorkspace: need   0
+*
-               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
+               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Zero out below R
+*
                CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ),
 *              Bidiagonalize R in A
 *              CWorkspace: need   2*N [tauq, taup] + N      [work]
 *              CWorkspace: prefer 2*N [tauq, taup] + 2*N*NB [work]
 *              RWorkspace: need   N [e]
+*
-               CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
+               CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
+     $                      WORK( ITAUQ ),
      $                      WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
      $                      IERR )
                NRWORK = IE + N
+*
 *              Perform bidiagonal SVD, compute singular values only
 *              Compute A=Q*R
 *              CWorkspace: need   N*N [U] + N*N [R] + N [tau] + N    [work]
 *              CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work]
 *              RWorkspace: need   0
+*
-               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
+               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Copy R to WORK( IR ), zeroing out below it
+*
                CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
-               CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, WORK( IR+1 ),
+               CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
+     $                      WORK( IR+1 ),
      $                      LDWRKR )
+*
 *              Generate Q in A
 *              CWorkspace: need   N*N [U] + N*N [R] + N [tau] + N    [work]
 *              CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work]
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
                IRU = IE + N
                IRVT = IRU + N*N
                NRWORK = IRVT + N*N
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix WORK(IU)
 *              Overwrite WORK(IU) by the left singular vectors of R
 *              CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work]
 *              RWorkspace: need   0
+*
                CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ),
      $                      LDWRKU )
-               CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR,
+               CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ),
+     $                      LDWRKR,
      $                      WORK( ITAUQ ), WORK( IU ), LDWRKU,
      $                      WORK( NWORK ), LWORK-NWORK+1, IERR )
+*
 *              Copy real matrix RWORK(IRVT) to complex matrix VT
 *              Overwrite VT by the right singular vectors of R
 *              CWorkspace: need   N*N [U] + N*N [R] + 2*N [tauq, taup] + N    [work]
 *              CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work]
 *              RWorkspace: need   0
+*
                CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT )
-               CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR,
+               CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ),
+     $                      LDWRKR,
      $                      WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Multiply Q in A by left singular vectors of R in
 *              WORK(IU), storing result in WORK(IR) and copying to A
 *              Compute A=Q*R
 *              CWorkspace: need   N*N [R] + N [tau] + N    [work]
 *              CWorkspace: prefer N*N [R] + N [tau] + N*NB [work]
 *              RWorkspace: need   0
+*
-               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
+               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Copy R to WORK(IR), zeroing out below it
+*
                CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
-               CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, WORK( IR+1 ),
+               CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
+     $                      WORK( IR+1 ),
      $                      LDWRKR )
+*
 *              Generate Q in A
 *              CWorkspace: need   N*N [R] + N [tau] + N    [work]
 *              CWorkspace: prefer N*N [R] + N [tau] + N*NB [work]
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
                IRU = IE + N
                IRVT = IRU + N*N
                NRWORK = IRVT + N*N
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix U
 *              Overwrite U by left singular vectors of R
 *              CWorkspace: need   N*N [R] + 2*N [tauq, taup] + N    [work]
 *              CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work]
 *              RWorkspace: need   0
+*
                CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU )
-               CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR,
+               CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ),
+     $                      LDWRKR,
      $                      WORK( ITAUQ ), U, LDU, WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Copy real matrix RWORK(IRVT) to complex matrix VT
 *              Overwrite VT by right singular vectors of R
 *              CWorkspace: need   N*N [R] + 2*N [tauq, taup] + N    [work]
 *              CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work]
 *              RWorkspace: need   0
+*
                CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT )
-               CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR,
+               CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ),
+     $                      LDWRKR,
      $                      WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Multiply Q in A by left singular vectors of R in
 *              WORK(IR), storing result in U
 *              CWorkspace: need   N*N [R]
 *              RWorkspace: need   0
+*
                CALL ZLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR )
-               CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA, WORK( IR ),
+               CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA,
+     $                     WORK( IR ),
      $                     LDWRKR, CZERO, U, LDU )
+*
             ELSE IF( WNTQA ) THEN
+*
 *              Path 4 (M >> N, JOBZ='A')
 *              Compute A=Q*R, copying result to U
 *              CWorkspace: need   N*N [U] + N [tau] + N    [work]
 *              CWorkspace: prefer N*N [U] + N [tau] + N*NB [work]
 *              RWorkspace: need   0
+*
-               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
+               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
                CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
+*
 *              Generate Q in U
 *              CWorkspace: need   N*N [U] + N [tau] + M    [work]
 *              Bidiagonalize R in A
 *              CWorkspace: need   N*N [U] + 2*N [tauq, taup] + N      [work]
 *              CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + 2*N*NB [work]
 *              RWorkspace: need   N [e]
+*
-               CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
+               CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
+     $                      WORK( ITAUQ ),
      $                      WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
      $                      IERR )
                IRU = IE + N
                IRVT = IRU + N*N
                NRWORK = IRVT + N*N
 *              of bidiagonal matrix in RWORK(IRU) and computing right
 *              singular vectors of bidiagonal matrix in RWORK(IRVT)
 *              CWorkspace: need   0
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix WORK(IU)
 *              Overwrite WORK(IU) by left singular vectors of R
 *              Multiply Q in U by left singular vectors of R in
 *              WORK(IU), storing result in A
 *              CWorkspace: need   N*N [U]
 *              RWorkspace: need   0
+*
-               CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU, WORK( IU ),
+               CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU,
+     $                     WORK( IU ),
      $                     LDWRKU, CZERO, A, LDA )
+*
 *              Copy left singular vectors of A from A to U
+*
                CALL ZLACPY( 'F', M, N, A, LDA, U, LDU )
 *              Path 5n (M >> N, JOBZ='N')
 *              Compute singular values only
 *              CWorkspace: need   0
 *              RWorkspace: need   N [e] + BDSPAC
+*
-               CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1,DUM,1,
+               CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1,DUM,
+     $                      1,
      $                      DUM, IDUM, RWORK( NRWORK ), IWORK, INFO )
             ELSE IF( WNTQO ) THEN
                IU = NWORK
                IRU = NRWORK
                IRVT = IRU + N*N
 *              of bidiagonal matrix in RWORK(IRU) and computing right
 *              singular vectors of bidiagonal matrix in RWORK(IRVT)
 *              CWorkspace: need   0
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Multiply real matrix RWORK(IRVT) by P**H in VT,
 *              storing the result in WORK(IU), copying to VT
 *              RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here
+*
                NRWORK = IRVT
                DO 20 I = 1, M, LDWRKU
                   CHUNK = MIN( M-I+1, LDWRKU )
-                  CALL ZLACRM( CHUNK, N, A( I, 1 ), LDA, RWORK( IRU ),
+                  CALL ZLACRM( CHUNK, N, A( I, 1 ), LDA,
+     $                         RWORK( IRU ),
      $                         N, WORK( IU ), LDWRKU, RWORK( NRWORK ) )
                   CALL ZLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
      $                         A( I, 1 ), LDA )
 CONTINUE
+*
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
                IRU = NRWORK
                IRVT = IRU + N*N
                NRWORK = IRVT + N*N
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Multiply real matrix RWORK(IRVT) by P**H in VT,
 *              storing the result in A, copying to VT
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
                IRU = NRWORK
                IRVT = IRU + N*N
                NRWORK = IRVT + N*N
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Multiply real matrix RWORK(IRVT) by P**H in VT,
 *              storing the result in A, copying to VT
 *              of bidiagonal matrix in RWORK(IRU) and computing right
 *              singular vectors of bidiagonal matrix in RWORK(IRVT)
 *              CWorkspace: need   0
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRVT) to complex matrix VT
 *              Overwrite VT by right singular vectors of A
 *                 CWorkspace: prefer 2*N [tauq, taup] + M*N [U] + N*NB [work]
 *                 RWorkspace: need   N [e] + N*N [RU]
+*
                   CALL ZLASET( 'F', M, N, CZERO, CZERO, WORK( IU ),
      $                         LDWRKU )
-                  CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ),
+                  CALL ZLACP2( 'F', N, N, RWORK( IRU ), N,
+     $                         WORK( IU ),
      $                         LDWRKU )
                   CALL ZUNMBR( 'Q', 'L', 'N', M, N, N, A, LDA,
      $                         WORK( ITAUQ ), WORK( IU ), LDWRKU,
      $                         WORK( NWORK ), LWORK-NWORK+1, IERR )
-                  CALL ZLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA )
+                  CALL ZLACPY( 'F', M, N, WORK( IU ), LDWRKU, A,
+     $                         LDA )
                ELSE
+*
 *                 Path 6o-slow
 *                 Generate Q in A
 *                 CWorkspace: need   2*N [tauq, taup] + N*N [U] + N    [work]
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
                IRU = NRWORK
                IRVT = IRU + N*N
                NRWORK = IRVT + N*N
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix U
 *              Overwrite U by left singular vectors of A
 *              RWorkspace: need   N [e] + N*N [RU] + N*N [RVT] + BDSPAC
+*
                IRU = NRWORK
                IRVT = IRU + N*N
                NRWORK = IRVT + N*N
-               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      N, RWORK( IRVT ), N, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Set the right corner of U to identity matrix
+*
 *              Compute A=L*Q
 *              CWorkspace: need   M [tau] + M    [work]
 *              CWorkspace: prefer M [tau] + M*NB [work]
 *              RWorkspace: need   0
+*
-               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
+               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Zero out above L
+*
                CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, A( 1, 2 ),
 *              Bidiagonalize L in A
 *              CWorkspace: need   2*M [tauq, taup] + M      [work]
 *              CWorkspace: prefer 2*M [tauq, taup] + 2*M*NB [work]
 *              RWorkspace: need   M [e]
+*
-               CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
+               CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
+     $                      WORK( ITAUQ ),
      $                      WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
      $                      IERR )
                NRWORK = IE + M
+*
 *              Perform bidiagonal SVD, compute singular values only
 *              Compute A=L*Q
 *              CWorkspace: need   M*M [VT] + M*M [L] + M [tau] + M    [work]
 *              CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work]
 *              RWorkspace: need   0
+*
-               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
+               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Copy L to WORK(IL), zeroing about above it
+*
                CALL ZLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL )
 *              RWorkspace: need   M [e] + M*M [RU] + M*M [RVT] + BDSPAC
+*
                IRU = IE + M
                IRVT = IRU + M*M
                NRWORK = IRVT + M*M
-               CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix WORK(IU)
 *              Overwrite WORK(IU) by the left singular vectors of L
 *              CWorkspace: need   M*M [VT] + M*M [L] + 2*M [tauq, taup] + M    [work]
 *              CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work]
 *              RWorkspace: need   0
+*
                CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU )
-               CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL,
+               CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ),
+     $                      LDWRKL,
      $                      WORK( ITAUQ ), U, LDU, WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT)
 *              Overwrite WORK(IVT) by the right singular vectors of L
 *              CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work]
 *              RWorkspace: need   0
+*
                CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ),
      $                      LDWKVT )
-               CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL,
+               CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ),
+     $                      LDWRKL,
      $                      WORK( ITAUP ), WORK( IVT ), LDWKVT,
      $                      WORK( NWORK ), LWORK-NWORK+1, IERR )
+*
 *              Multiply right singular vectors of L in WORK(IL) by Q
 *              in A, storing result in WORK(IL) and copying to A
 *              CWorkspace: prefer M*M [VT] + M*N [L]
 *              RWorkspace: need   0
+*
                DO 40 I = 1, N, CHUNK
                   BLK = MIN( N-I+1, CHUNK )
-                  CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IVT ), M,
+                  CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IVT ),
+     $                        M,
      $                        A( 1, I ), LDA, CZERO, WORK( IL ),
      $                        LDWRKL )
                   CALL ZLACPY( 'F', M, BLK, WORK( IL ), LDWRKL,
      $                         A( 1, I ), LDA )
 CONTINUE
 *              Compute A=L*Q
 *              CWorkspace: need   M*M [L] + M [tau] + M    [work]
 *              CWorkspace: prefer M*M [L] + M [tau] + M*NB [work]
 *              RWorkspace: need   0
+*
-               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
+               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Copy L to WORK(IL), zeroing out above it
+*
                CALL ZLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL )
 *              RWorkspace: need   M [e] + M*M [RU] + M*M [RVT] + BDSPAC
+*
                IRU = IE + M
                IRVT = IRU + M*M
                NRWORK = IRVT + M*M
-               CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix U
 *              Overwrite U by left singular vectors of L
 *              CWorkspace: need   M*M [L] + 2*M [tauq, taup] + M    [work]
 *              CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work]
 *              RWorkspace: need   0
+*
                CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU )
-               CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL,
+               CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ),
+     $                      LDWRKL,
      $                      WORK( ITAUQ ), U, LDU, WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Copy real matrix RWORK(IRVT) to complex matrix VT
 *              Overwrite VT by left singular vectors of L
 *              CWorkspace: need   M*M [L] + 2*M [tauq, taup] + M    [work]
 *              CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work]
 *              RWorkspace: need   0
+*
                CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT )
-               CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL,
+               CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ),
+     $                      LDWRKL,
      $                      WORK( ITAUP ), VT, LDVT, WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
+*
 *              Copy VT to WORK(IL), multiply right singular vectors of L
 *              in WORK(IL) by Q in A, storing result in VT
 *              CWorkspace: need   M*M [L]
 *              RWorkspace: need   0
+*
                CALL ZLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL )
-               CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), LDWRKL,
+               CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ),
+     $                     LDWRKL,
      $                     A, LDA, CZERO, VT, LDVT )
+*
             ELSE IF( WNTQA ) THEN
+*
 *              Path 4t (N >> M, JOBZ='A')
 *              Compute A=L*Q, copying result to VT
 *              CWorkspace: need   M*M [VT] + M [tau] + M    [work]
 *              CWorkspace: prefer M*M [VT] + M [tau] + M*NB [work]
 *              RWorkspace: need   0
+*
-               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ),
+               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( NWORK ),
      $                      LWORK-NWORK+1, IERR )
                CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
+*
 *              Generate Q in VT
 *              CWorkspace: need   M*M [VT] + M [tau] + N    [work]
 *              Bidiagonalize L in A
 *              CWorkspace: need   M*M [VT] + 2*M [tauq, taup] + M      [work]
 *              CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + 2*M*NB [work]
 *              RWorkspace: need   M [e]
+*
-               CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
+               CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
+     $                      WORK( ITAUQ ),
      $                      WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1,
      $                      IERR )
+*
 *              Perform bidiagonal SVD, computing left singular vectors
 *              of bidiagonal matrix in RWORK(IRU) and computing right
 *              RWorkspace: need   M [e] + M*M [RU] + M*M [RVT] + BDSPAC
+*
                IRU = IE + M
                IRVT = IRU + M*M
                NRWORK = IRVT + M*M
-               CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix U
 *              Overwrite U by left singular vectors of L
 *              Multiply right singular vectors of L in WORK(IVT) by
 *              Q in VT, storing result in A
 *              CWorkspace: need   M*M [VT]
 *              RWorkspace: need   0
+*
-               CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), LDWKVT,
+               CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ),
+     $                     LDWKVT,
      $                     VT, LDVT, CZERO, A, LDA )
+*
 *              Copy right singular vectors of A from A to VT
+*
                CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT )
 *              of bidiagonal matrix in RWORK(IRU) and computing right
 *              singular vectors of bidiagonal matrix in RWORK(IRVT)
 *              CWorkspace: need   0
 *              RWorkspace: need   M [e] + M*M [RVT] + M*M [RU] + BDSPAC
+*
-               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Multiply Q in U by real matrix RWORK(IRVT)
 *              storing the result in WORK(IVT), copying to U
 *              CWorkspace: need   2*M [tauq, taup] + M*M [VT]
 *              RWorkspace: need   M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork]
+*
-               CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M, WORK( IVT ),
+               CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M,
+     $                      WORK( IVT ),
      $                      LDWKVT, RWORK( NRWORK ) )
                CALL ZLACPY( 'F', M, M, WORK( IVT ), LDWKVT, U, LDU )
+*
 *              Multiply RWORK(IRVT) by P**H in A, storing the
 *              result in WORK(IVT), copying to A
 *              RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here
+*
                NRWORK = IRU
                DO 50 I = 1, N, CHUNK
                   BLK = MIN( N-I+1, CHUNK )
-                  CALL ZLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ), LDA,
+                  CALL ZLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ),
+     $                         LDA,
      $                         WORK( IVT ), LDWKVT, RWORK( NRWORK ) )
                   CALL ZLACPY( 'F', M, BLK, WORK( IVT ), LDWKVT,
      $                         A( 1, I ), LDA )
 CONTINUE
             ELSE IF( WNTQS ) THEN
 *              RWorkspace: need   M [e] + M*M [RVT] + M*M [RU] + BDSPAC
+*
                IRVT = NRWORK
                IRU = IRVT + M*M
                NRWORK = IRU + M*M
-               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Multiply Q in U by real matrix RWORK(IRU), storing the
 *              result in A, copying to U
 *              RWorkspace: need   M [e] + M*M [RVT] + M*M [RU] + BDSPAC
+*
                IRVT = NRWORK
                IRU = IRVT + M*M
                NRWORK = IRU + M*M
-               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Multiply Q in U by real matrix RWORK(IRU), storing the
 *              result in A, copying to U
 *              RWorkspace: need   M [e] + M*M [RVT] + M*M [RU] + BDSPAC
+*
                IRVT = NRWORK
                IRU = IRVT + M*M
                NRWORK = IRU + M*M
-               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix U
 *              Overwrite U by left singular vectors of A
 *                 copying to A
 *                 CWorkspace: need   2*M [tauq, taup] + M*N [VT] + M    [work]
 *                 CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] + M*NB [work]
 *                 RWorkspace: need   M [e] + M*M [RVT]
+*
-                  CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ),
+                  CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M,
+     $                         WORK( IVT ),
      $                         LDWKVT )
                   CALL ZUNMBR( 'P', 'R', 'C', M, N, M, A, LDA,
      $                         WORK( ITAUP ), WORK( IVT ), LDWKVT,
      $                         WORK( NWORK ), LWORK-NWORK+1, IERR )
-                  CALL ZLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA )
+                  CALL ZLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A,
+     $                         LDA )
                ELSE
+*
 *                 Path 6to-slow
 *                 Generate P**H in A
 *                 CWorkspace: need   2*M [tauq, taup] + M*M [VT] + M    [work]
 *                 RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here
+*
                   NRWORK = IRU
                   DO 60 I = 1, N, CHUNK
                      BLK = MIN( N-I+1, CHUNK )
-                     CALL ZLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ),
+                     CALL ZLARCM( M, BLK, RWORK( IRVT ), M, A( 1,
+     $                            I ),
      $                            LDA, WORK( IVT ), LDWKVT,
      $                            RWORK( NRWORK ) )
                      CALL ZLACPY( 'F', M, BLK, WORK( IVT ), LDWKVT,
      $                            A( 1, I ), LDA )
 CONTINUE
 *              RWorkspace: need   M [e] + M*M [RVT] + M*M [RU] + BDSPAC
+*
                IRVT = NRWORK
                IRU = IRVT + M*M
                NRWORK = IRU + M*M
-               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix U
 *              Overwrite U by left singular vectors of A
+*
                IRVT = NRWORK
                IRU = IRVT + M*M
                NRWORK = IRU + M*M
+*
-               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ),
+               CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ),
+     $                      RWORK( IRU ),
      $                      M, RWORK( IRVT ), M, DUM, IDUM,
      $                      RWORK( NRWORK ), IWORK, INFO )
+*
 *              Copy real matrix RWORK(IRU) to complex matrix U
 *              Overwrite U by left singular vectors of A
 *     .. Local Arrays ..
       DOUBLE PRECISION   DUM( 1 )
       COMPLEX*16         CDUM( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLASCL, XERBLA, ZBDSQR, ZGEBRD, ZGELQF, ZGEMM,
+      EXTERNAL           DLASCL, XERBLA, ZBDSQR, ZGEBRD, ZGELQF,
+     $                   ZGEMM,
      $                   ZGEQRF, ZLACPY, ZLASCL, ZLASET, ZUNGBR, ZUNGLQ,
      $                   ZUNGQR, ZUNMBR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
             MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
 *           Compute space needed for ZGEQRF
             CALL ZGEQRF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGEQRF = INT( CDUM(1) )
 *           Compute space needed for ZUNGQR
-            CALL ZUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, IERR )
+            CALL ZUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1,
+     $                   IERR )
             LWORK_ZUNGQR_N = INT( CDUM(1) )
-            CALL ZUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR )
+            CALL ZUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1,
+     $                   IERR )
             LWORK_ZUNGQR_M = INT( CDUM(1) )
 *           Compute space needed for ZGEBRD
             CALL ZGEBRD( N, N, A, LDA, S, DUM(1), CDUM(1),
      $                   CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGEBRD = INT( CDUM(1) )
             LWORK_ZGELQF = INT( CDUM(1) )
 *           Compute space needed for ZUNGLQ
             CALL ZUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), -1,
      $                   IERR )
             LWORK_ZUNGLQ_N = INT( CDUM(1) )
-            CALL ZUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, IERR )
+            CALL ZUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1,
+     $                   IERR )
             LWORK_ZUNGLQ_M = INT( CDUM(1) )
 *           Compute space needed for ZGEBRD
             CALL ZGEBRD( M, M, A, LDA, S, DUM(1), CDUM(1),
      $                   CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGEBRD = INT( CDUM(1) )
+*
 *              Compute A=Q*R
 *              (CWorkspace: need 2*N, prefer N+N*NB)
 *              (RWorkspace: need 0)
+*
-               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
+               CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( IWORK ),
      $                      LWORK-IWORK+1, IERR )
+*
 *              Zero out below R
+*
                IF( N .GT. 1 ) THEN
-                  CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ),
+                  CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2,
+     $                         1 ),
      $                         LDA )
                END IF
                IE = 1
                ITAUQ = 1
                ITAUP = ITAUQ + N
+*
 *              Bidiagonalize R in A
 *              (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
 *              (RWorkspace: need N)
+*
-               CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
+               CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
+     $                      WORK( ITAUQ ),
      $                      WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
      $                      IERR )
                NCVT = 0
                IF( WNTVO .OR. WNTVAS ) THEN
+*
 *              Perform bidiagonal QR iteration, computing right
 *              singular vectors of A in A if desired
 *              (CWorkspace: 0)
 *              (RWorkspace: need BDSPAC)
+*
-               CALL ZBDSQR( 'U', N, NCVT, 0, 0, S, RWORK( IE ), A, LDA,
+               CALL ZBDSQR( 'U', N, NCVT, 0, 0, S, RWORK( IE ), A,
+     $                      LDA,
      $                      CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO )
+*
 *              If right singular vectors desired in VT, copy them there
+*
                IF( WNTVAS )
                   CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
      $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
+*
 *                 Copy R to WORK(IR) and zero out below it
+*
-                  CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
+                  CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ),
+     $                         LDWRKR )
                   CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
      $                         WORK( IR+1 ), LDWRKR )
+*
 *                 Generate Q in A
 *                 (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
+*
 *                 Bidiagonalize R in WORK(IR)
 *                 (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
 *                 (RWorkspace: need N)
+*
-                  CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ),
+                  CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S,
+     $                         RWORK( IE ),
      $                         WORK( ITAUQ ), WORK( ITAUP ),
      $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
+*
 *                 Generate left vectors bidiagonalizing R
 *                 (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
 *                 Perform bidiagonal QR iteration, computing left
 *                 singular vectors of R in WORK(IR)
 *                 (CWorkspace: need N*N)
 *                 (RWorkspace: need BDSPAC)
+*
-                  CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, 1,
+                  CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM,
+     $                         1,
      $                         WORK( IR ), LDWRKR, CDUM, 1,
      $                         RWORK( IRWORK ), INFO )
                   IU = ITAUQ
+*
 *                 Multiply Q in A by left singular vectors of R in
 *                 (CWorkspace: need N*N+N, prefer N*N+M*N)
 *                 (RWorkspace: 0)
+*
                   DO 10 I = 1, M, LDWRKU
                      CHUNK = MIN( M-I+1, LDWRKU )
-                     CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, 1 ),
+                     CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I,
+     $                           1 ),
      $                           LDA, WORK( IR ), LDWRKR, CZERO,
      $                           WORK( IU ), LDWRKU )
                      CALL ZLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
      $                            A( I, 1 ), LDA )
 CONTINUE
 *                 Perform bidiagonal QR iteration, computing left
 *                 singular vectors of A in A
 *                 (CWorkspace: need 0)
 *                 (RWorkspace: need BDSPAC)
+*
-                  CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, 1,
+                  CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM,
+     $                         1,
      $                         A, LDA, CDUM, 1, RWORK( IRWORK ), INFO )
+*
                END IF
+*
             ELSE IF( WNTUO .AND. WNTVAS ) THEN
 *                 (RWorkspace: need N)
+*
                   CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ),
      $                         WORK( ITAUQ ), WORK( ITAUP ),
      $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  CALL ZLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR )
+                  CALL ZLACPY( 'L', N, N, VT, LDVT, WORK( IR ),
+     $                         LDWRKR )
+*
 *                 Generate left vectors bidiagonalizing R in WORK(IR)
 *                 (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
 *                 (RWorkspace: 0)
+*
 *                 (CWorkspace: need N*N+N, prefer N*N+M*N)
 *                 (RWorkspace: 0)
+*
                   DO 20 I = 1, M, LDWRKU
                      CHUNK = MIN( M-I+1, LDWRKU )
-                     CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, 1 ),
+                     CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I,
+     $                           1 ),
      $                           LDA, WORK( IR ), LDWRKR, CZERO,
      $                           WORK( IU ), LDWRKU )
                      CALL ZLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
      $                            A( I, 1 ), LDA )
 CONTINUE
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of R in WORK(IR)
 *                    (CWorkspace: need N*N)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM,
+                     CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ),
+     $                            CDUM,
      $                            1, WORK( IR ), LDWRKR, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
 *                    Multiply Q in A by left singular vectors of R in
 *                    WORK(IR), storing result in U
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in U
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM,
+                     CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ),
+     $                            CDUM,
      $                            1, U, LDU, CDUM, 1, RWORK( IRWORK ),
      $                            INFO )
+*
                   END IF
+*
+*
 *                    Generate right vectors bidiagonalizing R in A
 *                    (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
+                     CALL ZUNGBR( 'P', N, N, N, A, LDA,
+     $                            WORK( ITAUP ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + N
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in U and computing right
 *                    Generate right bidiagonalizing vectors in VT
 *                    (CWorkspace: need   N*N+3*N-1,
 *                                 prefer N*N+2*N+(N-1)*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
+                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT,
+     $                            WORK( ITAUP ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + N
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of R in WORK(IU) and computing
 *                    right singular vectors of R in VT
 *                    (CWorkspace: need N*N)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, WORK( IU ), LDWRKU, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
 *                    Multiply Q in A by left singular vectors of R in
 *                    WORK(IU), storing result in U
+*
 *                    Generate right bidiagonalizing vectors in VT
 *                    (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
+                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT,
+     $                            WORK( ITAUP ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + N
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in U and computing right
 *                    singular vectors of A in VT
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, U, LDU, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
                   END IF
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of R in WORK(IR)
 *                    (CWorkspace: need N*N)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM,
+                     CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ),
+     $                            CDUM,
      $                            1, WORK( IR ), LDWRKR, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
 *                    Multiply Q in U by left singular vectors of R in
 *                    WORK(IR), storing result in A
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in U
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM,
+                     CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ),
+     $                            CDUM,
      $                            1, U, LDU, CDUM, 1, RWORK( IRWORK ),
      $                            INFO )
+*
                   END IF
+*
+*
 *                    Generate right bidiagonalizing vectors in A
 *                    (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
+                     CALL ZUNGBR( 'P', N, N, N, A, LDA,
+     $                            WORK( ITAUP ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + N
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in U and computing right
 *                    Generate right bidiagonalizing vectors in VT
 *                    (CWorkspace: need   N*N+3*N-1,
 *                                 prefer N*N+2*N+(N-1)*NB)
 *                    (RWorkspace: need   0)
+*
-                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
+                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT,
+     $                            WORK( ITAUP ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + N
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of R in WORK(IU) and computing
 *                    right singular vectors of R in VT
 *                    (CWorkspace: need N*N)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, WORK( IU ), LDWRKU, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
 *                    Multiply Q in U by left singular vectors of R in
 *                    WORK(IU), storing result in A
+*
 *                    Generate right bidiagonalizing vectors in VT
 *                    (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
+                     CALL ZUNGBR( 'P', N, N, N, VT, LDVT,
+     $                            WORK( ITAUP ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + N
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in U and computing right
 *                    singular vectors of A in VT
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, U, LDU, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
                   END IF
+*
+*
 *              Compute A=L*Q
 *              (CWorkspace: need 2*M, prefer M+M*NB)
 *              (RWorkspace: 0)
+*
-               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
+               CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
+     $                      WORK( IWORK ),
      $                      LWORK-IWORK+1, IERR )
+*
 *              Zero out above L
+*
                CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, A( 1, 2 ),
+*
 *              Bidiagonalize L in A
 *              (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
 *              (RWorkspace: need M)
+*
-               CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
+               CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
+     $                      WORK( ITAUQ ),
      $                      WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
      $                      IERR )
                IF( WNTUO .OR. WNTUAS ) THEN
+*
 *                 If left singular vectors desired, generate Q
 *              Perform bidiagonal QR iteration, computing left singular
 *              vectors of A in A if desired
 *              (CWorkspace: 0)
 *              (RWorkspace: need BDSPAC)
+*
-               CALL ZBDSQR( 'U', M, 0, NRU, 0, S, RWORK( IE ), CDUM, 1,
+               CALL ZBDSQR( 'U', M, 0, NRU, 0, S, RWORK( IE ), CDUM,
+     $                      1,
      $                      A, LDA, CDUM, 1, RWORK( IRWORK ), INFO )
+*
 *              If left singular vectors desired in U, copy them there
+*
                IF( WNTUAS )
                   CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
      $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
+*
 *                 Copy L to WORK(IR) and zero out above it
+*
-                  CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR )
+                  CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ),
+     $                         LDWRKR )
                   CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
      $                         WORK( IR+LDWRKR ), LDWRKR )
+*
 *                 Generate Q in A
 *                 (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
+*
 *                 Bidiagonalize L in WORK(IR)
 *                 (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
 *                 (RWorkspace: need M)
+*
-                  CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S, RWORK( IE ),
+                  CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S,
+     $                         RWORK( IE ),
      $                         WORK( ITAUQ ), WORK( ITAUP ),
      $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
+*
 *                 Generate right vectors bidiagonalizing L
 *                 (CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB)
 *                 (CWorkspace: need M*M+M, prefer M*M+M*N)
 *                 (RWorkspace: 0)
+*
                   DO 30 I = 1, N, CHUNK
                      BLK = MIN( N-I+1, CHUNK )
-                     CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IR ),
+                     CALL ZGEMM( 'N', 'N', M, BLK, M, CONE,
+     $                           WORK( IR ),
      $                           LDWRKR, A( 1, I ), LDA, CZERO,
      $                           WORK( IU ), LDWRKU )
                      CALL ZLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
      $                            A( 1, I ), LDA )
 CONTINUE
 *                 Perform bidiagonal QR iteration, computing right
 *                 singular vectors of A in A
 *                 (CWorkspace: 0)
 *                 (RWorkspace: need BDSPAC)
+*
-                  CALL ZBDSQR( 'L', M, N, 0, 0, S, RWORK( IE ), A, LDA,
+                  CALL ZBDSQR( 'L', M, N, 0, 0, S, RWORK( IE ), A,
+     $                         LDA,
      $                         CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO )
+*
                END IF
+*
             ELSE IF( WNTVO .AND. WNTUAS ) THEN
      $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
+*
 *                 Copy L to U, zeroing about above it
+*
                   CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
-                  CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ),
+                  CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1,
+     $                         2 ),
      $                         LDU )
+*
 *                 Generate Q in A
 *                 (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
 *                 (RWorkspace: 0)
 *                 (RWorkspace: need M)
+*
                   CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ),
      $                         WORK( ITAUQ ), WORK( ITAUP ),
      $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
-                  CALL ZLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR )
+                  CALL ZLACPY( 'U', M, M, U, LDU, WORK( IR ),
+     $                         LDWRKR )
+*
 *                 Generate right vectors bidiagonalizing L in WORK(IR)
 *                 (CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB)
 *                 (RWorkspace: 0)
+*
 *                 (CWorkspace: need M*M+M, prefer M*M+M*N))
 *                 (RWorkspace: 0)
+*
                   DO 40 I = 1, N, CHUNK
                      BLK = MIN( N-I+1, CHUNK )
-                     CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IR ),
+                     CALL ZGEMM( 'N', 'N', M, BLK, M, CONE,
+     $                           WORK( IR ),
      $                           LDWRKR, A( 1, I ), LDA, CZERO,
      $                           WORK( IU ), LDWRKU )
                      CALL ZLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
      $                            A( 1, I ), LDA )
 CONTINUE
      $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
+*
 *                 Copy L to U, zeroing out above it
+*
                   CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
-                  CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ),
+                  CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1,
+     $                         2 ),
      $                         LDU )
+*
 *                 Generate Q in A
 *                 (CWorkspace: need 2*M, prefer M+M*NB)
 *                 (RWorkspace: 0)
 *                 singular vectors of A in U and computing right
 *                 singular vectors of A in A
 *                 (CWorkspace: 0)
 *                 (RWorkspace: need BDSPAC)
+*
-                  CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), A, LDA,
+                  CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), A,
+     $                         LDA,
      $                         U, LDU, CDUM, 1, RWORK( IRWORK ), INFO )
+*
                END IF
+*
             ELSE IF( WNTVS ) THEN
 *                    Perform bidiagonal QR iteration, computing right
 *                    singular vectors of A in VT
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, CDUM, 1, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
                   END IF
+*
+*
 *                    Generate left bidiagonalizing vectors of L in A
 *                    (CWorkspace: need 3*M, prefer 2*M+M*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
+                     CALL ZUNGBR( 'Q', M, M, M, A, LDA,
+     $                            WORK( ITAUQ ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + M
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in A and computing right
 *                    singular vectors of A in VT
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, A, LDA, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
                   END IF
+*
+*
 *                    Generate left bidiagonalizing vectors in U
 *                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
+                     CALL ZUNGBR( 'Q', M, M, M, U, LDU,
+     $                            WORK( ITAUQ ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + M
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of L in U and computing right
+*
 *                    Generate left bidiagonalizing vectors in U
 *                    (CWorkspace: need 3*M, prefer 2*M+M*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
+                     CALL ZUNGBR( 'Q', M, M, M, U, LDU,
+     $                            WORK( ITAUQ ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + M
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in U and computing right
 *                    singular vectors of A in VT
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, U, LDU, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
                   END IF
+*
 *                    Perform bidiagonal QR iteration, computing right
 *                    singular vectors of A in VT
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, CDUM, 1, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
                   END IF
+*
+*
 *                    Generate left bidiagonalizing vectors in A
 *                    (CWorkspace: need 3*M, prefer 2*M+M*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
+                     CALL ZUNGBR( 'Q', M, M, M, A, LDA,
+     $                            WORK( ITAUQ ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + M
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in A and computing right
 *                    singular vectors of A in VT
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, A, LDA, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
                   END IF
+*
+*
 *                    Generate left bidiagonalizing vectors in U
 *                    (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
+                     CALL ZUNGBR( 'Q', M, M, M, U, LDU,
+     $                            WORK( ITAUQ ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + M
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of L in U and computing right
+*
 *                    Generate left bidiagonalizing vectors in U
 *                    (CWorkspace: need 3*M, prefer 2*M+M*NB)
 *                    (RWorkspace: 0)
+*
-                     CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
+                     CALL ZUNGBR( 'Q', M, M, M, U, LDU,
+     $                            WORK( ITAUQ ),
      $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                      IRWORK = IE + M
+*
 *                    Perform bidiagonal QR iteration, computing left
 *                    singular vectors of A in U and computing right
 *                    singular vectors of A in VT
 *                    (CWorkspace: 0)
 *                    (RWorkspace: need BDSPAC)
+*
-                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
+                     CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ),
+     $                            VT,
      $                            LDVT, U, LDU, CDUM, 1,
      $                            RWORK( IRWORK ), INFO )
+*
                   END IF
+*
 *> \author NAG Ltd.
+*
 *> \ingroup gesvx
+*
 *  =====================================================================
-      SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
+      SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF,
+     $                   IPIV,
      $                   EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
      $                   WORK, RWORK, INFO )
+*
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH, ZLANGE, ZLANTR
       EXTERNAL           LSAME, DLAMCH, ZLANGE, ZLANTR
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGECON, ZGEEQU, ZGERFS, ZGETRF, ZGETRS,
+      EXTERNAL           XERBLA, ZGECON, ZGEEQU, ZGERFS, ZGETRF,
+     $                   ZGETRS,
      $                   ZLACPY, ZLAQGE
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
          BIGNUM = ONE / SMLNUM
       END IF
+*
 *     Test the input parameters.
+*
+      IF( .NOT.NOFACT .AND.
+     $    .NOT.EQUIL .AND.
-      IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
+     $    .NOT.LSAME( FACT, 'F' ) )
      $     THEN
          INFO = -1
       ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
      $         LSAME( TRANS, 'C' ) ) THEN
          INFO = -2
+*
       IF( EQUIL ) THEN
+*
 *        Compute row and column scalings to equilibrate the matrix A.
+*
-         CALL ZGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU )
+         CALL ZGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
+     $                INFEQU )
          IF( INFEQU.EQ.0 ) THEN
+*
 *           Equilibrate the matrix.
+*
             CALL ZLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
          RPVGRW = ZLANGE( 'M', N, N, A, LDA, RWORK ) / RPVGRW
       END IF
+*
 *     Compute the reciprocal of the condition number of A.
+*
-      CALL ZGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO )
+      CALL ZGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK,
+     $             INFO )
+*
 *     Compute the solution matrix X.
+*
       CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
       CALL ZGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
       DO 40 I = 1, N - 1
+*
 *        Find max element in matrix A
+*
          XMAX = ZERO
-         DO 20 IP = I, N
+         DO 20 JP = I, N
-            DO 10 JP = I, N
+            DO 10 IP = I, N
                IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN
                   XMAX = ABS( A( IP, JP ) )
                   IPV = IP
                   JPV = JP
                END IF
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, IINFO, J, JB, NB
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZGETRF2, ZLASWP, ZTRSM
+      EXTERNAL           XERBLA, ZGEMM, ZGETRF2, ZLASWP,
+     $                   ZTRSM
 *     ..
 *     .. External Functions ..
       INTEGER            ILAENV
       EXTERNAL           ILAENV
 *     ..
             JB = MIN( MIN( M, N )-J+1, NB )
+*
 *           Factor diagonal and subdiagonal blocks and test for exact
 *           singularity.
+*
-            CALL ZGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
+            CALL ZGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ),
+     $                    IINFO )
+*
 *           Adjust INFO and the pivot indices.
+*
             IF( INFO.EQ.0 .AND. IINFO.GT.0 )
      $         INFO = IINFO + J - 1
                CALL ZLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
      $                      IPIV, 1 )
+*
 *              Compute block row of U.
+*
-               CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
+               CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
+     $                     JB,
      $                     N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
      $                     LDA )
                IF( J+JB.LE.M ) THEN
+*
 *                 Update trailing submatrix.
+*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M-J-JB+1,
+                  CALL ZGEMM( 'No transpose', 'No transpose',
+     $                        M-J-JB+1,
      $                        N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
      $                        A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
      $                        LDA )
                END IF
             END IF
 *     .. External Functions ..
       INTEGER            ILAENV
       EXTERNAL           ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZGEMV, ZSWAP, ZTRSM, ZTRTRI
+      EXTERNAL           XERBLA, ZGEMM, ZGEMV, ZSWAP, ZTRSM,
+     $                   ZTRTRI
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
+*
 *     Test the input parameters.
+*
       INFO = 0
       NB = ILAENV( 1, 'ZGETRI', ' ', N, -1, -1, -1 )
-      LWKOPT = N*NB
+      LWKOPT = MAX( 1, N*NB )
       WORK( 1 ) = LWKOPT
       LQUERY = ( LWORK.EQ.-1 )
       IF( N.LT.0 ) THEN
          INFO = -1
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
       LDWORK = N
       IF( NB.GT.1 .AND. NB.LT.N ) THEN
          IWS = MAX( LDWORK*NB, 1 )
          IF( LWORK.LT.IWS ) THEN
             NB = LWORK / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'ZGETRI', ' ', N, -1, -1, -1 ) )
+            NBMIN = MAX( 2, ILAENV( 2, 'ZGETRI', ' ', N, -1, -1,
+     $                   -1 ) )
          END IF
       ELSE
          IWS = N
       END IF
+*
+*
             IF( J+JB.LE.N )
      $         CALL ZGEMM( 'No transpose', 'No transpose', N, JB,
      $                     N-J-JB+1, -ONE, A( 1, J+JB ), LDA,
      $                     WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA )
-            CALL ZTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB,
+            CALL ZTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N,
+     $                  JB,
      $                  ONE, WORK( J ), LDWORK, A( 1, J ), LDA )
 CONTINUE
       END IF
+*
 *     Apply column interchanges.
+*
          CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
+*
 *        Solve L*X = B, overwriting B with X.
+*
-         CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
+         CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N,
+     $               NRHS,
      $               ONE, A, LDA, B, LDB )
+*
 *        Solve U*X = B, overwriting B with X.
+*
          CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
+*
 *        Solve A**T * X = B  or A**H * X = B.
+*
 *        Solve U**T *X = B or U**H *X = B, overwriting B with X.
+*
-         CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE,
+         CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS,
+     $               ONE,
      $               A, LDA, B, LDB )
+*
 *        Solve L**T *X = B, or L**H *X = B overwriting B with X.
+*
          CALL ZTRSM( 'Left', 'Lower', TRANS, 'Unit', N, NRHS, ONE, A,
 *>  See R.C. Ward, Balancing the generalized eigenvalue problem,
 *>                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
+      SUBROUTINE ZGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M,
+     $                   V,
      $                   LDV, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       RIGHTV = LSAME( SIDE, 'R' )
       LEFTV = LSAME( SIDE, 'L' )
+*
       INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+      IF( .NOT.LSAME( JOB, 'N' ) .AND.
+     $    .NOT.LSAME( JOB, 'P' ) .AND.
+     $    .NOT.LSAME( JOB, 'S' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+     $                .NOT.LSAME( JOB, 'B' ) ) THEN
          INFO = -1
       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
          INFO = -2
       ELSE IF( N.LT.0 ) THEN
          INFO = -3
 *     .. Executable Statements ..
+*
 *     Test the input parameters
+*
       INFO = 0
-      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+      IF( .NOT.LSAME( JOB, 'N' ) .AND.
+     $    .NOT.LSAME( JOB, 'P' ) .AND.
+     $    .NOT.LSAME( JOB, 'S' ) .AND.
-     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+     $                .NOT.LSAME( JOB, 'B' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
          RSCALE( I ) = RSCALE( I ) + COR
 CONTINUE
       IF( CMAX.LT.HALF )
      $   GO TO 350
+*
-      CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 )
+      CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ),
+     $            1 )
-      CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 )
+      CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ),
+     $            1 )
+*
       PGAMMA = GAMMA
       IT = IT + 1
       IF( IT.LE.NRP2 )
      $   GO TO 250
 *> \author NAG Ltd.
+*
 *> \ingroup gges
+*
 *  =====================================================================
-      SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB,
+      SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B,
+     $                  LDB,
      $                  SDIM, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK,
      $                  LWORK, RWORK, BWORK, INFO )
+*
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     .. Local Arrays ..
       INTEGER            IDUM( 1 )
       DOUBLE PRECISION   DIF( 2 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ,
+      EXTERNAL           XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
+     $                   ZHGEQZ,
      $                   ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            ILAENV
       LQUERY = ( LWORK.EQ.-1 )
       IF( IJOBVL.LE.0 ) THEN
          INFO = -1
       ELSE IF( IJOBVR.LE.0 ) THEN
          INFO = -2
+      ELSE IF( ( .NOT.WANTST ) .AND.
-      ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
+     $         ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
          INFO = -3
       ELSE IF( N.LT.0 ) THEN
          INFO = -5
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -7
 *       NB refers to the optimal block size for the immediately
 *       following subroutine, as returned by ILAENV.)
+*
       IF( INFO.EQ.0 ) THEN
          LWKMIN = MAX( 1, 2*N )
-         LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) )
+         LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N,
+     $                 0 ) )
          LWKOPT = MAX( LWKOPT, N +
      $                 N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, -1 ) )
          IF( ILVSL ) THEN
             LWKOPT = MAX( LWKOPT, N +
      $                    N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, -1 ) )
       IF( WANTST ) THEN
+*
 *        Undo scaling on eigenvalues before selecting
+*
          IF( ILASCL )
-     $      CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, IERR )
+     $      CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N,
+     $                   IERR )
          IF( ILBSCL )
-     $      CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, IERR )
+     $      CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N,
+     $                   IERR )
+*
 *        Select eigenvalues
+*
          DO 10 I = 1, N
             BWORK( I ) = SELCTG( ALPHA( I ), BETA( I ) )
 CONTINUE
+*
-         CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHA,
+         CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB,
+     $                ALPHA,
      $                BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, PVSR,
      $                DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, IERR )
          IF( IERR.EQ.1 )
      $      INFO = N + 3
+*
 *     ..
 *     .. Local Arrays ..
       LOGICAL            LDUMMA( 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ,
+      EXTERNAL           XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
+     $                   ZHGEQZ,
      $                   ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, ZUNMQR
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            ILAENV
 *       following subroutine, as returned by ILAENV. The workspace is
 *       computed assuming ILO = 1 and IHI = N, the worst case.)
+*
       IF( INFO.EQ.0 ) THEN
          LWKMIN = MAX( 1, 2*N )
-         LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) )
+         LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N,
+     $                 0 ) )
          LWKOPT = MAX( LWKOPT, N +
      $                 N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, 0 ) )
          IF( ILVL ) THEN
             LWKOPT = MAX( LWKOPT, N +
      $                    N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, -1 ) )
             END IF
          ELSE
             CHTEMP = 'R'
          END IF
+*
-         CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL,
+         CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL,
+     $                LDVL,
      $                VR, LDVR, N, IN, WORK( IWRK ), RWORK( IRWRK ),
      $                IERR )
          IF( IERR.NE.0 ) THEN
             INFO = N + 2
             GO TO 70
 *>  an unblocked reduction, as described in _Matrix_Computations_,
 *>  by Golub and van Loan (Johns Hopkins Press).
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
+      SUBROUTINE ZGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+     $                   Q,
      $                   LDQ, Z, LDZ, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
             CTEMP = B( JROW, JROW )
             CALL ZLARTG( CTEMP, B( JROW, JROW-1 ), C, S,
      $                   B( JROW, JROW ) )
             B( JROW, JROW-1 ) = CZERO
-            CALL ZROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S )
+            CALL ZROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C,
+     $                 S )
             CALL ZROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C,
      $                 S )
             IF( ILZ )
-     $         CALL ZROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S )
+     $         CALL ZROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C,
+     $                    S )
 CONTINUE
 CONTINUE
+*
       RETURN
+*
 *> \author NAG Ltd.
+*
 *> \ingroup gtrfs
+*
 *  =====================================================================
-      SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2,
+      SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
+     $                   DU2,
      $                   IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK,
      $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     ..
 *     .. Local Arrays ..
       INTEGER            ISAVE( 3 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZGTTRS, ZLACN2, ZLAGTM
+      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZGTTRS, ZLACN2,
+     $                   ZLAGTM
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DIMAG, MAX
 *     ..
 *     .. External Functions ..
+*
 *        Compute residual R = B - op(A) * X,
 *        where op(A) = A, A**T, or A**H, depending on TRANS.
+*
          CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 )
-         CALL ZLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, ONE,
+         CALL ZLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX,
+     $                ONE,
      $                WORK, N )
+*
 *        Compute abs(op(A))*abs(x) + abs(b) for use in the backward
 *        error bound.
+*
          IF( BERR( J ).GT.EPS .AND. TWO*BERR( J ).LE.LSTRES .AND.
      $       COUNT.LE.ITMAX ) THEN
+*
 *           Update solution and try again.
+*
-            CALL ZGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, N,
+            CALL ZGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV, WORK,
+     $                   N,
      $                   INFO )
             CALL ZAXPY( N, DCMPLX( ONE ), WORK, 1, X( 1, J ), 1 )
             LSTRES = BERR( J )
             COUNT = COUNT + 1
             GO TO 20
          IF( KASE.NE.0 ) THEN
             IF( KASE.EQ.1 ) THEN
+*
 *              Multiply by diag(W)*inv(op(A)**H).
+*
-               CALL ZGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV, WORK,
+               CALL ZGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV,
+     $                      WORK,
      $                      N, INFO )
                DO 80 I = 1, N
                   WORK( I ) = RWORK( I )*WORK( I )
 CONTINUE
             ELSE
 *              Multiply by inv(op(A))*diag(W).
+*
                DO 90 I = 1, N
                   WORK( I ) = RWORK( I )*WORK( I )
 CONTINUE
-               CALL ZGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV, WORK,
+               CALL ZGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV,
+     $                      WORK,
      $                      N, INFO )
             END IF
             GO TO 70
          END IF
+*
 *> \author NAG Ltd.
+*
 *> \ingroup gtsvx
+*
 *  =====================================================================
-      SUBROUTINE ZGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
+      SUBROUTINE ZGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF,
+     $                   DUF,
      $                   DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
      $                   WORK, RWORK, INFO )
+*
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH, ZLANGT
       EXTERNAL           LSAME, DLAMCH, ZLANGT
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZGTCON, ZGTRFS, ZGTTRF, ZGTTRS,
+      EXTERNAL           XERBLA, ZCOPY, ZGTCON, ZGTRFS, ZGTTRF,
+     $                   ZGTTRS,
      $                   ZLACPY
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX
 *     ..
       END IF
       ANORM = ZLANGT( NORM, N, DL, D, DU )
+*
 *     Compute the reciprocal of the condition number of A.
+*
-      CALL ZGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK,
+      CALL ZGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND,
+     $             WORK,
      $             INFO )
+*
 *     Compute the solution vectors X.
+*
       CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
      $             INFO )
+*
 *     Use iterative refinement to improve the computed solutions and
 *     compute error bounds and backward error estimates for them.
+*
-      CALL ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV,
+      CALL ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2,
+     $             IPIV,
      $             B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO )
+*
 *     Set INFO = N+1 if the matrix is singular to working precision.
+*
       IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
 *> \author NAG Ltd.
+*
 *> \ingroup gttrs
+*
 *  =====================================================================
-      SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
+      SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B,
+     $                   LDB,
      $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
       IF( NB.GE.NRHS ) THEN
          CALL ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
       ELSE
          DO 10 J = 1, NRHS, NB
             JB = MIN( NRHS-J+1, NB )
-            CALL ZGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
+            CALL ZGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1,
+     $                   J ),
      $                   LDB )
 CONTINUE
       END IF
+*
 *     End of ZGTTRS
 *> \author NAG Ltd.
+*
 *> \ingroup gtts2
+*
 *  =====================================================================
-      SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
+      SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B,
+     $                   LDB )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       INTEGER            ILAENV
       DOUBLE PRECISION   DLAMCH, ZLANHE
       EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANHE
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DSCAL, DSTERF, XERBLA, ZHETRD, ZLASCL, ZSTEQR,
+      EXTERNAL           DSCAL, DSTERF, XERBLA, ZHETRD, ZLASCL,
+     $                   ZSTEQR,
      $                   ZUNGTR
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, SQRT
 *     ..
 *     ZUNGTR to generate the unitary matrix, then call ZSTEQR.
+*
       IF( .NOT.WANTZ ) THEN
          CALL DSTERF( N, W, RWORK( INDE ), INFO )
       ELSE
-         CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
+         CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ),
+     $                WORK( INDWRK ),
      $                LLWORK, IINFO )
          INDWRK = INDE + N
          CALL ZSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA,
      $                RWORK( INDWRK ), INFO )
       END IF
 *>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.
 *> \endverbatim
 *>
 *> \param[out] RWORK
 *> \verbatim
-*>          RWORK is DOUBLE PRECISION array,
+*>          RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK))
-*>                                         dimension (LRWORK)
 *>          On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
 *> \endverbatim
 *>
 *> \param[in] LRWORK
 *> \verbatim
 *>
 *> Jeff Rutter, Computer Science Division, University of California
 *> at Berkeley, USA
 *>
 *  =====================================================================
-      SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
+      SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
+     $                   RWORK,
      $                   LRWORK, IWORK, LIWORK, INFO )
+*
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
       INTEGER            ILAENV
       DOUBLE PRECISION   DLAMCH, ZLANHE
       EXTERNAL           LSAME, ILAENV, DLAMCH, ZLANHE
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DSCAL, DSTERF, XERBLA, ZHETRD, ZLACPY, ZLASCL,
+      EXTERNAL           DSCAL, DSTERF, XERBLA, ZHETRD, ZLACPY,
+     $                   ZLASCL,
      $                   ZSTEDC, ZUNMTR
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, SQRT
 *     ..
                LWMIN = N + 1
                LRWMIN = N
                LIWMIN = 1
             END IF
             LOPT = MAX( LWMIN, N +
-     $                  N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) )
+     $                  N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1,
+     $                            -1 ) )
             LROPT = LRWMIN
             LIOPT = LIWMIN
          END IF
          WORK( 1 ) = LOPT
-         RWORK( 1 ) = LROPT
+         RWORK( 1 ) = REAL( LROPT )
          IWORK( 1 ) = LIOPT
+*
          IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
             INFO = -8
          ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
          END IF
          CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
       END IF
+*
       WORK( 1 ) = LOPT
-      RWORK( 1 ) = LROPT
+      RWORK( 1 ) = REAL( LROPT )
       IWORK( 1 ) = LIOPT
+*
       RETURN
+*
 *     End of ZHEEVD
+*
                A( I, I+1 ) = ONE
+*
 *              Compute  x := tau * A * v  storing x in TAU(1:i)
+*
-               CALL ZHEMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO,
+               CALL ZHEMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1,
+     $                     ZERO,
      $                     TAU, 1 )
+*
 *              Compute  w := x - 1/2 * tau * (x**H * v) * v
+*
                ALPHA = -HALF*TAUI*ZDOTC( I, TAU, 1, A( 1, I+1 ), 1 )
                CALL ZHEMV( UPLO, N-I, TAUI, A( I+1, I+1 ), LDA,
      $                     A( I+1, I ), 1, ZERO, TAU( I ), 1 )
+*
 *              Compute  w := x - 1/2 * tau * (x**H * v) * v
+*
-               ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, A( I+1, I ),
+               ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, A( I+1,
+     $                                   I ),
      $                 1 )
                CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 )
+*
 *              Apply the transformation as a rank-2 update:
 *                 A := A - v * w**H - w * v**H
+*
-               CALL ZHER2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1,
+               CALL ZHER2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ),
+     $                     1,
      $                     A( I+1, I+1 ), LDA )
+*
             ELSE
                A( I+1, I+1 ) = DBLE( A( I+1, I+1 ) )
             END IF
             COLMAX = CABS1( A( IMAX, K ) )
          ELSE
             COLMAX = ZERO
          END IF
+*
-         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
+         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR.
+     $       DISNAN(ABSAKK) ) THEN
+*
 *           Column K is zero or underflow, or contains a NaN:
 *           set INFO and continue
+*
             IF( INFO.EQ.0 )
             COLMAX = CABS1( A( IMAX, K ) )
          ELSE
             COLMAX = ZERO
          END IF
+*
-         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN
+         IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR.
+     $       DISNAN(ABSAKK) ) THEN
+*
 *           Column K is zero or underflow, or contains a NaN:
 *           set INFO and continue
+*
             IF( INFO.EQ.0 )
 *              Determine only ROWMAX.
+*
                JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA )
                ROWMAX = CABS1( A( IMAX, JMAX ) )
                IF( IMAX.LT.N ) THEN
-                  JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 )
+                  JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ),
+     $                                  1 )
                   ROWMAX = MAX( ROWMAX, CABS1( A( JMAX, IMAX ) ) )
                END IF
+*
                IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
+*
+*
 *              Interchange rows and columns KK and KP in the trailing
 *              submatrix A(k:n,k:n)
+*
                IF( KP.LT.N )
-     $            CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+     $            CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ),
+     $                        1 )
                DO 60 J = KK + 1, KP - 1
                   T = DCONJG( A( J, KK ) )
                   A( J, KK ) = DCONJG( A( KP, J ) )
                   A( KP, J ) = T
 CONTINUE
 *>  where d and e denote diagonal and off-diagonal elements of T, and vi
 *>  denotes an element of the vector defining H(i).
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
+      SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       IF( INFO.EQ.0 ) THEN
+*
 *        Determine the block size.
+*
          NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
+         LWKOPT = MAX( 1, N*NB )
          WORK( 1 ) = LWKOPT
       END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZHETRD', -INFO )
 *> \endverbatim
 *>
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
-*>          The length of WORK.  LWORK >=1.  For best performance
+*>          The length of WORK. LWORK >= 1. For best performance
 *>          LWORK >= N*NB, where NB is the block size returned by ILAENV.
 *> \endverbatim
 *>
 *> \param[out] INFO
 *> \verbatim
       IF( INFO.EQ.0 ) THEN
+*
 *        Determine the block size
+*
          NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
+         LWKOPT = MAX( 1, N*NB )
          WORK( 1 ) = LWKOPT
       END IF
+*
       IF( INFO.NE.0 ) THEN
          CALL XERBLA( 'ZHETRF', -INFO )
       LDWORK = N
       IF( NB.GT.1 .AND. NB.LT.N ) THEN
          IWS = LDWORK*NB
          IF( LWORK.LT.IWS ) THEN
             NB = MAX( LWORK / LDWORK, 1 )
-            NBMIN = MAX( 2, ILAENV( 2, 'ZHETRF', UPLO, N, -1, -1, -1 ) )
+            NBMIN = MAX( 2, ILAENV( 2, 'ZHETRF', UPLO, N, -1, -1,
+     $                   -1 ) )
          END IF
       ELSE
          IWS = 1
       END IF
       IF( NB.LT.NBMIN )
          IF( K.GT.NB ) THEN
+*
 *           Factorize columns k-kb+1:k of A and use blocked code to
 *           update columns 1:k-kb
+*
-            CALL ZLAHEF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, IINFO )
+            CALL ZLAHEF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N,
+     $                   IINFO )
          ELSE
+*
 *           Use unblocked code to factorize columns 1:k of A
+*
             CALL ZHETF2( UPLO, K, A, LDA, IPIV, IINFO )
          IF( K.LE.N-NB ) THEN
+*
 *           Factorize columns k:k+kb-1 of A and use blocked code to
 *           update columns k+kb:n
+*
-            CALL ZLAHEF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ),
+            CALL ZLAHEF( UPLO, N-K+1, NB, KB, A( K, K ), LDA,
+     $                   IPIV( K ),
      $                   WORK, N, IINFO )
          ELSE
+*
 *           Use unblocked code to factorize columns k:n of A
+*
-            CALL ZHETF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO )
+            CALL ZHETF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ),
+     $                   IINFO )
             KB = N - K + 1
          END IF
+*
 *        Set INFO on the first occurrence of a zero pivot
+*
          GO TO 20
+*
       END IF
+*
 CONTINUE
+*
       WORK( 1 ) = LWKOPT
       RETURN
+*
 *     End of ZHETRF
+*
+*
             IF( K.GT.1 ) THEN
                CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 )
                CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO,
      $                     A( 1, K ), 1 )
-               A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, A( 1,
+               A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1,
+     $            A( 1,
      $                     K ), 1 ) )
             END IF
             KSTEP = 1
          ELSE
+*
+*
             IF( K.GT.1 ) THEN
                CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 )
                CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO,
      $                     A( 1, K ), 1 )
-               A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, A( 1,
+               A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1,
+     $            A( 1,
      $                     K ), 1 ) )
                A( K, K+1 ) = A( K, K+1 ) -
-     $                       ZDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 )
+     $                       ZDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ),
+     $                              1 )
                CALL ZCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 )
                CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO,
      $                     A( 1, K+1 ), 1 )
                A( K+1, K+1 ) = A( K+1, K+1 ) -
-     $                         DBLE( ZDOTC( K-1, WORK, 1, A( 1, K+1 ),
+     $                         DBLE( ZDOTC( K-1, WORK, 1, A( 1,
+     $                               K+1 ),
      $                         1 ) )
             END IF
             KSTEP = 2
          END IF
+*
+*
 *           Compute column K of the inverse.
+*
             IF( K.LT.N ) THEN
                CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
-               CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK,
+               CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA,
+     $                     WORK,
      $                     1, ZERO, A( K+1, K ), 1 )
                A( K, K ) = A( K, K ) - DBLE( ZDOTC( N-K, WORK, 1,
      $                     A( K+1, K ), 1 ) )
             END IF
             KSTEP = 1
+*
 *           Compute columns K-1 and K of the inverse.
+*
             IF( K.LT.N ) THEN
                CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
-               CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK,
+               CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA,
+     $                     WORK,
      $                     1, ZERO, A( K+1, K ), 1 )
                A( K, K ) = A( K, K ) - DBLE( ZDOTC( N-K, WORK, 1,
      $                     A( K+1, K ), 1 ) )
                A( K, K-1 ) = A( K, K-1 ) -
-     $                       ZDOTC( N-K, A( K+1, K ), 1, A( K+1, K-1 ),
+     $                       ZDOTC( N-K, A( K+1, K ), 1, A( K+1,
+     $                              K-1 ),
      $                       1 )
                CALL ZCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 )
-               CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK,
+               CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA,
+     $                     WORK,
      $                     1, ZERO, A( K+1, K-1 ), 1 )
                A( K-1, K-1 ) = A( K-1, K-1 ) -
-     $                         DBLE( ZDOTC( N-K, WORK, 1, A( K+1, K-1 ),
+     $                         DBLE( ZDOTC( N-K, WORK, 1, A( K+1,
+     $                               K-1 ),
      $                         1 ) )
             END IF
             KSTEP = 2
          END IF
+*
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDSCAL, ZGEMV, ZGERU, ZLACGV, ZSWAP
+      EXTERNAL           XERBLA, ZDSCAL, ZGEMV, ZGERU, ZLACGV,
+     $                   ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCONJG, MAX
 *     ..
 *     .. Executable Statements ..
      $         CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+*
 *           Multiply by inv(U(K)), where U(K) is the transformation
 *           stored in column K of A.
+*
-            CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
+            CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ),
+     $                  LDB,
      $                  B( 1, 1 ), LDB )
+*
 *           Multiply by the inverse of the diagonal block.
+*
             S = DBLE( ONE ) / DBLE( A( K, K ) )
      $         CALL ZSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
+*
 *           Multiply by inv(U(K)), where U(K) is the transformation
 *           stored in columns K-1 and K of A.
+*
-            CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
+            CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ),
+     $                  LDB,
      $                  B( 1, 1 ), LDB )
             CALL ZGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
      $                  LDB, B( 1, 1 ), LDB )
+*
 *           Multiply by the inverse of the diagonal block.
+*
 *           Multiply by inv(L(K)), where L(K) is the transformation
 *           stored in column K of A.
+*
             IF( K.LT.N )
-     $         CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ),
+     $         CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K,
+     $                     1 ),
      $                     LDB, B( K+1, 1 ), LDB )
+*
 *           Multiply by the inverse of the diagonal block.
+*
             S = DBLE( ONE ) / DBLE( A( K, K ) )
+*
 *           Multiply by inv(L(K)), where L(K) is the transformation
 *           stored in columns K and K+1 of A.
+*
             IF( K.LT.N-1 ) THEN
-               CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ),
+               CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K,
+     $                     1 ),
      $                     LDB, B( K+2, 1 ), LDB )
                CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1,
      $                     B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
             END IF
+*
 *>  We assume that complex ABS works as long as its value is less than
 *>  overflow.
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
+      SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T,
+     $                   LDT,
      $                   ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK,
      $                   RWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                      CALL ZROT( ILASTM-JCH, H( JCH, JCH+1 ), LDH,
      $                          H( JCH+1, JCH+1 ), LDH, C, S )
                      CALL ZROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT,
      $                          T( JCH+1, JCH+1 ), LDT, C, S )
                      IF( ILQ )
-     $                  CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
+     $                  CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ),
+     $                             1,
      $                             C, DCONJG( S ) )
                      IF( ILAZR2 )
      $                  H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C
                      ILAZR2 = .FALSE.
                      IF( ABS1( T( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
                      CTEMP = T( JCH, JCH+1 )
                      CALL ZLARTG( CTEMP, T( JCH+1, JCH+1 ), C, S,
      $                            T( JCH, JCH+1 ) )
                      T( JCH+1, JCH+1 ) = CZERO
                      IF( JCH.LT.ILASTM-1 )
-     $                  CALL ZROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT,
+     $                  CALL ZROT( ILASTM-JCH-1, T( JCH, JCH+2 ),
+     $                             LDT,
      $                             T( JCH+1, JCH+2 ), LDT, C, S )
                      CALL ZROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH,
      $                          H( JCH+1, JCH-1 ), LDH, C, S )
                      IF( ILQ )
-     $                  CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
+     $                  CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ),
+     $                             1,
      $                             C, DCONJG( S ) )
                      CTEMP = H( JCH+1, JCH )
                      CALL ZLARTG( CTEMP, H( JCH+1, JCH-1 ), C, S,
      $                            H( JCH+1, JCH ) )
                      H( JCH+1, JCH-1 ) = CZERO
                      CALL ZROT( JCH+1-IFRSTM, H( IFRSTM, JCH ), 1,
      $                          H( IFRSTM, JCH-1 ), 1, C, S )
                      CALL ZROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1,
      $                          T( IFRSTM, JCH-1 ), 1, C, S )
                      IF( ILZ )
-     $                  CALL ZROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
+     $                  CALL ZROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ),
+     $                             1,
      $                             C, S )
 CONTINUE
                   GO TO 50
                END IF
             ELSE IF( ILAZRO ) THEN
          CALL ZROT( ILAST-IFRSTM, H( IFRSTM, ILAST ), 1,
      $              H( IFRSTM, ILAST-1 ), 1, C, S )
          CALL ZROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1,
      $              T( IFRSTM, ILAST-1 ), 1, C, S )
          IF( ILZ )
-     $      CALL ZROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
+     $      CALL ZROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C,
+     $                 S )
+*
 *        H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA
+*
 CONTINUE
          ABSB = ABS( T( ILAST, ILAST ) )
          IF( ABSB.GT.SAFMIN ) THEN
             SIGNBC = DCONJG( T( ILAST, ILAST ) / ABSB )
             T( ILAST, ILAST ) = ABSB
             IF( ILSCHR ) THEN
-               CALL ZSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), 1 )
+               CALL ZSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ),
+     $                     1 )
-               CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, ILAST ),
+               CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM,
+     $                     ILAST ),
      $                     1 )
             ELSE
                CALL ZSCAL( 1, SIGNBC, H( ILAST, ILAST ), 1 )
             END IF
             IF( ILZ )
 *> \author NAG Ltd.
+*
 *> \ingroup hpcon
+*
 *  =====================================================================
-      SUBROUTINE ZHPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO )
+      SUBROUTINE ZHPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH, ZLANHP
       EXTERNAL           LSAME, DLAMCH, ZLANHP
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DSCAL, DSTERF, XERBLA, ZDSCAL, ZHPTRD, ZSTEQR,
+      EXTERNAL           DSCAL, DSTERF, XERBLA, ZDSCAL, ZHPTRD,
+     $                   ZSTEQR,
      $                   ZUPGTR
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          SQRT
 *     ..
       WANTZ = LSAME( JOBZ, 'V' )
+*
       INFO = 0
       IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
          INFO = -1
-      ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) )
+      ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR.
+     $         LSAME( UPLO, 'U' ) ) )
      $          THEN
          INFO = -2
       ELSE IF( N.LT.0 ) THEN
          INFO = -3
       ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+*
                AP( II+1 ) = ONE
+*
 *              Compute  y := tau * A * v  storing y in TAU(i:n-1)
+*
-               CALL ZHPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1,
+               CALL ZHPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ),
+     $                     1,
      $                     ZERO, TAU( I ), 1 )
+*
 *              Compute  w := y - 1/2 * tau * (y**H *v) * v
+*
-               ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, AP( II+1 ),
+               ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1,
+     $                                   AP( II+1 ),
      $                 1 )
                CALL ZAXPY( N-I, ALPHA, AP( II+1 ), 1, TAU( I ), 1 )
+*
 *              Apply the transformation as a rank-2 update:
 *                 A := A - v * w**H - w * v**H
+*
-               CALL ZHPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1,
+               CALL ZHPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ),
+     $                     1,
      $                     AP( I1I1 ) )
+*
             END IF
             AP( II+1 ) = E( I )
             D( I ) = DBLE( AP( II ) )
+*
 *              Interchange rows and columns KK and KP in the trailing
 *              submatrix A(k:n,k:n)
+*
                IF( KP.LT.N )
-     $            CALL ZSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ),
+     $            CALL ZSWAP( N-KP, AP( KNC+KP-KK+1 ), 1,
+     $                        AP( KPC+1 ),
      $                        1 )
                KX = KNC + KP - KK
                DO 80 J = KK + 1, KP - 1
                   KX = KX + N - J + 1
                   T = DCONJG( AP( KNC+J-KK ) )
 *                    = A - ( W(k) W(k+1) )*inv(D(k))*( W(k) W(k+1) )**H
+*
 *                 where L(k) and L(k+1) are the k-th and (k+1)-th
 *                 columns of L
+*
+                  D = DLAPY2(
-                  D = DLAPY2( DBLE( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ),
+     $                DBLE( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ),
      $                DIMAG( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ) )
                   D11 = DBLE( AP( K+1+K*( 2*N-K-1 ) / 2 ) ) / D
                   D22 = DBLE( AP( K+( K-1 )*( 2*N-K ) / 2 ) ) / D
                   TT = ONE / ( D11*D22-ONE )
                   D21 = AP( K+1+( K-1 )*( 2*N-K ) / 2 ) / D
             IF( K.GT.1 ) THEN
                CALL ZCOPY( K-1, AP( KC ), 1, WORK, 1 )
                CALL ZHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO,
      $                     AP( KC ), 1 )
                AP( KC+K-1 ) = AP( KC+K-1 ) -
-     $                        DBLE( ZDOTC( K-1, WORK, 1, AP( KC ), 1 ) )
+     $                        DBLE( ZDOTC( K-1, WORK, 1, AP( KC ),
+     $                              1 ) )
             END IF
             KSTEP = 1
          ELSE
+*
 *           2 x 2 diagonal block
             IF( K.GT.1 ) THEN
                CALL ZCOPY( K-1, AP( KC ), 1, WORK, 1 )
                CALL ZHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO,
      $                     AP( KC ), 1 )
                AP( KC+K-1 ) = AP( KC+K-1 ) -
-     $                        DBLE( ZDOTC( K-1, WORK, 1, AP( KC ), 1 ) )
+     $                        DBLE( ZDOTC( K-1, WORK, 1, AP( KC ),
+     $                              1 ) )
                AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) -
-     $                            ZDOTC( K-1, AP( KC ), 1, AP( KCNEXT ),
+     $                            ZDOTC( K-1, AP( KC ), 1,
+     $                                   AP( KCNEXT ),
      $                            1 )
                CALL ZCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 )
                CALL ZHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO,
      $                     AP( KCNEXT ), 1 )
                AP( KCNEXT+K ) = AP( KCNEXT+K ) -
-     $                          DBLE( ZDOTC( K-1, WORK, 1, AP( KCNEXT ),
+     $                          DBLE( ZDOTC( K-1, WORK, 1,
+     $                                AP( KCNEXT ),
      $                          1 ) )
             END IF
             KSTEP = 2
             KCNEXT = KCNEXT + K + 1
          END IF
+*
 *           Compute columns K-1 and K of the inverse.
+*
             IF( K.LT.N ) THEN
                CALL ZCOPY( N-K, AP( KC+1 ), 1, WORK, 1 )
-               CALL ZHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), WORK,
+               CALL ZHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ),
+     $                     WORK,
      $                     1, ZERO, AP( KC+1 ), 1 )
                AP( KC ) = AP( KC ) - DBLE( ZDOTC( N-K, WORK, 1,
      $                    AP( KC+1 ), 1 ) )
                AP( KCNEXT+1 ) = AP( KCNEXT+1 ) -
      $                          ZDOTC( N-K, AP( KC+1 ), 1,
      $                          AP( KCNEXT+2 ), 1 )
                CALL ZCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 )
-               CALL ZHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), WORK,
+               CALL ZHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ),
+     $                     WORK,
      $                     1, ZERO, AP( KCNEXT+2 ), 1 )
                AP( KCNEXT ) = AP( KCNEXT ) -
-     $                        DBLE( ZDOTC( N-K, WORK, 1, AP( KCNEXT+2 ),
+     $                        DBLE( ZDOTC( N-K, WORK, 1,
+     $                              AP( KCNEXT+2 ),
      $                        1 ) )
             END IF
             KSTEP = 2
             KCNEXT = KCNEXT - ( N-K+3 )
          END IF
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDSCAL, ZGEMV, ZGERU, ZLACGV, ZSWAP
+      EXTERNAL           XERBLA, ZDSCAL, ZGEMV, ZGERU, ZLACGV,
+     $                   ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCONJG, MAX
 *     ..
 *     .. Executable Statements ..
+*
 *           Multiply by inv(L(K)), where L(K) is the transformation
 *           stored in columns K and K+1 of A.
+*
             IF( K.LT.N-1 ) THEN
-               CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ),
+               CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K,
+     $                     1 ),
      $                     LDB, B( K+2, 1 ), LDB )
                CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1,
      $                     B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
             END IF
+*
       INTEGER            ILAENV
       LOGICAL            LSAME
       EXTERNAL           ILAENV, LSAME
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZLACPY, ZLAHQR, ZLAQR0, ZLASET
+      EXTERNAL           XERBLA, ZCOPY, ZLACPY, ZLAHQR, ZLAQR0,
+     $                   ZLASET
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCMPLX, MAX, MIN
 *     ..
 *     .. Executable Statements ..
+*
       ELSE IF( LQUERY ) THEN
+*
 *        ==== Quick return in case of a workspace query ====
+*
-         CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, Z,
+         CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI,
+     $                Z,
      $                LDZ, WORK, LWORK, INFO )
 *        ==== Ensure reported workspace size is backward-compatible with
 *        .    previous LAPACK versions. ====
          WORK( 1 ) = DCMPLX( MAX( DBLE( WORK( 1 ) ), DBLE( MAX( 1,
      $               N ) ) ), RZERO )
 *        ==== copy eigenvalues isolated by ZGEBAL ====
+*
          IF( ILO.GT.1 )
      $      CALL ZCOPY( ILO-1, H, LDH+1, W, 1 )
          IF( IHI.LT.N )
-     $      CALL ZCOPY( N-IHI, H( IHI+1, IHI+1 ), LDH+1, W( IHI+1 ), 1 )
+     $      CALL ZCOPY( N-IHI, H( IHI+1, IHI+1 ), LDH+1, W( IHI+1 ),
+     $                  1 )
+*
 *        ==== Initialize Z, if requested ====
+*
          IF( INITZ )
      $      CALL ZLASET( 'A', N, N, ZERO, ONE, Z, LDZ )
          NMIN = MAX( NTINY, NMIN )
+*
 *        ==== ZLAQR0 for big matrices; ZLAHQR for small ones ====
+*
          IF( N.GT.NMIN ) THEN
-            CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI,
+            CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO,
+     $                   IHI,
      $                   Z, LDZ, WORK, LWORK, INFO )
          ELSE
+*
 *           ==== Small matrix ====
+*
-            CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI,
+            CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO,
+     $                   IHI,
      $                   Z, LDZ, INFO )
+*
             IF( INFO.GT.0 ) THEN
+*
 *              ==== A rare ZLAHQR failure!  ZLAQR0 sometimes succeeds
 *                 .    tiny matrices must be copied into a larger
 *                 .    array before calling ZLAQR0. ====
+*
                   CALL ZLACPY( 'A', N, N, H, LDH, HL, NL )
                   HL( N+1, N ) = ZERO
-                  CALL ZLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ),
+                  CALL ZLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1,
+     $                         N+1 ),
      $                         NL )
-                  CALL ZLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, W,
+                  CALL ZLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL,
+     $                         W,
      $                         ILO, IHI, Z, LDZ, WORKL, NL, INFO )
                   IF( WANTT .OR. INFO.NE.0 )
      $               CALL ZLACPY( 'A', N, N, HL, NL, H, LDH )
                END IF
             END IF
 *>  vi denotes an element of the vector defining H(i), and ui an element
 *>  of the vector defining G(i).
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
+      SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX,
+     $                   Y,
      $                   LDY )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
      $                     A( I, I+1 ), LDA, A( I, I ), 1, ZERO,
      $                     Y( I+1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', M-I+1, I-1, ONE,
      $                     A( I, 1 ), LDA, A( I, I ), 1, ZERO,
      $                     Y( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
+               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1,
+     $                     1 ),
      $                     LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', M-I+1, I-1, ONE,
      $                     X( I, 1 ), LDX, A( I, I ), 1, ZERO,
      $                     Y( 1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', I-1, N-I, -ONE,
                E( I ) = DBLE( ALPHA )
                A( I, I+1 ) = ONE
+*
 *              Compute X(i+1:m,i)
+*
-               CALL ZGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ),
+               CALL ZGEMV( 'No transpose', M-I, N-I, ONE, A( I+1,
+     $                     I+1 ),
      $                     LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', N-I, I, ONE,
      $                     Y( I+1, 1 ), LDY, A( I, I+1 ), LDA, ZERO,
      $                     X( 1, I ), 1 )
                CALL ZGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ),
      $                     LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
+               CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1,
+     $                     I+1 ),
      $                     LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
+               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1,
+     $                     1 ),
      $                     LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
                CALL ZSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
             END IF
 CONTINUE
             IF( I.LT.M ) THEN
                A( I, I ) = ONE
+*
 *              Compute X(i+1:m,i)
+*
-               CALL ZGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ),
+               CALL ZGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1,
+     $                     I ),
      $                     LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', N-I+1, I-1, ONE,
      $                     Y( I, 1 ), LDY, A( I, I ), LDA, ZERO,
      $                     X( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
+               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1,
+     $                     1 ),
      $                     LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
-               CALL ZGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ),
+               CALL ZGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1,
+     $                     I ),
      $                     LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ),
+               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1,
+     $                     1 ),
      $                     LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
                CALL ZSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
                CALL ZLACGV( N-I+1, A( I, I ), LDA )
+*
 *              Update A(i+1:m,i)
+*
                CALL ZLACGV( I-1, Y( I, 1 ), LDY )
-               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ),
+               CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1,
+     $                     1 ),
      $                     LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 )
                CALL ZLACGV( I-1, Y( I, 1 ), LDY )
                CALL ZGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ),
      $                     LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 )
+*
      $                     A( I+1, I+1 ), LDA, A( I+1, I ), 1, ZERO,
      $                     Y( I+1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', M-I, I-1, ONE,
      $                     A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO,
      $                     Y( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ),
+               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1,
+     $                     1 ),
      $                     LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', M-I, I, ONE,
      $                     X( I+1, 1 ), LDX, A( I+1, I ), 1, ZERO,
      $                     Y( 1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', I, N-I, -ONE,
      $                   J, K, LGN, LL, MATSIZ, MSD2, SMLSIZ, SMM1,
      $                   SPM1, SPM2, SUBMAT, SUBPBS, TLVLS
       DOUBLE PRECISION   TEMP
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DCOPY, DSTEQR, XERBLA, ZCOPY, ZLACRM, ZLAED7
+      EXTERNAL           DCOPY, DSTEQR, XERBLA, ZCOPY, ZLACRM,
+     $                   ZLAED7
 *     ..
 *     .. External Functions ..
       INTEGER            ILAENV
       EXTERNAL           ILAENV
 *     ..
 *> \author NAG Ltd.
+*
 *> \ingroup laed7
+*
 *  =====================================================================
-      SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q,
+      SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D,
+     $                   Q,
      $                   LDQ, RHO, INDXQ, QSTORE, QPTR, PRMPTR, PERM,
      $                   GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK,
      $                   INFO )
+*
 *  -- LAPACK computational routine --
 *     .. Local Scalars ..
       INTEGER            COLTYP, CURR, I, IDLMDA, INDX,
      $                   INDXC, INDXP, IQ, IW, IZ, K, N1, N2, PTR
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLAED9, DLAEDA, DLAMRG, XERBLA, ZLACRM, ZLAED8
+      EXTERNAL           DLAED9, DLAEDA, DLAMRG, XERBLA, ZLACRM,
+     $                   ZLAED8
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
+*
       IF( K.NE.0 ) THEN
          CALL DLAED9( K, 1, K, N, D, RWORK( IQ ), K, RHO,
      $                RWORK( IDLMDA ), RWORK( IW ),
      $                QSTORE( QPTR( CURR ) ), K, INFO )
-         CALL ZLACRM( QSIZ, K, WORK, QSIZ, QSTORE( QPTR( CURR ) ), K, Q,
+         CALL ZLACRM( QSIZ, K, WORK, QSIZ, QSTORE( QPTR( CURR ) ), K,
+     $                Q,
      $                LDQ, RWORK( IQ ) )
          QPTR( CURR+1 ) = QPTR( CURR ) + K**2
          IF( INFO.NE.0 ) THEN
             RETURN
          END IF
 *> \author NAG Ltd.
+*
 *> \ingroup laed8
+*
 *  =====================================================================
-      SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA,
+      SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z,
+     $                   DLAMBDA,
      $                   Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR,
      $                   GIVCOL, GIVNUM, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
       INTEGER            IDAMAX
       DOUBLE PRECISION   DLAMCH, DLAPY2
       EXTERNAL           IDAMAX, DLAMCH, DLAPY2
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DCOPY, DLAMRG, DSCAL, XERBLA, ZCOPY, ZDROT,
+      EXTERNAL           DCOPY, DLAMRG, DSCAL, XERBLA, ZCOPY,
+     $                   ZDROT,
      $                   ZLACPY
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, MAX, MIN, SQRT
 *     ..
          K = 0
          DO 50 J = 1, N
             PERM( J ) = INDXQ( INDX( J ) )
             CALL ZCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 )
 CONTINUE
-         CALL ZLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), LDQ )
+         CALL ZLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ),
+     $                LDQ )
          RETURN
       END IF
+*
 *     If there are multiple eigenvalues then the problem deflates.  Here
 *     the number of equal eigenvalues are found.  As each equal
 *     The deflated eigenvalues and their corresponding vectors go back
 *     into the last N - K slots of D and Q respectively.
+*
       IF( K.LT.N ) THEN
          CALL DCOPY( N-K, DLAMBDA( K+1 ), 1, D( K+1 ), 1 )
-         CALL ZLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2, Q( 1, K+1 ),
+         CALL ZLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2, Q( 1,
+     $                K+1 ),
      $                LDQ )
       END IF
+*
       RETURN
+*
 *> \author NAG Ltd.
+*
 *> \ingroup lagtm
+*
 *  =====================================================================
-      SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA,
+      SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX,
+     $                   BETA,
      $                   B, LDB )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *>                  Computer Science Division,
 *>                  University of California, Berkeley
 *> \endverbatim
+*
 *  =====================================================================
-      SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
+      SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
       DOUBLE PRECISION   EIGHT, SEVTEN
       PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP,
+      INTEGER            IMAX, J, JJ, JMAX, JP, K, KK, KKW, KP,
      $                   KSTEP, KW
       DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, R1, ROWMAX, T
       COMPLEX*16         D11, D21, D22, Z
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            IZAMAX
       EXTERNAL           LSAME, IZAMAX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, ZSWAP
+      EXTERNAL           ZCOPY, ZDSCAL, ZGEMMTR, ZGEMV, ZLACGV,
+     $                   ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT
 *     ..
 *     .. Statement Functions ..
 *        Copy column K of A to column KW of W and update it
+*
          CALL ZCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 )
          W( K, KW ) = DBLE( A( K, K ) )
          IF( K.LT.N ) THEN
-            CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA,
+            CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ),
+     $                  LDA,
      $                  W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 )
             W( K, KW ) = DBLE( W( K, KW ) )
          END IF
+*
 *        Determine rows and columns to be interchanged and whether
+*
 *        Update the upper triangle of A11 (= A(1:k,1:k)) as
+*
 *        A11 := A11 - U12*D*U12**H = A11 - U12*W**H
+*
-*        computing blocks of NB columns at a time (note that conjg(W) is
-*        actually stored)
+*        (note that conjg(W) is actually stored)
-*
-         DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
-            JB = MIN( NB, K-J+1 )
-*
-*           Update the upper triangle of the diagonal block
-*
-            DO 40 JJ = J, J + JB - 1
-               A( JJ, JJ ) = DBLE( A( JJ, JJ ) )
-               CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE,
-     $                     A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE,
-     $                     A( J, JJ ), 1 )
-               A( JJ, JJ ) = DBLE( A( JJ, JJ ) )
-CONTINUE
+*
-*           Update the rectangular superdiagonal block
-*
-            CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB, N-K,
+         CALL ZGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K,
-     $                  -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW,
+     $                 -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW,
-     $                  CONE, A( 1, J ), LDA )
+     $                 CONE, A( 1, 1 ), LDA )
-CONTINUE
+*
 *        Put U12 in standard form by partially undoing the interchanges
 *        in columns k+1:n looping backwards from k+1 to n
+*
          J = K + 1
 *        Copy column K of A to column K of W and update it
+*
          W( K, K ) = DBLE( A( K, K ) )
          IF( K.LT.N )
      $      CALL ZCOPY( N-K, A( K+1, K ), 1, W( K+1, K ), 1 )
-         CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), LDA,
+         CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ),
+     $               LDA,
      $               W( K, 1 ), LDW, CONE, W( K, K ), 1 )
          W( K, K ) = DBLE( W( K, K ) )
+*
 *        Determine rows and columns to be interchanged and whether
 *        a 1-by-1 or 2-by-2 pivot block will be used
 *              BEGIN pivot search along IMAX row
+*
+*
 *              Copy column IMAX to column K+1 of W and update it
+*
-               CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 )
+               CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ),
+     $                     1 )
                CALL ZLACGV( IMAX-K, W( K, K+1 ), 1 )
                W( IMAX, K+1 ) = DBLE( A( IMAX, IMAX ) )
                IF( IMAX.LT.N )
      $            CALL ZCOPY( N-IMAX, A( IMAX+1, IMAX ), 1,
      $                        W( IMAX+1, K+1 ), 1 )
-               CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ),
+               CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K,
+     $                     1 ),
      $                     LDA, W( IMAX, 1 ), LDW, CONE, W( K, K+1 ),
      $                     1 )
                W( IMAX, K+1 ) = DBLE( W( IMAX, K+1 ) )
+*
 *              JMAX is the column-index of the largest off-diagonal
                A( KP, KP ) = DBLE( A( KK, KK ) )
                CALL ZCOPY( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
      $                     LDA )
                CALL ZLACGV( KP-KK-1, A( KP, KK+1 ), LDA )
                IF( KP.LT.N )
-     $            CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+     $            CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ),
+     $                        1 )
+*
 *              Interchange rows KK and KP in first K-1 columns of A
 *              (columns K (or K and K+1 for 2-by-2 pivot) of A will be
 *              later overwritten). Interchange rows KK and KP
 *              in first KK columns of W.
+*
 *        Update the lower triangle of A22 (= A(k:n,k:n)) as
+*
 *        A22 := A22 - L21*D*L21**H = A22 - L21*W**H
+*
-*        computing blocks of NB columns at a time (note that conjg(W) is
-*        actually stored)
+*        (note that conjg(W) is actually stored)
-*
-         DO 110 J = K, N, NB
-            JB = MIN( NB, N-J+1 )
-*
-*           Update the lower triangle of the diagonal block
-*
-            DO 100 JJ = J, J + JB - 1
-               A( JJ, JJ ) = DBLE( A( JJ, JJ ) )
-               CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE,
-     $                     A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE,
-     $                     A( JJ, JJ ), 1 )
-               A( JJ, JJ ) = DBLE( A( JJ, JJ ) )
-CONTINUE
-*
-*           Update the rectangular subdiagonal block
+*
-            IF( J+JB.LE.N )
-     $         CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
+         CALL ZGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1,
-     $                     K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ),
+     $                 K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW,
-     $                     LDW, CONE, A( J+JB, J ), LDA )
+     $                 CONE, A( K, K ), LDA )
-CONTINUE
+*
 *        Put L21 in standard form by partially undoing the interchanges
 *        of rows in columns 1:k-1 looping backwards from k-1 to 1
+*
          J = K - 1
             H( I, I-1 ) = ABS( H( I, I-1 ) )
             CALL ZSCAL( JHI-I+1, SC, H( I, I ), LDH )
             CALL ZSCAL( MIN( JHI, I+1 )-JLO+1, DCONJG( SC ),
      $                  H( JLO, I ), 1 )
             IF( WANTZ )
-     $         CALL ZSCAL( IHIZ-ILOZ+1, DCONJG( SC ), Z( ILOZ, I ), 1 )
+     $         CALL ZSCAL( IHIZ-ILOZ+1, DCONJG( SC ), Z( ILOZ, I ),
+     $                     1 )
          END IF
 CONTINUE
+*
       NH = IHI - ILO + 1
       NZ = IHIZ - ILOZ + 1
      $            H( M+2, M+1 ) = H( M+2, M+1 )*TEMP
                DO 110 J = M, I
                   IF( J.NE.M+1 ) THEN
                      IF( I2.GT.J )
      $                  CALL ZSCAL( I2-J, TEMP, H( J, J+1 ), LDH )
-                     CALL ZSCAL( J-I1, DCONJG( TEMP ), H( I1, J ), 1 )
+                     CALL ZSCAL( J-I1, DCONJG( TEMP ), H( I1, J ),
+     $                           1 )
                      IF( WANTZ ) THEN
                         CALL ZSCAL( NZ, DCONJG( TEMP ), Z( ILOZ, J ),
      $                              1 )
                      END IF
                   END IF
 *           Update A(K+1:N,I)
+*
 *           Update I-th column of A - Y * V**H
+*
             CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA )
-            CALL ZGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY,
+            CALL ZGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1),
+     $                  LDY,
      $                  A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 )
             CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA )
+*
 *           Apply I - V * T**H * V**H to this column (call it b) from the
 *           left, using the last column of T as workspace
          END IF
+*
 *        Generate the elementary reflector H(I) to annihilate
 *        A(K+I+1:N,I)
+*
-         CALL ZLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1,
+         CALL ZLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ),
+     $                1,
      $                TAU( I ) )
          EI = A( K+I, I )
          A( K+I, I ) = ONE
+*
 *        Compute  Y(K+1:N,I)
      $                  A( K+I, 1 ), LDA, A( K+I, I ), 1, ONE,
      $                  T( 1, NB ), 1 )
+*
 *           w := T**H *w
+*
-            CALL ZTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', I-1,
+            CALL ZTRMV( 'Upper', 'Conjugate transpose', 'Non-unit',
-     $                  T, LDT, T( 1, NB ), 1 )
+     $                  I-1, T, LDT, T( 1, NB ), 1 )
+*
 *           b2 := b2 - V2*w
+*
-            CALL ZGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ),
+            CALL ZGEMV( 'No transpose', N-K-I+1, I-1, -ONE,
-     $                  LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
+     $                  A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE,
+     $                  A( K+I, I ), 1 )
+*
 *           b1 := b1 - V1*w
+*
             CALL ZTRMV( 'Lower', 'No transpose', 'Unit', I-1,
      $                  A( K+1, 1 ), LDA, T( 1, NB ), 1 )
      $                TAU( I ) )
          A( K+I, I ) = ONE
+*
 *        Compute  Y(1:n,i)
+*
-         CALL ZGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA,
+         CALL ZGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ),
-     $               A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
+     $               LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
          CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE,
      $               A( K+I, 1 ), LDA, A( K+I, I ), 1, ZERO, T( 1, I ),
      $               1 )
-         CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1,
+         CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ),
-     $               ONE, Y( 1, I ), 1 )
+     $               1, ONE, Y( 1, I ), 1 )
          CALL ZSCAL( N, TAU( I ), Y( 1, I ), 1 )
+*
 *        Compute T(1:i,i)
+*
          CALL ZSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
-         CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT,
+         CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
-     $               T( 1, I ), 1 )
+     $               LDT, T( 1, I ), 1 )
          T( I, I ) = TAU( I )
+*
 CONTINUE
       A( K+NB, NB ) = EI
+*
 *>     Ming Gu and Ren-Cang Li, Computer Science Division, University of
 *>       California at Berkeley, USA \n
 *>     Osni Marques, LBNL/NERSC, USA \n
+*
 *  =====================================================================
-      SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX,
+      SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX,
+     $                   LDBX,
      $                   PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
      $                   POLES, DIFL, DIFR, Z, K, C, S, RWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     .. Local Scalars ..
       INTEGER            I, J, JCOL, JROW, M, N, NLP1
       DOUBLE PRECISION   DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGEMV, XERBLA, ZCOPY, ZDROT, ZDSCAL, ZLACPY,
+      EXTERNAL           DGEMV, XERBLA, ZCOPY, ZDROT, ZDSCAL,
+     $                   ZLACPY,
      $                   ZLASCL
 *     ..
 *     .. External Functions ..
       DOUBLE PRECISION   DLAMC3, DNRM2
       EXTERNAL           DLAMC3, DNRM2
+*
 *        Step (2L): permute rows of B.
+*
          CALL ZCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX )
          DO 20 I = 2, N
-            CALL ZCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX )
+            CALL ZCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ),
+     $                  LDBX )
 CONTINUE
+*
 *        Step (3L): apply the inverse of the left singular vector
 *        matrix to BX.
+*
+*
 *                    Use calls to the subroutine DLAMC3 to enforce the
 *                    parentheses (x+y)+z. The goal is to prevent
 *                    optimizing compilers from doing x+(y+z).
+*
-                     RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I+1,
+                     RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ,
+     $                      -POLES( I+1,
      $                            2 ) )-DIFR( I, 1 ) ) /
      $                            ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 )
                   END IF
 CONTINUE
                DO 120 I = J + 1, K
                   IF( Z( J ).EQ.ZERO ) THEN
                      RWORK( I ) = ZERO
                   ELSE
-                     RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I,
+                     RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ,
+     $                      -POLES( I,
      $                            2 ) )-DIFL( I ) ) /
      $                            ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 )
                   END IF
 CONTINUE
+*
 *        Step (2R): if SQRE = 1, apply back the rotation that is
 *        related to the right null space of the subproblem.
+*
          IF( SQRE.EQ.1 ) THEN
             CALL ZCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX )
-            CALL ZDROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S )
+            CALL ZDROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C,
+     $                  S )
          END IF
          IF( K.LT.MAX( M, N ) )
-     $      CALL ZLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, 1 ),
+     $      CALL ZLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1,
+     $                   1 ),
      $                   LDBX )
+*
 *        Step (3R): permute rows of B.
+*
          CALL ZCOPY( NRHS, BX( 1, 1 ), LDBX, B( NLP1, 1 ), LDB )
          IF( SQRE.EQ.1 ) THEN
             CALL ZCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB )
          END IF
          DO 190 I = 2, N
-            CALL ZCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB )
+            CALL ZCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ),
+     $                  LDB )
 CONTINUE
+*
 *        Step (4R): apply back the Givens rotations performed.
+*
          DO 200 I = GIVPTR, 1, -1
 *>     Ming Gu and Ren-Cang Li, Computer Science Division, University of
 *>       California at Berkeley, USA \n
 *>     Osni Marques, LBNL/NERSC, USA \n
+*
 *  =====================================================================
-      SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U,
+      SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX,
+     $                   U,
      $                   LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR,
      $                   GIVCOL, LDGCOL, PERM, GIVNUM, C, S, RWORK,
      $                   IWORK, INFO )
+*
 *  -- LAPACK computational routine --
       INTEGER            I, I1, IC, IM1, INODE, J, JCOL, JIMAG, JREAL,
      $                   JROW, LF, LL, LVL, LVL2, ND, NDB1, NDIML,
      $                   NDIMR, NL, NLF, NLP1, NLVL, NR, NRF, NRP1, SQRE
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGEMM, DLASDT, XERBLA, ZCOPY, ZLALS0
+      EXTERNAL           DGEMM, DLASDT, XERBLA, ZCOPY,
+     $                   ZLALS0
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCMPLX, DIMAG
 *     ..
 *     .. Executable Statements ..
             NL = IWORK( NDIML+IM1 )
             NR = IWORK( NDIMR+IM1 )
             NLF = IC - NL
             NRF = IC + 1
             J = J - 1
-            CALL ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), LDBX,
+            CALL ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ),
+     $                   LDBX,
      $                   B( NLF, 1 ), LDB, PERM( NLF, LVL ),
      $                   GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL,
      $                   GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ),
      $                   DIFL( NLF, LVL ), DIFR( NLF, LVL2 ),
      $                   Z( NLF, LVL ), K( J ), C( J ), S( J ), RWORK,
                SQRE = 0
             ELSE
                SQRE = 1
             END IF
             J = J + 1
-            CALL ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), LDB,
+            CALL ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ),
+     $                   LDB,
      $                   BX( NLF, 1 ), LDBX, PERM( NLF, LVL ),
      $                   GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL,
      $                   GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ),
      $                   DIFL( NLF, LVL ), DIFR( NLF, LVL2 ),
      $                   Z( NLF, LVL ), K( J ), C( J ), S( J ), RWORK,
             DO 200 JROW = NLF, NLF + NLP1 - 1
                J = J + 1
                RWORK( J ) = DBLE( B( JROW, JCOL ) )
 CONTINUE
 CONTINUE
-         CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU,
+         CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ),
+     $               LDU,
      $               RWORK( 1+NLP1*NRHS*2 ), NLP1, ZERO, RWORK( 1 ),
      $               NLP1 )
          J = NLP1*NRHS*2
          DO 230 JCOL = 1, NRHS
             DO 220 JROW = NLF, NLF + NLP1 - 1
                J = J + 1
                RWORK( J ) = DIMAG( B( JROW, JCOL ) )
 CONTINUE
 CONTINUE
-         CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU,
+         CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ),
+     $               LDU,
      $               RWORK( 1+NLP1*NRHS*2 ), NLP1, ZERO,
      $               RWORK( 1+NLP1*NRHS ), NLP1 )
          JREAL = 0
          JIMAG = NLP1*NRHS
          DO 250 JCOL = 1, NRHS
             DO 260 JROW = NRF, NRF + NRP1 - 1
                J = J + 1
                RWORK( J ) = DBLE( B( JROW, JCOL ) )
 CONTINUE
 CONTINUE
-         CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU,
+         CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ),
+     $               LDU,
      $               RWORK( 1+NRP1*NRHS*2 ), NRP1, ZERO, RWORK( 1 ),
      $               NRP1 )
          J = NRP1*NRHS*2
          DO 290 JCOL = 1, NRHS
             DO 280 JROW = NRF, NRF + NRP1 - 1
                J = J + 1
                RWORK( J ) = DIMAG( B( JROW, JCOL ) )
 CONTINUE
 CONTINUE
-         CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU,
+         CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ),
+     $               LDU,
      $               RWORK( 1+NRP1*NRHS*2 ), NRP1, ZERO,
      $               RWORK( 1+NRP1*NRHS ), NRP1 )
          JREAL = 0
          JIMAG = NRP1*NRHS
          DO 310 JCOL = 1, NRHS
       INTEGER            IDAMAX
       DOUBLE PRECISION   DLAMCH, DLANST
       EXTERNAL           IDAMAX, DLAMCH, DLANST
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGEMM, DLARTG, DLASCL, DLASDA, DLASDQ, DLASET,
+      EXTERNAL           DGEMM, DLARTG, DLASCL, DLASDA, DLASDQ,
+     $                   DLASET,
      $                   DLASRT, XERBLA, ZCOPY, ZDROT, ZLACPY, ZLALSA,
      $                   ZLASCL, ZLASET
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DIMAG, INT, LOG, SIGN
       ELSE IF( N.EQ.1 ) THEN
          IF( D( 1 ).EQ.ZERO ) THEN
             CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, B, LDB )
          ELSE
             RANK = 1
-            CALL ZLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, INFO )
+            CALL ZLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB,
+     $                   INFO )
             D( 1 ) = ABS( D( 1 ) )
          END IF
          RETURN
       END IF
+*
          IF( NRHS.GT.1 ) THEN
             DO 30 I = 1, NRHS
                DO 20 J = 1, N - 1
                   CS = RWORK( J*2-1 )
                   SN = RWORK( J*2 )
-                  CALL ZDROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, SN )
+                  CALL ZDROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS,
+     $                        SN )
 CONTINUE
 CONTINUE
          END IF
       END IF
+*
 CONTINUE
+*
          TOL = RCND*ABS( D( IDAMAX( N, D, 1 ) ) )
          DO 100 I = 1, N
             IF( D( I ).LE.TOL ) THEN
-               CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB )
+               CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, B( I, 1 ),
+     $                      LDB )
             ELSE
-               CALL ZLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, 1 ),
+               CALL ZLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I,
+     $                      1 ),
      $                      LDB, INFO )
                RANK = RANK + 1
             END IF
 CONTINUE
+*
+*
 *        Some of the elements in D can be negative because 1-by-1
 *        subproblems were not solved explicitly.
+*
          IF( ABS( D( I ) ).LE.TOL ) THEN
-            CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, WORK( BX+I-1 ), N )
+            CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, WORK( BX+I-1 ),
+     $                   N )
          ELSE
             RANK = RANK + 1
             CALL ZLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS,
      $                   WORK( BX+I-1 ), N, INFO )
          END IF
                   B( JROW, JCOL ) = DCMPLX( RWORK( JREAL ),
      $                              RWORK( JIMAG ) )
 CONTINUE
 CONTINUE
          ELSE
-            CALL ZLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), N,
+            CALL ZLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ),
+     $                   N,
      $                   B( ST, 1 ), LDB, RWORK( U+ST1 ), N,
      $                   RWORK( VT+ST1 ), IWORK( K+ST1 ),
      $                   RWORK( DIFL+ST1 ), RWORK( DIFR+ST1 ),
      $                   RWORK( Z+ST1 ), RWORK( POLES+ST1 ),
      $                   IWORK( GIVPTR+ST1 ), IWORK( GIVCOL+ST1 ), N,
          VALUE = ZERO
          DO 80 I = 1, N
             TEMP = WORK( I )
             IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
 CONTINUE
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          SCALE = ZERO
          SUM = ONE
          DO 90 J = 1, N
             L = MAX( 1, J-KU )
             K = KU + 1 - J + L
-            CALL ZLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM )
+            CALL ZLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE,
+     $                   SUM )
 CONTINUE
          VALUE = SCALE*SQRT( SUM )
       END IF
+*
       ZLANGB = VALUE
          VALUE = ZERO
          DO 80 I = 1, M
             TEMP = WORK( I )
             IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
 CONTINUE
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          SCALE = ZERO
          SUM = ONE
+*
 *        Find max(abs(A(i,j))).
+*
          ANORM = ABS( D( N ) )
          DO 10 I = 1, N - 1
-            IF( ANORM.LT.ABS( DL( I ) ) .OR. DISNAN( ABS( DL( I ) ) ) )
+            IF( ANORM.LT.ABS( DL( I ) ) .OR.
+     $          DISNAN( ABS( DL( I ) ) ) )
      $           ANORM = ABS(DL(I))
             IF( ANORM.LT.ABS( D( I ) ) .OR. DISNAN( ABS( D( I ) ) ) )
      $           ANORM = ABS(D(I))
-            IF( ANORM.LT.ABS( DU( I ) ) .OR. DISNAN (ABS( DU( I ) ) ) )
+            IF( ANORM.LT.ABS( DU( I ) ) .OR.
+     $          DISNAN (ABS( DU( I ) ) ) )
      $           ANORM = ABS(DU(I))
 CONTINUE
       ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN
+*
 *        Find norm1(A).
             DO 30 I = 2, N - 1
                TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) )
                IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP
 CONTINUE
          END IF
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          SCALE = ZERO
          SUM = ONE
                   SUM = ABS( A( I, J ) )
                   IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
          END IF
-      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
+      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR.
+     $         ( LSAME( NORM, 'O' ) ) .OR.
      $         ( NORM.EQ.'1' ) ) THEN
+*
 *        Find normI(A) ( = norm1(A), since A is hermitian).
+*
          VALUE = ZERO
                   WORK( I ) = WORK( I ) + ABSA
 CONTINUE
                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
          END IF
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          SCALE = ZERO
          SUM = ONE
                   IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
                K = K + N - J + 1
 CONTINUE
          END IF
-      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
+      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR.
+     $         ( LSAME( NORM, 'O' ) ) .OR.
      $         ( NORM.EQ.'1' ) ) THEN
+*
 *        Find normI(A) ( = norm1(A), since A is hermitian).
+*
          VALUE = ZERO
                   K = K + 1
 CONTINUE
                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
          END IF
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          SCALE = ZERO
          SUM = ONE
          VALUE = ZERO
          DO 80 I = 1, N
             SUM = WORK( I )
             IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          SCALE = ZERO
          SUM = ONE
                   IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
                K = K + N - J + 1
 CONTINUE
          END IF
-      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
+      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR.
+     $         ( LSAME( NORM, 'O' ) ) .OR.
      $         ( NORM.EQ.'1' ) ) THEN
+*
 *        Find normI(A) ( = norm1(A), since A is symmetric).
+*
          VALUE = ZERO
                   K = K + 1
 CONTINUE
                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
          END IF
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          SCALE = ZERO
          SUM = ONE
                   SUM = ABS( A( I, J ) )
                   IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
          END IF
-      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
+      ELSE IF( ( LSAME( NORM, 'I' ) ) .OR.
+     $         ( LSAME( NORM, 'O' ) ) .OR.
      $         ( NORM.EQ.'1' ) ) THEN
+*
 *        Find normI(A) ( = norm1(A), since A is symmetric).
+*
          VALUE = ZERO
                   WORK( I ) = WORK( I ) + ABSA
 CONTINUE
                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
          END IF
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          SCALE = ZERO
          SUM = ONE
             VALUE = ONE
             IF( LSAME( UPLO, 'U' ) ) THEN
                DO 20 J = 1, N
                   DO 10 I = MAX( K+2-J, 1 ), K
                      SUM = ABS( AB( I, J ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
             ELSE
                DO 40 J = 1, N
                   DO 30 I = 2, MIN( N+1-J, K+1 )
                      SUM = ABS( AB( I, J ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
             END IF
          ELSE
             VALUE = ZERO
             IF( LSAME( UPLO, 'U' ) ) THEN
                DO 60 J = 1, N
                   DO 50 I = MAX( K+2-J, 1 ), K + 1
                      SUM = ABS( AB( I, J ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
             ELSE
                DO 80 J = 1, N
                   DO 70 I = 1, MIN( N+1-J, K+1 )
                      SUM = ABS( AB( I, J ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
             END IF
          END IF
       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
          END IF
          DO 270 I = 1, N
             SUM = WORK( I )
             IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          IF( LSAME( UPLO, 'U' ) ) THEN
             IF( LSAME( DIAG, 'U' ) ) THEN
                END IF
             ELSE
                SCALE = ZERO
                SUM = ONE
                DO 290 J = 1, N
-                  CALL ZLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
+                  CALL ZLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ),
+     $                         J ),
      $                         1, SCALE, SUM )
 CONTINUE
             END IF
          ELSE
             IF( LSAME( DIAG, 'U' ) ) THEN
                SCALE = ONE
                SUM = N
                IF( K.GT.0 ) THEN
                   DO 300 J = 1, N - 1
-                     CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
+                     CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1,
+     $                            SCALE,
      $                            SUM )
 CONTINUE
                END IF
             ELSE
                SCALE = ZERO
                SUM = ONE
                DO 310 J = 1, N
-                  CALL ZLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE,
+                  CALL ZLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1,
+     $                         SCALE,
      $                         SUM )
 CONTINUE
             END IF
          END IF
          VALUE = SCALE*SQRT( SUM )
 *> \author NAG Ltd.
+*
 *> \ingroup lantp
+*
 *  =====================================================================
-      DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK )
+      DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP,
+     $                                  WORK )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
             VALUE = ONE
             IF( LSAME( UPLO, 'U' ) ) THEN
                DO 20 J = 1, N
                   DO 10 I = K, K + J - 2
                      SUM = ABS( AP( I ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
                   K = K + J
 CONTINUE
             ELSE
                DO 40 J = 1, N
                   DO 30 I = K + 1, K + N - J
                      SUM = ABS( AP( I ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
                   K = K + N - J + 1
 CONTINUE
             END IF
          ELSE
             VALUE = ZERO
             IF( LSAME( UPLO, 'U' ) ) THEN
                DO 60 J = 1, N
                   DO 50 I = K, K + J - 1
                      SUM = ABS( AP( I ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
                   K = K + J
 CONTINUE
             ELSE
                DO 80 J = 1, N
                   DO 70 I = K, K + N - J
                      SUM = ABS( AP( I ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
                   K = K + N - J + 1
 CONTINUE
             END IF
          END IF
          VALUE = ZERO
          DO 270 I = 1, N
             SUM = WORK( I )
             IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          IF( LSAME( UPLO, 'U' ) ) THEN
             IF( LSAME( DIAG, 'U' ) ) THEN
 *> \author NAG Ltd.
+*
 *> \ingroup lantr
+*
 *  =====================================================================
-      DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
+      DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A,
+     $                                  LDA,
      $                 WORK )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
             VALUE = ONE
             IF( LSAME( UPLO, 'U' ) ) THEN
                DO 20 J = 1, N
                   DO 10 I = 1, MIN( M, J-1 )
                      SUM = ABS( A( I, J ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
             ELSE
                DO 40 J = 1, N
                   DO 30 I = J + 1, M
                      SUM = ABS( A( I, J ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
             END IF
          ELSE
             VALUE = ZERO
             IF( LSAME( UPLO, 'U' ) ) THEN
                DO 60 J = 1, N
                   DO 50 I = 1, MIN( M, J )
                      SUM = ABS( A( I, J ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
             ELSE
                DO 80 J = 1, N
                   DO 70 I = J, M
                      SUM = ABS( A( I, J ) )
+                     IF( VALUE .LT. SUM .OR.
-                     IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
+     $                   DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
 CONTINUE
             END IF
          END IF
       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
          VALUE = ZERO
          DO 280 I = 1, M
             SUM = WORK( I )
             IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 CONTINUE
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR.
-      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+     $         ( LSAME( NORM, 'E' ) ) ) THEN
+*
 *        Find normF(A).
+*
          IF( LSAME( UPLO, 'U' ) ) THEN
             IF( LSAME( DIAG, 'U' ) ) THEN
                SCALE = ONE
                SUM = MIN( M, N )
                DO 290 J = 2, N
-                  CALL ZLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
+                  CALL ZLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE,
+     $                         SUM )
 CONTINUE
             ELSE
                SCALE = ZERO
                SUM = ONE
                DO 300 J = 1, N
-                  CALL ZLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
+                  CALL ZLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE,
+     $                         SUM )
 CONTINUE
             END IF
          ELSE
             IF( LSAME( DIAG, 'U' ) ) THEN
                SCALE = ONE
 *> \author NAG Ltd.
+*
 *> \ingroup laqgb
+*
 *  =====================================================================
-      SUBROUTINE ZLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
+      SUBROUTINE ZLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND,
+     $                   COLCND,
      $                   AMAX, EQUED )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
      $                   CONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, ITEMP, J, MN, OFFPI, PVT
       DOUBLE PRECISION   TEMP, TEMP2, TOL3Z
-      COMPLEX*16         AII
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZLARF, ZLARFG, ZSWAP
+      EXTERNAL           ZLARF1F, ZLARFG, ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DCONJG, MAX, MIN, SQRT
 *     ..
 *     .. External Functions ..
          END IF
+*
 *        Generate elementary reflector H(i).
+*
          IF( OFFPI.LT.M ) THEN
-            CALL ZLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1,
+            CALL ZLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ),
+     $                   1,
      $                   TAU( I ) )
          ELSE
             CALL ZLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) )
          END IF
+*
          IF( I.LT.N ) THEN
+*
 *           Apply H(i)**H to A(offset+i:m,i+1:n) from the left.
+*
-            AII = A( OFFPI, I )
-            A( OFFPI, I ) = CONE
-            CALL ZLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
+            CALL ZLARF1F( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
-     $                  DCONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA,
+     $                    CONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA,
-     $                  WORK( 1 ) )
+     $                    WORK( 1 ) )
-            A( OFFPI, I ) = AII
          END IF
+*
 *        Update partial column norms.
+*
          DO 10 J = I + 1, N
 *> \htmlonly
 *> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">[PDF]</a>
 *> \endhtmlonly
+*
 *  =====================================================================
-      SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
+      SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU,
+     $                   VN1,
      $                   VN2, AUXV, F, LDF )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
          IF( K.GT.1 ) THEN
             DO 20 J = 1, K - 1
                F( K, J ) = DCONJG( F( K, J ) )
 CONTINUE
-            CALL ZGEMV( 'No transpose', M-RK+1, K-1, -CONE, A( RK, 1 ),
+            CALL ZGEMV( 'No transpose', M-RK+1, K-1, -CONE, A( RK,
+     $                  1 ),
      $                  LDA, F( K, 1 ), LDF, CONE, A( RK, K ), 1 )
             DO 30 J = 1, K - 1
                F( K, J ) = DCONJG( F( K, J ) )
 CONTINUE
          END IF
+*
 *        Generate elementary reflector H(k).
+*
          IF( RK.LT.M ) THEN
-            CALL ZLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) )
+            CALL ZLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1,
+     $                   TAU( K ) )
          ELSE
             CALL ZLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) )
          END IF
+*
          AKK = A( RK, K )
 *        Incremental updating of F:
 *        F(1:N,K) := F(1:N,K) - tau(K)*F(1:N,1:K-1)*A(RK:M,1:K-1)**H
 *                    *A(RK:M,K).
+*
          IF( K.GT.1 ) THEN
-            CALL ZGEMV( 'Conjugate transpose', M-RK+1, K-1, -TAU( K ),
+            CALL ZGEMV( 'Conjugate transpose', M-RK+1, K-1,
+     $                  -TAU( K ),
      $                  A( RK, 1 ), LDA, A( RK, K ), 1, CZERO,
      $                  AUXV( 1 ), 1 )
+*
             CALL ZGEMV( 'No transpose', N, K-1, CONE, F( 1, 1 ), LDF,
      $                  AUXV( 1 ), 1, CONE, F( 1, K ), 1 )
+*
 *        Update the current row of A:
 *        A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)**H.
+*
          IF( K.LT.N ) THEN
-            CALL ZGEMM( 'No transpose', 'Conjugate transpose', 1, N-K,
+            CALL ZGEMM( 'No transpose', 'Conjugate transpose', 1,
+     $                  N-K,
      $                  K, -CONE, A( RK, 1 ), LDA, F( K+1, 1 ), LDF,
      $                  CONE, A( RK, K+1 ), LDA )
          END IF
+*
 *        Update partial column norms.
 *     Apply the block reflector to the rest of the matrix:
 *     A(OFFSET+KB+1:M,KB+1:N) := A(OFFSET+KB+1:M,KB+1:N) -
 *                         A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)**H.
+*
       IF( KB.LT.MIN( N, M-OFFSET ) ) THEN
-         CALL ZGEMM( 'No transpose', 'Conjugate transpose', M-RK, N-KB,
+         CALL ZGEMM( 'No transpose', 'Conjugate transpose', M-RK,
+     $               N-KB,
      $               KB, -CONE, A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF,
      $               CONE, A( RK+1, KB+1 ), LDA )
       END IF
+*
 *     Recomputation of difficult columns.
 *     ..
 *     .. Local Arrays ..
       COMPLEX*16         ZDUM( 1, 1 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZLACPY, ZLAHQR, ZLAQR3, ZLAQR4, ZLAQR5
+      EXTERNAL           ZLACPY, ZLAHQR, ZLAQR3, ZLAQR4,
+     $                   ZLAQR5
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DIMAG, INT, MAX, MIN, MOD,
      $                   SQRT
 *     ..
             KWV = NW + 2
             NVE = ( N-NW ) - KWV + 1
+*
 *           ==== Aggressive early deflation ====
+*
-            CALL ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
+            CALL ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH,
+     $                   ILOZ,
      $                   IHIZ, Z, LDZ, LS, LD, W, H( KV, 1 ), LDH, NHO,
      $                   H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, WORK,
      $                   LWORK )
+*
 *           ==== Adjust KBOT accounting for new deflations. ====
 *>
 *>       Karen Braman and Ralph Byers, Department of Mathematics,
 *>       University of Kansas, USA
 *>
 *  =====================================================================
-      SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
+      SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH,
+     $                   ILOZ,
      $                   IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
      $                   NV, WV, LDWV, WORK, LWORK )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
      $                   ONE = ( 1.0d0, 0.0d0 ) )
       DOUBLE PRECISION   RZERO, RONE
       PARAMETER          ( RZERO = 0.0d0, RONE = 1.0d0 )
 *     ..
 *     .. Local Scalars ..
-      COMPLEX*16         BETA, CDUM, S, TAU
+      COMPLEX*16         CDUM, S, TAU
       DOUBLE PRECISION   FOO, SAFMAX, SAFMIN, SMLNUM, ULP
       INTEGER            I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN,
      $                   KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWKOPT
 *     ..
 *     .. External Functions ..
       DOUBLE PRECISION   DLAMCH
       EXTERNAL           DLAMCH
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR,
+      EXTERNAL           ZCOPY, ZGEHRD, ZGEMM, ZLACPY,
+     $                   ZLAHQR,
-     $                   ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR
+     $                   ZLARF1F, ZLARFG, ZLASET, ZTREXC, ZUNMHR
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN
 *     ..
 *     .. Statement Functions ..
          CALL ZGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
          LWK1 = INT( WORK( 1 ) )
+*
 *        ==== Workspace query call to ZUNMHR ====
+*
-         CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
+         CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V,
+     $                LDV,
      $                WORK, -1, INFO )
          LWK2 = INT( WORK( 1 ) )
+*
 *        ==== Optimal workspace ====
+*
 *     .    aggressive early deflation using that part of
 *     .    the deflation window that converged using INFQR
 *     .    here and there to keep track.) ====
+*
       CALL ZLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
-      CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
+      CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ),
+     $            LDT+1 )
+*
       CALL ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
       CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
      $             JW, V, LDV, INFQR )
+*
                IF( CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) )
      $            IFST = J
 CONTINUE
             ILST = I
             IF( IFST.NE.ILST )
-     $         CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
+     $         CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST,
+     $                      INFO )
 CONTINUE
       END IF
+*
 *     ==== Restore shift/eigenvalue array from T ====
+*
+*
             CALL ZCOPY( NS, V, LDV, WORK, 1 )
             DO 50 I = 1, NS
                WORK( I ) = DCONJG( WORK( I ) )
 CONTINUE
-            BETA = WORK( 1 )
-            CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU )
+            CALL ZLARFG( NS, WORK( 1 ), WORK( 2 ), 1, TAU )
-            WORK( 1 ) = ONE
 *
-            CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
+            CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ),
+     $                   LDT )
 *
-            CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT,
+            CALL ZLARF1F( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT,
-     $                  WORK( JW+1 ) )
+     $                    WORK( JW+1 ) )
-            CALL ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
+            CALL ZLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT,
-     $                  WORK( JW+1 ) )
+     $                    WORK( JW+1 ) )
-            CALL ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
+            CALL ZLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV,
-     $                  WORK( JW+1 ) )
+     $                    WORK( JW+1 ) )
+*
             CALL ZGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
      $                   LWORK-JW, INFO )
          END IF
+*
+*
 *        ==== Accumulate orthogonal matrix in order update
 *        .    H and Z, if requested.  ====
+*
          IF( NS.GT.1 .AND. S.NE.ZERO )
-     $      CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
+     $      CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V,
+     $                   LDV,
      $                   WORK( JW+1 ), LWORK-JW, INFO )
+*
 *        ==== Update vertical slab in H ====
+*
          IF( WANTT ) THEN
          END IF
          DO 60 KROW = LTOP, KWTOP - 1, NV
             KLN = MIN( NV, KWTOP-KROW )
             CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
      $                  LDH, V, LDV, ZERO, WV, LDWV )
-            CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
+            CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ),
+     $                   LDH )
 CONTINUE
+*
 *        ==== Update horizontal slab in H ====
+*
          IF( WANTT ) THEN
 *        ==== Update vertical slab in Z ====
+*
          IF( WANTZ ) THEN
             DO 80 KROW = ILOZ, IHIZ, NV
                KLN = MIN( NV, IHIZ-KROW+1 )
-               CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
+               CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW,
+     $                     KWTOP ),
      $                     LDZ, V, LDV, ZERO, WV, LDWV )
                CALL ZLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
      $                      LDZ )
 CONTINUE
          END IF
 *>
 *>       Karen Braman and Ralph Byers, Department of Mathematics,
 *>       University of Kansas, USA
 *>
 *  =====================================================================
-      SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
+      SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH,
+     $                   ILOZ,
      $                   IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
      $                   NV, WV, LDWV, WORK, LWORK )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
      $                   ONE = ( 1.0d0, 0.0d0 ) )
       DOUBLE PRECISION   RZERO, RONE
       PARAMETER          ( RZERO = 0.0d0, RONE = 1.0d0 )
 *     ..
 *     .. Local Scalars ..
-      COMPLEX*16         BETA, CDUM, S, TAU
+      COMPLEX*16         CDUM, S, TAU
       DOUBLE PRECISION   FOO, SAFMAX, SAFMIN, SMLNUM, ULP
       INTEGER            I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN,
      $                   KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3,
      $                   LWKOPT, NMIN
 *     ..
       DOUBLE PRECISION   DLAMCH
       INTEGER            ILAENV
       EXTERNAL           DLAMCH, ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, ZLAQR4,
+      EXTERNAL           ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR,
+     $                   ZLAQR4,
-     $                   ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR
+     $                   ZLARF1F, ZLARFG, ZLASET, ZTREXC, ZUNMHR
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN
 *     ..
 *     .. Statement Functions ..
          CALL ZGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
          LWK1 = INT( WORK( 1 ) )
+*
 *        ==== Workspace query call to ZUNMHR ====
+*
-         CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
+         CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V,
+     $                LDV,
      $                WORK, -1, INFO )
          LWK2 = INT( WORK( 1 ) )
+*
 *        ==== Workspace query call to ZLAQR4 ====
+*
-         CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, V,
+         CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW,
+     $                V,
      $                LDV, WORK, -1, INFQR )
          LWK3 = INT( WORK( 1 ) )
+*
 *        ==== Optimal workspace ====
+*
 *     .    aggressive early deflation using that part of
 *     .    the deflation window that converged using INFQR
 *     .    here and there to keep track.) ====
+*
       CALL ZLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
-      CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
+      CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ),
+     $            LDT+1 )
+*
       CALL ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
       NMIN = ILAENV( 12, 'ZLAQR3', 'SV', JW, 1, JW, LWORK )
       IF( JW.GT.NMIN ) THEN
-         CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
+         CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ),
+     $                1,
      $                JW, V, LDV, WORK, LWORK, INFQR )
       ELSE
-         CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
+         CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ),
+     $                1,
      $                JW, V, LDV, INFQR )
       END IF
+*
 *     ==== Deflation detection loop ====
+*
                IF( CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) )
      $            IFST = J
 CONTINUE
             ILST = I
             IF( IFST.NE.ILST )
-     $         CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
+     $         CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST,
+     $                      INFO )
 CONTINUE
       END IF
+*
 *     ==== Restore shift/eigenvalue array from T ====
+*
+*
             CALL ZCOPY( NS, V, LDV, WORK, 1 )
             DO 50 I = 1, NS
                WORK( I ) = DCONJG( WORK( I ) )
 CONTINUE
-            BETA = WORK( 1 )
-            CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU )
+            CALL ZLARFG( NS, WORK( 1 ), WORK( 2 ), 1, TAU )
-            WORK( 1 ) = ONE
 *
-            CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
+            CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ),
+     $                   LDT )
 *
-            CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT,
+            CALL ZLARF1F( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT,
-     $                  WORK( JW+1 ) )
+     $                    WORK( JW+1 ) )
-            CALL ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
+            CALL ZLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT,
-     $                  WORK( JW+1 ) )
+     $                    WORK( JW+1 ) )
-            CALL ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
+            CALL ZLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV,
-     $                  WORK( JW+1 ) )
+     $                    WORK( JW+1 ) )
+*
             CALL ZGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
      $                   LWORK-JW, INFO )
          END IF
+*
+*
 *        ==== Accumulate orthogonal matrix in order update
 *        .    H and Z, if requested.  ====
+*
          IF( NS.GT.1 .AND. S.NE.ZERO )
-     $      CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
+     $      CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V,
+     $                   LDV,
      $                   WORK( JW+1 ), LWORK-JW, INFO )
+*
 *        ==== Update vertical slab in H ====
+*
          IF( WANTT ) THEN
          END IF
          DO 60 KROW = LTOP, KWTOP - 1, NV
             KLN = MIN( NV, KWTOP-KROW )
             CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
      $                  LDH, V, LDV, ZERO, WV, LDWV )
-            CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
+            CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ),
+     $                   LDH )
 CONTINUE
+*
 *        ==== Update horizontal slab in H ====
+*
          IF( WANTT ) THEN
 *        ==== Update vertical slab in Z ====
+*
          IF( WANTZ ) THEN
             DO 80 KROW = ILOZ, IHIZ, NV
                KLN = MIN( NV, IHIZ-KROW+1 )
-               CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
+               CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW,
+     $                     KWTOP ),
      $                     LDZ, V, LDV, ZERO, WV, LDWV )
                CALL ZLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
      $                      LDZ )
 CONTINUE
          END IF
             KWV = NW + 2
             NVE = ( N-NW ) - KWV + 1
+*
 *           ==== Aggressive early deflation ====
+*
-            CALL ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
+            CALL ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH,
+     $                   ILOZ,
      $                   IHIZ, Z, LDZ, LS, LD, W, H( KV, 1 ), LDH, NHO,
      $                   H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, WORK,
      $                   LWORK )
+*
 *           ==== Adjust KBOT accounting for new deflations. ====
 *>       Lars Karlsson, Daniel Kressner, and Bruno Lang, Optimally packed
 *>       chains of bulges in multishift QR algorithms.
 *>       ACM Trans. Math. Softw. 40, 2, Article 12 (February 2014).
 *>
 *  =====================================================================
-      SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
+      SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
+     $                   S,
      $                   H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV,
      $                   WV, LDWV, NH, WH, LDWH )
       IMPLICIT NONE
+*
 *  -- LAPACK auxiliary routine --
 *     ..
 *     .. Local Arrays ..
       COMPLEX*16         VT( 3 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZGEMM, ZLACPY, ZLAQR1, ZLARFG, ZLASET, ZTRMM
+      EXTERNAL           ZGEMM, ZLACPY, ZLAQR1, ZLARFG, ZLASET,
+     $                   ZTRMM
 *     ..
 *     .. Statement Functions ..
       DOUBLE PRECISION   CABS1
 *     ..
 *     .. Statement Function definitions ..
             CALL ZGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
      $           C, LDC, V, INCV, ZERO, WORK, 1 )
+*
 *           C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H
+*
-            CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
+            CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C,
+     $                  LDC )
          END IF
       ELSE
+*
 *        Form  C * H
+*
             CALL ZGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
      $           V, INCV, ZERO, WORK, 1 )
+*
 *           C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H
+*
-            CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
+            CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C,
+     $                  LDC )
          END IF
       END IF
       RETURN
+*
 *     End of ZLARF
+*
       END
+*> \brief \b ZLARF1F applies an elementary reflector to a general rectangular
+*              matrix assuming v(1) = 1.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARF1F + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarf1f.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarf1f.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarf1f.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          SIDE
+*       INTEGER            INCV, LDC, M, N
+*       COMPLEX*16         TAU
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZLARF1F applies a complex elementary reflector H to a real m by n matrix
+*> C, from either the left or the right. H is represented in the form
+*>
+*>       H = I - tau * v * v**H
+*>
+*> where tau is a complex scalar and v is a complex vector.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*>
+*> To apply H**H, supply conjg(tau) instead
+*> tau.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': form  H * C
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX*16 array, dimension
+*>                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+*>                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+*>          The vector v in the representation of H. V is not used if
+*>          TAU = 0. V(1) is not referenced or modified.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between elements of v. INCV <> 0.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is COMPLEX*16
+*>          The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX*16 array, dimension (LDC,N)
+*>          On entry, the m by n matrix C.
+*>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+*>          or C * H if SIDE = 'R'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension
+*>                         (N) if SIDE = 'L'
+*>                      or (M) if SIDE = 'R'
+*> \endverbatim
+*  To take advantage of the fact that v(1) = 1, we do the following
+*     v = [ 1 v_2 ]**T
+*     If SIDE='L'
+*           |-----|
+*           | C_1 |
+*        C =| C_2 |
+*           |-----|
+*        C_1\in\mathbb{C}^{1\times n}, C_2\in\mathbb{C}^{m-1\times n}
+*        So we compute:
+*        C = HC   = (I - \tau vv**T)C
+*                 = C - \tau vv**T C
+*        w = C**T v  = [ C_1**T C_2**T ] [ 1 v_2 ]**T
+*                    = C_1**T + C_2**T v ( ZGEMM then ZAXPYC-like )
+*        C  = C - \tau vv**T C
+*           = C - \tau vw**T
+*        Giving us   C_1 = C_1 - \tau w**T ( ZAXPYC-like )
+*                 and
+*                    C_2 = C_2 - \tau v_2w**T ( ZGERC )
+*     If SIDE='R'
+*
+*        C = [ C_1 C_2 ]
+*        C_1\in\mathbb{C}^{m\times 1}, C_2\in\mathbb{C}^{m\times n-1}
+*        So we compute:
+*        C = CH   = C(I - \tau vv**T)
+*                 = C - \tau Cvv**T
+*
+*        w = Cv   = [ C_1 C_2 ] [ 1 v_2 ]**T
+*                 = C_1 + C_2v_2 ( ZGEMM then ZAXPYC-like )
+*        C  = C - \tau Cvv**T
+*           = C - \tau wv**T
+*        Giving us   C_1 = C_1 - \tau w ( ZAXPYC-like )
+*                 and
+*                    C_2 = C_2 - \tau wv_2**T ( ZGERC )
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup larf
+*
+*  =====================================================================
+      SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK auxiliary routine --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+*     .. Scalar Arguments ..
+      CHARACTER          SIDE
+      INTEGER            INCV, LDC, M, N
+      COMPLEX*16         TAU
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE, ZERO
+      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
+     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            APPLYLEFT
+      INTEGER            I, LASTV, LASTC, J
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZGEMV, ZGERC, ZSCAL
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAZLR, ILAZLC
+      EXTERNAL           LSAME, ILAZLR, ILAZLC
+*     ..
+*     .. Executable Statements ..
+*
+      APPLYLEFT = LSAME( SIDE, 'L' )
+      LASTV = 1
+      LASTC = 0
+      IF( TAU.NE.ZERO ) THEN
+!     Set up variables for scanning V.  LASTV begins pointing to the end
+!     of V.
+         IF( APPLYLEFT ) THEN
+            LASTV = M
+         ELSE
+            LASTV = N
+         END IF
+         IF( INCV.GT.0 ) THEN
+            I = 1 + (LASTV-1) * INCV
+         ELSE
+            I = 1
+         END IF
+!     Look for the last non-zero row in V.
+!        Since we are assuming that V(1) = 1, and it is not stored, so we
+!        shouldn't access it.
+         DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO )
+            LASTV = LASTV - 1
+            I = I - INCV
+         END DO
+         IF( APPLYLEFT ) THEN
+!     Scan for the last non-zero column in C(1:lastv,:).
+            LASTC = ILAZLC(LASTV, N, C, LDC)
+         ELSE
+!     Scan for the last non-zero row in C(:,1:lastv).
+            LASTC = ILAZLR(M, LASTV, C, LDC)
+         END IF
+      END IF
+      IF( LASTC.EQ.0 ) THEN
+         RETURN
+      END IF
+      IF( APPLYLEFT ) THEN
+*
+*        Form  H * C
+*
+            ! Check if m = 1. This means v = 1, So we just need to compute
+            ! C := HC = (1-\tau)C.
+            IF( LASTV.EQ.1 ) THEN
+               CALL ZSCAL(LASTC, ONE - TAU, C, LDC)
+            ELSE
+*
+*              w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1)
+*
+               ! (I - tvv**H)C = C - tvv**H C
+               ! First compute w**H = v**H c -> w = C**H v
+               ! C = [ C_1 C_2 ]**T, v = [1 v_2]**T
+               ! w = C_1**H + C_2**Hv_2
+               ! w = C_2**Hv_2
+               CALL ZGEMV( 'Conjugate transpose', LASTV - 1,
+     $               LASTC, ONE, C( 1+1, 1 ), LDC, V( 1 + INCV ),
+     $               INCV, ZERO, WORK, 1 )
+*
+*              w(1:lastc,1) += v(1,1) * C(1,1:lastc)**H
+*
+               DO I = 1, LASTC
+                  WORK( I ) = WORK( I ) + DCONJG( C( 1, I ) )
+               END DO
+*
+*           C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H
+*
+            ! C(1, 1:lastc)   := C(...) - tau * v(1,1) * w(1:lastc,1)**H
+            !                  = C(...) - tau * Conj(w(1:lastc,1))
+            ! This is essentially a zaxpyc
+               DO I = 1, LASTC
+                  C( 1, I ) = C( 1, I ) - TAU * DCONJG( WORK( I ) )
+               END DO
+*
+*        C(2:lastv,1:lastc) += - tau * v(2:lastv,1) * w(1:lastc,1)**H
+*
+               CALL ZGERC( LASTV - 1, LASTC, -TAU, V( 1 + INCV ),
+     $               INCV, WORK, 1, C( 1+1, 1 ), LDC )
+            END IF
+      ELSE
+*
+*        Form  C * H
+*
+            ! Check if n = 1. This means v = 1, so we just need to compute
+            ! C := CH = C(1-\tau).
+            IF( LASTV.EQ.1 ) THEN
+               CALL ZSCAL(LASTC, ONE - TAU, C, 1)
+            ELSE
+*
+*              w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
+*
+               ! w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1)
+               CALL ZGEMV( 'No transpose', LASTC, LASTV-1, ONE,
+     $            C(1,1+1), LDC, V(1+INCV), INCV, ZERO, WORK, 1 )
+               ! w(1:lastc,1) += C(1:lastc,1) v(1,1) = C(1:lastc,1)
+               CALL ZAXPY(LASTC, ONE, C, 1, WORK, 1)
+*
+*              C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T
+*
+               ! C(1:lastc,1)     := C(...) - tau * w(1:lastc,1) * v(1,1)**T
+               !                   = C(...) - tau * w(1:lastc,1)
+               CALL ZAXPY(LASTC, -TAU, WORK, 1, C, 1)
+               ! C(1:lastc,2:lastv) := C(...) - tau * w(1:lastc,1) * v(2:lastv)**T
+               CALL ZGERC( LASTC, LASTV-1, -TAU, WORK, 1, V(1+INCV),
+     $                     INCV, C(1,1+1), LDC )
+            END IF
+      END IF
+      RETURN
+*
+*     End of ZLARF1F
+*
+      END
+*> \brief \b ZLARF1L applies an elementary reflector to a general rectangular
+*              matrix assuming v(lastv) = 1, where lastv is the last non-zero
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARF1L + dependencies
+*> <a
+*href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarf1l.f">
+*> [TGZ]</a>
+*> <a
+*href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarf1l.f">
+*> [ZIP]</a>
+*> <a
+*href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarf1l.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          SIDE
+*       INTEGER            INCV, LDC, M, N
+*       COMPLEX*16         TAU
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZLARF1L applies a complex elementary reflector H to a complex m by n matrix
+*> C, from either the left or the right. H is represented in the form
+*>
+*>       H = I - tau * v * v**H
+*>
+*> where tau is a real scalar and v is a real vector assuming v(lastv) = 1,
+*> where lastv is the last non-zero element.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*>
+*> To apply H**H (the conjugate transpose of H), supply conjg(tau) instead
+*> tau.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': form  H * C
+*>          = 'R': form  C * H
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX*16 array, dimension
+*>                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+*>                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+*>          The vector v in the representation of H. V is not used if
+*>          TAU = 0.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between elements of v. INCV > 0.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is COMPLEX*16
+*>          The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX*16 array, dimension (LDC,N)
+*>          On entry, the m by n matrix C.
+*>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+*>          or C * H if SIDE = 'R'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension
+*>                         (N) if SIDE = 'L'
+*>                      or (M) if SIDE = 'R'
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup larf1f
+*
+*  =====================================================================
+      SUBROUTINE ZLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK auxiliary routine --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+*     .. Scalar Arguments ..
+      CHARACTER          SIDE
+      INTEGER            INCV, LDC, M, N
+      COMPLEX*16         TAU
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE, ZERO
+      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
+     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            APPLYLEFT
+      INTEGER            I, J, LASTV, LASTC, FIRSTV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZGEMV, ZGERC, ZSCAL
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DCONJG
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAZLR, ILAZLC
+      EXTERNAL           LSAME, ILAZLR, ILAZLC
+*     ..
+*     .. Executable Statements ..
+*
+      APPLYLEFT = LSAME( SIDE, 'L' )
+      FIRSTV = 1
+      LASTC = 0
+      IF( TAU.NE.ZERO ) THEN
+!     Set up variables for scanning V.  LASTV begins pointing to the end
+!     of V up to V(1).
+         IF( APPLYLEFT ) THEN
+            LASTV = M
+         ELSE
+            LASTV = N
+         END IF
+         I = 1
+!     Look for the last non-zero row in V.
+         DO WHILE( LASTV.GT.FIRSTV .AND. V( I ).EQ.ZERO )
+            FIRSTV = FIRSTV + 1
+            I = I + INCV
+         END DO
+         IF( APPLYLEFT ) THEN
+!     Scan for the last non-zero column in C(1:lastv,:).
+            LASTC = ILAZLC(LASTV, N, C, LDC)
+         ELSE
+!     Scan for the last non-zero row in C(:,1:lastv).
+            LASTC = ILAZLR(M, LASTV, C, LDC)
+         END IF
+      END IF
+      IF( LASTC.EQ.0 ) THEN
+         RETURN
+      END IF
+      IF( APPLYLEFT ) THEN
+*
+*        Form  H * C
+*
+         IF( LASTV.EQ.FIRSTV ) THEN
+*
+*           C(lastv,1:lastc) := ( 1 - tau ) * C(lastv,1:lastc)
+*
+            CALL ZSCAL( LASTC, ONE - TAU, C( LASTV, 1 ), LDC )
+         ELSE
+*
+*           w(1:lastc,1) := C(firstv:lastv-1,1:lastc)**T * v(firstv:lastv-1,1)
+*
+            CALL ZGEMV( 'Conjugate transpose', LASTV - FIRSTV, LASTC,
+     $                  ONE, C( FIRSTV, 1 ), LDC, V( I ), INCV, ZERO,
+     $                  WORK, 1 )
+*
+*           w(1:lastc,1) += C(lastv,1:lastc)**H * v(lastv,1)
+*
+            DO J = 1, LASTC
+               WORK( J ) = WORK( J ) + CONJG( C( LASTV, J ) )
+            END DO
+*
+*           C(lastv,1:lastc) += - tau * v(lastv,1) * w(1:lastc,1)**H
+*
+            DO J = 1, LASTC
+               C( LASTV, J ) = C( LASTV, J )
+     $                         - TAU * CONJG( WORK( J ) )
+            END DO
+*
+*           C(firstv:lastv-1,1:lastc) += - tau * v(firstv:lastv-1,1) * w(1:lastc,1)**H
+*
+            CALL ZGERC( LASTV - FIRSTV, LASTC, -TAU, V( I ), INCV,
+     $                  WORK, 1, C( FIRSTV, 1 ), LDC)
+         END IF
+      ELSE
+*
+*        Form  C * H
+*
+         IF( LASTV.EQ.FIRSTV ) THEN
+*
+*           C(1:lastc,lastv) := ( 1 - tau ) * C(1:lastc,lastv)
+*
+            CALL ZSCAL( LASTC, ONE - TAU, C( 1, LASTV ), 1 )
+         ELSE
+*
+*           w(1:lastc,1) := C(1:lastc,firstv:lastv-1) * v(firstv:lastv-1,1)
+*
+            CALL ZGEMV( 'No transpose', LASTC, LASTV - FIRSTV, ONE,
+     $                  C( 1, FIRSTV ), LDC, V( I ), INCV, ZERO,
+     $                  WORK, 1 )
+*
+*           w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1)
+*
+            CALL ZAXPY( LASTC, ONE, C( 1, LASTV ), 1, WORK, 1 )
+*
+*           C(1:lastc,lastv) += - tau * v(lastv,1) * w(1:lastc,1)
+*
+            CALL ZAXPY( LASTC, -TAU, WORK, 1, C( 1, LASTV ), 1 )
+*
+*           C(1:lastc,firstv:lastv-1) += - tau * w(1:lastc,1) * v(firstv:lastv-1)**H
+*
+            CALL ZGERC( LASTC, LASTV - FIRSTV, -TAU, WORK, 1, V( I ),
+     $                  INCV, C( 1, FIRSTV ), LDC )
+         END IF
+      END IF
+      RETURN
+*
+*     End of ZLARF1L
+*
+      END
 *> \brief \b ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix.
+*
 *  =========== DOCUMENTATION ===========
+*
 * Online html documentation available at
 *>
 *> \verbatim
 *>
 *>  The shape of the matrix V and the storage of the vectors which define
 *>  the H(i) is best illustrated by the following example with n = 5 and
-*>  k = 3. The elements equal to 1 are not stored; the corresponding
+*>  k = 3. The triangular part of V (including its diagonal) is not
-*>  array elements are modified but restored on exit. The rest of the
-*>  array is not used.
+*>  referenced.
 *>
 *>  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
 *>
 *>               V = (  1       )                 V = (  1 v1 v1 v1 v1 )
 *>                   ( v1  1    )                     (     1 v2 v2 v2 )
 *>                   (     1 v3 )
 *>                   (        1 )
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+      SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V,
+     $                   LDV,
      $                   T, LDT, C, LDC, WORK, LDWORK )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                   CALL ZLACGV( N, WORK( 1, J ), 1 )
 CONTINUE
+*
 *              W := W * V1
+*
-               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
+               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+     $                     N,
      $                     K, ONE, V, LDV, WORK, LDWORK )
                IF( M.GT.K ) THEN
+*
 *                 W := W + C2**H * V2
+*
-                  CALL ZGEMM( 'Conjugate transpose', 'No transpose', N,
+                  CALL ZGEMM( 'Conjugate transpose', 'No transpose',
+     $                        N,
      $                        K, M-K, ONE, C( K+1, 1 ), LDC,
      $                        V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
                END IF
+*
 *              W := W * T**H  or  W * T
+*
-               CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
+               CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N,
+     $                     K,
      $                     ONE, T, LDT, WORK, LDWORK )
+*
 *              C := C - V * W**H
+*
                IF( M.GT.K ) THEN
                   CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
 CONTINUE
+*
 *              W := W * V1
+*
-               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
+               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+     $                     M,
      $                     K, ONE, V, LDV, WORK, LDWORK )
                IF( N.GT.K ) THEN
+*
 *                 W := W + C2 * V2
+*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M, K, N-K,
+                  CALL ZGEMM( 'No transpose', 'No transpose', M, K,
+     $                        N-K,
      $                        ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
      $                        ONE, WORK, LDWORK )
                END IF
+*
 *              W := W * T  or  W * T**H
+*
                IF( N.GT.K ) THEN
+*
 *                 C2 := C2 - W * V2**H
+*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
+                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+     $                        M,
      $                        N-K, K, -ONE, WORK, LDWORK, V( K+1, 1 ),
      $                        LDV, ONE, C( 1, K+1 ), LDC )
                END IF
+*
 *              W := W * V1**H
 *              W := C**H * V  =  (C1**H * V1 + C2**H * V2)  (stored in WORK)
+*
 *              W := C2**H
+*
                DO 70 J = 1, K
-                  CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
+                  CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ),
+     $                        1 )
                   CALL ZLACGV( N, WORK( 1, J ), 1 )
 CONTINUE
+*
 *              W := W * V2
+*
-               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
+               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+     $                     N,
      $                     K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
                IF( M.GT.K ) THEN
+*
 *                 W := W + C1**H * V1
+*
-                  CALL ZGEMM( 'Conjugate transpose', 'No transpose', N,
+                  CALL ZGEMM( 'Conjugate transpose', 'No transpose',
+     $                        N,
      $                        K, M-K, ONE, C, LDC, V, LDV, ONE, WORK,
      $                        LDWORK )
                END IF
+*
 *              W := W * T**H  or  W * T
+*
-               CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
+               CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N,
+     $                     K,
      $                     ONE, T, LDT, WORK, LDWORK )
+*
 *              C := C - V * W**H
+*
                IF( M.GT.K ) THEN
                   CALL ZCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
 CONTINUE
+*
 *              W := W * V2
+*
-               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
+               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+     $                     M,
      $                     K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
                IF( N.GT.K ) THEN
+*
 *                 W := W + C1 * V1
+*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M, K, N-K,
+                  CALL ZGEMM( 'No transpose', 'No transpose', M, K,
+     $                        N-K,
      $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
                END IF
+*
 *              W := W * T  or  W * T**H
+*
+*
                IF( N.GT.K ) THEN
+*
 *                 C1 := C1 - W * V1**H
+*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
+                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+     $                        M,
      $                        N-K, K, -ONE, WORK, LDWORK, V, LDV, ONE,
      $                        C, LDC )
                END IF
+*
 *              W := W * V2**H
      $                        WORK, LDWORK )
                END IF
+*
 *              W := W * T**H  or  W * T
+*
-               CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
+               CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N,
+     $                     K,
      $                     ONE, T, LDT, WORK, LDWORK )
+*
 *              C := C - V**H * W**H
+*
                IF( M.GT.K ) THEN
      $                        C( K+1, 1 ), LDC )
                END IF
+*
 *              W := W * V1
+*
-               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
+               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+     $                     N,
      $                     K, ONE, V, LDV, WORK, LDWORK )
+*
 *              C1 := C1 - W**H
+*
                DO 150 J = 1, K
      $                     'Unit', M, K, ONE, V, LDV, WORK, LDWORK )
                IF( N.GT.K ) THEN
+*
 *                 W := W + C2 * V2**H
+*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
+                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+     $                        M,
      $                        K, N-K, ONE, C( 1, K+1 ), LDC,
      $                        V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
                END IF
+*
 *              W := W * T  or  W * T**H
+*
                IF( N.GT.K ) THEN
+*
 *                 C2 := C2 - W * V2
+*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, K,
+                  CALL ZGEMM( 'No transpose', 'No transpose', M, N-K,
+     $                        K,
      $                        -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
      $                        C( 1, K+1 ), LDC )
                END IF
+*
 *              W := W * V1
+*
-               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
+               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+     $                     M,
      $                     K, ONE, V, LDV, WORK, LDWORK )
+*
 *              C1 := C1 - W
+*
                DO 180 J = 1, K
 *              W := C**H * V**H  =  (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
+*
 *              W := C2**H
+*
                DO 190 J = 1, K
-                  CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
+                  CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ),
+     $                        1 )
                   CALL ZLACGV( N, WORK( 1, J ), 1 )
 CONTINUE
+*
 *              W := W * V2**H
+*
      $                        LDC, V, LDV, ONE, WORK, LDWORK )
                END IF
+*
 *              W := W * T**H  or  W * T
+*
-               CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
+               CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N,
+     $                     K,
      $                     ONE, T, LDT, WORK, LDWORK )
+*
 *              C := C - V**H * W**H
+*
                IF( M.GT.K ) THEN
      $                        LDV, WORK, LDWORK, ONE, C, LDC )
                END IF
+*
 *              W := W * V2
+*
-               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
+               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+     $                     N,
      $                     K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
+*
 *              C2 := C2 - W**H
+*
                DO 210 J = 1, K
      $                     LDWORK )
                IF( N.GT.K ) THEN
+*
 *                 W := W + C1 * V1**H
+*
-                  CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
+                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+     $                        M,
      $                        K, N-K, ONE, C, LDC, V, LDV, ONE, WORK,
      $                        LDWORK )
                END IF
+*
 *              W := W * T  or  W * T**H
+*
                IF( N.GT.K ) THEN
+*
 *                 C1 := C1 - W * V1
+*
-                  CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, K,
+                  CALL ZGEMM( 'No transpose', 'No transpose', M, N-K,
+     $                        K,
      $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
                END IF
+*
 *              W := W * V2
+*
-               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
+               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+     $                     M,
      $                     K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
+*
 *              C1 := C1 - W
+*
                DO 240 J = 1, K
 *> \endhtmlonly
+*
 *  Definition:
 *  ===========
+*
-*       SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*       RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
 *       .. Scalar Arguments ..
 *       CHARACTER          DIRECT, STOREV
 *       INTEGER            K, LDT, LDV, N
 *       ..
 *>                   (     1 v3 )
 *>                   (        1 )
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+      RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV,
+     $                             TAU, T, LDT )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
-*     .. Scalar Arguments ..
+*        .. Scalar Arguments
+*
-      CHARACTER          DIRECT, STOREV
+      CHARACTER         DIRECT, STOREV
-      INTEGER            K, LDT, LDV, N
+      INTEGER           K, LDT, LDV, N
 *     ..
 *     .. Array Arguments ..
-      COMPLEX*16         T( LDT, * ), TAU( * ), V( LDV, * )
-*     ..
+*
-*  =====================================================================
+      COMPLEX*16        T( LDT, * ), TAU( * ), V( LDV, * )
+*     ..
+*
 *     .. Parameters ..
+*
-      COMPLEX*16         ONE, ZERO
+      COMPLEX*16        ONE, NEG_ONE, ZERO
-      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
+      PARAMETER(ONE=1.0D+0, ZERO = 0.0D+0, NEG_ONE=-1.0D+0)
-     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
-*     ..
+*
 *     .. Local Scalars ..
+*
-      INTEGER            I, J, PREVLASTV, LASTV
+      INTEGER           I,J,L
+      LOGICAL           QR,LQ,QL,DIRF,COLV
-*     ..
+*
 *     .. External Subroutines ..
+*
-      EXTERNAL           ZGEMV, ZTRMV, ZGEMM
+      EXTERNAL          ZTRMM,ZGEMM,ZLACPY
-*     ..
+*
-*     .. External Functions ..
+*     .. External Functions..
+*
-      LOGICAL            LSAME
+      LOGICAL           LSAME
-      EXTERNAL           LSAME
+      EXTERNAL          LSAME
+*
+*     .. Intrinsic Functions..
+*
+      INTRINSIC         CONJG
+*
+*     The general scheme used is inspired by the approach inside DGEQRT3
+*     which was (at the time of writing this code):
+*     Based on the algorithm of Elmroth and Gustavson,
+*     IBM J. Res. Develop. Vol 44 No. 4 July 2000.
 *     ..
 *     .. Executable Statements ..
+*
 *     Quick return if possible
+*
-      IF( N.EQ.0 )
+      IF(N.EQ.0.OR.K.EQ.0) THEN
-     $   RETURN
+         RETURN
+      END IF
+*
-      IF( LSAME( DIRECT, 'F' ) ) THEN
-         PREVLASTV = N
-         DO I = 1, K
+*     Base case
-            PREVLASTV = MAX( PREVLASTV, I )
-            IF( TAU( I ).EQ.ZERO ) THEN
+*
+      IF(N.EQ.1.OR.K.EQ.1) THEN
-*              H(i)  =  I
+         T(1,1) = TAU(1)
+         RETURN
+      END IF
+*
-               DO J = 1, I
-                  T( J, I ) = ZERO
+*     Beginning of executable statements
-               END DO
-            ELSE
+*
-*              general case
+      L = K / 2
+*
-               IF( LSAME( STOREV, 'C' ) ) THEN
-*                 Skip any trailing zeros.
+*     Determine what kind of Q we need to compute
-                  DO LASTV = N, I+1, -1
-                     IF( V( LASTV, I ).NE.ZERO ) EXIT
+*     We assume that if the user doesn't provide 'F' for DIRECT,
-                  END DO
-                  DO J = 1, I-1
-                     T( J, I ) = -TAU( I ) * CONJG( V( I , J ) )
+*     then they meant to provide 'B' and if they don't provide
-                  END DO
-                  J = MIN( LASTV, PREVLASTV )
+*     'C' for STOREV, then they meant to provide 'R'
+*
+      DIRF = LSAME(DIRECT,'F')
-*                 T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**H * V(i:j,i)
+      COLV = LSAME(STOREV,'C')
+*
-                  CALL ZGEMV( 'Conjugate transpose', J-I, I-1,
-     $                        -TAU( I ), V( I+1, 1 ), LDV,
+*     QR happens when we have forward direction in column storage
-     $                        V( I+1, I ), 1, ONE, T( 1, I ), 1 )
-               ELSE
-*                 Skip any trailing zeros.
-                  DO LASTV = N, I+1, -1
-                     IF( V( I, LASTV ).NE.ZERO ) EXIT
-                  END DO
-                  DO J = 1, I-1
-                     T( J, I ) = -TAU( I ) * V( J , I )
-                  END DO
-                  J = MIN( LASTV, PREVLASTV )
+*
-*                 T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H
+      QR = DIRF.AND.COLV
+*
-                  CALL ZGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ),
-     $                        V( 1, I+1 ), LDV, V( I, I+1 ), LDV,
+*     LQ happens when we have forward direction in row storage
-     $                        ONE, T( 1, I ), LDT )
-               END IF
+*
-*              T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+      LQ = DIRF.AND.(.NOT.COLV)
+*
+*     QL happens when we have backward direction in column storage
+*
+      QL = (.NOT.DIRF).AND.COLV
+*
+*     The last case is RQ. Due to how we structured this, if the
-               CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+*     above 3 are false, then RQ must be true, so we never store
+*     this
+*     RQ happens when we have backward direction in row storage
+*     RQ = (.NOT.DIRF).AND.(.NOT.COLV)
+*
+      IF(QR) THEN
+*
+*        Break V apart into 6 components
+*
+*        V = |---------------|
-     $                     LDT, T( 1, I ), 1 )
+*            |V_{1,1} 0      |
+*            |V_{2,1} V_{2,2}|
+*            |V_{3,1} V_{3,2}|
+*            |---------------|
+*
+*        V_{1,1}\in\C^{l,l}      unit lower triangular
+*        V_{2,1}\in\C^{k-l,l}    rectangular
+*        V_{3,1}\in\C^{n-k,l}    rectangular
+*
+*        V_{2,2}\in\C^{k-l,k-l}  unit lower triangular
+*        V_{3,2}\in\C^{n-k,k-l}  rectangular
+*
+*        We will construct the T matrix
+*        T = |---------------|
-               T( I, I ) = TAU( I )
+*            |T_{1,1} T_{1,2}|
-               IF( I.GT.1 ) THEN
+*            |0       T_{2,2}|
+*            |---------------|
+*
+*        T is the triangular factor obtained from block reflectors.
+*        To motivate the structure, assume we have already computed T_{1,1}
+*        and T_{2,2}. Then collect the associated reflectors in V_1 and V_2
+*
+*        T_{1,1}\in\C^{l, l}     upper triangular
+*        T_{2,2}\in\C^{k-l, k-l} upper triangular
+*        T_{1,2}\in\C^{l, k-l}   rectangular
+*
+*        Where l = floor(k/2)
+*
+*        Then, consider the product:
+*
-                  PREVLASTV = MAX( PREVLASTV, LASTV )
+*        (I - V_1*T_{1,1}*V_1')*(I - V_2*T_{2,2}*V_2')
+*        = I - V_1*T_{1,1}*V_1' - V_2*T_{2,2}*V_2' + V_1*T_{1,1}*V_1'*V_2*T_{2,2}*V_2'
+*
+*        Define T_{1,2} = -T_{1,1}*V_1'*V_2*T_{2,2}
+*
+*        Then, we can define the matrix V as
+*        V = |-------|
-               ELSE
+*            |V_1 V_2|
+*            |-------|
+*
+*        So, our product is equivalent to the matrix product
+*        I - V*T*V'
+*        This means, we can compute T_{1,1} and T_{2,2}, then use this information
+*        to compute T_{1,2}
+*
+*        Compute T_{1,1} recursively
+*
+         CALL ZLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT)
+*
+*        Compute T_{2,2} recursively
+*
+         CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV,
-                  PREVLASTV = LASTV
+     $               TAU(L+1), T(L+1, L+1), LDT)
+*
+*        Compute T_{1,2}
+*        T_{1,2} = V_{2,1}'
+*
+         DO J = 1, L
-               END IF
+            DO I = 1, K-L
+               T(J, L+I) = CONJG(V(L+I, J))
-             END IF
+            END DO
          END DO
-      ELSE
-         PREVLASTV = 1
-         DO I = K, 1, -1
-            IF( TAU( I ).EQ.ZERO ) THEN
+*
-*              H(i)  =  I
+*        T_{1,2} = T_{1,2}*V_{2,2}
+*
-               DO J = I, K
+         CALL ZTRMM('Right', 'Lower', 'No transpose', 'Unit', L,
-                  T( J, I ) = ZERO
+     $               K-L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT)
-               END DO
-            ELSE
+*
-*              general case
+*        T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2}
+*        Note: We assume K <= N, and GEMM will do nothing if N=K
+*
-               IF( I.LT.K ) THEN
-                  IF( LSAME( STOREV, 'C' ) ) THEN
-*                    Skip any leading zeros.
-                     DO LASTV = 1, I-1
-                        IF( V( LASTV, I ).NE.ZERO ) EXIT
-                     END DO
-                     DO J = I+1, K
-                        T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) )
-                     END DO
-                     J = MAX( LASTV, PREVLASTV )
-*
-*                    T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**H * V(j:n-k+i,i)
-*
-                     CALL ZGEMV( 'Conjugate transpose', N-K+I-J, K-I,
+         CALL ZGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE,
-     $                           -TAU( I ), V( J, I+1 ), LDV, V( J, I ),
+     $               V(K+1, 1), LDV, V(K+1, L+1), LDV, ONE,
-     $                           1, ONE, T( I+1, I ), 1 )
-                  ELSE
-*                    Skip any leading zeros.
-                     DO LASTV = 1, I-1
-                        IF( V( I, LASTV ).NE.ZERO ) EXIT
-                     END DO
-                     DO J = I+1, K
+     $               T(1, L+1), LDT)
-                        T( J, I ) = -TAU( I ) * V( J, N-K+I )
-                     END DO
-                     J = MAX( LASTV, PREVLASTV )
-*
-*                    T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H
-*
-                     CALL ZGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ),
-     $                           V( I+1, J ), LDV, V( I, J ), LDV,
-     $                           ONE, T( I+1, I ), LDT )
-                  END IF
+*
-*                 T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*        At this point, we have that T_{1,2} = V_1'*V_2
+*        All that is left is to pre and post multiply by -T_{1,1} and T_{2,2}
+*        respectively.
+*
+*        T_{1,2} = -T_{1,1}*T_{1,2}
+*
-                  CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+         CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L,
+     $               K-L, NEG_ONE, T, LDT, T(1, L+1), LDT)
+*
+*        T_{1,2} = T_{1,2}*T_{2,2}
+*
+         CALL ZTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L,
-     $                        T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+     $               K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT)
+      ELSE IF(LQ) THEN
+*
+*        Break V apart into 6 components
+*
+*        V = |----------------------|
+*            |V_{1,1} V_{1,2} V{1,3}|
+*            |0       V_{2,2} V{2,3}|
+*            |----------------------|
+*
+*        V_{1,1}\in\C^{l,l}      unit upper triangular
+*        V_{1,2}\in\C^{l,k-l}    rectangular
+*        V_{1,3}\in\C^{l,n-k}    rectangular
+*
+*        V_{2,2}\in\C^{k-l,k-l}  unit upper triangular
+*        V_{2,3}\in\C^{k-l,n-k}  rectangular
+*
+*        Where l = floor(k/2)
+*
+*        We will construct the T matrix
+*        T = |---------------|
+*            |T_{1,1} T_{1,2}|
-                  IF( I.GT.1 ) THEN
+*            |0       T_{2,2}|
+*            |---------------|
+*
+*        T is the triangular factor obtained from block reflectors.
+*        To motivate the structure, assume we have already computed T_{1,1}
+*        and T_{2,2}. Then collect the associated reflectors in V_1 and V_2
+*
+*        T_{1,1}\in\C^{l, l}         upper triangular
+*        T_{2,2}\in\C^{k-l, k-l}     upper triangular
+*        T_{1,2}\in\C^{l, k-l}       rectangular
+*
+*        Then, consider the product:
+*
+*        (I - V_1'*T_{1,1}*V_1)*(I - V_2'*T_{2,2}*V_2)
+*        = I - V_1'*T_{1,1}*V_1 - V_2'*T_{2,2}*V_2 + V_1'*T_{1,1}*V_1*V_2'*T_{2,2}*V_2
+*
+*        Define T_{1,2} = -T_{1,1}*V_1*V_2'*T_{2,2}
+*
+*        Then, we can define the matrix V as
+*        V = |---|
+*            |V_1|
+*            |V_2|
+*            |---|
+*
+*        So, our product is equivalent to the matrix product
+*        I - V'*T*V
+*        This means, we can compute T_{1,1} and T_{2,2}, then use this information
+*        to compute T_{1,2}
+*
+*        Compute T_{1,1} recursively
+*
+         CALL ZLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT)
+*
+*        Compute T_{2,2} recursively
+*
+         CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV,
-                     PREVLASTV = MIN( PREVLASTV, LASTV )
+     $               TAU(L+1), T(L+1, L+1), LDT)
+*
-                  ELSE
+*        Compute T_{1,2}
+*        T_{1,2} = V_{1,2}
+*
+         CALL ZLACPY('All', L, K-L, V(1, L+1), LDV, T(1, L+1), LDT)
+*
+*        T_{1,2} = T_{1,2}*V_{2,2}'
+*
+         CALL ZTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L,
+     $               ONE, V(L+1, L+1), LDV, T(1, L+1), LDT)
+*
+*        T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2}
+*        Note: We assume K <= N, and GEMM will do nothing if N=K
+*
+         CALL ZGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE,
+     $               V(1, K+1), LDV, V(L+1, K+1), LDV, ONE,
-                     PREVLASTV = LASTV
+     $               T(1, L+1), LDT)
+*
+*        At this point, we have that T_{1,2} = V_1*V_2'
+*        All that is left is to pre and post multiply by -T_{1,1} and T_{2,2}
+*        respectively.
+*
+*        T_{1,2} = -T_{1,1}*T_{1,2}
+*
+         CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L,
+     $               K-L, NEG_ONE, T, LDT, T(1, L+1), LDT)
+*
+*        T_{1,2} = T_{1,2}*T_{2,2}
+*
+         CALL ZTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L,
+     $               K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT)
+      ELSE IF(QL) THEN
+*
+*        Break V apart into 6 components
+*
+*        V = |---------------|
+*            |V_{1,1} V_{1,2}|
+*            |V_{2,1} V_{2,2}|
-                  END IF
+*            |0       V_{3,2}|
+*            |---------------|
+*
+*        V_{1,1}\in\C^{n-k,k-l}  rectangular
+*        V_{2,1}\in\C^{k-l,k-l}  unit upper triangular
+*
+*        V_{1,2}\in\C^{n-k,l}    rectangular
+*        V_{2,2}\in\C^{k-l,l}    rectangular
+*        V_{3,2}\in\C^{l,l}      unit upper triangular
+*
+*        We will construct the T matrix
+*        T = |---------------|
+*            |T_{1,1} 0      |
+*            |T_{2,1} T_{2,2}|
+*            |---------------|
+*
+*        T is the triangular factor obtained from block reflectors.
+*        To motivate the structure, assume we have already computed T_{1,1}
+*        and T_{2,2}. Then collect the associated reflectors in V_1 and V_2
+*
+*        T_{1,1}\in\C^{k-l, k-l} non-unit lower triangular
+*        T_{2,2}\in\C^{l, l}     non-unit lower triangular
+*        T_{2,1}\in\C^{k-l, l}   rectangular
+*
+*        Where l = floor(k/2)
+*
+*        Then, consider the product:
+*
+*        (I - V_2*T_{2,2}*V_2')*(I - V_1*T_{1,1}*V_1')
+*        = I - V_2*T_{2,2}*V_2' - V_1*T_{1,1}*V_1' + V_2*T_{2,2}*V_2'*V_1*T_{1,1}*V_1'
+*
+*        Define T_{2,1} = -T_{2,2}*V_2'*V_1*T_{1,1}
+*
+*        Then, we can define the matrix V as
+*        V = |-------|
+*            |V_1 V_2|
+*            |-------|
+*
+*        So, our product is equivalent to the matrix product
+*        I - V*T*V'
+*        This means, we can compute T_{1,1} and T_{2,2}, then use this information
+*        to compute T_{2,1}
+*
+*        Compute T_{1,1} recursively
+*
+         CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT)
+*
+*        Compute T_{2,2} recursively
+*
+         CALL ZLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV,
+     $               TAU(K-L+1), T(K-L+1, K-L+1), LDT)
+*
+*        Compute T_{2,1}
+*        T_{2,1} = V_{2,2}'
+*
+         DO J = 1, K-L
-               END IF
+            DO I = 1, L
-               T( I, I ) = TAU( I )
+               T(K-L+I, J) = CONJG(V(N-K+J, K-L+I))
-            END IF
+            END DO
          END DO
-      END IF
-      RETURN
+*
-*     End of ZLARFT
+*        T_{2,1} = T_{2,1}*V_{2,1}
+*
+         CALL ZTRMM('Right', 'Upper', 'No transpose', 'Unit', L,
+     $               K-L, ONE, V(N-K+1, 1), LDV, T(K-L+1, 1), LDT)
+*
+*        T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1}
+*        Note: We assume K <= N, and GEMM will do nothing if N=K
+*
+         CALL ZGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE,
+     $               V(1, K-L+1), LDV, V, LDV, ONE, T(K-L+1, 1),
+     $               LDT)
+*
+*        At this point, we have that T_{2,1} = V_2'*V_1
+*        All that is left is to pre and post multiply by -T_{2,2} and T_{1,1}
+*        respectively.
+*
+*        T_{2,1} = -T_{2,2}*T_{2,1}
+*
+         CALL ZTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L,
+     $               K-L, NEG_ONE, T(K-L+1, K-L+1), LDT,
+     $               T(K-L+1, 1), LDT)
+*
+*        T_{2,1} = T_{2,1}*T_{1,1}
+*
+         CALL ZTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L,
+     $               K-L, ONE, T, LDT, T(K-L+1, 1), LDT)
+      ELSE
+*
+*        Else means RQ case
+*
+*        Break V apart into 6 components
+*
+*        V = |-----------------------|
+*            |V_{1,1} V_{1,2} 0      |
+*            |V_{2,1} V_{2,2} V_{2,3}|
+*            |-----------------------|
+*
+*        V_{1,1}\in\C^{k-l,n-k}  rectangular
+*        V_{1,2}\in\C^{k-l,k-l}  unit lower triangular
+*
+*        V_{2,1}\in\C^{l,n-k}    rectangular
+*        V_{2,2}\in\C^{l,k-l}    rectangular
+*        V_{2,3}\in\C^{l,l}      unit lower triangular
+*
+*        We will construct the T matrix
+*        T = |---------------|
+*            |T_{1,1} 0      |
+*            |T_{2,1} T_{2,2}|
+*            |---------------|
+*
+*        T is the triangular factor obtained from block reflectors.
+*        To motivate the structure, assume we have already computed T_{1,1}
+*        and T_{2,2}. Then collect the associated reflectors in V_1 and V_2
+*
+*        T_{1,1}\in\C^{k-l, k-l} non-unit lower triangular
+*        T_{2,2}\in\C^{l, l}     non-unit lower triangular
+*        T_{2,1}\in\C^{k-l, l}   rectangular
+*
+*        Where l = floor(k/2)
+*
+*        Then, consider the product:
+*
+*        (I - V_2'*T_{2,2}*V_2)*(I - V_1'*T_{1,1}*V_1)
+*        = I - V_2'*T_{2,2}*V_2 - V_1'*T_{1,1}*V_1 + V_2'*T_{2,2}*V_2*V_1'*T_{1,1}*V_1
+*
+*        Define T_{2,1} = -T_{2,2}*V_2*V_1'*T_{1,1}
+*
+*        Then, we can define the matrix V as
+*        V = |---|
+*            |V_1|
+*            |V_2|
+*            |---|
+*
+*        So, our product is equivalent to the matrix product
+*        I - V'*T*V
+*        This means, we can compute T_{1,1} and T_{2,2}, then use this information
+*        to compute T_{2,1}
+*
+*        Compute T_{1,1} recursively
+*
+         CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT)
+*
+*        Compute T_{2,2} recursively
+*
+         CALL ZLARFT(DIRECT, STOREV, N, L, V(K-L+1, 1), LDV,
+     $               TAU(K-L+1), T(K-L+1, K-L+1), LDT)
+*
+*        Compute T_{2,1}
+*        T_{2,1} = V_{2,2}
+*
+         CALL ZLACPY('All', L, K-L, V(K-L+1, N-K+1), LDV,
+     $               T(K-L+1, 1), LDT)
+*
+*        T_{2,1} = T_{2,1}*V_{1,2}'
+*
+         CALL ZTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L,
+     $               ONE, V(1, N-K+1), LDV, T(K-L+1, 1), LDT)
+*
+*        T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1}
+*        Note: We assume K <= N, and GEMM will do nothing if N=K
+*
+         CALL ZGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE,
+     $               V(K-L+1, 1), LDV, V, LDV, ONE, T(K-L+1, 1),
+     $               LDT)
+*
+*        At this point, we have that T_{2,1} = V_2*V_1'
+*        All that is left is to pre and post multiply by -T_{2,2} and T_{1,1}
+*        respectively.
+*
+*        T_{2,1} = -T_{2,2}*T_{2,1}
+*
+         CALL ZTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L,
+     $               K-L, NEG_ONE, T(K-L+1, K-L+1), LDT,
+     $               T(K-L+1, 1), LDT)
+*
+*        T_{2,1} = T_{2,1}*T_{1,1}
+*
+         CALL ZTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L,
+     $               K-L, ONE, T, LDT, T(K-L+1, 1), LDT)
-      END
+      END IF
+      END SUBROUTINE
 *> \brief \b ZLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10.
+*
 *  =========== DOCUMENTATION ===========
+*
 * Online html documentation available at
 *> \author NAG Ltd.
+*
 *> \ingroup lascl
+*
 *  =====================================================================
-      SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
+      SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA,
+     $                   INFO )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
 *     .. Executable Statements ..
+*
 *     Test the input parameters
+*
       INFO = 0
-      IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
+      IF( .NOT.( LSAME( SIDE, 'L' ) .OR.
+     $    LSAME( SIDE, 'R' ) ) ) THEN
          INFO = 1
       ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
      $         'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
          INFO = 2
-      ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
+      ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR.
+     $         LSAME( DIRECT, 'B' ) ) )
      $          THEN
          INFO = 3
       ELSE IF( M.LT.0 ) THEN
          INFO = 4
       ELSE IF( N.LT.0 ) THEN
 *>                  Computer Science Division,
 *>                  University of California, Berkeley
 *> \endverbatim
+*
 *  =====================================================================
-      SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO )
+      SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       PARAMETER          ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 )
       COMPLEX*16         CONE
       PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP,
+      INTEGER            IMAX, J, JJ, JMAX, JP, K, KK, KKW, KP,
      $                   KSTEP, KW
       DOUBLE PRECISION   ABSAKK, ALPHA, COLMAX, ROWMAX
       COMPLEX*16         D11, D21, D22, R1, T, Z
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            IZAMAX
       EXTERNAL           LSAME, IZAMAX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZCOPY, ZGEMM, ZGEMV, ZSCAL, ZSWAP
+      EXTERNAL           ZCOPY, ZGEMMTR, ZGEMV, ZSCAL, ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DIMAG, MAX, MIN, SQRT
 *     ..
 *     .. Statement Functions ..
+*
 *        Copy column K of A to column KW of W and update it
+*
          CALL ZCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 )
          IF( K.LT.N )
-     $      CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA,
+     $      CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ),
+     $                  LDA,
      $                  W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 )
+*
          KSTEP = 1
+*
 *        Determine rows and columns to be interchanged and whether
+*
 *        Update the upper triangle of A11 (= A(1:k,1:k)) as
+*
 *        A11 := A11 - U12*D*U12**T = A11 - U12*W**T
+*
-*        computing blocks of NB columns at a time
-*
-         DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB
-            JB = MIN( NB, K-J+1 )
-*
-*           Update the upper triangle of the diagonal block
-*
-            DO 40 JJ = J, J + JB - 1
-               CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE,
-     $                     A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE,
-     $                     A( J, JJ ), 1 )
-CONTINUE
-*
-*           Update the rectangular superdiagonal block
-*
-            CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB, N-K,
+         CALL ZGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K,
-     $                  -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW,
+     $                 -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW,
-     $                  CONE, A( 1, J ), LDA )
+     $                 CONE, A( 1, 1 ), LDA )
-CONTINUE
+*
 *        Put U12 in standard form by partially undoing the interchanges
 *        in columns k+1:n looping backwards from k+1 to n
+*
          J = K + 1
      $      GO TO 90
+*
 *        Copy column K of A to column K of W and update it
+*
          CALL ZCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 )
-         CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), LDA,
+         CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ),
+     $               LDA,
      $               W( K, 1 ), LDW, CONE, W( K, K ), 1 )
+*
          KSTEP = 1
+*
 *        Determine rows and columns to be interchanged and whether
                KP = K
             ELSE
+*
 *              Copy column IMAX to column K+1 of W and update it
+*
-               CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 )
+               CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ),
-               CALL ZCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, K+1 ),
      $                     1 )
+               CALL ZCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX,
+     $                     K+1 ),
+     $                     1 )
-               CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ),
+               CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K,
+     $                     1 ),
      $                     LDA, W( IMAX, 1 ), LDW, CONE, W( K, K+1 ),
      $                     1 )
+*
 *              JMAX is the column-index of the largest off-diagonal
 *              element in row IMAX, and ROWMAX is its absolute value
+*
                A( KP, KP ) = A( KK, KK )
                CALL ZCOPY( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
      $                     LDA )
                IF( KP.LT.N )
-     $            CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+     $            CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ),
+     $                        1 )
+*
 *              Interchange rows KK and KP in first K-1 columns of A
 *              (columns K (or K and K+1 for 2-by-2 pivot) of A will be
 *              later overwritten). Interchange rows KK and KP
 *              in first KK columns of W.
+*
 *        Update the lower triangle of A22 (= A(k:n,k:n)) as
+*
 *        A22 := A22 - L21*D*L21**T = A22 - L21*W**T
+*
-*        computing blocks of NB columns at a time
-*
-         DO 110 J = K, N, NB
-            JB = MIN( NB, N-J+1 )
-*
-*           Update the lower triangle of the diagonal block
-*
-            DO 100 JJ = J, J + JB - 1
-               CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE,
-     $                     A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE,
-     $                     A( JJ, JJ ), 1 )
-CONTINUE
-*
-*           Update the rectangular subdiagonal block
-*
-            IF( J+JB.LE.N )
-     $         CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
+         CALL ZGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1,
-     $                     K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ),
+     $                 K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW,
-     $                     LDW, CONE, A( J+JB, J ), LDA )
+     $                 CONE, A( K, K ), LDA )
-CONTINUE
+*
 *        Put L21 in standard form by partially undoing the interchanges
 *        of rows in columns 1:k-1 looping backwards from k-1 to 1
+*
          J = K - 1
 *>  and we can safely call ZTBSV if 1/M(n) and 1/G(n) are both greater
 *>  than max(underflow, 1/overflow).
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
+      SUBROUTINE ZLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB,
+     $                   X,
      $                   SCALE, CNORM, INFO )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            IDAMAX, IZAMAX
       DOUBLE PRECISION   DLAMCH, DZASUM
       COMPLEX*16         ZDOTC, ZDOTU, ZLADIV
-      EXTERNAL           LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC,
+      EXTERNAL           LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM,
+     $                   ZDOTC,
      $                   ZDOTU, ZLADIV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTBSV
 *     ..
 *     .. Local Arrays ..
       DOUBLE PRECISION   RWORK( MAXDIM )
       COMPLEX*16         WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZCOPY, ZGECON, ZGESC2, ZLASSQ, ZLASWP,
+      EXTERNAL           ZAXPY, ZCOPY, ZGECON, ZGESC2, ZLASSQ,
+     $                   ZLASWP,
      $                   ZSCAL
 *     ..
 *     .. External Functions ..
       DOUBLE PRECISION   DZASUM
       COMPLEX*16         ZDOTC
 *           Look-ahead for L- part RHS(1:N-1) = +-1
 *           SPLUS and SMIN computed more efficiently than in BSOLVE[1].
+*
             SPLUS = SPLUS + DBLE( ZDOTC( N-J, Z( J+1, J ), 1, Z( J+1,
      $              J ), 1 ) )
-            SMINU = DBLE( ZDOTC( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 ) )
+            SMINU = DBLE( ZDOTC( N-J, Z( J+1, J ), 1, RHS( J+1 ),
+     $                    1 ) )
             SPLUS = SPLUS*DBLE( RHS( J ) )
             IF( SPLUS.GT.SMINU ) THEN
                RHS( J ) = BP
             ELSE IF( SMINU.GT.SPLUS ) THEN
                RHS( J ) = BM
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            IDAMAX, IZAMAX
       DOUBLE PRECISION   DLAMCH, DZASUM
       COMPLEX*16         ZDOTC, ZDOTU, ZLADIV
-      EXTERNAL           LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC,
+      EXTERNAL           LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM,
+     $                   ZDOTC,
      $                   ZDOTU, ZLADIV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTPSV
 *     ..
                   IF( J.GT.1 ) THEN
+*
 *                    Compute the update
 *                       x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
+*
-                     CALL ZAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, X,
+                     CALL ZAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1,
+     $                           X,
      $                           1 )
                      I = IZAMAX( J-1, X, 1 )
                      XMAX = CABS1( X( I ) )
                   END IF
                   IP = IP - J
 *     .. Local Scalars ..
       INTEGER            I, IW
       COMPLEX*16         ALPHA
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZAXPY, ZGEMV, ZHEMV, ZLACGV, ZLARFG, ZSCAL
+      EXTERNAL           ZAXPY, ZGEMV, ZHEMV, ZLACGV, ZLARFG,
+     $                   ZSCAL
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       COMPLEX*16         ZDOTC
       EXTERNAL           LSAME, ZDOTC
                CALL ZLACGV( N-I, W( I, IW+1 ), LDW )
                CALL ZGEMV( 'No transpose', I, N-I, -ONE, A( 1, I+1 ),
      $                     LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 )
                CALL ZLACGV( N-I, W( I, IW+1 ), LDW )
                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-               CALL ZGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ),
+               CALL ZGEMV( 'No transpose', I, N-I, -ONE, W( 1,
+     $                     IW+1 ),
      $                     LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 )
                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
                A( I, I ) = DBLE( A( I, I ) )
             END IF
             IF( I.GT.1 ) THEN
                CALL ZHEMV( 'Lower', N-I, ONE, A( I+1, I+1 ), LDA,
      $                     A( I+1, I ), 1, ZERO, W( I+1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
      $                     W( I+1, 1 ), LDW, A( I+1, I ), 1, ZERO,
      $                     W( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ),
+               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1,
+     $                     1 ),
      $                     LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
                CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
      $                     A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO,
      $                     W( 1, I ), 1 )
-               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ),
+               CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1,
+     $                     1 ),
      $                     LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 )
                CALL ZSCAL( N-I, TAU( I ), W( I+1, I ), 1 )
                ALPHA = -HALF*TAU( I )*ZDOTC( N-I, W( I+1, I ), 1,
      $                 A( I+1, I ), 1 )
-               CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 )
+               CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ),
+     $                     1 )
             END IF
+*
 CONTINUE
       END IF
+*
 *>  and we can safely call ZTRSV if 1/M(n) and 1/G(n) are both greater
 *>  than max(underflow, 1/overflow).
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
+      SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X,
+     $                   SCALE,
      $                   CNORM, INFO )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            IDAMAX, IZAMAX
       DOUBLE PRECISION   DLAMCH, DZASUM
       COMPLEX*16         ZDOTC, ZDOTU, ZLADIV
-      EXTERNAL           LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC,
+      EXTERNAL           LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM,
+     $                   ZDOTC,
      $                   ZDOTU, ZLADIV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV
 *     ..
 *                 call ZDOTU to perform the dot product.
+*
                   IF( UPPER ) THEN
                      CSUMJ = ZDOTU( J-1, A( 1, J ), 1, X, 1 )
                   ELSE IF( J.LT.N ) THEN
-                     CSUMJ = ZDOTU( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
+                     CSUMJ = ZDOTU( N-J, A( J+1, J ), 1, X( J+1 ),
+     $                              1 )
                   END IF
                ELSE
+*
 *                 Otherwise, use in-line code for the dot product.
+*
 *                 call ZDOTC to perform the dot product.
+*
                   IF( UPPER ) THEN
                      CSUMJ = ZDOTC( J-1, A( 1, J ), 1, X, 1 )
                   ELSE IF( J.LT.N ) THEN
-                     CSUMJ = ZDOTC( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
+                     CSUMJ = ZDOTC( N-J, A( J+1, J ), 1, X( J+1 ),
+     $                              1 )
                   END IF
                ELSE
+*
 *                 Otherwise, use in-line code for the dot product.
+*
 *        Compute the product U * U**H.
+*
          DO 10 I = 1, N
             AII = DBLE( A( I, I ) )
             IF( I.LT.N ) THEN
-               A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), LDA,
+               A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ),
+     $            LDA,
      $                     A( I, I+1 ), LDA ) )
                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
-               CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
+               CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1,
+     $                     I+1 ),
      $                     LDA, A( I, I+1 ), LDA, DCMPLX( AII ),
      $                     A( 1, I ), 1 )
                CALL ZLACGV( N-I, A( I, I+1 ), LDA )
             ELSE
                CALL ZDSCAL( I, AII, A( 1, I ), 1 )
 *        Compute the product L**H * L.
+*
          DO 20 I = 1, N
             AII = DBLE( A( I, I ) )
             IF( I.LT.N ) THEN
-               A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), 1,
+               A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ),
+     $            1,
      $                     A( I+1, I ), 1 ) )
                CALL ZLACGV( I-1, A( I, 1 ), LDA )
                CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE,
      $                     A( I+1, 1 ), LDA, A( I+1, I ), 1,
      $                     DCMPLX( AII ), A( I, 1 ), LDA )
                CALL ZTRMM( 'Left', 'Lower', 'Conjugate transpose',
      $                     'Non-unit', IB, I-1, CONE, A( I, I ), LDA,
      $                     A( I, 1 ), LDA )
                CALL ZLAUU2( 'Lower', IB, A( I, I ), LDA, INFO )
                IF( I+IB.LE.N ) THEN
-                  CALL ZGEMM( 'Conjugate transpose', 'No transpose', IB,
+                  CALL ZGEMM( 'Conjugate transpose', 'No transpose',
+     $                        IB,
      $                        I-1, N-I-IB+1, CONE, A( I+IB, I ), LDA,
      $                        A( I+IB, 1 ), LDA, CONE, A( I, 1 ), LDA )
                   CALL ZHERK( 'Lower', 'Conjugate transpose', IB,
      $                        N-I-IB+1, ONE, A( I+IB, I ), LDA, ONE,
      $                        A( I, I ), LDA )
       LOGICAL            LSAME
       INTEGER            ILAENV
       EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZHERK, ZPBTF2, ZPOTF2, ZTRSM
+      EXTERNAL           XERBLA, ZGEMM, ZHERK, ZPBTF2, ZPOTF2,
+     $                   ZTRSM
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MIN
 *     ..
 *     .. Executable Statements ..
+*
                   IF( I2.GT.0 ) THEN
+*
 *                    Update A12
+*
-                     CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose',
+                     CALL ZTRSM( 'Left', 'Upper',
+     $                           'Conjugate transpose',
      $                           'Non-unit', IB, I2, CONE,
      $                           AB( KD+1, I ), LDAB-1,
      $                           AB( KD+1-IB, I+IB ), LDAB-1 )
+*
 *                    Update A22
+*
-                     CALL ZHERK( 'Upper', 'Conjugate transpose', I2, IB,
+                     CALL ZHERK( 'Upper', 'Conjugate transpose', I2,
+     $                           IB,
      $                           -ONE, AB( KD+1-IB, I+IB ), LDAB-1, ONE,
      $                           AB( KD+1, I+IB ), LDAB-1 )
                   END IF
+*
                   IF( I3.GT.0 ) THEN
 CONTINUE
 CONTINUE
+*
 *                    Update A13 (in the work array).
+*
-                     CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose',
+                     CALL ZTRSM( 'Left', 'Upper',
+     $                           'Conjugate transpose',
      $                           'Non-unit', IB, I3, CONE,
      $                           AB( KD+1, I ), LDAB-1, WORK, LDWORK )
+*
 *                    Update A23
+*
      $                              LDWORK, CONE, AB( 1+IB, I+KD ),
      $                              LDAB-1 )
+*
 *                    Update A33
+*
-                     CALL ZHERK( 'Upper', 'Conjugate transpose', I3, IB,
+                     CALL ZHERK( 'Upper', 'Conjugate transpose', I3,
+     $                           IB,
      $                           -ONE, WORK, LDWORK, ONE,
      $                           AB( KD+1, I+KD ), LDAB-1 )
+*
 *                    Copy the lower triangle of A13 back into place.
+*
      $                           IB, CONE, AB( 1, I ), LDAB-1,
      $                           AB( 1+IB, I ), LDAB-1 )
+*
 *                    Update A22
+*
-                     CALL ZHERK( 'Lower', 'No transpose', I2, IB, -ONE,
+                     CALL ZHERK( 'Lower', 'No transpose', I2, IB,
+     $                           -ONE,
      $                           AB( 1+IB, I ), LDAB-1, ONE,
      $                           AB( 1, I+IB ), LDAB-1 )
                   END IF
+*
                   IF( I3.GT.0 ) THEN
      $                              LDAB-1, CONE, AB( 1+KD-IB, I+IB ),
      $                              LDAB-1 )
+*
 *                    Update A33
+*
-                     CALL ZHERK( 'Lower', 'No transpose', I3, IB, -ONE,
+                     CALL ZHERK( 'Lower', 'No transpose', I3, IB,
+     $                           -ONE,
      $                           WORK, LDWORK, ONE, AB( 1, I+KD ),
      $                           LDAB-1 )
+*
 *                    Copy the upper triangle of A31 back into place.
+*
      $                   NORMIN, N, A, LDA, WORK, SCALEL, RWORK, INFO )
             NORMIN = 'Y'
+*
 *           Multiply by inv(U).
+*
-            CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
+            CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN,
+     $                   N,
      $                   A, LDA, WORK, SCALEU, RWORK, INFO )
          ELSE
+*
 *           Multiply by inv(L).
+*
-            CALL ZLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
+            CALL ZLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN,
+     $                   N,
      $                   A, LDA, WORK, SCALEL, RWORK, INFO )
             NORMIN = 'Y'
+*
 *           Multiply by inv(L**H).
+*
 *     ..
 *     .. Local Arrays ..
       INTEGER            ISAVE( 3 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZHEMV, ZLACN2, ZPOTRS
+      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZHEMV, ZLACN2,
+     $                   ZPOTRS
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DIMAG, MAX
 *     ..
 *     .. External Functions ..
 *        Loop until stopping criterion is satisfied.
+*
 *        Compute residual R = B - A * X
+*
          CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 )
-         CALL ZHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 )
+         CALL ZHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK,
+     $               1 )
+*
 *        Compute componentwise relative backward error from formula
+*
 *        max(i) ( abs(R(i)) / ( abs(A)*abs(X) + abs(B) )(i) )
+*
 *     .. Executable Statements ..
+*
 *     Test the input parameters.
+*
       INFO = 0
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND.
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+     $    .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( NRHS.LT.0 ) THEN
          INFO = -3
 *> \author NAG Ltd.
+*
 *> \ingroup posvx
+*
 *  =====================================================================
-      SUBROUTINE ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
+      SUBROUTINE ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF,
+     $                   EQUED,
      $                   S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK,
      $                   RWORK, INFO )
+*
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH, ZLANHE
       EXTERNAL           LSAME, DLAMCH, ZLANHE
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACPY, ZLAQHE, ZPOCON, ZPOEQU, ZPORFS,
+      EXTERNAL           XERBLA, ZLACPY, ZLAQHE, ZPOCON, ZPOEQU,
+     $                   ZPORFS,
      $                   ZPOTRF, ZPOTRS
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
          BIGNUM = ONE / SMLNUM
       END IF
+*
 *     Test the input parameters.
+*
+      IF( .NOT.NOFACT .AND.
+     $    .NOT.EQUIL .AND.
-      IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
+     $    .NOT.LSAME( FACT, 'F' ) )
      $     THEN
          INFO = -1
-      ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
+      ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND.
+     $         .NOT.LSAME( UPLO, 'L' ) )
      $          THEN
          INFO = -2
       ELSE IF( N.LT.0 ) THEN
          INFO = -3
       ELSE IF( NRHS.LT.0 ) THEN
+*
       ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
+*
 *     Compute the reciprocal of the condition number of A.
+*
-      CALL ZPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO )
+      CALL ZPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK,
+     $             INFO )
+*
 *     Compute the solution matrix X.
+*
       CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
       CALL ZPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO )
+*
          DO 20 J = 1, N
+*
 *           Compute L(J,J) and test for non-positive-definiteness.
+*
-            AJJ = DBLE( A( J, J ) ) - DBLE( ZDOTC( J-1, A( J, 1 ), LDA,
+            AJJ = DBLE( A( J, J ) ) - DBLE( ZDOTC( J-1, A( J, 1 ),
+     $                  LDA,
      $            A( J, 1 ), LDA ) )
             IF( AJJ.LE.ZERO.OR.DISNAN( AJJ ) ) THEN
                A( J, J ) = AJJ
                GO TO 30
             END IF
+*
 *           Compute elements J+1:N of column J.
+*
             IF( J.LT.N ) THEN
                CALL ZLACGV( J-1, A( J, 1 ), LDA )
-               CALL ZGEMV( 'No transpose', N-J, J-1, -CONE, A( J+1, 1 ),
+               CALL ZGEMV( 'No transpose', N-J, J-1, -CONE, A( J+1,
+     $                     1 ),
      $                     LDA, A( J, 1 ), LDA, CONE, A( J+1, J ), 1 )
                CALL ZLACGV( J-1, A( J, 1 ), LDA )
                CALL ZDSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
             END IF
 CONTINUE
       LOGICAL            LSAME
       INTEGER            ILAENV
       EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZHERK, ZPOTRF2, ZTRSM
+      EXTERNAL           XERBLA, ZGEMM, ZHERK, ZPOTRF2,
+     $                   ZTRSM
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     ..
 *     .. Executable Statements ..
      $            GO TO 30
                IF( J+JB.LE.N ) THEN
+*
 *                 Compute the current block row.
+*
-                  CALL ZGEMM( 'Conjugate transpose', 'No transpose', JB,
+                  CALL ZGEMM( 'Conjugate transpose', 'No transpose',
+     $                        JB,
      $                        N-J-JB+1, J-1, -CONE, A( 1, J ), LDA,
      $                        A( 1, J+JB ), LDA, CONE, A( J, J+JB ),
      $                        LDA )
                   CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose',
      $                        'Non-unit', JB, N-J-JB+1, CONE, A( J, J ),
+*
                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
      $                        N-J-JB+1, JB, J-1, -CONE, A( J+JB, 1 ),
      $                        LDA, A( J, 1 ), LDA, CONE, A( J+JB, J ),
      $                        LDA )
-                  CALL ZTRSM( 'Right', 'Lower', 'Conjugate transpose',
+                  CALL ZTRSM( 'Right', 'Lower',
+     $                        'Conjugate transpose',
      $                        'Non-unit', N-J-JB+1, JB, CONE, A( J, J ),
      $                        LDA, A( J+JB, J ), LDA )
                END IF
 CONTINUE
          END IF
 *     .. Executable Statements ..
+*
 *     Test the input parameters.
+*
       INFO = 0
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND.
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+     $    .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
+*
 *        Solve A*X = B where A = U**H *U.
+*
 *        Solve U**H *X = B, overwriting B with X.
+*
-         CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose', 'Non-unit',
+         CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose',
+     $               'Non-unit',
      $               N, NRHS, ONE, A, LDA, B, LDB )
+*
 *        Solve U*X = B, overwriting B with X.
+*
          CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
          CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', N,
      $               NRHS, ONE, A, LDA, B, LDB )
+*
 *        Solve L**H *X = B, overwriting B with X.
+*
-         CALL ZTRSM( 'Left', 'Lower', 'Conjugate transpose', 'Non-unit',
+         CALL ZTRSM( 'Left', 'Lower', 'Conjugate transpose',
+     $               'Non-unit',
      $               N, NRHS, ONE, A, LDA, B, LDB )
       END IF
+*
       RETURN
+*
 *> \author NAG Ltd.
+*
 *> \ingroup ppcon
+*
 *  =====================================================================
-      SUBROUTINE ZPPCON( UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO )
+      SUBROUTINE ZPPCON( UPLO, N, AP, ANORM, RCOND, WORK, RWORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
      $                   NORMIN, N, AP, WORK, SCALEL, RWORK, INFO )
             NORMIN = 'Y'
+*
 *           Multiply by inv(U).
+*
-            CALL ZLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
+            CALL ZLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN,
+     $                   N,
      $                   AP, WORK, SCALEU, RWORK, INFO )
          ELSE
+*
 *           Multiply by inv(L).
+*
-            CALL ZLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
+            CALL ZLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN,
+     $                   N,
      $                   AP, WORK, SCALEL, RWORK, INFO )
             NORMIN = 'Y'
+*
 *           Multiply by inv(L**H).
+*
             JJ = JJ + J
+*
 *           Compute elements 1:J-1 of column J.
+*
             IF( J.GT.1 )
-     $         CALL ZTPSV( 'Upper', 'Conjugate transpose', 'Non-unit',
+     $         CALL ZTPSV( 'Upper', 'Conjugate transpose',
+     $                     'Non-unit',
      $                     J-1, AP, AP( JC ), 1 )
+*
 *           Compute U(J,J) and test for non-positive-definiteness.
+*
             AJJ = DBLE( AP( JJ ) ) - DBLE( ZDOTC( J-1,
 *        Compute the product inv(L)**H * inv(L).
+*
          JJ = 1
          DO 20 J = 1, N
             JJN = JJ + N - J + 1
-            AP( JJ ) = DBLE( ZDOTC( N-J+1, AP( JJ ), 1, AP( JJ ), 1 ) )
+            AP( JJ ) = DBLE( ZDOTC( N-J+1, AP( JJ ), 1, AP( JJ ),
+     $          1 ) )
             IF( J.LT.N )
-     $         CALL ZTPMV( 'Lower', 'Conjugate transpose', 'Non-unit',
+     $         CALL ZTPMV( 'Lower', 'Conjugate transpose',
+     $                     'Non-unit',
      $                     N-J, AP( JJN ), AP( JJ+1 ), 1 )
             JJ = JJN
 CONTINUE
       END IF
+*
+*
          DO 10 I = 1, NRHS
+*
 *           Solve U**H *X = B, overwriting B with X.
+*
-            CALL ZTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', N,
+            CALL ZTPSV( 'Upper', 'Conjugate transpose', 'Non-unit',
+     $                  N,
      $                  AP, B( 1, I ), 1 )
+*
 *           Solve U*X = B, overwriting B with X.
+*
             CALL ZTPSV( 'Upper', 'No transpose', 'Non-unit', N, AP,
             CALL ZTPSV( 'Lower', 'No transpose', 'Non-unit', N, AP,
      $                  B( 1, I ), 1 )
+*
 *           Solve L**H *X = Y, overwriting B with X.
+*
-            CALL ZTPSV( 'Lower', 'Conjugate transpose', 'Non-unit', N,
+            CALL ZTPSV( 'Lower', 'Conjugate transpose', 'Non-unit',
+     $                  N,
      $                  AP, B( 1, I ), 1 )
 CONTINUE
       END IF
+*
       RETURN
 *> \author NAG Ltd.
+*
 *> \ingroup pstf2
+*
 *  =====================================================================
-      SUBROUTINE ZPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
+      SUBROUTINE ZPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       DOUBLE PRECISION   DLAMCH
       LOGICAL            LSAME, DISNAN
       EXTERNAL           DLAMCH, LSAME, DISNAN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZDSCAL, ZGEMV, ZLACGV, ZSWAP, XERBLA
+      EXTERNAL           ZDSCAL, ZGEMV, ZLACGV, ZSWAP,
+     $                   XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCONJG, MAX, SQRT
 *     ..
 *     .. Executable Statements ..
+*
 *           Compute elements J+1:N of row J
+*
             IF( J.LT.N ) THEN
                CALL ZLACGV( J-1, A( 1, J ), 1 )
-               CALL ZGEMV( 'Trans', J-1, N-J, -CONE, A( 1, J+1 ), LDA,
+               CALL ZGEMV( 'Trans', J-1, N-J, -CONE, A( 1, J+1 ),
+     $                     LDA,
      $                     A( 1, J ), 1, CONE, A( J, J+1 ), LDA )
                CALL ZLACGV( J-1, A( 1, J ), 1 )
                CALL ZDSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
             END IF
+*
 *              Pivot OK, so can now swap pivot rows and columns
+*
                A( PVT, PVT ) = A( J, J )
                CALL ZSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA )
                IF( PVT.LT.N )
-     $            CALL ZSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, PVT ),
+     $            CALL ZSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1,
+     $                        PVT ),
      $                        1 )
                DO 170 I = J + 1, PVT - 1
                   ZTEMP = DCONJG( A( I, J ) )
                   A( I, J ) = DCONJG( A( PVT, I ) )
                   A( PVT, I ) = ZTEMP
 *> \author NAG Ltd.
+*
 *> \ingroup pstrf
+*
 *  =====================================================================
-      SUBROUTINE ZPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
+      SUBROUTINE ZPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       INTEGER            ILAENV
       LOGICAL            LSAME, DISNAN
       EXTERNAL           DLAMCH, ILAENV, LSAME, DISNAN
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           ZDSCAL, ZGEMV, ZHERK, ZLACGV, ZPSTF2, ZSWAP,
+      EXTERNAL           ZDSCAL, ZGEMV, ZHERK, ZLACGV, ZPSTF2,
+     $                   ZSWAP,
      $                   XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCONJG, MAX, MIN, SQRT, MAXLOC
 *     ..
+*
 *                 Compute elements J+1:N of row J.
+*
                   IF( J.LT.N ) THEN
                      CALL ZLACGV( J-1, A( 1, J ), 1 )
-                     CALL ZGEMV( 'Trans', J-K, N-J, -CONE, A( K, J+1 ),
+                     CALL ZGEMV( 'Trans', J-K, N-J, -CONE, A( K,
+     $                           J+1 ),
      $                           LDA, A( K, J ), 1, CONE, A( J, J+1 ),
      $                           LDA )
                      CALL ZLACGV( J-1, A( 1, J ), 1 )
                      CALL ZDSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
                   END IF
                   IF( J.NE.PVT ) THEN
+*
 *                    Pivot OK, so can now swap pivot rows and columns
+*
                      A( PVT, PVT ) = A( J, J )
-                     CALL ZSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA )
+                     CALL ZSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ),
+     $                           LDA )
                      IF( PVT.LT.N )
      $                  CALL ZSWAP( N-PVT, A( PVT+1, J ), 1,
      $                              A( PVT+1, PVT ), 1 )
                      DO 190 I = J + 1, PVT - 1
                         ZTEMP = DCONJG( A( I, J ) )
      $                  INCX )
             CALL ZDSCAL( N, SAFMAX, X, INCX )
          ELSE IF( (ABS( UR ).GT.SAFMAX).OR.(ABS( UI ).GT.SAFMAX) ) THEN
             IF( (ABSR.GT.OV).OR.(ABSI.GT.OV) ) THEN
 *              This means that a and b are both Inf. No need for scaling.
-               CALL ZSCAL( N, DCMPLX( ONE / UR, -ONE / UI ), X, INCX )
+               CALL ZSCAL( N, DCMPLX( ONE / UR, -ONE / UI ), X,
+     $                     INCX )
             ELSE
                CALL ZDSCAL( N, SAFMIN, X, INCX )
                IF( (ABS( UR ).GT.OV).OR.(ABS( UI ).GT.OV) ) THEN
 *                 Infs were generated. We do proper scaling to avoid them.
                   IF( ABSR.GE.ABSI ) THEN
 *> \author NAG Ltd.
+*
 *> \ingroup hpcon
+*
 *  =====================================================================
-      SUBROUTINE ZSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO )
+      SUBROUTINE ZSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       RETURN
+*
 *     End of ZSPCON
+*
       END
+*> \brief \b ZSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSPMV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zspmv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zspmv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zspmv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INCX, INCY, N
+*       COMPLEX*16         ALPHA, BETA
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16         AP( * ), X( * ), Y( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZSPMV  performs the matrix-vector operation
+*>
+*>    y := alpha*A*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are n element vectors and
+*> A is an n by n symmetric matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the matrix A is supplied in the packed
+*>           array AP as follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  supplied in AP.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  supplied in AP.
+*>
+*>           Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*>           Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX*16
+*>           On entry, ALPHA specifies the scalar alpha.
+*>           Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] AP
+*> \verbatim
+*>          AP is COMPLEX*16 array, dimension at least
+*>           ( ( N*( N + 1 ) )/2 ).
+*>           Before entry, with UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular part of the symmetric matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*>           and a( 2, 2 ) respectively, and so on.
+*>           Before entry, with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular part of the symmetric matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*>           and a( 3, 1 ) respectively, and so on.
+*>           Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX*16 array, dimension at least
+*>           ( 1 + ( N - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the N-
+*>           element vector x.
+*>           Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*>           Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX*16
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*>           Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is COMPLEX*16 array, dimension at least
+*>           ( 1 + ( N - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y. On exit, Y is overwritten by the updated
+*>           vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*>           Unchanged on exit.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup hpmv
+*
+*  =====================================================================
+      SUBROUTINE ZSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
+*
+*  -- LAPACK auxiliary routine --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INCX, INCY, N
+      COMPLEX*16         ALPHA, BETA
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         AP( * ), X( * ), Y( * )
+*     ..
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16         ONE
+      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
+      COMPLEX*16         ZERO
+      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
+      COMPLEX*16         TEMP1, TEMP2
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND.
+     $    .NOT.LSAME( UPLO, 'L' ) ) THEN
+         INFO = 1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = 2
+      ELSE IF( INCX.EQ.0 ) THEN
+         INFO = 6
+      ELSE IF( INCY.EQ.0 ) THEN
+         INFO = 9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZSPMV ', INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
+     $   RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF( INCX.GT.0 ) THEN
+         KX = 1
+      ELSE
+         KX = 1 - ( N-1 )*INCX
+      END IF
+      IF( INCY.GT.0 ) THEN
+         KY = 1
+      ELSE
+         KY = 1 - ( N-1 )*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+*     First form  y := beta*y.
+*
+      IF( BETA.NE.ONE ) THEN
+         IF( INCY.EQ.1 ) THEN
+            IF( BETA.EQ.ZERO ) THEN
+               DO 10 I = 1, N
+                  Y( I ) = ZERO
+CONTINUE
+            ELSE
+               DO 20 I = 1, N
+                  Y( I ) = BETA*Y( I )
+CONTINUE
+            END IF
+         ELSE
+            IY = KY
+            IF( BETA.EQ.ZERO ) THEN
+               DO 30 I = 1, N
+                  Y( IY ) = ZERO
+                  IY = IY + INCY
+CONTINUE
+            ELSE
+               DO 40 I = 1, N
+                  Y( IY ) = BETA*Y( IY )
+                  IY = IY + INCY
+CONTINUE
+            END IF
+         END IF
+      END IF
+      IF( ALPHA.EQ.ZERO )
+     $   RETURN
+      KK = 1
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        Form  y  when AP contains the upper triangle.
+*
+         IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
+            DO 60 J = 1, N
+               TEMP1 = ALPHA*X( J )
+               TEMP2 = ZERO
+               K = KK
+               DO 50 I = 1, J - 1
+                  Y( I ) = Y( I ) + TEMP1*AP( K )
+                  TEMP2 = TEMP2 + AP( K )*X( I )
+                  K = K + 1
+CONTINUE
+               Y( J ) = Y( J ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2
+               KK = KK + J
+CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 80 J = 1, N
+               TEMP1 = ALPHA*X( JX )
+               TEMP2 = ZERO
+               IX = KX
+               IY = KY
+               DO 70 K = KK, KK + J - 2
+                  Y( IY ) = Y( IY ) + TEMP1*AP( K )
+                  TEMP2 = TEMP2 + AP( K )*X( IX )
+                  IX = IX + INCX
+                  IY = IY + INCY
+CONTINUE
+               Y( JY ) = Y( JY ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2
+               JX = JX + INCX
+               JY = JY + INCY
+               KK = KK + J
+CONTINUE
+         END IF
+      ELSE
+*
+*        Form  y  when AP contains the lower triangle.
+*
+         IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
+            DO 100 J = 1, N
+               TEMP1 = ALPHA*X( J )
+               TEMP2 = ZERO
+               Y( J ) = Y( J ) + TEMP1*AP( KK )
+               K = KK + 1
+               DO 90 I = J + 1, N
+                  Y( I ) = Y( I ) + TEMP1*AP( K )
+                  TEMP2 = TEMP2 + AP( K )*X( I )
+                  K = K + 1
+CONTINUE
+               Y( J ) = Y( J ) + ALPHA*TEMP2
+               KK = KK + ( N-J+1 )
+CONTINUE
+         ELSE
+            JX = KX
+            JY = KY
+            DO 120 J = 1, N
+               TEMP1 = ALPHA*X( JX )
+               TEMP2 = ZERO
+               Y( JY ) = Y( JY ) + TEMP1*AP( KK )
+               IX = JX
+               IY = JY
+               DO 110 K = KK + 1, KK + N - J
+                  IX = IX + INCX
+                  IY = IY + INCY
+                  Y( IY ) = Y( IY ) + TEMP1*AP( K )
+                  TEMP2 = TEMP2 + AP( K )*X( IX )
+CONTINUE
+               Y( JY ) = Y( JY ) + ALPHA*TEMP2
+               JX = JX + INCX
+               JY = JY + INCY
+               KK = KK + ( N-J+1 )
+CONTINUE
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of ZSPMV
+*
+      END
 *> \brief \b ZSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix.
+*
 *  =========== DOCUMENTATION ===========
+*
 * Online html documentation available at
 *     .. Executable Statements ..
+*
 *     Test the input parameters.
+*
       INFO = 0
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND.
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+     $    .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = 1
       ELSE IF( N.LT.0 ) THEN
          INFO = 2
       ELSE IF( INCX.EQ.0 ) THEN
          INFO = 5
+*
 *              Interchange rows and columns KK and KP in the trailing
 *              submatrix A(k:n,k:n)
+*
                IF( KP.LT.N )
-     $            CALL ZSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ),
+     $            CALL ZSWAP( N-KP, AP( KNC+KP-KK+1 ), 1,
+     $                        AP( KPC+1 ),
      $                        1 )
                KX = KNC + KP - KK
                DO 80 J = KK + 1, KP - 1
                   KX = KX + N - J + 1
                   T = AP( KNC+J-KK )
+*
 *           Compute column K of the inverse.
+*
             IF( K.GT.1 ) THEN
                CALL ZCOPY( K-1, AP( KC ), 1, WORK, 1 )
-               CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ),
+               CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO,
+     $                     AP( KC ),
      $                     1 )
                AP( KC+K-1 ) = AP( KC+K-1 ) -
      $                        ZDOTU( K-1, WORK, 1, AP( KC ), 1 )
             END IF
             KSTEP = 1
+*
 *           Compute columns K and K+1 of the inverse.
+*
             IF( K.GT.1 ) THEN
                CALL ZCOPY( K-1, AP( KC ), 1, WORK, 1 )
-               CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ),
+               CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO,
+     $                     AP( KC ),
      $                     1 )
                AP( KC+K-1 ) = AP( KC+K-1 ) -
      $                        ZDOTU( K-1, WORK, 1, AP( KC ), 1 )
                AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) -
-     $                            ZDOTU( K-1, AP( KC ), 1, AP( KCNEXT ),
+     $                            ZDOTU( K-1, AP( KC ), 1,
+     $                                   AP( KCNEXT ),
      $                            1 )
                CALL ZCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 )
                CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO,
      $                     AP( KCNEXT ), 1 )
                AP( KCNEXT+K ) = AP( KCNEXT+K ) -
-     $                          ZDOTU( K-1, WORK, 1, AP( KCNEXT ), 1 )
+     $                          ZDOTU( K-1, WORK, 1, AP( KCNEXT ),
+     $                                 1 )
             END IF
             KSTEP = 2
             KCNEXT = KCNEXT + K + 1
          END IF
+*
+*
 *           Compute columns K-1 and K of the inverse.
+*
             IF( K.LT.N ) THEN
                CALL ZCOPY( N-K, AP( KC+1 ), 1, WORK, 1 )
-               CALL ZSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1,
+               CALL ZSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK,
+     $                     1,
      $                     ZERO, AP( KC+1 ), 1 )
                AP( KC ) = AP( KC ) - ZDOTU( N-K, WORK, 1, AP( KC+1 ),
      $                    1 )
                AP( KCNEXT+1 ) = AP( KCNEXT+1 ) -
      $                          ZDOTU( N-K, AP( KC+1 ), 1,
      $                          AP( KCNEXT+2 ), 1 )
                CALL ZCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 )
-               CALL ZSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1,
+               CALL ZSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK,
+     $                     1,
      $                     ZERO, AP( KCNEXT+2 ), 1 )
                AP( KCNEXT ) = AP( KCNEXT ) -
-     $                        ZDOTU( N-K, WORK, 1, AP( KCNEXT+2 ), 1 )
+     $                        ZDOTU( N-K, WORK, 1, AP( KCNEXT+2 ),
+     $                               1 )
             END IF
             KSTEP = 2
             KCNEXT = KCNEXT - ( N-K+3 )
          END IF
+*
 *           1 x 1 diagonal block
+*
 *           Multiply by inv(U**T(K)), where U(K) is the transformation
 *           stored in column K of A.
+*
-            CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ),
+            CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
+     $                  AP( KC ),
      $                  1, ONE, B( K, 1 ), LDB )
+*
 *           Interchange rows K and IPIV(K).
+*
             KP = IPIV( K )
 *           2 x 2 diagonal block
+*
 *           Multiply by inv(U**T(K+1)), where U(K+1) is the transformation
 *           stored in columns K and K+1 of A.
+*
-            CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ),
+            CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
+     $                  AP( KC ),
      $                  1, ONE, B( K, 1 ), LDB )
             CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
      $                  AP( KC+K ), 1, ONE, B( K+1, 1 ), LDB )
+*
 *           Interchange rows K and -IPIV(K).
+*
 *           Multiply by inv(L(K)), where L(K) is the transformation
 *           stored in columns K and K+1 of A.
+*
             IF( K.LT.N-1 ) THEN
-               CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ),
+               CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K,
+     $                     1 ),
      $                     LDB, B( K+2, 1 ), LDB )
                CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1,
      $                     B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
             END IF
+*
       INTEGER            ILAENV
       DOUBLE PRECISION   DLAMCH, DLANST
       EXTERNAL           LSAME, ILAENV, DLAMCH, DLANST
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF, XERBLA,
+      EXTERNAL           DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF,
+     $                   XERBLA,
      $                   ZLACPY, ZLACRM, ZLAED0, ZSTEQR, ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, INT, LOG, MAX, MOD, SQRT
 *     ..
             LWMIN = 1
             LRWMIN = 1 + 4*N + 2*N**2
             LIWMIN = 3 + 5*N
          END IF
          WORK( 1 ) = LWMIN
-         RWORK( 1 ) = LRWMIN
+         RWORK( 1 ) = REAL( LRWMIN )
          IWORK( 1 ) = LIWMIN
+*
          IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
             INFO = -8
          ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
             IF( M.GT.SMLSIZ ) THEN
+*
 *              Scale.
+*
                ORGNRM = DLANST( 'M', M, D( START ), E( START ) )
-               CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M,
+               CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ),
+     $                      M,
      $                      INFO )
-               CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ),
+               CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1,
+     $                      E( START ),
      $                      M-1, INFO )
+*
-               CALL ZLAED0( N, M, D( START ), E( START ), Z( 1, START ),
+               CALL ZLAED0( N, M, D( START ), E( START ), Z( 1,
+     $                      START ),
      $                      LDZ, WORK, N, RWORK, IWORK, INFO )
                IF( INFO.GT.0 ) THEN
                   INFO = ( INFO / ( M+1 )+START-1 )*( N+1 ) +
      $                   MOD( INFO, ( M+1 ) ) + START - 1
                   GO TO 70
                END IF
+*
 *              Scale back.
+*
-               CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M,
+               CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ),
+     $                      M,
      $                      INFO )
+*
             ELSE
                CALL DSTEQR( 'I', M, D( START ), E( START ), RWORK, M,
      $                      RWORK( M*M+1 ), INFO )
-               CALL ZLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, N,
+               CALL ZLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK,
+     $                      N,
      $                      RWORK( M*M+1 ) )
                CALL ZLACPY( 'A', N, M, WORK, N, Z( 1, START ), LDZ )
                IF( INFO.GT.0 ) THEN
                   INFO = START*( N+1 ) + FINISH
                   GO TO 70
 CONTINUE
       END IF
+*
 CONTINUE
       WORK( 1 ) = LWMIN
-      RWORK( 1 ) = LRWMIN
+      RWORK( 1 ) = REAL( LRWMIN )
       IWORK( 1 ) = LIWMIN
+*
       RETURN
+*
 *     End of ZSTEDC
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH, DLANST, DLAPY2
       EXTERNAL           LSAME, DLAMCH, DLANST, DLAPY2
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLAE2, DLAEV2, DLARTG, DLASCL, DLASRT, XERBLA,
+      EXTERNAL           DLAE2, DLAEV2, DLARTG, DLASCL, DLASRT,
+     $                   XERBLA,
      $                   ZLASET, ZLASR, ZSWAP
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, MAX, SIGN, SQRT
 *     ..
       ISCALE = 0
       IF( ANORM.EQ.ZERO )
      $   GO TO 10
       IF( ANORM.GT.SSFMAX ) THEN
          ISCALE = 1
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N,
+         CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ),
+     $                N,
      $                INFO )
          CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N,
      $                INFO )
       ELSE IF( ANORM.LT.SSFMIN ) THEN
          ISCALE = 2
-         CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N,
+         CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ),
+     $                N,
      $                INFO )
          CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N,
      $                INFO )
       END IF
+*
 *        If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
 *        to compute its eigensystem.
+*
          IF( M.EQ.L+1 ) THEN
             IF( ICOMPZ.GT.0 ) THEN
-               CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S )
+               CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C,
+     $                      S )
                WORK( L ) = C
                WORK( N-1+L ) = S
                CALL ZLASR( 'R', 'V', 'B', N, 2, WORK( L ),
      $                     WORK( N-1+L ), Z( 1, L ), LDZ )
             ELSE
+*
 *        If eigenvectors are desired, then apply saved rotations.
+*
          IF( ICOMPZ.GT.0 ) THEN
             MM = M - L + 1
-            CALL ZLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ),
+            CALL ZLASR( 'R', 'V', 'B', N, MM, WORK( L ),
+     $                  WORK( N-1+L ),
      $                  Z( 1, L ), LDZ )
          END IF
+*
          D( L ) = D( L ) - P
          E( L ) = G
 *        If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
 *        to compute its eigensystem.
+*
          IF( M.EQ.L-1 ) THEN
             IF( ICOMPZ.GT.0 ) THEN
-               CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S )
+               CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C,
+     $                      S )
                WORK( M ) = C
                WORK( N-1+M ) = S
                CALL ZLASR( 'R', 'V', 'F', N, 2, WORK( M ),
      $                     WORK( N-1+M ), Z( 1, L-1 ), LDZ )
             ELSE
+*
 *        If eigenvectors are desired, then apply saved rotations.
+*
          IF( ICOMPZ.GT.0 ) THEN
             MM = L - M + 1
-            CALL ZLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ),
+            CALL ZLASR( 'R', 'V', 'F', N, MM, WORK( M ),
+     $                  WORK( N-1+M ),
      $                  Z( 1, M ), LDZ )
          END IF
+*
          D( L ) = D( L ) - P
          E( LM1 ) = G
+*
 CONTINUE
       IF( ISCALE.EQ.1 ) THEN
          CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1,
      $                D( LSV ), N, INFO )
-         CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ),
+         CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1,
+     $                E( LSV ),
      $                N, INFO )
       ELSE IF( ISCALE.EQ.2 ) THEN
          CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1,
      $                D( LSV ), N, INFO )
-         CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ),
+         CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1,
+     $                E( LSV ),
      $                N, INFO )
       END IF
+*
 *     Check for no convergence to an eigenvalue after a total
 *     of N*MAXIT iterations.
 *> \author NAG Ltd.
+*
 *> \ingroup hemv
+*
 *  =====================================================================
-      SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY )
+      SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
+     $                  INCY )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
 *     .. Executable Statements ..
+*
 *     Test the input parameters.
+*
       INFO = 0
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND.
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+     $    .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = 1
       ELSE IF( N.LT.0 ) THEN
          INFO = 2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = 5
 *     .. Executable Statements ..
+*
 *     Test the input parameters.
+*
       INFO = 0
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND.
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+     $    .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = 1
       ELSE IF( N.LT.0 ) THEN
          INFO = 2
       ELSE IF( INCX.EQ.0 ) THEN
          INFO = 5
 *              element in row IMAX, and ROWMAX is its absolute value
+*
                JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA )
                ROWMAX = CABS1( A( IMAX, JMAX ) )
                IF( IMAX.LT.N ) THEN
-                  JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 )
+                  JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ),
+     $                                  1 )
                   ROWMAX = MAX( ROWMAX, CABS1( A( JMAX, IMAX ) ) )
                END IF
+*
                IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
+*
+*
 *              Interchange rows and columns KK and KP in the trailing
 *              submatrix A(k:n,k:n)
+*
                IF( KP.LT.N )
-     $            CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
+     $            CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ),
+     $                        1 )
                CALL ZSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
      $                     LDA )
                T = A( KK, KK )
                A( KK, KK ) = A( KP, KP )
                A( KP, KP ) = T
       LDWORK = N
       IF( NB.GT.1 .AND. NB.LT.N ) THEN
          IWS = LDWORK*NB
          IF( LWORK.LT.IWS ) THEN
             NB = MAX( LWORK / LDWORK, 1 )
-            NBMIN = MAX( 2, ILAENV( 2, 'ZSYTRF', UPLO, N, -1, -1, -1 ) )
+            NBMIN = MAX( 2, ILAENV( 2, 'ZSYTRF', UPLO, N, -1, -1,
+     $                   -1 ) )
          END IF
       ELSE
          IWS = 1
       END IF
       IF( NB.LT.NBMIN )
          IF( K.GT.NB ) THEN
+*
 *           Factorize columns k-kb+1:k of A and use blocked code to
 *           update columns 1:k-kb
+*
-            CALL ZLASYF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, IINFO )
+            CALL ZLASYF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N,
+     $                   IINFO )
          ELSE
+*
 *           Use unblocked code to factorize columns 1:k of A
+*
             CALL ZSYTF2( UPLO, K, A, LDA, IPIV, IINFO )
          IF( K.LE.N-NB ) THEN
+*
 *           Factorize columns k:k+kb-1 of A and use blocked code to
 *           update columns k+kb:n
+*
-            CALL ZLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ),
+            CALL ZLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA,
+     $                   IPIV( K ),
      $                   WORK, N, IINFO )
          ELSE
+*
 *           Use unblocked code to factorize columns k:n of A
+*
-            CALL ZSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO )
+            CALL ZSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ),
+     $                   IINFO )
             KB = N - K + 1
          END IF
+*
 *        Set INFO on the first occurrence of a zero pivot
+*
+*
             IF( K.GT.1 ) THEN
                CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 )
                CALL ZSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
      $                     A( 1, K ), 1 )
-               A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, K ),
+               A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1,
+     $            K ),
      $                     1 )
             END IF
             KSTEP = 1
          ELSE
+*
+*
             IF( K.GT.1 ) THEN
                CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 )
                CALL ZSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
      $                     A( 1, K ), 1 )
-               A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, K ),
+               A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1,
+     $            K ),
      $                     1 )
                A( K, K+1 ) = A( K, K+1 ) -
-     $                       ZDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 )
+     $                       ZDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ),
+     $                              1 )
                CALL ZCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 )
                CALL ZSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO,
      $                     A( 1, K+1 ), 1 )
                A( K+1, K+1 ) = A( K+1, K+1 ) -
      $                         ZDOTU( K-1, WORK, 1, A( 1, K+1 ), 1 )
+*
 *           Compute column K of the inverse.
+*
             IF( K.LT.N ) THEN
                CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
-               CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
+               CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK,
+     $                     1,
      $                     ZERO, A( K+1, K ), 1 )
-               A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, K ),
+               A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1,
+     $            K ),
      $                     1 )
             END IF
             KSTEP = 1
          ELSE
+*
+*
 *           Compute columns K-1 and K of the inverse.
+*
             IF( K.LT.N ) THEN
                CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 )
-               CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
+               CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK,
+     $                     1,
      $                     ZERO, A( K+1, K ), 1 )
-               A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, K ),
+               A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1,
+     $            K ),
      $                     1 )
                A( K, K-1 ) = A( K, K-1 ) -
-     $                       ZDOTU( N-K, A( K+1, K ), 1, A( K+1, K-1 ),
+     $                       ZDOTU( N-K, A( K+1, K ), 1, A( K+1,
+     $                              K-1 ),
      $                       1 )
                CALL ZCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 )
-               CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1,
+               CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK,
+     $                     1,
      $                     ZERO, A( K+1, K-1 ), 1 )
                A( K-1, K-1 ) = A( K-1, K-1 ) -
-     $                         ZDOTU( N-K, WORK, 1, A( K+1, K-1 ), 1 )
+     $                         ZDOTU( N-K, WORK, 1, A( K+1, K-1 ),
+     $                                1 )
             END IF
             KSTEP = 2
          END IF
+*
          KP = ABS( IPIV( K ) )
      $         CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
+*
 *           Multiply by inv(U(K)), where U(K) is the transformation
 *           stored in column K of A.
+*
-            CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
+            CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ),
+     $                  LDB,
      $                  B( 1, 1 ), LDB )
+*
 *           Multiply by the inverse of the diagonal block.
+*
             CALL ZSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
      $         CALL ZSWAP( NRHS, B( K-1, 1 ), LDB, B( KP, 1 ), LDB )
+*
 *           Multiply by inv(U(K)), where U(K) is the transformation
 *           stored in columns K-1 and K of A.
+*
-            CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB,
+            CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ),
+     $                  LDB,
      $                  B( 1, 1 ), LDB )
             CALL ZGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ),
      $                  LDB, B( 1, 1 ), LDB )
+*
 *           Multiply by the inverse of the diagonal block.
 *           1 x 1 diagonal block
+*
 *           Multiply by inv(U**T(K)), where U(K) is the transformation
 *           stored in column K of A.
+*
-            CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
+            CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1,
+     $                  K ),
      $                  1, ONE, B( K, 1 ), LDB )
+*
 *           Interchange rows K and IPIV(K).
+*
             KP = IPIV( K )
 *           2 x 2 diagonal block
+*
 *           Multiply by inv(U**T(K+1)), where U(K+1) is the transformation
 *           stored in columns K and K+1 of A.
+*
-            CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ),
+            CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1,
+     $                  K ),
      $                  1, ONE, B( K, 1 ), LDB )
             CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB,
      $                  A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB )
+*
 *           Interchange rows K and -IPIV(K).
+*
 *           Multiply by inv(L(K)), where L(K) is the transformation
 *           stored in column K of A.
+*
             IF( K.LT.N )
-     $         CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ),
+     $         CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K,
+     $                     1 ),
      $                     LDB, B( K+1, 1 ), LDB )
+*
 *           Multiply by the inverse of the diagonal block.
+*
             CALL ZSCAL( NRHS, ONE / A( K, K ), B( K, 1 ), LDB )
+*
 *           Multiply by inv(L(K)), where L(K) is the transformation
 *           stored in columns K and K+1 of A.
+*
             IF( K.LT.N-1 ) THEN
-               CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ),
+               CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K,
+     $                     1 ),
      $                     LDB, B( K+2, 1 ), LDB )
                CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1,
      $                     B( K+1, 1 ), LDB, B( K+2, 1 ), LDB )
             END IF
+*
 CONTINUE
+*
 *              Back transform eigenvector if HOWMNY='B'.
+*
                IF( ILBACK ) THEN
-                  CALL ZGEMV( 'N', N, N+1-JE, CONE, VL( 1, JE ), LDVL,
+                  CALL ZGEMV( 'N', N, N+1-JE, CONE, VL( 1, JE ),
+     $                        LDVL,
      $                        WORK( JE ), 1, CZERO, WORK( N+1 ), 1 )
                   ISRC = 2
                   IBEG = 1
                ELSE
                   ISRC = 1
 *           F-norm((B-QL**H*T*QR)) <= O(EPS*F-norm((B)))
+*
          CALL ZLACPY( 'Full', M, M, S, LDST, WORK, M )
          CALL ZLACPY( 'Full', M, M, T, LDST, WORK( M*M+1 ), M )
          CALL ZROT( 2, WORK, 1, WORK( 3 ), 1, CZ, -DCONJG( SZ ) )
-         CALL ZROT( 2, WORK( 5 ), 1, WORK( 7 ), 1, CZ, -DCONJG( SZ ) )
+         CALL ZROT( 2, WORK( 5 ), 1, WORK( 7 ), 1, CZ,
+     $              -DCONJG( SZ ) )
          CALL ZROT( 2, WORK, 2, WORK( 2 ), 2, CQ, -SQ )
          CALL ZROT( 2, WORK( 5 ), 2, WORK( 6 ), 2, CQ, -SQ )
          DO 10 I = 1, 2
             WORK( I ) = WORK( I ) - A( J1+I-1, J1 )
             WORK( I+2 ) = WORK( I+2 ) - A( J1+I-1, J1+1 )
+*
       CALL ZROT( J1+1, A( 1, J1 ), 1, A( 1, J1+1 ), 1, CZ,
      $           DCONJG( SZ ) )
       CALL ZROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, CZ,
      $           DCONJG( SZ ) )
-      CALL ZROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA, CQ, SQ )
+      CALL ZROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA, CQ,
+     $           SQ )
-      CALL ZROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB, CQ, SQ )
+      CALL ZROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB, CQ,
+     $           SQ )
+*
 *     Set  N1 by N2 (2,1) blocks to 0
+*
       A( J1+1, J1 ) = CZERO
       B( J1+1, J1 ) = CZERO
+*
 CONTINUE
+*
 *        Swap with next one below
+*
-         CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
+         CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+     $                LDZ,
      $                HERE, INFO )
          IF( INFO.NE.0 ) THEN
             ILST = HERE
             RETURN
          END IF
+*
 CONTINUE
+*
 *        Swap with next one above
+*
-         CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
+         CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+     $                LDZ,
      $                HERE, INFO )
          IF( INFO.NE.0 ) THEN
             ILST = HERE
             RETURN
          END IF
 *>      Sweden, December 1993, Revised April 1994, Also as LAPACK working
 *>      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
 *>      1996.
 *>
 *  =====================================================================
-      SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
+      SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B,
+     $                   LDB,
      $                   ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF,
      $                   WORK, LWORK, IWORK, LIWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     ..
 *     .. Local Arrays ..
       INTEGER            ISAVE( 3 )
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACN2, ZLACPY, ZLASSQ, ZSCAL, ZTGEXC,
+      EXTERNAL           XERBLA, ZLACN2, ZLACPY, ZLASSQ, ZSCAL,
+     $                   ZTGEXC,
      $                   ZTGSYL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DCMPLX, DCONJG, MAX, SQRT
 *     ..
+*
 *           Swap the K-th block to position KS. Compute unitary Q
 *           and Z that will swap adjacent diagonal blocks in (A, B).
+*
             IF( K.NE.KS )
-     $         CALL ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+     $         CALL ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
+     $                      Z,
      $                      LDZ, K, KS, IERR )
+*
             IF( IERR.GT.0 ) THEN
+*
 *              Swap is rejected: exit.
+*
          N1 = M
          N2 = N - M
          I = N1 + 1
          CALL ZLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 )
-         CALL ZLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ),
+         CALL ZLACPY( 'Full', N1, N2, B( 1, I ), LDB,
+     $                WORK( N1*N2+1 ),
      $                N1 )
          IJB = 0
          CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
      $                N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1,
      $                DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
             I = N1 + 1
             IJB = IDIFJB
+*
 *           Frobenius norm-based Difu estimate.
+*
-            CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
+            CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA,
+     $                   WORK,
      $                   N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ),
      $                   N1, DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
      $                   LWORK-2*N1*N2, IWORK, IERR )
+*
 *           Frobenius norm-based Difl estimate.
+*
-            CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK,
+            CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA,
+     $                   WORK,
      $                   N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ),
      $                   N2, DSCALE, DIF( 2 ), WORK( N1*N2*2+1 ),
      $                   LWORK-2*N1*N2, IWORK, IERR )
          ELSE
+*
             IF( KASE.NE.0 ) THEN
                IF( KASE.EQ.1 ) THEN
+*
 *                 Solve generalized Sylvester equation
+*
-                  CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA,
+                  CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ),
+     $                         LDA,
      $                         WORK, N1, B, LDB, B( I, I ), LDB,
      $                         WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
      $                         WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,
      $                         IERR )
                ELSE
+*
 *                 Solve the transposed variant.
+*
-                  CALL ZTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), LDA,
+                  CALL ZTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ),
+     $                         LDA,
      $                         WORK, N1, B, LDB, B( I, I ), LDB,
      $                         WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
      $                         WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,
      $                         IERR )
                END IF
             IF( KASE.NE.0 ) THEN
                IF( KASE.EQ.1 ) THEN
+*
 *                 Solve generalized Sylvester equation
+*
-                  CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA,
+                  CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A,
+     $                         LDA,
      $                         WORK, N2, B( I, I ), LDB, B, LDB,
      $                         WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
      $                         WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,
      $                         IERR )
                ELSE
+*
 *                 Solve the transposed variant.
+*
-                  CALL ZTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, LDA,
+                  CALL ZTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A,
+     $                         LDA,
      $                         WORK, N2, B, LDB, B( I, I ), LDB,
      $                         WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
      $                         WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,
      $                         IERR )
                END IF
 *>
 *>     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
 *>     Umea University, S-901 87 Umea, Sweden.
+*
 *  =====================================================================
-      SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
+      SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC,
+     $                   D,
      $                   LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
      $                   INFO )
+*
 *  -- LAPACK auxiliary routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZAXPY, ZGESC2, ZGETC2, ZLATDF, ZSCAL
+      EXTERNAL           XERBLA, ZAXPY, ZGESC2, ZGETC2, ZLATDF,
+     $                   ZSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCMPLX, DCONJG, MAX
 *     ..
 *     .. Executable Statements ..
+*
 *              Substitute R(I, J) and L(I, J) into remaining equation.
+*
                IF( I.GT.1 ) THEN
                   ALPHA = -RHS( 1 )
-                  CALL ZAXPY( I-1, ALPHA, A( 1, I ), 1, C( 1, J ), 1 )
+                  CALL ZAXPY( I-1, ALPHA, A( 1, I ), 1, C( 1, J ),
+     $                        1 )
-                  CALL ZAXPY( I-1, ALPHA, D( 1, I ), 1, F( 1, J ), 1 )
+                  CALL ZAXPY( I-1, ALPHA, D( 1, I ), 1, F( 1, J ),
+     $                        1 )
                END IF
                IF( J.LT.N ) THEN
                   CALL ZAXPY( N-J, RHS( 2 ), B( J, J+1 ), LDB,
      $                        C( I, J+1 ), LDC )
                   CALL ZAXPY( N-J, RHS( 2 ), E( J, J+1 ), LDE,
                IF( IERR.GT.0 )
      $            INFO = IERR
                CALL ZGESC2( LDZ, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
                IF( SCALOC.NE.ONE ) THEN
                   DO 40 K = 1, N
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ),
+                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1,
+     $                           K ),
      $                           1 )
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ),
+                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1,
+     $                           K ),
      $                           1 )
 CONTINUE
                   SCALE = SCALE*SCALOC
                END IF
+*
 *>      Condition Estimators for Solving the Generalized Sylvester
 *>      Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
 *>      July 1989, pp 745-751.
 *>
 *  =====================================================================
-      SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
+      SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC,
+     $                   D,
      $                   LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
      $                   IWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
       LOGICAL            LSAME
       INTEGER            ILAENV
       EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZGEMM, ZLACPY, ZLASET, ZSCAL, ZTGSY2
+      EXTERNAL           XERBLA, ZGEMM, ZLACPY, ZLASET, ZSCAL,
+     $                   ZTGSY2
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DBLE, DCMPLX, MAX, SQRT
 *     ..
 *     .. Executable Statements ..
+*
             SCALE = ONE
             DSCALE = ZERO
             DSUM = ONE
             PQ = M*N
-            CALL ZTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D,
+            CALL ZTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC,
+     $                   D,
      $                   LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE,
      $                   INFO )
             IF( DSCALE.NE.ZERO ) THEN
                IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
                   DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
                NB = JE - JS + 1
                DO 120 I = P, 1, -1
                   IS = IWORK( I )
                   IE = IWORK( I+1 ) - 1
                   MB = IE - IS + 1
-                  CALL ZTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
+                  CALL ZTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ),
+     $                         LDA,
      $                         B( JS, JS ), LDB, C( IS, JS ), LDC,
      $                         D( IS, IS ), LDD, E( JS, JS ), LDE,
      $                         F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
      $                         LINFO )
                   IF( LINFO.GT.0 )
      $                      LINFO )
                IF( LINFO.GT.0 )
      $            INFO = LINFO
                IF( SCALOC.NE.ONE ) THEN
                   DO 160 K = 1, JS - 1
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ),
+                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1,
+     $                           K ),
      $                           1 )
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ),
+                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1,
+     $                           K ),
      $                           1 )
 CONTINUE
                   DO 170 K = JS, JE
                      CALL ZSCAL( IS-1, DCMPLX( SCALOC, ZERO ),
      $                           C( 1, K ), 1 )
      $                           C( IE+1, K ), 1 )
                      CALL ZSCAL( M-IE, DCMPLX( SCALOC, ZERO ),
      $                           F( IE+1, K ), 1 )
 CONTINUE
                   DO 190 K = JE + 1, N
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ),
+                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1,
+     $                           K ),
      $                           1 )
-                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ),
+                     CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1,
+     $                           K ),
      $                           1 )
 CONTINUE
                   SCALE = SCALE*SCALOC
                END IF
+*
          IF( KASE.NE.0 ) THEN
             IF( KASE.EQ.KASE1 ) THEN
+*
 *              Multiply by inv(A).
+*
-               CALL ZLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, AP,
+               CALL ZLATPS( UPLO, 'No transpose', DIAG, NORMIN, N,
+     $                      AP,
      $                      WORK, SCALE, RWORK, INFO )
             ELSE
+*
 *              Multiply by inv(A**H).
+*
-               CALL ZLATPS( UPLO, 'Conjugate transpose', DIAG, NORMIN,
+               CALL ZLATPS( UPLO, 'Conjugate transpose', DIAG,
+     $                      NORMIN,
      $                      N, AP, WORK, SCALE, RWORK, INFO )
             END IF
             NORMIN = 'Y'
+*
 *           Multiply by 1/SCALE if doing so will not cause overflow.
 *>
 *> ZTPTRS solves a triangular system of the form
 *>
 *>    A * X = B,  A**T * X = B,  or  A**H * X = B,
 *>
-*> where A is a triangular matrix of order N stored in packed format,
+*> where A is a triangular matrix of order N stored in packed format, and B is an N-by-NRHS matrix.
+*>
+*> This subroutine verifies that A is nonsingular, but callers should note that only exact
+*> singularity is detected. It is conceivable for one or more diagonal elements of A to be
-*> and B is an N-by-NRHS matrix.  A check is made to verify that A is
+*> subnormally tiny numbers without this subroutine signalling an error.
-*> nonsingular.
+*>
+*> If a possible loss of numerical precision due to near-singular matrices is a concern, the
+*> caller should verify that A is nonsingular within some tolerance before calling this subroutine.
 *> \endverbatim
+*
 *  Arguments:
 *  ==========
+*
 *> \param[out] INFO
 *> \verbatim
 *>          INFO is INTEGER
 *>          = 0:  successful exit
 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
-*>          > 0:  if INFO = i, the i-th diagonal element of A is zero,
+*>          > 0:  if INFO = i, the i-th diagonal element of A is exactly zero,
 *>                indicating that the matrix is singular and the
 *>                solutions X have not been computed.
 *> \endverbatim
+*
 *  Authors:
 *> \author NAG Ltd.
+*
 *> \ingroup tptrs
+*
 *  =====================================================================
-      SUBROUTINE ZTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
+      SUBROUTINE ZTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
       UPPER = LSAME( UPLO, 'U' )
       NOUNIT = LSAME( DIAG, 'N' )
       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
       ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
+     $         LSAME( TRANS, 'T' ) .AND.
-     $         LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
+     $                .NOT.LSAME( TRANS, 'C' ) ) THEN
          INFO = -2
       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
          INFO = -3
       ELSE IF( N.LT.0 ) THEN
          INFO = -4
      $                      LDA, WORK, SCALE, RWORK, INFO )
             ELSE
+*
 *              Multiply by inv(A**H).
+*
-               CALL ZLATRS( UPLO, 'Conjugate transpose', DIAG, NORMIN,
+               CALL ZLATRS( UPLO, 'Conjugate transpose', DIAG,
+     $                      NORMIN,
      $                      N, A, LDA, WORK, SCALE, RWORK, INFO )
             END IF
             NORMIN = 'Y'
+*
 *           Multiply by 1/SCALE if doing so will not cause overflow.
 *>  magnitude has magnitude 1; here the magnitude of a complex number
 *>  (x,y) is taken to be |x| + |y|.
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
+      SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL,
+     $                   VR,
      $                   LDVR, MM, M, WORK, RWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
       INTEGER            IZAMAX
       DOUBLE PRECISION   DLAMCH, DZASUM
       EXTERNAL           LSAME, IZAMAX, DLAMCH, DZASUM
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS
+      EXTERNAL           XERBLA, ZCOPY, ZDSCAL, ZGEMV,
+     $                   ZLATRS
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX
 *     ..
 *     .. Statement Functions ..
                DO 60 K = KI + 1, N
                   VR( K, IS ) = CMZERO
 CONTINUE
             ELSE
                IF( KI.GT.1 )
-     $            CALL ZGEMV( 'N', N, KI-1, CMONE, VR, LDVR, WORK( 1 ),
+     $            CALL ZGEMV( 'N', N, KI-1, CMONE, VR, LDVR,
+     $                        WORK( 1 ),
      $                        1, DCMPLX( SCALE ), VR( 1, KI ), 1 )
+*
                II = IZAMAX( N, VR( 1, KI ), 1 )
                REMAX = ONE / CABS1( VR( II, KI ) )
                CALL ZDSCAL( N, REMAX, VR( 1, KI ), 1 )
                IF( CABS1( T( K, K ) ).LT.SMIN )
      $            T( K, K ) = SMIN
 CONTINUE
+*
             IF( KI.LT.N ) THEN
-               CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit',
+               CALL ZLATRS( 'Upper', 'Conjugate transpose',
+     $                      'Non-unit',
      $                      'Y', N-KI, T( KI+1, KI+1 ), LDT,
      $                      WORK( KI+1 ), SCALE, RWORK, INFO )
                WORK( KI ) = SCALE
             END IF
+*
                DO 110 K = 1, KI - 1
                   VL( K, IS ) = CMZERO
 CONTINUE
             ELSE
                IF( KI.LT.N )
-     $            CALL ZGEMV( 'N', N, N-KI, CMONE, VL( 1, KI+1 ), LDVL,
+     $            CALL ZGEMV( 'N', N, N-KI, CMONE, VL( 1, KI+1 ),
+     $                        LDVL,
      $                        WORK( KI+1 ), 1, DCMPLX( SCALE ),
      $                        VL( 1, KI ), 1 )
+*
                II = IZAMAX( N, VL( 1, KI ), 1 )
                REMAX = ONE / CABS1( VL( II, KI ) )
 *>  magnitude has magnitude 1; here the magnitude of a complex number
 *>  (x,y) is taken to be |x| + |y|.
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
+      SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL,
+     $                    VR,
      $                    LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
       IMPLICIT NONE
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            ILAENV, IZAMAX
       DOUBLE PRECISION   DLAMCH, DZASUM
-      EXTERNAL           LSAME, ILAENV, IZAMAX, DLAMCH, DZASUM
+      EXTERNAL           LSAME, ILAENV, IZAMAX, DLAMCH,
+     $                   DZASUM
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS,
+      EXTERNAL           XERBLA, ZCOPY, ZDSCAL, ZGEMV,
+     $                   ZLATRS,
      $                   ZGEMM, ZLASET, ZLACPY
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DCMPLX, CONJG, DIMAG, MAX
 *     ..
                IF( CABS1( T( K, K ) ).LT.SMIN )
      $            T( K, K ) = SMIN
 CONTINUE
+*
             IF( KI.LT.N ) THEN
-               CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit',
+               CALL ZLATRS( 'Upper', 'Conjugate transpose',
+     $                      'Non-unit',
      $                      'Y', N-KI, T( KI+1, KI+1 ), LDT,
      $                      WORK( KI+1 + IV*N ), SCALE, RWORK, INFO )
                WORK( KI + IV*N ) = SCALE
             END IF
+*
 *           Copy the vector x or Q*x to VL and normalize.
+*
             IF( .NOT.OVER ) THEN
 *              ------------------------------
 *              no back-transform: copy x to VL and normalize.
-               CALL ZCOPY( N-KI+1, WORK( KI + IV*N ), 1, VL(KI,IS), 1 )
+               CALL ZCOPY( N-KI+1, WORK( KI + IV*N ), 1, VL(KI,IS),
+     $                     1 )
+*
                II = IZAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1
                REMAX = ONE / CABS1( VL( II, IS ) )
                CALL ZDSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
+*
+*
             ELSE IF( NB.EQ.1 ) THEN
 *              ------------------------------
 *              version 1: back-transform each vector with GEMV, Q*x.
                IF( KI.LT.N )
-     $            CALL ZGEMV( 'N', N, N-KI, CONE, VL( 1, KI+1 ), LDVL,
+     $            CALL ZGEMV( 'N', N, N-KI, CONE, VL( 1, KI+1 ),
+     $                        LDVL,
      $                        WORK( KI+1 + IV*N ), 1, DCMPLX( SCALE ),
      $                        VL( 1, KI ), 1 )
+*
                II = IZAMAX( N, VL( 1, KI ), 1 )
                REMAX = ONE / CABS1( VL( II, KI ) )
          CALL ZLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP )
+*
 *        Apply transformation to the matrix T.
+*
          IF( K+2.LE.N )
-     $      CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS,
+     $      CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT,
+     $                 CS,
      $                 SN )
          CALL ZROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS,
      $              DCONJG( SN ) )
+*
          T( K, K ) = T22
 *>
 *>                      EPS * norm(T) / SEP
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S,
+      SUBROUTINE ZTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M,
+     $                   S,
      $                   SEP, WORK, LWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
       LOGICAL            LSAME
       DOUBLE PRECISION   ZLANGE
       EXTERNAL           LSAME, ZLANGE
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACN2, ZLACPY, ZTREXC, ZTRSYL
+      EXTERNAL           XERBLA, ZLACN2, ZLACPY, ZTREXC,
+     $                   ZTRSYL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, SQRT
 *     ..
 *     .. Executable Statements ..
 *>
 *>                      EPS * norm(T) / SEP(i)
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
+      SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL,
+     $                   VR,
      $                   LDVR, S, SEP, MM, M, WORK, LDWORK, RWORK,
      $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            IZAMAX
       DOUBLE PRECISION   DLAMCH, DZNRM2
       COMPLEX*16         ZDOTC
-      EXTERNAL           LSAME, IZAMAX, DLAMCH, DZNRM2, ZDOTC
+      EXTERNAL           LSAME, IZAMAX, DLAMCH, DZNRM2,
+     $                   ZDOTC
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZDRSCL, ZLACN2, ZLACPY, ZLATRS, ZTREXC
+      EXTERNAL           XERBLA, ZDRSCL, ZLACN2, ZLACPY, ZLATRS,
+     $                   ZTREXC
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          ABS, DBLE, DIMAG, MAX
 *     ..
 *     .. Statement Functions ..
+*
 *           Copy the matrix T to the array WORK and swap the k-th
 *           diagonal element to the (1,1) position.
+*
             CALL ZLACPY( 'Full', N, N, T, LDT, WORK, LDWORK )
-            CALL ZTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, K, 1, IERR )
+            CALL ZTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, K, 1,
+     $                   IERR )
+*
 *           Form  C = T22 - lambda*I in WORK(2:N,2:N).
+*
             DO 20 I = 2, N
                WORK( I, I ) = WORK( I, I ) - WORK( 1, 1 )
             SEP( KS ) = ZERO
             EST = ZERO
             KASE = 0
             NORMIN = 'N'
 CONTINUE
-            CALL ZLACN2( N-1, WORK( 1, N+1 ), WORK, EST, KASE, ISAVE )
+            CALL ZLACN2( N-1, WORK( 1, N+1 ), WORK, EST, KASE,
+     $                   ISAVE )
+*
             IF( KASE.NE.0 ) THEN
                IF( KASE.EQ.1 ) THEN
+*
 *                 Solve C**H*x = scale*b
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       DOUBLE PRECISION   DLAMCH, ZLANGE
       COMPLEX*16         ZDOTC, ZDOTU, ZLADIV
-      EXTERNAL           LSAME, DLAMCH, ZLANGE, ZDOTC, ZDOTU, ZLADIV
+      EXTERNAL           LSAME, DLAMCH, ZLANGE, ZDOTC, ZDOTU,
+     $                   ZLADIV
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           XERBLA, ZDSCAL
 *     ..
 *     .. Intrinsic Functions ..
             DO 20 J = 1, N, NB
                JB = MIN( NB, N-J+1 )
+*
 *              Compute rows 1:j-1 of current block column
+*
-               CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
+               CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG,
+     $                     J-1,
      $                     JB, ONE, A, LDA, A( 1, J ), LDA )
-               CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
+               CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG,
+     $                     J-1,
      $                     JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
+*
 *              Compute inverse of current diagonal block
+*
                CALL ZTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
 *>
 *> ZTRTRS solves a triangular system of the form
 *>
 *>    A * X = B,  A**T * X = B,  or  A**H * X = B,
 *>
-*> where A is a triangular matrix of order N, and B is an N-by-NRHS
+*> where A is a triangular matrix of order N, and B is an N-by-NRHS matrix.
+*>
+*> This subroutine verifies that A is nonsingular, but callers should note that only exact
+*> singularity is detected. It is conceivable for one or more diagonal elements of A to be
+*> subnormally tiny numbers without this subroutine signalling an error.
+*>
-*> matrix.  A check is made to verify that A is nonsingular.
+*> If a possible loss of numerical precision due to near-singular matrices is a concern, the
+*> caller should verify that A is nonsingular within some tolerance before calling this subroutine.
 *> \endverbatim
+*
 *  Arguments:
 *  ==========
+*
 *> \param[out] INFO
 *> \verbatim
 *>          INFO is INTEGER
 *>          = 0:  successful exit
 *>          < 0: if INFO = -i, the i-th argument had an illegal value
-*>          > 0: if INFO = i, the i-th diagonal element of A is zero,
+*>          > 0:  if INFO = i, the i-th diagonal element of A is exactly zero,
 *>               indicating that the matrix is singular and the solutions
 *>               X have not been computed.
 *> \endverbatim
+*
 *  Authors:
+*
 *     Test the input parameters.
+*
       INFO = 0
       NOUNIT = LSAME( DIAG, 'N' )
+      IF( .NOT.LSAME( UPLO, 'U' ) .AND.
-      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+     $    .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -1
       ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
+     $         LSAME( TRANS, 'T' ) .AND.
-     $         LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
+     $                .NOT.LSAME( TRANS, 'C' ) ) THEN
          INFO = -2
       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
          INFO = -3
       ELSE IF( N.LT.0 ) THEN
          INFO = -4
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, II, J, L
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF, ZSCAL
+      EXTERNAL           XERBLA, ZLARF1L, ZSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX
 *     ..
 *     .. Executable Statements ..
          II = N - K + I
+*
 *        Apply H(i) to A(1:m-k+i,1:n-k+i) from the left
+*
          A( M-N+II, II ) = ONE
-         CALL ZLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A,
+         CALL ZLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ),
+     $                 A,
-     $               LDA, WORK )
+     $                 LDA, WORK )
          CALL ZSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 )
          A( M-N+II, II ) = ONE - TAU( I )
+*
 *        Set A(m-k+i+1:m,n-k+i) to zero
+*
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, J, L
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF, ZSCAL
+      EXTERNAL           XERBLA, ZLARF1F, ZSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX
 *     ..
 *     .. Executable Statements ..
       DO 40 I = K, 1, -1
+*
 *        Apply H(i) to A(i:m,i:n) from the left
+*
          IF( I.LT.N ) THEN
-            A( I, I ) = ONE
-            CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+            CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
-     $                  A( I, I+1 ), LDA, WORK )
+     $                    A( I, I+1 ), LDA, WORK )
          END IF
          IF( I.LT.M )
      $      CALL ZSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
          A( I, I ) = ONE - TAU( I )
+*
 *> \author NAG Ltd.
+*
 *> \ingroup ungbr
+*
 *  =====================================================================
-      SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
+      SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
 *> \author NAG Ltd.
+*
 *> \ingroup unghr
+*
 *  =====================================================================
-      SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
+      SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK,
+     $                   INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, J, L
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF, ZSCAL
+      EXTERNAL           XERBLA, ZLACGV, ZLARF1F, ZSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCONJG, MAX
 *     ..
 *     .. Executable Statements ..
 *        Apply H(i)**H to A(i:m,i:n) from the right
+*
          IF( I.LT.N ) THEN
             CALL ZLACGV( N-I, A( I, I+1 ), LDA )
             IF( I.LT.M ) THEN
-               A( I, I ) = ONE
-               CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
+               CALL ZLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
-     $                     DCONJG( TAU( I ) ), A( I+1, I ), LDA, WORK )
+     $                       CONJG( TAU( I ) ), A( I+1, I ), LDA,
+     $                       WORK )
             END IF
             CALL ZSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
             CALL ZLACGV( N-I, A( I, I+1 ), LDA )
          END IF
          A( I, I ) = ONE - DCONJG( TAU( I ) )
+*
 *              Not enough workspace to use optimal NB:  reduce NB and
 *              determine the minimum value of NB.
+*
                NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGLQ', ' ', M, N, K, -1 ) )
+               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGLQ', ' ', M, N, K,
+     $                      -1 ) )
             END IF
          END IF
       END IF
+*
       IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
             IF( I+IB.LE.M ) THEN
+*
 *              Form the triangular factor of the block reflector
 *              H = H(i) H(i+1) . . . H(i+ib-1)
+*
-               CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ),
+               CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I,
+     $                      I ),
      $                      LDA, TAU( I ), WORK, LDWORK )
+*
 *              Apply H**H to A(i+ib:m,i:n) from the right
+*
-               CALL ZLARFB( 'Right', 'Conjugate transpose', 'Forward',
+               CALL ZLARFB( 'Right', 'Conjugate transpose',
+     $                      'Forward',
      $                      'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ),
      $                      LDA, WORK, LDWORK, A( I+IB, I ), LDA,
      $                      WORK( IB+1 ), LDWORK )
             END IF
+*
 *           Apply H**H to columns i:n of current block
+*
-            CALL ZUNGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
+            CALL ZUNGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ),
+     $                   WORK,
      $                   IINFO )
+*
 *           Set columns 1:i-1 of current block to zero
+*
             DO 40 J = 1, I - 1
+*
 *              Not enough workspace to use optimal NB:  reduce NB and
 *              determine the minimum value of NB.
+*
                NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQL', ' ', M, N, K, -1 ) )
+               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQL', ' ', M, N, K,
+     $                      -1 ) )
             END IF
          END IF
       END IF
+*
       IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
+*
 *              Not enough workspace to use optimal NB:  reduce NB and
 *              determine the minimum value of NB.
+*
                NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQR', ' ', M, N, K, -1 ) )
+               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQR', ' ', M, N, K,
+     $                      -1 ) )
             END IF
          END IF
       END IF
+*
       IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
      $                      LDA, WORK( IB+1 ), LDWORK )
             END IF
+*
 *           Apply H to rows i:m of current block
+*
-            CALL ZUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
+            CALL ZUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ),
+     $                   WORK,
      $                   IINFO )
+*
 *           Set rows 1:i-1 of current block to zero
+*
             DO 40 J = I, I + IB - 1
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, II, J, L
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF, ZSCAL
+      EXTERNAL           XERBLA, ZLACGV, ZLARF1L, ZSCAL
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCONJG, MAX
 *     ..
 *     .. Executable Statements ..
          II = M - K + I
+*
 *        Apply H(i)**H to A(1:m-k+i,1:n-k+i) from the right
+*
          CALL ZLACGV( N-M+II-1, A( II, 1 ), LDA )
-         A( II, N-M+II ) = ONE
-         CALL ZLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA,
+         CALL ZLARF1L( 'Right', II-1, N-M+II, A( II, 1 ), LDA,
-     $               DCONJG( TAU( I ) ), A, LDA, WORK )
+     $                 CONJG( TAU( I ) ), A, LDA, WORK )
          CALL ZSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA )
          CALL ZLACGV( N-M+II-1, A( II, 1 ), LDA )
          A( II, N-M+II ) = ONE - DCONJG( TAU( I ) )
+*
 *        Set A(m-k+i,n-k+i+1:n) to zero
+*
 *              Not enough workspace to use optimal NB:  reduce NB and
 *              determine the minimum value of NB.
+*
                NB = LWORK / LDWORK
-               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGRQ', ' ', M, N, K, -1 ) )
+               NBMIN = MAX( 2, ILAENV( 2, 'ZUNGRQ', ' ', M, N, K,
+     $                      -1 ) )
             END IF
          END IF
       END IF
+*
       IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
                CALL ZLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
      $                      A( II, 1 ), LDA, TAU( I ), WORK, LDWORK )
+*
 *              Apply H**H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
+*
-               CALL ZLARFB( 'Right', 'Conjugate transpose', 'Backward',
+               CALL ZLARFB( 'Right', 'Conjugate transpose',
+     $                      'Backward',
      $                      'Rowwise', II-1, N-K+I+IB-1, IB, A( II, 1 ),
      $                      LDA, WORK, LDWORK, A, LDA, WORK( IB+1 ),
      $                      LDWORK )
             END IF
+*
 *           Apply H**H to columns 1:n-k+i+ib-1 of current block
+*
-            CALL ZUNGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ),
+            CALL ZUNGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA,
+     $                   TAU( I ),
      $                   WORK, IINFO )
+*
 *           Set columns n-k+i+ib:n of current block to zero
+*
             DO 40 L = N - K + I + IB, N
 CONTINUE
          A( N, N ) = ONE
+*
 *        Generate Q(1:n-1,1:n-1)
+*
-         CALL ZUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO )
+         CALL ZUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK,
+     $                IINFO )
+*
       ELSE
+*
 *        Q was determined by a call to ZHETRD with UPLO = 'L'.
+*
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       LOGICAL            LEFT, NOTRAN
       INTEGER            I, I1, I2, I3, MI, NI, NQ
-      COMPLEX*16         AII, TAUI
+      COMPLEX*16         TAUI
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF
+      EXTERNAL           XERBLA, ZLARF1L
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCONJG, MAX
 *     ..
 *     .. Executable Statements ..
          IF( NOTRAN ) THEN
             TAUI = TAU( I )
          ELSE
             TAUI = DCONJG( TAU( I ) )
          END IF
-         AII = A( NQ-K+I, I )
-         A( NQ-K+I, I ) = ONE
-         CALL ZLARF( SIDE, MI, NI, A( 1, I ), 1, TAUI, C, LDC, WORK )
+         CALL ZLARF1L( SIDE, MI, NI, A( 1, I ), 1, TAUI, C, LDC,
-         A( NQ-K+I, I ) = AII
+     $                 WORK )
 CONTINUE
       RETURN
+*
 *     End of ZUNM2L
+*
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       LOGICAL            LEFT, NOTRAN
       INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
-      COMPLEX*16         AII, TAUI
+      COMPLEX*16         TAUI
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLARF
+      EXTERNAL           XERBLA, ZLARF1F
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCONJG, MAX
 *     ..
 *     .. Executable Statements ..
          IF( NOTRAN ) THEN
             TAUI = TAU( I )
          ELSE
             TAUI = DCONJG( TAU( I ) )
          END IF
-         AII = A( I, I )
+         CALL ZLARF1F( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ),
-         A( I, I ) = ONE
+     $               LDC,
-         CALL ZLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), LDC,
      $               WORK )
-         A( I, I ) = AII
 CONTINUE
       RETURN
+*
 *     End of ZUNM2R
+*
+*
       IF( INFO.EQ.0 ) THEN
          IF( M.GT.0 .AND. N.GT.0 ) THEN
             IF( APPLYQ ) THEN
                IF( LEFT ) THEN
-                  NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M-1, N, M-1,
+                  NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M-1, N,
+     $                         M-1,
      $                 -1 )
                ELSE
-                  NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N-1, N-1,
+                  NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N-1,
+     $                         N-1,
      $                 -1 )
                END IF
             ELSE
                IF( LEFT ) THEN
-                  NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M-1, N, M-1,
+                  NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M-1, N,
+     $                         M-1,
      $                 -1 )
                ELSE
-                  NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N-1, N-1,
+                  NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N-1,
+     $                         N-1,
      $                 -1 )
                END IF
             END IF
             LWKOPT = NW*NB
          ELSE
                MI = M
                NI = N - 1
                I1 = 1
                I2 = 2
             END IF
-            CALL ZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
+            CALL ZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA,
+     $                   TAU,
      $                   C( I1, I2 ), LDC, WORK, LWORK, IINFO )
          END IF
       ELSE
+*
 *        Apply P
          NQ = N
          NW = MAX( 1, M )
       END IF
       IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
          INFO = -1
-      ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) )
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND.
+     $         .NOT.LSAME( TRANS, 'C' ) )
      $          THEN
          INFO = -2
       ELSE IF( M.LT.0 ) THEN
          INFO = -3
       ELSE IF( N.LT.0 ) THEN
       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 *     ..
 *     .. Local Scalars ..
       LOGICAL            LEFT, NOTRAN
       INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
-      COMPLEX*16         AII, TAUI
+      COMPLEX*16         TAUI
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           LSAME
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           XERBLA, ZLACGV, ZLARF
+      EXTERNAL           XERBLA, ZLACGV, ZLARF1F
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          DCONJG, MAX
 *     ..
 *     .. Executable Statements ..
          ELSE
             TAUI = TAU( I )
          END IF
          IF( I.LT.NQ )
      $      CALL ZLACGV( NQ-I, A( I, I+1 ), LDA )
-         AII = A( I, I )
-         A( I, I ) = ONE
-         CALL ZLARF( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC, JC ),
+         CALL ZLARF1F( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC,
-     $               LDC, WORK )
+     $                 JC ), LDC, WORK )
-         A( I, I ) = AII
          IF( I.LT.NQ )
      $      CALL ZLACGV( NQ-I, A( I, I+1 ), LDA )
 CONTINUE
       RETURN
+*
+*
       IF( INFO.EQ.0 ) THEN
+*
 *        Compute the workspace requirements
+*
-         NB = MIN( NBMAX, ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N, K,
+         NB = MIN( NBMAX, ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N,
+     $             K,
      $        -1 ) )
          LWKOPT = NW*NB + TSIZE
          WORK( 1 ) = LWKOPT
       END IF
+*
       NBMIN = 2
       LDWORK = NW
       IF( NB.GT.1 .AND. NB.LT.K ) THEN
          IF( LWORK.LT.LWKOPT ) THEN
             NB = (LWORK-TSIZE) / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMLQ', SIDE // TRANS, M, N, K,
+            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMLQ', SIDE // TRANS, M, N,
+     $                   K,
      $              -1 ) )
          END IF
       END IF
+*
       IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
+*
 *        Use unblocked code
+*
-         CALL ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
+         CALL ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+     $                WORK,
      $                IINFO )
       ELSE
+*
 *        Use blocked code
+*
                JC = I
             END IF
+*
 *           Apply H or H**H
+*
-            CALL ZLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB,
+            CALL ZLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI,
+     $                   IB,
      $                   A( I, I ), LDA, WORK( IWT ), LDT,
      $                   C( IC, JC ), LDC, WORK, LDWORK )
 CONTINUE
       END IF
       WORK( 1 ) = LWKOPT
 *        Compute the workspace requirements
+*
          IF( M.EQ.0 .OR. N.EQ.0 ) THEN
             LWKOPT = 1
          ELSE
-            NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M, N,
+            NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M,
+     $                N,
      $                               K, -1 ) )
             LWKOPT = NW*NB + TSIZE
          END IF
          WORK( 1 ) = LWKOPT
       END IF
       NBMIN = 2
       LDWORK = NW
       IF( NB.GT.1 .AND. NB.LT.K ) THEN
          IF( LWORK.LT.LWKOPT ) THEN
             NB = (LWORK-TSIZE) / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQL', SIDE // TRANS, M, N, K,
+            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQL', SIDE // TRANS, M, N,
+     $                   K,
      $              -1 ) )
          END IF
       END IF
+*
       IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
+*
 *        Use unblocked code
+*
-         CALL ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
+         CALL ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+     $                WORK,
      $                IINFO )
       ELSE
+*
 *        Use blocked code
+*
                NI = N - K + I + IB - 1
             END IF
+*
 *           Apply H or H**H
+*
-            CALL ZLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI,
+            CALL ZLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI,
+     $                   NI,
      $                   IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC,
      $                   WORK, LDWORK )
 CONTINUE
       END IF
       WORK( 1 ) = LWKOPT
+*
       IF( INFO.EQ.0 ) THEN
+*
 *        Compute the workspace requirements
+*
-         NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N, K,
+         NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N,
+     $             K,
      $        -1 ) )
          LWKOPT = NW*NB + TSIZE
          WORK( 1 ) = LWKOPT
       END IF
+*
       NBMIN = 2
       LDWORK = NW
       IF( NB.GT.1 .AND. NB.LT.K ) THEN
          IF( LWORK.LT.LWKOPT ) THEN
             NB = (LWORK-TSIZE) / LDWORK
-            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQR', SIDE // TRANS, M, N, K,
+            NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQR', SIDE // TRANS, M, N,
+     $                   K,
      $              -1 ) )
          END IF
       END IF
+*
       IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
+*
 *        Use unblocked code
+*
-         CALL ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
+         CALL ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+     $                WORK,
      $                IINFO )
       ELSE
+*
 *        Use blocked code
+*
             IB = MIN( NB, K-I+1 )
+*
 *           Form the triangular factor of the block reflector
 *           H = H(i) H(i+1) . . . H(i+ib-1)
+*
-            CALL ZLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
+            CALL ZLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I,
+     $                   I ),
      $                   LDA, TAU( I ), WORK( IWT ), LDT )
             IF( LEFT ) THEN
+*
 *              H or H**H is applied to C(i:m,1:n)
+*
                JC = I
             END IF
+*
 *           Apply H or H**H
+*
-            CALL ZLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
+            CALL ZLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI,
+     $                   NI,
      $                   IB, A( I, I ), LDA, WORK( IWT ), LDT,
      $                   C( IC, JC ), LDC, WORK, LDWORK )
 CONTINUE
       END IF
       WORK( 1 ) = LWKOPT
 *> \author NAG Ltd.
+*
 *> \ingroup unmtr
+*
 *  =====================================================================
-      SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
+      SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C,
+     $                   LDC,
      $                   WORK, LWORK, INFO )
+*
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
       END IF
       IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
          INFO = -1
       ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
          INFO = -2
-      ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) )
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND.
+     $         .NOT.LSAME( TRANS, 'C' ) )
      $          THEN
          INFO = -3
       ELSE IF( M.LT.0 ) THEN
          INFO = -4
       ELSE IF( N.LT.0 ) THEN
+*
       IF( UPPER ) THEN
+*
 *        Q was determined by a call to ZHETRD with UPLO = 'U'
+*
-         CALL ZUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C,
+         CALL ZUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU,
+     $                C,
      $                LDC, WORK, LWORK, IINFO )
       ELSE
+*
 *        Q was determined by a call to ZHETRD with UPLO = 'L'
+*

The R Project SVN R

(root)/trunk/src/modules/lapack/cmplx.f @ 63243 – Rev 86265 → 87868