1 !------------------------------------------------------------------------- 2 ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! 3 !------------------------------------------------------------------------- 4 !BOI 5 ! 6 ! !TITLE: Returns a new date/time from an initial date/time and offset 7 ! 8 ! !AUTHORS: Rob Lucchesi 9 ! 10 ! !AFFILIATION: Data Assimilation Office, NASA/GSFC, Greenbelt, MD 20771 11 ! 12 ! !DATE: July 20, 1998 13 ! 14 !EOI 15 !------------------------------------------------------------------------- 16 !------------------------------------------------------------------------- 17 ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! 18 !------------------------------------------------------------------------- 19 !BOP 20 ! 21 ! !ROUTINE: GetDate --- Returns a new date/time from an initial date/time 22 ! and offset 23 ! 24 ! !INTERFACE: 25 ! 26 27 subroutine GetDate (yyyymmdd_1,hhmmss_1,offset, 28 . yyyymmdd_2,hhmmss_2,rc) 29 30 ! 31 ! !USES: 32 ! 33 34 implicit none 35 36 ! 37 ! !INPUT PARAMETERS: 38 ! 39 40 integer yyyymmdd_1 ! Initial date in YYYYYMMDD format 41 integer hhmmss_1 ! Initial time in HHMMSS format 42 integer offset ! Offset to add (in seconds) 43 44 ! 45 ! !OUTPUT PARAMETERS: 46 ! 47 integer yyyymmdd_2 ! New date in YYYYMMDD format 48 integer hhmmss_2 ! New time in HHMMSS format 49 integer rc ! Return code. (<0 = error) 50 ! 51 ! !DESCRIPTION: This subroutine returns a new date and time in yyyymmdd 52 ! and hhmmss format given and initial date, time, and 53 ! offset in seconds. The routine converts the input date 54 ! and time to julian seconds, adds the offset, and converts 55 ! back to yyyymmdd and hhmmss format. This routine has been 56 ! tested for Y2K compiance. 57 ! 58 ! !REVISION HISTORY: 59 ! 60 ! 1998.07.20 Lucchesi Initial version. 61 ! 62 !EOP 63 !------------------------------------------------------------------------- 64 65 integer StartDate, julday 66 parameter (StartDate = 2439321) ! Use birthday of author as base date 67 68 integer year1,mon1,day1,hour1,min1,sec1 69 integer year2,mon2,day2,hour2,min2,sec2 70 integer seconds1, seconds2 71 integer julian1, julian2 72 integer julsec, remainder 73 character*8 dateString 74 75 ! Error checking. 76 77 if (yyyymmdd_1 .lt. 19000000 .or. yyyymmdd_1 .gt. 21000000 ) then 78 rc=-1 79 return 80 endif 81 if (hhmmss_1 .lt. 0 .or. hhmmss_1 .ge. 240000 ) then 82 rc=-1 83 return 84 endif 85 86 ! Convert Date/Time strings to integer variables. 87 88 write (dateString, 200) yyyymmdd_1 89 200 format (I8) 90 read (dateString, 201) year1, mon1, day1 91 201 format (I4,2I2) 92 write (dateString, 202) hhmmss_1 93 202 format (I6) 94 read (dateString, 203) hour1, min1, sec1 95 203 format (3I2) 96 97 ! Get Julian Day and subtract off a constant (Julian days since 7/14/66) 98 99 julian1 = julday (mon1, day1, year1) 100 julian1 = julian1 - StartDate 101 102 ! Calculcate Julian seconds 103 104 julsec = (julian1-1)*86400 + hour1*3600 + min1*60 + sec1 105 106 ! Add offset and calculate new julian day. 107 108 julsec = julsec + offset 109 julian1 = INT(julsec/86400) + 1 110 julian1 = julian1 + StartDate 111 remainder = MOD(julsec,86400) 112 113 ! Convert julian day to YYYYMMDD. 114 115 call caldat (julian1, mon2, day2, year2) 116 117 ! Calculate HHMMSS from the remainder. 118 119 hour2 = INT(remainder/3600) 120 remainder = MOD(remainder,3600) 121 min2 = INT(remainder/60) 122 sec2 = MOD(remainder,60) 123 124 ! Build YYYYMMDD and HHMMSS variables. 125 126 yyyymmdd_2 = year2*10000 + mon2*100 + day2 127 hhmmss_2 = hour2*10000 + min2*100 + sec2 128 129 rc = 0 130 return 131 end 132