1c $Id$
2*
3C> \ingroup nwint
4C> @{
5C>
6C> \brief Compute the 1-electron GIAO overlap integrals
7C>
8C> Compute the the 1-electron GIAO overlap integrals.
9C> For a definition of the GIAO basis functions see the
10C> `int_giao_2e` routine (see also [1]).
11C>
12C> [1] M. Dupuis,
13C>     "New integral transforms for molecular properties and application
14C>     to a massively parallel GIAO-SCF implementation",
15C>     Comp. Phys. Comm. <b>134</b>, 150-166 (2001), DOI:
16C>     <a href="https://doi.org/10.1016/S0010-4655(00)00195-8">
17C>     10.1016/S0010-4655(00)00195-8</a>.
18C>
19c:tex-% this is part of the API Standard Integral routines.
20c:tex-\subsection{int\_giaos100}
21c:tex-This routine computes the 1-elec GIAO integrals of type r x R(A)
22c:tex-
23c:tex-{\it Syntax:}
24c:tex-\begin{verbatim}
25      subroutine int_giaos100(i_basis,ish,j_basis,jsh,lscr,scr,ls10,s10)
26c:tex-\end{verbatim}
27      implicit none
28#include "nwc_const.fh"
29#include "errquit.fh"
30#include "basP.fh"
31#include "basdeclsP.fh"
32#include "geomP.fh"
33#include "geobasmapP.fh"
34#include "mafdecls.fh"
35#include "bas_exndcf_dec.fh"
36#include "bas_ibs_dec.fh"
37#include "int_nbf.fh"
38#include "stdio.fh"
39#include "apiP.fh"
40#include "util.fh"
41c::external subroutines used
42c... errquit
43c::functions
44      logical cando_hnd_1e_prp
45      logical int_chk_init
46      logical int_chk_sh
47      external int_chk_init
48      external int_chk_sh
49      external cando_hnd_1e_prp
50c::passed
51c:tex-\begin{verbatim}
52      integer i_basis !< [Input] basis set handle for ish
53      integer ish     !< [Input] i shell/contraction
54      integer j_basis !< [Input] basis set handle for jsh
55      integer jsh     !< [Input] j shell/contraction
56      integer lscr    !< [Input] length of scratch array
57      double precision scr(lscr) !< [Scratch] scratch array
58      integer ls10               !< [Input] length of s10 buffer
59      double precision s10(ls10) !< [Output] s10 integrals
60c:tex-\end{verbatim}
61c::local
62      integer igeom, jgeom, ibas, jbas, ucont
63      integer itype, inp, igen, iexp, icent, icf, iatom
64      integer jtype, jnp, jgen, jexp, jcent, jcf, jatom
65c
66      logical any_spherical, trani, tranj, shells_ok
67      integer i_nbf_x, j_nbf_x
68      integer i_nbf_s, j_nbf_s
69      integer ipts, ncartint ,i,j
70c
71#include "bas_exndcf_sfn.fh"
72#include "bas_ibs_sfn.fh"
73c
74c check initialization and shells
75c
76      if (.not.int_chk_init('int_giaos100'))
77     &       call errquit('int_giaos100: int_init was not called' ,0,
78     &       INT_ERR)
79c
80      shells_ok = int_chk_sh(i_basis,ish)
81      shells_ok = shells_ok .and. int_chk_sh(j_basis,jsh)
82      if (.not.shells_ok)
83     &       call errquit('int_giaos100: invalid contraction/shell',0,
84     &       INT_ERR)
85c
86c  check if gencont
87c
88      call int_nogencont_check(i_basis,'int_giaos100:i_basis')
89      call int_nogencont_check(j_basis,'int_giaos100:j_basis')
90c
91      ibas = i_basis + basis_handle_offset
92      jbas = j_basis + basis_handle_offset
93c
94      ucont = (sf_ibs_cn2ucn(ish,ibas))
95      itype = infbs_cont(CONT_TYPE ,ucont,ibas)
96      inp   = infbs_cont(CONT_NPRIM,ucont,ibas)
97      igen  = infbs_cont(CONT_NGEN ,ucont,ibas)
98      iexp  = infbs_cont(CONT_IEXP ,ucont,ibas)
99      icf   = infbs_cont(CONT_ICFP ,ucont,ibas)
100      iatom = (sf_ibs_cn2ce(ish,ibas))
101      igeom = ibs_geom(ibas)
102c
103      ucont = (sf_ibs_cn2ucn(jsh,jbas))
104      jtype = infbs_cont(CONT_TYPE ,ucont,jbas)
105      jnp   = infbs_cont(CONT_NPRIM,ucont,jbas)
106      jgen  = infbs_cont(CONT_NGEN ,ucont,jbas)
107      jexp  = infbs_cont(CONT_IEXP ,ucont,jbas)
108      jcf   = infbs_cont(CONT_ICFP ,ucont,jbas)
109      jatom = (sf_ibs_cn2ce(jsh,jbas))
110      jgeom = ibs_geom(jbas)
111c
112      if (igeom.ne.jgeom) then
113        write(luout,*)'int_giaos100: two different geometries for',
114     &         ' properties?'
115        call errquit('int_giaos100: geom error ',911, GEOM_ERR)
116      endif
117c
118c     Determine # of cartesian integrals in block
119c
120      ncartint = int_nbf_x(itype)*int_nbf_x(jtype)
121c
122      call hnd_giaos100(
123     &       coords(1,iatom,igeom),
124     &       dbl_mb(mb_exndcf(iexp,ibas)),
125     &       dbl_mb(mb_exndcf(icf,ibas)),
126     &       inp,igen,itype,
127c
128     &       coords(1,jatom,jgeom),
129     &       dbl_mb(mb_exndcf(jexp,jbas)),
130     &       dbl_mb(mb_exndcf(jcf,jbas)),
131     &       jnp,jgen,jtype,
132c
133     &       ncartint,s10,scr,lscr)
134c
135c     h01 now has three blocks, one for each component x, y, z
136c
137      any_spherical = bas_spherical(ibas).or.bas_spherical(jbas)
138      if (.not.any_spherical) return
139c
140      i_nbf_x = int_nbf_x(itype)
141      j_nbf_x = int_nbf_x(jtype)
142c
143c... assume we need to transform both i and j integrals
144c
145      trani = .true.
146      tranj = .true.
147*.. do not tranform i component
148      if (.not.bas_spherical(ibas)) trani = .false.
149*.. do not tranform j component
150      if (.not.bas_spherical(jbas)) tranj = .false.
151c
152c ... reset general contractions for sp shells to 1 since they are handled
153c     as a block of 4.
154c
155      if (itype.eq.-1) igen = 1
156      if (jtype.eq.-1) jgen = 1
157      call spcart_2cBtran(s10,scr,lscr,
158     &    j_nbf_x,int_nbf_s(jtype),jtype,jgen,tranj,
159     &    i_nbf_x,int_nbf_s(itype),itype,igen,trani,
160     &    3,.false.)
161c
162c     We now have the integrals in array (nsph_ints,3)
163c
164      return
165      end
166C> @}
167