!-----  Ex8_4: All Round Calendar   -----
   PROGRAM main
      CHARACTER(LEN=2) :: name(0:6) = (/'日','月','火','水','木','金','土'/)
      INTEGER :: md(1:12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
      INTEGER :: y, m, d, ld
      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 *,'Day?'
	       READ *, d
         IF( d <= 0 .OR. d > md(m) ) THEN
	          PRINT*, 'そんな日は存在しません。'
         ELSE
            CALL count(ld)
            PRINT "( 1X, I4, '年', I2, '月', I2, '日は ', A2, A/ )",   &
	                 y, m, d, name(ld), '曜日 です。'
         END IF
      END DO
!
   CONTAINS
!-----   その日が西暦１年１月１日から何日目かを数え，曜日を算出する
      SUBROUTINE count(n)
         INTEGER, INTENT(OUT) :: n 
         n = yday(y) + SUM( md(1:m-1) ) + d
         n = MOD(n, 7)
      END SUBROUTINE
!-----   前年の12月31日が，西暦１年１月１日から何日目かを数える関数   
      FUNCTION yday(x)  RESULT(days)
         INTEGER :: x, days
         days = 365*(x-1) + (x-1)/4 - (x-1)/100 + (x-1)/400
      END FUNCTION yday   
!-----   うるう年なら１，平年なら０を返す関数
      INTEGER FUNCTION leap(x)
         INTEGER :: x
         leap = yday(x+1) - yday(x) - 365
      END FUNCTION leap
!
   END PROGRAM