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
QQ截图20190113211020.png (23.29 KB, 下载次数: 290)
liudy02 发表于 2019-1-14 10:11
这些都可以做,但是这个父类设计没啥意思啊
lookbook 发表于 2019-1-15 13:47
单独实现:
情况1:
2d直角=3d直角 & 3d直角=2d直角
liudy02 发表于 2019-1-15 15:00
没明白你的难处在哪里?既然都可以实现赋值,为什么会有问题
另外其实也不是很明白你这这么奇怪的需求是 ...
lookbook 发表于 2019-1-15 23:23
如果同时assignment(=)=> balbalbal....
那这个等号的重载将会遇到问题。
欢迎光临 Fortran Coder (http://bbs.fcode.cn/) | Powered by Discuz! X3.2 |