proteus  1.8.1
C/C++/Fortran libraries
Dsvdcmp.cpp
Go to the documentation of this file.
1 #include <math.h>
2 #include "Allocation.h"
3 
4 static double dmaxarg1,dmaxarg2;
5 #define DMAX(a,b) (dmaxarg1=(a),dmaxarg2=(b),(dmaxarg1) > (dmaxarg2) ?\
6  (dmaxarg1) : (dmaxarg2))
7 static int iminarg1,iminarg2;
8 #define IMIN(a,b) (iminarg1=(a),iminarg2=(b),(iminarg1) < (iminarg2) ?\
9  (iminarg1) : (iminarg2))
10 
11 #define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
12 
13 #include <stdio.h>
14 
15 void dsvdcmp(double **a, int m, int n, double w[], double **v)
16 {
17  double dpythag(double a, double b);
18  int flag,i,its,j,jj,k,l,nm;
19  double anorm,c,f,g,h,s,scale,x,y,z,*rv1;
20 
21  rv1=dvector(1,n);
22  g=scale=anorm=0.0;
23  for (i=1;i<=n;i++) {
24  l=i+1;
25  rv1[i]=scale*g;
26  g=s=scale=0.0;
27  if (i <= m) {
28  for (k=i;k<=m;k++) scale += fabs(a[k][i]);
29  if (scale) {
30  for (k=i;k<=m;k++) {
31  a[k][i] /= scale;
32  s += a[k][i]*a[k][i];
33  }
34  f=a[i][i];
35  g = -SIGN(sqrt(s),f);
36  h=f*g-s;
37  a[i][i]=f-g;
38  for (j=l;j<=n;j++) {
39  for (s=0.0,k=i;k<=m;k++) s += a[k][i]*a[k][j];
40  f=s/h;
41  for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
42  }
43  for (k=i;k<=m;k++) a[k][i] *= scale;
44  }
45  }
46  w[i]=scale *g;
47  g=s=scale=0.0;
48  if (i <= m && i != n) {
49  for (k=l;k<=n;k++) scale += fabs(a[i][k]);
50  if (scale) {
51  for (k=l;k<=n;k++) {
52  a[i][k] /= scale;
53  s += a[i][k]*a[i][k];
54  }
55  f=a[i][l];
56  g = -SIGN(sqrt(s),f);
57  h=f*g-s;
58  a[i][l]=f-g;
59  for (k=l;k<=n;k++) rv1[k]=a[i][k]/h;
60  for (j=l;j<=m;j++) {
61  for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k];
62  for (k=l;k<=n;k++) a[j][k] += s*rv1[k];
63  }
64  for (k=l;k<=n;k++) a[i][k] *= scale;
65  }
66  }
67  anorm=DMAX(anorm,(fabs(w[i])+fabs(rv1[i])));
68  }
69  for (i=n;i>=1;i--) {
70  if (i < n) {
71  if (g) {
72  for (j=l;j<=n;j++) v[j][i]=(a[i][j]/a[i][l])/g;
73  for (j=l;j<=n;j++) {
74  for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j];
75  for (k=l;k<=n;k++) v[k][j] += s*v[k][i];
76  }
77  }
78  for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0;
79  }
80  v[i][i]=1.0;
81  g=rv1[i];
82  l=i;
83  }
84  for (i=IMIN(m,n);i>=1;i--) {
85  l=i+1;
86  g=w[i];
87  for (j=l;j<=n;j++) a[i][j]=0.0;
88  if (g) {
89  g=1.0/g;
90  for (j=l;j<=n;j++) {
91  for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j];
92  f=(s/a[i][i])*g;
93  for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
94  }
95  for (j=i;j<=m;j++) a[j][i] *= g;
96  } else for (j=i;j<=m;j++) a[j][i]=0.0;
97  ++a[i][i];
98  }
99  for (k=n;k>=1;k--) {
100  for (its=1;its<=30;its++) {
101  flag=1;
102  for (l=k;l>=1;l--) {
103  nm=l-1;
104  if ((double)(fabs(rv1[l])+anorm) == anorm) {
105  flag=0;
106  break;
107  }
108  if ((double)(fabs(w[nm])+anorm) == anorm) break;
109  }
110  if (flag) {
111  c=0.0;
112  s=1.0;
113  for (i=l;i<=k;i++) {
114  f=s*rv1[i];
115  rv1[i]=c*rv1[i];
116  if ((double)(fabs(f)+anorm) == anorm) break;
117  g=w[i];
118  h=dpythag(f,g);
119  w[i]=h;
120  h=1.0/h;
121  c=g*h;
122  s = -f*h;
123  for (j=1;j<=m;j++) {
124  y=a[j][nm];
125  z=a[j][i];
126  a[j][nm]=y*c+z*s;
127  a[j][i]=z*c-y*s;
128  }
129  }
130  }
131  z=w[k];
132  if (l == k) {
133  if (z < 0.0) {
134  w[k] = -z;
135  for (j=1;j<=n;j++) v[j][k] = -v[j][k];
136  }
137  break;
138  }
139  if (its == 50) {fprintf(stderr,"no convergence in 30 dsvdcmp iterations");}
140  x=w[l];
141  nm=k-1;
142  y=w[nm];
143  g=rv1[nm];
144  h=rv1[k];
145  f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
146  g=dpythag(f,1.0);
147  f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x;
148  c=s=1.0;
149  for (j=l;j<=nm;j++) {
150  i=j+1;
151  g=rv1[i];
152  y=w[i];
153  h=s*g;
154  g=c*g;
155  z=dpythag(f,h);
156  rv1[j]=z;
157  c=f/z;
158  s=h/z;
159  f=x*c+g*s;
160  g = g*c-x*s;
161  h=y*s;
162  y *= c;
163  for (jj=1;jj<=n;jj++) {
164  x=v[jj][j];
165  z=v[jj][i];
166  v[jj][j]=x*c+z*s;
167  v[jj][i]=z*c-x*s;
168  }
169  z=dpythag(f,h);
170  w[j]=z;
171  if (z) {
172  z=1.0/z;
173  c=f*z;
174  s=h*z;
175  }
176  f=c*g+s*y;
177  x=c*y-s*g;
178  for (jj=1;jj<=m;jj++) {
179  y=a[jj][j];
180  z=a[jj][i];
181  a[jj][j]=y*c+z*s;
182  a[jj][i]=z*c-y*s;
183  }
184  }
185  rv1[l]=0.0;
186  rv1[k]=f;
187  w[k]=x;
188  }
189  }
190  free_dvector(rv1,1,n);
191 }
192 
dvector
double * dvector(long nl, long nh)
Definition: Util.cpp:7
w
#define w(x)
Definition: jf.h:22
DMAX
#define DMAX(a, b)
Definition: Dsvdcmp.cpp:5
Allocation.h
f
Double f
Definition: Headers.h:64
s
Double s
Definition: Headers.h:84
n
Int n
Definition: Headers.h:28
IMIN
#define IMIN(a, b)
Definition: Dsvdcmp.cpp:8
v
Double v
Definition: Headers.h:95
free_dvector
void free_dvector(double *v, long nl, long nh)
Definition: Util.cpp:38
z
Double * z
Definition: Headers.h:49
c
Double c
Definition: Headers.h:54
SIGN
#define SIGN(a, b)
Definition: Dsvdcmp.cpp:11
dsvdcmp
void dsvdcmp(double **a, int m, int n, double w[], double **v)
Definition: Dsvdcmp.cpp:15
dpythag
double dpythag(double a, double b)
Definition: Dpythag.cpp:5