proteus
1.8.1
C/C++/Fortran libraries
Users
cekees
proteus
proteus
fenton
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
Generated on Fri Jul 1 2022 11:17:40 for proteus by
1.8.20