Program k : datmgp, difdat, difdatr, idatmg, incdat, incdatr
program progk
implicit none
external idatmg, newdate
integer idatmg, newdate
integer idate1(14),idate2(14),i,nbh,nberr
integer dtpr,tmpr
real*8 nbh8
* first test with integer
* month
idate2(2)=2
* day of the month
idate2(3)=29
* year
idate2(4)=1975
* time in hours
idate2(5)=18
idate2(14)=idatmg(idate2)
* idate1=idate2+i
* idate1-idate2.eq.i?
print *,'The following operations is done: idate1=idate2+i,'
print *,'nbh=idate1-idate2, nbh.eq.i?'
print *,'The last statement is supposed to be true.'
print *,'The test is done for i=0,300000,20000'
print *,'and then, from the last date found,'
print *,'for i=0,-300000,-20000'
nberr=0
do i=0,300000,20000
call incdat(idate1(14),idate2(14),i)
call difdat(idate1(14),idate2(14),nbh)
ier = newdate(idate1(14),dtpr,tmpr,-3)
print '(a6,1x,i8.8,1x,i8.8)',' date:',dtpr,tmpr
if (nbh.ne.i) then
nberr=nberr+1
print *,'Error for i=',i
endif
enddo
print *,''
idate2(14)=idate1(14)
do i=0,-300000,-20000
call incdat(idate1(14),idate2(14),i)
call difdat(idate1(14),idate2(14),nbh)
ier = newdate(idate1(14),dtpr,tmpr,-3)
print '(a6,1x,i8.8,1x,i8.8)',' date:',dtpr,tmpr
if (nbh.ne.i) then
nberr=nberr+1
print *,'Error for i=',i
endif
enddo
if (nberr.eq.0) then
print *,'No error in the first test (integer)'
else
print *,'Number of errors:',nberr
endif
print *,''
* same test but using real*8
* year
idate2(4)=1976
* month
idate2(2)=6
* day of the month
idate2(3)=13
* time in hours
idate2(5)=10
* hundredths of second since last hour
idate2(6)=179500
idate2(14)=idatmg(idate2)
nberr=0
do i=0,20
call incdatr(idate1(14),idate2(14),27222.49*dble(i))
call difdatr(idate1(14),idate2(14),nbh8)
call datmgp(idate1)
print '(a6,7a4)',' date:',idate1(7),idate1(8),idate1(9),
# idate1(10),idate1(11),idate1(12),idate1(13)
if (abs(nbh8-27222.51*dble(i)).gt.1) nberr=nberr+1
enddo
if (nberr.eq.0) then
print *,'No error in the second test (real*8)'
else
print *,'Number of errors:',nberr
endif
stop
end