00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 struct {
00019 integer infot, nout;
00020 logical ok, lerr;
00021 } infoc_;
00022
00023 #define infoc_1 infoc_
00024
00025 struct {
00026 char srnamt[32];
00027 } srnamc_;
00028
00029 #define srnamc_1 srnamc_
00030
00031
00032
00033 static integer c__2 = 2;
00034 static integer c_n1 = -1;
00035 static integer c__0 = 0;
00036 static integer c__1 = 1;
00037 static integer c__3 = 3;
00038
00039 int serrqp_(char *path, integer *nunit)
00040 {
00041
00042 integer i__1;
00043
00044
00045 integer s_wsle(cilist *), e_wsle(void);
00046 int s_copy(char *, char *, ftnlen, ftnlen);
00047
00048
00049 real a[9] , w[10];
00050 char c2[2];
00051 integer ip[3], lw;
00052 real tau[3];
00053 integer info;
00054 extern int sgeqp3_(integer *, integer *, real *, integer
00055 *, integer *, real *, real *, integer *, integer *), alaesm_(char
00056 *, logical *, integer *);
00057 extern logical lsamen_(integer *, char *, char *);
00058 extern int chkxer_(char *, integer *, integer *, logical
00059 *, logical *), sgeqpf_(integer *, integer *, real *,
00060 integer *, integer *, real *, real *, integer *);
00061
00062
00063 static cilist io___1 = { 0, 0, 0, 0, 0 };
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106 infoc_1.nout = *nunit;
00107 io___1.ciunit = infoc_1.nout;
00108 s_wsle(&io___1);
00109 e_wsle();
00110 s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00111 lw = 10;
00112 a[0] = 1.f;
00113 a[3] = 2.f;
00114 a[4] = 3.f;
00115 a[1] = 4.f;
00116 infoc_1.ok = TRUE_;
00117
00118 if (lsamen_(&c__2, c2, "QP")) {
00119
00120
00121
00122
00123
00124 s_copy(srnamc_1.srnamt, "SGEQPF", (ftnlen)32, (ftnlen)6);
00125 infoc_1.infot = 1;
00126 sgeqpf_(&c_n1, &c__0, a, &c__1, ip, tau, w, &info);
00127 chkxer_("SGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00128 infoc_1.ok);
00129 infoc_1.infot = 2;
00130 sgeqpf_(&c__0, &c_n1, a, &c__1, ip, tau, w, &info);
00131 chkxer_("SGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00132 infoc_1.ok);
00133 infoc_1.infot = 4;
00134 sgeqpf_(&c__2, &c__0, a, &c__1, ip, tau, w, &info);
00135 chkxer_("SGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00136 infoc_1.ok);
00137
00138
00139
00140 s_copy(srnamc_1.srnamt, "SGEQP3", (ftnlen)32, (ftnlen)6);
00141 infoc_1.infot = 1;
00142 sgeqp3_(&c_n1, &c__0, a, &c__1, ip, tau, w, &lw, &info);
00143 chkxer_("SGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00144 infoc_1.ok);
00145 infoc_1.infot = 2;
00146 sgeqp3_(&c__1, &c_n1, a, &c__1, ip, tau, w, &lw, &info);
00147 chkxer_("SGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00148 infoc_1.ok);
00149 infoc_1.infot = 4;
00150 sgeqp3_(&c__2, &c__3, a, &c__1, ip, tau, w, &lw, &info);
00151 chkxer_("SGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00152 infoc_1.ok);
00153 infoc_1.infot = 8;
00154 i__1 = lw - 10;
00155 sgeqp3_(&c__2, &c__2, a, &c__2, ip, tau, w, &i__1, &info);
00156 chkxer_("SGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00157 infoc_1.ok);
00158 }
00159
00160
00161
00162 alaesm_(path, &infoc_1.ok, &infoc_1.nout);
00163
00164 return 0;
00165
00166
00167
00168 }