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 

Can't find declaration of local array.
Goto page 1, 2  Next
 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> General
View previous topic :: View next topic  
Author Message
Tenobaal88



Joined: 20 Nov 2014
Posts: 2

PostPosted: Thu Nov 20, 2014 11:14 pm    Post subject: Can't find declaration of local array. Reply with quote

Hi, I'm new to FORTRAN and struggling with the following subroutine.
There's an array "INDU" used in the subroutine "INVERS". I can't find the declaration of INDU in the code. I searched the whole programm but INDU only appears in subroutine "INVERS", so it can't be a global variable.
The FTN95 debugger says "Variable Unknown" when try to read the elements of the array. Nevertheless, the array INDU is used in the subroutine.
Please help me to understand whats going on here.

Code:

SUBROUTINE INVERS(NGL,NUGL,MAX,MAXUGL,ME0,DIAG,SPG,LUGL,MAT,
     *                 VEK,KOL,END,X,MAT0,VEK0,END0)

      IMPLICIT REAL*8(A-H,O-Z)
C
      COMMON /WINDOW/ WIN3
      COMMON /IODEF / VERSIO,NTEST,IKART,NLIST,ND1,INET,NNET,NPLOT,
     ,                NUEPL
C
      REAL*8    DIAG(1),MAT(1),VEK(1),X(1)
      REAL*8    MAT0(1),VEK0(1),SPG(1)
      LOGICAL   LUGL(1)
C
      INTEGER   KOL(1),END(1),END0(1)
      CHARACTER*10 TE

C Where is INDU declared???
      INDU(IZ,IS)=(IZ-1)*NUGL+IS

C .... additional code where INDU is used
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1885

PostPosted: Fri Nov 21, 2014 4:44 am    Post subject: Reply with quote

Indu is not an array; it is what is called a "statement function". There is less confusion when statement functions take other than integer arguments.

INDU seems intended to map a subscript pair to a single offset into an array.
Back to top
View user's profile Send private message
Wilfried Linder



Joined: 14 Nov 2007
Posts: 314
Location: Düsseldorf, Germany

PostPosted: Fri Nov 21, 2014 7:27 am    Post subject: Reply with quote

I'm not sure whether INDU is a function...

See the line IMPLICIT REAL*8(A-H,O-Z). This means that all variables beginning with "A", "B", ... "H" or "O" ... "Z" are declared as real*8. So I think that INDU is declared as a real*8 variable.

But I don't like IMPLICIT declarations and always use IMPLICIT NONE instead. This forces the programmer to explicitely declare all of his variables and makes the code clearer.

Besides: IZ seems to be the line index, IS the column index in a matrix, NUGL the number of unknows / equations in an equation system (= number of lines of the matrix). So, INDU calculates a unique index for each position in the matrix. INDU itself is a matrix. Find out the maximum dimensions of a matrix in your programme (say 30 x 30), then declare INDU in this way:

Code:
integer*4  INDU(30,30)

The code is written by a German-speaking author:

Z = Zeile (row)
S = Spalte (column)
GL = Gleichung (equation)

Wilfried
Back to top
View user's profile Send private message
davidb



Joined: 17 Jul 2009
Posts: 560
Location: UK

PostPosted: Fri Nov 21, 2014 8:17 am    Post subject: Reply with quote

But INDU begins with "I" and I isn't in the range A-H or O-Z.

So INDU isn't real*8.

INDU is Integer.

It is pretty clear that INDU is a statement function in the code posted.
_________________
Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl
Back to top
View user's profile Send private message
Wilfried Linder



Joined: 14 Nov 2007
Posts: 314
Location: Düsseldorf, Germany

PostPosted: Fri Nov 21, 2014 8:59 am    Post subject: Reply with quote

David, you're right, of course INDU was implicitely declared as integer. Sorry.

But - Tenobaal88 wrote that INDU appears only in this subroutine but nowhere else in the programme. Therefore I guess that it is not a function but a matrix Wink

Have a nice day
Wilfried
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Fri Nov 21, 2014 11:37 am    Post subject: Reply with quote

Go back to mecej4's post

Indu is what is called a "statement function".

These are obsolete but should still work.
It uses the 2 arguments IZ and IS and also the variable NUGL.

I would change the declarations to as below, to indicate they are arrays of unknown size:

REAL*8 DIAG(*),MAT(*),VEK(*),X(*)
REAL*8 MAT0(*),VEK0(*),SPG(*)
LOGICAL LUGL(*)
C
INTEGER KOL(*),END(*),END0(*)
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1885

PostPosted: Fri Nov 21, 2014 12:17 pm    Post subject: Reply with quote

FTN95 provides a way of clarifying whether an identifier represents an array or a function, with the /XREF and /LIS options. If the source is compiled with the /XREF option, a file with the suffix .XRF is produced, which will contain a line such as
Code:
INTEGER :: FUNCTION INDU


As John Campbell has noted, the use of '1' as a placeholder in dimension declarations for array type dummy arguments can be problematic. If array subscript checking is desired for the code in the subroutine, one has to put in actual limits, which can be constants or expressions involving integer dummy arguments, instead of '*'.
Back to top
View user's profile Send private message
LitusSaxonicum



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

PostPosted: Fri Nov 21, 2014 1:08 pm    Post subject: Reply with quote

Obsolete or not, statement functions still work, and that is definitely what INDU is. If you haven't read your code for a long time, or you are unaccustomed to statement functions, they look like something else, and cause the puzzlement that this has caused. My understanding is that they are compiled inline, and don't create the overheads that conventional subroutines and functions do - but then FTNxx is a law unto itself. In Fortran77 and earlier, the scope of any variable name is limited to the subprogram it is declared in and subprogram names have a global scope, but statement functions have a local scope and also have access to variables such as NUGL that for a conventional function would need to be passed to it as a parameter or via COMMON.

A more modern approach would be to declare that INVERS 'contains' INDU (and then write a conventional but 'contained' function), although the statement function does have the advantage of brevity even if it suffers the disadvantage of incomprehensibility.

Passing arrays of indeterminate length used to be done with the '1', because only the address of the first element is passed, and not its length, in most early Fortran variants and probably the same now. This has been addressed in Fortran 90 and onwards.

There will be divided opinions on IMPLICIT typing. I like it because I instantly know the types of all my variables. The two times in nearly 50 years I strayed from this, it caused me huge trouble. I know it marks me out as a dinosaur, or a museum piece, but it works for me. Others may prefer IMPLICIT NONE, and that is their prerogative. But I can tell you what will cause indigestion, and that is to mix implicit and explicit typing (as here)!

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



Joined: 20 Nov 2014
Posts: 2

PostPosted: Fri Nov 21, 2014 2:34 pm    Post subject: Reply with quote

You're right Wilfried Linder. The Subroutine INVERS solves a system of linear equations (Gauss algorithm).
INDU seems to be an implicit declaration of an array of integer.
When I delete the line "INDU(IZ,IS)=(IZ-1)*NUGL+IS" the debugger terminates the programm with the message "Call to missing routine - INDU".

I used the Notepad++ and other stuff to find the declaration of "INDU" but there's nothing outside of subroutine "INVERS".

Edit: I turned on the XREF and LIST Option. I found a Function INDU in the XREF File.

Output from XREF File:
Code:

INTEGER :: FUNCTION INDU
  6485*,   6539,    6544,    6550,    6598,    6611,    6617, 
  6618,    6623 


Corresponding lines from the LIS File.
Code:

   6483   C
   6484         INDU(IZ,IS)=(IZ-1)*NUGL+IS
   6485 

   6538         DO 41 K=1,NUGL
   6539      41 SPG(INDU(N,K))=0
   6540         DO 40 K=K1,K2

   6542           IF(KOL(K).GT.NGL) THEN
   6543              IUGL=KOL(K)-NGL
   6544              SPG(INDU(N,IUGL))=MAT(K)
   6545           ENDIF

   6548         IF(N.GT.NGL) SPG(INDU(N,N-NGL))=DIAG(N)
   6549   C
   6550   C***** BESETZEN DER RECHTEN SEITE

   6597   C
   6598         R=-SPG(INDU(IZ,IS))/SPG(INDU(IS+NGL,IS))
   6599         VEK0(IZ)=VEK0(IZ)+VEK0(IS+NGL)*R

   6610         IF(NUGL.GT.0) THEN
   6611          X(NGL+NUGL) = VEK0(NGL+NUGL)/SPG(INDU(NGL+NUGL,NUGL))
   6612         ENDIF

   6617      50 X(IZ)=X(IZ)-SPG(INDU(IZ,IS))*X(IS+NGL)
   6618         X(IZ)=X(IZ)/SPG(INDU(IZ,IZ-NGL))
   6619      49 CONTINUE 
   6620         DO 51 IZ=NGL,1,-1
   6621         X(IZ)=VEK0(IZ)
   6622         DO 52 IS=1,NUGL
   6623         X(IZ)=X(IZ)-SPG(INDU(IZ,IS))*X(IS+NGL)


Can somebody please explain what this means? What is the function actually doing?

Edit2: OK I understand whats going on. INDU(IZ,IS) is a function, IZ and IS are parameters of that function. The function calculates "(IZ-1)*NUGL+IS" and returns the result as an integer value. Embarassed
So the line "INDU(IZ,IS)=(IZ-1)*NUGL+IS" defines a whole function...crazy Shocked Thanks for your help!
Back to top
View user's profile Send private message
davidb



Joined: 17 Jul 2009
Posts: 560
Location: UK

PostPosted: Fri Nov 21, 2014 5:57 pm    Post subject: Re: Reply with quote

Tenobaal88 wrote:

Can somebody please explain what this means? What is the function actually doing?


The statement function is:
Code:

INDU(IZ,IS)=(IZ-1)*NUGL+IS


when it is called in your code like this:
Code:

SPG(INDU(N,IUGL))=MAT(K)


The compiler replaces this by the following:
Code:

SPG((N-1)*NUGL+IUGL)=MAT(K)


So the statement function acts like a macro in C if you know C.

Statement functions are a bit limited since they are confined to one statement (one line plus any continuation lines). The modern way is to write an "internal functon" which allows you to use multiple statements.
_________________
Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl
Back to top
View user's profile Send private message
davidb



Joined: 17 Jul 2009
Posts: 560
Location: UK

PostPosted: Fri Nov 21, 2014 6:00 pm    Post subject: Re: Reply with quote

mecej4 wrote:
If array subscript checking is desired for the code in the subroutine, one has to put in actual limits, which can be constants or expressions involving integer dummy arguments, instead of '*'.


Doesn't Silverfrost's FTN95 do subscript checking even if * is used on dummy arguments?
_________________
Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl


Last edited by davidb on Fri Nov 21, 2014 9:22 pm; edited 1 time in total
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1885

PostPosted: Fri Nov 21, 2014 8:00 pm    Post subject: Reply with quote

Good question!

If all the sources are compiled with /check, FTN95 will certainly flag the subscript error in a subroutine.

If the subroutine containing a subscript error contains '*' as the dimension of a dummy argument, the subroutine relies on the caller to pass information on the actual array size to it. If the caller is not compiled with /check but the subroutine is, then crashes or bad results can be seen in the subroutine even when the subroutine is compiled with /check. Here is an example: the subroutine is
Code:
subroutine sub(a,n)
integer a(*),n
integer i
do i=1,n*n+5
   a(i)=2*i-3
end do
return
end
The caller contains
Code:
program blowbnds
implicit none
integer n,a(10)
n=3
call sub(a,n)
write(*,*)a(3)
end program

If I compile only the subroutine with /check and run, no error is detected. If I change 'a(*)' to 'a(n)' in the subroutine, and compile in the same way, the error is reported in the subroutine.

A related issue is about using UBOUND, etc., on a dummy array argument. With assumed size arguments, one can't apply UBOUND.
Back to top
View user's profile Send private message
davidb



Joined: 17 Jul 2009
Posts: 560
Location: UK

PostPosted: Fri Nov 21, 2014 8:46 pm    Post subject: Reply with quote

I think only Silverfrost, NAG and Lahey compilers can do this now.

Related to this, in the following there should not be a run time error if the code is compiled with /CHECK and /OLD_ARRAYS. I have not tried it though Smile

Code:

subroutine add(a, n)
   ! Need /OLD_ARRAYS so a(1) is interpreted as (*)
   real a(1)
   print *, 'sum is ', sum(a(1:n))
end

program main
   real b(5)
   b = (/1.0, 2.0, 3.0, 4.0, 5.0/)
   call add(b, 5)
end


Generally, as all my subprograms have an explicit interface I don't much use (*) in my own work, but do come across it a lot in other peoples code.

Edit: Interesting I think there's a bug here in the compiler. Will post separately in support area.

mecej4 wrote:

With assumed size arguments, one can't apply UBOUND.


Well yes and no, you can use UBOUND (and SIZE etc) on all ranks except for the last one which has the (*). You can't use it on rank 1 assumed size arrays at all.

Code:

subroutine report(a, n)
   real a(n,*)
   print *, ubound(a,1)
end

program main
   real b(5,2)
   b = 1.0
   call report(b, 5)
end

_________________
Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Fri Nov 21, 2014 11:56 pm    Post subject: Reply with quote

I do recall that a very early version of FTN95 did not support statement functions, or at least had problems with them. Since converting to F95 I have removed them from my code.

I would not use statement functions in an equation solver as shown above. The preference now would be to have the array defined as 2D.

Early fortran coding would use a 1D array for efficiency, using smarts for the array address, rather than letting the compiler do the 2D address calculation. I think replacing that with an in-line function has lost the plot.

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



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

PostPosted: Sat Nov 22, 2014 12:30 pm    Post subject: Reply with quote

John,

I think it unlikely that statement functions didn't work with FTN95, as they've been part of Fortran for more than a half century, and they certainly worked with FTN77 - unless it was one of those things that Paul calls a 'regression'.

Whether an inline function is a good idea - or any other type of subprogram, or writing the code explicitly - is a function of the compiler and the computer. Whether it is good style depends on the reader. If the origins of the code go back to 'the dawn of time' other factors may influence this, e.g. one is dissuaded from using comments if there is a limit on the number of cards in a job (e.g. Imperial College's 'instant turnround' jobs on the CDC6400 c. 1972) or how many cards could read reliably. Moreover, such limitations militate against using white space and/or indents. I have one arithmetic IF left over from programming on an IBM1130 which still works perfectly - that computer had no logical IF!

In my view, one is least likely to find a problem in any facility that has been in a compiler for a long time.

Eddie
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 -> General 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