slatm2.c
Go to the documentation of this file.
00001 /* slatm2.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 doublereal slatm2_(integer *m, integer *n, integer *i__, integer *j, integer *
00017         kl, integer *ku, integer *idist, integer *iseed, real *d__, integer *
00018         igrade, real *dl, real *dr, integer *ipvtng, integer *iwork, real *
00019         sparse)
00020 {
00021     /* System generated locals */
00022     real ret_val;
00023 
00024     /* Local variables */
00025     integer isub, jsub;
00026     real temp;
00027     extern doublereal slaran_(integer *), slarnd_(integer *, integer *);
00028 
00029 
00030 /*  -- LAPACK auxiliary test routine (version 3.1) -- */
00031 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00032 /*     November 2006 */
00033 
00034 /*     .. Scalar Arguments .. */
00035 
00036 /*     .. */
00037 
00038 /*     .. Array Arguments .. */
00039 
00040 /*     .. */
00041 
00042 /*  Purpose */
00043 /*  ======= */
00044 
00045 /*     SLATM2 returns the (I,J) entry of a random matrix of dimension */
00046 /*     (M, N) described by the other paramters. It is called by the */
00047 /*     SLATMR routine in order to build random test matrices. No error */
00048 /*     checking on parameters is done, because this routine is called in */
00049 /*     a tight loop by SLATMR which has already checked the parameters. */
00050 
00051 /*     Use of SLATM2 differs from SLATM3 in the order in which the random */
00052 /*     number generator is called to fill in random matrix entries. */
00053 /*     With SLATM2, the generator is called to fill in the pivoted matrix */
00054 /*     columnwise. With SLATM3, the generator is called to fill in the */
00055 /*     matrix columnwise, after which it is pivoted. Thus, SLATM3 can */
00056 /*     be used to construct random matrices which differ only in their */
00057 /*     order of rows and/or columns. SLATM2 is used to construct band */
00058 /*     matrices while avoiding calling the random number generator for */
00059 /*     entries outside the band (and therefore generating random numbers */
00060 
00061 /*     The matrix whose (I,J) entry is returned is constructed as */
00062 /*     follows (this routine only computes one entry): */
00063 
00064 /*       If I is outside (1..M) or J is outside (1..N), return zero */
00065 /*          (this is convenient for generating matrices in band format). */
00066 
00067 /*       Generate a matrix A with random entries of distribution IDIST. */
00068 
00069 /*       Set the diagonal to D. */
00070 
00071 /*       Grade the matrix, if desired, from the left (by DL) and/or */
00072 /*          from the right (by DR or DL) as specified by IGRADE. */
00073 
00074 /*       Permute, if desired, the rows and/or columns as specified by */
00075 /*          IPVTNG and IWORK. */
00076 
00077 /*       Band the matrix to have lower bandwidth KL and upper */
00078 /*          bandwidth KU. */
00079 
00080 /*       Set random entries to zero as specified by SPARSE. */
00081 
00082 /*  Arguments */
00083 /*  ========= */
00084 
00085 /*  M      - INTEGER */
00086 /*           Number of rows of matrix. Not modified. */
00087 
00088 /*  N      - INTEGER */
00089 /*           Number of columns of matrix. Not modified. */
00090 
00091 /*  I      - INTEGER */
00092 /*           Row of entry to be returned. Not modified. */
00093 
00094 /*  J      - INTEGER */
00095 /*           Column of entry to be returned. Not modified. */
00096 
00097 /*  KL     - INTEGER */
00098 /*           Lower bandwidth. Not modified. */
00099 
00100 /*  KU     - INTEGER */
00101 /*           Upper bandwidth. Not modified. */
00102 
00103 /*  IDIST  - INTEGER */
00104 /*           On entry, IDIST specifies the type of distribution to be */
00105 /*           used to generate a random matrix . */
00106 /*           1 => UNIFORM( 0, 1 ) */
00107 /*           2 => UNIFORM( -1, 1 ) */
00108 /*           3 => NORMAL( 0, 1 ) */
00109 /*           Not modified. */
00110 
00111 /*  ISEED  - INTEGER array of dimension ( 4 ) */
00112 /*           Seed for random number generator. */
00113 /*           Changed on exit. */
00114 
00115 /*  D      - REAL array of dimension ( MIN( I , J ) ) */
00116 /*           Diagonal entries of matrix. Not modified. */
00117 
00118 /*  IGRADE - INTEGER */
00119 /*           Specifies grading of matrix as follows: */
00120 /*           0  => no grading */
00121 /*           1  => matrix premultiplied by diag( DL ) */
00122 /*           2  => matrix postmultiplied by diag( DR ) */
00123 /*           3  => matrix premultiplied by diag( DL ) and */
00124 /*                         postmultiplied by diag( DR ) */
00125 /*           4  => matrix premultiplied by diag( DL ) and */
00126 /*                         postmultiplied by inv( diag( DL ) ) */
00127 /*           5  => matrix premultiplied by diag( DL ) and */
00128 /*                         postmultiplied by diag( DL ) */
00129 /*           Not modified. */
00130 
00131 /*  DL     - REAL array ( I or J, as appropriate ) */
00132 /*           Left scale factors for grading matrix.  Not modified. */
00133 
00134 /*  DR     - REAL array ( I or J, as appropriate ) */
00135 /*           Right scale factors for grading matrix.  Not modified. */
00136 
00137 /*  IPVTNG - INTEGER */
00138 /*           On entry specifies pivoting permutations as follows: */
00139 /*           0 => none. */
00140 /*           1 => row pivoting. */
00141 /*           2 => column pivoting. */
00142 /*           3 => full pivoting, i.e., on both sides. */
00143 /*           Not modified. */
00144 
00145 /*  IWORK  - INTEGER array ( I or J, as appropriate ) */
00146 /*           This array specifies the permutation used. The */
00147 /*           row (or column) in position K was originally in */
00148 /*           position IWORK( K ). */
00149 /*           This differs from IWORK for SLATM3. Not modified. */
00150 
00151 /*  SPARSE - REAL    between 0. and 1. */
00152 /*           On entry specifies the sparsity of the matrix */
00153 /*           if sparse matix is to be generated. */
00154 /*           SPARSE should lie between 0 and 1. */
00155 /*           A uniform ( 0, 1 ) random number x is generated and */
00156 /*           compared to SPARSE; if x is larger the matrix entry */
00157 /*           is unchanged and if x is smaller the entry is set */
00158 /*           to zero. Thus on the average a fraction SPARSE of the */
00159 /*           entries will be set to zero. */
00160 /*           Not modified. */
00161 
00162 /*  ===================================================================== */
00163 
00164 /*     .. Parameters .. */
00165 
00166 /*     .. */
00167 
00168 /*     .. Local Scalars .. */
00169 
00170 /*     .. */
00171 
00172 /*     .. External Functions .. */
00173 
00174 /*     .. */
00175 
00176 /* ----------------------------------------------------------------------- */
00177 
00178 /*     .. Executable Statements .. */
00179 
00180 
00181 /*     Check for I and J in range */
00182 
00183     /* Parameter adjustments */
00184     --iwork;
00185     --dr;
00186     --dl;
00187     --d__;
00188     --iseed;
00189 
00190     /* Function Body */
00191     if (*i__ < 1 || *i__ > *m || *j < 1 || *j > *n) {
00192         ret_val = 0.f;
00193         return ret_val;
00194     }
00195 
00196 /*     Check for banding */
00197 
00198     if (*j > *i__ + *ku || *j < *i__ - *kl) {
00199         ret_val = 0.f;
00200         return ret_val;
00201     }
00202 
00203 /*     Check for sparsity */
00204 
00205     if (*sparse > 0.f) {
00206         if (slaran_(&iseed[1]) < *sparse) {
00207             ret_val = 0.f;
00208             return ret_val;
00209         }
00210     }
00211 
00212 /*     Compute subscripts depending on IPVTNG */
00213 
00214     if (*ipvtng == 0) {
00215         isub = *i__;
00216         jsub = *j;
00217     } else if (*ipvtng == 1) {
00218         isub = iwork[*i__];
00219         jsub = *j;
00220     } else if (*ipvtng == 2) {
00221         isub = *i__;
00222         jsub = iwork[*j];
00223     } else if (*ipvtng == 3) {
00224         isub = iwork[*i__];
00225         jsub = iwork[*j];
00226     }
00227 
00228 /*     Compute entry and grade it according to IGRADE */
00229 
00230     if (isub == jsub) {
00231         temp = d__[isub];
00232     } else {
00233         temp = slarnd_(idist, &iseed[1]);
00234     }
00235     if (*igrade == 1) {
00236         temp *= dl[isub];
00237     } else if (*igrade == 2) {
00238         temp *= dr[jsub];
00239     } else if (*igrade == 3) {
00240         temp = temp * dl[isub] * dr[jsub];
00241     } else if (*igrade == 4 && isub != jsub) {
00242         temp = temp * dl[isub] / dl[jsub];
00243     } else if (*igrade == 5) {
00244         temp = temp * dl[isub] * dl[jsub];
00245     }
00246     ret_val = temp;
00247     return ret_val;
00248 
00249 /*     End of SLATM2 */
00250 
00251 } /* slatm2_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:11