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
133
134
135
136
137
|
SUBROUTINE TISOSR (nplot, IERROR)
C
C LATEST REVISION DECEMBER 1984
C
C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF
C ISOSRF AND TO TEST ISOSRF ON A SINGLE PROBLEM
C
C USAGE CALL TISOSR (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 ISOSRF TEST SUCCESSFUL . . . SEE PLOT TO
C VERIFY PERFORMANCE
C
C IS WRITTEN ON UNIT 6.
C IN ADDITION, TWO FRAMES CONTAINING THE SAMPLE
C PLOTS ARE PRODUCED ON THE MACHINE GRAPHICS
C DEVICE. IN ORDER TO DETERMINE IF THE TEST
C WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
C THESE PLOTS.
C
C PRECISION SINGLE
C
C REQUIRED LIBRARY ISOSRF FROM ULIB LIBRARY
C FILES
C
C LANGUAGE STANDARD FORTRAN77
C
C HISTORY WRITTEN BY MEMBERS OF THE
C SCIENTIFIC COMPUTING DIVISION OF NCAR,
C BOULDER COLORADO
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 CALLS EZISOS AND ISOSRF TO DRAW ISO-
C VALUED SURFACE PLOTS OF THE FUNCTION.
C
C PORTABILITY ANSI STANDARD
C
C
SAVE
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 1 TO 1024, THE VALUES IX AND IY
C DEFINE THE CENTER OF THE TITLE STRING.
C
REAL IX,IY
DATA IX/.44/, IY/.95/
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 LABEL THE PLOT TO BE DRAWN BY EZISOS
C
if (nplot .eq. 1) then
CALL GSELNT(0)
CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY EZISOS OF ISOSRF',
1 2,0,0)
C
C TEST EZISOS
C
CALL EZISOS (T,NU,NV,NW,EYE,SLAB,TISO)
endif
C
C LABEL THE PLOT TO BE DRAWN BY ISOSRF
C
if (nplot .eq. 2) then
CALL GSELNT(0)
CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY ISOSRF OF ISOSRF',
1 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,IFLAG)
endif
c CALL FRAME
C
IERROR = 0
c WRITE (6,1001)
RETURN
C
c1001 FORMAT (' ISOSRF TEST SUCCESSFUL',24X,
c 1 'SEE PLOT TO VERIFY PERFORMANCE')
C
END
|
