Will temporary arrays in subroutines be reallocated on each call? - fortran

If I have a loop like
do i = 1,much
call computations(input(i,:),output(i,:))
enddo
and
subroutine computations(inn,outt)
real, intent(in) :: inn(:)
real, intent(out) :: outt(:)
real :: temp(size(inn))
...
end subroutine
will the array temp be allocated and deallocated on each call? We can assume that the size of input and output are not changing. If I did not have a subroutine but rather inline code in the loop, then this array would have to be defined higher up, and would not be reallocated on each loop iteration. Will the compiler realize this? Does it depend on optimization level/compiler?

Yes, the array will be allocated on each call. However, if it is allocated on the stack, the allocation is essentially free (just updating the stack pointer). One can never be sure about compiler optimizations unless you specify the compiler and the version, but I am not aware of any optimization like this, that would be very complicated. And also we would have to know the size of the array and whether the compiler allocates on the stack or on the heap.
If the subroutine is internal, you can allocate the array higher up. You can also allocate it higher up and pass it as an argument. But only do that if it really brings anything. If it is a rather small stack array, it would not achieve much.

Related

Fortran Deallocate x function

In Fortran coding language, what is Deallocate(x) is used for? x variable is an array. I heard it deletes all the elements in it. Is it true?
One of its example:
Toplam = 0.0
DO K = 1, N
Toplam = (Ort - X(K))**2
END DO ! bellek bloğu boşaltılıyor
DEALLOCATE(X)
Std_Sap = SQRT(Toplam/(N-1))
PRINT *,"Ortalama : ",Ort
PRINT *,"Standart sapma: ",Std_Sap END PROGRAM Ortalama
The linked question When is array deallocating necessary? is very closely related and I will try to avoid repeating points raised there and strictly just answer the main point "What does deallocate() actually do"?
Allocatable variables (scalars and arrays) are just handles or references. They do not actually refer to any part of memory untill they are allocated using allocate(). This allocation gives them some part of memory that they occupy. At that moment the status changes from "not allocated" to "allocated". (You can query the status using the allocated() function.)
If you have an allocated allocatable (e.g. allocatable array), you can deallocate it using deallocate(). This deallocation takes the memory back from the variable/array. The variable is now "not allocated" and contains no data elements. It does not have any array size, you cannot read it, write to it, you cannot even print the size() or shape(), it is just "not allocated" - that's all. It does not any longer refer to any particular memory.
You use the word "deleted" in your question. The memory might not be overwritten and the values that had been stored there could remain there. But they no longer belong to that array and the memory may be given to some other allocatable or pointer variable.
As the linked answers show, in some situations the deallocation is performed automatially.

How to use allocatable character in a Fortran common block? [duplicate]

is it possible to assign the size and values of a common array in a subroutine and then use it from other subroutines of the program?
The following program doesn't work, but I want to do something like this:
main.f
program main
integer n
integer, allocatable :: co(:)
common n, co
call assign
print *, co(1), co(2)
deallocate(co)
stop
end program main
assign.f
subroutine assign
integer n
integer, allocatable :: co(:)
common n, co
n = 2
allocate(co(n))
co(1) = 1
co(2) = 2
return
end subroutine assign
No. You can put pointers into common, but not allocatables.
The reason is that a concept fundamental to common is storage association, where you can make a contiguous sequence of all the things that are in the common and those sequences are then shared amongst scopes. Allocatables can have their size vary dynamically in a scope, which would make the tracking in the sequence of things in the common block that came after the allocatable rather difficult.
(Typical implementation of allocatables means that the storage directly associated with the allocatable is just a descriptor - the actual data is kept elsewhere. This practically breaks the concept of a contiguous sequence of storage units, given that the allocation status (as recorded in the descriptor) and the data are both part of the value of the allocatable. The implementation for pointers is similar, but then conceptually the data that is elsewhere in memory is not part of the value of the pointer, so it should not be expected to appear in the contiguous sequence that the common describes - the pointer is in the sequence, but not what it points at.)
Allocatables require F90. That means that you can use module variables - which are a far better solution than the use of common for global data. If you must do this using common, then use a data pointer.

Fortran runtime warning: temporary array

I get the fortran runtime warning "An array temporary was created" when running my code (compiled with gfortran) and I would like to know if there is a better way to solve this warning.
My original code is something like this:
allocate(flx_est(lsign,3))
allocate(flx_err(lsign,3))
do i=1,lsign
call combflx_calc(flx_est(i,:),flx_err(i,:))
enddo
Inside the subroutine I define the variables like this:
subroutine combflx_calc(flx_est,flx_err)
use,intrinsic :: ISO_Fortran_env, only: real64
implicit none
real(real64),intent(inout) :: flx_est(3),flx_err(3)
flux_est and flx_err vectors may change inside the subroutine depending on several conditions and I need to update their values accordingly.
Fortran does not seem to like this structure. I can solve it defining temporary variables:
tmp_flx_est=flx_est(i,:)
tmp_flx_err=flx_err(i,:)
call combflx_calc(tmp_flx_est,tmp_flx_err)
flx_est(i,:)=tmp_flx_est
flx_err(i,:)=tmp_flx_err
But it seems to me quite a silly way to fix it.
As you may see I'm not an expert with Fortran, so any help is more than welcome.
One way is to pass an assumed shape array
real(real64),intent(inout) :: flx_est(:),flx_err(:)
the other is to exchange the dimensions of your array, so that you can pass a contiguous section of the 2D array.
call combflx_calc(flx_est(:,i),flx_err(:,i))
The problem is that the explicit size dummy arguments of your procedure (var(n)) require contiguous arrays. The assumed shape arrays can have some stride.
Your array temporary is being created because you are passing a strided array to your subroutine. Fortran arrays are column major so the leftmost index varies fastest in an array, or better said, the leftmost index is contiguous in memory and each variable to the right is strided over those to the left.
When you call
call combflx_calc(flx_est(i,:),flx_err(i,:))
These slices are arrays of your 3-vector strided by the length of lsign. The subroutine expects variables of a single dimension contiguous in memory, which the variable you pass into it is not. Thus, a temporary must be made for the subroutine to operate on and then copied back into your array slice.
Your "fix" does not change this, it just not longer warns about a temporary because you are using an explicitly created variable rather than the runtime doing it for you.
Vladimir's answer gives you options to avoid the temporary, so I will not duplicate them here.

fortran: I have big local arrays, would it maybe be more efficient to make them global and allocate them beforehand?

I have this question. I noticed my fortran 90 program has many subroutines that allocate big matrices in some subroutine. These matrices are local and therefore only used in that subroutines. However, I call that subroutine thousands or more of times. Is their an overhead on doing that? In the sense: does the subroutine allocate at any call the big local matrix? So maybe it would be more efficient to allocate the variables on the main program and either pass it as an argument or putting it in a module? Or no advantage on doing that?
Thanks
Alberto
The allocation will most likely occur every time you call the subroutine. Depending on how much time is spent inside the subroutine for each call, it may or may not induce significant overhead. Time it and find out! There are some timing routines such as secnds and cpu_time. My own preference is to allocate a buffer beforehand and avoid unnecessary reallocations.

Fortran arrays and subroutines (sub arrays)

I'm going through a Fortran code, and one bit has me a little puzzled.
There is a subroutine, say
SUBROUTINE SSUB(X,...)
REAL*8 X(0:N1,1:N2,0:N3-1),...
...
RETURN
END
Which is called in another subroutine by:
CALL SSUB(W(0,1,0,1),...)
where W is a 'working array'. It appears that a specific value from W is passed to the X, however, X is dimensioned as an array. What's going on?
This is non-uncommon idiom for getting the subroutine to work on a (rectangular in N-dimensions) subset of the original array.
All parameters in Fortran (at least before Fortran 90) are passed by reference, so the actual array argument is resolved as a location in memory. Choose a location inside the space allocated for the whole array, and the subroutine manipulates only part of the array.
Biggest issue: you have to be aware of how the array is laid out in memory and how Fortran's array indexing scheme works. Fortran uses column major array ordering which is the opposite convention from c. Consider an array that is 5x5 in size (and index both directions from 0 to make the comparison with c easier). In both languages 0,0 is the first element in memory. In c the next element in memory is [0][1] but in Fortran it is (1,0). This affects which indexes you drop when choosing a subspace: if the original array is A(i,j,k,l), and the subroutine works on a three dimensional subspace (as in your example), in c it works on Aprime[i=constant][j][k][l], but in Fortran in works on Aprime(i,j,k,l=constant).
The other risk is wrap around. The dimensions of the (sub)array in the subroutine have to match those in the calling routine, or strange, strange things will happen (think about it). So if A is declared of size (0:4,0:5,0:6,0:7), and we call with element A(0,1,0,1), the receiving routine is free to start the index of each dimension where ever it likes, but must make the sizes (4,5,6) or else; but that means that the last element in the j direction actually wraps around! The thing to do about this is not use the last element. Making sure that that happens is the programmers job, and is a pain in the butt. Take care. Lots of care.
in fortran variables are passed by address.
So W(0,1,0,1) is value and address. so basically you pass subarray starting at W(0,1,0,1).
This is called "sequence association". In this case, what appears to be a scaler, an element of an array (actual argument in caller) is associated with an array (implicitly the first element), the dummy argument in the subroutine . Thereafter the elements of the arrays are associated by storage order, known as "sequence". This was done in Fortran 77 and earlier for various reasons, here apparently for a workspace array -- perhaps the programmer was doing their own memory management. This is retained in Fortran >=90 for backwards compatibility, but IMO, doesn't belong in new code.