[Fortran] 纯文本查看 复制代码 module Point_m
implicit none
type,abstract:: Point
end type
end module
module Point2D_m
use Point_m
implicit none
type,extends(Point):: Point2D
real x, y
end type
end module
module Point3D_m
use Point2D_m
implicit none
type,extends(Point2D):: Point3D
real z
end type
end module
module Point2D_sph_m
use Point_m
implicit none
type,extends(Point):: Point2D_sph
real r, phi
end type
end module
module Point3D_sph_m
use Point2D_sph_m
use Point3D_m
implicit none
type,extends(Point2D_sph):: Point3D_sph
real theta
contains
procedure XYZ2Sph, sph
generic:: assignment(=) => XYZ2Sph, sph
end type
contains
subroutine XYZ2Sph(this,other)
implicit none
class(Point3D_sph),intent(inout) :: this
class(Point2D),intent(in) :: other
select type(other)
class is(Point2D)
this%r = 1
this%phi = 2
this%theta = 0
class is(Point3D)
this%r = 1
this%phi = 2
this%theta = 3
end select
end subroutine XYZ2Sph
subroutine Sph(this,other)
implicit none
class(Point3D_sph),intent(inout) :: this
class(Point2D_sph),intent(in) :: other
select type(other)
class is(Point2D_sph)
this%r = 5
this%phi = 6
this%theta = 0
class is(Point3D_sph)
this%r = 5
this%phi = 6
this%theta = 7
end select
end subroutine sph
end module
program test
use Point3D_m
use Point3D_sph_m
type(point2d) a
type(point3d) b
type(point2d_sph) c
type(point3d_sph) d
d = a
print*,d
d = b
print*,d
d = c
print*,d
d = d
print*,d
pause
end
|