Fortran 2003 入門

ナビゲーション：前へ   上へ   次へ

3.4 割付け成分の例

以下は多項演算機能を提供する簡単なモジュールの定義とその用例を示したものです。 ここでは割付け成分の組込み代入と自動的に提供される構造体構成子を利用し、 加算演算子(+)を定義します。 より完成されたモジュールでは乗算等の他の演算子も提供されることになるでしょう。

!
! Module providing a single-precision polynomial arithmetic facility
!
MODULE real_poly_module
  !
  ! Define the polynomial type with its constructor.
  ! We will use the convention of storing the coefficients in the normal
  ! order of highest degree first, thus in an N-degree polynomial, COEFF(1)
  ! is the coefficient of X**N, COEFF(N) is the coefficient of X**1, and
  ! COEFF(N+1) is the scalar.
  !
  TYPE,PUBLIC :: real_poly
    REAL,ALLOCATABLE :: coeff(:)
  END TYPE
  !
  PUBLIC OPERATOR(+)
  INTERFACE OPERATOR(+)
    MODULE PROCEDURE rp_add_rp,rp_add_r,r_add_rp
  END INTERFACE
  !
CONTAINS
  TYPE(real_poly) FUNCTION rp_add_r(poly,real)
    TYPE(real_poly),INTENT(IN) :: poly
    REAL,INTENT(IN) :: real
    INTEGER isize
    IF (.NOT.ALLOCATED(poly%coeff)) STOP 'Undefined polynomial value in +'
    isize = SIZE(poly%coeff,1)
    rp_add_r%coeff(isize) = poly%coeff(isize) + real
  END FUNCTION
  TYPE(real_poly) FUNCTION r_add_rp(real,poly)
    TYPE(real_poly),INTENT(IN) :: poly
    REAL,INTENT(IN) :: real
    r_add_rp = rp_add_r(poly,real)
  END FUNCTION
  TYPE(real_poly) FUNCTION rp_add_rp(poly1,poly2)
    TYPE(real_poly),INTENT(IN) :: poly1,poly2
    INTEGER I,N,N1,N2
    IF (.NOT.ALLOCATED(poly1%coeff).OR..NOT.ALLOCATED(poly2%coeff)) &
      STOP 'Undefined polynomial value in +'
    ! Set N1 and N2 to the degrees of the input polynomials
    N1 = SIZE(poly1%coeff) - 1
    N2 = SIZE(poly2%coeff) - 1
    ! The result polynomial is of degree N
    N = MAX(N1,N2)
    ALLOCATE(rp_add_rp%coeff(N+1))
    DO I=0,MIN(N1,N2)
      rp_add_rp%coeff(N-I+1) = poly1%coeff(N1-I+1) + poly2%coeff(N2-I+1)
    END DO
    ! At most one of the next two DO loops is ever executed
    DO I=N1+1,N
      rp_add_rp%coeff(N-I+1) = poly2%coeff(N2-I+1)
    END DO
    DO I=N2+1,N
      rp_add_rp%coeff(N-I+1) = poly1%coeff(N1-I+1)
    END DO
  END FUNCTION
END MODULE
!
! Sample program
!
PROGRAM example
  USE real_poly_module
  TYPE(real_poly) p,q,r
  p = real_poly((/1.0,2.0,4.0/))   ! x**2 + 2x + 4
  q = real_poly((/1.0,-5.5/))      ! x - 5.5
  r = p + q                        ! x**2 + 3x - 1.5
  print 1,'The coefficients of the answer are:',r%coeff
1 format(1x,A,3F8.2)
END

上記例を実行すると以下の出力が得られます：

 The coefficients of the answer are:    1.00    3.00   -1.50

ナビゲーション：前へ   上へ   次へ