SUBROUTINE drv_timestamp(o_iyr,o_mth,o_day,o_nhr,o_min,o_sec, & iyr,mth,day,nhr,min,sec,seconds,julian,flag) !====================================================================== ! Description: Convert between Y/M/D H:M:S and seconds from origin ! flag = 's' convert date to seconds and julian ! flag = 'd' convert seconds to date and julian ! Note: This only works for 1901-2099! ! Aug 2001 P. Dirmeyer ! $Log: drv_timestamp.f90,v $ ! Revision 1.1 2002/08/19 18:54:37 guo ! Initial revision ! !====================================================================== IMPLICIT NONE INTEGER,PARAMETER :: hipr=SELECTED_REAL_KIND(13) INTEGER, INTENT(INOUT) :: iyr ! calendar year INTEGER, INTENT(INOUT) :: mth ! calendar month INTEGER, INTENT(INOUT) :: day ! calendar day INTEGER, INTENT(INOUT) :: nhr ! calendar hour INTEGER, INTENT(INOUT) :: min ! calendar minute INTEGER, INTENT(INOUT) :: sec ! calendar second REAL(KIND=hipr), INTENT(INOUT) :: seconds ! seconds from origin time INTEGER, INTENT(OUT) :: julian ! julian day of year CHARACTER(LEN=1), INTENT(IN) :: flag !** Origin time INTEGER, INTENT(IN) :: o_iyr INTEGER, INTENT(IN) :: o_mth INTEGER, INTENT(IN) :: o_day INTEGER, INTENT(IN) :: o_nhr INTEGER, INTENT(IN) :: o_min INTEGER, INTENT(IN) :: o_sec !** Other internal variables REAL (KIND=hipr) :: d_iyr, d_mth, d_day, d_nhr, d_min, d_sec INTEGER :: leap, s_iyr, e_iyr, s_mth, e_mth, off, msum INTEGER :: i INTEGER, DIMENSION(12) :: monlen= (/ 31,28,31,30,31,30,31,31,30,31,30,31 /) REAL (KIND=hipr) :: work !***** Given date, find seconds from origin if (flag == 's' .or. flag == 'S') then seconds = 0.0 !*** Second d_sec = sec - o_sec !*** Minute d_min = (min - o_min) * 60. !*** Hour d_nhr = (nhr - o_nhr) * 60. * 60. !*** Day d_day = (day - o_day) * 24. * 60. * 60. !*** Month d_mth = mth - o_mth msum = 0 if (d_mth > 0) then do i = 1, d_mth off = MOD(o_mth+i-2,12) + 1 msum = msum + monlen(off) enddo elseif (d_mth < 0) then do i = d_mth, -1 off = MOD(o_mth+i+11,12) + 1 msum = msum - monlen(off) enddo endif d_mth = msum * 24. * 60. * 60. !*** Year leap = 0 if (o_iyr == iyr) then if (MOD(o_iyr,4) == 0) then if (o_mth < 3 .and. mth > 2) leap = 1 if (o_mth > 2 .and. mth < 3) leap = -1 endif else s_iyr = o_iyr e_iyr = iyr s_mth = o_mth e_mth = mth if (o_iyr > iyr) then s_iyr = iyr e_iyr = o_iyr s_mth = mth e_mth = o_mth endif if (MOD(s_iyr,4) == 0 .and. s_mth < 3) leap = leap + 1 if (MOD(e_iyr,4) == 0 .and. e_mth > 2) leap = leap + 1 if (e_iyr-s_iyr > 1) then do i=s_iyr+1,e_iyr-1 if (MOD(i,4) == 0) leap = leap + 1 enddo endif if (o_iyr > iyr) leap = -leap endif d_iyr = ((iyr - o_iyr) * 365 + leap) * 24. * 60. * 60. seconds = d_iyr + d_mth + d_day + d_nhr + d_min + d_sec !***** Given seconds from origin, find date elseif (flag == 'd' .or. flag == 'D') then !*** Second work = seconds d_sec = DMOD(work,60._hipr) !*** Minute work = (work - d_sec)/60._hipr d_min = MOD(int(work),60) !*** Hour work = (work - d_min)/60. d_nhr = MOD(int(work),24) !*** Day work = (work - d_nhr)/24. d_day = work !*** Second part 2 sec = o_sec + d_sec if (sec < 0) then sec = sec + 60 d_min = d_min - 1 endif if (sec >= 60) then sec = sec - 60 d_min = d_min + 1 endif !*** Minute part 2 min = o_min + d_min if (min < 0) then min = min + 60 d_nhr = d_nhr - 1 endif if (min >= 60) then min = min - 60 d_nhr = d_nhr + 1 endif !*** Hour part 2 nhr = o_nhr + d_nhr if (nhr < 0) then nhr = nhr + 24 d_day = d_day - 1 endif if (nhr >= 24) then nhr = nhr - 24 d_day = d_day + 1 endif !*** Day, Month, Year leap = 0 day = o_day mth = o_mth iyr = o_iyr if (d_day > 0.0_hipr) then do while (d_day > 0.0_hipr) d_day = d_day - monlen(mth) if (mth == 2 .and. MOD(iyr,4) == 0) then d_day = d_day - 1._hipr leap = leap + 1 endif mth = mth + 1 if (mth > 12) then mth = 1 iyr = iyr + 1 endif enddo day = day + d_day if (day < 1) then mth = mth - 1 if (mth < 1) then mth = 12 iyr = iyr - 1 endif day = monlen(mth) + day if (mth == 2 .and. MOD(iyr,4) == 0) then day = day + 1 leap = leap - 1 endif elseif (day > monlen(mth)) then day = day - monlen(mth) if (mth == 2 .and. MOD(iyr,4) == 0) then day = day - 1 leap = leap + 1 if (day == 0) then ! special case when you hit 29 Feb on the nose day = 29 mth = mth - 1 endif endif mth = mth + 1 if (mth > 12) then !this should never be invoked, since Dec has max days (31) mth = 1 iyr = iyr + 1 endif endif else do while (d_day < 0.0_hipr) mth = mth - 1 if (mth == 2 .and. MOD(iyr,4) == 0) then d_day = d_day + 1._hipr leap = leap - 1 endif if (mth < 1) then mth = 12 iyr = iyr - 1 endif d_day = d_day + monlen(mth) enddo day = day + d_day if (mth == 2 .and. MOD(iyr,4) == 0 .and. day == 29) then else if (day > monlen(mth)) then day = day - monlen(mth) if (mth == 2 .and. MOD(iyr,4) == 0) then day = day - 1 leap = leap + 1 endif mth = mth + 1 if (mth > 12) then mth = 1 iyr = iyr + 1 endif endif endif endif ! print *,seconds, d_iyr , d_mth , d_day , d_nhr , d_min , d_sec else write(6,*) ' SUBROUTINE timestamp : unknown flag = ',flag stop 'timestamp' endif !*** Do the julian day julian = 0 IF (mth > 1) then DO i= 1,mth-1 julian= julian + monlen(i) ENDDO ENDIF julian = julian + day IF (mth > 2 .and. MOD(iyr,4) == 0) julian = julian + 1 ! write(6,1000)iyr,mth,day,nhr,min,sec,julian,seconds,leap 1000 format('Timestamp: ',i5,3i3,2(':',i2.2),' - ',i4,' - ',f14.1,i3) END SUBROUTINE drv_timestamp