mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-30 16:13:42 +02:00
subroutine merdge
This commit is contained in:
parent
0ffefd2f75
commit
e207c1d51a
@ -104,8 +104,9 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
|
|
||||||
|
|
||||||
if(N_microlist(smallerlist) > 0) then
|
if(N_microlist(smallerlist) > 0) then
|
||||||
microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist)
|
! microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist)
|
||||||
idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist)
|
! idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist)
|
||||||
|
call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0))
|
||||||
end if
|
end if
|
||||||
!if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size
|
!if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size
|
||||||
! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
|
! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, &
|
||||||
@ -141,7 +142,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp)
|
subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -199,6 +199,22 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
|||||||
end do
|
end do
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
|
!
|
||||||
|
! do j=1,mo_tot_num*2
|
||||||
|
! idx_microlist(N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = idx_microlist(1:N_microlist(0),0)
|
||||||
|
! microlist(:,:,N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = microlist(:,:,1:N_microlist(0),0)
|
||||||
|
! N_microlist(j) += N_microlist(0)
|
||||||
|
! end do
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine merdge(mic, idx_mic, N_mic, mic0, idx_mic0, N_mic0, Nint)
|
||||||
|
use bitmasks
|
||||||
|
integer(bit_kind) :: mic(Nint,2,N_mic), mic0(Nint,2,*)
|
||||||
|
integer :: idx_mic(N_mic), idx_mic0(N_mic0), N_mic, N_mic0
|
||||||
|
|
||||||
|
mic0(:,:,N_mic0+1:N_mic0+N_mic) = mic(:,:,:)
|
||||||
|
idx_mic0(N_mic0+1:N_mic0+N_mic) = idx_mic(:)
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user