3 ! Contributed by Juergen Reuter
4 ! Check that pr65548 is fixed.
9 integer, dimension(:), allocatable
:: map
10 real, dimension(:), allocatable
:: weight
12 procedure
:: init
=> selector_init
17 subroutine selector_init (selector
, weight
)
18 class(selector_t
), intent(out
) :: selector
19 real, dimension(:), intent(in
) :: weight
22 logical, dimension(:), allocatable
:: mask
24 allocate (mask (size (weight
)), source
= weight
/= 0)
27 allocate (selector
%map (n
), &
28 source
= pack ([(i
, i
= 1, size (weight
))], mask
))
29 allocate (selector
%weight (n
), &
30 source
= pack (weight
/ s
, mask
))
32 allocate (selector
%map (1), source
= 1)
33 allocate (selector
%weight (1), source
= 0.)
35 end subroutine selector_init
42 procedure
:: get_mass
=> flavor_get_mass
47 type(flavor_t
), dimension(:,:), allocatable
:: flv
51 class(phs_config_t
), pointer :: config
=> null ()
52 real, dimension(:), allocatable
:: m_in
57 elemental
function flavor_get_mass (flv
) result (mass
)
59 class(flavor_t
), intent(in
) :: flv
61 end function flavor_get_mass
63 subroutine phs_base_init (phs
, phs_config
)
64 class(phs_t
), intent(out
) :: phs
65 class(phs_config_t
), intent(in
), target
:: phs_config
66 phs
%config
=> phs_config
67 allocate (phs
%m_in (phs
%config
%n_in
), &
68 source
= phs_config
%flv(:phs_config
%n_in
, 1)%get_mass ())
69 end subroutine phs_base_init
76 real, dimension(:,:), allocatable
:: val
78 procedure
:: make
=> t_make
79 generic
:: get_int
=> get_int_array
, get_int_element
80 procedure
:: get_int_array
=> t_get_int_array
81 procedure
:: get_int_element
=> t_get_int_element
86 subroutine t_make (this
)
87 class(t
), intent(inout
) :: this
88 real, dimension(:), allocatable
:: int
89 allocate (int (0:this
%n
-1), source
=this
%get_int())
92 pure
function t_get_int_array (this
) result (array
)
93 class(t
), intent(in
) :: this
94 real, dimension(this
%n
) :: array
95 array
= this
%val (0:this
%n
-1, 4)
96 end function t_get_int_array
98 pure
function t_get_int_element (this
, set
) result (element
)
99 class(t
), intent(in
) :: this
100 integer, intent(in
) :: set
102 element
= this
%val (set
, 4)
103 end function t_get_int_element
108 character(32), dimension(:), allocatable
:: md5
110 procedure
:: init
=> t2_init
115 subroutine t2_init (this
)
116 class(t2
), intent(inout
) :: this
117 character(32), dimension(:), allocatable
:: md5
118 allocate (md5 (this
%n
), source
=this
%md5
)
119 if (md5(1) /= "tst ") STOP 1
120 if (md5(2) /= " ") STOP 2
121 if (md5(3) /= "fooblabar ") STOP 3
122 end subroutine t2_init
131 type(selector_t
) :: sel
133 type(phs_config_t
) :: phs_config
137 call sel
%init([2., 0., 3., 0., 4.])
139 if (any(sel
%map /= [1, 3, 5])) STOP 4
140 if (any(abs(sel
%weight
- [2., 3., 4.] / 9.) > 1E-6)) STOP 5
143 allocate (phs_config
%flv (phs_config
%n_in
, 1))
144 call phs_base_init (phs
, phs_config
)
146 if (any(abs(phs
%m_in
- [42.0, 42.0]) > 1E-6)) STOP 6
149 allocate (o
%val(0:1,4))
153 allocate(o2
%md5(o2
%n
))
156 o2
%md5(3) = "fooblabar"