1      subroutine fock_j_fit(nmat, g_dens, g_j)
2c
3c     $Id$
4c
5c     Wrapper routine for AO-basis J matrices with fitting
6c
7c     BGJ - 2/99
8c
9      implicit none
10c
11      integer nmat              ! [input] number of J matrices
12      integer g_dens(nmat)      ! [input] array of handles to densities
13      integer g_j(nmat)         ! [input] array of handles to J matrices
14c
15c     Local declarations
16c
17      call fock_j_fit_gen(nmat, g_dens, g_j, 0d0, .false., .true.)
18c
19      return
20      end
21c
22c
23      subroutine fock_j_fit_gen(nmat, g_dens, g_j, Tvec, have_Tvec,
24     &     do_init)
25c
26c     $Id$
27c
28c     Wrapper routine for AO-basis J matrices with fitting
29c
30c     BGJ - 2/99
31c
32      implicit none
33#include "errquit.fh"
34c
35#include "global.fh"
36#include "mafdecls.fh"
37#include "../nwdft/include/cdft.fh"
38c!!! BGJ
39#include "bgj.fh"
40#include "rtdb.fh"
41c!!! BGJ
42c
43      integer nmat              ! [input] number of J matrices
44      integer g_dens(nmat)      ! [input] array of handles to densities
45      integer g_j(nmat)         ! [input] array of handles to J matrices
46      logical derfit            ! [input] whether derivative density fit
47c                               !  *** from rtdb
48c                               !  ******* !!! document here !!!
49      double precision Tvec(*)  ! [input] right side vectors for fits
50      logical have_Tvec         ! [input] whether right side vectors are given
51      logical do_init           ! [input] whether to zero J matrices
52c
53c     Local declarations
54c
55      integer imat
56      integer rtdb
57      integer ntotel, n_batch, n3c_int, n3c_dbl, iwhat_max,
58     &     n_semi_bufs, fd
59      integer l_cd_coef, k_cd_coef
60      integer idum
61      double precision Ecoul
62      double precision ddum
63      logical IOLGC, old_incore, old_direct
64c
65      if (bgj_print() .gt. 0)
66     &     write(*,*)'--------Entered fock_j_fit-------------'
67      rtdb = bgj_get_rtdb_handle()
68c      write(*,*)'nmat rtdb geom',nmat,rtdb,geom
69c
70c     Get fock_j_fit variables
71c
72      if (.not. rtdb_get(rtdb, 'fock_j:derfit', mt_log, 1,
73     &     derfit)) then
74         if (bgj_print() .gt. 0)
75     &      write(*,*)'*** fock_j_fit: derfit not set: setting to false'
76         derfit = .false.       !!!
77      endif
78      if (bgj_print() .gt. 0)
79     &     write(*,*)'fock_j_fit: derfit =',derfit
80c
81c     Initialize J matrices
82c
83c      write(*,*)'*** do_init',do_init
84      if (do_init) then
85         do imat = 1, nmat
86c     write(*,*)'Density matrix',imat
87c     call ga_print(g_dens(imat))
88c            write(*,*)'*** zeroing g_j'
89            call ga_zero(g_j(imat))
90         enddo
91      endif
92c
93c     Set up scratch space for dft_fitcd and dft_fitvc
94c
95      if (.not.MA_Push_Get(MT_Dbl,nbf_cd*nmat,'cd_coef',l_cd_coef,
96     &     k_cd_coef))
97     &     call errquit('fock_j_fit: cannot allocate cd_coef',0, MA_ERR)
98c
99c     Prepare to call fitting routines
100c
101      idum = -1
102      ddum = -1d0
103c!!! Set up for cdinv to be allocated in dft_cdfit
104      IOLGC = .true.
105      if (noio.eq.1)IOLGC = .FALSE.
106      if (ipol.eq.1)then
107         nTotEl = 2*noc(1)
108      else
109         nTotEl = noc(1) + noc(2)
110      endif
111c!!! Set things up for direct to begin with - can refine to semi-direct
112c!!! after things are working
113      old_incore = incore
114      old_direct = direct
115      incore = .false.          !!!
116      direct = .true.           !!!
117      n_batch = 0               !!!
118      n3c_int = 0               !!!
119      n3c_dbl = 0               !!!
120      fd = 0                    !!!
121      n_semi_bufs = 0           !!!
122      iwhat_max = -1            !!!
123c
124c     Determine the fitting coefficients
125c
126      call dft_fitcd(nmat,dbl_mb(k_cd_coef), idum, Ecoul,
127     &     g_dens, nTotEl, n_batch, n3c_int,
128     &     idum, n3c_dbl, iwhat_max, n_semi_bufs, fd, IOLGC,
129     &     idum, derfit,  Tvec,
130     &     have_Tvec)
131c
132c     Compute the J matrices using the fitting coefficients
133c
134      call dft_fitvc(dbl_mb(k_cd_coef), idum, Ecoul,  g_j,
135     &     n_batch, n3c_int, idum, n3c_dbl,
136     &     iwhat_max, n_semi_bufs, fd, IOLGC,
137     &     derfit, nmat, do_init)
138c
139c     Clean up
140c
141      if (.not.ma_pop_stack(l_cd_coef))
142     &     call errquit('fock_j_fit: cannot pop stack',0, MA_ERR)
143      direct = old_direct
144      incore = old_incore
145c
146      if (bgj_print() .gt. 0) then
147         do imat = 1, nmat
148            write(*,*)'Fitted J matrix',imat
149            call ga_print(g_j(imat))
150         enddo
151         write(*,*)'--------Leaving fock_j_fit-------------'
152      endif
153c
154      return
155      end
156