
      PROGRAM WRARNC
C
C This program reads the area file for a specified EZMAP outline dataset
C and creates an NCGM containing plots of the data.
C
C The grid points involved are as follows:  First, the grid is divided
C into two halves - the left half and the right half - each of which is
C a square.  The center points of each half are used.  Then, each of
C those halves is subdivided into four square quarters and the eight
C center points of those are used.  Then, each of the eight squares is
C subdivided into four square quarters and the thirty-two center points
C of those are used.  At each subsequent step, the squares from the
C previous step are subdivided into four smaller squares and the center
C points of those squares are used.  This order tends to minimize the
C number of points that have to be examined in order to find one giving
C the desired information: one looks first at a very coarse grid, then
C at a finer one, then at a still finer one, and so on.
C
C The area identifiers are written in such a way as to keep the file
C small: each entry is just a pair of numbers, "m" and "n", interpreted
C to mean "m repetitions of the area identifier n", and there are no
C carriage returns.
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 Declare the number of subdivisions to be carried out.
C
        PARAMETER (NDIV=13)
C
C Declare how the plots are to be drawn by setting IPLT (1 => use GFA;
C 2 => use GCA).  Note that when IPLT is 2, MROW and MCOL need to be set
C appropriately to provide space for the cell array that will be used;
C just uncomment one of the following statements.  (Cell arrays take
C more memory, but produce a smaller metafile.)
C
C       PARAMETER (IPLT=1,MROW=      1,MCOL=     2)
        PARAMETER (IPLT=2,MROW=2**NDIV,MCOL=2*MROW)
C
C Declare the cell array.
C
        DIMENSION ICRA(MCOL,MROW)
C
C Declare a variable in which to form labels for plots.
C
        CHARACTER*74 LABL
C
C Declare a variable in which to form a file name.
C
        CHARACTER*71 FLNM
C
C Declare an array to use as an input buffer.
C
        CHARACTER*1 CHRS(512)
C
C Get the name of the file to be used and check for error.
C
        PRINT * , ' '
        PRINT * , 'Enter the name of the file to be used:'
        READ (*,'(A64)') FLNM
C
        IF (FLNM.EQ.' ') THEN
          PRINT * , 'ERROR - Input file name is blank.'
          STOP
        END IF
C
        LFNM=MPILNB(FLNM)
C
C Make EZMAPB read the name file for the dataset specified by "FLNM"
C so that we can use calls to retrieve information from it.
C
        CALL MPLNRI (FLNM(1:LFNM))
C
C Open the area file and initialize variables involved in reading it.
C
        FLNM(LFNM+1:LFNM+6)='.areas'
        FLNM(LFNM+7:LFNM+7)=CHAR(0)
C
        CALL NGOFRO (FLNM(1:LFNM+7),IFDE,ISTA)
C
        IF (ISTA.NE.0) THEN
          PRINT * , 'ERROR - Bad status from NGOFRO: ',ISTA
          STOP
        END IF
C
        NTMS=0
        MCHR=0
        NCHR=0
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 Select solid fill by GKS.
C
        CALL GSFAIS (1)
C
C Define some colors.
C
        CALL GSCR   (IWID,0,0.,0.,0.)
        CALL GSCR   (IWID,1,.5,.7,.8)
        CALL GSCR   (IWID,2,.4,.4,.6)
        CALL GSCR   (IWID,3,.2,.6,.5)
        CALL GSCR   (IWID,4,.2,.8,.2)
        CALL GSCR   (IWID,5,.5,.6,.2)
        CALL GSCR   (IWID,6,.6,.4,.2)
        CALL GSCR   (IWID,7,.6,.6,.5)
        CALL GSCR   (IWID,8,.9,1.,1.)
C
C Set the polyline color to black.
C
        CALL GSPLCI (0)
C
C Tell PLOTCHAR to use white characters, in font 25.
C
        CALL PCSETI ('CC - CHARACTER COLOR',7)
        CALL PCSETI ('FN - FONT NUMBER',25)
C
C Tell EZMAP to use a cylindrical equidistant projection and the
C maximal useful area produced by that projection.
C
        CALL MAPROJ ('CE',0.,0.,0.)
        CALL MAPSET ('MA',0.,0.,0.,0.)
C
C Keep EZMAP from dropping out points as it draws the outline.
C
        CALL MAPSTI ('MV - MINIMUM VECTOR LENGTH',1)
C
C Initialize EZMAP.
C
        CALL MAPINT
C
C Loop on the number of times the grid is to be subdivided.
C
        DO 107 IDIV=0,NDIV
C
C Compute the number of rows and columns in the grid at this level of
C subdivision.
C
          NROW=2**IDIV
          NCOL=2*NROW
C
C If plots are being generated, create a label for the plot.
C
          WRITE (LABL,'(''Step '',I2,'' - '',A)') IDIV,FLNM(1:LFNM)
C
C If fill areas are being used, write the label on the plot.
C
          IF (IPLT.EQ.1) CALL PLCHHQ (CFUX(.5),CFUY(.975),
     +                                   LABL(1:MPILNB(LABL)),.02,0.,0.)
C
C Loop through the rows of the grid.  Compute associated latitude (real
C and double-precision).
C
          DO 104 J=1,NROW
C
            RLAT=-90.+(REAL(J)-.5)*(180./REAL(NROW))
C
C Loop through the columns of the grid.  Compute associated longitude.
C
            DO 103 I=1,NCOL
C
              RLON=-180.+(REAL(I)-.5)*(360./REAL(NCOL))
C
C If the last area identifier had been used the correct number of times,
C read a new pair of numbers from the area file (a count and a new area
C identifier).
C
              IF (NTMS.EQ.0) THEN
                CALL MDRDNM (IFDE,CHRS,512,MCHR,NCHR,NTMS)
                IF (MCHR.EQ.0) GO TO 108
                CALL MDRDNM (IFDE,CHRS,512,MCHR,NCHR,IAID)
                IF (MCHR.EQ.0) GO TO 108
              END IF
C
C If fill areas are being used, fill the current grid box.  If a cell
C array is being used, set the value of the appropriate element.
C
              IF (IPLT.EQ.1) THEN
                CALL FILLBX (RLAT,RLON,.5*(360./REAL(NCOL)),IAID)
              ELSE IF (IPLT.EQ.2) THEN
                ICRA(I,J)=MPISCI(IAID)
              END IF
C
C Decrement the counter saying how many times to use the current area
C identifier.
C
              NTMS=NTMS-1
C
C End of loop through columns.
C
  103       CONTINUE
C
C End of loop through rows.
C
  104     CONTINUE
C
C If fill arrays are being used, draw the map outlines, in black, and
C advance the frame.  If a cell array is being used, do one or more
C plots from the cell array, labelling each one and advancing the
C frame after each one.
C
          IF (IPLT.EQ.1) THEN
C           CALL MPLNDR (FLNM(1:LFNM),5)
            CALL PLCHHQ (CFUX(.5),CFUY(.975),LABL(1:MPILNB(LABL)),
     +                                                  .02,0.,0.)
            CALL FRAME
          ELSE IF (IPLT.EQ.2) THEN
            DO 106 JBEG=1,NROW,1024
              JNUM=MIN(1024,NROW-JBEG+1)
              DO 105 IBEG=1,NCOL,1024
                INUM=MIN(1024,NCOL-IBEG+1)
                CALL GCA (CFUX(.05),CFUY(.5-.45*REAL(JNUM)/REAL(INUM)),
     +                    CFUX(.95),CFUY(.5+.45*REAL(JNUM)/REAL(INUM)),
     +                              MCOL,MROW,IBEG,JBEG,INUM,JNUM,ICRA)
                CALL PLCHHQ (CFUX(.5),CFUY(.975),LABL(1:MPILNB(LABL)),
     +                                                      .02,0.,0.)
                CALL FRAME
  105         CONTINUE
  106       CONTINUE
          END IF
C
C End of loop on subdivisions of the grid.
C
  107   CONTINUE
C
C Close the area file.
C
  108   CALL NGCLFI (IFDE)
C
C Close GKS.
C
        CALL GDAWK (IWID)
        CALL GCLWK (IWID)
        CALL GCLKS
C
C Done.
C
        STOP
C
      END



      SUBROUTINE FILLBX (RLAT,RLON,SIZE,IAID)
C
C This routine fills the projection of the current grid box.  First,
C define arrays in which to put box coordinates.
C
        DIMENSION XCRA(4),YCRA(4)
C
C Get user coordinates of the box corners.
C
        CALL MAPTRA (RLAT-SIZE,RLON-SIZE,XCRA(1),YCRA(1))
        CALL MAPTRA (RLAT-SIZE,RLON+SIZE,XCRA(2),YCRA(2))
        CALL MAPTRA (RLAT+SIZE,RLON+SIZE,XCRA(3),YCRA(3))
        CALL MAPTRA (RLAT+SIZE,RLON-SIZE,XCRA(4),YCRA(4))
C
C Determine the color to use.
C
        IF (IAID.LE.0) THEN
          CALL GSFACI (0)
        ELSE
          CALL GSFACI (MPISCI(IAID))
        END IF
C
C Fill the box.
C
        CALL GFA (4,XCRA,YCRA)
C
C Done.
C
        RETURN
C
      END
