← Back to branch summary

~ubuntu-branches/ubuntu/utopic/nwchem/utopic

« back to all changes in this revision

Viewing changes to src/tools/ga-5-2/pario/dra/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/pario/dra/perf2.F
 
1
#if HAVE_CONFIG_H
 
2
#   include "config.fh"
 
3
#endif
 
4
c
 
5
c FNAME - filename for test program
 
6
c
 
7
#define BASE_NAME  'da.try'
 
8
#define BASE_NAME1 'da1.try'
 
9
#ifdef  HPIODIR
 
10
#  define FNAME   HPIODIR//BASE_NAME
 
11
#  define FNAME1  HPIODIR//BASE_NAME1
 
12
#else
 
13
#  define FNAME   BASE_NAME
 
14
#  define FNAME1  BASE_NAME1
 
15
#endif
 
16
 
 
17
      program io
 
18
#include "mafdecls.fh"
 
19
#include "global.fh"
 
20
#include "dra.fh"
 
21
      integer status, me
 
22
      integer max_arrays
 
23
      integer stack, heap
 
24
      double precision max_sz, max_disk, max_mem 
 
25
      data max_arrays, max_sz, max_disk, max_mem /10,1d8,1d10, 1d6/
 
26
#if   defined(IBM)|| defined(CRAY_T3E)
 
27
      data stack, heap /9000000, 4000000/
 
28
#else
 
29
      data stack, heap /1200000, 800000/
 
30
#endif
 
31
c
 
32
#include "mp3.fh"
 
33
      call ga_initialize()
 
34
      if(.not. ga_uses_ma())then
 
35
         stack = 10000 
 
36
         heap  = 10000 
 
37
      endif
 
38
c
 
39
      if(ma_init(MT_F_DBL, stack, heap) ) then
 
40
        me    = ga_nodeid()
 
41
        if(dra_init(max_arrays, max_sz, max_disk, max_mem).ne.0)then
 
42
                call ga_error('dra_init failed: ',0)
 
43
        endif
 
44
        if (me.eq.0) print *,'  '
 
45
        if(me.eq.0)print *, 'TESTING PERFORMANCE OF DISK ARRAYS'
 
46
        if (me.eq.0) print *,' '
 
47
        call test_io_dbl()
 
48
        status = dra_terminate()
 
49
        call ga_terminate()
 
50
      else
 
51
        print *,'ma_init failed'
 
52
      endif
 
53
      if(me.eq.0)print *, 'all done ...'
 
54
      call MP_FINALIZE()
 
55
      end
 
56
 
 
57
 
 
58
 
 
59
      subroutine test_io_dbl
 
60
      implicit none
 
61
#include "mafdecls.fh"
 
62
#include "global.fh"
 
63
#include "dra.fh"
 
64
#include "mp3def.fh"
 
65
      integer n,m
 
66
      parameter (n=5000)
 
67
      parameter (m = 2*n)
 
68
      double precision   err, tt0, tt1, mbytes
 
69
      integer g_a, g_b,  d_a, d_b
 
70
      double precision drand
 
71
      integer i,j, req, loop
 
72
      integer dlo(2),dhi(2)
 
73
      integer glo(2),ghi(2)
 
74
      integer me, nproc
 
75
      integer index, dims(2), reqdims(2), ld(2)
 
76
      integer iran
 
77
      integer util_mdtob
 
78
      logical status
 
79
      external  drand
 
80
      external util_mdtob
 
81
      intrinsic int, dble
 
82
      iran(i) = int(drand(0)*dble(i-1)) + 1
 
83
c    
 
84
      loop  = 30
 
85
      req = -1
 
86
      nproc = ga_nnodes()
 
87
      me    = ga_nodeid()
 
88
c    
 
89
      if (me.eq.0) print *, 'creating global arrays ',n,' x',n
 
90
      if (me.eq.0)call ffflush(6)
 
91
      call ga_sync()
 
92
      if(.not. ga_create(MT_DBL, n, n, 'a', 1, 1, g_a))
 
93
     &         call ga_error('ga_create failed: a', 0)
 
94
      if(.not. ga_create(MT_DBL, n, n, 'b', 1, 1, g_b))
 
95
     &         call ga_error('ga_create failed: b', 0)
 
96
      if (me.eq.0) print *,'done '
 
97
      if (me.eq.0)call ffflush(6)
 
98
c
 
99
c     initialize g_a, g_b with random values
 
100
c     ... use ga_access to avoid allocating local buffers for ga_put
 
101
c
 
102
      call ga_sync()
 
103
      call nga_distribution(g_a, me, glo, ghi)
 
104
      call nga_access(g_a, glo, ghi, index, ld)
 
105
      call fill_random(DBL_MB(index), ghi(1)-glo(1)+1,
 
106
     &                 ghi(2)-glo(2)+1, ld(1))
 
107
      call ga_sync()
 
108
*     if (me.eq.0) print *,'done '
 
109
*     if (me.eq.0)call ffflush(6)
 
110
c
 
111
      call ga_zero(g_b)
 
112
c
 
113
c
 
114
c.......................................................................
 
115
      if (me.eq.0) print *, 'creating disk array ',n,' x',n
 
116
      if (me.eq.0)call ffflush(6)
 
117
      dims(1) = n
 
118
      dims(2) = n
 
119
      reqdims(1) = n
 
120
      reqdims(2) = n
 
121
      if(ndra_create(MT_DBL, 2, dims, 'A',
 
122
     &      FNAME, 
 
123
     &      DRA_RW, reqdims, d_a).ne.0)
 
124
     $   CALL ga_error('ndra_create failed: ',0)
 
125
c
 
126
      if(me.eq.0) print *, 'alligned blocking write'
 
127
      if (me.eq.0)call ffflush(6)
 
128
      tt0 = MP_TIMER()
 
129
      if(ndra_write(g_a, d_a, req).ne.0)
 
130
     $   CALL ga_error('ndra_write failed:',0)
 
131
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
 
132
      tt1 = MP_TIMER() -tt0
 
133
      mbytes = 1e-6*util_mdtob(n*n)
 
134
      if (me.eq.0)then
 
135
          write(6,100)mbytes,tt1,mbytes/tt1
 
136
      endif
 
137
c
 
138
      if(dra_close(d_a).ne.0)call ga_error('dra_close failed: ',d_a)
 
139
      tt1 = MP_TIMER() -tt0
 
140
      if (me.eq.0)then
 
141
          write(6,100)mbytes,tt1,mbytes/tt1
 
142
      endif
 
143
c
 
144
      if (me.eq.0) print *,' '
 
145
      if (me.eq.0) print *,'disk array closed '
 
146
      if (me.eq.0)call ffflush(6)
 
147
c.......................................................................
 
148
c
 
149
c
 
150
      if (me.eq.0) print *, 'creating disk array ',m,' x',m
 
151
      if (me.eq.0)call ffflush(6)
 
152
      dims(1) = m
 
153
      dims(2) = m
 
154
      reqdims(1) = n
 
155
      reqdims(2) = n
 
156
      if(ndra_create(MT_DBL, 2, dims, 'B',
 
157
     &      FNAME1,
 
158
     &      DRA_RW, reqdims, d_b).ne.0)
 
159
     $   CALL ga_error('ndra_create failed: ',0)
 
160
c
 
161
      if(me.eq.0) print *, 'non alligned blocking write'
 
162
      if (me.eq.0)call ffflush(6)
 
163
c
 
164
      glo(1) = 1
 
165
      glo(2) = 1
 
166
      ghi(1) = n
 
167
      ghi(2) = n
 
168
      dlo(1) = 2
 
169
      dlo(2) = 2
 
170
      dhi(1) = n+1
 
171
      dhi(2) = n+1
 
172
      tt0 = MP_TIMER()
 
173
      if(ndra_write_section(.false., g_a, glo, ghi,
 
174
     &               d_b, dlo, dhi, req).ne.0)
 
175
     &         call  ga_error('ndra_write_section failed:',0)
 
176
 
 
177
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
 
178
      tt1 = MP_TIMER() -tt0
 
179
      mbytes = 1e-6*util_mdtob(n*n)
 
180
      if (me.eq.0)then
 
181
          write(6,100)mbytes,tt1,mbytes/tt1
 
182
      endif
 
183
c
 
184
      if(dra_close(d_b).ne.0)call ga_error('dra_close failed: ',d_b)
 
185
      tt1 = MP_TIMER() -tt0
 
186
      if (me.eq.0)then
 
187
          write(6,100)mbytes,tt1,mbytes/tt1
 
188
      endif
 
189
c
 
190
      if (me.eq.0) print *,' '
 
191
      if (me.eq.0) print *,'disk array closed '
 
192
      if (me.eq.0)call ffflush(6)
 
193
c.......................................................................
 
194
c
 
195
c
 
196
      if (me.eq.0) print *,' '
 
197
      if (me.eq.0) print *,'opening disk array'
 
198
      if(dra_open(FNAME,DRA_R, d_a).ne.0)
 
199
     &            call ga_error('dra_open failed',0)
 
200
      if(me.eq.0) print *, 'alligned blocking read'
 
201
      if (me.eq.0)call ffflush(6)
 
202
      tt0 = MP_TIMER()
 
203
      if(ndra_read(g_b, d_a, req).ne.0)
 
204
     $   CALL ga_error('ndra_read failed:',0)
 
205
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
 
206
      tt1 = MP_TIMER() -tt0
 
207
      if (me.eq.0)then
 
208
          write(6,100)mbytes,tt1,mbytes/tt1
 
209
      endif
 
210
      call ga_dadd(1d0, g_a, -1d0, g_b, g_b)
 
211
      err = ga_ddot(g_b, g_b)
 
212
      if(err.ne.0) then
 
213
          if (me.eq.0) print *,'BTW, we have error =', err
 
214
      else
 
215
          if (me.eq.0) print *,'OK'
 
216
      endif
 
217
      if(dra_delete(d_a).ne.0)
 
218
     &            call ga_error('dra_delete failed',0)
 
219
c.......................................................................
 
220
c
 
221
      if (me.eq.0) print *,' '
 
222
      if (me.eq.0) print *,'opening disk array'
 
223
      if(dra_open(FNAME1,DRA_R, d_b).ne.0)
 
224
     &            call ga_error('dra_open failed',0)
 
225
      if(me.eq.0) print *, 'non alligned blocking read'
 
226
      if (me.eq.0)call ffflush(6)
 
227
      tt0 = MP_TIMER()
 
228
      if(ndra_read_section(.false.,   g_b, glo, ghi,
 
229
     &               d_b, dlo, dhi, req).ne.0)
 
230
     &        call   ga_error('ndra_read_section failed:',0)
 
231
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
 
232
      tt1 = MP_TIMER() -tt0
 
233
      if (me.eq.0)then
 
234
          write(6,100)mbytes,tt1,mbytes/tt1
 
235
      endif
 
236
      call ga_dadd(1d0, g_a, -1d0, g_b, g_b)
 
237
      err = ga_ddot(g_b, g_b)
 
238
      if(err.ne.0) then
 
239
          if (me.eq.0) print *,'BTW, we have error =', err
 
240
      else
 
241
          if (me.eq.0) print *,'OK'
 
242
      endif
 
243
      if(dra_delete(d_b).ne.0)
 
244
     &            call ga_error('dra_delete failed',0)
 
245
c.......................................................................
 
246
      status = ga_destroy(g_a)
 
247
      status = ga_destroy(g_b)
 
248
100   format(g11.2,' MB  time=',g11.2,' rate=',g11.3,'MB/s')
 
249
      end
 
250
 
 
251
 
 
252
 
 
253
      subroutine swap(a,b)
 
254
      integer a, b, temp
 
255
         temp = a
 
256
         a = b
 
257
         b = temp
 
258
      end
 
259
 
 
260
 
 
261
      subroutine init_char(str, len, char)
 
262
      character*(*) str
 
263
      character*1 char
 
264
      integer i
 
265
      do i = 1, len -1 
 
266
         str(i:i+1) = char
 
267
      enddo
 
268
      end
 
269
          
 
270
      
 
271
      subroutine fill_random(a, n,m, ld)
 
272
      integer ld, n,m
 
273
      double precision a(ld,*), drand, seed
 
274
      integer i,j
 
275
      external  drand
 
276
c
 
277
      do j=1,m
 
278
         seed = drand(j)
 
279
         do i=1,n
 
280
            a(i,j)=seed*i
 
281
         enddo
 
282
      enddo
 
283
      end