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 icase, n, incx, incy, mode;
00020 logical pass;
00021 } combla_;
00022
00023 #define combla_1 combla_
00024
00025
00026
00027 static integer c__1 = 1;
00028 static integer c__9 = 9;
00029 static doublereal c_b34 = 1.;
00030 static integer c__5 = 5;
00031
00032 int MAIN__(void)
00033 {
00034
00035
00036 static doublereal sfac = 9.765625e-4;
00037
00038
00039 static char fmt_99999[] = "(\002 Real BLAS Test Program Results\002,/1x)";
00040 static char fmt_99998[] = "(\002 ----"
00041 "- PASS -----\002)";
00042
00043
00044 integer s_wsfe(cilist *), e_wsfe(void);
00045 int s_stop(char *, ftnlen);
00046
00047
00048 integer ic;
00049 extern int check0_(doublereal *), check1_(doublereal *),
00050 check2_(doublereal *), check3_(doublereal *), header_(void);
00051
00052
00053 static cilist io___2 = { 0, 6, 0, fmt_99999, 0 };
00054 static cilist io___4 = { 0, 6, 0, fmt_99998, 0 };
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067 s_wsfe(&io___2);
00068 e_wsfe();
00069 for (ic = 1; ic <= 10; ++ic) {
00070 combla_1.icase = ic;
00071 header_();
00072
00073
00074
00075
00076
00077
00078 combla_1.pass = TRUE_;
00079 combla_1.incx = 9999;
00080 combla_1.incy = 9999;
00081 combla_1.mode = 9999;
00082 if (combla_1.icase == 3) {
00083 check0_(&sfac);
00084 } else if (combla_1.icase == 7 || combla_1.icase == 8 ||
00085 combla_1.icase == 9 || combla_1.icase == 10) {
00086 check1_(&sfac);
00087 } else if (combla_1.icase == 1 || combla_1.icase == 2 ||
00088 combla_1.icase == 5 || combla_1.icase == 6) {
00089 check2_(&sfac);
00090 } else if (combla_1.icase == 4) {
00091 check3_(&sfac);
00092 }
00093
00094 if (combla_1.pass) {
00095 s_wsfe(&io___4);
00096 e_wsfe();
00097 }
00098
00099 }
00100 s_stop("", (ftnlen)0);
00101
00102 return 0;
00103 }
00104
00105 int header_(void)
00106 {
00107
00108
00109 static char l[6*10] = " DDOT " "DAXPY " "DROTG " " DROT " "DCOPY " "DSWA"
00110 "P " "DNRM2 " "DASUM " "DSCAL " "IDAMAX";
00111
00112
00113 static char fmt_99999[] = "(/\002 Test of subprogram number\002,i3,12x,a"
00114 "6)";
00115
00116
00117 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00118
00119
00120 static cilist io___6 = { 0, 6, 0, fmt_99999, 0 };
00121
00122
00123
00124
00125
00126
00127
00128
00129 s_wsfe(&io___6);
00130 do_fio(&c__1, (char *)&combla_1.icase, (ftnlen)sizeof(integer));
00131 do_fio(&c__1, l + (0 + (0 + (combla_1.icase - 1) * 6)), (ftnlen)6);
00132 e_wsfe();
00133 return 0;
00134
00135 }
00136
00137 int check0_(doublereal *sfac)
00138 {
00139
00140
00141 static doublereal ds1[8] = { .8,.6,.8,-.6,.8,0.,1.,0. };
00142 static doublereal datrue[8] = { .5,.5,.5,-.5,-.5,0.,1.,1. };
00143 static doublereal dbtrue[8] = { 0.,.6,0.,-.6,0.,0.,1.,0. };
00144 static doublereal da1[8] = { .3,.4,-.3,-.4,-.3,0.,0.,1. };
00145 static doublereal db1[8] = { .4,.3,.4,.3,-.4,0.,1.,0. };
00146 static doublereal dc1[8] = { .6,.8,-.6,.8,.6,1.,0.,1. };
00147
00148
00149 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
00150 e_wsle(void);
00151 int s_stop(char *, ftnlen);
00152
00153
00154 integer k;
00155 doublereal sa, sb, sc, ss;
00156 extern int drotg_(doublereal *, doublereal *, doublereal
00157 *, doublereal *), stest1_(doublereal *, doublereal *, doublereal *
00158 , doublereal *);
00159
00160
00161 static cilist io___18 = { 0, 6, 0, 0, 0 };
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177 dbtrue[0] = 1.6666666666666667;
00178 dbtrue[2] = -1.6666666666666667;
00179 dbtrue[4] = 1.6666666666666667;
00180
00181 for (k = 1; k <= 8; ++k) {
00182
00183 combla_1.n = k;
00184 if (combla_1.icase == 3) {
00185
00186 if (k > 8) {
00187 goto L40;
00188 }
00189 sa = da1[k - 1];
00190 sb = db1[k - 1];
00191 drotg_(&sa, &sb, &sc, &ss);
00192 stest1_(&sa, &datrue[k - 1], &datrue[k - 1], sfac);
00193 stest1_(&sb, &dbtrue[k - 1], &dbtrue[k - 1], sfac);
00194 stest1_(&sc, &dc1[k - 1], &dc1[k - 1], sfac);
00195 stest1_(&ss, &ds1[k - 1], &ds1[k - 1], sfac);
00196 } else {
00197 s_wsle(&io___18);
00198 do_lio(&c__9, &c__1, " Shouldn't be here in CHECK0", (ftnlen)28);
00199 e_wsle();
00200 s_stop("", (ftnlen)0);
00201 }
00202
00203 }
00204 L40:
00205 return 0;
00206 }
00207
00208 int check1_(doublereal *sfac)
00209 {
00210
00211
00212 static doublereal sa[10] = { .3,-1.,0.,1.,.3,.3,.3,.3,.3,.3 };
00213 static doublereal dv[80] = { .1,2.,2.,2.,2.,2.,2.,
00214 2.,.3,3.,3.,3.,3.,3.,3.,3.,.3,-.4,4.,4.,4.,4.,4.,4.,.2,-.6,.3,5.,
00215 5.,5.,5.,5.,.1,-.3,.5,-.1,6.,6.,6.,6.,.1,8.,8.,8.,8.,8.,8.,8.,.3,
00216 9.,9.,9.,9.,9.,9.,9.,.3,2.,-.4,2.,2.,2.,2.,2.,.2,3.,-.6,5.,.3,2.,
00217 2.,2.,.1,4.,-.3,6.,-.5,7.,-.1,3. };
00218 static doublereal dtrue1[5] = { 0.,.3,.5,.7,.6 };
00219 static doublereal dtrue3[5] = { 0.,.3,.7,1.1,1. };
00220 static doublereal dtrue5[80] = { .1,2.,2.,2.,
00221 2.,2.,2.,2.,-.3,3.,3.,3.,3.,3.,3.,3.,0.,0.,4.,4.,4.,4.,4.,4.,.2,
00222 -.6,.3,5.,5.,5.,5.,5.,.03,-.09,.15,-.03,6.,6.,6.,6.,.1,8.,8.,8.,
00223 8.,8.,8.,8.,.09,9.,9.,9.,9.,9.,9.,9.,.09,2.,-.12,2.,2.,2.,2.,2.,
00224 .06,3.,-.18,5.,.09,2.,2.,2.,.03,4.,-.09,6.,-.15,7.,-.03,3. };
00225 static integer itrue2[5] = { 0,1,2,2,3 };
00226
00227
00228 integer i__1;
00229 doublereal d__1;
00230
00231
00232 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
00233 e_wsle(void);
00234 int s_stop(char *, ftnlen);
00235
00236
00237 integer i__;
00238 doublereal sx[8];
00239 integer np1, len;
00240 extern doublereal dnrm2_(integer *, doublereal *, integer *);
00241 extern int dscal_(integer *, doublereal *, doublereal *,
00242 integer *);
00243 extern doublereal dasum_(integer *, doublereal *, integer *);
00244 doublereal stemp[1], strue[8];
00245 extern int stest_(integer *, doublereal *, doublereal *,
00246 doublereal *, doublereal *), itest1_(integer *, integer *),
00247 stest1_(doublereal *, doublereal *, doublereal *, doublereal *);
00248 extern integer idamax_(integer *, doublereal *, integer *);
00249
00250
00251 static cilist io___31 = { 0, 6, 0, 0, 0 };
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265 for (combla_1.incx = 1; combla_1.incx <= 2; ++combla_1.incx) {
00266 for (np1 = 1; np1 <= 5; ++np1) {
00267 combla_1.n = np1 - 1;
00268 len = max(combla_1.n,1) << 1;
00269
00270 i__1 = len;
00271 for (i__ = 1; i__ <= i__1; ++i__) {
00272 sx[i__ - 1] = dv[i__ + (np1 + combla_1.incx * 5 << 3) - 49];
00273
00274 }
00275
00276 if (combla_1.icase == 7) {
00277
00278 stemp[0] = dtrue1[np1 - 1];
00279 d__1 = dnrm2_(&combla_1.n, sx, &combla_1.incx);
00280 stest1_(&d__1, stemp, stemp, sfac);
00281 } else if (combla_1.icase == 8) {
00282
00283 stemp[0] = dtrue3[np1 - 1];
00284 d__1 = dasum_(&combla_1.n, sx, &combla_1.incx);
00285 stest1_(&d__1, stemp, stemp, sfac);
00286 } else if (combla_1.icase == 9) {
00287
00288 dscal_(&combla_1.n, &sa[(combla_1.incx - 1) * 5 + np1 - 1],
00289 sx, &combla_1.incx);
00290 i__1 = len;
00291 for (i__ = 1; i__ <= i__1; ++i__) {
00292 strue[i__ - 1] = dtrue5[i__ + (np1 + combla_1.incx * 5 <<
00293 3) - 49];
00294
00295 }
00296 stest_(&len, sx, strue, strue, sfac);
00297 } else if (combla_1.icase == 10) {
00298
00299 i__1 = idamax_(&combla_1.n, sx, &combla_1.incx);
00300 itest1_(&i__1, &itrue2[np1 - 1]);
00301 } else {
00302 s_wsle(&io___31);
00303 do_lio(&c__9, &c__1, " Shouldn't be here in CHECK1", (ftnlen)
00304 28);
00305 e_wsle();
00306 s_stop("", (ftnlen)0);
00307 }
00308
00309 }
00310
00311 }
00312 return 0;
00313 }
00314
00315 int check2_(doublereal *sfac)
00316 {
00317
00318
00319 static doublereal sa = .3;
00320 static integer incxs[4] = { 1,2,-2,-1 };
00321 static integer incys[4] = { 1,-2,1,-2 };
00322 static integer lens[8] = { 1,1,2,4,1,1,3,7 };
00323 static integer ns[4] = { 0,1,2,4 };
00324 static doublereal dx1[7] = { .6,.1,-.5,.8,.9,-.3,-.4 };
00325 static doublereal dy1[7] = { .5,-.9,.3,.7,-.6,.2,.8 };
00326 static doublereal dt7[16] = { 0.,.3,.21,.62,0.,.3,-.07,
00327 .85,0.,.3,-.79,-.74,0.,.3,.33,1.27 };
00328 static doublereal dt8[112] = { .5,0.,0.,0.,0.,0.,0.,
00329 .68,0.,0.,0.,0.,0.,0.,.68,-.87,0.,0.,0.,0.,0.,.68,-.87,.15,.94,0.,
00330 0.,0.,.5,0.,0.,0.,0.,0.,0.,.68,0.,0.,0.,0.,0.,0.,.35,-.9,.48,0.,
00331 0.,0.,0.,.38,-.9,.57,.7,-.75,.2,.98,.5,0.,0.,0.,0.,0.,0.,.68,0.,
00332 0.,0.,0.,0.,0.,.35,-.72,0.,0.,0.,0.,0.,.38,-.63,.15,.88,0.,0.,0.,
00333 .5,0.,0.,0.,0.,0.,0.,.68,0.,0.,0.,0.,0.,0.,.68,-.9,.33,0.,0.,0.,
00334 0.,.68,-.9,.33,.7,-.75,.2,1.04 };
00335 static doublereal dt10x[112] = { .6,0.,0.,0.,
00336 0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.5,-.9,0.,0.,0.,0.,0.,.5,-.9,.3,.7,
00337 0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.3,.1,.5,0.,0.,
00338 0.,0.,.8,.1,-.6,.8,.3,-.3,.5,.6,0.,0.,0.,0.,0.,0.,.5,0.,0.,0.,0.,
00339 0.,0.,-.9,.1,.5,0.,0.,0.,0.,.7,.1,.3,.8,-.9,-.3,.5,.6,0.,0.,0.,0.,
00340 0.,0.,.5,0.,0.,0.,0.,0.,0.,.5,.3,0.,0.,0.,0.,0.,.5,.3,-.6,.8,0.,
00341 0.,0. };
00342 static doublereal dt10y[112] = { .5,0.,0.,0.,
00343 0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.6,.1,0.,0.,0.,0.,0.,.6,.1,-.5,.8,
00344 0.,0.,0.,.5,0.,0.,0.,0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,-.5,-.9,.6,0.,
00345 0.,0.,0.,-.4,-.9,.9,.7,-.5,.2,.6,.5,0.,0.,0.,0.,0.,0.,.6,0.,0.,0.,
00346 0.,0.,0.,-.5,.6,0.,0.,0.,0.,0.,-.4,.9,-.5,.6,0.,0.,0.,.5,0.,0.,0.,
00347 0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.6,-.9,.1,0.,0.,0.,0.,.6,-.9,.1,.7,
00348 -.5,.2,.8 };
00349 static doublereal ssize1[4] = { 0.,.3,1.6,3.2 };
00350 static doublereal ssize2[28] = { 0.,0.,0.,0.,0.,
00351 0.,0.,0.,0.,0.,0.,0.,0.,0.,1.17,1.17,1.17,1.17,1.17,1.17,1.17,
00352 1.17,1.17,1.17,1.17,1.17,1.17,1.17 };
00353
00354
00355 integer i__1;
00356 doublereal d__1;
00357
00358
00359 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
00360 e_wsle(void);
00361 int s_stop(char *, ftnlen);
00362
00363
00364 integer i__, j, ki, kn, mx, my;
00365 doublereal sx[7], sy[7], stx[7], sty[7];
00366 extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
00367 integer *);
00368 integer lenx, leny;
00369 extern int dcopy_(integer *, doublereal *, integer *,
00370 doublereal *, integer *), dswap_(integer *, doublereal *, integer
00371 *, doublereal *, integer *);
00372 integer ksize;
00373 extern int daxpy_(integer *, doublereal *, doublereal *,
00374 integer *, doublereal *, integer *), stest_(integer *, doublereal
00375 *, doublereal *, doublereal *, doublereal *), stest1_(doublereal *
00376 , doublereal *, doublereal *, doublereal *);
00377
00378
00379 static cilist io___58 = { 0, 6, 0, 0, 0 };
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393
00394 for (ki = 1; ki <= 4; ++ki) {
00395 combla_1.incx = incxs[ki - 1];
00396 combla_1.incy = incys[ki - 1];
00397 mx = abs(combla_1.incx);
00398 my = abs(combla_1.incy);
00399
00400 for (kn = 1; kn <= 4; ++kn) {
00401 combla_1.n = ns[kn - 1];
00402 ksize = min(2,kn);
00403 lenx = lens[kn + (mx << 2) - 5];
00404 leny = lens[kn + (my << 2) - 5];
00405
00406 for (i__ = 1; i__ <= 7; ++i__) {
00407 sx[i__ - 1] = dx1[i__ - 1];
00408 sy[i__ - 1] = dy1[i__ - 1];
00409
00410 }
00411
00412 if (combla_1.icase == 1) {
00413
00414 d__1 = ddot_(&combla_1.n, sx, &combla_1.incx, sy, &
00415 combla_1.incy);
00416 stest1_(&d__1, &dt7[kn + (ki << 2) - 5], &ssize1[kn - 1],
00417 sfac);
00418 } else if (combla_1.icase == 2) {
00419
00420 daxpy_(&combla_1.n, &sa, sx, &combla_1.incx, sy, &
00421 combla_1.incy);
00422 i__1 = leny;
00423 for (j = 1; j <= i__1; ++j) {
00424 sty[j - 1] = dt8[j + (kn + (ki << 2)) * 7 - 36];
00425
00426 }
00427 stest_(&leny, sy, sty, &ssize2[ksize * 14 - 14], sfac);
00428 } else if (combla_1.icase == 5) {
00429
00430 for (i__ = 1; i__ <= 7; ++i__) {
00431 sty[i__ - 1] = dt10y[i__ + (kn + (ki << 2)) * 7 - 36];
00432
00433 }
00434 dcopy_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy);
00435 stest_(&leny, sy, sty, ssize2, &c_b34);
00436 } else if (combla_1.icase == 6) {
00437
00438 dswap_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy);
00439 for (i__ = 1; i__ <= 7; ++i__) {
00440 stx[i__ - 1] = dt10x[i__ + (kn + (ki << 2)) * 7 - 36];
00441 sty[i__ - 1] = dt10y[i__ + (kn + (ki << 2)) * 7 - 36];
00442
00443 }
00444 stest_(&lenx, sx, stx, ssize2, &c_b34);
00445 stest_(&leny, sy, sty, ssize2, &c_b34);
00446 } else {
00447 s_wsle(&io___58);
00448 do_lio(&c__9, &c__1, " Shouldn't be here in CHECK2", (ftnlen)
00449 28);
00450 e_wsle();
00451 s_stop("", (ftnlen)0);
00452 }
00453
00454 }
00455
00456 }
00457 return 0;
00458 }
00459
00460 int check3_(doublereal *sfac)
00461 {
00462
00463
00464 static integer incxs[4] = { 1,2,-2,-1 };
00465 static integer incys[4] = { 1,-2,1,-2 };
00466 static integer lens[8] = { 1,1,2,4,1,1,3,7 };
00467 static integer ns[4] = { 0,1,2,4 };
00468 static doublereal dx1[7] = { .6,.1,-.5,.8,.9,-.3,-.4 };
00469 static doublereal dy1[7] = { .5,-.9,.3,.7,-.6,.2,.8 };
00470 static doublereal sc = .8;
00471 static doublereal ss = .6;
00472 static doublereal dt9x[112] = { .6,0.,0.,0.,0.,0.,0.,
00473 .78,0.,0.,0.,0.,0.,0.,.78,-.46,0.,0.,0.,0.,0.,.78,-.46,-.22,1.06,
00474 0.,0.,0.,.6,0.,0.,0.,0.,0.,0.,.78,0.,0.,0.,0.,0.,0.,.66,.1,-.1,0.,
00475 0.,0.,0.,.96,.1,-.76,.8,.9,-.3,-.02,.6,0.,0.,0.,0.,0.,0.,.78,0.,
00476 0.,0.,0.,0.,0.,-.06,.1,-.1,0.,0.,0.,0.,.9,.1,-.22,.8,.18,-.3,-.02,
00477 .6,0.,0.,0.,0.,0.,0.,.78,0.,0.,0.,0.,0.,0.,.78,.26,0.,0.,0.,0.,0.,
00478 .78,.26,-.76,1.12,0.,0.,0. };
00479 static doublereal dt9y[112] = { .5,0.,0.,0.,0.,0.,0.,
00480 .04,0.,0.,0.,0.,0.,0.,.04,-.78,0.,0.,0.,0.,0.,.04,-.78,.54,.08,0.,
00481 0.,0.,.5,0.,0.,0.,0.,0.,0.,.04,0.,0.,0.,0.,0.,0.,.7,-.9,-.12,0.,
00482 0.,0.,0.,.64,-.9,-.3,.7,-.18,.2,.28,.5,0.,0.,0.,0.,0.,0.,.04,0.,
00483 0.,0.,0.,0.,0.,.7,-1.08,0.,0.,0.,0.,0.,.64,-1.26,.54,.2,0.,0.,0.,
00484 .5,0.,0.,0.,0.,0.,0.,.04,0.,0.,0.,0.,0.,0.,.04,-.9,.18,0.,0.,0.,
00485 0.,.04,-.9,.18,.7,-.18,.2,.16 };
00486 static doublereal ssize2[28] = { 0.,0.,0.,0.,0.,
00487 0.,0.,0.,0.,0.,0.,0.,0.,0.,1.17,1.17,1.17,1.17,1.17,1.17,1.17,
00488 1.17,1.17,1.17,1.17,1.17,1.17,1.17 };
00489
00490
00491 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
00492 e_wsle(void);
00493 int s_stop(char *, ftnlen);
00494
00495
00496 integer i__, k, ki, kn, mx, my;
00497 doublereal sx[7], sy[7], stx[7], sty[7];
00498 integer lenx, leny;
00499 doublereal mwpc[11];
00500 extern int drot_(integer *, doublereal *, integer *,
00501 doublereal *, integer *, doublereal *, doublereal *);
00502 integer mwpn[11];
00503 doublereal mwps[11], mwpx[5], mwpy[5];
00504 integer ksize;
00505 doublereal copyx[5], copyy[5];
00506 extern int stest_(integer *, doublereal *, doublereal *,
00507 doublereal *, doublereal *);
00508 doublereal mwptx[55] , mwpty[55]
00509 ;
00510 integer mwpinx[11], mwpiny[11];
00511 doublereal mwpstx[5], mwpsty[5];
00512
00513
00514 static cilist io___82 = { 0, 6, 0, 0, 0 };
00515
00516
00517
00518
00519
00520
00521
00522
00523
00524
00525
00526
00527
00528 for (ki = 1; ki <= 4; ++ki) {
00529 combla_1.incx = incxs[ki - 1];
00530 combla_1.incy = incys[ki - 1];
00531 mx = abs(combla_1.incx);
00532 my = abs(combla_1.incy);
00533
00534 for (kn = 1; kn <= 4; ++kn) {
00535 combla_1.n = ns[kn - 1];
00536 ksize = min(2,kn);
00537 lenx = lens[kn + (mx << 2) - 5];
00538 leny = lens[kn + (my << 2) - 5];
00539
00540 if (combla_1.icase == 4) {
00541
00542 for (i__ = 1; i__ <= 7; ++i__) {
00543 sx[i__ - 1] = dx1[i__ - 1];
00544 sy[i__ - 1] = dy1[i__ - 1];
00545 stx[i__ - 1] = dt9x[i__ + (kn + (ki << 2)) * 7 - 36];
00546 sty[i__ - 1] = dt9y[i__ + (kn + (ki << 2)) * 7 - 36];
00547
00548 }
00549 drot_(&combla_1.n, sx, &combla_1.incx, sy, &combla_1.incy, &
00550 sc, &ss);
00551 stest_(&lenx, sx, stx, &ssize2[ksize * 14 - 14], sfac);
00552 stest_(&leny, sy, sty, &ssize2[ksize * 14 - 14], sfac);
00553 } else {
00554 s_wsle(&io___82);
00555 do_lio(&c__9, &c__1, " Shouldn't be here in CHECK3", (ftnlen)
00556 28);
00557 e_wsle();
00558 s_stop("", (ftnlen)0);
00559 }
00560
00561 }
00562
00563 }
00564
00565 mwpc[0] = 1.;
00566 for (i__ = 2; i__ <= 11; ++i__) {
00567 mwpc[i__ - 1] = 0.;
00568
00569 }
00570 mwps[0] = 0.;
00571 for (i__ = 2; i__ <= 6; ++i__) {
00572 mwps[i__ - 1] = 1.;
00573
00574 }
00575 for (i__ = 7; i__ <= 11; ++i__) {
00576 mwps[i__ - 1] = -1.;
00577
00578 }
00579 mwpinx[0] = 1;
00580 mwpinx[1] = 1;
00581 mwpinx[2] = 1;
00582 mwpinx[3] = -1;
00583 mwpinx[4] = 1;
00584 mwpinx[5] = -1;
00585 mwpinx[6] = 1;
00586 mwpinx[7] = 1;
00587 mwpinx[8] = -1;
00588 mwpinx[9] = 1;
00589 mwpinx[10] = -1;
00590 mwpiny[0] = 1;
00591 mwpiny[1] = 1;
00592 mwpiny[2] = -1;
00593 mwpiny[3] = -1;
00594 mwpiny[4] = 2;
00595 mwpiny[5] = 1;
00596 mwpiny[6] = 1;
00597 mwpiny[7] = -1;
00598 mwpiny[8] = -1;
00599 mwpiny[9] = 2;
00600 mwpiny[10] = 1;
00601 for (i__ = 1; i__ <= 11; ++i__) {
00602 mwpn[i__ - 1] = 5;
00603
00604 }
00605 mwpn[4] = 3;
00606 mwpn[9] = 3;
00607 for (i__ = 1; i__ <= 5; ++i__) {
00608 mwpx[i__ - 1] = (doublereal) i__;
00609 mwpy[i__ - 1] = (doublereal) i__;
00610 mwptx[i__ * 11 - 11] = (doublereal) i__;
00611 mwpty[i__ * 11 - 11] = (doublereal) i__;
00612 mwptx[i__ * 11 - 10] = (doublereal) i__;
00613 mwpty[i__ * 11 - 10] = (doublereal) (-i__);
00614 mwptx[i__ * 11 - 9] = (doublereal) (6 - i__);
00615 mwpty[i__ * 11 - 9] = (doublereal) (i__ - 6);
00616 mwptx[i__ * 11 - 8] = (doublereal) i__;
00617 mwpty[i__ * 11 - 8] = (doublereal) (-i__);
00618 mwptx[i__ * 11 - 6] = (doublereal) (6 - i__);
00619 mwpty[i__ * 11 - 6] = (doublereal) (i__ - 6);
00620 mwptx[i__ * 11 - 5] = (doublereal) (-i__);
00621 mwpty[i__ * 11 - 5] = (doublereal) i__;
00622 mwptx[i__ * 11 - 4] = (doublereal) (i__ - 6);
00623 mwpty[i__ * 11 - 4] = (doublereal) (6 - i__);
00624 mwptx[i__ * 11 - 3] = (doublereal) (-i__);
00625 mwpty[i__ * 11 - 3] = (doublereal) i__;
00626 mwptx[i__ * 11 - 1] = (doublereal) (i__ - 6);
00627 mwpty[i__ * 11 - 1] = (doublereal) (6 - i__);
00628
00629 }
00630 mwptx[4] = 1.;
00631 mwptx[15] = 3.;
00632 mwptx[26] = 5.;
00633 mwptx[37] = 4.;
00634 mwptx[48] = 5.;
00635 mwpty[4] = -1.;
00636 mwpty[15] = 2.;
00637 mwpty[26] = -2.;
00638 mwpty[37] = 4.;
00639 mwpty[48] = -3.;
00640 mwptx[9] = -1.;
00641 mwptx[20] = -3.;
00642 mwptx[31] = -5.;
00643 mwptx[42] = 4.;
00644 mwptx[53] = 5.;
00645 mwpty[9] = 1.;
00646 mwpty[20] = 2.;
00647 mwpty[31] = 2.;
00648 mwpty[42] = 4.;
00649 mwpty[53] = 3.;
00650 for (i__ = 1; i__ <= 11; ++i__) {
00651 combla_1.incx = mwpinx[i__ - 1];
00652 combla_1.incy = mwpiny[i__ - 1];
00653 for (k = 1; k <= 5; ++k) {
00654 copyx[k - 1] = mwpx[k - 1];
00655 copyy[k - 1] = mwpy[k - 1];
00656 mwpstx[k - 1] = mwptx[i__ + k * 11 - 12];
00657 mwpsty[k - 1] = mwpty[i__ + k * 11 - 12];
00658
00659 }
00660 drot_(&mwpn[i__ - 1], copyx, &combla_1.incx, copyy, &combla_1.incy, &
00661 mwpc[i__ - 1], &mwps[i__ - 1]);
00662 stest_(&c__5, copyx, mwpstx, mwpstx, sfac);
00663 stest_(&c__5, copyy, mwpsty, mwpsty, sfac);
00664
00665 }
00666 return 0;
00667 }
00668
00669 int stest_(integer *len, doublereal *scomp, doublereal *
00670 strue, doublereal *ssize, doublereal *sfac)
00671 {
00672
00673 static char fmt_99999[] = "(\002 F"
00674 "AIL\002)";
00675 static char fmt_99998[] = "(/\002 CASE N INCX INCY MODE I "
00676 " \002,\002 COMP(I) TRU"
00677 "E(I) DIFFERENCE\002,\002 SIZE(I)\002,/1x)";
00678 static char fmt_99997[] = "(1x,i4,i3,3i5,i3,2d36.8,2d12.4)";
00679
00680
00681 integer i__1;
00682 doublereal d__1, d__2, d__3, d__4, d__5;
00683
00684
00685 integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
00686
00687
00688 integer i__;
00689 doublereal sd;
00690 extern doublereal sdiff_(doublereal *, doublereal *);
00691
00692
00693 static cilist io___99 = { 0, 6, 0, fmt_99999, 0 };
00694 static cilist io___100 = { 0, 6, 0, fmt_99998, 0 };
00695 static cilist io___101 = { 0, 6, 0, fmt_99997, 0 };
00696
00697
00698
00699
00700
00701
00702
00703
00704
00705
00706
00707
00708
00709
00710
00711
00712
00713
00714
00715
00716
00717 --ssize;
00718 --strue;
00719 --scomp;
00720
00721
00722 i__1 = *len;
00723 for (i__ = 1; i__ <= i__1; ++i__) {
00724 sd = scomp[i__] - strue[i__];
00725 d__4 = (d__1 = ssize[i__], abs(d__1)) + (d__2 = *sfac * sd, abs(d__2))
00726 ;
00727 d__5 = (d__3 = ssize[i__], abs(d__3));
00728 if (sdiff_(&d__4, &d__5) == 0.) {
00729 goto L40;
00730 }
00731
00732
00733
00734 if (! combla_1.pass) {
00735 goto L20;
00736 }
00737
00738 combla_1.pass = FALSE_;
00739 s_wsfe(&io___99);
00740 e_wsfe();
00741 s_wsfe(&io___100);
00742 e_wsfe();
00743 L20:
00744 s_wsfe(&io___101);
00745 do_fio(&c__1, (char *)&combla_1.icase, (ftnlen)sizeof(integer));
00746 do_fio(&c__1, (char *)&combla_1.n, (ftnlen)sizeof(integer));
00747 do_fio(&c__1, (char *)&combla_1.incx, (ftnlen)sizeof(integer));
00748 do_fio(&c__1, (char *)&combla_1.incy, (ftnlen)sizeof(integer));
00749 do_fio(&c__1, (char *)&combla_1.mode, (ftnlen)sizeof(integer));
00750 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
00751 do_fio(&c__1, (char *)&scomp[i__], (ftnlen)sizeof(doublereal));
00752 do_fio(&c__1, (char *)&strue[i__], (ftnlen)sizeof(doublereal));
00753 do_fio(&c__1, (char *)&sd, (ftnlen)sizeof(doublereal));
00754 do_fio(&c__1, (char *)&ssize[i__], (ftnlen)sizeof(doublereal));
00755 e_wsfe();
00756 L40:
00757 ;
00758 }
00759 return 0;
00760
00761 }
00762
00763 int stest1_(doublereal *scomp1, doublereal *strue1,
00764 doublereal *ssize, doublereal *sfac)
00765 {
00766 doublereal scomp[1], strue[1];
00767 extern int stest_(integer *, doublereal *, doublereal *,
00768 doublereal *, doublereal *);
00769
00770
00771
00772
00773
00774
00775
00776
00777
00778
00779
00780
00781
00782
00783
00784
00785 --ssize;
00786
00787
00788 scomp[0] = *scomp1;
00789 strue[0] = *strue1;
00790 stest_(&c__1, scomp, strue, &ssize[1], sfac);
00791
00792 return 0;
00793 }
00794
00795 doublereal sdiff_(doublereal *sa, doublereal *sb)
00796 {
00797
00798 doublereal ret_val;
00799
00800
00801
00802
00803
00804
00805 ret_val = *sa - *sb;
00806 return ret_val;
00807 }
00808
00809 int itest1_(integer *icomp, integer *itrue)
00810 {
00811
00812 static char fmt_99999[] = "(\002 F"
00813 "AIL\002)";
00814 static char fmt_99998[] = "(/\002 CASE N INCX INCY MODE "
00815 " \002,\002 COMP TRU"
00816 "E DIFFERENCE\002,/1x)";
00817 static char fmt_99997[] = "(1x,i4,i3,3i5,2i36,i12)";
00818
00819
00820 integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
00821
00822
00823 integer id;
00824
00825
00826 static cilist io___104 = { 0, 6, 0, fmt_99999, 0 };
00827 static cilist io___105 = { 0, 6, 0, fmt_99998, 0 };
00828 static cilist io___107 = { 0, 6, 0, fmt_99997, 0 };
00829
00830
00831
00832
00833
00834
00835
00836
00837
00838
00839
00840
00841
00842
00843
00844 if (*icomp == *itrue) {
00845 goto L40;
00846 }
00847
00848
00849
00850 if (! combla_1.pass) {
00851 goto L20;
00852 }
00853
00854 combla_1.pass = FALSE_;
00855 s_wsfe(&io___104);
00856 e_wsfe();
00857 s_wsfe(&io___105);
00858 e_wsfe();
00859 L20:
00860 id = *icomp - *itrue;
00861 s_wsfe(&io___107);
00862 do_fio(&c__1, (char *)&combla_1.icase, (ftnlen)sizeof(integer));
00863 do_fio(&c__1, (char *)&combla_1.n, (ftnlen)sizeof(integer));
00864 do_fio(&c__1, (char *)&combla_1.incx, (ftnlen)sizeof(integer));
00865 do_fio(&c__1, (char *)&combla_1.incy, (ftnlen)sizeof(integer));
00866 do_fio(&c__1, (char *)&combla_1.mode, (ftnlen)sizeof(integer));
00867 do_fio(&c__1, (char *)&(*icomp), (ftnlen)sizeof(integer));
00868 do_fio(&c__1, (char *)&(*itrue), (ftnlen)sizeof(integer));
00869 do_fio(&c__1, (char *)&id, (ftnlen)sizeof(integer));
00870 e_wsfe();
00871 L40:
00872 return 0;
00873
00874 }
00875
00876 int dblat1_ () { MAIN__ (); return 0; }