clatm1.c
Go to the documentation of this file.
00001 /* clatm1.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Table of constant values */
00017 
00018 static integer c__3 = 3;
00019 
00020 /* Subroutine */ int clatm1_(integer *mode, real *cond, integer *irsign, 
00021         integer *idist, integer *iseed, complex *d__, integer *n, integer *
00022         info)
00023 {
00024     /* System generated locals */
00025     integer i__1, i__2, i__3;
00026     real r__1;
00027     doublereal d__1, d__2;
00028     complex q__1, q__2;
00029 
00030     /* Builtin functions */
00031     double pow_dd(doublereal *, doublereal *), pow_ri(real *, integer *), log(
00032             doublereal), exp(doublereal), c_abs(complex *);
00033 
00034     /* Local variables */
00035     integer i__;
00036     real temp, alpha;
00037     complex ctemp;
00038     extern /* Complex */ VOID clarnd_(complex *, integer *, integer *);
00039     extern /* Subroutine */ int xerbla_(char *, integer *);
00040     extern doublereal slaran_(integer *);
00041     extern /* Subroutine */ int clarnv_(integer *, integer *, integer *, 
00042             complex *);
00043 
00044 
00045 /*  -- LAPACK auxiliary test routine (version 3.1) -- */
00046 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00047 /*     November 2006 */
00048 
00049 /*     .. Scalar Arguments .. */
00050 /*     .. */
00051 /*     .. Array Arguments .. */
00052 /*     .. */
00053 
00054 /*  Purpose */
00055 /*  ======= */
00056 
00057 /*     CLATM1 computes the entries of D(1..N) as specified by */
00058 /*     MODE, COND and IRSIGN. IDIST and ISEED determine the generation */
00059 /*     of random numbers. CLATM1 is called by CLATMR to generate */
00060 /*     random test matrices for LAPACK programs. */
00061 
00062 /*  Arguments */
00063 /*  ========= */
00064 
00065 /*  MODE   - INTEGER */
00066 /*           On entry describes how D is to be computed: */
00067 /*           MODE = 0 means do not change D. */
00068 /*           MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND */
00069 /*           MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND */
00070 /*           MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) */
00071 /*           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) */
00072 /*           MODE = 5 sets D to random numbers in the range */
00073 /*                    ( 1/COND , 1 ) such that their logarithms */
00074 /*                    are uniformly distributed. */
00075 /*           MODE = 6 set D to random numbers from same distribution */
00076 /*                    as the rest of the matrix. */
00077 /*           MODE < 0 has the same meaning as ABS(MODE), except that */
00078 /*              the order of the elements of D is reversed. */
00079 /*           Thus if MODE is positive, D has entries ranging from */
00080 /*              1 to 1/COND, if negative, from 1/COND to 1, */
00081 /*           Not modified. */
00082 
00083 /*  COND   - REAL */
00084 /*           On entry, used as described under MODE above. */
00085 /*           If used, it must be >= 1. Not modified. */
00086 
00087 /*  IRSIGN - INTEGER */
00088 /*           On entry, if MODE neither -6, 0 nor 6, determines sign of */
00089 /*           entries of D */
00090 /*           0 => leave entries of D unchanged */
00091 /*           1 => multiply each entry of D by random complex number */
00092 /*                uniformly distributed with absolute value 1 */
00093 
00094 /*  IDIST  - CHARACTER*1 */
00095 /*           On entry, IDIST specifies the type of distribution to be */
00096 /*           used to generate a random matrix . */
00097 /*           1 => real and imaginary parts each UNIFORM( 0, 1 ) */
00098 /*           2 => real and imaginary parts each UNIFORM( -1, 1 ) */
00099 /*           3 => real and imaginary parts each NORMAL( 0, 1 ) */
00100 /*           4 => complex number uniform in DISK( 0, 1 ) */
00101 /*           Not modified. */
00102 
00103 /*  ISEED  - INTEGER array, dimension ( 4 ) */
00104 /*           On entry ISEED specifies the seed of the random number */
00105 /*           generator. The random number generator uses a */
00106 /*           linear congruential sequence limited to small */
00107 /*           integers, and so should produce machine independent */
00108 /*           random numbers. The values of ISEED are changed on */
00109 /*           exit, and can be used in the next call to CLATM1 */
00110 /*           to continue the same random number sequence. */
00111 /*           Changed on exit. */
00112 
00113 /*  D      - COMPLEX array, dimension ( MIN( M , N ) ) */
00114 /*           Array to be computed according to MODE, COND and IRSIGN. */
00115 /*           May be changed on exit if MODE is nonzero. */
00116 
00117 /*  N      - INTEGER */
00118 /*           Number of entries of D. Not modified. */
00119 
00120 /*  INFO   - INTEGER */
00121 /*            0  => normal termination */
00122 /*           -1  => if MODE not in range -6 to 6 */
00123 /*           -2  => if MODE neither -6, 0 nor 6, and */
00124 /*                  IRSIGN neither 0 nor 1 */
00125 /*           -3  => if MODE neither -6, 0 nor 6 and COND less than 1 */
00126 /*           -4  => if MODE equals 6 or -6 and IDIST not in range 1 to 4 */
00127 /*           -7  => if N negative */
00128 
00129 /*  ===================================================================== */
00130 
00131 /*     .. Parameters .. */
00132 /*     .. */
00133 /*     .. Local Scalars .. */
00134 /*     .. */
00135 /*     .. External Functions .. */
00136 /*     .. */
00137 /*     .. External Subroutines .. */
00138 /*     .. */
00139 /*     .. Intrinsic Functions .. */
00140 /*     .. */
00141 /*     .. Executable Statements .. */
00142 
00143 /*     Decode and Test the input parameters. Initialize flags & seed. */
00144 
00145     /* Parameter adjustments */
00146     --d__;
00147     --iseed;
00148 
00149     /* Function Body */
00150     *info = 0;
00151 
00152 /*     Quick return if possible */
00153 
00154     if (*n == 0) {
00155         return 0;
00156     }
00157 
00158 /*     Set INFO if an error */
00159 
00160     if (*mode < -6 || *mode > 6) {
00161         *info = -1;
00162     } else if (*mode != -6 && *mode != 0 && *mode != 6 && (*irsign != 0 && *
00163             irsign != 1)) {
00164         *info = -2;
00165     } else if (*mode != -6 && *mode != 0 && *mode != 6 && *cond < 1.f) {
00166         *info = -3;
00167     } else if ((*mode == 6 || *mode == -6) && (*idist < 1 || *idist > 4)) {
00168         *info = -4;
00169     } else if (*n < 0) {
00170         *info = -7;
00171     }
00172 
00173     if (*info != 0) {
00174         i__1 = -(*info);
00175         xerbla_("CLATM1", &i__1);
00176         return 0;
00177     }
00178 
00179 /*     Compute D according to COND and MODE */
00180 
00181     if (*mode != 0) {
00182         switch (abs(*mode)) {
00183             case 1:  goto L10;
00184             case 2:  goto L30;
00185             case 3:  goto L50;
00186             case 4:  goto L70;
00187             case 5:  goto L90;
00188             case 6:  goto L110;
00189         }
00190 
00191 /*        One large D value: */
00192 
00193 L10:
00194         i__1 = *n;
00195         for (i__ = 1; i__ <= i__1; ++i__) {
00196             i__2 = i__;
00197             r__1 = 1.f / *cond;
00198             d__[i__2].r = r__1, d__[i__2].i = 0.f;
00199 /* L20: */
00200         }
00201         d__[1].r = 1.f, d__[1].i = 0.f;
00202         goto L120;
00203 
00204 /*        One small D value: */
00205 
00206 L30:
00207         i__1 = *n;
00208         for (i__ = 1; i__ <= i__1; ++i__) {
00209             i__2 = i__;
00210             d__[i__2].r = 1.f, d__[i__2].i = 0.f;
00211 /* L40: */
00212         }
00213         i__1 = *n;
00214         r__1 = 1.f / *cond;
00215         d__[i__1].r = r__1, d__[i__1].i = 0.f;
00216         goto L120;
00217 
00218 /*        Exponentially distributed D values: */
00219 
00220 L50:
00221         d__[1].r = 1.f, d__[1].i = 0.f;
00222         if (*n > 1) {
00223             d__1 = (doublereal) (*cond);
00224             d__2 = (doublereal) (-1.f / (real) (*n - 1));
00225             alpha = pow_dd(&d__1, &d__2);
00226             i__1 = *n;
00227             for (i__ = 2; i__ <= i__1; ++i__) {
00228                 i__2 = i__;
00229                 i__3 = i__ - 1;
00230                 r__1 = pow_ri(&alpha, &i__3);
00231                 d__[i__2].r = r__1, d__[i__2].i = 0.f;
00232 /* L60: */
00233             }
00234         }
00235         goto L120;
00236 
00237 /*        Arithmetically distributed D values: */
00238 
00239 L70:
00240         d__[1].r = 1.f, d__[1].i = 0.f;
00241         if (*n > 1) {
00242             temp = 1.f / *cond;
00243             alpha = (1.f - temp) / (real) (*n - 1);
00244             i__1 = *n;
00245             for (i__ = 2; i__ <= i__1; ++i__) {
00246                 i__2 = i__;
00247                 r__1 = (real) (*n - i__) * alpha + temp;
00248                 d__[i__2].r = r__1, d__[i__2].i = 0.f;
00249 /* L80: */
00250             }
00251         }
00252         goto L120;
00253 
00254 /*        Randomly distributed D values on ( 1/COND , 1): */
00255 
00256 L90:
00257         alpha = log(1.f / *cond);
00258         i__1 = *n;
00259         for (i__ = 1; i__ <= i__1; ++i__) {
00260             i__2 = i__;
00261             r__1 = exp(alpha * slaran_(&iseed[1]));
00262             d__[i__2].r = r__1, d__[i__2].i = 0.f;
00263 /* L100: */
00264         }
00265         goto L120;
00266 
00267 /*        Randomly distributed D values from IDIST */
00268 
00269 L110:
00270         clarnv_(idist, &iseed[1], n, &d__[1]);
00271 
00272 L120:
00273 
00274 /*        If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign */
00275 /*        random signs to D */
00276 
00277         if (*mode != -6 && *mode != 0 && *mode != 6 && *irsign == 1) {
00278             i__1 = *n;
00279             for (i__ = 1; i__ <= i__1; ++i__) {
00280                 clarnd_(&q__1, &c__3, &iseed[1]);
00281                 ctemp.r = q__1.r, ctemp.i = q__1.i;
00282                 i__2 = i__;
00283                 i__3 = i__;
00284                 r__1 = c_abs(&ctemp);
00285                 q__2.r = ctemp.r / r__1, q__2.i = ctemp.i / r__1;
00286                 q__1.r = d__[i__3].r * q__2.r - d__[i__3].i * q__2.i, q__1.i =
00287                          d__[i__3].r * q__2.i + d__[i__3].i * q__2.r;
00288                 d__[i__2].r = q__1.r, d__[i__2].i = q__1.i;
00289 /* L130: */
00290             }
00291         }
00292 
00293 /*        Reverse if MODE < 0 */
00294 
00295         if (*mode < 0) {
00296             i__1 = *n / 2;
00297             for (i__ = 1; i__ <= i__1; ++i__) {
00298                 i__2 = i__;
00299                 ctemp.r = d__[i__2].r, ctemp.i = d__[i__2].i;
00300                 i__2 = i__;
00301                 i__3 = *n + 1 - i__;
00302                 d__[i__2].r = d__[i__3].r, d__[i__2].i = d__[i__3].i;
00303                 i__2 = *n + 1 - i__;
00304                 d__[i__2].r = ctemp.r, d__[i__2].i = ctemp.i;
00305 /* L140: */
00306             }
00307         }
00308 
00309     }
00310 
00311     return 0;
00312 
00313 /*     End of CLATM1 */
00314 
00315 } /* clatm1_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:32