Better way to mask a Fortran array? - arrays

I am wanting to mask a Fortran array. Here's the way I am currently doing it...
where (my_array <=15.0)
mask_array = 1
elsewhere
mask_array = 0
end where
So then I get my masked array with:
masked = my_array * mask_array
Is there a more concise way to do this?

Use the MERGE intrinsic function:
masked = my_array * merge(1,0,my_array<=15.0)

Or, sticking with where,
masked = 0
where (my_array <=15.0) masked = my_array
I expect that there are differences, in speed and memory consumption, between the use of where and the use of merge but off the top of my head I don't know what they are.

There are two different approaches already given here: one retaining where and one using merge. In the first, High Performance Mark mentions that there may be differences in speed and memory use (think about temporary arrays). I'll point out another potential consideration (without making a value judgment).
subroutine work_with_masked_where(my_array)
real, intent(in) :: my_array(:)
real, allocatable :: masked(:)
allocate(masked(SIZE(my_array)), source=0.)
where (my_array <=15.0) masked = my_array
! ...
end subroutine
subroutine work_with_masked_merge(my_array)
real, intent(in) :: my_array(:)
real, allocatable :: masked(:)
masked = MERGE(my_array, 0., my_array<=15.)
! ...
end subroutine
That is, the merge solution can use automatic allocation. Of course, there are times when one doesn't want this (such as when working with lots of my_arrays of the same size: there are often overheads when checking array sizes in these cases): use masked(:) = MERGE(...) after handling the allocation (which may be relevant even for the question code).

I find it useful to define a function where which takes an array of logicals and returns the integer indices of the .true. values, so e.g.
x = where([.true., .false., .false., .true.]) ! sets `x` to [1, 4].
This function can be defined as
function where(input) result(output)
logical, intent(in) :: input(:)
integer, allocatable :: output(:)
integer :: i
output = pack([(i, i=1, size(input))], input)
end function
With this where function, your problem can be solved as
my_array(where(my_array>15.0)) = 0
This is probably not the most performant way of doing this, but I think it is very readable and concise. This where function can also be more flexible than the where intrinsic, as it can be used e.g. for specific dimensions of multi-dimensional arrays.
Limitations:
Note however that (as #francescalus points out) this will not work for arrays which are not 1-indexed. This limitation cannot easily be avoided, as performing comparison operations on such arrays drops the indexing information, e.g.
real :: my_array(-2,2)
integer, allocatable :: indices(:)
my_array(-2:2) = [1,2,3,4,5]
indices = my_array>3
write(*,*) lbound(indices), ubound(indices) ! Prints "1 5".
For arrays which are not 1-indexed, in order to use this where function you would need the rather ugly
my_array(where(my_array>15.0)+lbound(my_array)-1) = 0

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.

Assign complex array from real arrays in Fortran [duplicate]

I want to assign complex array as variable.
My code is like
complex indx(3,3)
integer i,j
do i=1,3
do j=1,3
indx(i,j) = (i,j)
write(*,*) indx(i,j)
end do
end do
and in this case I am getting an error like
A symbol must be a defined parameter in this context. [I]
indx(i,j) = (i,j)
You must use function cmplx to build a complex value you want to assign.
complex indx(3,3)
integer i,j
do i=1,3
do j=1,3
indx(i,j) = cmplx(i,j)
write(*,*) indx(i,j)
end do
end do
The syntax you tried is only valid for constant literals.
The answer by Vladimir F tells the important part: for (i,j) to be a complex literal constant i and j must be constants.1 As stated there, the intrinsic complex function cmplx can be used in more general cases.
For the sake of some variety and providing options, I'll look at other aspects of complex arrays. In the examples which follow I'll ignore the output statement and assume the declarations given.
We have, then, Vladimir F's correction:
do i=1,3
do j=1,3
indx(i,j) = CMPLX(i,j) ! Note that this isn't in array element order
end do
end do
We could note, though, that cmplx is an elemental function:
do i=1,3
indx(i,:) = CMPLX(i,[(j,j=1,3)])
end do
On top of that, we can consider
indx = RESHAPE(CMPLX([((i,i=1,3),j=1,3)],[((j,i=1,3),j=1,3)]),[3,3])
where this time the right-hand side is in array element order for indx.
Well, I certainly won't say that this last (or perhaps even the second) is better than the original loop, but it's an option. In some cases it could be more elegant.
But we've yet other options. If one has compiler support for complex part designators we have an alternative for the first form:
do i=1,3
do j=1,3
indx(i,j)%re = i
indx(i,j)%im = j
end do
end do
This doesn't really give us anything, but note that we can have the complex part of an array:
do i=1,3
indx(i,:)%re = [(i,j=1,3)]
indx(i,:)%im = [(j,j=1,3)]
end do
or
do i=1,3
indx(i,:)%re = i ! Using scalar to array assignment
indx(i,:)%im = [(j,j=1,3)]
end do
And we could go all the way to
indx%re = RESHAPE([((i,i=1,3),j=1,3))],[3,3])
indx%im = RESHAPE([((j,i=1,3),j=1,3))],[3,3])
Again, that's all in the name of variety or for other applications. There's even spread to consider in some of these. But don't hate the person reviewing your code.
1 That's constants not constant expresssions.

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).

Parsing a complicated function using MKL/VML

I am trying to calculate a fairly complicated function, say func() - involving several additions, substractions, multiplications, divisions and trigonometric functions, of several two-dimensional arrays in fortran. The calculation is massively parrallel, in that each func() is independent over its row and column location. Each of the matrices is many gigabytes in size, and there are about a dozen of them as arguments.
I would like to make use of Intel MKL functions (invoking --mkl-parallel), in particular VML functions to add, subtract, divide etc. My question is: how can I render a complicated functional expression such as,
e.g.: func(x,y,z) = x*y+cos(z*x-x) where x,y,z are 2d arrays of several GB
in terms of VML functions but using more familiar binary operators. You see my problem requires, in principle, converting all the binary operators, such as "+" and "*" into binary functions taking arguments as ?vadd(x,y). Of course this would be very cumbersome and unsightly for large expressions. Is there a way to overload the binary arithmetic operators such as "+","-" to preferentially use MKL/VML versions in fortran. An example would be nice! Thanks!
I know this answer is a little bit off-topic.
Since all the operations are element-wise and your operations are simple, the func() could be a memory bandwidth bounded task. In this case, using VML may not be a good choice to maximum the performance.
Suppose each of your arrays is of 10GB in size, uisng VML as follows will need at least 9 x 10GB reading and 5 x 10GB writing.
func(...) {
tmp1=x*z
tmp1=tmp1-x;
tmp1=cos(tmp1);
tmp2=x*y;
return tmp1+tmp2;
}
where all the operations all overloaded for 2d array.
Instead you may find the following approach has much less memory access (3 x 10GB reading and 1 x 10GB writing) thus could be quicker (pseudo code).
$omp parallel for
for i in 1 to m
for j in 1 to n
result(i,j)= x(i,j)*y(i,j)+cos(z(i,j)*x(i,j)-x(i,j));
end
end
I developped a small example to show the addition of two vectors. As I don't have MKL installed anymore, I used the SAXPY command from BLAS. The principle should be the same.
At first you define a module with the appropriate definitions. In my case this would be an assignment to save a real array in my datatype (this is only a convenience function as you could also directly access the array variable) and the definition of the addition. Both are a new overload to the + operator and = assignment.
In the program, I define three fields. Two of them get assigned with random numbers and then added to get the third field. Then the first two fields get stored in my special variables, and the result of this addition is stored in a third variable of this type.
Finally, the result is compared by accessing the array directly. Please note, that the assignment from custom datatype to the same datatype is already defined (e.g. ffield3 = ffield1 is already defined.)
My module:
MODULE fasttype
IMPLICIT NONE
PRIVATE
PUBLIC :: OPERATOR(+), ASSIGNMENT(=)
TYPE,PUBLIC :: fastreal
REAL,DIMENSION(:),ALLOCATABLE :: array
END TYPE
INTERFACE OPERATOR(+)
MODULE PROCEDURE fast_add
END INTERFACE
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE fast_assign
END INTERFACE
CONTAINS
FUNCTION fast_add(fr1, fr2) RESULT(fr3)
TYPE(FASTREAL), INTENT(IN) :: fr1, fr2
TYPE(FASTREAL) :: fr3
INTEGER :: L
L = SIZE(fr2%array)
fr3 = fr2
CALL SAXPY(L, 1., fr1%array, 1, fr3%array, 1)
END FUNCTION
SUBROUTINE fast_assign(fr1, r2)
TYPE(FASTREAL), INTENT(OUT) :: fr1
REAL, DIMENSION(:), INTENT(IN) :: r2
INTEGER :: L
IF (.NOT. ALLOCATED(fr1%array)) THEN
L = SIZE(r2)
ALLOCATE(fr1%array(L))
END IF
fr1%array = r2
END SUBROUTINE
END MODULE
My program:
PROGRAM main
USE fasttype
IMPLICIT NONE
REAL, DIMENSION(:), ALLOCATABLE :: field1, field2, field3
TYPE(fastreal) :: ffield1, ffield2, ffield3
ALLOCATE(field1(10),field2(10),field3(10))
CALL RANDOM_NUMBER(field1)
CALL RANDOM_NUMBER(field2)
field3 = field1 + field2
ffield1 = field1
ffield2 = field2
ffield3 = ffield1 + ffield2
WRITE(*,*) field3 == ffield3%array
END PROGRAM

Resources