C C----------------------------------------------------------------------- C SUBROUTINE XYPROJ(XPROJ,YPROJ,X,Y,Z,Z0) C C THIS SUBROUTINE PERFORMS EITHER A PERSPECTIVE OR ORTHOGRAPHIC C PROJECTION OF THE POINT X,Y,Z TO THE IMAGE COORD'S XPROJ,YPROJ. C C INPUTS: C X,Y,Z REAL COORDINATES OF POINT C Z0 REAL DISTANCE FROM THE VIEWPOINT TO ORIGIN C NOTE: Z0=0 FOR ORTHOGRAPHIC PROJECTION C OUTPUTS: C XPROJ REAL HORIZONTAL COORDINATE FOR PROJECTED PT C YPROJ REAL VERTICAL COORDINATE FOR PROJECTED PT C C NOTE: INPUT COORDINATES ARE ALIGNED SO THAT THE X AXIS POINTS C TO THE RIGHT, AND THE Z AXIS IS UPRIGHT. THE VIEW IS THUS IN THE C DIRECTION OF THE INPUT Y AXIS. C THE OUTPUT COORDINATES ARE ALIGNED SO THAT THE X AXIS C POINTS TO THE RIGHT AND THE Y AXIS IS UPRIGHT. THUS, THE Z AXIS C POINTS AWAY ALONG THE VIEWER'S LINE OF SIGHT AND IS NOT SHOWN. C REAL XPROJ,YPROJ,X,Y,Z,Z0,CONST C CONST=1. IF (ABS(Z0).GT. 1.E-36) CONST=1.-Y/Z0 C XPROJ=X/CONST YPROJ=Z/CONST C RETURN END C C----------------------------------------------------------------------- C SUBROUTINE XYZRST(XRST,YRST,ZRST,X,Y,Z,ALPHA,BETA,GAMMA,SX,SY,SZ, * ,XT,YT,ZT,NEWMAT) C C THIS SUBROUTINE WILL ROTATE, SCALE, AND TRANSFORM A SET OF XYZ C COORDINATES. C C INPUTS: C X,Y,Z REAL INPUT COORDINATES C ALPHA REAL ROTATION ANGLE ABOUT Z AXIS C BETA REAL ROTATION ANGLE ABOUT Y AXIS C GAMMA REAL ROTATION ANGLE ABOUT X AXIS C SX,SY,SZ REAL SCALING FACTORS FOR EACH AXIS C XT,YT,ZT REAL TRANSLATION ALONG EACH AXIS C NEWMAT LOGICAL .TRUE. WILL RESULT IN COMPUTING MATRIX C OUTPUTS: C XRST REAL RSTECTED VALUE FOR X AXIS C YRST REAL RSTECTED VALUE FOR Y AXIS C REAL X,Y,Z,ALPHA,BETA,GAMMA,SX,SY,SZ,XT,YT,ZT,XRST,YRST,ZRST LOGICAL*1 NEWMAT C REAL MATRIX(4,3),ZRST C DATA MATRIX/1.,0.,0.,0.,0.,1.,0.,0.,0.,0.,1.,0./ C C FORM MATRIX C IF (.NOT.NEWMAT) GO TO 100 C USE COSINE TERMS AS TEMPORARY STORAGE FOR RADIAN MEASURE ANGLES C COSA=ALPHA/57.2958 COSB=BETA/57.2958 COSG=GAMMA/57.2958 C SINA=SIN(COSA) COSA=COS(COSA) SINB=SIN(COSB) COSB=COS(COSB) SING=SIN(COSG) COSG=COS(COSG) C MATRIX(1,1)=COSA*COSB*SX MATRIX(1,2)=SINA*COSB*SY MATRIX(1,3)=-SINB*SZ C MATRIX(2,1)=(COSA*SINB*SING-SINA*COSG)*SX MATRIX(2,2)=(COSA*COSG+SINA*SINB*SING)*SY MATRIX(2,3)=COSB*SING*SZ C MATRIX(3,1)=(SINA*SING+COSA*SINB*COSG)*SX MATRIX(3,2)=(SINA*SINB*COSG-COSA*SING)*SY MATRIX(3,3)=COSB*COSG*SZ C MATRIX(4,1)=XT MATRIX(4,2)=YT MATRIX(4,3)=ZT C C CALCULATE ROTATED, SCALED, TRANSLATED VALUES C 100 XRST=MATRIX(1,1)*X+MATRIX(2,1)*Y+MATRIX(3,1)*Z+MATRIX(4,1) YRST=MATRIX(1,2)*X+MATRIX(2,2)*Y+MATRIX(3,2)*Z+MATRIX(4,2) ZRST=MATRIX(1,3)*X+MATRIX(2,3)*Y+MATRIX(3,3)*Z+MATRIX(4,3) C RETURN END C C----------------------------------------------------------------------- C SUBROUTINE GRAPH(XMINI,XMAXI,NX,YMINI,YMAXI,NY,SXL,SXR,SYB,SYT) C C THIS SUBROUTINE PLOTS AND LABELS A GRAPH AND ESTABLISHES SCALE C FACTORS FOR FUTURE USE. C C INPUTS: C XMINI REAL MINIMUM VALUE FOR X AXIS C XMAXI REAL MAXIMUM VALUE FOR X AXIS C NX INTEGER APPROXIMATE NUMBER OF DIVISIONS ON AXIS C YMINI REAL MINIMUM VALUE FOR Y AXIS C YMAXI REAL MAXIMUM VALUE FOR Y AXIS C NY INTEGER APPROXIMATE NUMBER OF DIVISIONS ON YAXIS C SXL,SXR REAL SCREEN LEFT AND RIGHT X COORDINATES C SYB,SYT REAL SCREEN BOTTOM AND TOP Y COORDINATES C OUTPUTS: C NONE RETURNED C REAL XMINI,XMAXI,YMINI,YMAXI,SXL,SXR,SYB,SYT INTEGER NX,NY C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C C C SET SCALE FACTORS C XMIN=XMINI XMAX=XMAXI YMIN=YMINI YMAX=YMAXI CALL SWINDO(SXL,SXR,SYB,SYT) C C DRAW AXES C CALL DXDY(XMIN,XMAX,NX,DX,LBLNUM,LBLDEC) CALL AXIS(XMIN,XMAX,DX,SXL,SYB,SXR,SYB,CHYSZ/2.,270.,LBLNUM, * LBLDEC,0.) CALL DXDY(YMIN,YMAX,NY,DY,LBLNUM,LBLDEC) CALL AXIS(YMIN,YMAX,DY,SXL,SYB,SXL,SYT,CHXSZ/2.,180.,LBLNUM, * LBLDEC,90.) C C DO VERTICAL DOTTED LINES C CALL TICEND(XMIN,XMAX,DX,TIC,TICND) DXYDOT=DY/10. IF (TIC.EQ.XMIN) TIC=TIC+DX 1 IF ((DX.GE.0.0) .AND. (TIC.GT.TICND)) GO TO 3 IF ((DX.LT.0.0) .AND. (TIC.LT.TICND)) GO TO 3 XDOT=SX(TIC) TIC=TIC+DX XYDOT=YMIN+DXYDOT 2 IF ((DXYDOT.GE.0.0) .AND. (XYDOT.GT.YMAX)) GO TO 1 IF ((DXYDOT.LT.0.0) .AND. (XYDOT.LT.YMAX)) GO TO 1 YDOT=SY(XYDOT) XYDOT=XYDOT+DXYDOT CALL POINT(XDOT,YDOT) GO TO 2 C C DO HORIZONTAL DOTTED LINES C 3 CALL TICEND(YMIN,YMAX,DY,TIC,TICND) DXYDOT=DX/10. IF (TIC.EQ.YMIN) TIC=TIC+DY 4 IF((DY.GE.0.0) .AND. (TIC.GT.TICND)) RETURN IF((DY.LT.0.0) .AND. (TIC.LT.TICND)) RETURN YDOT=SY(TIC) TIC=TIC+DY XYDOT=XMIN+DXYDOT 5 IF((DXYDOT.GE.0.0) .AND. (XYDOT.GT.XMAX)) GO TO 4 IF ((DXYDOT.LT.0.0) .AND. (XYDOT.LT.XMAX)) GO TO 4 XDOT=SX(XYDOT) XYDOT=XYDOT+DXYDOT CALL POINT (XDOT,YDOT) GO TO 5 END C C----------------------------------------------------------------------- C SUBROUTINE AXIS(R1,R2,DRI,SX1,SY1,SX2,SY2,TICLEN,TICANG, * LBLNUM,LBLDEC,LBLANG) C C THIS SUBROUTINE PLOTS AND LABELS A LINEAR GRAPH AXIS C C INPUTS: C R1 REAL REAL WORLD VALUE AT START OF AXIS C R2 REAL REAL WORLD VALUE AT END OF AXIS C SX1,SY1 REAL SCREEN COORDINATES OF START OF AXIS C SX2,SY2 REAL SCREEN COORD. OF END OF AXIS (0.=>1.) C TICLEN REAL LENGTH OF TIC MARKS (SCREEN UNITS 0=>1.) C TICANG REAL ANGLE BETWEEN HORIZONTAL AND TIC MARKS C LBLNUM INTEGER TOTAL NUMBERS OF CHARACTERS IN LABELS C LBLDEC INTEGER NUMBER OF DIGITS RIGHT OF DECIMAL PLACE C LABELS ARE (F LBLNUM . LBLDEC ) FORMAT C LBLANG REAL ANGLE BETWEEN HORIZONTAL AND LABELS C OUTPUTS: C NONE RETURNED C REAL R1,R2,DRI,SX1,SY1,SX2,SY2,TICLEN,TICANG,LBLANG INTEGER LBLNUM,LBLDEC BYTE LBLFMT(9),LABEL(20) REAL ANGTIC,ANGLBL,LENTIC,XLEN,YLEN,RLEN,DR,RTIC,REND REAL XTIC,YTIC,ANGTST,XLABEL,YLABEL,T,RADIAN C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C DATA RADIAN/57.2958/ IF (DRI.EQ.0.0) GO TO 997 C C CORRECT INPUT VALUES, CALCULATE CONSTANT TERMS C ANGTIC=TICANG IF (TICLEN.LT.0.0) ANGTIC=(-ANGTIC) ANGTIC=POSANG(ANGTIC) ANGLBL=POSANG(LBLANG) LENTIC=ABS(TICLEN) XLEN=SX2-SX1 YLEN=SY2-SY1 RLEN=R2-R1 IF (RLEN.EQ.0.0) GO TO 997 DR=SIGN(DRI,RLEN) CALL TICEND(R1,R2,DR,RTIC,REND) ANGTST=ANGTIC-ANGLBL ANGTST=POSANG(ANGTST) ANGTIC=ANGTIC/RADIAN ANGLBL=ANGLBL/RADIAN XTIC=LENTIC*COS(ANGTIC) YTIC=LENTIC*SIN(ANGTIC) SCALE(3)=COS(ANGLBL) SCALE(4)=SIN(ANGLBL) C C CALCULATE OFFSETS FOR LABLES C IF (ANGTST.LT.45) GO TO 100 IF (ANGTST.LT.135) GO TO 200 IF (ANGTST.LT.225) GO TO 300 IF (ANGTST.LT.315) GO TO 400 C C CASE 1: TIC IS TO THE "LEFT" OF LABEL 100 XLABEL=(CHXSZ*SCALE(3)+CHYSZ*SCALE(4))/2. YLABEL=(CHYSZ*SCALE(3)-CHXSZ*SCALE(4))/2. GO TO 500 C C CASE 2: TIC IS "BELOW" LABEL 200 T=FLOAT(LBLNUM)*CHXSZ XLABEL=(-T*SCALE(3)-CHYSZ*SCALE(4))/2. YLABEL=(-T*SCALE(4)+CHYSZ*SCALE(3))/2. GO TO 500 C C CASE 3: TIC IS TO THE "RIGHT" OF LABEL 300 T=(FLOAT(LBLNUM)+.5)*CHXSZ XLABEL=SCALE(4)*CHYSZ/2.-T*SCALE(3) YLABEL=-SCALE(3)*CHYSZ/2.-T*SCALE(4) GO TO 500 C C CASE 4: TIC IS "ABOVE" LABEL 400 T=FLOAT(LBLNUM)*CHXSZ/2. XLABEL=-T*SCALE(3)-CHYSZ*SCALE(4)*1.5 YLABEL=-T*SCALE(4)-CHYSZ*SCALE(3)*1.5 C C FORM LABEL FORMAT Bn B B B B B B B B B B B B B B B B B B B B B BB O C 500 ENCODE (LBLFMT,501) LBLNUM,LBLDEC 501 FORMAT('(F',I3,'.',I2,')') C C DRAW AXIS C CALL SEGMNT(SX1,SY1,SX2,SY2) 600 IF ((DR.LT.0.0) .AND. (RTIC.LT.REND)) GO TO 999 IF ((DR.GT.0.0) .AND. (RTIC.GT.REND)) GO TO 999 DTIC=(RTIC-R1)/RLEN X=XLEN*DTIC+SX1 Y=YLEN*DTIC+SY1 CALL MOVE(X,Y) X=X+XTIC Y=Y+YTIC CALL VECTOR(X,Y) X=X+XLABEL Y=Y+YLABEL ENCODE (LABEL,LBLFMT) RTIC CALL GWRITE(X,Y,LABEL,LBLNUM) RTIC=RTIC+DR GO TO 600 C C ERROR MESSAGE C 997 WRITE(3,998) 998 FORMAT('0ZERO VALUE FOR REAL LENGTH OR INCREMENT') 999 T=CHROT/RADIAN SCALE(3)=COS(T) SCALE(4)=SIN(T) RETURN END C C----------------------------------------------------------------------- C SUBROUTINE TICEND(RMIN,RMAX,DR,R1,R2) C C THIS SUBROUTINE CALCULATES ENDPOINTS WHICH ARE MULTIPLES OF DR C AND LIE BETWEEN RMIN AND RMAX. C C INPUTS: C RMIN REAL STARTING VALUE FOR RANGE C RMAX REAL ENDING VALUE FOR RANGE C DR REAL INCREMENT BETWEEN INTERVALS IN RANGE C OUTPUTS: C R1 REAL STARTING VALUE FOR TIC MARKS C R2 REAL ENDING VALUE FOR TIC MARKS C REAL RMIN,RMAX,DR,R1,R2 C R1=FLOAT( INT( RMIN/DR ))*DR R2=FLOAT( INT( RMAX/DR ))*DR IF(R1.LT.0.0 .OR. R2.LT.0.0) GO TO 2 IF(DR.GT.0.0 .AND. R1.LT.RMIN) R1=R1+DR IF(DR.LT.0.0 .AND. R2.LT.RMAX) R2=R2-DR 2 IF(R1.GT.0.0 .OR. R2.GT.0.0) GO TO 100 IF(DR.LT.0.0 .AND. R1.GT.RMIN) R1=R1+DR IF(DR.GT.0.0 .AND. R2.GT.RMAX) R2=R2-DR 100 CONTINUE RETURN END C C----------------------------------------------------------------------- C SUBROUTINE DXDY(X1,X2,NX,DX,LBLNUM,LBLDEC) C C THIS FUNCTION CALCULATES A GOOD ENGINEERING VALUE FOR THE C INCREMENT BETWEEN TIC MARKS ON AN AXIS C C INPUTS: C X1 REAL MINIMUM VALUE ASSOCIATED WITH AXIS C X2 REAL MAXIMUM VALUE ASSOCIATED WITH AXIS C NX INTEGER APPROXIMATE NUMBER OF INTERVALS C OUTPUTS: C DX REAL INCREMENT BETWEEN TIC MARKS C LBLNUM INTEGER NUMBER OF CHARACTERS IN AXIS LABELS C LBLDEC INTEGER NUMBER OF DIGITS RIGHT OF DECIMAL PLACE C INTEGER NX,DXEXP,LBLNUM,LBLDEC REAL X1,X2 C XLEN=X2-X1 IF (XLEN.EQ.0.0) GO TO 998 DX=ABS(XLEN/FLOAT(NX)) DXLOG=ALOG10(DX) DXEXP=INT(DXLOG) DXMANT=DXLOG-FLOAT(DXEXP) IF (DXMANT.GT. 0.0) GO TO 2 DXEXP=DXEXP-1 DXMANT=DXMANT+1. 2 CONTINUE DX=1. IF (DXMANT.GT.0.18) DX=2. IF (DXMANT.GT.0.48) DX=5. IF (DXMANT.GT.0.9) DX=10. DX=DX*10.**DXEXP DX=SIGN(DX,XLEN) C DXLOG=AMAX1(ABS(XLEN),DXLOG) IF (X1.NE. 0.0) DXLOG=ABS(X1) IF (X2.NE. 0.0) DXLOG=AMAX1(DXLOG,ABS(X2)) DXLOG=ALOG10(DXLOG) LBLNUM=INT(DXLOG) IF (LBLNUM.LT.0) LBLNUM=0 DXLOG=ABS(XLEN) IF (X1.NE. 0.0) DXLOG=AMIN1(DXLOG,ABS(X1)) IF (X2.NE. 0.0) DXLOG=AMIN1(DXLOG,ABS(X2)) DXLOG=AMIN1(DXLOG,ABS(XLEN)) IF (DX.NE.0.0) DXLOG=AMIN1(DXLOG,ABS(DX)) DXLOG=ALOG10(DXLOG) IF (DXLOG.LT. 0.0) DXLOG=DXLOG-1. DXEXP=INT(DXLOG) LBLDEC=IABS(MIN0(LBLNUM,DXEXP,0)) LBLNUM=IABS(LBLNUM)+LBLDEC+3 RETURN 998 WRITE(3,999) 999 FORMAT('0ZERO LENGTH AXIS IN DXDY. VALUE NOT SET') RETURN END C C----------------------------------------------------------------------- C FUNCTION POSANG(ANGLE) C C THIS FUNCTION RETURNS AN ANGLE THAT IS THE SAME AS ANGLE, BUT IN C THE RANGE 0.0 TO 360. C C INPUTS: C ANGLE REAL ANGLE TO BE CONVERTED C OUTPUTS: C POSANG REAL CONVERTED ANGLE C REAL ANGLE POSANG=ANGLE IF (POSANG.GE.0.0 .AND. POSANG.LT.360.) RETURN POSANG=AMOD(ANGLE,360.) IF (POSANG.LT.0.0) POSANG=POSANG+360. RETURN END C C----------------------------------------------------------------------- C SUBROUTINE GWRITE(X,Y,STRING,N) C C THIS SUBROUTINE PLOTS A STRING OF GRAPHICAL CHARACTERS C C INPUTS: C X,Y REAL COORDINATES FOR FIRST CHARACTER C STRING BYTE ARRAY STRING TO BE PLOTTED C N INTEGER NUMBER OF CHARACTERS IN STRING C OUTPUTS: C NONE RETURNED C INTEGER N BYTE STRING(N) REAL X,Y C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C XC=X YC=Y DO 1 I=1,N CALL GCHAR(XC,YC,STRING(I)) XC=XC+CHXSZ*SCALE(3) YC=YC+CHXSZ*SCALE(4) 1 CONTINUE RETURN END C C----------------------------------------------------------------------- C SUBROUTINE GCHAR(CX,CY,CHAR) C C THIS SUBROUTINE PLOTS A CHARACTER AT X,Y. SIZE AND ROTATION ARE C TAKEN FROM COMMON C C INPUTS: C CHAR BYTE ASCII CHARACTER TO BE PLOTTED C CX,CY REAL COORDINATES OF CHARACTER C C OUTPUTS: C NONE RETURNED TO CALLING PROGRAM C BYTE SCHAR,CMD,IX,IY,CHAR INTEGER ICHAR, IX2,IY2 BYTE TCHAR REAL CX,CY,X,Y C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C COMMON /GTABLE/ICHAR(95),TCHAR(721) C EQUIVALENCE (IX,IX2),(IY,IY2) C SCHAR=CHAR.AND.127 IF (SCHAR.LT.32) RETURN I=SCHAR-31 I=ICHAR(I) C C WRITE(3,100) SCHAR,TCHAR(I),I C100 FORMAT('0IN GCHAR. CHARACTER IS:',I4,/, C * ' FIRST TABLE COMMAND IS:',I4,' (#',I4,')') 1 CMD=TCHAR(I) IF (CMD.EQ.-1) RETURN IX2=0 IY2=0 IY=CMD.AND.15 IX=CMD.AND.112 IX=IX/16 X=FLOAT(IX)*CHXSZ/7. Y=FLOAT(IY)*CHYSZ/9. C WRITE(3,101) X,Y,IX2,IY2,CX,CY C101 FORMAT(' X STROKE=',G12.5,' Y=',G12.5, C * /,' IX DECODED=',I5,' IY=',I5,/, C * ' REFERENCE COORD=',2G12.5) T=X X=CX+SCALE(3)*X-SCALE(4)*Y Y=CY+SCALE(4)*T+SCALE(3)*Y IF (CMD) 3,2,2 2 CALL MOVE(X,Y) C WRITE(3,102) X,Y C102 FORMAT(' MOVING TO ',G12.5,', ',G12.5) GO TO 4 3 CALL VECTOR(X,Y) C WRITE(3,103) X,Y C103 FORMAT(' DRAWING TO ',G12.5,', ',G12.5) 4 I=I+1 GO TO 1 END C C----------------------------------------------------------------------- C SUBROUTINE CHSET(XSIZE,YSIZE,THETA) C C THIS SUBROUTINE SETS THE CHARACTER ATTRIBUTES C C INPUTS: C XSIZE REAL WIDTH OF CHARACTER SPACE C YSIZE REAL HEIGHT OF CHARACTER SPACE C THETA REAL ROTATION OF CHARACTERS C OUTPUTS: C NONE RETURNED C REAL XSIZE,YSIZE,THETA C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C CHXSZ=XSIZE CHYSZ=YSIZE CHROT=THETA T=THETA/57.295 SCALE(3)=COS(T) SCALE(4)=SIN(T) RETURN END C C----------------------------------------------------------------------- C SUBROUTINE GRINIT(NAME) C C THIS SUBROUTINE OPENS THE GRAPHIC OUTPUT FILE AND INITIALIZES C GRAPHICAL VARIABLES C C INPUTS: C NAME BYTE ARRAY CONTAINS FILE NAME C C OUTPUTS: C NONE RETURNED C EXTERNAL CHRTBL BYTE NAME(11) C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C DATA COLOUR,GFORM/127,'(','1','2','8','A','1',')'/ DATA BUFFER(1),BUFFER(2),BUFFER(3),BUFFER(4),BUFFER(5),NBUFF * /'C',0,'E','C',127,5/ DATA XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP * /0.,1.,0.,1.,0.,1.,0.,1./ DATA CHXSZ,CHYSZ,CHROT /.0125,.02,0./ DATA XPOS,YPOS /0.,0./ DATA SCALE/1.,1.,1.,0./ C C100 FORMAT(' IN GRINIT. GFORM=',7A1,' NAME=',16A1) C WRITE(3,100) GFORM,NAME IF(NAME(9).NE.32) GO TO 1 C C NO EXTENSION GIVEN- ADD .VEC C NAME(9)='V' NAME(10)='E' NAME(11)='C' C 1 CALL OPEN(10,NAME,0) C RETURN END C C----------------------------------------------------------------------- C BLOCK DATA CHRTBL BYTE TCHAR INTEGER ICHAR COMMON /GTABLE/ ICHAR( 95),TCHAR( 721) DATA TCHAR / * -1, 56, -75, 51, -78, -1, 40, -90, 72, -58, -1, 40, * -94, 72, -62, 6, -26, 4, -28, -1, 56, -78, 87,-105, * -122,-107, -43, -28, -45,-109, -1, 104,-126, 8, -88, -90, * -122,-120, 68, -28, -30, -62, -60, -1, 98,-105, -88, -72, * -57, -58,-108,-109, -94, -78, -44, -1, 6,-105,-104,-120, * -121,-105, -1, 72, -74, -76, -62, -1, 40, -74, -76, -94, * -1, 21, -43, 39, -61, 71, -93, -1, 55, -77, 21, -43, * -1, 17, -94, -93,-109,-110, -94, -1, 21, -43, -1, 34, * -93,-109,-110, -94, -1, 88,-110, -1, 40, -56, -42, -44, * -62, -94,-108,-106, -88, -1, 38, -72, -78, 34, -62, -1, * 23, -88, -56, -41, -42,-109,-110, -46, -1, 23, -88, -56, * -41, -42, -59, -44, -45, -62, -94,-109, -1, 72, -62, 55, * -108, -44, -1, 88,-104,-106, -58, -43, -45, -62, -94,-109, * -1, 87, -56, -88,-105,-109, -94, -62, -45, -44, -59, -91, * -108, -1, 24, -40, -94, -1, 37, -59, -44, -45, -62, -94, * -109,-108, -91,-106,-105, -88, -56, -41, -42, -59, -1, 19, * -94, -62, -45, -41, -56, -88,-105,-106, -91, -59, -42, -1, * 23, -89, -90,-106,-105, 20, -92, -93,-109,-108, -1, 17, * -94, -93,-109,-110, -94, 22, -90, -91,-107,-106, -1, 87, * -107, -45, -1, 22, -42, 20, -44, -1, 23, -43,-109, -1, * 23, -88, -56, -41, -42, -76, 50, -79, -1, 23, -88, -56, * -41, -45, -62, -94,-109,-108, -91, -75, -78, -1, 2, -72, * -30, 20, -44, -1, 5, -59, -44, -45, -62,-126,-120, -56, * -41, -42, -59, -1, 87, -56,-104,-121,-125,-110, -62, -45, * -1, 2,-120, -56, -42, -44, -62,-126, -1, 88,-120,-126, * -46, 53,-123, -1, 88,-120,-126, 53,-123, -1, 87, -56, * -104,-121,-125,-110, -62, -45, -43, -75, -1, 2,-120, 88, * -46, 85,-123, -1, 40, -56, 56, -78, 34, -62, -1, 20, * -109, -94, -78, -61, -56, 56, -40, -1, 8,-126, 88,-123, * -46, -1, 24,-110, -46, -1, 2,-120, -75, -24, -30, -1, * 2,-120, -30, -24, -1, 7,-104, -40, -25, -29, -46,-110, * -125,-121, -1, 2,-120, -56, -41, -42, -59,-123, -1, 7, * -104, -40, -25, -28, -62,-110,-125,-121, 68, -30, -1, 2, * -120, -56, -41, -42, -59,-123, 53, -46, -1, 87, -56,-104, * -121,-122,-107, -59, -44, -45, -62,-110,-125, -1, 8, -24, * 56, -78, -1, 24,-109, -94, -62, -45, -40, -1, 8, -78, * -24, -1, 8,-110, -75, -46, -24, -1, 8, -30, 104,-126, * -1, 24, -76, -78, 88, -76, -1, 8, -24,-126, -30, -1, * 88, -72, -78, -46, -1, 24, -46, -1, 24, -72, -78,-110, * -1, 22, -72, -42, -1, 0, -32, -1, 102, -41, -40, -24, * -25, -41, -1, 5,-106, -74, -59, -61, -78,-110,-125,-108, * -60, 67, -46, -1, 24,-110, -62, -45, -44, -59,-107, -1, * 85, -91,-108,-109, -94, -46, -1, 88, -46, -94,-109,-108, * -91, -43, -1, 82, -94,-109,-108, -91, -59, -44,-108, -1, * 87, -56, -72, -89, -94, 21, -59, -1, 17, -96, -80, -63, * -59, -91,-108,-109, -94, -62, -1, 18,-104, 21, -75, -60, * -62, -1, 50, -75, 55, -72, -1, 18,-111, -96, -80, -63, * -59, 71, -56, -1, 24,-110, 20, -57, 37, -46, -1, 40, * -72, -78, 34, -62, -1, 2,-123, 4,-107, -91, -76, -78, * 52, -59, -43, -28, -30, -1, 18,-107, 20, -91, -59, -44, * -46, -1, 20, -91, -59, -44, -45, -62, -94,-109,-108, -1, * 16,-107, -59, -44, -45, -62,-110, -1, 80, -43, -91,-108, * -109, -94, -46, -1, 18,-107, 20, -91, -75, -60, -1, 19, * -94, -62, -45, -60, -92,-107, -90, -58, -43, -1, 40, -93, * -78, -62, -45, -44, 22, -74, -1, 21,-109, -94, -62, -45, * -43, 83, -30, -1, 21, -78, -43, -1, 21, -94, -76, -62, * -43, -1, 21, -62, 18, -59, -1, 21, -78, 85, -78, -95, * -112, -1, 21, -43,-110, -46, -1, 72, -72, -89, -90,-107, * -92, -93, -78, -62, -1, 48, -72, -1, 40, -72, -57, -58, * -43, -60, -61, -78, -94, -1, 7,-104, -88, -58, -42, -25, * -1/ DATA ICHAR/ * 1, 2, 7, 12, 21, 32, 45, 57, 64, 69, 74, 81, * 86, 93, 96, 102, 105, 115, 121, 130, 142, 148, 158, 171, * 175, 192, 205, 216, 228, 232, 237, 241, 250, 263, 269, 281, * 290, 298, 305, 311, 322, 329, 336, 345, 351, 355, 361, 366, * 376, 384, 396, 406, 419, 424, 431, 435, 441, 446, 452, 457, * 462, 465, 470, 474, 477, 484, 497, 505, 512, 520, 529, 537, * 548, 555, 560, 569, 576, 582, 595, 603, 613, 621, 629, 636, * 647, 656, 665, 669, 675, 680, 687, 692, 702, 705, 715/ END C C----------------------------------------------------------------------- C SUBROUTINE COLOR(BYTE) C C THIS SUBROUTINE SETS THE COLOR TO BE USED IN PLOTTING C C INPUTS: C BYTE BYTE COLOR TO BE USED C NEG=> COMPLEMENTARY C 0 => WHITE C POS=> BLACK C BYTE BYTE C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C COLOUR=BYTE IF(NBUFF.LT.126) GO TO 3 WRITE(10,GFORM)(BUFFER(I),I=1,NBUFF) NBUFF=0 3 NBUFF=NBUFF+2 BUFFER(NBUFF-1)=67 BUFFER(NBUFF)=COLOUR RETURN END C C----------------------------------------------------------------------- C SUBROUTINE SEGMNT(X1,Y1,X2,Y2) C C THIS SUBROUTINE DRAWS A LINE SEGMENT FROM (X1,Y1) TO (X2,Y2) C C INPUTS: C X1,Y1 REAL STARTING COORDINATES C X2,Y2 REAL END COORDINATES C OUTPUTS: C NONE RETURNED C INTEGER IRAST REAL X1,Y1,X2,Y2 C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF(NBUFF.LT.119) GO TO 2 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) NBUFF=0 2 NBUFF=NBUFF+1 BUFFER(NBUFF)='D' IRAST=IFIX(X1*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(Y1*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(X2*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(Y2*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) XPOS=X2 YPOS=Y2 RETURN END C C----------------------------------------------------------------------- C SUBROUTINE ERASE C C THIS SUBROUTINE CLEARS THE ENTIRE PLOT TO THE PRESET COLOR C C INPUTS: C NONE C OUTPUTS: C NONE RETURNED C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF (NBUFF.LT.127) GO TO 1 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) NBUFF=0 1 NBUFF=NBUFF+1 BUFFER(NBUFF)=69 RETURN END C C----------------------------------------------------------------------- C SUBROUTINE FILL(X1,Y1,X2,Y2,YF) C C THIS SUBROUTINE FILLS IN A SOLID AREA BETWEEN A LINE SEGMENT AND C A HORIZONTAL LINE C C INPUTS: C X1,Y1 REAL STARTING COORDINATES OF LINE SEGMENT C X2,Y2 REAL END COORDINATES OF LINE SEGMENT C YF REAL HORIZONTAL LEVEL TO WHICH THE FILLED C AREA WILL EXTEND C OUTPUTS: C NONE RETURNED C INTEGER IRAST REAL X1,Y1,X2,Y2,YF C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF (NBUFF.LT.117) GO TO 2 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) NBUFF=0 2 NBUFF=NBUFF+1 BUFFER(NBUFF)='F' IRAST=IFIX(X1*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(Y1*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(X2*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(Y2*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(YF*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) XPOS=X2 YPOS=Y2 RETURN END C C----------------------------------------------------------------------- C SUBROUTINE VECTOR(X,Y) C C THIS SUBROUTINE PLOTS A LINE SEGMENT FROM THE PRESENT POSITION C TO THE GIVEN COORDINATES C C INPUTS: C X,Y REAL COORDINATES OF END OF VECTOR C OUTPUTS: C NONE RETURNED C INTEGER IRAST REAL X,Y C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF (NBUFF.LT.123) GO TO 2 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) NBUFF=0 2 NBUFF=NBUFF+1 BUFFER(NBUFF)='I' IRAST=IFIX(X*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(Y*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) XPOS=X YPOS=Y RETURN END C C----------------------------------------------------------------------- C SUBROUTINE MOVE(X,Y) C C THIS SUBROUTINE MOVES PRESENT COORDINATES TO NEW LOCATION C WITHOUT PLOTTING C C INPUTS: C X,Y REAL NEW POSITION COORDINATES C OUTPUTS: C NONE RETURNED C INTEGER IRAST REAL X,Y C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF (NBUFF.LT.123) GO TO 2 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) NBUFF=0 2 NBUFF=NBUFF+1 BUFFER(NBUFF)='M' IRAST=IFIX(X*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(Y*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) XPOS=X YPOS=Y RETURN END C C----------------------------------------------------------------------- C SUBROUTINE GPRINT C C THIS SUBROUTINE CAUSES THE PICTURE PLOTTED SO FAR TO BE PRINTED C C INPUTS: C NONE C OUTPUTS: C NONE RETURNED C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF (NBUFF.LT.127) GO TO 2 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) NBUFF=0 2 NBUFF=NBUFF+1 BUFFER(NBUFF)=79 RETURN END C C----------------------------------------------------------------------- C SUBROUTINE POINT(X,Y) C C THIS SUBROUTINE PLOTS A SINGLE POINT AT (X,Y) C C INPUTS: C X,Y REAL COORDINATES OF POINT C OUTPUTS: C NONE RETURNED C INTEGER IRAST REAL X,Y C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF (NBUFF.LT.119) GO TO 2 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) NBUFF=0 2 NBUFF=NBUFF+1 BUFFER(NBUFF)='P' IRAST=IFIX(X*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(Y*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) XPOS=X YPOS=Y RETURN END C C----------------------------------------------------------------------- C SUBROUTINE GRFINI C C THIS SUBROUTINE TERMINATES THE PLOT AND CLOSES THE FILE C C INPUTS: C NONE C OUTPUTS: C NONE RETURNED C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF (NBUFF.LT.126) GO TO 2 WRITE (10) (BUFFER(I),I=1,NBUFF) NBUFF=0 2 NBUFF=NBUFF+1 BUFFER(NBUFF)=79 NBUFF=NBUFF+1 BUFFER(NBUFF)=81 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) ENDFILE 10 RETURN END C C----------------------------------------------------------------------- C SUBROUTINE GSTRNG(X,Y,STRING,NCHAR) C C INPUTS: C X,Y REAL STARTING COORDINATES FOR ARRAY C STRING BYTE ARRAY STRING TO BE PRINTED ON MX-80 C NCHAR INTEGER NUMBER OF CHARACTERS IN STRING C OUTPUTS: C NONE RETURNED C REAL X,Y INTEGER NCHAR,IRAST BYTE STRING(NCHAR) C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C IF (NCHAR.LE.0) RETURN IF (NBUFF.LT.117-NCHAR) GO TO 2 WRITE(10,GFORM) (BUFFER(I),I=1,NBUFF) NBUFF=0 2 IF (NCHAR.GT.115) NCHAR=115 NBUFF=NBUFF+1 BUFFER(NBUFF)='S' IRAST=IFIX(X*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) IRAST=IFIX(Y*32767) CALL CONCAT(BUFFER,NBUFF,IRAST,2,BUFFER,NBUFF) CALL CONCAT(BUFFER,NBUFF,STRING,NCHAR,BUFFER,NBUFF) NBUFF=NBUFF+1 BUFFER(NBUFF)=13 NBUFF=NBUFF+1 BUFFER(NBUFF)='N' C100 FORMAT(' IN GSTRNG. INPUT STRING IS:',/,' ',116A1) C101 FORMAT(' DECIMAL DUMP OF BUFFER FOLLOWS NBUFF:',I5) C102 FORMAT(20I4) C WRITE(3,100) (STRING(I),I=1,NCHAR) C WRITE(3,101) NBUFF C WRITE(3,102) BUFFER RETURN END C C----------------------------------------------------------------------- C FUNCTION SY(RYI) C C THIS FUNCTION DOES A LINEAR CONVERSION FROM THE REAL TO THE C SCREEN Y COORDINATE. C C INPUTS: C RYI REAL REAL WORLD Y COORDINATE C OUTPUTS: C SY REAL SCREEN Y COORDINATE C REAL RYI C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C SY=(RYI-YMIN)/SCALE(2)+SYBOT RETURN END C C----------------------------------------------------------------------- C FUNCTION SX(RXI) C C THIS FUNCTION DOES A LINEAR CONVERSION FROM THE REAL TO THE C SCREEN X COORDINATE C C INPUTS: C RXI REAL REAL WORLD COORDINATE C OUTPUTS: C SX REAL SCREEN X COORDINATE C REAL RXI C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C SX=(RXI-XMIN)/SCALE(1)+SXLEFT RETURN END C C----------------------------------------------------------------------- C FUNCTION RX(SXI) C C THIS FUNCTION DOES A LINEAR CONVERSION BETWEEN THE REAL WORLD C AND SCREEN X COORDINATES C C INPUTS: C SXI REAL SCREEN X COORDINATE C OUTPUTS: C RX REAL REAL WORLD X COORDINATE C REAL SXI C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C RX=SCALE(1)*(SXI-SXLEFT)+XMIN RETURN END C C----------------------------------------------------------------------- C FUNCTION RY(SYI) C C THIS FUNCTION DOES A LINEAR CONVERSION BETWEEN THE REAL WORLD C AND SCREEN Y COORDINATES C C INPUTS: C SYI REAL SCREEN Y COORDINATE C OUTPUTS: C RY REAL REAL WORLD Y COORDINATE C REAL SYI C C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C RY=SCALE(1)*(SYI-SYBOT)+YMIN RETURN END C C----------------------------------------------------------------------- C SUBROUTINE RWINDO(XMINI,XMAXI,YMINI,YMAXI) C C INPUTS: C XMINI REAL VALUE AT LEFT EDGE OF WINDOW (USER UNITS) C XMAXI REAL VALUE AT RIGHT EDGE OF WINDOW(USER UNITS) C YMINI REAL VALUE AT BOTTOM EDGE (USER UNITS) C YMAXI REAL VALUE AT TOP EDGE OF WINDOW (USER UNITS) C OUTPUTS: C NONE RETURNED C REAL XMINI,XMAXI,YMINI,YMAXI C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C XMIN=XMINI XMAX=XMAXI YMIN=YMINI YMAX=YMAXI C CALL SWINDO(SXLEFT,SXRT,SYBOT,SYTOP) RETURN END C C----------------------------------------------------------------------- C SUBROUTINE SWINDO(SXLTI,SXRTI,SYBOTI,SYTOPI) C C THIS SUBROUTINE SETS THE SCREEN WINDOW FOR GRIDS AND OTHER PLOTS C C INPUTS: C SXLTI REAL LEFT EDGE OF SCREEN AREA (SCREEN UNITS) C SXRTI REAL RIGHT EDGE OF SCREEN AREA (SCREEN UNITS) C SYBOTI REAL BOTTOM EDGE OF SCREEN AREA (SCREEN UNITS) C SYTOPI REAL TOP EDGE OF SCREEN AREA (SCREEN UNITS) C OUTPUTS: C NONE RETURNED C REAL SXLTI,SXRTI,SYBOTI,SYTOPI C BYTE GFORM,BUFFER,COLOUR REAL XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT,SYTOP,SCALE, * CHXSZ,CHYSZ,CHROT,XPOS,YPOS INTEGER NXCHAR,NYCHAR,NXLINE COMMON/GRAPH/BUFFER(128),XMIN,XMAX,YMIN,YMAX,SXLEFT,SXRT,SYBOT, * SYTOP,SCALE(4),NXCHAR,NYCHAR,NXLINE,CHXSZ,CHYSZ,CHROT,XPOS,YPOS, * COLOUR,NBUFF,GFORM(7) C SXLEFT=SXLTI SXRT=SXRTI SYBOT=SYBOTI SYTOP=SYTOPI C T=SXRT-SXLEFT IF (T.LT.1.E-4) GO TO 1 T=(XMAX-XMIN)/T IF (T.EQ.0 ) GO TO 3 SCALE(1)=T T=SYTOP-SYBOT IF (T.LT.1.E-4) GO TO 1 T=(YMAX-YMIN)/T IF (T.EQ.0) GO TO 3 SCALE(2)=T RETURN 1 WRITE(3,2) T 2 FORMAT(' SCREEN WINDOW TOO SMALL. SIZE=',G10.3, * ' SCALE VALUES NOT CALCULATED') RETURN 3 WRITE(3,4) 4 FORMAT(' REAL WINDOW HAS 0 SIZE. SCALE VALUES NOT CALCULATED') RETURN END C C----------------------------------------------------------------------- C SUBROUTINE CONCAT(STRNG1,N1,STRNG2,N2,STRNG3,N3) C C THIS SUBROUTINE CONCATENATES TWO STRINGS, STRNG1 AND STRNG2, C AND STORES THEM IN STRNG3. THE SAME NAME MAY BE SUBSTITUTED FOR C ANY OF THE STRINGS IN THE CALLING ARGUMENTS C C INPUTS: C STRNG1 BYTE ARRAY BASE STRING C N1 INTEGER NUMBER OF CHARACTERS IN STRNG1 C STRNG2 BYTE ARRAY STRING TO BE ADDED AT THE END OF C STRNG 1 C N2 INTEGER NUMBER OF CHARACTERS IN STRNG 2 C OUTPUTS: C STRNG3 BYTE ARRAY STRING THAT WILL CONTAIN 1+2 C N3 INTEGER NUMBER OF CHARACTERS IN STRNG 3 C BYTE STRNG1(1),STRNG2(2),STRNG3(I) INTEGER N1,N2,N3 C IF (N2.LE.0) GO TO 2 N=N1+N2 K=N2-1 DO 1 I=0,K J3=N-I J2=N2-I 1 STRNG3(J3)=STRNG2(J2) C 2 IF (N1.LE.0) GO TO 4 DO 3 I=1,N1 3 STRNG3(I)=STRNG1(I) C 4 IF((N1.GT.0).AND.(N2.GT.0)) N3=N1+N2 IF((N2.LE.0).OR.(N1.LE.0)) N3=MAX0(N1,N2,0) RETURN END