Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.c++ > #87349
| From | Klaus Wacker <klaus.w.wacker@t-online.de> |
|---|---|
| Newsgroups | comp.lang.fortran, comp.lang.c, comp.lang.c++ |
| Subject | Re: xkcd: Y2K and 2038 |
| Date | 2022-11-13 12:45 +0000 |
| Organization | IEFBR14 |
| Message-ID | <jtc77hF9gfvU2@mid.individual.net> (permalink) |
| References | <tkmbc4$uc0u$1@dont-email.me> |
Cross-posted to 3 groups.
In comp.lang.fortran Lynn McGuire <lynnmcguire5@gmail.com> wrote:
> xkcd: Y2K and 2038
> https://xkcd.com/2697/
>
> It shouldn't cost more than a trillion dollars or two to investigate this.
>
> Explained at:
> https://www.explainxkcd.com/wiki/index.php/2697:_Y2K_and_2038
>
> Lynn
My contribution to the 2038 problem:
----- o< ---------------------------------------------------
program p2038
! (c) Klaus Wacker
use datesub, only: jd,cdate
implicit none
integer, parameter :: minute=60
integer, parameter :: hour=60*minute
integer, parameter :: day=24*hour
integer, parameter :: maxepoch=(2**30-1)+2**30
integer date_time(8), jdmax, jdnow,jd1970,yyyy,mm,dd
integer secsmax,hoursmax,minsmax,yyyymax,mmmax,ddmax,daysub
integer monthstil
integer until(6)
integer i,ia,is,cnt
character*12 arg,lang
logical test,verbose
character*8, pointer :: texte(:,:)
character*8, target :: de_texte(2,9) = reshape( ['Jahr ','Jahre ','Monat ',&
&'Monate ', 'Tag ','Tage ','Stunde ','Stunden ','Minute ','Minuten ',&
&'Sekunde ','Sekunden','Noch ',' ',' und ',', ','Ende: ',&
&' '], shape(de_texte))
character*8, target :: en_texte(2,9) = reshape( ['year ','years ','month ',&
&'months ', 'day ','days ','hour ','hours ','minute ','minutes ',&
&'second ','seconds ',' ','left ',' and ',', ','The end:',&
&' '], shape(en_texte))
character*5 between
!
test=.false.
verbose=.false.
jd1970=jd(1970,1,1)
call date_and_time(values=date_time)
i=0
do ia=1,iargc()
call getarg(ia,arg)
if(arg.eq."-t") then
test=.true.
else if(arg.eq."-v") then
verbose=.true.
else
! numerical command line values override corresponding date_time values
i=i+1
read(arg,*,err=99) date_time(i)
endif
enddo
!
call getenv("LANG",lang)
if(test) write(*,*) "LANG=",lang
if(lang(1:2)=="de") then
texte => de_texte
else
texte => en_texte
endif
!
jdnow=jd(date_time(1),date_time(2),date_time(3))
if(test) write(*,*) date_time
jdmax=maxepoch/day+jd1970
secsmax=mod(maxepoch,day)
call hms(hoursmax,minsmax,secsmax)
call cdate(jdmax,yyyymax,mmmax,ddmax)
if(verbose) write(*,'(a,i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a)') &
&trim(texte(1,9))//" ",&
&yyyymax,"-",mmmax,"-",ddmax,"-",hoursmax,":",minsmax,":",secsmax," UTC"
until(3)=jdmax-jdnow
until(6)=(jdnow-jd1970)*day - date_time(4)*minute &
& + date_time(5)*hour + date_time(6)*minute + date_time(7)
! this should be the same as $(date +%s)
if(test) write(*,*) until(6)
until(6) = maxepoch - until(6) - until(3)*day
daysub = 0
if(until(6)<0) then
daysub = 1
until(6) = until(6)+day
endif
call hms(until(4),until(5),until(6))
until(1) = yyyymax-date_time(1)
until(3) = jdmax - jd(date_time(1)+until(1),date_time(2),date_time(3)) - daysub
if(until(3)<0) then
until(1) = until(1)-1
! until(3) = jdmax - jd(date_time(1)+until(1),date_time(2),date_time(3)) - daysub
endif
! until(2) cannot be a do variable
do monthstil=11,0,-1
until(3) = jdmax - jd(date_time(1)+until(1) + (date_time(2)+monthstil-1)/12,&
&mod(date_time(2)+monthstil-1,12)+1,date_time(3)) - daysub
if(until(3)>=0) exit
enddo
until(2)=monthstil
cnt = count(until>0)
if(texte(1,7)/=" ") write(*,'(a)',advance="no") trim(texte(1,7))//" "
do i=1,6
if(cnt==2) then
between=texte(1,8)
elseif(cnt==1) then
between=""
else
between=texte(2,8)
endif
if(until(i)/=0) then
is=min(until(i),2)
write(*,'(i0,a)',advance="no") until(i)," "//trim(texte(is,i))//trim(between)//" "
cnt=cnt-1
endif
enddo
write(*,'(a)') trim(texte(2,7))
stop
!
99 write(*,*) "Invalid argument ",ia,": ",arg
stop 1
!
contains
subroutine hms(hours,mins,secs)
implicit none
integer, intent(inout) :: secs
integer, intent(out) :: hours,mins
hours=secs/hour
secs=mod(secs,hour)
mins=secs/minute
secs=mod(secs,minute)
end subroutine hms
end program p2038
----- o< ---------------------------------------------------
DATESUB is a piece of software that I got really long time ago via
this newsgroup (with some trivial cahnges in lowercase, mainly to turn
it into a module):
----- o< ---------------------------------------------------
module datesub
contains
SUBROUTINE CALEND(YYYY,DDD,MM,DD)
!=============CALEND WHEN GIVEN A VALID YEAR, YYYY, AND DAY OF THE
! YEAR, DDD, RETURNS THE MONTH, MM, AND DAY OF THE
! MONTH, DD.
! SEE ACM ALGORITHM 398, TABLELESS DATE CONVERSION, BY
! DICK STONE, CACM 13(10):621.
implicit none
INTEGER YYYY,DDD,MM,DD,T
T=0
IF(MOD(YYYY,4).EQ.0) T=1
!-----------THE FOLLOWING STATEMENT IS NECESSARY IF YYYY IS LESS TNAN
! 1900 OR GREATER THAN 2100.
IF(MOD(YYYY,400).NE.0.AND.MOD(YYYY,100).EQ.0) T=0
DD=DDD
IF(DDD.GT.59+T) DD=DD+2-T
MM=((DD+91)*100)/3055
DD=(DD+91)-(MM*3055)/100
MM=MM-2
!----------MM WILL BE CORRECT IFF DDD IS CORRECT FOR YYYY.
IF(MM.GE.1 .AND. MM.LE.12) RETURN
WRITE(*,1) DDD
1 FORMAT('0$$$CALEND: DAY OF THE YEAR INPUT =',I11,' IS OUT OF RANGE.')
STOP
END SUBROUTINE
SUBROUTINE CDATE(JD,YYYY,MM,DD)
!=======GIVEN A JULIAN DAY NUMBER, NNNNNNNN, YYYY,MM,DD ARE RETURNED AS
! AS THE CALENDAR DATE. JD=NNNNNNNN IS THE JULIAN DATE
! FROM AN EPOCK IN THE VERY DISTANT PAST. SEE CACM
! 1968 11(10):657, LETTER TO THE EDITOR BY FLIEGEL AND
! VAN FLANDERN.
! EXAMPLE CALL CDATE(2440588,YYYY,MM,DD) RETURNS 1970 1 1 .
!
implicit none
INTEGER JD,YYYY,MM,DD,L,N
L=JD+68569
N=4*L/146097
L=L-(146097*N + 3)/4
YYYY=4000*(L+1)/1461001
L=L-1461*YYYY/4+31
MM=80*L/2447
DD=L-2447*MM/80
L=MM/11
MM=MM + 2 - 12*L
YYYY=100*(N-49) + YYYY + L
RETURN
END SUBROUTINE CDATE
SUBROUTINE DAYSUB(JD,YYYY,MM,DD,WD,DDD)
!========GIVEN JD, A JULIAN DAY # (SEE ASF JD), THIS ROUTINE
! CALCULATES DD, THE DAY NUMBER OF THE MONTH; MM, THE MONTH
! NUMBER; YYYY THE YEAR; WD THE WEEKDAY NUMBER, AND DDD
! THE DAY NUMBER OF THE YEAR.
! ARITHMETIC STATEMENT FUNCTIONS 'IZLR' AND 'IDAY' ARE TAKEN
! FROM REMARK ON ALGORITHM 398, BY J. DOUGLAS ROBERTSON,
! CACM 15(10):918.
!
! EXAMPLE: CALL DAYSUB(2440588,YYYY,MM,DD,WD,DDD) YIELDS 1970 1 1 4 1.
!
implicit none
INTEGER JD,YYYY,MM,DD,WD,DDD
integer iday,izlr
!
!------IZLR(YYYY,MM,DD) GIVES THE WEEKDAY NUMBER 0=SUNDAY, 1=MONDAY,
! ... 6=SATURDAY. EXAMPLE: IZLR(1970,1,1)=4=THURSDAY
!
IZLR(YYYY,MM,DD)=MOD((13*(MM+10-(MM+10)/13*12)-1)/5+DD+77 &
+5*(YYYY+(MM-14)/12-(YYYY+(MM-14)/12)/100*100)/4 &
+ (YYYY+(MM-14)/12)/400-(YYYY+(MM-14)/12)/100*2,7)
!
!------IDAY IS A COMPANION TO CALEND; GIVEN A CALENDAR DATE, YYYY, MM,
! DD, IDAY IS RETURNED AS THE DAY OF THE YEAR.
! EXAMPLE: IDAY(1984,4,22)=113
!
IDAY(YYYY,MM,DD)=3055*(MM+2)/100-(MM+10)/13*2-91 &
+(1-(MOD(YYYY,4)+3)/4+(MOD(YYYY,100)+99)/100 &
-(MOD(YYYY,400)+399)/400)*(MM+10)/13+DD
!
CALL CDATE(JD,YYYY,MM,DD)
WD=IZLR(YYYY,MM,DD)
DDD=IDAY(YYYY,MM,DD)
RETURN
END SUBROUTINE DAYSUB
FUNCTION JD(YYYY,MM,DD)
implicit none
integer jd
INTEGER YYYY,MM,DD
! DATE ROUTINE JD(YYYY,MM,DD) CONVERTS CALENDER DATE TO
! JULIAN DATE. SEE CACM 1968 11(10):657, LETTER TO THE
! EDITOR BY HENRY F. FLIEGEL AND THOMAS C. VAN FLANDERN.
! EXAMPLE JD(1970,1,1)=2440588
JD=DD-32075+1461*(YYYY+4800+(MM-14)/12)/4 &
+367*(MM-2-((MM-14)/12)*12)/12-3* &
((YYYY+4900+(MM-14)/12)/100)/4
RETURN
END FUNCTION JD
FUNCTION NDAYS(MM1,DD1,YYYY1, MM2,DD2,YYYY2)
implicit none
integer ndays
INTEGER YYYY1,MM1,DD1,YYYY2,MM2,DD2
!==============NDAYS IS RETURNED AS THE NUMBER OF DAYS BETWEEN TWO
! DATES; THAT IS MM1/DD1/YYYY1 MINUS MM2/DD2/YYYY2,
! WHERE DATEI AND DATEJ HAVE ELEMENTS MM, DD, YYYY.
!-------NDAYS WILL BE POSITIVE IFF DATE1 IS MORE RECENT THAN DATE2.
NDAYS=JD(YYYY1,MM1,DD1)-JD(YYYY2,MM2,DD2)
RETURN
END FUNCTION NDAYS
end module datesub
----- o< ---------------------------------------------------
--
Klaus Wacker klaus.w.wacker@t-online.de
51°29'7"N 7°25'7"E
Back to comp.lang.c++ | Previous | Next — Previous in thread | Find similar | Unroll thread
xkcd: Y2K and 2038 Lynn McGuire <lynnmcguire5@gmail.com> - 2022-11-11 14:29 -0600
Re: xkcd: Y2K and 2038 Thomas Koenig <tkoenig@netcologne.de> - 2022-11-12 07:36 +0000
Re: xkcd: Y2K and 2038 Lynn McGuire <lynnmcguire5@gmail.com> - 2022-11-12 01:58 -0600
Re: xkcd: Y2K and 2038 Thomas Koenig <tkoenig@netcologne.de> - 2022-11-12 08:30 +0000
Re: xkcd: Y2K and 2038 Muttley@dastardlyhq.com - 2022-11-12 10:00 +0000
Re: xkcd: Y2K and 2038 David Brown <david.brown@hesbynett.no> - 2022-11-12 11:29 +0100
Re: xkcd: Y2K and 2038 Bart <bc@freeuk.com> - 2022-11-12 11:03 +0000
Re: xkcd: Y2K and 2038 David Brown <david.brown@hesbynett.no> - 2022-11-12 12:57 +0100
Re: xkcd: Y2K and 2038 Bart <bc@freeuk.com> - 2022-11-12 15:56 +0000
Re: xkcd: Y2K and 2038 Michael S <already5chosen@yahoo.com> - 2022-11-12 10:05 -0800
Re: xkcd: Y2K and 2038 scott@slp53.sl.home (Scott Lurndal) - 2022-11-12 16:05 +0000
Re: xkcd: Y2K and 2038 Keith Thompson <Keith.S.Thompson+u@gmail.com> - 2022-11-12 18:00 -0800
Re: xkcd: Y2K and 2038 red floyd <no.spam.here@its.invalid> - 2022-11-13 09:49 -0800
Re: xkcd: Y2K and 2038 gazelle@shell.xmission.com (Kenny McCormack) - 2022-11-14 09:14 +0000
Re: xkcd: Y2K and 2038 David Brown <david.brown@hesbynett.no> - 2022-11-14 10:09 +0100
Re: xkcd: Y2K and 2038 Thomas Koenig <tkoenig@netcologne.de> - 2022-11-14 14:09 +0000
Re: xkcd: Y2K and 2038 Klaus Wacker <klaus.w.wacker@t-online.de> - 2022-11-14 13:47 +0000
Re: xkcd: Y2K and 2038 Paavo Helde <eesnimi@osa.pri.ee> - 2022-11-12 16:13 +0200
Re: xkcd: Y2K and 2038 Siri Cruise <chine.bleu@yahoo.com> - 2022-11-12 15:49 -0700
Re: xkcd: Y2K and 2038 Siri Cruise <chine.bleu@yahoo.com> - 2022-11-12 15:47 -0700
Re: xkcd: Y2K and 2038 Klaus Wacker <klaus.w.wacker@t-online.de> - 2022-11-13 12:45 +0000
csiph-web