Go to the documentation of this file.00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static doublereal c_b4 = 1.;
00019
00020 int drotg_(doublereal *da, doublereal *db, doublereal *c__,
00021 doublereal *s)
00022 {
00023
00024 doublereal d__1, d__2;
00025
00026
00027 double sqrt(doublereal), d_sign(doublereal *, doublereal *);
00028
00029
00030 doublereal r__, z__, roe, scale;
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046 roe = *db;
00047 if (abs(*da) > abs(*db)) {
00048 roe = *da;
00049 }
00050 scale = abs(*da) + abs(*db);
00051 if (scale != 0.) {
00052 goto L10;
00053 }
00054 *c__ = 1.;
00055 *s = 0.;
00056 r__ = 0.;
00057 z__ = 0.;
00058 goto L20;
00059 L10:
00060
00061 d__1 = *da / scale;
00062
00063 d__2 = *db / scale;
00064 r__ = scale * sqrt(d__1 * d__1 + d__2 * d__2);
00065 r__ = d_sign(&c_b4, &roe) * r__;
00066 *c__ = *da / r__;
00067 *s = *db / r__;
00068 z__ = 1.;
00069 if (abs(*da) > abs(*db)) {
00070 z__ = *s;
00071 }
00072 if (abs(*db) >= abs(*da) && *c__ != 0.) {
00073 z__ = 1. / *c__;
00074 }
00075 L20:
00076 *da = r__;
00077 *db = z__;
00078 return 0;
00079 }