diff --git a/src/NWints/simint/source/nwcsim_facef90.F b/src/NWints/simint/source/nwcsim_facef90.F index 3177bae25f..fd4283677b 100644 --- a/src/NWints/simint/source/nwcsim_facef90.F +++ b/src/NWints/simint/source/nwcsim_facef90.F @@ -121,8 +121,8 @@ subroutine nwcsim_init(rtdb,nbas,bases,num_der) C coord(1), coord(2), coord(3), & dbl_mb(k_exp), dbl_mb(k_coef), L zero_sh(nwcsim_noshell(bas),bas)) - enddo - enddo + enddo ! contractions + enddo ! atoms if(.not.ma_chop_stack(l_exp)) call errquit( E ' pop stack failed ',l_exp,0) c @@ -179,11 +179,12 @@ subroutine nwcsim_terminate() call simint_free_multi_shellpair(ket_msh) do ibasis=1,nwcsim_nbas bas=nwcsim_bas(ibasis) - do icsh=1,nwcsim_noshell(bas) - call simint_free_shell(smnt_sh(icsh,bas)) - call simint_free_shell(zero_sh(icsh,bas)) - enddo + do icsh=1,nwcsim_noshell(bas) + call simint_free_shell(smnt_sh(icsh,bas)) + call simint_free_shell(zero_sh(icsh,bas)) + enddo enddo + call nwcsim_clearcache() endif call simint_finalize() nwcsim_initialized=.false. diff --git a/src/NWints/simint/source/nwcsim_hf.fh b/src/NWints/simint/source/nwcsim_hf.fh new file mode 100644 index 0000000000..29bcd7b975 --- /dev/null +++ b/src/NWints/simint/source/nwcsim_hf.fh @@ -0,0 +1,4 @@ + integer cache1,cache2,cache3,cache4 + common/nwcsim_shpair_cache/ cache1,cache2,cache3,cache4 + integer nwcsim_cache + external nwcsim_cache diff --git a/src/NWints/simint/source/nwcsim_hf2.F b/src/NWints/simint/source/nwcsim_hf2.F index 2bc46472af..2bdcc08736 100644 --- a/src/NWints/simint/source/nwcsim_hf2.F +++ b/src/NWints/simint/source/nwcsim_hf2.F @@ -3,8 +3,9 @@ block data nwcsim_shpair * $Id$ * implicit none +c#include "nwcsim_hf.fh" integer cache1,cache2,cache3,cache4 - common/nwcsim_shpair_cache/cache1,cache2,cache3,cache4 + common/nwcsim_shpair_cache/ cache1,cache2,cache3,cache4 data cache1,cache2,cache3,cache4/-1,-1,-1,-1/ end @@ -25,6 +26,7 @@ subroutine nwcsim_hf2(ij_basis,i_sh,j_sh, integer lscr #include "errquit.fh" #include "mafdecls.fh" +#include "global.fh" #define DEBUG_ 1 #ifdef DEBUG double precision, pointer :: p1(:), p2(:),p3(:),p4(:) @@ -33,24 +35,25 @@ subroutine nwcsim_hf2(ij_basis,i_sh,j_sh, character*10 pname integer*4 zerod parameter(zerod=0) - integer cache1,cache2,cache3,cache4 - common/nwcsim_shpair_cache/cache1,cache2,cache3,cache4 +#include "nwcsim_hf.fh" pname="nwcsim_hf2" c c match ijkl shell to simint shell c - if(i_sh.ne.cache1.or.j_sh.ne.cache2) then + if(nwcsim_cache(ij_basis,i_sh).ne.cache1.or. + O nwcsim_cache(ij_basis,j_sh).ne.cache2) then call simint_create_multi_shellpair(1, smnt_sh(i_sh,ij_basis),1, S smnt_sh(j_sh,ij_basis), bra_msh, smnt_screen_method) - cache1=i_sh+10000000*ij_basis - cache2=j_sh+10000000*ij_basis + cache1=nwcsim_cache(ij_basis,i_sh) + cache2=nwcsim_cache(ij_basis,j_sh) endif - if(k_sh.ne.cache3.or.l_sh.ne.cache4) then + if(nwcsim_cache(kl_basis,k_sh).ne.cache3.or. + O nwcsim_cache(kl_basis,l_sh).ne.cache4) then call simint_create_multi_shellpair(1,smnt_sh(k_sh,kl_basis), S 1,smnt_sh(l_sh,kl_basis), ket_msh, smnt_screen_method) - cache3=k_sh+10000000*kl_basis - cache4=l_sh+10000000*kl_basis + cache3=nwcsim_cache(kl_basis,k_sh) + cache4=nwcsim_cache(kl_basis,l_sh) endif #ifdef DEBUG write(6,'(a,2i10)') ' basis tags ',ij_basis,kl_basis @@ -102,26 +105,27 @@ subroutine nwcsim_hf2_3c(i_basis,i_sh,jk_basis,j_sh,k_sh, integer lscr #include "errquit.fh" #include "mafdecls.fh" +#include "global.fh" integer i - character*10 pname - integer cache1,cache2,cache3,cache4 - common/nwcsim_shpair_cache/ cache1,cache2,cache3,cache4 + character*10 pname +#include "nwcsim_hf.fh" pname="nwcsim_hf2_3c" c c match ijkl shell to simint shell c - if(i_sh.ne.cache1.or.cache2.ne.0) then + if(nwcsim_cache(i_basis,i_sh).ne.cache1.or.cache2.ne.0) then call simint_create_multi_shellpair(1,smnt_sh(i_sh,i_basis), S 1,zero_sh(j_sh,i_basis), bra_msh, smnt_screen_method) - cache1=i_sh+10000000*i_basis + cache1=nwcsim_cache(i_basis,i_sh) cache2=0 endif - if(j_sh.ne.cache3.or.k_sh.ne.cache4) then + if(nwcsim_cache(jk_basis,j_sh).ne.cache3.or. + O nwcsim_cache(jk_basis,k_sh).ne.cache4) then call simint_create_multi_shellpair(1, smnt_sh(j_sh,jk_basis), 1, S smnt_sh(k_sh,jk_basis), ket_msh, smnt_screen_method) - cache3=j_sh+10000000*jk_basis - cache4=k_sh+10000000*jk_basis + cache3=nwcsim_cache(jk_basis,j_sh) + cache4=nwcsim_cache(jk_basis,k_sh) endif ncomputed = simint_compute_eri(bra_msh, ket_msh, smnt_screen_tol, C scr, eri) @@ -151,23 +155,24 @@ subroutine nwcsim_hf2_2c(i_basis,i_sh,j_basis,j_sh, #include "mafdecls.fh" #define DEBUG_ 1 integer i - integer cache1,cache2,cache3,cache4 - common/nwcsim_shpair_cache/ cache1,cache2,cache3,cache4 character*10 pname +#include "nwcsim_hf.fh" pname="nwcsim_hf2_2c" c c match ijkl shell to simint shell c - if(i_sh.ne.cache1) then + if(nwcsim_cache(i_basis,i_sh).ne.cache1.or.cache2.ne.0) then call simint_create_multi_shellpair(1,smnt_sh(i_sh,i_basis), S 1,zero_sh(i_sh,i_basis), bra_msh, smnt_screen_method) - cache1=i_sh+10000000*i_basis + cache1=nwcsim_cache(i_basis,i_sh) + cache2=0 endif - if(j_sh.ne.cache3) then + if(nwcsim_cache(j_basis,j_sh).ne.cache3.or.cache4.ne.0) then call simint_create_multi_shellpair(1, smnt_sh(j_sh,j_basis), 1, S zero_sh(j_sh,j_basis), ket_msh, smnt_screen_method) - cache3=j_sh+10000000*j_basis + cache3=nwcsim_cache(j_basis,j_sh) + cache4=0 endif ncomputed = simint_compute_eri(bra_msh, ket_msh, S smnt_screen_tol, @@ -200,8 +205,7 @@ subroutine nwcsim_hf2d(ij_basis,i_sh,j_sh, c type(c_simint_multi_shellpair), target :: bra_msh, ket_msh integer i character*10 pname - integer cache1,cache2,cache3,cache4 - common/nwcsim_shpair_cache/ cache1,cache2,cache3,cache4 +#include "nwcsim_hf.fh" pname="nwcsim_hf2d" c c match ijkl shell to simint shell @@ -210,17 +214,19 @@ subroutine nwcsim_hf2d(ij_basis,i_sh,j_sh, c call simint_initialize_multi_shellpair(bra_msh) c call simint_initialize_multi_shellpair(ket_msh) - if(i_sh.ne.cache1.or.j_sh.ne.cache2) then + if(nwcsim_cache(ij_basis,i_sh).ne.cache1.or. + O nwcsim_cache(ij_basis,j_sh).ne.cache2) then call simint_create_multi_shellpair(1, smnt_sh(i_sh,ij_basis),1, S smnt_sh(j_sh,ij_basis), bra_msh, smnt_screen_method) - cache1=i_sh+10000000*ij_basis - cache2=j_sh+10000000*ij_basis + cache1=nwcsim_cache(ij_basis,i_sh) + cache2=nwcsim_cache(ij_basis,j_sh) endif - if(k_sh.ne.cache3.or.l_sh.ne.cache4) then + if(nwcsim_cache(kl_basis,k_sh).ne.cache3.or. + O nwcsim_cache(kl_basis,l_sh).ne.cache4) then call simint_create_multi_shellpair(1,smnt_sh(k_sh,kl_basis), - S 1,smnt_sh(l_sh,kl_basis), ket_msh, smnt_screen_method) - cache3=k_sh+10000000*kl_basis - cache4=l_sh+10000000*kl_basis + S 1,smnt_sh(l_sh,kl_basis), ket_msh, smnt_screen_method) + cache3=nwcsim_cache(kl_basis,k_sh) + cache4=nwcsim_cache(kl_basis,l_sh) endif ncomputed = simint_compute_eri_deriv(smnt_deriv,bra_msh, ket_msh, @@ -253,8 +259,7 @@ subroutine nwcsim_hf2d_2c(i_basis,i_sh, c type(c_simint_multi_shellpair), target :: bra_msh, ket_msh integer i character*10 pname - integer cache1,cache2,cache3,cache4 - common/nwcsim_shpair_cache/ cache1,cache2,cache3,cache4 +#include "nwcsim_hf.fh" pname="nwcsim_hf2d_2c" c c match ijkl shell to simint shell @@ -263,15 +268,17 @@ subroutine nwcsim_hf2d_2c(i_basis,i_sh, c call simint_initialize_multi_shellpair(bra_msh) c call simint_initialize_multi_shellpair(ket_msh) - if(i_sh.ne.cache1) then - call simint_create_multi_shellpair(1, smnt_sh(i_sh,i_basis), 1, - S zero_sh(i_sh,i_basis), bra_msh, smnt_screen_method) - cache1=i_sh+10000000*i_basis + if(nwcsim_cache(i_basis,i_sh).ne.cache1.or.cache2.ne.0) then + call simint_create_multi_shellpair(1,smnt_sh(i_sh,i_basis), + S 1,zero_sh(i_sh,i_basis), bra_msh, smnt_screen_method) + cache1=nwcsim_cache(i_basis,i_sh) + cache2=0 endif - if(j_sh.ne.cache3) then - call simint_create_multi_shellpair(1, smnt_sh(j_sh,j_basis), 1, + if(nwcsim_cache(j_basis,j_sh).ne.cache3.or.cache4.ne.0) then + call simint_create_multi_shellpair(1, smnt_sh(j_sh,j_basis), 1, S zero_sh(j_sh,j_basis), ket_msh, smnt_screen_method) - cache3=j_sh+10000000*j_basis + cache3=nwcsim_cache(j_basis,j_sh) + cache4=0 endif ncomputed = simint_compute_eri_deriv(smnt_deriv,bra_msh, ket_msh, @@ -304,38 +311,53 @@ subroutine nwcsim_hf2d_3c(i_basis,i_sh, c type(c_simint_multi_shellpair), target :: bra_msh, ket_msh integer i character*10 pname - integer cache1,cache2,cache3,cache4 - common/nwcsim_shpair_cache/ cache1,cache2,cache3,cache4 +#include "nwcsim_hf.fh" pname="nwcsim_hf2d_3c" c c match ijkl shell to simint shell -c -c call simint_initialize_multi_shellpair(bra_msh) -c call simint_initialize_multi_shellpair(ket_msh) - if(i_sh.ne.cache1.or.cache2.ne.0) then - call simint_create_multi_shellpair(1, smnt_sh(i_sh,i_basis), 1, - S zero_sh(i_sh,i_basis), bra_msh, smnt_screen_method) - cache1=i_sh+10000000*i_basis + if(nwcsim_cache(i_basis,i_sh).ne.cache1.or.cache2.ne.0) then + call simint_create_multi_shellpair(1,smnt_sh(i_sh,i_basis), + S 1,zero_sh(j_sh,i_basis), bra_msh, smnt_screen_method) + cache1=nwcsim_cache(i_basis,i_sh) cache2=0 endif - if(j_sh.ne.cache3.or.k_sh.ne.cache4) then - call simint_create_multi_shellpair(1,smnt_sh(j_sh,jk_basis), 1, - S smnt_sh(k_sh,jk_basis), ket_msh, smnt_screen_method) - cache3=j_sh+10000000*jk_basis - cache4=k_sh+10000000*jk_basis + if(nwcsim_cache(jk_basis,j_sh).ne.cache3.or. + O nwcsim_cache(jk_basis,k_sh).ne.cache4) then + call simint_create_multi_shellpair(1, smnt_sh(j_sh,jk_basis), 1, + S smnt_sh(k_sh,jk_basis), ket_msh, smnt_screen_method) + cache3=nwcsim_cache(jk_basis,j_sh) + cache4=nwcsim_cache(jk_basis,k_sh) endif ncomputed = simint_compute_eri_deriv(smnt_deriv,bra_msh, ket_msh, s smnt_screen_tol, C scr, eri) -c call simint_free_multi_shellpair(bra_msh) -c call simint_free_multi_shellpair(ket_msh) if(ncomputed.gt.leri) call errquit( P pname//'ncomputed gt leri ',ncomputed*10000+leri, BASIS_ERR) return end + integer function nwcsim_cache(bas_in,sh_in) + implicit none + integer bas_in,sh_in + nwcsim_cache=sh_in+10000000*bas_in + if(nwcsim_cache.le.0) then + write(6,*) 'nwcsim_cache: bas_in,sh_in',bas_in,sh_in, + W 'returns ',nwcsim_cache + call errquit(' wrong caching ',0,0) + endif + return + end + subroutine nwcsim_clearcache() + implicit none +#include "nwcsim_hf.fh" + cache1=-1 + cache2=-1 + cache3=-1 + cache4=-1 + return + end #endif #else subroutine nwcsim_hf2()