Welcome to our forums
When running my program I got the following error:
Error 11, Array subscript(s) out-of-bounds
RANK - in file freeformat2.f95 at line 48 [+014a]
TEST - in file freeformat2.f95 at line 36 [+0d99]
But in line 36 and 48, I didn't find any question there. Does anyone have any ideas what the problem is please?[/b]
If the program is short then you could post it here so that we can see the lines of code that are causing the problem.
And, if the program is long and you feel that creating a short example with the same problematic behavior would take more effort than you are willing to provide, please zip up the whole program (source files, data files, build instructions) and post the zip on a public-access folder in the cloud. Provide a link to that zip file in this forum. There may be some forum readers willing to take a look despite the size.
n=n1+n2
call rank(xp,n,xr)
call rank(y,n,yr)
end program test
line 36 is call rank(xp,n,xr)
SUBROUTINE RANK(X,N,XR)
DIMENSION X(1),XR(1)
COMMON /BLOCK4/ XS(500)
AN=N
IPR=6
HOLD=X(1)
DO 60 I=2,N
IF(X(I).NE.HOLD)GOTO 90
60 CONTINUE
WRITE(IPR, *)HOLD
AVRANK=(AN+1.0)/2.0
DO I=1,N
XR(I)=AVRANK
end do
90 CONTINUE
CALL SORT(X,N,XS)
NM1=N-1
XPREV=X(1)
DO 700 I=1,N
JMIN=1
IF(X(I).GT.XPREV)GOTO 770
IF(I.EQ.1)GOTO 790
IF(X(I).EQ.XPREV)GOTO 750
GOTO 790
750 CONTINUE
XR(I)=RPREV
GOTO 880
770 CONTINUE
JMIN=K
IF(JMIN.LT.N)GOTO 790
IF(JMIN.EQ.N)GOTO 820
IBRAN=1
WRITE(IPR,*)IBRAN
WRITE(IPR,*)JMIN
STOP
790 CONTINUE
DO 800 J=JMIN,NM1
IF(X(I).NE.XS(J))GOTO 800
JP1=J+1
DO 900 K=JP1,N
IF(XS(K).NE.XS(J))GOTO 950
900 CONTINUE
K=N+1
950 CONTINUE
AVRANK=J+K-1
AVRANK=AVRANK/2.0
XR(I)=AVRANK
GOTO 880
800 CONTINUE
820 CONTINUE
J=N
K=N+1
IF(X(I).EQ.XS(J))GOTO 850
IBRAN=2
WRITE(IPR,*)IBRAN
WRITE(IPR,*)X(I),XS(J)
STOP
850 CONTINUE
XR(I)=N
880 CONTINUE
XPREV=X(I)
RPREV=XR(I)
700 CONTINUE
RETURN
END subroutine rank
!++++++++++++++++++++++++++++++++++++++++++++++++
SUBROUTINE SORT(X,N,Y)
DIMENSION X(:),Y(:)
integer,DIMENSION(500):: IU,IL
IPR=6
HOLD=X(1)
DO 60 I=2,N
IF(X(I).NE.HOLD)GOTO 90
60 CONTINUE
WRITE(IPR,*)HOLD
DO 61 I=1,N
Y(I)=X(I)
61 CONTINUE
RETURN
90 CONTINUE
DO 100 I=1,N
Y(I)=X(I)
100 CONTINUE
NM1=N-1
DO 200 I=1,NM1
IP1=I+1
IF(Y(I).LE.Y(IP1))GOTO 200
GOTO 250
200 CONTINUE
RETURN
250 M=1
I=1
J=N
305 IF(I.GE.J)GOTO 370
310 K=I
MID=(I+J)/2
AMED=Y(MID)
IF(Y(I).LE.AMED)GOTO 320
Y(MID)=Y(I)
Y(I)=AMED
AMED=Y(MID)
320 L=J
IF(Y(J).GE.AMED)GOTO 340
Y(MID)=Y(J)
Y(J)=AMED
AMED=Y(MID)
IF(Y(I).LE.AMED)GOTO 340
Y(MID)=Y(I)
Y(I)=AMED
AMED=Y(MID)
GOTO 340
330 Y(L)=Y(K)
Y(K)=TT
340 L=L-1
IF(Y(L).GT.AMED)GOTO 340
TT=Y(L)
350 K=K+1
IF(Y(K).LT.AMED)GOTO 350
IF(K.LE.L)GOTO 330
LMI=L-I
JMK=J-K
IF(LMI.LE.JMK)GOTO 360
IL(M)=I
IU(M)=L
I=K
M=M+1
GOTO 380
360 IL(M)=K
IU(M)=J
J=L
M=M+1
GOTO 380
370 M=M-1
IF(M.EQ.0)RETURN
I=IL(M)
J=IU(M)
380 JMI=J-I
IF(JMI.GE.11)GOTO 310
IF(I.EQ.1)GOTO 305
I=I-1
390 I=I+1
IF(I.EQ.J)GOTO 370
AMED=Y(I+1)
IF(Y(I).LE.AMED)GOTO 390
K=I
395 Y(K+1)=Y(K)
K=K-1
IF(AMED.LT.Y(K))GOTO 395
Y(K+1)=AMED
GOTO 390
END subroutine sort
And here is my subroutines. I found them on NIST website, I believe they are fortran 77 code, but I think them can be used in ftn 95 with a little change.
Quoted from PaulLaidler If the program is short then you could post it here so that we can see the lines of code that are causing the problem.
Thank you for your reply, my code is on above
Quoted from mecej4 And, if the program is long and you feel that creating a short example with the same problematic behavior would take more effort than you are willing to provide, please zip up the whole program (source files, data files, build instructions) and post the zip on a public-access folder in the cloud. Provide a link to that zip file in this forum. There may be some forum readers willing to take a look despite the size.
Got u. Thank u for your reply so quick.
We would need to see the whole of the main program. That is where the value of n is set and it is this value that appears to be too large.
Star2066: Old code such as the one that you posted, with dummy argument arrays with declared size of (1), as in your subroutine RANK, will not behave properly when you use a checking option such as /CHECK. Either compile your entire program without subscript checking, or modify/modernize the subroutines to make them survive subscript checking, or see if FTN95 contains a library function that will do the same task (sorting, in this case).
Quoted from PaulLaidler We would need to see the whole of the main program. That is where the value of n is set and it is this value that appears to be too large.
program test
implicit none
real :: r1,r2,c1,c2,e,x
real,dimension(500) :: xp
real,dimension(500) :: y
real,dimension(500) :: xr
real,dimension(500) :: yr
integer :: i,n1,n2,n
print *,'input numbers before change point to continue'
read *, n1
print *,'input numbers after change point to continue'
read *, n2
print *,'input coefficient of relationship before change point to continue'
read *, r1
print *,'input coefficient of relationship after change point to continue'
read *, r2
open(unit=1, file='results.txt')
c1 = sqrt(1-r1**2)
c2 = sqrt(1-r2**2)
write(1,*) 'c1=', c1,'c2=', c2
y=0
do i = 1,n1+n2 ! call random_seed(0)
call random_number(e)
if (i<n1) goto 10
if (i>=n1) goto 20 ! call random_seed(0)
10 call random_number(x)
xp(i) = x
y(i) = xp(i)*r1+e*c1 ! call random_seed(0)
20 call random_number(x)
xp(i)=x
y(i) = xp(i)*r2+e*c2
write(1,*)'i=',i,' x price=', xp(i),' y price=',y(i)
print *,'i=',i,' x price=', xp(i),' y price=',y(i)
end do
n=n1+n2
call rank(xp,n,xr)
call rank(y,n,yr)
end program test
This is my main program.
With two changes, your program runs fine with /check. The first is to replace (1) by (N) in the DIMENSION statement in subroutine RANK; the second is to replace (:) (darn smileys; that was left-paren, colon, right-paren) by (N) in subroutine SORT. You may not use assumed size arrays as formal arguments to a subprogram unless you also provide an explicit interface to the subprogram in the caller.
Quoted from mecej4 Star2066: Old code such as the one that you posted, with dummy argument arrays with declared size of (1), as in your subroutine RANK, will not behave properly when you use a checking option such as /CHECK.
I would leave checking on. The compiler should be able to cope with the (1) sized arrays if the option \OLD_ARRAYS is enabled. In Plato this is on the language tab (Allow old arrays) in the Properties window. It effectively changes (1) to (*).
Quoted from mecej4 With two changes, your program runs fine with /check. The first is to replace (1) by (N) in the DIMENSION statement in subroutine RANK; the second is to replace (:) (darn smileys; that was left-paren, colon, right-paren) by (N) in subroutine SORT. You may not use assumed size arrays as formal arguments to a subprogram unless you also provide an explicit interface to the subprogram in the caller.
Thank you for you answer, it works. But I have a new problem:
*** Error 112, Reference to undefined variable, array element or function result (/UNDEF)
TEST - in file freeformat2.f95 at line 39 [+0efb]
program test
implicit none
real :: r1,r2,c1,c2,e,x
real,dimension(500) :: xp
real,dimension(500) :: y
real,dimension(500) :: xr
real,dimension(500) :: yr
integer :: i,n1,n2,n
print *,'input numbers before change point to continue'
read *, n1
print *,'input numbers after change point to continue'
read *, n2
print *,'input coefficient of relationship before change point to continue'
read *, r1
print *,'input coefficient of relationship after change point to continue'
read *, r2
open(unit=1, file='results.txt')
open(unit=2, file='rankresults.txt')
c1 = sqrt(1-r1**2)
c2 = sqrt(1-r2**2)
write(1,*) 'c1=', c1,'c2=', c2
y=0
do i = 1,n1+n2 ! call random_seed(0)
call random_number(e)
if (i<n1) goto 10
if (i>=n1) goto 20 ! call random_seed(0)
10 call random_number(x)
xp(i) = x
y(i) = xp(i)*r1+e*c1 ! call random_seed(0)
20 call random_number(x)
xp(i)=x
y(i) = xp(i)*r2+e*c2
write(1,*)'i=',i,' x price=', xp(i),' y price=',y(i)
print *,'i=',i,' x price=', xp(i),' y price=',y(i)
end do
n=n1+n2
call rank(xp,n,xr)
call rank(y,n,yr)
write(2,*)' x rank=', xr,' y rank=',yr
end program test
Quoted from mecej4 With two changes, your program runs fine with /check. The first is to replace (1) by (N) in the DIMENSION statement in subroutine RANK; the second is to replace (:) (darn smileys; that was left-paren, colon, right-paren) by (N) in subroutine SORT. You may not use assumed size arrays as formal arguments to a subprogram unless you also provide an explicit interface to the subprogram in the caller.
by the way, how to use that '/check', could you please tell me about that?
Quoted from davidb
Quoted from mecej4 Star2066: Old code such as the one that you posted, with dummy argument arrays with declared size of (1), as in your subroutine RANK, will not behave properly when you use a checking option such as /CHECK.
I would leave checking on. The compiler should be able to cope with the (1) sized arrays if the option \OLD_ARRAYS is enabled. In Plato this is on the language tab (Allow old arrays) in the Properties window. It effectively changes (1) to (*).
I didn't use your way, but thx for your reply.
Quoted from star2066
Thank you for you answer, it works. But I have a new problem:
*** Error 112, Reference to undefined variable, array element or function result (/UNDEF)
TEST - in file freeformat2.f95 at line 39 [+0efb]
To compile with checks at the command line, use the /check or /undef options. In the IDE, select corresponding options.
In your main program, change write(12,)' x rank=', xr,' y rank=',yr to write(12,)' x rank=', xr(:n),' y rank=',yr(:n) The 'reference to undefined' runtime error occurred because the subroutines assigned values only in the subscript range 1:n. Attempting to print the whole array causes an abort when xr(n+1) is referenced.
You may not be aware that FTN95 comes with a subroutine, RSORT@, for creating a rank index array for a real array. Using that subroutine, your program can be abbreviated to
program test
implicit none
real :: r1,r2,c1,c2,e,x
integer, parameter :: NN = 50
real, dimension(NN) :: xp, yp
integer, dimension(NN) :: ir,jr
integer :: i,n1,n2,n
print *,'input numbers before change point to continue'
read *, n1
print *,'input numbers after change point to continue'
read *, n2
print *,'input coeff of rel before change point to continue'
read *, r1
print *,'input coef of rel after change point to continue'
read *, r2
c1 = sqrt(1-r1**2)
c2 = sqrt(1-r2**2)
write(*,*) 'c1=', c1,'c2=', c2
do i = 1,n1+n2
call random_number(e)
call random_number(x)
xp(i)=x
if (i<n1) then
yp(i) = x*r1+e*c1
else
yp(i) = x*r2+e*c2
endif
end do
n=n1+n2
call rsort@(ir,xp,n)
write(*,51)'x-price',(i,ir(i),xp(ir(i)),i=1,n)
call rsort@(jr,yp,n)
write(*,51)'y-price',(i,jr(i),yp(jr(i)),i=1,n)
51 FORMAT(/A,/,(i3,2x,i3,2x,F12.4))
end program test
Quoted from star2066
I didn't use your way, but thx for your reply.
No worries star2066. I hope you made some good progress anyway.
Quoted from mecej4 You may not be aware that FTN95 comes with a subroutine, RSORT@, for creating a rank index array for a real array. Using that subroutine, your program can be abbreviated to
program test implicit none real :: r1,r2,c1,c2,e,x integer, parameter :: NN = 50 real, dimension(NN) :: xp, yp integer, dimension(NN) :: ir,jr integer :: i,n1,n2,n print *,'input numbers before change point to continue' read *, n1 print *,'input numbers after change point to continue' read *, n2 print *,'input coeff of rel before change point to continue' read *, r1 print *,'input coef of rel after change point to continue' read *, r2 c1 = sqrt(1-r1**2) c2 = sqrt(1-r2**2) write(*,*) 'c1=', c1,'c2=', c2 do i = 1,n1+n2 call random_number(e) call random_number(x) xp(i)=x if (i<n1) then yp(i) = x*r1+e*c1 else yp(i) = x*r2+e*c2 endif end do n=n1+n2 call rsort@(ir,xp,n) write(*,51)'x-price',(i,ir(i),xp(ir(i)),i=1,n) call rsort@(jr,yp,n) write(*,51)'y-price',(i,jr(i),yp(jr(i)),i=1,n) 51 FORMAT(/A,/,(i3,2x,i3,2x,F12.4)) end program test
I run your code, one thing, the xp and yp are same every time. should we use random seed(0) first?