quad10/fenomens/lab/p4/MC-2.f90

program main
  use, intrinsic :: iso_c_binding, only: sp=>c_float, dp=>c_double
  use iso_fortran_env
  implicit none
  integer*4 :: L
  real*8 :: magne, energ, TEMP, E, DIFE, DELTA, M, SUMA, W(-8:8)
  integer*4 :: I, J, IMC, MCTOT, MCINI, MCD, IPAS, N, SEED, NSEED, SEED0, pbc
  integer :: genrand_int31
  character(100) :: NOM
  logical :: SAVEFINALCONF, SAVEEVOLUTION

  integer :: SUMI
  real(dp) :: SUME, SUME2, SUMM, SUMAM, SUMM2, VARE_TIMES_SUMI, VARM_TIMES_SUMI, CV, CHI

  ! Donat que les matrius a Fortran han de tenir una mida fixada i no poden
  ! dependre dinàmicament d'un paràmetre L, fem S de mida 128x128, i establim
  ! 128 com el valor màxim de L.
  integer*2 :: S(1:128, 1:128)

  ! Inicialitzem algunes variables sobre el problema, que es passen al programa amb un namelist
  ! L: Mida del sistema
  ! NOM: Prefix dels noms dels fitxers on es desaran les dades.
  ! TEMP: Temperatura reduïda per la simulació.
  ! NSEED: Nombres de seeds que es simularan.
  ! SEED0: Nombre de la seed inicial.
  ! MCTOT: Nombre d'iteracions Montecarlo que es faran per cada llavor.
  ! MCD: Cada cuantes iteracions Montecarlo s'han d'enregistrar les magnituds.
  ! SAVEFINALCONF: Si s'ha de desar un fitxer amb la configuració final.
  ! SAVEEVOLUTION: Si s'ha de desar un fitxer amb l'evolució temporal de les magnituds.
  namelist /DADES/ L, NOM, TEMP, NSEED, SEED0, MCTOT, MCINI, MCD, SAVEFINALCONF, SAVEEVOLUTION
  read(nml = DADES, unit = 5)

  if (L < 1 .or. L > 128) then
    print *, "ERROR: L ha de ser un enter entre 1 i 128."
    stop
  endif

  N = L*L

  ! Cache dels valors de l'exponencial
  do I = 0, 8
    W(I) = (2**30 - 1 + 2**30)*exp(-float(I)/TEMP)
  enddo

  ! Variables on anirem sumant les magnituds per fer el promig posteriorment
  SUMI = 0
  SUME = 0
  SUME2 = 0

  SUMM = 0
  SUMAM = 0
  SUMM2 = 0

  ! Si s'ha especificat de desar l'evolució temporal, obrim el fitxer on la desarem
  if (SAVEEVOLUTION) then
    open(12, file = "data_out/" // trim(NOM) // ".ev")
  endif

  ! Fem la simulació per NSEED seeds inicials.
  do SEED = SEED0, SEED0 + NSEED - 1
    print *, "Seed: ", SEED

    ! Inicialitzem la matriu d'spins aleatòriament
    call generateSpinMatrix(S, L, SEED)

    E = energ(S, L)
    M = magne(S, L)
    if (SAVEEVOLUTION) then
      write (12, *) "0", E, M
    endif

    ! Iterem amb el mètode de Montecarlo
    do IMC = 1, MCTOT
      do IPAS = 1, N
        I = mod(genrand_int31(), L) + 1
        J = mod(genrand_int31(), L) + 1
        SUMA = S(PBC(I - 1, L), J) + &
               S(PBC(I + 1, L), J) + &
               S(I, PBC(J - 1, L)) + &
               S(I, PBC(J + 1, L))
        DIFE = 2*SUMA*S(I, J)

        if (DIFE > 0) then
          DELTA = genrand_int31()
          if (DELTA >= W(int(DIFE))) then
            ! NO ho acceptem, passem a la següent volta del loop
            cycle
          endif
        endif

        ! Sí ho acceptem:
        S(I, J) = -S(I, J)
        E = E + DIFE
        M = M + 2*S(I, J)
      enddo

      if (SAVEEVOLUTION) then
        write (12, *) IMC, E, M
      endif

      ! Per evitar les correlacions de configuracions consecutives, només
      ! prenem mesures cada MCD configuracions.
      if (IMC > MCINI .and. mod(IMC, MCD) == 0) then
        SUMI = SUMI + 1

        SUME = SUME + E
        SUME2 = SUME2 + E*E

        SUMM = SUMM + M
        SUMAM = SUMAM + abs(M)
        SUMM2 = SUMM2 + M*M
      endif
    enddo
  enddo

  ! Normalitzem els promitjos
  SUME = SUME/SUMI
  SUME2 = SUME2/SUMI
  SUMM = SUMM/SUMI
  SUMAM = SUMAM/SUMI
  SUMM2 = SUMM2/SUMI
  VARE_TIMES_SUMI = SUME2 - SUME**2
  VARM_TIMES_SUMI = SUMM2 - SUMM**2
  CV = (SUME2 - SUME**2)/real(N*TEMP**2)
  CHI = (SUMM2 - SUMAM**2)/real(N*TEMP)

  ! Guardem a un fitxer els promitjos
  open(unit = 13, file = "data_out/" // trim(NOM) // ".res")
  ! Valors: L, T, <E>, <E**2>, Var(E)*SUMI, <M>, <|M|>, <M**2>, Var(M)*SUMI, C_V, CHI
  write(13, *) L, TEMP, SUME, SUME2, VARE_TIMES_SUMI, SUMM, SUMAM, SUMM2, VARM_TIMES_SUMI, CV, CHI

  if (SAVEFINALCONF) then
    call writeConfig(S, L, "data_out/" // trim(NOM) // ".conf")
  endif

  ! Tanquem els fitxers de sortida
  close(13)
  if (SAVEEVOLUTION) then
    close(12)
  endif
endprogram main