module TestMod
implicit none
type, public :: SharedData
integer, allocatable :: var(:)
end type SharedData
type, public :: F1
type(SharedData), pointer :: share => null()
end type F1
type, public :: F2
type(SharedData), pointer :: share => null()
end type F2
type, public ::TotalData
type(SharedData) :: share
type(F1) :: f1
type(F2) :: f2
end type TotalData
contains
subroutine allocate_total(total)
type(TotalData), intent(inout) :: total
integer :: i
allocate(total%share%var(10))
do i = 1, 10
total%share%var(i) = i + 1
end do
total%f1%share => total%share
total%f2%share => total%share
return
end subroutine allocate_total
subroutine deallocate_total(total)
type(TotalData), intent(inout) :: total
nullify(total%f1%share)
nullify(total%f2%share)
deallocate(total%share%var)
return
end subroutine deallocate_total
end module TestMod
program MyTest
use TestMod
implicit none
type(TotalData) :: total
integer :: i
call allocate_total(total)
do i = 1, 10
print *, total%share%var(i)
end do
do i = 1, 10
print *, total%f1%share%var(i)
end do
do i = 1, 10
print *, total%f2%share%var(i)
end do
call deallocate_total(total)
return
end program MyTest
Basically, I will need to do something within F1, something else within F2, and some others within TotalData. All will need SharedData, but as the name suggests, they all share one copy.
In the real case, the SharedData is large, so I donāt want to copy it. Then I came to the idea to put the real data in TotalData, and access with pointers in F1 and F2. However, the above code will not compile, because
Error: Pointer assignment target is neither TARGET nor POINTER at (1)
It works, thanks. Besides, how about the second question? Are there better ways to do it? Iām under the impression that many people only use pointers in Fortran for C interoperability, so I suppose pointers can be avoided in this case?
Also, the declaration of total in the main program needs the target attribute. Otherwise, in principle, temporary copies can be used for the dummy argument association.
Another general approach that can be used is to define an allocatable component within f1 and f2, and then right before f1 is used, a move_alloc() is used to move the allocation into f1, and upon return it is moved back to the total derived type. This avoids the downsides of pointers, but it puts more burden on the programmer to do the shallow copies in the right order.
Can move_alloc() be used on derived types as a whole? I suppose it can only be used on arrays. In the real case, there will be many arrays in SharedData, and it will tedious if I have to manually move_alloc() all of them.
C and Fortran pointers are related, but not the same (e.g., you cannot do p => t(2::2) in C). Pointers need the target attribute, which may inhibit optimizations.
āBetterā depends on your actual use case. Maybe you can think of TotalData as an object that implements some algorithm, with its sub-algorithms needing some āwrappingā:
module TestMod
implicit none
private
type, public :: SharedData
integer, allocatable :: var(:)
end type SharedData
type, public :: F1
integer :: f1_data = 1
contains
procedure :: do_thing => do_f1_thing
end type F1
type, public :: F2
integer :: f2_data = 2
contains
procedure :: do_thing => do_f2_thing
end type F2
type, public ::TotalData
private
type(SharedData) :: share
type(F1) :: f1
type(F2) :: f2
contains
private
procedure, public :: run_algorithm
procedure :: do_f1_thing => do_f1_thing_with_shared
procedure :: do_f2_thing => do_f2_thing_with_shared
end type TotalData
public allocate_total
public deallocate_total
contains
subroutine allocate_total(total)
type(TotalData), intent(inout) :: total
integer :: i
allocate(total%share%var(10))
do i = 1, 10
total%share%var(i) = i + 1
print '("share(",i0,") = ",g0)', i, total%share%var(i)
end do
end subroutine allocate_total
subroutine deallocate_total(total)
type(TotalData), intent(out) :: total
! deallocate(total%share%var)
end subroutine deallocate_total
subroutine do_f1_thing(this, share)
class(F1), intent(inout) :: this
type(SharedData), intent(in) :: share
print *, 'F1 sum = ', sum(this%f1_data * share%var)
end subroutine
subroutine do_f2_thing(this, share)
class(F2), intent(inout) :: this
type(SharedData), intent(in) :: share
print *, 'F2 sum = ', sum(this%f2_data * share%var)
end subroutine
subroutine run_algorithm(this)
class(TotalData), intent(inout) :: this
call this%do_f1_thing()
call this%do_f2_thing()
end subroutine
subroutine do_f1_thing_with_shared(this)
class(TotalData), intent(inout) :: this
call this%f1%do_thing(this%share)
end subroutine
subroutine do_f2_thing_with_shared(this)
class(TotalData), intent(inout) :: this
call this%f2%do_thing(this%share)
end subroutine
end module TestMod
program MyTest
use TestMod
implicit none
type(TotalData) :: total
integer :: i
call allocate_total(total)
call total%run_algorithm()
call deallocate_total(total)
end program MyTest
Sorry but I went to sleep by then. Indeed pointers are mostly used to avoid copies. There is nothing particularly wrong with your design. Another option would be simply passing shared data as a dummy argument when your computational routine is called, but that could increase number of arguments very fast.
In Python it is a commonly seen pattern to add a reference to some particular data structure to avoid passing it every time when calling computations. Unfortunately, Fortran much more prefers single-ownership of data, and pointers are really only used when that would be non feasible.
From my observation, some Fortran projects mostly use modular varibles to store data, instead of construct objects of derived types. The example will be somehow like
module SharedData
implicit none
integer, allocatable :: var(:)
end module TestMod
module F1Mod
use SharedData, only : var
end module F1Mod
module F2Mod
use SharedData, only : var
end module F2Mod
program MyTest
use SharedData, only : var
use F1Mod
use F2Mod
implicit none
allocate(var(10))
! call F1Mod subroutines
! call F2Mod subroutines
deallocate(var)
return
end program MyTest
This approach can be rationalized by the fact that for heavy scientific computation problems, usually only one task will be run in one process. However, I feel that this approach is rarely used in other software programming languages, where the usage of global variables are usually discouraged?
Anyway, in my opinion, performance is the most important for these use cases, and Iām curious about how much compilers will behave differently among these designs. Iām concerned about the claim of @jwmwalrus that āPointers need the target attribute, which may inhibit optimizationsā. Does this mean that the pointer version may be slower?
One reason I can think of is concurrency and the avoidance of race conditions. E.g., C has re-entrant versions of some functions, thus avoiding static access.
Although itās not just in other languages: In Fortran, the PURE prefix helps in making access to module variables read-only (in Fortran 2023, things went further with SIMPLE procedures, which isolate said procedure from the environment that CONTAINS it). And since Fortran 2018 made RECURSIVE the default behavior, the SAVE attribute/statement is out of the question.
In the case TARGET arguments possibly inhibiting certain optimizations, I was referring to the concept of aliasing. The TARGET attribute tells the compiler that there may be more than one way to access that variable.
Btw, C has a ārestrictā keyword that does the opposite āi.e., tells the compiler that, at the time of invocation, no other pointer is pointing to that same location.