Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50547/unplot.for
There is 1 other file named unplot.for in the archive. Click here to see a list.
	PROGRAM UNPLOT			!Translates PLT file to CALL PLOT
	DIMENSION ITEXT(16)		!80 characters
	EXTERNAL READER			!Subroutine to do input
	EXTERNAL PLOT,NEWPEN,OPRTXT,PAUSEP,TITLE  !Required routines from FORLIB

	EXTERNAL TOLP			!Use LOAD FOR:UNPLOT.FOR,REL:TOLP.REL

	TYPE 10
10	FORMAT(' Name of PLT file: ',$)
	ACCEPT 20, ITEXT		!Get name from user
20	FORMAT(16A5)
	OPEN(UNIT=1,DIALOG=ITEXT,ACCESS='SEQIN',MODE='IMAGE')

	CALL PLOTS(IERR,'TTY')		!Initialize the graphics terminal
	IF(IERR.NE.0) STOP 'Cannot start plotting'
	CALL FACTOR(0.7)		!Make it fit on TEK or GIGI screen
	K=NEWPEN(3)

C	IFLAG = 5003			!Do header and trailer with wraparound
C	IFLAG = 4400			!No header/trailer with wraparound
	IFLAG = 0			!Ignore header/trailer in file

	CALL TOLP(READER,IFLAG,ITEXT)	!Read plot file, call subroutine PLOT

	CALL PLOT(X,Y,999)		!Proper end to the plot
	IF(IFLAG.EQ.0) IFLAG = 16	!Output full file name if no errors

	TYPE 30, (ITEXT(I),I=1,IFLAG)	!Type the returned error message
30	FORMAT(1X,16A5)
	END
********************************************************************************
	SUBROUTINE READER(JWORD)	!Called from inside TOLP
	READ(1,ERR=40) JWORD		!Read 1 binary word from .PLT file
	RETURN				!OK

40	JWORD = -1			!Minus one means End-of-File
	RETURN
	END
********************************************************************************
*  The following dummy subroutines will write subroutine calls in PLOT.OUT     *
*  PLOTS,PLOT,NEWPEN,OPRTXT,PAUSEP,TITLE                                       *
********************************************************************************
	SUBROUTINE PLOTS(IERR,IPLT)
	OPEN (UNIT=2,FILE='PLOT.OUT')
	WRITE (2,5)
5	FORMAT(8X,'CALL PLOTS(IERR,IPLT)')
	IERR = 0
	RETURN
	END
********************************************************************************
	SUBROUTINE PLOT(X,Y,I)
	IF(Y.LT.99.0) WRITE (2,10) X,Y,I
10	FORMAT(8X,'CALL PLOT(',F6.3,',',F6.3,',',I3,')')
	IF(Y.GT.99.0) WRITE (2,11)
11	FORMAT(8X,'CALL PLOT(',F6.3,',',F8.3,',',I3,')')
	IF(I.EQ.999) WRITE(2,12)
12	FORMAT(8X,'END')
	RETURN
	END
********************************************************************************
	SUBROUTINE NEWPEN(IPEN,IERR)
	WRITE (2,20) IPEN
20	FORMAT(8X,'CALL NEWPEN(',I1,',IERR)')
	RETURN
	END
********************************************************************************
	SUBROUTINE PAUSEP(ISEC)
	WRITE (2,30) ISEC
30	FORMAT(8X,'CALL PAUSEP(',I3,')')
	RETURN
	END
********************************************************************************
	SUBROUTINE OPRTXT(IMESAG,NCHAR)
	TYPE 40
40	FORMAT(' Call to OPRTXT ignored')
	RETURN
	END
********************************************************************************
	SUBROUTINE TITLE(X,Y,HEIGHT,ISTRNG,ANGLE,NCHAR)
	TYPE 50
50	FORMAT(' TOLP was not supposed to call TITLE')
	RETURN
	END