1 subroutine hf2d_3a2b( 2 & Axyz,Aprims,Acoefs,NPA,NCA,La,ictra, 3 & Bxyz,Bprims,Bcoefs,NPB,NCB,Lb,ictrb, 4 & Cxyz,Cprims,Ccoefs,NPC,NCC,Lc,ictrc, 5 & Dxyz,Dprims,Dcoefs,NPD,NCD,Ld,ictrd, 6 & bERI,Nint,canAB,canCD,canPQ,dryrun, 7 & W0,maxW0) 8C $Id$ 9 Implicit None 10 Logical canAB,canCD,canPQ,dryrun 11 12c--> Cartesian Coordinates, Primitives & Contraction Coefficients 13 14 Integer La, Lb, Lc, Ld, Nint, MaxW0 15 Integer NPA, NCA, NPB, NCB, NPC, NCC, NPD, NCD 16 Double Precision Axyz(3),Aprims(NPA),Acoefs(NPA,NCA) 17 Double Precision Bxyz(3),Bprims(NPB),Bcoefs(NPB,NCB) 18 Double Precision Cxyz(3),Cprims(NPC),Ccoefs(NPC,NCC) 19 Double Precision Dxyz(3),Dprims(NPD),Dcoefs(NPD,NCD) 20 Integer ictra,ictrb,ictrc,ictrd 21c--> Block of Electron Repulsion Integrals 22 23 Double Precision bERI(Nint,*) 24 25c--> Scratch Space 26 27 Double Precision W0(maxW0) 28c 29 integer npa1, npa2, npa3, npb1, npb2 30 integer a_exp, a_cof, b_exp, b_cof 31 integer maxw0new, k0s, icont, kaddint, pw0 32 integer mem1add, mem1 33 integer mem2add, mem2 34 integer mem3add, mem3 35 integer mem4add, mem4 36 integer mem5add, mem5 37 integer mem6add, mem6 38c 39 npa1 = npa/3 40 npa2 = npa1 41 if (mod(npa,3).eq.1) then 42 npa1 = npa1 + 1 43 elseif(mod(npa,3).eq.2) then 44 npa1 = npa1 + 1 45 npa2 = npa1 46 endif 47 npa3 = npa - npa1 - npa2 ! size of third a block 48c 49 npb1 = npb/2 50 if (mod(npb,2).eq.1) npb1 = npb1 + 1 51 npb2 = npb - npb1 ! size of second b block 52c 53c.... do all a blocks for a given b block 54c 55c... first block of six (a1|b1|*) 56 b_exp = 1 57 b_cof = b_exp + npb1 58 a_exp = b_cof + npb1*NCB 59 a_cof = a_exp + npa1 60 k0s = a_cof + npa1*NCA 61 maxw0new = maxw0 - k0s 62 63 mem1 = k0s ! take care of compiler warnings 64 mem2 = k0s 65 mem3 = k0s 66 mem4 = k0s 67 mem5 = k0s 68 mem1add = mem1 69 mem2add = mem2 70 mem3add = mem3 71 mem4add = mem4 72 mem5add = mem5 73 mem6add = mem5 74 75 if (dryrun) then 76 mem1add = k0s 77 else 78 call dcopy(npa1,Aprims,1,W0(a_exp),1) 79 call dcopy(npb1,Bprims,1,W0(b_exp),1) 80 do 00100 icont = 1,NCA 81 pw0 = a_cof+(icont-1)*npa1 82 call dcopy(npa1,Acoefs(1,icont),1,W0(pw0),1) 8300100 continue 84 do 00200 icont = 1,NCB 85 pw0 = b_cof+(icont-1)*npb1 86 call dcopy(npb1,Bcoefs(1,icont),1,W0(pw0),1) 8700200 continue 88 endif 89 call hf2dold( 90 & Axyz,W0(a_exp),W0(a_cof),NPA1,NCA,La,ictra, 91 & Bxyz,W0(b_exp),W0(b_cof),NPB1,NCB,Lb,ictrb, 92 & Cxyz,Cprims,Ccoefs,NPC,NCC,Lc,ictrc, 93 & Dxyz,Dprims,Dcoefs,NPD,NCD,Ld,ictrd, 94 & bERI,Nint,canAB,canCD,canPQ,dryrun, 95 & W0(k0s),maxW0new) 96 if (dryrun) mem1 = maxW0new + mem1add 97c 98c... do second block of six (a2|b1|*) 99 a_cof = a_exp + npa2 100 kaddint = a_cof + npa2*NCA 101 k0s = kaddint + 12*nint 102 maxw0new = maxw0-k0s 103 if (dryrun) then 104 mem2add = k0s 105 else 106 call dcopy(npa2,Aprims(npa1+1),1,W0(a_exp),1) 107 do 00300 icont = 1,NCA 108 pw0 = a_cof+(icont-1)*npa2 109 call dcopy(npa2,Acoefs((npa1+1),icont),1,W0(pw0),1) 11000300 continue 111 endif 112 call hf2dold( 113 & Axyz,W0(a_exp),W0(a_cof),NPA2,NCA,La,ictra, 114 & Bxyz,W0(b_exp),W0(b_cof),NPB1,NCB,Lb,ictrb, 115 & Cxyz,Cprims,Ccoefs,NPC,NCC,Lc,ictrc, 116 & Dxyz,Dprims,Dcoefs,NPD,NCD,Ld,ictrd, 117 & W0(kaddint),Nint,canAB,canCD,canPQ,dryrun, 118 & W0(k0s),maxW0new) 119 if (dryrun) then 120 mem2 = maxw0new + mem2add 121 else 122c... sum blocks 1+2 123 call daxpy((nint*12),1.0d00,w0(kaddint),1,beri,1) 124 endif 125c... do third of 6 blocks (a3|b1|*) 126 a_cof = a_exp + npa3 127 kaddint = a_cof + npa3*NCA 128 k0s = kaddint + 12*nint 129 maxw0new = maxw0-k0s 130 if (dryrun) then 131 mem3add = k0s 132 else 133 call dcopy(npa3,Aprims((npa1+npa2+1)),1,W0(a_exp),1) 134 do 00400 icont = 1,NCA 135 pw0 = a_cof+(icont-1)*npa3 136 call dcopy(npa3,Acoefs((npa1+npa2+1),icont),1,W0(pw0),1) 13700400 continue 138 endif 139 call hf2dold( 140 & Axyz,W0(a_exp),W0(a_cof),NPA3,NCA,La,ictra, 141 & Bxyz,W0(b_exp),W0(b_cof),NPB1,NCB,Lb,ictrb, 142 & Cxyz,Cprims,Ccoefs,NPC,NCC,Lc,ictrc, 143 & Dxyz,Dprims,Dcoefs,NPD,NCD,Ld,ictrd, 144 & W0(kaddint),Nint,canAB,canCD,canPQ,dryrun, 145 & W0(k0s),maxW0new) 146 if (dryrun) then 147 mem3 = maxw0new + mem3add 148 else 149c... sum blocks 1,2 + 3 150 call daxpy((nint*12),1.0d00,w0(kaddint),1,beri,1) 151 endif 152c... do fourth of six blocks (a1|b2|*) 153 b_exp = 1 154 b_cof = b_exp + npb2 155 a_exp = b_cof + npb2*NCB 156 a_cof = a_exp + npa1 157 kaddint = a_cof + npa1*NCA 158 k0s = kaddint + 12*nint 159 maxw0new = maxw0-k0s 160 if (dryrun) then 161 mem4add = k0s 162 else 163 call dcopy(npa1,Aprims,1,W0(a_exp),1) 164 call dcopy(npb2,Bprims(npb1+1),1,W0(b_exp),1) 165 do 00500 icont = 1,NCA 166 pw0 = a_cof + (icont-1)*npa1 167 call dcopy(npa1,Acoefs(1,icont),1,W0(pw0),1) 16800500 continue 169 do 00600 icont = 1,NCB 170 pw0 = b_cof + (icont-1)*npb2 171 call dcopy(npb2,Bcoefs((npb1+1),icont),1,W0(pw0),1) 17200600 continue 173 endif 174 call hf2dold( 175 & Axyz,W0(a_exp),W0(a_cof),NPA1,NCA,La,ictra, 176 & Bxyz,W0(b_exp),W0(b_cof),NPB2,NCB,Lb,ictrb, 177 & Cxyz,Cprims,Ccoefs,NPC,NCC,Lc,ictrc, 178 & Dxyz,Dprims,Dcoefs,NPD,NCD,Ld,ictrd, 179 & W0(kaddint),Nint,canAB,canCD,canPQ,dryrun, 180 & W0(k0s),maxW0new) 181 if (dryrun) then 182 mem4 = maxw0new + mem4add 183 else 184c... sum blocks 1,2,3 + 4 185 call daxpy((nint*12),1.0d00,w0(kaddint),1,beri,1) 186 endif 187c... do fifth of six blocks (a2|b2|*) 188 a_cof = a_exp + npa2 189 kaddint = a_cof + npa2*NCA 190 k0s = kaddint + 12*nint 191 maxw0new = maxw0-k0s 192 if (dryrun) then 193 mem5add = k0s 194 else 195 call dcopy(npa2,Aprims(npa1+1),1,W0(a_exp),1) 196 do 00700 icont = 1,NCA 197 pw0 = a_cof+(icont-1)*npa2 198 call dcopy(npa2,Acoefs((npa1+1),icont),1,W0(pw0),1) 19900700 continue 200 endif 201 call hf2dold( 202 & Axyz,W0(a_exp),W0(a_cof),NPA2,NCA,La,ictra, 203 & Bxyz,W0(b_exp),W0(b_cof),NPB2,NCB,Lb,ictrb, 204 & Cxyz,Cprims,Ccoefs,NPC,NCC,Lc,ictrc, 205 & Dxyz,Dprims,Dcoefs,NPD,NCD,Ld,ictrd, 206 & W0(kaddint),Nint,canAB,canCD,canPQ,dryrun, 207 & W0(k0s),maxW0new) 208 if (dryrun) then 209 mem5 = maxw0new + mem5add 210 else 211c... sum blocks 1,2,3,4 + 5 212 call daxpy((nint*12),1.0d00,w0(kaddint),1,beri,1) 213 endif 214c 215c... do sixth of six blocks (a3|b2|*) 216 a_cof = a_exp + npa3 217 kaddint = a_cof + npa3*NCA 218 k0s = kaddint + 12*nint 219 maxw0new = maxw0-k0s 220 if (dryrun) then 221 mem6add = k0s 222 else 223 call dcopy(npa3,Aprims((npa1+npa2+1)),1,W0(a_exp),1) 224 do 00800 icont = 1,NCA 225 pw0 = a_cof+(icont-1)*npa3 226 call dcopy(npa3,Acoefs((npa1+npa2+1),icont),1,W0(pw0),1) 22700800 continue 228 endif 229 call hf2dold( 230 & Axyz,W0(a_exp),W0(a_cof),NPA3,NCA,La,ictra, 231 & Bxyz,W0(b_exp),W0(b_cof),NPB2,NCB,Lb,ictrb, 232 & Cxyz,Cprims,Ccoefs,NPC,NCC,Lc,ictrc, 233 & Dxyz,Dprims,Dcoefs,NPD,NCD,Ld,ictrd, 234 & W0(kaddint),Nint,canAB,canCD,canPQ,dryrun, 235 & W0(k0s),maxW0new) 236 if (dryrun) then 237 mem6 = maxw0new + mem6add 238 maxw0 = max(mem1,mem2,mem3,mem4,mem5,mem6) 239 else 240c... sum blocks 1,2,3,4,5 + 6 241 call daxpy((nint*12),1.0d00,w0(kaddint),1,beri,1) 242 endif 243 end 244