
      PROGRAM EQLOOK
C
C This program draws two maps - a simple one and a color-filled one -
C using the database, projection parameters, and limit parameters that
C the user specifies.
C
C Define the error file, the Fortran unit number, the workstation type,
C and the workstation ID to be used in calls to GKS routines.  Use one
C of the following:
C
        PARAMETER (IERF=6,LUNI=2,IWTY=1 ,IWID=1)  !  NCGM
C       PARAMETER (IERF=6,LUNI=2,IWTY=8 ,IWID=1)  !  X Windows
C       PARAMETER (IERF=6,LUNI=2,IWTY=20,IWID=1)  !  PostScript
C       PARAMETER (IERF=6,LUNI=2,IWTY=11,IWID=1)  !  PDF, Portrait
C       PARAMETER (IERF=6,LUNI=2,IWTY=12,IWID=1)  !  PDF, Landscape
C
C Define the sizes to be used for the area map array and workspaces.

        PARAMETER (LAMA=10000000,NCRA=500000,NGPS=10)
C
C Declare necessary arrays.
C
        DIMENSION IAMA(LAMA),XCRA(NCRA),YCRA(NCRA),IAAI(NGPS),IAGI(NGPS)
C
C Declare a common block in which to keep track of the longest line
C segment seen by the routine COLORA.
C
        COMMON /BIGEST/ NBIG,ILVL
C
C Declare user callback routines used to create maps.
C
        EXTERNAL COLORA,DRAWLA
C
C Other declarations.
C
        CHARACTER*64 FLNM
        CHARACTER*2 PTYP,LTYP
        DIMENSION PLM1(2),PLM2(2),PLM3(2),PLM4(2)
C
C Get the name of the database file.
C
        PRINT * , ' '
        PRINT * , 'Enter the name of the file to be used:'
        READ (*,'(A64)') FLNM
        PRINT * , ' '
C
C Get the level at which the database is to be displayed.
C
        PRINT * , 'Enter level at which dataset is to be displayed:'
        READ (*,*) ILVL
C
C Get the projection type.
C
        PRINT * , ' '
        PRINT * , 'Enter the type of projection to be used (AE, AI, CE,'
        PRINT * , 'EA, ER, GN, HA, LC, LE, ME, MO, MT, OR, RO, ST, SV,'
        PRINT * , 'or WT):'
        READ (*,'(A2)') PTYP
C
C Get associated parameters (which depend somewhat on the type).
C
        IF (PTYP.EQ.'LC') THEN
          PRINT * , ' '
          PRINT * , 'Enter latitude of 1st standard parallel:'
          READ (*,*) PLAT
          PRINT * , ' '
          PRINT * , 'Enter longitude of central meridian:'
          READ (*,*) PLON
          PRINT * , ' '
          PRINT * , 'Enter latitude of second standard parallel:'
          READ (*,*) ROTA
        ELSE
          PRINT * , ' '
          PRINT * , 'Enter pole latitude:'
          READ (*,*) PLAT
          PRINT * , ' '
          PRINT * , 'Enter pole longitude:'
          READ (*,*) PLON
          PRINT * , ' '
          PRINT * , 'Enter rotation angle:'
          READ (*,*) ROTA
          IF (PTYP.EQ.'SV') THEN
            PRINT * , ' '
            PRINT * , 'Enter satellite altitude (greater than 1):'
            READ (*,*) SALT
            PRINT * , ' '
            PRINT * , 'Enter angle 1:'
            READ (*,*) SAN1
            PRINT * , ' '
            PRINT * , 'Enter angle 2:'
            READ (*,*) SAN2
          END IF
        END IF
C
C Get the map limits type.
C
        PRINT * , ' '
        PRINT * , 'Enter the type of limits to be used (MA, CO, PO,'
        PRINT * , 'AN, LI, or GR):'
        READ (*,'(A2)') LTYP
C
C Get associated limits values.
C
        IF (LTYP.EQ.'MA') THEN
          PLM1(1)=0.
          PLM2(1)=0.
          PLM3(1)=0.
          PLM4(1)=0.
          PLM1(2)=0.
          PLM2(2)=0.
          PLM3(2)=0.
          PLM4(2)=0.
        ELSE IF (LTYP.EQ.'CO') THEN
          PRINT * , ' '
          PRINT * , 'Enter latitude and longitude of corner point 1:'
          READ (*,*) PLM1(1),PLM2(1)
          PRINT * , ' '
          PRINT * , 'Enter latitude and longitude of corner point 2:'
          READ (*,*) PLM3(1),PLM4(1)
          PLM1(2)=0.
          PLM2(2)=0.
          PLM3(2)=0.
          PLM4(2)=0.
        ELSE IF (LTYP.EQ.'PO') THEN
          PRINT * , ' '
          PRINT * , 'Enter latitude and longitude of edge point 1:'
          READ (*,*) PLM1(1),PLM1(2)
          PRINT * , ' '
          PRINT * , 'Enter latitude and longitude of edge point 2:'
          READ (*,*) PLM2(1),PLM2(2)
          PRINT * , ' '
          PRINT * , 'Enter latitude and longitude of edge point 3:'
          READ (*,*) PLM3(1),PLM3(2)
          PRINT * , ' '
          PRINT * , 'Enter latitude and longitude of edge point 3:'
          READ (*,*) PLM4(1),PLM4(2)
        ELSE IF (LTYP.EQ.'AN') THEN
          PRINT * , ' '
          PRINT * , 'Enter angular distance to the left:'
          READ (*,*) PLM1(1)
          PRINT * , ' '
          PRINT * , 'Enter angular distance to the right:'
          READ (*,*) PLM2(1)
          PRINT * , ' '
          PRINT * , 'Enter angular distance to the bottom:'
          READ (*,*) PLM3(1)
          PRINT * , ' '
          PRINT * , 'Enter angular distance to the top:'
          READ (*,*) PLM4(1)
          PLM1(2)=0.
          PLM2(2)=0.
          PLM3(2)=0.
          PLM4(2)=0.
        ELSE IF (LTYP.EQ.'LI') THEN
          PRINT * , ' '
          PRINT * , 'Enter limit value at the left edge:'
          READ (*,*) PLM1(1)
          PRINT * , ' '
          PRINT * , 'Enter limit value at the right edge:'
          READ (*,*) PLM2(1)
          PRINT * , ' '
          PRINT * , 'Enter limit value at the bottom edge:'
          READ (*,*) PLM3(1)
          PRINT * , ' '
          PRINT * , 'Enter limit value at the top edge:'
          READ (*,*) PLM4(1)
          PLM1(2)=0.
          PLM2(2)=0.
          PLM3(2)=0.
          PLM4(2)=0.
        ELSE IF (LTYP.EQ.'GR') THEN
          PRINT * , ' '
          PRINT * , 'Enter minimum latitude:'
          READ (*,*) PLM1(1)
          PRINT * , ' '
          PRINT * , 'Enter minimum longitude:'
          READ (*,*) PLM2(1)
          PRINT * , ' '
          PRINT * , 'Enter maximum latitude:'
          READ (*,*) PLM3(1)
          PRINT * , ' '
          PRINT * , 'Enter maximum longitude:'
          READ (*,*) PLM4(1)
          PLM1(2)=0.
          PLM2(2)=0.
          PLM3(2)=0.
          PLM4(2)=0.
        END IF
C
C Get the desired grid spacing.
C
        PRINT * , ' '
        PRINT * , 'Enter grid spacing:'
        READ (*,*) GRID
C
C Open GKS.
C
        CALL GOPKS (IERF,0)
        CALL GOPWK (IWID,LUNI,IWTY)
        CALL GACWK (IWID)
C
C Initialize a parameter that keeps track of the longest line
C segment seen by COLORA.
C
        NBIG=0
C
C Turn GKS clipping off.
C
        CALL GSCLIP (0)
C
C Set the GKS fill area interior style to "solid".
C
        CALL GSFAIS (1)
C
C Define some colors.
C
        CALL GSCR (IWID,  0,0.,0.,0.)  !  black background
        CALL GSCR (IWID,  1,1.,1.,1.)  !  white foreground
        CALL GSCR (IWID,  2,1.,.5,.5)  !  light red
        CALL GSCR (IWID,  3,.5,1.,.5)  !  light green
        CALL GSCR (IWID,  4,.5,.5,1.)  !  light blue
        CALL GSCR (IWID,101,.5,.6,.8)  !  area color 1
        CALL GSCR (IWID,102,.2,.4,.6)  !  area color 2
        CALL GSCR (IWID,103,.2,.6,.4)  !  area color 3
        CALL GSCR (IWID,104,.2,.8,.2)  !  area color 4  !  PRETTY GOOD
        CALL GSCR (IWID,105,.4,.6,.2)  !  area color 5
        CALL GSCR (IWID,106,.6,.4,.2)  !  area color 6
        CALL GSCR (IWID,107,.6,.6,.6)  !  area color 7
        CALL GSCR (IWID,108,.9,1.,1.)  !  area color 8
C
C Tell EZMAP what grid spacing to use.
C
        CALL MPSETR ('GR',GRID)
C
C Tell EZMAP what projection to use and give it associated parameters.
C
        CALL MAPROJ (PTYP,PLAT,PLON,ROTA)
        IF (PTYP.EQ.'SV') THEN
          CALL MPSETR ('SA',SALT)
          CALL MPSETR ('S1',SAN1)
          CALL MPSETR ('S2',SAN2)
        END IF
C
C Tell EZMAP what type of limits to use and give it values.
C
        CALL MAPSET (LTYP,PLM1,PLM2,PLM3,PLM4)
C
C Set vertical stripping off.
C
        CALL MPSETI ('VS',0)
C
C Set vertical stripping on.  This usually isn't necessary now, because
C most hardware color fill devices will handle huge polygons, and, on
C some devices, it can cause curious artifacts to appear ... but, just
C in case, I'll leave the code here, commented out.
C
C       CALL MPSETI ('VS',10)
C
C Initialize EZMAP.
C
        CALL MAPINT
C
C Draw the grid.
C
        CALL MAPGRD
C
C Draw labels.
C
        CALL MAPLBL
C
C Draw the geopolitical outlines.
C
        CALL MPLNDR (FLNM,ILVL)
C
C Advance the frame.
C
        CALL FRAME
C
C Initialize AREAS.
C
        CALL ARINAM (IAMA,LAMA)
C
C The following statement isn't necessary, as far as I can tell; I
C don't know why it was in here, but there may be some situation in
C which it has a beneficial effect, so I'm just commenting it out
C pending further experimentation.
C
C       CALL MPSETC ('OU','NO')
C
C Put geopolitical outlines in the area map.
C
        CALL MPLNAM (FLNM,ILVL,IAMA)
C
C Scan the area map and color the areas it defines.
C
        CALL ARSCAM (IAMA,XCRA,YCRA,NCRA,IAAI,IAGI,NGPS,COLORA)
C
C Draw the grid over oceans but not land masses.
C
        CALL MAPGRM (IAMA,XCRA,YCRA,NCRA,IAAI,IAGI,NGPS,DRAWLA)
C
C Draw a limb line for the projection.
C
        CALL MAPLMB
C
C Put on labels.
C
        CALL MAPLBL
C
C Advance the frame.
C
        CALL FRAME
C
C Print information collected by COLORA.
C
        PRINT * , 'NBIG = ',NBIG
C
C Close GKS.
C
        CALL GDAWK (IWID)
        CALL GCLWK (IWID)
        CALL GCLKS
C
C Done.
C
        STOP
C
      END



      SUBROUTINE COLORA (XCRA,YCRA,NCRA,IAAI,IAGI,NGPS)
C
        DIMENSION XCRA(NCRA),YCRA(NCRA),IAAI(NGPS),IAGI(NGPS)
C
        COMMON /BIGEST/ NBIG,ILVL
C
C Fill the areas extracted from an area map by ARSCAM, using the
C color implied by the area identifiers defined by the arguments.
C
        NBIG=MAX(NBIG,NCRA)
C
        IAI1=-1
        DO 101 IGRP=1,NGPS
          IF (IAGI(IGRP).EQ.1) IAI1=IAAI(IGRP)
  101   CONTINUE
C
        IF (IAI1.GT.0) THEN
          CALL GSFACI (MPISCI(MPIOLA(IAI1,ILVL))+100)
          CALL GFA    (NCRA-1,XCRA,YCRA)
        END IF
C
        RETURN
C
      END



      SUBROUTINE DRAWLA (XCRA,YCRA,NCRA,IAAI,IAGI,NGPS)
C
        DIMENSION XCRA(NCRA),YCRA(NCRA),IAAI(NGPS),IAGI(NGPS)
C
C Draw pieces of parallels and meridians lying over the ocean, as
C extracted by the routine MAPGRM.
C
C
        IAI1=-1
        DO 101 IGRP=1,NGPS
          IF (IAGI(IGRP).EQ.1) IAI1=IAAI(IGRP)
  101   CONTINUE
C
        IF (IAI1.GT.0) THEN
          IF (MPISCI(MPIOLA(IAI1,1)).EQ.1) THEN
            CALL GPL    (NCRA,XCRA,YCRA)
          END IF
        END IF
C
        RETURN
C
      END
