LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-08-06 20:40:30 +02:00
Code Issues Releases Wiki Activity

Compiles with gfortran

Browse Source
This commit is contained in:
Anthony Scemama 2016-09-22 21:52:25 +02:00
parent 402a16fbd4
commit 1746a14717
5 changed files with 1 additions and 229 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
plugins/Full_CI_ZMQ/selection_slave.irp.f
View File

@ -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)

34
plugins/MRCC_Utils/davidson.irp.f
View File

@ -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 = <u_0|H|u_0>/<u_0|u_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 <j|H|j>
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

16
src/Davidson/u0Hu0.irp.f
View File

@ -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 = <u_0|H|u_0>/<u_0|u_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

162
src/Determinants/guess_lowest_state.irp.f
View File

@ -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

16
src/Determinants/s2.irp.f
View File

@ -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 = <u_0|S2|u_0>/<u_0|u_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