Problem
After adding an external interface for Lapack, the code fails during linking with the message
Undefined symbols for architecture x86_64:
"___msolutionsvd_MOD_dgesvd", referenced from:
___msolutionsvd_MOD_svd_pseudoinverse_solve_sub in m-solution-svd.o
It seems that the linker is looking for a DGESVD.mod file which is not included with my openblas installation.
Code
This works
The module module mSolutionSVD used the declaration
external DGESVD
to point to the BLAS routine and contains subroutine svd_pseudoinverse_solve_sub
which calls DGESVD.
This fails
The declaration was replaced with the explicit interface
interface lapack
module subroutine DGESVD ( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO )
character ( kind = kindA, len = 1 ), intent ( in ) :: JOBU, JOBVT
integer ( kind = ip ), intent ( in ) :: M, N, LDA, LDU, LWORK
integer ( kind = ip ), intent ( out ) :: INFO
real ( kind = rp ), intent ( out ) :: S ( : ), U ( : , : ), VT ( : , : ), WORK ( : )
real ( kind = rp ), intent ( inout ) :: A ( : , : )
end subroutine DGESVD
end interface lapack
Background
The kind statements are sourced from a routine with these statements:
use, intrinsic :: iso_fortran_env, only : INT8, REAL64
integer, parameter :: kindA = kind ( 'A' )
integer, parameter :: rp = selected_real_kind ( REAL64 )
integer, parameter :: ip = selected_int_kind ( INT64 )
Question
Can we use an external interface for Lapack without having to recompile Lapack?
There are three problems with your code, two of them not related to your question.
First, the definition of the data types should be
use, intrinsic :: iso_fortran_env, only : INT64, REAL64
integer, parameter :: kindA = kind ( 'A' )
integer, parameter :: rp = REAL64
integer, parameter :: ip = INT64
This is because the predefined constants INT64 and REAL64 already represent the ranks, while the auxiliary functions selected_*_kind expect to be given the number of valid decimal places.
Second, your interface does not specify the parameter LDVT.
Third, and most importantly, you declare DGESVD as a module subroutine, by which you say that the subroutine is located in the present module. But it is not. Lapack subroutines are not in any modules. So, you need to omit the module keyword from your interface definition.
Note: If the data types kindA, rp and ip are defined in the same module, then after removing the module keyword from the interface declaration you will also need to add the line
import kindA, ip, rp
just below the prototype line subroutine DGESVD (...
Related
I was trying to create a program that requires me to use matrices as input for functions and subroutines and also requires me to take matrix as subroutine output in Fortran. But, I've encountered multiple errors while doing so. I am not able to understand the source of these errors and hence how to fix them.
I'm confident of the logic but I seem to be making errors in dealing with the matrices.
Program to solve system of linear equations(Gauss elimination with partial pivoting)
Code:
program solving_equations
implicit none
real, allocatable :: a(:,:),interchanged(:,:)
real, allocatable :: x(:)
real addition,multiplying_term,alpha,maximum
integer i,j,row,rth_ele,f_maxfinder,k,n,s,inte
read(*,*)n
allocate( a( n,(n+1) ) )
allocate( x(n) )
allocate( interchanged( n,(n+1) ) )
do i=1,n
read(*,*)( a(i,j),j=1,(n+1) )
end do
do rth_ele= 1,(n-1)
row=f_maxfinder( a , n , rth_ele )
if (row==rth_ele) then
continue
else
call interchanger(a,rth_ele,row,n,interchanged)
a = interchanged
end if
do i= (rth_ele+1) , n
! once i is fixed, multiplying term is fixed too
multiplying_term=( a(i,rth_ele)/a(rth_ele,rth_ele) )
do j=1,(n+1)
a(i,j)=a(i,j)-a(rth_ele,j)*multiplying_term
end do
end do
end do
x(n)=a(n,n+1)/a(n,n)
do i=(n-1),1,-1
addition=0.0
do s=n , (i+1) , -1
addition=addition+a(i,s)*x(s)
end do
x(i)= ( ( a(i,n+1)- addition )/a(i,i) )
end do
do i=1,n
print*,x(i)
end do
endprogram solving_equations
!=================
function f_maxfinder(a,n,rth_ele)
integer inte,f_maxfinder
real maximum
maximum=a(rth_ele,rth_ele)
do inte=n,nint(rth_ele+1),-1
if( a(inte,rth_ele) > maximum ) then
maximum = a(inte,rth_ele)
f_maxfinder=inte
else
continue
end if
end do
end
subroutine interchanger( a,rth_ele,row,n,interchanged )
integer i
real alpha
real, allocatable :: interchanged(:,:)
allocate( interchanged( n,(n+1) ) )
do i=1,n+1
alpha=a(row,i)
a(row,i)=a(rth_ele,i)
a(rth_ele,i)=alpha
end do
do i=1,n
do j=1,(n+1)
interchanged(i,j)=a(i,j)
end do
end do
end
Errors:
row=f_maxfinder( a , n , rth_ele )
1
Warning: Rank mismatch in argument 'a' at (1) (scalar and rank-2)
a(row,i)=a(rth_ele,i)
Error: The function result on the lhs of the assignment at (1) must have the pointer attribute.
a(rth_ele,i)=alpha
Error: The function result on the lhs of the assignment at (1) must have the pointer attribute.
call interchanger(a,rth_ele,row,n,interchanged)
1
Error: Explicit interface required for 'interchanger' at (1): allocatable argument
Thanks!
You're missing a declaration of a as an array in f_maxfinder. implicit none is your friend - be sure to use it all the time.
interchanger has a dummy argument interchanged that is an allocatable, assumed-shape array. This requires that an explicit interface to interchanger be visible in the caller. (See my post https://stevelionel.com/drfortran/2012/01/05/doctor-fortran-gets-explicit-again/ for more on this.
The interface issue could be solved by putting the subroutines in a module and adding a use of the module in the main program.
By the way, there's no need to make a allocatable in f_maxfinder, as you are not allocating or deallocating it. It is still an assumed-shape array so the explicit interface is still required.
Here is a working example taking into account #SteveLionel's advice and the following comments:
Always use implicit none, at least once in the main program and don't forget to pass the -warn flag to the compiler.
Either use a module for functions and subroutines, then add use <module> to the main program, or simply use contains and include them inside the main program as I did below.
The interchanged array is already alcated in the main program, you don't need to re-allocate it in the interchanger subroutine, just pass it as an assumed-shape array.
Remove unused variables; alpha, maximum, k, inte.
Define a in f_maxfinder function.
Function type is better written in front of the function name for readability; see your definition of f_maxfinder and don't declare the function again in main program, unless you're using an explicit interface.
The nint procedure accepts real input, you don't need it here.
Finally add any missing variable declarations in your function/subroutine.
program solving_equations
implicit none
real, allocatable :: a(:,:), interchanged(:,:), x(:)
real :: addition, multiplying_term
integer :: i, j, row, rth_ele, n, s
read (*,*) n
allocate ( a( n,(n+1) ) )
allocate ( x( n ) )
allocate ( interchanged( n,(n+1) ) )
do i = 1,n
do j = 1,(n+1)
read (*,*) a(i,j)
end do
end do
do rth_ele = 1,(n-1)
row = f_maxfinder( a , n , rth_ele )
if (row == rth_ele) then
continue
else
call interchanger(a, rth_ele, row, n, interchanged)
a = interchanged
end if
do i = (rth_ele+1) , n
! once i is fixed, multiplying term is fixed too
multiplying_term = a(i,rth_ele) / a(rth_ele,rth_ele)
do j = 1,(n+1)
a(i,j) = a(i,j) - a(rth_ele,j) * multiplying_term
end do
end do
end do
x(n) = a(n,n+1) / a(n,n)
do i = (n-1),1,-1
addition = 0.0
do s = n,(i+1),-1
addition = addition + a(i,s) * x(s)
end do
x(i)= (a(i,n+1) - addition) / a(i,i)
end do
do i = 1,n
print *, x(i)
end do
contains
integer function f_maxfinder(a, n, rth_ele)
integer :: n, rth_ele, inte
real :: maximum, a(:,:)
maximum = a(rth_ele,rth_ele)
do inte = n,rth_ele+1,-1
if (a(inte,rth_ele) > maximum) then
maximum = a(inte,rth_ele)
f_maxfinder = inte
else
continue
end if
end do
end
subroutine interchanger( a, rth_ele, row, n, interchanged )
integer :: i, rth_ele, row, n
real :: alpha, a(:,:), interchanged(:,:)
do i = 1,n+1
alpha = a(row,i)
a(row,i) = a(rth_ele,i)
a(rth_ele,i) = alpha
end do
do i = 1,n
do j = 1,(n+1)
interchanged(i,j) = a(i,j)
end do
end do
end
end program solving_equations
Entering a sample 3-by-4 array, you get the following output (check the results, you know your algorithm):
3
4
3
6
3
7
4
6
7
4
4
2
0
2.05263186
-2.15789509
0.210526198
Process returned 0 (0x0) execution time : 1.051 s
Press any key to continue.
I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if
I am trying to write a constructor for a derived type of an abstract one to solve this other question, but it seems that it's not working, or better, it isn't called at all.
The aim is to have a runtime polymorphism setting the correct number of legs of an animal.
These are the two modules:
animal
module animal_module
implicit none
type, abstract :: animal
private
integer, public :: nlegs = -1
contains
procedure :: legs
end type animal
contains
function legs(this) result(n)
class(animal), intent(in) :: this
integer :: n
n = this%nlegs
end function legs
cat
module cat_module
use animal_module, only : animal
implicit none
type, extends(animal) :: cat
private
contains
procedure :: setlegs => setlegs
end type cat
interface cat
module procedure init_cat
end interface cat
contains
type(cat) function init_cat(this)
class(cat), intent(inout) :: this
print *, "Cat!"
this%nlegs = -4
end function init_cat
main program
program oo
use animal_module
use cat_module
implicit none
type(cat) :: c
type(bee) :: b
character(len = 3) :: what = "cat"
class(animal), allocatable :: q
select case(what)
case("cat")
print *, "you will see a cat"
allocate(cat :: q)
q = cat() ! <----- this line does not change anything
case default
print *, "ohnoes, nothing is prepared!"
stop 1
end select
print *, "this animal has ", q%legs(), " legs."
print *, "cat animal has ", c%legs(), " legs."
end program
The constructor isn't called at all, and the number of legs still remains to -1.
The available non-default constructor for the cat type is given by the module procedure init_cat. This function you have defined like
type(cat) function init_cat(this)
class(cat), intent(inout) :: this
end function init_cat
It is a function with one argument, of class(cat). In your later reference
q = cat()
There is no specific function under the generic cat which matches that reference: the function init_cat does not accept a no-argument reference. The default structure constructor is instead used.
You must reference the generic cat in a way matching your init_cat interface to have that specific function called.
You want to change your init_cat function to look like
type(cat) function init_cat()
! print*, "Making a cat"
init_cat%nlegs = -4
end function init_cat
Then you can reference q=cat() as desired.
Note that in the original, you are attempting to "construct" a cat instance, but you aren't returning this constructed entity as the function result. Instead, you are modifying an argument (already constructed). Structure constructors are intended to be used returning such useful things.
Note also that you don't need to
allocate (cat :: q)
q = cat()
The intrinsic assignment to q already handles q's allocation.
FWIW, here is some sample code comparing three approaches (method = 1: sourced allocation, 2: polymorphic assignment, 3: mixed approach).
module animal_module
implicit none
type, abstract :: animal_t
integer :: nlegs = -1
contains
procedure :: legs !! defines a binding to some procedure
endtype
contains
function legs(this) result(n)
class(animal_t), intent(in) :: this
!! The passed variable needs to be declared as "class"
!! to use this routine as a type-bound procedure (TBP).
integer :: n
n = this % nlegs
end
end
module cat_module
use animal_module, only : animal_t
implicit none
type, extends(animal_t) :: cat_t
endtype
interface cat_t !! overloads the definition of cat_t() (as a procedure)
module procedure make_cat
end interface
contains
function make_cat() result( ret ) !! a usual function
type(cat_t) :: ret !<-- returns a concrete-type object
ret % nlegs = -4
end
end
program main
use cat_module, only: cat_t, animal_t
implicit none
integer :: method
type(cat_t) :: c
class(animal_t), allocatable :: q
print *, "How to create a cat? [method = 1,2,3]"
read *, method
select case ( method )
case ( 1 )
print *, "1: sourced allocation"
allocate( q, source = cat_t() )
!! An object created by a function "cat_t()" is used to
!! allocate "q" with the type and value taken from source=.
!! (Empirically most stable for different compilers/versions.)
case ( 2 )
print *, "2: polymorphic assignment"
q = cat_t()
!! Similar to sourced allocation. "q" is automatically allocated.
!! (Note: Old compilers may have bugs, so tests are recommended...)
case ( 3 )
print *, "3: mixed approach"
allocate( cat_t :: q )
q = cat_t()
!! First allocate "q" with a concrete type "cat_t"
!! and then assign a value obtained from cat_t().
case default ; stop "unknown method"
endselect
c = cat_t()
!! "c" is just a concrete-type variable (not "allocatable")
!! and assigned with a value obtained from cat_t().
print *, "c % legs() = ", c % legs()
print *, "q % legs() = ", q % legs()
end
--------------------------------------------------
Test
$ gfortran test.f90 # using version 8 or 9
$ echo 1 | ./a.out
How to create a cat? [method = 1,2,3]
1: sourced allocation
c % legs() = -4
q % legs() = -4
$ echo 2 | ./a.out
How to create a cat? [method = 1,2,3]
2: polymorphic assignment
c % legs() = -4
q % legs() = -4
$ echo 3 | ./a.out
How to create a cat? [method = 1,2,3]
3: mixed approach
c % legs() = -4
q % legs() = -4
--------------------------------------------------
Side notes
* It is also OK to directly use make_cat() to generate a value of cat_t:
e.g., allocate( q, source = make_cat() ) or q = make_cat().
In this case, we do not need to overload cat_t() via interface.
* Another approach is to write an "initializer" as a type-bound procedure,
and call it explicitly as q % init() (after allocating it via
allocate( cat_t :: q )). If the type contains pointer components,
this approach may be more straightforward by avoiding copy of
components (which can be problematic for pointer components).
I'm using Fortran and gfortran 4.7.2. I'm pretty new to Fortran and searched intensively for a solution to my problem. The program I want to use has many functions, which should be aliased based on the given conditions correctly. For that I want to use pointer.
The main program creates pointer based on the interface in the module func_interface. Based on which function I want to alias, I wrote a subroutine which should change the pointer to desired function. Nevertheless I receive a 'Memory Access Error' when trying to run the program - obviously because I didn't understand the pointers in Fortran or how to pass them to a subroutine in order to change them inside the subroutine correctly.
Has somebody an idea how to change the program in order to use it this way? The program is as below.
MODULE func_interface
ABSTRACT INTERFACE
FUNCTION func(z)
DOUBLE PRECISION func
DOUBLE PRECISION, INTENT (IN) :: z
END FUNCTION func
END INTERFACE
END MODULE func_interface
SUBROUTINE assign_pointer(i, func_ptr)
USE func_interface
IMPLICIT NONE
PROCEDURE (func), POINTER, INTENT(INOUT) :: func_ptr => NULL ()
INTEGER, INTENT (IN) :: i
DOUBLE PRECISION f1, f2
EXTERNAL f1, f2
SELECT CASE ( i )
CASE ( 1 )
func_ptr => f1
RETURN
CASE ( 2 )
func_ptr => f2
RETURN
END SELECT
END SUBROUTINE assign_pointer
DOUBLE PRECISION FUNCTION f1(x)
IMPLICIT NONE
DOUBLE PRECISION, INTENT(IN) :: x
f1 = 2*x
END FUNCTION f1
DOUBLE PRECISION FUNCTION f2(x)
IMPLICIT NONE
DOUBLE PRECISION, INTENT(IN) :: x
f2 = 4*x
END FUNCTION f2
PROGRAM pointer_test
USE func_interface
IMPLICIT NONE
DOUBLE PRECISION f1, f2
EXTERNAL f1, f2
PROCEDURE (func), POINTER :: func_ptr => NULL ()
CALL assign_pointer( 1, func_ptr )
WRITE(*, '(1PE12.4)') func_ptr(5.2D1)
END PROGRAM pointer_test
Error Message :
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7F32AFB92667
#1 0x7F32AFB92C34
#2 0x7F32AF14F19F
#3 0x4007CE in assign_pointer_
#4 0x40085B in MAIN__ at pointer_test.f90:0
Speicherzugriffsfehler
The answer by innoSPG gives the essential aspects of the solution: extend what the module includes to make an explicit interface available in the main program for the subroutine assign_pointer. I'll give a little more detail and address a difficulty suggested in a comment.
First, look at the (simplified) subroutine definition:
subroutine assign_pointer(i, func_ptr)
use func_interface ! func is given in here
procedure(func), pointer, intent(inout) :: func_ptr
integer, intent(in) :: i
end subroutine assign_pointer
The dummy argument func_ptr of this subroutine has the pointer attribute. As given elsewhere such an attribute requires an explicit interface in a scope referencing the subroutine. That other answer shows how that can be arranged (and there are many other questions and answer around that to be found).
The subroutine and functions are external procedures and do not automatically have an explicit interface available.
You then asked
Although I thought that using USE func_interface is explicitly defining the pointer.. what is the mistake in this thought?
The module func_interface contains the abstract interface func. This abstract interface is used in the declaration of the procedure pointers. However, it's the subroutine assign_pointer, as noted above, which is problematic. One can see that the dummy argument
procedure(), pointer, intent(inout) :: func_ptr
(which has implicit interface) is wholly independent of the module, but still there is a requirement for the subroutine's interface to be explicit in a calling scope.
So, the abstract interface is only one small part of the way to get this program to work.
And even that abstract interface may be unnecessary. Depending on how f1 and f2 are to be made available we may be able to write the module as:
module full_mod
contains
function f1(..)
end function f1
function f2(..)
end function f2
subroutine assign_pointer(i, func_ptr)
procedure(f1), pointer, intent(inout) :: func_ptr
integer, intent(in) :: i
! f1 and f2 available from the host module
end subroutine assign_pointer
end module
use full_mod
implicit none
procedure(f1), pointer :: func_ptr => NULL()
...
end
That is, f1 and f2 may themselves be used to give the interface of a procedure pointer, when those functions are in scope.
And a final note: the dummy argument func_ptr may not have explicit initialization. A line such as
procedure(func), pointer, intent(inout) :: func_ptr => NULL()
is trying to do exactly that. It is trying to say that func_ptr is initially disassociated. As can be seen in my code lump above the => NULL() should be removed. Either standard pointer assignment should be used
procedure(func), pointer, intent(inout) :: func_ptr
func_ptr => NULL()
or we can note that the explicit initialization in the main program
procedure(func), pointer :: func_ptr => NULL()
is allowed and as the dummy argument has the intent(inout) attribute it retains that not-associated status on entry to the subroutine.
The comments from francescalus and Vladimir are what you need. Below I suggest a simple reorganization of your code where I put all the functions in the existing module. I also commented the external statements because they become useless with functions in a module.
You will find the following comment on many fortran question on S.O. but it is worth putting it here again. When starting new project, you should stick to modern programming techniques. It is better to put procedures in module instead of using the external. That will automatically build the interface for you and do some checking at compile time.
Now if you are going to use some functions that exist already and you are not modifying them, you need to supply explicit interface.
Thank to francescalus comment, I modify the call to the selected function in the main program, to call only if it is initialized. To avoid that, the default case can be processed in the procedure assign_pointer.
MODULE func_interface
ABSTRACT INTERFACE
FUNCTION func(z)
DOUBLE PRECISION func
DOUBLE PRECISION, INTENT (IN) :: z
END FUNCTION func
END INTERFACE
CONTAINS
SUBROUTINE assign_pointer(i, func_ptr)
! USE func_interface
IMPLICIT NONE
PROCEDURE (func), POINTER, INTENT(INOUT) :: func_ptr => NULL ()
INTEGER, INTENT (IN) :: i
!DOUBLE PRECISION f1, f2
!EXTERNAL f1, f2
SELECT CASE ( i )
CASE ( 1 )
func_ptr => f1
RETURN
CASE ( 2 )
func_ptr => f2
RETURN
END SELECT
END SUBROUTINE assign_pointer
DOUBLE PRECISION FUNCTION f1(x)
IMPLICIT NONE
DOUBLE PRECISION, INTENT(IN) :: x
f1 = 2*x
END FUNCTION f1
DOUBLE PRECISION FUNCTION f2(x)
IMPLICIT NONE
DOUBLE PRECISION, INTENT(IN) :: x
f2 = 4*x
END FUNCTION f2
END MODULE func_interface
PROGRAM pointer_test
USE func_interface
IMPLICIT NONE
!DOUBLE PRECISION f1, f2
!EXTERNAL f1, f2
PROCEDURE (func), POINTER :: func_ptr => NULL ()
CALL assign_pointer( 1, func_ptr )
IF(associated(func_ptr))then
WRITE(*, '(1PE12.4)') func_ptr(5.2D1)
ELSE
! manage the cas
END IF
END PROGRAM pointer_test
I am encountering an error with the function detailed in this post.
The problem occurs because I am trying to return a type corresponding to the
input types. Can anyone suggest a solution? I originally had a function for each
type, and then a generic interface to group them into the same name. Now I am trying to
put everything in a single function using polymorphism.
Here is the error that gfortran is giving me.
gfortran -o build/lib/foul.o -c -ffree-form -g -J./build/lib lib/foul.f
lib/foul.f:471.45:
Function cassign (expr, a, b, wrn) Result (c)
I have tried to use an allocatable array. In the main program I then do
Character (len=65), Allocatable :: sc(:)
Integer, Allocatable :: ic(:)
Real, Allocatable :: rc(:)
Allocate (sc(1))
Allocate (ic(1))
Allocate (rc(1))
sc = cassign (ra < rb, sa, sb)
ic = cassign (ra < rb, ia, ib)
rc = cassign (ra < rb, ra, rb)
This returns the following error
gfortran -o build/utests/test_foul.o -c -ffree-form -g -J./build/lib utests/test_foul.f
utests/test_foul.f:315.7:
sc = cassign (ra < rb, sa, sb)
1
Error: Can't convert CLASS(*) to CHARACTER(1) at (1)
utests/test_foul.f:316.7:
ic = cassign (ra < rb, ia, ib)
1
Error: Can't convert CLASS(*) to INTEGER(4) at (1)
utests/test_foul.f:317.7:
rc = cassign (ra < rb, ra, rb)
1
Error: Can't convert CLASS(*) to REAL(4) at (1)
1
Error: CLASS variable 'c' at (1) must be dummy, allocatable or pointer
lib/foul.f:495.10:
c = a
1
Error: Nonallocatable variable must not be polymorphic in intrinsic
assignment at (1) - check that there is a matching specific subroutine
for '=' operator
lib/foul.f:497.10:
c = b
1
Here is the function I have coded. The variables a and b can be any of the types
Character, integer or real. And the output type should match the inputs a and b
The function type_match (a, b) returns true if the two types match, false otherwise.
Function cassign (expr, a, b, wrn) Result (c)
Logical, Intent(in) :: expr
Class (*), Intent(in) :: a, b
Logical, Intent (out), Optional :: wrn
Class (*) :: c
Logical :: warn, tma, tmb
!!$ Perform warning tests (performs type matching).
If (Present (wrn)) Then
!!$ Matching input types.
tma = type_match (a, b)
if (tma) Then
tmb = type_match (a, c)
!!$ Matching input and output types.
If (tmb) Then
If (expr) Then
c = a
Else
c = b
End If
wrn = .False.
!!$ Warning: Non-matching types.
Else
wrn = .True.
End If
Else
wrn = .True.
End If
Else
If (expr) Then
c = a
Else
c = b
End If
End If
End Function cassign
I am not sure that I recommend doing what I write below, preferring instead keeping to generics, but I will attempt to explain.
The first thing to note is that, as the error message states, for a non-dummy argument polymorphic variable (such as c) that variable must have the pointer or allocatable attribute. Here, it makes sense for the function result to be allocatable.
After adding the allocatable attribute, you seem to experience two things related to assignment of the allocatable polymorphic variable: once in the function setting the result, and once using the result of the function.
The version of gfortran you are using doesn't (apparently) support intrinsic assignment to polymorphic variables. You can use the equivalent, which arguably has the intention even clearer:
allocate (c, source=a) ! You may also need to provide bounds for c
! for some gfortran.
This is the solution to the assignment problem in the function.
With the function result, however, you are now returning a polymorphic result. That means that the variable taking the assignment must also be polymorphic, or the assignment must not be intrinsic. This is the
Error: Can't convert CLASS(*) to INTEGER(4) at (1)
error when you try intrinsic assignment.
Either make everything polymorphic, stick with generics, or use defined assignment. A simplified example follows for the latter case. [Adjust and extend as required.]
module hello_bob
interface assignment(=)
module procedure int_equal_func_class
end interface
contains
subroutine int_equal_func_class(a,b)
integer, intent(out) :: a(:)
class(*), intent(in) :: b(:)
select type (b)
type is (integer)
a = b
end select
end subroutine int_equal_func_class
function func(a)
class(*), intent(in) :: a(:)
class(*), allocatable :: func(:)
! No intrinsic assignment supported, also see note about bounds
allocate(func, source=a)
end function func
end module hello_bob
program bob
use hello_bob
integer i(4)
i=func([1,2,3,4])
print*, i
end program bob