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

« back to all changes in this revision

Viewing changes to src/tools/ga-5-2/global/testing/perform.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
* 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:
 
1
#if HAVE_CONFIG_H
 
2
#   include "config.fh"
 
3
#endif
 
4
c $Id: perform.F,v 1.9 2000-05-25 01:09:20 d3h325 Exp $
 
5
      program perform
 
6
c***
 
7
c***  Last modification: Fri Jan 13 12:13:27 PST 1995
 
8
c***
 
9
      implicit none
 
10
#include "mafdecls.fh"
 
11
#include "global.fh"
 
12
      integer heap
 
13
c
 
14
c***  Intitialize a message passing library
 
15
c
 
16
#include "mp3.fh"
 
17
c
 
18
c***  Intitialize the GA package
 
19
      call ga_initialize()
 
20
      if(ga_nnodes().ne.4 .and. ga_nodeid().eq.0)
 
21
     $   call ga_error('Program requires 4 GA processes',ga_nnodes())
 
22
c
 
23
c***  Initialize the MA package
 
24
      heap = 450000
 
25
      if (.not. ma_init(MT_DBL, heap,heap))
 
26
     $     call ga_error('ma init failed',2*heap)
 
27
c
 
28
      call testit()
 
29
c
 
30
      if(ga_nodeid().eq.0) print *, 'All tests successful'
 
31
c
 
32
      call ga_terminate()
 
33
c
 
34
      call MP_FINALIZE()
 
35
      end
 
36
 
 
37
 
 
38
c-----------------
 
39
 
 
40
      subroutine testit()
 
41
      implicit none
 
42
#include "mafdecls.fh"
 
43
#include "global.fh"
 
44
c
 
45
      integer n, nn, num_chunks
 
46
      parameter (n = 710, nn = n*n/4, num_chunks=12)
 
47
      double precision buf(nn)
 
48
c
 
49
      integer g_a
 
50
      integer ilo, ihi, jlo, jhi
 
51
      integer nproc, me, loop
 
52
      integer chunk(num_chunks)
 
53
      data    chunk /1,3,4,9,16,30,64,91,128,171,256,353/
 
54
c     
 
55
      nproc = ga_nnodes()
 
56
      me = ga_nodeid()
 
57
c
 
58
c***  Create global array
 
59
      if (.not. ga_create(MT_DBL, n, n, 'a', 0, 0, g_a))
 
60
     $     call ga_error(' ga_create failed ',1)
 
61
c     
 
62
      do loop=1,nn
 
63
         buf(loop) = .01d0
 
64
      enddo
 
65
      call ga_zero(g_a) 
 
66
c
 
67
      if (me .eq. 0) then
 
68
        write(*,*)' '
 
69
        print *,'> Performance of ga_get, ga_put & ga_acc n = ', n
 
70
        print *,' '
 
71
      endif
 
72
c
 
73
      
 
74
c     do loop=1,2
 
75
c
 
76
c***  local ops
 
77
c
 
78
      call ga_distribution(g_a, me, ilo, ihi, jlo, jhi)
 
79
      call TestPutGetAcc
 
80
     &     (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo, jhi)
 
81
c
 
82
c***  remote ops
 
83
c
 
84
      call ga_distribution(g_a, nproc-1, ilo, ihi, jlo, jhi)
 
85
      call TestPutGetAcc
 
86
     &     (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo, jhi)
 
87
 
 
88
c     enddo
 
89
      end
 
90
 
 
91
 
 
92
      subroutine TestPutGetAcc
 
93
     &          (g_a, n, chunk, num_chunks, buf, ilo, ihi, jlo,jhi)
 
94
      implicit none
 
95
#include "global.fh"
 
96
#include "testutil.fh"
 
97
c
 
98
      integer num_chunks, chunk(num_chunks)
 
99
      integer n, ilo, ihi, jlo,jhi,g_a
 
100
      double precision buf(*), tg, tp, ta
 
101
      double precision time_acc, time_get, time_put
 
102
c
 
103
      integer me
 
104
      integer loop, jump, count, bytes
 
105
c
 
106
      me = ga_nodeid()
 
107
      if (me .eq. 0) then
 
108
        write(6,*)' '
 
109
        write(6,'(21X,8hACCESS [,i3,1h:,i4,1h,,i3,1h:,i4,1h])') 
 
110
     &        ilo,ihi,jlo,jhi
 
111
        write(6,*)'bytes  loop         get                    put',
 
112
     &           '                 accumulate'
 
113
        call flush(6)
 
114
      endif
 
115
      call ga_sync()
 
116
c
 
117
      do loop = 1, num_chunks
 
118
        bytes = util_mdtob(1)*chunk(loop)*chunk(loop) !how much data is accessed
 
119
        jump  =  n/(60*loop) ! jump distance between consecutive patches
 
120
c
 
121
c       everybody touches own data 
 
122
        call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
 
123
        if (me .eq. 0) then
 
124
          tg= time_get(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count)
 
125
        else
 
126
          call sleep(2)
 
127
        endif
 
128
c
 
129
c       everybody touches own data
 
130
        call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
 
131
        if (me .eq. 0) then
 
132
          tp= time_put(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count)
 
133
        else
 
134
          call sleep(2)
 
135
        endif
 
136
c
 
137
c       everybody touches own data
 
138
        call ga_fill_patch(g_a, 1, n, 1, n , 1d0*me*loop)
 
139
        if (me .eq. 0) then
 
140
          ta= time_acc(g_a,ilo,ihi,jlo,jhi,buf,chunk(loop),jump,count)
 
141
        else
 
142
          call sleep(2)
 
143
        endif
 
144
c
 
145
        if (me .eq. 0) then
 
146
          write(6,77)bytes, count, tg, 1d-6*bytes/tg,
 
147
     &               tp, 1d-6*bytes/tp, ta, 1d-6*bytes/ta
 
148
          call flush(6)
 
149
        endif
 
150
      enddo
 
151
c
 
152
77    format(i6, i5, 3(d10.3, d9.2,'MB/s'))
 
153
      end
 
154
 
 
155
 
 
156
 
 
157
      double precision function
 
158
     &       time_acc(g_a, is, ie, js, je, buf, chunk, jump, count)
 
159
c
 
160
      implicit none
 
161
#include "global.fh"
 
162
#include "testutil.fh"
 
163
c
 
164
 
 
165
      integer g_a, chunk, jump, count, is, js, ie, je
 
166
c
 
167
      integer ilo, ihi, jlo, jhi
 
168
      double precision  seconds, buf 
 
169
c
 
170
      count = 0
 
171
      seconds = util_timer()
 
172
c
 
173
c       distance between consecutive patches increased by jump
 
174
c       to destroy locality of reference
 
175
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
176
           ihi = ilo + chunk -1
 
177
           do jlo = js, je -chunk-jump +1, chunk+jump
 
178
              jhi = jlo + chunk -1
 
179
              count = count + 1
 
180
              call ga_acc(g_a, ilo, ihi, jlo, jhi, buf, chunk, 1d0)
 
181
           enddo
 
182
        enddo
 
183
      seconds = util_timer() - seconds
 
184
c
 
185
      time_acc = seconds/count
 
186
      end
 
187
 
 
188
 
 
189
      double precision function
 
190
     &       time_get(g_a, is, ie, js, je, buf, chunk, jump, count)
 
191
c
 
192
      implicit none
 
193
#include "global.fh"
 
194
#include "testutil.fh"
 
195
c
 
196
      integer g_a, chunk, jump, count, is, js, ie, je
 
197
c
 
198
      integer ilo, ihi, jlo, jhi
 
199
      double precision  seconds, buf
 
200
c
 
201
      count = 0
 
202
      seconds = util_timer()
 
203
c
 
204
c       distance between consecutive patches increased by jump
 
205
c       to destroy locality of reference
 
206
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
207
           ihi = ilo + chunk -1
 
208
           do jlo = js, je -chunk-jump +1, chunk+jump
 
209
              jhi = jlo + chunk -1
 
210
              count = count + 1
 
211
              call ga_get(g_a, ilo, ihi, jlo, jhi, buf, chunk)
 
212
           enddo
 
213
        enddo
 
214
      seconds = util_timer() - seconds
 
215
c
 
216
      time_get = seconds/count
 
217
      end
 
218
 
 
219
 
 
220
 
 
221
      double precision function
 
222
     &       time_put(g_a, is, ie, js, je, buf, chunk, jump, count)
 
223
c
 
224
      implicit none
 
225
#include "global.fh"
 
226
#include "testutil.fh"
 
227
c
 
228
      integer g_a, chunk, jump, count, is, js, ie, je
 
229
c
 
230
      integer ilo, ihi, jlo, jhi
 
231
      double precision  seconds, buf
 
232
c
 
233
      count = 0
 
234
      seconds = util_timer()
 
235
c
 
236
c       distance between consecutive patches increased by jump
 
237
c       to destroy locality of reference
 
238
        do ilo = is, ie -chunk-jump +1, chunk+jump
 
239
           ihi = ilo + chunk -1
 
240
           do jlo = js, je -chunk-jump +1, chunk+jump
 
241
              jhi = jlo + chunk -1
 
242
              count = count + 1
 
243
              call ga_put(g_a, ilo, ihi, jlo, jhi, buf, chunk)
 
244
           enddo
 
245
        enddo
 
246
      seconds = util_timer() - seconds
 
247
c
 
248
      time_put = seconds/count
 
249
      end