In object-oriented programming class is a set (a transitive closure) of types bound by the relation of inheritance. It is said that all types derived from some base type T and the type T itself form a class T.

The first type T from the class T sometimes is called the root type of the class.

A class of types itself, as a type, has the values and operations of its own.
The operations of are usually called methods of the root type.
Both operations and values are called  polymorphic.

A polymorphic operation (method) selects an implementation depending on the actual specific type of the polymorphic argument.

The action of choice the type-specific implementation of a polymorphic operation is called dispatch. Correspondingly, polymorphic operations are often called dispatching or virtual.
Operations with multiple arguments and/or the results of the class are called multi-methods.
A further generalization of is the operation with arguments and/or results from different classes.

 single-dispatch languages are those that allow only one argument or result to control the dispatch. Usually it is the first parameter, often hidden, so that a prefix notation x.f() is used instead of mathematical f(x).
 multiple-dispatch languages allow many arguments and/or results to control the dispatch.


A polymorphic value has a type tag indicating its specific type from the class and the corresponding specific value of that type.
This type is sometimes called the most specific type of a [polymorphic] value.
The type tag of the value is used in order to resolve the dispatch.
The set of polymorphic values of a class is a transitive closure of the sets of values of all types from that class.

In many  OO languages
the type of the class of T and T itself are considered equivalent.
In some languages they are distinct (like in Ada).
When class T and T are equivalent, there is no way to distinguish
polymorphic and specific values.



Task

Create a basic class with a method, a constructor, an instance variable and how to instantiate it.




 
!-----------------------------------------------------------------------
!Module accuracy defines precision and some constants
!-----------------------------------------------------------------------
module accuracy_module
   implicit none
   integer, parameter, public :: rdp = kind(1.d0)
   ! constants
   real(rdp), parameter :: pi=3.141592653589793238462643383279502884197_rdp
end module accuracy_module
 
!-----------------------------------------------------------------------
!Module typedefs_module contains abstract derived type and extended type definitions.
! Note that a reserved word "class" in Fortran is used to describe
! some polymorphic variable  whose data type may vary at run time.
!-----------------------------------------------------------------------
module typedefs_module
   use accuracy_module
   implicit none
 
   private ! all
   public :: TPoint, TShape, TCircle, TRectangle, TSquare ! public only these defined derived types
 
   ! abstract derived type
   type, abstract :: TShape
      real(rdp) :: area
      character(len=:),allocatable :: name
   contains
      ! deferred method i.e. abstract method =  must be overridden in extended type
      procedure(calculate_area), deferred,pass :: calculate_area
   end type TShape
   ! just declaration of the abstract method/procedure for TShape type
   abstract interface
      function  calculate_area(this)
         use accuracy_module
         import TShape !imports TShape type from host scoping unit and makes it accessible here
         implicit none
         class(TShape) :: this
         real(rdp) :: calculate_area
 
      end function calculate_area
   end interface
 
   ! auxiliary derived type
   type TPoint
      real(rdp) :: x,y
   end type TPoint
 
   ! extended derived type
   type, extends(TShape) :: TCircle
      real(rdp) :: radius
      real(rdp), private :: diameter
      type(TPoint) :: centre
   contains
      procedure, pass :: calculate_area => calculate_circle_area
      procedure, pass :: get_circle_diameter
      final :: finalize_circle
   end type TCircle
 
   ! extended derived type
   type, extends(TShape) :: TRectangle
      type(TPoint) :: A,B,C,D
   contains
      procedure, pass :: calculate_area => calculate_rectangle_area
      final :: finalize_rectangle
   end type TRectangle
 
   ! extended derived type
   type, extends(TRectangle) :: TSquare
   contains
      procedure, pass :: calculate_area => calculate_square_area
      final :: finalize_square
   end type TSquare
 
 contains
 
   ! finalization subroutines for each type
   ! They called recursively, i.e. finalize_rectangle
   ! will be called after finalize_square subroutine
   subroutine finalize_circle(x)
      type(TCircle), intent(inout) :: x
      write(*,*) "Deleting TCircle object"
   end subroutine finalize_circle
 
   subroutine finalize_rectangle(x)
      type(TRectangle), intent(inout) :: x
      write(*,*) "Deleting also TRectangle object"
   end subroutine finalize_rectangle
 
   subroutine finalize_square(x)
      type(TSquare), intent(inout) :: x
      write(*,*) "Deleting TSquare object"
   end subroutine finalize_square
 
   function calculate_circle_area(this)
      implicit none
      class(TCircle) :: this
      real(rdp) :: calculate_circle_area
      this%area = pi * this%radius**2
      calculate_circle_area = this%area
   end function calculate_circle_area
 
   function calculate_rectangle_area(this)
      implicit none
      class(TRectangle) :: this
      real(rdp) :: calculate_rectangle_area
      ! here could be more code
      this%area = 1
      calculate_rectangle_area = this%area
   end function calculate_rectangle_area
 
   function calculate_square_area(this)
      implicit none
      class(TSquare) :: this
      real(rdp) :: calculate_square_area
      ! here could be more code
      this%area = 1
      calculate_square_area = this%area
   end function calculate_square_area
 
   function  get_circle_diameter(this)
      implicit none
      class(TCircle) :: this
      real(rdp) :: get_circle_diameter
      this % diameter = 2.0_rdp * this % radius
      get_circle_diameter = this % diameter
   end function get_circle_diameter
 
end module typedefs_module
 
!-----------------------------------------------------------------------
!Main program
!-----------------------------------------------------------------------
program    rosetta_class
   use accuracy_module
   use typedefs_module
   implicit none
 
   ! we need this subroutine in order to show the finalization
   call test_types()
 
 contains
 
   subroutine test_types()
      implicit none
      ! declare object of type TPoint
      type(TPoint), target :: point
      ! declare object of type TCircle
      type(TCircle),target :: circle
      ! declare object of type TSquare
      type(TSquare),target :: square
 
      ! declare pointers
      class(TPoint), pointer :: ppo
      class(TCircle), pointer :: pci
      class(TSquare), pointer :: psq
 
      !constructor
      point = TPoint(5.d0,5.d0)
      ppo => point
      write(*,*) "x=",point%x,"y=",point%y
 
      pci => circle
 
      pci % radius = 1
      write(*,*) pci % radius
      ! write(*,*) pci % diameter !No,it is a PRIVATE component
      write(*,*) pci % get_circle_diameter()
      write(*,*) pci % calculate_area()
      write(*,*) pci % area
 
      psq => square
 
      write(*,*) psq % area
      write(*,*) psq % calculate_area()
      write(*,*) psq % area
   end subroutine test_types
 
end program rosetta_class
 
 