1C> \ingroup nwint
2C> @{
3C>
4C> \brief Compute the 4-center 2-electron integral derivatives
5C>
6C> Compute the 4-center 2-electron integral derivatives as given by
7C> \f{eqnarray*}{
8C> \frac{\partial^2({\mu}{\rho}|{\nu}{\lambda})}{\partial X_x\partial X_y} = \int_{-\infty}^{\infty} \frac{\partial^2 g_{\mu}(X_{\mu},r_{1})g_{\rho}(X_{\rho},r_{1})\frac{1}{r_{12}}g_{\nu}(X_{\nu},r_{2})g_{\lambda}(X_{\lambda},r_{2})}{\partial X_x\partial X_y}dr_{1}dr_{2}
9C> \f}
10C> The integral derivatives are stored in an order that is consistent with
11C> the declaration `ERI(natcrd*(natcrd+1)/2,nint)`, where `nint` is the number
12C> of integrals in the shell quartet, `natcrd` is the number of Cartesian
13C> coordinates in the shell quartet, i.e. 12 ( = 4 atoms * 3 coordinates).
14C> The actual lexical indeces of the atoms on which the shells `ish`,
15C> `jsh`, `ksh` and `lsh` are centered are returned in `idatom`.
16C>
17      subroutine intdd_2e4c(brain, ish, jsh, ketin, ksh, lsh,
18     &       lscr, scr, leri, eri, idatom)
19c $Id$
20      implicit none
21c
22* basic api routine to generate 4 center two electron
23* integral second derivatives
24c
25* The buffer comes out as:
26*      (upper triangle block derivative, basis indecies)
27c------------------------------------------------------------
28c construct all 10 blocks of sec.der. (output) from 6 blocks:
29c
30c          AA AB AC AD                AA AB AC
31c             BB BC BD      from         BB BC
32c                CC CD                      CC
33c                   DD
34c      1-6, 7-15,16-24,25-33         1-6, 7-15,16-24
35c          34-39,40-48,49-57             25-30,31-39
36c                58-63,64-72                   40-45
37c                      73-78
38c------------------------------------------------------------
39* block AA: (1-6)  | block BB: (34-39)| block CC: (58-63)   |
40c       axax=1     |       bxbx=34    |       cxcx=58       |
41c       axay=2     |       bxby=35    |       cxcy=59       |
42c       axaz=3     |       bxbz=36    |       cxcz=60       |
43c       ayay=4     |       byby=37    |       cycy=61       |
44c       ayaz=5     |       bybz=38    |       cycz=62       |
45c       azaz=6     |       bzbz=39    |       czcz=63       |
46* block AB: (7-15) | block BC: (40-48)| block CD: (64-72)   |
47c       axbx=7     |       bxcx=40    |       cxdx=64       |
48c       axby=8     |       bxcy=41    |       cxdy=65       |
49c       axbz=9     |       bxcz=42    |       cxdz=66       |
50c       aybx=10    |       bycx=43    |       cydx=67       |
51c       ayby=11    |       bycy=44    |       cydy=68       |
52c       aybz=12    |       bycz=45    |       cydz=69       |
53c       azbx=13    |       bzcx=46    |       czdx=70       |
54c       azby=14    |       bzcy=47    |       czdy=71       |
55c       azbz=15    |       bzcz=48    |       czdz=72       |
56* block AC: (16-24)| block BD: (49-57)| block DD: (73-78)   |
57c       axcx=16    |       bxdx=49    |       dxdx=73       |
58c       axcy=17    |       bxdy=50    |       dxdy=74       |
59c       axcz=18    |       bxdz=51    |       dxdz=75       |
60c       aycx=19    |       bydx=52    |       dydy=76       |
61c       aycy=20    |       bydy=53    |       dydz=77       |
62c       aycz=21    |       bydz=54    |       dzdz=78       |
63c       azcx=22    |       bzdx=55    |                     |
64c       azcy=23    |       bzdy=56    |                     |
65c       azcz=24    |       bzdz=57    |                     |
66* block AD: (25-33)|                  |                     |
67c       axdx=25    |                  |                     |
68c       axdy=26    |                  |                     |
69c       axdz=27    |                  |                     |
70c       aydx=28    |                  |                     |
71c       aydy=29    |                  |                     |
72c       aydz=30    |                  |                     |
73c       azdx=31    |                  |                     |
74c       azdy=32    |                  |                     |
75c       azdz=33    |                  |                     |
76c------------------------------------------------------------
77#include "stdio.fh"
78#include "errquit.fh"
79#include "bas.fh"
80#include "nwc_const.fh"
81#include "basP.fh"
82#include "basdeclsP.fh"
83#include "geomP.fh"
84#include "geobasmapP.fh"
85#include "mafdecls.fh"
86#include "bas_exndcf_dec.fh"
87#include "bas_ibs_dec.fh"
88c
89c::external subroutines used
90c errquit
91c::functions
92      integer int_nint_cart
93      external int_nint_cart
94ckw
95      integer int_nint
96      external int_nint
97c
98      logical cando_nw
99      logical cando_txs
100      external cando_nw
101      external cando_txs
102ckw
103c::passed
104      integer brain !< [Input] basis set handle for bra basis
105      integer ish   !< [Input] lexical contraction index
106      integer jsh   !< [Input] lexical contraction index
107      integer ketin !< [Input] basis set handle for ket basis
108      integer ksh   !< [Input] lexical contraction index
109      integer lsh   !< [Input] lexical contraction index
110      integer lscr  !< [Input] length of scratch array
111      integer leri  !< [Input] length of eri array
112      double precision scr(lscr) !< [Scratch] scratch array for integral code.
113      double precision eri(leri) !< [Output]  array for two electron integral derivatives.
114c NOTE: length of idatom is always 4 because there can be at most 4 centers involved
115      integer idatom(4)          !< [Output]  array identifying centers for derivatives
116c
117c::local
118      integer nint, ucont
119      integer bra, ket, ab_geom, cd_geom
120      integer iatom
121      integer jatom
122      integer katom
123      integer latom
124ckw
125      double precision roff(3)
126      integer txs_i, txs_j, txs_k, txs_l
127      logical status_nw, status_txs
128      logical dum_log
129      integer nintzero, num_quart, dummy_lab
130      double precision q4
131ckw
132c
133      logical used_nw
134c
135#include "bas_exndcf_sfn.fh"
136#include "bas_ibs_sfn.fh"
137c
138      used_nw = .false.
139      nint = int_nint_cart(brain,ish,brain,jsh,ketin,ksh,ketin,lsh)
140      if (nint*78.gt.leri) then
141        write(luout,*) 'nint*78 = ',nint*78
142        write(luout,*) 'leri     = ',leri
143        call errquit('intdd_2e4c: nint>leri error',911, INT_ERR)
144      endif
145c
146      bra = brain + BASIS_HANDLE_OFFSET
147      ket = ketin + BASIS_HANDLE_OFFSET
148c
149      ab_geom = ibs_geom(bra)
150      cd_geom = ibs_geom(ket)
151      if (ab_geom.ne.cd_geom) then
152        write(luout,*)
153     &      'intdd_2e4c.F: two different geometries for',
154     &         ' derivatives?'
155        call errquit('intdd_2e4c: geom error ',911, GEOM_ERR)
156      endif
157
158c
159      ucont = (sf_ibs_cn2ucn(ish,bra))
160      iatom = (sf_ibs_cn2ce(ish,bra))
161      idatom(1)=iatom
162c
163      ucont = (sf_ibs_cn2ucn(jsh,bra))
164      jatom = (sf_ibs_cn2ce(jsh,bra))
165      idatom(2)=jatom
166c
167      ucont = (sf_ibs_cn2ucn(ksh,ket))
168      katom = (sf_ibs_cn2ce(ksh,ket))
169      idatom(3)=katom
170c
171      ucont = (sf_ibs_cn2ucn(lsh,ket))
172      latom = (sf_ibs_cn2ce(lsh,ket))
173      idatom(4)=latom
174c
175      if (iatom.eq.jatom.and.jatom.eq.katom.and.katom.eq.latom) then
176        call dcopy((nint*78),0.0d00,0,eri,1)
177        call ifill(4,-1,idatom,1)
178        return
179      endif
180c
181      status_nw  = .false.
182      status_txs =.true.
183      status_txs = status_txs .and.
184     &    cando_txs(brain,ish,jsh).and.cando_txs(ketin,ksh,lsh)
185c
186      if (status_txs) then
187        call dcopy(3,0.0d00,0,roff,1)
188        q4 = 1.0d00
189        txs_i = ish
190        txs_j = jsh
191        txs_k = ksh
192        txs_l = lsh
193        num_quart=1
194        dum_log=.false.
195c
196        call texas_hf2_m(
197     &      brain,txs_i,txs_j,
198     &      ketin,txs_k,txs_l,num_quart,
199     &      q4,.false.,
200c...............................use roff set false
201     &      roff,roff,roff,roff,.false.,
202     &      eri, leri, dummy_lab, dummy_lab, dummy_lab, dummy_lab,
203c...............gen labs .. more_integrals
204     &      nint, .false., dum_log, scr, lscr, 0.0d0,'der2_int')
205        if (nint .eq. 0) then
206          nintzero = int_nint(brain,ish,brain,jsh,ketin,ksh,ketin,lsh)
207          nintzero = nintzero*78
208          call dcopy(nintzero, 0.0d0, 0, eri, 1)
209          call ifill(4,-9,idatom,1)
210        endif
211c
212      else
213        write(luout,*)'intdd_2e4c: could not use the texas '
214        write(luout,*)'           integral second derivatives'
215        write(luout,*)' Please notify nwchem-support@emsl.pnl.gov with'
216        write(luout,*)'        the input deck and output available'
217        call errquit('intdd_2e4c: fatal error',911, INT_ERR)
218      endif
219c
220      end
221C> @}
222