! Check in_pack and in_unpack for integer and comlex types, with
|
! Check in_pack and in_unpack for integer and comlex types, with
|
! alignment issues thrown in for good measure.
|
! alignment issues thrown in for good measure.
|
|
|
program main
|
program main
|
implicit none
|
implicit none
|
|
|
complex(kind=4) :: a4(5),b4(5),aa4(5),bb4(5)
|
complex(kind=4) :: a4(5),b4(5),aa4(5),bb4(5)
|
real(kind=4) :: r4(100)
|
real(kind=4) :: r4(100)
|
equivalence(a4(1),r4(1)),(b4(1),r4(12))
|
equivalence(a4(1),r4(1)),(b4(1),r4(12))
|
|
|
complex(kind=8) :: a8(5),b8(5),aa8(5),bb8(5)
|
complex(kind=8) :: a8(5),b8(5),aa8(5),bb8(5)
|
real(kind=8) :: r8(100)
|
real(kind=8) :: r8(100)
|
equivalence(a8(1),r8(1)),(b8(1),r8(12))
|
equivalence(a8(1),r8(1)),(b8(1),r8(12))
|
|
|
integer(kind=4) :: i4(5),ii4(5)
|
integer(kind=4) :: i4(5),ii4(5)
|
integer(kind=8) :: i8(5),ii8(5)
|
integer(kind=8) :: i8(5),ii8(5)
|
|
|
integer :: i
|
integer :: i
|
|
|
a4 = (/(cmplx(i,-i,kind=4),i=1,5)/)
|
a4 = (/(cmplx(i,-i,kind=4),i=1,5)/)
|
b4 = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
|
b4 = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
|
call csub4(a4(5:1:-1),b4(5:1:-1),5)
|
call csub4(a4(5:1:-1),b4(5:1:-1),5)
|
aa4 = (/(cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
|
aa4 = (/(cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
|
if (any(aa4 /= a4)) call abort
|
if (any(aa4 /= a4)) call abort
|
bb4 = (/(2*cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
|
bb4 = (/(2*cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
|
if (any(bb4 /= b4)) call abort
|
if (any(bb4 /= b4)) call abort
|
|
|
a8 = (/(cmplx(i,-i,kind=8),i=1,5)/)
|
a8 = (/(cmplx(i,-i,kind=8),i=1,5)/)
|
b8 = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
|
b8 = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
|
call csub8(a8(5:1:-1),b8(5:1:-1),5)
|
call csub8(a8(5:1:-1),b8(5:1:-1),5)
|
aa8 = (/(cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
|
aa8 = (/(cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
|
if (any(aa8 /= a8)) call abort
|
if (any(aa8 /= a8)) call abort
|
bb8 = (/(2*cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
|
bb8 = (/(2*cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
|
if (any(bb8 /= b8)) call abort
|
if (any(bb8 /= b8)) call abort
|
|
|
i4 = (/(i, i=1,5)/)
|
i4 = (/(i, i=1,5)/)
|
call isub4(i4(5:1:-1),5)
|
call isub4(i4(5:1:-1),5)
|
ii4 = (/(5-i+1,i=1,5)/)
|
ii4 = (/(5-i+1,i=1,5)/)
|
if (any(ii4 /= i4)) call abort
|
if (any(ii4 /= i4)) call abort
|
|
|
i8 = (/(i,i=1,5)/)
|
i8 = (/(i,i=1,5)/)
|
call isub8(i8(5:1:-1),5)
|
call isub8(i8(5:1:-1),5)
|
ii8 = (/(5-i+1,i=1,5)/)
|
ii8 = (/(5-i+1,i=1,5)/)
|
if (any(ii8 /= i8)) call abort
|
if (any(ii8 /= i8)) call abort
|
|
|
end program main
|
end program main
|
|
|
subroutine csub4(a,b,n)
|
subroutine csub4(a,b,n)
|
implicit none
|
implicit none
|
complex(kind=4), dimension(n) :: a,b
|
complex(kind=4), dimension(n) :: a,b
|
complex(kind=4), dimension(n) :: aa, bb
|
complex(kind=4), dimension(n) :: aa, bb
|
integer :: n, i
|
integer :: n, i
|
aa = (/(cmplx(n-i+1,i-n-1,kind=4),i=1,n)/)
|
aa = (/(cmplx(n-i+1,i-n-1,kind=4),i=1,n)/)
|
if (any(aa /= a)) call abort
|
if (any(aa /= a)) call abort
|
bb = (/(2*cmplx(n-i+1,i-n-1,kind=4),i=1,5)/)
|
bb = (/(2*cmplx(n-i+1,i-n-1,kind=4),i=1,5)/)
|
if (any(bb /= b)) call abort
|
if (any(bb /= b)) call abort
|
a = (/(cmplx(i,-i,kind=4),i=1,5)/)
|
a = (/(cmplx(i,-i,kind=4),i=1,5)/)
|
b = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
|
b = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
|
end subroutine csub4
|
end subroutine csub4
|
|
|
subroutine csub8(a,b,n)
|
subroutine csub8(a,b,n)
|
implicit none
|
implicit none
|
complex(kind=8), dimension(n) :: a,b
|
complex(kind=8), dimension(n) :: a,b
|
complex(kind=8), dimension(n) :: aa, bb
|
complex(kind=8), dimension(n) :: aa, bb
|
integer :: n, i
|
integer :: n, i
|
aa = (/(cmplx(n-i+1,i-n-1,kind=8),i=1,n)/)
|
aa = (/(cmplx(n-i+1,i-n-1,kind=8),i=1,n)/)
|
if (any(aa /= a)) call abort
|
if (any(aa /= a)) call abort
|
bb = (/(2*cmplx(n-i+1,i-n-1,kind=8),i=1,5)/)
|
bb = (/(2*cmplx(n-i+1,i-n-1,kind=8),i=1,5)/)
|
if (any(bb /= b)) call abort
|
if (any(bb /= b)) call abort
|
a = (/(cmplx(i,-i,kind=8),i=1,5)/)
|
a = (/(cmplx(i,-i,kind=8),i=1,5)/)
|
b = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
|
b = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
|
end subroutine csub8
|
end subroutine csub8
|
|
|
subroutine isub4(a,n)
|
subroutine isub4(a,n)
|
implicit none
|
implicit none
|
integer(kind=4), dimension(n) :: a
|
integer(kind=4), dimension(n) :: a
|
integer(kind=4), dimension(n) :: aa
|
integer(kind=4), dimension(n) :: aa
|
integer :: n, i
|
integer :: n, i
|
aa = (/(n-i+1,i=1,n)/)
|
aa = (/(n-i+1,i=1,n)/)
|
if (any(aa /= a)) call abort
|
if (any(aa /= a)) call abort
|
a = (/(i,i=1,5)/)
|
a = (/(i,i=1,5)/)
|
end subroutine isub4
|
end subroutine isub4
|
|
|
subroutine isub8(a,n)
|
subroutine isub8(a,n)
|
implicit none
|
implicit none
|
integer(kind=8), dimension(n) :: a
|
integer(kind=8), dimension(n) :: a
|
integer(kind=8), dimension(n) :: aa
|
integer(kind=8), dimension(n) :: aa
|
integer :: n, i
|
integer :: n, i
|
aa = (/(n-i+1,i=1,n)/)
|
aa = (/(n-i+1,i=1,n)/)
|
if (any(aa /= a)) call abort
|
if (any(aa /= a)) call abort
|
a = (/(i,i=1,5)/)
|
a = (/(i,i=1,5)/)
|
end subroutine isub8
|
end subroutine isub8
|
|
|