Related
I want to solve this equation by using Fortran:
Where ψ (psi) is a complex Fortran variable.
Now, I am solving this by defining two new complex variables:
ir=(1.0,0.0) and ii=(0.0,1.0).
I use these to select only the real or imaginary part of the equation. In this way I solve my equation separately for the real and imaginary part. The code is here:
do i = 1,nn
mod2 = (abs(psi(i)))**2
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2*imag(psi(i))) + ii*(beta*real(der2(i)) - alpha*mod2*real(psi(i)))
end do
Where psi and der2 are complex arrays with nn elements.
I want to solve this equation in a better way without splitting it in two equations. I tried to solve it in this way:
mod2 = abs(psi)**2
psi = -ii*(-beta*der2+alpha*mod2*psi)
but it doesn't work because I obtain completely different values with respect to the first method I used. For me it makes sense that it doesn't work because in the second method I am not evaluating the real part. Is this right?
As an example, the 10° element of my psi array becomes:\
(-6.39094355774850412E-003,-6.04041029332164168E-003) (with 1° method)\
(-1.75266632213431602E-004,-6.21567692553507290E-003) (2° method)\
Any suggestion?
Thank you!
The problem is mod2 = abs(psi)**2 should have been mod2 = abs(dat)**2
But I think that the correct calculation for mod2 is sum( real( dat*conjg(dat) ) )
I get the same result with both methods with some arbitrary data:
eq1=
(-595.000000000000,-120.200000000000)
(-713.800000000000,-1.40000000000000)
(-832.600000000000,117.400000000000)
(-951.400000000000,236.200000000000)
(-1070.20000000000,355.000000000000)
(-1189.00000000000,473.800000000000)
(-1307.80000000000,592.600000000000)
(-1426.60000000000,711.400000000000)
(-1545.40000000000,830.200000000000)
(-1664.20000000000,949.000000000000)
eq2=
(-595.000000000000,-120.200000000000)
(-713.800000000000,-1.40000000000000)
(-832.600000000000,117.400000000000)
(-951.400000000000,236.200000000000)
(-1070.20000000000,355.000000000000)
(-1189.00000000000,473.800000000000)
(-1307.80000000000,592.600000000000)
(-1426.60000000000,711.400000000000)
(-1545.40000000000,830.200000000000)
(-1664.20000000000,949.000000000000)
Test code
program Console1
use,intrinsic :: iso_fortran_env
implicit none
! Variables
integer, parameter :: sp=real32, wp=real64
complex(wp), parameter :: ir = (1d0,0d0), ii = (0d0,1d0)
real(wp), parameter :: alpha = 0.1d0, beta = 0.2d0
integer, parameter :: n=10
complex(wp) :: dat(n), psi(n), der2(n)
integer :: i
! Body of Console1
dat = [ ( (2d0-i)*ir - (4d0+i)*ii, i=1,n ) ]
der2 = [ ( -(5d0+i)*ir + (1d0-i)*ii, i=1,n ) ]
psi = eq1(dat, der2)
print *, "eq1="
do i=1,n
print *, psi(i)
end do
psi = eq2(dat, der2)
print *, "eq2="
do i=1,n
print *, psi(i)
end do
contains
function eq1(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(psi))
complex(wp) :: psi(size(dat))
real(wp) :: mod2
integer :: i
mod2 = sum( real( dat*conjg(dat) ) )
do i=1, size(psi)
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2*imag(dat(i))) + ii*(beta*real(der2(i)) - alpha*mod2*real(dat(i)))
end do
end function
function eq2(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(dat))
complex(wp) :: psi(size(dat))
real(wp) :: mod2
mod2 = sum( real( dat*conjg(dat) ) )
psi = -ii*(-beta*der2+alpha*mod2*dat)
end function
end program Console1
Also with your definition of |ψ| we have also consistent results.
eq1=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
eq2=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
with code
function eq1(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(psi))
complex(wp) :: psi(size(dat))
real(wp) :: mod2(size(dat))
integer :: i
mod2 = abs(dat)**2
do i=1, size(psi)
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2(i)*imag(dat(i))) + ii*(beta*real(der2(i)) - alpha*mod2(i)*real(dat(i)))
end do
end function
function eq2(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(dat))
complex(wp) :: psi(size(dat))
real(wp) :: mod2(size(dat))
mod2 = abs(dat)**2
psi = -ii*(-beta*der2+alpha*mod2*dat)
end function
Going back to the original problem, I can replicate the issue
eq1=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
eq2=
(0.000000000000000E+000,-1.20000000000000)
(0.200000000000000,-1.40000000000000)
(0.400000000000000,-1.60000000000000)
(0.600000000000000,-1.80000000000000)
(0.800000000000000,-2.00000000000000)
(-1952.64000000000,779.256000000000)
(NaN,NaN)
(1.40000000000000,-2.60000000000000)
(NaN,NaN)
(1.80000000000000,-3.00000000000000)
with mod2 = abs(psi)**2 instead of mod2 = abs(dat)**2
How can overload operator(+) and assigment(-) for my class?
the compiler shows me the following message
Error: Component to the right of a part reference with nonzero rank must not have the ALLOCATABLE
attribute at (1).
For the assigment(=), I have no idea how to do it.
For c ++ it was easier. Return pointner this
function zmat_zmat_add(zmatrix1,zmatrix2) result(res_zmat_zmat)
type(zmatrix_type), dimension(:,:), intent(in) :: zmatrix1
type(zmatrix_type), dimension(:,:), intent(in) :: zmatrix2
type(zmatrix_type) :: res_zmat_zmat
integer :: rows
integer :: i,j ! liczniki pętli
rows=3
do i=1, rows
do j=1, rows
res_zmat_zmat%zmatrix_data(i,j)%realis= &
zmatrix1%zmatrix_data(i,j)%realis + zmatrix2%zmatrix_data(i,j)%realis
res_zmat_zmat%zmatrix_data(i,j)%imaginalis = &
zmatrix1%zmatrix_data(i,j)%imaginalis + &
zmatrix2%zmatrix_data(i,j)%imaginalis
enddo
enddo
end function zmat_zmat_add
rest code
module zmatrix_module
implicit none
type, public :: zcomplex_type
real :: realis
real :: imaginalis
end type zcomplex_type
type, extends(zcomplex_type), public :: zmatrix_type
type(zcomplex_type), dimension(:,:), allocatable, public :: zmatrix_data
end type zmatrix_type
public :: zmatrix_allocate
public :: zmatrix_free
public :: zmatrix_set
public :: zmatrix_print
interface operator(+)
procedure zzadd
procedure zmat_zmat_add
end interface
contains
function zzadd(z1,z2) result(res)
type(zcomplex_type), intent(in) :: z1
type(zcomplex_type), intent(in) :: z2
type(zcomplex_type) :: res
res%realis=z1%realis+z2%realis
res%imaginalis= z1%imaginalis +z2%imaginalis
end function zzadd
function zmat_zmat_add(zmatrix1,zmatrix2) result(res_zmat_zmat)
type(zmatrix_type), dimension(:,:), intent(in) :: zmatrix1
type(zmatrix_type), dimension(:,:), intent(in) :: zmatrix2
type(zmatrix_type) :: res_zmat_zmat
integer :: rows
integer :: i,j
rows=3
do i=1, rows
do j=1, rows
res_zmat_zmat%zmatrix_data(i,j)%realis= &
zmatrix1%zmatrix_data(i,j)%realis + zmatrix2%zmatrix_data(i,j)%realis
res_zmat_zmat%zmatrix_data(i,j)%imaginalis = &
zmatrix1%zmatrix_data(i,j)%imaginalis + &
zmatrix2%zmatrix_data(i,j)%imaginalis
enddo
enddo
end function zmat_zmat_add
subroutine zmatrix_allocate(zarray,rows)
type(zmatrix_type), intent(out) :: zarray
integer, intent(in) :: rows
allocate(zarray%zmatrix_data(1:rows, 1:rows))
end subroutine zmatrix_allocate
subroutine zmatrix_free(zarray)
type(zmatrix_type), intent(inout) :: zarray
deallocate(zarray%zmatrix_data)
end subroutine zmatrix_free
subroutine zmatrix_set(zarray, rows, re_values, im_values)
type(zmatrix_type), intent(inout) :: zarray
integer, intent(in) :: rows
real, intent(in) :: re_values, im_values
integer :: i,j
do i=1, rows
do j=1, rows
zarray%zmatrix_data(i,j)%realis = re_values
zarray%zmatrix_data(i,j)%imaginalis = im_values
enddo
enddo
end subroutine zmatrix_set
subroutine zmatrix_print(array,rows)
type(zmatrix_type), intent(in) :: array
integer, intent(in) :: rows
integer i,j
do i=1, rows
write(*,*) (array%zmatrix_data(i,j), j=1, rows)
enddo
write(*,*)
end subroutine zmatrix_print
end module zmatrix_module
Program main
use zmatrix_module
implicit none
type(zmatrix_type) :: mat1
type(zmatrix_type) :: mat2
type(zmatrix_type) :: mat3
type(zcomplex_type) :: z1
type(zcomplex_type) :: z2
type(zcomplex_type) :: z3
integer :: rows
rows=2
print *, " AAAAAAA"
call zmatrix_allocate(mat1,rows)
call zmatrix_set(mat1,rows,10.0,8.0)
call zmatrix_print(mat1,rows)
print *, "BBBBBBBB"
call zmatrix_allocate(mat2,rows)
call zmatrix_set(mat2,rows,1.0,2.0)
call zmatrix_print(mat2,rows)
print *, "CCCCCC"
call zmatrix_allocate(mat3,rows)
mat3=zmat_zmat_add(mat1,mat2)
mat3=mat1+mat2
call zmatrix_print(mat3,rows)
call zmatrix_free(mat1)
call zmatrix_free(mat2)
call zmatrix_free(mat3)
End Program main
The comments point out the immediate problem - you don't need the dimension attribute in the zmat_zmat_add routine - you are adding a single matrix to another matrix, not an array of matrix to another array of matrices. Thus you have a scalar of the appropriate type for each dummy argument.
However as the actual question indicates there is a second problem, how to allocate the result array for zmat_zmat_add. Well, you make the result allocatable and allocate it! I've shown in the first code below the most direct way to solve the problems you are showing. However the code you have written reads a bit like writing C++ as Fortran. This is not the best way to solve this problem, and so I have provided a second solution which is a much more Fortran way of doing things. This is below the first code. Anyway here the quick and dirty fix to your code:
ijb#ijb-Latitude-5410:~/work/stack$ cat zm1.f90
module zmatrix_module
implicit none
type, public :: zcomplex_type
real :: realis
real :: imaginalis
end type zcomplex_type
type, extends(zcomplex_type), public :: zmatrix_type
type(zcomplex_type), dimension(:,:), allocatable, public :: zmatrix_data
end type zmatrix_type
public :: zmatrix_allocate
public :: zmatrix_free
public :: zmatrix_set
public :: zmatrix_print
interface operator(+)
procedure zzadd
procedure zmat_zmat_add
end interface
contains
function zzadd(z1,z2) result(res)
type(zcomplex_type), intent(in) :: z1
type(zcomplex_type), intent(in) :: z2
type(zcomplex_type) :: res
res%realis=z1%realis+z2%realis
res%imaginalis= z1%imaginalis +z2%imaginalis
end function zzadd
function zmat_zmat_add(zmatrix1,zmatrix2) result(res_zmat_zmat)
type(zmatrix_type), intent(in) :: zmatrix1
type(zmatrix_type), intent(in) :: zmatrix2
type(zmatrix_type) :: res_zmat_zmat
integer :: cols, rows
integer :: i,j
rows = Size( zmatrix1%zmatrix_data, Dim = 1 )
cols = Size( zmatrix1%zmatrix_data, Dim = 2 )
Allocate( res_zmat_zmat%zmatrix_data( 1:rows, 1:cols ) )
do i=1, rows
do j=1, cols
res_zmat_zmat%zmatrix_data(i,j)%realis= &
zmatrix1%zmatrix_data(i,j)%realis + zmatrix2%zmatrix_data(i,j)%realis
res_zmat_zmat%zmatrix_data(i,j)%imaginalis = &
zmatrix1%zmatrix_data(i,j)%imaginalis + &
zmatrix2%zmatrix_data(i,j)%imaginalis
enddo
enddo
end function zmat_zmat_add
subroutine zmatrix_allocate(zarray,rows)
type(zmatrix_type), intent(out) :: zarray
integer, intent(in) :: rows
allocate(zarray%zmatrix_data(1:rows, 1:rows))
end subroutine zmatrix_allocate
subroutine zmatrix_free(zarray)
type(zmatrix_type), intent(inout) :: zarray
deallocate(zarray%zmatrix_data)
end subroutine zmatrix_free
subroutine zmatrix_set(zarray, rows, re_values, im_values)
type(zmatrix_type), intent(inout) :: zarray
integer, intent(in) :: rows
real, intent(in) :: re_values, im_values
integer :: i,j
do i=1, rows
do j=1, rows
zarray%zmatrix_data(i,j)%realis = re_values
zarray%zmatrix_data(i,j)%imaginalis = im_values
enddo
enddo
end subroutine zmatrix_set
subroutine zmatrix_print(array,rows)
type(zmatrix_type), intent(in) :: array
integer, intent(in) :: rows
integer i,j
do i=1, rows
write(*,*) (array%zmatrix_data(i,j), j=1, rows)
enddo
write(*,*)
end subroutine zmatrix_print
end module zmatrix_module
Program main
use zmatrix_module
implicit none
type(zmatrix_type) :: mat1
type(zmatrix_type) :: mat2
type(zmatrix_type) :: mat3
integer :: rows
rows=2
print *, " AAAAAAA"
call zmatrix_allocate(mat1,rows)
call zmatrix_set(mat1,rows,10.0,8.0)
call zmatrix_print(mat1,rows)
print *, "BBBBBBBB"
call zmatrix_allocate(mat2,rows)
call zmatrix_set(mat2,rows,1.0,2.0)
call zmatrix_print(mat2,rows)
print *, "CCCCCC"
call zmatrix_allocate(mat3,rows)
mat3=zmat_zmat_add(mat1,mat2)
mat3=mat1+mat2
call zmatrix_print(mat3,rows)
call zmatrix_free(mat1)
call zmatrix_free(mat2)
call zmatrix_free(mat3)
End Program main
ijb#ijb-Latitude-5410:~/work/stack$ gfortran --version
GNU Fortran (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
ijb#ijb-Latitude-5410:~/work/stack$ gfortran -std=f2018 -Wall -Wextra -fcheck=all -O -Wuse-without-only zm1.f90 -o zm1
zm1.f90:99:4:
99 | use zmatrix_module
| 1
Warning: USE statement at (1) has no ONLY qualifier [-Wuse-without-only]
ijb#ijb-Latitude-5410:~/work/stack$ ./zm1
AAAAAAA
10.0000000 8.00000000 10.0000000 8.00000000
10.0000000 8.00000000 10.0000000 8.00000000
BBBBBBBB
1.00000000 2.00000000 1.00000000 2.00000000
1.00000000 2.00000000 1.00000000 2.00000000
CCCCCC
11.0000000 10.0000000 11.0000000 10.0000000
11.0000000 10.0000000 11.0000000 10.0000000
ijb#ijb-Latitude-5410:~/work/stack$
As I say this is not a very "Fortran" way of solving this. Here is what I would do. Note
The intrinsic Complex data type
Array syntax to simplify the code
Allocation of allocatable arrays when they are the result of a calculation, again simplifying the code
Use of intrinsics to find properties of arrays rather than carrying around extra variables which contain duplicate information
Type bound procedures
(Not really only Fortran but use of private for encapsulation and to minimise name space pollution)
Quite probably others
Anyway here goes
Module zmatrix_module
Implicit None
Type, Public :: zmatrix_type
Private
Complex, Dimension(:,:), Allocatable, Private :: zmatrix_data
Contains
Procedure, Public :: allocate => zmatrix_allocate
Procedure, Public :: free => zmatrix_free
Procedure, Public :: set => zmatrix_set
Procedure, Public :: print => zmatrix_print
Generic , Public :: Operator( + ) => add
Procedure, Private :: add => zmat_zmat_add
End Type zmatrix_type
Private
Contains
Function zmat_zmat_add(zmatrix1,zmatrix2) Result(res_zmat_zmat)
Class(zmatrix_type), Intent(in) :: zmatrix1
Type (zmatrix_type), Intent(in) :: zmatrix2
Type (zmatrix_type) :: res_zmat_zmat
! Uses allocation on assignment
! Also use array syntax to simplify code
res_zmat_zmat%zmatrix_data = zmatrix1%zmatrix_data + zmatrix2%zmatrix_data
End Function zmat_zmat_add
Subroutine zmatrix_allocate(zarray,rows)
! Note Intent(out) ensures the array is deallocate on entry to the routine
Class(zmatrix_type), Intent(out) :: zarray
Integer, Intent(in) :: rows
Allocate(zarray%zmatrix_data(1:rows, 1:rows))
End Subroutine zmatrix_allocate
Subroutine zmatrix_free(zarray)
Class(zmatrix_type), Intent(inout) :: zarray
Deallocate(zarray%zmatrix_data)
End Subroutine zmatrix_free
Subroutine zmatrix_set(zarray, values )
Class(zmatrix_type), Intent(inout) :: zarray
Complex, Intent(in) :: values
zarray%zmatrix_data = values
End Subroutine zmatrix_set
Subroutine zmatrix_print(array)
Class(zmatrix_type), Intent(in) :: array
Integer :: i
! Don't need to carry around extra data, just ask the array its size
Do i=1, Size( array%zmatrix_data, Dim = 1 )
Write(*,*) array%zmatrix_data(i,:)
Enddo
Write(*,*)
End Subroutine zmatrix_print
End Module zmatrix_module
Program main
Use zmatrix_module, Only : zmatrix_type
Implicit None
Type( zmatrix_type ) :: mat1
Type( zmatrix_type ) :: mat2
Type( zmatrix_type ) :: mat3
Integer :: rows
rows=2
Print *, " AAAAAAA"
Call mat1%allocate( rows )
Call mat1%set( ( 10.0, 8.0 ) )
Call mat1%print()
Print *, "BBBBBBBB"
Call mat2%allocate( rows )
Call mat2%set( ( 1.0, 2.0 ) )
Call mat2%print()
Print *, "CCCCCC"
! Note mat3 gets auto-allocated as a result of the operation
mat3 = mat1 + mat2
Call mat3%print()
Call mat3%free()
Call mat2%free()
Call mat1%free()
End Program main
ijb#ijb-Latitude-5410:~/work/stack$ gfortran --version
GNU Fortran (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
ijb#ijb-Latitude-5410:~/work/stack$ gfortran -std=f2018 -Wall -Wextra -fcheck=all -O -Wuse-without-only zm2.f90 -o zm2
ijb#ijb-Latitude-5410:~/work/stack$ ./zm2
AAAAAAA
(10.0000000,8.00000000) (10.0000000,8.00000000)
(10.0000000,8.00000000) (10.0000000,8.00000000)
BBBBBBBB
(1.00000000,2.00000000) (1.00000000,2.00000000)
(1.00000000,2.00000000) (1.00000000,2.00000000)
CCCCCC
(11.0000000,10.0000000) (11.0000000,10.0000000)
(11.0000000,10.0000000) (11.0000000,10.0000000)
ijb#ijb-Latitude-5410:~/work/stack$
There is another way which would fit this nicely, namely parametrised derived types. But I have no experience here so I won't go into something I don't know.
#Ian Bush mentioned in his answer that another option is to use the feature called parameterized derived types.
I will show a sample implementation here using those type parameters. Here are some callouts, first:
With this you might reduce the need for allocatable variables, because you can specify the shape of your type-members at compile-time or runtime.
If you want to learn more about parameterized types, this article is a good starting point.
This was introduced in Fortran 2003. The availability of this feature depends on the compiler. Even some compilers that claim to be fully compliant with Fortran 2003 might fail to compile (for example, gfortran fails in several points of the following code).
Sample implementation:
module zmatrix_module
implicit none
private
! A parameterized-type is declared like this.
type, public :: zmatrix(rows)
! Delcare each parameter inside the type. In this case it is a len-type.
integer, len :: rows
private
! You can use a len-type parameter in initialization expressions.
complex :: data(rows, rows)
contains
! No need for `allocate` and `free` procedures anymore.
procedure, public :: set => zmat_set
procedure, public :: print => zmat_print
procedure :: add => zmat_add_zmat
generic, public :: operator(+) => add
end type
contains
function zmat_add_zmat(z1, z2) result(out)
class(zmatrix(*)), intent(in) :: z1
type(zmatrix(*)), intent(in) :: z2
! Match the len parameter of the output with the input.
type(zmatrix(z1%rows)) :: out
out%data = z1%data + z2%data
end
subroutine zmat_set(z, values)
class(zmatrix(*)), intent(inout) :: z
complex, intent(in) :: values
z%data = values
end
subroutine zmat_print(z)
class(zmatrix(*)), intent(in) :: z
integer :: i
! You can inquiry the type parameter with a syntax similar to structure field.
do i=1, z%rows
write(*,*) z%data(i,:)
end do
write(*,*)
end
end
Sample program using:
program main
use zmatrix_module, only : zmatrix
implicit None
integer, parameter :: rows = 2
! A constant or initialization expression are allowed as the len parameter.
type(zmatrix(rows)) :: mat1
type(zmatrix(rows)) :: mat2
! If you declare an allocatable, you might declare the len parameter as deferred.
type(zmatrix(:)), allocatable :: mat3(:)
call mat1%set((10.0, 8.0))
call mat2%set((1.0, 2.0))
! Note mat3 gets auto-allocated as a result of the operation.
mat3 = mat1 + mat2
! You can also allocate the object explicitly, or using a source/mold.
! allocate(zmatrix(2) :: mat3)
! allocate(mat3, source=mat1)
call mat3%print()
end
First of all, I know Julia does have an svd intrinsic function, but it does not exactly do what I need. Instead, svdcmp from Numerical Recipes does.
So, the subroutine is this:
MODULE nrtype
INTEGER, PARAMETER :: I4B = SELECTED_INT_KIND(9)
INTEGER, PARAMETER :: I2B = SELECTED_INT_KIND(4)
INTEGER, PARAMETER :: I1B = SELECTED_INT_KIND(2)
INTEGER, PARAMETER :: SP = KIND(1.0)
INTEGER, PARAMETER :: DP = KIND(1.0D0)
INTEGER, PARAMETER :: SPC = KIND((1.0,1.0))
INTEGER, PARAMETER :: DPC = KIND((1.0D0,1.0D0))
INTEGER, PARAMETER :: LGT = KIND(.true.)
REAL(SP), PARAMETER :: PI=3.141592653589793238462643383279502884197_sp
REAL(SP), PARAMETER :: PIO2=1.57079632679489661923132169163975144209858_sp
REAL(SP), PARAMETER :: TWOPI=6.283185307179586476925286766559005768394_sp
REAL(SP), PARAMETER :: SQRT2=1.41421356237309504880168872420969807856967_sp
REAL(SP), PARAMETER :: EULER=0.5772156649015328606065120900824024310422_sp
REAL(DP), PARAMETER :: PI_D=3.141592653589793238462643383279502884197_dp
REAL(DP), PARAMETER :: PIO2_D=1.57079632679489661923132169163975144209858_dp
REAL(DP), PARAMETER :: TWOPI_D=6.283185307179586476925286766559005768394_dp
TYPE sprs2_sp
INTEGER(I4B) :: n,len
REAL(SP), DIMENSION(:), POINTER :: val
INTEGER(I4B), DIMENSION(:), POINTER :: irow
INTEGER(I4B), DIMENSION(:), POINTER :: jcol
END TYPE sprs2_sp
TYPE sprs2_dp
INTEGER(I4B) :: n,len
REAL(DP), DIMENSION(:), POINTER :: val
INTEGER(I4B), DIMENSION(:), POINTER :: irow
INTEGER(I4B), DIMENSION(:), POINTER :: jcol
END TYPE sprs2_dp
END MODULE nrtype
MODULE nrutil
USE nrtype
IMPLICIT NONE
INTEGER(I4B), PARAMETER :: NPAR_ARTH=16,NPAR2_ARTH=8
INTEGER(I4B), PARAMETER :: NPAR_GEOP=4,NPAR2_GEOP=2
INTEGER(I4B), PARAMETER :: NPAR_CUMSUM=16
INTEGER(I4B), PARAMETER :: NPAR_CUMPROD=8
INTEGER(I4B), PARAMETER :: NPAR_POLY=8
INTEGER(I4B), PARAMETER :: NPAR_POLYTERM=8
INTERFACE assert_eq
MODULE PROCEDURE assert_eq2,assert_eq3,assert_eq4,assert_eqn
END INTERFACE
INTERFACE outerprod
MODULE PROCEDURE outerprod_r,outerprod_d
END INTERFACE
CONTAINS
FUNCTION assert_eq2(n1,n2,string)
CHARACTER(LEN=*), INTENT(IN) :: string
INTEGER, INTENT(IN) :: n1,n2
INTEGER :: assert_eq2
if (n1 == n2) then
assert_eq2=n1
else
write (*,*) 'nrerror: an assert_eq failed with this tag:', &
string
STOP 'program terminated by assert_eq2'
end if
END FUNCTION assert_eq2
!BL
FUNCTION assert_eq3(n1,n2,n3,string)
CHARACTER(LEN=*), INTENT(IN) :: string
INTEGER, INTENT(IN) :: n1,n2,n3
INTEGER :: assert_eq3
if (n1 == n2 .and. n2 == n3) then
assert_eq3=n1
else
write (*,*) 'nrerror: an assert_eq failed with this tag:', &
string
STOP 'program terminated by assert_eq3'
end if
END FUNCTION assert_eq3
!BL
FUNCTION assert_eq4(n1,n2,n3,n4,string)
CHARACTER(LEN=*), INTENT(IN) :: string
INTEGER, INTENT(IN) :: n1,n2,n3,n4
INTEGER :: assert_eq4
if (n1 == n2 .and. n2 == n3 .and. n3 == n4) then
assert_eq4=n1
else
write (*,*) 'nrerror: an assert_eq failed with this tag:', &
string
STOP 'program terminated by assert_eq4'
end if
END FUNCTION assert_eq4
!BL
FUNCTION assert_eqn(nn,string)
CHARACTER(LEN=*), INTENT(IN) :: string
INTEGER, DIMENSION(:), INTENT(IN) :: nn
INTEGER :: assert_eqn
if (all(nn(2:) == nn(1))) then
assert_eqn=nn(1)
else
write (*,*) 'nrerror: an assert_eq failed with this tag:', &
string
STOP 'program terminated by assert_eqn'
end if
END FUNCTION assert_eqn
!BL
SUBROUTINE nrerror(string)
CHARACTER(LEN=*), INTENT(IN) :: string
write (*,*) 'nrerror: ',string
STOP 'program terminated by nrerror'
END SUBROUTINE nrerror
!BL
FUNCTION outerprod_r(a,b)
REAL(SP), DIMENSION(:), INTENT(IN) :: a,b
REAL(SP), DIMENSION(size(a),size(b)) :: outerprod_r
outerprod_r = spread(a,dim=2,ncopies=size(b)) * &
spread(b,dim=1,ncopies=size(a))
END FUNCTION outerprod_r
!BL
FUNCTION outerprod_d(a,b)
REAL(DP), DIMENSION(:), INTENT(IN) :: a,b
REAL(DP), DIMENSION(size(a),size(b)) :: outerprod_d
outerprod_d = spread(a,dim=2,ncopies=size(b)) * &
spread(b,dim=1,ncopies=size(a))
END FUNCTION outerprod_d
!BL
END MODULE nrutil
MODULE nr
INTERFACE pythag
FUNCTION pythag_dp(a,b)
USE nrtype
REAL(DP), INTENT(IN) :: a,b
REAL(DP) :: pythag_dp
END FUNCTION pythag_dp
!BL
FUNCTION pythag_sp(a,b)
USE nrtype
REAL(SP), INTENT(IN) :: a,b
REAL(SP) :: pythag_sp
END FUNCTION pythag_sp
END INTERFACE
END MODULE nr
SUBROUTINE svdcmp_dp(a,w,v)
USE nrtype; USE nrutil, ONLY : assert_eq,nrerror,outerprod
USE nr, ONLY : pythag
IMPLICIT NONE
REAL(DP), DIMENSION(:,:), INTENT(INOUT) :: a
REAL(DP), DIMENSION(:), INTENT(OUT) :: w
REAL(DP), DIMENSION(:,:), INTENT(OUT) :: v
INTEGER(I4B) :: i,its,j,k,l,m,n,nm
REAL(DP) :: anorm,c,f,g,h,s,scale,x,y,z
REAL(DP), DIMENSION(size(a,1)) :: tempm
REAL(DP), DIMENSION(size(a,2)) :: rv1,tempn
m=size(a,1)
write(*,*)"size(a,1)= ",size(a,1)
write(*,*)"size(a,2)= ",size(a,2)
write(*,*)"size(v,1)= ",size(v,1)
write(*,*)"size(v,2)= ",size(v,2)
write(*,*)"size(w) = ",size(w)
n=assert_eq(size(a,2),size(v,1),size(v,2),size(w),'svdcmp_dp')
g=0.0
scale=0.0
do i=1,n
l=i+1
rv1(i)=scale*g
g=0.0
scale=0.0
if (i <= m) then
scale=sum(abs(a(i:m,i)))
if (scale /= 0.0) then
a(i:m,i)=a(i:m,i)/scale
s=dot_product(a(i:m,i),a(i:m,i))
f=a(i,i)
g=-sign(sqrt(s),f)
h=f*g-s
a(i,i)=f-g
tempn(l:n)=matmul(a(i:m,i),a(i:m,l:n))/h
a(i:m,l:n)=a(i:m,l:n)+outerprod(a(i:m,i),tempn(l:n))
a(i:m,i)=scale*a(i:m,i)
end if
end if
w(i)=scale*g
g=0.0
scale=0.0
if ((i <= m) .and. (i /= n)) then
scale=sum(abs(a(i,l:n)))
if (scale /= 0.0) then
a(i,l:n)=a(i,l:n)/scale
s=dot_product(a(i,l:n),a(i,l:n))
f=a(i,l)
g=-sign(sqrt(s),f)
h=f*g-s
a(i,l)=f-g
rv1(l:n)=a(i,l:n)/h
tempm(l:m)=matmul(a(l:m,l:n),a(i,l:n))
a(l:m,l:n)=a(l:m,l:n)+outerprod(tempm(l:m),rv1(l:n))
a(i,l:n)=scale*a(i,l:n)
end if
end if
end do
anorm=maxval(abs(w)+abs(rv1))
do i=n,1,-1
if (i < n) then
if (g /= 0.0) then
v(l:n,i)=(a(i,l:n)/a(i,l))/g
tempn(l:n)=matmul(a(i,l:n),v(l:n,l:n))
v(l:n,l:n)=v(l:n,l:n)+outerprod(v(l:n,i),tempn(l:n))
end if
v(i,l:n)=0.0
v(l:n,i)=0.0
end if
v(i,i)=1.0
g=rv1(i)
l=i
end do
do i=min(m,n),1,-1
l=i+1
g=w(i)
a(i,l:n)=0.0
if (g /= 0.0) then
g=1.0_dp/g
tempn(l:n)=(matmul(a(l:m,i),a(l:m,l:n))/a(i,i))*g
a(i:m,l:n)=a(i:m,l:n)+outerprod(a(i:m,i),tempn(l:n))
a(i:m,i)=a(i:m,i)*g
else
a(i:m,i)=0.0
end if
a(i,i)=a(i,i)+1.0_dp
end do
do k=n,1,-1
do its=1,30
do l=k,1,-1
nm=l-1
if ((abs(rv1(l))+anorm) == anorm) exit
if ((abs(w(nm))+anorm) == anorm) then
c=0.0
s=1.0
do i=l,k
f=s*rv1(i)
rv1(i)=c*rv1(i)
if ((abs(f)+anorm) == anorm) exit
g=w(i)
h=pythag(f,g)
w(i)=h
h=1.0_dp/h
c= (g*h)
s=-(f*h)
tempm(1:m)=a(1:m,nm)
a(1:m,nm)=a(1:m,nm)*c+a(1:m,i)*s
a(1:m,i)=-tempm(1:m)*s+a(1:m,i)*c
end do
exit
end if
end do
z=w(k)
if (l == k) then
if (z < 0.0) then
w(k)=-z
v(1:n,k)=-v(1:n,k)
end if
exit
end if
if (its == 30) call nrerror('svdcmp_dp: no convergence in svdcmp')
x=w(l)
nm=k-1
y=w(nm)
g=rv1(nm)
h=rv1(k)
f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0_dp*h*y)
g=pythag(f,1.0_dp)
f=((x-z)*(x+z)+h*((y/(f+sign(g,f)))-h))/x
c=1.0
s=1.0
do j=l,nm
i=j+1
g=rv1(i)
y=w(i)
h=s*g
g=c*g
z=pythag(f,h)
rv1(j)=z
c=f/z
s=h/z
f= (x*c)+(g*s)
g=-(x*s)+(g*c)
h=y*s
y=y*c
tempn(1:n)=v(1:n,j)
v(1:n,j)=v(1:n,j)*c+v(1:n,i)*s
v(1:n,i)=-tempn(1:n)*s+v(1:n,i)*c
z=pythag(f,h)
w(j)=z
if (z /= 0.0) then
z=1.0_dp/z
c=f*z
s=h*z
end if
f= (c*g)+(s*y)
x=-(s*g)+(c*y)
tempm(1:m)=a(1:m,j)
a(1:m,j)=a(1:m,j)*c+a(1:m,i)*s
a(1:m,i)=-tempm(1:m)*s+a(1:m,i)*c
end do
rv1(l)=0.0
rv1(k)=f
w(k)=x
end do
end do
END SUBROUTINE svdcmp_dp
Note that I include only the portions of the modules that I need (just for this case). then, I compile this into a shared library like:
gfortran -shared -fPIC svdcmp_dp.f90 -o svdcmp_dp.so
so far, so good.
The next thing I do is in Julia:
julia> M=5
julia> a=rand(M,M) #just to see if it works
julia> v=zeros(M,M)
julia> w=zeros(M)
julia> t=ccall((:svdcmp_dp_, "./svdcmp_dp.so")
, Void
, ( Ref{Float64} # array a(mp,np)
, Ref{Float64} # array w
, Ref{Float64} # array v
)
,a,w,v)
and I get:
julia> t=ccall((:svdcmp_dp_, "./svdcmp_dp.so")
, Void
, ( Ref{Float64} # array a(mp,np)
, Ref{Float64} # array w
, Ref{Float64} # array v
)
,a,w,v)
size(a,1)= 0
size(a,2)= 0
size(v,1)= 1
size(v,2)= 1
size(w) = 1
nrerror: an assert_eq failed with this tag:svdcmp_dp
STOP program terminated by assert_eq4
So, actually, my calling is OK, but apparently, the size intrinsic from Fortran 90 is NOT returning what I would expect. I say this because the first line in svdcmp_dp.f90 is calling the function assert_eq4 and determine that the dimensions are not compatible. This is not supposed to happen as I chose a[5 X 5], w[5], v[5,5], right?
I search about size in F90, and find out this:
Description:
Determine the extent of ARRAY along a specified dimension DIM, or the total number of elements in ARRAY if DIM is absent.
Standard:
Fortran 95 and later, with KIND argument Fortran 2003 and later
Class:
Inquiry function
Syntax:
RESULT = SIZE(ARRAY[, DIM [, KIND]])
Arguments:
ARRAY Shall be an array of any type. If ARRAY is a pointer
it must be associated and allocatable arrays must be allocated.
DIM (Optional) shall be a scalar of type INTEGER and its value shall
be in the range from 1 to n, where n equals the rank of ARRAY.
KIND (Optional) An INTEGER initialization expression indicating the
kind parameter of the result.
So, my guess is that the problem is related with the allocable property of a,v & w. Or the pointer issue (zero experience with pointers!)
I have actually solve this issue by replacing the declarations from:
SUBROUTINE svdcmp_dp(a,w,v)
USE nrtype; USE nrutil, ONLY : assert_eq,nrerror,outerprod
USE nr, ONLY : pythag
IMPLICIT NONE
REAL(DP), DIMENSION(:,:), INTENT(INOUT) :: a
REAL(DP), DIMENSION(:), INTENT(OUT) :: w
REAL(DP), DIMENSION(:,:), INTENT(OUT) :: v
INTEGER(I4B) :: i,its,j,k,l,m,n,nm
REAL(DP) :: anorm,c,f,g,h,s,scale,x,y,z
REAL(DP), DIMENSION(size(a,1)) :: tempm
REAL(DP), DIMENSION(size(a,2)) :: rv1,tempn
m=size(a,1)
to :
SUBROUTINE svdcmp_dp(Ma,Na,a,w,v)
USE nrtype; USE nrutil, ONLY : assert_eq,nrerror,outerprod
USE nr, ONLY : pythag
IMPLICIT NONE
INTEGER(I4B) :: i,its,j,k,l,Ma,Na,m,n,nm
REAL(DP), DIMENSION(Ma,Na), INTENT(INOUT) :: a
REAL(DP), DIMENSION(Na), INTENT(INOUT) :: w
REAL(DP), DIMENSION(Na,Na), INTENT(INOUT) :: v
REAL(DP) :: anorm,c,f,g,h,s,scale,x,y,z
REAL(DP), DIMENSION(size(a,1)) :: tempm
REAL(DP), DIMENSION(size(a,2)) :: rv1,tempn
Note that the last one also incudes the dimentions of the input arrays!
PD:
Also, the code need the module(it was incomplete):
MODULE nr
INTERFACE pythag
MODULE PROCEDURE pythag_dp, pythag_sp
END INTERFACE
CONTAINS
FUNCTION pythag_dp(a,b)
USE nrtype
IMPLICIT NONE
REAL(DP), INTENT(IN) :: a,b
REAL(DP) :: pythag_dp
REAL(DP) :: absa,absb
absa=abs(a)
absb=abs(b)
if (absa > absb) then
pythag_dp=absa*sqrt(1.0_dp+(absb/absa)**2)
else
if (absb == 0.0) then
pythag_dp=0.0
else
pythag_dp=absb*sqrt(1.0_dp+(absa/absb)**2)
end if
end if
END FUNCTION pythag_dp
!BL
FUNCTION pythag_sp(a,b)
USE nrtype
IMPLICIT NONE
REAL(SP), INTENT(IN) :: a,b
REAL(SP) :: pythag_sp
REAL(SP) :: absa,absb
absa=abs(a)
absb=abs(b)
if (absa > absb) then
pythag_sp=absa*sqrt(1.0_sp+(absb/absa)**2)
else
if (absb == 0.0) then
pythag_sp=0.0
else
pythag_sp=absb*sqrt(1.0_sp+(absa/absb)**2)
end if
end if
END FUNCTION pythag_sp
END MODULE nr
to run it(first, compile as a library):
julia> Na = 10;
julia> Ma = 10;
julia> w = zeros(Na);
julia> v = zeros(Na,Na);
julia> a = rand(Ma,Na);
julia> t = ccall((:svdcmp_dp_, "./svdcmp_dp.so")
, Void
, ( Ref{Int64} # dim Ma
, Ref{Int64} # dim Na
, Ref{Float64} # array a(Ma,Na)
, Ref{Float64} # array w(Na)
, Ref{Float64} # array v(Na,Na)
)
,Ma,Na,a,w,v)
size(a,1)= 10
size(a,2)= 10
size(v,1)= 10
size(v,2)= 10
size(w) = 10
julia> a
10×10 Array{Float64,2}:
-0.345725 -0.152634 -0.308378 0.16358 -0.0320809 … -0.47387 0.429124 -0.45121
-0.262689 0.337605 -0.0870571 0.409442 -0.160302 -0.0551756 0.16718 0.612903
-0.269915 0.410518 -0.0546271 -0.251295 -0.465747 0.328763 -0.109375 -0.476041
-0.33862 -0.238028 0.3538 -0.110374 0.294611 0.052966 0.44796 -0.0296113
-0.327258 -0.432601 -0.250865 0.478916 -0.0284979 0.0839667 -0.557761 -0.0956028
-0.265429 -0.199584 -0.178273 -0.300575 -0.578186 … -0.0561654 0.164844 0.35431
-0.333577 0.588873 -0.0587738 0.213815 0.349599 0.0573156 0.00210332 -0.0764212
-0.358586 -0.246824 0.211746 0.0193308 0.0844788 0.64333 0.105043 0.0645999
-0.340235 0.0145761 -0.344321 -0.602982 0.422866 -0.15449 -0.309766 0.220315
-0.301303 0.051581 0.712463 -0.0297202 -0.162096 -0.458565 -0.360566 -0.00623828
julia> w
10-element Array{Float64,1}:
4.71084
1.47765
1.06096
0.911895
0.123196
0.235218
0.418629
0.611456
0.722386
0.688394
julia> v
10×10 Array{Float64,2}:
-0.252394 0.128972 -0.0839656 0.6905 … 0.357651 0.0759095 -0.0858018 -0.111576
-0.222082 -0.202181 -0.0485353 -0.217066 0.11651 -0.223779 0.780065 -0.288588
-0.237793 0.109989 0.473947 0.155364 0.0821913 -0.61879 0.119753 0.33927
-0.343341 -0.439985 -0.459649 -0.233768 0.0948844 -0.155143 -0.233945 0.53929
-0.24665 0.0670331 -0.108927 0.119793 -0.520865 0.454486 0.375191 0.226854
-0.194316 0.301428 0.236947 -0.118114 … -0.579563 -0.183961 -0.19942 0.0545692
-0.349481 -0.61546 0.475366 0.227209 -0.0975147 0.274104 -0.0994582 -0.0834197
-0.457956 0.349558 0.263727 -0.506634 0.418154 0.378996 -0.113577 -0.0262257
-0.451763 0.0283005 -0.328583 -0.0121005 -0.219985 -0.276867 -0.269783 -0.604697
-0.27929 0.373724 -0.288427 0.246083 0.0529508 0.0369404 0.197368 0.265678
cheers!
I'm facing difficulties to figure out why my code is giving me this error
error 281 - Not enough variables in DATA statement
I am using the latest Silverfrost on Windows 8. The relevant piece of my module is,
...
INTEGER, parameter :: maxExampleTypes = 5
TYPE ExampleInfo
CHARACTER (len=50) :: ExDeckName
INTEGER A(maxExampleTypes)
INTEGER ExUnits
ENDTYPE ExampleInfo
TYPE(ExampleInfo) :: Example(10)
DATA Example(1)%ExDeckName/'test.dck'/
DATA Example(1)%A/1,2,3,4,5/
...
Curiously, when I only specify one variable for A with
DATA Example(1)%A/1/
the error disappears.
Have you got any idea where it could come from?
I would never use the DATA statement in modern Fortran. Try
...
INTEGER, parameter :: maxExampleTypes = 5
TYPE ExampleInfo
CHARACTER (len=50) :: ExDeckName
INTEGER :: A(maxExampleTypes)
INTEGER :: ExUnits
ENDTYPE ExampleInfo
TYPE(ExampleInfo) :: Example(10)
Example(1)%ExDeckName = 'test.dck'
Example(1)%A = (/ 1,2,3,4,5 /)
...
If the values are supposed to be default values, put them into the type declaration:
...
INTEGER, parameter :: maxExampleTypes = 5
TYPE ExampleInfo
CHARACTER (len=50) :: ExDeckName = 'test.dck'
INTEGER :: A(maxExampleTypes) = (/ 1,2,3,4,5 /)
INTEGER :: ExUnits
ENDTYPE ExampleInfo
TYPE(ExampleInfo) :: Example(10)
...
Sample test program:
module testmod
implicit none
INTEGER, parameter :: maxExampleTypes = 5
! Type with default values
TYPE ExampleInfo
CHARACTER (len=50) :: ExDeckName = 'test.dck'
INTEGER :: A(maxExampleTypes)= (/ 1,2,3,4,5 /)
INTEGER :: ExUnits
ENDTYPE ExampleInfo
contains
subroutine init_ExampleInfo(array)
implicit none
type(ExampleInfo), intent(out):: array(:)
integer :: i
do i=1,size(array)
array(i)%ExDeckName = 'test.dck'
array(i)%A = (/ 1,2,3,4,5 /)
enddo
end subroutine
end module
program test
use testmod
implicit none
TYPE(ExampleInfo) :: Example(10)
! Initialize manually
! call init_ExampleInfo(Example)
write(*,*) Example(1)%ExDeckName, Example(1)%A
! Set new values
Example(1)%ExDeckName = 'test2.dck'
Example(1)%A = (/ 5,4,3,2,1 /)
write(*,*) Example(1)%ExDeckName, Example(1)%A
end program
Over 2 weeks, I've struggled to call one of the METIS library written in C from my fortran code. And, unfortunately, It doesn't seem to be a HAPPY END without your help. I found some posts about direct calling and using interface. I prefer the latter because I could monitor the variables for debugging. There are three codes I attached.
1. c function I'd like to use 2. fortran interface module 3. fortran program
(1) c function
int METIS_PartMeshNodal(idx_t *ne, idx_t *nn, idx_t *eptr, idx_t *eind,
idx_t *vwgt, idx_t *vsize, idx_t *nparts, real_t *tpwgts,
idx_t *options, idx_t *objval, idx_t *epart, idx_t *npart)
I removed the c funciton body. It's not necessary to understand my problem
Here, idx_t is integer and real_t is single or double precision. From ne to options are input and last three arguments are output. And vwgt, vsize, tpwgts and options can receive null as an input for default setting I wrote the interface module for using c function like this
(2) Fortran interface module
Fixed!
Insert use iso_c_bind under use constants
Use integer(c_int) instead of integer for ne, nn and other variables.
Remove unused module constants
.
module Calling_METIS
!use constants, only : p2 !this is for double precision
use iso_c_bind !inserted later
implicit none
!integer :: ne, nn !modified
integer(c_int) :: ne, nn
!integer, dimension(:), allocatable :: eptr, eind !modified
integer(c_int), dimension(:), allocatable :: eptr, eind
!integer, dimension(:), allocatable :: vwgt, vsize !modified
type(c_ptr) :: vwgt, vsize
!integer :: nparts !modified
integer(c_int) :: nparts
!real(p2), dimension(:), allocatable :: tpwgts !modified
type(c_ptr) :: tpwgts
!integer, dimension(0:39) :: opts !modified
integer(c_int), dimension(0:39) :: opts
!integer :: objval !modified
integer(c_int) :: objval
!integer, dimension(:), allocatable :: epart, npart !modified
integer(c_int), dimension(:), allocatable :: epart, npart
interface
subroutine METIS_PartMeshNodal( ne, nn, eptr, eind, vwgt, vsize, nparts, tpwgt, &
opts, objval, epart, npart) bind(c)
use intrinsic :: iso_c_binding
!use constants, only : p2
implicit none
integer (c_int), intent(in) :: ne, nn
integer (c_int), dimension(*), intent(in) :: eptr, eind
!integer (c_int), dimension(*), intent(in) :: vwgt, vsize !modified
type(c_ptr), value :: vwgt, vsize
integer (c_int), intent(in) :: nparts
!real(c_double), dimension(*), intent(in) :: tpwgt !modified
type(c_ptr), value :: tpwgt
integer (c_int), dimension(0:39), intent(in) :: opts
integer (c_int), intent(out) :: objval
integer (c_int), dimension(*), intent(out) :: epart
integer (c_int), dimension(*), intent(out) :: npart
end subroutine METIS_PartMeshNodal
end interface
end module
And here is my program code calling the function
(3) Fortran program
Fixed!
allocation size of npart is fixed. Not ne but nn
opts(7)=1 is added to get Fortran-style array of epart, npart(no effect until now)
.
program METIS_call_test
!some 'use' statments
use Calling_METIS
use iso_c_binging !added
implicit none
! Local variable
integer :: iC
character(80) :: grid_file !grid_file
grid_file = 'test.grid'
! (1) Read grid files
call read_grid(grid_file)
! (2) Construction Input Data for calling METIS Function
! # of cells, vertices
ne = ncells
nn = nvtxs
! eptr, eind allocation
allocate(eptr(0:ne), eind(0:3*ntria + 4*nquad - 1))
! eptr and eind building
eptr(0) = 0
do iC=1, ncells
eptr(iC) = eptr(iC-1) + cell(iC)%nvtxs
eind(eptr(iC-1):eptr(iC)-1) = cell(iC)%vtx
end do
! epart, npart building
!allocate(epart(ne), npart(ne))
allocate(epart(ne), npart(nn)) ! modified
! # of partition setting
nparts = 2
vwgt = c_null_ptr !added
vsize = c_null_ptr !added
tpwgt = c_null_ptr !added
! (3) Call METIS_PartMeshNodal
call METIS_SetDefaultOptions(opts)
opts(7) = 1 !Added. For fortran style output array epart, npart.
call METIS_PartMeshNodal(ne, nn, eptr, eind, vwgt, vsize, nparts, tpwgt, &
opts, objval, epart, npart)
!call METIS_PartMeshNodal(ne, nn, eptr, eind, null(), null(), nparts, null(), &
! opts, objval, epart, npart) !wrong...
end program
But the problem is that I get an error message as below though I put null for tpwgt.
Input Error: Inorrect sum of 0.000000 for tpwgts for constraint 0.
And this message is handled in the code below.
for (i=0; i<ctrl->ncon; i++) {
sum = rsum(ctrl->nparts, ctrl->tpwgts+i, ctrl->ncon);
if (sum < 0.99 || sum > 1.01) {
IFSET(dbglvl, METIS_DBG_INFO,
printf("Input Error: Incorrect sum of %"PRREAL" for
tpwgts for constraint %"PRIDX".\n", sum, i));
return 0;
}
}
Anyway, in order to see what I would get if I put an array for tpwgts intead of null, tpwgts(:) = 1.0/nparts, which makes sum of tpwgts equal 1.0. But I got same message with 1.75 for the sum.
These are my questions
1. Did I use null() for passing arguments correctly?
2. Do I have to pass pointers for all arguments to c function? then how?
3. Is putting an integer to opts(0:39) enough for use? For example, in a post without 'interface module', simple code like options(3)=1 is used. But in the c code, options has 16 named variable like options[METIS_OPTION_NUMBERING], options[METIS_OPTION_UFACTOR]. I think some thing is necessary to set options but I have no idea.
4. Is there an example for METIS in fortran?
Any kind of hint/advice will be a great help for me. Thank you.
Conclution
The problem I had was that c function couldn't recognize null pointer from fortran code.
There were some miss declations of variables in interface module(see 'Fixed' and comments)
It looks like the code works properly. But option(7) = 1 for fortran style output didn't work and now I'm looking at it.
No, you cannot pass null(), that is a Fortran pointer constant. You must pass C_NULL_PTR from the module ISO_C_BINDING and the interface must reflect this. The dummy argument must be type(c_ptr), most probably with VALUE attribute. It may actually work because of the same internal representation, but I wouldn't count on it.
No, if you pass some normal variable, you can pass it directly by reference. Just like normally in Fortran. If the interface is BIND(C), the compiler knows it must send a pointer.
There is a new TS to update Fortran 2008, where you can define dummy arguments in the interoperable procedures as OPTIONAL. Then you can pass the null pointer just by omitting them. Gfortran should already support this.
Note: Here I can see a much different C signature of your function, are you sure yours is OK? http://charm.cs.uiuc.edu/doxygen/charm/meshpart_8c.shtml
I think your opts(7) does not work because you also need an interface for the METIS function METIS_SetDefaultOptions. Based on the answer from http://glaros.dtc.umn.edu/gkhome/node/877, I created a wrapper module (metisInterface.F90) with the interfaces I needed:
module metisInterface
! module to allows us to call METIS C functions from the main Fortran code
use,intrinsic :: ISO_C_BINDING
integer :: ia,ic
integer(C_INT) :: metis_ne,metis_nn
integer(C_INT) :: ncommon,objval
integer(C_INT) :: nparts
integer(C_INT),allocatable,dimension(:) :: eptr,eind,perm,iperm
integer(C_INT),allocatable,dimension(:) :: epart,npart
type(C_PTR) :: vwgt,vsize,twgts,tpwgts
integer(C_INT) :: opts(0:40)
interface
integer(C_INT) function METIS_SetDefaultOptions(opts) bind(C,name="METIS_SetDefaultOptions")
use,intrinsic :: ISO_C_BINDING
implicit none
integer(C_INT) :: opts(0:40)
end function METIS_SetDefaultOptions
end interface
interface
integer(C_INT) function METIS_PartMeshDual(ne,nn,eptr,eind,vwgt,vsize,ncommon,nparts,tpwgts, &
opts,objval,epart,npart) bind(C,name="METIS_PartMeshDual")
use,intrinsic :: ISO_C_BINDING
implicit none
integer(C_INT):: ne, nn
integer(C_INT):: ncommon, objval
integer(C_INT):: nparts
integer(C_INT),dimension(*) :: eptr, eind
integer(C_INT),dimension(*) :: epart, npart
type(C_PTR),value :: vwgt, vsize, tpwgts
integer(C_INT) :: opts(0:40)
end function METIS_PartMeshDual
end interface
end module metisInterface
Then, in the main program (or wherever you make the call to the METIS functions) you need to have (for completeness, I also added the call to METIS_PartMeshDual):
use metisInterface
integer :: metis_call_status
.
.
.
metis_call_status = METIS_SetDefaultOptions(opts)
! METIS_OPTION_NUMBERING for Fortran
opts(17) = 1
metis_call_status = METIS_PartMeshDual(metis_ne,metis_nn,eptr,eind, &
vwgt,vsize,ncommon,nparts,tpwgts,opts,objval,epart,npart)
Note that epart and npart will have Fortran numbering as you want (starting at 1). However, the processors will also start numbering at 1. For example, if you are running in 4 processors, root processor is 1 and you may have epart(n)=4, and you will not have any epart(n)=0.
Finally, a file metis.c is also needed with a single line:
#include "metis.h"
Compiling instructions
Compile metis.c with a C compiler
Compile metisInterface.F90 with a Fortran compiler linking with the compiled C object
Compile main program with a Fortran compiler linking with metisInterface.o