! 例題 8-5  万年暦（完成版） ［内部手続き ］
PROGRAM ex8_5

  IMPLICIT NONE
  INTEGER :: md( 1 : 12 ) = (/ 31, 28, 31, 30, 31, 30,   &
                               31, 31, 30, 31, 30, 31 /)
  INTEGER :: y, m, d, ld
  CHARACTER ( LEN = 3 ) :: yobi( 0 : 6 ) = (/ 'Sun', 'Mon', &
                           'Tue', 'Wed', 'Thu', 'Fri', 'Sat' /)

  DO
    PRINT *, '何年? ( 0 で終了 )'
    READ *, y
    IF ( y <= 0 ) EXIT
    md(2) = 28 + leap( y )     ! うるう年のとき，２月に１日加える

    PRINT *, '何月?'
    DO
      READ *, m
      IF (  0 < m .AND. m <= 12 ) EXIT
      PRINT *, '12以下の正の数を入れ直して下さい。'
    END DO

    PRINT *, '何日?'
    READ *, d
    IF ( d <= 0 .OR. d > md(m) ) THEN
      PRINT *, 'そんな日は存在しません。'
    ELSE
      CALL count( ld )
      PRINT '( 1X, I4, "年", I2, "月", I2, "日は ", A, A )', &
          y, m, d, yobi( ld ), ' です。'
    END IF
  END DO

CONTAINS

  ! その日が西暦１年１月１日から何日目かを数え，曜日を算出する
  SUBROUTINE count( n )

    IMPLICIT NONE
    INTEGER, INTENT ( OUT ) :: n

    n = MOD( yday( y ) + SUM( md( 1 : m - 1 ) ) + d, 7 )

  END SUBROUTINE

  ! 前年の12月31日が，西暦１年１月１日から何日目かを数える関数
  FUNCTION yday( x ) RESULT ( days )

    IMPLICIT NONE
    INTEGER, INTENT ( IN ) :: x
    INTEGER :: days

    days = 365 * ( x - 1 ) + ( x - 1 ) / 4 - ( x - 1 ) / 100 &
           + ( x - 1 ) / 400

  END FUNCTION yday

  ! うるう年なら１，平年なら０を返す関数
  INTEGER FUNCTION leap( x )

    IMPLICIT NONE
    INTEGER, INTENT ( IN ) :: x

    leap = yday( x + 1 ) - yday( x ) - 365

  END FUNCTION leap

END PROGRAM ex8_5