
      PROGRAM EZMPDE
C
C Define some parameters that say how much data we can handle.  MNES is
C the maximum number of edges we can handle, MNEP is the maximum number
C of edge points we can handle, MNAI is the maximum number of area
C identifiers we can handle, LAMA is the length of the area map to be
C used, MCRA is the dimension of the X and Y arrays passed to ARSCAM,
C and MMRK is the maximum number of error positions allowed to be marked
C at the same time.
C
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        PARAMETER (LAMA=2000000)
        PARAMETER (MCRA= 200000)
        PARAMETER (MMRK=   1000)
C
C Declare arrays required to read the selected boundary-outline dataset
C and associated information.
C
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
C
C Declare common block in which to pass viewport and window information
C to UPDATA.
C
        COMMON /EDCOM3/ VP(4),WD(4),LL
        SAVE   /EDCOM3/
C
C Declare common block in which to pass colors for outlines and solid
C fill to RNGSSQ.
C
        COMMON /RNGSCO/  IKOL(5),IKSF(5)
        SAVE   /RNGSCO/
C
C Declare some temporary variables used in dealing with area names.
C
        CHARACTER*64 NSCR,NNAM
C
C Declare variables required to deal with dataset names.
C
        CHARACTER*64 FNMI,FNMN,FNMO,FNMP,FNMQ
C
C Declare an array needed in determining which area identifiers are
C actually referenced.
C
        DIMENSION IREF(MNAI)
C
C Declare the coordinate permutation array needed in the code that
C breaks edges at points which are part of other edges.
C
        DIMENSION ICPA(MNEP)
C
C Keep the compiler from treating certain subroutine names as variables.
C
        EXTERNAL COLORA,LABELA,NUMBRA,UPDATA
C
C Declare quantities required to send windowed outlines to an area map
C and retrieve areas from it.
C
        COMMON /WDCOMN/ WXMN,WXMX,WYMN,WYMX
C
        DIMENSION IAMA(LAMA),XCRA(MCRA),YCRA(MCRA),IAAI(1),IAGI(1)
C
C Declare quantities required to output windowed outlines to an ASCII
C file.
C
        COMMON /WCCOMN/ NOSW
        SAVE   /WCCOMN/
C
C Declare quantities required to output windowed outlines to a Vis5D
C file.
C
        COMMON /WVCOMN/ NOSS,NOVS,ISEG(6)
        SAVE   /WVCOMN/
C
C Declare arrays required for determining and marking error positions.
C
        DIMENSION XMRK(MMRK),YMRK(MMRK)
        DIMENSION DSEG(10),ISIL(10),ISIR(10),IPER(10)
C
C Declare temporary variables to use in reading import-data files.
C
        CHARACTER*64 NOOL,NOOR
        CHARACTER*24 XXYY
C
C Declare a variable into which to read input commands.
C
        CHARACTER*1 COMD
C
C Declare some temporary character variables.
C
        CHARACTER*8 CTM1
        CHARACTER*128 CTM2
        CHARACTER*8 CTM3
        CHARACTER*147 TNM1,TNM2,NAML,NAMR
C
C Declare arrays required for grid labelling.
C
        DIMENSION RGRD(6),IGCI(6)
C
C Declare arrays in which to define the color and thickness of edges.
C
        DIMENSION ICOL(6),THCK(6)
C
C Declare a work array needed by RNGSOL and RNGSSF.
C
        PARAMETER (LRWK=122000,LRWH=LRWK/2,LHP1=LRWH+1)
        DIMENSION RWRK(LRWK)
C
C Declare character variables for EZMAP projection type and limit type.
C
        CHARACTER*2 PTYP,LTYP,PTYS,LTYS
C
C Declare other variables used in defining an EZMAP projection.
C
        DIMENSION PLM1(2),PLM2(2),PLM3(2),PLM4(2),ZROS(2)
C
C Declare variables defining reference points used in setting up EZMAP
C parameters specifying how a PNG is to be mapped onto the globe.
C
        PARAMETER (MPRP=99)
C
        DIMENSION IPXL(MPRP),PXLT(MPRP),PXLN(MPRP),PXLX(MPRP),PXLY(MPRP)
C
C Declare variables used to compute a correction function for a PNG.
C
        DIMENSION XINP(MPRP),YINP(MPRP),ZIXO(MPRP),ZIYO(MPRP)
C
C Declare variables used to implement an approximate representation of
C a correction function (to speed up the use of such a function).
C
        PARAMETER (MCFA=200,NCFA=200,MCFM=MCFA-1,NCFM=NCFA-1)
        DIMENSION XCFA(MCFA),YCFA(NCFA)
        DIMENSION ZCFX(MCFA,NCFA),ZCFY(MCFA,NCFA)
C
C Declare scratch arrays used in computing a correction function.
C
        PARAMETER (LIWK=31*MPRP+MCFA*NCFA,LFWK=8*MPRP)
        DIMENSION IWRK(LIWK),FWRK(LFWK)
C
C Declare an array to hold a cell array derived from a PNG background.
C We allow for a maximum of 1200x1200 cells, but we have to supply one
C more location than that because of a code peculiarity.  (I'm using
C the code in a loop to compute one more set of values, for the center
C point of the display.)
C
        PARAMETER (NCRA=1440001)
C
        DIMENSION ICRA(NCRA)
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
C Set the default values of the parameter that says what part of the
C globe we're looking at.
C
        DATA XCEN,YCEN,RNGE / 0. , 0. , 360. /
C
C Set the default value of the parameter that determines whether or not
C a grid will be drawn.
C
        DATA IGRD / 1 /
C
C Set the values of quantities required for grid labelling.
C
        DATA RGRD / .001 , .01 , .1 , 1. , 10. , 90. /
        DATA IGCI /   10 ,   2 ,  3 , 4  ,  5 ,   5  /
C
C Set the default values of the parameters that determine whether or
C not filling of areas will be done.  IFIL is just an on/off switch;
C its value can be toggled by an 'F' command.  The value of RFIL can
C be set by a 'V' command; it specifies the value of RNGE below which
C areas are filled.
C
        DATA IFIL,RFIL / 0 , 100. /
C
C Set the default value of a parameter determining whether or not a PNG
C background will be drawn.  IPBG may have the following values: -1 =>
C no PNG file has been read; 0 => PNG file has been read but is not to
C be displayed; 1 => PNG file has been read and is to be displayed.
C
        DATA IPBG / -1 /
C
C Set the default value of parameters defining reference points used in
C setting up EZMAP parameters specifying how a PNG is to be mapped onto
C the globe.
C
        DATA NPRP / 0 /
        DATA IPXL / MPRP*0 /
        DATA PXLT / MPRP*0. /
        DATA PXLN / MPRP*0. /
        DATA PXLX / MPRP*0. /
        DATA PXLY / MPRP*0. /
C
C Set the default values of parameters determining whether or not a
C RANGS/GSHHS background will be drawn.  IRBG is essentially an on/off
C switch, but with three "on" states (1 => fill only, 2 => outlines
C only, 3 => fill and outline); its value can be changed with a 'B'
C command.  The value of RRBG can be set by a 'V' command; it specifies
C the value of RNGE below which the background will be drawn.
C
        DATA IRBG,RRBG / 0 , 100. /
C
C Set the default value of the parameter that specifies the value of
C RNGE below which points are labeled.
C
        DATA RLBL / 1. /
C
C Set the default values of the error-marking parameters.
C
        DATA IMRK,NMRK / 0 , 0 /
C
C Set the default value of the desired distance between points on an
C interpolated replacement edge.
C
        DATA DLES / .05 /
C
C Set the default values of the NCGM output controls.
C
        DATA NCGM,NCGN / 0 , 0 /
C
C Set the default values of line color and thickness for various types
C of boundary lines.
C
        DATA ICOL /   9 ,  11 ,  12 ,  13 ,   14 ,  15 /
        DATA THCK / 1.0 , 1.0 , 1.0 , 1.0 ,  1.0 , 1.0 /
C
C Set the default value of the parameter that says what area level will
C be displayed.
C
        DATA ILVL / 5 /
C
C Set the default value of the parameter that, if non-zero, says to make
C all lines at levels less than or equal to that value a special color.
C
        DATA ICKL / 0 /
C
C Define the default values of some parameters used in editing areas.
C
        DATA NATY /  1  /
        DATA NSCI /  1  /
        DATA NPAR /  0  /
        DATA NNAM / ' ' /
C
C Define the default value of a parameter that says whether area labels
C will be written or not and, if so, how large the characters in them
C are to be.
C
        DATA CSAN / .0125 /
C
C Define the default value of a parameter that says whether or not
C global replacements are to be done (the "Global Replacement Flag"),
C and, if so, what tolerance is to be used.
C
        DATA GLRF / .001 /
C
C Set the default values of variables defining an EZMAP projection.
C
        DATA PTYP / 'CE' /
C
        DATA PLAT,PLON,ROTA / 0.,0.,0. /
C
        DATA SALT,SAN1,SAN2 / 1.125,0.,0. /
C
        DATA LTYP / 'MA' /
C
        DATA PLA1,PLA2,PLA3,PLA4 / 4*0. /
        DATA PLC1,PLC2,PLC3,PLC4 / 4*0. /
        DATA PLG1,PLG2,PLG3,PLG4 / 4*0. /
        DATA PLL1,PLL2,PLL3,PLL4 / 4*0. /
        DATA PL11,PL21,PL12,PL22,PL13,PL23,PL14,PL24 / 8*0. /
C
        DATA OORV / 1.E12 /
C
C Set the default values of variables defining the dimensions of the
C cell array to be used in displaying a PNG background.  Conceptually,
C the display area is covered by an ICADxICAD array of cells, but we
C will only display those with first indices in [ICI1,ICI2] and second
C indices in [ICJ1,ICJ2].  The object of this scheme is to allow the
C user to speed up the process of computing and displaying the cell
C array.
C
        DATA ICAD,ICI1,ICI2,ICJ1,ICJ2 / 1200,1,1200,1,1200 /
C
C Set the default value of the parameter that says how many input points
C have been collected for the code that sets up a correction function.
C NINP is negated to force the use of an approximation of the function.
C 
        DATA NINP / 0 /
C
C Set the default value of the quick mode dot size.
C
        DATA DSZE / .003 /
C
C Define some necessary constants.
C
        DATA DTOR / .017453292519943 /
        DATA RTOD / 57.2957795130823 /
C
C Define an arithmetic statement function which has a negative value if
C the point (X3,Y3) is to the right of the line from (X1,Y1) to (X2,Y2)
C and a positive value otherwise.
C
        SIDE(X1,Y1,X2,Y2,X3,Y3)=(X1-X3)*(Y2-Y3)-(Y1-Y3)*(X2-X3)
C
C Define an arithmetic statement function giving the distance from the
C point (X1,Y1) to the point (X2,Y2).
C
        DIST(X1,Y1,X2,Y2)=SQRT((X2-X1)**2+(Y2-Y1)**2)
C
C Define an arithmetic statement function giving the directed distance
C of the point (X3,Y3) from the line joining (X1,Y1) and (X2,Y2),
C negative if and only if the point is to the right of the line.
C
        PERP(X1,Y1,X2,Y2,X3,Y3)=((X1-X3)*(Y2-Y3)-(Y1-Y3)*(X2-X3))/D1T2
C
C If X11 is not active, tell the user so and quit.
C
        IF (ICHX11().EQ.0) THEN
          PRINT * , 'X11 is not active - editor cannot be run.'
          STOP
        END IF
C
C Turn on "raw" terminal input, and reset "Q" variables appropriately.
C Note that, if an error occurs, the "Q" variables are set for normal
C terminal input, but execution then immediately terminates.  It might
C be possible to continue execution (though some commands would be
C rendered useless).
C
        CALL SETTTY (0,IERR)
C
        IF (IERR.EQ.0) THEN
          ITTY=1
          Q=CHAR(13)
        ELSE
          ITTY=0
          Q=' '
          PRINT * , 'Error return by routine SETTTY: ',IERR,Q
          PRINT * , 'Can''t turn on ''raw'' terminal input.',Q
          PRINT * , 'Quitting.',Q
          STOP
        END IF
C
C Put NCAR Graphics in error recovery mode.  This is necessary because,
C if an error occurs inside NCAR Graphics, we want to get control back
C and turn off raw terminal input before terminating.
C
        CALL ENTSR (ITMP,1)
C
C Determine the position of zero in the character-collating sequence.
C
        ICH0=ICHAR('0')
C
C Set the default values of the indices of the area and edge picked.
C
        IOAP=0
        IOEP=0
C
C Set the default values of the parameters determining the area to be
C shown in yellow.  (One or the other may be set, but not both at once.)
C
        IOAS=0
        NOAS=' '
C
C Get the name of the dataset to be edited.
C
  101   PRINT * , Q
        PRINT * , 'Enter the name of the dataset to be edited:',Q
        CALL GTCHRS (FNMI,64)
        PRINT * , Q
        PRINT * , 'Merge contiguous edge segments (Y/N)?',Q
        CALL GTCHAR (COMD)
        IF (COMD.NE.'Y'.AND.COMD.NE.'y') THEN
          IMRG=0
        ELSE
          IMRG=1
        END IF
C
C Read data from the selected dataset.
C
        OPEN (11,FILE=FNMI(1:MPILNB(FNMI)),STATUS='OLD',
     +                                         FORM='FORMATTED',ERR=135)
C
C Initialize the number of edge points read so far and the number of
C edges read so far (both to zero).
C
        NOEP=0
        NOES=0
C
C Initialize the area-type, suggested-color-index, parent, and name
C arrays.
C
        DO 132 I=1,MNAI
          IATY(I)=0
          ISCI(I)=0
          IPAR(I)=0
          NAME(I)=' '
  132   CONTINUE
        GO TO 102
C
  135   PRINT * , Q
        PRINT * , 'Error opening dataset - try again.',Q
        GO TO 101

  102   NOES=NOES+1
C
        IF (NOES.GT.MNES) THEN
          PRINT * , 'Too many edges - quitting.',Q
          CLOSE (11)
          CALL EDSTOP
        END IF
C
        READ (11,'(4I4,4F10.5)') NNMS,ILTY(NOES),IAIL(NOES),
     +                           IAIR(NOES),YMAX,YMIN,XMAX,XMIN
C
        NPTS=NNMS/2
C
        IF (NPTS.NE.0) THEN
          IF (NOEP+NPTS.GT.MNEP) THEN
            PRINT * , 'Too many edge points - quitting.',Q
            CLOSE (11)
            CALL EDSTOP
          END IF
          READ (11,'(8F10.5)') (YCRD(NOEP+I),XCRD(NOEP+I),I=1,NPTS)
          IOFP(NOES)=NOEP+1
          IOLP(NOES)=NOEP+NPTS
C
          IF (IMRG.NE.0) THEN
            IF (NOES.GT.1.AND.ILTY(NOES).NE.0) THEN
              IF (ILTY(NOES).EQ.ILTY(NOES-1).AND.
     +            IAIL(NOES).EQ.IAIL(NOES-1).AND.
     +            IAIR(NOES).EQ.IAIR(NOES-1).AND.
     +            XCRD(NOEP).EQ.XCRD(NOEP+1).AND.
     +            YCRD(NOEP).EQ.YCRD(NOEP+1)) THEN
                DO 103 I=NOEP+2,NOEP+NPTS
                  XCRD(I-1)=XCRD(I)
                  YCRD(I-1)=YCRD(I)
  103           CONTINUE
                NPTS=NPTS-1
                NOES=NOES-1
                IOLP(NOES)=NOEP+NPTS
              END IF
            END IF
          END IF
C
          NOEP=NOEP+NPTS
          GO TO 102
        ELSE
          NOES=NOES-1
        END IF
C
        NOAD=0
C
  130   READ (11,'(I4,2I2,I5,1X,A64)') INDX,ITM1,ITM2,ITM3,NSCR
C
        IF (INDX.NE.0) THEN
          IF (INDX.GE.1.AND.INDX.LE.MNAI) THEN
            NOAD=NOAD+1
            IATY(INDX)=ITM1
            ISCI(INDX)=ITM2
            IPAR(INDX)=ITM3
            NAME(INDX)=NSCR
            GO TO 130
          ELSE
            PRINT * , 'Area index outside allowed range - quitting.',Q
            CLOSE (11)
            CALL EDSTOP
          END IF
        END IF
C
        CLOSE (11)
C
C Report the number of edges and points in the dataset.
C
        PRINT * , Q
        PRINT * , 'Number of areas in the dataset:  ',NOAD,Q
        PRINT * , 'Number of edges in the dataset:  ',NOES,Q
        PRINT * , 'Number of points in the dataset: ',NOEP,Q
C
C One-time patch to get rid of "unidentified island(s)".
C
C       DO 997 IOES=1,NOES
C         IOAL=IAIL(IOES)
C         IOAR=IAIR(IOES)
C         IF (NAME(IOAL).EQ.'unidentified island'.OR.
C    +        NAME(IOAL).EQ.'unidentified islands') THEN
C           IF (IATY(IOAL).NE.IATY(IPAR(IOAL)).OR.
C    +          ISCI(IOAL).NE.ISCI(IPAR(IOAL))) THEN
C             PRINT * , 'Problem with area ',IOAL
C           ELSE
C             IAIL(IOES)=IPAR(IOAL)
C           END IF
C         END IF
C         IF (NAME(IOAR).EQ.'unidentified island'.OR.
C    +        NAME(IOAR).EQ.'unidentified islands') THEN
C           IF (IATY(IOAR).NE.IATY(IPAR(IOAR)).OR.
C    +          ISCI(IOAR).NE.ISCI(IPAR(IOAR))) THEN
C             PRINT * , 'Problem with area ',IOAR
C           ELSE
C             IAIR(IOES)=IPAR(IOAR)
C           END IF
C         END IF
C 997   CONTINUE
C
C One-time patch to change the suggested color for all "Ice" areas to 8.
C
C       DO 997 I=1,MNAI
C         IF (IATY(I).NE.0) THEN
C           IF (ISPOAN(I,'Ice').NE.0) ISCI(I)=8
C         END IF
C 997   CONTINUE
C
C One-time patch to modify all coordinates of Antarctica to compensate
C for the assumption that "AntarticaImage.png" was a satellite view,
C rather than an orthographic view.
C
C       PRINT * , Q
C       PRINT * , 'Executing a one-time patch to compensate for the',Q
C       PRINT * , 'assumption that "AntarcticaImage.png" contained',Q
C       PRINT * , 'a satellite-view, rather than an orthographic,',Q
C       PRINT * , 'projection of Antarctica.  Every point south of',Q
C       PRINT * , '60S will be adjusted slightly, with the exception',Q
C       PRINT * , 'of some islands.',Q
C       PRINT * , Q
C       SAL=60.336
C       SSS=SQRT(SAL**2-1.)
C       RDI=SSS*TAN(.4335*DTOR)      !  SV distance to edge of PNG
C       RMU=SIN(26.75*DTOR)          !  OR distance to edge of PNG
C       DO 997 I=1,NOES
C         IF (IAIL(I).EQ.604.OR.IAIR(I).EQ.604) THEN
C           PRINT * , '  Skipping one of the Balleny Islands.',Q
C         END IF
C         IF (IAIL(I).EQ.612.OR.IAIR(I).EQ.612) THEN
C           PRINT * , '  Skipping Peter I Island.',Q
C         END IF
C         DO 996 J=IOFP(I),IOLP(I)
C           IF (YCRD(J).LT.-60.) THEN
C             SNA=SIN(DTOR*(90.+YCRD(J)))
C             CSA=COS(DTOR*(90.+YCRD(J)))
C             RVA=SSS*SNA/(SAL-CSA)  !  SV distance to current point
C             RVA=RVA/RDI            !  as a fraction of PNG radius
C             RVA=RVA*RMU            !  OR distance to current point
C             AVA=ASIN(RVA)
C             YCRD(J)=RTOD*AVA-90.
C           END IF
C 996     CONTINUE
C 997   CONTINUE
C
C Open GKS.
C
        CALL GOPKS (6,0)
C
C Open and activate an X workstation.
C
        CALL GOPWK (1,0,8)
        CALL GACWK (1)
C
C Open and activate an NCGM workstation.
C
        CALL GOPWK (2,0,1)
        CALL GACWK (2)
C
C Turn off clipping by GKS.
C
        CALL GSCLIP (0)
C
C Select a "fill area interior style" of "solid".
C
        CALL GSFAIS (1)
C
C Define some colors to use.
C
        DO 193 I=1,2
C
          CALL GSCR (I,  0,0.,0.,0.)  !  black   - the background
          CALL GSCR (I,  1,1.,1.,1.)  !  white   - the foreground
          CALL GSCR (I,  2,0.,.5,.5)  !  purple  - 1/100-degree grid
          CALL GSCR (I,  3,0.,0.,1.)  !  blue    - 1/10-degree grid
          CALL GSCR (I,  4,1.,0.,0.)  !  red     - 1-degree grid
          CALL GSCR (I,  5,1.,1.,0.)  !  yellow  - 10-degree grid
          CALL GSCR (I,  6,1.,0.,0.)  !  red     - the picked edge
          CALL GSCR (I,  7,1.,0.,1.)  !  magenta - picked point on edge
          CALL GSCR (I,  8,.7,.7,.7)  !  gray    - various
          CALL GSCR (I,  9,0.,.5,0.)  !  green   - problem edges
          CALL GSCR (I, 10,0.,0.,.5)  !  blue    - 1/1000-degree grid
C
          CALL GSCR (I, 11,1.,1.,1.)  !  white   - water/land edges
          CALL GSCR (I, 12,.9,.9,.9)  !  gray    - continent edges
          CALL GSCR (I, 13,.8,.8,.8)  !  gray    - country edges
          CALL GSCR (I, 14,.7,.7,.7)  !  gray    - state edges
          CALL GSCR (I, 15,.6,.6,.6)  !  gray    - county edges
C
          CALL GSCR (I, 16,1.,.6,.6)  !  pink    - edge of area picked
          CALL GSCR (I, 17,1.,.8,.8)  !  pink    - fill of area picked
          CALL GSCR (I, 18,1.,1.,0.)  !  yellow  - edge of area "shown"
          CALL GSCR (I, 19,1.,1.,.8)  !  yellow  - fill of area "shown"
          CALL GSCR (I, 20,.6,1.,1.)  !  cyan    - level-check color
C Area fill:
          CALL GSCR (I, 21,.5,.7,.8)  !  area color 1
          CALL GSCR (I, 22,.4,.4,.6)  !  area color 2
          CALL GSCR (I, 23,.2,.6,.5)  !  area color 3
          CALL GSCR (I, 24,.2,.8,.2)  !  area color 4
          CALL GSCR (I, 25,.5,.6,.2)  !  area color 5
          CALL GSCR (I, 26,.6,.4,.2)  !  area color 6
          CALL GSCR (I, 27,.6,.6,.5)  !  area color 7
          CALL GSCR (I, 28,.9,1.,1.)  !  area color 8
C RANGS/GSHHS background:
          CALL GSCR (I, 29,1.,0.,0.)  !  outline
          CALL GSCR (I, 30,.4,.4,1.)  !  fill ocean
          CALL GSCR (I, 31,.4,1.,.4)  !  fill land
          CALL GSCR (I, 32,.4,.8,.8)  !  fill lake
          CALL GSCR (I, 33,.4,1.,.4)  !  fill island in lake
          CALL GSCR (I, 34,.4,.8,.8)  !  fill pond on island in lake
C Cell array:
          CALL GSCR (I, 35,0.,0.,0.)  !  outside lat/lon range
          CALL GSCR (I, 36,0.,0.,0.)  !  not projectable
          DO 318 J=37,165             !  "gray scale" values
            CALL GSCR (I,J,0.,REAL(J-37)/128.,0.)
  318     CONTINUE
C
  193   CONTINUE
C
C Select font number 25, turn on the outlining of filled fonts, and turn
C off the setting of the outline color.
C
        CALL PCSETI ('FN - FONT NUMBER',25)
        CALL PCSETI ('OF - OUTLINE FLAG',1)
        CALL PCSETR ('OC - OUTLINE LINE COLOR',-1.)
C
C Turn on the computation of text-extent quantities.
C
        CALL PCSETI ('TE',1)
C
C Pass the clipping window to the routines WLTOAM and WLTOAF.
C
        WXMN=.10
        WXMX=.90
        WYMN=.10
        WYMX=.90
C
C Deactivate the NCGM workstation.
C
        CALL GDAWK (2)
C
C Do some consistency checks on the data pointers.  (I'm putting this
C in because it seems to be so easy, when putting in new features, to
C screw up these pointers and it is advantageous to find out about it
C as quickly as possible.)
C
  104   NERR=0
C
        IF (NOES.LT.1.OR.NOES.GT.MNES) THEN
          IF (NERR.EQ.0) PRINT * , Q
          NERR=NERR+1
          PRINT * , 'Value of NOES is incorrect: ',NOES,Q
        END IF
C
        IF (NOEP.LT.1.OR.NOEP.GT.MNEP) THEN
          IF (NERR.EQ.0) PRINT * , Q
          NERR=NERR+1
          PRINT * , 'Value of NOEP is incorrect: ',NOEP,Q
        END IF
C
        IF (IOFP(1).NE.1) THEN
          IF (NERR.EQ.0) PRINT * , Q
          NERR=NERR+1
          PRINT * , 'Value of IOFP(1) is wrong: ',IOFP(1),Q
        END IF
C
        DO 305 I=1,NOES
          IF (I.LT.NOES) THEN
            ITST=IOFP(I+1)-1
          ELSE
            ITST=NOEP
          END IF
          IF (IOLP(I).LT.IOFP(I).OR.IOLP(I).NE.ITST) THEN
            IF (NERR.EQ.0) PRINT * , Q
            NERR=NERR+1
            PRINT * , 'Problem(s) in arrays IOFP and/or IOLP:',Q
            PRINT * , '  IOFP(',I,'): ',IOFP(I),Q
            PRINT * , '  IOLP(',I,'): ',IOLP(I),Q
            IF (I.LT.NOES) THEN
              PRINT * , '  IOFP(',I+1,'): ',IOFP(I+1),Q
              PRINT * , '  IOLP(',I+1,'): ',IOLP(I+1),Q
            END IF
          END IF
  305   CONTINUE
C
        IF (IOEP.NE.0) THEN
          IF (IOEP.LT.1.OR.IOEP.GT.NOES) THEN
            IF (NERR.EQ.0) PRINT * , Q
            NERR=NERR+1
            PRINT * , 'Value of IOEP is incorrect: ',IOEP,Q
          END IF
          IF (IOPP.LT.0.OR.IOPP.GT.IOLP(IOEP)-IOFP(IOEP)) THEN
            IF (NERR.EQ.0) PRINT * , Q
            NERR=NERR+1
            PRINT * , 'Value of IOPP is incorrect: ',IOPP,Q
          END IF
        END IF
C
        IF (NERR.NE.0) THEN
          PRINT * , Q
          PRINT * , 'These errors indicate serious malfunctioning of',Q
          PRINT * , 'the editor.  You cannot continue until the bug',Q
          PRINT * , 'has been found and fixed.',Q
          CALL EDSTOP
        END IF
C
C Clear the X workstation.
C
        CALL GCLRWK (1,1)
C
C If NCGM output is turned on, activate the NCGM workstation.  If any
C frames have previously been output, clear the workstation.
C
        IF (NCGM.NE.0) THEN
          CALL GACWK (2)
          IF (NCGN.NE.0) CALL GCLRWK (2,1)
        END IF
C
C Initialize the mapping of lat/lon coordinates into the viewport.
C
        CALL SET    (.1,.9,.1,.9,XCEN-RNGE/2.,XCEN+RNGE/2.,
     +                           YCEN-RNGE/2.,YCEN+RNGE/2.,1)
C
C If requested, color areas and label them with their names.
C
        IF (IFIL.NE.0.AND.RNGE.LE.RFIL) THEN
          CALL ARINAM (IAMA,LAMA)
          XCRA(1)=MAX(-180.,XCEN-RNGE/2.)
          YCRA(1)=MAX(- 90.,YCEN-RNGE/2.)
          XCRA(2)=MIN( 180.,XCEN+RNGE/2.)
          YCRA(2)=MAX(- 90.,YCEN-RNGE/2.)
          XCRA(3)=MIN( 180.,XCEN+RNGE/2.)
          YCRA(3)=MIN(  90.,YCEN+RNGE/2.)
          XCRA(4)=MAX(-180.,XCEN-RNGE/2.)
          YCRA(4)=MIN(  90.,YCEN+RNGE/2.)
          XCRA(5)=MAX(-180.,XCEN-RNGE/2.)
          YCRA(5)=MAX(- 90.,YCEN-RNGE/2.)
          CALL AREDAM (IAMA,XCRA,YCRA,5,1,0,-1)
          IF (NERRO(ITMP).NE.0) THEN
            PRINT * , Q
            CALL EPRIN
            PRINT * , Q
            CALL ERROF
            GO TO 342
          END IF
          DO 161 IOES=1,NOES
            IOAL=IOAREA(ILVL,IAIL(IOES))
            IOAR=IOAREA(ILVL,IAIR(IOES))
            IF (IOAL.NE.IOAR) THEN
              DO 160 I=IOFP(IOES),IOLP(IOES)
                CALL WLTOAM (CUFX(XCRD(I)),CUFY(YCRD(I)),
     +                             MIN(I-IOFP(IOES),1),IAMA,1,IOAL,IOAR)
               IF (NERRO(ITMP).NE.0) THEN
                 PRINT * , Q
                 CALL EPRIN
                 PRINT * , Q
                 CALL ERROF
                 GO TO 342
               END IF
  160         CONTINUE
            END IF
  161     CONTINUE
          CALL ARSCAM (IAMA,XCRA,YCRA,MCRA,IAAI,IAGI,1,COLORA)
          IF (NERRO(ITMP).NE.0) THEN
            PRINT * , Q
            CALL EPRIN
            PRINT * , Q
            CALL ERROF
            GO TO 342
          END IF
          IF (CSAN.GT.0.) THEN
            CALL GSFACI (1)
            CALL ARSCAM (IAMA,XCRA,YCRA,MCRA,IAAI,IAGI,1,LABELA)
            IF (NERRO(ITMP).NE.0) THEN
              PRINT * , Q
              CALL EPRIN
              PRINT * , Q
              CALL ERROF
              GO TO 342
            END IF
          END IF
          PRINT * , Q
          PRINT * , 'Area map length: ',LAMA-IAMA(6)+IAMA(5)+1,Q
        ELSE
          IF (IPBG.EQ.1) THEN
            CALL MAPROJ (PTYP,PLAT,PLON,ROTA)
            IF (PTYP.EQ.'SV') THEN
              CALL MPSETR ('SA',SALT)
              CALL MPSETR ('S1',SAN1)
              CALL MPSETR ('S2',SAN2)
            END IF
            CALL MAPSET (LTYP,PLM1,PLM2,PLM3,PLM4)
            CALL MAPINT
            IF (NERRO(ITMP).NE.0) THEN
              PRINT * , Q
              CALL EPRIN
              PRINT * , Q
              CALL ERROF
              GO TO 345
            END IF
            CALL GETSET (XVPL,XVPR,YVPB,YVPT,XWDL,XWDR,YWDB,YWDT,LNLG)
            K=1
            ICAN=(ICJ2-ICJ1+1)*(ICI2-ICI1+1)+1
            DO 316 ICAI=1,ICAN
              IF (ICAI.LT.ICAN) THEN
                I=ICI1+MOD(ICAI-1,ICI2-ICI1+1)
                J=ICJ1+(ICAI-1)/(ICI2-ICI1+1)
                XCOC=(.5+REAL(I-1))/REAL(ICAD)
                YCOC=(.5+REAL(J-1))/REAL(ICAD)
                RLON=XCEN+RNGE*(XCOC-.5)
                RLAT=YCEN+RNGE*(YCOC-.5)
              ELSE
                RLON=XCEN
                RLAT=YCEN
              END IF
              IF (RLON.LT.-180..OR.RLON.GT.+180..OR.
     +            RLAT.LT. -90..OR.RLAT.GT. +90.) THEN
                ICRA(ICAI)=35
              ELSE
                CALL MAPTRA (RLAT,RLON,XCOP,YCOP)
                IF (XCOP.EQ.OORV) THEN
                  ICRA(ICAI)=36
                ELSE
                  XOTP=((XCOP-XWDL)/(XWDR-XWDL))*REAL(MGSV)
                  YOTP=((YCOP-YWDB)/(YWDT-YWDB))*REAL(NGSV)
                  IF (NINP.EQ.0) THEN
                    IGSV=MAX(1,MIN(MGSV,1+INT(XOTP)))
                    JGSV=MAX(1,MIN(NGSV,1+INT(YOTP)))
                  ELSE IF (NINP.GT.0) THEN
                    CALL IDBVIP (K,NINP,XINP,YINP,ZIXO,
     +                           1,XOTP,YOTP,ZOXO,IWRK,FWRK)
                    CALL IDBVIP (3,NINP,XINP,YINP,ZIYO,
     +                           1,XOTP,YOTP,ZOYO,IWRK,FWRK)
                    K=2
                    IGSV=MAX(1,MIN(MGSV,1+INT(XOTP+ZOXO)))
                    JGSV=MAX(1,MIN(NGSV,1+INT(YOTP+ZOYO)))
                  ELSE
                    XTMP=((XCOP-XWDL)/(XWDR-XWDL))*REAL(MCFM)
                    YTMP=((YCOP-YWDB)/(YWDT-YWDB))*REAL(NCFM)
                    ITMP=MAX(1,MIN(MCFM,1+INT(XTMP)))
                    JTMP=MAX(1,MIN(NCFM,1+INT(YTMP)))
                    XTMP=XTMP-REAL(ITMP)
                    YTMP=YTMP-REAL(JTMP)
                    ZOXO=(1.-YTMP)*((1.-XTMP)*ZCFX(ITMP  ,JTMP  )+
     +                                  XTMP *ZCFX(ITMP+1,JTMP  ))
     +                     + YTMP *((1.-XTMP)*ZCFX(ITMP  ,JTMP+1)+
     +                                  XTMP *ZCFX(ITMP+1,JTMP+1))
                    ZOYO=(1.-YTMP)*((1.-XTMP)*ZCFY(ITMP  ,JTMP  )+
     +                                  XTMP *ZCFY(ITMP+1,JTMP  ))
     +                     + YTMP *((1.-XTMP)*ZCFY(ITMP  ,JTMP+1)+
     +                                  XTMP *ZCFY(ITMP+1,JTMP+1))
                    IGSV=MAX(1,MIN(MGSV,1+INT(XOTP+ZOXO)))
                    JGSV=MAX(1,MIN(NGSV,1+INT(YOTP+ZOYO)))
                  END IF
                  ICRA(ICAI)=37+INT(128.*GSVALU(IGSV,JGSV))
                END IF
              END IF
  316       CONTINUE
            IF (ICRA(ICAN).LT.37) THEN
              ICEN=0
            ELSE
              ICEN=1
              IF (NINP.NE.0) THEN
                XOTP=XOTP+ZOXO
                YOTP=YOTP+ZOYO
              END IF
            END IF
            CALL SET (.1,.9,.1,.9,0.,REAL(ICAD),0.,REAL(ICAD),1)
            CALL GCA (REAL(ICI1-1),REAL(ICJ1-1),
     +                REAL(ICI2  ),REAL(ICJ2  ),
     +                ICI2-ICI1+1,ICJ2-ICJ1+1,1,1,
     +                ICI2-ICI1+1,ICJ2-ICJ1+1,ICRA)
            IF (NPRP.NE.0) THEN
              CALL PLOTIF (0.,0.,2)
              CALL GSLWSC (2.)
              IF (MGSV.GE.NGSV) THEN
                MTMP=INT(.24*SQRT(REAL(NCRA)))
                NTMP=INT(REAL(MTMP)*REAL(NGSV)/REAL(MGSV))
                CALL SET (.01,.25,.01,.01+.24*REAL(NGSV)/REAL(MGSV),
     +                                0.,REAL(MTMP),0.,REAL(NTMP),1)
              ELSE
                NTMP=INT(.24*SQRT(REAL(NCRA)))
                MTMP=INT(REAL(NTMP)*REAL(MGSV)/REAL(NGSV))
                CALL SET (.01,.01+.24*REAL(MGSV)/REAL(NGSV),.01,.25,
     +                                0.,REAL(MTMP),0.,REAL(NTMP),1)
              END IF
              DO 338 I=1,MTMP
                IGSV=MAX(1,MIN(MGSV,1+INT(((REAL(I)-.5)/REAL(MTMP))*
     +                                                 REAL(MGSV))))
                DO 337 J=1,NTMP
                  JGSV=MAX(1,MIN(NGSV,1+INT(((REAL(J)-.5)/REAL(NTMP))*
     +                                                   REAL(NGSV))))
                  ICRA(MTMP*(J-1)+I-1)=36+INT(128.*GSVALU(IGSV,JGSV))
  337           CONTINUE
  338         CONTINUE
              CALL GCA (0.,0.,REAL(MTMP),REAL(NTMP),MTMP,NTMP,1,1,
     +                                              MTMP,NTMP,ICRA)
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (8)
              CALL LINE (        0.,        0.,REAL(MTMP),        0.)
              CALL LINE (REAL(MTMP),        0.,REAL(MTMP),REAL(NTMP))
              CALL LINE (REAL(MTMP),REAL(NTMP),        0.,REAL(NTMP))
              CALL LINE (        0.,REAL(NTMP),        0.,        0.)
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (6)
              DO 317 I=1,MPRP
                IF (IPXL(I).NE.0) THEN
                  CALL CIRCLE (PXLX(I)*REAL(MTMP)/REAL(MGSV),
     +                         PXLY(I)*REAL(NTMP)/REAL(NGSV),.008)
                END IF
  317         CONTINUE
              IF (ICEN.NE.0) THEN
                CALL PLOTIF (0.,0.,2)
                CALL GSPLCI (8)
                CALL CIRCLE (XOTP*REAL(MTMP)/REAL(MGSV),
     +                       YOTP*REAL(NTMP)/REAL(NGSV),.008)
              END IF
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (1)
              CALL GSLWSC (1.)
            END IF
  345       CALL SET (.1,.9,.1,.9,XCEN-RNGE/2.,XCEN+RNGE/2.,
     +                            YCEN-RNGE/2.,YCEN+RNGE/2.,1)
            IF (NPRP.NE.0) THEN
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (6)
              CALL GSLWSC (2.)
              DO 336 I=1,MPRP
                IF (IPXL(I).NE.0.AND.PXLN(I).GE.XCEN-RNGE/2..AND.
     +                               PXLN(I).LE.XCEN+RNGE/2..AND.
     +                               PXLT(I).GE.YCEN-RNGE/2..AND.
     +                               PXLT(I).LE.YCEN+RNGE/2.) THEN
                  CALL CIRCLE (PXLN(I),PXLT(I),.015)
                END IF
  336         CONTINUE
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (1)
              CALL GSLWSC (1.)
            END IF
          END IF
          IF (IRBG.NE.0.AND.RNGE.LE.RRBG) THEN
            IKOL(1)=29
            IKOL(2)=29
            IKOL(3)=29
            IKOL(4)=29
            IKOL(5)=29
            IKSF(1)=30
            IKSF(2)=31
            IKSF(3)=32
            IKSF(4)=33
            IKSF(5)=34
            IF (IPBG.NE.1.AND.(IRBG.EQ.1.OR.IRBG.EQ.3)) THEN
              CALL RNGSSF (0,RWRK,LRWK,DBLE(YCEN-RNGE/2.),
     +                                 DBLE(XCEN-RNGE/2.),
     +                                 DBLE(YCEN+RNGE/2.),
     +                                 DBLE(XCEN+RNGE/2.))
            END IF
            IF ((IPBG.NE.1.AND.(IRBG.EQ.2.OR.IRBG.EQ.3)).OR.
     +          (IPBG.EQ.1.AND.IRBG.NE.0)) THEN
              CALL RNGSOL (0,RWRK,LRWK,DBLE(YCEN-RNGE/2.),
     +                                 DBLE(XCEN-RNGE/2.),
     +                                 DBLE(YCEN+RNGE/2.),
     +                                 DBLE(XCEN+RNGE/2.))
            END IF
            IF (ABS(XCEN-166.93039).LT.RNGE/2..AND.
     +          ABS(YCEN+   .51997).LT.RNGE/2..AND.
     +          RNGE.LT.5.) THEN
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (6)
              CALL GSFACI (6)
              CALL PLCHHQ (166.92839,CFUY(CUFY(-.51997)+.0024/RNGE),
     +                       'Remember that the RANGS/GSHHS background',
     +                                                 .0008/RNGE,0.,0.)
              CALL PLCHHQ (166.92839,CFUY(CUFY(-.51997)+.0008/RNGE),
     +              'database shows Nauru about .011 degrees above and',
     +                                                 .0008/RNGE,0.,0.)
              CALL PLCHHQ (166.92839,CFUY(CUFY(-.51997)-.0008/RNGE),
     +               '.004 degrees to the left of its proper position,',
     +                                                 .0008/RNGE,0.,0.)
              CALL PLCHHQ (166.92839,CFUY(CUFY(-.51997)-.0024/RNGE),
     +                     'as verified by a couple of recent atlases.',
     +                                                 .0008/RNGE,0.,0.)
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (1)
              CALL GSFACI (1)
            END IF
          END IF
        END IF
C
C Mark the center point with a dark gray circle.
C
  342   CALL PLOTIF (0.,0.,2)
        CALL GSPLCI (8)
        CALL GSFACI (8)
        CALL MARKIT (XCEN,YCEN,.02,1)
        CALL PLOTIF (0.,0.,2)
        CALL GSPLCI (1)
        CALL GSFACI (1)
C
C Draw a grid of lines, using different colors for different densities.
C
        IF (IGRD.NE.0) THEN
C
          DO 107 IGRC=1,6
C
            GRID=RGRD(IGRC)
C
            CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (IGCI(IGRC))
C
            FDGX=(INT(180./GRID)+1)*GRID
            XMIN=MAX(-180.,MIN(+180.,XCEN-RNGE/2.))
            IMIN=INT((XMIN+FDGX)/GRID)
            IF (REAL(IMIN)*GRID-FDGX.LT.XMIN-RNGE/1000.) IMIN=IMIN+1
            XMAX=MAX(-180.,MIN(+180.,XCEN+RNGE/2.))
            IMAX=INT((XMAX+FDGX)/GRID)+1
            IF (REAL(IMAX)*GRID-FDGX.GT.XMAX+RNGE/1000.) IMAX=IMAX-1
C
            FDGY=(INT( 90./GRID)+1)*GRID
            YMIN=MAX( -90.,MIN( +90.,YCEN-RNGE/2.))
            JMIN=INT((YMIN+FDGY)/GRID)
            IF (REAL(JMIN)*GRID-FDGY.LT.YMIN-RNGE/1000.) JMIN=JMIN+1
            YMAX=MAX( -90.,MIN( +90.,YCEN+RNGE/2.))
            JMAX=INT((YMAX+FDGY)/GRID)+1
            IF (REAL(JMAX)*GRID-FDGY.GT.YMAX+RNGE/1000.) JMAX=JMAX-1
C
            IF (RNGE/GRID.LT.100.) THEN
C
              YGMN=MAX( -90.,MIN( +90.,YCEN-RNGE/2.))
              YGMX=MAX( -90.,MIN( +90.,YCEN+RNGE/2.))
C
              DO 105 I=IMIN,IMAX
                XVAL=REAL(I)*GRID-FDGX
                CALL LINE (XVAL,YGMN,XVAL,YGMX)
                IF (IGRC.GT.1.AND.RNGE/GRID.LT.10.) THEN
                  WRITE (CTM3,'(F8.3)') XVAL
                  ITMP=MPIFNB(CTM3)
                  IF (CTM3(ITMP:ITMP).EQ.'-') THEN
                    CTM3(ITMP:ITMP)=' '
                    CTM3(8:8)='W'
                  ELSE
                    CTM3(8:8)='E'
                  END IF
                  CALL PLCHMQ (XVAL,CFUY(CUFY(YGMN)-.012),
     +                         CTM3(MPIFNB(CTM3):MPILNB(CTM3)),
     +                                              .012,0.,0.)
                  CALL PLCHMQ (XVAL,CFUY(CUFY(YGMX)+.012),
     +                         CTM3(MPIFNB(CTM3):MPILNB(CTM3)),
     +                                              .012,0.,0.)
                END IF
  105         CONTINUE
C
              XGMN=MAX(-180.,MIN(+180.,XCEN-RNGE/2.))
              XGMX=MAX(-180.,MIN(+180.,XCEN+RNGE/2.))
C
              DO 106 J=JMIN,JMAX
                YVAL=REAL(J)*GRID-FDGY
                CALL LINE (XGMN,YVAL,XGMX,YVAL)
                IF (IGRC.GT.1.AND.RNGE/GRID.LT.10.) THEN
                  WRITE (CTM3,'(F8.3)') YVAL
                  ITMP=MPIFNB(CTM3)
                  IF (CTM3(ITMP:ITMP).EQ.'-') THEN
                    CTM3(ITMP:ITMP)=' '
                    CTM3(8:8)='S'
                  ELSE
                    CTM3(8:8)='N'
                  END IF
                  CALL PLCHMQ (CFUX(CUFX(XGMN)-.006),YVAL,
     +                         CTM3(MPIFNB(CTM3):MPILNB(CTM3)),
     +                                              .012,0.,+1.)
                  CALL PLCHMQ (CFUX(CUFX(XGMX)+.006),YVAL,
     +                         CTM3(MPIFNB(CTM3):MPILNB(CTM3)),
     +                                              .012,0.,-1.)
                END IF
  106         CONTINUE
C
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (1)
C
            END IF

  107     CONTINUE
C
        END IF
C
C If an edge is picked, put arrows on the first point, the last point,
C and the point picked to show in what direction the edge is defined.
C
        IF (IOEP.NE.0.AND.IOLP(IOEP)-IOFP(IOEP).NE.0) THEN
          IF (XCRD(IOFP(IOEP)).GE.XCEN-RNGE/2..AND.
     +        XCRD(IOFP(IOEP)).LE.XCEN+RNGE/2..AND.
     +        YCRD(IOFP(IOEP)).GE.YCEN-RNGE/2..AND.
     +        YCRD(IOFP(IOEP)).LE.YCEN+RNGE/2.) THEN
            CALL PLOTIF (0.,0.,2)
            CALL GSLWSC (2.)
            CALL GSPLCI (5)
            XINC=XCRD(IOFP(IOEP)+1)-XCRD(IOFP(IOEP))
            YINC=YCRD(IOFP(IOEP)+1)-YCRD(IOFP(IOEP))
            CALL DARROW (XCRD(IOFP(IOEP)),
     +                   YCRD(IOFP(IOEP)),XINC,YINC,-.024)
            CALL PLOTIF (0.,0.,2)
            CALL GSLWSC (1.)
            CALL GSPLCI (1)
          END IF
          IF (XCRD(IOLP(IOEP)).GE.XCEN-RNGE/2..AND.
     +        XCRD(IOLP(IOEP)).LE.XCEN+RNGE/2..AND.
     +        YCRD(IOLP(IOEP)).GE.YCEN-RNGE/2..AND.
     +        YCRD(IOLP(IOEP)).LE.YCEN+RNGE/2.) THEN
            CALL PLOTIF (0.,0.,2)
            CALL GSLWSC (2.)
            CALL GSPLCI (5)
            XINC=XCRD(IOLP(IOEP))-XCRD(IOLP(IOEP)-1)
            YINC=YCRD(IOLP(IOEP))-YCRD(IOLP(IOEP)-1)
            CALL DARROW (XCRD(IOLP(IOEP)),
     +                   YCRD(IOLP(IOEP)),XINC,YINC,.024)
            CALL PLOTIF (0.,0.,2)
            CALL GSLWSC (1.)
            CALL GSPLCI (1)
          END IF
          IF (XCRD(IOFP(IOEP)+IOPP).GE.XCEN-RNGE/2..AND.
     +        XCRD(IOFP(IOEP)+IOPP).LE.XCEN+RNGE/2..AND.
     +        YCRD(IOFP(IOEP)+IOPP).GE.YCEN-RNGE/2..AND.
     +        YCRD(IOFP(IOEP)+IOPP).LE.YCEN+RNGE/2.) THEN
            CALL PLOTIF (0.,0.,2)
            CALL GSLWSC (2.)
            CALL GSPLCI (7)
            IF (IOPP.NE.IOLP(IOEP)-IOFP(IOEP)) THEN
              XINC=XCRD(IOFP(IOEP)+IOPP+1)-XCRD(IOFP(IOEP)+IOPP)
              YINC=YCRD(IOFP(IOEP)+IOPP+1)-YCRD(IOFP(IOEP)+IOPP)
              CALL DARROW (XCRD(IOFP(IOEP)+IOPP),
     +                     YCRD(IOFP(IOEP)+IOPP),XINC,YINC,.024)
            ELSE
              XINC=XCRD(IOFP(IOEP)+IOPP)-XCRD(IOFP(IOEP)+IOPP-1)
              YINC=YCRD(IOFP(IOEP)+IOPP)-YCRD(IOFP(IOEP)+IOPP-1)
              CALL DARROW (XCRD(IOFP(IOEP)+IOPP),
     +                     YCRD(IOFP(IOEP)+IOPP),XINC,YINC,.024)
            END IF
            CALL PLOTIF (0.,0.,2)
            CALL GSLWSC (1.)
            CALL GSPLCI (1)
          END IF
        END IF
C
C Draw boundary lines from the selected dataset.
C
        DO 109 IOES=1,NOES
          CALL PLOTIF (0.,0.,2)
          IF (IOES.EQ.IOEP) THEN
            CALL GSPLCI (6)
          ELSE IF (ISPOAI(IAIL(IOES),IOAP).NE.0.OR.
     +             ISPOAI(IAIR(IOES),IOAP).NE.0) THEN
            CALL GSPLCI (16)
          ELSE IF (ISPOAI(IAIL(IOES),IOAS).NE.0.OR.
     +             ISPOAI(IAIR(IOES),IOAS).NE.0.OR.
     +             ISPOAN(IAIL(IOES),NOAS).NE.0.OR.
     +             ISPOAN(IAIR(IOES),NOAS).NE.0) THEN
            CALL GSPLCI (18)
          ELSE IF (ICKL.NE.0.AND.ILTY(IOES).LE.ICKL) THEN
            CALL GSPLCI (20)
          ELSE
            CALL GSPLCI (ICOL(1+MAX(0,MIN(5,ILTY(IOES)))))
          END IF
          IF      (IOES.EQ.IOEP.OR.
     +             ISPOAI(IAIL(IOES),IOAP).NE.0.OR.
     +             ISPOAI(IAIR(IOES),IOAP).NE.0.OR.
     +             ISPOAI(IAIL(IOES),IOAS).NE.0.OR.
     +             ISPOAI(IAIR(IOES),IOAS).NE.0.OR.
     +             ISPOAN(IAIL(IOES),NOAS).NE.0.OR.
     +             ISPOAN(IAIR(IOES),NOAS).NE.0.OR.
     +             (ICKL.NE.0.AND.ILTY(IOES).LE.ICKL)) THEN
            CALL GSLWSC (2.)
          ELSE
            CALL GSLWSC (THCK(1+MAX(0,MIN(5,ILTY(IOES)))))
          END IF
          CALL FRSTPT (XCRD(IOFP(IOES)),YCRD(IOFP(IOES)))
          DO 108 I=1,IOLP(IOES)-IOFP(IOES)
            CALL VECTOR (XCRD(IOFP(IOES)+I),YCRD(IOFP(IOES)+I))
  108     CONTINUE
  109   CONTINUE
C
        CALL PLOTIF (0.,0.,2)
        CALL GSLWSC (1.)
        CALL GSPLCI (1)
C
C If the current value of the range parameter is small enough, mark
C each of the points with a little filled circle and with its latitude
C and longitude.  Also, mark each edge segment that's long enough with
C left and right area identifiers (this is actually done first).
C
        IF (RNGE.LE.RLBL) THEN
C
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (8)
          CALL GSFACI (8)
C
          DO 111 IOES=1,NOES
            DO 110 I=1,IOLP(IOES)-IOFP(IOES)
              IF (XCRD(IOFP(IOES)+I-1).GE.XCEN-RNGE/2..AND.
     +            XCRD(IOFP(IOES)+I-1).LE.XCEN+RNGE/2..AND.
     +            YCRD(IOFP(IOES)+I-1).GE.YCEN-RNGE/2..AND.
     +            YCRD(IOFP(IOES)+I-1).LE.YCEN+RNGE/2..AND.
     +            XCRD(IOFP(IOES)+I  ).GE.XCEN-RNGE/2..AND.
     +            XCRD(IOFP(IOES)+I  ).LE.XCEN+RNGE/2..AND.
     +            YCRD(IOFP(IOES)+I  ).GE.YCEN-RNGE/2..AND.
     +            YCRD(IOFP(IOES)+I  ).LE.YCEN+RNGE/2.) THEN
                XCPA=CUFX(XCRD(IOFP(IOES)+I-1))
                YCPA=CUFY(YCRD(IOFP(IOES)+I-1))
                XCPB=CUFX(XCRD(IOFP(IOES)+I  ))
                YCPB=CUFY(YCRD(IOFP(IOES)+I  ))
                XCPM=.5*(XCPA+XCPB)
                YCPM=.5*(YCPA+YCPB)
                SLEN=SQRT((XCPB-XCPA)**2+(YCPB-YCPA)**2)
                COSA=(XCPB-XCPA)/SLEN
                SINA=(YCPB-YCPA)/SLEN
                ANGD=RTOD*ARRAT2(SINA,COSA)
                IF (SLEN.GT..04) THEN
                  IOAL=IOAREA(ILVL,IAIL(IOES))
                  IOAR=IOAREA(ILVL,IAIR(IOES))
                  WRITE (CTM1,'(I1)') ILTY(IOES)
                  CALL PLCHMQ (CFUX(XCPM         ),CFUY(YCPM         ),
     +                                 CTM1(MPIFNB(CTM1):MPILNB(CTM1)),
     +                                                     .01,ANGD,0.)
                  WRITE (CTM1,'(I4)') IOAL
                  CALL PLCHMQ (CFUX(XCPM-.02*SINA),CFUY(YCPM+.02*COSA),
     +                                 CTM1(MPIFNB(CTM1):MPILNB(CTM1)),
     +                                                     .01,ANGD,0.)
                  WRITE (CTM1,'(I4)') IOAR
                  CALL PLCHMQ (CFUX(XCPM+.02*SINA),CFUY(YCPM-.02*COSA),
     +                                 CTM1(MPIFNB(CTM1):MPILNB(CTM1)),
     +                                                     .01,ANGD,0.)
                END IF
              END IF
  110       CONTINUE
  111     CONTINUE
C
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (1)
          CALL GSFACI (1)
C
          DO 113 IOES=1,NOES
            IF (IOES.EQ.IOEP) THEN
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (6)
              CALL GSFACI (6)
            END IF
            XCLP=1000.
            YCLP=1000.
            DO 112 I=0,IOLP(IOES)-IOFP(IOES)
              IF (XCRD(IOFP(IOES)+I).GE.XCEN-RNGE/2..AND.
     +            XCRD(IOFP(IOES)+I).LE.XCEN+RNGE/2..AND.
     +            YCRD(IOFP(IOES)+I).GE.YCEN-RNGE/2..AND.
     +            YCRD(IOFP(IOES)+I).LE.YCEN+RNGE/2.) THEN
                IF (SQRT((XCRD(IOFP(IOES)+I)-XCLP)**2+
     +                   (YCRD(IOFP(IOES)+I)-YCLP)**2).GT.RNGE/20.) THEN
                  CALL MARKIT (XCRD(IOFP(IOES)+I),
     +                         YCRD(IOFP(IOES)+I),.012,0)
                  XCLP=XCRD(IOFP(IOES)+I)
                  YCLP=YCRD(IOFP(IOES)+I)
                END IF
              END IF
  112       CONTINUE
            IF (IOES.EQ.IOEP) THEN
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (1)
              CALL GSFACI (1)
            END IF
  113     CONTINUE
C
          IF (IOEP.NE.0) THEN
            IF (XCRD(IOFP(IOEP)+IOPP).GE.XCEN-RNGE/2..AND.
     +          XCRD(IOFP(IOEP)+IOPP).LE.XCEN+RNGE/2..AND.
     +          YCRD(IOFP(IOEP)+IOPP).GE.YCEN-RNGE/2..AND.
     +          YCRD(IOFP(IOEP)+IOPP).LE.YCEN+RNGE/2.) THEN
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (7)
              CALL GSFACI (7)
              CALL MARKIT (XCRD(IOFP(IOEP)+IOPP),
     +                     YCRD(IOFP(IOEP)+IOPP),.012,0)
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (1)
              CALL GSFACI (1)
            END IF
          END IF
C
        END IF
C
C Write a message on the frame including the current dataset name and
C display level.
C
        CALL PLOTIF (0.,0.,2)
        CALL GSPLCI (9)
        CALL GSFACI (9)
C
        CTM2='Editing '//FNMI(1:MPILNB(FNMI))//' at level '//
     +                                              CHAR(ICH0+ILVL)//'.'
        CALL PLCHHQ (CFUX(.50),CFUY(.984),
     +               CTM2(1:MPILNB(CTM2)),.016,0.,0.)
C
        CALL PLOTIF (0.,0.,2)
        CALL GSPLCI (1)
        CALL GSFACI (1)
C
C If an edge is picked, write information for the areas on either side
C of it near the top of the frame and its type in the middle.
C
        IF (IOEP.NE.0) THEN
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (6)
          CALL GSFACI (6)
          IOAL=IOAREA(ILVL,IAIL(IOEP))
          IOAR=IOAREA(ILVL,IAIR(IOEP))
          WRITE (CTM1,'(I8)') IOPP+1
          WRITE (CTM3,'(I8)') IOLP(IOEP)-IOFP(IOEP)+1
          CTM2='Picked edge is of type '//
     +         CHAR(ICHAR('0')+MAX(0,MIN(9,ILTY(IOEP))))//
     +         '; picked point is number '//
     +         CTM1(MPIFNB(CTM1):MPILNB(CTM1))//
     +         ' of '//
     +         CTM3(MPIFNB(CTM3):MPILNB(CTM3))//
     +         '.'
          CALL PLCHHQ (CFUX(.50),CFUY(.956),
     +                 CTM2(MPIFNB(CTM2):MPILNB(CTM2)),.012,0.,0.)
          CALL PCSETC ('FC','|')
          WRITE (CTM2,'(''Left: '',I4,2I2,I5,1X,A)') IOAL,IATY(IOAL),
     +           ISCI(IOAL),IPAR(IOAL),NAME(IOAL)(1:MPILNB(NAME(IOAL)))
          CALL PLCHHQ (CFUX(.05),CFUY(.932),
     +                 CTM2(MPIFNB(CTM2):MPILNB(CTM2)),.012,0.,-1.)
          WRITE (CTM2,'(''Right: '',I4,2I2,I5,1X,A)')IOAR,IATY(IOAR),
     +           ISCI(IOAR),IPAR(IOAR),NAME(IOAR)(1:MPILNB(NAME(IOAR)))
          CALL PLCHHQ (CFUX(.95),CFUY(.932),
     +                 CTM2(MPIFNB(CTM2):MPILNB(CTM2)),.012,0.,+1.)
          CALL PCSETC ('FC',':')
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (1)
          CALL GSFACI (1)
        END IF
C
C If an area is picked, write information for it near the bottom of the
C frame.
C
        IF (IOAP.NE.0) THEN
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (17)
          CALL GSFACI (17)
          CALL PCSETC ('FC','|')
          WRITE (CTM2,'(''Picked area: '',I4,2I2,I5,1X,A)')
     +           IOAP,IATY(IOAP),ISCI(IOAP),IPAR(IOAP),
     +           NAME(IOAP)(1:MPILNB(NAME(IOAP)))
          CALL PLCHHQ (CFUX(.5),CFUY(.064),
     +                 CTM2(MPIFNB(CTM2):MPILNB(CTM2)),.014,0.,0.)
          CALL PCSETC ('FC',':')
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (1)
          CALL GSFACI (1)
        END IF
C
C If an area is being "shown", write its name near the bottom of the
C frame.
C
        IF (IOAS.GT.0) THEN
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (19)
          CALL GSFACI (19)
          CALL PCSETC ('FC','|')
          WRITE (CTM2,'(''"Shown" area: '',I4,2I2,I5,1X,A)') IOAS,
     +           IATY(IOAS),ISCI(IOAS),IPAR(IOAS),
     +           NAME(IOAS)(1:MPILNB(NAME(IOAS)))
          CALL PLCHHQ (CFUX(.5),CFUY(.034),
     +                 CTM2(MPIFNB(CTM2):MPILNB(CTM2)),.016,0.,0.)
          CALL PCSETC ('FC',':')
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (1)
          CALL GSFACI (1)
        ELSE IF (NOAS.NE.' ') THEN
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (19)
          CALL GSFACI (19)
          CALL PCSETC ('FC','|')
          WRITE (CTM2,'(''"Shown" area: '',A)') NOAS(1:MPILNB(NOAS))
          CALL PLCHHQ (CFUX(.5),CFUY(.034),
     +                 CTM2(MPIFNB(CTM2):MPILNB(CTM2)),.016,0.,0.)
          CALL PCSETC ('FC',':')
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (1)
          CALL GSFACI (1)
        END IF
C
C Mark the points, if any, near which errors have been detected.
C
        IF (NMRK.NE.0) THEN
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (9)
          DO 149 I=1,NMRK
            IF (XMRK(I).GE.XCEN-RNGE/2..AND.
     +          XMRK(I).LE.XCEN+RNGE/2..AND.
     +          YMRK(I).GE.YCEN-RNGE/2..AND.
     +          YMRK(I).LE.YCEN+RNGE/2.) THEN
              CALL CIRCLE (XMRK(I),YMRK(I),.015)
            END IF
  149     CONTINUE
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (1)
        END IF
C
C Flush the SPPS pen-move buffers.
C
        CALL PLOTIF (0.,0.,2)
C
C Update the X workstation.
C
        CALL GUWK (1,0)
C
C If NCGM output is turned on, update and deactivate the NCGM
C workstation, turn NCGM output off, and bump the frame count.
C
        IF (NCGM.NE.0) THEN
          CALL GUWK (2,0)
          CALL GDAWK (2)
          NCGM=0
          NCGN=NCGN+1
          PRINT * , Q
          PRINT * , 'Number of frames written to NCGM: ',NCGN,Q
        END IF
C
C Let the user enter a command.
C
  114   PRINT * , Q
        PRINT * , '--------------------------------------------------',Q
        PRINT * , Q
        PRINT * , 'Enter command (H for Help, Q for Quit):',Q
C
        CALL GTCHAR (COMD)
C
C "A" command ("change info for picked Area").
C
        IF (COMD.EQ.'A'.OR.COMD.EQ.'a') THEN
          PRINT * , Q
          PRINT * , 'Change area information (type, color, parent, and n
     +ame).',Q
          IF (IOAP.NE.0) THEN
            PRINT * , Q
            PRINT * , '  Information for picked area:',Q
            PRINT '(2X,2I2,I5,1X,A)' , IATY(IOAP),ISCI(IOAP),IPAR(IOAP),
     +                                 NAME(IOAP)(1:MPILNB(NAME(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area type (between 1 and 5):',Q
            CALL DERDIN (IATY(IOAP),IATY(IOAP))
            IATY(IOAP)=MAX(1,MIN(5,IATY(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area color (between 1 and 8):',Q
            CALL DERDIN (ISCI(IOAP),ISCI(IOAP))
            ISCI(IOAP)=MAX(1,MIN(8,ISCI(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area parent index (negative for first u
     +nused value):',Q
            CALL DERDIN (ITMP,IPAR(IOAP))
            IF (ITMP.LT.0.OR.ITMP.GT.MNAI) THEN
              PRINT * , Q
              PRINT * , 'Identifier outside legal range.  Seek first unu
     +sed value.',Q
              DO 205 I=1,MNAI
                IF (IATY(I).EQ.0) THEN
                  PRINT * , Q
                  PRINT * , 'First unused value found: ',I,Q
                  ITMP=I
                  IATY(I)=IATY(IOAP)
                  ISCI(I)=ISCI(IOAP)
                  IPAR(I)=IPAR(IOAP)
                  NAME(I)='New Parent Area'
                  GO TO 190
                END IF
  205         CONTINUE
              PRINT * , Q
              PRINT * , 'No unused values.  Use parent index of zero.',Q
              ITMP=0
            END IF
  190       IPAR(IOAP)=ITMP
            PRINT * , Q
            PRINT * , 'Enter new area name (up to 64 characters):',Q
            CALL GTCHRS (NSCR,64)
            IF (NSCR.NE.' ') NAME(IOAP)=NSCR
            GO TO 104
          ELSE
            PRINT * , Q
            PRINT * ,  'Can''t change area information - no area has bee
     +n picked.'
          END IF
C
C "B" command ("change Background display").
C
        ELSE IF (COMD.EQ.'B'.OR.COMD.EQ.'b') THEN
          PRINT * , Q
          PRINT * , 'Change background display.',Q
          PRINT * , Q
          PRINT * , 'Enter one of the following:',Q
          PRINT * , Q
          PRINT * , '  P => PNG background display.',Q
          PRINT * , '  Q => (Quit) PNG background display.',Q
          PRINT * , '  R => RANGS background display.',Q
          PRINT * , '  T => Toggle current background display.',Q
          PRINT * , Q
          PRINT * , 'Anything else has the same effect as "T".',Q
          CALL GTCHAR (COMD)
          IF      (COMD.EQ.'P'.OR.COMD.EQ.'p') THEN
            PRINT * , Q
            PRINT * , '  Change PNG background display.',Q
            IF (IPBG.LT.0) THEN
              PRINT * , Q
              PRINT * , 'Read PNG background file? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.NE.'Y'.AND.COMD.NE.'y') GO TO 114
              PRINT * , Q
              PRINT * , 'Enter the name of the file:',Q
              CALL GTCHRS (FNMP,63)
              FNMP(64:64)=' '
              IF (FNMP.EQ.' ') GO TO 114
              ILNB=MPILNB(FNMP)
              FNMP(ILNB+1:ILNB+1)=CHAR(0)
              PRINT * , Q
              PRINT * , 'Set weights for gray-scale conversion? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                PRINT * , Q
                PRINT * , 'Red weight (from 0 to 100,000):',Q
                CALL DERDIN (IRED,IRED)
                IRED=MAX(0,MIN(100000,IRED))
                PRINT * , Q
                PRINT * , 'Green weight (from 0 to',100000-IRED,'):',Q
                CALL DERDIN (IGRN,IGRN)
                IGRN=MAX(0,MIN(100000-IRED,IGRN))
                PRINT * , Q
                PRINT * , 'Blue weight: ',100000-IRED-IGRN,Q
              ELSE
                IRED=21268
                IGRN=71514
              END IF
              CALL GSVINI (FNMP,MGSV,NGSV,IRED,IGRN,Q,IERR)
              IF (IERR.NE.0) THEN
                PRINT * , 'Error reading PNG background file: ',IERR,Q
                GO TO 114
              END IF
              IPBG=1
              ILNB=ILNB+1
              FNMP(ILNB:ILNB)='i'
              OPEN (15,FILE=FNMP(1:ILNB),STATUS='OLD',
     +                                         FORM='FORMATTED',ERR=333)
              READ (15,'(20X,A64)',ERR=327,END=327) FNMQ
              READ (15,'(20X,A2,3E14.6)',ERR=327,END=327)
     +                                               PTYP,PLAT,PLON,ROTA
              IF (PTYP.EQ.'SV') THEN
                READ (15,'(22X,3E14.6)',ERR=327,END=327)  SALT,SAN1,SAN2
              END IF
              READ (15,'(20X,A2,4E14.6)',ERR=327,END=327)
     +                              LTYP,PLM1(1),PLM2(1),PLM3(1),PLM4(1)
              IF (LTYP.NE.'PO') THEN
                PLM1(2)=0.
                PLM2(2)=0.
                PLM3(2)=0.
                PLM4(2)=0.
              ELSE
                READ (15,'(22X,4E14.6)',ERR=327,END=327)
     +                                   PLM1(2),PLM2(2),PLM3(2),PLM4(2)
              END IF
              IF      (LTYP.EQ.'CO') THEN
                PLC1=PLM1(1)
                PLC2=PLM2(1)
                PLC3=PLM3(1)
                PLC4=PLM4(1)
              ELSE IF (LTYP.EQ.'PO') THEN
                PL11=PLM1(1)
                PL12=PLM2(1)
                PL13=PLM3(1)
                PL14=PLM4(1)
                PL21=PLM1(2)
                PL22=PLM2(2)
                PL23=PLM3(2)
                PL24=PLM4(2)
              ELSE IF (LTYP.EQ.'AN') THEN
                PLA1=PLM1(1)
                PLA2=PLM2(1)
                PLA3=PLM3(1)
                PLA4=PLM4(1)
              ELSE IF (LTYP.EQ.'LI') THEN
                PLL1=PLM1(1)
                PLL2=PLM2(1)
                PLL3=PLM3(1)
                PLL4=PLM4(1)
              ELSE IF (LTYP.EQ.'GR') THEN
                PLG1=PLM1(1)
                PLG2=PLM2(1)
                PLG3=PLM3(1)
                PLG4=PLM4(1)
              END IF
              READ (15,'(18X,I4)',ERR=327,END=327) IDUM
              DO 328 I=1,MPRP
                READ (15,'(18X,I4,4E14.6)',ERR=327,END=327)
     +                                 J,PXLT(J),PXLN(J),PXLX(J),PXLY(J)
                IPXL(J)=1
                NPRP=NPRP+1
  328         CONTINUE
  327         CLOSE (15)
            ELSE IF (IPBG.GT.0) THEN
              PRINT * , Q
              PRINT * , 'Change PNG reference points? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                IF (NPRP.NE.0) THEN
                  PRINT * , Q
                  PRINT * , 'Current PNG reference points (latitude,',Q
                  PRINT * , 'longitude, PNG column, and PNG row):',Q
                  PRINT * , Q
                  DO 322 I=1,MPRP
                    IF (IPXL(I).NE.0) THEN
                      PRINT * , 'Point',I,': ',PXLT(I),PXLN(I)
     +                                        ,PXLX(I),PXLY(I),Q
                    END IF
  322             CONTINUE
                END IF
                PRINT * , Q
                PRINT * , 'Create a new PNG reference point? (y/n)',Q
                CALL GTCHAR (COMD)
                IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                  IF (XCEN.LT.-180..OR.XCEN.GT.+180..OR.
     +                YCEN.LT. -90..OR.YCEN.GT. +90.) THEN
                    PRINT * , Q
                    PRINT * , 'Can''t do it - center is not on globe.',Q
                    GO TO 114
                  END IF
                  PRINT * , Q
                  PRINT * , 'Specify which point you want to define.',Q
                  PRINT * , 'Enter index from 1 to',MPRP,' (or just',Q
                  PRINT * , 'hit return to skip it):',Q
                  CALL DERDIN (IPTD,0)
                  IF (IPTD.LT.1.OR.IPTD.GT.MPRP) THEN
                    PRINT * , Q
                    PRINT * , 'Specified index is out of range, so',Q
                    PRINT * , 'no new PNG reference point created.',Q
                    GO TO 114
                  END IF
                  PRINT * , Q
                  PRINT * , 'Enter reference latitude (-90 to 90):',Q
                  CALL DERDRN (RLAT,0.)
                  RLAT=MAX(-90.,MIN(90.,RLAT))
                  PRINT * , Q
                  PRINT * , 'Enter reference longitude (-180 to 180):',Q
                  CALL DERDRN (RLON,0.)
                  RLON=MAX(-180.,MIN(180.,RLON))
                  CALL MAPROJ (PTYP,PLAT,PLON,ROTA)
                  IF (PTYP.EQ.'SV') THEN
                    CALL MPSETR ('SA',SALT)
                    CALL MPSETR ('S1',SAN1)
                    CALL MPSETR ('S2',SAN2)
                  END IF
                  CALL MAPSET (LTYP,PLM1,PLM2,PLM3,PLM4)
                  CALL MAPINT
                  IF (NERRO(ITMP).NE.0) THEN
                    PRINT * , Q
                    CALL EPRIN
                    PRINT * , Q
                    CALL ERROF
                    GO TO 114
                  END IF
                  CALL GETSET (XVPL,XVPR,YVPB,YVPT,
     +                         XWDL,XWDR,YWDB,YWDT,LNLG)
                  CALL MAPTRA (YCEN,XCEN,XCOP,YCOP)
                  IF (XCOP.NE.OORV) THEN
                    IF (IPXL(IPTD).EQ.0) NPRP=NPRP+1
                    IPXL(IPTD)=1
                    PXLT(IPTD)=RLAT
                    PXLN(IPTD)=RLON
                    XOTP=((XCOP-XWDL)/(XWDR-XWDL))*REAL(MGSV)
                    YOTP=((YCOP-YWDB)/(YWDT-YWDB))*REAL(NGSV)
                    IF (NINP.EQ.0) THEN
                      PXLX(IPTD)=XOTP
                      PXLY(IPTD)=YOTP
                    ELSE IF (NINP.GT.0) THEN
                      CALL IDBVIP (1,NINP,XINP,YINP,ZIXO,
     +                             1,XOTP,YOTP,ZOXO,IWRK,FWRK)
                      CALL IDBVIP (3,NINP,XINP,YINP,ZIYO,
     +                             1,XOTP,YOTP,ZOYO,IWRK,FWRK)
                      PXLX(IPTD)=XOTP+ZOXO
                      PXLY(IPTD)=YOTP+ZOYO
                    ELSE
                      XTMP=((XCOP-XWDL)/(XWDR-XWDL))*REAL(MCFM)
                      YTMP=((YCOP-YWDB)/(YWDT-YWDB))*REAL(NCFM)
                      ITMP=MAX(1,MIN(MCFM,1+INT(XTMP)))
                      JTMP=MAX(1,MIN(NCFM,1+INT(YTMP)))
                      XTMP=XTMP-REAL(ITMP)
                      YTMP=YTMP-REAL(JTMP)
                      ZOXO=(1.-YTMP)*((1.-XTMP)*ZCFX(ITMP  ,JTMP  )+
     +                                    XTMP *ZCFX(ITMP+1,JTMP  ))
     +                       + YTMP *((1.-XTMP)*ZCFX(ITMP  ,JTMP+1)+
     +                                    XTMP *ZCFX(ITMP+1,JTMP+1))
                      ZOYO=(1.-YTMP)*((1.-XTMP)*ZCFY(ITMP  ,JTMP  )+
     +                                    XTMP *ZCFY(ITMP+1,JTMP  ))
     +                       + YTMP *((1.-XTMP)*ZCFY(ITMP  ,JTMP+1)+
     +                                    XTMP *ZCFY(ITMP+1,JTMP+1))
                      PXLX(IPTD)=XOTP+ZOXO
                      PXLY(IPTD)=YOTP+ZOYO
                    END IF
                  ELSE
                    PRINT * , Q
                    PRINT * , 'Center point is not on projected PNG;',Q
                    PRINT * , 'no new PNG reference point created.',Q
                    GO TO 114
                  END IF
                  PRINT * , Q
                  PRINT * , 'Modified PNG reference points (latitude,',Q
                  PRINT * , 'longitude, PNG column, and PNG row):',Q
                  PRINT * , Q
                  DO 323 I=1,MPRP
                    IF (IPXL(I).NE.0) THEN
                      PRINT * , 'Point',I,': ',PXLT(I),PXLN(I) 
     +                                        ,PXLX(I),PXLY(I),Q
                    END IF
  323             CONTINUE
                  CALL SET    (.1,.9,.1,.9,XCEN-RNGE/2.,XCEN+RNGE/2.,
     +                                     YCEN-RNGE/2.,YCEN+RNGE/2.,1)
                ELSE IF (NPRP.NE.0) THEN
                  PRINT * , Q
                  PRINT * , 'Delete a PNG reference point? (y/n)',Q
                  CALL GTCHAR (COMD)
                  IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                    PRINT * , Q
                    PRINT * , 'Specify point you want to delete.',Q
                    PRINT * , 'Enter index from 1 to',MPRP,Q
                    PRINT * , '(or just hit return to skip it):',Q
                    CALL DERDIN (IPTD,0)
                    IF (IPTD.LT.1.OR.IPTD.GT.MPRP) THEN
                      PRINT * , Q
                      PRINT * , 'Specified index is out of range, so',Q
                      PRINT * , 'no PNG reference point was deleted.',Q
                    END IF
                    IF (IPXL(IPTD).EQ.0) THEN
                      PRINT * , Q
                      PRINT * , 'No PNG reference point was ever',Q
                      PRINT * , 'defined for that index value.',Q
                    ELSE
                      IPXL(IPTD)=0
                      PXLT(IPTD)=0.
                      PXLN(IPTD)=0.
                      PXLX(IPTD)=0.
                      PXLY(IPTD)=0.
                    END IF
                  END IF
                END IF
              END IF
            END IF
  333       PRINT * , Q
            PRINT * , 'Change projection parameters for PNG? (y/n)',Q
            CALL GTCHAR (COMD)
            IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
              PTYS=PTYP
  314         PRINT * , Q
              PRINT * , 'Current projection type: ',PTYP,Q
              PRINT * , Q
              PRINT * , 'Enter new value (LC, ST, OR,',Q
              PRINT * , 'LE, GN, AE, CE, ME, MO, RO, or SV):',Q
              CALL GTCHRS (CTM2,LEN(CTM2))
              PTYP=CTM2(1:2)
              IF (PTYP.NE.'LC'.AND.PTYP.NE.'ST'.AND.PTYP.NE.'OR'.AND.
     +            PTYP.NE.'LE'.AND.PTYP.NE.'GN'.AND.PTYP.NE.'AE'.AND.
     +            PTYP.NE.'CE'.AND.PTYP.NE.'ME'.AND.PTYP.NE.'MO'.AND.
     +            PTYP.NE.'RO'.AND.PTYP.NE.'SV'.AND.PTYP.NE.' ') THEN
                PRINT * , Q
                PRINT * , '  Illegal response.  Try again.',Q
                GO TO 314
              END IF
              IF (PTYP.EQ.'  ') PTYP=PTYS
              IF (PTYP.EQ.'LC') THEN
                PRINT * , Q
                PRINT * , ' Current values:',Q
                PRINT * , '   Latitude, 1st standard parallel: ',PLAT,Q
                PRINT * , '   Longitude, central meridian:     ',PLON,Q
                PRINT * , '   Latitude, 2nd standard parallel: ',ROTA,Q
                PRINT * , Q
                PRINT * , 'Enter latitude of 1st standard parallel:',Q
                CALL DERDRN (PLAT,PLAT)
                PRINT * , Q
                PRINT * , 'Enter longitude of central meridian:',Q
                CALL DERDRN (PLON,PLON)
                PRINT * , Q
                PRINT * , 'Enter latitude of 2nd standard parallel:',Q
                CALL DERDRN (ROTA,ROTA)
              ELSE
                PRINT * , Q
                PRINT * , ' Current values:',Q
                PRINT * , '   Pole latitude:  ',PLAT,Q
                PRINT * , '   Pole longitude: ',PLON,Q
                PRINT * , '   Rotation angle: ',ROTA,Q
                PRINT * , Q
                PRINT * , 'Enter pole latitude:',Q
                CALL DERDRN (PLAT,PLAT)
                PRINT * , Q
                PRINT * , 'Enter pole longitude:',Q
                CALL DERDRN (PLON,PLON)
                PRINT * , Q
                PRINT * , 'Enter rotation angle:',Q
                CALL DERDRN (ROTA,ROTA)
                IF (PTYP.EQ.'SV') THEN
                  PRINT * , Q
                  PRINT * , ' Current values:',Q
                  PRINT * , '   Satellite altitude: ',SALT,Q
                  PRINT * , '   Satellite angle 1:  ',SAN1,Q
                  PRINT * , '   Satellite angle 2:  ',SAN2,Q
                  PRINT * , Q
                  PRINT * , 'Enter satellite altitude (> 1):',Q
                  CALL DERDRN (SALT,SALT)
                  PRINT * , Q
                  PRINT * , 'Enter satellite angle 1:',Q
                  CALL DERDRN (SAN1,SAN1)
                  PRINT * , Q
                  PRINT * , 'Enter satellite angle 2:',Q
                  CALL DERDRN (SAN2,SAN2)
                END IF
              END IF
            END IF
            PRINT * , Q
            PRINT * , 'Change limit parameters for PNG? (y/n)',Q
            CALL GTCHAR (COMD)
            IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
              IF (NPRP.GE.2) THEN
                PRINT * , Q
                PRINT * , 'The following reference points (latitude',Q
                PRINT * , 'longitude, PNG column, and PNG row) are',Q
                PRINT * , 'defined:',Q
                PRINT * , Q
                DO 324 I=1,MPRP
                  IF (IPXL(I).NE.0) THEN
                    WRITE (*,'(''Point '',I2,'': '',4F12.5,A)')
     +                               I,PXLT(I),PXLN(I),PXLX(I),PXLY(I),Q
                  END IF
  324           CONTINUE
                PRINT * , Q
                PRINT * , 'Use reference points to set limits? (y/n)',Q
                CALL GTCHAR (COMD)
                IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                  PRINT * , Q
                  PRINT * , 'Specify which two points to use.',Q
                  PRINT * , Q
                  PRINT * , 'Enter index (1 to',MPRP,', inclusive):',Q
                  CALL DERDIN (ITM1,0)
                  PRINT * , Q
                  PRINT * , 'Enter index (1 to',MPRP,', inclusive):',Q
                  CALL DERDIN (ITM2,0)
                  IF (ITM1.LT.1.OR.ITM1.GT.MPRP.OR.
     +                ITM2.LT.1.OR.ITM2.GT.MPRP.OR.
     +                ITM1.EQ.ITM2) THEN
                    PRINT * , 'Indices wrong - no limits computed.',Q
                  ELSE IF (IPXL(ITM1).EQ.0.OR.IPXL(ITM2).EQ.0) THEN
                    PRINT * , 'Indices wrong - no limits computed.',Q
                  ELSE
                    CALL MAPROJ (PTYP,PLAT,PLON,ROTA)
                    IF (PTYP.EQ.'SV') THEN
                      CALL MPSETR ('SA',SALT)
                      CALL MPSETR ('S1',SAN1)
                      CALL MPSETR ('S2',SAN2)
                    END IF
                    CALL MAPSET ('MA',ZROS,ZROS,ZROS,ZROS)
                    CALL MAPINT
                    IF (NERRO(ITMP).NE.0) THEN
                      PRINT * , Q
                      CALL EPRIN
                      PRINT * , Q
                      CALL ERROF
                      GO TO 343
                    END IF
                    CALL MAPTRN (PXLT(ITM1),PXLN(ITM1),XPX1,YPX1)
                    CALL MAPTRN (PXLT(ITM2),PXLN(ITM2),XPX2,YPX2)
                    IF (ABS(PXLX(ITM1)-PXLX(ITM2)).GT.1..AND.
     +                  ABS(PXLY(ITM1)-PXLY(ITM2)).GT.1..AND.
     +                  XPX1.NE.OORV.AND.XPX2.NE.OORV) THEN
                      LTYP='LI'
                      XTMP=(XPX2-XPX1)/(PXLX(ITM2)-PXLX(ITM1))
                      YTMP=(YPX2-YPX1)/(PXLY(ITM2)-PXLY(ITM1))
                      PRINT * , Q
                      PRINT * , 'In the projection plane:',Q
                      PRINT * , '  Pixel width:  ',ABS(XTMP),Q
                      PRINT * , '  Pixel height: ',ABS(YTMP),Q
                      PLL1=XPX1-PXLX(ITM1)*XTMP
                      PLL2=XPX2+(REAL(MGSV)-PXLX(ITM2))*XTMP
                      PLL3=YPX1-PXLY(ITM1)*YTMP
                      PLL4=YPX2+(REAL(NGSV)-PXLY(ITM2))*YTMP
                      PLM1(1)=PLL1
                      PLM1(2)=0.
                      PLM2(1)=PLL2
                      PLM2(2)=0.
                      PLM3(1)=PLL3
                      PLM3(2)=0.
                      PLM4(1)=PLL4
                      PLM4(2)=0.
                      PRINT * , Q
                      PRINT * , 'Procedure successful.',Q
                    ELSE
                      PRINT * , Q
                      PRINT * , 'Procedure failed.',Q
                    END IF
  343               CALL SET (.1,.9,.1,.9,XCEN-RNGE/2.,XCEN+RNGE/2.,
     +                                    YCEN-RNGE/2.,YCEN+RNGE/2.,1)
                    GO TO 339
                  END IF
                END IF
              END IF
              LTYS=LTYP
  315         PRINT * , Q
              PRINT * , 'Current map-limits type: ',LTYP,Q
              PRINT * , Q
              PRINT * , 'Enter new value (MA, CO, PO, AN, LI, or GR):',Q
              CALL GTCHRS (CTM2,LEN(CTM2))
              LTYP=CTM2(1:2)
              IF (LTYP.NE.'MA'.AND.LTYP.NE.'CO'.AND.LTYP.NE.'PO'.AND.
     +            LTYP.NE.'AN'.AND.LTYP.NE.'LI'.AND.LTYP.NE.'GR'.AND.
     +            LTYP.NE.'  ') THEN
                PRINT * , Q
                PRINT * , '  Illegal response.  Try again.',Q
                GO TO 315
              END IF
              IF (LTYP.EQ.'  ') LTYP=LTYS
              IF (LTYP.EQ.'MA') THEN
                PLM1(1)=0.
                PLM1(2)=0.
                PLM2(1)=0.
                PLM2(2)=0.
                PLM3(1)=0.
                PLM3(2)=0.
                PLM4(1)=0.
                PLM4(2)=0.
              ELSE IF (LTYP.EQ.'CO') THEN
                PRINT * , Q
                PRINT * , ' Current values:',Q
                PRINT * , '   Latitude of 1st corner point:  ',PLC1,Q
                PRINT * , '   Longitude of 1st corner point: ',PLC2,Q
                PRINT * , '   Latitude of 2nd corner point:  ',PLC3,Q
                PRINT * , '   Longitude of 2nd corner point: ',PLC4,Q
                PRINT * , Q
                PRINT * , 'Enter latitude of 1st corner point:',Q
                CALL DERDRN (PLC1,PLC1)
                PRINT * , Q
                PRINT * , 'Enter longitude of 1st corner point:',Q
                CALL DERDRN (PLC2,PLC2)
                PRINT * , Q
                PRINT * , 'Enter latitude of 2nd corner point:',Q
                CALL DERDRN (PLC3,PLC3)
                PRINT * , Q
                PRINT * , 'Enter longitude of 2nd corner point:',Q
                CALL DERDRN (PLC4,PLC4)
                PLM1(1)=PLC1
                PLM1(2)=0.
                PLM2(1)=PLC2
                PLM2(2)=0.
                PLM3(1)=PLC3
                PLM3(2)=0.
                PLM4(1)=PLC4
                PLM4(2)=0.
              ELSE IF (LTYP.EQ.'PO') THEN
                PRINT * , Q
                PRINT * , ' Current values:',Q
                PRINT * , '   Latitude of 1st edge point:  ',PL11,Q
                PRINT * , '   Longitude of 1st edge point: ',PL21,Q
                PRINT * , '   Latitude of 2nd edge point:  ',PL12,Q
                PRINT * , '   Longitude of 2nd edge point: ',PL22,Q
                PRINT * , '   Latitude of 3rd edge point:  ',PL13,Q
                PRINT * , '   Longitude of 3rd edge point: ',PL23,Q
                PRINT * , '   Latitude of 4th edge point:  ',PL14,Q
                PRINT * , '   Longitude of 4th edge point: ',PL24,Q
                PRINT * , Q
                PRINT * , 'Enter latitude of 1st edge point:',Q
                CALL DERDRN (PL11,PL11)
                PRINT * , Q
                PRINT * , 'Enter longitude of 1st edge point:',Q
                CALL DERDRN (PL21,PL21)
                PRINT * , Q
                PRINT * , 'Enter latitude of 2nd edge point:',Q
                CALL DERDRN (PL12,PL12)
                PRINT * , Q
                PRINT * , 'Enter longitude of 2nd edge point:',Q
                CALL DERDRN (PL22,PL22)
                PRINT * , Q
                PRINT * , 'Enter latitude of 3rd edge point:',Q
                CALL DERDRN (PL13,PL13)
                PRINT * , Q
                PRINT * , 'Enter longitude of 3rd edge point:',Q
                CALL DERDRN (PL23,PL23)
                PRINT * , Q
                PRINT * , 'Enter latitude of 4th edge point:',Q
                CALL DERDRN (PL14,PL14)
                PRINT * , Q
                PRINT * , 'Enter longitude of 4th edge point:',Q
                CALL DERDRN (PL24,PL24)
                PLM1(1)=PL11
                PLM1(2)=PL21
                PLM2(1)=PL12
                PLM2(2)=PL22
                PLM3(1)=PL13
                PLM3(2)=PL23
                PLM4(1)=PL14
                PLM4(2)=PL24
              ELSE IF (LTYP.EQ.'AN') THEN
                PRINT * , Q
                PRINT * , ' Current values:',Q
                PRINT * , '   Angular distance to the left:   ',PLA1,Q
                PRINT * , '   Angular distance to the right:  ',PLA2,Q
                PRINT * , '   Angular distance to the bottom: ',PLA3,Q
                PRINT * , '   Angular distance to the top:    ',PLA4,Q
                PRINT * , Q
                PRINT * , 'Enter angular distance to the left:',Q
                CALL DERDRN (PLA1,PLA1)
                PRINT * , Q
                PRINT * , 'Enter angular distance to the right:',Q
                CALL DERDRN (PLA2,PLA2)
                PRINT * , Q
                PRINT * , 'Enter angular distance to the bottom:',Q
                CALL DERDRN (PLA3,PLA3)
                PRINT * , Q
                PRINT * , 'Enter angular distance to the top:',Q
                CALL DERDRN (PLA4,PLA4)
                PLM1(1)=PLA1
                PLM1(2)=0.
                PLM2(1)=PLA2
                PLM2(2)=0.
                PLM3(1)=PLA3
                PLM3(2)=0.
                PLM4(1)=PLA4
                PLM4(2)=0.
              ELSE IF (LTYP.EQ.'LI') THEN
                PRINT * , Q
                PRINT * , ' Current values:',Q
                PRINT * , '   Limit value at the left edge:   ',PLL1,Q
                PRINT * , '   Limit value at the right edge:  ',PLL2,Q
                PRINT * , '   Limit value at the bottom edge: ',PLL3,Q
                PRINT * , '   Limit value at the top edge:    ',PLL4,Q
                PRINT * , Q
                PRINT * , 'Enter limit value at the left edge:',Q
                CALL DERDRN (PLL1,PLL1)
                PRINT * , Q
                PRINT * , 'Enter limit value at the right edge:',Q
                CALL DERDRN (PLL2,PLL2)
                PRINT * , Q
                PRINT * , 'Enter limit value at the bottom edge:',Q
                CALL DERDRN (PLL3,PLL3)
                PRINT * , Q
                PRINT * , 'Enter limit value at the top edge:',Q
                CALL DERDRN (PLL4,PLL4)
                PLM1(1)=PLL1
                PLM1(2)=0.
                PLM2(1)=PLL2
                PLM2(2)=0.
                PLM3(1)=PLL3
                PLM3(2)=0.
                PLM4(1)=PLL4
                PLM4(2)=0.
              ELSE IF (LTYP.EQ.'GR') THEN
                PRINT * , Q
                PRINT * , ' Current values:',Q
                PRINT * , '   Minimum latitude:  ',PLG1,Q
                PRINT * , '   Minimum longitude: ',PLG2,Q
                PRINT * , '   Maximum latitude:  ',PLG3,Q
                PRINT * , '   Maximum longitude: ',PLG4,Q
                PRINT * , Q
                PRINT * , 'Enter minimum latitude:',Q
                CALL DERDRN (PLG1,PLG1)
                PRINT * , Q
                PRINT * , 'Enter minimum longitude:',Q
                CALL DERDRN (PLG2,PLG2)
                PRINT * , Q
                PRINT * , 'Enter maximum latitude:',Q
                CALL DERDRN (PLG3,PLG3)
                PRINT * , Q
                PRINT * , 'Enter maximum longitude:',Q
                CALL DERDRN (PLG4,PLG4)
                PLM1(1)=PLG1
                PLM1(2)=0.
                PLM2(1)=PLG2
                PLM2(2)=0.
                PLM3(1)=PLG3
                PLM3(2)=0.
                PLM4(1)=PLG4
                PLM4(2)=0.
              END IF
            END IF
  339       IF (NPRP.GE.4) THEN
              PRINT * , Q
              PRINT * , 'Use reference points to form a correction',Q
              PRINT * , 'function? (n/y)',Q
              CALL GTCHAR (COMD)
              IF (COMD.NE.'N'.AND.COMD.NE.'n') THEN
                CALL MAPROJ (PTYP,PLAT,PLON,ROTA)
                IF (PTYP.EQ.'SV') THEN
                  CALL MPSETR ('SA',SALT)
                  CALL MPSETR ('S1',SAN1)
                  CALL MPSETR ('S2',SAN2)
                END IF
                CALL MAPSET (LTYP,PLM1,PLM2,PLM3,PLM4)
                CALL MAPINT
                IF (NERRO(ITMP).NE.0) THEN
                  PRINT * , Q
                  CALL EPRIN
                  PRINT * , Q
                  CALL ERROF
                  GO TO 344
                END IF
                CALL GETSET (XVPL,XVPR,YVPB,YVPT,
     +                       XWDL,XWDR,YWDB,YWDT,LNLG)
                NINP=0
                DO 326 I=1,MPRP
                  IF (IPXL(I).NE.0) THEN
                    NINP=NINP+1
                    CALL MAPTRN (PXLT(I),PXLN(I),XCOP,YCOP)
                    XINP(NINP)=((XCOP-XWDL)/(XWDR-XWDL))*REAL(MGSV)
                    YINP(NINP)=((YCOP-YWDB)/(YWDT-YWDB))*REAL(NGSV)
                    ZIXO(NINP)=PXLX(I)-XINP(NINP)
                    ZIYO(NINP)=PXLY(I)-YINP(NINP)
                  END IF
  326           CONTINUE
                PRINT * , 'Use an approximate correction function',Q
                PRINT * , '(a bit less accurate, but faster)? (n/y)',Q
                CALL GTCHAR (COMD)
                IF (COMD.NE.'N'.AND.COMD.NE.'n') THEN
                  DO 331 I=1,MCFA
                    XCFA(I)=(REAL(I-1)/REAL(MCFM))*REAL(MGSV)
  331             CONTINUE
                  DO 332 J=1,NCFA
                    YCFA(J)=(REAL(J-1)/REAL(NCFM))*REAL(NGSV)
  332             CONTINUE
                  CALL IDSFFT (1,NINP,XINP,YINP,ZIXO,
     +                         MCFA,NCFA,MCFA,XCFA,YCFA,ZCFX,IWRK,FWRK)
                  CALL IDSFFT (3,NINP,XINP,YINP,ZIYO,
     +                         MCFA,NCFA,MCFA,XCFA,YCFA,ZCFY,IWRK,FWRK)
                  NINP=-NINP
                END IF
  344           CALL SET    (.1,.9,.1,.9,XCEN-RNGE/2.,XCEN+RNGE/2.,
     +                                   YCEN-RNGE/2.,YCEN+RNGE/2.,1)
              ELSE
                NINP=0
              END IF
            END IF
            PRINT * , Q
            PRINT * , 'Change cell array size parameters? (y/n)',Q
            CALL GTCHAR (COMD)
            IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
  319         PRINT * , Q
              PRINT * , ' Current values:',Q
              PRINT * , '   Window width/height (# cells): ',ICAD,Q
              PRINT * , '   Horizontal indices used:       ',ICI1,ICI2,Q
              PRINT * , '   Vertical indices used:         ',ICJ1,ICJ2,Q
              PRINT * , Q
              PRINT * , 'Enter window width/height (# of cells):',Q
              CALL DERDIN (ICAD,ICAD)
              IF (ICAD.LT.1) THEN
                PRINT * , Q
                PRINT * , 'Value must be greater than 1.',Q
                PRINT * , 'Try again.',Q
                GO TO 319
              END IF
  320         PRINT * , Q
              PRINT * , 'Enter index of first cell horizontally:',Q
              CALL DERDIN (ICI1,ICI1)
              PRINT * , Q
              PRINT * , 'Enter index of last cell horizontally:',Q
              CALL DERDIN (ICI2,ICI2)
              IF (ICI1.LT.1.OR.ICI1.GT.ICI2.OR.ICI2.GT.ICAD) THEN
                PRINT * , Q
                PRINT * , 'Values entered improperly.  Try again.',Q
                GO TO 320
              END IF
  321         PRINT * , Q
              PRINT * , 'Enter index of first cell vertically:',Q
              CALL DERDIN (ICJ1,ICJ1)
              PRINT * , Q
              PRINT * , 'Enter index of last cell vertically:',Q
              CALL DERDIN (ICJ2,ICJ2)
              IF (ICJ1.LT.1.OR.ICJ1.GT.ICJ2.OR.ICJ2.GT.ICAD) THEN
                PRINT * , Q
                PRINT * , 'Values entered improperly.  Try again.',Q
                GO TO 321
              END IF
              IF ((ICI2-ICI1+1)*(ICJ2-ICJ1+1).GT.NCRA) THEN
                PRINT * , Q
                PRINT * , 'Too many cells in cell array.',Q
                PRINT * , 'Maximum allowable value: ',NCRA,Q
                PRINT * , 'Try again.',Q
                GO TO 319
              END IF
            END IF
          ELSE IF (COMD.EQ.'Q'.OR.COMD.EQ.'q') THEN
            IF (IPBG.GE.0) THEN
              PRINT * , Q
              PRINT * , 'Write updated PNG information file? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                OPEN (15,FILE=FNMP(1:ILNB),STATUS='UNKNOWN',
     +                                         FORM='FORMATTED',ERR=329)
                REWIND 15
                WRITE (15,'(''File name:          '',A)') FNMP(1:ILNB-1)
                WRITE (15,'(''Projection:         '',A2,3E14.6)')
     +                                               PTYP,PLAT,PLON,ROTA
                IF (PTYP.EQ.'SV') THEN
                  WRITE (15,'(''Satellite values:     '',3E14.6)')
     +                                                    SALT,SAN1,SAN2
                END IF
                WRITE (15,'(''Limits:             '',A2,4E14.6)')
     +                              LTYP,PLM1(1),PLM2(1),PLM3(1),PLM4(1)
                IF (LTYP.EQ.'PO')
     +          WRITE (15,'(22X,4E14.6)')PLM1(2),PLM2(2),PLM3(2),PLM4(2)
                WRITE (15,'(''Reference points: '',I4)') NPRP
                DO 330 I=1,MPRP
                  IF (IPXL(I).NE.0)
     +              WRITE (15,'(18X,I4,4E14.6)')
     +                                 I,PXLT(I),PXLN(I),PXLX(I),PXLY(I)
  330           CONTINUE
              END IF
              CLOSE (15)
  329         PRINT * , 'Close PNG background file? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                CALL GSVEND
                IPBG=-1
                NPRP=0
                DO 325 I=1,MPRP
                  IPXL(I)=0
                  PXLT(I)=0.
                  PXLN(I)=0.
                  PXLX(I)=0.
                  PXLY(I)=0.
  325           CONTINUE
                NINP=0
                GO TO 104
              END IF
            END IF
            GO TO 114
          ELSE IF (COMD.EQ.'R'.OR.COMD.EQ.'r') THEN
            PRINT * , Q
            PRINT * , '  Change RANGS background display.',Q
            PRINT * , Q
            PRINT * , 'Enter one of the following:',Q
            PRINT * , Q
            PRINT * , '  0 => Turn RANGS fill and outlines off.',Q
            PRINT * , '  1 => Turn RANGS fill on.',Q
            PRINT * , '  2 => Turn RANGS outlines on.',Q
            PRINT * , '  3 => Turn RANGS fill and outlines on.',Q
            PRINT * , Q
            PRINT * , 'Anything else toggles background fill.',Q
            CALL DERDIN (IRBG,1-MIN(IRBG,1))
            IRBG=MAX(0,MIN(3,IRBG))
            IF (IRBG.EQ.0) THEN
              PRINT * , '  RANGS fill and outlines turned off.',Q
            ELSE IF (IRBG.EQ.1) THEN
              PRINT * , '  RANGS fill turned on.',Q
            ELSE IF (IRBG.EQ.2) THEN
              PRINT * , '  RANGS outlines turned on.',Q
            ELSE IF (IRBG.EQ.3) THEN
              PRINT * , '  RANGS fill and outlines turned on.',Q
            END IF
          ELSE
            IF (IPBG.GE.0) THEN
              IPBG=1-IPBG
              IF (IPBG.EQ.0) THEN
                PRINT * , '  PNG background turned off.',Q
              ELSE
                PRINT * , '  PNG background turned on.',Q
              END IF
            ELSE
              IRBG=1-MIN(IRBG,1)
              IF (IRBG.EQ.0) THEN
                PRINT * , '  RANGS fill and outlines turned off.',Q
              ELSE IF (IRBG.EQ.1) THEN
                PRINT * , '  RANGS fill turned on.',Q
              END IF
            END IF
          END IF
          GO TO 104
C
C "C" command ("Check for errors and mark them").
C
        ELSE IF (COMD.EQ.'C'.OR.COMD.EQ.'c') THEN
          PRINT * , Q
          PRINT * , 'Checking for errors.',Q
C         PRINT * , Q
C         PRINT * , 'Doing an initial check for indexing errors:',Q
C         NOIE=0
C         DO 264 IOES=2,NOES
C           IF (IOFP(IOES).NE.IOLP(IOES-1)+1) NOIE=NOIE+1
C 264     CONTINUE
C         PRINT * , 'Number of indexing errors found:',NOIE,Q
          PRINT * , Q
          PRINT * , 'Enter one of the following:',Q
          PRINT * , Q
          PRINT * , '  A => look for Angles in a given range',Q
          PRINT * , '  C => Clear the error list',Q
          PRINT * , '  E => examine edge Endpoints',Q
          PRINT * , '  F => look for color Fill problems',Q
          PRINT * , '  I => find unused area Identifiers',Q
          PRINT * , '  L => examine edge segment Lengths',Q
          PRINT * , '  M => Merge edges wherever possible',Q
          PRINT * , '  O => look for edges Overlapping themselves',Q
          PRINT * , '  T => look for edge Types outside [1,6]',Q
          PRINT * , Q
          CALL GTCHAR (COMD)
          IF      (COMD.EQ.'A'.OR.COMD.EQ.'a') THEN
            PRINT * , Q
            PRINT * , 'Checking for angles less than a stated minimum',Q
            PRINT * , 'desirable value but greater than or equal to a',Q
            PRINT * , 'minimum previously checked for.',Q
  177       PRINT * , Q
            PRINT * , 'Enter minimum desirable angle (in degrees):',Q
            CALL DERDRN (AMIN,0.)
            IF (AMIN.LE.0.) THEN
              PRINT * , Q
              PRINT * , 'Value must be greater than zero.',Q
              GO TO 177
            ELSE
              PRINT * , Q
              PRINT * , 'Enter minimum previously used (in degrees):',Q
              CALL DERDRN (AMPU,0.)
              IF (AMPU.LT.0.) AMPU=0.
              PRINT * , Q
              PRINT * , 'Looking for angles between',AMPU,' and ',AMIN,Q
              AMIN=DTOR*AMIN
              AMPU=DTOR*AMPU
              IMRK=0
              NMRK=0
              DO 179 IOES=1,NOES
                DO 178 I=IOFP(IOES)+1,IOLP(IOES)-1
                  A=MAX(SQRT((XCRD(I+1)-XCRD(I-1))**2+
     +                       (YCRD(I+1)-YCRD(I-1))**2),1.E-8)
                  B=MAX(SQRT((XCRD(I-1)-XCRD(I  ))**2+
     +                       (YCRD(I-1)-YCRD(I  ))**2),1.E-8)
                  C=MAX(SQRT((XCRD(I+1)-XCRD(I  ))**2+
     +                       (YCRD(I+1)-YCRD(I  ))**2),1.E-8)
                  ANGL=ABS(ACOS(.5*(B*B+C*C-A*A)/(B*C)))
                  IF (ANGL.LT.AMIN.AND.ANGL.GE.AMPU) THEN
                    IF (NMRK.LT.MMRK) THEN
                      NMRK=NMRK+1
                      XMRK(NMRK)=XCRD(I)
                      YMRK(NMRK)=YCRD(I)
                      GO TO 179
                    ELSE
                      GO TO 180
                    END IF
                  END IF
  178           CONTINUE
  179         CONTINUE
  180         PRINT * , Q
              PRINT * , 'Number of sharp angles found: ',NMRK,Q
            END IF
            GO TO 104
          ELSE IF (COMD.EQ.'C'.OR.COMD.EQ.'c') THEN
            IMRK=0
            NMRK=0
            PRINT * , Q
            PRINT * , 'Error list cleared.',Q
            GO TO 104
          ELSE IF (COMD.EQ.'E'.OR.COMD.EQ.'e') THEN
            PRINT * , Q
            PRINT * , 'Checking for errors at edge end points.',Q
            IMRK=0
            NMRK=0
            DO 159 I=1,NOES
              IF (IOFP(I).EQ.IOLP(I)) GO TO 157
              IF (IOAREA(ILVL,IAIL(I)).EQ.
     +            IOAREA(ILVL,IAIR(I))) GO TO 159
              NSEG=0
              XTMP=XCRD(IOFP(I)+1)-XCRD(IOFP(I))
              YTMP=YCRD(IOFP(I)+1)-YCRD(IOFP(I))
              IF (XTMP.EQ.0..AND.YTMP.EQ.0.) GO TO 152
              NSEG=NSEG+1
              DSEG(NSEG)=ARRAT2(YTMP,XTMP)
              ISIL(NSEG)=IOAREA(ILVL,IAIL(I))
              ISIR(NSEG)=IOAREA(ILVL,IAIR(I))
              DO 150 J=1,NOES
                IF (IOAREA(ILVL,IAIL(J)).EQ.
     +              IOAREA(ILVL,IAIR(J))) GO TO 150
                IF (MOD(ABS(XCRD(IOFP(I))-XCRD(IOFP(J))),360.).EQ.0.
     +              .AND.
     +              MOD(ABS(YCRD(IOFP(I))-YCRD(IOFP(J))),360.).EQ.0.
     +              .AND.
     +              I.NE.J) THEN
                  IF (NSEG.EQ.10) GO TO 152
                  XTMP=XCRD(IOFP(J)+1)-XCRD(IOFP(J))
                  YTMP=YCRD(IOFP(J)+1)-YCRD(IOFP(J))
                  IF (XTMP.EQ.0..AND.YTMP.EQ.0.) GO TO 152
                  NSEG=NSEG+1
                  DSEG(NSEG)=ARRAT2(YTMP,XTMP)
                  ISIL(NSEG)=IOAREA(ILVL,IAIL(J))
                  ISIR(NSEG)=IOAREA(ILVL,IAIR(J))
                END IF
                IF (MOD(ABS(XCRD(IOFP(I))-XCRD(IOLP(J))),360.).EQ.0.
     +              .AND.
     +              MOD(ABS(YCRD(IOFP(I))-YCRD(IOLP(J))),360.).EQ.0.
     +              ) THEN
                  IF (NSEG.EQ.10) GO TO 152
                  XTMP=XCRD(IOLP(J)-1)-XCRD(IOLP(J))
                  YTMP=YCRD(IOLP(J)-1)-YCRD(IOLP(J))
                  IF (XTMP.EQ.0..AND.YTMP.EQ.0.) GO TO 152
                  NSEG=NSEG+1
                  DSEG(NSEG)=ARRAT2(YTMP,XTMP)
                  ISIL(NSEG)=IOAREA(ILVL,IAIR(J))
                  ISIR(NSEG)=IOAREA(ILVL,IAIL(J))
                END IF
  150         CONTINUE
              IF (NSEG.LE.1) GO TO 152
              CALL SSORT1 (DSEG,NSEG,IPER)
              DO 151 K=1,NSEG
                KPL1=K+1
                IF (KPL1.GT.NSEG) KPL1=KPL1-NSEG
                IF (ISIL(IPER(K)).NE.ISIR(IPER(KPL1))) GO TO 152
                KMI1=K-1
                IF (KMI1.LT.1) KMI1=KMI1+NSEG
                IF (ISIR(IPER(K)).NE.ISIL(IPER(KMI1))) GO TO 152
  151         CONTINUE
              GO TO 154
  152         IF (NMRK.LT.MMRK) THEN
                DO 153 K=1,NMRK
                  IF (XCRD(IOFP(I)).EQ.XMRK(K).AND.
     +                YCRD(IOFP(I)).EQ.YMRK(K)) GO TO 154
  153           CONTINUE
                NMRK=NMRK+1
                XMRK(NMRK)=XCRD(IOFP(I))
                YMRK(NMRK)=YCRD(IOFP(I))
              END IF
  154         NSEG=0
              XTMP=XCRD(IOLP(I)-1)-XCRD(IOLP(I))
              YTMP=YCRD(IOLP(I)-1)-YCRD(IOLP(I))
              IF (XTMP.EQ.0..AND.YTMP.EQ.0.) GO TO 157
              NSEG=NSEG+1
              DSEG(NSEG)=ARRAT2(YTMP,XTMP)
              ISIL(NSEG)=IOAREA(ILVL,IAIR(I))
              ISIR(NSEG)=IOAREA(ILVL,IAIL(I))
              DO 155 J=1,NOES
                IF (IOAREA(ILVL,IAIL(J)).EQ.
     +              IOAREA(ILVL,IAIR(J))) GO TO 155
                IF (MOD(ABS(XCRD(IOLP(I))-XCRD(IOLP(J))),360.).EQ.0.
     +              .AND.
     +              MOD(ABS(YCRD(IOLP(I))-YCRD(IOLP(J))),360.).EQ.0.
     +              .AND.
     +              I.NE.J) THEN
                  IF (NSEG.EQ.10) GO TO 157
                  XTMP=XCRD(IOLP(J)-1)-XCRD(IOLP(J))
                  YTMP=YCRD(IOLP(J)-1)-YCRD(IOLP(J))
                  IF (XTMP.EQ.0..AND.YTMP.EQ.0.) GO TO 157
                  NSEG=NSEG+1
                  DSEG(NSEG)=ARRAT2(YTMP,XTMP)
                  ISIL(NSEG)=IOAREA(ILVL,IAIR(J))
                  ISIR(NSEG)=IOAREA(ILVL,IAIL(J))
                END IF
                IF (MOD(ABS(XCRD(IOLP(I))-XCRD(IOFP(J))),360.).EQ.0.
     +              .AND.
     +              MOD(ABS(YCRD(IOLP(I))-YCRD(IOFP(J))),360.).EQ.0.
     +              ) THEN
                  IF (NSEG.EQ.10) GO TO 157
                  XTMP=XCRD(IOFP(J)+1)-XCRD(IOFP(J))
                  YTMP=YCRD(IOFP(J)+1)-YCRD(IOFP(J))
                  IF (XTMP.EQ.0..AND.YTMP.EQ.0.) GO TO 157
                  NSEG=NSEG+1
                  DSEG(NSEG)=ARRAT2(YTMP,XTMP)
                  ISIL(NSEG)=IOAREA(ILVL,IAIL(J))
                  ISIR(NSEG)=IOAREA(ILVL,IAIR(J))
                END IF
  155         CONTINUE
              IF (NSEG.LE.1) GO TO 157
              CALL SSORT1 (DSEG,NSEG,IPER)
              DO 156 K=1,NSEG
                KPL1=K+1
                IF (KPL1.GT.NSEG) KPL1=KPL1-NSEG
                IF (ISIL(IPER(K)).NE.ISIR(IPER(KPL1))) GO TO 157
                KMI1=K-1
                IF (KMI1.LT.1) KMI1=KMI1+NSEG
                IF (ISIR(IPER(K)).NE.ISIL(IPER(KMI1))) GO TO 157
  156         CONTINUE
              GO TO 159
  157         IF (NMRK.LT.MMRK) THEN
                DO 158 K=1,NMRK
                  IF (XCRD(IOLP(I)).EQ.XMRK(K).AND.
     +                YCRD(IOLP(I)).EQ.YMRK(K)) GO TO 159
  158           CONTINUE
                NMRK=NMRK+1
                XMRK(NMRK)=XCRD(IOLP(I))
                YMRK(NMRK)=YCRD(IOLP(I))
              END IF
  159       CONTINUE
            PRINT * , Q
            PRINT * , 'Number of end-point errors found: ',NMRK,Q
            GO TO 104
          ELSE IF (COMD.EQ.'F'.OR.COMD.EQ.'f') THEN
            PRINT * , Q
            PRINT * , 'Checking for fill problems (anywhere the',Q
            PRINT * , 'same fill color is used on both sides of an',Q
            PRINT * , 'edge whose line type is greater than zero but',Q
            PRINT * , 'less than or equal to the current fill level',Q
            PRINT * , 'and which lies between two different areas).',Q
            IMRK=0
            NMRK=0
            DO 246 IOES=1,NOES
              IF (ILTY(IOES).GT.0.AND.
     +            ILTY(IOES).LE.ILVL.AND.
     +            IAIL(IOES).NE.IAIR(IOES).AND.
     +            ISCI(IOAREA(ILVL,IAIL(IOES))).EQ.
     +            ISCI(IOAREA(ILVL,IAIR(IOES)))) THEN
                IF (NMRK.LT.MMRK) THEN
                  NMRK=NMRK+1
                  XMRK(NMRK)=XCRD(IOFP(IOES))
                  YMRK(NMRK)=YCRD(IOFP(IOES))
                END IF
              END IF
  246       CONTINUE
            PRINT * , Q
            PRINT * , 'Number of fill problems found: ',NMRK,Q
            GO TO 104
          ELSE IF (COMD.EQ.'I'.OR.COMD.EQ.'i') THEN
            PRINT * , Q
            PRINT * , 'Checking for area identifier problems.',Q
            PRINT * , Q
            PRINT * , 'Looking for unreferenced area identifiers:',Q
            PRINT * , Q
            DO 162 I=1,MNAI
              IREF(I)=0
  162       CONTINUE
            DO 204 IOES=1,NOES
              IF (IREF(IAIL(IOES)).EQ.0) THEN
                ITMP=IAIL(IOES)
                NREP=0
  164           IREF(ITMP)=1
                ITMP=IPAR(ITMP)
                NREP=NREP+1
                IF (ITMP.NE.0.AND.NREP.LT.10) GO TO 164
              END IF
              IF (IREF(IAIR(IOES)).EQ.0) THEN
                ITMP=IAIR(IOES)
                NREP=0
  203           IREF(ITMP)=1
                ITMP=IPAR(ITMP)
                NREP=NREP+1
                IF (ITMP.NE.0.AND.NREP.LT.10) GO TO 203
              END IF
  204       CONTINUE
            IOLI=0
            NORI=0
            NOUI=0
            DO 163 I=1,MNAI
              IF (IATY(I).NE.0) THEN
                IOLI=I
                IF (IREF(I).NE.0) THEN
                  NORI=NORI+1
                ELSE
                  NOUI=NOUI+1
                  WRITE (*,'(I6,'' - unreferenced - '',A,A)')
     +                         I,NAME(I)(1:MPILNB(NAME(I))),Q
                END IF
              END IF
  163       CONTINUE
            NVIL=IOLI-NORI-NOUI
            PRINT * , Q
            PRINT * , '  Number of unreferenced identifiers: ',NOUI,Q
            PRINT * , '  Number of referenced identifiers:   ',NORI,Q
            PRINT * , '  Number of vacant slots in the list: ',NVIL,Q
            IF (NOUI.NE.0) THEN
              PRINT * , Q
              PRINT * , 'Eliminate unreferenced identifiers? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                PRINT * , Q
                PRINT * , 'Eliminating unreferenced identifiers:',Q
                PRINT * , Q
                IOLI=0
                NORI=0
                DO 165 I=1,MNAI
                  IF (IATY(I).NE.0) THEN
                    IF (IREF(I).NE.0) THEN
                      IOLI=I
                      NORI=NORI+1
                    ELSE
                      WRITE (*,'(I6,'' - eliminated - '',A,A)')
     +                           I,NAME(I)(1:MPILNB(NAME(I))),Q
                      IATY(I)=0
                      ISCI(I)=0
                      IPAR(I)=0
                      NAME(I)=' '
                    END IF
                  END IF
  165           CONTINUE
                NVIL=IOLI-NORI
                PRINT * , Q
                PRINT * , '  Number of referenced:   ',NORI,Q
                PRINT * , '  Number of vacant slots: ',NVIL,Q
              ELSE
                PRINT * , Q
                PRINT * , 'Unreferenced area identifiers left in.',Q
              END IF
            END IF
            IF (NVIL.NE.0) THEN
              PRINT * , Q
              PRINT * , 'Re-use vacant slots? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                PRINT * , Q
                PRINT * , 'Re-using vacant slots in identifier list:',Q
                PRINT * , Q
                I=1
  166           IF (I.LT.IOLI) THEN
                  IF (IATY(I).EQ.0) THEN
                    IATY(I)=IATY(IOLI)
                    ISCI(I)=ISCI(IOLI)
                    IPAR(I)=IPAR(IOLI)
                    NAME(I)=NAME(IOLI)
                    WRITE (*,'(I6,'' - reused - '',A,A)')
     +                     I,NAME(I)(1:MPILNB(NAME(I))),Q
                    DO 167 IOES=1,NOES
                      IF (IAIL(IOES).EQ.IOLI) IAIL(IOES)=I
                      IF (IAIR(IOES).EQ.IOLI) IAIR(IOES)=I
  167               CONTINUE
                    DO 202 J=1,IOLI-1
                      IF (IPAR(J).EQ.IOLI) IPAR(J)=I
  202               CONTINUE
                    IATY(IOLI)=0
                    ISCI(IOLI)=0
                    IPAR(IOLI)=0
                    NAME(IOLI)=' '
  168               IF (IATY(IOLI).EQ.0.AND.IOLI.GT.I) THEN
                      IOLI=IOLI-1
                      GO TO 168
                    END IF
                  END IF
                  I=I+1
                  GO TO 166
                END IF
                PRINT * , Q
                PRINT * , 'All vacant slots have been re-used.',Q
                IOAP=0
                IOAS=0
                GO TO 104
              ELSE
                PRINT * , Q
                PRINT * , 'Vacant slots not re-used, left in list.',Q
              END IF
            END IF
          ELSE IF (COMD.EQ.'L'.OR.COMD.EQ.'l') THEN
            PRINT * , Q
            PRINT * , 'Checking for edge segment length errors.',Q
  169       PRINT * , Q
            PRINT * , 'Enter minimum desirable segment length:',Q
            CALL DERDRN (SMIN,0.)
            IF (SMIN.LE.0.) THEN
              PRINT * , Q
              PRINT * , 'Value must be greater than zero.',Q
              GO TO 169
            ELSE
              SMSQ=SMIN*SMIN
              IMRK=0
              NMRK=0
              DO 171 IOES=1,NOES
                DO 170 I=IOFP(IOES),IOLP(IOES)-1
                  IF ((XCRD(I+1)-XCRD(I))**2+
     +                (YCRD(I+1)-YCRD(I))**2.LT.SMSQ) THEN
                    IF (NMRK.LT.MMRK) THEN
                      NMRK=NMRK+1
C                     PRINT * , 'Index of edge:',IOES,Q
C                     PRINT * , '  Index of first point:',IOFP(IOES),Q
C                     PRINT * , '  Index of last point: ',IOLP(IOES),Q
C                     PRINT * , '  Coordinates of point ',I,Q
C                     WRITE (*,'(''  '',2E20.12,A)') XCRD(I  ),YCRD(I  )
C    +                                                                ,Q
C                     PRINT * , '  Coordinates of point ',I+1,Q
C                     WRITE (*,'(''  '',2E20.12,A)') XCRD(I+1),YCRD(I+1)
C    +                                                                ,Q
                      XMRK(NMRK)=XCRD(I)
                      YMRK(NMRK)=YCRD(I)
                      GO TO 170
                    ELSE
                      GO TO 172
                    END IF
                  END IF
  170           CONTINUE
  171         CONTINUE
  172         PRINT * , Q
              PRINT * , 'Number of short edge segments found: ',NMRK,Q
            END IF
            GO TO 104
          ELSE IF (COMD.EQ.'M'.OR.COMD.EQ.'m') THEN
            PRINT * , Q
            PRINT * , 'Merging edge segments wherever possible.',Q
            IMRK=0
            NMRK=0
            IOES=1
  254       IF (IOES.LE.NOES) THEN
              JOES=IOES+1
  253         IF (JOES.LE.NOES) THEN
                ISWP=-1
                IF      (ILTY(IOES).EQ.ILTY(JOES)) THEN
                  IF      (IAIL(IOES).EQ.IAIL(JOES).AND.
     +                     IAIR(IOES).EQ.IAIR(JOES).AND.
     +                     XCRD(IOLP(IOES)).EQ.XCRD(IOFP(JOES)).AND.
     +                     YCRD(IOLP(IOES)).EQ.YCRD(IOFP(JOES))) THEN
                    ISWP=0
                    ITMP=IOLP(IOES)
                  ELSE IF (IAIL(IOES).EQ.IAIL(JOES).AND.
     +                     IAIR(IOES).EQ.IAIR(JOES).AND.
     +                     XCRD(IOFP(IOES)).EQ.XCRD(IOLP(JOES)).AND.
     +                     YCRD(IOFP(IOES)).EQ.YCRD(IOLP(JOES))) THEN
                    ISWP=3
                    ITMP=IOFP(IOES)
                  ELSE IF (IAIL(IOES).EQ.IAIR(JOES).AND.
     +                     IAIR(IOES).EQ.IAIL(JOES).AND.
     +                     XCRD(IOLP(IOES)).EQ.XCRD(IOLP(JOES)).AND.
     +                     YCRD(IOLP(IOES)).EQ.YCRD(IOLP(JOES))) THEN
                    ISWP=2
                    ITMP=IOLP(IOES)
                  ELSE IF (IAIL(IOES).EQ.IAIR(JOES).AND.
     +                     IAIR(IOES).EQ.IAIL(JOES).AND.
     +                     XCRD(IOFP(IOES)).EQ.XCRD(IOFP(JOES)).AND.
     +                     YCRD(IOFP(IOES)).EQ.YCRD(IOFP(JOES))) THEN
                    ISWP=1
                    ITMP=IOFP(IOES)
                  END IF
                END IF
                IF (ISWP.GE.0) THEN
                  DO 255 KOES=1,NOES
                    IF (KOES.NE.IOES.AND.KOES.NE.JOES.AND.
     +              ((XCRD(IOFP(KOES)).EQ.XCRD(ITMP).AND.
     +                YCRD(IOFP(KOES)).EQ.YCRD(ITMP)).OR.
     +               (XCRD(IOLP(KOES)).EQ.XCRD(ITMP).AND.
     +                YCRD(IOLP(KOES)).EQ.YCRD(ITMP)))) THEN
                      JOES=JOES+1
                      GO TO 253
                    END IF
  255             CONTINUE
                  NPTM=IOLP(JOES)-IOFP(JOES)
                  IF (NPTM.GT.MCRA) THEN
                    PRINT * , Q
                    PRINT * , 'Contiguous segments found that cannot',Q
                    PRINT * , 'be merged due to insufficient space in',Q
                    PRINT * , 'XCRA and YCRA; to get around this, you',Q
                    PRINT * , 'must recompile the editor with bigger',Q
                    PRINT * , 'value of parameter MCRA.',Q
                    JOES=JOES+1
                    GO TO 253
                  END IF
                  IF (NMRK.LT.MMRK) THEN
                    NMRK=NMRK+1
                    XMRK(NMRK)=XCRD(ITMP)
                    YMRK(NMRK)=YCRD(ITMP)
                  ELSE IF (IMRK.EQ.0) THEN
                    PRINT * , Q
                    PRINT * , 'Marked-point buffer overflow; some',Q
                    PRINT * , 'merge points will not be marked; to',Q
                    PRINT * , 'get around this, recompile the editor',Q
                    PRINT * , 'with bigger value of parameter MMRK.',Q
                    IMRK=1
                  END IF
                  IF (ISWP.EQ.1.OR.ISWP.EQ.3) THEN
                    DO 256 I=0,(IOLP(IOES)-IOFP(IOES)-1)/2
                      XTMP=XCRD(IOFP(IOES)+I)
                      YTMP=YCRD(IOFP(IOES)+I)
                      XCRD(IOFP(IOES)+I)=XCRD(IOLP(IOES)-I)
                      YCRD(IOFP(IOES)+I)=YCRD(IOLP(IOES)-I)
                      XCRD(IOLP(IOES)-I)=XTMP
                      YCRD(IOLP(IOES)-I)=YTMP
  256               CONTINUE
                    ITMP=IAIL(IOES)
                    IAIL(IOES)=IAIR(IOES)
                    IAIR(IOES)=ITMP
                  END IF
                  IF (ISWP.EQ.2.OR.ISWP.EQ.3) THEN
                    DO 257 I=0,(IOLP(JOES)-IOFP(JOES)-1)/2
                      XTMP=XCRD(IOFP(JOES)+I)
                      YTMP=YCRD(IOFP(JOES)+I)
                      XCRD(IOFP(JOES)+I)=XCRD(IOLP(JOES)-I)
                      YCRD(IOFP(JOES)+I)=YCRD(IOLP(JOES)-I)
                      XCRD(IOLP(JOES)-I)=XTMP
                      YCRD(IOLP(JOES)-I)=YTMP
  257               CONTINUE
                    ITMP=IAIL(JOES)
                    IAIL(JOES)=IAIR(JOES)
                    IAIR(JOES)=ITMP
                  END IF
                  DO 258 I=1,NPTM
                    XCRA(I)=XCRD(IOFP(JOES)+I)
                    YCRA(I)=YCRD(IOFP(JOES)+I)
  258             CONTINUE
                  DO 259 I=IOLP(JOES)-1,IOLP(IOES)+NPTM+1,-1
                    XCRD(I)=XCRD(I-NPTM)
                    YCRD(I)=YCRD(I-NPTM)
  259             CONTINUE
                  DO 260 I=1,NPTM
                    XCRD(IOLP(IOES)+I)=XCRA(I)
                    YCRD(IOLP(IOES)+I)=YCRA(I)
  260             CONTINUE
                  NOEP=NOEP-1
                  DO 261 I=IOLP(JOES),NOEP
                    XCRD(I)=XCRD(I+1)
                    YCRD(I)=YCRD(I+1)
  261             CONTINUE
                  IOLP(IOES)=IOLP(IOES)+NPTM
                  DO 262 I=IOES+1,JOES-1
                    IOFP(I)=IOFP(I)+NPTM
                    IOLP(I)=IOLP(I)+NPTM
  262             CONTINUE
                  NOES=NOES-1
                  DO 263 I=JOES,NOES
                    IOFP(I)=IOFP(I+1)-1
                    IOLP(I)=IOLP(I+1)-1
                    ILTY(I)=ILTY(I+1)
                    IAIL(I)=IAIL(I+1)
                    IAIR(I)=IAIR(I+1)
  263             CONTINUE
                  GO TO 254
                END IF
                JOES=JOES+1
                GO TO 253
              END IF
              IOES=IOES+1
              GO TO 254
            END IF
            PRINT * , Q
            PRINT * , 'Number of merged edge segments:  ',NMRK,Q
            PRINT * , Q
            PRINT * , 'Number of edges in the dataset:  ',NOES,Q
            PRINT * , 'Number of points in the dataset: ',NOEP,Q
            PRINT * , 'Number of areas in the dataset:  ',NOAD,Q
            IF (NMRK.NE.0) THEN
              IOEP=0
              IOPP=0
            END IF
            IMRK=0
            GO TO 104
          ELSE IF (COMD.EQ.'O'.OR.COMD.EQ.'o') THEN
            PRINT * , Q
            PRINT * , 'Checking for edges overlapping themselves.',Q
            IMRK=0
            NMRK=0
            DO 185 IOES=1,NOES
              DO 184 I=IOFP(IOES),IOLP(IOES)-3
                DO 183 J=I+2,IOLP(IOES)-1
                  IF (ILSINT(XCRD(I),YCRD(I),XCRD(I+1),YCRD(I+1),
     +                       XCRD(J),YCRD(J),XCRD(J+1),YCRD(J+1))
     +                                                     .NE.0) THEN
                    IF (NMRK.LT.MMRK) THEN
                      NMRK=NMRK+1
                      XMRK(NMRK)=XCRD(I)
                      YMRK(NMRK)=YCRD(I)
                      GO TO 183
                    ELSE
                      GO TO 186
                    END IF
                  END IF
  183           CONTINUE
  184         CONTINUE
  185       CONTINUE
  186       PRINT * , Q
            PRINT * , 'Number of edges overlapping themselves: ',NMRK,Q
            GO TO 104
          ELSE IF (COMD.EQ.'T'.OR.COMD.EQ.'t') THEN
            PRINT * , Q
            PRINT * , 'Checking for out-of-range edge types.',Q
            IMRK=0
            NMRK=0
            DO 181 IOES=1,NOES
              IF (ILTY(IOES).LT.1.OR.ILTY(IOES).GT.5) THEN
                IF (NMRK.LT.MMRK) THEN
                  NMRK=NMRK+1
                  XMRK(NMRK)=XCRD(IOFP(IOES))
                  YMRK(NMRK)=YCRD(IOFP(IOES))
                  GO TO 181
                ELSE
                  GO TO 182
                END IF
              END IF
  181       CONTINUE
  182       PRINT * , Q
            PRINT * , 'Number of bad edge types found: ',NMRK,Q
            GO TO 104
          END IF
C
C "D" command ("change Dataset viewed").
C
        ELSE IF (COMD.EQ.'D'.OR.COMD.EQ.'d') THEN
          FNMO=FNMI
          PRINT * , Q
          PRINT * , 'Change dataset being viewed.',Q
          PRINT * , Q
          PRINT * , 'Enter the name of the new dataset to be edited:',Q
          CALL GTCHRS (FNMI,64)
          PRINT * , Q
          PRINT * , 'Merge contiguous edge segments (Y/N)?',Q
          CALL GTCHAR (COMD)
          IF (COMD.NE.'Y'.AND.COMD.NE.'y') THEN
            IMRG=0
          ELSE
            IMRG=1
          END IF
          OPEN (11,FILE=FNMI(1:MPILNB(FNMI)),STATUS='OLD',
     +                                         FORM='FORMATTED',ERR=187)
          NOEP=0
          NOES=0
          DO 133 I=1,MNAI
            IATY(I)=0
            ISCI(I)=0
            IPAR(I)=0
            NAME(I)=' '
  133     CONTINUE
          GO TO 115
  187     PRINT * , Q
          PRINT * , 'Error opening dataset - no change.',Q
          FNMI=FNMO
          GO TO 114
  115     NOES=NOES+1
          IF (NOES.GT.MNES) THEN
            PRINT * , Q
            PRINT * , 'Too many edges - quitting.',Q
            CLOSE (11)
            CALL EDSTOP
          END IF
          READ (11,'(4I4,4F10.5)') NNMS,ILTY(NOES),IAIL(NOES),
     +                             IAIR(NOES),YMAX,YMIN,XMAX,XMIN
          NPTS=NNMS/2
          IF (NPTS.NE.0) THEN
            IF (NOEP+NPTS.GT.MNEP) THEN
              PRINT * , Q
              PRINT * , 'Too many edge points - quitting.',Q
              CLOSE (11)
              CALL EDSTOP
            END IF
            READ (11,'(8F10.5)') (YCRD(NOEP+I),XCRD(NOEP+I),I=1,NPTS)
            IOFP(NOES)=NOEP+1
            IOLP(NOES)=NOEP+NPTS
            IF (IMRG.NE.0) THEN
              IF (NOES.GT.1.AND.ILTY(NOES).NE.0) THEN
                IF (ILTY(NOES).EQ.ILTY(NOES-1).AND.
     +              IAIL(NOES).EQ.IAIL(NOES-1).AND.
     +              IAIR(NOES).EQ.IAIR(NOES-1).AND.
     +              XCRD(NOEP).EQ.XCRD(NOEP+1).AND.
     +              YCRD(NOEP).EQ.YCRD(NOEP+1)) THEN
                  DO 116 I=NOEP+2,NOEP+NPTS
                    XCRD(I-1)=XCRD(I)
                    YCRD(I-1)=YCRD(I)
  116             CONTINUE
                  NPTS=NPTS-1
                  NOES=NOES-1
                  IOLP(NOES)=NOEP+NPTS
                END IF
              END IF
            END IF
            NOEP=NOEP+NPTS
            GO TO 115
          ELSE
            NOES=NOES-1
          END IF
          NOAD=0
  131     READ (11,'(I4,2I2,I5,1X,A64)') INDX,ITM1,ITM2,ITM3,NSCR
          IF (INDX.NE.0) THEN
            IF (INDX.GE.1.AND.INDX.LE.MNAI) THEN
              NOAD=NOAD+1
              IATY(INDX)=ITM1
              ISCI(INDX)=ITM2
              IPAR(INDX)=ITM3
              NAME(INDX)=NSCR
              GO TO 131
            ELSE
              PRINT * , Q
              PRINT * , 'Area index outside allowed range - quitting.',Q
              CLOSE (11)
              CALL EDSTOP
            END IF
          END IF
          CLOSE (11)
          PRINT * , Q
          PRINT * , 'Number of areas in the dataset:  ',NOAD,Q
          PRINT * , 'Number of edges in the dataset:  ',NOES,Q
          PRINT * , 'Number of points in the dataset: ',NOEP,Q
          IOAP=0
          IOAS=0
          IOEP=0
          IOPP=0
          GO TO 104
C
C "E" command ("Edit dataset in some way").
C
        ELSE IF (COMD.EQ.'E'.OR.COMD.EQ.'e') THEN
          PRINT * , Q
          PRINT * , 'Edit data - enter one of the following:',Q
          PRINT * , Q
          PRINT * , '  D => delete (picked point)',Q
          PRINT * , '  I => insert (center point after picked point)',Q
          PRINT * , '  R => replace (picked point with center point)',Q
          PRINT * , Q
          PRINT * , '  E => edge (to access edge commands)',Q
          PRINT * , Q
          PRINT * , '  A => area (to access area commands)',Q
          PRINT * , Q
          CALL GTCHAR (COMD)
          IF (COMD.EQ.'D'.OR.COMD.EQ.'d') THEN
            IF (IOEP.EQ.0) THEN
              PRINT * , Q
              PRINT * , 'No edge picked.',Q
            ELSE
              XCEN=XCRD(IOFP(IOEP)+IOPP)
              YCEN=YCRD(IOFP(IOEP)+IOPP)
              NOEP=NOEP-1
              DO 117 I=IOFP(IOEP)+IOPP,NOEP
                XCRD(I)=XCRD(I+1)
                YCRD(I)=YCRD(I+1)
  117         CONTINUE
              IOLP(IOEP)=IOLP(IOEP)-1
              DO 118 IOES=IOEP+1,NOES
                IOFP(IOES)=IOFP(IOES)-1
                IOLP(IOES)=IOLP(IOES)-1
  118         CONTINUE
              IF (IOLP(IOEP).LT.IOFP(IOEP)) THEN
                NOES=NOES-1
                DO 119 IOES=IOEP,NOES
                  IOFP(IOES)=IOFP(IOES+1)
                  IOLP(IOES)=IOLP(IOES+1)
                  ILTY(IOES)=ILTY(IOES+1)
                  IAIL(IOES)=IAIL(IOES+1)
                  IAIR(IOES)=IAIR(IOES+1)
  119           CONTINUE
                IOEP=0
                IOPP=0
              ELSE
                IOPP=MAX(0,MIN(IOLP(IOEP)-IOFP(IOEP),IOPP-1))
              END IF
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'I'.OR.COMD.EQ.'i') THEN
            IF (IOEP.EQ.0) THEN
              PRINT * , Q
              PRINT * , 'No edge picked.',Q
            ELSE IF (NOEP.GE.MNEP) THEN
              PRINT * , Q
              PRINT * , 'Too many points.',Q
            ELSE IF (XCRD(IOFP(IOEP)+IOPP).EQ.XCEN.AND.
     +               YCRD(IOFP(IOEP)+IOPP).EQ.YCEN) THEN
              PRINT * , Q
              PRINT * , 'Adjacent identical points.',Q
            ELSE
              NOEP=NOEP+1
              DO 120 I=NOEP,IOFP(IOEP)+IOPP+2,-1
                XCRD(I)=XCRD(I-1)
                YCRD(I)=YCRD(I-1)
  120         CONTINUE
              IOLP(IOEP)=IOLP(IOEP)+1
              DO 121 IOES=IOEP+1,NOES
                IOFP(IOES)=IOFP(IOES)+1
                IOLP(IOES)=IOLP(IOES)+1
  121         CONTINUE
              XCRD(IOFP(IOEP)+IOPP+1)=XCEN
              YCRD(IOFP(IOEP)+IOPP+1)=YCEN
              IOPP=IOPP+1
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'R'.OR.COMD.EQ.'r') THEN
            IF (IOEP.EQ.0) THEN
              PRINT * , Q
              PRINT * , 'No edge picked.',Q
            ELSE
              IF (GLRF.EQ.0.) THEN
                XCRD(IOFP(IOEP)+IOPP)=XCEN
                YCRD(IOFP(IOEP)+IOPP)=YCEN
              ELSE
                XOLD=XCRD(IOFP(IOEP)+IOPP)
                YOLD=YCRD(IOFP(IOEP)+IOPP)
                DO 278 I=1,NOEP
                  IF (ABS(XCRD(I)-XOLD).LE.GLRF.AND.
     +                ABS(YCRD(I)-YOLD).LE.GLRF) THEN
                    XCRD(I)=XCEN
                    YCRD(I)=YCEN
                  END IF
  278           CONTINUE
              END IF
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'E'.OR.COMD.EQ.'e') THEN
            PRINT * , Q
            PRINT * , 'Edge mode - enter one of the following:',Q
            PRINT * , Q
            PRINT * , '  B => break (picked edge at picked point)',Q
            PRINT * , '  C => create (new edge from center point)',Q
            PRINT * , '  D => delete (picked edge)',Q
            PRINT * , Q
            PRINT * , '  I => interpolate (to less-dense picked edge)',Q
            PRINT * , Q
            PRINT * , '  A => automated edits of various types',Q
            PRINT * , Q
            CALL GTCHAR (COMD)
            IF (COMD.EQ.'B'.OR.COMD.EQ.'b') THEN
              IF (IOEP.EQ.0) THEN
                PRINT * , Q
                PRINT * , 'No edge picked.',Q
              ELSE IF (NOES.GE.MNES) THEN
                PRINT * , Q
                PRINT * , 'Too many edges.',Q
              ELSE IF (NOEP.GE.MNEP) THEN
                PRINT * , Q
                PRINT * , 'Too many points.',Q
              ELSE
                NOEP=NOEP+1
                DO 141 I=NOEP,IOFP(IOEP)+IOPP+1,-1
                  XCRD(I)=XCRD(I-1)
                  YCRD(I)=YCRD(I-1)
  141           CONTINUE
                NOES=NOES+1
                DO 142 IOES=NOES,IOEP+1,-1
                  IOFP(IOES)=IOFP(IOES-1)+1
                  IOLP(IOES)=IOLP(IOES-1)+1
                  ILTY(IOES)=ILTY(IOES-1)
                  IAIL(IOES)=IAIL(IOES-1)
                  IAIR(IOES)=IAIR(IOES-1)
  142           CONTINUE
                IOLP(IOEP  )=IOFP(IOEP)+IOPP
                IOFP(IOEP+1)=IOFP(IOEP)+IOPP+1
                GO TO 104
              END IF
            ELSE IF (COMD.EQ.'C'.OR.COMD.EQ.'c') THEN
              IF (IOEP.NE.0) THEN
                IF (IOPP.NE.0.AND.IOPP.NE.IOLP(IOEP)-IOFP(IOEP)) THEN
                  IF (XCRD(IOFP(IOEP)+IOPP).EQ.XCEN.AND.
     +                YCRD(IOFP(IOEP)+IOPP).EQ.YCEN) THEN
                    IF (NOES.LT.MNES.AND.NOEP.LT.MNEP) THEN
                      NOEP=NOEP+1
                      DO 359 I=NOEP,IOFP(IOEP)+IOPP+1,-1
                        XCRD(I)=XCRD(I-1)
                        YCRD(I)=YCRD(I-1)
  359                 CONTINUE
                      NOES=NOES+1
                      DO 360 IOES=NOES,IOEP+1,-1
                        IOFP(IOES)=IOFP(IOES-1)+1
                        IOLP(IOES)=IOLP(IOES-1)+1
                        ILTY(IOES)=ILTY(IOES-1)
                        IAIL(IOES)=IAIL(IOES-1)
                        IAIR(IOES)=IAIR(IOES-1)
  360                 CONTINUE
                      IOLP(IOEP  )=IOFP(IOEP)+IOPP
                      IOFP(IOEP+1)=IOFP(IOEP)+IOPP+1
                    END IF
                  END IF
                END IF
              END IF
              IF (NOES.GE.MNES) THEN
                PRINT * , Q
                PRINT * , 'Too many edges.',Q
              ELSE IF (NOEP.GE.MNEP) THEN
                PRINT * , Q
                PRINT * , 'Too many points.',Q
              ELSE
                DO 306 I=1,MNAI
                  IF (NAME(I).EQ.'Unidentified Area') THEN
                    IOUA=I
                    GO TO 308
                  END IF
  306           CONTINUE
                DO 307 I=1,MNAI
                  IF (IATY(I).EQ.0) THEN
                    IATY(I)=1
                    ISCI(I)=8
                    IPAR(I)=0
                    NAME(I)='Unidentified Area'
                    IOUA=I
                    GO TO 308
                  END IF
  307           CONTINUE
                PRINT * , 'Too many areas.',Q
                GO TO 104
  308           NOEP=NOEP+1
                XCRD(NOEP)=XCEN
                YCRD(NOEP)=YCEN
                NOES=NOES+1
                IOFP(NOES)=NOEP
                IOLP(NOES)=NOEP
                ILTY(NOES)=0
                IAIL(NOES)=IOUA
                IAIR(NOES)=IOUA
                IOEP=NOES
                IOPP=0
                GO TO 104
              END IF
            ELSE IF (COMD.EQ.'D'.OR.COMD.EQ.'d') THEN
              IF (IOEP.EQ.0) THEN
                PRINT * , Q
                PRINT * , 'No edge picked.',Q
              ELSE
                PRINT * , Q
                PRINT * , 'You really want to delete the edge? (y/n)',Q
                PRINT * , '(If so, answer "y", and it''ll be gone.)',Q
                CALL GTCHAR (COMD)
                IF (COMD.NE.'Y'.AND.COMD.NE.'y') THEN
                  PRINT * , Q
                  PRINT * , 'Edge not deleted.',Q
                  GO TO 114
                END IF
                NPTS=IOLP(IOEP)-IOFP(IOEP)+1
                NOEP=NOEP-NPTS
                DO 147 I=IOFP(IOEP),NOEP
                  XCRD(I)=XCRD(I+NPTS)
                  YCRD(I)=YCRD(I+NPTS)
  147           CONTINUE
                NOES=NOES-1
                DO 148 IOES=IOEP,NOES
                  IOFP(IOES)=IOFP(IOES+1)-NPTS
                  IOLP(IOES)=IOLP(IOES+1)-NPTS
                  ILTY(IOES)=ILTY(IOES+1)
                  IAIL(IOES)=IAIL(IOES+1)
                  IAIR(IOES)=IAIR(IOES+1)
  148           CONTINUE
                IOEP=0
                IOPP=0
                PRINT * , Q
                PRINT * , 'Edge deleted.',Q
                GO TO 104
              END IF
            ELSE IF (COMD.EQ.'I'.OR.COMD.EQ.'i') THEN
              IF (IOEP.EQ.0) THEN
                PRINT * , Q
                PRINT * , 'No edge picked.',Q
              ELSE IF (NOES.GE.MNES) THEN
                PRINT * , Q
                PRINT * , 'Too many edges.',Q
              ELSE IF (NOEP.GE.MNEP) THEN
                PRINT * , Q
                PRINT * , 'Too many points.',Q
              ELSE
                PRINT * , Q
                PRINT * , 'The current picked edge should be one with',Q
                PRINT * , 'closely-spaced points; a new edge, defined',Q
                PRINT * , 'by points that are further apart, will be',Q
                PRINT * , 'created.  Both edges will be left in the',Q
                PRINT * , 'database.  Delete one or the other.',Q
                PRINT * , Q
                PRINT * , 'Two different methods, designated A and B,',Q
                PRINT * , 'can be used to create a new edge.  Method',Q
                PRINT * , 'A is faster, but requires careful review',Q
                PRINT * , 'by user; manual editing may be required to',Q
                PRINT * , 'fix deviations from the original edge.',Q
                PRINT * , 'Method B is a bit slower, but more nearly',Q
                PRINT * , 'automatic.',Q
                PRINT * , Q
                PRINT * , 'Which method do you wish to use (A/B)?',Q
                PRINT * , Q
                CALL GTCHAR (COMD)
                IF (COMD.EQ.'A'.OR.COMD.EQ.'a') THEN
                  PRINT * , Q
                  PRINT * , 'Enter desired point separation (if',Q
                  PRINT * , 'different from current default value):',Q
                  DDBP=DLES
                  CALL DERDRN (DDBP,DDBP)
                  NOEP=NOEP+1
                  XCRD(NOEP)=XCRD(IOFP(IOEP))
                  YCRD(NOEP)=YCRD(IOFP(IOEP))
                  NOES=NOES+1
                  IOFP(NOES)=NOEP
                  IOLP(NOES)=NOEP
                  ILTY(NOES)=ILTY(IOEP)
                  IAIL(NOES)=IAIL(IOEP)
                  IAIR(NOES)=IAIR(IOEP)
                  XNXT=XCRD(IOFP(IOEP))
                  YNXT=YCRD(IOFP(IOEP))
                  DO 176 I=IOFP(IOEP)+1,IOLP(IOEP)
                    XLST=XNXT
                    YLST=YNXT
                    XNXT=XCRD(I)
                    YNXT=YCRD(I)
  175               DLST=ADSGCR(YCRD(NOEP),XCRD(NOEP),YLST,XLST)
                    DNXT=ADSGCR(YCRD(NOEP),XCRD(NOEP),YNXT,XNXT)
                    IF (DLST.LT.DDBP.AND.DNXT.GE.DDBP) THEN
                      CALL FPSGCR (YLST,XLST,YNXT,XNXT,
     +                             (DDBP-DLST)/(DNXT-DLST),YLST,XLST)
                      IF (NOEP.GE.MNEP) THEN
                        PRINT * , Q
                        PRINT * , 'Too many points.',Q
                        GO TO 104
                      ELSE
                        NOEP=NOEP+1
                        XCRD(NOEP)=XLST
                        YCRD(NOEP)=YLST
                        IOLP(NOES)=NOEP
                        GO TO 175
                      END IF
                    END IF
  176             CONTINUE
                  XCRD(NOEP)=XCRD(IOLP(IOEP))
                  YCRD(NOEP)=YCRD(IOLP(IOEP))
                  NOPO=IOLP(IOEP)-IOFP(IOEP)+1
                  NOPI=IOLP(NOES)-IOFP(NOES)+1
                  PRINT * , Q
                  PRINT * , 'Original edge:    ',NOPO,Q
                  PRINT * , 'Interpolated edge:',NOPI,Q
                  GO TO 104
                ELSE IF (COMD.EQ.'B'.OR.COMD.EQ.'b') THEN
                  PRINT * , Q
                  PRINT * , 'Enter desired point separation (if',Q
                  PRINT * , 'different from current default value):',Q
                  DDBP=DLES
                  CALL DERDRN (DDBP,DDBP)
                  NOEP=NOEP+1
                  XCRD(NOEP)=XCRD(IOFP(IOEP))
                  YCRD(NOEP)=YCRD(IOFP(IOEP))
                  NOES=NOES+1
                  IOFP(NOES)=NOEP
                  IOLP(NOES)=NOEP
                  ILTY(NOES)=ILTY(IOEP)
                  IAIL(NOES)=IAIL(IOEP)
                  IAIR(NOES)=IAIR(IOEP)
                  IOCS=IOFP(IOEP)
                  IOPS=IOCS
                  RLCS=SQRT((XCRD(IOCS+1)-XCRD(IOCS))**2+
     +                      (YCRD(IOCS+1)-YCRD(IOCS))**2)
                  DDCS=0.
  265             DDCS=DDCS+DDBP/10.
  266             IF (DDCS.GE.RLCS) THEN
                    IOCS=IOCS+1
                    IF (IOCS.LT.IOLP(IOEP)) THEN
                      DDCS=DDCS-RLCS
                      RLCS=SQRT((XCRD(IOCS+1)-XCRD(IOCS))**2+
     +                          (YCRD(IOCS+1)-YCRD(IOCS))**2)
                      A=MAX(SQRT((XCRD(IOCS+1)-XCRD(IOCS-1))**2+
     +                           (YCRD(IOCS+1)-YCRD(IOCS-1))**2),1.E-8)
                      B=MAX(SQRT((XCRD(IOCS-1)-XCRD(IOCS  ))**2+
     +                           (YCRD(IOCS-1)-YCRD(IOCS  ))**2),1.E-8)
                      C=MAX(RLCS                                ,1.E-8)
                      ANGL=RTOD*ABS(ACOS(.5*(B*B+C*C-A*A)/(B*C)))
                      IF (ANGL.LT.135.) THEN
                        XNXT=XCRD(IOCS)
                        YNXT=YCRD(IOCS)
                        DDCS=0.
                        GO TO 268
                      END IF
                      GO TO 266
                    ELSE
                      XNXT=XCRD(IOLP(IOEP))
                      YNXT=YCRD(IOLP(IOEP))
                    END IF
                  ELSE
                    XNXT=XCRD(IOCS)+DDCS*(XCRD(IOCS+1)-XCRD(IOCS))/RLCS
                    YNXT=YCRD(IOCS)+DDCS*(YCRD(IOCS+1)-YCRD(IOCS))/RLCS
                  END IF
                  IF (IOCS.LT.IOLP(IOEP)) THEN
                    D1T2=DIST(XCRD(NOEP),YCRD(NOEP),XNXT,YNXT)
                    IF (D1T2.GT.DDBP) GO TO 268
                    DO 267 I=IOPS+1,IOCS
                      IF (ABS(PERP(XCRD(NOEP),YCRD(NOEP),XNXT,YNXT,
     +                    XCRD(I),YCRD(I))).GT.DDBP/10.) GO TO 268
  267               CONTINUE
                    GO TO 265
                  END IF
  268             IF (NOEP.GE.MNEP) THEN
                    PRINT * , Q
                    PRINT * , 'Too many points.',Q
                    GO TO 104
                  ELSE
                    NOEP=NOEP+1
                    XCRD(NOEP)=XNXT
                    YCRD(NOEP)=YNXT
                    IOLP(NOES)=NOEP
                    IOPS=IOCS
                    IF (IOCS.LT.IOLP(IOEP)) GO TO 265
                  END IF
                  NOPO=IOLP(IOEP)-IOFP(IOEP)+1
                  NOPI=IOLP(NOES)-IOFP(NOES)+1
                  PRINT * , Q
                  PRINT * , 'Original edge:    ',NOPO,Q
                  PRINT * , 'Interpolated edge:',NOPI,Q
                  GO TO 104
                END IF
              END IF
            ELSE IF (COMD.EQ.'A'.OR.COMD.EQ.'a') THEN
              PRINT * , Q
              PRINT * , 'Choose one of the following:',Q
              PRINT * , Q
              PRINT * , '  B => Break new edges at selected points',Q
              PRINT * , '  C => Connect new edges to existing ones',Q
              PRINT * , '  S => Delete too-short edge segments',Q
              PRINT * , Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'B'.OR.COMD.EQ.'b') THEN
                PRINT * , Q
                PRINT * , 'Newly-imported edges (having line type',Q
                PRINT * , 'zero) are broken at interior points that',Q
                PRINT * , 'are on other newly imported edges.  (This',Q
                PRINT * , 'is necessary to ensure that only one area',Q
                PRINT * , 'lies to the left or right of each edge.)',Q
                PRINT * , Q
                PRINT * , 'This procedure can run a long time, so',Q
                PRINT * , 'so periodic prints are done that allow its',Q
                PRINT * , 'progress to be monitored.  To save time,',Q
                PRINT * , 'run this twice, the first time checking',Q
                PRINT * , 'only the end points of other edges and the',Q
                PRINT * , 'second time checking *all* points on other',Q
                PRINT * , 'edges.',Q
                PRINT * , Q
                PRINT * , 'Enter one of the following:',Q
                PRINT * , Q
                PRINT * , '  E => check End points only (1st pass)',Q
                PRINT * , '  A => check All points (2nd pass)',Q
                PRINT * , '  Q => Quit (neither of the above)',Q
                PRINT * , Q
                CALL GTCHAR (COMD)
                IF (COMD.EQ.'E'.OR.COMD.EQ.'e') THEN
                  ICKA=0
                ELSE IF (COMD.EQ.'A'.OR.COMD.EQ.'a') THEN
                  ICKA=1
                  CALL SSORT2 (XCRD,YCRD,NOEP,ICPA)
                ELSE
                  GO TO 114
                END IF
                NOSB=0
                IOES=1
  206           IF (IOES.LE.NOES) THEN
                  IF (ILTY(IOES).EQ.0) THEN
                    PRINT * , 'On segment ',IOES,' of ',NOES,'.',Q
                    DO 210 I=IOFP(IOES)+1,IOLP(IOES)-1
                      IF (ICKA.EQ.0) THEN
                        ITMP=1
                      ELSE
                        ITMP=NTIMES(XCRD,YCRD,NOEP,ICPA,I)-1
                      END IF
                      IF (ITMP.GT.0) THEN
                        DO 212 JOES=1,NOES
                          IF (ILTY(JOES).EQ.0.AND.JOES.NE.IOES) THEN
                            IF (ICKA.EQ.0) THEN
                              ININ=IOLP(JOES)-IOFP(JOES)
                            ELSE
                              ININ=1
                            END IF
                            DO 209 J=IOFP(JOES),IOLP(JOES),ININ
                              IF (I.NE.J.AND.XCRD(I).EQ.XCRD(J).AND.
     +                                       YCRD(I).EQ.YCRD(J)) THEN
                                IF (NOES.GE.MNES) THEN
                                  PRINT * , Q
                                  PRINT * , 'Too many edges.',Q
                                  GO TO 211
                                ELSE IF (NOEP.GE.MNEP) THEN
                                  PRINT * , Q
                                  PRINT * , 'Too many points.',Q
                                  GO TO 211
                                ELSE
                                  NOSB=NOSB+1
                                  NOEP=NOEP+1
                                  DO 207 K=NOEP,I+1,-1
                                    XCRD(K)=XCRD(K-1)
                                    YCRD(K)=YCRD(K-1)
  207                             CONTINUE
C                                 IF (NMRK.LT.MMRK) THEN !
C                                   NMRK=NMRK+1          !
C                                   XMRK(NMRK)=XCRD(I)   ! (MARK POINTS)
C                                   YMRK(NMRK)=YCRD(I)   !
C                                 END IF                 !
                                  IF (ICKA.NE.0)
     +                                 CALL SSORT2 (XCRD,YCRD,NOEP,ICPA)
                                  NOES=NOES+1
                                  DO 208 K=NOES,IOES+1,-1
                                    IOFP(K)=IOFP(K-1)+1
                                    IOLP(K)=IOLP(K-1)+1
                                    ILTY(K)=ILTY(K-1)
                                    IAIL(K)=IAIL(K-1)
                                    IAIR(K)=IAIR(K-1)
  208                             CONTINUE
                                  IOLP(IOES  )=I
                                  IOFP(IOES+1)=I+1
                                  IOES=IOES+1
                                  GO TO 206
                                END IF
                              END IF
  209                       CONTINUE
                          END IF
  212                   CONTINUE
                      END IF
  210               CONTINUE
                  END IF
                  IOES=IOES+1
                  GO TO 206
                END IF
  211           PRINT * , Q
                PRINT * , 'Number of segments broken:',NOSB,Q
                IF (NOSB.NE.0) THEN
                  IOEP=0
                  IOPP=0
                END IF
                GO TO 104
              ELSE IF (COMD.EQ.'C'.OR.COMD.EQ.'c') THEN
                PRINT * , Q
                PRINT * , 'This procedure looks for newly-imported',Q
                PRINT * , 'edges (those having line type zero) that',Q
                PRINT * , 'aren''t connected to any other edges; it',Q
                PRINT * , 'attempts to fix each one found, connecting',Q
                PRINT * , 'it to an edge which is not newly imported.',Q
                PRINT * , Q
                PRINT * , 'This procedure can run a long time, so',Q
                PRINT * , 'periodic prints are done, allowing its',Q
                PRINT * , 'progress to be monitored.',Q
                PRINT * , Q
                PRINT * , 'Continue (Y/N)?',Q
                PRINT * , Q
                CALL GTCHAR (COMD)
                IF (COMD.NE.'Y'.AND.COMD.NE.'y') GO TO 114
                NOSF=0
                IOES=1
  213           IF (IOES.LE.NOES) THEN
                  IF (ILTY(IOES).EQ.0) THEN
                    PRINT * , 'On segment ',IOES,' of ',NOES,'.',Q
                    DO 214 JOES=1,NOES
                      IF (IOES.NE.JOES.AND.
     +                    XCRD(IOFP(IOES)).EQ.XCRD(IOFP(JOES)).AND.
     +                    YCRD(IOFP(IOES)).EQ.YCRD(IOFP(JOES)))GO TO 215
                      IF (XCRD(IOFP(IOES)).EQ.XCRD(IOLP(JOES)).AND.
     +                    YCRD(IOFP(IOES)).EQ.YCRD(IOLP(JOES)))GO TO 215
  214               CONTINUE
                    SSAV=10.
                    DO 217 JOES=1,NOES
                      IF (ILTY(JOES).GT.0) THEN
                        DO 218 JOEP=IOFP(JOES),IOLP(JOES)-1
                          CALL INTERS (XCRD(IOFP(IOES)+1),
     +                                 YCRD(IOFP(IOES)+1),
     +                                 XCRD(IOFP(IOES)  ),
     +                                 YCRD(IOFP(IOES)  ),
     +                                 XCRD(JOEP)        ,
     +                                 YCRD(JOEP)        ,
     +                                 XCRD(JOEP+1)      ,
     +                                 YCRD(JOEP+1)      ,S,T)
                          IF (S.GE..01.AND.S.LT.SSAV.AND.
     +                        T.GE. 0..AND.T.LE.1.) THEN
                            SSAV=S
                            TSAV=T
                            KOES=JOES
                            KOEP=JOEP
                          END IF
  218                   CONTINUE
                      END IF
  217               CONTINUE
                    IF (SSAV.LT.2.) THEN
                      NOSF=NOSF+1
                      XINT=XCRD(KOEP)+TSAV*(XCRD(KOEP+1)-XCRD(KOEP))
                      YINT=YCRD(KOEP)+TSAV*(YCRD(KOEP+1)-YCRD(KOEP))
                      IF      (TSAV.LE..01) THEN
                        XINT=XCRD(KOEP)
                        YINT=YCRD(KOEP)
                        KOEP=KOEP-1
                      ELSE IF (TSAV.GE..99) THEN
                        XINT=XCRD(KOEP+1)
                        YINT=YCRD(KOEP+1)
                      ELSE IF (XINT.EQ.XCRD(KOEP).AND.
     +                         YINT.EQ.YCRD(KOEP)) THEN
                        KOEP=KOEP-1
                      ELSE IF (XINT.NE.XCRD(KOEP+1).OR.
     +                         YINT.NE.YCRD(KOEP+1)) THEN
                        IF (NOEP.GE.MNEP) THEN
                          PRINT * , Q
                          PRINT * , 'Too many points.',Q
                          GO TO 104
                        END IF
                        NOEP=NOEP+1
                        DO 223 I=NOEP,KOEP+2,-1
                          XCRD(I)=XCRD(I-1)
                          YCRD(I)=YCRD(I-1)
  223                   CONTINUE
                        XCRD(KOEP+1)=XINT
                        YCRD(KOEP+1)=YINT
                        IOLP(KOES)=IOLP(KOES)+1
                        DO 224 JOES=KOES+1,NOES
                          IOFP(JOES)=IOFP(JOES)+1
                          IOLP(JOES)=IOLP(JOES)+1
  224                   CONTINUE
                      END IF
                      IF (KOEP+1.NE.IOFP(KOES).AND.
     +                    KOEP+1.NE.IOLP(KOES)) THEN
                        IF (NOES.GE.MNES) THEN
                          PRINT * , Q
                          PRINT * , 'Too many edges.',Q
                          GO TO 104
                        ELSE IF (NOEP.GE.MNEP) THEN
                          PRINT * , Q
                          PRINT * , 'Too many points.',Q
                          GO TO 104
                        ELSE
                          NOEP=NOEP+1
                          DO 225 I=NOEP,KOEP+2,-1
                            XCRD(I)=XCRD(I-1)
                            YCRD(I)=YCRD(I-1)
  225                     CONTINUE
                          NOES=NOES+1
                          DO 226 JOES=NOES,KOES+1,-1
                            IOFP(JOES)=IOFP(JOES-1)+1
                            IOLP(JOES)=IOLP(JOES-1)+1
                            ILTY(JOES)=ILTY(JOES-1)
                            IAIL(JOES)=IAIL(JOES-1)
                            IAIR(JOES)=IAIR(JOES-1)
  226                     CONTINUE
                          IOLP(KOES  )=KOEP+1
                          IOFP(KOES+1)=KOEP+2
                        END IF
                        IF (IOES.GT.KOES) IOES=IOES+1
                      END IF
                      XCRD(IOFP(IOES))=XINT
                      YCRD(IOFP(IOES))=YINT
                      ILTY(IOES)=-1
                    END IF
  215               DO 216 JOES=1,NOES
                      IF (XCRD(IOLP(IOES)).EQ.XCRD(IOFP(JOES)).AND.
     +                    YCRD(IOLP(IOES)).EQ.YCRD(IOFP(JOES)))GO TO 219
                      IF (IOES.NE.JOES.AND.
     +                    XCRD(IOLP(IOES)).EQ.XCRD(IOLP(JOES)).AND.
     +                    YCRD(IOLP(IOES)).EQ.YCRD(IOLP(JOES)))GO TO 219
  216               CONTINUE
                    SSAV=10.
                    DO 220 JOES=1,NOES
                      IF (ILTY(JOES).GT.0) THEN
                        DO 221 JOEP=IOFP(JOES),IOLP(JOES)-1
                          CALL INTERS (XCRD(IOLP(IOES)-1),
     +                                 YCRD(IOLP(IOES)-1),
     +                                 XCRD(IOLP(IOES)  ),
     +                                 YCRD(IOLP(IOES)  ),
     +                                 XCRD(JOEP)        ,
     +                                 YCRD(JOEP)        ,
     +                                 XCRD(JOEP+1)      ,
     +                                 YCRD(JOEP+1)      ,S,T)
                          IF (S.GE..01.AND.S.LT.SSAV.AND.
     +                        T.GE. 0..AND.T.LE.1.) THEN
                            SSAV=S
                            TSAV=T
                            KOES=JOES
                            KOEP=JOEP
                          END IF
  221                   CONTINUE
                      END IF
  220               CONTINUE
                    IF (SSAV.LT.2.) THEN
                      NOSF=NOSF+1
                      XINT=XCRD(KOEP)+TSAV*(XCRD(KOEP+1)-XCRD(KOEP))
                      YINT=YCRD(KOEP)+TSAV*(YCRD(KOEP+1)-YCRD(KOEP))
                      IF      (TSAV.LE..01) THEN
                        XINT=XCRD(KOEP)
                        YINT=YCRD(KOEP)
                        KOEP=KOEP-1
                      ELSE IF (TSAV.GE..99) THEN
                        XINT=XCRD(KOEP+1)
                        YINT=YCRD(KOEP+1)
                      ELSE IF (XINT.EQ.XCRD(KOEP).AND.
     +                         YINT.EQ.YCRD(KOEP)) THEN
                        KOEP=KOEP-1
                      ELSE IF (XINT.NE.XCRD(KOEP+1).OR.
     +                         YINT.NE.YCRD(KOEP+1)) THEN
                        IF (NOEP.GE.MNEP) THEN
                          PRINT * , Q
                          PRINT * , 'Too many points.',Q
                          GO TO 104
                        END IF
                        NOEP=NOEP+1
                        DO 227 I=NOEP,KOEP+2,-1
                          XCRD(I)=XCRD(I-1)
                          YCRD(I)=YCRD(I-1)
  227                   CONTINUE
                        XCRD(KOEP+1)=XINT
                        YCRD(KOEP+1)=YINT
                        IOLP(KOES)=IOLP(KOES)+1
                        DO 228 JOES=KOES+1,NOES
                          IOFP(JOES)=IOFP(JOES)+1
                          IOLP(JOES)=IOLP(JOES)+1
  228                   CONTINUE
                      END IF
                      IF (KOEP+1.NE.IOFP(KOES).AND.
     +                    KOEP+1.NE.IOLP(KOES)) THEN
                        IF (NOES.GE.MNES) THEN
                          PRINT * , Q
                          PRINT * , 'Too many edges.',Q
                          GO TO 104
                        ELSE IF (NOEP.GE.MNEP) THEN
                          PRINT * , Q
                          PRINT * , 'Too many points.',Q
                          GO TO 104
                        ELSE
                          NOEP=NOEP+1
                          DO 229 I=NOEP,KOEP+2,-1
                            XCRD(I)=XCRD(I-1)
                            YCRD(I)=YCRD(I-1)
  229                     CONTINUE
                          NOES=NOES+1
                          DO 230 JOES=NOES,KOES+1,-1
                            IOFP(JOES)=IOFP(JOES-1)+1
                            IOLP(JOES)=IOLP(JOES-1)+1
                            ILTY(JOES)=ILTY(JOES-1)
                            IAIL(JOES)=IAIL(JOES-1)
                            IAIR(JOES)=IAIR(JOES-1)
  230                     CONTINUE
                          IOLP(KOES  )=KOEP+1
                          IOFP(KOES+1)=KOEP+2
                        END IF
                        IF (IOES.GT.KOES) IOES=IOES+1
                      END IF
                      XCRD(IOLP(IOES))=XINT
                      YCRD(IOLP(IOES))=YINT
                      ILTY(IOES)=-1
                    END IF
                  END IF
  219             IOES=IOES+1
                  GO TO 213
                END IF
                PRINT * , Q
                PRINT * , 'Number of segments fixed:',NOSF,Q
                IF (NOSF.NE.0) THEN
                  IOEP=0
                  IOPP=0
                  DO 222 IOES=1,NOES
                    IF (ILTY(IOES).LT.0) ILTY(IOES)=5  !  ???
  222             CONTINUE
                END IF
                GO TO 104
              ELSE IF (COMD.EQ.'S'.OR.COMD.EQ.'s') THEN
                PRINT * , Q
                PRINT * , 'Culling edge segments that are too short.',Q
  269           PRINT * , Q
                PRINT * , 'Enter minimum desirable segment length:',Q
                CALL DERDRN (SMIN,.0001)
                SMIN=MAX(0.,MIN(.001,SMIN))
                IF (SMIN.LE.0.) THEN
                  PRINT * , Q
                  PRINT * , 'Value must be greater than zero.',Q
                  GO TO 269
                ELSE
                  SMSQ=SMIN*SMIN
                  IMRK=0
                  NMRK=0
                  DO 273 IOES=1,NOES
                    IOPE=IOFP(IOES)+1
  272               IF (IOPE.LT.IOLP(IOES)) THEN
                      IF ((XCRD(IOPE)-XCRD(IOPE-1))**2+
     +                    (YCRD(IOPE)-YCRD(IOPE-1))**2.LT.SMSQ) THEN
                        IF (NMRK.LT.MMRK) THEN
                          NMRK=NMRK+1
                          XMRK(NMRK)=XCRD(IOPE)
                          YMRK(NMRK)=YCRD(IOPE)
                        END IF
                        NOEP=NOEP-1
                        DO 270 I=IOPE,NOEP
                          XCRD(I)=XCRD(I+1)
                          YCRD(I)=YCRD(I+1)
  270                   CONTINUE
                        IOLP(IOES)=IOLP(IOES)-1
                        DO 271 I=IOES+1,NOES
                          IOFP(I)=IOFP(I)-1
                          IOLP(I)=IOLP(I)-1
  271                   CONTINUE
                        GO TO 272
                      END IF
                      IOPE=IOPE+1
                      GO TO 272
                    END IF
  273             CONTINUE
                END IF
                PRINT * , 'Number of points removed: ',NMRK,Q
                IF (NMRK.NE.0) GO TO 104
              END IF
            END IF
          ELSE IF (COMD.EQ.'A'.OR.COMD.EQ.'a') THEN
            PRINT * , Q
            PRINT * , 'Area edit mode allows for quick identification',Q
            PRINT * , 'of areas defined by a new set of edges.  Each',Q
            PRINT * , 'of the areas defined by the edges in the',Q
            PRINT * , 'current window is given a number.  The user',Q
            PRINT * , 'is allowed to describe one or more of those',Q
            PRINT * , 'areas and update edges of each as specified',Q
            PRINT * , 'by the given description.',Q
            PRINT * , Q
            PRINT * , 'Information should be changed only for areas',Q
            PRINT * , 'lying entirely within the part of the plotter',Q
            PRINT * , 'frame outlined with a heavy red line.  Trying',Q
            PRINT * , 'to change information for areas lying partly',Q
            PRINT * , 'outside this line will not work properly.',Q
            PRINT * , Q
            PRINT * , 'Continue (Y/N)?',Q
            PRINT * , Q
            CALL GTCHAR (COMD)
            IF (COMD.NE.'Y'.AND.COMD.NE.'y') GO TO 114
            XCRA(1)=MAX(-180.,XCEN-RNGE/2.)
            YCRA(1)=MAX(- 90.,YCEN-RNGE/2.)
            XCRA(2)=MIN( 180.,XCEN+RNGE/2.)
            YCRA(2)=MAX(- 90.,YCEN-RNGE/2.)
            XCRA(3)=MIN( 180.,XCEN+RNGE/2.)
            YCRA(3)=MIN(  90.,YCEN+RNGE/2.)
            XCRA(4)=MAX(-180.,XCEN-RNGE/2.)
            YCRA(4)=MIN(  90.,YCEN+RNGE/2.)
            XCRA(5)=MAX(-180.,XCEN-RNGE/2.)
            YCRA(5)=MAX(- 90.,YCEN-RNGE/2.)
            CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (6)
            CALL GSLWSC (3.)
            CALL CURVE  (XCRA,YCRA,5)
            CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (1)
            CALL GSLWSC (1.)
            CALL ARINAM (IAMA,LAMA)
            CALL AREDAM (IAMA,XCRA,YCRA,5,1,0,-1)
            IF (NERRO(ITMP).NE.0) THEN
              PRINT * , Q
              CALL EPRIN
              PRINT * , Q
              CALL ERROF
              GO TO 104
            END IF
            DO 232 IOES=1,NOES
              IOAL=IOAREA(ILVL,IAIL(IOES))
              IOAR=IOAREA(ILVL,IAIR(IOES))
              DO 231 I=IOFP(IOES),IOLP(IOES)
                CALL WLTOAM (CUFX(XCRD(I)),CUFY(YCRD(I)),
     +                             MIN(I-IOFP(IOES),1),IAMA,1,IOAL,IOAR)
                IF (NERRO(ITMP).NE.0) THEN
                  PRINT * , Q
                  CALL EPRIN
                  PRINT * , Q
                  CALL ERROF
                  GO TO 104
                END IF
  231         CONTINUE
  232       CONTINUE
            NODA=-2
            CALL ARSCAM (IAMA,XCRA,YCRA,MCRA,IAAI,IAGI,1,NUMBRA)
            IF (NERRO(ITMP).NE.0) THEN
              PRINT * , Q
              CALL EPRIN
              PRINT * , Q
              CALL ERROF
              GO TO 104
            END IF
            PRINT * , Q
            PRINT * , 'Area map length: ',LAMA-IAMA(6)+IAMA(5)+1,Q
            IF (NODA.LE.0) THEN
              PRINT * , Q
              PRINT * , 'No areas defined.  Can''t continue.',Q
              GO TO 104
            END IF
            PRINT * , Q
            PRINT * , 'Number of defined areas:',NODA,Q
            IODA=0
  233       PRINT * , Q
            PRINT * , 'Number (in window) of area last modified:',IODA,Q
            PRINT * , Q
            PRINT * , 'Enter new area number (zero to quit):',Q
            CALL DERDIN (IODA,IODA)
            IODA=MAX(0,MIN(NODA,IODA))
            IF (IODA.EQ.0) GO TO 104
            INDX=IONA(IODA)
  239       IF (INDX.NE.0) THEN
              PRINT * , Q
              PRINT * , 'Current area definition is as follows:',Q
              PRINT * , Q
              PRINT * , '  Index: ',INDX,Q
              PRINT * , Q
              PRINT * , '  Type:  ',IATY(INDX),Q
              PRINT * , '  Color: ',ISCI(INDX),Q
              PRINT * , '  Parent:',IPAR(INDX),Q
              PRINT * , '  Name:  ',NAME(INDX)(1:MPILNB(NAME(INDX))),Q
              PRINT * , Q
              PRINT * , 'Use index/definition exactly as is (Y/N)?',Q
              PRINT * , Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') GO TO 238
              PRINT * , Q
              PRINT * , 'Use index but modify definition (Y/N)?',Q
              PRINT * , Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') GO TO 237
              INDX=0
            ELSE
              PRINT * , Q
              PRINT * , 'Selected area is undefined.',Q
            END IF
            PRINT * , Q
            PRINT * , 'Search for a given name in the database (Y/N)?',Q
            PRINT * , Q
            CALL GTCHAR (COMD)
            IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
  241         PRINT * , Q
              PRINT * , 'Enter new name (up to 64 characters):',Q
              CALL GTCHRS (NNAM,64)
              IF (NNAM.EQ.' ') GO TO 236
              DO 240 I=1,MNAI
                IF (NAME(I).EQ.NNAM) THEN
                  PRINT * , Q
                  PRINT * , 'Name found in following area definition:',Q
                  PRINT * , Q
                  PRINT * , '  Index: ',I,Q
                  PRINT * , Q
                  PRINT * , '  Type:  ',IATY(I),Q
                  PRINT * , '  Color: ',ISCI(I),Q
                  PRINT * , '  Parent:',IPAR(I),Q
                  PRINT * , '  Name:  ',NAME(I)(1:MPILNB(NAME(I))),Q
                  PRINT * , Q
                  PRINT * , 'Use this area definition (Y/N)?',Q
                  PRINT * , Q
                  CALL GTCHAR (COMD)
                  IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                    INDX=I
                    IONA(IODA)=INDX
                    GO TO 239
                  END IF
                END IF
  240         CONTINUE
              PRINT * , Q
              PRINT * , 'Name not found.  Try different name (Y/N)?',Q
              PRINT * , Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') GO TO 241
            END IF
  236       PRINT * , Q
            PRINT * , 'Create a totally new definition (Y/N)?',Q
            PRINT * , Q
            CALL GTCHAR (COMD)
            IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
              DO 234 I=1,MNAI
                IF (IATY(I).EQ.0) THEN
                  INDX=I
                  IONA(IODA)=INDX
                  GO TO 235
                END IF
  234         CONTINUE
              PRINT * , Q
              PRINT * , 'Too many areas.',Q
              GO TO 104
  235         IATY(INDX)=NATY
              ISCI(INDX)=NSCI
              IPAR(INDX)=NPAR
              NAME(INDX)=NNAM
              PRINT * , Q
              PRINT * , 'New area definition is as follows:',Q
              PRINT * , Q
              PRINT * , '  Index: ',INDX,Q
              PRINT * , Q
              PRINT * , '  Type:  ',IATY(INDX),Q
              PRINT * , '  Color: ',ISCI(INDX),Q
              PRINT * , '  Parent:',IPAR(INDX),Q
              PRINT * , '  Name:  ',NAME(INDX)(1:MPILNB(NAME(INDX))),Q
              GO TO 237
            END IF
            GO TO 233
  237       PRINT * , Q
            PRINT * , 'Enter new area type (between 1 and 5):',Q
            CALL DERDIN (NATY,IATY(INDX))
            NATY=MAX(1,MIN(5,NATY))
            IATY(INDX)=NATY
            PRINT * , Q
            PRINT * , 'Enter new color index (between 1 and 8):',Q
            CALL DERDIN (NSCI,ISCI(INDX))
            NSCI=MAX(1,MIN(8,NSCI))
            ISCI(INDX)=NSCI
            PRINT * , Q
            PRINT * , 'Enter new parent index:',Q
            CALL DERDIN (NPAR,IPAR(INDX))
            NPAR=MAX(0,MIN(MNAI,NPAR))
            IPAR(INDX)=NPAR
            PRINT * , Q
            PRINT * , 'Enter new name (up to 64 characters):',Q
            CALL GTCHRS (NNAM,64)
            IF (NNAM.NE.' ') NAME(INDX)=NNAM
            PRINT * , Q
            PRINT * , 'Area definition is now as follows:',Q
            PRINT * , Q
            PRINT * , '  Index: ',INDX,Q
            PRINT * , Q
            PRINT * , '  Type:  ',IATY(INDX),Q
            PRINT * , '  Color: ',ISCI(INDX),Q
            PRINT * , '  Parent:',IPAR(INDX),Q
            PRINT * , '  Name:  ',NAME(INDX)(1:MPILNB(NAME(INDX))),Q
  238       PRINT * , Q
            PRINT * , 'Incorporate information in database (Y/N)?',Q
            PRINT * , Q
            CALL GTCHAR (COMD)
            IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
              NODA=-2
              CALL GETSET (VP(1),VP(2),VP(3),VP(4),
     +                     WD(1),WD(2),WD(3),WD(4),LL)
              CALL ARSCAM (IAMA,XCRA,YCRA,MCRA,IAAI,IAGI,1,UPDATA)
              IF (NERRO(ITMP).NE.0) THEN
                PRINT * , Q
                CALL EPRIN
                PRINT * , Q
                CALL ERROF
                GO TO 104
              END IF
              PRINT * , Q
              PRINT * , 'Information incorporated.',Q
            ELSE
              PRINT * , Q
              PRINT * , 'Make further changes in definition (Y/N)?',Q
              PRINT * , Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') GO TO 237
            END IF
            GO TO 233
          END IF
C
C "F" command ("toggle Fill on/off").
C
        ELSE IF (COMD.EQ.'F'.OR.COMD.EQ.'f') THEN
          PRINT * , Q
          PRINT * , 'Toggle fill flag.',Q
          PRINT * , Q
          IFIL=1-IFIL
          GO TO 104
C
C "G" command ("toggle Grid on/off").
C
        ELSE IF (COMD.EQ.'G'.OR.COMD.EQ.'g') THEN
          PRINT * , Q
          PRINT * , 'Toggle grid flag.',Q
          PRINT * , Q
          IGRD=1-IGRD
          GO TO 104
C
C "H" command ("Help").
C
        ELSE IF (COMD.EQ.'H'.OR.COMD.EQ.'h') THEN
          PRINT * , Q
          PRINT * , 'Available commands are as follows:',Q
          PRINT * , Q
          PRINT * , '  A => change info for picked Area',Q
          PRINT * , '  B => change Background flag',Q
          PRINT * , '  C => Check for errors and mark them',Q
          PRINT * , '  D => change Dataset viewed',Q
          PRINT * , '  E => Edit dataset in some way',Q
          PRINT * , '  F => toggle Fill on/off',Q
          PRINT * , '  G => toggle Grid on/off',Q
          PRINT * , '  H => Help',Q
          PRINT * , '  I => change Identifiers of picked edge',Q
          PRINT * , '  L => change Level of area fill and editing',Q
          PRINT * , '  M => Move center point',Q
          PRINT * , '  N => write a frame to the NCGM',Q
          PRINT * , '  O => Output edges to a named file',Q
          PRINT * , '  P => Pick a point, an edge, and/or an area',Q
          PRINT * , '  Q => Quit',Q
          PRINT * , '  R => Read data (from background or from file)',Q
          PRINT * , '  S => Show a particular area',Q
          PRINT * , '  U => Update the display',Q
          PRINT * , '  V => change miscellaneous Variables',Q
          PRINT * , '  W => Write an updated copy of the dataset',Q
          PRINT * , '  X => eXamine various dataset parameters',Q
          PRINT * , '  Z => Zoom in/out toward/from center point',Q
          PRINT * , Q
          PRINT * , 'The center point is gray.  The perimeter of the',Q
          PRINT * , 'picked area is pink, the picked edge is red, and',Q
          PRINT * , 'the picked point magenta.  A, E, and I commands',Q
          PRINT * , 'make changes in the picked point and/or edge.',Q
C
C "I" command ("change Identifiers of picked edge").
C
        ELSE IF (COMD.EQ.'I'.OR.COMD.EQ.'i') THEN
          PRINT * , Q
          PRINT * , 'Change identifiers of picked edge.',Q
          IF (ILVL.LT.5) THEN
            PRINT * , Q
            PRINT * , 'Can''t make change at this display level.',Q
          ELSE IF (IOEP.EQ.0) THEN
            PRINT * , Q
            PRINT * , 'Can''t change identifiers - no edge picked.',Q
          ELSE
            PRINT * , Q
            PRINT * , '  Current line type:            ',ILTY(IOEP),Q
            PRINT * , '  Current left area identifier: ',IAIL(IOEP),Q
            PRINT * , '  Current right area identifier:',IAIR(IOEP),Q
            PRINT * , Q
            PRINT * , 'Line types are defined as follows:',Q
            PRINT * , Q
            PRINT * , '  1 => a land/water line',Q
            PRINT * , '  2 => a continent boundary',Q
            PRINT * , '  3 => a country boundary',Q
            PRINT * , '  4 => a state boundary',Q
            PRINT * , '  5 => a county boundary',Q
            PRINT * , Q
            PRINT * , 'Enter new line type:',Q
            CALL DERDIN (ILTY(IOEP),ILTY(IOEP))
            ILTY(IOEP)=MAX(0,MIN(5,ILTY(IOEP)))
            PRINT * , 'Enter new left area identifier (zero for first un
     +used value):',Q
            CALL DERDIN (IAIL(IOEP),IAIL(IOEP))
            IF (IAIL(IOEP).LT.1.OR.IAIL(IOEP).GT.MNAI) THEN
              PRINT * , Q
              PRINT * , 'Seeking first unused value.',Q
              DO 137 I=1,MNAI
                IF (IATY(I).EQ.0) THEN
                  PRINT * , 'First unused value found: ',I,Q
                  PRINT * , Q
                  IAIL(IOEP)=I
                  IATY(I)=1
                  ISCI(I)=1
                  IPAR(I)=0
                  NAME(I)='Area on Left'
                  IOAP=I
                  GO TO 309
                END IF
  137         CONTINUE
              PRINT * , Q
              PRINT * , 'No unused values found - left area identifier n
     +ot changed.',Q
            END IF
            GO TO 138
  309       PRINT * , Q
            PRINT * , '  Information for area: ',Q
            PRINT '(2X,2I2,I5,1X,A)' , IATY(IOAP),ISCI(IOAP),IPAR(IOAP),
     +                                 NAME(IOAP)(1:MPILNB(NAME(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area type (between 1 and 5):',Q
            CALL DERDIN (IATY(IOAP),IATY(IOAP))
            IATY(IOAP)=MAX(1,MIN(5,IATY(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area color (between 1 and 8):',Q
            CALL DERDIN (ISCI(IOAP),ISCI(IOAP))
            ISCI(IOAP)=MAX(1,MIN(8,ISCI(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area parent index (negative for first u
     +nused value):',Q
            CALL DERDIN (ITMP,IPAR(IOAP))
            IF (ITMP.LT.0.OR.ITMP.GT.MNAI) THEN
              PRINT * , Q
              PRINT * , 'Identifier outside legal range.  Seek first unu
     +sed value.',Q
              DO 310 I=1,MNAI
                IF (IATY(I).EQ.0) THEN
                  PRINT * , Q
                  PRINT * , 'First unused value found: ',I,Q
                  ITMP=I
                  IATY(I)=IATY(IOAP)
                  ISCI(I)=ISCI(IOAP)
                  IPAR(I)=IPAR(IOAP)
                  NAME(I)='New Parent Area'
                  GO TO 311
                END IF
  310         CONTINUE
              PRINT * , Q
              PRINT * , 'No unused values.  Use parent index of zero.',Q
              ITMP=0
            END IF
  311       IPAR(IOAP)=ITMP
            PRINT * , Q
            PRINT * , 'Enter new area name (up to 64 characters):',Q
            CALL GTCHRS (NSCR,64)
            IF (NSCR.NE.' ') NAME(IOAP)=NSCR
  138       PRINT * , 'Enter new right area identifier (zero for first u
     +nused value):',Q
            CALL DERDIN (IAIR(IOEP),IAIR(IOEP))
            IF (IAIR(IOEP).LT.1.OR.IAIR(IOEP).GT.MNAI) THEN
              PRINT * , Q
              PRINT * , 'Seeking first unused value.',Q
              DO 139 I=1,MNAI
                IF (IATY(I).EQ.0) THEN
                  PRINT * , 'First unused value found: ',I,Q
                  PRINT * , Q
                  IAIR(IOEP)=I
                  IATY(I)=1
                  ISCI(I)=1
                  IPAR(I)=0
                  NAME(I)='Area on Right'
                  IOAP=I
                  GO TO 312
                END IF
  139         CONTINUE
              PRINT * , Q
              PRINT * ,  'No unused values found - right area identifier
     + not changed.'
            END IF
            GO TO 104
  312       PRINT * , Q
            PRINT * , '  Information for area: ',Q
            PRINT '(2X,2I2,I5,1X,A)' , IATY(IOAP),ISCI(IOAP),IPAR(IOAP),
     +                                 NAME(IOAP)(1:MPILNB(NAME(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area type (between 1 and 5):',Q
            CALL DERDIN (IATY(IOAP),IATY(IOAP))
            IATY(IOAP)=MAX(1,MIN(5,IATY(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area color (between 1 and 8):',Q
            CALL DERDIN (ISCI(IOAP),ISCI(IOAP))
            ISCI(IOAP)=MAX(1,MIN(8,ISCI(IOAP)))
            PRINT * , Q
            PRINT * , 'Enter new area parent index (negative for first u
     +nused value):',Q
            CALL DERDIN (ITMP,IPAR(IOAP))
            IF (ITMP.LT.0.OR.ITMP.GT.MNAI) THEN
              PRINT * , Q
              PRINT * , 'Identifier outside legal range.  Seek first unu
     +sed value.',Q
              DO 313 I=1,MNAI
                IF (IATY(I).EQ.0) THEN
                  PRINT * , Q
                  PRINT * , 'First unused value found: ',I,Q
                  ITMP=I
                  IATY(I)=IATY(IOAP)
                  ISCI(I)=ISCI(IOAP)
                  IPAR(I)=IPAR(IOAP)
                  NAME(I)='New Parent Area'
                  GO TO 140
                END IF
  313         CONTINUE
              PRINT * , Q
              PRINT * , 'No unused values.  Use parent index of zero.',Q
              ITMP=0
            END IF
  140       IPAR(IOAP)=ITMP
            PRINT * , Q
            PRINT * , 'Enter new area name (up to 64 characters):',Q
            CALL GTCHRS (NSCR,64)
            IF (NSCR.NE.' ') NAME(IOAP)=NSCR
            GO TO 104
          END IF
C
C "L" command ("change Level of area fill and editing").
C
        ELSE IF (COMD.EQ.'L'.OR.COMD.EQ.'l') THEN
          PRINT * , Q
          PRINT * , 'Change level of edges going into area map, as follo
     +ws:',Q
          PRINT * , Q
          PRINT * , '  1 => Use land/water boundaries only.',Q
          PRINT * , '  2 => Add continent boundaries.',Q
          PRINT * , '  3 => Add country boundaries.',Q
          PRINT * , '  4 => Add state boundaries.',Q
          PRINT * , '  5 => Add county boundaries.',Q
          PRINT * , Q
          PRINT * , 'This parameter also changes the level of area',Q
          PRINT * , 'identifier information displayed and the level',Q
          PRINT * , 'of what can be changed using an A command.',Q
          PRINT * , Q
          PRINT * , 'Enter new value of area-fill-and-display level:',Q
          PRINT * , Q
          CALL DERDIN (ILVL,ILVL)
          ILVL=MAX(1,MIN(5,ILVL))
          GO TO 104
C
C "M" command ("Move center point").
C
        ELSE IF (COMD.EQ.'M'.OR.COMD.EQ.'m') THEN
          PRINT * , Q
          PRINT * , 'Move map center to a specified new position.',Q
          PRINT * , Q
          PRINT * , 'Enter one of the following:',Q
          PRINT * , Q
          PRINT * , '  C => Coordinate-specified position',Q
          PRINT * , '  L => Left from the current position',Q
          PRINT * , '  R => Right from the current position',Q
          PRINT * , '  D => Down from the current position',Q
          PRINT * , '  U => Up from the current position',Q
          PRINT * , Q
          PRINT * , '  P => Point currently picked',Q
          PRINT * , '  F => Forward along the picked edge',Q
          PRINT * , '  B => Backward along the picked edge',Q
          PRINT * , '  S => Starting point of picked edge',Q
          PRINT * , '  E => Ending point of picked edge',Q
          PRINT * , Q
          PRINT * , '  M => next Marked error position (if any)',Q
          PRINT * , '  A => specified Area',Q
          PRINT * , Q
          PRINT * , '  Q => Quick mode',Q
          PRINT * , Q
          PRINT * , '  V => change associated Variables',Q
          PRINT * , Q
          PRINT * , '  integer [0-9] => modifier for what follows',Q
          NUMB=0
  122     CALL GTCHAR (COMD)
          IF      (ICHAR(COMD).GE.ICHAR('0').AND.
     +             ICHAR(COMD).LE.ICHAR('9')) THEN
            NUMB=ICHAR(COMD)-ICHAR('0')
            GO TO 122
          ELSE IF (COMD.EQ.'A'.OR.COMD.EQ.'a') THEN
            PRINT * , Q
            PRINT * , 'Enter one of the following:',Q
            PRINT * , Q
            PRINT * , '  I => Index of desired area',Q
            PRINT * , '  N => Name of desired area',Q
            PRINT * , Q
            CALL GTCHAR (COMD)
            IF (COMD.EQ.'I'.OR.COMD.EQ.'i') THEN
              PRINT * , Q
              PRINT * , 'Enter index of area you want to see:',Q
              CALL DERDIN (ITMP,985)
              ITMP=MOD(ABS(ITMP)+MNAI-1,MNAI)+1
              IF (IATY(ITMP).NE.0) GO TO 243
            ELSE IF (COMD.EQ.'N'.OR.COMD.EQ.'n') THEN
              PRINT * , Q
              PRINT * , 'Enter name of area you want to see:',Q
              CALL GTCHRS (NSCR,64)
              IF (NSCR.EQ.' ') GO TO 114
              DO 242 I=1,MNAI
                IF (NUMB.NE.0.AND.IATY(I).NE.NUMB) GO TO 242
                IF (NAME(I).EQ.NSCR) THEN
                  TNM1=NAME(I)
                  ITMP=IPAR(I)
                  ICNT=0
  247             IF (ITMP.NE.0) THEN
                    LNAM=MPILNB(NAME(ITMP))
                    TNM2=NAME(ITMP)(1:LNAM)//' - '//TNM1
                    TNM1=TNM2
                    ITMP=IPAR(ITMP)
                    ICNT=ICNT+1
                    IF (ICNT.LT.10) GO TO 247
                  END IF
                  PRINT * , Q
                  PRINT * , 'Area found - definition is as follows:',Q
                  PRINT * , Q
                  PRINT * , '  Index:     ',I,Q
                  PRINT * , Q
                  PRINT * , '  Type:      ',IATY(I),Q
                  PRINT * , '  Color:     ',ISCI(I),Q
                  PRINT * , '  Parent:    ',IPAR(I),Q
                  PRINT * , '  Full name: ',TNM1(1:MPILNB(TNM1)),Q
                  PRINT * , Q
                  PRINT * , 'Is this the area you want (Y/N)?',Q
                  CALL GTCHAR (COMD)
                  IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                    ITMP=I
                    GO TO 243
                  END IF
                END IF
  242         CONTINUE
            ELSE
              GO TO 114
            END IF
            PRINT * , Q
            PRINT * , 'Area not found.',Q
            GO TO 114
  243       AXMN= 1.E36
            AXMX=-1.E36
            AYMN= 1.E36
            AYMX=-1.E36
            DO 245 IOES=1,NOES
              IF (ISPOAI(IAIL(IOES),ITMP).NE.0.OR.
     +            ISPOAI(IAIR(IOES),ITMP).NE.0) THEN
                DO 244 I=IOFP(IOES),IOLP(IOES)
                  AXMN=MIN(AXMN,XCRD(I))
                  AXMX=MAX(AXMX,XCRD(I))
                  AYMN=MIN(AYMN,YCRD(I))
                  AYMX=MAX(AYMX,YCRD(I))
  244           CONTINUE
              END IF
  245       CONTINUE
            IF (AXMN.LT.AXMX.AND.AYMN.LT.AYMX) THEN
              XCEN=.5*(AXMN+AXMX)
              YCEN=.5*(AYMN+AYMX)
              RNGE=1.01*MAX(AXMX-AXMN,AYMX-AYMN)
            END IF
            GO TO 104
          ELSE IF (COMD.EQ.'B'.OR.COMD.EQ.'b') THEN
            IF (IOEP.NE.0) THEN
              IOPP=IOPP-MAX(1,NUMB)
              IF (IOPP.LT.0) IOPP=IOLP(IOEP)-IOFP(IOEP)
              XCEN=XCRD(IOFP(IOEP)+IOPP)
              YCEN=YCRD(IOFP(IOEP)+IOPP)
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'C'.OR.COMD.EQ.'c') THEN
            PRINT * , 'Enter latitude of center position:',Q
            CALL DERDRN (YCEN,YCEN)
            PRINT * , 'Enter longitude of center position:',Q
            CALL DERDRN (XCEN,XCEN)
            GO TO 104
          ELSE IF (COMD.EQ.'D'.OR.COMD.EQ.'d') THEN
            YCEN=YCEN-RNGE/2.**(NUMB+1)
            GO TO 104
          ELSE IF (COMD.EQ.'E'.OR.COMD.EQ.'e') THEN
            IF (IOEP.NE.0) THEN
              IOPP=IOLP(IOEP)-IOFP(IOEP)
              XCEN=XCRD(IOFP(IOEP)+IOPP)
              YCEN=YCRD(IOFP(IOEP)+IOPP)
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'F'.OR.COMD.EQ.'f') THEN
            IF (IOEP.NE.0) THEN
              IOPP=IOPP+MAX(1,NUMB)
              IF (IOPP.GT.IOLP(IOEP)-IOFP(IOEP)) IOPP=0
              XCEN=XCRD(IOFP(IOEP)+IOPP)
              YCEN=YCRD(IOFP(IOEP)+IOPP)
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'L'.OR.COMD.EQ.'l') THEN
            XCEN=XCEN-RNGE/2.**(NUMB+1)
            GO TO 104
          ELSE IF (COMD.EQ.'M'.OR.COMD.EQ.'m') THEN
            IF (NMRK.NE.0) THEN
              IMRK=MOD(IMRK,NMRK)+1
              XCEN=XMRK(IMRK)
              YCEN=YMRK(IMRK)
              DMIN=1.E36
              IOEP=0
              IOPP=0
              DO 174 IOES=1,NOES
                DO 173 I=0,IOLP(IOES)-IOFP(IOES)
                  IF (XCRD(IOFP(IOES)+I).GE.XCEN-RNGE/2..AND.
     +                XCRD(IOFP(IOES)+I).LE.XCEN+RNGE/2..AND.
     +                YCRD(IOFP(IOES)+I).GE.YCEN-RNGE/2..AND.
     +                YCRD(IOFP(IOES)+I).LE.YCEN+RNGE/2.) THEN
                    DSQR=(XCRD(IOFP(IOES)+I)-XCEN)**2+
     +                   (YCRD(IOFP(IOES)+I)-YCEN)**2
                    IF (DSQR.LT.DMIN) THEN
                      DMIN=DSQR
                      IOEP=IOES
                      IOPP=I
                    END IF
                  END IF
  173           CONTINUE
  174         CONTINUE
              PRINT * , Q
              PRINT * , 'Number of marked points:  ',NMRK,Q
              PRINT * , 'Now viewing point number: ',IMRK,Q
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'P'.OR.COMD.EQ.'p') THEN
            IF (IOEP.NE.0) THEN
              XCEN=XCRD(IOFP(IOEP)+IOPP)
              YCEN=YCRD(IOFP(IOEP)+IOPP)
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'Q'.OR.COMD.EQ.'q') THEN
            PRINT * , Q
            PRINT * , 'In quick mode, the display does not update',Q
            PRINT * , 'completely when a command is typed; instead, a',Q
            PRINT * , 'partial update, with overlaid dots and lines,',Q
            PRINT * , 'show the effects of the command.',Q
            PRINT * , Q
            PRINT * , 'Quick mode can be used in one of two ways:',Q
            PRINT * , Q
            PRINT * , '1) If no on-screen picked point P exists when',Q
            PRINT * , 'quick mode is entered, the following commands',Q
            PRINT * , 'may be used to move C around on the display',Q
            PRINT * , 'and pick one.',Q
            PRINT * , Q
            PRINT * , '  integer [0-9] => modifies what follows',Q
            PRINT * , '  L/R/D/U => Move C Left/Right/Down/Up',Q
            PRINT * , '  P => Pick data point nearest C = P',Q
            PRINT * , '  C => Create a new line starting at C',Q
            PRINT * , Q
            PRINT * , 'More than one "P" may be issued, but "C" can',Q
            PRINT * , 'only be used once.',Q
            PRINT * , Q
            PRINT * , '2) Once a point P is picked, either because',Q
            PRINT * , 'it was picked when quick mode was entered or',Q
            PRINT * , 'because a P or C command is used, then the',Q
            PRINT * , 'following commands may be used to move C to',Q
            PRINT * , 'a desired position relative to P, and then to',Q
            PRINT * , 'insert or delete points on the picked line.',Q
            PRINT * , Q
            PRINT * , '  integer [0-9] => modifies what follows',Q
            PRINT * , '  F/B/L/R => Forward/Backward/Left/Right',Q
            PRINT * , '  I => Insert C after P; move C forward',Q
            PRINT * , '  D => Delete point following P in line',Q
            PRINT * , '  U => Undo immediately preceding "D" command',Q
            PRINT * , Q
            PRINT * , 'In either case, typing a "return" terminates',Q
            PRINT * , 'quick mode.',Q
            PRINT * , Q
            PRINT * , 'The "picked" point P, if any, is marked with a',Q
            PRINT * , 'blue dot, the "center point" C with a red one.',Q
            PRINT * , 'If the blue dot is not visible, it is probably',Q
            PRINT * , 'under the red one.',Q
            PRINT * , Q
            PRINT * , 'Begin entering commands now:',Q
            XCES=XCEN
            YCES=YCEN
            MODE=0
            IDEL=0
            IPCK=0
            IF (IOEP.NE.0) THEN
              IF (XCRD(IOFP(IOEP)+IOPP).GE.XCES-RNGE/2..AND.
     +            XCRD(IOFP(IOEP)+IOPP).LE.XCES+RNGE/2..AND.
     +            YCRD(IOFP(IOEP)+IOPP).GE.YCES-RNGE/2..AND.
     +            YCRD(IOFP(IOEP)+IOPP).LE.YCES+RNGE/2.) THEN
                MODE=1
                IPCK=1
                XPCK=XCRD(IOFP(IOEP)+IOPP)
                YPCK=YCRD(IOFP(IOEP)+IOPP)
                STEP=DLES
                DOFS=0.
                IF (IOPP.NE.0) THEN
                  IF (XCRD(IOFP(IOEP)+IOPP).NE.
     +                XCRD(IOFP(IOEP)+IOPP-1).OR.
     +                YCRD(IOFP(IOEP)+IOPP).NE.
     +                YCRD(IOFP(IOEP)+IOPP-1)) THEN
                    DOFS=RTOD*ATAN2(YCRD(IOFP(IOEP)+IOPP)-
     +                              YCRD(IOFP(IOEP)+IOPP-1),
     +                              XCRD(IOFP(IOEP)+IOPP)-
     +                              XCRD(IOFP(IOEP)+IOPP-1))
                  END IF
                END IF
                XCEN=XPCK+STEP*COS(DTOR*DOFS)/COS(DTOR*YCEN)
                YCEN=YPCK+STEP*SIN(DTOR*DOFS)
              END IF
            END IF
  340       CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (0)
            IF (IPCK.NE.0) THEN
              CALL GSFACI (3)
              CALL CIRCLE (XPCK,YPCK,-DSZE)
              CALL CIRCLE (XPCK,YPCK,+DSZE)
              XPCL=XPCK
              YPCL=YPCK
            END IF
            CALL GSFACI (4)
            CALL CIRCLE (XCEN,YCEN,-DSZE)
            CALL CIRCLE (XCEN,YCEN,+DSZE)
            XCEL=XCEN
            YCEL=YCEN
            CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (1)
            CALL GSFACI (1)
            CALL SFLUSH
            CALL GUWK (1,0)
            NUMB=0
  341       CALL GTCHR1 (COMD)
            IF (COMD.NE.'U'.AND.COMD.NE.'u') IDEL=0
            IF ((COMD.EQ.'C'.OR.COMD.EQ.'c'.OR.
     +           COMD.EQ.'P'.OR.COMD.EQ.'p').AND.
     +           MODE.LE.1.AND.IOEP.NE.0) THEN
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (ICOL(1+MAX(0,MIN(5,ILTY(IOEP)))))
              CALL GSLWSC (2.)
              CALL FRSTPT (XCRD(IOFP(IOEP)),YCRD(IOFP(IOEP)))
              DO 364 I=1,IOLP(IOEP)-IOFP(IOEP)
                CALL VECTOR (XCRD(IOFP(IOEP)+I),YCRD(IOFP(IOEP)+I))
  364         CONTINUE
              CALL PLOTIF (0.,0.,2)
              CALL GSLWSC (1.)
              CALL GSPLCI (1)
              IF ((COMD.EQ.'C'.OR.COMD.EQ.'c').AND.
     +          IOPP.NE.0.AND.IOPP.NE.IOLP(IOEP)-IOFP(IOEP)) THEN
                IF (NOES.LT.MNES.AND.NOEP.LT.MNEP) THEN
                  NOEP=NOEP+1
                  DO 357 I=NOEP,IOFP(IOEP)+IOPP+1,-1
                    XCRD(I)=XCRD(I-1)
                    YCRD(I)=YCRD(I-1)
  357             CONTINUE
                  NOES=NOES+1
                  DO 358 IOES=NOES,IOEP+1,-1
                    IOFP(IOES)=IOFP(IOES-1)+1
                    IOLP(IOES)=IOLP(IOES-1)+1
                    ILTY(IOES)=ILTY(IOES-1)
                    IAIL(IOES)=IAIL(IOES-1)
                    IAIR(IOES)=IAIR(IOES-1)
  358             CONTINUE
                  IOLP(IOEP  )=IOFP(IOEP)+IOPP
                  IOFP(IOEP+1)=IOFP(IOEP)+IOPP+1
                END IF
              END IF
            END IF
            IF      (ICHAR(COMD).GE.ICHAR('0').AND.
     +               ICHAR(COMD).LE.ICHAR('9')) THEN
              NUMB=ICHAR(COMD)-ICHAR('0')
              GO TO 341
            ELSE IF (COMD.EQ.'B'.OR.COMD.EQ.'b') THEN
              IF (MODE.GE.1) THEN
                STEP=STEP-DLES/2.**NUMB
              END IF
            ELSE IF (COMD.EQ.'C'.OR.COMD.EQ.'c') THEN
              IF (MODE.LE.1) THEN
                IF (IPCK.NE.0) THEN
                  XCEN=XPCK
                  YCEN=YPCK
                END IF
                IF (NOES.LT.MNES.AND.NOEP.LT.MNEP) THEN
                  DO 348 I=1,MNAI
                    IF (NAME(I).EQ.'Unidentified Area') THEN
                      IOUA=I
                      GO TO 350
                    END IF
  348             CONTINUE
                  DO 349 I=1,MNAI
                    IF (IATY(I).EQ.0) THEN
                      IATY(I)=1
                      ISCI(I)=8
                      IPAR(I)=0
                      NAME(I)='Unidentified Area'
                      IOUA=I
                      GO TO 350
                    END IF
  349             CONTINUE
                  PRINT * , Q
                  PRINT * , Q
                  PRINT * , 'Limits exceeded!',Q
                  GO TO 104
  350             NOEP=NOEP+1
                  XCRD(NOEP)=XCEN
                  YCRD(NOEP)=YCEN
                  NOES=NOES+1
                  IOFP(NOES)=NOEP
                  IOLP(NOES)=NOEP
                  ILTY(NOES)=0
                  IAIL(NOES)=IOUA
                  IAIR(NOES)=IOUA
                  IOEP=NOES
                  IOPP=0
                  MODE=2
                  IF (IPCK.EQ.0) THEN
                    XPCL=XCEN
                    YPCL=YCEN
                  END IF
                  IPCK=1
                  XPCK=XCEN
                  YPCK=YCEN
                  STEP=DLES
                  DOFS=0.
                ELSE
                  PRINT * , Q
                  PRINT * , Q
                  PRINT * , 'Limits exceeded!',Q
                  GO TO 104
                END IF
              END IF
            ELSE IF (COMD.EQ.'D'.OR.COMD.EQ.'d') THEN
              IF (MODE.EQ.0) THEN
                YCEN=YCEN-RNGE/2.**(NUMB+1)
              ELSE
                IF (IOPP.NE.IOLP(IOEP)-IOFP(IOEP)) THEN
                  IDEL=1
                  XDEL=XCRD(IOFP(IOEP)+IOPP+1)
                  YDEL=YCRD(IOFP(IOEP)+IOPP+1)
                  NOEP=NOEP-1
                  DO 353 I=IOFP(IOEP)+IOPP+1,NOEP
                    XCRD(I)=XCRD(I+1)
                    YCRD(I)=YCRD(I+1)
  353             CONTINUE
                  IOLP(IOEP)=IOLP(IOEP)-1
                  DO 354 IOES=IOEP+1,NOES
                    IOFP(IOES)=IOFP(IOES)-1
                    IOLP(IOES)=IOLP(IOES)-1
  354             CONTINUE
                  CALL GSFACI (0)
                  CALL CIRCLE (XDEL,YDEL,-DSZE)
                  CALL GSFACI (1)
                END IF
              END IF
            ELSE IF (COMD.EQ.'F'.OR.COMD.EQ.'f') THEN
              IF (MODE.GE.1) THEN
                STEP=STEP+DLES/2.**NUMB
              END IF
            ELSE IF (COMD.EQ.'I'.OR.COMD.EQ.'i') THEN
              IF (MODE.GE.1) THEN
                MODE=2
                IF (NOEP.GE.MNEP) THEN
                  PRINT * , Q
                  PRINT * , Q
                  PRINT * , 'Too many points.',Q
                  GO TO 104
                ELSE IF (XCRD(IOFP(IOEP)+IOPP).NE.XCEN.OR.
     +                   YCRD(IOFP(IOEP)+IOPP).NE.YCEN) THEN
                  NOEP=NOEP+1
                  DO 351 I=NOEP,IOFP(IOEP)+IOPP+2,-1
                    XCRD(I)=XCRD(I-1)
                    YCRD(I)=YCRD(I-1)
  351             CONTINUE
                  IOLP(IOEP)=IOLP(IOEP)+1
                  DO 352 IOES=IOEP+1,NOES
                    IOFP(IOES)=IOFP(IOES)+1
                    IOLP(IOES)=IOLP(IOES)+1
  352             CONTINUE
                  XCRD(IOFP(IOEP)+IOPP+1)=XCEN
                  YCRD(IOFP(IOEP)+IOPP+1)=YCEN
                  IOPP=IOPP+1
                  XPCK=XCEN
                  YPCK=YCEN
                  STEP=DLES
                END IF
              END IF
            ELSE IF (COMD.EQ.'L'.OR.COMD.EQ.'l') THEN
              IF (MODE.EQ.0) THEN
                XCEN=XCEN-RNGE/2.**(NUMB+1)
              ELSE
                DOFS=MOD(DOFS+90./2.**(NUMB+1),360.)
              END IF
            ELSE IF (COMD.EQ.'P'.OR.COMD.EQ.'p') THEN
              IF (MODE.LE.1) THEN
                IF (MODE.EQ.1) THEN
                  XCEN=XPCK
                  YCEN=YPCK
                END IF
                DMIN=1.E36
                IOAP=0
                IOEP=0
                IOPP=0
                DO 347 IOES=1,NOES
                  DO 346 I=0,IOLP(IOES)-IOFP(IOES)
                    IF (XCRD(IOFP(IOES)+I).GE.XCES-RNGE/2..AND.
     +                  XCRD(IOFP(IOES)+I).LE.XCES+RNGE/2..AND.
     +                  YCRD(IOFP(IOES)+I).GE.YCES-RNGE/2..AND.
     +                  YCRD(IOFP(IOES)+I).LE.YCES+RNGE/2.) THEN
                      DSQR=(XCRD(IOFP(IOES)+I)-XCEN)**2+
     +                     (YCRD(IOFP(IOES)+I)-YCEN)**2
                      IF (DSQR.LT.DMIN) THEN
                        DMIN=DSQR
                        IOEP=IOES
                        IOPP=I
                        NUMT=NUMB
                      ELSE IF (DSQR.EQ.DMIN) THEN
                        IF (NUMT.GT.0) THEN
                          NUMT=NUMT-1
                          IOEP=IOES
                          IOPP=I
                        END IF
                      END IF
                    END IF
  346             CONTINUE
  347           CONTINUE
                IF (IOEP.NE.0) THEN
                  IPCK=1
                  XPCK=XCRD(IOFP(IOEP)+IOPP)
                  YPCK=YCRD(IOFP(IOEP)+IOPP)
                  STEP=DLES
                  IF (IOPP.NE.0) THEN
                    IF (XCRD(IOFP(IOEP)+IOPP).NE.
     +                  XCRD(IOFP(IOEP)+IOPP-1).OR.
     +                  YCRD(IOFP(IOEP)+IOPP).NE.
     +                  YCRD(IOFP(IOEP)+IOPP-1)) THEN
                      DOFS=RTOD*ATAN2(YCRD(IOFP(IOEP)+IOPP)-
     +                                YCRD(IOFP(IOEP)+IOPP-1),
     +                                XCRD(IOFP(IOEP)+IOPP)-
     +                                XCRD(IOFP(IOEP)+IOPP-1))
                    ELSE
                      DOFS=0.
                    END IF
                  ELSE
                    DOFS=0.
                  END IF
                  MODE=1
                  XPCL=XPCK
                  YPCL=YPCK
                  IOP1=MAX(IOFP(IOEP),MIN(IOLP(IOEP),IOFP(IOEP)+IOPP-1))
                  IOP2=MAX(IOFP(IOEP),MIN(IOLP(IOEP),IOFP(IOEP)+IOPP+1))
                  IF (XCRD(IOP1).NE.XCRD(IOP2).OR.
     +                YCRD(IOP1).NE.YCRD(IOP2)) THEN
                    IF (SIDE(XCRD(IOP1),YCRD(IOP1),
     +                       XCRD(IOP2),YCRD(IOP2),
     +                       XCEN,YCEN).GT.0.) THEN
                      IOAP=IAIL(IOEP)
                    ELSE
                      IOAP=IAIR(IOEP)
                    END IF
                  END IF
                END IF
              END IF
            ELSE IF (COMD.EQ.'R'.OR.COMD.EQ.'r') THEN
              IF (MODE.EQ.0) THEN
                XCEN=XCEN+RNGE/2.**(NUMB+1)
              ELSE
                DOFS=MOD(DOFS+360.-90./2.**(NUMB+1),360.)
              END IF
            ELSE IF (COMD.EQ.'U'.OR.COMD.EQ.'u') THEN
              IF (MODE.EQ.0) THEN
                YCEN=YCEN+RNGE/2.**(NUMB+1)
              ELSE
                IF (IDEL.NE.0) THEN
                  NOEP=NOEP+1
                  DO 355 I=NOEP,IOFP(IOEP)+IOPP+2,-1
                    XCRD(I)=XCRD(I-1)
                    YCRD(I)=YCRD(I-1)
  355             CONTINUE
                  IOLP(IOEP)=IOLP(IOEP)+1
                  DO 356 IOES=IOEP+1,NOES
                    IOFP(IOES)=IOFP(IOES)+1
                    IOLP(IOES)=IOLP(IOES)+1
  356             CONTINUE
                  XCRD(IOFP(IOEP)+IOPP+1)=XDEL
                  YCRD(IOFP(IOEP)+IOPP+1)=YDEL
                  CALL CIRCLE (XDEL,YDEL,-DSZE)
                  IDEL=0
                END IF
              END IF
            ELSE IF (COMD.EQ.CHAR(13)) THEN
              IF (IPCK.NE.0) THEN
                XCEN=XPCK
                YCEN=YPCK
              END IF
              GO TO 104
            ELSE
              GO TO 341
            END IF
            IF (MODE.GE.1) THEN
              XCEN=XPCK+STEP*COS(DTOR*DOFS)/COS(DTOR*YCEN)
              YCEN=YPCK+STEP*SIN(DTOR*DOFS)
            END IF
            XCEN=MAX(XCES-RNGE/2.,MIN(XCES+RNGE/2.,XCEN))
            YCEN=MAX(YCES-RNGE/2.,MIN(YCES+RNGE/2.,YCEN))
            RXMN=MIN(XCEN,XCEL)
            RXMX=MAX(XCEN,XCEL)
            RYMN=MIN(YCEN,YCEL)
            RYMX=MAX(YCEN,YCEL)
            IF (IPCK.NE.0) THEN
              RXMN=MIN(RXMN,XPCK)
              RXMX=MAX(RXMX,XPCK)
              RYMN=MIN(RYMN,YPCK)
              RYMX=MAX(RYMX,YPCK)
              RXMN=MIN(RXMN,XPCL)
              RXMX=MAX(RXMX,XPCL)
              RYMN=MIN(RYMN,YPCL)
              RYMX=MAX(RYMX,YPCL)
            END IF
            IF (IDEL.NE.0) THEN
              RXMN=MIN(RXMN,XDEL)
              RXMX=MAX(RXMX,XDEL)
              RYMN=MIN(RYMN,YDEL)
              RYMX=MAX(RYMX,YDEL)
            END IF
            RXMN=MAX(XCES-RNGE/2.,CFUX(CUFX(RXMN)-DSZE))
            RXMX=MIN(XCES+RNGE/2.,CFUX(CUFX(RXMX)+DSZE))
            RYMN=MAX(YCES-RNGE/2.,CFUY(CUFY(RYMN)-DSZE))
            RYMX=MIN(YCES+RNGE/2.,CFUY(CUFY(RYMX)+DSZE))
            WXMN=CUFX(RXMN)
            WXMX=CUFX(RXMX)
            WYMN=CUFY(RYMN)
            WYMX=CUFY(RYMX)
            IF (IPBG.NE.1) THEN
              CALL BLNKIT (RXMN,RXMX,RYMN,RYMX)
            ELSE
              CALL MAPROJ (PTYP,PLAT,PLON,ROTA)
              IF (PTYP.EQ.'SV') THEN
                CALL MPSETR ('SA',SALT)
                CALL MPSETR ('S1',SAN1)
                CALL MPSETR ('S2',SAN2)
              END IF
              CALL MAPSET (LTYP,PLM1,PLM2,PLM3,PLM4)
              CALL MAPINT
              IF (NERRO(ITMP).NE.0) THEN
                PRINT * , Q
                CALL EPRIN
                PRINT * , Q
                CALL ERROF
                GO TO 362
              END IF
              CALL GETSET (XVPL,XVPR,YVPB,YVPT,XWDL,XWDR,YWDB,YWDT,LNLG)
              JCI1=MAX(1,MIN(ICAD,
     +                 INT(((RXMN-(XCES-RNGE/2.))/RNGE)*REAL(ICAD)) ))
              JCI2=MAX(1,MIN(ICAD,2+
     +                 INT(((RXMX-(XCES-RNGE/2.))/RNGE)*REAL(ICAD)) ))
              JCJ1=MAX(1,MIN(ICAD,
     +                 INT(((RYMN-(YCES-RNGE/2.))/RNGE)*REAL(ICAD)) ))
              JCJ2=MAX(1,MIN(ICAD,2+
     +                 INT(((RYMX-(YCES-RNGE/2.))/RNGE)*REAL(ICAD)) ))
              K=1
              JCAN=(JCJ2-JCJ1+1)*(JCI2-JCI1+1)
              DO 361 JCAI=1,JCAN
                I=JCI1+MOD(JCAI-1,JCI2-JCI1+1)
                J=JCJ1+(JCAI-1)/(JCI2-JCI1+1)
                XCOC=(.5+REAL(I-1))/REAL(ICAD)
                YCOC=(.5+REAL(J-1))/REAL(ICAD)
                RLON=XCES+RNGE*(XCOC-.5)
                RLAT=YCES+RNGE*(YCOC-.5)
                IF (RLON.LT.-180..OR.RLON.GT.+180..OR.
     +              RLAT.LT. -90..OR.RLAT.GT. +90.) THEN
                  ICRA(JCAI)=34
                ELSE
                  CALL MAPTRA (RLAT,RLON,XCOP,YCOP)
                  IF (XCOP.EQ.OORV) THEN
                    ICRA(JCAI)=35
                  ELSE
                    XOTP=((XCOP-XWDL)/(XWDR-XWDL))*REAL(MGSV)
                    YOTP=((YCOP-YWDB)/(YWDT-YWDB))*REAL(NGSV)
                    IF (NINP.EQ.0) THEN
                      IGSV=MAX(1,MIN(MGSV,1+INT(XOTP)))
                      JGSV=MAX(1,MIN(NGSV,1+INT(YOTP)))
                    ELSE IF (NINP.GT.0) THEN
                      CALL IDBVIP (K,NINP,XINP,YINP,ZIXO,
     +                             1,XOTP,YOTP,ZOXO,IWRK,FWRK)
                      CALL IDBVIP (3,NINP,XINP,YINP,ZIYO,
     +                             1,XOTP,YOTP,ZOYO,IWRK,FWRK)
                      K=2
                      IGSV=MAX(1,MIN(MGSV,1+INT(XOTP+ZOXO)))
                      JGSV=MAX(1,MIN(NGSV,1+INT(YOTP+ZOYO)))
                    ELSE
                      XTMP=((XCOP-XWDL)/(XWDR-XWDL))*REAL(MCFM)
                      YTMP=((YCOP-YWDB)/(YWDT-YWDB))*REAL(NCFM)
                      ITMP=MAX(1,MIN(MCFM,1+INT(XTMP)))
                      JTMP=MAX(1,MIN(NCFM,1+INT(YTMP)))
                      XTMP=XTMP-REAL(ITMP)
                      YTMP=YTMP-REAL(JTMP)
                      ZOXO=(1.-YTMP)*((1.-XTMP)*ZCFX(ITMP  ,JTMP  )+
     +                                    XTMP *ZCFX(ITMP+1,JTMP  ))
     +                       + YTMP *((1.-XTMP)*ZCFX(ITMP  ,JTMP+1)+
     +                                    XTMP *ZCFX(ITMP+1,JTMP+1))
                      ZOYO=(1.-YTMP)*((1.-XTMP)*ZCFY(ITMP  ,JTMP  )+
     +                                    XTMP *ZCFY(ITMP+1,JTMP  ))
     +                       + YTMP *((1.-XTMP)*ZCFY(ITMP  ,JTMP+1)+
     +                                    XTMP *ZCFY(ITMP+1,JTMP+1))
                      IGSV=MAX(1,MIN(MGSV,1+INT(XOTP+ZOXO)))
                      JGSV=MAX(1,MIN(NGSV,1+INT(YOTP+ZOYO)))
                    END IF
                    ICRA(JCAI)=36+INT(128.*GSVALU(IGSV,JGSV))
                  END IF
                END IF
  361         CONTINUE
              CALL SET (.1,.9,.1,.9,0.,REAL(ICAD),0.,REAL(ICAD),1)
              CALL GCA (REAL(JCI1-1),REAL(JCJ1-1),
     +                  REAL(JCI2  ),REAL(JCJ2  ),
     +                  JCI2-JCI1+1,JCJ2-JCJ1+1,1,1,
     +                  JCI2-JCI1+1,JCJ2-JCJ1+1,ICRA)
  362         CALL SET (.1,.9,.1,.9,XCES-RNGE/2.,XCES+RNGE/2.,
     +                              YCES-RNGE/2.,YCES+RNGE/2.,1)
              WXMN=.10
              WXMX=.90
              WYMN=.10
              WYMX=.90
            END IF
            CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (6)
            CALL GSLWSC (2.)
            CALL FRSTPT (XCRD(IOFP(IOEP)),YCRD(IOFP(IOEP)))
            DO 363 I=1,IOLP(IOEP)-IOFP(IOEP)
              CALL VECTOR (XCRD(IOFP(IOEP)+I),YCRD(IOFP(IOEP)+I))
  363       CONTINUE
            CALL PLOTIF (0.,0.,2)
            CALL GSLWSC (1.)
            CALL GSPLCI (1)
            GO TO 340
          ELSE IF (COMD.EQ.'R'.OR.COMD.EQ.'r') THEN
            XCEN=XCEN+RNGE/2.**(NUMB+1)
            GO TO 104
          ELSE IF (COMD.EQ.'S'.OR.COMD.EQ.'s') THEN
            IF (IOEP.NE.0) THEN
              IOPP=0
              XCEN=XCRD(IOFP(IOEP)+IOPP)
              YCEN=YCRD(IOFP(IOEP)+IOPP)
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'U'.OR.COMD.EQ.'u') THEN
            YCEN=YCEN+RNGE/2.**(NUMB+1)
            GO TO 104
          ELSE IF (COMD.EQ.'V'.OR.COMD.EQ.'v') THEN
            PRINT * , Q
            PRINT * , 'Change move/positioning Variables.',Q
            PRINT * , Q
            PRINT * , '  Latitude at center of map:        ',YCEN,Q
            PRINT * , '  Longitude at center of map:       ',XCEN,Q
            PRINT * , '  Range (left/right or bottom/top): ',RNGE,Q
            PRINT * , '  Desired length of edge segments:  ',DLES,Q
            PRINT * , '  Quick mode dot size (radius):     ',DSZE,Q
            PRINT * , Q
            PRINT * , 'Enter new center latitude (in degrees):',Q
            CALL DERDRN (YCEN,YCEN)
            PRINT * , 'Enter new center longitude (in degrees):',Q
            CALL DERDRN (XCEN,XCEN)
            PRINT * , 'Enter new range (in degrees):',Q
            CALL DERDRN (RNGE,RNGE)
            PRINT * , 'Enter new desired length of edge segments:',Q
            CALL DERDRN (DLES,DLES)
            PRINT * , 'Enter new quick mode dot size (radius):',Q
            CALL DERDRN (DSZE,DSZE)
            GO TO 104
          END IF
C
C "N" command ("write a frame to the NCGM").
C
        ELSE IF (COMD.EQ.'N'.OR.COMD.EQ.'n') THEN
          PRINT * , Q
          PRINT * , 'Write frame to an NCGM.',Q
          NCGM=1
          GO TO 104
C
C "O" commmand ("Output edges to a named file").
C
        ELSE IF (COMD.EQ.'O'.OR.COMD.EQ.'o') THEN
          PRINT * , Q
          PRINT * , 'Write windowed edge segments to a user-specified fi
     +le.',Q
          PRINT * , Q
          PRINT * , 'Enter the name of the file:',Q
          CALL GTCHRS (FNMN,64)
          IF (FNMN.EQ.' ') GO TO 114
          PRINT * , Q
          PRINT * , 'Write a map file to be used with Vis5D?',Q
          CALL GTCHAR (COMD)
          IF (COMD.NE.'Y'.AND.COMD.NE.'y') THEN
            PRINT * , Q
            PRINT * , 'No.  A simple ASCII file will be written.',Q
            OPEN (14,FILE=FNMN(1:MPILNB(FNMN)),STATUS='NEW',
     +                                         FORM='FORMATTED',ERR=250)
            NOSW=0
            WRITE (14,'('' '')')
            WRITE (14,'(''Frame parameters for this file:'')')
            WRITE (14,'('' '')')
            WRITE (14,'(F12.6,'' (left edge of frame)  '')')XCEN-RNGE/2.
            WRITE (14,'(F12.6,'' (right edge of frame) '')')XCEN+RNGE/2.
            WRITE (14,'(F12.6,'' (bottom edge of frame)'')')YCEN-RNGE/2.
            WRITE (14,'(F12.6,'' (top edge of frame)   '')')YCEN+RNGE/2.
            DO 249 IOES=1,NOES
              IOAL=IOAREA(ILVL,IAIL(IOES))
              IOAR=IOAREA(ILVL,IAIR(IOES))
              IF (IOAL.NE.IOAR) THEN
                TNM1=NAME(IOAL)
                ITMP=IPAR(IOAL)
                ICNT=0
  251           IF (ITMP.NE.0) THEN
                  TNM2=TNM1(1:MPILNB(TNM1))//' < '//NAME(ITMP)
                  TNM1=TNM2
                  ITMP=IPAR(ITMP)
                  ICNT=ICNT+1
                  IF (ICNT.LT.10) GO TO 251
                END IF
                NAML=TNM1
                TNM1=NAME(IOAR)
                ITMP=IPAR(IOAR)
                ICNT=0
  252           IF (ITMP.NE.0) THEN
                  TNM2=TNM1(1:MPILNB(TNM1))//' < '//NAME(ITMP)
                  TNM1=TNM2
                  ITMP=IPAR(ITMP)
                  ICNT=ICNT+1
                  IF (ICNT.LT.10) GO TO 252
                END IF
                NAMR=TNM1
                DO 248 I=IOFP(IOES),IOLP(IOES)
                  CALL WLTOAF (CUFX(XCRD(I)),CUFY(YCRD(I)),
     +                         MIN(I-IOFP(IOES),1),ILTY(IOES),IOAL,IOAR,
     +                                       IATY(IOAL),ISCI(IOAL),NAML,
     +                                       IATY(IOAR),ISCI(IOAR),NAMR)
  248           CONTINUE
              END IF
  249       CONTINUE
            PRINT * , Q
            IF (NOSW.NE.0) THEN
              PRINT * , 'Number of edge segments written:',NOSW,Q
              WRITE (14,'('' '')')
            ELSE
              PRINT * , 'No edge segments written.',Q
            END IF
            CLOSE (14)
            GO TO 114
  250       PRINT * , Q
            PRINT * , 'Error opening file.  No edge segments written.',Q
            GO TO 114
          ELSE
            PRINT * , Q
            PRINT * , 'Yes.  A Vis5D map file will be written.',Q
            LFNM=MIN(64,MPILNB(FNMN)+1)
            FNMN(LFNM:LFNM)=CHAR(0)
            CALL NGOFWO (FNMN(1:LFNM),IFDE,ISTA)
            IF (ISTA.NE.0) THEN
              PRINT * , 'Could not open file.',Q
              GO TO 114
            END IF
            DO 276 IPSS=1,3
              NOSS=0
              NOVS=0
              DO 275 IOES=1,NOES
                IOAL=IOAREA(ILVL,IAIL(IOES))
                IOAR=IOAREA(ILVL,IAIR(IOES))
                IF (IOAL.NE.IOAR) THEN
                  DO 274 I=IOFP(IOES),IOLP(IOES)
                    CALL WLTV5D (CUFX(XCRD(I)),CUFY(YCRD(I)),
     +                         MIN(I-IOFP(IOES),1),ILTY(IOES),IOAL,IOAR,
     +                                                        IFDE,IPSS)
  274             CONTINUE
                END IF
  275         CONTINUE
              IF (NOSS.EQ.0) GO TO 277
              IF (IPSS.EQ.1) THEN
                CALL NGWRIN (IFDE,NOSS,1,ISTA)
                IF (ISTA.NE.1) THEN
                  PRINT * , 'Error on write to file.',Q
                END IF
              ELSE IF (IPSS.EQ.2) THEN
                IF (NOSS.GT.0) THEN
                  CALL NGWRIN (IFDE,ISEG,6,ISTA)
                  IF (ISTA.NE.6) THEN
                    PRINT * , 'Error on write to file.',Q
                  END IF
                END IF
              END IF
              NOSW=NOSS
  276       CONTINUE
  277       CALL NGCLFI (IFDE)
            GO TO 114
          END IF
C
C "P" commmand ("Pick a point, an edge, and/or an area").
C
        ELSE IF (COMD.EQ.'P'.OR.COMD.EQ.'p') THEN
          PRINT * , Q
          PRINT * , 'Pick a point, an edge, and an area.',Q
          PRINT * , Q
          PRINT * , 'Enter one of the following:',Q
          PRINT * , Q
          PRINT * , '  A => pick a numbered area',Q
          PRINT * , Q
          PRINT * , '  P => nearest onscreen data point; recenter',Q
          PRINT * , '  N => nearest onscreen data point; no recenter',Q
          PRINT * , Q
          PRINT * , '  F => forward along picked edge; no recenter',Q
          PRINT * , '  B => backward along picked edge; no recenter',Q
          PRINT * , Q
          PRINT * , '  S => starting point of picked edge',Q
          PRINT * , '  E => ending point of picked edge',Q
          PRINT * , Q
          PRINT * , '  O => off (nothing picked)',Q
          PRINT * , Q
          PRINT * , '  integer [0-9] => modifier for what follows',Q
          NUMB=0
  143     CALL GTCHAR (COMD)
          IF (COMD.EQ.'A'.OR.COMD.EQ.'a') THEN
            PRINT * , Q
            PRINT * , 'Enter number of area you want to see:',Q
            CALL DERDIN (IOAP,IOAP)
            GO TO 104
          ELSE IF (COMD.EQ.'N'.OR.COMD.EQ.'n'.OR.
     +             COMD.EQ.'P'.OR.COMD.EQ.'p') THEN
            DMIN=1.E36
            IOAP=0
            IOEP=0
            IOPP=0
            DO 124 IOES=1,NOES
              DO 123 I=0,IOLP(IOES)-IOFP(IOES)
                IF (XCRD(IOFP(IOES)+I).GE.XCEN-RNGE/2..AND.
     +              XCRD(IOFP(IOES)+I).LE.XCEN+RNGE/2..AND.
     +              YCRD(IOFP(IOES)+I).GE.YCEN-RNGE/2..AND.
     +              YCRD(IOFP(IOES)+I).LE.YCEN+RNGE/2.) THEN
                  DSQR=(XCRD(IOFP(IOES)+I)-XCEN)**2+
     +                 (YCRD(IOFP(IOES)+I)-YCEN)**2
                  IF (DSQR.LT.DMIN) THEN
                    DMIN=DSQR
                    IOEP=IOES
                    IOPP=I
                    NUMT=NUMB
                  ELSE IF (DSQR.EQ.DMIN) THEN
                    IF (NUMT.GT.0) THEN
                      NUMT=NUMT-1
                      IOEP=IOES
                      IOPP=I
                    END IF
                  END IF
                END IF
  123         CONTINUE
  124       CONTINUE
            IF (IOEP.NE.0) THEN
              IOP1=MAX(IOFP(IOEP),MIN(IOLP(IOEP),IOFP(IOEP)+IOPP-1))
              IOP2=MAX(IOFP(IOEP),MIN(IOLP(IOEP),IOFP(IOEP)+IOPP+1))
              IF (XCRD(IOP1).NE.XCRD(IOP2).OR.
     +            YCRD(IOP1).NE.YCRD(IOP2)) THEN
                IF (SIDE(XCRD(IOP1),YCRD(IOP1),XCRD(IOP2),YCRD(IOP2),
     +              XCEN,YCEN).GT.0.) THEN
                  IOAP=IAIL(IOEP)
                ELSE
                  IOAP=IAIR(IOEP)
                END IF
              END IF
            END IF
            PRINT * , Q
            PRINT * , 'Index of area picked:  ',IOAP,Q
            PRINT * , 'Index of edge picked:  ',IOEP,Q
            PRINT * , 'Index of point picked: ',IOPP,Q
            IF (COMD.EQ.'P'.OR.COMD.EQ.'p') THEN
              XCEN=XCRD(IOFP(IOEP)+IOPP)
              YCEN=YCRD(IOFP(IOEP)+IOPP)
            END IF
            GO TO 104
          ELSE IF (COMD.EQ.'B'.OR.COMD.EQ.'b') THEN
            IF (IOEP.NE.0) THEN
              IOPP=IOPP-MAX(1,NUMB)
              IF (IOPP.LT.0) IOPP=IOLP(IOEP)-IOFP(IOEP)
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'F'.OR.COMD.EQ.'f') THEN
            IF (IOEP.NE.0) THEN
              IOPP=IOPP+MAX(1,NUMB)
              IF (IOPP.GT.IOLP(IOEP)-IOFP(IOEP)) IOPP=0
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'S'.OR.COMD.EQ.'s') THEN
            IF (IOEP.NE.0) THEN
              IOPP=0
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'E'.OR.COMD.EQ.'e') THEN
            IF (IOEP.NE.0) THEN
              IOPP=IOLP(IOEP)-IOFP(IOEP)
              GO TO 104
            END IF
          ELSE IF (COMD.EQ.'O'.OR.COMD.EQ.'o') THEN
            IOAP=0
            IOEP=0
            IOPP=0
            GO TO 104
          ELSE IF (ICHAR(COMD).GE.ICHAR('0').AND.
     +             ICHAR(COMD).LE.ICHAR('9')) THEN
            NUMB=ICHAR(COMD)-ICHAR('0')
            GO TO 143
          END IF
C
C "Q" command ("Quit").
C
        ELSE IF (COMD.EQ.'Q'.OR.COMD.EQ.'q') THEN
          PRINT * , Q
          PRINT * , 'Do you really want to quit? (y/n)',Q
          PRINT * , '(If so, answer "y".)',Q
          CALL GTCHAR (COMD)
          IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
            IF (IPBG.GE.0) THEN
              PRINT * , Q
              PRINT * , 'Write updated PNG information file? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                OPEN (15,FILE=FNMP(1:ILNB),STATUS='UNKNOWN',
     +                                         FORM='FORMATTED',ERR=335)
                REWIND 15
                WRITE (15,'(''File name:          '',A)') FNMP(1:ILNB-1)
                WRITE (15,'(''Projection:         '',A2,3E14.6)')
     +                                              PTYP,PLAT,PLON,ROTA
                IF (PTYP.EQ.'SV') THEN
                  WRITE (15,'(''Satellite values:     '',3E14.6)')
     +                                                    SALT,SAN1,SAN2
                END IF
                WRITE (15,'(''Limits:             '',A2,4E14.6)')
     +                              LTYP,PLM1(1),PLM2(1),PLM3(1),PLM4(1)
                IF (LTYP.EQ.'PO')
     +          WRITE (15,'(22X,4E14.6)')
     +                                   PLM1(2),PLM2(2),PLM3(2),PLM4(2)
                WRITE (15,'(''Reference points: '',I4)') NPRP
                DO 334 I=1,MPRP
                  IF (IPXL(I).NE.0)
     +              WRITE (15,'(18X,I4,4E14.6)')
     +                                 I,PXLT(I),PXLN(I),PXLX(I),PXLY(I)
  334           CONTINUE
                CLOSE (15)
              END IF
  335         CALL GSVEND
            END IF
            GO TO 998
          END IF
C
C "R" command ("Read data (from background or from file)").
C
        ELSE IF (COMD.EQ.'R'.OR.COMD.EQ.'r') THEN
          PRINT * , Q
          PRINT * , 'Read data.',Q
          PRINT * , Q
          PRINT * , 'Enter one of the following:',Q
          PRINT * , Q
          PRINT * , '  B => select Background segment near center',Q
          PRINT * , '  F => File of ASCII data in particular format',Q
          CALL GTCHAR (COMD)
          IF (COMD.EQ.'B'.OR.COMD.EQ.'b') THEN
            IF (RNGE.GT.10.) THEN
              PRINT * , Q
              PRINT * , 'Viewport range is greater than 10 degrees.',Q
              PRINT * , 'Background reads are not allowed.',Q
              GO TO 114
            END IF
            PRINT * , Q
            PRINT * , 'Select background segment passing near center.',Q
            IFNS=NOES+1
            CALL RNGSGL (0,RWRK,LRWK,DBLE(YCEN-RNGE/2.),
     +                               DBLE(XCEN-RNGE/2.),
     +                               DBLE(YCEN+RNGE/2.),
     +                               DBLE(XCEN+RNGE/2.))
  286       IOES=IFNS-1
            IOEN=0
            DTEN=0.
  279       IF (IOES.LT.NOES) THEN
              IOES=IOES+1
              DO 280 I=IOFP(IOES),IOLP(IOES)
                DTES=SQRT((XCRD(I)-XCEN)**2+(YCRD(I)-YCEN)**2)
                IF (IOEN.EQ.0.OR.DTES.LT.DTEN) THEN
                  IOEN=IOES
                  DTEN=DTES
                END IF
  280         CONTINUE
              GO TO 279
            END IF
            IF (IOEN.NE.0) THEN
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (4)
              CALL GSLWSC (2.)
              CALL FRSTPT (XCRD(IOFP(IOEN)),YCRD(IOFP(IOEN)))
              DO 287 I=IOFP(IOEN)+1,IOLP(IOEN)
                CALL VECTOR (XCRD(I),YCRD(I))
  287         CONTINUE
              CALL PLOTIF (0.,0.,2)
              CALL GSPLCI (1)
              CALL GSLWSC (1.)
              CALL GUWK (1,0)
              PRINT * , Q
              PRINT * , 'Is heavy red line the one you want? (y/n)',Q
              CALL GTCHAR (COMD)
              IF (COMD.NE.'Y'.AND.COMD.NE.'y') THEN
                CALL PLOTIF (0.,0.,2)
                CALL GSPLCI (1)
                CALL GSLWSC (2.)
                CALL FRSTPT (XCRD(IOFP(IOEN)),YCRD(IOFP(IOEN)))
                DO 288 I=IOFP(IOEN)+1,IOLP(IOEN)
                  CALL VECTOR (XCRD(I),YCRD(I))
  288           CONTINUE
                CALL PLOTIF (0.,0.,2)
                CALL GSPLCI (1)
                CALL GSLWSC (1.)
                CALL GUWK (1,0)
                LOEN=IOLP(IOEN)-IOFP(IOEN)+1
                IF (IOEN.NE.NOES) THEN
                  DO 281 I=IOLP(IOEN)+1,NOEP
                    XCRD(I-LOEN)=XCRD(I)
                    YCRD(I-LOEN)=YCRD(I)
  281             CONTINUE
                  DO 282 I=IOEN,NOES-1
                    IOFP(I)=IOFP(I+1)-LOEN
                    IOLP(I)=IOLP(I+1)-LOEN
  282             CONTINUE
                END IF
                NOEP=NOEP-LOEN
                NOES=NOES-1
                GO TO 286
              ELSE
                IF (IOEN.NE.IFNS) THEN
                  DO 289 I=IOFP(IOEN),IOLP(IOEN)
                    XCRD(IOFP(IFNS)-IOFP(IOEN)+I)=XCRD(I)
                    YCRD(IOFP(IFNS)-IOFP(IOEN)+I)=YCRD(I)
  289             CONTINUE
                  IOLP(IFNS)=IOFP(IFNS)+IOLP(IOEN)-IOFP(IOEN)
                END IF
                NOEP=IOLP(IFNS)
                NOES=IFNS
                IOEP=NOES
                IOPP=0
                IF (XCRD(IOFP(NOES)).NE.XCRD(IOLP(NOES)).OR.
     +              YCRD(IOFP(NOES)).NE.YCRD(IOLP(NOES))) THEN
                  PRINT * , Q
                  PRINT * , 'Try to extend the line? (y/n)',Q
                  CALL GTCHAR (COMD)
                  IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                    IFOB=0
                    NOCE=0
  290               IF (XCRD(IOFP(NOES)).NE.XCRD(IOLP(NOES)).OR.
     +                  YCRD(IOFP(NOES)).NE.YCRD(IOLP(NOES))) THEN
                      IBFS=0
                      XEND=XCRD(IOLP(NOES))
                      YEND=YCRD(IOLP(NOES))
                      ILAT=999
                      ILON=999
                      DO 291 I=IOLP(NOES)-1,IOFP(NOES),-1
                        IF (ILAT.EQ.999.AND.YCRD(I).NE.YEND) THEN
                          YTST=YCRD(I)
                          ILAT=INT((DBLE(YEND)+
     +                              DBLE(YTST))/2.D0+180.D0)-180
                        END IF
                        IF (ILON.EQ.999.AND.XCRD(I).NE.XEND) THEN
                          XTST=XCRD(I)
                          ILON=INT((DBLE(XEND)+
     +                              DBLE(XTST))/2.D0+360.D0)-360
                        END IF
                        IF (ILAT.NE.999.AND.ILON.NE.999) THEN
                          IF (MOD(YEND,1.).EQ.0.) THEN
                            IF (YEND.LT.YTST) THEN
                              ILAT=ILAT-1
                            ELSE
                              ILAT=ILAT+1
                            END IF
                          END IF
                          IF (MOD(XEND,1.).EQ.0.) THEN
                            IF (XEND.LT.XTST) THEN
                              ILON=ILON-1
                            ELSE
                              ILON=ILON+1
                            END IF
                          END IF
                          IF (ILON.LT.0) ILON=ILON+360
                          IF (ILAT.LT.-90.OR.ILAT.GT. 89.OR.
     +                        ILON.LT.  0.OR.ILON.GT.359) GO TO 297
                          GO TO 293
                        END IF
  291                 CONTINUE
                      PRINT * , Q
                      PRINT * , 'Pathological: can''t extend line.',Q
                      GO TO 294
  293                 NEPS=NOEP
                      CALL RNGSOF (0,ICAT,ICEL,IRIM)
                      CALL RNGSSQ (ICAT,ICEL,IRIM,ILAT,ILON,3,
     +                                             RWRK,RWRK(LHP1),LRWH)
                      CALL NGCLFI (ICAT)
                      CALL NGCLFI (ICEL)
                      CALL NGCLFI (IRIM)
                      PRINT * , 'ILAT,ILON,NOEP: ',ILAT,ILON,NOEP,Q
                      NOCE=NOCE+1
                      IF (MOD(NOCE,100).EQ.0) THEN
                        PRINT * , Q
                        PRINT * , 'Terminate the search now? (y/n)',Q
                        PRINT * , '(Anything but "y" means "n".)',Q
                        CALL GTCHAR (COMD)
                        IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') GO TO 294
                      END IF
                      IF (NOEP.NE.NEPS) GO TO 290
  297                 IBFS=IBFS+1
                      GO TO (298,301,300,300,302,302,299,299,292) , IBFS
  298                 PRINT * , Q
                      PRINT * , 'Lost - trying brute force search.',Q
                      NOCE=0
  299                 ILON=ILON+1
                      GO TO 303
  300                 ILON=ILON-1
                      GO TO 303
  301                 ILAT=ILAT+1
                      GO TO 303
  302                 ILAT=ILAT-1
  303                 IF (ILON.LT.0) ILON=ILON+360
                      IF (ILAT.LT.-90.OR.ILAT.GT. 89.OR.
     +                    ILON.LT.  0.OR.ILON.GT.359) GO TO 297
                      GO TO 293
  292                 PRINT * , Q
                      PRINT * , 'Brute force search has failed.',Q
                      IF (IFOB.EQ.0) THEN
                        PRINT * , Q
                        PRINT * , 'Searching in the other direction.',Q
                        IFOB=1
                        IBEG=IOFP(NOES)
                        IEND=IOLP(NOES)
  304                   IF (IBEG.LT.IEND) THEN
                          XTMP=XCRD(IBEG)
                          YTMP=YCRD(IBEG)
                          XCRD(IBEG)=XCRD(IEND)
                          YCRD(IBEG)=YCRD(IEND)
                          XCRD(IEND)=XTMP
                          YCRD(IEND)=YTMP
                          IBEG=IBEG+1
                          IEND=IEND-1
                          GO TO 304
                        END IF
                        NOCE=0
                        GO TO 290
                      END IF
                    END IF
                  ELSE
                    PRINT * , Q
                    PRINT * , 'Line not extended.',Q
                  END IF
                END IF
  294           PRINT * , Q
                PRINT * , 'Interpolate to use fewer points? (y/n)',Q
                PRINT * , Q
                PRINT * , '(This code does its job in-place, leaving',Q
                PRINT * , 'only the interpolated line behind after it',Q
                PRINT * , 'has finished.  If you need both lines, you',Q
                PRINT * , 'should answer "n", and then use "E(dit)',Q
                PRINT * , 'E(dge) I(nterpolate) (method) A".)',Q
                PRINT * , Q
                PRINT * , '(Anything but "y" means "n".)',Q
                CALL GTCHAR (COMD)
                IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                  PRINT * , Q
                  PRINT * , 'Interpolating.  Because interpolation',Q
                  PRINT * , 'is done in-place, if you use it on a',Q
                  PRINT * , 'line defined by points too far apart,',Q
                  PRINT * , 'it can fail.  In that case, neither line',Q
                  PRINT * , 'is left behind; you must use the R(ead)',Q
                  PRINT * , 'B(ackground) command again.',Q
                  PRINT * , Q
                  PRINT * , 'Enter desired point separation (if',Q
                  PRINT * , 'different from current default value):',Q
                  DDBP=DLES
                  CALL DERDRN (DDBP,DDBP)
                  NOPO=IOLP(NOES)-IOFP(NOES)+1
                  NOEP=IOFP(NOES)
                  XNXT=XCRD(IOFP(NOES))
                  YNXT=YCRD(IOFP(NOES))
                  DO 296 I=IOFP(NOES)+1,IOLP(NOES)
                    XLST=XNXT
                    YLST=YNXT
                    XNXT=XCRD(I)
                    YNXT=YCRD(I)
  295               DLST=ADSGCR(YCRD(NOEP),XCRD(NOEP),YLST,XLST)
                    DNXT=ADSGCR(YCRD(NOEP),XCRD(NOEP),YNXT,XNXT)
                    IF (DLST.LT.DDBP.AND.DNXT.GE.DDBP) THEN
                      CALL FPSGCR (YLST,XLST,YNXT,XNXT,
     +                             (DDBP-DLST)/(DNXT-DLST),YLST,XLST)
                      NOEP=NOEP+1
                      IF (NOEP.GT.I) THEN
                        PRINT * , Q
                        PRINT * , 'In-place interpolation failure.',Q
                        NOEP=IOFP(NOES)-1
                        NOES=NOES-1
                        IOEP=0
                        IOPP=0
                        GO TO 104
                      END IF
                      XCRD(NOEP)=XLST
                      YCRD(NOEP)=YLST
                      GO TO 295
                    END IF
  296             CONTINUE
                  XCRD(NOEP)=XCRD(IOLP(NOES))
                  YCRD(NOEP)=YCRD(IOLP(NOES))
                  IOLP(NOES)=NOEP
                  IOEP=NOES
                  IOPP=0
                  NOPI=IOLP(NOES)-IOFP(NOES)+1
                  PRINT * , Q
                  PRINT * , 'Interpolation done.',Q
                  PRINT * , Q
                  PRINT * , 'Number of points, original:    ',NOPO,Q
                  PRINT * , 'Number of points, interpolated:',NOPI,Q
                END IF
              END IF
            ELSE
              PRINT * , Q
              PRINT * , 'No boundary lines left in window.',Q
            END IF
            GO TO 104
          ELSE IF (COMD.EQ.'F'.OR.COMD.EQ.'f') THEN
            PRINT * , Q
            PRINT * , 'Read a named file of new data.',Q
            PRINT * , Q
            PRINT * , 'Enter the name of the file:',Q
            CALL GTCHRS (FNMN,64)
            IF (FNMN.EQ.' ') GO TO 114
            OPEN (13,FILE=FNMN(1:MPILNB(FNMN)),STATUS='OLD',
     +                                         FORM='FORMATTED',ERR=146)
            PRINT * , Q
            PRINT * , 'Coordinates are normally expected to be in',Q
            PRINT * , 'lat/lon order.  Assume the other order? (y/n)',Q
            CALL GTCHAR (COMD)
            NPTS=0
            GO TO 194
  146       PRINT * , Q
            PRINT * , 'Error opening new-data file - no data read.',Q
            GO TO 114
  194       READ (13,'(A64)',END=145) NOOL
            IF (NOOL.EQ.' ') NOOL='Unidentified Area'
            READ (13,'(A64)',END=145) NOOR
            IF (NOOR.EQ.' ') NOOR='Unidentified Area'
  144       READ (13,'(A24)',END=145) XXYY
            IF (XXYY.NE.' ') THEN
              IF (NOEP.GE.MNEP) THEN
                PRINT * , 'Too many edge points - stopping read.',Q
                CLOSE (13)
                GO TO 104
              ELSE
                NOEP=NOEP+1
                IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
                  READ (XXYY,'(2F12.6)') XCRD(NOEP),YCRD(NOEP)
                ELSE
                  READ (XXYY,'(2F12.6)') YCRD(NOEP),XCRD(NOEP)
                END IF
C
C               IF (SIDE(70.,20.,80.,0.,XCRD(NOEP),YCRD(NOEP)).GT.0.)
C    +                                                              THEN
C                 NOEP=NOEP-1
C                 GO TO 144      !  ONE-TIME PATCH TO IMPORT MALDIVES
C               END IF           !  WITHOUT IMPORTING PARTS OF INDIA
C
              END IF
              NPTS=NPTS+1
              IF (NPTS.EQ.1) THEN
                IF (NOES.GE.MNES) THEN
                  NOEP=NOEP-1
                  PRINT * , 'Too many edges - stopping read.',Q
                  CLOSE (13)
                  GO TO 104
                ELSE
                  NOES=NOES+1
                  IOFP(NOES)=NOEP
                  IOLP(NOES)=NOEP
                  ILTY(NOES)=0
                  IAIL(NOES)=1
                  IAIR(NOES)=1
                  DO 195 I=1,MNAI
                    IF (NAME(I).EQ.NOOL) THEN
                      IAIL(NOES)=I
                      GO TO 197
                    END IF
  195             CONTINUE
                  DO 196 I=1,MNAI
                    IF (IATY(I).EQ.0) THEN
                      IATY(I)=1
                      ISCI(I)=8
                      IPAR(I)=0
                      NAME(I)=NOOL
                      IAIL(NOES)=I
                      GO TO 197
                    END IF
  196             CONTINUE
  197             DO 198 I=1,MNAI
                    IF (NAME(I).EQ.NOOR) THEN
                      IAIR(NOES)=I
                      GO TO 200
                    END IF
  198             CONTINUE
                  DO 199 I=1,MNAI
                    IF (IATY(I).EQ.0) THEN
                      IATY(I)=1
                      ISCI(I)=8
                      IPAR(I)=0
                      NAME(I)=NOOR
                      IAIR(NOES)=I
                      GO TO 200
                    END IF
  199             CONTINUE
  200             CONTINUE
                END IF
              ELSE
                IOLP(NOES)=NOEP
              END IF
              GO TO 144
            ELSE
              NPTS=0
              GO TO 194
            END IF
  145       CLOSE (13)
            GO TO 104
          ELSE
            GO TO 114
          END IF
C
C "S" command ("Show a particular area").
C
        ELSE IF (COMD.EQ.'S'.OR.COMD.EQ.'s') THEN
          PRINT * , Q
          PRINT * , 'Show a particular area from the list.',Q
          PRINT * , Q
          PRINT * , 'Enter either a name or one of the following:',Q
          PRINT * , Q
          PRINT * , '  I => Index of desired area',Q
          PRINT * , '  N => Next area in the list',Q
          PRINT * , '  O => Off - no area shown',Q
          PRINT * , '  P => Previous area in the list',Q
          PRINT * , '  X => Main command menu (X = none of the above)',Q
          PRINT * , Q
          CALL GTCHRS (NOAS,64)
          IF (NOAS(2:64).EQ.' ') THEN
            COMD=NOAS(1:1)
            NOAS=' '
            IF (COMD.EQ.'I'.OR.COMD.EQ.'i') THEN
              PRINT * , Q
              PRINT * , 'Enter index of area you want to see:',Q
              CALL DERDIN (IOAS,IOAS)
              IOAS=MOD(ABS(IOAS)+MNAI-1,MNAI)+1
            ELSE IF (COMD.EQ.'N'.OR.COMD.EQ.'n') THEN
              IOAS=ABS(IOAS)
              IOAO=MOD(IOAS+MNAI-2,MNAI)+1
  188         IOAS=MOD(IOAS+1,MNAI)
              IF (IOAS.NE.IOAO.AND.IATY(IOAS).EQ.0) GO TO 188
            ELSE IF (COMD.EQ.'O'.OR.COMD.EQ.'o') THEN
              IOAS=-ABS(IOAS)
              NOAS=' '
              GO TO 104
            ELSE IF (COMD.EQ.'P'.OR.COMD.EQ.'p') THEN
              IOAS=ABS(IOAS)
              IOAO=MOD(IOAS,MNAI)+1
  189         IOAS=MOD(IOAS+MNAI-2,MNAI)+1
              IF (IOAS.NE.IOAO.AND.IATY(IOAS).EQ.0) GO TO 189
            ELSE
              GO TO 114
            END IF
          ELSE
            IOAS=-ABS(IOAS)
          END IF
          AXMN= 1.E36
          AXMX=-1.E36
          AYMN= 1.E36
          AYMX=-1.E36
          DO 192 IOES=1,NOES
            IF (ISPOAI(IAIL(IOES),IOAS).NE.0.OR.
     +          ISPOAI(IAIR(IOES),IOAS).NE.0.OR.
     +          ISPOAN(IAIL(IOES),NOAS).NE.0.OR.
     +          ISPOAN(IAIR(IOES),NOAS).NE.0) THEN
              DO 191 I=IOFP(IOES),IOLP(IOES)
                AXMN=MIN(AXMN,XCRD(I))
                AXMX=MAX(AXMX,XCRD(I))
                AYMN=MIN(AYMN,YCRD(I))
                AYMX=MAX(AYMX,YCRD(I))
  191         CONTINUE
            END IF
  192     CONTINUE
          IF (AXMN.LT.AXMX.AND.AYMN.LT.AYMX) THEN
            XCEN=.5*(AXMN+AXMX)
            YCEN=.5*(AYMN+AYMX)
            RNGE=1.01*MAX(AXMX-AXMN,AYMX-AYMN)
          END IF
          GO TO 104
C
C "U" command ("Update the display").
C
        ELSE IF (COMD.EQ.'U'.OR.COMD.EQ.'u') THEN
          PRINT * , Q
          PRINT * , 'Update display.',Q
          GO TO 104
C
C "V" command ("change Variables of various kinds").
C
        ELSE IF (COMD.EQ.'V'.OR.COMD.EQ.'v') THEN
          PRINT * , Q
          PRINT * , 'Change miscellaneous Variables.',Q
          PRINT * , Q
          PRINT * , '  Maximum range value for labeling:      ',RLBL,Q
          PRINT * , '  Maximum range value for fill:          ',RFIL,Q
          PRINT * , '  Maximum range value for background:    ',RRBG,Q
          PRINT * , '  Level at or below which lines are cyan:',ICKL,Q
          PRINT * , '  Size of characters for area labelling: ',CSAN,Q
          PRINT * , '  Global replacement flag:               ',GLRF,Q
          PRINT * , Q
          PRINT * , 'Enter new maximum range value for labels:',Q
          CALL DERDRN (RLBL,RLBL)
          PRINT * , 'Enter new maximum range value for fill:',Q
          CALL DERDRN (RFIL,RFIL)
          PRINT * , 'Enter new maximum range value for background:',Q
          CALL DERDRN (RRBG,RRBG)
          PRINT * , 'Enter new level at or below which lines are in cyan
     +:',Q
          CALL DERDIN (ICKL,ICKL)
          ICKL=MAX(0,MIN(5,ICKL))
          PRINT * , 'Enter new character size for area labels:',Q
          CALL DERDRN (CSAN,CSAN)
          CSAN=MAX(0.,MIN(1.,CSAN))
          PRINT * , 'Enter new global replacement flag:',Q
          CALL DERDRN (GLRF,GLRF)
          GLRF=MAX(0.,MIN(1.,GLRF))
          GO TO 104
C
C "W" command ("Write an updated copy of the dataset").
C
        ELSE IF (COMD.EQ.'W'.OR.COMD.EQ.'w') THEN
          PRINT * , Q
          PRINT * , 'Write an edited copy of the dataset.',Q
  201     PRINT * , Q
          PRINT * , 'Include edges of type 0? (y/n)',Q
          CALL GTCHAR (COMD)
          IF      (COMD.EQ.'N'.OR.COMD.EQ.'n') THEN
            ILTZ=0
          ELSE IF (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
            ILTZ=1
            PRINT * , Q
            PRINT * , 'Include *only* edges of type 0? (y/n)',Q
            CALL GTCHAR (COMD)
            IF      (COMD.EQ.'Y'.OR.COMD.EQ.'y') THEN
              ILTZ=2
            ELSE IF (COMD.NE.'N'.AND.COMD.NE.'n') THEN
              GO TO 201
            END IF
          ELSE
            GO TO 201
          END IF
          LFNM=MIN(61,MPILNB(FNMI))
          FNMO=FNMI(1:LFNM)//'.  '
          DO 125 I=1,99
            IF (I.LT.10) THEN
              FNMO(LFNM+2:LFNM+2)='.'
            ELSE
              FNMO(LFNM+2:LFNM+2)=CHAR(ICH0+I/10)
            END IF
            FNMO(LFNM+3:LFNM+3)=CHAR(ICH0+MOD(I,10))
            OPEN (12,FILE=FNMO(1:MPILNB(FNMO)),STATUS='NEW',
     +                                         FORM='FORMATTED',ERR=125)
            GO TO 126
  125     CONTINUE
          PRINT * , Q
          PRINT * , 'All 99 basic save file names have been used.'
          FNMO(LFNM+1:LFNM+3)='.00'
          OPEN (12,FILE=FNMO(1:MPILNB(FNMO)),STATUS='UNKNOWN',
     +                                                 FORM='FORMATTED')
  126     PRINT * , Q
          PRINT * , '  Name of file to be written: ',
     +                                            FNMO(1:MPILNB(FNMO)),Q
          DO 129 IOES=1,NOES
            IF (ILTZ.EQ.0.AND.ILTY(IOES).EQ.0) GO TO 129
            IF (ILTZ.EQ.2.AND.ILTY(IOES).NE.0) GO TO 129
            IBEG=IOFP(IOES)
  127       IEND=IBEG+MIN(99,IOLP(IOES)-IBEG)
            NNMS=2*(IEND-IBEG+1)
            YMAX=YCRD(IBEG)
            YMIN=YCRD(IBEG)
            XMAX=XCRD(IBEG)
            XMIN=XCRD(IBEG)
            DO 128 I=IBEG+1,IEND
              YMAX=MAX(YMAX,YCRD(I))
              YMIN=MIN(YMIN,YCRD(I))
              XMAX=MAX(XMAX,XCRD(I))
              XMIN=MIN(XMIN,XCRD(I))
  128       CONTINUE
            WRITE (12,'(4I4,4F10.5,I4)') NNMS,ILTY(IOES),IAIL(IOES),
     +                                   IAIR(IOES),YMAX,YMIN,XMAX,
     +                                   XMIN
            WRITE (12,'(8F10.5)') (YCRD(I),XCRD(I),I=IBEG,IEND)
            IF (IEND.LT.IOLP(IOES)) THEN
              IBEG=IEND
              GO TO 127
            END IF
  129     CONTINUE
          WRITE (12,  '(''   0   0   0   0   0.00000   0.00000   0.00000
     +   0.00000'')')
          DO 134 I=1,MNAI
            IF (IATY(I).NE.0) THEN
              WRITE (12,'(I4,2I2,I5,1X,A)') I,IATY(I),ISCI(I),IPAR(I),
     +                                      NAME(I)(1:MPILNB(NAME(I)))
            END IF
  134     CONTINUE
          WRITE (12,'(''   0 0 0    0'')')
          CLOSE (12)
C
C "X" command ("eXamine various dataset parameters").
C
        ELSE IF (COMD.EQ.'X'.OR.COMD.eq.'x') THEN
          PRINT * , Q
          PRINT * , 'Number of areas  : ',NOAD,' out of ',MNAI,Q
          PRINT * , 'Number of edges  : ',NOES,' out of ',MNES,Q
          PRINT * , 'Number of points : ',NOEP,' out of ',MNEP,Q
          SUML=0.
          SUM0=0.
          SUM1=0.
          SUM2=0.
          SUM3=0.
          SUM4=0.
          SUM5=0.
          NUML=0
          NUM0=0
          NUM1=0
          NUM2=0
          NUM3=0
          NUM4=0
          NUM5=0
          DO 284 IOES=1,NOES
            DO 283 I=IOFP(IOES),IOLP(IOES)-1
              SEGL=ADSGCR(YCRD(I),XCRD(I),YCRD(I+1),XCRD(I+1))
              SUML=SUML+SEGL
              NUML=NUML+1
              IF (ILTY(IOES).EQ.0) THEN
                SUM0=SUM0+SEGL
                NUM0=NUM0+1
              END IF
              IF (ILTY(IOES).EQ.1) THEN
                SUM1=SUM1+SEGL
                NUM1=NUM1+1
              END IF
              IF (ILTY(IOES).EQ.2) THEN
                SUM2=SUM2+SEGL
                NUM2=NUM2+1
              END IF
              IF (ILTY(IOES).EQ.3) THEN
                SUM3=SUM3+SEGL
                NUM3=NUM3+1
              END IF
              IF (ILTY(IOES).EQ.4) THEN
                SUM4=SUM4+SEGL
                NUM4=NUM4+1
              END IF
              IF (ILTY(IOES).EQ.5) THEN
                SUM5=SUM5+SEGL
                NUM5=NUM5+1
              END IF
  283       CONTINUE
  284     CONTINUE
          AVGL=0.
          AVG0=0.
          AVG1=0.
          AVG2=0.
          AVG3=0.
          AVG4=0.
          AVG5=0.
          IF (NUML.NE.0) AVGL=SUML/REAL(NUML)
          IF (NUM0.NE.0) AVG0=SUM0/REAL(NUM0)
          IF (NUM1.NE.0) AVG1=SUM1/REAL(NUM1)
          IF (NUM2.NE.0) AVG2=SUM2/REAL(NUM2)
          IF (NUM3.NE.0) AVG3=SUM3/REAL(NUM3)
          IF (NUM4.NE.0) AVG4=SUM4/REAL(NUM4)
          IF (NUM5.NE.0) AVG5=SUM5/REAL(NUM5)
          PRINT * , Q
          PRINT * , 'Number of edge segments   : ', NUML,Q
          PRINT * , 'Number of type 0 segments : ', NUM0,Q
          PRINT * , 'Number of type 1 segments : ', NUM1,Q
          PRINT * , 'Number of type 2 segments : ', NUM2,Q
          PRINT * , 'Number of type 3 segments : ', NUM3,Q
          PRINT * , 'Number of type 4 segments : ', NUM4,Q
          PRINT * , 'Number of type 5 segments : ', NUM5,Q
          PRINT * , Q
          PRINT * , 'Average length of edge segments   : ', AVGL,Q
          PRINT * , 'Average length of type 0 segments : ', AVG0,Q
          PRINT * , 'Average length of type 1 segments : ', AVG1,Q
          PRINT * , 'Average length of type 2 segments : ', AVG2,Q
          PRINT * , 'Average length of type 3 segments : ', AVG3,Q
          PRINT * , 'Average length of type 4 segments : ', AVG4,Q
          PRINT * , 'Average length of type 5 segments : ', AVG5,Q
          IF (IOEP.NE.0) THEN
            SUME=0.
            NUME=IOLP(IOEP)-IOFP(IOEP)
            DO 285 I=IOFP(IOEP),IOLP(IOEP)-1
              SUME=SUME+ADSGCR(YCRD(I),XCRD(I),YCRD(I+1),XCRD(I+1))
  285       CONTINUE
            AVGE=SUME/REAL(NUME)
            PRINT * , Q
            PRINT * , 'Number of segments on picked edge : ', NUME,Q
            PRINT * , 'Average length of those segments  : ', AVGE,Q
          END IF
C
C "Z" command ("Zoom in/out to/from center point").
C
        ELSE IF (COMD.EQ.'Z'.OR.COMD.EQ.'z') THEN
          PRINT * , Q
          PRINT * , 'Zoom - enter In, Out or an integer [1-9] :',Q
          NUMB=1
  136     CALL GTCHAR (COMD)
          IF      (COMD.EQ.'I'.OR.COMD.EQ.'i') THEN
            RNGE=RNGE/(2.**NUMB)
            GO TO 104
          ELSE IF (COMD.EQ.'O'.OR.COMD.EQ.'o') THEN
            RNGE=RNGE*(2.**NUMB)
            GO TO 104
          ELSE IF (ICHAR(COMD).GE.ICHAR('0').AND.
     +             ICHAR(COMD).LE.ICHAR('9')) THEN
            NUMB=MAX(1,ICHAR(COMD)-ICHAR('0'))
            GO TO 136
          END IF
C
C Anything else.
C
        ELSE
          PRINT * , Q
          PRINT * , 'Illegal command.  Try again.',Q
C
        END IF
C
        GO TO 114
C
C Normal exit.  Deactivate and close the X workstation, close the NCGM
C workstation, close GKS and call EDSTOP to turn off raw terminal input
C and quit.
C
  998   CALL GDAWK (1)
        CALL GCLWK (1)
        CALL GCLWK (2)
        CALL GCLKS
        CALL EDSTOP
C
C Error exit.  Print the GKS error message and call EDSTOP to turn off
C raw terminal input and quit.
C
  999   CALL EPRIN
        CALL EDSTOP
C
      END


      SUBROUTINE DERDIN (IVAL,IDEF)
C
C This routine reads a line of input to get an integer value IVAL.  If
C the line is entirely blank, the default value IDEF is returned.  If
C there is an error on the read, another line is obtained.
C
        CHARACTER*128 LINE
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
C Assume the default value will be returned until we find otherwise.
C
        IVAL=IDEF
C
C Get a line from standard input.
C
  101   CALL GTCHRS (LINE,128)
C
        IF (LINE.EQ.' ') RETURN
C
        READ (LINE,*,ERR=102) IVAL
        RETURN
C
  102   PRINT * , 'Error on read - try again.',Q
        GO TO 101
C
      END


      SUBROUTINE DERDRN (RVAL,RDEF)
C
C This routine reads a line of input to get a real number RVAL.  If
C the line is entirely blank, the default value RDEF is returned.  If
C there is an error on the read, another line is obtained.
C
        CHARACTER*128 LINE
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
C Assume the default value will be returned until we find otherwise.
C
        RVAL=RDEF
C
C Get a line from standard input.
C
  101   CALL GTCHRS (LINE,128)
C
        IF (LINE.EQ.' ') RETURN
C
        READ (LINE,*,ERR=102) RVAL
        RETURN
C
  102   PRINT * , 'Error on read - try again.',Q
        GO TO 101
C
      END


      SUBROUTINE MARKIT (XCEN,YCEN,SIZE,ICHQ)
        PARAMETER (NDIV=64,NDP1=NDIV+1,NDP2=NDIV+2,NPTS=2*NDP1+1,P=.6)
        DIMENSION XOFF(NDP1),YOFF(NDP1),XCRD(NPTS),YCRD(NPTS)
        CHARACTER*10 CTMP
        SAVE INIT
        DATA INIT / 0 /
        IF (INIT.EQ.0) THEN
          DO 101 I=1,NDP1
            ANGL=6.28318530717959*(REAL(I-1)/REAL(NDIV))
            XOFF(I)=COS(ANGL)
            YOFF(I)=SIN(ANGL)
  101     CONTINUE
        END IF
        ASIZ=ABS(SIZE)
        DO 102 I=1,NDP1
          XCRD(I)=CFUX(CUFX(XCEN)+ASIZ*XOFF(I))
          YCRD(I)=CFUY(CUFY(YCEN)+ASIZ*YOFF(I))
          XCRD(NDP1+I)=CFUX(CUFX(XCEN)+P*ASIZ*XOFF(NDP2-I))
          YCRD(NDP1+I)=CFUY(CUFY(YCEN)+P*ASIZ*YOFF(NDP2-I))
  102   CONTINUE
        XCRD(NPTS)=XCRD(1)
        YCRD(NPTS)=YCRD(1)
        CALL LINE (CFUX(CUFX(XCEN)-ASIZ),YCEN,
     +             CFUX(CUFX(XCEN)+ASIZ),YCEN)
        CALL LINE (XCEN,CFUY(CUFY(YCEN)-ASIZ),
     +             XCEN,CFUY(CUFY(YCEN)+ASIZ))
        CALL GFA (NPTS,XCRD,YCRD)
        IF (SIZE.GT.0.) THEN
          WRITE (CTMP,'(F10.5)') XCEN
          IF (ICHQ.EQ.0) THEN
            CALL PLCHMQ (CFUX(CUFX(XCEN)+ASIZ),
     +                   CFUY(CUFY(YCEN)-ASIZ),
     +                   CTMP(MPIFNB(CTMP):MPILNB(CTMP)),ASIZ,0.,-1.)
          ELSE
            CALL PLCHHQ (CFUX(CUFX(XCEN)+ASIZ),
     +                   CFUY(CUFY(YCEN)-ASIZ),
     +                   CTMP(MPIFNB(CTMP):MPILNB(CTMP)),ASIZ,0.,-1.)
          END IF
          WRITE (CTMP,'(F10.5)') YCEN
          IF (ICHQ.EQ.0) THEN
            CALL PLCHMQ (CFUX(CUFX(XCEN)+ASIZ),
     +                   CFUY(CUFY(YCEN)+ASIZ),
     +                   CTMP(MPIFNB(CTMP):MPILNB(CTMP)),ASIZ,0.,-1.)
          ELSE
            CALL PLCHHQ (CFUX(CUFX(XCEN)+ASIZ),
     +                   CFUY(CUFY(YCEN)+ASIZ),
     +                   CTMP(MPIFNB(CTMP):MPILNB(CTMP)),ASIZ,0.,-1.)
          END IF
        END IF
        RETURN
      END


      SUBROUTINE CIRCLE (XCEN,YCEN,SIZE)
        PARAMETER (NDIV=64,NPTS=NDIV+1)
        DIMENSION XOFF(NPTS),YOFF(NPTS),XCRD(NPTS),YCRD(NPTS)
        SAVE INIT
        DATA INIT / 0 /
        IF (INIT.EQ.0) THEN
          DO 101 I=1,NPTS
            ANGL=6.28318530717959*(REAL(I-1)/REAL(NDIV))
            XOFF(I)=COS(ANGL)
            YOFF(I)=SIN(ANGL)
  101     CONTINUE
        END IF
        ASIZ=ABS(SIZE)
        DO 102 I=1,NPTS
          XCRD(I)=CFUX(CUFX(XCEN)+ASIZ*XOFF(I))
          YCRD(I)=CFUY(CUFY(YCEN)+ASIZ*YOFF(I))
  102   CONTINUE
        IF (SIZE.GT.0.) THEN
          CALL GPL (NPTS,XCRD,YCRD)
        ELSE
          CALL GFA (NPTS,XCRD,YCRD)
        END IF
        RETURN
      END


      SUBROUTINE DARROW (XCRD,YCRD,XINC,YINC,SIZE)
        DNOM=SQRT(XINC**2+YINC**2)
        IF (DNOM.EQ.0.) RETURN
        IF (SIZE.LT.0.) THEN
          XTMP=XCRD
          YTMP=YCRD
          ASIZ=-SIZE
        ELSE
          XTMP=CFUX(CUFX(XCRD)+SIZE*XINC/DNOM)
          YTMP=CFUY(CUFY(YCRD)+SIZE*YINC/DNOM)
          ASIZ=SIZE
        END IF
        CALL LINE (CFUX(CUFX(XTMP)-     ASIZ*XINC/DNOM),
     +             CFUY(CUFY(YTMP)-     ASIZ*YINC/DNOM),XTMP,YTMP)
        CALL LINE (CFUX(CUFX(XTMP)-.375*ASIZ*XINC/DNOM 
     +                            +.250*ASIZ*YINC/DNOM),
     +             CFUY(CUFY(YTMP)-.375*ASIZ*YINC/DNOM 
     +                            -.250*ASIZ*XINC/DNOM),XTMP,YTMP)
        CALL LINE (CFUX(CUFX(XTMP)-.375*ASIZ*XINC/DNOM 
     +                            -.250*ASIZ*YINC/DNOM),
     +             CFUY(CUFY(YTMP)-.375*ASIZ*YINC/DNOM 
     +                            +.250*ASIZ*XINC/DNOM),XTMP,YTMP)
        RETURN
      END


      SUBROUTINE SSORT1 (RVAL,NVAL,IPER)
C
        DIMENSION RVAL(NVAL),IPER(NVAL)
C
C Given an array of NVAL reals in an array RVAL, this routine returns a
C permutation vector IPER such that, given I and J, 1.LE.I.LE.J.LE.NVAL,
C RVAL(IPER(I)).LE.RVAL(IPER(J)).
C
C A Shell sort is used.  Details of the algorithm may be found in the
C book "Algorithms" by Robert Sedgewick.
C
C Note:  Fred Clare wrote the original version of this routine.  I have
C adapted it for use in CONPACK; among other things, the error checking
C has been been removed because the calling routine does it.  (DJK)
C
        DO 101 I=1,NVAL
          IPER(I)=I
  101   CONTINUE
C
        K=0
C
  102   IF (3*K+1.LT.NVAL) THEN
          K=3*K+1
          GO TO 102
        END IF
C
  103   IF (K.GT.0) THEN
C
          DO 105 I=1,NVAL-K
C
            J=I
C
  104       IF (RVAL(IPER(J)).GT.RVAL(IPER(J+K))) THEN
              ITMP=IPER(J)
              IPER(J)=IPER(J+K)
              IPER(J+K)=ITMP
              J=J-K
              IF (J.GE.1) GO TO 104
            END IF
C
  105     CONTINUE
C
          K=(K-1)/3
          GO TO 103
C
        END IF
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE SSORT2 (RVL1,RVL2,NVAL,IPER)
C
        DIMENSION RVL1(NVAL),RVL2(NVAL),IPER(NVAL)
C
C Given two arrays of NVAL reals, RVL1 and RVL2, this routine returns a
C permutation vector IPER such that, given I and J, 1.LE.I.LE.J.LE.NVAL,
C RVL1(IPER(I)).LT.RVL1(IPER(J)) or RVL1(IPER(I)).EQ.RVL1(IPER(J)) and
C RVL2(IPER(I)).LE.RVL2(IPER(J)).
C
C A Shell sort is used.  Details of the algorithm may be found in the
C book "Algorithms" by Robert Sedgewick.
C
C Note:  Fred Clare wrote the original version of this routine.  I have
C adapted it for use in CONPACK; among other things, the error checking
C has been been removed because the calling routine does it.  (DJK)
C
        DO 101 I=1,NVAL
          IPER(I)=I
  101   CONTINUE
C
        K=0
C
  102   IF (3*K+1.LT.NVAL) THEN
          K=3*K+1
          GO TO 102
        END IF
C
  103   IF (K.GT.0) THEN
C
          DO 105 I=1,NVAL-K
C
            J=I
C
  104       IF (RVL1(IPER(J)).GT.RVL1(IPER(J+K)).OR.
     +         (RVL1(IPER(J)).EQ.RVL1(IPER(J+K)).AND.
     +          RVL2(IPER(J)).GT.RVL2(IPER(J+K)))) THEN
              ITMP=IPER(J)
              IPER(J)=IPER(J+K)
              IPER(J+K)=ITMP
              J=J-K
              IF (J.GE.1) GO TO 104
            END IF
C
  105     CONTINUE
C
          K=(K-1)/3
          GO TO 103
C
        END IF
C
C Done.
C
        RETURN
C
      END


      FUNCTION NTIMES (RVL1,RVL2,NVAL,IPER,ICOM)
C
        DIMENSION RVL1(NVAL),RVL2(NVAL),IPER(NVAL)
C
C The value of this function is the number of times that the pair of
C values (RVL1(ICOM),RVL2(ICOM)) occurs in the first NVAL positions in
C the arrays RVL1 and RVL2.  IPER is a permutation array created by a
C call to the subroutine SSORT2.
C
        ILOW=0
        IHGH=NVAL
C
  101   INDX=(ILOW+IHGH)/2
C
        IF (INDX.NE.ILOW) THEN
          IF (RVL1(IPER(INDX)).LT.RVL1(ICOM).OR.
     +       (RVL1(IPER(INDX)).EQ.RVL1(ICOM).AND.
     +        RVL2(IPER(INDX)).LT.RVL2(ICOM))) THEN
            ILOW=INDX
          ELSE
            IHGH=INDX
          END IF
          GO TO 101
        END IF
C
        NTIMES=0
C
  102   INDX=INDX+1
C
        IF (INDX.LE.NVAL) THEN
          IF (RVL1(IPER(INDX)).EQ.RVL1(ICOM).AND.
     +        RVL2(IPER(INDX)).EQ.RVL2(ICOM)) THEN
            NTIMES=NTIMES+1
            GO TO 102
          END IF
        END IF
C
C Done.
C
        RETURN
C
      END


      FUNCTION ARRAT2 (YVL,XVL)
C
C The function ARRAT2, given two real values YVL and XVL, approximates
C the value of ATAN2 (YVL,XVL).  Because of the way in which ARRAT2 is
C used, the approximation need not be very accurate; what's important
C is that it should be fast.
C
        DATA PIO2 / 1.57079632679490 /
        DATA PIPI / 3.14159265358979 /
        DATA PIT2 / 6.28318530717958 /
C
        IF      (XVL.LT.0..AND.YVL.LE.0.) THEN
          IF (-XVL.GT.-YVL) THEN
            ARRAT2=-PIPI+(YVL/XVL)/(1.+.28*(YVL/XVL)*(YVL/XVL))
          ELSE
            ARRAT2=-PIO2-(XVL/YVL)/(1.+.28*(XVL/YVL)*(XVL/YVL))
          END IF
        ELSE IF (XVL.GE.0..AND.YVL.LT.0.) THEN
          IF ( XVL.LT.-YVL) THEN
            ARRAT2=-PIO2-(XVL/YVL)/(1.+.28*(XVL/YVL)*(XVL/YVL))
          ELSE
            ARRAT2=      (YVL/XVL)/(1.+.28*(YVL/XVL)*(YVL/XVL))
          END IF
        ELSE IF (XVL.GT.0..AND.YVL.GE.0.) THEN
          IF ( XVL.GT. YVL) THEN
            ARRAT2=      (YVL/XVL)/(1.+.28*(YVL/XVL)*(YVL/XVL))
          ELSE
            ARRAT2= PIO2-(XVL/YVL)/(1.+.28*(XVL/YVL)*(XVL/YVL))
          END IF
        ELSE IF (XVL.LE.0..AND.YVL.GT.0.) THEN
          IF (-XVL.LT. YVL) THEN
            ARRAT2= PIO2-(XVL/YVL)/(1.+.28*(XVL/YVL)*(XVL/YVL))
          ELSE
            ARRAT2= PIPI+(YVL/XVL)/(1.+.28*(YVL/XVL)*(YVL/XVL))
          END IF
        ELSE
          ARRAT2=0.
        END IF
        RETURN
      END


      SUBROUTINE WLTOAM (XNXT,YNXT,IFST,IAMA,IGID,IAIL,IAIR)
C
        DIMENSION IAMA(*)
C
C This is a windowing routine for line draws.  Code using it should
C declare the common block WDCOMN and put into it minimum and maximum
C values of X and Y that together define a window at the edges of which
C lines are to be clipped.  Once that has been done, each call to
C WLTOAM with IFST = 0 declares a point (XNXT,YNXT) at which a line
C is to begin and each call to WLTOAM with IFST = 1 declares a point
C (XNXT,YNXT) at which a line is to continue.
C
C This routine puts the windowed line segments into the area map IAMA,
C using group identifier IGID, left area identifier IAIL, and right area
C identifier IAIR.  Each (XNXT,YNXT) is expected to be a point in the
C fractional coordinate system.  Likewise, the values of XMIN, XMAX,
C YMIN, and YMAX are expected to be in the fractional coordinate system.
C
C Declare the common block that holds the clipping window parameters.
C
        COMMON /WDCOMN/ XMIN,XMAX,YMIN,YMAX
C
C Declare some arrays to be used for passing point coordinates to
C AREDAM.
C
        DIMENSION XCRA(2),YCRA(2)
C
C Certain quantities need to be saved from call to call.  LPOW is a
C "last-point-outside-window" flag.  (XLST,YLST) is the last point
C (from the previous call to WLTOAM).
C
        SAVE LPOW,XLST,YLST
C
C Compute a "next-point-outside-window" flag.  The value of this flag
C is between -4 and +4, depending on where the next point is relative
C to the window, as shown in the following diagram:
C
C                      |      |
C                   -2 |  +1  | +4
C            YMAX -----+------+-----
C                   -3 |   0  | +3
C            YMIN -----+------+-----
C                   -4 |  -1  | +2
C                      |      |
C                    XMIN    XMAX
C
C Ultimately, we combine the values of this flag for two consecutive
C points in such a way as to get an integer between 1 and 81, telling
C us what combination of inside/outside we have to deal with.
C
        NPOW=IFIX(3.*(SIGN(.51,XNXT-XMIN)+SIGN(.51,XNXT-XMAX))+
     +               (SIGN(.51,YNXT-YMIN)+SIGN(.51,YNXT-YMAX)))
C
C If the next point is not the first point of a line, there is work to
C be done.
C
        IF (IFST.NE.0) THEN
C
C There are various possible cases, depending on whether the last point
C was inside or outside the window and whether the next point is inside
C or outside the window.
C
          IF (LPOW.EQ.0) THEN
            IF (NPOW.NE.0) GO TO 101
            XCRA(1)=CFUX(XLST)
            YCRA(1)=CFUY(YLST)
            XCRA(2)=CFUX(XNXT)
            YCRA(2)=CFUY(YNXT)
            CALL AREDAM (IAMA,XCRA,YCRA,2,IGID,IAIL,IAIR)
            IF (ICFELL('WLTOAM',1).NE.0) RETURN
            GO TO 115
          ELSE
            IF (NPOW.EQ.0) GO TO 103
            GO TO 105
          END IF
C
C Last point inside, next point outside.
C
  101     XPEW=XLST
          YPEW=YLST
          XDIF=XNXT-XLST
          YDIF=YNXT-YLST
C
          IF (ABS(XDIF).GT..000001*(XMAX-XMIN)) THEN
            XPEW=XMIN
            IF (XDIF.GE.0.) XPEW=XMAX
            YPEW=YLST+(XPEW-XLST)*YDIF/XDIF
            IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 102
          END IF
C
          IF (ABS(YDIF).GT..000001*(YMAX-YMIN)) THEN
            YPEW=YMIN
            IF (YDIF.GE.0.) YPEW=YMAX
            XPEW=XLST+(YPEW-YLST)*XDIF/YDIF
          END IF
C
  102     XCRA(1)=CFUX(XLST)
          YCRA(1)=CFUY(YLST)
          XCRA(2)=CFUX(XPEW)
          YCRA(2)=CFUY(YPEW)
          CALL AREDAM (IAMA,XCRA,YCRA,2,IGID,IAIL,IAIR)
          IF (ICFELL('WLTOAM',2).NE.0) RETURN
C
          GO TO 115
C
C Last point outside, next point inside.
C
  103     XPEW=XNXT
          YPEW=YNXT
          XDIF=XLST-XNXT
          YDIF=YLST-YNXT
C
          IF (ABS(XDIF).GT..000001*(XMAX-XMIN)) THEN
            XPEW=XMIN
            IF (XDIF.GE.0.) XPEW=XMAX
            YPEW=YNXT+(XPEW-XNXT)*YDIF/XDIF
            IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 104
          END IF
C
          IF (ABS(YDIF).GT..000001*(YMAX-YMIN)) THEN
            YPEW=YMIN
            IF (YDIF.GE.0.) YPEW=YMAX
            XPEW=XNXT+(YPEW-YNXT)*XDIF/YDIF
          END IF
C
  104     XCRA(1)=CFUX(XPEW)
          YCRA(1)=CFUY(YPEW)
          XCRA(2)=CFUX(XNXT)
          YCRA(2)=CFUY(YNXT)
          CALL AREDAM (IAMA,XCRA,YCRA,2,IGID,IAIL,IAIR)
          IF (ICFELL('WLTOAM',3).NE.0) RETURN
C
          GO TO 115
C
C Last point outside, next point outside.  Check whether or not part of
C the line joining them lies in the window.
C
  105     MPOW=9*LPOW+NPOW+41
C
          GO TO ( 115,115,115,115,115,106,115,106,106,
     +            115,115,115,107,115,106,107,106,106,
     +            115,115,115,107,115,115,107,107,115,
     +            115,109,109,115,115,106,115,106,106,
     +            115,115,115,115,115,115,115,115,115,
     +            108,108,115,108,115,115,107,107,115,
     +            115,109,109,115,115,109,115,115,115,
     +            108,108,109,108,115,109,115,115,115,
     +            108,108,115,108,115,115,115,115,115 ) , MPOW
C
  106     XPE1=XMIN
          YPT1=YMIN
          XPE2=XMAX
          YPT2=YMAX
          GO TO 110
C
  107     XPE1=XMIN
          YPT1=YMAX
          XPE2=XMAX
          YPT2=YMIN
          GO TO 110
C
  108     XPE1=XMAX
          YPT1=YMAX
          XPE2=XMIN
          YPT2=YMIN
          GO TO 110
C
  109     XPE1=XMAX
          YPT1=YMIN
          XPE2=XMIN
          YPT2=YMAX
C
  110     XDIF=XNXT-XLST
          YDIF=YNXT-YLST
C
          IF (ABS(XDIF).LE..000001*(XMAX-XMIN)) GO TO 112
          YPE1=YLST+(XPE1-XLST)*YDIF/XDIF
          YPE2=YLST+(XPE2-XLST)*YDIF/XDIF
C
          IF (ABS(YDIF).LE..000001*(YMAX-YMIN)) THEN
            IF (YPE1.LT.YMIN.OR.YPE1.GT.YMAX) GO TO 115
            IF (YPE2.LT.YMIN.OR.YPE2.GT.YMAX) GO TO 115
            GO TO 114
          END IF
C
          IF (YPE1.GE.YMIN.AND.YPE1.LE.YMAX) GO TO 111
          YPE1=YPT1
          XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
          IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 115
C
  111     IF (YPE2.GE.YMIN.AND.YPE2.LE.YMAX) GO TO 114
          GO TO 113
C
  112     YPE1=YPT1
          XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
          IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 115
C
  113     YPE2=YPT2
          XPE2=XLST+(YPE2-YLST)*XDIF/YDIF
          IF (XPE2.LT.XMIN.OR.XPE2.GT.XMAX) GO TO 115
C
  114     XCRA(1)=CFUX(XPE1)
          YCRA(1)=CFUY(YPE1)
          XCRA(2)=CFUX(XPE2)
          YCRA(2)=CFUY(YPE2)
          CALL AREDAM (IAMA,XCRA,YCRA,2,IGID,IAIL,IAIR)
          IF (ICFELL('WLTOAM',4).NE.0) RETURN
C
        END IF
C
C Processing of the next point is done.  It becomes the last point and
C we return to the user for a new next point.
C
  115   LPOW=NPOW
        XLST=XNXT
        YLST=YNXT
C
        RETURN
C
      END


      SUBROUTINE WLTOAF (XNXT,YNXT,IFST,ILTY,IAIL,IAIR,IATL,ISCL,NAML,
     +                                                 IATR,ISCR,NAMR)
C
      CHARACTER*(*) NAML,NAMR
C
C This is a windowing routine for line draws.  Code using it should
C declare the common block WDCOMN and put into it minimum and maximum
C values of X and Y that together define a window at the edges of which
C lines are to be clipped.  Once that has been done, each call to
C WLTOAF with IFST = 0 declares a point (XNXT,YNXT) at which a line
C is to begin and each call to WLTOAF with IFST = 1 declares a point
C (XNXT,YNXT) at which a line is to continue.
C
C This routine writes the coordinates to an ASCII file.  The values of
C XMIN, XMAX, YMIN, YMAX, XNXT, and YNXT are expected to be in the
C fractional coordinate system, but the coordinates are written in the
C user coordinate system.
C
C Declare the common block that holds the clipping window parameters.
C
        COMMON /WDCOMN/ XMIN,XMAX,YMIN,YMAX
C
        DIMENSION XCRA(2),YCRA(2)
C
C Certain quantities need to be saved from call to call.  LPOW is a
C "last-point-outside-window" flag.  (XLST,YLST) is the last point
C (from the previous call to WLTOAF).
C
        SAVE LPOW,XLST,YLST
C
C Compute a "next-point-outside-window" flag.  The value of this flag
C is between -4 and +4, depending on where the next point is relative
C to the window, as shown in the following diagram:
C
C                      |      |
C                   -2 |  +1  | +4
C            YMAX -----+------+-----
C                   -3 |   0  | +3
C            YMIN -----+------+-----
C                   -4 |  -1  | +2
C                      |      |
C                    XMIN    XMAX
C
C Ultimately, we combine the values of this flag for two consecutive
C points in such a way as to get an integer between 1 and 81, telling
C us what combination of inside/outside we have to deal with.
C
        NPOW=IFIX(3.*(SIGN(.51,XNXT-XMIN)+SIGN(.51,XNXT-XMAX))+
     +               (SIGN(.51,YNXT-YMIN)+SIGN(.51,YNXT-YMAX)))
C
C If the next point is not the first point of a line, there is work to
C be done.
C
        IF (IFST.NE.0) THEN
C
C There are various possible cases, depending on whether the last point
C was inside or outside the window and whether the next point is inside
C or outside the window.
C
          IF (LPOW.EQ.0) THEN
            IF (NPOW.NE.0) GO TO 101
            XCRA(1)=CFUX(XLST)
            YCRA(1)=CFUY(YLST)
            XCRA(2)=CFUX(XNXT)
            YCRA(2)=CFUY(YNXT)
            CALL WRTOAF (XCRA,YCRA,ILTY,IAIL,IAIR,IATL,ISCL,NAML,
     +                                            IATR,ISCR,NAMR)
            GO TO 115
          ELSE
            IF (NPOW.EQ.0) GO TO 103
            GO TO 105
          END IF
C
C Last point inside, next point outside.
C
  101     XPEW=XLST
          YPEW=YLST
          XDIF=XNXT-XLST
          YDIF=YNXT-YLST
C
          IF (ABS(XDIF).GT..000001*(XMAX-XMIN)) THEN
            XPEW=XMIN
            IF (XDIF.GE.0.) XPEW=XMAX
            YPEW=YLST+(XPEW-XLST)*YDIF/XDIF
            IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 102
          END IF
C
          IF (ABS(YDIF).GT..000001*(YMAX-YMIN)) THEN
            YPEW=YMIN
            IF (YDIF.GE.0.) YPEW=YMAX
            XPEW=XLST+(YPEW-YLST)*XDIF/YDIF
          END IF
C
  102     XCRA(1)=CFUX(XLST)
          YCRA(1)=CFUY(YLST)
          XCRA(2)=CFUX(XPEW)
          YCRA(2)=CFUY(YPEW)
          CALL WRTOAF (XCRA,YCRA,ILTY,IAIL,IAIR,IATL,ISCL,NAML,
     +                                          IATR,ISCR,NAMR)
C
          GO TO 115
C
C Last point outside, next point inside.
C
  103     XPEW=XNXT
          YPEW=YNXT
          XDIF=XLST-XNXT
          YDIF=YLST-YNXT
C
          IF (ABS(XDIF).GT..000001*(XMAX-XMIN)) THEN
            XPEW=XMIN
            IF (XDIF.GE.0.) XPEW=XMAX
            YPEW=YNXT+(XPEW-XNXT)*YDIF/XDIF
            IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 104
          END IF
C
          IF (ABS(YDIF).GT..000001*(YMAX-YMIN)) THEN
            YPEW=YMIN
            IF (YDIF.GE.0.) YPEW=YMAX
            XPEW=XNXT+(YPEW-YNXT)*XDIF/YDIF
          END IF
C
  104     XCRA(1)=CFUX(XPEW)
          YCRA(1)=CFUY(YPEW)
          XCRA(2)=CFUX(XNXT)
          YCRA(2)=CFUY(YNXT)
          CALL WRTOAF (XCRA,YCRA,ILTY,IAIL,IAIR,IATL,ISCL,NAML,
     +                                          IATR,ISCR,NAMR)
C
          GO TO 115
C
C Last point outside, next point outside.  Check whether or not part of
C the line joining them lies in the window.
C
  105     MPOW=9*LPOW+NPOW+41
C
          GO TO ( 115,115,115,115,115,106,115,106,106,
     +            115,115,115,107,115,106,107,106,106,
     +            115,115,115,107,115,115,107,107,115,
     +            115,109,109,115,115,106,115,106,106,
     +            115,115,115,115,115,115,115,115,115,
     +            108,108,115,108,115,115,107,107,115,
     +            115,109,109,115,115,109,115,115,115,
     +            108,108,109,108,115,109,115,115,115,
     +            108,108,115,108,115,115,115,115,115 ) , MPOW
C
  106     XPE1=XMIN
          YPT1=YMIN
          XPE2=XMAX
          YPT2=YMAX
          GO TO 110
C
  107     XPE1=XMIN
          YPT1=YMAX
          XPE2=XMAX
          YPT2=YMIN
          GO TO 110
C
  108     XPE1=XMAX
          YPT1=YMAX
          XPE2=XMIN
          YPT2=YMIN
          GO TO 110
C
  109     XPE1=XMAX
          YPT1=YMIN
          XPE2=XMIN
          YPT2=YMAX
C
  110     XDIF=XNXT-XLST
          YDIF=YNXT-YLST
C
          IF (ABS(XDIF).LE..000001*(XMAX-XMIN)) GO TO 112
          YPE1=YLST+(XPE1-XLST)*YDIF/XDIF
          YPE2=YLST+(XPE2-XLST)*YDIF/XDIF
C
          IF (ABS(YDIF).LE..000001*(YMAX-YMIN)) THEN
            IF (YPE1.LT.YMIN.OR.YPE1.GT.YMAX) GO TO 115
            IF (YPE2.LT.YMIN.OR.YPE2.GT.YMAX) GO TO 115
            GO TO 114
          END IF
C
          IF (YPE1.GE.YMIN.AND.YPE1.LE.YMAX) GO TO 111
          YPE1=YPT1
          XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
          IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 115
C
  111     IF (YPE2.GE.YMIN.AND.YPE2.LE.YMAX) GO TO 114
          GO TO 113
C
  112     YPE1=YPT1
          XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
          IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 115
C
  113     YPE2=YPT2
          XPE2=XLST+(YPE2-YLST)*XDIF/YDIF
          IF (XPE2.LT.XMIN.OR.XPE2.GT.XMAX) GO TO 115
C
  114     XCRA(1)=CFUX(XPE1)
          YCRA(1)=CFUY(YPE1)
          XCRA(2)=CFUX(XPE2)
          YCRA(2)=CFUY(YPE2)
          CALL WRTOAF (XCRA,YCRA,ILTY,IAIL,IAIR,IATL,ISCL,NAML,
     +                                          IATR,ISCR,NAMR)
C
        END IF
C
C Processing of the next point is done.  It becomes the last point and
C we return to the user for a new next point.
C
  115   LPOW=NPOW
        XLST=XNXT
        YLST=YNXT
C
        RETURN
C
      END


      SUBROUTINE WRTOAF (XCRA,YCRA,ILTY,IAIL,IAIR,IATL,ISCL,NAML,
     +                                            IATR,ISCR,NAMR)
        DIMENSION XCRA(2),YCRA(2)
        CHARACTER*(*) NAML,NAMR
        COMMON /WCCOMN/ NOSW
        SAVE   /WCCOMN/
        SAVE XLST,YLST,ILTL,IALL,IARL
        IF (NOSW.EQ.0.OR.XCRA(1).NE.XLST.OR.YCRA(1).NE.YLST.OR.
     +      ILTY.NE.ILTL.OR.IAIL.NE.IALL.OR.IAIR.NE.IARL) THEN
          NOSW=NOSW+1
          WRITE (14,'('' '')')
          WRITE (14,'(''---------------------------------------'')')
          WRITE (14,'('' '')')
          WRITE (14,'(''Line number:        '',I6)') NOSW
          WRITE (14,'('' '')')
          WRITE (14,'(''Type of line:       '',I6)') ILTY
          WRITE (14,'(''Index of area left: '',I6)') IAIL
          WRITE (14,'(''Index of area right:'',I6)') IAIR
          WRITE (14,'(''Type of area left:  '',I6)') IATL
          WRITE (14,'(''Type of area right: '',I6)') IATR
          WRITE (14,'(''Color of area left: '',I6)') ISCL
          WRITE (14,'(''Color of area right:'',I6)') ISCR
          WRITE (14,'('' '')')
          WRITE (14,'(''Names of areas left and right:'')')
          WRITE (14,'('' '')')
          WRITE (14,'(''  '',A)') NAML(1:MPILNB(NAML))
          WRITE (14,'(''  '',A)') NAMR(1:MPILNB(NAMR))
          WRITE (14,'('' '')')
          WRITE (14,'(''Point coordinates (longitude and latitude):'')')
          WRITE (14,'('' '')')
          WRITE (14,'(2F12.6)') XCRA(1),YCRA(1)
        END IF
        WRITE (14,'(2F12.6)') XCRA(2),YCRA(2)
        XLST=XCRA(2)
        YLST=YCRA(2)
        ILTL=ILTY
        IALL=IAIL
        IARL=IAIR
        RETURN
      END


      SUBROUTINE WLTV5D (XNXT,YNXT,IFST,ILTY,IAIL,IAIR,IFDE,IPSS)
C
C This is a windowing routine for line draws.  Code using it should
C declare the common block WDCOMN and put into it minimum and maximum
C values of X and Y that together define a window at the edges of which
C lines are to be clipped.  Once that has been done, each call to
C WLTV5D with IFST = 0 declares a point (XNXT,YNXT) at which a line
C is to begin and each call to WLTV5D with IFST = 1 declares a point
C (XNXT,YNXT) at which a line is to continue.
C
C This routine writes the coordinates to a Vis5D outline file.  The
C values of XMIN, XMAX, YMIN, YMAX, XNXT, and YNXT are expected to be
C in the fractional coordinate system, but the coordinates are written
C in the user coordinate system.  Three passes are required: when IPSS
C is 1, only the count of the number of polylines is written; when IPSS
C is 2, the polyline pointers are written; when IPSS is 3, the vertices
C are written.
C
C Declare the common block that holds the clipping window parameters.
C
        COMMON /WDCOMN/ XMIN,XMAX,YMIN,YMAX
C
        DIMENSION XCRA(2),YCRA(2)
C
C Certain quantities need to be saved from call to call.  LPOW is a
C "last-point-outside-window" flag.  (XLST,YLST) is the last point
C (from the previous call to WLTV5D).
C
        SAVE LPOW,XLST,YLST
C
C Compute a "next-point-outside-window" flag.  The value of this flag
C is between -4 and +4, depending on where the next point is relative
C to the window, as shown in the following diagram:
C
C                      |      |
C                   -2 |  +1  | +4
C            YMAX -----+------+-----
C                   -3 |   0  | +3
C            YMIN -----+------+-----
C                   -4 |  -1  | +2
C                      |      |
C                    XMIN    XMAX
C
C Ultimately, we combine the values of this flag for two consecutive
C points in such a way as to get an integer between 1 and 81, telling
C us what combination of inside/outside we have to deal with.
C
        NPOW=IFIX(3.*(SIGN(.51,XNXT-XMIN)+SIGN(.51,XNXT-XMAX))+
     +               (SIGN(.51,YNXT-YMIN)+SIGN(.51,YNXT-YMAX)))
C
C If the next point is not the first point of a line, there is work to
C be done.
C
        IF (IFST.NE.0) THEN
C
C There are various possible cases, depending on whether the last point
C was inside or outside the window and whether the next point is inside
C or outside the window.
C
          IF (LPOW.EQ.0) THEN
            IF (NPOW.NE.0) GO TO 101
            XCRA(1)=CFUX(XLST)
            YCRA(1)=CFUY(YLST)
            XCRA(2)=CFUX(XNXT)
            YCRA(2)=CFUY(YNXT)
            CALL WRTV5D (XCRA,YCRA,ILTY,IAIL,IAIR,IFDE,IPSS)
            GO TO 115
          ELSE
            IF (NPOW.EQ.0) GO TO 103
            GO TO 105
          END IF
C
C Last point inside, next point outside.
C
  101     XPEW=XLST
          YPEW=YLST
          XDIF=XNXT-XLST
          YDIF=YNXT-YLST
C
          IF (ABS(XDIF).GT..000001*(XMAX-XMIN)) THEN
            XPEW=XMIN
            IF (XDIF.GE.0.) XPEW=XMAX
            YPEW=YLST+(XPEW-XLST)*YDIF/XDIF
            IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 102
          END IF
C
          IF (ABS(YDIF).GT..000001*(YMAX-YMIN)) THEN
            YPEW=YMIN
            IF (YDIF.GE.0.) YPEW=YMAX
            XPEW=XLST+(YPEW-YLST)*XDIF/YDIF
          END IF
C
  102     XCRA(1)=CFUX(XLST)
          YCRA(1)=CFUY(YLST)
          XCRA(2)=CFUX(XPEW)
          YCRA(2)=CFUY(YPEW)
          CALL WRTV5D (XCRA,YCRA,ILTY,IAIL,IAIR,IFDE,IPSS)
C
          GO TO 115
C
C Last point outside, next point inside.
C
  103     XPEW=XNXT
          YPEW=YNXT
          XDIF=XLST-XNXT
          YDIF=YLST-YNXT
C
          IF (ABS(XDIF).GT..000001*(XMAX-XMIN)) THEN
            XPEW=XMIN
            IF (XDIF.GE.0.) XPEW=XMAX
            YPEW=YNXT+(XPEW-XNXT)*YDIF/XDIF
            IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 104
          END IF
C
          IF (ABS(YDIF).GT..000001*(YMAX-YMIN)) THEN
            YPEW=YMIN
            IF (YDIF.GE.0.) YPEW=YMAX
            XPEW=XNXT+(YPEW-YNXT)*XDIF/YDIF
          END IF
C
  104     XCRA(1)=CFUX(XPEW)
          YCRA(1)=CFUY(YPEW)
          XCRA(2)=CFUX(XNXT)
          YCRA(2)=CFUY(YNXT)
          CALL WRTV5D (XCRA,YCRA,ILTY,IAIL,IAIR,IFDE,IPSS)
C
          GO TO 115
C
C Last point outside, next point outside.  Check whether or not part of
C the line joining them lies in the window.
C
  105     MPOW=9*LPOW+NPOW+41
C
          GO TO ( 115,115,115,115,115,106,115,106,106,
     +            115,115,115,107,115,106,107,106,106,
     +            115,115,115,107,115,115,107,107,115,
     +            115,109,109,115,115,106,115,106,106,
     +            115,115,115,115,115,115,115,115,115,
     +            108,108,115,108,115,115,107,107,115,
     +            115,109,109,115,115,109,115,115,115,
     +            108,108,109,108,115,109,115,115,115,
     +            108,108,115,108,115,115,115,115,115 ) , MPOW
C
  106     XPE1=XMIN
          YPT1=YMIN
          XPE2=XMAX
          YPT2=YMAX
          GO TO 110
C
  107     XPE1=XMIN
          YPT1=YMAX
          XPE2=XMAX
          YPT2=YMIN
          GO TO 110
C
  108     XPE1=XMAX
          YPT1=YMAX
          XPE2=XMIN
          YPT2=YMIN
          GO TO 110
C
  109     XPE1=XMAX
          YPT1=YMIN
          XPE2=XMIN
          YPT2=YMAX
C
  110     XDIF=XNXT-XLST
          YDIF=YNXT-YLST
C
          IF (ABS(XDIF).LE..000001*(XMAX-XMIN)) GO TO 112
          YPE1=YLST+(XPE1-XLST)*YDIF/XDIF
          YPE2=YLST+(XPE2-XLST)*YDIF/XDIF
C
          IF (ABS(YDIF).LE..000001*(YMAX-YMIN)) THEN
            IF (YPE1.LT.YMIN.OR.YPE1.GT.YMAX) GO TO 115
            IF (YPE2.LT.YMIN.OR.YPE2.GT.YMAX) GO TO 115
            GO TO 114
          END IF
C
          IF (YPE1.GE.YMIN.AND.YPE1.LE.YMAX) GO TO 111
          YPE1=YPT1
          XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
          IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 115
C
  111     IF (YPE2.GE.YMIN.AND.YPE2.LE.YMAX) GO TO 114
          GO TO 113
C
  112     YPE1=YPT1
          XPE1=XLST+(YPE1-YLST)*XDIF/YDIF
          IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 115
C
  113     YPE2=YPT2
          XPE2=XLST+(YPE2-YLST)*XDIF/YDIF
          IF (XPE2.LT.XMIN.OR.XPE2.GT.XMAX) GO TO 115
C
  114     XCRA(1)=CFUX(XPE1)
          YCRA(1)=CFUY(YPE1)
          XCRA(2)=CFUX(XPE2)
          YCRA(2)=CFUY(YPE2)
          CALL WRTV5D (XCRA,YCRA,ILTY,IAIL,IAIR,IFDE,IPSS)
C
        END IF
C
C Processing of the next point is done.  It becomes the last point and
C we return to the user for a new next point.
C
  115   LPOW=NPOW
        XLST=XNXT
        YLST=YNXT
C
        RETURN
C
      END


      SUBROUTINE WRTV5D (XCRA,YCRA,ILTY,IAIL,IAIR,IFDE,IPSS)
        DIMENSION XCRA(2),YCRA(2)
        DIMENSION IWLL(2)
        EQUIVALENCE (IWLL(1),ILAT),(IWLL(2),ILON)
        COMMON /WCCOMN/ NOSW
        SAVE   /WCCOMN/
        COMMON /WVCOMN/ NOSS,NOVS,ISEG(6)
        SAVE   /WVCOMN/
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
        SAVE XLST,YLST,ILTL,IALL,IARL
        IF (NOSS.EQ.0.OR.XCRA(1).NE.XLST.OR.YCRA(1).NE.YLST.OR.
     +      ILTY.NE.ILTL.OR.IAIL.NE.IALL.OR.IAIR.NE.IARL) THEN
          IF (IPSS.EQ.2) THEN
            IF (NOSS.GT.0) THEN
              CALL NGWRIN (IFDE,ISEG,6,ISTA)
              IF (ISTA.NE.6) THEN
                PRINT * , 'Error on write to file.',Q
              END IF
            END IF
            ILAT= INT(10000.*YCRA(1))
            ILON=-INT(10000.*XCRA(1))
            ISEG(1)=ILAT
            ISEG(2)=ILAT
            ISEG(3)=ILON
            ISEG(4)=ILON
            ISEG(5)=1+6*NOSW+2*NOVS
            ISEG(6)=2
          ELSE IF (IPSS.EQ.3) THEN
            ILAT= INT(10000.*YCRA(1))
            ILON=-INT(10000.*XCRA(1))
            CALL NGWRIN (IFDE,IWLL,2,ISTA)
            IF (ISTA.NE.2) THEN
              PRINT * , 'Error on write to file.',Q
            END IF
          END IF
          NOSS=NOSS+1
          NOVS=NOVS+1
        END IF
        IF (IPSS.EQ.2) THEN
          ILAT= INT(10000.*YCRA(2))
          ILON=-INT(10000.*XCRA(2))
          ISEG(1)=MIN(ISEG(1),ILAT)
          ISEG(2)=MAX(ISEG(2),ILAT)
          ISEG(3)=MIN(ISEG(3),ILON)
          ISEG(4)=MAX(ISEG(4),ILON)
          ISEG(6)=ISEG(6)+2
        ELSE IF (IPSS.EQ.3) THEN
          ILAT= INT(10000.*YCRA(2))
          ILON=-INT(10000.*XCRA(2))
          CALL NGWRIN (IFDE,IWLL,2,ISTA)
          IF (ISTA.NE.2) THEN
            PRINT * , 'Error on write to file.',Q
          END IF
        END IF
        NOVS=NOVS+1
        XLST=XCRA(2)
        YLST=YCRA(2)
        ILTL=ILTY
        IALL=IAIL
        IARL=IAIR
        RETURN
      END


      FUNCTION ILSINT (XCPA,YCPA,XCPB,YCPB,XCPC,YCPC,XCPD,YCPD)
C
C This function has a non-zero value if and only if the 2D line
C segments AB and CD overlap.
C
C Initialize the value of the function to say that the line
C segments don't intersect.
C
        ILSINT=0
C
C Compute a denominator needed below.  (Its value is zero if and
C only if the line segments are parallel.)
C
        DNOM=(XCPB-XCPA)*(YCPD-YCPC)-(XCPD-XCPC)*(YCPB-YCPA)
C
C If the line segments are parallel, they don't intersect.
C
        IF (DNOM.EQ.0.) RETURN
C
C Otherwise, find the values of S and T, in the parametric equations
C for line segments AB and CD, for which intersection occurs.
C
        S=((XCPC-XCPA)*(YCPD-YCPC)-(XCPD-XCPC)*(YCPC-YCPA))/DNOM
        T=((XCPC-XCPA)*(YCPB-YCPA)-(XCPB-XCPA)*(YCPC-YCPA))/DNOM
C
C If both S and T are strictly between 0 and 1, the line segments
C intersect; otherwise, they don't.
C
        IF (S.GT.0..AND.S.LT.1..AND.T.GT.0..AND.T.LT.1.) ILSINT=1
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE COLORA (XCRA,YCRA,NCRA,IAAI,IAGI,NGPS)
        DIMENSION XCRA(NCRA),YCRA(NCRA),IAAI(NGPS),IAGI(NGPS)
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
        IF (NCRA.GT.1) THEN
          IF (NGPS.EQ.1.AND.IAGI(1).EQ.1.AND.
     +        IAAI(1).GE.1.AND.IAAI(1).LE.MNAI) THEN
            IF      (ISPOAI(IAAI(1),IOAP).NE.0) THEN
              ICOL=17
            ELSE IF (ISPOAI(IAAI(1),IOAS).NE.0.OR.
     +               ISPOAN(IAAI(1),NOAS).NE.0) THEN
              ICOL=19
            ELSE
              ICOL=20+ISCI(IAAI(1))
            END IF
            CALL GSFACI (ICOL)
            CALL GFA (NCRA-1,XCRA,YCRA)
          END IF
        END IF
        RETURN
      END


      SUBROUTINE LABELA (XCRA,YCRA,NCRA,IAAI,IAGI,NGPS)
        DIMENSION XCRA(NCRA),YCRA(NCRA),IAAI(NGPS),IAGI(NGPS)
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
        CHARACTER*64 CHRS,CHRT
        CALL GETSET (XVPL,XVPR,YVPB,YVPT,XWDL,XWDR,YWDB,YWDT,LNLG)
        IF (NCRA.GT.1) THEN
          IF (NGPS.EQ.1.AND.IAGI(1).EQ.1.AND.
     +        IAAI(1).GE.1.AND.IAAI(1).LE.MNAI) THEN
            CHRS=NAME(IAAI(1))
            ITMP=IPAR(IAAI(1))
            ICNT=0
  101       IF (ITMP.NE.0) THEN
              IF (IATY(ITMP).EQ.IATY(IAAI(1))) THEN
                LNAM=MPILNB(NAME(ITMP))
                CHRT=NAME(ITMP)(1:LNAM)//' - '//CHRS
                CHRS=CHRT
                ITMP=IPAR(ITMP)
                ICNT=ICNT+1
                IF (ICNT.LT.10) GO TO 101
              END IF
            END IF
          ELSE
            CHRS=' '
          END IF
          IF (CHRS.NE.' '.AND.
     +        CHRS.NE.'Land'.AND.
     +        CHRS.NE.'Water'.AND.
     +       (CHRS.NE.'Ocean'.OR.IATY(IAAI(1)).NE.2)) THEN
            XCEN=0.
            YCEN=0.
            WSUM=0.
C           WEDG=0.
            DO 102 I=1,NCRA-1
              WGHT=SQRT((XCRA(I+1)-XCRA(I))**2+(YCRA(I+1)-YCRA(I))**2)
              XCEN=XCEN+WGHT*(XCRA(I)+XCRA(I+1))/2.
              YCEN=YCEN+WGHT*(YCRA(I)+YCRA(I+1))/2.
              WSUM=WSUM+WGHT
C             IF ((XCRA(I).EQ.XWDL.AND.XCRA(I+1).EQ.XWDL).OR.
C    +            (XCRA(I).EQ.XWDR.AND.XCRA(I+1).EQ.XWDR).OR.
C    +            (YCRA(I).EQ.YWDB.AND.YCRA(I+1).EQ.YWDB).OR.
C    +            (YCRA(I).EQ.YWDT.AND.YCRA(I+1).EQ.YWDT))
C    +                                                    WEDG=WEDG+WGHT
  102       CONTINUE
            XCEN=XCEN/WSUM
            YCEN=YCEN/WSUM
            XRNG=0.
            YRNG=0.
            DO 103 I=1,NCRA-1
              WGHT=SQRT((XCRA(I+1)-XCRA(I))**2+(YCRA(I+1)-YCRA(I))**2)
              XRNG=XRNG+WGHT*((XCRA(I)+XCRA(I+1))/2.-XCEN)**2
              YRNG=YRNG+WGHT*((YCRA(I)+YCRA(I+1))/2.-YCEN)**2
  103       CONTINUE
            XRNG=2.*SQRT(XRNG/WSUM)
            YRNG=2.*SQRT(YRNG/WSUM)
            IOFC=MPIFNB(CHRS)
            IOLC=MPILNB(CHRS)
            CALL PLCHHQ (XCEN,YCEN,CHRS(IOFC:IOLC),CSAN,360.,0.)
            CALL PCGETR ('DL',DLFT)
            CALL PCGETR ('DR',DRGT)
            CALL PCGETR ('DB',DBOT)
            CALL PCGETR ('DT',DTOP)
            CSMU=MIN(1.,XRNG/(DLFT+DRGT),YRNG/(DBOT+DTOP))
            IF (CSMU.GE..25)
     +          CALL PLCHHQ (XCEN,YCEN,CHRS(IOFC:IOLC),CSMU*CSAN,0.,0.)
          END IF
        END IF
        RETURN
      END


      SUBROUTINE NUMBRA (XCRA,YCRA,NCRA,IAAI,IAGI,NGPS)
        DIMENSION XCRA(NCRA),YCRA(NCRA),IAAI(NGPS),IAGI(NGPS)
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
        CHARACTER*5 CHRS
        IF (NCRA.GT.1) THEN
          NODA=NODA+1
          IF (NODA.GT.0.AND.NODA.LE.1000) THEN
            IONA(NODA)=0
            IF (NGPS.EQ.1.AND.IAGI(1).EQ.1.AND.
     +          IAAI(1).GE.1.AND.IAAI(1).LE.MNAI) THEN
              IONA(NODA)=IAAI(1)
              IF      (ISPOAI(IAAI(1),IOAP).NE.0) THEN
                ICOL=17
              ELSE IF (ISPOAI(IAAI(1),IOAS).NE.0.OR.
     +                 ISPOAN(IAAI(1),NOAS).NE.0) THEN
                ICOL=19
              ELSE
                ICOL=20+ISCI(IAAI(1))
              END IF
            ELSE
              ICOL=1
            END IF
            XCEN=0.
            YCEN=0.
            WSUM=0.
            DO 101 I=1,NCRA-1
              WGHT=SQRT((XCRA(I+1)-XCRA(I))**2+(YCRA(I+1)-YCRA(I))**2)
              XCEN=XCEN+WGHT*(XCRA(I)+XCRA(I+1))/2.
              YCEN=YCEN+WGHT*(YCRA(I)+YCRA(I+1))/2.
              WSUM=WSUM+WGHT
  101       CONTINUE
            XCEN=XCEN/WSUM
            YCEN=YCEN/WSUM
            WRITE (CHRS,'(I5)') NODA
            CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (ICOL)
            CALL GSFACI (ICOL)
            CALL PLCHHQ (XCEN,YCEN,CHRS(MPIFNB(CHRS):MPILNB(CHRS)),
     +                                                  .018,0.,0.)
            CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (1)
            CALL GSFACI (1)
          END IF
        END IF
        RETURN
      END


      SUBROUTINE UPDATA (XCRA,YCRA,NCRA,IAAI,IAGI,NGPS)
        DIMENSION XCRA(NCRA),YCRA(NCRA),IAAI(NGPS),IAGI(NGPS)
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
        COMMON /EDCOM3/ VP(4),WD(4),LL
        SAVE   /EDCOM3/
        CHARACTER*5 CHRS
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
        AFCUFX(UX)=(UX-WD(1))/(WD(2)-WD(1))*(VP(2)-VP(1))+VP(1)
        AFCUFY(UY)=(UY-WD(3))/(WD(4)-WD(3))*(VP(4)-VP(3))+VP(3)
C
        IF (NCRA.GT.1) THEN
          NODA=NODA+1
          IF (NODA.EQ.IODA) THEN
            INDX=IONA(IODA)
            CALL PLOTIF (0.,0.,2)
            CALL GSFACI (20+ISCI(INDX))
            CALL GFA    (NCRA-1,XCRA,YCRA)
            CALL PLOTIF (0.,0.,2)
            CALL GSFACI (1)
            CALL GSPLCI (1)
            XCEN=0.
            YCEN=0.
            WSUM=0.
            DO 101 I=1,NCRA-1
              WGHT=SQRT((XCRA(I+1)-XCRA(I))**2+(YCRA(I+1)-YCRA(I))**2)
              XCEN=XCEN+WGHT*(XCRA(I)+XCRA(I+1))/2.
              YCEN=YCEN+WGHT*(YCRA(I)+YCRA(I+1))/2.
              WSUM=WSUM+WGHT
  101       CONTINUE
            XCEN=XCEN/WSUM
            YCEN=YCEN/WSUM
            WRITE (CHRS,'(I5)') NODA
            CALL PLCHHQ (XCEN,YCEN,CHRS(MPIFNB(CHRS):MPILNB(CHRS)),
     +                                                  .018,0.,0.)
            CALL ARGETI ('DI - DIRECTION',IDIR)
            DO 104 I=1,NCRA-1
              DO 103 IOES=1,NOES
                DO 102 IOEP=IOFP(IOES),IOLP(IOES)-1
                  ITST=IOVRLA(AFCUFX(XCRD(IOEP  )),
     +                        AFCUFY(YCRD(IOEP  )),
     +                        AFCUFX(XCRD(IOEP+1)),
     +                        AFCUFY(YCRD(IOEP+1)),
     +                        XCRA(I),YCRA(I),XCRA(I+1),YCRA(I+1))
                  IF (ITST.NE.0.AND.(IAIL(IOES).EQ.1087.OR.
     +                               IAIR(IOES).EQ.1087)) THEN
C                   PRINT * , 'ERROR FOUND',Q
C                   PRINT * , 'X1 = ',AFCUFX(XCRD(IOEP  )),Q
C                   PRINT * , 'Y1 = ',AFCUFY(YCRD(IOEP  )),Q
C                   PRINT * , 'X2 = ',AFCUFX(XCRD(IOEP+1)),Q
C                   PRINT * , 'X2 = ',AFCUFY(YCRD(IOEP+1)),Q
C                   PRINT * , 'X3 = ',XCRA(I),Q
C                   PRINT * , 'Y3 = ',YCRA(I),Q
C                   PRINT * , 'X4 = ',XCRA(I+1),Q
C                   PRINT * , 'X4 = ',YCRA(I+1),Q
C                   WRITE (*,'(E20.12,A)') AFCUFX(XCRD(IOEP  )),Q
C                   WRITE (*,'(E20.12,A)') AFCUFY(YCRD(IOEP  )),Q
C                   WRITE (*,'(E20.12,A)') AFCUFX(XCRD(IOEP+1)),Q
C                   WRITE (*,'(E20.12,A)') AFCUFY(YCRD(IOEP+1)),Q
C                   WRITE (*,'(E20.12,A)') XCRA(I),Q
C                   WRITE (*,'(E20.12,A)') YCRA(I),Q
C                   WRITE (*,'(E20.12,A)') XCRA(I+1),Q
C                   WRITE (*,'(E20.12,A)') YCRA(I+1),Q
                  END IF
                  IF (ITST.GT.0) THEN
                    PRINT * , 'CHECKPOINT 1',IOES,Q
                    IF (ILTY(IOES).EQ.0) ILTY(IOES)=IATY(INDX)
                    IF (IDIR.EQ.1) THEN
                      IAIL(IOES)=INDX
                    ELSE
                      IAIR(IOES)=INDX
                    END IF
                    GO TO 104
                  ELSE IF (ITST.LT.0) THEN
                    PRINT * , 'CHECKPOINT 2',IOES,Q
                    IF (ILTY(IOES).EQ.0) ILTY(IOES)=IATY(INDX)
                    IF (IDIR.EQ.1) THEN
                      IAIR(IOES)=INDX
                    ELSE
                      IAIL(IOES)=INDX
                    END IF
                    GO TO 104
                  END IF
  102           CONTINUE
  103         CONTINUE
  104       CONTINUE
          END IF
        END IF
        RETURN
      END


      INTEGER FUNCTION IOAREA (ILVL,IAID)
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
        ITMP=IAID
        NSTP=0
  101   IF (IATY(ITMP).GT.ILVL) THEN
          IF (IPAR(ITMP).GE.1.AND.IPAR(ITMP).LE.MNAI) THEN
            IF (IATY(IPAR(ITMP)).NE.0) THEN
              ITMP=IPAR(ITMP)
              NSTP=NSTP+1
              IF (NSTP.LT.10) GO TO 101
            END IF
          END IF
        END IF
        IOAREA=ITMP
        RETURN
      END


      INTEGER FUNCTION ISPOAI (IAI1,IAI2)
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
        ISPOAI=0
        IF (IAI2.LE.0) RETURN
        ITMP=IAI1
        NSTP=0
  101   IF (ITMP.NE.IAI2) THEN
          IF (IPAR(ITMP).NE.0.AND.NSTP.LT.10) THEN
            ITMP=IPAR(ITMP)
            NSTP=NSTP+1
            GO TO 101
          END IF
        ELSE
          ISPOAI=1
        END IF
        RETURN
      END


      INTEGER FUNCTION ISPOAN (IAIN,ANME)
        CHARACTER*(*) ANME
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
        ISPOAN=0
        IF (ANME.EQ.' ') RETURN
        ITMP=IAIN
        NSTP=0
  101   IF (NAME(ITMP).NE.ANME) THEN
          IF (IPAR(ITMP).NE.0.AND.NSTP.LT.10) THEN
            ITMP=IPAR(ITMP)
            NSTP=NSTP+1
            GO TO 101
          END IF
        ELSE
          ISPOAN=1
        END IF
        RETURN
      END


      SUBROUTINE INTERS (X1,Y1,X2,Y2,X3,Y3,X4,Y4,S,T)
C
C This subroutine, given points P1, P2, P3, and P4, returns S and T
C such that the point of intersection of P1P2 with P3P4 is at
C
C   (X1+S*(X2-X1),Y1+S*(Y2-Y1)) = (X3+T*(X4-X3),Y3+T*(Y4-Y3))
C
C If P1P2 is parallel to P3P4, then S and T come back equal to 1.E12.
C
        DN=(X2-X1)*(Y3-Y4)-(X3-X4)*(Y2-Y1)
C
        IF (DN.NE.0.) THEN
          S=((X3-X4)*(Y1-Y3)-(X1-X3)*(Y3-Y4))/DN
          T=((X1-X3)*(Y2-Y1)-(X2-X1)*(Y1-Y3))/DN
        ELSE
          S=1.E12
          T=1.E12
        END IF
C
        RETURN
C
      END


      FUNCTION IOVRLA (X1,Y1,X2,Y2,X3,Y3,X4,Y4)
C
C This function, given points P1, P2, P3, and P4, has the value 0 if the
C vector from P3 to P4 does not lie on top of the one from P1 to P2, the
C value 1 if it does and it points in the same direction, and the value
C -1 if it does and it points in the opposite direction.  This function
C assumes that all points are somewhere in the unit square.
C
C Define an epsilon for use below.
C
        PARAMETER (EPSI=.0001)
C
C Define an arithmetic statement function giving the distance from the
C point (X1,Y1) to the point (X2,Y2).
C
        DIST(X1,Y1,X2,Y2)=SQRT((X2-X1)**2+(Y2-Y1)**2)
C
C Define an arithmetic statement function giving the directed distance
C of the point (X3,Y3) from the line joining (X1,Y1) and (X2,Y2),
C negative if and only if the point is to the right of the line.
C
        PERP(X1,Y1,X2,Y2,X3,Y3)=((X1-X3)*(Y2-Y3)-(Y1-Y3)*(X2-X3))/D1T2
C
C Define an arithmetic statement function giving the directed distance
C of the point (X3,Y3) from a line perpendicular to the line joining
C (X1,Y1) to (X2,Y2) and passing through (X1,Y1), negative if and only
C if the point is on the opposite side of the line from (X2,Y2).
C
        PARA(X1,Y1,X2,Y2,X3,Y3)=PERP(X1,Y1,X1+Y2-Y1,Y1-X2+X1,X3,Y3)
C
        IOVRLA=0
C
        D1T2=DIST(X1,Y1,X2,Y2)
C
        IF (D1T2.LT.EPSI) RETURN
C
        IF (ABS(PERP(X1,Y1,X2,Y2,X3,Y3)).GT.EPSI) RETURN
C
        IF (ABS(PERP(X1,Y1,X2,Y2,X4,Y4)).GT.EPSI) RETURN
C
        PAR3=PARA(X1,Y1,X2,Y2,X3,Y3)
        IF (PAR3.LT.-EPSI.OR.PAR3.GT.D1T2+EPSI) RETURN
C
        PAR4=PARA(X1,Y1,X2,Y2,X4,Y4)
        IF (PAR4.LT.-EPSI.OR.PAR4.GT.D1T2+EPSI) RETURN
C
        IF (PAR3.LT.PAR4) THEN
          IOVRLA=1
        ELSE
          IOVRLA=-1
        END IF
C
        RETURN
C
      END


      SUBROUTINE RNGSOL (IRGL,RWRK,LRWK,SLAM,SLOM,BLAM,BLOM)
C
        DIMENSION RWRK(LRWK)
        DOUBLE PRECISION SLAM,SLOM,BLAM,BLOM
C
C This routine is called to draw RANGS/GSHHS outlines in the current
C window.  The argument IRGL specifies the level of resolution to be
C used, from 0 (highest resolution) to 4 (lowest resolution).
C
C Declare local variable.
C
        REAL             DUMI(4)
C
C Open the RANGS/GSHHS files.
C
        CALL RNGSOF (MAX(0,MIN(4,IRGL)),ICAT,ICEL,IRIM)
C
C Save the current state of the GKS clipping flag and turn clipping on.
C (Note that the call to GTX to write a blank is a work-around that has
C no visible effect on the picture but causes GKS to send the clipping
C flag and clipping rectangle to a workstation even if nothing else had
C previously been sent to it, so don't take it out unless you know that
C the behavior of GKS in this regard has been changed.)
C
        CALL GQCLIP (IERR,IGCF,DUMI)
C
        CALL GTX    (CFUX(.5),CFUY(.5),' ')
C
        CALL GSCLIP (1)
C
C Save the current polyline color.
C
        CALL GQPLCI (IERR,IPLC)
C
C Loop through all the 1-degree lat/lon squares; for each one, do a
C quick test to see if the square is entirely invisible and, if not,
C do more exhaustive tests to see if part of it is visible.
C
        DO 102 ILON=0,359
          IF ((DBLE(ILON   ).GT.BLOM.OR.
     +         DBLE(ILON+1 ).LT.SLOM).AND.
     +        (DBLE(ILON-360).GT.BLOM.OR.
     +         DBLE(ILON-359).LT.SLOM).AND.
     +        (DBLE(ILON+360).GT.BLOM.OR.
     +         DBLE(ILON+361).LT.SLOM))                        GO TO 102
          DO 101 ILAT = -90,89
            IF ((DBLE(ILAT).GT.BLAM.OR.DBLE(ILAT+1).LT.SLAM))  GO TO 101
            CALL RNGSSQ (ICAT,ICEL,IRIM,ILAT,ILON,0,
     +                                       RWRK,RWRK(LRWK/2+1),LRWK/2)
  101     CONTINUE
  102   CONTINUE
C
C Restore the polyline color to its original value.
C
        CALL GSPLCI (IPLC)
C
C Reset the clipping flag.
C
        CALL GSCLIP (IGCF)
C
C Close all RANGS/GSHHS files.
C
        CALL NGCLFI (ICAT)
        CALL NGCLFI (ICEL)
        CALL NGCLFI (IRIM)
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE RNGSGL (IRGL,RWRK,LRWK,SLAM,SLOM,BLAM,BLOM)
C
        DIMENSION RWRK(LRWK)
        DOUBLE PRECISION SLAM,SLOM,BLAM,BLOM
C
C This routine is called to get RANGS/GSHHS outlines from the current
C window and add them to the data being edited.  The argument IRGL
C specifies the level of resolution to be used, from 0 (highest
C resolution) to 4 (lowest resolution).
C
C Open the RANGS/GSHHS files.
C
        CALL RNGSOF (MAX(0,MIN(4,IRGL)),ICAT,ICEL,IRIM)
C
C Loop through all the 1-degree lat/lon squares; for each one, do a
C quick test to see if the square is entirely invisible and, if not,
C do more exhaustive tests to see if part of it is visible.
C
        DO 102 ILON=0,359
          IF ((DBLE(ILON   ).GT.BLOM.OR.
     +         DBLE(ILON+1 ).LT.SLOM).AND.
     +        (DBLE(ILON-360).GT.BLOM.OR.
     +         DBLE(ILON-359).LT.SLOM).AND.
     +        (DBLE(ILON+360).GT.BLOM.OR.
     +         DBLE(ILON+361).LT.SLOM))                        GO TO 102
          DO 101 ILAT = -90,89
            IF ((DBLE(ILAT).GT.BLAM.OR.DBLE(ILAT+1).LT.SLAM))  GO TO 101
            CALL RNGSSQ (ICAT,ICEL,IRIM,ILAT,ILON,2,
     +                                       RWRK,RWRK(LRWK/2+1),LRWK/2)
  101     CONTINUE
  102   CONTINUE
C
C Close all RANGS/GSHHS files.
C
        CALL NGCLFI (ICAT)
        CALL NGCLFI (ICEL)
        CALL NGCLFI (IRIM)
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE RNGSSF (IRGL,RWRK,LRWK,SLAM,SLOM,BLAM,BLOM)
C
        DIMENSION RWRK(LRWK)
        DOUBLE PRECISION SLAM,SLOM,BLAM,BLOM
C
C This routine is called to draw RANGS/GSHHS polygons in the current
C window.  The argument IRGL specifies the level of resolution to be
C used, from 0 (highest resolution) to 4 (lowest resolution).
C
C Declare local variable.
C
        REAL             DUMI(4)
C
C Open the RANGS/GSHHS files.
C
        CALL RNGSOF (MAX(0,MIN(4,IRGL)),ICAT,ICEL,IRIM)
C
C Save the current state of the GKS clipping flag and turn clipping on.
C (Note that the call to GTX to write a blank is a work-around that has
C no visible effect on the picture but causes GKS to send the clipping
C flag and clipping rectangle to a workstation even if nothing else had
C previously been sent to it, so don't take it out unless you know that
C the behavior of GKS in this regard has been changed.)
C
        CALL GQCLIP (IERR,IGCF,DUMI)
C
        CALL GTX    (CFUX(.5),CFUY(.5),' ')
C
        CALL GSCLIP (1)
C
C Save the current fill-area color.
C
        CALL GQFACI (IERR,IFAC)
C
C Loop through all the 1-degree lat/lon squares; for each one, do a
C quick test to see if the square is entirely invisible and, if not,
C do more exhaustive tests to see if part of it is visible.
C
        DO 102 ILON=0,359
          IF ((DBLE(ILON   ).GT.BLOM.OR.
     +         DBLE(ILON+1 ).LT.SLOM).AND.
     +        (DBLE(ILON-360).GT.BLOM.OR.
     +         DBLE(ILON-359).LT.SLOM).AND.
     +        (DBLE(ILON+360).GT.BLOM.OR.
     +         DBLE(ILON+361).LT.SLOM))                        GO TO 102
          DO 101 ILAT = -90,89
            IF ((DBLE(ILAT).GT.BLAM.OR.DBLE(ILAT+1).LT.SLAM))  GO TO 101
            CALL RNGSSQ (ICAT,ICEL,IRIM,ILAT,ILON,1,
     +                                       RWRK,RWRK(LRWK/2+1),LRWK/2)
  101     CONTINUE
  102   CONTINUE
C
C Restore the fill-area color to its original value.
C
        CALL GSFACI (IFAC)
C
C Reset the clipping flag.
C
        CALL GSCLIP (IGCF)
C
C Close all RANGS/GSHHS files.
C
        CALL NGCLFI (ICAT)
        CALL NGCLFI (ICEL)
        CALL NGCLFI (IRIM)
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE RNGSSQ (ICAT,ICEL,IRIM,ILAT,ILON,IFLL,XCRA,YCRA,MCRA)
C
        DIMENSION XCRA(MCRA),YCRA(MCRA)
C
C This routine, given the file identifiers ICAT, ICEL, and IRIM for a
C particular level of the RANGS/GSHHS data, the integer latitude and
C longitude ILAT and ILON (-90.LE.ILAT.LE.89 and 0.LE.ILON.LE.359) of
C the lower left-hand corner of a particular 1-degree square, and a
C flag IFLL, retrieves the polygons within the specified square and
C either draws them (if IFLL = 0), fills them (if IFLL = 1), and adds
C them to the data being edited (if IFLL = 2 or 3).  The arrays XCRA
C and YCRA are used to hold the coordinates of points defining polygons
C retrieved from the data arrays.
C
C Declare the common block in which colors for outlines and solid fill
C are passed from the main program to RNGSSQ.
C
        COMMON /RNGSCO/  IKOL(5),IKSF(5)
        SAVE   /RNGSCO/
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
C Declare local variables.
C
        DOUBLE PRECISION DLAT,DLON,PLAT,PLON,QLAT,QLON,RLAT,RLON,XCRD,
     +                   XLAT,XLON,YCRD
C
C CTM4 and CTM1 are character temporaries into which we can read a group
C of four bytes or a single byte, respectively.  (Because the data are
C written in a byte-swapped fashion, we cannot read a four-byte quantity
C as if it were an integer; instead, we must read the four bytes and put
C the integer together.)
C
        CHARACTER*4 CTM4
        CHARACTER*1 CTM1
C
C Define an amended version of the FORTRAN function ICHAR that will work
C on machines like the IBM, which sign-extend eight-bit characters.
C
        CHARACTER*1 CARG
C
        ICHARF(CARG)=MOD(ICHAR(CARG)+256,256)
C
C Compute the values of the parameters DLON and DLAT.
C
        DLON=.5D0
        DLAT=.5D0
C
C Zero the polygon-level counter and the count of polygon points saved.
C
        ILEV=0
        NCRA=0
C
C Look in the catalog for a pointer to the definition of the desired
C 1-degree square in the cell file.
C
        CALL NGSEEK (ICAT,4*((89-ILAT)*360+ILON),0,ISTA)
C
        IF (ISTA.LT.0) THEN
          PRINT * , 'RNGSSQ - SEEK FAILURE IN CAT FILE',Q
          CALL EDSTOP
        END IF
C
        CALL NGRDCH (ICAT,CTM4,4,ISTA)
C
        IF (ISTA.NE.4) THEN
          PRINT * , 'RNGSSQ - READ FAILURE IN CAT FILE',Q
          CALL EDSTOP
        END IF
C
        IPOS=IOR(ISHIFT(IOR(ISHIFT(IOR(ISHIFT(ICHARF(CTM4(4:4)),8),
     +                                        ICHARF(CTM4(3:3))),8),
     +                                        ICHARF(CTM4(2:2))),8),
     +                                        ICHARF(CTM4(1:1)))-1
C
C Position the cell file to the start of the definition.
C
        CALL NGSEEK (ICEL,IPOS,0,ISTA)
C
        IF (ISTA.LT.0) THEN
          PRINT * ,  'RNGSSQ - SEEK FAILURE IN CEL FILE'
          CALL EDSTOP
        END IF
C
C Read a new polygon byte.
C
  101   CALL NGRDCH (ICEL,CTM1,1,ISTA)
C
        IF (ISTA.NE.1) THEN
          PRINT * , 'RNGSSQ - READ FAILURE IN CEL FILE',Q
          CALL EDSTOP
        END IF
C
        IPGB = ICHARF(CTM1)
C
C If the polygon byte is non-zero, we are at the start of a new polygon.
C
        IF (IPGB.NE.0) THEN
C
C Bump the value of ILEV by one.  This is done because the definition
C of a polygon is recursive; it can itself include one or more interior
C polygons that form holes in it.  Each polygon begins with a non-zero
C polygon byte and ends with a zero polygon byte; if, when we read for
C a polygon byte, we get a non-zero value, we know that a new level of
C recursion is beginning.
C
          ILEV=ILEV+1
C
C Read the polygon ID.
C
          CALL NGRDCH (ICEL,CTM4,4,ISTA)
C
          IF (ISTA.NE.4) THEN
            PRINT * , 'RNGSSQ - READ FAILURE IN CEL FILE',Q
            CALL EDSTOP
          END IF
C
          IPID=IOR(ISHIFT(IOR(ISHIFT(IOR(ISHIFT(ICHARF(CTM4(4:4)),8),
     +                                          ICHARF(CTM4(3:3))),8),
     +                                          ICHARF(CTM4(2:2))),8),
     +                                          ICHARF(CTM4(1:1)))
C
C Zero IFLG.  It gets set non-zero when we have found the first point
C of the polygon, positive if that point is on the edge of the 1-degree
C cell, negative if otherwise.
C
          IFLG=0
C
C Zero ITMP.  This is done because we save the previous value of ITMP
C in ITML; it prevents ITML from getting a garbage value.
C
          ITMP=0
C
C Read a new segment byte.
C
  102     CALL NGRDCH (ICEL,CTM1,1,ISTA)
C
          IF (ISTA.NE.1) THEN
            PRINT * , 'RNGSSQ - READ FAILURE IN CEL FILE',Q
            CALL EDSTOP
          END IF
C
          ISGB = ICHARF(CTM1)
C
C The low-order three bits of the segment byte tell us what follows.
C Pull them off into ITMP, saving the previous value as ITML.
C
          ITML=ITMP
          ITMP=IAND(ISGB,7)
C
C If ITMP is non-zero, extract a three-bit integer that tells us the
C type of the polygon we're working on (0 => ocean, 1 => land, 2 =>
C lake, 3 => island in lake, 4 => pond on island).
C
          IF (ITMP.NE.0) ITYP=IAND(ISHIFT(ISGB,-4),7)
C
C If ITMP is between 1 and 6, inclusive, it specifies a number of
C points defined by values read from the cell file; each point is
C defined by two 4-byte integers, the first a longitude and the
C second a latitude, in units of millionths of a degree.  All of these
C points are on the edge of the 1-degree cell.
C
          IF (ITMP.GE.1.AND.ITMP.LE.6) THEN
C
            NPTS = ITMP
C
C Loop to read the points.
C
            DO 105 I=1,NPTS
C
C Read a longitude.
C
              CALL NGRDCH (ICEL,CTM4,4,ISTA)
C
              IF (ISTA.NE.4) THEN
                PRINT * , 'RNGSSQ - READ FAILURE IN CEL FILE',Q
                CALL EDSTOP
              END IF
C
              QLON=RLON
C
              RLON=.000001D0*DBLE(IOR(ISHIFT(
     +             IOR(ISHIFT(IOR(ISHIFT(ICHARF(CTM4(4:4)),8),
     +                                   ICHARF(CTM4(3:3))),8),
     +                                   ICHARF(CTM4(2:2))),8),
     +                                   ICHARF(CTM4(1:1))))
C
C Read a latitude.
C
              CALL NGRDCH (ICEL,CTM4,4,ISTA)
C
              IF (ISTA.NE.4) THEN
                PRINT * , 'RNGSSQ - READ FAILURE IN CEL FILE',Q
                CALL EDSTOP
              END IF
C
              QLAT=RLAT
C
              RLAT=.000001D0*DBLE(IOR(ISHIFT(
     +             IOR(ISHIFT(IOR(ISHIFT(ICHARF(CTM4(4:4)),8),
     +                                   ICHARF(CTM4(3:3))),8),
     +                                   ICHARF(CTM4(2:2))),8),
     +                                   ICHARF(CTM4(1:1))))
C
C If we had not yet seen the first point of the polygon (that is to
C say, if IFLG is zero), this is it; save its longitude and latitude
C and set IFLG to say that the first point was on the cell boundary.
C
              IF (IFLG.EQ.0) THEN
                PLON=RLON
                PLAT=RLAT
                IFLG=+1
              END IF
C
C The following code is meant to interpolate points on the cell edges
C and is executed only if we are filling the polygon, in which case it
C helps to prevent the appearance of seams where adjacent polygons meet.
C
              IF (I.NE.1) THEN
C
                IF (IFLL.EQ.1) THEN
C
                  IF (RLAT.EQ.QLAT) THEN
C
                    IDIR=INT(SIGN(1.D0,RLON-QLON))
                    IBEG=INT((QLON-DBLE(ILON))/DLON)
                    IEND=INT((RLON-DBLE(ILON))/DLON)
                    IF (IDIR.GT.0) IBEG=IBEG+1
                    IF (IDIR.LT.0) IEND=IEND+1
                    XLAT=RLAT
C
                    DO 103 IINT=IBEG,IEND,IDIR
                      XLON=DBLE(ILON)+DBLE(IINT)*DLON
                      IF ((XLON-RLON)*(QLON-XLON).GT.0.D0) THEN
                        IF (NCRA+1.LT.MCRA) THEN
                          NCRA=NCRA+1
                          XCRD=XLON
                          YCRD=XLAT
                          IF (ILON.GE.180) XCRD=XCRD-360.D0
                          XCRA(NCRA)=REAL(XCRD)
                          YCRA(NCRA)=REAL(YCRD)
                        ELSE
                          PRINT * , 'RNGSSQ - COORDINATE BUFFER OVERFLOW
     +',Q
                          CALL EDSTOP
                        END IF
                      END IF
  103               CONTINUE
C
                  ELSE IF (RLON.EQ.QLON) THEN
C
                    IDIR=INT(SIGN(1.D0,RLAT-QLAT))
                    IBEG=INT((QLAT-DBLE(ILAT))/DLAT)
                    IEND=INT((RLAT-DBLE(ILAT))/DLAT)
                    IF (IDIR.GT.0) IBEG=IBEG+1
                    IF (IDIR.LT.0) IEND=IEND+1
                    XLON=RLON
C
                    DO 104 IINT=IBEG,IEND,IDIR
                      XLAT=DBLE(ILAT)+DBLE(IINT)*DLAT
                      IF ((XLAT-RLAT)*(QLAT-XLAT).GT.0.D0) THEN
                        IF (NCRA+1.LT.MCRA) THEN
                          NCRA=NCRA+1
                          XCRD=XLON
                          YCRD=XLAT
                          IF(ILON.GE.180) XCRD=XCRD-360.D0
                          XCRA(NCRA)=REAL(XCRD)
                          YCRA(NCRA)=REAL(YCRD)
                        ELSE
                          PRINT * , 'RNGSSQ - COORDINATE BUFFER OVERFLOW
     +',Q
                          CALL EDSTOP
                        END IF
                      END IF
  104               CONTINUE
C
                  END IF
C
                END IF
C
              END IF
C
C If we are filling the polygon or if we are not filling the polygon,
C but the point is the first or last one in a sequence on the cell edge
C (meaning that it is joined to a point in the interior of the cell),
C insert its coordinates in the list.
C
              IF (IFLL.EQ.1.OR.I.EQ.1.OR.I.EQ.NPTS) THEN
                IF (NCRA+1.LT.MCRA) THEN
                  NCRA=NCRA+1
                  XCRD=RLON
                  YCRD=RLAT
                  IF (ILON.GE.180) XCRD=XCRD-360.D0
                  XCRA(NCRA)=REAL(XCRD)
                  YCRA(NCRA)=REAL(YCRD)
                ELSE
                  PRINT * , 'RNGSSQ - COORDINATE BUFFER OVERFLOW',Q
                  CALL EDSTOP
                END IF
              END IF
C
C If we are not filling the polygon, but are just drawing its boundary,
C and this point is the first point of a series of points along the cell
C edge, dump out a polyline and clear the point-coordinate buffer.  Note
C that NPTS *can* be equal to 1 in the case of a polygon which touches
C the cell edge at one point and then heads back into the interior;
C that's the reason for the ".AND.NPTS.NE.1" in the IF.
C
              IF (IFLL.NE.1.AND.I.EQ.1.AND.NPTS.NE.1) THEN
                IF (NCRA.GT.1) THEN
                  IF (IFLL.EQ.0) THEN
                    IF (IKOL(ITYP+1).GE.0) THEN
                      CALL GSPLCI (IKOL(ITYP+1))
                      CALL GPL (NCRA,XCRA,YCRA)
                    END IF
                  ELSE IF (IFLL.EQ.2) THEN
                    CALL PSEGM1 (XCRA,YCRA,NCRA)
                  ELSE IF (IFLL.EQ.3) THEN
                    CALL PSEGM2 (XCRA,YCRA,NCRA)
                  END IF
                END IF
                NCRA=0
              END IF
C
  105       CONTINUE
C
C Go back to read another segment byte.
C
            GO TO 102
C
C If ITMP is a 7, then the next two values in the cell file are 4-byte
C integers, the first of which is a pointer into the rim file and the
C second of which is the number of points to be read from the rim file.
C Each point in the rim file is defined like a point in the cell file,
C by a pair of 4-byte integers, specifying longitude and latitude, in
C millionths of a degree.  All of the points in the rim file are in
C the interior of the 1-degree cell.
C
          ELSE IF (ITMP.EQ.7) THEN
C
C Get the pointer into the rim file.
C
            CALL NGRDCH (ICEL,CTM4,4,ISTA)
C
            IF (ISTA.NE.4) THEN
              PRINT * , 'RNGSSQ - READ FAILURE IN CEL FILE',Q
              CALL EDSTOP
            END IF
C
            IPOS=IOR(ISHIFT(IOR(ISHIFT(IOR(ISHIFT(ICHARF(CTM4(4:4)),8),
     +                                            ICHARF(CTM4(3:3))),8),
     +                                            ICHARF(CTM4(2:2))),8),
     +                                            ICHARF(CTM4(1:1)))-1
C
C Get the number of points to be read from the rim file.
C
            CALL NGRDCH (ICEL,CTM4,4,ISTA)
C
            IF (ISTA.NE.4) THEN
              PRINT * , 'RNGSSQ - READ FAILURE IN CEL FILE',Q
              CALL EDSTOP
            END IF
C
            NPTS=IOR(ISHIFT(IOR(ISHIFT(IOR(ISHIFT(ICHARF(CTM4(4:4)),8),
     +                                            ICHARF(CTM4(3:3))),8),
     +                                            ICHARF(CTM4(2:2))),8),
     +                                            ICHARF(CTM4(1:1)))
C
C If the number of points to be read is non-zero (for some reason, it
C *can* happen that the number is zero), read the points.
C
            IF (NPTS.NE.0) THEN
C
C Position to the start of the list of points in the rim file.
C
              CALL NGSEEK (IRIM,IPOS,0,ISTA)
C
              IF (ISTA.LT.0) THEN
                PRINT * , 'RNGSSQ - SEEK FAILURE IN RIM FILE',Q
                CALL EDSTOP
              END IF
C
C Loop to read the points.
C
              DO 106 I=1,NPTS
C
C Read a longitude.
C
                CALL NGRDCH (IRIM,CTM4,4,ISTA)
C
                IF (ISTA.NE.4) THEN
                  PRINT * , 'RNGSSQ - READ FAILURE IN RIM FILE',Q
                  CALL EDSTOP
                END IF
C
                QLON=RLON
C
                RLON=.000001D0*DBLE(IOR(ISHIFT(
     +               IOR(ISHIFT(IOR(ISHIFT(ICHARF(CTM4(4:4)),8),
     +                                     ICHARF(CTM4(3:3))),8),
     +                                     ICHARF(CTM4(2:2))),8),
     +                                     ICHARF(CTM4(1:1))))
C
C Read a latitude.
C
                CALL NGRDCH (IRIM,CTM4,4,ISTA)
C
                IF (ISTA.NE.4) THEN
                  PRINT * , 'RNGSSQ - READ FAILURE IN RIM FILE',Q
                  CALL EDSTOP
                END IF
C
                QLAT=RLAT
C
                RLAT=.000001D0*DBLE(IOR(ISHIFT(
     +               IOR(ISHIFT(IOR(ISHIFT(ICHARF(CTM4(4:4)),8),
     +                                     ICHARF(CTM4(3:3))),8),
     +                                     ICHARF(CTM4(2:2))),8),
     +                                     ICHARF(CTM4(1:1))))
C
C If we had not yet seen the first point of the polygon (that is to
C say, if IFLG is zero), this is it; save its longitude and latitude
C and set IFLG to say that the first point was not on the cell boundary.
C
                IF (IFLG.EQ.0) THEN
                  PLON=RLON
                  PLAT=RLAT
                  IFLG=-1
                END IF
C
C Since all of these points are interior points, we just map them and
C add the u/v coordinates to the point-coordinate buffers.
C
                IF (NCRA+1.LT.MCRA) THEN
                  NCRA=NCRA+1
                  XCRD=RLON
                  YCRD=RLAT
                  IF (ILON.GE.180) XCRD=XCRD-360.D0
                  XCRA(NCRA)=REAL(XCRD)
                  YCRA(NCRA)=REAL(YCRD)
                ELSE
                  PRINT * , 'RNGSSQ - COORDINATE BUFFER OVERFLOW',Q
                  CALL EDSTOP
                END IF
C
  106         CONTINUE
C
            END IF
C
C We get here if we read a segment byte in which ITMP was zero.  Go back
C to read another segment byte.
C
            GO TO 102
C
          END IF
C
C If ITMP is zero, we've reached the end of the polygon.  We must supply
C a closure point (the first point of the polygon) and then either fill
C the polygon or draw the remainder of its boundary.
C
          IF (IFLL.EQ.1) THEN
C
C Output the fill area.  First, see if at least one point is defined in
C the buffers.
C
            IF (NCRA.GT.1) THEN
C
C Yes.  The complication here is that, if the last point we saw was on
C the cell edge and the first point of the polygon was also on the cell
C edge, then we have to interpolate points along the cell edge in the
C same way that was done above.
C
              IF (ITML.GE.1.AND.ITML.LE.6.AND.IFLG.GT.0) THEN
C
                QLON=RLON
                QLAT=RLAT
                RLON=PLON
                RLAT=PLAT
C
                IF (RLAT.EQ.QLAT) THEN
C
                  IDIR=INT(SIGN(1.D0,RLON-QLON))
                  IBEG=INT((QLON-DBLE(ILON))/DLON)
                  IEND=INT((RLON-DBLE(ILON))/DLON)
                  IF (IDIR.GT.0) IBEG=IBEG+1
                  IF (IDIR.LT.0) IEND=IEND+1
                  XLAT=RLAT
C
                  DO 107 IINT=IBEG,IEND,IDIR
                    XLON=DBLE(ILON)+DBLE(IINT)*DLON
                    IF ((XLON-RLON)*(QLON-XLON).GT.0.D0) THEN
                      IF (NCRA+1.LT.MCRA) THEN
                        NCRA=NCRA+1
                        XCRD=XLON
                        YCRD=XLAT
                        IF (ILON.GE.180) XCRD=XCRD-360.D0
                        XCRA(NCRA)=REAL(XCRD)
                        YCRA(NCRA)=REAL(YCRD)
                      ELSE
                        PRINT * , 'RNGSSQ - COORDINATE BUFFER OVERFLOW',
     +Q
                        CALL EDSTOP
                      END IF
                    END IF
  107             CONTINUE
C
                ELSE IF (RLON.EQ.QLON) THEN
C
                  IDIR=INT(SIGN(1.D0,RLAT-QLAT))
                  IBEG=INT((QLAT-DBLE(ILAT))/DLAT)
                  IEND=INT((RLAT-DBLE(ILAT))/DLAT)
                  IF (IDIR.GT.0) IBEG=IBEG+1
                  IF (IDIR.LT.0) IEND=IEND+1
                  XLON=RLON
C
                  DO 108 IINT=IBEG,IEND,IDIR
                    XLAT=DBLE(ILAT)+DBLE(IINT)*DLAT
                    IF ((XLAT-RLAT)*(QLAT-XLAT).GT.0.D0) THEN
                      IF (NCRA+1.LT.MCRA) THEN
                        NCRA=NCRA+1
                        XCRD=XLON
                        YCRD=XLAT
                        IF (ILON.GE.180) XCRD=XCRD-360.D0
                        XCRA(NCRA)=REAL(XCRD)
                        YCRA(NCRA)=REAL(YCRD)
                      ELSE
                        PRINT * , 'RNGSSQ - COORDINATE BUFFER OVERFLOW',
     +Q
                        CALL EDSTOP
                      END IF
                    END IF
  108             CONTINUE
C
                END IF
C
              END IF
C
C Add the mapped coordinates of the closure point to the buffers and
C fill the polygon.
C
              NCRA=NCRA+1
              XCRD=PLON
              YCRD=PLAT
              IF (ILON.GE.180) XCRD=XCRD-360.D0
              XCRA(NCRA)=REAL(XCRD)
              YCRA(NCRA)=REAL(YCRD)
              IF (ILAT.GE.55.AND.ILAT.LE.57.AND.ILON.EQ.82.AND.
     +                                                 ITYP.EQ.2) ITYP=1
              IF (IKSF(ITYP+1).GE.0.AND.NCRA.GT.2) THEN
                CALL GSFACI (IKSF(ITYP+1))
                CALL GFA (NCRA,XCRA,YCRA)
              END IF
C
            END IF
C
          ELSE
C
C Output the remainder of a polyline.  This time, we make sure that we
C have at least one point so far.
C
            IF (NCRA.GT.0) THEN
C
C Yes.  If the last point was an interior point or if the first point
C of the polygon was an interior point, add the closure point to it.
C
              IF (ITML.EQ.7.OR.IFLG.LT.0) THEN
                NCRA=NCRA+1
                XCRD=PLON
                YCRD=PLAT
                IF (ILON.GE.180) XCRD=XCRD-360.D0
                XCRA(NCRA)=REAL(XCRD)
                YCRA(NCRA)=REAL(YCRD)
              END IF
C
C Now, output the polyline.
C
              IF (NCRA.GT.1) THEN
                IF (IFLL.EQ.0) THEN
                  IF (IKOL(ITYP+1).GE.0) THEN
                    CALL GSPLCI (IKOL(ITYP+1))
                    CALL GPL (NCRA,XCRA,YCRA)
                  END IF
                ELSE IF (IFLL.EQ.2) THEN
                  CALL PSEGM1 (XCRA,YCRA,NCRA)
                ELSE IF (IFLL.EQ.3) THEN
                  CALL PSEGM2 (XCRA,YCRA,NCRA)
                END IF
              END IF
C
            END IF
C
          END IF
C
C Zero the count of coordinates in the point-coordinate buffer.
C
          NCRA=0
C
C Go back to read another polygon byte.
C
          GO TO 101
C
C If the polygon byte is zero, it says that we've hit the end of a
C polygon.
C
        ELSE
C
C Reduce the recursion counter by one and, if it's still non-zero, go
C back to read another polygon byte.
C
          ILEV=ILEV-1
          IF (ILEV.NE.0) GO TO 101
C
        END IF
C
C Normal return.
C
        RETURN
C
      END


      SUBROUTINE RNGSOF (IRGL,ICAT,ICEL,IRIM)
C
        INTEGER IRGL,ICAT,ICEL,IRIM
C
C This routine is called to open the files containing RANGS/GSHHS data
C at a specified resolution level IRGL.  The file descriptors come back
C in ICAT, ICEL, and IRIM.
C
C FLNM is a character variable in which to build the names of files to
C be opened by a call to NGOFRO.
C
        CHARACTER*129 FLNM
C
C NCAT, NCEL, and NRIM hold the names of the catalog file, the cell
C file, and the rim data file to be read.
C
        CHARACTER*13  NCAT,NCEL,NRIM
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
C Get the name of the directory the RANGS/GSHHS files are in.
C
        CALL RNGSDI (FLNM)
C
        DO 101 I=1,112
          IF (FLNM(I:I).EQ.' '.OR.FLNM(I:I).EQ.CHAR(0)) THEN
            INAM=I
            IF (I.NE.1) THEN
              IF (FLNM(I-1:I-1).NE.'/') THEN
                FLNM(I:I)='/'
                INAM=I+1
              END IF
            END IF
            GO TO 102
          END IF
  101   CONTINUE
C
        PRINT * , 'RNGSOF - RNGSDI RETURNED BAD DIRECTORY NAME',Q
        CALL EDSTOP
C
C Define the names of the data files to be read.
C
  102   NCAT = 'rangs('//CHAR(ICHAR('0')+IRGL)//').cat'//CHAR(0)
        NCEL = 'rangs('//CHAR(ICHAR('0')+IRGL)//').cel'//CHAR(0)
        NRIM = 'gshhs('//CHAR(ICHAR('0')+IRGL)//').rim'//CHAR(0)
C
C Open all the data files.
C
        FLNM(INAM:INAM+12)=NCAT
        CALL NGOFRO (FLNM,ICAT,ISTA)
C
        IF (ISTA.NE.0) THEN
          PRINT * , 'RNGSOF - ERROR OPENING RANGS/GSHHS CAT FILE',Q
          CALL EDSTOP
        END IF
C
        FLNM(INAM:INAM+12)=NCEL
        CALL NGOFRO (FLNM,ICEL,ISTA)
C
        IF (ISTA.NE.0) THEN
          PRINT * , 'RNGSOF - ERROR OPENING RANGS/GSHHS CEL FILE',Q
          CALL NGCLFI (ICAT)
          CALL EDSTOP
        END IF
C
        FLNM(INAM:INAM+12)=NRIM
        CALL NGOFRO (FLNM,IRIM,ISTA)
C
        IF (ISTA.NE.0) THEN
          PRINT * , 'RNGSOF - ERROR OPENING RANGS/GSHHS RIM FILE',Q
          CALL NGCLFI (ICAT)
          CALL NGCLFI (ICEL)
          CALL EDSTOP
        END IF
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE RNGSDI (DINM)
C
C This is a user-replaceable routine that returns the name of the
C directory in which the RANGS/GSHHS data files have been placed.
C
        CHARACTER*(*) DINM
C
C Return the name of the directory where the RANGS/GSHHS data reside.
C
        DINM='/Users/kennison/Mapping/RANGSData'
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE PSEGM1 (XCRA,YCRA,NCRA)
C
        DIMENSION XCRA(NCRA),YCRA(NCRA)
C
C "PSEGM1" stands for "Process SEGment, Method 1".
C
C This routine adds an edge segment to the database being edited;
C it checks to see if the new segment extends an existing edge and/or
C if it splices two existing edges together.
C
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
C Check to see if there's room in the point list for all of the new
C points.  (In cases in which the new outline segment adjoins one or
C two old ones, we can discard one or two duplicate points, but I'm
C disinclined to worry about such niceties; the point is to make sure
C we have enough room to work in.)
C
        IF (NOEP+NCRA.GT.MNEP) THEN
          PRINT * , 'In PSEGM1: Too many points.',Q
          RETURN
        END IF
C
C If it's not already there, put an unidentified-area name in the list
C and set IOUA to its index.
C
        DO 101 I=1,MNAI
          IF (NAME(I).EQ.'Unidentified Area') THEN
            IOUA=I
            GO TO 103
          END IF
  101   CONTINUE
C
        DO 102 I=1,MNAI
          IF (IATY(I).EQ.0) THEN
            IATY(I)=1
            ISCI(I)=8
            IPAR(I)=0
            NAME(I)='Unidentified Area'
            IOUA=I
            GO TO 103
          END IF
  102   CONTINUE
C
        PRINT * , 'In PSEGM1: Too many areas.',Q
        RETURN
C
C Search for an outline segment already in the list to which the new
C one can be joined.
C
  103   DO 104 I=IFNS,NOES
          IF (XCRA(   1).EQ.XCRD(IOFP(I)).AND.
     +        YCRA(   1).EQ.YCRD(IOFP(I))) THEN
            IOS1=I
            GO TO 106
          END IF
          IF (XCRA(   1).EQ.XCRD(IOLP(I)).AND.
     +        YCRA(   1).EQ.YCRD(IOLP(I))) THEN
            IOS1=I
            GO TO 109
          END IF
          IF (XCRA(NCRA).EQ.XCRD(IOFP(I)).AND.
     +        YCRA(NCRA).EQ.YCRD(IOFP(I))) THEN
            IOS1=I
            GO TO 112
          END IF
          IF (XCRA(NCRA).EQ.XCRD(IOLP(I)).AND.
     +        YCRA(NCRA).EQ.YCRD(IOLP(I))) THEN
            IOS1=I
            GO TO 115
          END IF
  104   CONTINUE
C
C There was no existing outline segment to which the new one ought to
C be joined; create a new outline segment in the list.
C
        IF (NOES+1.GT.MNES) THEN
          PRINT * , 'In PSEGM1: Too many segments.',Q
          RETURN
        END IF
C
        NOES=NOES+1
C
        IOFP(NOES)=NOEP+1
        IOLP(NOES)=NOEP+NCRA
        ILTY(NOES)=0
        IAIL(NOES)=IOUA
        IAIR(NOES)=IOUA
C
        DO 105 I=1,NCRA
          XCRD(NOEP+I)=XCRA(I)
          YCRD(NOEP+I)=YCRA(I)
  105   CONTINUE
C
        NOEP=NOEP+NCRA
C
        RETURN
C
C The first point of the new outline segment matches the first point of
C segment IOS1.
C
  106   DO 107 I=NOEP,IOFP(IOS1),-1
          XCRD(I+NCRA-1)=XCRD(I)
          YCRD(I+NCRA-1)=YCRD(I)
  107   CONTINUE
C
        DO 108 I=1,NCRA-1
          XCRD(IOFP(IOS1)+I-1)=XCRA(NCRA-I+1)
          YCRD(IOFP(IOS1)+I-1)=YCRA(NCRA-I+1)
  108   CONTINUE
C
        IFLP=1
C
        GO TO 118
C
C The first point of the new outline segment matches the last point of
C segment IOS1.
C
  109   DO 110 I=NOEP,IOLP(IOS1)+1,-1
          XCRD(I+NCRA-1)=XCRD(I)
          YCRD(I+NCRA-1)=YCRD(I)
  110   CONTINUE
C
        DO 111 I=1,NCRA-1
          XCRD(IOLP(IOS1)+I)=XCRA(I+1)
          YCRD(IOLP(IOS1)+I)=YCRA(I+1)
  111   CONTINUE
C
        IFLP=0
C
        GO TO 118
C
C The last point of the new outline segment matches the first point of
C segment IOS1.
C
  112   DO 113 I=NOEP,IOFP(IOS1),-1
          XCRD(I+NCRA-1)=XCRD(I)
          YCRD(I+NCRA-1)=YCRD(I)
  113   CONTINUE
C
        DO 114 I=1,NCRA-1
          XCRD(IOFP(IOS1)+I-1)=XCRA(I)
          YCRD(IOFP(IOS1)+I-1)=YCRA(I)
  114   CONTINUE
C
        IFLP=1
C
        GO TO 118
C
C The last point of the new outline segment matches the last point of
C segment IOS1.
C
  115   DO 116 I=NOEP,IOLP(IOS1)+1,-1
          XCRD(I+NCRA-1)=XCRD(I)
          YCRD(I+NCRA-1)=YCRD(I)
  116   CONTINUE
C
        DO 117 I=1,NCRA-1
          XCRD(IOLP(IOS1)+I)=XCRA(NCRA-I)
          YCRD(IOLP(IOS1)+I)=YCRA(NCRA-I)
  117   CONTINUE
C
        IFLP=0
C
C Adjust all the pointers to reflect the fact that outline segment
C IOS1 has been lengthened by NCRA-1 points.
C
  118   IOLP(IOS1)=IOLP(IOS1)+NCRA-1
C
        DO 119 I=IOS1+1,NOES
          IOFP(I)=IOFP(I)+NCRA-1
          IOLP(I)=IOLP(I)+NCRA-1
  119   CONTINUE
C
        NOEP=NOEP+NCRA-1
C
C If there are no outline segments following outline segment IOS1,
C there is nothing further to do.
C
        IF (IOS1.EQ.NOES) RETURN
C
C Otherwise, if the new end point of outline segment IOS1 is its first
C point, flip the line segment end-for-end so the new point is last.
C
        IF (IFLP.NE.0) THEN
          IBEG=IOFP(IOS1)
          IEND=IOLP(IOS1)
  120     IF (IBEG.LT.IEND) THEN
            XTMP=XCRD(IBEG)
            YTMP=YCRD(IBEG)
            XCRD(IBEG)=XCRD(IEND)
            YCRD(IBEG)=YCRD(IEND)
            XCRD(IEND)=XTMP
            YCRD(IEND)=YTMP
            IBEG=IBEG+1
            IEND=IEND-1
            GO TO 120
          END IF
        END IF
C
C Now, check the last point of outline segment IOS1 to see if it
C matches either end point of any following segment; if so, flip
C that following segment, as necessary, and then jump to append
C it to segment IOS1.
C
        DO 122 I=IOS1+1,NOES
          IF (XCRD(IOFP(I)).EQ.XCRD(IOLP(IOS1)).AND.
     +        YCRD(IOFP(I)).EQ.YCRD(IOLP(IOS1))) THEN
            IOS2=I
            GO TO 123
          END IF
          IF (XCRD(IOLP(I)).EQ.XCRD(IOLP(IOS1)).AND.
     +        YCRD(IOLP(I)).EQ.YCRD(IOLP(IOS1))) THEN
            IOS2=I
            IBEG=IOFP(IOS2)
            IEND=IOLP(IOS2)
  121       IF (IBEG.LT.IEND) THEN
              XTMP=XCRD(IBEG)
              YTMP=YCRD(IBEG)
              XCRD(IBEG)=XCRD(IEND)
              YCRD(IBEG)=YCRD(IEND)
              XCRD(IEND)=XTMP
              YCRD(IEND)=YTMP
              IBEG=IBEG+1
              IEND=IEND-1
              GO TO 121
            END IF
            GO TO 123
          END IF
  122   CONTINUE
C
C Outline segment IOS1 does not hook up with any of the others.  Done.
C
        RETURN
C
C Append outline segment IOS2 to outline segment IOS1 (deleting the
C point of overlap).  If the line segments are adjacent in the list,
C this is pretty easy.
C
  123   IF (IOS2.EQ.IOS1+1) THEN
          DO 124 I=IOFP(IOS2),NOEP-1
            XCRD(I)=XCRD(I+1)
            YCRD(I)=YCRD(I+1)
  124     CONTINUE
          NOEP=NOEP-1
          IOLP(IOS1)=IOLP(IOS2)-1
          DO 125 I=IOS2,NOES-1
            IOFP(I)=IOFP(I+1)-1
            IOLP(I)=IOLP(I+1)-1
            ILTY(I)=ILTY(I+1)
            IAIL(I)=IAIL(I+1)
            IAIR(I)=IAIR(I+1)
  125     CONTINUE
          NOES=NOES-1
          RETURN
        END IF
C
C Otherwise, it's more complicated.  First, we have to make sure that
C there is room for the extra points.  LOS2, at this point, is the
C length of that part of outline segment IOS2 that we want to copy.
C
        LOS2=IOLP(IOS2)-IOFP(IOS2)
C
        IF (NOEP+LOS2.GT.MNEP) THEN
          PRINT * , 'In PSEGM1: Too many points.',Q
          RETURN
        END IF
C
C Then, we expand the space available for outline segment IOS1, copy
C in the appropriate points from outline segment IOS2, and update all
C the pointers.
C
        DO 126 I=NOEP,IOLP(IOS1)+1,-1
          XCRD(I+LOS2)=XCRD(I)
          YCRD(I+LOS2)=YCRD(I)
  126   CONTINUE
C
        NOEP=NOEP+LOS2
C
        IOLP(IOS1)=IOLP(IOS1)+LOS2
C
        DO 127 I=IOS1+1,NOES
          IOFP(I)=IOFP(I)+LOS2
          IOLP(I)=IOLP(I)+LOS2
  127   CONTINUE
C
        DO 128 I=1,LOS2
          XCRD(IOLP(IOS1)-LOS2+I)=XCRD(IOFP(IOS2)+I)
          YCRD(IOLP(IOS1)-LOS2+I)=YCRD(IOFP(IOS2)+I)
  128   CONTINUE
C
C Finally, we delete outline segment IOS2.  LOS2, at this point, is the
C actual length of outline segment IOS2.
C
        LOS2=LOS2+1
C
        DO 129 I=IOLP(IOS2)+1,NOEP
          XCRD(I-LOS2)=XCRD(I)
          YCRD(I-LOS2)=YCRD(I)
  129   CONTINUE
C
        NOEP=NOEP-LOS2
C
        DO 130 I=IOS2,NOES-1
          IOFP(I)=IOFP(I+1)-LOS2
          IOLP(I)=IOLP(I+1)-LOS2
          ILTY(I)=ILTY(I+1)
          IAIL(I)=IAIL(I+1)
          IAIR(I)=IAIR(I+1)
  130   CONTINUE
C
        NOES=NOES-1
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE PSEGM2 (XCRA,YCRA,NCRA)
C
        DIMENSION XCRA(NCRA),YCRA(NCRA)
C
C "PSEGM2" stands for "Process SEGment, Method 2".
C
C This routine checks to see if a new edge segment connects to the last
C edge in the list, and, if so, adds it to that edge.
C
        PARAMETER (MNES=  30000)                               !   COPY!
        PARAMETER (MNEP=3000000)                               !   COPY!
        PARAMETER (MNAI=  12000)                               !   COPY!
        COMMON /EDCOM1/ IOFP(MNES),IOLP(MNES),ILTY(MNES)       !   COPY!
        COMMON /EDCOM1/ IAIL(MNES),IAIR(MNES)                  !   COPY!
        COMMON /EDCOM1/ XCRD(MNEP),YCRD(MNEP)                  !   COPY!
        COMMON /EDCOM1/ IATY(MNAI),ISCI(MNAI),IPAR(MNAI)       !   COPY!
        COMMON /EDCOM1/ IONA(1000)                             !   COPY!
        COMMON /EDCOM1/ NOES,NOEP,IOAP,IOAS,IODA,NODA,CSAN     !   COPY!
        COMMON /EDCOM1/ IFNS                                   !   COPY!
        SAVE   /EDCOM1/                                        !   COPY!
        COMMON /EDCOM2/ NOAS,NAME(MNAI)                        !   COPY!
        CHARACTER*64 NOAS,NAME                                 !   COPY!
        SAVE   /EDCOM2/                                        !   COPY!
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
C If the first point of the new segment matches the last point of the
C last edge in the list, attach it in forward order, first making sure
C that we're not backtracking along the edge.
C
        IF (XCRA(1).EQ.XCRD(NOEP).AND.
     +      YCRA(1).EQ.YCRD(NOEP)) THEN
          IF (NOEP+NCRA-1.GT.MNEP) THEN
            PRINT * , 'In PSEGM2: Too many points.',Q
            RETURN
          END IF
          IF (NOEP.GE.NCRA) THEN
            DO 101 I=1,NCRA-1
              IF (XCRA(I+1).NE.XCRD(NOEP-I).OR.
     +            YCRA(I+1).NE.YCRD(NOEP-I)) GO TO 102
  101       CONTINUE
            PRINT * , 'Attempt to backtrack along edge prevented.',Q
            RETURN
          END IF
  102     DO 103 I=1,NCRA-1
            XCRD(NOEP+I)=XCRA(I+1)
            YCRD(NOEP+I)=YCRA(I+1)
  103     CONTINUE
          NOEP=NOEP+NCRA-1
          IOLP(NOES)=NOEP
          RETURN
        END IF
C
C If the last point of the new segment matches the last point of the
C last edge in the list, attach it in backward order, first making sure
C that we're not backtracking along the edge.
C
        IF (XCRA(NCRA).EQ.XCRD(NOEP).AND.
     +      YCRA(NCRA).EQ.YCRD(NOEP)) THEN
          IF (NOEP+NCRA-1.GT.MNEP) THEN
            PRINT * , 'In PSEGM2: Too many points.',Q
            RETURN
          END IF
          IF (NOEP.GE.NCRA) THEN
            DO 104 I=1,NCRA-1
              IF (XCRA(NCRA-I).NE.XCRD(NOEP-I).OR.
     +            YCRA(NCRA-I).NE.YCRD(NOEP-I)) GO TO 105
  104       CONTINUE
            PRINT * , 'Attempt to backtrack along edge prevented.',Q
            RETURN
          END IF
  105     DO 106 I=1,NCRA-1
            XCRD(NOEP+I)=XCRA(NCRA-I)
            YCRD(NOEP+I)=YCRA(NCRA-I)
  106     CONTINUE
          NOEP=NOEP+NCRA-1
          IOLP(NOES)=NOEP
          RETURN
        END IF
C
      END


      SUBROUTINE FPSGCR (ALAT,ALON,BLAT,BLON,FRCT,FLAT,FLON)
C
C (FPSGCR = Find Point on Shortest Great Circle Route)
C
        REAL    ALAT,ALON,BLAT,BLON,FRCT,FLAT,FLON
C
C This routine, given the latitudes and longitudes of two points A and
C B on the surface of the globe and a fraction FRCT, between 0. and 1.,
C interpolates a point F along the shortest great circle route joining
C A to B such that the distance from A to F, divided by the distance
C from A to B, is equal to FRCT, and returns its latitude and longitude
C in FLAT and FLON.
C
C Define the constants used to convert from degrees to radians and
C vice-versa.
C
        DATA DTOR / .017453292519943 /
        DATA RTOD / 57.2957795130823 /
C
C Compute the X, Y, and Z coordinates (on a unit sphere) of the point B.
C
        CALL LLPXYZ (BLAT,BLON,XCPB,YCPB,ZCPB)
C
C Rotating about the Z axis by the angle -ALON would carry A into the XZ
C plane.
C
        CALL ROTXYZ (3,-ALON,XCPB,YCPB,ZCPB)
C
C Then, rotating about the Y axis by the angle ALAT would carry A into
C the point on the X axis with coordinates (1,0,0).
C
        CALL ROTXYZ (2,ALAT,XCPB,YCPB,ZCPB)
C
C Then, rotating about the X axis by the angle ALPH = -ATAN(ZCPB/YCPB)
C would leave the position of A unchanged but carry B into a point in
C the XY plane.
C
        IF (ZCPB.NE.0..OR.YCPB.NE.0.) THEN
          ALPH=-RTOD*ATAN2(ZCPB,YCPB)
        ELSE
          ALPH=0.
        END IF
C
        CALL ROTXYZ (1,ALPH,XCPB,YCPB,ZCPB)
C
C The angle BETA from A to B can now be computed easily.
C
        IF (XCPB.NE.0..OR.YCPB.NE.0.) THEN
          BETA=ATAN2(YCPB,XCPB)
        ELSE
          BETA=0.
        END IF
C
C Interpolate a point at the desired position between the points A and
C B, map it back to its original position on the great circle route from
C A to B, and get its latitude and longitude to return to the caller.
C
        GAMA=FRCT*BETA
C
        XCPF=COS(GAMA)
        YCPF=SIN(GAMA)
        ZCPF=0.
C
        CALL ROTXYZ (1,-ALPH,XCPF,YCPF,ZCPF)
        CALL ROTXYZ (2,-ALAT,XCPF,YCPF,ZCPF)
        CALL ROTXYZ (3, ALON,XCPF,YCPF,ZCPF)
C
        CALL XYZLLP (XCPF,YCPF,ZCPF,FLAT,FLON)
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE LLPXYZ (RLAT,RLON,RVOX,RVOY,RVOZ)
C
C (LLPXYZ = Lat/Lon Position to XYZ coordinates)
C
C Given the latitude and longitude of a point on the globe, return its
C X, Y, and Z coordinates.
C
        DATA DTOR / .017453292519943 /
C
        RVOX=COS(DTOR*RLAT)*COS(DTOR*RLON)
        RVOY=COS(DTOR*RLAT)*SIN(DTOR*RLON)
        RVOZ=SIN(DTOR*RLAT)
C
        RETURN
C
      END


      SUBROUTINE XYZLLP (RVOX,RVOY,RVOZ,RLAT,RLON)
C
C (XYZLLP = XYZ coordinates to Lat/Lon Position)
C
C Given the X, Y, and Z coordinates of a point on the globe, return its
C latitude and longitude.
C
        DATA RTOD / 57.2957795130823 /
C
        RLAT=RTOD*ASIN(RVOZ)
C
        IF (RVOX.NE.0.OR.RVOY.NE.0.) THEN
          RLON=RTOD*ATAN2(RVOY,RVOX)
        ELSE
          RLON=0.
        END IF
C
        RETURN
C
      END


      SUBROUTINE ROTXYZ (IAXS,ANGL,XCRD,YCRD,ZCRD)
C
C (ROTXYZ = ROTate a point defined by its X, Y, and Z coordinates)
C
C This is a modified version of a routine in the NCAR Graphics package,
C which is used in some of the examples.  It rotates the point having
C coordinates (XCRD,YCRD,ZCRD) by an angle ANGL about the axis specified
C by IAXS (1 for the X axis, 2 for the Y axis, 3 for the Z axis).
C
C One assumes a right-handed system with X, Y, and Z axes.  Rotating by
C an angle "a" about the X axis maps the point (x,y,z) into the point
C (x',y',z'), where
C
C       x' = x
C       y' = y cos(a) - z sin(a)
C       z' = z cos(a) + y sin(a)
C
C A positive value of "a" represents rotation in the direction from the
C Y axis to the Z axis.
C
C Similarly, rotating by an angle "a" about the Y axis maps the point
C (x,y,z) into the point (x',y',z'), where
C
C       x' = x cos(a) + z sin(a)
C       y' = y
C       z' = z cos(a) - x sin(a)
C
C A positive value of "a" represents rotation in the direction from the
C Z axis to the X axis.
C
C Rotating by an angle "a" about the Z axis maps the point (x,y,z) into
C the point (x',y',z'), where
C
C       x' = x cos(a) - y sin(a)
C       y' = y cos(a) + x sin(a)
C       y' = y
C
C A positive value of "a" represents rotation in the direction from the
C X axis to the Y axis.
C
C Define a multiplicative constant to convert from degrees to radians.
C
        DATA DTOR / .017453292519943 /
C
C Trigonometry.
C
        SINA=SIN(DTOR*ANGL)
        COSA=COS(DTOR*ANGL)
C
        XTMP=XCRD
        YTMP=YCRD
        ZTMP=ZCRD
C
        IF (IAXS.EQ.1) THEN
          YCRD=YTMP*COSA-ZTMP*SINA
          ZCRD=ZTMP*COSA+YTMP*SINA
        ELSE IF (IAXS.EQ.2) THEN
          XCRD=XTMP*COSA+ZTMP*SINA
          ZCRD=ZTMP*COSA-XTMP*SINA
        ELSE
          XCRD=XTMP*COSA-YTMP*SINA
          YCRD=YTMP*COSA+XTMP*SINA
        END IF
C
        RETURN
C
      END


      FUNCTION ADSGCR (ALAT,ALON,BLAT,BLON)
C
C (ADSGCR = Angle in Degrees along Shortest Great Circle Route)
C
C This function returns the shortest great circle distance, in degrees,
C between two points, A and B, on the surface of the globe.
C
        DATA DTOR / .017453292519943 /
        DATA RTOD / 57.2957795130823 /
C
        XCOA=COS(DTOR*ALAT)*COS(DTOR*ALON)
        YCOA=COS(DTOR*ALAT)*SIN(DTOR*ALON)
        ZCOA=SIN(DTOR*ALAT)
C
        XCOB=COS(DTOR*BLAT)*COS(DTOR*BLON)
        YCOB=COS(DTOR*BLAT)*SIN(DTOR*BLON)
        ZCOB=SIN(DTOR*BLAT)
C
        ADSGCR=2.*RTOD*ASIN(SQRT((XCOA-XCOB)**2+
     +                           (YCOA-YCOB)**2+
     +                           (ZCOA-ZCOB)**2)/2.)
C
        RETURN
C
      END


      SUBROUTINE IDBVII (NINP,XINP,YINP,ZIXO,ZIYO,IWRK,FWRK,
     +                        MGSV,NGSV,MCFA,NCFA,ZCFX,ZCFY,
     +                                       XOTP,YOTP,IERR)
C
        DIMENSION XINP(*),YINP(*),ZIXO(*),ZIYO(*),IWRK(*),FWRK(*)
C
        DIMENSION ZCFX(MCFA,NCFA),ZCFY(MCFA,NCFA)
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
C NOTE: THIS ROUTINE IS NO LONGER USED AND, IN ANY CASE, I THINK THERE
C MAY BE SOMETHING WRONG WITH IT.  I'm leaving it in just in case I need
C something like it later on.
C
C This routine attempts to find that point on a PNG image which is
C mapped into a specified point by the correction function being used
C by the editor.  It does this in a rather brute-force and non-general
C way, so beware of adapting this routine for other purposes.
C
C First, get the X and Y components of the correction function at the
C point of interest.
C
        CALL IDBVIV (NINP,XINP,YINP,ZIXO,ZIYO,IWRK,FWRK,
     +                    MGSV,NGSV,MCFA,NCFA,ZCFX,ZCFY,
     +                              XOTP,YOTP,ZOXO,ZOYO)
C
C Estimate a best-guess position for the point that the correction
C function maps into the point of interest.
C
        XBGP=XOTP-ZOXO
        YBGP=YOTP-ZOYO
C
C Now, get the X and Y components of the correction function at the
C best-guess position and compute a measure of how good that position
C actually is..
C
        CALL IDBVIV (NINP,XINP,YINP,ZIXO,ZIYO,IWRK,FWRK,
     +                    MGSV,NGSV,MCFA,NCFA,ZCFX,ZCFY,
     +                              XBGP,YBGP,ZOXO,ZOYO)
C
        SBGP=SQRT((XBGP+ZOXO-XOTP)**2+(YBGP+ZOYO-YOTP)**2)
C
C Compute the size of an initial search grid.
C
        SGSZ=SQRT(ZOXO**2+ZOYO**2)
C
C Examine each of 100 points around the current best-guess position and
C substitute the best of them for it.
C
  101   XTMP=XBGP
        YTMP=YBGP
C
        DO 103 I=1,10
          XTRY=XTMP+((REAL(I)-5.5)/4.5)*SGSZ
          DO 102 J=1,10
            YTRY=YTMP+((REAL(J)-5.5)/4.5)*SGSZ
            CALL IDBVIV (NINP,XINP,YINP,ZIXO,ZIYO,IWRK,FWRK,
     +                        MGSV,NGSV,MCFA,NCFA,ZCFX,ZCFY,
     +                                  XTRY,YTRY,ZOXO,ZOYO)
            STRY=SQRT((XTRY+ZOXO-XOTP)**2+(YTRY+ZOYO-YOTP)**2)
            IF (STRY.LT.SBGP) THEN
              XBGP=XTRY
              YBGP=YTRY
              SBGP=STRY
            END IF
  102     CONTINUE
  103   CONTINUE
C
C If the grid size is larger than a hard-wired tolerance, reduce it
C and jump back to continue searching.
C
        IF (SGSZ.GT..001) THEN
          SGSZ=SGSZ/5.
          GO TO 101
        END IF
C
C Otherwise, return the current best-guess position to the caller.
C
        PRINT * , Q
        PRINT * , 'In IDBVII:',Q
        PRINT * , '  Input values:    ',XOTP,YOTP,Q
        PRINT * , '  Output values:   ',XBGP,YBGP,Q
        PRINT * , '  Last test value: ',SBGP,Q
        XOTP=XBGP
        YOTP=YBGP
C
C Set error flag (reserved for possible future use).
C
        IERR=0
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE IDBVIV (NINP,XINP,YINP,ZIXO,ZIYO,IWRK,FWRK,
     +                        MGSV,NGSV,MCFA,NCFA,ZCFX,ZCFY,
     +                                  XOTP,YOTP,ZOXO,ZOYO)
C
        DIMENSION XINP(*),YINP(*),ZIXO(*),ZIYO(*),IWRK(*),FWRK(*)
C
        DIMENSION ZCFX(MCFA,NCFA),ZCFY(MCFA,NCFA)
C
        IF (NINP.GT.0) THEN
          CALL IDBVIP (2,NINP,XINP,YINP,ZIXO,1,XOTP,YOTP,ZOXO,IWRK,FWRK)
          CALL IDBVIP (3,NINP,XINP,YINP,ZIYO,1,XOTP,YOTP,ZOYO,IWRK,FWRK)
        ELSE
          XTMP=(XOTP/REAL(MGSV))*REAL(MCFA-1)
          YTMP=(YOTP/REAL(NGSV))*REAL(NCFA-1)
          ITMP=MAX(1,MIN(MCFA-1,1+INT(XTMP)))
          JTMP=MAX(1,MIN(NCFA-1,1+INT(YTMP)))
          XTMP=XTMP-REAL(ITMP)
          YTMP=YTMP-REAL(JTMP)
          ZOXO=(1.-YTMP)*((1.-XTMP)*ZCFX(ITMP  ,JTMP  )+
     +                        XTMP *ZCFX(ITMP+1,JTMP  ))
     +           + YTMP *((1.-XTMP)*ZCFX(ITMP  ,JTMP+1)+
     +                        XTMP *ZCFX(ITMP+1,JTMP+1))
          ZOYO=(1.-YTMP)*((1.-XTMP)*ZCFY(ITMP  ,JTMP  )+
     +                        XTMP *ZCFY(ITMP+1,JTMP  ))
     +           + YTMP *((1.-XTMP)*ZCFY(ITMP  ,JTMP+1)+
     +                        XTMP *ZCFY(ITMP+1,JTMP+1))
        END IF
C
        RETURN
C
      END


      SUBROUTINE EDSTOP
C
C This is a common "STOP" routine for the editor.  It makes sure that,
C if "raw" terminal input is in progress, it is turned off.
C
C Declare an integer variable that says what sort of terminal input is
C being done.  If ITTY is zero, normal terminal input is in progress;
C otherwise, raw terminal input is being done.
C
        COMMON /QTERMI/ ITTY
        SAVE   /QTERMI/
C
C Declare a character variable from which a single character will be
C written at the end of each line of print output.  The routines I am
C using to do raw terminal input require that this variable contain a
C carriage return (CHAR(13)), but this may be system-dependent.
C
        COMMON /QBLOCK/ Q
          CHARACTER*1 Q
        SAVE   /QBLOCK/
C
        IF (ITTY.NE.0) THEN
          CALL SETTTY (1,IERR)
          IF (IERR.EQ.0) THEN
            ITTY=0
            Q=' '
            PRINT * , Q
            PRINT * , 'Editor stop with raw terminal input off.',Q
          ELSE
            PRINT * , Q
            PRINT * , 'Error return by routine SETTTY: ',IERR,Q
            PRINT * , 'Can''t turn off ''raw'' terminal input.',Q
            PRINT * , Q
            PRINT * , 'Editor stop with raw terminal input on.',Q
          END IF
        END IF
C
        STOP
C
      END


      SUBROUTINE BLNKIT (XMIN,XMAX,YMIN,YMAX)
        DIMENSION XCRD(5),YCRD(5)
        XCRD(1)=XMIN
        YCRD(1)=YMIN
        XCRD(2)=XMAX
        YCRD(2)=YMIN
        XCRD(3)=XMAX
        YCRD(3)=YMAX
        XCRD(4)=XMIN
        YCRD(4)=YMAX
        XCRD(5)=XMIN
        YCRD(5)=YMIN
        CALL GSFACI (0)
        CALL GFA    (5,XCRD,YCRD)
        RETURN
      END
