diff --git a/src/include/implementation_extras.f90 b/src/include/implementation_extras.f90 index 26a9dde..2e27ba9 100644 --- a/src/include/implementation_extras.f90 +++ b/src/include/implementation_extras.f90 @@ -143,3 +143,68 @@ ELEMENTAL FUNCTION sub_realalt_complex_rpe_complex (x, y) RESULT (z) z = x - y%val END FUNCTION sub_realalt_complex_rpe_complex + !------------------------------------------------------------------- + ! Overloaded definitions for (*): + ! + + ELEMENTAL FUNCTION mul_rpe_complex_rpe_complex (x, y) RESULT (z) + TYPE(rpe_complex_var), INTENT(IN) :: x + TYPE(rpe_complex_var), INTENT(IN) :: y + TYPE(rpe_complex_var) :: z + z%sbits = MAX(significand_bits(x), significand_bits(y)) + z = x%val * y%val + END FUNCTION mul_rpe_complex_rpe_complex + + ELEMENTAL FUNCTION mul_rpe_complex_real_complex (x, y) RESULT (z) + TYPE(rpe_complex_var), INTENT(IN) :: x + COMPLEX(KIND=RPE_REAL_KIND), INTENT(IN) :: y + TYPE(rpe_complex_var) :: z + z%sbits = MAX(significand_bits(x), significand_bits(y)) + z = x%val * y + END FUNCTION mul_rpe_complex_real_complex + + ELEMENTAL FUNCTION mul_rpe_complex_realalt_complex (x, y) RESULT (z) + TYPE(rpe_complex_var), INTENT(IN) :: x + COMPLEX(KIND=RPE_ALTERNATE_KIND), INTENT(IN) :: y + TYPE(rpe_complex_var) :: z + z%sbits = MAX(significand_bits(x), significand_bits(y)) + z = x%val * y + END FUNCTION mul_rpe_complex_realalt_complex + + ELEMENTAL FUNCTION mul_real_complex_rpe_complex (x, y) RESULT (z) + COMPLEX(KIND=RPE_REAL_KIND), INTENT(IN) :: x + TYPE(rpe_complex_var), INTENT(IN) :: y + TYPE(rpe_complex_var) :: z + z%sbits = MAX(significand_bits(x), significand_bits(y)) + z = x * y%val + END FUNCTION mul_real_complex_rpe_complex + + ELEMENTAL FUNCTION mul_realalt_complex_rpe_complex (x, y) RESULT (z) + COMPLEX(KIND=RPE_ALTERNATE_KIND), INTENT(IN) :: x + TYPE(rpe_complex_var), INTENT(IN) :: y + TYPE(rpe_complex_var) :: z + z%sbits = MAX(significand_bits(x), significand_bits(y)) + z = x * y%val + END FUNCTION mul_realalt_complex_rpe_complex + + !------------------------------------------------------------------- + ! Overloaded definition for CONJG: + ! + + ELEMENTAL FUNCTION conjg_rpe_complex (x) RESULT(z) + TYPE(rpe_complex_var), INTENT(IN) :: x + TYPE(rpe_complex_var) :: z + z%sbits = significand_bits(x) + z = conjg(x%val) + END FUNCTION conjg_rpe_complex + + !------------------------------------------------------------------- + ! Overloaded definition for REAL: + ! + + ELEMENTAL FUNCTION real_rpe_complex (x) RESULT(z) + TYPE(rpe_complex_var), INTENT(IN) :: x + TYPE(rpe_var) :: z + z%sbits = significand_bits(x) + z = real(x%val) + END FUNCTION real_rpe_complex diff --git a/src/include/interface_extras.i b/src/include/interface_extras.i index e098837..c0100e6 100644 --- a/src/include/interface_extras.i +++ b/src/include/interface_extras.i @@ -20,3 +20,21 @@ MODULE PROCEDURE sub_real_complex_rpe_complex MODULE PROCEDURE sub_realalt_complex_rpe_complex END INTERFACE OPERATOR(-) + + INTERFACE OPERATOR(*) + MODULE PROCEDURE mul_rpe_complex_rpe_complex + MODULE PROCEDURE mul_rpe_complex_real_complex + MODULE PROCEDURE mul_rpe_complex_realalt_complex + MODULE PROCEDURE mul_real_complex_rpe_complex + MODULE PROCEDURE mul_realalt_complex_rpe_complex + END INTERFACE OPERATOR(*) + + PUBLIC :: CONJG + INTERFACE CONJG + MODULE PROCEDURE conjg_rpe_complex + END INTERFACE CONJG + + PUBLIC :: REAL + INTERFACE REAL + MODULE PROCEDURE real_rpe_complex + END INTERFACE REAL