1      block data block_int1e
2      implicit none
3#include "cint1cache.fh"
4      data ocache /.false./
5      end
6c
7C> \brief Compute 1-electron integrals and add them to a global array
8C>
9C> This routine computes 1-electron integrals of the specified kind and
10C> adds them to a global array. The routine always computes a
11C> rectangular matrix. It is even capable of using two different
12C> basis sets. Different kinds of integrals can be computed, they are:
13C>
14C> * "kinetic": the kinetic energy integrals
15C>
16C> * "potential": the nuclear attraction
17C>
18C> * "overlap": the overlap integrals
19C>
20C> * "pvp": ???
21C>
22C> * "so": spin-orbit integrals
23C>
24C> * "cos_chg_pot": the integrals with the COSMO charges
25C>
26C> * "bq_pot": the integrals with BQ-charges
27C>
28cc AJL/Begin
29C> * "potential_beta": the nuclear attraction with ECPs for the
30C>                     beta channel
31cc AJL/End
32C>
33C> The routine can exploit symmetry. If oskel is true then the
34C> "petite-list" symmetry will be used, although this requires both
35C> basis sets to be the same.
36C
37      subroutine int_1e_ga(ibas, jbas, g, integ_type, oskel)
38C$Id$
39      implicit none
40#include "errquit.fh"
41#include "cint1cache.fh"
42#include "mafdecls.fh"
43#include "global.fh"
44#include "rtdb.fh"
45#include "inp.fh"
46#include "apiP.fh"
47#include "bas.fh"
48#include "cscfps.fh"
49#include "sym.fh"
50#include "geom.fh"
51c
52c     Compute the desired type of integrals (kinetic, potential, overlap)
53c     and ADD them into the given global array.
54c     This version computes the full square of integrals and should work
55c     OK even if ibas != jbas.
56c
57c     Oskel indicates that the skeleton (petite-list symmetry) matrix should be
58c     built ... requires that ibas = jbas.
59c
60c     arguments
61c
62      integer ibas             !< [Input] bra basis sets
63      integer jbas             !< [Input] ket basis sets
64      integer g(*)             !< [Output] GA handle to array
65      character*(*) integ_type !< [Input] Name of integrals to compute
66      logical oskel            !< [Input] If true generate symmetry unique list
67c
68c     local variables
69c
70      integer type
71      logical dobq
72      character*255 integ_type1
73c
74      call ga_sync()
75c
76      dobq = geom_extbq_on()
77      integ_type1 = integ_type
78c
79      if (inp_compare(.false., integ_type1, 'potential0')) then
80        integ_type1='potential'
81        dobq=.false.
82cc AJL/Begin/SPIN-POLARISED ECPs
83      elseif (inp_compare(.false., integ_type1, 'potential_beta0')) then
84        integ_type1='potential_beta'
85        dobq=.false.
86cc AJL/End
87      end if
88c
89      if (oskel) then
90         if (ibas.ne.jbas) call errquit
91     $        ('int_1e_ga: use of symmetry requires ibas=jbas', ibas,
92     &       BASIS_ERR)
93      end if
94c
95      if (inp_compare(.false., integ_type1, 'kinetic')) then
96         type = 1
97      else if (inp_compare(.false., integ_type1, 'potential')) then
98         type = 2
99      else if (inp_compare(.false., integ_type1, 'overlap')) then
100         type = 3
101      else if (inp_compare(.false., integ_type1, 'pvp')) then
102         type = 4
103      else if (inp_compare(.false., integ_type1, 'so'))then
104         type = 5
105      else if (inp_compare(.false., integ_type1, 'cos_chg_pot'))then
106         type = 6
107      else if (inp_compare(.false., integ_type1, 'bq_pot'))then
108         type=7
109         if(.not.dobq) return
110cc AJL/Begin/SPIN-POLARISED ECPs
111      else if (inp_compare(.false., integ_type1, 'potential_beta')) then
112         type = 8
113cc AJL/End
114      else
115         write(6,*) ' integ_type1 = ', integ_type1
116         call errquit('int_1e_ga: unknown integ_type', 0, INT_ERR)
117      end if
118       if(type.lt.0.or.type.gt.10) call
119     E errquit(' bogus int1 type',0,INT_ERR)
120c
121c     Check if Douglas-Kroll is required, if so:
122c     getting the Douglas-Kroll kinetic and potential energy
123c     integrals
124c
125cc AJL/Begin/SPIN-POLARISED ECPs
126c      if (doug_kroll .and. (type.le.2)) then
127      if (doug_kroll .and. ((type.le.2) .or. (type.eq.8))) then
128cc AJL/End
129         if (ibas.ne.jbas) call errquit
130     $        ('int_1e_ga: Douglas-Kroll requires ibas=jbas', ibas,
131     &       BASIS_ERR)
132         call int_1edk_ga(ibas,g,type,oskel)
133         call ga_sync()            ! So that no nasty races can result
134         return
135      endif
136c
137c     Doing Douglas-Kroll Spin-Orbit terms
138c
139      if (doug_kroll .and. (type.eq.5)) then
140         if (ibas.ne.jbas) call errquit
141     $        ('int_1e_ga: Douglas-Kroll requires ibas=jbas', ibas,
142     &       BASIS_ERR)
143         call int_1edk_so_ga(ibas,g,type,oskel)
144         call ga_sync()            ! So that no nasty races can result
145         return
146      endif
147c
148      if (dobq) then
149         call int_1e_ooldga(ibas, jbas, g, integ_type1, oskel)
150cc AJL/Begin/SPIN-POLARISED ECPs
151cc         if(inp_compare(.false., integ_type1, 'potential'))
152cc     &      call int_1e_ooldga(ibas, jbas, g, 'bq_pot', oskel)
153         if (type.eq.2.or.type.eq.8) ! potential or potential_beta
154     &      call int_1e_ooldga(ibas, jbas, g, 'bq_pot', oskel)
155cc AJL/End
156      else
157         call int_1e_oldga(ibas, jbas, g, integ_type1, oskel)
158      end if
159c
160      end
161c
162      subroutine int_1e_ooldga(ibas, jbas, g, integ_type, oskel)
163      implicit none
164#include "errquit.fh"
165#include "cint1cache.fh"
166#include "mafdecls.fh"
167#include "global.fh"
168#include "rtdb.fh"
169#include "inp.fh"
170#include "apiP.fh"
171#include "bas.fh"
172#include "cscfps.fh"
173#include "sym.fh"
174c
175c     This is the original routine of int_1e_ga. It is still needed by the
176c     Douglas-Kroll routines to avoid recursive routine calling.
177c
178c     Compute the desired type of integrals (kinetic, potential, overlap)
179c     and ADD them into the given global array.
180c     This version computes the full square of integrals and should work
181c     OK even if ibas != jbas.
182c
183c     Oskel indicates that the skeleton (petite-list symmetry) matrix should be
184c     built ... requires that ibas = jbas.
185c
186c     arguments
187c
188      integer ibas, jbas        ! [input] bra and ket basis sets
189      integer g(3)              ! [output] GA handle to array. g(1..3) are used only
190                                ! for spin-orbit calculations. All other calculations use
191                                ! g(1) only
192      character*(*) integ_type  ! [input] Name of integrals to compute
193      logical oskel             ! [input] If true generate symmetry unique list
194c
195c     local variables
196c
197      integer nshell_i, nshell_j
198      integer ishell, jshell, iproc, nproc, mem1, max1e
199      integer ijshell, ilo, ihi, jlo, jhi, idim
200      integer l_buf, l_scr
201      integer k_buf, k_scr
202      integer type
203      logical odoit
204      double precision q2
205      external block_int1e      ! For T3D
206      integer i, noffset,g_loc
207c
208      logical ocache_save
209c
210      logical odbug
211      logical osome
212c
213      odbug=.false.
214      osome=.false.
215      osome=osome.or.odbug
216      odbug=odbug.and.(ga_nodeid().eq.0)
217      osome=osome.and.(ga_nodeid().eq.0)
218      if(osome) then
219         write(6,*) 'in -int_1e_ooldga- ... integ_type = ',
220     $              integ_type,ga_nodeid()
221         call util_flush(6)
222      endif
223c
224      call ga_sync()
225      if (oscfps) call pstat_on(ps_int_1e)
226c
227      if (oskel) then
228         if (ibas.ne.jbas) call errquit
229     $        ('int_1e_ga: use of symmetry requires ibas=jbas', ibas,
230     &       BASIS_ERR)
231      end if
232c
233      if (inp_compare(.false., integ_type, 'kinetic')) then
234         type = 1
235      else if (inp_compare(.false., integ_type, 'potential')) then
236         type = 2
237      else if (inp_compare(.false., integ_type, 'overlap')) then
238         type = 3
239      else if (inp_compare(.false., integ_type, 'pvp')) then
240         type = 4
241      else if (inp_compare(.false., integ_type, 'so'))then
242         type = 5
243      else if (inp_compare(.false., integ_type, 'cos_chg_pot'))then
244         type = 6
245      else if (inp_compare(.false., integ_type, 'bq_pot'))then
246         type = 7
247cc AJL/Begin/SPIN ECPs
248      else if (inp_compare(.false., integ_type, 'potential_beta')) then
249         type = 8
250cc AJL/End
251      else
252         write(6,*) ' integ_type = ', integ_type,ga_nodeid()
253         call errquit('int_1e_ga: unknown integ_type', 0, INT_ERR)
254      end if
255c
256c     ----- save ocache logical variable -----
257c
258      if(type.eq.6 .or. type.eq.7 ) then
259         ocache_save=ocache
260         ocache     =.false.
261      endif
262c
263c     In-core caching
264c
265c      ocache = .false.
266      if(osome) then
267         write(6,*) 'ocache = ',ocache,ga_nodeid()
268         call util_flush(6)
269      endif
270      if (ocache .and. (ibas.eq.bas1) .and. (jbas.eq.bas1)) then
271*         if (ga_nodeid().eq.0) then
272*           call ga_summarize(1)
273*           call util_flush(6)
274*         endif
275*         call ga_sync()
276c
277cc AJL/Begin/SPIN-POLARISED ECPs
278         if (type.ne.8) then
279           call ga_dadd(1.0d0, g_cache(type), 1.0d0, g, g)
280         else ! accomodate for potential_beta, stored in g_cache(4)
281           call ga_dadd(1.0d0, g_cache(4), 1.0d0, g, g)
282         endif
283cc AJL/End
284c
285         if (oscfps) call pstat_off(ps_int_1e)
286	 return
287      endif
288c
289c     Get info about the basis sets
290c
291      if (.not. bas_numcont(ibas, nshell_i)) call errquit
292     $     ('rhf_fock_1e: bas_numcont failed for ibas', ibas,
293     &       BASIS_ERR)
294      if (.not. bas_numcont(jbas, nshell_j)) call errquit
295     $     ('rhf_fock_1e: bas_numcont failed for jbas', jbas,
296     &       BASIS_ERR)
297c
298c     allocate necessary local temporary arrays on the stack
299c
300c     l_buf ... buffer to hold shell block of matrix
301c     l_s   ... buffer to hold shell block of matrix
302c     l_scr ... workspace for integral routines
303c
304c     k_* are the offsets corrsponding to the l_* handles
305c
306cso
307      call int_mem_1e(max1e, mem1)
308      if (type .eq. 5) then
309         max1e = 3*max1e
310         mem1 = 3*mem1
311      endif
312cso
313      if (.not. MA_push_get(MT_DBL,max1e,'int_1e_ga:buf',l_buf,k_buf))
314     $     call errquit('int_1e_ga: ma failed', max1e, MA_ERR)
315      if (.not. MA_push_get(MT_DBL, mem1,'int_1e_ga:scr',l_scr,k_scr))
316     $     call errquit('int_1e_ga: ma failed', mem1, MA_ERR)
317c
318c     Loop thru shells with static parallel work decomposition
319c
320      if (.not.inp_compare(.false., integ_type, 'so')) then
321         if(.not.ga_duplicate(g,g_loc,'local g')) call
322     .        errquit('int1e: dupl failed',0, GA_ERR)
323         call ga_zero(g_loc)
324      endif
325      iproc = ga_nodeid()
326      nproc = ga_nnodes()
327      ijshell = 0
328      q2 = 1.0d0
329      do jshell = 1, nshell_j
330         do ishell = 1, nshell_i
331c
332            if (mod(ijshell, nproc) .eq. iproc) then
333               odoit = .true.
334               if (oskel)
335     $              odoit = sym_shell_pair(ibas, ishell, jshell, q2)
336c
337               if (odoit) then
338                  if (.not. bas_cn2bfr(ibas, ishell, ilo, ihi))
339     $                 call errquit('int_1e_ga: bas_cn2bfr ?', ibas,
340     &       BASIS_ERR)
341                  if (.not. bas_cn2bfr(jbas, jshell, jlo, jhi))
342     $                 call errquit('int_1e_ga: bas_cn2bfr ?', jbas,
343     &       BASIS_ERR)
344                  idim = ihi - ilo + 1
345c
346c     Generate the integrals
347c
348                  if (type .eq. 1) then
349                     call int_1eke (jbas, jshell, ibas, ishell,
350     $                    mem1, dbl_mb(k_scr), max1e, dbl_mb(k_buf))
351                  else if (type .eq. 2) then
352                     call int_1epe (jbas, jshell, ibas, ishell,
353     $                    mem1, dbl_mb(k_scr), max1e, dbl_mb(k_buf))
354                  else if (type .eq. 3) then
355                     call int_1eov (jbas, jshell, ibas, ishell,
356     $                    mem1, dbl_mb(k_scr), max1e, dbl_mb(k_buf))
357                  else if (type .eq. 4) then
358                     call int_1epvpe (jbas, jshell, ibas, ishell,
359     $                    mem1, dbl_mb(k_scr), max1e, dbl_mb(k_buf))
360                  else if (type .eq. 5) then
361                     call intso_1e (jbas, jshell, ibas, ishell,
362     $                    mem1, dbl_mb(k_scr), max1e, dbl_mb(k_buf))
363                  else if (type .eq. 6) then
364                     if(odbug) then
365                        write(6,*) 'type = 6 ... potential ...',
366     $                             ga_nodeid()
367                        call util_flush(6)
368                     endif
369                     call int_1epot (jbas, jshell, ibas, ishell,
370     $                    mem1, dbl_mb(k_scr), max1e, dbl_mb(k_buf))
371                  else if (type .eq. 7) then
372                     call int_1epot1 (jbas, jshell, ibas, ishell,
373     $                    mem1, dbl_mb(k_scr), max1e, dbl_mb(k_buf))
374cc AJL/Begin/SPIN ECPs
375                 else if (type .eq. 8) then
376                     call int_1epe_beta (jbas, jshell, ibas, ishell,
377     $                    mem1, dbl_mb(k_scr), max1e, dbl_mb(k_buf))
378cc AJL/End
379                  else
380                     call errquit('int_1e_ga: invalid type?', type,
381     &       GA_ERR)
382                  end if
383c
384c     Add the integrals into the global array
385c
386                  if (inp_compare(.false., integ_type, 'so')) then
387                     do i = 1, 3
388                        noffset = (ihi-ilo+1)*(jhi-jlo+1)*(i-1)
389                        call ga_acc(g(i), ilo, ihi, jlo, jhi,
390     $                    dbl_mb(k_buf+noffset),
391     $                    idim, q2)
392                     enddo
393                  else
394                     if(odbug) then
395                        write(6,*) 'ga_acc = ...',ga_nodeid()
396                        call util_flush(6)
397                     endif
398cedo                     call ga_acc(g, ilo, ihi, jlo, jhi, dbl_mb(k_buf),
399cedo     $                    idim, q2)
400                    if(q2.ne.1) then
401                      call dscal((ihi-ilo+1)*(jhi-jlo+1),
402     ,            q2,dbl_mb(k_buf),1)
403                    endif
404                     call ga_put(g_loc, ilo, ihi, jlo, jhi,
405     ,             dbl_mb(k_buf),  idim)
406                 end if
407               end if
408            endif
409            ijshell = ijshell + 1
410         end do
411      end do
412c
413c     chop stack at first item allocated
414c
415      if (.not. MA_pop_stack(l_scr)) call errquit
416     $     ('int_1e_ga: pop failed', 0, GA_ERR)
417      if (.not. MA_pop_stack(l_buf)) call errquit
418     $     ('int_1e_ga: pop failed', 0, GA_ERR)
419c
420c     ----- restore ocache -----
421c
422      if(type.eq.6 .or. type.eq.7) then
423         ocache=ocache_save
424      endif
425c
426      if (.not.inp_compare(.false., integ_type, 'so')) then
427         call ga_dadd(1.0d0, g_loc, 1.0d0, g, g)
428         if (.not. ga_destroy(g_loc)) call errquit('i1ega: gad?',0,
429     &       GA_ERR)
430      endif
431      call ga_sync()            ! So that no nasty races can result
432c
433      if (oscfps) call pstat_off(ps_int_1e)
434c
435      end
436      subroutine int_1e_cache_ga(basis, oskel)
437      implicit none
438#include "errquit.fh"
439#include "cint1cache.fh"
440#include "bas.fh"
441      integer basis
442      logical oskel
443c
444      integer geom
445      integer ga_create_atom_blocked
446      external ga_create_atom_blocked
447c
448cc AJL/Begin/SPIN ECPs
449#include "global.fh"
450      integer ecp_handle
451cc AJL/End
452c
453      if (ocache) call int_1e_uncache_ga()
454c
455      if (.not. bas_geom(basis, geom)) call errquit
456     $   ('int_1e_cache_ga: basis corrupt?', 0, BASIS_ERR)
457c
458c	The use of ga_dadd to do the copy requires all uses of
459c	these integrals to be allocated via ga_create_atom_blocked
460c
461*      write(6,*) ' Enabling caching of 1-e integrals '
462c
463      g_cache(1) = ga_create_atom_blocked(geom, basis,'int1e: t')
464      g_cache(2) = ga_create_atom_blocked(geom, basis,'int1e: v')
465      g_cache(3) = ga_create_atom_blocked(geom, basis,'int1e: s')
466      call ga_zero(g_cache(1))
467      call ga_zero(g_cache(2))
468      call ga_zero(g_cache(3))
469      call int_1e_ga(basis, basis, g_cache(1), 'kinetic', oskel)
470      call int_1e_ga(basis, basis, g_cache(2), 'potential0', oskel)
471      call int_1e_ga(basis, basis, g_cache(3), 'overlap', .false.)
472c
473cc AJL/Begin/SPIN ECPs
474      if (bas_get_ecp_handle(basis,ecp_handle)) then
475        if (.not.ecp_get_high_chan(ecp_handle,channels)) channels = 1
476        if (channels.gt.1) then
477          if (ga_nodeid().eq.0) then
478            write(6,*) 'ECP Channels : ', channels
479            call util_flush(6)
480          endif
481          g_cache(4) =
482     &            ga_create_atom_blocked(geom, basis,'int1e: v_beta')
483          call ga_zero(g_cache(4))
484          call int_1e_ga(basis, basis, g_cache(4),
485     &                   'potential_beta0', oskel)
486        end if
487      end if
488cc AJL/End
489c
490      bas1 = basis
491      ocache = .true.
492c
493      end
494      subroutine int_1e_uncache_ga()
495      implicit none
496#include "errquit.fh"
497#include "cint1cache.fh"
498      logical ga_destroy
499c
500*      write(6,*) ' Disabling caching of 1-e integrals '
501c
502      if (.not. ocache) return
503      if (.not. ga_destroy(g_cache(1))) call errquit('i1ega: gad?',0,
504     &       BASIS_ERR)
505      if (.not. ga_destroy(g_cache(2))) call errquit('i1ega: gad?',0,
506     &       BASIS_ERR)
507      if (.not. ga_destroy(g_cache(3))) call errquit('i1ega: gad?',0,
508     &       BASIS_ERR)
509c
510cc AJL/Begin/SPIN ECPs
511      if (channels.gt.1) then
512        if (.not. ga_destroy(g_cache(4))) call errquit('i1ega: gad?',0,
513     &                       BASIS_ERR)
514      end if
515cc AJL/End
516c
517      bas1 = -1
518      ocache = .false.
519      end
520      subroutine int_1e_oldga(ibas, jbas, g, integ_type, oskel)
521      implicit none
522#include "inp.fh"
523#include "errquit.fh"
524#include "global.fh"
525      integer ibas, jbas        ! [input] bra and ket basis sets
526      integer g(3)              ! [output] GA handle to array. g(1..3) are used only
527                                ! for spin-orbit calculations. All other calculations use
528                                ! g(1) only
529      character*(*) integ_type  ! [input] Name of integrals to compute
530      logical oskel             ! [input] If true generate symmetry unique list
531c
532      external int_1eke,int_1epe,int_1eov,int_1epvpe,
533     I     int_1epot,int_1epot1,
534cc AJL/Begin/SPIN ECPs
535     I     int_1epe_beta
536cc AJL/End
537      integer type
538c
539
540      if(ibas.ne.jbas) then
541         call int_1e_ooldga(ibas, jbas, g,integ_type,oskel)
542         return
543      endif
544      if (inp_compare(.false., integ_type, 'so'))then
545cso
546          call int_1e_ooldga(ibas, jbas, g,integ_type,oskel)
547          return
548       endif
549      if (inp_compare(.false., integ_type, 'kinetic')) then
550         type = 1
551         call int_1e_oldga0(ibas, g, type,oskel,int_1eke)
552      else if (inp_compare(.false., integ_type, 'potential')) then
553         type = 2
554         call int_1e_oldga0(ibas, g, type,oskel,int_1epe)
555      else if (inp_compare(.false., integ_type, 'overlap')) then
556         type = 3
557         call int_1e_oldga0(ibas, g, type,oskel,int_1eov)
558      else if (inp_compare(.false., integ_type, 'pvp')) then
559         type = 4
560         call int_1e_oldga0(ibas, g, type,oskel,int_1epvpe)
561      else if (inp_compare(.false., integ_type, 'cos_chg_pot'))then
562         type = 6
563         call int_1e_oldga0(ibas, g, type,oskel,int_1epot)
564      else if (inp_compare(.false., integ_type, 'bq_pot'))then
565         type = 7
566         call int_1e_oldga0(ibas, g, type,oskel,int_1epot1)
567cc AJL/Begin/SPIN ECPs
568      else if (inp_compare(.false., integ_type, 'potential_beta')) then
569         type = 8
570         call int_1e_oldga0(ibas, g, type, oskel, int_1epe_beta)
571cc AJL/End/SPIN ECPs
572      else
573         write(6,*) ' integ_type = ', integ_type,ga_nodeid()
574         call errquit('int_1e_oldga: unknown integ_type', 0, INT_ERR)
575      end if
576
577      return
578      end
579      subroutine int_1e_oldga0(ibas, g, type, oskel,
580     I     int_call)
581      implicit none
582#include "errquit.fh"
583#include "cint1cache.fh"
584#include "mafdecls.fh"
585#include "global.fh"
586#include "rtdb.fh"
587#include "inp.fh"
588#include "apiP.fh"
589#include "bas.fh"
590#include "cscfps.fh"
591#include "sym.fh"
592#include "geom.fh"
593c
594c     This is the original routine of int_1e_ga. It is still needed by the
595c     Douglas-Kroll routines to avoid recursive routine calling.
596c
597c     Compute the desired type of integrals (kinetic, potential, overlap)
598c     and ADD them into the given global array.
599c
600c     Oskel indicates that the skeleton (petite-list symmetry) matrix should be
601c     built ... requires that ibas = jbas.
602c
603c     arguments
604c
605      integer ibas              ! [input] bra and ket basis sets
606      integer g(3)              ! [output] GA handle to array. g(1..3) are used only
607                                ! for spin-orbit calculations. All other calculations use
608                                ! g(1) only
609      integer type              ! [input] Name of integrals to compute
610      logical oskel             ! [input] If true generate symmetry unique list
611c
612c     local variables
613c
614      integer nshell_i, nshell_j
615      integer ishell, jshell, iproc, nproc, mem1, max1e
616      integer ijshell, ilo, ihi, jlo, jhi, idim
617      integer l_buf, l_scr
618      integer k_buf, k_scr
619      logical odoit
620      double precision q2
621      external block_int1e      ! For T3D
622      integer i, g_loc
623      integer geom
624c
625      logical ocache_save
626c
627      logical odbug
628      logical osome
629      external int_call
630c
631      odbug=.false.
632      osome=.false.
633      osome=osome.or.odbug
634      odbug=odbug.and.(ga_nodeid().eq.0)
635      osome=osome.and.(ga_nodeid().eq.0)
636      if(osome) then
637         write(6,*) 'in -int_1e_oldga0- ... integ_type = ',
638     $              type,ga_nodeid()
639         call util_flush(6)
640      endif
641c
642      call ga_sync()
643c
644      if (oscfps) call pstat_on(ps_int_1e)
645c
646c     ----- save ocache logical variable -----
647c
648      if(type.eq.6 .or. type.eq.7 ) then
649         ocache_save=ocache
650         ocache     =.false.
651      endif
652c
653c     In-core caching
654c
655c      ocache = .false.
656      if(osome) then
657         write(6,*) 'ocache = ',ocache,ga_nodeid()
658         call util_flush(6)
659      endif
660      if (ocache .and. (ibas.eq.bas1)) then
661cc AJL/Begin/SPIN ECPs
662         if (type.ne.8) then ! everything except potential_beta
663           call ga_dadd(1.0d0, g_cache(type), 1.0d0, g, g)
664         else
665           call ga_dadd(1.0d0, g_cache(4), 1.0d0, g, g)
666         end if
667cc AJL/End
668         if (oscfps) call pstat_off(ps_int_1e)
669         return
670      endif
671c
672c     Get info about the basis sets
673c
674      if (.not. bas_numcont(ibas, nshell_i)) call errquit
675     $     ('int_1e_oldga0: bas_numcont failed for ibas', ibas,
676     &       BASIS_ERR)
677      nshell_j=nshell_i
678c
679c     allocate necessary local temporary arrays on the stack
680c
681c     l_buf ... buffer to hold shell block of matrix
682c     l_s   ... buffer to hold shell block of matrix
683c     l_scr ... workspace for integral routines
684c
685c     k_* are the offsets corrsponding to the l_* handles
686c
687cso
688c
689c     Loop thru shells with static parallel work decomposition
690c
691      if(.not.ga_duplicate(g,g_loc,'local g')) call
692     .     errquit('int_1e_oldga0: dupl failed',0, GA_ERR)
693      call ga_zero(g_loc)
694      iproc = ga_nodeid()
695      nproc = ga_nnodes()
696      if (.not. bas_geom(ibas, geom)) call errquit
697     $   ('int_1e_oldga0: basis corrupt?', 0, BASIS_ERR)
698c
699      call int_mem_1e(max1e, mem1)
700      call ga_get2eri(ibas, g_loc, oskel, max1e, mem1, int_call)
701      if (oskel) call sym_symmetrize(geom,ibas,.false.,g_loc)
702c
703c     ----- restore ocache -----
704c
705      if(type.eq.6 .or. type.eq.7) then
706         ocache=ocache_save
707      endif
708c
709      call ga_dadd(1.0d0, g_loc, 1.0d0, g, g)
710      call ga_sync()            ! So that no nasty races can result
711      if (.not. ga_destroy(g_loc)) call errquit('int_1e_oldga0: gad?',0,
712     &     GA_ERR)
713      call ga_sync()            ! So that no nasty races can result
714c
715      if (oscfps) call pstat_off(ps_int_1e)
716c
717      end
718