! 例題 8-7  正方行列の Trace の計算 ［形状引継ぎ配列 ］
PROGRAM ex8_7

  IMPLICIT NONE
  INTEGER :: n, i, j
  REAL, ALLOCATABLE :: a( : , : )

  INTERFACE
    FUNCTION trace( x ) RESULT ( tr )
      REAL, INTENT ( IN ) :: x( 1 : , 1 : )      ! 形状引継ぎ配列
      REAL :: tr
    END FUNCTION
  END INTERFACE

  PRINT *, '正方行列の行(または列)の数は？'
  READ *, n

  ALLOCATE ( a( 1 : n, 1 : n ) )
  DO i = 1, n
    PRINT '( 1X, A, I2, A )', '第', i, ' 行'
    DO j = 1, n
      PRINT '( 1X, 2X, A, I2, A )', '第', j, ' 列の要素？'
      READ *, a( i, j )
    END DO
  END DO

  PRINT '( 1X, A, F7.4 )', 'trace = ', trace( a )

END PROGRAM ex8_7

! trace of a square matrix
FUNCTION trace( x ) RESULT ( tr )

  IMPLICIT NONE
  INTEGER :: n1, n2, i
  REAL, INTENT ( IN ) :: x( 1 : , 1 : )      ! 次元と下限だけ指定
  REAL :: tr

  n1 = SIZE( x, 1 )
  n2 = SIZE( x, 2 )

  IF ( n1 /= n2 ) THEN
    PRINT *, '正方行列ではありません。'
    RETURN
  ELSE
    tr = 0.0E0
    DO i = 1, n1
      tr = tr + x( i, i )
    END DO
  END IF

END FUNCTION trace