I have the following problem:
I have a module containing some fortran function, which takes 2 (mathematical) functions as its input. The way I do this at the moment is by defining an interface for the input functions. My module looks like this:
module myModule
implicit none
save
abstract interface
subroutine functype1(x,f)
import dp
real(kind=dp), dimension(:),intent(in) :: x
real(kind=dp), dimension(:),intent(out):: f
end subroutine
subroutine functype2(x,M)
import dp
real(kind=dp), dimension(:),intent(in) :: x
real(kind=dp), dimension(:,:),intent(out):: M
end subroutine
end interface
contains
function taylorExpansion(func,funcdiff)
procedure(functype1) :: func ! The mathematical function f
procedure(functype2) :: funcdiff ! The function evaluating the derivative/gradient of f
! ...
! (further implementation)
! ...
end function
The problem is now that I want functype1 to be kind of general: sometimes the input is just a real, sometimes it's an array of reals. Is it possible to do this smoothly?
(At the moment I'm forced to pass an array of size 1 to func1 instead of a real, which is quite clumsy)
Another way to formulate this is: is it possible to make a type which is a real OR an array of reals? This way both calls would be possible:
program testprog
use myModule
implicit none
save
call taylorExpansion(xsquared,xdiff) ! functype1 can accept reals
call taylorExpansion(vectornorm,vectornormdiff) ! functype1 can also accept vectors
contains
subroutine xsquared(x,fx)
real(kind=dp) :: x
real(kind=dp) :: fx
fx = x**2
end subroutine
subroutine twox(x,fx)
real(kind=dp) :: x
real(kind=dp) :: fx
fx = 2*x
end subroutine
subroutine vectornorm(x,fx)
real(kind=dp), dimension(:) :: x
real(kind=dp) :: fx=0.0
integer i
do i = 1,size(x)
fx = fx + x(i)**2
end do
end subroutine
subroutine vectornormdiff(x,fx)
real(kind=dp), dimension(:) :: x
real(kind=dp), dimension(:) :: fx
integer i
do = 1,size(x)
fx(i) = 2*x(i)
end do
end subroutine
end program
Related
I want to solve ODEs of the type
in modern fortran. I want to write the integrator (for example 4th-order Runge-Kutta) to be quite general, such that the same integrator can be used for different right-hand sides of the equation, including at least these different cases:
f(x, t) is a function, where both x and the return value are scalars
f(x, t) is a function, where both x and the return value are arrays (of the same shape)
f(x, t) is a type-bound procedure (or similar), where the purpose of the derived type is to interpolate some underlying data to the position and time given by (x, t)
Based on an answer to a similar question I have implemented the code included below, which seems to work as expected.
My problem is that I would like to keep rk4(x, t, h, f) general, such that x in f(x,t) can be an assumed-shape array (or even a scalar, ideally), but at the same time I would like to be able to specify that x has for example dimension(2) when I actually implement a function to interpolate some 2D data. However, if I try to modify the function evaluate in the example below such that x has dimension(2), then I get an error complaining about interface mismatch when I try to compile. Is there a way around this problem?
module interpolator_module
implicit none
integer, parameter :: WP = kind(1.0D0)
interface
! This is the general form of the right-hand side of an ODE
function rhs(x, t) result( val )
import :: WP
real(WP), dimension(:), intent(in) :: x
real(WP), intent(in) :: t
real(WP), dimension(size(x)) :: val
end function
end interface
type interpolator_type
! This type would in practice store arrays,
! of discrete data to be interpolated.
real(WP) :: stored_data
procedure(rhs), nopass, pointer :: eval
contains
procedure :: init
endtype
class(interpolator_type), pointer :: interpolator
contains
subroutine init( this, stored_data )
implicit none
class(interpolator_type), target :: this
real(WP) :: stored_data
this % stored_data = stored_data
this % eval => evaluate
interpolator => this
end subroutine
function evaluate(x, t) result( val )
implicit none
real(WP), dimension(:), intent(in) :: x
real(WP), intent(in) :: t
real(WP), dimension(size(x)) :: val
! This is where interpolation would happen
val = interpolator % stored_data * x
end function
end module
program main
use interpolator_module, only : interpolator_type
implicit none
integer, parameter :: WP = kind(1.0D0)
type(interpolator_type) :: interp
real(WP), dimension(2) :: x
real(WP) :: t, h
! initialise interpolator with some data
call interp % init(-0.1_WP)
x = (/ 2.0_WP, 1.0_WP /)
t = 0.0_WP
h = 1.0_WP
! Example of calling rk1 with the "type-bound procedure"
! which evaluates an interpolator
call rk4(x, t, h, interp % eval )
print *, x
! Example of calling rk1 with analytical function
call rk4(X, t, h, f )
print *, x
contains
subroutine rk4(x, t, h, f)
! Makes one step with 4th-order Runge-Kutta.
! Calculates next position using timestep h.
implicit none
real(WP), intent(inout), dimension(:) :: x
real(WP), intent(inout) :: t
real(WP), intent(in) :: h
interface
function f(x, t) result(val)
import WP
real(WP), dimension(:), intent(in) :: x
real(WP), intent(in) :: t
real(WP), dimension(size(x)) :: val
end function
end interface
! Local variables
real(WP), dimension(size(x)) :: k1, k2, k3, k4
! Evaluations of f(x, t)
k1 = f(x, t)
k2 = f(x + k1*h/2, t + h/2)
k3 = f(x + k2*h/2, t + h/2)
k4 = f(x + k3, t + h)
! Next position
x = x + h*(k1 + 2*k2 + 2*k3 + k4)/6
t = t + h
end subroutine
pure function f(x, t) result(val)
implicit none
real(WP), dimension(:), intent(in) :: x
real(WP), intent(in) :: t
real(WP), dimension(size(x)) :: val
val = -0.1_WP*x
end function
end program
Assumed shape arrays are not compatible with explicit shape arrays (like dimension(2)). The calling convention under the hood often uses a completely different mechanism that just would not work. If the compiler let you do it, it would crash the program.
You do not have much choice, because if you use assumed size arrays (dimension(*)) you do not have access to the size of the array and you would have to pass it separately. You could store it in the interpolator structure but it would still not be ideal.
I have a code similar to:
Module C_sys
use class_A
implicit none
Private
Type, public :: C_sys_type
private
logical :: Ao_set = .false.
type(A) :: Ao
Contains
Private
Procedure, public :: get_Ao
Procedure, public :: set_Ao
End Type C_sys_type
interface C_sys_type
Procedure C_sys_type_constructor
end interface C_sys_type
Contains
type(C_sys_type) elemental function C_sys_type_constructor(Ao) result(C_sys)
type(A), intent(in), optional :: Ao
C_sys % Ao = Ao
C_sys % Ao_set = .true.
end function C_sys_type_constructor
type(A) elemental function get_Ao
class(C_sys_type), intent(in) :: this
get_Ao = this % Ao
end function get_Ao
subroutine set_Ao(this, Ao)
class(C_sys_type), intent(inout) :: this
type(Ao), intent(in) :: Ao
this % Ao = Ao
this % Ao_set = .true.
end subroutine set_Ao
End Module C_sys
I am not sure where in the subroutine set_Ao , type(Ao), intent(in) :: Ao should be left like this or instead to have class(Ao), intent(in) :: Ao. I know that class(Ao) is making the variable polymorphic and accessing the data type of A. But I don't know when it has to be used one or the other.
Thanks.
If you want to be able to bind a function/subroutine to a derived type (and for that routine to be able to access/modify the members of an instance of that type, which is the usual use-case; referred to as "PASSing" a variable), you need to meet the following conditions:
The TYPE definition must contain an appropriate PROCEDURE line (either with PASS explicitly stated, or there by-default whenever NOPASS is not specified).
The function/subroutine have at least one dummy argument of the TYPE in question, which must be declared in the argument list with CLASS (subject to all the restrictions that entails).
The reason it needs CLASS for this is that some other TYPE might "extend" your TYPE, which would mean it inherits its members - this can only work if the member routines are data-polymorphic.
I've attempted to modify your provided code sample into something representative of what I think you actually meant, but which actually compiles, to hopefully demonstrate correct usage.
module c_sys
implicit none
private
type, public :: a
integer :: i
end type
type, public :: c_sys_type
private
logical :: ao_set = .false.
type(a) :: ao
contains
private
procedure, public :: get_ao
procedure, public :: set_ao
end type c_sys_type
interface c_sys_type
procedure c_sys_type_constructor
end interface c_sys_type
contains
type(c_sys_type) elemental function c_sys_type_constructor(ao) result(c_sys)
type(a), intent(in), optional :: ao
c_sys % ao = ao
c_sys % ao_set = .true.
end function c_sys_type_constructor
type(a) elemental function get_ao(this)
class(c_sys_type), intent(in) :: this
get_ao = this % ao
end function get_ao
subroutine set_ao(this, ao)
class(c_sys_type), intent(inout) :: this
type(a), intent(in) :: ao
this % ao = ao
this % ao_set = .true.
end subroutine set_ao
end module c_sys
I assume your TYPE A and TYPE AO were defined in the CLASS_A module you haven't provided. I've declared a dummy type in my version.
Things can get more complex if you want to make use of NOPASS etc., but for "normal" usage I hope this answers your question.
I have an abstract type and several types which inherit from him. Now I need to make an array of instances of those inherited types, but I'm not sure, if it's even possible in Fortran.
I've tried to make some wrapper type, like in Creating heterogeneous arrays in Fortran.
module m
implicit none
type, abstract :: a
integer, public :: num
end type a
type, extends(a) :: b
end type b
type, extends(a) :: c
end type c
type :: container
class(*), allocatable :: ptr
end type
end module m
program mwe
use m
type(b) :: b_obj
class(*), allocatable :: a_arr(:)
b_obj = b(1)
allocate(container :: a_arr(3))
a_arr(1) = container(b_obj)
end program mwe
But I'm getting this error:
test3.f90:28:25:
a_arr(1) = container(b_obj)
1
Error: Can't convert TYPE(b) to CLASS(*) at (1)
What am I doing wrong? Or is there any other, correct way to do it?
Attempt 2
I edited the code accordingly to francescalus's answer:
program mwe
use m
type(b) :: b_obj
type(c) :: c_obj
type(container), allocatable :: a_arr(:)
integer :: i
b_obj = b(1)
c_obj = c(2)
allocate(container :: a_arr(3))
a_arr(1)%ptr = b(1)
a_arr(2)%ptr = c(3)
a_arr(3)%ptr = c(1000)
do i=1,3
write(*,*) a_arr(i)%ptr%num
end do
end program mwe
And I'm getting another error:
test3.f90:36:35:
write(*,*) a_arr(i)%ptr%num
1
Error: ‘num’ at (1) is not a member of the ‘__class__STAR_a’ structure
As IanH commented when outlining the approach you take, the then current version of gfortran
does not appear to support definition of an unlimited polymorphic component via a structure constructor
container(b_obj) is such a thing. So, leaving aside whether you are still coming up against this problem, one may be interested in still allowing older versions/other compilers to use the code.
An alternative approach is not to use a constructor for the element of your container. Instead the single component can feature directly in an assignment:
use m
type(container) a_arr(3) ! Not polymorphic...
a_arr%ptr = b(1) ! ... so it has component ptr in its declared type
end mwe
Naturally, we still have the component of the container type polymorphic so any attempts to reference/define/etc., that component will be subject to those various restrictions. In your question you have the component unlimited polymorphic, but I see that you first talk about restricting the container's consideration to elements which extend the first type. Rather than declaring the container component as unlimited polymorphic it could be much more helpfully of declared type a:
type :: container
class(a), allocatable :: ptr
end type
This would be sufficient to solve the problem with
do i=1,3
write(*,*) a_arr(i)%ptr%num
end do
because num is a component of the declared type of a_arr(i)%ptr (that is., a). In general, it isn't the complete solution because
do i=1,3
write(*,*) a_arr(i)%ptr%num_of_type_b
end do
wouldn't work (with num_of_type_b a component in the extending type). Here you have to use the usual tricks (defined input/output, dynamic resolution, select type and so on). Those are beyond the scope of this answer and many other questions may be found covering them.
I add the correction to resolve the following error,
test3.f90:36:35:
write(*,*) a_arr(i)%ptr%num
1
Error: ‘num’ at (1) is not a member of the ‘__class__STAR_a’ structure
The unlimited polymorphic variable cannot directly access any component of the dynamic data type. In this case, a simple solution is to avoid class(*). The definition of container is changed to
type :: container
class(a), allocatable :: ptr
end type
So the working code in summary is as follows,
module m
implicit none
type, abstract :: a
integer, public :: num
end type a
type, extends(a) :: b
end type b
type, extends(a) :: c
end type c
type :: container
class(a), allocatable :: ptr
end type
end module m
program mwe
use m
type(container), allocatable :: a_arr(:)
integer :: i
allocate(container :: a_arr(3))
a_arr(1)%ptr = b(1)
a_arr(2)%ptr = c(3)
a_arr(3)%ptr = c(1000)
do i=1,3
write(*,*) a_arr(i)%ptr%num
end do
end program mwe
I'm attempting to add conversion functions to between different derived types. I'm
wanting them to be functions of the first derived type that returns the other derived type. This is no problem as long as they are in the same file and module. But I'd really like them to be able to be separated into multiple files since otherwise it would be a very large file. I can't figure out how to do this because of dependencies, and the lack of namespace in Fortran.
Is there a way to do this?
Here is an example of what I'd like to be dividing into two files (one for each derived type).
Module ConversionStuff
implicit none
type A_T
real :: a, b, c
contains
procedure :: toX => a_toX
end type A_T
type X_T
real :: x, y, z
contains
procedure :: toA => x_toA
end type X_T
contains
function a_toX(this) result(x)
class(A_T), intent(inout) :: this
type(X_T) :: x
x%x = this%a * 2
x%y = this%b * 2
x%z = this%c * 2
end function a_toX
function x_toA(this) result(a)
class(X_T), intent(inout) :: this
type(A_T) :: a
a%a = this%x * 0.5
a%b = this%y * 0.5
a%c = this%z * 0.5
end function x_toA
End Module ConversionStuff
I do apologize if there is a typo. I don't have an easy way to compile Fortran on this computer.
Within the current language this is easily enough dealt with through submodules - both type definitions go into the ancestor module along with the interfaces for the "shared" separate module procedures, procedure definitions are then split between submodules as it suits.
MODULE ConversionStuff
IMPLICIT NONE
TYPE :: A_T
REAL :: a, b, c
CONTAINS
PROCEDURE :: toX => a_toX
END TYPE A_T
TYPE :: X_T
REAL :: x, y, z
CONTAINS
PROCEDURE :: toA => x_toA
END TYPE x, y, z
INTERFACE
MODULE FUNCTION a_toX(this) RESULT(x)
IMPLICIT NONE
CLASS(A_T), INTENT(IN) :: this
TYPE(X_T) :: x
END FUNCTION a_toX
MODULE FUNCTION x_toA(this) RESULT(a)
IMPLICIT NONE
CLASS(X_T), INTENT(IN) :: this
TYPE(A_T) :: a
END FUNCTION x_toA
END INTERFACE
END MODULE ConversionStuff
SUBMODULE (ConversionStuff) Procedures_for_X
IMPLICIT NONE
CONTAINS
MODULE PROCEDURE a_toX
x%x = this%a * 2
x%y = this%b * 2
x%z = this%c * 2
END PROCEDURE a_toX
END SUBMODULE Procedures_for_X
...
Prior to Fortran 2008, you can sometimes use an alternative approach that emulates the above - the implementation of the procedures goes in a separately compiled set of external procedures that use the module. Care needs to be taken that the external procedures do not have visibility of their own interface.
MODULE ConversionStuff
IMPLICIT NONE
TYPE :: A_T
REAL :: a, b, c
CONTAINS
PROCEDURE :: toX => a_toX
END TYPE A_T
TYPE :: X_T
REAL :: x, y, z
CONTAINS
PROCEDURE :: toA => x_toA
END TYPE x, y, z
INTERFACE
FUNCTION a_toX(this) RESULT(x)
IMPORT :: A_T
IMPORT :: X_T
IMPLICIT NONE
CLASS(A_T), INTENT(IN) :: this
TYPE(X_T) :: x
END FUNCTION a_toX
FUNCTION x_toA(this) RESULT(a)
IMPORT :: A_T
IMPORT :: X_T
IMPLICIT NONE
CLASS(X_T), INTENT(IN) :: this
TYPE(A_T) :: a
END FUNCTION x_toA
END INTERFACE
PRIVATE :: a_toX
PRIVATE :: x_toA
END MODULE ConversionStuff
FUNCTION A_toX(this) RESULT(x)
USE ConversionStuff
IMPLICIT NONE
CLASS(A_T), INTENT(IN) :: this
TYPE(X_T) :: x
...etc...
END FUNCTION A_toX
There are limitations for the use of Fortran's accessibility attributes (PUBLIC and PRIVATE) for this second approach.
Note that the problem has nothing to do with namespaces, as the concept is typically defined.
After working on other things and coming back to this almost 2 months later. I found something I think is far more simple and elegant for this specific usage. I'm going to leave the previously accepted answer because it definitely answers the question, but this is an alternative method.
It uses the include keyword. I didn't understand until now that it doesn't compile included file until it is compiling the including file. Maybe there is something I don't understand, but for this situation where I only want to split into multiple files so that my single file isn't enormous, I think this method is worth the trade off in what I lose for it not being a module. If there is something I'm missing please let me know.
My solution is below.
Module ConversionStuff
implicit none
type A_T
real :: a, b, c
contains
procedure :: toX => a_toX
end type A_T
type X_T
real :: x, y, z
contains
procedure :: toA => x_toA
end type X_T
contains
include "A.f90"
include "X.f90"
End Module ConversionStuff
A.f90
function a_toX(this) result(x)
class(A_T), intent(inout) :: this
type(X_T) :: x
x%x = this%a * 2
x%y = this%b * 2
x%z = this%c * 2
end function a_toX
X.f90
function x_toA(this) result(a)
class(X_T), intent(inout) :: this
type(A_T) :: a
a%a = this%x * 0.5
a%b = this%y * 0.5
a%c = this%z * 0.5
end function x_toA
I'm trying to do a matrix inversion in a FORTRAN code which is called in MATLAB. But when I run the code in debug mode it can call and compute "dgetrf" without any problem but then I get a segfault in "dgetri". Can anyone give me an insight about any possible reason for such an error?
Here is the gateway function for the test function I use:
#include "fintrf.h"
!
SUBROUTINE MEXFUNCTION(NLHS, PLHS, NRHS, PRHS)
use mexf90
implicit none
integer*8, intent(in) :: PRHS(*) ! Pointers carrying the input data
integer*8, intent(out) :: PLHS(*) ! Pointers carrying the output data
integer*4, intent(in) :: NLHS,NRHS ! REMAINS THE SAME FOR 64BIT system
!-----------------------------------------------------------------------
integer*8 :: err, nA, mA
integer*8, pointer :: matAR, AInvR
character(200) :: errMsg
integer*4 :: txt, classId
integer*4, external :: mexprintf
! THE PART BELOW SEPARATED WITH "!$$" IS FOR WINDOWS ONLY
! THIS RESETS THE FLOATING POINT EXCEPTION
! TO ALLOW DIVIDE BY ZERO,
! OVERFLOW AND INVALID
!$$
!#if defined MSWIND
! INTEGER(2) CONTROL
! CALL GETCONTROLFPQQ(CONTROL)
! CONTROL = CONTROL .OR. FPCW$ZERODIVIDE
! CONTROL = CONTROL .OR. FPCW$INVALID
! CONTROL = CONTROL .OR. FPCW$OVERFLOW
! CALL SETCONTROLFPQQ(CONTROL)
!#endif
!$$
! ERROR CHECKING FOR INPUT
IF (NRHS .NE. 1) THEN
CALL MEXERRMSGTXT('MultMexError: 1 INPUT ARGUMENT IS REQUIRED')
ENDIF
IF (NLHS .NE. 1) THEN
CALL MEXERRMSGTXT('MultMexError: 1 OUTPUT ARGUMENT IS REQUIRED')
ENDIF
! ASSIGN POINTERS TO THE VARIOUS PARAMETERS
! Input matrix
matAR =>MXGETPR(PRHS(1))
mA = MXGETM(PRHS(1))
nA = MXGETN(PRHS(1))
! Do something meaningful...
classId = mxClassIDFromClassName('double')
plhs(1) = mxCreateDoubleMatrix(mA,nA,0)
AInvR =>mxGetPr(plhs(1))
call invTest(matAR,mA,nA,AInvR)
! Send the result to the return argument
!(For an alternative way of sending the results to the return arguments - see referenceF90.f90)
END SUBROUTINE MEXFUNCTION
The test function where I do the matrix inversion is as follows:
subroutine invTest(matAR,mA,nA,AInvR)
use mexf90
implicit none
interface
function dinv(A) result(Ainv)
use mexf90
real*8, dimension(:,:), intent(in) :: A
real*8, dimension(size(A,1),size(A,2)) :: Ainv
end function dinv
end interface
integer*4, intent(in) :: mA, nA
real*8, intent(in) :: matAR(mA,nA)
real*8, intent(out) :: AInvR(mA,nA)
AInvR = dinv(matAR)
end subroutine invTest
and the subroutine which I found on the internet to do the matrix inversion is:
function dinv(A) result(Ainv)
use mexf90
real*8, dimension(:,:), intent(in) :: A
real*8, dimension(size(A,1),size(A,2)) :: Ainv
real*8, dimension(size(A,1)) :: work ! work array for LAPACK
integer, dimension(size(A,1)) :: ipiv ! pivot indices
integer :: n, info, ddd
! External procedures defined in LAPACK
external DGETRF
external DGETRI
! Store A in Ainv to prevent it from being overwritten by LAPACK
Ainv = A
n = size(A,1)
! DGETRF computes an LU factorization of a general M-by-N matrix A
! using partial pivoting with row interchanges.
call DGETRF(n, n, Ainv, n, ipiv, info)
if (info /= 0) then
CALL MEXERRMSGTXT('Matrix is numerically singular!')
end if
! DGETRI computes the inverse of a matrix using the LU factorization
! computed by DGETRF.
call DGETRI(n, Ainv, n, ipiv, work, n, info)
if (info /= 0) then
CALL MEXERRMSGTXT('Matrix inversion failed!')
end if
end function dinv
You've got a mismatch of types for nA and mA in your call to invTest. They should be integer*4 but you have them declared as integer*8 in MEXFUNCTION.
If they need to be integer*8 for the call to mxCreateDoubleMatrix then just make integer*4 copies or possibly try
call invTest(matAR,int(mA),int(nA),AInvR)