Google
 

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  squares line is added.
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	Dummy call to force loading of APLLAB
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	Dummy entry just to force loading of this module
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
	LOGICAL	FLADJ
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)
	  CALL APLADJ(TIKVAL,NXTVAL,EXPMIN,POWMAX,FLADJ)
	  EXPVAL = EXPMIN
	  IF(FLADJ) GOTO 130
	    TIKVAL = TIKVAL / (10.0 ** EXPMIN)
C
C	    Now try for the fractional case
C
	    CALL APLADJ(TIKVAL,0.0,EXPMIN,POWMAX,FLADJ)
	    IF(.NOT.FLADJ) GOTO 120
	      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
	SUBROUTINE APLADJ(TIKVAL,NXTVAL,EXPMIN,POWMAX,FLADJ)
	REAL	TIKVAL, NXTVAL, EXPMIN, POWMAX
	LOGICAL	FLADJ
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  FLADJ	true if any adjustments made
C
	REAL	APPWR
C
C
	FLADJ = .FALSE.
 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
	  FLADJ = .TRUE.
	  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	Dummy call to force loading of APCLAB
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	Dummy entry to ensure loading of this module
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	Dummy call to force loading of APPLSQ
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	Dummy call to force loading calculating routines
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	Dummy entry to force loading
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
	INTEGER	MOV, DRW, SHADE
	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	are shaded or not
C
	SHADE = IFIX(TIKDEN + SIGN(0.5,TIKDEN))
C
	IF(SHADE.NE.1) GOTO 20
C
C	  not shaded - go write box and ticks together
C
	  CALL APTICK(DRW,TIKSIZ,TKHDIF)
	  GOTO 30
 20	CONTINUE
C
C	  shaded - draw box outline; change shade; draw ticks
C
	  CALL APTICK(DRW,NOSIZE,0.0)
	  CALL APSHAD(SHADE)
	  CALL APTICK(MOV,TIKSIZ,TKHDIF)
	  CALL APSHAD(1)
 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
	  ADJDIG = 1.0
	  IF(ABS(TKVAL).GE.1.0) ADJDIG = ADJDIG + APPWR(TKVAL)
	  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	and base (X,Y) addresses
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