gcc/testsuite/gfortran.dg/g77/f90-intrinsic-mathematical.f

   1 c { dg-do run }
   2 c  f90-intrinsic-mathematical.f
   3 c
   4 c Test Fortran 90 intrinsic mathematical functions - Section 13.10.3 and
   5 c 13.13
   6 c     David Billinghurst <David.Billinghurst@riotinto.com>
   7 c
   8 c Notes:
   9 c  * g77 does not fully comply with F90.  Noncompliances noted in comments.
  10 c  * Section 13.12: Specific names for intrinsic functions tested in
  11 c intrinsic77.f
  12
  13       logical fail
  14       common /flags/ fail
  15       fail = .false.
  16
  17 c     ACOS - Section 13.13.3
  18       call c_r(ACOS(0.54030231),1.0,'ACOS(real)')
  19       call c_d(ACOS(0.54030231d0),1.d0,'ACOS(double)')
  20
  21 c     ASIN - Section 13.13.12
  22       call c_r(ASIN(0.84147098),1.0,'ASIN(real)')
  23       call c_d(ASIN(0.84147098d0),1.d0,'ASIN(double)')
  24
  25 c     ATAN - Section 13.13.14
  26       call c_r(ATAN(1.5574077),1.0,'ATAN(real)')
  27       call c_d(ATAN(1.5574077d0),1.d0,'ATAN(double)')
  28
  29 c     ATAN2 - Section 13.13.15
  30       call c_r(ATAN2(1.5574077,1.),1.0,'ATAN2(real)')
  31       call c_d(ATAN2(1.5574077d0,1.d0),1.d0,'ATAN2(double)')
  32
  33 c     COS - Section 13.13.22
  34       call c_r(COS(1.0),0.54030231,'COS(real)')
  35       call c_d(COS(1.d0),0.54030231d0,'COS(double)')
  36       call c_c(COS((1.,0.)),(0.54030231,0.),'COS(complex)')
  37       call c_z(COS((1.d0,0.d0)),(0.54030231d0,0.d0),
  38      $     'COS(double complex)')
  39
  40 c     COSH - Section 13.13.23
  41       call c_r(COSH(1.0),1.5430806,'COSH(real)')
  42       call c_d(COSH(1.d0),1.5430806d0,'COSH(double)')
  43
  44 c     EXP - Section 13.13.34
  45       call c_r(EXP(1.0),2.7182818,'EXP(real)')
  46       call c_d(EXP(1.d0),2.7182818d0,'EXP(double)')
  47       call c_c(EXP((1.,0.)),(2.7182818,0.),'EXP(complex)')
  48       call c_z(EXP((1.d0,0.d0)),(2.7182818d0,0.d0),
  49      $     'EXP(double complex)')
  50
  51 c     LOG - Section 13.13.59
  52       call c_r(LOG(10.0),2.3025851,'LOG(real)')
  53       call c_d(LOG(10.d0),2.3025851d0,'LOG(double)')
  54       call c_c(LOG((10.,0.)),(2.3025851,0.),'LOG(complex)')
  55       call c_z(LOG((10.d0,0.)),(2.3025851d0,0.d0),
  56      $     'LOG(double complex)')
  57
  58 c     LOG10 - Section 13.13.60
  59       call c_r(LOG10(10.0),1.0,'LOG10(real)')
  60       call c_d(LOG10(10.d0),1.d0,'LOG10(double)')
  61
  62 c     SIN - Section 13.13.97
  63       call c_r(SIN(1.0),0.84147098,'SIN(real)')
  64       call c_d(SIN(1.d0),0.84147098d0,'SIN(double)')
  65       call c_c(SIN((1.,0.)),(0.84147098,0.),'SIN(complex)')
  66       call c_z(SIN((1.d0,0.d0)),(0.84147098d0,0.d0),
  67      $     'SIN(double complex)')
  68
  69 c     SINH - Section 13.13.98
  70       call c_r(SINH(1.0),1.175201,'SINH(real)')
  71       call c_d(SINH(1.d0),1.175201d0,'SINH(double)')
  72
  73 c     SQRT - Section 13.13.102
  74       call c_r(SQRT(4.0),2.0,'SQRT(real)')
  75       call c_d(SQRT(4.d0),2.d0,'SQRT(double)')
  76       call c_c(SQRT((4.,0.)),(2.,0.),'SQRT(complex)')
  77       call c_z(SQRT((4.d0,0.)),(2.d0,0.),
  78      $     'SQRT(double complex)')
  79
  80 c     TAN - Section 13.13.105
  81       call c_r(TAN(1.0),1.5574077,'TAN(real)')
  82       call c_d(TAN(1.d0),1.5574077d0,'TAN(double)')
  83
  84 c     TANH - Section 13.13.106
  85       call c_r(TANH(1.0),0.76159416,'TANH(real)')
  86       call c_d(TANH(1.d0),0.76159416d0,'TANH(double)')
  87
  88       if ( fail ) call abort()
  89       end
  90
  91       subroutine failure(label)
  92 c     Report failure and set flag
  93       character*(*) label
  94       logical fail
  95       common /flags/ fail
  96       write(6,'(a,a,a)') 'Test ',label,' FAILED'
  97       fail = .true.
  98       end
  99
 100       subroutine c_r(a,b,label)
 101 c     Check if REAL a equals b, and fail otherwise
 102       real a, b
 103       character*(*) label
 104       if ( abs(a-b) .gt. 1.0e-5 ) then
 105          call failure(label)
 106          write(6,*) 'Got ',a,' expected ', b
 107       end if
 108       end
 109
 110       subroutine c_d(a,b,label)
 111 c     Check if DOUBLE PRECISION a equals b, and fail otherwise
 112       double precision a, b
 113       character*(*) label
 114       if ( abs(a-b) .gt. 1.0d-5 ) then
 115          call failure(label)
 116          write(6,*) 'Got ',a,' expected ', b
 117       end if
 118       end
 119
 120       subroutine c_c(a,b,label)
 121 c     Check if COMPLEX a equals b, and fail otherwise
 122       complex a, b
 123       character*(*) label
 124       if ( abs(a-b) .gt. 1.0e-5 ) then
 125          call failure(label)
 126          write(6,*) 'Got ',a,' expected ', b
 127       end if
 128       end
 129
 130       subroutine c_z(a,b,label)
 131 c     Check if COMPLEX a equals b, and fail otherwise
 132       double complex a, b
 133       character*(*) label
 134       if ( abs(a-b) .gt. 1.0d-5 ) then
 135          call failure(label)
 136          write(6,*) 'Got ',a,' expected ', b
 137       end if
 138       end