!   F90 OOP example of generic (polymorphic) functions
!   Areas of shapes of different types, Draft # 1
!    Version 2, same function names (get_area) in each ADT
!   Extended from J. F. Kerrigan, "Migrating to Fortran90", page 98
!   Copyright J. E. Akin, 1997

      module ADT_Rectangle    ! define the first ADT
       implicit none
        type Rectangle
          real :: base
          real :: height
        end  type Rectangle
      contains
!      Computation of area for rectangles.
      subroutine get_area ( r, area )
        type ( Rectangle ), intent(in) :: r
        real, intent(out)              :: area
        area = r%base * r%height
      end subroutine get_area
      end module ADT_Rectangle

      module ADT_Circle    ! define the second ADT
       implicit none
        type Circle
          real :: radius
        end  type Circle
        real :: pi = 3.1415926535897931d0 ! a circle constant
      contains
!      Computation of area for circles.
      subroutine get_area ( c, area )
        type ( Circle ), intent(in) :: c
        real, intent(out)           :: area
        area = pi * c%radius**2
      end subroutine get_area
      end module ADT_Circle

      program geometry  ! for both types in a single function
        use ADT_Circle, c_area => get_area   ! renamed get_area
        use ADT_Rectangle
        implicit none

!     Interface to generic routine to compute area for any type
      interface compute_area
        module procedure get_area, c_area
      end interface
 
!     Declare a set geometric objects.
      type ( Rectangle ) :: four_sides
      type ( Circle    ) :: two_sides    ! inside, outside
      real               :: area = 0.0   ! the result
 
!     Initialize a rectangle and compute its area.
      four_sides = Rectangle ( 2.1, 4.3 )    ! default constructor
      call compute_area ( four_sides, area ) ! generic function
      write ( 6,100 ) four_sides, area       ! default components list
100   format ( "Area of ", f3.1, " by ", f3.1,                   &
     &               " rectangle is ", f5.2 )
 
!     Initialize a circle and compute its area.
      two_sides = Circle ( 5.4 )            ! default constructor
      call compute_area ( two_sides, area ) ! generic function
      write ( 6,200 ) two_sides, area
200   format ( "Area of circle with ", f3.1,                      &
     &             " radius is ", f9.5 )
 
      stop 'Normal end of geometry'
      end program geometry

! Running gives:
! Area of 2.1 by 4.3 rectangle is  9.03
! Area of circle with 5.4 radius is  91.60885