1      Subroutine hf1_er(Axyz,Aprims,Acoefs,NPA,NCA,La,
2     &               Bxyz,Bprims,Bcoefs,NPB,NCB,Lb,
3     &               Cxyz,zan,ncenters,
4     &               bO2I,bKEI,bNAI,Nint,O2I,KEI,NAI,canAB,
5     &               DryRun,W0,maxW0)
6c $Id$
7      implicit none
8
9      integer NPA,NCA,NPB,NCB
10      integer La,Lb,NInt
11      integer ncenters,maxW0
12      Logical O2I,KEI,NAI,canAB
13
14      Logical GenCon,DryRun
15
16c--> Cartesian Coordinates, Primitives & Contraction Coefficients
17
18      double precision Axyz(3),Aprims(NPA),Acoefs(NPA,NCA)
19      double precision Bxyz(3),Bprims(NPB),Bcoefs(NPB,NCB)
20
21c--> Nuclear Cartesian Coordinates & Charges
22
23      double precision Cxyz(3,ncenters),zan(ncenters)
24
25c--> Blocks of Overlap, Kinetic Energy & Nuclear Attraction Integrals
26
27      double precision bO2I(Nint),bKEI(Nint),bNAI(ncenters,Nint)
28
29c--> Scratch Space.
30
31      double precision W0(maxW0)
32C
33C     local
34C
35      integer MXD,NCP,Li,Lp,Lp3,NPP
36      integer i_ALPHAp,i_IPAIRp,i_left,i_ESp,i_right, i_exinv
37      integer i_rs,i_p,i_ijk,i_ff,i_pc,i_r0c,i_pf,i_ep
38      integer lprod,nd,i_r0,i_top,i_ti,i_rj
39      integer MaxMem
40c
41c Compute the overlap, kinetic energy, and nuclear attraction integrals for
42c two shells of contracted Gaussians functions. This driver is NOT capable of
43c evaluating integral derivatives.
44c
45c******************************************************************************
46      MXD = 0
47
48c Determine whether general or segmented contraction is used.
49
50      NCP = NCA*NCB
51
52      GenCon = NCP.ne.1
53
54      if( GenCon )then
55       write(*,*) 'HF1: Not yet ready for general contraction.'
56       stop
57      end if
58
59c To determine all the Hermite expansion coefficients required to evaluate
60c the kinetic energy integrals, increment the angular momenta by one.
61
62      if( KEI )then
63       Li = 1
64      else
65       Li = 0
66      end if
67
68c Define the angular momentum of the overlap distribution.
69
70      Lp = La + Lb
71
72c Increment "Lp" to account for the order of differentiation.
73
74      Lp = Lp + MXD
75
76c Define the accumulated number of angular momentum functions <= Lp.
77
78      Lp3 = ((Lp+1)*(Lp+2)*(Lp+3))/6
79
80c Define the prefactor of the overlap distribution "P".
81
82c Assign pointers to scratch space.
83
84      i_exinv = 1
85      i_ALPHAp = i_exinv+ncenters
86      i_IPAIRp = i_ALPHAp + 2*(NPA*NPB)
87      i_left   = i_IPAIRp + 2*(NPA*NPB) - 1
88
89      i_ESp   = (maxW0+1) - 3*(NPA*NPB)
90      i_right = i_ESp
91
92      if( i_left.ge.i_right )then
93
94       write(*,*) 'HF1:  Insufficient scratch space.'
95       write(*,*) '       needed    ',i_left + (maxW0-(i_right-1))
96       write(*,*) '       allocated ',maxW0
97
98       write(*,*) 'From the left '
99       write(*,*) 'ALPHAp:  ',i_ALPHAp
100       write(*,*) 'IPAIRp:  ',i_IPAIRp
101       write(*,*) 'From the right '
102       write(*,*) 'ESp   :  ',i_ESp
103
104       stop
105
106      end if
107
108      MaxMem = 1       ! take care of compiler warnings
109
110      if( DryRun )then
111
112       MaxMem = i_left + (maxW0 - (i_right-1))
113       NPP = NPA*NPB
114
115      else
116
117       call hfset(Axyz,Aprims,Acoefs,NPA,NCA,
118     &            Bxyz,Bprims,Bcoefs,NPB,NCB,
119     &            GenCon,W0(i_ALPHAp),W0(i_IPAIRp),W0(i_ESp),NPP)
120
121      end if
122
123c Define the Hermite linear expansion coefficients.
124
125c Assign pointers to scratch space.
126
127      lprod = ((La+Li)+(Lb+Li)+1)*((La+Li)+1)*((Lb+Li)+1)
128
129      i_Ep   = i_IPAIRp + 2*(NPA*NPB)
130      i_pf   = i_Ep     + 3*NPP*(MXD+1)*lprod
131      i_left = i_pf     + 2*NPP - 1
132
133      if( i_left.ge.i_right )then
134
135       write(*,*) 'HF1:  Insufficient scratch space.'
136       write(*,*) '       needed    ',i_left + (maxW0-(i_right-1))
137       write(*,*) '       allocated ',maxW0
138
139       write(*,*) 'From the right '
140       write(*,*) 'ALPHAp:  ',i_ALPHAp
141       write(*,*) 'IPAIRp:  ',i_IPAIRp
142       write(*,*) 'Ep    :  ',i_Ep
143       write(*,*) 'pf    :  ',i_pf
144       write(*,*) 'From the left '
145       write(*,*) 'ESp   :  ',i_ESp
146
147       stop
148
149      end if
150
151      if( DryRun )then
152
153       MaxMem = max( MaxMem, i_left + (maxW0 - (i_right-1)) )
154
155      else
156
157       do 100 nd = 0,MXD
158        call hfmke(Axyz,Bxyz,W0(i_ALPHAp),W0(i_ESp),W0(i_Ep),W0(i_pf),
159     &             nd,NPP,MXD,La+Li,Lb+Li)
160  100  continue
161
162      end if
163
164c Compute the 2-center overlap integrals, <a|S|b>.
165
166      if( O2I )then
167       if( .not. DryRun )then
168        call hf2oi(W0(i_Ep),bO2I,Nint,NPP,La,Lb,Li,canAB)
169       end if
170      end if
171
172c Compute kinetic energy integrals, <a|T|b>.
173
174      if( KEI )then
175
176c Assign pointers to scratch space.
177
178       i_Ti  = i_Ep + 3*NPP*(MXD+1)*lprod
179       i_top = i_Ti + NPP - 1
180
181       if( i_top.gt.maxW0 )then
182
183        write(*,*) 'HF1:  Insufficient scratch space.'
184        write(*,*) '       needed    ',i_top
185        write(*,*) '       allocated ',maxW0
186
187        write(*,*) 'ALPHAp:  ',i_ALPHAp
188        write(*,*) 'IPAIRp:  ',i_IPAIRp
189        write(*,*) 'Ep    :  ',i_Ep
190        write(*,*) 'Ti    :  ',i_Ti
191
192        stop
193
194       end if
195
196       if( DryRun )then
197
198        MaxMem = max( MaxMem, i_top )
199
200       else
201
202        call hfkei(W0(i_ALPHAp),W0(i_Ep),bKEI,W0(i_Ti),
203     &             Nint,NPP,La,Lb,Li,canAB)
204       end if
205
206      end if
207
208c Compute nuclear attraction integrals, <a|V|b>.
209
210      if( NAI )then
211
212c Define the auxiliary function integrals.
213
214c Assign scratch space.
215
216       i_R0  = i_Ep  + 3*NPP*(MXD+1)*lprod
217       i_R0C = i_R0  + NPP*Lp3
218       i_IJK = i_R0C  + NPP*Lp3*ncenters
219       i_P   = i_IJK + (Lp+1)**3
220       i_RS  = i_P   + NPP*3
221       i_PC  = i_RS  + NPP
222       i_ff  = i_PC  + NPP*3
223       i_Rj  = i_ff  + NPP*2
224       i_top = i_Rj  + NPP*(Lp+1)*Lp3 - 1
225
226       if( i_top.gt.maxW0 )then
227
228        write(*,*) 'HF1:  Insufficient scratch space.'
229        write(*,*) '       needed    ',i_top
230        write(*,*) '       allocated ',maxW0
231
232        write(*,*) 'ALPHAp:  ',i_ALPHAp
233        write(*,*) 'IPAIRp:  ',i_IPAIRp
234        write(*,*) 'Ep    :  ',i_Ep
235        write(*,*) 'R0    :  ',i_R0
236        write(*,*) 'R0C   :  ',i_R0C
237        write(*,*) 'IJK   :  ',i_IJK
238        write(*,*) 'P     :  ',i_P
239        write(*,*) 'RS    :  ',i_RS
240        write(*,*) 'PC    :  ',i_PC
241        write(*,*) 'ff    :  ',i_ff
242        write(*,*) 'Rj    :  ',i_Rj
243
244        stop
245
246       end if
247
248       if( DryRun )then
249
250        MaxMem = max( MaxMem, i_top )
251
252       else
253
254        call dfill (ncenters,0.0d0,W0(i_exinv),1)
255        call hf1mkr(Axyz,Bxyz,Cxyz,zan,W0(i_exinv),ncenters,
256     &              W0(i_ALPHAp),W0(i_P),W0(i_RS),W0(i_PC),W0(i_ff),
257     &              W0(i_Rj),W0(i_R0),W0(i_R0C),W0(i_IJK),
258     &              NPP,Lp,Lp3,.TRUE.)
259
260        call hfnai_er(ncenters,W0(i_Ep),W0(i_R0C),W0(i_IJK),bNAI,
261     &             Nint,NPP,La,Lb,Li,Lp,Lp3,canAB)
262
263       end if
264
265      end if
266
267c Return the maximum amount of scratch space required by a "dry run".
268
269      if( DryRun ) maxW0 = MaxMem
270c
271      end
272