| * test whether complex operators properly handle |
| * full and partial aliasing. |
| * (libf2c/libF77 routines used to assume no aliasing, |
| * then were changed to accommodate full aliasing, while |
| * the libg2c/libF77 versions were changed to accommodate |
| * both full and partial aliasing.) |
| * |
| * NOTE: this (19990325-0.f) is the single-precision version. |
| * See 19990325-1.f for the double-precision version. |
| |
| program complexalias |
| implicit none |
| |
| * Make sure non-aliased cases work. (Catch roundoff/precision |
| * problems, etc., here. Modify subroutine check if they occur.) |
| |
| call tryfull (1, 3, 5) |
| |
| * Now check various combinations of aliasing. |
| |
| * Full aliasing. |
| call tryfull (1, 1, 5) |
| |
| * Partial aliasing. |
| call trypart (2, 3, 5) |
| call trypart (2, 1, 5) |
| call trypart (2, 5, 3) |
| call trypart (2, 5, 1) |
| |
| end |
| |
| subroutine tryfull (xout, xin1, xin2) |
| implicit none |
| integer xout, xin1, xin2 |
| |
| * out, in1, and in2 are the desired indexes into the REAL array (array). |
| |
| complex expect |
| integer pwr |
| integer out, in1, in2 |
| |
| real array(6) |
| complex carray(3) |
| equivalence (carray(1), array(1)) |
| |
| * Make sure the indexes can be accommodated by the equivalences above. |
| |
| if (mod (xout, 2) .ne. 1) call abort |
| if (mod (xin1, 2) .ne. 1) call abort |
| if (mod (xin2, 2) .ne. 1) call abort |
| |
| * Convert the indexes into ones suitable for the COMPLEX array (carray). |
| |
| out = (xout + 1) / 2 |
| in1 = (xin1 + 1) / 2 |
| in2 = (xin2 + 1) / 2 |
| |
| * Check some open-coded stuff, just in case. |
| |
| call prepare1 (carray(in1)) |
| expect = + carray(in1) |
| carray(out) = + carray(in1) |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = - carray(in1) |
| carray(out) = - carray(in1) |
| call check (expect, carray(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) + carray(in2) |
| carray(out) = carray(in1) + carray(in2) |
| call check (expect, carray(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) - carray(in2) |
| carray(out) = carray(in1) - carray(in2) |
| call check (expect, carray(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) * carray(in2) |
| carray(out) = carray(in1) * carray(in2) |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = carray(in1) ** 2 |
| carray(out) = carray(in1) ** 2 |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = carray(in1) ** 3 |
| carray(out) = carray(in1) ** 3 |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = abs (carray(in1)) |
| array(out*2-1) = abs (carray(in1)) |
| array(out*2) = 0 |
| call check (expect, carray(out)) |
| |
| * Now check the stuff implemented in libF77. |
| |
| call prepare1 (carray(in1)) |
| expect = cos (carray(in1)) |
| carray(out) = cos (carray(in1)) |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = exp (carray(in1)) |
| carray(out) = exp (carray(in1)) |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = log (carray(in1)) |
| carray(out) = log (carray(in1)) |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = sin (carray(in1)) |
| carray(out) = sin (carray(in1)) |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = sqrt (carray(in1)) |
| carray(out) = sqrt (carray(in1)) |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = conjg (carray(in1)) |
| carray(out) = conjg (carray(in1)) |
| call check (expect, carray(out)) |
| |
| call prepare1i (carray(in1), pwr) |
| expect = carray(in1) ** pwr |
| carray(out) = carray(in1) ** pwr |
| call check (expect, carray(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) / carray(in2) |
| carray(out) = carray(in1) / carray(in2) |
| call check (expect, carray(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) ** carray(in2) |
| carray(out) = carray(in1) ** carray(in2) |
| call check (expect, carray(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = carray(in1) ** .2 |
| carray(out) = carray(in1) ** .2 |
| call check (expect, carray(out)) |
| |
| end |
| |
| subroutine trypart (xout, xin1, xin2) |
| implicit none |
| integer xout, xin1, xin2 |
| |
| * out, in1, and in2 are the desired indexes into the REAL array (array). |
| |
| complex expect |
| integer pwr |
| integer out, in1, in2 |
| |
| real array(6) |
| complex carray(3), carrayp(2) |
| equivalence (carray(1), array(1)) |
| equivalence (carrayp(1), array(2)) |
| |
| * Make sure the indexes can be accommodated by the equivalences above. |
| |
| if (mod (xout, 2) .ne. 0) call abort |
| if (mod (xin1, 2) .ne. 1) call abort |
| if (mod (xin2, 2) .ne. 1) call abort |
| |
| * Convert the indexes into ones suitable for the COMPLEX array (carray). |
| |
| out = xout / 2 |
| in1 = (xin1 + 1) / 2 |
| in2 = (xin2 + 1) / 2 |
| |
| * Check some open-coded stuff, just in case. |
| |
| call prepare1 (carray(in1)) |
| expect = + carray(in1) |
| carrayp(out) = + carray(in1) |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = - carray(in1) |
| carrayp(out) = - carray(in1) |
| call check (expect, carrayp(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) + carray(in2) |
| carrayp(out) = carray(in1) + carray(in2) |
| call check (expect, carrayp(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) - carray(in2) |
| carrayp(out) = carray(in1) - carray(in2) |
| call check (expect, carrayp(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) * carray(in2) |
| carrayp(out) = carray(in1) * carray(in2) |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = carray(in1) ** 2 |
| carrayp(out) = carray(in1) ** 2 |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = carray(in1) ** 3 |
| carrayp(out) = carray(in1) ** 3 |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = abs (carray(in1)) |
| array(out*2) = abs (carray(in1)) |
| array(out*2+1) = 0 |
| call check (expect, carrayp(out)) |
| |
| * Now check the stuff implemented in libF77. |
| |
| call prepare1 (carray(in1)) |
| expect = cos (carray(in1)) |
| carrayp(out) = cos (carray(in1)) |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = exp (carray(in1)) |
| carrayp(out) = exp (carray(in1)) |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = log (carray(in1)) |
| carrayp(out) = log (carray(in1)) |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = sin (carray(in1)) |
| carrayp(out) = sin (carray(in1)) |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = sqrt (carray(in1)) |
| carrayp(out) = sqrt (carray(in1)) |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = conjg (carray(in1)) |
| carrayp(out) = conjg (carray(in1)) |
| call check (expect, carrayp(out)) |
| |
| call prepare1i (carray(in1), pwr) |
| expect = carray(in1) ** pwr |
| carrayp(out) = carray(in1) ** pwr |
| call check (expect, carrayp(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) / carray(in2) |
| carrayp(out) = carray(in1) / carray(in2) |
| call check (expect, carrayp(out)) |
| |
| call prepare2 (carray(in1), carray(in2)) |
| expect = carray(in1) ** carray(in2) |
| carrayp(out) = carray(in1) ** carray(in2) |
| call check (expect, carrayp(out)) |
| |
| call prepare1 (carray(in1)) |
| expect = carray(in1) ** .2 |
| carrayp(out) = carray(in1) ** .2 |
| call check (expect, carrayp(out)) |
| |
| end |
| |
| subroutine prepare1 (in) |
| implicit none |
| complex in |
| |
| in = (3.2, 4.2) |
| |
| end |
| |
| subroutine prepare1i (in, i) |
| implicit none |
| complex in |
| integer i |
| |
| in = (2.3, 2.5) |
| i = 4 |
| |
| end |
| |
| subroutine prepare2 (in1, in2) |
| implicit none |
| complex in1, in2 |
| |
| in1 = (1.3, 2.4) |
| in2 = (3.5, 7.1) |
| |
| end |
| |
| subroutine check (expect, got) |
| implicit none |
| complex expect, got |
| |
| if (aimag(expect) .ne. aimag(got)) call abort |
| if (real(expect) .ne. real(got)) call abort |
| |
| end |