aboutsummaryrefslogtreecommitdiff
path: root/plotlib/plt_base.f
diff options
context:
space:
mode:
Diffstat (limited to 'plotlib/plt_base.f')
-rw-r--r--plotlib/plt_base.f1026
1 files changed, 1026 insertions, 0 deletions
diff --git a/plotlib/plt_base.f b/plotlib/plt_base.f
new file mode 100644
index 0000000..2f4aa5e
--- /dev/null
+++ b/plotlib/plt_base.f
@@ -0,0 +1,1026 @@
+C***********************************************************************
+C Module: plt_base.f
+C
+C Copyright (C) 1996 Harold Youngren, Mark Drela
+C
+C This library is free software; you can redistribute it and/or
+C modify it under the terms of the GNU Library General Public
+C License as published by the Free Software Foundation; either
+C version 2 of the License, or (at your option) any later version.
+C
+C This library is distributed in the hope that it will be useful,
+C but WITHOUT ANY WARRANTY; without even the implied warranty of
+C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+C Library General Public License for more details.
+C
+C You should have received a copy of the GNU Library General Public
+C License along with this library; if not, write to the Free
+C Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+C
+C Report problems to: guppy@maine.com
+C or drela@mit.edu
+C***********************************************************************
+C
+***********************************************************************
+C Xplot11 *
+C**********
+C
+C Dedicated to perpetuating ugly PLOT-10 and Versatec software
+C into the 21st century...
+C
+C This library supports interactive graphics and hardcopy output using
+C the interfaces defined in gw_subs.f and ps_subs.f.
+C Currently: gw_subs supports X window graphics in B&W or color
+C ps_subs supports B&W or color hardcopy to Postscript file
+C
+C Version 4.46 11/28/01
+C
+C Notes:
+C
+C***********************************************************************
+
+
+ subroutine PLINITIALIZE
+C
+C---Plot package initialization routine
+C Must be called before any color plot calls
+C
+ include 'pltlib.inc'
+C
+ GX_SIZ = 1
+ GY_SIZ = 1
+C---Check for user default for background and set up a colormap
+ call gw_revflag
+ call colormapdefault
+C
+ return
+ end
+
+
+ subroutine PLOPEN(relsize,nunit,idev)
+C
+C---Plot initialization routine
+C
+C Must be called before EACH page plot
+C
+C relsize Fractional size of X-graphics window relative to screen
+C if relsize < 0 the graphics page is in Portrait mode 8.5x11
+C if relsize >=0 the graphics page is in Landscape mode 11x8.5
+C
+C nunit Postscript output file specifier
+C < 0 Postscript output enabled to individual files plotNNN.ps
+C on unit 80 where NNN is cumulative plot number
+C = 0 Postscript output enabled to file plot.ps on unit 80
+C = NNN Postscript output enabled to file plotUUU.ps on unit UUU
+C
+C idev Plotting output selector
+C
+C idev X-window PostScript
+C ---- -------- ----------
+C 1 x
+C 2 B & W
+C 3 x B & W
+C 4 Color
+C 5 x Color
+C
+C Note: idev<1 or idev>5 gives only X-window output
+C (for pseudo-compatibility with old PLTLIB versions)
+C ((if you squint real hard))
+C
+ include 'pltlib.inc'
+C
+ SAVE ifirst, relsize_save, nunit_save
+ DATA ifirst / 0 /
+C
+ I_DEV = idev
+ if(idev.GT.5) I_DEV = 1
+C
+C---- control flags (gw_init will set LGW_COLOR = T if screen has color)
+ LGW_GEN = (I_DEV.EQ.1 .OR. I_DEV.EQ.3 .OR. I_DEV.EQ.5)
+ LPS_GEN = (I_DEV.GE.2)
+ LPS_COLOR = (I_DEV.GE.4)
+C
+C
+C---- clear primitives counter
+ N_PRIM = 0
+C
+ if(ifirst.EQ.0) then
+C------ First-ever PLOPEN call
+C
+ ifirst = 1
+C...graphics window
+ LGW_OPEN = .FALSE.
+ call gw_setup(relsize)
+ LGW_RESIZE = .FALSE.
+C
+C...PostScript (file not yet opened, and no unstroked page exists)
+ NPS_UNIT = -1
+ N_PAGES = 0
+ call ps_setup(nunit)
+C...No zooming to start off
+ call CLRZOOM
+C...Primitives file initializers
+ NPRIM_UNIT = NPRIM_UNIT_DEFAULT
+ LPRIM_OPEN = .FALSE.
+C
+ else
+C------ Subsequent PLOPEN call
+C...if a postscript file has been opened we need to end the page with
+C bounding box information
+ if(LPS_OPEN) call ps_endpage
+C
+ if(abs(relsize-relsize_save) .GT. 0.01) then
+C...relsize specfied has changed from previous PLOPEN call..
+C...re-setup aspect ratio and prepare to resize current graphics window
+ call gw_setup(relsize)
+ LGW_RESIZE = .TRUE.
+ endif
+C
+ if(nunit.NE.nunit_save .OR. nunit.LT.0) then
+C...nunit changed from previous PLOPEN call or individual plots are desired
+C close current PostScript file
+ call ps_close
+C...set up for new PostScript file
+ call ps_setup(nunit)
+ endif
+C
+C...If the prims file is open, rewind to be ready to write from the beginning
+ if(LPRIM_OPEN) then
+ rewind(NPRIM_UNIT)
+ endif
+C
+ endif
+C
+C...Initialize selected plot devices
+ if(LGW_GEN) call gw_init
+ if(LPS_GEN) call ps_init
+C
+ if(LGW_GEN) then
+ if(LGW_CHANGED) write(*,1000) X_WIND, Y_WIND
+ 1000 format(/1x,'X-window size changed to ',f6.2,'" x',f6.2,'"')
+ endif
+C
+C...Initialize line plot width, pattern, color
+ I_PEN = 1
+ I_PAT = -1
+ I_CLR = 1
+ call set_pen(I_PEN)
+ call set_pat(I_PAT)
+ call set_color(I_CLR)
+C
+ X_SCALE = 1.0
+ Y_SCALE = 1.0
+ X_ORG = 0.
+ Y_ORG = 0.
+ X_LST = 0.
+ Y_LST = 0.
+C
+C...No initial user clipping (clipping only to page size)
+ CLP_XMIN = 0.
+ CLP_XMAX = X_PAGE
+ CLP_YMIN = 0.
+ CLP_YMAX = Y_PAGE
+C
+C
+C...Save current call parameters
+ relsize_save = relsize
+ nunit_save = nunit
+C
+ return
+ end
+
+
+ subroutine REPLOT(idev)
+C
+C...Replots plot primitives saved in logging array since last PLOPEN call
+c
+C idev - as defined in PLOPEN header
+C
+ include 'pltlib.inc'
+ dimension xpoly(MaxPolyLine), ypoly(MaxPolyLine)
+C
+ idev_old = I_DEV
+C
+C
+ I_DEV = idev
+ if(idev.LE.0 .OR. idev.GT.5) I_DEV = idev_old
+C
+C...Control flags (LGW_COLOR should be already set for current screen)
+ LGW_GEN = (I_DEV.EQ.1 .OR. I_DEV.EQ.3 .OR. I_DEV.EQ.5)
+ LPS_GEN = (I_DEV.GE.2)
+ LPS_COLOR = (I_DEV.GE.4)
+C
+C...Re-Initialize selected plotting devices
+ if(LGW_GEN) call gw_init
+ if(LPS_GEN) call ps_init
+C
+C...Reset plot globals for this plot
+ I_PEN = 1
+ I_PAT = -1
+ I_CLR = 1
+ call set_pen(I_PEN)
+ call set_pat(I_PAT)
+ call set_color(I_CLR)
+C
+ X_SCALE = 1.0
+ Y_SCALE = 1.0
+ X_ORG = 0.
+ Y_ORG = 0.
+ X_LST = 0.
+ Y_LST = 0.
+C
+C...No initial user clipping (clipping only to window limits)
+ CLP_XMIN = 0.
+ CLP_XMAX = X_PAGE
+ CLP_YMIN = 0.
+ CLP_YMAX = Y_PAGE
+C
+ IPOLY = 0
+ ICLPMIN = 0
+C...Now, go through all the stored plot primitives
+ ICNT = -1
+ 1 call getprim(ICNT,ITYP,IVAL,XVAL,YVAL)
+C
+ if(ICNT.LT.0) go to 10
+C
+ if(ITYP.EQ.PageCommand) then
+ if(IVAL.EQ.-999) then
+ if(LPS_GEN) call ps_endpage
+ endif
+C
+ else if(ITYP.EQ.PlotCommand) then
+ call plot_1(XVAL,YVAL,IVAL)
+C
+C...Not currently using scale info in replots, all X,Y are absolute (HHY)
+ else if(ITYP.EQ.ScaleCommand) then
+ call set_scl(XVAL,YVAL)
+C
+ else if(ITYP.EQ.PenCommand) then
+ I_PEN = IVAL
+C
+ else if(ITYP.EQ.PatternCommand) then
+ I_PAT = IVAL
+C
+ else if(ITYP.EQ.ColorCommand) then
+ I_CLR = IVAL
+C
+ else if(ITYP.EQ.PolylinePointCommand) then
+ IPOLY = IPOLY+1
+ if(IPOLY.GT.MaxPolyline) then
+ write(*,*) '*** Error - too many polyline points'
+ stop
+ endif
+ xpoly(IPOLY) = XVAL
+ ypoly(IPOLY) = YVAL
+C
+ else if(ITYP.EQ.PolylineDrawCommand) then
+ IPOLY = IPOLY+1
+ if(IPOLY.GT.MaxPolyline) then
+ write(*,*) '*** Error - too many polyline points'
+ stop
+ endif
+ xpoly(IPOLY) = XVAL
+ ypoly(IPOLY) = YVAL
+ ifill = IVAL
+ call polyline_1(xpoly,ypoly,IPOLY,ifill)
+ IPOLY = 0
+C
+ else if(ITYP.EQ.MinClipCommand) then
+ CLPMINX = XVAL
+ CLPMINY = YVAL
+ ICLPMIN = 1
+C
+ else if(ITYP.EQ.MaxClipCommand) then
+ if(ICLPMIN.NE.1) then
+ write(*,*) '*** Error - no previous MinClip stored'
+ stop
+ endif
+ call set_clip(CLPMINX,CLPMINY,XVAL,YVAL)
+ ICLPMIN = 0
+C
+ else
+ write(*,*) '? REPLOT -- Illegal Command:', ITYP
+C
+ endif
+ go to 1
+C
+ 10 if(IPOLY.NE.0) then
+ write(*,*) '? REPLOT -- No end to polyline command.'
+ stop
+ endif
+ call PLFLUSH
+C
+ I_DEV = idev_old
+ LGW_GEN = (mod(I_DEV,2) .EQ. 1)
+ LPS_GEN = (I_DEV .GE. 2)
+ LPS_COLOR = (I_DEV .GE. 4)
+C
+ return
+ end
+
+
+ subroutine PLCLOSE
+C---Closes all plotting, no more plots...
+C closes any open postscript files
+C closes X window
+C closes and deletes log file (if used)
+ include 'pltlib.inc'
+C
+ call ps_endpage
+ call gw_close
+ call ps_close
+ if(LPRIM_OPEN) then
+ close(unit=NPRIM_UNIT,status='DELETE')
+ endif
+ return
+ end
+
+
+ subroutine PLEND
+C---Ends current plot,
+C finishes off current postscript plot page
+C ends current X window plot, flushes to display
+ include 'pltlib.inc'
+C
+ call putprim(PageCommand,-999,0.,0.)
+ if(LGW_GEN) call gw_endplot
+ if(LPS_GEN) call ps_endpage
+ return
+ end
+
+
+
+
+ subroutine PLOT(x,y,icode)
+C---Basic plotting routine, does moves and draws in user coordinates
+C with optional reorigin, also can end this plot or all plotting
+C x,y coordinates in user units
+C icode function code (integer)
+C 3 relative move to x,y
+C 2 relative line to x,y
+C -2 relative line to x,y and re-origin plotting to x,y
+C -3 relative move to x,y and re-origin plotting to x,y
+C -999 end this plot page
+C +999 end all plotting, close graphics window
+C
+ include 'pltlib.inc'
+C
+C...Convert plot coordinates to absolute units and plot
+ XABS = xusr2ABS(x)
+ YABS = yusr2ABS(y)
+ CALL PLOTABS(XABS,YABS,icode)
+ return
+ end
+
+
+
+ subroutine PLOTABS(x,y,icode)
+C---Absolute plotting routine, does moves and draws in absolute coordinates
+C with optional reorigin, also can end this plot or all plotting
+C
+C X,Y coordinates in absolute units
+C icode function code (integer)
+C 3 relative move to X,Y
+C 2 relative line to X,Y
+C -2 relative line to X,Y and re-origin plotting to X,Y
+C -3 relative move to X,Y and re-origin plotting to X,Y
+C -999 end this plot page
+C +999 end all plotting, close graphics window
+C
+ include 'pltlib.inc'
+ logical LCODE_OK
+C
+ icabs = abs(icode)
+C
+ LCODE_OK = ( icabs.EQ.2 .OR. icabs.EQ.3 .OR.
+ & icabs.EQ.999 )
+C
+ if(.NOT. LCODE_OK) then
+ write(*,*) 'PLOTABS: Unknown function code: ',icode
+ write(*,*) ' at point X,Y =',X,Y
+ return
+ endif
+C
+C---Check for end of plot page
+ if (icode.EQ.-999) then
+ call PLEND
+C---Check for end of ALL plotting
+ elseif(icode.EQ.+999) then
+ call PLCLOSE
+C
+ else
+C...Store plot primitive
+ call putprim(PlotCommand,icode,X,Y)
+C.....Do draw/move call with absolute coordinates
+ call plot_1(X,Y,icode)
+C
+ endif
+C
+ return
+ end
+
+
+
+
+ subroutine POLYLINE(x,y,n,ifill)
+C---Basic polyline plotting routine, input in user coordinates
+C x,y coordinate arrays in user units
+C n number of x,y points
+C ifill fill flag, 0 for no fill, 1 for filled polygon
+C
+ include 'pltlib.inc'
+ dimension x(n), y(n)
+ dimension XABS(MaxPolyLine), YABS(MaxPolyLine)
+C
+ if(n.LE.1) return
+C...Convert coordinates to absolute coordinates
+ do i=1, n
+ XABS(i) = xusr2ABS(x(i))
+ YABS(i) = yusr2ABS(y(i))
+ end do
+C...Plot polyline in absolute coordinates
+ call POLYLINEABS(XABS,YABS,n,ifill)
+ return
+ end
+
+
+ subroutine POLYLINEABS(X,Y,n,ifill)
+C---Basic polyline plotting routine, input in absolute coordinates
+C X,Y coordinate arrays in absolute units
+C n number of X,Y points
+C ifill fill flag, 0 for no fill, 1 for filled polygon
+C
+ include 'pltlib.inc'
+ dimension X(n), Y(n)
+C
+ if(n.LE.1) return
+C
+C...Store polyline primitives in stored plot array and do polyline plot call
+ icode = ifill
+ do i=1, n-1
+ call putprim(PolylinePointCommand,icode,X(i),Y(i))
+ end do
+ call putprim(PolylineDrawCommand,icode,X(n),Y(n))
+C
+C...plot polyline
+ call polyline_1(X,Y,n,ifill)
+ return
+ end
+
+
+
+ subroutine GETPEN(ipen)
+C...Gets current pen width in pixels
+ include 'pltlib.inc'
+ ipen = I_PEN
+ return
+ end
+
+ subroutine NEWPEN(ipen)
+C...Sets line width from 1 to 5 (pixels)
+ include 'pltlib.inc'
+ if(ipen.EQ.I_PEN) return
+c
+ ip = ipen
+ if (ip.GT.5) ip = 5
+ if (ip.LT.0) ip = 1
+ I_PEN = ip
+C...Install pen command into display primitives list
+ call putprim(PenCommand,ip,0.,0.)
+ return
+ end
+
+
+
+ subroutine GETPAT(ipat)
+C...Gets current line pattern as integer bit pattern
+ include 'pltlib.inc'
+ ipat = I_PAT
+ return
+ end
+
+
+ subroutine NEWPAT(ipat)
+C...Sets line pattern using bit pattern in lower 16 bits of ipat
+ include 'pltlib.inc'
+ if(ipat.EQ.I_PAT) return
+c
+ I_PAT = ipat
+C...Install pattern command into display primitives list
+ call putprim(PatternCommand,ipat,0.,0.)
+ return
+ end
+
+
+
+
+ subroutine GETORIGIN(XORG,YORG)
+C...Gets origin of user system in absolute (page) units
+ include 'pltlib.inc'
+C
+ XORG = X_ORG
+ YORG = Y_ORG
+ return
+ end
+
+
+ subroutine NEWORIGIN(XORG,YORG)
+C...Sets origin of user system in absolute (page) units
+ include 'pltlib.inc'
+C
+ X_ORG = XORG
+ Y_ORG = YORG
+ return
+ end
+
+
+ subroutine GETFACTORS(xscale,yscale)
+C...Gets current scale factors in user units
+ include 'pltlib.inc'
+ xscale = X_SCALE
+ yscale = Y_SCALE
+ return
+ end
+
+
+ subroutine NEWFACTOR(scale)
+C...Sets both plot scale factors to scale
+ include 'pltlib.inc'
+ call set_scl(scale,scale)
+C...Install scale command into display primitives list
+ call putprim(ScaleCommand,0,scale,scale)
+ return
+ end
+
+
+ subroutine NEWFACTORS(xscale,yscale)
+C...Sets plot scale factors
+ include 'pltlib.inc'
+ call set_scl(xscale,yscale)
+C...Install scale command into display primitives list
+ call putprim(ScaleCommand,0,xscale,yscale)
+ return
+ end
+
+
+ subroutine GETUSERTRANS(XORG,YORG,xscale,yscale)
+C...Gets origin and scale factors for user->absolute coordinate transform
+ include 'pltlib.inc'
+C
+ XORG = X_ORG
+ YORG = Y_ORG
+ xscale = X_SCALE
+ yscale = Y_SCALE
+ return
+ end
+
+
+ subroutine NEWUSERTRANS(XORG,YORG,xscale,yscale)
+C...Sets origin and scale factors for user->absolute coordinate transform
+ include 'pltlib.inc'
+C
+ X_ORG = XORG
+ Y_ORG = YORG
+ X_SCALE = xscale
+ Y_SCALE = yscale
+ return
+ end
+
+
+ subroutine GETLASTXY(x,y)
+C...Return last x,y plotting location in user coordinates
+ include 'pltlib.inc'
+C
+ call GETLASTXYABS(XABS,YABS)
+ x = XABS2usr(XABS)
+ y = YABS2usr(YABS)
+ return
+ end
+
+
+ subroutine GETLASTXYABS(X,Y)
+C...Return last x,y plotting location in user coordinates
+ include 'pltlib.inc'
+C
+ X = X_LST
+ Y = Y_LST
+ return
+ end
+
+
+ subroutine GETCURSORXY(x,y,chkey)
+C...Return current cursor (mouse) x,y location in user coordinates
+C...chkey returns the key pressed (instead of mouse click, say)
+ include 'pltlib.inc'
+ character*1 chkey
+C
+ call getcursorxyabs(XA,YA,chkey)
+C...get user coordinates
+ x = XABS2usr(XA)
+ y = YABS2usr(YA)
+ return
+ end
+
+
+ subroutine GETCURSORXYABS(X,Y,chkey)
+C...Return current cursor (mouse) X,Y location in absolute coordinates
+C...chkey returns the key pressed (instead of mouse click, say)
+ include 'pltlib.inc'
+ character*1 chkey
+C
+ call gw_curs(XZ,YZ,khar)
+ chkey = char(khar)
+ if(LGW_GEN) call gw_flush
+C
+C...get absolute coordinates
+ X = X_ZM2ABS(XZ)
+ Y = Y_ZM2ABS(YZ)
+ return
+ end
+
+
+
+ subroutine GETWINSIZE(XSIZE,YSIZE)
+C...Returns current size of graphics window in absolute (page) units
+ include 'pltlib.inc'
+C
+ XSIZE = float(GX_SIZ) / G_SCALE
+ YSIZE = float(GY_SIZ) / G_SCALE
+ return
+ end
+
+ subroutine GETPAGESIZE(XPAGE,YPAGE)
+C...Returns current size of page in absolute (page) units
+ include 'pltlib.inc'
+C
+ XPAGE = X_PAGE
+ YPAGE = Y_PAGE
+ return
+ end
+
+ subroutine GETREVVIDEO(lflag)
+C...Gets reverse video flag
+C Returns lflag = TRUE if reverse video is set
+C
+ include 'pltlib.inc'
+ logical lflag
+ lflag = LGW_REVVIDEO
+ return
+ end
+
+
+
+
+ subroutine WINERASE
+C...Erases the graphics area
+ include 'pltlib.inc'
+ if(LGW_GEN) call gw_clear
+ return
+ end
+
+
+ subroutine PLFLUSH
+C...Flush out plot components in buffers
+ include 'pltlib.inc'
+ if(LGW_GEN) call gw_flush
+ if(LPS_GEN) call ps_flush
+ return
+ end
+
+
+ subroutine DRAWTOSCREEN
+C...Sets plotting destination to screen
+ include 'pltlib.inc'
+C
+ call gw_drawtoscreen
+ return
+ end
+
+
+ subroutine DRAWTOBUFFER
+C...Sets plotting destination to background buffer
+ include 'pltlib.inc'
+C
+ call gw_drawtobuffer
+ return
+ end
+
+
+ subroutine SHOWBUFFER
+C...Displays contents of background buffer to screen
+ include 'pltlib.inc'
+C
+ call gw_showbuffer
+ return
+ end
+
+
+ subroutine NEWCLIP(xmin,xmax,ymin,ymax)
+C...Sets clip limits in user coordinates
+ include 'pltlib.inc'
+C
+ X_MIN = xusr2ABS(xmin)
+ X_MAX = xusr2ABS(xmax)
+ Y_MIN = yusr2ABS(ymin)
+ Y_MAX = yusr2ABS(ymax)
+ call set_clip(X_MIN,Y_MIN,X_MAX,Y_MAX)
+ call putprim(MinClipCommand,0,X_MIN,Y_MIN)
+ call putprim(MaxClipCommand,0,X_MAX,Y_MAX)
+C
+ return
+ end
+
+ subroutine NEWCLIPABS(XMIN,XMAX,YMIN,YMAX)
+C...Sets clip limits in absolute coordinates
+ include 'pltlib.inc'
+C
+ call set_clip(XMIN,YMIN,XMAX,YMAX)
+ call putprim(MinClipCommand,0,XMIN,YMIN)
+ call putprim(MaxClipCommand,0,XMAX,YMAX)
+C
+ return
+ end
+
+ subroutine GETCLIP(xmin,xmax,ymin,ymax)
+C...Returns clip limits in user coordinates
+C
+ include 'pltlib.inc'
+C
+ xmin = XABS2usr(CLP_XMIN)
+ xmax = XABS2usr(CLP_XMAX)
+ ymin = YABS2usr(CLP_YMIN)
+ ymax = YABS2usr(CLP_YMAX)
+ return
+ end
+
+ subroutine GETCLIPABS(XMIN,XMAX,YMIN,YMAX)
+C...Returns clip limits specified in absolute (page) coordinates
+C i.e. in inches
+C
+ include 'pltlib.inc'
+C
+ XMIN = CLP_XMIN
+ YMIN = CLP_YMIN
+ XMAX = CLP_XMAX
+ YMAX = CLP_YMAX
+ return
+ end
+
+ subroutine CLRCLIP
+C...Resets user clip limits to graphics window limits (no visible clipping)
+c
+ include 'pltlib.inc'
+c
+ call set_clip(0.0,0.0,X_PAGE,Y_PAGE)
+ call putprim(MinClipCommand,0,0.0 , 0.0)
+ call putprim(MaxClipCommand,0,X_PAGE,Y_PAGE)
+C
+ return
+ end
+
+
+
+ subroutine GETZOOMABS(XOFF,YOFF,XFAC,YFAC)
+C...Returns zoom offsets and scale factors
+C XOFF, YOFF are the offsets in absolute coordinates
+C XFAC, YFAC are the zoom factors applied to XY'=XYFAC*(XY+XYOFF)
+ include 'pltlib.inc'
+C
+ XOFF = XOFF_ZOOM
+ YOFF = YOFF_ZOOM
+ XFAC = XFAC_ZOOM
+ YFAC = YFAC_ZOOM
+C
+ return
+ end
+
+ subroutine NEWZOOMABS(XOFF,YOFF,XFAC,YFAC)
+C...Explicitly sets zoom offsets and scale factors
+C The parameters to NEWZOOMABS are the same as output from GETZOOMABS.
+C XOFF, YOFF are the offsets in absolute coordinates
+C XFAC, YFAC are the zoom factors applied to XY'=XYFAC*(XY+XYOFF)
+ include 'pltlib.inc'
+C
+ XOFF_ZOOM = XOFF
+ YOFF_ZOOM = YOFF
+ XFAC_ZOOM = XFAC
+ YFAC_ZOOM = YFAC
+c...Re-draw zoomed plot to X-window only
+c call REPLOT(1)
+C
+ return
+ end
+
+ subroutine USETZOOM(LXYSAME,LCURSOR)
+C...User interactively sets zoom box, either by mouse selection, or
+C by asking for coordinates of the zoom rectangle
+ logical LXYSAME,LCURSOR
+ include 'pltlib.inc'
+c
+C...Get zoom parameters from user
+ call set_zoom(XOFF_ZOOM,YOFF_ZOOM,XFAC_ZOOM,YFAC_ZOOM,
+ & LXYSAME,LCURSOR)
+c...Re-draw zoomed plot to X-window only
+c call REPLOT(1)
+ return
+ end
+
+ subroutine CLRZOOM
+C...Resets zoom parameters to no-zoom condition
+ include 'pltlib.inc'
+ call NEWZOOMABS(0.,0.,1.,1.)
+ return
+ end
+
+
+
+
+ function XABS2usr(X)
+C...Converts absolute X to user x
+ include 'pltlib.inc'
+ XABS2usr = (X - X_ORG)/X_SCALE
+ return
+ end
+
+ function YABS2usr(Y)
+C...Converts absolute Y to user y
+ include 'pltlib.inc'
+ YABS2usr = (Y - Y_ORG)/Y_SCALE
+ return
+ end
+
+ function xusr2ABS(x)
+C...Converts user x to absolute X
+ include 'pltlib.inc'
+ xusr2ABS = x*X_SCALE + X_ORG
+ return
+ end
+
+ function yusr2ABS(y)
+C...Converts user y to absolute Y
+ include 'pltlib.inc'
+ yusr2ABS = y*Y_SCALE + Y_ORG
+ return
+ end
+
+
+
+ subroutine PLGRID (x,y,nx,xd,ny,yd,lmask)
+C...Generates linear and non-linear grid patterns (with line masks)
+C
+C Where: x,y user coordinate of lower lefthand corner of
+c the grid to be generated.
+c
+c nx number of intervals in the x direction
+c if 'nx' is greater than 1000, then argument
+c 'xd' will be treated as an array of interval values
+c with 'nx-1000' elements. '-nx' indicates that the
+c actual vertical line generations are to be suppressed.
+c xd (nx<1000) user coordinate distance between uniformly
+c spaced vertical lines
+c (nx>1000) an array of values for spacing vertical
+c lines at varying intervals
+c
+c ny number of intervals in the y direction.
+c if 'ny' is greater than 1000, then argument
+c 'yd' will be treated as an array of interval values
+c with 'ny-1000' elements. '-ny' indicates that the
+c actual horizontal line generations are to be suppressed.
+c yd (ny<1000) user coordinate distance between uniformly
+c spaced horizontal lines
+c (ny>1000) an array of values for spacing horizontal
+c lines at varying intervals
+c
+c lmask line mask bit pattern to be used in generating
+c the gridded form.
+c
+c calls: PLGRIDABS
+C
+ DIMENSION xd(*),yd(*)
+ DIMENSION XDABS(500), YDABS(500)
+
+C
+ XABS = xusr2ABS(x)
+ YABS = yusr2ABS(y)
+ call GETFACTORS(xscale,yscale)
+ XDABS(1) = xscale*xd(1)
+ YDABS(1) = yscale*yd(1)
+C
+C...Decode grid interval information and scale arrays if necessary
+ MX = IABS(nx)
+ if(MX.GT.1000) then
+ JX = MX/1000
+ MX = MX - JX*1000
+ do i=2, MX
+ XDABS(i) = xscale*xd(i)
+ end do
+ ENDIF
+ MY = IABS(ny)
+ if(MY.GT.1000) then
+ JY = MY/1000
+ MY = MY - JY*1000
+ do i=2, MY
+ YDABS(i) = yscale*yd(i)
+ end do
+ ENDIF
+C
+C...Call absolute coordinate routine
+ call PLGRIDABS(XABS,YABS,nx,XDABS,ny,YDABS,lmask)
+ RETURN
+ END
+
+
+ subroutine PLGRIDABS(X,Y,nx,XD,ny,YD,lmask)
+C...Generates linear and non-linear grid patterns (with line masks)
+C
+C Where: X,Y absolute coordinate of lower lefthand corner of
+c the grid to be generated.
+c
+c nx number of intervals in the x direction
+c if 'nx' is greater than 1000, then argument
+c 'xd' will be treated as an array of interval values
+c with 'nx-1000' elements. '-nx' indicates that the
+c actual vertical line generations are to be suppressed.
+c XD (nx<1000) absolute coordinate distance between uniformly
+c spaced vertical lines
+c (nx>1000) an array of values for spacing vertical
+c lines at varying intervals
+c
+c ny number of intervals in the y direction.
+c if 'ny' is greater than 1000, then argument
+c 'yd' will be treated as an array of interval values
+c with 'ny-1000' elements. '-ny' indicates that the
+c actual horizontal line generations are to be suppressed.
+c YD (ny<1000) absolute coordinate distance between uniformly
+c spaced horizontal lines
+c (ny>1000) an array of values for spacing horizontal
+c lines at varying intervals
+c
+c lmask line mask bit pattern to be used in generating
+c the gridded form.
+c
+c calls: PLOTABS
+C
+ DIMENSION XD(*),YD(*)
+C
+C...Decode grid interval information
+ MX = IABS(nx)
+ MY = IABS(ny)
+ JX = MX/1000
+ JY = MY/1000
+ MX = MX - JX*1000
+ MY = MY - JY*1000
+C
+C...Save and set line mask pattern
+ LMSK = LMASK
+ CALL GETPAT(IMASK)
+ CALL NEWPAT(LMSK)
+C
+C...Set x ordinates for horizontal lines
+ X1 = X
+ X2 = X + XD(1)*FLOAT(MX)
+C
+C...Check for 'xd' single value or array
+ IF (JX.NE.0) THEN
+C...'XD' array, recompute right x ordinate
+ X2 = X
+ DO I=1,MX
+ X2 = X2 + XD(I)
+ END DO
+ ENDIF
+C
+C...Generate horizontal lines
+ Y2 = Y
+ IF (NY.GT.0) THEN
+ CALL PLOTABS(X1,Y2,+3)
+ CALL PLOTABS(X2,Y2,+2)
+ ENDIF
+ J = 1
+ DO I=1,MY
+ Y2 = Y2 + YD(J)
+ IF (NY.GT.0) THEN
+ CALL PLOTABS(X1,Y2,+3)
+ CALL PLOTABS(X2,Y2,+2)
+ ENDIF
+ J = J + JY
+ END DO
+C
+C...Generate vertical lines
+ IF (NX.GT.0) THEN
+ Y1 = y
+ CALL PLOTABS(X1,Y1,+3)
+ CALL PLOTABS(X1,Y2,+2)
+ J = 1
+ DO I=1,MX
+ X1 = X1 + XD(J)
+ CALL PLOTABS(X1,Y1,+3)
+ CALL PLOTABS(X1,Y2,+2)
+ J = J + JX
+ END DO
+ ENDIF
+C
+C...Restore line mask pattern
+ CALL NEWPAT(IMASK)
+C
+ RETURN
+ END