home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol194 / graf.fq / GRAF.F
Encoding:
Text File  |  1985-02-10  |  42.1 KB  |  1,295 lines
  1. C
  2. C-----------------------------------------------------------------------
  3. C
  4.         SUBROUTINE XYPROJ(XPROJ,YPROJ,X,Y,Z,Z0)
  5. C
  6. C       THIS SUBROUTINE PERFORMS EITHER A PERSPECTIVE OR ORTHOGRAPHIC 
  7. C       PROJECTION OF THE POINT X,Y,Z TO THE IMAGE COORD'S XPROJ,YPROJ.
  8. C
  9. C       INPUTS:
  10. C               X,Y,Z   REAL    COORDINATES OF POINT
  11. C               Z0      REAL    DISTANCE FROM THE VIEWPOINT TO ORIGIN
  12. C               NOTE: Z0=0 FOR ORTHOGRAPHIC PROJECTION
  13. C       OUTPUTS:
  14. C               XPROJ   REAL    HORIZONTAL COORDINATE FOR PROJECTED PT
  15. C               YPROJ   REAL    VERTICAL COORDINATE FOR PROJECTED PT
  16. C
  17. C       NOTE: INPUT COORDINATES ARE ALIGNED SO THAT THE X AXIS POINTS 
  18. C       TO THE RIGHT, AND THE Z AXIS IS UPRIGHT. THE VIEW IS THUS IN THE
  19. C       DIRECTION OF THE INPUT Y AXIS.
  20. C             THE OUTPUT COORDINATES ARE ALIGNED SO THAT THE X AXIS 
  21. C       POINTS TO THE RIGHT AND THE Y AXIS IS UPRIGHT. THUS, THE Z AXIS
  22. C       POINTS AWAY ALONG THE VIEWER'S LINE OF SIGHT AND IS NOT SHOWN.
  23. C
  24.         REAL XPROJ,YPROJ,X,Y,Z,Z0,CONST
  25. C
  26.         CONST=1.
  27.         IF (ABS(Z0).GT. 1.E-36) CONST=1.-Y/Z0
  28. C
  29.         XPROJ=X/CONST
  30.         YPROJ=Z/CONST
  31. C
  32.         RETURN
  33.         END
  34. C
  35. C-----------------------------------------------------------------------
  36. C
  37.         SUBROUTINE XYZRST(XRST,YRST,ZRST,X,Y,Z,ALPHA,BETA,GAMMA,SX,SY,SZ,
  38.      *  ,XT,YT,ZT,NEWMAT)
  39. C
  40. C       THIS SUBROUTINE WILL ROTATE, SCALE, AND TRANSFORM A SET OF XYZ 
  41. C       COORDINATES.
  42. C
  43. C       INPUTS:
  44. C               X,Y,Z   REAL    INPUT COORDINATES
  45. C               ALPHA   REAL    ROTATION ANGLE ABOUT Z AXIS
  46. C               BETA    REAL    ROTATION ANGLE ABOUT Y AXIS
  47. C               GAMMA   REAL    ROTATION ANGLE ABOUT X AXIS
  48. C               SX,SY,SZ REAL   SCALING FACTORS FOR EACH AXIS
  49. C               XT,YT,ZT REAL   TRANSLATION ALONG EACH AXIS
  50. C               NEWMAT  LOGICAL .TRUE. WILL RESULT IN COMPUTING MATRIX
  51. C       OUTPUTS:
  52. C               XRST    REAL    RSTECTED VALUE FOR X AXIS
  53. C               YRST    REAL    RSTECTED VALUE FOR Y AXIS
  54. C
  55.         REAL X,Y,Z,ALPHA,BETA,GAMMA,SX,SY,SZ,XT,YT,ZT,XRST,YRST,ZRST
  56.         LOGICAL*1 NEWMAT
  57. C
  58.         REAL MATRIX(4,3),ZRST
  59. C
  60.         DATA MATRIX/1.,0.,0.,0.,0.,1.,0.,0.,0.,0.,1.,0./
  61. C
  62. C       FORM MATRIX
  63. C
  64.         IF (.NOT.NEWMAT) GO TO 100
  65. C       USE COSINE TERMS AS TEMPORARY STORAGE FOR RADIAN MEASURE ANGLES
  66. C
  67.         COSA=ALPHA/57.2958
  68.         COSB=BETA/57.2958
  69.         COSG=GAMMA/57.2958
  70. C
  71.         SINA=SIN(COSA)
  72.         COSA=COS(COSA)
  73.         SINB=SIN(COSB)
  74.         COSB=COS(COSB)
  75.         SING=SIN(COSG)
  76.         COSG=COS(COSG)
  77. C
  78.         MATRIX(1,1)=COSA*COSB*SX
  79.         MATRIX(1,2)=SINA*COSB*SY
  80.         MATRIX(1,3)=-SINB*SZ
  81. C
  82.         MATRIX(2,1)=(COSA*SINB*SING-SINA*COSG)*SX
  83.         MATRIX(2,2)=(COSA*COSG+SINA*SINB*SING)*SY
  84.         MATRIX(2,3)=COSB*SING*SZ
  85. C
  86.         MATRIX(3,1)=(SINA*SING+COSA*SINB*COSG)*SX
  87.         MATRIX(3,2)=(SINA*SINB*COSG-COSA*SING)*SY
  88.         MATRIX(3,3)=COSB*COSG*SZ
  89. C
  90.         MATRIX(4,1)=XT
  91.         MATRIX(4,2)=YT
  92.         MATRIX(4,3)=ZT
  93. C
  94. C       CALCULATE ROTATED, SCALED, TRANSLATED VALUES
  95. C
  96. 100     XRST=MATRIX(1,1)*X+MATRIX(2,1)*Y+MATRIX(3,1)*Z+MATRIX(4,1)
  97.         YRST=MATRIX(1,2)*X+MATRIX(2,2)*Y+MATRIX(3,2)*Z+MATRIX(4,2)
  98.         ZRST=MATRIX(1,3)*X+MATRIX(2,3)*Y+MATRIX(3,3)*Z+MATRIX(4,3)
  99. C
  100.         RETURN
  101.         END
  102. C
  103. C-----------------------------------------------------------------------
  104. C
  105.         SUBROUTINE GRAPH(XMINI,XMAXI,NX,YMINI,YMAXI,NY,SXL,SXR,SYB,SYT)
  106. C
  107. C       THIS SUBROUTINE PLOTS AND LABELS A GRAPH AND ESTABLISHES SCALE
  108. C       FACTORS FOR FUTURE USE.
  109. C
  110. C       INPUTS:
  111. C               XMINI   REAL    MINIMUM VALUE FOR X AXIS
  112. C               XMAXI   REAL    MAXIMUM VALUE FOR X AXIS
  113. C               NX      INTEGER APPROXIMATE NUMBER OF DIVISIONS ON AXIS
  114. C               YMINI   REAL    MINIMUM VALUE FOR Y AXIS
  115. C               YMAXI   REAL    MAXIMUM VALUE FOR Y AXIS
  116. C               NY      INTEGER APPROXIMATE NUMBER OF DIVISIONS ON YAXIS
  117. C               SXL,SXR REAL    SCREEN LEFT AND RIGHT X COORDINATES
  118. C               SYB,SYT REAL    SCREEN BOTTOM AND TOP Y COORDINATES
  119. C       OUTPUTS:
  120. C               NONE RETURNED
  121. C
  122.         REAL XMINI,XMAXI,YMINI,YMAXI,SXL,SXR,SYB,SYT
  123.         INTEGER NX,NY
  124. C
  125.         BYTE GFORM,BUFFER,COLOUR
  126.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  127.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  128.         INTEGER NXCHAR,NYCHAR,NXLINE
  129.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  130.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  131.      *  COLOUR,NBUFF,GFORM(7)
  132. C
  133. C
  134. C       SET SCALE FACTORS
  135. C
  136.         XMIN=XMINI
  137.         XMAX=XMAXI
  138.         YMIN=YMINI
  139.         YMAX=YMAXI
  140.         CALL SWINDO(SXL,SXR,SYB,SYT)
  141. C
  142. C       DRAW AXES
  143. C
  144.         CALL DXDY(XMIN,XMAX,NX,DX,LBLNUM,LBLDEC)
  145.         CALL AXIS(XMIN,XMAX,DX,SXL,SYB,SXR,SYB,CHYSZ/2.,270.,LBLNUM,
  146.      *  LBLDEC,0.)
  147.         CALL DXDY(YMIN,YMAX,NY,DY,LBLNUM,LBLDEC)
  148.         CALL AXIS(YMIN,YMAX,DY,SXL,SYB,SXL,SYT,CHXSZ/2.,180.,LBLNUM,
  149.      *  LBLDEC,90.)
  150. C
  151. C       DO VERTICAL DOTTED LINES
  152. C
  153.         CALL TICEND(XMIN,XMAX,DX,TIC,TICND)
  154.         DXYDOT=DY/10.
  155.         IF (TIC.EQ.XMIN) TIC=TIC+DX
  156. 1       IF ((DX.GE.0.0) .AND. (TIC.GT.TICND)) GO TO 3
  157.         IF ((DX.LT.0.0) .AND. (TIC.LT.TICND)) GO TO 3
  158.         XDOT=SX(TIC)
  159.         TIC=TIC+DX
  160.         XYDOT=YMIN+DXYDOT
  161. 2       IF ((DXYDOT.GE.0.0) .AND. (XYDOT.GT.YMAX)) GO TO 1
  162.         IF ((DXYDOT.LT.0.0) .AND. (XYDOT.LT.YMAX)) GO TO 1
  163.         YDOT=SY(XYDOT)
  164.         XYDOT=XYDOT+DXYDOT
  165.         CALL POINT(XDOT,YDOT)
  166.         GO TO 2
  167. C
  168. C       DO HORIZONTAL DOTTED LINES
  169. C
  170. 3       CALL TICEND(YMIN,YMAX,DY,TIC,TICND)
  171.         DXYDOT=DX/10.
  172.         IF (TIC.EQ.YMIN) TIC=TIC+DY
  173. 4       IF((DY.GE.0.0) .AND. (TIC.GT.TICND)) RETURN
  174.         IF((DY.LT.0.0) .AND. (TIC.LT.TICND)) RETURN
  175.         YDOT=SY(TIC)
  176.         TIC=TIC+DY
  177.         XYDOT=XMIN+DXYDOT
  178. 5       IF((DXYDOT.GE.0.0) .AND. (XYDOT.GT.XMAX)) GO TO 4
  179.         IF ((DXYDOT.LT.0.0) .AND. (XYDOT.LT.XMAX)) GO TO 4
  180.         XDOT=SX(XYDOT)
  181.         XYDOT=XYDOT+DXYDOT
  182.         CALL POINT (XDOT,YDOT)
  183.         GO TO 5
  184.         END
  185. C
  186. C-----------------------------------------------------------------------
  187. C
  188.         SUBROUTINE AXIS(R1,R2,DRI,SX1,SY1,SX2,SY2,TICLEN,TICANG,
  189.      *  LBLNUM,LBLDEC,LBLANG)
  190. C
  191. C       THIS SUBROUTINE PLOTS AND LABELS A LINEAR GRAPH AXIS
  192. C
  193. C       INPUTS:
  194. C               R1      REAL    REAL WORLD VALUE AT START OF AXIS
  195. C               R2      REAL    REAL WORLD VALUE AT END OF AXIS
  196. C               SX1,SY1 REAL    SCREEN COORDINATES OF START OF AXIS
  197. C               SX2,SY2 REAL    SCREEN COORD. OF END OF AXIS (0.=>1.)
  198. C               TICLEN  REAL    LENGTH OF TIC MARKS (SCREEN UNITS 0=>1.)
  199. C               TICANG  REAL    ANGLE BETWEEN HORIZONTAL AND TIC MARKS
  200. C               LBLNUM  INTEGER TOTAL NUMBERS OF CHARACTERS IN LABELS
  201. C               LBLDEC  INTEGER NUMBER OF DIGITS RIGHT OF DECIMAL PLACE
  202. C                               LABELS ARE  (F LBLNUM . LBLDEC ) FORMAT
  203. C               LBLANG  REAL    ANGLE BETWEEN HORIZONTAL AND LABELS
  204. C       OUTPUTS:
  205. C               NONE RETURNED
  206. C
  207.         REAL R1,R2,DRI,SX1,SY1,SX2,SY2,TICLEN,TICANG,LBLANG
  208.         INTEGER LBLNUM,LBLDEC
  209.         BYTE LBLFMT(9),LABEL(20)
  210.         REAL ANGTIC,ANGLBL,LENTIC,XLEN,YLEN,RLEN,DR,RTIC,REND
  211.         REAL XTIC,YTIC,ANGTST,XLABEL,YLABEL,T,RADIAN
  212. C
  213. C
  214.         BYTE GFORM,BUFFER,COLOUR
  215.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  216.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  217.         INTEGER NXCHAR,NYCHAR,NXLINE
  218.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  219.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  220.      *  COLOUR,NBUFF,GFORM(7)
  221. C
  222.         DATA RADIAN/57.2958/
  223.         IF (DRI.EQ.0.0) GO TO 997
  224. C
  225. C       CORRECT INPUT VALUES, CALCULATE CONSTANT TERMS
  226. C
  227.         ANGTIC=TICANG
  228.         IF (TICLEN.LT.0.0) ANGTIC=(-ANGTIC)
  229.         ANGTIC=POSANG(ANGTIC)
  230.         ANGLBL=POSANG(LBLANG)
  231.         LENTIC=ABS(TICLEN)
  232.         XLEN=SX2-SX1
  233.         YLEN=SY2-SY1
  234.         RLEN=R2-R1
  235.         IF (RLEN.EQ.0.0) GO TO 997
  236.         DR=SIGN(DRI,RLEN)
  237.         CALL TICEND(R1,R2,DR,RTIC,REND)
  238.         ANGTST=ANGTIC-ANGLBL
  239.         ANGTST=POSANG(ANGTST)
  240.         ANGTIC=ANGTIC/RADIAN
  241.         ANGLBL=ANGLBL/RADIAN
  242.         XTIC=LENTIC*COS(ANGTIC)
  243.         YTIC=LENTIC*SIN(ANGTIC)
  244.         SCALE(3)=COS(ANGLBL)
  245.         SCALE(4)=SIN(ANGLBL)
  246. C
  247. C       CALCULATE OFFSETS FOR LABLES
  248. C
  249.         IF (ANGTST.LT.45) GO TO 100
  250.         IF (ANGTST.LT.135) GO TO 200
  251.         IF (ANGTST.LT.225) GO TO 300
  252.         IF (ANGTST.LT.315) GO TO 400
  253. C
  254. C       CASE 1: TIC IS TO THE "LEFT" OF LABEL
  255. 100     XLABEL=(CHXSZ*SCALE(3)+CHYSZ*SCALE(4))/2.
  256.         YLABEL=(CHYSZ*SCALE(3)-CHXSZ*SCALE(4))/2.
  257.         GO TO 500
  258. C
  259. C       CASE 2: TIC IS "BELOW" LABEL
  260. 200     T=FLOAT(LBLNUM)*CHXSZ
  261.         XLABEL=(-T*SCALE(3)-CHYSZ*SCALE(4))/2.
  262.         YLABEL=(-T*SCALE(4)+CHYSZ*SCALE(3))/2.
  263.         GO TO 500
  264. C
  265. C       CASE 3: TIC IS TO THE "RIGHT" OF LABEL
  266. 300     T=(FLOAT(LBLNUM)+.5)*CHXSZ
  267.         XLABEL=SCALE(4)*CHYSZ/2.-T*SCALE(3)
  268.         YLABEL=-SCALE(3)*CHYSZ/2.-T*SCALE(4)
  269.         GO TO 500
  270. C
  271. C       CASE 4: TIC IS "ABOVE" LABEL
  272. 400     T=FLOAT(LBLNUM)*CHXSZ/2.
  273.         XLABEL=-T*SCALE(3)-CHYSZ*SCALE(4)*1.5
  274.         YLABEL=-T*SCALE(4)-CHYSZ*SCALE(3)*1.5
  275. C
  276. C       FORM LABEL FORMAT
  277. Bn
  278. B
  279. B
  280. B
  281. B
  282. B
  283. B
  284. B
  285. B
  286. B
  287. B
  288. B
  289. B
  290. B
  291. B
  292. B
  293. B
  294. B
  295. B
  296. B
  297. B
  298. B
  299. BB
  300. O
  301. C
  302. 500     ENCODE (LBLFMT,501) LBLNUM,LBLDEC
  303. 501     FORMAT('(F',I3,'.',I2,')')
  304. C
  305. C       DRAW AXIS
  306. C
  307.         CALL SEGMNT(SX1,SY1,SX2,SY2)
  308. 600     IF ((DR.LT.0.0) .AND. (RTIC.LT.REND)) GO TO 999
  309.         IF ((DR.GT.0.0) .AND. (RTIC.GT.REND)) GO TO 999
  310.         DTIC=(RTIC-R1)/RLEN
  311.         X=XLEN*DTIC+SX1
  312.         Y=YLEN*DTIC+SY1
  313.         CALL MOVE(X,Y)
  314.         X=X+XTIC
  315.         Y=Y+YTIC
  316.         CALL VECTOR(X,Y)
  317.         X=X+XLABEL
  318.         Y=Y+YLABEL
  319.         ENCODE (LABEL,LBLFMT) RTIC
  320.         CALL GWRITE(X,Y,LABEL,LBLNUM)
  321.         RTIC=RTIC+DR
  322.         GO TO 600
  323. C
  324. C       ERROR MESSAGE
  325. C
  326. 997     WRITE(3,998)
  327. 998     FORMAT('0ZERO VALUE FOR REAL LENGTH OR INCREMENT')
  328. 999     T=CHROT/RADIAN
  329.         SCALE(3)=COS(T)
  330.         SCALE(4)=SIN(T)
  331.         RETURN
  332.         END
  333. C
  334. C-----------------------------------------------------------------------
  335. C
  336.         SUBROUTINE TICEND(RMIN,RMAX,DR,R1,R2)
  337. C
  338. C       THIS SUBROUTINE CALCULATES ENDPOINTS WHICH ARE MULTIPLES OF DR
  339. C       AND LIE BETWEEN RMIN AND RMAX.
  340. C
  341. C       INPUTS:
  342. C               RMIN    REAL    STARTING VALUE FOR RANGE
  343. C               RMAX    REAL    ENDING   VALUE FOR RANGE
  344. C               DR      REAL    INCREMENT BETWEEN INTERVALS IN RANGE
  345. C       OUTPUTS:
  346. C               R1      REAL    STARTING VALUE FOR TIC MARKS
  347. C               R2      REAL    ENDING   VALUE FOR TIC MARKS
  348. C
  349.         REAL RMIN,RMAX,DR,R1,R2
  350. C
  351.         R1=FLOAT( INT( RMIN/DR ))*DR
  352.         R2=FLOAT( INT( RMAX/DR ))*DR
  353.         IF(R1.LT.0.0 .OR. R2.LT.0.0) GO TO 2
  354.         IF(DR.GT.0.0 .AND. R1.LT.RMIN) R1=R1+DR
  355.         IF(DR.LT.0.0 .AND. R2.LT.RMAX) R2=R2-DR
  356. 2       IF(R1.GT.0.0 .OR. R2.GT.0.0) GO TO 100
  357.         IF(DR.LT.0.0 .AND. R1.GT.RMIN) R1=R1+DR
  358.         IF(DR.GT.0.0 .AND. R2.GT.RMAX) R2=R2-DR
  359. 100     CONTINUE
  360.         RETURN
  361.         END
  362. C
  363. C-----------------------------------------------------------------------
  364. C
  365.         SUBROUTINE DXDY(X1,X2,NX,DX,LBLNUM,LBLDEC)
  366. C
  367. C       THIS FUNCTION CALCULATES A GOOD ENGINEERING VALUE FOR THE 
  368. C       INCREMENT BETWEEN TIC MARKS ON AN AXIS
  369. C
  370. C       INPUTS:
  371. C               X1      REAL    MINIMUM VALUE ASSOCIATED WITH AXIS
  372. C               X2      REAL    MAXIMUM VALUE ASSOCIATED WITH AXIS
  373. C               NX      INTEGER APPROXIMATE NUMBER OF INTERVALS
  374. C       OUTPUTS:
  375. C               DX      REAL    INCREMENT BETWEEN TIC MARKS
  376. C               LBLNUM  INTEGER NUMBER OF CHARACTERS IN AXIS LABELS
  377. C               LBLDEC  INTEGER NUMBER OF DIGITS RIGHT OF DECIMAL PLACE
  378. C
  379.         INTEGER NX,DXEXP,LBLNUM,LBLDEC
  380.         REAL X1,X2
  381. C
  382.         XLEN=X2-X1
  383.         IF (XLEN.EQ.0.0) GO TO 998
  384.         DX=ABS(XLEN/FLOAT(NX))
  385.         DXLOG=ALOG10(DX)
  386.         DXEXP=INT(DXLOG)
  387.         DXMANT=DXLOG-FLOAT(DXEXP)
  388.         IF (DXMANT.GT. 0.0) GO TO 2
  389.         DXEXP=DXEXP-1
  390.         DXMANT=DXMANT+1.
  391. 2       CONTINUE
  392.         DX=1.
  393.         IF (DXMANT.GT.0.18) DX=2.
  394.         IF (DXMANT.GT.0.48) DX=5.
  395.         IF (DXMANT.GT.0.9) DX=10.
  396.         DX=DX*10.**DXEXP
  397.         DX=SIGN(DX,XLEN)
  398. C
  399.         DXLOG=AMAX1(ABS(XLEN),DXLOG)
  400.         IF (X1.NE. 0.0) DXLOG=ABS(X1)
  401.         IF (X2.NE. 0.0) DXLOG=AMAX1(DXLOG,ABS(X2))
  402.         DXLOG=ALOG10(DXLOG)
  403.         LBLNUM=INT(DXLOG)
  404.         IF (LBLNUM.LT.0) LBLNUM=0
  405.         DXLOG=ABS(XLEN)
  406.         IF (X1.NE. 0.0) DXLOG=AMIN1(DXLOG,ABS(X1))
  407.         IF (X2.NE. 0.0) DXLOG=AMIN1(DXLOG,ABS(X2))
  408.         DXLOG=AMIN1(DXLOG,ABS(XLEN))
  409.         IF (DX.NE.0.0) DXLOG=AMIN1(DXLOG,ABS(DX))
  410.         DXLOG=ALOG10(DXLOG)
  411.         IF (DXLOG.LT. 0.0) DXLOG=DXLOG-1.
  412.         DXEXP=INT(DXLOG)
  413.         LBLDEC=IABS(MIN0(LBLNUM,DXEXP,0))
  414.         LBLNUM=IABS(LBLNUM)+LBLDEC+3
  415.         RETURN
  416. 998     WRITE(3,999)
  417. 999     FORMAT('0ZERO LENGTH AXIS IN DXDY. VALUE NOT SET')
  418.         RETURN
  419.         END
  420. C
  421. C-----------------------------------------------------------------------
  422. C
  423.         FUNCTION POSANG(ANGLE)
  424. C
  425. C       THIS FUNCTION RETURNS AN ANGLE THAT IS THE SAME AS ANGLE, BUT IN
  426. C       THE RANGE 0.0 TO 360.
  427. C
  428. C       INPUTS:
  429. C               ANGLE   REAL    ANGLE TO BE CONVERTED
  430. C       OUTPUTS:
  431. C               POSANG  REAL    CONVERTED ANGLE
  432. C
  433.         REAL ANGLE
  434.         POSANG=ANGLE
  435.         IF (POSANG.GE.0.0 .AND. POSANG.LT.360.) RETURN
  436.         POSANG=AMOD(ANGLE,360.)
  437.         IF (POSANG.LT.0.0) POSANG=POSANG+360.
  438.         RETURN
  439.         END
  440. C
  441. C-----------------------------------------------------------------------
  442. C
  443.         SUBROUTINE GWRITE(X,Y,STRING,N)
  444. C
  445. C       THIS SUBROUTINE PLOTS A STRING OF GRAPHICAL CHARACTERS
  446. C
  447. C       INPUTS:
  448. C               X,Y     REAL    COORDINATES FOR FIRST CHARACTER
  449. C               STRING  BYTE ARRAY      STRING TO BE PLOTTED
  450. C               N       INTEGER NUMBER OF CHARACTERS IN STRING
  451. C       OUTPUTS:
  452. C               NONE RETURNED
  453. C
  454.         INTEGER N
  455.         BYTE STRING(N)
  456.         REAL    X,Y
  457. C
  458. C
  459.         BYTE GFORM,BUFFER,COLOUR
  460.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  461.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  462.         INTEGER NXCHAR,NYCHAR,NXLINE
  463.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  464.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  465.      *  COLOUR,NBUFF,GFORM(7)
  466. C
  467.         XC=X
  468.         YC=Y
  469.         DO 1 I=1,N
  470.         CALL GCHAR(XC,YC,STRING(I))
  471.         XC=XC+CHXSZ*SCALE(3)
  472.         YC=YC+CHXSZ*SCALE(4)
  473. 1       CONTINUE
  474.         RETURN
  475.         END
  476. C
  477. C-----------------------------------------------------------------------
  478. C
  479.         SUBROUTINE GCHAR(CX,CY,CHAR)
  480. C
  481. C       THIS SUBROUTINE PLOTS A CHARACTER AT X,Y. SIZE AND ROTATION ARE
  482. C       TAKEN FROM COMMON
  483. C
  484. C       INPUTS:
  485. C               CHAR    BYTE    ASCII CHARACTER TO BE PLOTTED
  486. C               CX,CY   REAL    COORDINATES OF CHARACTER
  487. C
  488. C       OUTPUTS:
  489. C               NONE RETURNED TO CALLING PROGRAM
  490. C
  491.         BYTE SCHAR,CMD,IX,IY,CHAR
  492.         INTEGER ICHAR, IX2,IY2
  493.         BYTE TCHAR
  494.         REAL CX,CY,X,Y
  495. C
  496. C
  497.         BYTE GFORM,BUFFER,COLOUR
  498.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  499.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  500.         INTEGER NXCHAR,NYCHAR,NXLINE
  501.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  502.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  503.      *  COLOUR,NBUFF,GFORM(7)
  504. C
  505.         COMMON /GTABLE/ICHAR(95),TCHAR(721)
  506. C
  507.         EQUIVALENCE (IX,IX2),(IY,IY2)
  508. C
  509.         SCHAR=CHAR.AND.127
  510.         IF (SCHAR.LT.32) RETURN
  511.         I=SCHAR-31
  512.         I=ICHAR(I)
  513. C
  514. C       WRITE(3,100) SCHAR,TCHAR(I),I
  515. C100    FORMAT('0IN GCHAR. CHARACTER IS:',I4,/,
  516. C     * ' FIRST TABLE COMMAND IS:',I4,' (#',I4,')')
  517. 1       CMD=TCHAR(I)
  518.         IF (CMD.EQ.-1) RETURN
  519.         IX2=0
  520.         IY2=0
  521.         IY=CMD.AND.15
  522.         IX=CMD.AND.112
  523.         IX=IX/16
  524.         X=FLOAT(IX)*CHXSZ/7.
  525.         Y=FLOAT(IY)*CHYSZ/9.
  526. C       WRITE(3,101) X,Y,IX2,IY2,CX,CY
  527. C101    FORMAT(' X STROKE=',G12.5,' Y=',G12.5,
  528. C     * /,' IX DECODED=',I5,' IY=',I5,/,
  529. C     * ' REFERENCE COORD=',2G12.5)
  530.         T=X
  531.         X=CX+SCALE(3)*X-SCALE(4)*Y
  532.         Y=CY+SCALE(4)*T+SCALE(3)*Y
  533.         IF (CMD) 3,2,2
  534. 2       CALL MOVE(X,Y)
  535. C       WRITE(3,102) X,Y
  536. C102    FORMAT(' MOVING TO ',G12.5,', ',G12.5)
  537.         GO TO 4
  538. 3       CALL VECTOR(X,Y)
  539. C       WRITE(3,103) X,Y
  540. C103    FORMAT(' DRAWING TO ',G12.5,', ',G12.5)
  541. 4       I=I+1
  542.         GO TO 1
  543.         END
  544. C
  545. C-----------------------------------------------------------------------
  546. C
  547.         SUBROUTINE CHSET(XSIZE,YSIZE,THETA)
  548. C
  549. C       THIS SUBROUTINE SETS THE CHARACTER ATTRIBUTES
  550. C
  551. C       INPUTS:
  552. C               XSIZE   REAL    WIDTH OF CHARACTER SPACE
  553. C               YSIZE   REAL    HEIGHT OF CHARACTER SPACE
  554. C               THETA   REAL    ROTATION OF CHARACTERS
  555. C       OUTPUTS:
  556. C               NONE RETURNED
  557. C
  558.         REAL XSIZE,YSIZE,THETA
  559. C
  560.         BYTE GFORM,BUFFER,COLOUR
  561.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  562.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  563.         INTEGER NXCHAR,NYCHAR,NXLINE
  564.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  565.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  566.      *  COLOUR,NBUFF,GFORM(7)
  567. C
  568.         CHXSZ=XSIZE
  569.         CHYSZ=YSIZE
  570.         CHROT=THETA
  571.         T=THETA/57.295
  572.         SCALE(3)=COS(T)
  573.         SCALE(4)=SIN(T)
  574.         RETURN
  575.         END
  576. C
  577. C-----------------------------------------------------------------------
  578. C
  579.         SUBROUTINE GRINIT(NAME)
  580. C
  581. C       THIS SUBROUTINE OPENS THE GRAPHIC OUTPUT FILE AND INITIALIZES
  582. C       GRAPHICAL VARIABLES
  583. C
  584. C       INPUTS:
  585. C               NAME    BYTE ARRAY      CONTAINS FILE NAME
  586. C
  587. C       OUTPUTS:
  588. C               NONE RETURNED
  589. C
  590.         EXTERNAL CHRTBL
  591.         BYTE NAME(11)
  592. C
  593.         BYTE GFORM,BUFFER,COLOUR
  594.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  595.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  596.         INTEGER NXCHAR,NYCHAR,NXLINE
  597.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  598.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  599.      *  COLOUR,NBUFF,GFORM(7)
  600. C
  601.         DATA COLOUR,GFORM/127,'(','1','2','8','A','1',')'/
  602.         DATA BUFFER(1),BUFFER(2),BUFFER(3),BUFFER(4),BUFFER(5),NBUFF
  603.      *  /'C',0,'E','C',127,5/
  604.         DATA XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP 
  605.      *  /0.,1.,0.,1.,0.,1.,0.,1./
  606.         DATA CHXSZ,CHYSZ,CHROT /.0125,.02,0./
  607.         DATA XPOS,YPOS /0.,0./
  608.         DATA SCALE/1.,1.,1.,0./
  609. C
  610. C100    FORMAT(' IN GRINIT. GFORM=',7A1,' NAME=',16A1)
  611. C       WRITE(3,100) GFORM,NAME
  612.         IF(NAME(9).NE.32) GO TO 1
  613. C
  614. C       NO EXTENSION GIVEN- ADD .VEC
  615. C
  616.         NAME(9)='V'
  617.         NAME(10)='E'
  618.         NAME(11)='C'
  619. C
  620. 1       CALL OPEN(10,NAME,0)
  621. C
  622.         RETURN
  623.         END
  624. C
  625. C-----------------------------------------------------------------------
  626. C
  627.        BLOCK DATA CHRTBL
  628.        BYTE TCHAR
  629.        INTEGER ICHAR
  630.        COMMON /GTABLE/ ICHAR( 95),TCHAR( 721)
  631.        DATA TCHAR /
  632.      *   -1,  56, -75,  51, -78,  -1,  40, -90,  72, -58,  -1,  40,
  633.      *  -94,  72, -62,   6, -26,   4, -28,  -1,  56, -78,  87,-105,
  634.      * -122,-107, -43, -28, -45,-109,  -1, 104,-126,   8, -88, -90,
  635.      * -122,-120,  68, -28, -30, -62, -60,  -1,  98,-105, -88, -72,
  636.      *  -57, -58,-108,-109, -94, -78, -44,  -1,   6,-105,-104,-120,
  637.      * -121,-105,  -1,  72, -74, -76, -62,  -1,  40, -74, -76, -94,
  638.      *   -1,  21, -43,  39, -61,  71, -93,  -1,  55, -77,  21, -43,
  639.      *   -1,  17, -94, -93,-109,-110, -94,  -1,  21, -43,  -1,  34,
  640.      *  -93,-109,-110, -94,  -1,  88,-110,  -1,  40, -56, -42, -44,
  641.      *  -62, -94,-108,-106, -88,  -1,  38, -72, -78,  34, -62,  -1,
  642.      *   23, -88, -56, -41, -42,-109,-110, -46,  -1,  23, -88, -56,
  643.      *  -41, -42, -59, -44, -45, -62, -94,-109,  -1,  72, -62,  55,
  644.      * -108, -44,  -1,  88,-104,-106, -58, -43, -45, -62, -94,-109,
  645.      *   -1,  87, -56, -88,-105,-109, -94, -62, -45, -44, -59, -91,
  646.      * -108,  -1,  24, -40, -94,  -1,  37, -59, -44, -45, -62, -94,
  647.      * -109,-108, -91,-106,-105, -88, -56, -41, -42, -59,  -1,  19,
  648.      *  -94, -62, -45, -41, -56, -88,-105,-106, -91, -59, -42,  -1,
  649.      *   23, -89, -90,-106,-105,  20, -92, -93,-109,-108,  -1,  17,
  650.      *  -94, -93,-109,-110, -94,  22, -90, -91,-107,-106,  -1,  87,
  651.      * -107, -45,  -1,  22, -42,  20, -44,  -1,  23, -43,-109,  -1,
  652.      *   23, -88, -56, -41, -42, -76,  50, -79,  -1,  23, -88, -56,
  653.      *  -41, -45, -62, -94,-109,-108, -91, -75, -78,  -1,   2, -72,
  654.      *  -30,  20, -44,  -1,   5, -59, -44, -45, -62,-126,-120, -56,
  655.      *  -41, -42, -59,  -1,  87, -56,-104,-121,-125,-110, -62, -45,
  656.      *   -1,   2,-120, -56, -42, -44, -62,-126,  -1,  88,-120,-126,
  657.      *  -46,  53,-123,  -1,  88,-120,-126,  53,-123,  -1,  87, -56,
  658.      * -104,-121,-125,-110, -62, -45, -43, -75,  -1,   2,-120,  88,
  659.      *  -46,  85,-123,  -1,  40, -56,  56, -78,  34, -62,  -1,  20,
  660.      * -109, -94, -78, -61, -56,  56, -40,  -1,   8,-126,  88,-123,
  661.      *  -46,  -1,  24,-110, -46,  -1,   2,-120, -75, -24, -30,  -1,
  662.      *    2,-120, -30, -24,  -1,   7,-104, -40, -25, -29, -46,-110,
  663.      * -125,-121,  -1,   2,-120, -56, -41, -42, -59,-123,  -1,   7,
  664.      * -104, -40, -25, -28, -62,-110,-125,-121,  68, -30,  -1,   2,
  665.      * -120, -56, -41, -42, -59,-123,  53, -46,  -1,  87, -56,-104,
  666.      * -121,-122,-107, -59, -44, -45, -62,-110,-125,  -1,   8, -24,
  667.      *   56, -78,  -1,  24,-109, -94, -62, -45, -40,  -1,   8, -78,
  668.      *  -24,  -1,   8,-110, -75, -46, -24,  -1,   8, -30, 104,-126,
  669.      *   -1,  24, -76, -78,  88, -76,  -1,   8, -24,-126, -30,  -1,
  670.      *   88, -72, -78, -46,  -1,  24, -46,  -1,  24, -72, -78,-110,
  671.      *   -1,  22, -72, -42,  -1,   0, -32,  -1, 102, -41, -40, -24,
  672.      *  -25, -41,  -1,   5,-106, -74, -59, -61, -78,-110,-125,-108,
  673.      *  -60,  67, -46,  -1,  24,-110, -62, -45, -44, -59,-107,  -1,
  674.      *   85, -91,-108,-109, -94, -46,  -1,  88, -46, -94,-109,-108,
  675.      *  -91, -43,  -1,  82, -94,-109,-108, -91, -59, -44,-108,  -1,
  676.      *   87, -56, -72, -89, -94,  21, -59,  -1,  17, -96, -80, -63,
  677.      *  -59, -91,-108,-109, -94, -62,  -1,  18,-104,  21, -75, -60,
  678.      *  -62,  -1,  50, -75,  55, -72,  -1,  18,-111, -96, -80, -63,
  679.      *  -59,  71, -56,  -1,  24,-110,  20, -57,  37, -46,  -1,  40,
  680.      *  -72, -78,  34, -62,  -1,   2,-123,   4,-107, -91, -76, -78,
  681.      *   52, -59, -43, -28, -30,  -1,  18,-107,  20, -91, -59, -44,
  682.      *  -46,  -1,  20, -91, -59, -44, -45, -62, -94,-109,-108,  -1,
  683.      *   16,-107, -59, -44, -45, -62,-110,  -1,  80, -43, -91,-108,
  684.      * -109, -94, -46,  -1,  18,-107,  20, -91, -75, -60,  -1,  19,
  685.      *  -94, -62, -45, -60, -92,-107, -90, -58, -43,  -1,  40, -93,
  686.      *  -78, -62, -45, -44,  22, -74,  -1,  21,-109, -94, -62, -45,
  687.      *  -43,  83, -30,  -1,  21, -78, -43,  -1,  21, -94, -76, -62,
  688.      *  -43,  -1,  21, -62,  18, -59,  -1,  21, -78,  85, -78, -95,
  689.      * -112,  -1,  21, -43,-110, -46,  -1,  72, -72, -89, -90,-107,
  690.      *  -92, -93, -78, -62,  -1,  48, -72,  -1,  40, -72, -57, -58,
  691.      *  -43, -60, -61, -78, -94,  -1,   7,-104, -88, -58, -42, -25,
  692.      *   -1/                                                       
  693.        DATA ICHAR/
  694.      *    1,   2,   7,  12,  21,  32,  45,  57,  64,  69,  74,  81,
  695.      *   86,  93,  96, 102, 105, 115, 121, 130, 142, 148, 158, 171,
  696.      *  175, 192, 205, 216, 228, 232, 237, 241, 250, 263, 269, 281,
  697.      *  290, 298, 305, 311, 322, 329, 336, 345, 351, 355, 361, 366,
  698.      *  376, 384, 396, 406, 419, 424, 431, 435, 441, 446, 452, 457,
  699.      *  462, 465, 470, 474, 477, 484, 497, 505, 512, 520, 529, 537,
  700.      *  548, 555, 560, 569, 576, 582, 595, 603, 613, 621, 629, 636,
  701.      *  647, 656, 665, 669, 675, 680, 687, 692, 702, 705, 715/     
  702.        END
  703. C
  704. C-----------------------------------------------------------------------
  705. C
  706.         SUBROUTINE COLOR(BYTE)
  707. C
  708. C       THIS SUBROUTINE SETS THE COLOR TO BE USED IN PLOTTING
  709. C
  710. C       INPUTS:
  711. C               BYTE    BYTE    COLOR TO BE USED
  712. C                               NEG=> COMPLEMENTARY
  713. C                               0  => WHITE
  714. C                               POS=> BLACK
  715. C
  716.         BYTE BYTE
  717. C
  718.         BYTE GFORM,BUFFER,COLOUR
  719.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  720.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  721.         INTEGER NXCHAR,NYCHAR,NXLINE
  722.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  723.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  724.      *  COLOUR,NBUFF,GFORM(7)
  725. C
  726.         COLOUR=BYTE
  727.         IF(NBUFF.LT.126) GO TO 3
  728.         WRITE(10,GFORM)(BUFFER(I),I=1,NBUFF)
  729.         NBUFF=0
  730. 3       NBUFF=NBUFF+2
  731.         BUFFER(NBUFF-1)=67
  732.         BUFFER(NBUFF)=COLOUR
  733.         RETURN
  734.         END
  735. C
  736. C-----------------------------------------------------------------------
  737. C
  738.         SUBROUTINE SEGMNT(X1,Y1,X2,Y2)
  739. C
  740. C       THIS SUBROUTINE DRAWS A LINE SEGMENT FROM (X1,Y1) TO  (X2,Y2)
  741. C
  742. C       INPUTS:
  743. C               X1,Y1   REAL    STARTING COORDINATES
  744. C               X2,Y2   REAL    END COORDINATES
  745. C       OUTPUTS:
  746. C               NONE RETURNED
  747. C
  748.         INTEGER IRAST
  749.         REAL X1,Y1,X2,Y2
  750. C
  751.         BYTE GFORM,BUFFER,COLOUR
  752.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  753.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  754.         INTEGER NXCHAR,NYCHAR,NXLINE
  755.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  756.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  757.      *  COLOUR,NBUFF,GFORM(7)
  758. C
  759.         IF(NBUFF.LT.119) GO TO 2
  760.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  761.         NBUFF=0
  762. 2       NBUFF=NBUFF+1
  763.         BUFFER(NBUFF)='D'
  764.         IRAST=IFIX(X1*32767)
  765.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  766.         IRAST=IFIX(Y1*32767)
  767.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  768.         IRAST=IFIX(X2*32767)
  769.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  770.         IRAST=IFIX(Y2*32767)
  771.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  772.         XPOS=X2
  773.         YPOS=Y2
  774.         RETURN
  775.         END
  776. C
  777. C-----------------------------------------------------------------------
  778. C
  779.         SUBROUTINE ERASE
  780. C
  781. C       THIS SUBROUTINE CLEARS THE ENTIRE PLOT TO THE PRESET COLOR
  782. C
  783. C       INPUTS:
  784. C               NONE
  785. C       OUTPUTS:
  786. C               NONE RETURNED
  787. C
  788. C
  789.         BYTE GFORM,BUFFER,COLOUR
  790.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  791.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  792.         INTEGER NXCHAR,NYCHAR,NXLINE
  793.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  794.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  795.      *  COLOUR,NBUFF,GFORM(7)
  796. C
  797.         IF (NBUFF.LT.127) GO TO 1
  798.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  799.         NBUFF=0
  800. 1       NBUFF=NBUFF+1
  801.         BUFFER(NBUFF)=69
  802.         RETURN
  803.         END
  804. C
  805. C-----------------------------------------------------------------------
  806. C
  807.         SUBROUTINE FILL(X1,Y1,X2,Y2,YF)
  808. C
  809. C       THIS SUBROUTINE FILLS IN A SOLID AREA BETWEEN A LINE SEGMENT AND
  810. C       A HORIZONTAL LINE
  811. C
  812. C       INPUTS:
  813. C               X1,Y1   REAL    STARTING COORDINATES OF LINE SEGMENT
  814. C               X2,Y2   REAL    END COORDINATES OF LINE SEGMENT
  815. C               YF      REAL    HORIZONTAL LEVEL TO WHICH THE FILLED 
  816. C                               AREA WILL EXTEND
  817. C       OUTPUTS:
  818. C               NONE RETURNED
  819. C
  820.         INTEGER IRAST
  821.         REAL X1,Y1,X2,Y2,YF
  822. C
  823.         BYTE GFORM,BUFFER,COLOUR
  824.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  825.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  826.         INTEGER NXCHAR,NYCHAR,NXLINE
  827.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  828.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  829.      *  COLOUR,NBUFF,GFORM(7)
  830. C
  831.         IF (NBUFF.LT.117) GO TO 2
  832.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  833.         NBUFF=0
  834. 2       NBUFF=NBUFF+1
  835.         BUFFER(NBUFF)='F'
  836.         IRAST=IFIX(X1*32767)
  837.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  838.         IRAST=IFIX(Y1*32767)
  839.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  840.         IRAST=IFIX(X2*32767)
  841.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  842.         IRAST=IFIX(Y2*32767)
  843.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  844.         IRAST=IFIX(YF*32767)
  845.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  846.         XPOS=X2
  847.         YPOS=Y2
  848.         RETURN
  849.         END
  850. C
  851. C-----------------------------------------------------------------------
  852. C
  853.         SUBROUTINE VECTOR(X,Y)
  854. C
  855. C       THIS SUBROUTINE PLOTS A LINE SEGMENT FROM THE PRESENT POSITION
  856. C       TO THE GIVEN COORDINATES
  857. C
  858. C       INPUTS:
  859. C               X,Y     REAL    COORDINATES OF END OF VECTOR
  860. C       OUTPUTS:
  861. C               NONE RETURNED
  862. C
  863.         INTEGER IRAST
  864.         REAL X,Y
  865. C
  866.         BYTE GFORM,BUFFER,COLOUR
  867.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  868.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  869.         INTEGER NXCHAR,NYCHAR,NXLINE
  870.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  871.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  872.      *  COLOUR,NBUFF,GFORM(7)
  873. C
  874.         IF (NBUFF.LT.123) GO TO 2
  875.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  876.         NBUFF=0
  877. 2       NBUFF=NBUFF+1
  878.         BUFFER(NBUFF)='I'
  879.         IRAST=IFIX(X*32767)
  880.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  881.         IRAST=IFIX(Y*32767)
  882.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  883.         XPOS=X
  884.         YPOS=Y
  885.         RETURN
  886.         END
  887. C
  888. C-----------------------------------------------------------------------
  889. C
  890.         SUBROUTINE MOVE(X,Y)
  891. C
  892. C       THIS SUBROUTINE MOVES PRESENT COORDINATES TO NEW LOCATION
  893. C       WITHOUT PLOTTING
  894. C
  895. C       INPUTS:
  896. C               X,Y     REAL    NEW POSITION COORDINATES
  897. C       OUTPUTS:
  898. C               NONE RETURNED
  899. C
  900.         INTEGER IRAST
  901.         REAL X,Y
  902. C
  903.         BYTE GFORM,BUFFER,COLOUR
  904.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  905.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  906.         INTEGER NXCHAR,NYCHAR,NXLINE
  907.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  908.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  909.      *  COLOUR,NBUFF,GFORM(7)
  910. C
  911.         IF (NBUFF.LT.123) GO TO 2
  912.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  913.         NBUFF=0
  914. 2       NBUFF=NBUFF+1
  915.         BUFFER(NBUFF)='M'
  916.         IRAST=IFIX(X*32767)
  917.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  918.         IRAST=IFIX(Y*32767)
  919.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  920.         XPOS=X
  921.         YPOS=Y
  922.         RETURN
  923.         END
  924. C
  925. C-----------------------------------------------------------------------
  926. C
  927.         SUBROUTINE GPRINT
  928. C
  929. C       THIS SUBROUTINE CAUSES THE PICTURE PLOTTED SO FAR TO BE PRINTED
  930. C
  931. C       INPUTS:
  932. C               NONE
  933. C       OUTPUTS:
  934. C               NONE RETURNED
  935. C
  936. C
  937.         BYTE GFORM,BUFFER,COLOUR
  938.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  939.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  940.         INTEGER NXCHAR,NYCHAR,NXLINE
  941.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  942.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  943.      *  COLOUR,NBUFF,GFORM(7)
  944. C
  945.         IF (NBUFF.LT.127) GO TO 2
  946.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  947.         NBUFF=0
  948. 2       NBUFF=NBUFF+1
  949.         BUFFER(NBUFF)=79
  950.         RETURN
  951.         END
  952. C
  953. C-----------------------------------------------------------------------
  954. C
  955.         SUBROUTINE POINT(X,Y)
  956. C
  957. C       THIS SUBROUTINE PLOTS A SINGLE POINT AT (X,Y)
  958. C
  959. C       INPUTS:
  960. C               X,Y     REAL    COORDINATES OF POINT
  961. C       OUTPUTS:
  962. C               NONE RETURNED
  963. C
  964.         INTEGER IRAST
  965.         REAL X,Y
  966. C
  967.         BYTE GFORM,BUFFER,COLOUR
  968.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  969.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  970.         INTEGER NXCHAR,NYCHAR,NXLINE
  971.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  972.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  973.      *  COLOUR,NBUFF,GFORM(7)
  974. C
  975.         IF (NBUFF.LT.119) GO TO 2
  976.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  977.         NBUFF=0
  978. 2       NBUFF=NBUFF+1
  979.         BUFFER(NBUFF)='P'
  980.         IRAST=IFIX(X*32767)
  981.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  982.         IRAST=IFIX(Y*32767)
  983.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  984.         XPOS=X
  985.         YPOS=Y
  986.         RETURN
  987.         END
  988. C
  989. C-----------------------------------------------------------------------
  990. C
  991.         SUBROUTINE GRFINI
  992. C
  993. C       THIS SUBROUTINE TERMINATES THE PLOT AND CLOSES THE FILE
  994. C
  995. C       INPUTS:
  996. C               NONE
  997. C       OUTPUTS:
  998. C               NONE RETURNED
  999. C
  1000. C
  1001.         BYTE GFORM,BUFFER,COLOUR
  1002.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  1003.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  1004.         INTEGER NXCHAR,NYCHAR,NXLINE
  1005.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  1006.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  1007.      *  COLOUR,NBUFF,GFORM(7)
  1008. C
  1009.         IF (NBUFF.LT.126) GO TO 2
  1010.         WRITE (10) (BUFFER(I),I=1,NBUFF)
  1011.         NBUFF=0
  1012. 2       NBUFF=NBUFF+1
  1013.         BUFFER(NBUFF)=79
  1014.         NBUFF=NBUFF+1
  1015.         BUFFER(NBUFF)=81
  1016.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  1017.         ENDFILE 10
  1018.         RETURN
  1019.         END
  1020. C
  1021. C-----------------------------------------------------------------------
  1022. C
  1023.         SUBROUTINE GSTRNG(X,Y,STRING,NCHAR)
  1024. C
  1025. C       INPUTS:
  1026. C               X,Y     REAL    STARTING COORDINATES FOR ARRAY
  1027. C               STRING  BYTE ARRAY      STRING TO BE PRINTED ON MX-80
  1028. C               NCHAR   INTEGER NUMBER OF CHARACTERS IN STRING
  1029. C       OUTPUTS:
  1030. C               NONE RETURNED
  1031. C
  1032.         REAL X,Y
  1033.         INTEGER NCHAR,IRAST
  1034.         BYTE STRING(NCHAR)
  1035. C
  1036. C
  1037.         BYTE GFORM,BUFFER,COLOUR
  1038.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  1039.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  1040.         INTEGER NXCHAR,NYCHAR,NXLINE
  1041.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  1042.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  1043.      *  COLOUR,NBUFF,GFORM(7)
  1044. C
  1045.         IF (NCHAR.LE.0) RETURN
  1046.         IF (NBUFF.LT.117-NCHAR) GO TO 2
  1047.         WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF)
  1048.         NBUFF=0
  1049. 2       IF (NCHAR.GT.115) NCHAR=115
  1050.         NBUFF=NBUFF+1
  1051.         BUFFER(NBUFF)='S'
  1052.         IRAST=IFIX(X*32767)
  1053.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  1054.         IRAST=IFIX(Y*32767)
  1055.         CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF)
  1056.         CALL CONCAT(BUFFER,NBUFF,STRING,NCHAR,BUFFER,NBUFF)
  1057.         NBUFF=NBUFF+1
  1058.         BUFFER(NBUFF)=13
  1059.         NBUFF=NBUFF+1
  1060.         BUFFER(NBUFF)='N'
  1061. C100    FORMAT(' IN GSTRNG. INPUT STRING IS:',/,' ',116A1)
  1062. C101    FORMAT(' DECIMAL DUMP OF BUFFER FOLLOWS NBUFF:',I5)
  1063. C102    FORMAT(20I4)
  1064. C       WRITE(3,100) (STRING(I),I=1,NCHAR)
  1065. C       WRITE(3,101) NBUFF
  1066. C       WRITE(3,102) BUFFER
  1067.         RETURN
  1068.         END
  1069. C
  1070. C-----------------------------------------------------------------------
  1071. C
  1072.         FUNCTION SY(RYI)
  1073. C
  1074. C       THIS FUNCTION DOES A LINEAR CONVERSION FROM THE REAL TO THE 
  1075. C       SCREEN Y COORDINATE.
  1076. C
  1077. C       INPUTS:
  1078. C               RYI     REAL    REAL WORLD Y COORDINATE
  1079. C       OUTPUTS:
  1080. C               SY      REAL    SCREEN Y COORDINATE
  1081. C
  1082.         REAL RYI
  1083. C
  1084. C
  1085.         BYTE GFORM,BUFFER,COLOUR
  1086.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  1087.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  1088.         INTEGER NXCHAR,NYCHAR,NXLINE
  1089.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  1090.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  1091.      *  COLOUR,NBUFF,GFORM(7)
  1092. C
  1093.         SY=(RYI-YMIN)/SCALE(2)+SYBOT
  1094.         RETURN
  1095.         END
  1096. C
  1097. C-----------------------------------------------------------------------
  1098. C
  1099.         FUNCTION SX(RXI)
  1100. C
  1101. C       THIS FUNCTION DOES A LINEAR CONVERSION FROM THE REAL TO THE 
  1102. C       SCREEN X COORDINATE
  1103. C
  1104. C       INPUTS:
  1105. C               RXI     REAL    REAL WORLD COORDINATE
  1106. C       OUTPUTS:
  1107. C               SX      REAL    SCREEN X COORDINATE
  1108. C
  1109.         REAL RXI
  1110. C
  1111. C
  1112.         BYTE GFORM,BUFFER,COLOUR
  1113.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  1114.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  1115.         INTEGER NXCHAR,NYCHAR,NXLINE
  1116.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  1117.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  1118.      *  COLOUR,NBUFF,GFORM(7)
  1119. C
  1120.         SX=(RXI-XMIN)/SCALE(1)+SXLEFT
  1121.         RETURN
  1122.         END
  1123. C
  1124. C-----------------------------------------------------------------------
  1125. C
  1126.         FUNCTION RX(SXI)
  1127. C
  1128. C       THIS FUNCTION DOES A LINEAR CONVERSION BETWEEN THE REAL WORLD 
  1129. C       AND SCREEN X COORDINATES
  1130. C
  1131. C       INPUTS:
  1132. C               SXI     REAL    SCREEN X COORDINATE
  1133. C       OUTPUTS:
  1134. C               RX      REAL    REAL WORLD X COORDINATE
  1135. C
  1136.         REAL SXI
  1137. C
  1138. C
  1139.         BYTE GFORM,BUFFER,COLOUR
  1140.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  1141.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  1142.         INTEGER NXCHAR,NYCHAR,NXLINE
  1143.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  1144.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  1145.      *  COLOUR,NBUFF,GFORM(7)
  1146. C
  1147.         RX=SCALE(1)*(SXI-SXLEFT)+XMIN
  1148.         RETURN
  1149.         END
  1150. C
  1151. C-----------------------------------------------------------------------
  1152. C
  1153.         FUNCTION RY(SYI)
  1154. C
  1155. C       THIS FUNCTION DOES A LINEAR CONVERSION BETWEEN THE REAL WORLD 
  1156. C       AND SCREEN Y COORDINATES
  1157. C
  1158. C       INPUTS:
  1159. C               SYI     REAL    SCREEN Y COORDINATE
  1160. C       OUTPUTS:
  1161. C               RY      REAL    REAL WORLD Y COORDINATE
  1162. C
  1163.         REAL SYI
  1164. C
  1165. C
  1166.         BYTE GFORM,BUFFER,COLOUR
  1167.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  1168.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  1169.         INTEGER NXCHAR,NYCHAR,NXLINE
  1170.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  1171.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  1172.      *  COLOUR,NBUFF,GFORM(7)
  1173. C
  1174.         RY=SCALE(1)*(SYI-SYBOT)+YMIN
  1175.         RETURN
  1176.         END
  1177. C
  1178. C-----------------------------------------------------------------------
  1179. C
  1180.         SUBROUTINE RWINDO(XMINI,XMAXI,YMINI,YMAXI)
  1181. C
  1182. C       INPUTS:
  1183. C               XMINI   REAL    VALUE AT LEFT EDGE OF WINDOW (USER UNITS)
  1184. C               XMAXI   REAL    VALUE AT RIGHT EDGE OF WINDOW(USER UNITS)
  1185. C               YMINI   REAL    VALUE AT BOTTOM EDGE (USER UNITS)
  1186. C               YMAXI   REAL    VALUE AT TOP EDGE OF WINDOW (USER UNITS)
  1187. C       OUTPUTS:
  1188. C               NONE RETURNED
  1189. C
  1190.         REAL XMINI,XMAXI,YMINI,YMAXI
  1191. C
  1192.         BYTE GFORM,BUFFER,COLOUR
  1193.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  1194.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  1195.         INTEGER NXCHAR,NYCHAR,NXLINE
  1196.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  1197.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  1198.      *  COLOUR,NBUFF,GFORM(7)
  1199. C
  1200.         XMIN=XMINI
  1201.         XMAX=XMAXI
  1202.         YMIN=YMINI
  1203.         YMAX=YMAXI
  1204. C
  1205.         CALL SWINDO(SXLEFT,SXRT,SYBOT,SYTOP)
  1206.         RETURN
  1207.         END
  1208. C
  1209. C-----------------------------------------------------------------------
  1210. C
  1211.         SUBROUTINE SWINDO(SXLTI,SXRTI,SYBOTI,SYTOPI)
  1212. C
  1213. C       THIS SUBROUTINE SETS THE SCREEN WINDOW FOR GRIDS AND OTHER PLOTS
  1214. C
  1215. C       INPUTS:
  1216. C               SXLTI   REAL    LEFT EDGE OF SCREEN AREA (SCREEN UNITS)
  1217. C               SXRTI   REAL    RIGHT EDGE OF SCREEN AREA (SCREEN UNITS)
  1218. C               SYBOTI  REAL    BOTTOM EDGE OF SCREEN AREA (SCREEN UNITS)
  1219. C               SYTOPI  REAL    TOP EDGE OF SCREEN AREA (SCREEN UNITS)
  1220. C       OUTPUTS:
  1221. C               NONE RETURNED
  1222. C
  1223.         REAL SXLTI,SXRTI,SYBOTI,SYTOPI
  1224. C
  1225.         BYTE GFORM,BUFFER,COLOUR
  1226.         REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE,
  1227.      *  CHXSZ,CHYSZ,CHROT,XPOS,YPOS
  1228.         INTEGER NXCHAR,NYCHAR,NXLINE
  1229.         COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,
  1230.      *  SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS,
  1231.      *  COLOUR,NBUFF,GFORM(7)
  1232. C
  1233.         SXLEFT=SXLTI
  1234.         SXRT=SXRTI
  1235.         SYBOT=SYBOTI
  1236.         SYTOP=SYTOPI
  1237. C
  1238.         T=SXRT-SXLEFT
  1239.         IF (T.LT.1.E-4) GO TO 1
  1240.         T=(XMAX-XMIN)/T
  1241.         IF (T.EQ.0 ) GO TO 3
  1242.         SCALE(1)=T
  1243.         T=SYTOP-SYBOT
  1244.         IF (T.LT.1.E-4) GO TO 1
  1245.         T=(YMAX-YMIN)/T
  1246.         IF (T.EQ.0) GO TO 3
  1247.         SCALE(2)=T
  1248.         RETURN
  1249. 1       WRITE(3,2) T
  1250. 2       FORMAT(' SCREEN WINDOW TOO SMALL. SIZE=',G10.3,
  1251.      *  ' SCALE VALUES NOT CALCULATED')
  1252.         RETURN
  1253. 3       WRITE(3,4)
  1254. 4       FORMAT(' REAL WINDOW HAS 0 SIZE. SCALE VALUES NOT CALCULATED')
  1255.         RETURN
  1256.         END
  1257. C
  1258. C-----------------------------------------------------------------------
  1259. C
  1260.         SUBROUTINE CONCAT(STRNG1,N1,STRNG2,N2,STRNG3,N3)
  1261. C
  1262. C       THIS SUBROUTINE CONCATENATES TWO STRINGS, STRNG1 AND STRNG2, 
  1263. C       AND STORES THEM IN STRNG3. THE SAME NAME MAY BE SUBSTITUTED FOR
  1264. C       ANY OF THE STRINGS IN THE CALLING ARGUMENTS
  1265. C
  1266. C       INPUTS:
  1267. C               STRNG1  BYTE ARRAY      BASE STRING
  1268. C               N1      INTEGER         NUMBER OF CHARACTERS IN STRNG1
  1269. C               STRNG2  BYTE ARRAY      STRING TO BE ADDED AT THE END OF
  1270. C                                       STRNG 1
  1271. C               N2      INTEGER         NUMBER OF CHARACTERS IN STRNG 2
  1272. C       OUTPUTS:
  1273. C               STRNG3  BYTE ARRAY      STRING THAT WILL CONTAIN 1+2
  1274. C               N3      INTEGER         NUMBER OF CHARACTERS IN STRNG 3
  1275. C
  1276.         BYTE STRNG1(1),STRNG2(2),STRNG3(I)
  1277.         INTEGER N1,N2,N3
  1278. C
  1279.         IF (N2.LE.0) GO TO 2
  1280.         N=N1+N2
  1281.         K=N2-1
  1282.         DO 1 I=0,K
  1283.         J3=N-I
  1284.         J2=N2-I
  1285. 1       STRNG3(J3)=STRNG2(J2)
  1286. C
  1287. 2       IF (N1.LE.0) GO TO 4
  1288.         DO 3 I=1,N1
  1289. 3       STRNG3(I)=STRNG1(I)
  1290. C
  1291. 4       IF((N1.GT.0).AND.(N2.GT.0)) N3=N1+N2
  1292.         IF((N2.LE.0).OR.(N1.LE.0)) N3=MAX0(N1,N2,0)
  1293.         RETURN
  1294.         END
  1295.