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 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() STOP END PROGRAM EXA_1
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 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
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 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 MESSAG(CPOL(I),NX,NY) CALL CURVE(X,Y,16) IF(I.EQ.6) THEN CALL HEIGHT(50) CALL TITLE() END IF CALL ENDGRF() END DO CALL DISFIN() STOP END PROGRAM EXA_4
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 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() STOP END PROGRAM EX10_1
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 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) 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
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 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
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 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
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 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
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 SETPAG('DA4P') CALL DISINI() CALL PAGERA() CALL COMPLX() CALL AXSPOS(200,2600) CALL AXSLEN(1800,1800) CALL NAME('X-axis','X') CALL NAME('Y-axis','Y') CALL NAME('Z-axis','Z') CALL TITLIN(CTIT1,2) CALL TITLIN(CTIT2,4) CALL VIEW3D(-5.,-5.,4.,'ABS') CALL GRAF3D(0.,360.,0.,90.,0.,360.,0.,90.,-3.,3.,-3.,1.) CALL HEIGHT(50) CALL TITLE() CALL COLOR('GREEN') CALL SURMAT(ZMAT,N,N,1,1) CALL DISFIN() STOP END PROGRAM EXA_10
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 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() STOP END PROGRAM EX14_1
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 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() STOP END PROGRAM EX14_2
PROGRAM EX13_1 USE DISLIN IMPLICIT NONE 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() STOP END PROGRAM EX13_1
PROGRAM EXA_13 USE DISLIN IMPLICIT NONE CHARACTER(LEN=80) :: CSTR INTEGER :: NL CALL SETPAG('DA4P') 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