libgfortran/intrinsics/f2c_specifics.F90

   1 !   Copyright (C) 2002-2018 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