Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
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