![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DLARGV 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DLARGV + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlargv.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlargv.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlargv.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE DLARGV( N, X, INCX, Y, INCY, C, INCC ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER INCC, INCX, INCY, N 00025 * .. 00026 * .. Array Arguments .. 00027 * DOUBLE PRECISION C( * ), X( * ), Y( * ) 00028 * .. 00029 * 00030 * 00031 *> \par Purpose: 00032 * ============= 00033 *> 00034 *> \verbatim 00035 *> 00036 *> DLARGV generates a vector of real plane rotations, determined by 00037 *> elements of the real vectors x and y. For i = 1,2,...,n 00038 *> 00039 *> ( c(i) s(i) ) ( x(i) ) = ( a(i) ) 00040 *> ( -s(i) c(i) ) ( y(i) ) = ( 0 ) 00041 *> \endverbatim 00042 * 00043 * Arguments: 00044 * ========== 00045 * 00046 *> \param[in] N 00047 *> \verbatim 00048 *> N is INTEGER 00049 *> The number of plane rotations to be generated. 00050 *> \endverbatim 00051 *> 00052 *> \param[in,out] X 00053 *> \verbatim 00054 *> X is DOUBLE PRECISION array, 00055 *> dimension (1+(N-1)*INCX) 00056 *> On entry, the vector x. 00057 *> On exit, x(i) is overwritten by a(i), for i = 1,...,n. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] INCX 00061 *> \verbatim 00062 *> INCX is INTEGER 00063 *> The increment between elements of X. INCX > 0. 00064 *> \endverbatim 00065 *> 00066 *> \param[in,out] Y 00067 *> \verbatim 00068 *> Y is DOUBLE PRECISION array, 00069 *> dimension (1+(N-1)*INCY) 00070 *> On entry, the vector y. 00071 *> On exit, the sines of the plane rotations. 00072 *> \endverbatim 00073 *> 00074 *> \param[in] INCY 00075 *> \verbatim 00076 *> INCY is INTEGER 00077 *> The increment between elements of Y. INCY > 0. 00078 *> \endverbatim 00079 *> 00080 *> \param[out] C 00081 *> \verbatim 00082 *> C is DOUBLE PRECISION array, dimension (1+(N-1)*INCC) 00083 *> The cosines of the plane rotations. 00084 *> \endverbatim 00085 *> 00086 *> \param[in] INCC 00087 *> \verbatim 00088 *> INCC is INTEGER 00089 *> The increment between elements of C. INCC > 0. 00090 *> \endverbatim 00091 * 00092 * Authors: 00093 * ======== 00094 * 00095 *> \author Univ. of Tennessee 00096 *> \author Univ. of California Berkeley 00097 *> \author Univ. of Colorado Denver 00098 *> \author NAG Ltd. 00099 * 00100 *> \date November 2011 00101 * 00102 *> \ingroup doubleOTHERauxiliary 00103 * 00104 * ===================================================================== 00105 SUBROUTINE DLARGV( N, X, INCX, Y, INCY, C, INCC ) 00106 * 00107 * -- LAPACK auxiliary routine (version 3.4.0) -- 00108 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00109 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00110 * November 2011 00111 * 00112 * .. Scalar Arguments .. 00113 INTEGER INCC, INCX, INCY, N 00114 * .. 00115 * .. Array Arguments .. 00116 DOUBLE PRECISION C( * ), X( * ), Y( * ) 00117 * .. 00118 * 00119 * ===================================================================== 00120 * 00121 * .. Parameters .. 00122 DOUBLE PRECISION ZERO, ONE 00123 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00124 * .. 00125 * .. Local Scalars .. 00126 INTEGER I, IC, IX, IY 00127 DOUBLE PRECISION F, G, T, TT 00128 * .. 00129 * .. Intrinsic Functions .. 00130 INTRINSIC ABS, SQRT 00131 * .. 00132 * .. Executable Statements .. 00133 * 00134 IX = 1 00135 IY = 1 00136 IC = 1 00137 DO 10 I = 1, N 00138 F = X( IX ) 00139 G = Y( IY ) 00140 IF( G.EQ.ZERO ) THEN 00141 C( IC ) = ONE 00142 ELSE IF( F.EQ.ZERO ) THEN 00143 C( IC ) = ZERO 00144 Y( IY ) = ONE 00145 X( IX ) = G 00146 ELSE IF( ABS( F ).GT.ABS( G ) ) THEN 00147 T = G / F 00148 TT = SQRT( ONE+T*T ) 00149 C( IC ) = ONE / TT 00150 Y( IY ) = T*C( IC ) 00151 X( IX ) = F*TT 00152 ELSE 00153 T = F / G 00154 TT = SQRT( ONE+T*T ) 00155 Y( IY ) = ONE / TT 00156 C( IC ) = T*Y( IY ) 00157 X( IX ) = G*TT 00158 END IF 00159 IC = IC + INCC 00160 IY = IY + INCY 00161 IX = IX + INCX 00162 10 CONTINUE 00163 RETURN 00164 * 00165 * End of DLARGV 00166 * 00167 END