|
111
|
1 ! Copyright (C) 2002-2017 Free Software Foundation, Inc.
|
|
|
2 ! Contributed by Tobias Schl"uter
|
|
|
3 !
|
|
|
4 !This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
|
|
5 !
|
|
|
6 !GNU libgfortran is free software; you can redistribute it and/or
|
|
|
7 !modify it under the terms of the GNU General Public
|
|
|
8 !License as published by the Free Software Foundation; either
|
|
|
9 !version 3 of the License, or (at your option) any later version.
|
|
|
10 !
|
|
|
11 !GNU libgfortran is distributed in the hope that it will be useful,
|
|
|
12 !but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
13 !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
14 !GNU General Public License for more details.
|
|
|
15 !
|
|
|
16 !Under Section 7 of GPL version 3, you are granted additional
|
|
|
17 !permissions described in the GCC Runtime Library Exception, version
|
|
|
18 !3.1, as published by the Free Software Foundation.
|
|
|
19 !
|
|
|
20 !You should have received a copy of the GNU General Public License and
|
|
|
21 !a copy of the GCC Runtime Library Exception along with this program;
|
|
|
22 !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
23 !<http://www.gnu.org/licenses/>.
|
|
|
24
|
|
|
25 ! Specifics for the intrinsics whose calling conventions change if
|
|
|
26 ! -ff2c is used.
|
|
|
27 !
|
|
|
28 ! There are two annoyances WRT the preprocessor:
|
|
|
29 ! - we're using -traditional-cpp, so we can't use the ## operator.
|
|
|
30 ! - macros expand to a single line, and Fortran lines can't be wider
|
|
|
31 ! than 132 characters, therefore we use two macros to split the lines
|
|
|
32 !
|
|
|
33 ! The cases we need to implement are functions returning default REAL
|
|
|
34 ! or COMPLEX. The former need to return DOUBLE PRECISION instead of REAL,
|
|
|
35 ! the latter become subroutines returning via a hidden first argument.
|
|
|
36
|
|
|
37 ! one argument functions
|
|
|
38 #define REAL_HEAD(NAME) \
|
|
|
39 elemental function _gfortran_f2c_specific__/**/NAME/**/_r4 (parm) result(res);
|
|
|
40
|
|
|
41 #define REAL_BODY(NAME) \
|
|
|
42 REAL, intent (in) :: parm; \
|
|
|
43 DOUBLE PRECISION :: res; \
|
|
|
44 res = NAME (parm); \
|
|
|
45 end function
|
|
|
46
|
|
|
47 #define COMPLEX_HEAD(NAME) \
|
|
|
48 subroutine _gfortran_f2c_specific__/**/NAME/**/_c4 (res, parm);
|
|
|
49
|
|
|
50 #define COMPLEX_BODY(NAME) \
|
|
|
51 COMPLEX, intent (in) :: parm; \
|
|
|
52 COMPLEX, intent (out) :: res; \
|
|
|
53 res = NAME (parm); \
|
|
|
54 end subroutine
|
|
|
55
|
|
|
56 #define DCOMPLEX_HEAD(NAME) \
|
|
|
57 subroutine _gfortran_f2c_specific__/**/NAME/**/_c8 (res, parm);
|
|
|
58
|
|
|
59 #define DCOMPLEX_BODY(NAME) \
|
|
|
60 DOUBLE COMPLEX, intent (in) :: parm; \
|
|
|
61 DOUBLE COMPLEX, intent (out) :: res; \
|
|
|
62 res = NAME (parm); \
|
|
|
63 end subroutine
|
|
|
64
|
|
|
65 REAL_HEAD(abs)
|
|
|
66 REAL_BODY(abs)
|
|
|
67
|
|
|
68 ! abs is special in that the result is real
|
|
|
69 elemental function _gfortran_f2c_specific__abs_c4 (parm) result (res)
|
|
|
70 COMPLEX, intent(in) :: parm
|
|
|
71 DOUBLE PRECISION :: res
|
|
|
72 res = abs(parm)
|
|
|
73 end function
|
|
|
74
|
|
|
75
|
|
|
76 ! aimag is special in that the result is real
|
|
|
77 elemental function _gfortran_f2c_specific__aimag_c4 (parm)
|
|
|
78 complex(kind=4), intent(in) :: parm
|
|
|
79 double precision :: _gfortran_f2c_specific__aimag_c4
|
|
|
80 _gfortran_f2c_specific__aimag_c4 = aimag(parm)
|
|
|
81 end function
|
|
|
82
|
|
|
83 elemental function _gfortran_f2c_specific__aimag_c8 (parm)
|
|
|
84 complex(kind=8), intent(in) :: parm
|
|
|
85 double precision :: _gfortran_f2c_specific__aimag_c8
|
|
|
86 _gfortran_f2c_specific__aimag_c8 = aimag(parm)
|
|
|
87 end function
|
|
|
88
|
|
|
89
|
|
|
90 REAL_HEAD(exp)
|
|
|
91 REAL_BODY(exp)
|
|
|
92 COMPLEX_HEAD(exp)
|
|
|
93 COMPLEX_BODY(exp)
|
|
|
94 DCOMPLEX_HEAD(exp)
|
|
|
95 DCOMPLEX_BODY(exp)
|
|
|
96
|
|
|
97 REAL_HEAD(log)
|
|
|
98 REAL_BODY(log)
|
|
|
99 COMPLEX_HEAD(log)
|
|
|
100 COMPLEX_BODY(log)
|
|
|
101 DCOMPLEX_HEAD(log)
|
|
|
102 DCOMPLEX_BODY(log)
|
|
|
103
|
|
|
104 REAL_HEAD(log10)
|
|
|
105 REAL_BODY(log10)
|
|
|
106
|
|
|
107 REAL_HEAD(sqrt)
|
|
|
108 REAL_BODY(sqrt)
|
|
|
109 COMPLEX_HEAD(sqrt)
|
|
|
110 COMPLEX_BODY(sqrt)
|
|
|
111 DCOMPLEX_HEAD(sqrt)
|
|
|
112 DCOMPLEX_BODY(sqrt)
|
|
|
113
|
|
|
114 REAL_HEAD(asin)
|
|
|
115 REAL_BODY(asin)
|
|
|
116
|
|
|
117 REAL_HEAD(acos)
|
|
|
118 REAL_BODY(acos)
|
|
|
119
|
|
|
120 REAL_HEAD(atan)
|
|
|
121 REAL_BODY(atan)
|
|
|
122
|
|
|
123 REAL_HEAD(asinh)
|
|
|
124 REAL_BODY(asinh)
|
|
|
125
|
|
|
126 REAL_HEAD(acosh)
|
|
|
127 REAL_BODY(acosh)
|
|
|
128
|
|
|
129 REAL_HEAD(atanh)
|
|
|
130 REAL_BODY(atanh)
|
|
|
131
|
|
|
132 REAL_HEAD(sin)
|
|
|
133 REAL_BODY(sin)
|
|
|
134 COMPLEX_HEAD(sin)
|
|
|
135 COMPLEX_BODY(sin)
|
|
|
136 DCOMPLEX_HEAD(sin)
|
|
|
137 DCOMPLEX_BODY(sin)
|
|
|
138
|
|
|
139 REAL_HEAD(cos)
|
|
|
140 REAL_BODY(cos)
|
|
|
141 COMPLEX_HEAD(cos)
|
|
|
142 COMPLEX_BODY(cos)
|
|
|
143 DCOMPLEX_HEAD(cos)
|
|
|
144 DCOMPLEX_BODY(cos)
|
|
|
145
|
|
|
146 REAL_HEAD(tan)
|
|
|
147 REAL_BODY(tan)
|
|
|
148
|
|
|
149 REAL_HEAD(sinh)
|
|
|
150 REAL_BODY(sinh)
|
|
|
151
|
|
|
152 REAL_HEAD(cosh)
|
|
|
153 REAL_BODY(cosh)
|
|
|
154
|
|
|
155 REAL_HEAD(tanh)
|
|
|
156 REAL_BODY(tanh)
|
|
|
157
|
|
|
158 REAL_HEAD(aint)
|
|
|
159 REAL_BODY(aint)
|
|
|
160
|
|
|
161 REAL_HEAD(anint)
|
|
|
162 REAL_BODY(anint)
|
|
|
163
|
|
|
164 ! two argument functions
|
|
|
165 #define REAL2_HEAD(NAME) \
|
|
|
166 elemental function _gfortran_f2c_specific__/**/NAME/**/_r4 (p1, p2) result(res);
|
|
|
167
|
|
|
168 #define REAL2_BODY(NAME) \
|
|
|
169 REAL, intent (in) :: p1, p2; \
|
|
|
170 DOUBLE PRECISION :: res; \
|
|
|
171 res = NAME (p1, p2); \
|
|
|
172 end function
|
|
|
173
|
|
|
174 REAL2_HEAD(sign)
|
|
|
175 REAL2_BODY(sign)
|
|
|
176
|
|
|
177 REAL2_HEAD(dim)
|
|
|
178 REAL2_BODY(dim)
|
|
|
179
|
|
|
180 REAL2_HEAD(atan2)
|
|
|
181 REAL2_BODY(atan2)
|
|
|
182
|
|
|
183 REAL2_HEAD(mod)
|
|
|
184 REAL2_BODY(mod)
|
|
|
185
|
|
|
186 ! conjg is special-cased because it is not suffixed _c4 but _4
|
|
|
187 subroutine _gfortran_f2c_specific__conjg_4 (res, parm)
|
|
|
188 COMPLEX, intent (in) :: parm
|
|
|
189 COMPLEX, intent (out) :: res
|
|
|
190 res = conjg (parm)
|
|
|
191 end subroutine
|
|
|
192 subroutine _gfortran_f2c_specific__conjg_8 (res, parm)
|
|
|
193 DOUBLE COMPLEX, intent (in) :: parm
|
|
|
194 DOUBLE COMPLEX, intent (out) :: res
|
|
|
195 res = conjg (parm)
|
|
|
196 end subroutine
|
|
|
197
|
