proteus 1.9.0
C/C++/Fortran libraries
Loading...
Searching...
No Matches
Dsvdcmp.cpp
Go to the documentation of this file.
1#include <math.h>
2#include "Allocation.h"
3
4static double dmaxarg1,dmaxarg2;
5#define DMAX(a,b) (dmaxarg1=(a),dmaxarg2=(b),(dmaxarg1) > (dmaxarg2) ?\
6 (dmaxarg1) : (dmaxarg2))
7static 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
15void 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
void free_dvector(double *v, long nl, long nh)
Definition Util.cpp:38
double * dvector(long nl, long nh)
Definition Util.cpp:7
double dpythag(double a, double b)
Definition Dpythag.cpp:5
#define IMIN(a, b)
Definition Dsvdcmp.cpp:8
#define DMAX(a, b)
Definition Dsvdcmp.cpp:5
void dsvdcmp(double **a, int m, int n, double w[], double **v)
Definition Dsvdcmp.cpp:15
#define SIGN(a, b)
Definition Dsvdcmp.cpp:11
Int n
Definition Headers.h:28
Double f
Definition Headers.h:64
Double s
Definition Headers.h:84
Double * z
Definition Headers.h:49
Double v
Definition Headers.h:95
#define c(i)
Definition jf.h:21
#define w(x)
Definition jf.h:22