drscl.c
Go to the documentation of this file.
00001 /* drscl.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 /* Subroutine */ int drscl_(integer *n, doublereal *sa, doublereal *sx, 
00017         integer *incx)
00018 {
00019     doublereal mul, cden;
00020     logical done;
00021     doublereal cnum, cden1, cnum1;
00022     extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *, 
00023             integer *), dlabad_(doublereal *, doublereal *);
00024     extern doublereal dlamch_(char *);
00025     doublereal bignum, smlnum;
00026 
00027 
00028 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00029 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00030 /*     November 2006 */
00031 
00032 /*     .. Scalar Arguments .. */
00033 /*     .. */
00034 /*     .. Array Arguments .. */
00035 /*     .. */
00036 
00037 /*  Purpose */
00038 /*  ======= */
00039 
00040 /*  DRSCL multiplies an n-element real vector x by the real scalar 1/a. */
00041 /*  This is done without overflow or underflow as long as */
00042 /*  the final result x/a does not overflow or underflow. */
00043 
00044 /*  Arguments */
00045 /*  ========= */
00046 
00047 /*  N       (input) INTEGER */
00048 /*          The number of components of the vector x. */
00049 
00050 /*  SA      (input) DOUBLE PRECISION */
00051 /*          The scalar a which is used to divide each component of x. */
00052 /*          SA must be >= 0, or the subroutine will divide by zero. */
00053 
00054 /*  SX      (input/output) DOUBLE PRECISION array, dimension */
00055 /*                         (1+(N-1)*abs(INCX)) */
00056 /*          The n-element vector x. */
00057 
00058 /*  INCX    (input) INTEGER */
00059 /*          The increment between successive values of the vector SX. */
00060 /*          > 0:  SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i),     1< i<= n */
00061 
00062 /* ===================================================================== */
00063 
00064 /*     .. Parameters .. */
00065 /*     .. */
00066 /*     .. Local Scalars .. */
00067 /*     .. */
00068 /*     .. External Functions .. */
00069 /*     .. */
00070 /*     .. External Subroutines .. */
00071 /*     .. */
00072 /*     .. Intrinsic Functions .. */
00073 /*     .. */
00074 /*     .. Executable Statements .. */
00075 
00076 /*     Quick return if possible */
00077 
00078     /* Parameter adjustments */
00079     --sx;
00080 
00081     /* Function Body */
00082     if (*n <= 0) {
00083         return 0;
00084     }
00085 
00086 /*     Get machine parameters */
00087 
00088     smlnum = dlamch_("S");
00089     bignum = 1. / smlnum;
00090     dlabad_(&smlnum, &bignum);
00091 
00092 /*     Initialize the denominator to SA and the numerator to 1. */
00093 
00094     cden = *sa;
00095     cnum = 1.;
00096 
00097 L10:
00098     cden1 = cden * smlnum;
00099     cnum1 = cnum / bignum;
00100     if (abs(cden1) > abs(cnum) && cnum != 0.) {
00101 
00102 /*        Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. */
00103 
00104         mul = smlnum;
00105         done = FALSE_;
00106         cden = cden1;
00107     } else if (abs(cnum1) > abs(cden)) {
00108 
00109 /*        Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. */
00110 
00111         mul = bignum;
00112         done = FALSE_;
00113         cnum = cnum1;
00114     } else {
00115 
00116 /*        Multiply X by CNUM / CDEN and return. */
00117 
00118         mul = cnum / cden;
00119         done = TRUE_;
00120     }
00121 
00122 /*     Scale the vector X by MUL */
00123 
00124     dscal_(n, &mul, &sx[1], incx);
00125 
00126     if (! done) {
00127         goto L10;
00128     }
00129 
00130     return 0;
00131 
00132 /*     End of DRSCL */
00133 
00134 } /* drscl_ */


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