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