10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-19 19:52:15 +02:00

subroutine merdge

This commit is contained in:
Yann Garniron 2015-12-18 16:19:09 +01:00
parent 0ffefd2f75
commit e207c1d51a
2 changed files with 19 additions and 3 deletions

View File

@ -104,8 +104,9 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
if(N_microlist(smallerlist) > 0) then
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)
! 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)
call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0))
end if
!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, &
@ -141,7 +142,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
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)
implicit none
BEGIN_DOC

View File

@ -199,9 +199,25 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
end do
end if
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
subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
use bitmasks
BEGIN_DOC