2 ! Transformational functions for zero-sized array and array sections
3 ! Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
6 real :: tempn(1), tempm(1,2)
7 real,allocatable
:: foo(:),bar(:,:),gee(:,:)
10 allocate(foo(0),bar(2,0),gee(0,7))
11 if (any(cshift(foo
,dim
=1,shift
=1)/= 0)) call abort
12 if (any(cshift(tempn(2:1),dim
=1,shift
=1)/= 0)) call abort
13 if (any(cshift(bar
,shift
=(/1,-1/),dim
=1)/= 0)) call abort
14 if (any(cshift(bar
,shift
=(/1,-1/),dim
=2)/= 0)) call abort
15 if (any(cshift(gee
,shift
=(/1,-1/),dim
=1)/= 0)) call abort
16 if (any(cshift(gee
,shift
=(/1,-1/),dim
=2)/= 0)) call abort
17 if (any(cshift(tempm(5:4,:),shift
=(/1,-1/),dim
=1)/= 0)) call abort
18 if (any(cshift(tempm(5:4,:),shift
=(/1,-1/),dim
=2)/= 0)) call abort
19 if (any(cshift(tempm(:,5:4),shift
=(/1,-1/),dim
=1)/= 0)) call abort
20 if (any(cshift(tempm(:,5:4),shift
=(/1,-1/),dim
=2)/= 0)) call abort
21 deallocate(foo
,bar
,gee
)
24 subroutine test_eoshift
25 real :: tempn(1), tempm(1,2)
26 real,allocatable
:: foo(:),bar(:,:),gee(:,:)
29 allocate(foo(0),bar(2,0),gee(0,7))
30 if (any(eoshift(foo
,dim
=1,shift
=1)/= 0)) call abort
31 if (any(eoshift(tempn(2:1),dim
=1,shift
=1)/= 0)) call abort
32 if (any(eoshift(bar
,shift
=(/1,-1/),dim
=1)/= 0)) call abort
33 if (any(eoshift(bar
,shift
=(/1,-1/),dim
=2)/= 0)) call abort
34 if (any(eoshift(gee
,shift
=(/1,-1/),dim
=1)/= 0)) call abort
35 if (any(eoshift(gee
,shift
=(/1,-1/),dim
=2)/= 0)) call abort
36 if (any(eoshift(tempm(5:4,:),shift
=(/1,-1/),dim
=1)/= 0)) call abort
37 if (any(eoshift(tempm(5:4,:),shift
=(/1,-1/),dim
=2)/= 0)) call abort
38 if (any(eoshift(tempm(:,5:4),shift
=(/1,-1/),dim
=1)/= 0)) call abort
39 if (any(eoshift(tempm(:,5:4),shift
=(/1,-1/),dim
=2)/= 0)) call abort
41 if (any(eoshift(foo
,dim
=1,shift
=1,boundary
=42.0)/= 0)) call abort
42 if (any(eoshift(tempn(2:1),dim
=1,shift
=1,boundary
=42.0)/= 0)) call abort
43 if (any(eoshift(bar
,shift
=(/1,-1/),dim
=1,boundary
=42.0)/= 0)) call abort
44 if (any(eoshift(bar
,shift
=(/1,-1/),dim
=2,boundary
=42.0)/= 0)) call abort
45 if (any(eoshift(gee
,shift
=(/1,-1/),dim
=1,boundary
=42.0)/= 0)) call abort
46 if (any(eoshift(gee
,shift
=(/1,-1/),dim
=2,boundary
=42.0)/= 0)) call abort
47 if (any(eoshift(tempm(5:4,:),shift
=(/1,-1/),dim
=1,boundary
=42.0)/= 0)) call abort
48 if (any(eoshift(tempm(5:4,:),shift
=(/1,-1/),dim
=2,boundary
=42.0)/= 0)) call abort
49 if (any(eoshift(tempm(:,5:4),shift
=(/1,-1/),dim
=1,boundary
=42.0)/= 0)) call abort
50 if (any(eoshift(tempm(:,5:4),shift
=(/1,-1/),dim
=2,boundary
=42.0)/= 0)) call abort
52 if (any(eoshift(foo
,dim
=1,shift
=1,boundary
=(/42.0,-7.0/))/= 0)) call abort
53 if (any(eoshift(tempn(2:1),dim
=1,shift
=1,boundary
=(/42.0,-7.0/))/= 0)) call abort
54 if (any(eoshift(bar
,shift
=(/1,-1/),dim
=1,boundary
=(/42.0,-7.0/))/= 0)) call abort
55 if (any(eoshift(bar
,shift
=(/1,-1/),dim
=2,boundary
=(/42.0,-7.0/))/= 0)) call abort
56 if (any(eoshift(gee
,shift
=(/1,-1/),dim
=1,boundary
=(/42.0,-7.0/))/= 0)) call abort
57 if (any(eoshift(gee
,shift
=(/1,-1/),dim
=2,boundary
=(/42.0,-7.0/))/= 0)) call abort
58 if (any(eoshift(tempm(5:4,:),shift
=(/1,-1/),dim
=1,boundary
=(/42.0,-7.0/))/= 0)) call abort
59 if (any(eoshift(tempm(5:4,:),shift
=(/1,-1/),dim
=2,boundary
=(/42.0,-7.0/))/= 0)) call abort
60 if (any(eoshift(tempm(:,5:4),shift
=(/1,-1/),dim
=1,boundary
=(/42.0,-7.0/))/= 0)) call abort
61 if (any(eoshift(tempm(:,5:4),shift
=(/1,-1/),dim
=2,boundary
=(/42.0,-7.0/))/= 0)) call abort
62 deallocate(foo
,bar
,gee
)
65 subroutine test_transpose
66 character(len
=1) :: tempn(1,2)
67 character(len
=1),allocatable
:: foo(:,:), bar(:,:)
69 integer,allocatable
:: x(:,:), y(:,:)
71 allocate(foo(3,0),bar(-2:-4,7:9))
73 allocate(x(3,0),y(-2:-4,7:9))
74 if (any(transpose(tempn(-7:-8,:)) /= 'b')) call abort
75 if (any(transpose(tempn(:,9:8)) /= 'b')) call abort
76 if (any(transpose(foo
) /= 'b')) call abort
77 if (any(transpose(bar
) /= 'b')) call abort
78 if (any(transpose(tempm(-7:-8,:)) /= 0)) call abort
79 if (any(transpose(tempm(:,9:8)) /= 0)) call abort
80 if (any(transpose(x
) /= 0)) call abort
81 if (any(transpose(y
) /= 0)) call abort
82 deallocate(foo
,bar
,x
,y
)
85 subroutine test_reshape
86 character(len
=1) :: tempn(1,2)
87 character(len
=1),allocatable
:: foo(:,:), bar(:,:)
89 integer,allocatable
:: x(:,:), y(:,:)
92 allocate(foo(3,0),bar(-2:-4,7:9),x(3,0),y(-2:-4,7:9))
94 if (size(reshape(tempn(-7:-8,:),(/3,3/),pad
=(/'a'/))) /= 9 .or
. &
95 any(reshape(tempn(-7:-8,:),(/3,3/),pad
=(/'a'/)) /= 'a')) call abort
96 if (size(reshape(tempn(-7:-8,:),(/3,3,3/),pad
=(/'a'/))) /= 27 .or
. &
97 any(reshape(tempn(-7:-8,:),(/3,3,3/),pad
=(/'a'/)) /= 'a')) call abort
98 if (size(reshape(tempn(-7:-8,:),(/3,3,3,3,3,3,3/),pad
=(/'a'/))) /= 2187 .or
. &
99 any(reshape(tempn(-7:-8,:),(/3,3,3,3,3,3,3/),pad
=(/'a'/)) /= 'a')) call abort
100 if (size(reshape(foo
,(/3,3/),pad
=(/'a'/))) /= 9 .or
. &
101 any(reshape(foo
,(/3,3/),pad
=(/'a'/)) /= 'a')) call abort
102 if (size(reshape(foo
,(/3,3,3/),pad
=(/'a'/))) /= 27 .or
. &
103 any(reshape(foo
,(/3,3,3/),pad
=(/'a'/)) /= 'a')) call abort
104 if (size(reshape(foo
,(/3,3,3,3,3,3,3/),pad
=(/'a'/))) /= 2187 .or
. &
105 any(reshape(foo
,(/3,3,3,3,3,3,3/),pad
=(/'a'/)) /= 'a')) call abort
106 if (size(reshape(bar
,(/3,3/),pad
=(/'a'/))) /= 9 .or
. &
107 any(reshape(bar
,(/3,3/),pad
=(/'a'/)) /= 'a')) call abort
108 if (size(reshape(bar
,(/3,3,3/),pad
=(/'a'/))) /= 27 .or
. &
109 any(reshape(bar
,(/3,3,3/),pad
=(/'a'/)) /= 'a')) call abort
110 if (size(reshape(bar
,(/3,3,3,3,3,3,3/),pad
=(/'a'/))) /= 2187 .or
. &
111 any(reshape(bar
,(/3,3,3,3,3,3,3/),pad
=(/'a'/)) /= 'a')) call abort
113 if (size(reshape(tempm(-7:-8,:),(/3,3/),pad
=(/7/))) /= 9 .or
. &
114 any(reshape(tempm(-7:-8,:),(/3,3/),pad
=(/7/)) /= 7)) call abort
115 if (size(reshape(tempm(-7:-8,:),(/3,3,3/),pad
=(/7/))) /= 27 .or
. &
116 any(reshape(tempm(-7:-8,:),(/3,3,3/),pad
=(/7/)) /= 7)) call abort
117 if (size(reshape(tempm(-7:-8,:),(/3,3,3,3,3,3,3/),pad
=(/7/))) /= 2187 .or
. &
118 any(reshape(tempm(-7:-8,:),(/3,3,3,3,3,3,3/),pad
=(/7/)) /= 7)) call abort
119 if (size(reshape(x
,(/3,3/),pad
=(/7/))) /= 9 .or
. &
120 any(reshape(x
,(/3,3/),pad
=(/7/)) /= 7)) call abort
121 if (size(reshape(x
,(/3,3,3/),pad
=(/7/))) /= 27 .or
. &
122 any(reshape(x
,(/3,3,3/),pad
=(/7/)) /= 7)) call abort
123 if (size(reshape(x
,(/3,3,3,3,3,3,3/),pad
=(/7/))) /= 2187 .or
. &
124 any(reshape(x
,(/3,3,3,3,3,3,3/),pad
=(/7/)) /= 7)) call abort
125 if (size(reshape(y
,(/3,3/),pad
=(/7/))) /= 9 .or
. &
126 any(reshape(y
,(/3,3/),pad
=(/7/)) /= 7)) call abort
127 if (size(reshape(y
,(/3,3,3/),pad
=(/7/))) /= 27 .or
. &
128 any(reshape(y
,(/3,3,3/),pad
=(/7/)) /= 7)) call abort
129 if (size(reshape(y
,(/3,3,3,3,3,3,3/),pad
=(/7/))) /= 2187 .or
. &
130 any(reshape(y
,(/3,3,3,3,3,3,3/),pad
=(/7/)) /= 7)) call abort
132 deallocate(foo
,bar
,x
,y
)
136 integer :: tempn(1,5)
137 integer,allocatable
:: foo(:,:)
140 if (size(pack(foo
,foo
/=0)) /= 0 .or
. any(pack(foo
,foo
/=0) /= -42)) call abort
141 if (size(pack(foo
,foo
/=0,(/1,3,4,5,1,0,7,9/))) /= 8 .or
. &
142 sum(pack(foo
,foo
/=0,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
143 if (size(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0)) /= 0 .or
. &
144 any(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0) /= -42)) call abort
145 if (size(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0,(/1,3,4,5,1,0,7,9/))) /= 8 .or
. &
146 sum(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0,(/1,3,4,5,1,0,7,9/))) /= 30) &
148 if (size(pack(foo
,.true
.)) /= 0 .or
. any(pack(foo
,.true
.) /= -42)) &
150 if (size(pack(foo
,.true
.,(/1,3,4,5,1,0,7,9/))) /= 8 .or
. &
151 sum(pack(foo
,.true
.,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
152 if (size(pack(tempn(:,-4:-5),.true
.)) /= 0 .or
. &
153 any(pack(foo
,.true
.) /= -42)) call abort
154 if (size(pack(tempn(:,-4:-5),.true
.,(/1,3,4,5,1,0,7,9/))) /= 8 .or
. &
155 sum(pack(tempn(:,-4:-5),.true
.,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
159 subroutine test_unpack
160 integer :: tempn(1,5), tempv(5)
161 integer,allocatable
:: foo(:,:), bar(:)
164 allocate(foo(0,1:7),bar(0:-1))
165 if (any(unpack(tempv
,tempv
/=0,tempv
) /= 5) .or
. &
166 size(unpack(tempv
,tempv
/=0,tempv
)) /= 5) call abort
167 if (any(unpack(tempv(1:0),tempv
/=0,tempv
) /= 5) .or
. &
168 size(unpack(tempv(1:0),tempv
/=0,tempv
)) /= 5) call abort
169 if (any(unpack(tempv
,tempv(1:0)/=0,tempv
) /= -47)) call abort
170 if (any(unpack(tempv(5:4),tempv(1:0)/=0,tempv
) /= -47)) call abort
171 if (any(unpack(bar
,foo
==foo
,foo
) /= -47)) call abort
175 subroutine test_spread
177 real,allocatable
:: foo(:)
180 if (any(spread(1,dim
=1,ncopies
=0) /= -17.0) .or
. &
181 size(spread(1,dim
=1,ncopies
=0)) /= 0) call abort
182 if (any(spread(foo
,dim
=1,ncopies
=1) /= -17.0) .or
. &
183 size(spread(foo
,dim
=1,ncopies
=1)) /= 0) call abort
184 if (any(spread(tempn(2:1),dim
=1,ncopies
=1) /= -17.0) .or
. &
185 size(spread(tempn(2:1),dim
=1,ncopies
=1)) /= 0) call abort