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

Question

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?

Answer 1

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