MODULE Rectangle_Type !----------------------------------------------------------------------- ! Module to define the derived data type Rectangle for processing ! rectangles with sides parallel to the x- and y- axes and with ! one vertex at the origin. Basic operations are: ! + : R1 + R2 is the smallest rectangle containing ! R1 and R2 ! .int. : R1 .int. R2 is the intersection of R1 and R2 ! * : c * R where c is a scalar (number) is the ! rectangle obtained by scaling the sides of R ! by |c| ! == : R1 == R2 is true if R1 and R2 have the same width ! and the same length !----------------------------------------------------------------------- TYPE Rectangle REAL :: Side1, Side2 END TYPE Rectangle ! Basic operations and relations INTERFACE OPERATOR(+) MODULE PROCEDURE Plus END INTERFACE INTERFACE OPERATOR(*) MODULE PROCEDURE ScalarMultiple END INTERFACE INTERFACE OPERATOR(==) MODULE PROCEDURE Equal END INTERFACE INTERFACE OPERATOR(.int.) MODULE PROCEDURE Intersect END INTERFACE INTERFACE ASSIGNMENT(=) MODULE PROCEDURE Assign END INTERFACE PRIVATE :: Plus, ScalarMultiple, Equal, Intersect, Assign CONTAINS !-Plus--------------------------------------------------------- ! Function to implement the + operation on type Rectangle. ! Accepts: Rectangles R1 and R2 ! Returns: R1 + R2 !-------------------------------------------------------------- FUNCTION Plus(R1, R2) TYPE(Rectangle) :: Plus TYPE(Rectangle), INTENT(IN) :: R1, R2 Plus%Side1 = MAX(R1%Side1, R2%Side1) Plus%Side2 = MAX(R1%Side2, R2%Side2) END FUNCTION Plus !-ScalarMultiple----------------------------------------------- ! Function to implement the * operation on type Rectangle. ! Accepts: Real number c and Rectangle R ! Returns: c * R !-------------------------------------------------------------- FUNCTION ScalarMultiple(c, R) TYPE(Rectangle) :: ScalarMultiple REAL, INTENT(IN) :: c TYPE(Rectangle), INTENT(IN) :: R ScalarMultiple%Side1 = ABS(c) * R%Side1 ScalarMultiple%Side2 = ABS(c) * R%Side2 END FUNCTION ScalarMultiple !-Equal-------------------------------------------------------- ! Function to implement the == relation on type Rectangle. ! Accepts: Rectangles R1 and R2 ! Returns: Truth or falsity of logical expression R1 == R2 !-------------------------------------------------------------- FUNCTION Equal(R1, R2) LOGICAL :: Equal TYPE(Rectangle), INTENT(IN) :: R1, R2 Equal = (R1%Side1 == R2%Side1) .AND. (R1%Side2 == R2%Side2) END FUNCTION Equal !-Intersect---------------------------------------------------- ! Function to implement the .int. operation on type Rectangle. ! Accepts: Rectangles R1 and R2 ! Returns: The intersection of R1 and R2 !-------------------------------------------------------------- FUNCTION Intersect(R1, R2) TYPE(Rectangle) :: Intersect TYPE(Rectangle), INTENT(IN) :: R1, R2 Intersect%Side1 = MIN(R1%Side1, R2%Side1) Intersect%Side2 = MIN(R1%Side2, R2%Side2) END FUNCTION Intersect !-Assign------------------------------------------------------- ! Subroutine to extend = to type Rectangle to allow statements ! of the form Rectangle-variable = real-expression ! Accepts: Rectangle R and real value RealValue ! Returns: R with both its components set to RealValue !-------------------------------------------------------------- SUBROUTINE Assign(R, RealValue) TYPE(Rectangle), INTENT(INOUT) :: R REAL, INTENT(IN) :: RealValue R%Side1 = RealValue R%Side2 = RealValue END SUBROUTINE Assign END MODULE Rectangle_Type