From 1746a14717b3fcce6d7582c77132661ec3f99637 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 22 Sep 2016 21:52:25 +0200 Subject: [PATCH] Compiles with gfortran --- plugins/Full_CI_ZMQ/selection_slave.irp.f | 2 +- plugins/MRCC_Utils/davidson.irp.f | 34 ----- src/Davidson/u0Hu0.irp.f | 16 --- src/Determinants/guess_lowest_state.irp.f | 162 ---------------------- src/Determinants/s2.irp.f | 16 --- 5 files changed, 1 insertion(+), 229 deletions(-) delete mode 100644 src/Determinants/guess_lowest_state.irp.f diff --git a/plugins/Full_CI_ZMQ/selection_slave.irp.f b/plugins/Full_CI_ZMQ/selection_slave.irp.f index 438892d3..c3514565 100644 --- a/plugins/Full_CI_ZMQ/selection_slave.irp.f +++ b/plugins/Full_CI_ZMQ/selection_slave.irp.f @@ -63,7 +63,7 @@ subroutine update_energy(energy) CI_eigenvectors(k,j) = psi_coef(k,j) enddo enddo - call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int) + call u_0_S2_u_0_nstates(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int) if (.True.) then do k=1,size(ci_electronic_energy) ci_electronic_energy(k) = energy(k) diff --git a/plugins/MRCC_Utils/davidson.irp.f b/plugins/MRCC_Utils/davidson.irp.f index ece34dee..713b3f61 100644 --- a/plugins/MRCC_Utils/davidson.irp.f +++ b/plugins/MRCC_Utils/davidson.irp.f @@ -377,22 +377,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nin end -subroutine u_0_H_u_0_mrcc(e_0,u_0,n,keys_tmp,Nint,istate) - use bitmasks - implicit none - BEGIN_DOC - ! Computes e_0 = / - ! - ! n : number of determinants - ! - END_DOC - integer, intent(in) :: n,Nint,istate - double precision, intent(out) :: e_0 - double precision, intent(in) :: u_0(n) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - call u_0_H_u_0_mrcc_nstates(e_0,u_0,n,keys_tmp,Nint,1,n,istate) -end - subroutine u_0_H_u_0_mrcc_nstates(e_0,u_0,n,keys_tmp,Nint,istate,N_st,sze_8) use bitmasks implicit none @@ -428,24 +412,6 @@ subroutine u_0_H_u_0_mrcc_nstates(e_0,u_0,n,keys_tmp,Nint,istate,N_st,sze_8) end -subroutine H_u_0_mrcc(v_0,u_0,H_jj,n,keys_tmp,Nint,istate_in) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_0 = H|u_0> - ! - ! n : number of determinants - ! - ! H_jj : array of - END_DOC - integer, intent(in) :: n,Nint,istate_in - double precision, intent(out) :: v_0(n) - double precision, intent(in) :: u_0(n) - double precision, intent(in) :: H_jj(n) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - call H_u_0_mrcc_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,1,n) -end - subroutine H_u_0_mrcc_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,istate_in,N_st,sze_8) use bitmasks implicit none diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index a298f61c..f871f5f0 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -1,19 +1,3 @@ -subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint) - use bitmasks - implicit none - BEGIN_DOC - ! Computes e_0 = / - ! - ! n : number of determinants - ! - END_DOC - integer, intent(in) :: n,Nint - double precision, intent(out) :: e_0 - double precision, intent(in) :: u_0(n) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - call u_0_H_u_0_nstates(e_0,u_0,n,keys_tmp,Nint,1,n) -end - subroutine u_0_H_u_0_nstates(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8) use bitmasks implicit none diff --git a/src/Determinants/guess_lowest_state.irp.f b/src/Determinants/guess_lowest_state.irp.f deleted file mode 100644 index f6d0a004..00000000 --- a/src/Determinants/guess_lowest_state.irp.f +++ /dev/null @@ -1,162 +0,0 @@ -program first_guess - use bitmasks - implicit none - BEGIN_DOC - ! Select all the determinants with the lowest energy as a starting point. - END_DOC - integer :: i,j - double precision, allocatable :: orb_energy(:) - double precision :: E - integer, allocatable :: kept(:) - integer :: nelec_kept(2) - character :: occ_char, keep_char - - PROVIDE H_apply_buffer_allocated psi_det - allocate (orb_energy(mo_tot_num), kept(0:mo_tot_num)) - nelec_kept(1:2) = 0 - kept(0) = 0 - - print *, 'Orbital energies' - print *, '================' - print *, '' - do i=1,mo_tot_num - keep_char = ' ' - occ_char = '-' - orb_energy(i) = mo_mono_elec_integral(i,i) - do j=1,elec_beta_num - if (i==j) cycle - orb_energy(i) += mo_bielec_integral_jj_anti(i,j) - enddo - do j=1,elec_alpha_num - orb_energy(i) += mo_bielec_integral_jj(i,j) - enddo - if ( (orb_energy(i) > -.5d0).and.(orb_energy(i) < .1d0) ) then - kept(0) += 1 - keep_char = 'X' - kept( kept(0) ) = i - if (i <= elec_beta_num) then - nelec_kept(2) += 1 - endif - if (i <= elec_alpha_num) then - nelec_kept(1) += 1 - endif - endif - if (i <= elec_alpha_num) then - if (i <= elec_beta_num) then - occ_char = '#' - else - occ_char = '+' - endif - endif - print '(I4, 3X, A, 3X, F10.6, 3X, A)', i, occ_char, orb_energy(i), keep_char - enddo - - - integer, allocatable :: list (:,:) - integer(bit_kind), allocatable :: string(:,:) - allocate ( list(N_int*bit_kind_size,2), string(N_int,2) ) - - string = ref_bitmask - call bitstring_to_list( string(1,1), list(1,1), elec_alpha_num, N_int) - call bitstring_to_list( string(1,2), list(1,2), elec_beta_num , N_int) - - psi_det_alpha_unique(:,1) = string(:,1) - psi_det_beta_unique (:,1) = string(:,2) - N_det_alpha_unique = 1 - N_det_beta_unique = 1 - - integer :: i1,i2,i3,i4,i5,i6,i7,i8,i9 - - psi_det_size = kept(0)**(nelec_kept(1)+nelec_kept(2)) - print *, kept(0), nelec_kept(:) - call write_int(6,psi_det_size,'psi_det_size') - TOUCH psi_det_size - -BEGIN_SHELL [ /usr/bin/python ] - -template_alpha_ext = """ -do %(i2)s = %(i1)s-1,1,-1 - list(elec_alpha_num-%(i)d,1) = kept(%(i2)s) - call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int) -""" - -template_alpha = """ -do %(i2)s = %(i1)s-1,1,-1 - list(elec_alpha_num-%(i)d,1) = kept(%(i2)s) - call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int) - N_det_alpha_unique += 1 - psi_det_alpha_unique(:,N_det_alpha_unique) = string(:,1) -""" - -template_beta_ext = """ -do %(i2)s = %(i1)s-1,1,-1 - list(elec_beta_num-%(i)d,2) = kept(%(i2)s) - call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int) -""" -template_beta = """ -do %(i2)s = %(i1)s-1,1,-1 - list(elec_beta_num-%(i)d,2) = kept(%(i2)s) - call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int) - N_det_beta_unique += 1 - psi_det_beta_unique(:,N_det_beta_unique) = string(:,2) -""" - -def write(template_ext,template,imax): - print "case(%d)"%(imax) - def aux(i2,i1,i,j): - if (i==imax-1): - print template%locals() - else: - print template_ext%locals() - i += 1 - j -= 1 - if (i != imax): - i1 = "i%d"%(i) - i2 = "i%d"%(i+1) - aux(i2,i1,i,j) - print "enddo" - - i2 = "i1" - i1 = "kept(0)+1" - i = 0 - aux(i2,i1,i,imax) - -def main(): - print """ - select case (nelec_kept(1)) - case(0) - continue - """ - for imax in range(1,10): - write(template_alpha_ext,template_alpha,imax) - - print """ - end select - - select case (nelec_kept(2)) - case(0) - continue - """ - for imax in range(1,10): - write(template_beta_ext,template_beta,imax) - print "end select" - -main() - -END_SHELL - - TOUCH N_det_alpha_unique N_det_beta_unique psi_det_alpha_unique psi_det_beta_unique - call create_wf_of_psi_bilinear_matrix(.False.) - call diagonalize_ci - j= N_det - do i=1,N_det - if (psi_average_norm_contrib_sorted(i) < 1.d-6) then - j = i-1 - exit - endif -! call debug_det(psi_det_sorted(1,1,i),N_int) - enddo - call save_wavefunction_general(j,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) - - deallocate(orb_energy, kept, list, string) -end diff --git a/src/Determinants/s2.irp.f b/src/Determinants/s2.irp.f index 3d3eda0b..ca7a0590 100644 --- a/src/Determinants/s2.irp.f +++ b/src/Determinants/s2.irp.f @@ -75,22 +75,6 @@ END_PROVIDER -subroutine u_0_S2_u_0(e_0,u_0,n,keys_tmp,Nint) - use bitmasks - implicit none - BEGIN_DOC - ! Computes e_0 = / - ! - ! n : number of determinants - ! - END_DOC - integer, intent(in) :: n,Nint - double precision, intent(out) :: e_0 - double precision, intent(in) :: u_0(n) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - call u_0_S2_u_0_nstates(e_0,u_0,n,keys_tmp,Nint,1,n) -end - subroutine u_0_S2_u_0_nstates(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8) use bitmasks implicit none