Web pdp-10.trailing-edge.com

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0126/aplot.for
There is 1 other file named aplot.for in the archive. Click here to see a list.
```	SUBROUTINE SIMPLS(XD,YD,ND)
INTEGER	ND
REAL	XD(ND), YD(ND)
C
C  Call ONEPLT, supplying all titling and ensuring that a least
C
C  XD	ND-array of X data
C  YD	ND-array of Y data
C
C
CALL ONEPLS(XD,YD,ND,'X data',-6,'Y data',6,0,0)
END
SUBROUTINE SIMPLT(XD,YD,ND)
INTEGER	ND
REAL	XD(ND), YD(ND)
C
C  Call ONEPLT and supply all titling.  Join up the points.
C
C  XD	ND-array of X data point
C  YD	ND-array of Y data points
C  ND	number of data points
C
C
CALL ONEPLT(XD,YD,ND,'X data',-6,'Y data',6,0,0)
END
SUBROUTINE ATOLOG(XY)
INTEGER	XY
C
C  Initialise the COMMON areas so that ATOPLT will plot on
C  a log scale on one or both axes
C
C  XY	1 : X-axis
C	2 : Y-axis
C	-ve means cancel appropriate axis
C
C
INTEGER	I
LOGICAL FLLOG, APXY
COMMON	/APLOG/FLLOG(2)
DATA	FLLOG/.FALSE.,.FALSE./
C
IF(APXY(IABS(XY))) RETURN
FLLOG(IABS(XY)) = (XY.GT.0)
C
C
CALL APLDM1
DUM = APLDM2(DUM)
END
SUBROUTINE APLLAB(XY,ORGV,TINC,TSPC,FLIN)
INTEGER	XY
REAL	ORGV, TINC, TSPC
LOGICAL	FLIN, APXY
C
C  Starting from the origin, work along the axis writing tick labels
C  at every other tick.  The labels give the log value at that tick.
C
C  ORGV		logarithm of value at origin of axis
C  TINC		increment in values between ticks
C  TSPC		spacing of ticks along axis
C  FLIN		true if integer labels to be used
C
C
INTEGER	X, Y, CTIK, NUMTIK
REAL	PENPOS(2), EXPPOS(2), LTKVAL, EXPMIN, NXTVAL
REAL	PENORG(2), XORG, YORG, TKLSIZ, TKLCLR, TKESIZ, AXISLN(2)
LOGICAL	FLLOG
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
COMMON	/APLOG/FLLOG(2)
C
EQUIVALENCE (AXISLN,APPARM(3))
EQUIVALENCE (PENORG,APPARM(5))
EQUIVALENCE (XORG,APPARM(5))
EQUIVALENCE (YORG,APPARM(6))
EQUIVALENCE (TKLSIZ,APPARM(19))
EQUIVALENCE (TKLCLR,APPARM(20))
EQUIVALENCE (TKESIZ,APPARM(39))
```
```	IF(.NOT.FLLOG(XY)) RETURN
C
C	Initialise label writing
C
IF(XY.EQ.Y) GOTO 100
PENPOS(X) = XORG
PENPOS(Y) = YORG - TKLSIZ - TKLCLR
EXPPOS(X) = XORG - TKESIZ
EXPPOS(Y) = PENPOS(Y)
GOTO 150
100	  PENPOS(Y) = YORG
EXPPOS(X) = XORG - TKLCLR - TKESIZ * 4.0
EXPPOS(Y) = YORG
PENPOS(X) = XORG - TKLCLR
IF(.NOT.FLIN) PENPOS(X) = PENPOS(X) - TKLSIZ * 3.0
150	CONTINUE
LTKVAL = ORGV
EXPMIN = 0.0
C
C  Loop here writing a real or integer logarithmic value
C  at each tick along the axis
C
DO 299 CTIK = 0, NUMTIK(XY), 2
NXTVAL = LTKVAL + TINC
IF(FLIN) CALL APILLB(XY,PENPOS,EXPPOS,LTKVAL,NXTVAL,EXPMIN)
IF(.NOT.FLIN) CALL APRLLB(XY,PENPOS,EXPPOS,LTKVAL)
LTKVAL = LTKVAL + TINC * 2.0
PENPOS(XY) = PENPOS(XY) + TSPC * 2.0
EXPPOS(XY) = EXPPOS(XY) + TSPC * 2.0
299	CONTINUE
C
C
ENTRY	APLDM1
END
SUBROUTINE APRLLB(XY,PENPOS,EXPPOS,LTKVAL)
INTEGER	XY
REAL	PENPOS(2), EXPPOS(2), LTKVAL
C
C  Write a real logarithmic tick value at the current
C  tick.
C
C  XY		1 : X-axis, 2 : Y-axis
C  PENPOS	X,Y position of pen
C  EXPPOS	X,Y position for exponent
C  LTKVAL	log of value at this tick
C
INTEGER X, Y
REAL	RV, RD, TIKVAL, EXPVAL, PENPSX, APPWR
REAL	TKLSIZ
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
EQUIVALENCE (TKLSIZ,APPARM(19))
C
C
C	Find the value and exponent to be plotted at this tick.
C	The value is normalised to a one digit integer part.
C
TIKVAL = EXP(LTKVAL)
EXPVAL = APPWR(TIKVAL)
TIKVAL = TIKVAL / (10.0 ** EXPVAL)
C
C	Adjust X pen position in case there is an integer part
C
PENPSX = PENPOS(X)
IF((TIKVAL + RV).GE.1.0) PENPSX = PENPSX - TKLSIZ
IF(TIKVAL.LT.0.01) TIKVAL = 0.0
TIKVAL = TIKVAL + RD
C
C	Plot the value and then the exponent (if any) beneath it
C
CALL APNUMB(PENPSX,PENPOS(Y),TKLSIZ,TIKVAL,0.0,2)
CALL APPLEX(EXPPOS,EXPVAL)
END
SUBROUTINE APILLB(XY,PENPOS,EXPPOS,LTKVAL,NXTVAL,EXPMIN)
INTEGER	XY
REAL	PENPOS(2), EXPPOS(2), LTKVAL, NXTVAL, EXPMIN
C
C  Write an integer logarithmic value at the current tick
C
C  XY		1 = X-axis; 2 = Y-axis
C  PENPOS	[x:y] position to write value
C  EXPPOS	[x:y] position to write exponent
C  LTKVAL	logarithm of value at this tick
C  NXTVAL	logarithm of value at next tick
C  EXPMIN	minimum exponent created in adjustments so far
C
INTEGER	X, Y
REAL	RV, RD, POWMAX, APPWR, TIKVAL, EXPVAL, PENPSX
REAL	EXPDIG, TKLSIZ
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
EQUIVALENCE (TKLSIZ,APPARM(19))
C
DATA	POWMAX/4.0/
C
C
C	Form the tick and exponent values
C
TIKVAL = EXP(LTKVAL)
EXPVAL = APPWR(TIKVAL)
C
C	If the power is greater than the maximum that will fit,
C	adjust the tick and exponent values making the tick
C	value small enough.
C
IF(EXPVAL.LE.POWMAX) GOTO 110
EXPVAL = EXPVAL - POWMAX
TIKVAL = TIKVAL / (10.0 ** EXPVAL)
GOTO 199
```
```C
C	Otherwise, the value may only be different from the next
C	tick value by it's fractional part, or it may only have
C	a fractional part. In both these cases, attempt to adjust
C	the tick and exponents so that a integer part exists
C	(because that is all that will be printed), and so that
C	it is different from the next tick.
C
110	  NXTVAL = EXP(NXTVAL)
EXPVAL = EXPMIN
TIKVAL = TIKVAL / (10.0 ** EXPMIN)
C
C	    Now try for the fractional case
C
EXPVAL = EXPMIN
EXPMIN = 0.0
120	    CONTINUE
130	  CONTINUE
199	CONTINUE
C
C	Alter the X pen position to compensate for the number
C	of digits in the value and a possible negative value
C
EXPDIG = 1.0
IF(TIKVAL.GE.1.0) EXPDIG = APPWR(TIKVAL) + 1.0
EXPDIG = EXPDIG * TKLSIZ / 2.0
PENPSX = PENPOS(X) - EXPDIG
IF(XY.EQ.Y) PENPSX = PENPSX - EXPDIG
TIKVAL = TIKVAL + RD
C
C	Plot the value and the exponent if it exists
C
CALL APNUMB(PENPSX,PENPOS(Y),TKLSIZ,TIKVAL,0.0,-1)
IF(EXPVAL.NE.0.0) CALL APPLEX(EXPPOS,EXPVAL)
C
C
END
REAL	TIKVAL, NXTVAL, EXPMIN, POWMAX
C
C  Up the value and reduce the exponent until either the integer
C  parts of the two values are different or the value is larger
C  than the maximum
C
C  TIKVAL	value to be changed
C  NXTVAL	value for comparison
C  EXPMIN	exponent for varying
C  POWMAX	maximum power permitted
C
REAL	APPWR
C
C
100	IF(AINT(TIKVAL).NE.AINT(NXTVAL).OR.APPWR(TIKVAL).GE.POWMAX)
*			RETURN
TIKVAL = TIKVAL * 10.0
NXTVAL = NXTVAL * 10.0
EXPMIN = EXPMIN - 1.0
GOTO 100
C
END
SUBROUTINE APPLEX(EXPPOS,EXPVAL)
REAL	EXPPOS(2), EXPVAL
C
C  plot an exponent as a multiplication by 10**n on the line below
C  the tick value
C
C  XY		1 : X-axis, 2 : Y-axis
C  EXPPOS	[x:y] position of exponent multiplier
C  EXPVAL	value of exponent
C
INTEGER	X, Y
REAL	XPOS, YPOS, EXPDIG, APPWR
REAL	TKESIZ, TKPSIZ, TKECLR
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
EQUIVALENCE (TKESIZ,APPARM(39))
EQUIVALENCE (TKPSIZ,APPARM(40))
EQUIVALENCE (TKECLR,APPARM(41))
C
C
C	Don't bother if exponent is zero!
C
IF(EXPVAL.EQ.0.0) RETURN
C
C	Position pen for plotting '*10' and plot it
C
EXPDIG = APPWR(EXPVAL)
IF(EXPDIG.LT.0.0) EXPDIG = EXPDIG + 1.0
XPOS = EXPPOS(X) - (EXPDIG + 1.0) * TKPSIZ / 2.0
YPOS = EXPPOS(Y) - TKESIZ - TKECLR
CALL APSYMB(XPOS,YPOS,TKESIZ,'*10',0.0,3)
C
C	Position pen for plotting exponent and plot it
C
XPOS = XPOS + TKESIZ * 3.0
YPOS = YPOS + TKESIZ / 3.0
CALL APNUMB(XPOS,YPOS,TKPSIZ,EXPVAL,0.0,-1)
END
LOGICAL FUNCTION APLOGN(VAL)
REAL	VAL(2)
C
C  Return the log of the values in the array if logging on the
C  respective axes
C
C  VAL		X,Y values for logs to be taken and returned
C
INTEGER	XY, X, Y
LOGICAL	FLLOG
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APLOG/FLLOG(2)
C
APLOGN = .FALSE.
DO 100 XY = X, Y
IF(.NOT.FLLOG(XY)) GOTO 100
IF(VAL(XY).LT.0.0) GOTO 999
IF(VAL(XY).GT.0.0) VAL(XY) = ALOG(VAL(XY))
100	CONTINUE
C
C
ENTRY	APLDM2(DUM)
RETURN
C
C	Plotting log of negative number
C
999	WRITE(LU,9990) VAL(XY)
9990	FORMAT(' %ATPAPL Attempt to plot log of ',E10.4,
*		' - point ignored')
END
SUBROUTINE ATOCHL(XY,NMLBL,TXLBL,TIKINC,TIKSTV)
INTEGER	XY, NMLBL, TXLBL(NMLBL)
REAL	TIKINC, TIKSTV
C
C  Draw character labels at the ticks on the axes instead of
C  the normal numeric labels.
C  The routine ATOPAL initialises character labels for either
C  the X or Y axis - two calls are needed for both.
C
C  XY		flag 0=x-axis and 1=y-axis
C  NMLBL	the number of labels in array TXLBL
C  TXLBL	array each word contains 5 character label
C  TIKINC	real increment between ticks
C  TIKSTV	first tick value
C
C
INTEGER NMLABL, TXLABL, IXTIK, I, TKLTYP, MXTXL, LU
LOGICAL	FLALF, APXY
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APALF/FLALF(2), NMLABL(2), TXLABL(24,2), MXTXL
C
DATA	FLALF, MXTXL/.FALSE., .FALSE., 24/
DATA	TKLTYP/31/
C
C
IF(APXY(IABS(XY))) RETURN
IF(XY.GT.0) GOTO 10
FLALF(IABS(XY)) = .FALSE.
RETURN
10	IF(NMLBL.EQ.0) RETURN
IF(IABS(NMLBL).LE.MXTXL) GOTO 50
WRITE(LU,6000)
6000	  FORMAT(' %ATPTML Too many text labels supplied')
RETURN
50	CONTINUE
FLALF(XY) = .TRUE.
C
C	Copy the text details into local storage
C
NMLABL(XY) = NMLBL
DO 100 I = 1,IABS(NMLBL)
TXLABL(I,XY) = TXLBL(I)
100	CONTINUE
C
C	Set the tick details into the parameter block
C
IF(TIKINC.EQ.0.0) GOTO 200
IXTIK = TKLTYP + XY - 1
CALL ATOPRM(1,IXTIK,2.)
CALL ATOPRM(1,IXTIK+2,TIKINC)
CALL ATOPRM(1,IXTIK+4,TIKSTV)
200	CONTINUE
C
C
CALL APCDM1
END
SUBROUTINE APCLAB(XY,TSPC)
INTEGER	XY
REAL	TSPC
C
C  Starting from the 'origin', advance along the axis, writing a
C  character label at every other tick.  If the labels run out
C  before the ticks, use the array of labels over again.
C
C  XY		1 : X-axis, 2 : Y-axis
C  TSPC		tick spacing
C
C
INTEGER	NLAB, CTIK, CLAB, X, Y, NMLABL, TXLABL
INTEGER	TIKTYP, NUMTIK
REAL	PENPOS(2), APPARM, PENORG(2), AXISLN(2)
REAL	XORG, YORG, TKLSIZ, TKLCLR
LOGICAL	FLALF, APXY
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
COMMON	/APALF/FLALF(2), NMLABL(2), TXLABL(24,2), MXTXL
C
EQUIVALENCE (AXISLN,APPARM(3))
EQUIVALENCE (PENORG,APPARM(5))
EQUIVALENCE (XORG,APPARM(5))
EQUIVALENCE (YORG,APPARM(6))
EQUIVALENCE (TKLSIZ,APPARM(19))
EQUIVALENCE (TKLCLR,APPARM(20))
C
C
IF(APXY(XY).OR..NOT.FLALF(XY)) RETURN
IF(TIKTYP(XY).NE.2) GOTO 900
C
C	Set pen position for the first tick
C
IF(XY.EQ.Y) GOTO 110
PENPOS(X) = XORG - (2.5 * TKLSIZ)
PENPOS(Y) = YORG - TKLCLR - TKLSIZ
GOTO 120
110	  PENPOS(X) = XORG - TKLCLR - (5.0 * TKLSIZ)
PENPOS(Y) = YORG
120	CONTINUE
```
```C
C
C
IF(NMLABL(XY).LT.0) PENPOS(XY) = PENPOS(XY) + (TSPC / 2.0)
NLAB = IABS(NMLABL(XY))
C
CLAB = 1
C
C	Loop here writing each tick. Each alternate tick is awarded
C	a label.
C
DO 299 CTIK = 0, NUMTIK(XY), 2
CALL APSYMB(PENPOS(X),PENPOS(Y),TKLSIZ,TXLABL(CLAB,XY),0.,5)
CLAB = CLAB + 1
IF(CLAB.GT.NLAB) CLAB = 1
PENPOS(XY) = PENPOS(XY) + TSPC * 2.0
299	CONTINUE
C
C
ENTRY	APCDM1
RETURN
C
C	Error - must have tick value specified for character labels
C
900	WRITE(LU,9000)
9000	FORMAT(' %ATPNOV No origin value given with character labels')
END
LOGICAL FUNCTION APXY(FL)
INTEGER	FL
C
C  Return true if FL is outside the range [1:LM], else false.
C  If the result is true, warn the user.
C
C  FL	integer, restricted to [1,LM]
C
INTEGER	LU
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
C
APXY = .FALSE.
IF(FL.EQ.1.OR.FL.EQ.2) RETURN
C
WRITE(LU,9999) FL
9999	FORMAT(' %ATPIOR XY-axis indicator out of range',I)
APXY = .TRUE.
END
SUBROUTINE ONEPLS(XD,YD,ND,XT,NXT,YT,NYT,PT,NPT)
INTEGER	ND, NXT, NYT, NPT, XT(1), YT(1), PT(1)
REAL	XD(ND), YD(ND)
C
C  As ONEPLT but add a least squares line. ONEPLS does not leave least
C  squares line drawing set.
C
C  Parameter list as ONEPLT.
C
C
CALL ATOLSQ(+1,1)
CALL ONEPLT(XD,YD,ND,XT,NXT,YT,NYT,PT,NPT)
CALL ATOLSQ(-1)
END
SUBROUTINE ONEPLP(XD,YD,ND,XT,NXT,YT,NYT,PT,NPT,XP,YP)
INTEGER	ND, NXT, NYT, NPT, XT(1), YT(1), PT(1)
REAL	XD(ND), YD(ND), XP, YP
C
C  As ONEPLT but add a least squares line. ONEPLP does not leave least
C  squares line drawing set.
C
C  Parameter list as ONEPLT.
C  XP,YP	point through which least squares line passes
C
C
CALL ATOLSP(1,1,XP,YP)
CALL ONEPLT(XD,YD,ND,XT,NXT,YT,NYT,PT,NPT)
CALL ATOLSP(-1)
END
SUBROUTINE ATOLSQ(N,DATSET)			![33]
INTEGER	DATSET(N), N
C
C  Initialise the least squares plotting code with the data
C  sets that are to have least squares lines plotted when
C  ATOPLT is called.
C
C  DATSET	each member holds the number of a data set
C  N		size of the DATSET array
C
INTEGER	NMLQDS, LSQDST, LU, I
LOGICAL FLLSQ
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APLSQ/FLLSQ, FLLSP, NMLQDS, NMLPDS
COMMON	/APLSQ/LSQDST(14), LSPDST(14), XLSQ(14), YLSQ(14)
DATA	FLLSQ/.FALSE./
C
C
IF(N.GT.14) GOTO 900
C
FLLSQ = (N.GT.0)
IF(N.LE.0) RETURN
NMLQDS = N
DO 110 I = 1, N
LSQDST(I) = IABS(DATSET(I))
110	CONTINUE
C
C
CALL APQDM1
RETURN
C
C  Error - number of data sets larger than permitted
C
900	WRITE(LU,9000) N
9000	FORMAT(' %ATPTMD Too many datasets in ATOLSQ call: ',I)
END
SUBROUTINE APPLSQ(XP,YP,ID,ND,FLONE)
INTEGER	ID(ND), ND
LOGICAL	FLONE
REAL	XP(ND), YP(ND)
C
C  Set up a call to the least squares calculator and plotter
C
C  XP,YP	data points for all data sets
C  ID		set IDs for each point
C  ND		size of XP, YP, ID
C  FLONE	true if called from ONEPLT
C
LOGICAL	FLLSQ
C
COMMON	/APLSQ/FLLSQ, FLLSP, NMLQDS, NMLPDS
COMMON	/APLSQ/LSQDST(14), LSPDST(14), XLSQ(14), YLSQ(14)
C
C
IF(FLLSQ)
*	    CALL APLSQC(XP,YP,ID,ND,NMLQDS,LSQDST,0.0,0.0,.FALSE.,FLONE)
C
C	Dummy entry to force loadting
C
ENTRY	APQDM1
END
SUBROUTINE ATOLSP(N,DATSET,XPT,YPT)		![33]
INTEGER	DATSET(N), N
REAL	XPT(N), YPT(N)
C
C  Initialise the least squares plotter to plot a least squares
C  line through a fixed point when ATOPLT is called.
C
C  DATSET	array containing IDs of data sets for least squares
C  XPT,YPT	(X,Y) arrays for fixed points
C  N		size of the DATSET, XPT and YPT arrays
C
INTEGER	NMLPDS, LSPDST, LU, I
LOGICAL	FLLSP
REAL	XLSQ, YLSQ
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APLSQ/FLLSQ, FLLSP, NMLQDS, NMLPDS
COMMON	/APLSQ/LSQDST(14), LSPDST(14), XLSQ(14), YLSQ(14)
DATA	FLLSP/.FALSE./
C
C
IF(N.GT.14) GOTO 900
FLLSP = (N.GT.0)
IF(N.LE.0) RETURN
NMLPDS = N
DO 110 I = 1, N
LSPDST(I) = IABS(DATSET(I))
XLSQ(I) = XPT(I)
YLSQ(I) = YPT(I)
110	CONTINUE
C
C
CALL APPDM1
RETURN
C
C  Error - array index exceeds bounds
C
900	WRITE(LU,9000) N
9000	FORMAT(' %ATPTMD Too many datasets in ATOLSP call: ',I)
END
SUBROUTINE APPLSP(XP,YP,ID,ND,FLONE)
INTEGER	ID(ND), ND
LOGICAL	FLONE
REAL	XP(ND), YP(ND)
C
C  Dummy entry to call in the routine which does all the
C  least squares calculation and plotting
C
C  XP,YP	original array holding all points for all sets
C  ID		original array holding set IDs
C  ND		number of members in arrays
C  FLONE	true if called by ONEPLT
C
LOGICAL	FLLSP
C
COMMON	/APLSQ/FLLSQ, FLLSP, NMLQDS, NMLPDS
COMMON	/APLSQ/LSQDST(14), LSPDST(14), XLSQ(14), YLSQ(14)
C
C
IF(FLLSP)
*	   CALL APLSQC(XP,YP,ID,ND,NMLPDS,LSPDST,XLSQ,YLSQ,.TRUE.,FLONE)
C
C
ENTRY APPDM1
END
SUBROUTINE APLSQC(XP,YP,ID,ND,NMLDS,LSDST,XLSQ,YLSQ,FLFXP,FLONE)
INTEGER	ID(ND), ND, NMLDS, LSDST(NMLDS)
REAL	XP(ND), YP(ND), XLSQ(NMLDS), YLSQ(NMLDS)
LOGICAL	FLFXP, FLONE
C
C  Calculate and plot the least squares line for all the required
C  data sets
C
C  XP,YP	original ATOPLT data points
C  ID		data set indicators
C  ND		size of XP, YP, ID
C  LSDST	least squares data set indicators
C  XLSQ,YLSQ	fixed points for least squares lines
C  NMLDS	size of XLSQ, YLSQ and LSDST
C  FLFXP	true if fixed point required
C  FLONE	true if called by ONEPLT
C
INTEGER	DS, PT, X, Y, MOV, DRW, IDA, ILS, FLNOT(14)
LOGICAL	APENC, APLOGN
REAL	SUMX, SUMY, SUMXY, SUMXX, DATVAL(2)
REAL	SLOPE, ICEPT, XN, XLS(2), YLS(2)
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (XPT,DATVAL(1)), (YPT,DATVAL(2))
C
C
C
SUMX = 0.0
SUMY = 0.0
SUMXY = 0.0
SUMXX = 0.0
XN = FLOAT(ND)
IDA = IABS(ID(1))
C
C	Loop here for each data set, calculating and plotting
C	the least squares line
C
DO 299 DS = 1, NMLDS
C
C	  Loop here for each point adding it into the least
C	  square sums if it belongs to the correct data set
C
DO 199 PT = 1, ND
IF(.NOT.FLONE) IDA = IABS(ID(PT))
IF(IDA.NE.LSDST(DS)) GOTO 199
XPT = XP(PT)
YPT = YP(PT)
IF(APLOGN(DATVAL)) GOTO 190
SUMX = SUMX + XPT
SUMY = SUMY + YPT
SUMXY = SUMXY + XPT * YPT
SUMXX = SUMXX + XPT * XPT
190	      CONTINUE
199	  CONTINUE
```
```C
C	  Unless nothing there, calculate the slope and intercept
C	  for the least squares line - note that this is different
C	  for the fixed point case.
C
IF(SUMXX.EQ.0.0) GOTO 299
C
IF(FLFXP) GOTO 210
SLOPE = SUMXY * XN - SUMX * SUMY
SLOPE = SLOPE / (SUMXX * XN - SUMX * SUMX)
ICEPT = (SUMY - SLOPE * SUMX) / XN
GOTO 220
210	    XPT = XLSQ(DS)
YPT = YLSQ(DS)
IF(APLOGN(DATVAL)) GOTO 215
SLOPE = (SUMXY - XPT * SUMY - YPT * SUMX) - XPT * YPT * XN
SLOPE = SLOPE / (SUMXX - 2.0 * SUMX * XPT + XPT * XPT * XN)
ICEPT = YPT - SLOPE * XPT
215	    CONTINUE
220	  CONTINUE
C
C	  check whether the line fits the box
C
XLS(1) = ORGVAL(X)
XLS(2) = ENDVAL(X)
YLS(1) = XLS(1) * SLOPE + ICEPT
YLS(2) = XLS(2) * SLOPE + ICEPT
CALL APLINE(XLS,YLS,-14,2,FLNOT,.TRUE.)
299	CONTINUE
END
SUBROUTINE ATOGET(NP,IP,PARM)
INTEGER	NP, IP(NP)
REAL	PARM(NP)
C
C  Return the current values of the ATOPLT parameters specified
C  by the IP array
C
C  NP		number of parameters
C  IP		array of parameter indices into APPARM
C  PARM		returned as parameter values
C
INTEGER	I, APLO, APHI
LOGICAL	APPCHK
REAL	APPARM
C
COMMON	/APPRM/APPARM(45), APLO, APHI
C
C
IF(NP.LE.0) RETURN
C
DO 100 I = 1, NP
IF(APPCHK(IP(I))) RETURN
PARM(I) = APPARM(IP(I))
100	CONTINUE
END
SUBROUTINE ATOPRM(NP,IP,PARM)
INTEGER	NP, IP(NP)
REAL	PARM(NP)
C
C  Set the given parameters into the APPARM array of ATOPLT
C  parameters after checking first that the value is
C  reasonable.
C
C  NP		number of parameters to be set
C  IP		indices of the parameters in APPARM
C  PARM		array of values of parameters
C
INTEGER	I, APLO, APHI, HICHEK(45), LOCHEK(45), IPI, LU
LOGICAL	APPCHK
REAL	APPARM, P, CHEK, APPVAL
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APPRM/APPARM(45), APLO, APHI
DATA	HICHEK/1004, 1004,    1,    2,    1,    2,    4,    4,
*			  1,    3,    3,    6,    5,    4,    5,    6,
*			  2,    2,    6,    6,    9,    9,    4,    4,
*			  4,    3, 1002, 1004, 1004, 1002, 1003, 1003,
*		       1004, 1004, 1004, 1004, 1002, 1002,    6,   39,
*			 39,    5,    6,    6,    4/
DATA	LOCHEK/26*1001, 3*1005, 5*1001, 2*1005, 9*1001/
C
C
IF(NP.LE.0) RETURN
C
DO 100 I = 1, NP
IPI = IP(I)
IF(APPCHK(IPI)) RETURN
P = PARM(I)
CHEK = APPVAL(HICHEK(IPI))
IF(P.LE.CHEK) GOTO 10
WRITE(LU,9000) IPI, P, CHEK
9000	    FORMAT(' %ATPPXV ATOPRM parameter ',I2,' value ',F,
*		   ' exceeds ',F)
GOTO 100
10	CONTINUE
C
C	  Now check against the lower bound
C
CHEK = APPVAL(LOCHEK(IPI))
IF(P.GE.CHEK) GOTO 20
WRITE(LU,9001) IPI, P, CHEK
9001	    FORMAT(' %ATPPLV ATOPRM parameter ',I2,' value ',F,
*	  	   ' is less than ',F)
GOTO 100
20	  CONTINUE
C
C	  All ok - as far as we can tell - set the new value
C
APPARM(IPI) = P
100	CONTINUE
C
C
END
LOGICAL FUNCTION APPCHK(I)
INTEGER	I
C
C  Check that I is in the range of ATOPLT parameters
C
C  I	to be checked
C
INTEGER	APLO, APHI, LU
REAL	APPARM
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
C
APPCHK = .FALSE.
IF(I.GE.APLO.AND.I.LE.APHI) RETURN
APPCHK = .TRUE.
WRITE(LU,9000) I
9000	FORMAT(' %ATPPOR ATOPRM index ',I,' out of range')
END
REAL FUNCTION APPVAL(I)
INTEGER	I
C
C  Depending on whether I is greater than 1000 or not:
C  > 1000	return a fixed constant
C  < 1000	return the indexed member of APPARM
C  unless I = 1 or 2 : then scale the value before returning
C  it, using the standard scale factor.
C
REAL	APPARM, CONST(5), SCLFAC(2)
C
COMMON	/APPRM/APPARM(45), APLO, APHI
C
EQUIVALENCE (SCLFAC,APPARM(28))
C
DATA	CONST/ 0.0, 1.0, 2.0, "377777777777, -"377777777777/
C
C
IF(I.GT.1000) APPVAL = CONST(I - 1000)
IF(I.LE.1000) APPVAL = APPARM(I)
IF(I.LE.2) APPVAL = APPARM(I) * SCLFAC(I)
END
SUBROUTINE ONEPLT(XD,YD,ND,XT,NXT,YT,NYT,PT,NPT)
INTEGER	ND, XT(1), NXT, YT(1), NYT, PT(1), NPT
REAL	XD(ND), YD(ND)
C
C  Plot a graph as for ATOPLT, but only have one data set and
C  no notes box
C
C  XD,YD	array containing data points
C  ND		size of XD, YD
C  XT		array containing X-axis title
C  NXT		number of characters in XT
C  YT		array containing Y-axis title
C  NYT		number of character in YT
C  PT		array containing plot title
C  NPT		number of characters in PT
C
INTEGER	ID, FLNOT(14)
LOGICAL	APDATA
C
C
CALL APNAME
C
C	set up the symbol for plotting at all data points
C
ID = 1
IF(NXT.LT.0) ID = -1
IF(NYT.LT.0) ID = -14
C
C	initialise the data base
C
IF(APDATA(XD,YD,ND)) RETURN
C
C	draw the graph border and label it
C
CALL APBORD(XT,IABS(NXT),YT,IABS(NYT),PT,NPT)
C
C	draw the symbols and line
C
CALL APLINE(XD,YD,ID,ND,FLNOT,.TRUE.)
C
C	add least squares lines if required
C
CALL APPLSQ(XD,YD,ID,ND,.TRUE.)
CALL APPLSP(XD,YD,ID,ND,.TRUE.)
C
C	terminate the plot if required
C
CALL APCLOS
END
SUBROUTINE ATOPLT(XD,YD,ID,ND,XT,NXT,YT,NYT,PT,NPT,NOT,NN)
INTEGER	ND, XT(1), NXT, YT(1), NYT, PT(1), NPT, NOT(NN,4), NN
REAL	XD(ND), YD(ND), ID(ND)
C
C  Plot a complete graph comprising an enclosing box with a title,
C  ticks, labels and titles along the X and Y axes, a box at the
C  right hand side containing explanations of the data plotted, and
C  up to 14 different data sets, whose points may be connected if
C  desired.
C
C  XD,YD	arrays containing the data points
C  ID		array containing the data set ID for each point
C  ND		dimension of XD,YD,ID
C  XT		array containing X-axis title
C  NXT		characters in X-axis title
C  YT		array containing Y-axis title
C  NYT		characters in Y-axis title
C  PT		array containing plot title
C  NPT		characters in plot title
C  NOT		array containing text of description of each line for
C		notes box.
C  NN		number of notes in NOT
C
INTEGER FLNOT(14)
LOGICAL APDATA
C
C
CALL APNAME
C
IF(APDATA(XD,YD,ND)) RETURN
C
C	Initialise drawing the graph
C
CALL APBORD(XT,NXT,YT,NYT,PT,NPT)
C
C	Draw the data sets
C
CALL APLINE(XD,YD,ID,ND,FLNOT,.FALSE.)
C
C	Add the notes to the notes box
C
CALL APNOTE(NOT,NN,FLNOT)
C
C	Add least squares lines if required
C
CALL APPLSQ(XD,YD,ID,ND,.FALSE.)
CALL APPLSP(XD,YD,ID,ND,.FALSE.)
C
C	Close down ATOPLT
C
CALL APCLOS
END
LOGICAL FUNCTION APDATA(XD,YD,ND)
INTEGER	ND
REAL	XD(ND), YD(ND)
C
C  Initialise the data details for ATOPLT by finding the data
C  maxima and minima and by initialising details for log
C  plotting
C
C  XD,YD	arrays of X,Y data points
C  ND		number of data points
C
INTEGER	TIKTYP, XY, X, Y, NUMTIK
LOGICAL	FLINT, APLOGN
REAL	TKLTYP(2), TKLINC(2), TKLVAL(2), TKLINT(2)
REAL	ORGVAL, MINVAL, MAXVAL, TIKINC, TIKVAL, TIKSPC
REAL	AXISLN(2), TIKSIZ, XTKSIZ, YTKSIZ, XTKSPC, YTKSPC
REAL	ORGPOS(2), ENDPOS
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (AXISLN,APPARM(3))
EQUIVALENCE (ORGPOS,APPARM(5))
EQUIVALENCE (XTKSIZ,APPARM(7))
EQUIVALENCE (XTKSPC,APPARM(10))
EQUIVALENCE (YTKSIZ,APPARM(26))
EQUIVALENCE (TKLTYP,APPARM(31))
EQUIVALENCE (TKLINC,APPARM(33))
EQUIVALENCE (TKLVAL,APPARM(35))
EQUIVALENCE (TKLINT,APPARM(37))
EQUIVALENCE (YTKSPC,APPARM(45))
C
C
APDATA = .FALSE.
IF(ND.LE.0) GOTO 980
CALL APRANG(XD,ND,MINVAL(X),MAXVAL(X))
CALL APRANG(YD,ND,MINVAL(Y),MAXVAL(Y))
IF(APLOGN(MINVAL).OR.APLOGN(MAXVAL)) GOTO 990
TIKSIZ(X) = XTKSIZ
TIKSIZ(Y) = YTKSIZ
TIKSPC(X) = XTKSPC
TIKSPC(Y) = YTKSPC
DO 100 XY = X, Y
TIKINC(XY) = TKLINC(XY)
TIKVAL(XY) = TKLVAL(XY)
TIKTYP(XY) = IFIX(TKLTYP(XY))
FLINT(XY)  = (TKLINT(XY).EQ.1.0)
100	CONTINUE
IF(APLOGN(TIKINC).OR.APLOGN(TIKVAL)) GOTO 990
DO 200 XY = X,Y
CALL APAXIS(TIKTYP(XY),ORGVAL(XY),MINVAL(XY),MAXVAL(XY),
*		      TIKINC(XY),TIKVAL(XY),TIKSPC(XY),AXISLN(XY))
ENDVAL(XY) = ORGVAL(XY) + AXISLN(XY) * TIKINC(XY) / TIKSPC(XY)
NUMTIK(XY) = AXISLN(XY) / TIKSPC(XY)
ENDPOS(XY) = ORGPOS(XY) + AXISLN(XY)
200	CONTINUE
RETURN
C
C	Number of points out of range
C
980	WRITE(LU,9800) ND
9800	FORMAT(' %ATPTFP Too few data points: ',I,' - plot aborted')
C
C
990	APDATA = .TRUE.
END
SUBROUTINE APRANG(D,N,MINV,MAXV)
INTEGER	N
REAL	D(N), MINV, MAXV
C
C  Find the maximum and minimum from the array and store it
C  for later
C
INTEGER	I
REAL	RD
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
C
MINV = D(1)
MAXV = D(1)
DO 100 I = 2,N
IF(MINV.GT.D(I)) MINV = D(I)
IF(MAXV.LT.D(I)) MAXV = D(I)
100	CONTINUE
END
SUBROUTINE APAXIS(TYP,ORGV,MINV,MAXV,TINC,TVAL,TSPC,AXIS)
INTEGER	TYP
REAL	ORGV, MINV, MAXV, TINC, TVAL, TSPC, AXIS
C
C  Initialise various parameters to do with the axis depending
C  on the type of labelling required by the caller
C
C  TYP		0 : increment and origin to be calculated given nothing
C		1 : one tick value given
C		2 : origin value given - windowing to be done
C  ORGV		returns value at origin
C  MINV		minimum data value
C  MAXV		maximum data value
C  TINC		0 : increment to be calculated and returned
C		n : given increment
C  TVAL		given tick value (type 1) or origin value (type 2)
C  TSPC		returns calculated tick spacing if increment given
C  AXIS		length of the axis
C
REAL	NTIK, APRND, RD, EXPMAX
REAL	TKVAL, OTINC,  NTK, LONG, SCALER
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
C
NTIK = AXIS / TSPC
C
C	if the tick increment is unspecified, treat each type
C	differently
C
IF(TINC.EQ.0.0) GOTO 400
GOTO (200, 300), TYP
C
C Type 0  Increment given      Value not considered
C	  The origin is the multiple of the tick increment
C	  below the minimum value, and the tick spacing can
C	  be calculated from there.
C
100	  ORGV = APRND(MINV,-TINC)
TSPC = AXIS * TINC / APRND(MAXV - ORGV,TINC)
RETURN
C
C Type 1  Increment given      Value given
C	  The origin is a multiple of the tick increment
C	  below the minimum value.  If the tick value is
C	  less than the minimum, the origin is below the
C	  tick value. The spacing is calculated accordingly.
C
200	  ORGV = TVAL
IF(TVAL.GT.MINV) ORGV = ORGV - APRND(TVAL - MINV,TINC)
TSPC = AXIS * TINC / APRND(AMAX1(TVAL,MAXV) - ORGV,TINC)
RETURN
```
```C
C Type 2  Increment given      Origin given
C	  No problems at all
C
300	  ORGV = TVAL
RETURN
C
C	VARIABLE INCREMENT
C
400	NTK = 0.0
IF(TYP.EQ.0.AND.TVAL.EQ.0.0) GOTO 500
C
C 	  One tick value fixed
C	  Calculate the origin and increment
C
IF(TYP.NE.2.AND.MINV.LT.TVAL) GOTO 410
C
C	    TVAL  <=  MINV
C
TKVAL = TVAL
TINC = (MAXV - TVAL) / NTIK
GOTO 440
410	    IF(MAXV.GT.TVAL) GOTO 420
C
C	      TVAL  >=  MINV
C
TINC = (TVAL - MINV) / NTIK
NTK = NTIK
GOTO 430
C
C	      MINV  <  TVAL  <  MAXV
C
420	      LONG = AMAX1((MAXV - TVAL),(TVAL - MINV))
NTK  = AINT(LONG * NTIK / (MAXV - MINV) + RV)
TINC = LONG / NTK
IF(LONG.GT.(TVAL - MINV)) NTK = NTIK - NTK
430	    CONTINUE
TKVAL = TVAL
440	  CONTINUE
GOTO 600
C
C	  Type 0  value unspecified
C
500	  SCALER = 10.0 ** APPWR(AMAX1(ABS(MINV),ABS(MAXV)))
TKVAL = APRND(MINV / SCALER,-0.5) * SCALER
TINC = (MAXV - TKVAL) / NTIK
600	CONTINUE
C
C	Finally, improve the calculated tick increment and origin
C	values by rounding the tick increment up until it reaches
C	a value that rounds nicely at every second tick and
C	covers the data as neatly as possible
C
IF(TINC.EQ.0.0) TINC = 1.0
610	ORGV = TKVAL - TINC * NTK
OTINC = TINC
EXPMAX = APPWR(AMAX1(ABS(ORGV),ABS(ORGV + TINC * NTIK)))
SCALER = RD * (10.0 ** EXPMAX)
TINC = APRND(TINC,SCALER)
IF(OTINC.LT.TINC) GOTO 610
END
SUBROUTINE APBORD(XT,NXT,YT,NYT,PT,NPT)
INTEGER	NXT, NYT, NPT
REAL	XT(1), YT(1), PT(1)
C
C  Initialise the plot including drawing the frame, adding the
C  titles, and plotting the tick labels
C
REAL	EXPVAL(2)
C
C
CALL APOPEN
CALL APVERS
CALL APFRAM
CALL APLABL(EXPVAL)
CALL APTITL(XT,NXT,YT,NYT,PT,NPT,EXPVAL)
END
SUBROUTINE APVERS
C
C  Plot a signature including my name, version number, and the
C  time and date of the plot.
C
INTEGER	TODAY(2), NOW, VERSIO, VCHAR
REAL	XP, YP, XPOS, YPOS, VERSIZ, V
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APVER/VERSIO(3), VCHAR, VEDIT
C
EQUIVALENCE (XP,APPARM(42))
EQUIVALENCE (YP,APPARM(43))
EQUIVALENCE (VERSIZ,APPARM(44))
C
C
CALL DATE(TODAY)
CALL TIME(NOW)
C
C
IF(VERSIZ.LE.0.0) RETURN
V = VERSIZ / 2.0
CALL APSYMB(XP,YP*2.0+V,VERSIZ,VERSIO,0.0,VCHAR)
CALL APSYMB(XP,YP+V,VERSIZ,'at ',0.0,3)
CALL APWHER(XPOS,YPOS)
CALL APSYMB(XPOS,YPOS,VERSIZ,NOW,0.0,5)
CALL APSYMB(XP,V,VERSIZ,'on ',0.0,3)
CALL APWHER(XPOS,YPOS)
CALL APSYMB(XPOS,YPOS,VERSIZ,TODAY,0.0,9)
END
SUBROUTINE APFRAM
C
C  Draw a box to contain the lines and draw ticks on the inside
C  of each of the box.
C  If the tick shading is nonstandard, take two passes and write the
C  ticks the second time around
C
REAL	TIKDEN, TIKSIZ, TKHDIF, NOSIZE(2)
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (TKHDIF,APPARM(8))
EQUIVALENCE (TIKDEN,APPARM(27))
C
DATA	NOSIZE/0.0, 0.0/
C
C
C	Do things different ways depending on whether the ticks
C
C
C
C	  not shaded - go write box and ticks together
C
CALL APTICK(DRW,TIKSIZ,TKHDIF)
GOTO 30
20	CONTINUE
C
C
CALL APTICK(DRW,NOSIZE,0.0)
CALL APTICK(MOV,TIKSIZ,TKHDIF)
30	CONTINUE
C
C
END
SUBROUTINE APTICK(PEN,TSIZ,TDIF)
INTEGER	PEN
REAL	TSIZ(2), TDIF
C
C  Plot either the sides of the box or the ticks or both together
C  The routine starts at the origin  and works around the box
C  continuously, drawing the sides forward or backward as required.
C  If the tick size is zero, no ticks are drawn.
C
C  PEN		MOV => don't draw the box edges
C		DRW => draw the edges
C  TSIZ		2-array with tick sizes on each axes
C  TDIF		difference in heigths between alternate ticks
C
INTEGER	X, Y, XY, YX, MOV, DRW, I, NUMT, NUMTIK
INTEGER	DIR(4), SID, FB, BAK
REAL	TIKPOS(2), TIKEND(2), TKDIF, SXY, AXLIM(2), TKSIZ
REAL	XORG, YORG, AXISLN(2), TIKSPC, TSPC
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (AXISLN,APPARM(3))
EQUIVALENCE (XORG,APPARM(5))
EQUIVALENCE (YORG,APPARM(6))
C
DATA	BAK, DIR/1, -1, -1, 1, 1/
C
C
XY = X
AXLIM(X) = XORG
AXLIM(Y) = YORG
C
C	Move to origin to start box
C
CALL APPLOT(XORG,YORG,MOV)
C
C	Loop drawing each side of the box
C
DO 100 SID = 1, 4
YX = 3 - XY
TKSIZ = TSIZ(XY)
FB = DIR(SID)
TIKPOS(X) = AXLIM(X)
TIKPOS(Y) = AXLIM(Y)
AXLIM(XY) = TIKPOS(XY) - AXISLN(XY) * FB
AXLIM(YX) = TIKPOS(YX)
NUMT = NUMTIK(XY) - 1
C
C	  Calculate the height of the bigger tick and the difference
C	  between them
C
SXY = FLOAT(3 - 2 * YX)
TKDIF = FB * TDIF * SXY
TIKEND(YX) = TIKPOS(YX) + FB * SXY * TKSIZ
C
C	  Set the position of the first tick
C	  Set the height of the first tick if moving backwards
C
IF(FB.EQ.BAK) GOTO 30
C
C	    Moving forwards
C
TSPC = TIKSPC(XY)
TIKPOS(XY) = TIKPOS(XY) + TSPC
GOTO 40
30	  CONTINUE
C
C	    Moving backwards
C
TSPC = -TIKSPC(XY)
TIKPOS(XY) = AXLIM(XY) + NUMT * TIKSPC(XY)
IF(MOD(NUMT,2).NE.0) GOTO 35
TIKEND(YX) = TIKEND(YX) - TKDIF
TKDIF = - TKDIF
35	    CONTINUE
40	  CONTINUE
C
C	  Loop drawing the segment of axis to the next tick, drawing
C	  the tick and advancing counters for the next tick
C
DO 50 I = 1, NUMT
TIKEND(XY) = TIKPOS(XY)
TIKEND(YX) = TIKEND(YX) - TKDIF
CALL APPLOT(TIKPOS(X),TIKPOS(Y),PEN)
IF(TKSIZ.LE.0.0) GOTO 45
CALL APPLOT(TIKEND(X),TIKEND(Y),MOV)
CALL APPLOT(TIKPOS(X),TIKPOS(Y),DRW)
45	    CONTINUE
TIKPOS(XY) = TIKPOS(XY) + TSPC
TKDIF = -TKDIF
50	  CONTINUE
C
C	  Draw to the end of the axis
C
CALL APPLOT(AXLIM(X),AXLIM(Y),PEN)
C
C	  Alter X and Y indicators for next axis
C
XY = YX
100	CONTINUE
C
C
END
SUBROUTINE APLABL(EXPVAL)
REAL	EXPVAL(2)
C
C  Decide on which type of label processing is required and call
C  the appropriate routine.  The choice is character labels,
C  log scaled labels or good old standard vanilla flavoured
C  labels.
C
INTEGER	LTYP, I, X, Y, XY
LOGICAL	FLLOG, FLALF
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APALF/FLALF(2), NMLABL(2), TXLABL(20,2), MXTXL
COMMON	/APLOG/FLLOG(2)
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
C
DO 199 I = X, Y
XY = I
EXPVAL(I) = 0.0
LTYP = 0
IF(FLLOG(I)) LTYP = 1
IF(FLALF(I)) LTYP = 2
GOTO (110, 120), LTYP
C
C	    Standard labels
C
CALL APSLAB(XY,ORGVAL(XY),ENDVAL(XY),TIKINC(XY),TIKSPC(XY),
*			FLINT(XY), EXPVAL(XY))
GOTO 150
C
C	    Log scaled labels
C
110	    CALL APLLAB(XY,ORGVAL(XY),TIKINC(XY),TIKSPC(XY),FLINT(XY))
GOTO 150
C
C	    Character labels
C
120	    CALL APCLAB(XY,TIKSPC(XY))
150	  CONTINUE
199	CONTINUE
END
SUBROUTINE APSLAB(XY,ORGV,ENDV,TINC,TSPC,FLINT,EXPVAL)
INTEGER	XY
LOGICAL	FLINT
REAL	ORGV, ENDV, TINC, TSPC, EXPVAL
C
C  Advance along the axis writing a label at every other tick.
C  The label may be an integer or a real number.  If it was
C  necessary to scale the tick values, add an exponent to the
C  end of the axis title.
C
C  XY		1 : X-axis; 2 : Y-axis
C  ORGV		value at origin of axis
C  ENDV		value at end of axis
C  TINC		tick value increment
C  TSPC		tick spacing
C  EXPVAL	returned with value of the exponent
C  FLINT	true if integer labels
C
INTEGER	X, Y
REAL	PENPOS(2), XORG, YORG, TKLSIZ, TKLCLR
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APPRM/APPARM(45), APLO, APHI
C
EQUIVALENCE (XORG,APPARM(5))
EQUIVALENCE (YORG,APPARM(6))
EQUIVALENCE (TKLSIZ,APPARM(19))
EQUIVALENCE (TKLCLR,APPARM(20))
C
C
IF(XY.EQ.Y) GOTO 100
PENPOS(X) = XORG
PENPOS(Y) = YORG - TKLSIZ - TKLCLR
GOTO 199
100	  PENPOS(X) = XORG - TKLCLR
IF(.NOT.FLINT) PENPOS(X) = PENPOS(X) - TKLSIZ * 3.0
PENPOS(Y) = YORG
199	CONTINUE
C
C	Calculate the exponent value
C
EXPVAL = AMAX1(ABS(ORGV),ABS(ENDV))
EXPVAL = APPWR(EXPVAL)
C
C	Call a subprogram to write the real or integer labels
C
IF(FLINT) CALL APISLB(XY,ORGV,TINC,TSPC,PENPOS,EXPVAL)
IF(.NOT.FLINT) CALL APRSLB(XY,ORGV,TINC,TSPC,PENPOS,EXPVAL)
END
SUBROUTINE APRSLB(XY,ORGV,TINC,TSPC,PENPOS,EXPVAL)
INTEGER	XY
REAL	ORGV, TINC, TSPC, PENPOS(2), EXPVAL
C
C  Move along the axis plotting real labels at every other tick
C
C  XY		1 : X-axis; 2 : Y-axis
C  ORGV		value at axis origin
C  TINC		tick increment
C  TSPC		tick spacing
C  PENPOS	current pen position
C  EXPVAL	power of 10 in the maximum of the values at the axis
C		limits
C
INTEGER	X, Y, NUMTIK, CTIK
REAL	TKINC, TKVAL, PENPSX, SCALER, TKLSIZ, AXISLN(2), RV
REAL	RD, TIKV
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (AXISLN,APPARM(3))
EQUIVALENCE (TKLSIZ,APPARM(19))
C
C
SCALER = 10.0 ** EXPVAL
TKVAL = ORGV / SCALER
TKINC = TINC / SCALER
C
C  Loop here for each tick on the axis
C
DO 199 CTIK = 0, NUMTIK(XY), 2
C
C	  Adjust the pen position to suit decimal points and
C	  minus signs in the tick value
C
PENPSX = PENPOS(X)
IF(ABS(TKVAL) + RV.GE.1.0) PENPSX = PENPSX - TKLSIZ
IF(ABS(TKVAL) + RV.LT.0.01) TKVAL = 0.0
IF(TKVAL.LT.0.0) PENPSX = PENPSX - TKLSIZ
TIKV = TKVAL + SIGN(RD,TKVAL)
CALL APNUMB(PENPSX,PENPOS(Y),TKLSIZ,TIKV,0.0,2)
C
C	  Advance to the next tick
C
TKVAL = TKVAL + TKINC * 2.0
PENPOS(XY) = PENPOS(XY) + TSPC * 2.0
199	CONTINUE
END
SUBROUTINE APISLB(XY,ORGV,TINC,TSPC,PENPOS,EXPVAL)
INTEGER	XY
REAL	ORGV, TINC, TSPC, PENPOS(2), EXPVAL
C
C  Advance along the axis writing an integer label at every
C  other tick
C
C  XY		1 : X-axis; 2 : Y-axis
C  ORGV		value at axis origin
C  TINC		tick value increment per tick
C  TSPC		tick spacing
C  PENPOS	pen position
C  EXPVAL	value of exponent
C
INTEGER	X, Y, CTIK, NUMTIK
REAL	POWMAX, TKVAL, TKINC, TIKEXP, ADJDIG, PENPSX, RV
REAL	SCALER, RD, TIKV
REAL	AXISLN(2), TKLSIZ
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (AXISLN,APPARM(3))
EQUIVALENCE (TKLSIZ,APPARM(19))
C
C
POWMAX = 4.0
IF(ORGV.LT.0.0) POWMAX = 3.0
TKVAL = ORGV
TKINC = TINC
C
C	If the exponent is below zero, adjust the value and increment
C	to bring it above zero
C
IF(EXPVAL.GE.0.0) GOTO 100
SCALER = 10.0 ** EXPVAL
TKVAL = TKVAL / SCALER
TKINC = TKINC / SCALER
100	CONTINUE
C
C	  Look at the exponent of the tick increment.  If the tick
C	  increment is small, adjust the value and the increment to
C	  make it as large as possible
C
IF(ABS(TKINC).GE.0.5) GOTO 200			![32]
TIKEXP = APPWR(TKINC)
IF(TIKEXP.GT.-2..AND.ABS(EXPVAL) + 2..LE.POWMAX) TIKEXP = -2.
IF(ABS(TIKEXP) + ABS(EXPVAL).GT.POWMAX) GOTO 200
SCALER = 10.0 ** TIKEXP
EXPVAL = TIKEXP - RV
GOTO 299
200	  CONTINUE
```
```C
C	  Scale the value and the tick increment to fit
C
250	  IF(EXPVAL.LE.POWMAX) EXPVAL = 0.0
IF(EXPVAL.GT.POWMAX) EXPVAL = EXPVAL - POWMAX
SCALER = 10.0 ** EXPVAL
299	CONTINUE
TKVAL = TKVAL / SCALER
TKINC = TKINC / SCALER
C
C	Loop here plotting the value at each tick along the
C	axis
C
DO 399 CTIK = 0, NUMTIK(XY), 2
PENPSX = PENPOS(X) - ADJDIG * TKLSIZ * XY / 2.0
IF(TKVAL.LT.0.0) PENPSX = PENPSX - TKLSIZ
TIKV = TKVAL + SIGN(RD,TKVAL)
CALL APNUMB(PENPSX,PENPOS(Y),TKLSIZ,TIKV,0.0,-1)
C
C	  advance the value and increment
C
PENPOS(XY) = PENPOS(XY) + TSPC * 2.0
TKVAL = TKVAL + TKINC * 2.0
399	CONTINUE
C
C
END
SUBROUTINE APTITL(XT,NXT,YT,NYT,PT,NPT,EXPVAL)
INTEGER	NXT, NYT, NPT
REAL	XT(1), YT(1), PT(1), EXPVAL(2)
C
C  Draw the plot title, the X-axis title and the Y-axis title,
C  and return the positions of the end of the X and Y axes
C  in case an exponent needs to be added there
C
C  XT, YT	X and Y axis titles
C  NXT, NYT	number of characters in those titles
C  PT		plot title
C  NPT		characters in plot title
C  EXPVAL	value of exponent to be plotted
C
INTEGER	X, Y, XY
REAL	XTTLX, XTTLY, YTTLX, YTTLY, XTTLSZ, YTTLSZ
REAL	XORG, YORG, XAXISL, YAXISL, PTTSIZ, PTTCLR
REAL	XPPOS, YPPOS, EXPPOS
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
EQUIVALENCE (XAXISL,APPARM(3))
EQUIVALENCE (YAXISL,APPARM(4))
EQUIVALENCE (XORG,APPARM(5))
EQUIVALENCE (YORG,APPARM(6))
EQUIVALENCE (XTTLX,APPARM(11))
EQUIVALENCE (XTTLY,APPARM(12))
EQUIVALENCE (YTTLX,APPARM(13))
EQUIVALENCE (YTTLY,APPARM(14))
EQUIVALENCE (XTTLSZ,APPARM(15))
EQUIVALENCE (YTTLSZ,APPARM(16))
EQUIVALENCE (PTTSIZ,APPARM(17))
EQUIVALENCE (PTTCLR,APPARM(18))
EQUIVALENCE (XFACTR,APPARM(28))
EQUIVALENCE (YFACTR,APPARM(29))
C
C
IF(NXT.NE.0) CALL APSYMB(XTTLX,XTTLY,XTTLSZ,XT,0.0,NXT)
EXPPOS = XTTLX + NXT * XTTLSZ + 1.0
IF(EXPVAL(X).NE.0.0) CALL APPSEX(X,EXPVAL(X),EXPPOS)
C
C	Now the Y-axis title
C
IF(NYT.NE.0) CALL APSYMB(YTTLX,YTTLY,YTTLSZ,YT,90.0,NYT)
EXPPOS = YTTLY + (NYT * YTTLSZ * XFACTR) / YFACTR + 1.0
IF(EXPVAL(Y).NE.0.0) CALL APPSEX(Y,EXPVAL(Y),EXPPOS)
C
C	Finally, calculate the position of the plot title
C	and plot it
C
XPPOS = XORG + (XAXISL - PTTSIZ * FLOAT(NPT)) / 2.0
YPPOS = YORG + YAXISL + PTTCLR
IF(NPT.NE.0) CALL APSYMB(XPPOS,YPPOS,PTTSIZ,PT,0.0,NPT)
C
C
END
SUBROUTINE APPSEX(XY,EXPVAL,EXPPOS)
INTEGER	XY
REAL	EXPVAL, EXPPOS
C
C  Write an exponent value at the end of the axis label
C
INTEGER	YX, X, Y
REAL	SXY, EXPDIG, ORIENT(2), TTLSIZ(2), PENPOS(2), TTLPOS(2)
REAL	EXPSIZ
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
C	This is a fiddle, relying on XTTPOSY adjoining YTTPOSX in
C	the APPARM array
C
EQUIVALENCE (TTLPOS,APPARM(12))
EQUIVALENCE (TTLSIZ,APPARM(15))
C
DATA	ORIENT/0.0,90.0/
C
C
C	Plot the exponent value
C
YX = 3 - XY
SXY = FLOAT(3 - 2 * XY)
PENPOS(XY) = EXPPOS + 10.0
PENPOS(YX) = TTLPOS(XY)
CALL APSYMB(PENPOS(X),PENPOS(Y),TTLSIZ(XY),'(*10',ORIENT(XY),4)
C
C	Calulate the number position and plot that
C
EXPDIG = APPWR(EXPVAL)
IF(EXPVAL.LT.0.0) EXPDIG = EXPDIG + 1.0
PENPOS(XY) = PENPOS(XY) + TTLSIZ(XY) * 4.0
EXPSIZ = TTLSIZ(XY) / 2.0
PENPOS(YX) = PENPOS(YX) + SXY * EXPSIZ
CALL APNUMB(PENPOS(X),PENPOS(Y),EXPSIZ,EXPVAL,ORIENT(XY),-1)
C
C	Finally, round it off by closing brackets
C
PENPOS(XY) = PENPOS(XY) + EXPSIZ * (EXPDIG + 1.0)
PENPOS(YX) = TTLPOS(XY)
CALL APSYMB(PENPOS(X),PENPOS(Y),TTLSIZ(XY),')',ORIENT(XY),1)
END
SUBROUTINE APLINE(XD,YD,ID,ND,FLNOT,FLONE)
INTEGER	ID(ND), ND, FLNOT(14)
LOGICAL	FLONE, APLOGN
REAL	XD(ND), YD(ND)
C
C  Draw all the data points onto the prepared graph and
C  connect those that require connection.
C
C  XD,YD	arrays of data points supplied
C  ID		array of data set indicators
C  ND		size of XD, YD, ID
C  FLNOT	array of counts of points with this symbol
C  FLONE	true if called by ONEPLT
C
INTEGER	I, IDS, IDA, MOV, DRW, PEN, X, Y, XY, IDX, FLOUT
INTEGER APWIND
REAL	BEGPOS(2), FINPOS(2), OLDPOS(2,14)
REAL	XORG, YORG, SYMSIZ, NEWPOS(2), AXISLN(2), PENORG(2)
REAL	ENDVAL, ORGVAL
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (AXISLN,APPARM(3))
EQUIVALENCE (PENORG,APPARM(5))
EQUIVALENCE (XORG,APPARM(5))
EQUIVALENCE (YORG,APPARM(6))
EQUIVALENCE (SYMSIZ,APPARM(25))
C
C
DO 50 I = 1,14
FLNOT(I) = 0
50	CONTINUE
C
C  Loop here for each data point
C
DO 300 I = 1, ND
C
C	  only set up symbol first time round for ONEPLT
C
IF(FLONE.AND.I.GT.1) GOTO 100
IDS = ID(I)
IDA = IABS(IDS)
IF(IDA.NE.0.AND.IDA.LE.14) GOTO 90
WRITE(LU,1000) ID(I)
1000	      FORMAT(' %ATPIOR DATA POINT ID OUT OF RANGE', I)
GOTO 300
90	    CONTINUE
100	  CONTINUE
```
```C
C	  log scale the data if required
C
NEWPOS(X) = XD(I)
NEWPOS(Y) = YD(I)
IF(APLOGN(NEWPOS)) GOTO 295
C
C	    Given the values at a data point, calculate the position
C	    and set up the positions for windowing
C
DO 130 XY = X, Y
NEWPOS(XY) = AXISLN(XY) * (NEWPOS(XY) - ORGVAL(XY)) /
*		             (ENDVAL(XY) - ORGVAL(XY)) + PENORG(XY)
IF(FLNOT(IDA).LE.0) OLDPOS(XY,IDA) = NEWPOS(XY)
BEGPOS(XY) = OLDPOS(XY,IDA)
FINPOS(XY) = NEWPOS(XY)
OLDPOS(XY,IDA) = NEWPOS(XY)
130	    CONTINUE
FLNOT(IDA) = FLNOT(IDA) + 1
C
C	    Check up on windowing and adjust the beginning and end of
C	    the plotted line accordingly
C
FLOUT = APWIND(BEGPOS,FINPOS)
IF(FLOUT.LT.0) GOTO 290
C
C	      Move the pen to the start of the line
C
CALL APPLOT(BEGPOS(X),BEGPOS(Y),MOV)
C
C	      Move or draw the line and plot the symbol
C
PEN = MOV
IF(IDS.LT.0) PEN = DRW
IDX = IDA
IF(FLOUT.EQ.1) IDX = 14
CALL APSYMB(FINPOS(X),FINPOS(Y),SYMSIZ,IDX,0.0,-PEN)
290	    CONTINUE
295	  CONTINUE
300	CONTINUE
END
INTEGER FUNCTION APWIND(BPOS,FPOS)
REAL	BPOS(2), FPOS(2)
C
C  Find the points BPOS and FPOS that lie on the line BPOS, FPOS
C  and are the extreme points of the line within the frame of
C  values that fit onto the plot.
C
C  BPOS		X,Y positions of start of line to be plotted
C  FPOS		X,Y positions of finish of line to be plotted
C
INTEGER	XY, X, Y
LOGICAL	DFLG
REAL	DPOS(2)
LOGICAL	APENC
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
C
IF(.NOT.APENC(FPOS)) GOTO 200
APWIND = 0
IF(.NOT.APENC(BPOS)) CALL APCROS(FPOS,BPOS,BPOS,DPOS,DFLG)
RETURN
C
C
200	  APWIND = 1
IF(.NOT.APENC(BPOS)) GOTO 250
CALL APCROS(FPOS,BPOS,FPOS,DPOS,DFLG)
RETURN
250	    CALL APCROS(FPOS,BPOS,BPOS,FPOS,DFLG)
IF(DFLG) APWIND = -1
END
SUBROUTINE APCROS(POS1,POS2,CRS1,CRS2,FLOUT)
LOGICAL	FLOUT
REAL	POS1(2), POS2(2), CRS1(2), CRS2(2)
C
C  Find the points of intersection of the line (X1,Y1) (X2,Y2)
C  with the frame (XMIN,XMAX,YMAX,YMIN).  There may be 0, 1 or 2
C  such points.
C
C  POS1		one end of the line
C  POS2		other end
C  CRS1,CRS2	points of intersection
C  FLOUT	true if no points of intersection
C
INTEGER	NCRS, I, J, X, Y
REAL	XN, XX, YN, YX, XI, YI, SLP, ICP
REAL	RV, XMAXV, XMINV, YMAXV, YMINV
REAL	XCRS(2), YCRS(2), ORGPOS(2)
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (ORGPOS,APPARM(5))
EQUIVALENCE (XMINV,ORGPOS(1))
EQUIVALENCE (YMINV,ORGPOS(2))
EQUIVALENCE (XMAXV,ENDPOS(1))
EQUIVALENCE (YMAXV,ENDPOS(2))
C
DIS(I) = (XCRS(I) - POS2(X)) ** 2 + (YCRS(I) - POS2(Y)) ** 2
C
C
XN = AMIN1(POS1(X),POS2(X))
XX = AMAX1(POS1(X),POS2(X))
YN = AMIN1(POS1(Y),POS2(Y))
YX = AMAX1(POS1(Y),POS2(Y))
C
NCRS = 0
FLOUT = .FALSE.
IF(YX - YN.GT.RV) GOTO 100
C
C  parallel to X-axis. Therefore only 2 possible points of intersection.
C
CALL APSECT(YN,XMAXV,XMAXV,XMINV,XN,XX,XCRS,YCRS,NCRS)
CALL APSECT(YN,YMINV,YMAXV,XMAXV,XN,XX,XCRS,YCRS,NCRS)
GOTO 300
C
100	IF(XX - XN.GT.RV) GOTO 200
C
C  Line is parallel to Y-axis, therefore only two possible intersections
C
CALL APSECT(XN,XMINV,XMAXV,YMINV,YN,YX,XCRS,YCRS,NCRS)
CALL APSECT(XN,XMINV,XMAXV,YMAXV,YN,YX,XCRS,YCRS,NCRS)
GOTO 300
```
```C
C  Line is diagonal, so there are 4 possible intersection points, one
C  with each side of the frame.
C
200	  SLP = (POS2(Y) - POS1(Y)) / (POS2(X) - POS1(X))
ICP = POS2(Y) - POS2(X) * SLP
C
C
YI = XMINV * SLP + ICP
CALL APSECT(XMINV,XN,XX,YI,YMINV,YMAXV,XCRS,YCRS,NCRS)
YI = XMAXV * SLP + ICP
CALL APSECT(XMAXV,XN,XX,YI,YMINV,YMAXV,XCRS,YCRS,NCRS)
XI = (YMINV - ICP) / SLP
CALL APSECT(XI,XMINV,XMAXV,YMINV,YN,YX,XCRS,YCRS,NCRS)
XI = (YMAXV - ICP) / SLP
CALL APSECT(XI,XMINV,XMAXV,YMAXV,YN,YX,XCRS,YCRS,NCRS)
C
C	Set up the points to return as the crossing points
C
300	IF(NCRS.GT.0) GOTO 310
FLOUT = .TRUE.
RETURN
C
C
310	I = 1
J = 1
IF(NCRS.EQ.1) GOTO 320
IF(DIS(1).GT.DIS(2)) I = 2
J = 3 - I
C
C
320	CRS1(X) = XCRS(I)
CRS1(Y) = YCRS(I)
CRS2(X) = XCRS(J)
CRS2(Y) = YCRS(J)
END
SUBROUTINE APSECT(X0,XLO,XHI,Y0,YLO,YHI,XCRS,YCRS,NCRS)
INTEGER	NCRS
REAL	X0, XLO, XHI, Y0, YLO, YHI, XCRS(2), YCRS(2)
C
C  Check whether X0 lies between (XLO,XHI) and ditto for Y0, and
C  if so add (X0,Y0) to the CRS array.
C
C  X0,Y0	point of intersection of two lines
C  XLO,XHI	end points of ne line
C  YLO,YHI	end points of the other line
C  XCRS,YCRS	array of points of intersection
C  NCRS		number of such points found so far
C
C
IF(X0.LT.XLO.OR.X0.GT.XHI) RETURN
IF(Y0.LT.YLO.OR.Y0.GT.YHI) RETURN
NCRS = NCRS + 1
XCRS(NCRS) = X0
YCRS(NCRS) = Y0
END
SUBROUTINE APNOTE(NOT,NN,FLNOT)
INTEGER	NOT(NN,4), NN, FLNOT(14)
C
C  Draw the notes box including the notes showing what each symbol
C  indicates.
C
C  NOT		array containing the notes text for each data set
C  NN		number of notes in notes array
C  FLNOT	array indicating whether a symbol was used
C
REAL	XPOS, YPOS, XP3, XP8, YSP, YPSP, XEND
REAL	XAXISL, YAXISL, NBOXSZ, NOTSIZ, NOTSPC, XNOTDS, YNOTDS
INTEGER	I, J, K, JCH, MOV, DRW
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APPRM/APPARM(45), APLO, APHI
C
EQUIVALENCE (XAXISL,APPARM(3))
EQUIVALENCE (YAXISL,APPARM(4))
EQUIVALENCE (XORG,APPARM(5))
EQUIVALENCE (YORG,APPARM(6))
EQUIVALENCE (NBOXSZ,APPARM(9))
EQUIVALENCE (NOTSIZ,APPARM(21))
EQUIVALENCE (XNOTDS,APPARM(22))
EQUIVALENCE (YNOTDS,APPARM(23))
EQUIVALENCE (NOTSPC,APPARM(24))
C
C
IF(NN.LE.0) RETURN
C
C	Draw the notes box
C
XPOS = XORG + XAXISL
YPOS = YORG + YAXISL
XEND = XPOS + NBOXSZ
CALL APPLOT(XPOS,YPOS,MOV)
CALL APPLOT(XEND,YPOS,DRW)
CALL APPLOT(XEND,YORG,DRW)
CALL APPLOT(XPOS,YORG,DRW)
C
C	Initialise line position
C
YSP = 0.
XPOS = XORG + XAXISL + XNOTDS
XP3 = XPOS + NOTSIZ * 3.0
XP8 = XPOS + NOTSIZ * 8.0
YPOS = YORG + YAXISL - YNOTDS
```
```C
C	Loop writing a line of note for each symbol used
C
J = 0
K = -MOV
C
C
DO 200 I = 1,14
C
C	  If symbol unused in plot, ignore it
C
IF (FLNOT(I).EQ.0) GOTO 195
C
C	    Increment count of symbols written.
C	    I=14 is a special case whose symbol must be forced to '-'
C
J = J + 1
JCH = I
IF(I.NE.14) GOTO 110
JCH = '-'
K = 1
110	    CONTINUE
C
C	    Now write the symbol
C
YPSP = YPOS + YSP
CALL APSYMB(XPOS,YPSP+NOTSIZ/2.0,NOTSIZ,JCH,0.0,K)
C
C	    Write the first half of the explanation
C
CALL APSYMB(XP3,YPSP,NOTSIZ,NOT(J,1),0.0,5)
CALL APSYMB(XP8,YPSP,NOTSIZ,NOT(J,2),0.0,5)
C
C	    If the second half exists, write it too
C
YSP = YSP - NOTSPC - NOTSIZ
IF(NOT(J,3).EQ.0..AND.NOT(J,4).EQ.0.) GOTO 190
YPSP = YPOS + YSP
CALL APSYMB(XP3,YPSP,NOTSIZ,NOT(J,3),0.0,5)
CALL APSYMB(XP8,YPSP,NOTSIZ,NOT(J,4),0.0,5)
YSP = YSP - NOTSPC - NOTSIZ
190	    CONTINUE
C
195	  CONTINUE
C
200	CONTINUE
C
END
LOGICAL FUNCTION APENC(VAL)
REAL	VAL(2)
C
C  Check whether the point X0,Y0 is inside the data value frame
C
INTEGER	X, Y
REAL	XMAXV, XMINV, YMAXV, YMINV, ORGPOS(2)
C
COMMON	/APPRM/APPARM(45), APLO, APHI
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
COMMON	/APINT/ORGVAL(2), ENDVAL(2), MINVAL(2), MAXVAL(2)
COMMON	/APINT/TIKINC(2), TIKVAL(2), TIKSPC(2), TIKTYP(2)
COMMON	/APINT/FLINT(2),  TIKSIZ(2), NUMTIK(2), ENDPOS(2)
C
EQUIVALENCE (ORGPOS,APPARM(5))
EQUIVALENCE (XMINV,ORGPOS(1))
EQUIVALENCE (YMINV,ORGPOS(2))
EQUIVALENCE (XMAXV,ENDPOS(1))
EQUIVALENCE (YMAXV,ENDPOS(2))
C
C
APENC = .FALSE.
IF(VAL(X).GT.XMAXV.OR.VAL(X).LT.XMINV) RETURN
IF(VAL(Y).GT.YMAXV.OR.VAL(Y).LT.YMINV) RETURN
APENC = .TRUE.
END
REAL FUNCTION APRND(VAL,MUL)
REAL	VAL, MUL
C
C  Find the nearest multiple of MUL to VAL. If MUL is positve, find
C  the nearest above, otherwise below.
C
REAL	RV, VM, AVM
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
C
VM = VAL / MUL
AVM = AINT(VM)
IF(ABS(VM-AVM).GT.RV.AND.VM.GT.0.0) AVM = AVM + 1.0
APRND = AVM * MUL
END
REAL FUNCTION APPWR(VAL)
REAL	VAL
C
C  Representing VAL as v*10^e where v is in the range 1<=v<10,
C  return e.
C
REAL	RV, V
C
COMMON	/APFIX/X, Y, RV, RD, LU, MOV, DRW
C
C
V = ALOG10(ABS(VAL) + RV)
IF(V.LT.0.0) V = V - 1.0
APPWR = AINT(V)
END
SUBROUTINE APLLAB(I1,R1,R2,R3,L1)
INTEGER	I1
LOGICAL	L1
REAL	R1, R2, R3
C
C  Dummy to satisfy loading request if log labels are not being used
C
LOGICAL	FLLOG
COMMON	/APLOG/FLLOG(2)
DATA	FLLOG/.FALSE., .FALSE./
END
LOGICAL FUNCTION APLOGN(R1)
REAL	R1
C
C  Dummy replacement for APLOGN if no log labelling
C
APLOGN = .FALSE.
END
SUBROUTINE APCLAB(I1,R1)
INTEGER	I1
REAL	R1
C
C  Dummy to satisfy loading request if character labels are not being
C  used
C
END
SUBROUTINE APPLSQ(R1,R2,I1,I2,L1)
INTEGER	I1, I2
LOGICAL	L1
REAL	R1, R2
C
C  Dummy to satisfy loading request if not plotting least squares lines
C
END
SUBROUTINE APPLSP(R1,R2,I1,I2,L1)
INTEGER	I1, I2
LOGICAL	L1
REAL	R1, R2
C
C  Dummy to satisfy loading request if not plotting least squares lines
C
END

```