gcc/testsuite/gfortran.fortran-torture/execute/math.f90

   1 ! Program to test mathematical intrinsics
   2
   3 ! This file is also 'include'd in:
   4 !   - 'libgomp/testsuite/libgomp.fortran/fortran-torture_execute_math.f90' (thus the '!$omp' directives)
   5 !   - 'libgomp/testsuite/libgomp.oacc-fortran/fortran-torture_execute_math.f90' (thus the '!$acc' directives)
   6
   7 subroutine dotest (n, val4, val8, known)
   8    implicit none
   9    real(kind=4) val4, known
  10    real(kind=8) val8
  11    integer n
  12    !$acc routine seq
  13
  14    if (abs (val4 - known) .gt. 0.001) STOP 1
  15    if (abs (real (val8, kind=4) - known) .gt. 0.001) STOP 2
  16 end subroutine
  17
  18 subroutine dotestc (n, val4, val8, known)
  19    implicit none
  20    complex(kind=4) val4, known
  21    complex(kind=8) val8
  22    integer n
  23    !$acc routine seq
  24
  25    if (abs (val4 - known) .gt. 0.001) STOP 3
  26    if (abs (cmplx (val8, kind=4) - known) .gt. 0.001) STOP 4
  27 end subroutine
  28
  29 subroutine testmath
  30    implicit none
  31    real(kind=4) r, two4, half4
  32    real(kind=8) q, two8, half8
  33    complex(kind=4) cr
  34    complex(kind=8) cq
  35    external dotest, dotestc
  36    !$acc routine seq
  37
  38    two4 = 2.0
  39    two8 = 2.0_8
  40    half4 = 0.5
  41    half8 = 0.5_8
  42    r = sin (two4)
  43    q = sin (two8)
  44    call dotest (1, r, q, 0.9093)
  45    r = cos (two4)
  46    q = cos (two8)
  47    call dotest (2, r, q, -0.4161)
  48    r = tan (two4)
  49    q = tan (two8)
  50    call dotest (3, r, q, -2.1850)
  51    r = asin (half4)
  52    q = asin (half8)
  53    call dotest (4, r, q, 0.5234)
  54    r = acos (half4)
  55    q = acos (half8)
  56    call dotest (5, r, q, 1.0472)
  57    r = atan (half4)
  58    q = atan (half8)
  59    call dotest (6, r, q, 0.4636)
  60    r = atan2 (two4, half4)
  61    q = atan2 (two8, half8)
  62    call dotest (7, r, q, 1.3258)
  63    r = exp (two4)
  64    q = exp (two8)
  65    call dotest (8, r, q, 7.3891)
  66    r = log (two4)
  67    q = log (two8)
  68    call dotest (9, r, q, 0.6931)
  69    r = log10 (two4)
  70    q = log10 (two8)
  71    call dotest (10, r, q, 0.3010)
  72    r = sinh (two4)
  73    q = sinh (two8)
  74    call dotest (11, r, q, 3.6269)
  75    r = cosh (two4)
  76    q = cosh (two8)
  77    call dotest (12, r, q, 3.7622)
  78    r = tanh (two4)
  79    q = tanh (two8)
  80    call dotest (13, r, q, 0.9640)
  81    r = sqrt (two4)
  82    q = sqrt (two8)
  83    call dotest (14, r, q, 1.4142)
  84
  85    r = atan2 (0.0, 1.0)
  86    q = atan2 (0.0_8, 1.0_8)
  87    call dotest (15, r, q, 0.0)
  88    r = atan2 (-1.0, 1.0)
  89    q = atan2 (-1.0_8, 1.0_8)
  90    call dotest (16, r, q, -0.7854)
  91    r = atan2 (0.0, -1.0)
  92    q = atan2 (0.0_8, -1.0_8)
  93    call dotest (17, r, q, 3.1416)
  94    r = atan2 (-1.0, -1.0)
  95    q = atan2 (-1.0_8, -1.0_8)
  96    call dotest (18, r, q, -2.3562)
  97    r = atan2 (1.0, 0.0)
  98    q = atan2 (1.0_8, 0.0_8)
  99    call dotest (19, r, q, 1.5708)
 100    r = atan2 (-1.0, 0.0)
 101    q = atan2 (-1.0_8, 0.0_8)
 102    call dotest (20, r, q, -1.5708)
 103
 104    cr = log ((-1.0, -1.0))
 105    cq = log ((-1.0_8, -1.0_8))
 106    call dotestc (21, cr, cq, (0.3466, -2.3562))
 107
 108 end subroutine
 109
 110 program main
 111    implicit none
 112    external testmath
 113
 114    !$acc serial
 115    !$omp target
 116    call testmath
 117    !$acc end serial
 118    !$omp end target
 119
 120 end program