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