2018-06-19 Tony Reix <tony.reix@atos.com>
[official-gcc.git] / libgfortran / intrinsics / f2c_specifics.F90
blob865ae5d715108cc99dbaecfe72c166f03f6c7f06
1 !   Copyright (C) 2002-2018 Free Software Foundation, Inc.
2 !   Contributed by Tobias Schl"uter
4 !This file is part of the GNU Fortran 95 runtime library (libgfortran).
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.
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.
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.
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/>.
25 ! Specifics for the intrinsics whose calling conventions change if
26 ! -ff2c is used.
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
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.
37 ! one argument functions
38 #define REAL_HEAD(NAME) \
39 elemental function _gfortran_f2c_specific__/**/NAME/**/_r4 (parm) result(res);
41 #define REAL_BODY(NAME) \
42   REAL, intent (in) :: parm; \
43   DOUBLE PRECISION :: res; \
44   res = NAME (parm); \
45 end function
47 #define COMPLEX_HEAD(NAME) \
48 subroutine _gfortran_f2c_specific__/**/NAME/**/_c4 (res, parm);
50 #define COMPLEX_BODY(NAME) \
51   COMPLEX, intent (in) :: parm; \
52   COMPLEX, intent (out) :: res; \
53   res = NAME (parm); \
54 end subroutine
56 #define DCOMPLEX_HEAD(NAME) \
57 subroutine _gfortran_f2c_specific__/**/NAME/**/_c8 (res, parm);
59 #define DCOMPLEX_BODY(NAME) \
60   DOUBLE COMPLEX, intent (in) :: parm; \
61   DOUBLE COMPLEX, intent (out) :: res; \
62   res = NAME (parm); \
63 end subroutine
65 REAL_HEAD(abs)
66 REAL_BODY(abs)
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
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
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
90 REAL_HEAD(exp)
91 REAL_BODY(exp)
92 COMPLEX_HEAD(exp)
93 COMPLEX_BODY(exp)
94 DCOMPLEX_HEAD(exp)
95 DCOMPLEX_BODY(exp)
97 REAL_HEAD(log)
98 REAL_BODY(log)
99 COMPLEX_HEAD(log)
100 COMPLEX_BODY(log)
101 DCOMPLEX_HEAD(log)
102 DCOMPLEX_BODY(log)
104 REAL_HEAD(log10)
105 REAL_BODY(log10)
107 REAL_HEAD(sqrt)
108 REAL_BODY(sqrt)
109 COMPLEX_HEAD(sqrt)
110 COMPLEX_BODY(sqrt)
111 DCOMPLEX_HEAD(sqrt)
112 DCOMPLEX_BODY(sqrt)
114 REAL_HEAD(asin)
115 REAL_BODY(asin)
117 REAL_HEAD(acos)
118 REAL_BODY(acos)
120 REAL_HEAD(atan)
121 REAL_BODY(atan)
123 REAL_HEAD(asinh)
124 REAL_BODY(asinh)
126 REAL_HEAD(acosh)
127 REAL_BODY(acosh)
129 REAL_HEAD(atanh)
130 REAL_BODY(atanh)
132 REAL_HEAD(sin)
133 REAL_BODY(sin)
134 COMPLEX_HEAD(sin)
135 COMPLEX_BODY(sin)
136 DCOMPLEX_HEAD(sin)
137 DCOMPLEX_BODY(sin)
139 REAL_HEAD(cos)
140 REAL_BODY(cos)
141 COMPLEX_HEAD(cos)
142 COMPLEX_BODY(cos)
143 DCOMPLEX_HEAD(cos)
144 DCOMPLEX_BODY(cos)
146 REAL_HEAD(tan)
147 REAL_BODY(tan)
149 REAL_HEAD(sinh)
150 REAL_BODY(sinh)
152 REAL_HEAD(cosh)
153 REAL_BODY(cosh)
155 REAL_HEAD(tanh)
156 REAL_BODY(tanh)
158 REAL_HEAD(aint)
159 REAL_BODY(aint)
161 REAL_HEAD(anint)
162 REAL_BODY(anint)
164 ! two argument functions
165 #define REAL2_HEAD(NAME) \
166 elemental function _gfortran_f2c_specific__/**/NAME/**/_r4 (p1, p2) result(res);
168 #define REAL2_BODY(NAME) \
169   REAL, intent (in) :: p1, p2; \
170   DOUBLE PRECISION :: res; \
171   res = NAME (p1, p2); \
172 end function
174 REAL2_HEAD(sign)
175 REAL2_BODY(sign)
177 REAL2_HEAD(dim)
178 REAL2_BODY(dim)
180 REAL2_HEAD(atan2)
181 REAL2_BODY(atan2)
183 REAL2_HEAD(mod)
184 REAL2_BODY(mod)
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