      PROGRAM EXAMPL
      CHARACTER*4 CDEV,CDSP,C*1

      CALL GETDSP(CDSP)

      IF(CDSP.EQ.'XWIN') THEN
        CALL WIDGET(CDEV,IOPT)
      ELSE
10      CALL OPTION(CDEV,IOPT)
        
        IF(IOPT.EQ.30) THEN
          GOTO 10
        ELSE IF (IOPT.EQ.0) THEN
          GOTO 20
        END IF
       
        CALL EXA(CDEV,IOPT)

        WRITE(6,'(4X,A)') 'Press RETURN to continue ...'
        READ(5,'(A)') C
        GOTO 10
      END IF
20    END

      SUBROUTINE EXA(CDEV,IOPT)
      CHARACTER*(*) CDEV

      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 EXA12_1
      ELSE IF(IOPT.EQ.13) THEN
	CALL EXA12_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
      END IF
      END

      SUBROUTINE WIDGET(CDEV,IOPT)
      COMMON /CWIDGET/ CL1
      CHARACTER*(*) CDEV,CL1*620,CL2*600,CHELP*200
      INTEGER IRAY(2)

      EXTERNAL MYSUB
      DATA IDEV/2/,IEXA/1/
       
      CHELP=
     * 'Fortran 77 Demo of the Data Plotting Library DISLIN.|'//
     * 'Author: H. Michels, MPI fuer Sonnensystemforschung,|'//
     *'            D-37191 Katlenburg-Lindau, Germany'

      CL1='CONS   (X Window Screen)|'//
     *    'XWIN   (Small Window)|'//
     *    'GKSL   (GKSLIN Metafile)|'//
     *    'CGM    (CGM Metafile)|'//
     *    'PS     (PostScript File)|'//
     *    'EPS    (EPS File)|'//
     *    'PDF    (PDF File)|'//
     *    'WMF    (Windows Metafile)|'//
     *    'HPGL   (HPGL Plotfile)|'//
     *    'SVG    (SVG File)|'//
     *    'JAVA   (Java Applet File)|'//
     *    'GIF    (GIF File)|'//
     *    'TIFF   (TIFF File)|'//
     *    'PNG    (PNG File)|'//
     *    'PPM    (PPM File)|'//
     *    'BMP    (BMP File)|'//
     *    'IMAG   (Image File)'
 
      CL2='Demo of Curve|Polar Plots|Symbols|Logarithmic Axes|'//
     *    'Interpolation Methods|'//
     *    'Line Styles|Legend|Shading Patterns (AREAF)|Vectors|'//
     *    'Shading Patterns (PIEGRF)|Surface Plot|Surface Plot|'//
     *    'Parametric Function Plot|'//
     *    'Map Plot|World Coastlines|Elliptical Proj.|'//
     *    'Azimuthal Proj.|'//
     *    'Conical Proj.|Bar Graphs|Pie Charts|3-D Bar/Pie Graphs|'//
     *    'Contours|Shaded Contours|'//
     *    'Instruction Alphabet|3-D Colour Plot|Shaded World|'//
     *    'Colour Tables'

      CDEV='XWIN'

      CALL SWGTIT('DISLIN Examples')
      CALL SWGHLP(CHELP)
      CALL SWGWTH(25)
      CALL SWGTYP('SCROLL', 'LIST')
      CALL SWGPOP('NOOK')

      CALL WGINI('HORI',IP)
      CALL WGBAS(IP, 'VERT', IP_L)
      CALL WGBAS(IP, 'VERT', IP_R)

      CALL WGLAB(IP_L,'Example:',ID)
      CALL WGLIS(IP_L,CL2,IEXA,IRAY(1))
      CALL WGQUIT (IP_L,ID)

      CALL WGLAB(IP_R,'Device:',ID)
      CALL WGLIS(IP_R,CL1,IDEV,IRAY(2))

      CALL WGPBUT(IP_R, 'Plot', ID_PBUT)
      CALL SWGCB (ID_PBUT, MYSUB, IRAY)
      CALL WGFIN
      END

      SUBROUTINE MYSUB(ID,IRAY)
      COMMON /CWIDGET/ CL1
      CHARACTER*8 CDEV,CL1*620,CSTR*80
      INTEGER IRAY(2)

      CALL GWGLIS(IRAY(1),IOPT)
      CALL GWGLIS(IRAY(2),IDEV)
      CALL ITMSTR(CL1,IDEV,CSTR)
      CDEV=CSTR(1:4)

      CALL EXA(CDEV,IOPT)
      END

      SUBROUTINE OPTION(CDEV,IOPT)
      PARAMETER (NR1=24,NR2=17)
      CHARACTER*(*) CDEV,CR0*58,CR1(NR1)*58,CR2(NR2)*58
      
      DATA IFIRST/0/

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

      DATA CR1/
     *'                      DISLIN-Examples                     ',
     *'                                                          ',
     *'Fortran 77 Demo of the Data Plotting Library DISLIN.      ',
     *'Author: H. Michels,  MPI fuer Sonnensystemforschung,  ',
     *'               D-39191 Katlenburg-Lindau, Germany         ',
     *'                                                          ',
     *'Device:      defines the metafile.                        ',
     *'   = CONS    Tektronix emulation or X Window terminal.    ',
     *'   = XWIN    X Window terminal (small window).            ',
     *'   = GKSL    A GKSLIN metafile will be created.           ',
     *'   = CGM     A CGM metafile will be created.              ',
     *'   = PS      A PostScript file will be created.           ',
     *'   = EPS     An EPS file will be created.                 ',
     *'   = PDF     A PDF file will be created.                  ',
     *'   = WMF     A Windows metafile will be created.          ',
     *'   = HPGL    A HPGL file will be created.                 ',
     *'   = SVG     A SVG file will be created.                  ',
     *'   = JAVA    A Java applet 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            '/

      IF((IFIRST.EQ.0).OR.(IOPT.EQ.30)) THEN
        WRITE(6,'(/4X,3A)')	     '/****',CR0,   '****/'
        WRITE(6,'(4X,3A,23(/4X,3A))') ('/**  ',CR1(I),'  **/',I=1,NR1)
        WRITE(6,'(4X,3A)')	     '/****',CR0,   '****/'

        WRITE(6,'(/4X,A)') '_Device: '
        READ(5,'(A)') CDEV
        IFIRST=1
      END IF

      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

      IF(IOPT.EQ.0) STOP
      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 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('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 COMPLX

      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*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,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*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('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*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('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*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_7
      PARAMETER(N=100)
      COMMON /WDATA/ XRAY(300),YRAY(300),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_8
      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 PAGERA
      CALL COMPLX
      CALL SETVLT ('SMALL')

      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,15)
	  IF(ICLR.EQ.0) ICLR=15
	  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*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_10
      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_11
      CHARACTER*60 CTIT1,CTIT2
      EXTERNAL ZFUN

      CTIT1='Surface Plot (SURFUN)'
      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 SURFUN(ZFUN,1,10.,1,10.)

      CALL DISFIN
      END

      FUNCTION ZFUN(X,Y)
      FPI=3.14159/180.
      ZFUN=2*SIN(X*FPI)*SIN(Y*FPI)
      END

      SUBROUTINE EXA12_1
      DIMENSION IXP(4),IYP(4)
      EXTERNAL ZFUN       !   see example 10
      DATA IXP/200,1999,1999,200/ IYP/2600,2600,801,801/

      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 (SURFUN)',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 SURFUN(ZFUN,1,10.,1,10.)
      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 EXA12_2
      CHARACTER*60 CTIT1,CTIT2
      EXTERNAL ZFUN2

      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 COMPLX
      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(ZFUN2,0.,2*PI,STEP,0.,2*PI,STEP)
      CALL DISFIN
      END

      FUNCTION ZFUN2(X,Y,IOPT)

      IF(IOPT.EQ.1) THEN
        ZFUN2=COS(X)*(3+COS(Y))
      ELSE IF(IOPT.EQ.2) THEN
        ZFUN2=SIN(X)*(3+COS(Y))
      ELSE
        ZFUN2=SIN(Y)
      END IF
      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 COMPLX

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

      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('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*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('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 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(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
        CALL SETCLR(I*25)
        ZLEV=-2.+(I-1)*0.5
        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**2.-1.)**2. + (Y**2.-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('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*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 EX10_3
      CHARACTER*80 CBUF
      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 COMPLX

      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*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 COMPLX

      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/'WHIT','RED ','GREE','ORAN','YELL','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('FORE')
      CALL GRIDMP(1,1)
        
      CALL DISFIN
      END

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

      CLIS='SMALL|RAINBOW|SPECTRUM|GREY|RRAIN|RGREY|VGA'

      CALL WGINI('VERT', IP)
      ILIS=2
      CALL WGLAB(IP, 'Colour Table:',ID)
      CALL WGLIS(IP,CLIS,ILIS,ID_LIS)
      CALL WGOK(IP,ID)
      CALL WGFIN

      CALL GWGLIS(ID_LIS,ILIS)
      CALL ITMSTR(CLIS,ILIS,CVLT)

      CALL DISINI
      CALL SETVLT(CVLT)

      NCOL=0
      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 COLOR('FORE')
            CALL NUMBER(XCOL,-1,NX-NL/2,NY+50)
            NCOL=NCOL+1
          END IF
        END DO
      END DO
      CALL DISFIN
      END
