character*30 name(100),fname real*4 dcos(100,3),sum,angle(100),x pi = 4*atan(1.0) write(6,*) 'Enter name of file with RTO operator names', . ' and direction cosines:' read(5,'(A)') fname open (unit=2,name=fname,status='old',readonly) i=1 50 read(2,'(A)',end=800) name(i) read(2,*) (dcos(i,j),j=1,3) write(6,51)i,name(i),(dcos(i,j),j=1,3) 51 format(' ',I4,a40,3f8.4) i=i+1 goto 50 800 n=i-1 m=n if (m.gt.32) m=32 write (6,881)(k,k=1,m) 881 format(' ',3x,32I4) 900 do 950 i=1,n do 940 k=1,i sum = 0. do 910 j=1,3 910 sum=sum+dcos(i,j)*dcos(k,j) angle(k)=0 if (sum.le.0.9999) angle(k)=180.*acos(sum)/pi !angle < .256 degrees. 940 continue m=i if (m.gt.32) m=32 950 write(6,951)i,(angle(k),k=1,m) 951 format(' ',I3,':',32f4.0) c plot x and y direction cosines of the rotation angles on a circle of radius 1. 2000 OPEN (UNIT=3,FILE='rtopolarz.ps',STATUS='NEW',RECL=1200, & CARRIAGECONTROL='LIST') WRITE(3,'(A)')'%!PS-Adobe-3.0 ' WRITE(3,'(A)')'%%Creator: mx10' WRITE(3,'(A)')'%%Pages: 1 ' WRITE(3,'(A)')'%%BoundingBox:0 0 602 792 ' WRITE(3,'(A)')'%%EndComments ' WRITE(3,'(A)')'%%BeginProlog ' WRITE(3,'(A)')'%%EndProlog ' WRITE(3,'(A)')'%%Page: 1 1 ' WRITE(3,'(A)')'%%PageBoundingBox: 0 0 602 792 ' c WRITE(3,'(A)')'%!PS-Adobe-3.0 EPSF-3.0 '//char(4) c WRITE(3,'(A)')'%%BoundingBox:0 0 602 792' WRITE(3,'(A)')'initgraphics ' write(3,'(A)') & '/cshow {dup stringwidth pop 2 div neg 0 rmoveto show} def' write(3,'(A)') & '/lshow {dup stringwidth pop neg 0 rmoveto show} def' write(3,'(A)')'1.0 dup scale 300. dup translate' write(3,'(A)')'newpath 0 0 2.0 0. 360 arc fill newpath' write(3,'(A)')'newpath 0 0 250.0 0. 360 arc stroke newpath' write(3,'(A)')'-255 0 moveto -245 0 lineto 245 0 moveto 255 0 lineto' write(3,'(A)')'0 -255 moveto 0 -245 lineto 0 245 moveto 0 255 lineto' write(3,'(A)')'/Times-Roman findfont 18 scalefont setfont' write(3,'(A)')'258 -7 moveto (X) show 0 258 moveto (Y) cshow' write(3,'(A)')'-258 -7 moveto (-X) lshow 0 -275 moveto (-Y) cshow' write(3,'(A)')'3 0 moveto (Z) show' write(3,'(A)')'stroke' write(3,'(A)')'/Times-Roman findfont 9 scalefont setfont' do 2010 i=1,n if (dcos(i,3).lt.o) then c plot the positive end: if z < 0 then negate x,y,z do 2060 j=1,3 2060 dcos(i,j) = -dcos(i,j) endif 2010 write(3,2011) 250.*dcos(i,1),250.*dcos(i,2),i 2011 format(' ',2f10.2,' moveto (',i2,') cshow') write(3,'(A)')'stroke showpage' close (unit=3) c plot x and y direction cosines of the rotation angles on a circle of radius 1. 3000 OPEN (UNIT=3,FILE='rtopolary.ps',STATUS='NEW',RECL=1200, & CARRIAGECONTROL='LIST') WRITE(3,'(A)')'%!PS-Adobe-3.0 ' WRITE(3,'(A)')'%%Creator: mx10' WRITE(3,'(A)')'%%Pages: 1 ' WRITE(3,'(A)')'%%BoundingBox:0 0 602 792 ' WRITE(3,'(A)')'%%EndComments ' WRITE(3,'(A)')'%%BeginProlog ' WRITE(3,'(A)')'%%EndProlog ' WRITE(3,'(A)')'%%Page: 1 1 ' WRITE(3,'(A)')'%%PageBoundingBox: 0 0 602 792 ' c WRITE(3,'(A)')'%!PS-Adobe-3.0 EPSF-3.0 '//char(4) c WRITE(3,'(A)')'%%BoundingBox:0 0 602 792' WRITE(3,'(A)')'initgraphics ' write(3,'(A)')'/Times-Roman findfont 18 scalefont setfont' write(3,'(A)') & '/cshow {dup stringwidth pop 2 div neg 0 rmoveto show} def' write(3,'(A)') & '/lshow {dup stringwidth pop neg 0 rmoveto show} def' write(3,'(A)')'1.0 dup scale 300. dup translate' write(3,'(A)')'newpath 0 0 2.0 0. 360 arc fill newpath' write(3,'(A)')'newpath 0 0 250.0 0. 360 arc stroke newpath' write(3,'(A)')'-255 0 moveto -245 0 lineto 245 0 moveto 255 0 lineto' write(3,'(A)')'0 -255 moveto 0 -245 lineto 0 245 moveto 0 255 lineto' write(3,'(A)')'/Times-Roman findfont 18 scalefont setfont' write(3,'(A)')'258 -7 moveto (X) show 0 258 moveto (Z) cshow' write(3,'(A)')'-258 -7 moveto (-X) lshow 0 -275 moveto (-Z) cshow' write(3,'(A)')'3 0 moveto (Y) show' write(3,'(A)')'stroke' write(3,'(A)')'/Times-Roman findfont 9 scalefont setfont' do 3010 i=1,n if (dcos(i,2).lt.o) then c plot the positive end: if y < 0 then negate x,y,z do 3060 j=1,3 3060 dcos(i,j) = -dcos(i,j) endif 3010 write(3,2011) 250.*dcos(i,1),250.*dcos(i,3),i write(3,'(A)')'stroke showpage' close (unit=3) c plot x and y direction cosines of the rotation angles on a circle of radius 1. 3100 OPEN (UNIT=3,FILE='rtopolarx.ps',STATUS='NEW',RECL=1200, & CARRIAGECONTROL='LIST') WRITE(3,'(A)')'%!PS-Adobe-3.0 ' WRITE(3,'(A)')'%%Creator: mx10' WRITE(3,'(A)')'%%Pages: 1 ' WRITE(3,'(A)')'%%BoundingBox:0 0 602 792 ' WRITE(3,'(A)')'%%EndComments ' WRITE(3,'(A)')'%%BeginProlog ' WRITE(3,'(A)')'%%EndProlog ' WRITE(3,'(A)')'%%Page: 1 1 ' WRITE(3,'(A)')'%%PageBoundingBox: 0 0 602 792 ' c WRITE(3,'(A)')'%!PS-Adobe-3.0 EPSF-3.0 '//char(4) c WRITE(3,'(A)')'%%BoundingBox:0 0 602 792' WRITE(3,'(A)')'initgraphics ' write(3,'(A)')'/Times-Roman findfont 18 scalefont setfont' write(3,'(A)') & '/cshow {dup stringwidth pop 2 div neg 0 rmoveto show} def' write(3,'(A)') & '/lshow {dup stringwidth pop neg 0 rmoveto show} def' write(3,'(A)')'1.0 dup scale 300. dup translate' write(3,'(A)')'newpath 0 0 2.0 0. 360 arc fill newpath' write(3,'(A)')'newpath 0 0 250.0 0. 360 arc stroke newpath' write(3,'(A)')'-255 0 moveto -245 0 lineto 245 0 moveto 255 0 lineto' write(3,'(A)')'0 -255 moveto 0 -245 lineto 0 245 moveto 0 255 lineto' write(3,'(A)')'/Times-Roman findfont 18 scalefont setfont' write(3,'(A)')'258 -7 moveto (Y) show 0 258 moveto (Z) cshow' write(3,'(A)')'-258 -7 moveto (-Y) lshow 0 -275 moveto (-Z) cshow' write(3,'(A)')'3 0 moveto (X) show' write(3,'(A)')'stroke' write(3,'(A)')'/Times-Roman findfont 9 scalefont setfont' do 3110 i=1,n if (dcos(i,1).lt.o) then c plot the positive end: if y < 0 then negate x,y,z do 3160 j=1,3 3160 dcos(i,j) = -dcos(i,j) endif 3110 write(3,2011) 250.*dcos(i,2),250.*dcos(i,3),i write(3,'(A)')'stroke showpage' close (unit=3) 1000 write(6,*)'Enter the indices of the operators to be compared:' read(5,*,end=1200) n1,n2 c if (n1.eq.0) end sum = 0. do 1100 j=1,3 1100 sum=sum+dcos(n1,j)*dcos(n2,j) write(6,*)'Cos of angle between operators:',sum, . 'Angle between operators:',180.*acos(sum)/pi 1101 format(' Cos angle between operators:',f6.1, . 'Angle between operators:',f6.1) goto 1000 1200 end