2016-12-19 23:26:16 +01:00
|
|
|
subroutine adr(ideter,add)
|
|
|
|
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)
|
|
|
|
integer(kind=selected_int_kind(16)),INTENT(INOUT)::add
|
2018-01-27 12:41:48 +01:00
|
|
|
integer(kind=selected_int_kind(16))::deti,dethi,addh,detnew
|
2016-12-19 23:26:16 +01:00
|
|
|
integer::count,i,j
|
|
|
|
|
2018-01-27 12:41:48 +01:00
|
|
|
deti=0
|
2016-12-19 23:26:16 +01:00
|
|
|
detnew=0
|
2018-01-27 12:41:48 +01:00
|
|
|
dethi=0
|
2016-12-19 23:26:16 +01:00
|
|
|
count=0
|
2018-01-27 12:41:48 +01:00
|
|
|
call conv(ideter,deti,dethi)
|
2016-12-19 23:26:16 +01:00
|
|
|
Do i=0,natom-1
|
2018-01-27 12:41:48 +01:00
|
|
|
if(BTEST(dethi,i))then
|
2016-12-19 23:26:16 +01:00
|
|
|
count=count+1
|
|
|
|
endif
|
2018-01-27 12:41:48 +01:00
|
|
|
if(BTEST(deti,i))then
|
2016-12-19 23:26:16 +01:00
|
|
|
detnew=IBSET(detnew,i-count)
|
|
|
|
endif
|
|
|
|
enddo
|
2018-01-27 12:41:48 +01:00
|
|
|
deti=detnew
|
|
|
|
call searchdet(deti,add,dethi,addh)
|
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
|