Skip to content

Commit 9d78ff8

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #6204 from martin-frbg/lapack1453
Fix names used by ORBDB/UNBDB in XERBLA calls (Reference-LAPACK PR 1453)
2 parents ee2efef + 5b2043d commit 9d78ff8

12 files changed

Lines changed: 383 additions & 947 deletions

File tree

‎lapack-netlib/SRC/cunbdb.c‎

Lines changed: 58 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -255,8 +255,6 @@ typedef struct Namelist Namelist;
255255
*/
256256

257257

258-
259-
260258
/* Table of constant values */
261259

262260
static integer c__1 = 1;
@@ -268,7 +266,6 @@ static integer c__1 = 1;
268266
/* Online html documentation available at */
269267
/* http://www.netlib.org/lapack/explore-html/ */
270268

271-
/* > \htmlonly */
272269
/* > Download CUNBDB + dependencies */
273270
/* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cunbdb.
274271
f"> */
@@ -279,7 +276,6 @@ f"> */
279276
/* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cunbdb.
280277
f"> */
281278
/* > [TXT]</a> */
282-
/* > \endhtmlonly */
283279

284280
/* Definition: */
285281
/* =========== */
@@ -517,9 +513,7 @@ f"> */
517513
/* > \author Univ. of Colorado Denver */
518514
/* > \author NAG Ltd. */
519515

520-
/* > \date December 2016 */
521-
522-
/* > \ingroup complexOTHERcomputational */
516+
/* > \ingroup unbdb */
523517

524518
/* > \par Further Details: */
525519
/* ===================== */
@@ -554,31 +548,32 @@ f"> */
554548
/* System generated locals */
555549
integer x11_dim1, x11_offset, x12_dim1, x12_offset, x21_dim1, x21_offset,
556550
x22_dim1, x22_offset, i__1, i__2, i__3;
557-
real r__1=0.;
558-
complex q__1={0.,0.};
551+
real r__1;
552+
complex q__1;
559553

560554
/* Local variables */
561555
logical colmajor;
562556
integer lworkmin, lworkopt, i__;
557+
real z1, z2, z3, z4;
563558
extern /* Subroutine */ void cscal_(integer *, complex *, complex *,
564-
integer *), clarf_(char *, integer *, integer *, complex *,
565-
integer *, complex *, complex *, integer *, complex *);
559+
integer *);
566560
extern logical lsame_(char *, char *);
567561
extern /* Subroutine */ void caxpy_(integer *, complex *, complex *,
568562
integer *, complex *, integer *);
569-
real z1, z2, z3, z4;
570563
extern real scnrm2_(integer *, complex *, integer *);
571-
extern /* Subroutine */ void clacgv_(integer *, complex *, integer *);
572-
extern void xerbla_(char *, integer *, ftnlen);
564+
extern /* Subroutine */ void clacgv_(integer *, complex *, integer *),
565+
xerbla_(char *, integer *, ftnlen), clarf1f_(char *, integer *,
566+
integer *, complex *, integer *, complex *, complex *, integer *,
567+
complex *);
573568
logical lquery;
574569
extern /* Subroutine */ void clarfgp_(integer *, complex *, complex *,
575570
integer *, complex *);
571+
extern real sroundup_lwork__(integer *);
576572

577573

578-
/* -- LAPACK computational routine (version 3.7.0) -- */
574+
/* -- LAPACK computational routine -- */
579575
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
580576
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
581-
/* December 2016 */
582577

583578

584579
/* ==================================================================== */
@@ -589,16 +584,16 @@ f"> */
589584

590585
/* Parameter adjustments */
591586
x11_dim1 = *ldx11;
592-
x11_offset = 1 + x11_dim1 * 1;
587+
x11_offset = 1 + x11_dim1;
593588
x11 -= x11_offset;
594589
x12_dim1 = *ldx12;
595-
x12_offset = 1 + x12_dim1 * 1;
590+
x12_offset = 1 + x12_dim1;
596591
x12 -= x12_offset;
597592
x21_dim1 = *ldx21;
598-
x21_offset = 1 + x21_dim1 * 1;
593+
x21_offset = 1 + x21_dim1;
599594
x21 -= x21_offset;
600595
x22_dim1 = *ldx22;
601-
x22_offset = 1 + x22_dim1 * 1;
596+
x22_offset = 1 + x22_dim1;
602597
x22 -= x22_offset;
603598
--theta;
604599
--phi;
@@ -669,14 +664,15 @@ f"> */
669664
if (*info == 0) {
670665
lworkopt = *m - *q;
671666
lworkmin = *m - *q;
672-
work[1].r = (real) lworkopt, work[1].i = 0.f;
667+
r__1 = sroundup_lwork__(&lworkopt);
668+
work[1].r = r__1, work[1].i = 0.f;
673669
if (*lwork < lworkmin && ! lquery) {
674670
*info = -21;
675671
}
676672
}
677673
if (*info != 0) {
678674
i__1 = -(*info);
679-
xerbla_("xORBDB", &i__1, (ftnlen)6);
675+
xerbla_("CUNBDB", &i__1, (ftnlen)6);
680676
return;
681677
} else if (lquery) {
682678
return;
@@ -736,8 +732,6 @@ f"> */
736732
clarfgp_(&i__2, &x11[i__ + i__ * x11_dim1], &x11[i__ + i__ *
737733
x11_dim1], &c__1, &taup1[i__]);
738734
}
739-
i__2 = i__ + i__ * x11_dim1;
740-
x11[i__2].r = 1.f, x11[i__2].i = 0.f;
741735
if (*m - *p > i__) {
742736
i__2 = *m - *p - i__ + 1;
743737
clarfgp_(&i__2, &x21[i__ + i__ * x21_dim1], &x21[i__ + 1 +
@@ -747,34 +741,32 @@ f"> */
747741
clarfgp_(&i__2, &x21[i__ + i__ * x21_dim1], &x21[i__ + i__ *
748742
x21_dim1], &c__1, &taup2[i__]);
749743
}
750-
i__2 = i__ + i__ * x21_dim1;
751-
x21[i__2].r = 1.f, x21[i__2].i = 0.f;
752744

753745
if (*q > i__) {
754746
i__2 = *p - i__ + 1;
755747
i__3 = *q - i__;
756748
r_cnjg(&q__1, &taup1[i__]);
757-
clarf_("L", &i__2, &i__3, &x11[i__ + i__ * x11_dim1], &c__1, &
758-
q__1, &x11[i__ + (i__ + 1) * x11_dim1], ldx11, &work[
759-
1]);
749+
clarf1f_("L", &i__2, &i__3, &x11[i__ + i__ * x11_dim1], &c__1,
750+
&q__1, &x11[i__ + (i__ + 1) * x11_dim1], ldx11, &
751+
work[1]);
760752
i__2 = *m - *p - i__ + 1;
761753
i__3 = *q - i__;
762754
r_cnjg(&q__1, &taup2[i__]);
763-
clarf_("L", &i__2, &i__3, &x21[i__ + i__ * x21_dim1], &c__1, &
764-
q__1, &x21[i__ + (i__ + 1) * x21_dim1], ldx21, &work[
765-
1]);
755+
clarf1f_("L", &i__2, &i__3, &x21[i__ + i__ * x21_dim1], &c__1,
756+
&q__1, &x21[i__ + (i__ + 1) * x21_dim1], ldx21, &
757+
work[1]);
766758
}
767759
if (*m - *q + 1 > i__) {
768760
i__2 = *p - i__ + 1;
769761
i__3 = *m - *q - i__ + 1;
770762
r_cnjg(&q__1, &taup1[i__]);
771-
clarf_("L", &i__2, &i__3, &x11[i__ + i__ * x11_dim1], &c__1, &
772-
q__1, &x12[i__ + i__ * x12_dim1], ldx12, &work[1]);
763+
clarf1f_("L", &i__2, &i__3, &x11[i__ + i__ * x11_dim1], &c__1,
764+
&q__1, &x12[i__ + i__ * x12_dim1], ldx12, &work[1]);
773765
i__2 = *m - *p - i__ + 1;
774766
i__3 = *m - *q - i__ + 1;
775767
r_cnjg(&q__1, &taup2[i__]);
776-
clarf_("L", &i__2, &i__3, &x21[i__ + i__ * x21_dim1], &c__1, &
777-
q__1, &x22[i__ + i__ * x22_dim1], ldx22, &work[1]);
768+
clarf1f_("L", &i__2, &i__3, &x21[i__ + i__ * x21_dim1], &c__1,
769+
&q__1, &x22[i__ + i__ * x22_dim1], ldx22, &work[1]);
778770
}
779771

780772
if (i__ < *q) {
@@ -818,8 +810,6 @@ f"> */
818810
clarfgp_(&i__2, &x11[i__ + (i__ + 1) * x11_dim1], &x11[
819811
i__ + (i__ + 2) * x11_dim1], ldx11, &tauq1[i__]);
820812
}
821-
i__2 = i__ + (i__ + 1) * x11_dim1;
822-
x11[i__2].r = 1.f, x11[i__2].i = 0.f;
823813
}
824814
if (*m - *q + 1 > i__) {
825815
i__2 = *m - *q - i__ + 1;
@@ -834,33 +824,31 @@ f"> */
834824
i__ + 1) * x12_dim1], ldx12, &tauq2[i__]);
835825
}
836826
}
837-
i__2 = i__ + i__ * x12_dim1;
838-
x12[i__2].r = 1.f, x12[i__2].i = 0.f;
839827

840828
if (i__ < *q) {
841829
i__2 = *p - i__;
842830
i__3 = *q - i__;
843-
clarf_("R", &i__2, &i__3, &x11[i__ + (i__ + 1) * x11_dim1],
831+
clarf1f_("R", &i__2, &i__3, &x11[i__ + (i__ + 1) * x11_dim1],
844832
ldx11, &tauq1[i__], &x11[i__ + 1 + (i__ + 1) *
845833
x11_dim1], ldx11, &work[1]);
846834
i__2 = *m - *p - i__;
847835
i__3 = *q - i__;
848-
clarf_("R", &i__2, &i__3, &x11[i__ + (i__ + 1) * x11_dim1],
836+
clarf1f_("R", &i__2, &i__3, &x11[i__ + (i__ + 1) * x11_dim1],
849837
ldx11, &tauq1[i__], &x21[i__ + 1 + (i__ + 1) *
850838
x21_dim1], ldx21, &work[1]);
851839
}
852840
if (*p > i__) {
853841
i__2 = *p - i__;
854842
i__3 = *m - *q - i__ + 1;
855-
clarf_("R", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], ldx12, &
856-
tauq2[i__], &x12[i__ + 1 + i__ * x12_dim1], ldx12, &
843+
clarf1f_("R", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], ldx12,
844+
&tauq2[i__], &x12[i__ + 1 + i__ * x12_dim1], ldx12, &
857845
work[1]);
858846
}
859847
if (*m - *p > i__) {
860848
i__2 = *m - *p - i__;
861849
i__3 = *m - *q - i__ + 1;
862-
clarf_("R", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], ldx12, &
863-
tauq2[i__], &x22[i__ + 1 + i__ * x22_dim1], ldx22, &
850+
clarf1f_("R", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], ldx12,
851+
&tauq2[i__], &x22[i__ + 1 + i__ * x22_dim1], ldx22, &
864852
work[1]);
865853
}
866854

@@ -893,21 +881,19 @@ f"> */
893881
clarfgp_(&i__2, &x12[i__ + i__ * x12_dim1], &x12[i__ + (i__ +
894882
1) * x12_dim1], ldx12, &tauq2[i__]);
895883
}
896-
i__2 = i__ + i__ * x12_dim1;
897-
x12[i__2].r = 1.f, x12[i__2].i = 0.f;
898884

899885
if (*p > i__) {
900886
i__2 = *p - i__;
901887
i__3 = *m - *q - i__ + 1;
902-
clarf_("R", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], ldx12, &
903-
tauq2[i__], &x12[i__ + 1 + i__ * x12_dim1], ldx12, &
888+
clarf1f_("R", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], ldx12,
889+
&tauq2[i__], &x12[i__ + 1 + i__ * x12_dim1], ldx12, &
904890
work[1]);
905891
}
906892
if (*m - *p - *q >= 1) {
907893
i__2 = *m - *p - *q;
908894
i__3 = *m - *q - i__ + 1;
909-
clarf_("R", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], ldx12, &
910-
tauq2[i__], &x22[*q + 1 + i__ * x22_dim1], ldx22, &
895+
clarf1f_("R", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], ldx12,
896+
&tauq2[i__], &x22[*q + 1 + i__ * x22_dim1], ldx22, &
911897
work[1]);
912898
}
913899

@@ -932,13 +918,11 @@ f"> */
932918
clarfgp_(&i__2, &x22[*q + i__ + (*p + i__) * x22_dim1], &x22[*q +
933919
i__ + (*p + i__ + 1) * x22_dim1], ldx22, &tauq2[*p + i__])
934920
;
935-
i__2 = *q + i__ + (*p + i__) * x22_dim1;
936-
x22[i__2].r = 1.f, x22[i__2].i = 0.f;
937921
i__2 = *m - *p - *q - i__;
938922
i__3 = *m - *p - *q - i__ + 1;
939-
clarf_("R", &i__2, &i__3, &x22[*q + i__ + (*p + i__) * x22_dim1],
940-
ldx22, &tauq2[*p + i__], &x22[*q + i__ + 1 + (*p + i__) *
941-
x22_dim1], ldx22, &work[1]);
923+
clarf1f_("R", &i__2, &i__3, &x22[*q + i__ + (*p + i__) * x22_dim1]
924+
, ldx22, &tauq2[*p + i__], &x22[*q + i__ + 1 + (*p + i__)
925+
* x22_dim1], ldx22, &work[1]);
942926

943927
i__2 = *m - *p - *q - i__ + 1;
944928
clacgv_(&i__2, &x22[*q + i__ + (*p + i__) * x22_dim1], ldx22);
@@ -997,8 +981,6 @@ f"> */
997981
i__2 = *p - i__ + 1;
998982
clarfgp_(&i__2, &x11[i__ + i__ * x11_dim1], &x11[i__ + (i__ + 1) *
999983
x11_dim1], ldx11, &taup1[i__]);
1000-
i__2 = i__ + i__ * x11_dim1;
1001-
x11[i__2].r = 1.f, x11[i__2].i = 0.f;
1002984
if (i__ == *m - *p) {
1003985
i__2 = *m - *p - i__ + 1;
1004986
clarfgp_(&i__2, &x21[i__ + i__ * x21_dim1], &x21[i__ + i__ *
@@ -1008,26 +990,24 @@ f"> */
1008990
clarfgp_(&i__2, &x21[i__ + i__ * x21_dim1], &x21[i__ + (i__ +
1009991
1) * x21_dim1], ldx21, &taup2[i__]);
1010992
}
1011-
i__2 = i__ + i__ * x21_dim1;
1012-
x21[i__2].r = 1.f, x21[i__2].i = 0.f;
1013993

1014994
i__2 = *q - i__;
1015995
i__3 = *p - i__ + 1;
1016-
clarf_("R", &i__2, &i__3, &x11[i__ + i__ * x11_dim1], ldx11, &
996+
clarf1f_("R", &i__2, &i__3, &x11[i__ + i__ * x11_dim1], ldx11, &
1017997
taup1[i__], &x11[i__ + 1 + i__ * x11_dim1], ldx11, &work[
1018998
1]);
1019999
i__2 = *m - *q - i__ + 1;
10201000
i__3 = *p - i__ + 1;
1021-
clarf_("R", &i__2, &i__3, &x11[i__ + i__ * x11_dim1], ldx11, &
1001+
clarf1f_("R", &i__2, &i__3, &x11[i__ + i__ * x11_dim1], ldx11, &
10221002
taup1[i__], &x12[i__ + i__ * x12_dim1], ldx12, &work[1]);
10231003
i__2 = *q - i__;
10241004
i__3 = *m - *p - i__ + 1;
1025-
clarf_("R", &i__2, &i__3, &x21[i__ + i__ * x21_dim1], ldx21, &
1005+
clarf1f_("R", &i__2, &i__3, &x21[i__ + i__ * x21_dim1], ldx21, &
10261006
taup2[i__], &x21[i__ + 1 + i__ * x21_dim1], ldx21, &work[
10271007
1]);
10281008
i__2 = *m - *q - i__ + 1;
10291009
i__3 = *m - *p - i__ + 1;
1030-
clarf_("R", &i__2, &i__3, &x21[i__ + i__ * x21_dim1], ldx21, &
1010+
clarf1f_("R", &i__2, &i__3, &x21[i__ + i__ * x21_dim1], ldx21, &
10311011
taup2[i__], &x22[i__ + i__ * x22_dim1], ldx22, &work[1]);
10321012

10331013
i__2 = *p - i__ + 1;
@@ -1068,41 +1048,37 @@ f"> */
10681048
i__2 = *q - i__;
10691049
clarfgp_(&i__2, &x11[i__ + 1 + i__ * x11_dim1], &x11[i__ + 2
10701050
+ i__ * x11_dim1], &c__1, &tauq1[i__]);
1071-
i__2 = i__ + 1 + i__ * x11_dim1;
1072-
x11[i__2].r = 1.f, x11[i__2].i = 0.f;
10731051
}
10741052
i__2 = *m - *q - i__ + 1;
10751053
clarfgp_(&i__2, &x12[i__ + i__ * x12_dim1], &x12[i__ + 1 + i__ *
10761054
x12_dim1], &c__1, &tauq2[i__]);
1077-
i__2 = i__ + i__ * x12_dim1;
1078-
x12[i__2].r = 1.f, x12[i__2].i = 0.f;
10791055

10801056
if (i__ < *q) {
10811057
i__2 = *q - i__;
10821058
i__3 = *p - i__;
10831059
r_cnjg(&q__1, &tauq1[i__]);
1084-
clarf_("L", &i__2, &i__3, &x11[i__ + 1 + i__ * x11_dim1], &
1060+
clarf1f_("L", &i__2, &i__3, &x11[i__ + 1 + i__ * x11_dim1], &
10851061
c__1, &q__1, &x11[i__ + 1 + (i__ + 1) * x11_dim1],
10861062
ldx11, &work[1]);
10871063
i__2 = *q - i__;
10881064
i__3 = *m - *p - i__;
10891065
r_cnjg(&q__1, &tauq1[i__]);
1090-
clarf_("L", &i__2, &i__3, &x11[i__ + 1 + i__ * x11_dim1], &
1066+
clarf1f_("L", &i__2, &i__3, &x11[i__ + 1 + i__ * x11_dim1], &
10911067
c__1, &q__1, &x21[i__ + 1 + (i__ + 1) * x21_dim1],
10921068
ldx21, &work[1]);
10931069
}
10941070
i__2 = *m - *q - i__ + 1;
10951071
i__3 = *p - i__;
10961072
r_cnjg(&q__1, &tauq2[i__]);
1097-
clarf_("L", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], &c__1, &
1073+
clarf1f_("L", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], &c__1, &
10981074
q__1, &x12[i__ + (i__ + 1) * x12_dim1], ldx12, &work[1]);
10991075
if (*m - *p > i__) {
11001076
i__2 = *m - *q - i__ + 1;
11011077
i__3 = *m - *p - i__;
11021078
r_cnjg(&q__1, &tauq2[i__]);
1103-
clarf_("L", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], &c__1, &
1104-
q__1, &x22[i__ + (i__ + 1) * x22_dim1], ldx22, &work[
1105-
1]);
1079+
clarf1f_("L", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], &c__1,
1080+
&q__1, &x22[i__ + (i__ + 1) * x22_dim1], ldx22, &
1081+
work[1]);
11061082
}
11071083
}
11081084

@@ -1118,24 +1094,22 @@ f"> */
11181094
i__2 = *m - *q - i__ + 1;
11191095
clarfgp_(&i__2, &x12[i__ + i__ * x12_dim1], &x12[i__ + 1 + i__ *
11201096
x12_dim1], &c__1, &tauq2[i__]);
1121-
i__2 = i__ + i__ * x12_dim1;
1122-
x12[i__2].r = 1.f, x12[i__2].i = 0.f;
11231097

11241098
if (*p > i__) {
11251099
i__2 = *m - *q - i__ + 1;
11261100
i__3 = *p - i__;
11271101
r_cnjg(&q__1, &tauq2[i__]);
1128-
clarf_("L", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], &c__1, &
1129-
q__1, &x12[i__ + (i__ + 1) * x12_dim1], ldx12, &work[
1130-
1]);
1102+
clarf1f_("L", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], &c__1,
1103+
&q__1, &x12[i__ + (i__ + 1) * x12_dim1], ldx12, &
1104+
work[1]);
11311105
}
11321106
if (*m - *p - *q >= 1) {
11331107
i__2 = *m - *q - i__ + 1;
11341108
i__3 = *m - *p - *q;
11351109
r_cnjg(&q__1, &tauq2[i__]);
1136-
clarf_("L", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], &c__1, &
1137-
q__1, &x22[i__ + (*q + 1) * x22_dim1], ldx22, &work[1]
1138-
);
1110+
clarf1f_("L", &i__2, &i__3, &x12[i__ + i__ * x12_dim1], &c__1,
1111+
&q__1, &x22[i__ + (*q + 1) * x22_dim1], ldx22, &work[
1112+
1]);
11391113
}
11401114

11411115
}
@@ -1154,13 +1128,11 @@ f"> */
11541128
clarfgp_(&i__2, &x22[*p + i__ + (*q + i__) * x22_dim1], &x22[*p +
11551129
i__ + 1 + (*q + i__) * x22_dim1], &c__1, &tauq2[*p + i__])
11561130
;
1157-
i__2 = *p + i__ + (*q + i__) * x22_dim1;
1158-
x22[i__2].r = 1.f, x22[i__2].i = 0.f;
11591131
if (*m - *p - *q != i__) {
11601132
i__2 = *m - *p - *q - i__ + 1;
11611133
i__3 = *m - *p - *q - i__;
11621134
r_cnjg(&q__1, &tauq2[*p + i__]);
1163-
clarf_("L", &i__2, &i__3, &x22[*p + i__ + (*q + i__) *
1135+
clarf1f_("L", &i__2, &i__3, &x22[*p + i__ + (*q + i__) *
11641136
x22_dim1], &c__1, &q__1, &x22[*p + i__ + (*q + i__ +
11651137
1) * x22_dim1], ldx22, &work[1]);
11661138
}

0 commit comments

Comments
 (0)