I have the following problem:
I have a subroutine called taylorExpansion which accepts a function f of which it computes a first order approximation.
The problem is now that in some cases I want the function f to accept some extra (optional) parameter alpha, but in other cases f doesn't accept this parameter.
module myModule
implicit none
save
abstract interface
subroutine getfunc(x_k,fvalue,alpha)
import dp
real(kind=dp), dimension(:), intent(in) :: x_k !
real(kind=dp), allocatable, intent(out) :: fvalue(:)
procedure(num_method), optional :: alpha ! Some functions should be able to accept an extra parameter alpha.
end subroutine
end interface
contains
subroutine taylorExpansion(f)
procedure(getfunc) :: f
...
end subroutine
end module
I want my program to look like the following:
program myProgram
use myModule
implicit none
call taylorExpansion(func1)
call taylorExpansion(func2)
contains
! This function accepts an extra parameter alpha
subroutine func1(x_k,fvalue,alpha)
real(kind=dp), dimension(:), intent(in) :: x_k !
real(kind=dp), allocatable, intent(out) :: fvalue(:)
procedure(num_method), optional :: alpha
...
end subroutine
! This function does NOT accept an extra parameter alpha
subroutine func2(x_k,fvalue)
real(kind=dp), dimension(:), intent(in) :: x_k !
real(kind=dp), allocatable, intent(out) :: fvalue(:)
...
end subroutine
end program
The problem is now that I can't do this: Fortran forces me to declare the optional argument alhpa in func2:
subroutine func1(x_k,fvalue,alpha)
real(kind=dp), dimension(:), intent(in) :: x_k !
real(kind=dp), allocatable, intent(out) :: fvalue(:)
procedure(num_method), optional :: alpha
...
end subroutine
while this make in reality no sense (func2 never needs a parameter alpha)
Is there a way to circumvent this?
You can always write a wrapper
subroutine func2_wrap(x_k,fvalue,alpha)
real(kind=dp), dimension(:), intent(in) :: x_k !
real(kind=dp), allocatable, intent(out) :: fvalue(:)
procedure(num_method), optional :: alpha
call func2(x_k,fvalue)
end subroutine
and pass this wrapper to taylorExpansion.
Related
Following a previous question I had (Fortran TYPE inheritance on runtime (declared by user)), I am using a factory method to generate an array of different types. Below is a simplified version of what I'm doing,
module multiarray
use iso_fortran_env, only: real64
implicit none
integer, parameter :: dp = real64
! abstract list type
type, abstract :: list
contains
procedure(in), deferred, pass(self) :: addval ! add a variable
procedure(out), deferred, pass(self) :: getval ! extract variable
end type
abstract interface
subroutine in(self,val)
import :: list
implicit none
class(list), intent(inout) :: self
class(*), intent(in) :: val
end subroutine
subroutine out(self,val)
import :: list
implicit none
class(list), intent(in) :: self
class(*), intent(out) :: val
end subroutine
end interface
! real(dp) element extension
type, extends(list) :: real_num
real(dp) :: var
contains
procedure, pass(self) :: addval => addreal
procedure, pass(self) :: getval => getreal
end type
! similar for character, logical, etc types
...
! wrapper
type wrapper
class(list), ALLOCATABLE :: arg
end type
contains
! real(dp) subroutines
subroutine addreal(self,val)
implicit none
class(real_num), intent(inout) :: self
class(*), intent(in) :: val
select type(val)
type is (real(dp))
self%var = val
end select
end subroutine
subroutine getreal(self,val)
implicit none
class(real_num), intent(in) :: self
class(*), intent(out) :: val
select type(val)
type is (real(dp))
val = self%var
end select
end subroutine
! similar for character, logical, etc types
...
! factory method
function get_list(val) result(pt)
class(*), intent(in) :: val
class(list), allocatable :: pt
select type(val)
type is (real(dp))
allocate(real_num :: pt)
type is (character(*))
...
end select
end function
end module
I use the wrapper type to generate an allocatable array of type list
type(wrapper) :: A(5)
real(dp) :: x
A(1)%arg = get_list(90.d0) ! Set A(1) as type real
call A(1)%arg%addval(90.d0) ! A(1) is a real of value 90
call A(1)%arg%getval(x) ! set x = A(1) to use elsewhere
The variable var is defined as a generic class in the abstract interface, it can be of real, character, logical, etc type. I then use a select type construct to match the addval=>addreal subroutine argument since var is of type class(*) in the abstract interface.
Is there a way to define an interface inside the abstract interface (nested), in a way that I don't need to have the select type in addreal (since I already know it's input needs to be a real type)? Or is there a better way, simpler way, to achieve what I'm trying to do with the variable type array? Thanks!
I think you don't want to have both class(*) inputs and an abstract base class. I think you want to have either one:
a non-polymorphic container class that can contain any (class(*)) element types, for example, a key-value pair in a dictionary;
a polymorphic container class if a limited set of types should later have a shared API.
In your case it seems you want maximum flexibility, I would vote for having a unique container class and making usage of class(*), like in the following example I've just made up:
! FP 2022-07-25
module myList
use iso_fortran_env
implicit none
type, public :: listElement
class(*), allocatable :: x
contains
procedure :: set
procedure :: get_any
procedure :: get_typed
procedure, private :: print
generic :: write(formatted) => print
end type listElement
contains
! Map accepted types
elemental logical function isAccepted(val)
class(*), intent(in) :: val
select type (input=>val)
type is (real(real32)); isAccepted = .true.
type is (character(*)); isAccepted = .true.
class default; isAccepted = .false.
end select
end function isAccepted
! Print value
subroutine print(this, unit, iotype, v_list, iostat, iomsg)
class(listElement), intent(in) :: this
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
if (.not.allocated(this%x)) then
write(unit,*,iostat=iostat) 'null'
else
select type (myVar => this%x)
type is (real(real32)); write(unit,*,iostat=iostat) myVar
type is (character(*)); write(unit,*,iostat=iostat) myVar
class default; write(unit,*,iostat=iostat) "ERROR"
end select
endif
end subroutine print
subroutine set(this,val)
class(listElement), intent(inout) :: this
class(*), intent(in) :: val
integer :: ierr
deallocate(this%x,stat=ierr) ! force deallocate
allocate(this%x,source=val)
end subroutine set
! Can be anything, but "val" must be declared "class(*), allocatable"
subroutine get_any(this,val)
class(listElement), intent(in) :: this
class(*), intent(out), allocatable :: val
allocate(val,source=this%x)
end subroutine get_any
subroutine get_typed(this,val)
class(listElement), intent(in) :: this
class(*), intent(out) :: val ! has a type that can't change
if (.not.isAccepted(val)) stop ' trying to return value to a class thats not supported '
if (.not.allocated(this%x)) return ! will return garbage
select type (outVal => val)
type is (real(real32));
select type (thisVal => this%x)
type is (real(real32)); outVal = thisVal
type is (real(real64)); outVal = real(thisVal,real32)
class default; stop 'error trying to convert list element to real32'
end select
type is (character(*));
select type (thisVal => this%x)
type is (character(*)); outVal = trim(thisVal)
class default; stop 'error trying to convert list element to character'
end select
class default
stop 'trying to return value to a class thats not accepted '
end select
end subroutine get_typed
end module myList
program tryList
use myList
implicit none
type(listElement) :: A(5)
integer :: i
character(255) myChar
real(real32) :: r32
real(real64) :: r64
call A(1)%set(123.45)
call A(2)%set("hello world!")
call A(3)%set(123.45d0)
do i=1,3
print *, 'A(',i,')=',A(i)
end do
call A(1)%get_typed(r64); print *, 'r64=',r64
call A(1)%get_typed(r32); print *, 'r32=',r32
call A(2)%get_typed(myChar); print *, 'myChar=',myChar
call A(2)%get_typed(r32) ! stop on error
end program
Notice that:
In general, this should work with any variables (class(*)), but if you want to use the fully polymorphic interface, the input variable must be defined as class(*), allocatable anywhere else, so, not exactly handy.
You want to have some helper routines and/or an enumerator type that help you map/handle all types you want to be contained, this example is just a stub.
This question already has answers here:
Fortran - explicit interface
(2 answers)
Procedure with assumed-shape dummy argument must have an explicit interface [duplicate]
(1 answer)
Closed 1 year ago.
I have the following Fortran source code intended to be compiled with f2py to be used by Numpy/Python.
subroutine get_value(ts, c_open)
implicit none
! INPUT PARAMETERS
integer(kind=4), intent(in) :: ts(:)
! OUTPUT PARAMETERS
integer(kind=4), intent(out) :: c_open
! SIMULATED CALCULATION
c_open = ts(1)
end subroutine
subroutine get_value_range(ts, a, b, c_open)
implicit none
! INPUT PARAMETERS
integer(kind=4), intent(in) :: ts(:)
integer(kind=4), intent(in) :: a
integer(kind=4), intent(in) :: b
! OUTPUT PARAMETERS
! - AGGREGATED VALUES TO RETURN
integer(kind=4), intent(out) :: c_open(b-a)
! INDIVIDUAL RETURN VALUES
integer(kind=4) :: c1_open
! AUXILIARY VARIABLES
integer :: i ! ITERATOR
! FILL IN OUTPUT ARRAY
do i = 1,10
call get_value( ts, c1_open)
c_open(i) = c1_open
end do
end subroutine
Basically get_value calculates a value (in this example it just returns the value of the first item of the passed vector ts and get_value_range returns a vector of results using get_value function.
When I compile with f2py I get:
37 | call get_value( ts, c1_open)
| 1
Error: Explicit interface required for 'get_value' at (1): assumed-shape argument
Why is this error being drop by f2py and is there any way to fix it?
EDIT:
I have been redirected here:
Fortran - explicit interface
and here:
Procedure with assumed-shape dummy argument must have an explicit interface
Now if I understood those posts correctly the compiler requires to know the parameters of get_value in get_value_range. That can be done either encapsulating everything in a module or by using an internal procedure or by defining explicitly an interface.
I am still pretty new to f2py and I am not sure if in f2py you have to encapsulate everything in modules or just write the subroutines as stand alone subroutines in the file. So far I am following the later approach as by doing that I see that they are properly exposed to Python.
Assuming that I want to try the approach of an explicit interface I try this:
subroutine get_value(ts, c_open)
implicit none
! INPUT PARAMETERS
integer(kind=4), intent(in) :: ts(:)
! OUTPUT PARAMETERS
integer(kind=4), intent(out) :: c_open
! SIMULATED CALCULATION
c_open = ts(1)
end subroutine
subroutine get_value_range(ts, a, b, ca_open)
implicit none
! INPUT PARAMETERS
integer(kind=4), intent(in) :: ts(:)
integer(kind=4), intent(in) :: a
integer(kind=4), intent(in) :: b
! OUTPUT PARAMETERS
! - AGGREGATED VALUES TO RETURN
integer(kind=4), intent(out) :: ca_open(b-a)
! INDIVIDUAL RETURN VALUES
integer(kind=4) :: c1_open
! AUXILIARY VARIABLES
integer :: i ! ITERATOR
! INTERFACE TO get_value
interface
function get_value(ts, c_open)
integer(kind=4), intent(in) :: ts(:)
integer(kind=4), intent(out) :: c_open
end function
end interface
! FILL IN OUTPUT ARRAY
do i = 1,10
call get_value(ts, c1_open)
ca_open(i) = c1_open
end do
end subroutine
But then I get the following error:
37 | function get_value(ts, c_open)
| 1
......
45 | call get_value(ts, c1_open)
| 2
Error: 'get_value' at (1) has a type, which is not consistent with the CALL at (2)
So it seems that the compiler is now finding the definition of get_value but for some reason that I can not understand it is detecting an inconsistency between the function definition and the call.
EDIT 2:
There is a clear error in the definition as pointed out in the comments, the interface block defines a function instead of a subroutine.
However, when I modify it I get a new error:
subroutine get_value(ts, c_open)
implicit none
! INPUT PARAMETERS
integer(kind=4), intent(in) :: ts(:)
! OUTPUT PARAMETERS
integer(kind=4), intent(out) :: c_open
! SIMULATED CALCULATION
c_open = ts(1)
end subroutine
subroutine get_value_range(ts, a, b, ca_open)
implicit none
! INTERFACE TO get_value
interface
subroutine get_value (ts, c_open)
integer(kind=4), intent(in) :: ts(:)
integer(kind=4), intent(out) :: c_open
end subroutine get_value
end interface
! INPUT PARAMETERS
integer(kind=4), intent(in) :: ts(:)
integer(kind=4), intent(in) :: a
integer(kind=4), intent(in) :: b
! OUTPUT PARAMETERS
! - AGGREGATED VALUES TO RETURN
integer(kind=4), intent(out) :: ca_open(b-a)
! INDIVIDUAL RETURN VALUES
integer(kind=4) :: c1_open
! AUXILIARY VARIABLES
integer :: i ! ITERATOR
! FILL IN OUTPUT ARRAY
do i = 1,10
call get_value(ts, c1_open)
ca_open(i) = c1_open
end do
end subroutine
These are the new errors after trying to compile it with f2py:
86 | subroutine get_value(ts,c_open) ! in :tape_lib:./ohl
| 1
Error: Syntax error in SUBROUTINE statement at (1)
88 | integer(kind=4), intent(in),dimension(:) :: ts
| 1
Error: Unexpected data declaration statement in INTERFACE block at (1)
89 | integer(kind=4), intent(out) :: c_open
| 1
Error: Unexpected data declaration statement in INTERFACE block at (1)
90 | end subroutine get_value
| 1
Error: Expecting END INTERFACE statement at (1)
How write assignment operator for complex number matrix class.
I know complex is standard in fortran.
For zcomplex_type works correct. I can assign real part of complex
number to real type, but in zmatrix_type doesn't work.
I must create matrix of real number in subroutine zmatrix_realmatrix_assign.
Error
mat1=tab
Error: Incompatible ranks 0 and 2 in assignment at (1)
module zmatrix_module
implicit none
type, public :: zcomplex_type
real :: realis
real :: imaginalis
end type zcomplex_type
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
public :: assignment(=)
interface assignment(=)
procedure zcomplex_re_assign
procedure re_zcomplex_assign
procedure zmatrix_realmatrix_assign
end interface
contains
subroutine zcomplex_re_assign(zcomplex1,real2)
type(zcomplex_type), intent(out) :: zcomplex1
real, intent(in) :: real2
zcomplex1%realis =real2
zcomplex1%imaginalis =0.0
end subroutine zcomplex_re_assign
subroutine re_zcomplex_assign(real2,zcomplex1)
real, intent(out) :: real2
type(zcomplex_type), intent(in) :: zcomplex1
real2=zcomplex1%realis
end subroutine re_zcomplex_assign
subroutine zmatrix_realmatrix_assign(zmatrix1,realmatrix2)
type(zmatrix_type), intent(out) :: zmatrix1
real, intent(in) :: realmatrix2
zmatrix1%zmatrix_data%realis=realmatrix2
zmatrix1%zmatrix_data%imaginalis=0
end subroutine zmatrix_realmatrix_assign
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
real :: tab(3,3)
call zmatrix_allocate(mat1,3)
tab=3
mat1=tab
print *, mat1
call zmatrix_free(mat1)
End Program main ```
You created an overloaded assignment operator zmatrix_realmatrix_assign which takes a scalar real value as input and outputs a zmatrix_type.
My guess is that you probably want zmatrix_realmatrix_assign to do the following:
make it accept a 2d real array: real, intent(in) :: realmatrix2(:,:)
allocate zmatrix1%zmatrix_data accordingly
set real/imag parts as previously done
subroutine zmatrix_realmatrix_assign(this, rmat)
type(zmatrix_type), intent(out) :: this
real, intent(in) :: rmat(:,:)
allocate (this%zmatrix_data(size(rmat, dim=1), size(rmat, dim=2)))
this%zmatrix_data%realis = rmat
this%zmatrix_data%imaginalis = 0
end subroutine
The assignment procedure explicitly allocates the data structure this%zmatrix_data such that the allocate call in your program is unnecessary
call zmatrix_allocate(mat1,3)
You could still use the zmatrix_allocate procedure by changing the intent in the assignment procedure but it is error prone (which is why I have added the tests for allocation)
subroutine zmatrix_realmatrix_assign(this, rmat)
type(zmatrix_type), intent(inout) :: this
real, intent(in) :: rmat(:,:)
if (.not. allocated(this%zmatrix_data) ) error stop 'did not call allocate beforehand'
if (any(shape(this%zmatrix_data) /= shape(rmat)) error stop 'wrong allocation of zmatrix_data'
this%zmatrix_data%realis = rmat
this%zmatrix_data%imaginalis = 0
end subroutine
I have function that returns an array, say
function f(A)
implicit none
real, intent(in) :: A(5)
real, intent(out) :: f(5)
f = A+1
end
My question is, how can I define f in the main program unit? E.g.
program main
implicit none
real :: A(5)
real, dimension(5), external :: f ! does not work
...
end
You need an explicit interface. You can do this in a few ways.
Explicitly in the scoping unit that calls f:
interface
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
end function
end interface
Place the function in your program host scope as an internal function:
program main
...
contains
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
end program
Place the function in a module:
module A
contains
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
end module
program main
use A
...
end program
Use the explicit interface from a different procedure with the same arguments and return type, kind and rank.
program main
interface
function r5i_r5o(r5)
implicit none
real, intent(in) :: r5(5)
real :: r5i_r5o(5)
end function
end interface
procedure(r5i_r5o) :: f
...
end program
function f(A)
implicit none
real, intent(in) :: A(5)
real :: f(5)
f = A+1
end
The cleanest way of doing this is option #3 using modules. This gives you the benefit of an automatic explicit interface (not needing to do option #1 everywhere you call f) and makes your function available everywhere the module is used rather than limited to a specific scoping unit as in option #2. Option #4 can be handy if you have many procedures with the same argument and return types since one explicit interface can be re-used for all of them.
This shows three different ways to specify function results, and how to use modules to organize your functions:
module so_func
INTEGER, PARAMETER :: MAX_SIZE = 5
TYPE MY_DATA
INTEGER :: SIZE
REAL, DIMENSION(MAX_SIZE) :: DATA
ENDTYPE
contains
FUNCTION f1(A,N) RESULT(X)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
REAL :: X(N)
! ....
X = 1.0+A
END FUNCTION f1
TYPE(MY_DATA) FUNCTION f2(A,N)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
! ....
f2%SIZE = N
f2%DATA(1:N) = 1.0+A
END FUNCTION f2
FUNCTION f3(A,N)
implicit none
INTEGER, INTENT(IN) :: N
REAL, INTENT(IN) :: A(N)
REAL :: f3(N)
! ....
f3 = 1.0+A
END FUNCTION f3
end module
program SO_RESULT
use so_func
implicit none
integer, parameter :: n=5
REAL :: A(n), y1(n), y3(n)
TYPE(MY_DATA) :: y2
INTEGER :: i
! Variables
A =(/ (i, i=1,n) /)
y1 = f1(A,n)
y2 = f2(A,n)
y3 = f3(A,n)
end program SO_RESULT
I want to add text to a scalar object's component no matter what is shape of this additional text.
To try this, I create an elemental procedure that has a elemental input argument but only one intent(inout) argument which is the passed object.
Here is a MWE:
module add_mod
implicit none
type obj_A
character(len=:), allocatable :: Message
contains
procedure, pass(objA) :: add
procedure, pass(objA) :: write
end type
contains
elemental subroutine add( objA, text )
implicit none
class(obj_A), intent(inout) :: objA
character(len=*), intent(in) :: text
objA%Message=objA%Message//text
end subroutine add
impure elemental subroutine write( objA, text )
implicit none
class(obj_A), intent(in) :: objA
character(len=*), intent(in) :: text
print*,'write ', text
end subroutine write
end module
program test
use add_mod
implicit none
type(obj_A) :: testA
call testA%add('toto')
print *, testA%Message
! call testA%add( ['toto','abcc','d,ef'] )
print *, testA%Message
call testA%write( ['toto','abcc','d,ef'] )
end program
If I let commented the line call testA%add( ['toto','abcc','d,ef'] ), it works fine. But if I uncomment, I have an error during the compilation
Error: Actual argument at (1) for INTENT(INOUT) dummy 'objA' of ELEMENTAL subroutine 'add' is a scalar, but another actual argument is an array`
I understand why it is correct with the testA%write call, it is due to the intent(in) of the passed object; in this case the compiler understands that one argument is scalar shape and the other one is array shape.
With the testA%add( ['toto','abcc','d,ef'] ), I also understand that it requires an array shaped obj_A as intent(inout), since the text given for input is a scalar. Thus, it is not the correct way to do it.
Is there a correct way to add text to obj_A%Message no matter what is shape of this text?
When using elemental subroutines, you can provide an array input and an array output [the operations then occur in an element-wise way]. However, you are trying to assign an array input to a scalar output (here: testA).
If you used an array output of size 3, your routine works as expected:
module add_mod
implicit none
type obj_A
character(len=:), allocatable :: Message
contains
procedure, pass(objA) :: add
end type
contains
elemental subroutine add( objA, text )
implicit none
class(obj_A), intent(inout) :: objA
character(len=*),intent(in) :: text
objA%Message=objA%Message//text
end subroutine add
end module
program test
use add_mod
implicit none
type(obj_A) :: testA
type(obj_A) :: testB(3)
call testA%add('toto')
print *, testA%Message
call testB%add( ['toto','abcc','d,ef'] )
print *, testA%Message
print *, testB(1)%Message, testB(2)%Message, testB(3)%Message
end program
Here is a version to add an array of strings to a scalar output. Please note that due this constellation, the subroutine cannot be elemental. However, it can be pure:
module add_mod
implicit none
type obj_A
character(len=:), allocatable :: Message
contains
procedure, pass(objA) :: add
end type
contains
pure subroutine add( objA, text )
implicit none
class(obj_A), intent(inout) :: objA
character(len=*), dimension(:), intent(in) :: text
integer :: i
do i=1,size(text)
objA%Message=objA%Message//text(i)
enddo !i
end subroutine add
end module
program test
use add_mod
implicit none
type(obj_A) :: testA
call testA%add(['toto'])
print *, testA%Message
call testA%add( ['toto','abcc','d,ef'] )
print *, testA%Message
end program
Finally, to support both scalar and array arguments, you need to provide and bind several implementations and then use a generic interface to provide them under the same name:
module add_mod
implicit none
type obj_A
character(len=:), allocatable :: Message
contains
generic :: add => add1, add2
procedure, pass(objA) :: add1
procedure, pass(objA) :: add2
end type
contains
pure subroutine add1( objA, text )
implicit none
class(obj_A), intent(inout) :: objA
character(len=*), dimension(:), intent(in) :: text
integer :: i
do i=1,size(text)
objA%Message=objA%Message//text(i)
enddo
end subroutine add1
pure subroutine add2( objA, text )
implicit none
class(obj_A), intent(inout) :: objA
character(len=*), intent(in) :: text
objA%Message=objA%Message//text
end subroutine add2
end module
program test
use add_mod
implicit none
type(obj_A) :: testA
call testA%add('toto')
print *, testA%Message
call testA%add( ['toto','abcc','d,ef'] )
print *, testA%Message
end program