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