58 lines
992 B
Fortran
58 lines
992 B
Fortran
program triangle
|
|
|
|
implicit none
|
|
|
|
integer :: nside,nsite,nelec
|
|
integer :: ix,iy,iz,i
|
|
real*16 :: factor,bbfac
|
|
real*16 :: uee,ubb,eta0,aux
|
|
real*16 :: start,finish
|
|
real*16,allocatable :: sin2(:)
|
|
|
|
open(unit=10,file='input')
|
|
read(10,*) nside
|
|
close(10)
|
|
|
|
call cpu_time(start)
|
|
|
|
nsite = 2*nside
|
|
nelec = nside**2*2
|
|
|
|
!bbfac = 0.7839363355057699q0
|
|
bbfac = 0.78393636789823211548q0
|
|
|
|
write(6,*) "total number of electrons",nelec
|
|
|
|
allocate(sin2(nsite))
|
|
|
|
factor=acos(-1q0)/nsite
|
|
do i = 0, nsite-1
|
|
sin2(i+1) = (sin(factor*i))**2
|
|
enddo
|
|
|
|
uee = 0q0
|
|
do ix = 0, nsite-1
|
|
do iy = 0, nsite-1
|
|
if (ix+iy==0) cycle
|
|
if (mod(ix+iy,2)==1) cycle
|
|
aux = sqrt(sin2(ix+1)+3q0*sin2(iy+1))
|
|
uee = uee + 1q0/aux
|
|
enddo
|
|
enddo
|
|
|
|
factor=sqrt(acos(-1q0)/2q0)*3q0**(0.25q0)/nsite
|
|
uee=uee*factor
|
|
|
|
ubb = nelec*bbfac/nside
|
|
|
|
eta0 = uee - ubb
|
|
|
|
print*,'eta0 (in Ry and Ha) =', 2q0*eta0, eta0
|
|
|
|
deallocate(sin2)
|
|
|
|
call cpu_time(finish)
|
|
print '("Time = ",f12.3," seconds.")',finish-start
|
|
|
|
end program triangle
|