Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2022 The MESA Team
4 : !
5 : ! This program is free software: you can redistribute it and/or modify
6 : ! it under the terms of the GNU Lesser General Public License
7 : ! as published by the Free Software Foundation,
8 : ! either version 3 of the License, or (at your option) any later version.
9 : !
10 : ! This program is distributed in the hope that it will be useful,
11 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
12 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 : ! See the GNU Lesser General Public License for more details.
14 : !
15 : ! You should have received a copy of the GNU Lesser General Public License
16 : ! along with this program. If not, see <https://www.gnu.org/licenses/>.
17 : !
18 : ! ***********************************************************************
19 :
20 : module support_functions
21 :
22 : use const_def, only: dp
23 : use math_lib
24 :
25 : implicit none
26 :
27 : interface pow
28 : module procedure int_real_pow
29 : module procedure int_int_pow
30 : end interface pow
31 :
32 : interface log
33 : module procedure log_int
34 : end interface log
35 :
36 : interface max
37 : module procedure max_int_real
38 : module procedure max_real_int
39 : end interface max
40 :
41 : interface min
42 : module procedure min_int_real
43 : module procedure min_real_int
44 : end interface min
45 :
46 : contains
47 :
48 381104 : pure real(dp) function sgn(x) result(res)
49 : real(dp), intent(in) :: x
50 381104 : if (x < 0d0) then
51 : res = -1d0
52 239326 : else if (x == 0d0) then
53 : res = 0d0
54 : else
55 238903 : res = 1d0
56 : end if
57 381104 : end function sgn
58 :
59 5722830 : pure real(dp) function Heaviside(x) result(res)
60 : real(dp), intent(in) :: x
61 5722830 : if (x < 0d0) then
62 : res = 0d0
63 3547812 : else if (x == 0d0) then
64 : res = 0.5d0
65 : else
66 3494002 : res = 1d0
67 : end if
68 5722830 : end function Heaviside
69 :
70 0 : pure real(dp) function int_real_pow(x, y) result(z)
71 : integer, intent(in) :: x
72 : real(dp), intent(in) :: y
73 : real(dp) :: x_real
74 :
75 0 : x_real = x
76 0 : z = pow(x_real,y)
77 0 : end function int_real_pow
78 :
79 0 : pure real(dp) function int_int_pow(x, y) result(z)
80 : integer, intent(in) :: x, y
81 :
82 0 : z = x**y
83 0 : end function int_int_pow
84 :
85 0 : pure real(dp) function log_int(x) result(res)
86 : integer, intent(in) :: x
87 : real(dp) :: x_real
88 :
89 0 : x_real = x
90 0 : res = log(x_real)
91 :
92 0 : end function log_int
93 :
94 0 : pure real(dp) function max_real_int(x, y) result(z)
95 : real(dp), intent(in) :: x
96 : integer, intent(in) :: y
97 0 : if (x > y) then
98 : z = x
99 : else
100 0 : z = y
101 : end if
102 0 : end function max_real_int
103 :
104 0 : pure real(dp) function max_int_real(x, y) result(z)
105 : integer, intent(in) :: x
106 : real(dp), intent(in) :: y
107 0 : if (x > y) then
108 : z = x
109 : else
110 0 : z = y
111 : end if
112 0 : end function max_int_real
113 :
114 0 : pure real(dp) function min_int_real(x, y) result(z)
115 : integer, intent(in) :: x
116 : real(dp), intent(in) :: y
117 0 : if (x < y) then
118 : z = x
119 : else
120 0 : z = y
121 : end if
122 0 : end function min_int_real
123 :
124 :
125 0 : pure real(dp) function min_real_int(x, y) result(z)
126 : integer, intent(in) :: y
127 : real(dp), intent(in) :: x
128 0 : if (x < y) then
129 : z = x
130 : else
131 0 : z = y
132 : end if
133 0 : end function min_real_int
134 :
135 : end module support_functions
|
