2 ! Take the pack intrinsic through its paces, with all types that are
7 real(kind
=4), dimension(3,3) :: r4
8 real(kind
=4), dimension(9) :: vr4
9 real(kind
=4), dimension(9) :: rr4
10 real(kind
=8), dimension(3,3) :: r8
11 real(kind
=8), dimension(9) :: vr8
12 real(kind
=8), dimension(9) :: rr8
13 complex(kind
=4), dimension(3,3) :: c4
14 complex(kind
=4), dimension(9) :: vc4
15 complex(kind
=4), dimension(9) :: rc4
16 complex(kind
=8), dimension(3,3) :: c8
17 complex(kind
=8), dimension(9) :: vc8
18 complex(kind
=8), dimension(9) :: rc8
19 integer(kind
=1), dimension(3,3) :: i1
20 integer(kind
=1), dimension(9) :: vi1
21 integer(kind
=1), dimension(9) :: ri1
22 integer(kind
=2), dimension(3,3) :: i2
23 integer(kind
=2), dimension(9) :: vi2
24 integer(kind
=2), dimension(9) :: ri2
25 integer(kind
=4), dimension(3,3) :: i4
26 integer(kind
=4), dimension(9) :: vi4
27 integer(kind
=4), dimension(9) :: ri4
28 integer(kind
=8), dimension(3,3) :: i8
29 integer(kind
=8), dimension(9) :: vi8
30 integer(kind
=8), dimension(9) :: ri8
35 type(i1_t
), dimension(3,3) :: d_i1
36 type(i1_t
), dimension(9) :: d_vi1
37 type(i1_t
), dimension(9) :: d_ri1
42 type(i4_t
), dimension(3,3) :: d_i4
43 type(i4_t
), dimension(9) :: d_vi4
44 type(i4_t
), dimension(9) :: d_ri4
46 d_vi1
%v
= (/(i
+10,i
=1,9)/)
47 d_i1
%v
= reshape((/1_1, -1_1, 2_1, -2_1, 3_1, -3_1, 4_1, &
48 & -4_1, 5_1/), shape(i1
))
49 d_ri1
= pack(d_i1
,d_i1
%v
>0,d_vi1
)
50 if (any(d_ri1
%v
/= (/1_1, 2_1, 3_1, 4_1, 5_1, 16_1, 17_1, 18_1, 19_1/))) &
53 d_vi4
%v
= (/(i
+10,i
=1,9)/)
54 d_i4
%v
= reshape((/1_4, -1_4, 2_4, -2_4, 3_4, -3_4, 4_4, &
55 & -4_4, 5_4/), shape(d_i4
))
56 d_ri4
= pack(d_i4
,d_i4
%v
>0,d_vi4
)
57 if (any(d_ri4
%v
/= (/1_4, 2_4, 3_4, 4_4, 5_4, 16_4, 17_4, 18_4, 19_4/))) &
60 vr4
= (/(i
+10,i
=1,9)/)
61 r4
= reshape((/1.0_4
, -3.0_4
, 2.1_4
, -4.21_4
, 1.2_4
, 0.98_4
, -1.2_4
, &
62 & -7.1_4
, -9.9_4
, 0.3_4
/), shape(r4
))
63 rr4
= pack(r4
,r4
>0,vr4
)
64 if (any(rr4
/= (/ 1.0_4
, 2.1_4
, 1.2_4
, 0.98_4
, 15._4
, 16._4
, 17._4
, &
65 & 18._4
, 19._4
/))) call abort
67 vr8
= (/(i
+10,i
=1,9)/)
68 r8
= reshape((/1.0_8
, -3.0_8
, 2.1_8
, -4.21_8
, 1.2_8
, 0.98_8
, -1.2_8
, &
69 & -7.1_8
, -9.9_8
, 0.3_8
/), shape(r8
))
70 rr8
= pack(r8
,r8
>0,vr8
)
71 if (any(rr8
/= (/ 1.0_8
, 2.1_8
, 1.2_8
, 0.98_8
, 15._8
, 16._8
, 17._8
, &
72 & 18._8
, 19._8
/))) call abort
74 vc4
= (/(i
+10,i
=1,9)/)
75 c4
= reshape((/1.0_4
, -3.0_4
, 2.1_4
, -4.21_4
, 1.2_4
, 0.98_4
, -1.2_4
, &
76 & -7.1_4
, -9.9_4
, 0.3_4
/), shape(c4
))
77 rc4
= pack(c4
,real(c4
)>0,vc4
)
78 if (any(real(rc4
) /= (/ 1.0_4
, 2.1_4
, 1.2_4
, 0.98_4
, 15._4
, 16._4
, 17._4
, &
79 & 18._4
, 19._4
/))) call abort
80 if (any(aimag(rc4
) /= 0)) call abort
82 vc8
= (/(i
+10,i
=1,9)/)
83 c8
= reshape((/1.0_4
, -3.0_4
, 2.1_4
, -4.21_4
, 1.2_4
, 0.98_4
, -1.2_4
, &
84 & -7.1_4
, -9.9_4
, 0.3_4
/), shape(c8
))
85 rc8
= pack(c8
,real(c8
)>0,vc8
)
86 if (any(real(rc8
) /= (/ 1.0_4
, 2.1_4
, 1.2_4
, 0.98_4
, 15._4
, 16._4
, 17._4
, &
87 & 18._4
, 19._4
/))) call abort
88 if (any(aimag(rc8
) /= 0)) call abort
90 vi1
= (/(i
+10,i
=1,9)/)
91 i1
= reshape((/1_1, -1_1, 2_1, -2_1, 3_1, -3_1, 4_1, -4_1, 5_1/), shape(i1
))
92 ri1
= pack(i1
,i1
>0,vi1
)
93 if (any(ri1
/= (/1_1, 2_1, 3_1, 4_1, 5_1, 16_1, 17_1, 18_1, 19_1/))) &
96 vi2
= (/(i
+10,i
=1,9)/)
97 i2
= reshape((/1_2, -1_2, 2_2, -2_2, 3_2, -3_2, 4_2, -4_2, 5_2/), shape(i2
))
98 ri2
= pack(i2
,i2
>0,vi2
)
99 if (any(ri2
/= (/1_2, 2_2, 3_2, 4_2, 5_2, 16_2, 17_2, 18_2, 19_2/))) &
102 vi4
= (/(i
+10,i
=1,9)/)
103 i4
= reshape((/1_4, -1_4, 2_4, -2_4, 3_4, -3_4, 4_4, -4_4, 5_4/), shape(i4
))
104 ri4
= pack(i4
,i4
>0,vi4
)
105 if (any(ri4
/= (/1_4, 2_4, 3_4, 4_4, 5_4, 16_4, 17_4, 18_4, 19_4/))) &
108 vi8
= (/(i
+10,i
=1,9)/)
109 i8
= reshape((/1_8, -1_8, 2_8, -2_8, 3_8, -3_8, 4_8, -4_8, 5_8/), shape(i8
))
110 ri8
= pack(i8
,i8
>0,vi8
)
111 if (any(ri8
/= (/1_8, 2_8, 3_8, 4_8, 5_8, 16_8, 17_8, 18_8, 19_8/))) &