c *********************************************************************** c *********************************************************************** c ** * * * * ** c ** * * Graphit * * ** c ** * * * * ** c ** * * Program to read in graphing information and rescale * * ** c ** * * the Data for Plotting in actual Graph Units. * * ** c ** * * * * ** c ** * * Originally written by Erik Antonsson * * ** c ** * * Dept. of Mechanical Engineering for VMS * * ** c ** * * * * ** c ** * * Ported to RSX by Edward J. Cetron * * ** c ** * * Center for Biomedical Design * * ** c ** * * 3168 MEB, Univ. of Utah * * ** c ** * * Salt Lake City, Utah 84112 * * ** c ** * * * * ** c *********************************************************************** c *********************************************************************** c dimension points(3000,2) integer hp,xfmt1,xfmt2,yfmt1,yfmt2 character*9 filenm character*13 filenn byte title(80),xaxis(80),yaxis(80) byte form1(6),form2(6),plot(15),numb(10),numbr(10) data plot/'P','A',6*' ',',',6*' '/ data hp/2/ ! write(5,10) 7 10 format(' GRAPHIT Executing ',a1,/) write(5,20) 7 20 format('$Enter the Digitized Data Input File Name ==> ',a1) read(5,30) ifile,filenm 30 format(q,a9) open(unit=1,name=filenm,status='OLD') ! read(1,40) nchars,title 40 format(q,80a1) if(nchars .gt. 32) write(5,50) 7 50 format(' * * Warning * * Graph Title is Too Long! ',a1) title(nchars+1) = "0 write(5,60) title 60 format(1x,75a1/) read(1,40) nchars,xaxis if (nhars .gt. 64) write(5,70) 7 70 format(' * * Warning * * X Axis Title is Too Long! ',a1) xaxis(nchars+1) = "0 read(1,40) nchars,yaxis if (nchars .gt. 46) write(5,80) 7 80 format(' * * Warning * * Y Axis Title is Too Long! ',a1) yaxis(nchars+1) = "0 ! read(1,*) xmin,xmax,xtick,sxtick read(1,*) ymin,ymax,ytick,sytick read(1,*) xfmt1,xfmt2,yfmt1,yfmt2 xrange = xmax-xmin if ((xrange/xtick .lt. 0.) .or. (xtick/sxtick .lt. 0.)) a stop 'GRAPHIT Stopped because of X-Tick Mark Errors' yrange = ymax-ymin if ((yrange/ytick .lt. 0.) .or. (ytick/sytick .lt. 0.)) a stop 'GRAPHIT Stopped because of Y-Tick Mark Errors' read(1,*) offset ! read(1,*) xref1,yref1 read(1,*) xiref1,yjref1 read(1,*) xref2,yref2 read(1,*) xiref2,yjref2 if ((xiref1 .eq. xiref2) .or. (yjref1 .eq. yjref2)) a stop'GRAPHIT Stopped because of Non-unique Scaling' ! xscale = (xref2-xref1)/(xiref2-xiref1) xref = xref1-(xiref1-offset)*xscale yscale = (yref2-yref1)/(yjref2-yjref1) yref = yref1-yjref1*yscale number = 0 90 number = number+1 read(1,*,err=120) xi,yj ! write(5,*) xi,yj if (xi) 110,100,100 100 points(number,1) = xscale*(xi-offset)+xref points(number,2) = yscale*yj+yref goto 90 110 points(number,1) = xi points(number,2) = yj goto 90 120 number = number-1 write(5,130) number,7 130 format(/,1x,i, a ' Digitized Data Pairs now Scaled ',a1,/) write(5,*) (points(i,1),points(i,2), i=1,number) close(unit=1) c c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c Initialize the HP 7220C Plotter c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c filenn(1:9) = filenm filenn(10:13) = '.hpl' open(unit=hp,name=filenn,status='NEW', a form='UNFORMATTED',initialsize=1,extendsize=1) write(5,140) filenm,7 140 format(' Graphit plot is being stored in ',a,'.HPL ',a1,/) ! ! Initialize the Plotter Configuration ! write(hp) "33,'.Y',"33,'.J',"33,'.K',"33,'.M200;;;13;0:' write(hp) "33,'.H760;0;17:',"33,'.N0;19:' call send('IW;PU;PA15000,1000;IN',21) call send('PA10500,0;DF;DI;SI0.19,0.31;SL',30) ! ! Draw Framing Box ! Set the Pen Velocities to 15 cm/s ! call send('VS10',4) call send('PU;SP5;PA400,500;PD;PR9600,0,0,7100,-9600,0, a0,-7100',51) call send('PU;PR50,50;PD;PR9500,0,0,7000,-9500,0,0,-7000;PU',48) ! ! Set the Window inside the Box ! Set the P1 and P2 Scaling Points ! call send('IW450,550,9950,7550',19) call send('IP450,550,9950,7550',19) ! ! Draw Plotting Area Box ! Set Window to this Area ! call send('PA2200,1550;PD;PA9200,1550,9200,7050, a2200,7050,2200,1550;PU',59) call send('IW2200,1550,9200,6551',21) c c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c Plot Data Graphs c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c xscale = 7000./xrange xref = 2200.5-xmin*xscale yscale = 5000./yrange yref = 1550.5-ymin*yscale ! move = 1 do 180 i=1,number x = points(i,1) y = points(i,2) if ((x .ne. -9999.) .and. (y .ne. -9999.)) goto 150 if (move .eq. 1) goto 180 call send('PU',2) move = 1 goto 180 150 iplot = int(x*xscale+xref) jplot = int(y*yscale+yref) encode(6,160,form1) iplot encode(6,160,form2) jplot 160 format(i6) do 170 j=1,6 plot(j+2) = form1(j) plot(j+9) = form2(j) 170 continue call send(plot,15) if (move .eq. 1) call send ('PD',2) move = 0 180 continue call send('PU',2) ! ! Reset the Window ! call send('IW450,550,9950,7550',19) ! ! Draw X-Tick Marks ! call send('SI0.2724,0.4445',15) do 250 k=1,2 nxtick = int(xrange/xtick)+1 x = xmin-xtick call send('TL2.857,0.',10) if (k .eq. 2) call send('TL0.,2.857',10) encode(6,160,form2) 1550 if (k .eq. 2) encode(6,160,form2) 7050 do 220 i=1,nxtick x = x+xtick iplot = int(x*xscale+xref) encode(6,160,form1) iplot do 190 j=1,6 plot(j+2)=form1(j) plot(j+9)=form2(j) 190 continue call send(plot,15) call send('XT',2) if (k .eq. 2) goto 220 encode(xfmt1,200,numb) x 200 format(f.) numb(xfmt1+1) = "0 locatn = 1 do 210 j=1,xfmt1+1 if (numb(j) .eq. "40) goto 210 numbr(locatn) = numb(j) locatn = locatn+1 210 continue call send('PR0,-125',8) call lorign(6,numbr) 220 continue ! ! Draw Minor Tick Marks ! nxtick = int(xrange/sxtick)+1 x = xmin-sxtick call send('TL1.785,0.',10) if (k .eq. 2) call send('TL0.,1.785',10) do 240 i=1,nxtick x = x+sxtick iplot = int(x*xscale+xref) encode(6,160,form1) iplot do 230 j=1,6 plot(j+2)=form1(j) plot(j+9)=form2(j) 230 continue call send(plot,15) call send('XT',2) 240 continue 250 continue ! ! Draw Y-Tick Marks ! do 320 k=1,2 nytick = int(yrange/ytick)+1 y = ymin-ytick call send('TL2.105,0.',10) if (k .eq. 2) call send('TL0.,2.105',10) encode(6,160,form2) 2200 if (k .eq. 2) encode(6,160,form2) 9200 do 290 i=1,nytick y = y+ytick jplot = int(y*yscale+yref) encode(6,160,form1) jplot do 260 j=1,6 plot(j+2)=form2(j) plot(j+9)=form1(j) 260 continue call send(plot,15) call send('YT',2) if (k .eq. 2) goto 290 encode(yfmt1,270,numb) y 270 format(f.) numb(yfmt1+1) = "0 locatn = 1 do 280 j=1,yfmt1+1 if (numb(j) .eq. "40) goto 280 numbr(locatn) = numb(j) locatn = locatn+1 280 continue call send('PR-100,0',8) call lorign(8,numbr) 290 continue ! ! Draw Minor Tick Marks ! nytick = int(yrange/sytick)+1 y = ymin-sytick call send('TL1.316,0.',10) if (k .eq. 2) call send('TL0.,1.316',10) do 310 i=1,nytick y = y+sytick jplot = int(y*yscale+yref) encode(6,160,form1) jplot do 300 j=1,6 plot(j+2)=form2(j) plot(j+9)=form1(j) 300 continue call send(plot,15) call send('YT',2) 310 continue 320 continue ! ! Label X-Axis Title ! call send('PA5700,925;DI;SI0.3112,0.508;SL',31) call lorign(5,xaxis) ! ! Label Y-Axis Title ! call send('PA1200,4300;DI0.,1.',19) call lorign(4,yaxis) ! ! Label Plot Title ! call send('PA5700,6525;DI;SI0.389,0.635;SL0.176',36) call lorign(4,title) ! call send('DF;IW;PU;SP0;PA15500,11000',26) close(unit=hp) stop 'GRAPHIT Stopped' end c c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c c SEND c c Subroutine to Send a Command String to the HP 7220C c c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c subroutine send(give,nsize) byte give(80) data hp/2/ write(hp) (give(i),i=1,nsize) if ((give(1) .ne. 'L' .and. give(1) .ne. 'l') .or. a (give(2).ne.'B' .and. give(2).ne.'b')) goto 10 write(hp) "3 10 write(hp) "73 return end c c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c c TEXT c c Subroutine to Write a Text Label at the Current Pen c Position and with the Current Character Size,Slant, c and Orientation. c c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c subroutine text(label) byte char(82),label(80) data char/'L','B',80*"0/ length = 80 do 10 i=1,80 if (label(i) .ne. "0) goto 10 length = i goto 20 10 continue 20 do 30 i=1,length char(i+2) = label(i) 30 continue call send(char,length+2) return end ! ! *********************************************************************** ! *********************************************************************** ! ** * * * * ** ! ** * * Lorigin * * ** ! ** * * * * ** ! ** * * This Subroutine will label a text string in one of 9 * * ** ! ** * * origin formats with any character size and orientat- * * ** ! ** * * ion angle. * * ** ! ** * * * * ** ! *********************************************************************** ! *********************************************************************** ! subroutine lorign(lorg,label) byte form(8),label(80),place(19) data place/'C','P',8*' ',',',8*' '/ ! horiz = float((lorg-1)/3) vert = float(mod(lorg+2,3)) ! ! Find Label Length ! length = 80 do 10 i=1,80 if (label(i) .ne. "0) goto 10 length = i goto 20 10 continue ! 20 space = 1./6. if (lorg .lt. 4) space = 0. offset = space-float(length-1)/2.*horiz encode(8,30,form) offset 30 format(f8.4) do 99 i=1,8 place(i+2) = form(i) 99 continue offset = -.25*vert encode(8,30,form) offset do 199 i=1,8 place(i+11) = form(i) 199 continue call send(place,19) call text(label) return end