1! program to time the various routines
2subroutine f_main
3
4  use qdmodule
5  implicit none
6  integer*4 old_cw
7  double precision t
8  double precision second
9  double precision time_thresh
10  parameter (time_thresh = 0.5d0)
11  type (qd_real) a, b, c, d
12  integer n, i, k
13
14  call f_fpu_fix_start (old_cw)
15
16  write (6, *) 'Timing addition / subtraction ...'
17  n = 512
18  do k = 1, 25
19    n = n * 2
20    a = qdpi()
21    b = sqrt(a)
22    c = sqrt(b)
23    d = sqrt(c)
24    t = second()
25    do i = 1, n
26      a = b + c
27      b = a - d
28      a = b + c
29      b = a - d
30    enddo
31    t = second() - t
32    if (t .ge. time_thresh) exit
33  enddo
34  n = n * 4
35  write (6, *) n, ' operations in ', t, ' seconds.'
36  write (6, *) t/n*1.0d6, ' usec'
37  call qdwrite(6, a)
38
39  write (6, *) 'Timing multiplication ...'
40  n = 512
41  do k = 1, 25
42    n = n * 2
43    a = 1.0d0 + qdpi() * 1.0d-7
44    b = a + 1.0d-7
45    c = b + 1.0d-8
46    d = c + 1.0d-9
47    t = second()
48    do i = 1, n
49      a = b * c
50      b = a * d
51      a = b * c
52      b = a * d
53    enddo
54    t = second() - t
55    if (t .ge. time_thresh) exit
56  enddo
57  n = n * 4
58  write (6, *) n, ' operations in ', t, ' seconds.'
59  write (6, *) t/n*1.0d6, ' usec'
60  call qdwrite(6, a)
61
62  write (6, *) 'Timing division ...'
63  n = 512
64  do k = 1, 25
65    n = n * 2
66    a = 1.0d0 + qdpi()
67    b = 2.0d0 + qdpi()
68    c = 1.0d0 + 1.0d-8
69    d = 1.0d0 + 1.0d-9
70    t = second()
71    do i = 1, n
72      a = b / c
73      b = a / d
74      a = b / c
75      b = a / d
76    enddo
77    t = second() - t
78    if (t .ge. time_thresh) exit
79  enddo
80  n = n * 4
81  write (6, *) n, ' operations in ', t, ' seconds.'
82  write (6, *) t/n*1.0d6, ' usec'
83  call qdwrite(6, a)
84
85  write (6, *) 'Timing square root ...'
86  n = 512
87  do k = 1, 25
88    n = n * 2
89    a = 0.0d0
90    b = 2.0d0 + qdpi()
91    t = second()
92    do i = 1, n
93      a = sqrt(a + b)
94    enddo
95    t = second() - t
96    if (t .ge. time_thresh) exit
97  enddo
98  write (6, *) n, ' operations in ', t, ' seconds.'
99  write (6, *) t/n*1.0d6, ' usec'
100  call qdwrite(6, a)
101
102  write (6, *) 'Timing sin ...'
103  n = 512
104  do k = 1, 25
105    n = n * 2
106    a = 0.0d0
107    c = 1.7d0 * qdreal(1.0d0) / dble(n)
108    d = 2.45d0 * qdpi() / dble(n + 3)
109    t = second()
110    do i = 1, n
111      a = a + sin(c)
112      c = c + d
113    enddo
114    t = second() - t
115    if (t .ge. time_thresh) exit
116  enddo
117  write (6, *) n, ' operations in ', t, ' seconds.'
118  write (6, *) t/n*1.0d6, ' usec'
119  call qdwrite(6, a)
120
121  write (6, *) 'Timing log ...'
122  n = 512
123  do k = 1, 25
124    n = n * 2
125    a = 0.0d0
126    c = exp(qdreal(-50.1d0));
127    d = exp(qdreal(100.2d0) / dble(n))
128    t = second()
129    do i = 1, n
130      a = a + log(c)
131      c = c * d
132    enddo
133    t = second() - t
134    if (t .ge. time_thresh) exit
135  enddo
136  write (6, *) n, ' operations in ', t, ' seconds.'
137  write (6, *) t/n*1.0d6, ' usec'
138  call qdwrite(6, a)
139
140end
141
142