
                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   1
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0001    !++
0002    !  VERSION:          1-001     ( Partially Emulate DISSPLA Contouring )
0003    !
0004    !  ABSTRACT:         This module provides a minimal emulation of the DISSPLA
0005    !                    contouring facilities.  The routines partly emulated
0006    !                    include:
0007    !                                         CONMAK
0008    !                                         CONTUR
0009    !                                         CONLIN
0010    !
0011    !  ENVIRONMENT:      This version requires GKS and partial emulation of the
0012    !                    DISSPLA routines:
0013    !                                         XPOSN
0014    !                                         YPOSN
0015    !                                         DASH
0016    !                                         DOT
0017    !                                         CHNDOT
0018    !                                         SOLID  (ie. RESET('DOT'))
0019    !
0020    !  AUTHOR:           DENNIS MIKKELSON
0021    !
0022    !
0023    !  CREATION DATE:    June 24, 1987
0024    !
0025    !  MODIFIED BY:
0026    !
0027    ! 1-002    Changed Contur to use a call to GPLOT's CURVE routine instead of 
0028    !          GKS's GPL routine directly.  This required adding calls to XINVRS
0029    !          and YINVRS to transform back to USER coordinates after using the
0030    !          transformation TRANS.  Also commented out the routine ATRANS which
0031    !          has been moved to another module in GPLOT.
0032    !
0033    !  COMMENTS:
0034    !
0035    !  See the DISSPLA documentation for more details on the calling sequence and
0036    !  the meaning of the various parameters.  The contours themselves are
0037    !  constructed using ALGORITHM 531 from the Collected Algorithms of ACM.  The
0038    !  subroutines making up ALGORITHM 531 are included at the end of this file.
0039    !
0040    !  In addition, the following include file 'gplot_src:CONTOUR_DEFS.INC'
0041    !  is needed by CONMAK, CONTUR, CONLIN, and the service routine CONSAV:
0042    !
0043    !     PARAMETER (MaxPts = 20000)      ! maximum number of points allowed
0044    !                                     ! on all contours
0045    !     PARAMETER (MaxCon = 400)        ! maximum number of contour curves
0046    !     PARAMETER (NWork = 50000)       ! the size of the work area is actually
0047    !                                     ! (2 * nx * ny * ncv + 30)/31 where
0048    !                                     !
0049    !                                     !     nx  = number of rows in data matrix
0050    !                                     !
0051    !                                     !     ny  = number of columns in matrix
0052    !                                     !
0053    !                                     !     ncv = number distinct contour levels
0054    !
0055    !     COMMON /CONDAT/Imode(20),Lbl(20),ITh(20),IPri(20),NContr,kPoint,
0056    !    :        Npts(MaxCon), ZLevel(MaxCon), XVal(MaxPts), YVal(MaxPts),
0057    !    :        cv(MaxCon), zstep, nxpts, nypts

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   2
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0058    !
0059    !
0060    !  In Addition the include file 'gplot_src:GKG.INC' is needed by the
0061    !  service routine CONSAV.
0062    !
0063    !	COMMON/GKG/XORIG,XMAX,YORIG,YMAX,IPIC,LTYPE,XCYCLE
0064    !	1,YCYCLE,THEFAC,RSTEP,KOLOR,LXNAME,LYNAME,IXNAME,IYNAME, TRANON
0065    !	REAL XORIG,XMAX,YORIG,YMAX,XCYCLE,YCYCLE,THEFAC,RSTEP
0066    !	INTEGER IPIC,LTYPE,IXNAME,IYNAME
0067    !	BYTE LXNAME(80),LYNAME(80)
0068    !	DATA IPIC/0/,LTYPE/1/,XCYCLE,YCYCLE,THEFAC,RSTEP/4*0.0/
0069    !
0070    !  The emulation is only partial as is described more fully below.
0071    !
0072    !  CONMAK -- The emulation of CONMAK is quite complete.  However, CONMAK stores
0073    !            the curve information in large arrays in common block /CONDAT/
0074    !            rather than in blank common so no call to BCOMON is needed.
0075    !            The size of the various arrays used puts an upper limit on the
0076    !            number of contours allowed, the total number of points in all
0077    !            contour lines, etc.  The size of these arrays is controlled by
0078    !            the PARAMETERS: MaxCon, MaxPts, and NWork.
0079    !
0080    !            MaxCon is the maximum number of distinct contour lines allowed
0081    !
0082    !            MaxPts is the maximun total number of points allowed on all
0083    !                   contours.
0084    !
0085    !            NWork is the number of 32-bit words set aside as a work area
0086    !                  for the contouring routine gcontr.  The work space required
0087    !                  is the floor of (2 * nx * ny * ncv + 30)/31 where
0088    !                  nx, ny are the number of subdivision points in in the x and y
0089    !                  directions, and ncv is the number of distinct contour levels
0090    !
0091    !  CONLIN -- will accept parameters as described in the DISSPLA manual and store
0092    !            information about the contour line styles in arrays in /CONDAT/.
0093    !            However, not all of the information is used.  Specifically,
0094    !
0095    !            Line styles
0096    !                        SOLID   -- Supported
0097    !                        DOT     -- Supported
0098    !                        DASH    -- Supported
0099    !                        CHNDOT  -- Supported
0100    !                        MYCON   -- Supported
0101    !                        CHNDASH -- NOT SUPPORTED
0102    !
0103    !            Labels                -- NOT SUPPORTED (but parameter must be     )
0104    !                                                   ('LABELS' or 'NOLABELS'    )
0105    !            Line Thickness        -- Supported
0106    !
0107    !            Line Priority         -- NOT SUPPORTED (but an integer parameter )
0108    !                                                   (must be passed           )
0109    !
0110    !  CONTUR -- Will draw the contour lines.  However, there is no labeling of
0111    !            lines, and lines which are close together will not be thinned.
0112    !
0113    !  MYCON  -- This routine may be supplied by the user, however, the elements
0114    !            of the array parameters IARAY() and RARAY() relating to LABELS

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   3
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0115    !            will have no effect.
0116    !
0117    !            The following elements of the parameters of MYCON are used:
0118    !
0119    !            RARAY(1) will contain the Z-Level of the current contour
0120    !
0121    !            IARAY(1) is used to set line width
0122    !
0123    !            IARAY(9) is used to Enable/Disable the drawing of particular
0124    !            contours
0125    !
0126    !            In addition the routine MYCON may change the line type to one
0127    !            of SOLID, DOT, DASH, or CHNDOT

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   4
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0129    !++
0130    !------------------------- SUBROUTINE CONMAK --------------------------------
0131    !
0132    !  FUNCTIONAL DESCRIPTION:
0133    !
0134    !        Make contour lines from the data stored in zmat.
0135    !
0136    !  FORMAL ARGUMENTS:
0137    !
0138    !        Zmat          INPUT         Zmat has z-values corresponding to
0139    !                                    ixdim*iydim points in the x-y plane.
0140    !                                    The points are assumed to lie on a regular
0141    !                                    grid with x values evenly spaced from
0142    !                                    xorig to xmax, and y values evenly spaced
0143    !                                    from yorig to ymin
0144    !
0145    !        ixdim         INPUT         The number of grid lines in the x
0146    !                                    direction.  (The number of ROWS in
0147    !                                    array Zmat.)
0148    !
0149    !        iydim         INPUT         The number of grid lines in the y
0150    !                                    direction.  (The number of COLUMNS in
0151    !                                    array Zmat.)
0152    !
0153    !        Zincr         INPUT         Zincr may be the character string 'SCALE',
0154    !                                    or may be a real value giving the size of
0155    !                                    the increment between levels.
0156    !
0157    !  IMPLICIT INPUTS:
0158    !
0159    !        The following paramters from the include file are used
0160    !
0161    !        NWork         INPUT         The size of the work array bitmap() used
0162    !                                    by GCONTR
0163    !
0164    !        MaxCon        INPUT         The maximum number of contour curves
0165    !
0166    !  IMPLICIT OUTPUTS:
0167    !
0168    !        In Common Block /CONDAT/, the following variables are set directly
0169    !        by a call to CONMAK.
0170    !
0171    !        nxpts, nypts  OUTPUT        The number of grid points in the x and y
0172    !                                    directions.  These values are later used
0173    !                                    by CONSAV to get the user coordinates of
0174    !                                    points on a contour line.
0175    !
0176    !        zstep         OUTPUT        The size of the increment between levels
0177    !                                    used in the contouring. This value is used
0178    !                                    later by CONTUR to determine which curve
0179    !                                    characteristics to use.
0180    !
0181    !        kpoint        OUTPUT        Initialized to 0 in this routine, then
0182    !                                    indirectly altered later by CONSAV which
0183    !                                    is called by GCONTR.
0184    !

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   5
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0185    !        NContr        OUTPUT        Initialized to 0 in this routine, then
0186    !                                    indirectly altered later by CONSAV which
0187    !                                    is called by GCONTR.
0188    !
0189    !        cv            OUTPUT        Array of Z-levels along which the contour
0190    !                                    lines are drawn
0191    !
0192    !        In Common Block /CONDAT/, the following variables are set INDIRECTLY
0193    !        by a call to CONMAK.
0194    !
0195    !        NPts          OUTPUT        Array listing the number of points in each
0196    !                                    distinct contour line.  Set by CONSAV which
0197    !                                    is called by GCONTR.
0198    !
0199    !        Zlevel        OUTPUT        Array listing the level of each distinct
0200    !                                    contour line.  Set by CONSAV which is
0201    !                                    called by GCONTR.
0202    !
0203    !        XVal, YVAL    OUTPUT        Lists of coordinates of points on contour
0204    !                                    lines.  Each contour line is stored as a
0205    !                                    sequence of x,y coordinates in the user's
0206    !                                    coordinate system.  If a contour line is
0207    !                                    closed, the first and last points in the
0208    !                                    contour line are the same.
0209    !
0210    !  SIDE EFFECTS:
0211    !
0212    !         NONE
0213    !
0214    !--
0215          SUBROUTINE CONMAK( zmat, ixdim, iydim, zincr)
0216     
0217          EXTERNAL CONSAV               ! routine now called by the contouring
0218                                        ! subroutine gcontr().  CONSAV will save
0219                                        ! the points of the contour line in
0220                                        ! common block /CONDAT/ in user coordinates
0221     
0222          INCLUDE 'gplot_src:CONTOUR_DEFS.INC/LIST'
0223  1       PARAMETER (MaxPts = 20000)      ! maximum number of points allowed
0224  1                                       ! on all contours
0225  1       PARAMETER (MaxCon = 400)        ! maximum number of contour curves
0226  1  
0227  1       PARAMETER (NWork = 50000)       ! the size of the work area is actually
0228  1                                       ! (2 * nx * ny * ncv + 30)/31 where 
0229  1                                       !
0230  1                                       !     nx  = number of rows in data matrix
0231  1                                       !
0232  1                                       !     ny  = number of columns in matrix
0233  1                                       !
0234  1                                       !     ncv = number distinct contour levels
0235  1 	      ! cmin = distance in inches between contour labels (TGW)
0236  1  
0237  1       COMMON /CONDAT/Imode(20),Lbl(20),ITh(20),IPri(20),NContr,kPoint,
0238  1      :        Npts(MaxCon), ZLevel(MaxCon), XVal(MaxPts), YVal(MaxPts),         
0239  1      :        cv(MaxCon), zstep, nxpts, nypts, cmin
0240  1  
0241  1 !      LOGICAL TranOn

CONMAK                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   6
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0242  1 	data cmin/3.0/
0243     
0244          CHARACTER*4 czincr
0245     
0246          REAL aincr, zincr
0247     
0248          REAL zmat(ixdim, iydim)
0249     
0250          INTEGER bitmap(NWork)          ! Work space for gcontr
0251     
0252          EQUIVALENCE (czincr,aincr)     ! Interpret parameter ZINCR as either
0253                                         ! Character or real
0254     
0255          if (ixdim .le. 1 .or. iydim .le. 1) then
0256            print *,'ERROR -- ixdim or iydim <= 1 in CONMAK'
0257            print *,'         contours not generated'
0258            return
0259          else
0260            nxpts = ixdim
0261            nypts = iydim
0262          endif
0263    !
0264    !  Find the extreme values in the array zmat
0265    !
0266          alarge = zmat(1,1)
0267          asmall = zmat(1,1)
0268     
0269          do 1 i = 1, ixdim
0270            do 1 j = 1, iydim
0271              if (zmat(i,j) .gt. alarge) alarge = zmat(i,j)
0272              if (zmat(i,j) .lt. asmall) asmall = zmat(i,j)
0273    1     continue
0274     
0275    !
0276    !  Now set up the contour levels according to ZINCR
0277    !
0278          aincr = zincr
0279     
0280          if (czincr(1:4) .eq. 'SCAL') then
0281            aincr = (alarge-asmall)/10.          ! just take 1/10 of the range
0282                                                 ! as the increment then round
0283            ipower = 0                           ! to one digit.
0284    2       if (aincr.ge. 10.) then
0285              aincr = aincr/10
0286              ipower = ipower + 1
0287              goto 2
0288            endif
0289     
0290    4       if (aincr .lt. 1.) then
0291              aincr = aincr*10
0292              ipower = ipower - 1
0293              goto 4
0294            endif
0295            iround = nint(aincr)
0296            aincr = iround * 10.**ipower
0297          endif
0298          zstep = aincr

CONMAK                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   7
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0299     
0300    !
0301    !  Construct evenly spaced levels for contouring
0302    !
0303          ilev = NINT( asmall/aincr )
0304          if (ilev*aincr .lt. asmall) ilev = ilev + 1
0305          ncv = 0
0306     
0307    10    continue
0308            ncv = ncv + 1
0309            if (ncv .gt. MaxCon) then
0310              print *,'ERROR -- too many contour levels in CONMAK'
0311              print *,'         not all levels requested will be '
0312              print *,'         drawn.'
0313              ncv = ncv - 1
0314              goto 20
0315            endif
0316            cv(ncv) = ilev * aincr
0317            ilev = ilev + 1
0318          if (ilev*aincr .le. alarge) goto 10
0319    20    continue
0320    !
0321    !  Check that the allocated work space is large enough
0322    !
0323          iwksz = (2*ixdim*iydim*ncv+30)/31
0324          if (iwksz .gt. NWork) then
0325            print *,'ERROR -- insufficient work space for gcontr'
0326            print *,'         increase parameter NWork to at least',iwksz
0327            print *,'         CONTOURS NOT GENERATED ! ! !'
0328            return
0329          endif
0330     
0331    !
0332    !  Now construct lists of points on contour lines in common block /CONDAT/
0333    !
0334          NContr = 0
0335          kPoint = 0
0336          call gcontr(zmat, ixdim, ixdim, iydim, cv, ncv, alarge+1.0,
0337         :            bitmap, consav)
0338     
0339          END

CONMAK                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   8
01                                                              21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  668   PIC CON REL LCL   SHR   EXE   RD NOWRT QUAD
  1 $PDATA                                 297   PIC CON REL LCL   SHR NOEXE   RD NOWRT QUAD
  2 $LOCAL                              200164   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD
  3 CONDAT                              165144   PIC OVR REL GBL   SHR NOEXE   RD   WRT QUAD

    Total Space Allocated               366273


ENTRY POINTS

    Address  Type  Name          

  0-00000000       CONMAK        


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  2-00000000  R*4  AINCR               **      R*4  ALARGE              **      R*4  ASMALL          3-00028514  R*4  CMIN          
  2-00000000  CHAR CZINCR              **      I*4  I                   **      I*4  ILEV                **      I*4  IPOWER        
      **      I*4  IROUND              **      I*4  IWKSZ          AP-00000008@ I*4  IXDIM          AP-0000000C@ I*4  IYDIM         
      **      I*4  J               3-00000144  I*4  KPOINT          3-00000140  I*4  NCONTR          2-00030D44  I*4  NCV           
  3-0002850C  I*4  NXPTS           3-00028510  I*4  NYPTS          AP-00000010@ R*4  ZINCR           3-00028508  R*4  ZSTEP         


ARRAYS

    Address  Type  Name                Bytes  Dimensions

  2-00000004  I*4  BITMAP             200000  (50000)
  3-00027EC8  R*4  CV                   1600  (400)
  3-00000000  I*4  IMODE                  80  (20)
  3-000000F0  I*4  IPRI                   80  (20)
  3-000000A0  I*4  ITH                    80  (20)
  3-00000050  I*4  LBL                    80  (20)
  3-00000148  I*4  NPTS                 1600  (400)
  3-00000DC8  R*4  XVAL                80000  (20000)
  3-00014648  R*4  YVAL                80000  (20000)
  3-00000788  R*4  ZLEVEL               1600  (400)
 AP-00000004@ R*4  ZMAT                   **  (*, *)


LABELS

    Address   Label       Address   Label       Address   Label       Address   Label       Address   Label   

      **      1         0-000000F8  2         0-0000010C  4         0-00000168  10        0-000001EC  20      

CONMAK                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page   9
01                                                              21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name          

        CONSAV                GCONTR        

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  10
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0001     

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  11
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0003    !++
0004    !----------------------------- SUBROUTINE CONTUR --------------------------
0005    !
0006    !  FUNCTIONAL DESCRIPTION:
0007    !
0008    !        Actually draw the contours which were constructed and saved in the
0009    !        common block /CONDAT/
0010    !
0011    !  FORMAL ARGUMENTS:
0012    !
0013    !        NLines            INPUT       Integer number of contour line
0014    !                                      characteristics set up by calls to
0015    !                                      CONLIN
0016    !
0017    !        LblFlg            INPUT       Character string to determine whether
0018    !                                      or not contour lines may be labeled.
0019    !                                      Labeled contour lines are not supported
0020    !                                      so this should be set to 'NOLABELS'
0021    !
0022    !        Idraw             INPUT       Idraw should be one of the character
0023    !                                      strings: 'DRAW' or 'NODRAW' to determine
0024    !                                      whether or not contour curves are drawn
0025    !
0026    !  IMPLICIT INPUTS:
0027    !
0028    !        The following variables in Common Block /CONDAT/ which were set up by
0029    !        previous routines are now used by contour
0030    !
0031    !        zstep         INPUT         The size of the increment between levels
0032    !                                    used in the contouring.  Value was set by
0033    !                                    CONMAK
0034    !
0035    !        NContr        INPUT         The number of distinct contour lines to
0036    !                                    draw.
0037    !
0038    !        NPts          INPUT         Array listing the number of points in each
0039    !                                    distinct contour line.
0040    !
0041    !        Zlevel        INPUT         Array listing the level of each distinct
0042    !                                    contour line.
0043    !
0044    !        XVal, YVAL    INPUT         Lists of coordinates of points on contour
0045    !                                    lines.
0046    !
0047    !        Imode         INPUT         Array of line type codes set by calls to
0048    !                                    CONLIN. Imode(L) determines whether line L
0049    !                                    should be SOLID, DOTTED, etc.
0050    !
0051    !        Lbl           INPUT         Array of Label On/Off flags set by calls to
0052    !                                    CONLIN.  Labeled contour lines are not
0053    !                                    currently supported.
0054    !
0055    !        ITh           INPUT         Array of line width factors set by calls to
0056    !                                    CONLIN.  The L th line has width
0057    !                                    ITh(L) * W  where W is the "standard" line
0058    !                                    width.

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  12
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0059    !
0060    !        Also, the following variables are needed from common blocks /GKG/ and
0061    !        /GKA/ of the GKS emulation of DISSPLA
0062    !
0063    !        TRSBPL        INPUT         The subplot transformation number
0064    !
0065    !        LTYPE         INPUT         The line type set by calls to DOT, etc.
0066    !
0067    !        TranOn        INPUT         Flag which indicates whether or not to call
0068    !                                    the low level transformation TRANS before
0069    !                                    drawing the contour polyline.
0070    !
0071    !  IMPLICIT OUTPUTS:
0072    !
0073    !        NONE
0074    !
0075    !  SIDE EFFECTS:
0076    !
0077    !         Uses GKS to actually draw the contour lines on the currently active
0078    !         workstation.
0079    !
0080    !--
0081          SUBROUTINE contur(NLines, LblFlg, Idraw)
0082     
0083          INCLUDE 'gplot_src:CONTOUR_DEFS.INC/LIST'
0084  1       PARAMETER (MaxPts = 20000)      ! maximum number of points allowed
0085  1                                       ! on all contours
0086  1       PARAMETER (MaxCon = 400)        ! maximum number of contour curves
0087  1  
0088  1       PARAMETER (NWork = 50000)       ! the size of the work area is actually
0089  1                                       ! (2 * nx * ny * ncv + 30)/31 where 
0090  1                                       !
0091  1                                       !     nx  = number of rows in data matrix
0092  1                                       !
0093  1                                       !     ny  = number of columns in matrix
0094  1                                       !
0095  1                                       !     ncv = number distinct contour levels
0096  1 	      ! cmin = distance in inches between contour labels (TGW)
0097  1  
0098  1       COMMON /CONDAT/Imode(20),Lbl(20),ITh(20),IPri(20),NContr,kPoint,
0099  1      :        Npts(MaxCon), ZLevel(MaxCon), XVal(MaxPts), YVal(MaxPts),         
0100  1      :        cv(MaxCon), zstep, nxpts, nypts, cmin
0101  1  
0102  1 !      LOGICAL TranOn
0103  1 	data cmin/3.0/
0104          INCLUDE 'gplot_src:GKA.INC/LIST'
0105  1 	COMMON /GKA/PAGEX,PAGEY,XPHYS,YPHYS,XAXIS,YAXIS,PSCALE
0106  1      1 ,TRPAGE,TRSBPL,TRDATA,XTONCH,YTONCH,XDATIN,YDATIN,CTHICK
0107  1      2 ,GRACEM,VX0,VXM,VY0,VYM,IFCHEK,TICY,NOYFST,NOYLST,INTY,YNUM
0108  1      3 ,CTRXLB,CTRYLB,TICX,NOXFST,NOXLST,INTX,XNUM,VX1,VY1,SCFACT
0109  1      4 ,VTHICK,ORSET,ANGSAV
0110  1 	REAL PAGEX,PAGEY,XPHYS,YPHYS,XAXIS,YAXIS,PSCALE,GRACEM
0111  1 	INTEGER ILINE,TRPAGE,TRSBPL,TRDATA
0112  1 	LOGICAL TICY,NOYFST,NOYLST,INTY,YNUM,CTRYLB
0113  1      1 ,        TICX,NOXFST,NOXLST,INTX,XNUM,CTRXLB
0114  1      2 ,        ORSET
0115  1 C	DATA ORSET/.FALSE./	! 7/15/91--See RESET.FOR

CONTUR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  13
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0116          INCLUDE 'gplot_src:GKG.INC/LIST'
0117  1 	PARAMETER (NLINEAR=0,NSTEP=1,NBARS=2,NPOLY3=3,NSPLINE=4,
0118  1 	1 NPOLY5=5,NPARA3=6,NRASPLN=7,NPSPLIN=8,NPARA5=9)
0119  1 	COMMON/GKG/XORIG,XMAX,YORIG,YMAX,IPIC,LTYPE,XCYCLE
0120  1 	1,YCYCLE,THEFAC,RSTEP,KOLOR,LXNAME,LYNAME,IXNAME,IYNAME
0121  1 	2,TRANON,XSTP,YSTP,NTERP,TENSN,BARWTH,XYDRAT
0122  1 	3,XTKIN,XLBREV,YTKIN,YLBREV
0123  1 	REAL XORIG,XMAX,YORIG,YMAX,XCYCLE,YCYCLE,THEFAC,RSTEP
0124  1 	REAL XSTP,YSTP,BARWTH,XYDRAT
0125  1 	INTEGER IPIC,LTYPE,IXNAME,IYNAME
0126  1 	LOGICAL TRANON,XTKIN,XLBREV,YTKIN,YLBREV
0127  1 	CHARACTER*300 LXNAME,LYNAME
0128     
0129          CHARACTER*8 LblFlg, Idraw, clabel
0130          REAL raray(2), Xpage(5000),Ypage(5000)
0131          real alabel(20), xlpos(20), ylpos(20)
0132          INTEGER IARAY(9)
0133     
0134          PARAMETER (DefaultWidth = 1.0)
0135     
0136          iStart = 1
0137          do 20 k = 1, NContr
0138     
0139            if (NLines .gt. 0) then                ! the user specified line
0140              kLev = NINT(ZLevel(k)/zStep)         ! characteristics
0141              if (kLev .lt. 0) then
0142                kLev = klev + NLines * ( abs(kLev)/NLines + 1 )
0143              endif
0144              LineNo = MOD(kLev,NLines) + 1        ! LineNo is the index into the
0145                                                   ! table of line characteristics
0146     
0147              raray(1) = ZLevel(k)                 ! set up arrays to pass to MYCON
0148              raray(2) = 1.0                       ! if necessary
0149     
0150              iaray(1) = ITh(LineNo)
0151    d	write(8,*) 'LblFlg=',LblFlg(1:6)
0152    d	write(8,*) 'Lbl(LineNo)=',Lbl(LineNo)
0153              if (LblFlg(1:6) .eq. 'LABELS' .and. Lbl(LineNo) .eq. 1) then
0154                iaray(2) = 1
0155              else
0156                iaray(2) = 0
0157              endif
0158              iaray(3) = 0
0159     
0160              if (Idraw(1:4) .eq. 'DRAW') then
0161                iaray(9) = 1
0162              else
0163                iaray(9) = 0
0164              endif
0165     
0166              if     (Imode(LineNo) .eq. 1) then       ! set line type as needed
0167                call SOLID
0168              elseif (Imode(LineNo) .eq. 2) then
0169                call DOT
0170              elseif (Imode(LineNo) .eq. 3) then
0171                call DASH
0172              elseif (Imode(LineNo) .eq. 4) then

CONTUR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  14
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0173                call CHNDOT
0174              elseif (Imode(LineNo) .eq. 5) then
0175                 call CHNDSH 
0176              elseif (Imode(LineNo) .eq. 6) then
0177                 call mycon(raray, iaray)
0178              endif
0179            else
0180              call SOLID               ! set up default values if no line
0181              raray(1) = ZLevel(k)     ! characteristics were specified
0182              raray(2) = 1.0
0183              iaray(1) = 1
0184              iaray(2) = 0
0185              iaray(3) = 0
0186              iaray(9) = 1
0187            endif
0188    !
0189    !  Now draw the contour curve according to the currently active characteristics
0190    !
0191             if (iaray(9) .eq. 1) then
0192    c
0193    c Commented out on 5/30/90 to change to use the GPLOT Curve routine. DJM
0194    c
0195    c           call gselnt(TRSBPL)     
0196    c           call gsln(LTYPE)
0197    c           call gslwsc(float(iaray(1)))
0198     
0199               IF (iaray(1) .GT. 1) THEN              ! use GPLOT call to set the
0200                 call thkcrv( iaray(1)*DefaultWidth ) ! line thickness 5/30/90 DJM
0201               ENDIF
0202     
0203               incomm = iStart-1
0204               inout  = 0
0205    	   nlabel = 0
0206    	   jj = 1
0207    19	   clen = 0.0
0208    c           do 18 jj = 1,Npts(k)
0209               do while (jj .le. Npts(k) .and. clen .lt. cmin)
0210                inout  = inout + 1
0211                 incomm = incomm + 1
0212    !
0213    !  Find page coordinates
0214    !
0215                 Xpage(inout) = xposn(XVal(incomm),YVal(incomm))
0216                 Ypage(inout) = yposn(XVal(incomm),YVal(incomm))
0217    	     xp1 = xpage(inout)
0218    	     yp1 = ypage(inout)
0219    	     dx2 = (xp1-xp0)*(xp1-xp0)
0220    	     dy2 = (yp1-yp0)*(yp1-yp0)
0221    	     vlen = sqrt(dx2 + dy2)
0222    	     xp0 = xp1
0223    	     yp0 = yp1
0224    	     clen = clen + vlen
0225    !
0226    !  Apply user transform if needed
0227    !
0228                 if (TranOn) then
0229                   call trans(Xpage(inout),Ypage(inout),4)

CONTUR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  15
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0230                 endif
0231    !
0232    !  Now transform back to data coordinates   5/30/90  DJM
0233    !
0234                 XTemp        = xInvrs(XPage(inout), Ypage(inout))
0235                 YPage(inout) = yInvrs(XPage(inout), Ypage(inout))
0236                 XPage(inout) = XTemp
0237     
0238    	     jj = jj + 1
0239    	    end do
0240    	    if(jj .lt. Npts(k)) then
0241    d	write(8,*) k,' jj,Npts(k)=',jj,Npts(k)
0242    	      jj0 = jj + 1
0243    d	write(8,*) 'iaray(2) =',iaray(2)
0244    	      if(iaray(2) .ne. 0) then	! save label position/angle
0245    		if(jj .lt. Npts(k)) then
0246    	  	  jj2 = Npts(k) + 1
0247    		else
0248    		  jj2 = Npts(k)
0249    		end if
0250    		if(jj .gt. 1) then
0251    		  jj1 = jj - 1
0252    		else
0253    		  jj1 = 1
0254    		end if
0255    		delx = xpage(jj2) - xpage(jj1)
0256    		dely = ypage(jj2) - ypage(jj1)
0257    		nlabel = nlabel + 1
0258    		alabel(nlabel) = atand(dely/delx)
0259    		xlpos(nlabel) = xpage(jj)
0260    	  	ylpos(nlabel) = ypage(jj)
0261    d	write(8,*) 'angle,x,y=',alabel(nlabel),xlpos(nlabel),
0262    d	1	                ylpos(nlabel)
0263    	      end if
0264    	      goto 19
0265    	    end if
0266    c18         continue
0267                call CURVE(Xpage, YPage, Npts(k), 0)     ! added 5/30/90 DJM
0268    	    Izlev = Zlevel(k)
0269    	    write(clabel,'(i8)') Izlev
0270    	    do i = 1,nlabel
0271    	      call angle(alabel(i))
0272    d	write(8,*) i,xlpos(i),ylpos(i),', ',clabel
0273    	      call chrmsg(xlpos(i),ylpos(i),clabel)
0274    	    end do
0275    	    call angle(0.0)
0276                call thkcrv(DefaultWidth)                ! reset to default width
0277    c
0278    c Commented out on 5/30/90 to change to use the Disspla Curve routine. DJM
0279    c
0280    c           call gpl(Npts(k),Xpage,Ypage)
0281    c           call gslwsc(1.0)
0282    c           call gsln(1)
0283    c
0284     
0285             endif
0286     

CONTUR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  16
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0287            iStart = iStart + Npts(k)      ! advance to start of next line in table
0288    20    continue
0289          END




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                 1248   PIC CON REL LCL   SHR   EXE   RD NOWRT QUAD
  1 $PDATA                                  82   PIC CON REL LCL   SHR NOEXE   RD NOWRT QUAD
  2 $LOCAL                               40536   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD
  3 CONDAT                              165144   PIC OVR REL GBL   SHR NOEXE   RD   WRT QUAD
  4 GKA                                    156   PIC OVR REL GBL   SHR NOEXE   RD   WRT QUAD
  5 GKG                                    696   PIC OVR REL GBL   SHR NOEXE   RD   WRT QUAD

    Total Space Allocated               207862


ENTRY POINTS

    Address  Type  Name          

  0-00000000       CONTUR        


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  4-00000098  R*4  ANGSAV          5-000002A0  R*4  BARWTH          2-00009D5C  CHAR CLABEL              **      R*4  CLEN          
  3-00028514  R*4  CMIN            4-00000038  R*4  CTHICK          4-00000068  L*4  CTRXLB          4-0000006C  L*4  CTRYLB        
      **      R*4  DELX                **      R*4  DELY                **      R*4  DX2                 **      R*4  DY2           
  4-0000003C  R*4  GRACEM              **      I*4  I              AP-0000000C@ CHAR IDRAW           4-00000050  I*4  IFCHEK        
      **      I*4  ILINE               **      I*4  INCOMM              **      I*4  INOUT           4-0000007C  L*4  INTX          
  4-00000060  L*4  INTY            5-00000010  I*4  IPIC            2-00009D64  I*4  ISTART          5-00000284  I*4  IXNAME        
  5-00000288  I*4  IYNAME              **      I*4  IZLEV               **      I*4  JJ                  **      I*4  JJ0           
      **      I*4  JJ1                 **      I*4  JJ2             2-00009D68  I*4  K                   **      I*4  KLEV          
  5-00000028  I*4  KOLOR           3-00000144  I*4  KPOINT         AP-00000008@ CHAR LBLFLG              **      I*4  LINENO        
  5-00000014  I*4  LTYPE           5-0000002C  CHAR LXNAME          5-00000158  CHAR LYNAME          3-00000140  I*4  NCONTR        
      **      I*4  NLABEL         AP-00000004@ I*4  NLINES          4-00000074  L*4  NOXFST          4-00000078  L*4  NOXLST        
  4-00000058  L*4  NOYFST          4-0000005C  L*4  NOYLST          5-00000298  I*4  NTERP           3-0002850C  I*4  NXPTS         
  3-00028510  I*4  NYPTS           4-00000094  L*4  ORSET           4-00000000  R*4  PAGEX           4-00000004  R*4  PAGEY         
  4-00000018  R*4  PSCALE          5-00000024  R*4  RSTEP           4-0000008C  R*4  SCFACT          5-0000029C  R*4  TENSN         
  5-00000020  R*4  THEFAC          4-00000070  L*4  TICX            4-00000054  L*4  TICY            5-0000028C  L*4  TRANON        
  4-00000024  I*4  TRDATA          4-0000001C  I*4  TRPAGE          4-00000020  I*4  TRSBPL              **      R*4  VLEN          
  4-00000090  R*4  VTHICK          4-00000040  R*4  VX0             4-00000084  R*4  VX1             4-00000044  R*4  VXM           
  4-00000048  R*4  VY0             4-00000088  R*4  VY1             4-0000004C  R*4  VYM             4-00000010  R*4  XAXIS         
  5-00000018  R*4  XCYCLE          4-00000030  R*4  XDATIN          5-000002AC  L*4  XLBREV          5-00000004  R*4  XMAX          
  4-00000080  L*4  XNUM            5-00000000  R*4  XORIG           2-00009D70  R*4  XP0                 **      R*4  XP1           
  4-00000008  R*4  XPHYS           5-00000290  R*4  XSTP                **      R*4  XTEMP           5-000002A8  L*4  XTKIN         
  4-00000028  R*4  XTONCH          5-000002A4  R*4  XYDRAT          4-00000014  R*4  YAXIS           5-0000001C  R*4  YCYCLE        
  4-00000034  R*4  YDATIN          5-000002B4  L*4  YLBREV          5-0000000C  R*4  YMAX            4-00000064  L*4  YNUM          
  5-00000008  R*4  YORIG           2-00009D74  R*4  YP0                 **      R*4  YP1             4-0000000C  R*4  YPHYS         
  5-00000294  R*4  YSTP            5-000002B0  L*4  YTKIN           4-0000002C  R*4  YTONCH          3-00028508  R*4  ZSTEP         

CONTUR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  17
01                                                              21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

ARRAYS

    Address  Type  Name                Bytes  Dimensions

  2-00009C48  R*4  ALABEL                 80  (20)
  3-00027EC8  R*4  CV                   1600  (400)
  2-00009D38  I*4  IARAY                  36  (9)
  3-00000000  I*4  IMODE                  80  (20)
  3-000000F0  I*4  IPRI                   80  (20)
  3-000000A0  I*4  ITH                    80  (20)
  3-00000050  I*4  LBL                    80  (20)
  3-00000148  I*4  NPTS                 1600  (400)
  2-00000000  R*4  RARAY                   8  (2)
  2-00009C98  R*4  XLPOS                  80  (20)
  2-00000008  R*4  XPAGE               20000  (5000)
  3-00000DC8  R*4  XVAL                80000  (20000)
  2-00009CE8  R*4  YLPOS                  80  (20)
  2-00004E28  R*4  YPAGE               20000  (5000)
  3-00014648  R*4  YVAL                80000  (20000)
  3-00000788  R*4  ZLEVEL               1600  (400)


LABELS

    Address   Label       Address   Label   

  0-000001DC  19            **      20      


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name            Type  Name            Type  Name            Type  Name            Type  Name          

        ANGLE                 CHNDOT                CHNDSH                CHRMSG                CURVE                 DASH          
        DOT              R*4  MTH$ATAND        R*4  MTH$SQRT              MYCON                 SOLID                 THKCRV        
        TRANS            R*4  XINVRS           R*4  XPOSN            R*4  YINVRS           R*4  YPOSN         

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  18
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0001     

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  19
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0003    !++
0004    !---------------------------- SUBROUTINE CONLIN -------------------------------
0005    !
0006    !  FUNCTIONAL DESCRIPTION:
0007    !
0008    !     Stores contour line style parameters in arrays in common block /CONDAT/
0009    !     for later use by CONTUR
0010    !
0011    !  FORMAL ARGUMENTS:
0012    !
0013    !         LineNo       INPUT         The index into the table of contour line
0014    !                                    characteristics.  The following items are
0015    !                                    stored in position LineNo of the
0016    !                                    corresponding arrays.
0017    !
0018    !         Mode         INPUT         One of the strings 'SOLID', 'DOT', 'DASH'
0019    !                                    'CHNDOT' or 'MYCON' to determine the type
0020    !                                    of contour line to be drawn. 'CHNDSH' is
0021    !                                    not supported.
0022    !
0023    !         LblFlg       INPUT         One of the strings 'LABELS' or 'NOLABELS'.
0024    !                                    Since labeled contour lines are not
0025    !                                    supported, 'NOLABELS' should be used.
0026    !
0027    !         IThick       INPUT         Integer thickness factor for the current
0028    !                                    line number.
0029    !
0030    !         IPrior       INPUT         Integer "THINNING" priority for the current
0031    !                                    line number.  This is ultimatly ignored.
0032    !
0033    !  IMPLICIT INPUTS:
0034    !
0035    !        NONE
0036    !
0037    !  IMPLICIT OUTPUTS:
0038    !
0039    !        The line characteristic data passed in the FORMAL ARGUMENTS to this
0040    !        subroutine are stored in the following arrays in /CONDAT/:
0041    !
0042    !        Imode         OUTPUT        Array of line type codes.
0043    !
0044    !        Lbl           OUTPUT        Array of Label On/Off flags.
0045    !
0046    !        ITh           OUTPUT        Array of line width factors.
0047    !
0048    !        IPri          OUTPUT        Array of priorities.
0049    !
0050    !        Using the following coding scheme:
0051    !
0052    !        Imode() = 1    means   'SOLID'
0053    !        Imode() = 2    means   'DOT'
0054    !        Imode() = 3    means   'DASH'
0055    !        Imode() = 4    means   'CHNDOT'
0056    !        Imode() = 5    means   'CHNDASH'        ! (NOT SUPPORTED BY VAX GKS)
0057    !        Imode() = 6    means   'MYCON'          ! that is, call a routine MYCON
0058    !                                                ! to set curve drawing paramters

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  20
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0059    !
0060    !        Lbl() = 0      means   'NOLABELS'
0061    !        Lbl() = 1      means   'LABELS'
0062    !
0063    !  SIDE EFFECTS:
0064    !
0065    !        NONE
0066    !
0067    !--
0068          SUBROUTINE CONLIN(LineNo, Mode, LblFlg, IThick, IPrior)
0069          INCLUDE 'gplot_src:CONTOUR_DEFS.INC/LIST'
0070  1       PARAMETER (MaxPts = 20000)      ! maximum number of points allowed
0071  1                                       ! on all contours
0072  1       PARAMETER (MaxCon = 400)        ! maximum number of contour curves
0073  1  
0074  1       PARAMETER (NWork = 50000)       ! the size of the work area is actually
0075  1                                       ! (2 * nx * ny * ncv + 30)/31 where 
0076  1                                       !
0077  1                                       !     nx  = number of rows in data matrix
0078  1                                       !
0079  1                                       !     ny  = number of columns in matrix
0080  1                                       !
0081  1                                       !     ncv = number distinct contour levels
0082  1 	      ! cmin = distance in inches between contour labels (TGW)
0083  1  
0084  1       COMMON /CONDAT/Imode(20),Lbl(20),ITh(20),IPri(20),NContr,kPoint,
0085  1      :        Npts(MaxCon), ZLevel(MaxCon), XVal(MaxPts), YVal(MaxPts),         
0086  1      :        cv(MaxCon), zstep, nxpts, nypts, cmin
0087  1  
0088  1 !      LOGICAL TranOn
0089  1 	data cmin/3.0/
0090     
0091          CHARACTER*8 Mode, LblFlg
0092     
0093          if (LineNo .gt. 19 .or. LineNo .lt. 0) then
0094            print *,'ERROR -- LineNo invalid in CONLIN : ',LineNo
0095            return
0096          endif
0097     
0098          iLine = LineNo + 1
0099          ITh(iLine)  = IThick
0100          IPri(iLine) = IPrior
0101     
0102          if (Mode(1:5) .eq. 'SOLID') then
0103            Imode(iLine) = 1
0104          elseif (Mode(1:3) .eq. 'DOT') then
0105            Imode(iLine) = 2
0106          elseif (Mode(1:4) .eq. 'DASH') then
0107            Imode(iLine) = 3
0108          elseif (Mode(1:6) .eq. 'CHNDOT') then
0109            Imode(iLine) = 4
0110          elseif (Mode(1:6) .eq. 'CHNDSH') then
0111            Imode(iLine) = 5
0112          elseif (Mode(1:5) .eq. 'MYCON') then
0113            Imode(iLine) = 6
0114          else
0115            print *,'ERROR -- invalid parameter Mode in CONLIN : ',Mode

CONLIN                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  21
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0116            Imode(iLine) = 1
0117          endif
0118     
0119          if (LblFlg(1:8) .eq. 'NOLABELS') then
0120            Lbl(iLine) = 0
0121          elseif (LblFlg(1:6) .eq. 'LABELS') then
0122            Lbl(iLine) = 1
0123          else
0124            print *,'ERROR -- invalid parameter LblFlg in CONLIN : ',LblFlg
0125            Lbl(iLine) = 0
0126          endif
0127     
0128          END




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  346   PIC CON REL LCL   SHR   EXE   RD NOWRT QUAD
  1 $PDATA                                 169   PIC CON REL LCL   SHR NOEXE   RD NOWRT QUAD
  2 $LOCAL                                  40   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD
  3 CONDAT                              165144   PIC OVR REL GBL   SHR NOEXE   RD   WRT QUAD

    Total Space Allocated               165699


ENTRY POINTS

    Address  Type  Name          

  0-00000000       CONLIN        


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  3-00028514  R*4  CMIN                **      I*4  ILINE          AP-00000014@ I*4  IPRIOR         AP-00000010@ I*4  ITHICK        
  3-00000144  I*4  KPOINT         AP-0000000C@ CHAR LBLFLG         AP-00000004@ I*4  LINENO         AP-00000008@ CHAR MODE          
  3-00000140  I*4  NCONTR          3-0002850C  I*4  NXPTS           3-00028510  I*4  NYPTS           3-00028508  R*4  ZSTEP         


ARRAYS

    Address  Type  Name                Bytes  Dimensions

  3-00027EC8  R*4  CV                   1600  (400)
  3-00000000  I*4  IMODE                  80  (20)
  3-000000F0  I*4  IPRI                   80  (20)
  3-000000A0  I*4  ITH                    80  (20)
  3-00000050  I*4  LBL                    80  (20)
  3-00000148  I*4  NPTS                 1600  (400)
  3-00000DC8  R*4  XVAL                80000  (20000)
  3-00014648  R*4  YVAL                80000  (20000)

CONLIN                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  22
01                                                              21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

  3-00000788  R*4  ZLEVEL               1600  (400)

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  23
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0002    !++
0003    !------------------------- SUBROUTINE CONSAV --------------------------------
0004    !
0005    !  FUNCTIONAL DESCRIPTION:
0006    !
0007    !         This routine is called by gcontr to 'draw' the contour lines.  x, y
0008    !         are "matrix coordinates" of a point on the contour, and isave is an
0009    !         integer code indicating the contour line status.  In fact the lines
0010    !         are not actually drawn by this routine, but the coordinates are saved
0011    !         in common block /CONDAT/ for use by CONTUR.   For more information
0012    !         SEE THE INTRODUCTORY COMMENTS IN GCONTR.
0013    !
0014    !  FORMAL ARGUMENTS:
0015    !
0016    !        x, y           INPUT        "Coordinates" of point to be drawn on a
0017    !                                    contour line.  These "coordinates" are
0018    !                                    interms of the row and column indices of
0019    !                                    of the matrix of z-values. Specifically
0020    !                                    (2.5,4.25) would correspond to a point
0021    !                                    whose x value is half way between the x
0022    !                                    value of the second row and the x value of
0023    !                                    the third row, and whose y value is 1/4 the
0024    !                                    way from the y value of the fourth column
0025    !                                    to the fifth column.
0026    !
0027    !        iflag          INPUT        Indicates whether the current point (x,y)
0028    !                                    starts a new contour, continues an old
0029    !                                    contour, etc.  See the introductory
0030    !                                    comments of GCONTR.
0031    !
0032    !  IMPLICIT INPUTS:
0033    !
0034    !        From common block /CONDAT/ this subroutine uses:
0035    !
0036    !        nxpts, nypts   INPUT        The number of grid points in the x and y
0037    !                                    directions.  These values are used by
0038    !                                    CONSAV to get the user coordinates of
0039    !                                    points on a contour line.
0040    !
0041    !        kpoint         INPUT        The total number of points saved for all
0042    !                                    contours up to the current call to CONSAV.
0043    !
0044    !        NContr         INPUT        The total number of distinct contours
0045    !                                    up to the current call to CONSAV.
0046    !
0047    !        cv             INPUT        Array of Z-levels along which the contour
0048    !                                    lines are drawn
0049    !
0050    !        From common block /GKG/ this subroutine uses:
0051    !
0052    !        XORIG, XMAX,   INPUT        Current user coordinate system limits.
0053    !        YORIG, YMAX
0054    !
0055    !
0056    !  IMPLICIT OUTPUTS:
0057    !

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  24
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0058    !        kpoint         OUTPUT       The total number of points saved for all
0059    !                                    contours after the current call to CONSAV.
0060    !
0061    !        NContr        OUTPUT        The total number of distinct contours
0062    !                                    after the current call to CONSAV.
0063    !
0064    !        NPts          OUTPUT        Array listing the number of points in each
0065    !                                    distinct contour line.
0066    !
0067    !        Zlevel        OUTPUT        Array listing the level of each distinct
0068    !                                    contour line.
0069    !
0070    !        XVal, YVAL    OUTPUT        Lists of coordinates of points on contour
0071    !                                    lines.  Each contour line is stored as a
0072    !                                    sequence of x,y coordinates in the user's
0073    !                                    coordinate system.  If a contour line is
0074    !                                    closed, the first and last points in the
0075    !                                    contour line are the same.
0076    !  SIDE EFFECTS:
0077    !
0078    !         NONE
0079    !--
0080     
0081          SUBROUTINE consav(x, y, iflag)
0082     
0083          INCLUDE 'gplot_src:GKG.INC/LIST'     ! Bring in xorig, xmax
0084  1 	PARAMETER (NLINEAR=0,NSTEP=1,NBARS=2,NPOLY3=3,NSPLINE=4,
0085  1 	1 NPOLY5=5,NPARA3=6,NRASPLN=7,NPSPLIN=8,NPARA5=9)
0086  1 	COMMON/GKG/XORIG,XMAX,YORIG,YMAX,IPIC,LTYPE,XCYCLE
0087  1 	1,YCYCLE,THEFAC,RSTEP,KOLOR,LXNAME,LYNAME,IXNAME,IYNAME
0088  1 	2,TRANON,XSTP,YSTP,NTERP,TENSN,BARWTH,XYDRAT
0089  1 	3,XTKIN,XLBREV,YTKIN,YLBREV
0090  1 	REAL XORIG,XMAX,YORIG,YMAX,XCYCLE,YCYCLE,THEFAC,RSTEP
0091  1 	REAL XSTP,YSTP,BARWTH,XYDRAT
0092  1 	INTEGER IPIC,LTYPE,IXNAME,IYNAME
0093  1 	LOGICAL TRANON,XTKIN,XLBREV,YTKIN,YLBREV
0094  1 	CHARACTER*300 LXNAME,LYNAME
0095                                                       !      and yorig, ymax
0096     
0097          INCLUDE 'gplot_src:CONTOUR_DEFS.INC/LIST'
0098  1       PARAMETER (MaxPts = 20000)      ! maximum number of points allowed
0099  1                                       ! on all contours
0100  1       PARAMETER (MaxCon = 400)        ! maximum number of contour curves
0101  1  
0102  1       PARAMETER (NWork = 50000)       ! the size of the work area is actually
0103  1                                       ! (2 * nx * ny * ncv + 30)/31 where 
0104  1                                       !
0105  1                                       !     nx  = number of rows in data matrix
0106  1                                       !
0107  1                                       !     ny  = number of columns in matrix
0108  1                                       !
0109  1                                       !     ncv = number distinct contour levels
0110  1 	      ! cmin = distance in inches between contour labels (TGW)
0111  1  
0112  1       COMMON /CONDAT/Imode(20),Lbl(20),ITh(20),IPri(20),NContr,kPoint,
0113  1      :        Npts(MaxCon), ZLevel(MaxCon), XVal(MaxPts), YVal(MaxPts),         
0114  1      :        cv(MaxCon), zstep, nxpts, nypts, cmin

CONSAV                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  25
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0115  1  
0116  1 !      LOGICAL TranOn
0117  1 	data cmin/3.0/
0118     
0119          SAVE kSoFar
0120     
0121          iact = mod(iflag,10)
0122          ilevel = iflag/10
0123     
0124          xuser = (x-1.)/(nxpts-1)*(xmax-xorig) + xorig      ! get user coordinates
0125          yuser = (y-1.)/(nypts-1)*(ymax-yorig) + yorig      ! of the current point
0126     
0127          if (iact .eq. 1) then                 ! continue a contour
0128            kSoFar = kSoFar + 1
0129            kpoint = kpoint + 1
0130            XVal(kpoint) = xuser
0131            YVal(kpoint) = yuser
0132          elseif (iact .eq. 2 .or. iact .eq. 3) then    ! start a contour
0133            kSoFar = 1
0134            NContr = NContr + 1
0135            ZLevel(NContr) = cv(ilevel)
0136            kpoint = kpoint + 1
0137            XVal(kpoint) = xuser
0138            YVal(kpoint) = yuser
0139          elseif (iact .eq. 4 .or. iact .eq. 5) then    ! finish a contour
0140            kSoFar = kSoFar + 1
0141            kpoint = kpoint + 1
0142            XVal(kpoint) = xuser
0143            YVal(kpoint) = yuser
0144            Npts(NContr) = kSoFar
0145          elseif (iact .eq. 6) then             ! move pen (this is ignored)
0146          else
0147            print *,'ERROR -- invalid iflag in gcontr : ',iflag
0148          endif
0149          END

CONSAV                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  26
01                                                              21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  309   PIC CON REL LCL   SHR   EXE   RD NOWRT QUAD
  1 $PDATA                                  35   PIC CON REL LCL   SHR NOEXE   RD NOWRT QUAD
  2 $LOCAL                                  12   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD
  3 GKG                                    696   PIC OVR REL GBL   SHR NOEXE   RD   WRT QUAD
  4 CONDAT                              165144   PIC OVR REL GBL   SHR NOEXE   RD   WRT QUAD

    Total Space Allocated               166196


ENTRY POINTS

    Address  Type  Name          

  0-00000000       CONSAV        


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  3-000002A0  R*4  BARWTH          4-00028514  R*4  CMIN                **      I*4  IACT           AP-0000000C@ I*4  IFLAG         
      **      I*4  ILEVEL          3-00000010  I*4  IPIC            3-00000284  I*4  IXNAME          3-00000288  I*4  IYNAME        
  3-00000028  I*4  KOLOR           4-00000144  I*4  KPOINT          2-00000000  I*4  KSOFAR          3-00000014  I*4  LTYPE         
  3-0000002C  CHAR LXNAME          3-00000158  CHAR LYNAME          4-00000140  I*4  NCONTR          3-00000298  I*4  NTERP         
  4-0002850C  I*4  NXPTS           4-00028510  I*4  NYPTS           3-00000024  R*4  RSTEP           3-0000029C  R*4  TENSN         
  3-00000020  R*4  THEFAC          3-0000028C  L*4  TRANON         AP-00000004@ R*4  X               3-00000018  R*4  XCYCLE        
  3-000002AC  L*4  XLBREV          3-00000004  R*4  XMAX            3-00000000  R*4  XORIG           3-00000290  R*4  XSTP          
  3-000002A8  L*4  XTKIN               **      R*4  XUSER           3-000002A4  R*4  XYDRAT         AP-00000008@ R*4  Y             
  3-0000001C  R*4  YCYCLE          3-000002B4  L*4  YLBREV          3-0000000C  R*4  YMAX            3-00000008  R*4  YORIG         
  3-00000294  R*4  YSTP            3-000002B0  L*4  YTKIN               **      R*4  YUSER           4-00028508  R*4  ZSTEP         


ARRAYS

    Address  Type  Name                Bytes  Dimensions

  4-00027EC8  R*4  CV                   1600  (400)
  4-00000000  I*4  IMODE                  80  (20)
  4-000000F0  I*4  IPRI                   80  (20)
  4-000000A0  I*4  ITH                    80  (20)
  4-00000050  I*4  LBL                    80  (20)
  4-00000148  I*4  NPTS                 1600  (400)
  4-00000DC8  R*4  XVAL                80000  (20000)
  4-00014648  R*4  YVAL                80000  (20000)
  4-00000788  R*4  ZLEVEL               1600  (400)

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  27
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0001     

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  28
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0003    c!++
0004    c!----------------------------- SUBROUTINE ATRANS ----------------------------
0005    c!
0006    c!  FUNCTIONAL DESCRIPTION:
0007    c!
0008    c!       Sets/Resets a global flag that indicates whether or not the user
0009    c!       supplied transformation TRANS is to be called before plotting lines,
0010    c!       text, etc.
0011    c!
0012    c!  FORMAL ARGUMENTS:
0013    c!
0014    c!       iflag             INPUT         iflag = 1 means enable TRANS, and
0015    c!                                       iflag = 0 means disable TRANS
0016    c!
0017    c!  IMPLICIT INPUTS:
0018    c!
0019    c!       NONE
0020    c!
0021    c!  IMPLICIT OUTPUTS:
0022    c!
0023    c!       TranOn            OUTPUT        This global flag is set according to the
0024    c!                                       value of iflag.  The status of this flag
0025    c!                                       must then be checked by routines which
0026    c!                                       map user coordinates to page
0027    c!                                       coordinates.
0028    c!
0029    c!  SIDE EFFECTS:
0030    c!
0031    c!       NONE
0032    c!
0033    c!--
0034    c      SUBROUTINE atrans(iflag)
0035    c 
0036    c      INCLUDE 'gplot_src:CONTOUR_DEFS.INC/LIST'
0037    c 
0038    c      if (iflag .eq. 1) then
0039    c        TranOn = .true.
0040    c      else
0041    c        TranOn = .false.
0042    c      endif
0043    c 
0044    c      END
0045     

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  29
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0047    c  Subroutines gcontr, fill0, mark1, and iget are from algorithm #531 of the
0048    c  Collected Algorithms of the Association for Computing Machinery.
0049    c
0050    c  They were obtained from NETLIB.  (SEND 531 FROM TOMS)
0051     
0052     
0053     
0054    c------------------------ SUBROUTINE gcontr -------------------------------
0055    c
0056          subroutine gcontr(z, nrz, nx, ny, cv, ncv, zmax, bitmap, draw)
0057    c
0058    c     this subroutine draws a contour through equal values of an array.
0059    c
0060    c     *****     formal arguments     ***********************************
0061    c
0062    c     z is the array for which contours are to be drawn.  the elements
0063    c     of z are assumed to lie upon the nodes of a topologically
0064    c     rectangular coordinate system - e.g. cartesian, polar (except
0065    c     the origin), etc.
0066    c
0067    c     nrz is the number of rows declared for z in the calling program.
0068    c
0069    c     nx is the limit for the first subscript of z.
0070    c
0071    c     ny is the limit for the second subscript of z.
0072    c
0073    c     cv are the values of the contours to be drawn.
0074    c
0075    c     ncv is the number of contour values in cv.
0076    c
0077    c     zmax is the maximum value of z for consideration.  a value of
0078    c     z(i,j) greater than zmax is a signal that that point and the
0079    c     grid line segments radiating from that point to it's neighbors
0080    c     are to be excluded from contouring.
0081    c
0082    c     bitmap is a work area large enough to hold 2*nx*ny*ncv bits.  it
0083    c     is accessed by low-level routines, which are described below.
0084    c     let j be the number of useful bits in each word of bitmap,
0085    c     as determined by the user machine and implementation of
0086    c     the bitmap manipulation subprograms described below.  then
0087    c     the number of words required for the bitmap is the floor of
0088    c         (2*nx*ny*ncv+j-1)/j.
0089    c
0090    c     draw is a user-provided subroutine used to draw contours.
0091    c     the calling sequence for draw is:
0092    c
0093    c         call draw (x,y,iflag)
0094    c         let nx = integer part of x, fx = fractional part of x.
0095    c         then x should be interpreted such that increases in nx
0096    c         correspond to increases in the first subscript of z, and
0097    c         fx is the fractional distance from the abscissa corresponding
0098    c         to nx to the abscissa corresponding to nx+1,
0099    c         and y should be interpreted similarly for the second
0100    c         subscript of z.
0101    c         the low-order digit of iflag will have one of the values:
0102    c             1 - continue a contour,

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  30
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0103    c             2 - start a contour at a boundary,
0104    c             3 - start a contour not at a boundary,
0105    c             4 - finish a contour at a boundary,
0106    c             5 - finish a closed contour (not at a boundary).
0107    c                 note that requests 1, 4 and 5 are for pen-down
0108    c                 moves, and that requests 2 and 3 are for pen-up
0109    c                 moves.
0110    c             6 - set x and y to the approximate 'pen' position, using
0111    c                 the notation discussed above.  this call may be
0112    c                 ignored, the result being that the 'pen' position
0113    c                 is taken to correspond to z(1,1).
0114    c         iflag/10 is the contour number.
0115    c
0116    c     *****     external subprograms     *******************************
0117    c
0118    c     draw is the user-supplied line drawing subprogram described above.
0119    c     draw may be sensitive to the host computer and to the plot device.
0120    c     fill0 is used to fill a bitmap with zeroes.  call fill0 (bitmap,n)
0121    c     fills the first n bits of bitmap with zeroes.
0122    c     mark1 is used to place a 1 in a specific bit of the bitmap.
0123    c     call mark1 (bitmap,n) puts a 1 in the nth bit of the bitmap.
0124    c     iget is used to determine the setting of a particular bit in the
0125    c     bitmap.  i=iget(bitmap,n) sets i to zero if the nth bit of the
0126    c     bitmap is zero, and sets i to one if the nth bit is one.
0127    c     fill0, mark1 and iget are machine sensitive.
0128    c
0129    c     ******************************************************************
0130    c
0131          real z(nrz,1), cv(1)
0132          integer bitmap(1)
0133          integer l1(4), l2(4), ij(2)
0134    c
0135    c     l1 and l2 contain limits used during the spiral search for the
0136    c     beginning of a contour.
0137    c     ij stores subcripts used during the spiral search.
0138    c
0139          integer i1(2), i2(2), i3(6)
0140    c
0141    c     i1, i2 and i3 are used for subscript computations during the
0142    c     examination of lines from z(i,j) to it's neighbors.
0143    c
0144          real xint(4)
0145    c
0146    c     xint is used to mark intersections of the contour under
0147    c     consideration with the edges of the cell being examined.
0148    c
0149          real xy(2)
0150    c
0151    c     xy is used to compute coordinates for the draw subroutine.
0152    c
0153          equivalence (l2(1),imax), (l2(2),jmax), (l2(3),imin),
0154         *  (l2(4),jmin)
0155          equivalence (ij(1),i), (ij(2),j)
0156          equivalence (xy(1),x), (xy(2),y)
0157    c
0158          data l1(3) /-1/, l1(4) /-1/
0159          data i1 /1,0/, i2 /1,-1/, i3 /1,0,0,1,1,0/

GCONTR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  31
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0160    c
0161          l1(1) = nx
0162          l1(2) = ny
0163          dmax = zmax
0164    c
0165    c     set the current pen position.  the default position corresponds
0166    c     to z(1,1).
0167    c
0168          x = 1.0
0169          y = 1.0
0170          call draw(x, y, 6)
0171          icur = max0(1,min0(int(x),nx))
0172          jcur = max0(1,min0(int(y),ny))
0173    c
0174    c     clear the bitmap
0175    c
0176          call fill0(bitmap, 2*nx*ny*ncv)
0177    c
0178    c     search along a rectangular spiral path for a line segment having
0179    c     the following properties:
0180    c          1.  the end points are not excluded,
0181    c          2.  no mark has been recorded for the segment,
0182    c          3.  the values of z at the ends of the segment are such that
0183    c              one z is less than the current contour value, and the
0184    c              other is greater than or equal to the current contour
0185    c              value.
0186    c
0187    c     search all boundaries first, then search interior line segments.
0188    c     note that the interior line segments near excluded points may be
0189    c     boundaries.
0190    c
0191          ibkey = 0
0192       10 i = icur
0193          j = jcur
0194       20 imax = i
0195          imin = -i
0196          jmax = j
0197          jmin = -j
0198          idir = 0
0199    c     direction zero is +i, 1 is +j, 2 is -i, 3 is -j.
0200       30 nxidir = idir + 1
0201          k = nxidir
0202          if (nxidir.gt.3) nxidir = 0
0203       40 i = iabs(i)
0204          j = iabs(j)
0205          if (z(i,j).gt.dmax) go to 140
0206          l = 1
0207    c     l=1 means horizontal line, l=2 means vertical line.
0208       50 if (ij(l).ge.l1(l)) go to 130
0209          ii = i + i1(l)
0210          jj = j + i1(3-l)
0211          if (z(ii,jj).gt.dmax) go to 130
0212          assign 100 to jump
0213    c     the next 15 statements (or so) detect boundaries.
0214       60 ix = 1
0215          if (ij(3-l).eq.1) go to 80
0216          ii = i - i1(3-l)

GCONTR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  32
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0217          jj = j - i1(l)
0218          if (z(ii,jj).gt.dmax) go to 70
0219          ii = i + i2(l)
0220          jj = j + i2(3-l)
0221          if (z(ii,jj).lt.dmax) ix = 0
0222       70 if (ij(3-l).ge.l1(3-l)) go to 90
0223       80 ii = i + i1(3-l)
0224          jj = j + i1(l)
0225          if (z(ii,jj).gt.dmax) go to 90
0226          if (z(i+1,j+1).lt.dmax) go to jump, (100, 280)
0227       90 ix = ix + 2
0228          go to jump, (100, 280)
0229      100 if (ix.eq.3) go to 130
0230          if (ix+ibkey.eq.0) go to 130
0231    c     now determine whether the line segment is crossed by the contour.
0232          ii = i + i1(l)
0233          jj = j + i1(3-l)
0234          z1 = z(i,j)
0235          z2 = z(ii,jj)
0236          do 120 icv=1,ncv
0237            if (iget(bitmap,2*(nx*(ny*(icv-1)+j-1)+i-1)+l).ne.0) go to 120
0238            if (cv(icv).le.amin1(z1,z2)) go to 110
0239            if (cv(icv).le.amax1(z1,z2)) go to 190
0240      110   call mark1(bitmap, 2*(nx*(ny*(icv-1)+j-1)+i-1)+l)
0241      120 continue
0242      130 l = l + 1
0243          if (l.le.2) go to 50
0244      140 l = mod(idir,2) + 1
0245          ij(l) = isign(ij(l),l1(k))
0246    c
0247    c     lines from z(i,j) to z(i+1,j) and z(i,j+1) are not satisfactory.
0248    c     continue the spiral.
0249    c
0250      150 if (ij(l).ge.l1(k)) go to 170
0251          ij(l) = ij(l) + 1
0252          if (ij(l).gt.l2(k)) go to 160
0253          go to 40
0254      160 l2(k) = ij(l)
0255          idir = nxidir
0256          go to 30
0257      170 if (idir.eq.nxidir) go to 180
0258          nxidir = nxidir + 1
0259          ij(l) = l1(k)
0260          k = nxidir
0261          l = 3 - l
0262          ij(l) = l2(k)
0263          if (nxidir.gt.3) nxidir = 0
0264          go to 150
0265      180 if (ibkey.ne.0) return
0266          ibkey = 1
0267          go to 10
0268    c
0269    c     an acceptable line segment has been found.
0270    c     follow the contour until it either hits a boundary or closes.
0271    c
0272      190 iedge = l
0273          cval = cv(icv)

GCONTR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  33
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0274          if (ix.ne.1) iedge = iedge + 2
0275          iflag = 2 + ibkey
0276          xint(iedge) = (cval-z1)/(z2-z1)
0277      200 xy(l) = float(ij(l)) + xint(iedge)
0278          xy(3-l) = float(ij(3-l))
0279          call mark1(bitmap, 2*(nx*(ny*(icv-1)+j-1)+i-1)+l)
0280          call draw(x, y, iflag+10*icv)
0281          if (iflag.lt.4) go to 210
0282          icur = i
0283          jcur = j
0284          go to 20
0285    c
0286    c     continue a contour.  the edges are numbered clockwise with
0287    c     the bottom edge being edge number one.
0288    c
0289      210 ni = 1
0290          if (iedge.lt.3) go to 220
0291          i = i - i3(iedge)
0292          j = j - i3(iedge+2)
0293      220 do 250 k=1,4
0294            if (k.eq.iedge) go to 250
0295            ii = i + i3(k)
0296            jj = j + i3(k+1)
0297            z1 = z(ii,jj)
0298            ii = i + i3(k+1)
0299            jj = j + i3(k+2)
0300            z2 = z(ii,jj)
0301            if (cval.le.amin1(z1,z2)) go to 250
0302            if (cval.gt.amax1(z1,z2)) go to 250
0303            if (k.eq.1) go to 230
0304            if (k.ne.4) go to 240
0305      230   zz = z1
0306            z1 = z2
0307            z2 = zz
0308      240   xint(k) = (cval-z1)/(z2-z1)
0309            ni = ni + 1
0310            ks = k
0311      250 continue
0312          if (ni.eq.2) go to 260
0313    c
0314    c     the contour crosses all four edges of the cell being examined.
0315    c     choose the lines top-to-left and bottom-to-right if the
0316    c     interpolation point on the top edge is less than the interpolation
0317    c     point on the bottom edge.  otherwise, choose the other pair.  this
0318    c     method produces the same results if the axes are reversed.  the
0319    c     contour may close at any edge, but must not cross itself inside
0320    c     any cell.
0321    c
0322          ks = 5 - iedge
0323          if (xint(3).lt.xint(1)) go to 260
0324          ks = 3 - iedge
0325          if (ks.le.0) ks = ks + 4
0326    c
0327    c     determine whether the contour will close or run into a boundary
0328    c     at edge ks of the current cell.
0329    c
0330      260 l = ks

GCONTR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  34
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0331          iflag = 1
0332          assign 280 to jump
0333          if (ks.lt.3) go to 270
0334          i = i + i3(ks)
0335          j = j + i3(ks+2)
0336          l = ks - 2
0337      270 if (iget(bitmap,2*(nx*(ny*(icv-1)+j-1)+i-1)+l).eq.0) go to 60
0338          iflag = 5
0339          go to 290
0340      280 if (ix.ne.0) iflag = 4
0341      290 iedge = ks + 2
0342          if (iedge.gt.4) iedge = iedge - 4
0343          xint(iedge) = xint(ks)
0344          go to 200
0345    c
0346          end




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                 1403   PIC CON REL LCL   SHR   EXE   RD NOWRT QUAD
  1 $PDATA                                   4   PIC CON REL LCL   SHR NOEXE   RD NOWRT QUAD
  2 $LOCAL                                 352   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD

    Total Space Allocated                 1759


ENTRY POINTS

    Address  Type  Name          

  0-00000000       GCONTR        


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  2-00000090  R*4  CVAL            2-00000068  R*4  DMAX            2-00000008  I*4  I               2-00000074  I*4  IBKEY         
  2-0000006C  I*4  ICUR            2-00000088  I*4  ICV             2-00000078  I*4  IDIR                **      I*4  IEDGE         
  2-00000094  I*4  IFLAG               **      I*4  II              2-00000010  I*4  IMAX            2-00000018  I*4  IMIN          
      **      I*4  IX              2-0000000C  I*4  J               2-00000070  I*4  JCUR                **      I*4  JJ            
  2-00000014  I*4  JMAX            2-0000001C  I*4  JMIN            2-00000080  I*4  JUMP                **      I*4  K             
  2-00000098  I*4  KS                  **      I*4  L              AP-00000018@ I*4  NCV                 **      I*4  NI            
 AP-00000008@ I*4  NRZ            AP-0000000C@ I*4  NX              2-0000007C  I*4  NXIDIR         AP-00000010@ I*4  NY            
  2-00000000  R*4  X               2-00000004  R*4  Y                   **      R*4  Z1              2-00000084  R*4  Z2            
 AP-0000001C@ R*4  ZMAX                **      R*4  ZZ            

GCONTR                                                          21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  35
01                                                              21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

ARRAYS

    Address  Type  Name                Bytes  Dimensions

 AP-00000020@ I*4  BITMAP                  4  (1)
 AP-00000014@ R*4  CV                      4  (1)
  2-00000030  I*4  I1                      8  (2)
  2-00000038  I*4  I2                      8  (2)
  2-00000040  I*4  I3                     24  (6)
  2-00000008  I*4  IJ                      8  (2)
  2-00000020  I*4  L1                     16  (4)
  2-00000010  I*4  L2                     16  (4)
  2-00000058  R*4  XINT                   16  (4)
  2-00000000  R*4  XY                      8  (2)
 AP-00000004@ R*4  Z                      **  (*, 1)


LABELS

    Address   Label       Address   Label       Address   Label       Address   Label       Address   Label       Address   Label   

  0-000000C0  10        0-000000CC  20        0-000000E4  30        0-000000F7  40        0-0000012C  50        0-00000164  60      
  0-000001A9  70        0-000001B2  80        0-000001EC  90        0-00000208  100       0-000004A0  110       0-000004D4  120     
  0-000004DC  130       0-000004E6  140       0-00000510  150       0-0000052C  160       0-0000053C  170       0-00000568  180     
  0-000002C9  190       0-000002F4  200       0-00000370  210       0-00000384  220       0-000003EB  230       0-000003F4  240     
  0-00000407  250       0-00000426  260       0-0000044A  270       0-000001FA  280       0-00000487  290     


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name            Type  Name            Type  Name            Type  Name          

 @      DRAW                  FILL0            I*4  IGET                  MARK1            I*4  MTH$JISIGN    

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  36
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0001     

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  37
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0003    c---------------------------- SUBROUTINE fill0 ----------------------------
0004    c
0005          subroutine fill0(bitmap, n)
0006    c
0007    c     fill the first n bits of bitmap with zeroes.
0008    c
0009          integer bitmap(1), n
0010    c
0011          data nbpw /31/
0012    c     nbpw is the minimum number of significant bits per word used
0013    c     by integer arithmetic.  this is usually one less than the
0014    c     actual number of bits per word, but an important exception is
0015    c     the cdc-6000 series of machines, where nbpw should be 48.
0016    c
0017          loop = n/nbpw
0018          nblw = mod(n,nbpw)
0019          if (loop.eq.0) go to 20
0020          do 10 i=1,loop
0021            bitmap(i) = 0
0022       10 continue
0023       20 if (nblw.ne.0) bitmap(loop+1) = mod(bitmap(loop+1),2**(nbpw-nblw)
0024         *  )
0025          return
0026          end




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  115   PIC CON REL LCL   SHR   EXE   RD NOWRT QUAD
  2 $LOCAL                                  28   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD

    Total Space Allocated                  143


ENTRY POINTS

    Address  Type  Name          

  0-00000000       FILL0         


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

      **      I*4  I                   **      I*4  LOOP           AP-00000008@ I*4  N                   **      I*4  NBLW          
  2-00000000  I*4  NBPW          

FILL0                                                           21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  38
01                                                              21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

ARRAYS

    Address  Type  Name                Bytes  Dimensions

 AP-00000004@ I*4  BITMAP                  4  (1)


LABELS

    Address   Label       Address   Label   

      **      10        0-0000004F  20      

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  39
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0001     

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  40
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0003    c-------------------------- SUBROUTINE mark1 -------------------------------
0004    c
0005          subroutine mark1(bitmap, n)
0006    c
0007    c     put a one in the nth bit of bitmap.
0008    c
0009          integer bitmap(1), n
0010    c
0011          data nbpw /31/
0012    c     nbpw is the minimum number of significant bits per word used
0013    c     by integer arithmetic.  this is usually one less than the
0014    c     actual number of bits per word, but an important exception is
0015    c     the cdc-6000 series of machines, where nbpw should be 48.
0016    c
0017          nword = (n-1)/nbpw
0018          nbit = mod(n-1,nbpw)
0019          i = 2**(nbpw-nbit-1)
0020          bitmap(nword+1) = bitmap(nword+1) + i*(1-mod(bitmap(nword+1)/i,2)
0021         *  )
0022          return
0023          end




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                   87   PIC CON REL LCL   SHR   EXE   RD NOWRT QUAD
  2 $LOCAL                                  24   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD

    Total Space Allocated                  111


ENTRY POINTS

    Address  Type  Name          

  0-00000000       MARK1         


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

      **      I*4  I              AP-00000008@ I*4  N                   **      I*4  NBIT            2-00000000  I*4  NBPW          
      **      I*4  NWORD         

MARK1                                                           21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  41
01                                                              21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

ARRAYS

    Address  Type  Name                Bytes  Dimensions

 AP-00000004@ I*4  BITMAP                  4  (1)

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  42
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0001     

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  43
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0003    c------------------------- FUNCTION iget -------------------------------
0004    c
0005          function iget(bitmap, n)
0006    c
0007    c     iget=0 if the nth bit of bitmap is zero, else iget is one.
0008    c
0009          integer bitmap(1), n
0010    c
0011          data nbpw /31/
0012    c     nbpw is the minimum number of significant bits per word used
0013    c     by integer arithmetic.  this is usually one less than the
0014    c     actual number of bits per word, but an important exception is
0015    c     the cdc-6000 series of machines, where nbpw should be 48.
0016    c
0017          nword = (n-1)/nbpw
0018          nbit = mod(n-1,nbpw)
0019          iget = mod(bitmap(nword+1)/2**(nbpw-nbit-1),2)
0020          return
0021          end




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                   75   PIC CON REL LCL   SHR   EXE   RD NOWRT QUAD
  2 $LOCAL                                  28   PIC CON REL LCL NOSHR NOEXE   RD   WRT QUAD

    Total Space Allocated                  103


ENTRY POINTS

    Address  Type  Name          

  0-00000000  I*4  IGET          


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

 AP-00000008@ I*4  N                   **      I*4  NBIT            2-00000004  I*4  NBPW                **      I*4  NWORD         


ARRAYS

    Address  Type  Name                Bytes  Dimensions

 AP-00000004@ I*4  BITMAP                  4  (1)

                                                                21-Oct-1991 11:43:02	VAX FORTRAN V5.6-119                Page  44
                                                                21-Oct-1991 11:23:53	UD5:[GPLOT.EXAMPLES]C_SUBS3.FOR;33          

0001     


COMMAND QUALIFIERS

  FORTRAN/LIST/NOOBJ/D_LINES C_SUBS3

  /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)
  /DEBUG=(NOSYMBOLS,TRACEBACK)
  /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS)
  /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE)
  /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX)
  /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN)
  /CONTINUATIONS=19  /NOCROSS_REFERENCE  /D_LINES  /NOEXTEND_SOURCE
  /F77  /NOG_FLOATING  /I4  /NOMACHINE_CODE  /OPTIMIZE  /NOPARALLEL
  /NOANALYSIS_DATA
  /NODIAGNOSTICS
  /LIST=UD5:[GPLOT.EXAMPLES]C_SUBS3.LIS;3                                                                   
  /NOOBJECT


COMPILATION STATISTICS

  Run Time:           7.92 seconds
  Elapsed Time:       13.12 seconds
  Page Faults:        469
  Dynamic Memory:     524 pages
