Detect variables implicitly declared

Hello,

I need to convert a set of routines from FORTRAN77 to Modern Fortran.
These routines should be used inside a new version of a bigger simulation code, that exposes some global variables that are in part used and modified by these routines.

I see that there are some tools that may assist the conversion, such as:

However, my main concern is not the translation, but the detection of variables.
More specifically, since these routines have been programmed in implicit, it would be very useful to have a list of the symbols exposed by some selected modules (that I will need to use) and a list of the variables defined implicitly by these routines.
Having these lists of variables will from one side let me detect potential name clashes and for the other side provide the elements to write appropriate variable declarations (and move to implicit none).

Do you have any suggestion for this specific use case?
Thank you for your help.

To find implicitly declared variables with gfortran, use the -fimplicit-none option. For Intel Fortran (ifx) on Windows, use the /warn declarations option and on Linux use
-warn declarations.

If your code has lines such as

implicit real(a-h, o-z)

they need to be removed for gfortran -fimplicit-none to warn about undeclared real variables.

2 Likes

good luck :slight_smile: If you find a good set of combination please keep us posted I also have to do this but first I need to fix up other bits of the code

See spag and fpt as well. Depending on how many procedures you have and whether they are in individual files or not, you know what their type is by their name so it is relatively easy to add an implicit none statement to the routine (or use one of the above switches to make it the default) and get the names from the error messages and turn them into declarations.

Thank you very much for the suggestion.
This approach detects only the variables implicitly defined, and not the list of all variables.

My issue is that I already detected some name clashes.
Let me better explain. In the old version of the simulation code there were some modules to share variables. In the new version there are other modules for the same purpose, but the names of some variables are different.
I already faced a name clash: a module imported in the new code declares a variable that was not present in the old code (and that I do not need), and the routine that I need to port with the implicit employs the same symbol. This is havoc. In this sense, looking for implicit-none errors is useful but not sufficient.
I would need the list of all variables, including those declared, to detect the best approach for the porting.

Potentially fortls may do this, but I do not how to get this information.

After a web search, I guess that your are speaking about

Some general advice is that if you have a line

use some_module

you can comment it out to see what breaks and then write

use some_module, only: x, y, z

if those are the variables needed.

1 Like

Sure, but I guess that it works only with implicit none.
Otherwise, nothing will break.
The combination of use and implicit makes the task harder.

For a code such as

module m
real :: pi = 3.14
end module m

program main
! use m
r = 10.0
print*,"area is ",pi*r**2
end program main

gfortran -fimplicit-none says

xarea.f90:8:20:

    8 | print*,"area is ",pi*r**2
      |                    1
Error: Symbol 'pi' at (1) has no IMPLICIT type
xarea.f90:7:1:

    7 | r = 10.0
      | 1
Error: Symbol 'r' at (1) has no IMPLICIT type

What prevents you from putting implicit none in every scope? This will catch all implicit local variables, but not module variables. Add explicit declarations for all local variables.

Then follow @Beliavsky’s advice to comment out the use statements one by one, and add use, only for each variable name that triggers an error.

Depending on cases, the -fdump-fortran-original option of gfortran might be useful to get a list of variables. For example, for this code

module mymod1
    implicit none
    integer :: val = 100
end module

module mymod2
    use mymod1, only: myval => val
contains

subroutine mylegacy()
    implicit double precision (a-h,o-z)
    val = -1
    num = 1
    print *, "pi = ", acos(val * num)
end subroutine

end module

gfortran -c -fdump-fortran-original test.f90 gives

    symtree: 'num'         || symbol: 'num'          
      type spec : (INTEGER 4)
      attributes: (VARIABLE  IMPLICIT-TYPE)
    symtree: 'val'         || symbol: 'val'          
      type spec : (REAL 8)
      attributes: (VARIABLE  IMPLICIT-TYPE)

It may be possible to write some script that collects variable names (e.g. into a dictionary) and check possible name collisions among various modules and routines.

Full output of the above command
Namespace: A-Z: (UNKNOWN 0)
procedure name = mymod1
  symtree: 'mymod1'      || symbol: 'mymod1'       
    type spec : (UNKNOWN 0)
    attributes: (MODULE )
  symtree: 'val'         || symbol: 'val'          
    type spec : (INTEGER 4)
    attributes: (VARIABLE IMPLICIT-SAVE)
    value: 100

  code:

Namespace: A-H: (REAL 4) I-N: (INTEGER 4) O-Z: (REAL 4)
procedure name = mymod2
  symtree: 'mylegacy'    || symbol: 'mylegacy'     
    type spec : (UNKNOWN 0)
    attributes: (PROCEDURE MODULE-PROC  SUBROUTINE CONTAINED)
  symtree: 'mymod1'      || symbol: 'mymod1'       
    type spec : (UNKNOWN 0)
    attributes: (MODULE  USE-ASSOC(mymod1))
  symtree: 'mymod2'      || symbol: 'mymod2'       
    type spec : (UNKNOWN 0)
    attributes: (MODULE )
  symtree: 'myval'       || symbol: 'val'          
    type spec : (INTEGER 4)
    attributes: (VARIABLE IMPLICIT-SAVE USE-ASSOC(mymod1))

  code:
CONTAINS

  Namespace: A-H: (REAL 8) I-N: (INTEGER 4) O-Z: (REAL 8)
  procedure name = mylegacy
    symtree: '__convert_i4_r8'|| symbol: '__convert_i4_r8' 
      type spec : (REAL 8)
      attributes: (PROCEDURE  FUNCTION ELEMENTAL PURE)
      result: __convert_i4_r8
    symtree: 'acos'        || symbol: 'acos'         
      type spec : (REAL 8)
      attributes: (PROCEDURE INTRINSIC-PROC  FUNCTION IMPLICIT-TYPE ARRAY-OUTER-DEPENDENCY)
      result: acos
    symtree: 'mylegacy'    || symbol: 'mylegacy' from namespace 'mymod2'
    symtree: 'num'         || symbol: 'num'          
      type spec : (INTEGER 4)
      attributes: (VARIABLE  IMPLICIT-TYPE)
    symtree: 'val'         || symbol: 'val'          
      type spec : (REAL 8)
      attributes: (VARIABLE  IMPLICIT-TYPE)

    code:
    ASSIGN mylegacy:val -1.0000000000000000e0_8
    ASSIGN mylegacy:num 1
    WRITE UNIT=6 FMT=-1
    TRANSFER 'pi = '
    TRANSFER __acos_r8[[(((* mylegacy:val __convert_i4_r8[[((mylegacy:num))]])))]]
    DT_END

To explain better the problem, you may see these samples. You may compile everything with CMake, if you like.

Let us consider that legrout is the legacy routine in fixed form Fortran that employs implicit declarations. This routines make use of a shared variable in a dedicated module.

The overall simulation code is composed by the main routine test1, the module mod1, and the legacy routine legrout1. The variable a declared in test1 is modified by legrout using the value of the variable b in mod1, employing a local variable c, implicitly defined.

Now, let us suppose that the new version of the simulation code arrives.
The legacy routine should perform the same task.
In this case, the variable a declared in test2 should again be modfied by legrout making use of the variable b in mod2, that represents the updated version of mod1.
However, the new version of the code employs also another variable c, declared inside mod2.

Of course, to make things nastier, in the real world, mod1 and mod2 will have the same name.

In the former version of the code, the variable c gets defined automatically inside legrout because of the implicit typing.
In the latter version of the code, the variable c is available by use association inside legrout.
Unfortunately, without changing the sources of the legacy routine, a side effect is generated in the main program.

You can see that in a real case with hundreds of lines (and no comments) it will be very difficult to deal with this case.
Setting implicit none in the new version of the code may not be enough, because it will not detect all the variables that, acoording to the original authors, should have been implicitly defined in the old context.
Also, you should consider that the module providing shared values used may have changed some variables names.

In this sense, it would be very useful to have just a report of all variables in a given module unit, either explicitly or implicitly defined.
This information should be available at some point in the compiler, therefore I guessed that someone should have faced this issue before.

This is indeed a very good point.
-fdump-fortran-original effectively provides the report of the variables.
I will play a bit with Python so see whether I may get something in a useful format and later come back.

1 Like

In lieu of true namespace nomenclature for variables I have found it easier to make everything private in a module and then explicitly specify what is public and make a type that contains all the variables I want public and place them in that. Then, in the procedures instead of using PI I would use something like constants%pi. They can be renamed on the use statement or often by using an ASSOCIATE statement. It might seem cumbersome in some cases, but I have found it avoids a lot of issues with public variables. You can also make the values only accessible via functions as well, but if heavily used there are situations where that might add noticeable undesired overhead. It seems overdue for Fortran to not support <MODULE_NAME>%<PROCEDURE()> and <MODULE_NAME>%variable. It seems at least on the surface to be worth the effort to implement full namespace nomenclature in the standard.

It is best to do this in code as suggested, but a quick way to accomplish this is with the gfortran
-fmodule-private option, which I use in makefiles.

the only modules I could find that I have that do not start with PRIVATE statement near the top are modules with nothing but use statements used to make a number of small modules available under a single name and/or to eliminate dependency loops so I think that sounds like a good default to have in the fpm [[fortran]] section of the manifest file if commonly available on compilers. To me PRIVATE not being a default is on lines with IMPLICIT NONE not being the default in a module. Although I have thought that the fpm new subcommand should perhaps have an option to turn the non-standard defaults off when working with existing code bases.

You can rename constants in the use statement, but not constants%pi. That is, something like

use some_mod, only: pi => constants%pi

is not allowed.

Another general solution to this namespace problem is to use the only: clause for all entities imported from a module. This requires some extra typing, of course. Another problem is that there is no way to tell the compiler to force the programmer (i.e. yourself) to use that convention, you have to remember to do it all on your own.

One problem with the <MODULE_NAME>%variable approach is that this exposes the inner structure of the nested modules to the high-level user code. As is, that is hidden to the programmer using the module, so he need not know if the variable is defined in that module or rather accessed in that module from some other module. With the namespace convention, a programmer might be required to do something like <MODULE_NAME>%<MODULE_B_NAME>%<MODULE_C_NAME>%variable instead. And then if the structure of those modules were ever changed (modules combined, rearranged, split, etc.), all the high-level codes would need to be changed to reflect the new inner structure.

Fortitude does this. fortitude check xonly.f90 for the code

module m
implicit none
integer :: i
end module m

program main
use m
implicit none
i = 3
print*,i
end program main

says

xonly.f90:7:1: M011 'use' statement missing 'only' clause
  |
6 | program main
7 | use m
  | ^^^^^ M011
8 | implicit none
9 | i = 3
  |

fortitude: 1 files scanned.
Number of errors: 1

On Windows the batch script

fortitude check xonly.f90
ECHO Return code: %ERRORLEVEL%

gives Return code: 1 and with bash the script is

fortitude check xonly.f90
echo "Return code: $?"

One could use a script that compiles a code only if it passes Fortitude, which also has a pre-commit hook.

1 Like

The fpt command to find all implicitly typed variables is “% show undeclared symbols” - please see: http://simconglobal.com/fpt_ref_show_undeclared_symbols.html .

You can download fpt at http://simconglobal.com . Please request a licence - the site will issue one for a few days and we will catch up in the morning with a longer term one.

fpt will also insert declarations for you, but I suspect that this isn’t what you want at the moment.

when I run it in one of my projects I get a lot of

There are multiple declarations of sub-program abrt
    1  ../original_source/source/util.f
    2  ../original_source/source/util.f

but

jorge@jorgepc:~/personal-dev/fortran/gamess/source$ grep "subroutine abrt" -i *
util.src:      subroutine ABRTX(str)
util.src:      SUBROUTINE ABRT

I see that there’s this:

fpt may detect two or more INCLUDE files or primary files with the same names or containing modules or sub-programs with the same name. When this occurs fpt prompts for the appropriate file or directory. However, problems will occur if two different modules or include files with the same name occur in the same program (in the case of modules this is illegal, but there is nothing in the language design to stop it happening).

So I am a bit confused on what’s going on here. My project is not the paragon of good software, so that might be helping to cause the pain.