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
138
139
140
141
142
143
144
145
146
147
|
SUBROUTINE TCONAS (IERROR)
C
C LATEST REVISION AUGUST 1984
C
C PURPOSE TO PROVIDE A SIMPLE DEMONSTRATION OF
C CONRAS, THE SUPER ENTRY POINT OF THE
C CONRAN PACKAGE.
C
C USAGE CALL TCONAS (IERROR)
C
C ARGUMENTS
C
C ON OUTPUT IERROR
C AN INTEGER VARIABLE
C .EQ. 0, IF THE TEST WAS SUCCESSFUL,
C .NE. 0, OTHERWISE
C IF NOT ZERO THE NUMBER PRODUCED WILL
C CORRESPOND TO THE ERROR NUMBERS IN
C THE CONRAS LISTING.
C
C I/O IF THE TEST IS SUCCESSFUL, THE MESSAGE
C
C CONRAS TEST SUCCESSFUL . . . SEE PLOT TO
C VERIFY PERFORMANCE
C
C IS PRINTED ON UNIT 6.
C IN ADDITION, TWO FRAMES CONTAINING THE CONTOUR
C PLOT AND TRIANGULATION OF THE DATA ARE PRODUCED
C ON THE DEFAULT GRAPHICS DEVICE UNLESS THE USER
C SPECIFIES OTHERWISE VIA JCL.
C
C PRECISION SINGLE
C
C REQUIRED LIBRARY CONRAS
C FILES CONTERP
C CONCOM
C DASHSUPR
C
C SPECIALIST FOR INFORMATION ABOUT THIS ROUTINE OR THE
C ULIB CONRAS PACKAGE, CONTACT THE SPECIALIST
C NAMED IN THE ULIB CONRAS PACKAGE.
C
C LANGUAGE FORTRAN
C
C ALGORITHM A SPARSE DATA SET IS DEFINED VIA DATA
C STATEMENTS. OPTIONS ARE SET TO PRODUCE A
C TITLE AND DISPLAY THE TRIANGULATION GENERATED
C BY THE INTERPOLATING ROUTINES. BY DEFAULT
C A MESSAGE AT THE BOTTEM OF THE PLOT AND A
C PERIMETER ARE ALSO PRODUCED. THIS ROUTINE
C TAKES ADVANTAGE OF THE PORT ERROR HANDLING
C ROUTINES TO DETERMINE IF CONRAS TERMINATED
C NORMALLY.
C
C PORTABILITY ANSI STANDARD
C
C
C SET UP THE SCRATCH SPACES REQUIRED BY CONRAS
C
DIMENSION WK(221),IWK(744),SCR(1600)
C
C SET UP THE ARRAYS TO DEFINE THE DATA SET
C
DIMENSION XD(17),YD(17),ZD(17)
COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
C
C DEFINE THE DATA SET
C
DATA XD(1),XD(2),XD(3),XD(4),XD(5),XD(6),XD(7),XD(8),
1 XD(9),XD(10),XD(11),XD(12),XD(13),XD(14),XD(15),
2 XD(16),XD(17)
3 /3.,3.,10.,18.,18.,10.,10.,5.,1.,15.,20.,
4 5.,15.,10.,7.,13.,16./
C
DATA YD(1),YD(2),YD(3),YD(4),YD(5),YD(6),YD(7),YD(8),
1 YD(9),YD(10),YD(11),YD(12),YD(13),YD(14),YD(15),
2 YD(16),YD(17)
3 /3.,18.,18.,3.,18.,10.,1.,5.,10.,5.,10.,
4 15.,15.,15.,20.,20.,8./
C
DATA ZD(1),ZD(2),ZD(3),ZD(4),ZD(5),ZD(6),ZD(7),ZD(8),
1 ZD(9),ZD(10),ZD(11),ZD(12),ZD(13),ZD(14),ZD(15),
2 ZD(16),ZD(17)
3 /25.,25.,25.,25.,25.,-5.,1.,1.,1.,1.,1.,
4 1.,1.,1.,1.,1.,25./
C
C SET UP PARAMETER FOR NUMBER OF INPUT POINTS
C
DATA NDP/17/
C
C SET PORT ERROR HANDLING ROUTINE TO RECOVERY MODE
C
CALL ENTSR(IROLD,1)
C
C SET UP TITLE FOR PLOT
C
CALL CONOP4('TLE=ON','DEMONSTRATION PLOT FOR CONRAS',29,0)
C
C TEST FOR ERROR
C
IF (NERRO(IERROR).NE.0) GO TO 100
C
C NO ERROR
C
C SET OPTION TO DISPLAY THE TRIANGULATION
C
CALL CONOP1('TRI=ON')
C
C TEST FOR ERROR
C
IF (NERRO(IERROR).NE.0) GO TO 100
C
C NO ERROR
C
C CALL CONRAS TO CONTOUR DATA
C
CALL CONRAS(XD,YD,ZD,NDP,WK,IWK,SCR)
C
C TEST FOR ERROR
C
IF (NERRO(IERROR).NE.0) GO TO 100
C
C NO ERROR
C
C
C CALL FRAME, CONRAS WILL NOT DO THIS
C
c CALL NEWFM
C
C PRINT MESSAGE EVERYTHING OK
C
c WRITE(6,10)
c10 FORMAT(1X,'CONRAS TEST SUCCESSFUL, SEE PLOT TO VERIFY ',
c 1'PERFORMANCE')
C
C
RETURN
C
C IF ERROR CALL THE PORT ERROR PRINT ROUTINE.
C THIS CALL IS NOT NECESSARY UNLESS YOU ARE IN RECOVER MODE.
C IF YOU ARE NOT IN RECOVER MODE THE ERROR MESSAGE WILL BE PRINTED
C AUTOMATICALLY.
C
100 CALL EPRIN
RETURN
C
END
|