DISLIN

Helmut Michels
Staff member computer centre
Phone: +49 551 384 979-334

DISLIN Examples / Fortran 77

Demonstration of CURVE / Fortran 77

      PROGRAM EXA_1
      PARAMETER (N=301)
      DIMENSION XRAY(N),Y1RAY(N),Y2RAY(N)

      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 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 HEIGHT(50)
      CALL TITLE

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

Polar Plots / Fortran 77

      PROGRAM EXA_2
      PARAMETER (N=300,M=10)
      REAL XRAY(300),YRAY(300),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 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

Symbols / Fortran 77

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

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

Interpolation Methods / Fortran 77

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

Bar Graphs / Fortran 77

      PROGRAM 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 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 BARS(X,Y,Y1,9)
          CALL BARS(X,Y,Y2,9)
          CALL BARS(X,Y,Y3,9)
          CALL RESET('BARGRP')
        ELSE IF(I.EQ.2) THEN
          CALL HEIGHT(30)
          CALL LABELS('DELTA','BARS')
          CALL LABPOS('CENTER','BARS')
          CALL BARS(X,Y,Y1,9)
          CALL BARS(X,Y1,Y2,9)
          CALL BARS(X,Y2,Y3,9)
          CALL HEIGHT(36)
        ELSE IF(I.EQ.3) THEN
          CALL LABELS('SECOND','BARS')
          CALL LABPOS('OUTSIDE','BARS')
          CALL BARS(X,Y,Y1,9)
        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

Pie Charts / Fortran 77

      PROGRAM 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 SCRMOD('REVERS')
      CALL SETPAG('DA4P')
      CALL METAFL('CONS')
      CALL DISINI
      CALL PAGERA
      CALL COMPLX
      CALL AXSLEN(1600,1000)
      CALL TITLIN(CTIT,2)

      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     Selecting shading patterns
      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

3-D Bar Graph / 3-D Pie Chart / Fortran 77

      PROGRAM EXA_11
      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 SCRMOD('REVERS')
      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
      END

3-D Bars / BARS3D / Fortran 77

      PROGRAM EX12_3
      PARAMETER (N=18)
      DIMENSION XRAY(N),YRAY(N),Z1RAY(N),Z2RAY(N),XWRAY(N),
     *          YWRAY(N),ICRAY(N)
      CHARACTER*80 CBUF

      DATA XRAY/1., 3., 8., 1.5, 9., 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/
      DATA YRAY/5., 8., 3.5, 2., 7., 1.,4.3, 7.2, 6.0, 8.5,
     *         4.1, 5.0, 7.3, 2.8, 1.6, 8.9, 9.5, 3.2/
      DATA Z1RAY/0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
     *           0., 0., 0., 0., 0., 0., 0., 0./
      DATA Z2RAY/4.,5.,3.,2.,3.5,4.5,2.,1.6,3.8,4.7,
     *           2.1, 3.5, 1.9, 4.2, 4.9, 2.8, 3.6, 4.3/ 
      DATA ICRAY/30, 30, 30, 30, 30, 30, 100, 100, 100, 100,
     *           100, 100, 170, 170, 170, 170, 170, 170/

      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
      END

Shading Patterns / Fortran 77

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

3-D Colour Plot / Fortran 77

      PROGRAM EX11_1
      PARAMETER (N=100)
      DIMENSION ZMAT(N,N)

      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',1)
      CALL TITLIN('F(X,Y) = 2 * SIN(X) * SIN(Y)',3)

      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
      END  

Surface Plot / Fortran 77

      PROGRAM EXA_12
      CHARACTER*60 CTIT1,CTIT2
      EXTERNAL ZFUN

      CTIT1='Surface Plot (SURFUN)'
      CTIT2='F(X,Y) = 2*SIN(X)*SIN(Y)' 

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

Shaded Surface Plot / Fortran 77

      PROGRAM EXA_12
      CHARACTER*60 CTIT1,CTIT2
      PARAMETER (N=50)
      DIMENSION ZMAT(N,N),XRAY(N),YRAY(N)

      FPI=3.1415927/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

      CTIT1='Shaded Surface Plot'
      CTIT2='F(X,Y) = 2*SIN(X)*SIN(Y)' 

      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 SURSHD(XRAY,N,YRAY,N,ZMAT)
      CALL DISFIN
      END     

Contour Plot / Fortran 77

      PROGRAM EX14_1
      PARAMETER (N=50)
      REAL XRAY(50),YRAY(50),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 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
        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

Shaded Contour Plot / Fortran 77

      PROGRAM EX14_3
      PARAMETER (N=50)
      DIMENSION ZMAT(N,N),ZLEV(12),XRAY(N),YRAY(N)

      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 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
      END  

Shaded Surface / Contour Plot / Fortran 77

      PROGRAM EXA12_5
      CHARACTER*60 CTIT1,CTIT2
      PARAMETER (N=50,NLEV=20)
      DIMENSION ZMAT(N,N),XRAY(N),YRAY(N),ZLEV(NLEV)

      FPI=3.1415927/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

      CTIT1='Shaded Surface / Contour Plot'
      CTIT2='F(X,Y) = 2*SIN(X)*SIN(Y)' 

      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
      END     

Spheres and Tubes / Fortran 77

      PROGRAM EXA12_6
      REAL X(17),Y(17),Z(17)
      INTEGER IDX(56)
     
      DATA X/10., 20., 10., 20., 5., 15., 25., 5., 15., 25., 
     *            5., 15., 25., 10., 20., 10., 20./
      DATA Y/10., 10., 20., 20., 5., 5., 5., 15., 15., 15.,
     *            25., 25., 25., 10., 10., 20., 20./
      DATA Z/5., 5., 5., 5., 15., 15., 15., 15., 15., 15.,
     *            15., 15., 15., 25., 25., 25., 25./ 
      DATA 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/

      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

Some Solids / Fortran 77

      PROGRAM EXA12_7

      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 MATOP3(1.0,0.5,0.0,'diffuse')

      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

Map Plot / Fortran 77

      PROGRAM EX13_1

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

Tex Instructions for Mathematical Formulas / Fortran 77

      PROGRAM EXA_13
      CHARACTER CSTR*80

      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
      END 
 
loading content