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
|
! { dg-do compile }
!
! Fix for a regression caused by
! r13-6747-gd7caf313525a46f200d7f5db1ba893f853774aee
!
! Contributed by Juergen Reuter <juergen.reuter@desy.de>
!
module resonances
implicit none
private
type :: t1_t
integer, dimension(:), allocatable :: c
contains
procedure, private :: t1_assign
generic :: assignment(=) => t1_assign
end type t1_t
type :: t3_t
type(t1_t), dimension(:), allocatable :: resonances
integer :: n_resonances = 0
contains
procedure, private :: t3_assign
generic :: assignment(=) => t3_assign
end type t3_t
type :: resonance_branch_t
integer :: i = 0
integer, dimension(:), allocatable :: r_child
integer, dimension(:), allocatable :: o_child
end type resonance_branch_t
type :: resonance_tree_t
private
integer :: n = 0
type(resonance_branch_t), dimension(:), allocatable :: branch
end type resonance_tree_t
type :: t3_set_t
private
type(t3_t), dimension(:), allocatable :: history
type(resonance_tree_t), dimension(:), allocatable :: tree
integer :: last = 0
contains
procedure, private :: expand => t3_set_expand
end type t3_set_t
contains
pure subroutine t1_assign &
(t1_out, t1_in)
class(t1_t), intent(inout) :: t1_out
class(t1_t), intent(in) :: t1_in
if (allocated (t1_out%c)) deallocate (t1_out%c)
if (allocated (t1_in%c)) then
allocate (t1_out%c (size (t1_in%c)))
t1_out%c = t1_in%c
end if
end subroutine t1_assign
subroutine t3_assign (res_hist_out, res_hist_in)
class(t3_t), intent(out) :: res_hist_out
class(t3_t), intent(in) :: res_hist_in
if (allocated (res_hist_in%resonances)) then
res_hist_out%resonances = res_hist_in%resonances
res_hist_out%n_resonances = res_hist_in%n_resonances
end if
end subroutine t3_assign
subroutine t3_set_expand (res_set)
class(t3_set_t), intent(inout) :: res_set
type(t3_t), dimension(:), allocatable :: history_new
integer :: s
s = size (res_set%history)
allocate (history_new (2 * s))
history_new(1:s) = res_set%history(1:s)
call move_alloc (history_new, res_set%history)
end subroutine t3_set_expand
end module resonances
|
