00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037 #ifndef TEMPLATE_LAPACK_LARTG_HEADER
00038 #define TEMPLATE_LAPACK_LARTG_HEADER
00039
00040
00041 template<class Treal>
00042 int template_lapack_lartg(const Treal *f, const Treal *g, Treal *cs,
00043 Treal *sn, Treal *r__)
00044 {
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089 logical first = TRUE_;
00090
00091 integer i__1;
00092 Treal d__1, d__2;
00093
00094 integer i__;
00095 Treal scale;
00096 integer count;
00097 Treal f1, g1, safmn2, safmx2;
00098 Treal safmin, eps;
00099
00100
00101
00102 if (first) {
00103 first = FALSE_;
00104 safmin = template_lapack_lamch("S", (Treal)0);
00105 eps = template_lapack_lamch("E", (Treal)0);
00106 d__1 = template_lapack_lamch("B", (Treal)0);
00107 i__1 = (integer) (template_blas_log(safmin / eps) / template_blas_log(template_lapack_lamch("B", (Treal)0)) /
00108 2.);
00109 safmn2 = template_lapack_pow_di(&d__1, &i__1);
00110 safmx2 = 1. / safmn2;
00111 }
00112 if (*g == 0.) {
00113 *cs = 1.;
00114 *sn = 0.;
00115 *r__ = *f;
00116 } else if (*f == 0.) {
00117 *cs = 0.;
00118 *sn = 1.;
00119 *r__ = *g;
00120 } else {
00121 f1 = *f;
00122 g1 = *g;
00123
00124 d__1 = absMACRO(f1), d__2 = absMACRO(g1);
00125 scale = maxMACRO(d__1,d__2);
00126 if (scale >= safmx2) {
00127 count = 0;
00128 L10:
00129 ++count;
00130 f1 *= safmn2;
00131 g1 *= safmn2;
00132
00133 d__1 = absMACRO(f1), d__2 = absMACRO(g1);
00134 scale = maxMACRO(d__1,d__2);
00135 if (scale >= safmx2) {
00136 goto L10;
00137 }
00138
00139 d__1 = f1;
00140
00141 d__2 = g1;
00142 *r__ = template_blas_sqrt(d__1 * d__1 + d__2 * d__2);
00143 *cs = f1 / *r__;
00144 *sn = g1 / *r__;
00145 i__1 = count;
00146 for (i__ = 1; i__ <= i__1; ++i__) {
00147 *r__ *= safmx2;
00148
00149 }
00150 } else if (scale <= safmn2) {
00151 count = 0;
00152 L30:
00153 ++count;
00154 f1 *= safmx2;
00155 g1 *= safmx2;
00156
00157 d__1 = absMACRO(f1), d__2 = absMACRO(g1);
00158 scale = maxMACRO(d__1,d__2);
00159 if (scale <= safmn2) {
00160 goto L30;
00161 }
00162
00163 d__1 = f1;
00164
00165 d__2 = g1;
00166 *r__ = template_blas_sqrt(d__1 * d__1 + d__2 * d__2);
00167 *cs = f1 / *r__;
00168 *sn = g1 / *r__;
00169 i__1 = count;
00170 for (i__ = 1; i__ <= i__1; ++i__) {
00171 *r__ *= safmn2;
00172
00173 }
00174 } else {
00175
00176 d__1 = f1;
00177
00178 d__2 = g1;
00179 *r__ = template_blas_sqrt(d__1 * d__1 + d__2 * d__2);
00180 *cs = f1 / *r__;
00181 *sn = g1 / *r__;
00182 }
00183 if (absMACRO(*f) > absMACRO(*g) && *cs < 0.) {
00184 *cs = -(*cs);
00185 *sn = -(*sn);
00186 *r__ = -(*r__);
00187 }
00188 }
00189 return 0;
00190
00191
00192
00193 }
00194
00195 #endif