1C> \ingroup nwint
2C> @{
3C>
4C> \brief Compute 2-electron 2-center Gaussian periodic electron
5C> repulsion integrals
6C>
7C> The code in question always uses density fitting approaches for
8C> the 2-center 2-electron integrals are needed. See [1] for details.
9C>
10C> [1] JE Jaffe, AC Hess,
11C>     <i>"Gaussian basis density functional theory for systems
12C>     periodic in two or three dimensions: Energy and forces"</i>,
13C>    J.Chem.Phys. <b>105</b>, 10983-10998 (1996), DOI:
14C>    <a href="https://doi.org/10.1063/1.472866">
15C>    10.1063/1.472866</a>
16C>
17      subroutine intp_2e2c(brain, ish, ketin, jsh, Rj,
18     &       lscr, scr, leri, eri)
19c $Id$
20      implicit none
21c
22c basic api routine to generate a block of 2 center two electron integrals
23c eri = <bra_g(ish)|ket_g(jsh)>
24c
25#include "apiP.fh"
26#include "errquit.fh"
27#include "bas.fh"
28#include "nwc_const.fh"
29#include "basP.fh"
30#include "basdeclsP.fh"
31#include "geomP.fh"
32#include "geobasmapP.fh"
33#include "stdio.fh"
34#include "mafdecls.fh"
35#include "bas_exndcf_dec.fh"
36#include "bas_ibs_dec.fh"
37#include "int_nbf.fh"
38c
39c::external subroutines used
40c errquit
41c::functions
42      logical cando_nw
43      logical int_chk_sh
44      logical int_chk_init
45      external cando_nw
46      external int_chk_sh
47      external int_chk_init
48c:: passed
49      integer brain  !< [Input] basis set handle for bra function
50      integer ketin  !< [Input] basis set handle for ket function
51      integer ish    !< [Input] lexical contraction/shell index
52      integer jsh    !< [Input] lexical contraction/shell index
53      integer lscr   !< [Input] length of scratch array
54      integer leri   !< [Input] length of ERI array
55      double precision scr(lscr) !< [Scratch] scratch array
56      double precision eri(leri) !< [Output] ERI array
57      double precision Rj(3)  !< [Input] translation vector for jsh center (fractional coordinates)
58c:: local
59      logical shells_ok
60      integer bra, ket
61      integer p_geom, q_geom, ucont
62      integer Lp, p_prim, p_gen, p_iexp, p_icfp, p_cent
63      integer Lq, q_prim, q_gen, q_iexp, q_icfp, q_cent
64      double precision xyz_new_j(3)  ! new coordinates for jsh function center
65c
66      integer WarnP
67      save WarnP
68      data WarnP /0/
69c
70#include "bas_exndcf_sfn.fh"
71#include "bas_ibs_sfn.fh"
72c
73c check initialization
74c
75      if (.not.int_chk_init('intp_2e2c'))
76     &       call errquit('intp_2e2c: int_init was not called' ,0,
77     &           INT_ERR)
78c
79c     check input shell ranges
80c
81      shells_ok = int_chk_sh(brain,ish)
82      shells_ok = shells_ok .and. int_chk_sh(ketin,jsh)
83c
84      if (.not.shells_ok)
85     &       call errquit('intp_2e2c: invalid contraction/shell',0,
86     &          BASIS_ERR)
87c
88c  check if gencon/sp shell
89c
90      call int_nogencont_check(brain,'intp_2e2c:bra')
91      call int_nogencont_check(ketin,'intp_2e2c:ket')
92      call int_nospshell_check(brain,'intp_2e2c:bra')
93      call int_nospshell_check(ketin,'intp_2e2c:ket')
94c
95c     define center information required
96c
97      bra = brain + BASIS_HANDLE_OFFSET
98      ket = ketin + BASIS_HANDLE_OFFSET
99      p_geom = ibs_geom(bra)
100      q_geom = ibs_geom(ket)
101c
102      if (p_geom.ne.q_geom.and.WarnP.eq.0) then
103        write(luout,*)
104     &      'intp_2e2c: WARNING: possible geometry inconsistency'
105        write(luout,*)'bra geometry handle:',p_geom
106        write(luout,*)'ket geometry handle:',q_geom
107        WarnP = 1
108      endif
109c
110      p_cent  = (sf_ibs_cn2ce(ish,bra))
111      q_cent  = (sf_ibs_cn2ce(jsh,ket))
112c
113c.. translate jsh center coordinates based on Rj
114      call intp_txyz(q_cent,q_geom,Rj,xyz_new_j)
115      if(cando_nw(brain,ish,0).and.cando_nw(ketin,jsh,0)) then
116c
117        ucont   = (sf_ibs_cn2ucn(ish,bra))
118        Lp      = infbs_cont(CONT_TYPE ,ucont,bra)
119        p_prim  = infbs_cont(CONT_NPRIM,ucont,bra)
120        p_gen   = infbs_cont(CONT_NGEN ,ucont,bra)
121        p_iexp  = infbs_cont(CONT_IEXP ,ucont,bra)
122        p_icfp  = infbs_cont(CONT_ICFP ,ucont,bra)
123c
124        ucont   = (sf_ibs_cn2ucn(jsh,ket))
125        Lq      = infbs_cont(CONT_TYPE ,ucont,ket)
126        q_prim  = infbs_cont(CONT_NPRIM,ucont,ket)
127        q_gen   = infbs_cont(CONT_NGEN ,ucont,ket)
128        q_iexp  = infbs_cont(CONT_IEXP ,ucont,ket)
129        q_icfp  = infbs_cont(CONT_ICFP ,ucont,ket)
130c
131        call hf2(
132     &         coords(1,p_cent,p_geom), dbl_mb(mb_exndcf(p_iexp,bra)),
133     &         dbl_mb(mb_exndcf(p_icfp,bra)), p_prim, p_gen, Lp,
134     &         coords(1,p_cent,p_geom), DCexp,
135     &         DCcoeff           ,      1,     1, 0,
136     &         xyz_new_j, dbl_mb(mb_exndcf(q_iexp,ket)),
137     &         dbl_mb(mb_exndcf(q_icfp,ket)), q_prim, q_gen, Lq,
138     &         xyz_new_j, DCexp,
139     &         DCcoeff           ,      1,     1, 0,
140c......................... canAB    canCD    canPQ
141     &         eri, leri, .false., .false., .false.,
142c............. dryrun
143     &         .false., scr, lscr)
144        if (bas_spherical(bra).or.bas_spherical(ket)) then
145c ... reset general contractions for sp shells to 1 since they are handled
146c     as a block of 4. Since int_nbf_* arrays are set to the appropriate size.
147          if (Lp.eq.-1) p_gen = 1
148          if (Lq.eq.-1) q_gen = 1
149          call spcart_2ctran(eri,scr,lscr,
150     &        int_nbf_x(Lp),int_nbf_s(Lp),Lp,p_gen,bas_spherical(bra),
151     &        int_nbf_x(Lq),int_nbf_s(Lq),Lq,q_gen,bas_spherical(ket),
152     &        .false.)
153        endif
154c
155      else
156        write(luout,*)'intp_2e2c: could not do nw integrals'
157        write(luout,*)' brain :',brain
158        write(luout,*)' ketin :',ketin
159        write(luout,*)' ish   :',ish
160        write(luout,*)' jsh   :',jsh
161        call errquit('intp_2e2c: fatal error ',0, INT_ERR)
162      endif
163      end
164C> @}
165