1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
SUBROUTINE TTHREE (IERROR)
C
C LATEST REVISION JULY, 1984
C
C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF
C THE ROUTINE THREED.
C
C USAGE CALL TTHREE (IERROR)
C
C ARGUMENTS
C
C ON OUTPUT IERROR
C AN INTEGER VARIABLE
C =0 IF THERE IS A NORMAL EXIT FROM THE
C ROUTINE THREED.
C =1 OTHERWISE
C
C I/O IF THERE IS A NORMAL EXIT FROM THE ROUTINE
C THREED THE MESSAGE
C THREED TEST SUCCESSFUL . . . SEE PLOT TO
C VERIFY PERFORMANCE
C IS PRINTED.
C
C PRECISION SINGLE
C
C LANGUAGE FORTRAN
C
C HISTORY ORIGINALLY WRITTEN NOVEMBER 1976
C CONVERTED TO GKS AND FORTRAN 77 JULY 1984
C
C ALGORITHM ROUTINE TTHREE CALLS SET3 TO ESTABLISH A
C MAPPING BETWEEN THE PLOTTER ADDRESSES AND
C THE USER'S VOLUME, AND TO INDICATE THE
C COORDINATES OF THE EYE POSITION FROM
C WHICH THE LINES TO BE DRAWN ARE VIEWED.
C NEXT, THE VOLUME PERIMETERS AND ASSOCIATED
C TICK MARKS ARE DRAWN BY CALLS TO PERIM3.
C THEN THE LINES ARE DRAWN. THESE ARE
C CERTAIN LATITUDES AND LONGITUDES OF A
C SPHERE.
C
C PORTABILITY ANSI FORTRAN 77
C
C
C
C
REAL EYE(3),X(31),Y(31),Z(31)
C
C SPECIFY ARGUMENT VALUES TO BE USED BY ROUTINE SET3. ON AN
C ABSTRACT PLOTTER WITH AN ADDRESS RANGE OF 0. TO 1. IN EACH
C COORDINATE DIRECTION, THE VALUES RXA, RXB, RYA, AND RYB
C DEFINE THE PORTION OF THE ADDRESS SPACE TO BE USED IN MAKING
C THE PLOT. UC, UD, VC, VD, WC, WD DEFINE A VOLUME IN USER
C COORDINATES WHICH IS TO BE MAPPED ONTO THE PORTION OF THE
C VIEWING SURFACE AS SPECIFIED BY RXA, RXB, RYA, AND RYB.
C
DATA RXA/0.097656/, RXB/0.90236/, RYA/0.097656/, RYB/0.90236/
DATA UC/-1./, UD/1./, VC/-1./, VD/1./, WC/-1./, WD/1./
DATA EYE(1),EYE(2),EYE(3)/10.,6.,3./
DATA TX/0.4374/, TY/0.9570/
C
C DEFINE PI
DATA PI/3.1415926535898/
C
C
C SELECT NORMALIZATION TRANSFORMATION 0
C
CALL GSELNT (0)
C
C CALL SET3 TO ESTABLISH A MAPPING BETWEEN THE PLOTTER ADDRESSES
C AND THE USER'S VOLUME, AND TO INDICATE THE COORDINATES OF THE
C EYE POSITION FROM WHICH THE LINES TO BE DRAWN ARE VIEWED.
C
CALL SET3(RXA,RXB,RYA,RYB,UC,UD,VC,VD,WC,WD,EYE)
C
C CALL PERIM3 TO DRAW PERIMETER LINES AND TICK MARKS
C
CALL PERIM3(2,5,1,10,1,-1.)
CALL PERIM3(4,2,1,1,2,-1.)
CALL PERIM3(2,10,4,5,3,-1.)
C
C DEFINE AND DRAW LATITUDINAL LINES ON THE SPHERE OF RADIUS ONE
C HAVING CENTER (0.,0.,0.)
C
DO 10 J=1,18
THETA = FLOAT(J)*PI/9.
CT = COS(THETA)
ST = SIN(THETA)
DO 20 K=1,31
PHI = FLOAT(K-16)*PI/30.
Z(K) = SIN(PHI)
CP = COS(PHI)
X(K) = CT*CP
Y(K) = ST*CP
20 CONTINUE
CALL CURVE3(X,Y,Z,31)
10 CONTINUE
C
C DEFINE AND DRAW LONGITUDINAL LINES ON THE SPHERE OF RADIUS ONE
C HAVING CENTER (0.,0.,0.)
C
DO 30 K=1,5
PHI = FLOAT(K-3)*PI/6.
SP = SIN(PHI)
CP = COS(PHI)
DO 40 J=1,31
TUETA = FLOAT(J-1)*PI/15.
X(J) = COS(TUETA)*CP
Y(J) = SIN(TUETA)*CP
Z(J) = SP
40 CONTINUE
CALL CURVE3(X,Y,Z,31)
30 CONTINUE
C
C CALL WTSTR FOR THREED PLOT TITLE
C
CALL WTSTR(TX,TY,'DEMONSTRATION PLOT FOR ROUTINE THREED',2,0,0)
call pwrzt (1.,0.,-1.,'DEMONSTRATION PLOT FOR ROUTINE THREED', 37,
* 2, 2, 3, 0)
C
c CALL NEWFM
C
IERROR = 0
c WRITE(6,1001)
RETURN
C
c1001 FORMAT(' THREED TEST SUCCESSFUL', 24X,
c 1 'SEE PLOT TO VERIFY PERFORMANCE')
END
|
