📄 zgesdd.c
字号:
nb = ilaenv_(&c__1, "ZGEBRD", " ", n, n, &c_n1, &c_n1, (
ftnlen)6, (ftnlen)1);
latime_1.ops += dopla_("ZGEBRD", n, n, &c__0, &c__0, &nb);
i__2 = *lwork - nwork + 1;
zgebrd_(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[
itauq], &work[itaup], &work[nwork], &i__2, &ierr);
iru = ie + *n;
irvt = iru + *n * *n;
nrwork = irvt + *n * *n;
/* Perform bidiagonal SVD, computing left singular vectors
of bidiagonal matrix in RWORK(IRU) and computing right
singular vectors of bidiagonal matrix in RWORK(IRVT)
(CWorkspace: need 0)
(RWorkspace: need BDSPAC) */
dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
info);
/* Copy real matrix RWORK(IRU) to complex matrix WORK(IU)
Overwrite WORK(IU) by left singular vectors of R
(CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
(RWorkspace: 0) */
zlacp2_("F", n, n, &rwork[iru], n, &work[iu], &ldwrku);
nb = ilaenv_(&c__1, "ZUNMBR", "QLN", n, n, n, &c_n1, (ftnlen)
6, (ftnlen)3);
latime_1.ops += dopla2_("ZUNMBR", "QLN", n, n, n, &c__0, &nb);
i__2 = *lwork - nwork + 1;
zunmbr_("Q", "L", "N", n, n, n, &a[a_offset], lda, &work[
itauq], &work[iu], &ldwrku, &work[nwork], &i__2, &
ierr);
/* Copy real matrix RWORK(IRVT) to complex matrix VT
Overwrite VT by right singular vectors of R
(CWorkspace: need 3*N, prefer 2*N+N*NB)
(RWorkspace: 0) */
zlacp2_("F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt);
nb = ilaenv_(&c__1, "ZUNMBR", "PRT", n, n, n, &c_n1, (ftnlen)
6, (ftnlen)3);
latime_1.ops += dopla2_("ZUNMBR", "PRT", n, n, n, &c__0, &nb);
i__2 = *lwork - nwork + 1;
zunmbr_("P", "R", "C", n, n, n, &a[a_offset], lda, &work[
itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
ierr);
/* Multiply Q in U by left singular vectors of R in
WORK(IU), storing result in A
(CWorkspace: need N*N)
(RWorkspace: 0) */
latime_1.ops += dopbl3_("ZGEMM ", m, n, n);
zgemm_("N", "N", m, n, n, &c_b2, &u[u_offset], ldu, &work[iu],
&ldwrku, &c_b1, &a[a_offset], lda);
/* Copy left singular vectors of A from A to U */
zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
}
} else if (*m >= mnthr2) {
/* MNTHR2 <= M < MNTHR1
Path 5 (M much larger than N, but not as much as MNTHR1)
Reduce to bidiagonal form without QR decomposition, use
ZUNGBR and matrix multiplication to compute singular vectors */
ie = 1;
nrwork = ie + *n;
itauq = 1;
itaup = itauq + *n;
nwork = itaup + *n;
/* Bidiagonalize A
(CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB)
(RWorkspace: need N) */
nb = ilaenv_(&c__1, "ZGEBRD", " ", m, n, &c_n1, &c_n1, (ftnlen)6,
(ftnlen)1);
latime_1.ops += dopla_("ZGEBRD", m, n, &c__0, &c__0, &nb);
i__2 = *lwork - nwork + 1;
zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
&work[itaup], &work[nwork], &i__2, &ierr);
if (wntqn) {
/* Compute singular values only
(Cworkspace: 0)
(Rworkspace: need BDSPAC) */
dbdsdc_("U", "N", n, &s[1], &rwork[ie], dum, &c__1, dum, &
c__1, dum, idum, &rwork[nrwork], &iwork[1], info);
} else if (wntqo) {
iu = nwork;
iru = nrwork;
irvt = iru + *n * *n;
nrwork = irvt + *n * *n;
/* Copy A to VT, generate P**H
(Cworkspace: need 2*N, prefer N+N*NB)
(Rworkspace: 0) */
zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
nb = ilaenv_(&c__1, "ZUNGBR", "P", n, n, n, &c_n1, (ftnlen)6,
(ftnlen)1);
latime_1.ops += dopla2_("ZUNGBR", "P", n, n, n, &c__0, &nb);
i__2 = *lwork - nwork + 1;
zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
work[nwork], &i__2, &ierr);
/* Generate Q in A
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
nb = ilaenv_(&c__1, "ZUNGBR", "Q", n, n, n, &c_n1, (ftnlen)6,
(ftnlen)1);
latime_1.ops += dopla2_("ZUNGBR", "Q", n, n, n, &c__0, &nb);
i__2 = *lwork - nwork + 1;
zungbr_("Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[
nwork], &i__2, &ierr);
if (*lwork >= *m * *n + *n * 3) {
/* WORK( IU ) is M by N */
ldwrku = *m;
} else {
/* WORK(IU) is LDWRKU by N */
ldwrku = (*lwork - *n * 3) / *n;
}
nwork = iu + ldwrku * *n;
/* Perform bidiagonal SVD, computing left singular vectors
of bidiagonal matrix in RWORK(IRU) and computing right
singular vectors of bidiagonal matrix in RWORK(IRVT)
(CWorkspace: need 0)
(RWorkspace: need BDSPAC) */
dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
info);
/* Multiply real matrix RWORK(IRVT) by P**H in VT,
storing the result in WORK(IU), copying to VT
(Cworkspace: need 0)
(Rworkspace: need 3*N*N) */
latime_1.ops += (doublereal) ((*n << 2) * *n * *n);
zlarcm_(n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &work[iu]
, &ldwrku, &rwork[nrwork]);
zlacpy_("F", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt);
/* Multiply Q in A by real matrix RWORK(IRU), storing the
result in WORK(IU), copying to A
(CWorkspace: need N*N, prefer M*N)
(Rworkspace: need 3*N*N, prefer N*N+2*M*N) */
nrwork = irvt;
i__2 = *m;
i__1 = ldwrku;
for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
i__1) {
/* Computing MIN */
i__3 = *m - i__ + 1;
chunk = min(i__3,ldwrku);
latime_1.ops += (doublereal) ((chunk << 2) * *n * *n);
zlacrm_(&chunk, n, &a_ref(i__, 1), lda, &rwork[iru], n, &
work[iu], &ldwrku, &rwork[nrwork]);
zlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a_ref(i__, 1)
, lda);
/* L20: */
}
} else if (wntqs) {
/* Copy A to VT, generate P**H
(Cworkspace: need 2*N, prefer N+N*NB)
(Rworkspace: 0) */
zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
nb = ilaenv_(&c__1, "ZUNGBR", "P", n, n, n, &c_n1, (ftnlen)6,
(ftnlen)1);
latime_1.ops += dopla2_("ZUNGBR", "P", n, n, n, &c__0, &nb);
i__1 = *lwork - nwork + 1;
zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
work[nwork], &i__1, &ierr);
/* Copy A to U, generate Q
(Cworkspace: need 2*N, prefer N+N*NB)
(Rworkspace: 0) */
zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
nb = ilaenv_(&c__1, "ZUNGBR", "Q", m, n, n, &c_n1, (ftnlen)6,
(ftnlen)1);
latime_1.ops += dopla2_("ZUNGBR", "Q", m, n, n, &c__0, &nb);
i__1 = *lwork - nwork + 1;
zungbr_("Q", m, n, n, &u[u_offset], ldu, &work[itauq], &work[
nwork], &i__1, &ierr);
/* Perform bidiagonal SVD, computing left singular vectors
of bidiagonal matrix in RWORK(IRU) and computing right
singular vectors of bidiagonal matrix in RWORK(IRVT)
(CWorkspace: need 0)
(RWorkspace: need BDSPAC) */
iru = nrwork;
irvt = iru + *n * *n;
nrwork = irvt + *n * *n;
dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
info);
/* Multiply real matrix RWORK(IRVT) by P**H in VT,
storing the result in A, copying to VT
(Cworkspace: need 0)
(Rworkspace: need 3*N*N) */
latime_1.ops += (doublereal) ((*n << 2) * *n * *n);
zlarcm_(n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &a[
a_offset], lda, &rwork[nrwork]);
zlacpy_("F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
/* Multiply Q in U by real matrix RWORK(IRU), storing the
result in A, copying to U
(CWorkspace: need 0)
(Rworkspace: need N*N+2*M*N) */
nrwork = irvt;
zlacrm_(m, n, &u[u_offset], ldu, &rwork[iru], n, &a[a_offset],
lda, &rwork[nrwork]);
zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
} else {
/* Copy A to VT, generate P**H
(Cworkspace: need 2*N, prefer N+N*NB)
(Rworkspace: 0) */
zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
nb = ilaenv_(&c__1, "ZUNGBR", "P", n, n, n, &c_n1, (ftnlen)6,
(ftnlen)1);
latime_1.ops += dopla2_("ZUNGBR", "P", n, n, n, &c__0, &nb);
i__1 = *lwork - nwork + 1;
zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
work[nwork], &i__1, &ierr);
/* Copy A to U, generate Q
(Cworkspace: need 2*N, prefer N+N*NB)
(Rworkspace: 0) */
zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
nb = ilaenv_(&c__1, "ZUNGBR", "Q", m, m, n, &c_n1, (ftnlen)6,
(ftnlen)1);
latime_1.ops += dopla2_("ZUNGBR", "Q", m, m, n, &c__0, &nb);
i__1 = *lwork - nwork + 1;
zungbr_("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[
nwork], &i__1, &ierr);
/* Perform bidiagonal SVD, computing left singular vectors
of bidiagonal matrix in RWORK(IRU) and computing right
singular vectors of bidiagonal matrix in RWORK(IRVT)
(CWorkspace: need 0)
(RWorkspace: need BDSPAC) */
iru = nrwork;
irvt = iru + *n * *n;
nrwork = irvt + *n * *n;
dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
info);
/* Multiply real matrix RWORK(IRVT) by P**H in VT,
storing the result in A, copying to VT
(Cworkspace: need 0)
(Rworkspace: need 3*N*N) */
latime_1.ops += (doublereal) ((*n << 2) * *n * *n);
zlarcm_(n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &a[
a_offset], lda, &rwork[nrwork]);
zlacpy_("F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
/* Multiply Q in U by real matrix RWORK(IRU), storing the
result in A, copying to U
(CWorkspace: 0)
(Rworkspace: need 3*N*N) */
nrwork = irvt;
zlacrm_(m, n, &u[u_offset], ldu, &rwork[iru], n, &a[a_offset],
lda, &rwork[nrwork]);
zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
}
} else {
/* M .LT. MNTHR2
Path 6 (M at least N, but not much larger)
Reduce to bidiagonal form without QR decomposition
Use ZUNMBR to compute singular vectors */
ie = 1;
nrwork = ie + *n;
itauq = 1;
itaup = itauq + *n;
nwork = itaup + *n;
/* Bidiagonalize A
(CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB)
(RWorkspace: need N) */
nb = ilaenv_(&c__1, "ZGEBRD", " ", m, n, &c_n1, &c_n1, (ftnlen)6,
(ftnlen)1);
latime_1.ops += dopla_("ZGEBRD", m, n, &c__0, &c__0, &nb);
i__1 = *lwork - nwork + 1;
zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
&work[itaup], &work[nwork], &i__1, &ierr);
if (wntqn) {
/* Compute singular values only
(Cworkspace: 0)
(Rworkspace: need BDSPAC) */
dbdsdc_("U", "N", n, &s[1], &rwork[ie], dum, &c__1, dum, &
c__1, dum, idum, &rwork[nrwork], &iwork[1], info);
} else if (wntqo) {
iu = nwork;
iru = nrwork;
irvt = iru + *n * *n;
nrwork = irvt + *n * *n;
if (*lwork >= *m * *n + *n * 3) {
/* WORK( IU ) is M by N */
ldwrku = *m;
} else {
/* WORK( IU ) is LDWRKU by N */
ldwrku = (*lwork - *n * 3) / *n;
}
nwork = iu + ldwrku * *n;
/* Perform bidiagonal SVD, computing left singular vectors
of bidiagonal matrix in RWORK(IRU) and computing right
singular vectors of bidiagonal matrix in RWORK(IRVT)
(CWorkspace: need 0)
(RWorkspace: need BDSPAC) */
dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
info);
/* Copy real matrix RWORK(IRVT) to complex matrix VT
Overwrite VT by right singular vectors of A
(Cworkspace: need 2*N, prefer N+N*NB)
(Rworkspace: need 0) */
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -