diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 0ac11353..36bd48aa 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -133,6 +133,9 @@ class H_apply(object): self["filterparticle"] = """ if(iand(ibset(0_bit_kind,j_a),hole(k_a,other_spin)).eq.0_bit_kind )cycle """ + def unset_skip(self): + self["skip"] = """ + """ def set_filter_2h_2p(self): diff --git a/src/Bitmask/bitmask_cas_routines.irp.f b/src/Bitmask/bitmask_cas_routines.irp.f index 776d4546..a2e8ef08 100644 --- a/src/Bitmask/bitmask_cas_routines.irp.f +++ b/src/Bitmask/bitmask_cas_routines.irp.f @@ -214,13 +214,13 @@ logical function is_a_two_holes_two_particles(key_in) integer :: i,i_diff i_diff = 0 if(N_int == 1)then - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) ) & + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) ) & + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & + popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) else if(N_int == 2)then - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) ) & + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) ) & + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & @@ -231,7 +231,7 @@ logical function is_a_two_holes_two_particles(key_in) + popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) else if(N_int == 3)then - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) ) & + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) ) & + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & @@ -245,7 +245,7 @@ logical function is_a_two_holes_two_particles(key_in) + popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) & + popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) else if(N_int == 4)then - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) ) & + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) ) & + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & @@ -263,7 +263,7 @@ logical function is_a_two_holes_two_particles(key_in) + popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) & + popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) else if(N_int == 5)then - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) ) & + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) ) & + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & @@ -285,7 +285,7 @@ logical function is_a_two_holes_two_particles(key_in) + popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) & + popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) ) else if(N_int == 6)then - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) ) & + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) ) & + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & @@ -311,7 +311,7 @@ logical function is_a_two_holes_two_particles(key_in) + popcnt( iand( iand( xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1))), virt_bitmask(6,1) ), virt_bitmask(6,1)) ) & + popcnt( iand( iand( xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1))), virt_bitmask(6,2) ), virt_bitmask(6,2)) ) else if(N_int == 7)then - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) ) & + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) ) & + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & @@ -341,7 +341,7 @@ logical function is_a_two_holes_two_particles(key_in) + popcnt( iand( iand( xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1))), virt_bitmask(7,1) ), virt_bitmask(7,1)) ) & + popcnt( iand( iand( xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1))), virt_bitmask(7,2) ), virt_bitmask(7,2)) ) else if(N_int == 8)then - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) ) & + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) ) & + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & @@ -378,7 +378,7 @@ logical function is_a_two_holes_two_particles(key_in) else do i = 1, N_int - i_diff = i_diff & + i_diff = i_diff + & + popcnt( xor( iand(inact_bitmask(i,1), xor(key_in(i,1),iand(key_in(i,1),cas_bitmask(i,1,1)))), inact_bitmask(i,1)) ) & + popcnt( xor( iand(inact_bitmask(i,2), xor(key_in(i,2),iand(key_in(i,2),cas_bitmask(i,2,1)))), inact_bitmask(i,2)) ) & + popcnt( iand( iand( xor(key_in(i,1),iand(key_in(i,1),cas_bitmask(i,1,1))), virt_bitmask(i,1) ), virt_bitmask(i,1)) ) & diff --git a/src/Dets/save_for_casino.irp.f b/src/Dets/save_for_casino.irp.f index 631f79bd..0c18d1e2 100644 --- a/src/Dets/save_for_casino.irp.f +++ b/src/Dets/save_for_casino.irp.f @@ -4,7 +4,6 @@ subroutine save_casino character*(128) :: message integer :: getUnitAndOpen, iunit integer, allocatable :: itmp(:) - integer :: n_ao_new real, allocatable :: rtmp(:) PROVIDE ezfio_filename @@ -76,8 +75,7 @@ subroutine save_casino icount += 2*ao_l(i)+1 endif enddo - n_ao_new = icount - write(iunit,*) n_ao_new + write(iunit,*) icount write(iunit,'(A)') 'Number of Gaussian primitives per primitive cell' allocate(itmp(ao_num)) integer :: l @@ -177,89 +175,6 @@ subroutine save_casino write(iunit,'(A)') - write(iunit,'(A)') 'MULTIDETERMINANT INFORMATION' - write(iunit,'(A)') '----------------------------' - write(iunit,'(A)') 'GS' - write(iunit,'(A)') 'ORBITAL COEFFICIENTS' - write(iunit,'(A)') '------------------------' - - ! Transformation cartesian -> spherical - double precision :: tf2(6,5), tf3(10,7), tf4(15,9) - integer :: check2(3,6), check3(3,10), check4(3,15) - check2(:,1) = (/ 2, 0, 0 /) - check2(:,2) = (/ 1, 1, 0 /) - check2(:,3) = (/ 1, 0, 1 /) - check2(:,4) = (/ 0, 2, 0 /) - check2(:,5) = (/ 0, 1, 1 /) - check2(:,6) = (/ 0, 0, 2 /) - - check3(:,1) = (/ 3, 0, 0 /) - check3(:,2) = (/ 2, 1, 0 /) - check3(:,3) = (/ 2, 0, 1 /) - check3(:,4) = (/ 1, 2, 0 /) - check3(:,5) = (/ 1, 1, 1 /) - check3(:,6) = (/ 1, 0, 2 /) - check3(:,7) = (/ 0, 3, 0 /) - check3(:,8) = (/ 0, 2, 1 /) - check3(:,9) = (/ 0, 1, 2 /) - check3(:,10) = (/ 0, 0, 3 /) - - check4(:,1) = (/ 4, 0, 0 /) - check4(:,2) = (/ 3, 1, 0 /) - check4(:,3) = (/ 3, 0, 1 /) - check4(:,4) = (/ 2, 2, 0 /) - check4(:,5) = (/ 2, 1, 1 /) - check4(:,6) = (/ 2, 0, 2 /) - check4(:,7) = (/ 1, 3, 0 /) - check4(:,8) = (/ 1, 2, 1 /) - check4(:,9) = (/ 1, 1, 2 /) - check4(:,10) = (/ 1, 0, 3 /) - check4(:,11) = (/ 0, 4, 0 /) - check4(:,12) = (/ 0, 3, 1 /) - check4(:,13) = (/ 0, 2, 2 /) - check4(:,14) = (/ 0, 1, 3 /) - check4(:,15) = (/ 0, 0, 4 /) - -! tf2 = (/ -! -0.5, 0, 0, -0.5, 0, 1.0, & -! 0, 0, 1.0, 0, 0, 0, & -! 0, 0, 0, 0, 1.0, 0, & -! 0.86602540378443864676, 0, 0, -0.86602540378443864676, 0, 0, & -! 0, 1.0, 0, 0, 0, 0, & -! /) -! tf3 = (/ -! 0, 0, -0.67082039324993690892, 0, 0, 0, 0, -0.67082039324993690892, 0, 1.0, & -! -0.61237243569579452455, 0, 0, -0.27386127875258305673, 0, 1.0954451150103322269, 0, 0, 0, 0, & -! 0, -0.27386127875258305673, 0, 0, 0, 0, -0.61237243569579452455, 0, 1.0954451150103322269, 0, & -! 0, 0, 0.86602540378443864676, 0, 0, 0, 0, -0.86602540378443864676, 0, 0, & -! 0, 0, 0, 0, 1.0, 0, 0, 0, 0, 0, & -! 0.790569415042094833, 0, 0, -1.0606601717798212866, 0, 0, 0, 0, 0, 0, & -! 0, 1.0606601717798212866, 0, 0, 0, 0, -0.790569415042094833, 0, 0, 0, & -! /) -! tf4 = (/ -! 0.375, 0, 0, 0.21957751641341996535, 0, -0.87831006565367986142, 0, 0, 0, 0, 0.375, 0, -0.87831006565367986142, 0, 1.0, & -! 0, 0, -0.89642145700079522998, 0, 0, 0, 0, -0.40089186286863657703, 0, 1.19522860933439364, 0, 0, 0, 0, 0, & -! 0, 0, 0, 0, -0.40089186286863657703, 0, 0, 0, 0, 0, 0, -0.89642145700079522998, 0, 1.19522860933439364, 0, & -! -0.5590169943749474241, 0, 0, 0, 0, 0.9819805060619657157, 0, 0, 0, 0, 0.5590169943749474241, 0, -0.9819805060619657157, 0, 0, & -! 0, -0.42257712736425828875, 0, 0, 0, 0, -0.42257712736425828875, 0, 1.1338934190276816816, 0, 0, 0, 0, 0, 0, & -! 0, 0, 0.790569415042094833, 0, 0, 0, 0, -1.0606601717798212866, 0, 0, 0, 0, 0, 0, 0, & -! 0, 0, 0, 0, 1.0606601717798212866, 0, 0, 0, 0, 0, 0, -0.790569415042094833, 0, 0, 0, & -! 0.73950997288745200532, 0, 0, -1.2990381056766579701, 0, 0, 0, 0, 0, 0, 0.73950997288745200532, 0, 0, 0, 0, & -! 0, 1.1180339887498948482, 0, 0, 0, 0, -1.1180339887498948482, 0, 0, 0, 0, 0, 0, 0, 0, & -! /) -! - - - allocate(rtmp(ao_num*mo_tot_num)) - l=0 - do i=1,mo_tot_num - do j=1,ao_num - l += 1 - rtmp(l) = mo_coef(j,i) - enddo - enddo - write(iunit,'(4(1PE20.13))') rtmp(1:l) - deallocate(rtmp) close(iunit) end diff --git a/src/Full_CI/H_apply.irp.f b/src/Full_CI/H_apply.irp.f index 5c6fcdc7..a755ad4a 100644 --- a/src/Full_CI/H_apply.irp.f +++ b/src/Full_CI/H_apply.irp.f @@ -10,6 +10,10 @@ s = H_apply("FCI_PT2") s.set_perturbation("epstein_nesbet_2x2") print s +s = H_apply("FCI_no_skip") +s.set_selection_pt2("epstein_nesbet_2x2") +s.unset_skip() +print s s = H_apply("FCI_mono") s.set_selection_pt2("epstein_nesbet_2x2") diff --git a/src/Full_CI/full_ci_no_skip.irp.f b/src/Full_CI/full_ci_no_skip.irp.f new file mode 100644 index 00000000..aa84fb9d --- /dev/null +++ b/src/Full_CI/full_ci_no_skip.irp.f @@ -0,0 +1,91 @@ +program full_ci + implicit none + integer :: i,k + + + double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:) + integer :: N_st, degree + N_st = N_states + allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st)) + character*(64) :: perturbation + + pt2 = 1.d0 + diag_algorithm = "Lapack" + if (N_det > n_det_max_fci) then + call diagonalize_CI + call save_wavefunction + psi_det = psi_det_sorted + psi_coef = psi_coef_sorted + N_det = n_det_max_fci + soft_touch N_det psi_det psi_coef + call diagonalize_CI + call save_wavefunction + print *, 'N_det = ', N_det + print *, 'N_states = ', N_states + print *, 'PT2 = ', pt2 + print *, 'E = ', CI_energy + print *, 'E+PT2 = ', CI_energy+pt2 + print *, '-----' + endif + double precision :: i_H_psi_array(N_states),diag_H_mat_elem,h,i_O1_psi_array(N_states) + if(read_wf)then + call i_H_psi(psi_det(1,1,N_det),psi_det,psi_coef,N_int,N_det,psi_det_size,N_states,i_H_psi_array) + h = diag_H_mat_elem(psi_det(1,1,N_det),N_int) + selection_criterion = dabs(psi_coef(N_det,1) * (i_H_psi_array(1) - h * psi_coef(N_det,1))) * 0.1d0 + soft_touch selection_criterion + endif + + + integer :: n_det_before + print*,'Beginning the selection ...' + do while (N_det < n_det_max_fci.and.maxval(abs(pt2(1:N_st))) > pt2_max) + n_det_before = N_det + call H_apply_FCI_no_skip(pt2, norm_pert, H_pert_diag, N_st) + + PROVIDE psi_coef + PROVIDE psi_det + PROVIDE psi_det_sorted + + if (N_det > n_det_max_fci) then + psi_det = psi_det_sorted + psi_coef = psi_coef_sorted + N_det = n_det_max_fci + soft_touch N_det psi_det psi_coef + endif + call diagonalize_CI + call save_wavefunction + if(n_det_before == N_det)then + selection_criterion = selection_criterion * 0.5d0 + endif + print *, 'N_det = ', N_det + print *, 'N_states = ', N_states + print *, 'PT2 = ', pt2 + print *, 'E = ', CI_energy + print *, 'E+PT2 = ', CI_energy+pt2 + print *, '-----' + call ezfio_set_full_ci_energy(CI_energy) + if (abort_all) then + exit + endif + enddo + N_det = min(n_det_max_fci,N_det) + touch N_det psi_det psi_coef + call diagonalize_CI + if(do_pt2_end)then + print*,'Last iteration only to compute the PT2' + threshold_selectors = 1.d0 + threshold_generators = 0.999d0 + call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st) + + print *, 'Final step' + print *, 'N_det = ', N_det + print *, 'N_states = ', N_states + print *, 'PT2 = ', pt2 + print *, 'E = ', CI_energy + print *, 'E+PT2 = ', CI_energy+pt2 + print *, '-----' + call ezfio_set_full_ci_energy_pt2(CI_energy+pt2) + endif + call save_wavefunction + deallocate(pt2,norm_pert) +end diff --git a/src/Properties/need.irp.f b/src/Properties/need.irp.f index 22cb6a48..eb4dfe34 100644 --- a/src/Properties/need.irp.f +++ b/src/Properties/need.irp.f @@ -132,7 +132,7 @@ ! double precision function gammp(a,x) implicit double precision (a-h,o-z) - if(x.lt.0..or.a.le.0.)stop 'error in gammp' + if(x.lt.0..or.a.le.0.)pause if(x.lt.a+1.)then call gser(gammp,a,x,gln) else @@ -169,7 +169,7 @@ parameter (itmax=100,eps=3.e-7) gln=gammln(a) if(x.le.0.)then - if(x.lt.0.) stop 'error in gser' + if(x.lt.0.)pause gamser=0. return endif @@ -182,7 +182,7 @@ sum=sum+del if(abs(del).lt.abs(sum)*eps)go to 1 11 continue - stop 'a too large, itmax too small' + pause 'a too large, itmax too small' 1 gamser=sum*exp(-x+a*log(x)-gln) return end @@ -233,7 +233,7 @@ gold=g endif 11 continue - stop 'a too large, itmax too small' + pause 'a too large, itmax too small' 1 gammcf=exp(-x+a*log(x)-gln)*g return end diff --git a/src/Utils/abort.irp.f b/src/Utils/abort.irp.f index 4abf1a01..e915202e 100644 --- a/src/Utils/abort.irp.f +++ b/src/Utils/abort.irp.f @@ -17,13 +17,16 @@ BEGIN_PROVIDER [ logical, abort_here ] END_PROVIDER subroutine trap_signals + use ifport implicit none BEGIN_DOC ! What to do when a signal is caught. Here, trap Ctrl-C and call the control_C subroutine. END_DOC integer, external :: catch_signal + integer :: err, flag integer, parameter :: sigusr2 = 12 - call signal (sigusr2, catch_signal) + flag = -1 + err = signal (sigusr2, catch_signal, flag) end subroutine trap_signals integer function catch_signal(signum)