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