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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
procedure srf_test()
char temp[SZ_LINE]
real z[20,30], x[20], y[30], s[6]
int mm[20,30,2]
real tx, ty
int i, j, m, n, isize
real xt, yt, dum
int ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, ncla, hskirt, ispval
real theta, chi, clo, cinc
common /srfip1/ ifr, istp, irots, idrx, idry, idrz, iupper, iskirt,
ncla, theta, hskirt, chi, clo, cinc, ispval
begin
# Some initialization that was originally in data statements:
tx = 0.4375
ty = 0.9667
m = 20
n = 30
s[1] = 4.0
s[2] = 5.0
s[3] = 3.0
s[4] = 0.0
s[5] = 0.0
s[6] = 0.0
# Define function values and store in z
DO I=1,M
X(I) = -1.+FLOAT(I-1)/FLOAT(M-1)*2.
DO J=1,N
Y(J) = -1.+FLOAT(J-1)/FLOAT(N-1)*2.
DO J=1,N {
DO I=1,M
Z(I,J) = EXP(-2.*SQRT(X(I)**2+Y(J)**2))
}
# Initialize block data before changing parameters.
call srfabd
IFR = 0
IDRZ = 1
CALL GSELNT (0)
call f77pak ("DEMONSTRATION PLOT FOR PWRZS", temp, SZ_LINE)
CALL WTSTR (TX,TY,temp,2,0,0)
CALL SRFACE (X,Y,Z,MM,M,M,N,S,0.)
#
# PUT PWRZS LABELS ON PICTURE
#
ISIZE = 35
call f77pak ("FRONT", temp, SZ_LINE)
CALL PWRZS (0.,1.1,0.,temp,5,ISIZE,-1,3,0)
call f77pak ("SIDE", temp, SZ_LINE)
CALL PWRZS (1.1,0.,0.,temp,4,ISIZE,2,-1,0)
call f77pak (" BACK BACK BACK BACK BACK", temp, SZ_LINE)
CALL PWRZS (0.,-1.1,.2,temp,25,ISIZE,-1,3,0)
#
# RESTORE SRFACE PARAMETERS TO DEFAULT
#
IFR = 1
IDRZ = 0
end
|
