1      subroutine dimqm_EqmN(rtdb, geom, xyz, eqmn)
2c      use constants
3      implicit none
4#include "errquit.fh"
5#include "inp.fh"
6#include "rtdb.fh"
7#include "stdio.fh"
8#include "nwc_const.fh"
9#include "mafdecls.fh"
10#include "global.fh"
11#include "testutil.fh"
12#include "geom.fh"
13#include "dimqm_constants.fh"
14#include "dimqm.fh"
15#include "msgids.fh"
16c
17c      Input Variables
18      integer rtdb
19      integer geom
20      double precision xyz(3, nDIM)
21      double precision eqmn(3, nDIM)
22c
23c      Local Variables
24      integer mLo, mUp, mOnNode, id
25      integer nNuc
26      integer l_qmxyz, k_qmxyz
27      integer l_qmchrg, k_qmchrg
28      integer m, n
29c
30      id = ga_nodeid()
31      if(id.eq.0 .and. ldebug) write(luout,*) "Start EqmN"
32c
33c      Pull in QM geometry data
34      if(.not. geom_ncent(geom, nNuc))
35     $  call errquit("dimqm_EqmN: geom_ncent", 1, GEOM_ERR)
36c
37c      Allocate memory for coords and charges
38      if(.not.ma_push_get(mt_dbl,3*nNuc,'QM xyz',l_qmxyz,k_qmxyz))
39     $  call errquit("dimqm_EqmN malloc k_qmxyz failed", 1, MA_ERR)
40      if(.not.ma_push_get(mt_dbl,nNuc,'QM chrg',l_qmchrg,k_qmchrg))
41     $  call errquit("dimqm_EqmN malloc k_qmchrg failed", 1, MA_ERR)
42c
43c      Populate the arrays
44      if(.not.geom_cart_coords_get(geom, dbl_mb(k_qmxyz)))
45     $  call errquit("dimqm_EqmN coords get failed", 1, GEOM_ERR)
46      if(.not.geom_cart_get_charges(geom,nNuc,dbl_mb(k_qmchrg)))
47     $  call errquit("dimqm_EqmN charges get failed", 1, GEOM_ERR)
48c
49c      Determine load balance
50      call pphilo(id, nDIM, mLo, mUp, mOnNode)
51c
52      do m = mLo, mUp ! Loop over DIM atoms on this node
53        do n = 1, nNuc ! Loop over all QM atoms
54c
55c         Calculate potential
56          call dimqm_fldpot(xyz(:,m), dbl_mb(k_qmxyz+3*(n-1)),
57     $                      dbl_mb(k_qmchrg+n-1), eqmn(:,m))
58        end do
59      end do
60c      write(luout,*) "EqmN:"
61c      write(luout,*) eqmn
62      call ga_dgop(msg_dimqm, eqmn, 3*nDIM, '+')
63      call ga_sync()
64c
65c      Deallocate memory
66      if(.not.ma_chop_stack(l_qmxyz))
67     $  call errquit('dimqm_EqmN chop failed', 1, MA_ERR)
68c
69      if(id.eq.0 .and. ldebug) write(luout,*) "End EqmN"
70      end subroutine dimqm_EqmN
71