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