fortran : invalid memory reference - fortran

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.

Related

Does write statement in Fortran90 affect resulting variable?

I know write statement is just to print the variable. But I have found something in my code.
For example, there are two variables called 'T_avg' and 'T_favg.'
I wanted to print T_favg, I used the line below.
write(*,*) T_favg
result: 100
And then I also wanted to see T_avg, I added variable.
write(*,*) T_avg, T_favg
result: 50, 200
I did not modify the code at all except that line, but the result of T_favg is different.
I used this command line.
ifort.exe /O2 scale_analysis(07022020).f90 -o test.exe
Is there any circumstance occurring it?
**Sorry, I added my code.
PROGRAM scale_analysis
USE, INTRINSIC :: iso_fortran_env, ONLY: real32, real64, FILE_STORAGE_SIZE
IMPLICIT NONE
! DECLARE PARAMETERS
INTEGER, PARAMETER :: SP = real32 ! SINGLE-PRECISION REAL
INTEGER, PARAMETER :: DP = real64 ! DOUBLE-PRECISION REAL
INTEGER, PARAMETER :: nx = 1024 ! TOTAL NUMBER OF GRID POINTS
INTEGER, PARAMETER :: iskip = 2
! DECLARE ALLOCATABLE ARRAYS
REAL(SP), ALLOCATABLE, DIMENSION(:,:,:) :: STMP, T, RHO
! DECLARE VARIABLES FOR SUMMATION
REAL(SP) :: rho_sum, rhoT_sum, T_sum
! DECLARE VARIABLES FOR REYNOLDS-AVERAGING
REAL(SP) :: rho_avg, rhoT_avg, T_avg
! DECLARE VARIABLES FOR FAVRE-AVERAGING
REAL(SP) :: T_favg
INTEGER :: i, j, k
CHARACTER(LEN=100) :: outfile, varname, infile4, infile5
CHARACTER(LEN=100) :: filename
!--------------------------------------------------------------------------
! DEMONSTRATE READ_DATA
!--------------------------------------------------------------------------
ALLOCATE(T(nx/iskip, nx/iskip, nx/iskip))
ALLOCATE(RHO(nx/iskip, nx/iskip, nx/iskip))
ALLOCATE(STMP(nx, nx, nx))
STMP = 0.0_SP
!--------------------------------------------------------------------------
! INITIALIZATION OF SUMMATION VARIABLES
!--------------------------------------------------------------------------
rho_sum = 0.0; rhoT_sum = 0.0;
T_sum = 0.0;
T_avg = 0.0; T_favg = 0.0;
!--------------------------------------------------------------------------
! DATA IMPORT -START
!--------------------------------------------------------------------------
varname = 'Z1_dil_inertHIT'
outfile = 'terms_in_Kolla(Z1_inertHIT).txt'
infile4 = 'E:\AUTOIGNITION\Z1\Temperature_inertHIT.bin'
infile5 = 'E:\AUTOIGNITION\Z1\Density_inertHIT.bin'
OPEN(44, file=TRIM(ADJUSTL(infile4)), status='old', access='stream', &
form='unformatted')
READ(44) stmp
CLOSE(44)
DO k = 1, nx/iskip
DO j = 1, nx/iskip
DO i = 1, nx/iskip
T(i,j,k) = stmp(1+iskip*(i-1), 1+iskip*(j-1), 1+iskip*(k-1))
END DO
END DO
END DO
WRITE(*, '(A)') 'Data4 is successfully read ... '
OPEN(55, file=TRIM(ADJUSTL(infile5)), status='old', access='stream', &
form='unformatted')
READ(55) stmp
CLOSE(55)
DO k = 1, nx/iskip
DO j = 1, nx/iskip
DO i = 1, nx/iskip
RHO(i,j,k) = stmp(1+iskip*(i-1), 1+iskip*(j-1), 1+iskip*(k-1))
END DO
END DO
END DO
WRITE(*, '(A)') 'Data5 is successfully read ... '
DEALLOCATE(stmp)
!--------------------------------------------------------------------------
! COMPUTE U_RMS
!--------------------------------------------------------------------------
DO k = 1, nx/iskip
DO j = 1, nx/iskip
DO i = 1, nx/iskip
rho_sum = rho_sum + RHO(i,j,k)
END DO
END DO
END DO
rho_avg = rho_sum / REAL((nx/iskip)**3)
!--------------------------------------------------------------------------
! COMPUTE TEMPERATRUE TAYLOR LENGTH SCALE(LAMBDA_T)
! C.TOWERY, DETONATION INITIATION BY COMPRESSIBLE TURBULENCE THERMODYNAMIC
! FLUCTUATIONS, CNF, 2019
!--------------------------------------------------------------------------
DO k = 1, nx/iskip
DO j = 1, nx/iskip
DO i = 1, nx/iskip
T_sum = T_sum + T(i,j,k)
rhoT_sum = rhoT_sum + ( RHO(i,j,k)*T(i,j,k) )
END DO
END DO
END DO
T_avg = T_sum / REAL((nx/iskip)**3)
rhoT_avg = rhoT_sum / REAL((nx/iskip)**3)
T_favg = rhoT_avg / rho_avg
DO k = 1, nx/iskip
DO j = 1, nx/iskip
DO i = 1, nx/iskip
rhoT_p_sum = rhoT_p_sum + RHO(i,j,k)*( (T(i,j,k) - T_favg)**2 )
END DO
END DO
END DO
rhoT_p_avg = rhoT_p_sum / REAL((nx/iskip)**3)
T_p = SQRT( rhoT_p_avg / rho_avg )
write(*,*) T_favg
write(*,*) T_avg,T_favg
END PROGRAM scale_analysis
The problematic part is write statement. If I erase T_avg from the second write statement line, then T_favg changes.

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&*

Fortran program does not converge without subroutine

I'm using a Fortran 90 script below to solve a partial differential equation using iterative method, but I have one issue about the structure of the program. If I use a subroutine called by the program the solution converge properly, but if I just put the calculations inside of the iterations the solution does not converge.
Here is the program that does not work:
...
DO IT = 2,ITMAX
DO I = 1,IMAX
PHIN(IT-1,I,1) = PHIN(IT-1,I,2) - (Y(2) - Y(1))*UINF*PHIY(I)
END DO
PHIN(IT,I,1) = PHIN(IT-1,I,1)
DO J = 2,JMAX-1
DO I = 2,IMAX-1
LPHI(I,J) = AX(I)*PHIN(IT-1,I-1,J) - &
BX(I)*PHIN(IT-1,I,J) + &
CX(I)*PHIN(IT-1,I+1,J) + &
AY(J)*PHIN(IT-1,I,J-1) - &
BY(J)*PHIN(IT-1,I,J) + &
CY(J)*PHIN(IT-1,I,J+1)
ENDDO
ENDDO
!
! SELECT CASE(SOL)
! CASE(1)
! CALL NPJ()
! CASE(2)
! CALL NPGS()
! CASE(3)
! CALL NSOR()
! END SELECT
DO J = 2,JMAX-1
DO I = 2,IMAX-1
C(I,J) = 1/(2*(DELTAX(I)**2 + DELTAY(J)**2))* &
(((DELTAX(I)*DELTAY(J))**2)*LPHI(I,J) + &
(PHIN(IT,I-1,J) - PHIN(IT-1,I-1,J))*DELTAY(J) + &
(PHIN(IT,I,J-1) - PHIN(IT-1,I,J-1))*DELTAX(I))
END DO
END DO
PHIN(IT,:,:) = PHIN(IT-1,:,:) + C(:,:)
RESI(IT) = MAXVAL(ABS(LPHI(:,:)))
IF (RESI(IT)<EPS) THEN
ITVALUE = IT
EXIT
ENDIF
LPHI(:,:) = 0
WRITE(*,*) IT,RESI(IT)
ENDDO
...
and the solution that works fine,
...
DO IT = 2,ITMAX
DO I = 1,IMAX
PHIN(IT-1,I,1) = PHIN(IT-1,I,2) - (Y(2) - Y(1))*UINF*PHIY(I)
END DO
PHIN(IT,I,1) = PHIN(IT-1,I,1)
DO J = 2,JMAX-1
DO I = 2,IMAX-1
LPHI(I,J) = AX(I)*PHIN(IT-1,I-1,J) - &
BX(I)*PHIN(IT-1,I,J) + &
CX(I)*PHIN(IT-1,I+1,J) + &
AY(J)*PHIN(IT-1,I,J-1) - &
BY(J)*PHIN(IT-1,I,J) + &
CY(J)*PHIN(IT-1,I,J+1)
ENDDO
ENDDO
SELECT CASE(SOL)
CASE(1)
CALL NPJ()
CASE(2)
CALL NPGS()
CASE(3)
CALL NSOR()
END SELECT
PHIN(IT,:,:) = PHIN(IT-1,:,:) + C(:,:)
RESI(IT) = MAXVAL(ABS(LPHI(:,:)))
IF (RESI(IT)<EPS) THEN
ITVALUE = IT
EXIT
ENDIF
LPHI(:,:) = 0
WRITE(*,*) IT,RESI(IT)
ENDDO
...
subroutIne NPGS()
use var_mesh
use var_solve
C(:,:) = 0
DO J = 2,JMAX-1
DO I = 2,IMAX-1
C(I,J) = 1/(2*(DELTAX(I)**2 + DELTAY(J)**2))* &
(((DELTAX(I)*DELTAY(J))**2)*LPHI(I,J) + &
(PHIN(IT,I-1,J) - PHIN(IT-1,I-1,J))*DELTAY(J) + &
(PHIN(IT,I,J-1) - PHIN(IT-1,I,J-1))*DELTAX(I))
END DO
END DO
RETURN
END SUBROUTINE NPGS
Can someone explain what is the main difference and why both programs are different?
Assigning C = 0 helps the script in the convergence, but I found what was the error, I assign just one part of the boundary condition in the program in this line:
PHIN(IT,I,1) = PHIN(IT-1,I,1)
but the correct way is to the entirely matrix and:
PHIN(IT,:,:) = PHIN(IT-1,:,:)

Increase Steps in 2D Self Avoiding Random Walk

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

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