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 C 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 C IDX = IXMINF - IXORIG IDY = IYMINF - IYORIG IXORIG = IXMINF IYORIG = IYMINF C C MOVE WINDOW INTO FRAME C IASCR = IASCR + IDX IBSCR = IBSCR + IDX ICSCR = ICSCR + IDY IDSCR = IDSCR + IDY XCONST = XCONST + IDX YCONST = YCONST + IDY C RETURN END SUBROUTINE WINDOW( XWIN0, XWIN1, YWIN0, YWIN1 ) COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /WORLD/ XMINW, XMAXW, YMINW, YMAXW C IASCR = SCRX * XWIN0 + IXORIG IBSCR = SCRX * XWIN1 + IXORIG ICSCR = SCRY * YWIN0 + IYORIG IDSCR = SCRY * YWIN1 + IYORIG C CALL SCALE( XMINW, XMAXW, YMINW, YMAXW ) C RETURN END SUBROUTINE VUPORT( XMIN, XMAX, YMIN, YMAX ) C CALL SCALE(XMIN, XMAX, YMIN, YMAX) C 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 C XMINW = XMIN XMAXW = XMAX YMINW = YMIN YMAXW = YMAX C XSLOPE = (IBSCR - IASCR) / (XMAX - XMIN) YSLOPE = (IDSCR - ICSCR) / (YMAX - YMIN) XCONST = - XSLOPE * XMIN + FLOAT(IASCR) YCONST = - YSLOPE * YMIN + FLOAT(ICSCR) C 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 C CALL DRWREC( XMINW, XMAXW, YMINW, YMAXW, 0 ) CALL XAXIS( XTIC, IXTIT, IXLEN, IXSIZ, IXFMT ) CALL YAXIS( YTIC, IYTIT, IYLEN, IYSIZ, IYFMT ) C RETURN END SUBROUTINE XAXIS( XTIC, IXTIT, IXLEN, IXSIZ, IXFMT ) BYTE IXTIT(IXLEN) 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) C WHEN ( IXSIZ .GE. 1 .AND. IXSIZ .LE. 5 ) IXS = IXSIZ ELSE IXS = 0 IF ( XTIC .NE. 0. ) IS = IASCR IY = ICSCR - ICHH(MAX0( IXS, 1 )) * 2 LENTIC = SCRX / 4 XVAL = XMINW IFORM = IFRMT( FORM, IXFMT ) XMAX = AMAX1( XMINW, XMAXW ) XMIN = AMIN1( XMINW, XMAXW ) IW = ICHW(MAX0(IXS,1)) WHILE ( XVAL .LE. XMAX .AND. XVAL .GE. XMIN ) WHEN ( XVAL .EQ. XMINW ) CALL LABELX( XVAL, FORM, IFORM, IS, IY, IW, IXS ) FIN ELSE IS = ISCRX( XVAL ) IF( IS .NE. IBSCR ) CALL DRXTIC(IS, ICSCR, LENTIC) CALL LABELX( XVAL, FORM, IFORM, IS, IY, IW, IXS ) FIN XVAL = XVAL + XTIC FIN FIN C C CENTER HORIZONTAL TITLE AND PLOT C IF( IXS .NE. 0 ) CALL TRIMSP( IXTIT, IXLEN, IST, IEND ) IXLN = IEND + 1 - IST IXL = IXLN * ICHW(IXS) IX = (IASCR + IBSCR - IXL) / 2 IY = ICSCR - 4 * ICHH(IXS) CALL PLTSTR(IX, IY, IXTIT(IST), IXLN, 1, IXS) FIN C 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 C WHEN ( IYSIZ .GE. 1 .AND. IYSIZ .LE. 5 ) IYS = IYSIZ ELSE IYS = 0 IXMIN = IASCR IF ( YTIC .NE. 0. ) 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 ) WHILE ( YVAL .LE. YMAX .AND. YVAL .GE. YMIN ) WHEN ( YVAL .EQ. YMINW ) CALL LABELY( YVAL, FORM, IFORM, IASCR, IY, IW, IYS ) FIN ELSE IS = ISCRY( YVAL ) IY = IS - IHGT IF( IDSCR .NE. IS ) CALL DRYTIC( IASCR, IS, LENTIC ) CALL LABELY( YVAL, FORM, IFORM, IASCR, IY, IW, IYS ) FIN YVAL = YVAL + YTIC FIN FIN C C CENTER VERTICAL TITLE AND PLOT C IF ( IYS .NE. 0 ) 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) FIN C RETURN END SUBROUTINE LABELX( XVAL, FORM, IFORM, IS, IY, ICHW, IXSIZ ) BYTE LABEL(9) INTEGER FORM(3) C IF ( IXSIZ .NE. 0 ) 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) FIN C RETURN END SUBROUTINE LABELY( YVAL, FORM, IFORM, IS, IY, ICHW, IYSIZ ) BYTE LABEL(9) INTEGER FORM(3) COMMON /YLABEL/ IXMIN C IF ( IYSIZ .NE. 0 ) 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) FIN C RETURN END SUBROUTINE DRXTIC( IX, IY, LENTIC ) C CALL PLOT(IX, IY, 0) CALL PLOT(IX, IY + LENTIC, 1) C RETURN END SUBROUTINE DRYTIC( IX, IY, LENTIC ) C CALL PLOT(IX, IY, 0) CALL PLOT(IX + LENTIC, IY, 1) C 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)' / C 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 C RETURN END SUBROUTINE LINE( X, Y, N, ICOL, ISYM, ISIZE, INUM ) DIMENSION X(N), Y(N) C CALL DASHLN(X, Y, N, ICOL, ISYM, ISIZE, INUM, 0 ) C RETURN END SUBROUTINE DASHLN( X, Y, N, ICOL, ISYM, ISIZE, INUM, LINTYP ) LOGICAL DRAW_MARK, DRAW_LINE, INSIDE, START_NEW DIMENSION X(N), Y(N) COMMON /CHKBON/ INSIDE, START_NEW, LINNTP, LIN1, DASH C DRAW_MARK = ISIZE .GE. 1 .AND. ISIZE .LE. 5 DRAW_MARK = DRAW_MARK .AND. ISYM .GE. 0 .AND. ISYM .LE. 5 DRAW_MARK = DRAW_MARK .AND. INUM .NE. 0 DRAW_LINE = INUM .GE. 0 C IF ( DRAW_LINE ) START_NEW = .TRUE. CALL COLTYP(ICOL) CALL MOVETO(X(1), Y(1), 0, LINTYP) DO ( I = 2, N ) CALL MOVETO(X(I), Y(I), 1, LINTYP) FIN C IF ( DRAW_MARK ) START_NEW = .TRUE. ITEMP = IABS(INUM) CALL COLTYP(ICOL) DO ( I = 1, N, ITEMP ) CALL MOVETO(X(I), Y(I), 0, LINTYP) IF ( INSIDE ) CALL MARKER(ISYM, ISIZE) FIN FIN C RETURN END SUBROUTINE MOVETO( XWRLD, YWRLD, IUD, LINTYP ) LOGICAL CURRENT_INSIDE, INX, INY, PREVIOUS_INSIDE, START_NEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ PREVIOUS_INSIDE, START_NEW, LINNTP, LIN1, DASH C WHEN ( START_NEW .OR. LINNTP .NE. LINTYP ) CALL MOV1ST(XWRLD, YWRLD, IUD, LINTYP) START_NEW = .FALSE. FIN ELSE 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 CURRENT_INSIDE = INX .AND. INY WHEN ( CURRENT_INSIDE .OR. PREVIOUS_INSIDE ) IF ( .NOT. ( CURRENT_INSIDE .AND. PREVIOUS_INSIDE ) ) IX0 = IXCUR IY0 = IYCUR WHEN ( PREVIOUS_INSIDE ) PREVIOUS_INSIDE = .FALSE. CALL FNDINT( IX0, IY0, IX, IY ) FIN ELSE PREVIOUS_INSIDE = .TRUE. CALL FNDINT( IX, IY, IX0, IY0 ) IXCUR = IX0 IYCUR = IY0 CALL DRDASH(IX0, IY0, 0) FIN FIN CALL DRDASH(IX, IY, IUD) FIN ELSE CALL ALLOUT( IX, IY, IUD ) FIN IXCUR = IXC IYCUR = IYC FIN C RETURN END SUBROUTINE ALLOUT( IX, IY, IUD ) INTEGER ISCX(2), ISCY(2), IX1(2), IY1(2) LOGICAL INSIDE, START_NEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ INSIDE, START_NEW, LINNTP, LIN1, DASH EQUIVALENCE ( ISCX(1), IASCR ), ( ISCX(2), IBSCR ) EQUIVALENCE ( ISCY(1), ICSCR ), ( ISCY(2), IDSCR ) C INSECT = 0 IF ( IX .NE. IXCUR ) IXMAX = MAX0( IX, IXCUR ) IXMIN = MIN0( IX, IXCUR ) DO ( IS = 1, 2 ) IF( ISCX(IS) .GE. IXMIN .AND. ISCX(IS) .LE. IXMAX ) XSL = ( IY - IYCUR ) / FLOAT( IX - IXCUR ) IY0 = XSL * ( ISCX(IS) - IX ) + IY IF ( IY0 .GE. ICSCR .AND. IY0 .LE. IDSCR ) INSECT = INSECT + 1 IX1(INSECT) = ISCX(IS) IY1(INSECT) = IY0 FIN FIN FIN FIN IF ( IY .NE. IYCUR .AND. INSECT .LT. 2 ) IYMAX = MAX0( IY, IYCUR ) IYMIN = MIN0( IY, IYCUR ) DO ( IS = 1, 2 ) IF( ISCY(IS) .GE. IYMIN .AND. ISCY(IS) .LE. IYMAX ) YSL = ( IX - IXCUR ) / FLOAT( IY - IYCUR ) IX0 = YSL * ( ISCY(IS) - IY ) + IX IF ( IX0 .GE. IASCR .AND. IX0 .LE. IBSCR ) INSECT = INSECT + 1 IX1(INSECT) = IX0 IY1(INSECT) = ISCY(IS) IF( INSECT.EQ.2.AND.IX1(1).EQ.IX1(2) ) INSECT=1 FIN FIN FIN FIN IF ( INSECT .EQ. 2 ) IXCUR = IX1(1) IYCUR = IY1(1) CALL DRDASH ( IX1(1), IY1(1), 0 ) CALL DRDASH ( IX1(2), IY1(2), IUD ) FIN INSIDE = .FALSE. C RETURN END SUBROUTINE FNDINT( IX0, IY0, IX, IY ) LOGICAL INX, INY COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR C INX = IX .GE. IASCR .AND. IX .LE. IBSCR INY = IY .GE. ICSCR .AND. IY .LE. IDSCR IF ( .NOT. INX ) XSL = (IY - IY0) / FLOAT(IX - IX0) WHEN ( IX .GT. IBSCR ) IX = IBSCR ELSE IX = IASCR IY = XSL * (IX - IX0) + IY0 INY = IY .GE. ICSCR .AND. IY .LE. IDSCR FIN IF ( .NOT. INY ) YSL = (IX - IX0) / FLOAT(IY - IY0) WHEN( IY .GT. IDSCR ) IY = IDSCR ELSE IY = ICSCR IX = YSL * (IY - IY0) + IX0 FIN C RETURN END SUBROUTINE MOV1ST( XWRLD, YWRLD, IUD, LINTYP ) LOGICAL INSIDE, INX, INY, START_NEW COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /HCURPO/ IXCUR, IYCUR COMMON /CHKBON/ INSIDE, START_NEW, LINNTP, LIN1, DASH COMMON /LINDAT/ RDASH(11), RSPACE(11) C 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 WHEN ( LINTYP .GT. 0 ) LINNTP = MIN0( MAX0( LINTYP, 1 ), 8 ) DASH = SCRX * RDASH(LINNTP) FIN ELSE LINNTP = 0 FIN LIN1 = LINNTP IF ( INSIDE ) CALL DRDASH( IX, IY, IUD ) IXCUR = IX IYCUR = IY C RETURN END SUBROUTINE DRDASH( IX, IY, IUD ) INTEGER LIND(11) LOGICAL INSIDE, START_NEW REAL IDASH(11), ISPACE(11) COMMON /HWINDO/ SCRX,SCRY,IXORIG,IYORIG,IASCR,IBSCR,ICSCR,IDSCR COMMON /LINDAT/ IDASH, ISPACE COMMON /CHKBON/ INSIDE, START_NEW, 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 / C WHEN ( IUD .EQ. 1 .AND. LINNTP .NE. 0 ) DX = IX - X0 DY = IY - Y0 DS = SQRT( DX * DX + DY * DY ) IF ( DS .GT. 0. ) C = DX / DS S = DY / DS FIN WHILE ( DS .GT. 0. ) WHEN ( DASH .GT. 0. ) 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 ) FIN ELSE DDS = AMIN1 ( DS, SPACE ) DS = DS - DDS SPACE = SPACE - DDS IF( SPACE .LE. 0. ) LIN1 = LIND(LIN1) DASH = SCRX * IDASH(LIN1) FIN X0 = X0 + DDS * C Y0 = Y0 + DDS * S IX0 = X0 + .5 IY0 = Y0 + .5 CALL PLOT( IX0, IY0, 0 ) FIN FIN FIN ELSE CALL PLOT( IX, IY, IUD ) FIN X0 = IX Y0 = IY C RETURN END SUBROUTINE PLTSTR( IX, IY, STR, LEN, IROT, ISIZE ) BYTE STR(LEN) LOGICAL INX, INY COMMON /HFRAME/ IXMINF, IXMAXF, IYMINF, IYMAXF C INX = IX .GE. IXMINF .AND. IX .LE. IXMAXF INY = IY .GE. IYMINF .AND. IY .LE. IYMAXF IF ( INX .AND. INY ) CALL PLOT ( IX, IY, 0 ) CALL WRTSTR ( STR, LEN, IROT, ISIZE ) FIN C RETURN END SUBROUTINE DRWREC( XMIN, XMAX, YMIN, YMAX, ICOL ) C 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) C RETURN END SUBROUTINE TRIMSP( TITLE, LEN, IST, IEND ) BYTE TITLE(LEN) C IST = 1 IEND = LEN WHILE ( IST .LT. LEN .AND. TITLE(IST) .EQ. ' ' ) IST = IST + 1 WHILE ( IEND .GT. IST .AND. TITLE(IEND) .EQ. ' ' ) IEND = IEND - 1 C RETURN END SUBROUTINE TRIML( LABEL, N, LEN ) BYTE LABEL(N) C I = 1 WHILE ( I .LT. N .AND. LABEL(I) .EQ. ' ' ) I = I + 1 LEN = 0 DO ( J = I, N ) LEN = LEN + 1 LABEL(LEN) = LABEL(J) FIN C RETURN END FUNCTION ISCRX( XWRLD ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST C X = AMIN1( XWRLD * XSLOPE + XCONST, 32767. ) X = AMAX1 ( X, -32767. ) ISCRX = IFIX( X + .5 ) C RETURN END FUNCTION ISCRY( YWRLD ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST C Y = AMIN1 ( YWRLD * YSLOPE + YCONST, 32767. ) Y = AMAX1 ( Y, -32767. ) ISCRY = IFIX ( Y + .5 ) C RETURN END FUNCTION XWORLD( IX ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST C XWORLD = ( IX - XCONST ) / XSLOPE C RETURN END FUNCTION YWORLD( IY ) COMMON /HSCALE/ XSLOPE, XCONST, YSLOPE, YCONST C YWORLD = ( IY - YCONST ) / YSLOPE C RETURN END SUBROUTINE CURPOS( ICURX, ICURY ) COMMON /HCURPO/ IXCUR, IYCUR C ICURX = IXCUR ICURY = IYCUR C 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) C DO ( I = 1, 6 ) J2(I) = I2(I) DO ( I = 1, 4 ) J1(I) = I1(I) Y1(I) = X1(I) Y2(I) = X2(I) FIN C 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 C 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) C DO ( I = 1, 6 ) I2(I) = J2(I) DO ( I = 1, 4 ) I1(I) = J1(I) X1(I) = Y1(I) X2(I) = Y2(I) FIN C 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 / C Y(1) = YSTRT Y(2) = YSTRT X(2) = XX(2) CONDITIONAL ( INUM .LT. 0 ) NUM = -2 X(1) = XX(2) FIN ( INUM .GT. 0 ) NUM = 1 X(1) = XX(1) FIN ( INUM .EQ. 0 ) NUM = 0 X(1) = XX(1) FIN FIN 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 C 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) C CALL INILGN( 0., XBOND, 0., YBOND ) IST = 1 DO ( 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) FIN CALL ENDLGN C RETURN END SUBROUTINE INIPLT( IUNIT, XSIZE, YSIZE ) BYTE ESC, FF, SUB, ENQ, CHAR, MES(10), TRANS(2), VTBUFR(128) INTEGER VTPOS, VTBUFL INTEGER VCHR_WIDTH(5), VCHR_HEIGHT(5) INTEGER HCHR_WIDTH(5), HCHR_HEIGHT(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 VCHR_WIDTH, VCHR_HEIGHT / 7,10,20,30,40, 10,15,30,45,60 / DATA HCHR_WIDTH, HCHR_HEIGHT / 18,24,36,48,72, 24,36,54,72,108 / DATA IASCR, IBSCR, ICSCR, IDSCR, IXORIG, IYORIG, XCONST, YCONST 1 / 6 * 0, 2 * 0. / C ITTNUM = 7 LUNPLT = IUNIT VISUAL = LUNPLT .EQ. ITTNUM VTBUFL = 128 VTPOS = 0 IUPDWN = 0 WHEN ( VISUAL ) CALL WRITCH(TRANS, 2) CALL ERASE SCRX = 75. SCRY = 75. DO ( I = 1, 5 ) ICHW(I) = VCHR_WIDTH(I) ICHH(I) = VCHR_HEIGHT(I) FIN FIN ELSE IF ( IUNIT .EQ. 8 ) LUNPLT = ITTNUM CALL PLTON FIN CALL WRITCH(MES, 10 ) SCRX = 200. SCRY = 200. DO ( I = 1, 5 ) ICHW(I) = HCHR_WIDTH(I) ICHH(I) = HCHR_HEIGHT(I) FIN FIN 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 ) C 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',' ','@'/ C WHEN ( VISUAL ) CALL PLTOFF CALL DMPPLT FIN ELSE CALL WRITCH(MES, 12 ) IF( LUNPLT .EQ. ITTNUM ) CALL PLTOFF CALL DMPPLT FIN IF ( LUNPLT .NE. ITTNUM ) CLOSE( UNIT = LUNPLT ) C 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 / C WHEN ( VISUAL ) CALL WRITCH( MESV, 5 ) FIN ELSE IF( IUPDWN .EQ. 0 ) CALL WRITCH(MESH, 2) IUPDWN = 1 FIN C 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 / C WHEN ( VISUAL ) CALL WRITCH( MESV, 5 ) FIN ELSE IF( IUPDWN .EQ. 1 ) CALL WRITCH(MESH, 2) IUPDWN = 0 FIN C 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 ) C 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 WHEN ( INX .AND. INY ) IXCUR = IXL + ISY * IY IYCUR = IYL - ISX * IY MINLEN = MIN0( LEN, 80 ) WHEN ( .NOT. VISUAL ) ENCODE(4,3,MES) IRT, (ISZ+2)/2, IPLS(MOD(ISZ,2)+1) DO ( I = 1, MINLEN ) MES(I + 4 ) = STR(I) MES( MINLEN + 5 ) = 95 NUMCH = MINLEN + 5 FIN ELSE MES(1) = 27 MES(2) = 47 MES(3) = 48 MES(4) = 100 MES(5) = 31 MES(6) = 27 WHEN ( ISZ .EQ. 1 ) MES(7) = '0' ELSE MES(7) = '9' MES(8) = 27 MES(9) = INUM(ISZ) MES(10) = 27 MES(11) = 47 MES(12) = IRRT + 48 MES(13) = 101 DO ( I = 1, MINLEN ) MES(I + 13) = STR(I) NUMCH = MINLEN + 13 FIN CALL WRITCH(MES, NUMCH) FIN ELSE WHEN ( LUNPLT .EQ. ITTNUM ) CALL PLTOFF CALL DMPPLT TYPE 1, (STR(I), I = 1, LEN) TYPE 2 CALL PLTON FIN ELSE TYPE 1, (STR(I), I = 1, LEN) TYPE 2 FIN FIN C RETURN END SUBROUTINE MARKER( ISYM, ISIZE ) BYTE MES(4) INTEGER MARK_SIZE(5) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MARK_SIZE / 2, 3, 4, 6, 9 / 1 FORMAT('M ', 2I1) C ISZ = MAX0( MIN0(ISIZE, 5), 1 ) MRK = MIN0( MAX0(ISYM, 0), 5 ) WHEN ( VISUAL ) IW = MARK_SIZE(ISZ) CALL CURPOS( IX, IY ) SELECT ( MRK ) (0) ! PLUS SIGN CALL PLOT( IX-IW, IY, 0 ) CALL PLOT( IX+IW, IY, 1 ) CALL PLOT( IX, IY-IW, 0 ) CALL PLOT( IX, IY+IW, 1 ) FIN (1) ! CROSS 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 ) FIN (2) ! SQUARE 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 ) FIN (3) ! CIRCLE CALL CIRCLE( IX, IY, IW ) FIN (4) ! TRIANGLE 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 ) FIN (5) ! HOURGLASS 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 ) FIN FIN FIN ELSE ENCODE( 4, 1, MES ) ( ISZ + 2 ) / 2, MRK IF ( MOD( ISZ, 2 ) .EQ. 1 ) MES(2) = MES(3) MES(3) = '+' FIN CALL WRITCH(MES, 4) FIN C 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' ) C WHEN ( VISUAL ) CALL PENDWN ENCODE( 15, 2, MES ) 27, IX, IY, IR DO ( I = 1, 15 ) IF( MES(I) .EQ. ' ' ) MES(I) = '0' CALL WRITCH( MES, 15 ) FIN ELSE ENCODE( 16, 1, MES ) IX, IY, IR CALL WRITCH( MES, 16 ) FIN C RETURN END SUBROUTINE COLTYP( ICOL ) BYTE MES(2) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM C IF( .NOT. VISUAL ) ITYPE = ICOL + 1 ITYPE = MIN0(ITYPE, 8) ITYPE = MAX0(ITYPE, 1) MES(1) = 'P' MES(2) = ITYPE + 48 CALL WRITCH(MES, 2) FIN C 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 ) C IX0 = IX IY0 = IY C C CHECK TO SEE IF IN BOUNDS C CONDITIONAL ( IX0 .LT. IXMINF ) IX0 = IXMINF ( IX0 .GT. IXMAXF ) IX0 = IXMAXF FIN CONDITIONAL ( IY0 .LT. IYMINF ) IY0 = IYMINF ( IY0 .GT. IYMAXF ) IY0 = IYMAXF FIN WHEN (IUD .EQ. 1) CALL PENDWN ELSE CALL PENUP C WHEN ( .NOT. VISUAL ) ENCODE( 10, 1, MES ) IX0, IY0 CALL WRITCH(MES, 10) FIN ELSE 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) FIN IXCUR = IX0 IYCUR = IY0 C RETURN END SUBROUTINE ERASE BYTE MES(2) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MES / 27, 12 / C IF( VISUAL ) CALL WRITCH(MES, 2) C RETURN END SUBROUTINE PLTON BYTE MES(4) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MES/ 27, '[', '5', 'i' / C WHEN ( .NOT. VISUAL ) CALL WRITCH(MES,4) FIN ELSE CALL WRITCH(31,1) FIN C RETURN END SUBROUTINE PLTOFF BYTE MES(4) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA MES/ 27, '[', '4', 'i' / C WHEN ( .NOT. VISUAL ) CALL WRITCH(MES,4) FIN ELSE CALL WRITCH(24, 1) FIN C RETURN END SUBROUTINE WRITCH( CH, N ) BYTE VTBUFR(128), CH(N) INTEGER VTPOS, VTBUFL LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /VTBUF/ VTBUFR, VTPOS, VTBUFL C IF( VTPOS + N .GT. VTBUFL ) CALL DMPPLT DO ( I = 1, N ) VTPOS = VTPOS + 1 VTBUFR(VTPOS) = CH(I) FIN IF ( VTPOS .GE. VTBUFL ) CALL DMPPLT C RETURN END SUBROUTINE DMPPLT BYTE VTBUFR(128) INTEGER VTPOS, VTBUFL LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /VTBUF/ VTBUFR, VTPOS, VTBUFL 1 FORMAT( 1X, 128A1 ) 2 FORMAT( '+', 128( A1, $ ) ) C WHEN ( VISUAL ) WRITE(LUNPLT, 2) ( VTBUFR(I), I = 1, VTPOS ) ELSE WRITE(LUNPLT, 1) ( VTBUFR(I), I = 1, VTPOS ) VTPOS = 0 C RETURN END SUBROUTINE CONLGN( 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) LOGICAL VISUAL COMMON /LGND/ YSTART, DELY, DELX, X(2) COMMON /PAGSIZ/ XBOND, YBOND COMMON /CRSPOS/ IXX, IYY COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM DATA IXX, IYY, XST, XLN / -100, -100, -1., .15 / C IF( VISUAL ) CALL INILGN( 0., XBOND, 0., YBOND ) CALL DRWREC( 0., 1., 0., 1., 0 ) X(2) = XWORLD(IXX) - DELX X(1) = X(2) - XLN YSTART = YWORLD(IYY) + .5 * DELY IST = 1 DO ( I = 1, NL ) XLEN(I) = X(2) - X(1) XSTRT(I) = X(1) YSTRT(I) = YSTART CALL FNDCUR( IX, IY ) IF( IX .NE. IXX .OR. IY .NE. IYY ) XSTRT(I) = XWORLD(IX) YSTRT(I) = YWORLD(IY) CALL FNDCUR( IX, IY ) XLEN(I) = XWORLD(IX) - XSTRT(I) IF( XLEN(I) .LT. 0. ) XLEN(I) = XLN FIN X(1) = XSTRT(I) X(2) = XLEN(I) + XSTRT(I) YSTART = YSTRT(I) CALL WRILGN('', 0, ICOL(I), ISYM(I), INUM(I), LINTYP(I)) CALL CURPOS( IX, IY ) CALL GETSTR( IX, IY, TITLE(IST), N(I), 1, 2 ) IST = IST + N(I) XST = XSTRT(I) XLN = XLEN(I) FIN CALL ENDLGN FIN C RETURN END SUBROUTINE GETSTR( IX, IY, STR, LEN, IROT, ISIZE ) BYTE STR(80) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM COMMON /CHRSIZ/ ICHW(5), ICHH(5) 1 FORMAT( Q, 80A1) C IF( VISUAL ) CALL PLTSTR( IX, IY, '', 0, IROT, ISIZE ) CALL DMPPLT READ(5,1) LEN, (STR(J), J = 1, LEN ) ISZ = MIN0( 5, MAX0( 1, ISIZE ) ) ID = ICHH(2) IXX = IX + ID * ( IABS( MOD( IROT - 1, 4 ) - 1 ) - 1 ) IYY = IY + ID * ( 1 - IABS( MOD( IROT - 1, 4 ) - 2 ) ) CALL PUTCUR( IXX, IYY ) FIN C RETURN END SUBROUTINE REDSTR( IX, IY, STR, LEN, IROT, ISIZE ) BYTE STR(1) LOGICAL VISUAL COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM C IF( VISUAL ) CALL FNDCUR( IX, IY ) CALL GETSTR( IX, IY, STR, LEN, IROT, ISIZE ) FIN C RETURN END SUBROUTINE DEFWIN( XMIN, XMAX, YMIN, YMAX ) BYTE ESC, FF, SUB, ENQ, CHAR INTEGER IX, IY, JX, JY, B LOGICAL VISUAL COMMON /HBYTE/ ESC, FF, SUB, ENQ, CHAR COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM C IF( VISUAL ) CALL FNDCUR(IX, IY) CALL FNDCUR(JX, JY) IXN = MIN0( IX, JX ) IXX = MAX0( IX, JX ) IYN = MIN0( IY, JY ) IYX = MAX0( IY, JY ) XMIN = IXN / 75. XMAX = IXX / 75. YMIN = IYN / 75. YMAX = IYX / 75. FIN C RETURN END SUBROUTINE CURSON BYTE ESC, FF, SUB, ENQ, CHAR COMMON /HBYTE/ ESC, FF, SUB, ENQ, CHAR C CALL WRITCH(ESC, 1) CALL WRITCH(SUB, 1) CALL DMPPLT C RETURN END SUBROUTINE FNDCUR( IX, IY ) BYTE ESC, FF, SUB, ENQ, CHAR COMMON /HBYTE/ ESC, FF, SUB, ENQ, CHAR BYTE HIGHX, LOWX, HIGHY, LOWY 1 FORMAT( 5A1 ) C CALL CURSON READ(5, 1) HIGHX, LOWX, HIGHY, LOWY, CHAR IF ( CHAR .NE. 8 ) HIGHX = LOWX LOWX = HIGHY HIGHY = LOWY LOWY = CHAR FIN IHIGHX = HIGHX .AND. 31 ILOWX = LOWX .AND. 31 IHIGHY = HIGHY .AND. 31 ILOWY = LOWY .AND. 31 IX = IHIGHX * 32 + ILOWX IY = IHIGHY * 32 + ILOWY C RETURN END SUBROUTINE PUTCUR( IX, IY) BYTE ESC, FF, SUB, ENQ, CHAR LOGICAL VISUAL COMMON /HBYTE/ ESC, FF, SUB, ENQ, CHAR COMMON /CRSPOS/ IXX, IYY COMMON /DEVICE/ VISUAL, LUNPLT, ITTNUM C IF( VISUAL ) CALL PLOT( IX, IY, 0 ) CALL WRITCH( ESC, 1 ) CALL WRITCH( '/', 1 ) CALL WRITCH( 'f', 1 ) CALL WRITCH( ' ', 1 ) IXX = IX IYY = IY FIN C RETURN END