SUBROUTINE NEXTIME ( JDATE , JTIME, DTIME ) C..................................................................... C Version "$Id: nextime.F 88 2018-03-16 17:43:05Z coats $" C EDSS/Models-3 I/O API. C Copyright (C) 1992-2002 MCNC and Carlie J. Coats, Jr., and C (C) 2003-2010 Baron Advanced Meteorological Systems, C (C) 2007-2013 Carlie J. Coats, Jr., and C (C) 2015 UNC Institute for the Environment. C Distributed under the GNU LESSER GENERAL PUBLIC LICENSE version 2.1 C See file "LGPL.txt" for conditions of use. C......................................................................... C subroutine body starts approx line 74 C C FUNCTION: C C Subroutine to add DTIME to the current time, and then C update the clock JTIME and calendar IDATE accordingly. C Output is fully normalized (0 <= JTIME <= 235959). C C IDATE is stored in the form YYYYDDD = YEAR*1000 + DAY C JTIME is stored in the form HHMMSS = HOUR*10000 + MINS*100 + SECS C DTIME is stored in the form HHMMSS = HOUR*10000 + MINS*100 + SECS C C CALLS: none C C REVISION HISTORY: C prototype 10/1990 by Carlie J. Coats, Jr., MCNC Environmental Programs C C Version 3/1993 by CJC for CRAY, etc. C C Bugfix 1/2002 by CJC: stepping _backwards_ across a year C transition C C Unification 2/2002 by CJC with global-climate DAYMON, which C uses a 360-day "year" C C Unification 2/2002 by CJC with global-climate DAYMON, which C uses a 360-day "year" C C Version 5/2005 by CJC: special case for time-independent data C (necessary for date:time=0000000:000000 normalization in CRTFIL3()) C C Version 1/2007 by CJC: handle negative JDATEs correctly C C Modified 03/2010 by CJC: F9x changes for I/O API v3.1 C C Modified 11/2015 by CJC: IO_365 changes C C Modified 07/2016 by CJC: Bug-fix in LASTTIME() C........................................................................ IMPLICIT NONE C....... ARGUMENTS: INTEGER, INTENT(INOUT) :: JDATE ! date (encoded YYYYDDD) INTEGER, INTENT(INOUT) :: JTIME ! time (encoded HHMMSS) INTEGER, INTENT(IN ) :: DTIME ! time increment (encoded HHMMSS) C....... LOCAL VARIABLES: day and year components of date INTEGER IBIAS, IDATE INTEGER YEAR ! year-component of IDATE INTEGER DAYS ! day-component of IDATE INTEGER HOUR ! hours-component of JTIME INTEGER MINS ! minutes-component of JTIME INTEGER SECS ! seconds-component of JTIME INTEGER SCR ! scratch accumulator INTEGER SIGN ! sign of DTIME INTEGER ATIME ! absolute value of DTIME #ifdef IO_360 #define CLIMODAYS (360) #endif #ifdef IO_365 #define CLIMODAYS (365) #endif C........................................................................ C begin NEXTIME C....... Increment seconds part of JTIME by DTIME (secs), and C....... re-normalize minute, hour, day part of IDATE:JTIME IF ( DTIME .GE. 0 ) THEN ATIME = DTIME SIGN = 1 ELSE ATIME = - DTIME SIGN = - 1 END IF SECS = MOD ( JTIME , 100 ) + SIGN * MOD ( ATIME , 100 ) IF ( SECS .GE. 0 ) THEN SCR = SECS / 60 ELSE SCR = - ( 60 - SECS ) / 60 END IF SECS = SECS - SCR * 60 MINS = SCR + MOD ( JTIME / 100 , 100 ) & + SIGN * MOD ( ATIME / 100 , 100 ) IF ( MINS .GE. 0 ) THEN SCR = MINS / 60 ELSE SCR = - ( 60 - MINS ) / 60 END IF MINS = MINS - SCR * 60 HOUR = JTIME / 10000 + SIGN * ( ATIME / 10000 ) + SCR DAYS = 0 IF ( HOUR .LT. -23 ) THEN SCR = -HOUR / 24 HOUR = HOUR + SCR * 24 DAYS = DAYS - SCR END IF IF ( HOUR .LT. 0 ) THEN SCR = ( 24 - HOUR ) / 24 HOUR = HOUR + SCR * 24 DAYS = DAYS - SCR ELSE IF ( HOUR .GT. 23 ) THEN SCR = HOUR / 24 HOUR = HOUR - SCR * 24 DAYS = DAYS + SCR END IF JTIME = 10000 * HOUR + 100 * MINS + SECS IF ( DAYS .EQ. 0 .AND. JDATE .EQ. 0 ) THEN RETURN END IF C....... Construct equivalent problem with positive IDATE = JDATE + IBIAS IF ( JDATE .GE. 2000 ) THEN IDATE = JDATE IBIAS = 0 ELSE IF ( JDATE .GE. -2000 ) THEN !! standard-year processing IDATE = JDATE + 3000 DAYS = DAYS + MOD ( IDATE , 1000 ) YEAR = IDATE / 1000 - 3 JDATE = 1000 * YEAR + DAYS RETURN ELSE ! adjust date by multiple of 400-year leap-year cycle YEAR = ABS( JDATE ) YEAR = YEAR / 1000 + 1 YEAR = 400 * ( YEAR / 400 + 1 ) IBIAS = 1000 * YEAR IDATE = JDATE + IBIAS END IF C........... Update IDATE: C........... Note that each year must be treated individually DAYS = DAYS + MOD ( IDATE , 1000 ) YEAR = IDATE / 1000 100 CONTINUE ! loop normalizing negative day numbers IF ( DAYS .LE. 0 ) THEN #ifdef CLIMODAYS DAYS = CLIMODAYS + DAYS YEAR = YEAR - 1 #endif #ifndef CLIMODAYS IF ( ( MOD (YEAR,4) .NE. 1 ) ! nonleap year & .OR. ( ( MOD (YEAR,100) .EQ. 1 ) & .AND. ( MOD (YEAR,400) .NE. 1 ) ) ) THEN DAYS = 365 + DAYS YEAR = YEAR - 1 ELSE ! leap-year case DAYS = 366 + DAYS YEAR = YEAR - 1 END IF #endif GO TO 100 END IF 200 CONTINUE ! loop normalizing day numbers > 365,366 #ifdef CLIMODAYS IF ( DAYS .GE. CLIMODAYS+1 ) THEN DAYS = DAYS - CLIMODAYS YEAR = YEAR + 1 GO TO 200 END IF ! end DAYS > 365,366 date-normalization loop #endif #ifndef CLIMODAYS IF ( DAYS .GE. 366 ) THEN IF ( ( MOD (YEAR,4) .NE. 0 ) ! nonleap year & .OR. ( ( MOD (YEAR,100) .EQ. 0 ) & .AND. ( MOD (YEAR,400) .NE. 0 ) ) ) THEN DAYS = DAYS - 365 YEAR = YEAR + 1 GO TO 200 ELSE IF ( DAYS .GE. 367 ) THEN ! leap year case DAYS = DAYS - 366 YEAR = YEAR + 1 GO TO 200 END IF END IF ! end DAYS > 365,366 date-normalization loop #endif JDATE = 1000 * YEAR + DAYS - IBIAS IF ( JDATE .EQ. -635 ) JDATE = 0 !! for standard-week/month/year accounting RETURN END SUBROUTINE NEXTIME !!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- SUBROUTINE LASTTIME( SDATE,STIME,TSTEP,NRECS, EDATE,ETIME ) IMPLICIT NONE C....... ARGUMENTS: INTEGER, INTENT(IN ) :: SDATE, STIME, TSTEP, NRECS INTEGER, INTENT( OUT) :: EDATE, ETIME C....... PARAMETERs: INTEGER, PARAMETER :: S365 = 365 * 24 * 60 * 60 !! seconds INTEGER, PARAMETER :: T365 = 365 * 24 * 10000 !! time as H*MMSS !!....... EXTERNAL Functions: INTEGER, EXTERNAL :: SEC2TIME, TIME2SEC !!....... LOCAL VARIABLES: day and year components of date INTEGER ISEC, STEP INTEGER*8 IREC, SECS !! Normalized copies of the arguments: EDATE = SDATE ETIME = STIME CALL NEXTIME( EDATE, ETIME, 0 ) IF ( TSTEP .EQ. 0 ) THEN ! time-independent case: RETURN ELSE IF ( NRECS .LE. 1 ) THEN ! at most 1 record RETURN END IF IREC = NRECS - 1 SECS = IREC * TIME2SEC( ABS( TSTEP ) ) DO IF ( SECS .LT. S365 ) EXIT SECS = SECS - S365 CALL NEXTIME( EDATE, ETIME, T365 ) END DO ISEC = SECS STEP = SEC2TIME( ISEC ) CALL NEXTIME( EDATE, ETIME, STEP ) RETURN END SUBROUTINE LASTTIME