130 lines
3.1 KiB
Fortran
130 lines
3.1 KiB
Fortran
module geom
|
|
|
|
type point
|
|
real(8), private :: x = 0
|
|
real(8), private :: y = 0
|
|
contains
|
|
procedure, public :: get_x
|
|
procedure, public :: get_y
|
|
procedure, public :: set_x
|
|
procedure, public :: set_y
|
|
procedure, public :: print => print_point
|
|
procedure, pass :: copy_point
|
|
!overloaded assignment operator
|
|
generic, public :: assignment(=) => copy_point
|
|
end type point
|
|
|
|
type, extends(point) :: circle
|
|
real(8), private :: r = 0
|
|
contains
|
|
procedure, public :: get_r
|
|
procedure, public :: set_r
|
|
procedure, public :: print => print_circle
|
|
procedure, pass :: copy_circle
|
|
!overloaded assignment operator
|
|
generic, public :: assignment(=) => copy_circle
|
|
end type circle
|
|
|
|
! constructor interface
|
|
interface circle
|
|
module procedure circle_constructor
|
|
end interface circle
|
|
! constructor interface
|
|
interface point
|
|
module procedure point_constructor
|
|
end interface point
|
|
|
|
contains
|
|
|
|
real(8) function get_x(this)
|
|
class(point), intent(in) :: this
|
|
get_x = this%x
|
|
end function get_x
|
|
|
|
real(8) function get_y(this)
|
|
class(point), intent(in) :: this
|
|
get_y = this%y
|
|
end function get_y
|
|
|
|
subroutine set_x(this, val)
|
|
class(point), intent(inout) :: this
|
|
real(8), intent(in) :: val
|
|
this%x = val
|
|
end subroutine set_x
|
|
|
|
subroutine set_y(this, val)
|
|
class(point), intent(inout) :: this
|
|
real(8), intent(in) :: val
|
|
this%y = val
|
|
end subroutine set_y
|
|
|
|
subroutine print_point(this)
|
|
class(point), intent(in) :: this
|
|
write(*,'(2(a,f0.4),a)') 'Point(',this%x,', ',this%y,')'
|
|
end subroutine print_point
|
|
|
|
real(8) function get_r(this)
|
|
class(circle), intent(in) :: this
|
|
get_r = this%r
|
|
end function get_r
|
|
|
|
subroutine set_r(this, val)
|
|
class(circle), intent(inout) :: this
|
|
real(8), intent(in) :: val
|
|
this%r = val
|
|
end subroutine set_r
|
|
|
|
subroutine print_circle(this)
|
|
class(circle), intent(in) :: this
|
|
write(*,'(3(a,f0.4),a)') 'Circle(',this%x,', ',this%y,'; ',this%r,')'
|
|
end subroutine print_circle
|
|
|
|
subroutine copy_point(this, rhs)
|
|
class(point), intent(inout) :: this
|
|
type(point), intent(in) :: rhs
|
|
this%x = rhs%x
|
|
this%y = rhs%y
|
|
end subroutine copy_point
|
|
|
|
subroutine copy_circle(this, rhs)
|
|
class(circle), intent(inout) :: this
|
|
type(circle), intent(in) :: rhs
|
|
this%x = rhs%x
|
|
this%y = rhs%y
|
|
this%r = rhs%r
|
|
end subroutine copy_circle
|
|
|
|
! non-default constructor to init private components
|
|
type(point) function point_constructor(x,y)
|
|
real(8), intent(in) :: x,y
|
|
point_constructor%x = x
|
|
point_constructor%y = y
|
|
end function point_constructor
|
|
! non-default constructor to init private components
|
|
type(circle) function circle_constructor(x,y,r)
|
|
real(8), intent(in) :: x,y,r
|
|
circle_constructor%x = x
|
|
circle_constructor%y = y
|
|
circle_constructor%r = r
|
|
end function circle_constructor
|
|
|
|
end module geom
|
|
|
|
program inh
|
|
use geom
|
|
|
|
type(point) :: p, p_copy
|
|
type(circle) :: c, c_copy
|
|
|
|
p = point(2.0d0, 3.0d0)
|
|
call p%print
|
|
p_copy = p
|
|
call p_copy%print
|
|
|
|
c = circle(3.0d0, 4.0d0, 5.0d0)
|
|
call c%print
|
|
c_copy = c
|
|
call c_copy%print
|
|
|
|
end program inh
|