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