mirror of
https://github.com/LCPQ/DEHam
synced 2024-06-27 23:52:14 +02:00
3278aabfeb
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
136 lines
3.3 KiB
Fortran
136 lines
3.3 KiB
Fortran
subroutine extra_diag(tistart)
|
|
implicit none
|
|
|
|
integer(kind=selected_int_kind(16)) :: iaa,iaa2,tistart,tistart2
|
|
integer(kind=selected_int_kind(16)) :: imat4,jmat4
|
|
integer :: i,ik,iik,j
|
|
integer :: ik1,ik2,IC,k,ikmax,ikmin,count,count2,detfound2
|
|
integer,allocatable :: ideter2(:)
|
|
real*8 :: dmat4,xmat
|
|
logical :: yw
|
|
|
|
!---------------------------------------------------------------------
|
|
! Calcul des elements extradiagonaux
|
|
!---------------------------------------------------------------------
|
|
!----------boucle premier voisin
|
|
|
|
allocate (ideter2(natomax))
|
|
foundet=0
|
|
foundetadr=0
|
|
foundetdmat=0d0
|
|
detfound=0
|
|
detfound2=0
|
|
foundadd=0
|
|
foundaddh=0
|
|
count=0
|
|
count2=1
|
|
tistart2=tistart
|
|
|
|
do j=1,nrows
|
|
|
|
call getdet(tistart,ideter2)
|
|
deter=ideter2
|
|
ideter2=0
|
|
Touch deter
|
|
! call adr(deter,iaa)
|
|
! call elem_diag(xmat)
|
|
! countcol+=1
|
|
! col(countcol)=iaa
|
|
! val(countcol)=xmat*1.0d0
|
|
|
|
count=0
|
|
yw=.FALSE.
|
|
do ik=1,nlientot
|
|
ik1=iliatom1(ik)
|
|
ik2=iliatom2(ik)
|
|
do k=1,natom
|
|
ideter2(k)=deter(k)
|
|
enddo
|
|
if(yalt(ik)) then
|
|
if (deter(ik1).eq.2) then
|
|
ideter2(ik1)=1
|
|
ideter2(ik2)=2
|
|
else
|
|
ideter2(ik1)=2
|
|
ideter2(ik2)=1
|
|
endif
|
|
dmat4=xjz(ik)
|
|
if(dmat4.ne.0d0)then
|
|
count+=1
|
|
foundet(:,detfound+count)=ideter2
|
|
foundetdmat(detfound+count)=dmat4
|
|
endif
|
|
endif
|
|
if(ytrou(ik)) then
|
|
if(deter(ik2).eq.3)then
|
|
if (deter(ik1).eq.1) then
|
|
ideter2(ik1)=3
|
|
ideter2(ik2)=1
|
|
else
|
|
ideter2(ik1)=3
|
|
ideter2(ik2)=2
|
|
endif
|
|
else
|
|
if (deter(ik2).eq.1) then
|
|
ideter2(ik1)=1
|
|
ideter2(ik2)=3
|
|
else
|
|
ideter2(ik1)=2
|
|
ideter2(ik2)=3
|
|
endif
|
|
endif
|
|
ikmin=min(ik1,ik2)
|
|
ikmax=max(ik1,ik2)
|
|
IC=0
|
|
do iik=ikmin+1,ikmax-1
|
|
if(deter(iik).ne.3)IC=IC+1
|
|
enddo
|
|
dmat4=(xt(ik))*(-1)**(IC)
|
|
if(dmat4.ne.0d0)then
|
|
count+=1
|
|
foundet(:,detfound+count)=ideter2
|
|
foundetdmat(detfound+count)=dmat4
|
|
endif
|
|
endif
|
|
enddo
|
|
|
|
detfound+=count
|
|
countcolfull(j)=count
|
|
tistart=tistart+1
|
|
|
|
enddo
|
|
Touch foundet foundetadr detfound foundadd foundaddh foundetdmat det deth
|
|
call adrfull()
|
|
|
|
do i=1,detfound
|
|
if(i.eq.1 .or. i-1.eq.detfound2)then
|
|
call getdet(tistart2,ideter2)
|
|
deter=ideter2
|
|
ideter2=0
|
|
Touch deter
|
|
call adr(deter,iaa)
|
|
call elem_diag(xmat)
|
|
countcol+=1
|
|
col(countcol)=iaa
|
|
val(countcol)=xmat*1.0d0
|
|
|
|
tistart2+=1
|
|
detfound2+=countcolfull(count2)
|
|
! if(i.ne.1)then
|
|
count2+=1
|
|
! endif
|
|
endif
|
|
imat4=iaa+1
|
|
jmat4=foundetadr(i)
|
|
dmat4=foundetdmat(i)
|
|
if(jmat4.le.(nt1*nt2) .and. dmat4 .ne. 0d0)then
|
|
countcol+=1
|
|
col(countcol)=jmat4
|
|
val(countcol)=dmat4
|
|
endif
|
|
enddo
|
|
|
|
|
|
return
|
|
end
|