← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/tools/ga-5-1/global/testing/ngatest_src/ndim_NGA_PERIODIC_ACC.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-5-1/global/testing/ngatest_src/ndim_NGA_PERIODIC_ACC.src
 
1
      subroutine m4_func_NGA_PERIODIC_ACC(m4_test_type, m4_ndim)
 
2
      implicit none
 
3
#include "mafdecls.fh"
 
4
#include "global.fh"
 
5
c     
 
6
      integer n
 
7
      integer ndim
 
8
      parameter (n = m4_n)
 
9
      parameter (ndim = m4_ndim)
 
10
      m4_data_type a(substr(m4_array, 1, eval(m4_ndim*2-1)))
 
11
      m4_data_type b(substr(m4_array, 1, eval(m4_ndim*2-1)))
 
12
      m4_data_type c(substr(m4_array, 1, eval(m4_ndim*2-1)))
 
13
      integer lo(ndim),hi(ndim),lop(ndim),hip(ndim)
 
14
      integer blo(ndim),bhi(ndim)
 
15
      integer dims(ndim),ld(ndim)
 
16
      integer g_a
 
17
      integer chunk(ndim)
 
18
      integer i,total,loop
 
19
      m4_data_type alpha
 
20
      double precision drand
 
21
      integer nproc, me
 
22
      logical status
 
23
c     
 
24
      nproc = ga_nnodes()
 
25
      me    = ga_nodeid()
 
26
c     
 
27
c---------------------- initialize the GA -----------------------
 
28
c     initialize the chunk, dims, ld, and calculate the number 
 
29
c     of elements
 
30
      total=1
 
31
      do i = 1,ndim
 
32
         chunk(i) = 0
 
33
         dims(i) = n
 
34
         ld(i) = n
 
35
      enddo
 
36
c
 
37
c***  Create global arrays
 
38
      if (.not. nga_create(m4_MT, ndim, dims, 'a', chunk, g_a))
 
39
     $     call ga_error(' ga_create failed ',1)
 
40
c     
 
41
      call ga_sync()
 
42
c
 
43
c------------------------ NGA_PERIODIC_ACC ----------------------
 
44
      m4_print_info(nga_periodic_acc)
 
45
c
 
46
      total = 1
 
47
      do i = 1,ndim
 
48
         lo(i) = 1
 
49
         hi(i) = n
 
50
         total = total*dims(i)
 
51
      enddo
 
52
c
 
53
      call m4_util_init_array(m4_test_type)(a,total)
 
54
      call m4_util_init_array(m4_test_type)(b,total)
 
55
c
 
56
c     initialize array g_a
 
57
      call ga_fill(g_a,m4_conv(123))
 
58
      call ga_sync()
 
59
c
 
60
      alpha = m4_rand(me*2+1)
 
61
c
 
62
      do loop = 1, MAXLOOP 
 
63
         if(mod(loop,nproc).eq.me) then
 
64
            call random_range_outbound(lo,hi,lop,hip,ndim)
 
65
            if(Mod(loop,10).eq.0) then
 
66
               call print_range(loop,lop,hip,ndim)
 
67
            endif
 
68
            call ga_init_fence()
 
69
c           keep a copy of the original patch
 
70
            call nga_periodic_put(g_a,lop,hip,
 
71
     $           b(substr(m4_lo_all,1,eval(m4_ndim*6-1))),ld)
 
72
            call ga_fence()
 
73
            call ga_init_fence()
 
74
            call nga_periodic_acc(g_a,lop,hip,
 
75
     $           a(substr(m4_lo_all,1,eval(m4_ndim*6-1))),ld,alpha)
 
76
            call ga_fence()
 
77
            call ga_init_fence()
 
78
            call nga_periodic_get(g_a,lop,hip,
 
79
     $           c(substr(m4_lo_all,1,eval(m4_ndim*6-1))),ld)
 
80
            call ga_fence()
 
81
c     
 
82
c           check the result
 
83
            do i=1,ndim
 
84
               blo(i) = 1
 
85
               bhi(i) = hip(i)-lop(i)+1
 
86
            enddo
 
87
c           scale the local copy of array            
 
88
            call m4_util_scale_patch(m4_test_type)(total,
 
89
     $        m4_conv(1),b,blo,bhi,ndim,dims,
 
90
     $        alpha,a,blo,bhi,ndim,dims)             
 
91
            call m4_util_compare_patches(m4_test_type)(1d-2,
 
92
     $           total,b,blo,bhi,ndim,dims,total,c,blo,bhi,ndim,dims)
 
93
         endif
 
94
         call ga_sync()
 
95
      enddo
 
96
c
 
97
      call ga_sync()
 
98
      if(me.eq.0)then
 
99
         print *, 'OK'
 
100
         print *, ' '
 
101
         call ffflush(6)
 
102
      endif
 
103
c---------------------------
 
104
c     
 
105
      status= ga_destroy(g_a)
 
106
      end