Return to whetstone.f CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 / tst

Power 6/32 Unix version 1.21

c	whetstone benchmark
c single precision variant of program
	common t,t1,t2,e1(4),j,k,l
	t=0.499975e00
	t1=0.50025e00
	t2=2.0e00
c execute program twice,  once with loopcount i=10,  and again with i=20.
	i=10
c***** start of timed interval *****
 10	btime=secnds(0.0)
c
c******** test 1 ********
c
	isave=i
	n1=0
	n2=12*i
	n3=14*i
	n4=345*i
	n5=0
	n6=210*i
	n7=32*i
	n8=899*i
	n9=616*i
	n10=0
	n11=93*i
	n12=0
	x1=1.0e0
	x2=-1.0e0
	x3=-1.0e0
	x4=-1.0e0
	if(n1)19,19,11
 11	do 18 i=1,n1,1
	x1=(x1+x2+x3-x4)*t
	x2=(x1+x2-x3+x4)*t
	x4=(-x1+x2+x3+x4)*t
	x3=(x1-x2+x3+x4)*t
 18	continue
 19	continue
	call pout(n1,n1,n1,x1,x2,x3,x4)
c
c******** test 2 ********
c
	e1(2)=-1.0e0
	e1(3)=-1.0e0
	e1(4)=-1.0e0
	if(n2)29,29,21
 21	do 28 i=1,n2,1
	e1(1)=(e1(1)+e1(2)+e1(3)-e1(4))*t
	e1(2)=(e1(1)+e1(2)-e1(3)+e1(4))*t
	e1(3)=(e1(1)-e1(2)+e1(3)+e1(4))*t
	e1(4)=(-e1(1)+e1(2)+e1(3)+e1(4))*t
 28	continue
 29	continue
	call pout(n2,n3,n2,e1(1),e1(2),e1(3),e1(4))
c
c******** test 3 ********
c
 31	do 38 i=1,n3,1
 38	call pa(e1)
 39	continue
	call pout(n3,n2,n2,e1(1),e1(2),e1(3),e1(4))
c
c******** test 4 ********
c
	if(n4)49,49,41
 41	do 48 i=1,n4,1
	if (j-1)43,42,43
 42	j=2
	goto44
 43	j=3
 44	if(j-2)46,46,45
 45	j=0
	goto47
 46	j=1
 47	if(j-1)411,412,412
 411	j=1
	goto48
 412	j=0
 48	continue
 49	continue
	call pout(n4,j,j,x1,x2,x3,x4)
c
c******** test 5 ********
c
	j=1
	k=2
	l=3
	if(n6)69,69,61
 61	do 68 i=1,n6,1
	j=j*(k-j)*(l-k)
	k=l*k-(l-j)*k
	l=(l-k)*(k+j)
	e1(l-1)=j+k+l
	e1(k-1)=j+k+l
 68	continue
 69	continue
	call pout(n6,j,k,e1(1),e1(2),e1(3),e1(4))
c
c******** test 6 ********
c
	x=0.5e0
	y=0.5e0
	if(n7)79,79,71
 71	do 78 i=1,n7,1
	x=t*atan(t2*sin(x)+cos(x)/cos(x+y)+cos(x-y)-1.0e0)
	y=t*atan(t2*sin(y)+cos(y)/cos(x+y)+cos(x-y)-1.0e0)
 78	continue
 79	continue
	call pout(n7,j,k,x,x,y,y)
c
c******** test 7 ********
c
	x=1.0e0
	y=1.0e0
	z=1.0e0
	if(n8)89,89,81
 81	do 88 i=1,n8,1
 88	call p3(x,y,z)
 89	continue
 	call pout(n8,j,k,x,y,z,z)
c
c******** test 8 ********
c
	j=1
	k=2
	l=3
	e1(1)=1.0e0
	e1(2)=2.0e0
	e1(3)=3.0e0
	if(n9)99,99,91
 91	do 98 i=1,n9,1
 98	call p0
 99	continue
	call pout(n9,j,k,e1(1),e1(2),e1(3),e1(4))
c
c******** test 9 ********
c
	j=2
	k=3
	if(n10)109,109,101
 101	do 108 i=1,n10,1
	j=j+k
	k=j+k
	j=j-k
	k=k-j-j
 108	continue
 109	continue
	call pout(n10,j,k,x1,x2,x3,x4)
c
c******** test 10 ********
c
	x=0.75e0
	if(n11)119,119,111
 111	do 118 i=1,n11,1
 118	x=sqrt(exp(alog(x)/t1))
 119	continue
c
c******** end of timed interval ********
c save time for loopcount i=10 and repeat for i=20
	delta=secnds(btime)-btime
	if(isave.eq.20) go to 120
	time1=delta
	i=20
	goto 10
 120	time2=delta
c calculate whetstone kips
	wkip=(1.0/(time2-time1))*1000
	write(6, 121) wkip
121	format (f10.2,' whetstone kips per second.')
	stop
	end

	subroutine pa(e)
	common t,t1,t2
	dimension e(4)
	j=0
 1	e(1)=(e(1)+e(2)+e(3)-e(4))*t
	e(2)=(e(1)+e(2)-e(3)+e(4))*t
	e(3)=(e(1)-e(2)+e(3)+e(4))*t
	e(4)=(-e(1)+e(2)+e(3)+e(4))/t2
	j=j+1
	if(j-6)1,2,2
 2	continue
	return
	end
	subroutine p0
	common t,t1,t2,e1(4),j,k,l
	e1(j)=e1(k)
	e1(k)=e1(l)
	e1(l)=e1(j)
	return
	end
	subroutine p3(x,y,z)
	common t,t1,t2
	x1=x
	y1=y
	x1=t*(x1+y1)
	y1=t*(x1+y1)
	z=(x1+y1)/t2
	return
	end
	subroutine pout(n,j,k,x1,x2,x3,x4)
	write (6,1) n,j,k,x1,x2,x3,x4
 1	format (1h ,3i7,4e12.4)
	return
	end

	subroutine prtres(wk)
	return
	end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.