Files
piscal/dataassim/math/othersupmath/doytotime.f
2022-09-12 16:40:28 +00:00

148 lines
4.1 KiB
FortranFixed

subroutine doytotime(dayfract,fday,fhour,fmin,fsecond)
implicit none
double precision dayfract,fday,fhour,fmin,fsecond,term
fday=dint(dayfract)
term=(dayfract-fday)*24.0d0
fhour=dint(term)
term=(term-fhour)*60.0d0
fmin=dint(term)
fsecond=(term-fmin)*60.0d0
if(dabs(fsecond-60.0d0).lt.1.0d-8)then
fsecond=0.0d0
fmin=fmin+1.0d0
endif
if(dabs(fmin-60.0d0).lt.(1.0d-8/60.0d0))then
fmin=0.0d0
fhour=fhour+1.0d0
endif
if(dabs(fhour).lt.1.0d-8.and.dabs(fmin).lt.1.0d-8.and.
&dabs(fsecond).lt.1.0d-8)then
if(dabs(fday-1.0d0).gt.1.0d-8)then
fday=fday-1.0d0
fhour=24.0d0
fmin=0.0d0
fsecond=0.0d0
endif
endif
return
end
subroutine doy_to_monthday(month,monthday,year,idoy)
!extract month,day of month from year and day of year
implicit none
integer month,monthday,year,idoy,isitaleapyear,
&i,j,k,ndays(12)
ndays(1)=31
ndays(2)=28+isitaleapyear(year)
ndays(3)=31
ndays(4)=30
ndays(5)=31
ndays(6)=30
ndays(7)=31
ndays(8)=31
ndays(9)=30
ndays(10)=31
ndays(11)=30
ndays(12)=31
k=0
do i=1,12
do j=1,ndays(i)
k=k+1
if(k.eq.idoy)then
month=i
monthday=j
return
endif
enddo
enddo
month=99
monthday=99
return
end
subroutine timestamp(iyear,dayfract,month,monthday,idoy,ihour,
&imin,isecond,chartimestamp)
implicit none
integer iyear,month,monthday,idoy,ihour,imin,isecond,itimestamp
double precision dayfract,fday,fhour,fmin,fsecond
character charyear*4,charmonth*2,charmonthday*2,charhour*2,
&charmin*2,charsecond*2,chartimestamp*14
if(dayfract.lt.1.0d0)dayfract=1.0d0
call doytotime(dayfract,fday,fhour,fmin,fsecond)
idoy=idnint(fday)
ihour=idnint(fhour)
imin=idnint(fmin)
isecond=idnint(fsecond)
call doy_to_monthday(month,monthday,iyear,idoy)
call NumberToChar(iyear,4,charyear)
call NumberToChar(month,2,charmonth)
call NumberToChar(monthday,2,charmonthday)
call NumberToChar(ihour,2,charhour)
call NumberToChar(imin,2,charmin)
call NumberToChar(isecond,2,charsecond)
chartimestamp=
&charyear//charmonth//charmonthday//charhour//charmin//charsecond
return
end
subroutine mnmdyeardoy(tenletters,month,monthday,
&year,idoy,yearfract)
!extract month,day of month, year, day of year, and year fraction (e.g. 2007.15) from
!a string of 10 characters in the exact form as 08-21-2010 (mn-md-year)
implicit none
character tenletters*(*),c*1
integer month,monthday,year,idoy,izero,isitaleapyear,
& i,j,k,n,ndays(12),ntotdays,itime(3)
double precision yearfract
do j=1,3
itime(j)=0
enddo
n=len(tenletters)
k=0
j=1
do i=n,1,-1
c=tenletters(i:i)
if(ichar(c).ge.48.and.ichar(c).le.57)then
itime(j)=itime(j)+(ichar(c)-48)*(10**k)
k=k+1
else
if(k.ne.0)j=j+1
k=0
endif
enddo
year=itime(1)
monthday=itime(2)
month=itime(3)
! izero=48
! month=(ichar(tenletters(1:1))-izero)*10
! month=month+(ichar(tenletters(2:2))-izero)
! monthday=(ichar(tenletters(4:4))-izero)*10
! monthday=monthday+(ichar(tenletters(5:5))-izero)
! year=(ichar(tenletters(7:7))-izero)*1000
! year=year+(ichar(tenletters(8:8))-izero)*100
! year=year+(ichar(tenletters(9:9))-izero)*10
! year=year+(ichar(tenletters(10:10))-izero)
ndays(1)=31
ndays(2)=28+isitaleapyear(year)
ndays(3)=31
ndays(4)=30
ndays(5)=31
ndays(6)=30
ndays(7)=31
ndays(8)=31
ndays(9)=30
ndays(10)=31
ndays(11)=30
ndays(12)=31
ntotdays=365+isitaleapyear(year)
idoy=monthday
do i=1,month-1
idoy=idoy+ndays(i)
enddo
yearfract=dble(year)+dble(idoy)/dble(ntotdays)
return
end