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) 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. / ITTNUM = 7 LUNPLT = IUNIT VISUAL = LUNPLT .EQ. ITTNUM VTBUFL = 128 VTPOS = 0 IUPDWN = 0 IF(.NOT.( VISUAL )) GO TO 32758 CALL WRITCH(TRANS, 2) 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 CALL WRITCH( MESV, 5 ) 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 CALL WRITCH( MESV, 5 ) 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(93), IPLS(2), INUM(5) LOGICAL VISUAL, INX, INY COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF COMMON /HCURPO/ IXCUR, IYCUR COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /CHRSIZ/ ICHW(5), ICHH(5) DATA INUM, IPLS / ':', '0', '1', '2', '3', ' ', '+' / 1 FORMAT('$Warning string ', 100A1) 2 FORMAT(' is out of bounds and will not be plotted') 3 FORMAT( 'S', 2I1, A1 ) ISZ = MIN0( MAX0( ISIZE, 1 ), 5 ) IX = ICHW(ISZ) * LEN IY = ICHH(ISZ) IRT = MOD(IROT - 1, 4) + 1 IRRT = MOD( 12 - 2 * IRT , 8 ) ISX = IABS(IRT - 3) - 1 ISY = IABS(IRT - 2) - 1 IXL = ISX * IX - ISY * IY + IXCUR IYL = ISX * IY + ISY * IX + IYCUR INX = IXL .GE. IXMINF .AND. IXL .LE. IXMAXF INY = IYL .GE. IYMINF .AND. IYL .LE. IYMAXF IF(.NOT.( INX .AND. INY )) GO TO 32758 IXCUR = IXL + ISY * IY IYCUR = IYL - ISX * IY MINLEN = MIN0( LEN, 80 ) IF(.NOT.( .NOT. VISUAL )) GO TO 32756 ENCODE(4,3,MES) IRT, (ISZ+2)/2, IPLS(MOD(ISZ,2)+1) DO 32755 I = 1, MINLEN MES(I + 4 ) = STR(I) 32755 CONTINUE MES( MINLEN + 5 ) = 95 NUMCH = MINLEN + 5 GO TO 32757 32756 MES(1) = 27 MES(2) = 47 MES(3) = 48 MES(4) = 100 MES(5) = 31 MES(6) = 27 IF(.NOT.( ISZ .EQ. 1 )) GO TO 32753 MES(7) = '0' GO TO 32754 32753 MES(7) = '9' 32754 MES(8) = 27 MES(9) = INUM(ISZ) MES(10) = 27 MES(11) = 47 MES(12) = IRRT + 48 MES(13) = 101 DO 32752 I = 1, MINLEN MES(I + 13) = STR(I) 32752 CONTINUE NUMCH = MINLEN + 13 32757 CALL WRITCH(MES, NUMCH) GO TO 32759 32758 IF(.NOT.( LUNPLT .EQ. ITTNUM )) GO TO 32750 CALL PLTOFF CALL DMPPLT TYPE 1, (STR(I), I = 1, LEN) TYPE 2 CALL PLTON GO TO 32751 32750 TYPE 1, (STR(I), I = 1, LEN) TYPE 2 32751 CONTINUE 32759 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) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM 1 FORMAT( 'CC', I4, ',', I4, I5 ) 2 FORMAT( A1, '/', I3, ';', I3, ';', I2, ';0A' ) IF(.NOT.( VISUAL )) GO TO 32758 CALL PENDWN ENCODE( 15, 2, MES ) 27, IX, IY, IR DO 32757 I = 1, 15 IF( MES(I) .EQ. ' ' ) MES(I) = '0' 32757 CONTINUE CALL WRITCH( MES, 15 ) 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) 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 / 1 FORMAT( I4, ',', I4, 1X ) IX0 = IX IY0 = IY IF(.NOT.( IX0 .LT. IXMINF )) GO TO 32758 IX0 = IXMINF GO TO 32759 32758 IF(.NOT.( IX0 .GT. IXMAXF )) GO TO 32757 IX0 = IXMAXF 32757 CONTINUE 32759 IF(.NOT.( IY0 .LT. IYMINF )) GO TO 32755 IY0 = IYMINF GO TO 32756 32755 IF(.NOT.( IY0 .GT. IYMAXF )) GO TO 32754 IY0 = IYMAXF 32754 CONTINUE 32756 IF(.NOT.(IUD .EQ. 1)) GO TO 32752 CALL PENDWN GO TO 32753 32752 CALL PENUP 32753 IF(.NOT.( .NOT. VISUAL )) GO TO 32750 ENCODE( 10, 1, MES ) IX0, IY0 CALL WRITCH(MES, 10) GO TO 32751 32750 MES(2) = MOD( IYCUR, 32 ) .OR. YL MES(1) = ( IYCUR / 32 ) .OR. YH MES(4) = MOD( IXCUR, 32 ) .OR. XL MES(3) = ( IXCUR / 32 ) .OR. XH MES(6) = MOD( IY0, 32 ) .OR. YL MES(5) = ( IY0 / 32 ) .OR. YH MES(8) = MOD( IX0, 32 ) .OR. XL MES(7) = ( IX0 / 32 ) .OR. XH CALL WRITCH(MES, 8) 32751 IXCUR = IX0 IYCUR = IY0 RETURN END SUBRO