proteus  1.8.1
C/C++/Fortran libraries
Subroutines.cpp
Go to the documentation of this file.
1 
2 // SUBROUTINES FOR FOURIER APPROXIMATION METHOD
3 
4 #include <math.h>
5 #include <stdio.h>
6 #include <string.h>
7 #include "ncurses/curses.h"
8 
9 #define iff(x,y) if(strcmp(x,#y)==0)
10 #define pi 3.14159265358979324
11 
12 #define Int extern int
13 #define Double extern double
14 
15 double *dvector(long, long);
16 double **dmatrix(long nrl, long nrh, long ncl, long nch);
17 void free_dvector(double *, long , long );
18 void free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch);
19 
20 extern char Case[];
21 
22 #include "Headers.h"
23 
24 // **************************************************
25 // CALCULATE INITIAL SOLUTION FROM LINEAR WAVE THEORY
26 // **************************************************
27 
28 void init()
29 {
30 int i;
31 double a, b, t;
32 
33 iff(Case,Period)
34  {
35  a=4.*pi*pi*height/Hoverd;
36  b=a/sqrt(tanh(a));
37  t=tanh(b);
38  z[1]=b+(a-b*t)/(t+b*(1.-t*t));
39  }
40 else
41  z[1]=2.*pi*height/Hoverd;
42 
43 z[2]=z[1]*Hoverd;
44 z[4]=sqrt(tanh(z[1]));
45 z[3]=2.*pi/z[4];
46 if(Current_criterion==1)
47  {
48  z[5]=Current*sqrt(z[2]);
49  z[6]=0.;
50  }
51 else
52  {
53  z[6]=Current*sqrt(z[2]);
54  z[5]=0.;
55  }
56 z[7]=z[4];
57 z[8]=0.;
58 z[9]=0.5*z[7]*z[7];
59 cosa[0]=1.;
60 sina[0]=0.;
61 z[10]=0.5*z[2];
62  for( i=1 ; i<=n ; i++ )
63  {
64  cosa[i]=cos(i*pi/n);
65  cosa[i+n]=cos((i+n)*pi/n);
66  sina[i]=sin(i*pi/n);
67  sina[i+n]=sin((i+n)*pi/n);
68  z[n+i+10]=0.;
69  z[i+10]=0.5*z[2]*cosa[i];
70  }
71 z[n+11]=0.5*z[2]/z[7];
72 
73 for( i=1 ; i<=9 ; i++ )
74  sol[i][1] = z[i];
75 for( i=10 ; i<=num ; i++ )
76  sol[i][1] = 0.;
77 
78 return;
79 }
80 
81 // EVALUATION OF EQUATIONS.
82 
83 double Eqns(double *rhs)
84 {
85 int i, j, m, it, nm;
86 double c, e, s, u, v;
87 
88 rhs[1]=z[2]-z[1]*Hoverd;
89 
90 iff(Case,Wavelength)
91  rhs[2]=z[2]-2.*pi*height;
92 else
93  rhs[2]=z[2]-height*z[3]*z[3];
94 
95 rhs[3]=z[4]*z[3]-pi-pi;
96 rhs[4]=z[5]+z[7]-z[4];
97 rhs[5]=z[6]+z[7]-z[4];
98 
99 rhs[5]=rhs[5]-z[8]/z[1];
100 for (i=1; i<=n; i++ )
101  {
102  coeff[i]=z[n+i+10];
103  Tanh[i] = tanh(i*z[1]);
104  }
105 it=6;
106 if(Current_criterion==1)it=5;
107 rhs[6]=z[it]-Current*sqrt(z[1]); // Correction made 20.5.2013, z[2] changed to z[1]
108 rhs[7]=z[10]+z[n+10];
109 for (i=1 ; i<= n-1 ; i++ )
110  rhs[7]=rhs[7]+z[10+i]+z[10+i];
111 rhs[8]=z[10]-z[n+10]-z[2];
112 for ( m=0 ; m <= n ; m++ )
113  {
114  psi=0.;
115  u=0.;
116  v=0.;
117  for (j=1 ; j <= n ; j++ )
118  {
119  nm = (m*j) % (n+n);
120  e=exp(j*(z[10+m]));
121  s=0.5*(e-1./e);
122  c=0.5*(e+1./e);
123  psi=psi+coeff[j]*(s+c*Tanh[j])*cosa[nm];
124  u=u+j*coeff[j]*(c+s*Tanh[j])*cosa[nm];
125  v=v+j*coeff[j]*(s+c*Tanh[j])*sina[nm];
126  }
127  rhs[m+9]=psi-z[8]-z[7]*z[m+10];
128  rhs[n+m+10]=0.5*(pow((-z[7]+u),2.)+v*v)+z[m+10]-z[9];
129  }
130 
131 for (j=1, s=0. ; j <= num ; j++ ) s += rhs[j]*rhs[j];
132 return s;
133 }
134 
135 // **************************************************
136 // SET UP JACOBIAN MATRIX AND SOLVE MATRIX EQUATION
137 // **************************************************
138 
139 double Newton(int count)
140 {
141 double **a, *rhs, *x;
142 double h, sum;
143 void Solve(double **, double *, int, int, double *, int, int);
144 
145 int i, j;
146 
147 Eqns(rhs1);
148 
149 if(count>=1)
150 {
151 ++count;
152 rhs=dvector(1,num);
153 x=dvector(1,num);
154 a=dmatrix(1,num,1,num);
155 }
156 
157 for ( i=1 ; i<=num ; i++ )
158  {
159  h=0.01*z[i];
160  if(fabs(z[i]) < 1.e-4) h = 1.e-5;
161  z[i]=z[i]+h;
162  Eqns(rhs2);
163  z[i]=z[i]-h;
164  rhs[i] = -rhs1[i];
165  for ( j=1 ; j<=num ; j++ )
166  a[j][i] = (rhs2[j] - rhs1[j])/h;
167  }
168 
169 // **************************************************
170 // SOLVE MATRIX EQUATION
171 // **************************************************
172 
173 Solve(a, rhs, (int)num, (int)num, x, (int)num, (int)num);
174 
175 for ( i=1 ; i<=num ; i++ )
176  z[i] += x[i];
177 
178 for ( sum = 0., i=10 ; i<= n+10 ; i++ )
179  sum += fabs(x[i]);
180 sum /= n;
181 
182 free_dvector(rhs,1,num);
183 free_dvector(x,1,num);
184 free_dmatrix(a,1,num,1,num);
185 
186 return(sum);
187 }
188 
dmatrix
double ** dmatrix(long nrl, long nrh, long ncl, long nch)
Definition: Util.cpp:16
Solve
void Solve(void)
Hoverd
Double Hoverd
Definition: Headers.h:68
rhs1
Double * rhs1
Definition: Headers.h:44
dvector
double * dvector(long, long)
Definition: Util.cpp:7
coeff
Double * coeff
Definition: Headers.h:42
s
Double s
Definition: Headers.h:84
sum
Double sum
Definition: Headers.h:85
iff
#define iff(x, y)
Definition: Subroutines.cpp:9
Tanh
Double * Tanh
Definition: Headers.h:47
n
Int n
Definition: Headers.h:28
free_dvector
void free_dvector(double *, long, long)
Definition: Util.cpp:38
Current_criterion
Int Current_criterion
Definition: Headers.h:27
num
Int num
Definition: Headers.h:32
cosa
Double * cosa
Definition: Headers.h:43
v
Double v
Definition: Headers.h:95
Case
char Case[]
Newton
double Newton(int count)
Definition: Subroutines.cpp:139
init
void init()
Definition: Subroutines.cpp:28
sina
Double * sina
Definition: Headers.h:46
z
Double * z
Definition: Headers.h:49
u
Double u
Definition: Headers.h:89
c
Double c
Definition: Headers.h:54
sol
Double ** sol
Definition: Headers.h:40
rhs2
Double * rhs2
Definition: Headers.h:45
free_dmatrix
void free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch)
Definition: Util.cpp:44
Eqns
double Eqns(double *rhs)
Definition: Subroutines.cpp:83
Headers.h
height
Double height
Definition: Headers.h:69
Current
Double Current
Definition: Headers.h:59
pi
#define pi
Definition: Subroutines.cpp:10
psi
Double psi
Definition: Headers.h:78