1! 物理定数モジュール
2module mod_const
3 implicit none
4 private ! デフォルトで非公開
5
6 ! 単位選択フラグ: 1 => MKS, 2 => CGS
7 integer :: unit = 1
8
9 real(8), parameter :: pi = 4 * atan(1.0_8)
10 real(8), parameter :: mu0 = 4 * pi * 1.0e-7_8
11
12 ! MKS => CGS への変換ファクター
13 real(8), parameter :: T = 1.0e+0_8
14 real(8), parameter :: L = 1.0e+2_8
15 real(8), parameter :: M = 1.0e+3_8
16
17 ! MKSで定義
18 real(8), parameter :: mks_light_speed = 2.997924e+8_8
19 real(8), parameter :: mks_electron_mass = 9.109382e-31_8
20 real(8), parameter :: mks_elementary_charge = 1.602176e-19_8
21
22 ! これらのみ公開
23 public :: set_mks, set_cgs
24 public :: light_speed, electron_mass, elementary_charge
25
26contains
27
28 ! MKSモード
29 subroutine set_mks()
30 implicit none
31
32 unit = 1
33 endsubroutine set_mks
34
35 ! CGSモード
36 subroutine set_cgs()
37 implicit none
38
39 unit = 2
40 endsubroutine set_cgs
41
42 ! 光速
43 function light_speed() result(x)
44 implicit none
45 real(8) :: x
46
47 if(unit == 1) then
48 x = mks_light_speed
49 else if(unit == 2) then
50 x = mks_light_speed * L / T
51 else
52 call unit_error(unit)
53 endif
54
55 endfunction light_speed
56
57 ! 電子質量
58 function electron_mass() result(x)
59 implicit none
60 real(8) :: x
61
62 if(unit == 1) then
63 x = mks_electron_mass
64 else if(unit == 2) then
65 x = mks_electron_mass * M
66 else
67 call unit_error(unit)
68 endif
69
70 endfunction electron_mass
71
72 ! 素電荷
73 function elementary_charge() result(x)
74 implicit none
75 real(8) :: x
76
77 if(unit == 1) then
78 x = mks_elementary_charge
79 else if(unit == 2) then
80 x = mks_elementary_charge * light_speed() * sqrt(mu0 / (4 * pi) * M * L * T**2)
81 else
82 call unit_error(unit)
83 endif
84
85 endfunction elementary_charge
86
87 ! エラー
88 subroutine unit_error(u)
89 implicit none
90 integer, intent(in) :: u
91
92 ! 標準エラー出力へ
93 write(0, '(a, i3)') 'Error: invalid unit ', u
94
95 endsubroutine unit_error
96
97endmodule mod_const
98
99! メインプログラム
100program sample
101 use mod_const
102 implicit none
103
104 ! デフォルトはMKS
105 write(*, '(a)') 'Physical Constants in MKS'
106 write(*, '(a20, " : ", e12.4)') 'Elementary Charge', elementary_charge()
107 write(*, '(a20, " : ", e12.4)') 'Electron Mass', electron_mass()
108 write(*, '(a20, " : ", e12.4)') 'Speed of Light', light_speed()
109
110 ! CGSで表示
111 call set_cgs()
112 write(*, '(a)') 'Physical Constants in CGS'
113 write(*, '(a20, " : ", e12.4)') 'Elementary Charge', elementary_charge()
114 write(*, '(a20, " : ", e12.4)') 'Electron Mass', electron_mass()
115 write(*, '(a20, " : ", e12.4)') 'Speed of Light', light_speed()
116
117endprogram sample