LCPQ
/
DEHam
mirror of https://github.com/LCPQ/DEHam
2
0
Fork 0
Code Issues Releases Wiki Activity
DEHam/src/adr.irp.f

41 lines
947 B
FortranFixed
Raw Normal View History

initial commit
2016-12-19 23:26:16 +01:00
subroutine adr(ideter,add)
looks like now it works for natom > 16
2018-01-29 00:10:47 +01:00
use iso_c_binding
initial commit
2016-12-19 23:26:16 +01:00
implicit none
BEGIN_DOC
! this subroutine provides the address of a detrminant
! given in old format.
! It searches in a list of generated determinants and
! matches the given determinant.
END_DOC
integer,INTENT(INOUT)::ideter(natomax)
looks like now it works for natom > 16
2018-01-29 00:10:47 +01:00
integer(C_SIZE_T),INTENT(INOUT)::add
integer(C_SIZE_T)::deti,dethi,addh,detnew
initial commit
2016-12-19 23:26:16 +01:00
integer::count,i,j
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
deti=0
initial commit
2016-12-19 23:26:16 +01:00
detnew=0
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
dethi=0
initial commit
2016-12-19 23:26:16 +01:00
count=0
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
call conv(ideter,deti,dethi)
initial commit
2016-12-19 23:26:16 +01:00
Do i=0,natom-1
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
if(BTEST(dethi,i))then
initial commit
2016-12-19 23:26:16 +01:00
count=count+1
endif
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
if(BTEST(deti,i))then
initial commit
2016-12-19 23:26:16 +01:00
detnew=IBSET(detnew,i-count)
endif
enddo
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
deti=detnew
call searchdet(deti,add,dethi,addh)
initial commit
2016-12-19 23:26:16 +01:00
add = add + (nt1-addh)*(nt2)
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,I14)
16 FORMAT(B64,I14,I14)
end