1      double precision function dft_n3cdbl()
2C$Id$
3      implicit none
4#include "errquit.fh"
5c****
6c**** nwchem handles
7c****
8!      integer  AO_bas_han, CD_bas_han
9!      integer itol2e ! bi-el int tolerance [input]
10c****
11#include "cdft.fh"
12#include "bas.fh"
13#include "basP.fh"
14#include "tcgmsg.fh"
15#include "global.fh"
16#include "schwarz.fh"
17#include "stdio.fh"
18#include "util.fh"
19c
20c     compute no. of 3-ctr integrals non null
21c     according to Schwarz screening
22c
23      integer me,nproc,ishc,ifirstc,ilastc,nshbfc,ishd,
24     &        ifirstd,ilastd,nshbfd,mxcebf_ao
25      integer maxg, mscratch_2e3c
26      integer itype,nprimo,isphere
27      integer sh_lo_d, sh_hi_d, atom_d
28      integer sh_lo_c, sh_hi_c, atom_c
29      double precision THRESHOLD,ERI_est,n3,ischw1
30      double precision imb_fact
31      logical oprint_3c2e,spherical_ao,spherical_cd,
32     C     oprint_3c2eh
33      double precision dbldum
34      integer intdum,ndone
35      integer n_batch, n_bmax
36      integer dft_nao2_max
37      external dft_nao2_max
38c
39      oprint_3c2e = util_print('3c 2e integrals', print_default)
40      oprint_3c2eh = util_print('3c 2e integrals details', print_high)
41      THRESHOLD=10.d0**(-itol2e)
42      nproc=ga_nnodes()
43      spherical_ao=bas_spherical(ao_bas_han)
44      spherical_cd=bas_spherical(cd_bas_han)
45c
46c     Determine the characteristics of the AO and CD Gaussian basis sets.
47c
48c
49      if( .not. bas_nbf_ce_max(AO_bas_han,mxcebf_ao) )then
50        call errquit('Exiting in dft_n3c.',1, BASIS_ERR)
51      end if
52c
53c
54      me=ga_nodeid()
55c
56c     Determine number of 3 center 2e- integrals based on Schwarz screening.
57c
58      ischw1 = 0.0d0
59      call int_mem_2e3c(maxg, mscratch_2e3c)
60c
61      do atom_c=1,ncenters
62         if (.not. bas_ce2cnr( ao_bas_han, atom_c, sh_lo_c, sh_hi_c))
63     &        call errquit('Exiting in dft_fitcd',110, BASIS_ERR)
64      do ishc = sh_lo_c,sh_hi_c
65c
66         if(spherical_ao) then
67            if(.not.bas_continfo(ao_bas_han,ishc,
68     &           itype,nprimo,nshbfc,isphere))
69     &           call errquit('Exiting in fitcd.',44, BASIS_ERR)
70            nshbfc=((itype+1)*(itype+2))/2*nshbfc
71         else
72            if( .not.bas_cn2bfr( AO_bas_han,ishc,ifirstc,ilastc))
73     &           call errquit('Exiting in dft_n3c.',3, BASIS_ERR)
74            nshbfc=ilastc-ifirstc+1
75         endif
76c
77      do atom_d=1,atom_c
78         if (.not. bas_ce2cnr( ao_bas_han, atom_d, sh_lo_d, sh_hi_d))
79     &        call errquit('Exiting in dft_fitcd',110, BASIS_ERR)
80        do ishd = sh_lo_d, sh_hi_d
81c
82c          Schwarz Screen integral blocks:  (p|cd) .le. (cd|cd)
83c
84          ERI_est=schwarz_shell(ishc,ishd)
85c
86          if( ERI_est.gt.THRESHOLD )then
87c
88             if(spherical_ao) then
89                if(.not.bas_continfo(ao_bas_han,ishd,
90     &               itype,nprimo,nshbfd,isphere))
91     &               call errquit('Exiting in fitcd.',44, BASIS_ERR)
92                nshbfd=((itype+1)*(itype+2))/2*nshbfd
93             else
94                if (.not. bas_cn2bfr( AO_bas_han,ishd,
95     &               ifirstd,ilastd))
96     &               call errquit('Exiting in fitvcoul.',4, BASIS_ERR)
97                nshbfd=ilastd-ifirstd+1
98             endif
99            ischw1 = ischw1 + dble(nshbfc*nshbfd)
100c
101          end if
102c
103       enddo ! ishd
104c
105      enddo ! ishc
106      enddo
107      enddo
108      ischw1 = ischw1*nbf_cd
109c
110c
111c     Define n3 = maximum number of 3 center 2e- integrals.
112c
113      n3=dble(nbf_ao**2)*dble(nbf_cd)
114c
115c     Define dft_n3cdbl=total number of non-zero 3 center 2e- ints.
116c
117      dft_n3cdbl=min(ischw1,n3)
118c
119c     Redefine dft_n3cdbl=buffer size of 3 center 2e- integrals
120c
121      call dft_getcdt(.true.,ndone,
122     N     ncenters, 1, .false., threshold, .true.,
123     N     intdum, 100000000, intdum,
124     &     intdum, dbldum,
125     T     dbldum, intdum)
126      if(oprint_3c2eh) then
127         write(6,*) ga_nodeid(),' ndone ',ndone
128      endif
129      dft_n3cdbl = ndone
130
131c
132      if (oprint_3c2e.and.me.eq.0)then
133         write(LuOut,*)
134         call util_print_centered
135     &      (LuOut,'3 Center 2 Electron Integral Information',25,.true.)
136         write(LuOut,1111)n3, ischw1,
137     D        dft_n3cdbl
138      endif
139 1111 format(10x,'Maximum number of 3-center 2e- integrals is:',f17.0,
140     &     /,10x,'  This is reduced with Schwarz screening to:',f17.0,
141     &     /,10x,'  Incore requires a per proc buffer size of:',f17.0)
142c
143      return
144      end
145      integer function dft_n3cint()
146C$Id$
147      implicit none
148#include "errquit.fh"
149#include "bas.fh"
150#include "rtdb.fh"
151#include "mafdecls.fh"
152#include "global.fh"
153#include "msgids.fh"
154#include "cdft.fh"
155c
156      integer nproc
157c
158      nproc=ga_nnodes()
159c
160      if( .not. bas_numcont(AO_bas_han,nshells_ao) )then
161        call errquit('Exiting in dft_3cinc.',1, BASIS_ERR)
162      end if
163c
164      if(nproc.gt.1) then
165c
166c       Allow for some load-imbalance (factor of 2).
167c
168        dft_n3cint = ncenters*(ncenters+1)/nproc
169        dft_n3cint = dft_n3cint*2
170        dft_n3cint=max(dft_n3cint,ncenters)
171#ifdef DEBUG
172        if(ga_nodeid().eq.0) then
173     C       write(6,*) ' dft_n3cint0 ',dft_n3cint, ' nctr0 ',ncenters
174     C       write(6,*) ' dft_n3cint ',dft_n3cint, ' nctr ',ncenters
175        endif
176#endif
177      else
178         dft_n3cint = ncenters*(ncenters+1)
179      endif
180      return
181      end
182