2
0
mirror of https://github.com/LCPQ/DEHam synced 2024-06-27 15:42:28 +02:00
DEHam/src/searchdet.irp.f
vijay gopal chilkuri 3278aabfeb updating code to the current local version, it might not compile atm.
Many new features added:
1. getting S2 values
2. possibility of setting position of hole
3. possibility of setting Sbox
4. three Sbox definitions at once
5. Doing only FAM1 or the full set of states
6. efficiency improvements
2018-01-27 12:41:48 +01:00

77 lines
1.9 KiB
Fortran

subroutine searchdet(deti,add,dethi,addh)
BEGIN_DOC
! this subroutine is at the heart of the idea
! it will generate all the determinants in a fixed order
! then find the posistion of the determinant given and
! return it's position in add.
END_DOC
integer(kind=selected_int_kind(16)),INTENT(INOUT)::deti
integer(kind=selected_int_kind(16)),INTENT(INOUT)::add
integer(kind=selected_int_kind(16)),INTENT(INOUT)::dethi
integer(kind=selected_int_kind(16)),INTENT(INOUT)::addh
integer(kind=selected_int_kind(16))::dethsh
integer(kind=selected_int_kind(16))::a
integer(kind=selected_int_kind(16))::i,j
integer::count
logical::found
i=1
j=nt1
found=.FALSE.
do while(.not.found)
if(deth((i+j)/2,1).eq.dethi)then
addh=deth((i+j)/2,2)
found=.TRUE.
EXIT
elseif (abs(i-j).eq.1)then
if(deth(i,1).eq.dethi)then
addh=deth(i,2)
elseif(deth(j,1).eq.dethi)then
addh=deth(j,2)
endif
found=.TRUE.
EXIT
else
if(deth((i+j)/2,1).gt.dethi)then
j=(i+j)/2
else
i=(i+j)/2
endif
endif
enddo
i=1
j=nt2
found=.FALSE.
do while(.not.found)
if(det((i+j)/2,1).eq.deti)then
add=det((i+j)/2,2)
found=.TRUE.
EXIT
elseif (abs(i-j).eq.1)then
if(det(i,1).eq.deti)then
add=det(i,2)
elseif(det(j,1).eq.deti)then
add=det(j,2)
endif
found=.TRUE.
EXIT
else
if(det((i+j)/2,1).gt.deti)then
j=(i+j)/2
else
i=(i+j)/2
endif
endif
enddo
10 FORMAT(B64,I8,F8.2)
15 FORMAT(B64,I8,I8,I8)
11 FORMAT(B64,I3,B64)
12 FORMAT(I5,$)
13 FORMAT(B64,B64)
14 FORMAT(B64,I8)
16 FORMAT(B64,I8,I8)
end