Fortran constructor of abstract class initializing private variables - constructor

I'm beginning with Fortran and I wanted to try a pretty simple example - one abstract class Connection, then its derived class IntervalConnection, while Connection class would have a constructor defined and IntervalConnection would inherit this constructor.
In this constructor I have several private variables, which I need to initialize.
The problem is, I'm getting following error, when trying to create a new object:
Connection.f08:152:10:
con = IntervalConnection(n1_p, n2_p, 5.0)
1
Error: Component ‘input_neuron’ at (1) is a PRIVATE component of ‘connection’
I suppose I'm not defining the constructor new_connection correctly. Could you, please, tell me, how should I implement it in a better way?
My code
module Connection_mod
implicit none
public
! TODO smazat
type :: Neuron
real, private :: state
contains
procedure :: get_state => get_state_impl
procedure :: set_state => set_state_impl
end type Neuron
!------------------!------------------------------------------------------------------------
! Type definitions !
!------------------!
type, abstract :: Connection
class(Neuron), pointer, private :: input_neuron
class(Neuron), pointer, private :: output_neuron
real, private :: weight
contains
procedure :: adjust_weight => adjust_weight_impl
! Getters and setters
procedure :: get_input_neuron => get_input_neuron_impl
procedure :: get_output_neuron => get_output_neuron_impl
procedure :: get_weight => get_weight_impl
end type Connection
type, extends(Connection) :: IntervalConnection
contains
procedure :: pass_signal => pass_signal_impl
end type IntervalConnection
!------------!------------------------------------------------------------------------------
! Interfaces !
!------------!
interface Connection
module procedure new_connection
end interface Connection
contains
!------------------------!------------------------------------------------------------------
! Method implementations !
! -----------------------!
!--------------!
! class Neuron !
!--------------!
! TODO smazat
function get_state_impl(this) result(state)
class(Neuron), intent(in) :: this
real :: state
state = this%state
end function get_state_impl
! TODO smazat
function set_state_impl(this, new_state) result(ret_this)
class(Neuron), target :: this
real, intent(in) :: new_state
class(Neuron), pointer :: ret_this
ret_this => this
this%state = new_state
end function set_state_impl
!------------------!
! class Connection !
!------------------!
subroutine adjust_weight_impl(this, added_value)
class(Connection), intent(inout) :: this
real, intent(in) :: added_value
this%weight = this%weight + added_value
end subroutine adjust_weight_impl
!--------------------------!
! class IntervalConnection !
!--------------------------!
subroutine pass_signal_impl(this)
! TODO dokoncit
class(IntervalConnection), intent(in) :: this
real :: a
class(Neuron), pointer :: dummy
a=this%weight * this%input_neuron%get_state()
dummy => this%output_neuron%set_state(5.0)
!this%output_neuron%set_state(this%weight * this%input_neuron%get_state())
end subroutine pass_signal_impl
!--------------!------------------------------------------------------------------------
! Constructors !
!--------------!
function new_connection(this, input_neuron, output_neuron, weight) result(ret_this)
class(Connection), target :: this
class(Connection), pointer :: ret_this
class(Neuron), pointer :: input_neuron
class(Neuron), pointer :: output_neuron
real, intent(in) :: weight
ret_this => this
this%input_neuron => input_neuron
this%output_neuron => output_neuron
this%weight = weight
end function new_connection
!-------------------!-------------------------------------------------------------------
! Getters & Setters !
!-------------------!
function get_input_neuron_impl(this) result (input_neuron)
class(Connection), target, intent(in) :: this
class(Neuron), pointer :: input_neuron
input_neuron => this%input_neuron
end function get_input_neuron_impl
function get_output_neuron_impl(this) result (output_neuron)
class(Connection), target, intent(in) :: this
class(Neuron), pointer :: output_neuron
output_neuron => this%output_neuron
end function get_output_neuron_impl
function get_weight_impl(this) result (weight)
class(Connection), intent(in) :: this
real :: weight
weight = this%weight
end function get_weight_impl
end module Connection_mod
program a
use Connection_mod
type(Neuron), target :: n1
type(Neuron), target :: n2
type(Neuron), pointer :: n1_p
type(Neuron), pointer :: n2_p
type(IntervalConnection) :: con
n1_p => n1
n2_p => n2
con = IntervalConnection(n1_p, n2_p, 5.0)
end program a

The function you created as a constructor takes four arguments
function new_connection(this, input_neuron, output_neuron, weight)
but you call it with three arguments
class(IntervalConnection) :: con
con = IntervalConnection(n1_p, n2_p, 5.0)
I moved the assignment out. It is not strictly necessary.
Therefore the generic resolution (TKR) cannot be successful and the default constructor will be tried.
And you also overloaded the Constructor or Connection, but then you call IntervalConection(). These are different!
You probably misunderstood how a constructor works with the arguments and return values. There is no place for any this argument. A constructor is NOT a type-bound procedure. It is not inherited. But the child connection can call the parent constructor if needed. Sometimes you want that, sometimes not. Notice the returned value is type, not class!
function new_interval_connection(input_neuron, output_neuron, weight) result(ret)
type(IntervalConnection) :: ret
class(Neuron), pointer :: input_neuron
class(Neuron), pointer :: output_neuron
real, intent(in) :: weight
ret%input_neuron => input_neuron
ret%output_neuron => output_neuron
ret%weight = weight
end function new_interval_connection
You want to create an instance of make the constructor for IntervalConnection, not for Connection, as you tried
interface IntervalConnection
module procedure new_interval_connection
end interface Connection
con = IntervalConnection(n1, n2, 5.0)

Related

Private and Public usage for the result variable of a Fortran function

I think this would have a quick answer from the experts but I have a basic doubt regarding Fortran using modules as private and declaring public what is used.
Would declaring the function in this case, be sufficient to use the module (example 1) and get the result outside?
or,
Does Fortran require to declare public both function and result (example 2)?
Example 1:
module forit
implicit none
private
integer, parameter :: dp=selected_real_kind(14)
public :: tester
contains
function tester(delta,w) result(resval)
real(dp), intent(in) :: delta, w
real(dp) :: resval
resval = w / delta ** 2
end function tester
end module forit
Example 2:
module forit
implicit none
private
integer, parameter :: dp=selected_real_kind(14)
real(dp) :: resval
public :: tester
public :: resval
contains
function tester(delta,w) result(resval)
real(dp), intent(in) :: delta, w
real(dp) :: resval
resval = w / delta ** 2
end function tester
end module forit

Using fortran to pass functions into a subroutine.

I've written a set of subroutines and compiled them into a library. These subroutines are based on some defined function(x,y). At the moment this is buried inside the library routine - however what I'd like is to be able to pass any function(x,y) into this library - is this possible? Thanks guys!
module ExampleFuncs
implicit none
abstract interface
function func (z)
real :: func
real, intent (in) :: z
end function func
end interface
contains
subroutine EvalFunc (aFunc_ptr, x)
procedure (func), pointer :: aFunc_ptr
real, intent (in) :: x
write (*, *) "answer:", aFunc_ptr (x)
end subroutine EvalFunc
function f1 (x)
real :: f1
real, intent (in) :: x
f1 = 2.0 * x
end function f1
function f2 (x)
real :: f2
real, intent (in) :: x
f2 = 3.0 * x**2
end function f2
end module ExampleFuncs
program Func_to_Sub
use ExampleFuncs
implicit none
procedure (func), pointer :: f_ptr => null ()
f_ptr => f1
call EvalFunc (f_ptr, 2.0)
f_ptr => f2
call EvalFunc (f_ptr, 2.0)
stop
end program Func_to_Sub

Fortran - Return an anonymous function from subroutine

I am trying to generalize a function call from a subroutine. So my idea is something like this
if (case1) then
call MainSubroutine1(myFun)
elseif (case2)
call MainSubroutine2(myFun)
end if
do i = 1,4
data = myFun(i)
end do
I realize this is kind of vague but I am not sure if this is possible.
Thank you,
John
edit 1/31/14 7:57 AM
I am sorry for the vague way I phrased this. I was thinking something similar to what #haraldki did but I was hoping that I could define an anonymous function within MainSubroutine1 and MainSubroutine2 and transfer that definition out to the main code.
This is because myFun depends on different stretched distribution (Gaussian and Fermi-Dirac) and I don't want to have a function that only calls a function with a constant thrown it.
Is this possible?
Thank you again.
John
The answer to you question simply is: no, you can't return an anonymous function. This is because, as #VladimirF says in the comments, there are no anonymous functions in Fortran. As the comments say, though, procedure pointers are quite passable.
Massive speculation follows which is hopefully useful as a way of avoiding the anonymous function requirement.
I infer that you would like to do something like
subroutine MainSubroutine1(fptr)
procedure(func), pointer, intent(out) :: fptr
! Calculate parameterization for your "anonymous" function
fptr => anon_parameterized
contains
real function anon_parameterized(i)
integer, intent(in) :: i
! Use the parameterization
anon_parameterized = ...
end function
end subroutine
and you don't want to do
subroutine MainSubroutine1(fptr)
procedure(func), pointer, intent(out) :: fptr
fptr => Gaussian
end subroutine
real function Gaussian(i)
integer, intent(in) :: i
! Calculate parameterization
Gaussian = Gaussian_parameterized(i, ...)
contains
function Gaussian_parameterized(i, ...)
integer, intent(in) :: i
!... other intent(in) parameters
end function
end subroutine
Note that these aren't internal, as passing pointers to things internal elsewhere is not well implemented (as an F2008 feature) yet, and is tricky. Passing a pointer to an internal procedure to get host association scares me.
If my inference is correct, then there is the possibility of using module variables to store the parameterization, again allowing the final "parameterized" call to be not internal to MainSubroutine1.
However, you may want to avoid module variables in which case you may consider passing passing the parameterization along with the function call:
procedure(func), pointer :: myFun => null()
if (case1) then
call MainSubroutine1(myFun)
else if (case2)
call MainSubroutine2(myFun)
end if
if (.not.associated(myFun)) STOP ":("
data = myFun(1, par1, par2)
Ah, but you don't know for certain what parameters the non-parameterized function myFun requires, so your interface is all broken. Isn't it?
Which then leads to polymorphism.
module dists
type, abstract :: par_type
end type par_type
type, extends(par_type) :: par_gaussian
real :: mu=5.2, sigma=1.2
end type par_gaussian
type, extends(par_type) :: par_fermi_dirac
real :: eps=11.1, mu=4.5
end type par_fermi_dirac
abstract interface
real function func(i, pars)
import par_type
integer, intent(in) :: i
class(par_type), intent(in) :: pars
end function func
end interface
contains
real function gaussian(i, pars)
integer, intent(in) :: i
class(par_type), intent(in) :: pars
select type (pars)
class is (par_gaussian)
print*, "Gaussian", pars%mu, pars%sigma
gaussian = pars%mu+pars%sigma
end select
end function gaussian
real function fermi_dirac(i, pars)
integer, intent(in) :: i
class(par_type), intent(in) :: pars
select type (pars)
class is (par_fermi_dirac)
print*, "Fermi-Dirac", pars%eps, pars%mu
fermi_dirac = pars%eps+pars%mu
end select
end function fermi_dirac
subroutine sub1(fptr, pars)
procedure(func), pointer, intent(out) :: fptr
class(par_type), intent(out), allocatable :: pars
fptr => gaussian
allocate(par_gaussian :: pars)
end subroutine sub1
subroutine sub2(fptr, pars)
procedure(func), pointer, intent(out) :: fptr
class(par_type), intent(out), allocatable :: pars
fptr => fermi_dirac
allocate(par_fermi_dirac :: pars)
end subroutine sub2
end module dists
program prog
use dists
implicit none
class(par_type), allocatable :: pars
procedure(func), pointer :: myfun
call sub1(myfun, pars)
print*, myfun(i, pars)
call sub2(myfun, pars)
print*, myfun(i, pars)
end program prog
That's all speculation, though.

Pointer to a function inside a derived type on a module in fortran

I guess I could easily use some help here, since I'm messing around with some fortran 2003 but can't seem to understand how to do things really.
The fact is that I need to write a fortran code that declares, inside a module, a new data type
that has as one of its members a pointer to a real function. Something like
module new_mod
type my_type
real*8 :: a, b
(here something that declares a real*8 function), pointer :: ptr
end type my_type
end module_new
module funcs
real*8 function function1(x)
real*8 :: x
function1 = x*x
end function function1
real*8 function function2(x)
real*8 :: x
function2 = x*x
end function function2
end module funcs
then in the main program I would like to have something like
program my_prog
use module_new
use module_funcs
implicit none
real*8 :: y, z
type(my_type) :: atom
...
atom%ptr => function1
y = atom%ptr(x)
...
atom%ptr => function2
z = atom%ptr(x)
end program my_prog
while
so the main idea is that module_new contains a type that has a pointer to a real
function. This pointer in th eobjects of the new type I must be able to point to different functions in the main program.
I have seen one can do similar things with abstract interfaces and such, but honestly, I'm in a mess here. If someone could help, I'll appreciate that.
Cheers...
Well, that is not really the type of question you would send to stackoverflow, but actually your code needs only a "slight improvement" (by appropriate definition of slight) to work:
module accuracy
implicit none
integer, parameter :: dp = kind(1.0d0)
end module accuracy
module typedef
use accuracy
implicit none
type :: mytype
real(dp) :: aa, bb
procedure(myinterface), pointer, nopass :: myfunc
end type mytype
abstract interface
function myinterface(xx)
import :: dp
real(dp), intent(in) :: xx
real(dp) :: myinterface
end function myinterface
end interface
end module typedef
module funcs
use accuracy
implicit none
contains
function func1(xx)
real(dp), intent(in) :: xx
real(dp) :: func1
func1 = xx
end function func1
function func2(xx)
real(dp), intent(in) :: xx
real(dp) :: func2
func2 = 2.0_dp * xx
end function func2
end module funcs
program test
use accuracy
use typedef
use funcs
implicit none
real(dp) :: xx
type(mytype) :: atom
xx = 12.0_dp
atom%myfunc => func1
print *, atom%myfunc(xx)
atom%myfunc => func2
print *, atom%myfunc(xx)
end program test
There are several things to be worth to mentioned:
You should use one global parameter for your accuracy (see module accuracy) and forget about real*8.
Your procedure pointer in your derived type needs an interface, which is provided within the following abstract interface block (see 'abstract interfaces' in a good F2003 book).
You need the nopass option for the procedure pointer in the derived type as otherwise Fortran will assume that the first parameter passed to the function/subroutine is the derived type itself (see 'type bound procedures' in a good F2003 book).
Finally, although rather obvious: You should definitely read a book about the Fortran 2003 features if you are serious about using them in a production code.

Elemental functions cannot be pointed to by procedure pointers

I'm trying to use a procedure pointer (new feature in Fortran 2003) to point to an elemental function but it does not work. I really need the function to be ELEMENTAL and need a pointer to it. Is it truly impossible to point to an elemental function in Fortran?
module elemfunc
implicit none
contains
elemental function fun111(x) result(y)
real*8, intent(in) :: x
real*8 :: y
y = x**2+1
end function fun111
end module elemfunc
program testptr
use elemfunc
implicit none
interface
elemental function func (z)
real*8 :: func
real*8, intent (in) :: z
end function func
end interface
procedure (func), pointer :: ptr
ptr => fun111
print *, ptr( (/1.0d0,2.0d0/) )
end program testptr
Error message:
main.f90:12.7:ptr=>fun111
1
Nonintrinstic elemental procedure pointer 'func111' is invalid in procedure pointer assignment at (1)
In paragraph 7.4.2 Pointer Assignment of the fortran 2003 standard it is explicitly stated that this is not allowed:
C728 (R742) The proc-target shall not be a nonintrinsic elemental procedure
(This constraint is still there in the fortran 2008 standard, so it hasn't been relaxed.)
I had this exact same issue and did not even realize it was an issue until I compiled with gfortran. Unfortunately, it is also forbidden to have dummy procedure arguments to elemental procedures. It is, however, still possible to achieve the functionality you want, though it is a bit kludgy.
What you can legally do is have an elemental function call a pure function. Depending on your needs, the elemental function can be type bound or not.
Option one
Put the procedure pointer and function inside a module:
module A
implicit none
procedure(func_IF), pointer :: ptr => null()
abstract interface
pure function func_IF(x)
real, intent(in) :: x
real :: func_IF
end function
end interface
contains
! Non type bound elemental
elemental function myfun1(x) result(r)
real, intent(in) :: x
real :: r
if(associated(ptr)) r = ptr(x)
end function
end module
Option two
Put both pointer and function inside a derived type:
module B
implicit none
type :: foo
procedure(func_IF), nopass, pointer :: ptr => null()
contains
procedure, pass :: myfun2
end type
abstract interface
pure function func_IF(x)
real, intent(in) :: x
real :: func_IF
end function
end interface
contains
! Type bound elemental
elemental function myfun2(this, x) result(r)
class(foo), intent(in) :: this
real, intent(in) :: x
real :: r
if(associated(this%ptr)) r = this%ptr(x)
end function
end module
A small test program:
program main
use A
use B
implicit none
type(foo) :: myfoo
myfoo%ptr => bar
ptr => bar
print*, myfun1([10., 20.])
print*, myfoo%myfun2([10., 20.])
contains
! Demo pure function with interface func_IF
pure function bar(x)
real, intent(in) :: x
real :: bar
bar = x**2
end function
end