c asplt - output plot file to console terminal c popen - subroutine popen real psc common/scale/xsc,ysc real xsc,ysc common/cpplot/buf,ixpen,iypen,symbol integer ixpen,iypen byte buf(66,80),symbol real arcsmo,segmin common/arccom/arcsmo,segmin c minimum arc segment length segmin=39. write(7,200) c Scaled for tektronics 4663 addressable graphics units (ADU) c Page format is `A-DRAFTING` c X = 10.5 inches = 4096 ADU c Y = 7.74 inches = 3019.23 ADU c tek ADU's per inch psc=4096/10.5 c 6 dots per inch in x dimension xsc=6/psc c 10 dots per inch in y dimension ysc=10/psc c for i=1 23000 if(.not.(i.le.66))goto 23002 c for j=1 23003 if(.not.(j.le.80))goto 23005 buf(i,j)=' ' j=j+1 goto 23003 c endfor 23005 continue i=i+1 goto 23000 c endfor 23002 continue symbol='*' read(5,201)junk return 200 format(' Set top of page and hit return.') 201 format(1a1) end c pclose - subroutine pclose common/cpplot/buf,ixpen,iypen,symbol integer ixpen,iypen byte buf(66,80),symbol call doplot return end c pmove - move the pen to (ixm,iym) without drawing subroutine pmove(ix,iy) integer ix,iy common/scale/xsc,ysc real xsc,ysc common/cpplot/buf,ixpen,iypen,symbol integer ixpen,iypen byte buf(66,80),symbol ixpen=ix*xsc+1. iypen=iy*ysc+1. return end c pdraw - draw a line from current pen position to the point (ixp,iyp) subroutine pdraw(ix,iy) real xdif,ydif,xdis,ydis,x,y,xincr,yincr integer ix,iy,ixp,iyp,ixdif,iydif,ixdis,iydis common/scale/xsc,ysc real xsc,ysc common/cpplot/buf,ixpen,iypen,symbol integer ixpen,iypen byte buf(66,80),symbol ixp=ix*xsc+1. iyp=iy*ysc+1. ixdif=ixp-ixpen iydif=iyp-iypen ixdis=iabs(ixdif) iydis=iabs(iydif) if(.not.((ixdis.eq.0).and.(iydis.eq.0)))goto 23006 buf(ixp,iyp)=symbol goto 23007 c else 23006 continue if(.not.(ixdis.gt.iydis))goto 23008 yincr=float(iydif)/float(ixdif) if(.not.(ixdif.gt.0))goto 23010 y=iypen i1=ixpen i2=ixp goto 23011 c else 23010 continue y=iyp i1=ixp i2=ixpen 23011 continue do 23012 i=i1,i2 ix=i iy=y+.5 buf(ix,iy)=symbol y=y+yincr 23012 continue goto 23009 c else 23008 continue xincr=float(ixdif)/float(iydif) if(.not.(iydif.gt.0))goto 23014 x=ixpen i1=iypen i2=iyp goto 23015 c else 23014 continue x=ixp i1=iyp i2=iypen 23015 continue do 23016 i=i1,i2 ix=x+.5 iy=i buf(ix,iy)=symbol x=x+xincr 23016 continue 23009 continue 23007 continue ixpen=ixp iypen=iyp return end c ppen - subroutine ppen(ipen) byte ipen common/cpplot/buf,ixpen,iypen,symbol integer ixpen,iypen byte buf(66,80),symbol symbol=ipen return end c ppage - subroutine ppage common/cpplot/buf,ixpen,iypen,symbol integer ixpen,iypen byte buf(66,80),symbol call doplot c for i=1 23018 if(.not.(i.le.66))goto 23020 c for j=1 23021 if(.not.(j.le.80))goto 23023 buf(i,j)=' ' j=j+1 goto 23021 c endfor 23023 continue i=i+1 goto 23018 c endfor 23020 continue return end c doplot - put out hard copy of plot file to the console subroutine doplot external len byte tim(10),gap(10),dat(10) data gap/9*' ',0/ common/cpplot/buf,ixpen,iypen,symbol integer ixpen,iypen byte buf(66,80),symbol call time(tim) call date(dat) write(7,200)(dat(i),i=1,len(dat)), (gap(i),i=1,len(gap)), (tim(i), & i=1,len(tim)) c for i=1 23024 if(.not.(i.le.66-1))goto 23026 c for n=80 23027 if(.not.(buf(i,n).eq.' '))goto 23029 n=n-1 goto 23027 c endfor 23029 continue write(7,200)(buf(i,j),j=1,n) i=i+1 goto 23024 c endfor 23026 continue return 200 format(' ', 80 a1) end