I’ve got a code modernization puzzle. I’m working with a large legacy code and trying to modernize it incrementally. The code has a custom command line interface to set the value of any global variable by name. For example, a command line input to set the value of mass to 60 looks like this:
> mass 60
Since Fortran doesn’t have introspection, this is achieved via a bunch of claptrap, namely a huge global array, an external data dictionary that lists all global variable names and their corresponding indices in the global array, and thousands of equivalence statements pairing global array elements with variable names within procedures. For example, in every procedure where mass appears, it has equivalence( global_array(658), mass ), along with a declaration real mass (and a dimension mass(n) statement in the case of arrays). Since each of these is written manually in hundreds of different files, it’s very error prone and fragile, and it doesn’t protect common data that shouldn’t be changed, and it’s a huge task to maintain the data dictionary
I had the idea to replace this with a design using modules to share the global variables with use, only:, and a namelist to provide the command line capability. (Assume for this conversation the command line must be preserved.)
- Move all global variable names into a module and delete the global arrays.
- Replace all
equivalencestatements withuse, only: - Provide command line access using a
namelistand internalread
With these changes, all global variables will need be declared and dimensioned just once, and added to a namelist once, hopefully in the same module file and even on the same line. Anywhere they need to be used, they are brought in explicitly by name with use, only:.
I got this design concept working in a small example with all the globals and namelist in a single module. But it won’t scale up, because this code has hundreds of files, and I don’t want to rebuild the entire code every time I touch the global module. Instead I want to split it into a smaller topical modules, whose namelists are public and in turn are used by the command line module. Since multiple namelist statements referring to the same group just continue adding to the same group, ideally I would like to build up a single namelist group from all these separate modules. But gfortran doesn’t combine namelist groups with the same name when they are accessed by use-association.
The following code is my proof of concept, but it doesn’t compile because the globals namelist group is an ambiguous reference brought in from both topical_module_1 and topical_module_2 separately, rather than combining to a single group. The code compiles if you uncomment the lines that rename the global namelists to g1 and g2, uncomment the corresponding read statements, while commenting out the references to globals. (As an aside, it’s interesting that a renamed namelist group still reads in using its original name, i.e. a read statement with the renamed group nml=g1 reads a namelist starting with &globals.)
Is it impossible to create a single namelist group with statements distributed across program units? The documentation I could find it not really clear on this.
Is there a better way to modernize the old code?
module topical_module_1
implicit none
private
real, public :: x1
public :: globals
namelist / globals / x1
end module topical_module_1
module topical_module_2
implicit none
private
real, public :: x2
public :: globals
namelist / globals / x2
end module topical_module_2
module command_line_module
use topical_module_1, only: globals
use topical_module_2, only: globals
!use topical_module_1, only: g1 => globals
!use topical_module_2, only: g2 => globals
implicit none
private
public :: read_user_input
public :: print_values
contains
subroutine read_user_input
use iso_fortran_env, only: error_unit
implicit none
character(256) :: input
character(:), allocatable :: morsel
character(:), allocatable :: nmlstring
character(256) :: iomessage
integer :: iostatus
write(*,'(a)',advance='no') '> '
read(*,'(a)') input
morsel = adjustl(trim(input))
write(*,'(2a)') '>> ',morsel
nmlstring = '&globals '//trim(morsel)//' /'
read(nmlstring,nml=globals,iostat=iostatus,iomsg=iomessage)
if (iostatus /= 0) then
write(error_unit,'("iostatus ",g0,": ",2(a,/))') iostatus, trim(iomessage), trim(nmlstring)
end if
!read(nmlstring,nml=g1,iostat=iostatus,iomsg=iomessage)
!if (iostatus /= 0) then
! write(error_unit,'("g1 iostatus ",g0,": ",2(a,/))') iostatus, trim(iomessage), trim(nmlstring)
!end if
!
!read(nmlstring,nml=g2,iostat=iostatus,iomsg=iomessage)
!if (iostatus /= 0) then
! write(error_unit,'("g2 iostatus ",g0,": ",2(a,/))') iostatus, trim(iomessage), trim(nmlstring)
!end if
deallocate(morsel)
deallocate(nmlstring)
end subroutine read_user_input
subroutine print_values
use topical_module_1, only: x1
use topical_module_2, only: x2
implicit none
write(*,*) 'x1 = ',x1
write(*,*) 'x2 = ',x2
end subroutine print_values
end module command_line_module
! main program
use command_line_module, only: read_user_input
use command_line_module, only: print_values
implicit none
call print_values
do
call read_user_input
call print_values
end do
end