examples/ludinv/dlatm2.c

   1 /* dlatm2.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 doublereal dlatm2_(integer *m, integer *n, integer *i__, integer *j, integer *
  17         kl, integer *ku, integer *idist, integer *iseed, doublereal *d__,
  18         integer *igrade, doublereal *dl, doublereal *dr, integer *ipvtng,
  19         integer *iwork, doublereal *sparse)
  20 {
  21     /* System generated locals */
  22     doublereal ret_val;
  23
  24     /* Local variables */
  25     integer isub, jsub;
  26     doublereal temp;
  27     extern doublereal dlaran_(integer *), dlarnd_(integer *, integer *);
  28
  29
  30 /*  -- LAPACK auxiliary test routine (version 3.1) -- */
  31 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  32 /*     November 2006 */
  33
  34 /*     .. Scalar Arguments .. */
  35
  36 /*     .. */
  37
  38 /*     .. Array Arguments .. */
  39
  40 /*     .. */
  41
  42 /*  Purpose */
  43 /*  ======= */
  44
  45 /*     DLATM2 returns the (I,J) entry of a random matrix of dimension */
  46 /*     (M, N) described by the other paramters. It is called by the */
  47 /*     DLATMR routine in order to build random test matrices. No error */
  48 /*     checking on parameters is done, because this routine is called in */
  49 /*     a tight loop by DLATMR which has already checked the parameters. */
  50
  51 /*     Use of DLATM2 differs from SLATM3 in the order in which the random */
  52 /*     number generator is called to fill in random matrix entries. */
  53 /*     With DLATM2, the generator is called to fill in the pivoted matrix */
  54 /*     columnwise. With DLATM3, the generator is called to fill in the */
  55 /*     matrix columnwise, after which it is pivoted. Thus, DLATM3 can */
  56 /*     be used to construct random matrices which differ only in their */
  57 /*     order of rows and/or columns. DLATM2 is used to construct band */
  58 /*     matrices while avoiding calling the random number generator for */
  59 /*     entries outside the band (and therefore generating random numbers */
  60
  61 /*     The matrix whose (I,J) entry is returned is constructed as */
  62 /*     follows (this routine only computes one entry): */
  63
  64 /*       If I is outside (1..M) or J is outside (1..N), return zero */
  65 /*          (this is convenient for generating matrices in band format). */
  66
  67 /*       Generate a matrix A with random entries of distribution IDIST. */
  68
  69 /*       Set the diagonal to D. */
  70
  71 /*       Grade the matrix, if desired, from the left (by DL) and/or */
  72 /*          from the right (by DR or DL) as specified by IGRADE. */
  73
  74 /*       Permute, if desired, the rows and/or columns as specified by */
  75 /*          IPVTNG and IWORK. */
  76
  77 /*       Band the matrix to have lower bandwidth KL and upper */
  78 /*          bandwidth KU. */
  79
  80 /*       Set random entries to zero as specified by SPARSE. */
  81
  82 /*  Arguments */
  83 /*  ========= */
  84
  85 /*  M      - INTEGER */
  86 /*           Number of rows of matrix. Not modified. */
  87
  88 /*  N      - INTEGER */
  89 /*           Number of columns of matrix. Not modified. */
  90
  91 /*  I      - INTEGER */
  92 /*           Row of entry to be returned. Not modified. */
  93
  94 /*  J      - INTEGER */
  95 /*           Column of entry to be returned. Not modified. */
  96
  97 /*  KL     - INTEGER */
  98 /*           Lower bandwidth. Not modified. */
  99
 100 /*  KU     - INTEGER */
 101 /*           Upper bandwidth. Not modified. */
 102
 103 /*  IDIST  - INTEGER */
 104 /*           On entry, IDIST specifies the type of distribution to be */
 105 /*           used to generate a random matrix . */
 106 /*           1 => UNIFORM( 0, 1 ) */
 107 /*           2 => UNIFORM( -1, 1 ) */
 108 /*           3 => NORMAL( 0, 1 ) */
 109 /*           Not modified. */
 110
 111 /*  ISEED  - INTEGER array of dimension ( 4 ) */
 112 /*           Seed for random number generator. */
 113 /*           Changed on exit. */
 114
 115 /*  D      - DOUBLE PRECISION array of dimension ( MIN( I , J ) ) */
 116 /*           Diagonal entries of matrix. Not modified. */
 117
 118 /*  IGRADE - INTEGER */
 119 /*           Specifies grading of matrix as follows: */
 120 /*           0  => no grading */
 121 /*           1  => matrix premultiplied by diag( DL ) */
 122 /*           2  => matrix postmultiplied by diag( DR ) */
 123 /*           3  => matrix premultiplied by diag( DL ) and */
 124 /*                         postmultiplied by diag( DR ) */
 125 /*           4  => matrix premultiplied by diag( DL ) and */
 126 /*                         postmultiplied by inv( diag( DL ) ) */
 127 /*           5  => matrix premultiplied by diag( DL ) and */
 128 /*                         postmultiplied by diag( DL ) */
 129 /*           Not modified. */
 130
 131 /*  DL     - DOUBLE PRECISION array ( I or J, as appropriate ) */
 132 /*           Left scale factors for grading matrix.  Not modified. */
 133
 134 /*  DR     - DOUBLE PRECISION array ( I or J, as appropriate ) */
 135 /*           Right scale factors for grading matrix.  Not modified. */
 136
 137 /*  IPVTNG - INTEGER */
 138 /*           On entry specifies pivoting permutations as follows: */
 139 /*           0 => none. */
 140 /*           1 => row pivoting. */
 141 /*           2 => column pivoting. */
 142 /*           3 => full pivoting, i.e., on both sides. */
 143 /*           Not modified. */
 144
 145 /*  IWORK  - INTEGER array ( I or J, as appropriate ) */
 146 /*           This array specifies the permutation used. The */
 147 /*           row (or column) in position K was originally in */
 148 /*           position IWORK( K ). */
 149 /*           This differs from IWORK for DLATM3. Not modified. */
 150
 151 /*  SPARSE - DOUBLE PRECISION    between 0. and 1. */
 152 /*           On entry specifies the sparsity of the matrix */
 153 /*           if sparse matix is to be generated. */
 154 /*           SPARSE should lie between 0 and 1. */
 155 /*           A uniform ( 0, 1 ) random number x is generated and */
 156 /*           compared to SPARSE; if x is larger the matrix entry */
 157 /*           is unchanged and if x is smaller the entry is set */
 158 /*           to zero. Thus on the average a fraction SPARSE of the */
 159 /*           entries will be set to zero. */
 160 /*           Not modified. */
 161
 162 /*  ===================================================================== */
 163
 164 /*     .. Parameters .. */
 165
 166 /*     .. */
 167
 168 /*     .. Local Scalars .. */
 169
 170 /*     .. */
 171
 172 /*     .. External Functions .. */
 173
 174 /*     .. */
 175
 176 /* ----------------------------------------------------------------------- */
 177
 178 /*     .. Executable Statements .. */
 179
 180
 181 /*     Check for I and J in range */
 182
 183     /* Parameter adjustments */
 184     --iwork;
 185     --dr;
 186     --dl;
 187     --d__;
 188     --iseed;
 189
 190     /* Function Body */
 191     if (*i__ < 1 || *i__ > *m || *j < 1 || *j > *n) {
 192         ret_val = 0.;
 193         return ret_val;
 194     }
 195
 196 /*     Check for banding */
 197
 198     if (*j > *i__ + *ku || *j < *i__ - *kl) {
 199         ret_val = 0.;
 200         return ret_val;
 201     }
 202
 203 /*     Check for sparsity */
 204
 205     if (*sparse > 0.) {
 206         if (dlaran_(&iseed[1]) < *sparse) {
 207             ret_val = 0.;
 208             return ret_val;
 209         }
 210     }
 211
 212 /*     Compute subscripts depending on IPVTNG */
 213
 214     if (*ipvtng == 0) {
 215         isub = *i__;
 216         jsub = *j;
 217     } else if (*ipvtng == 1) {
 218         isub = iwork[*i__];
 219         jsub = *j;
 220     } else if (*ipvtng == 2) {
 221         isub = *i__;
 222         jsub = iwork[*j];
 223     } else if (*ipvtng == 3) {
 224         isub = iwork[*i__];
 225         jsub = iwork[*j];
 226     }
 227
 228 /*     Compute entry and grade it according to IGRADE */
 229
 230     if (isub == jsub) {
 231         temp = d__[isub];
 232     } else {
 233         temp = dlarnd_(idist, &iseed[1]);
 234     }
 235     if (*igrade == 1) {
 236         temp *= dl[isub];
 237     } else if (*igrade == 2) {
 238         temp *= dr[jsub];
 239     } else if (*igrade == 3) {
 240         temp = temp * dl[isub] * dr[jsub];
 241     } else if (*igrade == 4 && isub != jsub) {
 242         temp = temp * dl[isub] / dl[jsub];
 243     } else if (*igrade == 5) {
 244         temp = temp * dl[isub] * dl[jsub];
 245     }
 246     ret_val = temp;
 247     return ret_val;
 248
 249 /*     End of DLATM2 */
 250
 251 } /* dlatm2_ */