u77-test.f: Don't bother declaring etime.
* libU77/u77-test.f: Don't bother declaring etime. Use `implicit none' and declare mask and lenstr. Do ETIME/DTIME consistency check before loop, then use loop to verify that dtime "ticks" at some point. Check ETIME array-sum using single-precision add, to avoid spurious complaint on systems (like x86) that use more precision for intermediate results. Fix `Results of ETIME and DTIME...' message to print pertinent values (r1 and r2 instead of i and j). Change loop from 10M to 1K repeated up to 1000 times or until dtime "ticks". Print the number of 1K loops needed to see this tick. Answer a commented question. Split up a long line of output and do other prettying. Preset lognam in case GETLOG fails to overwrite it. Patch from Craig. From-SVN: r18861
This commit is contained in:
parent
4d1d804584
commit
a051827081
|
@ -1,3 +1,21 @@
|
||||||
|
Wed Mar 4 16:32:46 1998 Craig Burley <burley@gnu.org>
|
||||||
|
|
||||||
|
* libU77/u77-test.f: Don't bother declaring etime.
|
||||||
|
Use `implicit none' and declare mask and lenstr.
|
||||||
|
Do ETIME/DTIME consistency check before loop, then
|
||||||
|
use loop to verify that dtime "ticks" at some point.
|
||||||
|
Check ETIME array-sum using single-precision add, to
|
||||||
|
avoid spurious complaint on systems (like x86) that
|
||||||
|
use more precision for intermediate results.
|
||||||
|
Fix `Results of ETIME and DTIME...' message to print
|
||||||
|
pertinent values (r1 and r2 instead of i and j).
|
||||||
|
Change loop from 10M to 1K repeated up to 1000 times
|
||||||
|
or until dtime "ticks".
|
||||||
|
Print the number of 1K loops needed to see this tick.
|
||||||
|
Answer a commented question.
|
||||||
|
Split up a long line of output and do other prettying.
|
||||||
|
Preset lognam in case GETLOG fails to overwrite it.
|
||||||
|
|
||||||
Sat Feb 28 15:32:15 1998 Craig Burley <burley@gnu.org>
|
Sat Feb 28 15:32:15 1998 Craig Burley <burley@gnu.org>
|
||||||
|
|
||||||
* libI77/open.c (f_open): Use sizeof(buf) instead of
|
* libI77/open.c (f_open): Use sizeof(buf) instead of
|
||||||
|
|
|
@ -3,15 +3,17 @@
|
||||||
* good squint at what it prints, though detected errors will cause
|
* good squint at what it prints, though detected errors will cause
|
||||||
* starred messages.
|
* starred messages.
|
||||||
|
|
||||||
|
implicit none
|
||||||
integer i, j, k, ltarray (9), idat (3), count, rate, count_max,
|
integer i, j, k, ltarray (9), idat (3), count, rate, count_max,
|
||||||
+ pid
|
+ pid, mask
|
||||||
real tarray1(2), tarray2(2), r1, r2, etime
|
real tarray1(2), tarray2(2), r1, r2, sum
|
||||||
intrinsic getpid, getuid, getgid, ierrno, gerror,
|
intrinsic getpid, getuid, getgid, ierrno, gerror,
|
||||||
+ fnum, isatty, getarg, access, unlink, fstat,
|
+ fnum, isatty, getarg, access, unlink, fstat,
|
||||||
+ stat, lstat, getcwd, gmtime, hostnm, etime, chmod,
|
+ stat, lstat, getcwd, gmtime, hostnm, etime, chmod,
|
||||||
+ chdir, fgetc, fputc, system_clock, second, idate, secnds,
|
+ chdir, fgetc, fputc, system_clock, second, idate, secnds,
|
||||||
+ time, ctime, fdate, ttynam
|
+ time, ctime, fdate, ttynam
|
||||||
external lenstr
|
external lenstr
|
||||||
|
integer lenstr
|
||||||
logical l
|
logical l
|
||||||
character gerr*80, c*1
|
character gerr*80, c*1
|
||||||
character ctim*25, line*80, lognam*20, wd*100, line2*80
|
character ctim*25, line*80, lognam*20, wd*100, line2*80
|
||||||
|
@ -35,20 +37,23 @@
|
||||||
line = 'and 6 isn''t a tty device (ISATTY)'
|
line = 'and 6 isn''t a tty device (ISATTY)'
|
||||||
end if
|
end if
|
||||||
write (6,'(1X,A)') line(:lenstr(line))
|
write (6,'(1X,A)') line(:lenstr(line))
|
||||||
|
|
||||||
pid = getpid()
|
pid = getpid()
|
||||||
WRITE (6,'(A,I10)') ' Process id (GETPID): ', pid
|
WRITE (6,'(A,I10)') ' Process id (GETPID): ', pid
|
||||||
WRITE (6,'(A,I10)') ' User id (GETUID): ', GETUID ()
|
WRITE (6,'(A,I10)') ' User id (GETUID): ', GETUID ()
|
||||||
WRITE (6,'(A,I10)') ' Group id (GETGID): ', GETGID ()
|
WRITE (6,'(A,I10)') ' Group id (GETGID): ', GETGID ()
|
||||||
WRITE (6,*) 'If you have the `id'' program, the following call of'
|
WRITE (6, *) 'If you have the `id'' program, the following call'
|
||||||
+ // ' SYSTEM should agree with the above'
|
write (6, *) 'of SYSTEM should agree with the above:'
|
||||||
call flush(6)
|
call flush(6)
|
||||||
CALL SYSTEM ('echo " " `id`')
|
CALL SYSTEM ('echo " " `id`')
|
||||||
call flush
|
call flush
|
||||||
|
lognam = 'blahblahblah'
|
||||||
call getlog (lognam)
|
call getlog (lognam)
|
||||||
write (6,*) 'Login name (GETLOG): ', lognam
|
write (6,*) 'Login name (GETLOG): ', lognam
|
||||||
call umask(0, mask)
|
call umask(0, mask)
|
||||||
write(6,*) 'UMASK returns', mask
|
write(6,*) 'UMASK returns', mask
|
||||||
call umask(mask)
|
call umask(mask)
|
||||||
|
|
||||||
ctim = fdate()
|
ctim = fdate()
|
||||||
write (6,*) 'FDATE returns: ', ctim
|
write (6,*) 'FDATE returns: ', ctim
|
||||||
j=time()
|
j=time()
|
||||||
|
@ -58,23 +63,54 @@
|
||||||
write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray
|
write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray
|
||||||
call system_clock(count, rate, count_max)
|
call system_clock(count, rate, count_max)
|
||||||
write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max
|
write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max
|
||||||
|
|
||||||
write (6,*) 'Sleeping for 1 second (SLEEP) ...'
|
write (6,*) 'Sleeping for 1 second (SLEEP) ...'
|
||||||
call sleep (1)
|
call sleep (1)
|
||||||
write (6,*) 'Looping 10,000,000 times ...'
|
|
||||||
do i=1,10*1000*1000
|
c consistency-check etime vs. dtime for first call
|
||||||
end do
|
r1 = etime (tarray1)
|
||||||
r1= etime (tarray1)
|
r2 = dtime (tarray2)
|
||||||
if (r1.ne.tarray1(1)+tarray1(2))
|
|
||||||
+ write (6,*) '*** ETIME didn''t return sum of the array: ',
|
|
||||||
+ r1, ' /= ', tarray1(1), '+', tarray1(2)
|
|
||||||
r2= dtime (tarray2)
|
|
||||||
if (abs (r1-r2).gt.1.0) write (6,*)
|
if (abs (r1-r2).gt.1.0) write (6,*)
|
||||||
+ 'Results of ETIME and DTIME differ by more than a second:',
|
+ 'Results of ETIME and DTIME differ by more than a second:',
|
||||||
+ i, j
|
+ r1, r2
|
||||||
write (6,'(A,3F10.3)')
|
call sgladd (sum, tarray1(1), tarray1(2))
|
||||||
|
if (r1 .ne. sum)
|
||||||
|
+ write (6,*) '*** ETIME didn''t return sum of the array: ',
|
||||||
|
+ r1, ' /= ', tarray1(1), '+', tarray1(2)
|
||||||
|
call sgladd (sum, tarray2(1), tarray2(2))
|
||||||
|
if (r2 .ne. sum)
|
||||||
|
+ write (6,*) '*** DTIME didn''t return sum of the array: ',
|
||||||
|
+ r2, ' /= ', tarray2(1), '+', tarray2(2)
|
||||||
|
write (6, '(A,3F10.3)')
|
||||||
+ ' Elapsed total, user, system time (ETIME): ',
|
+ ' Elapsed total, user, system time (ETIME): ',
|
||||||
+ r1, tarray1
|
+ r1, tarray1
|
||||||
call idate(i,j,k)
|
|
||||||
|
c now try to get times to change enough to see in etime/dtime
|
||||||
|
write (6,*) 'Looping until clock ticks at least once...'
|
||||||
|
do i = 1,1000
|
||||||
|
do j = 1,1000
|
||||||
|
end do
|
||||||
|
r2 = dtime (tarray2)
|
||||||
|
if (tarray2(1) .ne. 0. .or. tarray2(2) .ne. 0.) exit
|
||||||
|
end do
|
||||||
|
r1 = etime (tarray1)
|
||||||
|
call sgladd (sum, tarray1(1), tarray1(2))
|
||||||
|
if (r1 .ne. sum)
|
||||||
|
+ write (6,*) '*** ETIME didn''t return sum of the array: ',
|
||||||
|
+ r1, ' /= ', tarray1(1), '+', tarray1(2)
|
||||||
|
call sgladd (sum, tarray2(1), tarray2(2))
|
||||||
|
if (r2 .ne. sum)
|
||||||
|
+ write (6,*) '*** DTIME didn''t return sum of the array: ',
|
||||||
|
+ r2, ' /= ', tarray2(1), '+', tarray2(2)
|
||||||
|
write (6, '(A,3F10.3)')
|
||||||
|
+ ' Differences in total, user, system time (DTIME): ',
|
||||||
|
+ r2, tarray2
|
||||||
|
write (6, '(A,3F10.3)')
|
||||||
|
+ ' Elapsed total, user, system time (ETIME): ',
|
||||||
|
+ r1, tarray1
|
||||||
|
write (6, *) '(Clock-tick detected after ', i, ' 1K loops.)'
|
||||||
|
|
||||||
|
call idate (i,j,k)
|
||||||
call idate (idat)
|
call idate (idat)
|
||||||
write (6,*) 'IDATE d,m,y: ',idat
|
write (6,*) 'IDATE d,m,y: ',idat
|
||||||
print *, '... and the VXT version: ', i,j,k
|
print *, '... and the VXT version: ', i,j,k
|
||||||
|
@ -107,7 +143,8 @@
|
||||||
call fputc(3, 'c',i)
|
call fputc(3, 'c',i)
|
||||||
call fputc(3, 'd',j)
|
call fputc(3, 'd',j)
|
||||||
if (i+j.ne.0) write(6,*) '***FPUTC: ', i
|
if (i+j.ne.0) write(6,*) '***FPUTC: ', i
|
||||||
C why is it necessary to reopen?
|
C why is it necessary to reopen? (who wrote this?)
|
||||||
|
C the better to test with, my dear! (-- burley)
|
||||||
close(3)
|
close(3)
|
||||||
open(3,file='foo',status='old')
|
open(3,file='foo',status='old')
|
||||||
call fseek(3,0,0,*10)
|
call fseek(3,0,0,*10)
|
||||||
|
@ -176,3 +213,9 @@ C return >0
|
||||||
subroutine dumdum(r)
|
subroutine dumdum(r)
|
||||||
r = 3.14159
|
r = 3.14159
|
||||||
end
|
end
|
||||||
|
* do an add that is most likely to be done in single precision.
|
||||||
|
subroutine sgladd(sum,left,right)
|
||||||
|
implicit none
|
||||||
|
real sum,left,right
|
||||||
|
sum = left+right
|
||||||
|
end
|
||||||
|
|
Loading…
Reference in New Issue