examples/arm+dsp/ludinv/dlatm1.c

   1 /* dlatm1.f -- translated by f2c (version 20061008).
   2    You must link the resulting object file with libf2c:
   3         on Microsoft Windows system, link with libf2c.lib;
   4         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
   5         or, if you install libf2c.a in a standard place, with -lf2c -lm
   6         -- in that order, at the end of the command line, as in
   7                 cc *.o -lf2c -lm
   8         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
   9
  10                 http://www.netlib.org/f2c/libf2c.zip
  11 */
  12
  13 #include "f2c.h"
  14 #include "blaswrap.h"
  15
  16 /* Subroutine */ int dlatm1_(integer *mode, doublereal *cond, integer *irsign,
  17          integer *idist, integer *iseed, doublereal *d__, integer *n, integer
  18         *info)
  19 {
  20     /* System generated locals */
  21     integer i__1, i__2;
  22     doublereal d__1;
  23
  24     /* Builtin functions */
  25     double pow_dd(doublereal *, doublereal *), pow_di(doublereal *, integer *)
  26             , log(doublereal), exp(doublereal);
  27
  28     /* Local variables */
  29     integer i__;
  30     doublereal temp, alpha;
  31     extern doublereal dlaran_(integer *);
  32     extern /* Subroutine */ int xerbla_(char *, integer *), dlarnv_(
  33             integer *, integer *, integer *, doublereal *);
  34
  35
  36 /*  -- LAPACK auxiliary test routine (version 3.1) -- */
  37 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  38 /*     November 2006 */
  39
  40 /*     .. Scalar Arguments .. */
  41 /*     .. */
  42 /*     .. Array Arguments .. */
  43 /*     .. */
  44
  45 /*  Purpose */
  46 /*  ======= */
  47
  48 /*     DLATM1 computes the entries of D(1..N) as specified by */
  49 /*     MODE, COND and IRSIGN. IDIST and ISEED determine the generation */
  50 /*     of random numbers. DLATM1 is called by SLATMR to generate */
  51 /*     random test matrices for LAPACK programs. */
  52
  53 /*  Arguments */
  54 /*  ========= */
  55
  56 /*  MODE   - INTEGER */
  57 /*           On entry describes how D is to be computed: */
  58 /*           MODE = 0 means do not change D. */
  59 /*           MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND */
  60 /*           MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND */
  61 /*           MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) */
  62 /*           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) */
  63 /*           MODE = 5 sets D to random numbers in the range */
  64 /*                    ( 1/COND , 1 ) such that their logarithms */
  65 /*                    are uniformly distributed. */
  66 /*           MODE = 6 set D to random numbers from same distribution */
  67 /*                    as the rest of the matrix. */
  68 /*           MODE < 0 has the same meaning as ABS(MODE), except that */
  69 /*              the order of the elements of D is reversed. */
  70 /*           Thus if MODE is positive, D has entries ranging from */
  71 /*              1 to 1/COND, if negative, from 1/COND to 1, */
  72 /*           Not modified. */
  73
  74 /*  COND   - DOUBLE PRECISION */
  75 /*           On entry, used as described under MODE above. */
  76 /*           If used, it must be >= 1. Not modified. */
  77
  78 /*  IRSIGN - INTEGER */
  79 /*           On entry, if MODE neither -6, 0 nor 6, determines sign of */
  80 /*           entries of D */
  81 /*           0 => leave entries of D unchanged */
  82 /*           1 => multiply each entry of D by 1 or -1 with probability .5 */
  83
  84 /*  IDIST  - CHARACTER*1 */
  85 /*           On entry, IDIST specifies the type of distribution to be */
  86 /*           used to generate a random matrix . */
  87 /*           1 => UNIFORM( 0, 1 ) */
  88 /*           2 => UNIFORM( -1, 1 ) */
  89 /*           3 => NORMAL( 0, 1 ) */
  90 /*           Not modified. */
  91
  92 /*  ISEED  - INTEGER array, dimension ( 4 ) */
  93 /*           On entry ISEED specifies the seed of the random number */
  94 /*           generator. The random number generator uses a */
  95 /*           linear congruential sequence limited to small */
  96 /*           integers, and so should produce machine independent */
  97 /*           random numbers. The values of ISEED are changed on */
  98 /*           exit, and can be used in the next call to DLATM1 */
  99 /*           to continue the same random number sequence. */
 100 /*           Changed on exit. */
 101
 102 /*  D      - DOUBLE PRECISION array, dimension ( MIN( M , N ) ) */
 103 /*           Array to be computed according to MODE, COND and IRSIGN. */
 104 /*           May be changed on exit if MODE is nonzero. */
 105
 106 /*  N      - INTEGER */
 107 /*           Number of entries of D. Not modified. */
 108
 109 /*  INFO   - INTEGER */
 110 /*            0  => normal termination */
 111 /*           -1  => if MODE not in range -6 to 6 */
 112 /*           -2  => if MODE neither -6, 0 nor 6, and */
 113 /*                  IRSIGN neither 0 nor 1 */
 114 /*           -3  => if MODE neither -6, 0 nor 6 and COND less than 1 */
 115 /*           -4  => if MODE equals 6 or -6 and IDIST not in range 1 to 3 */
 116 /*           -7  => if N negative */
 117
 118 /*  ===================================================================== */
 119
 120 /*     .. Parameters .. */
 121 /*     .. */
 122 /*     .. Local Scalars .. */
 123 /*     .. */
 124 /*     .. External Functions .. */
 125 /*     .. */
 126 /*     .. External Subroutines .. */
 127 /*     .. */
 128 /*     .. Intrinsic Functions .. */
 129 /*     .. */
 130 /*     .. Executable Statements .. */
 131
 132 /*     Decode and Test the input parameters. Initialize flags & seed. */
 133
 134     /* Parameter adjustments */
 135     --d__;
 136     --iseed;
 137
 138     /* Function Body */
 139     *info = 0;
 140
 141 /*     Quick return if possible */
 142
 143     if (*n == 0) {
 144         return 0;
 145     }
 146
 147 /*     Set INFO if an error */
 148
 149     if (*mode < -6 || *mode > 6) {
 150         *info = -1;
 151     } else if (*mode != -6 && *mode != 0 && *mode != 6 && (*irsign != 0 && *
 152             irsign != 1)) {
 153         *info = -2;
 154     } else if (*mode != -6 && *mode != 0 && *mode != 6 && *cond < 1.) {
 155         *info = -3;
 156     } else if ((*mode == 6 || *mode == -6) && (*idist < 1 || *idist > 3)) {
 157         *info = -4;
 158     } else if (*n < 0) {
 159         *info = -7;
 160     }
 161
 162     if (*info != 0) {
 163         i__1 = -(*info);
 164         xerbla_("DLATM1", &i__1);
 165         return 0;
 166     }
 167
 168 /*     Compute D according to COND and MODE */
 169
 170     if (*mode != 0) {
 171         switch (abs(*mode)) {
 172             case 1:  goto L10;
 173             case 2:  goto L30;
 174             case 3:  goto L50;
 175             case 4:  goto L70;
 176             case 5:  goto L90;
 177             case 6:  goto L110;
 178         }
 179
 180 /*        One large D value: */
 181
 182 L10:
 183         i__1 = *n;
 184         for (i__ = 1; i__ <= i__1; ++i__) {
 185             d__[i__] = 1. / *cond;
 186 /* L20: */
 187         }
 188         d__[1] = 1.;
 189         goto L120;
 190
 191 /*        One small D value: */
 192
 193 L30:
 194         i__1 = *n;
 195         for (i__ = 1; i__ <= i__1; ++i__) {
 196             d__[i__] = 1.;
 197 /* L40: */
 198         }
 199         d__[*n] = 1. / *cond;
 200         goto L120;
 201
 202 /*        Exponentially distributed D values: */
 203
 204 L50:
 205         d__[1] = 1.;
 206         if (*n > 1) {
 207             d__1 = -1. / (doublereal) (*n - 1);
 208             alpha = pow_dd(cond, &d__1);
 209             i__1 = *n;
 210             for (i__ = 2; i__ <= i__1; ++i__) {
 211                 i__2 = i__ - 1;
 212                 d__[i__] = pow_di(&alpha, &i__2);
 213 /* L60: */
 214             }
 215         }
 216         goto L120;
 217
 218 /*        Arithmetically distributed D values: */
 219
 220 L70:
 221         d__[1] = 1.;
 222         if (*n > 1) {
 223             temp = 1. / *cond;
 224             alpha = (1. - temp) / (doublereal) (*n - 1);
 225             i__1 = *n;
 226             for (i__ = 2; i__ <= i__1; ++i__) {
 227                 d__[i__] = (doublereal) (*n - i__) * alpha + temp;
 228 /* L80: */
 229             }
 230         }
 231         goto L120;
 232
 233 /*        Randomly distributed D values on ( 1/COND , 1): */
 234
 235 L90:
 236         alpha = log(1. / *cond);
 237         i__1 = *n;
 238         for (i__ = 1; i__ <= i__1; ++i__) {
 239             d__[i__] = exp(alpha * dlaran_(&iseed[1]));
 240 /* L100: */
 241         }
 242         goto L120;
 243
 244 /*        Randomly distributed D values from IDIST */
 245
 246 L110:
 247         dlarnv_(idist, &iseed[1], n, &d__[1]);
 248
 249 L120:
 250
 251 /*        If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign */
 252 /*        random signs to D */
 253
 254         if (*mode != -6 && *mode != 0 && *mode != 6 && *irsign == 1) {
 255             i__1 = *n;
 256             for (i__ = 1; i__ <= i__1; ++i__) {
 257                 temp = dlaran_(&iseed[1]);
 258                 if (temp > .5) {
 259                     d__[i__] = -d__[i__];
 260                 }
 261 /* L130: */
 262             }
 263         }
 264
 265 /*        Reverse if MODE < 0 */
 266
 267         if (*mode < 0) {
 268             i__1 = *n / 2;
 269             for (i__ = 1; i__ <= i__1; ++i__) {
 270                 temp = d__[i__];
 271                 d__[i__] = d__[*n + 1 - i__];
 272                 d__[*n + 1 - i__] = temp;
 273 /* L140: */
 274             }
 275         }
 276
 277     }
 278
 279     return 0;
 280
 281 /*     End of DLATM1 */
 282
 283 } /* dlatm1_ */