OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [in-pack.f90] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner 
!  Check in_pack and in_unpack for integer and comlex types, with
2 
!  alignment issues thrown in for good measure.
3 
 
4 
program 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 
 
46 
end program main
47 
 
48 
subroutine 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)/)
59 
end subroutine csub4
60 
 
61 
subroutine 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)/)
72 
end subroutine csub8
73 
 
74 
subroutine 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)/)
82 
end subroutine isub4
83 
 
84 
subroutine 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)/)
92 
end subroutine isub8

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.