projects / people / ms / gcc.git / blame
| Commit | Line | Data |
|---|---|---|
| 3a9caf78 PT |
1 | ! { dg-do compile } |
| 2 | ! | |
| 3 | ! Fix for a regression caused by | |
| 4 | ! r13-6747-gd7caf313525a46f200d7f5db1ba893f853774aee | |
| 5 | ! | |
| 6 | ! Contributed by Juergen Reuter <juergen.reuter@desy.de> | |
| 7 | ! | |
| 8 | module resonances | |
| 9 | implicit none | |
| 10 | private | |
| 11 | ||
| 12 | type :: t1_t | |
| 13 | integer, dimension(:), allocatable :: c | |
| 14 | contains | |
| 15 | procedure, private :: t1_assign | |
| 16 | generic :: assignment(=) => t1_assign | |
| 17 | end type t1_t | |
| 18 | ||
| 19 | type :: t3_t | |
| 20 | type(t1_t), dimension(:), allocatable :: resonances | |
| 21 | integer :: n_resonances = 0 | |
| 22 | contains | |
| 23 | procedure, private :: t3_assign | |
| 24 | generic :: assignment(=) => t3_assign | |
| 25 | end type t3_t | |
| 26 | ||
| 27 | type :: resonance_branch_t | |
| 28 | integer :: i = 0 | |
| 29 | integer, dimension(:), allocatable :: r_child | |
| 30 | integer, dimension(:), allocatable :: o_child | |
| 31 | end type resonance_branch_t | |
| 32 | ||
| 33 | type :: resonance_tree_t | |
| 34 | private | |
| 35 | integer :: n = 0 | |
| 36 | type(resonance_branch_t), dimension(:), allocatable :: branch | |
| 37 | end type resonance_tree_t | |
| 38 | ||
| 39 | type :: t3_set_t | |
| 40 | private | |
| 41 | type(t3_t), dimension(:), allocatable :: history | |
| 42 | type(resonance_tree_t), dimension(:), allocatable :: tree | |
| 43 | integer :: last = 0 | |
| 44 | contains | |
| 45 | procedure, private :: expand => t3_set_expand | |
| 46 | end type t3_set_t | |
| 47 | ||
| 48 | contains | |
| 49 | ||
| 50 | pure subroutine t1_assign & | |
| 51 | (t1_out, t1_in) | |
| 52 | class(t1_t), intent(inout) :: t1_out | |
| 53 | class(t1_t), intent(in) :: t1_in | |
| 54 | if (allocated (t1_out%c)) deallocate (t1_out%c) | |
| 55 | if (allocated (t1_in%c)) then | |
| 56 | allocate (t1_out%c (size (t1_in%c))) | |
| 57 | t1_out%c = t1_in%c | |
| 58 | end if | |
| 59 | end subroutine t1_assign | |
| 60 | ||
| 61 | subroutine t3_assign (res_hist_out, res_hist_in) | |
| 62 | class(t3_t), intent(out) :: res_hist_out | |
| 63 | class(t3_t), intent(in) :: res_hist_in | |
| 64 | if (allocated (res_hist_in%resonances)) then | |
| 65 | res_hist_out%resonances = res_hist_in%resonances | |
| 66 | res_hist_out%n_resonances = res_hist_in%n_resonances | |
| 67 | end if | |
| 68 | end subroutine t3_assign | |
| 69 | ||
| 70 | subroutine t3_set_expand (res_set) | |
| 71 | class(t3_set_t), intent(inout) :: res_set | |
| 72 | type(t3_t), dimension(:), allocatable :: history_new | |
| 73 | integer :: s | |
| 74 | s = size (res_set%history) | |
| 75 | allocate (history_new (2 * s)) | |
| 76 | history_new(1:s) = res_set%history(1:s) | |
| 77 | call move_alloc (history_new, res_set%history) | |
| 78 | end subroutine t3_set_expand | |
| 79 | ||
| 80 | end module resonances |