gcc/testsuite/gfortran.dg/dec_math.f90

   1 ! { dg-options "-cpp -std=gnu" }
   2 ! { dg-do run { xfail i?86-*-freebsd* } }
   3 ! { dg-skip-if "No long double libc functions" { hppa*-*-hpux* } }
   4 !
   5 ! Test extra math intrinsics formerly offered by -fdec-math,
   6 ! now included with -std=gnu or -std=legacy.
   7 !
   8
   9 module dec_math
  10
  11   implicit none
  12
  13   real(4), parameter :: pi_f = 3.14159274_4
  14   real(8), parameter :: pi_d = 3.1415926535897931_8
  15 #ifdef __GFC_REAL_10__
  16   real(10), parameter :: pi_l = 3.1415926535897932383_10
  17 #endif
  18 #ifdef __GFC_REAL_16__
  19   real(16), parameter :: pi_q = 3.1415926535897932384626433832795028_16
  20 #endif
  21
  22   real(4), parameter :: r2d_f = 180.0_4 / pi_f
  23   real(8), parameter :: r2d_d = 180.0_8 / pi_d
  24 #ifdef __GFC_REAL_10__
  25   real(10), parameter :: r2d_l = 180.0_10 / pi_l
  26 #endif
  27 #ifdef __GFC_REAL_16__
  28   real(16), parameter :: r2d_q = 180.0_16 / pi_q
  29 #endif
  30
  31 contains
  32
  33   function d2rf(x)
  34     implicit none
  35     real(4), intent(in) :: x
  36     real(4) :: d2rf
  37     d2rf = (x * pi_f) / 180.0_4
  38   endfunction
  39
  40   subroutine cmpf(x, f1, f2, tolerance, str)
  41     implicit none
  42     real(4), intent(in) :: x, f1, f2, tolerance
  43     character(len=*), intent(in) :: str
  44     if ( abs(f2 - f1) .gt. tolerance ) then
  45       write (*, '(A,A,F12.6,A,F12.6,F12.6)') str, "(", x, ")", f1, f2
  46       STOP 1
  47     endif
  48   endsubroutine
  49
  50   function d2rd(x)
  51     implicit none
  52     real(8), intent(in) :: x
  53     real(8) :: d2rd
  54     d2rd = (x * pi_d) / 180.0_8
  55   endfunction
  56
  57   subroutine cmpd(x, d1, d2, tolerance, str)
  58     implicit none
  59     real(8), intent(in) :: x, d1, d2, tolerance
  60     character(len=*), intent(in) :: str
  61     if ( dabs(d2 - d1) .gt. tolerance ) then
  62       write (*, '(A,A,F18.14,A,F18.14,F18.14)') str, "(", x, ")", d1, d2
  63       STOP 2
  64     endif
  65   endsubroutine
  66
  67 #ifdef __GFC_REAL_10__
  68   function d2rl(x)
  69     implicit none
  70     real(10), intent(in) :: x
  71     real(10) :: d2rl
  72     d2rl = (x * pi_l) / 180.0_10
  73   endfunction
  74
  75   subroutine cmpl(x, f1, f2, tolerance, str)
  76     implicit none
  77     real(10), intent(in) :: x, f1, f2, tolerance
  78     character(len=*), intent(in) :: str
  79     if ( abs(f2 - f1) .gt. tolerance ) then
  80       write (*, '(A,A,F21.17,A,F21.17,F21.17)') str, "(", x, ")", f1, f2
  81       STOP 1
  82     endif
  83   endsubroutine
  84 #endif
  85
  86 #ifdef __GFC_REAL_16__
  87   function d2rq(x)
  88     implicit none
  89     real(16), intent(in) :: x
  90     real(16) :: d2rq
  91     d2rq = (x * pi_q) / 180.0_16
  92   endfunction
  93
  94   subroutine cmpq(x, f1, f2, tolerance, str)
  95     implicit none
  96     real(16), intent(in) :: x, f1, f2, tolerance
  97     character(len=*), intent(in) :: str
  98     if ( abs(f2 - f1) .gt. tolerance ) then
  99       write (*, '(A,A,F34.30,A,F34.30,F34.30)') str, "(", x, ")", f1, f2
 100       STOP 1
 101     endif
 102   endsubroutine
 103 #endif
 104
 105 end module
 106
 107 use dec_math
 108
 109 implicit none
 110
 111 ! inputs
 112 real(4) :: f_i1, f_i2
 113 real(4), volatile :: xf
 114 real(8) :: d_i1, d_i2
 115 real(8), volatile :: xd
 116 #ifdef __GFC_REAL_10__
 117 real(10) :: l_i1, l_i2
 118 real(10), volatile :: xl
 119 #endif
 120 #ifdef __GFC_REAL_16__
 121 real(16) :: q_i1, q_i2
 122 real(16), volatile :: xq
 123 #endif
 124
 125 ! expected outputs from (oe) default (oxe) expression
 126 real(4) :: f_oe, f_oxe
 127 real(8) :: d_oe, d_oxe
 128 #ifdef __GFC_REAL_10__
 129 real(10) :: l_oe, l_oxe
 130 #endif
 131 #ifdef __GFC_REAL_16__
 132 real(16) :: q_oe, q_oxe
 133 #endif
 134
 135 ! actual outputs from (oa) default (oc) constant (ox) expression
 136 real(4) :: f_oa, f_oc, f_ox
 137 real(8) :: d_oa, d_oc, d_ox
 138 #ifdef __GFC_REAL_10__
 139 real(10) :: l_oa, l_oc, l_ox
 140 #endif
 141 #ifdef __GFC_REAL_16__
 142 real(16) :: q_oa, q_oc, q_ox
 143 #endif
 144
 145 ! tolerance of the answer: assert |exp-act| <= tol
 146 ! accept loss of ~four decimal places
 147 real(4), parameter :: f_tol  = 5e-3_4
 148 real(8), parameter :: d_tol  = 5e-10_8
 149 #ifdef __GFC_REAL_10__
 150 real(10), parameter :: l_tol = 5e-15_10
 151 #endif
 152 #ifdef __GFC_REAL_16__
 153 real(16), parameter :: q_tol = 5e-20_16
 154 #endif
 155
 156 ! volatile multiplication factors to test non-constant expressions
 157 xf = 2.0_4
 158 xd = 2.0_8
 159 #ifdef __GFC_REAL_10__
 160 xl = 2.0_10
 161 #endif
 162 #ifdef __GFC_REAL_16__
 163 xq = 2.0_16
 164 #endif
 165
 166 ! Input -- cos(pi/4)
 167 f_i1 = 0.707107_4
 168 d_i1 = 0.707106781186548_8
 169 #ifdef __GFC_REAL_10__
 170 l_i1 = 0.707106781186547573_10
 171 #endif
 172 #ifdef __GFC_REAL_16__
 173 q_i1 = 0.707106781186547572737310929369414_16
 174 #endif
 175
 176 ! Expected -- pi/4
 177 f_oe =  r2d_f * acos (f_i1)
 178 f_oxe = r2d_f * acos (xf * f_i1)
 179 d_oe =  r2d_d * acos (d_i1)
 180 d_oxe = r2d_d * acos (xd * d_i1)
 181 #ifdef __GFC_REAL_10__
 182 l_oe =  r2d_l * acos (l_i1)
 183 l_oxe = r2d_l * acos (xl * l_i1)
 184 #endif
 185 #ifdef __GFC_REAL_16__
 186 q_oe =  r2d_q * acos (q_i1)
 187 q_oxe = r2d_q * acos (xq * q_i1)
 188 #endif
 189
 190 ! Actual
 191 f_oa =    acosd (f_i1)
 192 f_oc =    acosd (0.707107_4)
 193 f_ox = acosd (xf * f_i1)
 194 d_oa =     acosd (d_i1)
 195 d_oc =     acosd (0.707106781186548_8)
 196 d_ox = acosd (xd * 0.707106781186548_8)
 197 #ifdef __GFC_REAL_10__
 198 l_oa =    acosd (l_i1)
 199 l_oc =    acosd (0.707106781186547573_10)
 200 l_ox = acosd (xl * l_i1)
 201 #endif
 202 #ifdef __GFC_REAL_16__
 203 q_oa =    acosd (q_i1)
 204 q_oc =    acosd (0.707106781186547572737310929369414_16)
 205 q_ox = acosd (xq * 0.707106781186547572737310929369414_16)
 206 #endif
 207
 208 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) facosd")
 209 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) facosd")
 210 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) facosd")
 211 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) dacosd")
 212 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) dacosd")
 213 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) dacosd")
 214 #ifdef __GFC_REAL_10__
 215 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) lacosd")
 216 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) lacosd")
 217 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) lacosd")
 218 #endif
 219 #ifdef __GFC_REAL_16__
 220 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qacosd")
 221 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qacosd")
 222 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qacosd")
 223 #endif
 224
 225 ! Input
 226 f_i1 = 60.0_4
 227 d_i1 = 60.0_8
 228 #ifdef __GFC_REAL_10__
 229 l_i1 = 60.0_10
 230 #endif
 231 #ifdef __GFC_REAL_16__
 232 q_i1 = 60.0_16
 233 #endif
 234
 235 ! Expected
 236 f_oe  = cos (d2rf(f_i1))
 237 f_oxe = cos (d2rf(xf * f_i1))
 238 d_oe  = cos (d2rd(d_i1))
 239 d_oxe = cos (d2rd(xd * d_i1))
 240 #ifdef __GFC_REAL_10__
 241 l_oe  = cos (d2rl(l_i1))
 242 l_oxe = cos (d2rl(xl * l_i1))
 243 #endif
 244 #ifdef __GFC_REAL_16__
 245 q_oe  = cos (d2rq(q_i1))
 246 q_oxe = cos (d2rq(xq * q_i1))
 247 #endif
 248
 249 ! Actual
 250 f_oa = cosd (f_i1)
 251 f_oc = cosd (60.0_4)
 252 f_ox = cosd (xf * f_i1)
 253 d_oa = cosd (d_i1)
 254 d_oc = cosd (60.0_8)
 255 d_ox = cosd (xd * d_i1)
 256 #ifdef __GFC_REAL_10__
 257 l_oa = cosd (l_i1)
 258 l_oc = cosd (60.0_10)
 259 l_ox = cosd (xl * l_i1)
 260 #endif
 261 #ifdef __GFC_REAL_16__
 262 q_oa = cosd (q_i1)
 263 q_oc = cosd (60.0_16)
 264 q_ox = cosd (xq * q_i1)
 265 #endif
 266
 267 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) fcosd")
 268 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) fcosd")
 269 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) fcosd")
 270 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) dcosd")
 271 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) dcosd")
 272 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) cosd")
 273 #ifdef __GFC_REAL_10__
 274 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) lcosd")
 275 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) lcosd")
 276 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) lcosd")
 277 #endif
 278 #ifdef __GFC_REAL_16__
 279 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qcosd")
 280 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qcosd")
 281 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qcosd")
 282 #endif
 283
 284 ! Input -- sin(pi/4)
 285 f_i1 = 0.707107_4
 286 d_i1 = 0.707106781186548_8
 287 #ifdef __GFC_REAL_10__
 288 l_i1 = 0.707106781186547573_10
 289 #endif
 290 #ifdef __GFC_REAL_16__
 291 q_i1 = 0.707106781186547572737310929369414_16
 292 #endif
 293
 294 ! Expected -- pi/4
 295 f_oe  = r2d_f * asin (f_i1)
 296 f_oxe = r2d_f * asin (xf * f_i1)
 297 d_oe  = r2d_d * asin (d_i1)
 298 d_oxe = r2d_d * asin (xd * d_i1)
 299 #ifdef __GFC_REAL_10__
 300 l_oe  = r2d_l * asin (l_i1)
 301 l_oxe = r2d_l * asin (xl * l_i1)
 302 #endif
 303 #ifdef __GFC_REAL_16__
 304 q_oe  = r2d_q * asin (q_i1)
 305 q_oxe = r2d_q * asin (xq * q_i1)
 306 #endif
 307
 308 ! Actual
 309 f_oa = asind (f_i1)
 310 f_oc = asind (0.707107_4)
 311 f_ox = asind (xf * f_i1)
 312 d_oa = asind (d_i1)
 313 d_oc = asind (0.707106781186548_8)
 314 d_ox = asind (xd * d_i1)
 315 #ifdef __GFC_REAL_10__
 316 l_oa = asind (l_i1)
 317 l_oc = asind (0.707106781186547573_10)
 318 l_ox = asind (xl * l_i1)
 319 #endif
 320 #ifdef __GFC_REAL_16__
 321 q_oa = asind (q_i1)
 322 q_oc = asind (0.707106781186547572737310929369414_16)
 323 q_ox = asind (xq * q_i1)
 324 #endif
 325
 326 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) fasind")
 327 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) fasind")
 328 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) fasind")
 329 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) dasind")
 330 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) dasind")
 331 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) asind")
 332 #ifdef __GFC_REAL_10__
 333 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) lasind")
 334 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) lasind")
 335 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) lasind")
 336 #endif
 337 #ifdef __GFC_REAL_16__
 338 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qasind")
 339 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qasind")
 340 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qasind")
 341 #endif
 342
 343 ! Input
 344 f_i1 = 60.0_4
 345 d_i1 = 60.0_8
 346 #ifdef __GFC_REAL_10__
 347 l_i1 = 60.0_10
 348 #endif
 349 #ifdef __GFC_REAL_16__
 350 q_i1 = 60.0_16
 351 #endif
 352
 353 ! Expected
 354 f_oe  = sin (d2rf(f_i1))
 355 f_oxe = sin (d2rf(xf * f_i1))
 356 d_oe  = sin (d2rd(d_i1))
 357 d_oxe = sin (d2rd(xd * d_i1))
 358 #ifdef __GFC_REAL_10__
 359 l_oe  = sin (d2rl(l_i1))
 360 l_oxe = sin (d2rl(xl * l_i1))
 361 #endif
 362 #ifdef __GFC_REAL_16__
 363 q_oe  = sin (d2rq(q_i1))
 364 q_oxe = sin (d2rq(xq * q_i1))
 365 #endif
 366
 367 ! Actual
 368 f_oa = sind (f_i1)
 369 f_oc = sind (60.0_4)
 370 f_ox = sind (xf * f_i1)
 371 d_oa = sind (d_i1)
 372 d_oc = sind (60.0_8)
 373 d_ox = sind (xd * d_i1)
 374 #ifdef __GFC_REAL_10__
 375 l_oa = sind (l_i1)
 376 l_oc = sind (60.0_10)
 377 l_ox = sind (xl * l_i1)
 378 #endif
 379 #ifdef __GFC_REAL_16__
 380 q_oa = sind (q_i1)
 381 q_oc = sind (60.0_16)
 382 q_ox = sind (xq * q_i1)
 383 #endif
 384
 385 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) fsind")
 386 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) fsind")
 387 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) fsind")
 388 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) dsind")
 389 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) dsind")
 390 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) sind")
 391 #ifdef __GFC_REAL_10__
 392 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) lsind")
 393 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) lsind")
 394 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) lsind")
 395 #endif
 396 #ifdef __GFC_REAL_16__
 397 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qsind")
 398 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qsind")
 399 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qsind")
 400 #endif
 401
 402 ! Input
 403 f_i1 = 1.0_4
 404 f_i2 = 2.0_4
 405 d_i1 = 1.0_8
 406 d_i2 = 2.0_8
 407 #ifdef __GFC_REAL_10__
 408 l_i1 = 1.0_10
 409 l_i2 = 2.0_10
 410 #endif
 411 #ifdef __GFC_REAL_16__
 412 q_i1 = 1.0_16
 413 q_i2 = 2.0_16
 414 #endif
 415
 416 ! Expected
 417 f_oe  = r2d_f * atan2 (f_i1, f_i2)
 418 f_oxe = r2d_f * atan2 (xf * f_i1, f_i2)
 419 d_oe  = r2d_d * atan2 (d_i1, d_i2)
 420 d_oxe = r2d_d * atan2 (xd * d_i1, d_i2)
 421 #ifdef __GFC_REAL_10__
 422 l_oe  = r2d_l * atan2 (l_i1, l_i2)
 423 l_oxe = r2d_l * atan2 (xl * l_i1, l_i2)
 424 #endif
 425 #ifdef __GFC_REAL_16__
 426 q_oe  = r2d_q * atan2 (q_i1, q_i2)
 427 q_oxe = r2d_q * atan2 (xq * q_i1, q_i2)
 428 #endif
 429
 430 ! Actual
 431 f_oa = atan2d (f_i1, f_i2)
 432 f_oc = atan2d (1.0_4, 2.0_4)
 433 f_ox = atan2d (xf * f_i1, f_i2)
 434 d_oa = atan2d (d_i1, d_i2)
 435 d_oc = atan2d (1.0_8, 2.0_8)
 436 d_ox = atan2d (xd * d_i1, d_i2)
 437 #ifdef __GFC_REAL_10__
 438 l_oa = atan2d (l_i1, l_i2)
 439 l_oc = atan2d (1.0_10, 2.0_10)
 440 l_ox = atan2d (xl * l_i1, l_i2)
 441 #endif
 442 #ifdef __GFC_REAL_16__
 443 q_oa = atan2d (q_i1, q_i2)
 444 q_oc = atan2d (1.0_16, 2.0_16)
 445 q_ox = atan2d (xq * q_i1, q_i2)
 446 #endif
 447
 448 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) fatan2d")
 449 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) fatan2d")
 450 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) fatan2d")
 451 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) datan2d")
 452 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) datan2d")
 453 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) atan2d")
 454 #ifdef __GFC_REAL_10__
 455 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) latan2d")
 456 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) latan2d")
 457 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) latan2d")
 458 #endif
 459 #ifdef __GFC_REAL_16__
 460 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qatan2d")
 461 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qatan2d")
 462 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qatan2d")
 463 #endif
 464
 465 ! Input
 466 f_i1 = 1.55741_4
 467 d_i1 = 1.5574077246549_8
 468 #ifdef __GFC_REAL_10__
 469 l_i1 = 1.55740772465490229_10
 470 #endif
 471 #ifdef __GFC_REAL_16__
 472 q_i1 = 1.55740772465490229237161656783428_16
 473 #endif
 474
 475 ! Expected
 476 f_oe  = r2d_f * atan (f_i1)
 477 f_oxe = r2d_f * atan (xf * f_i1)
 478 d_oe  = r2d_d * atan (d_i1)
 479 d_oxe = r2d_d * atan (xd * d_i1)
 480 #ifdef __GFC_REAL_10__
 481 l_oe  = r2d_l * atan (l_i1)
 482 l_oxe = r2d_l * atan (xl * l_i1)
 483 #endif
 484 #ifdef __GFC_REAL_16__
 485 q_oe  = r2d_q * atan (q_i1)
 486 q_oxe = r2d_q * atan (xq * q_i1)
 487 #endif
 488
 489 ! Actual
 490 f_oa = atand (f_i1)
 491 f_oc = atand (1.55741_4)
 492 f_ox = atand (xf * f_i1)
 493 d_oa = atand (d_i1)
 494 d_oc = atand (1.5574077246549_8)
 495 d_ox = atand (xd * d_i1)
 496 #ifdef __GFC_REAL_10__
 497 l_oa = atand (l_i1)
 498 l_oc = atand (1.55740772465490229_10)
 499 l_ox = atand (xl * l_i1)
 500 #endif
 501 #ifdef __GFC_REAL_16__
 502 q_oa = atand (q_i1)
 503 q_oc = atand (1.55740772465490229237161656783428_16)
 504 q_ox = atand (xq * q_i1)
 505 #endif
 506
 507 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) fatand")
 508 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) fatand")
 509 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) fatand")
 510 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) datand")
 511 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) datand")
 512 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) atand")
 513 #ifdef __GFC_REAL_10__
 514 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) latand")
 515 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) latand")
 516 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) latand")
 517 #endif
 518 #ifdef __GFC_REAL_16__
 519 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qatand")
 520 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qatand")
 521 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qatand")
 522 #endif
 523
 524 ! Input
 525 f_i1 = 34.3775_4
 526 d_i1 = 34.3774677078494_8
 527 #ifdef __GFC_REAL_10__
 528 l_i1 = 34.3774677078493909_10
 529 #endif
 530 #ifdef __GFC_REAL_16__
 531 q_i1 = 34.3774677078493908766176900826395_16
 532 #endif
 533
 534 ! Expected
 535 f_oe  = 1.0_4/tan (f_i1)
 536 f_oxe = 1.0_4/tan (xf * f_i1)
 537 d_oe  = 1.0_8/tan (d_i1)
 538 d_oxe = 1.0_8/tan (xd * d_i1)
 539 #ifdef __GFC_REAL_10__
 540 l_oe  = 1.0_10/tan (l_i1)
 541 l_oxe = 1.0_10/tan (xl * l_i1)
 542 #endif
 543 #ifdef __GFC_REAL_16__
 544 q_oe  = 1.0_16/tan (q_i1)
 545 q_oxe = 1.0_16/tan (xq * q_i1)
 546 #endif
 547
 548 ! Actual
 549 f_oa = cotan (f_i1)
 550 f_oc = cotan (34.3775_4)
 551 f_ox = cotan (xf * f_i1)
 552 d_oa = cotan (d_i1)
 553 d_oc = cotan (34.3774677078494_8)
 554 d_ox = cotan (xd * d_i1)
 555 #ifdef __GFC_REAL_10__
 556 l_oa = cotan (l_i1)
 557 l_oc = cotan (34.3774677078493909_10)
 558 l_ox = cotan (xl * l_i1)
 559 #endif
 560 #ifdef __GFC_REAL_16__
 561 q_oa = cotan (q_i1)
 562 q_oc = cotan (34.3774677078493908766176900826395_16)
 563 q_ox = cotan (xq * q_i1)
 564 #endif
 565
 566 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) fcotan")
 567 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) fcotan")
 568 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) fcotan")
 569 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) dcotan")
 570 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) dcotan")
 571 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) cotan")
 572 #ifdef __GFC_REAL_10__
 573 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) lcotan")
 574 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) lcotan")
 575 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) lcotan")
 576 #endif
 577 #ifdef __GFC_REAL_16__
 578 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qcotan")
 579 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qcotan")
 580 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qcotan")
 581 #endif
 582
 583 ! Input
 584 f_i1 = 0.6_4
 585 d_i1 = 0.6_8
 586 #ifdef __GFC_REAL_10__
 587 l_i1 = 0.6_10
 588 #endif
 589 #ifdef __GFC_REAL_16__
 590 q_i1 = 0.6_16
 591 #endif
 592
 593 ! Expected
 594 f_oe  = cotan (d2rf(f_i1))
 595 f_oxe = cotan (d2rf(xf * f_i1))
 596 d_oe  = cotan (d2rd(d_i1))
 597 d_oxe = cotan (d2rd(xd * d_i1))
 598 #ifdef __GFC_REAL_10__
 599 l_oe  = cotan (d2rl(l_i1))
 600 l_oxe = cotan (d2rl(xl * l_i1))
 601 #endif
 602 #ifdef __GFC_REAL_16__
 603 q_oe  = cotan (d2rq(q_i1))
 604 q_oxe = cotan (d2rq(xq * q_i1))
 605 #endif
 606
 607 ! Actual
 608 f_oa = cotand (f_i1)
 609 f_oc = cotand (0.6_4)
 610 f_ox = cotand (xf * f_i1)
 611 d_oa = cotand (d_i1)
 612 d_oc = cotand (0.6_8)
 613 d_ox = cotand (xd * d_i1)
 614 #ifdef __GFC_REAL_10__
 615 l_oa = cotand (l_i1)
 616 l_oc = cotand (0.6_10)
 617 l_ox = cotand (xl * l_i1)
 618 #endif
 619 #ifdef __GFC_REAL_16__
 620 q_oa = cotand (q_i1)
 621 q_oc = cotand (0.6_16)
 622 q_ox = cotand (xq * q_i1)
 623 #endif
 624
 625 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) fcotand")
 626 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) fcotand")
 627 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) fcotand")
 628 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) dcotand")
 629 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) dcotand")
 630 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) cotand")
 631 #ifdef __GFC_REAL_10__
 632 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) lcotand")
 633 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) lcotand")
 634 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) lcotand")
 635 #endif
 636 #ifdef __GFC_REAL_16__
 637 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qcotand")
 638 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qcotand")
 639 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qcotand")
 640 #endif
 641
 642 ! Input
 643 f_i1 = 60.0_4
 644 d_i1 = 60.0_8
 645 #ifdef __GFC_REAL_10__
 646 l_i1 = 60.0_10
 647 #endif
 648 #ifdef __GFC_REAL_16__
 649 q_i1 = 60.0_16
 650 #endif
 651
 652 ! Expected
 653 f_oe  = tan (d2rf(f_i1))
 654 f_oxe = tan (d2rf(xf * f_i1))
 655 d_oe  = tan (d2rd(d_i1))
 656 d_oxe = tan (d2rd(xd * d_i1))
 657 #ifdef __GFC_REAL_10__
 658 l_oe  = tan (d2rl(l_i1))
 659 l_oxe = tan (d2rl(xl * l_i1))
 660 #endif
 661 #ifdef __GFC_REAL_16__
 662 q_oe  = tan (d2rq(q_i1))
 663 q_oxe = tan (d2rq(xq * q_i1))
 664 #endif
 665
 666 ! Actual
 667 f_oa = tand (f_i1)
 668 f_oc = tand (60.0_4)
 669 f_ox = tand (xf * f_i1)
 670 d_oa = tand (d_i1)
 671 d_oc = tand (60.0_8)
 672 d_ox = tand (xd * d_i1)
 673 #ifdef __GFC_REAL_10__
 674 l_oa = tand (l_i1)
 675 l_oc = tand (60.0_10)
 676 l_ox = tand (xl * l_i1)
 677 #endif
 678 #ifdef __GFC_REAL_16__
 679 q_oa = tand (q_i1)
 680 q_oc = tand (60.0_16)
 681 q_ox = tand (xq * q_i1)
 682 #endif
 683
 684 call cmpf(f_i1, f_oe,  f_oa, f_tol, "( ) ftand")
 685 call cmpf(f_i1, f_oe,  f_oc, f_tol, "(c) ftand")
 686 call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) ftand")
 687 call cmpd(d_i1, d_oe,  d_oa, d_tol, "( ) dtand")
 688 call cmpd(d_i1, d_oe,  d_oc, d_tol, "(c) dtand")
 689 call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) dtand")
 690 #ifdef __GFC_REAL_10__
 691 call cmpl(l_i1, l_oe,  l_oa, l_tol, "( ) ltand")
 692 call cmpl(l_i1, l_oe,  l_oc, l_tol, "(c) ltand")
 693 call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) ltand")
 694 #endif
 695 #ifdef __GFC_REAL_16__
 696 call cmpq(q_i1, q_oe,  q_oa, q_tol, "( ) qtand")
 697 call cmpq(q_i1, q_oe,  q_oc, q_tol, "(c) qtand")
 698 call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qtand")
 699 #endif
 700
 701 end