subroutine get_date (date_str) c c======================================================================= c === c This routine gets todays date, day of the week and time called === c (default month & weekday are December & Saturday respectively). === c === c ------- === c Output: === c ------- === c === c DATE_STR concatenated string for the day of the week, date === c (month,day,year), and time (12hr clock) of day === c (hour:min:sec). === c === #if defined decdate | defined craydate c Calls: DAY_CODE, LENGTH === # else c Calls: LENGTH === #endif c === c======================================================================= c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c integer dstat,half,hour,iday,imon,len1,len2,len3,min,nday,sbgn1, * sbgn2,sbgn3,send1,send2,send3,sec,tstat,year integer lday(31),lmonth(12) #if defined decdate | defined craydate integer century parameter (century=2000) character*8 tstring # elif defined sundate character*3 day3,mon character*28 fdate,tmpday # elif defined aixdate character*3 day3,mon character*26 tmpday #endif character*3 ampm(0:1) character*9 day(0:6),month(12) character*11 ctime character*18 today character*20 fmt character*44 date_str,wkday data ampm /' am',' pm'/ data day/'Sunday','Monday','Tuesday','Wednesday','Thursday', * 'Friday','Saturday'/ data lmonth,lday/7,8,5,5,3,4,4,6,9,7,8,8,9*1,22*2/ data month/'January','February','March','April','May','June', * 'July','August','September','October','November', * 'December'/ c c======================================================================= c Begin executable code. c======================================================================= c c----------------------------------------------------------------------- c Get weekday, date & time in short format, then extract this c information. c----------------------------------------------------------------------- c #if defined decdate dstat = 0 call idate (imon,nday,year) year = year+century call time (tstring) read (tstring,'(i2,1x,i2,1x,i2)',iostat=tstat) hour,min,sec if (tstat.ne.0) ctime = tstring # elif defined craydate write (tstring,'(a8)') date() read (tstring,'(i2,1x,i2,1x,i2)',iostat=dstat) imon,nday,year year = year+century if (dstat.ne.0) then wkday = tstring today = ' ' endif write (tstring,'(a8)') clock() read (tstring,'(i2,1x,i2,1x,i2)',iostat=tstat) hour,min,sec if (tstat.ne.0) ctime=tstring # elif defined sundate tmpday = fdate () read (tmpday,'(a3,1x,a3,1x,i2)',iostat=dstat) day3,mon,nday read (tmpday,'(11x,i2,1x,i2,1x,i2)',iostat=tstat) hour,min,sec tstat = max(abs(dstat),abs(tstat)) read (tmpday,'(20x,i4)',iostat=dstat) year if ((dstat.ne.0).or.(tstat.ne.0)) then dstat = 1 tstat = 1 wkday = tmpday today = ' ' ctime = ' ' endif # elif defined aixdate call fdate_ (tmpday) read (tmpday,'(a3,1x,a3,1x,i2)',iostat=dstat) day3,mon,nday read (tmpday,'(11x,i2,1x,i2,1x,i2)',iostat=tstat) hour,min,sec tstat = max(abs(dstat),abs(tstat)) read (tmpday,'(20x,i4)',iostat=dstat) year if ((dstat.ne.0).or.(tstat.ne.0)) then dstat = 1 tstat = 1 wkday = tmpday today = ' ' ctime = ' ' endif # else dstat = 1 tstat = 1 wkday = ' ' today = ' ' ctime = ' ' #endif c c----------------------------------------------------------------------- c Convert from 24 hour clock to 12 hour AM/PM clock. c----------------------------------------------------------------------- c if (tstat.eq.0) then half = hour/12 hour = hour-half*12 if (hour.eq.0) hour = 12 if (half.eq.2) half = 0 endif c if (dstat.eq.0) then c #if defined decdate | defined craydate c----------------------------------------------------------------------- c Get index for the day of the week. c----------------------------------------------------------------------- c call day_code (imon,nday,year,iday) c # elif defined sundate | defined aixdate c----------------------------------------------------------------------- c Loop to find full day name by comparing DAY3 with first 3 letters c of day. c----------------------------------------------------------------------- c iday = 0 do 10 while ((day3.ne.day(iday)(1:3)).and.(iday.lt.6)) iday = iday + 1 10 continue c c----------------------------------------------------------------------- c Loop to find full month name by comparing MON with first 3 letters c of month. c----------------------------------------------------------------------- c imon = 1 do 20 while ((mon.ne.month(imon)(1:3)).and.(imon.lt.12)) imon = imon + 1 20 continue c #endif c----------------------------------------------------------------------- c Construct date, time and day of the week output string. c----------------------------------------------------------------------- c write (fmt,30) lmonth(imon),lday(nday) 30 format ('(a',i1,',1x,i',i1,',1h,,1x,i4)') write (today,fmt) month(imon),nday,year wkday = day(iday) endif if (tstat.eq.0) then write (ctime,40) hour,min,sec,ampm(half) 40 format (i2,':',i2.2,':',i2.2,a3) endif c c Concatenate date string. c call length (wkday,len1,sbgn1,send1) call length (today,len2,sbgn2,send2) call length (ctime,len3,sbgn3,send3) if (len1.gt.0) then date_str=wkday(sbgn1:send1) else date_str=' ' end if if (len2.gt.0) then call length (date_str,len1,sbgn1,send1) if (len1.gt.0) then date_str=date_str(sbgn1:send1)//' - '//today(sbgn2:send2) else date_str=today(sbgn2:send2) endif endif if (len3.gt.0) then call length (date_str,len1,sbgn1,send1) if (len1.gt.0) then date_str=date_str(sbgn1:send1)//' - '//ctime(sbgn3:send3) else date_str=ctime(sbgn3:send3) endif endif c return end