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