Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0082/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