SUBROUTINE FRAME( XMINF, XMAXF, YMINF, YMAXF ) COMMON /PAGSIZ/ XBOND, YBOND COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR XN = AMAX1 ( 0., XMINF ) XX = AMIN1 ( XBOND, XMAXF ) YN = AMAX1 ( 0., YMINF ) YX = AMIN1 ( YBOND, YMAXF ) IXMINF = SCRX * XN IXMAXF = SCRX * XX IYMINF = SCRY * YN IYMAXF = SCRY * YX IDX = IXMINF - IXORIG IDY = IYMINF - IYORIG IXORIG = IXMINF IYORIG = IYMINF IASCR = IASCR + IDX IBSCR = IBSCR + IDX ICSCR = ICSCR + IDY IDSCR = IDSCR + IDY XCONST = XCONST + IDX YCONST = YCONST + IDY RETURN END SUBROUTINE WINDOW( XWIN0, XWIN1, YWIN0, YWIN1 ) COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW IASCR = SCRX * XWIN0 + IXORIG IBSCR = SCRX * XWIN1 + IXORIG ICSCR = SCRY * YWIN0 + IYORIG IDSCR = SCRY * YWIN1 + IYORIG CALL SCALE( XMINW, XMAXW, YMINW, YMAXW ) RETURN END SUBROUTINE VUPORT( XMIN, XMAX, YMIN, YMAX ) CALL SCALE(XMIN, XMAX, YMIN, YMAX) RETURN END SUBROUTINE SCALE( XMIN, XMAX, YMIN, YMAX ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW XMINW = XMIN XMAXW = XMAX YMINW = YMIN YMAXW = YMAX XSLOPE = (IBSCR - IASCR) / (XMAX - XMIN) YSLOPE = (IDSCR - ICSCR) / (YMAX - YMIN) XCONST = - XSLOPE * XMIN + FLOAT(IASCR) YCONST = - YSLOPE * YMIN + FLOAT(ICSCR) RETURN END SUBROUTINE AXIS( XTIC, YTIC, IXTIT, IXLEN, IXSIZ, IXFMT, 1 IYTIT, IYLEN, IYSIZ, IYFMT ) BYTE IXTIT(IXLEN), IYTIT(IYLEN) COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW CALL DRWREC( XMINW, XMAXW, YMINW, YMAXW, 0 ) CALL XAXIS( XTIC, IXTIT, IXLEN, IXSIZ, IXFMT ) CALL YAXIS( YTIC, IYTIT, IYLEN, IYSIZ, IYFMT ) RETURN END SUBROUTINE YAXIS( YTIC, IYTIT, IYLEN, IYSIZ, IYFMT ) BYTE IYTIT(IYLEN) INTEGER FORM(3) COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /YLABEL/ IXMIN IF(.NOT.( IYSIZ .GE. 1 .AND. IYSIZ .LE. 5 )) GO TO 32758 IYS = IYSIZ GO TO 32759 32758 IYS = 0 32759 IXMIN = IASCR IF(.NOT.( YTIC .NE. 0. )) GO TO 32757 IX = IASCR IS = ICSCR LENTIC = SCRY / 4 IFORM = IFRMT( FORM, IYFMT ) YVAL = YMINW IHGT = ICHH(MAX0(IYS,1)) / 2 IY = IS - IHGT IW = ICHW(MAX0(IYS,1)) YMAX = AMAX1( YMINW, YMAXW ) YMIN = AMIN1( YMINW, YMAXW ) 32756 IF(.NOT.( YVAL .LE. YMAX .AND. YVAL .GE. YMIN )) GO TO 32755 IF(.NOT.( YVAL .EQ. YMINW )) GO TO 32753 CALL LABELY( YVAL, FORM, IFORM, IASCR, IY, IW, IYS ) GO TO 32754 32753 IS = ISCRY( YVAL ) IY = IS - IHGT IF( IDSCR .NE. IS ) CALL DRYTIC( IASCR, IS, LENTIC ) CALL LABELY( YVAL, FORM, IFORM, IASCR, IY, IW, IYS ) 32754 YVAL = YVAL + YTIC GO TO 32756 32755 CONTINUE 32757 IF(.NOT.( IYS .NE. 0 )) GO TO 32752 CALL TRIMSP( IYTIT, IYLEN, IST, IEND ) IYLN = IEND + 1 - IST IX = IXMIN - ICHH(IYS) IYL = IYLN * ICHW(IYS) IY = (ICSCR + IDSCR - IYL) / 2 CALL PLTSTR(IX, IY, IYTIT(IST), IYLN, 4, IYS) 32752 RETURN END SUBROUTINE LABELX( XVAL, FORM, IFORM, IS, IY, ICHW, IXSIZ ) BYTE LABEL(9) INTEGER FORM(3) IF(.NOT.( IXSIZ .NE. 0 )) GO TO 32759 ENCODE ( 9 , FORM, LABEL ) XVAL CALL TRIML(LABEL, 9, LEN) IF ( IFORM .EQ. 0 ) LEN = LEN - 1 IXL = LEN * ICHW IX = IS - IXL / 2 CALL PLTSTR(IX, IY, LABEL , LEN , 1 , IXSIZ) 32759 RETURN END SUBROUTINE LABELY( YVAL, FORM, IFORM, IS, IY, ICHW, IYSIZ ) BYTE LABEL(9) INTEGER FORM(3) COMMON /YLABEL/ IXMIN IF(.NOT.( IYSIZ .NE. 0 )) GO TO 32759 ENCODE ( 9 , FORM, LABEL ) YVAL CALL TRIML ( LABEL, 9, LEN ) IF ( IFORM .EQ. 0 ) LEN = LEN - 1 IX = IS - ( LEN + 1 ) * ICHW IXMIN = MIN0( IXMIN, IX ) CALL PLTSTR(IX, IY, LABEL , LEN , 1 , IYSIZ) 32759 RETURN END SUBROUTINE DRXTIC( IX, IY, LENTIC ) CALL PLOT(IX, IY, 0) CALL PLOT(IX, IY + LENTIC, 1) RETURN END SUBROUTINE DRYTIC( IX, IY, LENTIC ) CALL PLOT(IX, IY, 0) CALL PLOT(IX + LENTIC, IY, 1) RETURN END FUNCTION IFRMT( FORM, IFMT ) INTEGER FMT(2) , EMT, NUM(5), FORM(3) DATA FMT / '(F', '9.' / DATA EMT / '(G' / DATA NUM / '0)', '1)', '2)', '3)', '2)' / IFORM = MAX0( 0, IFMT ) FORM(1) = FMT(1) FORM(2) = FMT(2) FORM(3) = NUM( MIN0( 5 , IFORM + 1) ) IF ( IFORM .GT. 3 ) FORM(1) = EMT IFRMT = IFORM RETURN END SUBROUTINE LINE( X, Y, N, ICOL, ISYM, ISIZE, INUM ) DIMENSION X(N), Y(N) CALL DASHLN(X, Y, N, ICOL, ISYM, ISIZE, INUM, 0 ) RETURN END SUBROUTINE DASHLN( X, Y, N, ICOL, ISYM, ISIZE, INUM, LINTYP ) LOGICAL DRAWIMARK, DRAWILINE, INSIDE, STARTINEW DIMENSION X(N), Y(N) COMMON /CHKBON/ INSIDE, STARTINEW, LINNTP, LIN1, DASH DRAWIMARK = ISIZE .GE. 1 .AND. ISIZE .LE. 5 DRAWIMARK = DRAWIMARK .AND. ISYM .GE. 0 .AND. ISYM .LE. 5 DRAWIMARK = DRAWIMARK .AND. INUM .NE. 0 DRAWILINE = INUM .GE. 0 IF(.NOT.( DRAWILINE )) GO TO 32759 STARTINEW = .TRUE. CALL COLTYP(ICOL) CALL MOVETO(X(1), Y(1), 0, LINTYP) DO 32758 I = 2, N CALL MOVETO(X(I), Y(I), 1, LINTYP) 32758 CONTINUE 32759 IF(.NOT.( DRAWIMARK )) GO TO 32757 STARTINEW = .TRUE. ITEMP = IABS(INUM) CALL COLTYP(ICOL) DO 32756 I = 1, N, ITEMP CALL MOVETO(X(I), Y(I), 0, LINTYP) IF ( INSIDE ) CALL MARKER(ISYM, ISIZE) 32756 CONTINUE 32757 RETURN END SUBROUTINE MOVETO( XWRLD, YWRLD, IUD, LINTYP ) LOGICAL CURRENTIINSIDE, INX, INY, PREVIOUSIINSIDE, STARTINEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ PREVIOUSIINSIDE, STARTINEW, LINNTP, LIN1, DASH IF(.NOT.( STARTINEW .OR. LINNTP .NE. LINTYP )) GO TO 32758 CALL MOV1ST(XWRLD, YWRLD, IUD, LINTYP) STARTINEW = .FALSE. GO TO 32759 32758 IXC = ISCRX( XWRLD ) IYC = ISCRY( YWRLD ) IX = IXC IY = IYC INX = IX .GE. IASCR .AND. IX .LE. IBSCR INY = IY .GE. ICSCR .AND. IY .LE. IDSCR CURRENTIINSIDE = INX .AND. INY IF(.NOT.( CURRENTIINSIDE .OR. PREVIOUSIINSIDE )) GO TO 32756 IF(.NOT.( .NOT. ( CURRENTIINSIDE .AND. PREVIOUSIINSIDE ) )) GO TO 132755 IX0 = IXCUR IY0 = IYCUR IF(.NOT.( PREVIOUSIINSIDE )) GO TO 32753 PREVIOUSIINSIDE = .FALSE. CALL FNDINT( IX0, IY0, IX, IY ) GO TO 32754 32753 PREVIOUSIINSIDE = .TRUE. CALL FNDINT( IX, IY, IX0, IY0 ) IXCUR = IX0 IYCUR = IY0 CALL DRDASH(IX0, IY0, 0) 32754 CONTINUE 32755 CALL DRDASH(IX, IY, IUD) GO TO 32757 32756 CALL ALLOUT( IX, IY, IUD ) 32757 IXCUR = IXC IYCUR = IYC 32759 RETURN END SUBROUTINE ALLOUT( IX, IY, IUD ) INTEGER ISCX(2), ISCY(2), IX1(2), IY1(2) LOGICAL INSIDE, STARTINEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ INSIDE, STARTINEW, LINNTP, LIN1, DASH EQUIVALENCE ( ISCX(1), IASCR ), ( ISCX(2), IBSCR ) EQUIVALENCE ( ISCY(1), ICSCR ), ( ISCY(2), IDSCR ) INSECT = 0 IF(.NOT.( IX .NE. IXCUR )) GO TO 32759 IXMAX = MAX0( IX, IXCUR ) IXMIN = MIN0( IX, IXCUR ) DO 32758 IS = 1, 2 IF(.NOT.( ISCX(IS) .GE. IXMIN .AND. ISCX(IS) .LE. IXMAX )) GO TO 3 12757 XSL = ( IY - IYCUR ) / FLOAT( IX - IXCUR ) IY0 = XSL * ( ISCX(IS) - IX ) + IY IF(.NOT.( IY0 .GE. ICSCR .AND. IY0 .LE. IDSCR )) GO TO 32756 INSECT = INSECT + 1 IX1(INSECT) = ISCX(IS) IY1(INSECT) = IY0 32756 CONTINUE 32757 CONTINUE 32758 CONTINUE 32759 IF(.NOT.( IY .NE. IYCUR .AND. INSECT .LT. 2 )) GO TO 32755 IYMAX = MAX0( IY, IYCUR ) IYMIN = MIN0( IY, IYCUR ) DO 32754 IS = 1, 2 IF(.NOT.( ISCY(IS) .GE. IYMIN .AND. ISCY(IS) .LE. IYMAX )) GO TO 3 12753 YSL = ( IX - IXCUR ) / FLOAT( IY - IYCUR ) IX0 = YSL * ( ISCY(IS) - IY ) + IX IF(.NOT.( IX0 .GE. IASCR .AND. IX0 .LE. IBSCR )) GO TO 32752 INSECT = INSECT + 1 IX1(INSECT) = IX0 IY1(INSECT) = ISCY(IS) IF( INSECT.EQ.2.AND.IX1(1).EQ.IX1(2) ) INSECT=1 32752 CONTINUE 32753 CONTINUE 32754 CONTINUE 32755 IF(.NOT.( INSECT .EQ. 2 )) GO TO 32751 IXCUR = IX1(1) IYCUR = IY1(1) CALL DRDASH ( IX1(1), IY1(1), 0 ) CALL DRDASH ( IX1(2), IY1(2), IUD ) 32751 INSIDE = .FALSE. RETURN END SUBROUTINE FNDINT( IX0, IY0, IX, IY ) LOGICAL INX, INY COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR INX = IX .GE. IASCR .AND. IX .LE. IBSCR INY = IY .GE. ICSCR .AND. IY .LE. IDSCR IF(.NOT.( .NOT. INX )) GO TO 32759 XSL = (IY - IY0) / FLOAT(IX - IX0) IF(.NOT.( IX .GT. IBSCR )) GO TO 32757 IX = IBSCR GO TO 32758 32757 IX = IASCR 32758 IY = XSL * (IX - IX0) + IY0 INY = IY .GE. ICSCR .AND. IY .LE. IDSCR 32759 IF(.NOT.( .NOT. INY )) GO TO 32756 YSL = (IX - IX0) / FLOAT(IY - IY0) IF(.NOT.( IY .GT. IDSCR )) GO TO 32754 IY = IDSCR GO TO 32755 32754 IY = ICSCR 32755 IX = YSL * (IY - IY0) + IX0 32756 RETURN END SUBROUTINE MOV1ST( XWRLD, YWRLD, IUD, LINTYP ) LOGICAL INSIDE, INX, INY, STARTINEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ INSIDE, STARTINEW, LINNTP, LIN1, DASH COMMON /LINDAT/ RDASH(11), RSPACE(11) IX = ISCRX( XWRLD ) IY = ISCRY( YWRLD ) INX = IX .GE. IASCR .AND. IX .LE. IBSCR INY = IY .GE. ICSCR .AND. IY .LE. IDSCR INSIDE = INX .AND. INY IF(.NOT.( LINTYP .GT. 0 )) GO TO 32758 LINNTP = MIN0( MAX0( LINTYP, 1 ), 8 ) DASH = SCRX * RDASH(LINNTP) GO TO 32759 32758 LINNTP = 0 32759 LIN1 = LINNTP IF ( INSIDE ) CALL DRDASH( IX, IY, IUD ) IXCUR = IX IYCUR = IY RETURN END SUBROUTINE DRDASH( IX, IY, IUD ) INTEGER LIND(11) LOGICAL INSIDE, STARTINEW REAL IDASH(11), ISPACE(11) COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /LINDAT/ IDASH, ISPACE COMMON /CHKBON/ INSIDE, STARTINEW, LINNTP, LIN1, DASH DATA LIND / 1, 2, 3, 4, 5, 6, 9, 10, 7, 11, 8 / DATA IDASH/.02, .04, .08, .16, .24, .32, .16, .16, .04, .04, .04/ DATA ISPACE/.08, .08, .08, .08, .12, .16, .08, .08, .08, .08, .08/ DATA LINNTP, LIN1 / 0, 0 / IF(.NOT.( IUD .EQ. 1 .AND. LINNTP .NE. 0 )) GO TO 32758 DX = IX - X0 DY = IY - Y0 DS = SQRT( DX * DX + DY * DY ) IF(.NOT.( DS .GT. 0. )) GO TO 32757 C = DX / DS S = DY / DS 32757 IF(.NOT.( DS .GT. 0. )) GO TO 32756 IF(.NOT.( DASH .GT. 0. )) GO TO 32754 DDS = AMIN1 ( DS, DASH ) DS = DS - DDS DASH = DASH - DDS IF( DASH .LE. 0. ) SPACE = SCRX * ISPACE(LIN1) X0 = X0 + DDS * C Y0 = Y0 + DDS * S IX0 = X0 + .5 IY0 = Y0 + .5 CALL PLOT( IX0, IY0, 1 ) GO TO 32755 32754 DDS = AMIN1 ( DS, SPACE ) DS = DS - DDS SPACE = SPACE - DDS IF(.NOT.( SPACE .LE. 0. )) GO TO 32753 LIN1 = LIND(LIN1) DASH = SCRX * IDASH(LIN1) 32753 X0 = X0 + DDS * C Y0 = Y0 + DDS * S IX0 = X0 + .5 IY0 = Y0 + .5 CALL PLOT( IX0, IY0, 0 ) 32755 GO TO 32757 32756 GO TO 32759 32758 CALL PLOT( IX, IY, IUD ) 32759 X0 = IX Y0 = IY RETURN END SUBROUTINE PLTSTR( IX, IY, STR, LEN, IROT, ISIZE ) BYTE STR(LEN) LOGICAL INX, INY COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF INX = IX .GE. IXMINF .AND. IX .LE. IXMAXF INY = IY .GE. IYMINF .AND. IY .LE. IYMAXF IF(.NOT.( INX .AND. INY )) GO TO 32759 CALL PLOT ( IX, IY, 0 ) CALL WRTSTR ( STR, LEN, IROT, ISIZE ) 32759 RETURN END SUBROUTINE DRWREC( XMIN, XMAX, YMIN, YMAX, ICOL ) CALL COLTYP(ICOL) CALL MOVETO(XMIN, YMIN, 0, 0) CALL MOVETO(XMAX, YMIN, 1, 0) CALL MOVETO(XMAX, YMAX, 1, 0) CALL MOVETO(XMIN, YMAX, 1, 0) CALL MOVETO(XMIN, YMIN, 1, 0) RETURN END SUBROUTINE TRIMSP( TITLE, LEN, IST, IEND ) BYTE TITLE(LEN) IST = 1 IEND = LEN 32759 IF(.NOT.( IST .LT. LEN .AND. TITLE(IST) .EQ. ' ' )) GO TO 32758 IST = IST + 1 GO TO 32759 32758 IF(.NOT.( IEND .GT. IST .AND. TITLE(IEND) .EQ. ' ' )) GO TO 32757 IEND = IEND - 1 GO TO 32758 32757 RETURN END SUBROUTINE TRIML( LABEL, N, LEN ) BYTE LABEL(N) I = 1 32759 IF(.NOT.( I .LT. N .AND. LABEL(I) .EQ. ' ' )) GO TO 32758 I = I + 1 GO TO 32759 32758 LEN = 0 DO 32757 J = I, N LEN = LEN + 1 LABEL(LEN) = LABEL(J) 32757 CONTINUE RETURN END FUNCTION ISCRX( XWRLD ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST X = AMIN1( XWRLD * XSLOPE + XCONST, 32767. ) X = AMAX1 ( X, -32767. ) ISCRX = IFIX( X + .5 ) RETURN END FUNCTION ISCRY( YWRLD ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST Y = AMIN1 ( YWRLD * YSLOPE + YCONST, 32767. ) Y = AMAX1 ( Y, -32767. ) ISCRY = IFIX ( Y + .5 ) RETURN END FUNCTION XWORLD( IX ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST XWORLD = ( IX - XCONST ) / XSLOPE RETURN END FUNCTION YWORLD( IY ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST YWORLD = ( IY - YCONST ) / YSLOPE RETURN END SUBROUTINE CURPOS( ICURX, ICURY ) COMMON /HCURPO/ IXCUR, IYCUR ICURX = IXCUR ICURY = IYCUR RETURN END SUBROUTINE INILGN( XMIN, XMAX, YMIN, YMAX ) COMMON /HFRAME/ I1(4) COMMON /HSCALE/ X1(4) COMMON /HWINDO/ SCRX, SCRY, I2(6) COMMON /WORLD/ X2(4) COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /SAVPAR/ J1(4), Y1(4), J2(6), Y2(4) COMMON /LGND/ YSTRT, DELY, DELX, X(2) DO 32759 I = 1, 6 J2(I) = I2(I) 32759 CONTINUE DO 32758 I = 1, 4 J1(I) = I1(I) Y1(I) = X1(I) Y2(I) = X2(I) 32758 CONTINUE CALL FRAME( XMIN, XMAX, YMIN, YMAX ) CALL WINDOW( 0., XMAX - XMIN, 0., YMAX - YMIN ) CALL VUPORT( 0., 1., 0., 1. ) DELY = YWORLD( ICHH(2) ) - YWORLD(0) DELX = XWORLD( ICHW(2) ) - XWORLD(0) YSTRT = .99 - DELY X(1) = .05 X(2) = .2 RETURN END SUBROUTINE ENDLGN COMMON /HFRAME/ I1(4) COMMON /HSCALE/ X1(4) COMMON /HWINDO/ SCRX, SCRY, I2(6) COMMON /WORLD/ X2(4) COMMON /SAVPAR/ J1(4), Y1(4), J2(6), Y2(4) DO 32759 I = 1, 6 I2(I) = J2(I) 32759 CONTINUE DO 32758 I = 1, 4 I1(I) = J1(I) X1(I) = Y1(I) X2(I) = Y2(I) 32758 CONTINUE RETURN END SUBROUTINE WRILGN( TITLE, N, ICOL, ISYM, INUM, LINTYP ) BYTE TITLE(N) DIMENSION X(2), Y(2) COMMON /LGND/ YSTRT, DELY, DELX, XX(2) DATA XX / .05, .2 / Y(1) = YSTRT Y(2) = YSTRT X(2) = XX(2) IF(.NOT.( INUM .LT. 0 )) GO TO 32758 NUM = -2 X(1) = XX(2) GO TO 32759 32758 IF(.NOT.( INUM .GT. 0 )) GO TO 32757 NUM = 1 X(1) = XX(1) GO TO 32759 32757 IF(.NOT.( INUM .EQ. 0 )) GO TO 32756 NUM = 0 X(1) = XX(1) 32756 CONTINUE 32759 CALL DASHLN( X, Y, 2, ICOL, ISYM, 2, NUM, LINTYP ) IX = ISCRX( X(2) + DELX ) IY = ISCRY( YSTRT - .5 * DELY ) CALL PLTSTR( IX, IY, TITLE, N, 1, 2 ) YSTRT = YSTRT - DELY RETURN END SUBROUTINE RECLGN( NL, TITLE, N, ICOL, ISYM, INUM, LINTYP, 1 XSTRT, XLEN, YSTRT ) BYTE TITLE(1) DIMENSION XSTRT(NL), XLEN(NL), YSTRT(NL) INTEGER N(NL), ICOL(NL), ISYM(NL), INUM(NL), LINTYP(NL) COMMON /PAGSIZ/ XBOND, YBOND COMMON /LGND/ YSTART, DELY, DELX, X(2) CALL INILGN( 0., XBOND, 0., YBOND ) IST = 1 DO 32759 I = 1, NL X(1) = XSTRT(I) X(2) = XSTRT(I) + XLEN(I) YSTART = YSTRT(I) CALL WRILGN(TITLE(IST),N(I),ICOL(I),ISYM(I),INUM(I),LINTYP(I)) IST = IST + N(I) 32759 CONTINUE CALL ENDLGN RETURN END SUBROUTINE INIPLT( IUNIT, XSIZE, YSIZE ) BYTE ESC, FF, SUB, ENQ, CHAR, MES(10), TRANS(2), VTBUFR(128) BYTE MESCLR(4) INTEGER VTPOS, VTBUFL INTEGER VCHRIWIDTH(5), VCHRIHEIGHT(5) INTEGER HCHRIWIDTH(5), HCHRIHEIGHT(5) LOGICAL VISUAL COMMON /PAGSIZ/ XBOND, YBOND COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /PENPOS/ IUPDWN COMMON /HBYTE/ ESC, FF, SUB, ENQ, CHAR COMMON /VTBUF/ VTBUFR, VTPOS, VTBUFL DATA MES / ';', ':', 'E', 'H', 'H', 'O', 'U', 'A', 'L', '0' / DATA FF , ENQ, SUB, ESC, TRANS / 12, 5, 26, 27, 29, 77 / DATA VCHRIWIDTH, VCHRIHEIGHT / 7,10,20,30,40, 10,15,30,45,60 / DATA HCHRIWIDTH, HCHRIHEIGHT / 18,24,36,48,72, 24,36,54,72,108 / DATA IASCR, IBSCR, ICSCR, IDSCR, IXORIG, IYORIG, XCONST, YCONST 1 / 6 * 0, 2 * 0. / DATA MESCLR /27,'[','2','J'/ !Line added for V ITTNUM = 7 LUNPLT = IUNIT VISUAL = LUNPLT .EQ. ITTNUM VTBUFL = 128 VTPOS = 0 IUPDWN = 0 IF(.NOT.( VISUAL )) GO TO 32758 CALL WRITCH (MESCLR,4) CALL PLTON CALL ERASE SCRX = 75. SCRY = 75. DO 32757 I = 1, 5 ICHW(I) = VCHRIWIDTH(I) ICHH(I) = VCHRIHEIGHT(I) 32757 CONTINUE GO TO 32759 32758 IF(.NOT.( IUNIT .EQ. 8 )) GO TO 32756 LUNPLT = ITTNUM CALL PLTON 32756 CALL WRITCH(MES, 10 ) SCRX = 200. SCRY = 200. DO 32755 I = 1, 5 ICHW(I) = HCHRIWIDTH(I) ICHH(I) = HCHRIHEIGHT(I) 32755 CONTINUE 32759 XBOND = XSIZE YBOND = YSIZE XMINW = 0. XMAXW = 1. YMINW = 0. YMAXW = 1. CALL FRAME( 0., XSIZE, 0., YSIZE ) CALL WINDOW( .2 * XSIZE, .8 * XSIZE, .2 * YSIZE, .8 * YSIZE ) RETURN END SUBROUTINE ENDPLT BYTE MES(12) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MES /'P','0','E','F','3','0','0','0',',','0',' ','@'/ IF(.NOT.( VISUAL )) GO TO 32758 CALL PLTOFF CALL DMPPLT GO TO 32759 32758 CALL WRITCH(MES, 12 ) IF( LUNPLT .EQ. ITTNUM ) CALL PLTOFF CALL DMPPLT 32759 IF ( LUNPLT .NE. ITTNUM ) CLOSE( UNIT = LUNPLT ) RETURN END SUBROUTINE PENDWN BYTE MESH(2), MESV(5) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /PENPOS/ IUPDWN DATA MESH, MESV / 'D', ' ', 27, '/', '0', 'd', 29 / IF(.NOT.( VISUAL )) GO TO 32758 IUPDWN = 1 GO TO 32759 32758 IF( IUPDWN .EQ. 0 ) CALL WRITCH(MESH, 2) IUPDWN = 1 32759 RETURN END SUBROUTINE PENUP BYTE MESH(2), MESV(5) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /PENPOS/ IUPDWN DATA MESH, MESV / 'U', ' ', 27, '/', '1', 'd', 28 / IF(.NOT.( VISUAL )) GO TO 32758 IUPDWN = 0 GO TO 32759 32758 IF( IUPDWN .EQ. 1 ) CALL WRITCH(MESH, 2) IUPDWN = 0 32759 RETURN END SUBROUTINE WRTSTR( STR, LEN, IROT, ISIZE ) BYTE STR(LEN), MES(5), XL, XH, YL, YH INTEGER POSIT(96), BLOCK(693) LOGICAL VISUAL, DONE COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHRSIZ/ ICHW(5), ICHH(5) COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA N, YL, YH, XL, XH / 693, 96, 32, 64, 32 / DATA POSIT / 1,2,173,26,34,48,71,177,94,98,86,106,183,102,189,200, . 602,611,616,624,637,641,650,662,666,682,163,152,194,110,197,202, . 6,217,222,234,242,249,255,260,270,276,282,287,292,295,300,304, . 313,320,331,340,352,356,362,365,370,374,379,126,213,130, 68,104, . 120,383,393,403,411,421,431,438,451,458,468,479,486,491,502,509, . 518,528,538,544,556,563,570,573,584,588,598,134,215,143,114, 1/ DATA BLOCK / . 2192,156,1173,146,3216,208,1104,1042,1050,1116,1244,1306,1300, . 1267,1235,1204,1208,183,1176,1144,1111,1110,1141,1173,3254,92, . 1104,220,1232,24,1304,20,3348,51,1106,1234,1267,1269,1238,1110, . 1079,1081,1114,1242,1273,156,3216,60,1051,1050,1081,1113,1146, . 1147,1116,1084,284,1040,240,1297,1298,1267,1235,1202,1201,1232, . 3312,20,1176,3348,276,1236,1203,1201,1168,1072,1041,1044,1176, . 1178,1148,1116,1082,1080,3345,26,1298,18,1306,22,1302,154,3218, . 188,1146,1138,3248,124,1210,1202,3184,22,3350,12,3468,154,1170, . 22,3350,24,1304,20,3348,22,1079,1143,1205,1269,3350,123,1179, . 1180,1148,1147,3257,188,1148,1136,3248,124,1212,1200,3184,252, . 1212,1179,1176,1110,1172,1169,1200,3312,60,1148,1179,1176,1238, . 1172,1169,1136,3120,181,1206,1238,1237,1205,208,1200,1201,1233, . 1232,3214,117,1142,1174,1173,1141,112,1137,1169,1168,3184,92, . 1114,220,3290,219,1211,1212,1244,1243,3225,208,1200,1201,1233, . 1232,3214,112,1137,1169,1168,3184,284,1046,3344,28,1302,3088,218, . 3088,59,1116,1244,1275,1272,1239,1207,1174,1173,146,3216,26,3280, . 156,3216,16,1180,1296,51,3315,16,1052,1244,1306,1304,1238,1046, . 214,1300,1298,1232,3088,282,1244,1116,1050,1042,1104,1232,3346, . 16,1052,1244,1306,1298,1232,3088,284,1052,1040,1296,22,3222,284, . 1052,1040,22,3222,282,1244,1116,1050,1042,1104,1232,1298,1301, . 3221,16,1052,22,1302,284,3344,28,1308,156,1168,16,3344,284,1298, . 1232,1104,3090,16,1052,284,1046,3344,28,1040,3344,16,1052,1168, . 1308,3344,16,1052,1296,3356,208,1104,1042,1050,1116,1244,1306, . 1298,3280,16,1052,1244,1306,1304,1238,3094,208,1104,1042,1050, . 1116,1244,1306,1298,1232,210,3344,16,1052,1244,1306,1304,1238, . 1046,214,3344,18,1104,1232,1298,1300,1238,1110,1048,1050,1116, . 1244,3354,28,1308,156,3216,28,1042,1104,1232,1298,3356,28,1168, . 3356,28,1040,1174,1296,3356,28,1296,16,3356,28,1174,1308,150, . 3216,28,1308,1040,3344,244,1206,1110,1044,1042,1104,1200,1266, . 246,3312,26,1040,18,1104,1200,1266,1268,1206,1110,3092,213,1206, . 1110,1044,1042,1104,1200,3281,244,1238,1110,1044,1042,1104,1200, . 1266,250,3312,19,1267,1269,1206,1110,1044,1042,1104,1200,3312, . 249,1242,1178,1144,1136,21,3285,212,1174,1110,1044,1042,1104, . 1168,1234,214,1229,1196,1068,3085,26,1040,20,1110,1206,1268,3312, . 122,1178,1177,1145,1146,118,1174,1168,80,3280,154,1210,1209,1177, . 1178,150,1206,1197,1164,1068,3085,26,1040,214,1107,1043,83,3280, . 122,1178,1168,112,3248,16,1045,1078,1142,1173,1168,1173,1206, . 1270,1301,3344,22,1040,20,1110,1206,1268,3312,242,1200,1104,1042, . 1044,1110,1206,1268,3314,22,1036,18,1104,1200,1266,1268,1206, . 1110,3092,244,1206,1110,1044,1042,1104,1200,1266,246,3308,22, . 1040,20,1110,1206,3285,17,1072,1200,1233,1234,1203,1075,1044, . 1045,1078,1206,3285,122,1137,1168,1200,1233,54,3254,22,1042,1104, . 1200,1266,246,3312,22,1136,3286,22,1041,1072,1136,1169,1171,145, . 1200,1264,1297,3350,22,1232,16,3286,22,1042,1104,1168,1234,214, . 1229,1196,1068,3085,22,1238,1040,3280,210,1168,1104,1042,1050, . 1116,1180,1242,3282,90,1180,1168,80,3280,27,1084,1212,1243,1240, . 1042,1040,3280,27,1084,1212,1243,1240,1174,1110,150,1236,1233, . 1200,1072,3089,208,1244,1044,3348,220,1052,1046,1206,1237,1233, . 1200,1072,3089,219,1212,1084,1051,1041,1072,1200,1233,1237,1206, . 1078,3093,28,1244,1242,3088,86,1048,1051,1084,1212,1243,1240, . 1174,1110,1044,1041,1072,1200,1233,1236,3222,17,1072,1200,1233, . 1243,1212,1084,1051,1047,1078,1206,3287 / IF(.NOT.( VISUAL )) GO TO 32759 CALL PENDWN 32759 ISZ = MIN0( MAX0( ISIZE, 1 ), 5 ) IRT = MOD( IROT - 1, 4 ) + 1 ISX = IABS( IRT - 3 ) - 1 ISY = IABS( IRT - 2 ) - 1 IXC = IXCUR IYC = IYCUR DO 32758 I = 1, LEN JCHR = STR(I) - 31 IF(.NOT.( JCHR .GT. 0 )) GO TO 32757 J = POSIT(JCHR) JWID = ICHW(ISZ) DONE = .FALSE. 32756 IF(.NOT.( .NOT. DONE )) GO TO 32755 IXP = MOD( BLOCK(J), 1024 ) IUD = 0 IF( MOD( BLOCK(J), 2048 ) .GE. 1024 ) IUD = 1 IYP = MOD( IXP , 32 ) - 12 IYP = ( ICHH(ISZ) * IYP ) / 12. + .5 IXP = IXP / 32 IXP = ( ICHW(ISZ) * IXP ) / 12. + .5 IX = IXC + IXP * ISX - ISY * IYP IY = IYC + IXP * ISY + ISX * IYP CALL PLOT( IX, IY, IUD ) IF( BLOCK(J) .GE. 2048 ) DONE = .TRUE. J = J + 1 GO TO 32756 32755 IXC = IXC + JWID * ISX IYC = IYC + JWID * ISY 32757 CONTINUE 32758 CONTINUE IXCUR = IXC IYCUR = IYC RETURN END SUBROUTINE MARKER( ISYM, ISIZE ) BYTE MES(4) INTEGER MARKISIZE(5) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MARKISIZE / 2, 3, 4, 6, 9 / 1 FORMAT('M ', 2I1) ISZ = MAX0( MIN0(ISIZE, 5), 1 ) MRK = MIN0( MAX0(ISYM, 0), 5 ) IF(.NOT.( VISUAL )) GO TO 32758 IW = MARKISIZE(ISZ) CALL CURPOS( IX, IY ) IF((0).NE.( MRK )) GO TO 32756 CALL PLOT( IX-IW, IY, 0 ) CALL PLOT( IX+IW, IY, 1 ) CALL PLOT( IX, IY-IW, 0 ) CALL PLOT( IX, IY+IW, 1 ) GO TO 32757 32756 IF((1).NE.( MRK )) GO TO 32755 CALL PLOT( IX-IW, IY-IW, 0 ) CALL PLOT( IX+IW, IY+IW, 1 ) CALL PLOT( IX+IW, IY-IW, 0 ) CALL PLOT( IX-IW, IY+IW, 1 ) GO TO 32757 32755 IF((2).NE.( MRK )) GO TO 32754 CALL PLOT( IX-IW, IY-IW, 0 ) CALL PLOT( IX+IW, IY-IW, 1 ) CALL PLOT( IX+IW, IY+IW, 1 ) CALL PLOT( IX-IW, IY+IW, 1 ) CALL PLOT( IX-IW, IY-IW, 1 ) GO TO 32757 32754 IF((3).NE.( MRK )) GO TO 32753 CALL CIRCLE( IX, IY, IW ) GO TO 32757 32753 IF((4).NE.( MRK )) GO TO 32752 CALL PLOT( IX-IW, IY-IW, 0 ) CALL PLOT( IX+IW, IY-IW, 1 ) CALL PLOT( IX, IY+IW, 1 ) CALL PLOT( IX-IW, IY-IW, 1 ) GO TO 32757 32752 IF((5).NE.( MRK )) GO TO 32751 CALL PLOT( IX-IW, IY-IW, 0 ) CALL PLOT( IX+IW, IY+IW, 1 ) CALL PLOT( IX-IW, IY+IW, 1 ) CALL PLOT( IX+IW, IY-IW, 1 ) CALL PLOT( IX-IW, IY-IW, 1 ) 32751 CONTINUE 32757 GO TO 32759 32758 ENCODE( 4, 1, MES ) ( ISZ + 2 ) / 2, MRK IF(.NOT.( MOD( ISZ, 2 ) .EQ. 1 )) GO TO 32750 MES(2) = MES(3) MES(3) = '+' 32750 CALL WRITCH(MES, 4) 32759 RETURN END SUBROUTINE CIRCLE( IX, IY, IR ) BYTE MES(16) BYTE CENTER(12) BYTE MESCIR(9) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM 1 FORMAT( 'CC', I4, ',', I4, I5 ) 2 FORMAT( A1, '/', I3, ';', I3, ';', I2, ';0A' ) 3 FORMAT('C[+',I4,',]') !VT125 line added. 4 FORMAT('P[',I4,',',I4,']') !VT125 line added. IF(.NOT.( VISUAL )) GO TO 32758 ENCODE (12, 4, CENTER) IX, 479-IY CALL WRITCH (CENTER,12) ENCODE (9, 3, MESCIR) IR CALL WRITCH (MESCIR,9) GO TO 32759 32758 ENCODE( 16, 1, MES ) IX, IY, IR CALL WRITCH( MES, 16 ) 32759 RETURN END SUBROUTINE COLTYP( ICOL ) BYTE MES(2) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM IF(.NOT.( .NOT. VISUAL )) GO TO 32759 ITYPE = ICOL + 1 ITYPE = MIN0(ITYPE, 8) ITYPE = MAX0(ITYPE, 1) MES(1) = 'P' MES(2) = ITYPE + 48 CALL WRITCH(MES, 2) 32759 RETURN END SUBROUTINE PLOT( IX, IY, IUD ) BYTE LOWY, HIGHY, LOWX, HIGHX, YL, YH, XL, XH BYTE MES(10) BYTE MESBEG(2),MESXY(10),MESEND LOGICAL VISUAL COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF COMMON /HCURPO/ IXCUR, IYCUR COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA YL, YH, XL, XH / 96, 32, 64, 32 /