      PROGRAM EXAMPL
      PARAMETER (NR1=25,NR2=17)

      CHARACTER CR0*58,CR1(NR1)*58,CR2(NR2)*58,CDEV*4,C*1

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

      DATA (CR1(I),I=1,16)/
     *'                      DISLIN-Examples                     ',
     *'                                                          ',
     *'Fortran 77 Demo of the Data Plotting Library DISLIN.      ',
     *'Author: H. Michels,  MPI fuer Sonnensystemforschung       ',
     *'                                                          ',
     *'Device:      defines the metafile.                        ',
     *'   = CONS    Screen (full window).                        ', 
     *'   = XWIN    Screen (small window).                       ', 
     *'   = GL      Screen (OpenGL window).                      ', 
     *'   = 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.                     ',
     *'   = WMF     A Windows metafil will be created.           ',
     *'   = EMF     A Windows metafil will be created.           '/

      DATA (CR1(I),I=17,NR1)/
     *'   = HPGL    A HPGL file will be created.                 ',
     *'   = SVG     A SVG file will be created.                  ',
     *'   = JAVA    A Java applet file will be created.          ',
     *'   = GIF     A GIF file will be created.                  ', 
     *'   = TIFF    A TIFF file will be created.                 ', 
     *'   = PNG     A PNG file will be created.                  ', 
     *'   = PPM     A PPM file will be created.                  ', 
     *'   = BMP     A BMP file will be created.                  ', 
     *'   = IMAG    An Image file will be created.               '/

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

10    WRITE(6,'(/4X,3A)')            '/****',CR0,   '****/'
      WRITE(6,'(4X,3A,24(/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,16(/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 EX12_1
      ELSE IF(IOPT.EQ.13) THEN
        CALL EX12_2
      ELSE IF(IOPT.EQ.14) THEN
        CALL EXA_12
      ELSE IF(IOPT.EQ.15) THEN
        CALL EX13_1
      ELSE IF(IOPT.EQ.16) THEN
        CALL EX13_2
      ELSE IF(IOPT.EQ.17) THEN
        CALL EX13_3
      ELSE IF(IOPT.EQ.18) THEN
        CALL EX13_4
      ELSE IF(IOPT.EQ.19) THEN
        CALL EX10_1
      ELSE IF(IOPT.EQ.20) THEN
        CALL EX10_2
      ELSE IF(IOPT.EQ.21) THEN
        CALL EX10_3
      ELSE IF(IOPT.EQ.22) THEN
        CALL EX14_1
      ELSE IF(IOPT.EQ.23) THEN
        CALL EX14_2
      ELSE IF(IOPT.EQ.24) THEN
        CALL EX6_1
      ELSE IF(IOPT.EQ.25) THEN
        CALL EX11_1
      ELSE IF(IOPT.EQ.26) THEN
        CALL EXA_13
      ELSE IF(IOPT.EQ.27) 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(300),YRAY(300),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 HWFONT
      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('FORE')
      CALL DASH
      CALL XAXGIT

      CALL DISFIN
      END

      SUBROUTINE EXA_2
      PARAMETER (N=300,M=10)
      COMMON /WDATA/ XRAY(300),YRAY(300),Y1RAY(100),Y2RAY(100),
     *               ZMAT(50,50)
      REAL X2(M),Y2(M)

      XPI=3.1415927
      STEP=360./(N-1)
      DO I=1,N
        A=(I-1)*STEP
        A=A*XPI/180
        YRAY(I)=A
        XRAY(I)=SIN(5*A)
      END DO

      DO I=1,M
        X2(I)=I
        Y2(I)=I
      END DO
 
      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL HWFONT

      CALL TITLIN ('Polar Plots', 2)
      CALL TICKS(3,'Y')
      CALL AXENDS('NOENDS','X')
      CALL LABDIG(-1,'Y')
      CALL AXSLEN(1000,1000)
      CALL AXSORG(1050,900)

      CALL POLAR(1.,0., 0.2, 0., 30.)
      CALL CURVE(XRAY,YRAY,N)
      CALL HTITLE(50)
      CALL TITLE
      CALL ENDGRF

      CALL LABDIG(-1,'X')
      CALL AXSORG(1050,2250)
      CALL LABTYP('VERT','Y')
      CALL BARWTH (5.)
      
      CALL POLAR(10.,0.,2.,0.,30.)
      CALL BARWTH(-5.)
      CALL POLCRV('FBARS')
      CALL CURVE(X2,Y2,M)
      CALL DISFIN
      END

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

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL PAGERA
      CALL COLOR('YELLOW')
      CALL HWFONT
      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,23
        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_4
      CHARACTER CTIT*60,CLAB(3)*5
      DATA CLAB/'LOG','FLOAT','ELOG '/

      CTIT='Logarithmic Scaling'

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

      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('FORE')
        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_5

      DIMENSION X(16), Y(16)
      CHARACTER CPOL(6)*8,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 HWFONT
      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('FORE')

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

      CALL DISFIN
      END

      SUBROUTINE EXA_6
      DIMENSION X(2),Y(2)
      CHARACTER CTYP(8)*6
      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 HWFONT

      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_7
      PARAMETER(N=100)
      COMMON /WDATA/ XRAY(300),YRAY(300),Y1RAY(100),Y2RAY(100),
     *               ZMAT(50,50)
      CHARACTER CBUF*14

      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 HWFONT
      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_8
      DIMENSION IXP(4),IYP(4),IX(4),IY(4)
      CHARACTER CTIT*60,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 HWFONT

      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_9
      DIMENSION IVEC(20)
      CHARACTER CTIT*60,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 HWFONT

      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_10
      DIMENSION XRAY(18)
      CHARACTER CTIT*60,CBUF*36,CSTR*2
      DATA XRAY/18*1./

      CTIT='Shading Patterns (PIEGRF)'

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

      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_11
      PARAMETER (N=50)
      COMMON /WDATA/ XRAY(300),YRAY(300),Y1RAY(100),Y2RAY(100),
     *               ZMAT(50,50)
      CHARACTER CTIT1*60,CTIT2*60

      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 HWFONT
      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 EX12_1
      DIMENSION IXP(4),IYP(4)
      PARAMETER (N=50)
      COMMON /WDATA/ XRAY(300),YRAY(300),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 HWFONT

      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 EX12_2
      CHARACTER CTIT1*60,CTIT2*60
      EXTERNAL ZFUN

      CTIT1='Surface Plot of the Parametric Function'
      CTIT2='[COS(t)*(3+COS(u)),SIN(t)*(3+COS(u)), SIN(u)]'
      PI=3.14159

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL HWFONT
      CALL PAGERA
      CALL AXSPOS(200,2400)
      CALL AXSLEN(1800,1800)
      CALL INTAX

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

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

      CALL VKYTIT(-300)
      CALL ZSCALE(-1.,1.)
      CALL GRAF3D(-4.,4.,-4.,1.,-4.,4.,-4.,1.,-3.,3.,-3.,1.)

      CALL HEIGHT(40)
      CALL TITLE

      CALL SURMSH('ON')
      STEP=2*PI/30.
      CALL SURFCP(ZFUN,0.,2*PI,STEP,0.,2*PI,STEP)
      CALL DISFIN
      END

      FUNCTION ZFUN(X,Y,IOPT)

      IF(IOPT.EQ.1) THEN
        ZFUN=COS(X)*(3+COS(Y))
      ELSE IF(IOPT.EQ.2) THEN
        ZFUN=SIN(X)*(3+COS(Y))
      ELSE
        ZFUN=SIN(Y)
      END IF
      END

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

      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=NINT(XP+30)
        NYP=NINT(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 HWFONT

      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('FORE')

      CALL HEIGHT(50)
      CALL TITLE
      CALL DISFIN
      END

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

      CALL SETPAG('DA4P')
      CALL DISINI
      CALL HWFONT
      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('FORE')

        CALL GRIDMP(1,1)
        CALL ENDGRF
      END DO

      CALL DISFIN
      END

      SUBROUTINE EX13_3
      DIMENSION NXA(4),NYA(4),XPOL(4),YPOL(4)
      CHARACTER CTIT*60
      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 HWFONT
      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('FORE')
        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 HWFONT
      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(300),YRAY(300),Y1RAY(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('FORE')
      CALL TITLE

      CALL DISFIN
      END

      SUBROUTINE EX14_2
      PARAMETER (N=50)
      COMMON /WDATA/ XRAY(300),YRAY(300),Y1RAY(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 HWFONT

      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 CT0*100,CT1*100,CT2*100,CT3*100,CTIT*100

      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 CTIT*60,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 HWFONT
      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('FORE')
          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('FORE')
          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('FORE')
        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 CTIT*60,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 HWFONT
      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 EX10_3
      CHARACTER CBUF*80
      REAL XRAY(5),Y1RAY(5),Y2RAY(5)
      INTEGER IC1RAY(5),IC2RAY(5)
      DATA XRAY/2.,4.,6.,8.,10./,Y1RAY/0.,0.,0.,0.,0./,
     *     Y2RAY/3.2,1.5,2.0,1.0,3.0/
      DATA IC1RAY/50,150,100,200,175/,
     *     IC2RAY/50,150,100,200,175/

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

      CALL TITLIN('3-D Bar Graph / 3-D Pie Chart', 2)
      CALL HTITLE(40)

      CALL SHDPAT(16)
      CALL AXSLEN(1500,1000)
      CALL AXSPOS(300,1400)

      CALL BARWTH(0.5)
      CALL BARTYP('3DVERT')
      CALL LABELS('SECOND','BARS')
      CALL LABPOS('OUTSIDE','BARS')
      CALL LABCLR(255,'BARS')
      CALL GRAF(0.,12.,0.,2.,0.,5.,0.,1.)
      CALL TITLE
      CALL COLOR('RED')
      CALL BARS(XRAY,Y1RAY,Y2RAY,5)
      CALL ENDGRF

      CALL SHDPAT(16)
      CALL LABELS('DATA','PIE')
      CALL LABCLR(255,'PIE')
      CALL CHNPIE('NONE')
      CALL PIECLR(IC1RAY,IC2RAY,5)
      CALL PIETYP('3D')
      CALL AXSPOS(300,2700)
      CALL PIEGRF(CBUF,0,Y2RAY,5)       
      CALL DISFIN
      END

      SUBROUTINE EX11_1
      PARAMETER (N=100)
      DIMENSION ZMAT(N,N)
      CHARACTER CDEV*4
     
      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 DISFIN
      END  

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

      CALL DISINI
      CALL HWFONT
      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('FORE')
      CALL GRIDMP(1,1)
        
      CALL DISFIN
      END

      SUBROUTINE EXA_14
      CHARACTER 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
