fortran66のブログ

fortran について書きます。

MODULE m_type
IMPLICIT NONE
!
TYPE :: t_base
 INTEGER :: n
 REAL    :: x
END TYPE t_base
!
END MODULE m_type
!===================================================
MODULE m_extype
USE m_type
IMPLICIT NONE
!
TYPE, EXTENDS(t_base) :: t_ext
 PROCEDURE (t_pr0), POINTER, NOPASS  :: pr0
 PROCEDURE (t_pr1), POINTER, NOPASS  :: pr1
 PROCEDURE (t_pr2), POINTER,   PASS  :: pr2
END TYPE t_ext
!
ABSTRACT INTERFACE
 !
 SUBROUTINE t_pr0()
 END SUBROUTINE t_pr0
 ! 
 SUBROUTINE t_pr1(x)
 IMPORT :: t_ext
 TYPE (t_ext), INTENT(IN OUT) :: x
 END SUBROUTINE t_pr1
 !
 SUBROUTINE t_pr2(x, y)
 IMPORT :: t_ext
 TYPE (t_ext), INTENT(IN OUT) :: x
 REAL, INTENT(IN) :: y
 END SUBROUTINE t_pr2
 !
END INTERFACE
!
END MODULE m_extype
!===================================================
MODULE m_func
USE m_extype
IMPLICIT NONE
CONTAINS
!--------------------
SUBROUTINE pr0()
PRINT *, 'uho!'
RETURN
END SUBROUTINE pr0
!--------------------
SUBROUTINE pr1(x)
TYPE (t_ext), INTENT(IN OUT) :: x
PRINT *, x%n, x%x
RETURN
END SUBROUTINE pr1
!--------------------
SUBROUTINE pr2(x, y)
TYPE (t_ext), INTENT(IN OUT) :: x
REAL, INTENT(IN) :: y
PRINT *, x%n, x%x
PRINT *, y
RETURN
END SUBROUTINE pr2
!
END MODULE m_func
!===================================================
PROGRAM test
USE m_extype
USE m_func
IMPLICIT NONE

TYPE (t_ext) :: a
a%n = 99
a%x = 999.0
a%pr0 => pr0
a%pr1 => pr1
a%pr2 => pr2

PRINT *, a%n, a%x

CALL a%pr0()
CALL a%pr1(a)
CALL a%pr2(1.0)

STOP
END PROGRAM test