1 ! Check in_pack and in_unpack for integer and comlex types, with
2 ! alignment issues thrown in for good measure.
7 complex(kind
=4) :: a4(5),b4(5),aa4(5),bb4(5)
8 real(kind
=4) :: r4(100)
9 equivalence(a4(1),r4(1)),(b4(1),r4(12))
11 complex(kind
=8) :: a8(5),b8(5),aa8(5),bb8(5)
12 real(kind
=8) :: r8(100)
13 equivalence(a8(1),r8(1)),(b8(1),r8(12))
15 integer(kind
=4) :: i4(5),ii4(5)
16 integer(kind
=8) :: i8(5),ii8(5)
20 a4
= (/(cmplx(i
,-i
,kind
=4),i
=1,5)/)
21 b4
= (/(2*cmplx(i
,-i
,kind
=4),i
=1,5)/)
22 call csub4(a4(5:1:-1),b4(5:1:-1),5)
23 aa4
= (/(cmplx(5-i
+1,i
-5-1,kind
=4),i
=1,5)/)
24 if (any(aa4
/= a4
)) STOP 1
25 bb4
= (/(2*cmplx(5-i
+1,i
-5-1,kind
=4),i
=1,5)/)
26 if (any(bb4
/= b4
)) STOP 2
28 a8
= (/(cmplx(i
,-i
,kind
=8),i
=1,5)/)
29 b8
= (/(2*cmplx(i
,-i
,kind
=8),i
=1,5)/)
30 call csub8(a8(5:1:-1),b8(5:1:-1),5)
31 aa8
= (/(cmplx(5-i
+1,i
-5-1,kind
=8),i
=1,5)/)
32 if (any(aa8
/= a8
)) STOP 3
33 bb8
= (/(2*cmplx(5-i
+1,i
-5-1,kind
=8),i
=1,5)/)
34 if (any(bb8
/= b8
)) STOP 4
37 call isub4(i4(5:1:-1),5)
38 ii4
= (/(5-i
+1,i
=1,5)/)
39 if (any(ii4
/= i4
)) STOP 5
42 call isub8(i8(5:1:-1),5)
43 ii8
= (/(5-i
+1,i
=1,5)/)
44 if (any(ii8
/= i8
)) STOP 6
48 subroutine csub4(a
,b
,n
)
50 complex(kind
=4), dimension(n
) :: a
,b
51 complex(kind
=4), dimension(n
) :: aa
, bb
53 aa
= (/(cmplx(n
-i
+1,i
-n
-1,kind
=4),i
=1,n
)/)
54 if (any(aa
/= a
)) STOP 7
55 bb
= (/(2*cmplx(n
-i
+1,i
-n
-1,kind
=4),i
=1,5)/)
56 if (any(bb
/= b
)) STOP 8
57 a
= (/(cmplx(i
,-i
,kind
=4),i
=1,5)/)
58 b
= (/(2*cmplx(i
,-i
,kind
=4),i
=1,5)/)
61 subroutine csub8(a
,b
,n
)
63 complex(kind
=8), dimension(n
) :: a
,b
64 complex(kind
=8), dimension(n
) :: aa
, bb
66 aa
= (/(cmplx(n
-i
+1,i
-n
-1,kind
=8),i
=1,n
)/)
67 if (any(aa
/= a
)) STOP 9
68 bb
= (/(2*cmplx(n
-i
+1,i
-n
-1,kind
=8),i
=1,5)/)
69 if (any(bb
/= b
)) STOP 10
70 a
= (/(cmplx(i
,-i
,kind
=8),i
=1,5)/)
71 b
= (/(2*cmplx(i
,-i
,kind
=8),i
=1,5)/)
76 integer(kind
=4), dimension(n
) :: a
77 integer(kind
=4), dimension(n
) :: aa
79 aa
= (/(n
-i
+1,i
=1,n
)/)
80 if (any(aa
/= a
)) STOP 11
86 integer(kind
=8), dimension(n
) :: a
87 integer(kind
=8), dimension(n
) :: aa
89 aa
= (/(n
-i
+1,i
=1,n
)/)
90 if (any(aa
/= a
)) STOP 12