1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
! This is an example for derived types defined by users
module MyBase_mod
public :: MyBase
type,abstract:: MyBase
real :: r
contains
procedure(equal_),deferred :: equal
generic :: operator(==) => equal
end type MyBase
abstract interface
logical function equal_(m1,m2) result(l)
import MyBase
class(MyBase),intent(in) :: m1
class(MyBase),intent(in) :: m2
end function equal_
end interface
end module MyBase_mod
module MyType_mod
use MyBase_mod
type,extends(MyBase) :: MyType
contains
procedure :: equal
end type
interface MyType
module procedure newMyType
end interface
contains
function newMyType(r) result(m)
real,intent(in) :: r
type(MyType) :: m
m%r = r
end function
logical function equal(m1,m2) result(l)
class(MyType),intent(in) :: m1
class(MyBase),intent(in) :: m2
l = (abs(m1%r- m2%r) <= 1.0e-7)
end function equal
end module MyType_mod
module VecMyPolyPtr_mod
use MyBase_mod
#define _type class(MyBase)
#define _allocatable
#define _pointer
#define _equal_defined
#include "templates/vector.inc"
end Module
program main
use MyType_mod
use VecMyPolyPtr_mod
implicit none
type(MyType) ,target :: mt
class(MyBase) ,pointer :: mp
type(Vector) :: mv
mt= myType(1.0d0)
mp=>mt
call mv%push_back(mp)
end program main
|
