00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static integer c__8 = 8;
00019 static integer c__1 = 1;
00020 static integer c__0 = 0;
00021
00022 int dcklse_(integer *nn, integer *mval, integer *pval,
00023 integer *nval, integer *nmats, integer *iseed, doublereal *thresh,
00024 integer *nmax, doublereal *a, doublereal *af, doublereal *b,
00025 doublereal *bf, doublereal *x, doublereal *work, doublereal *rwork,
00026 integer *nin, integer *nout, integer *info)
00027 {
00028
00029 static char fmt_9997[] = "(\002 *** Invalid input for LSE: M = \002,"
00030 "i6,\002, P = \002,i6,\002, N = \002,i6,\002;\002,/\002 must "
00031 "satisfy P <= N <= P+M \002,\002(this set of values will be skip"
00032 "ped)\002)";
00033 static char fmt_9999[] = "(\002 DLATMS in DCKLSE INFO = \002,i5)";
00034 static char fmt_9998[] = "(\002 M=\002,i4,\002 P=\002,i4,\002, N=\002,"
00035 "i4,\002, type \002,i2,\002, test \002,i2,\002, ratio=\002,g13.6)";
00036
00037
00038 integer i__1, i__2, i__3, i__4, i__5, i__6, i__7;
00039
00040
00041 int s_copy(char *, char *, ftnlen, ftnlen);
00042 integer s_wsle(cilist *), e_wsle(void), s_wsfe(cilist *), do_fio(integer *
00043 , char *, ftnlen), e_wsfe(void);
00044
00045
00046 integer i__, m, n, p, ik, nt, lda, ldb, kla, klb, kua, kub, imat;
00047 char path[3], type__[1];
00048 integer nrun, modea, modeb, nfail;
00049 char dista[1], distb[1];
00050 integer iinfo;
00051 doublereal anorm, bnorm;
00052 integer lwork;
00053 extern int dlatb9_(char *, integer *, integer *, integer
00054 *, integer *, char *, integer *, integer *, integer *, integer *,
00055 doublereal *, doublereal *, integer *, integer *, doublereal *,
00056 doublereal *, char *, char *),
00057 alahdg_(integer *, char *);
00058 doublereal cndnma, cndnmb;
00059 extern int alareq_(char *, integer *, logical *, integer
00060 *, integer *, integer *), dlarhs_(char *, char *, char *,
00061 char *, integer *, integer *, integer *, integer *, integer *,
00062 doublereal *, integer *, doublereal *, integer *, doublereal *,
00063 integer *, integer *, integer *),
00064 alasum_(char *, integer *, integer *, integer *, integer *), dlatms_(integer *, integer *, char *, integer *, char *,
00065 doublereal *, integer *, doublereal *, doublereal *, integer *,
00066 integer *, char *, doublereal *, integer *, doublereal *, integer
00067 *), dlsets_(integer *, integer *, integer
00068 *, doublereal *, doublereal *, integer *, doublereal *,
00069 doublereal *, integer *, doublereal *, doublereal *, doublereal *,
00070 doublereal *, doublereal *, doublereal *, integer *, doublereal *
00071 , doublereal *);
00072 logical dotype[8], firstt;
00073 doublereal result[7];
00074
00075
00076 static cilist io___13 = { 0, 0, 0, 0, 0 };
00077 static cilist io___14 = { 0, 0, 0, fmt_9997, 0 };
00078 static cilist io___30 = { 0, 0, 0, fmt_9999, 0 };
00079 static cilist io___31 = { 0, 0, 0, fmt_9999, 0 };
00080 static cilist io___35 = { 0, 0, 0, fmt_9998, 0 };
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
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180 --rwork;
00181 --work;
00182 --x;
00183 --bf;
00184 --b;
00185 --af;
00186 --a;
00187 --iseed;
00188 --nval;
00189 --pval;
00190 --mval;
00191
00192
00193 s_copy(path, "LSE", (ftnlen)3, (ftnlen)3);
00194 *info = 0;
00195 nrun = 0;
00196 nfail = 0;
00197 firstt = TRUE_;
00198 alareq_(path, nmats, dotype, &c__8, nin, nout);
00199 lda = *nmax;
00200 ldb = *nmax;
00201 lwork = *nmax * *nmax;
00202
00203
00204
00205 i__1 = *nn;
00206 for (ik = 1; ik <= i__1; ++ik) {
00207 m = mval[ik];
00208 p = pval[ik];
00209 n = nval[ik];
00210 if (p > n || n > m + p) {
00211 if (firstt) {
00212 io___13.ciunit = *nout;
00213 s_wsle(&io___13);
00214 e_wsle();
00215 firstt = FALSE_;
00216 }
00217 io___14.ciunit = *nout;
00218 s_wsfe(&io___14);
00219 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer));
00220 do_fio(&c__1, (char *)&p, (ftnlen)sizeof(integer));
00221 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00222 e_wsfe();
00223 }
00224
00225 }
00226 firstt = TRUE_;
00227
00228
00229
00230 i__1 = *nn;
00231 for (ik = 1; ik <= i__1; ++ik) {
00232 m = mval[ik];
00233 p = pval[ik];
00234 n = nval[ik];
00235 if (p > n || n > m + p) {
00236 goto L40;
00237 }
00238
00239 for (imat = 1; imat <= 8; ++imat) {
00240
00241
00242
00243 if (! dotype[imat - 1]) {
00244 goto L30;
00245 }
00246
00247
00248
00249
00250 dlatb9_(path, &imat, &m, &p, &n, type__, &kla, &kua, &klb, &kub, &
00251 anorm, &bnorm, &modea, &modeb, &cndnma, &cndnmb, dista,
00252 distb);
00253
00254 dlatms_(&m, &n, dista, &iseed[1], type__, &rwork[1], &modea, &
00255 cndnma, &anorm, &kla, &kua, "No packing", &a[1], &lda, &
00256 work[1], &iinfo);
00257 if (iinfo != 0) {
00258 io___30.ciunit = *nout;
00259 s_wsfe(&io___30);
00260 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00261 e_wsfe();
00262 *info = abs(iinfo);
00263 goto L30;
00264 }
00265
00266 dlatms_(&p, &n, distb, &iseed[1], type__, &rwork[1], &modeb, &
00267 cndnmb, &bnorm, &klb, &kub, "No packing", &b[1], &ldb, &
00268 work[1], &iinfo);
00269 if (iinfo != 0) {
00270 io___31.ciunit = *nout;
00271 s_wsfe(&io___31);
00272 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00273 e_wsfe();
00274 *info = abs(iinfo);
00275 goto L30;
00276 }
00277
00278
00279
00280
00281 i__3 = m - 1;
00282 i__2 = max(i__3,0);
00283
00284 i__5 = n - 1;
00285 i__4 = max(i__5,0);
00286 i__6 = max(n,1);
00287 i__7 = max(m,1);
00288 dlarhs_("DGE", "New solution", "Upper", "N", &m, &n, &i__2, &i__4,
00289 &c__1, &a[1], &lda, &x[(*nmax << 2) + 1], &i__6, &x[1], &
00290 i__7, &iseed[1], &iinfo);
00291
00292
00293 i__3 = p - 1;
00294 i__2 = max(i__3,0);
00295
00296 i__5 = n - 1;
00297 i__4 = max(i__5,0);
00298 i__6 = max(n,1);
00299 i__7 = max(p,1);
00300 dlarhs_("DGE", "Computed", "Upper", "N", &p, &n, &i__2, &i__4, &
00301 c__1, &b[1], &ldb, &x[(*nmax << 2) + 1], &i__6, &x[(*nmax
00302 << 1) + 1], &i__7, &iseed[1], &iinfo);
00303
00304 nt = 2;
00305
00306 dlsets_(&m, &p, &n, &a[1], &af[1], &lda, &b[1], &bf[1], &ldb, &x[
00307 1], &x[*nmax + 1], &x[(*nmax << 1) + 1], &x[*nmax * 3 + 1]
00308 , &x[(*nmax << 2) + 1], &work[1], &lwork, &rwork[1],
00309 result);
00310
00311
00312
00313
00314 i__2 = nt;
00315 for (i__ = 1; i__ <= i__2; ++i__) {
00316 if (result[i__ - 1] >= *thresh) {
00317 if (nfail == 0 && firstt) {
00318 firstt = FALSE_;
00319 alahdg_(nout, path);
00320 }
00321 io___35.ciunit = *nout;
00322 s_wsfe(&io___35);
00323 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer));
00324 do_fio(&c__1, (char *)&p, (ftnlen)sizeof(integer));
00325 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00326 do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(integer));
00327 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
00328 do_fio(&c__1, (char *)&result[i__ - 1], (ftnlen)sizeof(
00329 doublereal));
00330 e_wsfe();
00331 ++nfail;
00332 }
00333
00334 }
00335 nrun += nt;
00336
00337 L30:
00338 ;
00339 }
00340 L40:
00341 ;
00342 }
00343
00344
00345
00346 alasum_(path, nout, &nfail, &nrun, &c__0);
00347
00348 return 0;
00349
00350
00351
00352 }