質問編集履歴

1

一部だけだったのをソースコード全体にしました。

2020/07/11 14:47

投稿

aaaaaaaaa_a
aaaaaaaaa_a

スコア4

test CHANGED
File without changes
test CHANGED
@@ -18,15 +18,245 @@
18
18
 
19
19
  ###
20
20
 
21
- real*8 function f4(i,x1,x2,x3,x4,x5,x6)
21
+ program main
22
22
 
23
23
  implicit none
24
24
 
25
25
  integer,parameter :: n=14610
26
26
 
27
+ integer :: i,day,k
28
+
29
+ real*8 :: h,a(n),xj(n),yj(n),zj(n),x1,x2,x3,x4,x5,x6,
30
+
31
+ & f1,f2,f3,f4,f5,f6,ka1,ka2,ka3,ka4,ka5,ka6,kb1,kb2,kb3,
32
+
33
+ & kb4,kb5,kb6,kc1,kc2,kc3,kc4,kc5,kc6,kd1,kd2,kd3,kd4,
34
+
35
+ & kd5,kd6,gs,gj,xr,xrj,xmj
36
+
37
+
38
+
39
+ open(10,file='z_jupitar-2.txt')
40
+
41
+ do i=1,n
42
+
43
+ read(10,*) a(i),xj(i),yj(i),zj(i)
44
+
45
+ end do
46
+
47
+ close(10)
48
+
49
+
50
+
51
+ ! 初期条件
52
+
53
+ x1=3.64d-7
54
+
55
+ x2=0.0d0
56
+
57
+ x3=0.0d0
58
+
59
+ x4=0.0d0
60
+
61
+ x5=8.0d0
62
+
63
+ x6=0.0d0
64
+
65
+ h=20.0d0
66
+
67
+ write(*,*) 0,x1,x2,x3,xj(1),yj(1),zj(1)
68
+
69
+
70
+
71
+ ! 彗星の位置推算 Runge-Kutta法
72
+
73
+
74
+
75
+ do k=1,n-3,2
76
+
77
+ i=k
78
+
79
+ day=(i+1)*10
80
+
81
+
82
+
83
+ ka1=h*f1(x4)
84
+
85
+ ka2=h*f2(x5)
86
+
87
+ ka3=h*f3(x6)
88
+
89
+ ka4=h*f4(x1,x2,x3)
90
+
91
+ ka5=h*f5(x1,x2,x3)
92
+
93
+ ka6=h*f6(x1,x2,x3)
94
+
95
+
96
+
97
+ ! write(*,*) ka1,ka2,ka3,ka4,ka5,ka6
98
+
99
+
100
+
101
+ i=i+1
102
+
103
+
104
+
105
+ kb1=h*f1(x4+ka4/2.0d0)
106
+
107
+ kb2=h*f2(x5+ka5/2.0d0)
108
+
109
+ kb3=h*f3(x6+ka6/2.0d0)
110
+
111
+ kb4=h*f4(x1+ka1/2.0d0,x2+ka2/2.0d0,x3+ka3/2.0d0)
112
+
113
+ kb5=h*f5(x1+ka1/2.0d0,x2+ka2/2.0d0,x3+ka3/2.0d0)
114
+
115
+ kb6=h*f6(x1+ka1/2.0d0,x2+ka2/2.0d0,x3+ka3/2.0d0)
116
+
117
+
118
+
119
+ ! write(*,*) kb1,kb2,kb3,kb4,kb5,kb6
120
+
121
+
122
+
123
+ kc1=h*f1(x4+kb4/2.0d0)
124
+
125
+ kc2=h*f2(x5+kb5/2.0d0)
126
+
127
+ kc3=h*f3(x6+kb6/2.0d0)
128
+
129
+ kc4=h*f4(x1+kb1/2.0d0,x2+kb2/2.0d0,x3+kb3/2.0d0)
130
+
131
+ kc5=h*f5(x1+kb1/2.0d0,x2+kb2/2.0d0,x3+kb3/2.0d0)
132
+
133
+ kc6=h*f6(x1+kb1/2.0d0,x2+kb2/2.0d0,x3+kb3/2.0d0)
134
+
135
+
136
+
137
+ ! write(*,*) kc1,kc2,kc3,kc4,kc5,kc6
138
+
139
+
140
+
141
+ i=i+1
142
+
143
+
144
+
145
+ ! write(*,*) i
146
+
147
+
148
+
149
+ kd1=h*f1(x4+kc4)
150
+
151
+ kd2=h*f2(x5+kc5)
152
+
153
+ kd3=h*f3(x6+kc6)
154
+
155
+ kd4=h*f4(x1+kc1,x2+kc2,x3+kc3)
156
+
157
+ kd5=h*f5(x1+kc1,x2+kc2,x3+kc3)
158
+
159
+ kd6=h*f6(x1+kc1,x2+kc2,x3+kc3)
160
+
161
+
162
+
163
+ ! write(*,*) kd1,kd2,kd3,kd4,kd5,kd6
164
+
165
+
166
+
167
+ x1=x1+(ka1+kd1)/6.0d0+(kb1+kc1)/3.0d0
168
+
169
+ x2=x2+(ka2+kd2)/6.0d0+(kb2+kc2)/3.0d0
170
+
171
+ x3=x3+(ka3+kd3)/6.0d0+(kb3+kc3)/3.0d0
172
+
173
+ x4=x4+(ka4+kd4)/6.0d0+(kb4+kc4)/3.0d0
174
+
175
+ x5=x5+(ka5+kd5)/6.0d0+(kb5+kc5)/3.0d0
176
+
177
+ x6=x6+(ka6+kd6)/6.0d0+(kb6+kc6)/3.0d0
178
+
179
+
180
+
181
+ write(*,*) day,x1,x2,x3,x4,x5,x6
182
+
183
+ end do
184
+
185
+
186
+
187
+ stop
188
+
189
+ end program main
190
+
191
+
192
+
193
+ ! 微分方程式
194
+
195
+
196
+
197
+ real*8 function f1(x4)
198
+
199
+ implicit none
200
+
201
+ real*8 :: x4
202
+
203
+
204
+
205
+ f1=x4
206
+
207
+
208
+
209
+ return
210
+
211
+ end function f1
212
+
213
+
214
+
215
+ real*8 function f2(x5)
216
+
217
+ implicit none
218
+
219
+ real*8 :: x5
220
+
221
+
222
+
223
+ f2=x5
224
+
225
+
226
+
227
+ return
228
+
229
+ end function f2
230
+
231
+
232
+
233
+ real*8 function f3(x6)
234
+
235
+ implicit none
236
+
237
+ real*8 :: x6
238
+
239
+
240
+
241
+ f3=x6
242
+
243
+
244
+
245
+ return
246
+
247
+ end function f3
248
+
249
+
250
+
251
+ real*8 function f4(x1,x2,x3)
252
+
253
+ implicit none
254
+
255
+ integer,parameter :: n=14610
256
+
27
257
  integer :: i
28
258
 
29
- real*8 :: x1,x2,x3,x4,x5,x6,xj(n),yj(n),zj(n),
259
+ real*8 :: x1,x2,x3,xj(n),yj(n),zj(n),
30
260
 
31
261
  & gs,gj,xr,xrj,xmj
32
262
 
@@ -58,7 +288,7 @@
58
288
 
59
289
 
60
290
 
61
- real*8 function f5(i,x1,x2,x3,x4,x5,x6)
291
+ real*8 function f5(x1,x2,x3)
62
292
 
63
293
  implicit none
64
294
 
@@ -66,7 +296,7 @@
66
296
 
67
297
  integer :: i
68
298
 
69
- real*8 :: x1,x2,x3,x4,x5,x6,xj(n),yj(n),zj(n),
299
+ real*8 :: x1,x2,x3,xj(n),yj(n),zj(n),
70
300
 
71
301
  & gs,gj,xr,xrj,xmj
72
302
 
@@ -98,7 +328,7 @@
98
328
 
99
329
 
100
330
 
101
- real*8 function f6(i,x1,x2,x3,x4,x5,x6)
331
+ real*8 function f6(x1,x2,x3)
102
332
 
103
333
  implicit none
104
334
 
@@ -106,7 +336,7 @@
106
336
 
107
337
  integer :: i
108
338
 
109
- real*8 :: x1,x2,x3,x4,x5,x6,xj(n),yj(n),zj(n),
339
+ real*8 :: x1,x2,x3,xj(n),yj(n),zj(n),
110
340
 
111
341
  & gs,gj,xr,xrj,xmj
112
342
 
@@ -142,6 +372,8 @@
142
372
 
143
373
 
144
374
 
375
+
376
+
145
377
  ```
146
378
 
147
379