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)) STOP 1 25 bb4 = (/(2*cmplx(5-i+1,i-5-1,kind=4),i=1,5)/) 26 if (any(bb4 /= b4)) STOP 2 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)) STOP 3 33 bb8 = (/(2*cmplx(5-i+1,i-5-1,kind=8),i=1,5)/) 34 if (any(bb8 /= b8)) STOP 4 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)) STOP 5 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)) STOP 6 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)) 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)/) 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)) 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)/) 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)) STOP 11 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)) STOP 12 91 a = (/(i,i=1,5)/) 92end subroutine isub8 93