home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / fortran77_210 / library / f77 / graphdemo < prev    next >
Encoding:
Text File  |  1992-01-04  |  15.1 KB  |  471 lines
  1.       PROGRAM GRAPHDEMO
  2. C  original for BBC Master Scientific from C.Johnson 
  3. C  modified by K.M.Crennell  for Archimedes  Dec 91
  4. C ********************* CopyRight 'Fortran Friends' 1992 ****************
  5. C  If you want to distribute any of this code in your own programs, please
  6. C  acknowledge the 'Fortran Friends' PD library and send us a copy.
  7. C ************************************************************************
  8. C
  9. C  libraries needed  Graphics, Utils 
  10. C
  11. C  demo of X,Y graph drawing routine GRAPH
  12.       PARAMETER (MAXPTS=100)
  13.       REAL X(MAXPTS),Y(MAXPTS)
  14.       CHARACTER C*1,TEX*80
  15. C                 screen constants set in subroutine INIT
  16.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  17.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  18.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  19.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  20. C
  21. C                    read in data from file, N = no of X,Y points read
  22.       CALL GETDAT(X,Y,N,MAXPTS)
  23. C               set window in which to draw graph
  24.       CALL GWIND(100,300,956,956)
  25. C                 initialisation call to GRAPH to find the scale factor
  26. C                 neded to plot the X,Y points on this screen
  27.       CALL GRAPH(X,Y,N,0,IER)
  28.         IF(IER.NE.0)GOTO80                                   
  29. C                 ask to plot the points joined by a line between them
  30. C                 in a different colour
  31.       CALL GCOL(0,15)
  32.       CALL GRAPH(X,Y,N,1,IER)
  33.         IF(IER.NE.0)GOTO80                                
  34. C                 ask to plot the points as square markers
  35.       CALL GRAPH(X,Y,N,2,IER)
  36.         IF(IER.NE.0)GOTO80                                
  37. C      
  38.       TEX='Press <Spacebar> to exit, or S to save graph :- '
  39.       CALL WOG(IX0+336,IY1-64,TEX)
  40.       C=CHAR(IGET())
  41.       IF (C.EQ.'S')  CALL SCRNSV
  42.       CALL VDU(12)
  43.       IF(IER.EQ.0)STOP
  44.    80 WRITE(*,*) '*** Bad value for IOPT (',IER,') ***'
  45.       STOP 'Fatal error! Program terminated.'
  46.       END
  47. C
  48.       SUBROUTINE GETDAT(X,Y,N,MAXPTS)
  49. C                     reads X,Y data, returns N no of points read,
  50. C                     MAXPTS = maximum no allowed.
  51.       REAL X(*),Y(*)
  52.       CHARACTER FNAME*30
  53.       WRITE(*,*) '  Fortran Graph plotter V1.0'
  54.       WRITE(*,*) ' ----------------------------'
  55.       WRITE(*,*)
  56.       WRITE(*,*) '  Data file name ='
  57.       READ(*,9000) FNAME
  58.  9000 FORMAT(A)
  59. C      FNAME='GraphData'
  60.       OPEN(UNIT=1,FILE=FNAME)
  61.       N=1
  62.    20 READ(1,*,END=80) X(N),Y(N)
  63.       N=N+1
  64.       IF(N.LE.MAXPTS)GOTO20
  65.    80 N=N-1
  66.       RETURN
  67.       END
  68. C                      start of utilities **********************
  69. C
  70.       SUBROUTINE AXIS(Z1,Z2,I)
  71. C  The axis is not drawn here, just the tick lines and numbers.              C    minimum Z1 and Max Z2    I=1 Xaxis, =2 Y axis
  72. C                     
  73.       IF (Z1.GT.Z2) THEN
  74. C                        allow for user having got it backwards???
  75.         T=Z1
  76.         Z1=Z2
  77.         Z2=T
  78.       END IF
  79.       M=0
  80.       A=0.0
  81.       N=0
  82.       B=0.0
  83.       IF (Z1.NE.0.0) M=NINT(LOG10(ABS(Z1)))
  84.       IF (Z2.NE.0.0) N=NINT(LOG10(ABS(Z2)))
  85. C            find the power of 10 for the min & max numbers
  86.       IF (M.GT.N) THEN
  87.         N1=M
  88.       ELSE
  89.         N1=N
  90.       END IF
  91.       A=Z1*10.0**(-N1)
  92.       B=Z2*10.0**(-N1)
  93.       IF (ABS(B-A).LT.0.2) THEN
  94.         A1=A
  95.         B1=B
  96.       ELSE
  97.         A1=ROUND(A,1)
  98.         B1=ROUND(B,1)
  99.       END IF
  100.       IF(I.EQ.1)THEN
  101. C                  write out the tickmarks and associated numbers for X axis
  102.         CALL XTICKS(A1,B1,N1)
  103.       ELSE                                                                  
  104. C                 tickmarks and numbers for Y axis
  105.         CALL YTICKS(A1,B1,N1)
  106.       ENDIF
  107.       RETURN
  108.       END
  109.       SUBROUTINE DELTA(RANGE,NTICKS,D,NM)
  110. C            calculates the value of D which makes the NTICKS tick marks
  111. C evenly spaced within the distance RANGE and at 'nice' values 1,2, or 5
  112. C ALSO returns the number of minor tickmarks, NM, plotted within D 
  113.       REAL DT(3)
  114. C            LOG10(1) log10(2)  Log10(5)
  115.       DATA DT/    0  ,0.301030, 0.69897/
  116. C                         DXT =Minimum distance between ticks in X axis
  117.       DXT=RANGE/FLOAT(NTICKS)
  118.       X=LOG10(DXT)
  119.       IDX=INT(X)
  120.       DDX=X-IDX 
  121. C              IDX  exponent of DXT  DDX = mantissa
  122. C    DXT=10**(IDX+DDX)      where 0 < DDX < 1   want next biggest 'nice' no.
  123.       IF(DDX.LT.0.)THEN
  124.         DDX=DDX+1.
  125.         IDX=IDX-1
  126.       ENDIF                                 
  127.       IF(DDX.GT.DT(1).AND.DDX.LT.DT(2))DX=2
  128.       IF(DDX.GT.DT(2).AND.DDX.LT.DT(3))DX=5
  129.       IF(DDX.GE.DT(3))DX=10
  130.       D=DX*10.**IDX
  131. C               get number of minor tickmarks to return
  132.       NM=1
  133.       IF(DX.EQ.2.)NM=3
  134.       IF(DX.EQ.5.)NM=4
  135.       RETURN
  136.       END
  137. C
  138.       SUBROUTINE DRAWLN(X,Y,N)
  139. C              draw line through the X,Y points
  140.       REAL X(*),Y(*)
  141.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  142.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  143.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  144.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  145. C
  146.       CALL MOVE(ISCRN(X(1),0,1),ISCRN(Y(1),0,2))
  147.       DO 10 I=2,N
  148.    10 CALL DRAW(ISCRN(X(I),0,1),ISCRN(Y(I),0,2))
  149.       RETURN
  150.       END
  151. C
  152.       SUBROUTINE DRPNTS(X,Y,N)
  153. C        draws a filled square, size KSQ, in background colour,KOLB, 
  154. C        outlined in foreground colour KOLF at each of the N points in X,Y
  155.       REAL X(*),Y(*)
  156.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  157.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  158.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  159.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  160.       L=KSQ/2
  161.       N0=0
  162.       DO 10 I=1,N
  163.        IXP=ISCRN(X(I),N0,1)
  164.        IYP=ISCRN(Y(I),N0,2)
  165.        CALL GCOL(0,KOLB)
  166.        CALL RECTAN(IXP-L,IYP-L,IXP+L,IYP+L,.TRUE.)
  167.        CALL GCOL(0,KOLF)
  168.        CALL RECTAN(IXP-L,IYP-L,IXP+L,IYP+L,.FALSE.)
  169.    10 CONTINUE
  170.       RETURN
  171.       END
  172. C
  173.       SUBROUTINE GRAPH(X,Y,N,IOPT,IER)
  174.       REAL X(*),Y(*)
  175.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  176.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  177.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  178.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  179. C 
  180. C IOPT=0  =>  Does scaling, draws frame and axes
  181. C
  182. C IOPT=1  =>  Draws line through X and Y values.
  183. C
  184. C IOPT=2  =>  Draws points through X and Y data using squares.
  185. C
  186.       IER=0
  187. C                      error returns zero if OK
  188.       IF(IOPT.LT.0.OR.IOPT.GT.2)THEN
  189.         IER=IOPT
  190.         RETURN
  191.       ENDIF 
  192.       GOTO (100,200,300),IOPT+1
  193. C
  194.   100 CONTINUE
  195.       CALL SCALE(X,Y,N)              
  196. C             scale the user points to fit screen and set up constants
  197.       CALL GCOL(0,KOLF)
  198. C                       Outline the drawing area along the axes
  199.       CALL RECTAN(IXL,IYL,IXR,IYR,.FALSE.)
  200. C                       draw the axes 
  201.       CALL AXIS(XMIN,XMAX,1)
  202.       CALL AXIS(YMIN,YMAX,2)
  203.       RETURN
  204. C                       draw a line through the points
  205.   200 CALL DRAWLN(X,Y,N)
  206.       RETURN
  207. C                       draw the points with marker, no line
  208.   300 CALL DRPNTS(X,Y,N)
  209.       RETURN
  210.       END
  211.       SUBROUTINE INIT
  212. C                  CALLED FROM SCALE to initialise screen constants
  213.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  214.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  215.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  216.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  217. C
  218. C            (IX0,IY0) to (IX1,IY1)   screen (or window) size (rasters)
  219. C      IX0=0
  220. C      IY0=0
  221. C      IX1=1280
  222. C      IY1=960
  223. C                get the graphics window size
  224.       IX0=ISHFT(MVDUVAR(128),MODEVAR(-1,4))
  225.       IX1=ISHFT(MVDUVAR(130),MODEVAR(-1,4))
  226.       IY0=ISHFT(MVDUVAR(129),MODEVAR(-1,5))
  227.       IY1=ISHFT(MVDUVAR(131),MODEVAR(-1,5))
  228.       CALL CLG
  229. C                   background and foreground colours
  230.       KOLB=0
  231.       KOLF=7
  232. C                         screen co-ordinates must be divisible by 4
  233. C      MASKX=?IFFFFFFFE
  234. C      MASKY=?IFFFFFFFE
  235.       MASKX=ISHFT(-1,MODEVAR(-1,4))
  236.       MASKY=ISHFT(-1,MODEVAR(-1,5))
  237. C             (IXL,IYL) to (IXR,IYR)  graph drawing area (rasters)
  238.       IXL=IX0+160
  239.       IXR=IX1-100
  240.       IYL=IY0+128
  241.       IYR=IY1-100
  242. C                   side of square marker (rasters)
  243.       KSQ=16
  244. C              position of numbers on X axis relative to tick line
  245.       IUXAXT=  40
  246.       IUYAXT=  IYL-32
  247. C                  and on Y axis
  248.       IUXAYT=  IX0+48
  249.       IUYAYT=  12
  250. C                  amounts to left for short and long Y tick marks
  251.       LYTS= 16
  252.       LYTL= 28                                                  
  253. C             amount to right where Y marks stop
  254.       LYR=  8
  255. C            amounts below X axis for short and long tickmarks 
  256.       LXTS= 16
  257.       LXTL= 28                                                
  258. C              amount above X axis where all marks stop
  259.       LXHI = 8
  260. C               position of X axis text centre of IXl,IXR
  261.       IXAXT= IX0+(IXR-IXL) *0.5
  262.       IYAXT= IYL-64
  263. C              position of Y axis text relative to IXL,IYR
  264.       IXAYT= 80
  265.       IYAYT= 64
  266. C               relative position of exponent same for X and Y
  267.       ISUPX= +16
  268.       ISUPY= +16
  269.       RETURN
  270.       END
  271. C
  272.       FUNCTION ISCRN(Z,N,I)
  273. C converts user variable Z into a screen variable, N= power of 10
  274. C      I=1 for X, =2 for Y 
  275.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  276.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  277.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  278.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  279. C                    MASKX,MAXY are MODE dependent, set by routine SCALE
  280.       XY=Z
  281.       IF(N.NE.0)XY=XY*(10.0**N)
  282.       IF(I.EQ.1) ISCRN=IAND(IXL+INT((XY-XMIN)*SCALEX),MASKX)
  283.       IF(I.EQ.2) ISCRN=IAND(IYL+INT((XY-YMIN)*SCALEY),MASKY)
  284.       RETURN
  285.       END
  286. C
  287.       SUBROUTINE OUTINT(IX,IY,N)
  288. C             writes out an integer on screen
  289.       CHARACTER *10 WORK
  290.       WRITE(WORK,101)N
  291.   101 FORMAT(I4)
  292.       CALL WOG(IX,IY,WORK) 
  293.       RETURN
  294.       END
  295. C
  296.       SUBROUTINE OUTNUM(IX,IY,X)
  297. C                          outputs a floating point number to the screen
  298.       CHARACTER * 10 WORK
  299. C                       is there a format to write out leading zeros?
  300.       IF(X.GE.1.0)THEN
  301.         WRITE(WORK,101)X
  302.       ELSE
  303.         IF(X.GE.0.0)THEN
  304.           WRITE(WORK,102)X
  305.         ELSE
  306.           IF(X.GT.-1.0)THEN
  307.             WRITE(WORK,104)-X
  308.           ELSE
  309.             WRITE(WORK,103)-X   
  310.           ENDIF
  311.         ENDIF
  312.       ENDIF
  313.       CALL WOG(IX,IY,WORK)
  314.       RETURN              
  315.   101 FORMAT(1X,    F4.2)
  316.   102 FORMAT(1X,'0',F3.2)
  317.   103 FORMAT(       F4.2)
  318.   104 FORMAT(  '-0',F3.2)
  319.       END
  320. C
  321.       FUNCTION ROUND(X,IC)
  322.       T=10.0*ABS(X)+FLOAT(IC)-0.5
  323.       ROUND=SIGN(1.0,X)*FLOAT(INT(T))*0.1
  324.       RETURN
  325.       END
  326. C
  327.       SUBROUTINE SCALE(X,Y,N)
  328.       REAL X(*),Y(*)
  329.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  330.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  331.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  332.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  333. C                         set up constants for scaling to screen
  334.       CALL INIT
  335. C                          find Max and min in user data
  336.       XMIN=9999999.999
  337.       XMAX=-XMIN
  338.       YMIN=XMIN
  339.       YMAX=-YMIN
  340.       DO 10 I=1,N
  341.         Z=X(I)
  342.        IF (Z.LT.XMIN) XMIN=X(I)
  343.        IF (Z.GT.XMAX) XMAX=X(I)
  344.        Z=Y(I)
  345.        IF (Z.LT.YMIN) YMIN=Y(I)
  346.        IF (Z.GT.YMAX) YMAX=Y(I)
  347.    10 CONTINUE
  348.       Z=(XMIN+XMAX)*0.5
  349.       ZC=(XMAX-XMIN)*0.5
  350.       XMIN=Z-1.05*ZC
  351.       XMAX=Z+1.05*ZC
  352.       Z=(YMIN+YMAX)*0.5
  353.       ZC=(YMAX-YMIN)*0.5
  354.       YMIN=Z-1.05*ZC
  355.       YMAX=Z+1.05*ZC
  356.       SCALEX=FLOAT(IXR-IXL)/(XMAX-XMIN)
  357.       SCALEY=FLOAT(IYR-IYL)/(YMAX-YMIN)
  358.       RETURN
  359.       END
  360. C
  361.       SUBROUTINE SCRNSV
  362. C              saves the screen somehow for later printing, Drawfile?
  363.       RETURN
  364.       END
  365. C
  366.       CHARACTER*1 FUNCTION UPCASE(CHR)
  367. C                   converts the character in CHR to upper case
  368.       CHARACTER CHR*1
  369.       UPCASE=CHR
  370.       IF (CHR.GE.'a')  UPCASE=CHAR(ICHAR(CHR)-32)
  371.       RETURN
  372.       END
  373. C
  374.       SUBROUTINE XTICKS(X1,X2,N)
  375. C        puts tick marks and numbers on the X axis between minimum at X1 and
  376. C         max at X2. N=exponent of the X1 and X2          
  377.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  378.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  379.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  380.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  381. C             try 8 ticklines
  382.       NT=8
  383. C          decide on spacing assume X2 > X1
  384. C          DELTA finds a 'nice' one, returned in D
  385. C          also returns NMIN no of minor tickmarks to be inserted within D
  386.       CALL DELTA(X2-X1,NT,D,NMIN)
  387. C                   find NP, how many to do
  388.       NP=2+INT((X2-X1)/D)
  389.       X=X1-D
  390. C                for -ve values start at next higher point?
  391. C      IF(X1.LT.0)X=X+D
  392.       IYP=IYL-LXTL
  393.       IYQ=IYL+LXHI
  394. C                  Y values for major and minor tick lines
  395.       MYP=IYL-LXTS
  396.       MYQ=IYL+LXHI
  397. C           CX is spacing of the minor tickmarks
  398.       CX=D/FLOAT(NMIN+1)
  399.       DO 20 I=1,NP
  400.         X=X+D         
  401.         IF(X.GT.X2)GOTO20
  402. C                     output the numbers as XTEMP rounded
  403.         XTEMP=SIGN(1.,X)*INT(100.*ABS(X)+0.5)*0.01
  404.         IXP=ISCRN(X,N,1)
  405.         CALL OUTNUM(IXP-IUXAXT,IUYAXT,XTEMP)
  406. C                      output the major ticklines
  407.         CALL LINE(IXP,IYP,IXP,IYQ)
  408. C                      now the minor ticklines
  409.         DO 10 J=1,NMIN
  410.          IXP=ISCRN(X+J*CX,N,1)
  411.          IF(IXP.GT.IXR)GOTO20
  412.          CALL LINE(IXP,MYP,IXP,MYQ)
  413.    10   CONTINUE 
  414.    20 CONTINUE
  415.       CALL WOG(IXAXT,IYAXT,'X*10')
  416.       I=IXAXT+ISUPX
  417.       IF(N.LT.0)I=I+16
  418.       IF(N.NE.1)CALL OUTINT(I,IYAXT+ISUPY,N)
  419.       RETURN
  420.       END
  421. C
  422.       SUBROUTINE YTICKS(Y1,Y2,N)
  423. C                plots ticklines and number for the Y axis
  424. C                between minimum at Y1 and Max at Y2
  425.       COMMON /GRAF/ IX0,IY0,IX1,IY1,IXL,IYL,IXR,IYR,
  426.      1 IUXAXT,IUYAXT,IUXAYT,IUYAYT,IXAXT,IYAXT,IXAYT,IYAYT,KSQ,
  427.      2 LXHI,LYR,LXTS,LXTL,LYTS,LYTL,ISUPX,ISUPY,
  428.      3 KOLB,KOLF,XMIN,YMIN,XMAX,YMAX,SCALEX,SCALEY,MASKX,MASKY
  429. C             try 16 ticklines
  430.       NT=16
  431. C          decide on spacing assume Y2 > Y1
  432. C          DELTA finds a 'nice' one, returned in D
  433. C          also returns NMIN no of minor tickmarks to be inserted within D
  434.       CALL DELTA(Y2-Y1,NT,D,NMIN)
  435. C                   find NP, how many to do
  436.       NP=2+INT((Y2-Y1)/D)
  437.       Y=Y1-D
  438. C      IF(Y1.LT.0)Y=Y+D   need this???
  439.       IXP=IXL-LYTL
  440.       IXQ=IXL+LYR
  441. C                  Y values for major and minor tick lines
  442.       MXP=IXL-LYTS
  443.       MXQ=IXL+LYR
  444. C           CY is spacing of the minor tickmarks
  445.       CY=D/FLOAT(NMIN+1)
  446.       DO 20 I=1,NP
  447.         Y=Y+D    
  448. C                     output the numbers as XTEMP rounded
  449.         YTEMP=SIGN(1.,Y)*INT(100.*ABS(Y)+0.5)*0.01
  450.         IYP=ISCRN(Y,N,2)
  451.         CALL OUTNUM(IUXAYT,IYP+IUYAYT,YTEMP)
  452. C                      output the major ticklines
  453.         CALL LINE(IXP,IYP,IXQ,IYP)
  454. C                      now the minor ticklines
  455.         DO 10 J=1,NMIN
  456.          IYP=ISCRN(Y+J*CY,N,2)
  457.          IF(IYP.GT.IYR)GOTO20
  458.          CALL LINE(MXP,IYP,MXQ,IYP)
  459.    10   CONTINUE 
  460.    20 CONTINUE
  461.  
  462. C                              label Y axix units
  463.       IYP=IYR+IYAYT
  464.       IXP=IXL-IXAYT
  465.       CALL WOG(IXP,IYP,'Y*10') 
  466.       I=IXP+ISUPX
  467.       IF(N.LT.0)I=I+16
  468.       IF(N.NE.1)CALL OUTINT(I,IYP+ISUPY,N)
  469.       RETURN
  470.       END
  471.