@@ -39,18 +39,15 @@ subroutine fptest()
39
39
call parser% parse(func, var, .false. ) ! parse and bytecompile function string
40
40
if (parser% error()) then
41
41
call parser% print_errors(output_unit)
42
- else
42
+ error stop
43
+ end if
43
44
44
- write (* ,* )' ==> bytecode evaluation:'
45
- call parser% evaluate(val,res) ! interprete bytecode representation of function
46
- if (parser% error()) then
47
- call parser% print_errors(output_unit)
48
- else
49
- write (* ,* ) func,' =' ,res
50
- write (* ,* )' ==> direct evaluation:'
51
- x = val(1 )
52
- write (* ,* )' -x=' ,- x
53
- end if
45
+ call parser% evaluate(val,res) ! interprete bytecode representation of function
46
+ if (parser% error()) then
47
+ call parser% print_errors(output_unit)
48
+ else
49
+ x = val(1 )
50
+ call compare(' -x' , - x, res)
54
51
end if
55
52
56
53
end subroutine fptest
@@ -87,27 +84,22 @@ subroutine fptest2()
87
84
call parser% parse(func, var, .false. ) ! parse and bytecompile function string
88
85
if (parser% error()) then
89
86
call parser% print_errors(output_unit)
90
- else
87
+ error stop
88
+ end if
91
89
92
- write (* ,* )' ==> bytecode evaluation:'
93
- call parser% evaluate(val,res) ! interprete bytecode representation of function
94
- if (parser% error()) then
95
- call parser% print_errors(output_unit)
96
- else
97
- do i= 1 ,nfunc
98
- write (* ,* ) func(i),' =' ,res(i)
99
- end do
100
- write (* ,* )' ==> direct evaluation:'
101
- a0 = val(1 )
102
- b0 = val(2 )
103
- a1 = val(3 )
104
- b1 = val(4 )
105
- a3 = val(5 )
106
- b3 = val(6 )
107
- write (* ,* )' res=' ,a0* b0
108
- write (* ,* )' res=' ,a1/ b1
109
- write (* ,* )' res=' ,a3** b3
110
- end if
90
+ call parser% evaluate(val,res) ! interprete bytecode representation of function
91
+ if (parser% error()) then
92
+ call parser% print_errors(output_unit)
93
+ else
94
+ a0 = val(1 )
95
+ b0 = val(2 )
96
+ a1 = val(3 )
97
+ b1 = val(4 )
98
+ a3 = val(5 )
99
+ b3 = val(6 )
100
+ call compare(' a0*b0' , a0* b0, res(1 ))
101
+ call compare(' a1/b1' , a1/ b1, res(2 ))
102
+ call compare(' a3**b3' , a3** b3, res(3 ))
111
103
end if
112
104
113
105
end subroutine fptest2
@@ -140,24 +132,19 @@ subroutine fptest3()
140
132
call parser% parse(func, var, .false. ) ! parse and bytecompile function string
141
133
if (parser% error()) then
142
134
call parser% print_errors(output_unit)
143
- else
135
+ error stop
136
+ end if
144
137
145
- write (* ,* )' ==> bytecode evaluation:'
146
- call parser% evaluate(val,res) ! interprete bytecode representation of function
147
- if (parser% error()) then
148
- call parser% print_errors(output_unit)
149
- else
150
- do i= 1 ,nfunc
151
- write (* ,* ) func(i),' =' ,res(i)
152
- end do
153
- write (* ,* )' ==> direct evaluation:'
154
- vel = val(1 )
155
- alpha = val(2 )
156
- beta = val(3 )
157
- write (* ,* )' res=' ,vel* cos (beta)
158
- write (* ,* )' res=' ,vel* sin (beta)* cos (alpha)
159
- write (* ,* )' res=' ,vel* sin (beta)* sin (alpha)
160
- end if
138
+ call parser% evaluate(val,res) ! interprete bytecode representation of function
139
+ if (parser% error()) then
140
+ call parser% print_errors(output_unit)
141
+ else
142
+ vel = val(1 )
143
+ alpha = val(2 )
144
+ beta = val(3 )
145
+ call compare(' vel*cos(beta)' , vel* cos (beta), res(1 ))
146
+ call compare(' vel*sin(beta)*cos(alpha)' , vel* sin (beta)* cos (alpha), res(2 ))
147
+ call compare(' vel*sin(beta)*sin(alpha)' , vel* sin (beta)* sin (alpha), res(3 ))
161
148
end if
162
149
163
150
end subroutine fptest3
@@ -195,36 +182,34 @@ subroutine fptest4()
195
182
call parser% parse(func, var, .false. ) ! parse and bytecompile function string
196
183
if (parser% error()) then
197
184
call parser% print_errors(output_unit)
198
- else
199
-
200
- vel = val(1 )
201
- alpha = val(2 )
202
- beta = val(3 )
203
- call cpu_time (rt1)
204
- do n= 1 ,neval
205
- call parser% evaluate(val,res) ! interprete bytecode representation of function
206
- if (parser% error()) then
207
- call parser% print_errors(output_unit)
208
- return
209
- end if
210
- end do
211
- write (* ,* )' ==> bytecode evaluation:'
212
- write (* ,* ) ' res=' ,res
213
- call cpu_time (rt2)
214
- do n= 1 ,neval
215
- res(1 ) = vel* cos (beta)
216
- res(2 ) = vel* sin (beta)* cos (alpha)
217
- res(3 ) = vel* sin (beta)* sin (alpha)
218
- end do
219
- write (* ,* )' ==> direct evaluation:'
220
- write (* ,* ) ' res=' ,res
221
- call cpu_time (rt3)
222
- write (* ,* )' function evaluation:'
223
- write (* ,* )' - bytecode interpreter cpu time = ' ,rt2- rt1
224
- write (* ,* )' - machine code cpu time = ' ,rt3- rt2,' = ' ,(rt3- rt2)/ (rt2- rt1)* 100.0_wp ,' %'
185
+ error stop
186
+ end if
225
187
188
+ vel = val(1 )
189
+ alpha = val(2 )
190
+ beta = val(3 )
191
+ call cpu_time (rt1) ! -----
192
+ do n= 1 ,neval
193
+ call parser% evaluate(val,res) ! interprete bytecode representation of function
194
+ end do
195
+ call cpu_time (rt2) ! -----
196
+ if (parser% error()) then
197
+ call parser% print_errors(output_unit)
198
+ error stop
226
199
end if
227
200
201
+ call cpu_time (rt2) ! -----
202
+ do n= 1 ,neval
203
+ res(1 ) = vel* cos (beta)
204
+ res(2 ) = vel* sin (beta)* cos (alpha)
205
+ res(3 ) = vel* sin (beta)* sin (alpha)
206
+ end do
207
+ call cpu_time (rt3) ! -----
208
+
209
+ write (* ,* )' function evaluation:'
210
+ write (* ,* )' * bytecode interpreter cpu time = ' ,rt2- rt1
211
+ write (* ,* )' * machine code cpu time = ' ,rt3- rt2,' = ' ,(rt3- rt2)/ (rt2- rt1)* 100.0_wp ,' %'
212
+
228
213
end subroutine fptest4
229
214
! *******************************************************************************
230
215
@@ -253,14 +238,15 @@ subroutine fptest5()
253
238
call parser% parse(func, var, .false. ) ! parse and bytecompile function string
254
239
if (parser% error()) then
255
240
call parser% print_errors(output_unit)
241
+ error stop
242
+ end if
243
+
244
+ call parser% evaluate(val,res) ! interprete bytecode representation of function
245
+ if (parser% error()) then
246
+ call parser% print_errors(output_unit)
247
+ error stop
256
248
else
257
- write (* ,* )' ==> bytecode evaluation:'
258
- call parser% evaluate(val,res) ! interprete bytecode representation of function
259
- if (parser% error()) then
260
- call parser% print_errors(output_unit)
261
- else
262
- write (* ,* ) func,' =' ,res
263
- end if
249
+ call compare(' 1.0e0 + 5.e1' , real (1.0e0 + 5.e1 , wp), res)
264
250
end if
265
251
266
252
end subroutine fptest5
@@ -271,11 +257,12 @@ subroutine fptest6()
271
257
272
258
implicit none
273
259
274
- integer , parameter :: nfunc = 4
275
- character (len=* ), dimension (nfunc), parameter :: func = [ ' -1.0*x ' , &
276
- ' -x ' , &
277
- ' a*COS(b*x)+5 ' , &
278
- ' a*COS(b*x)+5.0' ]
260
+ integer , parameter :: nfunc = 5
261
+ character (len=* ), dimension (nfunc), parameter :: func = [ ' -1.0*x ' , &
262
+ ' -sqrt(x) ' , &
263
+ ' a*COS(b*x)+5 ' , &
264
+ ' a*COS(b*x)+5.0 ' , &
265
+ ' exp(x)-abs(x)+log(1.0)+log10(1.0)' ]
279
266
integer , parameter :: nvar = 3
280
267
character (len=* ), dimension (nvar), parameter :: var = [ ' x' , &
281
268
' a' , &
@@ -294,30 +281,49 @@ subroutine fptest6()
294
281
call parser% parse(func, var, .false. ) ! parse and bytecompile function string
295
282
if (parser% error()) then
296
283
call parser% print_errors(output_unit)
297
- else
284
+ error stop
285
+ end if
298
286
299
- write (* ,* )' ==> bytecode evaluation:'
300
- call parser% evaluate(val,res) ! interprete bytecode representation of function
301
- if (parser% error()) then
302
- call parser% print_errors(output_unit)
303
- else
304
- do i= 1 ,nfunc
305
- write (* ,* ) func(i),' =' ,res(i)
306
- end do
307
- write (* ,* )' ==> direct evaluation:'
308
- x = val(1 )
309
- a = val(2 )
310
- b = val(3 )
311
- write (* ,* )' -1.0*x =' ,- 1.0_wp * x
312
- write (* ,* )' -x =' ,- x
313
- write (* ,* )' a*cos(b*x)+5 =' ,a* cos (b* x)+ 5
314
- write (* ,* )' a*cos(b*x)+5.0=' ,a* cos (b* x)+ 5.0_wp
315
- end if
287
+ call parser% evaluate(val,res) ! interprete bytecode representation of function
288
+ if (parser% error()) then
289
+ call parser% print_errors(output_unit)
290
+ error stop
291
+ else
292
+ x = val(1 )
293
+ a = val(2 )
294
+ b = val(3 )
295
+ call compare(func(1 ), - 1.0_wp * x, res(1 ))
296
+ call compare(func(2 ), - sqrt (x), res(2 ))
297
+ call compare(func(3 ), a* cos (b* x)+ 5 , res(3 ))
298
+ call compare(func(4 ), a* cos (b* x)+ 5.0 , res(4 ))
299
+ call compare(func(5 ), exp (x)- abs (x)+ log (1.0 )+ log10 (1.0 ), res(5 ))
316
300
end if
317
301
318
302
end subroutine fptest6
319
303
! *******************************************************************************
320
304
305
+ ! *******************************************************************************
306
+ ! >
307
+ ! Compare the results from the parser to the actualy expression
308
+
309
+ subroutine compare (expression , truth , parser )
310
+
311
+ implicit none
312
+
313
+ character (len=* ),intent (in ) :: expression
314
+ real (wp),intent (in ) :: truth
315
+ real (wp),intent (in ) :: parser
316
+
317
+ if (truth == parser) then
318
+ write (* ,' (A30,A10,G0)' ) trim (expression), ' PASSED: ' , truth
319
+ else
320
+ write (* ,' (A30,A10,*(G0,1X))' ) trim (expression), ' FAILED: ' , truth , parser
321
+ error stop ' error evaluating expression'
322
+ end if
323
+
324
+ end subroutine compare
325
+ ! *******************************************************************************
326
+
321
327
! *******************************************************************************
322
328
end program tests
323
329
! *******************************************************************************
0 commit comments