
      PROGRAM EXAMSQ
C
C This program reads the line data from an ASCII file defining an EZMAP
C dataset and creates plots showing the number of data points in each
C of a number of subsquares of a cylindrical equidistant projection of
C the globe.
C
C The line data in the input files are grouped into logical records,
C each of which represents a single line segment and exists as a pair
C of FORTRAN records.  The first record of each pair contains four
C integers and four reals; if the first integer has a zero value, then
C there is no second record and the end of the line data has been
C reached.  The second record of each pair contains a varying number of
C real lat/lon coordinate pairs.  In terms of the variables into which
C the data are read:
C
C   INTS(1) = the number of reals in the second FORTRAN record, but if
C             the value is 0, there is no second FORTRAN record: this
C             signals the end of the line data in the input file.
C   INTS(2) = a "line type" for the line segment.
C   INTS(3) = the left area identifier for the line segment.
C   INTS(4) = the right area identifier for the line segment.
C   FLTS(1) = the biggest latitude in the line segment.
C   FLTS(2) = the smallest latitude in the line segment.
C   FLTS(3) = the biggest longitude in the line segment.
C   FLTS(4) = the smallest longitude in the line segment.
C  (FLTS(I),I=5,4+INTS(1)) = lat/lon pairs for the line segment.
C
C Following the line data are the names of the global areas described
C by the lines.  Each record contains an area identifier, an area type,
C a suggested color index for the area, the identifier of the "parent"
C area, and the name of the area.
C
C Define the number of frames to be drawn.  This determines the maximum
C number of subsquares used.
C
        PARAMETER (NFRA=6,MMAX=2**NFRA,NMAX=MMAX/2)
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 Dimension the arrays into which the data are to be read and from which
C they are to be written.
C
        DIMENSION INTS(4),FLTS(204)
C
C Set up an equivalent name for the array element specifying the length
C of the second FORTRAN record.
C
        EQUIVALENCE (INTS(1),LOSR)
C
C Dimension the arrays in which the point counts for the subsquares are
C to be kept.
C
        DIMENSION IHIT(MMAX,NMAX)
C
C Declare a character variable to hold the dataset name.
C
        CHARACTER*71 FLNM
C
C Declare a character-variable temporary for numbers to be written out.
C
        CHARACTER*10 CTFN
C
C Declare a character-variable temporary for titles to be written out.
C
        CHARACTER*128 CTFT
C
C Get the name of the file to be read.
C
        PRINT * , ' '
        PRINT * , 'Enter the name of the file to be read:'
        READ (*,'(A64)') FLNM
C
        IF (FLNM.EQ.' ') GO TO 901
C
        LFNM=IOLNBC(FLNM)
C
C Open the specified input file.
C
        OPEN (1,FILE=FLNM(1:LFNM),STATUS='OLD',FORM='FORMATTED',ERR=902)
C
C Open GKS.
C
        CALL GOPKS (IERF,0)
        CALL GOPWK (IWID,LUNI,IWTY)
        CALL GACWK (IWID)
C
C Turn off clipping by GKS.
C
        CALL GSCLIP (0)
C
C Define some colors.
C
        CALL GSCR   (IWID,0,0.0,0.0,0.0)
        CALL GSCR   (IWID,1,1.0,1.0,1.0)
        CALL GSCR   (IWID,2,0.5,0.5,0.5)
        CALL GSCR   (IWID,3,0.0,1.0,1.0)
        CALL GSCR   (IWID,4,0.5,0.0,0.5)
C
C Define the mapping of latitudes and longitudes into the plotter frame.
C
        CALL SET    (.02,.98,.26,.74,-180.,180.,-90.,90.,1)
C
C Tell PLOTCHAR what to expect as the function-code character.
C
        CALL PCSETC ('FC','!')
C
C Loop through the requested number of frames.
C
        DO 111 IFRA=1,NFRA
C
C Calculate how many boxes are in each row and column.
C
          MBOX=2**IFRA
          NBOX=MBOX/2
C
C Calculate the length of the side of each little subsquare.
C
          SIDE=360./REAL(MBOX)
C
C Draw a grid in light magenta.
C
          CALL SFLUSH
          CALL GSPLCI (4)
C
          DO 101 IBOX=0,MBOX
            CALL FRSTPT (-180.+REAL(IBOX)*SIDE,-90.)
            CALL VECTOR (-180.+REAL(IBOX)*SIDE, 90.)
  101     CONTINUE
C
          DO 102 JBOX=0,NBOX
            CALL FRSTPT (-180.,-90.+REAL(JBOX)*SIDE)
            CALL VECTOR ( 180.,-90.+REAL(JBOX)*SIDE)
  102     CONTINUE
C
C Calculate the character size to be used.
C
          CHSZ=.125/REAL(MBOX)
C
C Zero the array that keeps track of hits in the subsquares.
C
          DO 104 IBOX=1,MBOX
            DO 103 JBOX=1,NBOX
              IHIT(IBOX,JBOX)=0
  103       CONTINUE
  104     CONTINUE
C
C Set the polyline color to a dark gray.
C
          CALL SFLUSH
          CALL GSPLCI (2)
C
C Rewind the input unit.
C
          REWIND 1
C
C Read the next input record.
C
  105     READ (1,'(4I4,4F10.5)',ERR=904,END=905) (INTS(I),I=1,4),
     +                                            (FLTS(I),I=1,4)
C
C If lat/lon data follow, update the counts in the various squares, draw
C the line defined by the data, and go back for another input record.
C
          IF (LOSR.NE.0) THEN
            READ (1,'(8F10.5)',ERR=904,END=905) (FLTS(4+I),I=1,LOSR)
            DO 106 I=5,3+LOSR,2
              IBOX=MAX(1,MIN(MBOX,1+INT((FLTS(I+1)+180.)/SIDE)))
              JBOX=MAX(1,MIN(NBOX,1+INT((FLTS(I  )+ 90.)/SIDE)))
              IHIT(IBOX,JBOX)=IHIT(IBOX,JBOX)+1
              IF (I.EQ.5) THEN
                CALL FRSTPT (FLTS(I+1),FLTS(I))
              ELSE
                CALL VECTOR (FLTS(I+1),FLTS(I))
              END IF
  106       CONTINUE
            GO TO 105
          END IF
C
C Draw the frame summarizing the results.
C
          NNEB=0
          NMST=0
          NAVG=0
C
          DO 108 IBOX=1,MBOX
            DO 107 JBOX=1,NBOX
              IF (IHIT(IBOX,JBOX).NE.0) THEN
                NNEB=NNEB+1
                IF (IHIT(IBOX,JBOX).GT.NMST) NMST=IHIT(IBOX,JBOX)
                NAVG=NAVG+IHIT(IBOX,JBOX)
                CALL SFLUSH
                CALL GSPLCI (3)
                CALL FRSTPT (-180.+REAL(IBOX-1)*SIDE,
     +                        -90.+REAL(JBOX-1)*SIDE)
                CALL VECTOR (-180.+REAL(IBOX  )*SIDE,
     +                        -90.+REAL(JBOX-1)*SIDE)
                CALL VECTOR (-180.+REAL(IBOX  )*SIDE,
     +                        -90.+REAL(JBOX  )*SIDE)
                CALL VECTOR (-180.+REAL(IBOX-1)*SIDE,
     +                        -90.+REAL(JBOX  )*SIDE)
                CALL VECTOR (-180.+REAL(IBOX-1)*SIDE,
     +                        -90.+REAL(JBOX-1)*SIDE)
                WRITE (CTFN,'(I10)') IHIT(IBOX,JBOX)
                CALL PLCHLQ (-180.+(REAL(IBOX)-.5)*SIDE,
     +                        -90.+(REAL(JBOX)-.5)*SIDE,
     +                       CTFN(IOFNBC(CTFN):IOLNBC(CTFN)),
     +                       CHSZ,0.,0.)
              END IF
  107       CONTINUE
  108     CONTINUE
C
          NAVG=NAVG/(NNEB)
C
          CALL SFLUSH
          CALL GSPLCI (1)
C
C Put some labels at the top of the plot.
C
          WRITE (CTFN,'(I10)') IFRA
          CTFT='FRAME '//CTFN(IOFNBC(CTFN):IOLNBC(CTFN))
          WRITE (CTFN,'(I10)') MBOX
          CTFT=CTFT(IOFNBC(CTFT):IOLNBC(CTFT))//': '//
     +         CTFN(IOFNBC(CTFN):IOLNBC(CTFN))
          WRITE (CTFN,'(I10)') NBOX
C         CTFT=CTFT(IOFNBC(CTFT):IOLNBC(CTFT))//'!F1!X!F0!'//
          CTFT=CTFT(IOFNBC(CTFT):IOLNBC(CTFT))//'X'//
     +         CTFN(IOFNBC(CTFN):IOLNBC(CTFN))
          WRITE (CTFN,'(F10.3)') SIDE
          DO 109 I=IOLNBC(CTFN),IOFNBC(CTFN),-1
            IF (CTFN(I:I).EQ.'0') THEN
              CTFN(I:I)=' '
            ELSE IF (CTFN(I:I).EQ.'.') THEN
              CTFN(I:I)=' '
              GO TO 110
            ELSE
              GO TO 110
            END IF
  109     CONTINUE
  110     CTFT=CTFT(IOFNBC(CTFT):IOLNBC(CTFT))//' BOXES, EACH '//
     +         CTFN(IOFNBC(CTFN):IOLNBC(CTFN))//' DEGREES ON A SIDE.'
          CALL PLCHLQ (CFUX(.5),CFUY(.964),
     +                 CTFT(IOFNBC(CTFT):IOLNBC(CTFT)),
     +                 .016,0.,0.)
          WRITE (CTFN,'(I10)') NNEB
          CTFT='THERE ARE '//CTFN(IOFNBC(CTFN):IOLNBC(CTFN))//
     +         ' NON-EMPTY BOXES.'
          CALL PLCHLQ (CFUX(.5),CFUY(.932),
     +                 CTFT(IOFNBC(CTFT):IOLNBC(CTFT)),
     +                 .016,0.,0.)
          WRITE (CTFN,'(I10)') NMST
          CTFT='THERE ARE '//CTFN(IOFNBC(CTFN):IOLNBC(CTFN))//
     +         ' POINTS IN THE BOX WITH THE MOST.'
          CALL PLCHLQ (CFUX(.5),CFUY(.900),
     +                 CTFT(IOFNBC(CTFT):IOLNBC(CTFT)),
     +                 .016,0.,0.)
          WRITE (CTFN,'(I10)') NAVG
          CTFT='THERE ARE '//CTFN(IOFNBC(CTFN):IOLNBC(CTFN))//
     +         ' POINTS IN THE AVERAGE NON-EMPTY BOX.'
          CALL PLCHLQ (CFUX(.5),CFUY(.868),
     +                 CTFT(IOFNBC(CTFT):IOLNBC(CTFT)),
     +                 .016,0.,0.)
C
C Advance the frame.
C
          CALL FRAME
C
C End of frame loop.
C
  111   CONTINUE
C
C Close GKS.
C
        CALL GDAWK (IWID)
        CALL GCLWK (IWID)
        CALL GCLKS
C
C Close the input file.
C
        CLOSE (1,ERR=903)
C
C Normal exit.
C
        STOP
C
C Error exits.
C
  901   PRINT * , 'ERROR - Input file name is blank.'
        STOP
C
  902   PRINT * , 'ERROR - Couldn''t open input file.'
        STOP
C
  903   PRINT * , 'ERROR - Couldn''t close input file.'
        STOP
C
  904   PRINT * , 'ERROR - FORTRAN error on READ of input file.'
        STOP
C
  905   PRINT * , 'ERROR - Unexpected EOF on READ of input file.'
        STOP
C
      END



      INTEGER FUNCTION IOFNBC (CHRS)
C
        CHARACTER*(*) CHRS
C
C The value of IOFNBC(CHRS) is the index of the first non-blank
C character in the character string CHRS.
C
        DO 101 I=1,LEN(CHRS),1
          IF (CHRS(I:I).NE.' ') THEN
            IOFNBC=I
            RETURN
          END IF
  101   CONTINUE
C
        IOFNBC=1
C
        RETURN
C
      END



      INTEGER FUNCTION IOLNBC (CHRS)
C
        CHARACTER*(*) CHRS
C
C The value of IOLNBC(CHRS) is the index of the last non-blank
C character in the character string CHRS.
C
        DO 101 I=LEN(CHRS),1,-1
          IF (CHRS(I:I).NE.' ') THEN
            IOLNBC=I
            RETURN
          END IF
  101   CONTINUE
C
        IOLNBC=1
C
        RETURN
C
      END
