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
|
module Complex_module
implicit none
type :: ComplexType
real :: r
real :: i
contains
procedure :: integer_add_subrout
procedure :: real_add_subrout
generic :: add => integer_add_subrout, real_add_subrout
end type
contains
subroutine integer_add_subrout(this, r, i, sum)
class(ComplexType), intent(in) :: this
integer, intent(in) :: r, i
type(ComplexType), intent(out) :: sum
print *, "Calling integer_add_subrout"
sum%r = this%r + r
sum%i = this%i + i
end subroutine
subroutine real_add_subrout(this, r, i, sum)
class(ComplexType), intent(in) :: this
real, intent(in) :: r, i
type(ComplexType), intent(out) :: sum
print *, "Calling real_add_subrout"
sum%r = this%r + r
sum%i = this%i + i
end subroutine
end module
program generic_name_01
use Complex_module, only: ComplexType
implicit none
real :: fpone, fptwo, fpzero, negfpone
integer :: ione, izero
type(ComplexType) :: a, c
fpone = 1.0
fptwo = 2.0
fpzero = 0.0
ione = 1
izero = 0
negfpone = -1.0
c = ComplexType(fpone, fptwo)
call c%add(ione, izero, a)
print *, a%r, a%i
if( a%r /= 2.0 ) error stop
if( a%i /= 2.0 ) error stop
call c%add(fpzero, negfpone, a)
print *, a%r, a%i
if( a%r /= 1.0 ) error stop
if( a%i /= 1.0 ) error stop
end program
|
