← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/tools/ga-5-2/global/testing/mir_perf2.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
http://bugs.debian.org/696361
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/tools/ga-5-2/global/testing/mir_perf2.F
 
1
#if HAVE_CONFIG_H
 
2
#   include "config.fh"
 
3
#endif
 
4
c $Id: mir_perf2.F,v 1.1 2003-02-26 15:33:38 d3g293 Exp $
 
5
c------------------------------------------------------------------------
 
6
c Program perf.x is used to test performance of GA put, get, accumulate  |
 
7
c It has to be executed on four processors.                              |
 
8
c remote operations access data on processes 1,2,3 in the round-robin way|
 
9
c------------------------------------------------------------------------
 
10
c
 
11
#define SLEEP sleep
 
12
      program perf
 
13
      implicit none
 
14
#include "mafdecls.fh"
 
15
#include "global.fh"
 
16
      integer heap
 
17
c
 
18
c***  Intitialize a message passing library
 
19
c
 
20
#include "mp3.fh"
 
21
c
 
22
c***  Intitialize the GA package
 
23
      call ga_initialize()
 
24
      if(ga_nnodes().ne.4 .and. ga_nodeid().eq.0)
 
25
     $   call ga_error('Program requires 4 GA processes',ga_nnodes())
 
26
c
 
27
c***  Initialize the MA package
 
28
      heap = 900000
 
29
      if (.not. ma_init(MT_DBL, heap,heap)) 
 
30
     $     call ga_error('ma init failed',2*heap) 
 
31
c
 
32
c      call test2D()
 
33
      call test1D()
 
34
c
 
35
      if(ga_nodeid().eq.0) print *,'All tests successful '
 
36
c
 
37
      call ga_terminate()
 
38
c
 
39
      call MP_FINALIZE()
 
40
      end
 
41
 
 
42
 
 
43
      subroutine test1D()
 
44
      implicit none
 
45
#include "mafdecls.fh"
 
46
#include "global.fh"
 
47
c     
 
48
c
 
49
      integer n, nn, num_chunks
 
50
      parameter (n = 1024*1024, nn = n/4, num_chunks=16)
 
51
      double precision buf(nn)
 
52
c
 
53
      integer g_a
 
54
      integer ilo, ihi, jlo, jhi
 
55
      integer nproc, me, loop
 
56
      integer chunk(num_chunks)
 
57
      data    chunk /1,9,16,81,256,576,900,2304,4096,8281,
 
58
     $               16384,29241,65536,124609,193600,262144/
 
59
c     
 
60
      nproc = ga_nnodes()
 
61
      me = ga_nodeid()
 
62
c
 
63
c***  Create global array
 
64
      if (.not. ga_create(MT_DBL, n, 1, 'a', 0, 0, g_a))
 
65
     $     call ga_error(' ga_create failed ',1)
 
66
c     
 
67
      do loop=1,nn
 
68
         buf(loop) = .01d0
 
69
      enddo
 
70
      call ga_zero(g_a) 
 
71
c
 
72
      if (me .eq. 0) then
 
73
        write(*,*)' '
 
74
        write(*,*)' '
 
75
        write(*,*)' '
 
76
        write(*,55)n
 
77
55      format(' Performance of GA get, put & acc',
 
78
     $           ' for 1-dimensional sections of array[',i7,']')
 
79
        print *,' '
 
80
      endif
 
81
c
 
82
c     do loop=1,2
 
83
c
 
84
c***  local ops
 
85
c
 
86
      call ga_distribution(g_a, me, ilo, ihi, jlo, jhi)
 
87
      call TestPutGetAcc1
 
88
     &     (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo, jhi, .true.)
 
89
c
 
90
c***  remote ops
 
91
c
 
92
      call TestPutGetAcc1
 
93
     &     (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo, jhi,.false.)
 
94
 
 
95
c     enddo
 
96
      end
 
97
 
 
98
 
 
99
      subroutine TestPutGetAcc1
 
100
     &      (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo,jhi, local)
 
101
      implicit none
 
102
#include "global.fh"
 
103
#include "testutil.fh"
 
104
c
 
105
      integer num_chunks, chunk(num_chunks)
 
106
      integer n, ilo, ihi, jlo,jhi,g_a
 
107
      double precision buf(*), tg, tp, ta
 
108
      double precision time_acc1, time_get1, time_put1
 
109
      logical local
 
110
c
 
111
      integer me
 
112
      integer loop, jump, count, bytes
 
113
c
 
114
      me = ga_nodeid()
 
115
      if (me .eq. 0) then
 
116
        write(6,*)' '
 
117
        if(local) then
 
118
          write(6,'(26X, 25HLocal 1-D Array Section    )') 
 
119
        else
 
120
          write(6,'(26X, 25HRemote 1-D Array Section   )') 
 
121
        endif
 
122
 
 
123
        write(6,*)'    section           get               put',
 
124
     &           '           accumulate'
 
125
        write(6,*)' bytes    dim     sec      MB/s     sec      MB/s',
 
126
     &           '     sec      MB/s'
 
127
        call flush(6)
 
128
      endif
 
129
      call ga_sync()
 
130
c
 
131
      do loop = 1, num_chunks
 
132
        bytes = util_mdtob(1)*chunk(loop) ! how much data is accessed
 
133
        jump  =  n/(6000*loop) ! jump distance between consecutive patches
 
134
        if(loop.eq.num_chunks)jump=0
 
135
c
 
136
c       everybody touches own data 
 
137
        call ga_fill_patch(g_a, 1, n, 1, 1 , 1d0*me*loop)
 
138
        if (me .eq. 0) then
 
139
        tg=time_get1(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count,
 
140
     $               local)
 
141
        else
 
142
          call SLEEP(1)
 
143
        endif
 
144
c
 
145
c       everybody touches own data
 
146
        call ga_fill_patch(g_a, 1, n, 1, 1 , 1d0*me*loop)
 
147
        if (me .eq. 0) then
 
148
        tp=time_put1(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count, 
 
149
     $               local)
 
150
        else
 
151
          call SLEEP(1)
 
152
        endif
 
153
c
 
154
c       everybody touches own data
 
155
        call ga_fill_patch(g_a, 1, n, 1, 1 , 1d0*me*loop)
 
156
        if (me .eq. 0) then
 
157
        ta=time_acc1(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count,
 
158
     $               local)
 
159
        else
 
160
          call SLEEP(1)
 
161
        endif
 
162
c
 
163
        if (me .eq. 0) then
 
164
          write(6,77)bytes, chunk(loop), tg, 
 
165
     &          1d-6*bytes/tg,tp, 1d-6*bytes/tp, ta, 1d-6*bytes/ta
 
166
          call flush(6)
 
167
        endif
 
168
      enddo
 
169
c
 
170
77    format(i7, i7,1x, 3(1x,d8.3,1x,d8.3))
 
171
      end
 
172
 
 
173
 
 
174
 
 
175
      double precision function
 
176
     &   time_acc1(g_a, is, ie, js, je, buf, chunk, jump, count, local)
 
177
c
 
178
      implicit none
 
179
#include "global.fh"
 
180
#include "testutil.fh"
 
181
c
 
182
      integer g_a, chunk, jump, count, is, js, ie, je
 
183
      logical local 
 
184
      integer rows, indx, shifti
 
185
c
 
186
      integer ilo, ihi, jlo, jhi
 
187
      double precision seconds, buf 
 
188
c
 
189
      count = 0
 
190
      rows = ie - is + 1
 
191
      shifti = 2*rows 
 
192
      jlo = js
 
193
      jhi = je
 
194
 
 
195
      seconds = util_timer()
 
196
c
 
197
c       distance between consecutive patches increased by jump
 
198
c       to destroy locality of reference
 
199
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
200
           ihi = ilo + chunk -1
 
201
           count = count + 1
 
202
           if (local) then
 
203
                 call ga_acc(g_a, ilo, ihi, jlo, jhi, buf, chunk, 1d0)
 
204
           else
 
205
                 call ga_acc(g_a, ilo+shifti, ihi+shifti,
 
206
     $                       jlo, jhi,  buf, chunk, 1d0)
 
207
           endif
 
208
        enddo
 
209
      seconds = util_timer() - seconds
 
210
c
 
211
      time_acc1 = seconds/count
 
212
      end
 
213
 
 
214
 
 
215
      double precision function
 
216
     &    time_get1(g_a, is, ie, js, je, buf, chunk, jump, count, local)
 
217
c
 
218
      implicit none
 
219
#include "global.fh"
 
220
#include "testutil.fh"
 
221
c
 
222
      integer g_a, chunk, jump, count, is, js, ie, je
 
223
      integer rows, indx, shifti
 
224
      logical local
 
225
c
 
226
      integer ilo, ihi, jlo, jhi
 
227
      double precision seconds, buf
 
228
c
 
229
      count = 0
 
230
      rows = ie - is + 1
 
231
      shifti = 2*rows
 
232
      jlo = js
 
233
      jhi = je
 
234
 
 
235
      seconds = util_timer()
 
236
c
 
237
c       distance between consecutive patches increased by jump
 
238
c       to destroy locality of reference
 
239
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
240
              ihi = ilo + chunk -1
 
241
              count = count + 1
 
242
              if (local) then
 
243
                 call ga_get(g_a, ilo, ihi, jlo, jhi, buf, chunk)
 
244
              else
 
245
                 call ga_get(g_a, ilo+shifti, ihi+shifti,
 
246
     $                       jlo, jhi,  buf, chunk)
 
247
              endif
 
248
        enddo
 
249
      seconds = util_timer() - seconds
 
250
c
 
251
      time_get1 = seconds/count
 
252
      end
 
253
 
 
254
 
 
255
 
 
256
      double precision function
 
257
     &   time_put1(g_a, is, ie, js, je, buf, chunk, jump, count, local)
 
258
c
 
259
      implicit none
 
260
#include "global.fh"
 
261
#include "testutil.fh"
 
262
c
 
263
      integer g_a, chunk, jump, count, is, js, ie, je
 
264
      integer rows, indx, shifti
 
265
      logical local
 
266
c
 
267
      integer ilo, ihi, jlo, jhi
 
268
      double precision  seconds, buf
 
269
c
 
270
      count = 0
 
271
      rows = ie - is + 1
 
272
      shifti = 2*rows
 
273
      jlo = js
 
274
      jhi = je
 
275
 
 
276
      seconds = util_timer()
 
277
c
 
278
c       distance between consecutive patches increased by jump
 
279
c       to destroy locality of reference
 
280
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
281
              ihi = ilo + chunk -1
 
282
              count = count + 1
 
283
              if (local) then
 
284
                 call ga_put(g_a, ilo, ihi, jlo, jhi, buf, chunk)
 
285
              else
 
286
                 call ga_put(g_a, ilo+shifti, ihi+shifti,
 
287
     $                       jlo, jhi,  buf, chunk)
 
288
              endif
 
289
        enddo
 
290
      seconds = util_timer() - seconds
 
291
c
 
292
      time_put1 = seconds/count
 
293
      end
 
294
 
 
295
 
 
296
 
 
297
c
 
298
c     test for square patches
 
299
c
 
300
      subroutine test2D()
 
301
      implicit none
 
302
#include "mafdecls.fh"
 
303
#include "global.fh"
 
304
c
 
305
      integer n, nn, num_chunks
 
306
      parameter (n = 1024, nn = n*n/4, num_chunks=16)
 
307
      double precision buf(nn)
 
308
c
 
309
      integer g_a
 
310
      integer ilo, ihi, jlo, jhi
 
311
      integer nproc, me, loop
 
312
      integer chunk(num_chunks)
 
313
      data    chunk /1,3,4,9,16,24,30,48,64,91,128,171,256,353,440,512/
 
314
c     
 
315
      nproc = ga_nnodes()
 
316
      me = ga_nodeid()
 
317
c
 
318
c***  Create global array
 
319
      if (.not. ga_create(MT_DBL, n, n, 'a', 0, 0, g_a))
 
320
     $     call ga_error(' ga_create failed ',1)
 
321
c     
 
322
      do loop=1,nn
 
323
         buf(loop) = .01d0
 
324
      enddo
 
325
      call ga_zero(g_a) 
 
326
c
 
327
      if (me .eq. 0) then
 
328
        write(*,*)' '
 
329
        write(*,55)n,n
 
330
55      format(' Performance of GA get, put & acc',
 
331
     $           ' for square sections of array[',i4,',',i4,']')
 
332
        print *,' '
 
333
      endif
 
334
c
 
335
c     do loop=1,2
 
336
c
 
337
c***  local ops
 
338
c
 
339
      call ga_distribution(g_a, me, ilo, ihi, jlo, jhi)
 
340
      call TestPutGetAcc
 
341
     &     (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo, jhi, .true.)
 
342
c
 
343
c***  remote ops
 
344
c
 
345
      call TestPutGetAcc
 
346
     &     (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo, jhi,.false.)
 
347
 
 
348
c     enddo
 
349
      end
 
350
 
 
351
 
 
352
      subroutine TestPutGetAcc
 
353
     &      (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo,jhi, local)
 
354
      implicit none
 
355
#include "global.fh"
 
356
#include "testutil.fh"
 
357
c
 
358
      integer num_chunks, chunk(num_chunks)
 
359
      integer n, ilo, ihi, jlo,jhi,g_a
 
360
      double precision buf(*), tg, tp, ta
 
361
      double precision time_acc, time_get, time_put
 
362
      logical local
 
363
c
 
364
      integer me
 
365
      integer loop, jump, count, bytes
 
366
c
 
367
      me = ga_nodeid()
 
368
      if (me .eq. 0) then
 
369
        write(6,*)' '
 
370
        if(local) then
 
371
          write(6,'(26X, 25HLocal 2-D Array Section    )') 
 
372
        else
 
373
          write(6,'(26X, 25HRemote 2-D Array Section   )') 
 
374
        endif
 
375
 
 
376
        write(6,*)'    section           get               put',
 
377
     &           '           accumulate'
 
378
        write(6,*)' bytes    dim     sec      MB/s     sec      MB/s',
 
379
     &           '     sec      MB/s'
 
380
        call flush(6)
 
381
      endif
 
382
      call ga_sync()
 
383
c
 
384
      do loop = 1, num_chunks
 
385
        bytes = util_mdtob(1)*chunk(loop)*chunk(loop) !how much data is accessed
 
386
        jump  =  n/(60*loop) ! jump distance between consecutive patches
 
387
        if(loop.eq.num_chunks)jump=0
 
388
c
 
389
c       everybody touches own data 
 
390
        call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
 
391
        if (me .eq. 0) then
 
392
        tg=time_get(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count,
 
393
     $               local)
 
394
        else
 
395
          call SLEEP(1)
 
396
        endif
 
397
c
 
398
c       everybody touches own data
 
399
        call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
 
400
        if (me .eq. 0) then
 
401
        tp=time_put(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count, 
 
402
     $               local)
 
403
        else
 
404
          call SLEEP(1)
 
405
        endif
 
406
c
 
407
c       everybody touches own data
 
408
        call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
 
409
        if (me .eq. 0) then
 
410
        ta=time_acc(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count,
 
411
     $               local)
 
412
        else
 
413
          call SLEEP(1)
 
414
        endif
 
415
c
 
416
        if (me .eq. 0) then
 
417
          write(6,77)bytes, chunk(loop), tg, 
 
418
     &          1d-6*bytes/tg,tp, 1d-6*bytes/tp, ta, 1d-6*bytes/ta
 
419
          call flush(6)
 
420
        endif
 
421
      enddo
 
422
c
 
423
77    format(i7, i7,1x, 3(1x,d8.3,1x,d8.3))
 
424
      end
 
425
 
 
426
 
 
427
 
 
428
      double precision function
 
429
     &   time_acc(g_a, is, ie, js, je, buf, chunk, jump, count, local)
 
430
c
 
431
      implicit none
 
432
#include "global.fh"
 
433
#include "testutil.fh"
 
434
c
 
435
      integer g_a, chunk, jump, count, is, js, ie, je
 
436
      logical local 
 
437
      integer rows, cols, indx, shifti(3), shiftj(3)
 
438
c
 
439
      integer ilo, ihi, jlo, jhi
 
440
      double precision  seconds, buf 
 
441
c
 
442
      count = 0
 
443
      rows = ie - is + 1
 
444
      cols = je - js + 1
 
445
      shifti(1) = rows
 
446
      shifti(2) = 0
 
447
      shifti(3) = rows
 
448
      shiftj(1) = 0
 
449
      shiftj(2) = cols
 
450
      shiftj(3) = cols
 
451
 
 
452
      seconds = util_timer()
 
453
c
 
454
c       distance between consecutive patches increased by jump
 
455
c       to destroy locality of reference
 
456
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
457
           ihi = ilo + chunk -1
 
458
           do jlo = js, je -chunk-jump +1, chunk+jump
 
459
              jhi = jlo + chunk -1
 
460
              count = count + 1
 
461
              if (local) then
 
462
                 call ga_acc(g_a, ilo, ihi, jlo, jhi, buf, chunk, 1d0)
 
463
              else
 
464
                 indx = Mod(count,3) + 1 
 
465
                 call ga_acc(g_a, ilo+shifti(indx), ihi+shifti(indx),
 
466
     $                       jlo+shiftj(indx), jhi+shiftj(indx), 
 
467
     $                       buf, chunk, 1d0)
 
468
              endif
 
469
           enddo
 
470
        enddo
 
471
      seconds = util_timer() - seconds
 
472
c
 
473
      time_acc = seconds/count
 
474
      end
 
475
 
 
476
 
 
477
      double precision function
 
478
     &    time_get(g_a, is, ie, js, je, buf, chunk, jump, count, local)
 
479
c
 
480
      implicit none
 
481
#include "global.fh"
 
482
#include "testutil.fh"
 
483
c
 
484
      integer g_a, chunk, jump, count, is, js, ie, je
 
485
      integer rows, cols, indx, shifti(3), shiftj(3)
 
486
      logical local
 
487
c
 
488
      integer ilo, ihi, jlo, jhi
 
489
      double precision  seconds, buf
 
490
c
 
491
      count = 0
 
492
      rows = ie - is + 1
 
493
      cols = je - js + 1
 
494
      shifti(1) = rows
 
495
      shifti(2) = 0
 
496
      shifti(3) = rows
 
497
      shiftj(1) = 0
 
498
      shiftj(2) = cols
 
499
      shiftj(3) = cols
 
500
 
 
501
      seconds = util_timer()
 
502
c
 
503
c       distance between consecutive patches increased by jump
 
504
c       to destroy locality of reference
 
505
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
506
           ihi = ilo + chunk -1
 
507
           do jlo = js, je -chunk-jump +1, chunk+jump
 
508
              jhi = jlo + chunk -1
 
509
              count = count + 1
 
510
              if (local) then
 
511
                 call ga_get(g_a, ilo, ihi, jlo, jhi, buf, chunk)
 
512
              else
 
513
                 indx = Mod(count,3) + 1
 
514
                 call ga_get(g_a, ilo+shifti(indx), ihi+shifti(indx),
 
515
     $                       jlo+shiftj(indx), jhi+shiftj(indx),
 
516
     $                       buf, chunk)
 
517
              endif
 
518
           enddo
 
519
        enddo
 
520
      seconds = util_timer() - seconds
 
521
c
 
522
      time_get = seconds/count
 
523
      end
 
524
 
 
525
 
 
526
 
 
527
      double precision function
 
528
     &   time_put(g_a, is, ie, js, je, buf, chunk, jump, count, local)
 
529
c
 
530
      implicit none
 
531
#include "global.fh"
 
532
#include "testutil.fh"
 
533
c
 
534
      integer g_a, chunk, jump, count, is, js, ie, je
 
535
      integer rows, cols, indx, shifti(3), shiftj(3)
 
536
      logical local
 
537
c
 
538
      integer ilo, ihi, jlo, jhi
 
539
      double precision  seconds, buf
 
540
c
 
541
      count = 0
 
542
      rows = ie - is + 1
 
543
      cols = je - js + 1
 
544
      shifti(1) = rows
 
545
      shifti(2) = 0
 
546
      shifti(3) = rows
 
547
      shiftj(1) = 0
 
548
      shiftj(2) = cols
 
549
      shiftj(3) = cols
 
550
 
 
551
      seconds = util_timer()
 
552
c
 
553
c       distance between consecutive patches increased by jump
 
554
c       to destroy locality of reference
 
555
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
556
           ihi = ilo + chunk -1
 
557
           do jlo = js, je -chunk-jump +1, chunk+jump
 
558
              jhi = jlo + chunk -1
 
559
              count = count + 1
 
560
              if (local) then
 
561
                 call ga_put(g_a, ilo, ihi, jlo, jhi, buf, chunk)
 
562
              else
 
563
                 indx = Mod(count,3) + 1
 
564
                 call ga_put(g_a, ilo+shifti(indx), ihi+shifti(indx),
 
565
     $                       jlo+shiftj(indx), jhi+shiftj(indx),
 
566
     $                       buf, chunk)
 
567
              endif
 
568
           enddo
 
569
        enddo
 
570
      seconds = util_timer() - seconds
 
571
c
 
572
      time_put = seconds/count
 
573
      end
 
574
 
 
575
 
 
576
      subroutine my_sleep(seconds)
 
577
      implicit none
 
578
#include "global.fh"
 
579
#include "testutil.fh"
 
580
c
 
581
      double precision  ts, te, work
 
582
      integer seconds, loop
 
583
      common  /sleep_block/ work
 
584
c
 
585
      ts = util_timer()
 
586
      work = 0.
 
587
100   continue
 
588
         do loop= 1, 500
 
589
            work = work + 1.
 
590
         enddo
 
591
         te = util_timer()
 
592
      if(te - ts .lt. real(seconds)) goto 100
 
593
*     print *, work, ts, te 
 
594
      end