夏休みも近いので Fortran2003 の勉強ついでに、カレンダーを作ることにしました。
parametric type を Object-Oriented 機能で用いました。まだ Intel Fortran v.15 beta コンパイラにバグがあるようで debug mode では実行時エラーが出てしまいます。
なお画像の Ascii Art は、こちらのプログラムを用いました。http://fortran66.hatenablog.com/entry/2014/07/01/001238
プリンタに出すとコンソール出力と白黒が反転するので、RGB を反転させました。　
    module m_hanamoji
      implicit none
      character(len = 32), parameter :: dig = '0123456789'
      type :: t_hana(nrow, ncol)
        integer, len :: nrow, ncol  
        character(len = ncol) :: ch(1:nrow)  
      contains
        procedure :: pr => pr_hana
      end type t_hana    
      type(t_hana(5, 6)) :: digit(0:9) 
      type(t_hana(7, 8)) :: tsuki(0:10)  
      type(t_hana(7, 8)) :: youbi(0:7)  
      character(len = 136) :: screen(64) = ''
      
    contains  
      subroutine pr_hana(hana_moji, ix, iy)
        type(t_hana(*, *)), intent(in) :: hana_moji !
        integer, intent(in) :: ix, iy
        integer :: irow
        do irow = 1, hana_moji%nrow
          screen(irow + iy - 1)(ix:ix + hana_moji%ncol - 1) = hana_moji%ch(irow)
        end do    
      end subroutine pr_hana 

      subroutine print_number(text, ix, iy, center)
        character(len = *), intent(in) :: text
        integer, intent(in) :: ix, iy
        logical, optional, intent(in) :: center
        integer :: i, k, ix0
        ix0 = 0
        if (present(center) .and. center) ix0 = (len(text) * digit%ncol) / 2  
        do i = 1, len(text)
          k = index(dig, text(i:i)) - 1
          if (k >= 0) call digit(k)%pr(ix - ix0 + digit%ncol * (i - 1), iy)
        end do    
      end subroutine print_number  

      subroutine print_tsuki(month, ix, iy)
        integer, intent(in) :: month, ix, iy
        call tsuki(month)%pr(ix - 2 * tsuki%ncol, iy)
        call tsuki(    0)%pr(ix +     tsuki%ncol, iy)
      end subroutine print_tsuki  
      
      subroutine print_youbi(k, ix, iy)
        integer, intent(in) :: k, ix, iy
        call youbi(k)%pr(ix - youbi%ncol / 2, iy)
      end subroutine print_youbi

      subroutine init_hana()
        character(len = 60) :: tmp1(5) = ''
        character(len = 99) :: tmp2(7) = ''
        integer :: i
        tmp1(1) = ' 000    1    222   333     4  55555  666  77777  888   999  '                
        tmp1(2) = '0   0  11   2   2 3   3   44  5     6         7 8   8 9   9 '                 
        tmp1(3) = '0   0   1      2    333  4 4  5555  6666     7   888   9999 '                
        tmp1(4) = '0   0   1    2    3   3 44444     5 6   6   7   8   8     9 '               
        tmp1(5) = ' 000  11111 22222  333     4  5555   666    7    888   999  '
        do i = 0, 9
          associate(pos0 => digit(i)%ncol * i + 1, pos1 => digit(i)%ncol * (i + 1))  
            digit(i)%ch(:) = tmp1(:)(pos0:pos1)
          end associate
        end do    
        tmp2(1) = ' ######                 #######          #####     #      #      #   #   #         #    '  
        tmp2(2) = ' #    #          #####          #######   #     #######   #      #   #  #####      #    '  
        tmp2(3) = ' ######                         # # # #   #             #######  #   #   #  #      #    '  
        tmp2(4) = ' #    # #######          #####  # # # # ######   #   #    #      #   #   #  #   ####### '  
        tmp2(5) = ' ######                         ##   ##  #   #   #   #    #      #   #   #  #      #    '  
        tmp2(6) = ' #    #                         #     #  #   #   #   #    #      #   #   #  # #    #    '  
        tmp2(7) = '#    ##         ####### ####### ####### ####### #     #    #### #     # #    ##    #    '  
        do i = 0, 10
          associate(pos0 => tsuki(i)%ncol * i  + 1, pos1 => tsuki(i)%ncol * (i + 1))  
            tsuki(i)%ch(:) = tmp2(:)(pos0:pos1)
          end associate
        end do    
        tmp2(1) = '#######  ######    #       #       #      ###      #       #    '  
        tmp2(2) = '#     #  #    #  # #  #    # ## #######  #   #     #    ####### '  
        tmp2(3) = '#     #  ######  # # #  #####     ###   # ### #  #####    ###   '  
        tmp2(4) = '#######  #    # #  # #    ## #   # # #  # ### #    #     # # #  '  
        tmp2(5) = '#     #  ######    #     # # #   # # #     #       #     # # #  '  
        tmp2(6) = '#     #  #    #   # #   #  #  # #  #  #  # # #     #    # ### # '  
        tmp2(7) = '####### #    ##  #   #     #    #  #  # ####### ####### #  #  # '  
        do i = 0, 7
          associate(pos0 => youbi(i)%ncol * i  + 1, pos1 => youbi(i)%ncol * (i + 1))  
            youbi(i)%ch(:) = tmp2(:)(pos0:pos1)
          end associate
        end do    
      end subroutine init_hana
      
      integer function zeller(iy, im, id) ! Gregorian
        integer, value :: iy, im, id
        integer :: iwk, ih
        if (im == 1 .or. im == 2) then
          iy = iy - 1
          im = 12 + im
        end if
        ih =     iy / 100
        iy = mod(iy,  100)
        iwk = iy + floor(iy / 4.0) + floor(ih / 4.0) - 2 * ih + floor(13.0 * (im + 1.0) / 5.0) + id
        zeller = modulo(iwk , 7)
      end function zeller

      integer function ishift_day(iy, im)
        integer, intent(in) :: iy, im
        integer :: iwk
        iwk = zeller(iy, im, 1)
        if (iwk == 0) iwk = 7
        ishift_day = 2 - iwk
      end function ishift_day  
      
      integer function inum_days(iy, im)
        integer, intent(in) :: iy, im
        integer, parameter :: nd(12) = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
        inum_days = nd(im)
        if (im == 2 .and. leap_year(iy)) inum_days = inum_days + 1 
      contains
        logical function leap_year(iy)
          integer, intent(in) :: iy
          leap_year = .false.
          if (mod(iy,   4) == 0) leap_year = .true.
          if (mod(iy, 100) == 0) leap_year = .false.
          if (mod(iy, 400) == 0) leap_year = .true.
        end function leap_year
      end function inum_days
    end module m_hanamoji  

    program hana
      use m_hanamoji 
      implicit none
      character(len = 4) :: buff
      integer :: i, j, ix, iy, iyear, month
      call init_hana()
      iyear = 2014
      month = 8
      write(buff, '(i4)') iyear
      call print_tsuki(month,  64,  2)
      call print_number(buff, 100,  4)  
      do i = 0, 6
        call print_youbi(i, 18 * i + 12, 12)  
      end do
      j = 0
      do i = ishift_day(iyear, month), inum_days(iyear, month)
        ix = 14 + 18 * mod(j, 7)
        iy = 22 + 7 * (j / 7)
        buff = ''
        if (i > 0) write(buff, '(g0)') i
        call print_number(trim(buff), ix, iy, center = .true.)  
        j = j + 1
      end do    
! print screen  
      do i = 1, size(screen)
        print '(a128)', screen(i)
      end do
    end program hana