mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Merge branch 'master' of github.com:scemama/quantum_package
This commit is contained in:
commit
98191ae1ea
@ -57,7 +57,6 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
if(done .or. ctask == size(task_id)) then
|
if(done .or. ctask == size(task_id)) then
|
||||||
ASSERT (buf%N /= 0)
|
|
||||||
do i=1, ctask
|
do i=1, ctask
|
||||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i))
|
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i))
|
||||||
end do
|
end do
|
||||||
|
@ -39,7 +39,8 @@ subroutine run
|
|||||||
call dsort(norm_sort(1),iorder(1),nab)
|
call dsort(norm_sort(1),iorder(1),nab)
|
||||||
|
|
||||||
|
|
||||||
PROVIDE psi_bilinear_matrix_values nuclear_repulsion
|
PROVIDE psi_bilinear_matrix_values psi_bilinear_matrix_rows psi_bilinear_matrix_columns
|
||||||
|
PROVIDE nuclear_repulsion
|
||||||
print *, ''
|
print *, ''
|
||||||
do j=0,nab
|
do j=0,nab
|
||||||
i = iorder(j)
|
i = iorder(j)
|
||||||
@ -47,7 +48,9 @@ subroutine run
|
|||||||
!$OMP PARALLEL DO PRIVATE(k)
|
!$OMP PARALLEL DO PRIVATE(k)
|
||||||
do k=1,n_det
|
do k=1,n_det
|
||||||
if (psi_bilinear_matrix_columns(k) == -i) then
|
if (psi_bilinear_matrix_columns(k) == -i) then
|
||||||
psi_bilinear_matrix_values(k,1:N_states) = 0.d0
|
do l=1,N_states
|
||||||
|
psi_bilinear_matrix_values(k,l) = 0.d0
|
||||||
|
enddo
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
@ -55,7 +58,9 @@ subroutine run
|
|||||||
!$OMP PARALLEL DO PRIVATE(k)
|
!$OMP PARALLEL DO PRIVATE(k)
|
||||||
do k=1,n_det
|
do k=1,n_det
|
||||||
if (psi_bilinear_matrix_rows(k) == i) then
|
if (psi_bilinear_matrix_rows(k) == i) then
|
||||||
psi_bilinear_matrix_values(k,1:N_states) = 0.d0
|
do l=1,N_states
|
||||||
|
psi_bilinear_matrix_values(k,l) = 0.d0
|
||||||
|
enddo
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
@ -64,9 +69,11 @@ subroutine run
|
|||||||
cycle
|
cycle
|
||||||
endif
|
endif
|
||||||
|
|
||||||
u_0 = psi_bilinear_matrix_values(1:N_det,1:N_states)
|
u_0(1:N_det,1:N_states) = psi_bilinear_matrix_values(1:N_det,1:N_states)
|
||||||
v_t = 0.d0
|
v_0(1:N_det,1:N_states) = 0.d0
|
||||||
s_t = 0.d0
|
u_t(1:N_states,1:N_det) = 0.d0
|
||||||
|
v_t(1:N_states,1:N_det) = 0.d0
|
||||||
|
s_t(1:N_states,1:N_det) = 0.d0
|
||||||
call dtranspose( &
|
call dtranspose( &
|
||||||
u_0, &
|
u_0, &
|
||||||
size(u_0, 1), &
|
size(u_0, 1), &
|
||||||
@ -85,8 +92,8 @@ subroutine run
|
|||||||
|
|
||||||
double precision, external :: u_dot_u, u_dot_v
|
double precision, external :: u_dot_u, u_dot_v
|
||||||
do i=1,N_states
|
do i=1,N_states
|
||||||
e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),N_det)/u_dot_u(u_0(1,i),N_det)
|
e_0(i) = u_dot_v(u_0(1,i),v_0(1,i),N_det)/u_dot_u(u_0(1,i),N_det)
|
||||||
print *, 'E = ', e_0(i)
|
print *, 'E = ', e_0(i) + nuclear_repulsion
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
m = 0
|
m = 0
|
||||||
|
@ -42,18 +42,18 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
integer, allocatable :: hp(:,:)
|
integer, allocatable :: hp(:,:)
|
||||||
|
|
||||||
|
|
||||||
integer :: i_state, i, i_I, J, k, k2, k1, kk, ll, degree, degree2, m, l, deg, ni, m2
|
integer :: i_state, i, i_I, J, k, k2, k1, kk, ll, m, l, deg, ni, m2
|
||||||
integer :: n(2)
|
integer :: n(2)
|
||||||
integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s, kn
|
integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s, kn
|
||||||
logical :: ok
|
logical :: ok
|
||||||
double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al
|
double precision :: phase_ia, phase_Ik, phase_Jl, phase_Ji, phase_la, phase_ka, phase_tmp
|
||||||
|
double precision :: Hka, Hla, Ska, Sla, tmp
|
||||||
double precision :: diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv(N_states), cj_inv(N_states)
|
double precision :: diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv(N_states), cj_inv(N_states)
|
||||||
double precision :: contrib, contrib_s2, wall, iwall
|
double precision :: contrib, contrib_s2, wall, iwall
|
||||||
double precision, allocatable :: dleat(:,:,:), dleat_s2(:,:,:)
|
integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ, exc
|
||||||
integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ
|
|
||||||
integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt
|
integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt
|
||||||
integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp
|
integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp
|
||||||
logical, external :: is_in_wavefunction, isInCassd, detEq
|
logical, external :: is_in_wavefunction
|
||||||
integer,allocatable :: komon(:)
|
integer,allocatable :: komon(:)
|
||||||
logical :: komoned
|
logical :: komoned
|
||||||
!double precision, external :: get_dij
|
!double precision, external :: get_dij
|
||||||
@ -63,8 +63,8 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
|
|
||||||
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||||
|
|
||||||
allocate (dleat(N_states, N_det_non_ref, 2), delta(N_states,0:N_det_non_ref, 2))
|
allocate (delta(N_states,0:N_det_non_ref, 2))
|
||||||
allocate (dleat_s2(N_states, N_det_non_ref, 2), delta_s2(N_states,0:N_det_non_ref, 2))
|
allocate (delta_s2(N_states,0:N_det_non_ref, 2))
|
||||||
allocate(komon(0:N_det_non_ref))
|
allocate(komon(0:N_det_non_ref))
|
||||||
|
|
||||||
allocate(hp(2,N_det_non_ref))
|
allocate(hp(2,N_det_non_ref))
|
||||||
@ -100,7 +100,7 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
k = det_cepa0_idx(linked(kk, i_I))
|
k = det_cepa0_idx(linked(kk, i_I))
|
||||||
blok = blokMwen(kk, i_I)
|
blok = blokMwen(kk, i_I)
|
||||||
|
|
||||||
call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int)
|
call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,deg,phase_Ik,N_int)
|
||||||
|
|
||||||
if(J /= i_I) then
|
if(J /= i_I) then
|
||||||
call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int)
|
call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int)
|
||||||
@ -136,35 +136,9 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
if(h_cache(J,i) == 0.d0) cycle
|
if(h_cache(J,i) == 0.d0) cycle
|
||||||
if(h_cache(i_I,i) == 0.d0) cycle
|
if(h_cache(i_I,i) == 0.d0) cycle
|
||||||
|
|
||||||
!ok = .false.
|
|
||||||
!do i_state=1, N_states
|
|
||||||
! if(lambda_mrcc(i_state, i) /= 0d0) then
|
|
||||||
! ok = .true.
|
|
||||||
! exit
|
|
||||||
! end if
|
|
||||||
!end do
|
|
||||||
!if(.not. ok) cycle
|
|
||||||
!
|
|
||||||
|
|
||||||
komon(0) += 1
|
komon(0) += 1
|
||||||
kn = komon(0)
|
kn = komon(0)
|
||||||
komon(kn) = i
|
komon(kn) = i
|
||||||
|
|
||||||
|
|
||||||
! call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int)
|
|
||||||
! if(I_i /= J) call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ii,N_int)
|
|
||||||
! if(I_i == J) phase_Ii = phase_Ji
|
|
||||||
|
|
||||||
do i_state = 1,N_states
|
|
||||||
dkI = h_cache(J,i) * dij(i_I, i, i_state)
|
|
||||||
dleat(i_state, kn, 1) = dkI
|
|
||||||
dleat(i_state, kn, 2) = dkI
|
|
||||||
|
|
||||||
dkI = s2_cache(J,i) * dij(i_I, i, i_state)
|
|
||||||
dleat_s2(i_state, kn, 1) = dkI
|
|
||||||
dleat_s2(i_state, kn, 2) = dkI
|
|
||||||
end do
|
|
||||||
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
komoned = .true.
|
komoned = .true.
|
||||||
@ -178,18 +152,20 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int)
|
call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int)
|
||||||
if(.not. ok) cycle
|
if(.not. ok) cycle
|
||||||
if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) then
|
if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) then
|
||||||
cycle
|
if(is_in_wavefunction(det_tmp, N_int)) cycle
|
||||||
end if
|
end if
|
||||||
|
|
||||||
!if(isInCassd(det_tmp, N_int)) cycle
|
|
||||||
|
call i_h_j_phase_out(psi_non_ref(1,1,i), det_tmp, N_int, tmp, phase_ia,exc, deg)
|
||||||
|
call i_h_j_phase_out(psi_ref(1,1,i_I), psi_non_ref(1,1,k), N_int, tmp, phase_ik,exc, deg)
|
||||||
|
|
||||||
|
call i_h_j_phase_out(psi_non_ref(1,1,l), det_tmp, N_int, Hla, phase_la,exc,deg)
|
||||||
|
call get_s2(psi_non_ref(1,1,l), det_tmp, N_int, Sla)
|
||||||
|
|
||||||
|
|
||||||
do i_state = 1, N_states
|
do i_state = 1, N_states
|
||||||
!if(lambda_mrcc(i_state, i) == 0d0) cycle
|
contrib = dij(i_I, k, i_state) * dij(i_I, i, i_state) * Hla * phase_ia * phase_ik
|
||||||
|
contrib_s2 = dij(i_I, k, i_state) * dij(i_I, i, i_state) * Sla *phase_ia * phase_ik
|
||||||
|
|
||||||
!contrib = h_cache(i_I,k) * lambda_mrcc(i_state, k) * dleat(i_state, m, 2)! * phase_al
|
|
||||||
contrib = dij(i_I, k, i_state) * dleat(i_state, m, 2)
|
|
||||||
contrib_s2 = dij(i_I, k, i_state) * dleat_s2(i_state, m, 2)
|
|
||||||
delta(i_state,ll,1) += contrib
|
delta(i_state,ll,1) += contrib
|
||||||
delta_s2(i_state,ll,1) += contrib_s2
|
delta_s2(i_state,ll,1) += contrib_s2
|
||||||
if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then
|
if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then
|
||||||
@ -198,9 +174,12 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
if(I_i == J) cycle
|
if(I_i == J) cycle
|
||||||
!contrib = h_cache(J,l) * lambda_mrcc(i_state, l) * dleat(i_state, m, 1)! * phase_al
|
call i_h_j_phase_out(psi_non_ref(1,1,k), det_tmp, N_int, Hka, phase_ka,exc,deg)
|
||||||
contrib = dij(J, l, i_state) * dleat(i_state, m, 1)
|
call get_s2(psi_non_ref(1,1,k), det_tmp, N_int, Ska)
|
||||||
contrib_s2 = dij(J, l, i_state) * dleat_s2(i_state, m, 1)
|
call i_h_j_phase_out(psi_ref(1,1,J), psi_non_ref(1,1,l), N_int, tmp, phase_jl,exc, deg)
|
||||||
|
|
||||||
|
contrib = dij(J, l, i_state) * dij(J, i, i_state) * Hka* phase_ia * phase_jl
|
||||||
|
contrib_s2 = dij(J, l, i_state) * dij(J, i, i_state) * Ska*phase_ia*phase_jl
|
||||||
delta(i_state,kk,2) += contrib
|
delta(i_state,kk,2) += contrib
|
||||||
delta_s2(i_state,kk,2) += contrib_s2
|
delta_s2(i_state,kk,2) += contrib_s2
|
||||||
if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then
|
if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then
|
||||||
@ -211,12 +190,8 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
end do ! while
|
end do ! while
|
||||||
end do ! kk
|
end do ! kk
|
||||||
|
|
||||||
|
|
||||||
call push_mrsc2_results(zmq_socket_push, I_i, J, delta, delta_s2, task_id)
|
call push_mrsc2_results(zmq_socket_push, I_i, J, delta, delta_s2, task_id)
|
||||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
||||||
|
|
||||||
! end if
|
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
deallocate(delta)
|
deallocate(delta)
|
||||||
|
@ -435,17 +435,14 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
|||||||
! Save the wave function into the EZFIO file
|
! Save the wave function into the EZFIO file
|
||||||
END_DOC
|
END_DOC
|
||||||
use bitmasks
|
use bitmasks
|
||||||
|
include 'constants.include.F'
|
||||||
integer, intent(in) :: ndet,nstates,dim_psicoef
|
integer, intent(in) :: ndet,nstates,dim_psicoef
|
||||||
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
|
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
|
||||||
double precision, intent(in) :: psicoef(dim_psicoef,nstates)
|
double precision, intent(in) :: psicoef(dim_psicoef,nstates)
|
||||||
integer*8, allocatable :: psi_det_save(:,:,:)
|
integer*8, allocatable :: psi_det_save(:,:,:)
|
||||||
double precision, allocatable :: psi_coef_save(:,:)
|
double precision, allocatable :: psi_coef_save(:,:)
|
||||||
integer*8 :: det_8(100)
|
|
||||||
integer(bit_kind) :: det_bk((100*8)/bit_kind)
|
|
||||||
integer :: N_int2
|
|
||||||
equivalence (det_8, det_bk)
|
|
||||||
|
|
||||||
integer :: i,k
|
integer :: i,j,k
|
||||||
|
|
||||||
call ezfio_set_determinants_N_int(N_int)
|
call ezfio_set_determinants_N_int(N_int)
|
||||||
call ezfio_set_determinants_bit_kind(bit_kind)
|
call ezfio_set_determinants_bit_kind(bit_kind)
|
||||||
@ -453,20 +450,12 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
|||||||
call ezfio_set_determinants_n_states(nstates)
|
call ezfio_set_determinants_n_states(nstates)
|
||||||
call ezfio_set_determinants_mo_label(mo_label)
|
call ezfio_set_determinants_mo_label(mo_label)
|
||||||
|
|
||||||
N_int2 = (N_int*bit_kind)/8
|
allocate (psi_det_save(N_int,2,ndet))
|
||||||
allocate (psi_det_save(N_int2,2,ndet))
|
|
||||||
do i=1,ndet
|
do i=1,ndet
|
||||||
|
do j=1,2
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
det_bk(k) = psidet(k,1,i)
|
psi_det_save(k,j,i) = transfer(psidet(k,j,i),1_8)
|
||||||
enddo
|
enddo
|
||||||
do k=1,N_int2
|
|
||||||
psi_det_save(k,1,i) = det_8(k)
|
|
||||||
enddo
|
|
||||||
do k=1,N_int
|
|
||||||
det_bk(k) = psidet(k,2,i)
|
|
||||||
enddo
|
|
||||||
do k=1,N_int2
|
|
||||||
psi_det_save(k,2,i) = det_8(k)
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
call ezfio_set_determinants_psi_det(psi_det_save)
|
call ezfio_set_determinants_psi_det(psi_det_save)
|
||||||
@ -492,7 +481,6 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
|||||||
|
|
||||||
call ezfio_set_determinants_psi_coef(psi_coef_save)
|
call ezfio_set_determinants_psi_coef(psi_coef_save)
|
||||||
call write_int(output_determinants,ndet,'Saved determinants')
|
call write_int(output_determinants,ndet,'Saved determinants')
|
||||||
call stop_progress
|
|
||||||
deallocate (psi_coef_save)
|
deallocate (psi_coef_save)
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -565,7 +553,6 @@ subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,inde
|
|||||||
|
|
||||||
call ezfio_set_determinants_psi_coef(psi_coef_save)
|
call ezfio_set_determinants_psi_coef(psi_coef_save)
|
||||||
call write_int(output_determinants,ndet,'Saved determinants')
|
call write_int(output_determinants,ndet,'Saved determinants')
|
||||||
call stop_progress
|
|
||||||
deallocate (psi_coef_save)
|
deallocate (psi_coef_save)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -47,6 +47,14 @@ recursive subroutine dtranspose(A,LDA,B,LDB,d1,d2)
|
|||||||
double precision, intent(in) :: A(LDA,d2)
|
double precision, intent(in) :: A(LDA,d2)
|
||||||
double precision, intent(out) :: B(LDB,d1)
|
double precision, intent(out) :: B(LDB,d1)
|
||||||
|
|
||||||
|
|
||||||
|
! do j=1,d1
|
||||||
|
! do i=1,d2
|
||||||
|
! B(i,j ) = A(j ,i)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! return
|
||||||
|
|
||||||
integer :: i,j,k, mod_align
|
integer :: i,j,k, mod_align
|
||||||
if ( d2 < 32 ) then
|
if ( d2 < 32 ) then
|
||||||
do j=1,d1
|
do j=1,d1
|
||||||
|
Loading…
Reference in New Issue
Block a user