!----------------------! module systemvariables implicit none integer :: ll ! system length integer :: nn ! number of spins (nn=ll*ll) real(8) :: pflip(-4:4) ! flip probabilities integer, allocatable :: spin(:) ! spin array integer, allocatable :: mdis(:) ! magnetization distribution end module systemvariables !--------------------------! !----------------------------------------------------------------------! ! Metropolis-algorithm simulation of the two-dimensional Ising model. ! ! Reads the following from a file 'read.in': ! ! ll,tt ! ! steps1,steps2,steps3,bins ! ! where: ll = system length (integer) ! ! tt = temperature (T/J) ! ! steps1 = # of sweeps for equilibration ! ! steps2 = # of sweeps for construction magnetization histogram ! ! steps3 = # of sweeps per bin for reversal statistics ! ! bins = # of bins for reversal statistics ! ! Random numbers seed (and integer) is read from 'seed.in'. ! ! Writes the magnetization histogram to the file 'mag.dat': ! ! Writes information on the reversals to file 'log.dat': ! !----------------------------------------------------------------------! program ising2d !---------------! use systemvariables implicit none integer :: i,j,t,m,nr,bins,steps1,steps2,steps3 real(8) :: ran,tt,at,avt,ert open(1,file='read.in',status='old') read(1,*)ll,tt read(1,*)steps1,steps2,steps3,bins close(1) nn=ll*ll call initran(1) do i=-4,4 pflip(i)=exp(-2.d0*dble(i)/tt) end do allocate (spin(0:nn-1)) do i=0,nn-1 spin(i)=2*int(2.d0*ran())-1 enddo do i=1,steps1 call mcstep() enddo allocate (mdis(0:nn)); mdis=0 do i=1,steps2 call mcstep() m=abs(sum(spin)) mdis(m)=mdis(m)+1 enddo mdis(0)=mdis(0)*2 m=0 open(10,file='mag.dat',status='replace') do i=mod(nn,2),nn,2 write(10,*)i,mdis(i) enddo close(10) open(10,file='log.dat',status='replace') do j=1,bins nr=0 at=0.d0 do i=1,steps3 call mcstep() enddo at=at/dble(nr) avt=avt+at ert=ert+at**2 open(10,file='log.dat',position='append') write(10,'(i4,i8,f12.1)')j,nr,at close(10) enddo avt=avt/bins ert=ert/bins ert=sqrt((ert-avt**2)/dble(bins-1)) open(10,file='log.dat',position='append') write(10,*)avt,ert close(10) deallocate(spin) deallocate(mdis) !-------------------! end program ising2d !-------------------! !----------------------------------------------! ! Carries out one Monte Carlo step, defined as ! ! nn flip attempts of randomly selected spins. ! !----------------------------------------------! subroutine mcstep() !-------------------! use systemvariables implicit none integer :: i,s,x,y,s1,s2,s3,s4 real(8) :: ran do i=1,nn s=int(ran()*nn) ! generate random site x=mod(s,ll); y=s/ll ! coordinates of site s s1=spin(mod(x+1,ll)+y*ll) ! spin at right neighbor of site s s2=spin(x+mod(y+1,ll)*ll) ! spin at up neighbor of site s s3=spin(mod(x-1+ll,ll)+y*ll) ! spin at left neighbor of site s s4=spin(x+mod(y-1+ll,ll)*ll) ! spin at down neighbor of site s if (ran()