






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)
    RETURN
  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
    RETURN

  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)
    RETURN

  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)
    RETURN

  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(IN OUT) :: R
    REAL, INTENT(IN) :: RealValue

    R%Side1 = RealValue
    R%Side2 = RealValue
    RETURN

  END SUBROUTINE Assign

END MODULE Rectangle_Type
