DISLIN Examples / Fortran 90

Demonstration of CURVE / Fortran 90

      PROGRAM EXA_1
      USE DISLIN
      IMPLICIT NONE
      INTEGER, PARAMETER :: N=100
      REAL, DIMENSION (N) :: XRAY,Y1RAY,Y2RAY
      REAL, PARAMETER :: PI=3.1415926
      REAL :: FPI,STEP,X
      INTEGER :: I,IC

      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 METAFL('CONS')
      CALL SCRMOD('REVERS')
      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)

      IC=INTRGB(0.95,0.95,0.95)
      CALL AXSBGD(IC)

      CALL GRAF(0.,360.,0.,90.,-1.,1.,-1.,0.5)
      CALL SETRGB(0.7,0.7,0.7)
      CALL GRID(1,1)

      CALL COLOR('FORE')
      CALL TITLE()

      CALL COLOR('RED')
      CALL CURVE(XRAY,Y1RAY,N)
      CALL COLOR('GREEN')
      CALL CURVE(XRAY,Y2RAY,N)
      CALL DISFIN()
      END PROGRAM EXA_1

---

Polar Plots / Fortran 90

      PROGRAM EXA_2
      USE DISLIN
      IMPLICIT NONE
      INTEGER, PARAMETER :: N=300,M=10
      REAL, DIMENSION (N) :: XRAY,YRAY
      REAL, DIMENSION (M) :: X2,Y2
      REAL :: XPI,STEP,A
      INTEGER :: I

      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 METAFL('CONS')
      CALL SCRMOD('REVERS')
      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 GRAFP(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 GRAFP(10.,0.,2.,0.,30.)
      CALL BARWTH(-5.)
      CALL POLCRV('FBARS')
      CALL CURVE(X2,Y2,M)
      CALL DISFIN()
      END PROGRAM EXA_2

---

Symbols / Fortran 90

      PROGRAM EXA_2
      USE DISLIN
      IMPLICIT NONE
      CHARACTER (LEN=20) :: CTIT = 'Symbols'
      CHARACTER (LEN=2)  :: CSTR
      INTEGER :: I,NY,NXP,NL

      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      CALL SCRMOD('REVERS')
      CALL DISINI()
      CALL PAGERA()
      CALL COMPLX()

      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()
      STOP
      END PROGRAM EXA_2

---

Interpolation Methods / Fortran 90

      PROGRAM EXA_4
      USE DISLIN
      IMPLICIT NONE

      REAL, DIMENSION (16) :: &
        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./)
      CHARACTER (LEN = 60) :: CTIT = 'Interpolation Methods'
      CHARACTER (LEN = 6), DIMENSION (6) :: &
              CPOL = (/'SPLINE','STEM  ','BARS  ','STEP  ','STAIRS', &
                  'LINEAR'/)
      INTEGER :: I,NX,NY,NYA=2700,IC

      CALL SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      CALL DISINI()
      CALL COMPLX()
      CALL PAGERA()
      CALL INCMRK(1)
      CALL HSYMBL(25)
      CALL TITLIN(CTIT,2)
      CALL AXSLEN(1500,350)
      CALL SETGRF('LINE','LINE','LINE','LINE')
      IC=INTRGB(1.0,1.0,0.0)
      CALL AXSBGD(IC)

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

        CALL GRAF(0.,20.,0.,5.,0.,10.,0.,5.)
        NX=NXPOSN(1.)
        NY=NYPOSN(8.)
        CALL MESSAG(CPOL(I),NX,NY)

        CALL COLOR('RED')
        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()
      STOP
      END PROGRAM EXA_4

---

Bar Graphs / Fortran 90

      PROGRAM EX10_1
      USE DISLIN
      IMPLICIT NONE
      CHARACTER (LEN=60) :: CTIT = 'Bar Graphs (BARS)'
      CHARACTER (LEN=24) :: CBUF
      REAL, DIMENSION (9) :: &
         X  = (/1.,2.,3.,4.,5.,6.,7.,8.,9./), Y = 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/)
      INTEGER :: I,NYA=2700

      CALL SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      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()
      STOP
      END PROGRAM EX10_1

---

Pie Charts / Fortran 90

      PROGRAM EX10_2
      USE DISLIN
      IMPLICIT NONE
      REAL, DIMENSION (5) :: XRAY = (/1.,2.5,2.,2.7,1.8/)
      CHARACTER (LEN=60) :: CTIT = 'Pie Charts (PIEGRF)'
      CHARACTER (LEN=40) :: CBUF
      INTEGER :: I,NYA=2800

      CALL SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      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)

      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()
      STOP
      END PROGRAM EX10_2

---

3-D Bar Graph / 3-D Pie Chart

            PROGRAM EXA_12
            USE DISLIN
            IMPLICIT NONE

            CHARACTER (LEN=80) :: CBUF
            REAL, DIMENSION (5) ::  XRAY  = (/2.,4.,6.,8.,10./), &
                                    Y1RAY = (/0.,0.,0.,0.,0./),  &
                                    Y2RAY = (/3.2,1.5,2.0,1.0,3.0/)
            INTEGER, DIMENSION (5) :: IC1RAY = (/50,150,100,200,175/), &
                                      IC2RAY = (/50,150,100,200,175/)

            CALL SETPAG('DA4P')
            CALL METAFL('CONS')
            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()
            STOP            
            END PROGRAM EXA_12

---

3-D Shading Patterns / Fortran 90

      PROGRAM EXA_7
      USE DISLIN
      IMPLICIT NONE

      CHARACTER (LEN=60) :: CTIT = 'Shading Patterns (AREAF)'
      CHARACTER (LEN=2)  :: CSTR
      INTEGER, DIMENSION (4) :: IXP,IYP,IX = (/0,300,300,0/), &
                                        IY = (/0,0,400,400/)
      INTEGER :: NL,NX,NY,NX0=335,NY0=350,I,J,II,ICLR,K

      CALL SCRMOD('REVERS')
      CALL METAFL('CONS')
      CALL DISINI()
      CALL SETVLT('SMALL')
      CALL PAGERA()
      CALL COMPLX()

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

      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()
      STOP
      END PROGRAM EXA_7

---

3-D Bars /BARS3D / Fortran 90

      PROGRAM EX12_3
      USE DISLIN
      IMPLICIT NONE

      INTEGER, PARAMETER :: N=18
      CHARACTER (LEN=80) :: CBUF

      REAL, DIMENSION (N) :: XWRAY, YWRAY,  &
        XRAY  = (/1.0, 3.0, 8.0, 1.5, 9.0, 6.3, 5.8, 2.3, 8.1,   & 
                  3.5, 2.2, 8.7, 9.2, 4.8, 3.4, 6.9, 7.5, 3.8/), &
        YRAY  = (/5.0, 8.0, 3.5, 2.0, 7.0, 1.0, 4.3, 7.2, 6.0,   &
                  8.5, 4.1, 5.0, 7.3, 2.8, 1.6, 8.9, 9.5, 3.2/), &
        Z1RAY = (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,   &
                  0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/), &
        Z2RAY = (/4.0, 5.0, 3.0, 2.0, 3.5, 4.5, 2.0, 1.6, 3.8,   &
                  4.7, 2.1, 3.5, 1.9, 4.2, 4.9, 2.8, 3.6, 4.3/)
 
      INTEGER, DIMENSION (N) ::   &
        ICRAY = (/30, 30, 30, 30, 30, 30, 100, 100, 100, 100,    &
                 100, 100, 170, 170, 170, 170, 170, 170/)
      INTEGER :: I

      DO I=1,N
        XWRAY(I)=0.5
        YWRAY(I)=0.5
      END DO

      CALL SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      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('3-D Bars / BARS3D',3)

      CALL LABL3D('HORI')
      CALL GRAF3D(0.,10.,0.,2.,0.,10.,0.,2.,0.,5.,0.,1.)
      CALL GRID3D(1,1,'BOTTOM')

      CALL BARS3D(XRAY,YRAY,Z1RAY,Z2RAY,XWRAY,YWRAY,ICRAY,N)

      CALL LEGINI(CBUF,3,20)
      CALL LEGTIT(' ')
      CALL LEGPOS(1300,1100)
      CALL LEGLIN(CBUF,'First',1)
      CALL LEGLIN(CBUF,'Second',2)
      CALL LEGLIN(CBUF,'Third',3)
      CALL LEGEND(CBUF,3)

      CALL HEIGHT(50)
      CALL TITLE
      CALL DISFIN
      STOP
      END PROGRAM EX12_3

---

3-D Colour Plot / Fortran 90

      PROGRAM EX11_1
      USE DISLIN
      IMPLICIT NONE

      INTEGER, PARAMETER :: N=100
      REAL, DIMENSION (N,N) :: ZMAT
      REAL    :: FPI,STEP,X,Y
      INTEGER :: I,J

      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 SCRMOD('REVERS')
      CALL METAFL('CONS')
      CALL DISINI()
      CALL PAGERA()
      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)
      CALL TITLE()
      CALL MPAEPL(3)
      CALL DISFIN()
      STOP
      END PROGRAM EX11_1

---

Surface Plot / Fortran 90

      PROGRAM EXA_10
      USE DISLIN
      IMPLICIT NONE
      INTEGER, PARAMETER :: N=50
      REAL, DIMENSION (N,N) :: ZMAT
      CHARACTER (LEN=60) :: CTIT1 = 'Surface Plot (SURMAT)', &
                            CTIT2 = 'F(X,Y) = 2*SIN(X)*SIN(Y)'
      REAL    :: FPI,STEP,X,Y
      INTEGER :: I,J

      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 SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      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,N,N,1,1)

      CALL DISFIN()
      STOP
      END PROGRAM EXA_10

---

Shaded Surface Plot / Fortran 90

      PROGRAM EXA_10
      USE DISLIN
      IMPLICIT NONE
      INTEGER, PARAMETER :: N=50
      REAL, DIMENSION (N,N) :: ZMAT
      REAL, DIMENSION (N) :: XRAY,YRAY 
      CHARACTER (LEN=60) :: CTIT1 = 'Shaded Surface Plot', &
                            CTIT2 = 'F(X,Y) = 2*SIN(X)*SIN(Y)'
      REAL    :: FPI,STEP,X,Y
      INTEGER :: I,J

      FPI=3.14159/180.
      STEP = 360./(N-1)
      DO I=1,N
        X=(I-1)*STEP
        XRAY(I)=X
        DO J=1,N
          Y=(J-1)*STEP
          YRAY(J)=Y
          ZMAT(I,J)=2*SIN(X*FPI)*SIN(Y*FPI)
        END DO
      END DO

      CALL SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      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 SHDMOD('SMOOTH','SURFACE')
      CALL SURSHD(XRAY,N,YRAY,N,ZMAT)

      CALL DISFIN()
      STOP
      END PROGRAM EXA_10

---

Contour Plot / Fortran 90

      PROGRAM EX14_1
      USE DISLIN
      IMPLICIT NONE
      INTEGER, PARAMETER :: N=50
      REAL, DIMENSION (N) :: XRAY,YRAY
      REAL, DIMENSION (N,N) :: ZMAT
      INTEGER :: I,J
      REAL    :: FPI,STEP,ZLEV

      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 SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      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()
      STOP
      END PROGRAM EX14_1

---

Shaded Contour Plot / Fortran 90

      PROGRAM EX14_2
      USE DISLIN
      IMPLICIT NONE
      INTEGER, PARAMETER :: N=50
      REAL, DIMENSION (N) :: XRAY,YRAY
      REAL, DIMENSION (N,N) :: ZMAT
      REAL, DIMENSION (12)  :: ZLEV
      REAL    :: STEP,X,Y
      INTEGER :: I,J

      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 SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      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()
      STOP
      END PROGRAM EX14_2

---

Shaded Surface / Contour Plot / Fortran 90

      PROGRAM EXA12_5
      USE DISLIN
      IMPLICIT NONE
      INTEGER, PARAMETER :: N=50,NLEV=20
      REAL, DIMENSION (N,N) :: ZMAT
      REAL, DIMENSION (N) :: XRAY,YRAY 
      REAL, DIMENSION (NLEV) :: ZLEV
      CHARACTER (LEN=60) :: CTIT1 = 'Shaded Surface / Contour Plot', &
                            CTIT2 = 'F(X,Y) = 2*SIN(X)*SIN(Y)'
      REAL    :: FPI,STEP,X,Y
      INTEGER :: I,J

      FPI=3.14159/180.
      STEP = 360./(N-1)
      DO I=1,N
        X=(I-1)*STEP
        XRAY(I)=X
        DO J=1,N
          Y=(J-1)*STEP
          YRAY(J)=Y
          ZMAT(I,J)=2*SIN(X*FPI)*SIN(Y*FPI)
        END DO
      END DO

      CALL SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      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 GRAF3D(0.,360.,0.,90.,0.,360.,0.,90.,-2.,2.,-2.,1.)
      CALL HEIGHT(50)
      CALL TITLE()

      CALL GRFINI(-1.,-1.,-1.,1.,-1.,-1.,1.,1.,-1.)
      CALL NOGRAF()
      CALL GRAF(0.,360.,0.,90.,0.,360.,0.,90.)
      STEP=4./NLEV
      DO I=1,NLEV
        ZLEV(I)=-2.0+(I-1)*STEP
      END DO
      CALL CONSHD(XRAY,N,YRAY,N,ZMAT,ZLEV,NLEV)
      CALL BOX2D()
      CALL RESET('NOGRAF')
      CALL GRFFIN()

      CALL SHDMOD('SMOOTH','SURFACE')
      CALL SURSHD(XRAY,N,YRAY,N,ZMAT)
      CALL DISFIN()
      STOP
      END PROGRAM EXA12_5

---

Spheres and Tubes / Fortran 90

      PROGRAM EXA12_6
      USE DISLIN
      IMPLICIT NONE
     
      REAL, DIMENSION (17) :: X = (/10., 20., 10., 20., 5., 15., 25.,  & 
          5., 15., 25., 5., 15., 25., 10., 20., 10., 20./)
      REAL, DIMENSION (17) :: Y = (/10., 10., 20., 20., 5., 5., 5.,    &
         15., 15., 15., 25., 25., 25., 10., 10., 20., 20./)
      REAL, DIMENSION (17) :: Z = (/5., 5., 5., 5., 15., 15., 15.,     &
         15., 15., 15., 15., 15., 15., 25., 25., 25., 25./) 
      INTEGER, DIMENSION (56) :: IDX = (/1, 2, 1, 3, 3, 4, 2, 4, 5, 6, &
          6, 7, 8, 9, 9, 10, 11, 12, 12, 13,  5, 8, 8, 11, 6, 9, 9,    &
         12, 7, 10, 10, 13,  14, 15, 16, 17, 14, 16, 15, 17,           &
          1, 5, 2, 7, 3, 11, 4, 13, 5, 14, 7, 15, 11, 16, 13, 17/)
      INTEGER :: I,J1,J2,IRET

      CALL SETPAG('da4p')
      CALL SCRMOD('revers')
      CALL METAFL('cons')
      CALL DISINI() 
      CALL PAGERA() 
      CALL HWFONT() 

      CALL LIGHT('on')
      CALL MATOP3(0.02, 0.02, 0.02, 'specular')

      CALL CLIP3D('none')
      CALL AXSPOS(0,2500)
      CALL AXSLEN(2100,2100)

      CALL HTITLE(50)
      CALL TITLIN('Spheres and Tubes', 4)

      CALL NAME('X-axis', 'x')
      CALL NAME('Y-axis', 'y')
      CALL NAME('Z-axis', 'z')

      CALL LABDIG(-1, 'xyz')  
      CALL LABL3D('hori')
      CALL GRAF3D(0., 30., 0., 5., 0., 30., 0., 5., 0., 30., 0., 5.)
      CALL TITLE() 

      CALL SHDMOD('smooth', 'surface')
      CALL ZBFINI(IRET)
      CALL MATOP3(1.0, 0.0, 0.0, 'diffuse')

      DO I=1,17
        CALL SPHE3D(X(I),Y(I),Z(I),2.0,50,25)
      END DO

      CALL MATOP3(0.0, 1.0, 0.0, 'diffuse')
      DO I=1,56,2
        J1=IDX(I)
        J2=IDX(I+1)
        CALL TUBE3D(X(J1),Y(J1),Z(J1),X(J2),Y(J2),Z(J2),0.5,10,5)
      END DO
      CALL ZBFFIN()
      CALL DISFIN()
      END PROGRAM EXA12_6

---

Some Solids / Fortran 90

      PROGRAM EXA12_7
      USE DISLIN
      IMPLICIT NONE
      INTEGER :: IRET

      CALL SETPAG('da4p')
      CALL SCRMOD('revers')
      CALL METAFL('cons')
      CALL DISINI()
      CALL PAGERA()
      CALL HWFONT()
      CALL LIGHT('on')
      CALL LITOP3(1,0.5,0.5,0.5,'ambient')

      CALL CLIP3D('none')
      CALL AXSPOS(0, 2500)
      CALL AXSLEN(2100, 2100)

      CALL HTITLE(60)
      CALL TITLIN('Some Solids', 4)

      CALL NOGRAF()
      CALL GRAF3D(-5., 5., -5., 2., -5., 5., -5., 2., -5., 5., -5., 2.)
      CALL TITLE()
 
      CALL SHDMOD('smooth', 'surface')
      CALL ZBFINI(IRET)

      CALL MATOP3(1.0, 0.5, 0.0, 'diffuse')
      CALL TUBE3D(-3., -3., 8.0, 2., 3., 5.5, 1., 40, 20) 

      CALL ROT3D(-60., 0., 0.) 
      CALL MATOP3(1.0, 0.0, 1.0, 'diffuse')
      CALL SETFCE('bottom')
      CALL MATOP3(1.0, 0.0, 0.0, 'diffuse')
      CALL CONE3D(-3., -3., 3.5, 2., 3., 3., 40, 20)
      CALL SETFCE('top')

      CALL ROT3D(0., 0., 0.) 
      CALL MATOP3(0.0, 1.0, 1.0, 'diffuse')
      CALL PLAT3D(4., 4., 3., 3., 'ICOS')

      CALL ROT3D(0., 0., 0.) 
      CALL MATOP3(1.0, 1.0, 0.0, 'diffuse')
      CALL SPHE3D(0., 0., 0., 3., 40, 20)

      CALL ROT3D(0., 0., -20.) 
      CALL MATOP3(0.0, 0.0, 1.0, 'diffuse')
      CALL QUAD3D(-4., -4., -3., 3., 3., 3.)

      CALL ROT3D(0., 0., 30.) 
      CALL MATOP3(1.0, 0.3, 0.3, 'diffuse')
      CALL PYRA3D(-2., -5., -10., 3., 5., 5., 4)

      CALL ROT3D(0., 0., 0.) 
      CALL MATOP3(1.0, 0.0, 0.0, 'diffuse')
      CALL TORUS3D(7., -3., -2., 1.5, 3.5, 1.5, 0., 360., 40, 20)
      CALL ROT3D(0., 90., 0.) 

      CALL MATOP3(0.0, 1.0, 0.0, 'diffuse')
      CALL TORUS3D(7., -5., -2., 1.5, 3.5, 1.5, 0., 360., 40, 20)
      CALL ZBFFIN()
      CALL DISFIN()
      END PROGRAM EXA12_7

---

Map Plot / Fortran 90

      PROGRAM EX13_1
      USE DISLIN
      IMPLICIT NONE

      CALL SCRMOD('REVERS')
      CALL SETPAG('DA4L')
      CALL METAFL('CONS')
      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()
      STOP
      END PROGRAM EX13_1

---

TeX Instructions for Mathematical Formulas / Fortran 90

      PROGRAM EXA_13
      USE DISLIN
      IMPLICIT NONE
      CHARACTER(LEN=80) :: CSTR
      INTEGER :: NL

      CALL SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      CALL DISINI()
      CALL PAGERA()
      CALL COMPLX()
      CALL HEIGHT(40)

      CSTR='TeX Instructions for Mathematical Formulas'
      NL=NLMESS(CSTR)
      CALL MESSAG(CSTR, (2100 - nl)/2, 100)
  
      CALL TEXMOD('ON')
      CALL MESSAG('$\frac{1}{x+y}$', 150, 400)
      CALL MESSAG('$\frac{a^2 - b^2}{a+b} = a - b$', 1200, 400)
  
      CALL MESSAG('$r = \sqrt{x^2 + y^2}', 150, 700)
      CALL MESSAG('$\cos \phi = \frac{x}{\sqrt{x^2 + y^2}}$', 1200, 700)

      CALL MESSAG('$\Gamma(x) = \int_0^\infty e^{-t}t^{x-1}dt$', 150, 1000)
      CALL MESSAG('$\lim_{x \to \infty} (1 + \frac{1}{x})^x = e$', 1200, 1000)

      CALL MESSAG('$\mu = \sum_{i=1}^n x_i p_i$', 150, 1300)
      CALL MESSAG('$\mu = \int_{-\infty}^ \infty x f(x) dx$', 1200, 1300)

      CALL MESSAG('$\overline{x} = \frac{1}{n} \sum_{i=1}^n x_i$', 150, 1600)
      CALL MESSAG('$s^2 = \frac{1}{n-1} \sum_{i=1}^n (x_i - \overline{x})^2$', &
          1200, 1600)

      CALL MESSAG('$\sqrt[n]{\frac{x^n - y^n}{1 + u^{2n}}}$', 150, 1900)  
      CALL MESSAG('$\sqrt[3]{-q + \sqrt{q^2 + p^3}}$', 1200, 1900)

      CALL MESSAG('$\int \frac{dx}{1+x^2} = \arctan x + C$', 150, 2200)
      CALL MESSAG('$\int \frac{dx}{\sqrt{1+x^2}} = {\rm arsinh} x + C$', &
          1200, 2200)

      CALL MESSAG('$\overline{P_1P_2} = \sqrt{(x_2-x_1)^2 + (y_2-y_1)^2}$', &
           150,2500)
      CALL MESSAG('$x = \frac{x_1 + \lambda x_2}{1 + \lambda}$', 1200, 2500)

      CALL DISFIN()
      STOP
      END PROGRAM EXA_13