← 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/big.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/big.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,1d9,1d10, 1d6/
 
26
#if   defined(IBM)|| defined(CRAY_T3E)
 
27
      data stack, heap /6000000, 4000000/
 
28
#else
 
29
      data stack, heap /1200000, 800000/
 
30
#endif
 
31
c
 
32
#include "mp3.fh"
 
33
      if(.not. ga_uses_ma())then
 
34
         stack = 10000 
 
35
         heap  = 10000 
 
36
      endif
 
37
c
 
38
      if(ma_init(MT_F_DBL, stack, heap) ) then
 
39
        call ga_initialize()
 
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=10000)
 
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 dilo,dihi,djlo,djhi
 
73
      integer gilo,gihi,gjlo,gjhi
 
74
      integer ielem, jelem
 
75
      integer me, nproc
 
76
      integer index, ld
 
77
      integer iran
 
78
      logical status
 
79
      integer util_mdtob
 
80
      external  drand
 
81
      external util_mdtob
 
82
      intrinsic int, dble
 
83
      iran(i) = int(drand(0)*dble(i-1)) + 1
 
84
c    
 
85
      loop  = 30
 
86
      req = -1
 
87
      nproc = ga_nnodes()
 
88
      me    = ga_nodeid()
 
89
c    
 
90
      if (me.eq.0) print *, 'creating global arrays ',n,' x',n
 
91
      if (me.eq.0)call ffflush(6)
 
92
      call ga_sync()
 
93
      if(.not. ga_create(MT_DBL, n, n, 'a', 1, 1, g_a))
 
94
     &         call ga_error('ga_create failed: a', 0)
 
95
      if(.not. ga_create(MT_DBL, n, n, 'b', 1, 1, g_b))
 
96
     &         call ga_error('ga_create failed: b', 0)
 
97
      if (me.eq.0) print *,'done '
 
98
      if (me.eq.0)call ffflush(6)
 
99
c
 
100
c     initialize g_a, g_b with random values
 
101
c     ... use ga_access to avoid allocating local buffers for ga_put
 
102
c
 
103
      call ga_sync()
 
104
      call ga_distribution(g_a, me, gilo,gihi,gjlo,gjhi)
 
105
      call ga_access(g_a, gilo,gihi,gjlo,gjhi, index, ld)
 
106
      call fill_random(DBL_MB(index), gihi-gilo+1, gjhi-gjlo+1, ld)
 
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
      if(dra_create(MT_DBL, n, n, 'A', FNAME, 
 
118
     &      DRA_RW, n, n, d_a).ne.0)
 
119
     $   CALL ga_error('dra_create failed: ',0)
 
120
c
 
121
      if(me.eq.0) print *, 'alligned blocking write'
 
122
      if (me.eq.0)call ffflush(6)
 
123
      tt0 = MP_TIMER()
 
124
      if(dra_write(g_a, d_a,req).ne.0)
 
125
     $   CALL ga_error('dra_write failed:',0)
 
126
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
 
127
      tt1 = MP_TIMER() -tt0
 
128
      mbytes = 1e-6*util_mdtob(n*n)
 
129
      if (me.eq.0)then
 
130
          write(6,100)mbytes,tt1,mbytes/tt1
 
131
      endif
 
132
c
 
133
      if(dra_close(d_a).ne.0)call ga_error('dra_close failed: ',d_a)
 
134
      tt1 = MP_TIMER() -tt0
 
135
      if (me.eq.0)then
 
136
          write(6,100)mbytes,tt1,mbytes/tt1
 
137
      endif
 
138
c
 
139
      if (me.eq.0) print *,' '
 
140
      if (me.eq.0) print *,'disk array closed '
 
141
      if (me.eq.0)call ffflush(6)
 
142
c.......................................................................
 
143
c
 
144
c
 
145
      if (me.eq.0) print *, 'creating disk array ',m,' x',m
 
146
      if (me.eq.0)call ffflush(6)
 
147
      if(dra_create(MT_DBL, m, m, 'A', FNAME1,
 
148
     &      DRA_RW, n, n, d_b).ne.0)
 
149
     $   CALL ga_error('dra_create failed: ',0)
 
150
c
 
151
      if(me.eq.0) print *, 'non alligned blocking write'
 
152
      if (me.eq.0)call ffflush(6)
 
153
c
 
154
      gilo =1 
 
155
      gjlo =1 
 
156
      gihi =n
 
157
      gjhi =n
 
158
      tt0 = MP_TIMER()
 
159
      if(dra_write_section(.false.,     g_a, gilo, gihi, gjlo, gjhi,
 
160
     &               d_b, gilo+1, gihi+1, gjlo+1, gjhi+1, req).ne.0)
 
161
     &         call  ga_error('dra_write_section failed:',0)
 
162
 
 
163
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
 
164
      tt1 = MP_TIMER() -tt0
 
165
      mbytes = 1e-6*util_mdtob(n*n)
 
166
      if (me.eq.0)then
 
167
          write(6,100)mbytes,tt1,mbytes/tt1
 
168
      endif
 
169
c
 
170
      if(dra_close(d_b).ne.0)call ga_error('dra_close failed: ',d_b)
 
171
      tt1 = MP_TIMER() -tt0
 
172
      if (me.eq.0)then
 
173
          write(6,100)mbytes,tt1,mbytes/tt1
 
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 *,' '
 
183
      if (me.eq.0) print *,'opening disk array'
 
184
      if(dra_open(FNAME,DRA_R, d_a).ne.0)
 
185
     &            call ga_error('dra_open failed',0)
 
186
      if(me.eq.0) print *, 'alligned blocking read'
 
187
      if (me.eq.0)call ffflush(6)
 
188
      tt0 = MP_TIMER()
 
189
      if(dra_read(g_b, d_a, req).ne.0)
 
190
     $   CALL ga_error('dra_read failed:',0)
 
191
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
 
192
      tt1 = MP_TIMER() -tt0
 
193
      if (me.eq.0)then
 
194
          write(6,100)mbytes,tt1,mbytes/tt1
 
195
      endif
 
196
      call ga_dadd(1d0, g_a, -1d0, g_b, g_b)
 
197
      err = ga_ddot(g_b, g_b)
 
198
      if(err.ne.0) then
 
199
          if (me.eq.0) print *,'BTW, we have error =', err
 
200
          call ga_print(g_b) 
 
201
      else
 
202
          if (me.eq.0) print *,'OK'
 
203
      endif
 
204
      if(dra_delete(d_a).ne.0)
 
205
     &            call ga_error('dra_delete failed',0)
 
206
c.......................................................................
 
207
c
 
208
      if (me.eq.0) print *,' '
 
209
      if (me.eq.0) print *,'opening disk array'
 
210
      if(dra_open(FNAME1,DRA_R, d_b).ne.0)
 
211
     &            call ga_error('dra_open failed',0)
 
212
      if(me.eq.0) print *, 'non alligned blocking read'
 
213
      if (me.eq.0)call ffflush(6)
 
214
      gilo =1 
 
215
      gjlo =1 
 
216
      gihi =n
 
217
      gjhi =n
 
218
      tt0 = MP_TIMER()
 
219
      if(dra_read_section(.false.,   g_b, gilo, gihi, gjlo, gjhi,
 
220
     &               d_b, gilo+1, gihi+1, gjlo+1, gjhi+1, req).ne.0)
 
221
     &        call   ga_error('dra_read_section failed:',0)
 
222
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
 
223
      tt1 = MP_TIMER() -tt0
 
224
      if (me.eq.0)then
 
225
          write(6,100)mbytes,tt1,mbytes/tt1
 
226
      endif
 
227
      call ga_dadd(1d0, g_a, -1d0, g_b, g_b)
 
228
      err = ga_ddot(g_b, g_b)
 
229
      if(err.ne.0) then
 
230
          if (me.eq.0) print *,'BTW, we have error =', err
 
231
      else
 
232
          if (me.eq.0) print *,'OK'
 
233
      endif
 
234
      if(dra_delete(d_b).ne.0)
 
235
     &            call ga_error('dra_delete failed',0)
 
236
c.......................................................................
 
237
      status = ga_destroy(g_a)
 
238
      status = ga_destroy(g_b)
 
239
100   format(g11.2,' MB  time=',g11.2,' rate=',g11.3,'MB/s')
 
240
      end
 
241
 
 
242
 
 
243
 
 
244
      subroutine swap(a,b)
 
245
      integer a, b, temp
 
246
         temp = a
 
247
         a = b
 
248
         b = temp
 
249
      end
 
250
 
 
251
 
 
252
      subroutine init_char(str, len, char)
 
253
      character*(*) str
 
254
      character*1 char
 
255
      integer i
 
256
      do i = 1, len -1 
 
257
         str(i:i+1) = char
 
258
      enddo
 
259
      end
 
260
          
 
261
      
 
262
      subroutine fill_random(a, n,m, ld)
 
263
      integer ld, n,m
 
264
      double precision a(ld,*), drand, seed
 
265
      integer i,j
 
266
      external  drand
 
267
c
 
268
      do j=1,m
 
269
         seed = drand(j)
 
270
         do i=1,n
 
271
            a(i,j)=seed*i
 
272
         enddo
 
273
      enddo
 
274
      end