オブジェクト指向型の TYPE 中で、その TYPE に作用する副プログラム名に総称名を用いることが可能です。
ソースコード
MODULE m_TYPE IMPLICIT NONE TYPE :: t_vector REAL, ALLOCATABLE :: v(:) CONTAINS PROCEDURE, PASS :: init PROCEDURE, PASS :: dot1 PROCEDURE, PASS :: dot2 GENERIC :: dot => dot1, dot2 FINAL :: fin END TYPE t_vector !--------------------------------------- CONTAINS !--------------------------------------- SUBROUTINE init(this, n) CLASS (t_vector), INTENT(IN) :: this INTEGER, INTENT(IN) :: n ALLOCATE( this%v(n) ) RETURN END SUBROUTINE init !--------------------------------------- SUBROUTINE fin(this) TYPE (t_vector), INTENT(IN) :: this IF ( ALLOCATED(this%v) ) DEALLOCATE( this%v ) PRINT *, 'deallocated' RETURN END SUBROUTINE fin !--------------------------------------- SUBROUTINE dot1(this, d) CLASS (t_vector), INTENT(IN) :: this REAL(8), INTENT(OUT) :: d d = SQRT(SUM(this%v**2)) RETURN END SUBROUTINE dot1 !--------------------------------------- SUBROUTINE dot2(this, x) CLASS (t_vector), INTENT(IN) :: this REAL, INTENT(OUT) :: x x = SQRT(SUM(this%v**2)) RETURN END SUBROUTINE dot2 !--------------------------------------- END MODULE m_TYPE !========================================= PROGRAM TYPE USE m_TYPE IMPLICIT NONE TYPE, EXTENDS(t_vector) :: t_2vector REAL, ALLOCATABLE :: u(:) END TYPE t_2vector ! TYPE(t_vector), ALLOCATABLE :: x TYPE(t_2vector), ALLOCATABLE :: y REAL :: r, s REAL(8) :: d ALLOCATE(x, y) CALL x%init(10) CALL y%init(10) CALL RANDOM_SEED() CALL RANDOM_NUMBER(x%v) CALL RANDOM_NUMBER(y%v) CALL x%dot2(r) PRINT *, x%v CALL x%dot(s) CALL x%dot(d) PRINT *, '===========>', s, d ! CALL y%dot(s) CALL y%dot(d) PRINT *, '===========>', s, d ! ALLOCATE( y%u(10) ) y%u = x%v PRINT *, 'DOT_PRODUCT(y%v, y%u) ===>', DOT_PRODUCT(y%v, y%u), DOT_PRODUCT(y%v, x%v) DEALLOCATE( y%u ) DEALLOCATE(x, y) ! STOP END PROGRAM TYPE