Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

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