← Back to branch summary

~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to src/tools/ga-4-3/ma/testf.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-02-09 20:02:41 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120209200241-jgk03qfsphal4ug2
Tags: 6.1-1
http://bugs.debian.org/632611
https://launchpad.net/bugs/791308
* New upstream release.

[ Michael Banck ]
* debian/patches/02_makefile_flags.patch: Updated.
* debian/patches/02_makefile_flags.patch: Use internal blas and lapack code.
* debian/patches/02_makefile_flags.patch: Define GCC4 for LINUX and LINUX64
  (Closes: #632611 and LP: #791308).
* debian/control (Build-Depends): Added openssh-client.
* debian/rules (USE_SCALAPACK, SCALAPACK): Removed variables (Closes:
  #654658).
* debian/rules (LIBDIR, USE_MPIF4, ARMCI_NETWORK): New variables.
* debian/TODO: New file.
* debian/control (Build-Depends): Removed libblas-dev, liblapack-dev and
  libscalapack-mpi-dev.
* debian/patches/04_show_testsuite_diff_output.patch: New patch, shows the
  diff output for failed tests.
* debian/patches/series: Adjusted.
* debian/testsuite: Optionally run all tests if "all" is passed as option.
* debian/rules: Run debian/testsuite with "all" if DEB_BUILD_OPTIONS
  contains "checkall".

[ Daniel Leidert ]
* debian/control: Used wrap-and-sort. Added Vcs-Svn and Vcs-Browser fields.
  (Priority): Moved to extra according to policy section 2.5.
  (Standards-Version): Bumped to 3.9.2.
  (Description): Fixed a typo.
* debian/watch: Added.
* debian/patches/03_hurd-i386_define_path_max.patch: Added.
  - Define MAX_PATH if not defines to fix FTBFS on hurd.
* debian/patches/series: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/tools/ga-4-3/ma/testf.F
 
1
c
 
2
c     $Id: testf.F,v 1.6 1997-02-26 20:39:23 d3h325 Exp $
 
3
c
 
4
 
 
5
c
 
6
c     Exercise the MA routines.
 
7
c
 
8
 
 
9
      program testf
 
10
 
 
11
      implicit none
 
12
 
 
13
      character char1
 
14
      character*2 char2
 
15
      character char5(5)
 
16
      integer handle1
 
17
      integer handle2
 
18
      integer handle3
 
19
      integer handle4
 
20
      integer i
 
21
      integer ihandle1
 
22
      integer index1
 
23
      integer index2
 
24
      logical value
 
25
 
 
26
#include "mafdecls.fh"
 
27
 
 
28
c     ok
 
29
      write (*,*) 'start testing MA_set_error_print ...'
 
30
      value = MA_set_error_print(.true.)
 
31
      write (*,*) 'should see an MA error message here ...'
 
32
      value = MA_pop_stack(-1)
 
33
      value = MA_set_error_print(.false.)
 
34
      if (value) then
 
35
          write (*,*) 'should not see an MA error message here ...'
 
36
          value = MA_pop_stack(-1)
 
37
      else
 
38
          write (*,*) '... failure; return value is wrong'
 
39
      endif
 
40
      write (*,*) 'stop testing MA_set_error_print'
 
41
      write (*,*) ' '
 
42
 
 
43
      value = MA_set_error_print(.true.)
 
44
 
 
45
c     ok
 
46
      write (*,*) 'should be 9 values ...'
 
47
      write (*,*) '1. MA_sizeof(MT_BYTE, 1, MT_BYTE) = ',
 
48
     $    MA_sizeof(MT_BYTE, 1, MT_BYTE)
 
49
      write (*,*) '2. MA_sizeof(MT_INT, 1, MT_BYTE) = ',
 
50
     $    MA_sizeof(MT_INT, 1, MT_BYTE)
 
51
      write (*,*) '3. MA_sizeof(MT_LOG, 1, MT_BYTE) = ',
 
52
     $    MA_sizeof(MT_LOG, 1, MT_BYTE)
 
53
      write (*,*) '4. MA_sizeof(MT_REAL, 1, MT_BYTE) = ',
 
54
     $    MA_sizeof(MT_REAL, 1, MT_BYTE)
 
55
      write (*,*) '5. MA_sizeof(MT_DBL, 1, MT_BYTE) = ',
 
56
     $    MA_sizeof(MT_DBL, 1, MT_BYTE)
 
57
      write (*,*) '6. MA_sizeof(MT_SCPL, 1, MT_BYTE) = ',
 
58
     $    MA_sizeof(MT_SCPL, 1, MT_BYTE)
 
59
      write (*,*) '7. MA_sizeof(MT_DCPL, 1, MT_BYTE) = ',
 
60
     $    MA_sizeof(MT_DCPL, 1, MT_BYTE)
 
61
      write (*,*) '8. MA_sizeof(MT_BYTE, 3, MT_DBL) = ',
 
62
     $    MA_sizeof(MT_BYTE, 3, MT_DBL)
 
63
      write (*,*) '9. MA_sizeof(MT_BYTE, 33, MT_DBL) = ',
 
64
     $    MA_sizeof(MT_BYTE, 33, MT_DBL)
 
65
      write (*,*) ' '
 
66
 
 
67
c     ok
 
68
      write (*,*) 'should be 2 values ...'
 
69
      write (*,*) '1. MA_sizeof_overhead(MT_BYTE) = ',
 
70
     $    MA_sizeof_overhead(MT_BYTE)
 
71
      write (*,*) '2. MA_sizeof_overhead(MT_INT) = ',
 
72
     $    MA_sizeof_overhead(MT_INT)
 
73
      write (*,*) ' '
 
74
 
 
75
c     fail
 
76
      write (*,*) 'should fail (not init) ...'
 
77
      value = MA_push_stack(MT_DBL, 10, 'stack1', handle1)
 
78
      if (value) then
 
79
          write (*,*) '... success'
 
80
      else
 
81
          write (*,*) '... failure'
 
82
      endif
 
83
      write (*,*) ' '
 
84
 
 
85
c     ok
 
86
      value = MA_initialized()
 
87
      if (value) then
 
88
          write (*,*) 'MA_initialized returns true (failure)'
 
89
      else
 
90
          write (*,*) 'MA_initialized returns false (success)'
 
91
      endif
 
92
      write (*,*) ' '
 
93
 
 
94
c     fail
 
95
      write (*,*) 'should fail (bad datatype) ...'
 
96
      value = MA_init(-1, 10, 10)
 
97
      if (value) then
 
98
          write (*,*) '... success'
 
99
      else
 
100
          write (*,*) '... failure'
 
101
      endif
 
102
      write (*,*) ' '
 
103
 
 
104
c     ok
 
105
      write (*,*) 'should succeed ...'
 
106
      value = MA_init(MT_DBL, 1000, 1000)
 
107
      if (value) then
 
108
          write (*,*) '... success'
 
109
      else
 
110
          write (*,*) '... failure'
 
111
      endif
 
112
      write (*,*) ' '
 
113
 
 
114
c     ok
 
115
      value = MA_initialized()
 
116
      if (value) then
 
117
          write (*,*) 'MA_initialized returns true (success)'
 
118
      else
 
119
          write (*,*) 'MA_initialized returns false (failure)'
 
120
      endif
 
121
      write (*,*) ' '
 
122
 
 
123
c     ok
 
124
      write (*,*) 'should be 1 value ...'
 
125
      write (*,*) '1. MA_sizeof_overhead(MT_BYTE) = ',
 
126
     $    MA_sizeof_overhead(MT_BYTE)
 
127
      write (*,*) ' '
 
128
 
 
129
c     fail
 
130
      write (*,*) 'should fail (bad handle) ...'
 
131
      handle1 = 0
 
132
      value = MA_pop_stack(handle1)
 
133
      if (value) then
 
134
          write (*,*) '... success'
 
135
      else
 
136
          write (*,*) '... failure'
 
137
      endif
 
138
      write (*,*) ' '
 
139
 
 
140
c     fail
 
141
      write (*,*) 'should fail (bad handle) ...'
 
142
      handle1 = 37
 
143
      value = MA_pop_stack(handle1)
 
144
      if (value) then
 
145
          write (*,*) '... success'
 
146
      else
 
147
          write (*,*) '... failure'
 
148
      endif
 
149
      write (*,*) ' '
 
150
 
 
151
c     fail
 
152
      write (*,*) 'should fail (bad handle) ...'
 
153
      handle1 = 10000
 
154
      value = MA_pop_stack(handle1)
 
155
      if (value) then
 
156
          write (*,*) '... success'
 
157
      else
 
158
          write (*,*) '... failure'
 
159
      endif
 
160
      write (*,*) ' '
 
161
 
 
162
c     fail
 
163
      write (*,*) 'should fail (bad handle) ...'
 
164
      value = MA_get_index(handle1, index1)
 
165
      if (value) then
 
166
          write (*,*) '... success'
 
167
      else
 
168
          write (*,*) '... failure'
 
169
      endif
 
170
      write (*,*) ' '
 
171
 
 
172
c     ok
 
173
      write (*,*) 'start testing MA_chop_stack ...'
 
174
      value = MA_push_stack(MT_BYTE, 1, 'stack1', handle1)
 
175
      value = MA_push_stack(MT_BYTE, 2, 'stack2', handle2)
 
176
      value = MA_push_stack(MT_BYTE, 3, 'stack3', handle3)
 
177
      value = MA_push_stack(MT_BYTE, 4, 'stack4', handle4)
 
178
      write (*,*) 'should be 4 blocks on stack ...'
 
179
      call MA_summarize_allocated_blocks
 
180
      write (*,*) 'should succeed ...'
 
181
      value = MA_chop_stack(handle4)
 
182
      if (value) then
 
183
          write (*,*) '... success'
 
184
      else
 
185
          write (*,*) '... failure'
 
186
      endif
 
187
      write (*,*) 'should be 3 blocks on stack ...'
 
188
      call MA_summarize_allocated_blocks
 
189
      write (*,*) 'should fail (not in stack) ...'
 
190
      value = MA_chop_stack(handle4)
 
191
      if (value) then
 
192
          write (*,*) '... success'
 
193
      else
 
194
          write (*,*) '... failure'
 
195
      endif
 
196
      write (*,*) 'should succeed ...'
 
197
      value = MA_chop_stack(handle2)
 
198
      if (value) then
 
199
          write (*,*) '... success'
 
200
      else
 
201
          write (*,*) '... failure'
 
202
      endif
 
203
      write (*,*) 'should be 1 block on stack ...'
 
204
      call MA_summarize_allocated_blocks
 
205
      write (*,*) 'should succeed ...'
 
206
      value = MA_chop_stack(handle1)
 
207
      if (value) then
 
208
          write (*,*) '... success'
 
209
      else
 
210
          write (*,*) '... failure'
 
211
      endif
 
212
      write (*,*) 'should be 0 blocks ...'
 
213
      call MA_summarize_allocated_blocks
 
214
      value = MA_push_stack(MT_BYTE, 1, 'stack1', handle1)
 
215
      do 10 i = 1, 33
 
216
          value = MA_push_stack(MT_BYTE, 1, 'stackn', handle2)
 
217
10    continue
 
218
      value = MA_chop_stack(handle1)
 
219
      write (*,*) 'stop testing MA_chop_stack'
 
220
      write (*,*) ' '
 
221
 
 
222
c     ok
 
223
      write (*,*) 'start testing 0-length stack allocations ...'
 
224
      value = MA_push_get(MT_INT, 1, 'stack1', handle1, index1)
 
225
      value = MA_push_get(MT_INT, 0, 'stack2', handle2, index2)
 
226
      value = MA_push_stack(MT_BYTE, 0, 'stack3', handle3)
 
227
      value = MA_push_stack(MT_BYTE, 4, 'stack4', handle4)
 
228
      int_mb(index1) = 123
 
229
      int_mb(index2) = 0
 
230
      write (*,*) 'should fail (bad right sig on stack2) ...'
 
231
      value = MA_verify_allocator_stuff()
 
232
      if (value) then
 
233
          write (*,*) '... success'
 
234
      else
 
235
          write (*,*) '... failure'
 
236
      endif
 
237
      write (*,*) 'should succeed ...'
 
238
      value = MA_chop_stack(handle1)
 
239
      if (value) then
 
240
          write (*,*) '... success'
 
241
      else
 
242
          write (*,*) '... failure'
 
243
      endif
 
244
      write (*,*) 'stop testing 0-length stack allocations ...'
 
245
      write (*,*) ' '
 
246
 
 
247
c     ok
 
248
      write (*,*) 'start testing 0-length heap allocations ...'
 
249
      value = MA_alloc_get(MT_INT, 1, 'heap1', handle1, index1)
 
250
      value = MA_alloc_get(MT_INT, 0, 'heap2', handle2, index2)
 
251
      value = MA_allocate_heap(MT_BYTE, 0, 'heap3', handle3)
 
252
      value = MA_allocate_heap(MT_BYTE, 4, 'heap4', handle4)
 
253
      int_mb(index1) = 123
 
254
      value = MA_free_heap(handle4)
 
255
      value = MA_free_heap(handle3)
 
256
      value = MA_free_heap(handle2)
 
257
      value = MA_free_heap(handle1)
 
258
      write (*,*) 'should be 0 blocks ...'
 
259
      call MA_summarize_allocated_blocks
 
260
      write (*,*) 'stop testing 0-length heap allocations ...'
 
261
      write (*,*) ' '
 
262
 
 
263
c     ok
 
264
      write (*,*) 'should succeed ...'
 
265
      value = MA_push_stack(MT_DBL, 10, 'stack1', handle1)
 
266
      if (value) then
 
267
          write (*,*) '... success'
 
268
      else
 
269
          write (*,*) '... failure'
 
270
      endif
 
271
      write (*,*) 'should succeed ...'
 
272
      value = MA_get_index(handle1, index1)
 
273
      if (value) then
 
274
          write (*,*) '... success'
 
275
      else
 
276
          write (*,*) '... failure'
 
277
      endif
 
278
      dbl_mb(index1) = 19.82
 
279
      dbl_mb(index1 + 9) = dbl_mb(index1) - 19
 
280
      write (*,*) 'should be 19.82 and 0.82 ...'
 
281
      write (*,*) 'dbl_mb(', index1, ') = ', dbl_mb(index1)
 
282
      write (*,*) 'dbl_mb(', index1 + 9, ') = ', dbl_mb(index1 + 9)
 
283
      write (*,*) ' '
 
284
 
 
285
c     ok
 
286
      write (*,*) 'should succeed ...'
 
287
      value = MA_allocate_heap(MT_INT, 10, 'heap1', handle2)
 
288
      if (value) then
 
289
          write (*,*) '... success'
 
290
      else
 
291
          write (*,*) '... failure'
 
292
      endif
 
293
      write (*,*) ' '
 
294
 
 
295
c     fail
 
296
      write (*,*) 'should fail (not in heap) ...'
 
297
      value = MA_free_heap(handle1)
 
298
      if (value) then
 
299
          write (*,*) '... success'
 
300
      else
 
301
          write (*,*) '... failure'
 
302
      endif
 
303
      write (*,*) ' '
 
304
 
 
305
c     fail
 
306
      write (*,*) 'should fail (not in stack) ...'
 
307
      value = MA_pop_stack(handle2)
 
308
      if (value) then
 
309
          write (*,*) '... success'
 
310
      else
 
311
          write (*,*) '... failure'
 
312
      endif
 
313
      write (*,*) ' '
 
314
 
 
315
c     ok
 
316
      write (*,*) 'should succeed ...'
 
317
      value = MA_push_stack(MT_BYTE, 5, 'stack2', handle3)
 
318
      if (value) then
 
319
          write (*,*) '... success'
 
320
      else
 
321
          write (*,*) '... failure'
 
322
      endif
 
323
      write (*,*) ' '
 
324
 
 
325
c     ok
 
326
      write (*,*) 'should see something here ...'
 
327
      call MA_summarize_allocated_blocks
 
328
      write (*,*) ' '
 
329
 
 
330
c     fail
 
331
      write (*,*) 'should fail (not top of stack) ...'
 
332
      value = MA_pop_stack(handle1)
 
333
      if (value) then
 
334
          write (*,*) '... success'
 
335
      else
 
336
          write (*,*) '... failure'
 
337
      endif
 
338
      write (*,*) ' '
 
339
 
 
340
c     ok
 
341
      write (*,*) 'should succeed ...'
 
342
      value = MA_pop_stack(handle3)
 
343
      if (value) then
 
344
          write (*,*) '... success'
 
345
      else
 
346
          write (*,*) '... failure'
 
347
      endif
 
348
      write (*,*) ' '
 
349
 
 
350
c     ok
 
351
      write (*,*) 'should succeed ...'
 
352
      value = MA_pop_stack(handle1)
 
353
      if (value) then
 
354
          write (*,*) '... success'
 
355
      else
 
356
          write (*,*) '... failure'
 
357
      endif
 
358
      write (*,*) ' '
 
359
 
 
360
c     ok
 
361
      write (*,*) 'should succeed ...'
 
362
      value = MA_get_index(handle2, index2)
 
363
      if (value) then
 
364
          write (*,*) '... success'
 
365
      else
 
366
          write (*,*) '... failure'
 
367
      endif
 
368
      int_mb(index2) = 1963
 
369
      int_mb(index2 + 9) = int_mb(index2) - 1900
 
370
      write (*,*) 'should be 1963 and 63 ...'
 
371
      write (*,*) 'int_mb(', index2, ') = ', int_mb(index2)
 
372
      write (*,*) 'int_mb(', index2 + 9, ') = ', int_mb(index2 + 9)
 
373
      write (*,*) ' '
 
374
 
 
375
c     ok
 
376
      write (*,*) 'should succeed ...'
 
377
      value = MA_allocate_heap(MT_REAL, 1, 'heap2', handle3)
 
378
      if (value) then
 
379
          write (*,*) '... success'
 
380
      else
 
381
          write (*,*) '... failure'
 
382
      endif
 
383
      write (*,*) ' '
 
384
 
 
385
c     ok
 
386
      write (*,*) 'start testing MA_verify_allocator_stuff ...'
 
387
      write (*,*) 'should see nothing here ...'
 
388
      value = MA_verify_allocator_stuff()
 
389
      write (*,*) 'should succeed ...'
 
390
      if (value) then
 
391
          write (*,*) '... success'
 
392
      else
 
393
          write (*,*) '... failure'
 
394
      endif
 
395
      write (*,*) 'stop testing MA_verify_allocator_stuff'
 
396
      write (*,*) ' '
 
397
 
 
398
c     fail
 
399
      write (*,*) 'should fail (bad right guard) ...'
 
400
      int_mb(index2 + 10) = 0
 
401
      value = MA_free_heap(handle2)
 
402
      if (value) then
 
403
          write (*,*) '... success'
 
404
      else
 
405
          write (*,*) '... failure'
 
406
      endif
 
407
      write (*,*) ' '
 
408
 
 
409
c     ok
 
410
      write (*,*) 'should succeed ...'
 
411
      value = MA_set_auto_verify(.true.)
 
412
      value = MA_set_auto_verify(.true.)
 
413
      if (value) then
 
414
          write (*,*) '... success'
 
415
      else
 
416
          write (*,*) '... failure'
 
417
      endif
 
418
      write (*,*) ' '
 
419
 
 
420
c     fail
 
421
      write (*,*) 'start testing MA_set_auto_verify ...'
 
422
      write (*,*) 'should see something here ...'
 
423
      value = MA_set_auto_verify(.true.)
 
424
      value = MA_free_heap(handle2)
 
425
      write (*,*) 'should fail (bad right guard) ...'
 
426
      if (value) then
 
427
          write (*,*) '... success'
 
428
      else
 
429
          write (*,*) '... failure'
 
430
      endif
 
431
      value = MA_set_auto_verify(.false.)
 
432
      write (*,*) 'stop testing MA_set_auto_verify'
 
433
      write (*,*) ' '
 
434
 
 
435
c     fail
 
436
      write (*,*) 'start testing MA_verify_allocator_stuff ...'
 
437
      write (*,*) 'should see something here ...'
 
438
      value = MA_verify_allocator_stuff()
 
439
      write (*,*) 'should fail (bad right guard) ...'
 
440
      if (value) then
 
441
          write (*,*) '... success'
 
442
      else
 
443
          write (*,*) '... failure'
 
444
      endif
 
445
      write (*,*) 'stop testing MA_verify_allocator_stuff'
 
446
      write (*,*) ' '
 
447
 
 
448
c     ok
 
449
      write (*,*) 'should be 3 values ...'
 
450
      write (*,*) '1. MA_inquire_avail(MT_DBL) = ',
 
451
     $    MA_inquire_avail(MT_DBL)
 
452
      write (*,*) '2. MA_inquire_avail(MT_BYTE) = ',
 
453
     $    MA_inquire_avail(MT_BYTE)
 
454
      write (*,*) '3. MA_inquire_avail(MT_DCPL) = ',
 
455
     $    MA_inquire_avail(MT_DCPL)
 
456
      write (*,*) ' '
 
457
 
 
458
c     fail
 
459
      write (*,*) 'should be 3 values ...'
 
460
      write (*,*) '1. MA_inquire_heap(MT_DBL) = ',
 
461
     $    MA_inquire_heap(MT_DBL)
 
462
      write (*,*) '2. MA_inquire_heap(MT_BYTE) = ',
 
463
     $    MA_inquire_heap(MT_BYTE)
 
464
      write (*,*) '3. MA_inquire_heap(MT_DCPL) = ',
 
465
     $    MA_inquire_heap(MT_DCPL)
 
466
      write (*,*) ' '
 
467
 
 
468
c     fail
 
469
      write (*,*) 'should be 3 values ...'
 
470
      write (*,*) '1. MA_inquire_stack(MT_DBL) = ',
 
471
     $    MA_inquire_stack(MT_DBL)
 
472
      write (*,*) '2. MA_inquire_stack(MT_BYTE) = ',
 
473
     $    MA_inquire_stack(MT_BYTE)
 
474
      write (*,*) '3. MA_inquire_stack(MT_DCPL) = ',
 
475
     $    MA_inquire_stack(MT_DCPL)
 
476
      write (*,*) ' '
 
477
 
 
478
c     ok
 
479
      write (*,*) 'should succeed ...'
 
480
      value = MA_alloc_get(MT_INT, 1, 'heap3', handle1, index1)
 
481
      if (value) then
 
482
          write (*,*) '... success'
 
483
      else
 
484
          write (*,*) '... failure'
 
485
      endif
 
486
      int_mb(index1) = 1982
 
487
      write (*,*) 'should be 1982 ...'
 
488
      write (*,*) 'int_mb(', index1, ') = ', int_mb(index1)
 
489
      write (*,*) ' '
 
490
 
 
491
c     ok
 
492
      write (*,*) 'should succeed ...'
 
493
      value = MA_free_heap(handle1)
 
494
      if (value) then
 
495
          write (*,*) '... success'
 
496
      else
 
497
          write (*,*) '... failure'
 
498
      endif
 
499
      write (*,*) ' '
 
500
 
 
501
c     ok
 
502
      write (*,*) 'start testing byte arrays ...'
 
503
      write (*,*) 'should succeed ...'
 
504
      value = MA_push_get(MT_BYTE, 5, 'stack3', handle1, index1)
 
505
      if (value) then
 
506
          write (*,*) '... success'
 
507
      else
 
508
          write (*,*) '... failure'
 
509
      endif
 
510
      char5(1) = 'z'
 
511
      char5(2) = 'y'
 
512
      char5(3) = 'x'
 
513
      char5(4) = 'w'
 
514
      char5(5) = 'v'
 
515
      do 20 i = 0, 4
 
516
          byte_mb(index1 + i) = char5(i + 1)
 
517
20    continue
 
518
      write (*,*) 'should be zyxwv ...'
 
519
      do 30 i = 0, 4
 
520
          char1 = byte_mb(index1+i)
 
521
          write (*,*) 'byte_mb(', index1+i, ') = ', char1
 
522
30    continue
 
523
      write (*,*) 'should succeed ...'
 
524
      value = MA_pop_stack(handle1)
 
525
      if (value) then
 
526
          write (*,*) '... success'
 
527
      else
 
528
          write (*,*) '... failure'
 
529
      endif
 
530
      write (*,*) 'should succeed ...'
 
531
      i = 1
 
532
      char2 = 'ab'
 
533
      value = MA_alloc_get(MT_BYTE, i * 2, 'heap4', handle1, index1)
 
534
      if (value) then
 
535
          write (*,*) '... success'
 
536
      else
 
537
          write (*,*) '... failure'
 
538
      endif
 
539
      byte_mb(index1) = char2(1:1)
 
540
      byte_mb(index1 + 1) = char2(2:2)
 
541
      write (*,*) 'should be ab ...'
 
542
      do 40 i = 0, 1
 
543
          char1 = byte_mb(index1+i)
 
544
          write (*,*) 'byte_mb(', index1+i, ') = ', char1
 
545
40    continue
 
546
      write (*,*) 'should succeed ...'
 
547
      value = MA_free_heap(handle1)
 
548
      if (value) then
 
549
          write (*,*) '... success'
 
550
      else
 
551
          write (*,*) '... failure'
 
552
      endif
 
553
      write (*,*) 'stop testing byte arrays ...'
 
554
      write (*,*) ' '
 
555
 
 
556
c     ok
 
557
      write (*,*) 'should succeed ...'
 
558
      value = MA_push_get(MT_INT, 1, 'stack3', handle1, index1)
 
559
      if (value) then
 
560
          write (*,*) '... success'
 
561
      else
 
562
          write (*,*) '... failure'
 
563
      endif
 
564
      int_mb(index1) = 5
 
565
      write (*,*) 'should be 5 ...'
 
566
      write (*,*) 'int_mb(', index1, ') = ', int_mb(index1)
 
567
      write (*,*) ' '
 
568
 
 
569
c     ok
 
570
      write (*,*) 'should succeed ...'
 
571
      value = MA_pop_stack(handle1)
 
572
      if (value) then
 
573
          write (*,*) '... success'
 
574
      else
 
575
          write (*,*) '... failure'
 
576
      endif
 
577
      write (*,*) ' '
 
578
 
 
579
c     ok
 
580
      write (*,*) 'start testing MA_print_stats ...'
 
581
      call MA_print_stats(.true.)
 
582
      write (*,*) 'stop testing MA_print_stats'
 
583
      write (*,*) ' '
 
584
 
 
585
c     fail
 
586
      write (*,*) 'should fail (not implemented) ...'
 
587
      value = MA_init_memhandle_iterator(ihandle1)
 
588
      if (value) then
 
589
          write (*,*) '... success'
 
590
      else
 
591
          write (*,*) '... failure'
 
592
      endif
 
593
      write (*,*) ' '
 
594
 
 
595
c     fail
 
596
      write (*,*) 'should fail (not implemented) ...'
 
597
      value = MA_get_next_memhandle(ihandle1, handle1)
 
598
      if (value) then
 
599
          write (*,*) '... success'
 
600
      else
 
601
          write (*,*) '... failure'
 
602
      endif
 
603
      write (*,*) ' '
 
604
 
 
605
c     ok
 
606
      write (*,*) 'start testing MA_set_hard_fail ...'
 
607
      value = MA_set_hard_fail(.false.)
 
608
      write (*,*) 'should see a (nonfatal) MA error message here ...'
 
609
      value = MA_pop_stack(-1)
 
610
      value = MA_set_hard_fail(.true.)
 
611
      value = MA_set_hard_fail(.true.)
 
612
      if (value) then
 
613
          write (*,*) 'should see a (hard failure)',
 
614
     $    ' MA error message here ...'
 
615
          value = MA_pop_stack(-1)
 
616
      else
 
617
          write (*,*) '... failure; return value is wrong'
 
618
      endif
 
619
      write (*,*) 'stop testing MA_set_hard_fail'
 
620
 
 
621
      end