aboutsummaryrefslogtreecommitdiff
path: root/sys/gio/ncarutil/tests/conrast.f
blob: c4f3ab123dca4c86faecd79c4959fe8e4b190388 (plain) (blame)
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