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