3 c Test double complex intrinsics CD*.
4 c These functions are VAX extensions
6 c David Billinghurst <David.Billinghurst@riotinto.com>
11 intrinsic cdabs, cdcos, cdexp, cdlog, cdsin, cdsqrt
15 c CDABS - Absolute value
18 call c_d(CDABS(z),x,'CDABS(double complex)')
19 call p_d_z(CDABS,z,x,'CDABS')
23 a = (-1.52763825012d0,-0.165844401919)
24 call c_z(CDCOS(z),a,'CDCOS(double complex)')
25 call p_z_z(CDCOS,z,a,'CDCOS')
29 a = (10.8522619142d0,16.9013965352)
30 call c_z(CDEXP(z),a,'CDEXP(double complex)')
31 call p_z_z(CDEXP,z,a,'CDEXP')
33 c CDLOG - Natural logarithm
34 call c_z(CDLOG(a),z,'CDLOG(double complex)')
35 call p_z_z(CDLOG,a,z,'CDLOG')
39 a = (0.217759551622d0,-1.1634403637d0)
40 call c_z(CDSIN(z),a,'CDSIN(double complex)')
41 call p_z_z(CDSIN,z,a,'CDSIN')
43 c CDSQRT - Square root
45 a = sqrt(2.0d0)*(1.0d0,-1.0d0)
46 call c_z(CDSQRT(z),a,'CDSQRT(double complex)')
47 call p_z_z(CDSQRT,z,a,'CDSQRT')
49 if ( fail ) call abort()
52 subroutine failure(label)
53 c Report failure and set flag
57 write(6,'(a,a,a)') 'Test ',label,' FAILED'
61 subroutine c_z(a,b,label)
62 c Check if DOUBLE COMPLEX a equals b, and fail otherwise
65 if ( abs(a-b) .gt. 1.0e-5 ) then
67 write(6,*) 'Got ',a,' expected ', b
71 subroutine c_d(a,b,label)
72 c Check if DOUBLE PRECISION a equals b, and fail otherwise
75 if ( abs(a-b) .gt. 1.0d-5 ) then
77 write(6,*) 'Got ',a,' expected ', b
81 subroutine p_z_z(f,x,a,label)
82 c Check if DOUBLE COMPLEX f(x) equals a for DOUBLE COMPLEX x
85 call c_z(f(x),a,label)
88 subroutine p_d_z(f,x,a,label)
89 c Check if DOUBLE PRECISION f(x) equals a for DOUBLE COMPLEX x
93 call c_d(f(x),a,label)