      subroutine m4_func_NGA_DOT_PATCH(m4_test_type, m4_ndim)
      implicit none
#include "mafdecls.fh"
#include "global.fh"
c     
      integer n,m
      integer ndim
      parameter (n = m4_n)
      parameter (m = (m4_n**m4_ndim)/100)
      parameter (ndim = m4_ndim)
      m4_data_type a(substr(m4_array, 1, eval(m4_ndim*2-1)))
      m4_data_type b(substr(m4_array, 1, eval(m4_ndim*2-1)))
      m4_data_type c(substr(m4_array, 1, eval(m4_ndim*2-1)))
      integer dims(ndim)
      integer g_a, g_b
      integer chunk(ndim)
      integer i, total
      integer elems, count_elems
      integer loop
      integer lop(ndim), hip(ndim), hipl(ndim)
      integer alo(ndim), ahi(ndim)
      integer blo(ndim), bhi(ndim)
      integer tlo(ndim), thi(ndim)
      m4_data_type alpha, beta
      m4_data_type m4_util_dot_patch(m4_test_type)
c     for different array dimensions
      ifelse(m4_ndim,1,`',`
      m4_data_type d(substr(m4_array, 1, eval((m4_ndim-1)*2-1)))
      integer dndim
      parameter (dndim = m4_ndim-1)
      integer ddims(dndim),dlo(dndim),dhi(dndim),dtotal
      ')
c      
      integer nproc, me
      logical status
      integer repeat
c     
      nproc = ga_nnodes()
      me    = ga_nodeid()
c     
c---------------------- initialize the GA -----------------------
c     initialize the chunk, dims, ld, and calculate the number 
c     of elements
      total=1
      do i = 1,ndim
         chunk(i) = 0
         dims(i) = n
         total = total * dims(i)
      enddo
c
c***  Create global arrays
      if (.not. nga_create(m4_MT, ndim, dims, 'a', chunk, g_a))
     $     call ga_error(' ga_create failed ',1)
c
c     test the same distribution and different distribution seperately
      do repeat=1,2
         if(repeat.eq.1) then
            status = ga_duplicate(g_a, g_b, 'a_duplicated')
            if(.not.ga_compare_distr(g_a, g_b))
     $           call ga_error("g_b distribution different",0)
c
         else
            do i = 1,ndim
               if(mod(i,2).eq.0) chunk(i) = n
            enddo
            if (.not. nga_create(m4_MT, ndim, dims, 'b', chunk, g_b))
     $           call ga_error(' ga_create failed ',1)
         endif
c
         call ga_sync()
c     
c---------------------------NGA_DOT_PATCH -------------------------
c
      if(repeat.eq.1) then
         m4_print_info(m4_nga_dot_patch(m4_dot))
         if(me.eq.0) print *, 'Testing with the same distributions'
      else
         if(me.eq.0) print *, 'Testing with different distributions'
      endif
c     
c     initialize GA
      call m4_util_init_array(m4_test_type)(a,total)
      call nga_distribution(g_a, me, lop, hip)
      elems = count_elems(lop, hip, ndim)
      if(elems.gt.0) call nga_put(g_a,lop,hip,
     $     a(substr(m4_lop_all, 1, eval(m4_ndim*7-1))),dims)
      call m4_util_init_array(m4_test_type)(b,total)
      call nga_distribution(g_b, me, lop, hip)
      elems = count_elems(lop, hip, ndim)
      if(elems.gt.0) call nga_put(g_b,lop,hip,
     $     b(substr(m4_lop_all, 1, eval(m4_ndim*7-1))),dims)
c     
      call ga_sync()
      do i = 1,ndim
         lop(i) = 1
         hipl(i) = n-1
         hip(i) = n
      enddo
c     
c---  
      do loop=1, 10
         call random_range(lop,hipl,alo,ahi,ndim)
         do i=1, ndim
            blo(i) = alo(i) + 1
            bhi(i) = ahi(i) + 1
         enddo
         if(me.eq.0)then
            call dot_range(loop,alo,ahi,ndim,blo,bhi,ndim)
c$$$            print *, loop,'dot: [',(alo(i),':',ahi(i), i=1,ndim),']', 
c$$$     $           ',', '[',(blo(i),':',bhi(i), i=1,ndim),']'
         endif
c
         alpha=m4_nga_dot_patch(m4_dot)(g_a,'n',alo,ahi,g_b,'n',blo,bhi)
c
c        the result should be 
         beta = m4_util_dot_patch(m4_test_type)(total,
     $        a,alo,ahi,ndim,dims,b,blo,bhi,ndim,dims)
c     
         if(ABS(beta-alpha).gt.1d-6*ABS(alpha)) then
            print *,me, ' error ', beta, alpha
            call ga_error('exiting ...',0)
         endif
c
      enddo
c     
      call ga_sync()
      if(me.eq.0)then
         print *, ' without transpose OK'
         print *, ' '
         call ffflush(6)
      endif
c---  
c     prepare array a, make it transposed
      call m4_util_transpose(m4_test_type)(b,c,total,ndim,dims)
c
      do loop=1, 10
         call random_range(lop,hipl,alo,ahi,ndim)
         do i=1, ndim
            blo(i) = alo(i) + 1
            bhi(i) = ahi(i) + 1
         enddo
         if(me.eq.0)then
            call dot_range(loop,alo,ahi,ndim,blo,bhi,ndim)
c$$$            print *, loop,'dot: [',(alo(i),':',ahi(i), i=1,ndim),']', 
c$$$     $           ',', '[',(blo(i),':',bhi(i), i=1,ndim),']'
         endif
c
         alpha=m4_nga_dot_patch(m4_dot)(g_a,'n',alo,ahi,g_b,'t',blo,bhi)
c
c        adjust index of array a
         do i=1,ndim
            tlo(i) = blo(ndim-i+1)
            thi(i) = bhi(ndim-i+1)
         enddo
c     
c        the result should be 
         beta = m4_util_dot_patch(m4_test_type)(total,
     $        a,alo,ahi,ndim,dims,b,tlo,thi,ndim,dims)
c     
         if(ABS(beta-alpha).gt.1d-6*ABS(alpha)) then
            print *,me, ' error ', beta, alpha
            call ga_error('exiting ...',0)
         endif
c
      enddo
c     
      call ga_sync()
      if(me.eq.0)then
         print *, ' with transpose OK'
         print *, ' '
         call ffflush(6)
      endif
c---------------------------
c     
         status = ga_destroy(g_b)
      enddo
c
c-----------------------------------------------------------------
      changequote({,})
      ifelse(m4_ndim,1,{},{
c     testing copy on differet dimensions
      dtotal = 1
      do i = 1,dndim
         ddims(i) = n
         dtotal = dtotal * ddims(i)
      enddo
c     
      if (.not. nga_create(m4_MT, dndim, ddims, 'd', chunk, g_b))
     $     call ga_error(' ga_create failed ',1)
c     
      if(me.eq.0) 
     $     print *, 'Testing dot patch on different dimensions'
c     
c     initialize GAs
      call m4_util_init_array(m4_test_type)(a,total)
      call nga_distribution(g_a, me, lop, hip)
      elems = count_elems(lop, hip, ndim)
      if(elems.gt.0) call nga_put(g_a,lop,hip,
     $     a(substr(m4_lop_all, 1, eval(m4_ndim*7-1))),dims)
      call m4_util_init_array(m4_test_type)(d,dtotal)
      call nga_distribution(g_b, me, dlo, dhi)
      elems = count_elems(dlo, dhi, dndim)
      if(elems.gt.0) call nga_put(g_b,dlo,dhi,
     $     d(substr(m4_dlo_all, 1, eval((m4_ndim-1)*7-1))),ddims)
c     
      call ga_sync()
c     
c     calculate the maximum range of g_a that can fit into g_b
      do i = 1,ndim
         lop(i) = 1
         hip(i) = n
      enddo
      hip(dndim) = 1
c     
      do loop=1, 10
         call random_range(lop,hip,alo,ahi,ndim)
c     
         do i=1, dndim
            dlo(i) = alo(dndim-i+1)
            dhi(i) = ahi(dndim-i+1)
         enddo
         dlo(1) = alo(ndim)
         dhi(1) = ahi(ndim)
c     
         if(me.eq.0) then
            call dot_range(loop,alo,ahi,ndim,dlo,dhi,dndim)
c$$$            print *,loop,'dot: [',(alo(i),':',ahi(i), i=1,ndim),']', 
c$$$     $           ',', '[',(dlo(i),':',dhi(i), i=1,dndim),']'
         endif
c     
         alpha=m4_nga_dot_patch(m4_dot)(g_a,'n',alo,ahi,
     $        g_b,'n',dlo,dhi)
c     
c     the result should be 
         beta = m4_util_dot_patch(m4_test_type)(total,
     $        a,alo,ahi,ndim,dims,d,dlo,dhi,dndim,ddims)
c     
         if(ABS(beta-alpha).gt.1d-6*ABS(alpha)) then
            print *,me, ' error ', beta, alpha
            call ga_error('exiting ...',0)
         endif
c     
      enddo
c     
      call ga_sync()
      if(me.eq.0)then
         print *, '  dot patch on different dimensions: OK'
         print *, ' '
         call ffflush(6)
      endif            
c     
      status = ga_destroy(g_b)
      })
      changequote(`,')
c---  
      status = ga_destroy(g_a)
      end
