Afegir sessió 3 del lab de fenòmens
Change-Id: Ic21d679decc844e3c2899d6da4cca48301dbae0c
diff --git a/quad10/fenomens/lab/.gitignore b/quad10/fenomens/lab/.gitignore
index cfbd694..bad51b8 100644
--- a/quad10/fenomens/lab/.gitignore
+++ b/quad10/fenomens/lab/.gitignore
@@ -1,2 +1,4 @@
p*/out/
+p*/out_data/
*.o
+configuration.conf
diff --git a/quad10/fenomens/lab/p3/MC-1.f90 b/quad10/fenomens/lab/p3/MC-1.f90
new file mode 100644
index 0000000..b6f519b
--- /dev/null
+++ b/quad10/fenomens/lab/p3/MC-1.f90
@@ -0,0 +1,78 @@
+program main
+ implicit none
+ integer*4, PARAMETER :: L = 32
+ integer*2 :: S(1:L, 1:L)
+ real*8 :: MAGNE, ENERG, TEMP, E, DIFE, DELTA, M, SUMA, W(-8:8), genrand_real2
+ integer*4 :: PBC(0:L+1), I, J, IMC, MCTOT, IPAS, N, SEED
+ character :: TEMPSTRING*100, str*20
+
+ if (command_argument_count() < 1) then
+ print *, "Error: please supply a command-line argument with the"
+ print *, "temperature, via './mc1 {TEMPERATURE}', where {TEMPERATURE}"
+ print *, "is the temperature."
+ stop
+ endif
+
+ ! Inicialitzem algunes variables sobre el problema
+ call get_command_argument(1, TEMPSTRING) ! Ex: 2.0d0
+ TEMPSTRING = trim(adjustl(TEMPSTRING))
+ read (TEMPSTRING, *) TEMP
+ SEED = 234567
+ MCTOT = 10000
+ N = L*L
+
+ ! Obrim el fitxer on escriurem els resultats a cada iteració
+ open(unit = 12, file = "out_data/" // "SIM-L-" // trim(str(L)) // "-TEMP-" // &
+ trim(str(int(1000*TEMP))) // "-MCTOT-" // trim(str(MCTOT)) //".out")
+
+ ! Inicialitzem variable que ens fa latent la periodicitat
+ PBC(0) = L
+ PBC(L + 1) = 1
+ do I = 1, L
+ PBC(I) = I
+ enddo
+
+ ! Cache dels valors de l'exponencial
+ do I = -8, 8
+ W(I) = exp(-float(I)/TEMP)
+ enddo
+
+ ! Inicialitzem la matriu d'spins aleatòriament
+ call WRITECONFIG(S, L)
+
+ E = ENERG(S, L, PBC)
+ M = MAGNE(S, L)
+ print *, "Energia inicial:", E, "Magnet. inicial:", M
+ write (12, *) "0", E, M
+
+ ! Iterem amb el mètode de Montecarlo
+ do IMC = 1, MCTOT
+ do IPAS = 1, N
+ ! LOS LOOPS HACEN COSAS
+ I = INT(genrand_real2()*L) + 1
+ J = INT(genrand_real2()*L) + 1
+ SUMA = S(PBC(I - 1), J) + S(PBC(I + 1), J) + S(I, PBC(J - 1)) + S(I, PBC(J + 1))
+ DIFE = 2*SUMA*S(I, J)
+
+ if (DIFE > 0) then
+ DELTA = genrand_real2()
+ if (DELTA >= W(int(DIFE))) then
+ ! NO ho acceptem
+ cycle
+ endif
+ endif
+
+ ! Sí ho acceptem:
+ S(I, J) = -S(I, J)
+ E = E + DIFE
+ M = M + 2*S(I, J)
+ enddo
+ if (mod(IMC, 1000) == 0) then
+ print *, "Iter:", IMC, "Energia:", E, "Magn:", INT(M)
+ endif
+ write (12, *) IMC, E, M
+ enddo
+
+ ! Tanquem el fitxer de sortida
+ close(12)
+endprogram main
diff --git a/quad10/fenomens/lab/p3/MC-2.f90 b/quad10/fenomens/lab/p3/MC-2.f90
new file mode 100644
index 0000000..20efdca
--- /dev/null
+++ b/quad10/fenomens/lab/p3/MC-2.f90
@@ -0,0 +1,117 @@
+program main
+ use, intrinsic :: iso_c_binding, only: sp=>c_float, dp=>c_double
+ implicit none
+ integer*4, PARAMETER :: L = 32
+ integer*2 :: S(1:L, 1:L)
+ real*8 :: MAGNE, ENERG, TEMP, E, DIFE, DELTA, M, SUMA, W(-8:8), genrand_real2
+ integer*4 :: PBC(0:L+1), I, J, IMC, MCTOT, MCINI, MCD, IPAS, N, SEED, NSEED, SEED0
+ character :: TEMPSTRING*100, str*20
+ character(:), allocatable :: NOM
+
+ integer :: SUMI
+ real(dp) :: SUME, SUME2, SUMM, SUMAM, SUMM2, VARE, VARM
+
+ if (command_argument_count() < 1) then
+ print *, "Error: please supply a command-line argument with the"
+ print *, "temperature, via './mc1 {TEMPERATURE}', where {TEMPERATURE}"
+ print *, "is the temperature."
+ stop
+ endif
+
+ ! Inicialitzem algunes variables sobre el problema
+ call get_command_argument(1, TEMPSTRING) ! Ex: 2.0d0
+ TEMPSTRING = trim(adjustl(TEMPSTRING))
+ read (TEMPSTRING, *) TEMP
+ NSEED = 10
+ SEED0 = 117654
+ MCTOT = 10000
+ MCINI = 1000
+ MCD = 10
+ N = L*L
+ NOM = "out_data/" // "SIM-L-" // trim(str(L)) // "-TEMP-" // &
+ trim(str(int(1000*TEMP))) // "-MCTOT-" // trim(str(MCTOT))
+
+ ! Obrim el fitxer on escriurem els resultats a cada iteració
+ open(unit = 12, file = NOM // ".out")
+
+ ! Inicialitzem variable que ens fa latent la periodicitat
+ PBC(0) = L
+ PBC(L + 1) = 1
+ do I = 1, L
+ PBC(I) = I
+ enddo
+
+ ! Cache dels valors de l'exponencial
+ do I = -8, 8
+ W(I) = exp(-float(I)/TEMP)
+ enddo
+
+ do SEED = SEED0, SEED0 + NSEED - 1
+ print *, "Seed: ", SEED
+
+ ! Inicialitzem la matriu d'spins aleatòriament
+ call WRITECONFIGSEED(S, L, SEED)
+
+ E = ENERG(S, L, PBC)
+ M = MAGNE(S, L)
+ print *, "Energia inicial:", E, "Magnet. inicial:", M
+ write (12, *) "0", E, M
+
+ ! Iterem amb el mètode de Montecarlo
+ do IMC = 1, MCTOT
+ do IPAS = 1, N
+ ! LOS LOOPS HACEN COSAS
+ I = INT(genrand_real2()*L) + 1
+ J = INT(genrand_real2()*L) + 1
+ SUMA = S(PBC(I - 1), J) + S(PBC(I + 1), J) + S(I, PBC(J - 1)) + S(I, PBC(J + 1))
+ DIFE = 2*SUMA*S(I, J)
+
+ if (DIFE > 0) then
+ DELTA = genrand_real2()
+ if (DELTA >= W(int(DIFE))) then
+ ! NO ho acceptem
+ cycle
+ endif
+ endif
+
+ ! Sí ho acceptem:
+ S(I, J) = -S(I, J)
+ E = E + DIFE
+ M = M + 2*S(I, J)
+ enddo
+
+ if (mod(IMC, 1000) == 0) then
+ print *, "Iter:", IMC, "Energia:", E, "Magn:", INT(M)
+ endif
+ write (12, *) IMC, E, M
+
+ 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 = SUME2 - SUME*SUME
+ VARM = SUMM2 - SUMM*SUMM
+
+ ! Guardem a un fiter els promitjos
+ open(unit = 13, file = NOM // ".res")
+ write(13, *) L, TEMP, SUMI, SUME, SUME2, VARE, SUMM, SUMAM, SUMM2, VARM
+
+ ! Tanquem els fitxers de sortida
+ close(12)
+ close(13)
+endprogram main
diff --git a/quad10/fenomens/lab/p3/Makefile b/quad10/fenomens/lab/p3/Makefile
new file mode 100644
index 0000000..64bd220
--- /dev/null
+++ b/quad10/fenomens/lab/p3/Makefile
@@ -0,0 +1,26 @@
+.PHONY: all make_out_folder
+
+all: MC-1.o MC-2.o
+make_out_folder:
+ mkdir -p out out_data
+MC-1.o: make_out_folder mt19937ar.o writeconfig.o magne.o energ.o str.o MC-1.f90
+ gfortran -c MC-1.f90
+ gfortran MC-1.o writeconfig.o mt19937ar.o magne.o energ.o str.o -o out/mc1
+MC-2.o: make_out_folder mt19937ar.o writeconfigseed.o magne.o energ.o str.o MC-2.f90
+ gfortran -c MC-2.f90
+ gfortran MC-2.o writeconfigseed.o mt19937ar.o magne.o energ.o str.o -o out/mc2
+mt19937ar.o: mt19937ar.f
+ f77 -c mt19937ar.f
+writeconfig.o: writeconfig.f90
+ gfortran -c writeconfig.f90
+writeconfigseed.o: writeconfigseed.f90
+ gfortran -c writeconfigseed.f90
+magne.o: magne.f90
+ gfortran -c magne.f90
+energ.o: energ.f90
+ gfortran -c energ.f90
+str.o: str.f90
+ gfortran -c str.f90
+
+clean:
+ rm -rf out out_data *.o
diff --git a/quad10/fenomens/lab/p3/README.md b/quad10/fenomens/lab/p3/README.md
new file mode 100644
index 0000000..53ae2f4
--- /dev/null
+++ b/quad10/fenomens/lab/p3/README.md
@@ -0,0 +1,13 @@
+# Pràctica 3: Simulació MC del model d'Ising 2D: evolució temporal i promitjos
+**Data: 5 de maig de 2022**
+
+Programes:
+
+- `MC-1.f`: codi que simula el model d'Ising 2D amb l'algorisme de Metropolis començant per una matriu d'spins generada a l'atzar, i escriu en un fitxer els resultats a cada iteració per poder graficar-los.
+- `MC-2.f`: el mateix, però treu els promitjos.
+
+## Instruccions per compilar
+Per compilar, executeu `make all`. Els executables es trobaran a la carpeta `out`.
+
+## Nota addicional
+El script `mc-1.sh` permet generar el gràfic per comparar com evolucionen valors de l'E i M en funció de la temperatura.
diff --git a/quad10/fenomens/lab/p3/energ.f90 b/quad10/fenomens/lab/p3/energ.f90
new file mode 100644
index 0000000..4ee8508
--- /dev/null
+++ b/quad10/fenomens/lab/p3/energ.f90
@@ -0,0 +1,14 @@
+real*8 function ENERG(S, L, PBC)
+ integer*2 :: S(1:L, 1:L)
+ integer*4 :: I, J, L
+ integer*4 :: PBC(0:L+1)
+ real*8 :: ENE
+ ENE = 0.0d0
+ do I = 1, L
+ do J = 1, L
+ ENE = ENE - S(I, J)*S(PBC(I + 1), J) - S(I, J)*S(I, PBC(J + 1))
+ enddo
+ enddo
+ ENERG = ENE
+ return
+endfunction
diff --git a/quad10/fenomens/lab/p3/graphs/different_temp.gnu b/quad10/fenomens/lab/p3/graphs/different_temp.gnu
new file mode 100755
index 0000000..246cc97
--- /dev/null
+++ b/quad10/fenomens/lab/p3/graphs/different_temp.gnu
@@ -0,0 +1,17 @@
+#!/usr/bin/env -S gnuplot -c
+outputfile = 'out_data/diferent_t' # Nom de la imatge resultant (sense extensió)
+datafilepre = 'out_data/SIM-L-32-TEMP-'
+datafilepost = '-MCTOT-10000.out'
+L=32
+TEMPS="1500 1800 2500 3500 4500"
+
+set terminal svg dashed size 600, 1200 font "Computer Modern,Tinos,Helvetica,15"
+set output outputfile.'.svg'
+
+set key outside top horizontal
+set multiplot layout 2,1
+
+set title "Energia"
+plot for [T in TEMPS] datafilepre . T . datafilepost using 1:($2/(L*L)) with lines title "T = ".T." mK"
+set title "Magnetització"
+plot for [T in TEMPS] datafilepre . T . datafilepost using 1:($3/(L*L)) with lines title "T = ".T." mK"
diff --git a/quad10/fenomens/lab/p3/magne.f90 b/quad10/fenomens/lab/p3/magne.f90
new file mode 100644
index 0000000..0e7df92
--- /dev/null
+++ b/quad10/fenomens/lab/p3/magne.f90
@@ -0,0 +1,17 @@
+real*8 function MAGNE(S, L)
+ implicit none
+ integer*4, intent(in) :: L
+ integer*2, intent(out) :: S(1:L,1:L)
+ integer*4 :: i, j
+ real*8 :: mag
+ mag = 0d0
+
+ do i = 1, L
+ do j = 1, L
+ mag = mag + S(i, j)
+ enddo
+ enddo
+
+ magne = mag
+ return
+end function MAGNE
diff --git a/quad10/fenomens/lab/p3/mc-1.sh b/quad10/fenomens/lab/p3/mc-1.sh
new file mode 100644
index 0000000..bbfc02c
--- /dev/null
+++ b/quad10/fenomens/lab/p3/mc-1.sh
@@ -0,0 +1,11 @@
+#!/bin/sh
+temps="1.5 1.8 2.5 3.5 4.5"
+for temp in $temps; do
+ echo "-----------------------------"
+ echo "Executant per T = $temp"
+ echo "-----------------------------"
+ ./out/mc1 $temp
+
+ echo
+done
+./graphs/different_temp.gnu
diff --git a/quad10/fenomens/lab/p3/mt19937ar.f b/quad10/fenomens/lab/p3/mt19937ar.f
new file mode 100644
index 0000000..be81d16
--- /dev/null
+++ b/quad10/fenomens/lab/p3/mt19937ar.f
@@ -0,0 +1,282 @@
+c
+c A C-program for MT19937, with initialization improved 2002/1/26.
+c Coded by Takuji Nishimura and Makoto Matsumoto.
+c
+c Before using, initialize the state by using init_genrand(seed)
+c or init_by_array(init_key, key_length).
+c
+c Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
+c All rights reserved.
+c Copyright (C) 2005, Mutsuo Saito,
+c All rights reserved.
+c
+c Redistribution and use in source and binary forms, with or without
+c modification, are permitted provided that the following conditions
+c are met:
+c
+c 1. Redistributions of source code must retain the above copyright
+c notice, this list of conditions and the following disclaimer.
+c
+c 2. Redistributions in binary form must reproduce the above copyright
+c notice, this list of conditions and the following disclaimer in the
+c documentation and/or other materials provided with the distribution.
+c
+c 3. The names of its contributors may not be used to endorse or promote
+c products derived from this software without specific prior written
+c permission.
+c
+c THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+c "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+c LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+c A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+c CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+c EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+c PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+c PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+c LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+c NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+c SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+c
+c
+c Any feedback is very welcome.
+c http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html
+c email: m-mat @ math.sci.hiroshima-u.ac.jp (remove space)
+c
+c-----------------------------------------------------------------------
+c FORTRAN77 translation by Tsuyoshi TADA. (2005/12/19)
+c
+c ---------- initialize routines ----------
+c subroutine init_genrand(seed): initialize with a seed
+c subroutine init_by_array(init_key,key_length): initialize by an array
+c
+c ---------- generate functions ----------
+c integer function genrand_int32(): signed 32-bit integer
+c integer function genrand_int31(): unsigned 31-bit integer
+c double precision function genrand_real1(): [0,1] with 32-bit resolution
+c double precision function genrand_real2(): [0,1) with 32-bit resolution
+c double precision function genrand_real3(): (0,1) with 32-bit resolution
+c double precision function genrand_res53(): (0,1) with 53-bit resolution
+c
+c This program uses the following non-standard intrinsics.
+c ishft(i,n): If n>0, shifts bits in i by n positions to left.
+c If n<0, shifts bits in i by n positions to right.
+c iand (i,j): Performs logical AND on corresponding bits of i and j.
+c ior (i,j): Performs inclusive OR on corresponding bits of i and j.
+c ieor (i,j): Performs exclusive OR on corresponding bits of i and j.
+c
+c-----------------------------------------------------------------------
+c initialize mt(0:N-1) with a seed
+c-----------------------------------------------------------------------
+ subroutine init_genrand(s)
+ integer s
+ integer N
+ integer DONE
+ integer ALLBIT_MASK
+ parameter (N=624)
+ parameter (DONE=123456789)
+ integer mti,initialized
+ integer mt(0:N-1)
+ common /mt_state1/ mti,initialized
+ common /mt_state2/ mt
+ common /mt_mask1/ ALLBIT_MASK
+c
+ call mt_initln
+ mt(0)=iand(s,ALLBIT_MASK)
+ do 100 mti=1,N-1
+ mt(mti)=1812433253*
+ & ieor(mt(mti-1),ishft(mt(mti-1),-30))+mti
+ mt(mti)=iand(mt(mti),ALLBIT_MASK)
+ 100 continue
+ initialized=DONE
+c
+ return
+ end
+c-----------------------------------------------------------------------
+c initialize by an array with array-length
+c init_key is the array for initializing keys
+c key_length is its length
+c-----------------------------------------------------------------------
+ subroutine init_by_array(init_key,key_length)
+ integer init_key(0:*)
+ integer key_length
+ integer N
+ integer ALLBIT_MASK
+ integer TOPBIT_MASK
+ parameter (N=624)
+ integer i,j,k
+ integer mt(0:N-1)
+ common /mt_state2/ mt
+ common /mt_mask1/ ALLBIT_MASK
+ common /mt_mask2/ TOPBIT_MASK
+c
+ call init_genrand(19650218)
+ i=1
+ j=0
+ do 100 k=max(N,key_length),1,-1
+ mt(i)=ieor(mt(i),ieor(mt(i-1),ishft(mt(i-1),-30))*1664525)
+ & +init_key(j)+j
+ mt(i)=iand(mt(i),ALLBIT_MASK)
+ i=i+1
+ j=j+1
+ if(i.ge.N)then
+ mt(0)=mt(N-1)
+ i=1
+ endif
+ if(j.ge.key_length)then
+ j=0
+ endif
+ 100 continue
+ do 200 k=N-1,1,-1
+ mt(i)=ieor(mt(i),ieor(mt(i-1),ishft(mt(i-1),-30))*1566083941)-i
+ mt(i)=iand(mt(i),ALLBIT_MASK)
+ i=i+1
+ if(i.ge.N)then
+ mt(0)=mt(N-1)
+ i=1
+ endif
+ 200 continue
+ mt(0)=TOPBIT_MASK
+c
+ return
+ end
+c-----------------------------------------------------------------------
+c generates a random number on [0,0xffffffff]-interval
+c-----------------------------------------------------------------------
+ function genrand_int32()
+ integer genrand_int32
+ integer N,M
+ integer DONE
+ integer UPPER_MASK,LOWER_MASK,MATRIX_A
+ integer T1_MASK,T2_MASK
+ parameter (N=624)
+ parameter (M=397)
+ parameter (DONE=123456789)
+ integer mti,initialized
+ integer mt(0:N-1)
+ integer y,kk
+ integer mag01(0:1)
+ common /mt_state1/ mti,initialized
+ common /mt_state2/ mt
+ common /mt_mask3/ UPPER_MASK,LOWER_MASK,MATRIX_A,T1_MASK,T2_MASK
+ common /mt_mag01/ mag01
+c
+ if(initialized.ne.DONE)then
+ call init_genrand(21641)
+ endif
+c
+ if(mti.ge.N)then
+ do 100 kk=0,N-M-1
+ y=ior(iand(mt(kk),UPPER_MASK),iand(mt(kk+1),LOWER_MASK))
+ mt(kk)=ieor(ieor(mt(kk+M),ishft(y,-1)),mag01(iand(y,1)))
+ 100 continue
+ do 200 kk=N-M,N-1-1
+ y=ior(iand(mt(kk),UPPER_MASK),iand(mt(kk+1),LOWER_MASK))
+ mt(kk)=ieor(ieor(mt(kk+(M-N)),ishft(y,-1)),mag01(iand(y,1)))
+ 200 continue
+ y=ior(iand(mt(N-1),UPPER_MASK),iand(mt(0),LOWER_MASK))
+ mt(kk)=ieor(ieor(mt(M-1),ishft(y,-1)),mag01(iand(y,1)))
+ mti=0
+ endif
+c
+ y=mt(mti)
+ mti=mti+1
+c
+ y=ieor(y,ishft(y,-11))
+ y=ieor(y,iand(ishft(y,7),T1_MASK))
+ y=ieor(y,iand(ishft(y,15),T2_MASK))
+ y=ieor(y,ishft(y,-18))
+c
+ genrand_int32=y
+ return
+ end
+c-----------------------------------------------------------------------
+c generates a random number on [0,0x7fffffff]-interval
+c-----------------------------------------------------------------------
+ function genrand_int31()
+ integer genrand_int31
+ integer genrand_int32
+ genrand_int31=int(ishft(genrand_int32(),-1))
+ return
+ end
+c-----------------------------------------------------------------------
+c generates a random number on [0,1]-real-interval
+c-----------------------------------------------------------------------
+ function genrand_real1()
+ double precision genrand_real1,r
+ integer genrand_int32
+ r=dble(genrand_int32())
+ if(r.lt.0.d0)r=r+2.d0**32
+ genrand_real1=r/4294967295.d0
+ return
+ end
+c-----------------------------------------------------------------------
+c generates a random number on [0,1)-real-interval
+c-----------------------------------------------------------------------
+ function genrand_real2()
+ double precision genrand_real2,r
+ integer genrand_int32
+ r=dble(genrand_int32())
+ if(r.lt.0.d0)r=r+2.d0**32
+ genrand_real2=r/4294967296.d0
+ return
+ end
+c-----------------------------------------------------------------------
+c generates a random number on (0,1)-real-interval
+c-----------------------------------------------------------------------
+ function genrand_real3()
+ double precision genrand_real3,r
+ integer genrand_int32
+ r=dble(genrand_int32())
+ if(r.lt.0.d0)r=r+2.d0**32
+ genrand_real3=(r+0.5d0)/4294967296.d0
+ return
+ end
+c-----------------------------------------------------------------------
+c generates a random number on [0,1) with 53-bit resolution
+c-----------------------------------------------------------------------
+ function genrand_res53()
+ double precision genrand_res53
+ integer genrand_int32
+ double precision a,b
+ a=dble(ishft(genrand_int32(),-5))
+ b=dble(ishft(genrand_int32(),-6))
+ if(a.lt.0.d0)a=a+2.d0**32
+ if(b.lt.0.d0)b=b+2.d0**32
+ genrand_res53=(a*67108864.d0+b)/9007199254740992.d0
+ return
+ end
+c-----------------------------------------------------------------------
+c initialize large number (over 32-bit constant number)
+c-----------------------------------------------------------------------
+ subroutine mt_initln
+ integer ALLBIT_MASK
+ integer TOPBIT_MASK
+ integer UPPER_MASK,LOWER_MASK,MATRIX_A,T1_MASK,T2_MASK
+ integer mag01(0:1)
+ common /mt_mask1/ ALLBIT_MASK
+ common /mt_mask2/ TOPBIT_MASK
+ common /mt_mask3/ UPPER_MASK,LOWER_MASK,MATRIX_A,T1_MASK,T2_MASK
+ common /mt_mag01/ mag01
+CC TOPBIT_MASK = Z'80000000'
+CC ALLBIT_MASK = Z'ffffffff'
+CC UPPER_MASK = Z'80000000'
+CC LOWER_MASK = Z'7fffffff'
+CC MATRIX_A = Z'9908b0df'
+CC T1_MASK = Z'9d2c5680'
+CC T2_MASK = Z'efc60000'
+ TOPBIT_MASK=1073741824
+ TOPBIT_MASK=ishft(TOPBIT_MASK,1)
+ ALLBIT_MASK=2147483647
+ ALLBIT_MASK=ior(ALLBIT_MASK,TOPBIT_MASK)
+ UPPER_MASK=TOPBIT_MASK
+ LOWER_MASK=2147483647
+ MATRIX_A=419999967
+ MATRIX_A=ior(MATRIX_A,TOPBIT_MASK)
+ T1_MASK=489444992
+ T1_MASK=ior(T1_MASK,TOPBIT_MASK)
+ T2_MASK=1875247104
+ T2_MASK=ior(T2_MASK,TOPBIT_MASK)
+ mag01(0)=0
+ mag01(1)=MATRIX_A
+ return
+ end
diff --git a/quad10/fenomens/lab/p3/str.f90 b/quad10/fenomens/lab/p3/str.f90
new file mode 100644
index 0000000..31cd529
--- /dev/null
+++ b/quad10/fenomens/lab/p3/str.f90
@@ -0,0 +1,6 @@
+character(len=20) function str(k)
+ ! "Convert an integer to string."
+ integer, intent(in) :: k
+ write (str, *) k
+ str = adjustl(str)
+end function str
diff --git a/quad10/fenomens/lab/p3/writeconfig.f90 b/quad10/fenomens/lab/p3/writeconfig.f90
new file mode 100644
index 0000000..408a168
--- /dev/null
+++ b/quad10/fenomens/lab/p3/writeconfig.f90
@@ -0,0 +1,16 @@
+subroutine WRITECONFIG(S, L)
+ implicit none
+ integer*4, intent(in) :: L
+ integer*2, intent(out) :: S(1:L,1:L)
+ integer*4 :: SEED, i, j
+ real*8 :: genrand_real2
+
+ SEED = 23456
+ call init_genrand(SEED)
+
+ do i = 1, L
+ do j = 1, L
+ S(i, j) = merge(1, -1, genrand_real2() < .5d0)
+ enddo
+ enddo
+end subroutine WRITECONFIG
diff --git a/quad10/fenomens/lab/p3/writeconfigseed.f90 b/quad10/fenomens/lab/p3/writeconfigseed.f90
new file mode 100644
index 0000000..f7c8570
--- /dev/null
+++ b/quad10/fenomens/lab/p3/writeconfigseed.f90
@@ -0,0 +1,16 @@
+subroutine WRITECONFIGSEED(S, L, SEED)
+ implicit none
+ integer*4, intent(in) :: L
+ integer*4, intent(in) :: SEED
+ integer*2, intent(out) :: S(1:L,1:L)
+ integer*4 :: i, j
+ real*8 :: genrand_real2
+
+ call init_genrand(SEED)
+
+ do i = 1, L
+ do j = 1, L
+ S(i, j) = merge(1, -1, genrand_real2() < .5d0)
+ enddo
+ enddo
+end subroutine WRITECONFIGSEED