← 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_PUT.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_PUT.src
 
1
      subroutine m4_func_NGA_PUT(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 lo(ndim),hi(ndim),dims(ndim),ld(ndim)
 
14
      integer g_a
 
15
      integer chunk(ndim)
 
16
      integer i, total, loop
 
17
      integer lop(ndim),hip(ndim)
 
18
      integer elems, count_elems
 
19
      integer nproc, me
 
20
      integer proc
 
21
      logical status
 
22
c     
 
23
      nproc = ga_nnodes()
 
24
      me    = ga_nodeid()
 
25
c     
 
26
c---------------------- initialize the GA -----------------------
 
27
c     initialize the chunk, dims, ld, and calculate the number 
 
28
c     of elements
 
29
      total=1
 
30
      do i = 1,ndim
 
31
         chunk(i) = 0
 
32
         dims(i) = n
 
33
         ld(i) = n
 
34
         total = total * dims(i)
 
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_PUT ----------------------------
 
44
      m4_print_info(nga_put)
 
45
c
 
46
      proc =  nproc-1 -me       ! access other process memory 
 
47
      call nga_distribution(g_a, proc, lo,hi)
 
48
      elems = count_elems(lo,hi,ndim)
 
49
      call m4_util_init_array(m4_test_type)(a,total)
 
50
c
 
51
      call ga_sync()
 
52
      if(elems.gt.0) then
 
53
         call nga_put(g_a,lo,hi,
 
54
     $        a(substr(m4_lo_all, 1, eval(m4_ndim*6-1))),ld)
 
55
         do loop = 1, MAXLOOP 
 
56
            call random_range(lo,hi,lop,hip,ndim)
 
57
            if(me.eq.0 .and. Mod(loop,10).eq.0)then
 
58
               call print_range(loop,lop,hip,ndim)
 
59
            endif
 
60
            call nga_put(g_a,lop,hip,
 
61
     $           a(substr(m4_lop_all, 1, eval(m4_ndim*7-1))),ld)
 
62
         enddo
 
63
         
 
64
         call nga_get(g_a,lo,hi,
 
65
     $        b(substr(m4_lo_all, 1, eval(m4_ndim*6-1))),ld)
 
66
c
 
67
         call m4_util_compare_patches(m4_test_type)(0d0,total,
 
68
     $        a,lo,hi,ndim,dims,total,b,lo,hi,ndim,dims)
 
69
      else
 
70
c     so that the random_range can be call the same number of times
 
71
c     in other words, util_drand can generate the same number for the
 
72
c     collective operations
 
73
         do loop=1, MAXLOOP
 
74
            call random_range(lo,hi,lop,hip,ndim)
 
75
         enddo
 
76
      endif
 
77
c
 
78
      call ga_sync()
 
79
      if(me.eq.0)then
 
80
         print *, 'OK'
 
81
         print *, ' '
 
82
         call ffflush(6)
 
83
      endif
 
84
c---------------------------
 
85
c     
 
86
      status= ga_destroy(g_a)
 
87
      end