FTN4,L,Y
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
*  NAME:   GRAPH                      * 
*  SOURCE: 92091-18016                * 
*  RELOC:  92091-16016                * 
*  PGMR:   G. Jackoway, M. Fackler    * 
*************************************** 
$PAGE 
$CDS ON 
      SUBROUTINE CLONE
      STOP 'CLONE DANS GRAPH.FTN !' 
      END 
CC************************************************************
C 
C      NAME: Interface Module for LGRID 
C 
CC*********************************************************** 
C 
      SUBROUTINE LGRID(XTIC,YTIC,XORG,YORG,XMJC,YMJC,TSx,Tsy) 
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     This module is the interface module for the command LGRID.
C 
C     The LGRID command draws labelled axes with grid pattern 
C     in the world coordinate window.  The user specifies the 
C     origin for the axes, the space between minor grids (or tics)
C     the major grid to minor grid (or tic) ratio, and the size 
C     of minor tics thru the parameters.  If the size of the minor
C     tics is specified as 0, then GRID draws minor grids with line-
C     style 2.
C 
C     This interface module receives the user call, and hands 
C     everything to the subroutine AXELS, which does all the
C     outputting for the 4 routines AXES,LAXES,GRID, and LGRID. 
C 
C     There are no optional parameters for this module, but it
C     is indicated where additional code could be inserted to handle
C     optional parameters.
C 
C     The parameters in the calling sequence have the following 
C     meanings: 
C 
C  Parameter     Type        Meaning
C  ---------   ----------    -------------------------------------- 
C 
C    XTIC      Real,Input    Space between grids/tics on the X axis 
C                            (in world coordinates) 
C 
C    YTIC         "          Space between grids/tics on the Y axis 
C                            (in world coordinates) 
C 
C    XORG         "          X-Origin of the axes (world coordinates) 
C 
C    YORG         "          Y-Origin of the axes (world coordinates) 
C 
C    XMJC         "          1 grid in XMJC grids/tics is a major one         
C                            on the X axis
C 
C    YMJC         "          1 grid in YMJC grids/tics is a major one 
C                            on the Y axis
C 
C    Tsx, Tsy     "          Minor Tic sizes (in world coordinates) 
C                            If = 0, minor grids drawn with linestyle 2 
C                            instead of tics. 
C 
C***********************************************************
$PAGE 
C*******************************************************************
C 
C     Set up the parameters 
C     ********************* 
C 
      REAL XTIC,YTIC,XORG,YORG,XMJC,YMJC,TSx,Tsy
C 
C******************************************************************** 
C 
C     SET up the variables
C     ********************
C 
      INTEGER INDC
      REAL P1,P2,P3,P4,P5,P6,P7,p8
C 
C **** INDC       Indicator to AXELS which call is requesting output
C                 1=AXES    2=LAXES    3=GRID    4=LGRID
C 
C **** P1,...,P7,p8  Copies of the parameters to send to AXELS
C 
C******************************************************************** 
C 
C Set up P1 thru P8 to send to AXELS.  If the routine wasn't called 
C with enough parameters, and it is going to cause a problem, we will 
C find out here.  This area could be enhanced to set parameters to
C default values if they weren't provided in the call. For FTN4X users
C the intrinsic PCOUNT() will return the number of parameters sent. 
C If N parameters were sent, then the code could be enhanced to set P1        
C thru PN to passed values and set PN+1 thru P8 to defaults.
C 
C To ensure the integrity of the user's variables, set P1 thru P8 
C to the values of the passed parameters.  The P-variables will be            
C passed as parameters to AXELS.
C 
      P1 = XTIC 
      P2 = YTIC 
      P3 = XORG 
      P4 = YORG 
      P5 = XMJC 
      P6 = YMJC 
      P7 = TSx
      P8 = TSy
C 
C Set INDC=4 for call to AXELS. 4 indicates LABELLED GRIDS to AXELS.
C 
      INDC = 4
C 
C Call subroutine AXELS to do everything
C 
      CALL AXELS(INDC,P1,P2,P3,P4,P5,P6,P7,p8)
C 
C The end 
C 
      RETURN
      END 
$FILES (0,0)
CC************************************************************
C 
C      NAME: AXES AND LAXES, GRID AND LGRID 
C 
CC*********************************************************** 
C 
      SUBROUTINE AXELS(IND,P1,P2,P3,P4,P5,P6,P7,p8) 
     + ,92091-16016 REV.5000 <890418.1140>
C 
C 
C     This subroutine handles graph requests for the modules
C     AXES,LAXES,GRID, and LGRID. 
C 
C     It does all the calculations and produces all the graphics output 
C     for the 4 calls. It uses the passed parameter IND to determine
C     what kind of output is being requested. 
C 
C     The parameters in the calling sequence have the following 
C     meanings: 
C 
C  Parameter       Type             Meaning 
C  ---------      -------------     --------------------------------------- 
C 
C    IND          Integer,Input     Indicator of desired action 
C                                   1 = AXES,2 = LAXES
C                                   3 = GRID,4 = LGRID
C 
C    P1            Real,Input       X-Tic Spacing (in world coords) 
C 
C    P2              "              Y-Tic Spacing (in world coords) 
C 
C    P3              "              X-Origin (in world coords)
C 
C    P4              "              Y-Origin (in world coords)
C 
C    P5              "              X-Major count (1 major tic in P5 tics)
C 
C    P6              "              Y-Major count (1 major tic in P6 tics)
C 
C    P7, P8          "              Minor tic sizes (world coords)
C                                   Major tic size is 2 times minor tic size
C                                   If = 0 and GRID or LGRID indicates
C                                    minor grids instead of minor tics
C 
C*************************************************************
C 
C    Set up the parameters
C    *********************
C 
      INTEGER IND 
      REAL P1,P2,P3,P4,P5,P6,P7,p8
C 
C*************************************************************
$PAGE 
C*************************************************************
C 
C     Set up variables
C     ****************
C 
       REAL XSPACE,YSPACE,TICSIZ,XORG,YORG
       INTEGER XCOUNT,YCOUNT,OCODE,ISIZE,RSIZE,IERR,IDUMY 
       REAL RDUMY, WIND(4),OWIND(4),XLEFT,XRGHT,YBOT,YTOP 
       REAL VIEW(4),NWIND(4)
       INTEGER LSTYLE,TCLIP 
       REAL XCUR,YCUR,TSPACE,OFFSET 
       LOGICAL LABEL,GMAJOR,GMINRX,GMINRY,MAJOR 
       INTEGER LOOP,DIR,TICNUM
       REAL WIDTH,HEIGHT,MDGT 
       INTEGER NUMD,IASC(4),XDECM,YDECM 
       LOGICAL XINVRT,YINVRT,IXY
       REAL TICSZX,TICSZY,AR(2),XVWIDE,YVWIDE 
       INTEGER Device(5)
C 
C **** XSPACE           Positive number with the same magnitude as
C                       the X tic spacing parameter P1
C 
C **** YSPACE           Positive number with the same magnitude as
C                       the Y tic spacing parameter P2
C 
C **** XORG             working copy of the X origin parameter P3 
C 
C **** YORG             working copy of the Y origin parameter P4 
C 
C **** XCOUNT           positive integer not equal to zero which
C                       represents the X major tic count derived from P5
C 
C **** YCOUNT           positive integer not equal to zero which
C                       represents the Y major tic count derived from P6
C 
C **** OCODE            used for calling DGL inquiry subroutines
C      ISIZE
C      RSIZE
C      IERR 
C      IDUMY
C      RDUMY
C 
C **** WIND             The original window which may have been user specified
C                       to be inverted in some way. 
C 
C **** XLEFT            ordered window vertices with XLEFT and YBOT the 
C      YBOT             minimums, XRGHT and YTOP the maximums 
C      XRGHT
C      YTOP 
$PAGE 
C 
C **** OWIND            array holding the ordered window limits 
C 
C **** VIEW             array to hold original viewport for restoration 
C                       at the end of AXELS 
C 
C **** NWIND            array to hold AXELS' expanded window for
C                       positioning labels                                    
C 
C **** LSTYLE           for inquiring and storing linestyle information 
C 
C **** TCLIP            output parameter for subroutine CLINE, in which 
C                       is returned an indicator of what kind of clipping 
C                       was done. 
C 
C **** XCUR,            current X or Y coordinate component for tic/grid
C      YCUR             being output
C 
C **** TSPACE           tic spacing (XSPACE or YSPACE) currently in effect
C 
C **** OFFSET           ticmark offset from axis, i.e. 1/2 total length of tic
C 
C **** LABEL            TRUE if want labels 
C 
C **** GMAJOR           TRUE if want major grids
C 
C **** GMINRX           TRUE if want minor grids in X axis direction
C 
C **** GMINRY           TRUE if want minor grids in Y axis direction
C 
C **** MAJOR            TRUE if we are currently outputting a major tic/grid
C 
C **** LOOP             counting variables for loops, etc.
C      DIR
C      TICNUM 
C 
C **** WIDTH            labelling variables 
C      HEIGHT 
C      MDGT 
C      NUMD 
C      IASC 
C      XDECM
C      YDECM
C 
C **** XINVRT           TRUE if window is inverted in X, Y direction
C      YINVRT 
C 
C **** IXY              TRUE if writing labels along X axis 
C                       FALSE if writing labels along Y axis
C 
C **** TICSZX,TICSZY    The world coordinate equivalents of the 
C                       virtual coordinate value in TICSIZ. 
$PAGE 
C 
C **** AR               Aspect Ratio of the virtual coordinate system 
C                       (is an array since DGL inquiry returns 2 values)
C 
C **** XVWIDE           Width of the virtual coordinate system along
C      YVWIDE           each axis.
C 
C****************************************************************** 
C 
C Make working copies of input parameters with more descriptive names.
C Forgive user input errors here. 
C Zero is an illegal value for major and minor tic
C count (P5 and P6) so set counts to 1 if they are zero.  Also
C note that the tic counts, P5 and P6 are put into integers,
C since they must be integer values anyway. 
C 
C MAX1 returns the maximum of two reals as an integer.
C 
      XSPACE = ABS(P1)
      YSPACE = ABS(P2)
      XORG   = P3 
      YORG   = P4 
      XCOUNT = MAX1(1.,ABS(P5)) 
      YCOUNT = MAX1(1.,ABS(P6)) 
      TICSzx = ABS(P7)
      TICSzy = ABS(P8)
C 
C Inquire the window from DGL. Ignore the error return since there can
C only be an error if ISIZE and RSIZE do not match opcode. Since
C these are hard coded error should not occur.
C 
      OCODE = 450 
      ISIZE = 0 
      RSIZE = 4 
      CALL ZIWS(OCODE,ISIZE,RSIZE,IDUMY,WIND,IERR)
C 
C ( WIND(1),WIND(3) ) is lower left 
C ( WIND(2),WIND(4) ) is upper right
C as entered into the DGL system.  However, since inverted windows are
C allowed, we need to order our window limits so we can perform 
C comparisons against the upper and lower limits later. 
C Order into individual variables and also into an array for passing. 
C 
C AMAX1 and AMIN1 return the minimum or maximum of the two reals
C passed in as a real.
C 
      XLEFT = AMIN1(WIND(1),WIND(2))
      OWIND(1) = XLEFT
      XRGHT = AMAX1(WIND(1),WIND(2))
      OWIND(2) = XRGHT
      YBOT = AMIN1(WIND(3),WIND(4)) 
      OWIND(3) = YBOT 
      YTOP = AMAX1(WIND(3),WIND(4)) 
      OWIND(4) = YTOP 
$PAGE 
C 
C The ticsize specified by the user is in virtual coordinates.
C Convert to world coordinates. Since the X axis of the world coordinate
C system need not have units that are the same size as units of the 
C Y axis, this convertion will result in two values. The end result of
C all this being that the appearance of the tic marks on the final plot 
C will be the same along the X and Y axes.
C 
C Steps to doing conversion:  
C   a) inquire the aspect ratio from DGL
C   b) determine the width of the virtual coordinate system in
C      both the x and y directions
C   c) plug values in conversion formula
C 
  
      OCODE = 254 
      RSIZE = 2 
      ISIZE = 0 
      CALL ZIWS(OCODE,ISIZE,RSIZE,IDUMY,AR,IERR)
C 
      XVWIDE = 1. 
      YVWIDE = 1. 
      IF (AR(1) .LT. 1) YVWIDE = AR(1)
      IF (AR(1) .GT. 1) XVWIDE = 1. / AR(1) 
C 
*     TICSZY = TICSIZ * (XRGHT - XLEFT) / XVWIDE  Now sent in...
*     TICSZX = TICSIZ * (YTOP - YBOT) / YVWIDE      directly in P7, P8
C 
C  Inquire the current linestyle from DGL. Save in LSTYLE so it can be
C  restore at program end, since we may change it during axis and grid
C  outputting.
C 
C  Again, ignore the error return since we hard coded all parameters. 
C 
      OCODE = 1062
      ISIZE = 1 
      RSIZE = 0 
      CALL ZIWS(OCODE,ISIZE,RSIZE,LSTYLE,RDUMY,IERR)
C 
C  Indicate if major grids were requested by checking if user called    
C  GRID or LGRID. 
C 
      GMAJOR = (IND .GT. 2) 
C 
C  Indicate if minor grids were requested by user, i.e. GRID or LGRID 
C  call with ticsiz = 0 indicating minor grids, not tics, and COUNT > 1       
C  indicating not all grids are major.
C 
      GMINRX = (GMAJOR .AND. ((TICSZX .EQ. 0.) .AND. (XCOUNT .GT. 1)))
      GMINRY = (GMAJOR .AND. ((TICSZY .EQ. 0.) .AND. (YCOUNT .GT. 1)))
$PAGE 
C 
C  Indicate if labels were requested by the user (LAXES or LGRID) 
C  If they were, then do the following processing which is necessary
C  if and only if labels were requested:
C 
C   1. Call subroutine EXWV to expand the viewport to make room for 
C      the labels.  The window must be expanded also to preserve the
C      window to viewport mapping. EXWV is fed the original window, 
C      (since we already know it) and returns the following:
C 
C           a. new window (NWIND) 
C           b. original viewport (VIEW) 
C           c. character width (WIDTH)
C           d. character height (HEIGHT)
C 
C      The window and viewport are later restored to their original 
C      values.
C 
C   2. Set logicals to indicate whether or not we have an inverted
C      window in the X and Y directions 
C 
C   3. If we have an inverted X window then we must make character
C      width negative so we will move in the proper direction when
C      centering our labels.
C 
C   4. If we have an inverted Y window then we must make character
C      height negative so we will move in the proper direction when 
C      centering our labels.
C 
C   5. Calculate XDECM and YDECM to determine the number of digits to go
C      to the left of the decimal point for labels along the X and Y axes.
C      The calculation is based on the magnitude of the window. 
C 
C MAX0 returns as an integer, the maximum of two integers.
C INT returns the largest integer less than or equal to the given real. 
C AMAX1 returns the maximum of two reals as a real
C ALOGT returns log base 10 of the real specified.
C ABS returns the absolute value of the specified real
C 
      LABEL = ((IND .EQ. 2) .OR. (IND .EQ. 4))
C 
      IF (.NOT.LABEL) GO TO 5 
C 
        CALL EXWV(WIND,VIEW,NWIND,WIDTH,HEIGHT) 
        XINVRT = (WIND(2).LT.WIND(1)) 
        YINVRT = (WIND(4).LT.WIND(3)) 
        IF (XINVRT) WIDTH = - WIDTH 
        IF (YINVRT) HEIGHT = - HEIGHT 
        XDECM=MAX0(1,(INT(ALOGT(AMAX1(ABS(XLEFT),ABS(XRGHT))+.01))+1))
        YDECM=MAX0(1,(INT(ALOGT(AMAX1(ABS(YBOT),ABS(YTOP))+.01))+1))
C 
 5    CONTINUE
$PAGE 
C********************************************************************** 
C*
C*
C*   Do for the X-axis and then the Y-axis
C*
C*     Set IXY to indicate which axis to work on. 
C*     Draw axis across the window. Output label if required. 
C*     Draw tics/grids to right of origin if any there. Output
C*          labels if required. 
C*     Draw tics/grids to left or origin if any there. Output 
C*          labels if required. 
C*
C*     Only those X tics that are inside the left/right window
C*     boundaries and those Y tics that are inside the top/bottom 
C*     window boundaries get labelled.
C*     Axes and grids have 'infinite' length so aren't clipped that way.
C*     The clipping algorithm outputs all the lines and reports why 
C*     tics are clipped; The decision on whether or not 
C*     a label it required to be made.
C*
C********************************************************************** 
C 
C ******** X AXIS ************************************************
C 
C Set IXY to indicate X axis tics being drawn 
C 
      IXY = .TRUE.
C 
C Set linestyle to 1 for the axis unless we came in with linestyle 1
C 
        CALL Ziws(5050,5,0,Device,0,Ierr) 
        IF (Device(1) .EQ. 2H26) THEN 
           IF (Lstyle .NE. 8) CALL Zlstl(8) 
        ELSE
           IF (LSTYLE.NE.1) CALL ZLSTL(1)   
        ENDIF 
C 
C Call subroutine with axis endpoints to draw X axis. 
C TCLIP returns with clip type. 
C 
       CALL CLINE(XORG,YBOT,XORG,YTOP,OWIND,TCLIP)
C 
C Label the origin if labels requested and X-axis was inside the window 
C 
       IF ((p1.ge.0) .and.
     *   (LABEL).AND.(TCLIP.EQ.0)) CALL OUTLB(XORG,NWIND,XDECM,WIDTH, 
     * HEIGHT,IXY)
C 
C If no tics/grids requested, then no more labels and we are done with X-axis 
C 
       IF (XSPACE .EQ. 0.0) GO TO 100 
$PAGE 
C 
C Prepare for minor grids if there are some by setting linestyle to 2.
C Linestyle will be set to 1 for major grids and re-set to 1 afterwards.
C This way there are only 2*number of major grids calls to ZLSTL
C 
       IF (GMINRX) CALL ZLSTL(2)        !???????????????????
C 
C Output tics/grids for the right side of the axis and then the left side 
C      DIR = 1 for right side,      DIR  =  2 for left side 
C 
       DO 60 DIR = 1,2
C 
C Calculate number of potential tics/grids to right/left side of origin.
C Some may be invisible to left/right of window.
C If DIR=1 the TICNUM=(XRGHT-XORG)/XSPACE else TICNUM=(XORG-XLEFT)/XSPACE 
C 
         IF (DIR.EQ.2) GO TO 10 
           TICNUM = (XRGHT - XORG) / XSPACE                                   
           TSPACE = XSPACE
           GO TO 20 
 10      TICNUM = (XORG - XLEFT) / XSPACE                                     
         TSPACE = 0. - XSPACE                                                 
 20      CONTINUE 
C 
C If no potential tics/grids inside window, finished with this side.
C If LAXES or AXES and ticsize = 0 no grids or tics.
C 
         IF ((TICNUM.LE.0).OR.((TICSZX.EQ.0).AND.(IND.LE.2))) GO TO 50
C 
C        Request output for all potential tics/grids
C 
         DO 40 LOOP = 1,TICNUM
C 
           XCUR = XORG + TSPACE*LOOP
           MAJOR = (MOD(LOOP,XCOUNT).EQ.0)
C 
C          If major or minor grid then output grids else output ticmarks
C 
           IF ((GMAJOR.AND.MAJOR).OR.(GMINRX)) GO TO 30 
C 
C          If minor tic then OFFSET = TICSZX/2 else MAJOR TIC OFFSET = TICSZX 
C 
           OFFSET = TICSZX/2. 
           IF (MAJOR) OFFSET = TICSZX 
C 
C          Output a ticmark 
C 
           CALL CLINE(XCUR,YORG-OFFSET,XCUR,YORG+OFFSET,OWIND,TCLIP)
           GO TO 35 
$PAGE 
C 
C          Output a  major or minor grid. 
C 
 30        IF ((MAJOR).AND.(GMINRX)) CALL ZLSTL(1)
           CALL CLINE(XCUR,YBOT,XCUR,YTOP,OWIND,TCLIP)
           IF ((MAJOR).AND.(GMINRX)) CALL ZLSTL(2)   !????????????
C 
 35        CONTINUE 
C 
C Output a label if requested and X axis was not totally to the left or 
C right of the window.
C 
           if((p1.ge.0) .and. 
     *     (LABEL).AND.((MAJOR).AND.(TCLIP.NE.1))) CALL OUTLB(XCUR, 
     *     NWIND,XDECM,WIDTH,HEIGHT,IXY)
C 
 40        CONTINUE 
 50      CONTINUE 
 60      CONTINUE 
C 
C********************************************************************** 
$PAGE 
C 
C ******** Y AXIS ************************************************
C 
 100    CONTINUE
C 
C Set IXY to false to indicate Y axis tics being drawn
C 
        IXY = .FALSE. 
C 
C Set linestyle to 1 for this axis (we don't know what we came in with) 
C 
        IF (GMINRX) CALL ZLSTL(1) 
C 
C Draw X axis, which is just a giant tic mark on Y axis 
C 
       CALL CLINE(XLEFT,YORG,XRGHT,YORG,OWIND,TCLIP)
C 
C Label the origin if labels requested and X-axis was inside the window 
C 
       IF((LABEL).AND.(TCLIP .EQ. 0)) CALL OUTLB(YORG,NWIND,YDECM,WIDTH,
     * HEIGHT,IXY)
C 
C If no tics/grids requested, then no more labels and we are done with all    
C No tics or grids for LAXES and AXES if tic size = 0.
C 
       IF ((YSPACE.EQ.0.0).OR.((TICSZY.EQ.0).AND.(IND.LE.2))) GO TO 200 
C 
C prepare for minor grids if there are any be setting linestyle to 2. 
C Linestyle will be set to 1 for major grids and reset to 2 afterwards. 
C This way there are only 2*number of major tics calls to ZLSTL 
C 
       IF (GMINRY) CALL ZLSTL(2)      !???????????????????? 
C 
C Output tics/grids for the top side of the axis and then the bottom side 
C      DIR = 1 for top  DIR  =  2 for bottom
C 
       DO 160 DIR = 1,2 
C 
C        Set the current Y-axis position to the Y origin
C 
         YCUR = YORG
C 
C Calculate number of potential tics/grids on top/bottom of origin. 
C Some may be invisible to bottom/top of window.
C If DIR=1 then TICNUM=(YTOP-YORG)/YSPACE else TICNUM=(YORG-XBOT)/YSPACE
C 
         IF (DIR.EQ.2) GO TO 110
           TICNUM = (YTOP - YORG) / YSPACE                                    
           TSPACE = YSPACE
           GO TO 120
 110     TICNUM = (YORG - YBOT) / YSPACE                                      
         TSPACE = 0. - YSPACE                                                 
 120     CONTINUE 
$PAGE 
C 
C If no potential tics/grids inside window, finished with this side.
C 
         IF (TICNUM.LE.0) GO TO 150 
C 
C        Request output for all potential tics/grids
C 
         DO 140 LOOP = 1,TICNUM 
           YCUR = YORG + TSPACE*LOOP
           MAJOR = (MOD(LOOP,YCOUNT).EQ.0)
C 
C          If major or minor grid then output grids else output ticmarks. 
C 
           IF ((GMAJOR.AND.MAJOR).OR.(GMINRY)) GO TO 130
C 
C          If minor tic then OFFSET = TICSZY/2 else MAJOR TIC OFFSET = TICSZY 
C 
           OFFSET = TICSZY/2. 
           IF (MAJOR) OFFSET = TICSZY 
C 
C          Output a ticmark 
C 
           CALL CLINE(XORG-OFFSET,YCUR,XORG+OFFSET,YCUR,OWIND,TCLIP)
           GO TO 135
C 
C          Output a grid
C 
 130       IF ((MAJOR).AND.(GMINRY)) CALL ZLSTL(1)
           CALL CLINE(XLEFT,YCUR,XRGHT,YCUR,OWIND,TCLIP)
           IF ((MAJOR).AND.(GMINRY)) CALL ZLSTL(2)      ! ??????
C 
 135       CONTINUE 
C 
C Output a label if requested and Y axis was not totally above or below 
C the window. 
C 
           IF ((LABEL).AND.((MAJOR).AND.(TCLIP.NE.2))) CALL OUTLB(YCUR,       
     *     NWIND,YDECM,WIDTH,HEIGHT,IXY)
C 
 137       CONTINUE 
 140       CONTINUE 
 150     CONTINUE 
 160     CONTINUE 
C 
C Restore original linestyle
C 
 200  CONTINUE
      CALL ZLSTL(LSTYLE)
$PAGE 
C 
C Restore original window and viewport if labels were drawn.
C 
      IF(.NOT. LABEL) GO TO 999 
      CALL ZWIND(WIND(1),WIND(2),WIND(3),WIND(4)) 
      CALL ZVIEW(VIEW(1),VIEW(2),VIEW(3),VIEW(4)) 
999   CONTINUE
      RETURN
      END 
CC******************************************************************
C 
C 
C 
C     NAME: EXWV, subroutine to expand window and viewport
C           for labels
C 
C 
C 
CC******************************************************************
C 
      SUBROUTINE EXWV(WIND,VIEW,NWIND,WIDTH,HEIGHT) 
     + ,92091-16016 REV.5000 <890418.1140>
C 
C 
C     Subroutine EXWV expands the window and viewport to
C     allow room for graph labels.
C     The current character size will be used. It is assumed that 
C     the user sets the appropriate size so that characters are 
C     readable and that labels do not overlap each other. It is 
C     also assumed that the user has left enough room in the
C     viewport so allow room for labels. If not enough room to expand 
C     the viewport as desired, expand bottom or left if possible
C     and leave the other side unexpanded. If neither side can be 
C     expanded leave everything as originally specified.
C 
C     The parameters in the calling sequence have the following 
C     meanings: 
C 
C   Parameter   Type           Meaning
C   ---------   -----------    -------------------------
C 
C     WIND(4)   Real,input     original window
C     VIEW(4)   Real,output    array to return back original viewport 
C     NWIND(4)  Real,output    array to return new, expanded window 
C     WIDTH     Real,output    character width
C     HEIGHT    Real,output    character height 
C 
C*********************************************************************
C 
C     Set up the parameters 
C     ********************* 
C 
      REAL WIND(4),VIEW(4),NWIND(4),WIDTH,HEIGHT
C 
C******************************************************************** 
$PAGE 
C******************************************************************** 
C 
C     Set up the variables
C     ********************
  
      REAL RLIST(4),SPACE,EXWHT,EXWWD,
     *     NYBOT,NXLEFT,XLEFT,XRGHT,YBOT,YTOP,
     *     VLEFT,VRGHT,VBOT,VTOP,WWIDE,WHIGH, 
     *     NVLEFT,NVBOT,VWIDE,VHIGH,PWWD,PWHT 
C 
      INTEGER OPCODE,ISIZE,ILIST(1),RSIZE(4),IERR 
C 
C  ILIST(1),RLIST(4)  arrays for DGL inquiry call 
C  OPCODE,ISIZE,IERR  parameters for DGL inquiry call 
C  EXWHT              amount of expanded window height
C  EXWWD              amount of expanded window width 
C  XLEFT              min X coordinate of original window 
C  XRGHT              max X coordinate of original window 
C  YBOT               min Y coordinate of original window 
C  YTOP               max Y coordinate of original window 
C  NXLEFT             far left X coordinate of new window 
C  NYBOT              bottom Y coordinate of new window 
C  VLEFT              min X coordinate of original viewport 
C  VRGHT              max X coordinate of original viewport 
C  VBOT               min Y coordinate of original viewport 
C  VTOP               max Y coordinate of original viewport 
C  NVLEFT             far left X coordinate of new viewport 
C  NVBOT              bottom Y coordinate of new viewport 
C  WWIDE              original window width 
C  WHIGH              original window height
C  VWIND              original viewport width 
C  VHIGH              original viewport height
C 
C*********************************************************************
C 
C Inquire the viewport from DGL. Ignore the error return on ZIWS call 
C since we are hard coding input parameters. After inquiry call, copy 
C values to individual variables to facilitate later computations.
C 
      OPCODE = 451
      RSIZE = 4 
      ISIZE = 0 
      CALL ZIWS(OPCODE,ISIZE,RSIZE,ILIST,VIEW,IERR) 
          VLEFT = VIEW(1) 
          VRGHT = VIEW(2) 
          VBOT  = VIEW(3) 
          VTOP  = VIEW(4) 
$PAGE 
C 
C Move window parameters to individual variables to facilitate
C later computations. 
C 
      XLEFT = WIND(1) 
      XRGHT = WIND(2) 
      YBOT  = WIND(3) 
      YTOP  = WIND(4) 
C 
C Inquire current character size. IERR is assumed to be returned as 
C 0 indicating that no errors occurred during the call to ZIWS. Copy
C values into individual variables to facilitate later computations.
C 
      OPCODE = 250
      RSIZE = 2 
      ISIZE = 0 
      CALL ZIWS(OPCODE,ISIZE,RSIZE,ILIST,RLIST,IERR)
          WIDTH  = RLIST(1) 
          HEIGHT = RLIST(2) 
C 
C*******************************************************************
C 
C Based on the character size, temporarily expand the window and
C viewport to accomodate labels. 7 characters (including decimal
C point and negative sign) are allowed for labels on the left                 
C side of the graph. Also add some space to allow room between
C the graph and the labels. Assume that the space is the size of
C one character height for labels below the X axis and one
C character width for labels to the left of the Y axis. 
C 
C 
C Compute extra space to add to the height and width of graph 
C Width space made larger depending on whether exponents necessary
      EXWHT = HEIGHT + HEIGHT 
      EXWWD = (WIDTH * Xtrac()) + WIDTH 
C 
C If a normal window, subtract expanded window amount from left and 
C bottom to increase size.
C If an inverted window, add expanded window amount to left and 
C bottom to increase size.
C 
      IF (XRGHT .LT. XLEFT) NXLEFT = XLEFT + EXWWD
      IF (YTOP  .LT. YBOT ) NYBOT  = YBOT  + EXWHT
      IF (XRGHT .GT. XLEFT) NXLEFT = XLEFT - EXWWD
      IF (YTOP  .GT. YBOT ) NYBOT  = YBOT  - EXWHT
C 
C Put new window values in NWIND array and call ZWIND to
C reset window to the expanded values.
C 
      NWIND(1) = NXLEFT 
      NWIND(2) = XRGHT
      NWIND(3) = NYBOT
      NWIND(4) = YTOP 
      CALL ZWIND(NXLEFT,XRGHT,NYBOT,YTOP) 
$PAGE 
C 
C Find out what percent we expanded the window
C and use this to increase the viewport.
C First compute the window height and width,
C taking into account possible inverted window. 
C 
      IF (XRGHT .LT. XLEFT) WWIDE = XLEFT - XRGHT 
      IF (YTOP  .LT. YBOT ) WHIGH = YBOT  - YTOP
      IF (XRGHT .GT. XLEFT) WWIDE = XRGHT - XLEFT 
      IF (YTOP  .GT. YBOT ) WHIGH = YTOP  - YBOT
C 
C Compute percentage we increased the window width (PWWD) 
C and percentage we increased the window height (PWHT). 
C 
      PWWD = (100.0 * EXWWD) / WWIDE
      PWHT = (100.0 * EXWHT) / WHIGH
C                                                                             
C Calculate current viewport width and height 
C 
      VWIDE = VRGHT - VLEFT 
      VHIGH = VTOP  - VBOT
C 
C***********************************************************************
C 
C Determine new viewport limits based on percentage window was
C increased and call ZVIEW to reset the viewport to expanded values.
C If unable to expand viewport recover by only expanding where can and
C and returning to initial values where cannot expand the desied amount/
C 
      NVLEFT = VLEFT - ((VWIDE * PWWD) / 100.)
      NVBOT = VBOT - ((VHIGH * PWHT) / 100.)
C 
C     Checking for inability to expand viewport as expected 
C 
      IF ((NVLEFT .LT. 0.0) .AND. (NVBOT .LT. 0.0)) GO TO 5000
      IF (NVLEFT  .LT. 0.0) GO TO 6000
      IF (NVBOT   .LT. 0.0) GO TO 7000
C 
C     Reset the viewport to expanded limits since passed all checks.
C 
      CALL ZVIEW(NVLEFT,VRGHT,NVBOT,VTOP) 
      GO TO 99999 
C 
C************************************************************************ 
$PAGE 
C************************************************************************ 
C 
C Viewport too small on the left and the bottom of the viewport.
C Set everything back to
C the initial values, so graph will come out in the same place as 
C it would if there were no labels. We do not need to reset the 
C viewport since it has not changed from the original values. 
C 
 5000 CONTINUE
      NWIND(1) = XLEFT
      NWIND(2) = XRGHT
      NWIND(3) = YBOT 
      NWIND(4) = YTOP 
C 
      CALL ZWIND(XLEFT,XRGHT,YBOT,YTOP) 
      GO TO 99999 
C 
C***********************************************************************
C 
C Viewport too small on the left but O.K on the bottom. 
C Go back to original values on the left but expand on the bottom.
C 
 6000 CONTINUE
      NWIND(1) = XLEFT
      NWIND(2) = XRGHT
      CALL ZWIND(XLEFT,XRGHT,NYBOT,YTOP)
      CALL ZVIEW(VLEFT,VRGHT,NVBOT,VTOP)
      GO TO 99999 
C 
C***********************************************************************
C 
C Viewport too small on the bottom but O.K on the left
C Go back to original values on the bottom but expand on the left.
C 
 7000 CONTINUE
      NWIND(3) = YBOT 
      NWIND(4) = YTOP 
      CALL ZWIND(NXLEFT,XRGHT,YBOT,YTOP)
      CALL ZVIEW(NVLEFT,VRGHT,VBOT,VTOP)
      GO TO 99999 
C 
C********************************************************************** 
C 
C     The end 
C 
99999 CONTINUE
      RETURN
      END 
$FILES (0,0)
      SUBROUTINE ENCOD( IASC, RNUM, LEFT, NDGTS, CNUM ) 
     + ,92091-16016 REV.5000 <890418.1140>
C 
C*******************************************************************
C 
C     This subroutine will encode the real number 'RNUM' into an
C     ascii string which is returned in array IASC.  The constant 
C     'M' defined below determines the maximum number of digits to
C     be calculated.  Leading zeroes will be suppressed,
C     and the string will have LEFT + 1 characters
C     to the left of the decimal point. 
C 
C     The maximum number of ascii characters returned in IASC will
C     be M+2 to allow for a leading minus sign and the decimal point. 
C 
C     There are three error contitions that can occur.  LEFT can be 
C     larger than M - 1, in which case $$$$$.$ is returned.  The
C     number could be smaller than can be output, in which case 
C     0.0 is output.  Finally, the number could be too large to be
C     output using only LEFT digits, and XX.X is output.
C 
C     This routine makes use of SMOVE and SFILL, both of which are
C     found in the DECIMAL STRING ARITHMETIC ROUTINES library.  You 
C     will need to search the library if it is not GEN'ed into your 
C     system
C 
C*******************************************************************
C 
C     The arguments (O for arguments returned by the routine, I for input): 
C     --- --------- 
C 
C     IASC   [O, Integer] An integer array that the ASCII string
C                           will be stored into.  It should be at 
C                           least M + 2 characters long.
C 
C     RNUM   [I, Integer] The floating point number to be translated
C                           into ASCII. 
C 
C     LEFT   [I, Integer] The number of digits to leave to the left 
C                           of the decimal point.  There will be
C                           LEFT + 1 characters to the left of the
C                           decimal point because of the sign 
C                           character.
C 
C     NDGTS  [O, Integer] The total number of characters returned 
C                           in IASC.
C 
C     CNUM   [O, Real]    Eventually this will point to the center
C                           printing character in IASC.  It is a real 
C                           number because the center can be on a half
C                           character boundary. 
C 
C*******************************************************************
$PAGE 
C*******************************************************************
C 
C       { arguments } 
C 
      INTEGER IASC (4)
      REAL    RNUM
      INTEGER LEFT, NDGTS 
      REAL    CNUM
C 
C       { local variables } 
C 
      INTEGER INUM (5), IDIGIT (10), M, IPOS, IVAL, I 
      REAL    ROUND, TNUM, BASE 
      LOGICAL IFLAG 
C 
      DATA    INUM / 2H01, 2H23, 2H45, 2H67, 2H89 / 
      DATA    M    / 6 /
C 
C     The local variables:
C     --- ----- --------- 
C 
C     INUM    --  an array to store the ASCII version of numbers
C     IDIGIT  --  an array to store each digit of RNUM
C     M       --  a compile time constant of how many digits should 
C                   be computed 
C     IPOS    --  points to the next free character position in IASC
C     IVAL    --  a temporary variable to hold a digits value 
C     I       --  used as a loop counter
C 
C     ROUND   --  one half a least iignificant digit
C     TNUM    --  the absolute value of RNUM
C     BASE    --  holds the magnitude of the current digit being computed 
C 
C     IFLAG   --  used to flag whether or not a digit has been printed yet
C 
C*******************************************************************
C 
C     Create some constants 
C 
C     BASE is just larger than the largest number that can be output. 
C 
C     ROUND is one half the smallest number that can be output, and is
C       added to the number so digits can be formed by truncation.
C 
C     TNUM is the number actually used in the computation of digits, and
C       is equal to the absolute value of RNUM (the number to be output)
C       plus ROUND (the rounding constant)
C 
      BASE  = 10.0**LEFT
      ROUND = 0.5  / (10.0** (M - LEFT))
      TNUM = ABS ( RNUM ) + ROUND 
$PAGE 
C 
C       { If LEFT is too large ( larger that M - 1 ) then return }
C 
      IF ( LEFT .LE. (M-1) ) GOTO 10
          CALL SMOVE ( 8H $$$$$.$ , 1, 8, IASC, 1 ) 
          NDGTS = 8 
          CNUM  = 5 
          RETURN
   10 CONTINUE
C 
C       { Fill up IASC with (M+2) blanks }
C 
      CALL SFILL(IASC,1,M+2,2H  ) 
C 
C       { If number is too small or too big, do something special } 
C 
      IF ( TNUM .GE. (2.0*ROUND) ) GOTO  20 
C 
C           { number is too small } 
C           { output 0.0 in the right place } 
C 
          CALL SMOVE ( 4H0.0  , 1, 3, IASC, LEFT + 1) 
          NDGTS = LEFT + 3
          CNUM  = LEFT + 2
          RETURN
   20 CONTINUE
C 
      IF ( TNUM .LT. BASE ) GOTO 30 
C 
C           { number is too large } 
C           { output XX.X at the begininng of the line }
C 
          CALL SMOVE ( 6H XX.X , 1, 5, IASC, 1 )
          NDGTS = 5 
          CNUM  = 3.5 
          RETURN
   30 CONTINUE
$PAGE 
C 
C     Figure out the value of all the digits.  This is done 
C       as follows: 
C 
C     At the beginning of the loop BASE is one order of magnitude 
C       greater than the digit we are interested in.  TNUM is 
C       multiplied by 10 and then divided by BASE.  This yeilds a 
C       number whose integer part is equal to the digit we are interested 
C       in.  An implicit truncation is performed when this digit is 
C       stored into the integer array IDIGIT.  TNUM then has that 
C       digit subtracted from it, and is now ready for the next 
C       iteration.
C 
      DO 40 I=1,M 
          TNUM      = TNUM * 10.
          IDIGIT(I) = TNUM / BASE 
          TNUM      = TNUM - (BASE * IDIGIT(I)) 
   40 CONTINUE
C 
C       Set CNUM to something distinctive so we can tell that it is in
C       its initial state.  Eventually it will hold the position of the 
C       first printing character. 
C 
      CNUM = -1 
C 
C       { Create first character (blank or minus) } 
C       {   The . is just a placeholder to fool the editor }
C 
      IF (RNUM.LT.0) GOTO  50 
          IASC (1) = 2H . 
          GOTO 60 
C 
   50     IASC (1) = 2H-. 
C 
C           { Aha! a printing character.  Set CNUM to its index. }
C 
          CNUM = 1
   60 CONTINUE
$PAGE 
C 
C     Create digits to the left of the decimal point.  Note:
C       variable IFLAG is used to suppress leading zeroes by
C       flagging the first non-zero digit.
C 
C     There is some low magic going on to create the character.  The
C       integer value (0-9) for the character is stored in IDIGIT.
C       IVAL is set to this value plus one (1-10).  This number is
C       implicitly used as an index into INUM, which is an origin one 
C       character array of the characters '0' though '9'.  SMOVE will 
C       then write this character into IASC at the origin one character 
C       position IPOS, which has been set to point to the next free 
C       character position in IASC. 
C 
      IFLAG = .FALSE. 
      IPOS  =  2
      DO 90 I=1,LEFT
          IF ((IDIGIT(I) .EQ. 0).AND.(.NOT. IFLAG)) GOTO 70 
              IVAL  = IDIGIT(I) + 1 
              CALL SMOVE(INUM,IVAL,IVAL,IASC,IPOS)
              IFLAG = .TRUE.
C 
C               { set CNUM to the 1st printing character position, if needed }
C 
              IF ( CNUM .EQ. -1 ) CNUM = IPOS 
C 
              GOTO 80 
C 
   70     CALL SMOVE ( 2H  , 1, 1, IASC, IPOS ) 
  
   80     IPOS = IPOS + 1 
   90 CONTINUE
C 
C       { Add decimal point } 
C 
      CALL SMOVE(2H..,1,1,IASC,IPOS)
C 
C       { set CNUM if needed }
C 
      IF ( CNUM .EQ. -1 ) CNUM = IPOS 
C 
      IPOS = IPOS + 1 
C 
C     Read backwards in the IDIGIT array until a non zero digit 
C      is found.  Set NDGTS to the number of significant
C      digits, but always include at least one digit to the 
C      right of the decimal point 
C 
      DO 100 I = M, LEFT + 2, -1
          IF ( IDIGIT (I) .NE. 0 ) GOTO 110 
  100 CONTINUE
C 
  110 NDGTS = I 
$PAGE 
C 
C       { Create digits to the right of the decimal point } 
C 
      DO 120 I = LEFT+1, NDGTS
          IVAL = IDIGIT(I) + 1
          CALL SMOVE(INUM,IVAL,IVAL,IASC,IPOS)
          IPOS = IPOS + 1 
  120 CONTINUE
C 
C       Add two to NDGTS.  One is for the leading '-' or ' ' and one
C        is for the '.' in the middle.
C 
      NDGTS = NDGTS + 2 
C 
C       NDGTS now contains the offset of the last printing char, and
C        CNUM has the offset of the first printing char.  Reset CNUM
C        to the center between these two.  The factor of .5 is so CNUM
C        is indexed from the same point as DGL
C 
      CNUM = ( CNUM + NDGTS ) / 2 -.5 
C 
C       { all done! } 
C 
      RETURN
      END 
CC*********************************************************** 
C 
C 
C  NAME: CLINE - AXELS clipping routine     
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE CLINE(X1,Y1,X2,Y2,WIND,TCLIP)
     + ,92091-16016 REV.5000 <890418.1140>
C 
C To output the horizontal and vertical lines whose endpoints 
C are passed as parameters. Horizontal and vertical lines 
C will be clipped to the window (passed as a parameter) 
C before being output.  Diagonal lines will not be output.
C An indicator of whether or not the line was visible and 
C what type of clipping (if any) was done, is passed back to
C the caller. 
C 
C Note: This routine call ONLY clip horizontal and vertical 
C lines. Diagonal lines will not be output at all.
C 
C Parameter   Type          Description 
C ---------  --------       --------------------------------------------- 
C 
C X1,Y1,X2,Y2 real,input    The endpoint coordinates of the line
C                           to be processed.
C                           (X1,Y1) is one endpoint and (X2,Y2) is the other
C 
C WIND        real,input    4-element array holding the corner coordinates
C                           of the window to which horizontal and vertical
C                           lines are clipped.
C                           (WIND(1),WIND(3)) is the lower left corner
C                           (WIND(2),WIND(4)) is the upper right coorner
C                           Note: Calling routine has already ordered in
C                           the case of an inverted window so that
C                           WIND(1) <= WIND(2) and WIND(3) <= WIND(4) 
C 
C TCLIP    integer,output   Indicator of visibility of line and why it
C                           was clipped if it was invisible.
C                             0 - line was totally of partially visible 
C                             1 - line was totally to the left or right of
C                                 the window
C                             2 - line was totally above or below the window
C                             3 - line was diagonal so not processed. 
C 
C***************************************************************************
C 
C      Set up the parameters
C 
       REAL  X1,Y1,X2,Y2,WIND(4)
       INTEGER TCLIP
C 
C**************************************************************************** 
$PAGE 
C**************************************************************************** 
C 
C     Set up the local variables
C 
      REAL WLEFT,WRGHT,WTOP,WBOT
C 
      REAL XLEFT,XRGHT,YTOP,YBOT
C 
C  **** WBOT  - lower Y limit of ordered window 
C  **** WLEFT - lower X limit of ordered window 
C  **** WRGHT - upper X limit of ordered window 
C  **** WTOP  - upper Y limit of ordered window 
C  **** XLEFT - X component of line's first (leftmost or lower) endpoint
C  **** XRGHT - X component of line's second (rightmost or uppper endpoint
C  **** YBOT  - Y component of line's first (leftmost or lower) endpoint
C  **** YTOP  - Y component of line's second (rightmost or upper) endpoint
C 
C*****************************************************************************
C 
C  Move the window verticies into individual variables to facilitate
C  processing.
C 
      WLEFT = WIND(1) 
      WRGHT = WIND(2) 
      WBOT  = WIND(3) 
      WTOP  = WIND(4) 
C 
C**************************************************************************** 
C 
C    Find out what kind of line we have.  If the X coordinates are
C    constant then it's vertical (a point will fall into this check)          
C    and if the Y coordinates are constant then it's horizontal.              
C    If neither then it's diagonal. In this casre varaible TCLIP          
C    is set to 3 to indicate no processing occurs and GOTO EXIT 
C 
      IF (X1 .EQ. X2) GO TO 10
C 
      IF (Y1 .EQ. Y2) GO TO 20
C 
      TCLIP = 3 
      GO TO 999 
C 
C*****************************************************************************
 10   CONTINUE
$PAGE 
C 
C   Vertical line 
C 
C   Get the Y coordinates ordered, with YBOT below YTOP 
C   remember, X1 = X2 
C 
      YBOT = AMIN1(Y1,Y2) 
      YTOP = AMAX1(Y1,Y2) 
C 
C 
C  If the line is out of the window then no output is required. Check to
C  see if it is all left, right, above, or below the window rectangle.
C  Go to 99X where TCLIP is set to X (and from whence you exit).
C 
      IF (X1.LT.WLEFT) GO TO 991
      IF (X1.GT.WRGHT) GO TO 991
      IF (YBOT.GT.WTOP) GO TO 992 
      IF (YTOP.LT.WBOT) GO TO 992 
C 
C  We have some line to output so move to the upper point (or its intersection
C  with the bottom) and draw to the upper point (or its intersection with 
C  the top). Set TCLIP = 0 to indicate some output. 
C  Then that is all so go exit. 
C 
      CALL ZMOVE(X1,AMAX1(YBOT,WBOT)) 
      CALL ZDRAW(X1,AMIN1(YTOP,WTOP)) 
      TCLIP = 0 
C 
      GO TO 999 
C 
C********************************************************************** 
 20   CONTINUE
C 
C   Horizontal line 
C 
C   Get the X coordinates ordered, with XLEFT left of XRGHT 
C   remember Y1 =Y2 
C 
C   AMIN1 and AMAX1 return as a real the minimum or maximum of the two
C   specified reals.
C 
      XLEFT = AMIN1(X1,X2)
      XRGHT = AMAX1(X1,X2)
C 
C  If the line is out of the window then no output is required. Check to
C  see if it is all left, right, above, or below the window rectangle.
C  Go to 99X where TCLIP is set to X (and from whence you exit).
C 
      IF (XRGHT .LT. WLEFT) GO TO 991 
      IF (XLEFT .GT. WRGHT) GO TO 991 
      IF (Y1 .GT. WTOP) GO TO 992 
      IF (Y1 .LT. WBOT) GO TO 992 
$PAGE 
C 
C  We have some line to output so move to the left point (or its intersection 
C  with the left side) and draw to the right point (or its intersection with
C  the right side).  Set TCLIP = 0 to indicate output.
C  Then that is all so exit.
C 
      CALL ZMOVE(AMAX1(XLEFT,WLEFT),Y1) 
      CALL ZDRAW(AMIN1(XRGHT,WRGHT),Y1) 
      TCLIP = 0 
C 
      GO TO 999 
C 
C*****************************************************************************
C 
 991  CONTINUE
C 
C Set TCLIP = 1 to indicate that line was totally to the left or right of the 
C window.  Then go exit.
C 
      TCLIP = 1 
      GO TO 999 
C 
 992  CONTINUE
C 
C Set TCLIP = 2 to indicate that line was totally on top or below the window. 
C Then go exit. 
C 
      TCLIP = 2 
C     GO TO 999 
C 
C************************************************************************** 
 999  CONTINUE
C 
C The end.
C 
      RETURN
      END 
      SUBROUTINE chsiz(Chx,Chy) 
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Find out the true character cell size 
C     and return it.
C 
      INTEGER err 
      REAL ch(2)
      CALL ziws(250,0,2,0,ch,err) 
      chx = ch(1) 
      chy = ch(2) 
      RETURN
      END 
      SUBROUTINE chset(Ibig)
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Set the character size.  Ibig = 1 gives full-size 
C     characters, = 0 gives 3/4 size
C 
      INTEGER err 
      REAL w(4),rlist(4)
C 
C     Get world coordinates (as presently understood by DGL) and
C     assign them to more meanginful variables
C 
      CALL ziws (450,0,4,0,w,err) 
      wx1 = w(1)  
      wx2 = w(2)
      wy1 = w(3)
      wy2 = w(4)
C 
C     Find the linear transformation function by determining
C     where the world coordinates would be placed on the
C     actual screen (in terms of the real coordinates - millimeters)
C 
      CALL zdpmm (wx1,wy1,x1,y1)
      CALL zdpmm (wx2,wy2,x2,y2)
C 
C     Make the character size 1.27% of the screen (scale down if
C     user requested small letters) 
C 
      sizeup = (x2-x1) * 0.0127 
      IF (ibig.eq.0) sizeup = sizeup * 0.75 
C 
      xwsf = (wx2-wx1)/(x2-x1)  ! scale factor in x for world coordinates 
      ywsf = (wy2-wy1)/(y2-y1)  ! scale factor in y for world coordinates 
C 
C     Now call character size routine in DGL with our characters being
C     adjusted for the linear transformation.  Note that the height of
C     the character is adjusted so that it's ratio to the width is
C     10 to 5 
C 
      CALL zcsiz (xwsf*sizeup,ywsf*sizeup*(10./5.)) 
      RETURN
      END 
      SUBROUTINE Asprq(Asp) 
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Set the aspect ratio to optimal, and return it
C 
      REAL Rlist(4) 
C 
C     Find out what optimal ratio is
C 
      CALL Ziws(254,0,2,0,rlist,ierr) 
C 
      IF (ierr.eq.0) THEN 
         Call Zaspk(1.0,Rlist(2)) 
         Call Ziws(254,0,2,0,Rlist,ierr)
         Asp = Rlist(1) 
      ELSE
         Asp = 1
      ENDIF 
C 
      RETURN
      END 
      SUBROUTINE Ncolr(Color) 
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Return number of available colors 
C 
      INTEGER Color, List(4), Err 
C 
C     Ask device how many there are 
C 
      CALL Ziws(1054, 1, 0, List, 0, Err) 
C 
      IF (Err.NE.0) THEN
          Color = 1 
      ELSE
          Color = List(1) 
      ENDIF 
C 
      RETURN
      END 
      SUBROUTINE clpon
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Set clipping on for calls to YMOVE and YDRAW. 
C 
      IMPLICIT NONE 
C 
      INTEGER clplm, onoff
      REAL xmin, xmax, ymin, ymax 
C 
C  Block data clplm holds on/off flag for clipping limits and 
C  max coordinates in world.
C 
      COMMON /clplm/onoff,xmin,xmax,ymin,ymax 
C 
      CALL clims ! set up clipping limits 
      onoff = 1  ! set flag on
      RETURN
      END 
      SUBROUTINE clims
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Set clipping limits 
C 
      REAL world
      INTEGER clplm, onoff, err 
      COMMON /clplm/ onoff, world (4) 
C 
      CALL ziws (450,0,4,0,world,err) 
      RETURN
      END 
      SUBROUTINE clpof
     + ,92091-16016 REV.5000 <890418.1140>
      IMPLICIT NONE 
C 
      INTEGER clplm, onoff
      REAL xmin,xmax,ymin,ymax
      COMMON /clplm/onoff,xmin,xmax,ymin,ymax 
C 
      onoff = 0   ! set clipping flag off 
      RETURN
      END 
      BLOCK DATA ,92091-16016 REV.5000 <890418.1140>
C 
C     Clipping on/off flag and limits in x and y directions 
C 
      INTEGER clplm,onoff 
      REAL xmin,xmax,ymin,ymax
      COMMON /clplm/onoff,xmin,xmax,ymin,ymax 
      DATA onoff/0/  ! default to clipping disabled 
      END 
      SUBROUTINE ymove (x,y)
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Move using clipping limits
C 
      INTEGER clplm, onoff, off 
      REAL x, y, fx, fy 
      REAL xmin, xmax, ymin, ymax 
      COMMON /clplm/ onoff, xmin, xmax, ymin, ymax
      DATA off/0/ 
C 
      fx (t) = amin1 (amax1(t,xmin),xmax) 
      fy (t) = amin1 (amax1(t,ymin),ymax) 
C 
      IF (onoff .eq. off) THEN
          call zmove (x,y)
      ELSE
C 
C         Move to clipped x, y point
C 
          call zmove (fx(x),fy(y))
      ENDIF 
C 
      RETURN
      END 
      SUBROUTINE ydraw (x,y)
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Draw using clipping limits
C 
      INTEGER clplm, onoff, off 
      REAL xmin, xmax, ymin, ymax 
      REAL x, y, fx, fy 
      COMMON /clplm/ onoff, xmin, xmax, ymin, ymax
      DATA off/0/ 
C 
      fx (t) = amin1 (amax1(t,xmin),xmax) 
      fy (t) = amin1 (amax1(t,ymin),ymax) 
C 
      IF (onoff .eq. off) THEN
          call zdraw (x,y)
      ELSE
C 
C         Draw to clipped x,y point 
C 
          call zdraw (fx(x),fy(y))
      ENDIF 
C 
      RETURN
      END 
      SUBROUTINE ywind (x1,x2,y1,y2)
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     Set clipping limits to new window 
C 
      REAL x1,x2, y1,y2 
C 
C     Reset DGL'S window
C 
      CALL zwind (x1,x2,y1,y2)
C 
C     Tell the clipping routines about it 
C 
      CALL clims
      RETURN
      END 
$FILES (0,0)
      SUBROUTINE SCAL1(XMIN, XMAX, N, XMINP, XMAXP, DIST, IERR) 
     + ,92091-16016 REV.5000 <890418.1140>
C 
C     GIVEN XMIN, XMAX AND N, SCL1 FINDS A NEW RANGE XMINP, 
C     XMAXP DIVISIBLE INTO APPROXIMATELY N LINEAR INTERVALS 
C     OF SIZE DIST. 
C     VINT IS AN ARRAY OF ACCEPTABLE VALUES FOR DIST (TIMES 
C     AN INTEGER POWER OF 10).
C     SOR IS AN ARRAY OF GEOMETRIC MEANS OF ADJACENT VALUES 
C     OF VINT. IT IS USED AS BREAK POINTS TO DETERMINE
C     WHICH VINT VALUE TO ASSIGN TO DIST
C 
C     IERR = 0  IF IT WORKED
C 
      DIMENSION VINT(4),SOR(3)
      INTEGER*4 M1, M2, NAL 
      INTEGER*2 N,  IERR
      DATA VINT/1.0, 2.0, 5.0, 10.0/
      DATA SOR/1.414214, 3.162278, 7.7071068/ 
C 
C     CHECK WHETHER PROPER INPUT VALUES WERE SUPPLIED 
C 
      IERR = 0
      IF (XMIN.LT.XMAX .AND. N.GT.0) GO TO 10 
      IERR = 1
      RETURN
C 
C     DEL ACCOUNTS FOR COMPUTER ROUN-OFF EXPECTED FROM
C     A DIVISION AND FLOAT. IT SHOULD BE LESS THAN THE
C     MINIMUM INCREMENT OF THE PLOTTING DEVICE DIVIDED
C     BY THE PLOT SIZE TIMES NUMBER OF INTERVALS
C 
10    DEL = .00001
      FN = N
C 
C     FIND APPROXIMATE INTERVAL SIZE A
C 
      A = (XMAX-XMIN)/FN
      AL = ALOG10(A)
      NAL = AL
      IF (A.LT. 1.0) NAL = NAL - 1
C 
C     A IS SCALED INTO VARIABLE NAMED B BETWEEN 1 AND 10
C 
      B = A/10.0**NAL 
C 
C     THE CLOSEST PERMISSIBLE VALUE OF B IS FOUND 
C 
      DO 20 I=1,3 
         IF (B.LT.SOR(I)) GO TO 30
20    CONTINUE
      I=4 
$PAGE 
C 
C     THE INTERVAL SIZE IS COMPUTED 
C 
30    DIST = VINT(I)*10.0**NAL
      FM1 = XMIN/DIST 
      M1 = FM1
      IF (FM1.LT. 0.0) M1 = M1 - 1
      IF (ABS(FLOAT(M1)+1.0-FM1) .LT. DEL) M1 = M1 + 1
C 
C     THE NEW MINIMUM AND MAXIMUM LIMITS ARE FOUND
C 
      XMINP = DIST * FLOAT(M1)
      FM2 = XMAX/DIST 
      M2 = FM2 + 1.0
      IF (FM2.LT. -1.0) M2 = M2 - 1 
      IF (ABS(FM2+1.0-FLOAT(M2)) .LT. DEL) M2 = M2 - 1                        
      XMAXP = DIST * FLOAT(M2)
C 
C     ADJUST LIMITS TO ACCOUND FOR ROUND-OFF IF NECESSARY 
C 
      IF (XMINP.GT.XMIN)XMINP=XMIN
      IF (XMAXP.LT.XMAX)XMAXP=XMAX
      RETURN
      END 
