C Copyright(c) 1999, Space Science and Engineering Center, UW-Madison C Refer to "McIDAS Software Acquisition and Distribution Policies" C in the file mcidas/data/license.txt C *** $Id: smpdaytime.f,v 1.0 1999/09/28 14:38:32 russd Tst $ *** C ? SMPDAYTIME - McIDAS day and time conversion sample program C ? SMPDAYTIME C ? Parameters: C ? none C ? Keywords: C ? DAY=day1..dayN | list of days C ? TIMe=time1..timeN | list of times C ? Remarks: C ? McIDAS programing sample. C ? C ? This sample program illustrats the day/time conversion C ? and formatting utilities. C ? ---------- subroutine main0 implicit none c --- external functions c --- internal functions integer tim_utils ! test plot package utils c --- internal variables integer status ! function status c **************** Program Body ************** c --- set initial program status to FAILED call MCCODESET( -1 ) c --- DAY/TIME utilities status = TIM_UTILS( ) if( status.lt.0 ) return c --- set the program status to SUCCESS call MCCODESET( 0 ) c --- signal finished call EDEST('Done ...',0) return end ** Name: ** tim_utils - code tests day/time utilities ** ** Interface: ** integer function ** tim_utils( ) ** ** Input: ** none ** ** Input and Output: ** none ** ** Output: ** none ** ** Return values: ** 0 - Success ** -1 - Failed ** ** Remarks: ** Used to illustrate basic graphic functions ** ** Categories: ** graphic integer function tim_utils( ) implicit none c --- parameters c --- internal constants integer MAX_DAYTIME parameter (MAX_DAYTIME = 100) integer JAN72_DAY parameter (JAN72_DAY = 1972001) integer JAN72_TIME parameter (JAN72_TIME = 0) integer Y2K_DAY parameter (Y2K_DAY = 2000001) integer Y2K_TIME parameter (Y2K_TIME = 0) integer NFORMS parameter (NFORMS = 24) c --- external functions character*12 cfu integer len_trim integer mccmdnum integer mccmdiyd integer mccmdihr integer mccmddhr integer mccydtostr integer mcdaytimetosec integer mcincday real ftime c --- internal variables character*12 cday character*12 cform character*12 ctime character*256 date_string double precision dnow double precision dtimes(MAX_DAYTIME) integer ok integer i integer j integer k integer inow integer len integer num_days integer num_times integer yesterday integer today integer tomorrow integer seconds integer today_seconds integer yesterday_seconds integer tomorrow_seconds integer JAN72_seconds integer Y2K_seconds integer delta_seconds integer days(MAX_DAYTIME) integer itimes(MAX_DAYTIME) integer forms(NFORMS) data forms/ 1, 2, 3, 4, 5, 6, 7, 8, & 9, 10, 20, 21, 100, 101, 200, 201, & 202, 203, 300, 301, 400, 401, 500, 501/ c ************ Function Body ************* c --- initialize the function status tim_utils = -1 c --- get the system day and time c Note: MCGETDAY can be used to get the current day (CCYYDDD) c MCGETTIME can be used to get the current time (HHMMSS) call MCGETDAYTIME( today, inow ) c --- compute yesterday ok= MCINCDAY( today, -1, yesterday ) if( ok.ne.0 ) then call EDEST('MCINCDAY: failed --> status =', ok) return endif c --- compute tomorrow ok= MCINCDAY( today, 1, tomorrow ) if( ok.ne.0 ) then call EDEST('MCINCDAY: failed --> status =', ok) return endif c --- convert the current time to double precision dnow = dble( ftime( inow ) ) c --- get the day(s) from the command line num_days = MCCMDNUM( 'DAY' ) if( num_days.gt.0 ) then do i = 1, num_days ok= MCCMDIYD('DAY',1,'DAY',today,1970001,2100001,days(i)) if( ok.lt.0 ) return end do else num_days = 1 days(num_days) = today endif c --- get the time(s) from the command line num_times = MCCMDNUM( 'TIM.E' ) if( num_times.gt.0 ) then do i = 1, num_times ok= MCCMDIHR('TIM.E',1,'TIME',inow,0,235959,itimes(i)) if( ok.lt.0 ) return ok= MCCMDDHR('TIM.E',1,'TIME',dnow,0.0D0,23.99D0,dtimes(i)) if( ok.lt.0 ) return end do else num_times = 1 itimes(num_times) = inow dtimes(num_times) = dnow endif c --- convert yesterday to seconds ok= MCDAYTIMETOSEC( yesterday, 235959, yesterday_seconds ) if( ok.ne.0 ) then call EDEST('Yesterday MCDAYTIMETOSEC: failed --> status =',ok) return endif c --- convert today to seconds ok= MCDAYTIMETOSEC( today, inow, today_seconds ) if( ok.ne.0 ) then call EDEST('Yesterday MCDAYTIMETOSEC: failed --> status =',ok) return endif c --- convert tomorrow to seconds ok= MCDAYTIMETOSEC( tomorrow, 0, tomorrow_seconds ) if( ok.ne.0 ) then call EDEST('Tomorrow MCDAYTIMETOSEC: failed --> status =',ok) return endif c --- convert JAN72 to seconds ok= MCDAYTIMETOSEC( JAN72_DAY, JAN72_TIME, JAN72_seconds ) if( ok.ne.0 ) then call EDEST('JAN72 MCDAYTIMETOSEC: failed --> status =', ok) return endif c --- convert Y2K to seconds ok= MCDAYTIMETOSEC( Y2K_DAY, Y2K_TIME, Y2K_seconds ) if( ok.ne.0 ) then call EDEST('Y2K MCDAYTIMETOSEC: failed --> status =', ok) return endif c --- print today refernces ok= MCCYDTOSTR( today, 6, date_string ) if( ok.ne.0 ) then call EDEST('MCCYDTOSTR: failed --> status =', ok) return endif call sdest(' ',0) call sdest('TODAY is '//date_string,0) delta_seconds = today_seconds - yesterday_seconds call sdest('Seconds into day =',delta_seconds) delta_seconds = tomorrow_seconds - today_seconds - 1 call sdest('Seconds remaining in day =',delta_seconds) c --- print days/times do i = 1, num_days do j = 1, num_times cday = CFU( days(i) ) ctime = CFU( itimes(i) ) call SDEST(' ',0) call SDEST('Day/Time Operations: Day='//cday// & ' Time='//ctime,0) c ------ convert cyd to dmy c form string c 1 01/17/95 c 2 17/01/95 c 3 Jan 17,1995 c 4 17 Jan 1995 c 5 January 17,1995 c 6 17 January 1995 c 7 1995/01/17 (ISO Standard) c 8 95/01/17 (ISO Standard) c 9 1995017 c 10 017 c 20 Tuesday January 17, 1995 c 21 Tue January 17, 1995 c 100 Jan 17 c 101 17 Jan c 200 January c 201 Jan c 202 01 c 203 1 c 300 17 (leading zeros) c 301 17 c 400 Tuesday c 401 Tue c 500 1995 c 501 95 call SDEST(' ',0) call SDEST(' Date Formats',0) do k = 1, NFORMS ok= MCCYDTOSTR( days(i), forms(k), date_string ) if( ok.ne.0 ) then call EDEST('MCCYDTOSTR: failed --> status =', ok) return else cform = CFU( forms(k) ) len = LEN_TRIM( date_string ) call SDEST(' Date format='//cform(1:3)// & ' --> '//date_string(1:len),0) endif end do c ------ convert the day/time to seconds ok= MCDAYTIMETOSEC( days(i), itimes(j), seconds ) if( ok.ne.0 ) then call EDEST('MCDAYTIMETOSEC: failed --> status =', ok) return endif c ------ compute seconds until CALL SDEST(' ',0) call SDEST(' Day/Time to SECONDS:',0) delta_seconds = seconds - JAN72_seconds call SDEST(' seconds since Jan 01 1972 =', delta_seconds ) delta_seconds = seconds - Y2K_seconds if( delta_seconds.le.0 ) then call SDEST(' seconds until Jan 01 2000 =', delta_seconds ) else call SDEST(' seconds since Jan 01 2000 =', delta_seconds ) endif end do end do c --- set return status tim_utils = 0 return end