Type point
Real x,y
Contains
Procedure :: identify => identify_point
Procedure distance
End Type
Private identify_point,distance
Contains
Real Function distance(p)
Class(point),Intent(In) :: p
distance = sqrt(p%x**2 + p%y**2)
End Function
Subroutine identify_point(this)
Class(point),Intent(In) :: this
Write (*,'(1X,A,1X,2G10.2)',Advance='NO') &
"The point at",this%x,this%y
End Subroutine
End Module
Module more_points
Use point_module
Type,Extends(point) :: named_point
! Inherit Real x,y
Character(80) name ! Extra component
Contains
! Override identify with our own procedure.
Procedure :: identify => identify_named_point
! Inherit distance as is.
End Type
Contains
Subroutine identify_named_point(this)
Class(named_point),Intent(In) :: this
Write (*,'(1X,A,1X,2G10.2)',Advance='NO') &
'The point "'//Trim(this%name)//'" at',this%x,this%y
End Subroutine
End Module
Program extends_example
Use more_points
Type(point) :: a = point(3.0,4.0)
Type(named_point) :: b = named_point(1.0,1.0,'corner')
Call show_info(a)
Call show_info(b)
Contains
Subroutine show_info(x)
Class(point),Intent(In) :: x
Call x%identify
Print '(" has distance ",G10.2)',x%distance()
End Subroutine
End Program
Execution ResultsThe point at 3.0 4.0 has distance 5.0
The point "corner" at 1.0 1.0 has distance 1.4