232 integer u1_dim1, u1_offset, u2_dim1, u2_offset, v1t_dim1, v1t_offset, x11_dim1, x11_offset, x21_dim1, x21_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9;
234 integer lworkmin, lworkopt, i__, j, r__, childinfo, lorglqmin, lorgqrmin, lorglqopt, lorgqropt, ib11d, ib11e, ib12d, ib12e, ib21d, ib21e, ib22d, ib22e, iphi;
235 extern logical lsame_(
char *,
char *);
238 integer itaup1, itaup2, itauq1;
258 int sorbdb1_(), sorbdb2_(), sorbdb3_(), sorbdb4_() ;
283 x11_offset = 1 + x11_dim1;
286 x21_offset = 1 + x21_dim1;
290 u1_offset = 1 + u1_dim1;
293 u2_offset = 1 + u2_dim1;
296 v1t_offset = 1 + v1t_dim1;
302 wantu1 = lsame_(jobu1,
"Y");
303 wantu2 = lsame_(jobu2,
"Y");
304 wantv1t = lsame_(jobv1t,
"Y");
305 lquery = *lwork == -1;
310 else if (*p < 0 || *p > *m)
314 else if (*q < 0 || *q > *m)
318 else if (*ldx11 < max(1,*p))
327 if (*ldx21 < max(i__1,i__2))
331 else if (wantu1 && *ldu1 < *p)
335 else if (wantu2 && *ldu2 < *m - *p)
339 else if (wantv1t && *ldv1t < *q)
345 i__1 = *p, i__2 = *m - *p, i__1 = min(i__1,i__2);
348 r__ = min(i__1,i__2);
372 ib11d = iphi + max(i__1,i__2);
373 ib11e = ib11d + max(1,r__);
377 ib12d = ib11e + max(i__1,i__2);
378 ib12e = ib12d + max(1,r__);
382 ib21d = ib12e + max(i__1,i__2);
383 ib21e = ib21d + max(1,r__);
387 ib22d = ib21e + max(i__1,i__2);
388 ib22e = ib22d + max(1,r__);
392 ibbcsd = ib22e + max(i__1,i__2);
396 itaup1 = iphi + max(i__1,i__2);
397 itaup2 = itaup1 + max(1,*p);
401 itauq1 = itaup2 + max(i__1,i__2);
402 iorbdb = itauq1 + max(1,*q);
403 iorgqr = itauq1 + max(1,*q);
404 iorglq = itauq1 + max(1,*q);
407 sorbdb1_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo);
411 sorgqr_fla(p, p, q, &u1[u1_offset], ldu1, (
real*)&c__0, &work[1], &c_n1, &childinfo);
412 lorgqrmin = max(1,*p);
419 sorgqr_fla(&i__1, &i__2, q, &u2[u2_offset], ldu2, (
real*)&c__0, &work[1] , &c_n1, &childinfo);
423 lorgqrmin = max(i__1,i__2);
429 i__1 = max(i__2,i__3);
433 i__4 = max(i__5,i__6);
437 i__7 = max(i__8,i__9);
438 sorglq_fla(&i__1, &i__4, &i__7, &v1t[v1t_offset], ldv1t, (
real*)&c__0, & work[1], &c_n1, &childinfo);
442 lorglqmin = max(i__1,i__2);
444 sbbcsd_(jobu1, jobu2, jobv1t,
"N",
"N", m, p, q, &theta[1], &c__0, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, &c__0, &c__1, &c__0, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, & childinfo);
449 sorbdb2_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo);
451 if (*p - 1 >= *m - *p)
456 sorgqr_fla(&i__1, &i__2, &i__3, &u1[(u1_dim1 << 1) + 2], ldu1, (
real*)&c__0, &work[1], &c_n1, &childinfo);
460 lorgqrmin = max(i__1,i__2);
467 sorgqr_fla(&i__1, &i__2, q, &u2[u2_offset], ldu2, (
real*)&c__0, &work[1] , &c_n1, &childinfo);
471 lorgqrmin = max(i__1,i__2);
474 sorglq_fla(q, q, &r__, &v1t[v1t_offset], ldv1t, (
real*)&c__0, &work[1], & c_n1, &childinfo);
475 lorglqmin = max(1,*q);
477 sbbcsd_(jobv1t,
"N", jobu1, jobu2,
"T", m, q, p, &theta[1], &c__0, &v1t[v1t_offset], ldv1t, &c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &c__0, &c__0, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, &childinfo);
480 else if (r__ == *m - *p)
482 sorbdb3_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &work[1], & c_n1, &childinfo);
484 if (*p >= *m - *p - 1)
486 sorgqr_fla(p, p, q, &u1[u1_offset], ldu1, (
real*)&c__0, &work[1], &c_n1, &childinfo);
487 lorgqrmin = max(1,*p);
495 sorgqr_fla(&i__1, &i__2, &i__3, &u2[(u2_dim1 << 1) + 2], ldu2, (
real*)&c__0, &work[1], &c_n1, &childinfo);
499 lorgqrmin = max(i__1,i__2);
502 sorglq_fla(q, q, &r__, &v1t[v1t_offset], ldv1t, (
real*)&c__0, &work[1], & c_n1, &childinfo);
503 lorglqmin = max(1,*q);
507 sbbcsd_(
"N", jobv1t, jobu2, jobu1,
"T", m, &i__1, &i__2, &theta[1] , &c__0, &c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, &c__0, &c__0, & c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, &childinfo);
512 sorbdb4_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, &theta[1], &c__0, &c__0, &c__0, &c__0, &c__0, & work[1], &c_n1, &childinfo);
513 lorbdb = *m + (
integer) work[1];
517 sorgqr_fla(p, p, &i__1, &u1[u1_offset], ldu1, (
real*)&c__0, &work[1], & c_n1, &childinfo);
518 lorgqrmin = max(1,*p);
526 sorgqr_fla(&i__1, &i__2, &i__3, &u2[u2_offset], ldu2, (
real*)&c__0, & work[1], &c_n1, &childinfo);
530 lorgqrmin = max(i__1,i__2);
533 sorglq_fla(q, q, q, &v1t[v1t_offset], ldv1t, (
real*)&c__0, &work[1], &c_n1, &childinfo);
534 lorglqmin = max(1,*q);
538 sbbcsd_(jobu2, jobu1,
"N", jobv1t,
"N", m, &i__1, &i__2, &theta[1] , &c__0, &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, & c__0, &c__1, &v1t[v1t_offset], ldv1t, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &c__0, &work[1], &c_n1, & childinfo);
542 i__1 = iorbdb + lorbdb - 1, i__2 = iorgqr + lorgqrmin - 1, i__1 = max( i__1,i__2), i__2 = iorglq + lorglqmin - 1;
543 i__1 = max(i__1, i__2);
544 i__2 = ibbcsd + lbbcsd - 1;
545 lworkmin = max(i__1,i__2);
547 i__1 = iorbdb + lorbdb - 1, i__2 = iorgqr + lorgqropt - 1, i__1 = max( i__1,i__2), i__2 = iorglq + lorglqopt - 1;
548 i__1 = max(i__1, i__2);
549 i__2 = ibbcsd + lbbcsd - 1;
550 lworkopt = max(i__1,i__2);
551 work[1] = (
real) lworkopt;
552 if (*lwork < lworkmin && ! lquery)
560 xerbla_(
"SORCSD2BY1", &i__1);
567 lorgqr = *lwork - iorgqr + 1;
568 lorglq = *lwork - iorglq + 1;
575 sorbdb1_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, & theta[1], &work[iphi], &work[itaup1], &work[itaup2], &work[ itauq1], &work[iorbdb], &lorbdb, &childinfo);
577 if (wantu1 && *p > 0)
579 slacpy_(
"L", p, q, &x11[x11_offset], ldx11, &u1[u1_offset], ldu1);
580 sorgqr_fla(p, p, q, &u1[u1_offset], ldu1, &work[itaup1], &work[ iorgqr], &lorgqr, &childinfo);
582 if (wantu2 && *m - *p > 0)
585 slacpy_(
"L", &i__1, q, &x21[x21_offset], ldx21, &u2[u2_offset], ldu2);
588 sorgqr_fla(&i__1, &i__2, q, &u2[u2_offset], ldu2, &work[itaup2], & work[iorgqr], &lorgqr, &childinfo);
590 if (wantv1t && *q > 0)
592 v1t[v1t_dim1 + 1] = 1.f;
598 v1t[j * v1t_dim1 + 1] = 0.f;
599 v1t[j + v1t_dim1] = 0.f;
603 slacpy_(
"U", &i__1, &i__2, &x21[(x21_dim1 << 1) + 1], ldx21, &v1t[ (v1t_dim1 << 1) + 2], ldv1t);
607 sorglq_fla(&i__1, &i__2, &i__3, &v1t[(v1t_dim1 << 1) + 2], ldv1t, & work[itauq1], &work[iorglq], &lorglq, &childinfo);
610 sbbcsd_(jobu1, jobu2, jobv1t,
"N",
"N", m, p, q, &theta[1], &work[ iphi], &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &v1t[ v1t_offset], ldv1t, &c__0, &c__1, &work[ib11d], &work[ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo);
613 if (*q > 0 && wantu2)
620 iwork[i__] = *m - *p - *q + i__;
627 iwork[i__] = i__ - *q;
631 slapmt_(&c_false, &i__1, &i__2, &u2[u2_offset], ldu2, &iwork[1]);
638 sorbdb2_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, & theta[1], &work[iphi], &work[itaup1], &work[itaup2], &work[ itauq1], &work[iorbdb], &lorbdb, &childinfo);
640 if (wantu1 && *p > 0)
642 u1[u1_dim1 + 1] = 1.f;
648 u1[j * u1_dim1 + 1] = 0.f;
649 u1[j + u1_dim1] = 0.f;
653 slacpy_(
"L", &i__1, &i__2, &x11[x11_dim1 + 2], ldx11, &u1[( u1_dim1 << 1) + 2], ldu1);
657 sorgqr_fla(&i__1, &i__2, &i__3, &u1[(u1_dim1 << 1) + 2], ldu1, &work[ itaup1], &work[iorgqr], &lorgqr, &childinfo);
659 if (wantu2 && *m - *p > 0)
662 slacpy_(
"L", &i__1, q, &x21[x21_offset], ldx21, &u2[u2_offset], ldu2);
665 sorgqr_fla(&i__1, &i__2, q, &u2[u2_offset], ldu2, &work[itaup2], & work[iorgqr], &lorgqr, &childinfo);
667 if (wantv1t && *q > 0)
669 slacpy_(
"U", p, q, &x11[x11_offset], ldx11, &v1t[v1t_offset], ldv1t);
670 sorglq_fla(q, q, &r__, &v1t[v1t_offset], ldv1t, &work[itauq1], &work[ iorglq], &lorglq, &childinfo);
673 sbbcsd_(jobv1t,
"N", jobu1, jobu2,
"T", m, q, p, &theta[1], &work[ iphi], &v1t[v1t_offset], ldv1t, &c__0, &c__1, &u1[u1_offset], ldu1, &u2[u2_offset], ldu2, &work[ib11d], &work[ib11e], &work[ ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ib22d] , &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo);
676 if (*q > 0 && wantu2)
683 iwork[i__] = *m - *p - *q + i__;
690 iwork[i__] = i__ - *q;
694 slapmt_(&c_false, &i__1, &i__2, &u2[u2_offset], ldu2, &iwork[1]);
697 else if (r__ == *m - *p)
701 sorbdb3_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, & theta[1], &work[iphi], &work[itaup1], &work[itaup2], &work[ itauq1], &work[iorbdb], &lorbdb, &childinfo);
703 if (wantu1 && *p > 0)
705 slacpy_(
"L", p, q, &x11[x11_offset], ldx11, &u1[u1_offset], ldu1);
706 sorgqr_fla(p, p, q, &u1[u1_offset], ldu1, &work[itaup1], &work[ iorgqr], &lorgqr, &childinfo);
708 if (wantu2 && *m - *p > 0)
710 u2[u2_dim1 + 1] = 1.f;
716 u2[j * u2_dim1 + 1] = 0.f;
717 u2[j + u2_dim1] = 0.f;
721 slacpy_(
"L", &i__1, &i__2, &x21[x21_dim1 + 2], ldx21, &u2[( u2_dim1 << 1) + 2], ldu2);
725 sorgqr_fla(&i__1, &i__2, &i__3, &u2[(u2_dim1 << 1) + 2], ldu2, &work[ itaup2], &work[iorgqr], &lorgqr, &childinfo);
727 if (wantv1t && *q > 0)
730 slacpy_(
"U", &i__1, q, &x21[x21_offset], ldx21, &v1t[v1t_offset], ldv1t);
731 sorglq_fla(q, q, &r__, &v1t[v1t_offset], ldv1t, &work[itauq1], &work[ iorglq], &lorglq, &childinfo);
736 sbbcsd_(
"N", jobv1t, jobu2, jobu1,
"T", m, &i__1, &i__2, &theta[1], & work[iphi], &c__0, &c__1, &v1t[v1t_offset], ldv1t, &u2[ u2_offset], ldu2, &u1[u1_offset], ldu1, &work[ib11d], &work[ ib11e], &work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e] , &work[ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, & childinfo);
746 iwork[i__] = *q - r__ + i__;
753 iwork[i__] = i__ - r__;
757 slapmt_(&c_false, p, q, &u1[u1_offset], ldu1, &iwork[1]);
761 slapmr_(&c_false, q, q, &v1t[v1t_offset], ldv1t, &iwork[1]);
770 sorbdb4_(m, p, q, &x11[x11_offset], ldx11, &x21[x21_offset], ldx21, & theta[1], &work[iphi], &work[itaup1], &work[itaup2], &work[ itauq1], &work[iorbdb], &work[iorbdb + *m], &i__1, &childinfo) ;
772 if (wantu1 && *p > 0)
774 scopy_(p, &work[iorbdb], &c__1, &u1[u1_offset], &c__1);
780 u1[j * u1_dim1 + 1] = 0.f;
784 slacpy_(
"L", &i__1, &i__2, &x11[x11_dim1 + 2], ldx11, &u1[( u1_dim1 << 1) + 2], ldu1);
786 sorgqr_fla(p, p, &i__1, &u1[u1_offset], ldu1, &work[itaup1], &work[ iorgqr], &lorgqr, &childinfo);
788 if (wantu2 && *m - *p > 0)
791 scopy_(&i__1, &work[iorbdb + *p], &c__1, &u2[u2_offset], &c__1);
797 u2[j * u2_dim1 + 1] = 0.f;
801 slacpy_(
"L", &i__1, &i__2, &x21[x21_dim1 + 2], ldx21, &u2[( u2_dim1 << 1) + 2], ldu2);
805 sorgqr_fla(&i__1, &i__2, &i__3, &u2[u2_offset], ldu2, &work[itaup2], &work[iorgqr], &lorgqr, &childinfo);
807 if (wantv1t && *q > 0)
810 slacpy_(
"U", &i__1, q, &x21[x21_offset], ldx21, &v1t[v1t_offset], ldv1t);
811 i__1 = *p - (*m - *q);
812 i__2 = *q - (*m - *q);
813 slacpy_(
"U", &i__1, &i__2, &x11[*m - *q + 1 + (*m - *q + 1) * x11_dim1], ldx11, &v1t[*m - *q + 1 + (*m - *q + 1) * v1t_dim1], ldv1t);
816 slacpy_(
"U", &i__1, &i__2, &x21[*m - *q + 1 + (*p + 1) * x21_dim1] , ldx21, &v1t[*p + 1 + (*p + 1) * v1t_dim1], ldv1t);
817 sorglq_fla(q, q, q, &v1t[v1t_offset], ldv1t, &work[itauq1], &work[ iorglq], &lorglq, &childinfo);
822 sbbcsd_(jobu2, jobu1,
"N", jobv1t,
"N", m, &i__1, &i__2, &theta[1], & work[iphi], &u2[u2_offset], ldu2, &u1[u1_offset], ldu1, &c__0, &c__1, &v1t[v1t_offset], ldv1t, &work[ib11d], &work[ib11e], & work[ib12d], &work[ib12e], &work[ib21d], &work[ib21e], &work[ ib22d], &work[ib22e], &work[ibbcsd], &lbbcsd, &childinfo);
832 iwork[i__] = *p - r__ + i__;
839 iwork[i__] = i__ - r__;
843 slapmt_(&c_false, p, p, &u1[u1_offset], ldu1, &iwork[1]);
847 slapmr_(&c_false, p, q, &v1t[v1t_offset], ldv1t, &iwork[1]);
int integer
Definition: FLA_f2c.h:25
int logical
Definition: FLA_f2c.h:36
float real
Definition: FLA_f2c.h:30
int sorglq_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *work, integer *lwork, integer *info)
Definition: sorglq.c:122
int sorgqr_fla(integer *m, integer *n, integer *k, real *a, integer *lda, real *tau, real *work, integer *lwork, integer *info)
Definition: sorgqr.c:123