← Back to branch summary

~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to src/tools/ga-4-3/global/testing/ngatest_src/ndim_NGA_ADD_PATCH.src

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-02-09 20:02:41 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120209200241-jgk03qfsphal4ug2
Tags: 6.1-1
http://bugs.debian.org/632611
https://launchpad.net/bugs/791308
* New upstream release.

[ Michael Banck ]
* debian/patches/02_makefile_flags.patch: Updated.
* debian/patches/02_makefile_flags.patch: Use internal blas and lapack code.
* debian/patches/02_makefile_flags.patch: Define GCC4 for LINUX and LINUX64
  (Closes: #632611 and LP: #791308).
* debian/control (Build-Depends): Added openssh-client.
* debian/rules (USE_SCALAPACK, SCALAPACK): Removed variables (Closes:
  #654658).
* debian/rules (LIBDIR, USE_MPIF4, ARMCI_NETWORK): New variables.
* debian/TODO: New file.
* debian/control (Build-Depends): Removed libblas-dev, liblapack-dev and
  libscalapack-mpi-dev.
* debian/patches/04_show_testsuite_diff_output.patch: New patch, shows the
  diff output for failed tests.
* debian/patches/series: Adjusted.
* debian/testsuite: Optionally run all tests if "all" is passed as option.
* debian/rules: Run debian/testsuite with "all" if DEB_BUILD_OPTIONS
  contains "checkall".

[ Daniel Leidert ]
* debian/control: Used wrap-and-sort. Added Vcs-Svn and Vcs-Browser fields.
  (Priority): Moved to extra according to policy section 2.5.
  (Standards-Version): Bumped to 3.9.2.
  (Description): Fixed a typo.
* debian/watch: Added.
* debian/patches/03_hurd-i386_define_path_max.patch: Added.
  - Define MAX_PATH if not defines to fix FTBFS on hurd.
* debian/patches/series: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/tools/ga-4-3/global/testing/ngatest_src/ndim_NGA_ADD_PATCH.src
 
1
      subroutine m4_func_NGA_ADD_PATCH(m4_test_type, m4_ndim)
 
2
      implicit none
 
3
#include "mafdecls.fh"
 
4
#include "global.fh"
 
5
c     
 
6
      integer n,m
 
7
      integer ndim
 
8
      parameter (n = m4_n)
 
9
      parameter (m = (m4_n**m4_ndim)/100)
 
10
      parameter (ndim = m4_ndim)
 
11
      m4_data_type a(substr(m4_array, 1, eval(m4_ndim*2-1)))
 
12
      m4_data_type b(substr(m4_array, 1, eval(m4_ndim*2-1)))
 
13
      integer dims(ndim)
 
14
      integer g_a, g_b,g_c
 
15
      integer chunk(ndim)
 
16
      integer i, total
 
17
      integer elems, count_elems      
 
18
      integer loop
 
19
      double precision util_drand
 
20
      m4_data_type alpha, beta
 
21
      integer lop(ndim), hip(ndim), hipl(ndim)
 
22
      integer alo(ndim), ahi(ndim)
 
23
      integer blo(ndim), bhi(ndim)
 
24
      integer clo(ndim), chi(ndim)
 
25
c     for different array dimensions
 
26
      ifelse(m4_ndim,1,`',`
 
27
      m4_data_type d(substr(m4_array, 1, eval((m4_ndim-1)*2-1)))
 
28
      integer dndim
 
29
      parameter (dndim = m4_ndim-1)
 
30
      integer ddims(dndim),dlo(dndim),dhi(dndim),dtotal
 
31
      ')
 
32
c
 
33
      integer nproc, me
 
34
      logical status
 
35
      integer repeat
 
36
c     
 
37
      nproc = ga_nnodes()
 
38
      me    = ga_nodeid()
 
39
c     
 
40
c---------------------- initialize the GA -----------------------
 
41
c     initialize the chunk, dims, ld, and calculate the number 
 
42
c     of elements
 
43
      total=1
 
44
      do i = 1,ndim
 
45
         chunk(i) = 0
 
46
         dims(i) = n
 
47
         total = total * dims(i)
 
48
      enddo
 
49
c
 
50
c***  Create global arrays
 
51
      if (.not. nga_create(m4_MT, ndim, dims, 'a', chunk, g_a))
 
52
     $     call ga_error(' ga_create failed ',1)
 
53
c
 
54
c     test the same distribution and different distribution seperately
 
55
      do repeat=1,2
 
56
         if(repeat.eq.1) then
 
57
            status = ga_duplicate(g_a, g_b, 'a_duplicated')
 
58
            if(.not.ga_compare_distr(g_a, g_b))
 
59
     $           call ga_error("g_b distribution different",0)
 
60
c            
 
61
            status = ga_duplicate(g_a, g_c, 'a_duplicated_again')
 
62
            if(.not.ga_compare_distr(g_a, g_c))
 
63
     $           call ga_error("g_c distribution different",0)
 
64
c
 
65
         else
 
66
            do i = 1,ndim
 
67
               if(mod(i,2).eq.0) chunk(i) = n
 
68
            enddo
 
69
            if (.not. nga_create(m4_MT, ndim, dims, 'b', chunk, g_b))
 
70
     $           call ga_error(' ga_create failed ',1)
 
71
            do i = 1,ndim
 
72
               if(mod(i,2).eq.0) chunk(i) = 0
 
73
               if(mod(i,2).eq.1) chunk(i) = n
 
74
            enddo
 
75
            if (.not. nga_create(m4_MT, ndim, dims, 'c', chunk, g_c))
 
76
     $           call ga_error(' ga_create failed ',1)
 
77
         endif
 
78
c
 
79
         call ga_sync()
 
80
c     
 
81
c---------------------------NGA_ADD_PATCH -------------------------
 
82
c
 
83
      if(repeat.eq.1) then
 
84
         m4_print_info(nga_add_patch)
 
85
         if(me.eq.0) print *, 'Testing with the same distributions'
 
86
      else
 
87
         if(me.eq.0) print *, 'Testing with different distributions'
 
88
      endif
 
89
c     
 
90
c     initialize GA
 
91
      call m4_util_init_array(m4_test_type)(a,total)
 
92
      call nga_distribution(g_a, me, lop, hip)
 
93
      elems = count_elems(lop, hip, ndim)
 
94
      if(elems.gt.0) call nga_put(g_a,lop,hip,
 
95
     $     a(substr(m4_lop_all, 1, eval(m4_ndim*7-1))),dims)
 
96
      call m4_util_init_array(m4_test_type)(b,total)
 
97
      call nga_distribution(g_b, me, lop, hip)
 
98
      elems = count_elems(lop, hip, ndim)
 
99
      if(elems.gt.0) call nga_put(g_b,lop,hip,
 
100
     $     b(substr(m4_lop_all, 1, eval(m4_ndim*7-1))),dims)
 
101
c     
 
102
      call ga_sync()
 
103
      do i = 1,ndim
 
104
         lop(i) = 1
 
105
         hipl(i) = n-2
 
106
         hip(i) = n
 
107
      enddo
 
108
c     
 
109
c---  
 
110
      do loop=1, 10
 
111
         call random_range(lop,hipl,alo,ahi,ndim)
 
112
         do i=1, ndim
 
113
            blo(i) = alo(i) + 1
 
114
            bhi(i) = ahi(i) + 1
 
115
            clo(i) = alo(i) + 2
 
116
            chi(i) = ahi(i) + 2
 
117
         enddo
 
118
         if(me.eq.0)then
 
119
            call add_range(loop,alo,ahi,ndim,blo,bhi,ndim)
 
120
c$$$            print *, loop,': [',(alo(i),':',ahi(i), i=1,ndim),']', 
 
121
c$$$     $           '+', '[',(blo(i),':',bhi(i), i=1,ndim),']'
 
122
         endif
 
123
c
 
124
         alpha = m4_rand(1)
 
125
         beta = m4_rand(1)
 
126
c
 
127
c        keep copies of the origian arrays
 
128
         call nga_get(g_a,alo,ahi,
 
129
     $        a(substr(m4_alo_all, 1, eval(m4_ndim*7-1))),dims)
 
130
         call nga_get(g_b,blo,bhi,
 
131
     $        b(substr(m4_blo_all, 1, eval(m4_ndim*7-1))),dims)
 
132
c        the result should be (in a)
 
133
         call m4_util_scale_patch(m4_test_type)(total,
 
134
     $        alpha,a,alo,ahi,ndim,dims,
 
135
     $        beta,b,blo,bhi,ndim,dims)
 
136
c
 
137
         call nga_add_patch(alpha, g_a, alo, ahi, beta, g_b, blo, bhi,
 
138
     $                         g_c, clo,chi)
 
139
c     
 
140
         call nga_get(g_c,clo,chi,
 
141
     $        b(substr(m4_clo_all, 1, eval(m4_ndim*7-1))),dims)
 
142
c     
 
143
         call m4_util_compare_patches(m4_test_type)(1d-5,total,
 
144
     $        a,alo,ahi,ndim,dims,total,b,clo,chi,ndim,dims)
 
145
      enddo
 
146
c     
 
147
      call ga_sync()
 
148
      if(me.eq.0)then
 
149
         print *, 'OK'
 
150
         print *, ' '
 
151
         call ffflush(6)
 
152
      endif
 
153
c---------------------------
 
154
c     
 
155
         status = ga_destroy(g_b)
 
156
      enddo
 
157
c-----------------------------------------------------------------
 
158
      changequote({,})
 
159
      ifelse(m4_ndim,1,{},{
 
160
c     testing copy on differet dimensions
 
161
      dtotal = 1
 
162
      do i = 1,dndim
 
163
         ddims(i) = n
 
164
         dtotal = dtotal * ddims(i)
 
165
      enddo
 
166
c     
 
167
      if (.not. nga_create(m4_MT, dndim, ddims, 'd', chunk, g_b))
 
168
     $     call ga_error(' ga_create failed ',1)
 
169
c     
 
170
      if(me.eq.0) 
 
171
     $     print *, 'Testing adding patch on different dimensions'
 
172
c     
 
173
      call ga_sync()
 
174
c     
 
175
c     initialize g_b
 
176
      call m4_util_init_array(m4_test_type)(d,dtotal)
 
177
      call nga_distribution(g_b, me, dlo, dhi)
 
178
      elems = count_elems(dlo, dhi, dndim)
 
179
      if(elems.gt.0) call nga_put(g_b,dlo,dhi,
 
180
     $     d(substr(m4_dlo_all, 1, eval((m4_ndim-1)*7-1))),ddims)
 
181
c
 
182
c     calculate the maximum range of g_a that can fit into g_b
 
183
      do i = 1,ndim
 
184
         lop(i) = 1
 
185
         hip(i) = n
 
186
      enddo
 
187
      hip(dndim) = 1
 
188
c     
 
189
      call ga_sync()
 
190
c
 
191
      do loop=1, 10
 
192
         call random_range(lop,hip,alo,ahi,ndim)
 
193
c     
 
194
         do i=1, dndim
 
195
            dlo(i) = alo(dndim-i+1)
 
196
            dhi(i) = ahi(dndim-i+1)
 
197
         enddo
 
198
         dlo(1) = alo(ndim)
 
199
         dhi(1) = ahi(ndim)
 
200
c     
 
201
         if(me.eq.0) then
 
202
            call add_range(loop,alo,ahi,ndim,dlo,dhi,dndim)
 
203
c$$$            print *, loop,': [',(alo(i),':',ahi(i), i=1,ndim),']', 
 
204
c$$$     $           '+', '[',(dlo(i),':',dhi(i), i=1,dndim),']'
 
205
         endif
 
206
c     
 
207
         alpha = m4_rand(1)
 
208
         beta = m4_rand(1)
 
209
c     
 
210
c     keep copies of the origian arrays
 
211
         call nga_get(g_a,alo,ahi,
 
212
     $        a(substr(m4_alo_all, 1, eval(m4_ndim*7-1))),dims)
 
213
         call nga_get(g_b,dlo,dhi,
 
214
     $        d(substr(m4_dlo_all, 1, eval((m4_ndim-1)*7-1))),ddims)
 
215
c     
 
216
c     the result should be (in a)
 
217
         call m4_util_scale_patch(m4_test_type)(total,
 
218
     $        alpha,a,alo,ahi,ndim,dims,
 
219
     $        beta,d,dlo,dhi,dndim,ddims)
 
220
c     
 
221
         call nga_add_patch(alpha,g_a,alo,ahi,beta,g_b,dlo,dhi,
 
222
     $        g_c,alo,ahi)
 
223
c     
 
224
         call nga_get(g_c,alo,ahi,
 
225
     $        b(substr(m4_alo_all, 1, eval(m4_ndim*7-1))),dims)
 
226
c     
 
227
         call m4_util_compare_patches(m4_test_type)(1d-5,total,
 
228
     $        a,alo,ahi,ndim,dims,total,b,alo,ahi,ndim,dims)
 
229
      enddo
 
230
c     
 
231
      call ga_sync()
 
232
      if(me.eq.0)then
 
233
         print *, '  add patches on different dimensions: OK'
 
234
         print *, ' '
 
235
         call ffflush(6)
 
236
      endif            
 
237
c     
 
238
      status = ga_destroy(g_b)
 
239
      })
 
240
      changequote(`,')
 
241
c---  
 
242
c     
 
243
      status = ga_destroy(g_c)
 
244
      status = ga_destroy(g_a)
 
245
      end