.lm 10 .rm 72 a .b 14 .c ;HGRAPH Documentation - July 11, 1983 .b 2 .c ;Written by .c ;H. L. McMaken .b 1 .c ;Applied Mathematical Sciences .c ;Ames Laboratory - USDOE .c ;Iowa State University .b 2 .c ;All rights (and wrongs) reserved .b 5 The following documents the line drawing routines developed for use on the LSI 11/23. These routines will work with either the Houston Instruments DMP-3 or DMP-29 pen plotter (HIPLOT), .X HIPLOT the Grinnell Systems GMR 271 image processing system (GRINNELL), .X GRINNELL or the Visual Products 550 (VISUAL). .X VISUAL .pg .c ;I. TERMINOLOGY .X terminology .b 2 In order to understand many of the routines included in this document, one must understand the terminology that is used. The reader will encounter such phrases as "screen coordinates", "world coordinates", "nominal inches", "plotting frame", "plotting window", and "plotting page". To understand these, consider the following diagram: .b 24 The plotting window .x plotting window contains the data to be plotted (the dashed line in the above). This data is "clipped" so that it will only appear inside the plotting window. The plotting frame .x plotting frame is a region outside of which no plotting may take place. The plotting window and the labels for the plotting window are contained within the plotting frame. The plotting window is defined relative to the lower left hand corner of the plotting frame. The plotting page .x plotting page is the maximum allowable plotting area. This is dependent on the device used. For the HIPLOT this is 10.25 by 7.25 units, for the GRINNELL this is 10.22 by 10.22 units, and for the VISUAL this is 10.24 by 7.8 units. These units are expressed in "nominal inches". .x nominal inch On the HIPLOT these are actual inches. These nominal inches provide a global coordinate .x coordinates, global system independent of the given device. World coordinates .x coordinates, world are the coordinates associated with the data to be plotted. Screen coordinates .x coordinates, screen are the coordinates used internally by the plotting device. .pg .c ;II. GETTING STARTED. .X getting started .b 2 For the casual user, there are several higher level routines which should be of interest. These are divided into three catagories: initializing and terminating plots, drawing two dimensional plots, and drawing three dimensional plots. For more advanced users, additional categories entitled Additional Routines and Auxiliary Routines are included. .b 1 To get started, consider the following simple example program. It first generates the data to be plotted into the x and y arrays. The next six statements initialize the plotting device and plotting routines, plot the data, and terminate the plot. These six routines are in general the only routines one needs to use to create a two-dimensional plot. A brief description of each routine follows. A more detailed description follows in subsequent sections. .B 1 .x examples .X INIPLT .X WINDOW .X VUPORT .X AXIS .X LINE .X ENDPLT .LIT DIMENSION X(41), Y(41) C DO 10 I = 1, 41 X(I) = .05 * ( I - 1 ) Y(I) = SIN( 3.141592654 * X(I) ) 10 CONTINUE C CALL INIPLT( 99, 10., 7. ) CALL WINDOW( 2., 8., 2., 6. ) CALL VUPORT( 0., 2., -1., 1. ) CALL AXIS( .5, .5, 'x', 1, 2, 1, 'sin', 3, 2, 1 ) CALL LINE( X, Y, 41, 0, 0, 0, 0 ) CALL ENDPLT C END .ELI .B 1 The above produces the following plot. .pg Subroutine INIPLT .x INIPLT initializes the plotting device and plotting routines. The arguments indicate that the data is to be written to FTN99.DAT, and that the plotting page is 10 by 7 nominal inches. Subroutine WINDOW .x WINDOW defines the plotting window. The plotting window defined in the program is 6 by 4 nominal inches starting at location (2,2). Subroutine VUPORT .x VUPORT sets up the correspondence between the world coordinates and the screen coordinates. For this program, the horizontal axis runs from 0 units to 2 units, while the vertical axis runs from -1 units to 1 units. Subroutine AXIS .x AXIS draws a box around the plotting window, draws tick marks every .5 units on the horizontal and vertical axes, and labels these tick marks. It centers a lower case 'x' under the horizontal axis, and a lower case 'sin' to the left of the vertical axis. Subroutine LINE .X LINE connects the points to be plotted by line segments. Subroutine ENDPLT .x ENDPLT terminates the plot. .pg .c ;III. INITIALIZING AND TERMINATING PLOTS. .X initializing plots .X terminating plots .b 2 The following statements initialize and terminate plotting: .b 1 .lit SUBROUTINE INIPLT SUBROUTINE DMPPLT SUBROUTINE ENDPLT .eli .x INIPLT .X DMPPLT .X ENDPLT .b 1 To start the plot, the user must first initialize the plotting routines. This requires that the following statement be executed PRIOR to calling any other plotting routine: .b 1 CALL INIPLT(iunit, xsize, ysize) .x INIPLT .b 1 This routine initializes the plot. The variables xsize and ysize denote the size of the plotting page in nominal inches. For the HIPLOT .X HIPLOT , this is the size of the paper. HIPLOT has a .X HIPLOT maximum length of 10.25 inches and a height of 7.25 inches. Setting xsize larger than 10.25, or ysize larger than 7.25 may cause the limit switches to be activated during the plot. This will cause unpredictable results. No plotting is permitted outside this area. The maximum size of the plot on the GRINNELL .X GRINNELL is 10.22 by 10.22. The maximum size of the plot on the VISUAL .X VISUAL is 10.24 by 7.8. For compatability between devices, bounds within the common intersection should be chosen. .b 1 The variable iunit is the logical unit number selected to contain the plot commands. When plotting on the GRINNELL .X GRINNELL the variable iunit is ignored. The following table indicates the conventions used on the 11/23 for the HIPLOT and the VISUAL. .x HIPLOT .X VISUAL .pg The logical unit number equal to 7 is associated with the user's terminal. When iunit is equal to 7 the plot is sent directly to the terminal. Hence, the HIPLOT .X HIPLOT must be connected to the printer port if you are to see the plot. The software will automatically enable the printer port prior to sending the data, and disable the printer port upon completion of the plot. Since the terminal for the VISUAL .X VISUAL is the plotting device, setting iunit = 7 will display the plot immediately. The plotting instructions generated by the program are not stored in a file and are lost upon termination of the program. Setting iunit = 9, sends the plot directly to the queued plotting device. This is a HIPLOT device and will not understand the data generated by a plot for the VISUAL. .X HIPLOT .X VISUAL Hence, DO NOT USE iunit = 9 with the VISUAL. .X VISUAL To save a copy of the plot use iunit = 10 to 99. It is the user's responsibility to see that saved copies of the plot are backed up. .b 1 To dump the buffer so that the entire plot may be seen, place the following statement in your program: .b 1 CALL DMPPLT .x DMPPLT .b 1 Subroutine DMPPLT is useful for maintaining synchronized I/O for .X DMPPLT interactive plotting, without the hassle of recalling INIPLT and ENDPLT. .x ENDPLT .b 1 To terminate a plot, place the following statement in your program: .b 1 CALL ENDPLT .x ENDPLT .b 1 This routine terminates the plotting. It must be the last plotting routine called if the entire plot file is to be viewed. No other plotting routine may follow without first calling INIPLT. .x INIPLT .pg .C ;IV. TWO DIMENSIONAL PLOTS. .X two dimensional plots .b 2 For two dimensional plots the following routines should be used. .b 1 .X FRAME .X WINDOW .X VUPORT .X AXIS .X DASHLN .X LINE .lit CALL FRAME CALL WINDOW CALL VUPORT CALL AXIS CALL DASHLN CALL LINE .eli .b 1 These are described below. .b 1 SUBROUTINE FRAME(xmin, xmax, ymin, ymax) .X FRAME .b 1 This routine allows the user to select the plotting frame. No plotting may take place outside of this region. Subroutine FRAME maps the origin into the point (xmin, ymin). The usefulness of this routine is in producing multiple plots on a single page. In this case one would like to make sure that parts of one plot do not overwrite parts of other plots. By specifying limits, one can control where plotting can take place. The variables xmin and xmax are the minimum and maximum horizontal dimensions in inches of the allowable plotting area, and the variables ymin and ymax are the minimum and maximum vertical dimensions. Subroutine FRAME need not be called unless desired. However, the first call to FRAME must follow INIPLT and preceed calls .X FRAME .x INIPLT .X WINDOW .X VUPORT to WINDOW and VUPORT. Subsequent calls to subroutine FRAME will automatically update the transformation from world to screen coordinates using the arguments of the last call to WINDOW and VUPORT. The position of the plotting window will be in the same place relative to the point (xmin, ymin) as the previous plot. If FRAME is not called, the origin is taken to be the lower left hand corner of the plotting page. .b 1 SUBROUTINE WINDOW(xwin0, xwin1, ywin0, ywin1) .X WINDOW .b 1 This routine sets up the dimensions of the plotting window. The variables xwin0, xwin1, ywin0, and ywin1 are the bounds in inches of this window. The values xwin0, xwin1, ywin0 and ywin1 are given relative to the last call to FRAME. .b 1 SUBROUTINE VUPORT (xmin, xmax, ymin, ymax) .X VUPORT .b 1 This routine sets up the correspondence between the world coordinates and the screen coordinates. World coordinates are the coordinates associated with the data to be plotted. Screen coordinates are the coordinates use by the plotting device. The variables xmin and xmax represent respectively, the minimum and maximum x-values to be plotted. The variables ymin and ymax represent respectively, the minimum and maximum y-values to be plotted. The point (xmin, ymin) will be plotted at (xwin0, ywin0). The point (xmax, ymax) will be plotted at (xwin1, ywin1). Values falling outside this viewport will be clipped. The default values for (xmin, ymin) and (xmax, ymax) are (0, 0) and (1, 1), respectively. A call to VUPORT is not needed after a call to WINDOW. .X VUPORT .X WINDOW This feature is useful for multiple plots in which the scaling of the x and y axes do not change. To draw a second plot on the same page ( or screen ) the user need only issue a call to WINDOW to move the plotting window. This will adjust the coordinate transformation between world and screen coordinates so that the previous values supplied by VUPORT are now plotted at the positions indicated by the arguments of the call to WINDOW. Note, however, that merely changing WINDOW will not guaranty that one plot will not overwrite another plot. To insure this, the user should use FRAME. .X VUPORT .X WINDOW .b 1 .lit SUBROUTINE AXIS(xtic, ytic, ixtit, ixlen, ixsiz, ixfmt, iytit, iylen, iysiz, iyfmt) .eli .X AXIS .b 1 This routine draws the axes for two dimensional plots. The variables xtic and ytic are the distances in world coordinates between tick marks on the x and y axes. The variable ixtit is the label for the x-axis. The variable ixlen is the number of characters in ixtit. The variable ixsiz is the size (value between 1 and 5) of the x label. For the HIPLOT .X HIPLOT the following sizes are available: .lm +5 .nf .b 1 For ixsiz = 1 the characters are 0.07 inch high. For ixsiz = 2 the characters are 0.14 inch high. For ixsiz = 3 the characters are 0.28 inch high. For ixsiz = 4 the characters are 0.56 inch high. For ixsiz = 5 the characters are 1.12 inch high. .b 1 .lm -5 For the GRINNELL the following sizes are avialable: .X GRINNELL .lm +5 .b 1 For ixsiz = 1 the characters are 0.16 inch high. For ixsiz = 2 the characters are 0.16 inch high. For ixsiz = 3 the characters are 0.32 inch high. For ixsiz = 4 the characters are 0.32 inch high. For ixsiz = 5 the characters are 0.32 inch high. .b 1 .lm -5 For the VISUAL the following sizes are avialable: .X VISUAL .lm +5 .b 1 For ixsiz = 1 the characters are 0.11 inch high. For ixsiz = 2 the characters are 0.15 inch high. For ixsiz = 3 the characters are 0.29 inch high. For ixsiz = 4 the characters are 0.44 inch high. For ixsiz = 5 the characters are 0.59 inch high. .b 1 .lm -5 .f If ixsiz is outside of this range, ixsiz is reset to 2. The variable ixfmt defines the format of the values on the x-axis. For ixfmt = 0 to 3, the format is taken to be F9.ixfmt. For ixfmt = 4, the format is E9.2. The variables iytit, iylen, iysiz and iyfmt are defined in a corresponding way for the y-axis. .b 1 .tp 5 SUBROUTINE DASHLN(x, y, n, icol, isym, isize, inum, lintyp) .b 1 This subroutine will draw dashed lines of a user controlled color through the n coordinate points (x, y). The variables x and y are n-dimensional arrays. The variable isym is the symbol to be plotted at the points. The GRINNELL .X GRINNELL and VISUAL .X VISUAL currently do not support symbol plots. The value of isym must be between 0 and 5. For isym = 0 a plus sign is plotted, for isym = 1 a cross is plotted, for isym = 2 a square is plotted, for isym = 3 a circle is plotted, for isym = 4 a triangle is plotted, and for isym = 5 an hourglass is plotted. The variable isize is the size of the symbol. The value of isize must be between 1 and 5. The size of the symbol is given in inches by .035 * 2 ** isize. A symbol is plotted every abs(inum) points. If inum is negative, only symbols are plotted. If any of the following are out of range, only a line is drawn: isym, isize, inum. The variable icol determines the color of the line. For the GRINNELL .X GRINNELL the folowing colors are avialable: .nf .lm +5 .b 1 For icol = 0, a white line is drawn. For icol = 1, a red line is drawn. For icol = 2, a orange line is drawn. For icol = 3, a yellow line is drawn. For icol = 4, a green line is drawn. For icol = 5, a blue line is drawn. For icol = 6, a purple line is drawn. .lm -5 .b 1 For the HIPLOT .x HIPLOT the following association between icol and color is suggested: .lm +5 .b 1 For icol = 0, a black line is drawn. For icol = 1, a red line is drawn. For icol = 2, a orange line is drawn. For icol = 3, a lime-green line is drawn. For icol = 4, a green line is drawn. For icol = 5, a blue line is drawn. For icol = 6, a lavender line is drawn. For icol = 7, a brown line is drawn. .lm -5 .f .b 1 The parameter lintyp controls the type of dashed line drawn. For lintyp equal to 0, a solid line is drawn; for lintyp equal to 1, a dotted line is drawn, for lintyp between 2 and 6, a dashed line of increasing dash length is drawn, for lintyp equal to 7 a dash-dot line is drawn, and for lintyp equal to 8, a dash-dot-dot line is drawn. .b 1 SUBROUTINE LINE(x, y, n, icol, isym, isize, inum) .X LINE .b 1 This routine draws a solid line through the n world coordinates, (x, y). The arguments of LINE are the same as described above for DASHLN. .X DASHLN .b 2 The following details the relation between INIPLT, FRAME and WINDOW. .X FRAME .X WINDOW .x INIPLT .b 1 Subroutine INIPLT sets up the maximum size of the plot (plotting page). This is either .x INIPLT the physical size of the paper for the HIPLOT .X HIPLOT (i.e., 10.25 x 7.25 inches), the size of the GRINNELL .X GRINNELL screen (i.e., 10.22 x 10.22 nominal inches) or the size of the VISUAL .x VISUAL screen (i.e., 10.24 x 7.8 nominal inches). Within this region you may futher divide the plotting page by framing certain portions of it. Within each plotting frame you can specify a plotting window. The lines drawn as part of the plot of x and y coordinate pairs will be contained within the plotting window. The labels for the axes will be contained within the plotting frame. The plotting frame will be contained within the plotting page (see the section on TERMINOLOGY). As an example, the following program will divide the plotting page into four separate regions in which a copy of a plot of sin(x) and cos(x) from 0 to 6.28 is drawn. The plot produced by this program is shown below. .pg .x examples .X INIPLT .X FRAME .X WINDOW .X VUPORT .X AXIS .X DASHLN .X ENDPLT .lit DIMENSION X(41), S(41), C(41) C C CALCULATE X AND Y VALUES C DO 10 I = 1, 41 X(I) = .157 * ( I - 1 ) C(I) = COS( X(I) ) S(I) = SIN( X(I) ) 10 CONTINUE C C SET PHYSICAL PAGE SIZE TO BE 10 X 7 INCHES C CALL INIPLT( 99, 10., 7. ) C C SELECT LOWER LEFT HAND QUARTER AS PLOTTING FRAME C CALL FRAME ( 0., 5., 0., 3.5 ) CALL WINDOW( 1.5, 4.5, 1., 3. ) CALL VUPORT( 0., 6.28, -1., 1. ) CALL AXIS ( 1., .5, 'x', 1, 2, 0, 'y(x)', 4, 2, 1 ) CALL DASHLN ( X, C, 41, 0, 0, 0, 0, 1 ) CALL DASHLN ( X, S, 41, 1, 0, 0, 0, 2 ) C C DRAW SECOND PLOT IN UPPER LEFT C NOTE THAT FRAME WILL AUTOMATICALLY ADJUST WINDOW AND VUPORT C FOR YOU C CALL FRAME ( 0., 5., 3.5, 7. ) CALL AXIS ( 1., .5, 'x', 1, 2, 0, 'y(x)', 4, 2, 1 ) CALL DASHLN ( X, C, 41, 2, 0, 0, 0, 3 ) CALL DASHLN ( X, S, 41, 3, 0, 0, 0, 4 ) C C DRAW THIRD PLOT IN UPPER RIGHT C CALL FRAME ( 5., 10., 3.5, 7. ) CALL AXIS ( 1., .5, 'x', 1, 2, 0, 'y(x)', 4, 2, 1 ) CALL DASHLN ( X, C, 41, 4, 0, 0, 0, 5 ) CALL DASHLN ( X, S, 41, 5, 0, 0, 0, 6 ) C C DRAW FOURTH PLOT IN LOWER RIGHT C CALL FRAME ( 5., 10., 0., 3.5 ) CALL AXIS ( 1., .5, 'x', 1, 2, 0, 'y(x)', 4, 2, 1 ) CALL DASHLN ( X, C, 41, 6, 0, 0, 0, 7 ) CALL DASHLN ( X, S, 41, 6, 0, 0, 0, 8 ) C C TERMINATE PLOTTING C CALL ENDPLT C END .eli .pg .C ;V. THREE DIMENSIONAL PLOTS. .X three dimensional plots .b 2 Three dimensional plots with hidden line removal are handled by the following routine: .b 1 CALL PLOT3D(f,x,y,nx,ny,xw,yw,xview,yview,zview,line,scale) .X PLOT3D .b 1 The variable f is an nx by ny array containing the values of the surface to be plotted. The variables x and y are also nx by ny arrays. They are used internally by PLOT3D for storing the x and y plot coordinates. The variables nx and ny are the dimensions of the f, x, and y arrays. The variables xw and yw are the dimensions of the plot in inches. The variables xview, yview and zview are the location in inches of the point of observation relative to the grid. The grid is xw by yw. The variable line chooses which direction(s) the projected grid lines are drawn. If line = 1, only lines in the x direction are drawn. If line = 2, only lines in the y direction are drawn. For line = 0, lines are drawn in both the x and y directions. The variable scale is a scaling factor for the array f. For scale = 0, a suitable scaling factor is chosen by PLOT3D. .b 1 A sample program is given below. .b 1 .tp 25 .X examples .X INIPLT .X PLOT3D .X ENDPLT .lit DIMENSION F(21, 11), X(21, 11), Y(21, 11) C PI = 3.141592654 TYPE 2 ACCEPT *, IUNIT C CALL INIPLT(IUNIT, 10., 7.) C DO 20 J = 1, 11 XX = .1 * (J - 1) DO 10 I = 1, 21 YY = .1 * (I - 1) F(I, J) = COS(PI * XX) * SIN(PI * YY) 10 CONTINUE 20 CONTINUE C TYPE 1 ACCEPT *, LINE, XV, YV, ZV C CALL PLOT3D(F,X,Y,21,11,10.,5.,XV,YV,ZV,LINE,0.) CALL ENDPLT C STOP 1 FORMAT('$INPUT LINE, XV, YV, ZV? ') 2 FORMAT('$INPUT IUNIT? ') END .eli .pg With line = 0, XV = 20, YV = 30 and ZV = 40, the above program produces the following plot. .b 1 With line = 0, XV = -10, YV = 30 and ZV = 40, the program produces this plot. .pg .C ;VI. ADDITIONAL ROUTINES. .X additional routines .b 2 SUBROUTINE ERASE .X ERASE .b 1 Subroutine ERASE has been added to the software package in order to erase the GRINNELL .X GRINNELL or VISUAL .X VISUAL screen without reissuing a call to INIPLT. This has the advantage of not resetting all of the internal .x INIPLT .X WINDOW .X VUPORT saved parameters generated by calls to WINDOW, VUPORT, etc.. This routine has no effect for plots on the HIPLOT. .X HIPLOT .b 1 SUBROUTINE PLTOFF .X PLTOFF .b 1 Subroutine PLTOFF will disable the printer port when plotting on the HIPLOT using iunit = 7, or will enable the alphanumerics screen on the VISUAL. .X HIPLOT .X VISUAL When used with PLTON, it allows the user to enter data to the program while it is plotting data. Innocently typing in data while the printer port is enabled can cause erratic behavior on the HIPLOT. .X HIPLOT A similar transgression on the VISUAL .X VISUAL results in the plot being overwritten. .B 1 SUBROUTINE PLTON .X PLTON .b 1 Subroutine PLTON will enable the printer port when plotting on the HIPLOT using iunit = 7, or will enable the alphagraphics screen on the VISUAL. .X HIPLOT .X VISUAL .b 1 SUBROUTINE MOVETO( xwrld, ywrld, iud, lintyp ) .X MOVETO .b 1 Subroutine MOVETO will move from the current cursor position to the world coordinate (xwrld, ywrld) if it is inside the plotting window, otherwise it will move to the intersection of the plotting window. MOVETO will draw a line only when iud is equal to one. The type of line drawn is determined by lintyp. .b 1 FUNCTION ISCRX( xwrld ) .x ISCRX .b 1 Function ISCRX converts the x world coordinate into the x screen coordinate. .b 1 FUNCTION ISCRY( ywrld ) .x ISCRY .b 1 Function ISCRY converts the y world coordinate into the y screen coordinate. .b 1 FUNCTION XWORLD( ix ) .x XWORLD .b 1 Function XWORLD converts the x screen coordinate to the x world coordinate. .b 1 .pg FUNCTION YWORLD( iy ) .x YWORLD .b 1 Function YWORLD converts the y screen coordinate to the y world coordinate. .b 1 SUBROUTINE CURPOS( icurx, icury ) .x CURPOS .b 1 Subroutine CURPOS returns the current screen coordinates into icurx and icury. .b 1 SUBROUTINE PLTSTR( ix, iy, str, len, irot, isize ) .X PLTSTR .b 1 Subroutine PLTSTR will write an alphanumeric string 'str' of length 'len' at screen location given by (ix, iy). The height of the string is determined by isize (see AXIS .X AXIS for the relevant sizes of the characters). The argument irot determines the rotation of the string. For irot = 1 the string is written right side up, for irot = 2 the string is rotated clockwise through 90 degrees, for irot = 3 the string is rotated 180 degrees, and for irot = 4 the string is rotated through 270 degress. .pg .C ;VII. RUNNING A PROGRAM. .X running a program .b 2 .X VIPLOT .X GRPLOT .X GRLIB .X HIX .X VIX .X GRX To compile, link and run a program which will plot on the HIPLOT, .X HIPLOT the GRINNELL .X GRINNELL or the VISUAL, .X VISUAL the following sequence is used. For the HIPLOT .X HIPLOT use, .b 1 .lm +5 .lit FORT filespec LINK filespec,SY:HIPLOT RUN filespec .eli .lm -5 .b 1 or .b 1 .lm +5 HIX filespec .lm -5 .b 1 For the GRINNELL .X GRINNELL use, .b 1 .lm +5 .lit FORT filespec LINK filespec,SY:GRPLOT,SY:GRLIB RUN filespec .eli .lm -5 .b 1 or .b 1 .lm +5 GRX filespec .lm -5 .b 1 For the VISUAL .X VISUAL use, .b 1 .lm +5 .lit FORT filespec LINK filespec,SY:VIPLOT RUN filespec .eli .lm -5 .b 1 or .b 1 .lm +5 VIX filespec .lm -5 .b 1 The files SY:HIPLOT, SY:GRPLOT, and SY:VIPLOT are object modules containing the device dependent plotting routines. The file SY:GRLIB is an object library of routines for the GRINNELL. Listings of the routines contained in each of the object modules are located on the system disk as SY:name.LST. The FORTRAN source is also contained on the system disk. The FORTRAN source and listing file for the device independent routines are on the system disk as SY:HGRAPH.FOR and SY:HGRAPH.LST, respectively. .pg .C ;VIII. DISPLAYING A DISK PLOT FILE. .X displaying a disk plot file .b 2 To display a disk plot file containing the device instructions for either the HIPLOT or the VISUAL, .X HIPLOT .X VISUAL one should use one of the following. To display a plot on the VISUAL type, .B 1 .i 5 TYPE filspec .b 1 To display a plot on the HIPLOT connected to a printer port type, .b 1 .i 5 TYPLOT filspec .b 1 To display a plot on the queued HIPLOT device type, .b 1 .i 5 COPY filspec PT: .I 5 SPOOL PT FORM=STD .b 1 The letters STD must be capitalized. As an example, suppose you generated a plot using the VISUAL software with iunit=99. This created a disk file named FTN99.DAT. To display this file on the VISUAL type the following: .b 1 .i 5 TYPE FTN99.DAT .pg .C ;IX. AUXILIARY ROUTINES. .X auxiliary routines .b 2 The following lower level routines have been included for completness. These routines should not be used unless absolutely needed, as their function may change without notice. .b 1 SUBROUTINE COLTYP(icol) .x COLTYP .b 1 This routine sets the line color. It is inoperative for the VISUAL and the single pen HIPLOT. .x VISUAL .X HIPLOT .b 1 SUBROUTINE DASH( ix, iy, iud, lintyp ) .X DASH .b 1 This routine will draw a dashed line of type lintyp from the current position to the screen coordinate (ix, iy). .b 1 SUBROUTINE INSECT(i1, j1, iplot, iplot0, x, y, nx, ny, l) .x INSECT .b 1 This routine computes the intersection point of a grid line which is partially hidden. It is used by PLOT3D. .b 1 SUBROUTINE MARKER(mrknum, isize) .X MARKER .b 1 This routine places a marker at the current position. It is nonfunctional for the VISUAL and GRINNELL .X VISUAL .X GRINNELL .b 1 SUBROUTINE MOV1ST( xwrld, ywrld, lintyp ) .X MOV1ST .b 1 Subroutine MOV1ST moves to the world coordinate (xwrld, ywrld). The argument lintyp refers to the type of line to be initialized (see DASHLN .X DASHLN for details on the types of lines available). .b 1 SUBROUTINE PENDWN .X PENDWN .b 1 This routine puts the pen down so it will draw a visible line. It is applicable only for HIPLOT and VISUAL. .X VISUAL .X HIPLOT .b 1 SUBROUTINE PENUP .X PENUP .b 1 This routine puts the pen up so no line is drawn. It is applicable only for HIPLOT and VISUAL. .b 1 SUBROUTINE PLOT(ix, iy, i) .X PLOT .b 1 This routine moves to the screen coordinates (ix, iy). If i = 0, the pen is put up before moving, if i = 1, the pen is put down before moving. It checks to see if within page boundary. .b 1 .pg SUBROUTINE PLOTIN(x, y, i) .X PLOTIN .b 1 This routine moves to the point (x, y) where x and y are given in nominal inches. If i=0, pen is put up before plotting, otherwise the pen is put down. .b 1 SUBROUTINE TRIML( str, n, len ) .x TRIML .b 1 This routine trims leading blanks from the string STR of length n. It returns in LEN the length of the trimmed string and in STR the string left justified with all blanks removed. .b 1 SUBROUTINE WRITCH(ch) .X WRITCH .B 1 This routine is used by the VISUAL to output characters to either the terminal or a disk file. The argument ch is a single byte. .b 1 SUBROUTINE WRTSTR(str, len, irot, isize) .X WRTSTR .b 1 This routine writes a string at the current location. The argument len is the length of the string; irot determines the rotation of the string (1 - 4), 1 is right side up, 2 is rotated 90 degrees clockwise, etc.; and isize is the size of the string (1 <= isize <= 5). The string is checked to see if in is in bounds. .ax DEVICE INDEPENDENT ROUTINES .X device independent routines .rm 80 .x FRAME, listing .lit 0001 SUBROUTINE FRAME (xmin, xmax, ymin, ymax) c c this routine frames a plot, i.e., no plotting of any kind c may take place outside of this frame without issuing a new c call to frame c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 common /pagsiz/ xbond, ybond c 0004 xn = amax1 ( 0., xmin ) 0005 xx = amin1 ( float(xbond), xmax ) 0006 yn = amax1 ( 0., ymin ) 0007 yx = amin1 ( float(ybond), ymax ) 0008 xmo = xmid 0009 ymo = ymid 0010 xmid = .5 * scrx * ( xx + xn ) 0011 ymid = .5 * scry * ( yx + yn ) 0012 dxb = .5 * scrx * ( xx - xn ) 0013 dyb = .5 * scry * ( yx - yn ) c 0014 dxo = xmid - xmo 0015 dyo = ymid - ymo 0016 ixorig = scrx * xn 0017 iyorig = scry * yn c c move window into frame c 0018 iascr = iascr + dxo 0019 ibscr = ibscr + dxo 0020 icscr = icscr + dyo 0021 idscr = idscr + dyo 0022 xm = xm + dxo 0023 ym = ym + dyo c c move view port into frame c 0024 xconst = xconst + dxo 0025 yconst = yconst + dyo c 0026 return 0027 end .eli .pg .x WINDOW, listing .lit 0001 SUBROUTINE WINDOW(xwin0, xwin1, ywin0, ywin1) c c this subroutine sets the dimensions of the plotting window. c xwin0, xwin1, ywin0, and ywin1 are the bounds in inches of c the plotting window. the actual plot less labels are contained c within this window. scaling is performed by subroutine setwin. c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 common /world/ xmin, xmax, ymin, ymax c c convert from inches to plot coordinates c 0004 iascr = scrx * xwin0 + ixorig 0005 ibscr = scrx * xwin1 + ixorig 0006 icscr = scry * ywin0 + iyorig 0007 idscr = scry * ywin1 + iyorig c 0008 dx = .5 * (ibscr - iascr) 0009 dy = .5 * (idscr - icscr) 0010 xm = .5 * (ibscr + iascr) 0011 ym = .5 * (idscr + icscr) c 0012 call vuport ( xmin, xmax, ymin, ymax ) 0013 return 0014 end .eli .pg .x VUPORT, listing .lit 0001 SUBROUTINE VUPORT(awrld, bwrld, cwrld, dwrld) c c this subroutine sets up the correspondence between the c world coordinates and the screen coordinates by initializing c the variables xslope, yslope, xconst and yconst which c implicitly define the affine map from world to screen c coordinates through the formulas c c xscr = xwrld * xslope + xconst c yscr = ywrld * yslope + yconst c c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 common /world/ xmin, xmax, ymin, ymax c 0004 xmin = awrld 0005 xmax = bwrld 0006 ymin = cwrld 0007 ymax = dwrld c 0008 xslope = (ibscr - iascr) / (bwrld - awrld) 0009 yslope = (idscr - icscr) / (dwrld - cwrld) c 0010 xconst = - xslope * awrld + float(iascr) 0011 yconst = - yslope * cwrld + float(icscr) c 0012 return 0013 end .eli .pg .x AXIS, listing .lit 0001 SUBROUTINE AXIS(xtic, ytic, ixtit, ixlen, ixsiz, ixfmt, 1 iytit, iylen, iysiz, iyfmt) c c draws axes for two dimensional plots. xtic and ytic are the c distances between tick marks on the x and y axes. ixtit is the c label for the x axis. ixlen is the length of the x label. ixsiz c is the size (1 - 5) of the x label. iytit, iylen and iysiz have c obvious cooresponding definitions. c 0002 byte ixtit(ixlen), iytit(iylen), label(9) 0003 integer fmt(2) , emt, num(5), form(3) 0004 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0005 data fmt / '(F', '9.' / 0006 data emt / '(E' / 0007 data num / '0)', '1)', '2)', '3)', '2)' / c c draw window (plot) boundary c 0008 call coltyp(0) 0009 call plot(iascr, icscr, 0) 0010 call plot(ibscr, icscr, 1) 0011 call plot(ibscr, idscr, 1) 0012 call plot(iascr, idscr, 1) 0013 call plot(iascr, icscr, 1) c 0014 idx = ifix(xtic * xslope) 0015 idy = ifix(ytic * yslope) 0016 iy = icscr 0017 n = (ibscr - iascr) / idx - 1 ccc c c The following code puts tick marks and labels on the horizontal axis c 0018 is = iascr c c set up format of labels for horizontal axis c 0019 iform = max0 ( 0 , ixfmt ) 0020 form(1) = fmt(1) 0021 form(2) = fmt(2) 0022 form(3) = num( min0( 5 , iform + 1) ) 0023 if ( iform .gt. 3 ) form(1) = emt 0024 c c label tick mark on left end of horizontal axis c c compute value, translate and trim leading blanks c 0025 xmin = xworld( iascr ) 0026 encode ( 9 , form, label ) xmin 0027 call triml(label, 9, len) c c remove decimal point for integer label c 0028 if ( iform .eq. 0 ) len = len - 1 0029 c c determine size of label and center c 0030 ixl = len * ichar(ixsiz) 0031 ix = is - ixl / 2 0032 iy = icscr - (ichar(ixsiz) * 7) / 3 c c write label c 0033 call pltstr(ix, iy, label , len , 1 , ixsiz) c c draw ticks and write labels on the interior of horizontal axis c 0034 lentic = scrx / 4 c c if n < = 0 then there will be no tick marks drawn nor any labels c written on the horizontal axis c 0035 if(n .le. 0)goto 20 0037 do 10 i = 1, n 0038 is = is + idx c c draw tick mark c 0039 call plot(is, icscr, 0) 0040 call plot(is, icscr + lentic, 1) c c label tick mark c 0041 xmin = xmin + xtic 0042 encode ( 9 , form, label ) xmin 0043 call triml(label, 9, len) 0044 if ( iform .eq. 0 ) len = len - 1 0046 ixl = len * ichar(ixsiz) 0047 ix = is - ixl / 2 c 0048 call pltstr(ix, iy, label , len , 1 , ixsiz) c 0049 10 continue c c label tick mark on right end of horizontal axis c 0050 20 continue 0051 is = is + idx 0052 xmin = xmin + xtic 0053 encode ( 9 , form, label ) xmin 0054 call triml(label , 9, len) 0055 if ( iform .eq. 0 ) len = len - 1 0057 ixl = len * ichar(ixsiz) 0058 ix = is - ixl / 2 c 0059 call pltstr(ix, iy, label , len , 1 , ixsiz) c c trim leading and trailing blanks c 0060 do 23 i = 1, ixlen 0061 if ( ixtit(i) .ne. ' ' ) goto 25 0063 23 continue 0064 i = ixlen c 0065 25 continue c 0066 do 27 j = ixlen, i, -1 0067 if ( ixtit(j) .ne. ' ' ) goto 29 0069 27 continue 0070 j = i c 0071 29 continue c c center horizontal title and plot c 0072 ixln = j + 1 - i 0073 ixl = ixln * ichar(ixsiz) 0074 ix = (iascr + ibscr - ixl) / 2 0075 iy = iy - (7 * ichar(ixsiz)) / 3 c 0076 call pltstr(ix, iy, ixtit(i), ixln, 1, ixsiz) c 0077 ix = iascr 0078 n = ( idscr - icscr ) / idy - 1 ccc c c The following code puts tick marks and labels on the vertical axis c 0079 call plot(iascr, icscr, 0) 0080 is = icscr c c set up format of labels for vertical axis c 0081 iform = max0 ( 0 , iyfmt ) 0082 form(1) = fmt(1) 0083 form(2) = fmt(2) 0084 form(3) = num( min0( 5 , iform + 1) ) 0085 if ( iform .gt. 3 ) form(1) = emt 0086 c c label tick mark on bottom end of vertical axis c c compute value, translate and trim leading blanks c 0087 ymin = yworld( icscr ) 0088 encode ( 9 , form, label ) ymin 0089 call triml(label, 9, len) c c remove decimal point for integer label c 0090 if ( iform .eq. 0 ) len = len - 1 0091 c c determine size of label and center c 0092 iyl = (len + 1) * ichar(iysiz ) 0093 ix = iascr - iyl 0094 ixmin = ix 0095 ihgt = (7 * ichar(iysiz )) / 12 0096 iy = is - ihgt c c write label c 0097 call pltstr(ix, iy, label , len , 1 , iysiz) c c draw ticks and write labels on the interior of vertical axis c 0098 lentic = scry / 4 c c if n < = 0 then there will be no tick marks drawn nor any labels c written on the vertical axis c 0099 if(n .le. 0)goto 40 0101 do 30 i = 1, n 0102 is = is + idy c c draw tick mark c 0103 call plot(iascr, is, 0) 0104 call plot(iascr + lentic, is, 1) c c label tick mark c 0105 ymin = ymin + ytic 0106 encode ( 9 , form, label ) ymin 0107 call triml ( label, 9, len ) 0108 if ( iform .eq. 0 ) len = len - 1 0110 ix = iascr - ( len + 1 ) * ichar (iysiz) 0111 ixmin = min0 ( ixmin, ix ) 0112 iy = is - ihgt c 0113 call pltstr(ix, iy, label , len , 1 , iysiz) c 0114 30 continue c c label tick mark on top end of vertical axis c 0115 40 continue 0116 is = is + idy 0117 ymin = ymin + ytic 0118 encode ( 9 , form, label ) ymin 0119 call triml ( label, 9, len ) 0120 if ( iform .eq. 0 ) len = len - 1 0122 ix = iascr - ( len + 1 ) * ichar (iysiz) 0123 ixmin = min0 ( ixmin, ix ) 0124 iy = is - ihgt c 0125 call pltstr(ix, iy, label , len , 1 , iysiz) c c center vertical title and plot c 0126 ix = ixmin - (7 * ichar(ixsiz)) / 6 0127 iyl = iylen * ichar(iysiz) 0128 iy = (icscr + idscr - iyl) / 2 c 0129 call pltstr(ix, iy, iytit, iylen, 4, iysiz) c 0130 return 0131 end .eli .pg .x LINE, listing .lit 0001 SUBROUTINE LINE ( x, y, n, icol, isym, isize, inum ) 0002 dimension x(n), y(n) 0003 call dashln(x, y, n, icol, isym, isize, inum, 0 ) 0004 return 0005 end .eli .pg .x DASHLN, listing .lit 0001 SUBROUTINE DASHLN(x, y, n, icol, isym, isize, inum, ityp) c c this routine plots the n world coordinates, (x, y). c icol is the color of line which connects the points. c isym is the symbol to be plotted at the points. c isize is the size of the symbol. c ityp is the type of line which connects the points. c a symbol is plotted every abs(inum) points. if inum is c negative, only symbols are plotted. c if any of the following are out of range, only a line is c drawn: isym, isize, inum c 0002 byte mark 0003 dimension x(n), y(n) 0004 common/chkbon/ibond, istrt, linntp c 0005 mark = isize .le. 0.or.isize .gt. 5 0006 mark = mark.or.isym .lt. 0.or.isym .gt. 5 0007 mark = mark.or.inum .eq. 0 0008 ibond = 0 c 0009 if(inum .lt. 0)goto 20 0010 c c draw line c 0011 call coltyp(icol) 0012 istrt = 1 0013 call moveto(x(1), y(1), 0, ityp) c 0014 do 10 i = 2, n 0015 call moveto(x(i), y(i), 1, ityp) 0016 10 continue c 0017 20 if(mark)return 0018 c c draw symbols c 0019 ibond = 0 0020 itemp = iabs(inum) 0021 do 30 i = 1, n, itemp 0022 call moveto(x(i), y(i), 0, ityp) 0023 if(ibond .eq. 0)call marker(isym, isize) 0025 30 continue c 0026 return 0027 end .eli .pg .x MOVETO, listing .lit 0001 SUBROUTINE MOVETO (xwrld, ywrld, iud, lintyp) c c moves the pen to the point with world coordinates (xwrld, ywrld) c draws a line only if iud = 1 c the type of line drawn is set by the lintyp c move is made only to window boundary c 0002 dimension ix1(2), iy1(2) 0003 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig 0004 common/chkbon/ibond, istrt, linntp c 0005 if ( istrt .eq. 0 .and. linntp .eq. lintyp ) goto 500 0007 call mov1st(xwrld, ywrld, lintyp) 0008 return c 0009 500 ix = iscrx( xwrld ) 0010 iy = iscry( ywrld ) c c (ix,iy) is screen coordinate inside window c (ixo,iyo) is current screen coordinate c (ixcur,iycur) is previous screen coordinate c (ix0,iy0) is screen coordinate outside window c 0011 ixo = ix 0012 iyo = iy c c check to see if in window c 0013 inx = (abs(ix - xm) .le. dx) 0014 iny = (abs(iy - ym) .le. dy) 0015 in = inx * iny c c in is one if inside window, zero if outside window c ibond is zero if previous point inside window, minus one if outside c in + ibond will be positive only if both previous point and current c point are inside window c in + ibond will be zero only if one point is inside and one point c is outside c in + ibond will be negative only if both points are outside c 0016 if ( in + ibond ) 300, 100, 200 ccc c this section finds the intersection with the window boundary for c consecutive points on opposite sides of the boundary c 0017 100 ix0 = ixcur 0018 iy0 = iycur 0019 if ( in ) goto 120 0020 c c current point outside window c 0021 ibond = - 1 c c find intersection (if any) with horizontal boundaries c 0022 if ( inx ) goto 110 0024 xsl = (iy - iy0) / float(ix - ix0) 0025 xsc = xm + sign(dx, ix - xm) 0026 iy = xsl * (xsc - ix) + iy 0027 ix = xsc c c find intersection (if any) with vertical boundaries c 0028 110 if ( abs( iy - ym ) .le. dy ) goto 200 0030 ysl = (ix - ixcur) / float(iy - iycur) 0031 ysc = ym + sign(dy, iy - ym) 0032 ix = ysl * (ysc - iy) + ix 0033 iy = ysc 0034 goto 200 c c current point inside window c 0035 120 ibond = 0 c c find intersection (if any) with horizontal boundaries c 0036 if ( abs( ix0 - xm ) .le. dx ) goto 130 0038 xsl = (iy - iy0) / float(ix - ix0) 0039 xsc = xm + sign(dx, ix0 - xm) 0040 iy0 = xsl * (xsc - ix0) + iy0 0041 ix0 = xsc c c find intersection (if any) with vertical boundaries c 0042 130 if ( abs( iy0 - ym ) .le. dy ) goto 140 0044 ysl = (ix - ix0) / float(iy - iy0) 0045 ysc = ym + sign(dy, iy0 - ym) 0046 ix0 = ysl * (ysc - iy0) + ix0 0047 iy0 = ysc c c move pen to boundary c 0048 140 call dash(ix0, iy0, 0, lintyp) ccc c this section plots points within the window c 0049 200 call dash(ix, iy, iud, lintyp) c c save current coordinates c 0050 ixcur = ixo 0051 iycur = iyo c 0052 return ccc c this section handels points outside window c 0053 300 insect = 0 0054 if ( ix .eq. ixcur ) goto 320 0056 if( abs(xm - dx - .5*(ix+ixcur)) .gt. .5*iabs(ix-ixcur) )goto 310 0058 xsl = ( iy - iycur ) / float( ix - ixcur ) 0059 y0 = xsl * ( xm - dx - ix ) + iy 0060 if ( ( ( y0 - iy ) * ( y0 - iycur ) .gt. 0. ) 1 .or. ( abs( y0 - ym ) .gt. dy ) ) goto 310 0062 insect = 1 0063 ix1(insect) = xm - dx 0064 iy1(insect) = y0 c 0065 310 if( abs(xm + dx - .5*(ix+ixcur)) .gt. .5*iabs(ix-ixcur) )goto 320 0067 y0 = xsl * ( xm + dx - ix ) + iy 0068 if ( ( ( y0 - iy ) * ( y0 - iycur ) .gt. 0. ) 1 .or. ( abs( y0 - ym ) .gt. dy ) ) goto 320 0070 insect = insect + 1 0071 ix1(insect) = xm + dx 0072 iy1(insect) = y0 0073 if ( insect .eq. 2 ) goto 350 0074 c 0075 320 if ( iy .eq. iycur ) goto 390 0077 if( abs(ym - dy - .5*(iy+iycur)) .gt. .5*iabs(iy-iycur) )goto 330 0079 ysl = ( ix - ixcur ) / float( iy - iycur ) 0080 x0 = ysl * ( ym - dy - iy ) + ix 0081 if ( ( ( x0 - ix ) * ( x0 - ixcur ) .gt. 0. ) 1 .or. ( abs( x0 - xm ) .gt. dx ) ) goto 330 0083 insect = insect + 1 0084 ix1(insect) = x0 0085 iy1(insect) = ym - dy 0086 if ( insect .eq. 2 .and. ix1(2) .ne. ix1(1) ) goto 350 0088 insect = 1 c 0089 330 if( abs(ym + dy - .5*(iy+iycur)) .gt. .5*iabs(iy-iycur) )goto 390 0091 x0 = ysl * ( ym + dy - iy ) + ix 0092 if ( ( ( x0 - ix ) * ( x0 - ixcur ) .gt. 0. ) 1 .or. ( abs( x0 - xm ) .gt. dx ) ) goto 390 0094 insect = insect + 1 0095 ix1(insect) = x0 0096 iy1(insect) = ym + dy c 0097 if ( insect .lt. 2 ) goto 390 0099 350 call dash ( ix1(1), iy1(1), 0, lintyp) 0100 call dash ( ix1(2), iy1(2), iud, lintyp) 0101 390 ibond = -1 0102 ixcur = ixo 0103 iycur = iyo 0104 return 0105 end .eli .pg .x MOV1ST, listing .lit 0001 SUBROUTINE MOV1ST (xwrld, ywrld, lintyp) c c moves the pen to the point with world coordinates (xwrld, ywrld) c draws a line only if iud = 1 c the type of line drawn is set by the lintyp c move is made only to window boundary c 0002 dimension ix1(2), iy1(2) 0003 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig 0004 common/chkbon/ibond, istrt, linntp c 0005 ix = iscrx( xwrld ) 0006 iy = iscry( ywrld ) 0007 ibond = 0 0008 istrt = 1 c c (ix,iy) is screen coordinate c check to see if in window c 0009 inx = (abs(ix - xm) .le. dx) 0010 iny = (abs(iy - ym) .le. dy) 0011 in = inx * iny c c in is one if inside window, zero if outside window c 0012 if ( in ) goto 100 0013 c c initial point outside of plotting window 0014 ibond = -1 0015 ixcur = ix 0016 iycur = iy c 0017 100 call dash(ix, iy, 0, lintyp) c c save current coordinates c 0018 ixcur = ix 0019 iycur = iy 0020 istrt = 0 c 0021 return 0022 end .eli .pg .x DASH, listing .lit 0001 SUBROUTINE DASH( ix, iy, iud, lintyp ) c 0002 integer lind(11) 0003 real idash(11), ispace(11) 0004 data lind / 1, 2, 3, 4, 5, 6, 9, 10, 7, 11, 8 / 0005 data idash/.02, .04, .08, .16, .24, .32, .16, .16, .04, .04, .04/ 0006 data ispace/.08, .08, .08, .08, .12, .16, .08, .08, .08, .08, .08/ c 0007 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0008 common /chkbon/ ibond, istrt, lin 0009 data lin, lin1 / 0, 0 / c 0010 if ( istrt .ne. 1 ) goto 50 0012 if ( lintyp .gt. 0 ) goto 60 0014 lin = 0 0015 goto 50 0016 60 lin = max0 ( lintyp, 1 ) 0017 lin = min0 ( lin, 8 ) 0018 lin1 = lin 0019 dash = scrx * idash(lin1) 0020 space = 0 0021 50 if ( lin .le. 0 ) goto 300 0023 if ( iud .ne. 1 ) goto 300 0025 dx1 = ix - ixcur 0026 dy1 = iy - iycur 0027 ds = sqrt ( dx1 * dx1 + dy1 * dy1 ) 0028 if ( ds .eq. 0. ) return 0030 c = dx1 / ds 0031 s = dy1 / ds 0032 x0 = ixcur 0033 y0 = iycur 0034 if ( dash .eq. 0. ) goto 200 0036 100 if ( ds .ge. dash ) goto 150 0038 dash = dash - ds 0039 ds = 0. 0040 call plot ( ix, iy, 1 ) 0041 return 0042 150 ds = ds - dash 0043 x0 = dash * c + x0 0044 y0 = dash * s + y0 0045 ix0 = x0 +.5 0046 iy0 = y0 +.5 0047 call plot ( ix0, iy0, 1 ) 0048 dash = 0. 0049 space = scrx * ispace(lin1) 0050 if ( space .eq. 0. ) goto 270 0052 200 if ( ds .ge. space ) goto 250 0054 space = space - ds 0055 ds = 0. 0056 call plot ( ix, iy, 0 ) 0057 return 0058 250 ds = ds - space 0059 x0 = space * c + x0 0060 y0 = space * s + y0 0061 ix0 = x0 +.5 0062 iy0 = y0 +.5 0063 call plot ( ix0, iy0, 0 ) 0064 space = 0. 0065 lin1 = lind(lin1) 0066 270 dash = scrx * idash(lin1) 0067 goto 100 0068 300 call plot ( ix, iy, iud ) 0069 return 0070 end .eli .pg .x PLTSTR, listing .lit 0001 SUBROUTINE PLTSTR( ix, iy, str, len, irot, isize ) c c this routine moves to the point (ix,iy) and writes a string c only if the entire string is in the boundary c 0002 byte str(len) c 0003 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c c attempt move to point and write string c 0004 call plot ( ix, iy, 0 ) 0005 if ( (ix .eq. ixcur) .and. (iy .eq. iycur) ) 1 call wrtstr ( str, len, irot, isize ) 0007 return 0008 end .eli .pg .x TRIML, listing .lit 0001 SUBROUTINE TRIML( label, n, len ) 0002 byte label(n) c 0003 do 10 i = 1, n 0004 if ( label(i) .ne. ' ' ) goto 20 0006 10 continue c 0007 20 len = 0 0008 do 30 j = i, n 0009 len = len + 1 0010 label(len) = label(j) 0011 30 continue c 0012 return 0013 end .eli .pg .x ISCRX, listing .lit 0001 FUNCTION ISCRX( xwrld ) 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 x = amin1( xwrld * xslope + xconst, 32767. ) 0004 x = amax1 ( x, -32767. ) 0005 iscrx = ifix( x ) c 0006 return 0007 end .eli .pg .x ISCRY, listing .lit 0001 FUNCTION ISCRY( ywrld ) 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 y = amin1 ( ywrld * yslope + yconst, 32767. ) 0004 y = amax1 ( y, -32767. ) 0005 iscry = ifix ( y ) c 0006 return 0007 end .eli .pg .x XWORLD, listing .lit 0001 FUNCTION XWORLD( ix ) 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 xworld = ( ix - xconst ) / xslope c 0004 return 0005 end .eli .pg .x YWORLD, listing .lit 0001 FUNCTION YWORLD( iy ) 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 yworld = ( iy - yconst ) / yslope c 0004 return 0005 end .eli .pg .x CURPOS, listing .lit 0001 SUBROUTINE CURPOS( icurx, icury ) 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 icurx = ixcur 0004 icury = iycur 0005 return 0006 end .eli .pg .x PLOT3D, listing .lit ccc c SUBROUTINE PLOT3D c c This routine plots three dimensional surfaces on a rectangular c grid with hidden line removal. The array f(nx,ny) contains the c values of the surface above a given grid point. The arrays c x(nx,ny) and y(nx,ny) are internal work arrays containing the x c and y coordinate of the projected surface. The variables nx and c ny are the dimensions of the arrays. The variables xw and yw are c the size of the projected plot in inches. The variables xview, c yview and zview are the position at which the surface is to be c viewed in which the grid lies in a rectangle bounded by the c diagonal vertices (0,0) and (xw,yw). The variable line determines c which directions the grid lines are plotted. For line = 1, only c those grid lines parallel to the x-axis are plotted. For line = c 2, only those grid lines parallel to the y-axis are plotted. For c line = 0 all grid lines are plotted. The variable scale c determines the scaling factor for the surface to be plotted. If c scale = 0, the routine will choose a suitable scaling factor. c c 0001 SUBROUTINE PLOT3D(f,x,y,nx,ny,xw,yw,xview,yview,zview,line,scale) c 0002 dimension f(nx,ny),x(nx,ny),y(nx,ny) c 0003 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, pdx, pdy, dxb, dyb, ixcur, iycur, xmido, ymido, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig 0004 common/pscale/xv,yv,dx,dy,ca,sa,ly,lx,xscale,xn,yscale,yn 0005 common/color/isubch c 0006 data small,pt5/1.e-06,.5/ c 0007 if(line.le.2)goto 10 0009 line=line-3 0010 goto 305 c c normalize constants c 0011 10 xb=1. 0012 yb=yw/xw 0013 xv=xview/xw 0014 yv=yview/xw 0015 h=zview/xw 0016 ir=1 0017 nxx=nx+1 0018 nyy=ny+1 c c determine projection plane c 0019 a=atan2(.5*xb-xv,.5*yb-yv) 0020 sa=sin(a) 0021 ca=cos(a) c c y component of the vertices of the projected grid c 0022 y2=xb*sa 0023 y3=yb*ca 0024 y4=y2+y3 0025 yc=xv*sa+yv*ca 0026 yn=amin1(0.,y2,y3,y4) 0027 if(yc.ge.yn)yc=yn-.01*abs(yb) 0029 yc=-yc 0030 xc=xv*ca-yv*sa 0031 dx=xb/(nx-1) 0032 dxx=1./dx 0033 vx=dxx*xv+1.00001 0034 lx=vx 0035 dy=yb/(ny-1) 0036 dyy=1./dy 0037 vy=dyy*yv+1.00001 0038 ly=vy 0039 yn=0. 0040 yx=yn 0041 d=.5*y4 0042 yd=yc+d 0043 yp=0. c c determine minimum and maximum of the surface c 0044 tn=f(1,1) 0045 tx=tn 0046 do 50 j=1,ny 0047 do 50 i=1,nx 0048 tn=amin1(tn,f(i,j)) 0049 50 tx=amax1(tx,f(i,j)) c c compute scaling factor c 0050 s=tx-tn 0051 if(s.eq.0.)s=tx 0053 s=amax1(xb,yb)/s 0054 if(scale.ne.0.)s=scale 0055 c c compute projected x and y coordinates of surface c 0056 do 120 j=1,ny 0057 xp=0. 0058 c=yp*sa+xc 0059 do 100 i=1,nx 0060 t=f(i,j)*s 0061 hl=xp*sa+yp*ca 0062 x(i,j)=(xp*ca-c)*yd/(hl+yc)+small 0063 y(i,j)=((hl-d)*h+t*yd)/(hl+yc)+small 0064 yn=amin1(yn,y(i,j)) 0065 yx=amax1(yx,y(i,j)) 0066 100 xp=xp+dx 0067 120 yp=yp+dy c c x component of the vertices of the grid c 0068 x1=x(1,1) 0069 x2=x(nx,1) 0070 x3=x(1,ny) 0071 x4=x(nx,ny) 0072 tn=tn*yd*s*1.1 c c y component of the vertices of the projected grid c 0073 y1=(tn-d*h)/yc 0074 y2=((y2-d)*h+tn)/(y2+yc) 0075 y3=((y3-d)*h+tn)/(y3+yc) 0076 y4=((y4-d)*h+tn)/(y4+yc) c 0077 xn=amin1(x1,x2,x3,x4) 0078 xx=amax1(x1,x2,x3,x4) 0079 yn=amin1(yn,y1,y2,y3,y4) 0080 xscale=scrx*xw/(xx-xn) 0081 yscale=scry*yw/(yx-yn) 0082 xn=xscale*xn 0083 yn=yscale*yn c c convert to screen cordinates c 0084 do 200 j=1,ny 0085 do 200 i=1,nx 0086 x(i,j)=aint(xscale*x(i,j)-xn+pt5) 0087 200 y(i,j)=aint(yscale*y(i,j)-yn+pt5) c 0088 x1=aint(xscale*x1-xn+pt5) 0089 y1=aint(yscale*y1-yn+pt5) 0090 x2=aint(xscale*x2-xn+pt5) 0091 y2=aint(yscale*y2-yn+pt5) 0092 x3=aint(xscale*x3-xn+pt5) 0093 y3=aint(yscale*y3-yn+pt5) 0094 x4=aint(xscale*x4-xn+pt5) 0095 y4=aint(yscale*y4-yn+pt5) 0096 xscale=xscale*yd c c begin hidden line removal c 0097 do 300 j=1,ny 0098 do 300 i=1,nx 0099 ix=isign(1,lx-i) 0100 iy=isign(1,ly-j) 0101 ih=i 0102 iplot=1 0103 if(0.eq.lx-i)goto 250 0105 215 ih=ih+ix 0106 if(ih.lt.1.or.ih.gt.nx)goto 250 0108 xp=(ih-1)*dx 0109 xm=dx/dy*(dy*(j-1)-yv)/(dx*(i-1)-xv) 0110 yp=xm*(ih-i)+j 0111 jj=ifix(yp) 0112 jh=jj+1 0113 if(jj.lt.1.or.jh.gt.ny)goto 250 0115 yp=(yp-1)*dy 0116 hl=yc+xp*sa+yp*ca 0117 xi=aint(xscale*(xp*ca-yp*sa-xc)/hl-xn+pt5) 0118 yi=(y(ih,jj)-y(ih,jh))*(xi-aint(x(ih,jh)))/ 1(aint(x(ih,jj))-aint(x(ih,jh)))+y(ih,jh) 0119 if(aint(yi+pt5).lt.y(i,j))goto 215 0121 iplot=0 0122 goto 290 0123 250 if(ly-j.eq.0)goto 290 0125 jh=j 0126 260 jh=jh+iy 0127 if(jh.lt.1.or.jh.gt.ny)goto 290 0129 yp=(jh-1)*dy 0130 ym=dy/dx*(dx*(i-1)-xv)/(dy*(j-1)-yv) 0131 xp=ym*(jh-j)+i 0132 ii=ifix(xp) 0133 ih=ii+1 0134 if(ii.lt.1.or.ih.gt.nx)goto 290 0136 xp=(xp-1)*dx 0137 hl=yc+xp*sa+yp*ca 0138 xi=aint(xscale*(xp*ca-yp*sa-xc)/hl-xn+pt5) 0139 yi=(y(ii,jh)-y(ih,jh))*(xi-aint(x(ih,jh)))/ 1(aint(x(ii,jh))-aint(x(ih,jh)))+y(ih,jh) 0140 if(aint(yi+pt5).lt.y(i,j))goto 260 0142 iplot=0 0143 290 x(i,j)=x(i,j)+.101*iplot 0144 300 continue c c plot x grid lines c 0145 305 if(line.eq.2)goto 350 0147 isubch=1 0148 do 310 j=1,ny 0149 iplot0=ifix(10*(x(1,j)-ifix(x(1,j)))) 0150 if(iplot0.eq.1)call plot(ifix(x(1,j)),ifix(y(1,j)),0) 0152 do 310 i=2,nx 0153 iplot=ifix(10*(x(i,j)-aint(x(i,j)))) 0154 call insect(i,j,iplot,iplot0,x,y,nx,ny,0) 0155 310 iplot0=iplot c c plot visible verticle bars c 0156 if(lx.ge.1.and.lx.le.nx)goto 350 0158 if(lx.lt.1)goto 320 0160 ii=nx 0161 aa=(y2-y4)/(x2-x4) 0162 bb=y4-x4*aa 0163 ix=x2 0164 iy=y2 0165 goto 330 0166 320 ii=1 0167 aa=(y3-y1)/(x3-x1) 0168 bb=y1-x1*aa 0169 ix=x1 0170 iy=y1 0171 330 do 340 j=1,ny 0172 call plot(ifix(x(ii,j)),ifix(y(ii,j)),0) 0173 340 call plot(ifix(x(ii,j)),ifix(aa*x(ii,j)+bb),1) 0174 call plot(ix,iy,1) c c plot y grid lines c 0175 350 if(line.eq.1)return 0177 isubch=2 0178 do 400 i=1,nx 0179 iplot0=ifix(10*(x(i,1)-ifix(x(i,1)))) 0180 if(iplot0.eq.1)call plot(ifix(x(i,1)),ifix(y(i,1)),0) 0182 do 400 j=2,ny 0183 iplot=ifix(10*(x(i,j)-aint(x(i,j)))) 0184 call insect(i,j,iplot,iplot0,x,y,nx,ny,1) 0185 400 iplot0=iplot c c plot visible verticle bars c 0186 if(ly.ge.1.and.ly.le.ny)return 0188 if(ly.lt.1)goto 420 0190 jj=ny 0191 aa=(y3-y4)/(x3-x4) 0192 bb=y4-x4*aa 0193 ix=x3 0194 iy=y3 0195 goto 430 0196 420 jj=1 0197 aa=(y2-y1)/(x2-x1) 0198 bb=y1-x1*aa 0199 ix=x1 0200 iy=y1 0201 430 do 440 i=1,nx 0202 call plot(ifix(x(i,jj)),ifix(y(i,jj)),0) 0203 440 call plot(ifix(x(i,jj)),ifix(aa*x(i,jj)+bb),1) 0204 call plot(ix,iy,1) 0205 return 0206 end .eli .pg .x INSECT, listing .lit ccc c SUBROUTINE INSECT c c This routine computes the intersection point of a grid line which is c partially hidden. c c 0001 SUBROUTINE INSECT(i1,j1,iplot,iplot0,x,y,nx,ny,l) c 0002 dimension x(nx,ny),y(nx,ny) 0003 byte eq1,eq2 0004 common/pscale/xv,yv,dx,dy,ca,sa,ly,lx,xscale,xn,yscale,yn 0005 data pt5/.5/ 0006 if(iplot.eq.iplot0)goto 290 0008 i=i1 0009 j=j1 0010 i0=i1 0011 j0=j1 0012 ix=isign(1,lx-i) 0013 iy=isign(1,ly-j) 0014 insct=0 0015 if(l.eq.0)goto 10 0017 j=j1-iplot0 0018 j0=j1-iplot 0019 xf=aint(x(i0,j0)) 0020 yf=y(i0,j0) 0021 xl=aint(x(i,j)) 0022 yl=y(i,j) 0023 imin=i1 0024 jmin=iy*min0(iy*j,iy*j0) 0025 if(jmin.eq.j0.and.(y(i+ix,j)-yl)/(x(i+ix,j)-xl).lt. 1(yf-yl)/(xf-xl))goto 270 0027 goto 20 0028 10 i=i1-iplot0 0029 i0=i1-iplot 0030 xf=aint(x(i0,j0)) 0031 yf=y(i0,j0) 0032 xl=aint(x(i,j)) 0033 yl=y(i,j) 0034 imin=ix*min0(ix*i,ix*i0) 0035 jmin=j1 0036 if(imin.eq.i0.and.(y(i,j+iy)-yl)/(x(i,j+iy)-xl).gt. 1(yf-yl)/(xf-xl))goto 270 0038 20 xint=xf-xl 0039 yint=yf-yl 0040 ih=imin 0041 if(lx-i.eq.0)goto 250 0043 xm1=dx/dy*(dy*(j-1)-yv)/(dx*(i-1)-xv) 0044 xm2=dx/dy*(dy*(j0-1)-yv)/(dx*(i0-1)-xv) 0045 215 ih=ih+ix 0046 if(ih.lt.1.or.ih.gt.nx)goto 250 0048 yp1=xm1*(ih-i)+j 0049 if(i.eq.ih)yp1=yp1+iy 0051 yp2=xm2*(ih-i0)+j0 0052 if(i0.eq.ih)yp2=yp2+iy 0054 jn=ifix(amin1(yp1,yp2)) 0055 jx=ifix(amax1(yp1,yp2)) 0056 do 220 jj=jn,jx 0057 jh=jj+1 0058 if(jj.lt.1.or.jh.gt.ny)goto 220 0060 if((x(ih,jh)-aint(x(ih,jh)))+(x(ih,jj)-aint(x(ih,jj))).eq.0) 1goto 220 0062 s1=(yf-yl)/(xf-xl) 0063 s2=(y(ih,jj)-y(ih,jh))/(aint(x(ih,jj))-aint(x(ih,jh))) 0064 if(s1.eq.s2)goto 220 0066 xi=(y(ih,jh)-yl+xl*s1-aint(x(ih,jh))*s2)/(s1-s2) 0067 if(abs(aint(xi+pt5)-.5*(xl+xf)).gt..5*abs(xf-xl))goto 220 0069 xmid=.5*aint(x(ih,jj)+x(ih,jh)) 0070 xdif=.5*abs(aint(x(ih,jj))-aint(x(ih,jh))) 0071 if(abs(aint(xi+pt5)-xmid).gt.xdif)goto 220 0073 jh=(jj+jh+iy*(jj-jh))/2 0074 yi=s1*(xi-xl)+yl 0075 if(xint*(y(ih,jh+iy)-y(ih,jh))*ix*iy.lt. 1yint*(aint(x(ih,jh+iy))-aint(x(ih,jh)))*ix*iy)goto 220 0077 xf=aint(xi+pt5) 0078 yf=aint(yi+pt5) 0079 insct=1 0080 if(xf-xl.eq.0)goto 270 0082 220 continue 0083 goto 215 0084 250 if(ly-j.eq.0)goto 270 0086 ym1=dy/dx*(dx*(i-1)-xv)/(dy*(j-1)-yv) 0087 ym2=dy/dx*(dx*(i0-1)-xv)/(dy*(j0-1)-yv) 0088 jh=jmin 0089 260 jh=jh+iy 0090 if(jh.lt.1.or.jh.gt.ny)goto 270 0092 xp1=ym1*(jh-j)+i 0093 if(j.eq.jh)xp1=xp1+ix 0095 xp2=ym2*(jh-j0)+i0 0096 if(j0.eq.jh)xp2=xp2+ix 0098 jn=ifix(amin1(xp1,xp2)) 0099 jx=ifix(amax1(xp1,xp2)) 0100 do 265 ii=jn,jx 0101 ih=ii+1 0102 if(ii.lt.1.or.ih.gt.nx)goto 265 0104 if((x(ih,jh)-aint(x(ih,jh)))+(x(ii,jh)-aint(x(ii,jh))).eq.0) 1goto 265 0106 eq1=i.eq.ih.or.i.eq.ii 0107 if(eq1.and.eq2)goto 265 0109 s1=(yf-yl)/(xf-xl) 0110 s2=(y(ii,jh)-y(ih,jh))/(aint(x(ii,jh))-aint(x(ih,jh))) 0111 if(s1.eq.s2)goto 265 0113 xi=(y(ih,jh)-yl+xl*s1-aint(x(ih,jh))*s2)/(s1-s2) 0114 if(abs(aint(xi+pt5)-.5*(xl+xf)).gt..5*abs(xf-xl))goto 265 0116 xmid=.5*aint(x(ii,jh)+x(ih,jh)) 0117 xdif=.5*abs(aint(x(ii,jh))-aint(x(ih,jh))) 0118 if(abs(aint(xi+pt5)-xmid).gt.xdif)goto 265 0120 ih=(ih+ii+ix*(ii-ih))/2 0121 yi=s1*(xi-xl)+yl 0122 if(xint*(y(ih+ix,jh)-y(ih,jh))*ix*iy.gt. 1yint*(aint(x(ih+ix,jh))-aint(x(ih,jh)))*ix*iy)goto 265 0124 xf=aint(xi+pt5) 0125 yf=aint(yi+pt5) 0126 insct=1 0127 if(xf.eq.xl)goto 270 0129 265 continue 0130 goto 260 0131 270 if(insct.eq.1)goto 280 0133 if(l.eq.0.and.i.eq.1.or.i.eq.nx)return 0135 if(l.eq.1.and.j.eq.1.or.j.eq.ny)return 0137 call plot(ifix(xl),ifix(yl),0) 0138 return 0139 280 ix=ifix(xf) 0140 iy=ifix(yf) 0141 call plot(ix,iy,iplot0) 0142 if(xf.eq.xl)return 0144 290 if(iplot.eq.0)return 0146 ix=ifix(x(i1,j1)) 0147 iy=ifix(y(i1,j1)) 0148 call plot(ix,iy,1) 0149 return 0150 end .eli .pg .ax HIPLOT ROUTINES .x HIPLOT routines .x INIPLT, listing .rm 80 .lit 0001 SUBROUTINE INIPLT(iunit, xsize, ysize) c c this routine initializes the plot. xsize and ysize denote the c size of the total plotting surface in inches. no plotting is c permitted outside this area. iunit is the logical unit c number of the plot. for iunit = 6, the plot is sent directly c to the plotter. c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 common /pagsiz/ xbond, ybond c 0004 common /world/ xmin, xmax, ymin, ymax c 0005 lunplt = iunit 0006 if ( iunit .eq. 7 ) call plton 0008 write(lunplt, 1) 0009 1 format(' ;: HOAUL0 ') c 0010 scrx = 200. 0011 scry = 200. c 0012 xbond = xsize 0013 ybond = ysize 0014 ixbond = ifix(scrx * xsize) 0015 iybond = ifix(scry * ysize) 0016 dxb = .5 * ixbond 0017 dyb = .5 * iybond 0018 xmid = dxb 0019 ymid = dyb c c set default values c 0020 ixorig = 0 0021 iyorig = 0 0022 iascr = 0 0023 ibscr = ixbond 0024 icscr = 0 0025 idscr = iybond c 0026 xslope = ixbond 0027 xconst = 0. 0028 yslope = iybond 0029 yconst = 0. c 0030 xmin = 0. 0031 xmax = 1. 0032 ymin = 0. 0033 ymax = 1. c 0034 do 10 i = 1 , 5 0035 ichar(i) = 6 * 2 ** i 0036 10 continue c 0037 return 0038 end .eli .pg .x ENDPLT, listing .lit 0001 SUBROUTINE ENDPLT c c this routine ends plotting by deselecting the plotter and c dumping the buffer c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 call dmpplt 0004 if ( lunplt .eq. 7 ) call pltoff 0005 c 0006 return 0007 end .eli .pg .x DMPPLT, listing .lit 0001 SUBROUTINE DMPPLT c c this routine ends plotting by deselecting the plotter and c dumping the buffer c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 write(lunplt, 1) 0004 write(lunplt, 2) 0005 write(lunplt, 2) 0006 write(lunplt, 3) c 0007 return 0008 1 format(1x, 'HUP0 @', 122x) 0009 2 format(129x) 0010 3 format(123x, ';: HU ') 0011 end .eli .pg .x PENDWN, listing .lit 0001 SUBROUTINE PENDWN c c this routine puts the pen down so it will draw c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 write (lunplt, 1) 0004 1 format (1x, ' D ') 0005 return 0006 end .eli .pg .x PENUP, listing .lit 0001 SUBROUTINE PENUP c c this routine puts the pen up c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 write (lunplt, 1) 0004 1 format (1x, ' U ') 0005 return 0006 end .eli .pg .x WRTSTR, listing .lit 0001 SUBROUTINE WRTSTR(str, len, irot, isize) c c subroutine "write string" c len is the length of the string c irot determines the rotation of the string (1 - 4), 1 is c right side up, 2 is rotated 90 degrees clockwise, etc. c string is checked to see if in is in bounds c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 byte str(len) c c check to see if in bounds c 0004 isz = max0(isize, 1) 0005 isz = min0(isz, 5) 0006 ix = 2 ** (isz - 1) 0007 iy = 14 * ix 0008 ix = 12 * ix * len 0009 irt = mod(irot - 1, 4) + 1 0010 isx = iabs(irt - 3) - 1 0011 isy = iabs(irt - 2) - 1 0012 ixl = isx * ix - isy * iy + ixcur 0013 iyl = isx * iy + isy * ix + iycur 0014 if( abs(ixl - xmid) .gt. dxb )goto 100 0016 if( abs(iyl - ymid) .gt. dyb )goto 100 0017 c c plot string c 0018 write (lunplt, 3) irt, isz, (str(i), i = 1, len) 0019 write (lunplt, 4) 0020 return c c string is out of bounds c 0021 100 if ( lunplt .eq. 7 ) call pltoff 0023 type 1, (str(i), i = 1, len) 0024 type 2 0025 if ( lunplt .eq. 7 ) call plton 0026 c 0027 return 0028 1 format('$WARNING string ', 100a1) 0029 2 format(' is out of bounds and will not be plotted') 0030 3 format (1x, 'S', 2i1, 1x, 100a1, $) 0031 4 format(1x, '_') 0032 end .eli .pg .x MARKER, listing .lit 0001 SUBROUTINE MARKER(mrknum, isize) c c places a marker at the current coordinates c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 isz = min0(isize, 5) 0004 isz = max0(isz, 1) 0005 mrk = max0(mrknum, 0) 0006 mrk = min0(mrk, 5) 0007 write (lunplt, 1) isz, mrk 0008 1 format(1x, ' M', 2i1, 1x) 0009 return 0010 end .eli .pg .x COLTYP, listing .lit 0001 SUBROUTINE COLTYP (icol) c c this subroutine sets the line color c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 itype = icol + 1 0004 itype = min0(itype, 8) 0005 itype = max0(itype, 1) 0006 write (lunplt, 1) itype 0007 1 format (1x, ' P', i1) 0008 return 0009 end .eli .pg .x PLOT, listing .lit 0001 SUBROUTINE PLOT(ixo, iyo, i) c c this routine moves to the screen coordinates ix, iy. c if i = 0, the pen is put up before moving, if i = 1, the c pen is put down before moving. checks to see if within c surface boundary. c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 if(i .eq. 0)call penup 0005 if(i .ne. 0)call pendwn 0007 ix = ixo 0008 iy = iyo c c check to see if in bounds c 0009 delx = ix - xmid 0010 if(abs(delx) .le. dxb)goto 100 0012 xsc = xmid + sign(dxb, delx) 0013 xsl = 1. 0014 if ( ix .ne. ixcur ) xsl = ( xsc - ixcur ) / float(ix - ixcur) 0016 xsl = (iy - iycur) * xsl 0017 ix = xsc 0018 iy = xsl + iycur c 0019 100 dely = iy - ymid 0020 if(abs(dely) .le. dyb)goto 200 0022 ysc = ymid + sign(dyb, dely) 0023 ysl = 1. 0024 if ( iy .ne. iycur ) ysl = ( ysc - iycur ) / float(iy - iycur) 0026 ysl = (ix - ixcur) * ysl 0027 ix = ysl + ixcur 0028 iy = ysc c c plot point c 0029 200 write(lunplt, 1)ix, iy c c save current coordinates c 0030 ixcur = ix 0031 iycur = iy c 0032 1 format(1x, 2(i4, 1x)) 0033 return 0034 end .eli .pg .x PLOTIN, listing .lit 0001 SUBROUTINE PLOTIN(x, y, i) c c plots the point x, y where x and y are given in inches. c if i = 0, pen is put up before plotting, else pen is put down. c 0002 ix = ifix(200 * x) 0003 iy = ifix(200 * y) 0004 call plot(ix, iy, i) 0005 return 0006 end .eli .pg .x ERASE, listing .lit 0001 SUBROUTINE ERASE c c this is a do-nothing subroutine supplied for compatibility with c the GRINELL version of the software. 0002 return 0003 end .eli .pg .x PLTON, listing .lit 0001 SUBROUTINE PLTON c 0002 common /zgraph/ iunit, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 byte esc 0004 esc = 27 0005 write(iunit, 1) esc 0006 1 format ( 1x, a1, '[?7i' ) 0007 return 0008 end .eli .pg .x PLTOFF, listing .lit 0001 SUBROUTINE PLTOFF c 0002 common /zgraph/ iunit, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 byte esc 0004 esc = 27 0005 write(iunit, 1) esc 0006 1 format( 1x, a1, '[?6i' ) 0007 return 0008 end .eli .pg .Ax GRINNELL ROUTINES .X GRINNELL routines .x INIPLT, listing .rm 80 .lit 0001 SUBROUTINE INIPLT(iunit,x,y) 0002 integer data(8) 0003 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0004 common /pagsiz/ xbond, ybond c 0005 common /world/ xmin, xmax, ymin, ymax c 0006 common/grbufr/ibufl,ibuf(1000) 0007 data data,ibufl/512,4095,15,111,255,240,3840,2309,1000/ c 0008 call grsini 0009 call grfer("7777,"7777,0) 0010 call grlwr(1,data,0,8,0) c 0011 scrx = 50. 0012 scry = 50. c 0013 xbond = x 0014 ybond = y 0015 ixbond = scrx * x 0016 iybond = scry * y 0017 dxb = .5 * ixbond 0018 dyb = .5 * iybond 0019 xmid = dxb 0020 ymid = dyb c c set default values c 0021 ixorig = 0 0022 iyorig = 0 0023 iascr = 0 0024 ibscr = ixbond 0025 icscr = 0 0026 idscr = iybond c 0027 xslope = ixbond 0028 xconst = 0 0029 yslope = iybond 0030 yconst = 0 c 0031 xmin = 0. 0032 xmax = 1. 0033 ymin = 0. 0034 ymax = 1. c 0035 ichar(1) = 7 0036 ichar(2) = 7 0037 ichar(3) = 14 0038 ichar(4) = 14 0039 ichar(5) = 14 c 0040 return 0041 end .eli .pg .x ENDPLT, listing .lit 0001 SUBROUTINE ENDPLT 0002 call grsend 0003 return 0004 end .eli .pg .x DMPPLT, listing .lit 0001 SUBROUTINE DMPPLT 0002 call grsbfd 0003 return 0004 end .eli .pg .x WRTSTR, listing .lit 0001 SUBROUTINE WRTSTR(str, len, irot, isize) c c subroutine "write string" c len is the length of the string c irot determines the rotation of the string (1 - 4), 1 is c right side up, 2 is rotated 90 degrees clockwise, etc. c string is checked to see if in is in bounds c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 byte str(len) 0004 byte charb(886) 0005 integer char(223), length(223), matrix(8) 0006 data charb/ 1 "370,"220,"160," 20,"340,"210,"210,"210,"370,"210,"210,"160, 1 "360,"210,"210,"360,"200,"200,"200,"360,"210,"210,"360,"210, 1 "210,"360,"170,"200,"200,"200,"170,"160,"210,"200,"200,"200, 1 "210,"160,"170,"210,"210,"170," 10," 10," 10,"360,"210,"210, 1 "210,"210,"210,"360,"170,"200,"370,"210,"160,"370,"200,"200, 1 "360,"200,"200,"370,"100,"100,"100,"340,"100,"110," 60,"200, 1 "200,"200,"360,"200,"200,"370,"160,"210," 10,"170,"210,"210, 1 "170,"160,"210,"270,"200,"200,"210,"160,"210,"210,"210,"360, 1 "200,"200,"200,"210,"210,"210,"370,"210,"210,"210,"160," 40, 1 " 40,"140," 00," 40,"370," 40," 40," 40," 40," 40,"370,"140, 1 "220," 20," 20," 20," 20," 00," 20,"140,"220," 20," 20," 20, 1 " 20," 70,"210,"220,"340,"240,"220,"200,"200,"210,"220,"240, 1 "300,"240,"220,"210,"340,"100,"100,"100,"100,"100,"300,"370, 1 "200,"200,"200,"200,"200,"200,"210,"250,"250,"370,"220,"210, 1 "210,"210,"250,"250,"330,"210,"210,"210,"210,"310,"260,"210, 1 "230,"230,"250,"310,"310,"210,"160,"210,"210,"210,"160,"160, 1 "210,"210,"210,"210,"210,"160,"200,"200,"200,"360,"210,"210, 1 "360,"200,"200,"200,"360,"210,"210,"360," 10," 10," 10,"170, 1 "210,"210,"170,"150,"220,"250,"210,"210,"210,"160,"200,"200, 1 "200,"310,"260,"210,"220,"240,"360,"210,"210,"360,"360," 10, 1 "160,"200,"170,"160,"210," 10,"160,"200,"210,"160," 60,"110, 1 "100,"100,"340,"100,"100," 40," 40," 40," 40," 40," 40,"370, 1 "170,"210,"210,"210,"210,"160,"210,"210,"210,"210,"210,"210, 1 " 40,"120,"210,"210,"210," 40," 40,"120,"120,"210,"210,"210, 1 "210,"330,"250,"210,"210,"210,"330,"250,"250,"210,"210,"210, 1 "210,"120," 40,"120,"210,"210,"210,"120," 40,"120,"210,"210, 1 "160,"210," 10,"170,"210,"210,"210," 40," 40," 40," 40,"120, 1 "210,"210,"370,"100," 40," 20,"370,"370,"200,"100," 40," 20, 1 " 10,"370,"370,"210,"210,"120,"120," 40," 40," 40," 00," 40, 1 " 40," 40," 40," 40,"120,"120,"120,"120,"120,"370,"120,"370, 1 "120,"120," 40,"360," 50,"160,"240,"170," 40,"210,"200,"100, 1 " 40," 20," 10,"210,"170,"220,"250,"140,"120,"120," 40,"100, 1 " 40," 40," 40,"100,"100,"100,"100,"100,"100,"100," 40,"100, 1 " 40," 40," 40," 40," 40," 40," 40,"100,"120," 40,"370," 40, 1 "120," 40," 40,"370," 40," 40,"100," 40," 40,"370," 40,"200, 1 "100," 40," 20," 10,"160,"210,"310,"250,"230,"210,"160,"160, 1 " 40," 40," 40," 40,"140," 40,"370,"100," 40," 20," 10,"210, 1 "160,"160,"210," 10," 60," 10,"210,"160," 20," 20,"370,"220, 1 "120," 60," 20,"160,"210," 10," 10,"360,"200,"370,"160,"210, 1 "210,"360,"200,"210,"160,"100,"100,"100," 40," 20," 10,"370, 1 "160,"210,"210,"160,"210,"210,"160,"160,"210," 10,"170,"210, 1 "210,"160," 40," 00," 00," 40,"100," 40," 40," 00," 40," 20, 1 " 40,"100," 40," 20,"370," 00," 00,"370,"100," 40," 20," 40, 1 "100," 40," 00," 40," 20," 10,"210,"160,"170,"200,"270,"250, 1 "270,"210,"160,"160,"100,"100,"100,"100,"100,"100,"100,"160, 1 " 10," 20," 40,"100,"200,"160," 20," 20," 20," 20," 20," 20, 1 " 20,"160,"210,"120," 40,"377," 40,"100,"100," 70," 20,"174, 1 "222,"222,"222,"174," 20," 70,"314,"110,"110,"204,"204,"204, 1 "170,"374,"100," 40," 20," 10," 20," 40,"100,"374,"340,"100, 1 "100,"100,"100,"100,"100,"104,"374,"356,"104,"104," 50," 50, 1 " 20," 20,"204,"374,"204," 00,"170," 00,"204,"374,"204," 70, 1 " 20," 20," 70,"124,"124,"124,"222," 70," 70," 20," 20," 20, 1 " 20," 50," 50,"252,"104,"356,"104,"104,"104,"104,"104,"104, 1 "104,"376,"170,"204,"200,"200,"160,"200,"204,"170,"170,"204, 1 "204,"204,"264,"204,"204,"170,"140,"220,"220," 20," 20," 20, 1 " 20," 20," 20," 20," 20," 20," 20," 20," 20," 20," 20," 20, 1 " 20," 20," 20," 20," 20," 20," 20," 20," 20," 22," 22," 14, 1 " 20," 20," 20," 20," 20," 20," 20," 20," 20,"154,"220,"220, 1 "220,"220,"150,"200,"200,"360,"210,"210,"360,"210,"210,"160, 1 "140," 20,"160,"200,"200,"160,"100,"100," 70,"100,"160,"210, 1 "210,"160," 40,"100,"100," 70,"160,"200,"200,"340,"200,"200, 1 "160,"100,"100,"160,"250,"250,"160," 20," 20," 40," 40," 20, 1 " 20," 30,"224,"144," 04," 04," 04," 44," 44," 44,"244,"130, 1 "140,"220,"200,"100,"100," 40,"104,"110," 50," 60,"250,"144, 1 "210,"210,"110,"120," 60," 40," 40,"100,"200,"200,"350,"220, 1 "220,"220,"220,"220,"300,"240,"220,"110,"110,"310,"140,"220, 1 "210,"210,"110," 60," 40," 50," 50," 50,"250,"170,"140,"220, 1 "220,"360,"220,"220,"140,"200,"200,"200,"340,"220,"220,"220, 1 "140,"160,"210,"210,"210,"210,"174," 40," 40," 40," 40,"240, 1 "170," 30," 44," 44," 44,"244,"144,"154,"272,"222,"222,"202, 1 "104,"114," 52," 20," 20,"250,"144," 40," 40,"160,"250,"250, 1 "250," 40," 40,"140,"220," 20,"140,"200,"200,"100,"170,"200, 1 " 30," 40," 40," 40,"100," 40," 40," 40," 30,"300," 40," 40, 1 " 40," 20," 40," 40," 40,"300," 20,"250,"100," 0 1 / 0007 data char/ 1 30 * 886, 1 886,886,346,353,356,363,370,377,384,387,396,405,410,415,418, 1 419,420,425,432,439,446,453,460,467,474,481,488,495,499,504, 1 509,513,518,525,006,020,032,046,058,072,086,100,113,128,142, 1 156,168,180,192,206,220,232,244,258,270,282,294,306,320,332, 1 532,541,546,555,558,886,001,013,027,039,053,065,079,093,107, 1 120,135,149,163,175,187,199,213,227,239,251,265,277,289,301, 1 313,327,865,685,874,883,886,886,886,886,886,886,886,886,886, 1 15 * 886, 1 886,886,886,886,886,886,886,886,886,886,886,886,603,339,639, 1 562,587,886,886,655,886,596,886,886,886,630,647,886,578,886, 1 621,886,571,886,612,886,886,886,886,886,886,559,694,700,709, 1 719,727,734,742,749,757,886,763,769,777,785,791,797,803,810, 1 818,824,830,886,836,842,848,856,886,886,886,886,886 1 / 0008 data length/ 1 4122,4122,4122,-3094,3*4122,-10256,12*4122,-3102,9*4122, 1 4122,4122,4218,4158,4218,4218,4218,4218,4158,4248, 1 4248,4187,4187,4154,4125,4122,4187,4218,4218,4218, 1 4218,4218,4218,4218,4218,4218,4218,4171,4186,4187, 1 4171,4187,4218,4218,4218,4218,4218,4218,4218,4218, 1 4218,4218,4218,4218,4218,4218,4218,4218,4218,4218, 1 4218,4218,4218,4218,4218,4218,4218,4218,4218,4218, 1 4248,4187,4248,4156,4122,4122,4186,4218,4186,4218, 1 4186,4218,4216,4218,4202,4232,4218,4218,4186,4186, 1 4186,4216,4216,4186,4186,4218,4186,4186,4186,4186, 1 4216,4186,4248,4248,4248,4156,4122,4122,4122,4122, 1 4122,4122,4122,4122,4122,4122,4122,4122,4122,4122, 1 20*4122, 1 4122,4122,4250,4218,4234,4250,4250,4122,4122,4576, 1 4122,4218,4122,4122,4122,4250,4234,4122,4250,4122, 1 4250,4122,4218,4122,4250,4122,4122,4122,4122,4122, 1 4122,4158,4202,4248,4264,4234,4218,4234,4218,4232, 1 4202,0026,4202,4234,4232,4202,4202,4202,4218,4232, 1 4202,4202,4202,4122,4202,4202,4234,4248,4122,4122, 1 4122,4122,4122 1 / c c check to see if in bounds c 0009 isz = max0(isize, 1) 0010 isz = min0(isz, 5) 0011 id = 0 0012 if ( isz .ge. 3 ) id = 1 0014 len1 = len 0015 do 5 i = 1, len 0016 if ( str(i) .eq. 96 ) len1 = len1 - 1 0018 if ( str(i) .le. 31 ) len1 = len1 - 1 0020 if ( str(i) .eq. 8 ) len1 = len1 - 1 0022 5 continue 0023 ix = ichar(isz) * len1 0024 iy = (7 * ichar(isz)) / 6 0025 irt = mod(max0(irot - 1, 0), 4) + 1 0026 isx = iabs(irt - 3) - 1 0027 isy = iabs(irt - 2) - 1 0028 ixl = isx * ix - isy * iy + ixcur 0029 iyl = isx * iy + isy * ix + iycur 0030 if( abs( ixl - xmid ) .gt. dxb )goto 100 0032 if( abs( iyl - ymid ) .gt. dyb )goto 100 0033 c c plot string c 0034 ix = ixcur 0035 iy = iycur 0036 iesc = 0 0037 lnx = mod ( ( id + 1 ) * isx + 1024, 1024 ) 0038 lny = mod ( ( id + 1 ) * isy + 1024, 1024 ) 0039 do 20 i = 1 , len 0040 nchar = str(i) 0041 nchar = nchar .and. "377 0042 nchar = nchar + iesc 0043 iesc = 96 0044 if ( nchar .eq. 96 ) goto 20 0046 iesc = 0 0047 n = length( nchar ) 0048 ioff = ( mod( iabs(n) , 16 ) - 10 ) * ( id + 1 ) 0049 idx = n / 16 0050 n = mod( iabs(idx) , 64 ) 0051 istr = char( nchar ) 0052 jj = 0 0053 ixl = ix - ioff * isy 0054 iyl = iy + ioff * isx 0055 do 15 ii = 1, n 0056 nchar = charb(ii + istr - 1) .and. "377 0057 do 10 j = 1, 8 0058 ntwo = 2 ** ( 8 - j ) 0059 matrix(j) = nchar / ntwo 0060 nchar = mod ( nchar , ntwo ) 0061 10 continue 0062 call grwdw(matrix,ixl,iyl,lnx,lny,8,id,id,1,0) 0063 ixl = ixl - isy * ( id + 1 ) 0064 iyl = iyl + isx * ( id + 1 ) 0065 15 continue 0066 inc = ( 3 + idx / 64 ) * ( id + 1 ) c 0067 if ( inc .ne. 0 ) goto 17 0069 ix = ix - ioff * isy 0070 iy = iy + ioff * isx c 0071 17 ix = ix + inc * isx 0072 iy = iy + inc * isy 0073 20 continue 0074 return c c string is out of bounds c 0075 100 type 1, (str(i), i = 1, len) 0076 type 2 c 0077 return 0078 1 format('$WARNING string ', 100a1) 0079 2 format(' is out of bounds and will not be plotted') 0080 end .eli .pg .x MARKER, listing .lit 0001 SUBROUTINE MARKER(mrknum, isize) c c places a marker at the current coordinates c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 isz = min0(isize, 5) 0004 isz = max0(isz, 1) 0005 mrk = max0(mrknum, 0) 0006 mrk = min0(mrk, 5) 0007 return 0008 end .eli .pg .x COLTYP, listing .lit 0001 SUBROUTINE COLTYP (ityp) c c this subroutine sets the line type c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 common/color/isc c 0004 itype = min0(ityp, 8) 0005 itype = max0(itype, 0) 0006 isc = itype + 1 0007 return 0008 end .eli .pg .x PLOT, listing .lit 0001 SUBROUTINE PLOT(ixo ,iyo ,ip) 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 common/color/isc 0004 integer idata(4) 0005 ix = ixo 0006 iy = iyo c c check to see if in bounds c 0007 delx = ix - xmid 0008 if(abs(delx) .le. dxb)goto 100 0010 xsc = xmid + sign(dxb, delx) 0011 xsl = 1. 0012 if ( ix .ne. ixcur ) xsl = ( xsc - ixcur ) / float(ix - ixcur) 0014 xsl = (iy - iycur) * xsl 0015 ix = xsc 0016 iy = xsl + iycur c 0017 100 dely = iy - ymid 0018 if(abs(dely) .le. dyb)goto 200 0020 ysc = ymid + sign(dyb, dely) 0021 ysl = 1. 0022 if ( iy .ne. iycur ) ysl = ( ysc - iycur ) / float(iy - iycur) 0024 ysl = (ix - ixcur) * ysl 0025 ix = ysl + ixcur 0026 iy = ysc c c save current coordinates c 0027 200 ixcur = ix 0028 iycur = iy c c plot point c 0029 idata(3)=ix 0030 idata(4)=iy 0031 if(ip.eq.1)call grfvl(1,isc,0,1,idata,2) 0033 idata(1)=ix 0034 idata(2)=iy 0035 return 0036 end .eli .pg .x PLOTIN, listing .lit 0001 SUBROUTINE PLOTIN(x, y, i) c c plots the point x, y where x and y are given in inches. c if i = 0, pen is put up before plotting, else pen is put down. c 0002 ix = ifix(50 * x) 0003 iy = ifix(50 * y) 0004 call plot(ix, iy, i) 0005 return 0006 end .eli .pg .x ERASE, listing .lit 0001 SUBROUTINE ERASE c c erases the entire screen and sets it to the background color c 0002 call grfer("7777, "7777, 0) 0003 return 0004 end .eli .pg .x PLTON, listing .lit 0001 SUBROUTINE PLTON 0002 return 0003 end .eli .pg .x PLTOFF, listing .lit 0001 SUBROUTINE PLTOFF 0002 return 0003 end .ELI .pg .ax VISUAL ROUTINES .X VISUAL routines .x INIPLT, listing .rm 80 .lit 0001 SUBROUTINE INIPLT(iunit, xsize, ysize) c c this routine initializes the plot. xsize and ysize denote the c size of the total plotting surface in inches. no plotting is c permitted outside this area. iunit is the logical unit c number of the plot. for iunit = 6, the plot is sent directly c to the plotter. c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 common /pagsiz/ xbond, ybond c 0004 common /world/ xmin, xmax, ymin, ymax c 0005 byte vtbufr(1024) 0006 integer irec, vtpos, vtstrt, vtbufl 0007 common / vtbuf/ vtbufr, irec, vtpos, vtstrt, vtbufl c 0008 if ( iunit .eq. 7 ) goto 100 0010 open( unit=iunit, access='DIRECT', recordsize=128, initialsize=32, 1 associatevariable=irec ) 0011 irec = 1 0012 vtbufl = 512 0013 vtstrt = 0 0014 vtpos = 0 0015 100 lunplt = iunit c c set terminal to transparent mode TSX command c 0016 call writch(29) 0017 call writch(77) 0018 call erase c 0019 scrx = 75. 0020 scry = 75. c 0021 xbond = xsize 0022 ybond = ysize 0023 ixbond = ifix(scrx * xsize) 0024 iybond = ifix(scry * ysize) 0025 dxb = .5 * ixbond 0026 dyb = .5 * iybond 0027 xmid = dxb 0028 ymid = dyb c c set default values c 0029 ixorig = 0 0030 iyorig = 0 0031 iascr = 0 0032 ibscr = ixbond 0033 icscr = 0 0034 idscr = iybond c 0035 xslope = ixbond 0036 xconst = 0. 0037 yslope = iybond 0038 yconst = 0. c 0039 xmin = 0. 0040 xmax = 1. 0041 ymin = 0. 0042 ymax = 1. c 0043 ichar(1) = 7 0044 ichar(2) = 10 0045 ichar(3) = 19 0046 ichar(4) = 29 0047 ichar(5) = 38 c 0048 return 0049 end .eli .pg .x ENDPLT, listing .lit 0001 SUBROUTINE ENDPLT c c this routine ends plotting by deselecting the plotter and c dumping the buffer c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 call pltoff 0004 if ( lunplt .ne. 7 ) call dmpplt 0006 return 0007 end .eli .pg .x PENDWN, listing .lit 0001 SUBROUTINE PENDWN c c this routine puts the pen down so it will draw c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c c /0d turns on dots c 0003 call writch(27) 0004 call writch(47) 0005 call writch(48) 0006 call writch(100) c c GS (^]) turns on vector mode c 0007 call writch(29) c 0008 return 0009 end .eli .pg .x PENUP, listing .lit 0001 SUBROUTINE PENUP c c this routine puts the pen up c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c c /1d turns off dots c 0003 call writch(27) 0004 call writch(47) 0005 call writch(49) 0006 call writch(100) c c FS (^\) turns on point plot mode c 0007 call writch(28) c 0008 return 0009 end .eli .pg .x WRTSTR, listing .lit 0001 SUBROUTINE WRTSTR(str, len, irot, isize) c c subroutine "write string" c len is the length of the string c irot determines the rotation of the string (1 - 4), 1 is c right side up, 2 is rotated 90 degrees clockwise, etc. c string is checked to see if in is in bounds c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 byte inum(5) 0004 data inum / ':', '9', '1', '2', '3' / 0005 byte str(len) c c check to see if in bounds c 0006 isz = max0(isize, 1) 0007 isz = min0(isz, 5 ) 0008 ix = 2 ** (isz - 1) 0009 iy = 14 * ix 0010 ix = 12 * ix * len 0011 irt = mod(irot - 1, 4) + 1 0012 irrt = mod( 12 - 2 * irt , 8 ) 0013 isx = iabs(irt - 3) - 1 0014 isy = iabs(irt - 2) - 1 0015 ixl = isx * ix - isy * iy + ixcur 0016 iyl = isx * iy + isy * ix + iycur 0017 if( abs(ixl - xmid) .gt. dxb )goto 100 0019 if( abs(iyl - ymid) .gt. dyb )goto 100 0020 c c plot string c /0d turns on dots c 0021 call writch(27) 0022 call writch(47) 0023 call writch(48) 0024 call writch(100) c c US (^_) turns on alphagraphics mode c 0025 call writch(31) c c Set character size c 0026 call writch(27) 0027 call writch(inum(isz)) c c set character rotation c 0028 call writch(27) 0029 call writch('/') 0030 call writch(irrt + 48) 0031 call writch('e') c c write string c 0032 do 999 i = 1, len 0033 call writch(str(i)) 0034 999 continue c 0035 return c c string is out of bounds c 0036 100 call pltoff 0037 type 1, (str(i), i = 1, len) 0038 type 2 0039 call plton c 0040 return 0041 1 format('$WARNING string ', 100a1) 0042 2 format(' is out of bounds and will not be plotted') 0043 end .eli .pg .x MARKER, listing .lit 0001 SUBROUTINE MARKER(mrknum, isize) c c places a marker at the current coordinates c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 return 0004 end .eli .pg .x COLTYP, listing .lit 0001 SUBROUTINE COLTYP (icol) c c this subroutine sets the line color c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 return 0004 end .eli .pg .x PLOT, listing .lit 0001 SUBROUTINE PLOT(ixo, iyo, i) c c this routine moves to the screen coordinates ix, iy. c if i = 0, the pen is put up before moving, if i = 1, the c pen is put down before moving. checks to see if within c surface boundary. c 0002 byte lowy, highy, lowx, highx, yl, yh, xl, xh 0003 data yl, yh, xl, xh / 96, 32, 64, 32 / 0004 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0005 ix = ixo 0006 iy = iyo c c check to see if in bounds c 0007 delx = ix - xmid 0008 if(abs(delx) .le. dxb)goto 100 0010 xsc = xmid + sign(dxb, delx) 0011 xsl = 1. 0012 if ( ix .ne. ixcur ) xsl = ( xsc - ixcur ) / float(ix - ixcur) 0014 xsl = (iy - iycur) * xsl 0015 ix = xsc 0016 iy = xsl + iycur c 0017 100 dely = iy - ymid 0018 if(abs(dely) .le. dyb)goto 200 0020 ysc = ymid + sign(dyb, dely) 0021 ysl = 1. 0022 if ( iy .ne. iycur ) ysl = ( ysc - iycur ) / float(iy - iycur) 0024 ysl = (ix - ixcur) * ysl 0025 ix = ysl + ixcur 0026 iy = ysc c c plot point c 0027 200 if(i .eq. 0)call penup 0029 if(i .ne. 0)call pendwn 0030 c 0031 lowy = mod( iycur, 32 ) .or. yl 0032 highy = ( iycur / 32 ) .or. yh 0033 lowx = mod( ixcur, 32 ) .or. xl 0034 highx = ( ixcur / 32 ) .or. xh c c output previous position c 0035 call writch(highy) 0036 call writch(lowy) 0037 call writch(highx) 0038 call writch(lowx) c 0039 lowy = mod( iy, 32 ) .or. yl 0040 highy = ( iy / 32 ) .or. yh 0041 lowx = mod( ix, 32 ) .or. xl 0042 highx = ( ix / 32 ) .or. xh c c output current position c 0043 call writch(highy) 0044 call writch(lowy) 0045 call writch(highx) 0046 call writch(lowx) c c save current coordinates c 0047 ixcur = ix 0048 iycur = iy c 0049 return 0050 end .eli .pg .x PLOTIN, listing .lit 0001 SUBROUTINE PLOTIN(x, y, i) c c plots the point x, y where x and y are given in inches. c if i = 0, pen is put up before plotting, else pen is put down. c 0002 ix = ifix(75 * x) 0003 iy = ifix(75 * y) 0004 call plot(ix, iy, i) 0005 return 0006 end .eli .pg .x ERASE, listing .lit 0001 SUBROUTINE ERASE c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c c erases graphics page homes cursor c 0003 call writch(27) 0004 call writch(12) c 0005 return 0006 end .eli .pg .x PLTON, listing .lit 0001 SUBROUTINE PLTON 0002 call writch(31) 0003 return 0004 end .eli .pg .x PLTOFF, listing .lit 0001 SUBROUTINE PLTOFF 0002 call writch(24) 0003 return 0004 end .eli .pg .x WRITCH, listing .lit 0001 SUBROUTINE WRITCH(ch) c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 byte vtbufr(1024) 0004 integer irec, vtpos, vtstrt, vtbufl 0005 common / vtbuf/ vtbufr, irec, vtpos, vtstrt, vtbufl c 0006 byte ch 0007 if ( lunplt .eq. 7 ) goto 100 0009 vtpos = vtpos + 1 0010 vtbufr(vtstrt + vtpos) = ch 0011 if ( vtpos .ge. vtbufl ) call dmpplt 0013 return c 0014 100 call ittour(ch) 0015 return 0016 end .eli .pg .x DMPPLT, listing .lit 0001 SUBROUTINE DMPPLT c 0002 common /zgraph/ lunplt, iascr, ibscr, icscr, idscr, 1 xm, ym, dx, dy, dxb, dyb, ixcur, iycur, xmid, ymid, 1 xslope, yslope, xconst, yconst, scrx, scry, ichar(5), 1 ixorig, iyorig c 0003 byte vtbufr(1024) 0004 integer irec, vtpos, vtstrt, vtbufl 0005 common / vtbuf/ vtbufr, irec, vtpos, vtstrt, vtbufl c 0006 if ( lunplt .eq. 7 ) return 0008 write(lunplt'irec) ( vtbufr(i), i = vtstrt + 1, vtstrt + vtpos ) 0009 vtstrt = mod( vtstrt + vtbufl, vtbufl + vtbufl ) 0010 vtpos = 0 c 0011 return 0012 end .ELI .DX