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
75
76
77
78
79
80
81
82
83
84
85
86
|
! { dg-do compile }
! Test the fix for PR43843, in which the temporary for b(1) in
! test_member was an indirect reference, rather then the value.
!
! Contributed by Kyle Horne <horne.kyle@gmail.com>
! Reported by Tobias Burnus <burnus@gcc.gno.org>
! Reported by Harald Anlauf <anlauf@gmx.de> (PR43841)
!
module polar_mod
implicit none
complex, parameter :: i = (0.0,1.0)
real, parameter :: pi = 3.14159265359
real, parameter :: e = exp (1.0)
type :: polar_t
real :: l, th
end type
type(polar_t) :: one = polar_t (1.0, 0)
interface operator(/)
module procedure div_pp
end interface
interface operator(.ne.)
module procedure ne_pp
end interface
contains
elemental function div_pp(u,v) result(o)
type(polar_t), intent(in) :: u, v
type(polar_t) :: o
complex :: a, b, c
a = u%l*exp (i*u%th*pi)
b = v%l*exp (i*v%th*pi)
c = a/b
o%l = abs (c)
o%th = atan2 (imag (c), real (c))/pi
end function div_pp
elemental function ne_pp(u,v) result(o)
type(polar_t), intent(in) :: u, v
LOGICAL :: o
if (u%l .ne. v%l) then
o = .true.
else if (u%th .ne. v%th) then
o = .true.
else
o = .false.
end if
end function ne_pp
end module polar_mod
program main
use polar_mod
implicit none
call test_member
call test_other
call test_scalar
call test_real
contains
subroutine test_member
type(polar_t), dimension(3) :: b
b = polar_t (2.0,0.5)
b(:) = b(:)/b(1)
if (any (b .ne. one)) call abort
end subroutine test_member
subroutine test_other
type(polar_t), dimension(3) :: b
type(polar_t), dimension(3) :: c
b = polar_t (3.0,1.0)
c = polar_t (3.0,1.0)
b(:) = b(:)/c(1)
if (any (b .ne. one)) call abort
end subroutine test_other
subroutine test_scalar
type(polar_t), dimension(3) :: b
type(polar_t) :: c
b = polar_t (4.0,1.5)
c = b(1)
b(:) = b(:)/c
if (any (b .ne. one)) call abort
end subroutine test_scalar
subroutine test_real
real,dimension(3) :: b
real :: real_one
b = 2.0
real_one = b(2)/b(1)
b(:) = b(:)/b(1)
if (any (b .ne. real_one)) call abort
end subroutine test_real
end program main
|
