Increase Steps in 2D Self Avoiding Random Walk - fortran

I am trying to increase the number of possible steps in the following Fortran self avoiding random walk program.
Increasing the number of steps would result in more accuracy regarding the square mean distance
I would appropriate your solutions and suggestions.
PROGRAM Two_dimensional_Self_Avoiding__Random_Walks
implicit none
integer, dimension(:,:), allocatable :: lattice
integer, dimension(1:46):: na
integer :: i,x,y,xt,yt,id,step,xx, ns,n,ii,III,choice
real :: r,dis,dis2,square,d,d2
Logical :: terminate,newsite
CALL RANDOM_SEED()
! intial values for end to end distance
read(*,*) choice
if (choice == 1) then
print*, ' Enter ns and n '
read(*,*) ns
na = (/(III, III=5, 50, 1)/)
do ii= 1, 46
dis = 0.0; dis2 = 0.0
n = na(ii)
allocate(lattice(-n:n,-n:n))
CALL walks() ! self avoiding walks
IF (ALLOCATED (lattice)) DEALLOCATE (lattice)
enddo
elseif (choice == 2) then
print*, ' Enter ns and n '
read(*,*) ns , n
dis = 0.0; dis2 = 0.0
allocate(lattice(-n:n,-n:n))
CALL walks()
endif
CONTAINS
SUBROUTINE walks
DO i = 1,ns
lattice = 0; x = 0; y = 0
step = 0; terminate = .FALSE.
DO WHILE ((.NOT. terminate) .AND. (step <= n))
xt = x; yt = y
xx = lattice(x+1,y)+lattice(x-1,y) &
+lattice(x,y+1)+lattice(x,y-1)
IF (xx == 4) THEN
terminate = .TRUE.
ELSE
newsite = .FALSE.
DO WHILE (.NOT. newsite)
CALL RANDOM_NUMBER(r)
id = INT(r*4.0)
IF (id == 0) THEN
x = xt + 1; y = yt
ELSEIF (id == 1) THEN
x = xt - 1; y = yt
ELSEIF (id == 2) THEN
x = xt; y = yt + 1
ELSEIF (id == 3) THEN
x = xt; y = yt - 1
ENDIF
IF (lattice(x,y) == 0) newsite = .TRUE.
ENDDO
step = step + 1; lattice(x,y) = 1
ENDIF
write(7,*) x,y
ENDDO
write(10,*),step
square = float(x**2+y**2)
dis = dis + sqrt(square); dis2 = dis2 + square
d = dis/ns; d2=dis2/ns
ENDDO
write(11,*), ns,n, d, d2
print*, ns,n, d, d2
END SUBROUTINE walks
END PROGRAM Two_dimensional_Self_Avoiding__Random_Walks

Related

fortran gives strange results when writing to file

I am using fortran. I want to write some information to a file, and here is my code:
open(unit=114514, position="append", file="msst_info.txt")
write(114514, 100) "step =", step
write(114514, 200) "A =", A
write(114514, 200) "omega =", omega(sd)
write(114514, 300) "dilation =", dilation(sd)
write(114514, 200) "p_msst =", p_msst / (kBar * 10)
write(114514, 300) "vol =", vol / Ang**3
write(114514, 300) "temp =", temperature
write(114514, 400) "+++++++++++++++++++++++++++"
100 format(A10, i8)
200 format(A10, e12.4)
300 format(A10, f12.4)
400 format(A)
close(114514)
I wish it can append the information to this file after each step. But the result is very strange:
dilation = 0.9999
p_msst = 0.3619E+02
vol = 10 A = -0.1041E-23
omega = -0.2290E-15
dilation = 0.9999
p_msst = 0.3619E+02
vol A = -0.1041E-23
omega = -0.2290E-15
dilation = 0.9999
p_msst = 0.3619E+02
vol = 1053.0452
temp = 195.9830
+++++++++++++++++++++++++++
step = 6
A = -0.1041E-23
omega = -0.2290E-15
dilation = 0.9999
p_msst = 0.3619E+02
vol = 1053.0452
temp = 195.9830
+++++++++++++++++++++++++++
step = 7
A = -0.1249E step = 7
A = -0.1249E-23
omega = -0.2290E-15
dilation = 0.9999
p_msst = 0.4342E+02
vol = 1052.8163
temp = 198.4668
+++++++++++++++++++++++++++
the format of step 6 is what i want. but in step 7, some text is written multiple times, and their position is completely wrong. I wonder why it happens.
the whole code:
module msst
use poscar_struct_def
use dynconstr
use prec
use reader_tags
use poscar
implicit none
contains
subroutine msst_step(dyn, latt_cur, t_info, tsif, tifor, io, niond, nionpd, ntypd, ntyppd)
! =======================================================================
! Written by S. Pan 2021/5/28
! This subroutine calculate a msst step. (Evan J. Reed 2003 PRL)
! I refer to fix_msst.cpp in LAMMPS when writing this code.
! The v(t-dt/2) is needed for velocity verlet algo.
! Two step: first, calculate the velocity v(t) with the a(t) and v(t-dt/2).
! second: give the position of ion and cell x(t+dt), and v(t+dt/2).
! The parameter mu is neglected since it makes the process complex.
! dyn: the struct for some MD variables, such as x, v, force.
! t_info: the struct for type information, such as number of ions.
! step: the current number of step. Init if step == 1.
! =======================================================================
! the dyn info will be changed
type(dynamics), intent(in out) :: dyn
type(latt), intent(in out) :: latt_cur
type(type_info), intent(in out) :: t_info
! these are inputs, should not be modified
type(in_struct), intent(in) :: io
real(q), dimension(3, t_info%nions), intent(in) :: tifor ! force on ions
real(q), dimension(3, 3), intent(in) :: tsif ! stress
! some units
real(q), parameter :: eV = 1.60218e-19, Ang = 1e-10, fs = 1e-15, &
amu = 1.66053886e-27, kBar = 1e5, kB = 1.38064852e-23
! energy in J, length in meter, time in s, mass in kg
! stress in Pa
! internal variables
real(q), save :: dt, dthalf, tscale, qmass, vs, total_mass=0, vol0
real(q), dimension(3, t_info%nions) :: velocity_before_half_dt, velocity_now, velocity_after_half_dt, &
C_force, x
real(q), dimension(3), save :: omega = [0, 0, 0] ! the time derivative of cell
real(q), dimension(3) :: dilation = [1, 1, 1]
integer :: ierr, ii, ni, nt, niond, nionpd, ntypd, ntyppd
integer, save :: sd, step = 0
real(q), dimension(3, 3) :: kinetic_stress, total_stress
real(q), dimension(3, 3), save :: p0
real(q) :: p_msst, A, vol, vol1, vol2, fac1, sqrt_initial_temperature_scaling, temperature, ekin
if (step .eq. 0) then
dyn%init = 0
call rd_poscar(latt_cur, t_info, dyn, &
& niond, nionpd, ntypd, ntyppd, &
& io%iu0, io%iu6)
end if
dyn%posioc = dyn%posion
step = step + 1
dt = dyn%potim * fs
dthalf = dt/2
! convert x to cartsian coordination. x and velocity use standard unit.
do ii = 1, 3
x(ii, :) = dyn%posion(ii, :) * latt_cur%a(ii, ii) * Ang
end do
! there isn't anything in dyn%pomass. so must use t_info%pomass
ni=1
do nt=1,t_info%ntyp
do ni=ni,t_info%nityp(nt)+ni-1
C_force(:, ni) = tifor(:, ni)/t_info%pomass(nt)
total_mass = total_mass + t_info%pomass(nt)
enddo
enddo
C_force = C_force * (eV/Ang/amu)
total_mass = total_mass * amu
if (step .eq. 1) then
! read these tags from INCAR
call process_incar(io%lopen, io%iu0, io%iu5, 'qmass', qmass, ierr, .true.)
call process_incar(io%lopen, io%iu0, io%iu5, 'tscale', tscale, ierr, .true.)
call process_incar(io%lopen, io%iu0, io%iu5, 'shock_direction', sd, ierr, .true.)
call process_incar(io%lopen, io%iu0, io%iu5, 'shock_velocity', vs, ierr, .true.)
! use tscale to give a initial cell velocity, or the cell will stay still forever
do ii = 1, 3
velocity_now(ii, :) = dyn%vel(ii, :) * latt_cur%a(ii, ii) * (Ang/fs) / dyn%potim
end do
CALL EKINC(EKIN,T_INFO%NIONS,T_INFO%NTYP,T_INFO%ITYP,T_INFO%POMASS,DYN%POTIM,LATT_CUR%A,DYN%VEL)
temperature = 2 * ekin * eV / (kB * t_info%nions * 3 )
fac1 = tscale*total_mass/qmass*temperature
omega(sd) = -sqrt(fac1)
sqrt_initial_temperature_scaling = sqrt(1.0-tscale)
velocity_now = velocity_now * sqrt_initial_temperature_scaling
else
! =======================================================================
! 2nd half of Verlet update. this part get current velocity from t-dt/2.
! =======================================================================
! propagate particle velocities 1/2 step, it should not be done on the first step of MD.
do ii = 1, 3
velocity_before_half_dt(ii, :) = dyn%vel(ii, :) * latt_cur%a(ii, ii) * (Ang/fs) / dyn%potim
end do
velocity_now = velocity_before_half_dt + C_force*dthalf
end if
! compute new pressure and volume and temperature
call compute_kinetic_stress(t_info, latt_cur, dyn, kinetic_stress, tsif, -1)
total_stress = tsif + kinetic_stress
total_stress = total_stress * kBar
vol = latt_cur%a(1, 1) * latt_cur%a(2, 2) * latt_cur%a(3, 3) * (Ang**3)
if (step .eq. 1) then
p0 = total_stress
vol0 = vol
end if
p_msst = vs**2 * total_mass * (vol0 - vol)/vol0**2
A = total_mass * (total_stress(sd, sd) - p0(sd, sd) - p_msst) / qmass
! qmass is in mass(kg)**2 / length(m)**4
if (step .ne. 1) then
! propagate the time derivative of the volume 1/2 step at fixed V, r, rdot
! it should not be done on the first step of MD.
omega(sd) = omega(sd) + A*dthalf ! this is the current omega
end if
! =======================================================================
! 1st half of Verlet update
! in VASP, the 1st half of Verlet update cannot be performed before
! compute force and stress. So it must be placed here.
! =======================================================================
! propagate the time derivative of the volume 1/2 step at fixed vol, r, rdot
omega(sd) = omega(sd) + A*dthalf ! this is omega(t+dt/2)
! propagate velocities 1/2 step
velocity_after_half_dt = velocity_now + C_force*dthalf
! now, we need to compute the vol and pos for next step:
! propagate the volume 1/2 step
vol1 = vol + omega(sd)*dthalf
! rescale positions and change box size
dilation(sd) = vol1/vol
call remap(latt_cur, sd, x, velocity_after_half_dt, dilation,t_info)
! propagate particle positions 1 time step
x = x + dt * velocity_after_half_dt
! propagate the volume 1/2 step
vol2 = vol1 + omega(sd)*dthalf
! rescale positions and change box size
dilation(sd) = vol2/vol1
call remap(latt_cur, sd, x, velocity_after_half_dt, dilation,t_info)
do ii = 1, 3
dyn%posion(ii, :) = x(ii, :) / latt_cur%a(ii, ii) / Ang
dyn%vel(ii, :) = velocity_after_half_dt(ii, :) / latt_cur%a(ii, ii) / (Ang/fs) * dyn%potim
end do
t_info%posion = dyn%posion
CALL EKINC(EKIN,T_INFO%NIONS,T_INFO%NTYP,T_INFO%ITYP,T_INFO%POMASS,DYN%POTIM,LATT_CUR%A,DYN%VEL)
temperature = 2 * ekin * eV / (kB * t_info%nions * 3 )
! this block for debug. write the information to a file
if (.true.) then
open(unit=114514, position="append", file="msst_info.txt")
write(114514, 100) "step =", step
write(114514, 200) "A =", A
write(114514, 200) "omega =", omega(sd)
write(114514, 300) "dilation =", dilation(sd)
write(114514, 200) "p_msst =", p_msst / (kBar * 10)
write(114514, 300) "vol =", vol / Ang**3
write(114514, 300) "temp =", temperature
write(114514, 400) "+++++++++++++++++++++++++++"
100 format(A10, i8)
200 format(A10, e12.4)
300 format(A10, f12.4)
400 format(A)
close(114514)
end if
end subroutine msst_step
! change the shape of cell, along with ion pos and vel.
subroutine remap(latt_cur, sd, x, v, dilation,t_info)
integer, intent(in):: sd
type(type_info), intent(in) :: t_info
real(q), dimension(3), intent(in) :: dilation
real(q), dimension(3, t_info%nions), intent(in out) :: x, v
type(latt), intent(in out) :: latt_cur
latt_cur%a(sd, sd) = dilation(sd) * latt_cur%a(sd, sd)
x(sd, :) = dilation(sd) * x(sd, :)
v(sd, :) = dilation(sd) * v(sd, :)
end subroutine remap
end module msst

fortran : invalid memory reference

I encountered this error while solving the diffusion equation on fortran using alternating directional implicit(ADI) method.
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0xffffffff
#1 0xffffffff
#2 0xffffffff
#3 0xffffffff
#4 0xffffffff
#5 0xffffffff
#6 0xffffffff
#7 0xffffffff
#8 0xffffffff
#9 0xffffffff
#10 0xffffffff
#11 0xffffffff
#12 0xffffffff
#13 0xffffffff
#14 0xffffffff
And here is my code
program HW1_1_ADI
implicit none
real :: delx, dely, delt, dx, dy
real, parameter :: a=0.7, m=0.1, eta=0.001, pi=3.141592
real, dimension(401,101,50) :: psi
real, dimension(201,101,50) :: psi2, psi_half
real , dimension(401) :: x
real, dimension(400) :: a_D, b_D, C_D, v_D, o_D
real, dimension(100) :: a_D2, b_D2, C_D2, v_D2, o_D2
integer :: i, j, n, imax, jmax, nmax, ihalf
open(1,file='HW1.txt')
2 format (101((400(e10.3,','), e10.3), /))
imax = 401
jmax = 101
nmax = 50
ihalf = (imax+1)/2
delx = 2.0/(imax-1)
dely = 1.0/(jmax-1)
delt = 0.2 * 10**3
dx = eta * delt / delx**2
dy = eta * delt / dely**2
! x-coordinate
do i = 1, imax
x(i) = -1.0 + (i-1)*delx
end do
! initial condition
do i = 1, imax
do j = 1, jmax
psi(i,j,1) = cos(m*pi*x(i))-a*cos(3.0*m*pi*x(i))
end do
end do
do i = 1, ihalf
do j = 1, jmax
psi2(i,j,1) = cos(m*pi*x(i))-a*cos(3.0*m*pi*x(i))
end do
end do
! ADI
do n = 1, nmax-1
do j=2, jmax
do i = 2, ihalf
b_D(i-1) = 1.0 + dx
a_D(i-1) = -0.5*dx
c_D(i-1) = -0.5*dx
if (i == ihalf) then
a_D(i-1) = -dx
end if
if (j==jmax) then
if (i==2) then
v_D(i-1) = dy*psi2(i,jmax-1,n) + (1.0-dy)*psi2(i,jmax,n) + 0.5*dx*psi2(1,jmax,n)
else
v_D(i-1) = dy*psi2(i,jmax-1,n) + (1.0-dy)*psi2(i,jmax,n)
end if
else
if (i==2) then
v_D(i-1) = 0.5*dy*psi2(2,j-1,n) + (1.0-dy)*psi2(2,j,n) + 0.5*dy*psi2(2,j+1,n)&
+0.5*dx*psi2(1,j,n)
else
v_D(i-1) = 0.5*dy*psi2(i,j-1,n) + (1.0-dy)*psi2(i,j,n) + 0.5*dy*psi2(i,j+1,n)
end if
end if
end do
call tridag(a_D,b_D,c_D,v_D,o_D,ihalf-1)
do i = 1, ihalf-1
psi_half(i+1,j,n) = o_D(i)
end do
end do
! boundary condition
! y=0
do i = 1, ihalf
psi_half(i,1,:) = cos(m*pi*x(i))-a*cos(3.0*m*pi*x(i))
end do
! x=-1
do j = 1, jmax
psi_half(1,j,:) = cos(m*pi) - a*cos(3.0*m*pi)
end do
do i = 2, ihalf
do j = 2, jmax
b_D2(j-1) = 1.0 + dy
a_D2(j-1) = -0.5*dy
c_D2(j-1) = -0.5*dy
if (j == jmax) then
a_D2(j-1) = -dy
end if
if (i==ihalf) then
if (j==2) then
v_D2(j-1) = dx*psi_half(ihalf-1,j,n) + (1.0-dx)*psi_half(ihalf,j,n) + 0.5*dy*psi_half(ihalf,1,n)
else
v_D2(j-1) = dx*psi_half(ihalf-1,j,n) + (1.0-dx)*psi_half(ihalf,j,n)
end if
else
if (j==2) then
v_D2(j-1) = 0.5*dx*psi_half(i-1,j,n) + (1.0-dx)*psi_half(i,j,n) + 0.5*dx*psi_half(i+1,j,n)&
+0.5*dy*psi_half(i,1,n)
else
v_D2(j-1) = 0.5*dx*psi_half(i-1,j,n) + (1.0-dx)*psi_half(i,j,n) + 0.5*dx*psi_half(i+1,j,n)
end if
end if
end do
call tridag(a_D2,b_D2,c_D2,v_D2,o_D2,jmax-1)
do j = 1, jmax-1
psi2(i,j+1,n+1) = o_D2(j)
end do
end do
! boundary condition
! y=0
do i = 1, ihalf
psi2(i,1,n+1) = cos(m*pi*x(i))-a*cos(3.0*m*pi*x(i))
end do
! x=-1
do j = 1, jmax
psi2(1,j,n+1) = cos(m*pi) - a*cos(3.0*m*pi)
end do
! reflection condition
do i = 1, ihalf
do j = 1, jmax
psi(i,j,n+1) = psi2(i,j,n+1)
end do
end do
end do
do i = ihalf+1, imax
do j = 1, jmax
psi(i,j,:) = psi(imax+1-i,j,:)
end do
end do
write(1,2) psi(:,:,2)
contains
subroutine tridag(a,b,c,r,u,n)
implicit none
integer n, nMAX
real a(n), b(n), c(n), r(n), u(n)
parameter (nMAX = 100)
integer j
real bet, gam(nMAX)
if (b(1) == 0.0) print *, 'tridag: rewrite equations'
bet = b(1)
u(1) = r(1)/bet
do j = 2, n
gam(j) = c(j-1)/bet
bet = b(j) - a(j)*gam(j)
if (bet == 0.0) print *, 'tridag failed'
u(j) = (r(j)-a(j)*u(j-1)) / bet
end do
do j = n-1, 1, -1
u(j) = u(j) - gam(j+1)*u(j+1)
end do
return
end subroutine
end program
What I'm curious about is that it's good at first.
At first, I set it up imax=200(maximum index of x-coordinate).
Here is original code.
program HW1_1_ADI
implicit none
real :: delx, dely, delt, dx, dy
real, parameter :: a=0.7, m=0.1, eta=0.001, pi=3.141592
real, dimension(201,101,50) :: psi
real, dimension(101,101,50) :: psi2, psi_half
real , dimension(201) :: x
real, dimension(100) :: a_D, b_D, C_D, v_D, o_D
real, dimension(100) :: a_D2, b_D2, C_D2, v_D2, o_D2
integer :: i, j, n, imax, jmax, nmax, ihalf
open(1,file='HW1.txt')
2 format (101((200(e10.3,','), e10.3), /))
imax = 201
jmax = 101
nmax = 50
ihalf = (imax+1)/2
delx = 2.0/(imax-1)
dely = 1.0/(jmax-1)
delt = 0.2 * 10**3
dx = eta * delt / delx**2
dy = eta * delt / dely**2
! x-coordinate
do i = 1, imax
x(i) = -1.0 + (i-1)*delx
end do
! initial condition
do i = 1, imax
do j = 1, jmax
psi(i,j,1) = cos(m*pi*x(i))-a*cos(3.0*m*pi*x(i))
end do
end do
do i = 1, ihalf
do j = 1, jmax
psi2(i,j,1) = cos(m*pi*x(i))-a*cos(3.0*m*pi*x(i))
end do
end do
! ADI
do n = 1, nmax-1
do j=2, jmax
do i = 2, ihalf
b_D(i-1) = 1.0 + dx
a_D(i-1) = -0.5*dx
c_D(i-1) = -0.5*dx
if (i == ihalf) then
a_D(i-1) = -dx
end if
if (j==jmax) then
if (i==2) then
v_D(i-1) = dy*psi2(i,jmax-1,n) + (1.0-dy)*psi2(i,jmax,n) + 0.5*dx*psi2(1,jmax,n)
else
v_D(i-1) = dy*psi2(i,jmax-1,n) + (1.0-dy)*psi2(i,jmax,n)
end if
else
if (i==2) then
v_D(i-1) = 0.5*dy*psi2(2,j-1,n) + (1.0-dy)*psi2(2,j,n) + 0.5*dy*psi2(2,j+1,n)&
+0.5*dx*psi2(1,j,n)
else
v_D(i-1) = 0.5*dy*psi2(i,j-1,n) + (1.0-dy)*psi2(i,j,n) + 0.5*dy*psi2(i,j+1,n)
end if
end if
end do
call tridag(a_D,b_D,c_D,v_D,o_D,ihalf-1)
do i = 1, ihalf-1
psi_half(i+1,j,n) = o_D(i)
end do
end do
! boundary condition
! y=0
do i = 1, ihalf
psi_half(i,1,:) = cos(m*pi*x(i))-a*cos(3.0*m*pi*x(i))
end do
! x=-1
do j = 1, jmax
psi_half(1,j,:) = cos(m*pi) - a*cos(3.0*m*pi)
end do
do i = 2, ihalf
do j = 2, jmax
b_D2(j-1) = 1.0 + dy
a_D2(j-1) = -0.5*dy
c_D2(j-1) = -0.5*dy
if (j == jmax) then
a_D2(j-1) = -dy
end if
if (i==ihalf) then
if (j==2) then
v_D2(j-1) = dx*psi_half(ihalf-1,j,n) + (1.0-dx)*psi_half(ihalf,j,n) + 0.5*dy*psi_half(ihalf,1,n)
else
v_D2(j-1) = dx*psi_half(ihalf-1,j,n) + (1.0-dx)*psi_half(ihalf,j,n)
end if
else
if (j==2) then
v_D2(j-1) = 0.5*dx*psi_half(i-1,j,n) + (1.0-dx)*psi_half(i,j,n) + 0.5*dx*psi_half(i+1,j,n)&
+0.5*dy*psi_half(i,1,n)
else
v_D2(j-1) = 0.5*dx*psi_half(i-1,j,n) + (1.0-dx)*psi_half(i,j,n) + 0.5*dx*psi_half(i+1,j,n)
end if
end if
end do
call tridag(a_D2,b_D2,c_D2,v_D2,o_D2,jmax-1)
do j = 1, jmax-1
psi2(i,j+1,n+1) = o_D2(j)
end do
end do
! boundary condition
! y=0
do i = 1, ihalf
psi2(i,1,n+1) = cos(m*pi*x(i))-a*cos(3.0*m*pi*x(i))
end do
! x=-1
do j = 1, jmax
psi2(1,j,n+1) = cos(m*pi) - a*cos(3.0*m*pi)
end do
! reflection condition
do i = 1, ihalf
do j = 1, jmax
psi(i,j,n+1) = psi2(i,j,n+1)
end do
end do
end do
do i = ihalf+1, imax
do j = 1, jmax
psi(i,j,:) = psi(imax+1-i,j,:)
end do
end do
write(1,2) psi(:,:,2)
contains
subroutine tridag(a,b,c,r,u,n)
implicit none
integer n, nMAX
real a(n), b(n), c(n), r(n), u(n)
parameter (nMAX = 100)
integer j
real bet, gam(nMAX)
if (b(1) == 0.0) print *, 'tridag: rewrite equations'
bet = b(1)
u(1) = r(1)/bet
do j = 2, n
gam(j) = c(j-1)/bet
bet = b(j) - a(j)*gam(j)
if (bet == 0.0) print *, 'tridag failed'
u(j) = (r(j)-a(j)*u(j-1)) / bet
end do
do j = n-1, 1, -1
u(j) = u(j) - gam(j+1)*u(j+1)
end do
return
end subroutine
end program
This works well.
What's wrong in my code?
I suggest you learn how to use your compiler to help you diagnose these problems - when developing always turn on run time error checks. Here is what gfortran can tell you, note the -fcheck=all and -g flags, though I would recommend all the ones I use:
ijb#ijb-Latitude-5410:~/work/stack$ gfortran --version
GNU Fortran (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
ijb#ijb-Latitude-5410:~/work/stack$ gfortran -Wall -Wextra -fcheck=all -O -g -std=f2008 imax.f90
imax.f90:160:12:
160 | if (b(1) == 0.0) print *, 'tridag: rewrite equations'
| 1
Warning: Equality comparison for REAL(4) at (1) [-Wcompare-reals]
imax.f90:168:16:
168 | if (bet == 0.0) print *, 'tridag failed'
| 1
Warning: Equality comparison for REAL(4) at (1) [-Wcompare-reals]
ijb#ijb-Latitude-5410:~/work/stack$ ./a.out
At line 166 of file imax.f90
Fortran runtime error: Index '101' of dimension 1 of array 'gam' above upper bound of 100
Error termination. Backtrace:
#0 0x7f998e9abd01 in ???
#1 0x7f998e9ac849 in ???
#2 0x7f998e9acec6 in ???
#3 0x5562d1681337 in tridag
at /home/ijb/work/stack/imax.f90:166
#4 0x5562d1681971 in hw1_1_adi
at /home/ijb/work/stack/imax.f90:72
#5 0x5562d1681f56 in main
at /home/ijb/work/stack/imax.f90:149
From this it looks like you haven't adjusted the nMax parameter in tridag correctly - I suggest you also learn about allocatable arrays and how you can avoid this problem in a way which means you don't have to change your code for every different size you try.

cgeev sovle Non Hermitain matrix is incorrect

Recently I want to reproduce the Fig.1(a) of Edge States and Topological Invariants of Non-Hermitian Systems.I used cgeev to solve eigenvalue of non-Hermitian Hamiltonian matrices,I found the solution become wired.
Here is my Fortran code,the result to Fig1.(a) correspond the abs.dat.
module pub
implicit none
complex,parameter::im = (0.0,1.0)
real,parameter::pi = 3.1415926535
integer xn,N,en,kn
parameter(xn = 100,N = xn*2,en = 100)
complex Ham(N,N)
real t1,t2,t3,gam
!-----------------
integer::lda = N
integer,parameter::lwmax=2*N + N**2
complex,allocatable::w(:) ! store eigenvalues
complex,allocatable::work(:)
real,allocatable::rwork(:)
integer lwork
integer info
integer LDVL, LDVR
parameter(LDVL = N, LDVR = N )
complex VL( LDVL, N ), VR( LDVR, N )
end module pub
!=====================================================
program sol
use pub
! Physics memory allocate
allocate(w(N))
allocate(work(lwmax))
allocate(rwork(2*N))
!-----------------
t2 = 1.0
t3 = 0.0
gam = 3.0/4.0
call band()
end program sol
!======================================================
subroutine band()
use pub
integer m1,i
open(11,file="real.dat")
open(12,file="imag.dat")
open(13,file="abs.dat")
do m1 = -en,en
t1 = 3.0*m1/en
call matset()
call eigsol()
write(11,999)t1,(real(w(i)),i = 1,N)
write(12,999)t1,(aimag(w(i)),i = 1,N)
write(13,999)t1,(abs(w(i)),i = 1,N)
end do
close(11)
close(12)
close(13)
999 format(201f11.6)
end subroutine band
!======================================================
subroutine matset()
use pub
real kx
complex sx(2,2),sy(2,2),sz(2,2)
integer k,m1,m2
sx(1,2) = 1.0
sx(2,1) = 1.0
sy(1,2) = -im
sy(2,1) = im
sz(1,1) = 1.0
sz(2,2) = -1.0
!--------
Ham = 0.0
do k = 0,xn-1
if(k == 0)then
do m1 = 1,2
do m2 = 1,2
ham(m1,m2) = t1*sx(m1,m2) + im*gam/2.0*sy(m1,m2)
ham(m1,m2 + 2) = (t2 + t3)/2.0*sx(m1,m2) - im*(t2 - t3)/2.0*sy(m1,m2)
end do
end do
elseif(k == xn-1)then
do m1 = 1,2
do m2 = 1,2
ham(k*2 + m1,k*2 + m2) = t1*sx(m1,m2) + im*gam/2.0*sy(m1,m2)
ham(k*2 + m1,k*2 + m2 - 2) = (t2 + t3)/2.0*sx(m1,m2) + im*(t2 - t3)/2.0*sy(m1,m2)
end do
end do
else
do m1 = 1,2
do m2 = 1,2
ham(k*2 + m1,k*2 + m2) = t1*sx(m1,m2) + im*gam/2.0*sy(m1,m2)
! right hopping
ham(k*2 + m1,k*2 + m2 + 2) = (t2 + t3)/2.0*sx(m1,m2) - im*(t2 - t3)/2.0*sy(m1,m2)
! left hopping
ham(k*2 + m1,k*2 + m2 - 2) = (t2 + t3)/2.0*sx(m1,m2) + im*(t2 - t3)/2.0*sy(m1,m2)
end do
end do
end if
end do
return
end subroutine matset
!==============================================================================
subroutine eigsol()
use pub
! Query the optimal workspace.
LWORK = -1
CALL cgeev( 'Vectors', 'Vectors', N, Ham, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
LWORK = MIN( LWMAX, INT( WORK( 1 ) ) )
! Solve eigenproblem.
CALL cgeev( 'Vectors', 'Vectors', N, Ham, LDA, W, VL, LDVL,VR, LDVR, WORK, LWORK, RWORK, INFO)
! Check for convergence.
IF( INFO.GT.0 ) THEN
WRITE(*,*)'The algorithm failed to compute eigenvalues.'
STOP
END IF
! open(120,file="eigval.dat")
! do m = 1,N
! write(120,*)m,w(m)
! end do
! close(120)
return
end subroutine eigsol
If I used wrong function from Lapack or my code isn't correct.
I use intel fortran,complie command is
*ifort -mkl file.f90 -o a.out
Run program ./a.out&*

how to do an iterative process for a fortran subroutine

I have a fortran code that computes the solution vector using the thomas algorithm subroutine.
I want the solution vector to run in a loop for a certain number of time.
How do i call this subroutine in the loop?
my subroutine is the thomas algorithm subroutine.
It returns the solution vector u but I want it to use the vectors NN times in a loop. So the old u becomes the new u to use in the subroutine.
How do I do this?
Below is the what i tried
program thomasalg2
implicit double precision(A-H,O-Z)
real*8, dimension(9,1) :: a,b,c,r,u,uold!the dimension is subject to change depending on the size of the new matrix
!real*8, dimension(9,50) :: W
real*8 :: pi
real*8 :: h,k,lm,l,T
integer :: i,j,al,NN,n
l = 1!right endpoint on the X-axis
n = 9 !number of rols/cols of the coefficient matrix with boundaries included
T = 0.5 !maximum number of the time variable
NN = 50!number of time steps
np = n
h = l/n
k = T/NN
al = 1.0D0 !alpha
pi = dacos(-1.0D0)
lm = (al**2)*(k/(h**2)) !lambda
do i = 1,n
r(i,1) = sin(pi*i*h) !this is W_0
end do
a(1,1) = 0.0D0
do i = 2,n
a(i,1) = -lm
end do
do i = 1,n
b(i,1) = 1 + (2*lm)
end do
c(9,1) = 0.0D0
do i = 1,n-1
c(i,1) = -lm
end do
!the 3 diagonals are stored in the 1st, 2nd, 3rd & 4th files respectively.
open(10, file = 'thom1.txt')
open(11, file = 'thom2.txt')
open(12, file = 'thom3.txt')
open(13, file = 'thom4.txt')
write(10,*)
do i = 1,n
write(10,*) a(i,1)
end do
write(11,*)
do i = 1,n
write(11,*) b(i,1)
end do
write(12,*)
do i = 1,n
write(12,*) c(i,1)
end do
write(13,*)
do i = 1,n
write(13,*) r(i,1)
end do
open(14, file = 'tridag2.txt')
write(14,*)
n = 9
do i = 1,n
write(14,*) a(i,1),b(i,1),c(i,1),r(i,1) !write the given vectors in the file in the form of a column vector
end do
call tridag(a,b,c,r,u,n)
!solve the given system and return the solution vector u
do i = 1,NN
call tridag(a,b,c,r,u,n)
!write(15,*) u
r = u
end do
open(15, file = 'tridag2u.txt')
write(15,*)
!write the solution vector in the form of a column vector
do i = 1,n
write(15,*) u(i,1)
end do
!print *, "Your data has been written in 'tridag2.txt'"
end program thomasalg2
subroutine tridag(a,b,c,r,u,n)
implicit double precision (A-H, O-Z)
integer n, NMAX
real*8 a(n), b(n), c(n), r(n), u(n)
parameter (NMAX = 500)
integer j
real*8 bet, gam(NMAX)
if(b(1).eq.0.) stop "tridag: rewrite equations"
bet = b(1)
u(1)=r(1)/bet
do j = 2,n
gam(j) = c(j-1)/bet
bet = b(j)-a(j)*gam(j)
if (bet.eq.0.) stop "tridag failed"
u(j) = (r(j)-a(j)*u(j-1))/bet
end do
do j = n-1,1,-1
u(j) = u(j)-gam(j+1)*u(j+1)
end do
!print *, "The solution is", u
return
end subroutine

How take more than one input and run the program for each one

The following is a program for self avoiding random walk. The program works fine but I need to make a minor modification but I do not know how.
Currently the program receives n and ns as inputs and then calculates a distance (dis). I want the program to receive more than one n and calculate the distance for each n.
Example of current output
n = 100 ns = 100 dis = 10.8
I want the program to output
n = 100 ns = 100 dis = 10.8
n = 200 ns = 100 dis = 11.6
and go on for all input vales of n.
This can be done by running the program every time with different n but I need to do it with one run.
PROGRAM Two_dimensional_Self_Avoiding__Random_Walks
implicit none
integer, dimension(:,:), allocatable :: lattice
integer :: i,x,y,xt,yt,id,step,xx, ns,n
real :: r,dis,dis2,square,d,d2
Logical :: terminate,newsite
print*, ' Enter ns and n '
read(*,*) ns,n
allocate(lattice(-n:n,-n:n))
CALL RANDOM_SEED()
dis = 0.0; dis2 = 0.0 ! intial values for end to end distance
CALL walks() ! self avoiding walks
dis = dis/float(ns); dis2 = dis2/float(ns)
print*,ns,n,dis,dis2
CONTAINS
SUBROUTINE walks
DO i = 1,ns
lattice = 0; x = 0; y = 0
step = 0; terminate = .FALSE.
!do ii = 1, n
DO WHILE ((.NOT. terminate) .AND. (step <= n))
xt = x; yt = y
xx = lattice(x+1,y)+lattice(x-1,y) &
+lattice(x,y+1)+lattice(x,y-1)
IF (xx == 4) THEN
terminate = .TRUE.
ELSE
newsite = .FALSE.
DO WHILE (.NOT. newsite)
CALL RANDOM_NUMBER(r)
id = INT(r*4.0)
IF (id == 0) THEN
x = xt + 1; y = yt
ELSEIF (id == 1) THEN
x = xt - 1; y = yt
ELSEIF (id == 2) THEN
x = xt; y = yt + 1
ELSEIF (id == 3) THEN
x = xt; y = yt - 1
ENDIF
IF (lattice(x,y) == 0) newsite = .TRUE.
ENDDO
step = step + 1; lattice(x,y) = 1
ENDIF
write(10,*),step
!print*, x,y
write(7,*) x,y
ENDDO
square = float(x**2+y**2)
dis = dis + sqrt(square); dis2 = dis2 + square
d = dis/ns; d2=dis2/ns
write(8,*) step, d, d2
!enddo
ENDDO
END SUBROUTINE walks
END PROGRAM Two_dimensional_Self_Avoiding__Random_Walks