!-------------------------------------------------------------------------------
program f90_CALSMALL
!-------------------------------------------------------------------------------
!***********************************
! 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:12,1:6,1:7)
character(len=9)::str_mm(1:12)=(/'January ','February ','March ','April ','May ','June ',&
'July ','August ','September','October ','November ','December '/)
call getarg(1,dummy1)
call getarg(2,fnameW)
read(dummy1,*) yy
do mm=1,12
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
do i=1,6
do j=1,7
cal(i,j)=0
end do
end do
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(mm,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(mm,i,j),j=1,7)
end do
end do
call HTML(fnameW,yy,str_mm,str_cal)
call CSS()
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(fnameW,yy,str_mm,str_cal)
character(len=50),intent(in)::fnameW
character(len=9),intent(in)::str_mm(1:12)
character(len=2),intent(in)::str_cal(1:12,1:6,1:7)
integer,intent(in)::yy
character(len=200)::wdum
character(len=4)::dum1
character(len=2)::dum2
integer::work1,work2
integer::i,j,k,nw,mm
write(dum1,'(i4)') yy
open(12,file=fnameW,status='replace')
write(12,'(a)') ''
write(12,'(a)') ''
write(12,'(a)') '