1* test whether complex operators properly handle
2* full and partial aliasing.
3* (libf2c/libF77 routines used to assume no aliasing,
4* then were changed to accommodate full aliasing, while
5* the libg2c/libF77 versions were changed to accommodate
6* both full and partial aliasing.)
7*
8* NOTE: this (19990325-1.f) is the double-precision version.
9* See 19990325-0.f for the single-precision version.
10
11      program doublecomplexalias
12      implicit none
13
14* Make sure non-aliased cases work.  (Catch roundoff/precision
15* problems, etc., here.  Modify subroutine check if they occur.)
16
17      call tryfull (1, 3, 5)
18
19* Now check various combinations of aliasing.
20
21* Full aliasing.
22      call tryfull (1, 1, 5)
23
24* Partial aliasing.
25      call trypart (2, 3, 5)
26      call trypart (2, 1, 5)
27      call trypart (2, 5, 3)
28      call trypart (2, 5, 1)
29
30      end
31
32      subroutine tryfull (xout, xin1, xin2)
33      implicit none
34      integer xout, xin1, xin2
35
36* out, in1, and in2 are the desired indexes into the REAL array (array).
37
38      double complex expect
39      integer pwr
40      integer out, in1, in2
41
42      double precision array(6)
43      double complex carray(3)
44      equivalence (carray(1), array(1))
45
46* Make sure the indexes can be accommodated by the equivalences above.
47
48      if (mod (xout, 2) .ne. 1) call abort
49      if (mod (xin1, 2) .ne. 1) call abort
50      if (mod (xin2, 2) .ne. 1) call abort
51
52* Convert the indexes into ones suitable for the COMPLEX array (carray).
53
54      out = (xout + 1) / 2
55      in1 = (xin1 + 1) / 2
56      in2 = (xin2 + 1) / 2
57
58* Check some open-coded stuff, just in case.
59
60      call prepare1 (carray(in1))
61      expect = + carray(in1)
62      carray(out) = + carray(in1)
63      call check (expect, carray(out))
64
65      call prepare1 (carray(in1))
66      expect = - carray(in1)
67      carray(out) = - carray(in1)
68      call check (expect, carray(out))
69
70      call prepare2 (carray(in1), carray(in2))
71      expect = carray(in1) + carray(in2)
72      carray(out) = carray(in1) + carray(in2)
73      call check (expect, carray(out))
74
75      call prepare2 (carray(in1), carray(in2))
76      expect = carray(in1) - carray(in2)
77      carray(out) = carray(in1) - carray(in2)
78      call check (expect, carray(out))
79
80      call prepare2 (carray(in1), carray(in2))
81      expect = carray(in1) * carray(in2)
82      carray(out) = carray(in1) * carray(in2)
83      call check (expect, carray(out))
84
85      call prepare1 (carray(in1))
86      expect = carray(in1) ** 2
87      carray(out) = carray(in1) ** 2
88      call check (expect, carray(out))
89
90      call prepare1 (carray(in1))
91      expect = carray(in1) ** 3
92      carray(out) = carray(in1) ** 3
93      call check (expect, carray(out))
94
95      call prepare1 (carray(in1))
96      expect = abs (carray(in1))
97      array(out*2-1) = abs (carray(in1))
98      array(out*2) = 0
99      call check (expect, carray(out))
100
101* Now check the stuff implemented in libF77.
102
103      call prepare1 (carray(in1))
104      expect = cos (carray(in1))
105      carray(out) = cos (carray(in1))
106      call check (expect, carray(out))
107
108      call prepare1 (carray(in1))
109      expect = exp (carray(in1))
110      carray(out) = exp (carray(in1))
111      call check (expect, carray(out))
112
113      call prepare1 (carray(in1))
114      expect = log (carray(in1))
115      carray(out) = log (carray(in1))
116      call check (expect, carray(out))
117
118      call prepare1 (carray(in1))
119      expect = sin (carray(in1))
120      carray(out) = sin (carray(in1))
121      call check (expect, carray(out))
122
123      call prepare1 (carray(in1))
124      expect = sqrt (carray(in1))
125      carray(out) = sqrt (carray(in1))
126      call check (expect, carray(out))
127
128      call prepare1 (carray(in1))
129      expect = conjg (carray(in1))
130      carray(out) = conjg (carray(in1))
131      call check (expect, carray(out))
132
133      call prepare1i (carray(in1), pwr)
134      expect = carray(in1) ** pwr
135      carray(out) = carray(in1) ** pwr
136      call check (expect, carray(out))
137
138      call prepare2 (carray(in1), carray(in2))
139      expect = carray(in1) / carray(in2)
140      carray(out) = carray(in1) / carray(in2)
141      call check (expect, carray(out))
142
143      call prepare2 (carray(in1), carray(in2))
144      expect = carray(in1) ** carray(in2)
145      carray(out) = carray(in1) ** carray(in2)
146      call check (expect, carray(out))
147
148      call prepare1 (carray(in1))
149      expect = carray(in1) ** .2
150      carray(out) = carray(in1) ** .2
151      call check (expect, carray(out))
152
153      end
154
155      subroutine trypart (xout, xin1, xin2)
156      implicit none
157      integer xout, xin1, xin2
158
159* out, in1, and in2 are the desired indexes into the REAL array (array).
160
161      double complex expect
162      integer pwr
163      integer out, in1, in2
164
165      double precision array(6)
166      double complex carray(3), carrayp(2)
167      equivalence (carray(1), array(1))
168      equivalence (carrayp(1), array(2))
169
170* Make sure the indexes can be accommodated by the equivalences above.
171
172      if (mod (xout, 2) .ne. 0) call abort
173      if (mod (xin1, 2) .ne. 1) call abort
174      if (mod (xin2, 2) .ne. 1) call abort
175
176* Convert the indexes into ones suitable for the COMPLEX array (carray).
177
178      out = xout / 2
179      in1 = (xin1 + 1) / 2
180      in2 = (xin2 + 1) / 2
181
182* Check some open-coded stuff, just in case.
183
184      call prepare1 (carray(in1))
185      expect = + carray(in1)
186      carrayp(out) = + carray(in1)
187      call check (expect, carrayp(out))
188
189      call prepare1 (carray(in1))
190      expect = - carray(in1)
191      carrayp(out) = - carray(in1)
192      call check (expect, carrayp(out))
193
194      call prepare2 (carray(in1), carray(in2))
195      expect = carray(in1) + carray(in2)
196      carrayp(out) = carray(in1) + carray(in2)
197      call check (expect, carrayp(out))
198
199      call prepare2 (carray(in1), carray(in2))
200      expect = carray(in1) - carray(in2)
201      carrayp(out) = carray(in1) - carray(in2)
202      call check (expect, carrayp(out))
203
204      call prepare2 (carray(in1), carray(in2))
205      expect = carray(in1) * carray(in2)
206      carrayp(out) = carray(in1) * carray(in2)
207      call check (expect, carrayp(out))
208
209      call prepare1 (carray(in1))
210      expect = carray(in1) ** 2
211      carrayp(out) = carray(in1) ** 2
212      call check (expect, carrayp(out))
213
214      call prepare1 (carray(in1))
215      expect = carray(in1) ** 3
216      carrayp(out) = carray(in1) ** 3
217      call check (expect, carrayp(out))
218
219      call prepare1 (carray(in1))
220      expect = abs (carray(in1))
221      array(out*2) = abs (carray(in1))
222      array(out*2+1) = 0
223      call check (expect, carrayp(out))
224
225* Now check the stuff implemented in libF77.
226
227      call prepare1 (carray(in1))
228      expect = cos (carray(in1))
229      carrayp(out) = cos (carray(in1))
230      call check (expect, carrayp(out))
231
232      call prepare1 (carray(in1))
233      expect = exp (carray(in1))
234      carrayp(out) = exp (carray(in1))
235      call check (expect, carrayp(out))
236
237      call prepare1 (carray(in1))
238      expect = log (carray(in1))
239      carrayp(out) = log (carray(in1))
240      call check (expect, carrayp(out))
241
242      call prepare1 (carray(in1))
243      expect = sin (carray(in1))
244      carrayp(out) = sin (carray(in1))
245      call check (expect, carrayp(out))
246
247      call prepare1 (carray(in1))
248      expect = sqrt (carray(in1))
249      carrayp(out) = sqrt (carray(in1))
250      call check (expect, carrayp(out))
251
252      call prepare1 (carray(in1))
253      expect = conjg (carray(in1))
254      carrayp(out) = conjg (carray(in1))
255      call check (expect, carrayp(out))
256
257      call prepare1i (carray(in1), pwr)
258      expect = carray(in1) ** pwr
259      carrayp(out) = carray(in1) ** pwr
260      call check (expect, carrayp(out))
261
262      call prepare2 (carray(in1), carray(in2))
263      expect = carray(in1) / carray(in2)
264      carrayp(out) = carray(in1) / carray(in2)
265      call check (expect, carrayp(out))
266
267      call prepare2 (carray(in1), carray(in2))
268      expect = carray(in1) ** carray(in2)
269      carrayp(out) = carray(in1) ** carray(in2)
270      call check (expect, carrayp(out))
271
272      call prepare1 (carray(in1))
273      expect = carray(in1) ** .2
274      carrayp(out) = carray(in1) ** .2
275      call check (expect, carrayp(out))
276
277      end
278
279      subroutine prepare1 (in)
280      implicit none
281      double complex in
282
283      in = (3.2d0, 4.2d0)
284
285      end
286
287      subroutine prepare1i (in, i)
288      implicit none
289      double complex in
290      integer i
291
292      in = (2.3d0, 2.5d0)
293      i = 4
294
295      end
296
297      subroutine prepare2 (in1, in2)
298      implicit none
299      double complex in1, in2
300
301      in1 = (1.3d0, 2.4d0)
302      in2 = (3.5d0, 7.1d0)
303
304      end
305
306      subroutine check (expect, got)
307      implicit none
308      double complex expect, got
309
310      if (dimag(expect) .ne. dimag(got)) call abort
311      if (dble(expect) .ne. dble(got)) call abort
312
313      end
314