CODEWITHSUNDEEP
functionfortranoverloading
user1543042
user1543042

Reputation: 3440

Fortran: Change function based on parameter

Is it possible to change the function called for a program based on a parameter value? I'm thinking of something similar to a function overload, the example below shows what I'm thinking. I'm just am wondering if there is a cleaner / better way to do it.

function squareArea(s) result(A)
    real :: s, A
    A = s*s
end function squareArea

function circleArea(r) result(A)
    real :: r, A
    A = 3.14159 * r * r
end function circleArea

function Area(shape, dim) result(A)
    character(len = *) shape
    real dim, A

    if (shape == 'circle') then
        A = circleArea(dim)
    elseif (shape == 'square') then
        A = squareArea(dim)
    end if

end function Area

program main
    character(len = 6) :: sh = 'circle'
    real :: r = 1.4
    real :: A

    A = Area(sh, r)

    write(*,*) sh, r, A

end program main

Upvotes: 0

Views: 133

Answers (1)

IanH
IanH

Reputation: 21451

Yes - and you show one possible way.

Fortran 2003 permits overriding of procedures based on the dynamic type of the object used to reference the procedure. Whether this is better/cleaner depends on your circumstances.

MODULE Shapes
  IMPLICIT NONE

  TYPE, ABSTRACT :: Shape
  CONTAINS
    PROCEDURE(shape_Area), DEFERRED :: Area
  END TYPE Shape

  INTERFACE
    FUNCTION shape_Area(sh) RESULT(area)
      IMPORT :: Shape
      IMPLICIT NONE
      CLASS(Shape), INTENT(IN) :: sh
      REAL :: area
    END FUNCTION shape_Area
  END INTERFACE

  TYPE, EXTENDS(Shape) :: Circle
    REAL :: radius
  CONTAINS
    PROCEDURE :: Area => circle_Area
  END TYPE Circle

  TYPE, EXTENDS(Shape) :: Square
    REAL :: side
  CONTAINS
    PROCEDURE :: Area => square_Area
  END TYPE Square
CONTAINS
  FUNCTION circle_Area(sh) RESULT(area)
    CLASS(Circle), INTENT(IN) :: sh
    REAL :: area
    area = 3.14159 * sh%radius**2
  END FUNCTION circle_Area
  FUNCTION square_Area(sh) RESULT(area)
    CLASS(Square), INTENT(IN) :: sh
    REAL :: area
    area = sh%side**2
  END FUNCTION square_Area
END MODULE Shapes

PROGRAM Areas
  USE Shapes
  IMPLICIT NONE
  TYPE(Circle) :: c = Circle(1.4)
  TYPE(Square) :: s = Square(1.4)
  CHARACTER(*), PARAMETER :: fmt = "(A,G0,' has area ',G0)"
  PRINT fmt, 'Circle with radius ', c%radius, c%Area()
  PRINT fmt, 'Square with side ', s%side, s%Area()
END PROGRAM Areas

Upvotes: 2

Related Questions