!-------------------------------------------------------------------------------
program f90_CALENDER
!-------------------------------------------------------------------------------
    !***********************************
    ! What day of the week is it today?
    !***********************************
    implicit none
    character(len=8)::yymmdd
    character(len=4)::dummy1
    character(len=2)::dummy2
    character(len=2)::dummy3
    character(len=50)::fnameR
    character(len=50)::fnameW
    integer::yy,mm,dd
    integer::yc,mc
    integer::int_day
    integer::ly
    integer::i,j,k,nw
    integer::m_days(1:12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
    integer::cal(1:6,1:7)
    character(len=2)::str_cal(1:6,1:7)
    character(len=9)::str_mm(1:12)=(/'January  ','February ','March    ','April    ','May      ','June     ',&
                                     'July     ','August   ','September','October  ','November ','December '/)

    do i=1,6
        do j=1,7
            cal(i,j)=0
        end do
    end do

    call getarg(1,yymmdd)
    call getarg(2,fnameR)
    call getarg(3,fnameW)
    dummy1=yymmdd(1:4)
    dummy2=yymmdd(5:6)
    dummy3=yymmdd(7:8)
    read(dummy1,*) yy
    read(dummy2,*) mm
    read(dummy3,*) dd

    yc=yy
    mc=mm
    if(mm==1)then
        yc=yy-1
        mc=13
    end if
    if(mm==2)then
        yc=yy-1
        mc=14
    end if

    call WHATDAY(yc,mc,dd,int_day)
    ly=LEAP_YEAR(yy)
    if(ly==1.and.mm==2)m_days(2)=29
    if(ly==0.and.(mc==14.and.dd==29))then
        write(6,*) 'Date inputted is invalid!'
        stop
    end if

    k=1
    do i=1,m_days(mm)
        call WHATDAY(yc,mc,i,int_day)
        cal(k,int_day)=i
        if(int_day==7)k=k+1
    end do
    do i=1,6
        do j=1,7
            write(dummy3,'(i2)') cal(i,j)
            if(dummy3==' 0')dummy3(1:2)='  '
            str_cal(i,j)=dummy3
        end do
    end do

    nw=5
    if(cal(6,1)/=0)nw=6
    write(6,'("    ",a9,"  (",i4,")")') str_mm(mm),yy
    write(6,'(7(" ",a3))') 'Mon','Tue','Wed','Thu','Fri','Sat','San'
    do i=1,nw
        write(6,'(7("  ",a2))') (str_cal(i,j),j=1,7)
    end do

    call HTML(fnameR,fnameW,yy,mm,str_mm,str_cal)
    call CSCAL00()

stop

contains
!-------------------------------------------------------------------------------
    subroutine WHATDAY(yy,mm,dd,int_day)
        !***********************************
        ! Zeller's congruence
        !***********************************
        integer,intent(in)::yy,mm,dd
        integer,intent(out)::int_day
        integer::pp,cc

        cc=yy/100
        pp=dd+(26*(mm+1)/10)+mod(yy,100)+(mod(yy,100)/4)+(5*cc+cc/4)+5
        int_day=mod(pp,7)+1

    end subroutine WHATDAY
!-------------------------------------------------------------------------------
    integer function LEAP_YEAR(yy)
        integer,intent(in)::yy

        LEAP_YEAR=0
        if((mod(yy,400)==0).or.(mod(yy,4)==0.and.mod(yy,100)/=0))LEAP_YEAR=1

    end function LEAP_YEAR
!-------------------------------------------------------------------------------
    subroutine HTML(fnameR,fnameW,yy,mm,str_mm,str_cal)
        character(len=50),intent(in)::fnameR,fnameW
        character(len=9),intent(in)::str_mm(1:12)
        character(len=2),intent(in)::str_cal(1:6,1:7)
        integer,intent(in)::yy,mm
        integer,parameter::nchar=200,nrow=31
        character(len=nchar)::str_com(1:nrow),dummy,wdum
        character(len=4)::dum1
        character(len=2)::dum2
        integer::work1,work2
        integer::i,j,k,io,nd,nw

        open(11,file=fnameR,status='old')
        i=0
        do
            read(11,'(a)',iostat=io) dummy
            if(io<0)exit
            dum1=dummy(1:4)
            dum2=dummy(5:6)
            read(dum1,*) work1
            read(dum2,*) work2
            if(work1==yy.and.work2==mm)then
                i=i+1
                str_com(i)=dummy
            end if
        end do
        close(11)
        nd=i

        write(dum1,'(i4)') yy
        write(dum2,'(i2.2)') mm
        open(12,file=fnameW,status='replace')
        write(12,'(a)') '<!DOCTYPE html>'
        write(12,'(a)') '<html lang="en">'
        write(12,'(a)') '<head>'
        write(12,'(a)') '<meta name="auther" content="WANtaro">'
        write(12,'(a)') '<meta charset="utf-8">'
        write(12,'(a)') '<link rel="stylesheet" type="text/css" href="cscal00.css">'
        write(12,'(a)') '<link rel="stylesheet" type="text/css" href="cscal'//dum2//'.css">'
        write(12,'(a)') '<link rel="shortcut icon" href="png_ctl/favicon.ico">'
        write(12,'(a)') '<title>WANtaroHP (Schedule '//dum2//')</title>'
        write(12,'(a)') '<!--[if lt IE 9]>'
        write(12,'(a)') '<script src="http://html5shim.googlecode.com/svn/trunk/html5.js"></script>'
        write(12,'(a)') '<![endif]-->'
        write(12,'(a)') '</head>'
        write(12,'(a)') '<body>'
        write(12,'()')
        write(12,'(a)') '<nav id="navi">'
        write(12,'(a)') '<form action="cal_main.html"><p><input type="submit" value=" Calender main page "></p></form>'
        write(12,'(a)') '<br>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201301.html">Jan.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201302.html">Feb.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201303.html">Mar.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201304.html">Apr.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201305.html">May.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201306.html">Jun.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201307.html">Jul.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201308.html">Aug.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201309.html">Sep.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201310.html">Oct.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201311.html">Nov.2013</a></p>'
        write(12,'(a)') '<p>&nbsp;&nbsp;<a href="cal_201312.html">Dec.2013</a></p>'
        write(12,'(a)') '</nav><!--***** End of "nav" *****-->'
        write(12,'()')
        write(12,'(a)') '<section id="main">'
        write(12,'()')
        write(12,'(a)') '<div>'
        write(12,'(a)') '<p class="title">'//str_mm(mm)//' ('//dum1//')</p>'
        write(12,'(a)') '<table>'
        write(12,'(a)') '<tr>'
        write(12,'(a)') '<th class="col"><span class="dayN">Monday   </span></th>'
        write(12,'(a)') '<th class="col"><span class="dayN">Tuesday  </span></th>'
        write(12,'(a)') '<th class="col"><span class="dayN">Wednesday</span></th>'
        write(12,'(a)') '<th class="col"><span class="dayN">Thursday </span></th>'
        write(12,'(a)') '<th class="col"><span class="dayN">Friday   </span></th>'
        write(12,'(a)') '<th class="col"><span class="dayB">Saturday </span></th>'
        write(12,'(a)') '<th class="col"><span class="dayR">Sunday   </span></th>'
        write(12,'(a)') '</tr>'
        nw=5
        if(cal(6,1)/=0)nw=6
        do i=1,nw
            write(12,'(a)') '<tr>'
            do j=1,7
                if(j<=5)dum1='dayN'
                if(j==6)dum1='dayB'
                if(j==7)dum1='dayR'
                wdum='<td class="col"><span class="'//dum1//'">'//str_cal(i,j)//'</span><br></td>'
                dum2=str_cal(i,j)
                if(dum2=='  ')dum2=" 0"
                read(dum2,*) work1
                do k=1,nd
                    dummy=str_com(k)
                    dum2=dummy(7:8)
                    read(dum2,*) work2
                    if(work1==work2)then
                        if(10<=index(dummy,'Holiday'))dum1='dayR'
                        wdum='<td class="col"><span class="'//dum1//'">'//str_cal(i,j)//'</span><br>' &
                        & //trim(adjustl(dummy(10:nchar)))//'</td>'
                    end if
                end do
                write(12,'(a)') trim(adjustl(wdum))
            end do
            write(12,'(a)') '</tr>'
        end do
        write(12,'(a)') '</table>'
        write(12,'(a)') '</div>'
        write(12,'()')
        write(12,'(a)') '</section><!--***** End of "main" *****-->'
        write(12,'(a)') '</body>'
        write(12,'(a)') '</html>'

    end subroutine HTML
!-------------------------------------------------------------------------------
    subroutine CSCAL00()
        open(12,file='cscal00.css',status='replace')
        write(12,'(a)') '*{margin:0;padding:0;}'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') '/* Format for body                        */'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') 'body{'
        write(12,'(a)') 'line-height:150%;'
        write(12,'(a)') 'color:#000000;'
        write(12,'(a)') 'background-color:#ffffff;'
        write(12,'(a)') 'font-size:0.9em;'
        write(12,'(a)') 'font-family:arial;'
        write(12,'(a)') '}'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') '/* Main contents                          */'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') '#main{'
        write(12,'(a)') 'margin-top:20px;'
        write(12,'(a)') 'margin-left:200px;'
        write(12,'(a)') 'padding:10px;'
        write(12,'(a)') 'background-color:#ffffff;'
        write(12,'(a)') '}'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') '/* Left Menu                              */'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') '#navi{'
        write(12,'(a)') 'margin-top:10px;'
        write(12,'(a)') 'margin-left:10px;'
        write(12,'(a)') 'padding:10px;'
        write(12,'(a)') 'width:180px;'
        write(12,'(a)') 'position:absolute;'
        write(12,'(a)') 'left:0;'
        write(12,'(a)') 'font-size:1.2em;'
        write(12,'(a)') 'line-height:150%;'
        write(12,'(a)') 'background-color:#ffffff;'
        write(12,'(a)') 'color:#000000;'
        write(12,'(a)') '}'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') '/* Table                                  */'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') 'table{'
        write(12,'(a)') 'margin-left:auto;'
        write(12,'(a)') 'margin-right:auto;'
        write(12,'(a)') 'margin-top:10px;'
        write(12,'(a)') 'margin-bottom:10px;'
        write(12,'(a)') 'font-size:0.85em;'
        write(12,'(a)') 'line-height:110%;'
        write(12,'(a)') '}'
        write(12,'(a)') 'th{'
        write(12,'(a)') 'width:100px;'
        write(12,'(a)') 'text-align:center;'
        write(12,'(a)') 'vertical-align:middle;'
        write(12,'(a)') 'padding-top:3px;'
        write(12,'(a)') 'padding-right:10px;'
        write(12,'(a)') 'padding-bottom:3px;'
        write(12,'(a)') 'padding-left:10px;'
        write(12,'(a)') '}'
        write(12,'(a)') 'td{'
        write(12,'(a)') 'width:100px;'
        write(12,'(a)') 'height:80px;'
        write(12,'(a)') 'text-align:left;'
        write(12,'(a)') 'vertical-align:top;'
        write(12,'(a)') 'padding-top:3px;'
        write(12,'(a)') 'padding-right:10px;'
        write(12,'(a)') 'padding-bottom:3px;'
        write(12,'(a)') 'padding-left:10px;'
        write(12,'(a)') '}'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') '/* Table title                            */'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') 'p.title{'
        write(12,'(a)') 'text-align:center;'
        write(12,'(a)') 'margin-top:10px;'
        write(12,'(a)') 'margin-bottom:10px;'
        write(12,'(a)') 'font-size:2em;'
        write(12,'(a)') 'font-weight:bold;'
        write(12,'(a)') 'font-style:italic;'
        write(12,'(a)') '}'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') '/* Table day                              */'
        write(12,'(a)') '/******************************************/'
        write(12,'(a)') 'span.dayN{'
        write(12,'(a)') 'font-size:large;'
        write(12,'(a)') 'font-weight:bold;'
        write(12,'(a)') 'font-style:italic;'
        write(12,'(a)') 'color:#000000;'
        write(12,'(a)') '}'
        write(12,'(a)') 'span.dayB{'
        write(12,'(a)') 'font-size:large;'
        write(12,'(a)') 'font-weight:bold;'
        write(12,'(a)') 'font-style:italic;'
        write(12,'(a)') 'color:#0000ff;'
        write(12,'(a)') '}'
        write(12,'(a)') 'span.dayR{'
        write(12,'(a)') 'font-size:large;'
        write(12,'(a)') 'font-weight:bold;'
        write(12,'(a)') 'font-style:italic;'
        write(12,'(a)') 'color:#ff0000;'
        write(12,'(a)') '}'
        close(12)
    end subroutine CSCAL00
!-------------------------------------------------------------------------------
end program f90_CALENDER