forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Program aborts with spurious error report
Goto page 1, 2  Next
 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
mecej4



Joined: 31 Oct 2006
Posts: 1884

PostPosted: Sat Jan 06, 2018 9:36 pm    Post subject: Program aborts with spurious error report Reply with quote

When the program below is compiled with FTN95 8.10 using the /check option, the resulting EXE aborts with the message "Attempt to call a routine with argument number four containing too few array elements at address xxx". The array in question, FVEC, has exactly the correct size, 5.

This happens with or without /64. When the EXE is run from the command line, the line number where the abort occurred is not shown, only an offset is displayed. When the program is run inside SDBG or SDBG64, the line number is shown. At the point where the program stops in SDBG64, the variables display gives some puzzling and inconsistent information:
Code:
(Alternate address of FVEC) = REAL*4 Array size not known
(Alternate address of M) = 5
(Alternate address of N) = 3
(Alternate address of P) = REAL*4 Array size not known
FVEC = REAL*4 (5)
M = 5
N = 3
P = REAL*4 (3)

Here is the test program source:
Code:
MODULE fit_data
   IMPLICIT NONE
   INTEGER, PARAMETER :: NDAT = 5, NCOEF = 3
   REAL, SAVE  :: x(NDAT) = (/ 28.93, 29.57, 31.30, 33.43, 33.84 /), &
                  y(NDAT) = (/ 0.943, 0.892, 1.089, 1.504, 1.418 /)
END MODULE fit_data

PROGRAM DOFIT

USE fit_data
IMPLICIT NONE

REAL     :: fvec(NDAT)
INTEGER  :: n = NCOEF                 ! number of parameters in model
INTEGER  :: m = NDAT                  ! number of observations
REAL     :: p(NCOEF) = (/ 1e1,-1e-1,5e-2 /)   ! trial values of parameters

CALL lmdif(m, n, p, fvec)

STOP

CONTAINS

SUBROUTINE ffcn(p, fvec)

USE fit_data
IMPLICIT NONE
REAL, INTENT(IN)      :: p(:)
REAL, INTENT(OUT)     :: fvec(:)

fvec = -y + (p(2)*x+p(1))/ (p(3)*x+1d0)

RETURN
END SUBROUTINE ffcn

SUBROUTINE lmdif(m, n, p, fvec)
implicit none

INTEGER, INTENT(IN)   :: m
INTEGER, INTENT(IN)   :: n
REAL, INTENT(IN OUT)  :: p(:)
REAL, INTENT(OUT)     :: fvec(:)

 CALL ffcn(p, fvec)
 CALL fdjac2(m, n, p, fvec)

 RETURN
END SUBROUTINE lmdif

SUBROUTINE fdjac2(m, n, p, fvec)
implicit none

INTEGER, INTENT(IN)   :: m
INTEGER, INTENT(IN)   :: n
REAL, INTENT(IN OUT)  :: p(n)
REAL, INTENT(IN)      :: fvec(m)

INTEGER   :: j
REAL :: eps, h, temp, wa(m), fjac(m)
REAL, PARAMETER :: zero = 0.0

eps = 3e-4
DO  j = 1, n
  temp = p(j)
  h = eps*ABS(temp)
  IF (h == zero) h = eps
  p(j) = temp + h
  CALL ffcn(p, wa)
  p(j) = temp
  fjac = (wa(1:m) - fvec(1:m))/h
END DO

RETURN

END SUBROUTINE fdjac2

END PROGRAM DOFIT
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Mon Jan 08, 2018 8:43 am    Post subject: Reply with quote

Thank you for this bug report. I have made a note that it needs to be fixed.
Back to top
View user's profile Send private message AIM Address
mecej4



Joined: 31 Oct 2006
Posts: 1884

PostPosted: Tue Feb 13, 2018 2:49 pm    Post subject: Reply with quote

More searching in these forums turned up the following reports of what may be the same issue:

"What sometimes 64bit mode with /check /full_debug generates", http://forums.silverfrost.com/viewtopic.php?p=24012

"FTN95 8.10 false error report: Array arg w too few elements", http://forums.silverfrost.com/viewtopic.php?p=24009
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7912
Location: Salford, UK

PostPosted: Tue Feb 13, 2018 6:13 pm    Post subject: Reply with quote

This issue has now been fixed for the next release.
Back to top
View user's profile Send private message AIM Address
JohnCampbell



Joined: 16 Feb 2006
Posts: 2551
Location: Sydney

PostPosted: Wed Feb 14, 2018 12:14 am    Post subject: Reply with quote

I find the use of CONTAINS in the following code to be confusing and could be error prone.
Code:
CONTAINS

SUBROUTINE ffcn(p, fvec)

USE fit_data
IMPLICIT NONE
REAL, INTENT(IN)      :: p(:)
REAL, INTENT(OUT)     :: fvec(:)

fvec = -y + (p(2)*x+p(1))/ (p(3)*x+1d0)

RETURN
END SUBROUTINE ffcn


Subroutine ffcn uses arrays fvec, p, x & y
All these arrays are in scope, but p & fvec are supplied as arguments.
( is USE fit_data required here or am I misunderstanding the scope implied by CONTAINS ? )

Shouldn't there be a warning that the subroutine arguments conflict with in scope arrays ? ( which are the same arrays ! )
I am assuming the subroutine arguments take precedence over the arrays provided by CONTAINS or USE.

I don't like the use of CONTAINS at all. If you want variables to be in scope, wouldn't a MODULE be a better approach ?
This example has x and y available via both CONTAINS and USE.

What do others think of this ?

John
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1884

PostPosted: Wed Feb 14, 2018 1:13 am    Post subject: Reply with quote

John, this code was intended only to exhibit the compiler bug. As with many other codes that are derived from a real application by cutting out as many lines as possible, what is left is quite silly and does no useful calculations.

I do not think that it is worthwhile to edit the code to make it respectable. I plead that codes of this nature (minimum working examples) not be held up as examples of well-written code.
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2551
Location: Sydney

PostPosted: Thu Feb 15, 2018 2:49 pm    Post subject: Reply with quote

mecej4,

More a complaint about how CONTAINS can disguise the scope of local and used variables from the containing routine.

Perhaps there could be a warning that an in-scope variable name conflicts with a routine argument or module, which does happen in other cases, such as MODULE vs local declaration. Compiling SUBROUTINE ffcn should provide warnings of conflict.
Back to top
View user's profile Send private message
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Thu Feb 15, 2018 3:57 pm    Post subject: Reply with quote

Is a CONTAINS routine put in-line like a statement function, or is it the same as any other subprogram apart from scoping?
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1884

PostPosted: Thu Feb 15, 2018 5:30 pm    Post subject: Re: Reply with quote

JohnCampbell wrote:
...CONTAINS can disguise the scope of local and used variables from the containing routine.

That is a problem. More generally, the same exists in any subprogram that has overlapping scope and/or storage/host association of variable names. For me, this happens when I am studying someone else's program that is not working quite right, and create temporary variables for use in PRINT statements to let me view the values of some suspicious expressions. In these situations, I also wish that we could have local implied do index variables as in C:

for(int i=0; i<N; i++)printf("...",A[i]);

Perhaps there could be a warning that an in-scope variable name conflicts with a routine argument or module, which does happen in other cases, such as MODULE vs local declaration. Compiling SUBROUTINE ffcn should provide warnings of conflict.[/quote]
I'd definitely like that and use it often.
Back to top
View user's profile Send private message
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Thu Feb 15, 2018 6:16 pm    Post subject: Reply with quote

The scoping rules are plain for the case you request, and have, as far as I know, always been so. The scope of a loop index variable in (say) a DATA statement is local to the statement (as it can be dealt with by the compiler) but the scope of a loop index variable in an input or output list is the whole subprogram in which it appears. Hence,

Code:
      PROGRAM SCOPE
      DIMENSION A(3)
      A(1) = 1.0; A(2) = 2.0; A(3) = 3.0
      DO 10 I=1,3
      WRITE(*,*) (A(I),I=1,3)
   10 CONTINUE
      END


MUST fail. (In FTN95 at compile time. If not, because you are using something inferior, then at run time, possibly mysteriously).

If the implied DO loop variable was scoped only to the statement you used it in, then it wouldn't be Fortran.

Surely there are enough implicitly INTEGER variables you could use that probably won't conflict: 'Mecej4' being one unlikely that anyone else would use. In old code, it is probably sufficient that it is more than 6 characters long.

For instance:

Code:
      WRITE(*,*) (A(Meghan_Markle),Meghan_Markle=1,3)


Another approach is to use a routine like:

Code:
      SUBROUTINE DEBUG_VARS ( A, I,  J)
      DIMENSION A(*)
      WRITE(*,*) (A(K), K = I, J)
      END


and insert CALL DEBUG_VARS (A, I, J) instead of putting the write statement in. It might even be shorter.

Eddie
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2551
Location: Sydney

PostPosted: Fri Feb 16, 2018 3:20 am    Post subject: Re: Reply with quote

LitusSaxonicum wrote:
The scope of a loop index variable in (say) a DATA statement is local to the statement (as it can be dealt with by the compiler) but the scope of a loop index variable in an input or output list is the whole subprogram in which it appears.


Eddie, you are probably not the one to ask about this, but it always puzzles me how I can use a loop index that is local to a data statement, when I use "IMPLICIT NONE" or /implicit_none.
With /imp, I have to declare the loop index as integer, so then it's scope becomes the whole routine. Just means that the loop index in the data statement must be a unique name, if the variable I is used elsewhere in the routine or worse still, in a module or common.
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1884

PostPosted: Fri Feb 16, 2018 3:54 pm    Post subject: Reply with quote

John, I have read through the scope rules, but gave up after sensing that I would not be able to remember all the details while writing code. For most people, it may be best not to use the same names for implied DO variables as variables used elsewhere.

In the program
Code:
program vtest
implicit none
integer :: x(4) = [(i*4, i=2,5)], j,i
print *,(x(j),j=1,4)
print *,i,j
end program

the variable i is undefined except within the initialization. The variable j, on the other hand, is undefined before line 4, but has the value 5 after that line (according to FTN95 8.10).
Back to top
View user's profile Send private message
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Fri Feb 16, 2018 6:49 pm    Post subject: Reply with quote

John,

No I'm not the best person As , but what you describe is a side effect of IMPLICIT NONE. The scoping rules used to be simple:

Global - subroutine and function names, intrinsics, named common names
Local - everything in a subroutine
Even more local - implied DO loop in an initialisation (which you lose with IMPLICIT NONE).

Now, as above, but anything in a CONTAINing supprogram also applies in CONTAINed routines. Modules may further obscure this.

As long as you remember that a DO loop index is undefined on exit from the loop by virtue of finishing (it is defined on a jump out) then you can use it as often as you like. As the number of variables you can use is essentially infinite, I prefer to use separate loop variables if the subroutine code is lengthy, but i,j,k if it is short. The former case always has the loop index name starting with i, and the final count with N, as in

Code:
DO 120 iNODES = 1, nNODES


or

Code:
DO 80 iELES = 1, nELES


but i and j in shorter subprograms. For me, it is the need to read it decades later.

(and usually all in capitals!)

Eddie
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1884

PostPosted: Fri Feb 16, 2018 7:07 pm    Post subject: Re: Reply with quote

LitusSaxonicum wrote:
...As long as you remember that a DO loop index is undefined on exit from the loop by virtue of finishing (it is defined on a jump out) ...

Eddie, that was true in the old days, but not in Fortran 9X and later. For example, F2003 says in 8.1.6.4.4 "Loop termination":
Quote:
When a DO construct becomes inactive, the DO variable, if any, of the DO construct retains its last defined value.


Another feature that one could have in old Fortran: the DO index variable could be REAL. This is no longer permitted.
Back to top
View user's profile Send private message
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Sat Feb 17, 2018 9:51 am    Post subject: Reply with quote

In FTN95, I found that on exit from DO 10 I=1,3 that I was 4, which is not undefined, but is defined in a way that is relatively useless. Integers can't be undefined in the way that REALs can. As for loop variables being REAL, that was a stupid and unnecessary insertion, and deserved to be removed.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Goto page 1, 2  Next
Page 1 of 2

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group