fortran access routine inside "contains" statement in separate routine - static

I am trying to reset the save variable inside a routine, a way I theorize going around this is having a reset() function that zeros out the data inside, however I cannot directly call this function as it is inside the "contains" keyword, is there a way to override this protection? I've looked into "interface" and "external" keywords but the documentation for this particular question seems sparce
program main
implicit none
call count ! 1
call count ! 2
call count ! 3
! cannot make a call to reset
! is there any way to remove this
! protection and access this directly?
call reset
call count ! 1 etc...
end program main
subroutine count
integer, save :: numcalled = 0
numcalled = numcalled + 1
print *, numcalled
return
contains
subroutine reset
numcalled = 0
end subroutine reset
end subroutine count
This is a small example to get the idea of what I aim to do to a project with a bunch of "save" variables and I need to reset these as this code will be called several times and stuff needs to be fresh for each function call (no static variables floating around with bad state), if I can override this protection to access subroutines inside a "contains" keyword this would be a very minimally invasive task

The procedure declared after contains is an internal procedure. It cannot be called from the outside world. There is no way.
You would have to store the data in a module and have a reset module procedure
module subs
implicit none
integer, save :: numcalled = 0
contains
subroutine count
numcalled = numcalled + 1
print *, numcalled
end subroutine count
subroutine reset
numcalled = 0
end subroutine reset
end module
or have a special argument to your count subroutine to tell it it should call its reset function for you.
subroutine count(do_reset)
integer, save :: numcalled = 0
logical :: do_reset
if (do_reset) call reset
numcalled = numcalled + 1
print *, numcalled
return
contains
subroutine reset
numcalled = 0
end subroutine reset
end subroutine count
You can make the argument optional. You can also return from the subroutine after calling reset without executing the rest of the code.
Anyway, no matter what solution you choose, all procedures should be in modules if there is no specific reason against.

The program you present is a great example of how giving functions state can lead to problems. When you just need state to persist forever on a single thread, functions with state are okay, but if you need to modify / reset the state, or if you are using multiple threads or multiple "instances" of the function, saved variables are usually too inflexible.
A flexible alternative would be to use a Counter class, which exposes your count function, and also has a reset function. This allows you to modify the state as desired, and also to have multiple instances of the class in multiple parts of your code without having to worry about shared state.
This would look something like
module counter_mod
implicit none
type :: Counter
integer, private :: counter_ = 0
procedure, public :: count
procedure, public :: reset
end class
contains
subroutine count(this)
class(Counter), intent(inout) :: this
this%counter_ = this%counter_ + 1
print *, this%counter_
end subroutine
subroutine reset(this)
class(Counter), intent(inout) :: this
this%counter_ = 0
print *, this%counter_
end subroutine
end module
and then your program would look like
program main
use counter_mod
implicit none
Counter my_counter
call my_counter%count() ! 1
call my_counter%count() ! 2
call my_counter%count() ! 3
call my_counter%reset() ! 0
call my_counter%count() ! 1 etc...
! And then you can have another counter.
Counter another_counter
call another_counter%count() ! 1
call my_counter%count() ! 2
call my_counter%reset() ! 0
call another_counter%count() ! 2
end program main

Insofar as you are changing the state of something (a counter) then an object-oriented approach seems more
natural.
Either way, to get to a separate routine you would need modules, as already pointed out.
One nice way to set or reset the variable if required might be to use an optional argument, as in the routine below.
If so, then you still need an explicit interface, for which a module is still the easiest standard way of providing it.
BTW, if you use the variable name COUNT then I think you are probably hiding a standard library routine.
Code to use an optional argument to set or reset the counter to whatever you like:
module mods
implicit none
contains
subroutine counter( startValue )
integer, optional :: startValue
integer, save :: numcalled = 0
if ( present( startValue ) ) then
numcalled = startValue
else
numcalled = numcalled + 1
print *, numcalled
end if
end subroutine counter
end module mods
!=================================================
program main
use mods, only: counter
implicit none
call counter ! 1
call counter ! 2
call counter ! 3
call counter( 0 )
call counter ! 1
call counter ! 2
call counter ! 3
call counter( 100 )
call counter ! 101
call counter ! 102
call counter ! 103
end program main
1
2
3
1
2
3
101
102
103

Related

How can a Fortran program that iterates over an array and distributes the corresponding entries among a set of subroutines be designed efficiently?

I have a fortran subroutine that receives a large unsorted array of a certain type and needs to call other subroutines that are responsible for parsing and storing each item depending on one of the values declared inside of it.
In my previous post, I shared a program that does just that but had a few design flaws, like allocating a large array for every type that needs to be parsed and only filling out the required values, or calling if (.not. allocated()) multiple times for every array element.
I have created another version of this program that addresses these downsides, but entails some other design paradigm issues that need to be improved upon:
module animal_farm
integer :: &
RABBIT_ID = 1, &
DOG_ID= 2, &
BIRD_ID= 3, &
HORSE_ID= 4, &
current_animal_id
type :: Animal
character(256) :: animal_type
integer :: &
age
end type Animal
type(Animal), dimension(:), allocatable, target :: & ! temporary arrays storing all the entries from large_animal_list for each animal
rabbit_entries, &
horse_entries, &
bird_entries, &
dog_entries
type(Animal), dimension(:), pointer :: &
current_animal_list
integer, dimension(:), allocatable :: animal_list_mapping
! this type and array is defined for every available animal, but only Rabbit is defined here to keep this example as simple as possible
type :: Rabbit
integer :: &
age, &
estimated_carrots_eaten ! parameters like this are defined differently for each animal, requiring a new *_params array for each type
end type Rabbit
type(Rabbit), dimension(:), allocatable :: & ! list of rabbit entries alongside parameters calculated specifically for rabbits
rabbit_params
integer, dimension(4) :: & ! number of available animals is 4
animal_ids, &
animal_counts, & ! temporary array to count the number of animals in large_animal_list
individual_animal_indeces ! temporary array that stores the current index of one of the animal specific lists
contains
subroutine parse_animals(large_animal_list)
type(Animal), dimension(:), intent(in) :: large_animal_list
integer :: i
allocate(animal_list_mapping(size(large_animal_list)))
animal_counts = 0
do i = 1, size(large_animal_list)
select case(large_animal_list(i)%animal_type)
case('rabbit')
current_animal_id = RABBIT_ID
case('horse')
current_animal_id = HORSE_ID
case('bird')
current_animal_id = BIRD_ID
case('dog')
current_animal_id = DOG_ID
end select
animal_counts(current_animal_id) = animal_counts(current_animal_id)+1
end do
allocate(rabbit_entries(animal_counts(RABBIT_ID)))
allocate(horse_entries(animal_counts(HORSE_ID)))
allocate(bird_entries(animal_counts(BIRD_ID)))
allocate(dog_entries(animal_counts(DOG_ID)))
individual_animal_indeces = 1
do i = 1, size(large_animal_list)
select case(large_animal_list(i)%animal_type)
case('rabbit')
current_animal_id = RABBIT_ID
current_animal_list => rabbit_entries
case('horse')
current_animal_id = HORSE_ID
current_animal_list => horse_entries
case('bird')
current_animal_id = BIRD_ID
current_animal_list => bird_entries
case('dog')
current_animal_id = DOG_ID
current_animal_list => dog_entries
end select
current_animal_list(individual_animal_indeces(current_animal_id))%age = large_animal_list(i)%age
animal_list_mapping(i) = individual_animal_indeces(current_animal_id)
individual_animal_indeces(current_animal_id) = animal_counts(current_animal_id)+1
end do
if (animal_counts(RABBIT_ID)>0) call parse_rabbit_information(rabbit_entries)
! if (animal_counts(HORSE_ID)>0) call parse_horse_information(horse_entries)
! if (animal_counts(BIRD_ID)>0) call parse_bird_information(bird_entries)
! if (animal_counts(DOG_ID)>0) call parse_dog_information(dog_entries)
end subroutine parse_animals
subroutine parse_rabbit_information(rabbit_entries)
type(Animal), dimension(:), intent(in) :: rabbit_entries
integer :: i
allocate(rabbit_params(size(rabbit_entries)))
do i=1, size(rabbit_entries)
rabbit_params(i)%age = rabbit_entries(i)%age
rabbit_params(i)%estimated_carrots_eaten = rabbit_entries(i)%age*10*365
end do
end subroutine parse_rabbit_information
subroutine feed_rabbit(animal_list_index)
integer, intent(in) :: animal_list_index
integer :: rabbit_params_index
rabbit_params_index = animal_list_mapping(animal_list_index)
rabbit_params(rabbit_params_index)%estimated_carrots_eaten = rabbit_params(rabbit_params_index)%estimated_carrots_eaten+1
end subroutine feed_rabbit
end module animal_farm
Program TEST
use animal_farm
type(Animal), dimension(10) :: my_animal_list
my_animal_list(1)%animal_type = "rabbit"
my_animal_list(1)%age = 5
my_animal_list(2)%animal_type = "dog"
my_animal_list(2)%age = 6
my_animal_list(3)%animal_type = "horse"
my_animal_list(3)%age = 1
my_animal_list(4)%animal_type = "rabbit"
my_animal_list(4)%age = 3
my_animal_list(5)%animal_type = "bird"
my_animal_list(5)%age = 4
my_animal_list(6)%animal_type = "horse"
my_animal_list(6)%age = 6
my_animal_list(7)%animal_type = "rabbit"
my_animal_list(7)%age = 2
my_animal_list(8)%animal_type = "rabbit"
my_animal_list(8)%age = 2
my_animal_list(9)%animal_type = "dog"
my_animal_list(9)%age = 4
my_animal_list(10)%animal_type = "horse"
my_animal_list(10)%age = 7
call parse_animals(my_animal_list)
call feed_rabbit(1)
call feed_rabbit(4)
End Program TEST
This version only calls each subroutine responsible for handling the different item types once, and passes an array that already has the correct size and can simply be allocated in the target subroutine. If possible, I would like to improve the following points:
The current solution involves the use of two loops, the first one where the number of occurrences for each item type is counted, and another where the now allocated arrays that are being passed to the subroutines are filled with the corresponding values. This requires the use of helper arrays such as animal_counts or individual_animal_indeces, which in turn also need to know how many different types of animals they need to account for (hardcoded to be 4 in the example). I also tried using some sort of linked-list structure to improve this, which allowed me to only use one loop, but the values corresponding to each type still need to be stored in an array of the correct size.
To address the issues from point 1., I thought about placing the defined *_ID variables in an array, so the helper arrays can be defined with integer, dimension(size(animal_id_array)). The defined *_ID variables are also being used as array indeces, which requires them to be defined by hand from 1-x. It is not very clean to have to add and remove ids from a list like this and redefine the array where they are stored, every time an id is added or removed. The generation of ids can be achieved with the enum, bind(c); enumerator operator, but to get to the number of ids you still need to create a separate array or hardcode the amount somewhere.
How can this program be modified to improve its performance and memory-efficiency without making it needlessly difficult to read and maintain?
How can this program be modified to improve its performance and memory-efficiency without making it needlessly difficult to read and maintain?
Working towards all three of these goals at once is almost always difficult, and sometimes outright impossible. Unless you have specific reasons to do otherwise, I would recommend first focussing on making your code easy to read and maintain, and only then trying to improve its performance and memory-efficiency. The latter step should only be done after profiling your code to see which bits actually need optimising.
With that in mind, let's see if we can simplify your code a bit. Since you already have a number of types, let's go full object-oriented, and introduce some polymorphism.
If we're inheriting Rabbit from Animal, we can avoid storing the animal_type field, and instead generate it using a type-bound procedure, something like
module animal_mod
implicit none
! Define the base Animal type.
type, abstract :: Animal
integer :: age
contains
procedure(animal_type_Animal), deferred, nopass :: animal_type
end type
! Define the interface for the `animal_type` functions.
interface
function animal_type_Animal() result(output)
character(256) :: output
end function
end interface
end animal_mod
and
module rabbit_mod
use animal_mod
implicit none
! Define the `Rabbit` type as an extension of the `Animal` type.
! Note that `Rabbit` has an `age` because it is an `Animal`.
type, extends(Animal) :: Rabbit
integer :: estimated_carrots_eaten
contains
procedure, nopass :: animal_type => animal_type_Rabbit
end type
contains
! Define the implementation of `animal_type` for the `Rabbit` type.
function animal_type_Rabbit() result(output)
character(256) :: output
output = "rabbit"
end function
end module
Now we want to be able to create an array of animals. Fortran doesn't allow polymorphic arrays, so we need to define a type which contains an animal and which can be made into an array. Something like
module animal_box_mod
use animal_mod
implicit none
type :: AnimalBox
class(Animal), allocatable :: a
end type
end module
We can now create an array of animals, e.g.
type(AnimalBox) :: animals(3)
animals(1)%a = Rabbit(age=3, estimated_carrots_eaten=0)
animals(2)%a = Frog(age=3, estimated_bugs_eaten=4, length=1.7786)
animals(3)%a = Mouse(age=4, estimated_cheese_eaten=7, coat="Yellow")
Instead of using a method like feed_rabbit(7), you can instead use a type-bound method. If we add this as
module rabbit_module
type, extends(Animal) :: Rabbit
... ! as above
contains
... ! as above
procedure :: feed
end type
contains
... ! as above
subroutine feed(this)
class(Rabbit), intent(inout) :: this
this%estimated_carrots_eaten = this%estimated_carrots_eaten + 1
end subroutine
end module
then we can call this using our animals array as
select type(a => animals(1)%a); type is(Rabbit)
a.feed()
end select

How to directly use the return of maxloc as index of an array [duplicate]

Is there possibility to use indexing directly on a function's return value? Something like this:
readStr()(2:5)
where readStr() is a function which returns a character string or an array. In many other languages it is quite possible, but what about Fortran? The syntax in my example of course does not compile. Is there any other syntax to be used?
No, that is not possible in Fortran. You could, however, alter your function to take an additional index array that determines which elements are returned. This example illustrates this possibility using an interface to allow for an optional specification of the indices (simplified greatly thanks to the comment by IanH):
module test_mod
implicit none
contains
function squareOpt( arr, idx ) result(res)
real, intent(in) :: arr(:)
integer, intent(in), optional :: idx(:)
real,allocatable :: res( : )
real :: res_( size(arr) )
integer :: stat
! Calculate as before
res_ = arr*arr
if ( present(idx) ) then
! Take the sub-set
allocate( res(size(idx)), stat=stat )
if ( stat /= 0 ) stop 'Cannot allocate memory!'
res = res_(idx)
else
! Take the the whole array
allocate( res(size(arr)), stat=stat )
if ( stat /= 0 ) stop 'Cannot allocate memory!'
res = res_
endif
end function
end module
program test
use test_mod
implicit none
real :: arr(4)
integer :: idx(2)
arr = [ 1., 2., 3., 4. ]
idx = [ 2, 3]
print *, 'w/o indices',squareOpt(arr)
print *, 'w/ indices',squareOpt(arr, idx)
end program
No.
But if it bothers you, you can write your own user defined functions and operators to achieve a similar outcome without having to store the result of the function reference in a separate variable.
You can avoid declaring another variable if you use associate. Whether it is any better or clearer than a temporary variable must be decided by the user. The result has to be stored somewhere anyway.
associate(str=>readStr())
print *, str(2:5)
end associate
It will not be very useful for this specific case with a potentially long string but might be more useful for other similar cases that get linked here as duplicates.

Creating a subset of an array of derived type in Fortran doesn't work, what am I missing?

I am having a problem trying to use subsets of an array containing instances of a type in Fortran. Creating the subset renders the contents garbage. Essentially it boils down to:
class(myType), allocatable :: instances(:)
...allocate/initialize instances here...
doSomethingWithInstances( instances ) ! Works
doSomethingWithInstances( instances((/1,2/)) ) ! Doesn't work
Here is a complete code that reproduces the problem, in this code the correct output is the values of the integers assigned to each of the instances i.e "3, 8, 16", when the subroutine is called on the subset (/1,2/) of the array it should therefore print "3, 8" however it instead prints "3, 192552":
module test
! Simple type contains integer
type :: myType
integer :: n
end type
contains
! Output the integer for myType t
subroutine saySomething(t)
class(myType) :: t
print *, t%n
end subroutine
end module
program main
use test
type(myType), allocatable :: instances(:)
! Declare an array of myType
allocate(instances(3))
instances(1) = myType(3)
instances(2) = myType(8)
instances(3) = myType(16)
! call saySomething for each element
! on the direct array and on the subset
! elements 1 and 2
print *, "Working:"
call saySomethingArray(instances)
print *, "Broken:"
call saySomethingArray(instances((/1,2/))) ! Here is the problem
contains
! Call saySomething on each element of the input array
subroutine saySomethingArray(instances)
class(myType) :: instances(:)
integer :: i
do i=1,size(instances)
call saySomething(instances(i))
enddo
end subroutine
end program
I wondered if it wasn't copying things correctly or something when it creates the subset, but I couldn't figure it out. Any help would be greatly appreciated :) cheers
In these cases please always tell us what is your compiler, its version and all flags used for compiling. This is a compiler bug. I can reproduce it with GCC 7. It runs correctly with Intel Fortran 16.
As a workaround, the error will go away if you declare instances in saySomethingArray as type instead of class. Also, printing the array as an array expression works correctly.
The problem also appears for other kinds of array expressions, not just vector subscripts.
Reported to GCC as https://gcc.gnu.org/bugzilla/show_bug.cgi?id=84074. Maybe it will turn up to be a duplicate of some earlier bug. This is the MCVE ([mcve]):
type :: t
integer :: n
end type
type(t) :: array(2) = [t(1),t(2)]
call sub(array((/1,2/)))
contains
subroutine sub(a)
class(t) :: a(:)
integer :: i
print *, "loop a(i) :"
do i=1,size(a)
print *,a(i)%n
enddo
print *, "a%n :",a%n
print *, "a(1:size(a))%n :",a(1:size(a))%n
end subroutine
end program
Output:
> gfortran-7 vecsubs2.f90
> ./a.out
loop a(i) :
2
0
a%n : 1 2
a(1:size(a))%n : 1 2

How to assign values to an array except certain elements in fortran?

I want to assign values to an array with a certain rule, except the 5th element due to divide-by-zero problem. The program is like follows:
program main
implicit none
real(8) :: a(10)
integer :: i
a(5) = 0d0
do i = 1, 10
if (i /= 5) then
a(i) = 1.0d0 / dble(i-5)
end if
write(*,*) a(i)
end do
stop
end program main
Is there a more smart/efficient way to do the same thing?
Thank you very much!
If you want to save the amount of source code:
program main
implicit none
integer, parameter :: dbl = kind(1.d0)
real(dbl) :: a(10)
integer :: i
do i = 1, 10
a(i) = 1._dbl / (i-5)
end do
a(5) = 0
! I expect you want to do something more than just this with the array
do i = 1, 10
write(*,*) a(i)
end do
end program
As francescalus points out this may cause your program to crash if floating point exceptions are enabled. Anyway, also notice other things I used, which can shorten your code. = 0 instead of = 0.d0, avoiding the dbl() (use real(x,dbl) instead if necessary) and so on.
If this code is repeated very often, you could also save some CPU time by avoiding the branch. In a typical initialization code it is irrelevant.

fortran loop a list of 2D arrays using pointers

i have allocated a lot of 2D arrays in my code, and I want each one array to read from a file named as array's name. The problem is that each array has different size, so I am looking for the most efficient way. The code is like this:
Module Test
USE ...
implicit NONE
private
public:: initializeTest, readFile
real(kind=8),dimension(:,:),allocatable,target:: ar1,ar2,ar3,ar4,ar5,...,ar10
real(kind=8),dimension(:,:),pointer:: pAr
CONTAINS
!
subroutine initializeTest
integer:: k1,k2,k3,k4,k5
integer:: ind1,ind2
allocate(ar1(k1,k1),ar2(k1,k2),ar3(k2,k4),ar4(k5,k5),...) !variable sizes
! here needs automatization - since its repeated
pAr => ar1
ind1 = size(pAr,1)
ind2 = size(pAr,2)
call readFile(par,ind1,ind2)
pAr => ar2
ind1 = size(pAr,1)
ind2 = size(pAr,2)
call readFile(par,ind1,ind2)
!....ar3, ... , ar9
pAr => ar10
ind1 = size(pAr,1)
ind2 = size(pAr,2)
call readFile(par,ind1,ind2)
end subroutine initializeTest
!
!
subroutine readFile(ar,row,col)
real(kind=8),dimension(row,col)
integer:: i,j,row,col
! it should open the file with same name as 'ar'
open(unit=111,file='ar.dat')
do i = 1, row
read(222,*) (ar(i,j),j=1,col)
enddo
end subroutine importFile
!
!
end module Test
If your arrays ar1, ar2, etc. had the same dimensions you could put them all in a 3-dimensional array. Since they have different dimensions, you can define a derived type, call it a "matrix", with an allocatable array component and then create an array of that derived type. Then you can read the i'th matrix from a file such as "input_1.txt" for i=1.
The program below, which works with g95 and gfortran, shows how the derived type can be declared and used.
module foo
implicit none
type, public :: matrix
real, allocatable :: xx(:,:)
end type matrix
end module foo
program xfoo
use foo, only: matrix
implicit none
integer, parameter :: nmat = 9
integer :: i
character (len=20) :: fname
type(matrix) :: y(nmat)
do i=1,nmat
allocate(y(i)%xx(i,i))
write (fname,"('input_',i0)") i
! in actual code, read data into y(i)%xx from file fname
y(i)%xx = 0.0
print*,"read from file ",trim(fname)
end do
end program xfoo
As far as I know, extracting the name of the variable from the variable at runtime isn't going to work.
If you need lots of automation for the arrays, consider using an array of a derived type, as one other answer suggests, in order to loop over them both for allocation and reading. Then you can enumerate the files, or store a label with the derived type.
Sticking to specific array names, an alternative is to just read/write the files with the required name as an argument to the routine:
Module Test
...
! here needs automatization - since its repeated
call readFile(ar1,'ar1')
call readFile(ar2,'ar2')
!....ar3, ... , ar9
call readFile(ar10,'ar10')
end subroutine initializeTest
subroutine readFile(ar,label)
real(kind=8) :: ar(:,:)
character(len=*) :: label
integer:: i,j,nrow,ncol,fd
nrow=size(ar,1)
ncol=size(ar,2)
open(newunit=fd,file=label)
do i = 1, row
read(fd,*) (ar(i,j),j=1,col)
enddo
end subroutine readFile
end module Test
Some unsollicited comments: I don't really get why (in this example) readFile is public, why the pointers are needed? Also, kind=8 shouldn't be used (Fortran 90 kind parameter).

Resources