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
130
131
132
|
SUBROUTINE TPWRZI (IERROR)
C
C LATEST REVISION JULY, 1984
C
C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF
C PWRZI IN CONJUNCTION WITH ISOSRF
C
C USAGE CALL TPWRZI (IERROR)
C
C ARGUMENTS
C
C ON OUTPUT IERROR
C AN INTEGER VARIABLE
C = 0, IF THE TEST WAS SUCCESSFUL,
C = 1, OTHERWISE
C
C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE
C
C PWRZI TEST SUCCESSFUL . . . SEE PLOT TO
C VERIFY PERFORMANCE
C
C IS PRINTED ON UNIT 6.
C IN ADDITION, ONE FRAME CONTAINING THE SAMPLE
C PLOT IS PRODUCED ON THE MACHINE GRAPHICS
C DEVICE. IN ORDER TO DETERMINE IF THE TEST
C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
C THIS PLOT.
C
C PRECISION SINGLE
C
C REQUIRED LIBRARY PWRZI, ISOSRF
C FILES
C
C
C LANGUAGE FORTRAN
C
C ALGORITHM A FUNCTION OF THREE VARIABLES IS DEFINED, AND
C VALUES OF THE FUNCTION ON A THREE DIMENSIONAL
C RECTANGULAR GRID ARE STORED IN AN ARRAY. THIS
C SUBROUTINE THEN CALLS ISOSRF TO DRAW AN
C ISO-VALUED SURFACE PLOT OF THE FUNCTION,
C THEN PWRZI IS CALLED THREE TIMES TO
C LABEL THE FRONT, SIDE, AND BACK OF THE
C PICTURE.
C
C PORTABILITY ANSI FORTRAN 77
C
C
DIMENSION T(21,31,19),SLAB(33,33),EYE(3)
C
C SPECIFY COORDINATES FOR PLOT TITLES. ON AN ABSTRACT GRID WHERE
C THE INTEGER COORDINATES RANGE FROM 0.0 TO 1.0, THE VALUES TX AND TY
C DEFINE THE CENTER OF THE TITLE STRING.
C
DATA TX/0.4375/, TY/0.9667/
C
DATA NU,NV,NW/21,31,19/
DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./
DATA TISO/0./
DATA MUVWP2/33/
DATA IFLAG/-7/
C
C INITIALIZE ERROR PARAMETER
C
IERROR = 1
C
C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED
C
JCENT1 = FLOAT(NV)*.5-RBIG1*.5
JCENT2 = FLOAT(NV)*.5+RBIG2*.5
DO 30 I=1,NU
FIMID = I-NU/2
DO 20 J=1,NV
FJMID1 = J-JCENT1
FJMID2 = J-JCENT2
DO 10 K=1,NW
FKMID = K-NW/2
F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1))
F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1))
FIP1 = (1.-F1)*FIMID
FIP2 = (1.-F2)*FIMID
FJP1 = (1.-F1)*FJMID1
FJP2 = (1.-F2)*FJMID2
FKP1 = (1.-F1)*FKMID
FKP2 = (1.-F2)*FKMID
T(I,J,K) = AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1-
1 RSML1*RSML1,
2 FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2)
10 CONTINUE
20 CONTINUE
30 CONTINUE
C
C DEFINE EYE POSITION
C
EYE(1) = 100.
EYE(2) = 150.
EYE(3) = 125.
C
C SELECT NORMALIZATION TRANS NUMBER 0
C
CALL GSELNT (0)
C
C
C LABEL THE PLOT
C
CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR PWRZI',2,0,0)
C
C TEST ISOSRF WITH SUBARRAY OF T
C
MU = NU/2
MV = NV/2
MW = NW/2
MUVWP2 = MAX0(MU,MV,MW)+2
CALL ISOSRF (T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO,
1 IFLAG)
ISIZE = 35
CALL PWRZI (5.,16.,.5,'FRONT',5,ISIZE,-1,3,0)
CALL PWRZI (11.,7.5,.5,'SIDE',4,ISIZE,2,-1,0)
CALL PWRZI (5.,1.,5.,' BACK BACK BACK BACK BACK',25,ISIZE,-1,3,0)
CALL SETUSV ('XF',10)
CALL SETUSV ('YF',10)
CALL NEWFM
IERROR = 0
C
c WRITE (6,1001)
RETURN
C
C
c1001 FORMAT (' PWRZI TEST SUCCESSFUL',24X,
c 1 'SEE PLOT TO VERIFY PERFORMANCE')
C
END
|
