質問するログイン新規登録

質問編集履歴

1

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

2020/07/11 14:47

投稿

aaaaaaaaa_a
aaaaaaaaa_a

スコア4

title CHANGED
File without changes
body CHANGED
@@ -8,11 +8,126 @@
8
8
  ```
9
9
 
10
10
  ###
11
- real*8 function f4(i,x1,x2,x3,x4,x5,x6)
11
+ program main
12
12
  implicit none
13
13
  integer,parameter :: n=14610
14
+ integer :: i,day,k
15
+ real*8 :: h,a(n),xj(n),yj(n),zj(n),x1,x2,x3,x4,x5,x6,
16
+ & f1,f2,f3,f4,f5,f6,ka1,ka2,ka3,ka4,ka5,ka6,kb1,kb2,kb3,
17
+ & kb4,kb5,kb6,kc1,kc2,kc3,kc4,kc5,kc6,kd1,kd2,kd3,kd4,
18
+ & kd5,kd6,gs,gj,xr,xrj,xmj
19
+
20
+ open(10,file='z_jupitar-2.txt')
21
+ do i=1,n
22
+ read(10,*) a(i),xj(i),yj(i),zj(i)
23
+ end do
24
+ close(10)
25
+
26
+ ! 初期条件
27
+ x1=3.64d-7
28
+ x2=0.0d0
29
+ x3=0.0d0
30
+ x4=0.0d0
31
+ x5=8.0d0
32
+ x6=0.0d0
33
+ h=20.0d0
34
+ write(*,*) 0,x1,x2,x3,xj(1),yj(1),zj(1)
35
+
36
+ ! 彗星の位置推算 Runge-Kutta法
37
+
38
+ do k=1,n-3,2
39
+ i=k
40
+ day=(i+1)*10
41
+
42
+ ka1=h*f1(x4)
43
+ ka2=h*f2(x5)
44
+ ka3=h*f3(x6)
45
+ ka4=h*f4(x1,x2,x3)
46
+ ka5=h*f5(x1,x2,x3)
47
+ ka6=h*f6(x1,x2,x3)
48
+
49
+ ! write(*,*) ka1,ka2,ka3,ka4,ka5,ka6
50
+
51
+ i=i+1
52
+
53
+ kb1=h*f1(x4+ka4/2.0d0)
54
+ kb2=h*f2(x5+ka5/2.0d0)
55
+ kb3=h*f3(x6+ka6/2.0d0)
56
+ kb4=h*f4(x1+ka1/2.0d0,x2+ka2/2.0d0,x3+ka3/2.0d0)
57
+ kb5=h*f5(x1+ka1/2.0d0,x2+ka2/2.0d0,x3+ka3/2.0d0)
58
+ kb6=h*f6(x1+ka1/2.0d0,x2+ka2/2.0d0,x3+ka3/2.0d0)
59
+
60
+ ! write(*,*) kb1,kb2,kb3,kb4,kb5,kb6
61
+
62
+ kc1=h*f1(x4+kb4/2.0d0)
63
+ kc2=h*f2(x5+kb5/2.0d0)
64
+ kc3=h*f3(x6+kb6/2.0d0)
65
+ kc4=h*f4(x1+kb1/2.0d0,x2+kb2/2.0d0,x3+kb3/2.0d0)
66
+ kc5=h*f5(x1+kb1/2.0d0,x2+kb2/2.0d0,x3+kb3/2.0d0)
67
+ kc6=h*f6(x1+kb1/2.0d0,x2+kb2/2.0d0,x3+kb3/2.0d0)
68
+
69
+ ! write(*,*) kc1,kc2,kc3,kc4,kc5,kc6
70
+
71
+ i=i+1
72
+
73
+ ! write(*,*) i
74
+
75
+ kd1=h*f1(x4+kc4)
76
+ kd2=h*f2(x5+kc5)
77
+ kd3=h*f3(x6+kc6)
78
+ kd4=h*f4(x1+kc1,x2+kc2,x3+kc3)
79
+ kd5=h*f5(x1+kc1,x2+kc2,x3+kc3)
80
+ kd6=h*f6(x1+kc1,x2+kc2,x3+kc3)
81
+
82
+ ! write(*,*) kd1,kd2,kd3,kd4,kd5,kd6
83
+
84
+ x1=x1+(ka1+kd1)/6.0d0+(kb1+kc1)/3.0d0
85
+ x2=x2+(ka2+kd2)/6.0d0+(kb2+kc2)/3.0d0
86
+ x3=x3+(ka3+kd3)/6.0d0+(kb3+kc3)/3.0d0
87
+ x4=x4+(ka4+kd4)/6.0d0+(kb4+kc4)/3.0d0
88
+ x5=x5+(ka5+kd5)/6.0d0+(kb5+kc5)/3.0d0
89
+ x6=x6+(ka6+kd6)/6.0d0+(kb6+kc6)/3.0d0
90
+
91
+ write(*,*) day,x1,x2,x3,x4,x5,x6
92
+ end do
93
+
94
+ stop
95
+ end program main
96
+
97
+ ! 微分方程式
98
+
99
+ real*8 function f1(x4)
100
+ implicit none
101
+ real*8 :: x4
102
+
103
+ f1=x4
104
+
105
+ return
106
+ end function f1
107
+
108
+ real*8 function f2(x5)
109
+ implicit none
110
+ real*8 :: x5
111
+
112
+ f2=x5
113
+
114
+ return
115
+ end function f2
116
+
117
+ real*8 function f3(x6)
118
+ implicit none
119
+ real*8 :: x6
120
+
121
+ f3=x6
122
+
123
+ return
124
+ end function f3
125
+
126
+ real*8 function f4(x1,x2,x3)
127
+ implicit none
128
+ integer,parameter :: n=14610
14
129
  integer :: i
15
- real*8 :: x1,x2,x3,x4,x5,x6,xj(n),yj(n),zj(n),
130
+ real*8 :: x1,x2,x3,xj(n),yj(n),zj(n),
16
131
  & gs,gj,xr,xrj,xmj
17
132
 
18
133
  gs=2.95912208d-4
@@ -28,11 +143,11 @@
28
143
  return
29
144
  end function f4
30
145
 
31
- real*8 function f5(i,x1,x2,x3,x4,x5,x6)
146
+ real*8 function f5(x1,x2,x3)
32
147
  implicit none
33
148
  integer,parameter :: n=14610
34
149
  integer :: i
35
- real*8 :: x1,x2,x3,x4,x5,x6,xj(n),yj(n),zj(n),
150
+ real*8 :: x1,x2,x3,xj(n),yj(n),zj(n),
36
151
  & gs,gj,xr,xrj,xmj
37
152
 
38
153
  gs=2.95912208d-4
@@ -48,11 +163,11 @@
48
163
  return
49
164
  end function f5
50
165
 
51
- real*8 function f6(i,x1,x2,x3,x4,x5,x6)
166
+ real*8 function f6(x1,x2,x3)
52
167
  implicit none
53
168
  integer,parameter :: n=14610
54
169
  integer :: i
55
- real*8 :: x1,x2,x3,x4,x5,x6,xj(n),yj(n),zj(n),
170
+ real*8 :: x1,x2,x3,xj(n),yj(n),zj(n),
56
171
  & gs,gj,xr,xrj,xmj
57
172
 
58
173
  gs=2.95912208d-4
@@ -70,6 +185,7 @@
70
185
 
71
186
 
72
187
 
188
+
73
189
  ```
74
190
 
75
191
  ### 試したこと