258 lines
8.4 KiB
Fortran
258 lines
8.4 KiB
Fortran
! =============
|
|
! MODULE CALMOD
|
|
! =============
|
|
|
|
module calmod
|
|
implicit none
|
|
integer :: mondays(0:12) = (/0,31,28,31,30,31,30,31,31,30,31,30,31/)
|
|
integer :: monaccu(0:12)
|
|
integer :: ny400d = 400 * 365 + 97
|
|
integer :: ny100d = 100 * 365 + 24
|
|
integer :: ny004d = 4 * 365 + 1
|
|
integer :: ny001d = 365
|
|
|
|
end module calmod
|
|
|
|
|
|
! =================
|
|
! FUNCTION NWEEKDAY
|
|
! =================
|
|
|
|
integer function nweekday(kday)
|
|
nweekday = mod(kday+6,7)
|
|
return
|
|
end
|
|
|
|
! ===================
|
|
! SUBROUTINE STEP2CAL
|
|
! ===================
|
|
|
|
subroutine step2cal(kstep,ktspd,kyea,kmon,kday,khou,kmin)
|
|
use calmod
|
|
implicit none
|
|
integer, intent(IN ) :: kstep ! time step since simulation start
|
|
integer, intent(IN ) :: ktspd ! time steps per day
|
|
integer, intent(OUT) :: kyea ! current year of simulation
|
|
integer, intent(OUT) :: kmon ! current month of simulation
|
|
integer, intent(OUT) :: kday ! current day of simulation
|
|
integer, intent(OUT) :: khou ! current hour of simulation
|
|
integer, intent(OUT) :: kmin ! current minute of simulation
|
|
|
|
integer :: idall
|
|
integer :: istp
|
|
integer :: iy400,id400
|
|
integer :: iy100,id100
|
|
integer :: iy004,id004
|
|
integer :: iy001,id001
|
|
integer :: jmon
|
|
|
|
logical :: leap
|
|
|
|
idall = kstep / ktspd
|
|
|
|
iy400 = idall / ny400d ! segment [of 400 years]
|
|
id400 = mod(idall,ny400d)
|
|
|
|
if (id400 <= ny100d) then ! century year is leap year
|
|
iy100 = 0 ! century in segment [0]
|
|
id100 = id400
|
|
iy004 = id100 / ny004d ! tetrade in century [0..24]
|
|
id004 = mod(id100 , ny004d)
|
|
leap = (id004 <= ny001d)
|
|
if (leap) then
|
|
iy001 = 0 ! year in tetrade [0]
|
|
id001 = id004
|
|
else
|
|
iy001 = (id004-1)/ny001d ! year in tetrade [1,2,3]
|
|
id001 = mod(id004-1, ny001d)
|
|
endif
|
|
else ! century year is not leap year
|
|
iy100 = (id400-1)/ny100d ! century in segment [1,2,3]
|
|
id100 = mod(id400-1, ny100d)
|
|
if (id100 < ny004d-1) then
|
|
iy004 = 0 ! tetrade in century [0]
|
|
id004 = id100
|
|
leap = .false.
|
|
iy001 = id004/ny001d ! year in tetrade [1,2,3]
|
|
id001 = mod(id004,ny001d)
|
|
else
|
|
iy004 = (id100+1)/ny004d ! tetrade in century [1..24]
|
|
id004 = mod(id100+1,ny004d)
|
|
leap = (id004 <= ny001d)
|
|
if (leap) then
|
|
iy001 = 0 ! year in tetrade [0]
|
|
id001 = id004
|
|
else
|
|
iy001 = (id004-1)/ny001d
|
|
id001 = mod(id004-1, ny001d)
|
|
endif
|
|
endif
|
|
endif
|
|
|
|
kyea = iy400 * 400 + iy100 * 100 + iy004 * 4 + iy001
|
|
! print *,"yea ",kyea,iy400,iy100,iy004,iy001,id004,ny001d
|
|
|
|
monaccu(0) = mondays(0)
|
|
monaccu(1) = mondays(1)
|
|
monaccu(2) = mondays(1) + mondays(2)
|
|
if (leap) monaccu(2) = monaccu(2) + 1
|
|
do jmon = 3 , 12
|
|
monaccu(jmon) = monaccu(jmon-1) + mondays(jmon)
|
|
enddo
|
|
kmon = 1
|
|
id001 = id001 + 1
|
|
do while (id001 > monaccu(kmon))
|
|
kmon = kmon + 1
|
|
enddo
|
|
kday = id001 - monaccu(kmon-1)
|
|
|
|
istp = mod(kstep,ktspd)
|
|
kmin = (istp * 1440) / ktspd
|
|
khou = kmin / 60
|
|
kmin = mod(kmin,60)
|
|
|
|
return
|
|
end subroutine step2cal
|
|
|
|
! ===================
|
|
! SUBROUTINE CAL2STEP
|
|
! ===================
|
|
|
|
subroutine cal2step(kstep,ktspd,kyea,kmon,kday,khou,kmin)
|
|
use calmod
|
|
implicit none
|
|
integer, intent(OUT) :: kstep ! time step since simulation start
|
|
integer, intent(IN ) :: ktspd ! time steps per day
|
|
integer, intent(IN ) :: kyea ! current year of simulation
|
|
integer, intent(IN ) :: kmon ! current month of simulation
|
|
integer, intent(IN ) :: kday ! current day of simulation
|
|
integer, intent(IN ) :: khou ! current hour of simulation
|
|
integer, intent(IN ) :: kmin ! current minute of simulation
|
|
|
|
integer :: idall
|
|
integer :: ilp
|
|
integer :: iy400,id400
|
|
integer :: iy100,id100
|
|
integer :: iy004,id004
|
|
integer :: jmon
|
|
|
|
logical :: leap
|
|
|
|
iy400 = kyea / 400 ! segment [400]
|
|
id400 = mod(kyea ,400) ! year in segment [0..399]
|
|
iy100 = id400 / 100 ! century [0,1,2,3]
|
|
id100 = mod(id400,100) ! year in century [0..99]
|
|
iy004 = id100 / 4 ! tetrade [0..24]
|
|
id004 = mod(id100, 4) ! year in tetrade [0,1,2,3]
|
|
|
|
leap = (id004 == 0 .and. (id100 /= 0 .or. id400 == 0))
|
|
|
|
ilp = -1
|
|
if (id004 > 0) ilp = ilp + 1
|
|
if (iy100 > 0 .and. id100 == 0 ) ilp = ilp + 1
|
|
|
|
monaccu(0) = mondays(0)
|
|
monaccu(1) = mondays(1)
|
|
monaccu(2) = mondays(1) + mondays(2)
|
|
if (leap) monaccu(2) = monaccu(2) + 1
|
|
do jmon = 3 , 12
|
|
monaccu(jmon) = monaccu(jmon-1) + mondays(jmon)
|
|
enddo
|
|
|
|
idall = iy400 * ny400d + iy100 * ny100d + iy004 * ny004d &
|
|
+ id004 * ny001d + monaccu(kmon-1)+ kday + ilp
|
|
kstep = ktspd * idall + (ktspd * (khou * 60 + kmin)) / 1440
|
|
|
|
return
|
|
end subroutine cal2step
|
|
|
|
! =====================
|
|
! SUBROUTINE STEP2CAL30
|
|
! =====================
|
|
|
|
subroutine step2cal30(kstep,ktspd,kyea,kmon,kday,khou,kmin)
|
|
use calmod
|
|
implicit none
|
|
integer, intent(IN ) :: kstep ! time step since simulation start
|
|
integer, intent(IN ) :: ktspd ! time steps per day
|
|
integer, intent(OUT) :: kyea ! current year of simulation
|
|
integer, intent(OUT) :: kmon ! current month of simulation
|
|
integer, intent(OUT) :: kday ! current day of simulation
|
|
integer, intent(OUT) :: khou ! current hour of simulation
|
|
integer, intent(OUT) :: kmin ! current minute of simulation
|
|
|
|
integer :: idall
|
|
integer :: istp
|
|
|
|
idall = kstep / ktspd
|
|
kyea = idall / 360
|
|
idall = mod(idall,360)
|
|
kmon = idall / 30 + 1
|
|
kday = mod(idall, 30) + 1
|
|
istp = mod(kstep,ktspd)
|
|
kmin = (istp * 1440) / ktspd
|
|
khou = kmin / 60
|
|
kmin = mod(kmin,60)
|
|
|
|
return
|
|
end subroutine step2cal30
|
|
|
|
! =====================
|
|
! SUBROUTINE CAL2STEP30
|
|
! =====================
|
|
|
|
subroutine cal2step30(kstep,ktspd,kyea,kmon,kday,khou,kmin)
|
|
use calmod
|
|
implicit none
|
|
integer, intent(OUT) :: kstep ! time step since simulation start
|
|
integer, intent(IN ) :: ktspd ! time steps per day
|
|
integer, intent(IN ) :: kyea ! current year of simulation
|
|
integer, intent(IN ) :: kmon ! current month of simulation
|
|
integer, intent(IN ) :: kday ! current day of simulation
|
|
integer, intent(IN ) :: khou ! current hour of simulation
|
|
integer, intent(IN ) :: kmin ! current minute of simulation
|
|
|
|
kstep = ktspd * (kyea * 360 + (kmon-1) * 30 + kday - 1) &
|
|
+(ktspd * (khou * 60 + kmin)) / 1440
|
|
|
|
return
|
|
end subroutine cal2step30
|
|
|
|
program caltest
|
|
use calmod
|
|
parameter (nstep=100)
|
|
do istep = 1 , nstep
|
|
call step2cal(istep,32,iyy,imm,idd,ihh,imi)
|
|
call cal2step(jstep,32,iyy,imm,idd,ihh,imi)
|
|
if (imm==2 .and. idd > 28 .and. ihh == 0 .and. imi == 0) &
|
|
write (*,1000) istep,jstep,istep/32+1,iyy,imm,idd,ihh,imi
|
|
! if (iyy == 3 .and. imm == 12) &
|
|
! write (*,1000) istep,jstep,istep/32+1,iyy,imm,idd,ihh,imi
|
|
! if (istep > 1215470) &
|
|
! write (*,1000) istep,jstep,istep/32+1,iyy,imm,idd,ihh,imi
|
|
if (istep /= jstep) then
|
|
write (*,1000) istep,jstep,istep/32+1,iyy,imm,idd,ihh,imi
|
|
stop
|
|
endif
|
|
enddo
|
|
1000 format(2i10,i8,i5,i3,i3,i3,i3)
|
|
print *,'monaccu'
|
|
do j = 0,12
|
|
print '(i2,i4)',j,monaccu(j)
|
|
enddo
|
|
print *,'monaccu'
|
|
print *,'enter date1 (YYYY MM DD)'
|
|
read (*,'(i4,i3,i3)') iy1,im1,id1
|
|
print *,'enter date2 (YYYY MM DD)'
|
|
read (*,'(i4,i3,i3)') iy2,im2,id2
|
|
|
|
call cal2step(istep1,32,iy1,im1,id1,0,0)
|
|
call cal2step(istep2,32,iy2,im2,id2,0,0)
|
|
idd = (istep2-istep1)/32
|
|
idy = idd / 365
|
|
print *,idd,' Days or ',idy,' Years'
|
|
print *,'Weekday is ',nweekday(istep1/32)
|
|
print *,'Weekday is ',nweekday(istep2/32)
|
|
stop
|
|
end
|