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