# 利用蔡勒公式获得给定日期的星期数

```Integer Function GetWeekByDate( y , mon , day ) result( week )
Implicit None
Integer , Intent( IN ) :: y , mon , day
integer :: month , year , y12 , y34
integer :: A,B,C,D
If ( mon==1 .or. mon==2 ) Then
month = mon + 12 ! If January or Febrary,regarding it as 13 or 14
year  = y - 1  !Then the year should minus one
Else
month = mon
year  = y
End If          !e.g. 2012-01-01 is regarding as 2011-13-1
y12=year/100
y34=year-y12*100
A=int(y34/4.0)
B=int(y12/4.0)
C=2*y12
D=int(26*(month+1)/10.0)
week=abs(mod((y34+A+B-C+D+day-1),7))
End Function GetWeekByDate
!This program is mainly to obtain the weekday according to date
Program www_fcode_cn
Implicit None
Character(len=64)::str=''
Integer::year,month,day,week,GetWeekByDate
Character(len=*) , parameter :: WeekCn = "日一二三四五六"
Character(len=9) , parameter :: WeekEn(0:6) = &
["Sunday   ","Monday   ","Tuesday  ","Wednesday","Thursday ","Friday   ","Saturday "]
Character(len=12)::time(3)
Integer::date_time(8)
Logical::t= .true.

Do
Call date_and_time(time(1), time(2), time(3), date_time) ! Obtain the date of today
year =date_time(1) !Get the year of today
month=date_time(2) !Get the month of today
day  =date_time(3) !Get the day of today
Call GetDate("Input the date(e.g. 2008 8 8, Press 'Enter' is today )",&
year,month,day) ! Press 'Enter' for today or input by yourself
Call JudgeDate( str,year ) ! Judge the common and leap year
Call Judgeyear(year,month,day,t)  !Judge the year whether reasonable or not
If (.not.t) then
Write(*,"(a)") "Congratuation! Before 1582-10-15 doesn't exist the concept of date."
Exit
End if
Call Judgemonth(month,t) !Judge the month whether reasonable or not
If (.not.t) then
Write(*,"(a,g0,1x,a)") 'Are you kidding? You creat the month of ',month,'?!'
Exit
End if
Call Judgeday(str,year,month,day,t) !Judge the day whether reasonable or not
If (.not.t) then
Write(*,"(a,g0,a,g0,1x,a,1x,g0,1x,a)") "Don't you really think the date ",year,'-',month, "has",day, "days?!"
Exit
End if
week = GetWeekByDate( year , month , day )
Select Case(week)
Case(0:6)
Write(*,*) '今天是星期',WeekCn(week*2+1:week*2+2),'(Today is ',WeekEn(week),')'
Case Default
Write(*,*) 'error!please reput the correct year,month or day.'
End Select
Write(*,*) 'press q to exit,otherwise any other keys to continue'
If (str=='q') Exit
End Do
End Program www_fcode_cn

Subroutine GetDate( cStr, year, month, day )
Implicit none
Character(len=*) , intent(in)::cStr
Integer ::year,month,day
Integer input_year,input_month,input_day,ierr
If (len_trim(cRead)<=0) then   !Press 'Enter', then get today
write(*,"(g0,a,g0,a,g0)") year,'-',month,'-',day
End if
If (ierr==0) then !The date obtaining through inputing by yourself
year=input_year
month=input_month
day=input_day
Write(*,"(g0,a,g0,a,g0)") year,'-',month,'-',day
End if
End subroutine GetDate

Subroutine JudgeDate(str,in_year)
Implicit none
Integer,intent(in)::in_year
Integer judgement1,judgement2,judgement3
Character(len=60)::str
judgement1=mod(in_year,400)
judgement2=mod(in_year,100)
judgement3=mod(in_year,4)
If (judgement2==0) then
If (judgement1==0) then
str='leap'
Else
str='common'
End if
Else
If (judgement3==0) then
str='leap'
Else
str='common'
Endif
End if
End subroutine JudgeDate

Subroutine Judgeyear(year,month,day,t)
Implicit none
Logical t
Integer year,month,day
t = .true.
If (year<1582) then
t=.false.
Return
Elseif (year==1582 .and. month<10 ) then
t=.false.
Return
Elseif (year==1582 .and. month==10 .and. day<15) then
t=.false.
Return
End if
End subroutine Judgeyear

Subroutine Judgemonth(month,t)
Implicit none
Logical t
Integer month
t =  .not.(month>12 .or. month<1 )
End subroutine Judgemonth

Subroutine Judgeday(str,year,month,day,t)
Implicit none
Integer year,month,day
Character(len=60),intent(in)::str
Integer , save :: DayOfMonth(12) = [31,28,31,30,31,30,31,31,30,31,30,31]
Logical t
if ( trim(str)=='leap' ) then
DayOfMonth(2) = 29
else
DayOfMonth(2) = 28
end if
t = .not.( day<1 .or. day> DayOfMonth(month) )
End subroutine Judgeday``` 