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