| 1 |
149 |
jeremybenn |
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(complex(kind=8))')
|
| 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(complex(kind=8))')
|
| 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(complex(kind=8))')
|
| 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(complex(kind=8))')
|
| 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(complex(kind=8))')
|
| 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 |
|
|
complex(kind=8) 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
|
