1!  Check in_pack and in_unpack for integer and comlex types, with
2!  alignment issues thrown in for good measure.
3
4program main
5  implicit none
6
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))
10
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))
14
15  integer(kind=4) :: i4(5),ii4(5)
16  integer(kind=8) :: i8(5),ii8(5)
17
18  integer :: i
19
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)) call abort
25  bb4 = (/(2*cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
26  if (any(bb4 /= b4)) call abort
27
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)) call abort
33  bb8 = (/(2*cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
34  if (any(bb8 /= b8)) call abort
35
36  i4 = (/(i, i=1,5)/)
37  call isub4(i4(5:1:-1),5)
38  ii4 = (/(5-i+1,i=1,5)/)
39  if (any(ii4 /= i4)) call abort
40
41  i8 = (/(i,i=1,5)/)
42  call isub8(i8(5:1:-1),5)
43  ii8 = (/(5-i+1,i=1,5)/)
44  if (any(ii8 /= i8)) call abort
45
46end program main
47
48subroutine csub4(a,b,n)
49  implicit none
50  complex(kind=4), dimension(n) :: a,b
51  complex(kind=4), dimension(n) :: aa, bb
52  integer :: n, i
53  aa = (/(cmplx(n-i+1,i-n-1,kind=4),i=1,n)/)
54  if (any(aa /= a)) call abort
55  bb = (/(2*cmplx(n-i+1,i-n-1,kind=4),i=1,5)/)
56  if (any(bb /= b)) call abort
57  a = (/(cmplx(i,-i,kind=4),i=1,5)/)
58  b = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
59end subroutine csub4
60
61subroutine csub8(a,b,n)
62  implicit none
63  complex(kind=8), dimension(n) :: a,b
64  complex(kind=8), dimension(n) :: aa, bb
65  integer :: n, i
66  aa = (/(cmplx(n-i+1,i-n-1,kind=8),i=1,n)/)
67  if (any(aa /= a)) call abort
68  bb = (/(2*cmplx(n-i+1,i-n-1,kind=8),i=1,5)/)
69  if (any(bb /= b)) call abort
70  a = (/(cmplx(i,-i,kind=8),i=1,5)/)
71  b = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
72end subroutine csub8
73
74subroutine isub4(a,n)
75  implicit none
76  integer(kind=4), dimension(n) :: a
77  integer(kind=4), dimension(n) :: aa
78  integer :: n, i
79  aa = (/(n-i+1,i=1,n)/)
80  if (any(aa /= a)) call abort
81  a = (/(i,i=1,5)/)
82end subroutine isub4
83
84subroutine isub8(a,n)
85  implicit none
86  integer(kind=8), dimension(n) :: a
87  integer(kind=8), dimension(n) :: aa
88  integer :: n, i
89  aa = (/(n-i+1,i=1,n)/)
90  if (any(aa /= a)) call abort
91  a = (/(i,i=1,5)/)
92end subroutine isub8
93