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