Share allocatable Arrays - arrays

I have some allocatable arrays which I need to share between some subroutines. I usually would just pass them as arguments or maybe write everything in a Module, but I'm afraid this isn't possible in my situation.
I only write some own subroutines and use subroutines provided and described by an FEM-Solver. So i cannot alter the arguments of this subroutines or wrap them in a Module.
As far as i know it also isn't possible to Build common blocks with array of unknown size at compile time.
Is there something else to pass my arrays?
Update:
At the moment my program environment looks like this:
I have a subroutine, provided by the FEM-program, which is called after each increment, this calls several of my subroutines where I compute some values for each node or for a subset of those.
To display these values in the post-Simulation, i have to pass them to another subroutine. This subroutine is called by the FEM-solver for each node at the end of the increment. So shifting my code to this Subroutine would produce a lot of overhead.
My idea is to compute the values once, store the Values in an array and pass this array to the second subroutine where they will be written to the database of the computation.
Update
Some Pseudo-code:
Assumed from program behaviour:
Program FEM-solver
*magic*
call ENDINC(ar1,ar2)
*something*
do NodeID=1,Sum_Of_Nodes
do valueID=1,Sum_Of_User_Computed_Values !(defined in preprocessing)
call nodeval(NodeID,valueID,Value,ar3,...,arN)
end do
end do
*voodoo*
end program FEM-solver
Written and working:
Subroutine ENDINC(ar1,ar2)
*Computation of some node values*
*Calling of own Subroutines, which compute more values*
*Writing an array with results values for some/each node(s)*
nodersltArr(NodeID,rslt)=*some Value*
end Subroutine ENDINC
Needed, writng the computed Values to the Node solution database:
Subroutine nodeval(NodeID,valueID,Value,ar3,...,arN)
*called for each NodeID and valueID*
value=noderslArr(NodeID,valueID)
end subroutine nodeval

You can pass an allocatable array to procedure that isn't declared to use allocatable arrays, as long as the array is allocated before the call. (Of course, you can't use the array as an allocatable array in the procedure in which it is declared without that property.) Perhaps that will solve your problem. Allocate the array in the code that you write, than pass it as an argument to the FEM solver.
Example code: (I'd normally put the function into a module but you say that you can't do that, so I write an example showing the case of not using a module.)
function MySum ( RegArray )
real :: MySum
real, dimension (:), intent (in) :: RegArray
MySum = sum (RegArray)
end function MySum
program TestArray
implicit none
interface AFunc
function MySum ( SomeArray )
real :: MySum
real, dimension (:), intent (in) :: SomeArray
end function MySum
end interface AFunc
real, dimension (:), allocatable :: AllocArray
integer :: N
real :: answer
write (*, '("Input array size: ")', advance="no")
read (*, *) N
allocate ( AllocArray (1:N) )
AllocArray = 1.0
answer = MySum ( AllocArray )
write (*, *) answer
end program TestArray
---------- EDIT: Second Concept ---------
Sharing an allocatable array between two subroutines, without the calling routine being "aware" of the array.
module MySubs
real, allocatable, dimension (:,:) :: array
contains
subroutine One ( x, y, ... N, M )
integer, intent (in) :: N, M
if ( .NOT. allocated (array) ) allocate ( array (N, M) )
end subroutine One
subroutine Two ( .... )
end subroutine Two
end module MySubs
UPDATE: note: This approach can be used to pass information between the two routines without the main program having access the module ... for the question, without modifying the original main prpgram. Part of the example is how to allocate the arrays: the example does that by having the subroutine that would first use the array test whether the array is allocated -- if not, it allocates the array.

The three examples below all work with gfortran. The second may fail on some compilers as it uses a F2003 feature (allocatable dummy arguments), and not all compilers are 100% F2003 compliant. However, most implement ISO TR 15581 (which includes this feature).
First version, you can use a common pointer to allocatable array.
program hip
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
double precision, allocatable, dimension(:, :), target :: a
allocate(a(100, 100))
a(1, 1) = 3.1416d0
p => a
call hop
deallocate(a)
end program
subroutine hop
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
print *, size(p, 1), size(p, 2), p(1, 1)
end subroutine
Second version, allocating in a subroutine then calling another. One still needs to declare the array in main program.
program hip
implicit none
interface
subroutine hip_alloc(arr)
double precision, allocatable, dimension(:, :) :: arr
end subroutine
end interface
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
double precision, allocatable, dimension(:, :) :: a
p => null()
print *, "a:", allocated(a)
print *, "p:", associated(p)
call hip_alloc(a)
print *, "a:", allocated(a)
print *, "p:", associated(p)
call hop
deallocate(a)
end program
subroutine hip_alloc(arr)
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
double precision, allocatable, dimension(:, :), target :: arr
allocate(arr(100, 100))
arr(1, 1) = 3.1416d0
p => arr
end subroutine
subroutine hop
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
print *, size(p, 1), size(p, 2), p(1, 1)
end subroutine
Third version, here we first call a function returning a pointer, then pass this pointer to a subroutine through a common. The function does the allocation, as in second example. The pointer is deallocated in main program, but could be elsewhere.
program hip
implicit none
interface
function hip_alloc(n)
integer :: n
double precision, dimension(:, :), pointer :: hip_alloc
end function
end interface
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
p => null()
print *, "p:", associated(p)
p => hip_alloc(100)
print *, "p:", associated(p)
call hop
deallocate(p)
end program
function hip_alloc(n)
implicit none
integer :: n
double precision, dimension(:, :), pointer :: hip_alloc
allocate(hip_alloc(n, n))
hip_alloc(1, 1) = 3.1416d0
end function
subroutine hop
implicit none
double precision, dimension(:, :), pointer :: p
common /hiphop/ p
print *, size(p, 1), size(p, 2), p(1, 1)
end subroutine

I do not understand why writing a MODULE would not work, but have you considered CONTAINS? Everything above the CONTAINS declaration is visible to the subroutines below the CONTAINS:
PROGRAM call_both
INTEGER,DIMENSION(2) :: a, b
a = 1
b = 2
PRINT *,"main sees", a, b
CALL subA
CALL subB
CONTAINS
SUBROUTINE subA
PRINT *,"subA sees",a,b
END SUBROUTINE subA
SUBROUTINE subB
PRINT *,"subB sees",a,b
END SUBROUTINE subB
END PROGRAM call_both
The output would be
main sees 1 1 2 2
subA sees 1 1 2 2
subB sees 1 1 2 2
This works with ALLOCATABLE arrays as well.

Related

Difference in Fortran pointer and Fortran allocatable in calling C_F_POINTER

The thing is, 'C_F_POINTER' compiles successfully(ifort version 19.0.5.281) with 'allocatable arrays' as its argument, and it works in the exactly same way with the case in which 'pointer' is used as its argument.
program test1
use mkl_spblas
use omp_lib
use iso_c_binding
implicit none
integer, parameter :: DIM_ = 4, DIM_2 = 6
integer :: stat, i
integer :: irn(DIM_2), jcn(DIM_2)
real*8 :: val(DIM_2)
integer(c_int) :: indexing
integer :: DIM_r, DIM_c
type(c_ptr) :: rows_start_c, rows_end_c, col_indx_c, values_c
(*1)!integer,allocatable :: rows_start_f(:), rows_end_f(:), col_indx_f(:)
!real*8 ,allocatable :: values_f(:)
(*2)integer ,pointer :: rows_start_f(:), rows_end_f(:), col_indx_f(:)
real*8 ,pointer :: values_f(:)
type(SPARSE_MATRIX_T) :: mat1, mat2
irn = (/ 2, 2, 3, 4, 0, 0 /)
jcn = (/ 1, 2, 3, 2, 0, 0 /)
val = (/ 5, 8, 3, 6, 0, 0 /)
call omp_set_num_threads(1)
stat = mkl_sparse_d_create_coo (A=mat1, indexing=SPARSE_INDEX_BASE_ONE, &
rows=DIM_, cols=DIM_, nnz=DIM_,&
row_indx=irn, col_indx=jcn, values=val )
if (stat /= 0) stop 'Error in mkl_sparse_d_create_coo'
stat = mkl_sparse_convert_csr (source=mat1,&
operation=SPARSE_OPERATION_NON_TRANSPOSE, &
dest = mat2 )
if (stat /= 0) stop 'Error in mkl_sparse_convert_csr'
stat = mkl_sparse_d_export_csr(mat2, indexing, DIM_r, DIM_c, &
rows_start_c, rows_end_c, col_indx_c, values_c)
(*3)call c_f_pointer(rows_start_c, rows_start_f, [DIM_r])
call c_f_pointer(rows_end_c , rows_end_f , [DIM_c])
call c_f_pointer(col_indx_c , col_indx_f , [rows_end_f(DIM_r)-1])
call c_f_pointer(values_c , values_f , [rows_end_f(DIM_r)-1])
stat = mkl_sparse_destroy (A=mat1)
if (stat /= 0) stop 'Error in mkl_sparse_destroy (mat1)'
stat = mkl_sparse_destroy (A=mat2)
if (stat /= 0) stop 'Error in mkl_sparse_destroy (mat2)'
call mkl_free_buffers
(*4)print *, 'rows_start'
print *, rows_start_f
print *, 'rows_end'
print *, rows_end_f
print *, 'col_indx'
print *, col_indx_f
print *, 'values'
print *, values_f
print *, 'indexing'
print *, indexing
print *, 'size(values_f,1)'
print *, size(values_f,1)
end program test1
In the test code above, I marked some points as (*1), (*2), and so on in the leftside of the code.
(*1) & (*2) : allocatable array version and pointer version of the code
(*3) : where I call 'C_F_POINTER'
(*4) : print statements to see the output
The results are 'exactly' the same in both (*1), and (*2) case, and all values are properly converted into desired CSR format.
rows_start
1 1 3 4
rows_end
1 3 4 5
col_indx
1 2 3 2
values
5.00000000000000 8.00000000000000 3.00000000000000
6.00000000000000
indexing
1
size(values_f,1)
4
I found a similar question in StackOverflow 2 years ago (difference between fortran pointers or allocatable arrays for c_f_pointer call).
This question is asking the exactly the same questions in my mind right now.
If I rearange questions in my words,
Difference between pointer and allocatable array?
In C, as far as I know, the arrays are stored in contiguous memory and can be represented by the pointer which points its 1st element. And in Fortran90, if I pass a array into a subroutine as 'assumed-size array', the code behaves like it never cares about how it's allocated, how it's size is like, and treates the array as 1D being stored in contiguous site.
In below code, the subroutine 'assign_A' just gets the 'tot_array(1,2)' as its starting point, and do its work on contiguous site and seems to do it even out of bound of 'tot_array'!! (tot_array is 2x2 matrix, and assign_A's do loop runs 5 times starting at tot_array(1,2)) I was 'feeling' the pointer and allocatable arrays are similar stuff in this sense. But apparently, as the answers in difference between fortran pointers or allocatable arrays for c_f_pointer call, they are different things. Why arrays acts like pointer when they are passed to subroutine as 'assumed-size' one?
program assumed_size_array_test
implicit none
external assign_A
real*8 :: tot_array(2,2)
integer:: i
! Initially 'tot_array' set to be 1.d0
tot_array = 1.d0
write(*,*) 'Before'
write(*,'(5f5.2)') tot_array
call assign_A(tot_array(1,2))
write(*,*) 'After'
write(*,'(5f5.2)') tot_array
end program
subroutine assign_A(A)
implicit none
real*8, intent(inout) :: A(*)
integer :: i
do i = 1,5
A(i) = 2.d0
enddo
end subroutine
Before
1.00 1.00 1.00 1.00
After
1.00 1.00 2.00 2.00
Is there any difference in using 'allocatable array' and 'pointer' in calling 'C_F_POINTER' in Fortran90?
I used ifort version 19.0.5.281, and this compiler seems to give me exactly the same results as far as I checked. If it's okay, I prefer to use allocatble arrays instead of pointers. Is there any difference in using 'allocatable array' and 'pointer' with 'C_F_POINTER', and is there anything that I should be aware of in doing so?
The answers in difference between fortran pointers or allocatable arrays for c_f_pointer call says that I SHOULD use pointers, not using allocatable arrays with C_F_POINTER, but it seems it's some ongoing issue that was not concluded exactly at that time. Is there any conclusion in why 'C_F_POINTER', which is designed for fortran pointer, works fine with allocatable arrays and is result is the same?
Thank you for reading this question.
Obviously, both Fortran POINTER variables and ALLOCATABLE variables have a lot of common in their internal impementation. Most of that is under the hood and should not be accessed directly. Both allocate some memory and probably use the same operating system's or C runtime library's allocator. For example, malloc().
In both there is some memory allocated or pointed to and described by a simple address (for scalars) or by an array descriptor (for an array).
Pointers and allocatable variables mainly differ in what you can do with them and what the compiler will do with them for you. You can think of allocatables as a sort of "smart pointers" quite similar to std::unique_ptr in C++. Recall what happens in C++ you have new and delete which in turn call malloc and free but you are not allowed to mix them. And you are certainly not allowed to manually modify the address stored in a C++ smart pointer either.
When you send an allocatable variable to a procedure that expects a pointer, anything can happen, it is an undefined behaviour. But, if the internal hidden structure has a similar layout, it may happen that you actually set the allocatable internals to point to some memory that was not allocated through allocatable. You may then think that everything is OK and you have a new feature. However, when the time for deallocation comes, and allocatables are often deallocated automatically, it can easilly fail in very unpredictable ways. It can crash in very strange places of the code, the results can be wrong and so on. Anything can happen.
For example, this extremely ugly program works for me too (in gfortran):
subroutine point(ptr, x)
pointer :: ptr
target :: x
ptr => x
end subroutine
interface
subroutine point(ptr, x)
allocatable :: ptr
target :: x
end subroutine
end interface
allocatable z
y = 1.0
call point(z, y)
print *, z
end
But you should never do stuff like this. It is really something very, very wrong. If you make z a local variable, so that it is deallocated, or if you try to deallocate it, it will crash. That is because the only information the compiler has is the address. Internally, the allocatable really looks the same as a pointer. It is just an address (for a scalar). The only difference is what you are allowed to do with it and what the compiler will do for you automatically.
This won't even crash, because the internal implementation similarities I mentioned. but it is no less wrong.
subroutine point(ptr, x)
pointer :: ptr
target :: x
ptr => x
end subroutine
interface
subroutine point(ptr, x)
allocatable :: ptr
target :: x
end subroutine
end interface
allocatable z
pointer y
allocate(y)
y = 1.0
call point(z, y)
print *, z
deallocate(z)
end
It just survives because both allocatable and pointer use the same internal allocator (malloc) in gfortran and they are both implemented as a simple address.

Fortran shape matching rules violated

What am I trying to achieve
Im trying to write a subroutine that takes an Matrix (2D array) as input and prints it nicely to the standard console output.
Problem
error #6634: The shape matching rules of actual arguments and dummy arguments have been violated. ['U']
Code
The subroutine printing the matrix is in this module
Module
MODULE LinearSystems
IMPLICIT NONE
private
...
public showMatrix
...
contains
subroutine showMatrix(a, n, m, name)
implicit none
double precision, dimension(:,:), intent(in) :: a
character, dimension(:), intent(in), optional :: name
integer, intent(in) :: n,m
integer :: i, j
write(*,*) "*** Show Matrix ", name, " ***"
do i = 1, n
do j = 1, m
write(*,'(F8.4)',advance="no") a(i,j)
end do
write(*,*)
end do
end subroutine showMatrix
and the main program calls it
Main Program
program PoisonEquation
...
use LinearSystems
implicit none
double precision, dimension(:,:), allocatable :: u,...
integer :: n = 700
allocate(u(n-1,n-1))
...
call showMatrix(u, n-1,n-1, "U")
I'm looking forward to receive tipps on how to improve this code snipped and get it bug free.
The name dummy argument is an assumed shape array (see the dimension(:) declaration). The "U" literal used for the actual argument is scalar (the error message refers to this literal).
If a dummy argument is an assumed shape array, the rank of the actual argument shall be the same as the rank of the dummy argument (F2018 15.5.2.4p16).
Figure out whether you want to pass/receive an array or a scalar, and fix the code.
Problem solved
The problem was in the character initialisation and after fixing this issue as well as fixing a issue in the main program, which lead to u being deallocated before it was passed to the subroutine the code now works and the subroutine for printing looks like this:
subroutine showMatrix(a, name)
implicit none
double precision, dimension(:,:), intent(in) :: a
character(*), intent(in), optional :: name
integer :: i, j
write(*,*) "*** Show Matrix ", name, " ***"
do i = 1, size(a,1)
do j = 1, size(a,2)
write(*,'(F8.4)',advance="no") a(i,j)
end do
write(*,*)
end do
end subroutine showMatrix

Passing the allocatable array to subroutine in Fortran with MPI [duplicate]

This question already has answers here:
keeping array limits in fortran during subroutine call
(3 answers)
Closed 5 years ago.
I am trying to pass the allocatable array to the subroutine. When I am using the serial version as mentioned in How to pass allocatable arrays to subroutines in Fortran it is working fine. Below is my serial version of code.
module test
contains
subroutine func(a,sqa,n)
implicit none
integer, intent(in) :: n
integer, intent(in), dimension(:,:) :: a
integer, intent(out), dimension(:,:):: sqa
!local variables
integer :: i,j
do i= 1,n
do j = 1,2
sqa(i,j) = a(i,j)*a(i,j)
print *, 'i',i, 'j', j,'sqa(i,j)',sqa(i,j)
end do
end do
end subroutine func
end module test
program main
use test
implicit none
integer :: n,i,j
integer, dimension(:,:), allocatable :: a, sqa
print *, 'enter no of rows'
read *, n
allocate(a(1:n,2))
allocate(sqa(1:n,2))
do i = 1,n
do j = 1, 2
a(i,j) = i +j
print *, 'i =',i,'j =',j, a(i,j)
end do
end do
call func(a, sqa,n)
deallocate(a,sqa)
end program main
When I start to implement using MPI, my parallel version of code is
module test
contains
subroutine func(a,sqa,istart,iend)
implicit none
integer, intent(in) :: istart, iend
integer, intent(in), dimension(:,:) :: a
integer, intent(out),dimension(:,:) :: sqa
!local variables
integer :: i,j
do i= istart, iend
do j = 1,2
sqa(i,j) = a(i,j)*a(i,j)
print *, 'i',i, 'j', j,'sqa(i,j)',sqa(i,j)
end do
end do
end subroutine func
end module test
program main
use test
use mpi
implicit none
integer :: istart, iend, ierr,nproc, procnum, n,&
points_per_thread, i,j
integer, dimension(:,:), allocatable :: a, sqa
integer,dimension(mpi_status_size) :: status
call mpi_init(ierr)
call mpi_comm_size(mpi_comm_world, nproc, ierr)
call mpi_comm_rank(mpi_comm_world,procnum, ierr)
if(procnum == 0)then
print *, 'enter no of rows'
read *, n
end if
call mpi_bcast(n,1,mpi_integer,0,mpi_comm_world, ierr)
points_per_thread = (n + nproc - 1)/nproc
istart = procnum*points_per_thread + 1
iend = min((procnum + 1)*points_per_thread,n)
print *, 'istart ', istart, 'iend', iend, 'procnum', procnum
call mpi_barrier(mpi_comm_world, ierr)
allocate(a(istart:iend,2))
allocate(sqa(istart:iend,2))
do i = istart,iend
do j = 1, 2
a(i,j) = i +j
print *, 'i =',i,'j =',j, a(i,j)
end do
end do
call mpi_barrier(mpi_comm_world, ierr)
call func(a(istart:iend,:), sqa(istart:iend,:),istart,iend)
deallocate(a,sqa)
call mpi_finalize(ierr)
end program main
The above code gives the segmentation fault error. I don't understand the reason for this.
Next, when in my subroutine func I change the declaration of arrays a and sqa to
integer,intent(in):: a(istart:iend,2)
integer, intent(out)::sqa(istart:iend,2)
Now it works fine. I request to kindly help me understand the reason for the error.
Assumed shape dummy arrays make available the extension of the actual arguments inside the function but not their bounds. If the actual bounds are needed inside the function, explicit-shape dummy arrays must be used.

finding specific indices with pointer array

I am relatively new to Fortran and break my head about one thing for hours now:
I want to write a subroutine for finding the indexes for specific elements in a real 1D array (given to the routine as input).
I have generated an array with 100 random reals, called arr, and now want to determine the indexes of those elements which are greater than a real value min, which is also passed to subroutine.
Plus, in the end I would like to have a pointer I'd allocate in the end, which I was said would be better than using an array indices containing the indexes once found.
I just didn't find how to solve that, I had following approach:
SUBROUTINE COMP(arr, min)
real, intent(in) :: arr(:)
real, intent(in) :: min
integer, pointer, dimension(:) :: Indices
integer :: i, j
! now here I need a loop which assigns to each element of the pointer
! array the Indices one after another, i don't know how many indices there
! are to be pointed at
! And I dont know how to manage that the Indices are pointed at one after another,
! like Indices(1) => 4
! Indices(2) => 7
! Indices(3) => 32
! Indices(4) => 69
! ...
! instead of
! Indices(4) => 4
! Indices(7) => 7
! Indices(32) => 32
! Indices(69) => 69
! ...
DO i = 1, size(arr)
IF (arr(i) > min) THEN
???
ENDIF
ENDDO
allocate(Indices)
END SUBROUTINE COMP
If succinctness (rather than performance) floats your boat... consider:
FUNCTION find_indexes_for_specific_elements_in_a_real_1D_array(array, min) &
RESULT(indices)
REAL, INTENT(IN) :: array(:)
REAL, INTENT(IN) :: min
INTEGER, ALLOCATABLE :: indices(:)
INTEGER :: i
indices = PACK([(i,i=1,SIZE(array))], array >= min)
END FUNCTION find_indexes_for_specific_elements_in_a_real_1D_array
[Requires F2003. Procedures that have assumed shape arguments and functions with allocatable results need to have an explicit interface accessible where they are referenced, so all well behaved Fortran programmers put them in a module.]
A simple way to get the indices of a rank 1 array arr for elements greater than value min is
indices = PACK([(i, i=LBOUND(arr,1), UBOUND(arr,1))], arr.gt.min)
where indices is allocatable, dimension(:). If your compiler doesn't support automatic (re-)allocation than an ALLOCATE(indices(COUNT(arr.gt.min)) would be needed before that point (with a DEALLOCATE before that if indices is already allocated).
As explanation: the [(i, i=...)] creates an array with the numbers of the indices of the other array, and the PACK intrinsic selects those corresponding to the mask condition.
Note that if you are doing index calculations in a subroutine you have to be careful:
subroutine COMP(arr, min, indices)
real, intent(in) :: arr(:)
real, intent(in) :: min
integer, allocatable, intent(out) :: indices(:)
!...
end subroutine
arr in the subroutine will have lower bound 1 regardless of the bounds of the actual argument (the array passed) (which could be, say VALS(10:109). You will also then want to pass the lower bound to the subroutine, or address that later.
[Automatic allocation is not an F90 feature, but in F90 one also has to think about allocatable subroutine arguments
I think you're on the right track, but you're ignoring some intrinsic Fortran functions, specifically count, and you aren't returning anything!
subroutine comp(arr, min)
real, intent(in) :: arr(:)
real, intent(in) :: min
! local variables
integer, allocatable :: indices(:)
integer :: i,j, indx
! count counts the number of TRUE elements in the array
indx = count(arr > min)
allocate(indices(indx))
! the variable j here is the counter to increment the index of indices
j=1
do i=1,size(arr)
if(arr(i) > min) then
indices(j) = i
j = j+1
endif
enddo
end subroutine comp
Then you can use the array indices as
do i=1,size(indices)
var = arr(indices(i))
enddo
Note that since you are not returning indices, you will lose all the information found once you return--unless you plan on using it in the subroutine, then you're okay. If you're not using it there, you could define it as a global variable in a module and the other subroutines should see it.

error #6366: The shapes of the array expressions do not conform

I create a program to solve two-body problem by runge-kutt method. I was faced with the problem: when I call the function which return the ELEMENT of two-dimension array from expression, which must give the ELEMENT of two-dimension array too (sorry for confusion with terms), I get this message:
error #6366: The shapes of the array expressions do not conform.
[X1]
X1(DIM,i)=X1(DIM,i-1)+0.5D0*ABS(i/2)*H*K1(DIM,i-1,X1(DIM,i-1),X2(DIM,i-1),V1(DIM,i-1),V2(DIM,i-1),NDIM,ORD,2,maxnu)
I have a external interface for this function and it's apparently that compiler consider this as a function.
I must clarify some things:
Yes, it's not quite Fortran, it's preprocessor Trefor, which is used by astronomers in Moscow University (I'm just a student). This language is very similar to fortran, but a bit closer to C (Semi-colons for example), which is studied by many students.
Runge-Kutta method can be briefly written as:
We have initial value problem
dy/dt=f(t,y), y(t0)=y0
y is unknown vector, which contains 12 components in my case (3 coordinates and 3 velocities for each body)
next step is
y(n+1)=y(n)+1/6*h*(k1+2k2+2k3+k4), t(n+1)=t(n)+h
where
k1=f(tn,yn),
k2=f(tn+1/2h,yn+h/2*k1)
k3=f(tn+1/2h,yn+h/2*k2)
k4=f(tn+1/2h,yn+k3)
I.e. in my code X1,2 and V1,2 and K_1,2 should be vectors, because each of them must be have 3 spatial components and 4 components for each 'order' of method.
The full code:
FUNCTION K1(DIM,i,X1,X2,V1,V2,NDIM,ORD,nu,maxnu)RESULT (K_1);
integer,intent(in) :: i,DIM,nu;
real(8) :: K_1;
real(8) :: B1;
real(8) :: R;
real(8),intent(in) :: X1,X2,V1,V2;
COMMON/A/M1,M2,Fgauss,H;
integer,intent(in) :: NDIM,ORD,maxnu;
Dimension :: B1(NDIM, ORD);
Dimension :: X1(NDIM,ORD),X2(NDIM,ORD),V1(NDIM,ORD),V2(NDIM,ORD);
Dimension :: K_1(NDIM,ORD);
IF (nu>=2) THEN;
B1(DIM,i)=V1(DIM,i);
ELSE;
R=((X1(1,i)-X2(1,i))**2.D0+(X1(2,i)-X2(2,i))**2.D0+(X1(3,i)-X2(3,i))**2.D0)**0.5D0;
B1(DIM,i)=Fgauss*M2*(X2(DIM,i)-X1(DIM,i))/((R)**3.D0);
END IF;
K_1(DIM,i)=B1(DIM,i);
RETURN;
END FUNCTION K1;
FUNCTION K2(DIM,i,X1,X2,V1,V2,NDIM,ORD,nu,maxnu)RESULT (K_2);
integer,intent(in) :: i,DIM,nu;
real(8) :: K_2;
real(8) :: B2;
real(8) :: R;
real(8),intent(in) :: X1,X2,V1,V2;
COMMON/A/M1,M2,Fgauss,H;
integer,intent(in) :: NDIM,ORD,maxnu;
Dimension :: B2(NDIM,ORD);
Dimension :: X1(NDIM,ORD),X2(NDIM,ORD),V1(NDIM,ORD),V2(NDIM,ORD);
Dimension :: K_2(NDIM,ORD);
IF (nu>=2) THEN;
B2(DIM, i)=V2(DIM,i);
ELSE;
R=((X1(1,i)-X2(1,i))**2.D0+(X1(2,i)-X2(2,i))**2.D0+(X1(3,i)-X2(3,i))**2.D0)**0.5D0;
B2(DIM, i)=Fgauss*M1*(X2(DIM,i)-X1(DIM,i))/((R)**3.D0);
END IF;
K_2(DIM,i)=B2(DIM, i);
RETURN;
END FUNCTION K2;
PROGRAM RUNGEKUTT;
IMPLICIT NONE;
Character*80 STRING;
real(8) :: M1,M2,Fgauss,H;
real(8) :: R,X1,X2,V1,V2;
integer :: N,i,DIM,NDIM,maxnu,ORD;
integer :: nu;
PARAMETER(NDIM=3,ORD=4,maxnu=2);
Dimension :: X1(NDIM,ORD),X2(NDIM,ORD);
Dimension :: V1(NDIM,ORD),V2(NDIM,ORD);
INTERFACE;
FUNCTION K1(DIM,i,X1,X2,V1,V2,NDIM,ORD,nu,maxnu)RESULT (K_1);
integer,intent(in) :: i,DIM,nu;
real(8) :: K_1;
real(8) :: R;
real(8) :: B1;
real(8),intent(in) :: X1,X2,V1,V2;
COMMON/A/M1,M2,Fgauss,H;
integer,intent(in) :: NDIM,ORD,maxnu;
Dimension :: B1(NDIM, ORD);
Dimension :: X1(NDIM,ORD),X2(NDIM,ORD),V1(NDIM,ORD),V2(NDIM,ORD);
Dimension :: K_1(NDIM,ORD);
END FUNCTION K1;
FUNCTION K2(DIM,i,X1,X2,V1,V2,NDIM,ORD,nu,maxnu)RESULT (K_2);
integer,intent(in) :: i,DIM,nu;
real(8) :: K_2;
real(8) :: R;
real(8) :: B2;
real(8),intent(in) :: X1,X2,V1,V2;
COMMON/A/M1,M2,Fgauss,H;
integer,intent(in) :: NDIM,ORD,maxnu;
Dimension :: B2(NDIM,ORD);
Dimension :: X1(NDIM,ORD),X2(NDIM,ORD),V1(NDIM,ORD),V2(NDIM,ORD);
Dimension :: K_2(NDIM,ORD);
END FUNCTION K2;
END INTERFACE;
open(1,file='input.dat');
open(2,file='result.res');
open(3,file='mid.dat');
READ(1,'(A)') STRING;
READ(1,*) Fgauss,H;
READ(1,*) M1,M2;
READ(1,*) X1(1,1),X1(2,1),X1(3,1),V1(1,1),V1(2,1),V1(3,1);
READ(1,*) X2(1,1),X2(2,1),X2(3,1),V2(1,1),V2(2,1),V2(3,1);
WRITE(*,'(A)') STRING;
WRITE(3,'(A)') STRING;
WRITE(3,'(A,2G14.6)')' Fgauss,H:',Fgauss,H;
WRITE(3,'(A,2G14.6)')' M1,M2:',M1,M2;
WRITE(3,'(A,6G17.10)')' X1(1,1),X1(2,1),X1(3,1),V1(1,1),V1(2,1),V1(3,1):',X1(1,1),X1(2,1),X1(3,1),V1(1,1),V1(2,1),V1(3,1);
WRITE(3,'(A,6G17.10)')' X2(1,1),X2(2,1),X2(3,1),V2(1,1),V2(2,1),V2(3,1):',X2(1,1),X2(2,1),X2(3,1),V2(1,1),V2(2,1),V2(3,1);
R=((X1(1,1)-X2(1,1))**2.D0+(X1(2,1)-X2(2,1))**2.D0+(X1(3,1)-X2(3,1))**2.D0)**0.5D0;
N=0;
_WHILE N<=100 _DO;
i=2;
_WHILE i<=ORD _DO;
DIM=1;
_WHILE DIM<=NDIM _DO;
X1(DIM,i)=X1(DIM,i-1)+0.5D0*ABS(i/2)*H*K1(DIM,i-1,X1(DIM,i-1),X2(DIM,i-1),V1(DIM,i-1),V2(DIM,i-1),NDIM,ORD,2,maxnu);
X2(DIM,i)=X2(DIM,i-1)+0.5D0*H*ABS(i/2)*K2(DIM,i-1,X1(DIM,i-1),X2(DIM,i-1),V1(DIM,i-1),V2(DIM,i-1),NDIM,ORD,2,maxnu);
V1(DIM,i)=V1(DIM,i-1)+0.5D0*H*ABS(i/2)*K1(DIM,i-1,X1(DIM,i-1),X2(DIM,i-1),V1(DIM,i-1),V2(DIM,i-1),NDIM,ORD,1,maxnu);
V2(DIM,i)=V2(DIM,i-1)+0.5D0*H*ABS(i/2)*K2(DIM,i-1,X1(DIM,i-1),X2(DIM,i-1),V1(DIM,i-1),V2(DIM,i-1),NDIM,ORD,1,maxnu);
DIM=DIM+1;
_OD;
i=i+1;
_OD;
_WHILE DIM<=NDIM _DO;
X1(DIM,1)=X1(DIM,1)+1.D0/6.D0*H*(K1(DIM,1,X1(DIM,1),X2(DIM,1),V1(DIM,1),V2(DIM,1),NDIM,ORD,2,maxnu)+2.D0*K1(DIM,2,X1(DIM,2),X2(DIM,2),V1(DIM,2),V2(DIM,2),NDIM,ORD,2,maxnu)+2.D0*K1(DIM,3,X1(DIM,3),X2(DIM,3),V1(DIM,3),V2(DIM,3),NDIM,ORD,2,maxnu)+K1(DIM,4,X1(DIM,4),X2(DIM,4),V1(DIM,4),V2(DIM,4),NDIM,ORD,2,maxnu));
X2(DIM,1)=X2(DIM,1)+1.D0/6.D0*H*(K2(DIM,1,X1(DIM,1),X2(DIM,1),V1(DIM,1),V2(DIM,1),NDIM,ORD,2,maxnu)+2.D0*K2(DIM,2,X1(DIM,2),X2(DIM,2),V1(DIM,2),V2(DIM,2),NDIM,ORD,2,maxnu)+2.D0*K2(DIM,3,X1(DIM,3),X2(DIM,3),V1(DIM,3),V2(DIM,3),NDIM,ORD,2,maxnu)+K2(DIM,4,X1(DIM,4),X2(DIM,4),V1(DIM,4),V2(DIM,4),NDIM,ORD,2,maxnu));
V1(DIM,1)=V1(DIM,1)+1.D0/6.D0*H*(K1(DIM,1,X1(DIM,1),X2(DIM,1),V1(DIM,1),V2(DIM,1),NDIM,ORD,1,maxnu)+2.D0*K1(DIM,2,X1(DIM,2),X2(DIM,2),V1(DIM,2),V2(DIM,2),NDIM,ORD,2,maxnu)+2.D0*K2(DIM,3,X1(DIM,3),X2(DIM,3),V1(DIM,3),V2(DIM,3),NDIM,ORD,2,maxnu)+K2(DIM,4,X1(DIM,4),X2(DIM,4),V1(DIM,4),V2(DIM,4),NDIM,ORD,2,maxnu));
V2(DIM,1)=V2(DIM,1)+1.D0/6.D0*H*(K2(DIM,1,X1(DIM,1),X2(DIM,1),V1(DIM,1),V2(DIM,1),NDIM,ORD,1,maxnu)+2.D0*K2(DIM,2,X1(DIM,2),X2(DIM,2),V1(DIM,2),V2(DIM,2),NDIM,ORD,1,maxnu)+2.D0*K2(DIM,3,X1(DIM,3),X2(DIM,3),V1(DIM,3),V2(DIM,3),NDIM,ORD,1,maxnu)+K2(DIM,4,X1(DIM,4),X2(DIM,4),V1(DIM,4),V2(DIM,4),NDIM,ORD,1,maxnu));
_OD;
R=((X1(1,5)-X2(1,5))**2.D0+(X1(2,5)-X2(2,5))**2.D0+(X1(3,5)-X2(3,5))**2.D0)**0.5D0;
N=N+1;
write(2,'(A,1i5,6g12.5)')' N,X1(1,1),X1(2,1),X1(3,1),X2(1,1),X2(2,1),X2(3,1):',N,X1(1,1),X1(2,1),X1(3,1),X2(1,1),X2(2,1),X2(1,1),X2(2,1),X2(3,1);
_OD;
END PROGRAM RUNGEKUTT;
Please, help, it seems, I don't understand something in using functions!
M.S.B. is on the right track, but I think there's enough here to figure out the problem. As noted, function K1 returns a two-dimension array. But all of the other operands in the expression are scalars (well, I don't know what H is, but it likely doesn't matter.) What ends up happening is that the expression evaluates to an array, the scalars getting expanded as needed to match up. You then end up with assigning an array to a scalar, and that's the cause of the error.
I am not familiar enough with Runge-Kutta to be able to suggest what you want instead. But it is likely that you want the function to return a scalar, not an array.
Are you calculating a scaler? If I understand what you are trying to do, the function returns a 2D array, but you only assign to one element of it. Why not have the function return a scaler value instead of an array?
The array message is about an inconsistency between the shapes of arrays in the expression. You haven't shown all of the declarations so we can't figure that out.
Coding style tips: 0) Is there a typo? Should it be Function K1? 1) Semi-colons aren't necessary on the end of each line. Fortran isn't C. 2) At least to me, your code would be more readable if you put all of the declarations pertaining to each variable on one line, instead of separate lines for type, intent and dimension. For example:
real, dimension (NDIM,ORD), intent (in) :: X1
EDIT after the edit of the question:
The machine written code is ugly.
It is clear that you need to do the calculation for all the dimensions. The question is where. The code shows the loops containing the function call rather than the function containing the loops. With this overall design it would make sense that you calculate a single element of the output array (i.e., a scaler variable) and have that be the function return instead of having the function return an array. For this design, it makes little sense to return a 2D array containing only a single used element. And since your statement in the main program expects a scaler, you are getting the error message from the compiler. So redesign your function to return a scaler.
And it looks that you are calling K1 with the actual argument being single elements when arrays are expected. For example, you have X1(DIM,i-1) as a third argument when the function expects an array of size X1(NDIM,ORD). This also a problem, as an inconsistency in actual (i.e., call) and dummy arguments (i.e., function). If function K1 is to do the work of selecting the appropriate array elements, you need to pass it the entire array. If the call is to select the appropriate array elements, then rewrite K1 to have scalers instead of arrays as input arguments. You need a consistent design.

Resources