      PROGRAM EXAMPL
      PARAMETER (NR1=19,NR2 =15)

      CHARACTER*58 CR0,CR1(NR1),CR2(NR2),CDEV*4,C*1
      COMMON /WDATA/ XRAY(100),Y1RAY(100),Y2RAY(100),ZMAT(50,50)

      DATA CR0/
     *'**********************************************************'/

      DATA CR1/
     *'                      DISLIN-Examples                     ',
     *'                                                          ',
     *'Fortran Demo Program of the Data Plotting Library DISLIN. ',
     *'Author: H. Michels,  Max-Planck-Institut fuer Aeronomie,  ',
     *'                D-37191 Katlenburg-Lindau, Germany        ',
     *'                                                          ',
     *'Device:      defines the metafile.                        ',
     *'   = CONS    VGA screen output.                           ',
     *'   = GKSL    A GKSLIN metafile will be created.           ',
     *'   = CGM     A CGM metafile will be created.              ',
     *'   = PS      a PostScript file will created.              ',
     *'   = EPS     an EPS file will created.                    ',
     *'   = PDF     a PDF file will created.                     ',
     *'   = HPGL    A HPGL file will be created.                 ',
     *'   = SVG     A SVG file will be created.                  ',
     *'   = WMF     a Windows metafile will be created.          ',
     *'   = PNG     a PNG file will be created.                  ',
     *'   = TIFF    a TIFF file will be created.                 ',
     *'   = BMP     a BMP file will be created.                  '/

      DATA CR2/
     *'                      DISLIN-Examples                     ',
     *'                                                          ',
     *' 0: Program end                  13: World Coastlines     ',
     *' 1: Demo of Curve                14: Elliptical Proj.     ',
     *' 2: Symbols                      15: Azimuthal Proj.      ',
     *' 3: Logarithmic Axes             16: Conical  Proj.       ',
     *' 4: Interpolation Methods        17: Bar Graphs           ',
     *' 5: Line Styles                  18: Pie Charts           ',
     *' 6: Legend                       19: Contours             ',
     *' 7: Shading Patterns (AREAF)     20: Shaded Contours      ',
     *' 8: Vectors                      21: Instruction Alphabet ',
     *' 9: Shading Patterns (PIEGRF)    22: 3-D Colour Plot      ',
     *'10: Surface Plot                 23: Shaded World         ',
     *'11: Surface Plot                 24: Colour Tables        ',
     *'12: Map Plot                     30: Menue end            '/

10    WRITE(6,'(/4X,3A)')	     '/****',CR0,   '****/'
      WRITE(6,'(4X,3A,18(/4X,3A))') ('/**  ',CR1(I),'  **/',I=1,NR1)
      WRITE(6,'(4X,3A)')	     '/****',CR0,   '****/'

      WRITE(6,'(/4X,A)') '_Device: '
      READ(5,'(A)') CDEV
      IF(CDEV.EQ.' ') GOTO 100

20    WRITE(6,'(/4X,3A)')	     '/****',CR0,   '****/'
      WRITE(6,'(4X,3A,14(/4X,3A))') ('/**  ',CR2(I),'  **/',I=1,NR2)
      WRITE(6,'(4X,3A)')	     '/****',CR0,   '****/'

      WRITE(6,'(/4X,A)') '_Option: '
      READ(5,*) IOPT

      CALL METAFL(CDEV)
      CALL SETPAG('DA4L')

      IF(IOPT.EQ.1) THEN
        CALL EXA_1
      ELSE IF(IOPT.EQ.2) THEN
        CALL EXA_2
      ELSE IF(IOPT.EQ.3) THEN
        CALL EXA_3
      ELSE IF(IOPT.EQ.4) THEN
        CALL EXA_4
      ELSE IF(IOPT.EQ.5) THEN
        CALL EXA_5
      ELSE IF(IOPT.EQ.6) THEN
        CALL EXA_6
      ELSE IF(IOPT.EQ.7) THEN
        CALL EXA_7
      ELSE IF(IOPT.EQ.8) THEN
        CALL EXA_8
      ELSE IF(IOPT.EQ.9) THEN
        CALL EXA_9
      ELSE IF(IOPT.EQ.10) THEN
        CALL EXA_10
      ELSE IF(IOPT.EQ.11) THEN
	CALL EXA_11
      ELSE IF(IOPT.EQ.12) THEN
	CALL EXA_12
      ELSE IF(IOPT.EQ.13) THEN
	CALL EX13_1
      ELSE IF(IOPT.EQ.14) THEN
	CALL EX13_2
      ELSE IF(IOPT.EQ.15) THEN
	CALL EX13_3
      ELSE IF(IOPT.EQ.16) THEN
	CALL EX13_4
      ELSE IF(IOPT.EQ.17) THEN
	CALL EX10_1
      ELSE IF(IOPT.EQ.18) THEN
	CALL EX10_2
      ELSE IF(IOPT.EQ.19) THEN
	CALL EX14_1
      ELSE IF(IOPT.EQ.20) THEN
	CALL EX14_2
      ELSE IF(IOPT.EQ.21) THEN
	CALL EX6_1
      ELSE IF(IOPT.EQ.22) THEN
	CALL EX11_1
      ELSE IF(IOPT.EQ.23) THEN
	CALL EXA_13
      ELSE IF(IOPT.EQ.24) THEN
	CALL EXA_14
      ELSE IF(IOPT.EQ.30) THEN
	GOTO 10
      ELSE IF(IOPT.EQ.0) THEN
	GOTO 100
      END IF

      WRITE(6,'(4X,A)') 'Press RETURN to continue ...'
      READ(5,'(A)') C
      IF((C.EQ.'Q').OR.(C.EQ.'q')) STOP
      GOTO 20

100   CONTINUE
      END

      SUBROUTINE EXA_1
      PARAMETER (N=100)
      COMMON /WDATA/ XRAY(100),Y1RAY(100),Y2RAY(100),ZMAT(50,50)

      PI=3.1415926
      FPI=PI/180.
      STEP=360./(N-1)

      DO I=1,N
        XRAY(I)=(I-1)*STEP
        X=XRAY(I)*FPI
        Y1RAY(I)=SIN(X)
        Y2RAY(I)=COS(X)
      END DO

      CALL DISINI
      CALL PAGERA
      CALL COMPLX
      CALL AXSPOS(450,1800)
      CALL AXSLEN(2200,1200)

      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')

      CALL LABDIG(-1,'X')
      CALL TICKS(10,'XY')

      CALL TITLIN('Demonstration of CURVE',1)
      CALL TITLIN('SIN(X), COS(X)',3)

      CALL GRAF(0.,360.,0.,90.,-1.,1.,-1.,0.5)
      CALL TITLE

      CALL COLOR('RED')
      CALL CURVE(XRAY,Y1RAY,N)
      CALL COLOR('GREEN')
      CALL CURVE(XRAY,Y2RAY,N)

      CALL COLOR('WHITE')
      CALL DASH
      CALL XAXGIT

      CALL DISFIN
      END

      SUBROUTINE EXA_2
      CHARACTER*20 CTIT,CSTR*2
      CTIT='Symbols'

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COLOR('YELLOW')
      CALL COMPLX
      CALL PAGHDR('H. Michels  (',')',2,0)

      CALL HEIGHT(60)

      NL=NLMESS(CTIT)
      CALL MESSAG(CTIT,(2100-NL)/2,200)

      CALL HEIGHT(50)
      CALL HSYMBL(120)

      NY=150

      DO I=0,21
        IF(MOD(I,4).EQ.0) THEN
          NY=NY+400
          NXP=550
        ELSE
          NXP=NXP+350
        END IF

        IF(I.LT.10) THEN
          WRITE(CSTR,'(I1)') I
        ELSE
          WRITE(CSTR,'(I2)') I
        END IF

        NL=NLMESS(CSTR)/2
        CALL MESSAG(CSTR,NXP-NL,NY+150)
        CALL SYMBOL(I,NXP,NY)
      END DO

      CALL DISFIN
      END

      SUBROUTINE EXA_3
      CHARACTER*60 CTIT,CLAB(3)*5
      DATA CLAB/'LOG','FLOAT','ELOG '/

      CTIT='Logarithmic Scaling'

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX

      CALL AXSLEN(1400,500)
      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')
      CALL AXSSCL('LOG','XY')

      CALL TITLIN(CTIT,2)

      DO I=1,3
        NYA=2650-(I-1)*800
        CALL LABDIG(-1,'XY')
        IF(I.EQ.2)THEN
          CALL LABDIG(1,'Y')
          CALL NAME(' ','X')
        END IF

        CALL AXSPOS(500,NYA)
        CALL COLOR('YELLOW')
        CALL MESSAG('Labels: '//CLAB(I),600,NYA-400)
        CALL COLOR('WHITE')
        CALL LABELS(CLAB(I),'XY')
        CALL GRAF(0.,3.,0.,1.,-1.,2.,-1.,1.)

        IF(I.EQ.3) THEN
          CALL HEIGHT(50)
          CALL TITLE
        END IF

        CALL ENDGRF
      END DO

      CALL DISFIN
      END

      SUBROUTINE EXA_4

      DIMENSION X(16), Y(16)
      CHARACTER*8 CPOL(6),CTIT*60

      DATA X/0.,1.,3.,4.5,6.,8.,9.,11.,12.,12.5,13.,15.,16.,
     *         17.,19.,20./
     *     Y/2.,4.,4.5,3.,1.,7.,2.,3.,5.,2.,2.5,2.,4.,6.,5.5,4./
     *     CPOL/'SPLINE','STEM','BARS','STAIRS','STEP','LINEAR'/
     *     NYA/2700/

      CTIT='Interpolation Methods'

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL COMPLX
      CALL PAGERA
      CALL INCMRK(1)
      CALL HSYMBL(25)
      CALL TITLIN(CTIT,1)
      CALL AXSLEN(1500,350)
      CALL SETGRF('LINE','LINE','LINE','LINE')

      DO I=1,6
        CALL AXSPOS(350,NYA-(I-1)*350)
        CALL POLCRV(CPOL(I))
        CALL MARKER(0)

        CALL GRAF(0.,20.,0.,5.,0.,10.,0.,5.)
        NX=NXPOSN(1.)
	NY=NYPOSN(8.)
	CALL COLOR('YELLOW')
        CALL MESSAG(CPOL(I),NX,NY)
	CALL CURVE(X,Y,16)
	CALL COLOR('WHITE')

        IF(I.EQ.6) THEN
          CALL HEIGHT(50)
          CALL TITLE
        END IF
        CALL ENDGRF
      END DO

      CALL DISFIN
      END

      SUBROUTINE EXA_5
      DIMENSION X(2),Y(2)
      CHARACTER*6 CTYP(8)
      DATA X/3.,9./CTYP/'SOLID','DOT','DASH','CHNDSH',
     *                        'CHNDOT','DASHM','DOTL','DASHL'/

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL CENTER
      CALL CHNCRV('BOTH')
      CALL COMPLX

      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')

      CALL TITLIN('Demonstration of CURVE',1)
      CALL TITLIN('Line Styles',3)

      CALL GRAF(0.,10.,0.,2.,0.,10.,0.,2.)
      CALL TITLE

      DO I=1,8
        Y(1)=9.5-I
        Y(2)=9.5-I
        NY=NYPOSN(Y(1))
        NX=NXPOSN(1.0)
        CALL MESSAG(CTYP(I),NX,NY-20)
        CALL CURVE(X,Y,2)
      END DO

      CALL DISFIN
      END

      SUBROUTINE EXA_6
      PARAMETER(N=100)
      COMMON /WDATA/ XRAY(100),Y1RAY(100),Y2RAY(100),ZMAT(50,50)
      CHARACTER*14 CBUF

      FPI=3.1415926/180.
      STEP=360./(N-1)
      DO I=1,N
        XRAY(I)=(I-1)*STEP
        X=XRAY(I)*FPI
        Y1RAY(I)=SIN(X)
        Y2RAY(I)=COS(X)
      END DO

      CALL DISINI
      CALL COMPLX
      CALL PAGERA

      CALL AXSPOS(450,1800)
      CALL AXSLEN(2200,1200)

      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')
      CALL LABDIG(-1,'X')
      CALL TICKS(10,'XY')

      CALL TITLIN('Demonstration of CURVE',1)
      CALL TITLIN('Legend',3)

      CALL GRAF(0.,360.,0.,90.,-1.,1.,-1.,0.5)
      CALL TITLE
      CALL XAXGIT

      CALL CHNCRV('BOTH')
      CALL CURVE(XRAY,Y1RAY,N)
      CALL CURVE(XRAY,Y2RAY,N)

C     Statements for the legend
      CALL LEGINI(CBUF,2,7)
      NX=NXPOSN(190.)
      NY=NYPOSN(0.75)
      CALL LEGPOS(NX,NY)
      CALL LEGLIN(CBUF,'sin (x)',1)
      CALL LEGLIN(CBUF,'cos (x)',2)
      CALL LEGTIT('Legend')
      CALL LEGEND(CBUF,3)

      CALL DISFIN
      END

      SUBROUTINE EXA_7
      DIMENSION IXP(4),IYP(4),IX(4),IY(4)
      CHARACTER*60 CTIT,CSTR*2
      DATA IX/0,300,300,0/IY/0,0,400,400/

      CTIT='Shading Patterns (AREAF)'

      CALL DISINI
      CALL SETVLT('SMALL')
      CALL PAGERA
      CALL COMPLX

      CALL HEIGHT(50)
      NL=NLMESS(CTIT)
      NX=(2970-NL)/2
      CALL MESSAG(CTIT,NX,200)

      NX0=335
      NY0=350

      DO I=1,3
        NY=NY0+(I-1)*600
        DO J=1,6
          ICLR=(I-1)*6+J-1
          ICLR=MOD(ICLR,8)
          IF(ICLR.EQ.0) ICLR=8
	  CALL SETCLR(ICLR)
          NX=NX0+(J-1)*400
          II=(I-1)*6+J-1
          CALL SHDPAT(II)
          WRITE(CSTR,'(I2)') II

          DO K=1,4
            IXP(K)=IX(K)+NX
            IYP(K)=IY(K)+NY
          END DO
          CALL AREAF(IXP,IYP,4)

          NL=NLMESS(CSTR)
          NX=NX+(300-NL)/2
          CALL MESSAG(CSTR,NX,NY+460)
        END DO
      END DO

      CALL DISFIN
      END

      SUBROUTINE EXA_8
      DIMENSION IVEC(20)
      CHARACTER*60 CTIT,CNUM*4
      DATA IVEC/0,1111,1311,1421,1531,1701,1911,3111,3311,3421,
     *           3531,3703,4221,4302,4413,4522,4701,5312,5502,5703/

      CTIT='Vectors'

      CALL DISINI
      CALL COLOR('CYAN')
      CALL PAGERA
      CALL COMPLX

      CALL HEIGHT(60)
      NL=NLMESS(CTIT)
      NX=(2970-NL)/2
      CALL MESSAG(CTIT,NX,200)

      CALL HEIGHT(50)
      NX=300
      NY=400

      DO I=1,20
        IF(I.EQ.11) THEN
          NX=NX+2970/2
          NY=400
        END IF

        WRITE(CNUM,'(I4)') IVEC(I)
        NL=NLMESS(CNUM)
        CALL MESSAG(CNUM,NX-NL,NY-25 )

        CALL VECTOR(NX+100,NY,NX+1000,NY,IVEC(I))
        NY=NY+160
      END DO

      CALL DISFIN
      END

      SUBROUTINE EXA_9
      DIMENSION XRAY(18)
      CHARACTER*60 CTIT,CBUF*36,CSTR*2
      DATA XRAY/18*1./

      CTIT='Shading Patterns (PIEGRF)'

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX

      CALL AXSPOS(250,2700)
      CALL AXSLEN(1600,2200)
      CALL TITLIN(CTIT,3)
      CALL HEIGHT(50)

      CALL LEGINI(CBUF,18,2)

      DO I=1,18
        WRITE(CSTR,'(I2)') I-1
        CALL LEGLIN(CBUF,CSTR,I)
      END DO

      CALL CHNPIE('BOTH')
      CALL LABELS('NONE','PIE')
      CALL PIEGRF(CBUF,1,XRAY,18)
      CALL TITLE

      CALL DISFIN
      END

      SUBROUTINE EXA_10
      PARAMETER (N=50)
      COMMON /WDATA/ XRAY(100),Y1RAY(100),Y2RAY(100),ZMAT(50,50)
      CHARACTER*60 CTIT1,CTIT2

      FPI=3.14159/180.

      STEP = 360./(N-1)
      DO I=1,N
        X=(I-1)*STEP
        DO J=1,N
          Y=(J-1)*STEP
          ZMAT(I,J)=2*SIN(X*FPI)*SIN(Y*FPI)
        END DO
      END DO
 
      CTIT1='Surface Plot (SURMAT)'
      CTIT2='F(X,Y) = 2*SIN(X)*SIN(Y)'

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX
      CALL AXSPOS(200,2600)
      CALL AXSLEN(1800,1800)

      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')
      CALL NAME('Z-axis','Z')

      CALL TITLIN(CTIT1,2)
      CALL TITLIN(CTIT2,4)

      CALL VIEW3D(-5.,-5.,4.,'ABS')
      CALL GRAF3D(0.,360.,0.,90.,0.,360.,0.,90.,-3.,3.,-3.,1.)
      CALL HEIGHT(50)
      CALL TITLE

      CALL COLOR('GREEN')
      CALL SURMAT(ZMAT,50,50,1,1)

      CALL DISFIN
      END

      SUBROUTINE EXA_11
      DIMENSION IXP(4),IYP(4)
      PARAMETER (N=50)
      COMMON /WDATA/ XRAY(100),Y1RAY(100),Y2RAY(100),ZMAT(50,50)
      DATA IXP/200,1999,1999,200/ IYP/2600,2600,801,801/

      FPI=3.14159/180.

      STEP = 360./(N-1)
      DO I=1,N
        X=(I-1)*STEP
        DO J=1,N
          Y=(J-1)*STEP
          ZMAT(I,J)=2*SIN(X*FPI)*SIN(Y*FPI)
        END DO
      END DO
 
      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX

      CALL AXSPOS(200,2600)
      CALL AXSLEN(1800,1800)
      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')
      CALL NAME('Z-axis','Z')
      CALL TITLIN('Surface Plot (SURMAT)',2)
      CALL TITLIN('F(X,Y) = 2*SIN(X)*SIN(Y)',4)

      CALL GRAF3D(0.,360.,0.,90.,0.,360.,0.,90.,-3.,3.,-3.,1.)
      CALL HEIGHT(50)
      CALL TITLE
      CALL SHLSUR

      CALL COLOR('GREEN')
      CALL SURMAT(ZMAT,50,50,1,1)

      CALL COLOR('FORE')
C     Grid in the XY plane
      CALL GRFINI(-1.,-1.,-1.,1.,-1.,-1.,1.,1.,-1.)
      CALL NOGRAF
      CALL GRAF(0.,360.,0.,90.,0.,360.,0.,90.)
      CALL DASHL
      CALL GRID(1,1)
      CALL GRFFIN

C     Grid in the YZ plane
      CALL GRFINI(-1.,-1.,-1.,-1.,1.,-1.,-1.,1.,1.)
      CALL GRAF(0.,360.,0.,90.,-3.,3.,-3.,1.)
      CALL GRID(1,1)
      CALL GRFFIN

C     Shading in the XZ plane
      CALL GRFINI(-1.,1.,-1.,1.,1.,-1.,1.,1.,1.)
      CALL SHDPAT(7)
      CALL SOLID
      CALL AREAF(IXP,IYP,4)
      CALL GRFFIN

      CALL DISFIN
      END

      SUBROUTINE EXA_12
      DIMENSION XC(9),YC(9)
      CHARACTER*12 CSTR(9)

      DATA XC/-22.,18.,37.5,0.,2.5,12.5,23.5,-3.75,14.25/
     *     YC/64.,59.6,56.,51.5,48.5,42.,38.,40.3,50.1/
     *   CSTR/'Reykjavik','Stockholm','Moskau','London','Paris',
     *        'Rom','Athen','Madrid','Prag'/

      CALL DISINI
      CALL PAGERA
      CALL HWFONT

      CALL AXSPOS(500,1850)
      CALL AXSLEN(2200,1400)

      CALL LABDIG(-1,'xy')
      CALL TICKS(1,'xy')
      CALL NAME('Longitude','x')
      CALL NAME('Latitude','y')

      CALL TITLIN('Map Plot',3)
      CALL INCMRK(-1)

      CALL LABELS('MAP','xy')
      CALL PROJCT('LAMBERT')
      CALL FRAME(3)
      CALL GRAFMP(-40.,60.,-40.,20.,35.,70.,40.,10.)

      CALL COLOR('GREEN')
      CALL WORLD
      CALL COLOR('FORE')
      CALL CURVMP(XC,YC,9)

      DO I=1,9
        CALL POS2PT(XC(I),YC(I),XP,YP)
        NXP=XP+30
        NYP=YP
        CALL MESSAG(CSTR(I),NXP,NYP)
      END DO

      CALL GRIDMP(1,1)
      CALL HEIGHT(50)
      CALL TITLE
      CALL DISFIN
      END

      SUBROUTINE EX13_1
      CALL SETPAG('DA4L')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX

      CALL FRAME(3)
      CALL AXSPOS(400,1850)
      CALL AXSLEN(2400,1400)

      CALL NAME('Longitude','X')
      CALL NAME('Latitude','Y')
      CALL TITLIN('World Coastlines and Lakes',3)

      CALL LABELS('MAP','XY')
      CALL GRAFMP(-180.,180.,-180.,90.,-90.,90.,-90.,30.)

      CALL GRIDMP(1,1)
      CALL COLOR('GREEN')
      CALL WORLD
      CALL COLOR('WHITE')

      CALL HEIGHT(50)
      CALL TITLE
      CALL DISFIN
      END

      SUBROUTINE EX13_2
      CHARACTER*6 CPROJ(3),CTIT*60
      DATA CPROJ/'Sanson','Winkel','Hammer'/

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL COMPLX
      CALL PAGERA

      CALL HEIGHT(40)
      CALL AXSLEN(1600,750)

      NYA=3850
      DO I=1,3
        NYA=NYA-950
        CALL AXSPOS(250,NYA)

        CALL PROJCT(CPROJ(I))
        CALL NOCLIP
        CALL GRAFMP(-180.,180.,-180.,30.,-90.,90.,-90.,15.)

        WRITE(CTIT,'(2A)') 'Elliptical Projection of ',CPROJ(I)
        CALL TITLIN(CTIT,4)
        CALL TITLE

	CALL COLOR('GREEN')
	CALL WORLD
	CALL COLOR('WHITE')

        CALL GRIDMP(1,1)
        CALL ENDGRF
      END DO

      CALL DISFIN
      END

      SUBROUTINE EX13_3
      DIMENSION NXA(4),NYA(4),XPOL(4),YPOL(4)
      CHARACTER*60 CTIT
      DATA NXA/200,1150,200,1150/NYA/1600,1600,2700,2700/
      DATA XPOL/0.,0.,0.,0./YPOL/0.,45.,90.,-45./

      CTIT='Azimuthal Lambert Projections'

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL COMPLX
      CALL PAGERA

      CALL HEIGHT(50)
      NL=NLMESS(CTIT)
      NX=(2250-NL)/2.
      CALL MESSAG(CTIT,NX,300)

      CALL AXSLEN(900,900)
      CALL PROJCT('LAMBERT')

      DO I=1,4
        CALL AXSPOS(NXA(I),NYA(I))
        CALL MAPPOL(XPOL(I),YPOL(I))
        CALL GRAFMP(-180.,180.,-180.,30.,-90.,90.,-90.,30.)

        CALL COLOR('GREEN')
	CALL WORLD
	CALL COLOR('WHITE')
        CALL GRIDMP(1,1)
        CALL ENDGRF
      END DO

      CALL DISFIN
      END

      SUBROUTINE EX13_4
      PARAMETER (N = 32)
      DIMENSION INRAY(N),IPRAY(N),ICRAY(N)

      DO I=1,32
        INRAY(I)=I
        IPRAY(I)=0
        ICRAY(I)=1
      END DO

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX
      CALL SETVLT('SMALL')

      CALL INTAX
      CALL TICKS(1,'XY')
      CALL FRAME(3)
      CALL AXSLEN(1600,2200)
      CALL AXSPOS(400,2700)

      CALL NAME('Longitude','X')
      CALL NAME('Latitude','Y')
      CALL TITLIN('Conformal Conic Projection',3)

      CALL LABELS('MAP','XY')
      CALL PROJCT('CONF')
      CALL GRAFMP(-10.,30.,-10.,5.,35.,70.,35.,5.)

      CALL GRIDMP(1,1)
      CALL SHDEUR(INRAY,IPRAY,ICRAY,N)

      CALL HEIGHT(50)
      CALL TITLE
      CALL DISFIN
      END

      SUBROUTINE EX14_1
      PARAMETER (N=50)
      COMMON /WDATA/ XRAY(100),YRAY(100),Y2RAY(100),ZMAT(50,50)

      FPI=3.14159/180.
      STEP=360./(N-1)

      DO I=1,N
        XRAY(I)=(I-1.)*STEP
	YRAY(I)=(I-1.)*STEP
      END DO

      DO I=1,N
        DO J=1,N
	  ZMAT(I,J)=2*SIN(XRAY(I)*FPI)*SIN(YRAY(J)*FPI)
        END DO
      END DO

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL COMPLX
      CALL PAGERA

      CALL TITLIN('Contour plot',1)
      CALL TITLIN('F(X,Y) = 2 * SIN(X) * SIN(Y)',3)

      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')

      CALL INTAX
      CALL AXSPOS(450,2670)
      CALL GRAF(0.,360.,0.,90.,0.,360.,0.,90.)

      CALL HEIGHT(30)
      DO I=1,9
        ZLEV=-2.+(I-1)*0.5
        CALL SETCLR(I*25)
        IF(I.EQ.5) THEN
	  CALL LABELS('NONE','CONTUR')
        ELSE
	  CALL LABELS('FLOAT','CONTUR')
        END IF
	CALL CONTUR(XRAY,N,YRAY,N,ZMAT,ZLEV)
      END DO

      CALL HEIGHT(50)
      CALL COLOR('WHITE')
      CALL TITLE

      CALL DISFIN
      END

      SUBROUTINE EX14_2
      PARAMETER (N=50)
      COMMON /WDATA/ XRAY(100),YRAY(100),Y2RAY(100),ZMAT(50,50)
      DIMENSION ZLEV(12)

      STEP=1.6/(N-1)
      DO I=1,N
        X=0.0+(I-1)*STEP
        XRAY(I)=X
        DO J=1,N
          Y=0.0+(J-1)*STEP
          YRAY(J)=Y
          ZMAT(I,J)=(X*X-1.)**2 + (Y*Y-1.)**2
        END DO
      END DO

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX

      CALL MIXALF
      CALL TITLIN('Shaded Contour Plot',1)
      CALL TITLIN('F(X,Y) = (X[2$ - 1)[2$ + (Y[2$ - 1)[2$',3)
      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')

      CALL SHDMOD('POLY','CONTUR')
      CALL AXSPOS(450,2670)
      CALL GRAF(0.0,1.6,0.0,0.2,0.0,1.6,0.0,0.2)

      DO I=1,12
        ZLEV(13-I)=0.1+(I-1)*0.1
      END DO

      CALL CONSHD(XRAY,N,YRAY,N,ZMAT,ZLEV,12)

      CALL HEIGHT(50)
      CALL TITLE
      CALL DISFIN
      END  

      SUBROUTINE EX6_1
      CHARACTER*100 CT0,CT1,CT2,CT3,CTIT

      CTIT='Instruction Alphabet'
      CT1='{M2}C{M4}(x) ='//
     *    ' {M3P}v{M4}e{E}-t{R}t{E}x-1{R}dt{GDH0.4F-1}0{U1.4M3F3}l'

      CT2='lim{GDHC}x{M3CD1.1}a{C}l{RM}'//
     *    '  (1 + {PUH} 1 {RVGD0.5H} x {R}){U1.2H}x{R} = e'

      CT0='Character{H0.5} height{RZ-30}  incli{Z30}nation {ZW0.5} '//
     *    ' ratio {WK} fixed width'

      CT3='Underscoring{L}    {P}twice{J}    vectors {PA8V}'
      NY=1100

      CALL SETPAG('DA4L')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX
      CALL COLOR('CYAN')

      CALL HEIGHT(50)
      NL=NLMESS(CTIT)
      CALL MESSAG(CTIT,(2970-NL)/2,250)

      CALL HEIGHT(36)
      CALL MESSAG('1.)',300,450)
      CALL MESSAG(CT0,500,450)

      CALL HEIGHT(50)
      CALL SMXALF('INST','{','}',1)
      CALL MESSAG(CT0,500,550)

      CALL RESET('SMXA')
      CALL HEIGHT(36)
      CALL MESSAG('2.)',300,750)
      CALL MESSAG(CT3,500,750)

      CALL HEIGHT(50)
      CALL SMXALF('INST','{','}',1)
      CALL MESSAG(CT3,500,850)

      CALL RESET('SMXALF')
      CALL HEIGHT(36)
      CALL MESSAG('3.)',300,NY)
      CALL MESSAG(CT1,500,NY)

      CALL SMXALF('INST','{','}',1)
      CALL HEIGHT(80)
      CALL MESSAG(CT1,900,NY+150)

      CALL HEIGHT(36)
      CALL RESET('SMXA')
      CALL MESSAG('4.)',300,NY+450)
      CALL MESSAG(CT2,500,NY+450)

      CALL HEIGHT(80)
      CALL SMXALF('INST','{','}',1)
      CALL MESSAG(CT2,900,NY+600)
      CALL DISFIN
      END

      SUBROUTINE EX10_1
      DIMENSION X(9),Y(9),Y1(9),Y2(9),Y3(9)
      CHARACTER*60 CTIT,CBUF*24

      DATA  X/1.,2.,3.,4.,5.,6.,7.,8.,9./ Y/9*0./
     *     Y1/1.,1.5,2.5,1.3,2.0,1.2,0.7,1.4,1.1/
     *     Y2/2.,2.7,3.5,2.1,3.2,1.9,2.0,2.3,1.8/
     *     Y3/4.,3.5,4.5,3.7,4.,2.9,3.0,3.2,2.6/

      NYA=2700
      CTIT='Bar Graphs (BARS)'

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX
      CALL TICKS(1,'X')
      CALL INTAX
      CALL AXSLEN(1600,700)
      CALL TITLIN(CTIT,3)

      CALL LEGINI(CBUF,3,8)
      CALL LEGLIN(CBUF,'FIRST',1)
      CALL LEGLIN(CBUF,'SECOND',2)
      CALL LEGLIN(CBUF,'THIRD',3)
      CALL LEGTIT(' ')
      CALL SHDPAT(5)
      DO I=1,3
        IF(I.GT.1) CALL LABELS('NONE','X')
        CALL AXSPOS(300,NYA-(I-1)*800)

        CALL GRAF(0.,10.,0.,1.,0.,5.,0.,1.)

        IF(I.EQ.1) THEN
	  CALL BARGRP(3,0.15)
	  CALL COLOR('RED')
	  CALL BARS(X,Y,Y1,9)
	  CALL COLOR('GREEN')
	  CALL BARS(X,Y,Y2,9)
	  CALL COLOR('BLUE')
	  CALL BARS(X,Y,Y3,9)
	  CALL COLOR('WHITE')
          CALL RESET('BARGRP')
        ELSE IF(I.EQ.2) THEN
          CALL HEIGHT(30)
	  CALL LABELS('DELTA','BARS')
          CALL LABPOS('CENTER','BARS')
	  CALL COLOR('RED')
	  CALL BARS(X,Y,Y1,9)
	  CALL COLOR('GREEN')
	  CALL BARS(X,Y1,Y2,9)
	  CALL COLOR('BLUE')
	  CALL BARS(X,Y2,Y3,9)
	  CALL COLOR('WHITE')
          CALL RESET('HEIGHT')
        ELSE IF(I.EQ.3) THEN
	  CALL LABELS('SECOND','BARS')
          CALL LABPOS('OUTSIDE','BARS')
	  CALL COLOR('RED')
	  CALL BARS(X,Y,Y1,9)
	  CALL COLOR('WHITE')
        END IF

        IF(I.NE.3) CALL LEGEND(CBUF,7)

        IF(I.EQ.3) THEN
          CALL HEIGHT(50)
          CALL TITLE
        END IF

        CALL ENDGRF
      END DO

      CALL DISFIN
      END

      SUBROUTINE EX10_2
      DIMENSION XRAY(5)
      CHARACTER*60 CTIT,CBUF*40
      DATA XRAY/1.,2.5,2.,2.7,1.8/

      CTIT='Pie Charts (PIEGRF)'
      NYA=2800

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX
      CALL AXSLEN(1600,1000)
      CALL TITLIN(CTIT,2)
      CALL CHNPIE('BOTH')

      CALL LEGINI(CBUF,5,8)
      CALL LEGLIN(CBUF,'FIRST',1)
      CALL LEGLIN(CBUF,'SECOND',2)
      CALL LEGLIN(CBUF,'THIRD',3)
      CALL LEGLIN(CBUF,'FOURTH',4)
      CALL LEGLIN(CBUF,'FIFTH',5)

C     INDIVIDUELLE SCHRAFFUREN AUSWAEHLEN
      CALL PATCYC(1,7)
      CALL PATCYC(2,4)
      CALL PATCYC(3,13)
      CALL PATCYC(4,3)
      CALL PATCYC(5,5)

      DO I=1,2
        CALL AXSPOS(250,NYA-(I-1)*1200)
        IF(I.EQ.2) THEN
          CALL LABELS('DATA','PIE')
          CALL LABPOS('EXTERNAL','PIE')
        END IF

        CALL PIEGRF(CBUF,1,XRAY,5)

        IF(I.EQ.2) THEN
          CALL HEIGHT(50)
          CALL TITLE
        END IF
        CALL ENDGRF
      END DO
      CALL DISFIN
      END

      SUBROUTINE EX11_1
      PARAMETER (N=100)
      DIMENSION ZMAT(N,N)
      CHARACTER*4 CDEV
     
      FPI=3.1415927/180.
      STEP=360./(N-1)
      DO I=1,N
        X=(I-1.)*STEP
        DO J=1,N
          Y=(J-1.)*STEP
          ZMAT(I,J)=2*SIN(X*FPI)*SIN(Y*FPI)
        END DO
      END DO
      
      CALL DISINI
      CALL PAGERA
      CALL GETMFL(CDEV)
      CALL HWFONT

      CALL TITLIN('3-D Colour Plot of the Function',2)
      CALL TITLIN('F(X,Y) = 2 * SIN(X) * SIN(Y)',4)

      CALL NAME('X-axis','X')
      CALL NAME('Y-axis','Y')
      CALL NAME('Z-axis','Z')

      CALL INTAX
      CALL AUTRES(N,N)
      CALL AXSPOS(300,1850)
      CALL AX3LEN(2200,1400,1400)

      CALL GRAF3(0.,360.,0.,90.,0.,360.,0.,90.,-2.,2.,-2.,1.)
      CALL CRVMAT(ZMAT,N,N,1,1)

      CALL HEIGHT(50)
      IF(CDEV.EQ.'POST') CALL PSFONT('Palatino-BoldItalic')
      CALL TITLE
      CALL MPAEPL(3)
      CALL DISFIN
      END  

      SUBROUTINE EXA_13
      PARAMETER (N=7)
      CHARACTER*4 CLR(N),CONT(N)
      DATA CLR/'WHITE','RED','GREE','ORAN','YELLO','CYAN','BLUE'/
     *    CONT/'ANTA','AFRI','EURA','NORT','SOUT','AUST','LAKE'/

      CALL DISINI
      CALL COMPLX
      CALL SETVLT('SMALL')
      CALL PAGERA

      CALL PROJCT('HAMMER')
      CALL NOCLIP
      CALL GRAFMP(-180.,180.,-180.,30.,-90.,90.,-90.,30.)

      CALL SHDPAT(16)
      DO I=1,N
        CALL COLOR(CLR(I))
        CALL SHDMAP(CONT(I))
      END DO

      CALL COLOR('WHITE')
      CALL GRIDMP(1,1)
        
      CALL DISFIN
      END

      SUBROUTINE EXA_14
      CHARACTER*4 CVLT*4
      DATA NB,NH,NCOL/100,80,0/

      WRITE(6,'(A,$)') ' Give colour table (RAIN, SPEC, GREY): '
      READ(5,'(A)') CVLT

      CALL DISINI
      CALL PAGERA
      CALL SETVLT(CVLT)

      CALL HEIGHT(30)
      DO I=1,13
        NY=I*150
        NX=-50
        DO J=1,20
          NX=NX+145
          IF(NCOL.LE.255) THEN
            CALL POINT(NX,NY,NB,NH,NCOL)
            XCOL=NCOL
            NL=NLNUMB(XCOL,-1)
            CALL SETCLR(255)
            CALL NUMBER(XCOL,-1,NX-NL/2,NY+50)
            NCOL=NCOL+1
          END IF
        END DO
      END DO
      CALL DISFIN
      END
