Implemented all functions for rp complex type

See aopp-pred#24.
samhatfield · Nov 2, 2016 · ada60e4 · ada60e4
1 parent 09ab45b
commit ada60e4
Show file tree

Hide file tree

Showing 2 changed files with 83 additions and 0 deletions.
diff --git 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
@@ -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