!------------------------------------------------------------------------------- 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)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') 'WANtaroHP (calender '//dum1//')' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'()') write(12,'(a)') '

' write(12,'(a)') '
' write(12,'()') write(12,'(a)') '

'//dum1//' Calender

' write(12,'(a)') '
' do mm=1,12 write(12,'(a)') '
' write(12,'(a)') '

'//str_mm(mm)//'

' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' write(12,'(a)') '' nw=6 do i=1,nw write(12,'(a)') '' do j=1,7 if(j<=5)dum1='dayN' if(j==6)dum1='dayB' if(j==7)dum1='dayR' dum2=str_cal(mm,i,j) wdum='' write(12,'(a)') trim(adjustl(wdum)) end do write(12,'(a)') '' end do write(12,'(a)') '
MTWTFSS
'//dum2//'
' write(12,'(a)') '
' if(mm==4.or.mm==8.or.mm==12)write(12,'(a)') '
' end do write(12,'()') write(12,'(a)') '' write(12,'(a)') '' end subroutine HTML !------------------------------------------------------------------------------- subroutine CSS() open(12,file='cscalsmall.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)') '/* 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:5px;' write(12,'(a)') 'margin-bottom:5px;' write(12,'(a)') 'font-size:1.0em;' write(12,'(a)') 'line-height:100%;' write(12,'(a)') '}' write(12,'(a)') 'th{' write(12,'(a)') 'text-align:center;' write(12,'(a)') 'vertical-align:middle;' write(12,'(a)') 'padding-top:2px;' write(12,'(a)') 'padding-right:2px;' write(12,'(a)') 'padding-bottom:2px;' write(12,'(a)') 'padding-left:2px;' write(12,'(a)') '}' write(12,'(a)') 'td{' write(12,'(a)') 'text-align:center;' write(12,'(a)') 'vertical-align:middle;' write(12,'(a)') 'padding-top:2px;' write(12,'(a)') 'padding-right:2px;' write(12,'(a)') 'padding-bottom:2px;' write(12,'(a)') 'padding-left:2px;' write(12,'(a)') '}' write(12,'(a)') '/******************************************/' write(12,'(a)') '/* Table day */' write(12,'(a)') '/******************************************/' write(12,'(a)') 'span.dayN{' 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-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-weight:bold;' write(12,'(a)') 'font-style:italic;' write(12,'(a)') 'color:#ff0000;' 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:2px;' write(12,'(a)') 'margin-bottom:2px;' write(12,'(a)') 'font-size:1.2em;' write(12,'(a)') 'font-weight:bold;' write(12,'(a)') 'font-style:italic;' write(12,'(a)') '}' write(12,'(a)') '/******************************************/' write(12,'(a)') '/* Format for picture grid */' write(12,'(a)') '/******************************************/' write(12,'(a)') '.unit{clear:both;}' write(12,'(a)') '.grid{' write(12,'(a)') 'float:left;' write(12,'(a)') 'margin-right:auto;' write(12,'(a)') 'margin-left:auto;' write(12,'(a)') 'width:180px;' write(12,'(a)') 'text-align:center;' write(12,'(a)') '}' write(12,'(a)') '.grid p{margin:0;line-height:100%;}' write(12,'(a)') '.grid a{text-decoration:none;}' close(12) end subroutine CSS !------------------------------------------------------------------------------- end program f90_CALSMALL