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