← Back to branch summary

~ubuntu-branches/ubuntu/vivid/atlas/vivid

« back to all changes in this revision

Viewing changes to EXtest/r1test.c

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot, Sylvestre Ledru, Sébastien Villemot
  • Date: 2013-06-11 15:58:16 UTC
  • mfrom: (1.1.4) (25 sid)
  • mto: This revision was merged to the branch mainline in revision 26.
  • Revision ID: package-import@ubuntu.com-20130611155816-8xeeiziu1iml040c
Tags: 3.10.1-1
http://bugs.debian.org/609287
http://bugs.debian.org/602524
http://bugs.debian.org/701921
http://bugs.debian.org/666203
http://bugs.debian.org/701068
http://bugs.debian.org/697431
[ Sylvestre Ledru ]
* New upstream release (Closes: #609287)

[ Sébastien Villemot ]
* Provide architectural defaults (i.e. precomputed timings) for all
  release archs (except armel and mips for the time being, due to slow
  porterboxes). This will make the package build much faster and should
  eliminate transient build failures due to excessive variance in the
  timings.
* Move symlinks for lib{cblas,f77blas,atlas,lapack_atlas} out of the
  libblas.so.3 alternative and make them always present, so that
  software relying on these libs do not break when another alternative
  is selected for BLAS
* ATLAS now has improved ARM support with native asm constructs. This required
  the following tunes:
  + armel-is-v4t.diff: new patch, prevents FTBFS on armel; otherwise,
    ATLAS uses asm constructs too recent for the platform (armel is only v4t)
  + debian/rules: on armhf, define the ATL_ARM_HARDFP flag; otherwise the asm
    constructs use the soft-float ABI for passing floating points
  + on armhf, ensure that -mfloat-abi=softfp and -mcpu=vfpv3 flags are never
    used; this is implemented via a patch (armhf.diff) and by the use of fixed
    archdefs
* The generic package is now built without multi-threading, because otherwise
  the package fails to build on some single-processor machines (this required
  the introduction of a patch: fix-non-threaded-build.diff). As a side effect,
  the build of the custom package gracefully handles non-threaded
  builds. (Closes: #602524)
* Add libblas.a as slave in the libblas.so alternative (Closes: #701921)
* Add symlinks for lib{f77blas,atlas}.a in /usr/lib (Closes: #666203)
* Modify shlibs file of libatlas3-base, such that packages using
  libblas/liblapack depend on any BLAS/LAPACK alternative, while packages
  depending on ATLAS-specific libraries (e.g. libatlas.so) depend specifically
  on libatlas3-base.
* corei1.diff: remove patch, applied upstream
* Use my @debian.org email address
* Remove obsolete DM-Upload-Allowed flag
* Switch VCS to git
* Remove Conflicts/Replaces against pre-squeeze packages
* libatlas-base-dev now provides libblas.so, as libblas-dev
* No longer use -Wa,--noexecstack in CFLAGS, it makes the package FTBFS
* Do not use POWER3 arch for powerpcspe port (Closes: #701068)
* Bump to debhelper compat level 9
* README.Debian: mention that devscripts is needed to compile the custom
  package (Closes: #697431)
* Bump Standards-Version to 3.9.4. As a consequence, add Built-Using
  fields because the package embeds stuff from liblapack-pic

Show diffs side-by-side

added added

removed removed

Lines of Context:
EXtest/r1test.c
 
1
/*
 
2
 *             Automatically Tuned Linear Algebra Software v3.10.1
 
3
 * Copyright (C) 2011 R. Clint Whaley
 
4
 *
 
5
 * Redistribution and use in source and binary forms, with or without
 
6
 * modification, are permitted provided that the following conditions
 
7
 * are met:
 
8
 *   1. Redistributions of source code must retain the above copyright
 
9
 *      notice, this list of conditions and the following disclaimer.
 
10
 *   2. Redistributions in binary form must reproduce the above copyright
 
11
 *      notice, this list of conditions, and the following disclaimer in the
 
12
 *      documentation and/or other materials provided with the distribution.
 
13
 *   3. The name of the ATLAS group or the names of its contributers may
 
14
 *      not be used to endorse or promote products derived from this
 
15
 *      software without specific written permission.
 
16
 *
 
17
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 
18
 * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 
19
 * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 
20
 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE ATLAS GROUP OR ITS CONTRIBUTORS
 
21
 * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 
22
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 
23
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 
24
 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 
25
 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 
26
 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 
27
 * POSSIBILITY OF SUCH DAMAGE.
 
28
 *
 
29
 */
 
30
#include "atlas_misc.h"
 
31
#include "atlas_tst.h"
 
32
#include "atlas_lvl2.h"
 
33
#include "atlas_level1.h"
 
34
#include <ctype.h>
 
35
int FAx=0, MAx=0, FAy=0, MAy=0, FAa=0, MAa=0;
 
36
#include <stdio.h>
 
37
#include <stdlib.h>
 
38
#include <assert.h>
 
39
 
 
40
struct FA_allocs
 
41
{
 
42
   void *mem, *memA;
 
43
   struct FA_allocs *next;
 
44
} *allocQ=NULL;
 
45
 
 
46
struct FA_allocs *NewAlloc(size_t size, struct FA_allocs *next,
 
47
                           int align, int misalign)
 
48
/*
 
49
 * Allocates size allocation that is aligned to [align], but not aligned
 
50
 * to [misalign].  Therefore, misalign > align.  Align must minimally be sizeof
 
51
 * while misalign may be 0 if we don't need to avoid a particular alignment.
 
52
 */
 
53
{
 
54
   void *vp;
 
55
   char *cp;
 
56
   struct FA_allocs *ap;
 
57
   int n, i;
 
58
   const int malign = align >= misalign ? align : misalign;
 
59
 
 
60
   n = size + align + align + malign;
 
61
   i = (n >> 3)<<3;
 
62
   if (n != i)
 
63
      n += n - i;
 
64
   cp = malloc(n + sizeof(struct FA_allocs));
 
65
   assert(cp);
 
66
   ap = (struct FA_allocs *) (cp + n);
 
67
   ap->mem = cp;
 
68
/*
 
69
 * Align to min alignment
 
70
 */
 
71
   ap->memA = align ? (void*) ((((size_t) cp)/align)*align + align) : cp;
 
72
/*
 
73
 * Misalign to misalign
 
74
 * We often need to make sure to unaligned addresses share the same modulo
 
75
 * so that they have the *same* degree of misalignment (so that their alignment
 
76
 * can be fixed by simple peeling), and so in this case force the address
 
77
 * modulo the misalign to be the exact align value.
 
78
 */
 
79
   if (misalign)
 
80
      ap->memA = (void*)((((size_t)ap->memA)/malign)*malign + malign + align);
 
81
   ap->next = next;
 
82
   return(ap);
 
83
}
 
84
 
 
85
/*
 
86
 * no-align malloc free retaining system default behavior
 
87
 */
 
88
void *NA_malloc(size_t size)
 
89
{
 
90
   return(malloc(size));
 
91
}
 
92
void *NA_calloc(size_t n, size_t size)
 
93
{
 
94
   return(calloc(n, size));
 
95
}
 
96
void NA_free(void *ptr)
 
97
{
 
98
   free(ptr);
 
99
}
 
100
 
 
101
 
 
102
/*
 
103
 * malloc/free pair that aligns data to align, but not to misalign
 
104
 */
 
105
void *FA_malloc(size_t size, int align, int misalign)
 
106
{
 
107
   if ((!misalign && align <= 8) || !size)
 
108
      return(malloc(size));
 
109
   else
 
110
   {
 
111
      allocQ = NewAlloc(size, allocQ, align, misalign);
 
112
      return(allocQ->memA);
 
113
   }
 
114
}
 
115
void *FA_calloc(size_t n, size_t size, int align, int misalign)
 
116
{
 
117
   char *cp;
 
118
   int *ip;
 
119
   double *dp;
 
120
   size_t i;
 
121
   size_t tsize;
 
122
   tsize = n * size;
 
123
   cp = FA_malloc(tsize, align, misalign);
 
124
   if (size == sizeof(int))
 
125
      for (ip=(int*)cp,i=0; i < n; i++)
 
126
        ip[i] = 0;
 
127
   else if (size == sizeof(double))
 
128
      for (dp=(double*)cp,i=0; i < n; i++)
 
129
        dp[i] = 0.0;
 
130
   else
 
131
      for (i=0; i < tsize; i++)
 
132
        cp[i] = 0;
 
133
   return(cp);
 
134
}
 
135
 
 
136
void FA_free(void *ptr, int align, int misalign)
 
137
/*
 
138
 * Part of malloc/free pair that aligns data to FALIGN
 
139
 */
 
140
{
 
141
   struct FA_allocs *ap, *prev;
 
142
   if (ptr)
 
143
   {
 
144
      if ((!misalign && align <= 8))
 
145
         free(ptr);
 
146
      else
 
147
      {
 
148
         for (ap=allocQ; ap && ap->memA != ptr; ap = ap->next) prev = ap;
 
149
         if (!ap)
 
150
         {
 
151
            fprintf(stderr, "Couldn't find mem=%ld\nmemQ=\n", (size_t)ptr);
 
152
            for (ap=allocQ; ap; ap = ap->next)
 
153
               fprintf(stderr, "   %ld, %ld\n", (size_t)ap->memA,
 
154
                       (size_t)ap->mem);
 
155
         }
 
156
         assert(ap);
 
157
         if (ap == allocQ)
 
158
            allocQ = allocQ->next;
 
159
         else
 
160
            prev->next = ap->next;
 
161
         free(ap->mem);
 
162
      }
 
163
   }
 
164
}
 
165
 
 
166
static void dumb_ger(int Conj, int M, int N, const SCALAR alpha, TYPE *X,
 
167
                     int incX, TYPE *Y, int incY, TYPE *A, int lda)
 
168
{
 
169
   #ifdef TCPLX
 
170
      TYPE tmp[2];
 
171
      const TYPE ra = alpha[0], ia = alpha[1];
 
172
   #endif
 
173
   int j;
 
174
 
 
175
   for (j=0; j < N; j++)
 
176
   {
 
177
   #ifdef TREAL
 
178
      const TYPE al = alpha * Y[j*incY];
 
179
      Mjoin(PATL,axpy)(M, al, X, incX, A+lda*j, 1);
 
180
   #else
 
181
      const TYPE rY = Y[2*j*incY], iY = Y[2*j*incY+1];
 
182
      tmp[0] = rY*ra - iY*ia;
 
183
      tmp[1] = rY*ia + iY*ra;
 
184
      if (Conj) tmp[1] = -tmp[1];
 
185
      Mjoin(PATL,axpy)(M, tmp, X, incX, A+2*lda*j, 1);
 
186
   #endif
 
187
   }
 
188
}
 
189
static int CheckAns(int M, int N, TYPE *G, int ldg, TYPE *U, int ldu)
 
190
{
 
191
   TYPE diff, eps;
 
192
   int i, j, ierr=0;
 
193
   #ifdef TREAL
 
194
      const int M2 = M, emul=4;
 
195
   #else
 
196
      const int M2 = M<<1, emul=4*4;
 
197
      ldg <<= 1; ldu <<= 1;
 
198
   #endif
 
199
 
 
200
   eps = Mjoin(PATL,epsilon)();
 
201
   for (j=0; j < N; j++, G += ldg, U += ldu)
 
202
   {
 
203
      for (i=0; i < M2; i++)
 
204
      {
 
205
         diff = G[i] - U[i];
 
206
         if (diff < ATL_rzero) diff = -diff;
 
207
         if (diff > emul*eps)
 
208
         {
 
209
            fprintf(stderr, "A(%d,%d): Good=%f, Computed=%f\n",
 
210
                    i, j, G[i], U[i]);
 
211
            if (!ierr) ierr = i+j*M+1;
 
212
         }
 
213
      }
 
214
   }
 
215
   return(ierr);
 
216
}
 
217
 
 
218
#define NX M
 
219
#define NY N
 
220
#ifdef TCPLX
 
221
   #define ATL_gerT Mjoin(PATL,geru)
 
222
#else
 
223
   #define ATL_gerT Mjoin(PATL,ger)
 
224
#endif
 
225
void ATL_gerT(ATL_CINT M, ATL_CINT N, const SCALAR alpha,
 
226
              const TYPE *X, ATL_CINT incX, const TYPE *Y, ATL_CINT incY,
 
227
              TYPE *A, ATL_CINT lda);
 
228
#define ATL_rS2C(sc_) \
 
229
   (((sc_) == ATL_rzero) ? '0' : ( ((sc_) == ATL_rone) ? '1' : 'X'))
 
230
#ifdef TCPLX
 
231
   #define ATL_S2C(sc_) ATL_rS2C(sc_[0]), ATL_rS2C(sc_[1])
 
232
#else
 
233
   #define ATL_S2C(sc_) ATL_rS2C(sc_)
 
234
#endif
 
235
 
 
236
static int RunTest(int CONJ, int M, int N, int incY, int lda, int II)
 
237
{
 
238
   #ifdef TCPLX
 
239
      TYPE one[2] = {ATL_rone, ATL_rzero};
 
240
      #ifdef ALPHA0
 
241
         const TYPE alpha[2] = {ATL_rzero, ATL_rzero};
 
242
      #elif defined(ALPHAX)
 
243
         const TYPE alpha[2] = {ATL_rone, ATL_rzero};
 
244
      #else
 
245
         const TYPE alpha[2] = {0.5, 2.1};
 
246
      #endif
 
247
   #else
 
248
      TYPE one = ATL_rone;
 
249
      #ifdef ALPHA0
 
250
         const TYPE alpha = ATL_rzero;
 
251
      #elif defined(ALPHAX)
 
252
         const TYPE alpha = ATL_rone;
 
253
      #else
 
254
         const TYPE alpha = 2.0;
 
255
      #endif
 
256
   #endif
 
257
   TYPE *A, *A0, *X, *Y, *y;
 
258
   ATL_CINT aincY = Mabs(incY), incX=1, aincX=1;
 
259
   #ifdef TCPLX
 
260
      char *frm = "%6d %5d %5d %5d %4d %4d %c,%c  %4x %4x %4x  %6s\n";
 
261
   #else
 
262
      char *frm = "%6d %5d %5d %5d %4d %4d   %c  %4x %4x %4x  %6s\n";
 
263
   #endif
 
264
   int ierr;
 
265
   if (!II)
 
266
   {
 
267
      printf("\n");
 
268
      printf(
 
269
         "           M     N   lda incY incX alp    A    X     Y   PASS?\n");
 
270
      printf(
 
271
         "====== ===== ===== ===== ==== ==== ===  ==== ==== ====  ======\n");
 
272
   }
 
273
   A = FA_malloc(ATL_MulBySize(lda)*N, FAa, MAa);
 
274
   A0 = FA_malloc(ATL_MulBySize(M)*N, FAa, MAa);
 
275
   Y = FA_malloc(ATL_MulBySize(NY)*aincY, FAy, MAy);
 
276
   X = FA_malloc(ATL_MulBySize(NX), FAx, MAx);
 
277
   ATL_assert(A && A0 && X && Y);
 
278
   printf(frm, II, M, N, lda, incY, incX, ATL_S2C(alpha), ((size_t)A)&0xFFFF,
 
279
          ((size_t)X)&0xFFFF, ((size_t)Y)&0xFFFF, " START");
 
280
   Mjoin(PATL,gegen)(1, NY, Y, aincY, NY*aincY);
 
281
   Mjoin(PATL,gegen)(1, NX, X, aincX, NY*aincY+127*50+77);
 
282
   Mjoin(PATL,gegen)(M, N, A0, M, N*M+513*7+90);
 
283
   Mjoin(PATL,gegen)(M, N, A, lda, N*M+513*7+90);
 
284
   if (incY < 0) Y += (NY-1) * (aincY SHIFT);
 
285
 
 
286
   ATL_gerT(M, N, alpha, X, incX, Y, incY, A, lda);
 
287
   dumb_ger(CONJ, M, N, alpha, X, 1, Y, incY, A0, M);
 
288
 
 
289
   if (incY < 0) Y -= (N-1) * (aincY SHIFT);
 
290
   FA_free(Y, FAy, MAy);
 
291
   FA_free(X, FAx, MAx);
 
292
   ierr = CheckAns(M, N, A0, M, A, lda);
 
293
   FA_free(A, FAa, MAa);
 
294
   FA_free(A0, FAa, MAa);
 
295
 
 
296
   printf(frm, II, M, N, lda, incY, incX, ATL_S2C(alpha), ((size_t)A)&0xFFFF,
 
297
          ((size_t) X)&0xFFFF, ((size_t) Y)&0xFFFF, (ierr) ? "FAILED":"PASSED");
 
298
   return(ierr);
 
299
}
 
300
#undef NX
 
301
#undef NY
 
302
 
 
303
int RunTests(int verb, int *CONJs, int *Ms, int *Ns, int *incYs, int *ldas)
 
304
{
 
305
   int iy, ix, ic, in, im, iax, iay, iaa;
 
306
   ATL_INT m, n, lda, conj, incy;
 
307
   int nerr=0, II=0;
 
308
   assert(ldas[0] == Ms[0]);
 
309
   for (in=1; in <= Ns[0]; in++)
 
310
   {
 
311
      n = Ns[in];
 
312
      for (im=1; im <= Ms[0]; im++)
 
313
      {
 
314
         m = Ms[im];
 
315
         lda = ldas[im];
 
316
         for (iy=1; iy <= incYs[0]; iy++)
 
317
         {
 
318
            incy = incYs[iy];
 
319
            for (ic=1; ic <= CONJs[0]; ic++)
 
320
            {
 
321
               conj = CONJs[ic];
 
322
               for (iaa=0; iaa < 8; iaa++)
 
323
               {
 
324
                  FAa = iaa*sizeof(TYPE);
 
325
                  MAa = FAa + sizeof(TYPE);
 
326
                  for (iay=0; iay < 8; iay++)
 
327
                  {
 
328
                     FAy = iay*sizeof(TYPE);
 
329
                     MAy = FAy + sizeof(TYPE);
 
330
                     for (iax=0; iax < 8; iax++)
 
331
                     {
 
332
                        FAx = iax*sizeof(TYPE);
 
333
                        MAx = FAx + sizeof(TYPE);
 
334
                        nerr += RunTest(conj, m, n, incy, lda, II++);
 
335
                        if (nerr && !verb)
 
336
                           return(nerr);
 
337
                     }
 
338
                  }
 
339
               }
 
340
            }
 
341
         }
 
342
      }
 
343
   }
 
344
   if (nerr)
 
345
      printf("FAILED: %d of %d tests!\n", nerr, II);
 
346
   else
 
347
      printf("PASSED: all %d tests.\n", II);
 
348
   return(nerr);
 
349
}
 
350
 
 
351
void PrintUsage(char *name, int ierr, char *flag)
 
352
{
 
353
   if (ierr > 0)
 
354
      fprintf(stderr, "Bad argument #%d: '%s'\n",
 
355
              ierr, flag ? flag : "Not enough arguments");
 
356
   else if (ierr < 0)
 
357
      fprintf(stderr, "ERROR: %s\n", flag);
 
358
 
 
359
   fprintf(stderr, "USAGE: %s [flags]:\n", name);
 
360
   fprintf(stderr, "   -n <#> <N1> ... <N#>\n");
 
361
   fprintf(stderr, "   -N <Nstart> <Nend> <Ninc>\n");
 
362
   fprintf(stderr, "   -m <#> <M1> ... <M#>\n");
 
363
   fprintf(stderr, "   -M <Mstart> <Mend> <Minc>\n");
 
364
   fprintf(stderr, "   -l <#> <lda1> ... <lda#>\n");
 
365
   fprintf(stderr, "   -g <ldagap> : lda = M + <ldagap> foreach M\n");
 
366
   fprintf(stderr, "   -y <#> <incY1> ... <incY#>\n");
 
367
   fprintf(stderr, "   -x <#> <incX1> ... <incX#>\n");
 
368
   fprintf(stderr, "   -C <#> <conj1> ... <conj#>\n");
 
369
   fprintf(stderr,
 
370
           "   -v [0,1] : 0 - stop on first error, else keep testing\n");
 
371
   fprintf(stderr,
 
372
"   -F[x,y,a] <#> : if(# > 0) -> force op to be aligned to at least # bytes\n");
 
373
   fprintf(stderr,
 
374
      "                   if(# < 0) -> force op to be aligned to < # bytes.\n");
 
375
 
 
376
   exit(ierr ? ierr : -1);
 
377
}
 
378
 
 
379
 
 
380
/* procedure 1 */
 
381
int *GetIntList1(int ival)
 
382
/*
 
383
 * returns integer array with iarr[0] = 1, iarr[1] = ival
 
384
 */
 
385
{
 
386
   int *iarr;
 
387
   iarr = malloc(2*sizeof(int));
 
388
   ATL_assert(iarr);
 
389
   iarr[0] = 1;
 
390
   iarr[1] = ival;
 
391
   return(iarr);
 
392
}
 
393
 
 
394
#ifdef TYPE
 
395
/* procedure 2 */
 
396
TYPE *GetTypeList1(const SCALAR val)
 
397
/*
 
398
 * Returns a TYPE array with arr[0] = 1.0, arr[1] = val
 
399
 */
 
400
{
 
401
   TYPE *arr;
 
402
   arr = malloc(ATL_MulBySize(2));
 
403
   ATL_assert(arr);
 
404
   arr[0] = 1;
 
405
   #ifdef TCPLX
 
406
      arr[2] = *val;
 
407
      arr[3] = val[1];
 
408
   #else
 
409
      arr[1] = val;
 
410
   #endif
 
411
   return(arr);
 
412
}
 
413
#endif
 
414
 
 
415
/* procedure 3 */
 
416
int *GetIntList2(int ival1, int ival2)
 
417
/*
 
418
 * returns integer array with iarr[0] = 1, iarr[1] = ival1, ival[2] = ival2
 
419
 */
 
420
{
 
421
   int *iarr;
 
422
   iarr = malloc(3*sizeof(int));
 
423
   ATL_assert(iarr);
 
424
   iarr[0] = 1;
 
425
   iarr[1] = ival1;
 
426
   iarr[2] = ival2;
 
427
   return(iarr);
 
428
}
 
429
 
 
430
/* procedure 4 */
 
431
int *DupIntList(int *list)
 
432
/*
 
433
 * Duplicates list of integers, list[0] holds the length, not including 0
 
434
 */
 
435
{
 
436
   int i, n, *ip;
 
437
 
 
438
   assert(list);
 
439
   n = list[0] + 1;
 
440
   ip = malloc(sizeof(int)*n);
 
441
   assert(ip);
 
442
   for (i=0; i < n; i++)
 
443
      ip[i] = list[i];
 
444
   return(ip);
 
445
}
 
446
 
 
447
/* procedure 5 */
 
448
int *GetIntList(int nargs, char **args, int i, int nmul)
 
449
/*
 
450
 * Gets a list of integers, whose length is given by atoi(args[i])*nmul
 
451
 * list is this length+1, since 0'th location gets atoi(args[i])
 
452
 */
 
453
{
 
454
   int n, *iarr, k;
 
455
 
 
456
   if (++i >= nargs)
 
457
      PrintUsage(args[0], i, NULL);
 
458
   n = atoi(args[i]) * nmul;
 
459
   ATL_assert(n > 0);
 
460
   iarr = malloc(sizeof(int)*(n+1));
 
461
   ATL_assert(iarr);
 
462
 
 
463
   iarr[0] = n / nmul;
 
464
   for (k=0; k < n; k++)
 
465
   {
 
466
      if (++i >= nargs)
 
467
         PrintUsage(args[0], i, NULL);
 
468
      iarr[k+1] = atoi(args[i]);
 
469
   }
 
470
   return(iarr);
 
471
}
 
472
 
 
473
#ifdef TYPE
 
474
/* procedure 6 */
 
475
TYPE *GetTypeList(int nargs, char **args, int i, int nmul)
 
476
/*
 
477
 * Gets a list of TYPEs, whose length is given by atoi(args[i])*nmul
 
478
 * list is this length+1, since 0'th location gets atof(args[i])
 
479
 */
 
480
{
 
481
   int n, k;
 
482
   TYPE *arr;
 
483
 
 
484
   if (++i >= nargs)
 
485
      PrintUsage(args[0], i, NULL);
 
486
   n = atoi(args[i]) * nmul;
 
487
   ATL_assert(n > 0);
 
488
   arr = malloc(ATL_MulBySize(n+1));
 
489
   ATL_assert(arr);
 
490
 
 
491
   arr[0] = n / nmul;
 
492
   for (k=0; k < n; k++)
 
493
   {
 
494
      if (++i >= nargs)
 
495
         PrintUsage(args[0], i, NULL);
 
496
      arr[k+(1 SHIFT)] = atof(args[i]);
 
497
   }
 
498
   return(arr);
 
499
}
 
500
#endif
 
501
 
 
502
/* procedure 7 */
 
503
int *IntRange2IntList(int N0, int NN, int incN)
 
504
{
 
505
   int i, n;
 
506
   int *iarr;
 
507
 
 
508
   for (i=N0, n=0; i <= NN; i += incN) n++;
 
509
   iarr = malloc(sizeof(int)*(n+1));
 
510
   ATL_assert(iarr);
 
511
   iarr[0] = n;
 
512
   for (i=N0, n=1 ; i <= NN; i += incN, n++)
 
513
      iarr[n] = i;
 
514
   return(iarr);
 
515
}
 
516
 
 
517
int GetFlags(int nargs, char **args, int **CONJs, int **Ms, int **Ns,
 
518
             int **LDAs, int **incYs, int **incXs)
 
519
{
 
520
   int verb, i, k, *ip;
 
521
   char ch;
 
522
   int ldagap = 8;
 
523
 
 
524
   *Ns = *Ms = *LDAs = *incYs = *incXs = *CONJs = NULL;
 
525
   verb = 0;
 
526
 
 
527
   for (i=1; i < nargs; i++)
 
528
   {
 
529
      if (args[i][0] != '-')
 
530
         PrintUsage(args[0], i, args[i]);
 
531
      ch = args[i][1];
 
532
      switch(ch)
 
533
      {
 
534
      case 'v':
 
535
        if (++i >= nargs)
 
536
            PrintUsage(args[0], i-1, "out of flags in -g ");
 
537
         verb = atoi(args[i]);
 
538
         break;
 
539
      case 'g':
 
540
        if (++i >= nargs)
 
541
            PrintUsage(args[0], i-1, "out of flags in -g ");
 
542
         ldagap = atoi(args[i]);
 
543
         break;
 
544
      case 'M':
 
545
      case 'N':
 
546
         if (i+3 >= nargs)
 
547
            PrintUsage(args[0], i-1, "out of flags in -N/M ");
 
548
         ip = IntRange2IntList(atoi(args[i+1]),atoi(args[i+2]),atoi(args[i+3]));
 
549
         if (ch == 'M')
 
550
            *Ms = ip;
 
551
         else
 
552
            *Ns = ip;
 
553
         i += 3;
 
554
         break;
 
555
      case 'n':
 
556
      case 'm':
 
557
      case 'l':
 
558
      case 'y':
 
559
      case 'x':
 
560
         ip = GetIntList(nargs, args, i, 1);
 
561
         i += ip[0] + 1;
 
562
         switch(ch)
 
563
         {
 
564
         case 'n':
 
565
            *Ns = ip;
 
566
            break;
 
567
         case 'm':
 
568
            *Ms = ip;
 
569
            break;
 
570
         case 'l':
 
571
            *LDAs = ip;
 
572
            break;
 
573
         case 'y':
 
574
            *incYs = ip;
 
575
            break;
 
576
         case 'x':
 
577
            *incXs = ip;
 
578
            break;
 
579
         }
 
580
         break;
 
581
      default:
 
582
         PrintUsage(args[0], i, args[i]);
 
583
      }
 
584
   }
 
585
   if (*CONJs == NULL)
 
586
   #ifdef TCPX
 
587
      *CONJs = GetIntList2(0, 1);
 
588
   #else
 
589
      *CONJs = GetIntList1(0);
 
590
   #endif
 
591
   if (*incXs == NULL)
 
592
      *incXs = GetIntList1(1);
 
593
   if (*incYs == NULL)
 
594
      *incYs = GetIntList1(1);
 
595
   if (*Ms == NULL)
 
596
      *Ms = GetIntList1(977);
 
597
   if (*Ns == NULL)
 
598
      *Ns = GetIntList1(77);
 
599
   if (*LDAs == NULL)
 
600
   {
 
601
      *LDAs = DupIntList(*Ms);
 
602
      for (i=1; i <= (*LDAs)[0]; i++)
 
603
         (*LDAs)[i] += ldagap;
 
604
   }
 
605
   assert((*LDAs)[0] == (*Ms)[0]);
 
606
   return(verb);
 
607
}
 
608
 
 
609
int main(int nargs, char **args)
 
610
{
 
611
   int *Ms, *Ns, *LDAs, *incYs, *incXs, *CONJs;
 
612
   int verb, ierr=0;
 
613
 
 
614
   verb = GetFlags(nargs, args, &CONJs, &Ms, &Ns, &LDAs, &incYs, &incXs);
 
615
   ierr = RunTests(verb, CONJs, Ms, Ns, incYs, LDAs);
 
616
   free(CONJs);
 
617
   free(incXs);
 
618
   free(incYs);
 
619
   free(Ms);
 
620
   free(Ns);
 
621
   free(LDAs);
 
622
   exit(ierr);
 
623
}