C (C) Copyright 1996-2016 ECMWF.
C 
C This software is licensed under the terms of the Apache Licence Version 2.0
C which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. 
C In applying this licence, ECMWF does not waive the privileges and immunities 
C granted to it by virtue of its status as an intergovernmental organisation nor
C does it submit to any jurisdiction.
C

      PROGRAM CONT08
C
C     THIS PROGRAM DEMONSTRATES MAGICS CONTOUR SHADING TECHNIQUES AND METHODS.
C     THERE ARE THREE TECHNIQUES - POLYGON_SHADING, MARKER and CELL_SHADING.
C     POLYGON SHADING HAS THREE METHODS - DOT, HATCH and AREA_FILL (SOLID).
C     THE AREA SELECTED IS A POLAR STEREOGRAPHIC ATLANTIC/EUROPEAN AREA AND THE
C     DATA TO BE CONTOURED/SHADED IS A MSL FIELD IN GRIB CODE.
C
C     OPEN MAGICS
C
      DIMENSION CONLIS (7)
      DATA CONLIS /450.0, 490.0, 520., 550., 565., 580., 620.0/
      CALL POPEN
      CALL PARSE_COMMAND_LINE ('cont08')
      CALL PSETC ('PAGE_ID_LINE_USER_TEXT', 'TESTS/CONT08')
C
C     SELECT THE PROJECTION AND AREA AND PASS DATA TO MAGICS
C
      CALL PSETC ('SUBPAGE_MAP_PROJECTION', 'POLAR_STEREOGRAPHIC')
      CALL PSETC ('SUBPAGE_MAP_AREA_DEFINITION', 'CENTRE')
      CALL PSETR ('SUBPAGE_MAP_CENTRE_LATITUDE', 40.0)
      CALL PSETR ('SUBPAGE_MAP_CENTRE_LONGITUDE', -20.0)
      CALL PSETR ('SUBPAGE_MAP_SCALE', 35.E6)
      CALL PSETC ('GRIB_INPUT_TYPE', 'FILE')
      CALL PSETC ('GRIB_INPUT_FILE_NAME', 'z500.grb')
      CALL PGRIB
C
C     SET GENERAL MAGICS PARAMETERS
C
      CALL PSETC ('CONTOUR_HILO', 'OFF')
      CALL PSETC ('CONTOUR_SHADE', 'ON')
      CALL PSETC ('LEGEND', 'ON')
      CALL PSETC ('CONTOUR_HIGHLIGHT', 'OFF')
      CALL PSETC ('CONTOUR_LINE_COLOUR', 'BLACK')
      CALL PSETC ('CONTOUR_LEVEL_SELECTION_TYPE', 'LEVEL_LIST')
      CALL PSET1R ('CONTOUR_LEVEL_LIST', CONLIS, 7)
      CALL PSETI ('CONTOUR_LABEL_FREQUENCY', 1)
      CALL PSETC ('MAP_GRID', 'OFF')
      CALL PSETC ('MAP_LABEL', 'OFF')
      CALL PSETC ('MAP_COASTLINE_COLOUR', 'BLACK')
      CALL PSETC ('TEXT_JUSTIFICATION', 'CENTRE')
      CALL PSETR ('TEXT_REFERENCE_CHARACTER_HEIGHT', 1.25)
C
C     FIRST MAP - TECHNIQUE: POLYGON, METHOD: AREA_FILL
C
      CALL CONT08_ONE
      CALL PNEW ('PAGE')
C
C     SECOND MAP - TECHNIQUE: POLYGON, METHOD: DOT
C
      CALL CONT08_TWO
      CALL PNEW ('PAGE')
C
C     THIRD MAP - TECHNIQUE: POLYGON, METHOD: HATCH
C
      CALL CONT08_THREE
      CALL PNEW ('PAGE')
C
C     FOURTH MAP - TECHNIQUE: CELL_SHADING (DEFAULT)
C
      CALL CONT08_FOUR
      CALL PNEW ('PAGE')
C
C     FIVTH MAP - TECHNIQUE: CELL_SHADING (DIFFERENT METHOD AND RESOLUTION)
C
      CALL CONT08_FIVE
      CALL PNEW ('PAGE')    
C
C     SIXTH MAP - TECHNIQUE: MARKER
C
      CALL CONT08_SIX

      CALL PCLOSE
      STOP
      END    
    






      SUBROUTINE CONT08_ONE
C
C     THIS ROUTINE USES POLYGON SHADING TECHNIQUE WITH 'DOT' METHOD
C
C     PLOT THE SHADED CONTOURS
C
      CALL PSETC ('CONTOUR_SHADE_TECHNIQUE', 'POLYGON_SHADING')   
      CALL PSETC ('CONTOUR_SHADE_METHOD', 'DOT')
      CALL PSETR ('CONTOUR_SHADE_DOT_SIZE', 0.045)     
      CALL PCONT
C
C     PLOT THE COASTLINES
C
      CALL PCOAST
C
C     PLOT TITLE TEXT
C
      CALL PSETI ('TEXT_LINE_COUNT', 1)
      CALL PSETC ('TEXT_LINE_1',
     X'CONTOUR_SHADE_TECHNIQUE= POLYGON '//
     x    '    SHADE_METHOD= DOT')
      CALL PTEXT
      RETURN
      END
      SUBROUTINE CONT08_TWO
C
C     THIS ROUTINE USES POLYGON SHADING TECHNIQUE WITH 'HATCH' METHOD
C
C     PLOT THE SHADED CONTOURS
C
      CALL PSETC ('CONTOUR_SHADE_TECHNIQUE', 'POLYGON_SHADING')   
      CALL PSETC ('CONTOUR_SHADE_METHOD', 'HATCH') 
      CALL PCONT
C
C     PLOT THE COASTLINES
C
      CALL PCOAST
C
C     PLOT TITLE TEXT
C
      CALL PSETC ('TEXT_LINE_1',
     X'CONTOUR_SHADE_TECHNIQUE= POLYGON '//
     x    '    SHADE_METHOD= HATCH')
      CALL PTEXT
      RETURN
      END
      SUBROUTINE CONT08_THREE

C
C     THIS ROUTINE USES POLYGON SHADING TECHNIQUE WITH 'REA_FILL' METHOD
C
C     PLOT THE SHADED CONTOURS
C
      CALL PSETC ('CONTOUR_SHADE_TECHNIQUE', 'POLYGON_SHADING')   
      CALL PSETC ('CONTOUR_SHADE_METHOD', 'AREA_FILL')   
      CALL PCONT
C
C     PLOT THE COASTLINES
C
      CALL PCOAST
C
C     PLOT TITLE TEXT
C
      CALL PSETC ('TEXT_LINE_1',
     X'CONTOUR_SHADE_TECHNIQUE= POLYGON '//   
     x   '    SHADE_METHOD = AREA_FILL')
      CALL PTEXT
      RETURN
      END

      SUBROUTINE CONT08_FOUR
C
C     THIS ROUTINE USES CELL SHADING TECHNIQUE,  DEFAULT CELL_METHOD = 'INTERPOLATE'
C     DEFAULT CELL_RESOLUTION = 10.0 
C
C     PLOT THE SHADED CONTOURS - DEFAULT CELL_METHOD = 'INTERPOLATE'
C     DEFAULT CELL_RESOLUTION = 10.0
C
      CALL PSETC ('CONTOUR_SHADE_TECHNIQUE', 'CELL_SHADING')
      CALL PSETR ('CONTOUR_SHADE_CELL_RESOLUTION', 1.0)
      CALL PCONT
C
C     PLOT THE COASTLINES
C
      CALL PCOAST
C
C     PLOT TITLE TEXT
C
      CALL PSETC ('TEXT_LINE_1',
     X'CONTOUR_SHADE_TECHNIQUE = CELL_SHADING                ')
      CALL PSETC ('TEXT_LINE_2',
     X'CELL_METHOD = INTERPOLATE , CELL RESOLOUTION = 10.0  ')
      CALL PSETI ('TEXT_LINE_COUNT', 2)
      CALL PTEXT
      RETURN
      END
      SUBROUTINE  CONT08_FIVE
C
C     THIS ROUTINE USES CELL SHADING TECHNIQUE,  CELL_METHOD = 'NEAREST'
C     DEFAULT CELL_RESOLUTION = 20.0
C
C     PLOT THE SHADED CONTOURS  
C
      CALL PSETC ('CONTOUR_SHADE_TECHNIQUE', 'CELL_SHADING')  
      CALL PSETC ('CONTOUR_SHADE_CELL_METHOD', 'NEAREST')
      CALL PSETR ('CONTOUR_SHADE_CELL_RESOLUTION', 20.0) 
      CALL PCONT
C
C     PLOT THE COASTLINES
C
      CALL PCOAST
C
C     PLOT TITLE TEXT
C
      CALL PSETC ('TEXT_LINE_1',
     X'CONTOUR_SHADE_TECHNIQUE = CELL_SHADING                ')
      CALL PSETC ('TEXT_LINE_2',
     X'CELL_METHOD = NEAREST, CELL RESOLOUTION = 20.0  ')
      CALL PSETI ('TEXT_LINE_COUNT', 2)
      CALL PTEXT
      RETURN
      END
      SUBROUTINE CONT08_SIX
      CHARACTER*32 COLTAB
      DIMENSION  HGTAB(6), MARTAB(6)
      DATA MARTAB /3, 5, 7, 9, 15, 18/
      DATA HGTAB /0.22, 0.23, 0.21, 0.18, 0.17, 0.15/
C
C     CYLINDICAL AREA FOR MARKER SHADING TO AVOID CONGESTION
C
      CALL PSETC ('SUBPAGE_MAP_PROJECTION', 'CYLINDRICAL')
      CALL PSETR ('SUBPAGE_LOWER_LEFT_LATITUDE', 20.0)    
      CALL PSETR ('SUBPAGE_LOWER_LEFT_LONGITUDE', -30.0)    
      CALL PSETR ('SUBPAGE_UPPER_RIGHT_LATITUDE', 70.0)    
      CALL PSETR ('SUBPAGE_UPPER_RIGHT_LONGITUDE', 40.0)    
C
C     THIS ROUTINE USES MARKER SHADING TECHNIQUE 
C
C     EACH SHADING LEVEL WILL HAVE A DIFFERENT MARKER SYMBOL, HEIGHT AND COLOUR
C     - DEFINED BY THE TABLES MARTAB, HGTAB AND COLTAB
C     6 SHADING LEVELS REQUIRED DEFINED PREVIOUSLY
C
      CALL PSET1I ('CONTOUR_SHADE_MARKER_TABLE', MARTAB, 6)
      CALL PSET1R ('CONTOUR_SHADE_HEIGHT_TABLE', HGTAB, 6)
C
C     PLOT THE SHADED CONTOURS
C
      CALL PSETC ('CONTOUR_SHADE_TECHNIQUE', 'MARKER')   
      CALL PCONT
C
C     PLOT THE COASTLINES
C
      CALL PCOAST
C
C     PLOT TITLE TEXT
C
      CALL PSETC ('TEXT_LINE_1',
     X'CONTOUR_SHADE_TECHNIQUE = MARKER -  VARIOUS MARKERS AND HEIGHTS')
      CALL PSETI ('TEXT_LINE_COUNT', 1)
      CALL PTEXT
      RETURN
      END


C --------------------------------------------------------------------
C     PARSE_COMMAND_LINE
C     Checks the command-line for any arguments.
C     Arguments can come in pairs. Currently supported arguments are:
C     PROJECTION <CYLINDRICAL | POLAR_STEREOGRAPHIC>
C     DEVICE <PS | SVG | PNG>
C     e.g. Run the program with:
C       <progname> PROJECTION CYLINDRICAL  DEVICE SVG
C --------------------------------------------------------------------

      SUBROUTINE PARSE_COMMAND_LINE (OUTROOTNAME)

      CHARACTER*32 ARG
      CHARACTER*64 ID_TEXT
      CHARACTER*32 PROJECTION
      CHARACTER*32 DEVICE
      CHARACTER*48 EXENAME
      CHARACTER*8  MINIMAL
      CHARACTER*8  SEPARATOR
      CHARACTER*64 OUTNAME
      CHARACTER*(*) OUTROOTNAME

      CHARACTER*16 FORMATS_PS_GIF
      DIMENSION    FORMATS_PS_GIF(2)
      DATA         FORMATS_PS_GIF /'PS', 'GIF_ANIMATION'/

      CHARACTER*16 FORMATS_PS_GIF_PDF
      DIMENSION    FORMATS_PS_GIF_PDF(3)
      DATA         FORMATS_PS_GIF_PDF /'PS', 'GIF_ANIMATION', 'PDF'/

      CHARACTER*16 FORMATS_PS_GIF_SVG
      DIMENSION    FORMATS_PS_GIF_SVG(3)
      DATA         FORMATS_PS_GIF_SVG /'PS', 'GIF_ANIMATION', 'SVG'/

      CHARACTER*16 FORMATS_PS_PNG_SVG
      DIMENSION    FORMATS_PS_PNG_SVG(3)
      DATA         FORMATS_PS_PNG_SVG /'PS', 'PNG', 'SVG'/

      CHARACTER*16 FORMATS_PS_GIF_PNG_SVG
      DIMENSION    FORMATS_PS_GIF_PNG_SVG(4)
      DATA         FORMATS_PS_GIF_PNG_SVG /'PS', 'GIF_ANIMATION', 
     +                                     'PNG', 'SVG'/

      CHARACTER*16 FORMATS_ALL
      DIMENSION    FORMATS_ALL(5)
      DATA         FORMATS_ALL /'PS', 'SVG', 'PDF',
     +                          'KML', 'PNG'/

      INTEGER NUM_ARGS
      INTEGER DEVICE_SET

      DEVICE_SET = 0

      ID_TEXT = ''

      NUM_ARGS = IARGC()

      I = 1
C
C  Start GoTo
C
20    IF (I.LE.NUM_ARGS) THEN
          CALL GETARG ( I, ARG )
C
C         Set the projection?
C
          IF (ARG.EQ.'PROJECTION') THEN
              I = I + 1 
              CALL GETARG ( I, PROJECTION ) 
              CALL PSETC ('SUBPAGE_MAP_PROJECTION', PROJECTION)
C
C        Set the device?
C
          ELSEIF (ARG.EQ.'DEVICE') THEN
              I = I + 1 
              CALL GETARG ( I, DEVICE ) 

C             Set the output filename

              IF     (DEVICE.EQ.'PS')  THEN
                OUTNAME = OUTROOTNAME //   '.ps'
                CALL PSETC ('DEVICE',       DEVICE)
                CALL PSETC ('PS_DEVICE',   'ps_a4')
                CALL PSETC ('PS_FILE_NAME', OUTNAME)
              ELSEIF (DEVICE.EQ.'PS_NEW') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'PS')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'EPS') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'EPS')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'GIF') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'GIF_ANIMATION')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)
                CALL PSETI ('OUTPUT_GIF_DELAY',     150)
              ELSEIF (DEVICE.EQ.'GIF_MULTI') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'GIF')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'PNG') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'PNG')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'JPEG') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'JPEG')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'SVG') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'SVG')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'CSVG') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'CSVG')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'KML') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'KML')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)

              ELSEIF (DEVICE.EQ.'BAD') THEN
                CALL PSETC ('OUTPUT_FORMAT',  'BAD')
                CALL PSETC ('OUTPUT_NAME', OUTROOTNAME)

              ELSEIF (DEVICE.EQ.'PS_GIF') THEN
                CALL PSET1C ('OUTPUT_FORMATS', FORMATS_PS_GIF, 2)
                CALL PSETC  ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'PS_GIF_PDF') THEN
                CALL PSET1C ('OUTPUT_FORMATS', FORMATS_PS_GIF_PDF, 3)
                CALL PSETC  ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'PS_GIF_SVG') THEN
                CALL PSET1C ('OUTPUT_FORMATS', FORMATS_PS_GIF_SVG, 3)
                CALL PSETC  ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'PS_PNG_SVG') THEN
                CALL PSET1C ('OUTPUT_FORMATS', FORMATS_PS_PNG_SVG, 3)
                CALL PSETC  ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'PS_GIF_PNG_SVG') THEN
                CALL PSET1C ('OUTPUT_FORMATS',
     +                               FORMATS_PS_GIF_PNG_SVG, 4)
                CALL PSETC  ('OUTPUT_NAME', OUTROOTNAME)
              ELSEIF (DEVICE.EQ.'ALL') THEN
                CALL PSET1C ('OUTPUT_FORMATS', FORMATS_ALL, 5)
                CALL PSETC  ('OUTPUT_NAME', OUTROOTNAME)
              ELSE
                WRITE(*, '(A)') 'BAD DEVICE: ', DEVICE
              ENDIF
            
            DEVICE_SET = 1
C
C        Split the PostScript pages into separate files?
C
          ELSEIF (ARG.EQ.'PS_SPLIT') THEN
                CALL PSETC ('OUTPUT_PS_SPLIT',     'ON')
C
C        Turn on the numbering for the first page?
C
          ELSEIF (ARG.EQ.'FIRST_PAGE_NUMBER') THEN
                CALL PSETC ('OUTPUT_NAME_FIRST_PAGE_NUMBER', 'ON')
C
C         Set the minimal filename number width?
C
          ELSEIF (ARG.EQ.'MINIMAL') THEN
              I = I + 1 
              CALL GETARG (I, MINIMAL) 
              IF     (MINIMAL.EQ.'0')  THEN
                CALL PSETI ('OUTPUT_FILE_MINIMAL_WIDTH', 0)
              ELSEIF (MINIMAL.EQ.'1')  THEN
                CALL PSETI ('OUTPUT_FILE_MINIMAL_WIDTH', 1)
              ELSEIF (MINIMAL.EQ.'2') THEN
                CALL PSETI ('OUTPUT_FILE_MINIMAL_WIDTH', 2)
              ELSEIF (MINIMAL.EQ.'3') THEN
                CALL PSETI ('OUTPUT_FILE_MINIMAL_WIDTH', 3)
              ENDIF
C
C         Set the file number separator?
C
          ELSEIF (ARG.EQ.'SEP') THEN
              I = I + 1 
              CALL GETARG ( I, SEPARATOR ) 
              CALL PSETC ('OUTPUT_FILE_SEPARATOR', SEPARATOR)
C
C        Run using linear contouring?
C
          ELSEIF (ARG.EQ.'LINEAR') THEN
                CALL PSETC ('CONTOUR_METHOD', 'LINEAR')
                CALL PSETC ('PAGE_ID_LINE_USER_TEXT_PLOT', 'ON')
                CALL PSETC ('PAGE_ID_LINE_USER_TEXT', 'LINEAR')
          ENDIF
          I = I + 1 
          GOTO 20
      ENDIF
C
C     If no device has been set, then use PostScript by default
C
      IF (DEVICE_SET.EQ.0) THEN
        OUTNAME = OUTROOTNAME // '.ps'
        CALL PSETC ('PS_DEVICE',    'ps_a4')
        CALL PSETC ('PS_FILE_NAME', OUTNAME)
      ENDIF
C
      END
