I would like to know how to assign two pointers, one to the real part of a complex 3d array and another to the imaginary part of the same array in Fortran.
Let's say I have defined a 3d array as such:
complex*16, dimension(:,:,:), allocatable, target :: vftmp
and I would like to assign a pointer to the real part of vftmp(2,1,1) and a pointer to the imaginary part of vftmp(2,1,1). Could someone help me with a snippet please? Thanks.
I hope something like the following is possible
real, pointer :: re
complex, target :: z
re => z % re
! or
real, pointer :: re(:,:,:)
complex, target :: z(2,3,4)
re => z(:,:,:) % re
but it seems not (or possible with very new compilers...?) So a workaround approach below:
1) If the goal is to get (scalar) pointers for the Re and Im parts of a single element of a complex array, I guess we can use c_f_pointer such that
module testmod
contains
subroutine getreim_ptr( z, re, im )
use iso_c_binding
implicit none
complex, target, intent(in) :: z
real, pointer :: re, im, buf(:)
call c_f_pointer( c_loc( z ), buf, [ 2 ] )
re => buf( 1 )
im => buf( 2 )
end subroutine
end module
program main
use testmod
implicit none
complex :: z( 2, 3 )
real, pointer :: re, im
!! Test array.
z = 0.0
z( 1, 1 ) = ( 1.0, -1.0 )
!! Get pointers for the Re/Im parts of z(1,1).
call getreim_ptr( z( 1, 1 ), re, im )
print *, "z(1,:) = ", z(1,:)
print *, "z(2,:) = ", z(2,:)
print *, "re = ", re
print *, "im = ", im
end
Result (gfortran-8.2):
z(1,:) = (1.00000000,-1.00000000) (0.00000000,0.00000000) (0.00000000,0.00000000)
z(2,:) = (0.00000000,0.00000000) (0.00000000,0.00000000) (0.00000000,0.00000000)
re = 1.00000000
im = -1.00000000
2) If the goal is to get array pointers for the entire complex array, I guess we can use rank-remapping pointer assignments (to point to non-contiguous memory with constant gaps). For example, in the 2D case (for simplicity),
re( 1:n1, 1:n2 ) => buf( 1::2 )
im( 1:n1, 1:n2 ) => buf( 2::2 )
where re and im are 2D array pointers and buf is a real 1D array pointer that points to an allocatable 2D complex array (via c_f_pointer). A minimum example may look like this:
module testmod
contains
subroutine getreim_ptr2d( zarr, re, im )
use iso_c_binding
implicit none
complex, allocatable, target, intent(in) :: zarr(:,:)
real, pointer :: re(:,:), im(:,:), buf(:)
integer :: n1, n2
n1 = size( zarr, 1 )
n2 = size( zarr, 2 )
call c_f_pointer( c_loc( zarr ), buf, [ size(zarr) * 2 ] )
re( 1:n1, 1:n2 ) => buf( 1::2 )
im( 1:n1, 1:n2 ) => buf( 2::2 )
end subroutine
end module
program main
use testmod
implicit none
complex, allocatable :: zarr(:,:)
real, pointer :: re(:,:), im(:,:)
integer i
!! Prepare a test array (zarr).
allocate( zarr( 2, 3 ) )
zarr(1,:) = [( complex( 100 + i, -100 -i ), i=1,3 )]
zarr(2,:) = [( complex( 200 + i, -200 -i ), i=1,3 )]
print *, "shape( zarr ) = ", shape( zarr )
print *, "zarr(1,:) = ", zarr(1,:)
print *, "zarr(2,:) = ", zarr(2,:)
call getreim_ptr2d( zarr, re, im )
print *
print *, "shape( re ) = ", shape( re )
print *, "re(1,:) = ", re(1,:)
print *, "re(2,:) = ", re(2,:)
print *
print *, "shape( im ) = ", shape( im )
print *, "im(1,:) = ", im(1,:)
print *, "im(2,:) = ", im(2,:)
end program
Result (gfortran 8.2):
shape( zarr ) = 2 3
zarr(1,:) = (101.000000,-101.000000) (102.000000,-102.000000) (103.000000,-103.000000)
zarr(2,:) = (201.000000,-201.000000) (202.000000,-202.000000) (203.000000,-203.000000)
shape( re ) = 2 3
re(1,:) = 101.000000 102.000000 103.000000
re(2,:) = 201.000000 202.000000 203.000000
shape( im ) = 2 3
im(1,:) = -101.000000 -102.000000 -103.000000
im(2,:) = -201.000000 -202.000000 -203.000000
Below are some materials we can find on the net:
The New Features of Fortran 2003 (N1597): 3.7 "Pointer assignment"
"...Remapping of the elements of a rank-one array is permitted:
p(1:m,1:2*m) => a(1:2*m*m)
The mapping is in array-element order and the target array must be large enough. The bounds may be any scalar integer expressions. The limitation to rank-one arrays is because pointer arrays need not occupy contiguous storage:
a => b(1:10:2)
but all the gaps have the same length in the rank-one case."
Fortran 2003 extensions: 5.4.3 Rank-remapping Pointer Assignment (this page)
"...This feature allows a multi-dimensional pointer to point to a single-dimensional object. For example:
REAL,POINTER :: diagonal(:),matrix(:,:),base(:)
...
ALLOCATE(base(n*n))
matrix(1:n,1:n) => base
diagonal => base(::n+1)
!
! DIAGONAL now points to the diagonal elements of MATRIX.
!
Note that when rank-remapping, the values for both the lower and upper bounds must be explicitly specified for all dimensions, there are no defaults."
Related
I have a very large vector in which I want to add the total number of elements as a condition that repeat numbers do not characterize a new element, for example:
V=[0,5,1,8,9,1,1,]
My desired answer would be:5
But I can't think of a way to do that because with the count function I would have to know all the elements of my vector.
count function not works in this case
FWIW, here's a solution using a tree. No attempt to balance it.
module treemodule
implicit none
private
public numDistinct
type Node
integer value
type(Node), pointer :: left => null(), right => null()
end type node
type, public :: Tree
private
type(Node), pointer :: root => null()
integer :: size = 0
contains
procedure insert
procedure clear
procedure print
procedure getsize
procedure, private :: insertNode
procedure, private :: deleteNode
procedure, private :: printNode
end type Tree
contains
integer function numDistinct( A )
integer, intent(in) :: A(:)
integer i
type(Tree) T
numDistinct = 3
do i = 1, size( A )
call T%insert( A(i) )
end do
numDistinct = T%getsize()
! Comment out the following if you don't need it ...
write( *, "(A)", advance="no" ) "Distinct elements: "; call T%print; write( *, * )
call T%clear
end function numDistinct
integer function getsize( this )
class(Tree) this
getsize = this%size
end function getsize
subroutine insert( this, value )
class(Tree) this
integer, intent(in) :: value
call this%insertNode( this%root, value )
end subroutine insert
subroutine print( this )
class(Tree) this
call this%printNode( this%root )
end subroutine print
subroutine clear( this )
class(Tree) this
call this%deleteNode( this%root )
end subroutine clear
recursive subroutine insertNode( this, ptr, value )
class(Tree) this
type(Node), pointer, intent(inout) :: ptr
integer value
if ( associated( ptr ) ) then
if ( value < ptr%value ) then
call this%insertNode( ptr%left, value )
else if ( value > ptr%value ) then
call this%insertNode( ptr%right, value )
end if
else
allocate( ptr, source=Node(value) )
this%size = this%size + 1
end if
end subroutine insertNode
recursive subroutine deleteNode( this, ptr )
class(Tree) this
type(Node), pointer, intent(inout) :: ptr
if ( associated( ptr ) ) then
call this%deleteNode( ptr%left )
call this%deleteNode( ptr%right )
deallocate( ptr )
this%size = this%size - 1
end if
end subroutine deleteNode
recursive subroutine printNode( this, ptr )
class(Tree) this
type(Node), pointer, intent(in) :: ptr
if ( associated( ptr ) ) then
call this%printNode( ptr%left )
write ( *, "( i0, 1x )", advance="no" ) ptr%value
call this%printNode( ptr%right )
end if
end subroutine printNode
end module treemodule
!=======================================================================
program main
use treemodule
implicit none
integer, allocatable :: A(:)
integer C
A = [ 0, 5, 1, 8, 9, 1, 1 ]
C = numDistinct( A )
write( *, "( 'Number of distinct elements = ', i0 )" ) C
end program main
Distinct elements: 0 1 5 8 9
Number of distinct elements = 5
If you don't care about memory and performances (otherwise there are more efficient codes in the link given by Francescalus):
integer function count_unique(x) result(n)
implicit none
integer, intent(in) :: x(:)
integer, allocatable :: y(:)
y = x(:)
n = 0
do while (size(y) > 0)
n = n+1
y = pack(y,mask=(y(:) /= y(1)) ! drops all elements that are
! equals to the 1st one (included)
end do
end function count_unique
I have a function that accepts two numbers and I don't care if they are integers or real or 32bits or 64bits. For the example below, I just write it as a simple multiplication. In Fortran 90 you could do this with an interface block, but you'd have to write 16 (!) functions if you wanted to cover all the possible interactions of multiplying two numbers, each of which could be int32, int64, real32, or real64.
With Fortran 2003 you have some other options like class(*) for polymorphism and I found one way to do this by simply converting all the inputs to reals, before multiplying:
! compiled on linux with gfortran 4.8.5
program main
integer, target :: i = 2
real(4), target :: x = 2.0
real(8), target :: y = 2.0
character, target :: c = 'a'
print *, multiply(i,x)
print *, multiply(x,i)
print *, multiply(i,i)
print *, multiply(y,y)
print *, multiply(c,c)
contains
function multiply(p,q)
real :: multiply
class(*) :: p, q
real :: r, s
r = 0.0 ; s = 0.0
select type(p)
type is (integer(4)) ; r = p
type is (integer(8)) ; r = p
type is (real(4)) ; r = p
type is (real(8)) ; r = p
class default ; print *, "p is not a real or int"
end select
select type(q)
type is (integer(4)) ; s = q
type is (integer(8)) ; s = q
type is (real(4)) ; s = q
type is (real(8)) ; s = q
class default ; print *, "q is not a real or int"
end select
multiply = r * s
end function multiply
end program main
This seems like an improvement. At least the amount of code here is linear in the number of types rather than quadratic, but I wonder if there is still a better way to do this? As you can see I still have to write the select type code twice, changing 'r' to 's' and 'p' to 'q'.
I tried to convert the select type blocks into a function but couldn't get that to work. But I am interested in any and all alternatives that can further improve on this. It seems like this would be a common problem but I so far haven't found any general approach that is better than this.
Edit to add: Apparently there are plans to improve Fortran w.r.t. this issue in the future as noted in the comment by #SteveLionel. #roygvib further provides a link to a specific proposal which also does a nice job of explaining the issue: https://j3-fortran.org/doc/year/13/13-236.txt
Not a solution for generics, but for "converting the select type blocks into a function", the following code seems to work (which might be useful if some nontrivial conversion is included (?)).
program main
implicit none
integer :: i = 2
real*4 :: x = 2.0
real*8 :: y = 2.0
character(3) :: c = 'abc'
print *, multiply( i, x )
print *, multiply( x, i )
print *, multiply( i, i )
print *, multiply( y, y )
print *, multiply( c, c )
contains
function toreal( x ) result( y )
class(*) :: x
real :: y
select type( x )
type is (integer) ; y = x
type is (real(4)) ; y = x
type is (real(8)) ; y = x
type is (character(*)) ; y = len(x)
class default ; stop "no match for x"
endselect
end
function multiply( p, q ) result( ans )
class(*) :: p, q
real :: ans
ans = toreal( p ) * toreal( q )
end
end program
! gfortran-8 test.f90 && ./a.out
4.00000000
4.00000000
4.00000000
4.00000000
9.00000000
Another approach may be just converting the actual arguments to reals (although it may not be useful for more practical purposes...)
program main
implicit none
integer :: i = 2
real*4 :: x = 2.0
real*8 :: y = 2.0
character :: c = 'a'
print *, multiply( real(i), real(x) )
print *, multiply( real(x), real(i) )
print *, multiply( real(i), real(i) )
print *, multiply( real(y), real(y) )
! print *, multiply( real(c), real(c) ) ! error
contains
function multiply( p, q ) result( ans )
real :: p, q
real :: ans
ans = p * q
end
end program
Here's an alternate approach using a statically overloaded function via an interface block as implicitly referred to in my question and #roygvib's answer. (I figured it makes sense to have this written explicitly, especially if it someone can improve on it.)
Two advantages of the interface block method are:
It's approximately 3x faster (as #roygvib also found, although I
don't know exactly how he wrote the function)
It only requires Fortran 90 (not Fortran 2003)
The main disadvantage is that you have to write the function multiple times. As noted in the question, in this example you'd have to write the multiplication function 16 times, to handle all combos of 32 & 64 bit reals and ints. It's not that terrible here, with the function being a single line of code, but you can easily see that this is more serious for many realistic use cases.
Below is the code I used to test the interface block method. To keep it relatively concise, I tested only the 4 permutations of 32 bit reals and ints. I re-used the main program to also test the #roygvib code. On my 2015 macbook, it took about 16 seconds (interface block) vs 48 seconds (class(*) method).
Module:
module mult_mod
use, intrinsic :: iso_fortran_env, only: i4 => int32, r4 => real32
interface mult
module procedure mult_real4_real4
module procedure mult_int4_real4
module procedure mult_real4_int4
module procedure mult_int4_int4
end interface mult
contains
function mult_real4_real4( p, q ) result( ans )
real(r4) :: p, q
real(r4) :: ans
ans = p * q
end function mult_real4_real4
function mult_int4_real4( p, q ) result( ans )
integer(i4) :: p
real(r4) :: q
real(r4) :: ans
ans = p * q
end function mult_int4_real4
function mult_real4_int4( p, q ) result( ans )
real(r4) :: p
integer(i4) :: q
real(r4) :: ans
ans = p * q
end function mult_real4_int4
function mult_int4_int4( p, q ) result( ans )
integer(i4) :: p, q
real(r4) :: ans
ans = p * q
end function mult_int4_int4
end module mult_mod
Program:
program main
use mult_mod
integer(i4) :: i = 2
real(r4) :: x = 2.0
integer(i4) :: i_end = 1e9
real(r4) :: result
do j = 1, i_end
result = mult( x, x )
result = mult( x, i )
result = mult( i, x )
result = mult( i, i )
end do
end program main
What is the best method when you need interchange the values in two polymorphic elements? (Using standard fortran 2008).
I'm sending an example (please try don't modify the type variables).
The problems that I have using intel compiler v.19 and gfortran 8.1 in windows are different.
Here a complete example. Look at the subroutine where I have defined the swap procedure. Currently is activate the version that works in GFortran but I have error with intel compiler. If you comment this part and uncomment the lines for ifort, then works for intel and not for gfortran....
Program Check
implicit none
!> Type definitions
Type :: Refl_Type
integer,dimension(:), allocatable :: H
integer :: Mult =0
End Type Refl_Type
Type :: RefList_Type
integer :: Nref
class(refl_Type), dimension(:), allocatable :: Reflections
end Type RefList_Type
Type(RefList_Type) :: List
Type(Refl_Type), dimension(3) :: Refl_Ini
!> Variables
integer :: i
!> Init
Refl_Ini(1)%H=[1, 0, 0]; Refl_Ini(1)%Mult=1
Refl_Ini(2)%H=[0, 2, 0]; Refl_Ini(2)%Mult=2
Refl_Ini(3)%H=[0, 0, 3]; Refl_Ini(3)%Mult=3
List%Nref=3
List%Reflections=Refl_Ini
!> Print Step:1
do i=1, List%Nref
print '(i3,2x,3i4,2x,i3)', i,List%Reflections(i)%H, List%Reflections(i)%Mult
end do
print*,' '
print*,' '
!> Swap
call Swap_Elements_List(List, 1, 3)
!> Print Step:2
do i=1, List%Nref
print '(i3,2x,3i4,2x,i3)', i,List%Reflections(i)%H, List%Reflections(i)%Mult
end do
Contains
Subroutine Swap_Elements_List(List, i, j)
!---- Argument ----!
type (RefList_Type), intent(in out) :: List
integer, intent(in) :: i,j
!---- Local Variables ----!
class(Refl_Type), allocatable :: tmp
!> IFort
!tmp=List%reflections(i)
!List%reflections(i)=List%reflections(j)
!List%reflections(j)=tmp
!> Gfortran
associate(t1 => list%reflections(i), t2 => list%reflections(j), tt => tmp)
tt=t1
t1=t2
t2=tt
end associate
End Subroutine Swap_Elements_List
End Program Check
Any suggestion?
Compiling the original code with gfortran-8.2 gives
test.f90:34:6:
List%reflections(i)=List%reflections(j) !!<---
1
Error: Nonallocatable variable must not be polymorphic in
intrinsic assignment at (1) - check that there is a
matching specific subroutine for '=' operator
I think this is because List % reflections(i) is not separately allocatable (even though List % reflections itself is allocatable as an array of uniform type). This point seems to be discussed in detail, e.g., in this Q/A page, which suggests two alternative approaches: (A) convince the compiler that all elements will be of the same type; or (B) use an (array) container.
If we use the "container" approach, I think we can use move_alloc() to swap two polymorphic objects (without knowing the dynamic type). For example, a bit modified version of the original code may be
program main
implicit none
type :: Refl_t
integer, allocatable :: H(:)
endtype
type, extends(Refl_t) :: ExtRefl_t
real :: foo
endtype
type :: RefList_t
class(Refl_t), allocatable :: refl
endtype
type(RefList_t) :: list( 3 )
call init()
print *, "Before:"
call output()
call swap( 1, 2 )
print *, "After:"
call output()
contains
subroutine swap( i, j )
integer, intent(in) :: i, j
class(Refl_t), allocatable :: tmp
call move_alloc( from= list( i )% refl, to= tmp )
call move_alloc( from= list( j )% refl, to= list( i )% refl )
call move_alloc( from= tmp, to= list( j )% refl )
end
subroutine init()
integer i
do i = 1, 3
allocate( ExtRefl_t :: list( i ) % refl )
select type( x => list( i ) % refl )
type is ( ExtRefl_t )
x % H = [ i, i * 10 ]
x % foo = i * 100
endselect
enddo
end
subroutine output()
integer i
do i = 1, 3
select type( x => list( i ) % refl )
type is ( ExtRefl_t )
print *, "i = ", i, " : H = ", x % H, " foo = ", x % foo
endselect
enddo
end
end program
Result (gfortran-8.2):
Before:
i = 1 : H = 1 10 foo = 100.000000
i = 2 : H = 2 20 foo = 200.000000
i = 3 : H = 3 30 foo = 300.000000
After:
i = 1 : H = 2 20 foo = 200.000000
i = 2 : H = 1 10 foo = 100.000000
i = 3 : H = 3 30 foo = 300.000000
I think we could also use polymorphic assignment for the above swap() routine, for example:
subroutine swap( i, j )
integer, intent(in) :: i, j
class(Refl_t), allocatable :: tmp
tmp = list( i ) % refl
list( i ) % refl = list( j ) % refl
list( j ) % refl = tmp
end
This compiles with gfortran-8.2, but gives a strange result... (a possible compiler bug?). I guess newer compilers like GCC-9 or Intel Fortran may give an expected result.
On the other hand, if we use a polymorphic array, we may need to use select type explicitly for swapping the two elements. (But I hope there is a different approach...) The code may then look like:
program main
implicit none
type :: Refl_t
integer, allocatable :: H(:)
endtype
type, extends(Refl_t) :: ExtRefl_t
real :: foo
endtype
class(Refl_t), allocatable :: refls( : )
allocate( ExtRefl_t :: refls( 3 ) )
call init()
print *, "Before:"
call output()
call swap( 1, 2 )
print *, "After:"
call output()
contains
subroutine swap( i, j )
integer, intent(in) :: i, j
selecttype ( refls )
type is ( ExtRefl_t )
block
type(ExtRefl_t) :: tmp
tmp = refls( i ) !<-- assignment of concrete type
refls( i ) = refls( j )
refls( j ) = tmp
endblock
class default
stop
endselect
end
subroutine init()
integer i
select type( refls )
type is ( ExtRefl_t )
do i = 1, 3
refls( i ) % H = [ i, i * 10 ]
refls( i ) % foo = i * 100
enddo
endselect
end
subroutine output()
integer i
select type( refls )
type is ( ExtRefl_t )
do i = 1, 3
print *, "i = ", i, " : H = ", refls( i ) % H, &
" foo = ", refls( i ) % foo
enddo
endselect
end
end program
(The result is the same as above.)
The answer by roygvib summarizes the problem well. If this assignment is to be performed in user's code where the types are known or are known to be from a small set of possible types, one can just protect the assignment by the select type typeguard.
The real problem happens in a generic code that is written without the knowledge of the user's derived types. Therefore it may have no access to possible user-defined assignments. I suggest a possible solution using a callback procedure. Basically, the user defines an assignment or swap procedure which is then called by the library code.
subroutine sub_that_needs_assignments(array, assign)
class(*) :: array
interface
subroutne assign(out, in)
end subroutine
end interface
call assign(array(i), array(i+1))
!or you can even assign a new elemnt from somewhere else
! possibly protect by same_type_as()
end subroutine
in the user's code
subroutine assign_my_type(out, in)
class(*), ... :: out
class(*), ... :: in
select type (out)
type is (my_type)
select type (in) ! not always necessary
type is (in)
out = in
end select
end select
!add appropriate error checking
end subroutine
I am not experienced programer in fortran so I need a help about my simple code.
My code is:
module derived_type
implicit none
type :: iter_type
integer :: calc_tmp
integer :: n_iter
contains
procedure :: calc_iter => calc_iter_process
procedure :: take_calc_tmp => take_data_calc_tmp
procedure :: take_n_iter => take_data_n_iter
end type iter_type
private :: calc_iter_process
private :: take_data_calc_tmp
private :: take_data_n_iter
contains
function calc_iter_process( this, indx_00 ) result( err_tmp )
class( iter_type ) :: this
integer, intent( in ) :: indx_00
logical :: err_tmp
err_tmp = .false.
this%n_iter = 0
this%calc_tmp = 1
do while( this%calc_tmp < indx_00 )
this%n_iter = this%n_iter + 1
if ( this%n_iter > 50 ) then
write(*,*) "error - maximal number of iterations !!!"
err_tmp = .true.
exit
end if
this%calc_tmp = this%calc_tmp + 1
end do
end function calc_iter_process
function take_data_calc_tmp( this ) result( data_tmp )
class( iter_type ) :: this
integer :: data_tmp
data_tmp = this%calc_tmp
end function take_data_calc_tmp
function take_data_n_iter( this ) result( data_tmp )
class( iter_type ) :: this
integer :: data_tmp
data_tmp = this%n_iter
end function take_data_n_iter
end module derived_type
program iteration_values
use, non_intrinsic :: derived_type
implicit none
integer, parameter :: number_00 = 32
logical :: global_err
type( iter_type ) :: iter_object
global_err = iter_object%calc_iter( number_00 )
if ( global_err ) stop "error - global !!!"
end program iteration_values
I need to find way for code modification which can give me a way to keep or save value of 'calc_tmp' in every single iterations.
When I thinking about that I can not imagine how to allocate or deallocate some array which must be dimension same or higher the 'n_iter'.
Is there way for doing that?
I would recommend the use of the allocatable attribute and move_alloc. Here is an example program. move_alloc is Fortran 2003. In this example, I'm increasing the size of the array every time its size is exceeded.
program temp
implicit none
integer, dimension(:), allocatable :: tempval, calc_tmp_history
integer :: i, j, calc_tmp, totalSize
totalSize = 0
allocate(calc_tmp_history(2))
do i = 1,4
calc_tmp = 2*i
if (i > size(calc_tmp_history)) then
call move_alloc(calc_tmp_history,tempval)
allocate(calc_tmp_history(2*i))
do j = 1,i
calc_tmp_history(j) = tempval(j)
end do
end if
calc_tmp_history(i) = calc_tmp
totalSize = totalSize + 1
end do
do i = 1,totalSize
print *, calc_tmp_history(i)
end do
end program
Output from this is:
2
4
6
8
Consider the following "real world" legacy Fortran 77 code, which may well be illegal according to the standard, but works in real life with a wide range of compilers, and produces no compiler or linker warnings if each subroutine is compiled separately.
subroutine a
complex z(10)
call b(z)
call r1(z)
call r2(z)
end
subroutine b(z)
complex z(10)
c ... use complex arithmetic on z
end
subroutine r1(x)
real x(2,10)
c ... do something with real and imaginary parts
c ... real parts are x(1,*)
c ... imaginary parts are x(2,*)
end
subroutine r2(x)
real x(20)
c ... do something with real and imaginary parts
end
I want to re-package code in this style using Fortran 90/95 modules. The naïve approach of
module m
public a
private b, r1, r2
contains
subroutine a
complex z(10)
call b(z)
call r1(z)
call r2(z)
end subroutine a
subroutine b(z)
complex z(10)
c ... use complex arithmetic on z
end subroutine b
subroutine r1(x)
real x(2,10)
c ... do something with real and imaginary parts
c ... real parts are x(1,*)
c ... imaginary parts are x(2,*)
end subroutine r1
subroutine r2(x)
real x(20)
c ... do something with real and imaginary parts
end subroutine r2
end module m
doesn't compile, because (of course) the compiler can now see that subroutines r1 and r2 are called with the wrong argument type.
I need some ideas on how to fix this, with the minimum amount of rewriting of the existing code, and without making duplicate copies of the data in memory - the real-life size of the data is too big for that.
c_f_pointer() may be useful to get a real(2,*) pointer to a complex(*) array, but I am not sure whether passing the complex parameter (zconst(:)) to ctor() is really okay... (here I have used gfortran 4.4 & 4.8 and ifort 14.0, and to make the output more compact the array dimension is changed from 10 to 3.)
module m
implicit none
contains
subroutine r1 ( x )
real x( 2, 3 )
print *
print *, "In r1:"
print *, "Real part = ",x( 1, : )
print *, "Imag part = ",x( 2, : )
endsubroutine
subroutine r2 ( x )
real x( 6 )
print *
print *, "In r2:"
print *, "all elements = ", x( : )
endsubroutine
subroutine b ( z )
complex :: z( 3 )
real, pointer :: rp(:,:)
rp => ctor( z, 3 ) !! to compare z and rp
print *
print *, "In b:"
print *, "1st elem = ", z( 1 ), rp( :, 1 )
print *, "3rd elem = ", z( 3 ), rp( :, 3 )
endsubroutine
function ctor( z, n ) result( ret ) !! get real(2,*) pointer to complex(*)
use iso_c_binding
implicit none
integer :: n
complex, target :: z( n )
real, pointer :: ret(:,:)
call c_f_pointer( c_loc(z(1)), ret, shape=[2,n] )
endfunction
endmodule
program main
use m
implicit none
complex z(3)
complex, parameter :: zconst(3) = [(7.0,-7.0),(8.0,-8.0),(9.0,-9.0)]
z(1) = ( 1.0, -1.0 )
z(2) = ( 2.0, -2.0 )
z(3) = ( 3.0, -3.0 )
call r1 ( ctor( z, 3 ) )
call r1 ( ctor( zconst, 3 ) )
call r2 ( ctor( z, 3 ) )
call r2 ( ctor( zconst, 3 ) )
call b ( z )
call b ( zconst )
endprogram
Note the following suggestion has some retrogressive aspects.
In the example code in the question, the original source of the data is a local variable. Such a local variable can appear in a storage association context by using an equivalence statement, and in such a context it is possible to treat a COMPLEX object as a pair of REAL objects.
module m
public a
private b, r1, r2
contains
subroutine a
complex z(10)
real r(size(z)*2)
equivalence (z,r)
call b(z) ! pass complex array
call r1(r) ! pass real array
call r2(r) ! pass real array
end subroutine a
subroutine b(z)
complex z(10)
! ... use complex arithmetic on z
end subroutine b
subroutine r1(x)
real x(2,10)
! ... do something with real and imaginary parts
! ... real parts are x(1,*)
! ... imaginary parts are x(2,*)
end subroutine r1
subroutine r2(x)
real x(20)
! ... do something with real and imaginary parts
end subroutine r2
end module m
(This is perhaps more a comment than an answer, but you can't include formatted code in a comment).
#roygvib answered the question in standard fortran 2003.
The same idea can be coded more concisely using the non-standard "Cray Fortran pointer" syntax which is implemented in many compilers - for example the -fcray-pointer option in gfortran. The non-standard intrinsic function loc replaces ctor.
subroutine b ( z )
complex :: z( 3 )
real :: r( 2, 3 )
pointer(zp, r)
zp = loc(z)
print *
print *, "In b:"
print *, "1st elem = ", z( 1 ), r( :, 1)
print *, "3rd elem = ", z( 3 ), r( :, 3)
endsubroutine