SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
$ WORK, LWORK, RWORK, INFO )
CHARACTER JOBU, JOBVT
INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
DOUBLE PRECISION RWORK( * ), S( * )
COMPLEX*16 A( LDA, * ), U( LDU, * ), VT( LDVT, * ),
$ WORK( * )
COMPLEX*16 CZERO, CONE
PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ),
$ CONE = ( 1.0D0, 0.0D0 ) )
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
LOGICAL LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
$ WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
INTEGER BLK, CHUNK, I, IE, IERR, IR, IRWORK, ISCL,
$ ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
$ MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
$ NRVT, WRKBL
DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM
DOUBLE PRECISION DUM( 1 )
COMPLEX*16 CDUM( 1 )
EXTERNAL DLASCL, XERBLA, ZBDSQR, ZGEBRD, ZGELQF, ZGEMM,
$ ZGEQRF, ZLACPY, ZLASCL, ZLASET, ZUNGBR, ZUNGLQ,
$ ZUNGQR, ZUNMBR
LOGICAL LSAME
INTEGER ILAENV
DOUBLE PRECISION DLAMCH, ZLANGE
EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE
INTRINSIC MAX, MIN, SQRT
INFO = 0
MINMN = MIN( M, N )
WNTUA = LSAME( JOBU, 'A' )
WNTUS = LSAME( JOBU, 'S' )
WNTUAS = WNTUA .OR. WNTUS
WNTUO = LSAME( JOBU, 'O' )
WNTUN = LSAME( JOBU, 'N' )
WNTVA = LSAME( JOBVT, 'A' )
WNTVS = LSAME( JOBVT, 'S' )
WNTVAS = WNTVA .OR. WNTVS
WNTVO = LSAME( JOBVT, 'O' )
WNTVN = LSAME( JOBVT, 'N' )
LQUERY = ( LWORK.EQ.-1 )
IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
INFO = -1
ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR.
$ ( WNTVO .AND. WNTUO ) ) THEN
INFO = -2
ELSE IF( M.LT.0 ) THEN
INFO = -3
ELSE IF( N.LT.0 ) THEN
INFO = -4
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -6
ELSE IF( LDU.LT.1 .OR. ( WNTUAS .AND. LDU.LT.M ) ) THEN
INFO = -9
ELSE IF( LDVT.LT.1 .OR. ( WNTVA .AND. LDVT.LT.N ) .OR.
$ ( WNTVS .AND. LDVT.LT.MINMN ) ) THEN
INFO = -11
END IF
IF( INFO.EQ.0 ) THEN
MINWRK = 1
MAXWRK = 1
IF( M.GE.N .AND. MINMN.GT.0 ) THEN
MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
IF( M.GE.MNTHR ) THEN
IF( WNTUN ) THEN
MAXWRK = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1,
$ -1 )
MAXWRK = MAX( MAXWRK, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
IF( WNTVO .OR. WNTVAS )
$ MAXWRK = MAX( MAXWRK, 2*N+( N-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
MINWRK = 3*N
ELSE IF( WNTUO .AND. WNTVN ) THEN
WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
$ N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
MAXWRK = MAX( N*N+WRKBL, N*N+M*N )
MINWRK = 2*N + M
ELSE IF( WNTUO .AND. WNTVAS ) THEN
WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
$ N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+( N-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
MAXWRK = MAX( N*N+WRKBL, N*N+M*N )
MINWRK = 2*N + M
ELSE IF( WNTUS .AND. WNTVN ) THEN
WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
$ N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
MAXWRK = N*N + WRKBL
MINWRK = 2*N + M
ELSE IF( WNTUS .AND. WNTVO ) THEN
WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
$ N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+( N-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
MAXWRK = 2*N*N + WRKBL
MINWRK = 2*N + M
ELSE IF( WNTUS .AND. WNTVAS ) THEN
WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M,
$ N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+( N-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
MAXWRK = N*N + WRKBL
MINWRK = 2*N + M
ELSE IF( WNTUA .AND. WNTVN ) THEN
WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'ZUNGQR', ' ', M,
$ M, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
MAXWRK = N*N + WRKBL
MINWRK = 2*N + M
ELSE IF( WNTUA .AND. WNTVO ) THEN
WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'ZUNGQR', ' ', M,
$ M, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+( N-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
MAXWRK = 2*N*N + WRKBL
MINWRK = 2*N + M
ELSE IF( WNTUA .AND. WNTVAS ) THEN
WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'ZUNGQR', ' ', M,
$ M, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+2*N*
$ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', N, N, N, -1 ) )
WRKBL = MAX( WRKBL, 2*N+( N-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
MAXWRK = N*N + WRKBL
MINWRK = 2*N + M
END IF
ELSE
MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N,
$ -1, -1 )
IF( WNTUS .OR. WNTUO )
$ MAXWRK = MAX( MAXWRK, 2*N+N*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, N, N, -1 ) )
IF( WNTUA )
$ MAXWRK = MAX( MAXWRK, 2*N+M*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) )
IF( .NOT.WNTVN )
$ MAXWRK = MAX( MAXWRK, 2*N+( N-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) )
MINWRK = 2*N + M
END IF
ELSE IF( MINMN.GT.0 ) THEN
MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
IF( N.GE.MNTHR ) THEN
IF( WNTVN ) THEN
MAXWRK = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1,
$ -1 )
MAXWRK = MAX( MAXWRK, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
IF( WNTUO .OR. WNTUAS )
$ MAXWRK = MAX( MAXWRK, 2*M+M*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
MINWRK = 3*M
ELSE IF( WNTVO .AND. WNTUN ) THEN
WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
$ N, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
MAXWRK = MAX( M*M+WRKBL, M*M+M*N )
MINWRK = 2*M + N
ELSE IF( WNTVO .AND. WNTUAS ) THEN
WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
$ N, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+M*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
MAXWRK = MAX( M*M+WRKBL, M*M+M*N )
MINWRK = 2*M + N
ELSE IF( WNTVS .AND. WNTUN ) THEN
WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
$ N, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
MAXWRK = M*M + WRKBL
MINWRK = 2*M + N
ELSE IF( WNTVS .AND. WNTUO ) THEN
WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
$ N, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+M*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
MAXWRK = 2*M*M + WRKBL
MINWRK = 2*M + N
ELSE IF( WNTVS .AND. WNTUAS ) THEN
WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M,
$ N, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+M*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
MAXWRK = M*M + WRKBL
MINWRK = 2*M + N
ELSE IF( WNTVA .AND. WNTUN ) THEN
WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'ZUNGLQ', ' ', N,
$ N, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
MAXWRK = M*M + WRKBL
MINWRK = 2*M + N
ELSE IF( WNTVA .AND. WNTUO ) THEN
WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'ZUNGLQ', ' ', N,
$ N, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+M*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
MAXWRK = 2*M*M + WRKBL
MINWRK = 2*M + N
ELSE IF( WNTVA .AND. WNTUAS ) THEN
WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'ZUNGLQ', ' ', N,
$ N, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+2*M*
$ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
WRKBL = MAX( WRKBL, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'P', M, M, M, -1 ) )
WRKBL = MAX( WRKBL, 2*M+M*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
MAXWRK = M*M + WRKBL
MINWRK = 2*M + N
END IF
ELSE
MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N,
$ -1, -1 )
IF( WNTVS .OR. WNTVO )
$ MAXWRK = MAX( MAXWRK, 2*M+M*
$ ILAENV( 1, 'ZUNGBR', 'P', M, N, M, -1 ) )
IF( WNTVA )
$ MAXWRK = MAX( MAXWRK, 2*M+N*
$ ILAENV( 1, 'ZUNGBR', 'P', N, N, M, -1 ) )
IF( .NOT.WNTUN )
$ MAXWRK = MAX( MAXWRK, 2*M+( M-1 )*
$ ILAENV( 1, 'ZUNGBR', 'Q', M, M, M, -1 ) )
MINWRK = 2*M + N
END IF
END IF
MAXWRK = MAX( MAXWRK, MINWRK )
WORK( 1 ) = MAXWRK
IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
INFO = -13
END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGESVD', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
IF( M.EQ.0 .OR. N.EQ.0 ) THEN
RETURN
END IF
EPS = DLAMCH( 'P' )
SMLNUM = SQRT( DLAMCH( 'S' ) ) / EPS
BIGNUM = ONE / SMLNUM
ANRM = ZLANGE( 'M', M, N, A, LDA, DUM )
ISCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
ISCL = 1
CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
ELSE IF( ANRM.GT.BIGNUM ) THEN
ISCL = 1
CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
END IF
IF( M.GE.N ) THEN
IF( M.GE.MNTHR ) THEN
IF( WNTUN ) THEN
ITAU = 1
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ),
$ LDA )
IE = 1
ITAUQ = 1
ITAUP = ITAUQ + N
IWORK = ITAUP + N
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
CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
NCVT = N
END IF
IRWORK = IE + N
CALL ZBDSQR( 'U', N, NCVT, 0, 0, S, RWORK( IE ), A, LDA,
$ CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO )
IF( WNTVAS )
$ CALL ZLACPY( 'F', N, N, A, LDA, VT, LDVT )
ELSE IF( WNTUO .AND. WNTVN ) THEN
IF( LWORK.GE.N*N+3*N ) THEN
IR = 1
IF( LWORK.GE.MAX( WRKBL, LDA*N )+LDA*N ) THEN
LDWRKU = LDA
LDWRKR = LDA
ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N )+N*N ) THEN
LDWRKU = LDA
LDWRKR = N
ELSE
LDWRKU = ( LWORK-N*N ) / N
LDWRKR = N
END IF
ITAU = IR + LDWRKR*N
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ WORK( IR+1 ), LDWRKR )
CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, 1,
$ WORK( IR ), LDWRKR, CDUM, 1,
$ RWORK( IRWORK ), INFO )
IU = ITAUQ
DO 10 I = 1, M, LDWRKU
CHUNK = MIN( M-I+1, LDWRKU )
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 )
10 CONTINUE
ELSE
IE = 1
ITAUQ = 1
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
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
IF( LWORK.GE.N*N+3*N ) THEN
IR = 1
IF( LWORK.GE.MAX( WRKBL, LDA*N )+LDA*N ) THEN
LDWRKU = LDA
LDWRKR = LDA
ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N )+N*N ) THEN
LDWRKU = LDA
LDWRKR = N
ELSE
LDWRKU = ( LWORK-N*N ) / N
LDWRKR = N
END IF
ITAU = IR + LDWRKR*N
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
IF( N.GT.1 )
$ CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ VT( 2, 1 ), LDVT )
CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + 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 ZUNGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT,
$ LDVT, WORK( IR ), LDWRKR, CDUM, 1,
$ RWORK( IRWORK ), INFO )
IU = ITAUQ
DO 20 I = 1, M, LDWRKU
CHUNK = MIN( M-I+1, LDWRKU )
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 )
20 CONTINUE
ELSE
ITAU = 1
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
IF( N.GT.1 )
$ CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ VT( 2, 1 ), LDVT )
CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
$ WORK( ITAUQ ), A, LDA, WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT,
$ LDVT, A, LDA, CDUM, 1, RWORK( IRWORK ),
$ INFO )
END IF
ELSE IF( WNTUS ) THEN
IF( WNTVN ) THEN
IF( LWORK.GE.N*N+3*N ) THEN
IR = 1
IF( LWORK.GE.WRKBL+LDA*N ) THEN
LDWRKR = LDA
ELSE
LDWRKR = N
END IF
ITAU = IR + LDWRKR*N
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ),
$ LDWRKR )
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ WORK( IR+1 ), LDWRKR )
CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM,
$ 1, WORK( IR ), LDWRKR, CDUM, 1,
$ RWORK( IRWORK ), INFO )
CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA,
$ WORK( IR ), LDWRKR, CZERO, U, LDU )
ELSE
ITAU = 1
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZUNGQR( M, N, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ A( 2, 1 ), LDA )
CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
$ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM,
$ 1, U, LDU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
END IF
ELSE IF( WNTVO ) THEN
IF( LWORK.GE.2*N*N+3*N ) THEN
IU = 1
IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
LDWRKU = LDA
IR = IU + LDWRKU*N
LDWRKR = LDA
ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
LDWRKU = LDA
IR = IU + LDWRKU*N
LDWRKR = N
ELSE
LDWRKU = N
IR = IU + LDWRKU*N
LDWRKR = N
END IF
ITAU = IR + LDWRKR*N
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, WORK( IU ),
$ LDWRKU )
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ WORK( IU+1 ), LDWRKU )
CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, WORK( IU ), LDWRKU, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, WORK( IU ), LDWRKU,
$ WORK( IR ), LDWRKR )
CALL ZUNGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ),
$ WORK( IR ), LDWRKR, WORK( IU ),
$ LDWRKU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA,
$ WORK( IU ), LDWRKU, CZERO, U, LDU )
CALL ZLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
$ LDA )
ELSE
ITAU = 1
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZUNGQR( M, N, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ A( 2, 1 ), LDA )
CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
$ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), A,
$ LDA, U, LDU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
END IF
ELSE IF( WNTVAS ) THEN
IF( LWORK.GE.N*N+3*N ) THEN
IU = 1
IF( LWORK.GE.WRKBL+LDA*N ) THEN
LDWRKU = LDA
ELSE
LDWRKU = N
END IF
ITAU = IU + LDWRKU*N
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, WORK( IU ),
$ LDWRKU )
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ WORK( IU+1 ), LDWRKU )
CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, WORK( IU ), LDWRKU, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
$ LDVT )
CALL ZUNGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT,
$ LDVT, WORK( IU ), LDWRKU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA,
$ WORK( IU ), LDWRKU, CZERO, U, LDU )
ELSE
ITAU = 1
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZUNGQR( M, N, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
IF( N.GT.1 )
$ CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ VT( 2, 1 ), LDVT )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
$ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT,
$ LDVT, U, LDU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
END IF
END IF
ELSE IF( WNTUA ) THEN
IF( WNTVN ) THEN
IF( LWORK.GE.N*N+MAX( N+M, 3*N ) ) THEN
IR = 1
IF( LWORK.GE.WRKBL+LDA*N ) THEN
LDWRKR = LDA
ELSE
LDWRKR = N
END IF
ITAU = IR + LDWRKR*N
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ),
$ LDWRKR )
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ WORK( IR+1 ), LDWRKR )
CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM,
$ 1, WORK( IR ), LDWRKR, CDUM, 1,
$ RWORK( IRWORK ), INFO )
CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU,
$ WORK( IR ), LDWRKR, CZERO, A, LDA )
CALL ZLACPY( 'F', M, N, A, LDA, U, LDU )
ELSE
ITAU = 1
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ A( 2, 1 ), LDA )
CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
$ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM,
$ 1, U, LDU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
END IF
ELSE IF( WNTVO ) THEN
IF( LWORK.GE.2*N*N+MAX( N+M, 3*N ) ) THEN
IU = 1
IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
LDWRKU = LDA
IR = IU + LDWRKU*N
LDWRKR = LDA
ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
LDWRKU = LDA
IR = IU + LDWRKU*N
LDWRKR = N
ELSE
LDWRKU = N
IR = IU + LDWRKU*N
LDWRKR = N
END IF
ITAU = IR + LDWRKR*N
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, WORK( IU ),
$ LDWRKU )
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ WORK( IU+1 ), LDWRKU )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, WORK( IU ), LDWRKU, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, WORK( IU ), LDWRKU,
$ WORK( IR ), LDWRKR )
CALL ZUNGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ),
$ WORK( IR ), LDWRKR, WORK( IU ),
$ LDWRKU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU,
$ WORK( IU ), LDWRKU, CZERO, A, LDA )
CALL ZLACPY( 'F', M, N, A, LDA, U, LDU )
CALL ZLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
$ LDA )
ELSE
ITAU = 1
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ A( 2, 1 ), LDA )
CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
$ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), A,
$ LDA, U, LDU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
END IF
ELSE IF( WNTVAS ) THEN
IF( LWORK.GE.N*N+MAX( N+M, 3*N ) ) THEN
IU = 1
IF( LWORK.GE.WRKBL+LDA*N ) THEN
LDWRKU = LDA
ELSE
LDWRKU = N
END IF
ITAU = IU + LDWRKU*N
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, WORK( IU ),
$ LDWRKU )
CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ WORK( IU+1 ), LDWRKU )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, WORK( IU ), LDWRKU, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
$ LDVT )
CALL ZUNGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT,
$ LDVT, WORK( IU ), LDWRKU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU,
$ WORK( IU ), LDWRKU, CZERO, A, LDA )
CALL ZLACPY( 'F', M, N, A, LDA, U, LDU )
ELSE
ITAU = 1
IWORK = ITAU + N
CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
IF( N.GT.1 )
$ CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
$ VT( 2, 1 ), LDVT )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
$ WORK( ITAUQ ), U, LDU, WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + N
CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT,
$ LDVT, U, LDU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
END IF
END IF
END IF
ELSE
IE = 1
ITAUQ = 1
ITAUP = ITAUQ + N
IWORK = ITAUP + N
CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
$ IERR )
IF( WNTUAS ) THEN
CALL ZLACPY( 'L', M, N, A, LDA, U, LDU )
IF( WNTUS )
$ NCU = N
IF( WNTUA )
$ NCU = M
CALL ZUNGBR( 'Q', M, NCU, N, U, LDU, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IF( WNTVAS ) THEN
CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT )
CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IF( WNTUO ) THEN
CALL ZUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IF( WNTVO ) THEN
CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IRWORK = IE + N
IF( WNTUAS .OR. WNTUO )
$ NRU = M
IF( WNTUN )
$ NRU = 0
IF( WNTVAS .OR. WNTVO )
$ NCVT = N
IF( WNTVN )
$ NCVT = 0
IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
CALL ZBDSQR( 'U', N, NCVT, NRU, 0, S, RWORK( IE ), VT,
$ LDVT, U, LDU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
CALL ZBDSQR( 'U', N, NCVT, NRU, 0, S, RWORK( IE ), A,
$ LDA, U, LDU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
ELSE
CALL ZBDSQR( 'U', N, NCVT, NRU, 0, S, RWORK( IE ), VT,
$ LDVT, A, LDA, CDUM, 1, RWORK( IRWORK ),
$ INFO )
END IF
END IF
ELSE
IF( N.GE.MNTHR ) THEN
IF( WNTVN ) THEN
ITAU = 1
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, A( 1, 2 ),
$ LDA )
IE = 1
ITAUQ = 1
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
$ IERR )
IF( WNTUO .OR. WNTUAS ) THEN
CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IRWORK = IE + M
NRU = 0
IF( WNTUO .OR. WNTUAS )
$ NRU = M
CALL ZBDSQR( 'U', M, 0, NRU, 0, S, RWORK( IE ), CDUM, 1,
$ A, LDA, CDUM, 1, RWORK( IRWORK ), INFO )
IF( WNTUAS )
$ CALL ZLACPY( 'F', M, M, A, LDA, U, LDU )
ELSE IF( WNTVO .AND. WNTUN ) THEN
IF( LWORK.GE.M*M+3*M ) THEN
IR = 1
IF( LWORK.GE.MAX( WRKBL, LDA*N )+LDA*M ) THEN
LDWRKU = LDA
CHUNK = N
LDWRKR = LDA
ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N )+M*M ) THEN
LDWRKU = LDA
CHUNK = N
LDWRKR = M
ELSE
LDWRKU = M
CHUNK = ( LWORK-M*M ) / M
LDWRKR = M
END IF
ITAU = IR + LDWRKR*M
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ WORK( IR+LDWRKR ), LDWRKR )
CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, M, 0, 0, S, RWORK( IE ),
$ WORK( IR ), LDWRKR, CDUM, 1, CDUM, 1,
$ RWORK( IRWORK ), INFO )
IU = ITAUQ
DO 30 I = 1, N, CHUNK
BLK = MIN( N-I+1, CHUNK )
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 )
30 CONTINUE
ELSE
IE = 1
ITAUQ = 1
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
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
IF( LWORK.GE.M*M+3*M ) THEN
IR = 1
IF( LWORK.GE.MAX( WRKBL, LDA*N )+LDA*M ) THEN
LDWRKU = LDA
CHUNK = N
LDWRKR = LDA
ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N )+M*M ) THEN
LDWRKU = LDA
CHUNK = N
LDWRKR = M
ELSE
LDWRKU = M
CHUNK = ( LWORK-M*M ) / M
LDWRKR = M
END IF
ITAU = IR + LDWRKR*M
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ),
$ LDU )
CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + 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 ZUNGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
$ WORK( IR ), LDWRKR, U, LDU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
IU = ITAUQ
DO 40 I = 1, N, CHUNK
BLK = MIN( N-I+1, CHUNK )
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 )
40 CONTINUE
ELSE
ITAU = 1
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ),
$ LDU )
CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'P', 'L', 'C', M, N, M, U, LDU,
$ WORK( ITAUP ), A, LDA, WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
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
IF( WNTUN ) THEN
IF( LWORK.GE.M*M+3*M ) THEN
IR = 1
IF( LWORK.GE.WRKBL+LDA*M ) THEN
LDWRKR = LDA
ELSE
LDWRKR = M
END IF
ITAU = IR + LDWRKR*M
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ),
$ LDWRKR )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ WORK( IR+LDWRKR ), LDWRKR )
CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, M, 0, 0, S, RWORK( IE ),
$ WORK( IR ), LDWRKR, CDUM, 1, CDUM, 1,
$ RWORK( IRWORK ), INFO )
CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IR ),
$ LDWRKR, A, LDA, CZERO, VT, LDVT )
ELSE
ITAU = 1
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZUNGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ A( 1, 2 ), LDA )
CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'P', 'L', 'C', M, N, M, A, LDA,
$ WORK( ITAUP ), VT, LDVT,
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT,
$ LDVT, CDUM, 1, CDUM, 1,
$ RWORK( IRWORK ), INFO )
END IF
ELSE IF( WNTUO ) THEN
IF( LWORK.GE.2*M*M+3*M ) THEN
IU = 1
IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
LDWRKU = LDA
IR = IU + LDWRKU*M
LDWRKR = LDA
ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
LDWRKU = LDA
IR = IU + LDWRKU*M
LDWRKR = M
ELSE
LDWRKU = M
IR = IU + LDWRKU*M
LDWRKR = M
END IF
ITAU = IR + LDWRKR*M
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, WORK( IU ),
$ LDWRKU )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ WORK( IU+LDWRKU ), LDWRKU )
CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, WORK( IU ), LDWRKU, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, WORK( IU ), LDWRKU,
$ WORK( IR ), LDWRKR )
CALL ZUNGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
$ WORK( IU ), LDWRKU, WORK( IR ),
$ LDWRKR, CDUM, 1, RWORK( IRWORK ),
$ INFO )
CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IU ),
$ LDWRKU, A, LDA, CZERO, VT, LDVT )
CALL ZLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
$ LDA )
ELSE
ITAU = 1
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZUNGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ A( 1, 2 ), LDA )
CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'P', 'L', 'C', M, N, M, A, LDA,
$ WORK( ITAUP ), VT, LDVT,
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
$ LDVT, A, LDA, CDUM, 1,
$ RWORK( IRWORK ), INFO )
END IF
ELSE IF( WNTUAS ) THEN
IF( LWORK.GE.M*M+3*M ) THEN
IU = 1
IF( LWORK.GE.WRKBL+LDA*M ) THEN
LDWRKU = LDA
ELSE
LDWRKU = M
END IF
ITAU = IU + LDWRKU*M
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, WORK( IU ),
$ LDWRKU )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ WORK( IU+LDWRKU ), LDWRKU )
CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, WORK( IU ), LDWRKU, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
$ LDU )
CALL ZUNGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
$ WORK( IU ), LDWRKU, U, LDU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IU ),
$ LDWRKU, A, LDA, CZERO, VT, LDVT )
ELSE
ITAU = 1
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZUNGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ U( 1, 2 ), LDU )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'P', 'L', 'C', M, N, M, U, LDU,
$ WORK( ITAUP ), VT, LDVT,
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
$ LDVT, U, LDU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
END IF
END IF
ELSE IF( WNTVA ) THEN
IF( WNTUN ) THEN
IF( LWORK.GE.M*M+MAX( N+M, 3*M ) ) THEN
IR = 1
IF( LWORK.GE.WRKBL+LDA*M ) THEN
LDWRKR = LDA
ELSE
LDWRKR = M
END IF
ITAU = IR + LDWRKR*M
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ),
$ LDWRKR )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ WORK( IR+LDWRKR ), LDWRKR )
CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, M, 0, 0, S, RWORK( IE ),
$ WORK( IR ), LDWRKR, CDUM, 1, CDUM, 1,
$ RWORK( IRWORK ), INFO )
CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IR ),
$ LDWRKR, VT, LDVT, CZERO, A, LDA )
CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT )
ELSE
ITAU = 1
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ A( 1, 2 ), LDA )
CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'P', 'L', 'C', M, N, M, A, LDA,
$ WORK( ITAUP ), VT, LDVT,
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT,
$ LDVT, CDUM, 1, CDUM, 1,
$ RWORK( IRWORK ), INFO )
END IF
ELSE IF( WNTUO ) THEN
IF( LWORK.GE.2*M*M+MAX( N+M, 3*M ) ) THEN
IU = 1
IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
LDWRKU = LDA
IR = IU + LDWRKU*M
LDWRKR = LDA
ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
LDWRKU = LDA
IR = IU + LDWRKU*M
LDWRKR = M
ELSE
LDWRKU = M
IR = IU + LDWRKU*M
LDWRKR = M
END IF
ITAU = IR + LDWRKR*M
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, WORK( IU ),
$ LDWRKU )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ WORK( IU+LDWRKU ), LDWRKU )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, WORK( IU ), LDWRKU, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, WORK( IU ), LDWRKU,
$ WORK( IR ), LDWRKR )
CALL ZUNGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
$ WORK( ITAUQ ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
$ WORK( IU ), LDWRKU, WORK( IR ),
$ LDWRKR, CDUM, 1, RWORK( IRWORK ),
$ INFO )
CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IU ),
$ LDWRKU, VT, LDVT, CZERO, A, LDA )
CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT )
CALL ZLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
$ LDA )
ELSE
ITAU = 1
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ A( 1, 2 ), LDA )
CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'P', 'L', 'C', M, N, M, A, LDA,
$ WORK( ITAUP ), VT, LDVT,
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
$ LDVT, A, LDA, CDUM, 1,
$ RWORK( IRWORK ), INFO )
END IF
ELSE IF( WNTUAS ) THEN
IF( LWORK.GE.M*M+MAX( N+M, 3*M ) ) THEN
IU = 1
IF( LWORK.GE.WRKBL+LDA*M ) THEN
LDWRKU = LDA
ELSE
LDWRKU = M
END IF
ITAU = IU + LDWRKU*M
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, WORK( IU ),
$ LDWRKU )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ WORK( IU+LDWRKU ), LDWRKU )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, WORK( IU ), LDWRKU, S,
$ RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
$ LDU )
CALL ZUNGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
$ WORK( ITAUP ), WORK( IWORK ),
$ LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, M, M, 0, S, RWORK( IE ),
$ WORK( IU ), LDWRKU, U, LDU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IU ),
$ LDWRKU, VT, LDVT, CZERO, A, LDA )
CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT )
ELSE
ITAU = 1
IWORK = ITAU + M
CALL ZGELQF( M, N, A, LDA, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO,
$ U( 1, 2 ), LDU )
IE = 1
ITAUQ = ITAU
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ),
$ WORK( ITAUQ ), WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNMBR( 'P', 'L', 'C', M, N, M, U, LDU,
$ WORK( ITAUP ), VT, LDVT,
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
IRWORK = IE + M
CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT,
$ LDVT, U, LDU, CDUM, 1,
$ RWORK( IRWORK ), INFO )
END IF
END IF
END IF
ELSE
IE = 1
ITAUQ = 1
ITAUP = ITAUQ + M
IWORK = ITAUP + M
CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ),
$ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
$ IERR )
IF( WNTUAS ) THEN
CALL ZLACPY( 'L', M, M, A, LDA, U, LDU )
CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IF( WNTVAS ) THEN
CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT )
IF( WNTVA )
$ NRVT = N
IF( WNTVS )
$ NRVT = M
CALL ZUNGBR( 'P', NRVT, N, M, VT, LDVT, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IF( WNTUO ) THEN
CALL ZUNGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IF( WNTVO ) THEN
CALL ZUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
$ WORK( IWORK ), LWORK-IWORK+1, IERR )
END IF
IRWORK = IE + M
IF( WNTUAS .OR. WNTUO )
$ NRU = M
IF( WNTUN )
$ NRU = 0
IF( WNTVAS .OR. WNTVO )
$ NCVT = N
IF( WNTVN )
$ NCVT = 0
IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
CALL ZBDSQR( 'L', M, NCVT, NRU, 0, S, RWORK( IE ), VT,
$ LDVT, U, LDU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
CALL ZBDSQR( 'L', M, NCVT, NRU, 0, S, RWORK( IE ), A,
$ LDA, U, LDU, CDUM, 1, RWORK( IRWORK ),
$ INFO )
ELSE
CALL ZBDSQR( 'L', M, NCVT, NRU, 0, S, RWORK( IE ), VT,
$ LDVT, A, LDA, CDUM, 1, RWORK( IRWORK ),
$ INFO )
END IF
END IF
END IF
IF( ISCL.EQ.1 ) THEN
IF( ANRM.GT.BIGNUM )
$ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
$ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1,
$ RWORK( IE ), MINMN, IERR )
IF( ANRM.LT.SMLNUM )
$ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
$ IERR )
IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
$ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1,
$ RWORK( IE ), MINMN, IERR )
END IF
WORK( 1 ) = MAXWRK
RETURN
END