Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50344/plot.dem
There is 1 other file named plot.dem in the archive. Click here to see a list.
C [DEM19]
C TETRAHEDRAL WAVE FUNCTIONS
C DEMONSTRATION TO EXERCISE THE PROGRAMS PLTSV, D19SP, VISSS, AND
C OTHERS WHICH MIGHT USE SPHERICAL POLAR COORDINATES. THIS INCLUDES
C HIDDEN SURFACE, CONTOURING AND SHADING OPTIONS, AS WELL AS SEVERAL
C MULTICOLOR TECHNIQUES. THE SURFACE EMPLOYED IS A RATHER SIMPLE
C APPROXIMATION TO THE TETRAHEDRAL BONDING FUNCTIONS, AND THEREFORE
C IS ONE WHICH HAS LARGE LOBES IN THE TETRAHEDRAL DIRECTIONS. THE
C VARIABLE L SELECTS ONE OF THE OPTIONS.
C L=1 ORDINARY PERSPECTIVE AND CONTOURS
C L=2 CHECKERBOARD OF LATITUDE AND LONGITUDE
C L=3 CONTOUR BANDS
C [21-MAY-75]
EXTERNAL PLTCA,PLTPO,D19SP,VISSP
DIMENSION EF(240,61)
COMMON O(3,3)
AS(J,I)=0.1*FLOAT(MOD(I+J,2))
L=1
NT=61
NP=240
S=-1.0
CALL PLTEU (O,10.0,-60.0,10.0)
DT=3.14159/FLOAT(NT-1)
DP=6.28318/FLOAT(NP)
T=3.14159
DO 20 I=1,NT
P=0.475
DO 10 J=1,NP
TF=0.67*(1.0+0.5*COS(3.0*T)+S*0.1667*COS(9.0*T))
PF=0.67*(1.0+0.5*SIN(3.0*P)-S*0.1667*SIN(9.0*P))
RA=TF*PF
IF (L.EQ.1) EF(J,I)=RA
IF (L.EQ.2) EF(J,I)=SIGN(RA,SIN(6.0*T)*SIN(12.0*P))
IF (L.EQ.3) EF(J,I)=SIGN(RA,SIN(31.4*RA))
10 P=P+DP
20 T=T-DT
CALL PLT00
CALL PLTFR
CALL PLTUR (-0.1,0.0,1.0,1.0,1.1,-0.1,0.0,1.0,1.0,1.1,0.02,PLTCA)
CALL PLTSV (EF,NP,NT,1.0,O,VISSP,PLTPO)
CALL PLTLA ('DEM19')
CALL PLTEJ
IF (L.LE.1) GO TO 30
CALL PLT00
CALL PLTFR
CALL PLTUR (-0.1,0.0,1.0,1.0,1.1,-0.1,0.0,1.0,1.0,1.1,0.02,PLTCA)
CALL PLTSV (EF,NP,NT,-1.0,O,VISSP,PLTPO)
CALL PLTEJ
RETURN
30 CALL PLT00
CALL PLTFR
CALL PLTKX (0.50,EF,1.0,NP,NT,D19SP)
CALL PLTKY (0.80,EF,1.0,NP,NT,D19SP)
CALL PLTKP (0.0,EF,1.0,51,7,NP,5,NT,D19SP)
CALL PLTLA ('DEM19')
CALL PLTEJ
END
SUBROUTINE D19SP (PH,TH,P)
C [SPHERICAL POLAR]
C CHANGE THE ANGULAR VARIABLES PH,TH TO THE CARTESIAN COORDINATES
C X,Z SO AS TO DEFINE DIRECTLY IN SPHERICAL POLAR COORDINATES POINTS
C WHICH LIE UPON THE SURFACE OF A CONSTANT SPHERE AND GRAPH THEIR
C PROJECTION ON THE X-Y PLANE. PH,TH ARE BOTH SUPPOSED TO LIE IN
C THE RANGE 0.0 .LE. PH,TH .LE. 1.0, SINCE THIS IS THE RANGE ASSUMED
C BY SUCH SUBROUTINES AS THE CONTOURING PROGRAMS. SPECIALLY ADAPTED
C FOR DEM19 FROM VISSP.
C [23-JUN-75]
LOGICAL P
COMMON O(3,3)
EQUIVALENCE (O11,O(1,1)),(O12,O(1,2)),(O13,O(1,3))
EQUIVALENCE (O21,O(2,1)),(O22,O(2,2)),(O23,O(2,3))
EQUIVALENCE (O31,O(3,1)),(O32,O(3,2)),(O33,O(3,3))
THE=3.14159*TH
PHI=6.28318*PH
X=SIN(THE)*COS(PHI)
Y=SIN(THE)*SIN(PHI)
Z=COS(THE)
U=O11*X+O12*Y+O13*Z
V=O21*X+O22*Y+O23*Z
W=O31*X+O32*Y+O33*Z
RO=SQRT(U*U+V*V)
FI=ATAN2(V,U)/6.28318
CALL PLTPO (FI,RO,(P.AND.(W.GE.0.0)))
RETURN
END
C [DEM28]
C DEMONSTRATION OF THE POTENTIAL FELT BY TWO PARTICLES IN A GAUSSIAN
C WELL. THE SURFACE ARISES FROM THE USE OF HYPERSPHERICAL HARMONICS
C IN QUANTUM MECHANICS. HERE IT IS USED TO ILLUSTRATE A TECHNIQUE
C OF SKETCHING OUT A COARSE SURFACE INTO WHICH IS INSERTED A DENSER
C REGION OF SPECIAL INTEREST. THE DETAIL WHICH IS DESIRED IS THE
C SHAPE OF THE BOTTOM OF THE TROUGHS CROSSING AT THE CENTER OF THE
C DRAWING.
C [06-OCT-74]
EXTERNAL PLTCA
DIMENSION VE(97,97)
EX(I)=0.0667*FLOAT(I-57)
WY(J)=0.0487*FLOAT(J-41)
NX=97
NY=97
DO 10 I=1,NX
DO 10 J=1,NY
X1=EX(I)
X2=WY(J)
R1=EXP(-X1*X1)
R2=EXP(-X2*X2)
RR=EXP(-0.25*(X1-X2)*(X1-X2))
10 VE(I,J)=TANH(0.4*(-2.0*R1-2.0*R2+RR))
CALL PLT00
CALL PLTFR
CALL PLTLA ('DEM28')
CALL DEMS1 (-1.0,VE,1.0,NX,NY)
CALL PLTEJ
CALL PLTBO
CALL PLTLA ('DEM28')
CALL PLTKP (-1.0,VE,1.0,51,5,NX,5,NY,PLTCA)
CALL PLTEJ
CALL EXIT
END
C ==================================================================
SUBROUTINE DEMS1 (Z1,Z,Z2,NX,NY)
C [06-OCT-74]
EXTERNAL PLTCA
DIMENSION Z(1)
COMMON/VIS/ N0
N0=0
CALL VISDS (Z1,Z,Z2,1,NX,NX,1,NY,NY,0.2,0.2,-8,8,PLTCA)
N0=0
CALL VISDS (Z1,Z,Z2,1,57,NX,41,NY,NY,0.2,0.2,-1,1,PLTCA)
RETURN
END
C [DEM30]
C DEMONSTRATION FOR THE REPRESENTATION OF A FUNCTION OF A COMPLEX
C VARIABLE. THE COMPLEX CONTOURING PROGRAM PLTKC AUTOMATICALLY
C CONTOURS BOTH THE MODULUS AND THE ARGUMENT OF A COMPLEX FUNCTION,
C WHICH IT RECEIVES IN THE FORM OF A COMPLEX ARRAY.
C [26-MAY-75]
EXTERNAL PLTCA
COMPLEX P,U,V,Z,W(121,121)
P(Z)=1.0+Z*(1.0+Z*(1.0+Z*(1.0+Z*(1.0+Z))))
NX=121
NY=121
X1=-1.5
X2= 1.5
Y1=-1.5
Y2= 1.5
DX=(X2-X1)/FLOAT(NX-1)
DY=(Y2-Y1)/FLOAT(NY-1)
Y=Y1
DO 20 I=1,NY
X=X1
DO 10 J=1,NX
Z=CMPLX(X,Y)
U=1.0/P(Z)-Z
W(J,I)=U
10 X=X+DX
20 Y=Y+DY
CALL PLT00
CALL PLTBO
CALL PLTUR (X1,X1,1.0,X2,X2,Y1,Y1,1.0,Y2,Y2,0.01,PLTCA)
CALL PLTLA ('DEM30')
CALL PLTKC (0.0,W,10.0,51,4,NX,4,NY,PLTCA)
CALL PLTEJ
CALL EXIT
END
C [DEM31]
C DEMONSTRATION FOR THE REPRESENTATION OF A FUNCTION OF A COMPLEX
C VARIABLE. THE MODULUS OF THE FUNCTION CAN BE SHOWN AS A SURFACE IN
C THREE DIMENSIONS, BUT THE PHASE IS LOST IN THE PROCESS. BY SHOWING
C CONTOURS OF CONSTANT PHASE THE LOST INFORMATION IS REGAINED, BUT
C IT IS HARD TO SHOW CONTOURS ON A SURFACE ALREADY DENSELY POPULATED
C BY LINEAR ARCS. BY SHOWING REGIONS OF DIFFERENT PHASE IN DIFFERENT
C COLORS THE INFORMATION IS PRESENTED IN A READILY PERCEIVABLE FORM.
C [26-MAY-75]
EXTERNAL PLTCA
COMPLEX P,U,V,Z
DIMENSION W(121,121)
P(Z)=1.0+Z*(1.0+Z*(1.0+Z*(1.0+Z*(1.0+Z))))
RO=45.0
TI=22.50
NX=121
NY=121
X1=-1.5
X2= 1.5
Y1=-1.5
Y2= 1.5
DX=(X2-X1)/FLOAT(NX-1)
DY=(Y2-Y1)/FLOAT(NY-1)
Y=Y1
DO 20 I=1,NY
X=X1
DO 10 J=1,NX
Z=CMPLX(X,Y)
U=1.0/P(Z)-Z
AM=CABS(U)
PH=CARG(U)
W(J,I)=SIGN(TANH(0.25*AM),SIN(2.0*PH))
10 X=X+DX
20 Y=Y+DY
CALL PLT00
CALL PLTFR
CALL PLTLA ('DEM31')
CALL PLTUR (-0.1,0.0,1.0,1.0,1.1,-0.1,0.0,1.0,1.0,1.1,0.02,PLTCA)
CALL PVIIV (0.0,W,1.0,NX,NY,RO,TI,1.0,PLTCA)
CALL PLTEJ
CALL PLT00
CALL PLTFR
CALL PLTUR (-0.1,0.0,1.0,1.0,1.1,-0.1,0.0,1.0,1.0,1.1,0.02,PLTCA)
CALL PVIIV (0.0,W,1.0,NX,NY,RO,TI,-1.0,PLTCA)
CALL PLTEJ
CALL EXIT
END
C [DEM32]
C DEMONSTRATION FOR THE INCLINED VIEW PROGRAM PLTIV. THE SURFACE
C REPRESENTED IS THE SAME ONE USED IN DEM30 AND DEM31, WHICH IS THE
C ABSOLUTE VALUE OF A FUNCTION OF A COMPLEX VARIABLE WITH FIVE POLES
C LOCATED AT THE VERTICES OF A REGULAR HEXAGON. TWO OPTIONS SHOW
C SHOW DIFFERENT STAGES OR ROTATION ABOUT A VERTICAL AXIS (L=1) OR
C DIFFERENT DEGREES OF TILT ABOUT A HORIZONTAL AXIS (L=2).
C [30-MAY-75]
EXTERNAL PLTCA,PLTQ1,PLTQ2,PLTQ3,PLTQ4
COMPLEX P,U,V,Z
DIMENSION O(3,3),W(121,121)
P(Z)=1.0+Z*(1.0+Z*(1.0+Z*(1.0+Z*(1.0+Z))))
L=2
NX=121
NY=121
X1=-1.5
X2= 1.5
Y1=-1.5
Y2= 1.5
DX=(X2-X1)/FLOAT(NX-1)
DY=(Y2-Y1)/FLOAT(NY-1)
Y=Y1
DO 20 I=1,NY
X=X1
DO 10 J=1,NX
Z=CMPLX(X,Y)
U=1.0/P(Z)-Z
AM=CABS(U)
W(J,I)=TANH(0.25*AM)
10 X=X+DX
W( 1,I)=0.0
W(NX,I)=0.0
20 Y=Y+DY
DO 30 J=1,NY
W(J, 1)=0.0
30 W(J,NY)=0.0
CALL PLT00
CALL PLTFR
CALL PLTLA ('DEM32')
IF (L.EQ.1) CALL PLTIV (0.0,W,1.0,NX,NY,-45.0,47.1,PLTQ1)
IF (L.EQ.1) CALL PLTIV (0.0,W,1.0,NX,NY,-135.0,47.1,PLTQ2)
IF (L.EQ.1) CALL PLTIV (0.0,W,1.0,NX,NY,135.0,47.1,PLTQ3)
IF (L.EQ.1) CALL PLTIV (0.0,W,1.0,NX,NY,45.0,47.1,PLTQ4)
IF (L.EQ.2) CALL PLTIV (0.0,W,1.0,NX,NY,60.0,15.0,PLTQ1)
IF (L.EQ.2) CALL PLTIV (0.0,W,1.0,NX,NY,60.0,30.0,PLTQ2)
IF (L.EQ.2) CALL PLTIV (0.0,W,1.0,NX,NY,60.0,60.0,PLTQ3)
IF (L.EQ.2) CALL PLTIV (0.0,W,1.0,NX,NY,60.0,88.0,PLTQ4)
CALL PLTEJ
CALL EXIT
END
C [DEM34]
C DEMONSTRATION FOR THE ORTHOGRAPHIC RELIEF PROGRAM. THE SURFACE
C SHOWN IS RELATED TO THE SURFACE OF DEM30, DEM31, AND DEM33, BY THE
C SUBTRACTION OF THE VARIABLE Z. THE OBJECTIVE IS TO LOCATE POINTS
C WHERE THAT SURFACE EQUALS Z; ORTHOGRAPHIC RELIEF WILL SOMETIMES
C AID TO DISTINGUISH DEPRESSIONS IN A SURFACE FROM PROTRUBERANCES.
C OPTION L ALLOWS GENERATION OF AN ORTHOGRAPHIC RELIEF (L=2) OR AN
C ORDINARY CONTOUR (L=1). IF THESE ARE DONE IN TWO DIFFERENT COLORS
C AND SUPERPOSED, THEY WILL SOMETIMES ENHANCE ONE ANOTHER.
C [08-JUN-75]
EXTERNAL PLTCA
COMPLEX P,U,V,Z
DIMENSION W(121,121)
P(Z)=1.0+Z*(1.0+Z*(1.0+Z*(1.0+Z*(1.0+Z))))
L=1
NX=121
NY=121
X1=-1.5
X2= 1.5
Y1=-1.5
Y2= 1.5
DX=(X2-X1)/FLOAT(NX-1)
DY=(Y2-Y1)/FLOAT(NY-1)
Y=Y1
DO 20 I=1,NY
X=X1
DO 10 J=1,NX
Z=CMPLX(X,Y)
U=1.0/P(Z)-Z
W(J,I)=TANH(CABS(U))
10 X=X+DX
20 Y=Y+DY
CALL PLT00
CALL PLTBO
CALL PLTUR (X1,X1,1.0,X2,X2,Y1,Y1,1.0,Y2,Y2,0.01,PLTCA)
CALL PLTLA ('DEM34')
IF (L.EQ.1) CALL PLTKP (0.0,W,1.0,101,4,NX,4,NY,PLTCA)
IF (L.EQ.2) CALL PLTOR (0.0,W,1.0,151,4,NX,4,NY,PLTCA)
CALL PLTEJ
CALL EXIT
END
C [DEM38]
C DEMONSTRATION PROGRAM FOR PLTRI. THE PRINCIPAL POINT OF INTEREST
C IN THIS DEMONSTRATION IS THE FACT THAT VIRTUALLY ANY COORDINATE
C SYSTEM MAY BE USED FOR PLOTTING A GRAPH, AND THAT THE AXIS DRAWING
C OPTION WILL FAITHFULLY DRAW THE COORDINATE AXES OF THE SYSTEM IN
C USE. BY SELECTING OPTIONS L=1,2,3,4,5, THE FIVE COORDINATE SYSTEMS
C CARTESIAN, POLAR, ELLIPTIC, SPHERICAL POLAR, OR TRIANGULAR, MAY BE
C TESTED.
C [07-JUN-75]
EXTERNAL PLTCA,PLTPO,PLTEL,PLTSP,PLTTR
EX(TE)=0.5*(1.0+SIN(0.5*TE*(1.0+0.5*TE)))
WY(TE)=0.4*(COS(TE)+0.3*COS(2.0*TE)+0.1*COS(3.0*TE))
DT=0.005
L=3
N=1001
CALL PLT00
CALL PLTBO
CALL PLTLA ('DEM38')
CALL PLTIG (0.0,0.0,1,PLTPO)
CALL PLTIG (1.0,1.0,2,PLTPO)
TE=0.0
IF (L.EQ.1) CALL PLTIG (EX(TE),WY(TE),3,PLTCA)
IF (L.EQ.2) CALL PLTIG (EX(TE),WY(TE),3,PLTPO)
IF (L.EQ.3) CALL PLTIG (EX(TE),WY(TE),3,PLTEL)
IF (L.EQ.4) CALL PLTIG (EX(TE),WY(TE),3,PLTSP)
IF (L.EQ.5) CALL PLTIG (EX(TE),WY(TE),3,PLTTR)
DO 10 I=1,N
IF (L.EQ.1) CALL PLTIG (EX(TE),WY(TE),4,PLTCA)
IF (L.EQ.2) CALL PLTIG (EX(TE),WY(TE),4,PLTPO)
IF (L.EQ.3) CALL PLTIG (EX(TE),WY(TE),4,PLTEL)
IF (L.EQ.4) CALL PLTIG (EX(TE),WY(TE),4,PLTSP)
IF (L.EQ.5) CALL PLTIG (EX(TE),WY(TE),4,PLTTR)
10 TE=TE+DT
TE=0.0
DO 20 I=1,11
IF (L.EQ.1) CALL PLTIG (TE,TE,5,PLTCA)
IF (L.EQ.2) CALL PLTIG (TE,TE,5,PLTPO)
IF (L.EQ.3) CALL PLTIG (TE,TE,5,PLTEL)
IF (L.EQ.4) CALL PLTIG (TE,TE,5,PLTSP)
IF (L.EQ.5) CALL PLTIG (TE,TE,5,PLTTR)
20 TE=TE+0.1
TE=0.0
DO 30 I=1,21
IF (L.EQ.1) CALL PLTIG (EX(TE),WY(TE),6,PLTCA)
IF (L.EQ.2) CALL PLTIG (EX(TE),WY(TE),6,PLTPO)
IF (L.EQ.3) CALL PLTIG (EX(TE),WY(TE),6,PLTEL)
IF (L.EQ.4) CALL PLTIG (EX(TE),WY(TE),6,PLTSP)
IF (L.EQ.5) CALL PLTIG (EX(TE),WY(TE),6,PLTTR)
30 TE=TE+0.05
CALL PLTEJ
CALL EXIT
END