.OP LS=10000 LI=1 CB RT ES=< ET=> OC UC=0
.EL I

I
I $Id: CodeIftran,v 1.13 2008-09-18 00:39:48 kennison Exp $
I

      FUNCTION MAPACI (IAI)
        INTEGER IAI
        MAPACI=MDPACI(IAI)
        RETURN
      END


      FUNCTION MDPACI (IAI)
C
        INTEGER IAI
C
C Given an integer area identifier IAI generated by MDPBLA, the value
C of MDPACI is an appropriate color index for the area.
C
C Define the array of color indices.
C
        INTEGER ICI(1361)
C
        DATA (ICI(I),I=   1, 100) /
     +      2,1,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 ,
     +      1,2,2,2,2 , 1,2,2,2,1 , 2,2,2,2,2 , 1,2,1,1,2 , 1,2,2,2,2 ,
     +      1,2,2,2,1 , 2,2,2,1,2 , 2,2,2,2,2 , 1,2,2,2,2 , 2,2,2,2,2 ,
     +      2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 /
        DATA (ICI(I),I= 101, 200) /
     +      2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,1,2,2,2 , 2,2,1,2,1 ,
     +      1,1,2,1,1 , 1,2,2,1,2 , 2,2,2,2,2 , 2,2,1,2,2 , 2,1,1,2,2 ,
     +      2,2,2,2,1 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 ,
     +      2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 /
        DATA (ICI(I),I= 201, 300) /
     +      2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,2,2,2 , 2,2,7,2,3 ,
     +      4,2,2,2,2 , 2,2,2,4,4 , 1,5,4,4,4 , 4,6,5,1,2 , 1,3,1,4,5 ,
     +      6,2,5,2,3 , 3,4,2,2,4 , 1,6,2,1,1 , 4,2,4,4,5 , 4,4,1,1,1 ,
     +      1,3,1,4,1 , 1,4,2,4,4 , 2,4,2,2,1 , 4,2,2,1,3 , 4,4,4,6,4 /
        DATA (ICI(I),I= 301, 400) /
     +      4,4,4,4,4 , 4,2,2,4,5 , 5,1,4,2,2 , 2,2,2,1,6 , 2,4,1,4,2 ,
     +      2,1,4,1,2 , 2,2,1,2,2 , 1,2,3,1,4 , 4,2,4,4,4 , 4,1,4,4,4 ,
     +      4,6,4,2,2 , 3,1,4,4,4 , 4,4,4,4,4 , 4,4,4,4,4 , 2,4,4,4,2 ,
     +      4,2,4,2,4 , 4,2,4,4,2 , 1,2,4,2,2 , 4,4,5,4,4 , 4,4,4,4,2 /
        DATA (ICI(I),I= 401, 500) /
     +      2,1,4,4,2 , 3,1,3,5,4 , 1,2,2,1,1 , 1,1,6,3,3 , 6,6,6,6,6 ,
     +      1,5,4,4,1 , 5,5,5,5,5 , 5,5,5,5,7 , 1,6,6,3,6 , 3,3,3,3,3 ,
     +      3,3,7,3,3 , 3,3,3,3,7 , 3,6,6,6,6 , 1,2,3,4,6 , 2,2,2,2,2 ,
     +      2,2,4,4,1 , 5,4,4,6,6 , 4,4,6,6,1 , 6,5,6,1,2 , 1,3,6,6,1 /
        DATA (ICI(I),I= 501, 600) /
     +      1,4,6,5,6 , 2,6,6,6,6 , 5,2,3,1,3 , 6,4,1,1,6 , 1,2,2,4,6 ,
     +      1,6,6,6,2 , 1,1,4,2,6 , 4,4,5,4,4 , 1,1,1,1,3 , 1,4,1,3,1 ,
     +      4,2,3,4,4 , 2,4,2,2,1 , 4,6,2,2,1 , 3,4,6,4,4 , 4,5,6,4,4 ,
     +      4,4,4,4,4 , 2,2,2,4,5 , 5,1,6,4,6 , 2,2,2,2,2 , 2,1,6,2,4 /
        DATA (ICI(I),I= 601, 700) /
     +      1,4,4,2,2 , 1,4,1,2,6 , 2,2,1,2,2 , 4,5,1,2,3 , 1,4,4,6,2 ,
     +      4,4,4,4,5 , 1,3,4,6,4 , 4,4,6,4,2 , 2,6,6,3,1 , 4,2,4,4,5 ,
     +      4,4,4,4,4 , 4,4,4,4,4 , 6,2,4,4,4 , 7,2,4,7,2 , 4,2,4,4,2 ,
     +      4,4,2,1,2 , 4,2,2,4,4 , 5,4,4,4,4 , 4,4,2,2,2 , 1,4,4,2,6 /
        DATA (ICI(I),I= 701, 800) /
     +      2,2,3,1,6 , 3,5,4,4,3 , 1,2,3,2,1 , 1,1,2,1,3 , 3,3,6,3,6 ,
     +      6,6,6,1,5 , 4,4,1,4,3 , 5,5,5,3,5 , 5,5,5,5,5 , 3,6,7,6,7 ,
     +      5,6,3,3,4 , 5,3,7,7,6 , 2,5,7,3,7 , 5,7,2,3,6 , 4,2,4,2,2 ,
     +      5,2,2,6,5 , 6,3,4,4,2 , 2,4,5,2,2 , 2,5,2,3,3 , 5,6,5,3,4 /
        DATA (ICI(I),I= 801, 900) /
     +      2,6,4,3,4 , 5,5,4,6,5 , 2,6,3,3,3 , 5,6,4,4,3 , 2,3,2,4,2 ,
     +      5,2,2,4,4 , 2,6,6,1,4 , 2,5,5,5,5 , 2,3,6,2,6 , 3,3,2,6,3 ,
     +      5,6,5,2,6 , 3,3,6,1,2 , 5,1,4,2,3 , 1,4,6,1,3 , 2,4,5,1,2 ,
     +      1,1,3,5,3 , 4,6,2,3,5 , 3,6,5,6,4 , 1,6,2,4,6 , 4,6,6,6,3 /
        DATA (ICI(I),I= 901,1000) /
     +      6,4,3,1,6 , 3,4,6,2,3 , 1,5,1,4,5 , 3,3,4,3,6 , 3,5,5,5,5 ,
     +      6,6,2,4,1 , 5,5,5,5,5 , 6,6,5,3,3 , 5,5,4,5,5 , 5,4,2,4,4 ,
     +      4,5,5,5,4 , 2,5,5,4,5 , 5,5,3,3,5 , 5,3,5,3,5 , 5,3,6,6,3 ,
     +      6,6,3,6,3 , 6,6,3,6,3 , 3,3,6,3,3 , 6,3,7,6,3 , 3,6,3,6,6 /
        DATA (ICI(I),I=1001,1100) /
     +      3,3,2,7,1 , 6,6,3,6,3 , 3,3,3,3,3 , 3,7,3,3,3 , 3,3,3,7,3 ,
     +      6,6,6,6,1 , 3,6,6,6,6 , 1,6,6,6,6 , 1,7,6,6,6 , 6,1,6,1,1 ,
     +      6,1,6,6,6 , 6,3,1,3,6 , 4,6,5,2,1 , 6,6,2,4,6 , 1,6,4,5,6 ,
     +      5,3,6,6,6 , 1,2,6,6,5 , 6,6,7,7,2 , 2,6,2,6,3 , 4,3,3,2,3 /
        DATA (ICI(I),I=1101,1200) /
     +      4,3,3,3,6 , 7,6,7,5,6 , 3,3,4,5,3 , 7,7,6,2,5 , 7,3,7,5,7 ,
     +      2,3,6,4,2 , 4,2,2,5,2 , 2,6,5,6,3 , 4,4,2,2,4 , 5,2,2,2,5 ,
     +      2,3,3,5,6 , 5,3,4,2,6 , 4,3,4,5,5 , 4,6,5,2,6 , 3,3,3,5,6 ,
     +      4,4,3,2,3 , 2,4,2,5,2 , 2,4,4,2,6 , 6,1,4,2,5 , 5,5,5,2,3 /
        DATA (ICI(I),I=1201,1300) /
     +      6,2,6,3,3 , 2,6,3,5,6 , 5,2,6,3,3 , 6,1,2,5,1 , 4,2,3,1,4 ,
     +      6,1,3,2,4 , 5,1,2,1,1 , 3,5,3,4,6 , 2,3,5,3,6 , 5,6,4,1,6 ,
     +      2,4,6,4,6 , 6,6,3,6,4 , 3,1,6,3,4 , 6,2,3,1,5 , 1,4,5,3,3 ,
     +      4,3,6,3,5 , 5,5,5,6,6 , 2,4,1,5,5 , 5,5,5,6,6 , 5,3,3,5,5 /
        DATA (ICI(I),I=1301,1361) /
     +      4,5,5,5,4 , 2,4,4,4,5 , 5,5,4,2,5 , 5,4,5,5,5 , 3,3,5,5,3 ,
     +      5,3,5,5,3 , 6,6,3,6,6 , 3,6,3,6,6 , 3,6,3,3,3 , 6,3,3,6,3 ,
     +      7,6,3,3,6 , 3,6,6,3,3 , 2 /
C
C Pull out the appropriate color index, taking precautions to prevent
C an out-of-array reference.
C
        IF (IAI.GE.1.AND.IAI.LE.1361)
          MDPACI=ICI(IAI)
        ELSE
          MDPACI=1
        END IF
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE MAPBLA (IAMP)
        INTEGER IAMP(*)
        IF (ICFELL('MAPBLA - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
        CALL MDPBLA (IAMP)
        IF (ICFELL('MAPBLA',2).NE.0) RETURN
        RETURN
      END


      SUBROUTINE MDPBLA (IAMP)
C
        INTEGER IAMP(*)
C
C Declare required common blocks.
C
        COMMON /MAPCM0/  COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        DOUBLE PRECISION COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        SAVE   /MAPCM0/
C
        COMMON /MAPCM1/  COSO,COSR,SINO,SINR,IPRJ,IROD
        DOUBLE PRECISION COSO,COSR,SINO,SINR
        INTEGER          IPRJ,IROD
        SAVE   /MAPCM1/
C
        COMMON /MAPCM2/  BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG,ISSL
        DOUBLE PRECISION BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG
        INTEGER          ISSL
        SAVE   /MAPCM2/
C
        COMMON /MAPCM3/  ITPN,NOUT,NPTS,IGID,IDLS,IDRS,BLAG,SLAG,BLOG,
     +                   SLOG,PNTS(200),IDOS(4)
        INTEGER          ITPN,NOUT,NPTS,IGID,IDLS,IDRS,IDOS
        REAL             BLAG,SLAG,BLOG,SLOG,PNTS
        SAVE   /MAPCM3/
C
        COMMON /MAPCM4/  GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW,IDOT,IDSH,IDTL,ILCW,
     +                   ILTS,JPRJ,ELPF,INTF,LBLF,PRMF
        DOUBLE PRECISION GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW
        INTEGER          IDOT,IDSH,IDTL,ILCW,ILTS,JPRJ
        LOGICAL          ELPF,INTF,LBLF,PRMF
        SAVE   /MAPCM4/
C
        COMMON /MAPCM5/  DDCT(5),DDCL(5),LDCT(6),LDCL(6),PDCT(19),
     +                   PDCL(19)
        CHARACTER*2      DDCT,DDCL,LDCT,LDCL,PDCT,PDCL
        SAVE   /MAPCM5/
C
        COMMON /MAPCMC/  IGI1,IGI2,NCRA,NOVS,XCRA(100),YCRA(100)
        INTEGER          IGI1,IGI2,NCRA,NOVS
        REAL             XCRA,YCRA
        SAVE   /MAPCMC/
C
        COMMON /MAPCMW/  CSLS,CSLT,SLTD,ISLT
        DOUBLE PRECISION CSLS,CSLT,SLTD
        INTEGER ISLT
        SAVE   /MAPCMW/
C
        COMMON /MAPSAT/  ALFA,BETA,DCSA,DCSB,DSNA,DSNB,SALT,SSMO,SRSS
        DOUBLE PRECISION ALFA,BETA,DCSA,DCSB,DSNA,DSNB,SALT,SSMO,SRSS
        SAVE   /MAPSAT/
C
        COMMON /USGSC1/  UTPA(15),UUMN,UUMX,UVMN,UVMX,IPRF
        DOUBLE PRECISION UTPA,UUMN,UUMX,UVMN,UVMX
        INTEGER IPRF
        SAVE   /USGSC1/
C
C Declare local variables.
C
        DOUBLE PRECISION ALPH,CLAT,CLON,CRAD,COSA,COSB,COSL,COSP,DEPS,
     +                   DIST,DLAT,DLON,DR,DS,SINA,SINB,SINL,SINP,RLAT,
     +                   RLON,RVTU,SSLT,TEMP,U,UCIR,UEDG,UNS1,UOLD,URAD,
     +                   UVAL,V,VCIR,VEDG,VNS1,VOLD,VVAL,X,XANP,XAS1,
     +                   XAS2,XCRD,YANP,YAS1,YAS2,YCRD
C
        INTEGER          I,IAID,IAM5,IDIV,IDLT,IDRT,IFDE,IGRP,IPEN,IPSS,
     +                   ISTA,IVIS,IWGF,J,K,MCHR,NCHR,NCOL,NROW,NSEG,
     +                   NTMS
C
C Declare a couple of temporary arrays to hold coordinates of a circle.
C
        DOUBLE PRECISION TLAT(361),TLON(361)
C
C Dimension the arrays needed to define some lines across the map.
C
        REAL             XCR(2),YCR(2)
C
C Declare an array in which to construct a file name.
C
        CHARACTER*128 FLNM
C
C Declare an array to use as an input buffer in reading characters.
C
        CHARACTER*1 CHRS(512)
C
C Declare arithmetic statement functions.
C
        DOUBLE PRECISION CEIL,FLOR
C
C Declare external functions.
C
        DOUBLE PRECISION RBGDFE,RBGLEN
C
C The arithmetic statement functions FLOR and CEIL give, respectively,
C the "floor" of X - the largest integer less than or equal to X - and
C the "ceiling" of X - the smallest integer greater than or equal to X.
C
        FLOR(X)=DINT(X+1.D4)-1.D4
        CEIL(X)=-FLOR(-X)
C
C Check for an uncleared prior error.
C
        IF (ICFELL('MDPBLA - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C If EZMAP needs initialization, do it.
C
        IF (INTF)
          CALL MDPINT
          IF (ICFELL('MDPBLA',2).NE.0) RETURN
        END IF
C
C Put the perimeter and the limb line into the area map (in group 1 and,
C perhaps, in group 2).
C
        IPSS=1
        IGRP=IGI1
C
        LOOP
C
C Perimeter.
C
          IDLT=0
          IDRT=-1
C
          IF (ELPF)
            TEMP=.9998D0
            LOOP
              U=URNG
              V=0.D0
              XCRD=UCEN+TEMP*U
              YCRD=VCEN
              INVOKE (START-A-LINE)
              FOR (I = 1 TO 360)
                U=URNG*COS(DTOR*DBLE(I))
                V=URNG*SIN(DTOR*DBLE(I))
                XCRD=UCEN+TEMP*U
                YCRD=VCEN+TEMP*V*VRNG/URNG
                INVOKE (CONTINUE-THE-LINE)
              END FOR
            EXIT IF (TEMP.EQ.1.0002D0)
              TEMP=1.0002D0
            END LOOP
          ELSE
            XCRD=UMIN-1.0002D0*(UMAX-UMIN)
            YCRD=VMIN-1.0002D0*(UMAX-UMIN)
            INVOKE (START-A-LINE)
            XCRD=UMAX+1.0002D0*(UMAX-UMIN)
            YCRD=VMIN-1.0002D0*(UMAX-UMIN)
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMAX+1.0002D0*(UMAX-UMIN)
            YCRD=VMAX+1.0002D0*(UMAX-UMIN)
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMIN-1.0002D0*(UMAX-UMIN)
            YCRD=VMAX+1.0002D0*(UMAX-UMIN)
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMIN-1.0002D0*(UMAX-UMIN)
            YCRD=VMIN-1.0002D0*(UMAX-UMIN)
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMIN+.9998D0*(UMAX-UMIN)
            YCRD=VMIN+.9998D0*(VMAX-VMIN)
            INVOKE (START-A-LINE)
            XCRD=UMAX-.9998D0*(UMAX-UMIN)
            YCRD=VMIN+.9998D0*(VMAX-VMIN)
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMAX-.9998D0*(UMAX-UMIN)
            YCRD=VMAX-.9998D0*(VMAX-VMIN)
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMIN+.9998D0*(UMAX-UMIN)
            YCRD=VMAX-.9998D0*(VMAX-VMIN)
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMIN+.9998D0*(UMAX-UMIN)
            YCRD=VMIN+.9998D0*(VMAX-VMIN)
            INVOKE (CONTINUE-THE-LINE)
          END IF
          INVOKE (TERMINATE-THE-LINE)
C
C Don't put the limb line in group 2.
C
          IF (IPSS.EQ.2) GO TO 108
C
C Limb line.
C
C Projection:     US  LC  ST  OR  LE  GN  AE
C                     CE  ME  MT  RO  EA  AI  HA  MO  WT  (arbitrary)
C                     CE  ME  MT  RO  EA  AI  HA  MO  WT  (fast-path)
C                         ME
C
          GO TO (100,101,108,102,103,108,104,
     +               107,107,105,107,107,109,110,110,107,
     +               107,107,105,107,107,109,110,110,107,
     +                   107                            ) , IPRJ+1
C
C USGS transformations.
C
  100     IF (IPRF.EQ. 3.OR.IPRF.EQ. 4.OR.IPRF.EQ. 5.OR.IPRF.EQ. 7.OR.
     +        IPRF.EQ. 8.OR.IPRF.EQ.16.OR.IPRF.EQ.17.OR.IPRF.EQ.18.OR.
     +        IPRF.EQ.19.OR.IPRF.EQ.21)
            IF (IPRF.EQ.3.OR.IPRF.EQ.8.OR.IPRF.EQ.17.OR.IPRF.EQ.18.OR.
     +          IPRF.EQ.21)
              DLON=GRDR
              RLAT=-89.998D0
              IDLT=0
              IDRT=-1
              K=CEIL(360.D0/DLON)
              DO (I=1,2)
                RLON=UTPA(5)-180.D0
                CALL MDPITA (RLAT,RLON,0,IAMP,IGRP,IDLT,IDRT)
                IF (ICFELL('MDPBLA',3).NE.0) RETURN
                DO (J=1,K-1)
                  RLON=RLON+DLON
                  CALL MDPITA (RLAT,RLON,1,IAMP,IGRP,IDLT,IDRT)
                  IF (ICFELL('MDPBLA',4).NE.0) RETURN
                END DO
                RLON=UTPA(5)+180.D0
                CALL MDPITA (RLAT,RLON,2,IAMP,IGRP,IDLT,IDRT)
                IF (ICFELL('MDPBLA',5).NE.0) RETURN
                CALL MDPIQA (            IAMP,IGRP,IDLT,IDRT)
                IF (ICFELL('MDPBLA',6).NE.0) RETURN
                RLAT=89.998D0
                IDLT=-1
                IDRT=0
              END DO
              INVOKE (TERMINATE-THE-LINE)
            END IF
            IF (IPRF.EQ.7)
              DLON= 89.999999D0
            ELSE
              DLON=179.999999D0
            END IF
            DLAT=GRDR
            RLON=UTPA(5)+DLON
            IDLT=0
            IDRT=-1
            K=CEIL(180.D0/DLAT)
            DO (I=1,2)
              RLAT=-90.D0
              CALL MDPITA (RLAT,RLON,0,IAMP,IGRP,IDLT,IDRT)
              IF (ICFELL('MDPBLA',7).NE.0) RETURN
              DO (J=1,K-1)
                RLAT=RLAT+DLAT
                CALL MDPITA (RLAT,RLON,1,IAMP,IGRP,IDLT,IDRT)
                IF (ICFELL('MDPBLA',8).NE.0) RETURN
              END DO
              RLAT=90.D0
              CALL MDPITA (RLAT,RLON,2,IAMP,IGRP,IDLT,IDRT)
              IF (ICFELL('MDPBLA',9).NE.0) RETURN
              CALL MDPIQA (            IAMP,IGRP,IDLT,IDRT)
              IF (ICFELL('MDPBLA',10).NE.0) RETURN
              RLON=UTPA(5)-DLON
              IDLT=-1
              IDRT=0
            END DO
            INVOKE (TERMINATE-THE-LINE)
            GO TO 108
          ELSE IF (IPRF.EQ.9)
            DLON=GRDR
            RLAT=-.001D0
            IDLT=-1
            IDRT=0
            K=CEIL(180.D0/DLON)
            DO (I=1,2)
              RLON=UTPA(5)+90.D0
              CALL MDPITA (RLAT,RLON,0,IAMP,IGRP,IDLT,IDRT)
              IF (ICFELL('MDPBLA',11).NE.0) RETURN
              DO (J=1,K-1)
                RLON=RLON+DLON
                CALL MDPITA (RLAT,RLON,1,IAMP,IGRP,IDLT,IDRT)
                IF (ICFELL('MDPBLA',12).NE.0) RETURN
              END DO
              RLON=UTPA(5)+270.D0
              CALL MDPITA (RLAT,RLON,2,IAMP,IGRP,IDLT,IDRT)
              IF (ICFELL('MDPBLA',13).NE.0) RETURN
              CALL MDPIQA (            IAMP,IGRP,IDLT,IDRT)
              IF (ICFELL('MDPBLA',14).NE.0) RETURN
              RLAT=.001D0
              IDLT=0
              IDRT=-1
            END DO
            INVOKE (TERMINATE-THE-LINE)
            GO TO 108
          ELSE IF (IPRF.EQ.11.OR.IPRF.EQ.12.OR.IPRF.EQ.14.OR.
     +                           IPRF.EQ.15.OR.IPRF.EQ.23)
            IF (IPRF.EQ.11.OR.IPRF.EQ.12)
              CLAT=UTPA(6)
              CLON=UTPA(5)
              CRAD=179.95D0
            ELSE IF (IPRF.EQ.14)
              CLAT=UTPA(6)
              CLON=UTPA(5)
              CRAD=89.999D0
            ELSE IF (IPRF.EQ.15)
              CLAT=UTPA(6)
              CLON=UTPA(5)
              CRAD=RTOD*ACOS(UTPA(1)/(UTPA(1)+UTPA(3)))-.001D0
            ELSE IF (IPRF.EQ.23)
              CLAT=  64.D0
              CLON=-152.D0
              CRAD=  29.999D0
            END IF
            CALL MDGCOG (CLAT,CLON,CRAD,TLAT,TLON,361)
            CALL MDPITA (TLAT(1),TLON(1),0,IAMP,IGRP,0,-1)
            IF (ICFELL('MDPBLA',15).NE.0) RETURN
            DO (I=2,360)
              CALL MDPITA (TLAT(I),TLON(I),1,IAMP,IGRP,0,-1)
              IF (ICFELL('MDPBLA',16).NE.0) RETURN
            END DO
            CALL MDPITA (TLAT(361),TLON(361),2,IAMP,IGRP,0,-1)
            IF (ICFELL('MDPBLA',17).NE.0) RETURN
            CALL MDPIQA (                      IAMP,IGRP,0,-1)
            IF (ICFELL('MDPBLA',18).NE.0) RETURN
            GO TO 108
          ELSE IF (IPRF.EQ.20)
            ALPH=DTOR*(180.D0-UTPA(4))
            CALL MDPTRN (+90.D0,0.D0,XANP,YANP)
            IF (ICFELL('MDPBLA',19).NE.0) RETURN
            CALL MDPTRN (-90.D0,0.D0,XAS1,YAS1)
            IF (ICFELL('MDPBLA',20).NE.0) RETURN
            UNS1=(XAS1-XANP)*COS(ALPH)+(YAS1-YANP)*SIN(ALPH)
            VNS1=(YAS1-YANP)*COS(ALPH)-(XAS1-XANP)*SIN(ALPH)
            XAS2=XANP+VNS1*SIN(ALPH)+UNS1*COS(ALPH)
            YAS2=YANP+UNS1*SIN(ALPH)-VNS1*COS(ALPH)
            DIST=SQRT((XAS2-XAS1)*(XAS2-XAS1)+(YAS2-YAS1)*(YAS2-YAS1))
            IF (VNS1.LT.0.D0)
              DEPS=-.001D0*DIST
              IDLT=-1
              IDRT= 0
            ELSE
              DEPS=+.001D0*DIST
              IDLT= 0
              IDRT=-1
            END IF
            DIST=2.D0*DIST
            XCR(1)=REAL(XAS1-DIST*COS(ALPH)+DEPS*SIN(ALPH))
            YCR(1)=REAL(YAS1-DIST*SIN(ALPH)-DEPS*COS(ALPH))
            XCR(2)=REAL(XAS1+DIST*COS(ALPH)+DEPS*SIN(ALPH))
            YCR(2)=REAL(YAS1+DIST*SIN(ALPH)-DEPS*COS(ALPH))
            CALL AREDAM (IAMP,XCR,YCR,2,IGRP,IDRT,IDLT)
            IF (ICFELL('MDPBLA',21).NE.0) RETURN
            XCR(1)=REAL(XAS2-DIST*COS(ALPH)-DEPS*SIN(ALPH))
            YCR(1)=REAL(YAS2-DIST*SIN(ALPH)+DEPS*COS(ALPH))
            XCR(2)=REAL(XAS2+DIST*COS(ALPH)-DEPS*SIN(ALPH))
            YCR(2)=REAL(YAS2+DIST*SIN(ALPH)+DEPS*COS(ALPH))
            CALL AREDAM (IAMP,XCR,YCR,2,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPBLA',22).NE.0) RETURN
            GO TO 108
          ELSE
            GO TO 108
          END IF
C
C Lambert conformal conic.
C
  101     DLAT=GRDR
          RLON=PLNO+179.999999D0
          IDLT=0
          IDRT=-1
          K=CEIL(180.D0/DLAT)
          DO (I=1,2)
            RLAT=-90.D0
            CALL MDPITA (RLAT,RLON,0,IAMP,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPBLA',23).NE.0) RETURN
            DO (J=1,K-1)
              RLAT=RLAT+DLAT
              CALL MDPITA (RLAT,RLON,1,IAMP,IGRP,IDLT,IDRT)
              IF (ICFELL('MDPBLA',24).NE.0) RETURN
            END DO
            RLAT=90.D0
            CALL MDPITA (RLAT,RLON,2,IAMP,IGRP,IDLT,IDRT)
            CALL MDPIQA (            IAMP,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPBLA',25).NE.0) RETURN
            RLON=PLNO-179.999999D0
            IDLT=-1
            IDRT=0
          END DO
          INVOKE (TERMINATE-THE-LINE)
          GO TO 108
C
C Orthographic (or satellite-view).
C
  102     IF (ABS(SALT).LE.1.D0.OR.ALFA.EQ.0.D0)
            URAD=1.D0
            RVTU=1.D0
            GO TO 106
          ELSE
            SSLT=SALT
            SALT=-ABS(SALT)
            IDLT=-1
            IDRT=0
            DR=.9998D0
            LOOP
              IPEN=0
              DO (I=1,361)
                COSB=COS(DBLE(DTOR*DBLE(I-1)))
                SINB=SIN(DBLE(DTOR*DBLE(I-1)))
                IF (DR.LT.1.D0)
                  COSA=(DR*DR*ABS(SALT)+SSMO*SQRT(1.D0-DR*DR))/
     +                                             (DR*DR+SSMO)
                ELSE
                  DS=2.D0-DR
                  COSA=(DS*DS*ABS(SALT)-SSMO*SQRT(1.D0-DS*DS))/
     +                                             (DS*DS+SSMO)
                END IF
                SINA=SQRT(1.D0-COSA*COSA)
                SINL=SINA*SINB
                COSL=COSA*COSO-SINA*SINO*COSB
                COSP=SQRT(SINL*SINL+COSL*COSL)
                IF (COSP.NE.0.D0)
                  SINL=SINL/COSP
                  COSL=COSL/COSP
                END IF
                IF (ABS(SINO).GT..000001D0)
                  SINP=(COSA-COSP*COSL*COSO)/SINO
                ELSE
                  SINP=SINA*COSB
                END IF
                RLAT=RTOD*ATAN2(SINP,COSP)
                RLON=PLNO+RTOD*ATAN2(SINA*SINB,
     +                         COSA*COSO-SINA*SINO*COSB)
                IF (ABS(RLON).GT.180.D0) RLON=RLON-SIGN(360.D0,RLON)
                CALL MDPITA (RLAT,RLON,IPEN,IAMP,IGRP,IDLT,IDRT)
                IF (ICFELL('MDPBLA',26).NE.0) RETURN
                IPEN=1
                IF (I.EQ.360) IPEN=2
              END DO
              INVOKE (TERMINATE-THE-LINE)
            EXIT IF (DR.EQ.1.0002D0)
              DR=1.0002D0
            END LOOP
            SALT=SSLT
            GO TO 108
          END IF
C
C Lambert equal-area.  Note:  The constant "1.999999500000" is the real
C effective radius of the limb of the Lambert equal area projection, as
C determined by the test at statement number 106 in the routine MDPTRN.
C
  103     URAD=1.9999995000000D0
          RVTU=1.D0
          GO TO 106
C
C Azimuthal equidistant.  Note:  The constant "3.140178439909" is the
C real effective radius of the limb of the azimuthal equidistant
C projection, as determined by the test at statement number 108 in the
C routine MDPTRN.
C
  104     URAD=3.1401784399095D0
          RVTU=1.D0
          GO TO 106
C
C Mollweide type.
C
  105     URAD=2.D0
          RVTU=0.5D0
          GO TO 106
C
C Aitoff.
C
  109     URAD=3.14159265358979D0
          RVTU=.5D0
          GO TO 106
C
C Hammer and true Mollweide.
C
  110     URAD=2.82842712474619D0
          RVTU=.5D0
          GO TO 106
C
  106     IF (ELPF.AND.ABS(UCEN).LT..0001D0.AND.
     +                 ABS(VCEN).LT..0001D0.AND.
     +                 ABS(URNG-URAD).LT..0001D0.AND.
     +                 ABS(VRNG/URNG-RVTU).LT..0001D0) GO TO 108
C
          TEMP=.9998D0
C
          LOOP
            IDLT=0
            IDRT=-1
            IVIS=-1
            FOR (I = 1 TO 361)
              UCIR=TEMP*URAD*COS(DTOR*DBLE(I-1))
              VCIR=TEMP*URAD*SIN(DTOR*DBLE(I-1))
              U=UCIR-UOFF
              V=RVTU*VCIR-VOFF
              IF (.NOT.ELPF.AND.
     +            (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX))
                IF (IVIS.EQ.1)
                  CALL MDPTRP (UOLD,VOLD,U,V,UEDG,VEDG)
                  XCRD=UEDG
                  YCRD=VEDG
                  INVOKE (CONTINUE-THE-LINE)
                END IF
                IVIS=0
              ELSE IF (ELPF.AND.
     +                 (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.D0))
                IF (IVIS.EQ.1)
                  CALL MDPTRE (UOLD,VOLD,U,V,UEDG,VEDG)
                  XCRD=UEDG
                  YCRD=VEDG
                  INVOKE (CONTINUE-THE-LINE)
                END IF
                IVIS=0
              ELSE
                IF (IVIS.LT.0)
                  XCRD=U
                  YCRD=V
                  INVOKE (START-A-LINE)
                  IVIS=1
                ELSE
                  IF (IVIS.EQ.0)
                    IF (.NOT.ELPF) CALL MDPTRP (U,V,UOLD,VOLD,UOLD,VOLD)
                    IF (     ELPF) CALL MDPTRE (U,V,UOLD,VOLD,UOLD,VOLD)
                    XCRD=UOLD
                    YCRD=VOLD
                    INVOKE (START-A-LINE)
                    IVIS=1
                  END IF
                  XCRD=U
                  YCRD=V
                  INVOKE (CONTINUE-THE-LINE)
                END IF
              END IF
              UOLD=U
              VOLD=V
            END FOR
            INVOKE (TERMINATE-THE-LINE)
          EXIT IF (TEMP.EQ.1.0002D0)
            TEMP=1.0002D0
          END LOOP
          GO TO 108
C
C Cylindrical equidistant, Mercator, Robinson, cylindrical equal-area,
C Winkel tripel.
C
  107     TEMP=.9998D0
C
          LOOP
            IDLT=0
            IDRT=-1
            IVIS=-1
            RLAT=-90.D0
            RLON=-180.D0
            FOR (I = 1 TO 361)
              IF (IPRJ.EQ.7.OR.IPRJ.EQ.16)
                U=TEMP*RLON-UOFF
                V=TEMP*RLAT/CSLT-VOFF
              ELSE IF (IPRJ.EQ.8.OR.IPRJ.EQ.17.OR.IPRJ.EQ.25)
                U=TEMP*DTOR*RLON-UOFF
                V=TEMP*LOG(TAN((MAX(-89.999999D0,
     +                          MIN(+89.999999D0,RLAT))+
     +                                                90.D0)*DTRH))-VOFF
                IF (IPRJ.EQ.25)
                  UTMP=U*COSR+V*SINR
                  VTMP=V*COSR-U*SINR
                  U=UTMP
                  V=VTMP
                END IF
              ELSE IF (IPRJ.EQ.11.OR.IPRJ.EQ.20)
                U=TEMP*DTOR*RLON-UOFF
                V=TEMP*SIN(DTOR*RLAT)/CSLS-VOFF
              ELSE IF (IPRJ.EQ.15.OR.IPRJ.EQ.24)
                CALL WTPROJ (TEMP*DTOR*RLAT,TEMP*DTOR*RLON,U,V,CSLT)
                U=U-UOFF
                V=V-VOFF
              ELSE
                U=TEMP*(RLON/180.D0)*RBGLEN(RLAT)-UOFF
                V=TEMP*RBGDFE(RLAT)-VOFF
              END IF
              IF (I.LE.90)
                RLON=RLON+4.D0
              ELSE IF (I.LE.180)
                RLAT=RLAT+2.D0
              ELSE IF (I.LE.270)
                RLON=RLON-4.D0
              ELSE IF (I.LE.360)
                RLAT=RLAT-2.D0
              END IF
              IF (.NOT.ELPF.AND.
     +            (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX))
                IF (IVIS.EQ.1)
                  CALL MDPTRP (UOLD,VOLD,U,V,UEDG,VEDG)
                  XCRD=UEDG
                  YCRD=VEDG
                  INVOKE (CONTINUE-THE-LINE)
                END IF
                IVIS=0
              ELSE IF (ELPF.AND.
     +                 (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.D0))
                IF (IVIS.EQ.1)
                  CALL MDPTRE (UOLD,VOLD,U,V,UEDG,VEDG)
                  XCRD=UEDG
                  YCRD=VEDG
                  INVOKE (CONTINUE-THE-LINE)
                END IF
                IVIS=0
              ELSE
                IF (IVIS.LT.0)
                  XCRD=U
                  YCRD=V
                  INVOKE (START-A-LINE)
                  IVIS=1
                ELSE
                  IF (IVIS.EQ.0)
                    IF (.NOT.ELPF) CALL MDPTRP (U,V,UOLD,VOLD,UOLD,VOLD)
                    IF (     ELPF) CALL MDPTRE (U,V,UOLD,VOLD,UOLD,VOLD)
                    XCRD=UOLD
                    YCRD=VOLD
                    INVOKE (START-A-LINE)
                    IVIS=1
                  END IF
                  XCRD=U
                  YCRD=V
                  INVOKE (CONTINUE-THE-LINE)
                END IF
              END IF
              UOLD=U
              VOLD=V
            END FOR
            INVOKE (TERMINATE-THE-LINE)
          EXIT IF (TEMP.EQ.1.0002D0)
            TEMP=1.0002D0
          END LOOP
C
  108   EXIT IF (IGRP.EQ.IGI2.OR.NOVS.LE.0)
C
          IPSS=2
          IGRP=IGI2
C
        END LOOP
C
C Add lines to group 2 to create vertical strips.
C
        IF (NOVS.GT.1)
C
          IDLT=0
          IDRT=0
C
          YCR(1)=VMIN
          YCR(2)=VMAX
C
          DO (I=1,NOVS-1)
            XCR(1)=REAL(UMIN+(DBLE(I)/DBLE(NOVS))*(UMAX-UMIN))
            XCR(2)=XCR(1)
            CALL AREDAM (IAMP,XCR,YCR,2,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPBLA',27).NE.0) RETURN
          END DO
C
        END IF
C
C If the selected outline type is "NONE", quit; no outlines need be
C added to the area map.
C
        IF (NOUT.LE.0) RETURN
C
C Set the flag IWGF to say whether or not the whole globe is shown by
C the current projection.  If so (IWGF=1), there's no need to waste the
C time required to check each outline point group for intersection with
C the window.
C
        IWGF=0
        IF (BLAM-SLAM.GT.179.D0.AND.BLOM-SLOM.GT.359.D0) IWGF=1
C
C Position to the user-selected portion of the outline dataset.
C
        IGRP=IGI1
        CALL MDPIO (1)
        IF (ICFELL('MDPBLA',28).NE.0) RETURN
        NSEG=0
C
C Save the pointer that will tell us whether anything actually got
C put into the area map, so that, if not, we can take remedial action.
C
        IAM5=IAMP(5)
C
C Read the next record (group of points).
C
  301   CALL MDPIO (2)
        IF (ICFELL('MDPBLA',29).NE.0) RETURN
        IDLT=IDOS(NOUT)+IDLS
        IDRT=IDOS(NOUT)+IDRS
        NSEG=NSEG+1
C
C If the end of the desired data has been reached, quit reading.
C
        IF (NPTS.EQ.0) GO TO 302
C
C If less than the whole globe is shown by the projection, do a quick
C check for intersection of the box surrounding the point group with
C the area shown.
C
        IF (IWGF.EQ.0)
          IF (DBLE(SLAG).GT.BLAM.OR.DBLE(BLAG).LT.SLAM) GO TO 301
          IF ((DBLE(SLOG     ).GT.BLOM.OR.
     +         DBLE(BLOG     ).LT.SLOM).AND.
     +        (DBLE(SLOG-360.).GT.BLOM.OR.
     +         DBLE(BLOG-360.).LT.SLOM).AND.
     +        (DBLE(SLOG+360.).GT.BLOM.OR.
     +         DBLE(BLOG+360.).LT.SLOM)) GO TO 301
        END IF
C
C See if the user wants to omit this point group.
C
        CALL HLUMAPEOD (NOUT,NSEG,IDLT,IDRT,NPTS,PNTS)
        IF (ICFELL('MDPBLA',30).NE.0) RETURN
        IF (NPTS.LE.1) GO TO 301
C
C Put the group into the area map.
C
        CALL MAPITA (PNTS(1),PNTS(2),0,IAMP,IGRP,IDLT,IDRT)
        IF (ICFELL('MDPBLA',31).NE.0) RETURN
C
        DO (K=2,NPTS-1)
          CALL MAPITA (PNTS(2*K-1),PNTS(2*K),1,IAMP,IGRP,IDLT,IDRT)
          IF (ICFELL('MDPBLA',32).NE.0) RETURN
        END DO
C
        CALL MAPITA (PNTS(2*NPTS-1),PNTS(2*NPTS),2,IAMP,IGRP,IDLT,IDRT)
        IF (ICFELL('MDPBLA',33).NE.0) RETURN
C
C Force a buffer dump.
C
        INVOKE (TERMINATE-THE-LINE)
C
C Go get another group.
C
        GO TO 301
C
C See if anything was actually put into the area map and, if not, take
C action to supply AREAS with a correct area identifier.
C
  302   IF (IAMP(5).EQ.IAM5)
          CALL MPDBDI (FLNM,ISTA)
          IF (ISTA.EQ.-1) GO TO 309
          DO 303 I=1,111
            IF (FLNM(I:I).EQ.CHAR(0))
              FLNM(I:I+17)='/EzmapAreaInfo.'//DDCT(NOUT+1)//CHAR(0)
              GO TO 304
            ENDIF
  303     CONTINUE
          GO TO 309
  304     CALL NGOFRO (FLNM,IFDE,ISTA)
          IF (ISTA.NE.0) GO TO 309
          NTMS=0
          MCHR=0
          NCHR=0
          DO 307 IDIV=0,9
            NROW=2**IDIV
            NCOL=2*NROW
            DO 306 J=1,NROW
              RLAT=-90.D0+(DBLE(J)-.5D0)*(180.D0/DBLE(NROW))
              DO 305 I=1,NCOL
                RLON=-180.D0+(DBLE(I)-.5D0)*(360.D0/DBLE(NCOL))
                IF (NTMS.EQ.0)
                  CALL MDRDNM (IFDE,CHRS,512,MCHR,NCHR,NTMS)
                  IF (MCHR.EQ.0) GO TO 308
                  CALL MDRDNM (IFDE,CHRS,512,MCHR,NCHR,IAID)
                  IF (MCHR.EQ.0) GO TO 308
                END IF
                CALL MDPTRA (RLAT,RLON,UVAL,VVAL)
                IF (UVAL.NE.1.D12)
                  XCR(1)=REAL(UMIN)
                  XCR(2)=REAL(UMAX)
                  YCR(1)=REAL(VMIN)
                  YCR(2)=REAL(VMAX)
                  CALL AREDAM (IAMP,XCR,YCR,2,IGRP,IAID,IAID)
                  GO TO 308
                END IF
                NTMS=NTMS-1
  305         CONTINUE
  306       CONTINUE
  307     CONTINUE
  308     CALL NGCLFI (IFDE)
C
        END IF
C
C Done.
C
  309   RETURN
C
C The following internal procedure is invoked to start a line.
C
        BLOCK (START-A-LINE)
          IF (NCRA.GT.1)
            CALL AREDAM (IAMP,XCRA,YCRA,NCRA,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPBLA',34).NE.0) RETURN
          END IF
          XCRA(1)=REAL(XCRD)
          YCRA(1)=REAL(YCRD)
          NCRA=1
        END BLOCK
C
C The following internal procedure is invoked to continue a line.
C
        BLOCK (CONTINUE-THE-LINE)
          IF (NCRA.EQ.100)
            CALL AREDAM (IAMP,XCRA,YCRA,NCRA,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPBLA',35).NE.0) RETURN
            XCRA(1)=XCRA(100)
            YCRA(1)=YCRA(100)
            NCRA=1
          END IF
          NCRA=NCRA+1
          XCRA(NCRA)=REAL(XCRD)
          YCRA(NCRA)=REAL(YCRD)
        END BLOCK
C
C The following internal procedure is invoked to terminate a line.
C
        BLOCK (TERMINATE-THE-LINE)
          IF (NCRA.GT.1)
            CALL AREDAM (IAMP,XCRA,YCRA,NCRA,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPBLA',36).NE.0) RETURN
            NCRA=0
          END IF
        END BLOCK
C
      END


      SUBROUTINE MDRDNM (IFDE,CHRS,LCHR,MCHR,NCHR,INUM)
C
        INTEGER     IFDE
        CHARACTER*1 CHRS(LCHR)
        INTEGER     LCHR,MCHR,NCHR,INUM
C
C Declare local variables.
C
        INTEGER     ISTA
C
C Given the file descriptor of an open file in IFDE and a character
C buffer CHRS, of length LCHR, having in it MCHR characters read from
C the file, of which NCHR have previously been processed, this routine
C finds the next integer in the file and returns that as the value of
C INUM.
C
C Skip blanks.
C
  101   NCHR=NCHR+1
C
        IF (NCHR.GT.MCHR)
          CALL NGRDCH (IFDE,CHRS,LCHR,ISTA)
          IF (ISTA.LE.0)
            MCHR=0
            RETURN
          ELSE
            MCHR=ISTA
            NCHR=1
          END IF
        END IF
C
        IF (CHRS(NCHR).EQ.' ') GO TO 101
C
C Translate the number, stopping on a blank.
C
        INUM=ICHAR(CHRS(NCHR))-ICHAR('0')
C
  102   NCHR=NCHR+1
C
        IF (NCHR.GT.MCHR)
          CALL NGRDCH (IFDE,CHRS,LCHR,ISTA)
          IF (ISTA.LE.0)
            MCHR=0
            RETURN
          ELSE
            MCHR=ISTA
            NCHR=1
          END IF
        END IF
C
        IF (CHRS(NCHR).EQ.' ') RETURN
C
        INUM=10*INUM+ICHAR(CHRS(NCHR))-ICHAR('0')
C
        GO TO 102
C
      END


      SUBROUTINE MAPLMM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        INTEGER IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
        IF (ICFELL('MAPLMM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
        CALL MDPLMM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MAPLMM',2).NE.0) RETURN
        RETURN
      END


      SUBROUTINE MDPLMM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        INTEGER IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
C
C SVOU is a character variable in which to save the value of the EZMAP
C internal parameter named 'OU'.
C
        CHARACTER*2      SVOU
C
C Check for an uncleared prior error.
C
        IF (ICFELL('MDPLMM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C Call the EZMAPA routine MDPBLM to generate limb lines (if any) and a
C perimeter and draw them masked by an area map.
C
        CALL MDGETC ('OU',SVOU)
        CALL MDSETC ('OU','NO')
        CALL MDPBLM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPLMM',2).NE.0) RETURN
        CALL MDSETC ('OU',SVOU)
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE MAPBLM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        INTEGER IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
        IF (ICFELL('MAPBLM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
        CALL MDPBLM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MAPBLM',2).NE.0) RETURN
        RETURN
      END


      SUBROUTINE MDPBLM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
C
        INTEGER IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
C
C Declare required common blocks.
C
        COMMON /MAPCM0/  COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        DOUBLE PRECISION COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        SAVE   /MAPCM0/
C
        COMMON /MAPCM1/  COSO,COSR,SINO,SINR,IPRJ,IROD
        DOUBLE PRECISION COSO,COSR,SINO,SINR
        INTEGER          IPRJ,IROD
        SAVE   /MAPCM1/
C
        COMMON /MAPCM2/  BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG,ISSL
        DOUBLE PRECISION BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG
        INTEGER          ISSL
        SAVE   /MAPCM2/
C
        COMMON /MAPCM3/  ITPN,NOUT,NPTS,IGID,IDLS,IDRS,BLAG,SLAG,BLOG,
     +                   SLOG,PNTS(200),IDOS(4)
        INTEGER          ITPN,NOUT,NPTS,IGID,IDLS,IDRS,IDOS
        REAL             BLAG,SLAG,BLOG,SLOG,PNTS
        SAVE   /MAPCM3/
C
        COMMON /MAPCM4/  GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW,IDOT,IDSH,IDTL,ILCW,
     +                   ILTS,JPRJ,ELPF,INTF,LBLF,PRMF
        DOUBLE PRECISION GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW
        INTEGER          IDOT,IDSH,IDTL,ILCW,ILTS,JPRJ
        LOGICAL          ELPF,INTF,LBLF,PRMF
        SAVE   /MAPCM4/
C
        COMMON /MAPCMC/  IGI1,IGI2,NCRA,NOVS,XCRA(100),YCRA(100)
        INTEGER          IGI1,IGI2,NCRA,NOVS
        REAL             XCRA,YCRA
        SAVE   /MAPCMC/
C
        COMMON /MAPCMW/  CSLS,CSLT,SLTD,ISLT
        DOUBLE PRECISION CSLS,CSLT,SLTD
        INTEGER ISLT
        SAVE   /MAPCMW/
C
        COMMON /MAPSAT/  ALFA,BETA,DCSA,DCSB,DSNA,DSNB,SALT,SSMO,SRSS
        DOUBLE PRECISION ALFA,BETA,DCSA,DCSB,DSNA,DSNB,SALT,SSMO,SRSS
        SAVE   /MAPSAT/
C
        COMMON /USGSC1/  UTPA(15),UUMN,UUMX,UVMN,UVMX,IPRF
        DOUBLE PRECISION UTPA,UUMN,UUMX,UVMN,UVMX
        INTEGER IPRF
        SAVE   /USGSC1/
C
C Declare local variables.
C
        INTEGER          I,IGIS,IPEN,IVIS,IWGF,J,K,NSEG
C
        DOUBLE PRECISION ALPH,CLAT,CLON,CRAD,COSA,COSB,COSL,COSP,DEPS,
     +                   DIST,DLAT,DLON,DR,DS,SINA,SINB,SINL,SINP,RLAT,
     +                   RLON,RVTU,SSLT,TEMP,U,UCIR,UEDG,UNS1,UOLD,URAD,
     +                   V,VCIR,VEDG,VNS1,VOLD,X,XANP,XAS1,XAS2,XCRD,
     +                   YANP,YAS1,YAS2,YCRD
C
C Declare a couple of temporary arrays to hold coordinates of a circle.
C
        DOUBLE PRECISION TLAT(361),TLON(361)
C
C Dimension the arrays needed to define some lines across the map.
C
        REAL             XCR(2),YCR(2)
C
C Declare arithmetic statement functions.
C
        DOUBLE PRECISION CEIL,FLOR
C
C Declare external functions.
C
        DOUBLE PRECISION RBGDFE,RBGLEN
C
C The arithmetic statement functions FLOR and CEIL give, respectively,
C the "floor" of X - the largest integer less than or equal to X - and
C the "ceiling" of X - the smallest integer greater than or equal to X.
C
        FLOR(X)=DINT(X+1.D4)-1.D4
        CEIL(X)=-FLOR(-X)
C
C Check for an uncleared prior error.
C
        IF (ICFELL('MDPBLM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C If EZMAP needs initialization, do it.
C
        IF (INTF)
          CALL MDPINT
          IF (ICFELL('MDPBLM',2).NE.0) RETURN
        END IF
C
C If the perimeter is to be drawn ...
C
        IF (PRMF)
C
C ... reset the color index and dash pattern for the perimeter ...
C
          CALL MDPCHM (1,IOR(ISHIFT(32767,1),1),
     +                                  IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',3).NE.0) RETURN
C
C .. and draw the perimeter.
C
          IF (ELPF)
            TEMP=.9998D0
            LOOP
              U=URNG
              V=0.D0
              XCRD=UCEN+TEMP*U
              YCRD=VCEN
              INVOKE (START-A-LINE)
              FOR (I = 1 TO 360)
                U=URNG*COS(DTOR*DBLE(I))
                V=URNG*SIN(DTOR*DBLE(I))
                XCRD=UCEN+TEMP*U
                YCRD=VCEN+TEMP*V*VRNG/URNG
                INVOKE (CONTINUE-THE-LINE)
              END FOR
            EXIT IF (TEMP.EQ.1.0002D0)
              TEMP=1.0002D0
            END LOOP
          ELSE
            XCRD=UMIN
            YCRD=VMIN
            INVOKE (START-A-LINE)
            XCRD=UMAX
            YCRD=VMIN
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMAX
            YCRD=VMAX
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMIN
            YCRD=VMAX
            INVOKE (CONTINUE-THE-LINE)
            XCRD=UMIN
            YCRD=VMIN
            INVOKE (CONTINUE-THE-LINE)
          END IF
          INVOKE (TERMINATE-THE-LINE)
C
C Restore the color index and dash pattern.
C
          CALL MDPCHM (-1,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',4).NE.0) RETURN
C
        END IF
C
C Reset the color index and dash pattern for limb lines.
C
        CALL MDPCHM (4,IOR(ISHIFT(32767,1),1),
     +                                  IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPBLM',5).NE.0) RETURN
C
C Draw the limb line.
C
C Projection:   US  LC  ST  OR  LE  GN  AE
C                   CE  ME  MT  RO  EA  AI  HA  MO  WT  (arbitrary)
C                   CE  ME  MT  RO  EA  AI  HA  MO  WT  (fast-path)
C                       RM
C
        GO TO (100,101,108,102,103,108,104,
     +             107,107,105,107,107,109,110,110,107,
     +             107,107,105,107,107,109,110,110,107,
     +                 107                            ) , IPRJ+1
C
C USGS transformations.
C
  100   IF (IPRF.EQ. 3.OR.IPRF.EQ. 4.OR.IPRF.EQ. 5.OR.IPRF.EQ. 7.OR.
     +      IPRF.EQ. 8.OR.IPRF.EQ.16.OR.IPRF.EQ.17.OR.IPRF.EQ.18.OR.
     +      IPRF.EQ.19.OR.IPRF.EQ.21)
          IF (IPRF.EQ.3.OR.IPRF.EQ.8.OR.IPRF.EQ.17.OR.IPRF.EQ.18.OR.
     +        IPRF.EQ.21)
            DLON=GRDR
            RLAT=-89.998D0
            K=CEIL(360.D0/DLON)
            DO (I=1,2)
              RLON=UTPA(5)-180.D0
              CALL MDPITM (RLAT,RLON,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
              IF (ICFELL('MDPBLM',6).NE.0) RETURN
              DO (J=1,K-1)
                RLON=RLON+DLON
                CALL MDPITM (RLAT,RLON,1,
     +                                  IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
                IF (ICFELL('MDPBLM',7).NE.0) RETURN
              END DO
              RLON=UTPA(5)+180.D0
              CALL MDPITM (RLAT,RLON,2,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
              IF (ICFELL('MDPBLM',8).NE.0) RETURN
              CALL MDPIQM (            IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
              IF (ICFELL('MDPBLM',9).NE.0) RETURN
              RLAT=89.998D0
            END DO
            INVOKE (TERMINATE-THE-LINE)
          END IF
          IF (IPRF.EQ.7)
            DLON= 89.999999D0
          ELSE
            DLON=179.999999D0
          END IF
          DLAT=GRDR
          RLON=UTPA(5)+DLON
          K=CEIL(180.D0/DLAT)
          DO (I=1,2)
            RLAT=-90.D0
            CALL MDPITM (RLAT,RLON,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',10).NE.0) RETURN
            DO (J=1,K-1)
              RLAT=RLAT+DLAT
              CALL MDPITM (RLAT,RLON,1,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
              IF (ICFELL('MDPBLM',11).NE.0) RETURN
            END DO
            RLAT=90.D0
            CALL MDPITM (RLAT,RLON,2,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',12).NE.0) RETURN
            CALL MDPIQM (            IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',13).NE.0) RETURN
            RLON=UTPA(5)-DLON
          END DO
          INVOKE (TERMINATE-THE-LINE)
          GO TO 108
        ELSE IF (IPRF.EQ.9)
          DLON=GRDR
          RLAT=-.001D0
          K=CEIL(180.D0/DLON)
          DO (I=1,2)
            RLON=UTPA(5)+90.D0
            CALL MDPITM (RLAT,RLON,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',14).NE.0) RETURN
            DO (J=1,K-1)
              RLON=RLON+DLON
              CALL MDPITM (RLAT,RLON,1,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
              IF (ICFELL('MDPBLM',15).NE.0) RETURN
            END DO
            RLON=UTPA(5)+270.D0
            CALL MDPITM (RLAT,RLON,2,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',16).NE.0) RETURN
            CALL MDPIQM (            IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',17).NE.0) RETURN
            RLAT=.001D0
          END DO
          INVOKE (TERMINATE-THE-LINE)
          GO TO 108
        ELSE IF (IPRF.EQ.11.OR.IPRF.EQ.12.OR.IPRF.EQ.14.OR.
     +                         IPRF.EQ.15.OR.IPRF.EQ.23)
          IF (IPRF.EQ.11.OR.IPRF.EQ.12)
            CLAT=UTPA(6)
            CLON=UTPA(5)
            CRAD=179.95D0
          ELSE IF (IPRF.EQ.14)
            CLAT=UTPA(6)
            CLON=UTPA(5)
            CRAD=89.999D0
          ELSE IF (IPRF.EQ.15)
            CLAT=UTPA(6)
            CLON=UTPA(5)
            CRAD=RTOD*ACOS(UTPA(1)/(UTPA(1)+UTPA(3)))-.001D0
          ELSE IF (IPRF.EQ.23)
            CLAT=  64.D0
            CLON=-152.D0
            CRAD=  29.999D0
          END IF
          CALL MDGCOG (CLAT,CLON,CRAD,TLAT,TLON,361)
          CALL MDPITM (TLAT(1),TLON(1),0,
     +                                  IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',18).NE.0) RETURN
          DO (I=2,360)
            CALL MDPITM (TLAT(I),TLON(I),1,
     +                                  IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',19).NE.0) RETURN
          END DO
          CALL MDPITM (TLAT(361),TLON(361),2,
     +                                  IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',20).NE.0) RETURN
          CALL MDPIQM (                 IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',21).NE.0) RETURN
          GO TO 108
        ELSE IF (IPRF.EQ.20)
          ALPH=DTOR*(180.D0-UTPA(4))
          CALL MDPTRN (+90.D0,0.D0,XANP,YANP)
          IF (ICFELL('MDPBLM',22).NE.0) RETURN
          CALL MDPTRN (-90.D0,0.D0,XAS1,YAS1)
          IF (ICFELL('MDPBLM',23).NE.0) RETURN
          UNS1=(XAS1-XANP)*COS(ALPH)+(YAS1-YANP)*SIN(ALPH)
          VNS1=(YAS1-YANP)*COS(ALPH)-(XAS1-XANP)*SIN(ALPH)
          XAS2=XANP+VNS1*SIN(ALPH)+UNS1*COS(ALPH)
          YAS2=YANP+UNS1*SIN(ALPH)-VNS1*COS(ALPH)
          DIST=SQRT((XAS2-XAS1)*(XAS2-XAS1)+(YAS2-YAS1)*(YAS2-YAS1))
          IF (VNS1.LT.0.D0)
            DEPS=-.001D0*DIST
          ELSE
            DEPS=+.001D0*DIST
          END IF
          DIST=2.D0*DIST
          XCR(1)=REAL(XAS1-DIST*COS(ALPH)+DEPS*SIN(ALPH))
          YCR(1)=REAL(YAS1-DIST*SIN(ALPH)-DEPS*COS(ALPH))
          XCR(2)=REAL(XAS1+DIST*COS(ALPH)+DEPS*SIN(ALPH))
          YCR(2)=REAL(YAS1+DIST*SIN(ALPH)-DEPS*COS(ALPH))
          CALL ARDRLN (IAM,XCR,YCR,2,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',24).NE.0) RETURN
          XCR(1)=REAL(XAS2-DIST*COS(ALPH)-DEPS*SIN(ALPH))
          YCR(1)=REAL(YAS2-DIST*SIN(ALPH)+DEPS*COS(ALPH))
          XCR(2)=REAL(XAS2+DIST*COS(ALPH)-DEPS*SIN(ALPH))
          YCR(2)=REAL(YAS2+DIST*SIN(ALPH)+DEPS*COS(ALPH))
          CALL ARDRLN (IAM,XCR,YCR,2,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',25).NE.0) RETURN
          GO TO 108
        ELSE
          GO TO 108
        END IF
C
C Lambert conformal conic.
C
  101   DLAT=GRDR
        RLON=PLNO+179.999999D0
        K=CEIL(180.D0/DLAT)
        DO (I=1,2)
          RLAT=-90.D0
          CALL MDPITM (RLAT,RLON,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',26).NE.0) RETURN
          DO (J=1,K-1)
            RLAT=RLAT+DLAT
            CALL MDPITM (RLAT,RLON,1,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',27).NE.0) RETURN
          END DO
          RLAT=RLAT+DLAT
          CALL MDPITM (RLAT,RLON,2,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',28).NE.0) RETURN
          RLON=PLNO-179.999999D0
        END DO
        INVOKE (TERMINATE-THE-LINE)
        GO TO 108
C
C Orthographic (or satellite-view).
C
  102   IF (ABS(SALT).LE.1.D0.OR.ALFA.EQ.0.D0)
          URAD=1.D0
          RVTU=1.D0
          GO TO 106
        ELSE
          SSLT=SALT
          SALT=-ABS(SALT)
          DR=.9998D0
          LOOP
            IPEN=0
            DO (I=1,361)
              COSB=COS(DTOR*DBLE(I-1))
              SINB=SIN(DTOR*DBLE(I-1))
              IF (DR.LT.1.D0)
                COSA=(DR*DR*ABS(SALT)+SSMO*SQRT(1.D0-DR*DR))/
     +                                           (DR*DR+SSMO)
              ELSE
                DS=2.D0-DR
                COSA=(DS*DS*ABS(SALT)-SSMO*SQRT(1.D0-DS*DS))/
     +                                           (DS*DS+SSMO)
              END IF
              SINA=SQRT(1.D0-COSA*COSA)
              SINL=SINA*SINB
              COSL=COSA*COSO-SINA*SINO*COSB
              COSP=SQRT(SINL*SINL+COSL*COSL)
              IF (COSP.NE.0.D0)
                SINL=SINL/COSP
                COSL=COSL/COSP
              END IF
              IF (ABS(SINO).GT..000001D0)
                SINP=(COSA-COSP*COSL*COSO)/SINO
              ELSE
                SINP=SINA*COSB
              END IF
              RLAT=RTOD*ATAN2(SINP,COSP)
              RLON=PLNO+RTOD*ATAN2(SINA*SINB,
     +                             COSA*COSO-SINA*SINO*COSB)
              IF (ABS(RLON).GT.180.D0) RLON=RLON-SIGN(360.D0,RLON)
              CALL MDPITM (RLAT,RLON,IPEN,
     +                     IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
              IF (ICFELL('MDPBLM',29).NE.0) RETURN
              IPEN=1
              IF (I.EQ.360) IPEN=2
            END DO
            INVOKE (TERMINATE-THE-LINE)
          EXIT IF (DR.EQ.1.0002D0)
            DR=1.0002D0
          END LOOP
        END IF
        SALT=SSLT
        GO TO 108
C
C Lambert equal-area.  Note:  The constant "1.999999500000" is the real
C effective radius of the limb of the Lambert equal area projection, as
C determined by the test at statement number 106 in the routine MDPTRN.
C
  103   URAD=1.999999500000D0
        RVTU=1.D0
        GO TO 106
C
C Azimuthal equidistant.  Note:  The constant "3.140178439909" is the
C real effective radius of the limb of the azimuthal equidistant
C projection, as determined by the test at statement number 108 in the
C routine MDPTRN.
C
  104   URAD=3.140178439909D0
        RVTU=1.D0
        GO TO 106
C
C Mollweide type.
C
  105   URAD=2.D0
        RVTU=0.5D0
        GO TO 106
C
C Aitoff.
C
  109   URAD=3.14159265358979D0
        RVTU=.5D0
        GO TO 106
C
C Hammer and true Mollweide.
C
  110   URAD=2.82842712474619D0
        RVTU=.5D0
        GO TO 106
C
  106   IF (ELPF.AND.ABS(UCEN).LT..0001D0.AND.
     +               ABS(VCEN).LT..0001D0.AND.
     +               ABS(URNG-URAD).LT..0001D0.AND.
     +               ABS(VRNG/URNG-RVTU).LT..0001D0) GO TO 108
C
        TEMP=.9998D0
C
        LOOP
          IVIS=-1
          FOR (I = 1 TO 361)
            UCIR=TEMP*URAD*COS(DTOR*DBLE(I-1))
            VCIR=TEMP*URAD*SIN(DTOR*DBLE(I-1))
            U=UCIR-UOFF
            V=RVTU*VCIR-VOFF
            IF (.NOT.ELPF.AND.
     +          (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX))
              IF (IVIS.EQ.1)
                CALL MDPTRP (UOLD,VOLD,U,V,UEDG,VEDG)
                XCRD=UEDG
                YCRD=VEDG
                INVOKE (CONTINUE-THE-LINE)
              END IF
              IVIS=0
            ELSE IF (ELPF.AND.
     +               (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.D0))
              IF (IVIS.EQ.1)
                CALL MDPTRE (UOLD,VOLD,U,V,UEDG,VEDG)
                XCRD=UEDG
                YCRD=VEDG
                INVOKE (CONTINUE-THE-LINE)
              END IF
              IVIS=0
            ELSE
              IF (IVIS.LT.0)
                XCRD=U
                YCRD=V
                INVOKE (START-A-LINE)
                IVIS=1
              ELSE
                IF (IVIS.EQ.0)
                  IF (.NOT.ELPF) CALL MDPTRP (U,V,UOLD,VOLD,UOLD,VOLD)
                  IF (     ELPF) CALL MDPTRE (U,V,UOLD,VOLD,UOLD,VOLD)
                  XCRD=UOLD
                  YCRD=VOLD
                  INVOKE (START-A-LINE)
                  IVIS=1
                END IF
                XCRD=U
                YCRD=V
                INVOKE (CONTINUE-THE-LINE)
              END IF
            END IF
            UOLD=U
            VOLD=V
          END FOR
          INVOKE (TERMINATE-THE-LINE)
        EXIT IF (TEMP.EQ.1.0002D0)
          TEMP=1.0002D0
        END LOOP
        GO TO 108
C
C Cylindrical equidistant, Mercator, Robinson, cylindrical equal-area,
C Winkel tripel.
C
  107   TEMP=.9998D0
C
        LOOP
          IVIS=-1
          RLAT=-90.D0
          RLON=-180.D0
          FOR (I = 1 TO 361)
            IF (IPRJ.EQ.7.OR.IPRJ.EQ.16)
              U=TEMP*RLON-UOFF
              V=TEMP*RLAT/CSLT-VOFF
            ELSE IF (IPRJ.EQ.8.OR.IPRJ.EQ.17.OR.IPRJ.EQ.25)
              U=TEMP*DTOR*RLON-UOFF
              V=TEMP*LOG(TAN((MAX(-89.999999D0,
     +                        MIN(+89.999999D0,RLAT))+90.D0)*DTRH))-VOFF
              IF (IPRJ.EQ.25)
                UTMP=U*COSR+V*SINR
                VTMP=V*COSR-U*SINR
                U=UTMP
                V=VTMP
              END IF
            ELSE IF (IPRJ.EQ.11.OR.IPRJ.EQ.20)
              U=TEMP*DTOR*RLON-UOFF
              V=TEMP*SIN(DTOR*RLAT)/CSLS-VOFF
            ELSE IF (IPRJ.EQ.15.OR.IPRJ.EQ.24)
              CALL WTPROJ (TEMP*DTOR*RLAT,TEMP*DTOR*RLON,U,V,CSLT)
              U=U-UOFF
              V=V-VOFF
            ELSE
              U=TEMP*(RLON/180.D0)*RBGLEN(RLAT)-UOFF
              V=TEMP*RBGDFE(RLAT)-VOFF
            END IF
            IF (I.LE.90)
              RLON=RLON+4.D0
            ELSE IF (I.LE.180)
              RLAT=RLAT+2.D0
            ELSE IF (I.LE.270)
              RLON=RLON-4.D0
            ELSE IF (I.LE.360)
              RLAT=RLAT-2.D0
            END IF
            IF (.NOT.ELPF.AND.
     +          (U.LT.UMIN.OR.U.GT.UMAX.OR.V.LT.VMIN.OR.V.GT.VMAX))
              IF (IVIS.EQ.1)
                CALL MDPTRP (UOLD,VOLD,U,V,UEDG,VEDG)
                XCRD=UEDG
                YCRD=VEDG
                INVOKE (CONTINUE-THE-LINE)
              END IF
              IVIS=0
            ELSE IF (ELPF.AND.
     +               (((U-UCEN)/URNG)**2+((V-VCEN)/VRNG)**2.GT.1.D0))
              IF (IVIS.EQ.1)
                CALL MDPTRE (UOLD,VOLD,U,V,UEDG,VEDG)
                XCRD=UEDG
                YCRD=VEDG
                INVOKE (CONTINUE-THE-LINE)
              END IF
              IVIS=0
            ELSE
              IF (IVIS.LT.0)
                XCRD=U
                YCRD=V
                INVOKE (START-A-LINE)
                IVIS=1
              ELSE
                IF (IVIS.EQ.0)
                  IF (.NOT.ELPF) CALL MDPTRP (U,V,UOLD,VOLD,UOLD,VOLD)
                  IF (     ELPF) CALL MDPTRE (U,V,UOLD,VOLD,UOLD,VOLD)
                  XCRD=UOLD
                  YCRD=VOLD
                  INVOKE (START-A-LINE)
                  IVIS=1
                END IF
                XCRD=U
                YCRD=V
                INVOKE (CONTINUE-THE-LINE)
              END IF
            END IF
            UOLD=U
            VOLD=V
          END FOR
          INVOKE (TERMINATE-THE-LINE)
        EXIT IF (TEMP.EQ.1.0002D0)
          TEMP=1.0002D0
        END LOOP
C
C Restore the color index and dash pattern.
C
  108   CALL MDPCHM (-4,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPBLM',30).NE.0) RETURN
C
C If the selected outline type is "NONE", quit; no outlines need to
C be drawn.
C
        IF (NOUT.LE.0) RETURN
C
C Set the flag IWGF to say whether or not the whole globe is shown by
C the current projection.  If so (IWGF=1), there's no need to waste the
C time required to check each outline point group for intersection with
C the window.
C
        IWGF=0
        IF (BLAM-SLAM.GT.179.D0.AND.BLOM-SLOM.GT.359.D0) IWGF=1
C
C IGIS keeps track of changes in the group identifier, so that the
C color index can be changed when necessary.
C
        IGIS=0
C
C Position to the user-selected portion of the outline dataset.
C
        CALL MDPIO (1)
        IF (ICFELL('MDPBLM',31).NE.0) RETURN
        NSEG=0
C
C Read the next record (group of points).
C
  301   CALL MDPIO (2)
        IF (ICFELL('MDPBLM',32).NE.0) RETURN
        NSEG=NSEG+1
C
C Check for the end of the desired data.
C
        IF (NPTS.EQ.0) GO TO 303
C
C If less than the whole globe is shown by the projection, do a quick
C check for intersection of the box surrounding the point group with
C the area shown.
C
        IF (IWGF.EQ.0)
          IF (DBLE(SLAG).GT.BLAM.OR.DBLE(BLAG).LT.SLAM) GO TO 301
          IF ((DBLE(SLOG     ).GT.BLOM.OR.
     +         DBLE(BLOG     ).LT.SLOM).AND.
     +        (DBLE(SLOG-360.).GT.BLOM.OR.
     +         DBLE(BLOG-360.).LT.SLOM).AND.
     +        (DBLE(SLOG+360.).GT.BLOM.OR.
     +         DBLE(BLOG+360.).LT.SLOM)) GO TO 301
        END IF
C
C See if the user wants to omit this point group.
C
        CALL HLUMAPEOD (NOUT,NSEG,IDOS(NOUT)+IDLS,
     +                            IDOS(NOUT)+IDRS,NPTS,PNTS)
        IF (ICFELL('MDPBLM',33).NE.0) RETURN
        IF (NPTS.LE.1) GO TO 301
C
C If we've switched to a new group, set the color index, dotting, and
C dash pattern for the group.
C
        IF (IGID.NE.IGIS)
          IF (IGIS.NE.0)
            CALL MDPCHM (-4-IGIS,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',34).NE.0) RETURN
          END IF
          CALL MDPCHM (4+IGID,IOR(ISHIFT(32767,1),1),
     +                                  IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',35).NE.0) RETURN
          IGIS=IGID
        END IF
C
C Plot the group.
C
        CALL MAPITM (PNTS(1),PNTS(2),0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPBLM',36).NE.0) RETURN
C
        DO (K=2,NPTS-1)
          CALL MAPITM (PNTS(2*K-1),PNTS(2*K),1,
     +                 IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',37).NE.0) RETURN
        END DO
C
        CALL MAPITM (PNTS(2*NPTS-1),PNTS(2*NPTS),2,
     +               IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPBLM',38).NE.0) RETURN
C
C Force a buffer dump.
C
        INVOKE (TERMINATE-THE-LINE)
C
C Go get another group.
C
        GO TO 301
C
C Reset the color index, dotting, and dash pattern, if necessary.
C
  303   IF (IGIS.NE.0)
          CALL MDPCHM (-4-IGIS,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPBLM',39).NE.0) RETURN
        END IF
C
C Done.
C
        RETURN
C
C The following internal procedure is invoked to start a line.
C
        BLOCK (START-A-LINE)
          IF (NCRA.GT.1)
            CALL ARDRLN (IAM,XCRA,YCRA,NCRA,
     +                   XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',40).NE.0) RETURN
          END IF
          XCRA(1)=REAL(XCRD)
          YCRA(1)=REAL(YCRD)
          NCRA=1
        END BLOCK
C
C The following internal procedure is invoked to continue a line.
C
        BLOCK (CONTINUE-THE-LINE)
          IF (NCRA.EQ.100)
            CALL ARDRLN (IAM,XCRA,YCRA,NCRA,
     +                   XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',41).NE.0) RETURN
            XCRA(1)=XCRA(100)
            YCRA(1)=YCRA(100)
            NCRA=1
          END IF
          NCRA=NCRA+1
          XCRA(NCRA)=REAL(XCRD)
          YCRA(NCRA)=REAL(YCRD)
        END BLOCK
C
C The following internal procedure is invoked to terminate a line.
C
        BLOCK (TERMINATE-THE-LINE)
          IF (NCRA.GT.1)
            CALL ARDRLN (IAM,XCRA,YCRA,NCRA,
     +                   XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPBLM',42).NE.0) RETURN
            NCRA=0
          END IF
        END BLOCK
C
      END


      SUBROUTINE MAPGRM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        INTEGER IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
        IF (ICFELL('MAPGRM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
        CALL MDPGRM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MAPGRM',2).NE.0) RETURN
        RETURN
      END


      SUBROUTINE MDPGRM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
C
        INTEGER IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
C
C Declare required common blocks.  See MAPBDX for descriptions of these
C common blocks and the variables in them.
C
        COMMON /MAPCM0/  COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        DOUBLE PRECISION COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        SAVE   /MAPCM0/
C
        COMMON /MAPCM1/  COSO,COSR,SINO,SINR,IPRJ,IROD
        DOUBLE PRECISION COSO,COSR,SINO,SINR
        INTEGER          IPRJ,IROD
        SAVE   /MAPCM1/
C
        COMMON /MAPCM2/  BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG,ISSL
        DOUBLE PRECISION BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG
        INTEGER          ISSL
        SAVE   /MAPCM2/
C
        COMMON /MAPCM4/  GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW,IDOT,IDSH,IDTL,ILCW,
     +                   ILTS,JPRJ,ELPF,INTF,LBLF,PRMF
        DOUBLE PRECISION GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW
        INTEGER          IDOT,IDSH,IDTL,ILCW,ILTS,JPRJ
        LOGICAL          ELPF,INTF,LBLF,PRMF
        SAVE   /MAPCM4/
C
C Declare local variables.
C
        DOUBLE PRECISION BLAT,BLON,DLAT,DLON,GLAT,GLON,OLAT,RLAT,RLON,
     +                   SLAT,SLON,U,V,X,XLAT,XLON
C
C Declare the type of two local arithmetic statement functions and the
C argument used with them.
C
        DOUBLE PRECISION CEIL,FLOR
C
C The arithmetic statement functions FLOR and CEIL give, respectively,
C the "floor" of X - the largest integer less than or equal to X - and
C the "ceiling" of X - the smallest integer greater than or equal to X.
C
        FLOR(X)=DINT(X+1.D4)-1.D4
        CEIL(X)=-FLOR(-X)
C
C Check for an uncleared prior error.
C
        IF (ICFELL('MDPGRM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C If EZMAP needs initialization, do it.
C
        IF (INTF)
          CALL MDPINT
          IF (ICFELL('MDPGRM',2).NE.0) RETURN
        END IF
C
C If the grid is suppressed, do nothing.
C
        IF (GRID.LE.0.D0) RETURN
C
C Otherwise, set the latitude and longitude grid spacings.
C
        GLAT=GRID
        GLON=GRID
        IF (GRLA.GT.0.D0) GLAT=GRLA
        IF (GRLO.GT.0.D0) GLON=GRLO
C
C Reset the color index, dotting, and dash pattern for the grid.
C
        CALL MDPCHM (2,IDSH,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPGRM',3).NE.0) RETURN
C
C Transfer the latitude/longitude limits computed by MDPINT to local,
C modifiable variables.
C
        BLAT=BLAM
        BLON=BLOM
        SLAT=SLAM
        SLON=SLOM
C
C For certain azimuthal projections centered at a pole, the latitude
C limit furthest from the pole needs adjustment to make it projectable
C and visible.  Otherwise, we have trouble with portions of meridians
C disappearing.
C
        IF (IPRJ.EQ.3.OR.IPRJ.EQ.4.OR.IPRJ.EQ.6)
          IF (PLTO.GT.+89.999999D0)
            SLAT=SLAT+SRCH
            IF (IPRJ.EQ.3) SLAT=SLAT+SRCH
          END IF
          IF (PLTO.LT.-89.999999D0)
            BLAT=BLAT-SRCH
            IF (IPRJ.EQ.3) BLAT=BLAT-SRCH
          END IF
        END IF
C
C RLON is the smallest longitude for which a meridian is to be drawn,
C XLON the biggest.  Avoid drawing a given meridian twice.
C
        RLON=GLON*FLOR(SLON/GLON)
        XLON=GLON*CEIL(BLON/GLON)
C
        IF (XLON-RLON.GT.359.999999D0)
          IF (IPRJ.EQ.1)
            RLON=GLON*CEIL((PLNO-179.999999D0)/GLON)
            XLON=GLON*FLOR((PLNO+179.999999D0)/GLON)
          ELSE IF (IPRJ.GE.2.AND.IPRJ.LE.15)
            XLON=XLON-GLON
            IF (XLON-RLON.GT.359.999999D0) XLON=XLON-GLON
          END IF
        END IF
C
C OLAT is the latitude at which meridians that do not extend all the
C way to the poles are to stop.
C
        IF (IPRJ.EQ.16.OR.IPRJ.EQ.17.OR.IPRJ.EQ.19.OR.IPRJ.EQ.20.OR.
     +                                  IPRJ.EQ.24.OR.IPRJ.EQ.25)
          OLAT=90.D0
        ELSE
          IF (DINT(GRPO/1000.D0).EQ.0D0)
            OLAT=GLAT*FLOR(89.999999D0/GLAT)
          ELSE
            OLAT=GLAT*FLOR(MIN(89.999999D0,DINT(GRPO/1000.D0))/GLAT)
          END IF
        END IF
C
C Draw the meridians.
C
        RLON=RLON-GLON
  101   RLON=RLON+GLON
        XLAT=OLAT
        IF (MOD(GRPO,1000.D0).GT.0.D0)
          IF (MOD(RLON,MOD(GRPO,1000.D0)).EQ.0.D0) XLAT=90.D0
        END IF
        RLAT=MAX(SLAT,-XLAT)
        XLAT=MIN(BLAT, XLAT)
        DLAT=(XLAT-RLAT)/CEIL((XLAT-RLAT)/GRDR)
        CALL MDPITM (RLAT,RLON,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPGRM',4).NE.0) RETURN
  102   RLAT=RLAT+DLAT
        CALL MDPITM (RLAT,RLON,1,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPGRM',5).NE.0) RETURN
        IF (RLAT.LT.XLAT-.5D0*DLAT) GO TO 102
        CALL MDPIQM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPGRM',6).NE.0) RETURN
        IF (RLON.LT.XLON-.5D0*GLON) GO TO 101
C
C Round the latitude limits to appropriate multiples of GLAT.
C
        SLAT=GLAT*FLOR(SLAT/GLAT)
        IF (SLAT.LE.-90.D0) SLAT=SLAT+GLAT
        BLAT=GLAT*CEIL(BLAT/GLAT)
        IF (BLAT.GE.+90.D0) BLAT=BLAT-GLAT
C
C If a fast-path cylindrical equidistant or cylindrical equal-area
C projection is in use and either or both of the poles is within the
C (rectangular) perimeter, arrange for the parallels at -90 and/or +90
C to be drawn.
C
        IF (IPRJ.EQ.16.OR.IPRJ.EQ.20)
          CALL MDPTRN (-90.D0,PLNO,U,V)
          IF (ICFELL('MDPGRM',7).NE.0) RETURN
          IF (U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN.AND.V.LE.VMAX)
     +                                                    SLAT=SLAT-GLAT
          CALL MDPTRN (+90.D0,PLNO,U,V)
          IF (ICFELL('MDPGRM',8).NE.0) RETURN
          IF (U.GE.UMIN.AND.U.LE.UMAX.AND.V.GE.VMIN.AND.V.LE.VMAX)
     +                                                    BLAT=BLAT+GLAT
        END IF
C
C Draw the parallels.
C
        XLAT=SLAT-GLAT
  103   XLAT=XLAT+GLAT
        RLAT=MAX(-90.D0,MIN(+90.D0,XLAT))
        IF (DINT(GRPO/1000.D0).EQ.0.D0.OR.
     +      ABS(RLAT).LE.DINT(GRPO/1000.D0))
          RLON=FLOR(SLON)
          XLON=MIN(CEIL(BLON),RLON+360.D0)
          DLON=(XLON-RLON)/CEIL((XLON-RLON)/GRDR)
          CALL MDPITM (RLAT,RLON,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPGRM',9).NE.0) RETURN
  104     RLON=RLON+DLON
          CALL MDPITM (RLAT,RLON,1,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPGRM',10).NE.0) RETURN
          IF (RLON.LT.XLON-.5D0*DLON) GO TO 104
          CALL MDPIQM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPGRM',11).NE.0) RETURN
        END IF
        IF (XLAT.LT.BLAT-.5D0*GLAT) GO TO 103
C
C Restore the color index, and dash pattern.
C
        CALL MDPCHM (-2,0,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPGRM',12).NE.0) RETURN
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE MAPIQA (IAMP,IGRP,IDLT,IDRT)
        INTEGER IAMP(*),IGRP,IDLT,IDRT
        IF (ICFELL('MAPIQA - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
        CALL MDPIQA (IAMP,IGRP,IDLT,IDRT)
        IF (ICFELL('MAPIQA',2).NE.0) RETURN
        RETURN
      END


      SUBROUTINE MDPIQA (IAMP,IGRP,IDLT,IDRT)
C
        INTEGER IAMP(*),IGRP,IDLT,IDRT
C
C Declare required common blocks.  See MAPBDX for descriptions of these
C common blocks and the variables in them.
C
        COMMON /MAPCMC/  IGI1,IGI2,NCRA,NOVS,XCRA(100),YCRA(100)
        INTEGER          IGI1,IGI2,NCRA,NOVS
        REAL             XCRA,YCRA
        SAVE   /MAPCMC/
C
C Check for an uncleared prior error.
C
        IF (ICFELL('MDPIQA - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C Terminate the line, if any.
C
        IF (NCRA.GT.1)
          CALL AREDAM (IAMP,XCRA,YCRA,NCRA,IGRP,IDLT,IDRT)
          IF (ICFELL('MDPIQA',2).NE.0) RETURN
          NCRA=0
        END IF
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE MAPIQM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        INTEGER IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
        IF (ICFELL('MAPIQM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
        CALL MDPIQM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MAPIQM',2).NE.0) RETURN
        RETURN
      END


      SUBROUTINE MDPIQM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
C
        INTEGER IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
C
C Declare required common blocks.  See MAPBDX for descriptions of these
C common blocks and the variables in them.
C
        COMMON /MAPCMC/  IGI1,IGI2,NCRA,NOVS,XCRA(100),YCRA(100)
        INTEGER          IGI1,IGI2,NCRA,NOVS
        REAL             XCRA,YCRA
        SAVE   /MAPCMC/
C
C Check for an uncleared prior error.
C
        IF (ICFELL('MDPIQM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C Terminate the line, if any.
C
        IF (NCRA.GT.1)
          CALL ARDRLN (IAM,XCRA,YCRA,NCRA,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
          IF (ICFELL('MDPIQM',2).NE.0) RETURN
          NCRA=0
        END IF
C
C Done.
C
        RETURN
C
      END


      SUBROUTINE MAPITA (XLAT,XLON,IFST,IAMP,IGRP,IDLT,IDRT)
        REAL    XLAT,XLON
        INTEGER IFST,IAMP(*),IGRP,IDLT,IDRT
        IF (ICFELL('MAPITA - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
        CALL MDPITA (DBLE(XLAT),DBLE(XLON),IFST,IAMP,IGRP,IDLT,IDRT)
        IF (ICFELL('MAPITA',2).NE.0) RETURN
        RETURN
      END


      SUBROUTINE MDPITA (XLAT,XLON,IFST,IAMP,IGRP,IDLT,IDRT)
C
        DOUBLE PRECISION XLAT,XLON
        INTEGER          IFST,IAMP(*),IGRP,IDLT,IDRT
C
C Declare required common blocks.  See MAPBDX for descriptions of these
C common blocks and the variables in them.
C
        COMMON /MAPCM0/  COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        DOUBLE PRECISION COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        SAVE   /MAPCM0/
C
        COMMON /MAPCM1/  COSO,COSR,SINO,SINR,IPRJ,IROD
        DOUBLE PRECISION COSO,COSR,SINO,SINR
        INTEGER          IPRJ,IROD
        SAVE   /MAPCM1/
C
        COMMON /MAPCM2/  BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG,ISSL
        DOUBLE PRECISION BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG
        INTEGER          ISSL
        SAVE   /MAPCM2/
C
        COMMON /MAPCM4/  GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW,IDOT,IDSH,IDTL,ILCW,
     +                   ILTS,JPRJ,ELPF,INTF,LBLF,PRMF
        DOUBLE PRECISION GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW
        INTEGER          IDOT,IDSH,IDTL,ILCW,ILTS,JPRJ
        LOGICAL          ELPF,INTF,LBLF,PRMF
        SAVE   /MAPCM4/
C
        COMMON /MAPCM8/  P,Q,R
        DOUBLE PRECISION P,Q,R
        SAVE   /MAPCM8/
C
        COMMON /MAPCMA/  DATL,DBTD,DDTS,DPLT,DPSQ,DSCA,DSSQ
        DOUBLE PRECISION DATL,DBTD,DDTS,DPLT,DPSQ,DSCA,DSSQ
        SAVE   /MAPCMA/
C
        COMMON /MAPCMC/  IGI1,IGI2,NCRA,NOVS,XCRA(100),YCRA(100)
        INTEGER          IGI1,IGI2,NCRA,NOVS
        REAL             XCRA,YCRA
        SAVE   /MAPCMC/
C
        COMMON /USGSC1/  UTPA(15),UUMN,UUMX,UVMN,UVMX,IPRF
        DOUBLE PRECISION UTPA,UUMN,UUMX,UVMN,UVMX
        INTEGER IPRF
        SAVE   /USGSC1/
C
C Declare local variables.
C
        DOUBLE PRECISION APTX,CPLN,CPLT,CXLN,CXLT,DTST,PAPE,PNEW,POLD,
     +                   RLAT,RLATI(100),RLNE,RLNO,RLON,RLONI(100),RLTE,
     +                   RLTO,RMLO,RMUL,SPLN,SPLT,SXLN,SXLT,UCOE,UNEW,
     +                   UOLD,VCOE,VNEW,VOLD,XCRD,XLNO,XLTO,YCRD
C
        INTEGER          IOPI,IVIS,IVSO,NOPI
C
        SAVE             IVSO,POLD,RLNO,RLTO,RMLO,UOLD,VOLD,XLNO,XLTO
C
        DATA IVSO,POLD,RLNO,RLTO,RMLO,UOLD,VOLD,XLNO,XLTO / 0,8*0.D0 /
C
C Check for an uncleared prior error.
C
        IF (ICFELL('MDPITA - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C If EZMAP needs initialization, do it.
C
        IF (INTF)
          CALL MDPINT
          IF (ICFELL('MDPITA',2).NE.0) RETURN
        END IF
C
C Initialize the variables that control interpolation.
C
        IOPI=0
        NOPI=0
C
C If the projection is one of those in which great distortion occurs at
C points opposite the pole, see if some points need to be interpolated.
C
C Note that I originally did this for four different projections, but it
C really needs to be done only for the Lambert Equal-Area and Azimuthal
C Equidistant projections, as these are the only two that are sometimes
C used to show the entire globe.  When I added the USGS projections, I
C did not bother to provide interpolation for the other two projections
C (the Gnomonic and the Stereographic), but I also did not remove the
C interpolation that was being done for the forms of these projections
C that we already had (03/11/99).
C
        IF ((IPRJ.EQ.0.AND.(IPRF.EQ. 3.OR.IPRF.EQ. 8.OR.
     +                      IPRF.EQ.11.OR.IPRF.EQ.12)).OR.
     +      IPRJ.EQ.2.OR.IPRJ.EQ.4.OR.IPRJ.EQ.5.OR.IPRJ.EQ.6)
          IF (IPRJ.EQ.0)
            IF (IPRF.EQ.3.OR.IPRF.EQ.8)
              CPLT=0.D0
              SPLT=1.D0
              CPLN=1.D0
              SPLN=0.D0
              IF (IPRF.EQ.8.AND.UTPA(9).EQ.0.D0)
                DTST=UTPA(3)
              ELSE
                DTST=.5D0*UTPA(3)+UTPA(4)
              END IF
              IF (DTST.GT.0.D0)
                DTST=90.D0-DTST
              ELSE
                SPLT=-SPLT
                DTST=DTST+90.D0
              END IF
            ELSE
              CPLT=COS(DTOR*UTPA(6))
              SPLT=SIN(DTOR*UTPA(6))
              CPLN=COS(DTOR*UTPA(5))
              SPLN=SIN(DTOR*UTPA(5))
            END IF
          ELSE
            CPLT=COS(DTOR*PLTO)
            SPLT=SIN(DTOR*PLTO)
            CPLN=COS(DTOR*PLNO)
            SPLN=SIN(DTOR*PLNO)
          END IF
          CXLT=COS(DTOR*XLAT)
          SXLT=SIN(DTOR*XLAT)
          CXLN=COS(DTOR*XLON)
          SXLN=SIN(DTOR*XLON)
          APTX=2.D0*RTOD*ASIN(SQRT((CXLT*CXLN-CPLT*CPLN)**2+
     +                             (CXLT*SXLN-CPLT*SPLN)**2+
     +                             (SXLT     -SPLT     )**2)/2.D0)
          IF (IPRJ.EQ.0.AND.(IPRF.EQ.3.OR.IPRF.EQ.8))
            IF (APTX.LE.DTST)
              RMUL=MAX(1.D0,MIN(51.D0,51.D0*((DTST-APTX)/DTST)**8))
            ELSE
              RMUL=MAX(1.D0,MIN(51.D0,51.D0*((APTX-DTST)/
     +                                          (180.D0-DTST))**8))
            END IF
          ELSE IF (IPRJ.EQ.2)
            IF (APTX.LE.179.999D0)
              RMUL=MIN(101.D0,1.D0/(1.D0+COS(DTOR*APTX)))
            ELSE
              RMUL=101.D0
            END IF
          ELSE IF ((IPRJ.EQ.0.AND.IPRF.EQ.11).OR.IPRJ.EQ.4)
            IF (APTX.LE.179.999D0)
              RMUL=MIN(101.D0,2.D0/SQRT(2.D0*(1.D0+COS(DTOR*APTX))))
            ELSE
              RMUL=101.D0
            END IF
          ELSE IF (IPRJ.EQ.5)
            IF (APTX.LT.89.999D0)
              RMUL=MIN(21.D0,1.D0/COS(DTOR*APTX))
            ELSE
              RMUL=21.D0
            END IF
          ELSE IF ((IPRJ.EQ.0.AND.IPRF.EQ.12).OR.IPRJ.EQ.6)
            IF (APTX.LE..00001D0)
              RMUL=1.D0
            ELSE IF (APTX.LT.179.999D0)
              RMUL=MIN(101.D0,DTOR*APTX/SIN(DTOR*APTX))
            ELSE
              RMUL=101.D0
            END IF
          END IF
          IF (IFST.NE.0)
            NOPI=MAX(0,MIN(50,INT(MAX(RMLO,RMUL))/2))
            IF (NOPI.NE.0)
     +                CALL MDPGCI (XLTO,XLNO,XLAT,XLON,NOPI,RLATI,RLONI)
          END IF
          XLTO=XLAT
          XLNO=XLON
          RMLO=RMUL
        END IF
C
C If there is not enough room in the area map for all the saved points,
C plus all the interpolated points, plus a few more points, times a
C fudge factor, don't change anything - just return an overflow error
C to the caller.
C
        IF ((NCRA+NOPI+5)*16.GE.IAMP(6)-IAMP(5)-1)
          CALL SETER ('MDPITA - AREA-MAP ARRAY OVERFLOW',3,1)
          RETURN
        END IF
C
C Return here for the next interpolated point.
C
  101   IF (IOPI.LT.NOPI)
          IOPI=IOPI+1
          RLAT=RLATI(IOPI)
          RLON=RLONI(IOPI)
        ELSE
          IOPI=IOPI+1
          RLAT=XLAT
          RLON=XLON
        END IF
C
C Project the point (RLAT,RLON) to (UNEW,VNEW), using the routine
C MDPTRA, which returns 1.D12 for UNEW and VNEW in areas outside the
C perimeter and on the "wrong" side of a limb line.  Also save PNEW
C for "crossover" testing.
C
        CALL MDPTRA (RLAT,RLON,UNEW,VNEW)
        IF (ICFELL('MDPITA',4).NE.0) RETURN
        PNEW=P
C
C If the new point is invisible, we only have to draw something if it's
C not a first point and the last point was visible, in which case we
C interpolate to find a point at the edge of the visible area and then
C extend the line we're drawing to that point.  In any case, we jump to
C save information about the new point and get another.
C
        IF (UNEW.GE.1.D12)
          IVIS=0
          IF (IFST.NE.0.AND.IVSO.NE.0)
            CALL MDITVE (RLTO,RLNO,POLD,UOLD,VOLD,
     +                   RLAT,RLON,PNEW,UNEW,VNEW,
     +                   RLTE,RLNE,PAPE,UCOE,VCOE)
            IF (ICFELL('MDPITA',5).NE.0) RETURN
            XCRD=UCOE
            YCRD=VCOE
            INVOKE (CONTINUE-THE-LINE)
          END IF
          GO TO 103
        END IF
C
C Otherwise, the new point is visible; things get more complicated.
C
        IVIS=1
C
C If the new point is a first point, initialize a new set of line draws,
C then jump to save information about the new point and get another.
C
        IF (IFST.EQ.0)
          XCRD=UNEW
          YCRD=VNEW
          INVOKE (START-A-LINE)
          GO TO 103
        END IF
C
C Otherwise, the new point is visible and it's not a first point; if the
C last point was invisible, find a point at the edge of the visible area
C and start a new set of line draws there.
C
        IF (IVSO.EQ.0)
          CALL MDITVE (RLAT,RLON,PNEW,UNEW,VNEW,
     +                 RLTO,RLNO,POLD,UOLD,VOLD,
     +                 RLTO,RLNO,POLD,UOLD,VOLD)
          IF (ICFELL('MDPITA',6).NE.0) RETURN
          IVSO=1
          XCRD=UOLD
          YCRD=VOLD
          INVOKE (START-A-LINE)
        END IF
C
C The new point is visible; so was the old one.  If the projection type
C is one of those for which "crossover" is not possible, just jump to
C extend the line to the new point.
C
        IF (IPRJ.GE.2.AND.IPRJ.LE.6) GO TO 102
C
        IF (IPRJ.EQ.0.AND.(IPRF.EQ. 6.OR.IPRF.EQ.10.OR.IPRF.EQ.11.OR.
     +                     IPRF.EQ.12.OR.IPRF.EQ.13.OR.IPRF.EQ.14.OR.
     +                     IPRF.EQ.15.OR.IPRF.EQ.23)) GO TO 102
C
C Test for "crossover"; if it has not occurred, jump to extend the line.
C
        IF (ABS(PNEW-POLD).LT.PEPS) GO TO 102
C
C The new and old points are both visible and "crossover" has occurred.
C We must extend the line to one edge of the map and restart it at the
C other edge.
C
        CALL MDITVE (RLTO,RLNO,POLD,UOLD,VOLD,
     +               RLAT,RLON,PNEW,UNEW,VNEW,
     +               RLTE,RLNE,PAPE,UCOE,VCOE)
        IF (ICFELL('MDPITA',7).NE.0) RETURN
        XCRD=UCOE
        YCRD=VCOE
        INVOKE (CONTINUE-THE-LINE)
C
        CALL MDITVE (RLAT,RLON,PNEW,UNEW,VNEW,
     +               RLTO,RLNO,POLD,UOLD,VOLD,
     +               RLTO,RLNO,POLD,UOLD,VOLD)
        IF (ICFELL('MDPITA',8).NE.0) RETURN
C
C Start a new series of line draws with the old point.
C
        IVSO=1
        XCRD=UOLD
        YCRD=VOLD
        INVOKE (START-A-LINE)
C
C Continue the line to the new point.
C
  102   XCRD=UNEW
        YCRD=VNEW
        INVOKE (CONTINUE-THE-LINE)
C
C Save information about the current point for the next call.
C
  103   IVSO=IVIS
        RLTO=RLAT
        RLNO=RLON
        POLD=PNEW
        UOLD=UNEW
        VOLD=VNEW
C
C If interpolation is taking place, loop back for the next point.
C
  104   IF (IOPI.LE.NOPI) GO TO 101
C
C Done.
C
        RETURN
C
C The following internal procedure is invoked to start a line.
C
        BLOCK (START-A-LINE)
          IF (NCRA.GT.1)
            CALL AREDAM (IAMP,XCRA,YCRA,NCRA,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPITA',9).NE.0) RETURN
          END IF
          XCRA(1)=REAL(XCRD)
          YCRA(1)=REAL(YCRD)
          NCRA=1
        END BLOCK
C
C The following internal procedure is invoked to continue a line.
C
        BLOCK (CONTINUE-THE-LINE)
          IF (NCRA.EQ.100)
            CALL AREDAM (IAMP,XCRA,YCRA,NCRA,IGRP,IDLT,IDRT)
            IF (ICFELL('MDPITA',10).NE.0) RETURN
            XCRA(1)=XCRA(100)
            YCRA(1)=YCRA(100)
            NCRA=1
          END IF
          NCRA=NCRA+1
          XCRA(NCRA)=REAL(XCRD)
          YCRA(NCRA)=REAL(YCRD)
        END BLOCK
C
      END


      SUBROUTINE MAPITM (XLAT,XLON,IFST,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        REAL    XLAT,XLON
        INTEGER IFST,IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
        IF (ICFELL('MAPITM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
        CALL MDPITM (DBLE(XLAT),DBLE(XLON),IFST,IAM,XCS,YCS,MCS,IAI,IAG,
     +                                                          MAI,LPR)
        IF (ICFELL('MAPITM',2).NE.0) RETURN
        RETURN
      END


      SUBROUTINE MDPITM (XLAT,XLON,IFST,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
C
        DOUBLE PRECISION XLAT,XLON
        INTEGER          IFST,IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL             XCS(*),YCS(*)
C
C Declare required common blocks.  See MAPBDX for descriptions of these
C common blocks and the variables in them.
C
        COMMON /MAPCM0/  COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        DOUBLE PRECISION COS1,DTOR,DTRH,OOPI,PI,PIOF,PIOT,RTDD,RTOD,
     +                   SROT,SIN1,TOPI,TSRT
        SAVE   /MAPCM0/
C
        COMMON /MAPCM1/  COSO,COSR,SINO,SINR,IPRJ,IROD
        DOUBLE PRECISION COSO,COSR,SINO,SINR
        INTEGER          IPRJ,IROD
        SAVE   /MAPCM1/
C
        COMMON /MAPCM2/  BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG,ISSL
        DOUBLE PRECISION BLAM,BLOM,PEPS,SLAM,SLOM,UCEN,UMAX,UMIN,UOFF,
     +                   URNG,VCEN,VMAX,VMIN,VOFF,VRNG
        INTEGER          ISSL
        SAVE   /MAPCM2/
C
        COMMON /MAPCM4/  GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW,IDOT,IDSH,IDTL,ILCW,
     +                   ILTS,JPRJ,ELPF,INTF,LBLF,PRMF
        DOUBLE PRECISION GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW
        INTEGER          IDOT,IDSH,IDTL,ILCW,ILTS,JPRJ
        LOGICAL          ELPF,INTF,LBLF,PRMF
        SAVE   /MAPCM4/
C
        COMMON /MAPCM8/  P,Q,R
        DOUBLE PRECISION P,Q,R
        SAVE   /MAPCM8/
C
        COMMON /MAPCMA/  DATL,DBTD,DDTS,DPLT,DPSQ,DSCA,DSSQ
        DOUBLE PRECISION DATL,DBTD,DDTS,DPLT,DPSQ,DSCA,DSSQ
        SAVE   /MAPCMA/
C
        COMMON /MAPCMC/  IGI1,IGI2,NCRA,NOVS,XCRA(100),YCRA(100)
        INTEGER          IGI1,IGI2,NCRA,NOVS
        REAL             XCRA,YCRA
        SAVE   /MAPCMC/
C
        COMMON /USGSC1/  UTPA(15),UUMN,UUMX,UVMN,UVMX,IPRF
        DOUBLE PRECISION UTPA,UUMN,UUMX,UVMN,UVMX
        INTEGER IPRF
        SAVE   /USGSC1/
C
C Declare local variables.
C
        DOUBLE PRECISION APTX,CPLN,CPLT,CXLN,CXLT,DTST,PAPE,PNEW,POLD,
     +                   RLAT,RLATI(100),RLNE,RLNO,RLON,RLONI(100),RLTE,
     +                   RLTO,RMLO,RMUL,SPLN,SPLT,SXLN,SXLT,UCOE,UNEW,
     +                   UOLD,VCOE,VNEW,VOLD,XCRD,XLNO,XLTO,YCRD
C
        INTEGER          IOPI,IVIS,IVSO,NOPI
C
        SAVE             IVSO,POLD,RLNO,RLTO,RMLO,UOLD,VOLD,XLNO,XLTO
C
        DATA IVSO,POLD,RLNO,RLTO,RMLO,UOLD,VOLD,XLNO,XLTO / 0,8*0.D0 /
C
C Check for an uncleared prior error.
C
        IF (ICFELL('MDPITM - UNCLEARED PRIOR ERROR',1).NE.0) RETURN
C
C If EZMAP needs initialization, do it.
C
        IF (INTF)
          CALL MDPINT
          IF (ICFELL('MDPITM',2).NE.0) RETURN
        END IF
C
C Initialize the variables that control interpolation.
C
        IOPI=0
        NOPI=0
C
C If the projection is one of those in which great distortion occurs at
C points opposite the pole, see if some points need to be interpolated.
C
C Note that I originally did this for four different projections, but it
C really needs to be done only for the Lambert Equal-Area and Azimuthal
C Equidistant projections, as these are the only two that are sometimes
C used to show the entire globe.  When I added the USGS projections, I
C did not bother to provide interpolation for the other two projections
C (the Gnomonic and the Stereographic), but I also did not remove the
C interpolation that was being done for the forms of these projections
C that we already had (03/11/99).
C
        IF ((IPRJ.EQ.0.AND.(IPRF.EQ. 3.OR.IPRF.EQ. 8.OR.
     +                      IPRF.EQ.11.OR.IPRF.EQ.12)).OR.
     +      IPRJ.EQ.2.OR.IPRJ.EQ.4.OR.IPRJ.EQ.5.OR.IPRJ.EQ.6)
          IF (IPRJ.EQ.0)
            IF (IPRF.EQ.3.OR.IPRF.EQ.8)
              CPLT=0.D0
              SPLT=1.D0
              CPLN=1.D0
              SPLN=0.D0
              IF (IPRF.EQ.8.AND.UTPA(9).EQ.0.D0)
                DTST=UTPA(3)
              ELSE
                DTST=.5D0*UTPA(3)+UTPA(4)
              END IF
              IF (DTST.GT.0.D0)
                DTST=90.D0-DTST
              ELSE
                SPLT=-SPLT
                DTST=DTST+90.D0
              END IF
            ELSE
              CPLT=COS(DTOR*UTPA(6))
              SPLT=SIN(DTOR*UTPA(6))
              CPLN=COS(DTOR*UTPA(5))
              SPLN=SIN(DTOR*UTPA(5))
            END IF
          ELSE
            CPLT=COS(DTOR*PLTO)
            SPLT=SIN(DTOR*PLTO)
            CPLN=COS(DTOR*PLNO)
            SPLN=SIN(DTOR*PLNO)
          END IF
          CXLT=COS(DTOR*XLAT)
          SXLT=SIN(DTOR*XLAT)
          CXLN=COS(DTOR*XLON)
          SXLN=SIN(DTOR*XLON)
          APTX=2.D0*RTOD*ASIN(SQRT((CXLT*CXLN-CPLT*CPLN)**2+
     +                             (CXLT*SXLN-CPLT*SPLN)**2+
     +                             (SXLT     -SPLT     )**2)/2.D0)
          IF (IPRJ.EQ.0.AND.(IPRF.EQ.3.OR.IPRF.EQ.8))
            IF (APTX.LE.DTST)
              RMUL=MAX(1.D0,MIN(51.D0,51.D0*((DTST-APTX)/DTST)**8))
            ELSE
              RMUL=MAX(1.D0,MIN(51.D0,51.D0*((APTX-DTST)/
     +                                          (180.D0-DTST))**8))
            END IF
          ELSE IF (IPRJ.EQ.2)
            IF (APTX.LE.179.999D0)
              RMUL=MIN(101.D0,1.D0/(1.D0+COS(DTOR*APTX)))
            ELSE
              RMUL=101.D0
            END IF
          ELSE IF ((IPRJ.EQ.0.AND.IPRF.EQ.11).OR.IPRJ.EQ.4)
            IF (APTX.LE.179.999D0)
              RMUL=MIN(101.D0,2.D0/SQRT(2.D0*(1.D0+COS(DTOR*APTX))))
            ELSE
              RMUL=101.D0
            END IF
          ELSE IF (IPRJ.EQ.5)
            IF (APTX.LT.89.999D0)
              RMUL=MIN(21.D0,1.D0/COS(DTOR*APTX))
            ELSE
              RMUL=21.D0
            END IF
          ELSE IF ((IPRJ.EQ.0.AND.IPRF.EQ.12).OR.IPRJ.EQ.6)
            IF (APTX.LE..00001D0)
              RMUL=1.D0
            ELSE IF (APTX.LT.179.999D0)
              RMUL=MIN(101.D0,DTOR*APTX/SIN(DTOR*APTX))
            ELSE
              RMUL=101.D0
            END IF
          END IF
          IF (IFST.NE.0)
            NOPI=MAX(0,MIN(50,INT(MAX(RMLO,RMUL))/2))
            IF (NOPI.NE.0)
     +                CALL MDPGCI (XLTO,XLNO,XLAT,XLON,NOPI,RLATI,RLONI)
          END IF
          XLTO=XLAT
          XLNO=XLON
          RMLO=RMUL
        END IF
C
C Return here for the next interpolated point.
C
  101   IF (IOPI.LT.NOPI)
          IOPI=IOPI+1
          RLAT=RLATI(IOPI)
          RLON=RLONI(IOPI)
        ELSE
          IOPI=IOPI+1
          RLAT=XLAT
          RLON=XLON
        END IF
C
C Project the point (RLAT,RLON) to (UNEW,VNEW), using the routine
C MDPTRA, which returns 1.D12 for UNEW and VNEW in areas outside the
C perimeter and on the "wrong" side of a limb line.  Also save PNEW
C for "crossover" testing.
C
        CALL MDPTRA (RLAT,RLON,UNEW,VNEW)
        IF (ICFELL('MDPITM',3).NE.0) RETURN
        PNEW=P
C
C If the new point is invisible, we only have to draw something if it's
C not a first point and the last point was visible, in which case we
C interpolate to find a point at the edge of the visible area and then
C extend the line we're drawing to that point.  In any case, we jump to
C save information about the new point and get another.
C
        IF (UNEW.GE.1.D12)
          IVIS=0
          IF (IFST.NE.0.AND.IVSO.NE.0)
            CALL MDITVE (RLTO,RLNO,POLD,UOLD,VOLD,
     +                   RLAT,RLON,PNEW,UNEW,VNEW,
     +                   RLTE,RLNE,PAPE,UCOE,VCOE)
            IF (ICFELL('MDPITM',4).NE.0) RETURN
            XCRD=UCOE
            YCRD=VCOE
            INVOKE (CONTINUE-THE-LINE)
          END IF
          GO TO 103
        END IF
C
C Otherwise, the new point is visible; things get more complicated.
C
        IVIS=1
C
C If the new point is a first point, initialize a new set of line draws,
C then jump to save information about the new point and get another.
C
        IF (IFST.EQ.0)
          XCRD=UNEW
          YCRD=VNEW
          INVOKE (START-A-LINE)
          GO TO 103
        END IF
C
C Otherwise, the new point is visible and it's not a first point; if the
C last point was invisible, find a point at the edge of the visible area
C and start a new set of line draws there.
C
        IF (IVSO.EQ.0)
          CALL MDITVE (RLAT,RLON,PNEW,UNEW,VNEW,
     +                 RLTO,RLNO,POLD,UOLD,VOLD,
     +                 RLTO,RLNO,POLD,UOLD,VOLD)
          IF (ICFELL('MDPITM',5).NE.0) RETURN
          IVSO=1
          XCRD=UOLD
          YCRD=VOLD
          INVOKE (START-A-LINE)
        END IF
C
C The new point is visible; so was the old one.  If the projection type
C is one of those for which "crossover" is not possible, just jump to
C extend the line to the new point.
C
        IF (IPRJ.GE.2.AND.IPRJ.LE.6) GO TO 102
C
        IF (IPRJ.EQ.0.AND.(IPRF.EQ. 6.OR.IPRF.EQ.10.OR.IPRF.EQ.11.OR.
     +                     IPRF.EQ.12.OR.IPRF.EQ.13.OR.IPRF.EQ.14.OR.
     +                     IPRF.EQ.15.OR.IPRF.EQ.23)) GO TO 102
C
C Test for "crossover"; if it has not occurred, jump to extend the line.
C
        IF (ABS(PNEW-POLD).LT.PEPS) GO TO 102
C
C The new and old points are both visible and "crossover" has occurred.
C We must extend the line to one edge of the map and restart it at the
C other edge.
C
        CALL MDITVE (RLTO,RLNO,POLD,UOLD,VOLD,
     +               RLAT,RLON,PNEW,UNEW,VNEW,
     +               RLTE,RLNE,PAPE,UCOE,VCOE)
        IF (ICFELL('MDPITM',6).NE.0) RETURN
        XCRD=UCOE
        YCRD=VCOE
        INVOKE (CONTINUE-THE-LINE)
C
        CALL MDITVE (RLAT,RLON,PNEW,UNEW,VNEW,
     +               RLTO,RLNO,POLD,UOLD,VOLD,
     +               RLTO,RLNO,POLD,UOLD,VOLD)
        IF (ICFELL('MDPITM',7).NE.0) RETURN
C
C Start a new series of line draws with the old point.
C
        IVSO=1
        XCRD=UOLD
        YCRD=VOLD
        INVOKE (START-A-LINE)
C
C Continue the line to the new point.
C
  102   XCRD=UNEW
        YCRD=VNEW
        INVOKE (CONTINUE-THE-LINE)
C
C Save information about the current point for the next call.
C
  103   IVSO=IVIS
        RLTO=RLAT
        RLNO=RLON
        POLD=PNEW
        UOLD=UNEW
        VOLD=VNEW
C
C If interpolation is taking place, loop back for the next point.
C
  104   IF (IOPI.LE.NOPI) GO TO 101
C
C Done.
C
        RETURN
C
C The following internal procedure is invoked to start a line.
C
        BLOCK (START-A-LINE)
          IF (NCRA.GT.1)
            CALL ARDRLN (IAM,XCRA,YCRA,NCRA,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPITM',8).NE.0) RETURN
          END IF
          XCRA(1)=REAL(XCRD)
          YCRA(1)=REAL(YCRD)
          NCRA=1
        END BLOCK
C
C The following internal procedure is invoked to continue a line.
C
        BLOCK (CONTINUE-THE-LINE)
          IF (NCRA.EQ.100)
            CALL ARDRLN (IAM,XCRA,YCRA,NCRA,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
            IF (ICFELL('MDPITM',9).NE.0) RETURN
            XCRA(1)=XCRA(100)
            YCRA(1)=YCRA(100)
            NCRA=1
          END IF
          NCRA=NCRA+1
          XCRA(NCRA)=REAL(XCRD)
          YCRA(NCRA)=REAL(YCRD)
        END BLOCK
C
      END


      SUBROUTINE MDPCHM (IPRT,IDPT,IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
C
        INTEGER IPRT,IDPT,IAM(*),MCS,IAI(*),IAG(*),MAI
        REAL    XCS(*),YCS(*)
C
C MDPCHM is called by various EZMAP routines to reset the color index,
C and dash pattern before and after drawing parts of a map by means
C of calls to ARDRLN (masked against an area map).
C
C The argument IPRT, if positive, says which part of the map is about
C to be drawn, as follows:
C
C     IPRT    Part of map.
C     ----    ------------
C       1     Perimeter.
C       2     Grid.
C       3     Labelling.
C       4     Limb lines.
C       5     Outline point group, continental.
C       6     Outline point group, U.S.
C       7     Outline point group, country.
C
C A call with IPRT equal to the negative of one of these values asks
C that the color index saved by the last call, with IPRT positive, be
C restored.
C
C When IPRT is positive, IDPT is the dash pattern to be used.  If IPRT
C is negative, IDPT is ignored.
C
C Declare required common blocks.  See MAPBDX for descriptions of these
C common blocks and the variables in them.
C
        COMMON /MAPCM4/  GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW,IDOT,IDSH,IDTL,ILCW,
     +                   ILTS,JPRJ,ELPF,INTF,LBLF,PRMF
        DOUBLE PRECISION GRDR,GRID,GRLA,GRLO,GRPO,OTOL,PDRE,PLA1,PLA2,
     +                   PLA3,PLA4,PLB1,PLB2,PLB3,PLB4,PLNO,PLTO,ROTA,
     +                   SRCH,XLOW,XROW,YBOW,YTOW
        INTEGER          IDOT,IDSH,IDTL,ILCW,ILTS,JPRJ
        LOGICAL          ELPF,INTF,LBLF,PRMF
        SAVE   /MAPCM4/
C
        COMMON /MAPCMQ/  ICIN(8)
        INTEGER          ICIN
        SAVE   /MAPCMQ/
C
C Declare one of the dash-package common blocks, too.
C
        COMMON /SMFLAG/  ISMO
        INTEGER          ISMO
        SAVE   /SMFLAG/
C
C Declare local variables.
C
        INTEGER          IGER,IPLS,IPMS,ISMS,ITXS
C
C Certain variables need to be saved between calls.
C
        SAVE IPLS,IPMS,ISMS,ITXS
C
C Flush all buffers before changing anything.
C
        CALL MDPIQM (IAM,XCS,YCS,MCS,IAI,IAG,MAI,LPR)
        IF (ICFELL('MDPCHM',1).NE.0) RETURN
C
C Set/reset color index, dotting, and dash pattern.  The user has the
C last word.
C
        IF (IPRT.GT.0)
          ISMS=ISMO
          ISMO=1
          CALL DASHDB (IDPT)
          IF (ICFELL('MDPCHM',2).NE.0) RETURN
          IF (ICIN(IPRT).GE.0)
            CALL GQPLCI (IGER,IPLS)
            IF (IGER.NE.0)
              CALL SETER ('MDPCHM - ERROR EXIT FROM GQPLCI',3,1)
              RETURN
            END IF
            CALL GQPMCI (IGER,IPMS)
            IF (IGER.NE.0)
              CALL SETER ('MDPCHM - ERROR EXIT FROM GQPMCI',4,1)
              RETURN
            END IF
            CALL GQTXCI (IGER,ITXS)
            IF (IGER.NE.0)
              CALL SETER ('MDPCHM - ERROR EXIT FROM GQTXCI',5,1)
              RETURN
            END IF
            CALL GSPLCI (ICIN(IPRT))
            CALL GSPMCI (ICIN(IPRT))
            CALL GSTXCI (ICIN(IPRT))
          END IF
          CALL HLUMAPUSR (IPRT)
          IF (ICFELL('MDPCHM',6).NE.0) RETURN
        ELSE
          CALL HLUMAPUSR (IPRT)
          IF (ICFELL('MDPCHM',7).NE.0) RETURN
          IF (ICIN(-IPRT).GE.0)
            CALL GSPLCI (IPLS)
            CALL GSPMCI (IPMS)
            CALL GSTXCI (ITXS)
          END IF
          CALL DASHDB (IOR(ISHIFT(32767,1),1))
          IF (ICFELL('MDPCHM',8).NE.0) RETURN
          ISMO=ISMS
        END IF
C
C Done.
C
        RETURN
C
      END
