!   From: "COMPUTATIONAL PHYSICS, 2nd Ed" 
!   by RH Landau, MJ Paez, and CC Bordeianu 
!   Copyright Wiley - VCH, 2007.
!   Electronic Materials copyright: R Landau, Oregon State Univ, 2007;
!   MJ Paez, Univ Antioquia, 2007; and CC Bordeianu, Univ Bucharest, 2007.
!   Supported by the US National Science Foundation

! Ising3D.f90: Ising 3D model of magnetic dipol string      

Program Ising3D

  Implicit none
  Integer :: N = 200, Ni = 20, Nj = 20, Nk = 20, i, j, k, l, n1
  Real*8 :: sum, E, M, M2, U, U2, C, Chi, Ener, Mag, kT
  Real*8  :: a(20, 20, 20), ranDom
	
  Open(8, FILE = 'specific_heat.dat', Status = 'Unknown')
  Open(9, FILE = 'susceptibility.dat', Status = 'Unknown')
  Open(10, FILE = 'energy.dat', Status = 'Unknown')
  Open(11, FILE = 'magnetization.dat', Status = 'Unknown')
	
 ! N = 200 of Numb tries, Ni = 20, Nj = 20, Nk = 20=Lattice size
 ! a(20, 20, 20) - Spin config,             kT - Temperature
 
  Do kT = 0.5, 8., 0.10                           ! Running Averages
    U  = 0.                                                   ! Ener
    U2 = 0.
    M   = 0.                                                   ! Mag
    M2 = 0.
		                       ! Set up the initial lattice configuration
    Do  i = 1, Ni                
      Do  j = 1, Nj
        Do k = 1, Nk
          a(i, j, k) = 1.
        End Do
      End Do
    End Do
		                                 ! Initial Ener and magnetization
    Ener = 0.         
    Mag = 0.
    Do  i = 1, Ni
      Do j = 1, Nj
			                                   ! sum over nearest neighbors
        Do k = 1, Nk
          sum = 0.
					                             ! Periodic Boundary Conditions
          If ( i > 1 ) then                  
            sum = sum + a(i- 1, j, k)
          Endif
          If (i < Ni) then
              sum = sum + a(i+ 1, j, k)
          Endif
          If ( j > 1 ) then
            sum = sum + a(i, j - 1, k)
          Endif
          If ( j < Nj ) then
            sum = sum + a(i, j + 1, k)
          Endif
          If ( k > 1 ) then
            sum = sum + a(i, j, k - 1)
          Endif
          If ( k < Nk ) then
            sum = sum + a(i, j, k + 1)
          Endif
          Ener = Ener - sum * a(i, j, k) 
          Mag = Mag - a(i, j, k)
        End Do
      End Do
    End Do
    Ener = Ener/2.                               ! Correct the energy
    Do  l = 1, N
		                                    ! Pick node to flip at random
      Do n1 = 1, Ni*Nj*Nk
        i = ranDom()*Ni + 1                   
        j = ranDom()*Nj + 1
        k = ranDom()*Nk + 1
        sum = 0.     
				                    ! Calculate change in energy when flipped
        If ( i > 1 ) then
           sum = sum + a(i- 1, j, k)
        Endif
        If (i < Ni ) then
          sum = sum + a(i+ 1, j, k)
        Endif
        If (j > 1 ) then
          sum = sum + a(i, j - 1, k)
        Endif
        If (j < Nj ) then
          sum = sum + a(i, j + 1, k)
        Endif
        If (k > 1 ) then
          sum = sum + a(i, j, k - 1)
        Endif
        If (k < Nk ) then
          sum = sum + a(i, j, k + 1)
        Endif
				                                             ! energy change
        E = 2. * sum * a(i, j, k)                           
				                                        ! Metroplis algorithm
        If (( E < 0. ).or.( exp( - E/kT) > ranDom() )) then     
                                                      ! Accept change
          a(i, j, k) = - a(i, j, k)                       ! flip spin
          Ener = Ener + E
          Mag = Mag - 2. * a(i, j, k)
        Endif
      End Do
			                                           ! Increment averages
      M = M + Mag                                      
      M2 = M2 + Mag * Mag
      U = U + Ener 
      U2 = U2 + Ener * Ener
			                                                ! Print to file
      If (modulo(l, N - 1) == 0) then                  
        U = U/l/Ni/Nj/Nk                             ! average energy
        U2 = U2/l/Ni/Nj/Nk/Ni/Nj/Nk
        C = ((U2 - U*U))/kT/kT                        ! specific heat
        M = M/l/Ni/Nj/Nk                      ! average magnetization
        M2 = M2/l/Ni/Nj/Nk/Ni/Nj/Nk
        Chi = ((M2 - M*M))/kT                       ! susceptibility
        write(*, *) kT, C  
        write(8, *)  kT, C                            
        write(9, *)   kT, Chi                         
        write(10, *)  kT, U                           
        write(11, *)  kT, abs(M)              
      Endif
    End Do
  End Do
  close(8)
  close(9)
  close(10)
  close(11)
End Program Ising3D