LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-03 01:45:59 +02:00
Code Issues Releases Wiki Activity

minilist simple pour mrcc_dress

Browse Source
This commit is contained in:
Yann Garniron 2015-10-16 13:14:19 +02:00
parent bbbc72341a
commit 4af7cf1104
1 changed files with 0 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
plugins/MRCC_Utils/mrcc_dress.irp.f
View File

@ -58,109 +58,9 @@ subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullLis
idx_miniList(N_miniList) = i
end if
end do
! if(N_miniList > 2) then
! call sort_detList(miniList, idx_miniList, N_miniList, Nint)
! end if
!
! shortcut(0) = 1
! shortcut(1) = 1
! do i=2,N_miniList
! do ni=1,nint
! if(miniList(ni,1,i) /= miniList(ni,1,i-1)) then
! shortcut(0) = shortcut(0) + 1
! shortcut(shortcut(0)) = i
! exit
! end if
! end do
! end do
!print *, N_miniList_tot , " vers ", dik
end subroutine
subroutine det_inf(res, key1, key2, Nint)
use bitmasks
implicit none
integer(bit_kind),intent(in) :: key1(Nint, 2), key2(Nint, 2)
integer,intent(in) :: Nint
integer :: i,j
logical,intent(out) :: res
res = .false.
do i=1,2
do j=Nint,1,-1
if(key1(j,i) < key2(j,i)) then
res = .true.
return
else if(key1(j,i) > key2(j,i)) then
return
end if
end do
end do
end function
subroutine tamiser(key, idx, no, n, Nint, N_key)
use bitmasks
implicit none
integer(bit_kind),intent(inout) :: key(Nint, 2, N_key)
integer,intent(in) :: no, n, Nint, N_key
integer,intent(inout) :: idx(N_key)
integer :: k,j,tmpidx
integer(bit_kind) :: tmp(Nint, 2)
logical :: inf
k = no
j = 2*k
do while(j <= n)
call det_inf(inf, key(:,:,j), key(:,:,j+1), Nint)
if(j < n .and. inf) then
j = j+1
end if
call det_inf(inf, key(:,:,k), key(:,:,j), Nint)
if(inf) then
tmp(:,:) = key(:,:,k)
key(:,:,k) = key(:,:,j)
key(:,:,j) = tmp(:,:)
tmpidx = idx(k)
idx(k) = idx(j)
idx(j) = tmpidx
k = j
j = 2*k
else
return
end if
end do
end subroutine
subroutine sort_detList(key, idx, N_key, Nint)
use bitmasks
implicit none
integer(bit_kind),intent(inout) :: key(Nint,2,N_key)
integer,intent(inout) :: idx(N_key)
integer, intent(in) :: Nint, N_key
integer(bit_kind) :: tmp(Nint, 2)
integer :: tmpidx,i
do i=N_key/2,1,-1
!call tamiser(key, idx, i, N_key, Nint, N_key)
end do
do i=N_key,2,-1
tmp(:,:) = key(:,:,i)
key(:,:,i) = key(:,:,1)
key(:,:,1) = tmp(:,:)
tmpidx = idx(i)
idx(i) = idx(1)
idx(1) = tmpidx
!call tamiser(key, idx, 1, i-1, Nint, N_key)
end do
end subroutine
subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n_selected,det_buffer,Nint,iproc,key_mask)
use bitmasks
implicit none