1      subroutine dft_3dacc(g_fock,buf,imat,imat2,
2     ,     ifirst,ilast,jfirst,jlast,ldin)
3C$Id$
4      implicit none
5      integer g_fock
6      integer imat,imat2
7      integer ldin
8      integer ifirst,ilast,jfirst,jlast
9      double precision buf(*)
10c
11      integer lo(3)  !array of starting indices for ga   [input]
12      integer hi(3)  !  array of ending indices for ga     [input]
13      integer ld(2) !array specifying leading dimensions for buffer
14      ld(1)=imat2-imat+1
15      ld(2)=ldin
16      lo(1)=imat
17      hi(1)=imat2
18      lo(2)=ifirst
19      hi(2)=ilast
20      lo(3)=jfirst
21      hi(3)=jlast
22      call nga_acc(g_fock, lo, hi, buf, ld, 1d0)
23      return
24      end
25      subroutine dft_3dget(g_fock,buf,imat,
26     ,     ifirst,ilast,jfirst,jlast,ldin)
27      implicit none
28#include "errquit.fh"
29      integer g_fock
30      integer imat
31      integer ldin
32      integer ifirst,ilast,jfirst,jlast
33      double precision buf(*)
34c
35      integer lo(3)  !array of starting indices for ga   [input]
36      integer hi(3)  !  array of ending indices for ga     [input]
37      integer ld(2) !array specifying leading dimensions for buffer
38#ifdef DEBUG
39      integer ityp, ndim, dims(3)
40      call nga_inquire(g_fock, ityp, ndim, dims)
41      if(ndim.ne.3) call errquit(' 3d3d3d ',ndim, GA_ERR)
42      write(6,*) ' 3dg imat ',imat
43      if(imat.lt.1) call errquit( ' imat neg ',imat, UNKNOWN_ERR)
44      if(imat.gt.dims(1)) call errquit(' imat gt dim1 ',imat,
45     &       UNKNOWN_ERR)
46      if(ilast.gt.dims(2)) call errquit(' il gt dim2 ',dims(2),
47     &       UNKNOWN_ERR)
48      if(jlast.gt.dims(3)) call errquit(' jl gt dim3 ',dims(3),
49     &       UNKNOWN_ERR)
50#endif
51      ld(1)=1
52      ld(2)=ldin
53      lo(1)=imat
54      hi(1)=imat
55      lo(2)=ifirst
56      hi(2)=ilast
57      lo(3)=jfirst
58      hi(3)=jlast
59      call nga_get(g_fock, lo, hi, buf, ld)
60      return
61      end
62