10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-23 21:03:49 +01:00

s2 complex

This commit is contained in:
Kevin Gasperich 2020-02-24 15:57:20 -06:00
parent dffd10375b
commit 3982ee4479
2 changed files with 169 additions and 178 deletions

View File

@ -1,179 +1,171 @@
subroutine u_0_S2_u_0_complex(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8) subroutine u_0_S2_u_0_complex(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
!todo: modify/implement for complex use bitmasks
print*,irp_here,' not implemented for complex' implicit none
stop -1 BEGIN_DOC
! use bitmasks ! Computes e_0 = <u_0|S2|u_0>/<u_0|u_0>
! 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, N_st, sze_8
! double precision, intent(out) :: e_0(N_st)
! double precision, intent(in) :: u_0(sze_8,N_st)
! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
! !
! double precision, allocatable :: v_0(:,:) ! n : number of determinants
! double precision :: u_dot_u,u_dot_v
! integer :: i,j
! allocate (v_0(sze_8,N_st))
! !
! call S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8) END_DOC
! do i=1,N_st integer, intent(in) :: n,Nint, N_st, sze_8
! e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n) + S_z2_Sz double precision, intent(out) :: e_0(N_st)
! enddo complex*16, intent(in) :: u_0(sze_8,N_st)
integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
complex*16, allocatable :: v_0(:,:)
double precision :: u_dot_u_complex
complex*16 :: u_dot_v_complex
integer :: i,j
allocate (v_0(sze_8,N_st))
call s2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
do i=1,N_st
e_0(i) = dble(u_dot_v_complex(u_0(1,i),v_0(1,i),n))/u_dot_u_complex(u_0(1,i),n) + S_z2_Sz
enddo
end end
subroutine S2_u_0_complex(v_0,u_0,n,keys_tmp,Nint) subroutine S2_u_0_complex(v_0,u_0,n,keys_tmp,Nint)
!todo: modify/implement for complex use bitmasks
print*,irp_here,' not implemented for complex' implicit none
stop -1 BEGIN_DOC
! use bitmasks ! Computes v_0 = S^2|u_0>
! implicit none !
! BEGIN_DOC ! n : number of determinants
! ! Computes v_0 = S^2|u_0> !
! ! END_DOC
! ! n : number of determinants integer, intent(in) :: n,Nint
! ! complex*16, intent(out) :: v_0(n)
! END_DOC complex*16, intent(in) :: u_0(n)
! integer, intent(in) :: n,Nint integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
! double precision, intent(out) :: v_0(n) call s2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,1,n)
! double precision, intent(in) :: u_0(n)
! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
! call S2_u_0_nstates(v_0,u_0,n,keys_tmp,Nint,1,n)
end end
subroutine S2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8) subroutine S2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
!todo: modify/implement for complex use bitmasks
print*,irp_here,' not implemented for complex' implicit none
stop -1 BEGIN_DOC
! use bitmasks ! Computes v_0 = S^2|u_0>
! implicit none
! BEGIN_DOC
! ! Computes v_0 = S^2|u_0>
! !
! ! n : number of determinants
! !
! END_DOC
! integer, intent(in) :: N_st,n,Nint, sze_8
! double precision, intent(out) :: v_0(sze_8,N_st)
! double precision, intent(in) :: u_0(sze_8,N_st)
! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
! double precision :: s2_tmp
! double precision, allocatable :: vt(:,:)
! integer :: i,j,k,l, jj,ii
! integer :: i0, j0
! !
! integer, allocatable :: shortcut(:,:), sort_idx(:,:) ! n : number of determinants
! integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:)
! integer(bit_kind) :: sorted_i(Nint)
! !
! integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, istate END_DOC
! integer, intent(in) :: N_st,n,Nint, sze_8
! complex*16, intent(out) :: v_0(sze_8,N_st)
! ASSERT (Nint > 0) complex*16, intent(in) :: u_0(sze_8,N_st)
! ASSERT (Nint == N_int) integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
! ASSERT (n>0) double precision :: s2_tmp
! PROVIDE ref_bitmask_energy complex*16, allocatable :: vt(:,:)
! integer :: i,j,k,l, jj,ii
! allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2)) integer :: i0, j0
! v_0 = 0.d0
! integer, allocatable :: shortcut(:,:), sort_idx(:,:)
! call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:)
! call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) integer(bit_kind) :: sorted_i(Nint)
!
! !$OMP PARALLEL DEFAULT(NONE) & integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, istate
! !$OMP PRIVATE(i,s2_tmp,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)&
! !$OMP SHARED(n,u_0,keys_tmp,Nint,v_0,sorted,shortcut,sort_idx,version,N_st,sze_8)
! allocate(vt(sze_8,N_st)) ASSERT (Nint > 0)
! vt = 0.d0 ASSERT (Nint == N_int)
! ASSERT (n>0)
! do sh=1,shortcut(0,1) PROVIDE ref_bitmask_energy
! !$OMP DO SCHEDULE(static,1)
! do sh2=sh,shortcut(0,1) allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2))
! exa = 0 v_0 = (0.d0,0.d0)
! do ni=1,Nint
! exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint)
! end do call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint)
! if(exa > 2) then
! cycle !$OMP PARALLEL DEFAULT(NONE) &
! end if !$OMP PRIVATE(i,s2_tmp,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)&
! !$OMP SHARED(n,u_0,keys_tmp,Nint,v_0,sorted,shortcut,sort_idx,version,N_st,sze_8)
! do i=shortcut(sh,1),shortcut(sh+1,1)-1 allocate(vt(sze_8,N_st))
! org_i = sort_idx(i,1) vt = (0.d0,0.d0)
! if(sh==sh2) then
! endi = i-1 do sh=1,shortcut(0,1)
! else !$OMP DO SCHEDULE(static,1)
! endi = shortcut(sh2+1,1)-1 do sh2=sh,shortcut(0,1)
! end if exa = 0
! do ni=1,Nint do ni=1,Nint
! sorted_i(ni) = sorted(ni,i,1) exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1)))
! enddo end do
! if(exa > 2) then
! do j=shortcut(sh2,1),endi cycle
! org_j = sort_idx(j,1) end if
! ext = exa
! do ni=1,Nint do i=shortcut(sh,1),shortcut(sh+1,1)-1
! ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) org_i = sort_idx(i,1)
! end do if(sh==sh2) then
! if(ext <= 4) then endi = i-1
! call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp) else
! do istate=1,N_st endi = shortcut(sh2+1,1)-1
! vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate) end if
! vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate) do ni=1,Nint
! enddo sorted_i(ni) = sorted(ni,i,1)
! endif enddo
! enddo
! enddo do j=shortcut(sh2,1),endi
! enddo org_j = sort_idx(j,1)
! !$OMP END DO NOWAIT ext = exa
! enddo do ni=1,Nint
! ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1)))
! do sh=1,shortcut(0,2) end do
! !$OMP DO if(ext <= 4) then
! do i=shortcut(sh,2),shortcut(sh+1,2)-1 call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp)
! org_i = sort_idx(i,2) do istate=1,N_st
! do j=shortcut(sh,2),i-1 vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate)
! org_j = sort_idx(j,2) vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate)
! ext = 0 enddo
! do ni=1,Nint endif
! ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) enddo
! end do enddo
! if(ext == 4) then enddo
! call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp) !$OMP END DO NOWAIT
! do istate=1,N_st enddo
! vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate)
! vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate) do sh=1,shortcut(0,2)
! enddo !$OMP DO
! end if do i=shortcut(sh,2),shortcut(sh+1,2)-1
! end do org_i = sort_idx(i,2)
! end do do j=shortcut(sh,2),i-1
! !$OMP END DO NOWAIT org_j = sort_idx(j,2)
! enddo ext = 0
! !$OMP BARRIER do ni=1,Nint
! ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2)))
! do istate=1,N_st end do
! do i=n,1,-1 if(ext == 4) then
! !$OMP ATOMIC call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp)
! v_0(i,istate) = v_0(i,istate) + vt(i,istate) do istate=1,N_st
! enddo vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate)
! enddo vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate)
! enddo
! deallocate(vt) end if
! !$OMP END PARALLEL end do
! end do
! do i=1,n !$OMP END DO NOWAIT
! call get_s2(keys_tmp(1,1,i),keys_tmp(1,1,i),Nint,s2_tmp) enddo
! do istate=1,N_st !$OMP BARRIER
! v_0(i,istate) += s2_tmp * u_0(i,istate)
! enddo do istate=1,N_st
! enddo do i=n,1,-1
! !$OMP ATOMIC
! deallocate (shortcut, sort_idx, sorted, version) v_0(i,istate) = v_0(i,istate) + vt(i,istate)
enddo
enddo
deallocate(vt)
!$OMP END PARALLEL
do i=1,n
call get_s2(keys_tmp(1,1,i),keys_tmp(1,1,i),Nint,s2_tmp)
do istate=1,N_st
v_0(i,istate) += s2_tmp * u_0(i,istate)
enddo
enddo
deallocate (shortcut, sort_idx, sorted, version)
end end
@ -190,19 +182,20 @@ subroutine get_uJ_s2_uI_complex(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_key
! use bitmasks ! use bitmasks
! integer, intent(in) :: n,nmax_coefs,nmax_keys,nstates ! integer, intent(in) :: n,nmax_coefs,nmax_keys,nstates
! integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys) ! integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys)
! double precision, intent(in) :: psi_coefs_tmp(nmax_coefs,nstates) ! complex*16, intent(in) :: psi_coefs_tmp(nmax_coefs,nstates)
! double precision, intent(out) :: s2(nstates,nstates) ! complex*16, intent(out) :: s2(nstates,nstates)
! double precision :: s2_tmp,accu ! double precision :: s2_tmp
! complex*16 :: accu
! integer :: i,j,l,jj,ll,kk ! integer :: i,j,l,jj,ll,kk
! integer, allocatable :: idx(:) ! integer, allocatable :: idx(:)
! BEGIN_DOC ! BEGIN_DOC
! ! returns the matrix elements of S^2 "s2(i,j)" between the "nstates" states ! ! returns the matrix elements of S^2 "s2(i,j)" between the "nstates" states
! ! psi_coefs_tmp(:,i) and psi_coefs_tmp(:,j) ! ! psi_coefs_tmp(:,i) and psi_coefs_tmp(:,j)
! END_DOC ! END_DOC
! s2 = 0.d0 ! s2 = (0.d0,0.d0)
! do ll = 1, nstates ! do ll = 1, nstates
! do jj = 1, nstates ! do jj = 1, nstates
! accu = 0.d0 ! accu = (0.d0,0.d0)
! !$OMP PARALLEL DEFAULT(NONE) & ! !$OMP PARALLEL DEFAULT(NONE) &
! !$OMP PRIVATE (i,j,kk,idx,s2_tmp) & ! !$OMP PRIVATE (i,j,kk,idx,s2_tmp) &
! !$OMP SHARED (ll,jj,psi_keys_tmp,psi_coefs_tmp,N_int,n,nstates)& ! !$OMP SHARED (ll,jj,psi_keys_tmp,psi_coefs_tmp,N_int,n,nstates)&
@ -211,12 +204,12 @@ subroutine get_uJ_s2_uI_complex(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_key
! !$OMP DO SCHEDULE(dynamic) ! !$OMP DO SCHEDULE(dynamic)
! do i = n,1,-1 ! Better OMP scheduling ! do i = n,1,-1 ! Better OMP scheduling
! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,i),N_int,s2_tmp) ! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,i),N_int,s2_tmp)
! accu += psi_coefs_tmp(i,ll) * s2_tmp * psi_coefs_tmp(i,jj) ! accu += dconjg(psi_coefs_tmp(i,ll)) * s2_tmp * psi_coefs_tmp(i,jj)
! call filter_connected(psi_keys_tmp,psi_keys_tmp(1,1,i),N_int,i-1,idx) ! call filter_connected(psi_keys_tmp,psi_keys_tmp(1,1,i),N_int,i-1,idx)
! do kk=1,idx(0) ! do kk=1,idx(0)
! j = idx(kk) ! j = idx(kk)
! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,j),N_int,s2_tmp) ! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,j),N_int,s2_tmp)
! accu += psi_coefs_tmp(i,ll) * s2_tmp * psi_coefs_tmp(j,jj) + psi_coefs_tmp(i,jj) * s2_tmp * psi_coefs_tmp(j,ll) ! accu += dconjg(psi_coefs_tmp(i,ll)) * s2_tmp * psi_coefs_tmp(j,jj) + psi_coefs_tmp(i,jj) * s2_tmp * psi_coefs_tmp(j,ll)
! enddo ! enddo
! enddo ! enddo
! !$OMP END DO ! !$OMP END DO

View File

@ -34,14 +34,12 @@ determinants:
might be able to combine some providers?? might be able to combine some providers??
(done) psi_energy_mono_elec.irp.f (done) psi_energy_mono_elec.irp.f
(done) ref_bitmask.irp.f (done) ref_bitmask.irp.f
(****) s2{,_complex}.irp.f (done?) s2{,_complex}.irp.f
made copies of needed functions for complex remaining functions not needed?
still need to do implementation
(done) single_excitations.irp.f (done) single_excitations.irp.f
(done?) single_excitation_two_e.irp.f (done?) single_excitation_two_e.irp.f
(done?) slater_rules.irp.f (done?) slater_rules.irp.f
(done?) slater_rules_wee_mono.irp.f (done?) slater_rules_wee_mono.irp.f
check indices for complex
(done) sort_dets_ab.irp.f (done) sort_dets_ab.irp.f
spindeterminants.ezfio_config spindeterminants.ezfio_config
need svd complex? need svd complex?