1       SUBROUTINE DRTU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
2     1                  IBUGD2,IFOUND,IERROR)
3C
4C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
5C              FOR ROMAN TRIPLEX UPPER CASE (PART 1).
6C     WRITTEN BY--JAMES J. FILLIBEN
7C                 STATISTICAL ENGINEERING DIVISION
8C                 INFORMATION TECHNOLOGY LABORATORY
9C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10C                 GAITHERSBURG, MD 20899
11C                 PHONE--301-975-2855
12C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14C     LANGUAGE--ANSI FORTRAN (1977)
15C     VERSION NUMBER--87/4
16C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
17C     UPDATED         --MAY       1982.
18C     UPDATED         --MARCH     1987.
19C
20C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21C
22      CHARACTER*4 IOP
23      CHARACTER*4 IBUGD2
24      CHARACTER*4 IFOUND
25      CHARACTER*4 IERROR
26C
27      CHARACTER*4 IOPERA
28C
29C---------------------------------------------------------------------
30C
31      DIMENSION IOP(*)
32      DIMENSION X(*)
33      DIMENSION Y(*)
34C
35      DIMENSION IOPERA(300)
36      DIMENSION IX(300)
37      DIMENSION IY(300)
38C
39      DIMENSION IXMIND(30)
40      DIMENSION IXMAXD(30)
41      DIMENSION IXDELD(30)
42      DIMENSION ISTARD(30)
43      DIMENSION NUMCOO(30)
44C
45C-----COMMON----------------------------------------------------------
46C
47      INCLUDE 'DPCOP2.INC'
48C
49C-----DATA STATEMENTS-------------------------------------------------
50C
51C     DEFINE CHARACTER   3001--UPPER CASE A
52C
53      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',   0,  12/
54      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',  -7,  -8/
55      DATA IOPERA(   3),IX(   3),IY(   3)/'MOVE',  -1,   9/
56      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',   5,  -9/
57      DATA IOPERA(   5),IX(   5),IY(   5)/'MOVE',   0,   9/
58      DATA IOPERA(   6),IX(   6),IY(   6)/'DRAW',   6,  -9/
59      DATA IOPERA(   7),IX(   7),IY(   7)/'MOVE',   0,  12/
60      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',   7,  -9/
61      DATA IOPERA(   9),IX(   9),IY(   9)/'MOVE',  -5,  -3/
62      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',   4,  -3/
63      DATA IOPERA(  11),IX(  11),IY(  11)/'MOVE',  -9,  -9/
64      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',  -3,  -9/
65      DATA IOPERA(  13),IX(  13),IY(  13)/'MOVE',   2,  -9/
66      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',   9,  -9/
67      DATA IOPERA(  15),IX(  15),IY(  15)/'MOVE',  -7,  -8/
68      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',  -8,  -9/
69      DATA IOPERA(  17),IX(  17),IY(  17)/'MOVE',  -7,  -8/
70      DATA IOPERA(  18),IX(  18),IY(  18)/'DRAW',  -5,  -9/
71      DATA IOPERA(  19),IX(  19),IY(  19)/'MOVE',   5,  -8/
72      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',   3,  -9/
73      DATA IOPERA(  21),IX(  21),IY(  21)/'MOVE',   5,  -7/
74      DATA IOPERA(  22),IX(  22),IY(  22)/'DRAW',   4,  -9/
75      DATA IOPERA(  23),IX(  23),IY(  23)/'MOVE',   6,  -7/
76      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',   8,  -9/
77C
78      DATA IXMIND(   1)/ -10/
79      DATA IXMAXD(   1)/  10/
80      DATA IXDELD(   1)/  20/
81      DATA ISTARD(   1)/   1/
82      DATA NUMCOO(   1)/  24/
83C
84C     DEFINE CHARACTER   3002--UPPER CASE B
85C
86      DATA IOPERA(  25),IX(  25),IY(  25)/'MOVE',  -6,  12/
87      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',  -6,  -9/
88      DATA IOPERA(  27),IX(  27),IY(  27)/'MOVE',  -5,  11/
89      DATA IOPERA(  28),IX(  28),IY(  28)/'DRAW',  -5,  -8/
90      DATA IOPERA(  29),IX(  29),IY(  29)/'MOVE',  -4,  12/
91      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',  -4,  -9/
92      DATA IOPERA(  31),IX(  31),IY(  31)/'MOVE',  -9,  12/
93      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',   3,  12/
94      DATA IOPERA(  33),IX(  33),IY(  33)/'DRAW',   6,  11/
95      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',   7,  10/
96      DATA IOPERA(  35),IX(  35),IY(  35)/'DRAW',   8,   8/
97      DATA IOPERA(  36),IX(  36),IY(  36)/'DRAW',   8,   6/
98      DATA IOPERA(  37),IX(  37),IY(  37)/'DRAW',   7,   4/
99      DATA IOPERA(  38),IX(  38),IY(  38)/'DRAW',   6,   3/
100      DATA IOPERA(  39),IX(  39),IY(  39)/'DRAW',   3,   2/
101      DATA IOPERA(  40),IX(  40),IY(  40)/'MOVE',   6,  10/
102      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',   7,   8/
103      DATA IOPERA(  42),IX(  42),IY(  42)/'DRAW',   7,   6/
104      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',   6,   4/
105      DATA IOPERA(  44),IX(  44),IY(  44)/'MOVE',   3,  12/
106      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',   5,  11/
107      DATA IOPERA(  46),IX(  46),IY(  46)/'DRAW',   6,   9/
108      DATA IOPERA(  47),IX(  47),IY(  47)/'DRAW',   6,   5/
109      DATA IOPERA(  48),IX(  48),IY(  48)/'DRAW',   5,   3/
110      DATA IOPERA(  49),IX(  49),IY(  49)/'DRAW',   3,   2/
111      DATA IOPERA(  50),IX(  50),IY(  50)/'MOVE',  -4,   2/
112      DATA IOPERA(  51),IX(  51),IY(  51)/'DRAW',   3,   2/
113      DATA IOPERA(  52),IX(  52),IY(  52)/'DRAW',   6,   1/
114      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',   7,   0/
115      DATA IOPERA(  54),IX(  54),IY(  54)/'DRAW',   8,  -2/
116      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',   8,  -5/
117      DATA IOPERA(  56),IX(  56),IY(  56)/'DRAW',   7,  -7/
118      DATA IOPERA(  57),IX(  57),IY(  57)/'DRAW',   6,  -8/
119      DATA IOPERA(  58),IX(  58),IY(  58)/'DRAW',   3,  -9/
120      DATA IOPERA(  59),IX(  59),IY(  59)/'DRAW',  -9,  -9/
121      DATA IOPERA(  60),IX(  60),IY(  60)/'MOVE',   6,   0/
122      DATA IOPERA(  61),IX(  61),IY(  61)/'DRAW',   7,  -2/
123      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',   7,  -5/
124      DATA IOPERA(  63),IX(  63),IY(  63)/'DRAW',   6,  -7/
125      DATA IOPERA(  64),IX(  64),IY(  64)/'MOVE',   3,   2/
126      DATA IOPERA(  65),IX(  65),IY(  65)/'DRAW',   5,   1/
127      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',   6,  -1/
128      DATA IOPERA(  67),IX(  67),IY(  67)/'DRAW',   6,  -6/
129      DATA IOPERA(  68),IX(  68),IY(  68)/'DRAW',   5,  -8/
130      DATA IOPERA(  69),IX(  69),IY(  69)/'DRAW',   3,  -9/
131      DATA IOPERA(  70),IX(  70),IY(  70)/'MOVE',  -8,  12/
132      DATA IOPERA(  71),IX(  71),IY(  71)/'DRAW',  -6,  11/
133      DATA IOPERA(  72),IX(  72),IY(  72)/'MOVE',  -7,  12/
134      DATA IOPERA(  73),IX(  73),IY(  73)/'DRAW',  -6,  10/
135      DATA IOPERA(  74),IX(  74),IY(  74)/'MOVE',  -3,  12/
136      DATA IOPERA(  75),IX(  75),IY(  75)/'DRAW',  -4,  10/
137      DATA IOPERA(  76),IX(  76),IY(  76)/'MOVE',  -2,  12/
138      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW',  -4,  11/
139      DATA IOPERA(  78),IX(  78),IY(  78)/'MOVE',  -6,  -8/
140      DATA IOPERA(  79),IX(  79),IY(  79)/'DRAW',  -8,  -9/
141      DATA IOPERA(  80),IX(  80),IY(  80)/'MOVE',  -6,  -7/
142      DATA IOPERA(  81),IX(  81),IY(  81)/'DRAW',  -7,  -9/
143      DATA IOPERA(  82),IX(  82),IY(  82)/'MOVE',  -4,  -7/
144      DATA IOPERA(  83),IX(  83),IY(  83)/'DRAW',  -3,  -9/
145      DATA IOPERA(  84),IX(  84),IY(  84)/'MOVE',  -4,  -8/
146      DATA IOPERA(  85),IX(  85),IY(  85)/'DRAW',  -2,  -9/
147C
148      DATA IXMIND(   2)/ -11/
149      DATA IXMAXD(   2)/  11/
150      DATA IXDELD(   2)/  22/
151      DATA ISTARD(   2)/  25/
152      DATA NUMCOO(   2)/  61/
153C
154C     DEFINE CHARACTER   3003--UPPER CASE C
155C
156      DATA IOPERA(  86),IX(  86),IY(  86)/'MOVE',   6,   9/
157      DATA IOPERA(  87),IX(  87),IY(  87)/'DRAW',   7,  12/
158      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',   7,   6/
159      DATA IOPERA(  89),IX(  89),IY(  89)/'DRAW',   6,   9/
160      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',   4,  11/
161      DATA IOPERA(  91),IX(  91),IY(  91)/'DRAW',   2,  12/
162      DATA IOPERA(  92),IX(  92),IY(  92)/'DRAW',  -1,  12/
163      DATA IOPERA(  93),IX(  93),IY(  93)/'DRAW',  -4,  11/
164      DATA IOPERA(  94),IX(  94),IY(  94)/'DRAW',  -6,   9/
165      DATA IOPERA(  95),IX(  95),IY(  95)/'DRAW',  -7,   7/
166      DATA IOPERA(  96),IX(  96),IY(  96)/'DRAW',  -8,   4/
167      DATA IOPERA(  97),IX(  97),IY(  97)/'DRAW',  -8,  -1/
168      DATA IOPERA(  98),IX(  98),IY(  98)/'DRAW',  -7,  -4/
169      DATA IOPERA(  99),IX(  99),IY(  99)/'DRAW',  -6,  -6/
170      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',  -4,  -8/
171      DATA IOPERA( 101),IX( 101),IY( 101)/'DRAW',  -1,  -9/
172      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',   2,  -9/
173      DATA IOPERA( 103),IX( 103),IY( 103)/'DRAW',   4,  -8/
174      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',   6,  -6/
175      DATA IOPERA( 105),IX( 105),IY( 105)/'DRAW',   7,  -4/
176      DATA IOPERA( 106),IX( 106),IY( 106)/'MOVE',  -5,   9/
177      DATA IOPERA( 107),IX( 107),IY( 107)/'DRAW',  -6,   7/
178      DATA IOPERA( 108),IX( 108),IY( 108)/'DRAW',  -7,   4/
179      DATA IOPERA( 109),IX( 109),IY( 109)/'DRAW',  -7,  -1/
180      DATA IOPERA( 110),IX( 110),IY( 110)/'DRAW',  -6,  -4/
181      DATA IOPERA( 111),IX( 111),IY( 111)/'DRAW',  -5,  -6/
182      DATA IOPERA( 112),IX( 112),IY( 112)/'MOVE',  -1,  12/
183      DATA IOPERA( 113),IX( 113),IY( 113)/'DRAW',  -3,  11/
184      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',  -5,   8/
185      DATA IOPERA( 115),IX( 115),IY( 115)/'DRAW',  -6,   4/
186      DATA IOPERA( 116),IX( 116),IY( 116)/'DRAW',  -6,  -1/
187      DATA IOPERA( 117),IX( 117),IY( 117)/'DRAW',  -5,  -5/
188      DATA IOPERA( 118),IX( 118),IY( 118)/'DRAW',  -3,  -8/
189      DATA IOPERA( 119),IX( 119),IY( 119)/'DRAW',  -1,  -9/
190C
191      DATA IXMIND(   3)/ -11/
192      DATA IXMAXD(   3)/  10/
193      DATA IXDELD(   3)/  21/
194      DATA ISTARD(   3)/  86/
195      DATA NUMCOO(   3)/  34/
196C
197C     DEFINE CHARACTER   3004--UPPER CASE D
198C
199      DATA IOPERA( 120),IX( 120),IY( 120)/'MOVE',  -6,  12/
200      DATA IOPERA( 121),IX( 121),IY( 121)/'DRAW',  -6,  -9/
201      DATA IOPERA( 122),IX( 122),IY( 122)/'MOVE',  -5,  11/
202      DATA IOPERA( 123),IX( 123),IY( 123)/'DRAW',  -5,  -8/
203      DATA IOPERA( 124),IX( 124),IY( 124)/'MOVE',  -4,  12/
204      DATA IOPERA( 125),IX( 125),IY( 125)/'DRAW',  -4,  -9/
205      DATA IOPERA( 126),IX( 126),IY( 126)/'MOVE',  -9,  12/
206      DATA IOPERA( 127),IX( 127),IY( 127)/'DRAW',   1,  12/
207      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',   4,  11/
208      DATA IOPERA( 129),IX( 129),IY( 129)/'DRAW',   6,   9/
209      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   7,   7/
210      DATA IOPERA( 131),IX( 131),IY( 131)/'DRAW',   8,   4/
211      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',   8,  -1/
212      DATA IOPERA( 133),IX( 133),IY( 133)/'DRAW',   7,  -4/
213      DATA IOPERA( 134),IX( 134),IY( 134)/'DRAW',   6,  -6/
214      DATA IOPERA( 135),IX( 135),IY( 135)/'DRAW',   4,  -8/
215      DATA IOPERA( 136),IX( 136),IY( 136)/'DRAW',   1,  -9/
216      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',  -9,  -9/
217      DATA IOPERA( 138),IX( 138),IY( 138)/'MOVE',   5,   9/
218      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',   6,   7/
219      DATA IOPERA( 140),IX( 140),IY( 140)/'DRAW',   7,   4/
220      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',   7,  -1/
221      DATA IOPERA( 142),IX( 142),IY( 142)/'DRAW',   6,  -4/
222      DATA IOPERA( 143),IX( 143),IY( 143)/'DRAW',   5,  -6/
223      DATA IOPERA( 144),IX( 144),IY( 144)/'MOVE',   1,  12/
224      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',   3,  11/
225      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',   5,   8/
226      DATA IOPERA( 147),IX( 147),IY( 147)/'DRAW',   6,   4/
227      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',   6,  -1/
228      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',   5,  -5/
229      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',   3,  -8/
230      DATA IOPERA( 151),IX( 151),IY( 151)/'DRAW',   1,  -9/
231      DATA IOPERA( 152),IX( 152),IY( 152)/'MOVE',  -8,  12/
232      DATA IOPERA( 153),IX( 153),IY( 153)/'DRAW',  -6,  11/
233      DATA IOPERA( 154),IX( 154),IY( 154)/'MOVE',  -7,  12/
234      DATA IOPERA( 155),IX( 155),IY( 155)/'DRAW',  -6,  10/
235      DATA IOPERA( 156),IX( 156),IY( 156)/'MOVE',  -3,  12/
236      DATA IOPERA( 157),IX( 157),IY( 157)/'DRAW',  -4,  10/
237      DATA IOPERA( 158),IX( 158),IY( 158)/'MOVE',  -2,  12/
238      DATA IOPERA( 159),IX( 159),IY( 159)/'DRAW',  -4,  11/
239      DATA IOPERA( 160),IX( 160),IY( 160)/'MOVE',  -6,  -8/
240      DATA IOPERA( 161),IX( 161),IY( 161)/'DRAW',  -8,  -9/
241      DATA IOPERA( 162),IX( 162),IY( 162)/'MOVE',  -6,  -7/
242      DATA IOPERA( 163),IX( 163),IY( 163)/'DRAW',  -7,  -9/
243      DATA IOPERA( 164),IX( 164),IY( 164)/'MOVE',  -4,  -7/
244      DATA IOPERA( 165),IX( 165),IY( 165)/'DRAW',  -3,  -9/
245      DATA IOPERA( 166),IX( 166),IY( 166)/'MOVE',  -4,  -8/
246      DATA IOPERA( 167),IX( 167),IY( 167)/'DRAW',  -2,  -9/
247C
248      DATA IXMIND(   4)/ -11/
249      DATA IXMAXD(   4)/  11/
250      DATA IXDELD(   4)/  22/
251      DATA ISTARD(   4)/ 120/
252      DATA NUMCOO(   4)/  48/
253C
254C     DEFINE CHARACTER   3005--UPPER CASE E
255C
256      DATA IOPERA( 168),IX( 168),IY( 168)/'MOVE',  -6,  12/
257      DATA IOPERA( 169),IX( 169),IY( 169)/'DRAW',  -6,  -9/
258      DATA IOPERA( 170),IX( 170),IY( 170)/'MOVE',  -5,  11/
259      DATA IOPERA( 171),IX( 171),IY( 171)/'DRAW',  -5,  -8/
260      DATA IOPERA( 172),IX( 172),IY( 172)/'MOVE',  -4,  12/
261      DATA IOPERA( 173),IX( 173),IY( 173)/'DRAW',  -4,  -9/
262      DATA IOPERA( 174),IX( 174),IY( 174)/'MOVE',  -9,  12/
263      DATA IOPERA( 175),IX( 175),IY( 175)/'DRAW',   7,  12/
264      DATA IOPERA( 176),IX( 176),IY( 176)/'DRAW',   7,   6/
265      DATA IOPERA( 177),IX( 177),IY( 177)/'MOVE',  -4,   2/
266      DATA IOPERA( 178),IX( 178),IY( 178)/'DRAW',   2,   2/
267      DATA IOPERA( 179),IX( 179),IY( 179)/'MOVE',   2,   6/
268      DATA IOPERA( 180),IX( 180),IY( 180)/'DRAW',   2,  -2/
269      DATA IOPERA( 181),IX( 181),IY( 181)/'MOVE',  -9,  -9/
270      DATA IOPERA( 182),IX( 182),IY( 182)/'DRAW',   7,  -9/
271      DATA IOPERA( 183),IX( 183),IY( 183)/'DRAW',   7,  -3/
272      DATA IOPERA( 184),IX( 184),IY( 184)/'MOVE',  -8,  12/
273      DATA IOPERA( 185),IX( 185),IY( 185)/'DRAW',  -6,  11/
274      DATA IOPERA( 186),IX( 186),IY( 186)/'MOVE',  -7,  12/
275      DATA IOPERA( 187),IX( 187),IY( 187)/'DRAW',  -6,  10/
276      DATA IOPERA( 188),IX( 188),IY( 188)/'MOVE',  -3,  12/
277      DATA IOPERA( 189),IX( 189),IY( 189)/'DRAW',  -4,  10/
278      DATA IOPERA( 190),IX( 190),IY( 190)/'MOVE',  -2,  12/
279      DATA IOPERA( 191),IX( 191),IY( 191)/'DRAW',  -4,  11/
280      DATA IOPERA( 192),IX( 192),IY( 192)/'MOVE',   2,  12/
281      DATA IOPERA( 193),IX( 193),IY( 193)/'DRAW',   7,  11/
282      DATA IOPERA( 194),IX( 194),IY( 194)/'MOVE',   4,  12/
283      DATA IOPERA( 195),IX( 195),IY( 195)/'DRAW',   7,  10/
284      DATA IOPERA( 196),IX( 196),IY( 196)/'MOVE',   5,  12/
285      DATA IOPERA( 197),IX( 197),IY( 197)/'DRAW',   7,   9/
286      DATA IOPERA( 198),IX( 198),IY( 198)/'MOVE',   6,  12/
287      DATA IOPERA( 199),IX( 199),IY( 199)/'DRAW',   7,   6/
288      DATA IOPERA( 200),IX( 200),IY( 200)/'MOVE',   2,   6/
289      DATA IOPERA( 201),IX( 201),IY( 201)/'DRAW',   1,   2/
290      DATA IOPERA( 202),IX( 202),IY( 202)/'DRAW',   2,  -2/
291      DATA IOPERA( 203),IX( 203),IY( 203)/'MOVE',   2,   4/
292      DATA IOPERA( 204),IX( 204),IY( 204)/'DRAW',   0,   2/
293      DATA IOPERA( 205),IX( 205),IY( 205)/'DRAW',   2,   0/
294      DATA IOPERA( 206),IX( 206),IY( 206)/'MOVE',   2,   3/
295      DATA IOPERA( 207),IX( 207),IY( 207)/'DRAW',  -2,   2/
296      DATA IOPERA( 208),IX( 208),IY( 208)/'DRAW',   2,   1/
297      DATA IOPERA( 209),IX( 209),IY( 209)/'MOVE',  -6,  -8/
298      DATA IOPERA( 210),IX( 210),IY( 210)/'DRAW',  -8,  -9/
299      DATA IOPERA( 211),IX( 211),IY( 211)/'MOVE',  -6,  -7/
300      DATA IOPERA( 212),IX( 212),IY( 212)/'DRAW',  -7,  -9/
301      DATA IOPERA( 213),IX( 213),IY( 213)/'MOVE',  -4,  -7/
302      DATA IOPERA( 214),IX( 214),IY( 214)/'DRAW',  -3,  -9/
303      DATA IOPERA( 215),IX( 215),IY( 215)/'MOVE',  -4,  -8/
304      DATA IOPERA( 216),IX( 216),IY( 216)/'DRAW',  -2,  -9/
305      DATA IOPERA( 217),IX( 217),IY( 217)/'MOVE',   2,  -9/
306      DATA IOPERA( 218),IX( 218),IY( 218)/'DRAW',   7,  -8/
307      DATA IOPERA( 219),IX( 219),IY( 219)/'MOVE',   4,  -9/
308      DATA IOPERA( 220),IX( 220),IY( 220)/'DRAW',   7,  -7/
309      DATA IOPERA( 221),IX( 221),IY( 221)/'MOVE',   5,  -9/
310      DATA IOPERA( 222),IX( 222),IY( 222)/'DRAW',   7,  -6/
311      DATA IOPERA( 223),IX( 223),IY( 223)/'MOVE',   6,  -9/
312      DATA IOPERA( 224),IX( 224),IY( 224)/'DRAW',   7,  -3/
313C
314      DATA IXMIND(   5)/ -11/
315      DATA IXMAXD(   5)/  10/
316      DATA IXDELD(   5)/  21/
317      DATA ISTARD(   5)/ 168/
318      DATA NUMCOO(   5)/  57/
319C
320C     DEFINE CHARACTER   3006--UPPER CASE F
321C
322      DATA IOPERA( 225),IX( 225),IY( 225)/'MOVE',  -6,  12/
323      DATA IOPERA( 226),IX( 226),IY( 226)/'DRAW',  -6,  -9/
324      DATA IOPERA( 227),IX( 227),IY( 227)/'MOVE',  -5,  11/
325      DATA IOPERA( 228),IX( 228),IY( 228)/'DRAW',  -5,  -8/
326      DATA IOPERA( 229),IX( 229),IY( 229)/'MOVE',  -4,  12/
327      DATA IOPERA( 230),IX( 230),IY( 230)/'DRAW',  -4,  -9/
328      DATA IOPERA( 231),IX( 231),IY( 231)/'MOVE',  -9,  12/
329      DATA IOPERA( 232),IX( 232),IY( 232)/'DRAW',   7,  12/
330      DATA IOPERA( 233),IX( 233),IY( 233)/'DRAW',   7,   6/
331      DATA IOPERA( 234),IX( 234),IY( 234)/'MOVE',  -4,   2/
332      DATA IOPERA( 235),IX( 235),IY( 235)/'DRAW',   2,   2/
333      DATA IOPERA( 236),IX( 236),IY( 236)/'MOVE',   2,   6/
334      DATA IOPERA( 237),IX( 237),IY( 237)/'DRAW',   2,  -2/
335      DATA IOPERA( 238),IX( 238),IY( 238)/'MOVE',  -9,  -9/
336      DATA IOPERA( 239),IX( 239),IY( 239)/'DRAW',  -1,  -9/
337      DATA IOPERA( 240),IX( 240),IY( 240)/'MOVE',  -8,  12/
338      DATA IOPERA( 241),IX( 241),IY( 241)/'DRAW',  -6,  11/
339      DATA IOPERA( 242),IX( 242),IY( 242)/'MOVE',  -7,  12/
340      DATA IOPERA( 243),IX( 243),IY( 243)/'DRAW',  -6,  10/
341      DATA IOPERA( 244),IX( 244),IY( 244)/'MOVE',  -3,  12/
342      DATA IOPERA( 245),IX( 245),IY( 245)/'DRAW',  -4,  10/
343      DATA IOPERA( 246),IX( 246),IY( 246)/'MOVE',  -2,  12/
344      DATA IOPERA( 247),IX( 247),IY( 247)/'DRAW',  -4,  11/
345      DATA IOPERA( 248),IX( 248),IY( 248)/'MOVE',   2,  12/
346      DATA IOPERA( 249),IX( 249),IY( 249)/'DRAW',   7,  11/
347      DATA IOPERA( 250),IX( 250),IY( 250)/'MOVE',   4,  12/
348      DATA IOPERA( 251),IX( 251),IY( 251)/'DRAW',   7,  10/
349      DATA IOPERA( 252),IX( 252),IY( 252)/'MOVE',   5,  12/
350      DATA IOPERA( 253),IX( 253),IY( 253)/'DRAW',   7,   9/
351      DATA IOPERA( 254),IX( 254),IY( 254)/'MOVE',   6,  12/
352      DATA IOPERA( 255),IX( 255),IY( 255)/'DRAW',   7,   6/
353      DATA IOPERA( 256),IX( 256),IY( 256)/'MOVE',   2,   6/
354      DATA IOPERA( 257),IX( 257),IY( 257)/'DRAW',   1,   2/
355      DATA IOPERA( 258),IX( 258),IY( 258)/'DRAW',   2,  -2/
356      DATA IOPERA( 259),IX( 259),IY( 259)/'MOVE',   2,   4/
357      DATA IOPERA( 260),IX( 260),IY( 260)/'DRAW',   0,   2/
358      DATA IOPERA( 261),IX( 261),IY( 261)/'DRAW',   2,   0/
359      DATA IOPERA( 262),IX( 262),IY( 262)/'MOVE',   2,   3/
360      DATA IOPERA( 263),IX( 263),IY( 263)/'DRAW',  -2,   2/
361      DATA IOPERA( 264),IX( 264),IY( 264)/'DRAW',   2,   1/
362      DATA IOPERA( 265),IX( 265),IY( 265)/'MOVE',  -6,  -8/
363      DATA IOPERA( 266),IX( 266),IY( 266)/'DRAW',  -8,  -9/
364      DATA IOPERA( 267),IX( 267),IY( 267)/'MOVE',  -6,  -7/
365      DATA IOPERA( 268),IX( 268),IY( 268)/'DRAW',  -7,  -9/
366      DATA IOPERA( 269),IX( 269),IY( 269)/'MOVE',  -4,  -7/
367      DATA IOPERA( 270),IX( 270),IY( 270)/'DRAW',  -3,  -9/
368      DATA IOPERA( 271),IX( 271),IY( 271)/'MOVE',  -4,  -8/
369      DATA IOPERA( 272),IX( 272),IY( 272)/'DRAW',  -2,  -9/
370C
371      DATA IXMIND(   6)/ -11/
372      DATA IXMAXD(   6)/   9/
373      DATA IXDELD(   6)/  20/
374      DATA ISTARD(   6)/ 225/
375      DATA NUMCOO(   6)/  48/
376C
377C-----START POINT-----------------------------------------------------
378C
379      IFOUND='YES'
380      IERROR='NO'
381C
382      NUMCO=1
383      ISTART=1
384      ISTOP=1
385      NC=1
386C
387C               ******************************************
388C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
389C               **  HERSHEY CHARACTER SET CASE          **
390C               ******************************************
391C
392C
393      IF(IBUGD2.EQ.'OFF')GOTO90
394      WRITE(ICOUT,999)
395  999 FORMAT(1X)
396      CALL DPWRST('XXX','BUG ')
397      WRITE(ICOUT,51)
398   51 FORMAT('***** AT THE BEGINNING OF DRTU1--')
399      CALL DPWRST('XXX','BUG ')
400      WRITE(ICOUT,52)ICHARN
401   52 FORMAT('ICHARN = ',I8)
402      CALL DPWRST('XXX','BUG ')
403      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
404   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
405      CALL DPWRST('XXX','BUG ')
406   90 CONTINUE
407C
408C               **************************************
409C               **  STEP 2--                        **
410C               **  EXTRACT THE COORDINATES         **
411C               **  FOR THIS PARTICULAR CHARACTER.  **
412C               **************************************
413C
414      ISTART=ISTARD(ICHARN)
415      NC=NUMCOO(ICHARN)
416      ISTOP=ISTART+NC-1
417      J=0
418      DO1100I=ISTART,ISTOP
419      J=J+1
420      IOP(J)=IOPERA(I)
421      X(J)=IX(I)
422      Y(J)=IY(I)
423 1100 CONTINUE
424      NUMCO=J
425      IXMINS=IXMIND(ICHARN)
426      IXMAXS=IXMAXD(ICHARN)
427      IXDELS=IXDELD(ICHARN)
428C
429      GOTO9000
430C
431C               *****************
432C               **  STEP 90--  **
433C               **  EXIT       **
434C               *****************
435C
436 9000 CONTINUE
437      IF(IBUGD2.EQ.'OFF')GOTO9090
438      WRITE(ICOUT,999)
439      CALL DPWRST('XXX','BUG ')
440      WRITE(ICOUT,9011)
441 9011 FORMAT('***** AT THE END       OF DRTU1--')
442      CALL DPWRST('XXX','BUG ')
443      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
444 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
445      CALL DPWRST('XXX','BUG ')
446      WRITE(ICOUT,9013)ICHARN
447 9013 FORMAT('ICHARN = ',I8)
448      CALL DPWRST('XXX','BUG ')
449      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
450 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
451      CALL DPWRST('XXX','BUG ')
452      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
453      DO9015I=1,NUMCO
454      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
455 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
456      CALL DPWRST('XXX','BUG ')
457 9015 CONTINUE
458 9019 CONTINUE
459      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
460 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
461      CALL DPWRST('XXX','BUG ')
462 9090 CONTINUE
463C
464      RETURN
465      END
466      SUBROUTINE DRTU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
467     1IBUGD2,IFOUND,IERROR)
468C
469C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
470C              FOR ROMAN TRIPLEX UPPER CASE (PART 2).
471C     WRITTEN BY--JAMES J. FILLIBEN
472C                 STATISTICAL ENGINEERING DIVISION
473C                 INFORMATION TECHNOLOGY LABORATORY
474C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
475C                 GAITHERSBURG, MD 20899
476C                 PHONE--301-975-2855
477C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
478C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
479C     LANGUAGE--ANSI FORTRAN (1977)
480C     VERSION NUMBER--87/4
481C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
482C     UPDATED         --MAY       1982.
483C     UPDATED         --MARCH     1987.
484C
485C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
486C
487      CHARACTER*4 IOP
488      CHARACTER*4 IBUGD2
489      CHARACTER*4 IFOUND
490      CHARACTER*4 IERROR
491C
492      CHARACTER*4 IOPERA
493C
494C---------------------------------------------------------------------
495C
496      DIMENSION IOP(*)
497      DIMENSION X(*)
498      DIMENSION Y(*)
499C
500      DIMENSION IOPERA(300)
501      DIMENSION IX(300)
502      DIMENSION IY(300)
503C
504      DIMENSION IXMIND(30)
505      DIMENSION IXMAXD(30)
506      DIMENSION IXDELD(30)
507      DIMENSION ISTARD(30)
508      DIMENSION NUMCOO(30)
509C
510C-----COMMON----------------------------------------------------------
511C
512      INCLUDE 'DPCOP2.INC'
513C
514C-----DATA STATEMENTS-------------------------------------------------
515C
516C     DEFINE CHARACTER   3007--UPPER CASE G
517C
518      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',   6,   9/
519      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',   7,  12/
520      DATA IOPERA(   3),IX(   3),IY(   3)/'DRAW',   7,   6/
521      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',   6,   9/
522      DATA IOPERA(   5),IX(   5),IY(   5)/'DRAW',   4,  11/
523      DATA IOPERA(   6),IX(   6),IY(   6)/'DRAW',   2,  12/
524      DATA IOPERA(   7),IX(   7),IY(   7)/'DRAW',  -1,  12/
525      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',  -4,  11/
526      DATA IOPERA(   9),IX(   9),IY(   9)/'DRAW',  -6,   9/
527      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',  -7,   7/
528      DATA IOPERA(  11),IX(  11),IY(  11)/'DRAW',  -8,   4/
529      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',  -8,  -1/
530      DATA IOPERA(  13),IX(  13),IY(  13)/'DRAW',  -7,  -4/
531      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',  -6,  -6/
532      DATA IOPERA(  15),IX(  15),IY(  15)/'DRAW',  -4,  -8/
533      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',  -1,  -9/
534      DATA IOPERA(  17),IX(  17),IY(  17)/'DRAW',   2,  -9/
535      DATA IOPERA(  18),IX(  18),IY(  18)/'DRAW',   4,  -8/
536      DATA IOPERA(  19),IX(  19),IY(  19)/'DRAW',   6,  -8/
537      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',   7,  -9/
538      DATA IOPERA(  21),IX(  21),IY(  21)/'DRAW',   7,  -1/
539      DATA IOPERA(  22),IX(  22),IY(  22)/'MOVE',  -5,   9/
540      DATA IOPERA(  23),IX(  23),IY(  23)/'DRAW',  -6,   7/
541      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',  -7,   4/
542      DATA IOPERA(  25),IX(  25),IY(  25)/'DRAW',  -7,  -1/
543      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',  -6,  -4/
544      DATA IOPERA(  27),IX(  27),IY(  27)/'DRAW',  -5,  -6/
545      DATA IOPERA(  28),IX(  28),IY(  28)/'MOVE',  -1,  12/
546      DATA IOPERA(  29),IX(  29),IY(  29)/'DRAW',  -3,  11/
547      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',  -5,   8/
548      DATA IOPERA(  31),IX(  31),IY(  31)/'DRAW',  -6,   4/
549      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',  -6,  -1/
550      DATA IOPERA(  33),IX(  33),IY(  33)/'DRAW',  -5,  -5/
551      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',  -3,  -8/
552      DATA IOPERA(  35),IX(  35),IY(  35)/'DRAW',  -1,  -9/
553      DATA IOPERA(  36),IX(  36),IY(  36)/'MOVE',   6,  -2/
554      DATA IOPERA(  37),IX(  37),IY(  37)/'DRAW',   6,  -7/
555      DATA IOPERA(  38),IX(  38),IY(  38)/'MOVE',   5,  -1/
556      DATA IOPERA(  39),IX(  39),IY(  39)/'DRAW',   5,  -7/
557      DATA IOPERA(  40),IX(  40),IY(  40)/'DRAW',   4,  -8/
558      DATA IOPERA(  41),IX(  41),IY(  41)/'MOVE',   2,  -1/
559      DATA IOPERA(  42),IX(  42),IY(  42)/'DRAW',  10,  -1/
560      DATA IOPERA(  43),IX(  43),IY(  43)/'MOVE',   3,  -1/
561      DATA IOPERA(  44),IX(  44),IY(  44)/'DRAW',   5,  -2/
562      DATA IOPERA(  45),IX(  45),IY(  45)/'MOVE',   4,  -1/
563      DATA IOPERA(  46),IX(  46),IY(  46)/'DRAW',   5,  -3/
564      DATA IOPERA(  47),IX(  47),IY(  47)/'MOVE',   8,  -1/
565      DATA IOPERA(  48),IX(  48),IY(  48)/'DRAW',   7,  -3/
566      DATA IOPERA(  49),IX(  49),IY(  49)/'MOVE',   9,  -1/
567      DATA IOPERA(  50),IX(  50),IY(  50)/'DRAW',   7,  -2/
568C
569      DATA IXMIND(   7)/ -11/
570      DATA IXMAXD(   7)/  12/
571      DATA IXDELD(   7)/  23/
572      DATA ISTARD(   7)/   1/
573      DATA NUMCOO(   7)/  50/
574C
575C     DEFINE CHARACTER   3008--UPPER CASE H
576C
577      DATA IOPERA(  51),IX(  51),IY(  51)/'MOVE',  -7,  12/
578      DATA IOPERA(  52),IX(  52),IY(  52)/'DRAW',  -7,  -9/
579      DATA IOPERA(  53),IX(  53),IY(  53)/'MOVE',  -6,  11/
580      DATA IOPERA(  54),IX(  54),IY(  54)/'DRAW',  -6,  -8/
581      DATA IOPERA(  55),IX(  55),IY(  55)/'MOVE',  -5,  12/
582      DATA IOPERA(  56),IX(  56),IY(  56)/'DRAW',  -5,  -9/
583      DATA IOPERA(  57),IX(  57),IY(  57)/'MOVE',   5,  12/
584      DATA IOPERA(  58),IX(  58),IY(  58)/'DRAW',   5,  -9/
585      DATA IOPERA(  59),IX(  59),IY(  59)/'MOVE',   6,  11/
586      DATA IOPERA(  60),IX(  60),IY(  60)/'DRAW',   6,  -8/
587      DATA IOPERA(  61),IX(  61),IY(  61)/'MOVE',   7,  12/
588      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',   7,  -9/
589      DATA IOPERA(  63),IX(  63),IY(  63)/'MOVE', -10,  12/
590      DATA IOPERA(  64),IX(  64),IY(  64)/'DRAW',  -2,  12/
591      DATA IOPERA(  65),IX(  65),IY(  65)/'MOVE',   2,  12/
592      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',  10,  12/
593      DATA IOPERA(  67),IX(  67),IY(  67)/'MOVE',  -5,   2/
594      DATA IOPERA(  68),IX(  68),IY(  68)/'DRAW',   5,   2/
595      DATA IOPERA(  69),IX(  69),IY(  69)/'MOVE', -10,  -9/
596      DATA IOPERA(  70),IX(  70),IY(  70)/'DRAW',  -2,  -9/
597      DATA IOPERA(  71),IX(  71),IY(  71)/'MOVE',   2,  -9/
598      DATA IOPERA(  72),IX(  72),IY(  72)/'DRAW',  10,  -9/
599      DATA IOPERA(  73),IX(  73),IY(  73)/'MOVE',  -9,  12/
600      DATA IOPERA(  74),IX(  74),IY(  74)/'DRAW',  -7,  11/
601      DATA IOPERA(  75),IX(  75),IY(  75)/'MOVE',  -8,  12/
602      DATA IOPERA(  76),IX(  76),IY(  76)/'DRAW',  -7,  10/
603      DATA IOPERA(  77),IX(  77),IY(  77)/'MOVE',  -4,  12/
604      DATA IOPERA(  78),IX(  78),IY(  78)/'DRAW',  -5,  10/
605      DATA IOPERA(  79),IX(  79),IY(  79)/'MOVE',  -3,  12/
606      DATA IOPERA(  80),IX(  80),IY(  80)/'DRAW',  -5,  11/
607      DATA IOPERA(  81),IX(  81),IY(  81)/'MOVE',   3,  12/
608      DATA IOPERA(  82),IX(  82),IY(  82)/'DRAW',   5,  11/
609      DATA IOPERA(  83),IX(  83),IY(  83)/'MOVE',   4,  12/
610      DATA IOPERA(  84),IX(  84),IY(  84)/'DRAW',   5,  10/
611      DATA IOPERA(  85),IX(  85),IY(  85)/'MOVE',   8,  12/
612      DATA IOPERA(  86),IX(  86),IY(  86)/'DRAW',   7,  10/
613      DATA IOPERA(  87),IX(  87),IY(  87)/'MOVE',   9,  12/
614      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',   7,  11/
615      DATA IOPERA(  89),IX(  89),IY(  89)/'MOVE',  -7,  -8/
616      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',  -9,  -9/
617      DATA IOPERA(  91),IX(  91),IY(  91)/'MOVE',  -7,  -7/
618      DATA IOPERA(  92),IX(  92),IY(  92)/'DRAW',  -8,  -9/
619      DATA IOPERA(  93),IX(  93),IY(  93)/'MOVE',  -5,  -7/
620      DATA IOPERA(  94),IX(  94),IY(  94)/'DRAW',  -4,  -9/
621      DATA IOPERA(  95),IX(  95),IY(  95)/'MOVE',  -5,  -8/
622      DATA IOPERA(  96),IX(  96),IY(  96)/'DRAW',  -3,  -9/
623      DATA IOPERA(  97),IX(  97),IY(  97)/'MOVE',   5,  -8/
624      DATA IOPERA(  98),IX(  98),IY(  98)/'DRAW',   3,  -9/
625      DATA IOPERA(  99),IX(  99),IY(  99)/'MOVE',   5,  -7/
626      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',   4,  -9/
627      DATA IOPERA( 101),IX( 101),IY( 101)/'MOVE',   7,  -7/
628      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',   8,  -9/
629      DATA IOPERA( 103),IX( 103),IY( 103)/'MOVE',   7,  -8/
630      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',   9,  -9/
631C
632      DATA IXMIND(   8)/ -12/
633      DATA IXMAXD(   8)/  12/
634      DATA IXDELD(   8)/  24/
635      DATA ISTARD(   8)/  51/
636      DATA NUMCOO(   8)/  54/
637C
638C     DEFINE CHARACTER   3009--UPPER CASE I
639C
640      DATA IOPERA( 105),IX( 105),IY( 105)/'MOVE',  -1,  12/
641      DATA IOPERA( 106),IX( 106),IY( 106)/'DRAW',  -1,  -9/
642      DATA IOPERA( 107),IX( 107),IY( 107)/'MOVE',   0,  11/
643      DATA IOPERA( 108),IX( 108),IY( 108)/'DRAW',   0,  -8/
644      DATA IOPERA( 109),IX( 109),IY( 109)/'MOVE',   1,  12/
645      DATA IOPERA( 110),IX( 110),IY( 110)/'DRAW',   1,  -9/
646      DATA IOPERA( 111),IX( 111),IY( 111)/'MOVE',  -4,  12/
647      DATA IOPERA( 112),IX( 112),IY( 112)/'DRAW',   4,  12/
648      DATA IOPERA( 113),IX( 113),IY( 113)/'MOVE',  -4,  -9/
649      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',   4,  -9/
650      DATA IOPERA( 115),IX( 115),IY( 115)/'MOVE',  -3,  12/
651      DATA IOPERA( 116),IX( 116),IY( 116)/'DRAW',  -1,  11/
652      DATA IOPERA( 117),IX( 117),IY( 117)/'MOVE',  -2,  12/
653      DATA IOPERA( 118),IX( 118),IY( 118)/'DRAW',  -1,  10/
654      DATA IOPERA( 119),IX( 119),IY( 119)/'MOVE',   2,  12/
655      DATA IOPERA( 120),IX( 120),IY( 120)/'DRAW',   1,  10/
656      DATA IOPERA( 121),IX( 121),IY( 121)/'MOVE',   3,  12/
657      DATA IOPERA( 122),IX( 122),IY( 122)/'DRAW',   1,  11/
658      DATA IOPERA( 123),IX( 123),IY( 123)/'MOVE',  -1,  -8/
659      DATA IOPERA( 124),IX( 124),IY( 124)/'DRAW',  -3,  -9/
660      DATA IOPERA( 125),IX( 125),IY( 125)/'MOVE',  -1,  -7/
661      DATA IOPERA( 126),IX( 126),IY( 126)/'DRAW',  -2,  -9/
662      DATA IOPERA( 127),IX( 127),IY( 127)/'MOVE',   1,  -7/
663      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',   2,  -9/
664      DATA IOPERA( 129),IX( 129),IY( 129)/'MOVE',   1,  -8/
665      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   3,  -9/
666C
667      DATA IXMIND(   9)/  -6/
668      DATA IXMAXD(   9)/   6/
669      DATA IXDELD(   9)/  12/
670      DATA ISTARD(   9)/ 105/
671      DATA NUMCOO(   9)/  26/
672C
673C     DEFINE CHARACTER   3010--UPPER CASE J
674C
675      DATA IOPERA( 131),IX( 131),IY( 131)/'MOVE',   1,  12/
676      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',   1,  -5/
677      DATA IOPERA( 133),IX( 133),IY( 133)/'DRAW',   0,  -8/
678      DATA IOPERA( 134),IX( 134),IY( 134)/'DRAW',  -1,  -9/
679      DATA IOPERA( 135),IX( 135),IY( 135)/'MOVE',   2,  11/
680      DATA IOPERA( 136),IX( 136),IY( 136)/'DRAW',   2,  -5/
681      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',   1,  -8/
682      DATA IOPERA( 138),IX( 138),IY( 138)/'MOVE',   3,  12/
683      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',   3,  -5/
684      DATA IOPERA( 140),IX( 140),IY( 140)/'DRAW',   2,  -8/
685      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',  -1,  -9/
686      DATA IOPERA( 142),IX( 142),IY( 142)/'DRAW',  -3,  -9/
687      DATA IOPERA( 143),IX( 143),IY( 143)/'DRAW',  -5,  -8/
688      DATA IOPERA( 144),IX( 144),IY( 144)/'DRAW',  -6,  -6/
689      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',  -6,  -4/
690      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',  -5,  -3/
691      DATA IOPERA( 147),IX( 147),IY( 147)/'DRAW',  -4,  -3/
692      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',  -3,  -4/
693      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',  -3,  -5/
694      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',  -4,  -6/
695      DATA IOPERA( 151),IX( 151),IY( 151)/'DRAW',  -5,  -6/
696      DATA IOPERA( 152),IX( 152),IY( 152)/'MOVE',  -5,  -4/
697      DATA IOPERA( 153),IX( 153),IY( 153)/'DRAW',  -5,  -5/
698      DATA IOPERA( 154),IX( 154),IY( 154)/'DRAW',  -4,  -5/
699      DATA IOPERA( 155),IX( 155),IY( 155)/'DRAW',  -4,  -4/
700      DATA IOPERA( 156),IX( 156),IY( 156)/'DRAW',  -5,  -4/
701      DATA IOPERA( 157),IX( 157),IY( 157)/'MOVE',  -2,  12/
702      DATA IOPERA( 158),IX( 158),IY( 158)/'DRAW',   6,  12/
703      DATA IOPERA( 159),IX( 159),IY( 159)/'MOVE',  -1,  12/
704      DATA IOPERA( 160),IX( 160),IY( 160)/'DRAW',   1,  11/
705      DATA IOPERA( 161),IX( 161),IY( 161)/'MOVE',   0,  12/
706      DATA IOPERA( 162),IX( 162),IY( 162)/'DRAW',   1,  10/
707      DATA IOPERA( 163),IX( 163),IY( 163)/'MOVE',   4,  12/
708      DATA IOPERA( 164),IX( 164),IY( 164)/'DRAW',   3,  10/
709      DATA IOPERA( 165),IX( 165),IY( 165)/'MOVE',   5,  12/
710      DATA IOPERA( 166),IX( 166),IY( 166)/'DRAW',   3,  11/
711C
712      DATA IXMIND(  10)/  -8/
713      DATA IXMAXD(  10)/   8/
714      DATA IXDELD(  10)/  16/
715      DATA ISTARD(  10)/ 131/
716      DATA NUMCOO(  10)/  36/
717C
718C     DEFINE CHARACTER   3011--UPPER CASE K
719C
720      DATA IOPERA( 167),IX( 167),IY( 167)/'MOVE',  -7,  12/
721      DATA IOPERA( 168),IX( 168),IY( 168)/'DRAW',  -7,  -9/
722      DATA IOPERA( 169),IX( 169),IY( 169)/'MOVE',  -6,  11/
723      DATA IOPERA( 170),IX( 170),IY( 170)/'DRAW',  -6,  -8/
724      DATA IOPERA( 171),IX( 171),IY( 171)/'MOVE',  -5,  12/
725      DATA IOPERA( 172),IX( 172),IY( 172)/'DRAW',  -5,  -9/
726      DATA IOPERA( 173),IX( 173),IY( 173)/'MOVE',   6,  11/
727      DATA IOPERA( 174),IX( 174),IY( 174)/'DRAW',  -5,   0/
728      DATA IOPERA( 175),IX( 175),IY( 175)/'MOVE',  -2,   2/
729      DATA IOPERA( 176),IX( 176),IY( 176)/'DRAW',   5,  -9/
730      DATA IOPERA( 177),IX( 177),IY( 177)/'MOVE',  -1,   2/
731      DATA IOPERA( 178),IX( 178),IY( 178)/'DRAW',   6,  -9/
732      DATA IOPERA( 179),IX( 179),IY( 179)/'MOVE',  -1,   4/
733      DATA IOPERA( 180),IX( 180),IY( 180)/'DRAW',   7,  -9/
734      DATA IOPERA( 181),IX( 181),IY( 181)/'MOVE', -10,  12/
735      DATA IOPERA( 182),IX( 182),IY( 182)/'DRAW',  -2,  12/
736      DATA IOPERA( 183),IX( 183),IY( 183)/'MOVE',   3,  12/
737      DATA IOPERA( 184),IX( 184),IY( 184)/'DRAW',   9,  12/
738      DATA IOPERA( 185),IX( 185),IY( 185)/'MOVE', -10,  -9/
739      DATA IOPERA( 186),IX( 186),IY( 186)/'DRAW',  -2,  -9/
740      DATA IOPERA( 187),IX( 187),IY( 187)/'MOVE',   2,  -9/
741      DATA IOPERA( 188),IX( 188),IY( 188)/'DRAW',   9,  -9/
742      DATA IOPERA( 189),IX( 189),IY( 189)/'MOVE',  -9,  12/
743      DATA IOPERA( 190),IX( 190),IY( 190)/'DRAW',  -7,  11/
744      DATA IOPERA( 191),IX( 191),IY( 191)/'MOVE',  -8,  12/
745      DATA IOPERA( 192),IX( 192),IY( 192)/'DRAW',  -7,  10/
746      DATA IOPERA( 193),IX( 193),IY( 193)/'MOVE',  -4,  12/
747      DATA IOPERA( 194),IX( 194),IY( 194)/'DRAW',  -5,  10/
748      DATA IOPERA( 195),IX( 195),IY( 195)/'MOVE',  -3,  12/
749      DATA IOPERA( 196),IX( 196),IY( 196)/'DRAW',  -5,  11/
750      DATA IOPERA( 197),IX( 197),IY( 197)/'MOVE',   5,  12/
751      DATA IOPERA( 198),IX( 198),IY( 198)/'DRAW',   6,  11/
752      DATA IOPERA( 199),IX( 199),IY( 199)/'MOVE',   8,  12/
753      DATA IOPERA( 200),IX( 200),IY( 200)/'DRAW',   6,  11/
754      DATA IOPERA( 201),IX( 201),IY( 201)/'MOVE',  -7,  -8/
755      DATA IOPERA( 202),IX( 202),IY( 202)/'DRAW',  -9,  -9/
756      DATA IOPERA( 203),IX( 203),IY( 203)/'MOVE',  -7,  -7/
757      DATA IOPERA( 204),IX( 204),IY( 204)/'DRAW',  -8,  -9/
758      DATA IOPERA( 205),IX( 205),IY( 205)/'MOVE',  -5,  -7/
759      DATA IOPERA( 206),IX( 206),IY( 206)/'DRAW',  -4,  -9/
760      DATA IOPERA( 207),IX( 207),IY( 207)/'MOVE',  -5,  -8/
761      DATA IOPERA( 208),IX( 208),IY( 208)/'DRAW',  -3,  -9/
762      DATA IOPERA( 209),IX( 209),IY( 209)/'MOVE',   5,  -7/
763      DATA IOPERA( 210),IX( 210),IY( 210)/'DRAW',   3,  -9/
764      DATA IOPERA( 211),IX( 211),IY( 211)/'MOVE',   5,  -7/
765      DATA IOPERA( 212),IX( 212),IY( 212)/'DRAW',   8,  -9/
766C
767      DATA IXMIND(  11)/ -12/
768      DATA IXMAXD(  11)/  10/
769      DATA IXDELD(  11)/  22/
770      DATA ISTARD(  11)/ 167/
771      DATA NUMCOO(  11)/  46/
772C
773C     DEFINE CHARACTER   3012--UPPER CASE L
774C
775      DATA IOPERA( 213),IX( 213),IY( 213)/'MOVE',  -4,  12/
776      DATA IOPERA( 214),IX( 214),IY( 214)/'DRAW',  -4,  -9/
777      DATA IOPERA( 215),IX( 215),IY( 215)/'MOVE',  -3,  11/
778      DATA IOPERA( 216),IX( 216),IY( 216)/'DRAW',  -3,  -8/
779      DATA IOPERA( 217),IX( 217),IY( 217)/'MOVE',  -2,  12/
780      DATA IOPERA( 218),IX( 218),IY( 218)/'DRAW',  -2,  -9/
781      DATA IOPERA( 219),IX( 219),IY( 219)/'MOVE',  -7,  12/
782      DATA IOPERA( 220),IX( 220),IY( 220)/'DRAW',   1,  12/
783      DATA IOPERA( 221),IX( 221),IY( 221)/'MOVE',  -7,  -9/
784      DATA IOPERA( 222),IX( 222),IY( 222)/'DRAW',   8,  -9/
785      DATA IOPERA( 223),IX( 223),IY( 223)/'DRAW',   8,  -3/
786      DATA IOPERA( 224),IX( 224),IY( 224)/'MOVE',  -6,  12/
787      DATA IOPERA( 225),IX( 225),IY( 225)/'DRAW',  -4,  11/
788      DATA IOPERA( 226),IX( 226),IY( 226)/'MOVE',  -5,  12/
789      DATA IOPERA( 227),IX( 227),IY( 227)/'DRAW',  -4,  10/
790      DATA IOPERA( 228),IX( 228),IY( 228)/'MOVE',  -1,  12/
791      DATA IOPERA( 229),IX( 229),IY( 229)/'DRAW',  -2,  10/
792      DATA IOPERA( 230),IX( 230),IY( 230)/'MOVE',   0,  12/
793      DATA IOPERA( 231),IX( 231),IY( 231)/'DRAW',  -2,  11/
794      DATA IOPERA( 232),IX( 232),IY( 232)/'MOVE',  -4,  -8/
795      DATA IOPERA( 233),IX( 233),IY( 233)/'DRAW',  -6,  -9/
796      DATA IOPERA( 234),IX( 234),IY( 234)/'MOVE',  -4,  -7/
797      DATA IOPERA( 235),IX( 235),IY( 235)/'DRAW',  -5,  -9/
798      DATA IOPERA( 236),IX( 236),IY( 236)/'MOVE',  -2,  -7/
799      DATA IOPERA( 237),IX( 237),IY( 237)/'DRAW',  -1,  -9/
800      DATA IOPERA( 238),IX( 238),IY( 238)/'MOVE',  -2,  -8/
801      DATA IOPERA( 239),IX( 239),IY( 239)/'DRAW',   0,  -9/
802      DATA IOPERA( 240),IX( 240),IY( 240)/'MOVE',   3,  -9/
803      DATA IOPERA( 241),IX( 241),IY( 241)/'DRAW',   8,  -8/
804      DATA IOPERA( 242),IX( 242),IY( 242)/'MOVE',   5,  -9/
805      DATA IOPERA( 243),IX( 243),IY( 243)/'DRAW',   8,  -7/
806      DATA IOPERA( 244),IX( 244),IY( 244)/'MOVE',   6,  -9/
807      DATA IOPERA( 245),IX( 245),IY( 245)/'DRAW',   8,  -6/
808      DATA IOPERA( 246),IX( 246),IY( 246)/'MOVE',   7,  -9/
809      DATA IOPERA( 247),IX( 247),IY( 247)/'DRAW',   8,  -3/
810C
811      DATA IXMIND(  12)/  -9/
812      DATA IXMAXD(  12)/   9/
813      DATA IXDELD(  12)/  18/
814      DATA ISTARD(  12)/ 213/
815      DATA NUMCOO(  12)/  35/
816C
817C     DEFINE CHARACTER   3013--UPPER CASE M
818C
819      DATA IOPERA( 248),IX( 248),IY( 248)/'MOVE',  -8,  12/
820      DATA IOPERA( 249),IX( 249),IY( 249)/'DRAW',  -8,  -8/
821      DATA IOPERA( 250),IX( 250),IY( 250)/'MOVE',  -8,  12/
822      DATA IOPERA( 251),IX( 251),IY( 251)/'DRAW',  -1,  -9/
823      DATA IOPERA( 252),IX( 252),IY( 252)/'MOVE',  -7,  12/
824      DATA IOPERA( 253),IX( 253),IY( 253)/'DRAW',  -1,  -6/
825      DATA IOPERA( 254),IX( 254),IY( 254)/'MOVE',  -6,  12/
826      DATA IOPERA( 255),IX( 255),IY( 255)/'DRAW',   0,  -6/
827      DATA IOPERA( 256),IX( 256),IY( 256)/'MOVE',   6,  12/
828      DATA IOPERA( 257),IX( 257),IY( 257)/'DRAW',  -1,  -9/
829      DATA IOPERA( 258),IX( 258),IY( 258)/'MOVE',   6,  12/
830      DATA IOPERA( 259),IX( 259),IY( 259)/'DRAW',   6,  -9/
831      DATA IOPERA( 260),IX( 260),IY( 260)/'MOVE',   7,  11/
832      DATA IOPERA( 261),IX( 261),IY( 261)/'DRAW',   7,  -8/
833      DATA IOPERA( 262),IX( 262),IY( 262)/'MOVE',   8,  12/
834      DATA IOPERA( 263),IX( 263),IY( 263)/'DRAW',   8,  -9/
835      DATA IOPERA( 264),IX( 264),IY( 264)/'MOVE', -11,  12/
836      DATA IOPERA( 265),IX( 265),IY( 265)/'DRAW',  -6,  12/
837      DATA IOPERA( 266),IX( 266),IY( 266)/'MOVE',   6,  12/
838      DATA IOPERA( 267),IX( 267),IY( 267)/'DRAW',  11,  12/
839      DATA IOPERA( 268),IX( 268),IY( 268)/'MOVE', -11,  -9/
840      DATA IOPERA( 269),IX( 269),IY( 269)/'DRAW',  -5,  -9/
841      DATA IOPERA( 270),IX( 270),IY( 270)/'MOVE',   3,  -9/
842      DATA IOPERA( 271),IX( 271),IY( 271)/'DRAW',  11,  -9/
843      DATA IOPERA( 272),IX( 272),IY( 272)/'MOVE', -10,  12/
844      DATA IOPERA( 273),IX( 273),IY( 273)/'DRAW',  -8,  11/
845      DATA IOPERA( 274),IX( 274),IY( 274)/'MOVE',   9,  12/
846      DATA IOPERA( 275),IX( 275),IY( 275)/'DRAW',   8,  10/
847      DATA IOPERA( 276),IX( 276),IY( 276)/'MOVE',  10,  12/
848      DATA IOPERA( 277),IX( 277),IY( 277)/'DRAW',   8,  11/
849      DATA IOPERA( 278),IX( 278),IY( 278)/'MOVE',  -8,  -8/
850      DATA IOPERA( 279),IX( 279),IY( 279)/'DRAW', -10,  -9/
851      DATA IOPERA( 280),IX( 280),IY( 280)/'MOVE',  -8,  -8/
852      DATA IOPERA( 281),IX( 281),IY( 281)/'DRAW',  -6,  -9/
853      DATA IOPERA( 282),IX( 282),IY( 282)/'MOVE',   6,  -8/
854      DATA IOPERA( 283),IX( 283),IY( 283)/'DRAW',   4,  -9/
855      DATA IOPERA( 284),IX( 284),IY( 284)/'MOVE',   6,  -7/
856      DATA IOPERA( 285),IX( 285),IY( 285)/'DRAW',   5,  -9/
857      DATA IOPERA( 286),IX( 286),IY( 286)/'MOVE',   8,  -7/
858      DATA IOPERA( 287),IX( 287),IY( 287)/'DRAW',   9,  -9/
859      DATA IOPERA( 288),IX( 288),IY( 288)/'MOVE',   8,  -8/
860      DATA IOPERA( 289),IX( 289),IY( 289)/'DRAW',  10,  -9/
861C
862      DATA IXMIND(  13)/ -13/
863      DATA IXMAXD(  13)/  13/
864      DATA IXDELD(  13)/  26/
865      DATA ISTARD(  13)/ 248/
866      DATA NUMCOO(  13)/  42/
867C
868C-----START POINT-----------------------------------------------------
869C
870      IFOUND='YES'
871      IERROR='NO'
872C
873      NUMCO=1
874      ISTART=1
875      ISTOP=1
876      NC=1
877C
878C               ******************************************
879C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
880C               **  HERSHEY CHARACTER SET CASE          **
881C               ******************************************
882C
883C
884      IF(IBUGD2.EQ.'OFF')GOTO90
885      WRITE(ICOUT,999)
886  999 FORMAT(1X)
887      CALL DPWRST('XXX','BUG ')
888      WRITE(ICOUT,51)
889   51 FORMAT('***** AT THE BEGINNING OF DRTU2--')
890      CALL DPWRST('XXX','BUG ')
891      WRITE(ICOUT,52)ICHARN
892   52 FORMAT('ICHARN = ',I8)
893      CALL DPWRST('XXX','BUG ')
894      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
895   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
896      CALL DPWRST('XXX','BUG ')
897   90 CONTINUE
898C
899C               **************************************
900C               **  STEP 2--                        **
901C               **  EXTRACT THE COORDINATES         **
902C               **  FOR THIS PARTICULAR CHARACTER.  **
903C               **************************************
904C
905      ISTART=ISTARD(ICHARN)
906      NC=NUMCOO(ICHARN)
907      ISTOP=ISTART+NC-1
908      J=0
909      DO1100I=ISTART,ISTOP
910      J=J+1
911      IOP(J)=IOPERA(I)
912      X(J)=IX(I)
913      Y(J)=IY(I)
914 1100 CONTINUE
915      NUMCO=J
916      IXMINS=IXMIND(ICHARN)
917      IXMAXS=IXMAXD(ICHARN)
918      IXDELS=IXDELD(ICHARN)
919C
920      GOTO9000
921C
922C               *****************
923C               **  STEP 90--  **
924C               **  EXIT       **
925C               *****************
926C
927 9000 CONTINUE
928      IF(IBUGD2.EQ.'OFF')GOTO9090
929      WRITE(ICOUT,999)
930      CALL DPWRST('XXX','BUG ')
931      WRITE(ICOUT,9011)
932 9011 FORMAT('***** AT THE END       OF DRTU2--')
933      CALL DPWRST('XXX','BUG ')
934      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
935 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
936      CALL DPWRST('XXX','BUG ')
937      WRITE(ICOUT,9013)ICHARN
938 9013 FORMAT('ICHARN = ',I8)
939      CALL DPWRST('XXX','BUG ')
940      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
941 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
942      CALL DPWRST('XXX','BUG ')
943      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
944      DO9015I=1,NUMCO
945      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
946 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
947      CALL DPWRST('XXX','BUG ')
948 9015 CONTINUE
949 9019 CONTINUE
950      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
951 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
952      CALL DPWRST('XXX','BUG ')
953 9090 CONTINUE
954C
955      RETURN
956      END
957      SUBROUTINE DRTU3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
958     1IBUGD2,IFOUND,IERROR)
959C
960C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
961C              FOR ROMAN TRIPLEX UPPER CASE (PART 3).
962C     WRITTEN BY--JAMES J. FILLIBEN
963C                 STATISTICAL ENGINEERING DIVISION
964C                 INFORMATION TECHNOLOGY LABORATORY
965C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
966C                 GAITHERSBURG, MD 20899
967C                 PHONE--301-975-2855
968C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
969C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
970C     LANGUAGE--ANSI FORTRAN (1977)
971C     VERSION NUMBER--87/4
972C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
973C     UPDATED         --MAY       1982.
974C     UPDATED         --MARCH     1987.
975C
976C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
977C
978      CHARACTER*4 IOP
979      CHARACTER*4 IBUGD2
980      CHARACTER*4 IFOUND
981      CHARACTER*4 IERROR
982C
983      CHARACTER*4 IOPERA
984C
985C---------------------------------------------------------------------
986C
987      DIMENSION IOP(*)
988      DIMENSION X(*)
989      DIMENSION Y(*)
990C
991      DIMENSION IOPERA(300)
992      DIMENSION IX(300)
993      DIMENSION IY(300)
994C
995      DIMENSION IXMIND(30)
996      DIMENSION IXMAXD(30)
997      DIMENSION IXDELD(30)
998      DIMENSION ISTARD(30)
999      DIMENSION NUMCOO(30)
1000C
1001C-----COMMON----------------------------------------------------------
1002C
1003      INCLUDE 'DPCOP2.INC'
1004C
1005C-----DATA STATEMENTS-------------------------------------------------
1006C
1007C     DEFINE CHARACTER   3014--UPPER CASE N
1008C
1009      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',  -7,  12/
1010      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',  -7,  -8/
1011      DATA IOPERA(   3),IX(   3),IY(   3)/'MOVE',  -7,  12/
1012      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',   7,  -9/
1013      DATA IOPERA(   5),IX(   5),IY(   5)/'MOVE',  -6,  12/
1014      DATA IOPERA(   6),IX(   6),IY(   6)/'DRAW',   6,  -6/
1015      DATA IOPERA(   7),IX(   7),IY(   7)/'MOVE',  -5,  12/
1016      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',   7,  -6/
1017      DATA IOPERA(   9),IX(   9),IY(   9)/'MOVE',   7,  11/
1018      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',   7,  -9/
1019      DATA IOPERA(  11),IX(  11),IY(  11)/'MOVE', -10,  12/
1020      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',  -5,  12/
1021      DATA IOPERA(  13),IX(  13),IY(  13)/'MOVE',   4,  12/
1022      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',  10,  12/
1023      DATA IOPERA(  15),IX(  15),IY(  15)/'MOVE', -10,  -9/
1024      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',  -4,  -9/
1025      DATA IOPERA(  17),IX(  17),IY(  17)/'MOVE',  -9,  12/
1026      DATA IOPERA(  18),IX(  18),IY(  18)/'DRAW',  -7,  11/
1027      DATA IOPERA(  19),IX(  19),IY(  19)/'MOVE',   5,  12/
1028      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',   7,  11/
1029      DATA IOPERA(  21),IX(  21),IY(  21)/'MOVE',   9,  12/
1030      DATA IOPERA(  22),IX(  22),IY(  22)/'DRAW',   7,  11/
1031      DATA IOPERA(  23),IX(  23),IY(  23)/'MOVE',  -7,  -8/
1032      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',  -9,  -9/
1033      DATA IOPERA(  25),IX(  25),IY(  25)/'MOVE',  -7,  -8/
1034      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',  -5,  -9/
1035C
1036      DATA IXMIND(  14)/ -12/
1037      DATA IXMAXD(  14)/  12/
1038      DATA IXDELD(  14)/  24/
1039      DATA ISTARD(  14)/   1/
1040      DATA NUMCOO(  14)/  26/
1041C
1042C     DEFINE CHARACTER   3015--UPPER CASE O
1043C
1044      DATA IOPERA(  27),IX(  27),IY(  27)/'MOVE',  -1,  12/
1045      DATA IOPERA(  28),IX(  28),IY(  28)/'DRAW',  -4,  11/
1046      DATA IOPERA(  29),IX(  29),IY(  29)/'DRAW',  -6,   9/
1047      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',  -7,   7/
1048      DATA IOPERA(  31),IX(  31),IY(  31)/'DRAW',  -8,   3/
1049      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',  -8,   0/
1050      DATA IOPERA(  33),IX(  33),IY(  33)/'DRAW',  -7,  -4/
1051      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',  -6,  -6/
1052      DATA IOPERA(  35),IX(  35),IY(  35)/'DRAW',  -4,  -8/
1053      DATA IOPERA(  36),IX(  36),IY(  36)/'DRAW',  -1,  -9/
1054      DATA IOPERA(  37),IX(  37),IY(  37)/'DRAW',   1,  -9/
1055      DATA IOPERA(  38),IX(  38),IY(  38)/'DRAW',   4,  -8/
1056      DATA IOPERA(  39),IX(  39),IY(  39)/'DRAW',   6,  -6/
1057      DATA IOPERA(  40),IX(  40),IY(  40)/'DRAW',   7,  -4/
1058      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',   8,   0/
1059      DATA IOPERA(  42),IX(  42),IY(  42)/'DRAW',   8,   3/
1060      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',   7,   7/
1061      DATA IOPERA(  44),IX(  44),IY(  44)/'DRAW',   6,   9/
1062      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',   4,  11/
1063      DATA IOPERA(  46),IX(  46),IY(  46)/'DRAW',   1,  12/
1064      DATA IOPERA(  47),IX(  47),IY(  47)/'DRAW',  -1,  12/
1065      DATA IOPERA(  48),IX(  48),IY(  48)/'MOVE',  -5,   9/
1066      DATA IOPERA(  49),IX(  49),IY(  49)/'DRAW',  -6,   7/
1067      DATA IOPERA(  50),IX(  50),IY(  50)/'DRAW',  -7,   4/
1068      DATA IOPERA(  51),IX(  51),IY(  51)/'DRAW',  -7,  -1/
1069      DATA IOPERA(  52),IX(  52),IY(  52)/'DRAW',  -6,  -4/
1070      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',  -5,  -6/
1071      DATA IOPERA(  54),IX(  54),IY(  54)/'MOVE',   5,  -6/
1072      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',   6,  -4/
1073      DATA IOPERA(  56),IX(  56),IY(  56)/'DRAW',   7,  -1/
1074      DATA IOPERA(  57),IX(  57),IY(  57)/'DRAW',   7,   4/
1075      DATA IOPERA(  58),IX(  58),IY(  58)/'DRAW',   6,   7/
1076      DATA IOPERA(  59),IX(  59),IY(  59)/'DRAW',   5,   9/
1077      DATA IOPERA(  60),IX(  60),IY(  60)/'MOVE',  -1,  12/
1078      DATA IOPERA(  61),IX(  61),IY(  61)/'DRAW',  -3,  11/
1079      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',  -5,   8/
1080      DATA IOPERA(  63),IX(  63),IY(  63)/'DRAW',  -6,   4/
1081      DATA IOPERA(  64),IX(  64),IY(  64)/'DRAW',  -6,  -1/
1082      DATA IOPERA(  65),IX(  65),IY(  65)/'DRAW',  -5,  -5/
1083      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',  -3,  -8/
1084      DATA IOPERA(  67),IX(  67),IY(  67)/'DRAW',  -1,  -9/
1085      DATA IOPERA(  68),IX(  68),IY(  68)/'MOVE',   1,  -9/
1086      DATA IOPERA(  69),IX(  69),IY(  69)/'DRAW',   3,  -8/
1087      DATA IOPERA(  70),IX(  70),IY(  70)/'DRAW',   5,  -5/
1088      DATA IOPERA(  71),IX(  71),IY(  71)/'DRAW',   6,  -1/
1089      DATA IOPERA(  72),IX(  72),IY(  72)/'DRAW',   6,   4/
1090      DATA IOPERA(  73),IX(  73),IY(  73)/'DRAW',   5,   8/
1091      DATA IOPERA(  74),IX(  74),IY(  74)/'DRAW',   3,  11/
1092      DATA IOPERA(  75),IX(  75),IY(  75)/'DRAW',   1,  12/
1093C
1094      DATA IXMIND(  15)/ -11/
1095      DATA IXMAXD(  15)/  11/
1096      DATA IXDELD(  15)/  22/
1097      DATA ISTARD(  15)/  27/
1098      DATA NUMCOO(  15)/  49/
1099C
1100C     DEFINE CHARACTER   3016--UPPER CASE P
1101C
1102      DATA IOPERA(  76),IX(  76),IY(  76)/'MOVE',  -6,  12/
1103      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW',  -6,  -9/
1104      DATA IOPERA(  78),IX(  78),IY(  78)/'MOVE',  -5,  11/
1105      DATA IOPERA(  79),IX(  79),IY(  79)/'DRAW',  -5,  -8/
1106      DATA IOPERA(  80),IX(  80),IY(  80)/'MOVE',  -4,  12/
1107      DATA IOPERA(  81),IX(  81),IY(  81)/'DRAW',  -4,  -9/
1108      DATA IOPERA(  82),IX(  82),IY(  82)/'MOVE',  -9,  12/
1109      DATA IOPERA(  83),IX(  83),IY(  83)/'DRAW',   3,  12/
1110      DATA IOPERA(  84),IX(  84),IY(  84)/'DRAW',   6,  11/
1111      DATA IOPERA(  85),IX(  85),IY(  85)/'DRAW',   7,  10/
1112      DATA IOPERA(  86),IX(  86),IY(  86)/'DRAW',   8,   8/
1113      DATA IOPERA(  87),IX(  87),IY(  87)/'DRAW',   8,   5/
1114      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',   7,   3/
1115      DATA IOPERA(  89),IX(  89),IY(  89)/'DRAW',   6,   2/
1116      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',   3,   1/
1117      DATA IOPERA(  91),IX(  91),IY(  91)/'DRAW',  -4,   1/
1118      DATA IOPERA(  92),IX(  92),IY(  92)/'MOVE',   6,  10/
1119      DATA IOPERA(  93),IX(  93),IY(  93)/'DRAW',   7,   8/
1120      DATA IOPERA(  94),IX(  94),IY(  94)/'DRAW',   7,   5/
1121      DATA IOPERA(  95),IX(  95),IY(  95)/'DRAW',   6,   3/
1122      DATA IOPERA(  96),IX(  96),IY(  96)/'MOVE',   3,  12/
1123      DATA IOPERA(  97),IX(  97),IY(  97)/'DRAW',   5,  11/
1124      DATA IOPERA(  98),IX(  98),IY(  98)/'DRAW',   6,   9/
1125      DATA IOPERA(  99),IX(  99),IY(  99)/'DRAW',   6,   4/
1126      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',   5,   2/
1127      DATA IOPERA( 101),IX( 101),IY( 101)/'DRAW',   3,   1/
1128      DATA IOPERA( 102),IX( 102),IY( 102)/'MOVE',  -9,  -9/
1129      DATA IOPERA( 103),IX( 103),IY( 103)/'DRAW',  -1,  -9/
1130      DATA IOPERA( 104),IX( 104),IY( 104)/'MOVE',  -8,  12/
1131      DATA IOPERA( 105),IX( 105),IY( 105)/'DRAW',  -6,  11/
1132      DATA IOPERA( 106),IX( 106),IY( 106)/'MOVE',  -7,  12/
1133      DATA IOPERA( 107),IX( 107),IY( 107)/'DRAW',  -6,  10/
1134      DATA IOPERA( 108),IX( 108),IY( 108)/'MOVE',  -3,  12/
1135      DATA IOPERA( 109),IX( 109),IY( 109)/'DRAW',  -4,  10/
1136      DATA IOPERA( 110),IX( 110),IY( 110)/'MOVE',  -2,  12/
1137      DATA IOPERA( 111),IX( 111),IY( 111)/'DRAW',  -4,  11/
1138      DATA IOPERA( 112),IX( 112),IY( 112)/'MOVE',  -6,  -8/
1139      DATA IOPERA( 113),IX( 113),IY( 113)/'DRAW',  -8,  -9/
1140      DATA IOPERA( 114),IX( 114),IY( 114)/'MOVE',  -6,  -7/
1141      DATA IOPERA( 115),IX( 115),IY( 115)/'DRAW',  -7,  -9/
1142      DATA IOPERA( 116),IX( 116),IY( 116)/'MOVE',  -4,  -7/
1143      DATA IOPERA( 117),IX( 117),IY( 117)/'DRAW',  -3,  -9/
1144      DATA IOPERA( 118),IX( 118),IY( 118)/'MOVE',  -4,  -8/
1145      DATA IOPERA( 119),IX( 119),IY( 119)/'DRAW',  -2,  -9/
1146C
1147      DATA IXMIND(  16)/ -11/
1148      DATA IXMAXD(  16)/  11/
1149      DATA IXDELD(  16)/  22/
1150      DATA ISTARD(  16)/  76/
1151      DATA NUMCOO(  16)/  44/
1152C
1153C     DEFINE CHARACTER   3017--UPPER CASE Q
1154C
1155      DATA IOPERA( 120),IX( 120),IY( 120)/'MOVE',  -1,  12/
1156      DATA IOPERA( 121),IX( 121),IY( 121)/'DRAW',  -4,  11/
1157      DATA IOPERA( 122),IX( 122),IY( 122)/'DRAW',  -6,   9/
1158      DATA IOPERA( 123),IX( 123),IY( 123)/'DRAW',  -7,   7/
1159      DATA IOPERA( 124),IX( 124),IY( 124)/'DRAW',  -8,   3/
1160      DATA IOPERA( 125),IX( 125),IY( 125)/'DRAW',  -8,   0/
1161      DATA IOPERA( 126),IX( 126),IY( 126)/'DRAW',  -7,  -4/
1162      DATA IOPERA( 127),IX( 127),IY( 127)/'DRAW',  -6,  -6/
1163      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',  -4,  -8/
1164      DATA IOPERA( 129),IX( 129),IY( 129)/'DRAW',  -1,  -9/
1165      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   1,  -9/
1166      DATA IOPERA( 131),IX( 131),IY( 131)/'DRAW',   4,  -8/
1167      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',   6,  -6/
1168      DATA IOPERA( 133),IX( 133),IY( 133)/'DRAW',   7,  -4/
1169      DATA IOPERA( 134),IX( 134),IY( 134)/'DRAW',   8,   0/
1170      DATA IOPERA( 135),IX( 135),IY( 135)/'DRAW',   8,   3/
1171      DATA IOPERA( 136),IX( 136),IY( 136)/'DRAW',   7,   7/
1172      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',   6,   9/
1173      DATA IOPERA( 138),IX( 138),IY( 138)/'DRAW',   4,  11/
1174      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',   1,  12/
1175      DATA IOPERA( 140),IX( 140),IY( 140)/'DRAW',  -1,  12/
1176      DATA IOPERA( 141),IX( 141),IY( 141)/'MOVE',  -5,   9/
1177      DATA IOPERA( 142),IX( 142),IY( 142)/'DRAW',  -6,   7/
1178      DATA IOPERA( 143),IX( 143),IY( 143)/'DRAW',  -7,   4/
1179      DATA IOPERA( 144),IX( 144),IY( 144)/'DRAW',  -7,  -1/
1180      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',  -6,  -4/
1181      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',  -5,  -6/
1182      DATA IOPERA( 147),IX( 147),IY( 147)/'MOVE',   5,  -6/
1183      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',   6,  -4/
1184      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',   7,  -1/
1185      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',   7,   4/
1186      DATA IOPERA( 151),IX( 151),IY( 151)/'DRAW',   6,   7/
1187      DATA IOPERA( 152),IX( 152),IY( 152)/'DRAW',   5,   9/
1188      DATA IOPERA( 153),IX( 153),IY( 153)/'MOVE',  -1,  12/
1189      DATA IOPERA( 154),IX( 154),IY( 154)/'DRAW',  -3,  11/
1190      DATA IOPERA( 155),IX( 155),IY( 155)/'DRAW',  -5,   8/
1191      DATA IOPERA( 156),IX( 156),IY( 156)/'DRAW',  -6,   4/
1192      DATA IOPERA( 157),IX( 157),IY( 157)/'DRAW',  -6,  -1/
1193      DATA IOPERA( 158),IX( 158),IY( 158)/'DRAW',  -5,  -5/
1194      DATA IOPERA( 159),IX( 159),IY( 159)/'DRAW',  -3,  -8/
1195      DATA IOPERA( 160),IX( 160),IY( 160)/'DRAW',  -1,  -9/
1196      DATA IOPERA( 161),IX( 161),IY( 161)/'MOVE',   1,  -9/
1197      DATA IOPERA( 162),IX( 162),IY( 162)/'DRAW',   3,  -8/
1198      DATA IOPERA( 163),IX( 163),IY( 163)/'DRAW',   5,  -5/
1199      DATA IOPERA( 164),IX( 164),IY( 164)/'DRAW',   6,  -1/
1200      DATA IOPERA( 165),IX( 165),IY( 165)/'DRAW',   6,   4/
1201      DATA IOPERA( 166),IX( 166),IY( 166)/'DRAW',   5,   8/
1202      DATA IOPERA( 167),IX( 167),IY( 167)/'DRAW',   3,  11/
1203      DATA IOPERA( 168),IX( 168),IY( 168)/'DRAW',   1,  12/
1204      DATA IOPERA( 169),IX( 169),IY( 169)/'MOVE',  -4,  -6/
1205      DATA IOPERA( 170),IX( 170),IY( 170)/'DRAW',  -3,  -4/
1206      DATA IOPERA( 171),IX( 171),IY( 171)/'DRAW',  -1,  -3/
1207      DATA IOPERA( 172),IX( 172),IY( 172)/'DRAW',   0,  -3/
1208      DATA IOPERA( 173),IX( 173),IY( 173)/'DRAW',   2,  -4/
1209      DATA IOPERA( 174),IX( 174),IY( 174)/'DRAW',   3,  -6/
1210      DATA IOPERA( 175),IX( 175),IY( 175)/'DRAW',   4, -12/
1211      DATA IOPERA( 176),IX( 176),IY( 176)/'DRAW',   5, -14/
1212      DATA IOPERA( 177),IX( 177),IY( 177)/'DRAW',   7, -14/
1213      DATA IOPERA( 178),IX( 178),IY( 178)/'DRAW',   8, -12/
1214      DATA IOPERA( 179),IX( 179),IY( 179)/'DRAW',   8, -10/
1215      DATA IOPERA( 180),IX( 180),IY( 180)/'MOVE',   4, -10/
1216      DATA IOPERA( 181),IX( 181),IY( 181)/'DRAW',   5, -12/
1217      DATA IOPERA( 182),IX( 182),IY( 182)/'DRAW',   6, -13/
1218      DATA IOPERA( 183),IX( 183),IY( 183)/'DRAW',   7, -13/
1219      DATA IOPERA( 184),IX( 184),IY( 184)/'MOVE',   3,  -6/
1220      DATA IOPERA( 185),IX( 185),IY( 185)/'DRAW',   5, -11/
1221      DATA IOPERA( 186),IX( 186),IY( 186)/'DRAW',   6, -12/
1222      DATA IOPERA( 187),IX( 187),IY( 187)/'DRAW',   7, -12/
1223      DATA IOPERA( 188),IX( 188),IY( 188)/'DRAW',   8, -11/
1224C
1225      DATA IXMIND(  17)/ -11/
1226      DATA IXMAXD(  17)/  11/
1227      DATA IXDELD(  17)/  22/
1228      DATA ISTARD(  17)/ 120/
1229      DATA NUMCOO(  17)/  69/
1230C
1231C     DEFINE CHARACTER   3018--UPPER CASE R
1232C
1233      DATA IOPERA( 189),IX( 189),IY( 189)/'MOVE',  -6,  12/
1234      DATA IOPERA( 190),IX( 190),IY( 190)/'DRAW',  -6,  -9/
1235      DATA IOPERA( 191),IX( 191),IY( 191)/'MOVE',  -5,  11/
1236      DATA IOPERA( 192),IX( 192),IY( 192)/'DRAW',  -5,  -8/
1237      DATA IOPERA( 193),IX( 193),IY( 193)/'MOVE',  -4,  12/
1238      DATA IOPERA( 194),IX( 194),IY( 194)/'DRAW',  -4,  -9/
1239      DATA IOPERA( 195),IX( 195),IY( 195)/'MOVE',  -9,  12/
1240      DATA IOPERA( 196),IX( 196),IY( 196)/'DRAW',   3,  12/
1241      DATA IOPERA( 197),IX( 197),IY( 197)/'DRAW',   6,  11/
1242      DATA IOPERA( 198),IX( 198),IY( 198)/'DRAW',   7,  10/
1243      DATA IOPERA( 199),IX( 199),IY( 199)/'DRAW',   8,   8/
1244      DATA IOPERA( 200),IX( 200),IY( 200)/'DRAW',   8,   6/
1245      DATA IOPERA( 201),IX( 201),IY( 201)/'DRAW',   7,   4/
1246      DATA IOPERA( 202),IX( 202),IY( 202)/'DRAW',   6,   3/
1247      DATA IOPERA( 203),IX( 203),IY( 203)/'DRAW',   3,   2/
1248      DATA IOPERA( 204),IX( 204),IY( 204)/'DRAW',  -4,   2/
1249      DATA IOPERA( 205),IX( 205),IY( 205)/'MOVE',   6,  10/
1250      DATA IOPERA( 206),IX( 206),IY( 206)/'DRAW',   7,   8/
1251      DATA IOPERA( 207),IX( 207),IY( 207)/'DRAW',   7,   6/
1252      DATA IOPERA( 208),IX( 208),IY( 208)/'DRAW',   6,   4/
1253      DATA IOPERA( 209),IX( 209),IY( 209)/'MOVE',   3,  12/
1254      DATA IOPERA( 210),IX( 210),IY( 210)/'DRAW',   5,  11/
1255      DATA IOPERA( 211),IX( 211),IY( 211)/'DRAW',   6,   9/
1256      DATA IOPERA( 212),IX( 212),IY( 212)/'DRAW',   6,   5/
1257      DATA IOPERA( 213),IX( 213),IY( 213)/'DRAW',   5,   3/
1258      DATA IOPERA( 214),IX( 214),IY( 214)/'DRAW',   3,   2/
1259      DATA IOPERA( 215),IX( 215),IY( 215)/'MOVE',   0,   2/
1260      DATA IOPERA( 216),IX( 216),IY( 216)/'DRAW',   2,   1/
1261      DATA IOPERA( 217),IX( 217),IY( 217)/'DRAW',   3,  -1/
1262      DATA IOPERA( 218),IX( 218),IY( 218)/'DRAW',   5,  -7/
1263      DATA IOPERA( 219),IX( 219),IY( 219)/'DRAW',   6,  -9/
1264      DATA IOPERA( 220),IX( 220),IY( 220)/'DRAW',   8,  -9/
1265      DATA IOPERA( 221),IX( 221),IY( 221)/'DRAW',   9,  -7/
1266      DATA IOPERA( 222),IX( 222),IY( 222)/'DRAW',   9,  -5/
1267      DATA IOPERA( 223),IX( 223),IY( 223)/'MOVE',   5,  -5/
1268      DATA IOPERA( 224),IX( 224),IY( 224)/'DRAW',   6,  -7/
1269      DATA IOPERA( 225),IX( 225),IY( 225)/'DRAW',   7,  -8/
1270      DATA IOPERA( 226),IX( 226),IY( 226)/'DRAW',   8,  -8/
1271      DATA IOPERA( 227),IX( 227),IY( 227)/'MOVE',   2,   1/
1272      DATA IOPERA( 228),IX( 228),IY( 228)/'DRAW',   3,   0/
1273      DATA IOPERA( 229),IX( 229),IY( 229)/'DRAW',   6,  -6/
1274      DATA IOPERA( 230),IX( 230),IY( 230)/'DRAW',   7,  -7/
1275      DATA IOPERA( 231),IX( 231),IY( 231)/'DRAW',   8,  -7/
1276      DATA IOPERA( 232),IX( 232),IY( 232)/'DRAW',   9,  -6/
1277      DATA IOPERA( 233),IX( 233),IY( 233)/'MOVE',  -9,  -9/
1278      DATA IOPERA( 234),IX( 234),IY( 234)/'DRAW',  -1,  -9/
1279      DATA IOPERA( 235),IX( 235),IY( 235)/'MOVE',  -8,  12/
1280      DATA IOPERA( 236),IX( 236),IY( 236)/'DRAW',  -6,  11/
1281      DATA IOPERA( 237),IX( 237),IY( 237)/'MOVE',  -7,  12/
1282      DATA IOPERA( 238),IX( 238),IY( 238)/'DRAW',  -6,  10/
1283      DATA IOPERA( 239),IX( 239),IY( 239)/'MOVE',  -3,  12/
1284      DATA IOPERA( 240),IX( 240),IY( 240)/'DRAW',  -4,  10/
1285      DATA IOPERA( 241),IX( 241),IY( 241)/'MOVE',  -2,  12/
1286      DATA IOPERA( 242),IX( 242),IY( 242)/'DRAW',  -4,  11/
1287      DATA IOPERA( 243),IX( 243),IY( 243)/'MOVE',  -6,  -8/
1288      DATA IOPERA( 244),IX( 244),IY( 244)/'DRAW',  -8,  -9/
1289      DATA IOPERA( 245),IX( 245),IY( 245)/'MOVE',  -6,  -7/
1290      DATA IOPERA( 246),IX( 246),IY( 246)/'DRAW',  -7,  -9/
1291      DATA IOPERA( 247),IX( 247),IY( 247)/'MOVE',  -4,  -7/
1292      DATA IOPERA( 248),IX( 248),IY( 248)/'DRAW',  -3,  -9/
1293      DATA IOPERA( 249),IX( 249),IY( 249)/'MOVE',  -4,  -8/
1294      DATA IOPERA( 250),IX( 250),IY( 250)/'DRAW',  -2,  -9/
1295C
1296      DATA IXMIND(  18)/ -11/
1297      DATA IXMAXD(  18)/  11/
1298      DATA IXDELD(  18)/  22/
1299      DATA ISTARD(  18)/ 189/
1300      DATA NUMCOO(  18)/  62/
1301C
1302C     DEFINE CHARACTER   3019--UPPER CASE S
1303C
1304      DATA IOPERA( 251),IX( 251),IY( 251)/'MOVE',   6,   9/
1305      DATA IOPERA( 252),IX( 252),IY( 252)/'DRAW',   7,  12/
1306      DATA IOPERA( 253),IX( 253),IY( 253)/'DRAW',   7,   6/
1307      DATA IOPERA( 254),IX( 254),IY( 254)/'DRAW',   6,   9/
1308      DATA IOPERA( 255),IX( 255),IY( 255)/'DRAW',   4,  11/
1309      DATA IOPERA( 256),IX( 256),IY( 256)/'DRAW',   1,  12/
1310      DATA IOPERA( 257),IX( 257),IY( 257)/'DRAW',  -2,  12/
1311      DATA IOPERA( 258),IX( 258),IY( 258)/'DRAW',  -5,  11/
1312      DATA IOPERA( 259),IX( 259),IY( 259)/'DRAW',  -7,   9/
1313      DATA IOPERA( 260),IX( 260),IY( 260)/'DRAW',  -7,   6/
1314      DATA IOPERA( 261),IX( 261),IY( 261)/'DRAW',  -6,   4/
1315      DATA IOPERA( 262),IX( 262),IY( 262)/'DRAW',  -3,   2/
1316      DATA IOPERA( 263),IX( 263),IY( 263)/'DRAW',   3,   0/
1317      DATA IOPERA( 264),IX( 264),IY( 264)/'DRAW',   5,  -1/
1318      DATA IOPERA( 265),IX( 265),IY( 265)/'DRAW',   6,  -3/
1319      DATA IOPERA( 266),IX( 266),IY( 266)/'DRAW',   6,  -6/
1320      DATA IOPERA( 267),IX( 267),IY( 267)/'DRAW',   5,  -8/
1321      DATA IOPERA( 268),IX( 268),IY( 268)/'MOVE',  -6,   6/
1322      DATA IOPERA( 269),IX( 269),IY( 269)/'DRAW',  -5,   4/
1323      DATA IOPERA( 270),IX( 270),IY( 270)/'DRAW',  -3,   3/
1324      DATA IOPERA( 271),IX( 271),IY( 271)/'DRAW',   3,   1/
1325      DATA IOPERA( 272),IX( 272),IY( 272)/'DRAW',   5,   0/
1326      DATA IOPERA( 273),IX( 273),IY( 273)/'DRAW',   6,  -2/
1327      DATA IOPERA( 274),IX( 274),IY( 274)/'MOVE',  -5,  11/
1328      DATA IOPERA( 275),IX( 275),IY( 275)/'DRAW',  -6,   9/
1329      DATA IOPERA( 276),IX( 276),IY( 276)/'DRAW',  -6,   7/
1330      DATA IOPERA( 277),IX( 277),IY( 277)/'DRAW',  -5,   5/
1331      DATA IOPERA( 278),IX( 278),IY( 278)/'DRAW',  -3,   4/
1332      DATA IOPERA( 279),IX( 279),IY( 279)/'DRAW',   3,   2/
1333      DATA IOPERA( 280),IX( 280),IY( 280)/'DRAW',   6,   0/
1334      DATA IOPERA( 281),IX( 281),IY( 281)/'DRAW',   7,  -2/
1335      DATA IOPERA( 282),IX( 282),IY( 282)/'DRAW',   7,  -5/
1336      DATA IOPERA( 283),IX( 283),IY( 283)/'DRAW',   6,  -7/
1337      DATA IOPERA( 284),IX( 284),IY( 284)/'DRAW',   5,  -8/
1338      DATA IOPERA( 285),IX( 285),IY( 285)/'DRAW',   2,  -9/
1339      DATA IOPERA( 286),IX( 286),IY( 286)/'DRAW',  -1,  -9/
1340      DATA IOPERA( 287),IX( 287),IY( 287)/'DRAW',  -4,  -8/
1341      DATA IOPERA( 288),IX( 288),IY( 288)/'DRAW',  -6,  -6/
1342      DATA IOPERA( 289),IX( 289),IY( 289)/'DRAW',  -7,  -3/
1343      DATA IOPERA( 290),IX( 290),IY( 290)/'DRAW',  -7,  -9/
1344      DATA IOPERA( 291),IX( 291),IY( 291)/'DRAW',  -6,  -6/
1345C
1346      DATA IXMIND(  19)/ -10/
1347      DATA IXMAXD(  19)/  10/
1348      DATA IXDELD(  19)/  20/
1349      DATA ISTARD(  19)/ 251/
1350      DATA NUMCOO(  19)/  41/
1351C
1352C-----START POINT-----------------------------------------------------
1353C
1354      IFOUND='YES'
1355      IERROR='NO'
1356C
1357      NUMCO=1
1358      ISTART=1
1359      ISTOP=1
1360      NC=1
1361C
1362C               ******************************************
1363C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
1364C               **  HERSHEY CHARACTER SET CASE          **
1365C               ******************************************
1366C
1367C
1368      IF(IBUGD2.EQ.'OFF')GOTO90
1369      WRITE(ICOUT,999)
1370  999 FORMAT(1X)
1371      CALL DPWRST('XXX','BUG ')
1372      WRITE(ICOUT,51)
1373   51 FORMAT('***** AT THE BEGINNING OF DRTU3--')
1374      CALL DPWRST('XXX','BUG ')
1375      WRITE(ICOUT,52)ICHARN
1376   52 FORMAT('ICHARN = ',I8)
1377      CALL DPWRST('XXX','BUG ')
1378      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
1379   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
1380      CALL DPWRST('XXX','BUG ')
1381   90 CONTINUE
1382C
1383C               **************************************
1384C               **  STEP 2--                        **
1385C               **  EXTRACT THE COORDINATES         **
1386C               **  FOR THIS PARTICULAR CHARACTER.  **
1387C               **************************************
1388C
1389      ISTART=ISTARD(ICHARN)
1390      NC=NUMCOO(ICHARN)
1391      ISTOP=ISTART+NC-1
1392      J=0
1393      DO1100I=ISTART,ISTOP
1394      J=J+1
1395      IOP(J)=IOPERA(I)
1396      X(J)=IX(I)
1397      Y(J)=IY(I)
1398 1100 CONTINUE
1399      NUMCO=J
1400      IXMINS=IXMIND(ICHARN)
1401      IXMAXS=IXMAXD(ICHARN)
1402      IXDELS=IXDELD(ICHARN)
1403C
1404      GOTO9000
1405C
1406C               *****************
1407C               **  STEP 90--  **
1408C               **  EXIT       **
1409C               *****************
1410C
1411 9000 CONTINUE
1412      IF(IBUGD2.EQ.'OFF')GOTO9090
1413      WRITE(ICOUT,999)
1414      CALL DPWRST('XXX','BUG ')
1415      WRITE(ICOUT,9011)
1416 9011 FORMAT('***** AT THE END       OF DRTU3--')
1417      CALL DPWRST('XXX','BUG ')
1418      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
1419 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
1420      CALL DPWRST('XXX','BUG ')
1421      WRITE(ICOUT,9013)ICHARN
1422 9013 FORMAT('ICHARN = ',I8)
1423      CALL DPWRST('XXX','BUG ')
1424      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
1425 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
1426      CALL DPWRST('XXX','BUG ')
1427      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
1428      DO9015I=1,NUMCO
1429      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
1430 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
1431      CALL DPWRST('XXX','BUG ')
1432 9015 CONTINUE
1433 9019 CONTINUE
1434      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
1435 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
1436      CALL DPWRST('XXX','BUG ')
1437 9090 CONTINUE
1438C
1439      RETURN
1440      END
1441      SUBROUTINE DRTU4(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
1442     1IBUGD2,IFOUND,IERROR)
1443C
1444C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
1445C              FOR ROMAN TRIPLEX UPPER CASE (PART 4).
1446C     WRITTEN BY--JAMES J. FILLIBEN
1447C                 STATISTICAL ENGINEERING DIVISION
1448C                 INFORMATION TECHNOLOGY LABORATORY
1449C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1450C                 GAITHERSBURG, MD 20899
1451C                 PHONE--301-975-2855
1452C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1453C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1454C     LANGUAGE--ANSI FORTRAN (1977)
1455C     VERSION NUMBER--87/4
1456C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
1457C     UPDATED         --MAY       1982.
1458C     UPDATED         --MARCH     1987.
1459C
1460C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1461C
1462      CHARACTER*4 IOP
1463      CHARACTER*4 IBUGD2
1464      CHARACTER*4 IFOUND
1465      CHARACTER*4 IERROR
1466C
1467      CHARACTER*4 IOPERA
1468C
1469C---------------------------------------------------------------------
1470C
1471      DIMENSION IOP(*)
1472      DIMENSION X(*)
1473      DIMENSION Y(*)
1474C
1475      DIMENSION IOPERA(300)
1476      DIMENSION IX(300)
1477      DIMENSION IY(300)
1478C
1479      DIMENSION IXMIND(30)
1480      DIMENSION IXMAXD(30)
1481      DIMENSION IXDELD(30)
1482      DIMENSION ISTARD(30)
1483      DIMENSION NUMCOO(30)
1484C
1485C-----COMMON----------------------------------------------------------
1486C
1487      INCLUDE 'DPCOP2.INC'
1488C
1489C-----DATA STATEMENTS-------------------------------------------------
1490C
1491C     DEFINE CHARACTER   3020--UPPER CASE T
1492C
1493      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',  -8,  12/
1494      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',  -8,   6/
1495      DATA IOPERA(   3),IX(   3),IY(   3)/'MOVE',  -1,  12/
1496      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',  -1,  -9/
1497      DATA IOPERA(   5),IX(   5),IY(   5)/'MOVE',   0,  11/
1498      DATA IOPERA(   6),IX(   6),IY(   6)/'DRAW',   0,  -8/
1499      DATA IOPERA(   7),IX(   7),IY(   7)/'MOVE',   1,  12/
1500      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',   1,  -9/
1501      DATA IOPERA(   9),IX(   9),IY(   9)/'MOVE',   8,  12/
1502      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',   8,   6/
1503      DATA IOPERA(  11),IX(  11),IY(  11)/'MOVE',  -8,  12/
1504      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',   8,  12/
1505      DATA IOPERA(  13),IX(  13),IY(  13)/'MOVE',  -4,  -9/
1506      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',   4,  -9/
1507      DATA IOPERA(  15),IX(  15),IY(  15)/'MOVE',  -7,  12/
1508      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',  -8,   6/
1509      DATA IOPERA(  17),IX(  17),IY(  17)/'MOVE',  -6,  12/
1510      DATA IOPERA(  18),IX(  18),IY(  18)/'DRAW',  -8,   9/
1511      DATA IOPERA(  19),IX(  19),IY(  19)/'MOVE',  -5,  12/
1512      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',  -8,  10/
1513      DATA IOPERA(  21),IX(  21),IY(  21)/'MOVE',  -3,  12/
1514      DATA IOPERA(  22),IX(  22),IY(  22)/'DRAW',  -8,  11/
1515      DATA IOPERA(  23),IX(  23),IY(  23)/'MOVE',   3,  12/
1516      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',   8,  11/
1517      DATA IOPERA(  25),IX(  25),IY(  25)/'MOVE',   5,  12/
1518      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',   8,  10/
1519      DATA IOPERA(  27),IX(  27),IY(  27)/'MOVE',   6,  12/
1520      DATA IOPERA(  28),IX(  28),IY(  28)/'DRAW',   8,   9/
1521      DATA IOPERA(  29),IX(  29),IY(  29)/'MOVE',   7,  12/
1522      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',   8,   6/
1523      DATA IOPERA(  31),IX(  31),IY(  31)/'MOVE',  -1,  -8/
1524      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',  -3,  -9/
1525      DATA IOPERA(  33),IX(  33),IY(  33)/'MOVE',  -1,  -7/
1526      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',  -2,  -9/
1527      DATA IOPERA(  35),IX(  35),IY(  35)/'MOVE',   1,  -7/
1528      DATA IOPERA(  36),IX(  36),IY(  36)/'DRAW',   2,  -9/
1529      DATA IOPERA(  37),IX(  37),IY(  37)/'MOVE',   1,  -8/
1530      DATA IOPERA(  38),IX(  38),IY(  38)/'DRAW',   3,  -9/
1531C
1532      DATA IXMIND(  20)/ -10/
1533      DATA IXMAXD(  20)/  10/
1534      DATA IXDELD(  20)/  20/
1535      DATA ISTARD(  20)/   1/
1536      DATA NUMCOO(  20)/  38/
1537C
1538C     DEFINE CHARACTER   3021--UPPER CASE U
1539C
1540      DATA IOPERA(  39),IX(  39),IY(  39)/'MOVE',  -7,  12/
1541      DATA IOPERA(  40),IX(  40),IY(  40)/'DRAW',  -7,  -3/
1542      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',  -6,  -6/
1543      DATA IOPERA(  42),IX(  42),IY(  42)/'DRAW',  -4,  -8/
1544      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',  -1,  -9/
1545      DATA IOPERA(  44),IX(  44),IY(  44)/'DRAW',   1,  -9/
1546      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',   4,  -8/
1547      DATA IOPERA(  46),IX(  46),IY(  46)/'DRAW',   6,  -6/
1548      DATA IOPERA(  47),IX(  47),IY(  47)/'DRAW',   7,  -3/
1549      DATA IOPERA(  48),IX(  48),IY(  48)/'DRAW',   7,  11/
1550      DATA IOPERA(  49),IX(  49),IY(  49)/'MOVE',  -6,  11/
1551      DATA IOPERA(  50),IX(  50),IY(  50)/'DRAW',  -6,  -4/
1552      DATA IOPERA(  51),IX(  51),IY(  51)/'DRAW',  -5,  -6/
1553      DATA IOPERA(  52),IX(  52),IY(  52)/'MOVE',  -5,  12/
1554      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',  -5,  -4/
1555      DATA IOPERA(  54),IX(  54),IY(  54)/'DRAW',  -4,  -7/
1556      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',  -3,  -8/
1557      DATA IOPERA(  56),IX(  56),IY(  56)/'DRAW',  -1,  -9/
1558      DATA IOPERA(  57),IX(  57),IY(  57)/'MOVE', -10,  12/
1559      DATA IOPERA(  58),IX(  58),IY(  58)/'DRAW',  -2,  12/
1560      DATA IOPERA(  59),IX(  59),IY(  59)/'MOVE',   4,  12/
1561      DATA IOPERA(  60),IX(  60),IY(  60)/'DRAW',  10,  12/
1562      DATA IOPERA(  61),IX(  61),IY(  61)/'MOVE',  -9,  12/
1563      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',  -7,  11/
1564      DATA IOPERA(  63),IX(  63),IY(  63)/'MOVE',  -8,  12/
1565      DATA IOPERA(  64),IX(  64),IY(  64)/'DRAW',  -7,  10/
1566      DATA IOPERA(  65),IX(  65),IY(  65)/'MOVE',  -4,  12/
1567      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',  -5,  10/
1568      DATA IOPERA(  67),IX(  67),IY(  67)/'MOVE',  -3,  12/
1569      DATA IOPERA(  68),IX(  68),IY(  68)/'DRAW',  -5,  11/
1570      DATA IOPERA(  69),IX(  69),IY(  69)/'MOVE',   5,  12/
1571      DATA IOPERA(  70),IX(  70),IY(  70)/'DRAW',   7,  11/
1572      DATA IOPERA(  71),IX(  71),IY(  71)/'MOVE',   9,  12/
1573      DATA IOPERA(  72),IX(  72),IY(  72)/'DRAW',   7,  11/
1574C
1575      DATA IXMIND(  21)/ -12/
1576      DATA IXMAXD(  21)/  12/
1577      DATA IXDELD(  21)/  24/
1578      DATA ISTARD(  21)/  39/
1579      DATA NUMCOO(  21)/  34/
1580C
1581C     DEFINE CHARACTER   3022--UPPER CASE V
1582C
1583      DATA IOPERA(  73),IX(  73),IY(  73)/'MOVE',  -7,  12/
1584      DATA IOPERA(  74),IX(  74),IY(  74)/'DRAW',   0,  -9/
1585      DATA IOPERA(  75),IX(  75),IY(  75)/'MOVE',  -6,  12/
1586      DATA IOPERA(  76),IX(  76),IY(  76)/'DRAW',   0,  -6/
1587      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW',   0,  -9/
1588      DATA IOPERA(  78),IX(  78),IY(  78)/'MOVE',  -5,  12/
1589      DATA IOPERA(  79),IX(  79),IY(  79)/'DRAW',   1,  -6/
1590      DATA IOPERA(  80),IX(  80),IY(  80)/'MOVE',   7,  11/
1591      DATA IOPERA(  81),IX(  81),IY(  81)/'DRAW',   0,  -9/
1592      DATA IOPERA(  82),IX(  82),IY(  82)/'MOVE',  -9,  12/
1593      DATA IOPERA(  83),IX(  83),IY(  83)/'DRAW',  -2,  12/
1594      DATA IOPERA(  84),IX(  84),IY(  84)/'MOVE',   3,  12/
1595      DATA IOPERA(  85),IX(  85),IY(  85)/'DRAW',   9,  12/
1596      DATA IOPERA(  86),IX(  86),IY(  86)/'MOVE',  -8,  12/
1597      DATA IOPERA(  87),IX(  87),IY(  87)/'DRAW',  -6,  10/
1598      DATA IOPERA(  88),IX(  88),IY(  88)/'MOVE',  -4,  12/
1599      DATA IOPERA(  89),IX(  89),IY(  89)/'DRAW',  -5,  10/
1600      DATA IOPERA(  90),IX(  90),IY(  90)/'MOVE',  -3,  12/
1601      DATA IOPERA(  91),IX(  91),IY(  91)/'DRAW',  -5,  11/
1602      DATA IOPERA(  92),IX(  92),IY(  92)/'MOVE',   5,  12/
1603      DATA IOPERA(  93),IX(  93),IY(  93)/'DRAW',   7,  11/
1604      DATA IOPERA(  94),IX(  94),IY(  94)/'MOVE',   8,  12/
1605      DATA IOPERA(  95),IX(  95),IY(  95)/'DRAW',   7,  11/
1606C
1607      DATA IXMIND(  22)/ -10/
1608      DATA IXMAXD(  22)/  10/
1609      DATA IXDELD(  22)/  20/
1610      DATA ISTARD(  22)/  73/
1611      DATA NUMCOO(  22)/  23/
1612C
1613C     DEFINE CHARACTER   3023--UPPER CASE W
1614C
1615      DATA IOPERA(  96),IX(  96),IY(  96)/'MOVE',  -8,  12/
1616      DATA IOPERA(  97),IX(  97),IY(  97)/'DRAW',  -4,  -9/
1617      DATA IOPERA(  98),IX(  98),IY(  98)/'MOVE',  -7,  12/
1618      DATA IOPERA(  99),IX(  99),IY(  99)/'DRAW',  -4,  -4/
1619      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',  -4,  -9/
1620      DATA IOPERA( 101),IX( 101),IY( 101)/'MOVE',  -6,  12/
1621      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',  -3,  -4/
1622      DATA IOPERA( 103),IX( 103),IY( 103)/'MOVE',   0,  12/
1623      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',  -3,  -4/
1624      DATA IOPERA( 105),IX( 105),IY( 105)/'DRAW',  -4,  -9/
1625      DATA IOPERA( 106),IX( 106),IY( 106)/'MOVE',   0,  12/
1626      DATA IOPERA( 107),IX( 107),IY( 107)/'DRAW',   4,  -9/
1627      DATA IOPERA( 108),IX( 108),IY( 108)/'MOVE',   1,  12/
1628      DATA IOPERA( 109),IX( 109),IY( 109)/'DRAW',   4,  -4/
1629      DATA IOPERA( 110),IX( 110),IY( 110)/'DRAW',   4,  -9/
1630      DATA IOPERA( 111),IX( 111),IY( 111)/'MOVE',   2,  12/
1631      DATA IOPERA( 112),IX( 112),IY( 112)/'DRAW',   5,  -4/
1632      DATA IOPERA( 113),IX( 113),IY( 113)/'MOVE',   8,  11/
1633      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',   5,  -4/
1634      DATA IOPERA( 115),IX( 115),IY( 115)/'DRAW',   4,  -9/
1635      DATA IOPERA( 116),IX( 116),IY( 116)/'MOVE', -11,  12/
1636      DATA IOPERA( 117),IX( 117),IY( 117)/'DRAW',  -3,  12/
1637      DATA IOPERA( 118),IX( 118),IY( 118)/'MOVE',   0,  12/
1638      DATA IOPERA( 119),IX( 119),IY( 119)/'DRAW',   2,  12/
1639      DATA IOPERA( 120),IX( 120),IY( 120)/'MOVE',   5,  12/
1640      DATA IOPERA( 121),IX( 121),IY( 121)/'DRAW',  11,  12/
1641      DATA IOPERA( 122),IX( 122),IY( 122)/'MOVE', -10,  12/
1642      DATA IOPERA( 123),IX( 123),IY( 123)/'DRAW',  -7,  11/
1643      DATA IOPERA( 124),IX( 124),IY( 124)/'MOVE',  -9,  12/
1644      DATA IOPERA( 125),IX( 125),IY( 125)/'DRAW',  -7,  10/
1645      DATA IOPERA( 126),IX( 126),IY( 126)/'MOVE',  -5,  12/
1646      DATA IOPERA( 127),IX( 127),IY( 127)/'DRAW',  -6,  10/
1647      DATA IOPERA( 128),IX( 128),IY( 128)/'MOVE',  -4,  12/
1648      DATA IOPERA( 129),IX( 129),IY( 129)/'DRAW',  -6,  11/
1649      DATA IOPERA( 130),IX( 130),IY( 130)/'MOVE',   6,  12/
1650      DATA IOPERA( 131),IX( 131),IY( 131)/'DRAW',   8,  11/
1651      DATA IOPERA( 132),IX( 132),IY( 132)/'MOVE',  10,  12/
1652      DATA IOPERA( 133),IX( 133),IY( 133)/'DRAW',   8,  11/
1653C
1654      DATA IXMIND(  23)/ -12/
1655      DATA IXMAXD(  23)/  12/
1656      DATA IXDELD(  23)/  24/
1657      DATA ISTARD(  23)/  96/
1658      DATA NUMCOO(  23)/  38/
1659C
1660C     DEFINE CHARACTER   3024--UPPER CASE X
1661C
1662      DATA IOPERA( 134),IX( 134),IY( 134)/'MOVE',  -7,  12/
1663      DATA IOPERA( 135),IX( 135),IY( 135)/'DRAW',   5,  -9/
1664      DATA IOPERA( 136),IX( 136),IY( 136)/'MOVE',  -6,  12/
1665      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',   6,  -9/
1666      DATA IOPERA( 138),IX( 138),IY( 138)/'MOVE',  -5,  12/
1667      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',   7,  -9/
1668      DATA IOPERA( 140),IX( 140),IY( 140)/'MOVE',   6,  11/
1669      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',  -6,  -8/
1670      DATA IOPERA( 142),IX( 142),IY( 142)/'MOVE',  -9,  12/
1671      DATA IOPERA( 143),IX( 143),IY( 143)/'DRAW',  -2,  12/
1672      DATA IOPERA( 144),IX( 144),IY( 144)/'MOVE',   3,  12/
1673      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',   9,  12/
1674      DATA IOPERA( 146),IX( 146),IY( 146)/'MOVE',  -9,  -9/
1675      DATA IOPERA( 147),IX( 147),IY( 147)/'DRAW',  -3,  -9/
1676      DATA IOPERA( 148),IX( 148),IY( 148)/'MOVE',   2,  -9/
1677      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',   9,  -9/
1678      DATA IOPERA( 150),IX( 150),IY( 150)/'MOVE',  -8,  12/
1679      DATA IOPERA( 151),IX( 151),IY( 151)/'DRAW',  -5,  10/
1680      DATA IOPERA( 152),IX( 152),IY( 152)/'MOVE',  -4,  12/
1681      DATA IOPERA( 153),IX( 153),IY( 153)/'DRAW',  -5,  10/
1682      DATA IOPERA( 154),IX( 154),IY( 154)/'MOVE',  -3,  12/
1683      DATA IOPERA( 155),IX( 155),IY( 155)/'DRAW',  -5,  11/
1684      DATA IOPERA( 156),IX( 156),IY( 156)/'MOVE',   4,  12/
1685      DATA IOPERA( 157),IX( 157),IY( 157)/'DRAW',   6,  11/
1686      DATA IOPERA( 158),IX( 158),IY( 158)/'MOVE',   8,  12/
1687      DATA IOPERA( 159),IX( 159),IY( 159)/'DRAW',   6,  11/
1688      DATA IOPERA( 160),IX( 160),IY( 160)/'MOVE',  -6,  -8/
1689      DATA IOPERA( 161),IX( 161),IY( 161)/'DRAW',  -8,  -9/
1690      DATA IOPERA( 162),IX( 162),IY( 162)/'MOVE',  -6,  -8/
1691      DATA IOPERA( 163),IX( 163),IY( 163)/'DRAW',  -4,  -9/
1692      DATA IOPERA( 164),IX( 164),IY( 164)/'MOVE',   5,  -8/
1693      DATA IOPERA( 165),IX( 165),IY( 165)/'DRAW',   3,  -9/
1694      DATA IOPERA( 166),IX( 166),IY( 166)/'MOVE',   5,  -7/
1695      DATA IOPERA( 167),IX( 167),IY( 167)/'DRAW',   4,  -9/
1696      DATA IOPERA( 168),IX( 168),IY( 168)/'MOVE',   5,  -7/
1697      DATA IOPERA( 169),IX( 169),IY( 169)/'DRAW',   8,  -9/
1698C
1699      DATA IXMIND(  24)/ -10/
1700      DATA IXMAXD(  24)/  10/
1701      DATA IXDELD(  24)/  20/
1702      DATA ISTARD(  24)/ 134/
1703      DATA NUMCOO(  24)/  36/
1704C
1705C     DEFINE CHARACTER   3025--UPPER CASE Y
1706C
1707      DATA IOPERA( 170),IX( 170),IY( 170)/'MOVE',  -8,  12/
1708      DATA IOPERA( 171),IX( 171),IY( 171)/'DRAW',  -1,   1/
1709      DATA IOPERA( 172),IX( 172),IY( 172)/'DRAW',  -1,  -9/
1710      DATA IOPERA( 173),IX( 173),IY( 173)/'MOVE',  -7,  12/
1711      DATA IOPERA( 174),IX( 174),IY( 174)/'DRAW',   0,   1/
1712      DATA IOPERA( 175),IX( 175),IY( 175)/'DRAW',   0,  -8/
1713      DATA IOPERA( 176),IX( 176),IY( 176)/'MOVE',  -6,  12/
1714      DATA IOPERA( 177),IX( 177),IY( 177)/'DRAW',   1,   1/
1715      DATA IOPERA( 178),IX( 178),IY( 178)/'DRAW',   1,  -9/
1716      DATA IOPERA( 179),IX( 179),IY( 179)/'MOVE',   7,  11/
1717      DATA IOPERA( 180),IX( 180),IY( 180)/'DRAW',   1,   1/
1718      DATA IOPERA( 181),IX( 181),IY( 181)/'MOVE', -10,  12/
1719      DATA IOPERA( 182),IX( 182),IY( 182)/'DRAW',  -3,  12/
1720      DATA IOPERA( 183),IX( 183),IY( 183)/'MOVE',   4,  12/
1721      DATA IOPERA( 184),IX( 184),IY( 184)/'DRAW',  10,  12/
1722      DATA IOPERA( 185),IX( 185),IY( 185)/'MOVE',  -4,  -9/
1723      DATA IOPERA( 186),IX( 186),IY( 186)/'DRAW',   4,  -9/
1724      DATA IOPERA( 187),IX( 187),IY( 187)/'MOVE',  -9,  12/
1725      DATA IOPERA( 188),IX( 188),IY( 188)/'DRAW',  -7,  11/
1726      DATA IOPERA( 189),IX( 189),IY( 189)/'MOVE',  -4,  12/
1727      DATA IOPERA( 190),IX( 190),IY( 190)/'DRAW',  -6,  11/
1728      DATA IOPERA( 191),IX( 191),IY( 191)/'MOVE',   5,  12/
1729      DATA IOPERA( 192),IX( 192),IY( 192)/'DRAW',   7,  11/
1730      DATA IOPERA( 193),IX( 193),IY( 193)/'MOVE',   9,  12/
1731      DATA IOPERA( 194),IX( 194),IY( 194)/'DRAW',   7,  11/
1732      DATA IOPERA( 195),IX( 195),IY( 195)/'MOVE',  -1,  -8/
1733      DATA IOPERA( 196),IX( 196),IY( 196)/'DRAW',  -3,  -9/
1734      DATA IOPERA( 197),IX( 197),IY( 197)/'MOVE',  -1,  -7/
1735      DATA IOPERA( 198),IX( 198),IY( 198)/'DRAW',  -2,  -9/
1736      DATA IOPERA( 199),IX( 199),IY( 199)/'MOVE',   1,  -7/
1737      DATA IOPERA( 200),IX( 200),IY( 200)/'DRAW',   2,  -9/
1738      DATA IOPERA( 201),IX( 201),IY( 201)/'MOVE',   1,  -8/
1739      DATA IOPERA( 202),IX( 202),IY( 202)/'DRAW',   3,  -9/
1740C
1741      DATA IXMIND(  25)/ -11/
1742      DATA IXMAXD(  25)/  11/
1743      DATA IXDELD(  25)/  22/
1744      DATA ISTARD(  25)/ 170/
1745      DATA NUMCOO(  25)/  33/
1746C
1747C     DEFINE CHARACTER   3026--UPPER CASE Z
1748C
1749      DATA IOPERA( 203),IX( 203),IY( 203)/'MOVE',   7,  12/
1750      DATA IOPERA( 204),IX( 204),IY( 204)/'DRAW',  -7,  12/
1751      DATA IOPERA( 205),IX( 205),IY( 205)/'DRAW',  -7,   6/
1752      DATA IOPERA( 206),IX( 206),IY( 206)/'MOVE',   5,  12/
1753      DATA IOPERA( 207),IX( 207),IY( 207)/'DRAW',  -7,  -9/
1754      DATA IOPERA( 208),IX( 208),IY( 208)/'MOVE',   6,  12/
1755      DATA IOPERA( 209),IX( 209),IY( 209)/'DRAW',  -6,  -9/
1756      DATA IOPERA( 210),IX( 210),IY( 210)/'MOVE',   7,  12/
1757      DATA IOPERA( 211),IX( 211),IY( 211)/'DRAW',  -5,  -9/
1758      DATA IOPERA( 212),IX( 212),IY( 212)/'MOVE',  -7,  -9/
1759      DATA IOPERA( 213),IX( 213),IY( 213)/'DRAW',   7,  -9/
1760      DATA IOPERA( 214),IX( 214),IY( 214)/'DRAW',   7,  -3/
1761      DATA IOPERA( 215),IX( 215),IY( 215)/'MOVE',  -6,  12/
1762      DATA IOPERA( 216),IX( 216),IY( 216)/'DRAW',  -7,   6/
1763      DATA IOPERA( 217),IX( 217),IY( 217)/'MOVE',  -5,  12/
1764      DATA IOPERA( 218),IX( 218),IY( 218)/'DRAW',  -7,   9/
1765      DATA IOPERA( 219),IX( 219),IY( 219)/'MOVE',  -4,  12/
1766      DATA IOPERA( 220),IX( 220),IY( 220)/'DRAW',  -7,  10/
1767      DATA IOPERA( 221),IX( 221),IY( 221)/'MOVE',  -2,  12/
1768      DATA IOPERA( 222),IX( 222),IY( 222)/'DRAW',  -7,  11/
1769      DATA IOPERA( 223),IX( 223),IY( 223)/'MOVE',   2,  -9/
1770      DATA IOPERA( 224),IX( 224),IY( 224)/'DRAW',   7,  -8/
1771      DATA IOPERA( 225),IX( 225),IY( 225)/'MOVE',   4,  -9/
1772      DATA IOPERA( 226),IX( 226),IY( 226)/'DRAW',   7,  -7/
1773      DATA IOPERA( 227),IX( 227),IY( 227)/'MOVE',   5,  -9/
1774      DATA IOPERA( 228),IX( 228),IY( 228)/'DRAW',   7,  -6/
1775      DATA IOPERA( 229),IX( 229),IY( 229)/'MOVE',   6,  -9/
1776      DATA IOPERA( 230),IX( 230),IY( 230)/'DRAW',   7,  -3/
1777C
1778      DATA IXMIND(  26)/ -10/
1779      DATA IXMAXD(  26)/  10/
1780      DATA IXDELD(  26)/  20/
1781      DATA ISTARD(  26)/ 203/
1782      DATA NUMCOO(  26)/  28/
1783C
1784C-----START POINT-----------------------------------------------------
1785C
1786      IFOUND='YES'
1787      IERROR='NO'
1788C
1789      NUMCO=1
1790      ISTART=1
1791      ISTOP=1
1792      NC=1
1793C
1794C               ******************************************
1795C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
1796C               **  HERSHEY CHARACTER SET CASE          **
1797C               ******************************************
1798C
1799C
1800      IF(IBUGD2.EQ.'OFF')GOTO90
1801      WRITE(ICOUT,999)
1802  999 FORMAT(1X)
1803      CALL DPWRST('XXX','BUG ')
1804      WRITE(ICOUT,51)
1805   51 FORMAT('***** AT THE BEGINNING OF DRTU4--')
1806      CALL DPWRST('XXX','BUG ')
1807      WRITE(ICOUT,52)ICHARN
1808   52 FORMAT('ICHARN = ',I8)
1809      CALL DPWRST('XXX','BUG ')
1810      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
1811   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
1812      CALL DPWRST('XXX','BUG ')
1813   90 CONTINUE
1814C
1815C               **************************************
1816C               **  STEP 2--                        **
1817C               **  EXTRACT THE COORDINATES         **
1818C               **  FOR THIS PARTICULAR CHARACTER.  **
1819C               **************************************
1820C
1821      ISTART=ISTARD(ICHARN)
1822      NC=NUMCOO(ICHARN)
1823      ISTOP=ISTART+NC-1
1824      J=0
1825      DO1100I=ISTART,ISTOP
1826      J=J+1
1827      IOP(J)=IOPERA(I)
1828      X(J)=IX(I)
1829      Y(J)=IY(I)
1830 1100 CONTINUE
1831      NUMCO=J
1832      IXMINS=IXMIND(ICHARN)
1833      IXMAXS=IXMAXD(ICHARN)
1834      IXDELS=IXDELD(ICHARN)
1835C
1836      GOTO9000
1837C
1838C               *****************
1839C               **  STEP 90--  **
1840C               **  EXIT       **
1841C               *****************
1842C
1843 9000 CONTINUE
1844      IF(IBUGD2.EQ.'OFF')GOTO9090
1845      WRITE(ICOUT,999)
1846      CALL DPWRST('XXX','BUG ')
1847      WRITE(ICOUT,9011)
1848 9011 FORMAT('***** AT THE END       OF DRTU4--')
1849      CALL DPWRST('XXX','BUG ')
1850      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
1851 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
1852      CALL DPWRST('XXX','BUG ')
1853      WRITE(ICOUT,9013)ICHARN
1854 9013 FORMAT('ICHARN = ',I8)
1855      CALL DPWRST('XXX','BUG ')
1856      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
1857 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
1858      CALL DPWRST('XXX','BUG ')
1859      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
1860      DO9015I=1,NUMCO
1861      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
1862 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
1863      CALL DPWRST('XXX','BUG ')
1864 9015 CONTINUE
1865 9019 CONTINUE
1866      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
1867 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
1868      CALL DPWRST('XXX','BUG ')
1869 9090 CONTINUE
1870C
1871      RETURN
1872      END
1873      SUBROUTINE DRWFIL(XC,YC,NMX,NSEG,NPTS,SNSE,CLSD,NSGX,X,Y,IMX,
1874     1                  JMX,IB,JB,NBX,PRMTR,NS,D,CN,WLN,IDSH,KOLR,
1875     1                  LBL,LDEC,SZL,DLMM,
1876     1                  XTEMP,YTEMP,TATEMP,NTEMP,NTRACE,
1877     1                  IBUGG3,ISUBRO,IERROR)
1878C
1879C     PURPOSE--XX
1880C
1881C     WRITTEN BY--DAVID W. BEHRINGER NOAA/AOML (MIAMI).
1882C                 AS PART OF NOAA'S CONCX V.3   MARCH 1988.
1883C     ORIGINAL VERSION (IN DATAPLOT)--AUGUST    1988.
1884C
1885C     UPDATED         --JANUARY   1989.  MORE CHANGES TO STANDARD FORTRAN 77--
1886C                                        REPLACED ENCODE WITH
1887C                                        INTERNAL WRITE (ALAN HECKERT).
1888C
1889C-----COMMON----------------------------------------------------------
1890C
1891      INCLUDE 'DPCOCP.INC'
1892C
1893C---------------------------------------------------------------------
1894C
1895      CHARACTER CHR(15)*1
1896      CHARACTER*15 CHRTMP
1897C
1898CCCCC INTEGER NPTS(NSGX,3),SNSE(NSGX,3),CLSD(NSGX,3),NSEG(3),NSGE(3),
1899CCCCC1 NSGCL(3),NSGCH(3),NTPE(3),NTPCL(3),NTPCH(3)
1900CCCCC DIMENSION XC(NMX,3),YC(NMX,3),D(2,NSGX,3),IB(NBX),JB(NBX),
1901CCCCC1 X(IMX),Y(JMX),NS(2,NSGX,3)
1902C
1903      CHARACTER*4 IBUGG3
1904      CHARACTER*4 ISUBRO
1905      CHARACTER*4 IERROR
1906C
1907      INTEGER NPTS
1908      INTEGER SNSE
1909      INTEGER CLSD
1910      INTEGER NSEG
1911      INTEGER NSGE
1912      INTEGER NSGCL
1913      INTEGER NSGCH
1914      INTEGER NTPE
1915      INTEGER NTPCL
1916      INTEGER NTPCH
1917C
1918      DIMENSION NPTS(MAXNSG,3)
1919      DIMENSION SNSE(MAXNSG,3)
1920      DIMENSION CLSD(MAXNSG,3)
1921      DIMENSION NSEG(3)
1922      DIMENSION NSGE(3)
1923      DIMENSION NSGCL(3)
1924      DIMENSION NSGCH(3)
1925      DIMENSION NTPE(3)
1926      DIMENSION NTPCL(3)
1927      DIMENSION NTPCH(3)
1928C
1929      DIMENSION XC(MAXNMX,3)
1930      DIMENSION YC(MAXNMX,3)
1931      DIMENSION D(2,MAXNSG,3)
1932      DIMENSION IB(*)
1933      DIMENSION JB(*)
1934      DIMENSION X(*)
1935      DIMENSION Y(*)
1936      DIMENSION NS(2,MAXNSG,3)
1937C
1938      DIMENSION XTEMP(*)
1939      DIMENSION YTEMP(*)
1940      DIMENSION TATEMP(*)
1941C
1942      DATA FRM/0.0/
1943C
1944C-----START POINT-----------------------------------------------------
1945C
1946C   SORT THE CONTOUR SEGMENTS AND CREATE POLYGONS FOR COLOR FILL
1947C
1948      CALL PLYSRT(XC,YC,NMX,NSEG,NSGE,NSGCL,NSGCH,NPTS,NTPE,NTPCL,
1949     1   NTPCH,SNSE,CLSD,NSGX,X,Y,IMX,JMX,IB,JB,NBX,PRMTR,NS,D)
1950C
1951C   FILL THE POLYGONS WITH COLOR
1952C
1953      IF (KOLR.GE.0) THEN
1954        L1=1
1955        DO 10 N=1,NSEG(3)
1956          NP=NPTS(N,3)
1957          CALL RSURF(XC(L1,3),YC(L1,3),NP,KOLR,FRM,
1958     1               XTEMP,YTEMP,TATEMP,NTEMP,NTRACE,
1959     1               IBUGG3,ISUBRO,IERROR)
1960          L1=L1+NP
1961 10     CONTINUE
1962      END IF
1963C
1964C   DRAW THE CONTOURS (USE *(*,3) ARRAYS TO PREVENT DATA LOSS DUE TO GVECT)
1965C
1966      IF (CN.NE.999.999) THEN
1967C
1968CCCCC   CALL GWICOL(WLN,1)    AUGUST 1988
1969        WLNT=WLN
1970C
1971        IF (LBL.GT.0) THEN
1972          IPOW=MAX0(LDEC+1,1)
1973CCCCC THE FOLLOWING 2 LINES WERE CORRECTED JANUARY 1989
1974CCCCC     ENCODE(15,999,CHR) CN+SIGN(10.**-IPOW,CN)
1975C999      FORMAT(F15.5)
1976          WRITE(CHRTMP,'(F15.5)') CN+SIGN(10.**(-IPOW),CN)
1977          DO 15 III=1,15
1978            CHR(III)=CHRTMP(III:III)
1979 15       CONTINUE
1980C  END CHANGE
1981          I=MAX0(0,INT(LOG10(ABS(CN+SIGN(0.001,CN)))))+1
1982          IF (CN.LT.0.) I=I+1
1983          IS=MAX0(1,10-I)
1984          IE=10+LDEC
1985          DO 20 I=IS,IE
1986            NCHR=I-IS+1
1987            CHR(NCHR)=CHR(I)
1988 20       CONTINUE
1989        END IF
1990        L2=0
1991        DO 30 NSG=1,NSEG(1)
1992          L1=L2+1
1993          NP=IABS(NPTS(NSG,1))
1994          L2=L2+NP
1995          DO 40 L=L1,L2
1996            LL=L-L1+1
1997            LLL=L2-L+L1
1998            XC(LL,3)=XC(LLL,1)
1999            YC(LL,3)=YC(LLL,1)
2000 40       CONTINUE
2001          IF (LBL.LE.0) THEN
2002            CALL DRAW0(XC(1,3),YC(1,3),NP,IDSH,
2003     1                 XTEMP,YTEMP,TATEMP,NTEMP,NTRACE,
2004     1                 IBUGG3,ISUBRO,IERROR)
2005          ELSE
2006            CALL DRAWL(XC(1,3),YC(1,3),D(1,1,3),NP,IDSH,CHR,
2007     1                 NCHR,SZL,DLMM,
2008     1                 XTEMP,YTEMP,TATEMP,NTEMP,NTRACE,
2009     1                 IBUGG3,ISUBRO,IERROR)
2010          END IF
2011 30     CONTINUE
2012      END IF
2013C
2014C   CONVERT *(*,2) ARRAYS TO *(*,1) ARRAYS
2015C
2016      N=0
2017      LE=0
2018      DO 50 K=1,3
2019        IF (K.EQ.1) THEN
2020          NSG=NSGE(2)
2021          NSGE(1)=NSG
2022          NTPE(1)=NTPE(2)
2023          NN=0
2024          LOFF=0
2025        ELSE IF (K.EQ.2) THEN
2026          NSG=NSGCH(2)
2027          NSGCL(1)=NSG
2028          NTPCL(1)=NTPCH(2)
2029          NN=NSGE(2)+NSGCL(2)
2030          LOFF=NTPCL(2)
2031        ELSE
2032          NSG=NSGCL(2)
2033          NSGCH(1)=NSG
2034          NTPCH(1)=NTPCL(2)
2035          NN=NSGE(2)
2036          LOFF=-NTPCH(2)
2037        END IF
2038        DO 60 N0=1,NSG
2039          N=N+1
2040          NN=NN+1
2041          NPTS(N,1)=IABS(NPTS(NN,2))
2042          SNSE(N,1)=1
2043          CLSD(N,1)=-CLSD(NN,2)
2044          LS=LE+1
2045          LE=LE+NPTS(N,1)
2046          DO 70 L=LS,LE
2047            LL=LE-L+LS+LOFF
2048            XC(L,1)=XC(LL,2)
2049            YC(L,1)=YC(LL,2)
2050 70       CONTINUE
2051          IF (K.EQ.1) THEN
2052            DO 80 I=1,2
2053              II=MOD(I,2)+1
2054              NS(I,N,1)=NS(II,NN,2)
2055              D(I,N,1)=D(II,NN,2)
2056 80         CONTINUE
2057          ELSE
2058            D(1,N,1)=D(1,NN,2)
2059          END IF
2060 60     CONTINUE
2061 50   CONTINUE
2062      NSEG(1)=NSEG(2)
2063      RETURN
2064      END
2065      SUBROUTINE DSCAL(N,DA,DX,INCX)
2066C
2067C     SCALES A VECTOR BY A CONSTANT.
2068C     USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE.
2069C     JACK DONGARRA, LINPACK, 3/11/78.
2070C     MODIFIED 3/93 TO RETURN IF INCX .LE. 0.
2071C
2072      DOUBLE PRECISION DA,DX(1)
2073      INTEGER I,INCX,M,MP1,N,NINCX
2074C
2075      IF( N.LE.0 .OR. INCX.LE.0 )RETURN
2076      IF(INCX.EQ.1)GO TO 20
2077C
2078C        CODE FOR INCREMENT NOT EQUAL TO 1
2079C
2080      NINCX = N*INCX
2081      DO 10 I = 1,NINCX,INCX
2082        DX(I) = DA*DX(I)
2083   10 CONTINUE
2084      RETURN
2085C
2086C        CODE FOR INCREMENT EQUAL TO 1
2087C
2088C
2089C        CLEAN-UP LOOP
2090C
2091   20 M = MOD(N,5)
2092      IF( M .EQ. 0 ) GO TO 40
2093      DO 30 I = 1,M
2094        DX(I) = DA*DX(I)
2095   30 CONTINUE
2096      IF( N .LT. 5 ) RETURN
2097   40 MP1 = M + 1
2098      DO 50 I = MP1,N,5
2099        DX(I) = DA*DX(I)
2100        DX(I + 1) = DA*DX(I + 1)
2101        DX(I + 2) = DA*DX(I + 2)
2102        DX(I + 3) = DA*DX(I + 3)
2103        DX(I + 4) = DA*DX(I + 4)
2104   50 CONTINUE
2105      RETURN
2106      END
2107      SUBROUTINE DSET (N, X, CONST)
2108C
2109C     MARK VANGEL, NIST, JANUARY 1994
2110C     SUBROUTINE DSET SETS THE N VALUES IN X TO THE CONSTANT CONST
2111C
2112C
2113      DOUBLE PRECISION X, CONST
2114      DIMENSION X(N)
2115      DO 10 I=1, N
2116         X(I) = CONST
2117 10   CONTINUE
2118      RETURN
2119      END
2120      SUBROUTINE DSORT (DX, DY, N, KFLAG, IERROR)
2121C***BEGIN PROLOGUE  DSORT
2122C***PURPOSE  Sort an array and optionally make the same interchanges in
2123C            an auxiliary array.  The array may be sorted in increasing
2124C            or decreasing order.  A slightly modified QUICKSORT
2125C            algorithm is used.
2126C***LIBRARY   SLATEC
2127C***CATEGORY  N6A2B
2128C***TYPE      DOUBLE PRECISION (SSORT-S, DSORT-D, ISORT-I)
2129C***KEYWORDS  SINGLETON QUICKSORT, SORT, SORTING
2130C***AUTHOR  Jones, R. E., (SNLA)
2131C           Wisniewski, J. A., (SNLA)
2132C***DESCRIPTION
2133C
2134C   DSORT sorts array DX and optionally makes the same interchanges in
2135C   array DY.  The array DX may be sorted in increasing order or
2136C   decreasing order.  A slightly modified quicksort algorithm is used.
2137C
2138C   Description of Parameters
2139C      DX - array of values to be sorted   (usually abscissas)
2140C      DY - array to be (optionally) carried along
2141C      N  - number of values in array DX to be sorted
2142C      KFLAG - control parameter
2143C            =  2  means sort DX in increasing order and carry DY along.
2144C            =  1  means sort DX in increasing order (ignoring DY)
2145C            = -1  means sort DX in decreasing order (ignoring DY)
2146C            = -2  means sort DX in decreasing order and carry DY along.
2147C
2148C***REFERENCES  R. C. Singleton, Algorithm 347, An efficient algorithm
2149C                 for sorting with minimal storage, Communications of
2150C                 the ACM, 12, 3 (1969), pp. 185-187.
2151C***ROUTINES CALLED  XERMSG
2152C***REVISION HISTORY  (YYMMDD)
2153C   761101  DATE WRITTEN
2154C   761118  Modified to use the Singleton quicksort algorithm.  (JAW)
2155C   890531  Changed all specific intrinsics to generic.  (WRB)
2156C   890831  Modified array declarations.  (WRB)
2157C   891009  Removed unreferenced statement labels.  (WRB)
2158C   891024  Changed category.  (WRB)
2159C   891024  REVISION DATE from Version 3.2
2160C   891214  Prologue converted to Version 4.0 format.  (BAB)
2161C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
2162C   901012  Declared all variables; changed X,Y to DX,DY; changed
2163C           code to parallel SSORT. (M. McClain)
2164C   920501  Reformatted the REFERENCES section.  (DWL, WRB)
2165C   920519  Clarified error messages.  (DWL)
2166C   920801  Declarations section rebuilt and code restructured to use
2167C           IF-THEN-ELSE-ENDIF.  (RWC, WRB)
2168C   970821  Minor modifications to error handling and printing to
2169C           incorporate into Dataplot
2170C***END PROLOGUE  DSORT
2171C     .. Scalar Arguments ..
2172C
2173      CHARACTER*4 IERROR
2174      INCLUDE 'DPCOP2.INC'
2175C
2176      INTEGER KFLAG, N
2177C     .. Array Arguments ..
2178      DOUBLE PRECISION DX(*), DY(*)
2179C     .. Local Scalars ..
2180      DOUBLE PRECISION R, T, TT, TTY, TY
2181      INTEGER I, IJ, J, K, KK, L, M, NN
2182C     .. Local Arrays ..
2183      INTEGER IL(21), IU(21)
2184C     .. External Subroutines ..
2185CCCCC EXTERNAL XERMSG
2186C     .. Intrinsic Functions ..
2187      INTRINSIC ABS, INT
2188C***FIRST EXECUTABLE STATEMENT  DSORT
2189      IERROR='NO'
2190      NN = N
2191      IF (NN .LT. 1) THEN
2192CCCCC    CALL XERMSG ('SLATEC', 'DSORT',
2193CCCCC+      'The number of values to be sorted is not positive.', 1, 1)
2194         WRITE(ICOUT,1001)
2195         CALL DPWRST('XXX','BUG ')
2196         WRITE(ICOUT,1002)
2197         CALL DPWRST('XXX','BUG ')
2198         IERROR='YES'
2199         RETURN
2200      ENDIF
2201 1001 FORMAT('***** RECIPE ERROR: INTERNAL ERROR FROM DSORT')
2202 1002 FORMAT('      THE NUMBER OF VALUES TO BE SORTED IS NOT POSITIVE.')
2203C
2204      KK = ABS(KFLAG)
2205      IF (KK.NE.1 .AND. KK.NE.2) THEN
2206CCCCC    CALL XERMSG ('SLATEC', 'DSORT',
2207CCCCC+      'The sort control parameter, K, is not 2, 1, -1, or -2.', 2,
2208CCCCC+      1)
2209         WRITE(ICOUT,1003)
2210         CALL DPWRST('XXX','BUG ')
2211         WRITE(ICOUT,1004)
2212         CALL DPWRST('XXX','BUG ')
2213         IERROR='YES'
2214         RETURN
2215      ENDIF
2216 1003 FORMAT('***** RECIPE ERROR: INTERNAL ERROR FROM DSORT')
2217 1004 FORMAT('      THE SORT CONTROL PARAMETER, K, IS NOT 2, 1, ',
2218     1'-1, OR -2.')
2219C
2220C     Alter array DX to get decreasing order if needed
2221C
2222      IF (KFLAG .LE. -1) THEN
2223         DO 10 I=1,NN
2224            DX(I) = -DX(I)
2225   10    CONTINUE
2226      ENDIF
2227C
2228      IF (KK .EQ. 2) GO TO 100
2229C
2230C     Sort DX only
2231C
2232      M = 1
2233      I = 1
2234      J = NN
2235      R = 0.375D0
2236C
2237   20 IF (I .EQ. J) GO TO 60
2238      IF (R .LE. 0.5898437D0) THEN
2239         R = R+3.90625D-2
2240      ELSE
2241         R = R-0.21875D0
2242      ENDIF
2243C
2244   30 K = I
2245C
2246C     Select a central element of the array and save it in location T
2247C
2248      IJ = I + INT((J-I)*R)
2249      T = DX(IJ)
2250C
2251C     If first element of array is greater than T, interchange with T
2252C
2253      IF (DX(I) .GT. T) THEN
2254         DX(IJ) = DX(I)
2255         DX(I) = T
2256         T = DX(IJ)
2257      ENDIF
2258      L = J
2259C
2260C     If last element of array is less than than T, interchange with T
2261C
2262      IF (DX(J) .LT. T) THEN
2263         DX(IJ) = DX(J)
2264         DX(J) = T
2265         T = DX(IJ)
2266C
2267C        If first element of array is greater than T, interchange with T
2268C
2269         IF (DX(I) .GT. T) THEN
2270            DX(IJ) = DX(I)
2271            DX(I) = T
2272            T = DX(IJ)
2273         ENDIF
2274      ENDIF
2275C
2276C     Find an element in the second half of the array which is smaller
2277C     than T
2278C
2279   40 L = L-1
2280      IF (DX(L) .GT. T) GO TO 40
2281C
2282C     Find an element in the first half of the array which is greater
2283C     than T
2284C
2285   50 K = K+1
2286      IF (DX(K) .LT. T) GO TO 50
2287C
2288C     Interchange these elements
2289C
2290      IF (K .LE. L) THEN
2291         TT = DX(L)
2292         DX(L) = DX(K)
2293         DX(K) = TT
2294         GO TO 40
2295      ENDIF
2296C
2297C     Save upper and lower subscripts of the array yet to be sorted
2298C
2299      IF (L-I .GT. J-K) THEN
2300         IL(M) = I
2301         IU(M) = L
2302         I = K
2303         M = M+1
2304      ELSE
2305         IL(M) = K
2306         IU(M) = J
2307         J = L
2308         M = M+1
2309      ENDIF
2310      GO TO 70
2311C
2312C     Begin again on another portion of the unsorted array
2313C
2314   60 M = M-1
2315      IF (M .EQ. 0) GO TO 190
2316      I = IL(M)
2317      J = IU(M)
2318C
2319   70 IF (J-I .GE. 1) GO TO 30
2320      IF (I .EQ. 1) GO TO 20
2321      I = I-1
2322C
2323   80 I = I+1
2324      IF (I .EQ. J) GO TO 60
2325      T = DX(I+1)
2326      IF (DX(I) .LE. T) GO TO 80
2327      K = I
2328C
2329   90 DX(K+1) = DX(K)
2330      K = K-1
2331      IF (T .LT. DX(K)) GO TO 90
2332      DX(K+1) = T
2333      GO TO 80
2334C
2335C     Sort DX and carry DY along
2336C
2337  100 M = 1
2338      I = 1
2339      J = NN
2340      R = 0.375D0
2341C
2342  110 IF (I .EQ. J) GO TO 150
2343      IF (R .LE. 0.5898437D0) THEN
2344         R = R+3.90625D-2
2345      ELSE
2346         R = R-0.21875D0
2347      ENDIF
2348C
2349  120 K = I
2350C
2351C     Select a central element of the array and save it in location T
2352C
2353      IJ = I + INT((J-I)*R)
2354      T = DX(IJ)
2355      TY = DY(IJ)
2356C
2357C     If first element of array is greater than T, interchange with T
2358C
2359      IF (DX(I) .GT. T) THEN
2360         DX(IJ) = DX(I)
2361         DX(I) = T
2362         T = DX(IJ)
2363         DY(IJ) = DY(I)
2364         DY(I) = TY
2365         TY = DY(IJ)
2366      ENDIF
2367      L = J
2368C
2369C     If last element of array is less than T, interchange with T
2370C
2371      IF (DX(J) .LT. T) THEN
2372         DX(IJ) = DX(J)
2373         DX(J) = T
2374         T = DX(IJ)
2375         DY(IJ) = DY(J)
2376         DY(J) = TY
2377         TY = DY(IJ)
2378C
2379C        If first element of array is greater than T, interchange with T
2380C
2381         IF (DX(I) .GT. T) THEN
2382            DX(IJ) = DX(I)
2383            DX(I) = T
2384            T = DX(IJ)
2385            DY(IJ) = DY(I)
2386            DY(I) = TY
2387            TY = DY(IJ)
2388         ENDIF
2389      ENDIF
2390C
2391C     Find an element in the second half of the array which is smaller
2392C     than T
2393C
2394  130 L = L-1
2395      IF (DX(L) .GT. T) GO TO 130
2396C
2397C     Find an element in the first half of the array which is greater
2398C     than T
2399C
2400  140 K = K+1
2401      IF (DX(K) .LT. T) GO TO 140
2402C
2403C     Interchange these elements
2404C
2405      IF (K .LE. L) THEN
2406         TT = DX(L)
2407         DX(L) = DX(K)
2408         DX(K) = TT
2409         TTY = DY(L)
2410         DY(L) = DY(K)
2411         DY(K) = TTY
2412         GO TO 130
2413      ENDIF
2414C
2415C     Save upper and lower subscripts of the array yet to be sorted
2416C
2417      IF (L-I .GT. J-K) THEN
2418         IL(M) = I
2419         IU(M) = L
2420         I = K
2421         M = M+1
2422      ELSE
2423         IL(M) = K
2424         IU(M) = J
2425         J = L
2426         M = M+1
2427      ENDIF
2428      GO TO 160
2429C
2430C     Begin again on another portion of the unsorted array
2431C
2432  150 M = M-1
2433      IF (M .EQ. 0) GO TO 190
2434      I = IL(M)
2435      J = IU(M)
2436C
2437  160 IF (J-I .GE. 1) GO TO 120
2438      IF (I .EQ. 1) GO TO 110
2439      I = I-1
2440C
2441  170 I = I+1
2442      IF (I .EQ. J) GO TO 150
2443      T = DX(I+1)
2444      TY = DY(I+1)
2445      IF (DX(I) .LE. T) GO TO 170
2446      K = I
2447C
2448  180 DX(K+1) = DX(K)
2449      DY(K+1) = DY(K)
2450      K = K-1
2451      IF (T .LT. DX(K)) GO TO 180
2452      DX(K+1) = T
2453      DY(K+1) = TY
2454      GO TO 170
2455C
2456C     Clean up
2457C
2458  190 IF (KFLAG .LE. -1) THEN
2459         DO 200 I=1,NN
2460            DX(I) = -DX(I)
2461  200    CONTINUE
2462      ENDIF
2463      RETURN
2464      END
2465      DOUBLE PRECISION FUNCTION DSPENC (X)
2466C***BEGIN PROLOGUE  DSPENC
2467C***PURPOSE  Compute a form of Spence's integral due to K. Mitchell.
2468C***LIBRARY   SLATEC (FNLIB)
2469C***CATEGORY  C5
2470C***TYPE      DOUBLE PRECISION (SPENC-S, DSPENC-D)
2471C***KEYWORDS  FNLIB, SPECIAL FUNCTIONS, SPENCE'S INTEGRAL
2472C***AUTHOR  Fullerton, W., (LANL)
2473C***DESCRIPTION
2474C
2475C DSPENC(X) calculates the double precision Spence's integral
2476C for double precision argument X.  Spence's function defined by
2477C        integral from 0 to X of  -LOG(1-Y)/Y  DY.
2478C For ABS(X) .LE. 1, the uniformly convergent expansion
2479C        DSPENC = sum K=1,infinity  X**K / K**2     is valid.
2480C This is a form of Spence's integral due to K. Mitchell which differs
2481C from the definition in the NBS Handbook of Mathematical Functions.
2482C
2483C Spence's function can be used to evaluate much more general integral
2484C forms.  For example,
2485C        integral from 0 to Z of  LOG(A*X+B)/(C*X+D)  DX  =
2486C             LOG(ABS(B-A*D/C))*LOG(ABS(A*(C*X+D)/(A*D-B*C)))/C
2487C             - DSPENC (A*(C*Z+D)/(A*D-B*C)) / C.
2488C
2489C Ref -- K. Mitchell, Philosophical Magazine, 40, p.351 (1949).
2490C        Stegun and Abromowitz, AMS 55, p.1004.
2491C
2492C
2493C Series for SPEN       on the interval  0.          to  5.00000E-01
2494C                                        with weighted error   4.74E-32
2495C                                         log weighted error  31.32
2496C                               significant figures required  30.37
2497C                                    decimal places required  32.11
2498C
2499C***REFERENCES  (NONE)
2500C***ROUTINES CALLED  D1MACH, DCSEVL, INITDS
2501C***REVISION HISTORY  (YYMMDD)
2502C   780201  DATE WRITTEN
2503C   890531  Changed all specific intrinsics to generic.  (WRB)
2504C   891115  Corrected third argument in reference to INITDS.  (WRB)
2505C   891115  REVISION DATE from Version 3.2
2506C   891214  Prologue converted to Version 4.0 format.  (BAB)
2507C***END PROLOGUE  DSPENC
2508C
2509C-----COMMON----------------------------------------------------------
2510C
2511      INCLUDE 'DPCOMC.INC'
2512      INCLUDE 'DPCOP2.INC'
2513C
2514      DOUBLE PRECISION X, SPENCS(38), ALN, PI26, XBIG, DCSEVL
2515      LOGICAL FIRST
2516      SAVE SPENCS, PI26, NSPENC, XBIG, FIRST
2517      DATA SPENCS(  1) / +.1527365598 8924058729 4668491002 8 D+0      /
2518      DATA SPENCS(  2) / +.8169658058 0510144035 0183818527 1 D-1      /
2519      DATA SPENCS(  3) / +.5814157140 7787308729 7735064118 2 D-2      /
2520      DATA SPENCS(  4) / +.5371619814 5415275422 4788900531 9 D-3      /
2521      DATA SPENCS(  5) / +.5724704675 1858262332 1060305478 2 D-4      /
2522      DATA SPENCS(  6) / +.6674546121 6493363436 0783543858 9 D-5      /
2523      DATA SPENCS(  7) / +.8276467339 7156769815 8439168901 1 D-6      /
2524      DATA SPENCS(  8) / +.1073315673 0306789512 7000587335 4 D-6      /
2525      DATA SPENCS(  9) / +.1440077294 3032394023 3459033151 3 D-7      /
2526      DATA SPENCS( 10) / +.1984442029 9659063678 9887713960 8 D-8      /
2527      DATA SPENCS( 11) / +.2794005822 1636387202 0199482161 5 D-9      /
2528      DATA SPENCS( 12) / +.4003991310 8833118230 7258044590 8 D-10     /
2529      DATA SPENCS( 13) / +.5823462892 0446384713 6813583575 7 D-11     /
2530      DATA SPENCS( 14) / +.8576708692 6386892780 9791477122 4 D-12     /
2531      DATA SPENCS( 15) / +.1276862586 2801930459 8948303343 3 D-12     /
2532      DATA SPENCS( 16) / +.1918826209 0425170811 6238041606 2 D-13     /
2533      DATA SPENCS( 17) / +.2907319206 9771381777 9579971967 3 D-14     /
2534      DATA SPENCS( 18) / +.4437112685 2767804625 5747364174 5 D-15     /
2535      DATA SPENCS( 19) / +.6815727787 4145995278 6735913560 7 D-16     /
2536      DATA SPENCS( 20) / +.1053017386 0155744295 4701941664 4 D-16     /
2537      DATA SPENCS( 21) / +.1635389806 7523771000 5182173457 0 D-17     /
2538      DATA SPENCS( 22) / +.2551852874 9404639323 1090164258 1 D-18     /
2539      DATA SPENCS( 23) / +.3999020621 9993601127 7047037951 9 D-19     /
2540      DATA SPENCS( 24) / +.6291501645 2168118765 1414917119 9 D-20     /
2541      DATA SPENCS( 25) / +.9933827435 6756776438 0388775253 3 D-21     /
2542      DATA SPENCS( 26) / +.1573679570 7499648167 2176380586 6 D-21     /
2543      DATA SPENCS( 27) / +.2500595316 8494761293 6927095466 6 D-22     /
2544      DATA SPENCS( 28) / +.3984740918 3838111392 1066325333 3 D-23     /
2545      DATA SPENCS( 29) / +.6366473210 0828438926 9132629333 3 D-24     /
2546      DATA SPENCS( 30) / +.1019674287 2396783670 7706197333 3 D-24     /
2547      DATA SPENCS( 31) / +.1636881058 9135188411 1107413333 3 D-25     /
2548      DATA SPENCS( 32) / +.2633310439 4176501173 4527999999 9 D-26     /
2549      DATA SPENCS( 33) / +.4244811560 1239768172 2436266666 6 D-27     /
2550      DATA SPENCS( 34) / +.6855411983 6800529168 2474666666 6 D-28     /
2551      DATA SPENCS( 35) / +.1109122433 4380564340 1898666666 6 D-28     /
2552      DATA SPENCS( 36) / +.1797431304 9998914573 6533333333 3 D-29     /
2553      DATA SPENCS( 37) / +.2917505845 9760951732 9066666666 6 D-30     /
2554      DATA SPENCS( 38) / +.4742646808 9286710613 3333333333 3 D-31     /
2555      DATA PI26 / +1.644934066 8482264364 7241516664 6025189219 D0 /
2556      DATA FIRST /.TRUE./
2557C***FIRST EXECUTABLE STATEMENT  DSPENC
2558      IF (FIRST) THEN
2559         NSPENC = INITDS (SPENCS, 38, 0.1*REAL(D1MACH(3)))
2560         XBIG = 1.0D0/D1MACH(3)
2561      ENDIF
2562      FIRST = .FALSE.
2563C
2564      IF (X.GT.2.0D0) GO TO 60
2565      IF (X.GT.1.0D0) GO TO 50
2566      IF (X.GT.0.5D0) GO TO 40
2567      IF (X.GE.0.0D0) GO TO 30
2568      IF (X.GT.(-1.D0)) GO TO 20
2569C
2570C HERE IF X .LE. -1.0
2571C
2572      ALN = LOG(1.0D0-X)
2573      DSPENC = -PI26 - 0.5D0*ALN*(2.0D0*LOG(-X)-ALN)
2574      IF (X.GT.(-XBIG)) DSPENC = DSPENC
2575     1  + (1.D0 + DCSEVL (4.D0/(1.D0-X)-1.D0, SPENCS, NSPENC))/(1.D0-X)
2576      RETURN
2577C
2578C -1.0 .LT. X .LT. 0.0
2579C
2580 20   DSPENC = -0.5D0*LOG(1.0D0-X)**2
2581     1  - X*(1.D0+DCSEVL(4.D0*X/(X-1.D0)-1.D0, SPENCS, NSPENC))/(X-1.D0)
2582      RETURN
2583C
2584C 0.0 .LE. X .LE. 0.5
2585C
2586 30   DSPENC = X*(1.D0 + DCSEVL (4.D0*X-1.D0, SPENCS, NSPENC))
2587      RETURN
2588C
2589C 0.5 .LT. X .LE. 1.0
2590C
2591 40   DSPENC = PI26
2592      IF (X.NE.1.D0) DSPENC = PI26 - LOG(X)*LOG(1.0D0-X)
2593     1  - (1.D0-X)*(1.D0+DCSEVL(4.D0*(1.D0-X)-1.D0, SPENCS, NSPENC))
2594      RETURN
2595C
2596C 1.0 .LT. X .LE. 2.0
2597C
2598 50   DSPENC = PI26 - 0.5D0*LOG(X)*LOG((X-1.D0)**2/X)
2599     1  + (X-1.D0)*(1.D0+DCSEVL(4.D0*(X-1.D0)/X-1.D0, SPENCS, NSPENC))/X
2600      RETURN
2601C
2602C X .GT. 2.0
2603C
2604 60   DSPENC = 2.0D0*PI26 - 0.5D0*LOG(X)**2
2605      IF (X.LT.XBIG) DSPENC = DSPENC
2606     1  - (1.D0 + DCSEVL (4.D0/X-1.D0, SPENCS, NSPENC))/X
2607      RETURN
2608C
2609      END
2610      DOUBLE PRECISION FUNCTION DSUM (N, DX, INCX)
2611C
2612C     MARK VANGEL, NIST, JANUARY 1994
2613C     FUNCTION DSUM SUMS DX((I-1)*INCX+1), FOR I=1, ..., N.
2614C     COMPARE TO BLAS LEVEL 1 ROUTINE DASUM.
2615C
2616      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
2617      DIMENSION DX(1)
2618      DSUM = 0.D0
2619      DO 10 I=1, N
2620         DSUM = DSUM +DX ((I-1)*INCX +1)
2621 10   CONTINUE
2622      RETURN
2623      END
2624      SUBROUTINE DSVDC(X,LDX,N,P,S,E,U,LDU,V,LDV,WORK,JOB,INFO)
2625      INTEGER LDX,N,P,LDU,LDV,JOB,INFO
2626      DOUBLE PRECISION X(LDX,1),S(1),E(1),U(LDU,1),V(LDV,1),WORK(1)
2627C
2628C
2629C     DSVDC IS A SUBROUTINE TO REDUCE A DOUBLE PRECISION NXP MATRIX X
2630C     BY ORTHOGONAL TRANSFORMATIONS U AND V TO DIAGONAL FORM.  THE
2631C     DIAGONAL ELEMENTS S(I) ARE THE SINGULAR VALUES OF X.  THE
2632C     COLUMNS OF U ARE THE CORRESPONDING LEFT SINGULAR VECTORS,
2633C     AND THE COLUMNS OF V THE RIGHT SINGULAR VECTORS.
2634C
2635C     ON ENTRY
2636C
2637C         X         DOUBLE PRECISION(LDX,P), WHERE LDX.GE.N.
2638C                   X CONTAINS THE MATRIX WHOSE SINGULAR VALUE
2639C                   DECOMPOSITION IS TO BE COMPUTED.  X IS
2640C                   DESTROYED BY DSVDC.
2641C
2642C         LDX       INTEGER.
2643C                   LDX IS THE LEADING DIMENSION OF THE ARRAY X.
2644C
2645C         N         INTEGER.
2646C                   N IS THE NUMBER OF ROWS OF THE MATRIX X.
2647C
2648C         P         INTEGER.
2649C                   P IS THE NUMBER OF COLUMNS OF THE MATRIX X.
2650C
2651C         LDU       INTEGER.
2652C                   LDU IS THE LEADING DIMENSION OF THE ARRAY U.
2653C                   (SEE BELOW).
2654C
2655C         LDV       INTEGER.
2656C                   LDV IS THE LEADING DIMENSION OF THE ARRAY V.
2657C                   (SEE BELOW).
2658C
2659C         WORK      DOUBLE PRECISION(N).
2660C                   WORK IS A SCRATCH ARRAY.
2661C
2662C         JOB       INTEGER.
2663C                   JOB CONTROLS THE COMPUTATION OF THE SINGULAR
2664C                   VECTORS.  IT HAS THE DECIMAL EXPANSION AB
2665C                   WITH THE FOLLOWING MEANING
2666C
2667C                        A.EQ.0    DO NOT COMPUTE THE LEFT SINGULAR
2668C                                  VECTORS.
2669C                        A.EQ.1    RETURN THE N LEFT SINGULAR VECTORS
2670C                                  IN U.
2671C                        A.GE.2    RETURN THE FIRST MIN(N,P) SINGULAR
2672C                                  VECTORS IN U.
2673C                        B.EQ.0    DO NOT COMPUTE THE RIGHT SINGULAR
2674C                                  VECTORS.
2675C                        B.EQ.1    RETURN THE RIGHT SINGULAR VECTORS
2676C                                  IN V.
2677C
2678C     ON RETURN
2679C
2680C         S         DOUBLE PRECISION(MM), WHERE MM=MIN(N+1,P).
2681C                   THE FIRST MIN(N,P) ENTRIES OF S CONTAIN THE
2682C                   SINGULAR VALUES OF X ARRANGED IN DESCENDING
2683C                   ORDER OF MAGNITUDE.
2684C
2685C         E         DOUBLE PRECISION(P),
2686C                   E ORDINARILY CONTAINS ZEROS.  HOWEVER SEE THE
2687C                   DISCUSSION OF INFO FOR EXCEPTIONS.
2688C
2689C         U         DOUBLE PRECISION(LDU,K), WHERE LDU.GE.N.  IF
2690C                                   JOBA.EQ.1 THEN K.EQ.N, IF JOBA.GE.2
2691C                                   THEN K.EQ.MIN(N,P).
2692C                   U CONTAINS THE MATRIX OF LEFT SINGULAR VECTORS.
2693C                   U IS NOT REFERENCED IF JOBA.EQ.0.  IF N.LE.P
2694C                   OR IF JOBA.EQ.2, THEN U MAY BE IDENTIFIED WITH X
2695C                   IN THE SUBROUTINE CALL.
2696C
2697C         V         DOUBLE PRECISION(LDV,P), WHERE LDV.GE.P.
2698C                   V CONTAINS THE MATRIX OF RIGHT SINGULAR VECTORS.
2699C                   V IS NOT REFERENCED IF JOB.EQ.0.  IF P.LE.N,
2700C                   THEN V MAY BE IDENTIFIED WITH X IN THE
2701C                   SUBROUTINE CALL.
2702C
2703C         INFO      INTEGER.
2704C                   THE SINGULAR VALUES (AND THEIR CORRESPONDING
2705C                   SINGULAR VECTORS) S(INFO+1),S(INFO+2),...,S(M)
2706C                   ARE CORRECT (HERE M=MIN(N,P)).  THUS IF
2707C                   INFO.EQ.0, ALL THE SINGULAR VALUES AND THEIR
2708C                   VECTORS ARE CORRECT.  IN ANY EVENT, THE MATRIX
2709C                   B = TRANS(U)*X*V IS THE BIDIAGONAL MATRIX
2710C                   WITH THE ELEMENTS OF S ON ITS DIAGONAL AND THE
2711C                   ELEMENTS OF E ON ITS SUPER-DIAGONAL (TRANS(U)
2712C                   IS THE TRANSPOSE OF U).  THUS THE SINGULAR
2713C                   VALUES OF X AND B ARE THE SAME.
2714C
2715C     LINPACK. THIS VERSION DATED 08/14/78 .
2716C              CORRECTION MADE TO SHIFT 2/84.
2717C     G.W. STEWART, UNIVERSITY OF MARYLAND, ARGONNE NATIONAL LAB.
2718C
2719C     DSVDC USES THE FOLLOWING FUNCTIONS AND SUBPROGRAMS.
2720C
2721C     EXTERNAL DROT
2722C     BLAS DAXPY,DDOT,DSCAL,DSWAP,DNRM2,DROTG
2723C     FORTRAN DABS,DMAX1,MAX0,MIN0,MOD,DSQRT
2724C
2725C     INTERNAL VARIABLES
2726C
2727      INTEGER I,ITER,J,JOBU,K,KASE,KK,L,LL,LLS,LM1,LP1,LS,LU,M,MAXIT,
2728     *        MM,MM1,MP1,NCT,NCTP1,NCU,NRT,NRTP1
2729      DOUBLE PRECISION DDOT,T
2730      DOUBLE PRECISION B,C,CS,EL,EMM1,F,G,DNRM2,SCALE,SHIFT,SL,SM,SN,
2731     *                 SMM1,T1,TEST,ZTEST
2732      LOGICAL WANTU,WANTV
2733C
2734C
2735C     SET THE MAXIMUM NUMBER OF ITERATIONS.
2736C
2737      L=0
2738      LS=0
2739      MAXIT = 30
2740C
2741C     DETERMINE WHAT IS TO BE COMPUTED.
2742C
2743      WANTU = .FALSE.
2744      WANTV = .FALSE.
2745      JOBU = MOD(JOB,100)/10
2746      NCU = N
2747      IF (JOBU .GT. 1) NCU = MIN0(N,P)
2748      IF (JOBU .NE. 0) WANTU = .TRUE.
2749      IF (MOD(JOB,10) .NE. 0) WANTV = .TRUE.
2750C
2751C     REDUCE X TO BIDIAGONAL FORM, STORING THE DIAGONAL ELEMENTS
2752C     IN S AND THE SUPER-DIAGONAL ELEMENTS IN E.
2753C
2754      INFO = 0
2755      NCT = MIN0(N-1,P)
2756      NRT = MAX0(0,MIN0(P-2,N))
2757      LU = MAX0(NCT,NRT)
2758      IF (LU .LT. 1) GO TO 170
2759      DO 160 L = 1, LU
2760         LP1 = L + 1
2761         IF (L .GT. NCT) GO TO 20
2762C
2763C           COMPUTE THE TRANSFORMATION FOR THE L-TH COLUMN AND
2764C           PLACE THE L-TH DIAGONAL IN S(L).
2765C
2766            S(L) = DNRM2(N-L+1,X(L,L),1)
2767            IF (S(L) .EQ. 0.0D0) GO TO 10
2768               IF (X(L,L) .NE. 0.0D0) S(L) = DSIGN(S(L),X(L,L))
2769               CALL DSCAL(N-L+1,1.0D0/S(L),X(L,L),1)
2770               X(L,L) = 1.0D0 + X(L,L)
2771   10       CONTINUE
2772            S(L) = -S(L)
2773   20    CONTINUE
2774         IF (P .LT. LP1) GO TO 50
2775         DO 40 J = LP1, P
2776            IF (L .GT. NCT) GO TO 30
2777            IF (S(L) .EQ. 0.0D0) GO TO 30
2778C
2779C              APPLY THE TRANSFORMATION.
2780C
2781               T = -DDOT(N-L+1,X(L,L),1,X(L,J),1)/X(L,L)
2782               CALL DAXPY(N-L+1,T,X(L,L),1,X(L,J),1)
2783   30       CONTINUE
2784C
2785C           PLACE THE L-TH ROW OF X INTO  E FOR THE
2786C           SUBSEQUENT CALCULATION OF THE ROW TRANSFORMATION.
2787C
2788            E(J) = X(L,J)
2789   40    CONTINUE
2790   50    CONTINUE
2791         IF (.NOT.WANTU .OR. L .GT. NCT) GO TO 70
2792C
2793C           PLACE THE TRANSFORMATION IN U FOR SUBSEQUENT BACK
2794C           MULTIPLICATION.
2795C
2796            DO 60 I = L, N
2797               U(I,L) = X(I,L)
2798   60       CONTINUE
2799   70    CONTINUE
2800         IF (L .GT. NRT) GO TO 150
2801C
2802C           COMPUTE THE L-TH ROW TRANSFORMATION AND PLACE THE
2803C           L-TH SUPER-DIAGONAL IN E(L).
2804C
2805            E(L) = DNRM2(P-L,E(LP1),1)
2806            IF (E(L) .EQ. 0.0D0) GO TO 80
2807               IF (E(LP1) .NE. 0.0D0) E(L) = DSIGN(E(L),E(LP1))
2808               CALL DSCAL(P-L,1.0D0/E(L),E(LP1),1)
2809               E(LP1) = 1.0D0 + E(LP1)
2810   80       CONTINUE
2811            E(L) = -E(L)
2812            IF (LP1 .GT. N .OR. E(L) .EQ. 0.0D0) GO TO 120
2813C
2814C              APPLY THE TRANSFORMATION.
2815C
2816               DO 90 I = LP1, N
2817                  WORK(I) = 0.0D0
2818   90          CONTINUE
2819               DO 100 J = LP1, P
2820                  CALL DAXPY(N-L,E(J),X(LP1,J),1,WORK(LP1),1)
2821  100          CONTINUE
2822               DO 110 J = LP1, P
2823                  CALL DAXPY(N-L,-E(J)/E(LP1),WORK(LP1),1,X(LP1,J),1)
2824  110          CONTINUE
2825  120       CONTINUE
2826            IF (.NOT.WANTV) GO TO 140
2827C
2828C              PLACE THE TRANSFORMATION IN V FOR SUBSEQUENT
2829C              BACK MULTIPLICATION.
2830C
2831               DO 130 I = LP1, P
2832                  V(I,L) = E(I)
2833  130          CONTINUE
2834  140       CONTINUE
2835  150    CONTINUE
2836  160 CONTINUE
2837  170 CONTINUE
2838C
2839C     SET UP THE FINAL BIDIAGONAL MATRIX OR ORDER M.
2840C
2841      M = MIN0(P,N+1)
2842      NCTP1 = NCT + 1
2843      NRTP1 = NRT + 1
2844      IF (NCT .LT. P) S(NCTP1) = X(NCTP1,NCTP1)
2845      IF (N .LT. M) S(M) = 0.0D0
2846      IF (NRTP1 .LT. M) E(NRTP1) = X(NRTP1,M)
2847      E(M) = 0.0D0
2848C
2849C     IF REQUIRED, GENERATE U.
2850C
2851      IF (.NOT.WANTU) GO TO 300
2852         IF (NCU .LT. NCTP1) GO TO 200
2853         DO 190 J = NCTP1, NCU
2854            DO 180 I = 1, N
2855               U(I,J) = 0.0D0
2856  180       CONTINUE
2857            U(J,J) = 1.0D0
2858  190    CONTINUE
2859  200    CONTINUE
2860         IF (NCT .LT. 1) GO TO 290
2861         DO 280 LL = 1, NCT
2862            L = NCT - LL + 1
2863            IF (S(L) .EQ. 0.0D0) GO TO 250
2864               LP1 = L + 1
2865               IF (NCU .LT. LP1) GO TO 220
2866               DO 210 J = LP1, NCU
2867                  T = -DDOT(N-L+1,U(L,L),1,U(L,J),1)/U(L,L)
2868                  CALL DAXPY(N-L+1,T,U(L,L),1,U(L,J),1)
2869  210          CONTINUE
2870  220          CONTINUE
2871               CALL DSCAL(N-L+1,-1.0D0,U(L,L),1)
2872               U(L,L) = 1.0D0 + U(L,L)
2873               LM1 = L - 1
2874               IF (LM1 .LT. 1) GO TO 240
2875               DO 230 I = 1, LM1
2876                  U(I,L) = 0.0D0
2877  230          CONTINUE
2878  240          CONTINUE
2879            GO TO 270
2880  250       CONTINUE
2881               DO 260 I = 1, N
2882                  U(I,L) = 0.0D0
2883  260          CONTINUE
2884               U(L,L) = 1.0D0
2885  270       CONTINUE
2886  280    CONTINUE
2887  290    CONTINUE
2888  300 CONTINUE
2889C
2890C     IF IT IS REQUIRED, GENERATE V.
2891C
2892      IF (.NOT.WANTV) GO TO 350
2893         DO 340 LL = 1, P
2894            L = P - LL + 1
2895            LP1 = L + 1
2896            IF (L .GT. NRT) GO TO 320
2897            IF (E(L) .EQ. 0.0D0) GO TO 320
2898               DO 310 J = LP1, P
2899                  T = -DDOT(P-L,V(LP1,L),1,V(LP1,J),1)/V(LP1,L)
2900                  CALL DAXPY(P-L,T,V(LP1,L),1,V(LP1,J),1)
2901  310          CONTINUE
2902  320       CONTINUE
2903            DO 330 I = 1, P
2904               V(I,L) = 0.0D0
2905  330       CONTINUE
2906            V(L,L) = 1.0D0
2907  340    CONTINUE
2908  350 CONTINUE
2909C
2910C     MAIN ITERATION LOOP FOR THE SINGULAR VALUES.
2911C
2912      MM = M
2913      ITER = 0
2914  360 CONTINUE
2915C
2916C        QUIT IF ALL THE SINGULAR VALUES HAVE BEEN FOUND.
2917C
2918C     ...EXIT
2919         IF (M .EQ. 0) GO TO 620
2920C
2921C        IF TOO MANY ITERATIONS HAVE BEEN PERFORMED, SET
2922C        FLAG AND RETURN.
2923C
2924         IF (ITER .LT. MAXIT) GO TO 370
2925            INFO = M
2926C     ......EXIT
2927            GO TO 620
2928  370    CONTINUE
2929C
2930C        THIS SECTION OF THE PROGRAM INSPECTS FOR
2931C        NEGLIGIBLE ELEMENTS IN THE S AND E ARRAYS.  ON
2932C        COMPLETION THE VARIABLES KASE AND L ARE SET AS FOLLOWS.
2933C
2934C           KASE = 1     IF S(M) AND E(L-1) ARE NEGLIGIBLE AND L.LT.M
2935C           KASE = 2     IF S(L) IS NEGLIGIBLE AND L.LT.M
2936C           KASE = 3     IF E(L-1) IS NEGLIGIBLE, L.LT.M, AND
2937C                        S(L), ..., S(M) ARE NOT NEGLIGIBLE (QR STEP).
2938C           KASE = 4     IF E(M-1) IS NEGLIGIBLE (CONVERGENCE).
2939C
2940         DO 390 LL = 1, M
2941            L = M - LL
2942C        ...EXIT
2943            IF (L .EQ. 0) GO TO 400
2944            TEST = DABS(S(L)) + DABS(S(L+1))
2945            ZTEST = TEST + DABS(E(L))
2946            IF (ZTEST .NE. TEST) GO TO 380
2947               E(L) = 0.0D0
2948C        ......EXIT
2949               GO TO 400
2950  380       CONTINUE
2951  390    CONTINUE
2952  400    CONTINUE
2953         IF (L .NE. M - 1) GO TO 410
2954            KASE = 4
2955         GO TO 480
2956  410    CONTINUE
2957            LP1 = L + 1
2958            MP1 = M + 1
2959            DO 430 LLS = LP1, MP1
2960               LS = M - LLS + LP1
2961C           ...EXIT
2962               IF (LS .EQ. L) GO TO 440
2963               TEST = 0.0D0
2964               IF (LS .NE. M) TEST = TEST + DABS(E(LS))
2965               IF (LS .NE. L + 1) TEST = TEST + DABS(E(LS-1))
2966               ZTEST = TEST + DABS(S(LS))
2967               IF (ZTEST .NE. TEST) GO TO 420
2968                  S(LS) = 0.0D0
2969C           ......EXIT
2970                  GO TO 440
2971  420          CONTINUE
2972  430       CONTINUE
2973  440       CONTINUE
2974            IF (LS .NE. L) GO TO 450
2975               KASE = 3
2976            GO TO 470
2977  450       CONTINUE
2978            IF (LS .NE. M) GO TO 460
2979               KASE = 1
2980            GO TO 470
2981  460       CONTINUE
2982               KASE = 2
2983               L = LS
2984  470       CONTINUE
2985  480    CONTINUE
2986         L = L + 1
2987C
2988C        PERFORM THE TASK INDICATED BY KASE.
2989C
2990         GO TO (490,520,540,570), KASE
2991C
2992C        DEFLATE NEGLIGIBLE S(M).
2993C
2994  490    CONTINUE
2995            MM1 = M - 1
2996            F = E(M-1)
2997            E(M-1) = 0.0D0
2998            DO 510 KK = L, MM1
2999               K = MM1 - KK + L
3000               T1 = S(K)
3001               CALL DROTG(T1,F,CS,SN)
3002               S(K) = T1
3003               IF (K .EQ. L) GO TO 500
3004                  F = -SN*E(K-1)
3005                  E(K-1) = CS*E(K-1)
3006  500          CONTINUE
3007               IF (WANTV) CALL DROT(P,V(1,K),1,V(1,M),1,CS,SN)
3008  510       CONTINUE
3009         GO TO 610
3010C
3011C        SPLIT AT NEGLIGIBLE S(L).
3012C
3013  520    CONTINUE
3014            F = E(L-1)
3015            E(L-1) = 0.0D0
3016            DO 530 K = L, M
3017               T1 = S(K)
3018               CALL DROTG(T1,F,CS,SN)
3019               S(K) = T1
3020               F = -SN*E(K)
3021               E(K) = CS*E(K)
3022               IF (WANTU) CALL DROT(N,U(1,K),1,U(1,L-1),1,CS,SN)
3023  530       CONTINUE
3024         GO TO 610
3025C
3026C        PERFORM ONE QR STEP.
3027C
3028  540    CONTINUE
3029C
3030C           CALCULATE THE SHIFT.
3031C
3032            SCALE = DMAX1(DABS(S(M)),DABS(S(M-1)),DABS(E(M-1)),
3033     *                    DABS(S(L)),DABS(E(L)))
3034            SM = S(M)/SCALE
3035            SMM1 = S(M-1)/SCALE
3036            EMM1 = E(M-1)/SCALE
3037            SL = S(L)/SCALE
3038            EL = E(L)/SCALE
3039            B = ((SMM1 + SM)*(SMM1 - SM) + EMM1**2)/2.0D0
3040            C = (SM*EMM1)**2
3041            SHIFT = 0.0D0
3042            IF (B .EQ. 0.0D0 .AND. C .EQ. 0.0D0) GO TO 550
3043               SHIFT = DSQRT(B**2+C)
3044               IF (B .LT. 0.0D0) SHIFT = -SHIFT
3045               SHIFT = C/(B + SHIFT)
3046  550       CONTINUE
3047            F = (SL + SM)*(SL - SM) + SHIFT
3048            G = SL*EL
3049C
3050C           CHASE ZEROS.
3051C
3052            MM1 = M - 1
3053            DO 560 K = L, MM1
3054               CALL DROTG(F,G,CS,SN)
3055               IF (K .NE. L) E(K-1) = F
3056               F = CS*S(K) + SN*E(K)
3057               E(K) = CS*E(K) - SN*S(K)
3058               G = SN*S(K+1)
3059               S(K+1) = CS*S(K+1)
3060               IF (WANTV) CALL DROT(P,V(1,K),1,V(1,K+1),1,CS,SN)
3061               CALL DROTG(F,G,CS,SN)
3062               S(K) = F
3063               F = CS*E(K) + SN*S(K+1)
3064               S(K+1) = -SN*E(K) + CS*S(K+1)
3065               G = SN*E(K+1)
3066               E(K+1) = CS*E(K+1)
3067               IF (WANTU .AND. K .LT. N)
3068     *            CALL DROT(N,U(1,K),1,U(1,K+1),1,CS,SN)
3069  560       CONTINUE
3070            E(M-1) = F
3071            ITER = ITER + 1
3072         GO TO 610
3073C
3074C        CONVERGENCE.
3075C
3076  570    CONTINUE
3077C
3078C           MAKE THE SINGULAR VALUE  POSITIVE.
3079C
3080            IF (S(L) .GE. 0.0D0) GO TO 580
3081               S(L) = -S(L)
3082               IF (WANTV) CALL DSCAL(P,-1.0D0,V(1,L),1)
3083  580       CONTINUE
3084C
3085C           ORDER THE SINGULAR VALUE.
3086C
3087  590       IF (L .EQ. MM) GO TO 600
3088C           ...EXIT
3089               IF (S(L) .GE. S(L+1)) GO TO 600
3090               T = S(L)
3091               S(L) = S(L+1)
3092               S(L+1) = T
3093               IF (WANTV .AND. L .LT. P)
3094     *            CALL DSWAP(P,V(1,L),1,V(1,L+1),1)
3095               IF (WANTU .AND. L .LT. N)
3096     *            CALL DSWAP(N,U(1,L),1,U(1,L+1),1)
3097               L = L + 1
3098            GO TO 590
3099  600       CONTINUE
3100            ITER = 0
3101            M = M - 1
3102  610    CONTINUE
3103      GO TO 360
3104  620 CONTINUE
3105      RETURN
3106      END
3107      SUBROUTINE DSWAP (N,DX,INCX,DY,INCY)
3108C
3109C     INTERCHANGES TWO VECTORS.
3110C     USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE.
3111C     JACK DONGARRA, LINPACK, 3/11/78.
3112C
3113      DOUBLE PRECISION DX(1),DY(1),DTEMP
3114      INTEGER I,INCX,INCY,IX,IY,M,MP1,N
3115C
3116      IF(N.LE.0)RETURN
3117      IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
3118C
3119C       CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL
3120C         TO 1
3121C
3122      IX = 1
3123      IY = 1
3124      IF(INCX.LT.0)IX = (-N+1)*INCX + 1
3125      IF(INCY.LT.0)IY = (-N+1)*INCY + 1
3126      DO 10 I = 1,N
3127        DTEMP = DX(IX)
3128        DX(IX) = DY(IY)
3129        DY(IY) = DTEMP
3130        IX = IX + INCX
3131        IY = IY + INCY
3132   10 CONTINUE
3133      RETURN
3134C
3135C       CODE FOR BOTH INCREMENTS EQUAL TO 1
3136C
3137C
3138C       CLEAN-UP LOOP
3139C
3140   20 M = MOD(N,3)
3141      IF( M .EQ. 0 ) GO TO 40
3142      DO 30 I = 1,M
3143        DTEMP = DX(I)
3144        DX(I) = DY(I)
3145        DY(I) = DTEMP
3146   30 CONTINUE
3147      IF( N .LT. 3 ) RETURN
3148   40 MP1 = M + 1
3149      DO 50 I = MP1,N,3
3150        DTEMP = DX(I)
3151        DX(I) = DY(I)
3152        DY(I) = DTEMP
3153        DTEMP = DX(I + 1)
3154        DX(I + 1) = DY(I + 1)
3155        DY(I + 1) = DTEMP
3156        DTEMP = DX(I + 2)
3157        DX(I + 2) = DY(I + 2)
3158        DY(I + 2) = DTEMP
3159   50 CONTINUE
3160      RETURN
3161      END
3162      SUBROUTINE DTRCO(T,LDT,N,RCOND,Z,JOB)
3163C***BEGIN PROLOGUE  DTRCO
3164C***DATE WRITTEN   780814   (YYMMDD)
3165C***REVISION DATE  820801   (YYMMDD)
3166C***REVISION HISTORY  (YYMMDD)
3167C   000330  Modified array declarations.  (JEC)
3168C***CATEGORY NO.  D2A3
3169C***KEYWORDS  CONDITION,DOUBLE PRECISION,FACTOR,LINEAR ALGEBRA,LINPACK,
3170C             MATRIX,TRIANGULAR
3171C***AUTHOR  MOLER, C. B., (U. OF NEW MEXICO)
3172C***PURPOSE  Estimates the condition of a double precision TRIANGULAR
3173C            matrix.
3174C***DESCRIPTION
3175C
3176C     DTRCO estimates the condition of a double precision triangular
3177C     matrix.
3178C
3179C     On Entry
3180C
3181C        T       DOUBLE PRECISION(LDT,N)
3182C                T contains the triangular matrix.  The zero
3183C                elements of the matrix are not referenced, and
3184C                the corresponding elements of the array can be
3185C                used to store other information.
3186C
3187C        LDT     INTEGER
3188C                LDT is the leading dimension of the array T.
3189C
3190C        N       INTEGER
3191C                N is the order of the system.
3192C
3193C        JOB     INTEGER
3194C                = 0         T  is lower triangular.
3195C                = nonzero   T  is upper triangular.
3196C
3197C     On Return
3198C
3199C        RCOND   DOUBLE PRECISION
3200C                an estimate of the reciprocal condition of  T .
3201C                For the system  T*X = B , relative perturbations
3202C                in  T  and  B  of size  EPSILON  may cause
3203C                relative perturbations in  X  of size  EPSILON/RCOND .
3204C                If  RCOND  is so small that the logical expression
3205C                           1.0 + RCOND .EQ. 1.0
3206C                is true, then  T  may be singular to working
3207C                precision.  In particular,  RCOND  is zero  if
3208C                exact singularity is detected or the estimate
3209C                underflows.
3210C
3211C        Z       DOUBLE PRECISION(N)
3212C                a work vector whose contents are usually unimportant.
3213C                If  T  is close to a singular matrix, then  Z  is
3214C                an approximate null vector in the sense that
3215C                NORM(A*Z) = RCOND*NORM(A)*NORM(Z) .
3216C
3217C     LINPACK.  This version dated 08/14/78 .
3218C     Cleve Moler, University of New Mexico, Argonne National Lab.
3219C
3220C     Subroutines and Functions
3221C
3222C     BLAS DAXPY,DSCAL,DASUM
3223C     Fortran DABS,DMAX1,DSIGN
3224C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
3225C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
3226C***ROUTINES CALLED  DASUM,DAXPY,DSCAL
3227C***END PROLOGUE  DTRCO
3228      INTEGER LDT,N,JOB
3229      DOUBLE PRECISION T(LDT,*),Z(*)
3230      DOUBLE PRECISION RCOND
3231C
3232      DOUBLE PRECISION W,WK,WKM,EK
3233      DOUBLE PRECISION TNORM,YNORM,S,SM,DASUM
3234      INTEGER I1,J,J1,J2,K,KK,L
3235      LOGICAL LOWER
3236C***FIRST EXECUTABLE STATEMENT  DTRCO
3237      LOWER = JOB .EQ. 0
3238C
3239C     COMPUTE 1-NORM OF T
3240C
3241      TNORM = 0.0D0
3242      DO 10 J = 1, N
3243         L = J
3244         IF (LOWER) L = N + 1 - J
3245         I1 = 1
3246         IF (LOWER) I1 = J
3247         TNORM = DMAX1(TNORM,DASUM(L,T(I1,J),1))
3248   10 CONTINUE
3249C
3250C     RCOND = 1/(NORM(T)*(ESTIMATE OF NORM(INVERSE(T)))) .
3251C     ESTIMATE = NORM(Z)/NORM(Y) WHERE  T*Z = Y  AND  TRANS(T)*Y = E .
3252C     TRANS(T)  IS THE TRANSPOSE OF T .
3253C     THE COMPONENTS OF  E  ARE CHOSEN TO CAUSE MAXIMUM LOCAL
3254C     GROWTH IN THE ELEMENTS OF Y .
3255C     THE VECTORS ARE FREQUENTLY RESCALED TO AVOID OVERFLOW.
3256C
3257C     SOLVE TRANS(T)*Y = E
3258C
3259      EK = 1.0D0
3260      DO 20 J = 1, N
3261         Z(J) = 0.0D0
3262   20 CONTINUE
3263      DO 100 KK = 1, N
3264         K = KK
3265         IF (LOWER) K = N + 1 - KK
3266         IF (Z(K) .NE. 0.0D0) EK = DSIGN(EK,-Z(K))
3267         IF (DABS(EK-Z(K)) .LE. DABS(T(K,K))) GO TO 30
3268            S = DABS(T(K,K))/DABS(EK-Z(K))
3269            CALL DSCAL(N,S,Z,1)
3270            EK = S*EK
3271   30    CONTINUE
3272         WK = EK - Z(K)
3273         WKM = -EK - Z(K)
3274         S = DABS(WK)
3275         SM = DABS(WKM)
3276         IF (T(K,K) .EQ. 0.0D0) GO TO 40
3277            WK = WK/T(K,K)
3278            WKM = WKM/T(K,K)
3279         GO TO 50
3280   40    CONTINUE
3281            WK = 1.0D0
3282            WKM = 1.0D0
3283   50    CONTINUE
3284         IF (KK .EQ. N) GO TO 90
3285            J1 = K + 1
3286            IF (LOWER) J1 = 1
3287            J2 = N
3288            IF (LOWER) J2 = K - 1
3289            DO 60 J = J1, J2
3290               SM = SM + DABS(Z(J)+WKM*T(K,J))
3291               Z(J) = Z(J) + WK*T(K,J)
3292               S = S + DABS(Z(J))
3293   60       CONTINUE
3294            IF (S .GE. SM) GO TO 80
3295               W = WKM - WK
3296               WK = WKM
3297               DO 70 J = J1, J2
3298                  Z(J) = Z(J) + W*T(K,J)
3299   70          CONTINUE
3300   80       CONTINUE
3301   90    CONTINUE
3302         Z(K) = WK
3303  100 CONTINUE
3304      S = 1.0D0/DASUM(N,Z,1)
3305      CALL DSCAL(N,S,Z,1)
3306C
3307      YNORM = 1.0D0
3308C
3309C     SOLVE T*Z = Y
3310C
3311      DO 130 KK = 1, N
3312         K = N + 1 - KK
3313         IF (LOWER) K = KK
3314         IF (DABS(Z(K)) .LE. DABS(T(K,K))) GO TO 110
3315            S = DABS(T(K,K))/DABS(Z(K))
3316            CALL DSCAL(N,S,Z,1)
3317            YNORM = S*YNORM
3318  110    CONTINUE
3319         IF (T(K,K) .NE. 0.0D0) Z(K) = Z(K)/T(K,K)
3320         IF (T(K,K) .EQ. 0.0D0) Z(K) = 1.0D0
3321         I1 = 1
3322         IF (LOWER) I1 = K + 1
3323         IF (KK .GE. N) GO TO 120
3324            W = -Z(K)
3325            CALL DAXPY(N-KK,W,T(I1,K),1,Z(I1),1)
3326  120    CONTINUE
3327  130 CONTINUE
3328C     MAKE ZNORM = 1.0
3329      S = 1.0D0/DASUM(N,Z,1)
3330      CALL DSCAL(N,S,Z,1)
3331      YNORM = S*YNORM
3332C
3333      IF (TNORM .NE. 0.0D0) RCOND = YNORM/TNORM
3334      IF (TNORM .EQ. 0.0D0) RCOND = 0.0D0
3335      RETURN
3336      END
3337      SUBROUTINE DTRSL(T,LDT,N,B,JOB,INFO)
3338C***BEGIN PROLOGUE  DTRSL
3339C***DATE WRITTEN   780814   (YYMMDD)
3340C***REVISION DATE  820801   (YYMMDD)
3341C***REVISION HISTORY  (YYMMDD)
3342C   000330  Modified array declarations.  (JEC)
3343C***CATEGORY NO.  D2A3
3344C***KEYWORDS  DOUBLE PRECISION,LINEAR ALGEBRA,LINPACK,MATRIX,SOLVE,
3345C             TRIANGULAR
3346C***AUTHOR  STEWART, G. W., (U. OF MARYLAND)
3347C***PURPOSE  Solves systems of the form  T*X=B or  TRANS(T)*X=B  where T
3348C            is a TRIANGULAR matrix of order N.
3349C***DESCRIPTION
3350C
3351C     DTRSL solves systems of the form
3352C
3353C                   T * X = B
3354C     or
3355C                   TRANS(T) * X = B
3356C
3357C     where T is a triangular matrix of order N.  Here TRANS(T)
3358C     denotes the transpose of the matrix T.
3359C
3360C     On Entry
3361C
3362C         T         DOUBLE PRECISION(LDT,N)
3363C                   T contains the matrix of the system.  The zero
3364C                   elements of the matrix are not referenced, and
3365C                   the corresponding elements of the array can be
3366C                   used to store other information.
3367C
3368C         LDT       INTEGER
3369C                   LDT is the leading dimension of the array T.
3370C
3371C         N         INTEGER
3372C                   N is the order of the system.
3373C
3374C         B         DOUBLE PRECISION(N).
3375C                   B contains the right hand side of the system.
3376C
3377C         JOB       INTEGER
3378C                   JOB specifies what kind of system is to be solved.
3379C                   If JOB is
3380C
3381C                        00   solve T*X=B, T lower triangular,
3382C                        01   solve T*X=B, T upper triangular,
3383C                        10   solve TRANS(T)*X=B, T lower triangular,
3384C                        11   solve TRANS(T)*X=B, T upper triangular.
3385C
3386C     On Return
3387C
3388C         B         B contains the solution, if INFO .EQ. 0.
3389C                   Otherwise B is unaltered.
3390C
3391C         INFO      INTEGER
3392C                   INFO contains zero if the system is nonsingular.
3393C                   Otherwise INFO contains the index of
3394C                   the first zero diagonal element of T.
3395C
3396C     LINPACK.  This version dated 08/14/78 .
3397C     G. W. Stewart, University of Maryland, Argonne National Lab.
3398C
3399C     Subroutines and Functions
3400C
3401C     BLAS DAXPY,DDOT
3402C     Fortran MOD
3403C***REFERENCES  DONGARRA J.J., BUNCH J.R., MOLER C.B., STEWART G.W.,
3404C                 *LINPACK USERS  GUIDE*, SIAM, 1979.
3405C***ROUTINES CALLED  DAXPY,DDOT
3406C***END PROLOGUE  DTRSL
3407      INTEGER LDT,N,JOB,INFO
3408      DOUBLE PRECISION T(LDT,*),B(*)
3409C
3410C
3411      DOUBLE PRECISION DDOT,TEMP
3412      INTEGER CASE,J,JJ
3413C
3414C     BEGIN BLOCK PERMITTING ...EXITS TO 150
3415C
3416C        CHECK FOR ZERO DIAGONAL ELEMENTS.
3417C
3418C***FIRST EXECUTABLE STATEMENT  DTRSL
3419         DO 10 INFO = 1, N
3420C     ......EXIT
3421            IF (T(INFO,INFO) .EQ. 0.0D0) GO TO 150
3422   10    CONTINUE
3423         INFO = 0
3424C
3425C        DETERMINE THE TASK AND GO TO IT.
3426C
3427         CASE = 1
3428         IF (MOD(JOB,10) .NE. 0) CASE = 2
3429         IF (MOD(JOB,100)/10 .NE. 0) CASE = CASE + 2
3430         GO TO (20,50,80,110), CASE
3431C
3432C        SOLVE T*X=B FOR T LOWER TRIANGULAR
3433C
3434   20    CONTINUE
3435            B(1) = B(1)/T(1,1)
3436            IF (N .LT. 2) GO TO 40
3437            DO 30 J = 2, N
3438               TEMP = -B(J-1)
3439               CALL DAXPY(N-J+1,TEMP,T(J,J-1),1,B(J),1)
3440               B(J) = B(J)/T(J,J)
3441   30       CONTINUE
3442   40       CONTINUE
3443         GO TO 140
3444C
3445C        SOLVE T*X=B FOR T UPPER TRIANGULAR.
3446C
3447   50    CONTINUE
3448            B(N) = B(N)/T(N,N)
3449            IF (N .LT. 2) GO TO 70
3450            DO 60 JJ = 2, N
3451               J = N - JJ + 1
3452               TEMP = -B(J+1)
3453               CALL DAXPY(J,TEMP,T(1,J+1),1,B(1),1)
3454               B(J) = B(J)/T(J,J)
3455   60       CONTINUE
3456   70       CONTINUE
3457         GO TO 140
3458C
3459C        SOLVE TRANS(T)*X=B FOR T LOWER TRIANGULAR.
3460C
3461   80    CONTINUE
3462            B(N) = B(N)/T(N,N)
3463            IF (N .LT. 2) GO TO 100
3464            DO 90 JJ = 2, N
3465               J = N - JJ + 1
3466               B(J) = B(J) - DDOT(JJ-1,T(J+1,J),1,B(J+1),1)
3467               B(J) = B(J)/T(J,J)
3468   90       CONTINUE
3469  100       CONTINUE
3470         GO TO 140
3471C
3472C        SOLVE TRANS(T)*X=B FOR T UPPER TRIANGULAR.
3473C
3474  110    CONTINUE
3475            B(1) = B(1)/T(1,1)
3476            IF (N .LT. 2) GO TO 130
3477            DO 120 J = 2, N
3478               B(J) = B(J) - DDOT(J-1,T(1,J),1,B(1),1)
3479               B(J) = B(J)/T(J,J)
3480  120       CONTINUE
3481  130       CONTINUE
3482  140    CONTINUE
3483  150 CONTINUE
3484      RETURN
3485      END
3486      REAL FUNCTION DUMFUN(X0)
3487C
3488C     PURPOSE--AUXILLARY FUNCTION FOR COMPUTING A USER-DEFINED
3489C              FUNCTION.  USED BY THE NUMERICAL DERIVATIVE ROUTINE
3490C              INITIALLY, BUT MAY BE APPLICABLE TO OTHER APPLICATIONS.
3491C              IT COMPUTES THE FUNCTION AT THE VALUE X0
3492C              AND RETURNS THE FUNCTION VALUE IN DUMFUN.
3493C     WRITTEN BY--ALAN HECKERT
3494C                 STATISTICAL ENGINEERING DIVISION
3495C                 INFORMATION TECHNOLOGY LABORATORY
3496C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3497C                 GAITHERSBURG, MD 20899-8980
3498C                 PHONE--301-975-2855
3499C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3500C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3501C     LANGUAGE--ANSI FORTRAN (1977)
3502C     VERSION NUMBER--2004/1
3503C     ORIGINAL VERSION--JANUARY   2004.
3504C     UPDATED         --SEPTEMBER 2015. SUPPORT FOR FUNCTION BLOCKS
3505C
3506C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3507C
3508      REAL X0
3509C
3510      CHARACTER*4 IH
3511      CHARACTER*4 IH2
3512C
3513      INCLUDE 'DPCOPA.INC'
3514      INCLUDE 'DPCOHK.INC'
3515      INCLUDE 'DPCODA.INC'
3516      INCLUDE 'DPCOFB.INC'
3517C
3518      COMMON/IFBL2/IFLGFB
3519C
3520      CHARACTER*8 IFBNAM
3521      CHARACTER*8 IFBANS
3522C
3523      CHARACTER*4 IFEESV
3524      COMMON/IFEED/IFEESV
3525C
3526      CHARACTER*4 ZMODEL
3527      CHARACTER*4 IPARN
3528      CHARACTER*4 IPARN2
3529      CHARACTER*4 IANGLU
3530      CHARACTER*4 ITYPEH
3531      CHARACTER*4 IW21HO
3532      CHARACTER*4 IW22HO
3533      CHARACTER*4 IVARN
3534      CHARACTER*4 IVARN2
3535      CHARACTER*4 IZNAME
3536      CHARACTER*4 IZNAM2
3537      CHARACTER*4 IBUGA3
3538      CHARACTER*4 IBUGCO
3539      CHARACTER*4 IBUGEV
3540      CHARACTER*4 IERROR
3541C
3542      CHARACTER*4 ISUBN1
3543      CHARACTER*4 ISUBN2
3544      CHARACTER*4 ISTEPN
3545      CHARACTER*4 IFTEXP
3546      CHARACTER*4 IFTORD
3547      CHARACTER*4 IFORSW
3548      CHARACTER*4 ISUBRO
3549      CHARACTER*4 IFOUND
3550C
3551C---------------------------------------------------------------------
3552C
3553      PARAMETER (IDUMCH=1000)
3554      PARAMETER (IDUMC2=100)
3555C
3556      DIMENSION PARAM(IDUMC2)
3557      DIMENSION IPARN(IDUMC2)
3558      DIMENSION IPARN2(IDUMC2)
3559      DIMENSION IVARN(IDUMC2)
3560      DIMENSION IVARN2(IDUMC2)
3561C
3562      DIMENSION ZMODEL(IDUMCH)
3563      DIMENSION ITYPEH(IDUMCH)
3564      DIMENSION IW21HO(IDUMCH)
3565      DIMENSION IW22HO(IDUMCH)
3566      DIMENSION W2HOLD(IDUMCH)
3567C
3568      DIMENSION ILOCV(IDUMC2)
3569C
3570      COMMON /DUMCMC/ IBUGA3, ITYPEH, IW21HO, IW22HO, IPARN, IPARN2,
3571     &                IVARN, IVARN2, ZMODEL, IZNAME, IZNAM2, IZNDEX
3572      COMMON /DUMCMR/ PARAM, W2HOLD,
3573     &                NUMCHA, NUMVAR, NWHOLD, NUMDV, ILOCV
3574C
3575C-----COMMON----------------------------------------------------------
3576C
3577      INCLUDE 'DPCOP2.INC'
3578C
3579C-----START POINT-----------------------------------------------------
3580C
3581      IERROR='OFF'
3582      IFOUND='NO'
3583      ISUBRO='NULL'
3584      IFTEXP='+'
3585      IFTORD='DATA'
3586      IFORSW='E'
3587C
3588      MAXCP1=MAXCOL+1
3589      MAXCP2=MAXCOL+2
3590      MAXCP3=MAXCOL+3
3591      MAXCP4=MAXCOL+4
3592      MAXCP5=MAXCOL+5
3593      MAXCP6=MAXCOL+6
3594C
3595      IF(IBUGA3.EQ.'ON')THEN
3596        WRITE(ICOUT,999)
3597  999   FORMAT(1X)
3598        CALL DPWRST('XXX','BUG ')
3599        WRITE(ICOUT,51)
3600   51   FORMAT('AT THE BEGINNING OF DUMFUN--')
3601        CALL DPWRST('XXX','BUG ')
3602        WRITE(ICOUT,52)IBUGA3
3603   52   FORMAT('IBUGA3 = ',A4)
3604        CALL DPWRST('XXX','BUG ')
3605        WRITE(ICOUT,53)NUMCHA,NUMDV,NUMVAR
3606   53   FORMAT('NUMCHA,NUMDV,NUMVAR = ',3I8)
3607        CALL DPWRST('XXX','BUG ')
3608        NMAX=NUMCHA
3609        IF(NMAX.GT.25)NMAX=25
3610        WRITE(ICOUT,54)(MODEL(J),J=1,NMAX)
3611   54   FORMAT('MODEL(I) = ',25A4)
3612        CALL DPWRST('XXX','BUG ')
3613        DO55I=1,NUMVAR
3614          WRITE(ICOUT,56)I,PARAM(I),IPARN(I),IPARN2(I)
3615   56     FORMAT('I,PARAM(I),IPARN(I),IPARN2(I) = ',I8,E15.7,A4,A4)
3616          CALL DPWRST('XXX','BUG ')
3617   55   CONTINUE
3618        DO59I=1,NUMDV
3619          WRITE(ICOUT,61)I,IVARN(I),IVARN2(I)
3620   61     FORMAT('I, IVARN(I),IVARN2(I) = ',I8,2X,A4,A4)
3621          CALL DPWRST('XXX','BUG ')
3622   59   CONTINUE
3623        WRITE(ICOUT,69)X0
3624   69   FORMAT('X0 = ',G15.7)
3625        CALL DPWRST('XXX','BUG ')
3626      ENDIF
3627C
3628C               ***************************
3629C               **  STEP 3--             **
3630C               **  INITIALIZE PARAMETERS**
3631C               ***************************
3632C
3633      ISTEPN='3'
3634      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3635C
3636      IPASS=2
3637      IBUGCO=IBUGA3
3638      IBUGEV=IBUGA3
3639      FX=0.0
3640C
3641      IFBNAM=' '
3642      IFBANS=' '
3643      IF(IFLGFB.EQ.1)THEN
3644        IFBNAM=IFBNA1
3645        IFBANS=IFBAN1
3646        IH=IFBPL1(1)(1:4)
3647        IH2=IFBPL1(1)(5:8)
3648      ELSEIF(IFLGFB.EQ.2)THEN
3649        IFBNAM=IFBNA2
3650        IFBANS=IFBAN2
3651        IH=IFBPL2(1)(1:4)
3652        IH2=IFBPL2(1)(5:8)
3653      ELSEIF(IFLGFB.EQ.3)THEN
3654        IFBNAM=IFBNA3
3655        IFBANS=IFBAN3
3656        IH=IFBPL3(1)(1:4)
3657        IH2=IFBPL3(1)(5:8)
3658      ENDIF
3659C
3660      IF(IFLGFB.LE.0)THEN
3661        PARAM(IZNDEX)=X0
3662        CALL COMPIM(ZMODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMVAR,
3663     1              IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,FX,
3664     1              IBUGCO,IBUGEV,IERROR)
3665      ELSE
3666C
3667C       FUNCTION BLOCK CASE:
3668C
3669C       STEP 1: COMPUTE FUNCTION BLOCK (BUT FIRST SET CURRENT
3670C               VALUE OF DESIRED PARAMETER)
3671C
3672        DO3305II=1,NUMNAM
3673          IF(IH.EQ.IHNAME(II) .AND. IH2.EQ.IHNAM2(II) .AND.
3674     1       IUSE(II).EQ.'P')THEN
3675            VALUE(II)=X0
3676            IVALUE(II)=INT(X0+0.5)
3677            GOTO3309
3678          ENDIF
3679 3305   CONTINUE
3680C
3681C       PARAMETER NAME NOT FOUND IN CURRENT LIST, SO NEED TO ADD
3682C       TO NAME LIST
3683C
3684        IF(NUMNAM.LT.MAXNAM)THEN
3685          NUMNAM=NUMNAM+1
3686          IHNAME(NUMNAM)=IH
3687          IHNAM2(NUMNAM)=IH2
3688          IUSE(NUMNAM)='P'
3689          VALUE(NUMNAM)=X0
3690          IVALUE(NUMNAM)=INT(X0 + 0.5)
3691        ELSE
3692          WRITE(ICOUT,999)
3693          CALL DPWRST('XXX','BUG ')
3694          WRITE(ICOUT,3306)
3695 3306     FORMAT('***** ERROR IN NUMERICAL DERIVATIVE--')
3696          CALL DPWRST('XXX','BUG ')
3697          WRITE(ICOUT,3307)
3698 3307     FORMAT('      MAXIMUM NUMBER OF NAMES EXCEEDED.')
3699          CALL DPWRST('XXX','BUG ')
3700        ENDIF
3701C
3702 3309   CONTINUE
3703C
3704        IFEEDB='OFF'
3705        CALL DPFBEX(IFBNAM,IANGLU,ISEED,IFTEXP,IFTORD,IFORSW,
3706     1              IBUGA3,IBUGA3,IBUGCO,IBUGEV,IBUGEV,
3707     1              ISUBRO,IFOUND,IERROR)
3708        IFEEDB=IFEESV
3709C
3710C       STEP 2: RETRIEVE RESPONSE
3711C
3712        DO3320II=1,NUMNAM
3713          IF(IFBANS(1:4).EQ.IHNAME(II) .AND.
3714     1       IFBANS(5:8).EQ.IHNAM2(II))THEN
3715            IF(IUSE(II).EQ.'P')THEN
3716              FX=VALUE(II)
3717              GOTO3329
3718            ELSEIF(IUSE(II).EQ.'V')THEN
3719              ICOLR=IVALUE(II)
3720              IJ=MAXN*(ICOLR-1)+1
3721              IF(ICOLR.LE.MAXCOL)FX=V(IJ)
3722              IF(ICOLR.EQ.MAXCP1)FX=PRED(1)
3723              IF(ICOLR.EQ.MAXCP2)FX=RES(1)
3724              IF(ICOLR.EQ.MAXCP3)FX=YPLOT(1)
3725              IF(ICOLR.EQ.MAXCP4)FX=XPLOT(1)
3726              IF(ICOLR.EQ.MAXCP5)FX=X2PLOT(1)
3727              IF(ICOLR.EQ.MAXCP6)FX=TAGPLO(1)
3728              GOTO3329
3729            ENDIF
3730          ENDIF
3731 3320   CONTINUE
3732C
3733C       PARAMETER/VARIABLE NAME NOT FOUND
3734C
3735        WRITE(ICOUT,3306)
3736        CALL DPWRST('XXX','BUG ')
3737        WRITE(ICOUT,3321)
3738 3321   FORMAT('      EXPECTED PARAMETER/VARIABLE NOT FOUND IN ',
3739     1         'NAME TABLE.')
3740        CALL DPWRST('XXX','BUG ')
3741        WRITE(ICOUT,3323)IFBANS
3742 3323   FORMAT('      EXPECTED NAME = ',A8)
3743        CALL DPWRST('XXX','BUG ')
3744C
3745 3329   CONTINUE
3746C
3747      ENDIF
3748C
3749      DUMFUN=FX
3750C
3751C               *****************
3752C               **  STEP 90--  **
3753C               **  EXIT       **
3754C               *****************
3755C
3756      IF(IBUGA3.EQ.'ON')THEN
3757        WRITE(ICOUT,9011)
3758 9011   FORMAT('***** AT THE END      OF DUMFUN--')
3759        CALL DPWRST('XXX','BUG ')
3760        WRITE(ICOUT,9021)FX,IERROR
3761 9021   FORMAT('FX,IERROR = ',G15.7,A4)
3762        CALL DPWRST('XXX','BUG ')
3763        DO9102KK=1,NUMDV
3764          WRITE(ICOUT,9103)KK,PARAM(KK)
3765 9103     FORMAT('I,PARAM(I) = ',I5,1X,G15.7)
3766          CALL DPWRST('XXX','BUG ')
3767 9102   CONTINUE
3768      ENDIF
3769C
3770      RETURN
3771      END
3772      SUBROUTINE DUNRAN(N,NPAR,ISEED,X)
3773C
3774C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
3775C              FROM THE DISCRETE UNIFORM DISTRIBUTION
3776C              WITH INTEGER 'NUMBER OF ITEMS' = NPAR
3777C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
3778C                                OF RANDOM NUMBERS TO BE
3779C                                GENERATED.
3780C                     --NPAR   = THE INTEGER VALUE
3781C                                OF THE 'NUMBER OF ITEMS' PARAMETER.
3782C                                NPAR SHOULD BE A POSITIVE INTEGER.
3783C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
3784C                                (OF DIMENSION AT LEAST N)
3785C                                INTO WHICH THE GENERATED
3786C                                RANDOM SAMPLE WILL BE PLACED.
3787C     OUTPUT--A RANDOM SAMPLE OF SIZE N
3788C             FROM THE DISCRETE UNIFORM DISTRIBUTION
3789C             WITH 'NUMBER OF ITEMS' PARAMETER = NPAR.
3790C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
3791C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
3792C                   OF N FOR THIS SUBROUTINE.
3793C                 --NPAR SHOULD BE A POSITIVE INTEGER.
3794C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
3795C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
3796C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
3797C     LANGUAGE--ANSI FORTRAN (1977)
3798C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
3799C              FROM THIS DISCRETE RANDOM NUMBER
3800C              GENERATOR MUST NECESSARILY BE A
3801C              SEQUENCE OF ***INTEGER*** VALUES,
3802C              THE OUTPUT VECTOR X IS SINGLE
3803C              PRECISION IN MODE.
3804C              X HAS BEEN SPECIFIED AS SINGLE
3805C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
3806C              CONVENTION THAT ALL OUTPUT VECTORS FROM ALL
3807C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
3808C              THIS CONVENTION IS BASED ON THE BELIEF THAT
3809C              1) A MIXTURE OF MODES (FLOATING POINT
3810C              VERSUS INTEGER) IS INCONSISTENT AND
3811C              AN UNNECESSARY COMPLICATION
3812C              IN A DATA ANALYSIS; AND
3813C              2) FLOATING POINT MACHINE ARITHMETIC
3814C              (AS OPPOSED TO INTEGER ARITHMETIC)
3815C              IS THE MORE NATURAL MODE FOR DOING
3816C              DATA ANALYSIS.
3817C     REFERENCE--JOHNSON AND KOTZ
3818C     WRITTEN BY--JAMES J. FILLIBEN
3819C                 STATISTICAL ENGINEERING DIVISION
3820C                 INFORMATION TECHNOLOGY LABORATORY
3821C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3822C                 GAITHERSBURG, MD 20899
3823C                 PHONE--301-975-2855
3824C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3825C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3826C     LANGUAGE--ANSI FORTRAN (1977)
3827C     VERSION NUMBER--89/1
3828C     ORIGINAL VERSION--DECEMBER  1988.
3829C     UPDATED         --JUNE      2005. ROUTINE WAS GENERATING RANDOM
3830C                                       NUMBERS FROM 1 TO N RATHER
3831C                                       THAN 0 TO N.  CORRECTED TO
3832C                                       GENERATE FROM 0 TO N.
3833C
3834C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3835C
3836C---------------------------------------------------------------------
3837C
3838      DIMENSION X(*)
3839C
3840C-----COMMON----------------------------------------------------------
3841C
3842      INCLUDE 'DPCOP2.INC'
3843C
3844C-----START POINT-----------------------------------------------------
3845C
3846C     CHECK THE INPUT ARGUMENTS FOR ERRORS
3847C
3848      IF(N.LT.1)THEN
3849        WRITE(ICOUT, 5)
3850    5   FORMAT('***** ERROR--THE REQUESTED NUMBER OF DISCRETE ',
3851     1         'UNIFORM RANDOM NUMBERS IS NON-POSITIVE *****')
3852        CALL DPWRST('XXX','BUG ')
3853        WRITE(ICOUT,47)N
3854   47   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
3855        CALL DPWRST('XXX','BUG ')
3856        GOTO9000
3857      ELSEIF(NPAR.LT.1)THEN
3858        WRITE(ICOUT,25)
3859   25   FORMAT('***** ERROR--THE SHAPE PARAMETER (N) FOR THE DISCRETE',
3860     1         'UNIFORM RANDOM NUMBERS IS NON-POSITIVE *****')
3861        CALL DPWRST('XXX','BUG ')
3862        WRITE(ICOUT,47)NPAR
3863        CALL DPWRST('XXX','BUG ')
3864        GOTO9000
3865      ENDIF
3866C
3867C     GENERATE N UNIFORM (0,1) (CONTINOUS) RANDOM NUMBERS;
3868C
3869      CALL UNIRAN(N,ISEED,X)
3870C
3871C     CONVERT THE N CONTINUOUS UNIFORM RANDOM NUMBERS OVER [0,1]
3872C     TO N DISCRETE UNIFORM RANDOM NUMBERS OVER [0,NPAR]
3873C
3874CCCCC JUNE 2005. GENERATE OVER [0,NPAR] RATHER THAN [1,NPAR].  USE
3875CCCCC CURRENT ALGORITHM FOR [1,NPAR+1] THEN SUBTRACT 1.
3876C
3877      NPART=NPAR+1
3878      ANPAR=NPART
3879      DO1100I=1,N
3880        U=X(I)
3881        PROD=ANPAR*U
3882        IPROD=INT(PROD)
3883        IPROD=IPROD+1
3884        IF(IPROD.LT.1)IPROD=1
3885        IF(IPROD.GT.NPART)IPROD=NPART
3886        X(I)=IPROD - 1
3887 1100 CONTINUE
3888C
3889 9000 CONTINUE
3890      RETURN
3891      END
3892      SUBROUTINE DUNRA2(N,NPAR,ISEED,X)
3893C
3894C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
3895C              FROM THE DISCRETE UNIFORM DISTRIBUTION
3896C              WITH INTEGER 'NUMBER OF ITEMS' = NPAR
3897C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
3898C                                OF RANDOM NUMBERS TO BE
3899C                                GENERATED.
3900C                     --NPAR   = THE INTEGER VALUE
3901C                                OF THE 'NUMBER OF ITEMS' PARAMETER.
3902C                                NPAR SHOULD BE A POSITIVE INTEGER.
3903C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
3904C                                (OF DIMENSION AT LEAST N)
3905C                                INTO WHICH THE GENERATED
3906C                                RANDOM SAMPLE WILL BE PLACED.
3907C     OUTPUT--A RANDOM SAMPLE OF SIZE N
3908C             FROM THE DISCRETE UNIFORM DISTRIBUTION
3909C             WITH 'NUMBER OF ITEMS' PARAMETER = NPAR.
3910C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
3911C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
3912C                   OF N FOR THIS SUBROUTINE.
3913C                 --NPAR SHOULD BE A POSITIVE INTEGER.
3914C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
3915C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
3916C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
3917C     LANGUAGE--ANSI FORTRAN (1977)
3918C     COMMENT--NOTE THAT EVEN THOUGH THE OUTPUT
3919C              FROM THIS DISCRETE RANDOM NUMBER
3920C              GENERATOR MUST NECESSARILY BE A
3921C              SEQUENCE OF ***INTEGER*** VALUES,
3922C              THE OUTPUT VECTOR X IS SINGLE
3923C              PRECISION IN MODE.
3924C              X HAS BEEN SPECIFIED AS SINGLE
3925C              PRECISION SO AS TO CONFORM WITH THE DATAPAC
3926C              CONVENTION THAT ALL OUTPUT VECTORS FROM ALL
3927C              DATAPAC SUBROUTINES ARE SINGLE PRECISION.
3928C              THIS CONVENTION IS BASED ON THE BELIEF THAT
3929C              1) A MIXTURE OF MODES (FLOATING POINT
3930C              VERSUS INTEGER) IS INCONSISTENT AND
3931C              AN UNNECESSARY COMPLICATION
3932C              IN A DATA ANALYSIS; AND
3933C              2) FLOATING POINT MACHINE ARITHMETIC
3934C              (AS OPPOSED TO INTEGER ARITHMETIC)
3935C              IS THE MORE NATURAL MODE FOR DOING
3936C              DATA ANALYSIS.
3937C     REFERENCE--JOHNSON AND KOTZ
3938C     WRITTEN BY--JAMES J. FILLIBEN
3939C                 STATISTICAL ENGINEERING DIVISION
3940C                 INFORMATION TECHNOLOGY LABORATORY
3941C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3942C                 GAITHERSBURG, MD 20899
3943C                 PHONE--301-975-2855
3944C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3945C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3946C     LANGUAGE--ANSI FORTRAN (1977)
3947C     VERSION NUMBER--89/1
3948C     ORIGINAL VERSION--DECEMBER  1988.
3949C     UPDATED         --JUNE      2005. ROUTINE WAS GENERATING RANDOM
3950C                                       NUMBERS FROM 1 TO N RATHER
3951C                                       THAN 0 TO N.  CORRECTED TO
3952C                                       GENERATE FROM 0 TO N.
3953C     UPDATED         --AUGUST    2005. THIS IS A COPY OF THE ORIGINAL
3954C                                       DUNRAN THAT GOES FROM 1 TO N.
3955C                                       THIS VERSION OF ROUTINE USED
3956C                                       BY BOOTSTRAP COMMAND.
3957C
3958C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3959C
3960C---------------------------------------------------------------------
3961C
3962      DIMENSION X(*)
3963C
3964C-----COMMON----------------------------------------------------------
3965C
3966      INCLUDE 'DPCOP2.INC'
3967C
3968C-----START POINT-----------------------------------------------------
3969C
3970C     CHECK THE INPUT ARGUMENTS FOR ERRORS
3971C
3972      IF(N.LT.1)THEN
3973        WRITE(ICOUT, 5)
3974    5   FORMAT('***** ERROR--THE REQUESTED NUMBER OF DISCRETE ',
3975     1         'UNIFORM RANDOM NUMBERS IS NON-POSITIVE *****')
3976        CALL DPWRST('XXX','BUG ')
3977        WRITE(ICOUT,47)N
3978   47   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
3979        CALL DPWRST('XXX','BUG ')
3980        GOTO9000
3981      ELSEIF(NPAR.LT.1)THEN
3982        WRITE(ICOUT,25)
3983   25   FORMAT('***** ERROR--THE SHAPE PARAMETER (N) FOR THE DISCRETE',
3984     1         'UNIFORM RANDOM NUMBERS IS NON-POSITIVE *****')
3985        CALL DPWRST('XXX','BUG ')
3986        WRITE(ICOUT,47)NPAR
3987        CALL DPWRST('XXX','BUG ')
3988        GOTO9000
3989      ENDIF
3990C
3991C     GENERATE N UNIFORM (0,1) (CONTINOUS) RANDOM NUMBERS;
3992C
3993      CALL UNIRAN(N,ISEED,X)
3994C
3995C     CONVERT THE N CONTINUOUS UNIFORM RANDOM NUMBERS OVER [0,1]
3996C     TO N DISCRETE UNIFORM RANDOM NUMBERS OVER [1,NPAR]
3997C
3998      ANPAR=NPAR
3999      DO1100I=1,N
4000      U=X(I)
4001      PROD=ANPAR*U
4002      IPROD=INT(PROD)
4003      IPROD=IPROD+1
4004      IF(IPROD.LT.1)IPROD=1
4005      IF(IPROD.GT.NPAR)IPROD=NPAR
4006      X(I)=IPROD
4007 1100 CONTINUE
4008C
4009 9000 CONTINUE
4010      RETURN
4011      END
4012      SUBROUTINE DVLA(VA,X,PD)
4013C
4014C       ====================================================
4015C       Purpose: Compute parabolic cylinder functions Dv(x)
4016C                for large argument
4017C       Input:   x  --- Argument
4018C                va --- Order
4019C       Output:  PD --- Dv(x)
4020C       Routines called:
4021C             (1) VVLA for computing Vv(x) for large |x|
4022C             (2) GAMMA for computing �(x)
4023C                 SUBSTITUTE CMLIB DGAMMA FUNCTION
4024C       ====================================================
4025C
4026        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
4027        PI=3.141592653589793D0
4028        EPS=1.0D-12
4029        EP=DEXP(-.25*X*X)
4030        A0=DABS(X)**VA*EP
4031        R=1.0D0
4032        PD=1.0D0
4033        DO 10 K=1,16
4034           R=-0.5D0*R*(2.0*K-VA-1.0)*(2.0*K-VA-2.0)/(K*X*X)
4035           PD=PD+R
4036           IF (DABS(R/PD).LT.EPS) GO TO 15
403710      CONTINUE
403815      PD=A0*PD
4039        IF (X.LT.0.0D0) THEN
4040            X1=-X
4041            CALL VVLA(VA,X1,VL)
4042CCCCC       CALL GAMMA(-VA,GL)
4043            GL=DGAMMA(-VA)
4044            PD=PI*VL/GL+DCOS(PI*VA)*PD
4045        ENDIF
4046        RETURN
4047        END
4048      SUBROUTINE DVSA(VA,X,PD)
4049C
4050C       ===================================================
4051C       Purpose: Compute parabolic cylinder function Dv(x)
4052C                for small argument
4053C       Input:   x  --- Argument
4054C                va --- Order
4055C       Output:  PD --- Dv(x)
4056C       Routine called: GAMMA for computing �(x)
4057C                SUBSTITUTE CMLIB DGAMMA FUNCTION
4058C       ===================================================
4059C
4060        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
4061        EPS=1.0D-15
4062        PI=3.141592653589793D0
4063        SQ2=DSQRT(2.0D0)
4064        EP=DEXP(-.25D0*X*X)
4065        VA0=0.5D0*(1.0D0-VA)
4066        IF (VA.EQ.0.0) THEN
4067           PD=EP
4068        ELSE
4069           IF (X.EQ.0.0) THEN
4070              IF (VA0.LE.0.0.AND.VA0.EQ.INT(VA0)) THEN
4071                 PD=0.0D0
4072              ELSE
4073CCCCC            CALL GAMMA(VA0,GA0)
4074                 GA0=DGAMMA(VA0)
4075                 PD=DSQRT(PI)/(2.0D0**(-.5D0*VA)*GA0)
4076              ENDIF
4077           ELSE
4078CCCCC         CALL GAMMA(-VA,G1)
4079              G1=DGAMMA(-VA)
4080              A0=2.0D0**(-0.5D0*VA-1.0D0)*EP/G1
4081              VT=-.5D0*VA
4082CCCCC         CALL GAMMA(VT,G0)
4083              G0=DGAMMA(VT)
4084              PD=G0
4085              R=1.0D0
4086              DO 10 M=1,250
4087                 VM=.5D0*(M-VA)
4088CCCCC            CALL GAMMA(VM,GM)
4089                 GM=DGAMMA(VM)
4090                 R=-R*SQ2*X/M
4091                 R1=GM*R
4092                 PD=PD+R1
4093                 IF (DABS(R1).LT.DABS(PD)*EPS) GO TO 15
409410            CONTINUE
409515            PD=A0*PD
4096           ENDIF
4097        ENDIF
4098        RETURN
4099        END
4100      SUBROUTINE DWECDF(X,GAMMA,CDF)
4101C
4102C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
4103C              FUNCTION VALUE FOR THE DOUBLE WEIBULL
4104C              DISTRIBUTION WITH SINGLE PRECISION
4105C              TAIL LENGTH PARAMETER = GAMMA.
4106C              THE DOUBLE WEIBULL DISTRIBUTION USED
4107C              HEREIN IS DEFINED FOR ALL REAL X,
4108C              AND HAS THE PROBABILITY DENSITY FUNCTION
4109C                 F(X) = (C/2)*X*EXP(-ABS(X)**C)
4110C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
4111C                                WHICH THE PROBABILITY DENSITY
4112C                                FUNCTION IS TO BE EVALUATED.
4113C                     --GAMMA  = THE SHAPE PARAMETER
4114C                                GAMMA SHOULD BE POSITIVE.
4115C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION PROBABILITY
4116C                                DENSITY FUNCTION VALUE.
4117C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
4118C             FUNCTION VALUE CDF FOR THE DOUBLE WEIBULL DISTRIBUTION
4119C             WITH TAIL LENGHT PARAMETER = GAMMA.
4120C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
4121C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
4122C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
4123C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
4124C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
4125C     LANGUAGE--ANSI FORTRAN (1977)
4126C     REFERENCE --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
4127C                 DISTRIBUTIONS--2, 1994, CHAPTER 21
4128C     WRITTEN BY--ALAN HECKERT
4129C                 STATISTICAL ENGINEERING DIVISION
4130C                 INFORMATION TECHNOLOGY LABORATORY
4131C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4132C                 GAITHERSBURG, MD 20899
4133C                 PHONE--301-975-2899
4134C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4135C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4136C     LANGUAGE--ANSI FORTRAN (1966)
4137C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
4138C                          DENOTED BY QUOTES RATHER THAN NH.
4139C     VERSION NUMBER--95/10
4140C     ORIGINAL VERSION--OCTOBER   1995.
4141C
4142C-----COMMON----------------------------------------------------------
4143C
4144      INCLUDE 'DPCOP2.INC'
4145C
4146C-----START POINT-----------------------------------------------------
4147C
4148C     CHECK THE INPUT ARGUMENTS FOR ERRORS
4149C
4150      CDF=0.0
4151      IF(GAMMA.LE.0)THEN
4152        WRITE(ICOUT,15)
4153   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO DWECDF IS ',
4154     1         'NON-POSITIVE')
4155        CALL DPWRST('XXX','BUG ')
4156        WRITE(ICOUT,46)GAMMA
4157   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
4158        CALL DPWRST('XXX','BUG ')
4159        GOTO9000
4160      ENDIF
4161C
4162CCCCC THE FOLLOWING SECTION WAS REWRITTEN      JANUARY 1994
4163      MINMAX=1
4164      IF(X.EQ.0.0)THEN
4165        CDF=0.5
4166      ELSEIF(X.GT.0.0)THEN
4167        CALL WEICDF(X,GAMMA,MINMAX,CDF2)
4168        CDF=0.5+CDF2/2.0
4169      ELSE
4170        ARG1=-X
4171        CALL WEICDF(ARG1,GAMMA,MINMAX,CDF2)
4172        CDF=0.5-CDF2/2.0
4173      ENDIF
4174C
4175 9000 CONTINUE
4176      RETURN
4177      END
4178      SUBROUTINE DWEPDF(X,GAMMA,PDF)
4179C
4180C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
4181C              FUNCTION VALUE FOR THE DOUBLE WEIBULL
4182C              DISTRIBUTION WITH SINGLE PRECISION
4183C              TAIL LENGTH PARAMETER = GAMMA.
4184C              THE DOUBLE WEIBULL DISTRIBUTION USED
4185C              HEREIN IS DEFINED FOR ALL REAL X,
4186C              AND HAS THE PROBABILITY DENSITY FUNCTION
4187C                 F(X) = (C/2)*X*EXP(-ABS(X)**C)
4188C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
4189C                                WHICH THE PROBABILITY DENSITY
4190C                                FUNCTION IS TO BE EVALUATED.
4191C                     --GAMMA  = THE SHAPE PARAMETER
4192C                                GAMMA SHOULD BE POSITIVE.
4193C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
4194C                                DENSITY FUNCTION VALUE.
4195C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
4196C             FUNCTION VALUE PDF FOR THE DOUBLE WEIBULL DISTRIBUTION
4197C             WITH TAIL LENGHT PARAMETER = GAMMA.
4198C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
4199C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
4200C     OTHER DATAPAC   SUBROUTINES NEEDED--WEIPDF.
4201C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
4202C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
4203C     LANGUAGE--ANSI FORTRAN (1977)
4204C     REFERENCE --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
4205C                 DISTRIBUTIONS--2, 1994, CHAPTER 21
4206C     WRITTEN BY--ALAN HECKERT
4207C                 STATISTICAL ENGINEERING DIVISION
4208C                 INFORMATION TECHNOLOGY LABORATORY
4209C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4210C                 GAITHERSBURG, MD 20899
4211C                 PHONE--301-975-2899
4212C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4213C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4214C     LANGUAGE--ANSI FORTRAN (1977)
4215C     VERSION NUMBER--95/10
4216C     ORIGINAL VERSION--OCTOBER   1995.
4217C
4218C-----COMMON----------------------------------------------------------
4219C
4220      INCLUDE 'DPCOP2.INC'
4221C
4222C-----START POINT-----------------------------------------------------
4223C
4224C     CHECK THE INPUT ARGUMENTS FOR ERRORS
4225C
4226      PDF=0.0
4227      IF(GAMMA.LE.0)THEN
4228        WRITE(ICOUT,15)
4229   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO DWEPDF IS ',
4230     1         'NON-POSITIVE')
4231        CALL DPWRST('XXX','BUG ')
4232        WRITE(ICOUT,46)GAMMA
4233   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
4234        CALL DPWRST('XXX','BUG ')
4235        GOTO9000
4236      ENDIF
4237C
4238CCCCC THE FOLLOWING SECTION WAS REWRITTEN      JANUARY 1994
4239      MINMAX=1
4240      ARG1=ABS(X)
4241      CALL WEIPDF(ARG1,GAMMA,MINMAX,PDF2)
4242      PDF=PDF2/2.0
4243C
4244 9000 CONTINUE
4245      RETURN
4246      END
4247      SUBROUTINE DWEPPF(P,GAMMA,PPF)
4248C
4249C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
4250C              FUNCTION VALUE FOR THE DOUBLE WEIBULL
4251C              DISTRIBUTION WITH SINGLE PRECISION
4252C              TAIL LENGTH PARAMETER = GAMMA.
4253C              THE DOUBLE WEIBULL DISTRIBUTION USED
4254C              HEREIN IS DEFINED FOR ALL REAL X,
4255C              AND HAS THE PROBABILITY DENSITY FUNCTION
4256C                 F(X) = (C/2)*X*EXP(-ABS(X)**C)
4257C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
4258C                                (BETWEEN 0.0 (INCLUSIVELY)
4259C                                AND 1.0 (EXCLUSIVELY))
4260C                                AT WHICH THE PERCENT POINT
4261C                                FUNCTION IS TO BE EVALUATED.
4262C                     --GAMMA  = THE SINGLE PRECISION VALUE
4263C                                OF THE TAIL LENGTH PARAMETER.
4264C                                GAMMA SHOULD BE POSITIVE.
4265C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
4266C                                POINT FUNCTION VALUE.
4267C     OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION .
4268C             VALUE PPF FOR THE WEIBULL DISTRIBUTION
4269C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
4270C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
4271C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
4272C                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
4273C                   AND 1.0 (EXCLUSIVELY).
4274C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
4275C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG.
4276C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
4277C     LANGUAGE--ANSI FORTRAN (1977)
4278C     REFERENCE --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
4279C                 DISTRIBUTIONS--2, 1994, CHAPTER 21
4280C     WRITTEN BY--ALAN HECKERT
4281C                 STATISTICAL ENGINEERING DIVISION
4282C                 INFORMATION TECHNOLOGY LABORATORY
4283C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4284C                 GAITHERSBURG, MD 20899
4285C                 PHONE--301-975-2899
4286C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4287C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4288C     LANGUAGE--ANSI FORTRAN (1977)
4289C     VERSION NUMBER--95/10
4290C     ORIGINAL VERSION--OCTOBER   1995.
4291C
4292C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4293C
4294C-----COMMON----------------------------------------------------------
4295C
4296      INCLUDE 'DPCOP2.INC'
4297C
4298C-----START POINT-----------------------------------------------------
4299C
4300C     CHECK THE INPUT ARGUMENTS FOR ERRORS
4301C
4302      PPF=0.0
4303      IF(P.LE.0.0.OR.P.GE.1.0)THEN
4304        WRITE(ICOUT,1)
4305        CALL DPWRST('XXX','BUG ')
4306        WRITE(ICOUT,46)P
4307        CALL DPWRST('XXX','BUG ')
4308        GOTO9000
4309      ELSEIF(GAMMA.LE.0.0)THEN
4310        WRITE(ICOUT,15)
4311        CALL DPWRST('XXX','BUG ')
4312        WRITE(ICOUT,46)GAMMA
4313        CALL DPWRST('XXX','BUG ')
4314        GOTO9000
4315      ENDIF
4316    1 FORMAT('***** ERROR--THE FIRST ARGUMENT TO DWEPPF IS ',
4317     1       'OUTSIDE THE ALLOWABLE (0,1) INTERVAL')
4318   15 FORMAT('***** ERROR--THE SECOND ARGUMENT TO DWEPPF IS ',
4319     1       'NON-POSITIVE')
4320   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
4321C
4322      MINMAX=1
4323      IF(P.EQ.0.5)THEN
4324        PPF=0.0
4325      ELSEIF(P.LT.0.5)THEN
4326        ARG1=2.0*(0.5-P)
4327        CALL WEIPPF(ARG1,GAMMA,MINMAX,PPF)
4328        PPF=-PPF
4329      ELSE
4330        ARG1=2.0*(P-0.5)
4331        CALL WEIPPF(ARG1,GAMMA,MINMAX,PPF)
4332      ENDIF
4333C
4334 9000 CONTINUE
4335      RETURN
4336      END
4337      SUBROUTINE DWERAN(N,GAMMA,ISEED,X)
4338C
4339C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
4340C              FROM THE DOUBLE WEIBULL DISTRIBUTION
4341C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
4342C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
4343C                                OF RANDOM NUMBERS TO BE
4344C                                GENERATED.
4345C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
4346C                                TAIL LENGTH PARAMETER.
4347C                                GAMMA SHOULD BE POSITIVE.
4348C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
4349C                                (OF DIMENSION AT LEAST N)
4350C                                INTO WHICH THE GENERATED
4351C                                RANDOM SAMPLE WILL BE PLACED.
4352C     OUTPUT--A RANDOM SAMPLE OF SIZE N
4353C             FROM THE DOUBLE WEIBULL DISTRIBUTION
4354C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
4355C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
4356C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
4357C                   OF N FOR THIS SUBROUTINE.
4358C                 --GAMMA SHOULD BE POSITIVE.
4359C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
4360C     FORTRAN LIBRARY SUBROUTINES NEEDED--NON E.
4361C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
4362C     LANGUAGE--ANSI FORTRAN (1977)
4363C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
4364C                 DISTRIBUTIONS--1, 2ND. ED., 1994.
4365C     WRITTEN BY--ALAN HECKERT
4366C                 STATISTICAL ENGINEERING DIVISION
4367C                 INFORMATION TECHNOLOGY LABORATORY
4368C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4369C                 GAITHERSBURG, MD 20899
4370C                 PHONE--301-975-2899
4371C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4372C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4373C     LANGUAGE--ANSI FORTRAN (1966)
4374C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
4375C                          DENOTED BY QUOTES RATHER THAN NH.
4376C     VERSION NUMBER--2001.9
4377C     ORIGINAL VERSION--SEPTEMBER 2001.
4378C
4379C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4380C
4381C---------------------------------------------------------------------
4382C
4383      DIMENSION X(*)
4384C
4385C-----COMMON----------------------------------------------------------
4386C
4387      INCLUDE 'DPCOP2.INC'
4388C
4389C-----START POINT-----------------------------------------------------
4390C
4391C     CHECK THE INPUT ARGUMENTS FOR ERRORS
4392C
4393      IF(N.LT.1)THEN
4394        WRITE(ICOUT, 5)
4395        CALL DPWRST('XXX','BUG ')
4396        WRITE(ICOUT,47)N
4397        CALL DPWRST('XXX','BUG ')
4398        GOTO9000
4399      ELSEIF(GAMMA.LE.0.0)THEN
4400        WRITE(ICOUT,15)
4401        CALL DPWRST('XXX','BUG ')
4402        WRITE(ICOUT,46)GAMMA
4403        CALL DPWRST('XXX','BUG ')
4404        GOTO9000
4405      ENDIF
4406    5 FORMAT('***** ERROR--THE REQUESTED NUMBER OF DOUBLE WEIBULL ',
4407     1       'RANDOM NUMBERS IS NON-POSITIVE')
4408   15 FORMAT('***** ERROR--THE SPECIFIED VALUE OF GAMMA FOR THE ',
4409     1       'DOUBLE WEIBULL RANDOM NUMBERS IS NON-POSITIVE')
4410   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
4411   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
4412C
4413C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
4414C
4415      CALL UNIRAN(N,ISEED,X)
4416C
4417C     GENERATE N DOUBLE WEIBULL DISTRIBUTION RANDOM NUMBERS
4418C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
4419C
4420      DO100I=1,N
4421        CALL DWEPPF(X(I),GAMMA,XTEMP)
4422        X(I)=XTEMP
4423  100 CONTINUE
4424C
4425 9000 CONTINUE
4426      RETURN
4427      END
4428      SUBROUTINE DXADD (X, IX, Y, IY, Z, IZ, IERROR)
4429C***BEGIN PROLOGUE  DXADD
4430C***PURPOSE  To provide double-precision floating-point arithmetic
4431C            with an extended exponent range.
4432C***LIBRARY   SLATEC
4433C***CATEGORY  A3D
4434C***TYPE      DOUBLE PRECISION (XADD-S, DXADD-D)
4435C***KEYWORDS  EXTENDED-RANGE DOUBLE-PRECISION ARITHMETIC
4436C***AUTHOR  Lozier, Daniel W., (NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY)
4437C           Smith, John M., (NBS and George Mason University)
4438C***DESCRIPTION
4439C     DOUBLE PRECISION X, Y, Z
4440C     INTEGER IX, IY, IZ
4441C
4442C                  FORMS THE EXTENDED-RANGE SUM  (Z,IZ) =
4443C                  (X,IX) + (Y,IY).  (Z,IZ) IS ADJUSTED
4444C                  BEFORE RETURNING. THE INPUT OPERANDS
4445C                  NEED NOT BE IN ADJUSTED FORM, BUT THEIR
4446C                  PRINCIPAL PARTS MUST SATISFY
4447C                  RADIX**(-2L).LE.ABS(X).LE.RADIX**(2L),
4448C                  RADIX**(-2L).LE.ABS(Y).LE.RADIX**(2L).
4449C
4450C***SEE ALSO  DXSET
4451C***REFERENCES  (NONE)
4452C***ROUTINES CALLED  DXADJ
4453C***COMMON BLOCKS    DXBLK2
4454C***REVISION HISTORY  (YYMMDD)
4455C   820712  DATE WRITTEN
4456C   881020  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
4457C   901019  Revisions to prologue.  (DWL and WRB)
4458C   901106  Changed all specific intrinsics to generic.  (WRB)
4459C           Corrected order of sections in prologue and added TYPE
4460C           section.  (WRB)
4461C   920127  Revised PURPOSE section of prologue.  (DWL)
4462C***END PROLOGUE  DXADD
4463      DOUBLE PRECISION X, Y, Z
4464      INTEGER IX, IY, IZ
4465      DOUBLE PRECISION RADIX, RADIXL, RAD2L, DLG10R
4466      INTEGER L, L2, KMAX
4467      COMMON /DXBLK2/ RADIX, RADIXL, RAD2L, DLG10R, L, L2, KMAX
4468      SAVE /DXBLK2/
4469      DOUBLE PRECISION S, T
4470C
4471C   THE CONDITIONS IMPOSED ON L AND KMAX BY THIS SUBROUTINE
4472C ARE
4473C     (1) 1 .LT. L .LE. 0.5D0*LOGR(0.5D0*DZERO)
4474C
4475C     (2) NRADPL .LT. L .LE. KMAX/6
4476C
4477C     (3) KMAX .LE. (2**NBITS - 4*L - 1)/2
4478C
4479C THESE CONDITIONS MUST BE MET BY APPROPRIATE CODING
4480C IN SUBROUTINE DXSET.
4481C
4482C***FIRST EXECUTABLE STATEMENT  DXADD
4483      IERROR=0
4484      IF (X.NE.0.0D0) GO TO 10
4485      Z = Y
4486      IZ = IY
4487      GO TO 220
4488   10 IF (Y.NE.0.0D0) GO TO 20
4489      Z = X
4490      IZ = IX
4491      GO TO 220
4492   20 CONTINUE
4493      IF (IX.GE.0 .AND. IY.GE.0) GO TO 40
4494      IF (IX.LT.0 .AND. IY.LT.0) GO TO 40
4495      IF (ABS(IX).LE.6*L .AND. ABS(IY).LE.6*L) GO TO 40
4496      IF (IX.GE.0) GO TO 30
4497      Z = Y
4498      IZ = IY
4499      GO TO 220
4500   30 CONTINUE
4501      Z = X
4502      IZ = IX
4503      GO TO 220
4504   40 I = IX - IY
4505CCCCC IF (I) 80, 50, 90
4506      IF(I.LT.0)GOTO80
4507      IF(I.GT.0)GOTO90
4508      IF (ABS(X).GT.1.0D0 .AND. ABS(Y).GT.1.0D0) GO TO 60
4509      IF (ABS(X).LT.1.0D0 .AND. ABS(Y).LT.1.0D0) GO TO 70
4510      Z = X + Y
4511      IZ = IX
4512      GO TO 220
4513   60 S = X/RADIXL
4514      T = Y/RADIXL
4515      Z = S + T
4516      IZ = IX + L
4517      GO TO 220
4518   70 S = X*RADIXL
4519      T = Y*RADIXL
4520      Z = S + T
4521      IZ = IX - L
4522      GO TO 220
4523   80 S = Y
4524      IS = IY
4525      T = X
4526      GO TO 100
4527   90 S = X
4528      IS = IX
4529      T = Y
4530  100 CONTINUE
4531C
4532C  AT THIS POINT, THE ONE OF (X,IX) OR (Y,IY) THAT HAS THE
4533C LARGER AUXILIARY INDEX IS STORED IN (S,IS). THE PRINCIPAL
4534C PART OF THE OTHER INPUT IS STORED IN T.
4535C
4536      I1 = ABS(I)/L
4537      I2 = MOD(ABS(I),L)
4538      IF (ABS(T).GE.RADIXL) GO TO 130
4539      IF (ABS(T).GE.1.0D0) GO TO 120
4540      IF (RADIXL*ABS(T).GE.1.0D0) GO TO 110
4541      J = I1 + 1
4542      T = T*RADIX**(L-I2)
4543      GO TO 140
4544  110 J = I1
4545      T = T*RADIX**(-I2)
4546      GO TO 140
4547  120 J = I1 - 1
4548      IF (J.LT.0) GO TO 110
4549      T = T*RADIX**(-I2)/RADIXL
4550      GO TO 140
4551  130 J = I1 - 2
4552      IF (J.LT.0) GO TO 120
4553      T = T*RADIX**(-I2)/RAD2L
4554  140 CONTINUE
4555C
4556C  AT THIS POINT, SOME OR ALL OF THE DIFFERENCE IN THE
4557C AUXILIARY INDICES HAS BEEN USED TO EFFECT A LEFT SHIFT
4558C OF T.  THE SHIFTED VALUE OF T SATISFIES
4559C
4560C       RADIX**(-2*L) .LE. ABS(T) .LE. 1.0D0
4561C
4562C AND, IF J=0, NO FURTHER SHIFTING REMAINS TO BE DONE.
4563C
4564      IF (J.EQ.0) GO TO 190
4565      IF (ABS(S).GE.RADIXL .OR. J.GT.3) GO TO 150
4566      IF (ABS(S).GE.1.0D0) GO TO (180, 150, 150), J
4567      IF (RADIXL*ABS(S).GE.1.0D0) GO TO (180, 170, 150), J
4568      GO TO (180, 170, 160), J
4569  150 Z = S
4570      IZ = IS
4571      GO TO 220
4572  160 S = S*RADIXL
4573  170 S = S*RADIXL
4574  180 S = S*RADIXL
4575  190 CONTINUE
4576C
4577C   AT THIS POINT, THE REMAINING DIFFERENCE IN THE
4578C AUXILIARY INDICES HAS BEEN USED TO EFFECT A RIGHT SHIFT
4579C OF S.  IF THE SHIFTED VALUE OF S WOULD HAVE EXCEEDED
4580C RADIX**L, THEN (S,IS) IS RETURNED AS THE VALUE OF THE
4581C SUM.
4582C
4583      IF (ABS(S).GT.1.0D0 .AND. ABS(T).GT.1.0D0) GO TO 200
4584      IF (ABS(S).LT.1.0D0 .AND. ABS(T).LT.1.0D0) GO TO 210
4585      Z = S + T
4586      IZ = IS - J*L
4587      GO TO 220
4588  200 S = S/RADIXL
4589      T = T/RADIXL
4590      Z = S + T
4591      IZ = IS - J*L + L
4592      GO TO 220
4593  210 S = S*RADIXL
4594      T = T*RADIXL
4595      Z = S + T
4596      IZ = IS - J*L - L
4597  220 CALL DXADJ(Z, IZ,IERROR)
4598      RETURN
4599      END
4600      SUBROUTINE DXADJ (X, IX, IERROR)
4601C***BEGIN PROLOGUE  DXADJ
4602C***PURPOSE  To provide double-precision floating-point arithmetic
4603C            with an extended exponent range.
4604C***LIBRARY   SLATEC
4605C***CATEGORY  A3D
4606C***TYPE      DOUBLE PRECISION (XADJ-S, DXADJ-D)
4607C***KEYWORDS  EXTENDED-RANGE DOUBLE-PRECISION ARITHMETIC
4608C***AUTHOR  Lozier, Daniel W., (NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY)
4609C           Smith, John M., (NBS and George Mason University)
4610C***DESCRIPTION
4611C     DOUBLE PRECISION X
4612C     INTEGER IX
4613C
4614C                  TRANSFORMS (X,IX) SO THAT
4615C                  RADIX**(-L) .LE. ABS(X) .LT. RADIX**L.
4616C                  ON MOST COMPUTERS THIS TRANSFORMATION DOES
4617C                  NOT CHANGE THE MANTISSA OF X PROVIDED RADIX IS
4618C                  THE NUMBER BASE OF DOUBLE-PRECISION ARITHMETIC.
4619C
4620C***SEE ALSO  DXSET
4621C***REFERENCES  (NONE)
4622C***ROUTINES CALLED  XERMSG
4623C***COMMON BLOCKS    DXBLK2
4624C***REVISION HISTORY  (YYMMDD)
4625C   820712  DATE WRITTEN
4626C   881020  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
4627C   901019  Revisions to prologue.  (DWL and WRB)
4628C   901106  Changed all specific intrinsics to generic.  (WRB)
4629C           Corrected order of sections in prologue and added TYPE
4630C           section.  (WRB)
4631C           CALLs to XERROR changed to CALLs to XERMSG.  (WRB)
4632C   920127  Revised PURPOSE section of prologue.  (DWL)
4633C***END PROLOGUE  DXADJ
4634      DOUBLE PRECISION X
4635      INTEGER IX
4636      DOUBLE PRECISION RADIX, RADIXL, RAD2L, DLG10R
4637      INTEGER L, L2, KMAX
4638      COMMON /DXBLK2/ RADIX, RADIXL, RAD2L, DLG10R, L, L2, KMAX
4639      SAVE /DXBLK2/
4640C
4641C-----COMMON----------------------------------------------------------
4642C
4643      INCLUDE 'DPCOP2.INC'
4644C
4645C   THE CONDITION IMPOSED ON L AND KMAX BY THIS SUBROUTINE
4646C IS
4647C     2*L .LE. KMAX
4648C
4649C THIS CONDITION MUST BE MET BY APPROPRIATE CODING
4650C IN SUBROUTINE DXSET.
4651C
4652C***FIRST EXECUTABLE STATEMENT  DXADJ
4653      IERROR=0
4654      IF (X.EQ.0.0D0) GO TO 50
4655      IF (ABS(X).GE.1.0D0) GO TO 20
4656      IF (RADIXL*ABS(X).GE.1.0D0) GO TO 60
4657      X = X*RAD2L
4658      IF (IX.LT.0) GO TO 10
4659      IX = IX - L2
4660      GO TO 70
4661   10 IF (IX.LT.-KMAX+L2) GO TO 40
4662      IX = IX - L2
4663      GO TO 70
4664   20 IF (ABS(X).LT.RADIXL) GO TO 60
4665      X = X/RAD2L
4666      IF (IX.GT.0) GO TO 30
4667      IX = IX + L2
4668      GO TO 70
4669   30 IF (IX.GT.KMAX-L2) GO TO 40
4670      IX = IX + L2
4671      GO TO 70
4672   40 CONTINUE
4673CCC40 CALL XERMSG ('SLATEC', 'DXADJ', 'overflow in auxiliary index',
4674CCCCC+             207, 1)
4675      IERROR=207
4676      WRITE(ICOUT,901)
4677      CALL DPWRST('XXX','BUG ')
4678  901 FORMAT('***** ERROR FROM DXADJ, OVERFLOW IN AUXILIARY INDEX.')
4679      RETURN
4680   50 IX = 0
4681   60 IF (ABS(IX).GT.KMAX) GO TO 40
4682   70 RETURN
4683      END
4684      SUBROUTINE DXLEGF (DNU1, NUDIFF, MU1, MU2, THETA, ID, PQA, IPQA,
4685     1   IERROR)
4686C***BEGIN PROLOGUE  DXLEGF
4687C***PURPOSE  Compute normalized Legendre polynomials and associated
4688C            Legendre functions.
4689C***LIBRARY   SLATEC
4690C***CATEGORY  C3A2, C9
4691C***TYPE      DOUBLE PRECISION (XLEGF-S, DXLEGF-D)
4692C***KEYWORDS  LEGENDRE FUNCTIONS
4693C***AUTHOR  Smith, John M., (NBS and George Mason University)
4694C***DESCRIPTION
4695C
4696C   DXLEGF: Extended-range Double-precision Legendre Functions
4697C
4698C   A feature of the DXLEGF subroutine for Legendre functions is
4699C the use of extended-range arithmetic, a software extension of
4700C ordinary floating-point arithmetic that greatly increases the
4701C exponent range of the representable numbers. This avoids the
4702C need for scaling the solutions to lie within the exponent range
4703C of the most restrictive manufacturer's hardware. The increased
4704C exponent range is achieved by allocating an integer storage
4705C location together with each floating-point storage location.
4706C
4707C   The interpretation of the pair (X,I) where X is floating-point
4708C and I is integer is X*(IR**I) where IR is the internal radix of
4709C the computer arithmetic.
4710C
4711C   This subroutine computes one of the following vectors:
4712C
4713C 1. Legendre function of the first kind of negative order, either
4714C    a. P(-MU1,NU,X), P(-MU1-1,NU,X), ..., P(-MU2,NU,X) or
4715C    b. P(-MU,NU1,X), P(-MU,NU1+1,X), ..., P(-MU,NU2,X)
4716C 2. Legendre function of the second kind, either
4717C    a. Q(MU1,NU,X), Q(MU1+1,NU,X), ..., Q(MU2,NU,X) or
4718C    b. Q(MU,NU1,X), Q(MU,NU1+1,X), ..., Q(MU,NU2,X)
4719C 3. Legendre function of the first kind of positive order, either
4720C    a. P(MU1,NU,X), P(MU1+1,NU,X), ..., P(MU2,NU,X) or
4721C    b. P(MU,NU1,X), P(MU,NU1+1,X), ..., P(MU,NU2,X)
4722C 4. Normalized Legendre polynomials, either
4723C    a. PN(MU1,NU,X), PN(MU1+1,NU,X), ..., PN(MU2,NU,X) or
4724C    b. PN(MU,NU1,X), PN(MU,NU1+1,X), ..., PN(MU,NU2,X)
4725C
4726C where X = COS(THETA).
4727C
4728C   The input values to DXLEGF are DNU1, NUDIFF, MU1, MU2, THETA,
4729C and ID. These must satisfy
4730C
4731C    DNU1 is DOUBLE PRECISION and greater than or equal to -0.5;
4732C    NUDIFF is INTEGER and non-negative;
4733C    MU1 is INTEGER and non-negative;
4734C    MU2 is INTEGER and greater than or equal to MU1;
4735C    THETA is DOUBLE PRECISION and in the half-open interval (0,PI/2];
4736C    ID is INTEGER and equal to 1, 2, 3 or 4;
4737C
4738C and  additionally either NUDIFF = 0 or MU2 = MU1.
4739C
4740C   If ID=1 and NUDIFF=0, a vector of type 1a above is computed
4741C with NU=DNU1.
4742C
4743C   If ID=1 and MU1=MU2, a vector of type 1b above is computed
4744C with NU1=DNU1, NU2=DNU1+NUDIFF and MU=MU1.
4745C
4746C   If ID=2 and NUDIFF=0, a vector of type 2a above is computed
4747C with NU=DNU1.
4748C
4749C   If ID=2 and MU1=MU2, a vector of type 2b above is computed
4750C with NU1=DNU1, NU2=DNU1+NUDIFF and MU=MU1.
4751C
4752C   If ID=3 and NUDIFF=0, a vector of type 3a above is computed
4753C with NU=DNU1.
4754C
4755C   If ID=3 and MU1=MU2, a vector of type 3b above is computed
4756C with NU1=DNU1, NU2=DNU1+NUDIFF and MU=MU1.
4757C
4758C   If ID=4 and NUDIFF=0, a vector of type 4a above is computed
4759C with NU=DNU1.
4760C
4761C   If ID=4 and MU1=MU2, a vector of type 4b above is computed
4762C with NU1=DNU1, NU2=DNU1+NUDIFF and MU=MU1.
4763C
4764C   In each case the vector of computed Legendre function values
4765C is returned in the extended-range vector (PQA(I),IPQA(I)). The
4766C length of this vector is either MU2-MU1+1 or NUDIFF+1.
4767C
4768C   Where possible, DXLEGF returns IPQA(I) as zero. In this case the
4769C value of the Legendre function is contained entirely in PQA(I),
4770C so it can be used in subsequent computations without further
4771C consideration of extended-range arithmetic. If IPQA(I) is nonzero,
4772C then the value of the Legendre function is not representable in
4773C floating-point because of underflow or overflow. The program that
4774C calls DXLEGF must test IPQA(I) to ensure correct usage.
4775C
4776C   IERROR is an error indicator. If no errors are detected, IERROR=0
4777C when control returns to the calling routine. If an error is detected,
4778C IERROR is returned as nonzero. The calling routine must check the
4779C value of IERROR.
4780C
4781C   If IERROR=210 or 211, invalid input was provided to DXLEGF.
4782C   If IERROR=201,202,203, or 204, invalid input was provided to DXSET.
4783C   If IERROR=205 or 206, an internal consistency error occurred in
4784C DXSET (probably due to a software malfunction in the library routine
4785C I1MACH).
4786C   If IERROR=207, an overflow or underflow of an extended-range number
4787C was detected in DXADJ.
4788C   If IERROR=208, an overflow or underflow of an extended-range number
4789C was detected in DXC210.
4790C
4791C***SEE ALSO  DXSET
4792C***REFERENCES  Olver and Smith, Associated Legendre Functions on the
4793C                 Cut, J Comp Phys, v 51, n 3, Sept 1983, pp 502--518.
4794C               Smith, Olver and Lozier, Extended-Range Arithmetic and
4795C                 Normalized Legendre Polynomials, ACM Trans on Math
4796C                 Softw, v 7, n 1, March 1981, pp 93--105.
4797C***ROUTINES CALLED  DXPMU, DXPMUP, DXPNRM, DXPQNU, DXQMU, DXQNU, DXRED,
4798C                    DXSET, XERMSG
4799C***REVISION HISTORY  (YYMMDD)
4800C   820728  DATE WRITTEN
4801C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
4802C   901019  Revisions to prologue.  (DWL and WRB)
4803C   901106  Changed all specific intrinsics to generic.  (WRB)
4804C           Corrected order of sections in prologue and added TYPE
4805C           section.  (WRB)
4806C           CALLs to XERROR changed to CALLs to XERMSG.  (WRB)
4807C   920127  Revised PURPOSE section of prologue.  (DWL)
4808C***END PROLOGUE  DXLEGF
4809      DOUBLE PRECISION PQA,DNU1,DNU2,SX,THETA,X,PI2
4810      DIMENSION PQA(*),IPQA(*)
4811C
4812C-----COMMON----------------------------------------------------------
4813C
4814      INCLUDE 'DPCOP2.INC'
4815C
4816C***FIRST EXECUTABLE STATEMENT  DXLEGF
4817      IERROR=0
4818      CALL DXSET (0, 0, 0.0D0, 0,IERROR)
4819      IF (IERROR.NE.0) RETURN
4820      PI2=2.D0*ATAN(1.D0)
4821C
4822C        ZERO OUTPUT ARRAYS
4823C
4824      L=(MU2-MU1)+NUDIFF+1
4825      DO 290 I=1,L
4826        PQA(I)=0.D0
4827        IPQA(I)=0
4828  290 CONTINUE
4829C
4830C        CHECK FOR VALID INPUT VALUES
4831C
4832      IF(NUDIFF.LT.0) GO TO 400
4833      IF(DNU1.LT.-.5D0) GO TO 400
4834      IF(MU2.LT.MU1) GO TO 400
4835      IF(MU1.LT.0) GO TO 400
4836      IF(THETA.LE.0.D0.OR.THETA.GT.PI2) GO TO 420
4837      IF(ID.LT.1.OR.ID.GT.4) GO TO 400
4838      IF((MU1.NE.MU2).AND.(NUDIFF.GT.0)) GO TO 400
4839C
4840C        IF DNU1 IS NOT AN INTEGER, NORMALIZED P(MU,DNU,X)
4841C        CANNOT BE CALCULATED.  IF DNU1 IS AN INTEGER AND
4842C        MU1.GT.DNU2 THEN ALL VALUES OF P(+MU,DNU,X) AND
4843C        NORMALIZED P(MU,NU,X) WILL BE ZERO.
4844C
4845      DNU2=DNU1+NUDIFF
4846      IF((ID.EQ.3).AND.(MOD(DNU1,1.D0).NE.0.D0)) GO TO 295
4847      IF((ID.EQ.4).AND.(MOD(DNU1,1.D0).NE.0.D0)) GO TO 400
4848      IF((ID.EQ.3.OR.ID.EQ.4).AND.MU1.GT.DNU2) RETURN
4849  295 CONTINUE
4850C
4851      X=COS(THETA)
4852      SX=1.D0/SIN(THETA)
4853      IF(ID.EQ.2) GO TO 300
4854      IF(MU2-MU1.LE.0) GO TO 360
4855C
4856C        FIXED NU, VARIABLE MU
4857C        CALL DXPMU TO CALCULATE P(-MU1,NU,X),....,P(-MU2,NU,X)
4858C
4859      CALL DXPMU(DNU1,DNU2,MU1,MU2,THETA,X,SX,ID,PQA,IPQA,IERROR)
4860      IF (IERROR.NE.0) RETURN
4861      GO TO 380
4862C
4863  300 IF(MU2.EQ.MU1) GO TO 320
4864C
4865C        FIXED NU, VARIABLE MU
4866C        CALL DXQMU TO CALCULATE Q(MU1,NU,X),....,Q(MU2,NU,X)
4867C
4868      CALL DXQMU(DNU1,DNU2,MU1,MU2,THETA,X,SX,ID,PQA,IPQA,IERROR)
4869      IF (IERROR.NE.0) RETURN
4870      GO TO 390
4871C
4872C        FIXED MU, VARIABLE NU
4873C        CALL DXQNU TO CALCULATE Q(MU,DNU1,X),....,Q(MU,DNU2,X)
4874C
4875  320 CALL DXQNU(DNU1,DNU2,MU1,THETA,X,SX,ID,PQA,IPQA,IERROR)
4876      IF (IERROR.NE.0) RETURN
4877      GO TO 390
4878C
4879C        FIXED MU, VARIABLE NU
4880C        CALL DXPQNU TO CALCULATE P(-MU,DNU1,X),....,P(-MU,DNU2,X)
4881C
4882  360 CALL DXPQNU(DNU1,DNU2,MU1,THETA,ID,PQA,IPQA,IERROR)
4883      IF (IERROR.NE.0) RETURN
4884C
4885C        IF ID = 3, TRANSFORM P(-MU,NU,X) VECTOR INTO
4886C        P(MU,NU,X) VECTOR.
4887C
4888  380 IF(ID.EQ.3) CALL DXPMUP(DNU1,DNU2,MU1,MU2,PQA,IPQA,IERROR)
4889      IF (IERROR.NE.0) RETURN
4890C
4891C        IF ID = 4, TRANSFORM P(-MU,NU,X) VECTOR INTO
4892C        NORMALIZED P(MU,NU,X) VECTOR.
4893C
4894      IF(ID.EQ.4) CALL DXPNRM(DNU1,DNU2,MU1,MU2,PQA,IPQA,IERROR)
4895      IF (IERROR.NE.0) RETURN
4896C
4897C        PLACE RESULTS IN REDUCED FORM IF POSSIBLE
4898C        AND RETURN TO MAIN PROGRAM.
4899C
4900  390 DO 395 I=1,L
4901      CALL DXRED(PQA(I),IPQA(I),IERROR)
4902      IF (IERROR.NE.0) RETURN
4903  395 CONTINUE
4904      RETURN
4905C
4906C        *****     ERROR TERMINATION     *****
4907C
4908  400 CONTINUE
4909CCCCC CALL XERMSG ('SLATEC', 'DXLEGF',
4910CCCCC+             'DNU1, NUDIFF, MU1, MU2, or ID not valid', 210, 1)
4911      WRITE(ICOUT,901)
4912      CALL DPWRST('XXX','BUG ')
4913  901 FORMAT('***** ERROR FROM DXLEGF, INVALID INPUT ARGUMENTS.')
4914      IERROR=210
4915      RETURN
4916  420 CONTINUE
4917CCCCC CALL XERMSG ('SLATEC', 'DXLEGF', 'THETA out of range', 211, 1)
4918      WRITE(ICOUT,902)
4919      CALL DPWRST('XXX','BUG ')
4920  902 FORMAT('***** ERROR FROM DXLEGF, THETA OUT OF RANGE.')
4921      IERROR=211
4922      RETURN
4923      END
4924      SUBROUTINE DXNRMP (NU, MU1, MU2, DARG, MODE, DPN, IPN, ISIG,
4925     1   IERROR)
4926C***BEGIN PROLOGUE  DXNRMP
4927C***PURPOSE  Compute normalized Legendre polynomials.
4928C***LIBRARY   SLATEC
4929C***CATEGORY  C3A2, C9
4930C***TYPE      DOUBLE PRECISION (XNRMP-S, DXNRMP-D)
4931C***KEYWORDS  LEGENDRE FUNCTIONS
4932C***AUTHOR  Lozier, Daniel W., (NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY)
4933C           Smith, John M., (NBS and George Mason University)
4934C***DESCRIPTION
4935C
4936C        SUBROUTINE TO CALCULATE NORMALIZED LEGENDRE POLYNOMIALS
4937C        (XNRMP is single-precision version)
4938C        DXNRMP calculates normalized Legendre polynomials of varying
4939C        order and fixed argument and degree. The order MU and degree
4940C        NU are non-negative integers and the argument is real. Because
4941C        the algorithm requires the use of numbers outside the normal
4942C        machine range, this subroutine employs a special arithmetic
4943C        called extended-range arithmetic. See J.M. Smith, F.W.J. Olver,
4944C        and D.W. Lozier, Extended-Range Arithmetic and Normalized
4945C        Legendre Polynomials, ACM Transactions on Mathematical Soft-
4946C        ware, 93-105, March 1981, for a complete description of the
4947C        algorithm and special arithmetic. Also see program comments
4948C        in DXSET.
4949C
4950C        The normalized Legendre polynomials are multiples of the
4951C        associated Legendre polynomials of the first kind where the
4952C        normalizing coefficients are chosen so as to make the integral
4953C        from -1 to 1 of the square of each function equal to 1. See
4954C        E. Jahnke, F. Emde and F. Losch, Tables of Higher Functions,
4955C        McGraw-Hill, New York, 1960, p. 121.
4956C
4957C        The input values to DXNRMP are NU, MU1, MU2, DARG, and MODE.
4958C        These must satisfy
4959C          1. NU .GE. 0 specifies the degree of the normalized Legendre
4960C             polynomial that is wanted.
4961C          2. MU1 .GE. 0 specifies the lowest-order normalized Legendre
4962C             polynomial that is wanted.
4963C          3. MU2 .GE. MU1 specifies the highest-order normalized Leg-
4964C             endre polynomial that is wanted.
4965C         4a. MODE = 1 and -1.0D0 .LE. DARG .LE. 1.0D0 specifies that
4966C             Normalized Legendre(NU, MU, DARG) is wanted for MU = MU1,
4967C             MU1 + 1, ..., MU2.
4968C         4b. MODE = 2 and -3.14159... .LT. DARG .LT. 3.14159... spec-
4969C             ifies that Normalized Legendre(NU, MU, COS(DARG)) is
4970C             wanted for MU = MU1, MU1 + 1, ..., MU2.
4971C
4972C        The output of DXNRMP consists of the two vectors DPN and IPN
4973C        and the error estimate ISIG. The computed values are stored as
4974C        extended-range numbers such that
4975C             (DPN(1),IPN(1))=NORMALIZED LEGENDRE(NU,MU1,DX)
4976C             (DPN(2),IPN(2))=NORMALIZED LEGENDRE(NU,MU1+1,DX)
4977C                .
4978C                .
4979C             (DPN(K),IPN(K))=NORMALIZED LEGENDRE(NU,MU2,DX)
4980C        where K = MU2 - MU1 + 1 and DX = DARG or COS(DARG) according
4981C        to whether MODE = 1 or 2. Finally, ISIG is an estimate of the
4982C        number of decimal digits lost through rounding errors in the
4983C        computation. For example if DARG is accurate to 12 significant
4984C        decimals, then the computed function values are accurate to
4985C        12 - ISIG significant decimals (except in neighborhoods of
4986C        zeros).
4987C
4988C        The interpretation of (DPN(I),IPN(I)) is DPN(I)*(IR**IPN(I))
4989C        where IR is the internal radix of the computer arithmetic. When
4990C        IPN(I) = 0 the value of the normalized Legendre polynomial is
4991C        contained entirely in DPN(I) and subsequent double-precision
4992C        computations can be performed without further consideration of
4993C        extended-range arithmetic. However, if IPN(I) .NE. 0 the corre-
4994C        sponding value of the normalized Legendre polynomial cannot be
4995C        represented in double-precision because of overflow or under-
4996C        flow. THE USER MUST TEST IPN(I) IN HIS/HER PROGRAM. In the case
4997C        that IPN(I) is nonzero, the user could rewrite his/her program
4998C        to use extended range arithmetic.
4999C
5000C
5001C
5002C        The interpretation of (DPN(I),IPN(I)) can be changed to
5003C        DPN(I)*(10**IPN(I)) by calling the extended-range subroutine
5004C        DXCON. This should be done before printing the computed values.
5005C        As an example of usage, the Fortran coding
5006C              J = K
5007C              DO 20 I = 1, K
5008C              CALL DXCON(DPN(I), IPN(I),IERROR)
5009C              IF (IERROR.NE.0) RETURN
5010C              PRINT 10, DPN(I), IPN(I)
5011C           10 FORMAT(1X, D30.18 , I15)
5012C              IF ((IPN(I) .EQ. 0) .OR. (J .LT. K)) GO TO 20
5013C              J = I - 1
5014C           20 CONTINUE
5015C        will print all computed values and determine the largest J
5016C        such that IPN(1) = IPN(2) = ... = IPN(J) = 0. Because of the
5017C        change of representation caused by calling DXCON, (DPN(I),
5018C        IPN(I)) for I = J+1, J+2, ... cannot be used in subsequent
5019C        extended-range computations.
5020C
5021C        IERROR is an error indicator. If no errors are detected,
5022C        IERROR=0 when control returns to the calling routine. If
5023C        an error is detected, IERROR is returned as nonzero. The
5024C        calling routine must check the value of IERROR.
5025C
5026C        If IERROR=212 or 213, invalid input was provided to DXNRMP.
5027C        If IERROR=201,202,203, or 204, invalid input was provided
5028C        to DXSET.
5029C        If IERROR=205 or 206, an internal consistency error occurred
5030C        in DXSET (probably due to a software malfunction in the
5031C        library routine I1MACH).
5032C        If IERROR=207, an overflow or underflow of an extended-range
5033C        number was detected in DXADJ.
5034C        If IERROR=208, an overflow or underflow of an extended-range
5035C        number was detected in DXC210.
5036C
5037C***SEE ALSO  DXSET
5038C***REFERENCES  Smith, Olver and Lozier, Extended-Range Arithmetic and
5039C                 Normalized Legendre Polynomials, ACM Trans on Math
5040C                 Softw, v 7, n 1, March 1981, pp 93--105.
5041C***ROUTINES CALLED  DXADD, DXADJ, DXRED, DXSET, XERMSG
5042C***REVISION HISTORY  (YYMMDD)
5043C   820712  DATE WRITTEN
5044C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5045C   901019  Revisions to prologue.  (DWL and WRB)
5046C   901106  Changed all specific intrinsics to generic.  (WRB)
5047C           Corrected order of sections in prologue and added TYPE
5048C           section.  (WRB)
5049C           CALLs to XERROR changed to CALLs to XERMSG.  (WRB)
5050C   920127  Revised PURPOSE section of prologue.  (DWL)
5051C***END PROLOGUE  DXNRMP
5052      INTEGER NU, MU1, MU2, MODE, IPN, ISIG
5053      DOUBLE PRECISION DARG, DPN
5054      DIMENSION DPN(*), IPN(*)
5055      DOUBLE PRECISION C1,C2,P,P1,P2,P3,S,SX,T,TX,X,DK
5056C
5057C-----COMMON----------------------------------------------------------
5058C
5059      INCLUDE 'DPCOP2.INC'
5060C
5061C CALL DXSET TO INITIALIZE EXTENDED-RANGE ARITHMETIC (SEE DXSET
5062C LISTING FOR DETAILS)
5063C***FIRST EXECUTABLE STATEMENT  DXNRMP
5064      IERROR=0
5065      CALL DXSET (0, 0, 0.0D0, 0,IERROR)
5066      IF (IERROR.NE.0) RETURN
5067C
5068C        TEST FOR PROPER INPUT VALUES.
5069C
5070      IF (NU.LT.0) GO TO 110
5071      IF (MU1.LT.0) GO TO 110
5072      IF (MU1.GT.MU2) GO TO 110
5073      IF (NU.EQ.0) GO TO 90
5074      IF (MODE.LT.1 .OR. MODE.GT.2) GO TO 110
5075      GO TO (10, 20), MODE
5076   10 IF (ABS(DARG).GT.1.0D0) GO TO 120
5077      IF (ABS(DARG).EQ.1.0D0) GO TO 90
5078      X = DARG
5079      SX = SQRT((1.0D0+ABS(X))*((0.5D0-ABS(X))+0.5D0))
5080      TX = X/SX
5081      ISIG = INT(LOG10(2.0D0*NU*(5.0D0+TX**2)))
5082      GO TO 30
5083   20 IF (ABS(DARG).GT.4.0D0*ATAN(1.0D0)) GO TO 120
5084      IF (DARG.EQ.0.0D0) GO TO 90
5085      X = COS(DARG)
5086      SX = ABS(SIN(DARG))
5087      TX = X/SX
5088      ISIG = INT(LOG10(2.0D0*NU*(5.0D0+ABS(DARG*TX))))
5089C
5090C        BEGIN CALCULATION
5091C
5092   30 MU = MU2
5093      I = MU2 - MU1 + 1
5094C
5095C        IF MU.GT.NU, NORMALIZED LEGENDRE(NU,MU,X)=0.
5096C
5097   40 IF (MU.LE.NU) GO TO 50
5098      DPN(I) = 0.0D0
5099      IPN(I) = 0
5100      I = I - 1
5101      MU = MU - 1
5102      IF (I .GT. 0) GO TO 40
5103      ISIG = 0
5104      GO TO 160
5105   50 MU = NU
5106C
5107C        P1 = 0. = NORMALIZED LEGENDRE(NU,NU+1,X)
5108C
5109      P1 = 0.0D0
5110      IP1 = 0
5111C
5112C        CALCULATE P2 = NORMALIZED LEGENDRE(NU,NU,X)
5113C
5114      P2 = 1.0D0
5115      IP2 = 0
5116      P3 = 0.5D0
5117      DK = 2.0D0
5118      DO 60 J=1,NU
5119        P3 = ((DK+1.0D0)/DK)*P3
5120        P2 = P2*SX
5121        CALL DXADJ(P2, IP2,IERROR)
5122        IF (IERROR.NE.0) RETURN
5123        DK = DK + 2.0D0
5124   60 CONTINUE
5125      P2 = P2*SQRT(P3)
5126      CALL DXADJ(P2, IP2,IERROR)
5127      IF (IERROR.NE.0) RETURN
5128      S = 2.0D0*TX
5129      T = 1.0D0/NU
5130      IF (MU2.LT.NU) GO TO 70
5131      DPN(I) = P2
5132      IPN(I) = IP2
5133      I = I - 1
5134      IF (I .EQ. 0) GO TO 140
5135C
5136C        RECURRENCE PROCESS
5137C
5138   70 P = MU*T
5139      C1 = 1.0D0/SQRT((1.0D0-P+T)*(1.0D0+P))
5140      C2 = S*P*C1*P2
5141      C1 = -SQRT((1.0D0+P+T)*(1.0D0-P))*C1*P1
5142      CALL DXADD(C2, IP2, C1, IP1, P, IP,IERROR)
5143      IF (IERROR.NE.0) RETURN
5144      MU = MU - 1
5145      IF (MU.GT.MU2) GO TO 80
5146C
5147C        STORE IN ARRAY DPN FOR RETURN TO CALLING ROUTINE.
5148C
5149      DPN(I) = P
5150      IPN(I) = IP
5151      I = I - 1
5152      IF (I .EQ. 0) GO TO 140
5153   80 P1 = P2
5154      IP1 = IP2
5155      P2 = P
5156      IP2 = IP
5157      IF (MU.LE.MU1) GO TO 140
5158      GO TO 70
5159C
5160C        SPECIAL CASE WHEN X=-1 OR +1, OR NU=0.
5161C
5162   90 K = MU2 - MU1 + 1
5163      DO 100 I=1,K
5164        DPN(I) = 0.0D0
5165        IPN(I) = 0
5166  100 CONTINUE
5167      ISIG = 0
5168      IF (MU1.GT.0) GO TO 160
5169      ISIG = 1
5170      DPN(1) = SQRT(NU+0.5D0)
5171      IPN(1) = 0
5172      IF (MOD(NU,2).EQ.0) GO TO 160
5173      IF (MODE.EQ.1 .AND. DARG.EQ.1.0D0) GO TO 160
5174      IF (MODE.EQ.2) GO TO 160
5175      DPN(1) = -DPN(1)
5176      GO TO 160
5177C
5178C          ERROR PRINTOUTS AND TERMINATION.
5179C
5180  110 CONTINUE
5181CCCCC CALL XERMSG ('SLATEC', 'DXNRMP', 'NU, MU1, MU2 or MODE not valid',
5182CCCCC+             212, 1)
5183      WRITE(ICOUT,901)
5184      CALL DPWRST('XXX','BUG ')
5185  901 FORMAT('***** ERROR FROM DXNRMP, INVALID INOUT ARGUMENTS.')
5186      IERROR=212
5187      RETURN
5188  120 CONTINUE
5189CCCCC CALL XERMSG ('SLATEC', 'DXNRMP', 'DARG out of range', 213, 1)
5190      WRITE(ICOUT,902)
5191      CALL DPWRST('XXX','BUG ')
5192  902 FORMAT('***** ERROR FROM DXNRMP, FIRST ARGUMENT OUT OF RANGE.')
5193      IERROR=213
5194      RETURN
5195C
5196C        RETURN TO CALLING PROGRAM
5197C
5198  140 K = MU2 - MU1 + 1
5199      DO 150 I=1,K
5200        CALL DXRED(DPN(I),IPN(I),IERROR)
5201        IF (IERROR.NE.0) RETURN
5202  150 CONTINUE
5203  160 RETURN
5204      END
5205      SUBROUTINE DXPMU (NU1, NU2, MU1, MU2, THETA, X, SX, ID, PQA, IPQA,
5206     1   IERROR)
5207C***BEGIN PROLOGUE  DXPMU
5208C***SUBSIDIARY
5209C***PURPOSE  To compute the values of Legendre functions for DXLEGF.
5210C            Method: backward mu-wise recurrence for P(-MU,NU,X) for
5211C            fixed nu to obtain P(-MU2,NU1,X), P(-(MU2-1),NU1,X), ...,
5212C            P(-MU1,NU1,X) and store in ascending mu order.
5213C***LIBRARY   SLATEC
5214C***CATEGORY  C3A2, C9
5215C***TYPE      DOUBLE PRECISION (XPMU-S, DXPMU-D)
5216C***KEYWORDS  LEGENDRE FUNCTIONS
5217C***AUTHOR  Smith, John M., (NBS and George Mason University)
5218C***ROUTINES CALLED  DXADD, DXADJ, DXPQNU
5219C***REVISION HISTORY  (YYMMDD)
5220C   820728  DATE WRITTEN
5221C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5222C   901019  Revisions to prologue.  (DWL and WRB)
5223C   901106  Changed all specific intrinsics to generic.  (WRB)
5224C           Corrected order of sections in prologue and added TYPE
5225C           section.  (WRB)
5226C   920127  Revised PURPOSE section of prologue.  (DWL)
5227C***END PROLOGUE  DXPMU
5228      DOUBLE PRECISION PQA,NU1,NU2,P0,X,SX,THETA,X1,X2
5229      DIMENSION PQA(*),IPQA(*)
5230C
5231C        CALL DXPQNU TO OBTAIN P(-MU2,NU,X)
5232C
5233C***FIRST EXECUTABLE STATEMENT  DXPMU
5234      IERROR=0
5235      CALL DXPQNU(NU1,NU2,MU2,THETA,ID,PQA,IPQA,IERROR)
5236      IF (IERROR.NE.0) RETURN
5237      P0=PQA(1)
5238      IP0=IPQA(1)
5239      MU=MU2-1
5240C
5241C        CALL DXPQNU TO OBTAIN P(-MU2-1,NU,X)
5242C
5243      CALL DXPQNU(NU1,NU2,MU,THETA,ID,PQA,IPQA,IERROR)
5244      IF (IERROR.NE.0) RETURN
5245      N=MU2-MU1+1
5246      PQA(N)=P0
5247      IPQA(N)=IP0
5248      IF(N.EQ.1) GO TO 300
5249      PQA(N-1)=PQA(1)
5250      IPQA(N-1)=IPQA(1)
5251      IF(N.EQ.2) GO TO 300
5252      J=N-2
5253  290 CONTINUE
5254C
5255C        BACKWARD RECURRENCE IN MU TO OBTAIN
5256C              P(-MU2,NU1,X),P(-(MU2-1),NU1,X),....P(-MU1,NU1,X)
5257C              USING
5258C              (NU-MU)*(NU+MU+1.)*P(-(MU+1),NU,X)=
5259C                2.*MU*X*SQRT((1./(1.-X**2))*P(-MU,NU,X)-P(-(MU-1),NU,X)
5260C
5261      X1=2.D0*MU*X*SX*PQA(J+1)
5262      X2=-(NU1-MU)*(NU1+MU+1.D0)*PQA(J+2)
5263      CALL DXADD(X1,IPQA(J+1),X2,IPQA(J+2),PQA(J),IPQA(J),IERROR)
5264      IF (IERROR.NE.0) RETURN
5265      CALL DXADJ(PQA(J),IPQA(J),IERROR)
5266      IF (IERROR.NE.0) RETURN
5267      IF(J.EQ.1) GO TO 300
5268      J=J-1
5269      MU=MU-1
5270      GO TO 290
5271  300 RETURN
5272      END
5273      SUBROUTINE DXPMUP (NU1, NU2, MU1, MU2, PQA, IPQA, IERROR)
5274C***BEGIN PROLOGUE  DXPMUP
5275C***SUBSIDIARY
5276C***PURPOSE  To compute the values of Legendre functions for DXLEGF.
5277C            This subroutine transforms an array of Legendre functions
5278C            of the first kind of negative order stored in array PQA
5279C            into Legendre functions of the first kind of positive
5280C            order stored in array PQA. The original array is destroyed.
5281C***LIBRARY   SLATEC
5282C***CATEGORY  C3A2, C9
5283C***TYPE      DOUBLE PRECISION (XPMUP-S, DXPMUP-D)
5284C***KEYWORDS  LEGENDRE FUNCTIONS
5285C***AUTHOR  Smith, John M., (NBS and George Mason University)
5286C***ROUTINES CALLED  DXADJ
5287C***REVISION HISTORY  (YYMMDD)
5288C   820728  DATE WRITTEN
5289C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5290C   901019  Revisions to prologue.  (DWL and WRB)
5291C   901106  Changed all specific intrinsics to generic.  (WRB)
5292C           Corrected order of sections in prologue and added TYPE
5293C           section.  (WRB)
5294C   920127  Revised PURPOSE section of prologue.  (DWL)
5295C***END PROLOGUE  DXPMUP
5296      DOUBLE PRECISION DMU,NU,NU1,NU2,PQA,PROD
5297      DIMENSION PQA(*),IPQA(*)
5298C***FIRST EXECUTABLE STATEMENT  DXPMUP
5299      IERROR=0
5300      NU=NU1
5301      MU=MU1
5302      DMU=MU
5303      N=INT(NU2-NU1+.1D0)+(MU2-MU1)+1
5304      J=1
5305      IF(MOD(REAL(NU),1.).NE.0.) GO TO 210
5306  200 IF(DMU.LT.NU+1.D0) GO TO 210
5307      PQA(J)=0.D0
5308      IPQA(J)=0
5309      J=J+1
5310      IF(J.GT.N) RETURN
5311C        INCREMENT EITHER MU OR NU AS APPROPRIATE.
5312      IF(NU2-NU1.GT..5D0) NU=NU+1.D0
5313      IF(MU2.GT.MU1) MU=MU+1
5314      GO TO 200
5315C
5316C        TRANSFORM P(-MU,NU,X) TO P(MU,NU,X) USING
5317C        P(MU,NU,X)=(NU-MU+1)*(NU-MU+2)*...*(NU+MU)*P(-MU,NU,X)*(-1)**MU
5318C
5319  210 PROD=1.D0
5320      IPROD=0
5321      K=2*MU
5322      IF(K.EQ.0) GO TO 222
5323      DO 220 L=1,K
5324        PROD=PROD*(DMU-NU-L)
5325        CALL DXADJ(PROD,IPROD,IERROR)
5326  220 CONTINUE
5327      IF (IERROR.NE.0) RETURN
5328  222 CONTINUE
5329      DO 240 I=J,N
5330      IF(MU.EQ.0) GO TO 225
5331      PQA(I)=PQA(I)*PROD*(-1)**MU
5332      IPQA(I)=IPQA(I)+IPROD
5333      CALL DXADJ(PQA(I),IPQA(I),IERROR)
5334      IF (IERROR.NE.0) RETURN
5335  225 IF(NU2-NU1.GT..5D0) GO TO 230
5336      PROD=(DMU-NU)*PROD*(-DMU-NU-1.D0)
5337      CALL DXADJ(PROD,IPROD,IERROR)
5338      IF (IERROR.NE.0) RETURN
5339      MU=MU+1
5340      DMU=DMU+1.D0
5341      GO TO 240
5342  230 PROD=PROD*(-DMU-NU-1.D0)/(DMU-NU-1.D0)
5343      CALL DXADJ(PROD,IPROD,IERROR)
5344      IF (IERROR.NE.0) RETURN
5345      NU=NU+1.D0
5346  240 CONTINUE
5347      RETURN
5348      END
5349      SUBROUTINE DXPNRM (NU1, NU2, MU1, MU2, PQA, IPQA, IERROR)
5350C***BEGIN PROLOGUE  DXPNRM
5351C***SUBSIDIARY
5352C***PURPOSE  To compute the values of Legendre functions for DXLEGF.
5353C            This subroutine transforms an array of Legendre functions
5354C            of the first kind of negative order stored in array PQA
5355C            into normalized Legendre polynomials stored in array PQA.
5356C            The original array is destroyed.
5357C***LIBRARY   SLATEC
5358C***CATEGORY  C3A2, C9
5359C***TYPE      DOUBLE PRECISION (XPNRM-S, DXPNRM-D)
5360C***KEYWORDS  LEGENDRE FUNCTIONS
5361C***AUTHOR  Smith, John M., (NBS and George Mason University)
5362C***ROUTINES CALLED  DXADJ
5363C***REVISION HISTORY  (YYMMDD)
5364C   820728  DATE WRITTEN
5365C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5366C   901019  Revisions to prologue.  (DWL and WRB)
5367C   901106  Changed all specific intrinsics to generic.  (WRB)
5368C           Corrected order of sections in prologue and added TYPE
5369C           section.  (WRB)
5370C   920127  Revised PURPOSE section of prologue.  (DWL)
5371C***END PROLOGUE  DXPNRM
5372      DOUBLE PRECISION C1,DMU,NU,NU1,NU2,PQA,PROD
5373      DIMENSION PQA(*),IPQA(*)
5374C***FIRST EXECUTABLE STATEMENT  DXPNRM
5375      IERROR=0
5376      L=INT((MU2-MU1)+(NU2-NU1+1.5D0))
5377      MU=MU1
5378      DMU=MU1
5379      NU=NU1
5380C
5381C         IF MU .GT.NU, NORM P =0.
5382C
5383      J=1
5384  500 CONTINUE
5385      IF(DMU.LE.NU) GO TO 505
5386      PQA(J)=0.D0
5387      IPQA(J)=0
5388      J=J+1
5389      IF(J.GT.L) RETURN
5390C
5391C        INCREMENT EITHER MU OR NU AS APPROPRIATE.
5392C
5393      IF(MU2.GT.MU1) DMU=DMU+1.D0
5394      IF(NU2-NU1.GT..5D0) NU=NU+1.D0
5395      GO TO 500
5396C
5397C         TRANSFORM P(-MU,NU,X) INTO NORMALIZED P(MU,NU,X) USING
5398C              NORM P(MU,NU,X)=
5399C                 SQRT((NU+.5)*FACTORIAL(NU+MU)/FACTORIAL(NU-MU))
5400C                              *P(-MU,NU,X)
5401C
5402  505 CONTINUE
5403      PROD=1.D0
5404      IPROD=0
5405      K=2*MU
5406      IF(K.LE.0) GO TO 520
5407      DO 510 I=1,K
5408        PROD=PROD*SQRT(NU+DMU+1.D0-I)
5409        CALL DXADJ(PROD,IPROD,IERROR)
5410  510 CONTINUE
5411      IF (IERROR.NE.0) RETURN
5412  520 CONTINUE
5413      DO 540 I=J,L
5414      C1=PROD*SQRT(NU+.5D0)
5415      PQA(I)=PQA(I)*C1
5416      IPQA(I)=IPQA(I)+IPROD
5417      CALL DXADJ(PQA(I),IPQA(I),IERROR)
5418      IF (IERROR.NE.0) RETURN
5419      IF(NU2-NU1.GT..5D0) GO TO 530
5420      IF(DMU.GE.NU) GO TO 525
5421      PROD=SQRT(NU+DMU+1.D0)*PROD
5422      IF(NU.GT.DMU) PROD=PROD*SQRT(NU-DMU)
5423      CALL DXADJ(PROD,IPROD,IERROR)
5424      IF (IERROR.NE.0) RETURN
5425      MU=MU+1
5426      DMU=DMU+1.D0
5427      GO TO 540
5428  525 PROD=0.D0
5429      IPROD=0
5430      MU=MU+1
5431      DMU=DMU+1.D0
5432      GO TO 540
5433  530 PROD=SQRT(NU+DMU+1.D0)*PROD
5434      IF(NU.NE.DMU-1.D0) PROD=PROD/SQRT(NU-DMU+1.D0)
5435      CALL DXADJ(PROD,IPROD,IERROR)
5436      IF (IERROR.NE.0) RETURN
5437      NU=NU+1.D0
5438  540 CONTINUE
5439      RETURN
5440      END
5441      SUBROUTINE DXPQNU (NU1, NU2, MU, THETA, ID, PQA, IPQA, IERROR)
5442C***BEGIN PROLOGUE  DXPQNU
5443C***SUBSIDIARY
5444C***PURPOSE  To compute the values of Legendre functions for DXLEGF.
5445C            This subroutine calculates initial values of P or Q using
5446C            power series, then performs forward nu-wise recurrence to
5447C            obtain P(-MU,NU,X), Q(0,NU,X), or Q(1,NU,X). The nu-wise
5448C            recurrence is stable for P for all mu and for Q for mu=0,1.
5449C***LIBRARY   SLATEC
5450C***CATEGORY  C3A2, C9
5451C***TYPE      DOUBLE PRECISION (XPQNU-S, DXPQNU-D)
5452C***KEYWORDS  LEGENDRE FUNCTIONS
5453C***AUTHOR  Smith, John M., (NBS and George Mason University)
5454C***ROUTINES CALLED  DXADD, DXADJ, DXPSI
5455C***COMMON BLOCKS    DXBLK1
5456C***REVISION HISTORY  (YYMMDD)
5457C   820728  DATE WRITTEN
5458C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5459C   901019  Revisions to prologue.  (DWL and WRB)
5460C   901106  Changed all specific intrinsics to generic.  (WRB)
5461C           Corrected order of sections in prologue and added TYPE
5462C           section.  (WRB)
5463C   920127  Revised PURPOSE section of prologue.  (DWL)
5464C***END PROLOGUE  DXPQNU
5465      DOUBLE PRECISION A,NU,NU1,NU2,PQ,PQA,DXPSI,R,THETA,W,X,X1,X2,XS,
5466     1 Y,Z
5467      DOUBLE PRECISION DI,DMU,PQ1,PQ2,FACTMU,FLOK
5468      DIMENSION PQA(*),IPQA(*)
5469      COMMON /DXBLK1/ NBITSF
5470      SAVE /DXBLK1/
5471C
5472C        J0, IPSIK, AND IPSIX ARE INITIALIZED IN THIS SUBROUTINE.
5473C        J0 IS THE NUMBER OF TERMS USED IN SERIES EXPANSION
5474C        IN SUBROUTINE DXPQNU.
5475C        IPSIK, IPSIX ARE VALUES OF K AND X RESPECTIVELY
5476C        USED IN THE CALCULATION OF THE DXPSI FUNCTION.
5477C
5478C***FIRST EXECUTABLE STATEMENT  DXPQNU
5479      IERROR=0
5480      J0=NBITSF
5481      IPSIK=1+(NBITSF/10)
5482      IPSIX=5*IPSIK
5483      IPQ=0
5484C        FIND NU IN INTERVAL [-.5,.5) IF ID=2  ( CALCULATION OF Q )
5485      NU=MOD(NU1,1.D0)
5486      IF(NU.GE..5D0) NU=NU-1.D0
5487C        FIND NU IN INTERVAL (-1.5,-.5] IF ID=1,3, OR 4  ( CALC. OF P )
5488      IF(ID.NE.2.AND.NU.GT.-.5D0) NU=NU-1.D0
5489C        CALCULATE MU FACTORIAL
5490      K=MU
5491      DMU=MU
5492      IF(MU.LE.0) GO TO 60
5493      FACTMU=1.D0
5494      IF=0
5495      DO 50 I=1,K
5496        FACTMU=FACTMU*I
5497        CALL DXADJ(FACTMU,IF,IERROR)
5498   50 CONTINUE
5499      IF (IERROR.NE.0) RETURN
5500   60 IF(K.EQ.0) FACTMU=1.D0
5501      IF(K.EQ.0) IF=0
5502C
5503C        X=COS(THETA)
5504C        Y=SIN(THETA/2)**2=(1-X)/2=.5-.5*X
5505C        R=TAN(THETA/2)=SQRT((1-X)/(1+X)
5506C
5507      X=COS(THETA)
5508      Y=SIN(THETA/2.D0)**2
5509      R=TAN(THETA/2.D0)
5510C
5511C        USE ASCENDING SERIES TO CALCULATE TWO VALUES OF P OR Q
5512C        FOR USE AS STARTING VALUES IN RECURRENCE RELATION.
5513C
5514      PQ2=0.0D0
5515      DO 100 J=1,2
5516      IPQ1=0
5517      IF(ID.EQ.2) GO TO 80
5518C
5519C        SERIES FOR P ( ID = 1, 3, OR 4 )
5520C        P(-MU,NU,X)=1./FACTORIAL(MU)*SQRT(((1.-X)/(1.+X))**MU)
5521C                *SUM(FROM 0 TO J0-1)A(J)*(.5-.5*X)**J
5522C
5523      IPQ=0
5524      PQ=1.D0
5525      A=1.D0
5526      IA=0
5527      DO 65 I=2,J0
5528      DI=I
5529      A=A*Y*(DI-2.D0-NU)*(DI-1.D0+NU)/((DI-1.D0+DMU)*(DI-1.D0))
5530      CALL DXADJ(A,IA,IERROR)
5531      IF (IERROR.NE.0) RETURN
5532      IF(A.EQ.0.D0) GO TO 66
5533      CALL DXADD(PQ,IPQ,A,IA,PQ,IPQ,IERROR)
5534      IF (IERROR.NE.0) RETURN
5535   65 CONTINUE
5536   66 CONTINUE
5537      IF(MU.LE.0) GO TO 90
5538      X2=R
5539      X1=PQ
5540      K=MU
5541      DO 77 I=1,K
5542        X1=X1*X2
5543        CALL DXADJ(X1,IPQ,IERROR)
5544   77 CONTINUE
5545      IF (IERROR.NE.0) RETURN
5546      PQ=X1/FACTMU
5547      IPQ=IPQ-IF
5548      CALL DXADJ(PQ,IPQ,IERROR)
5549      IF (IERROR.NE.0) RETURN
5550      GO TO 90
5551C
5552C        Z=-LN(R)=.5*LN((1+X)/(1-X))
5553C
5554   80 Z=-LOG(R)
5555      W=DXPSI(NU+1.D0,IPSIK,IPSIX)
5556      XS=1.D0/SIN(THETA)
5557C
5558C        SERIES SUMMATION FOR Q ( ID = 2 )
5559C        Q(0,NU,X)=SUM(FROM 0 TO J0-1)((.5*LN((1+X)/(1-X))
5560C    +DXPSI(J+1,IPSIK,IPSIX)-DXPSI(NU+1,IPSIK,IPSIX)))*A(J)*(.5-.5*X)**J
5561C
5562C        Q(1,NU,X)=-SQRT(1./(1.-X**2))+SQRT((1-X)/(1+X))
5563C             *SUM(FROM 0 T0 J0-1)(-NU*(NU+1)/2*LN((1+X)/(1-X))
5564C                 +(J-NU)*(J+NU+1)/(2*(J+1))+NU*(NU+1)*
5565C     (DXPSI(NU+1,IPSIK,IPSIX)-DXPSI(J+1,IPSIK,IPSIX))*A(J)*(.5-.5*X)**J
5566C
5567C        NOTE, IN THIS LOOP K=J+1
5568C
5569      PQ=0.D0
5570      IPQ=0
5571      IA=0
5572      A=1.D0
5573      DO 85 K=1,J0
5574      FLOK=K
5575      IF(K.EQ.1) GO TO 81
5576      A=A*Y*(FLOK-2.D0-NU)*(FLOK-1.D0+NU)/((FLOK-1.D0+DMU)*(FLOK-1.D0))
5577      CALL DXADJ(A,IA,IERROR)
5578      IF (IERROR.NE.0) RETURN
5579   81 CONTINUE
5580      IF(MU.GE.1) GO TO 83
5581      X1=(DXPSI(FLOK,IPSIK,IPSIX)-W+Z)*A
5582      IX1=IA
5583      CALL DXADD(PQ,IPQ,X1,IX1,PQ,IPQ,IERROR)
5584      IF (IERROR.NE.0) RETURN
5585      GO TO 85
5586   83 X1=(NU*(NU+1.D0)*(Z-W+DXPSI(FLOK,IPSIK,IPSIX))+(NU-FLOK+1.D0)
5587     1  *(NU+FLOK)/(2.D0*FLOK))*A
5588      IX1=IA
5589      CALL DXADD(PQ,IPQ,X1,IX1,PQ,IPQ,IERROR)
5590      IF (IERROR.NE.0) RETURN
5591   85 CONTINUE
5592      IF(MU.GE.1) PQ=-R*PQ
5593      IXS=0
5594      IF(MU.GE.1) CALL DXADD(PQ,IPQ,-XS,IXS,PQ,IPQ,IERROR)
5595      IF (IERROR.NE.0) RETURN
5596      IF(J.EQ.2) MU=-MU
5597      IF(J.EQ.2) DMU=-DMU
5598   90 IF(J.EQ.1) PQ2=PQ
5599      IF(J.EQ.1) IPQ2=IPQ
5600      NU=NU+1.D0
5601  100 CONTINUE
5602      K=0
5603      IF(NU-1.5D0.LT.NU1) GO TO 120
5604      K=K+1
5605      PQA(K)=PQ2
5606      IPQA(K)=IPQ2
5607      IF(NU.GT.NU2+.5D0) RETURN
5608  120 PQ1=PQ
5609      IPQ1=IPQ
5610      IF(NU.LT.NU1+.5D0) GO TO 130
5611      K=K+1
5612      PQA(K)=PQ
5613      IPQA(K)=IPQ
5614      IF(NU.GT.NU2+.5D0) RETURN
5615C
5616C        FORWARD NU-WISE RECURRENCE FOR F(MU,NU,X) FOR FIXED MU
5617C        USING
5618C        (NU+MU+1)*F(MU,NU,X)=(2.*NU+1)*F(MU,NU,X)-(NU-MU)*F(MU,NU-1,X)
5619C        WHERE F(MU,NU,X) MAY BE P(-MU,NU,X) OR IF MU IS REPLACED
5620C        BY -MU THEN F(MU,NU,X) MAY BE Q(MU,NU,X).
5621C        NOTE, IN THIS LOOP, NU=NU+1
5622C
5623  130 X1=(2.D0*NU-1.D0)/(NU+DMU)*X*PQ1
5624      X2=(NU-1.D0-DMU)/(NU+DMU)*PQ2
5625      CALL DXADD(X1,IPQ1,-X2,IPQ2,PQ,IPQ,IERROR)
5626      IF (IERROR.NE.0) RETURN
5627      CALL DXADJ(PQ,IPQ,IERROR)
5628      IF (IERROR.NE.0) RETURN
5629      NU=NU+1.D0
5630      PQ2=PQ1
5631      IPQ2=IPQ1
5632      GO TO 120
5633C
5634      END
5635      DOUBLE PRECISION FUNCTION DXPSI (A, IPSIK, IPSIX)
5636C***BEGIN PROLOGUE  DXPSI
5637C***SUBSIDIARY
5638C***PURPOSE  To compute values of the Psi function for DXLEGF.
5639C***LIBRARY   SLATEC
5640C***CATEGORY  C7C
5641C***TYPE      DOUBLE PRECISION (XPSI-S, DXPSI-D)
5642C***KEYWORDS  PSI FUNCTION
5643C***AUTHOR  Smith, John M., (NBS and George Mason University)
5644C***ROUTINES CALLED  (NONE)
5645C***REVISION HISTORY  (YYMMDD)
5646C   820728  DATE WRITTEN
5647C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5648C   901019  Revisions to prologue.  (DWL and WRB)
5649C   901106  Changed all specific intrinsics to generic.  (WRB)
5650C           Corrected order of sections in prologue and added TYPE
5651C           section.  (WRB)
5652C   920127  Revised PURPOSE section of prologue.  (DWL)
5653C***END PROLOGUE  DXPSI
5654      DOUBLE PRECISION A,B,C,CNUM,CDENOM
5655      DIMENSION CNUM(12),CDENOM(12)
5656      SAVE CNUM, CDENOM
5657C
5658C        CNUM(I) AND CDENOM(I) ARE THE ( REDUCED ) NUMERATOR
5659C        AND 2*I*DENOMINATOR RESPECTIVELY OF THE 2*I TH BERNOULLI
5660C        NUMBER.
5661C
5662      DATA CNUM(1),CNUM(2),CNUM(3),CNUM(4),CNUM(5),CNUM(6),CNUM(7),
5663     1CNUM(8),CNUM(9),CNUM(10),CNUM(11),CNUM(12)
5664     2    / 1.D0,     -1.D0,    1.D0,     -1.D0, 1.D0,
5665     3   -691.D0,  1.D0,     -3617.D0, 43867.D0, -174611.D0, 77683.D0,
5666     4   -236364091.D0/
5667      DATA CDENOM(1),CDENOM(2),CDENOM(3),CDENOM(4),CDENOM(5),CDENOM(6),
5668     1 CDENOM(7),CDENOM(8),CDENOM(9),CDENOM(10),CDENOM(11),CDENOM(12)
5669     2/12.D0,120.D0,   252.D0,   240.D0,132.D0,
5670     3  32760.D0, 12.D0,  8160.D0, 14364.D0, 6600.D0, 276.D0, 65520.D0/
5671C***FIRST EXECUTABLE STATEMENT  DXPSI
5672      N=MAX(0,IPSIX-INT(A))
5673      B=N+A
5674      K1=IPSIK-1
5675C
5676C        SERIES EXPANSION FOR A .GT. IPSIX USING IPSIK-1 TERMS.
5677C
5678      C=0.D0
5679      DO 12 I=1,K1
5680        K=IPSIK-I
5681        C=(C+CNUM(K)/CDENOM(K))/B**2
5682   12 CONTINUE
5683      DXPSI=LOG(B)-(C+.5D0/B)
5684      IF(N.EQ.0) GO TO 20
5685      B=0.D0
5686C
5687C        RECURRENCE FOR A .LE. IPSIX.
5688C
5689      DO 15 M=1,N
5690        B=B+1.D0/(N-M+A)
5691   15 CONTINUE
5692      DXPSI=DXPSI-B
5693   20 RETURN
5694      END
5695      SUBROUTINE DXQMU (NU1, NU2, MU1, MU2, THETA, X, SX, ID, PQA, IPQA,
5696     1   IERROR)
5697C***BEGIN PROLOGUE  DXQMU
5698C***SUBSIDIARY
5699C***PURPOSE  To compute the values of Legendre functions for DXLEGF.
5700C            Method: forward mu-wise recurrence for Q(MU,NU,X) for fixed
5701C            nu to obtain Q(MU1,NU,X), Q(MU1+1,NU,X), ..., Q(MU2,NU,X).
5702C***LIBRARY   SLATEC
5703C***CATEGORY  C3A2, C9
5704C***TYPE      DOUBLE PRECISION (XQMU-S, DXQMU-D)
5705C***KEYWORDS  LEGENDRE FUNCTIONS
5706C***AUTHOR  Smith, John M., (NBS and George Mason University)
5707C***ROUTINES CALLED  DXADD, DXADJ, DXPQNU
5708C***REVISION HISTORY  (YYMMDD)
5709C   820728  DATE WRITTEN
5710C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5711C   901019  Revisions to prologue.  (DWL and WRB)
5712C   901106  Corrected order of sections in prologue and added TYPE
5713C           section.  (WRB)
5714C   920127  Revised PURPOSE section of prologue.  (DWL)
5715C***END PROLOGUE  DXQMU
5716      DIMENSION PQA(*),IPQA(*)
5717      DOUBLE PRECISION DMU,NU,NU1,NU2,PQ,PQA,PQ1,PQ2,SX,X,X1,X2
5718      DOUBLE PRECISION THETA
5719C***FIRST EXECUTABLE STATEMENT  DXQMU
5720      IERROR=0
5721      MU=0
5722C
5723C        CALL DXPQNU TO OBTAIN Q(0.,NU1,X)
5724C
5725      CALL DXPQNU(NU1,NU2,MU,THETA,ID,PQA,IPQA,IERROR)
5726      IF (IERROR.NE.0) RETURN
5727      PQ2=PQA(1)
5728      IPQ2=IPQA(1)
5729      MU=1
5730C
5731C        CALL DXPQNU TO OBTAIN Q(1.,NU1,X)
5732C
5733      CALL DXPQNU(NU1,NU2,MU,THETA,ID,PQA,IPQA,IERROR)
5734      IF (IERROR.NE.0) RETURN
5735      NU=NU1
5736      K=0
5737      MU=1
5738      DMU=1.D0
5739      PQ1=PQA(1)
5740      IPQ1=IPQA(1)
5741      IF(MU1.GT.0) GO TO 310
5742      K=K+1
5743      PQA(K)=PQ2
5744      IPQA(K)=IPQ2
5745      IF(MU2.LT.1) GO TO 330
5746  310 IF(MU1.GT.1) GO TO 320
5747      K=K+1
5748      PQA(K)=PQ1
5749      IPQA(K)=IPQ1
5750      IF(MU2.LE.1) GO TO 330
5751  320 CONTINUE
5752C
5753C        FORWARD RECURRENCE IN MU TO OBTAIN
5754C                  Q(MU1,NU,X),Q(MU1+1,NU,X),....,Q(MU2,NU,X) USING
5755C             Q(MU+1,NU,X)=-2.*MU*X*SQRT(1./(1.-X**2))*Q(MU,NU,X)
5756C                               -(NU+MU)*(NU-MU+1.)*Q(MU-1,NU,X)
5757C
5758      X1=-2.D0*DMU*X*SX*PQ1
5759      X2=(NU+DMU)*(NU-DMU+1.D0)*PQ2
5760      CALL DXADD(X1,IPQ1,-X2,IPQ2,PQ,IPQ,IERROR)
5761      IF (IERROR.NE.0) RETURN
5762      CALL DXADJ(PQ,IPQ,IERROR)
5763      IF (IERROR.NE.0) RETURN
5764      PQ2=PQ1
5765      IPQ2=IPQ1
5766      PQ1=PQ
5767      IPQ1=IPQ
5768      MU=MU+1
5769      DMU=DMU+1.D0
5770      IF(MU.LT.MU1) GO TO 320
5771      K=K+1
5772      PQA(K)=PQ
5773      IPQA(K)=IPQ
5774      IF(MU2.GT.MU) GO TO 320
5775  330 RETURN
5776      END
5777      SUBROUTINE DXQNU (NU1, NU2, MU1, THETA, X, SX, ID, PQA, IPQA,
5778     1   IERROR)
5779C***BEGIN PROLOGUE  DXQNU
5780C***SUBSIDIARY
5781C***PURPOSE  To compute the values of Legendre functions for DXLEGF.
5782C            Method: backward nu-wise recurrence for Q(MU,NU,X) for
5783C            fixed mu to obtain Q(MU1,NU1,X), Q(MU1,NU1+1,X), ...,
5784C            Q(MU1,NU2,X).
5785C***LIBRARY   SLATEC
5786C***CATEGORY  C3A2, C9
5787C***TYPE      DOUBLE PRECISION (XQNU-S, DXQNU-D)
5788C***KEYWORDS  LEGENDRE FUNCTIONS
5789C***AUTHOR  Smith, John M., (NBS and George Mason University)
5790C***ROUTINES CALLED  DXADD, DXADJ, DXPQNU
5791C***REVISION HISTORY  (YYMMDD)
5792C   820728  DATE WRITTEN
5793C   890126  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5794C   901019  Revisions to prologue.  (DWL and WRB)
5795C   901106  Corrected order of sections in prologue and added TYPE
5796C           section.  (WRB)
5797C   920127  Revised PURPOSE section of prologue.  (DWL)
5798C***END PROLOGUE  DXQNU
5799      DIMENSION PQA(*),IPQA(*)
5800      DOUBLE PRECISION DMU,NU,NU1,NU2,PQ,PQA,PQ1,PQ2,SX,X,X1,X2
5801      DOUBLE PRECISION THETA,PQL1,PQL2
5802C***FIRST EXECUTABLE STATEMENT  DXQNU
5803      IERROR=0
5804      K=0
5805      PQ2=0.0D0
5806      IPQ2=0
5807      PQL2=0.0D0
5808      IPQL2=0
5809      IF(MU1.EQ.1) GO TO 290
5810      MU=0
5811C
5812C        CALL DXPQNU TO OBTAIN Q(0.,NU2,X) AND Q(0.,NU2-1,X)
5813C
5814      CALL DXPQNU(NU1,NU2,MU,THETA,ID,PQA,IPQA,IERROR)
5815      IF (IERROR.NE.0) RETURN
5816      IF(MU1.EQ.0) RETURN
5817      K=INT((NU2-NU1+1.5D0))
5818      PQ2=PQA(K)
5819      IPQ2=IPQA(K)
5820      PQL2=PQA(K-1)
5821      IPQL2=IPQA(K-1)
5822  290 MU=1
5823C
5824C        CALL DXPQNU TO OBTAIN Q(1.,NU2,X) AND Q(1.,NU2-1,X)
5825C
5826      CALL DXPQNU(NU1,NU2,MU,THETA,ID,PQA,IPQA,IERROR)
5827      IF (IERROR.NE.0) RETURN
5828      IF(MU1.EQ.1) RETURN
5829      NU=NU2
5830      PQ1=PQA(K)
5831      IPQ1=IPQA(K)
5832      PQL1=PQA(K-1)
5833      IPQL1=IPQA(K-1)
5834  300 MU=1
5835      DMU=1.D0
5836  320 CONTINUE
5837C
5838C        FORWARD RECURRENCE IN MU TO OBTAIN Q(MU1,NU2,X) AND
5839C              Q(MU1,NU2-1,X) USING
5840C              Q(MU+1,NU,X)=-2.*MU*X*SQRT(1./(1.-X**2))*Q(MU,NU,X)
5841C                   -(NU+MU)*(NU-MU+1.)*Q(MU-1,NU,X)
5842C
5843C              FIRST FOR NU=NU2
5844C
5845      X1=-2.D0*DMU*X*SX*PQ1
5846      X2=(NU+DMU)*(NU-DMU+1.D0)*PQ2
5847      CALL DXADD(X1,IPQ1,-X2,IPQ2,PQ,IPQ,IERROR)
5848      IF (IERROR.NE.0) RETURN
5849      CALL DXADJ(PQ,IPQ,IERROR)
5850      IF (IERROR.NE.0) RETURN
5851      PQ2=PQ1
5852      IPQ2=IPQ1
5853      PQ1=PQ
5854      IPQ1=IPQ
5855      MU=MU+1
5856      DMU=DMU+1.D0
5857      IF(MU.LT.MU1) GO TO 320
5858      PQA(K)=PQ
5859      IPQA(K)=IPQ
5860      IF(K.EQ.1) RETURN
5861      IF(NU.LT.NU2) GO TO 340
5862C
5863C              THEN FOR NU=NU2-1
5864C
5865      NU=NU-1.D0
5866      PQ2=PQL2
5867      IPQ2=IPQL2
5868      PQ1=PQL1
5869      IPQ1=IPQL1
5870      K=K-1
5871      GO TO 300
5872C
5873C         BACKWARD RECURRENCE IN NU TO OBTAIN
5874C              Q(MU1,NU1,X),Q(MU1,NU1+1,X),....,Q(MU1,NU2,X)
5875C              USING
5876C              (NU-MU+1.)*Q(MU,NU+1,X)=
5877C                       (2.*NU+1.)*X*Q(MU,NU,X)-(NU+MU)*Q(MU,NU-1,X)
5878C
5879  340 PQ1=PQA(K)
5880      IPQ1=IPQA(K)
5881      PQ2=PQA(K+1)
5882      IPQ2=IPQA(K+1)
5883  350 IF(NU.LE.NU1) RETURN
5884      K=K-1
5885      X1=(2.D0*NU+1.D0)*X*PQ1/(NU+DMU)
5886      X2=-(NU-DMU+1.D0)*PQ2/(NU+DMU)
5887      CALL DXADD(X1,IPQ1,X2,IPQ2,PQ,IPQ,IERROR)
5888      IF (IERROR.NE.0) RETURN
5889      CALL DXADJ(PQ,IPQ,IERROR)
5890      IF (IERROR.NE.0) RETURN
5891      PQ2=PQ1
5892      IPQ2=IPQ1
5893      PQ1=PQ
5894      IPQ1=IPQ
5895      PQA(K)=PQ
5896      IPQA(K)=IPQ
5897      NU=NU-1.D0
5898      GO TO 350
5899      END
5900      SUBROUTINE DXRED (X, IX, IERROR)
5901C***BEGIN PROLOGUE  DXRED
5902C***PURPOSE  To provide double-precision floating-point arithmetic
5903C            with an extended exponent range.
5904C***LIBRARY   SLATEC
5905C***CATEGORY  A3D
5906C***TYPE      DOUBLE PRECISION (XRED-S, DXRED-D)
5907C***KEYWORDS  EXTENDED-RANGE DOUBLE-PRECISION ARITHMETIC
5908C***AUTHOR  Lozier, Daniel W., (NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY)
5909C           Smith, John M., (NBS and George Mason University)
5910C***DESCRIPTION
5911C     DOUBLE PRECISION X
5912C     INTEGER IX
5913C
5914C                  IF
5915C                  RADIX**(-2L) .LE. (ABS(X),IX) .LE. RADIX**(2L)
5916C                  THEN DXRED TRANSFORMS (X,IX) SO THAT IX=0.
5917C                  IF (X,IX) IS OUTSIDE THE ABOVE RANGE,
5918C                  THEN DXRED TAKES NO ACTION.
5919C                  THIS SUBROUTINE IS USEFUL IF THE
5920C                  RESULTS OF EXTENDED-RANGE CALCULATIONS
5921C                  ARE TO BE USED IN SUBSEQUENT ORDINARY
5922C                  DOUBLE-PRECISION CALCULATIONS.
5923C
5924C***SEE ALSO  DXSET
5925C***REFERENCES  (NONE)
5926C***ROUTINES CALLED  (NONE)
5927C***COMMON BLOCKS    DXBLK2
5928C***REVISION HISTORY  (YYMMDD)
5929C   820712  DATE WRITTEN
5930C   881020  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
5931C   901019  Revisions to prologue.  (DWL and WRB)
5932C   901106  Changed all specific intrinsics to generic.  (WRB)
5933C           Corrected order of sections in prologue and added TYPE
5934C           section.  (WRB)
5935C   920127  Revised PURPOSE section of prologue.  (DWL)
5936C***END PROLOGUE  DXRED
5937      DOUBLE PRECISION X
5938      INTEGER IX
5939      DOUBLE PRECISION RADIX, RADIXL, RAD2L, DLG10R, XA
5940      INTEGER L, L2, KMAX
5941      COMMON /DXBLK2/ RADIX, RADIXL, RAD2L, DLG10R, L, L2, KMAX
5942      SAVE /DXBLK2/
5943C
5944C***FIRST EXECUTABLE STATEMENT  DXRED
5945      IERROR=0
5946      IF (X.EQ.0.0D0) GO TO 90
5947      XA = ABS(X)
5948      IF (IX.EQ.0) GO TO 70
5949      IXA = ABS(IX)
5950      IXA1 = IXA/L2
5951      IXA2 = MOD(IXA,L2)
5952      IF (IX.GT.0) GO TO 40
5953   10 CONTINUE
5954      IF (XA.GT.1.0D0) GO TO 20
5955      XA = XA*RAD2L
5956      IXA1 = IXA1 + 1
5957      GO TO 10
5958   20 XA = XA/RADIX**IXA2
5959      IF (IXA1.EQ.0) GO TO 70
5960      DO 30 I=1,IXA1
5961        IF (XA.LT.1.0D0) GO TO 100
5962        XA = XA/RAD2L
5963   30 CONTINUE
5964      GO TO 70
5965C
5966   40 CONTINUE
5967      IF (XA.LT.1.0D0) GO TO 50
5968      XA = XA/RAD2L
5969      IXA1 = IXA1 + 1
5970      GO TO 40
5971   50 XA = XA*RADIX**IXA2
5972      IF (IXA1.EQ.0) GO TO 70
5973      DO 60 I=1,IXA1
5974        IF (XA.GT.1.0D0) GO TO 100
5975        XA = XA*RAD2L
5976   60 CONTINUE
5977   70 IF (XA.GT.RAD2L) GO TO 100
5978      IF (XA.GT.1.0D0) GO TO 80
5979      IF (RAD2L*XA.LT.1.0D0) GO TO 100
5980   80 X = SIGN(XA,X)
5981   90 IX = 0
5982  100 RETURN
5983      END
5984      SUBROUTINE DXSET (IRAD, NRADPL, DZERO, NBITS, IERROR)
5985C***BEGIN PROLOGUE  DXSET
5986C***PURPOSE  To provide double-precision floating-point arithmetic
5987C            with an extended exponent range.
5988C***LIBRARY   SLATEC
5989C***CATEGORY  A3D
5990C***TYPE      DOUBLE PRECISION (XSET-S, DXSET-D)
5991C***KEYWORDS  EXTENDED-RANGE DOUBLE-PRECISION ARITHMETIC
5992C***AUTHOR  Lozier, Daniel W., (NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY)
5993C           Smith, John M., (NBS and George Mason University)
5994C***DESCRIPTION
5995C
5996C   SUBROUTINE  DXSET  MUST BE CALLED PRIOR TO CALLING ANY OTHER
5997C EXTENDED-RANGE SUBROUTINE. IT CALCULATES AND STORES SEVERAL
5998C MACHINE-DEPENDENT CONSTANTS IN COMMON BLOCKS. THE USER MUST
5999C SUPPLY FOUR CONSTANTS THAT PERTAIN TO HIS PARTICULAR COMPUTER.
6000C THE CONSTANTS ARE
6001C
6002C          IRAD = THE INTERNAL BASE OF DOUBLE-PRECISION
6003C                 ARITHMETIC IN THE COMPUTER.
6004C        NRADPL = THE NUMBER OF RADIX PLACES CARRIED IN
6005C                 THE DOUBLE-PRECISION REPRESENTATION.
6006C         DZERO = THE SMALLEST OF 1/DMIN, DMAX, DMAXLN WHERE
6007C                 DMIN = THE SMALLEST POSITIVE DOUBLE-PRECISION
6008C                 NUMBER OR AN UPPER BOUND TO THIS NUMBER,
6009C                 DMAX = THE LARGEST DOUBLE-PRECISION NUMBER
6010C                 OR A LOWER BOUND TO THIS NUMBER,
6011C                 DMAXLN = THE LARGEST DOUBLE-PRECISION NUMBER
6012C                 SUCH THAT LOG10(DMAXLN) CAN BE COMPUTED BY THE
6013C                 FORTRAN SYSTEM (ON MOST SYSTEMS DMAXLN = DMAX).
6014C         NBITS = THE NUMBER OF BITS (EXCLUSIVE OF SIGN) IN
6015C                 AN INTEGER COMPUTER WORD.
6016C
6017C ALTERNATIVELY, ANY OR ALL OF THE CONSTANTS CAN BE GIVEN
6018C THE VALUE 0 (0.0D0 FOR DZERO). IF A CONSTANT IS ZERO, DXSET TRIES
6019C TO ASSIGN AN APPROPRIATE VALUE BY CALLING I1MACH
6020C (SEE P.A.FOX, A.D.HALL, N.L.SCHRYER, ALGORITHM 528 FRAMEWORK
6021C FOR A PORTABLE LIBRARY, ACM TRANSACTIONS ON MATH SOFTWARE,
6022C V.4, NO.2, JUNE 1978, 177-188).
6023C
6024C   THIS IS THE SETTING-UP SUBROUTINE FOR A PACKAGE OF SUBROUTINES
6025C THAT FACILITATE THE USE OF EXTENDED-RANGE ARITHMETIC. EXTENDED-RANGE
6026C ARITHMETIC ON A PARTICULAR COMPUTER IS DEFINED ON THE SET OF NUMBERS
6027C OF THE FORM
6028C
6029C               (X,IX) = X*RADIX**IX
6030C
6031C WHERE X IS A DOUBLE-PRECISION NUMBER CALLED THE PRINCIPAL PART,
6032C IX IS AN INTEGER CALLED THE AUXILIARY INDEX, AND RADIX IS THE
6033C INTERNAL BASE OF THE DOUBLE-PRECISION ARITHMETIC.  OBVIOUSLY,
6034C EACH REAL NUMBER IS REPRESENTABLE WITHOUT ERROR BY MORE THAN ONE
6035C EXTENDED-RANGE FORM.  CONVERSIONS BETWEEN  DIFFERENT FORMS ARE
6036C ESSENTIAL IN CARRYING OUT ARITHMETIC OPERATIONS.  WITH THE CHOICE
6037C OF RADIX WE HAVE MADE, AND THE SUBROUTINES WE HAVE WRITTEN, THESE
6038C CONVERSIONS ARE PERFORMED WITHOUT ERROR (AT LEAST ON MOST COMPUTERS).
6039C (SEE SMITH, J.M., OLVER, F.W.J., AND LOZIER, D.W., EXTENDED-RANGE
6040C ARITHMETIC AND NORMALIZED LEGENDRE POLYNOMIALS, ACM TRANSACTIONS ON
6041C MATHEMATICAL SOFTWARE, MARCH 1981).
6042C
6043C   AN EXTENDED-RANGE NUMBER  (X,IX)  IS SAID TO BE IN ADJUSTED FORM IF
6044C X AND IX ARE ZERO OR
6045C
6046C           RADIX**(-L) .LE. ABS(X) .LT. RADIX**L
6047C
6048C IS SATISFIED, WHERE L IS A COMPUTER-DEPENDENT INTEGER DEFINED IN THIS
6049C SUBROUTINE. TWO EXTENDED-RANGE NUMBERS IN ADJUSTED FORM CAN BE ADDED,
6050C SUBTRACTED, MULTIPLIED OR DIVIDED (IF THE DIVISOR IS NONZERO) WITHOUT
6051C CAUSING OVERFLOW OR UNDERFLOW IN THE PRINCIPAL PART OF THE RESULT.
6052C WITH PROPER USE OF THE EXTENDED-RANGE SUBROUTINES, THE ONLY OVERFLOW
6053C THAT CAN OCCUR IS INTEGER OVERFLOW IN THE AUXILIARY INDEX. IF THIS
6054C IS DETECTED, THE SOFTWARE CALLS XERROR (A GENERAL ERROR-HANDLING
6055C FORTRAN SUBROUTINE PACKAGE).
6056C
6057C   MULTIPLICATION AND DIVISION IS PERFORMED BY SETTING
6058C
6059C                 (X,IX)*(Y,IY) = (X*Y,IX+IY)
6060C OR
6061C                 (X,IX)/(Y,IY) = (X/Y,IX-IY).
6062C
6063C PRE-ADJUSTMENT OF THE OPERANDS IS ESSENTIAL TO AVOID
6064C OVERFLOW OR  UNDERFLOW OF THE PRINCIPAL PART. SUBROUTINE
6065C DXADJ (SEE BELOW) MAY BE CALLED TO TRANSFORM ANY EXTENDED-
6066C RANGE NUMBER INTO ADJUSTED FORM.
6067C
6068C   ADDITION AND SUBTRACTION REQUIRE THE USE OF SUBROUTINE DXADD
6069C (SEE BELOW).  THE INPUT OPERANDS NEED NOT BE IN ADJUSTED FORM.
6070C HOWEVER, THE RESULT OF ADDITION OR SUBTRACTION IS RETURNED
6071C IN ADJUSTED FORM.  THUS, FOR EXAMPLE, IF (X,IX),(Y,IY),
6072C (U,IU),  AND (V,IV) ARE IN ADJUSTED FORM, THEN
6073C
6074C                 (X,IX)*(Y,IY) + (U,IU)*(V,IV)
6075C
6076C CAN BE COMPUTED AND STORED IN ADJUSTED FORM WITH NO EXPLICIT
6077C CALLS TO DXADJ.
6078C
6079C   WHEN AN EXTENDED-RANGE NUMBER IS TO BE PRINTED, IT MUST BE
6080C CONVERTED TO AN EXTENDED-RANGE FORM WITH DECIMAL RADIX.  SUBROUTINE
6081C DXCON IS PROVIDED FOR THIS PURPOSE.
6082C
6083C   THE SUBROUTINES CONTAINED IN THIS PACKAGE ARE
6084C
6085C     SUBROUTINE DXADD
6086C USAGE
6087C                  CALL DXADD(X,IX,Y,IY,Z,IZ,IERROR)
6088C                  IF (IERROR.NE.0) RETURN
6089C DESCRIPTION
6090C                  FORMS THE EXTENDED-RANGE SUM  (Z,IZ) =
6091C                  (X,IX) + (Y,IY).  (Z,IZ) IS ADJUSTED
6092C                  BEFORE RETURNING. THE INPUT OPERANDS
6093C                  NEED NOT BE IN ADJUSTED FORM, BUT THEIR
6094C                  PRINCIPAL PARTS MUST SATISFY
6095C                  RADIX**(-2L).LE.ABS(X).LE.RADIX**(2L),
6096C                  RADIX**(-2L).LE.ABS(Y).LE.RADIX**(2L).
6097C
6098C     SUBROUTINE DXADJ
6099C USAGE
6100C                  CALL DXADJ(X,IX,IERROR)
6101C                  IF (IERROR.NE.0) RETURN
6102C DESCRIPTION
6103C                  TRANSFORMS (X,IX) SO THAT
6104C                  RADIX**(-L) .LE. ABS(X) .LT. RADIX**L.
6105C                  ON MOST COMPUTERS THIS TRANSFORMATION DOES
6106C                  NOT CHANGE THE MANTISSA OF X PROVIDED RADIX IS
6107C                  THE NUMBER BASE OF DOUBLE-PRECISION ARITHMETIC.
6108C
6109C     SUBROUTINE DXC210
6110C USAGE
6111C                  CALL DXC210(K,Z,J,IERROR)
6112C                  IF (IERROR.NE.0) RETURN
6113C DESCRIPTION
6114C                  GIVEN K THIS SUBROUTINE COMPUTES J AND Z
6115C                  SUCH THAT  RADIX**K = Z*10**J, WHERE Z IS IN
6116C                  THE RANGE 1/10 .LE. Z .LT. 1.
6117C                  THE VALUE OF Z WILL BE ACCURATE TO FULL
6118C                  DOUBLE-PRECISION PROVIDED THE NUMBER
6119C                  OF DECIMAL PLACES IN THE LARGEST
6120C                  INTEGER PLUS THE NUMBER OF DECIMAL
6121C                  PLACES CARRIED IN DOUBLE-PRECISION DOES NOT
6122C                  EXCEED 60. DXC210 IS CALLED BY SUBROUTINE
6123C                  DXCON WHEN NECESSARY. THE USER SHOULD
6124C                  NEVER NEED TO CALL DXC210 DIRECTLY.
6125C
6126C     SUBROUTINE DXCON
6127C USAGE
6128C                  CALL DXCON(X,IX,IERROR)
6129C                  IF (IERROR.NE.0) RETURN
6130C DESCRIPTION
6131C                  CONVERTS (X,IX) = X*RADIX**IX
6132C                  TO DECIMAL FORM IN PREPARATION FOR
6133C                  PRINTING, SO THAT (X,IX) = X*10**IX
6134C                  WHERE 1/10 .LE. ABS(X) .LT. 1
6135C                  IS RETURNED, EXCEPT THAT IF
6136C                  (ABS(X),IX) IS BETWEEN RADIX**(-2L)
6137C                  AND RADIX**(2L) THEN THE REDUCED
6138C                  FORM WITH IX = 0 IS RETURNED.
6139C
6140C     SUBROUTINE DXRED
6141C USAGE
6142C                  CALL DXRED(X,IX,IERROR)
6143C                  IF (IERROR.NE.0) RETURN
6144C DESCRIPTION
6145C                  IF
6146C                  RADIX**(-2L) .LE. (ABS(X),IX) .LE. RADIX**(2L)
6147C                  THEN DXRED TRANSFORMS (X,IX) SO THAT IX=0.
6148C                  IF (X,IX) IS OUTSIDE THE ABOVE RANGE,
6149C                  THEN DXRED TAKES NO ACTION.
6150C                  THIS SUBROUTINE IS USEFUL IF THE
6151C                  RESULTS OF EXTENDED-RANGE CALCULATIONS
6152C                  ARE TO BE USED IN SUBSEQUENT ORDINARY
6153C                  DOUBLE-PRECISION CALCULATIONS.
6154C
6155C***REFERENCES  Smith, Olver and Lozier, Extended-Range Arithmetic and
6156C                 Normalized Legendre Polynomials, ACM Trans on Math
6157C                 Softw, v 7, n 1, March 1981, pp 93--105.
6158C***ROUTINES CALLED  I1MACH, XERMSG
6159C***COMMON BLOCKS    DXBLK1, DXBLK2, DXBLK3
6160C***REVISION HISTORY  (YYMMDD)
6161C   820712  DATE WRITTEN
6162C   881020  Revised to meet SLATEC CML recommendations.  (DWL and JMS)
6163C   901019  Revisions to prologue.  (DWL and WRB)
6164C   901106  Changed all specific intrinsics to generic.  (WRB)
6165C           Corrected order of sections in prologue and added TYPE
6166C           section.  (WRB)
6167C           CALLs to XERROR changed to CALLs to XERMSG.  (WRB)
6168C   920127  Revised PURPOSE section of prologue.  (DWL)
6169C***END PROLOGUE  DXSET
6170      INTEGER IRAD, NRADPL, NBITS
6171      DOUBLE PRECISION DZERO, DZEROX
6172      COMMON /DXBLK1/ NBITSF
6173      SAVE /DXBLK1/
6174      DOUBLE PRECISION RADIX, RADIXL, RAD2L, DLG10R
6175      INTEGER L, L2, KMAX
6176      COMMON /DXBLK2/ RADIX, RADIXL, RAD2L, DLG10R, L, L2, KMAX
6177      SAVE /DXBLK2/
6178      INTEGER NLG102, MLG102, LG102
6179      COMMON /DXBLK3/ NLG102, MLG102, LG102(21)
6180      SAVE /DXBLK3/
6181      INTEGER IFLAG
6182      SAVE IFLAG
6183C
6184      DIMENSION LOG102(20), LGTEMP(20)
6185      SAVE LOG102
6186C
6187C-----COMMON----------------------------------------------------------
6188C
6189      INCLUDE 'DPCOMC.INC'
6190      INCLUDE 'DPCOP2.INC'
6191C
6192C
6193C   LOG102 CONTAINS THE FIRST 60 DIGITS OF LOG10(2) FOR USE IN
6194C CONVERSION OF EXTENDED-RANGE NUMBERS TO BASE 10 .
6195      DATA LOG102 /301,029,995,663,981,195,213,738,894,724,493,026,768,
6196     * 189,881,462,108,541,310,428/
6197C
6198C FOLLOWING CODING PREVENTS DXSET FROM BEING EXECUTED MORE THAN ONCE.
6199C THIS IS IMPORTANT BECAUSE SOME SUBROUTINES (SUCH AS DXNRMP AND
6200C DXLEGF) CALL DXSET TO MAKE SURE EXTENDED-RANGE ARITHMETIC HAS
6201C BEEN INITIALIZED. THE USER MAY WANT TO PRE-EMPT THIS CALL, FOR
6202C EXAMPLE WHEN I1MACH IS NOT AVAILABLE. SEE CODING BELOW.
6203      DATA IFLAG /0/
6204C***FIRST EXECUTABLE STATEMENT  DXSET
6205      IERROR=0
6206      IF (IFLAG .NE. 0) RETURN
6207      IRADX = IRAD
6208      NRDPLC = NRADPL
6209      DZEROX = DZERO
6210      IMINEX = 0
6211      IMAXEX = 0
6212      NBITSX = NBITS
6213C FOLLOWING 5 STATEMENTS SHOULD BE DELETED IF I1MACH IS
6214C NOT AVAILABLE OR NOT CONFIGURED TO RETURN THE CORRECT
6215C MACHINE-DEPENDENT VALUES.
6216      IF (IRADX .EQ. 0) IRADX = I1MACH (10)
6217      IF (NRDPLC .EQ. 0) NRDPLC = I1MACH (14)
6218      IF (DZEROX .EQ. 0.0D0) IMINEX = I1MACH (15)
6219      IF (DZEROX .EQ. 0.0D0) IMAXEX = I1MACH (16)
6220      IF (NBITSX .EQ. 0) NBITSX = I1MACH (8)
6221      IF (IRADX.EQ.2) GO TO 10
6222      IF (IRADX.EQ.4) GO TO 10
6223      IF (IRADX.EQ.8) GO TO 10
6224      IF (IRADX.EQ.16) GO TO 10
6225CCCCC CALL XERMSG ('SLATEC', 'DXSET', 'IMPROPER VALUE OF IRAD', 201, 1)
6226      WRITE(ICOUT,901)
6227      CALL DPWRST('XXX','BUG ')
6228  901 FORMAT('***** ERROR FROM DXSET, IMPROPER VALUE OF IRAD.')
6229      IERROR=201
6230      RETURN
6231   10 CONTINUE
6232      LOG2R=0
6233      IF (IRADX.EQ.2) LOG2R = 1
6234      IF (IRADX.EQ.4) LOG2R = 2
6235      IF (IRADX.EQ.8) LOG2R = 3
6236      IF (IRADX.EQ.16) LOG2R = 4
6237      NBITSF=LOG2R*NRDPLC
6238      RADIX = IRADX
6239      DLG10R = LOG10(RADIX)
6240      IF (DZEROX .NE. 0.0D0) GO TO 14
6241      LX = MIN ((1-IMINEX)/2, (IMAXEX-1)/2)
6242      GO TO 16
6243   14 CONTINUE
6244      LX = INT(0.5D0*LOG10(DZEROX)/DLG10R)
6245C RADIX**(2*L) SHOULD NOT OVERFLOW, BUT REDUCE L BY 1 FOR FURTHER
6246C PROTECTION.
6247      LX=LX-1
6248   16 CONTINUE
6249      L2 = 2*LX
6250      IF (LX.GE.4) GO TO 20
6251CCCCC CALL XERMSG ('SLATEC', 'DXSET', 'IMPROPER VALUE OF DZERO', 202, 1)
6252      WRITE(ICOUT,902)
6253      CALL DPWRST('XXX','BUG ')
6254  902 FORMAT('***** ERROR FROM DXSET, IMPROPER VALUE OF DZERO.')
6255      IERROR=202
6256      RETURN
6257   20 CONTINUE
6258      L = LX
6259      RADIXL = RADIX**L
6260      RAD2L = RADIXL**2
6261C    IT IS NECESSARY TO RESTRICT NBITS (OR NBITSX) TO BE LESS THAN SOME
6262C UPPER LIMIT BECAUSE OF BINARY-TO-DECIMAL CONVERSION. SUCH CONVERSION
6263C IS DONE BY DXC210 AND REQUIRES A CONSTANT THAT IS STORED TO SOME FIXED
6264C PRECISION. THE STORED CONSTANT (LOG102 IN THIS ROUTINE) PROVIDES
6265C FOR CONVERSIONS ACCURATE TO THE LAST DECIMAL DIGIT WHEN THE INTEGER
6266C WORD LENGTH DOES NOT EXCEED 63. A LOWER LIMIT OF 15 BITS IS IMPOSED
6267C BECAUSE THE SOFTWARE IS DESIGNED TO RUN ON COMPUTERS WITH INTEGER WORD
6268C LENGTH OF AT LEAST 16 BITS.
6269      IF (15.LE.NBITSX .AND. NBITSX.LE.63) GO TO 30
6270CCCCC CALL XERMSG ('SLATEC', 'DXSET', 'IMPROPER VALUE OF NBITS', 203, 1)
6271      WRITE(ICOUT,913)
6272      CALL DPWRST('XXX','BUG ')
6273  913 FORMAT('***** ERROR FROM DXSET, IMPROPER VALUE OF NBITS.')
6274      IERROR=203
6275      RETURN
6276   30 CONTINUE
6277      KMAX = 2**(NBITSX-1) - L2
6278      NB = (NBITSX-1)/2
6279      MLG102 = 2**NB
6280      IF (1.LE.NRDPLC*LOG2R .AND. NRDPLC*LOG2R.LE.120) GO TO 40
6281CCCCC CALL XERMSG ('SLATEC', 'DXSET', 'IMPROPER VALUE OF NRADPL', 204,
6282CCCCC+             1)
6283      WRITE(ICOUT,903)
6284      CALL DPWRST('XXX','BUG ')
6285  903 FORMAT('***** ERROR FROM DXSET, IMPROPER VALUE OF NRADPL.')
6286      IERROR=204
6287      RETURN
6288   40 CONTINUE
6289      NLG102 = NRDPLC*LOG2R/NB + 3
6290      NP1 = NLG102 + 1
6291C
6292C   AFTER COMPLETION OF THE FOLLOWING LOOP, IC CONTAINS
6293C THE INTEGER PART AND LGTEMP CONTAINS THE FRACTIONAL PART
6294C OF LOG10(IRADX) IN RADIX 1000.
6295      IC = 0
6296      DO 50 II=1,20
6297        I = 21 - II
6298        IT = LOG2R*LOG102(I) + IC
6299        IC = IT/1000
6300        LGTEMP(I) = MOD(IT,1000)
6301   50 CONTINUE
6302C
6303C   AFTER COMPLETION OF THE FOLLOWING LOOP, LG102 CONTAINS
6304C LOG10(IRADX) IN RADIX MLG102. THE RADIX POINT IS
6305C BETWEEN LG102(1) AND LG102(2).
6306      LG102(1) = IC
6307      DO 80 I=2,NP1
6308        LG102X = 0
6309        DO 70 J=1,NB
6310          IC = 0
6311          DO 60 KK=1,20
6312            K = 21 - KK
6313            IT = 2*LGTEMP(K) + IC
6314            IC = IT/1000
6315            LGTEMP(K) = MOD(IT,1000)
6316   60     CONTINUE
6317          LG102X = 2*LG102X + IC
6318   70   CONTINUE
6319        LG102(I) = LG102X
6320   80 CONTINUE
6321C
6322C CHECK SPECIAL CONDITIONS REQUIRED BY SUBROUTINES...
6323      IF (NRDPLC.LT.L) GO TO 90
6324CCCCC CALL XERMSG ('SLATEC', 'DXSET', 'NRADPL .GE. L', 205, 1)
6325      WRITE(ICOUT,904)
6326      CALL DPWRST('XXX','BUG ')
6327  904 FORMAT('***** ERROR FROM DXSET, IMPROPER VALUE OF NRADPL.')
6328      IERROR=205
6329      RETURN
6330   90 IF (6*L.LE.KMAX) GO TO 100
6331CCCCC CALL XERMSG ('SLATEC', 'DXSET', '6*L .GT. KMAX', 206, 1)
6332      WRITE(ICOUT,905)
6333      CALL DPWRST('XXX','BUG ')
6334  905 FORMAT('***** ERROR FROM DXSET, IMPROPER VALUE OF L.')
6335      IERROR=206
6336      RETURN
6337  100 CONTINUE
6338      IFLAG = 1
6339      RETURN
6340      END
6341      SUBROUTINE D3DEDC(X,Y,Z,N,
6342     1                  X3DEYE,Y3DEYE,Z3DEYE,
6343     1                  D3DCXX,D3DCXY,D3DCXZ,
6344     1                  D3DCYX,D3DCYY,D3DCYZ,
6345     1                  D3DCZX,D3DCZY,D3DCZZ,
6346     1                  TERMXX,TERMXY,TERMXZ,
6347     1                  TERMYX,TERMYY,TERMYZ,
6348     1                  TERMZX,TERMZY,TERMZZ,
6349     1                  IBUGPL,ISUBRO,IERROR)
6350C
6351C     PURPOSE--COMPUTE DIRECTION COSINES
6352C              WHICH WILL BE NEEDED TO ROTATE
6353C              THE 3-D DATA CLOUD ONTO A 2-D PLANE.
6354C     NOTE--THE DN.. ARE DIRECTION NUMBERS.
6355C           THE DC.. ARE DIRECTION COSINES.
6356C     WRITTEN BY--JAMES J. FILLIBEN
6357C                 STATISTICAL ENGINEERING DIVISION
6358C                 INFORMATION TECHNOLOGY LABORATORY
6359C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6360C                 GAITHERSBURG, MD 20899
6361C                 PHONE--301-975-2855
6362C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6363C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6364C     LANGUAGE--ANSI FORTRAN (1977)
6365C     VERSION NUMBER--88/10
6366C     ORIGINAL VERSION--MARCH     1979.
6367C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1988.
6368C
6369C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6370C
6371      DIMENSION X(*)
6372      DIMENSION Y(*)
6373      DIMENSION Z(*)
6374C
6375      CHARACTER*4 IBUGPL
6376      CHARACTER*4 ISUBRO
6377      CHARACTER*4 IERROR
6378C
6379      CHARACTER*4 ISUBN1
6380      CHARACTER*4 ISUBN2
6381      CHARACTER*4 ISTEPN
6382C
6383C-----COMMON----------------------------------------------------------
6384C
6385      INCLUDE 'DPCOP2.INC'
6386C
6387C-----START POINT-----------------------------------------------------
6388C
6389      ISUBN1='D3DE'
6390      ISUBN2='DC  '
6391      IERROR='NO'
6392C
6393      EPS=0.0000001
6394C
6395      IF(IBUGPL.EQ.'OFF'.AND.ISUBRO.NE.'DEDC')GOTO90
6396      WRITE(ICOUT,999)
6397  999 FORMAT(1X)
6398      CALL DPWRST('XXX','BUG ')
6399      WRITE(ICOUT,51)
6400   51 FORMAT('***** AT THE BEGINNING OF D3DEDC--')
6401      CALL DPWRST('XXX','BUG ')
6402      WRITE(ICOUT,52)IBUGPL,ISUBRO,IERROR,N
6403   52 FORMAT('IBUGPL,ISUBRO,IERROR,N = ',3(A4,2X),I8)
6404      CALL DPWRST('XXX','BUG ')
6405      WRITE(ICOUT,61)X3DEYE,Y3DEYE,Z3DEYE
6406   61 FORMAT('X3DEYE, Y3DEYE, Z3DEYE  = ',3E15.7)
6407      CALL DPWRST('XXX','BUG ')
6408      DO70II=1,N
6409        WRITE(ICOUT,73)II,X(II),Y(II),Z(II)
6410   73   FORMAT('II,X(II),Y(II),Z(II) = ',I8,3G15.7)
6411        CALL DPWRST('XXX','BUG ')
6412   70 CONTINUE
6413   90 CONTINUE
6414C
6415C               *********************************************************
6416C               **  GENERAL DISCUSSION--                               **
6417C               **  DETERMINE (IN ORIGINAL COORDINATE SYSTEM VALUES)   **
6418C               **  WHERE THE DATA POINTS FALL ON THE VISUAL PLANE.    **
6419C               **  FOR EACH (XD,YD,ZD) DATA POINT,                    **
6420C               **  DETERMINE WHERE THE VISUAL RAY FROM                **
6421C               **  THE DATA POINT TO OUR EYE                          **
6422C               **  STRIKES THE VISUAL (PERSPECTIVE) PLANE.            **
6423C               **  THE VISUAL PLANE IS THAT PLANE                     **
6424C               **  WHICH IS NORMAL TO OUR EYE                         **
6425C               **  AND WHICH CONTAINS THE AVERAGE POINT (XM,YM,ZM).   **
6426C               **  THE EQUATION OF THE VISUAL PLANE IS                **
6427C               **  (X3DEYE-XM)(X-XM) + (Y3DEYE-YM)(Y-YM) +
6428C               **                    + (Z3DEYE-YM)(Z-ZM) = 0          **
6429C               **  WHERE X, Y, Z ARE THE DUMMY VARIABLES              **
6430C               **  REPRESENTING ANY POINT (X,Y,Z) ON THAT PLANE.      **
6431C               **  THIS EQUATION MUST BE SOLVED FOR X, Y, AND Z.      **
6432C               **  THE EQUATIONS OF THE LINE FROM THE DATA POINT
6433C               **  (XD,YD,ZD)
6434C               **  TO OUR EYE (X3DEYE,Y3DEYE,Z3DEYE) ARE
6435C               **  (X-XD)/(X3DEYE-XD) = (Y-YD)/(Y3DEYE-YD)
6436C               **                     = (Z-ZD)/(Z3DEYE-ZD)
6437C               **  WHERE (XD,YD,ZD) REPRESENTS A DATA POINT.           **
6438C               **  THE VISUAL PLANE EQUATION AND THE LINE EQUATIONS    **
6439C               **  MUST BE COMBINED TO SOLVE FOR THE VALUES (X,Y,Z)    **
6440C               **  ON THE VISUAL PLANE AS OUR EYE SEES THEM.           **
6441C               **********************************************************
6442C
6443C               **********************************************************
6444C               **  THE FINAL PLOT STATEMENT WILL INVOLVE
6445C               **  ONLY 2 VECTORS.
6446C               **  AT THE MOMENT, THE POINTS (XP,YP,ZP)
6447C               **  ON THE VISUAL PLANE ARE DEFINED
6448C               **  BY 3 COORDINATE VALUES.
6449C               **  TO REDUCE THE 3 COORDINATE VALUES
6450C               **  TO 2 COORDINATE VALUES,
6451C               **  WE MUST ROTATE THE VISUAL PLANE
6452C               **  SO THAT IT IS PARALLEL TO THE ORIGINAL XZ PLANE.
6453C               **  TO CARRY OUT SUCH A ROTATION, WE MUST
6454C               **  DETERMINE THE DIRECTION NUMBERS AND DIRECTION COSINES
6455C               **  OF THE NEW AXES IN TERMS OF THE OLD COORDINATE SYSTEM.
6456C               **  THE NEW Y AXIS WILL (BY CONSTRUCTION) BE
6457C               **  ON THE NORMAL LINE TRAVELING FROM
6458C               **  THE AVERAGE POINT (XM,YM,ZM) TO OUR EYE POINT
6459C               **  (X3DEYE,Y3DEYE,Z3DEYE)
6460C               **  AND WILL THEREFORE HAVE DIRECTIONS NUMBERS
6461C               **  X3DEYE, Y3DEYE, Z3DEYE
6462C               **  THE NEW Z AXIS WILL BE PERPENDICULAR TO THE NEW Y AXIS
6463C               **  AND WILL RESIDE IN THE PLANE CONTAINING THE
6464C               **  THE FOLLOWING 3 POINTS--
6465C               **      1) THE AVERAGE POINT (XM,YM,ZM)
6466C               **      2) THE EYE POINT (X3DEYE,Y3DEYE,Z3DEYE)
6467C               **      3) SOME POINT (SAY (XM,YM,ZM+1)) OF THE OLD Z AXIS
6468C               **         DISPLACED OVER SO AS TO EMANATE FROM (XM,YM,ZM).
6469C               **  THE ABOVE 3 POINTS DEFINE A VERTICAL PLANE.
6470C               **  THE PURPOSE OF THE VERTICAL PLANE IS TO DEFINE
6471C               **  WHICH DIRECTION IS 'UP' IN THE FINAL PICTURE.
6472C               **  THE EQUATION OF THE VERTICAL PLANE IS
6473C               **  (A-XM)(X-XM) + (B-YM)(Y-YM) + (C-ZM)(Z-ZM) = 0 .
6474C               **  THIS EQUATION MUST BE SOLVED FOR A, B, AND C.
6475C               **  WITHOUT LOSS OF GENERALITY, A MAY BE INITIALLY SET TO 1.
6476C               **  THE SOLUTION TURNS OUT TO BE
6477C               **      A = 1
6478C               **      B = -X3DEYE/Y3DEYE
6479C               **      C = 0
6480C               **  NOTE, HOWEVER, THAT THESE A, B, AND C VALUES
6481C               **  FOR THIS VERTICAL PLANE WILL BE IDENTICAL TO THE
6482C               **  DIRECTION NUMBERS FOR THE NORMAL TO THIS VERTICAL PLANE
6483C               **  WHICH IS IDENTICALLY THE NEW X AXIS
6484C               **  AND SO THE ABOVE A, B, AND C VALUES DEFINE THE DIRECTION
6485C               **  DIRECTION NUMBERS FOR THE NEW X AXIS.
6486C               **  TO SOLVE FOR THE DIRECTION NUMBERS FOR THE NEW Z AXIS,
6487C               **  WE SEEK 3 DIRECTION NUMBERS D, E, AND F
6488C               **  WHICH MUST BE PERPENDICULAR TO BOTH THE
6489C               **  NEW Y AXIS (WITH DIRECTION NUMBERS X3DEYE, Y3DEYE,
6490C               **  AND Z3DEYE)
6491C               **  AND THE NEW X AXIS (WITH DIRECTION NUMBERS A, B, AND C ABOVE
6492C               **  WITHOUT LOSS OF GENERALITY, D MAY BE INITIALLY SET TO 1.
6493C               **  NOTE THAT WHENEVER 2 LINES ARE PERPENDICULAR,
6494C               **  THE INNER PRODUCT OF THE DIRECTION NUMBERS MUST = 0.
6495C               **  WITHOUT LOSS OF GENERALITY, D MAY BE INITIALLY SET TO 1.
6496C               **  INCORPORATING THE 2 INNER PRODUCT EQUATIONS,
6497C               **  WE MAY SOLVE FOR E AND F.
6498C               **  THE SOLUTIONS TURN OUT TO BE
6499C               **      D = 1
6500C               **      E = Y3DEYE/X3DEYE
6501C               **      F = (-X3DEYE*X3DEYE - Y3DEYE*Y3DEYE) / (X3DEYE*Z3DEYE)
6502C               **
6503C               **  IN SUMMARY, THE DIRECTION NUMBERS FOR THE 3 NEW AXES
6504C               **  MAY BE WRITTEN AS
6505C               **      NEW X AXIS:  Y3DEYE       -X3DEYE     0
6506C               **      NEW Y AXIS:  X3DEYE       Y3DEYE      Z3DEYE
6507C               **      NEW Z AXIS:  -X3DEYE*Z3DEYE   -Y3DEYE*Z3DEYE
6508C               **                                        X3DEYE*X3DEYE+Y3DEYE
6509C               **  NOTE THAT BY INSPECTION WE SEE RETROSPECTIVELY
6510C               **  THAT THE 3 INNER PRODUCTS ALL = 0
6511C               **  AND SO THE 3 DEFINED AXES ARE ALL PERPENDICULAR
6512C               **  (AS THEY SHOULD BE).
6513C               **
6514C               **  THE CORRESPONDING DIRECTION COSINES
6515C               **  ARE GOTTEN BY NORMALIZATION TO UNITY;
6516C               **  LET US SYMBOLICALLY REPRESENT THEM BY--
6517C               **      D3DCXX   D3DCXY   D3DCXZ
6518C               **      D3DCYX   D3DCYY   D3DCYZ
6519C               **      D3DCZX   D3DCZY   D3DCZZ
6520C               **  THE ABOVE RESULTS WERE ACTUALLY ARRIVED AT
6521C               **  (AND ARE VALID FOR) BY DISPLACING THE OLD ORIGIN
6522C               **  FROM (0,0,0) TO (XM,YM,ZM).
6523C               **  THIS SIMPLIFIES THE EQUATIONS CONSIDERABLY.
6524C               **
6525C               **  GIVEN THAT WE NOW HAVE THE DIRECTION COSINES
6526C               **  OF THE NEW AXES IN TERMS OF THE OLD COORDINATES,
6527C               **  WE MAKE USE OF
6528C               **  EISENHART (COORDINATE GEOMETRY, PAGE 160) WHICH STATES
6529C               **  THAT THE LINEAR TRANSFORMATION THAT IS NEEDED TO CARRY OUT
6530C               **  THE ROTATION FROM THE VISUAL PLANE TO THE XZ PLANE
6531C               **  IS GIVEN BY
6532C               **      XT = XM + D3DCXX(X-XM) + D3DCXY(Y-YM) + D3DCXZ(Z-ZM)
6533C               **      YT = YM + D3DCYX(X-XM) + D3DCYY(Y-YM) + D3DCYZ(Z-ZM)
6534C               **      ZT = ZM + D3DCZX(X-XM) + D3DCZY(Y-YM) + D3DCZZ(Z-ZM)
6535C               **
6536C               **  NOTE THAT BY INSPECTION OF THE ABOVE TRANSFORMATION
6537C               **  IT IS SEEN THAT (XM,YM,ZM) IS MAPPED INTO (XM,YM,ZM)
6538C               **  (AS IT SHOULD BE).
6539C               **  NOTE ALSO THAT THE EYE POINT AND ANY POINT ALONG THE LINE
6540C               **  OF SIGHT WOULD HAVE BEEN MAPPED INTO (XM,YM,ZM)
6541C               **  AS IT SHOULD BE.
6542C               **  NOTE ALSO THAT ALL POINTS ON THE VISUAL PLANE
6543C               **  SINCE THEY SATISFY
6544C               **     (X3DEYE-XM)(X-XM) + (Y3DEYE-YM)(Y-YM) + (Z3DEYE-ZM)(Z-ZM)
6545C               **     = 0
6546C               **  GETS MAPPED INTO THE CONSTANT YT VALUE OF YT = YM
6547C               **  AND SO THE TRANSFORMED PLOT SURFACE IS ONE WHICH
6548C               **  IS PARALLEL TO THE XZ PLANE BUT IS DISPLACED
6549C               **  YM UNITS OUT FROM THE XZ PLANE.
6550C               **  THIS PLOT PLANE WILL CONTAIN THE POINT (XM,YM,ZM).
6551C               ****************************************************************
6552C
6553      ISTEPN='31'
6554      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DEDC')
6555     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6556C
6557      DNXX=Y3DEYE
6558      DNXY=-X3DEYE
6559      DNXZ=0.0
6560      DNYX=X3DEYE
6561      DNYY=Y3DEYE
6562      DNYZ=Z3DEYE
6563      DNZX=-X3DEYE*Z3DEYE
6564      DNZY=-Y3DEYE*Z3DEYE
6565      DNZZ=X3DEYE*X3DEYE+Y3DEYE*Y3DEYE
6566C
6567      ARGX=DNXX**2+DNXY**2+DNXZ**2
6568      ARGY=DNYX**2+DNYY**2+DNYZ**2
6569      ARGZ=DNZX**2+DNZY**2+DNZZ**2
6570      DENOMX=0.0
6571      DENOMY=0.0
6572      DENOMZ=0.0
6573      IF(ARGX.GT.0.0)DENOMX=SQRT(ARGX)
6574      IF(ARGY.GT.0.0)DENOMY=SQRT(ARGY)
6575      IF(ARGZ.GT.0.0)DENOMZ=SQRT(ARGZ)
6576C
6577C     ***** 15 LINES OF CODE TO CHECK FOR DIVISION BY 0 ADDED AUGUST 1983 *****
6578C
6579      D3DCXX=CPUMAX
6580      D3DCXY=CPUMAX
6581      D3DCXZ=CPUMAX
6582      IF(DENOMX.EQ.0.0)GOTO1119
6583      D3DCXX=DNXX/DENOMX
6584      D3DCXY=DNXY/DENOMX
6585      D3DCXZ=DNXZ/DENOMX
6586 1119 CONTINUE
6587C
6588      D3DCYX=CPUMAX
6589      D3DCYY=CPUMAX
6590      D3DCYZ=CPUMAX
6591      IF(DENOMY.EQ.0.0)GOTO1129
6592      D3DCYX=DNYX/DENOMY
6593      D3DCYY=DNYY/DENOMY
6594      D3DCYZ=DNYZ/DENOMY
6595 1129 CONTINUE
6596C
6597      D3DCZX=CPUMAX
6598      D3DCZY=CPUMAX
6599      D3DCZZ=CPUMAX
6600      IF(DENOMZ.EQ.0.0)GOTO1139
6601      D3DCZX=DNZX/DENOMZ
6602      D3DCZY=DNZY/DENOMZ
6603      D3DCZZ=DNZZ/DENOMZ
6604 1139 CONTINUE
6605C
6606C     THE FOLLOWING IS FROM EIDE ET AL (1985),
6607C     ENGINEERING GRAPHICS FUNDAMENTALS
6608C     PAGE 386-387, FORMULA 17.42.
6609C     ALPHA IS THE ANGLE FROM MY XY (= BOTTTOM) PLANE TO THE EYE VECTOR
6610C     BETA  IS THE ANGLE FROM MY YZ (= LEFT) TO THE EYE VECTOR
6611C     (NOTE DIFFERENCE HERE TO EIDE'S NOTATION, HIS Z = MY Y, & VV.)
6612C
6613      ARGALP=X3DEYE**2+Y3DEYE**2+Z3DEYE**2
6614      DENALP=0.0
6615      IF(ARGALP.GT.0.0)DENALP=SQRT(ARGALP)
6616      SINALP=Z3DEYE/DENALP
6617      COSALP=SQRT(1.0-SINALP**2)
6618C
6619      SINBET=0.0
6620      COSBET=1.0
6621      DENBET=0.0
6622      ARGBET=X3DEYE**2+Y3DEYE**2
6623      IF(ARGBET.LE.EPS)GOTO1159
6624      IF(ARGBET.GT.EPS)DENBET=SQRT(ARGBET)
6625      SINBET=X3DEYE/DENBET
6626      COSBET=SQRT(1.0-SINBET**2)
6627 1159 CONTINUE
6628C
6629      TERMXX=COSBET
6630      TERMXY=(-SINBET)
6631      TERMXZ=0.0
6632C
6633      TERMYX=COSALP*SINBET
6634      TERMYY=COSALP*COSBET
6635      TERMYZ=SINALP
6636C
6637      TERMZX=(-SINALP*SINBET)
6638      TERMZY=(-SINALP*COSBET)
6639      TERMZZ=COSALP
6640C
6641      GOTO9000
6642C
6643C               *****************
6644C               **  STEP 90--  **
6645C               **  EXIT.      **
6646C               *****************
6647C
6648 9000 CONTINUE
6649      IF(IBUGPL.EQ.'OFF'.AND.ISUBRO.NE.'DEDC')GOTO9090
6650      WRITE(ICOUT,999)
6651      CALL DPWRST('XXX','BUG ')
6652      WRITE(ICOUT,9011)
6653 9011 FORMAT('***** AT THE END       OF D3DEDC--')
6654      CALL DPWRST('XXX','BUG ')
6655      WRITE(ICOUT,9012)IBUGPL,ISUBRO,IERROR
6656 9012 FORMAT('IBUGPL,ISUBRO,IERROR = ',3A4)
6657      CALL DPWRST('XXX','BUG ')
6658      WRITE(ICOUT,9013)X3DEYE,Y3DEYE,Z3DEYE
6659 9013 FORMAT('X3DEYE,Y3DEYE,Z3DEYE = ',3E15.7)
6660      CALL DPWRST('XXX','BUG ')
6661      WRITE(ICOUT,9021)DNXX,DNXY,DNXZ
6662 9021 FORMAT('DNXX,DNXY,DNXZ = ',3E15.7)
6663      CALL DPWRST('XXX','BUG ')
6664      WRITE(ICOUT,9022)DNYX,DNYY,DNYZ
6665 9022 FORMAT('DNYX,DNYY,DNYZ = ',3E15.7)
6666      CALL DPWRST('XXX','BUG ')
6667      WRITE(ICOUT,9023)DNYX,DNYY,DNYZ
6668 9023 FORMAT('DNZX,DNZY,DNZZ = ',3E15.7)
6669      CALL DPWRST('XXX','BUG ')
6670      WRITE(ICOUT,9024)D3DCXX,D3DCXY,D3DCXZ
6671 9024 FORMAT('D3DCXX,D3DCXY,D3DCXZ = ',3E15.7)
6672      CALL DPWRST('XXX','BUG ')
6673      WRITE(ICOUT,9025)D3DCYX,D3DCYY,D3DCYZ
6674 9025 FORMAT('D3DCYX,D3DCYY,D3DCYZ = ',3E15.7)
6675      CALL DPWRST('XXX','BUG ')
6676      WRITE(ICOUT,9026)D3DCZX,D3DCZY,D3DCZZ
6677 9026 FORMAT('D3DCZX,D3DCZY,D3DCZZ = ',3E15.7)
6678      CALL DPWRST('XXX','BUG ')
6679      WRITE(ICOUT,9034)TERMXX,TERMXY,TERMXZ
6680 9034 FORMAT('TERMXX,TERMXY,TERMXZ = ',3E15.7)
6681      CALL DPWRST('XXX','BUG ')
6682      WRITE(ICOUT,9035)TERMYX,TERMYY,TERMYZ
6683 9035 FORMAT('TERMYX,TERMYY,TERMYZ = ',3E15.7)
6684      CALL DPWRST('XXX','BUG ')
6685      WRITE(ICOUT,9036)TERMZX,TERMZY,TERMZZ
6686 9036 FORMAT('TERMZX,TERMZY,TERMZZ = ',3E15.7)
6687      CALL DPWRST('XXX','BUG ')
6688 9090 CONTINUE
6689C
6690      RETURN
6691      END
6692      SUBROUTINE D3DELI(X,Y,Z,N,
6693     1XEYE0,YEYE0,ZEYE0,
6694     1XORIG,YORIG,ZORIG,
6695     1X3DMIN,Y3DMIN,Z3DMIN,
6696     1X3DMAX,Y3DMAX,Z3DMAX,
6697     1X3DMID,Y3DMID,Z3DMID,
6698     1X3DRAN,Y3DRAN,Z3DRAN,
6699     1X3DEYE,Y3DEYE,Z3DEYE,
6700     1X3DORI,Y3DORI,Z3DORI,
6701     1XPRIME,YPRIME,ZPRIME,
6702     1IBUGPL,ISUBRO,IERROR)
6703C
6704C     PURPOSE--COMPUTE MIN, MAX, MID, AND RANGE OF THE RAW DATA.
6705C              COMPUTE EYE COORDINATES.
6706C              COMPUTE ORIGIN COORDINATES
6707C              COMPUTE VISUAL EXTREME POINTS ON THE
6708C                 ORTHOGNORMAL PLANE THROUGH (X3DMID,Y3DMID,Z3DMID)
6709C     WRITTEN BY--JAMES J. FILLIBEN
6710C                 STATISTICAL ENGINEERING DIVISION
6711C                 INFORMATION TECHNOLOGY LABORATORY
6712C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6713C                 GAITHERSBURG, MD 20899
6714C                 PHONE--301-975-2855
6715C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6716C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6717C     LANGUAGE--ANSI FORTRAN (1977)
6718C     VERSION NUMBER--88/10
6719C     ORIGINAL VERSION--MARCH     1979.
6720C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1988.
6721C
6722C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6723C
6724      CHARACTER*4 IBUGPL
6725      CHARACTER*4 ISUBRO
6726      CHARACTER*4 IERROR
6727C
6728      CHARACTER*4 ISUBN1
6729      CHARACTER*4 ISUBN2
6730      CHARACTER*4 ISTEPN
6731C
6732C---------------------------------------------------------------------
6733C
6734      DIMENSION X(*)
6735      DIMENSION Y(*)
6736      DIMENSION Z(*)
6737C
6738      DIMENSION XPRIME(*)
6739      DIMENSION YPRIME(*)
6740      DIMENSION ZPRIME(*)
6741C
6742C---------------------------------------------------------------------
6743C
6744      INCLUDE 'DPCOP2.INC'
6745C
6746C-----START POINT-----------------------------------------------------
6747C
6748      ISUBN1='D3DE'
6749      ISUBN2='LI  '
6750      IERROR='NO'
6751C
6752      EPS=0.0000001
6753C
6754      IF(IBUGPL.NE.'ON'.AND.ISUBRO.NE.'DELI')GOTO90
6755      WRITE(ICOUT,999)
6756  999 FORMAT(1X)
6757      CALL DPWRST('XXX','BUG ')
6758      WRITE(ICOUT,51)
6759   51 FORMAT('***** AT THE BEGINNING OF D3DELI--')
6760      CALL DPWRST('XXX','BUG ')
6761      WRITE(ICOUT,52)IBUGPL,ISUBRO,IERROR
6762   52 FORMAT('IBUGPL,ISUBRO,IERROR = ',3A4)
6763      CALL DPWRST('XXX','BUG ')
6764      WRITE(ICOUT,61)XEYE0,YEYE0,ZEYE0
6765   61 FORMAT('XEYE0, YEYE0, ZEYE0  = ',3E15.7)
6766      CALL DPWRST('XXX','BUG ')
6767      WRITE(ICOUT,62)XORIG,YORIG,ZORIG
6768   62 FORMAT('XORIG, YORIG, ZORIG  = ',3E15.7)
6769      CALL DPWRST('XXX','BUG ')
6770      WRITE(ICOUT,71)N
6771   71 FORMAT('N = ',I8)
6772      CALL DPWRST('XXX','BUG ')
6773      DO72I=1,N
6774      WRITE(ICOUT,73)I,X(I),Y(I),Z(I)
6775   73 FORMAT('I,X(I),Y(I),Z(I) = ',I8,3E15.7)
6776      CALL DPWRST('XXX','BUG ')
6777   72 CONTINUE
6778   90 CONTINUE
6779C
6780C               ************************************************
6781C               **  STEP 11--                                 **
6782C               **  COMPUTE THE MIN AND MAX OF THE RAW DATA.  **
6783C               ************************************************
6784C
6785      ISTEPN='11'
6786      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DELI')
6787     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6788C
6789      X3DMIN=X(1)
6790      X3DMAX=X(1)
6791      Y3DMIN=Y(1)
6792      Y3DMAX=Y(1)
6793      Z3DMIN=Z(1)
6794      Z3DMAX=Z(1)
6795C
6796      DO1100I=1,N
6797      IF(X(I).LT.X3DMIN)X3DMIN=X(I)
6798      IF(X(I).GT.X3DMAX)X3DMAX=X(I)
6799      IF(Y(I).LT.Y3DMIN)Y3DMIN=Y(I)
6800      IF(Y(I).GT.Y3DMAX)Y3DMAX=Y(I)
6801      IF(Z(I).LT.Z3DMIN)Z3DMIN=Z(I)
6802      IF(Z(I).GT.Z3DMAX)Z3DMAX=Z(I)
6803 1100 CONTINUE
6804      X3DRAN=X3DMAX-X3DMIN
6805      Y3DRAN=Y3DMAX-Y3DMIN
6806      Z3DRAN=Z3DMAX-Z3DMIN
6807C
6808C               *******************************************
6809C               **  STEP 12--                            **
6810C               **  COMPUTE MIDRANGES FOR THE X, Y,      **
6811C               **  AND Z VECTORS.                       **
6812C               **  THIS WILL DEFINE THE 'MIDDLE POINT'  **
6813C               **  OF THE 3-D PLOT.                     **
6814C               *******************************************
6815C
6816      ISTEPN='12'
6817      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DELI')
6818     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6819C
6820      X3DMID=(X3DMIN+X3DMAX)/2.0
6821      Y3DMID=(Y3DMIN+Y3DMAX)/2.0
6822      Z3DMID=(Z3DMIN+Z3DMAX)/2.0
6823C
6824C               *******************************************
6825C               **  STEP 13--                            **
6826C               **  COMPUTE EYE COORDINATES.             88
6827C               **  IF (XEYE0,YEYE0,ZEYE0) IS UNDEFINED  **
6828C               **  (THAT IS,    = CPU MINIMUM),         **
6829C               **  THEN COMPUTE DEFAULT VALUES.         **
6830C               *******************************************
6831C
6832      ISTEPN='13'
6833      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DELI')
6834     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6835      X3DEYE=XEYE0
6836      Y3DEYE=YEYE0
6837      Z3DEYE=ZEYE0
6838      IF(XEYE0.LE.CPUMIN)X3DEYE=X3DMAX+3.0*X3DRAN
6839      IF(YEYE0.LE.CPUMIN)Y3DEYE=Y3DMAX+3.0*Y3DRAN
6840      IF(ZEYE0.LE.CPUMIN)Z3DEYE=Z3DMAX+3.0*Z3DRAN
6841C
6842C               ***************************************************
6843C               **  STEP 14--                                    **
6844C               **  COMPUTE THE ENDPONTS OF THE 3-PRONGED AXIS.  **
6845C               ***************************************************
6846C
6847      ISTEPN='14'
6848      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DELI')
6849     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6850C
6851      FACTOR=1.25
6852C
6853      X3DORI=XORIG
6854      Y3DORI=YORIG
6855      Z3DORI=ZORIG
6856      IF(XORIG.EQ.CPUMIN)X3DORI=X3DMIN
6857      IF(YORIG.EQ.CPUMIN)Y3DORI=Y3DMIN
6858      IF(ZORIG.EQ.CPUMIN)Z3DORI=Z3DMIN
6859C
6860      XPRIME(1)=X3DORI
6861      YPRIME(1)=Y3DORI
6862      ZPRIME(1)=Z3DORI
6863C
6864      XPRIME(2)=X3DORI+FACTOR*X3DRAN
6865      YPRIME(2)=Y3DORI
6866      ZPRIME(2)=Z3DORI
6867C
6868      XPRIME(3)=X3DORI
6869      YPRIME(3)=Y3DORI
6870      ZPRIME(3)=Z3DORI
6871C
6872      XPRIME(4)=X3DORI
6873      YPRIME(4)=Y3DORI+FACTOR*Y3DRAN
6874      ZPRIME(4)=Z3DORI
6875C
6876      XPRIME(5)=X3DORI
6877      YPRIME(5)=Y3DORI
6878      ZPRIME(5)=Z3DORI
6879C
6880      XPRIME(6)=X3DORI
6881      YPRIME(6)=Y3DORI
6882      ZPRIME(6)=Z3DORI+FACTOR*Z3DRAN
6883C
6884C               ***************************************************************
6885C               **  STEP 15--                                                **
6886C               **  DETERMINE 3 POINTS WHICH WILL DEFINE EXTREMAL POINTS     **
6887C               **  ON THE VISUAL PLANE.                                     **
6888C               **  THIS IS NEEDED SO THAT THE UNDERLYING GRAPHICS SOFTWARE  **
6889C               **  WILL SHOW A CLOSE POINT/CLOUD/FIGURE                     **
6890C               **  AS BEING LARGE IN APPEARANCE,                            **
6891C               **  AND A DISTANT POINT/CLOUD/FIGURE                         **
6892C               **  AS BEING SMALL IN APPEARANCE.                            **
6893C               **  SUCH A STEP IS NECESSARY BECAUSE THE                     **
6894C               **  UNDERLYING GRAPHICS SOFTWARE WILL BY DEFAULT             **
6895C               **  GIVE FULL RESOLUTION TO ALL DATA CLOUDS/FIGRUES          **
6896C               **  WHICH WILL HAVE THE NET EFFECT OF                        **
6897C               **  ALL DATA CLOUDS/FIGURES BEING LARGE.                     **
6898C               **  THE 3 CALCULATED EXTREMAL POINTS WILL NEVER              **
6899C               **  EXPLICITELY APPEAR ON THE PLOT (THEY WILL                **
6900C               **  HAVE A BLANK PLOT CHARAXCTER AUTOMATICALLY);             **
6901C               **  THERE EXISTENCE ONLY SERVES TO ASSURE THAT THE           **
6902C               **  PLOT WINDOW IS APPROPRIATELY STRETCHED.                  **
6903C               ***************************************************************
6904C
6905C               ************************************************************
6906C               **  STEP 15.1--                                           **
6907C               **  DEFINE THE PERIPHERAL VISION ANGLE.                   **
6908C               **  THIS HAS BEEN SET TO 60 DEGREES                       **
6909C               **  (30   DEGREES ABOVE THE NORMAL LINE                   **
6910C               **  TO THE VISUAL PLANE AND 30   DEGREES BELOW            **
6911C               **  THE NORMAL LINE TO THE PLANE).                        **
6912C               **  COMPUTE THE RADIUS OF THE CIRCLE ON THE VISUAL PLANE  **
6913C               **  WHICH IS JUST AT THE EDGE OF VISIBILITY--             **
6914C               **  THE LARGER THE PERIPHERAL ANGLE,                      **
6915C               **  THE LARGER THE RADIUS, AND VICE VERSA.                **
6916C               ************************************************************
6917C
6918      ISTEPN='15.1'
6919      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DELI')
6920     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6921C
6922      THETA=3.1415926/12.0
6923      ARG=(X3DEYE-X3DMID)**2+(Y3DEYE-Y3DMID)**2+(Z3DEYE-Z3DMID)**2
6924      DIST=0.0
6925      IF(ARG.GT.0.0)DIST=SQRT(ARG)
6926      RADIUS=DIST*TAN(THETA)
6927      IF(IBUGPL.NE.'ON'.AND.ISUBRO.NE.'DELI')GOTO1519
6928      WRITE(ICOUT,999)
6929      CALL DPWRST('XXX','BUG ')
6930      WRITE(ICOUT,1511)
6931 1511 FORMAT('***** FROM THE MIDDLE OF D3DELI--')
6932      CALL DPWRST('XXX','BUG ')
6933      WRITE(ICOUT,1512)THETA,ARG,DIST,RADIUS
6934 1512 FORMAT('THETA,ARG,DIST,RADIUS = ',4E15.7)
6935      CALL DPWRST('XXX','BUG ')
6936 1519 CONTINUE
6937C
6938C               ***********************************************************
6939C               **  STEP 15.2--                                          **
6940C               **  DETERMINE THE 2 POINTS ON THIS CIRCLE OF VISIBILITY  **
6941C               **  WHICH INTERSECT WITH THE X = X3DMID PLANE.             **
6942C               ***********************************************************
6943C
6944      ISTEPN='15.2'
6945      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DELI')
6946     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6947C
6948      XD=X3DMID
6949      YD1=Y3DMID
6950      YD2=Y3DMID
6951      ZD1=Z3DMID
6952      ZD2=Z3DMID
6953C
6954C     ***** 7 LINES OF CODE TO ADJUST FOR DIVISION BY 0 ADDED AUGUST 1983 *****
6955      XDEL=X3DEYE-X3DMID
6956      IF(XDEL.EQ.0.0)XDEL=EPS
6957      YDEL=Y3DEYE-Y3DMID
6958      IF(YDEL.EQ.0.0)YDEL=EPS
6959      ZDEL=Z3DEYE-Z3DMID
6960      IF(ZDEL.EQ.0.0)ZDEL=EPS
6961C
6962      DISC=1.0+(ZDEL/YDEL)**2
6963      DENOM=0.0
6964      IF(DISC.GT.0.0)DENOM=SQRT(DISC)
6965      IF(DISC.LT.0.0)GOTO1520
6966      ZD1=Z3DMID+RADIUS/DENOM
6967      ZD2=Z3DMID+RADIUS/(-DENOM)
6968      YD1=CPUMIN
6969      IF(YDEL.NE.0.0)YD1=Y3DMID-ZDEL*(ZD1-Z3DMID)/YDEL
6970      YD2=CPUMAX
6971      IF(YDEL.NE.0.0)YD2=Y3DMID-ZDEL*(ZD2-Z3DMID)/YDEL
6972 1520 CONTINUE
6973C
6974      XPRIME(7)=X3DMID
6975      YPRIME(7)=YD1
6976      ZPRIME(7)=ZD1
6977C
6978      XPRIME(8)=X3DMID
6979      YPRIME(8)=YD2
6980      ZPRIME(8)=ZD2
6981C
6982      IF(IBUGPL.NE.'ON'.AND.ISUBRO.NE.'DELI')GOTO1529
6983      WRITE(ICOUT,999)
6984      CALL DPWRST('XXX','BUG ')
6985      WRITE(ICOUT,1521)X3DMID,RADIUS
6986 1521 FORMAT('X3DMID,RADIUS = ',2E15.7)
6987      CALL DPWRST('XXX','BUG ')
6988      WRITE(ICOUT,1522)DISC,DENOM
6989 1522 FORMAT('DISC,DENOM = ',2E15.7)
6990      CALL DPWRST('XXX','BUG ')
6991      WRITE(ICOUT,1523)XD,YD1,YD2,ZD1,ZD2
6992 1523 FORMAT('XD,YD1,YD2,ZD1,ZD2 = ',5E15.7)
6993      CALL DPWRST('XXX','BUG ')
6994      WRITE(ICOUT,1524)XPRIME(7),YPRIME(7),ZPRIME(7)
6995 1524 FORMAT('XPRIME(7),YPRIME(7),ZPRIME(7)    = ',3E15.7)
6996      CALL DPWRST('XXX','BUG ')
6997      WRITE(ICOUT,1525)XPRIME(8),YPRIME(8),ZPRIME(8)
6998 1525 FORMAT('XPRIME(8),YPRIME(8),ZPRIME(8)    = ',3E15.7)
6999      CALL DPWRST('XXX','BUG ')
7000 1529 CONTINUE
7001C
7002C               ***********************************************************
7003C               **  STEP 15.3--                                          **
7004C               **  DETERMINE THE 2 POINTS ON THIS CIRCLE OF VISIBILITY  **
7005C               **  WHICH INTERSECT WITH THE Y = Y3DMID PLANE.             **
7006C               ***********************************************************
7007C
7008      ISTEPN='15.3'
7009      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DELI')
7010     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7011C
7012      XD1=X3DMID
7013      XD2=X3DMID
7014      YD=Y3DMID
7015      ZD1=Z3DMID
7016      ZD2=Z3DMID
7017C
7018C     ***** 3 LINES OF CODE TO CHECK FOR DIVISION BY 0 ADDED AUGUST 1983 *****
7019      DISC=CPUMAX
7020      IF(XDEL.NE.0.0)DISC=1.0+(ZDEL/XDEL)**2
7021      DENOM=0.0
7022      IF(DISC.GT.0.0)DENOM=SQRT(DISC)
7023      IF(DISC.LT.0.0)GOTO1530
7024      ZD1=Z3DMID+RADIUS/DENOM
7025      ZD2=Z3DMID+RADIUS/(-DENOM)
7026      XD1=CPUMIN
7027      IF(XDEL.NE.0.0)XD1=X3DMID-ZDEL*(ZD1-Z3DMID)/XDEL
7028      XD2=CPUMAX
7029      IF(XDEL.NE.0.0)XD2=X3DMID-ZDEL*(ZD2-Z3DMID)/XDEL
7030C
7031 1530 CONTINUE
7032      XPRIME(9)=XD1
7033      YPRIME(9)=Y3DMID
7034      ZPRIME(9)=ZD1
7035C
7036      XPRIME(10)=XD2
7037      YPRIME(10)=Y3DMID
7038      ZPRIME(10)=ZD2
7039C
7040      IF(IBUGPL.NE.'ON'.AND.ISUBRO.NE.'DELI')GOTO1539
7041      WRITE(ICOUT,999)
7042      CALL DPWRST('XXX','BUG ')
7043      WRITE(ICOUT,1531)Y3DMID,RADIUS
7044 1531 FORMAT('Y3DMID,RADIUS = ',2E15.7)
7045      CALL DPWRST('XXX','BUG ')
7046      WRITE(ICOUT,1532)DISC,DENOM
7047 1532 FORMAT('DISC,DENOM = ',2E15.7)
7048      CALL DPWRST('XXX','BUG ')
7049      WRITE(ICOUT,1533)XD1,XD2,YD,ZD1,ZD2
7050 1533 FORMAT('XD1,XD2,YD,ZD1,ZD2 = ',5E15.7)
7051      CALL DPWRST('XXX','BUG ')
7052      WRITE(ICOUT,1534)XPRIME(9),YPRIME(9),ZPRIME(9)
7053 1534 FORMAT('XPRIME(9),YPRIME(9),ZPRIME(9)    = ',3E15.7)
7054      CALL DPWRST('XXX','BUG ')
7055      WRITE(ICOUT,1535)XPRIME(10),YPRIME(10),ZPRIME(10)
7056 1535 FORMAT('XPRIME(10),YPRIME(10),ZPRIME(10) = ',3E15.7)
7057      CALL DPWRST('XXX','BUG ')
7058 1539 CONTINUE
7059C
7060C               ***********************************************************
7061C               **  STEP 15.4--                                          **
7062C               **  DETERMINE THE 2 POINTS ON THIS CIRCLE OF VISIBILITY  **
7063C               **  WHICH INTERSECT WITH THE Z = Z3DMID PLANE.             **
7064C               ***********************************************************
7065C
7066      ISTEPN='15.4'
7067      IF(IBUGPL.EQ.'ON'.OR.ISUBRO.EQ.'DELI')
7068     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7069C
7070      XD1=X3DMID
7071      XD2=X3DMID
7072      YD1=Y3DMID
7073      YD2=Y3DMID
7074      ZD=Z3DMID
7075C
7076C     ***** 3 LINES OF CODE TO CHECK FOR DIVISION BY 0 ADDED AUGUST 1983 *****
7077      DISC=CPUMAX
7078      IF(YDEL.NE.0.0)DISC=1.0+(XDEL/YDEL)**2
7079      DENOM=0.0
7080      IF(DISC.GT.0.0)DENOM=SQRT(DISC)
7081      IF(DISC.LT.0.0)GOTO1540
7082      XD1=X3DMID+RADIUS/DENOM
7083      XD2=X3DMID+RADIUS/(-DENOM)
7084      YD1=CPUMIN
7085      IF(YDEL.NE.0.0)YD1=Y3DMID-XDEL*(XD1-X3DMID)/YDEL
7086      YD2=CPUMAX
7087      IF(YDEL.NE.0.0)YD2=Y3DMID-XDEL*(XD2-X3DMID)/YDEL
7088C
7089 1540 CONTINUE
7090      XPRIME(11)=XD1
7091      YPRIME(11)=YD1
7092      ZPRIME(11)=Z3DMID
7093C
7094      XPRIME(12)=XD2
7095      YPRIME(12)=YD2
7096      ZPRIME(12)=Z3DMID
7097C
7098      IF(IBUGPL.NE.'ON'.AND.ISUBRO.NE.'DELI')GOTO1549
7099      WRITE(ICOUT,999)
7100      CALL DPWRST('XXX','BUG ')
7101      WRITE(ICOUT,1541)Z3DMID,RADIUS
7102 1541 FORMAT('Z3DMID,RADIUS = ',2E15.7)
7103      CALL DPWRST('XXX','BUG ')
7104      WRITE(ICOUT,1542)DISC,DENOM
7105 1542 FORMAT('DISC,DENOM = ',2E15.7)
7106      CALL DPWRST('XXX','BUG ')
7107      WRITE(ICOUT,1543)XD1,XD2,YD1,YD2,ZD
7108 1543 FORMAT('XD1,XD2,YD1,YD2,ZD = ',5E15.7)
7109      CALL DPWRST('XXX','BUG ')
7110      WRITE(ICOUT,1544)XPRIME(11),YPRIME(11),ZPRIME(11)
7111 1544 FORMAT('XPRIME(11),YPRIME(11),ZPRIME(11) = ',3E15.7)
7112      CALL DPWRST('XXX','BUG ')
7113      WRITE(ICOUT,1545)XPRIME(12),YPRIME(12),ZPRIME(12)
7114 1545 FORMAT('XPRIME(12),YPRIME(12),ZPRIME(12) = ',3E15.7)
7115      CALL DPWRST('XXX','BUG ')
7116 1549 CONTINUE
7117C
7118C               *****************
7119C               **  STEP 90--  **
7120C               **  EXIT.      **
7121C               *****************
7122C
7123      IF(IBUGPL.NE.'ON'.AND.ISUBRO.NE.'DELI')GOTO9090
7124      WRITE(ICOUT,999)
7125      CALL DPWRST('XXX','BUG ')
7126      WRITE(ICOUT,9011)
7127 9011 FORMAT('***** AT THE END       OF D3DELI--')
7128      CALL DPWRST('XXX','BUG ')
7129      WRITE(ICOUT,9012)IBUGPL,ISUBRO,IERROR
7130 9012 FORMAT('IBUGPL,ISUBRO,IERROR = ',3A4)
7131      CALL DPWRST('XXX','BUG ')
7132      WRITE(ICOUT,9021)N
7133 9021 FORMAT('N = ',I8)
7134      CALL DPWRST('XXX','BUG ')
7135      DO9022I=1,N
7136      WRITE(ICOUT,9023)I,X(I),Y(I),Z(I)
7137 9023 FORMAT('I,X(I),Y(I),Z(I) = ',I8,3E15.7)
7138      CALL DPWRST('XXX','BUG ')
7139 9022 CONTINUE
7140      WRITE(ICOUT,9031)X3DMIN,Y3DMIN,Z3DMIN
7141 9031 FORMAT('X3DMIN,Y3DMIN,Z3DMIN       = ',3E15.7)
7142      CALL DPWRST('XXX','BUG ')
7143      WRITE(ICOUT,9032)X3DMAX,Y3DMAX,Z3DMAX
7144 9032 FORMAT('X3DMAX,Y3DMAX,Z3DMAX       = ',3E15.7)
7145      CALL DPWRST('XXX','BUG ')
7146      WRITE(ICOUT,9033)X3DMID,Y3DMID,Z3DMID
7147 9033 FORMAT('X3DMID,Y3DMID,Z3DMID       = ',3E15.7)
7148      CALL DPWRST('XXX','BUG ')
7149      WRITE(ICOUT,9034)X3DRAN,Y3DRAN,Z3DRAN
7150 9034 FORMAT('X3DRAN,Y3DRAN,Z3DRAN = ',3E15.7)
7151      CALL DPWRST('XXX','BUG ')
7152      WRITE(ICOUT,9041)XEYE0,YEYE0,ZEYE0
7153 9041 FORMAT('XEYE0,YEYE0,ZEYE0    = ',3E15.7)
7154      CALL DPWRST('XXX','BUG ')
7155      WRITE(ICOUT,9042)X3DEYE,Y3DEYE,Z3DEYE
7156 9042 FORMAT('X3DEYE,Y3DEYE,Z3DEYE       = ',3E15.7)
7157      CALL DPWRST('XXX','BUG ')
7158      WRITE(ICOUT,9043)XORIG,YORIG,ZORIG
7159 9043 FORMAT('XORIG,YORIG,ZORIG    = ',3E15.7)
7160      CALL DPWRST('XXX','BUG ')
7161      WRITE(ICOUT,9044)X3DORI,Y3DORI,Z3DORI
7162 9044 FORMAT('X3DORI,Y3DORI,Z3DORI = ',3E15.7)
7163      CALL DPWRST('XXX','BUG ')
7164      DO9051I=1,12
7165      WRITE(ICOUT,9052)I,XPRIME(I),YPRIME(I),ZPRIME(I)
7166 9052 FORMAT('I,XPRIME(I),YPRIME(I),ZPRIME(I) = ',I8,3E15.7)
7167      CALL DPWRST('XXX','BUG ')
7168 9051 CONTINUE
7169 9090 CONTINUE
7170C
7171      RETURN
7172      END
7173      SUBROUTINE D3DEMD(X,Y,Z,TEMP,N,
7174     1XDELMN,YDELMN,ZDELMN)
7175C
7176C     PURPOSE--COMPUTE MINIMUM DIFFERENCE
7177C              BETWEEN X VALUES,
7178C              BETWEEN Y VALUES,
7179C              BETWEEN Z VALUES.
7180C
7181C     WRITTEN BY--JAMES J. FILLIBEN
7182C                 STATISTICAL ENGINEERING DIVISION
7183C                 INFORMATION TECHNOLOGY LABORATORY
7184C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7185C                 GAITHERSBURG, MD 20899
7186C                 PHONE--301-975-2855
7187C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7188C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7189C     LANGUAGE--ANSI FORTRAN (1977)
7190C     VERSION NUMBER--88/11
7191C     ORIGINAL VERSION--OCTOBER   1979.
7192C     UPDATED         --JULY      1989.  CHAR*4 STATEMETN FOR IWRITE
7193C
7194C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
7195C
7196CCCCC THE FOLLOWING LINE WAS ADDED JULY 1989
7197      CHARACTER*4 IWRITE
7198C
7199      CHARACTER*4 ISUBN1
7200      CHARACTER*4 ISUBN2
7201      CHARACTER*4 ISTEPN
7202C
7203C---------------------------------------------------------------------
7204C
7205      INCLUDE 'DPCOBE.INC'
7206C
7207      DIMENSION X(*)
7208      DIMENSION Y(*)
7209      DIMENSION Z(*)
7210      DIMENSION TEMP(*)
7211C
7212C---------------------------------------------------------------------
7213C
7214      INCLUDE 'DPCOP2.INC'
7215C
7216C-----START POINT-----------------------------------------------------
7217C
7218      ISUBN1='D3DE'
7219      ISUBN2='MD  '
7220C
7221      IF(IBUGG4.NE.'ON'.AND.ISUBG4.NE.'DEMD')GOTO90
7222      WRITE(ICOUT,999)
7223  999 FORMAT(1X)
7224      CALL DPWRST('XXX','BUG ')
7225      WRITE(ICOUT,51)
7226   51 FORMAT('***** AT THE BEGINNING OF D3DEMD--')
7227      CALL DPWRST('XXX','BUG ')
7228      WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4
7229   52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
7230      CALL DPWRST('XXX','BUG ')
7231      WRITE(ICOUT,71)N
7232   71 FORMAT('N = ',I8)
7233      CALL DPWRST('XXX','BUG ')
7234      DO72I=1,N
7235      WRITE(ICOUT,73)I,X(I),Y(I),Z(I)
7236   73 FORMAT('I,X(I),Y(I),Z(I) = ',I8,3E15.7)
7237      CALL DPWRST('XXX','BUG ')
7238   72 CONTINUE
7239   90 CONTINUE
7240C
7241C               ************************************************
7242C               **  STEP 11--                                 **
7243C               **  COMPUTE MINIMUM DIFFERENCES               **
7244C               ************************************************
7245C
7246      ISTEPN='11'
7247      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DEMD')
7248     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7249C
7250      IWRITE='OFF'
7251C
7252      XDELMN=CPUMAX
7253      CALL DISTIN(X,N,IWRITE,TEMP,NTEMP,IBUGG4,IERRG4)
7254      CALL SORT(TEMP,NTEMP,TEMP)
7255      IF(NTEMP.LE.1)XDELMN=0.0
7256      IF(NTEMP.LE.1)GOTO1190
7257      DO1100I=2,NTEMP
7258      IM1=I-1
7259      DEL=TEMP(I)-TEMP(IM1)
7260      IF(DEL.LE.0.0)GOTO1100
7261      IF(DEL.LT.XDELMN)XDELMN=DEL
7262 1100 CONTINUE
7263 1190 CONTINUE
7264C
7265      YDELMN=CPUMAX
7266      CALL DISTIN(Y,N,IWRITE,TEMP,NTEMP,IBUGG4,IERRG4)
7267      CALL SORT(TEMP,NTEMP,TEMP)
7268      IF(NTEMP.LE.1)YDELMN=0.0
7269      IF(NTEMP.LE.1)GOTO1290
7270      DO1200I=2,NTEMP
7271      IM1=I-1
7272      DEL=TEMP(I)-TEMP(IM1)
7273      IF(DEL.LE.0.0)GOTO1200
7274      IF(DEL.LT.YDELMN)YDELMN=DEL
7275 1200 CONTINUE
7276 1290 CONTINUE
7277C
7278      ZDELMN=CPUMAX
7279      CALL DISTIN(Z,N,IWRITE,TEMP,NTEMP,IBUGG4,IERRG4)
7280      CALL SORT(TEMP,NTEMP,TEMP)
7281      IF(NTEMP.LE.1)ZDELMN=0.0
7282      IF(NTEMP.LE.1)GOTO1390
7283      DO1300I=2,NTEMP
7284      IM1=I-1
7285      DEL=TEMP(I)-TEMP(IM1)
7286      IF(DEL.LE.0.0)GOTO1300
7287      IF(DEL.LT.ZDELMN)ZDELMN=DEL
7288 1300 CONTINUE
7289 1390 CONTINUE
7290C
7291C               *****************
7292C               **  STEP 90--  **
7293C               **  EXIT.      **
7294C               *****************
7295C
7296      IF(IBUGG4.NE.'ON'.AND.ISUBG4.NE.'DEMD')GOTO9090
7297      WRITE(ICOUT,999)
7298      CALL DPWRST('XXX','BUG ')
7299      WRITE(ICOUT,9011)
7300 9011 FORMAT('***** AT THE END       OF D3DEMD--')
7301      CALL DPWRST('XXX','BUG ')
7302      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4
7303 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
7304      CALL DPWRST('XXX','BUG ')
7305      WRITE(ICOUT,9021)N,NTEMP
7306 9021 FORMAT('N,NTEMP = ',2I8)
7307      CALL DPWRST('XXX','BUG ')
7308      DO9022I=1,N
7309      WRITE(ICOUT,9023)I,X(I),Y(I),Z(I),TEMP(I)
7310 9023 FORMAT('I,X(I),Y(I),Z(I),TEMP(I) = ',I8,4E15.7)
7311      CALL DPWRST('XXX','BUG ')
7312 9022 CONTINUE
7313      WRITE(ICOUT,9031)XDELMN,YDELMN,ZDELMN
7314 9031 FORMAT('XDELMN,YDELMN,ZDELMN = ',3E15.7)
7315      CALL DPWRST('XXX','BUG ')
7316 9090 CONTINUE
7317C
7318      RETURN
7319      END
7320      SUBROUTINE D3DRBA(XRAW,YRAW,ZRAW,NP,
7321     1PX,PY,PZ,PX2,PY2,PZ2,PX3,PY3,
7322     1ICASPL,ICAS3D,
7323     1ISORSW,
7324     1IBA2SW,ABA2WI,ABA2BA,
7325     1IBA2BL,IBA2BC,PBA2BT,
7326     1IBA2FS,IBA2FC,
7327     1IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT,
7328     1XDELMN,YDELMN,ZDELMN,
7329     1PXMIN,PXMAX,PYMIN,PYMAX,
7330     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
7331     1IX1TSC,IY1TSC)
7332C
7333C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
7334C              AND FOR EACH VALUE IN X(.), DRAW A BAR
7335C              (= VERTICAL OR HORIZONTAL BAR)
7336C              FROM THE BASE POINT ABA2BA
7337C              TO THE POINT Y(.).
7338C              DO SO FOR A SPECIFIED BAR LINE TYPE,
7339C              LINES COLOR, AND LINE THICKNESS.
7340C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
7341C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
7342C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
7343C           BACK IN THE MAIN ROUTINE.
7344C
7345C     WRITTEN BY--JAMES J. FILLIBEN
7346C                 STATISTICAL ENGINEERING DIVISION
7347C                 INFORMATION TECHNOLOGY LABORATORY
7348C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7349C                 GAITHERSBURG, MD 20899
7350C                 PHONE--301-975-2855
7351C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7352C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7353C     LANGUAGE--ANSI FORTRAN (1977)
7354C     VERSION NUMBER--87.5
7355C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
7356C     UPDATED         --MAY       1987.
7357C     UPDATED         --MARCH     1988.  TO FIX PROBLEM WHEREBY ONLY FIRST BAR
7358C                                        HAD PROPER PATTERN (STOLNICKI).
7359C     UPDATED         --SEPTEMBER 1988.  RENUMBER
7360C     UPDATED         --APRIL     1992.  ASP2BA  TO  ABA2BA
7361C     UPDATED         --APRIL     1992.  IPATTT TO IPATT
7362C
7363C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
7364C
7365      CHARACTER*4 ICASPL
7366      CHARACTER*4 ICAS3D
7367C
7368      CHARACTER*4 ISORSW
7369C
7370      CHARACTER*4 IBA2SW
7371      CHARACTER*4 IBA2BL
7372      CHARACTER*4 IBA2BC
7373      CHARACTER*4 IBA2FS
7374      CHARACTER*4 IBA2FC
7375      CHARACTER*4 IBA2PT
7376      CHARACTER*4 IBA2PL
7377      CHARACTER*4 IBA2PC
7378      CHARACTER*4 IBA2TY
7379      CHARACTER*4 IBA2DI
7380C
7381      CHARACTER*4 IX1TSC
7382      CHARACTER*4 IY1TSC
7383C
7384      CHARACTER*4 ITYPE
7385C
7386      CHARACTER*4 IFIG
7387      CHARACTER*4 IPATT
7388      CHARACTER*4 ICOL
7389CCCCC CHARACTER*4 ICOLF
7390CCCCC CHARACTER*4 ICOLP
7391      CHARACTER*4 IDIR
7392C
7393      CHARACTER*4 IHORPA
7394      CHARACTER*4 IVERPA
7395      CHARACTER*4 IDUPPA
7396      CHARACTER*4 IDDOPA
7397C
7398CCCCC CHARACTER*4 IFIGSV
7399C
7400      DIMENSION XRAW(*)
7401      DIMENSION YRAW(*)
7402      DIMENSION ZRAW(*)
7403      DIMENSION PX(*)
7404      DIMENSION PY(*)
7405      DIMENSION PZ(*)
7406      DIMENSION PX2(*)
7407      DIMENSION PY2(*)
7408      DIMENSION PZ2(*)
7409      DIMENSION PX3(*)
7410      DIMENSION PY3(*)
7411C
7412      DIMENSION XVECT(2)
7413      DIMENSION YVECT(2)
7414      DIMENSION ZVECT(2)
7415C
7416C-----COMMON----------------------------------------------------------
7417C
7418      INCLUDE 'DPCOGR.INC'
7419      INCLUDE 'DPCOBE.INC'
7420      INCLUDE 'DPCO3D.INC'
7421      INCLUDE 'DPCOP2.INC'
7422C
7423C-----START POINT-----------------------------------------------------
7424C
7425      J=0
7426      HOLD=1.0
7427      ABASE=0.0
7428      PBASE=0.0
7429      PBASE2=0.0
7430      PLEFT=0.0
7431      PRIGHT=0.0
7432      AWIDTH=0.0
7433      PWIDTH=0.0
7434C
7435      FXMIN=FX1MIN
7436      FXMAX=FX1MAX
7437      FYMIN=FY1MIN
7438      FYMAX=FY1MAX
7439C
7440      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO90
7441      WRITE(ICOUT,999)
7442  999 FORMAT(1X)
7443      CALL DPWRST('XXX','BUG ')
7444      WRITE(ICOUT,51)
7445   51 FORMAT('***** AT THE BEGINNING OF D3DRBA--')
7446      CALL DPWRST('XXX','BUG ')
7447      WRITE(ICOUT,52)NP
7448   52 FORMAT('NP = ',I8)
7449      CALL DPWRST('XXX','BUG ')
7450      WRITE(ICOUT,53)ICASPL,ICAS3D
7451   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
7452      CALL DPWRST('XXX','BUG ')
7453      WRITE(ICOUT,54)XDELMN,YDELMN,ZDELMN
7454   54 FORMAT('XDELMN,YDELMN,ZDELMN = ',3E15.7)
7455      CALL DPWRST('XXX','BUG ')
7456      IF(NP.LE.3)GOTO69
7457      DO65I=1,3
7458      WRITE(ICOUT,66)I,XRAW(I),YRAW(I),ZRAW(I)
7459   66 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
7460      CALL DPWRST('XXX','BUG ')
7461   65 CONTINUE
7462      NPM2=NP-2
7463      DO67I=NPM2,NP
7464      WRITE(ICOUT,68)I,XRAW(I),YRAW(I),ZRAW(I)
7465   68 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
7466      CALL DPWRST('XXX','BUG ')
7467   67 CONTINUE
7468   69 CONTINUE
7469      WRITE(ICOUT,70)ISORSW
7470   70 FORMAT('ISORSW = ',A4)
7471      CALL DPWRST('XXX','BUG ')
7472      WRITE(ICOUT,71)IBA2SW,ABA2WI,ABA2BA
7473   71 FORMAT('IBA2SW,ABA2WI,ABA2BA = ',A4,2X,2E15.7)
7474      CALL DPWRST('XXX','BUG ')
7475      WRITE(ICOUT,72)IBA2BL,IBA2BC,PBA2BT
7476   72 FORMAT('IBA2BL,IBA2BC,PBA2BT = ',A4,2X,A4,2X,E15.7)
7477      CALL DPWRST('XXX','BUG ')
7478      WRITE(ICOUT,73)IBA2FS,IBA2FC
7479   73 FORMAT('IBA2FS,IBA2FC = ',A4,2X,A4)
7480      CALL DPWRST('XXX','BUG ')
7481      WRITE(ICOUT,74)IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT
7482   74 FORMAT('IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT = ',
7483     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,2E15.7)
7484      CALL DPWRST('XXX','BUG ')
7485      WRITE(ICOUT,81)X3DEYE,Y3DEYE,Z3DEYE
7486   81 FORMAT('X3DEYE,Y3DEYE,Z3DEYE = ',3E15.7)
7487      CALL DPWRST('XXX','BUG ')
7488      WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
7489   84 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
7490      CALL DPWRST('XXX','BUG ')
7491      WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
7492   85 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
7493      CALL DPWRST('XXX','BUG ')
7494      WRITE(ICOUT,86)IX1TSC,IY1TSC
7495   86 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
7496      CALL DPWRST('XXX','BUG ')
7497      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
7498   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
7499      CALL DPWRST('XXX','BUG ')
7500   90 CONTINUE
7501C
7502C               *************************************************
7503C               **  STEP 11--                                  **
7504C               **  IF CALLED FOR, SORT THE DATA               **
7505C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
7506C               *************************************************
7507C
7508      IDIR=IBA2DI
7509C
7510      IF(ISORSW.EQ.'OFF')GOTO1150
7511      IF(ICASPL.EQ.'PIEC')GOTO1150
7512      IF(ICAS3D.EQ.'ON')GOTO1150
7513      IF(ICASPL.EQ.'CONT')GOTO1150
7514C
7515C
7516C     12/2009: NEED TO MODIFY THIS SORT LINE.
7517CCCCC CALL SORTC(X,Y,NP,PX,PY)
7518      GOTO1190
7519C
7520 1150 CONTINUE
7521      DO1160I=1,NP
7522      PX(I)=XRAW(I)
7523      PY(I)=YRAW(I)
7524      PZ(I)=ZRAW(I)
7525 1160 CONTINUE
7526      GOTO1190
7527C
7528 1190 CONTINUE
7529C
7530C               ************************************************
7531C               **  STEP 12--                                 **
7532C               **  IF A LOG SCALE PLOT IS CALLED FOR,        **
7533C               **  CHECK THAT ALL DATA POINTS ARE POSITIVE.  **
7534C               ************************************************
7535C
7536      IF(IX1TSC.EQ.'LOG')GOTO1210
7537      GOTO1290
7538C
7539 1210 CONTINUE
7540      IF(IDIR.EQ.'H')GOTO1215
7541      GOTO1219
7542 1215 CONTINUE
7543CCCCC THE FOLLOWING 2 LINES WERE FIXED    APRIL 1992 (ALAN)
7544CCCCC IF(ASP2BA.LE.0.0)HOLD=ASP2BA
7545CCCCC IF(ASP2BA.LE.0.0)GOTO1250
7546      IF(ABA2BA.LE.0.0)HOLD=ABA2BA
7547      IF(ABA2BA.LE.0.0)GOTO1250
7548 1219 CONTINUE
7549C
7550      IF(ISORSW.EQ.'ON')GOTO1220
7551      GOTO1230
7552C
7553 1220 CONTINUE
7554      J=1
7555      IF(PX(J).LE.0.0)GOTO1250
7556      GOTO1290
7557C
7558 1230 CONTINUE
7559      DO1235I=1,NP
7560      J=I
7561      IF(PX(J).LE.0.0)GOTO1250
7562 1235 CONTINUE
7563      GOTO1290
7564C
7565 1250 CONTINUE
7566      WRITE(ICOUT,999)
7567      CALL DPWRST('XXX','BUG ')
7568      WRITE(ICOUT,1251)
7569 1251 FORMAT('***** ERROR IN D3DRBA--')
7570      CALL DPWRST('XXX','BUG ')
7571      WRITE(ICOUT,1252)
7572 1252 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
7573      CALL DPWRST('XXX','BUG ')
7574      WRITE(ICOUT,1253)
7575 1253 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
7576      CALL DPWRST('XXX','BUG ')
7577      WRITE(ICOUT,1254)
7578 1254 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
7579      CALL DPWRST('XXX','BUG ')
7580      WRITE(ICOUT,1255)
7581 1255 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
7582      CALL DPWRST('XXX','BUG ')
7583      WRITE(ICOUT,1256)PX(J)
7584 1256 FORMAT('      THE VALUE = ',E15.7)
7585      CALL DPWRST('XXX','BUG ')
7586      WRITE(ICOUT,1257)
7587 1257 FORMAT('      THIS VALUE CAME FROM THE ')
7588      CALL DPWRST('XXX','BUG ')
7589      WRITE(ICOUT,1258)
7590 1258 FORMAT('      HORIZONTAL AXIS VARIABLE.')
7591      CALL DPWRST('XXX','BUG ')
7592      WRITE(ICOUT,1259)
7593 1259 FORMAT('      CORRECTIVE ACTION--')
7594      CALL DPWRST('XXX','BUG ')
7595      WRITE(ICOUT,1260)
7596 1260 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
7597      CALL DPWRST('XXX','BUG ')
7598      IERRG4='YES'
7599      GOTO9000
7600C
7601 1290 CONTINUE
7602C
7603      IF(IY1TSC.EQ.'LOG')GOTO1310
7604      GOTO1390
7605C
7606 1310 CONTINUE
7607      IF(IDIR.EQ.'V')GOTO1315
7608      GOTO1319
7609 1315 CONTINUE
7610CCCCC THE FOLLOWING 2 LINES WERE FIXED    APRIL 1992 (ALAN)
7611CCCCC IF(ASP2BA.LE.0.0)HOLD=ASP2BA
7612CCCCC IF(ASP2BA.LE.0.0)GOTO1350
7613      IF(ABA2BA.LE.0.0)HOLD=ABA2BA
7614      IF(ABA2BA.LE.0.0)GOTO1350
7615 1319 CONTINUE
7616C
7617      IF(ISORSW.EQ.'ON')GOTO1320
7618      GOTO1330
7619C
7620 1320 CONTINUE
7621      J=1
7622      IF(PY(J).LE.0.0)HOLD=PY(J)
7623      IF(PY(J).LE.0.0)GOTO1350
7624      GOTO1390
7625C
7626 1330 CONTINUE
7627      DO1335I=1,NP
7628      J=I
7629      IF(PY(J).LE.0.0)HOLD=PY(J)
7630      IF(PY(J).LE.0.0)GOTO1350
7631 1335 CONTINUE
7632      GOTO1390
7633C
7634 1350 CONTINUE
7635      WRITE(ICOUT,999)
7636      CALL DPWRST('XXX','BUG ')
7637      WRITE(ICOUT,1351)
7638 1351 FORMAT('***** ERROR IN D3DRBA--')
7639      CALL DPWRST('XXX','BUG ')
7640      WRITE(ICOUT,1352)
7641 1352 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
7642      CALL DPWRST('XXX','BUG ')
7643      WRITE(ICOUT,1353)
7644 1353 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
7645      CALL DPWRST('XXX','BUG ')
7646      WRITE(ICOUT,1354)
7647 1354 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
7648      CALL DPWRST('XXX','BUG ')
7649      WRITE(ICOUT,1355)
7650 1355 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
7651      CALL DPWRST('XXX','BUG ')
7652      WRITE(ICOUT,1356)HOLD
7653 1356 FORMAT('      THE VALUE = ',E15.7)
7654      CALL DPWRST('XXX','BUG ')
7655      WRITE(ICOUT,1357)
7656 1357 FORMAT('      THIS VALUE CAME FROM THE ')
7657      CALL DPWRST('XXX','BUG ')
7658      WRITE(ICOUT,1358)
7659 1358 FORMAT('      VERTICAL AXIS VARIABLE.')
7660      CALL DPWRST('XXX','BUG ')
7661      WRITE(ICOUT,1359)
7662 1359 FORMAT('      CORRECTIVE ACTION--')
7663      CALL DPWRST('XXX','BUG ')
7664      WRITE(ICOUT,1360)
7665 1360 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
7666      CALL DPWRST('XXX','BUG ')
7667      IERRG4='YES'
7668      GOTO9000
7669C
7670 1390 CONTINUE
7671C
7672C               ******************************************
7673C               **  STEP 40--                           **
7674C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
7675C               **  TRANSFORM THE DATA                  **
7676C               ******************************************
7677C
7678      ABASE=ABA2BA
7679      AWIDTH=ABA2WI
7680C
7681      WIDTHX=AWIDTH
7682      IF(WIDTHX.EQ.CPUMIN.AND.XDELMN.LE.0.0)WIDTHX=1.0
7683      IF(WIDTHX.EQ.CPUMIN.AND.XDELMN.GT.0.0)WIDTHX=XDELMN
7684      WIDTHY=AWIDTH
7685      IF(WIDTHY.EQ.CPUMIN.AND.YDELMN.LE.0.0)WIDTHY=1.0
7686      IF(WIDTHY.EQ.CPUMIN.AND.YDELMN.GT.0.0)WIDTHY=YDELMN
7687      WIDTHZ=AWIDTH
7688      IF(WIDTHZ.EQ.CPUMIN.AND.ZDELMN.LE.0.0)WIDTHZ=1.0
7689      IF(WIDTHZ.EQ.CPUMIN.AND.ZDELMN.GT.0.0)WIDTHZ=ZDELMN
7690C
7691      IF(IX1TSC.EQ.'LOG')GOTO4010
7692      GOTO4019
7693 4010 CONTINUE
7694      IF(IDIR.EQ.'H')ABASE=LOG10(ABASE)
7695      DO4015I=1,NP
7696      PX(I)=LOG10(PX(I))
7697 4015 CONTINUE
7698 4019 CONTINUE
7699C
7700      IF(IY1TSC.EQ.'LOG')GOTO4020
7701      GOTO4029
7702 4020 CONTINUE
7703      IF(IDIR.EQ.'V')ABASE=LOG10(ABASE)
7704      DO4025I=1,NP
7705      PY(I)=LOG10(PY(I))
7706 4025 CONTINUE
7707 4029 CONTINUE
7708C
7709C               *******************************
7710C               **  STEP 60--                **
7711C               **  PREPARE TO MAKE VARIOUS  **
7712C               **  LINE SETTINGS            **
7713C               *******************************
7714C
7715      ITYPE='LINE'
7716C
7717C               **********************************************
7718C               **  STEP 61--                               **
7719C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
7720C               **  OF THE LINE PATTERN                     **
7721C               **  INTO A NUMERIC REPRESENTATION           **
7722C               **  WHICH CAN BE UNDERSTOOD BY THE          **
7723C               **  GRAPHICS DEVICE.                        **
7724C               **********************************************
7725C
7726      IPATT=IBA2BL
7727      CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
7728     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
7729C
7730C               *******************************
7731C               **  STEP 62--                **
7732C               **  SET THE LINE PATTERN     **
7733C               **  ON THE GRAPHICS DEVICE.  **
7734C               *******************************
7735C
7736      CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
7737     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
7738C
7739C               **********************************************
7740C               **  STEP 63--                               **
7741C               **  TRANSLATE THE  DESIRED                  **
7742C               **  LINE THICKNESS                          **
7743C               **  INTO A NUMERIC REPRESENTATION           **
7744C               **  WHICH CAN BE UNDERSTOOD BY THE          **
7745C               **  GRAPHICS DEVICE.                        **
7746C               **********************************************
7747C
7748      PTHICK=PBA2BT
7749      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
7750C
7751C               *******************************
7752C               **  STEP 64--                **
7753C               **  SET THE LINE THICKNESS   **
7754C               **  ON THE GRAPHICS DEVICE.  **
7755C               *******************************
7756C
7757      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
7758C
7759C               **********************************************
7760C               **  STEP 65--                               **
7761C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
7762C               **  OF THE LINE COLOR                       **
7763C               **  INTO A NUMERIC REPRESENTATION           **
7764C               **  WHICH CAN BE UNDERSTOOD BY THE          **
7765C               **  GRAPHICS DEVICE.                        **
7766C               **********************************************
7767C
7768      ICOL=IBA2BC
7769      CALL GRTRCO(ITYPE,ICOL,JCOL)
7770C
7771C               *******************************
7772C               **  STEP 66--                **
7773C               **  SET THE LINE COLOR       **
7774C               **  ON THE GRAPHICS DEVICE.  **
7775C               *******************************
7776C
7777      CALL GRSECO(ITYPE,ICOL,JCOL)
7778C
7779C               **************************************************
7780C               **  STEP 71--                                   **
7781C               **  FOR EACH RAW 3-D DATA POINT--               **
7782C               **     1) MAKE THE BAR                          **
7783C               **     2) TRANSLATE IT TO 2 DIMENSIONS          **
7784C               **     3) TRANSLATE IT TO 0-100 UNITS           **
7785C               **     4) CLIP THE BAR   IF NEEDED              **
7786C               **     5) DRAW OUT THE BAR                      **
7787C               **************************************************
7788C
7789      IFIG='GENE'
7790C
7791      FXMIN=FX1MIN
7792      FXMAX=FX1MAX
7793      IF(IX1TSC.EQ.'LOG')FXMIN=LOG10(FX1MIN)
7794      IF(IX1TSC.EQ.'LOG')FXMAX=LOG10(FX1MAX)
7795C
7796      FYMIN=FY1MIN
7797      FYMAX=FY1MAX
7798      IF(IY1TSC.EQ.'LOG')FYMIN=LOG10(FY1MIN)
7799      IF(IY1TSC.EQ.'LOG')FYMAX=LOG10(FY1MAX)
7800C
7801      FXRANG=FXMAX-FXMIN
7802      FYRANG=FYMAX-FYMIN
7803      PXRANG=PXMAX-PXMIN
7804      PYRANG=PYMAX-PYMIN
7805C
7806C
7807      BASEX=ABASE
7808      BASEY=ABASE
7809      BASEZ=ABASE
7810C
7811      DO7100I=1,NP
7812C
7813      CALL D3MKBA(PX,PY,PZ,NP,I,
7814     1IDIR,
7815     1WIDTHX,WIDTHY,WIDTHZ,
7816     1BASEX,BASEY,BASEZ,
7817     1XVECT,YVECT,ZVECT,IXNEAR,IXFAR,IYNEAR,IYFAR,IZNEAR,IZFAR,
7818     1PX2,PY2,PZ2,NP2)
7819C
7820      CALL D3TR32(PX2,PY2,PZ2,NP2,PX3,PY3,NP3)
7821C
7822      CALL D3TRXP(PX3,PY3,NP3,IDIR,ABASE,
7823     1FXMIN,FXMAX,FXRANG,FYMIN,FYMAX,FYRANG,
7824     1PXMIN,PXMAX,PXRANG,PYMIN,PYMAX,PYRANG,
7825     1PX3,PY3,NP3,PBASE)
7826C
7827      CALL DPSQUE(PX3,PY3,NP3,
7828     1PXMIN,PXMAX,PYMIN,PYMAX)
7829C
7830      CALL GRDRPL(PX3,PY3,NP3,
7831CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
7832CCCCC1IFIG,IPATTT,PTHICK,ICOL,
7833     1IFIG,IPATT,PTHICK,ICOL,
7834     1JPATTT,JTHICK,PTHIC2,JCOL)
7835C
7836 7100 CONTINUE
7837C
7838C               *****************
7839C               **  STEP 90--  **
7840C               **  EXIT       **
7841C               *****************
7842C
7843 9000 CONTINUE
7844      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO9090
7845      WRITE(ICOUT,999)
7846      CALL DPWRST('XXX','BUG ')
7847      WRITE(ICOUT,9011)
7848 9011 FORMAT('***** AT THE END       OF D3DRBA--')
7849      CALL DPWRST('XXX','BUG ')
7850      WRITE(ICOUT,9012)NP
7851 9012 FORMAT('NP = ',I8)
7852      CALL DPWRST('XXX','BUG ')
7853      WRITE(ICOUT,9013)ICASPL,ICAS3D
7854 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
7855      CALL DPWRST('XXX','BUG ')
7856      WRITE(ICOUT,9014)ABASE,HOLD,PBASE,PBASE2,PLEFT,PRIGHT
7857 9014 FORMAT('ABASE,HOLD,PBASE,PBASE2,PLEFT,PRIGHT = ',6E15.7)
7858      CALL DPWRST('XXX','BUG ')
7859      WRITE(ICOUT,9015)XDELMN,YDELMN,ZDELMN,AWIDTH,PWIDTH
7860 9015 FORMAT('XDELMN,YDELMN,ZDELMN,AWIDTH,PWIDTH = ',5E15.7)
7861      CALL DPWRST('XXX','BUG ')
7862      IF(NP.LE.3)GOTO9029
7863      DO9025I=1,3
7864      WRITE(ICOUT,9026)I,XRAW(I),YRAW(I),ZRAW(I)
7865 9026 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
7866      CALL DPWRST('XXX','BUG ')
7867 9025 CONTINUE
7868      NPM2=NP-2
7869      DO9027I=NPM2,NP
7870      WRITE(ICOUT,9028)I,XRAW(I),YRAW(I),ZRAW(I)
7871 9028 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
7872      CALL DPWRST('XXX','BUG ')
7873 9027 CONTINUE
7874 9029 CONTINUE
7875      WRITE(ICOUT,9030)ISORSW
7876 9030 FORMAT('ISORSW = ',A4)
7877      CALL DPWRST('XXX','BUG ')
7878      WRITE(ICOUT,9031)IBA2SW,ABA2WI,ABA2BA
7879 9031 FORMAT('IBA2SW,ABA2WI,ABA2BA = ',A4,2X,2E15.7)
7880      CALL DPWRST('XXX','BUG ')
7881      WRITE(ICOUT,9032)IBA2BL,IBA2BC,PBA2BT
7882 9032 FORMAT('IBA2BL,IBA2BC,PBA2BT = ',A4,2X,A4,2X,E15.7)
7883      CALL DPWRST('XXX','BUG ')
7884      WRITE(ICOUT,9033)IBA2FS,IBA2FC
7885 9033 FORMAT('IBA2FS,IBA2FC = ',A4,2X,A4)
7886      CALL DPWRST('XXX','BUG ')
7887      WRITE(ICOUT,9034)IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT
7888 9034 FORMAT('IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT = ',
7889     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,2E15.7)
7890      CALL DPWRST('XXX','BUG ')
7891      WRITE(ICOUT,9041)X3DEYE,Y3DEYE,Z3DEYE
7892 9041 FORMAT('X3DEYE,Y3DEYE,Z3DEYE    = ',3E15.7)
7893      CALL DPWRST('XXX','BUG ')
7894      WRITE(ICOUT,9042)WIDTHX,WIDTHY,WIDTHZ
7895 9042 FORMAT('WIDTHX,WIDTHY,WIDTHZ = ',3E15.7)
7896      CALL DPWRST('XXX','BUG ')
7897      WRITE(ICOUT,9043)BASEX,BASEY,BASEZ
7898 9043 FORMAT('BASEX,BASEY,BASEZ    = ',3E15.7)
7899      CALL DPWRST('XXX','BUG ')
7900      WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
7901 9044 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
7902      CALL DPWRST('XXX','BUG ')
7903      WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
7904 9045 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
7905      CALL DPWRST('XXX','BUG ')
7906      WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
7907 9046 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
7908      CALL DPWRST('XXX','BUG ')
7909      WRITE(ICOUT,9047)IX1TSC,IY1TSC
7910 9047 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
7911      CALL DPWRST('XXX','BUG ')
7912      WRITE(ICOUT,9051)IFIG
7913 9051 FORMAT('IFIG = ',A4)
7914      CALL DPWRST('XXX','BUG ')
7915      WRITE(ICOUT,9052)IPATT,JPATT
7916 9052 FORMAT('IPATT,JPATT = ',A4,I8)
7917      CALL DPWRST('XXX','BUG ')
7918      WRITE(ICOUT,9053)PTHICK,JTHICK,PTHIC2
7919 9053 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
7920      CALL DPWRST('XXX','BUG ')
7921      WRITE(ICOUT,9054)ICOL,JCOL,IDIR
7922 9054 FORMAT('ICOL,JCOL,IDIR = ',A4,I8,2X,A4)
7923      CALL DPWRST('XXX','BUG ')
7924      WRITE(ICOUT,9055)ITYPE
7925 9055 FORMAT('ITYPE = ',A4)
7926      CALL DPWRST('XXX','BUG ')
7927      WRITE(ICOUT,9069)IBUGG4,ISUBG4,IERRG4
7928 9069 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
7929      CALL DPWRST('XXX','BUG ')
7930 9090 CONTINUE
7931C
7932      RETURN
7933      END
7934      SUBROUTINE D3DRCH(XRAW,YRAW,ZRAW,PX,PY,PZ,NP,PY2,PX2,NP2,
7935     1X3D2,
7936     1ICASPL,ICAS3D,
7937     1ISORSW,
7938     1ICH2PA,ICH2FO,ICH2CA,ICH2JU,ICH2DI,ACH2AN,ICH2FI,ICH2CO,
7939     1PCH2HE,PCH2WI,PCH2TH,PCH2HO,PCH2VO,
7940     1ITEXSP,
7941     1PXMIN,PXMAX,PYMIN,PYMAX,
7942     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
7943     1IX1TSC,IY1TSC,
7944     1IMPSW2,AMPSCH,AMPSCW)
7945C
7946C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
7947C              DRAW A CHARACTER TRACE OF Y(.) VERSUS X(.),
7948C              THAT IS, DRAW A SPECIFIED MARKER (= CHARACTER) TYPE
7949C              AT EACH OF THE PLOT POINTS.
7950C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
7951C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
7952C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
7953C           BACK IN THE MAIN ROUTINE.
7954C
7955C     WRITTEN BY--JAMES J. FILLIBEN
7956C                 STATISTICAL ENGINEERING DIVISION
7957C                 INFORMATION TECHNOLOGY LABORATORY
7958C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7959C                 GAITHERSBURG, MD 20899
7960C                 PHONE--301-975-2855
7961C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7962C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7963C     LANGUAGE--ANSI FORTRAN (1977)
7964C     VERSION NUMBER--83.6
7965C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
7966C     UPDATED         --DECEMBER  1987.  INDEPENDENT CONTROL OF CHAR WIDTH.
7967C     UPDATED         --SEPTEMBER 1988.  LOG/WEIBULL CHECK AS A SUBROUTINE
7968C     UPDATED         --SEPTEMBER 1988.  RENUMBER
7969C
7970C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
7971C
7972      CHARACTER*4 ICASPL
7973      CHARACTER*4 ICAS3D
7974C
7975      CHARACTER*4 ISORSW
7976C
7977      CHARACTER*24 ICH2PA
7978      CHARACTER*4 ICH2FO
7979      CHARACTER*4 ICH2CA
7980      CHARACTER*4 ICH2JU
7981      CHARACTER*4 ICH2DI
7982      CHARACTER*4 ICH2FI
7983      CHARACTER*4 ICH2CO
7984C
7985      CHARACTER*4 ITEXSP
7986C
7987      CHARACTER*4 IX1TSC
7988      CHARACTER*4 IY1TSC
7989C
7990      CHARACTER*4 IFIG
7991      CHARACTER*24 IPATT
7992      CHARACTER*4 IFONT
7993      CHARACTER*4 ICASE
7994      CHARACTER*4 IJUST
7995      CHARACTER*4 IDIR
7996      CHARACTER*4 IFILL
7997      CHARACTER*4 ICOL
7998C
7999      CHARACTER*24 ISYMBL
8000      CHARACTER*4 ISPAC
8001      CHARACTER*4 IMPSW2
8002C
8003      CHARACTER*4 ICASAX
8004C
8005      DIMENSION XRAW(*)
8006      DIMENSION YRAW(*)
8007      DIMENSION ZRAW(*)
8008      DIMENSION PX(*)
8009      DIMENSION PY(*)
8010      DIMENSION PZ(*)
8011      DIMENSION PY2(*)
8012      DIMENSION PX2(*)
8013      DIMENSION X3D2(*)
8014C
8015C-----COMMON----------------------------------------------------------
8016C
8017      INCLUDE 'DPCOGR.INC'
8018      INCLUDE 'DPCOBE.INC'
8019      INCLUDE 'DPCO3D.INC'
8020      INCLUDE 'DPCOP2.INC'
8021C
8022C-----START POINT-----------------------------------------------------
8023C
8024      FXMIN=FX1MIN
8025      FXMAX=FX1MAX
8026      FYMIN=FY1MIN
8027      FYMAX=FY1MAX
8028C
8029      AHUNDR=100.0
8030C
8031      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRCH')GOTO90
8032      WRITE(ICOUT,999)
8033  999 FORMAT(1X)
8034      CALL DPWRST('XXX','BUG ')
8035      WRITE(ICOUT,51)
8036   51 FORMAT('***** AT THE BEGINNING OF D3DRCH--')
8037      CALL DPWRST('XXX','BUG ')
8038      WRITE(ICOUT,52)NP
8039   52 FORMAT('NP = ',I8)
8040      CALL DPWRST('XXX','BUG ')
8041      WRITE(ICOUT,53)ICASPL,ICAS3D
8042   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
8043      CALL DPWRST('XXX','BUG ')
8044      IF(NP.LE.3)GOTO69
8045      DO65I=1,3
8046      WRITE(ICOUT,66)I,XRAW(I),YRAW(I),ZRAW(I)
8047   66 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
8048      CALL DPWRST('XXX','BUG ')
8049   65 CONTINUE
8050      NPM2=NP-2
8051      DO67I=NPM2,NP
8052      WRITE(ICOUT,68)I,XRAW(I),YRAW(I),ZRAW(I)
8053   68 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
8054      CALL DPWRST('XXX','BUG ')
8055   67 CONTINUE
8056   69 CONTINUE
8057      WRITE(ICOUT,70)ISORSW
8058   70 FORMAT('ISORSW = ',A4)
8059      CALL DPWRST('XXX','BUG ')
8060      WRITE(ICOUT,74)ICH2PA
8061   74 FORMAT('ICH2PA= ',A24)
8062      CALL DPWRST('XXX','BUG ')
8063      WRITE(ICOUT,75)ICH2FO
8064   75 FORMAT('ICH2FO= ',A4)
8065      CALL DPWRST('XXX','BUG ')
8066      WRITE(ICOUT,76)ICH2JU
8067   76 FORMAT('ICH2JU= ',A4)
8068      CALL DPWRST('XXX','BUG ')
8069      WRITE(ICOUT,77)ICH2DI
8070   77 FORMAT('ICH2DI= ',A4)
8071      CALL DPWRST('XXX','BUG ')
8072      WRITE(ICOUT,78)ACH2AN
8073   78 FORMAT('ACH2AN= ',E15.7)
8074      CALL DPWRST('XXX','BUG ')
8075      WRITE(ICOUT,79)ICH2FI
8076   79 FORMAT('ICH2FI= ',A4)
8077      CALL DPWRST('XXX','BUG ')
8078      WRITE(ICOUT,80)ICH2CO
8079   80 FORMAT('ICH2CO= ',A4)
8080      CALL DPWRST('XXX','BUG ')
8081      WRITE(ICOUT,81)PCH2HE
8082   81 FORMAT('PCH2HE= ',E15.7)
8083      CALL DPWRST('XXX','BUG ')
8084      WRITE(ICOUT,82)PCH2WI
8085   82 FORMAT('PCH2WI= ',E15.7)
8086      CALL DPWRST('XXX','BUG ')
8087      WRITE(ICOUT,83)PCH2TH,PCH2VO,PCH2HO
8088   83 FORMAT('PCH2TH,PCH2VO,PCH2HO= ',3E15.7)
8089      CALL DPWRST('XXX','BUG ')
8090      WRITE(ICOUT,84)ITEXSP
8091   84 FORMAT('ITEXSP = ',A4)
8092      CALL DPWRST('XXX','BUG ')
8093      WRITE(ICOUT,85)PXMIN,PXMAX,PYMIN,PYMAX
8094   85 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
8095      CALL DPWRST('XXX','BUG ')
8096      WRITE(ICOUT,86)FX1MIN,FX1MAX,FY1MIN,FY1MAX
8097   86 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
8098      CALL DPWRST('XXX','BUG ')
8099      WRITE(ICOUT,87)IX1TSC,IY1TSC
8100   87 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
8101      CALL DPWRST('XXX','BUG ')
8102      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
8103   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8104      CALL DPWRST('XXX','BUG ')
8105   90 CONTINUE
8106C
8107C               *************************************************
8108C               **  STEP 10--                                  **
8109C               **  IF CALLED FOR, SORT THE DATA               **
8110C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
8111C               *************************************************
8112C
8113      IF(ISORSW.EQ.'OFF')GOTO1150
8114      IF(ICASPL.EQ.'PIEC')GOTO1150
8115      IF(ICAS3D.EQ.'ON')GOTO1150
8116C
8117CCCCC CALL SORTC(X,Y,NP,PX,PY)
8118      GOTO1190
8119C
8120 1150 CONTINUE
8121      DO1160I=1,NP
8122      PX(I)=XRAW(I)
8123      PY(I)=YRAW(I)
8124      PZ(I)=ZRAW(I)
8125 1160 CONTINUE
8126      GOTO1190
8127C
8128 1190 CONTINUE
8129C
8130C               **********************************************************
8131C               **  STEP 21--                                           **
8132C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,           **
8133C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS            **
8134C               **  ARE IN VALID RANGE.                                 **
8135C               **  IF A LOG SCALE PLOT IS CALLED FOR,                  **
8136C               **  CHECK THAT ALL   HORIZ.  AXIS DATA POINTS ARE > 0.  **
8137C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,              **
8138C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS ARE        **
8139C               **  STRICTLY > 0 AND STRICTLY < 100                     **
8140C               **********************************************************
8141C
8142      IF(IX1TSC.EQ.'LOG')GOTO2110
8143      GOTO2119
8144 2110 CONTINUE
8145      ICASAX='2DHO'
8146      CALL CKLOSC(PX,NP,ISORSW,ICASAX,
8147     1ISUBG4,IBUGG4,IERRG4)
8148      IF(IERRG4.EQ.'YES')GOTO9000
8149 2119 CONTINUE
8150C
8151      IF(IX1TSC.EQ.'WEIB')GOTO2120
8152      GOTO2129
8153 2120 CONTINUE
8154      ICASAX='2DHO'
8155      CALL CKPRSC(PX,NP,ISORSW,ICASAX,
8156     1ISUBG4,IBUGG4,IERRG4)
8157      IF(IERRG4.EQ.'YES')GOTO9000
8158 2129 CONTINUE
8159C
8160C               **********************************************************
8161C               **  STEP 22--                                           **
8162C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,           **
8163C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS            **
8164C               **  ARE IN VALID RANGE.                                 **
8165C               **  IF A LOG SCALE PLOT IS CALLED FOR,                  **
8166C               **  CHECK THAT ALL   VERT.   AXIS DATA POINTS ARE > 0.  **
8167C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,              **
8168C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS ARE        **
8169C               **  STRICTLY > 0 AND STRICTLY < 100                     **
8170C               **********************************************************
8171C
8172      IF(IY1TSC.EQ.'LOG')GOTO2210
8173      GOTO2219
8174 2210 CONTINUE
8175      ICASAX='2DVE'
8176      CALL CKLOSC(PY,NP,ISORSW,ICASAX,
8177     1ISUBG4,IBUGG4,IERRG4)
8178      IF(IERRG4.EQ.'YES')GOTO9000
8179 2219 CONTINUE
8180C
8181      IF(IY1TSC.EQ.'WEIB')GOTO2220
8182      GOTO2229
8183 2220 CONTINUE
8184      ICASAX='2DVE'
8185      CALL CKPRSC(PY,NP,ISORSW,ICASAX,
8186     1ISUBG4,IBUGG4,IERRG4)
8187      IF(IERRG4.EQ.'YES')GOTO9000
8188 2229 CONTINUE
8189C
8190C               ******************************************
8191C               **  STEP 41--                           **
8192C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
8193C               **  TRANSFORM THE DATA                  **
8194C               ******************************************
8195C
8196      IF(IX1TSC.EQ.'LOG')GOTO4110
8197      GOTO4119
8198 4110 CONTINUE
8199      DO4115I=1,NP
8200      PX(I)=LOG10(PX(I))
8201 4115 CONTINUE
8202 4119 CONTINUE
8203C
8204      IF(IY1TSC.EQ.'LOG')GOTO4120
8205      GOTO4129
8206 4120 CONTINUE
8207      DO4125I=1,NP
8208      PY(I)=LOG10(PY(I))
8209 4125 CONTINUE
8210 4129 CONTINUE
8211C
8212C               ******************************************
8213C               **  STEP 42--                           **
8214C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,  **
8215C               **  TRANSFORM THE DATA                  **
8216C               ******************************************
8217C
8218      IF(IX1TSC.EQ.'WEIB')GOTO4210
8219      GOTO4219
8220 4210 CONTINUE
8221      DO4215I=1,NP
8222      PX(I)=LOG(LOG(AHUNDR/(AHUNDR-PX(I))))
8223 4215 CONTINUE
8224 4219 CONTINUE
8225C
8226      IF(IY1TSC.EQ.'WEIB')GOTO4220
8227      GOTO4229
8228 4220 CONTINUE
8229      DO4225I=1,NP
8230      PY(I)=LOG(LOG(AHUNDR/(AHUNDR-PY(I))))
8231 4225 CONTINUE
8232 4229 CONTINUE
8233C
8234C               **************************************************
8235C               **  STEP 51--                                   **
8236C               **  FORM THE CHARACTERS IN RAW 3-D SPACE.       **
8237C               **************************************************
8238C
8239C               **************************************************
8240C               **  STEP 52--                                   **
8241C               **  IF HIDDEN LINE REMOVAL IS ON,               **
8242C               **  DETERMINE IF ANY PART                       **
8243C               **  OF THE CHARACTER IS VISIBLE;                **
8244C               **  FORM SUBCHARACTERS.                         **
8245C               **************************************************
8246C
8247C               **************************************************
8248C               **  STEP 53--                                   **
8249C               **  TRANSLATE THE VISIBLE SUB-CHARACTERS        **
8250C               **  FROM THE RAW 3-D SPACE                      **
8251C               **  TO THE FINAL VISUAL 2-D PLANE.              **
8252C               **************************************************
8253C
8254      CALL D3TR32(PX,PY,PZ,NP,PX,PY,NP)
8255C
8256C               *****************************************************
8257C               **  STEP 54--                                      **
8258C               **  TRANSLATE THE 2-D PLANE DATA POINTS            **
8259C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
8260C               *****************************************************
8261C
8262      FXMIN=FX1MIN
8263      FXMAX=FX1MAX
8264      IF(IX1TSC.EQ.'LOG')FXMIN=LOG10(FX1MIN)
8265      IF(IX1TSC.EQ.'LOG')FXMAX=LOG10(FX1MAX)
8266      IF(IX1TSC.EQ.'WEIB')FXMIN=LOG(LOG(AHUNDR/(AHUNDR-FX1MIN)))
8267      IF(IX1TSC.EQ.'WEIB')FXMAX=LOG(LOG(AHUNDR/(AHUNDR-FX1MAX)))
8268C
8269      FYMIN=FY1MIN
8270      FYMAX=FY1MAX
8271      IF(IY1TSC.EQ.'LOG')FYMIN=LOG10(FY1MIN)
8272      IF(IY1TSC.EQ.'LOG')FYMAX=LOG10(FY1MAX)
8273      IF(IY1TSC.EQ.'WEIB')FYMIN=LOG(LOG(AHUNDR/(AHUNDR-FY1MIN)))
8274      IF(IY1TSC.EQ.'WEIB')FYMAX=LOG(LOG(AHUNDR/(AHUNDR-FY1MAX)))
8275C
8276      FXRANG=FXMAX-FXMIN
8277      FYRANG=FYMAX-FYMIN
8278      PXRANG=PXMAX-PXMIN
8279      PYRANG=PYMAX-PYMIN
8280C
8281      DO5410I=1,NP
8282      FXRATI=(PX(I)-FXMIN)/FXRANG
8283      FYRATI=(PY(I)-FYMIN)/FYRANG
8284      PX(I)=PXMIN+FXRATI*PXRANG
8285      PY(I)=PYMIN+FYRATI*PYRANG
8286 5410 CONTINUE
8287C
8288      DO5420I=1,NP
8289      PX(I)=PX(I)+PCH2HO
8290      PY(I)=PY(I)+PCH2VO
8291 5420 CONTINUE
8292C
8293C               ***********************************************
8294C               **  STEP 60--                                **
8295C               **  WRITE OUT THE MARKERS (PLOT CHARACTERS)  **
8296C               **  AT THE PLOT POINTS                       **
8297C               ***********************************************
8298C
8299      IFIG='GENE'
8300      IPATT=ICH2PA
8301      IFONT=ICH2FO
8302      ICASE=ICH2CA
8303      IJUST=ICH2JU
8304      IDIR=ICH2DI
8305      ANGLE=ACH2AN
8306      IFILL=ICH2FI
8307      ICOL=ICH2CO
8308      PHEIGH=PCH2HE
8309CCCCC PWIDTH=0.5*PHEIGH
8310CCCCC PWIDTH=PHEIGH*(ANUMVP/ANUMHP)      DECEMBER 1987  TEST
8311      PWIDTH=PCH2WI
8312      PVEGAP=PHEIGH/2.0
8313      PHOGAP=PWIDTH/2.0
8314      PTHICK=PCH2TH
8315      ISYMBL=ICH2PA
8316      ISPAC=ITEXSP
8317C
8318      CALL DPCLCH(PX,PY,NP,PX2,PY2,NP2,X3D2,
8319     1PXMIN,PXMAX,PYMIN,PYMAX,
8320     1ISORSW,
8321     1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
8322     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
8323     1IMPSW2,AMPSCH,AMPSCW,
8324     1ISYMBL,ISPAC)
8325C
8326C               *****************
8327C               **  STEP 90--  **
8328C               **  EXIT       **
8329C               *****************
8330C
8331 9000 CONTINUE
8332      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRCH')GOTO9090
8333      WRITE(ICOUT,999)
8334      CALL DPWRST('XXX','BUG ')
8335      WRITE(ICOUT,9011)
8336 9011 FORMAT('***** AT THE END       OF D3DRCH--')
8337      CALL DPWRST('XXX','BUG ')
8338      WRITE(ICOUT,9012)NP
8339 9012 FORMAT('NP = ',I8)
8340      CALL DPWRST('XXX','BUG ')
8341      WRITE(ICOUT,9013)ICASPL,ICAS3D
8342 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
8343      CALL DPWRST('XXX','BUG ')
8344      IF(NP.LE.3)GOTO9029
8345      DO9025I=1,3
8346      WRITE(ICOUT,9026)I,XRAW(I),YRAW(I),ZRAW(I)
8347 9026 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
8348      CALL DPWRST('XXX','BUG ')
8349 9025 CONTINUE
8350      NPM2=NP-2
8351      DO9027I=NPM2,NP
8352      WRITE(ICOUT,9028)I,XRAW(I),YRAW(I),ZRAW(I)
8353 9028 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
8354      CALL DPWRST('XXX','BUG ')
8355 9027 CONTINUE
8356 9029 CONTINUE
8357      WRITE(ICOUT,9030)ISORSW
8358 9030 FORMAT('ISORSW = ',A4)
8359      CALL DPWRST('XXX','BUG ')
8360      WRITE(ICOUT,9034)ICH2PA
8361 9034 FORMAT('ICH2PA= ',A24)
8362      CALL DPWRST('XXX','BUG ')
8363      WRITE(ICOUT,9035)ICH2FO
8364 9035 FORMAT('ICH2FO= ',A4)
8365      CALL DPWRST('XXX','BUG ')
8366      WRITE(ICOUT,9036)ICH2JU
8367 9036 FORMAT('ICH2JU= ',A4)
8368      CALL DPWRST('XXX','BUG ')
8369      WRITE(ICOUT,9037)ICH2DI
8370 9037 FORMAT('ICH2DI= ',A4)
8371      CALL DPWRST('XXX','BUG ')
8372      WRITE(ICOUT,9038)ACH2AN
8373 9038 FORMAT('ACH2AN= ',E15.7)
8374      CALL DPWRST('XXX','BUG ')
8375      WRITE(ICOUT,9039)ICH2FI
8376 9039 FORMAT('ICH2FI= ',A4)
8377      CALL DPWRST('XXX','BUG ')
8378      WRITE(ICOUT,9040)ICH2CO
8379 9040 FORMAT('ICH2CO= ',A4)
8380      CALL DPWRST('XXX','BUG ')
8381      WRITE(ICOUT,9041)PCH2HE
8382 9041 FORMAT('PCH2HE= ',E15.7)
8383      CALL DPWRST('XXX','BUG ')
8384      WRITE(ICOUT,9042)PCH2WI
8385 9042 FORMAT('PCH2WI= ',E15.7)
8386      CALL DPWRST('XXX','BUG ')
8387      WRITE(ICOUT,9043)PCH2TH,PCH2HO,PCH2VO
8388 9043 FORMAT('PCH2TH,PCH2HO,PCH2VO= ',3E15.7)
8389      CALL DPWRST('XXX','BUG ')
8390      WRITE(ICOUT,9044)ITEXSP
8391 9044 FORMAT('ITEXSP = ',A4)
8392      CALL DPWRST('XXX','BUG ')
8393      WRITE(ICOUT,9045)PXMIN,PXMAX,PYMIN,PYMAX
8394 9045 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
8395      CALL DPWRST('XXX','BUG ')
8396      WRITE(ICOUT,9046)FX1MIN,FX1MAX,FY1MIN,FY1MAX
8397 9046 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
8398      CALL DPWRST('XXX','BUG ')
8399      WRITE(ICOUT,9047)FXMIN,FXMAX,FYMIN,FYMAX
8400 9047 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
8401      CALL DPWRST('XXX','BUG ')
8402      WRITE(ICOUT,9048)IX1TSC,IY1TSC
8403 9048 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
8404      CALL DPWRST('XXX','BUG ')
8405      WRITE(ICOUT,9051)ISYMBL,ISPAC
8406 9051 FORMAT('ISYMBL,ISPAC = ',A24,2X,A4)
8407      CALL DPWRST('XXX','BUG ')
8408      WRITE(ICOUT,9059)IBUGG4,ISUBG4,IERRG4
8409 9059 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8410      CALL DPWRST('XXX','BUG ')
8411 9090 CONTINUE
8412C
8413      RETURN
8414      END
8415      SUBROUTINE D3DRFL(ICASPL,ICAS3D,FRAM3D,
8416     1X3DMIN,X3DMAX,Y3DMIN,Y3DMAX,Z3DMIN,Z3DMAX,
8417     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
8418     1IX1FPA,IX2FPA,IY1FPA,IY2FPA,
8419     1IX1FCO,IX2FCO,IY1FCO,IY2FCO,
8420     1PFRATH)
8421C     PURPOSE--DRAW THE 3 TO 8 (IF CALLED FOR) 3-D FRAME LINES
8422C     WRITTEN BY--JAMES J. FILLIBEN
8423C                 STATISTICAL ENGINEERING DIVISION
8424C                 INFORMATION TECHNOLOGY LABORATORY
8425C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8426C                 GAITHERSBURG, MD 20899
8427C                 PHONE--301-975-2855
8428C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8429C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8430C     LANGUAGE--ANSI FORTRAN (1977)
8431C     VERSION NUMBER--93.10
8432C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1993.
8433C
8434C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
8435C
8436      CHARACTER*4 ICASPL
8437      CHARACTER*4 ICAS3D
8438C
8439      CHARACTER*4 FRAM3D
8440C
8441      CHARACTER*4 IX1FSW
8442      CHARACTER*4 IX2FSW
8443      CHARACTER*4 IY1FSW
8444      CHARACTER*4 IY2FSW
8445C
8446      CHARACTER*4 IX1FPA
8447      CHARACTER*4 IX2FPA
8448      CHARACTER*4 IY1FPA
8449      CHARACTER*4 IY2FPA
8450C
8451      CHARACTER*4 IX1FCO
8452      CHARACTER*4 IX2FCO
8453      CHARACTER*4 IY1FCO
8454      CHARACTER*4 IY2FCO
8455C
8456      CHARACTER*4 IFIG
8457      CHARACTER*4 IPATT
8458      CHARACTER*4 ICOL
8459      CHARACTER*4 IFLAG
8460C
8461      DIMENSION PX(100)
8462      DIMENSION PY(100)
8463      DIMENSION PZ(100)
8464C
8465C-----COMMON----------------------------------------------------------
8466C
8467      INCLUDE 'DPCOGR.INC'
8468      INCLUDE 'DPCOBE.INC'
8469      INCLUDE 'DPCOP2.INC'
8470C
8471C
8472C-----START POINT-----------------------------------------------------
8473C
8474      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFL')GOTO90
8475      WRITE(ICOUT,999)
8476  999 FORMAT(1X)
8477      CALL DPWRST('XXX','BUG ')
8478      WRITE(ICOUT,51)
8479   51 FORMAT('***** AT THE BEGINNING OF D3DRFL--')
8480      CALL DPWRST('XXX','BUG ')
8481      WRITE(ICOUT,52)X3DMIN,X3DMAX
8482   52 FORMAT('X3DMIN,X3DMAX = ',2F10.5)
8483      CALL DPWRST('XXX','BUG ')
8484      WRITE(ICOUT,53)Y3DMIN,Y3DMAX
8485   53 FORMAT('Y3DMIN,Y3DMAX = ',2F10.5)
8486      CALL DPWRST('XXX','BUG ')
8487      WRITE(ICOUT,54)Z3DMIN,Z3DMAX
8488   54 FORMAT('Z3DMIN,Z3DMAX = ',2F10.5)
8489      CALL DPWRST('XXX','BUG ')
8490      WRITE(ICOUT,55)ICASPL,ICAS3D,FRAM3D
8491   55 FORMAT('ICASPL,ICAS3D,FRAM3D = ',A4,2X,A4,2X,A4)
8492      CALL DPWRST('XXX','BUG ')
8493      WRITE(ICOUT,61)IX1FSW,IX2FSW,IY1FSW,IY2FSW
8494   61 FORMAT('IX1FSW,IX2FSW,IY1FSW,IY2FSW = ',A4,2X,A4,2X,A4,2X,A4)
8495      CALL DPWRST('XXX','BUG ')
8496      WRITE(ICOUT,62)IX1FPA,IX2FPA,IY1FPA,IY2FPA
8497   62 FORMAT('IX1FPA,IX2FPA,IY1FPA,IY2FPA = ',A4,2X,A4,2X,A4,2X,A4)
8498      CALL DPWRST('XXX','BUG ')
8499      WRITE(ICOUT,63)IX1FCO,IX2FCO,IY1FCO,IY2FCO
8500   63 FORMAT('IX1FCO,IX2FCO,IY1FCO,IY2FCO = ',A4,2X,A4,2X,A4,2X,A4)
8501      CALL DPWRST('XXX','BUG ')
8502      WRITE(ICOUT,64)PFRATH
8503   64 FORMAT('PFRATH = ',E15.7)
8504      CALL DPWRST('XXX','BUG ')
8505      WRITE(ICOUT,65)IBUGG4,ISUBG4,IERRG4
8506   65 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8507      CALL DPWRST('XXX','BUG ')
8508   90 CONTINUE
8509C
8510      IF(ICASPL.EQ.'PIEC')GOTO9000
8511      IF(ICASPL.EQ.'STAR')GOTO9000
8512C
8513      IFIG='LINE'
8514      PTHICK=PFRATH
8515C
8516C               *********************************************
8517C               **  STEP 1--                               **
8518C               **  IF CALLED FOR,                         **
8519C               **  DRAW OUT THE "3 PRONG" FRAME           **
8520C               *********************************************
8521C
8522      IF(FRAM3D.EQ.'3PRO')THEN
8523         PX(1)=X3DMIN
8524         PX(2)=X3DMAX
8525         PX(3)=X3DMIN
8526         PX(4)=X3DMIN
8527         PX(5)=X3DMIN
8528         PX(6)=X3DMIN
8529C
8530         PY(1)=Y3DMIN
8531         PY(2)=Y3DMIN
8532         PY(3)=Y3DMIN
8533         PY(4)=Y3DMIN
8534         PY(5)=Y3DMIN
8535         PY(6)=Y3DMAX
8536C
8537         PZ(1)=Z3DMIN
8538         PZ(2)=Z3DMIN
8539         PZ(3)=Z3DMIN
8540         PZ(4)=Z3DMAX
8541         PZ(5)=Z3DMIN
8542         PZ(6)=Z3DMIN
8543         NP=6
8544         IPATT=IX1FPA
8545         ICOL=IX1FCO
8546         IFLAG='ON'
8547C
8548         CALL D3TR32(PX,PY,PZ,NP,PX,PY,NP)
8549         CALL D3SCAL(PX,PY,NP)
8550         CALL DPDRPL(PX,PY,NP,
8551     1   IFIG,IPATT,PTHICK,ICOL,
8552     1   JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8553      ENDIF
8554C
8555C               *********************************************
8556C               **  STEP 2--                               **
8557C               **  IF CALLED FOR,                         **
8558C               **  DRAW OUT THE "3 PLANE" STYLE FRAME     **
8559C               *********************************************
8560C
8561      IF(FRAM3D.EQ.'3PLA')THEN
8562         PX(1)=X3DMIN
8563         PX(2)=X3DMAX
8564         PX(3)=X3DMAX
8565         PX(4)=X3DMIN
8566         PX(5)=X3DMIN
8567         PX(6)=X3DMIN
8568         PX(7)=X3DMIN
8569         PX(8)=X3DMIN
8570         PX(9)=X3DMIN
8571         PX(10)=X3DMAX
8572         PX(11)=X3DMAX
8573         PX(12)=X3DMIN
8574         PX(13)=X3DMIN
8575C
8576         PY(1)=Y3DMIN
8577         PY(2)=Y3DMIN
8578         PY(3)=Y3DMIN
8579         PY(4)=Y3DMIN
8580         PY(5)=Y3DMIN
8581         PY(6)=Y3DMAX
8582         PY(7)=Y3DMAX
8583         PY(8)=Y3DMIN
8584         PY(9)=Y3DMIN
8585         PY(10)=Y3DMIN
8586         PY(11)=Y3DMAX
8587         PY(12)=Y3DMAX
8588         PY(13)=Y3DMIN
8589C
8590         PZ(1)=Z3DMIN
8591         PZ(2)=Z3DMIN
8592         PZ(3)=Z3DMAX
8593         PZ(4)=Z3DMAX
8594         PZ(5)=Z3DMIN
8595         PZ(6)=Z3DMIN
8596         PZ(7)=Z3DMAX
8597         PZ(8)=Z3DMAX
8598         PZ(9)=Z3DMIN
8599         PZ(10)=Z3DMIN
8600         PZ(11)=Z3DMIN
8601         PZ(12)=Z3DMIN
8602         PZ(13)=Z3DMIN
8603         NP=13
8604         IPATT=IX1FPA
8605         ICOL=IX1FCO
8606         IFLAG='ON'
8607         CALL D3TR32(PX,PY,PZ,NP,PX,PY,NP)
8608         CALL D3SCAL(PX,PY,NP)
8609         CALL DPDRPL(PX,PY,NP,
8610     1   IFIG,IPATT,PTHICK,ICOL,
8611     1   JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8612      ENDIF
8613C
8614C               *********************************************
8615C               **  STEP 3--                               **
8616C               **  IF CALLED FOR,                         **
8617C               **  DRAW OUT THE "BOX" STYLE FRAME         **
8618C               *********************************************
8619C
8620      IF(FRAM3D.EQ.'BOX')THEN
8621         PX(1)=X3DMIN
8622         PX(2)=X3DMAX
8623         PX(3)=X3DMAX
8624         PX(4)=X3DMIN
8625         PX(5)=X3DMIN
8626         PX(6)=X3DMIN
8627         PX(7)=X3DMIN
8628         PX(8)=X3DMIN
8629         PX(9)=X3DMIN
8630         PX(10)=X3DMAX
8631         PX(11)=X3DMAX
8632         PX(12)=X3DMAX
8633         PX(13)=X3DMAX
8634         PX(14)=X3DMAX
8635         PX(15)=X3DMIN
8636         PX(16)=X3DMAX
8637         PX(17)=X3DMAX
8638         PX(18)=X3DMIN
8639         PX(19)=X3DMIN
8640C
8641         PY(1)=Y3DMIN
8642         PY(2)=Y3DMIN
8643         PY(3)=Y3DMIN
8644         PY(4)=Y3DMIN
8645         PY(5)=Y3DMIN
8646         PY(6)=Y3DMAX
8647         PY(7)=Y3DMAX
8648         PY(8)=Y3DMIN
8649         PY(9)=Y3DMIN
8650         PY(10)=Y3DMIN
8651         PY(11)=Y3DMAX
8652         PY(12)=Y3DMAX
8653         PY(13)=Y3DMIN
8654         PY(14)=Y3DMAX
8655         PY(15)=Y3DMAX
8656         PY(16)=Y3DMAX
8657         PY(17)=Y3DMAX
8658         PY(18)=Y3DMAX
8659         PY(19)=Y3DMIN
8660C
8661         PZ(1)=Z3DMIN
8662         PZ(2)=Z3DMIN
8663         PZ(3)=Z3DMAX
8664         PZ(4)=Z3DMAX
8665         PZ(5)=Z3DMIN
8666         PZ(6)=Z3DMIN
8667         PZ(7)=Z3DMAX
8668         PZ(8)=Z3DMAX
8669         PZ(9)=Z3DMIN
8670         PZ(10)=Z3DMIN
8671         PZ(11)=Z3DMIN
8672         PZ(12)=Z3DMAX
8673         PZ(13)=Z3DMAX
8674         PZ(14)=Z3DMAX
8675         PZ(15)=Z3DMAX
8676         PZ(16)=Z3DMAX
8677         PZ(17)=Z3DMIN
8678         PZ(18)=Z3DMIN
8679         PZ(19)=Z3DMIN
8680         NP=19
8681         IPATT=IX1FPA
8682         ICOL=IX1FCO
8683         IFLAG='ON'
8684         CALL D3TR32(PX,PY,PZ,NP,PX,PY,NP)
8685         CALL D3SCAL(PX,PY,NP)
8686         CALL DPDRPL(PX,PY,NP,
8687     1   IFIG,IPATT,PTHICK,ICOL,
8688     1   JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8689      ENDIF
8690C
8691C               *********************************************
8692C               **  STEP 4--                               **
8693C               **  IF CALLED FOR,                         **
8694C               **  DRAW OUT THE "ZIGZAG" FRAME           **
8695C               *********************************************
8696C
8697      IF(FRAM3D.EQ.'ZIGZ')THEN
8698         PX(1)=X3DMIN
8699         PX(2)=X3DMIN
8700         PX(3)=X3DMAX
8701         PX(4)=X3DMAX
8702C
8703         PY(1)=Y3DMAX
8704         PY(2)=Y3DMAX
8705         PY(3)=Y3DMAX
8706         PY(4)=Y3DMIN
8707C
8708         PZ(1)=Z3DMAX
8709         PZ(2)=Z3DMIN
8710         PZ(3)=Z3DMIN
8711         PZ(4)=Z3DMIN
8712         NP=4
8713         IPATT=IX1FPA
8714         ICOL=IX1FCO
8715         IFLAG='ON'
8716         CALL D3TR32(PX,PY,PZ,NP,PX,PY,NP)
8717         CALL D3SCAL(PX,PY,NP)
8718         CALL DPDRPL(PX,PY,NP,
8719     1   IFIG,IPATT,PTHICK,ICOL,
8720     1   JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8721      ENDIF
8722C
8723C               *****************
8724C               **  STEP 90--  **
8725C               **  EXIT       **
8726C               *****************
8727C
8728 9000 CONTINUE
8729      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFL')GOTO9090
8730      WRITE(ICOUT,999)
8731      CALL DPWRST('XXX','BUG ')
8732      WRITE(ICOUT,9011)
8733 9011 FORMAT('***** AT THE END       OF D3DRFL--')
8734      CALL DPWRST('XXX','BUG ')
8735      WRITE(ICOUT,9012)X3DMIN,X3DMAX
8736 9012 FORMAT('X3DMIN,X3DMAX = ',2F10.5)
8737      CALL DPWRST('XXX','BUG ')
8738      WRITE(ICOUT,9013)Y3DMIN,Y3DMAX
8739 9013 FORMAT('Y3DMIN,Y3DMAX = ',2F10.5)
8740      CALL DPWRST('XXX','BUG ')
8741      WRITE(ICOUT,9014)Z3DMIN,Z3DMAX
8742 9014 FORMAT('Z3DMIN,Z3DMAX = ',2F10.5)
8743      CALL DPWRST('XXX','BUG ')
8744      WRITE(ICOUT,9015)ICASPL,ICAS3D,FRAM3D
8745 9015 FORMAT('ICASPL,ICAS3D,FRAM3D = ',A4,2X,A4,2X,A4)
8746      CALL DPWRST('XXX','BUG ')
8747      WRITE(ICOUT,9021)IX1FSW,IX2FSW,IY1FSW,IY2FSW
8748 9021 FORMAT('IX1FSW,IX2FSW,IY1FSW,IY2FSW = ',A4,2X,A4,2X,A4,2X,A4)
8749      CALL DPWRST('XXX','BUG ')
8750      WRITE(ICOUT,9022)IX1FPA,IX2FPA,IY1FPA,IY2FPA
8751 9022 FORMAT('IX1FPA,IX2FPA,IY1FPA,IY2FPA = ',A4,2X,A4,2X,A4,2X,A4)
8752      CALL DPWRST('XXX','BUG ')
8753      WRITE(ICOUT,9023)IX1FCO,IX2FCO,IY1FCO,IY2FCO
8754 9023 FORMAT('IX1FCO,IX2FCO,IY1FCO,IY2FCO = ',A4,2X,A4,2X,A4,2X,A4)
8755      CALL DPWRST('XXX','BUG ')
8756      WRITE(ICOUT,9024)PFRATH
8757 9024 FORMAT('PFRATH = ',E15.7)
8758      CALL DPWRST('XXX','BUG ')
8759      WRITE(ICOUT,9025)IBUGG4,ISUBG4,IERRG4
8760 9025 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8761      CALL DPWRST('XXX','BUG ')
8762 9090 CONTINUE
8763C
8764      RETURN
8765      END
8766      SUBROUTINE D3DRFR(ICASPL,ICAS3D,FRAM3D,
8767     1X3DMIN,X3DMAX,Y3DMIN,Y3DMAX,Z3DMIN,Z3DMAX,
8768     1IVGMSW,IHGMSW)
8769C
8770C     PURPOSE--DRAW 3-D FRAME LINES (ALONG WITH TIC MARKS,
8771C              TIC MARK LABELS, AND GRID LINES
8772C              FOR A PLOT.
8773C
8774C     WRITTEN BY--JAMES J. FILLIBEN
8775C                 STATISTICAL ENGINEERING DIVISION
8776C                 INFORMATION TECHNOLOGY LABORATORY
8777C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8778C                 GAITHERSBURG, MD 20899
8779C                 PHONE--301-975-2855
8780C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8781C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8782C     LANGUAGE--ANSI FORTRAN (1977)
8783C     VERSION NUMBER--93.6
8784C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1993.
8785C
8786C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
8787C
8788      CHARACTER*4 ICASPL
8789      CHARACTER*4 ICAS3D
8790C
8791      CHARACTER*4 FRAM3D
8792C
8793      CHARACTER*4 IVGMSW
8794      CHARACTER*4 IHGMSW
8795C
8796C-----COMMON----------------------------------------------------------
8797C
8798      INCLUDE 'DPCOPA.INC'
8799      INCLUDE 'DPCOPC.INC'
8800      INCLUDE 'DPCOGR.INC'
8801      INCLUDE 'DPCOBE.INC'
8802      INCLUDE 'DPCOP2.INC'
8803C
8804C-----START POINT-----------------------------------------------------
8805C
8806C
8807      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFR')GOTO90
8808      WRITE(ICOUT,999)
8809  999 FORMAT(1X)
8810      CALL DPWRST('XXX','BUG ')
8811      WRITE(ICOUT,51)
8812   51 FORMAT('***** AT THE BEGINNING OF D3DRFR--')
8813      CALL DPWRST('XXX','BUG ')
8814      WRITE(ICOUT,52)IMANUF,IMODEL
8815   52 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
8816      CALL DPWRST('XXX','BUG ')
8817      WRITE(ICOUT,53)ICASPL,ICAS3D
8818   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
8819      CALL DPWRST('XXX','BUG ')
8820      WRITE(ICOUT,55)IBUGG4,ISUBG4,IERRG4
8821   55 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8822      CALL DPWRST('XXX','BUG ')
8823   90 CONTINUE
8824C
8825C               *******************************
8826C               **  STEP 1--                 **
8827C               **  FILL  THE MARGIN REGION  **
8828C               *******************************
8829C
8830      IF(IERASW.EQ.'ON'.AND.IMARCO.NE.IBACCO)
8831     1CALL DPFIMA(PXMIN,PYMIN,PXMAX,PYMAX,
8832     1ICASPL,ICAS3D,
8833     1IMARCO)
8834C
8835C               ****************************
8836C               **  STEP 2--              **
8837C               **  DRAW THE FRAME LINES  **
8838C               ****************************
8839C
8840      CALL D3DRFL(ICASPL,ICAS3D,FRAM3D,
8841     1X3DMIN,X3DMAX,Y3DMIN,Y3DMAX,Z3DMIN,Z3DMAX,
8842     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
8843     1IX1FPA,IX2FPA,IY1FPA,IY2FPA,
8844     1IX1FCO,IX2FCO,IY1FCO,IY2FCO,
8845     1PFRATH)
8846C
8847C               **************************
8848C               **  STEP 3--            **
8849C               **  DRAW THE TIC MARKS  **
8850C               **************************
8851C
8852      CALL DPDRTM(PXMIN,PYMIN,PXMAX,PYMAX,
8853     1FX1MIN,FY1MIN,FX1MAX,FY1MAX,
8854     1ICASPL,ICAS3D,
8855     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
8856     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
8857     1PX1COO,PX2COO,PY1COO,PY2COO,
8858     1NX1COO,NX2COO,NY1COO,NY2COO,
8859     1PX1CMN,PX2CMN,PY1CMN,PY2CMN,
8860     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
8861     1PX1TLE,PX2TLE,PY1TLE,PY2TLE,
8862     1PTICTH,PMNTFA,
8863     1IX1TJU,IX2TJU,IY1TJU,IY2TJU,
8864     1IX1TCO,IX2TCO,IY1TCO,IY2TCO)
8865C
8866C               *************************************
8867C               **  STEP 4--                       **
8868C               **  WRITE OUT THE TIC MARK LABELS  **
8869C               *************************************
8870C
8871      CALL DPWRTL(ICASPL,ICAS3D)
8872C
8873C               ***************************
8874C               **  STEP 5--             **
8875C               **  DRAW THE GRID LINES  **
8876C               ***************************
8877C
8878      CALL DPDRGL(PXMIN,PYMIN,PXMAX,PYMAX,
8879     1FX1MIN,FY1MIN,FX1MAX,FY1MAX,
8880     1ICASPL,ICAS3D,
8881     1IVGRSW,IHGRSW,
8882     1IVGMSW,IHGMSW,
8883     1PX1COO,PX2COO,PY1COO,PY2COO,
8884     1X1COOR,X2COOR,Y1COOR,Y2COOR,
8885     1NX1COO,NX2COO,NY1COO,NY2COO,
8886     1PX1CMN,PX2CMN,PY1CMN,PY2CMN,
8887     1X1COMN,X2COMN,Y1COMN,Y2COMN,
8888     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
8889     1IVGRPA,IHGRPA,IVGRCO,IHGRCO,
8890     1PVGRTH,PHGRTH,
8891     1PX1TOL,PX1TOR,PY1TOB,PY1TOT)
8892CCCC ABOVE LINE ADDED MAY, 1990 (FOR TIC OFFSETS)
8893C
8894C               *****************
8895C               **  STEP 90--  **
8896C               **  EXIT       **
8897C               *****************
8898C
8899      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFR')GOTO9090
8900      WRITE(ICOUT,999)
8901      CALL DPWRST('XXX','BUG ')
8902      WRITE(ICOUT,9011)
8903 9011 FORMAT('***** AT THE END       OF D3DRFR--')
8904      CALL DPWRST('XXX','BUG ')
8905      WRITE(ICOUT,9012)IMANUF,IMODEL
8906 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
8907      CALL DPWRST('XXX','BUG ')
8908      WRITE(ICOUT,9013)ICASPL,ICAS3D
8909 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
8910      CALL DPWRST('XXX','BUG ')
8911      WRITE(ICOUT,9015)IBUGG4,ISUBG4,IERRG4
8912 9015 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8913      CALL DPWRST('XXX','BUG ')
8914 9090 CONTINUE
8915C
8916      RETURN
8917      END
8918      SUBROUTINE D3DRSP(XRAW,YRAW,ZRAW,NP,
8919     1PX,PY,PZ,PX2,PY2,PZ2,PX3,PY3,
8920     1ICASPL,ICAS3D,
8921     1ISORSW,
8922     1ISP2LI,ISP2CO,ISP2DI,PSP2TH,ASP2BA,
8923     1PXMIN,PXMAX,PYMIN,PYMAX,
8924     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
8925     1IX1TSC,IY1TSC)
8926C
8927C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
8928C              AND FOR EACH VALUE IN X(.), DRAW A SPIKE
8929C              (= A VERTICAL OR HORIZONTAL LINE SEGMENT)
8930C              FROM THE BASE POINT ASP2BA
8931C              TO THE POINT Y(.).
8932C              DO SO FOR A SPECIFIED SPIKE LINE TYPE,
8933C              LINES COLOR, LINE DIRECTION, AND LINE THICKNESS.
8934C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
8935C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
8936C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
8937C           BACK IN THE MAIN ROUTINE.
8938C
8939C     WRITTEN BY--JAMES J. FILLIBEN
8940C                 STATISTICAL ENGINEERING DIVISION
8941C                 INFORMATION TECHNOLOGY LABORATORY
8942C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8943C                 GAITHERSBURG, MD 20899
8944C                 PHONE--301-975-2855
8945C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8946C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8947C     LANGUAGE--ANSI FORTRAN (1977)
8948C     VERSION NUMBER--87.6
8949C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
8950C     UPDATED--APRIL     1987.
8951C     UPDATED         --SEPTEMBER 1988.  RENUMBER
8952C
8953C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
8954C
8955      CHARACTER*4 ICASPL
8956      CHARACTER*4 ICAS3D
8957C
8958      CHARACTER*4 ISORSW
8959C
8960      CHARACTER*4 ISP2LI
8961      CHARACTER*4 ISP2CO
8962      CHARACTER*4 ISP2DI
8963C
8964      CHARACTER*4 IX1TSC
8965      CHARACTER*4 IY1TSC
8966C
8967      CHARACTER*4 ITYPE
8968C
8969      CHARACTER*4 IFIG
8970      CHARACTER*4 IPATTT
8971      CHARACTER*4 ICOL
8972      CHARACTER*4 IDIR
8973C
8974C     6/23/86
8975C     HOW COME THE FOLLOWING 4 VARIABLES ARE NOT CARRIED
8976C     AS INPUT TO THIS SUBROUTINE--NOT NEEDED???
8977C     CHECK ON THIS.
8978C
8979      CHARACTER*4 IHORPA
8980      CHARACTER*4 IVERPA
8981      CHARACTER*4 IDUPPA
8982      CHARACTER*4 IDDOPA
8983C
8984      DIMENSION XRAW(*)
8985      DIMENSION YRAW(*)
8986      DIMENSION ZRAW(*)
8987      DIMENSION PX(*)
8988      DIMENSION PY(*)
8989      DIMENSION PZ(*)
8990      DIMENSION PX2(*)
8991      DIMENSION PY2(*)
8992      DIMENSION PZ2(*)
8993      DIMENSION PX3(*)
8994      DIMENSION PY3(*)
8995C
8996C-----COMMON----------------------------------------------------------
8997C
8998      INCLUDE 'DPCOGR.INC'
8999      INCLUDE 'DPCOBE.INC'
9000      INCLUDE 'DPCO3D.INC'
9001      INCLUDE 'DPCOP2.INC'
9002C
9003C-----START POINT-----------------------------------------------------
9004C
9005      J=0
9006      HOLD=1.0
9007      ABASE=0.0
9008      PBASE=0.0
9009      PBASE2=0.0
9010C
9011      FXMIN=FX1MIN
9012      FXMAX=FX1MAX
9013      FYMIN=FY1MIN
9014      FYMAX=FY1MAX
9015C
9016      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRSP')GOTO90
9017      WRITE(ICOUT,999)
9018  999 FORMAT(1X)
9019      CALL DPWRST('XXX','BUG ')
9020      WRITE(ICOUT,51)
9021   51 FORMAT('***** AT THE BEGINNING OF D3DRSP--')
9022      CALL DPWRST('XXX','BUG ')
9023      WRITE(ICOUT,52)NP
9024   52 FORMAT('NP = ',I8)
9025      CALL DPWRST('XXX','BUG ')
9026      WRITE(ICOUT,53)ICASPL,ICAS3D
9027   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
9028      CALL DPWRST('XXX','BUG ')
9029      IF(NP.LE.3)GOTO69
9030      DO65I=1,3
9031      WRITE(ICOUT,66)I,XRAW(I),YRAW(I),ZRAW(I)
9032   66 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
9033      CALL DPWRST('XXX','BUG ')
9034   65 CONTINUE
9035      NPM2=NP-2
9036      DO67I=NPM2,NP
9037      WRITE(ICOUT,68)I,XRAW(I),YRAW(I),ZRAW(I)
9038   68 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
9039      CALL DPWRST('XXX','BUG ')
9040   67 CONTINUE
9041   69 CONTINUE
9042      WRITE(ICOUT,70)ISORSW
9043   70 FORMAT('ISORSW = ',A4)
9044      CALL DPWRST('XXX','BUG ')
9045      WRITE(ICOUT,71)ISP2LI
9046   71 FORMAT('ISP2LI= ',A4)
9047      CALL DPWRST('XXX','BUG ')
9048      WRITE(ICOUT,72)ISP2CO,ISP2DI
9049   72 FORMAT('ISP2CO,ISP2DI= ',A4,2X,A4)
9050      CALL DPWRST('XXX','BUG ')
9051      WRITE(ICOUT,73)PSP2TH
9052   73 FORMAT('PSP2TH= ',E15.7)
9053      CALL DPWRST('XXX','BUG ')
9054      WRITE(ICOUT,74)ASP2BA
9055   74 FORMAT('ASP2BA= ',E15.7)
9056      CALL DPWRST('XXX','BUG ')
9057      DO81I=1,NP
9058      WRITE(ICOUT,82)I,PX3(I),PY3(I)
9059   82 FORMAT('I,PX3(I),PY3(I) = ',I8,2G15.7)
9060      CALL DPWRST('XXX','BUG ')
9061   81 CONTINUE
9062      WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
9063   84 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
9064      CALL DPWRST('XXX','BUG ')
9065      WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
9066   85 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
9067      CALL DPWRST('XXX','BUG ')
9068      WRITE(ICOUT,86)IX1TSC,IY1TSC
9069   86 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
9070      CALL DPWRST('XXX','BUG ')
9071      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
9072   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
9073      CALL DPWRST('XXX','BUG ')
9074   90 CONTINUE
9075C
9076C               *************************************************
9077C               **  STEP 11--                                  **
9078C               **  IF CALLED FOR, SORT THE DATA               **
9079C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
9080C               *************************************************
9081C
9082      IDIR=ISP2DI
9083C
9084      IF(ISORSW.EQ.'OFF')GOTO1150
9085      IF(ICASPL.EQ.'PIEC')GOTO1150
9086      IF(ICAS3D.EQ.'ON')GOTO1150
9087      IF(ICASPL.EQ.'CONT')GOTO1150
9088C
9089CCCCC CALL SORTC(X,Y,NP,PX,PY)
9090      GOTO1190
9091C
9092 1150 CONTINUE
9093      DO1160I=1,NP
9094      PX(I)=XRAW(I)
9095      PY(I)=YRAW(I)
9096      PZ(I)=ZRAW(I)
9097 1160 CONTINUE
9098      GOTO1190
9099C
9100 1190 CONTINUE
9101C
9102C               ************************************************
9103C               **  STEP 12--                                 **
9104C               **  IF A LOG SCALE PLOT IS CALLED FOR,        **
9105C               **  CHECK THAT ALL DATA POINTS ARE POSITIVE.  **
9106C               ************************************************
9107C
9108      IF(IX1TSC.EQ.'LOG')GOTO1210
9109      GOTO1290
9110C
9111 1210 CONTINUE
9112      IF(IDIR.EQ.'H')GOTO1215
9113      GOTO1219
9114 1215 CONTINUE
9115      IF(ASP2BA.LE.0.0)HOLD=ASP2BA
9116      IF(ASP2BA.LE.0.0)GOTO1250
9117 1219 CONTINUE
9118C
9119      IF(ISORSW.EQ.'ON')GOTO1220
9120      GOTO1230
9121C
9122 1220 CONTINUE
9123      J=1
9124      IF(PX(J).LE.0.0)GOTO1250
9125      GOTO1290
9126C
9127 1230 CONTINUE
9128      DO1235I=1,NP
9129      J=I
9130      IF(PX(J).LE.0.0)GOTO1250
9131 1235 CONTINUE
9132      GOTO1290
9133C
9134 1250 CONTINUE
9135      WRITE(ICOUT,999)
9136      CALL DPWRST('XXX','BUG ')
9137      WRITE(ICOUT,1251)
9138 1251 FORMAT('***** ERROR IN D3DRSP--')
9139      CALL DPWRST('XXX','BUG ')
9140      WRITE(ICOUT,1252)
9141 1252 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
9142      CALL DPWRST('XXX','BUG ')
9143      WRITE(ICOUT,1253)
9144 1253 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
9145      CALL DPWRST('XXX','BUG ')
9146      WRITE(ICOUT,1254)
9147 1254 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
9148      CALL DPWRST('XXX','BUG ')
9149      WRITE(ICOUT,1255)
9150 1255 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
9151      CALL DPWRST('XXX','BUG ')
9152      WRITE(ICOUT,1256)PX(J)
9153 1256 FORMAT('      THE VALUE = ',E15.7)
9154      CALL DPWRST('XXX','BUG ')
9155      WRITE(ICOUT,1257)
9156 1257 FORMAT('      THIS VALUE CAME FROM THE ')
9157      CALL DPWRST('XXX','BUG ')
9158      WRITE(ICOUT,1258)
9159 1258 FORMAT('      HORIZONTAL AXIS VARIABLE.')
9160      CALL DPWRST('XXX','BUG ')
9161      WRITE(ICOUT,1259)
9162 1259 FORMAT('      CORRECTIVE ACTION--')
9163      CALL DPWRST('XXX','BUG ')
9164      WRITE(ICOUT,1260)
9165 1260 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
9166      CALL DPWRST('XXX','BUG ')
9167      IERRG4='YES'
9168      GOTO9000
9169C
9170 1290 CONTINUE
9171C
9172      IF(IY1TSC.EQ.'LOG')GOTO1310
9173      GOTO1390
9174C
9175 1310 CONTINUE
9176      IF(IDIR.EQ.'V')GOTO1315
9177      GOTO1319
9178 1315 CONTINUE
9179      IF(ASP2BA.LE.0.0)HOLD=ASP2BA
9180      IF(ASP2BA.LE.0.0)GOTO1350
9181 1319 CONTINUE
9182C
9183      IF(ISORSW.EQ.'ON')GOTO1320
9184      GOTO1330
9185C
9186 1320 CONTINUE
9187      J=1
9188      IF(PY(J).LE.0.0)HOLD=PY(J)
9189      IF(PY(J).LE.0.0)GOTO1350
9190      GOTO1390
9191C
9192 1330 CONTINUE
9193      DO1335I=1,NP
9194      J=I
9195      IF(PY(J).LE.0.0)HOLD=PY(J)
9196      IF(PY(J).LE.0.0)GOTO1350
9197 1335 CONTINUE
9198      GOTO1390
9199C
9200 1350 CONTINUE
9201      WRITE(ICOUT,999)
9202      CALL DPWRST('XXX','BUG ')
9203      WRITE(ICOUT,1351)
9204 1351 FORMAT('***** ERROR IN D3DRSP--')
9205      CALL DPWRST('XXX','BUG ')
9206      WRITE(ICOUT,1352)
9207 1352 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
9208      CALL DPWRST('XXX','BUG ')
9209      WRITE(ICOUT,1353)
9210 1353 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
9211      CALL DPWRST('XXX','BUG ')
9212      WRITE(ICOUT,1354)
9213 1354 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
9214      CALL DPWRST('XXX','BUG ')
9215      WRITE(ICOUT,1355)
9216 1355 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
9217      CALL DPWRST('XXX','BUG ')
9218      WRITE(ICOUT,1356)HOLD
9219 1356 FORMAT('      THE VALUE = ',E15.7)
9220      CALL DPWRST('XXX','BUG ')
9221      WRITE(ICOUT,1357)
9222 1357 FORMAT('      THIS VALUE CAME FROM THE ')
9223      CALL DPWRST('XXX','BUG ')
9224      WRITE(ICOUT,1358)
9225 1358 FORMAT('      VERTICAL AXIS VARIABLE.')
9226      CALL DPWRST('XXX','BUG ')
9227      WRITE(ICOUT,1359)
9228 1359 FORMAT('      CORRECTIVE ACTION--')
9229      CALL DPWRST('XXX','BUG ')
9230      WRITE(ICOUT,1360)
9231 1360 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
9232      CALL DPWRST('XXX','BUG ')
9233      IERRG4='YES'
9234      GOTO9000
9235C
9236 1390 CONTINUE
9237C
9238C               ******************************************
9239C               **  STEP 40--                           **
9240C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
9241C               **  TRANSFORM THE DATA                  **
9242C               ******************************************
9243C
9244      ABASE=ASP2BA
9245C
9246      IF(IX1TSC.EQ.'LOG')GOTO4010
9247      GOTO4019
9248 4010 CONTINUE
9249      IF(IDIR.EQ.'H')ABASE=LOG10(ABASE)
9250      DO4015I=1,NP
9251      PX(I)=LOG10(PX(I))
9252 4015 CONTINUE
9253 4019 CONTINUE
9254C
9255      IF(IY1TSC.EQ.'LOG')GOTO4020
9256      GOTO4029
9257 4020 CONTINUE
9258      IF(IDIR.EQ.'V')ABASE=LOG10(ABASE)
9259      DO4025I=1,NP
9260      PY(I)=LOG10(PY(I))
9261 4025 CONTINUE
9262 4029 CONTINUE
9263C
9264C               *******************************
9265C               **  STEP 60--                **
9266C               **  PREPARE TO MAKE VARIOUS  **
9267C               **  LINE SETTINGS            **
9268C               *******************************
9269C
9270      ITYPE='LINE'
9271C
9272C               **********************************************
9273C               **  STEP 61--                               **
9274C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9275C               **  OF THE LINE PATTERN                     **
9276C               **  INTO A NUMERIC REPRESENTATION           **
9277C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9278C               **  GRAPHICS DEVICE.                        **
9279C               **********************************************
9280C
9281      IPATTT=ISP2LI
9282      CALL GRTRPA(ITYPE,IPATTT,PXSPA,PYSPA,
9283     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
9284C
9285C               *******************************
9286C               **  STEP 62--                **
9287C               **  SET THE LINE PATTERN     **
9288C               **  ON THE GRAPHICS DEVICE.  **
9289C               *******************************
9290C
9291      CALL GRSEPA(ITYPE,IPATTT,PXSPA,PYSPA,
9292     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
9293C
9294C               **********************************************
9295C               **  STEP 63--                               **
9296C               **  TRANSLATE THE  DESIRED                  **
9297C               **  LINE THICKNESS                          **
9298C               **  INTO A NUMERIC REPRESENTATION           **
9299C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9300C               **  GRAPHICS DEVICE.                        **
9301C               **********************************************
9302C
9303      PTHICK=PSP2TH
9304      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
9305C
9306C               *******************************
9307C               **  STEP 64--                **
9308C               **  SET THE LINE THICKNESS   **
9309C               **  ON THE GRAPHICS DEVICE.  **
9310C               *******************************
9311C
9312      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
9313C
9314C               **********************************************
9315C               **  STEP 65--                               **
9316C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9317C               **  OF THE LINE COLOR                       **
9318C               **  INTO A NUMERIC REPRESENTATION           **
9319C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9320C               **  GRAPHICS DEVICE.                        **
9321C               **********************************************
9322C
9323      ICOL=ISP2CO
9324      CALL GRTRCO(ITYPE,ICOL,JCOL)
9325C
9326C               *******************************
9327C               **  STEP 66--                **
9328C               **  SET THE LINE COLOR       **
9329C               **  ON THE GRAPHICS DEVICE.  **
9330C               *******************************
9331C
9332      CALL GRSECO(ITYPE,ICOL,JCOL)
9333C
9334C               **************************************************
9335C               **  STEP 71--                                   **
9336C               **  FOR EACH RAW 3-D DATA POINT--               **
9337C               **     1) MAKE THE SPIKE                        **
9338C               **     2) TRANSLATE IT TO 2 DIMENSIONS          **
9339C               **     3) TRANSLATE IT TO 0-100 UNITS           **
9340C               **     4) CLIP THE SPIKE IF NEEDED              **
9341C               **     5) DRAW OUT THE SPIKE                    **
9342C               **************************************************
9343C
9344C
9345      IFIG='GENE'
9346C
9347      FXMIN=FX1MIN
9348      FXMAX=FX1MAX
9349      IF(IX1TSC.EQ.'LOG')FXMIN=LOG10(FX1MIN)
9350      IF(IX1TSC.EQ.'LOG')FXMAX=LOG10(FX1MAX)
9351C
9352      FYMIN=FY1MIN
9353      FYMAX=FY1MAX
9354      IF(IY1TSC.EQ.'LOG')FYMIN=LOG10(FY1MIN)
9355      IF(IY1TSC.EQ.'LOG')FYMAX=LOG10(FY1MAX)
9356C
9357      FXRANG=FXMAX-FXMIN
9358      FYRANG=FYMAX-FYMIN
9359      PXRANG=PXMAX-PXMIN
9360      PYRANG=PYMAX-PYMIN
9361C
9362      DO7100I=1,NP
9363C
9364      CALL D3MKSP(PX,PY,PZ,NP,I,
9365     1IDIR,
9366     1ABASE,ABASE,ABASE,
9367     1PX2,PY2,PZ2,NP2)
9368C
9369      CALL D3TR32(PX2,PY2,PZ2,NP2,PX3,PY3,NP3)
9370C
9371      CALL D3TRXP(PX3,PY3,NP3,IDIR,ABASE,
9372     1FXMIN,FXMAX,FXRANG,FYMIN,FYMAX,FYRANG,
9373     1PXMIN,PXMAX,PXRANG,PYMIN,PYMAX,PYRANG,
9374     1PX3,PY3,NP3,PBASE)
9375C
9376      CALL DPSQUE(PX3,PY3,NP3,
9377     1PXMIN,PXMAX,PYMIN,PYMAX)
9378C
9379      CALL GRDRPL(PX3,PY3,NP3,
9380     1IFIG,IPATTT,PTHICK,ICOL,
9381     1JPATTT,JTHICK,PTHIC2,JCOL)
9382C
9383 7100 CONTINUE
9384C
9385C               *****************
9386C               **  STEP 90--  **
9387C               **  EXIT       **
9388C               *****************
9389C
9390 9000 CONTINUE
9391      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRSP')GOTO9090
9392      WRITE(ICOUT,999)
9393      CALL DPWRST('XXX','BUG ')
9394      WRITE(ICOUT,9011)
9395 9011 FORMAT('***** AT THE END       OF D3DRSP--')
9396      CALL DPWRST('XXX','BUG ')
9397      WRITE(ICOUT,9012)NP
9398 9012 FORMAT('NP = ',I8)
9399      CALL DPWRST('XXX','BUG ')
9400      WRITE(ICOUT,9013)ICASPL,ICAS3D
9401 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
9402      CALL DPWRST('XXX','BUG ')
9403      WRITE(ICOUT,9014)HOLD
9404 9014 FORMAT('HOLD = ',E15.7)
9405      CALL DPWRST('XXX','BUG ')
9406      WRITE(ICOUT,9015)ABASE,PBASE,PBASE2
9407 9015 FORMAT('ABASE,PBASE,PBASE2 = ',3E15.7)
9408      CALL DPWRST('XXX','BUG ')
9409      IF(NP.LE.3)GOTO9029
9410      DO9025I=1,3
9411      WRITE(ICOUT,9026)I,XRAW(I),YRAW(I),ZRAW(I)
9412 9026 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
9413      CALL DPWRST('XXX','BUG ')
9414 9025 CONTINUE
9415      NPM2=NP-2
9416      DO9027I=NPM2,NP
9417      WRITE(ICOUT,9028)I,XRAW(I),YRAW(I),ZRAW(I)
9418 9028 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
9419      CALL DPWRST('XXX','BUG ')
9420 9027 CONTINUE
9421 9029 CONTINUE
9422      WRITE(ICOUT,9030)ISORSW
9423 9030 FORMAT('ISORSW = ',A4)
9424      CALL DPWRST('XXX','BUG ')
9425      WRITE(ICOUT,9031)ISP2LI
9426 9031 FORMAT('ISP2LI= ',A4)
9427      CALL DPWRST('XXX','BUG ')
9428      WRITE(ICOUT,9032)PSP2TH
9429 9032 FORMAT('PSP2TH= ',E15.7)
9430      CALL DPWRST('XXX','BUG ')
9431      WRITE(ICOUT,9033)ISP2CO,ISP2DI
9432 9033 FORMAT('ISP2CO,ISP2DI= ',A4,2X,A4)
9433      CALL DPWRST('XXX','BUG ')
9434      WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
9435 9044 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
9436      CALL DPWRST('XXX','BUG ')
9437      WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
9438 9045 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
9439      CALL DPWRST('XXX','BUG ')
9440      WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
9441 9046 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
9442      CALL DPWRST('XXX','BUG ')
9443      WRITE(ICOUT,9047)IX1TSC,IY1TSC
9444 9047 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
9445      CALL DPWRST('XXX','BUG ')
9446      WRITE(ICOUT,9051)IFIG
9447 9051 FORMAT('IFIG = ',A4)
9448      CALL DPWRST('XXX','BUG ')
9449      WRITE(ICOUT,9052)IPATTT,JPATTT
9450 9052 FORMAT('IPATTT,JPATTT = ',A4,I8)
9451      CALL DPWRST('XXX','BUG ')
9452      WRITE(ICOUT,9053)PTHICK,JTHICK,PTHIC2
9453 9053 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
9454      CALL DPWRST('XXX','BUG ')
9455      WRITE(ICOUT,9054)ICOL,JCOL,IDIR
9456 9054 FORMAT('ICOL,JCOL,IDIR = ',A4,I8,2X,A4)
9457      CALL DPWRST('XXX','BUG ')
9458      WRITE(ICOUT,9055)ITYPE
9459 9055 FORMAT('ITYPE = ',A4)
9460      CALL DPWRST('XXX','BUG ')
9461      WRITE(ICOUT,9069)IBUGG4,ISUBG4,IERRG4
9462 9069 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
9463      CALL DPWRST('XXX','BUG ')
9464      WRITE(ICOUT,9071)NP2,NP3
9465 9071 FORMAT('NP2,NP3 = ',2I8)
9466      CALL DPWRST('XXX','BUG ')
9467 9090 CONTINUE
9468C
9469      RETURN
9470      END
9471      SUBROUTINE D3DRTR(XRAW,YRAW,ZRAW,PX,PY,PZ,NP,PY2,PX2,NP2,
9472     1PY3,PX3,NP3,
9473     1ICASPL,ICAS3D,
9474     1ISORSW,
9475     1ILI2PA,ILI2CO,PLI2TH,
9476     1ARE2BA,
9477     1IRE2FS,IRE2FC,
9478     1IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS,
9479     1PXMIN,PXMAX,PYMIN,PYMAX,
9480     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
9481     1IX1TSC,IY1TSC)
9482C
9483C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
9484C              DRAW A SINGLE TRACE OF Y(.) VERSUS X(.)
9485C              FOR A SPECIFIED LINE TYPE, COLOR, AND THICKNESS.
9486C              AND (IF CALLED FOR) FILL IN BELOW/ABOVE THE TRACE
9487C              TO THE BASE LINE ARE2BA.
9488C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
9489C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
9490C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
9491C           BACK IN THE MAIN ROUTINE.
9492C
9493C     WRITTEN BY--JAMES J. FILLIBEN
9494C                 STATISTICAL ENGINEERING DIVISION
9495C                 INFORMATION TECHNOLOGY LABORATORY
9496C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9497C                 GAITHERSBURG, MD 20899
9498C                 PHONE--301-975-2855
9499C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9500C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9501C     LANGUAGE--ANSI FORTRAN (1977)
9502C     VERSION NUMBER--83.6
9503C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
9504C     UPDATED         --FEBRUARY  1988.   STAR PLOT
9505C     UPDATED         --SEPTEMBER 1988.  LOG/WEIBULL CHECK AS A SUBROUTINE
9506C     UPDATED         --SEPTEMBER 1988.  RENUMBER
9507C     UPDATED         --AUGUST    1992.  CALL TO DPFIRE
9508C     UPDATED         --JULY      1993.  NORMAL SCALE (JJF)
9509C
9510C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
9511C
9512      CHARACTER*4 ICASPL
9513      CHARACTER*4 ICAS3D
9514C
9515      CHARACTER*4 ISORSW
9516C
9517      CHARACTER*4 ILI2PA
9518      CHARACTER*4 ILI2CO
9519C
9520      CHARACTER*4 IRE2FS
9521      CHARACTER*4 IRE2FC
9522      CHARACTER*4 IRE2PT
9523      CHARACTER*4 IRE2PL
9524      CHARACTER*4 IRE2PC
9525C
9526      CHARACTER*4 IX1TSC
9527      CHARACTER*4 IY1TSC
9528C
9529      CHARACTER*4 IFIG
9530      CHARACTER*4 IPATT
9531      CHARACTER*4 ICOL
9532C
9533      CHARACTER*4 ICOLF
9534      CHARACTER*4 ICOLP
9535C
9536      CHARACTER*4 ICASAX
9537C
9538CCCCC AUGUST 1992.
9539      CHARACTER*4 IPATT2
9540C
9541      DIMENSION XRAW(*)
9542      DIMENSION YRAW(*)
9543      DIMENSION ZRAW(*)
9544      DIMENSION PX(*)
9545      DIMENSION PY(*)
9546      DIMENSION PZ(*)
9547      DIMENSION PY2(*)
9548      DIMENSION PX2(*)
9549      DIMENSION PY3(*)
9550      DIMENSION PX3(*)
9551C
9552C-----COMMON----------------------------------------------------------
9553C
9554      INCLUDE 'DPCOGR.INC'
9555      INCLUDE 'DPCOBE.INC'
9556      INCLUDE 'DPCO3D.INC'
9557      INCLUDE 'DPCOP2.INC'
9558C
9559C-----START POINT-----------------------------------------------------
9560C
9561      HOLD=1.0
9562      ABASE=0.0
9563      PBASE=0.0
9564      PBASE2=0.0
9565      PLEFT=0.0
9566      PRIGHT=0.0
9567      AWIDTH=0.0
9568      PWIDTH=0.0
9569      FYRATI=0.0
9570C
9571      FXMIN=FX1MIN
9572      FXMAX=FX1MAX
9573      FYMIN=FY1MIN
9574      FYMAX=FY1MAX
9575C
9576      AHUNDR=100.0
9577      ABASE2=0.0
9578C
9579      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRTR')GOTO90
9580      WRITE(ICOUT,999)
9581  999 FORMAT(1X)
9582      CALL DPWRST('XXX','BUG ')
9583      WRITE(ICOUT,51)
9584   51 FORMAT('***** AT THE BEGINNING OF D3DRTR--')
9585      CALL DPWRST('XXX','BUG ')
9586      WRITE(ICOUT,52)NP,NP3
9587   52 FORMAT('NP,NP3 = ',2I8)
9588      CALL DPWRST('XXX','BUG ')
9589      DO45I=1,NP3
9590      WRITE(ICOUT,46)I,PX3(I),PY3(I)
9591   46 FORMAT('I,PX3(I),PY3(I) = ',I8,2G15.7)
9592      CALL DPWRST('XXX','BUG ')
9593   45 CONTINUE
9594      WRITE(ICOUT,53)ICASPL,ICAS3D
9595   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
9596      CALL DPWRST('XXX','BUG ')
9597      IF(NP.LE.3)GOTO69
9598      DO65I=1,3
9599      WRITE(ICOUT,66)I,XRAW(I),YRAW(I),ZRAW(I)
9600   66 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
9601      CALL DPWRST('XXX','BUG ')
9602   65 CONTINUE
9603      NPM2=NP-2
9604      DO67I=NPM2,NP
9605      WRITE(ICOUT,68)I,XRAW(I),YRAW(I),ZRAW(I)
9606   68 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
9607      CALL DPWRST('XXX','BUG ')
9608   67 CONTINUE
9609   69 CONTINUE
9610      WRITE(ICOUT,70)ISORSW
9611   70 FORMAT('ISORSW = ',A4)
9612      CALL DPWRST('XXX','BUG ')
9613      WRITE(ICOUT,71)ILI2PA,ILI2CO,PLI2TH
9614   71 FORMAT('ILI2PA,ILI2CO,PLI2TH = ',A4,2X,A4,E15.7)
9615      CALL DPWRST('XXX','BUG ')
9616      WRITE(ICOUT,72)ARE2BA
9617   72 FORMAT('ARE2BA = ',E15.7)
9618      CALL DPWRST('XXX','BUG ')
9619      WRITE(ICOUT,73)IRE2FS,IRE2FC
9620   73 FORMAT('IRE2FS,IRE2FC = ',A4,2X,A4)
9621      CALL DPWRST('XXX','BUG ')
9622      WRITE(ICOUT,74)IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS
9623   74 FORMAT('IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS = ',
9624     1A4,2X,A4,2X,A4,2E15.7)
9625      CALL DPWRST('XXX','BUG ')
9626      WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
9627   84 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
9628      CALL DPWRST('XXX','BUG ')
9629      WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
9630   85 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
9631      CALL DPWRST('XXX','BUG ')
9632      WRITE(ICOUT,86)IX1TSC,IY1TSC
9633   86 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
9634      CALL DPWRST('XXX','BUG ')
9635      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
9636   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
9637      CALL DPWRST('XXX','BUG ')
9638   90 CONTINUE
9639C
9640C               *************************************************
9641C               **  STEP 11--                                  **
9642C               **  IF CALLED FOR, SORT THE DATA               **
9643C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
9644C               *************************************************
9645C
9646      IF(ISORSW.EQ.'OFF')GOTO1150
9647      IF(ICASPL.EQ.'PIEC')GOTO1150
9648      IF(ICASPL.EQ.'STAR')GOTO1150
9649      IF(ICAS3D.EQ.'ON')GOTO1150
9650      IF(ICASPL.EQ.'CONT')GOTO1150
9651C
9652CCCCC CALL SORTC(X,Y,NP,PX,PY)
9653      GOTO1190
9654C
9655 1150 CONTINUE
9656      DO1160I=1,NP
9657      PX(I)=XRAW(I)
9658      PY(I)=YRAW(I)
9659      PZ(I)=ZRAW(I)
9660 1160 CONTINUE
9661      GOTO1190
9662C
9663 1190 CONTINUE
9664C
9665C               **********************************************************
9666C               **  STEP 21--                                           **
9667C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,           **
9668C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS            **
9669C               **  ARE IN VALID RANGE.                                 **
9670C               **  IF A LOG SCALE PLOT IS CALLED FOR,                  **
9671C               **  CHECK THAT ALL   HORIZ.  AXIS DATA POINTS ARE > 0.  **
9672C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,              **
9673C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS ARE        **
9674C               **  IF A NORMAL SCALE PLOT IS CALLED FOR,              **
9675C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS ARE        **
9676C               **  STRICTLY > 0 AND STRICTLY < 100                     **
9677C               **********************************************************
9678C
9679      IF(IX1TSC.EQ.'LOG')GOTO2110
9680      GOTO2119
9681 2110 CONTINUE
9682      ICASAX='2DHO'
9683      CALL CKLOSC(PX,NP,ISORSW,ICASAX,
9684     1ISUBG4,IBUGG4,IERRG4)
9685      IF(IERRG4.EQ.'YES')GOTO9000
9686 2119 CONTINUE
9687C
9688CCCCC THE FOLLOWING SECTION WAS CHANGED JULY 1993 (JJF)
9689CCCCC IF(IX1TSC.EQ.'WEIB')GOTO2120
9690      IF(IX1TSC.EQ.'WEIB'.OR.
9691     1   IX1TSC.EQ.'NORM')GOTO2120
9692      GOTO2129
9693 2120 CONTINUE
9694      ICASAX='2DHO'
9695CCCCC CALL CKWESC(PX,NP,ISORSW,ICASAX,
9696CCCCC CALL CKPRSC(PX,NP,ISORSW,ICASAX,
9697CCCCC1ISUBG4,IBUGG4,IERRG4)
9698CCCCC IF(IERRG4.EQ.'YES')GOTO9000
9699 2129 CONTINUE
9700C
9701C               **********************************************************
9702C               **  STEP 22--                                           **
9703C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,           **
9704C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS            **
9705C               **  ARE IN VALID RANGE.                                 **
9706C               **  IF A LOG SCALE PLOT IS CALLED FOR,                  **
9707C               **  CHECK THAT ALL   VERT.   AXIS DATA POINTS ARE > 0.  **
9708C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,              **
9709C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS ARE        **
9710C               **  STRICTLY > 0 AND STRICTLY < 100                     **
9711C               **  IF A NORMAL  SCALE PLOT IS CALLED FOR,              **
9712C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS ARE        **
9713C               **  STRICTLY > 0 AND STRICTLY < 100                     **
9714C               **********************************************************
9715C
9716      IF(IY1TSC.EQ.'LOG')GOTO2210
9717      GOTO2219
9718 2210 CONTINUE
9719      ICASAX='2DVE'
9720      CALL CKLOSC(PY,NP,ISORSW,ICASAX,
9721     1ISUBG4,IBUGG4,IERRG4)
9722      IF(IERRG4.EQ.'YES')GOTO9000
9723 2219 CONTINUE
9724C
9725CCCCC THE FOLLOWING SECTION WAS CHANGED JULY 1993 (JJF)
9726CCCCC IF(IY1TSC.EQ.'WEIB')GOTO2220
9727      IF(IY1TSC.EQ.'WEIB'.OR.
9728     1   IY1TSC.EQ.'NORM')GOTO2220
9729      GOTO2229
9730 2220 CONTINUE
9731      ICASAX='2DVE'
9732CCCCC CALL CKWESC(PY,NP,ISORSW,ICASAX,
9733CCCCC CALL CKPRSC(PY,NP,ISORSW,ICASAX,
9734CCCCC1ISUBG4,IBUGG4,IERRG4)
9735CCCCC IF(IERRG4.EQ.'YES')GOTO9000
9736 2229 CONTINUE
9737C
9738C               ******************************************
9739C               **  STEP 41--                           **
9740C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
9741C               **  TRANSFORM THE DATA                  **
9742C               ******************************************
9743C
9744      IF(IX1TSC.EQ.'LOG')GOTO4110
9745      GOTO4119
9746 4110 CONTINUE
9747      DO4115I=1,NP
9748      PX(I)=LOG10(PX(I))
9749 4115 CONTINUE
9750 4119 CONTINUE
9751C
9752      ABASE=ARE2BA
9753      IF(IY1TSC.EQ.'LOG')GOTO4120
9754      GOTO4129
9755 4120 CONTINUE
9756      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0)ABASE=LOG10(ABASE)
9757      IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE=1.0
9758      DO4125I=1,NP
9759      PY(I)=LOG10(PY(I))
9760 4125 CONTINUE
9761 4129 CONTINUE
9762C
9763C               ******************************************
9764C               **  STEP 42--                           **
9765C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,  **
9766C               **  TRANSFORM THE DATA                  **
9767C               ******************************************
9768C
9769      IF(IX1TSC.EQ.'WEIB')GOTO4210
9770      GOTO4219
9771 4210 CONTINUE
9772      DO4215I=1,NP
9773      PX(I)=LOG(LOG(AHUNDR/(AHUNDR-PX(I))))
9774 4215 CONTINUE
9775 4219 CONTINUE
9776C
9777      ABASE=ARE2BA
9778      IF(IY1TSC.EQ.'WEIB')GOTO4220
9779      GOTO4229
9780 4220 CONTINUE
9781      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
9782     1ABASE2=LOG(LOG(AHUNDR/(AHUNDR-ABASE)))
9783      IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE2=0.1
9784      IF(ABASE.NE.CPUMAX.AND.ABASE.GE.AHUNDR)ABASE2=0.1
9785      ABASE=ABASE2
9786      DO4225I=1,NP
9787      PY(I)=LOG(LOG(AHUNDR/(AHUNDR-PY(I))))
9788 4225 CONTINUE
9789 4229 CONTINUE
9790C
9791CCCCC THE FOLLOWING SECTION WAS ADDED   JULY 1993 (JJF)
9792C               ******************************************
9793C               **  STEP 43--                           **
9794C               **  IF A NORMAL  SCALE PLOT IS CALLED FOR,  **
9795C               **  TRANSFORM THE DATA                  **
9796C               ******************************************
9797C
9798      IF(IX1TSC.EQ.'NORM')GOTO4310
9799      GOTO4319
9800 4310 CONTINUE
9801      DO4315I=1,NP
9802CCCCC CHANGE FOLLOWING LINE NOVEMBER 1994.
9803CCCCC PX(I)=AHUNDR*NORCDF(PX(I))
9804      CALL NORCDF(PX(I),ATEMP)
9805      PX(I)=AHUNDR*ATEMP
9806 4315 CONTINUE
9807 4319 CONTINUE
9808C
9809      ABASE=ARE2BA
9810      IF(IY1TSC.EQ.'WEIB')GOTO4320
9811      GOTO4329
9812 4320 CONTINUE
9813      CALL NORCDF(ABASE,ATEMP)
9814      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
9815     1ABASE2=AHUNDR*ATEMP
9816      IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE2=0.1
9817      IF(ABASE.NE.CPUMAX.AND.ABASE.GE.AHUNDR)ABASE2=0.1
9818      ABASE=ABASE2
9819      DO4325I=1,NP
9820CCCCC CHANGE FOLLOWING LINE NOVEMBER 1994.
9821CCCCC PY(I)=AHUNDR*NORCDF(PY(I))
9822      CALL NORCDF(PY(I),ATEMP)
9823      PY(I)=AHUNDR*ATEMP
9824 4325 CONTINUE
9825 4329 CONTINUE
9826C
9827C               **************************************************
9828C               **  STEP 51--                                   **
9829C               **  FORM THE TRACE IN RAW 3-D SPACE.            **
9830C               **************************************************
9831C
9832C               **************************************************
9833C               **  STEP 52--                                   **
9834C               **  IF HIDDEN LINE REMOVAL IS ON,               **
9835C               **  DETERMINE IF ANY PART                       **
9836C               **  OF THE TRACE IS VISIBLE;                    **
9837C               **  FORM SUBTRACES.                             **
9838C               **************************************************
9839C
9840C               **************************************************
9841C               **  STEP 53--                                   **
9842C               **  TRANSLATE THE VISIBLE SUB-TRACES            **
9843C               **  FROM THE RAW 3-D SPACE                      **
9844C               **  TO THE FINAL VISUAL 2-D PLANE.              **
9845C               **************************************************
9846C
9847      CALL D3TR32(PX,PY,PZ,NP,PX,PY,NP)
9848C
9849C               *****************************************************
9850C               **  STEP 54--                                      **
9851C               **  TRANSLATE THE 2-D PLANE DATA POINTS            **
9852C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
9853C               *****************************************************
9854C
9855      FXMIN=FX1MIN
9856      FXMAX=FX1MAX
9857      IF(IX1TSC.EQ.'LOG')FXMIN=LOG10(FX1MIN)
9858      IF(IX1TSC.EQ.'LOG')FXMAX=LOG10(FX1MAX)
9859      IF(IX1TSC.EQ.'WEIB')FXMIN=LOG(LOG(AHUNDR/(AHUNDR-FX1MIN)))
9860      IF(IX1TSC.EQ.'WEIB')FXMAX=LOG(LOG(AHUNDR/(AHUNDR-FX1MAX)))
9861CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 193 (JJF)
9862CCCCC CHANGE FOLLOWING 2 LINES NOVEMBER 1994.
9863CCCCC IF(IX1TSC.EQ.'NORM')FXMIN=AHUNDR*NORCDF(FX1MIN)
9864CCCCC IF(IX1TSC.EQ.'NORM')FXMAX=AHUNDR*NORCDF(FX1MAX)
9865      CALL NORCDF(FX1MIN,ATEMP)
9866      IF(IX1TSC.EQ.'NORM')FXMIN=AHUNDR*ATEMP
9867      CALL NORCDF(FX1MAX,ATEMP)
9868      IF(IX1TSC.EQ.'NORM')FXMAX=AHUNDR*ATEMP
9869C
9870      FYMIN=FY1MIN
9871      FYMAX=FY1MAX
9872      IF(IY1TSC.EQ.'LOG')FYMIN=LOG10(FY1MIN)
9873      IF(IY1TSC.EQ.'LOG')FYMAX=LOG10(FY1MAX)
9874      IF(IY1TSC.EQ.'WEIB')FYMIN=LOG(LOG(AHUNDR/(AHUNDR-FY1MIN)))
9875      IF(IY1TSC.EQ.'WEIB')FYMAX=LOG(LOG(AHUNDR/(AHUNDR-FY1MAX)))
9876CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 193 (JJF)
9877CCCCC CHANGE FOLLOWING 2 LINES NOVEMBER 1994.
9878CCCCC IF(IY1TSC.EQ.'NORM')FYMIN=AHUNDR*NORCDF(FY1MIN)
9879CCCCC IF(IY1TSC.EQ.'NORM')FYMAX=AHUNDR*NORCDF(FY1MAX)
9880      CALL NORCDF(FY1MIN,ATEMP)
9881      IF(IY1TSC.EQ.'NORM')FYMIN=AHUNDR*ATEMP
9882      CALL NORCDF(FY1MAX,ATEMP)
9883      IF(IY1TSC.EQ.'NORM')FYMAX=AHUNDR*ATEMP
9884C
9885      FXRANG=FXMAX-FXMIN
9886      FYRANG=FYMAX-FYMIN
9887      PXRANG=PXMAX-PXMIN
9888      PYRANG=PYMAX-PYMIN
9889C
9890      DO5410I=1,NP
9891      FXRATI=(PX(I)-FXMIN)/FXRANG
9892      FYRATI=(PY(I)-FYMIN)/FYRANG
9893      PX(I)=PXMIN+FXRATI*PXRANG
9894      PY(I)=PYMIN+FYRATI*PYRANG
9895 5410 CONTINUE
9896      IF(ABASE.NE.CPUMAX)FYRATI=(ABASE-FYMIN)/FYRANG
9897      IF(ABASE.NE.CPUMAX)PBASE=PYMIN+FYRATI*PYRANG
9898C
9899C               **************************************
9900C               **  STEP 60--                       **
9901C               **  IF CALLED FOR,                  **
9902C               **  FILL OVER/UNDER THE TRACE       **
9903C               **  (BUT CLIP FIRST, IF NECESSARY)  **
9904C               **************************************
9905C
9906      IFIG='GENE'
9907C
9908      IF(IRE2FS.EQ.'OFF')GOTO6190
9909      IPATT=IRE2PT
9910      PTHICK=PRE2PT
9911      PXGAP=PRE2PS
9912      PYGAP=PRE2PS
9913      ICOLF=IRE2FC
9914      ICOLP=IRE2PC
9915CCCCC AUGUST 1992.  SET IPATT2
9916      IPATT2='SOLI'
9917C
9918      CALL DPSQUE(PX,PY,NP,
9919     1PXMIN,PXMAX,PYMIN,PYMAX)
9920C
9921      IF(ABASE.EQ.CPUMAX)GOTO6110
9922      GOTO6120
9923C
9924 6110 CONTINUE
9925      DO6115I=1,NP
9926      PX2(I)=PX(I)
9927      PY2(I)=PY(I)
9928 6115 CONTINUE
9929      NP2=NP+1
9930      PX2(NP2)=PX(1)
9931      PY2(NP2)=PY(1)
9932C
9933      DO6116J=1,NP2
9934      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
9935      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
9936      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
9937      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
9938 6116 CONTINUE
9939C
9940CCCCC AUGUST 1992.  ADD IPATT2
9941      CALL DPFIRE(PX2,PY2,NP2,
9942CCCCC1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP)
9943     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
9944     1IPATT2)
9945C
9946      GOTO6190
9947C
9948 6120 CONTINUE
9949      PBASE2=PBASE
9950      IF(PBASE2.LT.PYMIN.AND.(PYMIN-PBASE2).LE.0.0001)PBASE2=PYMIN
9951      IF(PBASE2.GT.PYMAX.AND.(PBASE2-PYMAX).LE.0.0001)PBASE2=PYMAX
9952C
9953      NP2=5
9954      NPM1=NP-1
9955      IF(NPM1.LE.0)GOTO6190
9956      DO6125I=1,NPM1
9957      IP1=I+1
9958C
9959      PLEFT=PX(I)
9960      PRIGHT=PX(IP1)
9961      IF(PLEFT.LT.PXMIN.AND.(PXMIN-PLEFT).LE.0.0001)PLEFT=PXMIN
9962      IF(PRIGHT.GT.PXMAX.AND.(PRIGHT-PXMAX).LE.0.0001)PRIGHT=PXMAX
9963C
9964      IF(PRIGHT.LT.PXMIN)GOTO6125
9965      IF(PLEFT.GT.PXMAX)GOTO6125
9966      IF(PY(I).LT.PYMIN.AND.PBASE2.LT.PYMIN)GOTO6125
9967      IF(PY(I).GT.PYMAX.AND.PBASE2.GT.PYMAX)GOTO6125
9968C
9969      PX2(1)=PLEFT
9970      PX2(2)=PRIGHT
9971      PX2(3)=PRIGHT
9972      PX2(4)=PLEFT
9973      PX2(5)=PLEFT
9974C
9975      PY2(1)=PBASE2
9976      PY2(2)=PBASE2
9977      PY2(3)=PY(IP1)
9978      PY2(4)=PY(I)
9979      PY2(5)=PBASE2
9980C
9981      DO6126J=1,NP2
9982      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
9983      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
9984      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
9985      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
9986 6126 CONTINUE
9987C
9988CCCCC AUGUST 1992.  ADD IPATT2
9989      CALL DPFIRE(PX2,PY2,NP2,
9990CCCCC1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP)
9991     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
9992     1IPATT2)
9993 6125 CONTINUE
9994C
9995      GOTO6190
9996C
9997 6190 CONTINUE
9998C
9999C               *****************************************
10000C               **  STEP 70--                          **
10001C               **  DRAW OUT THE TRACE                 **
10002C               **  (BUT CLIP IT FIRST, IF NECESSARY)  **
10003C               *****************************************
10004C
10005      IFIG='GENE'
10006      IPATT=ILI2PA
10007      PTHICK=PLI2TH
10008      ICOL=ILI2CO
10009C
10010CCCCC PX3 AND PY3 COMMENTED OUT IN DPCLTR, SO TREAT AS
10011CCCCC SCALAR HERE FOR NOW.
10012C
10013CCCCC CALL DPCLTR(PX,PY,NP,PX2,PY2,NP2,PY3,PX3,NP3,
10014      CALL DPCLTR(PX,PY,NP,PX2,PY2,NP2,
10015     1            PXMIN,PXMAX,PYMIN,PYMAX,
10016     1            ISORSW,
10017     1            IFIG,IPATT,PTHICK,ICOL)
10018C
10019C               *****************
10020C               **  STEP 90--  **
10021C               **  EXIT       **
10022C               *****************
10023C
10024 9000 CONTINUE
10025      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRTR')GOTO9090
10026      WRITE(ICOUT,999)
10027      CALL DPWRST('XXX','BUG ')
10028      WRITE(ICOUT,9011)
10029 9011 FORMAT('***** AT THE END       OF D3DRTR--')
10030      CALL DPWRST('XXX','BUG ')
10031      WRITE(ICOUT,9012)NP
10032 9012 FORMAT('NP = ',I8)
10033      CALL DPWRST('XXX','BUG ')
10034      WRITE(ICOUT,9013)ICASPL,ICAS3D
10035 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
10036      CALL DPWRST('XXX','BUG ')
10037      IF(NP.LE.3)GOTO9029
10038      DO9025I=1,3
10039      WRITE(ICOUT,9026)I,XRAW(I),YRAW(I),ZRAW(I)
10040 9026 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
10041      CALL DPWRST('XXX','BUG ')
10042 9025 CONTINUE
10043      NPM2=NP-2
10044      DO9027I=NPM2,NP
10045      WRITE(ICOUT,9028)I,XRAW(I),YRAW(I),ZRAW(I)
10046 9028 FORMAT('I,XRAW(I),YRAW(I),ZRAW(I) = ',I8,3E15.7)
10047      CALL DPWRST('XXX','BUG ')
10048 9027 CONTINUE
10049 9029 CONTINUE
10050      WRITE(ICOUT,9030)ISORSW
10051 9030 FORMAT('ISORSW = ',A4)
10052      CALL DPWRST('XXX','BUG ')
10053      WRITE(ICOUT,9031)ILI2PA,ILI2CO,PLI2TH
10054 9031 FORMAT('ILI2PA,ILI2CO,PLI2TH = ',A4,2X,A4,E15.7)
10055      CALL DPWRST('XXX','BUG ')
10056      WRITE(ICOUT,9032)ARE2BA
10057 9032 FORMAT('ARE2BA = ',E15.7)
10058      CALL DPWRST('XXX','BUG ')
10059      WRITE(ICOUT,9033)IRE2FS,IRE2FC
10060 9033 FORMAT('IRE2FS,IRE2FC = ',A4,2X,A4)
10061      CALL DPWRST('XXX','BUG ')
10062      WRITE(ICOUT,9034)IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS
10063 9034 FORMAT('IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS = ',
10064     1A4,2X,A4,2X,A4,2E15.7)
10065      CALL DPWRST('XXX','BUG ')
10066      WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
10067 9044 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
10068      CALL DPWRST('XXX','BUG ')
10069      WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
10070 9045 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
10071      CALL DPWRST('XXX','BUG ')
10072      WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
10073 9046 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
10074      CALL DPWRST('XXX','BUG ')
10075      WRITE(ICOUT,9047)IX1TSC,IY1TSC
10076 9047 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
10077      CALL DPWRST('XXX','BUG ')
10078      WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
10079 9049 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
10080      CALL DPWRST('XXX','BUG ')
10081 9090 CONTINUE
10082C
10083      RETURN
10084      END
10085      SUBROUTINE D3MKBA(XRAW,YRAW,ZRAW,NRAW,IRAW,
10086     1IDIR,
10087     1WIDTHX,WIDTHY,WIDTHZ,
10088     1BASEX,BASEY,BASEZ,
10089     1XVECT,YVECT,ZVECT,IXNEAR,IXFAR,IYNEAR,IYFAR,IZNEAR,IZFAR,
10090     1XBAR,YBAR,ZBAR,NBAR)
10091C
10092C     PURPOSE--GIVEN A SINGLE POINT (XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW))
10093C              IN 3-SPACE, AND AN EYE POSITION,
10094C              MAKE (= CONSTRUCT) A 3-D BAR.
10095C     WRITTEN BY--JAMES J. FILLIBEN
10096C                 STATISTICAL ENGINEERING DIVISIONBAR
10097C                 INFORMATION TECHNOLOGY LABORATORY
10098C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10099C                 GAITHERSBURG, MD 20899
10100C                 PHONE--301-975-2855
10101C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10102C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10103C     LANGUAGE--ANSI FORTRAN (1977)
10104C     VERSION NUMBER--88/10
10105C     ORIGINAL VERSION--SEPTEMBER 1988.
10106C
10107C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10108C
10109      CHARACTER*4 IDIR
10110C
10111      CHARACTER*4 ISUBN1
10112      CHARACTER*4 ISUBN2
10113CCCCC CHARACTER*4 ISTEPN
10114C
10115C---------------------------------------------------------------------
10116C
10117      DIMENSION XRAW(*)
10118      DIMENSION YRAW(*)
10119      DIMENSION ZRAW(*)
10120C
10121      DIMENSION XVECT(*)
10122      DIMENSION YVECT(*)
10123      DIMENSION ZVECT(*)
10124C
10125      DIMENSION XBAR(*)
10126      DIMENSION YBAR(*)
10127      DIMENSION ZBAR(*)
10128C
10129C-----COMMON----------------------------------------------------------
10130C
10131      INCLUDE 'DPCOBE.INC'
10132      INCLUDE 'DPCO3D.INC'
10133      INCLUDE 'DPCOP2.INC'
10134C
10135C-----START POINT-----------------------------------------------------
10136C
10137      ISUBN1='D3MK'
10138      ISUBN2='BA  '
10139C
10140      IF(IBUGG4.NE.'ON'.AND.ISUBG4.NE.'MKBA')GOTO90
10141      WRITE(ICOUT,999)
10142  999 FORMAT(1X)
10143      CALL DPWRST('XXX','BUG ')
10144      WRITE(ICOUT,51)
10145   51 FORMAT('***** AT THE BEGINNING OF D3MKBA--')
10146      CALL DPWRST('XXX','BUG ')
10147      WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4
10148   52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
10149      CALL DPWRST('XXX','BUG ')
10150      WRITE(ICOUT,53)IDIR
10151   53 FORMAT('IDIR = ',A4)
10152      CALL DPWRST('XXX','BUG ')
10153      WRITE(ICOUT,54)WIDTHX,WIDTHY,WIDTHZ
10154   54 FORMAT('WIDTHX,WIDTHY,WIDTHZ = ',3E15.7)
10155      CALL DPWRST('XXX','BUG ')
10156      WRITE(ICOUT,55)BASEX,BASEY,BASEZ
10157   55 FORMAT('BASEX,BASEY,BASEZ    = ',3E15.7)
10158      CALL DPWRST('XXX','BUG ')
10159      WRITE(ICOUT,56)X3DEYE,Y3DEYE,Z3DEYE
10160   56 FORMAT('X3DEYE,Y3DEYE,Z3DEYE    = ',3E15.7)
10161      CALL DPWRST('XXX','BUG ')
10162      WRITE(ICOUT,61)XVECT(1),YVECT(1),ZVECT(1)
10163   61 FORMAT('XVECT(1),YVECT(1),ZVECT(1) = ',3E15.7)
10164      CALL DPWRST('XXX','BUG ')
10165      WRITE(ICOUT,62)XVECT(2),YVECT(2),ZVECT(2)
10166   62 FORMAT('XVECT(2),YVECT(2),ZVECT(2) = ',3E15.7)
10167      CALL DPWRST('XXX','BUG ')
10168      WRITE(ICOUT,63)IXNEAR,IXFAR,IYNEAR,IYFAR,IZNEAR,IZFAR
10169   63 FORMAT('IXNEAR,IXFAR,IYNEAR,IYFAR,IZNEAR,IZFAR = ',6I8)
10170      CALL DPWRST('XXX','BUG ')
10171      WRITE(ICOUT,71)NRAW,IRAW
10172   71 FORMAT('NRAW,IRAW = ',2I8)
10173      CALL DPWRST('XXX','BUG ')
10174      WRITE(ICOUT,72)IRAW,XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW)
10175   72 FORMAT('IRAW,XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW) = ',I8,3E15.7)
10176      CALL DPWRST('XXX','BUG ')
10177   90 CONTINUE
10178C
10179C               **************************************************
10180C               **  MAKE (= CONSTRUCT) A BAR.                 **
10181C               **************************************************
10182C
10183C               **************************************************
10184C               **  STEP 11-                                    **
10185C               **  FIND THE NEAREST (TO THE EYE) VERTEX        **
10186C               **  OF OF THE 8 VERTICES OF THE 3-D BAR         **
10187C               **************************************************
10188C
10189      X0=XRAW(IRAW)
10190      Y0=YRAW(IRAW)
10191      Z0=ZRAW(IRAW)
10192C
10193      IF(IDIR.EQ.'V')GOTO1110
10194      IF(IDIR.EQ.'H1')GOTO1120
10195      IF(IDIR.EQ.'H2')GOTO1130
10196      GOTO1110
10197C
10198 1110 CONTINUE
10199      XVECT(1)=X0-WIDTHX/2.0
10200      XVECT(2)=X0+WIDTHX/2.0
10201      YVECT(1)=Y0-WIDTHY/2.0
10202      YVECT(2)=Y0+WIDTHY/2.0
10203      ZVECT(1)=BASEZ
10204      ZVECT(2)=Z0
10205      GOTO1150
10206C
10207 1120 CONTINUE
10208      XVECT(1)=BASEX
10209      XVECT(2)=X0
10210      YVECT(1)=Y0-WIDTHY/2.0
10211      YVECT(2)=Y0+WIDTHY/2.0
10212      ZVECT(1)=Z0-WIDTHZ/2.0
10213      ZVECT(2)=Z0+WIDTHZ/2.0
10214      GOTO1150
10215C
10216 1130 CONTINUE
10217      XVECT(1)=X0-WIDTHX/2.0
10218      XVECT(2)=X0+WIDTHX/2.0
10219      YVECT(1)=BASEY
10220      YVECT(2)=Y0
10221      ZVECT(1)=Z0-WIDTHZ/2.0
10222      ZVECT(2)=Z0+WIDTHZ/2.0
10223      GOTO1150
10224C
10225 1150 CONTINUE
10226C
10227      DISTSQ=CPUMAX
10228      DO1151IX=1,2
10229      XVECT2=XVECT(IX)
10230      DO1152IY=1,2
10231      YVECT2=YVECT(IY)
10232      DO1153IZ=1,2
10233      ZVECT2=ZVECT(IZ)
10234      DISTS2=(XVECT2-X3DEYE)**2+(YVECT2-Y3DEYE)**2+(ZVECT2-Z3DEYE)**2
10235      IF(DISTS2.LT.DISTSQ)GOTO1155
10236      GOTO1153
10237 1155 CONTINUE
10238      IXNEAR=IX
10239      IYNEAR=IY
10240      IZNEAR=IZ
10241 1153 CONTINUE
10242 1152 CONTINUE
10243 1151 CONTINUE
10244C
10245      IXFAR=1
10246      IF(IXNEAR.EQ.1)IXFAR=2
10247      IYFAR=1
10248      IF(IYNEAR.EQ.1)IYFAR=2
10249      IZFAR=1
10250      IF(IZNEAR.EQ.1)IZFAR=2
10251C
10252      XBAR(1)=XVECT(IXNEAR)
10253      XBAR(2)=XVECT(IXNEAR)
10254      XBAR(3)=XVECT(IXNEAR)
10255      XBAR(4)=XVECT(IXNEAR)
10256      XBAR(5)=XVECT(IXNEAR)
10257      YBAR(1)=YVECT(IYNEAR)
10258      YBAR(2)=YVECT(IYNEAR)
10259      YBAR(3)=YVECT(IYFAR)
10260      YBAR(4)=YVECT(IYFAR)
10261      YBAR(5)=YVECT(IYNEAR)
10262      ZBAR(1)=ZVECT(IZNEAR)
10263      ZBAR(2)=ZVECT(IZFAR)
10264      ZBAR(3)=ZVECT(IZFAR)
10265      ZBAR(4)=ZVECT(IZNEAR)
10266      ZBAR(5)=ZVECT(IZNEAR)
10267C
10268      XBAR(6)=XVECT(IXNEAR)
10269      XBAR(7)=XVECT(IXFAR)
10270      XBAR(8)=XVECT(IXFAR)
10271      XBAR(9)=XVECT(IXNEAR)
10272      XBAR(10)=XVECT(IXNEAR)
10273      YBAR(6)=YVECT(IYNEAR)
10274      YBAR(7)=YVECT(IYNEAR)
10275      YBAR(8)=YVECT(IYNEAR)
10276      YBAR(9)=YVECT(IYNEAR)
10277      YBAR(10)=YVECT(IYNEAR)
10278      ZBAR(6)=ZVECT(IZNEAR)
10279      ZBAR(7)=ZVECT(IZNEAR)
10280      ZBAR(8)=ZVECT(IZFAR)
10281      ZBAR(9)=ZVECT(IZFAR)
10282      ZBAR(10)=ZVECT(IZNEAR)
10283C
10284      XBAR(11)=XVECT(IXNEAR)
10285      XBAR(12)=XVECT(IXNEAR)
10286      XBAR(13)=XVECT(IXFAR)
10287      XBAR(14)=XVECT(IXFAR)
10288      XBAR(15)=XVECT(IXNEAR)
10289      YBAR(11)=YVECT(IYNEAR)
10290      YBAR(12)=YVECT(IYFAR)
10291      YBAR(13)=YVECT(IYFAR)
10292      YBAR(14)=YVECT(IYNEAR)
10293      YBAR(15)=YVECT(IYNEAR)
10294      ZBAR(11)=ZVECT(IZNEAR)
10295      ZBAR(12)=ZVECT(IZNEAR)
10296      ZBAR(13)=ZVECT(IZNEAR)
10297      ZBAR(14)=ZVECT(IZNEAR)
10298      ZBAR(15)=ZVECT(IZNEAR)
10299C
10300      NBAR=15
10301C
10302C               *****************
10303C               **  EXIT.      **
10304C               *****************
10305C
10306      IF(IBUGG4.NE.'ON'.AND.ISUBG4.NE.'MKBA')GOTO9090
10307      WRITE(ICOUT,999)
10308      CALL DPWRST('XXX','BUG ')
10309      WRITE(ICOUT,9011)
10310 9011 FORMAT('***** AT THE END       OF D3MKBA--')
10311      CALL DPWRST('XXX','BUG ')
10312      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4
10313 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
10314      CALL DPWRST('XXX','BUG ')
10315      WRITE(ICOUT,9013)IDIR
10316 9013 FORMAT('IDIR = ',A4)
10317      CALL DPWRST('XXX','BUG ')
10318      WRITE(ICOUT,9014)WIDTHX,WIDTHY,WIDTHZ
10319 9014 FORMAT('WIDTHX,WIDTHY,WIDTHZ = ',3E15.7)
10320      CALL DPWRST('XXX','BUG ')
10321      WRITE(ICOUT,9015)BASEX,BASEY,BASEZ
10322 9015 FORMAT('BASEX,BASEY,BASEZ    = ',3E15.7)
10323      CALL DPWRST('XXX','BUG ')
10324      WRITE(ICOUT,9016)X3DEYE,Y3DEYE,Z3DEYE
10325 9016 FORMAT('X3DEYE,Y3DEYE,Z3DEYE    = ',3E15.7)
10326      CALL DPWRST('XXX','BUG ')
10327      WRITE(ICOUT,9021)XVECT(1),YVECT(1),ZVECT(1)
10328 9021 FORMAT('XVECT(1),YVECT(1),ZVECT(1) = ',3E15.7)
10329      CALL DPWRST('XXX','BUG ')
10330      WRITE(ICOUT,9022)XVECT(2),YVECT(2),ZVECT(2)
10331 9022 FORMAT('XVECT(2),YVECT(2),ZVECT(2) = ',3E15.7)
10332      CALL DPWRST('XXX','BUG ')
10333      WRITE(ICOUT,9023)IXNEAR,IXFAR,IYNEAR,IYFAR,IZNEAR,IZFAR
10334 9023 FORMAT('IXNEAR,IXFAR,IYNEAR,IYFAR,IZNEAR,IZFAR = ',6I8)
10335      CALL DPWRST('XXX','BUG ')
10336      WRITE(ICOUT,9031)NRAW,IRAW
10337 9031 FORMAT('NRAW,IRAW = ',2I8)
10338      CALL DPWRST('XXX','BUG ')
10339      WRITE(ICOUT,9032)IRAW,XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW)
10340 9032 FORMAT('IRAW,XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW) = ',I8,3E15.7)
10341      CALL DPWRST('XXX','BUG ')
10342      WRITE(ICOUT,9041)NBAR
10343 9041 FORMAT('NBAR = ',I8)
10344      CALL DPWRST('XXX','BUG ')
10345      DO9042I=1,NBAR
10346      WRITE(ICOUT,9043)I,XBAR(I),YBAR(I),ZBAR(I)
10347 9043 FORMAT('I,XBAR(I),YBAR(I),ZBAR(I) = ',I8,3E15.7)
10348      CALL DPWRST('XXX','BUG ')
10349 9042 CONTINUE
10350 9090 CONTINUE
10351C
10352      RETURN
10353      END
10354      SUBROUTINE D3MKSP(XRAW,YRAW,ZRAW,NRAW,IRAW,
10355     1IDIR,
10356     1BASEX,BASEY,BASEZ,
10357     1XSPIKE,YSPIKE,ZSPIKE,NSPIKE)
10358C
10359C     PURPOSE--GIVEN A SINGLE POINT (XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW))
10360C              IN 3-SPACE,
10361C              MAKE (= CONSTRUCT) A 3-D SPIKE.
10362C     WRITTEN BY--JAMES J. FILLIBEN
10363C                 STATISTICAL ENGINEERING DIVISIONSPIKE
10364C                 INFORMATION TECHNOLOGY LABORATORY
10365C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10366C                 GAITHERSBURG, MD 20899
10367C                 PHONE--301-975-2855
10368C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10369C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10370C     LANGUAGE--ANSI FORTRAN (1977)
10371C     VERSION NUMBER--88/10
10372C     ORIGINAL VERSION--SEPTEMBER 1988.
10373C     UPDATED         --APRIL   1992.  BASE2 TO BASEX/Y/Z
10374C
10375C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10376C
10377      CHARACTER*4 IDIR
10378C
10379      CHARACTER*4 ISUBN1
10380      CHARACTER*4 ISUBN2
10381C
10382C---------------------------------------------------------------------
10383C
10384      DIMENSION XRAW(*)
10385      DIMENSION YRAW(*)
10386      DIMENSION ZRAW(*)
10387C
10388      DIMENSION XSPIKE(*)
10389      DIMENSION YSPIKE(*)
10390      DIMENSION ZSPIKE(*)
10391C
10392C-----COMMON----------------------------------------------------------
10393C
10394      INCLUDE 'DPCOBE.INC'
10395      INCLUDE 'DPCO3D.INC'
10396      INCLUDE 'DPCOP2.INC'
10397C
10398C-----START POINT-----------------------------------------------------
10399C
10400      ISUBN1='D3MK'
10401      ISUBN2='SP  '
10402C
10403      IF(IBUGG4.NE.'ON'.AND.ISUBG4.NE.'MKSP')GOTO90
10404      WRITE(ICOUT,999)
10405  999 FORMAT(1X)
10406      CALL DPWRST('XXX','BUG ')
10407      WRITE(ICOUT,51)
10408   51 FORMAT('***** AT THE BEGINNING OF D3MKSP--')
10409      CALL DPWRST('XXX','BUG ')
10410      WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4
10411   52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
10412      CALL DPWRST('XXX','BUG ')
10413      WRITE(ICOUT,53)NRAW,IRAW
10414   53 FORMAT('NRAW,IRAW = ',2I8)
10415      CALL DPWRST('XXX','BUG ')
10416      WRITE(ICOUT,61)IDIR
10417   61 FORMAT('IDIR = ',A4)
10418      CALL DPWRST('XXX','BUG ')
10419      WRITE(ICOUT,62)BASEX,BASEY,BASEZ
10420   62 FORMAT('BASEX,BASEY,BASEZ = ',3E15.7)
10421      CALL DPWRST('XXX','BUG ')
10422      WRITE(ICOUT,63)IRAW,XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW)
10423   63 FORMAT('IRAW,XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW) = ',I8,3E15.7)
10424      CALL DPWRST('XXX','BUG ')
10425      WRITE(ICOUT,71)X3DEYE,Y3DEYE,Z3DEYE
10426   71 FORMAT('X3DEYE,Y3DEYE,Z3DEYE = ',3E15.7)
10427      CALL DPWRST('XXX','BUG ')
10428   90 CONTINUE
10429C
10430C               **************************************************
10431C               **  STEP 11-                                    **
10432C               **  MAKE (= CONSTRUCT) A SPIKE.                 **
10433C               **************************************************
10434C
10435      IF(IDIR.EQ.'V')GOTO1110
10436      IF(IDIR.EQ.'HX')GOTO1120
10437      IF(IDIR.EQ.'HY')GOTO1130
10438      GOTO1110
10439C
10440 1110 CONTINUE
10441      XSPIKE(1)=XRAW(IRAW)
10442      YSPIKE(1)=YRAW(IRAW)
10443CCCCC THE FOLLOWING LINE WAS FIXED    APRIL 1992 (ALAN)
10444CCCCC ZSPIKE(1)=BASE2
10445      ZSPIKE(1)=BASEZ
10446      GOTO1150
10447C
10448 1120 CONTINUE
10449CCCCC THE FOLLOWING LINE WAS FIXED    APRIL 1992 (ALAN)
10450CCCCC XSPIKE(1)=BASE2
10451      XSPIKE(1)=BASEX
10452      YSPIKE(1)=YRAW(IRAW)
10453      ZSPIKE(1)=ZRAW(IRAW)
10454      GOTO1150
10455C
10456 1130 CONTINUE
10457      XSPIKE(1)=XRAW(IRAW)
10458CCCCC THE FOLLOWING LINE WAS FIXED    APRIL 1992 (ALAN)
10459CCCCC YSPIKE(1)=BASE2
10460      YSPIKE(1)=BASEY
10461      ZSPIKE(1)=ZRAW(IRAW)
10462      GOTO1150
10463C
10464 1150 CONTINUE
10465C
10466      XSPIKE(2)=XRAW(IRAW)
10467      YSPIKE(2)=YRAW(IRAW)
10468      ZSPIKE(2)=ZRAW(IRAW)
10469C
10470      NSPIKE=2
10471C
10472C               *****************
10473C               **  EXIT.      **
10474C               *****************
10475C
10476      IF(IBUGG4.NE.'ON'.AND.ISUBG4.NE.'MKSP')GOTO9090
10477      WRITE(ICOUT,999)
10478      CALL DPWRST('XXX','BUG ')
10479      WRITE(ICOUT,9011)
10480 9011 FORMAT('***** AT THE END       OF D3MKSP--')
10481      CALL DPWRST('XXX','BUG ')
10482      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4
10483 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
10484      CALL DPWRST('XXX','BUG ')
10485      WRITE(ICOUT,9013)IDIR
10486 9013 FORMAT('IDIR = ',A4)
10487      CALL DPWRST('XXX','BUG ')
10488      WRITE(ICOUT,9014)BASEX,BASEY,BASEZ
10489 9014 FORMAT('BASEX,BASEY,BASEZ = ',3E15.7)
10490      CALL DPWRST('XXX','BUG ')
10491      WRITE(ICOUT,9021)NRAW,IRAW
10492 9021 FORMAT('NRAW,IRAW = ',2I8)
10493      CALL DPWRST('XXX','BUG ')
10494      WRITE(ICOUT,9022)IRAW,XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW)
10495 9022 FORMAT('IRAW,XRAW(IRAW),YRAW(IRAW),ZRAW(IRAW) = ',I8,3E15.7)
10496      CALL DPWRST('XXX','BUG ')
10497      WRITE(ICOUT,9031)X3DEYE,Y3DEYE,Z3DEYE
10498 9031 FORMAT('X3DEYE,Y3DEYE,Z3DEYE = ',3E15.7)
10499      CALL DPWRST('XXX','BUG ')
10500      WRITE(ICOUT,9041)NSPIKE
10501 9041 FORMAT('NSPIKE = ',I8)
10502      CALL DPWRST('XXX','BUG ')
10503      DO9042I=1,NSPIKE
10504      WRITE(ICOUT,9043)I,XSPIKE(I),YSPIKE(I),ZSPIKE(I)
10505 9043 FORMAT('I,XSPIKE(I),YSPIKE(I),ZSPIKE(I) = ',I8,3E15.7)
10506      CALL DPWRST('XXX','BUG ')
10507 9042 CONTINUE
10508 9090 CONTINUE
10509C
10510      RETURN
10511      END
10512      SUBROUTINE D3SCAL(PX,PY,NP)
10513C
10514C     PURPOSE--EXECUTE A SCALING AND TRANSLATION
10515C      OF 3D POINTS THAT HAVE ALREADY
10516C     BEEN TRANSLATED INTO 2D VALUES
10517C     BUT NOW NEED TO BE SCALED AND TRANSLATED
10518C     TO PROPER 0 TO 100 SCREEN VALUES.
10519C     WRITTEN BY--JAMES J. FILLIBEN
10520C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10521C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10522C     LANGUAGE--ANSI FORTRAN (1977)
10523C     VERSION NUMBER--93/10
10524C     ORIGINAL VERSION--SEPTEMBER 1993.
10525C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1993.
10526C
10527C-----COMMON STATEMENTS-----------------------------------------------
10528C
10529      INCLUDE 'DPCOPA.INC'
10530C
10531      INCLUDE 'DPCO3D.INC'
10532      INCLUDE 'DPCOPC.INC'
10533      INCLUDE 'DPCOBE.INC'
10534C
10535C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10536C
10537      CHARACTER*4 ISUBN1
10538      CHARACTER*4 ISUBN2
10539CCCCC CHARACTER*4 ISTEPN
10540C
10541C---------------------------------------------------------------------
10542C
10543      DIMENSION PX(*)
10544      DIMENSION PY(*)
10545C
10546C-----COMMON----------------------------------------------------------
10547C
10548      INCLUDE 'DPCOP2.INC'
10549C
10550C-----START POINT-----------------------------------------------------
10551C
10552      ISUBN1='D3SC'
10553      ISUBN2='AL  '
10554C
10555      FXMIN=FX1MIN
10556      FXMAX=FX1MAX
10557      FYMIN=FY1MIN
10558      FYMAX=FY1MAX
10559C
10560      FXRANG=FXMAX-FXMIN
10561      FYRANG=FYMAX-FYMIN
10562      PXRANG=PXMAX-PXMIN
10563      PYRANG=PYMAX-PYMIN
10564C
10565      DO1000I=1,NP
10566      FXRATI=(PX(I)-FXMIN)/FXRANG
10567      FYRATI=(PY(I)-FYMIN)/FYRANG
10568      PX(I)=PXMIN+FXRATI*PXRANG
10569      PY(I)=PYMIN+FYRATI*PYRANG
10570 1000 CONTINUE
10571C
10572      RETURN
10573      END
10574      SUBROUTINE D3TR32(X,Y,Z,N,XT,ZT,NT)
10575C
10576C     PURPOSE--EXECUTE A 3-D TRANSFORMATION
10577C              (ORTHOGRAPHIC OR PERSPECTIVE)
10578C              WHICH TAKES A 3-D DATA CLOUD
10579C              AND MAPS IN ONTO A 2-D PLANE
10580C              (IDENTICALLY THE ORIGINAL XZ PLANE).
10581C     WRITTEN BY--JAMES J. FILLIBEN
10582C                 STATISTICAL ENGINEERING DIVISION
10583C                 INFORMATION TECHNOLOGY LABORATORY
10584C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10585C                 GAITHERSBURG, MD 20899
10586C                 PHONE--301-975-2855
10587C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10588C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10589C     LANGUAGE--ANSI FORTRAN (1977)
10590C     VERSION NUMBER--88/10
10591C     ORIGINAL VERSION--MARCH     1979.
10592C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1988.
10593C     UPDATE          --JUNE      1990.  COMPILE ERROR IN A WRITE STATEMENT
10594C
10595C-----COMMON STATEMENTS-----------------------------------------------
10596C
10597      INCLUDE 'DPCO3D.INC'
10598      INCLUDE 'DPCOBE.INC'
10599C
10600C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10601C
10602      CHARACTER*4 ISUBN1
10603      CHARACTER*4 ISUBN2
10604      CHARACTER*4 ISTEPN
10605C
10606C---------------------------------------------------------------------
10607C
10608      DIMENSION X(*)
10609      DIMENSION Y(*)
10610      DIMENSION Z(*)
10611      DIMENSION XT(*)
10612      DIMENSION ZT(*)
10613C
10614C-----COMMON----------------------------------------------------------
10615C
10616      INCLUDE 'DPCOP2.INC'
10617C
10618C-----START POINT-----------------------------------------------------
10619C
10620      ISUBN1='D3TR'
10621      ISUBN2='32  '
10622      IERRG4='NO'
10623C
10624      EPS=0.0000001
10625      TERMZX=0.0
10626      TERMZY=0.0
10627      TERMZZ=0.0
10628      TERMXX=0.0
10629      TERMXY=0.0
10630      TERMXZ=0.0
10631C
10632      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TR32')GOTO90
10633      WRITE(ICOUT,999)
10634  999 FORMAT(1X)
10635      CALL DPWRST('XXX','BUG ')
10636      WRITE(ICOUT,51)
10637   51 FORMAT('***** AT THE BEGINNING OF D3TR32--')
10638      CALL DPWRST('XXX','BUG ')
10639      WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4
10640   52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
10641      CALL DPWRST('XXX','BUG ')
10642      WRITE(ICOUT,53)I3DPRO
10643   53 FORMAT('I3DPRO = ',A4)
10644      CALL DPWRST('XXX','BUG ')
10645      WRITE(ICOUT,54)X3DEYE,Y3DEYE,Z3DEYE
10646   54 FORMAT('X3DEYE,Y3DEYE,Z3DEYE = ',3E15.7)
10647      CALL DPWRST('XXX','BUG ')
10648      WRITE(ICOUT,55)X3DMID,Y3DMID,Z3DMID
10649   55 FORMAT('X3DMID,Y3DMID,Z3DMID = ',3E15.7)
10650      CALL DPWRST('XXX','BUG ')
10651      WRITE(ICOUT,64)D3DCXX,D3DCXY,D3DCXZ
10652   64 FORMAT('D3DCXX,D3DCXY,D3DCXZ = ',3E15.7)
10653      CALL DPWRST('XXX','BUG ')
10654      WRITE(ICOUT,65)D3DCYX,D3DCYY,D3DCYZ
10655   65 FORMAT('D3DCYX,D3DCYY,D3DCYZ = ',3E15.7)
10656      CALL DPWRST('XXX','BUG ')
10657      WRITE(ICOUT,66)D3DCZX,D3DCZY,D3DCZZ
10658   66 FORMAT('D3DCZX,D3DCZY,D3DCZZ = ',3E15.7)
10659      CALL DPWRST('XXX','BUG ')
10660      WRITE(ICOUT,71)N
10661   71 FORMAT('N = ',I8)
10662      CALL DPWRST('XXX','BUG ')
10663      DO72I=1,N
10664      WRITE(ICOUT,73)I,X(I),Y(I),Z(I)
10665   73 FORMAT('I,X(I),Y(I),Z(I) = ',I8,3E15.7)
10666      CALL DPWRST('XXX','BUG ')
10667   72 CONTINUE
10668   90 CONTINUE
10669C
10670C               *********************************************************
10671C               **  GENERAL DISCUSSION--                               **
10672C               **  DETERMINE (IN ORIGINAL COORDINATE SYSTEM VALUES)   **
10673C               **  WHERE THE DATA POINTS FALL ON THE VISUAL PLANE.    **
10674C               **  FOR EACH (XD,YD,ZD) DATA POINT,                    **
10675C               **  DETERMINE WHERE THE VISUAL RAY FROM                **
10676C               **  THE DATA POINT TO OUR EYE                          **
10677C               **  STRIKES THE VISUAL (PERSPECTIVE) PLANE.            **
10678C               **  THE VISUAL PLANE IS THAT PLANE                     **
10679C               **  WHICH IS NORMAL TO OUR EYE                         **
10680C               **  AND WHICH CONTAINS THE AVERAGE POINT (XM,YM,ZM).   **
10681C               **  THE EQUATION OF THE VISUAL PLANE IS                **
10682C               **  (X3DEYE-XM)(X-XM) + (Y3DEYE-YM)(Y-YM) +
10683C               **                    + (Z3DEYE-YM)(Z-ZM) = 0          **
10684C               **  WHERE X, Y, Z ARE THE DUMMY VARIABLES              **
10685C               **  REPRESENTING ANY POINT (X,Y,Z) ON THAT PLANE.      **
10686C               **  THIS EQUATION MUST BE SOLVED FOR X, Y, AND Z.      **
10687C               **  THE EQUATIONS OF THE LINE FROM THE DATA POINT
10688C               **  (XD,YD,ZD)
10689C               **  TO OUR EYE (X3DEYE,Y3DEYE,Z3DEYE) ARE
10690C               **  (X-XD)/(X3DEYE-XD) = (Y-YD)/(Y3DEYE-YD)
10691C               **                     = (Z-ZD)/(Z3DEYE-ZD)
10692C               **  WHERE (XD,YD,ZD) REPRESENTS A DATA POINT.           **
10693C               **  THE VISUAL PLANE EQUATION AND THE LINE EQUATIONS    **
10694C               **  MUST BE COMBINED TO SOLVE FOR THE VALUES (X,Y,Z)    **
10695C               **  ON THE VISUAL PLANE AS OUR EYE SEES THEM.           **
10696C               **********************************************************
10697C
10698C               **********************************************************
10699C               **  THE FINAL PLOT STATEMENT WILL INVOLVE
10700C               **  ONLY 2 VECTORS.
10701C               **  AT THE MOMENT, THE POINTS (XP,YP,ZP)
10702C               **  ON THE VISUAL PLANE ARE DEFINED
10703C               **  BY 3 COORDINATE VALUES.
10704C               **  TO REDUCE THE 3 COORDINATE VALUES
10705C               **  TO 2 COORDINATE VALUES,
10706C               **  WE MUST ROTATE THE VISUAL PLANE
10707C               **  SO THAT IT IS PARALLEL TO THE ORIGINAL XZ PLANE.
10708C               **  TO CARRY OUT SUCH A ROTATION, WE MUST
10709C               **  DETERMINE THE DIRECTION NUMBERS AND DIRECTION COSINES
10710C               **  OF THE NEW AXES IN TERMS OF THE OLD COORDINATE SYSTEM.
10711C               **  THE NEW Y AXIS WILL (BY CONSTRUCTION) BE
10712C               **  ON THE NORMAL LINE TRAVELING FROM
10713C               **  THE AVERAGE POINT (XM,YM,ZM) TO OUR EYE POINT
10714C               **  (X3DEYE,Y3DEYE,Z3DEYE)
10715C               **  AND WILL THEREFORE HAVE DIRECTIONS NUMBERS
10716C               **  X3DEYE, Y3DEYE, Z3DEYE
10717C               **  THE NEW Z AXIS WILL BE PERPENDICULAR TO THE NEW Y AXIS
10718C               **  AND WILL RESIDE IN THE PLANE CONTAINING THE
10719C               **  THE FOLLOWING 3 POINTS--
10720C               **      1) THE AVERAGE POINT (XM,YM,ZM)
10721C               **      2) THE EYE POINT (X3DEYE,Y3DEYE,Z3DEYE)
10722C               **      3) SOME POINT (SAY (XM,YM,ZM+1)) OF THE OLD Z AXIS
10723C               **         DISPLACED OVER SO AS TO EMANATE FROM (XM,YM,ZM).
10724C               **  THE ABOVE 3 POINTS DEFINE A VERTICAL PLANE.
10725C               **  THE PURPOSE OF THE VERTICAL PLANE IS TO DEFINE
10726C               **  WHICH DIRECTION IS 'UP' IN THE FINAL PICTURE.
10727C               **  THE EQUATION OF THE VERTICAL PLANE IS
10728C               **  (A-XM)(X-XM) + (B-YM)(Y-YM) + (C-ZM)(Z-ZM) = 0 .
10729C               **  THIS EQUATION MUST BE SOLVED FOR A, B, AND C.
10730C               **  WITHOUT LOSS OF GENERALITY, A MAY BE INITIALLY SET TO 1.
10731C               **  THE SOLUTION TURNS OUT TO BE
10732C               **      A = 1
10733C               **      B = -X3DEYE/Y3DEYE
10734C               **      C = 0
10735C               **  NOTE, HOWEVER, THAT THESE A, B, AND C VALUES
10736C               **  FOR THIS VERTICAL PLANE WILL BE IDENTICAL TO THE
10737C               **  DIRECTION NUMBERS FOR THE NORMAL TO THIS VERTICAL PLANE
10738C               **  WHICH IS IDENTICALLY THE NEW X AXIS
10739C               **  AND SO THE ABOVE A, B, AND C VALUES DEFINE THE DIRECTION
10740C               **  DIRECTION NUMBERS FOR THE NEW X AXIS.
10741C               **  TO SOLVE FOR THE DIRECTION NUMBERS FOR THE NEW Z AXIS,
10742C               **  WE SEEK 3 DIRECTION NUMBERS D, E, AND F
10743C               **  WHICH MUST BE PERPENDICULAR TO BOTH THE
10744C               **  NEW Y AXIS (WITH DIRECTION NUMBERS X3DEYE, Y3DEYE,
10745C               **  AND Z3DEYE)
10746C               **  AND THE NEW X AXIS (WITH DIRECTION NUMBERS A, B, AND C ABOVE
10747C               **  WITHOUT LOSS OF GENERALITY, D MAY BE INITIALLY SET TO 1.
10748C               **  NOTE THAT WHENEVER 2 LINES ARE PERPENDICULAR,
10749C               **  THE INNER PRODUCT OF THE DIRECTION NUMBERS MUST = 0.
10750C               **  WITHOUT LOSS OF GENERALITY, D MAY BE INITIALLY SET TO 1.
10751C               **  INCORPORATING THE 2 INNER PRODUCT EQUATIONS,
10752C               **  WE MAY SOLVE FOR E AND F.
10753C               **  THE SOLUTIONS TURN OUT TO BE
10754C               **      D = 1
10755C               **      E = Y3DEYE/X3DEYE
10756C               **      F = (-X3DEYE*X3DEYE - Y3DEYE*Y3DEYE) / (X3DEYE*Z3DEYE)
10757C               **
10758C               **  IN SUMMARY, THE DIRECTION NUMBERS FOR THE 3 NEW AXES
10759C               **  MAY BE WRITTEN AS
10760C               **      NEW X AXIS:  Y3DEYE       -X3DEYE     0
10761C               **      NEW Y AXIS:  X3DEYE       Y3DEYE      Z3DEYE
10762C               **      NEW Z AXIS:  -X3DEYE*Z3DEYE   -Y3DEYE*Z3DEYE
10763C               **                                        X3DEYE*X3DEYE+Y3DEYE
10764C               **  NOTE THAT BY INSPECTION WE SEE RETROSPECTIVELY
10765C               **  THAT THE 3 INNER PRODUCTS ALL = 0
10766C               **  AND SO THE 3 DEFINED AXES ARE ALL PERPENDICULAR
10767C               **  (AS THEY SHOULD BE).
10768C               **
10769C               **  THE CORRESPONDING DIRECTION COSINES
10770C               **  ARE GOTTEN BY NORMALIZATION TO UNITY;
10771C               **  LET US SYMBOLICALLY REPRESENT THEM BY--
10772C               **      D3DCXX   D3DCXY   D3DCXZ
10773C               **      D3DCYX   D3DCYY   D3DCYZ
10774C               **      D3DCZX   D3DCZY   D3DCZZ
10775C               **  THE ABOVE RESULTS WERE ACTUALLY ARRIVED AT
10776C               **  (AND ARE VALID FOR) BY DISPLACING THE OLD ORIGIN
10777C               **  FROM (0,0,0) TO (XM,YM,ZM).
10778C               **  THIS SIMPLIFIES THE EQUATIONS CONSIDERABLY.
10779C               **
10780C               **  GIVEN THAT WE NOW HAVE THE DIRECTION COSINES
10781C               **  OF THE NEW AXES IN TERMS OF THE OLD COORDINATES,
10782C               **  WE MAKE USE OF
10783C               **  EISENHART (COORDINATE GEOMETRY, PAGE 160) WHICH STATES
10784C               **  THAT THE LINEAR TRANSFORMATION THAT IS NEEDED TO CARRY OUT
10785C               **  THE ROTATION FROM THE VISUAL PLANE TO THE XZ PLANE
10786C               **  IS GIVEN BY
10787C               **      XT = XM + D3DCXX(X-XM) + D3DCXY(Y-YM) + D3DCXZ(Z-ZM)
10788C               **      YT = YM + D3DCYX(X-XM) + D3DCYY(Y-YM) + D3DCYZ(Z-ZM)
10789C               **      ZT = ZM + D3DCZX(X-XM) + D3DCZY(Y-YM) + D3DCZZ(Z-ZM)
10790C               **
10791C               **  NOTE THAT BY INSPECTION OF THE ABOVE TRANSFORMATION
10792C               **  IT IS SEEN THAT (XM,YM,ZM) IS MAPPED INTO (XM,YM,ZM)
10793C               **  (AS IT SHOULD BE).
10794C               **  NOTE ALSO THAT THE EYE POINT AND ANY POINT ALONG THE LINE
10795C               **  OF SIGHT WOULD HAVE BEEN MAPPED INTO (XM,YM,ZM)
10796C               **  AS IT SHOULD BE.
10797C               **  NOTE ALSO THAT ALL POINTS ON THE VISUAL PLANE
10798C               **  SINCE THEY SATISFY
10799C               **     (X3DEYE-XM)(X-XM) + (Y3DEYE-YM)(Y-YM) + (Z3DEYE-ZM)(Z-ZM)
10800C               **     = 0
10801C               **  GETS MAPPED INTO THE CONSTANT YT VALUE OF YT = YM
10802C               **  AND SO THE TRANSFORMED PLOT SURFACE IS ONE WHICH
10803C               **  IS PARALLEL TO THE XZ PLANE BUT IS DISPLACED
10804C               **  YM UNITS OUT FROM THE XZ PLANE.
10805C               **  THIS PLOT PLANE WILL CONTAIN THE POINT (XM,YM,ZM).
10806C               ****************************************************************
10807C
10808C               **************************************************
10809C               **  STEP 11--                                   **
10810C               **  BRANCH TO THE APPROPRIATE                   **
10811C               **  TRANSFORMATION                              **
10812C               **************************************************
10813C
10814      ISTEPN='11'
10815      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TR32')
10816     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10817C
10818      NT=N
10819C
10820      XDEL=X3DEYE-X3DMID
10821      IF(XDEL.EQ.0.0)XDEL=EPS
10822      YDEL=Y3DEYE-Y3DMID
10823      IF(YDEL.EQ.0.0)YDEL=EPS
10824      ZDEL=Z3DEYE-Z3DMID
10825      IF(ZDEL.EQ.0.0)ZDEL=EPS
10826C
10827      IF(I3DPRO.EQ.'ORTH')GOTO2100
10828      GOTO3100
10829C
10830C               **************************************************
10831C               **  STEP 21--                                   **
10832C               **  TREAT THE ORTHOGRAPHIC TRANSFORMATION CASE  **
10833C               **************************************************
10834C
10835 2100 CONTINUE
10836C
10837      ISTEPN='21'
10838      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TR32')
10839     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10840C
10841C     THE FOLLOWING IS INCORRECT (XM FOR X(I) ETC.)
10842CCCCC MAY 1996.  NP12 IS UNDEFINED.  USE NT.
10843CCCCC DO2110I=1,NP12
10844      DO2110I=1,NT
10845C
10846C     ***** 5 LINES OF CODE TO ADJUST FOR DIVISION BY 0 ADDED AUGUST 1983 *****
10847CCCCC A11=XDEL
10848CCCCC A12=YDEL
10849CCCCC A13=ZDEL
10850CCCCC A23=Y3DEYE-Y3DMID
10851CCCCC IF(A23.EQ.0.0)A21=EPS
10852CCCCC A23=-(X3DEYE-X3DMID)
10853CCCCC IF(A23.EQ.0.0)A22=EPS
10854CCCCC A23=0.0
10855CCCCC A31=0.0
10856CCCCC A32=Z3DEYE-Z3DMID
10857CCCCC IF(A32.EQ.0.0)A32=EPS
10858CCCCC A33=-(Y3DEYE-Y3DMID)
10859CCCCC IF(A33.EQ.0.0)A33=EPS
10860C
10861CCCCC R1=XDEL*X3DMID+YDEL*Y3DMID+ZDEL*Z3DMID
10862CCCCC R2=(Y3DEYE-Y3DMID)*X3DMID-(X3DEYE-X3DMID)*YM
10863CCCCC R3=(Z3DEYE-Z3DMID)*Y3DMID-(Y3DEYE-Y3DMID)*Z3DMID
10864C
10865CCCCC P12=-A23/A11
10866CCCCC P13=-A32/(P12*A12+A23)
10867C
10868CCCCC ZPI=(P13*(P12*R1+R2)+R3)/
10869CCCCC1(P13*P12*A13+A33)
10870CCCCC YPI=(R3-A33*ZPI)/A32
10871CCCCC XPI=(R2-A23*YPI)/A21
10872CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TR32')
10873CCCCC1WRITE(ICOUT,2111)I,XPI,YPI,ZPI
10874C2111 FORMAT('I,XPI,YPI,ZPI = ',I8,3E15.7)
10875CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TR32')
10876CCCCC1CALL DPWRST('XXX','BUG ')
10877C
10878CCCCC DELX=XPI-X3DMID
10879CCCCC DELY=YPI-Y3DMID
10880CCCCC DELZ=ZPI-Z3DMID
10881CCCCC XT(I)=X3DMID+D3DCXX*DELX+D3DCXY*DELY+D3DCXZ*DELZ
10882CCCCC YT(I)=Y3DMID+D3DCYX*DELX+D3DCYY*DELY+D3DCYZ*DELZ
10883CCCCC ZT(I)=X3DMID+D3DCZX*DELX+D3DCZY*DELY+D3DCZZ*DELZ
10884      DELX=X(I)-X3DMID
10885      DELY=Y(I)-Y3DMID
10886      DELZ=Z(I)-Z3DMID
10887      XT(I)=X3DMID+TERMXX*DELX+TERMXY*DELY+TERMXZ*DELZ
10888      ZT(I)=X3DMID+TERMZX*DELX+TERMZY*DELY+TERMZZ*DELZ
10889C
10890 2110 CONTINUE
10891      GOTO9000
10892C
10893C               **************************************************
10894C               **  STEP 31--                                   **
10895C               **  TREAT THE PERSPECTIVE TRANSFORMATION CASE   **
10896C               **************************************************
10897C
10898 3100 CONTINUE
10899C
10900      ISTEPN='31'
10901      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TR32')
10902     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10903C
10904      DO3110I=1,N
10905C
10906C     ***** 5 LINES OF CODE TO ADJUST FOR DIVISION BY 0 ADDED AUGUST 1983 *****
10907      A11=XDEL
10908      A12=YDEL
10909      A13=ZDEL
10910      A21=Y3DEYE-Y(I)
10911      IF(A21.EQ.0.0)A21=EPS
10912      A22=-(X3DEYE-X(I))
10913      IF(A22.EQ.0.0)A22=EPS
10914      A23=0.0
10915      A31=0.0
10916      A32=Z3DEYE-Z(I)
10917      IF(A32.EQ.0.0)A32=EPS
10918      A33=-(Y3DEYE-Y(I))
10919      IF(A33.EQ.0.0)A33=EPS
10920C
10921      R1=XDEL*X3DMID+YDEL*Y3DMID+ZDEL*Z3DMID
10922      R2=(Y3DEYE-Y(I))*X(I)-(X3DEYE-X(I))*Y(I)
10923      R3=(Z3DEYE-Z(I))*Y(I)-(Y3DEYE-Y(I))*Z(I)
10924C
10925      P12=-A21/A11
10926      P13=-A32/(P12*A12+A22)
10927C
10928      ZPI=(P13*(P12*R1+R2)+R3)/
10929     1(P13*P12*A13+A33)
10930      YPI=(R3-A33*ZPI)/A32
10931      XPI=(R2-A22*YPI)/A21
10932      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TR32')
10933     1WRITE(ICOUT,3111)I,XPI,YPI,ZPI
10934 3111 FORMAT('I,XPI,YPI,ZPI = ',I8,3E15.7)
10935      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TR32')
10936     1CALL DPWRST('XXX','BUG ')
10937C
10938      DELX=XPI-X3DMID
10939      DELY=YPI-Y3DMID
10940      DELZ=ZPI-Z3DMID
10941      XT(I)=X3DMID+D3DCXX*DELX+D3DCXY*DELY+D3DCXZ*DELZ
10942CCCCC YT(I)=Y3DMID+D3DCYX*DELX+D3DCYY*DELY+D3DCYZ*DELZ
10943      ZT(I)=X3DMID+D3DCZX*DELX+D3DCZY*DELY+D3DCZZ*DELZ
10944C
10945 3110 CONTINUE
10946      GOTO9000
10947C
10948C               *****************
10949C               **  STEP 90--  **
10950C               **  EXIT.      **
10951C               *****************
10952C
10953 9000 CONTINUE
10954      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TR32')GOTO9090
10955      WRITE(ICOUT,999)
10956      CALL DPWRST('XXX','BUG ')
10957      WRITE(ICOUT,9011)
10958 9011 FORMAT('***** AT THE END       OF D3TR32--')
10959      CALL DPWRST('XXX','BUG ')
10960      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4
10961 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
10962      CALL DPWRST('XXX','BUG ')
10963      WRITE(ICOUT,9013)I3DPRO
10964 9013 FORMAT('I3DPRO = ',A4)
10965      CALL DPWRST('XXX','BUG ')
10966      WRITE(ICOUT,9014)IBUGG4,ISUBG4,IERRG4
10967 9014 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',3A4)
10968      CALL DPWRST('XXX','BUG ')
10969      WRITE(ICOUT,9015)X3DEYE,Y3DEYE,Z3DEYE
10970 9015 FORMAT('X3DEYE,Y3DEYE,Z3DEYE = ',3E15.7)
10971      CALL DPWRST('XXX','BUG ')
10972      WRITE(ICOUT,9016)X3DMID,Y3DMID,Z3DMID
10973 9016 FORMAT('X3DMID,Y3DMID,Z3DMID = ',3E15.7)
10974      CALL DPWRST('XXX','BUG ')
10975      WRITE(ICOUT,9024)D3DCXX,D3DCXY,D3DCXZ
10976 9024 FORMAT('D3DCXX,D3DCXY,D3DCXZ = ',3E15.7)
10977      CALL DPWRST('XXX','BUG ')
10978      WRITE(ICOUT,9025)D3DCYX,D3DCYY,D3DCYZ
10979 9025 FORMAT('D3DCYX,D3DCYY,D3DCYZ = ',3E15.7)
10980      CALL DPWRST('XXX','BUG ')
10981      WRITE(ICOUT,9026)D3DCZX,D3DCZY,D3DCZZ
10982 9026 FORMAT('D3DCZX,D3DCZY,D3DCZZ = ',3E15.7)
10983      CALL DPWRST('XXX','BUG ')
10984      WRITE(ICOUT,9031)XDEL,YDEL,ZDEL
10985 9031 FORMAT('XDEL,YDEL,ZDEL = ',3E15.7)
10986      CALL DPWRST('XXX','BUG ')
10987      WRITE(ICOUT,9032)A11,A12,A13
10988 9032 FORMAT('A11,A12,A13    = ',3E15.7)
10989      CALL DPWRST('XXX','BUG ')
10990      WRITE(ICOUT,9033)A21,A22,A23
10991 9033 FORMAT('A21,A22,A23    = ',3E15.7)
10992      CALL DPWRST('XXX','BUG ')
10993      WRITE(ICOUT,9034)A31,A32,A33
10994 9034 FORMAT('A31,A32,A33    = ',3E15.7)
10995      CALL DPWRST('XXX','BUG ')
10996      WRITE(ICOUT,9035)R1,R2,R3
10997 9035 FORMAT('R1,R2,R3       = ',3E15.7)
10998      CALL DPWRST('XXX','BUG ')
10999      WRITE(ICOUT,9036)P12,P13
11000 9036 FORMAT('P12,P13        = ',2E15.7)
11001      CALL DPWRST('XXX','BUG ')
11002      WRITE(ICOUT,9037)XPI,YPI,ZPI
11003 9037 FORMAT('XPI,YPI,ZPI    = ',3E15.7)
11004      CALL DPWRST('XXX','BUG ')
11005      WRITE(ICOUT,9038)DELX,DELY,DELZ
11006 9038 FORMAT('DELX,DELY,DELZ = ',3E15.7)
11007      CALL DPWRST('XXX','BUG ')
11008      WRITE(ICOUT,9039)XT(N),ZT(N)
11009 9039 FORMAT('XT(N),ZT(N)    = ',2E15.7)
11010      CALL DPWRST('XXX','BUG ')
11011      WRITE(ICOUT,9041)N,NT
11012 9041 FORMAT('N,NT = ',2I8)
11013      CALL DPWRST('XXX','BUG ')
11014      DO9042I=1,N
11015      WRITE(ICOUT,9043)I,X(I),Y(I),Z(I),XT(I),ZT(I)
11016 9043 FORMAT('I,X(I),Y(I),Z(I),XT(I),ZT(I) = ',I8,5E11.3)
11017      CALL DPWRST('XXX','BUG ')
11018 9042 CONTINUE
11019 9090 CONTINUE
11020C
11021      RETURN
11022      END
11023      SUBROUTINE D3TRXP(X,Y,N,IDIR,ABASE,
11024     1FXMIN,FXMAX,FXRANG,FYMIN,FYMAX,FYRANG,
11025     1PXMIN,PXMAX,PXRANG,PYMIN,PYMAX,PYRANG,
11026     1PX,PY,NP,PBASE)
11027C
11028C     PURPOSE--TRANSLATE 2-D RAW OR INTERMEDIATE DATA
11029C              INTO 2-D VISUAL PLANE (0 TO 100) DATA
11030C     WRITTEN BY--JAMES J. FILLIBEN
11031C                 STATISTICAL ENGINEERING DIVISION
11032C                 INFORMATION TECHNOLOGY LABORATORY
11033C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11034C                 GAITHERSBURG, MD 20899
11035C                 PHONE--301-975-2855
11036C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11037C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11038C     LANGUAGE--ANSI FORTRAN (1977)
11039C     VERSION NUMBER--88/10
11040C     ORIGINAL VERSION--SEPTEMBER 1988.
11041C
11042C-----COMMON STATEMENTS-----------------------------------------------
11043C
11044      INCLUDE 'DPCO3D.INC'
11045      INCLUDE 'DPCOBE.INC'
11046C
11047C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11048C
11049      CHARACTER*4 IDIR
11050C
11051      CHARACTER*4 ISUBN1
11052      CHARACTER*4 ISUBN2
11053CCCCC CHARACTER*4 ISTEPN
11054C
11055C---------------------------------------------------------------------
11056C
11057      DIMENSION X(*)
11058      DIMENSION Y(*)
11059      DIMENSION PX(*)
11060      DIMENSION PY(*)
11061C
11062C-----COMMON----------------------------------------------------------
11063C
11064      INCLUDE 'DPCOP2.INC'
11065C
11066C-----START POINT-----------------------------------------------------
11067C
11068      ISUBN1='D3TR'
11069      ISUBN2='XP  '
11070      IERRG4='NO'
11071C
11072      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRXP')GOTO90
11073      WRITE(ICOUT,999)
11074  999 FORMAT(1X)
11075      CALL DPWRST('XXX','BUG ')
11076      WRITE(ICOUT,51)
11077   51 FORMAT('***** AT THE BEGINNING OF D3TRXP--')
11078      CALL DPWRST('XXX','BUG ')
11079      WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4
11080   52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
11081      CALL DPWRST('XXX','BUG ')
11082      WRITE(ICOUT,53)FXMIN,FXMAX,FXRANG
11083   53 FORMAT('FXMIN,FXMAX,FXRANG = ',3E15.7)
11084      CALL DPWRST('XXX','BUG ')
11085      WRITE(ICOUT,54)FYMIN,FYMAX,FYRANG
11086   54 FORMAT('FYMIN,FYMAX,FYRANG = ',3E15.7)
11087      CALL DPWRST('XXX','BUG ')
11088      WRITE(ICOUT,55)PXMIN,PXMAX,PXRANG
11089   55 FORMAT('PXMIN,PXMAX,PXRANG = ',3E15.7)
11090      CALL DPWRST('XXX','BUG ')
11091      WRITE(ICOUT,56)PYMIN,PYMAX,PYRANG
11092   56 FORMAT('PYMIN,PYMAX,PYRANG = ',3E15.7)
11093      CALL DPWRST('XXX','BUG ')
11094      WRITE(ICOUT,57)ABASE
11095   57 FORMAT('ABASE = ',E15.7)
11096      CALL DPWRST('XXX','BUG ')
11097      WRITE(ICOUT,61)N,IDIR
11098   61 FORMAT('N,IDIR = ',I8,2X,A4)
11099      CALL DPWRST('XXX','BUG ')
11100      DO62I=1,N
11101      WRITE(ICOUT,63)I,X(I),Y(I)
11102   63 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
11103      CALL DPWRST('XXX','BUG ')
11104   62 CONTINUE
11105   90 CONTINUE
11106C
11107C               *****************************************************
11108C               **  STEP 11--                                      **
11109C               **  TRANSLATE THE 2-D PLANE DATA POINTS            **
11110C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
11111C               *****************************************************
11112C
11113      NP=N
11114C
11115      DO1110I=1,N
11116      FXRATI=(X(I)-FXMIN)/FXRANG
11117      FYRATI=(Y(I)-FYMIN)/FYRANG
11118      PX(I)=PXMIN+FXRATI*PXRANG
11119      PY(I)=PYMIN+FYRATI*PYRANG
11120 1110 CONTINUE
11121C
11122      IF(IDIR.EQ.'V')GOTO1120
11123      GOTO1129
11124 1120 CONTINUE
11125      FYRATI=(ABASE-FYMIN)/FYRANG
11126      PBASE=PYMIN+FYRATI*PYRANG
11127 1129 CONTINUE
11128C
11129      IF(IDIR.EQ.'H')GOTO1130
11130      GOTO1139
11131 1130 CONTINUE
11132      FXRATI=(ABASE-FXMIN)/FXRANG
11133      PBASE=PXMIN+FXRATI*PXRANG
11134 1139 CONTINUE
11135C
11136C               **************************************************
11137C               **  STEP 90--                                   **
11138C               **  EXIT.                                       **
11139C               **************************************************
11140C
11141      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRXP')GOTO9090
11142      WRITE(ICOUT,999)
11143      CALL DPWRST('XXX','BUG ')
11144      WRITE(ICOUT,9011)
11145 9011 FORMAT('***** AT THE END       OF D3TRXP--')
11146      CALL DPWRST('XXX','BUG ')
11147      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4
11148 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
11149      CALL DPWRST('XXX','BUG ')
11150      WRITE(ICOUT,9013)FXMIN,FXMAX,FXRANG
11151 9013 FORMAT('FXMIN,FXMAX,FXRANG = ',3E15.7)
11152      CALL DPWRST('XXX','BUG ')
11153      WRITE(ICOUT,9014)FYMIN,FYMAX,FYRANG
11154 9014 FORMAT('FYMIN,FYMAX,FYRANG = ',3E15.7)
11155      CALL DPWRST('XXX','BUG ')
11156      WRITE(ICOUT,9015)PXMIN,PXMAX,PXRANG
11157 9015 FORMAT('PXMIN,PXMAX,PXRANG = ',3E15.7)
11158      CALL DPWRST('XXX','BUG ')
11159      WRITE(ICOUT,9016)PYMIN,PYMAX,PYRANG
11160 9016 FORMAT('PYMIN,PYMAX,PYRANG = ',3E15.7)
11161      CALL DPWRST('XXX','BUG ')
11162      WRITE(ICOUT,9017)ABASE
11163 9017 FORMAT('ABASE = ',E15.7)
11164      CALL DPWRST('XXX','BUG ')
11165      WRITE(ICOUT,9021)N,NP,IDIR
11166 9021 FORMAT('N,NP,IDIR = ',2I8,2X,A4)
11167      CALL DPWRST('XXX','BUG ')
11168      DO9022I=1,N
11169      WRITE(ICOUT,9023)I,X(I),Y(I),PX(I),PY(I)
11170 9023 FORMAT('I,X(I),Y(I),PX(I),PY(I) = ',I8,4E15.7)
11171      CALL DPWRST('XXX','BUG ')
11172 9022 CONTINUE
11173 9090 CONTINUE
11174C
11175      RETURN
11176      END
11177      FUNCTION E1 (X)
11178C***BEGIN PROLOGUE  E1
11179C***PURPOSE  Compute the exponential integral E1(X).
11180C***LIBRARY   SLATEC (FNLIB)
11181C***CATEGORY  C5
11182C***TYPE      SINGLE PRECISION (E1-S, DE1-D)
11183C***KEYWORDS  E1 FUNCTION, EXPONENTIAL INTEGRAL, FNLIB,
11184C             SPECIAL FUNCTIONS
11185C***AUTHOR  Fullerton, W., (LANL)
11186C***DESCRIPTION
11187C
11188C E1 calculates the single precision exponential integral, E1(X), for
11189C positive single precision argument X and the Cauchy principal value
11190C for negative X.  If principal values are used everywhere, then, for
11191C all X,
11192C
11193C    E1(X) = -Ei(-X)
11194C or
11195C    Ei(X) = -E1(-X).
11196C
11197C
11198C Series for AE11       on the interval -1.00000D-01 to  0.
11199C                                        with weighted error   1.76E-17
11200C                                         log weighted error  16.75
11201C                               significant figures required  15.70
11202C                                    decimal places required  17.55
11203C
11204C
11205C Series for AE12       on the interval -2.50000D-01 to -1.00000D-01
11206C                                        with weighted error   5.83E-17
11207C                                         log weighted error  16.23
11208C                               significant figures required  15.76
11209C                                    decimal places required  16.93
11210C
11211C
11212C Series for E11        on the interval -4.00000D+00 to -1.00000D+00
11213C                                        with weighted error   1.08E-18
11214C                                         log weighted error  17.97
11215C                               significant figures required  19.02
11216C                                    decimal places required  18.61
11217C
11218C
11219C Series for E12        on the interval -1.00000D+00 to  1.00000D+00
11220C                                        with weighted error   3.15E-18
11221C                                         log weighted error  17.50
11222C                        approx significant figures required  15.8
11223C                                    decimal places required  18.10
11224C
11225C
11226C Series for AE13       on the interval  2.50000D-01 to  1.00000D+00
11227C                                        with weighted error   2.34E-17
11228C                                         log weighted error  16.63
11229C                               significant figures required  16.14
11230C                                    decimal places required  17.33
11231C
11232C
11233C Series for AE14       on the interval  0.          to  2.50000D-01
11234C                                        with weighted error   5.41E-17
11235C                                         log weighted error  16.27
11236C                               significant figures required  15.38
11237C                                    decimal places required  16.97
11238C
11239C***REFERENCES  (NONE)
11240C***ROUTINES CALLED  CSEVL, INITS, R1MACH, XERMSG
11241C***REVISION HISTORY  (YYMMDD)
11242C   770701  DATE WRITTEN
11243C   890531  Changed all specific intrinsics to generic.  (WRB)
11244C   891115  Modified prologue description.  (WRB)
11245C   891115  REVISION DATE from Version 3.2
11246C   891214  Prologue converted to Version 4.0 format.  (BAB)
11247C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
11248C   920618  Removed space from variable names.  (RWC, WRB)
11249C***END PROLOGUE  E1
11250C
11251C-----COMMON----------------------------------------------------------
11252C
11253      INCLUDE 'DPCOMC.INC'
11254      INCLUDE 'DPCOP2.INC'
11255C
11256      DIMENSION AE11CS(39), AE12CS(25), E11CS(19), E12CS(16),
11257     1  AE13CS(25), AE14CS(26)
11258      LOGICAL FIRST
11259      SAVE AE11CS, AE12CS, E11CS, E12CS, AE13CS, AE14CS,
11260     1 NTAE11, NTAE12, NTE11, NTE12, NTAE13, NTAE14, XMAX, FIRST
11261      DATA AE11CS( 1) /    .1215032397 1606579E0 /
11262      DATA AE11CS( 2) /   -.0650887785 13550150E0 /
11263      DATA AE11CS( 3) /    .0048976513 57459670E0 /
11264      DATA AE11CS( 4) /   -.0006492378 43027216E0 /
11265      DATA AE11CS( 5) /    .0000938404 34587471E0 /
11266      DATA AE11CS( 6) /    .0000004202 36380882E0 /
11267      DATA AE11CS( 7) /   -.0000081133 74735904E0 /
11268      DATA AE11CS( 8) /    .0000028042 47688663E0 /
11269      DATA AE11CS( 9) /    .0000000564 87164441E0 /
11270      DATA AE11CS(10) /   -.0000003448 09174450E0 /
11271      DATA AE11CS(11) /    .0000000582 09273578E0 /
11272      DATA AE11CS(12) /    .0000000387 11426349E0 /
11273      DATA AE11CS(13) /   -.0000000124 53235014E0 /
11274      DATA AE11CS(14) /   -.0000000051 18504888E0 /
11275      DATA AE11CS(15) /    .0000000021 48771527E0 /
11276      DATA AE11CS(16) /    .0000000008 68459898E0 /
11277      DATA AE11CS(17) /   -.0000000003 43650105E0 /
11278      DATA AE11CS(18) /   -.0000000001 79796603E0 /
11279      DATA AE11CS(19) /    .0000000000 47442060E0 /
11280      DATA AE11CS(20) /    .0000000000 40423282E0 /
11281      DATA AE11CS(21) /   -.0000000000 03543928E0 /
11282      DATA AE11CS(22) /   -.0000000000 08853444E0 /
11283      DATA AE11CS(23) /   -.0000000000 00960151E0 /
11284      DATA AE11CS(24) /    .0000000000 01692921E0 /
11285      DATA AE11CS(25) /    .0000000000 00607990E0 /
11286      DATA AE11CS(26) /   -.0000000000 00224338E0 /
11287      DATA AE11CS(27) /   -.0000000000 00200327E0 /
11288      DATA AE11CS(28) /   -.0000000000 00006246E0 /
11289      DATA AE11CS(29) /    .0000000000 00045571E0 /
11290      DATA AE11CS(30) /    .0000000000 00016383E0 /
11291      DATA AE11CS(31) /   -.0000000000 00005561E0 /
11292      DATA AE11CS(32) /   -.0000000000 00006074E0 /
11293      DATA AE11CS(33) /   -.0000000000 00000862E0 /
11294      DATA AE11CS(34) /    .0000000000 00001223E0 /
11295      DATA AE11CS(35) /    .0000000000 00000716E0 /
11296      DATA AE11CS(36) /   -.0000000000 00000024E0 /
11297      DATA AE11CS(37) /   -.0000000000 00000201E0 /
11298      DATA AE11CS(38) /   -.0000000000 00000082E0 /
11299      DATA AE11CS(39) /    .0000000000 00000017E0 /
11300      DATA AE12CS( 1) /    .5824174951 3472674E0 /
11301      DATA AE12CS( 2) /   -.1583488509 0578275E0 /
11302      DATA AE12CS( 3) /   -.0067642755 90323141E0 /
11303      DATA AE12CS( 4) /    .0051258439 50185725E0 /
11304      DATA AE12CS( 5) /    .0004352324 92169391E0 /
11305      DATA AE12CS( 6) /   -.0001436133 66305483E0 /
11306      DATA AE12CS( 7) /   -.0000418013 20556301E0 /
11307      DATA AE12CS( 8) /   -.0000027133 95758640E0 /
11308      DATA AE12CS( 9) /    .0000011513 81913647E0 /
11309      DATA AE12CS(10) /    .0000004206 50022012E0 /
11310      DATA AE12CS(11) /    .0000000665 81901391E0 /
11311      DATA AE12CS(12) /    .0000000006 62143777E0 /
11312      DATA AE12CS(13) /   -.0000000028 44104870E0 /
11313      DATA AE12CS(14) /   -.0000000009 40724197E0 /
11314      DATA AE12CS(15) /   -.0000000001 77476602E0 /
11315      DATA AE12CS(16) /   -.0000000000 15830222E0 /
11316      DATA AE12CS(17) /    .0000000000 02905732E0 /
11317      DATA AE12CS(18) /    .0000000000 01769356E0 /
11318      DATA AE12CS(19) /    .0000000000 00492735E0 /
11319      DATA AE12CS(20) /    .0000000000 00093709E0 /
11320      DATA AE12CS(21) /    .0000000000 00010707E0 /
11321      DATA AE12CS(22) /   -.0000000000 00000537E0 /
11322      DATA AE12CS(23) /   -.0000000000 00000716E0 /
11323      DATA AE12CS(24) /   -.0000000000 00000244E0 /
11324      DATA AE12CS(25) /   -.0000000000 00000058E0 /
11325      DATA E11CS( 1) / -16.1134616555 71494026E0 /
11326      DATA E11CS( 2) /   7.7940727787 426802769E0 /
11327      DATA E11CS( 3) /  -1.9554058188 631419507E0 /
11328      DATA E11CS( 4) /    .3733729386 6277945612E0 /
11329      DATA E11CS( 5) /   -.0569250319 1092901938E0 /
11330      DATA E11CS( 6) /    .0072110777 6966009185E0 /
11331      DATA E11CS( 7) /   -.0007810490 1449841593E0 /
11332      DATA E11CS( 8) /    .0000738809 3356262168E0 /
11333      DATA E11CS( 9) /   -.0000062028 6187580820E0 /
11334      DATA E11CS(10) /    .0000004681 6002303176E0 /
11335      DATA E11CS(11) /   -.0000000320 9288853329E0 /
11336      DATA E11CS(12) /    .0000000020 1519974874E0 /
11337      DATA E11CS(13) /   -.0000000001 1673686816E0 /
11338      DATA E11CS(14) /    .0000000000 0627627066E0 /
11339      DATA E11CS(15) /   -.0000000000 0031481541E0 /
11340      DATA E11CS(16) /    .0000000000 0001479904E0 /
11341      DATA E11CS(17) /   -.0000000000 0000065457E0 /
11342      DATA E11CS(18) /    .0000000000 0000002733E0 /
11343      DATA E11CS(19) /   -.0000000000 0000000108E0 /
11344      DATA E12CS( 1) /  -0.0373902147 92202795E0 /
11345      DATA E12CS( 2) /   0.0427239860 62209577E0 /
11346      DATA E12CS( 3) /   -.1303182079 849700544E0 /
11347      DATA E12CS( 4) /    .0144191240 2469889073E0 /
11348      DATA E12CS( 5) /   -.0013461707 8051068022E0 /
11349      DATA E12CS( 6) /    .0001073102 9253063780E0 /
11350      DATA E12CS( 7) /   -.0000074299 9951611943E0 /
11351      DATA E12CS( 8) /    .0000004537 7325690753E0 /
11352      DATA E12CS( 9) /   -.0000000247 6417211390E0 /
11353      DATA E12CS(10) /    .0000000012 2076581374E0 /
11354      DATA E12CS(11) /   -.0000000000 5485141480E0 /
11355      DATA E12CS(12) /    .0000000000 0226362142E0 /
11356      DATA E12CS(13) /   -.0000000000 0008635897E0 /
11357      DATA E12CS(14) /    .0000000000 0000306291E0 /
11358      DATA E12CS(15) /   -.0000000000 0000010148E0 /
11359      DATA E12CS(16) /    .0000000000 0000000315E0 /
11360      DATA AE13CS( 1) /   -.6057732466 4060346E0 /
11361      DATA AE13CS( 2) /   -.1125352434 8366090E0 /
11362      DATA AE13CS( 3) /    .0134322662 47902779E0 /
11363      DATA AE13CS( 4) /   -.0019268451 87381145E0 /
11364      DATA AE13CS( 5) /    .0003091183 37720603E0 /
11365      DATA AE13CS( 6) /   -.0000535641 32129618E0 /
11366      DATA AE13CS( 7) /    .0000098278 12880247E0 /
11367      DATA AE13CS( 8) /   -.0000018853 68984916E0 /
11368      DATA AE13CS( 9) /    .0000003749 43193568E0 /
11369      DATA AE13CS(10) /   -.0000000768 23455870E0 /
11370      DATA AE13CS(11) /    .0000000161 43270567E0 /
11371      DATA AE13CS(12) /   -.0000000034 66802211E0 /
11372      DATA AE13CS(13) /    .0000000007 58754209E0 /
11373      DATA AE13CS(14) /   -.0000000001 68864333E0 /
11374      DATA AE13CS(15) /    .0000000000 38145706E0 /
11375      DATA AE13CS(16) /   -.0000000000 08733026E0 /
11376      DATA AE13CS(17) /    .0000000000 02023672E0 /
11377      DATA AE13CS(18) /   -.0000000000 00474132E0 /
11378      DATA AE13CS(19) /    .0000000000 00112211E0 /
11379      DATA AE13CS(20) /   -.0000000000 00026804E0 /
11380      DATA AE13CS(21) /    .0000000000 00006457E0 /
11381      DATA AE13CS(22) /   -.0000000000 00001568E0 /
11382      DATA AE13CS(23) /    .0000000000 00000383E0 /
11383      DATA AE13CS(24) /   -.0000000000 00000094E0 /
11384      DATA AE13CS(25) /    .0000000000 00000023E0 /
11385      DATA AE14CS( 1) /   -.1892918000 753017E0 /
11386      DATA AE14CS( 2) /   -.0864811785 5259871E0 /
11387      DATA AE14CS( 3) /    .0072241015 4374659E0 /
11388      DATA AE14CS( 4) /   -.0008097559 4575573E0 /
11389      DATA AE14CS( 5) /    .0001099913 4432661E0 /
11390      DATA AE14CS( 6) /   -.0000171733 2998937E0 /
11391      DATA AE14CS( 7) /    .0000029856 2751447E0 /
11392      DATA AE14CS( 8) /   -.0000005659 6491457E0 /
11393      DATA AE14CS( 9) /    .0000001152 6808397E0 /
11394      DATA AE14CS(10) /   -.0000000249 5030440E0 /
11395      DATA AE14CS(11) /    .0000000056 9232420E0 /
11396      DATA AE14CS(12) /   -.0000000013 5995766E0 /
11397      DATA AE14CS(13) /    .0000000003 3846628E0 /
11398      DATA AE14CS(14) /   -.0000000000 8737853E0 /
11399      DATA AE14CS(15) /    .0000000000 2331588E0 /
11400      DATA AE14CS(16) /   -.0000000000 0641148E0 /
11401      DATA AE14CS(17) /    .0000000000 0181224E0 /
11402      DATA AE14CS(18) /   -.0000000000 0052538E0 /
11403      DATA AE14CS(19) /    .0000000000 0015592E0 /
11404      DATA AE14CS(20) /   -.0000000000 0004729E0 /
11405      DATA AE14CS(21) /    .0000000000 0001463E0 /
11406      DATA AE14CS(22) /   -.0000000000 0000461E0 /
11407      DATA AE14CS(23) /    .0000000000 0000148E0 /
11408      DATA AE14CS(24) /   -.0000000000 0000048E0 /
11409      DATA AE14CS(25) /    .0000000000 0000016E0 /
11410      DATA AE14CS(26) /   -.0000000000 0000005E0 /
11411      DATA FIRST /.TRUE./
11412C***FIRST EXECUTABLE STATEMENT  E1
11413      IF (FIRST) THEN
11414         ETA = 0.1*R1MACH(3)
11415         NTAE11 = INITS (AE11CS, 39, ETA)
11416         NTAE12 = INITS (AE12CS, 25, ETA)
11417         NTE11 = INITS (E11CS, 19, ETA)
11418         NTE12 = INITS (E12CS, 16, ETA)
11419         NTAE13 = INITS (AE13CS, 25, ETA)
11420         NTAE14 = INITS (AE14CS, 26, ETA)
11421C
11422         XMAXT = -LOG (R1MACH(1))
11423         XMAX = XMAXT - LOG(XMAXT)
11424      ENDIF
11425      FIRST = .FALSE.
11426C
11427      IF (X.GT.(-10.)) GO TO 20
11428C
11429C E1(X) = -EI(-X) FOR X .LE. -10.
11430C
11431      E1 = EXP(-X)/X * (1.+CSEVL (20./X+1., AE11CS, NTAE11))
11432      RETURN
11433C
11434 20   IF (X.GT.(-4.0)) GO TO 30
11435C
11436C E1(X) = -EI(-X) FOR -10. .LT. X .LE. -4.
11437C
11438      E1 = EXP(-X)/X * (1.+CSEVL ((40./X+7.)/3., AE12CS, NTAE12))
11439      RETURN
11440C
11441 30   IF (X.GT.(-1.0)) GO TO 40
11442C
11443C E1(X) = -EI(-X) FOR -4. .LT. X .LE. -1.
11444C
11445      E1 = -LOG(ABS(X)) + CSEVL ((2.*X+5.)/3., E11CS, NTE11)
11446      RETURN
11447C
11448 40   IF (X.GT.1.) GO TO 50
11449      IF (X .EQ. 0.) THEN
11450        WRITE(ICOUT,41)
11451   41   FORMAT('***** ERORR FROM E1, X IS ZER0.  *******')
11452        CALL DPWRST('XXX','BUG ')
11453        E1=0.0
11454        RETURN
11455      ENDIF
11456C
11457C E1(X) = -EI(-X) FOR -1. .LT. X .LE. 1.,  X .NE. 0.
11458C
11459      E1 = (-LOG(ABS(X)) - 0.6875 + X) + CSEVL (X, E12CS, NTE12)
11460      RETURN
11461C
11462 50   IF (X.GT.4.) GO TO 60
11463C
11464C E1(X) = -EI(-X) FOR 1. .LT. X .LE. 4.
11465C
11466      E1 = EXP(-X)/X * (1.+CSEVL ((8./X-5.)/3., AE13CS, NTAE13))
11467      RETURN
11468C
11469 60   IF (X.GT.XMAX) GO TO 70
11470C
11471C E1(X) = -EI(-X) FOR 4. .LT. X .LE. XMAX
11472C
11473      E1 = EXP(-X)/X * (1. + CSEVL (8./X-1., AE14CS, NTAE14))
11474      RETURN
11475C
11476C E1(X) = -EI(-X) FOR X .GT. XMAX
11477C
11478 70   CONTINUE
11479      WRITE(ICOUT,71)
11480      CALL DPWRST('XXX','BUG ')
11481   71 FORMAT('***** WARNING FROM E1, UNDERFLOW BECAUSE THE ',
11482     1       'VALUE OF X IS SO LARGE.  ****')
11483      E1 = 0.
11484      RETURN
11485C
11486      END
11487      SUBROUTINE EA(NEWFLG,SVALUE,LIMEXP,RESULT,ABSERR,EPSTAB,IERR)
11488C   PART OF QAGI CODE.
11489C***BEGIN PROLOGUE  EA
11490C***DATE WRITTEN   800101  (YYMMDD)
11491C***REVISION DATE  871208   (YYMMDD)
11492C***CATEGORY NO.  E5
11493C***KEYWORDS  CONVERGENCE ACCELERATION,EPSILON ALGORITHM,EXTRAPOLATION
11494C***AUTHOR  PIESSENS, ROBERT, APPLIED MATH. AND PROGR. DIV. -
11495C             K. U. LEUVEN
11496C           DE DONCKER-KAPENGA, ELISE,WESTERN MICHIGAN UNIVERSITY
11497C           KAHANER, DAVID K., NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11498C           STARKENBURG, C. B., NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11499C***PURPOSE  Given a slowly convergent sequence, this routine attempts
11500C            to extrapolate nonlinearly to a better estimate of the
11501C            sequence's limiting value, thus improving the rate of
11502C            convergence. Routine is based on the epsilon algorithm
11503C            of P. Wynn. An estimate of the absolute error is also
11504C            given.
11505C     THIS PROLOGUE HAS BEEN REMOVED FOR REASONS OF SPACE
11506C     FOR A COMPLETE COPY OF THIS ROUTINE CONTACT THE AUTHORS
11507C     From the book "Numerical Methods and Software"
11508C          by  D. Kahaner, C. Moler, S. Nash
11509C               Prentice Hall 1988
11510C***END PROLOGUE  EA
11511      REAL ABSERR,DELTA1,DELTA2,DELTA3,EPRN,EPSTAB(*),
11512     1   ERROR,ERR1,ERR2,ERR3,E0,E1,E2,E3,RELPR,RES,RESULT,
11513     2   RES3LA(3),R1MACH,SS,SVALUE,TOL1,TOL2,TOL3
11514      INTEGER I,IB,IB2,IE,IERR,IN,K1,K2,K3,LIMEXP,N,NEWELM,NUM,NRES
11515      LOGICAL NEWFLG
11516C
11517      INCLUDE 'DPCOMC.INC'
11518      INCLUDE 'DPCOP2.INC'
11519C
11520C***FIRST EXECUTABLE STATEMENT  EA
11521      IF(LIMEXP.LT.3) THEN
11522        IERR = 1
11523CCCCC   CALL XERROR('LIMEXP IS LESS THAN 3',21,1,1)
11524        WRITE(ICOUT,999)
11525  999   FORMAT(1X)
11526        CALL DPWRST('XXX','BUG ')
11527        WRITE(ICOUT,901)
11528  901   FORMAT('***** ERROR--NUMERICAL INTEGRATION ROUTINE EA (CALLED ',
11529     1         'BY QAGI ROUTINE).')
11530        CALL DPWRST('XXX','BUG ')
11531        WRITE(ICOUT,903)
11532  903   FORMAT('      LIMEXP IS LESS THAN 3.')
11533        CALL DPWRST('XXX','BUG ')
11534        GO TO 110
11535      ENDIF
11536      IERR = 0
11537      RES3LA(1)=EPSTAB(LIMEXP+5)
11538      RES3LA(2)=EPSTAB(LIMEXP+6)
11539      RES3LA(3)=EPSTAB(LIMEXP+7)
11540      RESULT=SVALUE
11541      IF(NEWFLG) THEN
11542        N=1
11543        NRES=0
11544        NEWFLG=.FALSE.
11545        EPSTAB(N)=SVALUE
11546        ABSERR=ABS(RESULT)
11547        GO TO 100
11548      ELSE
11549        N=INT(EPSTAB(LIMEXP+3))
11550        NRES=INT(EPSTAB(LIMEXP+4))
11551        IF(N.EQ.2) THEN
11552          EPSTAB(N)=SVALUE
11553          ABSERR=.6E+01*ABS(RESULT-EPSTAB(1))
11554          GO TO 100
11555        ENDIF
11556      ENDIF
11557      EPSTAB(N)=SVALUE
11558      RELPR=R1MACH(4)
11559      EPRN=1.0E+01*RELPR
11560      EPSTAB(N+2)=EPSTAB(N)
11561      NEWELM=(N-1)/2
11562      NUM=N
11563      K1=N
11564      DO 40 I=1,NEWELM
11565        K2=K1-1
11566        K3=K1-2
11567        RES=EPSTAB(K1+2)
11568        E0=EPSTAB(K3)
11569        E1=EPSTAB(K2)
11570        E2=RES
11571        DELTA2=E2-E1
11572        ERR2=ABS(DELTA2)
11573        TOL2=MAX(ABS(E2),ABS(E1))*RELPR
11574        DELTA3=E1-E0
11575        ERR3=ABS(DELTA3)
11576        TOL3=MAX(ABS(E1),ABS(E0))*RELPR
11577        IF(ERR2.GT.TOL2.OR.ERR3.GT.TOL3) GO TO 10
11578C
11579C           IF E0, E1 AND E2 ARE EQUAL TO WITHIN MACHINE
11580C           ACCURACY, CONVERGENCE IS ASSUMED.
11581C           RESULT=E2
11582C           ABSERR=ABS(E1-E0)+ABS(E2-E1)
11583C
11584        RESULT=RES
11585        ABSERR=ERR2+ERR3
11586        GO TO 50
11587   10   IF(I.NE.1) THEN
11588          E3=EPSTAB(K1)
11589          EPSTAB(K1)=E1
11590          DELTA1=E1-E3
11591          ERR1=ABS(DELTA1)
11592          TOL1=MAX(ABS(E1),ABS(E3))*RELPR
11593C
11594C           IF TWO ELEMENTS ARE VERY CLOSE TO EACH OTHER, OMIT
11595C           A PART OF THE TABLE BY ADJUSTING THE VALUE OF N
11596C
11597          IF(ERR1.LE.TOL1.OR.ERR2.LE.TOL2.OR.ERR3.LE.TOL3) GO TO 20
11598          SS=0.1E+01/DELTA1+0.1E+01/DELTA2-0.1E+01/DELTA3
11599        ELSE
11600          EPSTAB(K1)=E1
11601          IF(ERR2.LE.TOL2.OR.ERR3.LE.TOL3) GO TO 20
11602          SS=0.1E+01/DELTA2-0.1E+01/DELTA3
11603        ENDIF
11604C
11605C           TEST TO DETECT IRREGULAR BEHAVIOUR IN THE TABLE, AND
11606C           EVENTUALLY OMIT A PART OF THE TABLE ADJUSTING THE VALUE
11607C           OF N
11608C
11609        IF(ABS(SS*E1).GT.0.1E-03) GO TO 30
11610   20   N=I+I-1
11611        IF(NRES.EQ.0) THEN
11612          ABSERR=ERR2+ERR3
11613          RESULT=RES
11614        ELSE IF(NRES.EQ.1) THEN
11615          RESULT=RES3LA(1)
11616        ELSE IF(NRES.EQ.2) THEN
11617          RESULT=RES3LA(2)
11618        ELSE
11619          RESULT=RES3LA(3)
11620        ENDIF
11621        GO TO 50
11622C
11623C           COMPUTE A NEW ELEMENT AND EVENTUALLY ADJUST
11624C           THE VALUE OF RESULT
11625C
11626   30   RES=E1+0.1E+01/SS
11627        EPSTAB(K1)=RES
11628        K1=K1-2
11629        IF(NRES.EQ.0) THEN
11630          ABSERR=ERR2+ABS(RES-E2)+ERR3
11631          RESULT=RES
11632          GO TO 40
11633        ELSE IF(NRES.EQ.1) THEN
11634          ERROR=.6E+01*(ABS(RES-RES3LA(1)))
11635        ELSE IF(NRES.EQ.2) THEN
11636          ERROR=.2E+01*(ABS(RES-RES3LA(2))+ABS(RES-RES3LA(1)))
11637        ELSE
11638          ERROR=ABS(RES-RES3LA(3))+ABS(RES-RES3LA(2))
11639     1          +ABS(RES-RES3LA(1))
11640        ENDIF
11641        IF(ERROR.GT.1.0E+01*ABSERR) GO TO 40
11642        ABSERR=ERROR
11643        RESULT=RES
11644   40 CONTINUE
11645C
11646C           COMPUTE ERROR ESTIMATE
11647C
11648        IF(NRES.EQ.1) THEN
11649          ABSERR=.6E+01*(ABS(RESULT-RES3LA(1)))
11650        ELSE IF(NRES.EQ.2) THEN
11651          ABSERR=.2E+01*ABS(RESULT-RES3LA(2))+ABS(RESULT-RES3LA(1))
11652        ELSE IF(NRES.GT.2) THEN
11653          ABSERR=ABS(RESULT-RES3LA(3))+ABS(RESULT-RES3LA(2))
11654     1          +ABS(RESULT-RES3LA(1))
11655        ENDIF
11656C
11657C           SHIFT THE TABLE
11658C
11659   50 IF(N.EQ.LIMEXP) N=2*(LIMEXP/2)-1
11660      IB=1
11661      IF((NUM/2)*2.EQ.NUM) IB=2
11662      IE=NEWELM+1
11663      DO 60 I=1,IE
11664        IB2=IB+2
11665        EPSTAB(IB)=EPSTAB(IB2)
11666        IB=IB2
11667   60 CONTINUE
11668      IF(NUM.EQ.N) GO TO 80
11669      IN=NUM-N+1
11670      DO 70 I=1,N
11671        EPSTAB(I)=EPSTAB(IN)
11672        IN=IN+1
11673   70 CONTINUE
11674C
11675C           UPDATE RES3LA
11676C
11677   80 IF(NRES.EQ.0) THEN
11678        RES3LA(1)=RESULT
11679      ELSE IF(NRES.EQ.1) THEN
11680        RES3LA(2)=RESULT
11681      ELSE IF(NRES.EQ.2) THEN
11682        RES3LA(3)=RESULT
11683      ELSE
11684        RES3LA(1)=RES3LA(2)
11685        RES3LA(2)=RES3LA(3)
11686        RES3LA(3)=RESULT
11687      ENDIF
11688      ABSERR=MAX(ABSERR,EPRN*ABS(RESULT))
11689      NRES=NRES+1
11690  100 N=N+1
11691*     IF(N.LE.3) ABSERR = R1MACH(2) * (0.1D-03)
11692      EPSTAB(LIMEXP+3)=REAL(N)
11693      EPSTAB(LIMEXP+4)=REAL(NRES)
11694      EPSTAB(LIMEXP+5)=RES3LA(1)
11695      EPSTAB(LIMEXP+6)=RES3LA(2)
11696      EPSTAB(LIMEXP+7)=RES3LA(3)
11697  110 RETURN
11698      END
11699      FUNCTION EI (X)
11700C***BEGIN PROLOGUE  EI
11701C***PURPOSE  Compute the exponential integral Ei(X).
11702C***LIBRARY   SLATEC (FNLIB)
11703C***CATEGORY  C5
11704C***TYPE      SINGLE PRECISION (EI-S, DEI-D)
11705C***KEYWORDS  EI FUNCTION, EXPONENTIAL INTEGRAL, FNLIB,
11706C             SPECIAL FUNCTIONS
11707C***AUTHOR  Fullerton, W., (LANL)
11708C***DESCRIPTION
11709C
11710C EI calculates the single precision exponential integral, Ei(X), for
11711C positive single precision argument X and the Cauchy principal value
11712C for negative X.  If principal values are used everywhere, then, for
11713C all X,
11714C
11715C    Ei(X) = -E1(-X)
11716C or
11717C    E1(X) = -Ei(-X).
11718C
11719C***REFERENCES  (NONE)
11720C***ROUTINES CALLED  E1
11721C***REVISION HISTORY  (YYMMDD)
11722C   770401  DATE WRITTEN
11723C   891115  Modified prologue description.  (WRB)
11724C   891115  REVISION DATE from Version 3.2
11725C   891214  Prologue converted to Version 4.0 format.  (BAB)
11726C***END PROLOGUE  EI
11727C***FIRST EXECUTABLE STATEMENT  EI
11728      EI = -E1(-X)
11729C
11730      RETURN
11731      END
11732      SUBROUTINE EDGEF (NK,FC,GC,XX,YY,BFK,CDFX,POI,POJ,EPS3,IFLAG,L)
11733C
11734C--- COMPUTE THE BETA C.D.F.'S BY A RECURRENCE RELATION ALONG THE EDGES
11735C--- I = IMIN AND J = JMIN OF A GRID.  THE CORRESPONDING COMPONENTS OF
11736C--- THE F" C.D.F. ARE INCLUDED IN THE SUMMATION.  TERMS WHICH MIGHT
11737C--- CAUSE UNDERFLOW ARE SET TO ZERO.
11738C
11739      DIMENSION BFK(*),POI(*),POJ(*)
11740      DOUBLE PRECISION DARG,DEUFLO,DLNGAM
11741      DATA DEUFLO / -30.0D0 /
11742      EPS3=0.000001
11743      IFLAG=0
11744      FD = FC-1.0
11745      K = MAX0(L,MIN0(NK,INT((GC-1.0)*XX/YY-FD)))
11746      FK = FD+REAL(K)
11747CCCCC CALL CDFBET (XX,FK,GC,EPS3,IFLAG,BFK(K))
11748      CALL BETCDF(XX,FK,GC,BFK(K))
11749CCCCC IF (IFLAG.NE.0) RETURN
11750      IF (L.EQ.1) BFK(K) = 1.0-BFK(K)
11751      IF (NK.EQ.1) GO TO 40
11752      DARG = DBLE(FK)*DLOG(DBLE(XX))+DBLE(GC)*DLOG(DBLE(YY))-
11753     *   DLOG(DBLE(FK))+DLNGAM(DBLE(FK+GC))-DLNGAM(DBLE(FK))-
11754     *   DLNGAM(DBLE(GC))
11755      IF (DARG.LT.DEUFLO) THEN
11756         DK = 0.0
11757      ELSE
11758         DK = SNGL(DEXP(DARG))*(-1.0)**L
11759      ENDIF
11760      IF (K.GE.NK) GO TO 20
11761      BFK(K+1) = BFK(K)-DK
11762      DI = DK
11763      KFLAG = 1
11764      DO 10 I = K+1, NK-1
11765         IF (KFLAG.EQ.1) THEN
11766            DI = DI*(FD+GC+REAL(I-1))*XX/(FD+REAL(I))
11767            IF (DK+DI.EQ.DK) THEN
11768               KFLAG = 0
11769               DI = 0.0
11770            ENDIF
11771         ENDIF
11772         BFK(I+1) = BFK(I)-DI
11773   10 CONTINUE
11774   20 DI = DK
11775      KFLAG = 1
11776      DO 30 I = K-1, L, -1
11777         IF (KFLAG.EQ.1) THEN
11778            DI = DI*(FC+REAL(I))/((FD+GC+REAL(I))*XX)
11779            IF (DK+DI.EQ.DK) THEN
11780               KFLAG = 0
11781               DI = 0.0
11782            ENDIF
11783         ENDIF
11784         BFK(I) = BFK(I+1)+DI
11785   30 CONTINUE
11786   40 DO 50 I = L, NK
11787         CDFX = CDFX+POI(I)*POJ(1)*BFK(I)
11788   50 CONTINUE
11789      RETURN
11790      END
11791      SUBROUTINE EDGET(NK,FC,GC,XX,YY,BFK,CDFX,POI,POJ,EPS3,IFLAG,L)
11792CCCCC CONVERT TO DOUBLE PRECISION.  SINGLE PRECISION GIVES INACCURATE
11793CCCCC RESULTS FOR 32-BIT MACHINES.
11794C
11795C--- COMPUTE THE BETA C.D.F.'S BY A RECURRENCE RELATION ALONG THE EDGES
11796C--- I = IMIN AND J = JMIN OF A GRID.  THE CORRESPONDING COMPONENTS OF
11797C--- THE T" C.D.F. ARE INCLUDED IN THE SUMMATION.  TERMS WHICH MIGHT
11798C--- CAUSE UNDERFLOW ARE SET TO ZERO.
11799C
11800      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
11801C
11802      DIMENSION BFK(*),POI(*),POJ(*)
11803CCCCC DOUBLE PRECISION DARG,DEUFLO,DLNGAM
11804      DATA DEUFLO / -69.0D0 /
11805C
11806      EPS3=0.0
11807C
11808      FD = FC-1.0D0
11809      K = MAX0(L,MIN0(NK,INT((GC-1.0D0)*XX/YY-FD)))
11810      FK = FD+DBLE(K)
11811CCCCC CALL BETCDF(SNGL(XX),SNGL(FK),SNGL(GC),ATEMP)
11812      BFK(K)=DBETAI(XX,FK,GC)
11813C
11814      IF (IFLAG.NE.0) RETURN
11815      IF (L.EQ.1) BFK(K) = 1.0D0-BFK(K)
11816      IF (NK.EQ.1) GO TO 40
11817      DARG = FK*DLOG(XX)+GC*DLOG(YY)-
11818     *   DLOG(FK)+DLNGAM(FK+GC)-DLNGAM(FK)-
11819     *   DLNGAM(GC)
11820      IF (DARG.LT.DEUFLO) THEN
11821         DK = 0.0D0
11822      ELSE
11823         DK = DEXP(DARG)*(-1.0D0)**L
11824      ENDIF
11825      IF (K.GE.NK) GO TO 20
11826      BFK(K+1) = BFK(K)-DK
11827      DI = DK
11828      KFLAG = 1
11829      DO 10 I = K+1, NK-1
11830         IF (KFLAG.EQ.1) THEN
11831            DI = DI*(FD+GC+DBLE(I-1))*XX/(FD+DBLE(I))
11832            IF (DK+DI.EQ.DK) THEN
11833               KFLAG = 0
11834               DI = 0.0D0
11835            ENDIF
11836         ENDIF
11837         BFK(I+1) = BFK(I)-DI
11838   10 CONTINUE
11839   20 DI = DK
11840      KFLAG = 1
11841      DO 30 I = K-1, L, -1
11842         IF (KFLAG.EQ.1) THEN
11843            DI = DI*(FC+DBLE(I))/((FD+GC+DBLE(I))*XX)
11844            IF (DK+DI.EQ.DK) THEN
11845               KFLAG = 0
11846               DI = 0.0D0
11847            ENDIF
11848         ENDIF
11849         BFK(I) = BFK(I+1)+DI
11850   30 CONTINUE
11851   40 DO 50 I = L, NK
11852         CDFX = CDFX+POI(I)*POJ(1)*BFK(I)
11853   50 CONTINUE
11854      RETURN
11855      END
11856      SUBROUTINE EDGVER(EDGE1,EDGE2,NEDGE,Y,X,NVERT,IWRITE,
11857     1Y2,X2,TAG,NOUT,
11858     1IBUGA3,IERROR)
11859C
11860C     PURPOSE--GIVEN A LIST OF EDGES AND A SET OF ORIGINAL
11861C              VERTICES, GENERATE A NEW LIST OF VERTICES
11862C              CORRESPONDING TO THE EDGES.  NOTE THAT A
11863C              NUMBER OF COMBINATORIC/COMPUTATIONAL GEOMETRY
11864C              ALGORITHMS WORK WITH EDGES.  THIS IS A UTILITY
11865C              ROUTINE THAT MAKES IT EASIER TO PLOT THESE EDGES.
11866C     EXAMPLES--LET Y2 X2 TAG = EDGES TO VERTICES EDGE1 EDGE2 Y X
11867C     INPUT  ARGUMENTS--EDGE1  VECTOR IDENTIFYING FIRST VERTEX IN EDGE
11868C                       EDGE2  VECTOR IDENTIFYING SECOND VERTEX IN EDGE
11869C                       Y      Y-AXIS VECTOR
11870C                       X      X-AXIS VECTOR
11871C                       NEDGE  NUMBER OF EDGES
11872C                       NVERT  NUMBER OF VERTICES
11873C     OUTPUT ARGUMENTS--Y2     Y-AXIS VECTOR OF THE NEW VERTICES
11874C                       X2     X-AXIS VECTOR OF THE NEW VERTICES
11875C                       TAG    VECTOR IDENTIFYING PAIRS OF VERTICES
11876C     WRITTEN BY--JAMES J. FILLIBEN
11877C                 STATISTICAL ENGINEERING DIVISION
11878C                 INFORMATION TECHNOLOGY LABORATORY
11879C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11880C                 GAITHERSBURG, MD 20899-8980
11881C                 PHONE--301-975-2855
11882C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11883C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11884C     LANGUAGE--ANSI FORTRAN (1977)
11885C     VERSION NUMBER--2008/4
11886C     ORIGINAL VERSION--APRIL    2008.
11887C
11888C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11889C
11890      CHARACTER*4 IWRITE
11891      CHARACTER*4 IBUGA3
11892      CHARACTER*4 IERROR
11893C
11894      CHARACTER*4 ISUBN1
11895      CHARACTER*4 ISUBN2
11896C
11897      DIMENSION EDGE1(*)
11898      DIMENSION EDGE2(*)
11899      DIMENSION Y(*)
11900      DIMENSION X(*)
11901      DIMENSION Y2(*)
11902      DIMENSION X2(*)
11903      DIMENSION TAG(*)
11904C
11905C-----COMMON----------------------------------------------------------
11906C
11907      INCLUDE 'DPCOP2.INC'
11908C
11909C-----START POINT-----------------------------------------------------
11910C
11911      ISUBN1='EDGV'
11912      ISUBN2='ER  '
11913      IERROR='NO'
11914C
11915      IF(IBUGA3.EQ.'ON')THEN
11916        WRITE(ICOUT,999)
11917  999   FORMAT(1X)
11918        CALL DPWRST('XXX','BUG ')
11919        WRITE(ICOUT,51)
11920   51   FORMAT('***** AT THE BEGINNING OF EDGVER--')
11921        CALL DPWRST('XXX','BUG ')
11922        WRITE(ICOUT,52)IBUGA3,IWRITE,NEDGE,NVERT
11923   52   FORMAT('IBUGA3,IWRITE,NEDGE,NVERT = ',A4,2X,A4,2X,2I10)
11924        CALL DPWRST('XXX','BUG ')
11925        DO55I=1,NEDGE
11926          WRITE(ICOUT,56)I,EDGE1(I),EDGE2(I)
11927   56     FORMAT('I,EDGE1(I),EDGE2(I) = ',I8,2G15.7)
11928          CALL DPWRST('XXX','BUG ')
11929   55   CONTINUE
11930        DO65I=1,NVERT
11931          WRITE(ICOUT,66)I,Y(I),X(I)
11932   66     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
11933          CALL DPWRST('XXX','BUG ')
11934   65   CONTINUE
11935      ENDIF
11936C
11937C               ******************************************
11938C               **  STEP 1: CHECK THAT VERTICES ARE IN  **
11939C               **          THE RANGE (1,NVERT)         **
11940C               ******************************************
11941C
11942      DO100I=1,NEDGE
11943        ITEMP1=INT(EDGE1(I)+0.01)
11944        IF(ITEMP1.LT.1 .OR. ITEMP1.GT.NVERT)THEN
11945          WRITE(ICOUT,999)
11946          CALL DPWRST('XXX','BUG ')
11947          WRITE(ICOUT,101)
11948  101     FORMAT('***** ERROR FROM EDGES TO VERTICES--')
11949          CALL DPWRST('XXX','BUG ')
11950          WRITE(ICOUT,103)I
11951  103     FORMAT('      THE FIRST VERTEX FOR EDGE ',I8,' IS LESS ',
11952     1           'THAN ONE')
11953          CALL DPWRST('XXX','BUG ')
11954          WRITE(ICOUT,105)NVERT
11955  105     FORMAT('      OR GREATER THAN THE NUMBER OF VERTICES (',I8,
11956     1           ').')
11957          CALL DPWRST('XXX','BUG ')
11958          IERROR='YES'
11959          GOTO9000
11960        ENDIF
11961C
11962        ITEMP2=INT(EDGE2(I)+0.01)
11963        IF(ITEMP2.LT.1 .OR. ITEMP2.GT.NVERT)THEN
11964          WRITE(ICOUT,999)
11965          CALL DPWRST('XXX','BUG ')
11966          WRITE(ICOUT,101)
11967          CALL DPWRST('XXX','BUG ')
11968          WRITE(ICOUT,113)I
11969  113     FORMAT('      THE SECOND VERTEX FOR EDGE ',I8,' IS LESS THAN')
11970          CALL DPWRST('XXX','BUG ')
11971          WRITE(ICOUT,105)NVERT
11972          CALL DPWRST('XXX','BUG ')
11973          IERROR='YES'
11974          GOTO9000
11975        ENDIF
11976C
11977  100 CONTINUE
11978C
11979      ICNT1=0
11980      ICNT2=0
11981      DO200I=1,NEDGE
11982        ICNT2=ICNT2+1
11983        ITEMP1=INT(EDGE1(I)+0.01)
11984        ITEMP2=INT(EDGE2(I)+0.01)
11985        ICNT1=ICNT1+1
11986        Y2(ICNT1)=Y(ITEMP1)
11987        X2(ICNT1)=X(ITEMP1)
11988        TAG(ICNT1)=REAL(ICNT2)
11989        ICNT1=ICNT1+1
11990        Y2(ICNT1)=Y(ITEMP2)
11991        X2(ICNT1)=X(ITEMP2)
11992        TAG(ICNT1)=REAL(ICNT2)
11993  200 CONTINUE
11994C
11995      NOUT=ICNT1
11996C
11997C               *****************
11998C               **  STEP 90--  **
11999C               **  EXIT.      **
12000C               *****************
12001C
12002 9000 CONTINUE
12003C
12004      IF(IBUGA3.EQ.'ON')THEN
12005        WRITE(ICOUT,999)
12006        CALL DPWRST('XXX','BUG ')
12007        WRITE(ICOUT,9011)
12008 9011   FORMAT('***** AT THE END OF EDGVER--')
12009        CALL DPWRST('XXX','BUG ')
12010        WRITE(ICOUT,9014)NOUT
12011 9014   FORMAT('NOUT = ',I8)
12012        CALL DPWRST('XXX','BUG ')
12013        DO9015I=1,NOUT
12014          WRITE(ICOUT,9016)I,Y2(I),X2(I),TAG(I)
12015 9016     FORMAT('I,Y2(I),X2(I),TAG(I) = ',I8,3G15.7)
12016          CALL DPWRST('XXX','BUG ')
12017 9015   CONTINUE
12018      ENDIF
12019C
12020      RETURN
12021      END
12022      SUBROUTINE EEWCDF(X,AL,GAMMA1,SCALE1,GAMMA2,SCALE2,CDF)
12023C
12024C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
12025C              FUNCTION VALUE FOR THE END-EFFECTS WEIBULL DISTRIBUTION.
12026C              THIS DISTRIBUTION IS USED IN MODELING FAILURES OF
12027C              CARBON FIBERS UNDER STRESS.  THE CDF IS DEFINED AS:
12028C
12029C              F(X,L,S1,G1,L2,S2,G2) =
12030C                 1 - EXP[-L*(X/S1)**G1 - (X/S2)**G2]
12031C                     X, L, S1, G1, S2, G2 > 0
12032C
12033C             HERE, S1 AND G1 ARE THE SCALE AND SHAPE PARAMETERS
12034C             OF A WEIBULL DISTRIBUTION THAT MODELS "TRUE" FLAWS
12035C             AND S2 AND G2 ARE SCALE AND SHAPE PARAMETERS OF A
12036C             WEIBULL DISTRIBUTION THAT MODELS "END EFFECTS".  L
12037C             IS THE LENGTH OF THE FIBER (THIS SHOULD TYPICALLY BE
12038C             A KNOWN, FIXED VALUE).  NOTE THAT END-EFFECTS TYPICALLY
12039C             BECOME LESS PROMINENT AS THE FIBER LENGTH INCREASES
12040C             SINCE THE FIBER IS MORE LIKELY TO CONTAIN A FATAL FLAW.
12041C
12042C     INPUT  ARGUMENTS--X      = THE DOUBLE PRECISION VALUE AT
12043C                                WHICH THE CUMULATIVE DISTRIBUTION
12044C                                FUNCTION IS TO BE EVALUATED.
12045C                                X SHOULD BE NON-NEGATIVE.
12046C                     --AL     = FIBER LENGTH
12047C                     --SCALE1 = SCALE PARAMETER (FIRST PART)
12048C                     --GAMMA1 = SHAPE PARAMETER (FIRST PART)
12049C                     --SCALE2 = SCALE PARAMETER (SECOND PART)
12050C                     --GAMMA2 = SHAPE PARAMETER (SECOND PART)
12051C     OUTPUT ARGUMENTS--CDF    = THE DOUBLE PRECISION CUMULATIVE
12052C                                DISTRIBUTION FUNCTION VALUE.
12053C     OUTPUT--THE DOUBLE PRECISION CUMULATIVE DISTRIBUTION
12054C             FUNCTION VALUE CDF FOR THE END-EFFECTS WEIBULL DISTRIBUTION
12055C             WITH 5 SHAPE PARAMETERS
12056C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
12057C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
12058C                 --GAMMA1,GAMMA2,SCALE1,SCALE2,AL SHOULD BE POSITIVE.
12059C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
12060C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
12061C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
12062C     LANGUAGE--ANSI FORTRAN (1977)
12063C     REFERENCES--STONER, EDIE, AND DURHAM (1994), "AN END-EFFECT MODEL
12064C                 FOR THE SINGLE-FILAMENT TENSILE TEST", JOURNAL OF
12065C                 OF MATERIALS SCIENCE, 29, PP. 6561-6574.
12066C               --NEWELL AND SAGENDORF (1999), "EXPERIMENTAL VERIFICATION
12067C                 OF THE END-EFFECT WEIBULL MODEL AS A PREDICTOR OF THE
12068C                 TENSILE STRENGTH OF KEVLAR-29 (POLY
12069C                 p-PHENYLENETEREPHTHALAMIDE) FIBRES AT DIFFERENCE GAUGE
12070C                 LENGTHS", HIGH PERFORMANCE POLYMERS, 11, PP. 297-305.
12071C     WRITTEN BY--ALAN HECKERT
12072C                 STATISTICAL ENGINEERING DIVISION
12073C                 INFORMATION TECHNOLOGY LABORATORY
12074C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12075C                 GAITHERSBURG, MD 20899-8980
12076C                 PHONE--301-975-2899
12077C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12078C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12079C     LANGUAGE--ANSI FORTRAN (1977)
12080C     VERSION NUMBER--2010.7
12081C     ORIGINAL VERSION--JULY      2010.
12082C
12083C---------------------------------------------------------------------
12084C
12085      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
12086C
12087      INCLUDE 'DPCOP2.INC'
12088C
12089C-----START POINT-----------------------------------------------------
12090C
12091C     CHECK THE INPUT ARGUMENTS FOR ERRORS
12092C
12093      CDF=0.0D0
12094      IF(SCALE1.LE.0.0D0)THEN
12095        WRITE(ICOUT,5)
12096    5   FORMAT('***** ERROR--THE SCALE(1) PARAMETER FOR EEWCDF ',
12097     1         'IS NON-POSITIVE')
12098        CALL DPWRST('XXX','BUG ')
12099        WRITE(ICOUT,46)SCALE1
12100   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
12101        CALL DPWRST('XXX','BUG ')
12102        GOTO9000
12103      ELSEIF(GAMMA1.LE.0.0D0)THEN
12104        WRITE(ICOUT,15)
12105   15   FORMAT('***** ERROR--THE GAMMA(1) SHAPE PARAMETER FOR EEWCDF ',
12106     1         'IS NON-POSITIVE')
12107        CALL DPWRST('XXX','BUG ')
12108        WRITE(ICOUT,46)GAMMA1
12109        CALL DPWRST('XXX','BUG ')
12110        GOTO9000
12111      ELSEIF(SCALE2.LE.0.0D0)THEN
12112        WRITE(ICOUT,25)
12113   25   FORMAT('***** ERROR--THE SCALE(2) PARAMETER FOR EEWCDF ',
12114     1         'IS NON-POSITIVE')
12115        CALL DPWRST('XXX','BUG ')
12116        WRITE(ICOUT,46)SCALE2
12117        CALL DPWRST('XXX','BUG ')
12118        GOTO9000
12119      ELSEIF(GAMMA2.LE.0.0D0)THEN
12120        WRITE(ICOUT,35)
12121   35   FORMAT('***** ERROR--THE GAMMA(2) SHAPE PARAMETER FOR EEWCDF ',
12122     1         'IS NON-POSITIVE')
12123        CALL DPWRST('XXX','BUG ')
12124        WRITE(ICOUT,46)GAMMA2
12125        CALL DPWRST('XXX','BUG ')
12126        GOTO9000
12127      ELSEIF(AL.LE.0.0D0)THEN
12128        WRITE(ICOUT,45)
12129   45   FORMAT('***** ERROR--THE FIBER LENGTH PARAMETER FOR EEWCDF ',
12130     1         'IS NON-POSITIVE')
12131        CALL DPWRST('XXX','BUG ')
12132        WRITE(ICOUT,46)AL
12133        CALL DPWRST('XXX','BUG ')
12134        GOTO9000
12135      ENDIF
12136C
12137      IF(X.LE.0.0D0)THEN
12138        CDF=0.0D0
12139      ELSE
12140        DTERM1=-AL*(X/SCALE1)**GAMMA1
12141        DTERM2=(X/SCALE2)**GAMMA2
12142        CDF=DEXP(DTERM1 - DTERM2)
12143        CDF=1.0D0 - CDF
12144      ENDIF
12145C
12146 9000 CONTINUE
12147      RETURN
12148      END
12149      SUBROUTINE EEWCD2(X,NX,LI,PI,NI,GAMMA1,SCALE1,GAMMA2,SCALE2,ALOC,
12150     1                  CDF,
12151     1                  ISUBRO,IBUGA2,IERROR)
12152C
12153C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
12154C              FUNCTION VALUE FOR THE END-EFFECTS WEIBULL DISTRIBUTION.
12155C              THIS DISTRIBUTION IS USED IN MODELING FAILURES OF
12156C              CARBON FIBERS UNDER STRESS.  THE CDF IS DEFINED AS:
12157C
12158C              F(X,L,S1,G1,L2,S2,G2) =
12159C                 1 - EXP[-L*(X/S1)**G1 - (X/S2)**G2]
12160C                     X, L, S1, G1, S2, G2 > 0
12161C
12162C             HERE, S1 AND G1 ARE THE SCALE AND SHAPE PARAMETERS
12163C             OF A WEIBULL DISTRIBUTION THAT MODELS "TRUE" FLAWS
12164C             AND S2 AND G2 ARE SCALE AND SHAPE PARAMETERS OF A
12165C             WEIBULL DISTRIBUTION THAT MODELS "END EFFECTS".  L
12166C             IS THE LENGTH OF THE FIBER (THIS SHOULD TYPICALLY BE
12167C             A KNOWN, FIXED VALUE).  NOTE THAT END-EFFECTS TYPICALLY
12168C             BECOME LESS PROMINENT AS THE FIBER LENGTH INCREASES
12169C             SINCE THE FIBER IS MORE LIKELY TO CONTAIN A FATAL FLAW.
12170C
12171C             THE EEWCDF ROUTINE COMPUTES THIS FUNCTION FOR A SINGLE
12172C             VALUE OF L.  THIS ROUTINE COMPUTES THIS FUNCTION FOR
12173C             MULTIPLE VALUES OF L.  IT DOES THIS USING A MIXTURE
12174C             APPROACH.  THAT IS
12175C
12176C              F(X;L,GAMMA1,SCALE1,GAMMA2,SCALE2) = SUM[i=1 to NI]
12177C                  [p(i)*EEFCDF(X;L(i),GAMMA1,SCALE1,GAMMA2,SCALE2)]
12178C
12179C              WHERE NI IS THE NUMBER OF DISTINCT VALUES FOR L.
12180C
12181C              THIS ROUTINE ASSUMES THAT THE SCALE/SHAPE
12182C              PARAMETERS ARE FIXED (I.E., ONLY L VARIES).
12183C
12184C              CURRENTLY, WE RESTRICT L TO A MAXIMUM OF 10 DISTINCT
12185C              LEVELS.
12186C
12187C     INPUT  ARGUMENTS--X      = A VARIABLE CONTAINING THE VALUES AT WHICH
12188C                                THE CUMULATIVE DISTRIBUTION FUNCTION IS
12189C                                TO BE EVALUATED.
12190C                     --NX     = A PARAMETER THAT SPECIFIES THE NUMBER
12191C                                OF VALUES FOR X.
12192C                     --LI     = A VARIABLE CONTAINING THE GAUGE LENGTH
12193C                                PARAMETER L.
12194C                     --PI     = A VARIABLE CONTAINING THE "MIXING"
12195C                                PROPORTIONS FOR LI.
12196C                     --NI     = A PARAMETER THAT SPECIFIES THE NUMBER
12197C                                OF VALUES FOR LI AND PI.
12198C                     --GAMMA1 = SHAPE PARAMETER (FIRST PART)
12199C                     --SCALE1 = SCALE PARAMETER (FIRST PART)
12200C                     --GAMMA2 = SHAPE PARAMETER (SECOND PART)
12201C                     --SCALE2 = SCALE PARAMETER (SECOND PART)
12202C     OUTPUT ARGUMENTS--PDF    = A VARIABLE CONTAINING THE CUMULATIVE
12203C                                DISTRIBUTION FUNCTION VALUES.
12204C     OUTPUT--THE DOUBLE PRECISION CUMULATIVE DISTRIBUTION FUNCTION VALUES
12205C             CDF FOR THE END-EFFECTS WEIBULL DISTRIBUTION
12206C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
12207C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
12208C                 --GAMMA1,GAMMA2,SCALE1,SCALE2,AL SHOULD BE POSITIVE.
12209C     OTHER DATAPAC   SUBROUTINES NEEDED--EEWCDF.
12210C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
12211C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
12212C     LANGUAGE--ANSI FORTRAN (1977)
12213C     REFERENCES--STONER, EDIE, AND DURHAM (1994), "AN END-EFFECT MODEL
12214C                 FOR THE SINGLE-FILAMENT TENSILE TEST", JOURNAL OF
12215C                 OF MATERIALS SCIENCE, 29, PP. 6561-6574.
12216C               --NEWELL AND SAGENDORF (1999), "EXPERIMENTAL VERIFICATION
12217C                 OF THE END-EFFECT WEIBULL MODEL AS A PREDICTOR OF THE
12218C                 TENSILE STRENGTH OF KEVLAR-29 (POLY
12219C                 p-PHENYLENETEREPHTHALAMIDE) FIBRES AT DIFFERENCE GAUGE
12220C                 LENGTHS", HIGH PERFORMANCE POLYMERS, 11, PP. 297-305.
12221C     WRITTEN BY--ALAN HECKERT
12222C                 STATISTICAL ENGINEERING DIVISION
12223C                 INFORMATION TECHNOLOGY LABORATORY
12224C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12225C                 GAITHERSBURG, MD 20899-8980
12226C                 PHONE--301-975-2899
12227C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12228C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12229C     LANGUAGE--ANSI FORTRAN (1977)
12230C     VERSION NUMBER--2010.10
12231C     ORIGINAL VERSION--NOVEMBER  2010.
12232C
12233C---------------------------------------------------------------------
12234C
12235      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
12236      DOUBLE PRECISION X(*)
12237      DOUBLE PRECISION LI(*)
12238      DOUBLE PRECISION PI(*)
12239      DOUBLE PRECISION CDF(*)
12240C
12241      CHARACTER*4 ISUBRO
12242      CHARACTER*4 IBUGA2
12243      CHARACTER*4 IERROR
12244C
12245      INCLUDE 'DPCOP2.INC'
12246C
12247C-----START POINT-----------------------------------------------------
12248C
12249C     CHECK THE INPUT ARGUMENTS FOR ERRORS
12250C
12251      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'WCD2')THEN
12252        WRITE(ICOUT,51)
12253   51   FORMAT('***** AT THE BEGINNING OF EEWCD2')
12254        CALL DPWRST('XXX','BUG ')
12255      ENDIF
12256C
12257      IF(NX.LT.1)THEN
12258        WRITE(ICOUT,1)
12259    1   FORMAT('***** ERROR IN END EFFECTS WEIBULL CDF--')
12260        CALL DPWRST('XXX','BUG ')
12261        WRITE(ICOUT,3)
12262    3   FORMAT('      THE NUMBER OF REQUESTED CDF VALUES IS ',
12263     1         'NON-POSITIVE.')
12264        CALL DPWRST('XXX','BUG ')
12265        WRITE(ICOUT,5)NX
12266    5   FORMAT('      THE NUMBER OF REQUESTED CDF VALUES  = ',I8)
12267        CALL DPWRST('XXX','BUG ')
12268        IERROR='YES'
12269        GOTO9000
12270      ELSEIF(NI.LT.1)THEN
12271        WRITE(ICOUT,1)
12272        CALL DPWRST('XXX','BUG ')
12273        WRITE(ICOUT,13)
12274   13   FORMAT('      THE NUMBER OF DISTINCT GAUGE LENGTH (L) VALUES ',
12275     1         'IS NON-POSITIVE.')
12276        CALL DPWRST('XXX','BUG ')
12277        WRITE(ICOUT,15)NI
12278   15   FORMAT('      THE NUMBER OF REQUESTED L VALUES  = ',I8)
12279        CALL DPWRST('XXX','BUG ')
12280        IERROR='YES'
12281        GOTO9000
12282      ELSEIF(NI.GT.10)THEN
12283        WRITE(ICOUT,1)
12284        CALL DPWRST('XXX','BUG ')
12285        WRITE(ICOUT,18)
12286   18   FORMAT('      THE NUMBER OF DISTINCT GAUGE LENGTH (L) VALUES ',
12287     1         'IS GREATER THAN 10.')
12288        CALL DPWRST('XXX','BUG ')
12289        WRITE(ICOUT,15)NI
12290        CALL DPWRST('XXX','BUG ')
12291        IERROR='YES'
12292        GOTO9000
12293      ELSEIF(SCALE1.LE.0.0D0)THEN
12294        WRITE(ICOUT,1)
12295        CALL DPWRST('XXX','BUG ')
12296        WRITE(ICOUT,21)
12297   21   FORMAT('      THE SCALE(1) PARAMETER IS NON-POSITIVE')
12298        CALL DPWRST('XXX','BUG ')
12299        WRITE(ICOUT,46)SCALE1
12300   46   FORMAT('      THE VALUE OF THE ARGUMENT IS ',G15.7)
12301        CALL DPWRST('XXX','BUG ')
12302        GOTO9000
12303      ELSEIF(GAMMA1.LE.0.0D0)THEN
12304        WRITE(ICOUT,1)
12305        CALL DPWRST('XXX','BUG ')
12306        WRITE(ICOUT,23)
12307   23   FORMAT('      THE GAMMA(1) SHAPE PARAMETER IS NON-POSITIVE')
12308        CALL DPWRST('XXX','BUG ')
12309        WRITE(ICOUT,46)GAMMA1
12310        CALL DPWRST('XXX','BUG ')
12311        GOTO9000
12312      ELSEIF(SCALE2.LE.0.0D0)THEN
12313        WRITE(ICOUT,1)
12314        CALL DPWRST('XXX','BUG ')
12315        WRITE(ICOUT,25)
12316   25   FORMAT('      THE SCALE(2) PARAMETER IS NON-POSITIVE')
12317        CALL DPWRST('XXX','BUG ')
12318        WRITE(ICOUT,46)SCALE2
12319        CALL DPWRST('XXX','BUG ')
12320        GOTO9000
12321      ELSEIF(GAMMA2.LE.0.0D0)THEN
12322        WRITE(ICOUT,1)
12323        CALL DPWRST('XXX','BUG ')
12324        WRITE(ICOUT,27)
12325   27   FORMAT('      THE GAMMA(2) SHAPE PARAMETER IS NON-POSITIVE')
12326        CALL DPWRST('XXX','BUG ')
12327        WRITE(ICOUT,46)GAMMA2
12328        CALL DPWRST('XXX','BUG ')
12329        GOTO9000
12330      ENDIF
12331C
12332      DSUM1=0.0D0
12333      DO60I=1,NI
12334        IF(LI(I).LE.0.0D0)THEN
12335          WRITE(ICOUT,1)
12336          CALL DPWRST('XXX','BUG ')
12337          WRITE(ICOUT,62)I
12338   62     FORMAT('      FOR ROW ',I8,' THE VALUE OF THE GAUGE LENGTH ',
12339     1           'ARGUMENT (L) IS NON-POSITIVE.')
12340          CALL DPWRST('XXX','BUG ')
12341          WRITE(ICOUT,64)LI(I)
12342   64     FORMAT('      THE VALUE OF L(I)  = ',G15.7)
12343          CALL DPWRST('XXX','BUG ')
12344          GOTO9000
12345          IERROR='YES'
12346        ELSEIF(PI(I).LE.0.0D0 .OR. PI(I).GT.1.0D0)THEN
12347          WRITE(ICOUT,1)
12348          CALL DPWRST('XXX','BUG ')
12349          WRITE(ICOUT,67)I
12350   67     FORMAT('      FOR ROW ',I8,' THE VALUE OF THE MIXING ',
12351     1           'ARGUMENT (P)')
12352          CALL DPWRST('XXX','BUG ')
12353          WRITE(ICOUT,68)
12354   68     FORMAT('      IS OUTSIDE THE (0,1) INTERVAL).')
12355          CALL DPWRST('XXX','BUG ')
12356          WRITE(ICOUT,69)PI(I)
12357   69     FORMAT('      THE VALUE OF P(I)  = ',G15.7)
12358          CALL DPWRST('XXX','BUG ')
12359          GOTO9000
12360          IERROR='YES'
12361        ENDIF
12362        DSUM1=DSUM1 + PI(I)
12363   60 CONTINUE
12364C
12365C     CHECK THAT MIXING PROPORTIONS SUM TO 1
12366C
12367      IF(ABS(DSUM1 - 1.0D0).GT.0.000001D0)THEN
12368        WRITE(ICOUT,1)
12369        CALL DPWRST('XXX','BUG ')
12370        WRITE(ICOUT,63)
12371   63   FORMAT('      THE MIXING PROPORTIONS DO NOT SUM TO ONE.')
12372        CALL DPWRST('XXX','BUG ')
12373        WRITE(ICOUT,65)REAL(DSUM1)
12374   65   FORMAT('      THE SUM OF THE MIXING PROPORTIONS  = ',G15.7)
12375        CALL DPWRST('XXX','BUG ')
12376      ENDIF
12377C
12378C     NOW COMPUTE THE CDF BY SUMMING OVER THE L(I) CASES
12379C
12380      DO100I=1,NX
12381        IF(X(I).LE.ALOC)THEN
12382          CDF(I)=0.0D0
12383          GOTO100
12384        ENDIF
12385        DSUM1=0.0D0
12386        DO200J=1,NI
12387          DTERM1=X(I)-ALOC
12388          CALL EEWCDF(DTERM1,LI(J),GAMMA1,SCALE1,GAMMA2,SCALE2,DTERM2)
12389          DSUM1=DSUM1 + PI(J)*DTERM2
12390  200   CONTINUE
12391        CDF(I)=DSUM1
12392  100 CONTINUE
12393C
12394 9000 CONTINUE
12395      RETURN
12396      END
12397      SUBROUTINE EEWPDF(X,AL,GAMMA1,SCALE1,GAMMA2,SCALE2,PDF)
12398C
12399C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILUITY DENSITY
12400C              FUNCTION VALUE FOR THE END-EFFECTS WEIBULL DISTRIBUTION.
12401C              THIS DISTRIBUTION IS USED IN MODELING FAILURES OF
12402C              CARBON FIBERS UNDER STRESS.  THE PDF IS DEFINED AS:
12403C
12404C              f(X,L,S1,G1,L2,S2,G2) =
12405C                 [L*G1*X**(G1-1)/S1**G1 + G2*X**(G2-1)/S2**G2]*
12406C                 EXP[-L*(X/S1)**G1 - (X/S2)**G2]
12407C                 X, L, S1, G1, S2, G2 > 0
12408C
12409C             HERE, S1 AND G1 ARE THE SCALE AND SHAPE PARAMETERS
12410C             OF A WEIBULL DISTRIBUTION THAT MODELS "TRUE" FLAWS
12411C             AND S2 AND G2 ARE SCALE AND SHAPE PARAMETERS OF A
12412C             WEIBULL DISTRIBUTION THAT MODELS "END EFFECTS".  L
12413C             IS THE LENGTH OF THE FIBER (THIS SHOULD TYPICALLY BE
12414C             A KNOWN, FIXED VALUE).  NOTE THAT END-EFFECTS TYPICALLY
12415C             BECOME LESS PROMINENT AS THE FIBER LENGTH INCREASES
12416C             SINCE THE FIBER IS MORE LIKELY TO CONTAIN A FATAL FLAW.
12417C
12418C     INPUT  ARGUMENTS--X      = THE DOUBLE PRECISION VALUE AT
12419C                                WHICH THE PROBABILITY DENSITY
12420C                                FUNCTION IS TO BE EVALUATED.
12421C                                X SHOULD BE NON-NEGATIVE.
12422C                     --AL     = FIBER LENGTH
12423C                     --SCALE1 = SCALE PARAMETER (FIRST PART)
12424C                     --GAMMA1 = SHAPE PARAMETER (FIRST PART)
12425C                     --SCALE2 = SCALE PARAMETER (SECOND PART)
12426C                     --GAMMA2 = SHAPE PARAMETER (SECOND PART)
12427C     OUTPUT ARGUMENTS--PDF    = THE DOUBLE PRECISION PROBABILITY DENSITY
12428C                                FUNCTION VALUE.
12429C     OUTPUT--THE DOUBLE PRECISION PROBABILITY DENSITY FUNCTION VALUE PDF
12430C             FOR THE END-EFFECTS WEIBULL DISTRIBUTION
12431C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
12432C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
12433C                 --GAMMA1,GAMMA2,SCALE1,SCALE2,AL SHOULD BE POSITIVE.
12434C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
12435C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
12436C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
12437C     LANGUAGE--ANSI FORTRAN (1977)
12438C     REFERENCES--STONER, EDIE, AND DURHAM (1994), "AN END-EFFECT MODEL
12439C                 FOR THE SINGLE-FILAMENT TENSILE TEST", JOURNAL OF
12440C                 OF MATERIALS SCIENCE, 29, PP. 6561-6574.
12441C               --NEWELL AND SAGENDORF (1999), "EXPERIMENTAL VERIFICATION
12442C                 OF THE END-EFFECT WEIBULL MODEL AS A PREDICTOR OF THE
12443C                 TENSILE STRENGTH OF KEVLAR-29 (POLY
12444C                 p-PHENYLENETEREPHTHALAMIDE) FIBRES AT DIFFERENCE GAUGE
12445C                 LENGTHS", HIGH PERFORMANCE POLYMERS, 11, PP. 297-305.
12446C     WRITTEN BY--ALAN HECKERT
12447C                 STATISTICAL ENGINEERING DIVISION
12448C                 INFORMATION TECHNOLOGY LABORATORY
12449C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12450C                 GAITHERSBURG, MD 20899-8980
12451C                 PHONE--301-975-2899
12452C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12453C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12454C     LANGUAGE--ANSI FORTRAN (1977)
12455C     VERSION NUMBER--2010.7
12456C     ORIGINAL VERSION--JULY      2010.
12457C
12458C---------------------------------------------------------------------
12459C
12460      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
12461C
12462      INCLUDE 'DPCOP2.INC'
12463C
12464C-----START POINT-----------------------------------------------------
12465C
12466C     CHECK THE INPUT ARGUMENTS FOR ERRORS
12467C
12468      PDF=0.0D0
12469      IF(X.LE.0.0D0)THEN
12470        WRITE(ICOUT,55)
12471   55   FORMAT('***** ERROR--THE FIRST ARGUMENT TO EEWPDF IS ',
12472     1         'NON-POSITIVE')
12473        CALL DPWRST('XXX','BUG ')
12474        WRITE(ICOUT,46)X
12475        CALL DPWRST('XXX','BUG ')
12476        GOTO9000
12477      ELSEIF(SCALE1.LE.0.0D0)THEN
12478        WRITE(ICOUT,5)
12479    5   FORMAT('***** ERROR--THE SCALE(1) PARAMETER FOR EEWPDF ',
12480     1         'IS NON-POSITIVE')
12481        CALL DPWRST('XXX','BUG ')
12482        WRITE(ICOUT,46)SCALE1
12483   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
12484        CALL DPWRST('XXX','BUG ')
12485        GOTO9000
12486      ELSEIF(GAMMA1.LE.0.0D0)THEN
12487        WRITE(ICOUT,15)
12488   15   FORMAT('***** ERROR--THE GAMMA(1) SHAPE PARAMETER FOR EEWPDF ',
12489     1         'IS NON-POSITIVE')
12490        CALL DPWRST('XXX','BUG ')
12491        WRITE(ICOUT,46)GAMMA1
12492        CALL DPWRST('XXX','BUG ')
12493        GOTO9000
12494      ELSEIF(SCALE2.LE.0.0D0)THEN
12495        WRITE(ICOUT,25)
12496   25   FORMAT('***** ERROR--THE SCALE(2) PARAMETER FOR EEWPDF ',
12497     1         'IS NON-POSITIVE')
12498        CALL DPWRST('XXX','BUG ')
12499        WRITE(ICOUT,46)SCALE2
12500        CALL DPWRST('XXX','BUG ')
12501        GOTO9000
12502      ELSEIF(GAMMA2.LE.0.0D0)THEN
12503        WRITE(ICOUT,35)
12504   35   FORMAT('***** ERROR--THE GAMMA(2) SHAPE PARAMETER FOR EEWPDF ',
12505     1         'IS NON-POSITIVE')
12506        CALL DPWRST('XXX','BUG ')
12507        WRITE(ICOUT,46)GAMMA2
12508        CALL DPWRST('XXX','BUG ')
12509        GOTO9000
12510      ELSEIF(AL.LE.0.0D0)THEN
12511        WRITE(ICOUT,45)
12512   45   FORMAT('***** ERROR--THE FIBER LENGTH PARAMETER FOR EEWPDF ',
12513     1         'IS NON-POSITIVE')
12514        CALL DPWRST('XXX','BUG ')
12515        WRITE(ICOUT,46)AL
12516        CALL DPWRST('XXX','BUG ')
12517        GOTO9000
12518      ENDIF
12519C
12520      DTERM1=AL*GAMMA1*(X**(GAMMA1-1.0D0))/(SCALE1**GAMMA1)
12521      DTERM2=GAMMA2*(X**(GAMMA2-1.0D0))/(SCALE2**GAMMA2)
12522      DTERM3=-AL*(X/SCALE1)**GAMMA1
12523      DTERM4=(X/SCALE2)**GAMMA2
12524      PDF=(DTERM1 + DTERM2)*DEXP(DTERM3 - DTERM4)
12525C
12526 9000 CONTINUE
12527      RETURN
12528      END
12529      SUBROUTINE EEWPD2(X,NX,LI,PI,NI,GAMMA1,SCALE1,GAMMA2,SCALE2,ALOC,
12530     1                  PDF,
12531     1                  ISUBRO,IBUGA2,IERROR)
12532C
12533C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILUITY DENSITY
12534C              FUNCTION VALUE FOR THE END-EFFECTS WEIBULL DISTRIBUTION.
12535C              THIS DISTRIBUTION IS USED IN MODELING FAILURES OF
12536C              CARBON FIBERS UNDER STRESS.  THE PDF IS DEFINED AS:
12537C
12538C              f(X,L,S1,G1,L2,S2,G2) =
12539C                 [L*G1*X**(G1-1)/S1**G1 + G2*X**(G2-1)/S2**G2]*
12540C                 EXP[-L*(X/S1)**G1 - (X/S2)**G2]
12541C                 X, L, S1, G1, S2, G2 > 0
12542C
12543C             HERE, S1 AND G1 ARE THE SCALE AND SHAPE PARAMETERS
12544C             OF A WEIBULL DISTRIBUTION THAT MODELS "TRUE" FLAWS
12545C             AND S2 AND G2 ARE SCALE AND SHAPE PARAMETERS OF A
12546C             WEIBULL DISTRIBUTION THAT MODELS "END EFFECTS".  L
12547C             IS THE LENGTH OF THE FIBER (THIS SHOULD TYPICALLY BE
12548C             A KNOWN, FIXED VALUE).  NOTE THAT END-EFFECTS TYPICALLY
12549C             BECOME LESS PROMINENT AS THE FIBER LENGTH INCREASES
12550C             SINCE THE FIBER IS MORE LIKELY TO CONTAIN A FATAL FLAW.
12551C
12552C             THE EEWPDF ROUTINE COMPUTES THIS FUNCTION FOR A SINGLE
12553C             VALUE OF L.  THIS ROUTINE COMPUTES THIS FUNCTION FOR
12554C             MULTIPLE VALUES OF L.  IT DOES THIS USING A MIXTURE
12555C             APPROACH.  THAT IS
12556C
12557C              f(X;L,GAMMA1,SCALE1,GAMMA2,SCALE2) = SUM[i=1 to NI]
12558C                  [p(i)*EEFPDF(X;L(i),GAMMA1,SCALE1,GAMMA2,SCALE2)]
12559C
12560C              WHERE NI IS THE NUMBER OF DISTINCT VALUES FOR L.
12561C
12562C              THIS ROUTINE ASSUMES THAT THE SCALE/SHAPE
12563C              PARAMETERS ARE FIXED (I.E., ONLY L VARIES).
12564C
12565C              CURRENTLY, WE RESTRICT L TO A MAXIMUM OF 10 DISTINCT
12566C              LEVELS.
12567C
12568C     INPUT  ARGUMENTS--X      = A VARIABLE CONTAINING THE VALUES AT WHICH
12569C                                THE PROBABILITY DENSITY FUNCTION IS TO
12570C                                BE EVALUATED.
12571C                     --NX     = A PARAMETER THAT SPECIFIES THE NUMBER
12572C                                OF VALUES FOR X.
12573C                     --LI     = A VARIABLE CONTAINING THE GAUGE LENGTH
12574C                                PARAMETER L.
12575C                     --PI     = A VARIABLE CONTAINING THE "MIXING"
12576C                                PROPORTIONS FOR LI.
12577C                     --NI     = A PARAMETER THAT SPECIFIES THE NUMBER
12578C                                OF VALUES FOR LI AND PI.
12579C                     --GAMMA1 = SHAPE PARAMETER (FIRST PART)
12580C                     --SCALE1 = SCALE PARAMETER (FIRST PART)
12581C                     --GAMMA2 = SHAPE PARAMETER (SECOND PART)
12582C                     --SCALE2 = SCALE PARAMETER (SECOND PART)
12583C     OUTPUT ARGUMENTS--PDF    = A VARIABLE CONTAINING THE PROBABILITY
12584C                                DENSITY FUNCTION VALUES.
12585C     OUTPUT--THE DOUBLE PRECISION PROBABILITY DENSITY FUNCTION VALUE PDF
12586C             FOR THE END-EFFECTS WEIBULL DISTRIBUTION
12587C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
12588C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
12589C                 --GAMMA1,GAMMA2,SCALE1,SCALE2,AL SHOULD BE POSITIVE.
12590C     OTHER DATAPAC   SUBROUTINES NEEDED--EEWPDF.
12591C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
12592C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
12593C     LANGUAGE--ANSI FORTRAN (1977)
12594C     REFERENCES--STONER, EDIE, AND DURHAM (1994), "AN END-EFFECT MODEL
12595C                 FOR THE SINGLE-FILAMENT TENSILE TEST", JOURNAL OF
12596C                 OF MATERIALS SCIENCE, 29, PP. 6561-6574.
12597C               --NEWELL AND SAGENDORF (1999), "EXPERIMENTAL VERIFICATION
12598C                 OF THE END-EFFECT WEIBULL MODEL AS A PREDICTOR OF THE
12599C                 TENSILE STRENGTH OF KEVLAR-29 (POLY
12600C                 p-PHENYLENETEREPHTHALAMIDE) FIBRES AT DIFFERENCE GAUGE
12601C                 LENGTHS", HIGH PERFORMANCE POLYMERS, 11, PP. 297-305.
12602C     WRITTEN BY--ALAN HECKERT
12603C                 STATISTICAL ENGINEERING DIVISION
12604C                 INFORMATION TECHNOLOGY LABORATORY
12605C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12606C                 GAITHERSBURG, MD 20899-8980
12607C                 PHONE--301-975-2899
12608C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12609C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12610C     LANGUAGE--ANSI FORTRAN (1977)
12611C     VERSION NUMBER--2010.10
12612C     ORIGINAL VERSION--NOVEMBER  2010.
12613C
12614C---------------------------------------------------------------------
12615C
12616      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
12617      DOUBLE PRECISION X(*)
12618      DOUBLE PRECISION LI(*)
12619      DOUBLE PRECISION PI(*)
12620      DOUBLE PRECISION PDF(*)
12621C
12622      CHARACTER*4 ISUBRO
12623      CHARACTER*4 IBUGA2
12624      CHARACTER*4 IERROR
12625C
12626      INCLUDE 'DPCOP2.INC'
12627C
12628C-----START POINT-----------------------------------------------------
12629C
12630C     CHECK THE INPUT ARGUMENTS FOR ERRORS
12631C
12632      IERROR='NO'
12633      IF(NX.LT.1)THEN
12634        WRITE(ICOUT,1)
12635    1   FORMAT('***** ERROR IN END EFFECTS WEIBULL PDF--')
12636        CALL DPWRST('XXX','BUG ')
12637        WRITE(ICOUT,3)
12638    3   FORMAT('      THE NUMBER OF REQUESTED PDF VALUES IS ',
12639     1         'NON-POSITIVE.')
12640        CALL DPWRST('XXX','BUG ')
12641        WRITE(ICOUT,5)NX
12642    5   FORMAT('      THE NUMBER OF REQUESTED PDF VALUES  = ',I8)
12643        CALL DPWRST('XXX','BUG ')
12644        IERROR='YES'
12645        GOTO9000
12646      ELSEIF(NI.LT.1)THEN
12647        WRITE(ICOUT,1)
12648        CALL DPWRST('XXX','BUG ')
12649        WRITE(ICOUT,13)
12650   13   FORMAT('      THE NUMBER OF DISTINCT GAUGE LENGTH (L) VALUES ',
12651     1         'IS NON-POSITIVE.')
12652        CALL DPWRST('XXX','BUG ')
12653        WRITE(ICOUT,15)NI
12654   15   FORMAT('      THE NUMBER OF REQUESTED L VALUES  = ',I8)
12655        CALL DPWRST('XXX','BUG ')
12656        IERROR='YES'
12657        GOTO9000
12658      ELSEIF(NI.GT.10)THEN
12659        WRITE(ICOUT,1)
12660        CALL DPWRST('XXX','BUG ')
12661        WRITE(ICOUT,18)
12662   18   FORMAT('      THE NUMBER OF DISTINCT GAUGE LENGTH (L) VALUES ',
12663     1         'IS GREATER THAN 10.')
12664        CALL DPWRST('XXX','BUG ')
12665        WRITE(ICOUT,15)NI
12666        CALL DPWRST('XXX','BUG ')
12667        IERROR='YES'
12668        GOTO9000
12669      ELSEIF(SCALE1.LE.0.0D0)THEN
12670        WRITE(ICOUT,1)
12671        CALL DPWRST('XXX','BUG ')
12672        WRITE(ICOUT,21)
12673   21   FORMAT('      THE SCALE(1) PARAMETER IS NON-POSITIVE')
12674        CALL DPWRST('XXX','BUG ')
12675        WRITE(ICOUT,46)SCALE1
12676   46   FORMAT('      THE VALUE OF THE ARGUMENT IS ',G15.7)
12677        CALL DPWRST('XXX','BUG ')
12678        GOTO9000
12679      ELSEIF(GAMMA1.LE.0.0D0)THEN
12680        WRITE(ICOUT,1)
12681        CALL DPWRST('XXX','BUG ')
12682        WRITE(ICOUT,23)
12683   23   FORMAT('      THE GAMMA(1) SHAPE PARAMETER IS NON-POSITIVE')
12684        CALL DPWRST('XXX','BUG ')
12685        WRITE(ICOUT,46)GAMMA1
12686        CALL DPWRST('XXX','BUG ')
12687        GOTO9000
12688      ELSEIF(SCALE2.LE.0.0D0)THEN
12689        WRITE(ICOUT,1)
12690        CALL DPWRST('XXX','BUG ')
12691        WRITE(ICOUT,25)
12692   25   FORMAT('      THE SCALE(2) PARAMETER IS NON-POSITIVE')
12693        CALL DPWRST('XXX','BUG ')
12694        WRITE(ICOUT,46)SCALE2
12695        CALL DPWRST('XXX','BUG ')
12696        GOTO9000
12697      ELSEIF(GAMMA2.LE.0.0D0)THEN
12698        WRITE(ICOUT,1)
12699        CALL DPWRST('XXX','BUG ')
12700        WRITE(ICOUT,27)
12701   27   FORMAT('      THE GAMMA(2) SHAPE PARAMETER IS NON-POSITIVE')
12702        CALL DPWRST('XXX','BUG ')
12703        WRITE(ICOUT,46)GAMMA2
12704        CALL DPWRST('XXX','BUG ')
12705        GOTO9000
12706      ENDIF
12707C
12708      DO50I=1,NX
12709        IF(X(I).LE.ALOC)THEN
12710          WRITE(ICOUT,1)
12711          CALL DPWRST('XXX','BUG ')
12712          WRITE(ICOUT,55)I
12713   55     FORMAT('      FOR ROW ',I8,' THE VALUE OF THE INPUT ',
12714     1           'ARGUMENT IS')
12715          CALL DPWRST('XXX','BUG ')
12716          WRITE(ICOUT,56)
12717   56     FORMAT('      LESS THAN OR EQUAL TO THE VALUE OF THE ',
12718     1           'LOCATION PARAMETER')
12719          CALL DPWRST('XXX','BUG ')
12720          WRITE(ICOUT,58)X(I)
12721   58     FORMAT('      THE VALUE OF X(I)                    = ',G15.7)
12722          CALL DPWRST('XXX','BUG ')
12723          WRITE(ICOUT,59)ALOC
12724   59     FORMAT('      THE VALUE OF THE LOCATION PARAMETER  = ',G15.7)
12725          CALL DPWRST('XXX','BUG ')
12726          GOTO9000
12727          IERROR='YES'
12728        ENDIF
12729   50 CONTINUE
12730C
12731      DSUM1=0.0D0
12732      DO60I=1,NI
12733        IF(LI(I).LE.0.0D0)THEN
12734          WRITE(ICOUT,1)
12735          CALL DPWRST('XXX','BUG ')
12736          WRITE(ICOUT,62)I
12737   62     FORMAT('      FOR ROW ',I8,' THE VALUE OF THE GAUGE LENGTH ',
12738     1           'ARGUMENT (L) IS NON-POSITIVE.')
12739          CALL DPWRST('XXX','BUG ')
12740          WRITE(ICOUT,64)LI(I)
12741   64     FORMAT('      THE VALUE OF L(I)  = ',G15.7)
12742          CALL DPWRST('XXX','BUG ')
12743          GOTO9000
12744          IERROR='YES'
12745        ELSEIF(PI(I).LE.0.0D0 .OR. PI(I).GT.1.0D0)THEN
12746          WRITE(ICOUT,1)
12747          CALL DPWRST('XXX','BUG ')
12748          WRITE(ICOUT,67)I
12749   67     FORMAT('      FOR ROW ',I8,' THE VALUE OF THE MIXING ',
12750     1           'ARGUMENT (P)')
12751          CALL DPWRST('XXX','BUG ')
12752          WRITE(ICOUT,68)
12753   68     FORMAT('      IS OUTSIDE THE (0,1) INTERVAL).')
12754          CALL DPWRST('XXX','BUG ')
12755          WRITE(ICOUT,69)PI(I)
12756   69     FORMAT('      THE VALUE OF P(I)  = ',G15.7)
12757          CALL DPWRST('XXX','BUG ')
12758          GOTO9000
12759          IERROR='YES'
12760        ENDIF
12761        DSUM1=DSUM1 + PI(I)
12762   60 CONTINUE
12763C
12764C     CHECK THAT MIXING PROPORTIONS SUM TO 1
12765C
12766      IF(ABS(DSUM1 - 1.0D0).GT.0.000001D0)THEN
12767        WRITE(ICOUT,1)
12768        CALL DPWRST('XXX','BUG ')
12769        WRITE(ICOUT,63)
12770   63   FORMAT('      THE MIXING PROPORTIONS DO NOT SUM TO ONE.')
12771        CALL DPWRST('XXX','BUG ')
12772        WRITE(ICOUT,65)REAL(DSUM1)
12773   65   FORMAT('      THE SUM OF THE MIXING PROPORTIONS  = ',G15.7)
12774        CALL DPWRST('XXX','BUG ')
12775      ENDIF
12776C
12777C     NOW COMPUTE THE PDF BY SUMMING OVER THE L(I) CASES
12778C
12779      DO100I=1,NX
12780        DSUM1=0.0D0
12781        DO200J=1,NI
12782          DTERM1=X(I)-ALOC
12783          CALL EEWPDF(DTERM1,LI(J),GAMMA1,SCALE1,GAMMA2,SCALE2,DTERM2)
12784          DSUM1=DSUM1 + PI(J)*DTERM2
12785  200   CONTINUE
12786        PDF(I)=DSUM1
12787  100 CONTINUE
12788C
12789 9000 CONTINUE
12790C
12791      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'WPDF')THEN
12792        WRITE(ICOUT,9010)
12793 9010   FORMAT('****** AT THE END OF EEWPD2')
12794        CALL DPWRST('XXX','BUG ')
12795      ENDIF
12796C
12797      RETURN
12798      END
12799      SUBROUTINE EEWPPF(P,AL,GAMMA1,SCALE1,GAMMA2,SCALE2,PPF)
12800C
12801C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
12802C              FUNCTION VALUE FOR THE END-EFFECTS WEIBULL DISTRIBUTION.
12803C              THIS DISTRIBUTION IS USED IN MODELING FAILURES OF
12804C              CARBON FIBERS UNDER STRESS.  THE CDF IS DEFINED AS:
12805C
12806C              F(X,L,S1,G1,L2,S2,G2) =
12807C                 1 - EXP[-L*(X/S1)**G1 - (X/S2)**G2]
12808C                     X, L, S1, G1, S2, G2 > 0
12809C
12810C             HERE, S1 AND G1 ARE THE SCALE AND SHAPE PARAMETERS
12811C             OF A WEIBULL DISTRIBUTION THAT MODELS "TRUE" FLAWS
12812C             AND S2 AND G2 ARE SCALE AND SHAPE PARAMETERS OF A
12813C             WEIBULL DISTRIBUTION THAT MODELS "END EFFECTS".  L
12814C             IS THE LENGTH OF THE FIBER (THIS SHOULD TYPICALLY BE
12815C             A KNOWN, FIXED VALUE).  NOTE THAT END-EFFECTS TYPICALLY
12816C             BECOME LESS PROMINENT AS THE FIBER LENGTH INCREASES
12817C             SINCE THE FIBER IS MORE LIKELY TO CONTAIN A FATAL FLAW.
12818C
12819C             THE PERCENT POINT FUNCTION IS COMPUTED BY NUMERICALLY
12820C             INVERTING THE CDF FUNCTION.
12821C
12822C     INPUT  ARGUMENTS--P      = THE DOUBLE PRECISION VALUE AT
12823C                                WHICH THE PERCENT POINT
12824C                                FUNCTION IS TO BE EVALUATED.
12825C                     --AL     = FIBER LENGTH
12826C                     --SCALE1 = SCALE PARAMETER (FIRST PART)
12827C                     --GAMMA1 = SHAPE PARAMETER (FIRST PART)
12828C                     --SCALE2 = SCALE PARAMETER (SECOND PART)
12829C                     --GAMMA2 = SHAPE PARAMETER (SECOND PART)
12830C     OUTPUT ARGUMENTS--CDF    = THE DOUBLE PRECISION CUMULATIVE
12831C                                DISTRIBUTION FUNCTION VALUE.
12832C     OUTPUT--THE DOUBLE PRECISION CUMULATIVE DISTRIBUTION
12833C             FUNCTION VALUE CDF FOR THE END-EFFECTS WEIBULL DISTRIBUTION
12834C             WITH 5 SHAPE PARAMETERS
12835C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
12836C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
12837C                 --GAMMA1,GAMMA2,SCALE1,SCALE2,AL SHOULD BE POSITIVE.
12838C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
12839C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
12840C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
12841C     LANGUAGE--ANSI FORTRAN (1977)
12842C     REFERENCES--STONER, EDIE, AND DURHAM (1994), "AN END-EFFECT MODEL
12843C                 FOR THE SINGLE-FILAMENT TENSILE TEST", JOURNAL OF
12844C                 OF MATERIALS SCIENCE, 29, PP. 6561-6574.
12845C               --NEWELL AND SAGENDORF (1999), "EXPERIMENTAL VERIFICATION
12846C                 OF THE END-EFFECT WEIBULL MODEL AS A PREDICTOR OF THE
12847C                 TENSILE STRENGTH OF KEVLAR-29 (POLY
12848C                 p-PHENYLENETEREPHTHALAMIDE) FIBRES AT DIFFERENCE GAUGE
12849C                 LENGTHS", HIGH PERFORMANCE POLYMERS, 11, PP. 297-305.
12850C     WRITTEN BY--ALAN HECKERT
12851C                 STATISTICAL ENGINEERING DIVISION
12852C                 INFORMATION TECHNOLOGY LABORATORY
12853C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12854C                 GAITHERSBURG, MD 20899-8980
12855C                 PHONE--301-975-2899
12856C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12857C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12858C     LANGUAGE--ANSI FORTRAN (1977)
12859C     VERSION NUMBER--2010.7
12860C     ORIGINAL VERSION--JULY      2010.
12861C
12862C---------------------------------------------------------------------
12863C
12864      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
12865C
12866      INCLUDE 'DPCOP2.INC'
12867C
12868      DATA DEPS /0.000000001/
12869      DATA DSIG /1.0D-9/
12870      DATA MAXIT /2000/
12871C
12872C-----START POINT-----------------------------------------------------
12873C
12874C     CHECK THE INPUT ARGUMENTS FOR ERRORS
12875C
12876      PPF=0.0D0
12877      IF(P.LT.0.0D0 .OR. P.GE.1.0D0)THEN
12878        WRITE(ICOUT,55)
12879   55   FORMAT('***** ERROR--THE FIRST ARGUMENT TO EEWPPF IS OUTSIDE ',
12880     1         'THE (0,1) INTERVAL')
12881        CALL DPWRST('XXX','BUG ')
12882        WRITE(ICOUT,46)P
12883        CALL DPWRST('XXX','BUG ')
12884        GOTO9000
12885      ELSEIF(SCALE1.LE.0.0D0)THEN
12886        WRITE(ICOUT,5)
12887    5   FORMAT('***** ERROR--THE SCALE(1) PARAMETER FOR EEWPPF ',
12888     1         'IS NON-POSITIVE')
12889        CALL DPWRST('XXX','BUG ')
12890        WRITE(ICOUT,46)SCALE1
12891   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
12892        CALL DPWRST('XXX','BUG ')
12893        GOTO9000
12894      ELSEIF(GAMMA1.LE.0.0D0)THEN
12895        WRITE(ICOUT,15)
12896   15   FORMAT('***** ERROR--THE GAMMA(1) SHAPE PARAMETER FOR EEWPPF ',
12897     1         'IS NON-POSITIVE')
12898        CALL DPWRST('XXX','BUG ')
12899        WRITE(ICOUT,46)GAMMA1
12900        CALL DPWRST('XXX','BUG ')
12901        GOTO9000
12902      ELSEIF(SCALE2.LE.0.0D0)THEN
12903        WRITE(ICOUT,25)
12904   25   FORMAT('***** ERROR--THE SCALE(2) PARAMETER FOR EEWPPF ',
12905     1         'IS NON-POSITIVE')
12906        CALL DPWRST('XXX','BUG ')
12907        WRITE(ICOUT,46)SCALE2
12908        CALL DPWRST('XXX','BUG ')
12909        GOTO9000
12910      ELSEIF(GAMMA2.LE.0.0D0)THEN
12911        WRITE(ICOUT,35)
12912   35   FORMAT('***** ERROR--THE GAMMA(2) SHAPE PARAMETER FOR EEWPPF ',
12913     1         'IS NON-POSITIVE')
12914        CALL DPWRST('XXX','BUG ')
12915        WRITE(ICOUT,46)GAMMA2
12916        CALL DPWRST('XXX','BUG ')
12917        GOTO9000
12918      ELSEIF(AL.LE.0.0D0)THEN
12919        WRITE(ICOUT,45)
12920   45   FORMAT('***** ERROR--THE FIBER LENGTH PARAMETER FOR EEWPPF ',
12921     1         'IS NON-POSITIVE')
12922        CALL DPWRST('XXX','BUG ')
12923        WRITE(ICOUT,46)AL
12924        CALL DPWRST('XXX','BUG ')
12925        GOTO9000
12926      ENDIF
12927C
12928      IF(P.LE.0.0D0)THEN
12929        PPF=0.0D0
12930        GOTO9000
12931      ENDIF
12932C
12933C     COMPUTE PPF NUMERICALLY
12934C
12935C
12936C     FIND BRACKETING INTERVAL.
12937C
12938      DXL=0.0D0
12939      DXINC=MAX(SCALE1,SCALE2)
12940      IF(DXINC.LT.1.0D0)DXINC=1.0D0
12941      ICOUNT=0
12942      MAXCNT=10000
12943C
12944   91 CONTINUE
12945      DXR=DXL+DXINC
12946      IF(DXL.LE.0.0D0)DXL=0.0D0
12947      IF(DXR.LE.0.0D0)DXR=DXL+DXINC
12948      CALL EEWCDF(DXL,AL,GAMMA1,SCALE1,GAMMA2,SCALE2,CDFL)
12949      CALL EEWCDF(DXR,AL,GAMMA1,SCALE1,GAMMA2,SCALE2,CDFR)
12950      IF(CDFL.LT.P .AND. CDFR.LT.P)THEN
12951        DXL=DXR
12952      ELSEIF(CDFL.GT.P .AND. CDFR.GT.P)THEN
12953        DXL=DXL-DXINC
12954      ELSE
12955        GOTO99
12956      ENDIF
12957      ICOUNT=ICOUNT+1
12958      IF(ICOUNT.GT.MAXCNT)THEN
12959        WRITE(ICOUT,96)
12960        CALL DPWRST('XXX','BUG ')
12961        PPF=0.0D0
12962        GOTO9000
12963      ENDIF
12964   96 FORMAT('***** ERROR--EEWPPF UNABLE TO FIND BRACKETING INTERVAL')
12965      GOTO91
12966C
12967C  BISECTION METHOD
12968C
12969   99 CONTINUE
12970      IC = 0
12971      DFXL = -P
12972      DFXR = 1.0D0 - P
12973  105 CONTINUE
12974      DX = (DXL+DXR)*0.5D0
12975      CALL EEWCDF(DX,AL,GAMMA1,SCALE1,GAMMA2,SCALE2,DCDF)
12976      DP1=DCDF
12977      DPPF=DX
12978      PPF=DPPF
12979      DFCS = DP1 - P
12980      IF(DFCS*DFXL.GT.0.0D0)GOTO110
12981      DXR = DX
12982      DFXR = DFCS
12983      GOTO115
12984  110 CONTINUE
12985      DXL = DX
12986      DFXL = DFCS
12987  115 CONTINUE
12988      DXRML = DXR - DXL
12989      IF(DXRML.LE.DSIG .AND. DABS(DFCS).LE.DEPS)GOTO9000
12990      IC = IC + 1
12991      IF(IC.LE.MAXIT)GOTO105
12992      WRITE(ICOUT,130)
12993      CALL DPWRST('XXX','BUG ')
12994  130 FORMAT('***** ERROR--EEWPPF ROUTINE DID NOT CONVERGE. ***')
12995      GOTO9000
12996C
12997 9000 CONTINUE
12998      RETURN
12999      END
13000      SUBROUTINE EEWPP2(P,NX,LI,PI,NI,GAMMA1,SCALE1,GAMMA2,SCALE2,ALOC,
13001     1                  PPF,
13002     1                  ISUBRO,IBUGA2,IERROR)
13003C
13004C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
13005C              FUNCTION VALUE FOR THE END EFFECTS WEIBULL
13006C              DISTRIBUTION.
13007C
13008C              THE EEWPPF ROUTINE COMPUTES THIS FUNCTION FOR A SINGLE
13009C              VALUE OF L.  THIS ROUTINE COMPUTES THIS FUNCTION FOR
13010C              MULTIPLE VALUES OF L.  IT DOES THIS USING A MIXTURE
13011C              APPROACH.  EEWPP2 COMPUTES THE PPF FUNCTION BY
13012C              NUMERICALLY INVERTING THE CUMULATIVE DISTRIBUTION
13013C              FUNCTION.
13014C
13015C              THIS ROUTINE ASSUMES THAT THE LOCATION/SCALE/SHAPE
13016C              PARAMETERS ARE FIXED (I.E., ONLY L VARIES).
13017C
13018C              CURRENTLY, WE RESTRICT L TO A MAXIMUM OF 10 DISTINCT
13019C              LEVELS.
13020C
13021C     INPUT  ARGUMENTS--P      = A VARIABLE CONTAINING THE VALUES AT WHICH
13022C                                THE PERCENT POINT FUNCTION IS
13023C                                TO BE EVALUATED.
13024C                     --NX     = A PARAMETER THAT SPECIFIES THE NUMBER
13025C                                OF VALUES FOR P.
13026C                     --LI     = A VARIABLE CONTAINING THE GAUGE LENGTH
13027C                                PARAMETER L.
13028C                     --PI     = A VARIABLE CONTAINING THE "MIXING"
13029C                                PROPORTIONS FOR LI.
13030C                     --NI     = A PARAMETER THAT SPECIFIES THE NUMBER
13031C                                OF VALUES FOR LI AND PI.
13032C                     --GAMMA1 = SHAPE PARAMETER (FIRST PART)
13033C                     --SCALE1 = SCALE PARAMETER (FIRST PART)
13034C                     --GAMMA2 = SHAPE PARAMETER (SECOND PART)
13035C                     --SCALE2 = SCALE PARAMETER (SECOND PART)
13036C     OUTPUT ARGUMENTS--PPF    = A VARIABLE CONTAINING THE PERCENT POINT
13037C                                FUNCTION VALUES.
13038C     OUTPUT--THE DOUBLE PRECISION PERCENT POINT FUNCTION VALUES.
13039C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
13040C     OTHER DATAPAC   SUBROUTINES NEEDED--EEWCD2.
13041C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
13042C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
13043C     LANGUAGE--ANSI FORTRAN (1977)
13044C     REFERENCES--STONER, EDIE, AND DURHAM (1994), "AN END-EFFECT MODEL
13045C                 FOR THE SINGLE-FILAMENT TENSILE TEST", JOURNAL OF
13046C                 OF MATERIALS SCIENCE, 29, PP. 6561-6574.
13047C               --NEWELL AND SAGENDORF (1999), "EXPERIMENTAL VERIFICATION
13048C                 OF THE END-EFFECT WEIBULL MODEL AS A PREDICTOR OF THE
13049C                 TENSILE STRENGTH OF KEVLAR-29 (POLY
13050C                 p-PHENYLENETEREPHTHALAMIDE) FIBRES AT DIFFERENCE GAUGE
13051C                 LENGTHS", HIGH PERFORMANCE POLYMERS, 11, PP. 297-305.
13052C     WRITTEN BY--ALAN HECKERT
13053C                 STATISTICAL ENGINEERING DIVISION
13054C                 INFORMATION TECHNOLOGY LABORATORY
13055C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13056C                 GAITHERSBURG, MD 20899-8980
13057C                 PHONE--301-975-2899
13058C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13059C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13060C     LANGUAGE--ANSI FORTRAN (1977)
13061C     VERSION NUMBER--2010.11
13062C     ORIGINAL VERSION--NOVEMBER  2010.
13063C
13064C---------------------------------------------------------------------
13065C
13066      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
13067C
13068      DOUBLE PRECISION P(*)
13069      DOUBLE PRECISION LI(*)
13070      DOUBLE PRECISION PI(*)
13071      DOUBLE PRECISION PPF(*)
13072C
13073      DOUBLE PRECISION DCDF(1)
13074      DOUBLE PRECISION DX(1)
13075C
13076      DOUBLE PRECISION LMIN
13077      DOUBLE PRECISION LMAX
13078C
13079      CHARACTER*4 ISUBRO
13080      CHARACTER*4 IBUGA2
13081      CHARACTER*4 IERROR
13082C
13083      INCLUDE 'DPCOP2.INC'
13084C
13085      DATA DEPS /1.0D-14/
13086      DATA DSIG /1.0D-14/
13087      DATA MAXIT /1000/
13088C
13089C-----START POINT-----------------------------------------------------
13090C
13091C     CHECK THE INPUT ARGUMENTS FOR ERRORS
13092C
13093      IF(NX.LT.1)THEN
13094        WRITE(ICOUT,1)
13095    1   FORMAT('***** ERROR IN END EFFECTS WEIBULL PPF--')
13096        CALL DPWRST('XXX','BUG ')
13097        WRITE(ICOUT,3)
13098    3   FORMAT('      THE NUMBER OF REQUESTED PPF VALUES IS ',
13099     1         'NON-POSITIVE.')
13100        CALL DPWRST('XXX','BUG ')
13101        WRITE(ICOUT,5)NX
13102    5   FORMAT('      THE NUMBER OF REQUESTED PPF VALUES  = ',I8)
13103        CALL DPWRST('XXX','BUG ')
13104        IERROR='YES'
13105        GOTO9000
13106      ELSEIF(NI.LT.1)THEN
13107        WRITE(ICOUT,1)
13108        CALL DPWRST('XXX','BUG ')
13109        WRITE(ICOUT,13)
13110   13   FORMAT('      THE NUMBER OF DISTINCT GAUGE LENGTH (L) VALUES ',
13111     1         'IS NON-POSITIVE.')
13112        CALL DPWRST('XXX','BUG ')
13113        WRITE(ICOUT,15)NI
13114   15   FORMAT('      THE NUMBER OF REQUESTED L VALUES  = ',I8)
13115        CALL DPWRST('XXX','BUG ')
13116        IERROR='YES'
13117        GOTO9000
13118      ELSEIF(NI.GT.10)THEN
13119        WRITE(ICOUT,1)
13120        CALL DPWRST('XXX','BUG ')
13121        WRITE(ICOUT,18)
13122   18   FORMAT('      THE NUMBER OF DISTINCT GAUGE LENGTH (L) VALUES ',
13123     1         'IS GREATER THAN 10.')
13124        CALL DPWRST('XXX','BUG ')
13125        WRITE(ICOUT,15)NI
13126        CALL DPWRST('XXX','BUG ')
13127        IERROR='YES'
13128        GOTO9000
13129      ELSEIF(SCALE1.LE.0.0D0)THEN
13130        WRITE(ICOUT,1)
13131        CALL DPWRST('XXX','BUG ')
13132        WRITE(ICOUT,21)
13133   21   FORMAT('      THE SCALE(1) PARAMETER IS NON-POSITIVE')
13134        CALL DPWRST('XXX','BUG ')
13135        WRITE(ICOUT,46)SCALE1
13136   46   FORMAT('      THE VALUE OF THE ARGUMENT IS ',G15.7)
13137        CALL DPWRST('XXX','BUG ')
13138        GOTO9000
13139      ELSEIF(GAMMA1.LE.0.0D0)THEN
13140        WRITE(ICOUT,1)
13141        CALL DPWRST('XXX','BUG ')
13142        WRITE(ICOUT,23)
13143   23   FORMAT('      THE GAMMA(1) SHAPE PARAMETER IS NON-POSITIVE')
13144        CALL DPWRST('XXX','BUG ')
13145        WRITE(ICOUT,46)GAMMA1
13146        CALL DPWRST('XXX','BUG ')
13147        GOTO9000
13148      ELSEIF(SCALE2.LE.0.0D0)THEN
13149        WRITE(ICOUT,1)
13150        CALL DPWRST('XXX','BUG ')
13151        WRITE(ICOUT,25)
13152   25   FORMAT('      THE SCALE(2) PARAMETER IS NON-POSITIVE')
13153        CALL DPWRST('XXX','BUG ')
13154        WRITE(ICOUT,46)SCALE2
13155        CALL DPWRST('XXX','BUG ')
13156        GOTO9000
13157      ELSEIF(GAMMA2.LE.0.0D0)THEN
13158        WRITE(ICOUT,1)
13159        CALL DPWRST('XXX','BUG ')
13160        WRITE(ICOUT,27)
13161   27   FORMAT('      THE GAMMA(2) SHAPE PARAMETER IS NON-POSITIVE')
13162        CALL DPWRST('XXX','BUG ')
13163        WRITE(ICOUT,46)GAMMA2
13164        CALL DPWRST('XXX','BUG ')
13165        GOTO9000
13166      ENDIF
13167C
13168      DSUM1=0.0D0
13169      DO50I=1,NI
13170        IF(LI(I).LE.0.0D0)THEN
13171          WRITE(ICOUT,1)
13172          CALL DPWRST('XXX','BUG ')
13173          WRITE(ICOUT,52)I
13174   52     FORMAT('      FOR ROW ',I8,' THE VALUE OF THE GAUGE LENGTH ',
13175     1           'ARGUMENT (L) IS NON-POSITIVE.')
13176          CALL DPWRST('XXX','BUG ')
13177          WRITE(ICOUT,54)LI(I)
13178   54     FORMAT('      THE VALUE OF L(I)  = ',G15.7)
13179          CALL DPWRST('XXX','BUG ')
13180          GOTO9000
13181          IERROR='YES'
13182        ELSEIF(PI(I).LE.0.0D0 .OR. PI(I).GT.1.0D0)THEN
13183          WRITE(ICOUT,1)
13184          CALL DPWRST('XXX','BUG ')
13185          WRITE(ICOUT,57)I
13186   57     FORMAT('      FOR ROW ',I8,' THE VALUE OF THE MIXING ',
13187     1           'ARGUMENT (P)')
13188          CALL DPWRST('XXX','BUG ')
13189          WRITE(ICOUT,58)
13190   58     FORMAT('      OUTSIDE THE (0,1) INTERVAL).')
13191          CALL DPWRST('XXX','BUG ')
13192          WRITE(ICOUT,59)PI(I)
13193   59     FORMAT('      THE VALUE OF P(I)  = ',G15.7)
13194          CALL DPWRST('XXX','BUG ')
13195          GOTO9000
13196          IERROR='YES'
13197        ENDIF
13198        DSUM1=DSUM1 + PI(I)
13199   50 CONTINUE
13200C
13201C     CHECK THAT MIXING PROPORTIONS SUM TO 1
13202C
13203      IF(ABS(DSUM1 - 1.0D0).GT.0.000001D0)THEN
13204        WRITE(ICOUT,1)
13205        CALL DPWRST('XXX','BUG ')
13206        WRITE(ICOUT,63)
13207   63   FORMAT('      THE MIXING PROPORTIONS DO NOT SUM TO ONE.')
13208        CALL DPWRST('XXX','BUG ')
13209        WRITE(ICOUT,65)REAL(DSUM1)
13210   65   FORMAT('      THE SUM OF THE MIXING PROPORTIONS  = ',G15.7)
13211        CALL DPWRST('XXX','BUG ')
13212      ENDIF
13213C
13214C     NOW COMPUTE THE PPF BY NUMERICALLY INVERTING THE CDF FUNCTION
13215C
13216      NTEMP=1
13217      LMIN=LI(1)
13218      LMAX=LI(1)
13219      DO90I=1,NI
13220        IF(LI(I).LT.LMIN)LMIN=LI(I)
13221        IF(LI(I).GT.LMAX)LMAX=LI(I)
13222   90 CONTINUE
13223C
13224      DO100I=1,NX
13225        DP=P(I)
13226C
13227        IF(DP.LT.0.0D0 .OR. DP.GE.1.0D0)THEN
13228          WRITE(ICOUT,1)
13229          CALL DPWRST('XXX','BUG ')
13230          WRITE(ICOUT,105)I
13231  105     FORMAT('      FOR ROW ',I8,' THE PROBABILITY PARAMETER (P) ',
13232     1           'IS OUTSIDE THE (0,1) INTERVAL.')
13233          CALL DPWRST('XXX','BUG ')
13234          WRITE(ICOUT,106)DP
13235  106     FORMAT('      THE VALUE OF P  = ',G15.7)
13236          CALL DPWRST('XXX','BUG ')
13237          IERROR='YES'
13238          GOTO9000
13239        ELSEIF(1.0D0 - DP.LE.0.0D0)THEN
13240          WRITE(ICOUT,1)
13241          CALL DPWRST('XXX','BUG ')
13242          WRITE(ICOUT,108)I
13243  108     FORMAT('      FOR ROW ',I8,' THE PROBABILITY PARAMETER (P) ',
13244     1           'IS TOO CLOSE TO 1 TO COMPUTE.')
13245          CALL DPWRST('XXX','BUG ')
13246          WRITE(ICOUT,106)DP
13247          CALL DPWRST('XXX','BUG ')
13248          IERROR='YES'
13249          GOTO9000
13250        ENDIF
13251        IF(DP.EQ.0.0D0)THEN
13252          PPF(I)=ALOC
13253          GOTO100
13254        ENDIF
13255C
13256C       STEP 1: FIND BRACKETING INTERVAL
13257C
13258        CALL EEWPPF(DP,LMIN,GAMMA1,SCALE1,GAMMA2,SCALE2,DTERM1)
13259        DTERM1=ALOC + DTERM1
13260        CALL EEWPPF(DP,LMAX,GAMMA1,SCALE1,GAMMA2,SCALE2,DTERM2)
13261        DTERM2=ALOC + DTERM2
13262        DXL=MIN(DTERM1,DTERM2)
13263        DXR=MAX(DTERM1,DTERM2)
13264        IF(DXL.EQ.DXR)THEN
13265          PPF(I)=DXL
13266          GOTO100
13267        ENDIF
13268        NTEMP=1
13269        DX(1)=DXL
13270        CALL EEWCD2(DX,NTEMP,LI,PI,NI,GAMMA1,SCALE1,GAMMA2,SCALE2,ALOC,
13271     1              DCDF,
13272     1              ISUBRO,IBUGA2,IERROR)
13273        DCDFL=DCDF(1)
13274        DX(1)=DXR
13275        CALL EEWCD2(DX,NTEMP,LI,PI,NI,GAMMA1,SCALE1,GAMMA2,SCALE2,ALOC,
13276     1              DCDF,
13277     1              ISUBRO,IBUGA2,IERROR)
13278        DCDFR=DCDF(1)
13279C
13280        IF(DCDFL.LT.DP .AND. DCDFR.LT.DP)THEN
13281          PPF(I)=CPUMIN
13282          GOTO100
13283        ELSEIF(DCDFL.GT.DP .AND. DCDFR.GT.DP)THEN
13284          PPF(I)=CPUMIN
13285          GOTO100
13286        ENDIF
13287C
13288C       STEP 2: BISECTION METHOD
13289C
13290        IC = 0
13291        DFXL = -DP
13292        DFXR = 1.0D0 - DP
13293  205   CONTINUE
13294        DX(1)=(DXL+DXR)*0.5D0
13295        CALL EEWCD2(DX,NTEMP,LI,PI,NI,GAMMA1,SCALE1,GAMMA2,SCALE2,ALOC,
13296     1              DCDF,
13297     1              ISUBRO,IBUGA2,IERROR)
13298        DP1=DCDF(1)
13299        DPPF=DX(1)
13300        DFCS = DP1 - DP
13301C
13302        IF(DFCS*DFXL.GT.0.0D0)THEN
13303          DXL = DX(1)
13304          DFXL = DFCS
13305        ELSE
13306          DXR = DX(1)
13307          DFXR = DFCS
13308        ENDIF
13309C
13310        DXRML = DXR - DXL
13311        IF(DXRML.LE.DSIG .AND. DABS(DFCS).LE.DEPS)THEN
13312          PPF(I)=DPPF
13313          GOTO100
13314        ENDIF
13315C
13316C       STEP 3: ERROR MESSAGE FOR NO CONVERGENCE
13317C
13318        IC = IC + 1
13319        IF(IC.LE.MAXIT)GOTO205
13320        WRITE(ICOUT,1)
13321        CALL DPWRST('XXX','BUG ')
13322        WRITE(ICOUT,230)I,DP
13323  230   FORMAT('      FOR ROW ',I8,' (P = ',G15.7,'), THERE WAS ',
13324     1         'NO CONVERGENCE')
13325        CALL DPWRST('XXX','BUG ')
13326        WRITE(ICOUT,233)
13327  233   FORMAT('      LAST VALUE OBTAINED WILL BE USED.')
13328        CALL DPWRST('XXX','BUG ')
13329        PPF(I)=DPPF
13330        GOTO100
13331C
13332  100 CONTINUE
13333C
13334 9000 CONTINUE
13335      RETURN
13336      END
13337      SUBROUTINE EMPQUA(X,NX,IWRITE,Y,U,NY,IBUGA3,ISUBRO,IERROR)
13338C
13339C     PURPOSE--COMPUTE THE EMPIRICAL QUANTILE FUNCTION OF A VARIABLE--
13340C              THE FORMULA IS:
13341C
13342C                 Qhat(u) = (N*u - j + (1/2))*X(j+1) +
13343C                           (j + (1/2) - N*u)*X(j)
13344C
13345C                           (2-j-1)/(2*N) <= u < (2*j+1)/(2*n)
13346C                           j = 1, 2, ... n-1
13347C
13348C               THIS WILL BE COMPUTED FOR A SPECIFIED NUMBER OF
13349C               EQUI-SPACED POINTS BETWEEN THE LOWER AND UPPER LIMITS.
13350C
13351C     REFERENCE--"MIL-HDBK-17-1F Volume 1: Guidelines for Characterization
13352C                of Structural Materials", Depeartment of Defense,
13353C                chapter 8, 2002.
13354C     WRITTEN BY--ALAN HECKERT
13355C                 STATISTICAL ENGINEERING DIVISION
13356C                 INFORMATION TECHNOLOGY LABORATORY
13357C                 NATION INSTITUTE OF STANDARDS AND TECHNOLOGY
13358C                 GAITHERSBURG, MD 20899-8980
13359C                 PHONE--301-975-2899
13360C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13361C           OF THE NATION INSTITUTE OF STANDARDS AND TECHNOLOGY.
13362C     LANGUAGE--ANSI FORTRAN (1977)
13363C     VERSION NUMBER--2017/2
13364C     ORIGINAL VERSION--FEBRUARY  2017.
13365C
13366C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
13367C
13368      CHARACTER*4 IWRITE
13369      CHARACTER*4 ISUBRO
13370      CHARACTER*4 IBUGA3
13371      CHARACTER*4 IERROR
13372C
13373      CHARACTER*4 ISUBN1
13374      CHARACTER*4 ISUBN2
13375C
13376C---------------------------------------------------------------------
13377C
13378      DIMENSION X(*)
13379      DIMENSION Y(*)
13380      DIMENSION U(*)
13381C
13382C-----COMMON----------------------------------------------------------
13383C
13384      INCLUDE 'DPCOP2.INC'
13385C
13386C-----START POINT-----------------------------------------------------
13387C
13388      ISUBN1='EMPQ'
13389      ISUBN2='UA  '
13390C
13391      IERROR='NO'
13392C
13393      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PQUA')THEN
13394        WRITE(ICOUT,999)
13395  999   FORMAT(1X)
13396        CALL DPWRST('XXX','BUG ')
13397        WRITE(ICOUT,51)
13398   51   FORMAT('***** AT THE BEGINNING OF EMPQUA--')
13399        CALL DPWRST('XXX','BUG ')
13400        WRITE(ICOUT,52)IWRITE,IBUGA3,NX
13401   52   FORMAT('IWRITE,IBUGA3,NX = ',2(A4,2X),I8)
13402        CALL DPWRST('XXX','BUG ')
13403        DO55I=1,NX
13404          WRITE(ICOUT,56)I,X(I)
13405   56     FORMAT('I,X(I) = ',I8,G15.7)
13406          CALL DPWRST('XXX','BUG ')
13407   55   CONTINUE
13408      ENDIF
13409C
13410C               **************************************
13411C               **  SORT THE DATA                   **
13412C               **************************************
13413C
13414      CALL SORT(X,NX,X)
13415C
13416      NY=0
13417      AN=REAL(NX)
13418      IF(NX.GT.1000)THEN
13419        NINC=1
13420      ELSE
13421        NTOT=1000
13422        AINC=REAL(NTOT)/REAL(NX)
13423        NINC=INT(AINC+0.5)
13424        IF(NINC.LE.0)NINC=1
13425      ENDIF
13426C
13427      DO100J=1,NX-1
13428        AJ=REAL(J)
13429        ALOW=(2.0*AJ - 1.0)/(2.0*AN)
13430        AUPP=(2.0*AJ + 1.0)/(2.0*AN)
13431        IF(NINC.EQ.1)THEN
13432          AMID=(ALOW+AUPP)/2.0
13433          NY=NY+1
13434          TERM1=AN*AMID - AJ + 0.5
13435          TERM2=AJ + 0.5 - AN*AMID
13436          U(NY)=AMID
13437          Y(NY)=TERM1*X(J+1) + TERM2*X(J)
13438        ELSE
13439          AINC=(AUPP-ALOW)/REAL(NINC)
13440          DO200K=1,NINC
13441            AVAL=ALOW + REAL(K-1)*AINC
13442            NY=NY+1
13443            TERM1=AN*AVAL - AJ + 0.5
13444            TERM2=AJ + 0.5 - AN*AVAL
13445            U(NY)=AVAL
13446            Y(NY)=TERM1*X(J+1) + TERM2*X(J)
13447  200     CONTINUE
13448        ENDIF
13449  100 CONTINUE
13450C
13451C               *****************
13452C               **  STEP 90--  **
13453C               **  EXIT.      **
13454C               *****************
13455C
13456      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PQUA')THEN
13457        WRITE(ICOUT,999)
13458        CALL DPWRST('XXX','BUG ')
13459        WRITE(ICOUT,9011)
13460 9011   FORMAT('***** AT THE END       OF EMPQUA--')
13461        CALL DPWRST('XXX','BUG ')
13462        WRITE(ICOUT,9013)IERROR,NX,NY
13463 9013   FORMAT('IERROR,NX,NY = ',A4,2X,2I8)
13464        CALL DPWRST('XXX','BUG ')
13465        DO9015I=1,NY
13466          WRITE(ICOUT,9016)I,U(I),Y(I)
13467 9016     FORMAT('I,U(I),Y(I) = ',I8,2G15.7)
13468          CALL DPWRST('XXX','BUG ')
13469 9015   CONTINUE
13470      ENDIF
13471C
13472      RETURN
13473      END
13474      SUBROUTINE EMPTIQ(X,NX,IWRITE,AIQHAT,TIQHAT,U,QUHAT,NY,
13475     1                  IBUGA3,ISUBRO,IERROR)
13476C
13477C     PURPOSE--COMPUTE THE INFORMATIVE QUANTILE (IQ) FUNCTION.
13478C
13479C              THE EMPIRICAL QUANTILE FUNCTION OF A VARIABLE IS
13480C              COMPUTED WITH THE FORMULA:
13481C
13482C                 Qhat(u) = (N*u - j + (1/2))*X(j+1) +
13483C                           (j + (1/2) - N*u)*X(j)
13484C
13485C                           (2-j-1)/(2*N) <= u < (2*j+1)/(2*n)
13486C                           j = 1, 2, ... n-1
13487C
13488C               THIS WILL BE COMPUTED FOR A SPECIFIED NUMBER OF
13489C               EQUI-SPACED POINTS BETWEEN THE LOWER AND UPPER LIMITS.
13490C
13491C               THE ESTIMATED IQ FUNCTION IS DEFINED AS:
13492C
13493C                 IQHAT(u) = (QHAT(u) - QHAT(0.5))/
13494C                            {2*(QHAT(0.75) - QHAT(0.25))}
13495C
13496C               THE ESTIMATED TRUNCATED IQ FUNCTION IS DEFINED AS:
13497C
13498C                 TIQHAT(u) = (QHAT(u) - QHAT(0.5))/
13499C                             {2*(QHAT(0.75) - QHAT(0.25))} -1 < IQHAT(u) <= 1
13500C
13501C                             -1                                 IQHAT(u) <= -1
13502C                             +1                                 IQHAT(u) >  +1
13503C
13504C     REFERENCE--"MIL-HDBK-17-1F Volume 1: Guidelines for Characterization
13505C                of Structural Materials", Depeartment of Defense,
13506C                chapter 8, 2002.
13507C     WRITTEN BY--ALAN HECKERT
13508C                 STATISTICAL ENGINEERING DIVISION
13509C                 INFORMATION TECHNOLOGY LABORATORY
13510C                 NATION INSTITUTE OF STANDARDS AND TECHNOLOGY
13511C                 GAITHERSBURG, MD 20899-8980
13512C                 PHONE--301-975-2899
13513C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13514C           OF THE NATION INSTITUTE OF STANDARDS AND TECHNOLOGY.
13515C     LANGUAGE--ANSI FORTRAN (1977)
13516C     VERSION NUMBER--2017/03
13517C     ORIGINAL VERSION--MARCH     2017.
13518C
13519C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
13520C
13521      CHARACTER*4 IWRITE
13522      CHARACTER*4 ISUBRO
13523      CHARACTER*4 IBUGA3
13524      CHARACTER*4 IERROR
13525C
13526      CHARACTER*4 ISUBN1
13527      CHARACTER*4 ISUBN2
13528C
13529      REAL LININ3
13530      EXTERNAL LININ3
13531C
13532C---------------------------------------------------------------------
13533C
13534      DIMENSION X(*)
13535      DIMENSION QUHAT(*)
13536      DIMENSION AIQHAT(*)
13537      DIMENSION TIQHAT(*)
13538      DIMENSION U(*)
13539C
13540C-----COMMON----------------------------------------------------------
13541C
13542      INCLUDE 'DPCOP2.INC'
13543C
13544C-----START POINT-----------------------------------------------------
13545C
13546      ISUBN1='EMPT'
13547      ISUBN2='IQ  '
13548C
13549      IERROR='NO'
13550C
13551      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PTIQ')THEN
13552        WRITE(ICOUT,999)
13553  999   FORMAT(1X)
13554        CALL DPWRST('XXX','BUG ')
13555        WRITE(ICOUT,51)
13556   51   FORMAT('***** AT THE BEGINNING OF EMPTIQ--')
13557        CALL DPWRST('XXX','BUG ')
13558        WRITE(ICOUT,52)IWRITE,IBUGA3,NX
13559   52   FORMAT('IWRITE,IBUGA3,NX = ',2(A4,2X),I8)
13560        CALL DPWRST('XXX','BUG ')
13561        DO55I=1,NX
13562          WRITE(ICOUT,56)I,X(I)
13563   56     FORMAT('I,X(I) = ',I8,G15.7)
13564          CALL DPWRST('XXX','BUG ')
13565   55   CONTINUE
13566      ENDIF
13567C
13568C               ***********************************************
13569C               **  COMPUTE THE EMPIRICAL QUANTILE FUNCTION  **
13570C               ***********************************************
13571C
13572      CALL SORT(X,NX,X)
13573C
13574      NY=0
13575      AN=REAL(NX)
13576      IF(NX.GT.1000)THEN
13577        NINC=1
13578      ELSE
13579        NTOT=1000
13580        AINC=REAL(NTOT)/REAL(NX)
13581        NINC=INT(AINC+0.5)
13582        IF(NINC.LE.0)NINC=1
13583      ENDIF
13584C
13585      DO100J=1,NX-1
13586        AJ=REAL(J)
13587        ALOW=(2.0*AJ - 1.0)/(2.0*AN)
13588        AUPP=(2.0*AJ + 1.0)/(2.0*AN)
13589        IF(NINC.EQ.1)THEN
13590          AMID=(ALOW+AUPP)/2.0
13591          NY=NY+1
13592          TERM1=AN*AMID - AJ + 0.5
13593          TERM2=AJ + 0.5 - AN*AMID
13594          U(NY)=AMID
13595          QUHAT(NY)=TERM1*X(J+1) + TERM2*X(J)
13596        ELSE
13597          AINC=(AUPP-ALOW)/REAL(NINC)
13598          DO200K=1,NINC
13599            AVAL=ALOW + REAL(K-1)*AINC
13600            NY=NY+1
13601            TERM1=AN*AVAL - AJ + 0.5
13602            TERM2=AJ + 0.5 - AN*AVAL
13603            U(NY)=AVAL
13604            QUHAT(NY)=TERM1*X(J+1) + TERM2*X(J)
13605  200     CONTINUE
13606        ENDIF
13607  100 CONTINUE
13608C
13609C               *****************************************************
13610C               **  NOW COMPUTE THE INFORMATIVE QUANTILE FUNCTION  **
13611C               *****************************************************
13612C
13613C      SEARCH THE LIST FOR THE CLOSEST MATCH TO U = 0.5, .25, and .75
13614C
13615      IFLAG1=0
13616      IFLAG2=0
13617      DO300I=1,NY-1
13618        IF(U(I).LE.0.25 .AND. U(I+1).GE.0.25 .AND. IFLAG1.EQ.0)THEN
13619          AVAL=0.25
13620          QU25=LININ3(U(I),QUHAT(I),U(I+1),QUHAT(I+1),AVAL,
13621     1                IBUGA3,ISUBRO,IERROR)
13622          IFLAG1=1
13623        ELSEIF(U(I).LE.0.5 .AND. U(I+1).GE.0.5 .AND. IFLAG2.EQ.0)THEN
13624          AVAL=0.50
13625          QU50=LININ3(U(I),QUHAT(I),U(I+1),QUHAT(I+1),AVAL,
13626     1                IBUGA3,ISUBRO,IERROR)
13627          IFLAG2=1
13628        ELSEIF(U(I).LE.0.75 .AND. U(I+1).GE.0.75)THEN
13629          AVAL=0.75
13630          QU75=LININ3(U(I),QUHAT(I),U(I+1),QUHAT(I+1),AVAL,
13631     1                IBUGA3,ISUBRO,IERROR)
13632          GOTO309
13633        ENDIF
13634  300 CONTINUE
13635  309 CONTINUE
13636C
13637      DO400I=1,NY
13638        AIQHAT(I)=(QUHAT(I) - QU50)/(2.0*(QU75 - QU25))
13639        IF(AIQHAT(I).LE.-1.0)THEN
13640          TIQHAT(I)=-1.0
13641        ELSEIF(AIQHAT(I).GT.1.0)THEN
13642          TIQHAT(I)=1.0
13643        ELSE
13644          TIQHAT(I)=AIQHAT(I)
13645        ENDIF
13646  400  CONTINUE
13647C
13648C               *****************
13649C               **  STEP 90--  **
13650C               **  EXIT.      **
13651C               *****************
13652C
13653      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PTIQ')THEN
13654        WRITE(ICOUT,999)
13655        CALL DPWRST('XXX','BUG ')
13656        WRITE(ICOUT,9011)
13657 9011   FORMAT('***** AT THE END       OF EMPTIQ--')
13658        CALL DPWRST('XXX','BUG ')
13659        WRITE(ICOUT,9013)IERROR,NX,NY,QU25,QU50,QU75
13660 9013   FORMAT('IERROR,NX,NY,QU25,QU50,QU75 = ',A4,2X,2I8,3G15.7)
13661        CALL DPWRST('XXX','BUG ')
13662        DO9015I=1,NY
13663          WRITE(ICOUT,9016)I,U(I),QUHAT(I),AIQHAT(I),TIQHAT(I)
13664 9016     FORMAT('I,U(I),QUHAT(I),AIQHAT(I),TIQHAT(I) = ',I8,4G15.7)
13665          CALL DPWRST('XXX','BUG ')
13666 9015   CONTINUE
13667      ENDIF
13668C
13669      RETURN
13670      END
13671      SUBROUTINE EN(X,ULAB,XREF,UREF,N,IWRITE,ENOUT,
13672     1              IBUGA3,ISUBRO,IERROR)
13673C
13674C     PURPOSE--THIS SUBROUTINE COMPUTES THE EN STATISTIC:
13675C
13676C                 EN(i) = (x(i) - XREF)/SQRT(U(lab)**2 + U(ref)**2)
13677C
13678C              WHERE
13679C
13680C                   XREF    = THE ASSIGNED VALUE (DETERMINED FROM A
13681C                             REFERENCE LABORATORY)
13682C                   U(ref)  = THE EXPANDED UNCERTAINTY FOR THE ASSIGNED
13683C                             VALUE
13684C                   U(lab)  = THE EXPANDED UNCERTAINTY FOR THE LAB
13685C
13686C              NOTE THAT SINCE THE LAB UNCERTAINTY CAN VARY DEPENDING
13687C              ON THE LAB, THIS IS INPUT AS A VECTOR RATHER THAN A
13688C              PARAMETER.  XREF AND UREF ARE INPUT AS PARAMETERS SINCE
13689C              THEY ARE FIXED FOR ALL LABS.  ULAB EFFECTIVELY ACTS AS
13690C              AS A PROXY FOR LAB-ID, SO NO NEED TO INPUT THIS AS A
13691C              SEPARATE VALUE.
13692C
13693C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
13694C                                (UNSORTED OR SORTED) OBSERVATIONS.
13695C                     --ULAB   = THE SINGLE PRECISION VECTOR OF
13696C                                LAB EXPANDED UNCERTAINTIES
13697C                     --XREF   = THE SINGLE PRECISION VALUE CONTAINING
13698C                                THE ASSIGNED VALUE
13699C                     --UREF   = THE SINGLE PRECISION VALUE CONTAINING
13700C                                THE EXPANDED UNCERTAINTY FOR THE
13701C                                ASSIGNED VALUE
13702C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
13703C                                IN THE VECTOR X.
13704C     OUTPUT ARGUMENTS--ENOUT  = THE SINGLE PRECISION VECTOR OF THE
13705C                                COMPUTED EN VALUES.
13706C     OUTPUT--THE COMPUTED SINGLE PRECISION VECTOR OF THE SAMPLE EN
13707C             VALUES.
13708C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
13709C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
13710C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
13711C     LANGUAGE--ANSI FORTRAN (1977)
13712C     REFERENCE--ISO 13528, FIRST EDITION, STATISTICAL METHODS FOR USE
13713C                IN PROFICIENCY TESTING BY INTERLABORATORY COMPARISONS,
13714C                2005, PP. 27-28.
13715C     WRITTEN BY--ALAN HECKERT
13716C                 STATISTICAL ENGINEERING DIVISION
13717C                 INFORMATION TECHNOLOGY LABORATORY
13718C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13719C                 GAITHERSBURG, MD 20899-8980
13720C                 PHONE--301-975-2899
13721C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13722C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13723C     LANGUAGE--ANSI FORTRAN (1977)
13724C     VERSION NUMBER--2012.1
13725C     ORIGINAL VERSION--JANUARY   2012.
13726C
13727C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
13728C
13729      CHARACTER*4 IWRITE
13730      CHARACTER*4 IBUGA3
13731      CHARACTER*4 ISUBRO
13732      CHARACTER*4 IERROR
13733C
13734      CHARACTER*4 ISUBN1
13735      CHARACTER*4 ISUBN2
13736C
13737C---------------------------------------------------------------------
13738C
13739      DIMENSION X(*)
13740      DIMENSION ULAB(*)
13741      DIMENSION ENOUT(*)
13742C
13743C-----COMMON----------------------------------------------------------
13744C
13745      INCLUDE 'DPCOP2.INC'
13746C
13747C-----START POINT-----------------------------------------------------
13748C
13749      ISUBN1='EN  '
13750      ISUBN2='    '
13751      IERROR='NO'
13752C
13753      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'EN  ')THEN
13754        WRITE(ICOUT,999)
13755  999   FORMAT(1X)
13756        CALL DPWRST('XXX','BUG ')
13757        WRITE(ICOUT,51)
13758   51   FORMAT('***** AT THE BEGINNING OF EN--')
13759        CALL DPWRST('XXX','BUG ')
13760        WRITE(ICOUT,52)IBUGA3,N,XREF,UREF
13761   52   FORMAT('IBUGA3,N = ',A4,2X,I8,2G15.7)
13762        CALL DPWRST('XXX','BUG ')
13763        DO55I=1,N
13764          WRITE(ICOUT,56)I,X(I),ULAB(I)
13765   56     FORMAT('I,X(I),ULAB(I) = ',I8,2G15.7)
13766          CALL DPWRST('XXX','BUG ')
13767   55   CONTINUE
13768      ENDIF
13769C
13770C               ********************
13771C               **  COMPUTE EN    **
13772C               ********************
13773C
13774C               ********************************************
13775C               **  STEP 1--                              **
13776C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
13777C               ********************************************
13778C
13779      AN=N
13780C
13781      IF(N.LT.1)THEN
13782        WRITE(ICOUT,999)
13783        CALL DPWRST('XXX','BUG ')
13784        WRITE(ICOUT,111)
13785  111   FORMAT('***** ERROR IN EN--')
13786        CALL DPWRST('XXX','BUG ')
13787        WRITE(ICOUT,112)
13788  112   FORMAT('      THE NUMBER OF OBSERVATIONS IN THE VARIABLE FOR')
13789        CALL DPWRST('XXX','BUG ')
13790        WRITE(ICOUT,114)
13791  114   FORMAT('      WHICH THE MEAN IS TO BE COMPUTED MUST BE AT ',
13792     1         'LEAST 1.')
13793        CALL DPWRST('XXX','BUG ')
13794        WRITE(ICOUT,117)N
13795  117   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,'.')
13796        CALL DPWRST('XXX','BUG ')
13797        IERROR='YES'
13798        GOTO9000
13799      ENDIF
13800C
13801      IF(UREF.LT.0.0)THEN
13802        WRITE(ICOUT,999)
13803        CALL DPWRST('XXX','BUG ')
13804        WRITE(ICOUT,111)
13805        CALL DPWRST('XXX','BUG ')
13806        WRITE(ICOUT,122)
13807  122   FORMAT('      THE REFERENCE EXPANDED UNCERTAINTY IS NEGATIVE.')
13808        CALL DPWRST('XXX','BUG ')
13809        WRITE(ICOUT,127)UREF
13810  127   FORMAT('      THE REFERENCE EXPANDED UNCERTAINTY = ',G15.7)
13811        CALL DPWRST('XXX','BUG ')
13812        IERROR='YES'
13813        GOTO9000
13814      ENDIF
13815C
13816C               *************************
13817C               **  STEP 2--           **
13818C               **  COMPUTE THE EN     **
13819C               *************************
13820C
13821      DO200I=1,N
13822        UTEMP1=ULAB(I)
13823        UTEMP2=UTEMP1**2 + UREF**2
13824C
13825        IF(UTEMP1.LT.0.0 .OR. UTEMP2.LE.0.0)THEN
13826          WRITE(ICOUT,999)
13827          CALL DPWRST('XXX','BUG ')
13828          WRITE(ICOUT,111)
13829          CALL DPWRST('XXX','BUG ')
13830          WRITE(ICOUT,222)
13831  222     FORMAT('      EITHER THE LAB EXPANDED UNCERTAINTY IS ',
13832     1           'NEGATIVE OR')
13833          CALL DPWRST('XXX','BUG ')
13834          WRITE(ICOUT,224)
13835  224     FORMAT('      BOTH THE LAB EXPANDED UNCERTAINTY AND THE ',
13836     1           'EXPANDED')
13837          CALL DPWRST('XXX','BUG ')
13838          WRITE(ICOUT,226)
13839  226     FORMAT('      REFERENCE UNCERTAINTY ARE ZERO.')
13840          CALL DPWRST('XXX','BUG ')
13841          WRITE(ICOUT,127)UREF
13842          CALL DPWRST('XXX','BUG ')
13843          WRITE(ICOUT,227)ULAB(I)
13844  227     FORMAT('      THE LAB EXPANDED UNCERTAINTY = ',G15.7)
13845          CALL DPWRST('XXX','BUG ')
13846          IERROR='YES'
13847          GOTO9000
13848        ENDIF
13849C
13850        ENOUT(I)=(X(I) - XREF)/SQRT(UTEMP1**2 + UREF**2)
13851  200 CONTINUE
13852C
13853C               *******************************
13854C               **  STEP 3--                 **
13855C               **  WRITE OUT A LINE         **
13856C               **  OF SUMMARY INFORMATION.  **
13857C               *******************************
13858C
13859      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
13860        WRITE(ICOUT,999)
13861        CALL DPWRST('XXX','BUG ')
13862        WRITE(ICOUT,811)N
13863  811   FORMAT('THE NUMBER OF EN VALUES GENERATED = ',I8)
13864        CALL DPWRST('XXX','BUG ')
13865      ENDIF
13866C
13867C               *****************
13868C               **  STEP 90--  **
13869C               **  EXIT.      **
13870C               *****************
13871C
13872 9000 CONTINUE
13873      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'EN  ')THEN
13874        WRITE(ICOUT,999)
13875        CALL DPWRST('XXX','BUG ')
13876        WRITE(ICOUT,9011)
13877 9011   FORMAT('***** AT THE END OF EN--')
13878        CALL DPWRST('XXX','BUG ')
13879        DO9012I=1,N
13880          WRITE(ICOUT,9015)I,X(I),ULAB(I),ENOUT(I)
13881 9015     FORMAT('I,X(I),ULAB(I),ENOUT(I) = ',I8,3G15.7)
13882          CALL DPWRST('XXX','BUG ')
13883 9012   CONTINUE
13884      ENDIF
13885C
13886      RETURN
13887      END
13888      DOUBLE PRECISION FUNCTION ENVJ(N,X)
13889      DOUBLE PRECISION X
13890      ENVJ=0.5D0*DLOG10(6.28D0*N)-N*DLOG10(1.36D0*X/N)
13891      RETURN
13892      END
13893      DOUBLE PRECISION FUNCTION EPLFUN (DB)
13894C
13895C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE ESTIMATE OF B
13896C              FOR THE EXPONENTIAL LAW (NUMBER OF FAILURES CASE).
13897C              THIS FUNCTION FINDS THE ROOT OF THE EQUATION:
13898C
13899C                 SUM[i=1 to n][X(i)] + N/Bhat -
13900C                 N*X(n)/(1 - EXP(-BHAT*X(n)) = 0
13901C
13902C              WITH
13903C
13904C                 N        = NUMBER OF FAILURE TIMES
13905C                 Bhat     = POINT ESTIMATE OF B
13906C                 X        = VECTOR OF FAILURE TIMES
13907C
13908C              NOTE THAT THE SUM[X(I)] AND X(N) ARE COMPUTED IN
13909C              DPMLEL AND PASSED VIA COMMON BLOCK.
13910C
13911C              CALLED BY DFZERO ROUTINE FOR FINDING THE ROOT OF A
13912C              FUNCTION.
13913C     EXAMPLE--EXPONENTIAL LAW MAXIMUM LIKELIHOOD Y CENSOR
13914C     REFERENCE--TOBIAS AND TRINDADE, "APPLIED RELIABILITY", SECOND
13915C                EDITION, PP. 363-365.
13916C     WRITTEN BY--JAMES J. FILLIBEN
13917C                 STATISTICAL ENGINEERING DIVISION
13918C                 INFORMATION TECHNOLOGY LABORATORY
13919C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13920C                 GAITHERSBUG, MD 20899-8980
13921C                 PHONE--301-975-2855
13922C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13923C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13924C     LANGUAGE--ANSI FORTRAN (1977)
13925C     VERSION NUMBER--2007/2
13926C     ORIGINAL VERSION--FEBRUARY   2007.
13927C
13928C---------------------------------------------------------------------
13929C
13930      DOUBLE PRECISION DB
13931C
13932      DOUBLE PRECISION DN
13933      DOUBLE PRECISION DTEND
13934      DOUBLE PRECISION DXSUM
13935      DOUBLE PRECISION DXN
13936      COMMON/EPLCOM/DXSUM,DXN,DTEND,DN
13937C
13938C-----COMMON----------------------------------------------------------
13939C
13940      INCLUDE 'DPCOP2.INC'
13941C
13942C-----START POINT-----------------------------------------------------
13943C
13944C  COMPUTE SOME SUMS
13945C
13946      EPLFUN=DXSUM + (DN/DB) - DN*DXN/(1.0D0 - DEXP(-DB*DXN))
13947C
13948      RETURN
13949      END
13950      DOUBLE PRECISION FUNCTION EPLFU2 (DB)
13951C
13952C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE ESTIMATE OF B
13953C              FOR THE EXPONENTIAL LAW (TIME CENSORED CASE).
13954C              THIS FUNCTION FINDS THE ROOT OF THE EQUATION:
13955C
13956C                 SUM[i=1 to n][X(i)] + N/Bhat -
13957C                 N*T/(1 - EXP(-BHAT*T)) = 0
13958C
13959C              WITH
13960C
13961C                 N        = NUMBER OF FAILURE TIMES
13962C                 Bhat     = POINT ESTIMATE OF B
13963C                 X        = VECTOR OF FAILURE TIMES
13964C                 T        = CENSORING TIME
13965C
13966C              NOTE THAT THE SUM[X(I)] AND T ARE COMPUTED IN
13967C              DPMLEL AND PASSED VIA COMMON BLOCK.
13968C
13969C              CALLED BY DFZERO ROUTINE FOR FINDING THE ROOT OF A
13970C              FUNCTION.
13971C     EXAMPLE--EXPONENTIAL LAW MAXIMUM LIKELIHOOD Y CENSOR
13972C     REFERENCE--TOBIAS AND TRINDADE, "APPLIED RELIABILITY", SECOND
13973C                EDITION, PP. 363-365.
13974C     WRITTEN BY--JAMES J. FILLIBEN
13975C                 STATISTICAL ENGINEERING DIVISION
13976C                 INFORMATION TECHNOLOGY LABORATORY
13977C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13978C                 GAITHERSBUG, MD 20899-8980
13979C                 PHONE--301-975-2855
13980C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13981C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13982C     LANGUAGE--ANSI FORTRAN (1977)
13983C     VERSION NUMBER--2007/2
13984C     ORIGINAL VERSION--FEBRUARY   2007.
13985C
13986C---------------------------------------------------------------------
13987C
13988      DOUBLE PRECISION DB
13989C
13990      DOUBLE PRECISION DN
13991      DOUBLE PRECISION DTEND
13992      DOUBLE PRECISION DXSUM
13993      DOUBLE PRECISION DXN
13994      COMMON/EPLCOM/DXSUM,DXN,DTEND,DN
13995C
13996C-----COMMON----------------------------------------------------------
13997C
13998      INCLUDE 'DPCOP2.INC'
13999C
14000C-----START POINT-----------------------------------------------------
14001C
14002C  COMPUTE SOME SUMS
14003C
14004      EPLFU2=DXSUM + (DN/DB) - DN*DTEND/(1.0D0 - DEXP(-DB*DTEND))
14005C
14006      RETURN
14007      END
14008      SUBROUTINE EUCDIS(AMAT,AMAT2,MAXROM,MAXCOM,NR1,NC1,
14009     1                  ICASE,ICASE2,P,IWRITE,
14010     1                  TEMP1,TEMP2,
14011     1                  IBUGA3,ISUBRO,IERROR)
14012C
14013C     PURPOSE--THIS SUBROUTINE COMPUTES THE EUCLIDEAN DISTANCE OF A
14014C              MATRIX.  THE FORMULA IS:
14015C
14016C                 D(ij)=SQRT{SUM[k=1 to p][(X(ik) - X(jk))**2)}
14017C
14018C              ALTERNATIVELY (BASED ON ICASE2), THE FOLLOWING DISTANCE
14019C              MATRICES CAN BE COMPUTED:
14020C
14021C              MINKOWSKY DISTANCE:
14022C
14023C                 D(ij)=SUM[k=1 to p][(ABS|(X(ik) - X(jk))|**P)**(1/P)]
14024C
14025C              BLOCK (OR MANHATTAN) DISTANCE:
14026C
14027C                 D(ij)=SUM[k=1 to p][|X(ik) - X(jk)|]
14028C
14029C              CANBERRA DISTANCE:
14030C
14031C                 D(ij)=SUM[k=1 to p][|X(ik) - X(jk)|/
14032C                       (|X(i)| + |Y(i)|)]
14033C
14034C              CHEBYCHEV DISTANCE:
14035C
14036C                 D(ij)=MAX[k=1 to p][|X(ik) - X(jk)|]
14037C
14038C              COSINE SIMILARITY:
14039C
14040C                 S(ij) = SUM[k=1 to p][X(ik)*Y(ik)]/
14041C                         {SQRT(SUM[k=1 to p][X(ik)**2])*
14042C                          SQRT(SUM[k=1 to p][X(ik)**2])}
14043C
14044C             COSINE DISTANCE:
14045C
14046C                D(ij) = 1 - COSINE SIMILARITY(ij)
14047C
14048C             ANGULAR COSINE DISTANCE:
14049C
14050C                D(ij) = 1 - COSINE SIMILARITY(ij)
14051C
14052C             JACCARD SIMILARITY:
14053C
14054C                J(ij) = SUM[k=1 to n][MIN(X(ik),Y(ik))/
14055C                        SUM[k=1 to n][MAX(X(ik),Y(ik))]
14056C
14057C             JACCARD DISTANCE:
14058C
14059C                D(ij) = 1 - JACCARD SIMILARITY(ij)
14060C
14061C             HAMMING DISTANCE:
14062C
14063C                D(ij) = NUMBER OF ELEMENTS THAT DIFFER IN X AND Y
14064C
14065C             PEARSON DISTANCE:
14066C
14067C                D(ij) = (1 - R(I,J))/2  (R = CORRELATION COEFFICIENT)
14068C
14069C             PEARSON SIMILARITY:
14070C
14071C                S(ij) = 1 - PEARSON DISTANCE
14072C
14073C     INPUT  ARGUMENTS--AMAT   = THE SINGLE PRECISION MATRIX
14074C                     --MAXROM = THE INTEGER ROW DIMENSION OF AMAT
14075C                     --MAXCOM = THE INTEGER COUMN DIMENSION OF AMAT
14076C                     --NR1    = THE INTEGER NUMBER OF ROWS OF AMAT
14077C                     --NC1    = THE INTEGER NUMBER OF COLUMNS OF AMAT
14078C     OUTPUT ARGUMENTS--AMAT2    = THE SINGLE PRECISION VALUE OF THE
14079C                                COMPUTED SAMPLE EUCLIDEAN DISTANCES.
14080C     OUTPUT--MATRIX OF EUCLIDEAN DISTANCES
14081C     NOTE--THIS ROUTINE ASSUMES THE ERROR CHECKING (FOR EQUAL
14082C           ROWS AND COLUMNS, MATCHING DIMENSIONS FOR X AND AMAT)
14083C           IS DONE BT THE CALLING SUBROUTINE.
14084C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
14085C     LANGUAGE--ANSI FORTRAN (1977)
14086C     WRITTEN BY--ALAN HECKERT
14087C                 STATISTICAL ENGINEERING DIVISION
14088C                 INFORMATION TECHNOLOGY LABORATORY
14089C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14090C                 GAITHERSBURG, MD 20899
14091C                 PHONE--301-975-2855
14092C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14093C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14094C     LANGUAGE--ANSI FORTRAN (1977)
14095C     VERSION NUMBER--98.6
14096C     ORIGINAL VERSION--JUNE      1998.
14097C     UPDATED         --AUGUST    2018. INCORPORATE ADDITIONAL DISTANCE
14098C                                       METRICS (ICASE2)
14099C
14100C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
14101C
14102      CHARACTER*4 ICASE
14103      CHARACTER*4 ICASE2
14104      CHARACTER*4 IWRITE
14105      CHARACTER*4 IBUGA3
14106      CHARACTER*4 ISUBRO
14107      CHARACTER*4 IERROR
14108C
14109      CHARACTER*4 ISUBN1
14110      CHARACTER*4 ISUBN2
14111C
14112C---------------------------------------------------------------------
14113C
14114      DOUBLE PRECISION DSUM
14115      DOUBLE PRECISION DSUM2
14116      DOUBLE PRECISION DSUM3
14117      DOUBLE PRECISION DYM1
14118      DOUBLE PRECISION DYM2
14119C
14120      DIMENSION AMAT(MAXROM,MAXCOM)
14121      DIMENSION AMAT2(MAXROM,MAXCOM)
14122      DIMENSION TEMP1(*)
14123      DIMENSION TEMP2(*)
14124C
14125C-----COMMON----------------------------------------------------------
14126C
14127      INCLUDE 'DPCOP2.INC'
14128C
14129      DATA PI/3.1415926535898E0/
14130C
14131C-----START POINT-----------------------------------------------------
14132C
14133      ISUBN1='EUCD'
14134      ISUBN2='IS  '
14135      IERROR='NO'
14136C
14137      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'CDIS')THEN
14138        WRITE(ICOUT,999)
14139  999   FORMAT(1X)
14140        CALL DPWRST('XXX','BUG ')
14141        WRITE(ICOUT,51)
14142   51   FORMAT('***** AT THE BEGINNING OF EUCDIS--')
14143        CALL DPWRST('XXX','BUG ')
14144        WRITE(ICOUT,52)IBUGA3,ICASE,ICASE2,NR1,NC1
14145   52   FORMAT('IBUGA3,ICASE,ICASE2,NR1,NC1 = ',3(A4,2X),2I8)
14146        CALL DPWRST('XXX','BUG ')
14147      ENDIF
14148C
14149C               ********************************
14150C               **  COMPUTE DISTANCE           *
14151C               ********************************
14152C
14153      IF(ICASE.EQ.'ROW ')THEN
14154        DO5860I=1,NR1
14155          DO5861J=1,I
14156            DSUM=0.0D0
14157            DSUM2=0.0D0
14158            DSUM3=0.0D0
14159            IF(ICASE2.EQ.'EUCL')THEN
14160              IF(I.EQ.J)THEN
14161                AMAT2(I,J)=0.0
14162              ELSE
14163                DO5862K=1,NC1
14164                  DYM1=AMAT(I,K)
14165                  DYM2=AMAT(J,K)
14166                  DSUM=DSUM+(DYM1-DYM2)**2
14167 5862           CONTINUE
14168                AMAT2(I,J)=REAL(DSQRT(DSUM))
14169              ENDIF
14170            ELSEIF(ICASE2.EQ.'MINK')THEN
14171              IF(I.EQ.J)THEN
14172                AMAT2(I,J)=0.0
14173              ELSE
14174                DO5863K=1,NC1
14175                  DYM1=AMAT(I,K)
14176                  DYM2=AMAT(J,K)
14177                  DSUM=DSUM + DABS(DYM1-DYM2)**DBLE(P)
14178 5863           CONTINUE
14179                AMAT2(I,J)=REAL(DSUM**(1.0D0/DBLE(P)))
14180              ENDIF
14181            ELSEIF(ICASE2.EQ.'BLOC')THEN
14182              IF(I.EQ.J)THEN
14183                AMAT2(I,J)=0.0
14184              ELSE
14185                DO5864K=1,NC1
14186                  DYM1=AMAT(I,K)
14187                  DYM2=AMAT(J,K)
14188                  DSUM=DSUM+DABS(DYM1-DYM2)
14189 5864           CONTINUE
14190                AMAT2(I,J)=REAL(DSUM)
14191              ENDIF
14192            ELSEIF(ICASE2.EQ.'HAMM')THEN
14193              IF(I.EQ.J)THEN
14194                AMAT2(I,J)=0.0
14195              ELSE
14196                DO55869K=1,NC1
14197                  DYM1=AMAT(I,K)
14198                  DYM2=AMAT(J,K)
14199                  IF(DYM1.NE.DYM2)DSUM=DSUM+1.0D0
1420055869           CONTINUE
14201                AMAT2(I,J)=REAL(DSUM)
14202              ENDIF
14203            ELSEIF(ICASE2.EQ.'CHEB')THEN
14204              IF(I.EQ.J)THEN
14205                AMAT2(I,J)=0.0
14206              ELSE
14207                DSUM2=0.0D0
14208                DO5865K=1,NC1
14209                  DYM1=AMAT(I,K)
14210                  DYM2=AMAT(J,K)
14211                  DSUM=DSUM+DABS(DYM1-DYM2)
14212 5865           CONTINUE
14213                AMAT2(I,J)=REAL(DSUM)
14214              ENDIF
14215            ELSEIF(ICASE2.EQ.'COSS' .OR. ICASE2.EQ.'COSD' .OR.
14216     1             ICASE2.EQ.'ACSS' .OR. ICASE2.EQ.'ACSD')THEN
14217              IF(I.EQ.J)THEN
14218                IF(ICASE2.EQ.'COSD' .OR. ICASE2.EQ.'ACSD')THEN
14219                  AMAT2(I,J)=0.0
14220                ELSE
14221                  AMAT2(I,J)=1.0
14222                ENDIF
14223              ELSE
14224                IFLAG=1
14225                DO5866K=1,NC1
14226                  IF(ICASE2.EQ.'COSD')THEN
14227                    IF(AMAT(I,K).LT.0.0 .OR. AMAT(J,K).LT.0.0)THEN
14228                      WRITE(ICOUT,999)
14229                      CALL DPWRST('XXX','BUG ')
14230                      WRITE(ICOUT,8001)
14231 8001                 FORMAT('****** ERROR IN MATRIX DISTANCE--')
14232                      CALL DPWRST('XXX','BUG ')
14233                      WRITE(ICOUT,8003)
14234 8003                 FORMAT('       COSINE DISTANCE NOT SUPPORTED ',
14235     1                       'NEGATIVE VALUES.')
14236                      CALL DPWRST('XXX','BUG ')
14237                      WRITE(ICOUT,8005)I,K,AMAT(I,K)
14238 8005                 FORMAT('        ROW ',I6,' COLUMN ',I6,' HAS ',
14239     1                       'THE VALUE ',E15.7)
14240                      CALL DPWRST('XXX','BUG ')
14241                      WRITE(ICOUT,8005)J,K,AMAT(J,K)
14242                      CALL DPWRST('XXX','BUG ')
14243                      IERROR='YES'
14244                      GOTO9000
14245                    ENDIF
14246                  ENDIF
14247                  DYM1=AMAT(I,K)
14248                  DYM2=AMAT(J,K)
14249                  DTEMP=DYM1*DYM2
14250                  DSUM=DSUM + DTEMP
14251                  DTEMP=DYM1*DYM1
14252                  DSUM2=DSUM2 + DTEMP
14253                  DTEMP=DYM2*DYM2
14254                  DSUM3=DSUM3 + DTEMP
14255 5866           CONTINUE
14256C
14257                IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'CDIS')THEN
14258                  WRITE(ICOUT,15861)I,J,DSUM,DSUM2,DSUM3
1425915861             FORMAT('I,J,DSUM,DSUM2,DSUM3 = ',2I6,3G15.7)
14260                  CALL DPWRST('XXX','BUG ')
14261                ENDIF
14262C
14263                IF(DSUM2.GT.0.0D0 .AND. DSUM3.GT.0.0D0)THEN
14264                  DTEMP=DSUM/(DSQRT(DSUM2)*DSQRT(DSUM3))
14265                  AMAT2(I,J)=REAL(DTEMP)
14266                  IF(ICASE2.EQ.'COSD')THEN
14267                    AMAT2(I,J)=1.0 - AMAT2(I,J)
14268                  ELSEIF(ICASE2.EQ.'ACSD')THEN
14269                    AFACT=1.0
14270                    IF(IFLAG.EQ.1)AFACT=2.0
14271                    AMAT2(I,J)=AFACT*ACOS(AMAT2(I,J))/PI
14272                  ELSEIF(ICASE2.EQ.'ACSS')THEN
14273                    AFACT=1.0
14274                    IF(IFLAG.EQ.1)AFACT=2.0
14275                    AMAT2(I,J)=1.0 - AFACT*ACOS(AMAT2(I,J))/PI
14276                  ENDIF
14277                ELSE
14278                  AMAT2(I,J)=CPUMIN
14279                ENDIF
14280              ENDIF
14281            ELSEIF(ICASE2.EQ.'JACS' .OR. ICASE2.EQ.'JACD')THEN
14282              IF(I.EQ.J)THEN
14283                IF(ICASE2.EQ.'JASD')THEN
14284                  AMAT2(I,J)=0.0
14285                ELSE
14286                  AMAT2(I,J)=1.0
14287                ENDIF
14288              ELSE
14289                DO5867K=1,NC1
14290                  DYM1=AMAT(I,K)
14291                  DYM2=AMAT(J,K)
14292                  DTEMP=MIN(DYM1,DYM2)
14293                  DSUM=DSUM + DTEMP
14294                  DTEMP=MAX(DYM1,DYM2)
14295                  DSUM2=DSUM2 + DTEMP
14296 5867           CONTINUE
14297                AMAT2(I,J)=REAL(DSUM/DSUM2)
14298                IF(ICASE2.EQ.'JACD')THEN
14299                  AMAT2(I,J)=1.0 - AMAT2(I,J)
14300                ENDIF
14301              ENDIF
14302            ELSEIF(ICASE2.EQ.'PDIS' .OR. ICASE2.EQ.'PSIM')THEN
14303              IF(I.EQ.J)THEN
14304                AMAT2(I,J)=0.0
14305                IF(ICASE2.EQ.'PSIM')AMAT2(I,J)=1.0
14306              ELSE
14307                DO5868K=1,NC1
14308                  TEMP1(K)=AMAT(I,K)
14309                  TEMP2(K)=AMAT(J,K)
14310 5868           CONTINUE
14311                CALL CORR(TEMP1,TEMP2,NC1,IWRITE,ACORR,IBUGA3,IERROR)
14312                AMAT2(I,J)=(1.0 - ACORR)/2.0
14313                IF(ICASE2.EQ.'PSIM')AMAT2(I,J)=1.0 - AMAT2(I,J)
14314              ENDIF
14315            ELSEIF(ICASE2.EQ.'CANB')THEN
14316              IF(I.EQ.J)THEN
14317                AMAT2(I,J)=0.0
14318              ELSE
14319                DO5869K=1,NC1
14320                  DYM1=AMAT(I,K)
14321                  DYM2=AMAT(J,K)
14322                  DSUM=DSUM+DABS(DYM1-DYM2)/
14323     1                 (DABS(DYM1)+DABS(DYM2))
14324 5869           CONTINUE
14325                AMAT2(I,J)=REAL(DSUM)
14326              ENDIF
14327            ENDIF
14328            AMAT2(J,I)=AMAT2(I,J)
14329 5861     CONTINUE
14330 5860   CONTINUE
14331      ELSEIF(ICASE.EQ.'COLU')THEN
14332        DO5960I=1,NC1
14333          DO5961J=1,I
14334            DSUM=0.0D0
14335            DSUM2=0.0D0
14336            DSUM3=0.0D0
14337            IF(ICASE2.EQ.'EUCL')THEN
14338              IF(I.EQ.J)THEN
14339                AMAT2(I,J)=0.0
14340              ELSE
14341                DO5962K=1,NR1
14342                  DYM1=AMAT(K,I)
14343                  DYM2=AMAT(K,J)
14344                  DSUM=DSUM+(DYM1-DYM2)**2
14345 5962           CONTINUE
14346                AMAT2(I,J)=REAL(DSQRT(DSUM))
14347              ENDIF
14348            ELSEIF(ICASE2.EQ.'MINK')THEN
14349              IF(I.EQ.J)THEN
14350                AMAT2(I,J)=0.0
14351              ELSE
14352                DO5963K=1,NR1
14353                  DYM1=AMAT(K,I)
14354                  DYM2=AMAT(K,J)
14355                  DSUM=DSUM + DABS(DYM1-DYM2)**DBLE(P)
14356 5963           CONTINUE
14357                AMAT2(I,J)=REAL(DSUM**(1.0D0/DBLE(P)))
14358              ENDIF
14359            ELSEIF(ICASE2.EQ.'BLOC')THEN
14360              IF(I.EQ.J)THEN
14361                AMAT2(I,J)=0.0
14362              ELSE
14363                DO5964K=1,NR1
14364                  DYM1=AMAT(K,I)
14365                  DYM2=AMAT(K,J)
14366                  DSUM=DSUM+DABS(DYM1-DYM2)
14367 5964           CONTINUE
14368                AMAT2(I,J)=REAL(DSUM)
14369              ENDIF
14370            ELSEIF(ICASE2.EQ.'HAMM')THEN
14371              IF(I.EQ.J)THEN
14372                AMAT2(I,J)=0.0
14373              ELSE
14374                DO55969K=1,NR1
14375                  DYM1=AMAT(K,I)
14376                  DYM2=AMAT(K,J)
14377                  IF(DYM1.NE.DYM2)DSUM=DSUM+1.0D0
1437855969           CONTINUE
14379                AMAT2(I,J)=REAL(DSUM)
14380              ENDIF
14381            ELSEIF(ICASE2.EQ.'CHEB')THEN
14382              IF(I.EQ.J)THEN
14383                AMAT2(I,J)=0.0
14384              ELSE
14385                DO5965K=1,NR1
14386                  DYM1=AMAT(K,I)
14387                  DYM2=AMAT(K,J)
14388                  DTEMP=DABS(DYM1-DYM2)
14389                  IF(DTEMP.GT.DSUM)DSUM=DTEMP
14390 5965           CONTINUE
14391                AMAT2(I,J)=REAL(DSUM)
14392              ENDIF
14393            ELSEIF(ICASE2.EQ.'COSS' .OR. ICASE2.EQ.'COSD' .OR.
14394     1             ICASE2.EQ.'ACSS' .OR. ICASE2.EQ.'ACSD')THEN
14395              IF(I.EQ.J)THEN
14396                IF(ICASE2.EQ.'COSD' .OR. ICASE2.EQ.'ACSD')THEN
14397                  AMAT2(I,J)=0.0
14398                ELSE
14399                  AMAT2(I,J)=1.0
14400                ENDIF
14401              ELSE
14402                IFLAG=1
14403                DO5966K=1,NR1
14404                  IF(ICASE2.EQ.'COSD')THEN
14405                    IF(AMAT(K,I).LT.0.0 .OR. AMAT(K,J).LT.0.0)THEN
14406                      WRITE(ICOUT,999)
14407                      CALL DPWRST('XXX','BUG ')
14408                      WRITE(ICOUT,8001)
14409                      CALL DPWRST('XXX','BUG ')
14410                      WRITE(ICOUT,8003)
14411                      CALL DPWRST('XXX','BUG ')
14412                      WRITE(ICOUT,8005)K,I,AMAT(K,I)
14413                      CALL DPWRST('XXX','BUG ')
14414                      WRITE(ICOUT,8005)K,J,AMAT(K,J)
14415                      CALL DPWRST('XXX','BUG ')
14416                      IERROR='YES'
14417                      GOTO9000
14418                    ENDIF
14419                  ENDIF
14420                  IF(AMAT(K,I).LT.0.0)IFLAG=0
14421                  IF(AMAT(K,J).LT.0.0)IFLAG=0
14422                  DYM1=AMAT(K,I)
14423                  DYM2=AMAT(K,J)
14424                  DTEMP=DYM1*DYM2
14425                  DSUM=DSUM + DTEMP
14426                  DTEMP=DYM1*DYM1
14427                  DSUM2=DSUM2 + DTEMP
14428                  DTEMP=DYM2*DYM2
14429                  DSUM3=DSUM3 + DTEMP
14430 5966           CONTINUE
14431C
14432                IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'CDIS')THEN
14433                  WRITE(ICOUT,15861)I,J,DSUM,DSUM2,DSUM3
14434                  CALL DPWRST('XXX','BUG ')
14435                ENDIF
14436C
14437                IF(DSUM2.GT.0.0D0 .AND. DSUM3.GT.0.0D0)THEN
14438                  DTEMP=DSUM/(SQRT(DSUM2)*SQRT(DSUM3))
14439                  AMAT2(I,J)=REAL(DTEMP)
14440                  IF(ICASE2.EQ.'COSD')THEN
14441                    AMAT2(I,J)=1.0 - AMAT2(I,J)
14442                  ELSEIF(ICASE2.EQ.'ACSD')THEN
14443                    AFACT=1.0
14444                    IF(IFLAG.EQ.1)AFACT=2.0
14445                    AMAT2(I,J)=AFACT*ACOS(AMAT2(I,J))/PI
14446                  ELSEIF(ICASE2.EQ.'ACSS')THEN
14447                    AFACT=1.0
14448                    IF(IFLAG.EQ.1)AFACT=2.0
14449                    AMAT2(I,J)=1.0 - AFACT*ACOS(AMAT2(I,J))/PI
14450                  ENDIF
14451                ELSE
14452                  AMAT2(I,J)=CPUMIN
14453                ENDIF
14454              ENDIF
14455            ELSEIF(ICASE2.EQ.'JACS' .OR. ICASE2.EQ.'JACD')THEN
14456              IF(I.EQ.J)THEN
14457                IF(ICASE2.EQ.'JACD')THEN
14458                  AMAT2(I,J)=0.0
14459                ELSE
14460                  AMAT2(I,J)=1.0
14461                ENDIF
14462              ELSE
14463                DO5967K=1,NR1
14464                  DYM1=AMAT(K,I)
14465                  DYM2=AMAT(K,J)
14466                  DTEMP=MIN(DYM1,DYM2)
14467                  DSUM=DSUM + DTEMP
14468                  DTEMP=MAX(DYM1,DYM2)
14469                  DSUM2=DSUM2 + DTEMP
14470 5967           CONTINUE
14471                AMAT2(I,J)=REAL(DSUM/DSUM2)
14472                IF(ICASE2.EQ.'JACD')THEN
14473                  AMAT2(I,J)=1.0 - AMAT2(I,J)
14474                ENDIF
14475              ENDIF
14476            ELSEIF(ICASE2.EQ.'PDIS' .OR. ICASE2.EQ.'PSIM')THEN
14477              IF(I.EQ.J)THEN
14478                AMAT2(I,J)=0.0
14479                IF(ICASE2.EQ.'PSIM')AMAT2(I,J)=1.0
14480              ELSE
14481                DO5968K=1,NR1
14482                  TEMP1(K)=AMAT(K,I)
14483                  TEMP2(K)=AMAT(K,J)
14484 5968           CONTINUE
14485                CALL CORR(TEMP1,TEMP2,NR1,IWRITE,ACORR,IBUGA3,IERROR)
14486                AMAT2(I,J)=(1.0 - ACORR)/2.0
14487                IF(ICASE2.EQ.'PSIM')AMAT2(I,J)=1.0 - AMAT2(I,J)
14488              ENDIF
14489            ELSEIF(ICASE2.EQ.'CANB')THEN
14490              IF(I.EQ.J)THEN
14491                AMAT2(I,J)=0.0
14492              ELSE
14493                DO5969K=1,NR1
14494                  DYM1=AMAT(K,I)
14495                  DYM2=AMAT(K,J)
14496                  DSUM=DSUM+DABS(DYM1-DYM2)/
14497     1                 (DABS(DYM1)+DABS(DYM2))
14498 5969           CONTINUE
14499                AMAT2(I,J)=REAL(DSUM)
14500              ENDIF
14501            ENDIF
14502            AMAT2(J,I)=AMAT2(I,J)
14503 5961     CONTINUE
14504 5960   CONTINUE
14505      ENDIF
14506C
14507C               *******************************
14508C               **  STEP 3--                 **
14509C               **  WRITE OUT A LINE         **
14510C               **  OF SUMMARY INFORMATION.  **
14511C               *******************************
14512C
14513      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
14514        WRITE(ICOUT,999)
14515        CALL DPWRST('XXX','BUG ')
14516        WRITE(ICOUT,811)
14517  811   FORMAT('THE DISTANCE/SIMILARITY MATRIX HAS BEEN CALCULATED.')
14518        CALL DPWRST('XXX','BUG ')
14519      ENDIF
14520C
14521C               *****************
14522C               **  STEP 90--  **
14523C               **  EXIT.      **
14524C               *****************
14525C
14526 9000 CONTINUE
14527      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'CDIS')THEN
14528        WRITE(ICOUT,999)
14529        CALL DPWRST('XXX','BUG ')
14530        WRITE(ICOUT,9011)
14531 9011   FORMAT('***** AT THE END       OF EUCDIS--')
14532        CALL DPWRST('XXX','BUG ')
14533        WRITE(ICOUT,9012)IBUGA3,IERROR
14534 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
14535        CALL DPWRST('XXX','BUG ')
14536        DO9020IROW=1,NR1
14537          DO9030ICOL=1,NC1
14538            WRITE(ICOUT,9022)IROW,ICOL,AMAT2(IROW,ICOL)
14539 9022       FORMAT('IROW,ICOL,AMAT2(IROW,ICOL) = ',2I6,G15.7)
14540            CALL DPWRST('XXX','BUG ')
14541 9030     CONTINUE
14542 9020   CONTINUE
14543      ENDIF
14544C
14545      RETURN
14546      END
14547      SUBROUTINE EULERB(N,EN)
14548C
14549C       ======================================
14550C       Purpose: Compute Euler number En
14551C       Input :  n --- Serial number
14552C       Output:  EN(n) --- En
14553C       ======================================
14554C
14555        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
14556C
14557      INCLUDE 'DPCOP2.INC'
14558C
14559        DIMENSION EN(0:N)
14560C
14561        HPI=2.0D0/3.141592653589793D0
14562        DO1I=0,N
14563          EN(I)=0.0D0
14564 1      CONTINUE
14565C
14566        EN(0)=1.0D0
14567        EN(2)=-1.0D0
14568        IF(N.LE.3)RETURN
14569        R1=-4.0D0*HPI**3
14570C
14571        IFLAG=0
14572C
14573        DO 20 M=4,N,2
14574           IF(IFLAG.EQ.1)THEN
14575             EN(M)=DBLE(CPUMAX)
14576             GOTO20
14577           ENDIF
14578           R1=-R1*(M-1)*M*HPI*HPI
14579           R2=1.0D0
14580CCCCC      ISGN=1.0D0
14581           ISGN=1
14582           DO 10 K=3,1000,2
14583              ISGN=-ISGN
14584              S=(1.0D0/K)**(M+1)
14585              R2=R2+ISGN*S
14586              IF (S.LT.1.0D-15) GOTO 29
1458710         CONTINUE
1458829         CONTINUE
14589           EN(M)=R1*R2
14590           IF(EN(M).GE.DBLE(CPUMAX))THEN
14591             IFLAG=1
14592             EN(M)=DBLE(CPUMAX)
14593             WRITE(ICOUT,90)M
14594             CALL DPWRST('XXX','BUG ')
1459590           FORMAT('***** EULER NUMBERS: OVERFLOW AT N = ',I8)
14596           ENDIF
1459720      CONTINUE
14598C
14599        RETURN
14600        END
14601      SUBROUTINE EULERP(X,N,EN)
14602C
14603C       ======================================
14604C       Purpose: Compute Euler polynomial of order n for X
14605C       Input :  n --- Order of Euler polynomial
14606C                x --- value at which to compute the polynomial
14607C       Output:  EN--- computed value
14608C       ======================================
14609C
14610      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
14611C
14612      DIMENSION DTEMP(200)
14613C
14614      INCLUDE 'DPCOP2.INC'
14615C
14616      SUM=0.0D0
14617      DO100I=0,N/2
14618        CALL EULERB(2*I,DTEMP)
14619        TERM2=DTEMP(2*I+1)
14620        TERM1=DBINOM(N,2*I)
14621        IF(X-0.5D0.EQ.0.0D0 .AND. N-2*I.EQ.0)THEN
14622          TERM3=1.0D0
14623        ELSE
14624          TERM3=(X-0.5D0)**(N-2*I)
14625        ENDIF
14626        SUM=SUM + TERM1*TERM2*TERM3/DBLE(2**(2*I))
14627  100 CONTINUE
14628      EN=SUM
14629C
14630      RETURN
14631      END
14632      SUBROUTINE EXCHNG (X, M, Y, N, SX, SY)
14633C
14634C        ALGORITHM AS 304.2 APPL.STATIST. (1996), VOL.45, NO.3
14635C
14636C        Exchanges the sample data.  Assumes both X and Y have been
14637C        previously dimensioned to at least max(M, N) elements
14638C
14639C        DATAPLOT NOTE: UTILITY ROUTINE USED BY THE FISHER TWO SAMPLE
14640C                       RANDOMIZATION TEST
14641C
14642      INTEGER M, N
14643      REAL X(*), Y(*), SX, SY
14644C
14645      INTEGER C, K
14646      REAL TEMP
14647C
14648      TEMP = SX
14649      SX = SY
14650      SY = TEMP
14651C
14652      C = MIN(M, N)
14653      DO 10 K = 1, C
14654         TEMP = X(K)
14655         X(K) = Y(K)
14656         Y(K) = TEMP
14657   10 CONTINUE
14658      IF (M .GT. N) THEN
14659         DO 20 K = C+1, M
14660            Y(K) = X(K)
14661   20    CONTINUE
14662         N = M
14663         M = C
14664      ELSE IF (M .LT. N) THEN
14665         DO 30 K = C+1, N
14666            X(K) = Y(K)
14667   30    CONTINUE
14668         M = N
14669         N = C
14670      END IF
14671C
14672      RETURN
14673      END
14674      SUBROUTINE EXINT (X, N, KODE, M, TOL, EN, NZ, IERR)
14675C***BEGIN PROLOGUE  EXINT
14676C***PURPOSE  Compute an M member sequence of exponential integrals
14677C            E(N+K,X), K=0,1,...,M-1 for N .GE. 1 and X .GE. 0.
14678C***LIBRARY   SLATEC
14679C***CATEGORY  C5
14680C***TYPE      SINGLE PRECISION (EXINT-S, DEXINT-D)
14681C***KEYWORDS  EXPONENTIAL INTEGRAL, SPECIAL FUNCTIONS
14682C***AUTHOR  Amos, D. E., (SNLA)
14683C***DESCRIPTION
14684C
14685C         EXINT computes M member sequences of exponential integrals
14686C         E(N+K,X), K=0,1,...,M-1 for N .GE. 1 and X .GE. 0.  The
14687C         exponential integral is defined by
14688C
14689C         E(N,X)=integral on (1,infinity) of EXP(-XT)/T**N
14690C
14691C         where X=0.0 and N=1 cannot occur simultaneously.  Formulas
14692C         and notation are found in the NBS Handbook of Mathematical
14693C         Functions (ref. 1).
14694C
14695C         The power series is implemented for X .LE. XCUT and the
14696C         confluent hypergeometric representation
14697C
14698C                     E(A,X) = EXP(-X)*(X**(A-1))*U(A,A,X)
14699C
14700C         is computed for X .GT. XCUT.  Since sequences are computed in
14701C         a stable fashion by recurring away from X, A is selected as
14702C         the integer closest to X within the constraint N .LE. A .LE.
14703C         N+M-1.  For the U computation, A is further modified to be the
14704C         nearest even integer.  Indices are carried forward or
14705C         backward by the two term recursion relation
14706C
14707C                     K*E(K+1,X) + X*E(K,X) = EXP(-X)
14708C
14709C         once E(A,X) is computed.  The U function is computed by means
14710C         of the backward recursive Miller algorithm applied to the
14711C         three term contiguous relation for U(A+K,A,X), K=0,1,...
14712C         This produces accurate ratios and determines U(A+K,A,X), and
14713C         hence E(A,X), to within a multiplicative constant C.
14714C         Another contiguous relation applied to C*U(A,A,X) and
14715C         C*U(A+1,A,X) gets C*U(A+1,A+1,X), a quantity proportional to
14716C         E(A+1,X).  The normalizing constant C is obtained from the
14717C         two term recursion relation above with K=A.
14718C
14719C     Description of Arguments
14720C
14721C         Input
14722C           X       X .GT. 0.0 for N=1 and  X .GE. 0.0 for N .GE. 2
14723C           N       order of the first member of the sequence, N .GE. 1
14724C                   (X=0.0 and N=1 is an error)
14725C           KODE    a selection parameter for scaled values
14726C                   KODE=1   returns        E(N+K,X), K=0,1,...,M-1.
14727C                       =2   returns EXP(X)*E(N+K,X), K=0,1,...,M-1.
14728C           M       number of exponential integrals in the sequence,
14729C                   M .GE. 1
14730C           TOL     relative accuracy wanted, ETOL .LE. TOL .LE. 0.1
14731C                   ETOL = single precision unit roundoff = R1MACH(4)
14732C
14733C         Output
14734C           EN      a vector of dimension at least M containing values
14735C                   EN(K) = E(N+K-1,X) or EXP(X)*E(N+K-1,X), K=1,M
14736C                   depending on KODE
14737C           NZ      underflow indicator
14738C                   NZ=0   a normal return
14739C                   NZ=M   X exceeds XLIM and an underflow occurs.
14740C                          EN(K)=0.0E0 , K=1,M returned on KODE=1
14741C           IERR    error flag
14742C                   IERR=0, normal return, computation completed
14743C                   IERR=1, input error,   no computation
14744C                   IERR=2, error,         no computation
14745C                           algorithm termination condition not met
14746C
14747C***REFERENCES  M. Abramowitz and I. A. Stegun, Handbook of
14748C                 Mathematical Functions, NBS AMS Series 55, U.S. Dept.
14749C                 of Commerce, 1955.
14750C               D. E. Amos, Computation of exponential integrals, ACM
14751C                 Transactions on Mathematical Software 6, (1980),
14752C                 pp. 365-377 and pp. 420-428.
14753C***ROUTINES CALLED  I1MACH, PSIXN, R1MACH
14754C***REVISION HISTORY  (YYMMDD)
14755C   800501  DATE WRITTEN
14756C   890531  Changed all specific intrinsics to generic.  (WRB)
14757C   890531  REVISION DATE from Version 3.2
14758C   891214  Prologue converted to Version 4.0 format.  (BAB)
14759C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
14760C   900326  Removed duplicate information from DESCRIPTION section.
14761C           (WRB)
14762C   910408  Updated the REFERENCES section.  (WRB)
14763C   920207  Updated with code with a revision date of 880811 from
14764C           D. Amos.  Included correction of argument list.  (WRB)
14765C   920501  Reformatted the REFERENCES section.  (WRB)
14766C***END PROLOGUE  EXINT
14767C
14768C-----COMMON----------------------------------------------------------
14769C
14770      INCLUDE 'DPCOMC.INC'
14771      INCLUDE 'DPCOP2.INC'
14772C
14773      REAL             A,AA,AAMS,AH,AK,AT,B,BK,BT,CC,CNORM,CT,EM,EMX,EN,
14774     1                 ETOL,FNM,FX,PT,P1,P2,S,TOL,TX,X,XCUT,XLIM,XTOL,Y,
14775     2                 YT,Y1,Y2
14776      REAL             PSIXN
14777      INTEGER I,IC,ICASE,ICT,IERR,IK,IND,IX,I1M,JSET,K,KK,KN,KODE,KS,M,
14778     1        ML,MU,N,ND,NM,NZ
14779      DIMENSION EN(*), A(99), B(99), Y(2)
14780C***FIRST EXECUTABLE STATEMENT  EXINT
14781      IERR = 0
14782      NZ = 0
14783      ML = 0
14784      ETOL = MAX(R1MACH(4),0.5E-18)
14785      IF (X.LT.0.0E0) IERR = 1
14786      IF (N.LT.1) IERR = 1
14787      IF (KODE.LT.1 .OR. KODE.GT.2) IERR = 1
14788      IF (M.LT.1) IERR = 1
14789      IF (TOL.LT.ETOL .OR. TOL.GT.0.1E0) IERR = 1
14790      IF (X.EQ.0.0E0 .AND. N.EQ.1) IERR = 1
14791      IF (IERR.NE.0) RETURN
14792      I1M = -I1MACH(12)
14793      PT = 2.3026E0*R1MACH(5)*I1M
14794      XLIM = PT - 6.907755E0
14795      BT = PT + (N+M-1)
14796      IF (BT.GT.1000.0E0) XLIM = PT - LOG(BT)
14797C
14798      XCUT = 2.0E0
14799      IF (ETOL.GT.2.0E-7) XCUT = 1.0E0
14800      IF (X.GT.XCUT) GO TO 100
14801      IF (X.EQ.0.0E0 .AND. N.GT.1) GO TO 80
14802C-----------------------------------------------------------------------
14803C     SERIES FOR E(N,X) FOR X.LE.XCUT
14804C-----------------------------------------------------------------------
14805      TX = X + 0.5E0
14806      IX = INT(TX)
14807C-----------------------------------------------------------------------
14808C     ICASE=1 MEANS INTEGER CLOSEST TO X IS 2 AND N=1
14809C     ICASE=2 MEANS INTEGER CLOSEST TO X IS 0,1, OR 2 AND N.GE.2
14810C-----------------------------------------------------------------------
14811      ICASE = 2
14812      IF (IX.GT.N) ICASE = 1
14813      NM = N - ICASE + 1
14814      ND = NM + 1
14815      IND = 3 - ICASE
14816      MU = M - IND
14817      ML = 1
14818      KS = ND
14819      FNM = NM
14820      S = 0.0E0
14821      XTOL = 3.0E0*TOL
14822      IF (ND.EQ.1) GO TO 10
14823      XTOL = 0.3333E0*TOL
14824      S = 1.0E0/FNM
14825   10 CONTINUE
14826      AA = 1.0E0
14827      AK = 1.0E0
14828      IC = 35
14829      IF (X.LT.ETOL) IC = 1
14830      DO 50 I=1,IC
14831        AA = -AA*X/AK
14832        IF (I.EQ.NM) GO TO 30
14833        S = S - AA/(AK-FNM)
14834        IF (ABS(AA).LE.XTOL*ABS(S)) GO TO 20
14835        AK = AK + 1.0E0
14836        GO TO 50
14837   20   CONTINUE
14838        IF (I.LT.2) GO TO 40
14839        IF (ND-2.GT.I .OR. I.GT.ND-1) GO TO 60
14840        AK = AK + 1.0E0
14841        GO TO 50
14842   30   S = S + AA*(-LOG(X)+PSIXN(ND))
14843        XTOL = 3.0E0*TOL
14844   40   AK = AK + 1.0E0
14845   50 CONTINUE
14846      IF (IC.NE.1) GO TO 340
14847   60 IF (ND.EQ.1) S = S + (-LOG(X)+PSIXN(1))
14848      IF (KODE.EQ.2) S = S*EXP(X)
14849      EN(1) = S
14850      EMX = 1.0E0
14851      IF (M.EQ.1) GO TO 70
14852      EN(IND) = S
14853      AA = KS
14854      IF (KODE.EQ.1) EMX = EXP(-X)
14855      GO TO (220, 240), ICASE
14856   70 IF (ICASE.EQ.2) RETURN
14857      IF (KODE.EQ.1) EMX = EXP(-X)
14858      EN(1) = (EMX-S)/X
14859      RETURN
14860   80 CONTINUE
14861      DO 90 I=1,M
14862        EN(I) = 1.0E0/(N+I-2)
14863   90 CONTINUE
14864      RETURN
14865C-----------------------------------------------------------------------
14866C     BACKWARD RECURSIVE MILLER ALGORITHM FOR
14867C              E(N,X)=EXP(-X)*(X**(N-1))*U(N,N,X)
14868C     WITH RECURSION AWAY FROM N=INTEGER CLOSEST TO X.
14869C     U(A,B,X) IS THE SECOND CONFLUENT HYPERGEOMETRIC FUNCTION
14870C-----------------------------------------------------------------------
14871  100 CONTINUE
14872      EMX = 1.0E0
14873      IF (KODE.EQ.2) GO TO 130
14874      IF (X.LE.XLIM) GO TO 120
14875      NZ = M
14876      DO 110 I=1,M
14877        EN(I) = 0.0E0
14878  110 CONTINUE
14879      RETURN
14880  120 EMX = EXP(-X)
14881  130 CONTINUE
14882      IX = INT(X+0.5E0)
14883      KN = N + M - 1
14884      IF (KN.LE.IX) GO TO 140
14885      IF (N.LT.IX .AND. IX.LT.KN) GO TO 170
14886      IF (N.GE.IX) GO TO 160
14887      GO TO 340
14888  140 ICASE = 1
14889      KS = KN
14890      ML = M - 1
14891      MU = -1
14892      IND = M
14893      IF (KN.GT.1) GO TO 180
14894  150 KS = 2
14895      ICASE = 3
14896      GO TO 180
14897  160 ICASE = 2
14898      IND = 1
14899      KS = N
14900      MU = M - 1
14901      IF (N.GT.1) GO TO 180
14902      IF (KN.EQ.1) GO TO 150
14903      IX = 2
14904  170 ICASE = 1
14905      KS = IX
14906      ML = IX - N
14907      IND = ML + 1
14908      MU = KN - IX
14909  180 CONTINUE
14910      IK = KS/2
14911      AH = IK
14912      JSET = 1 + KS - (IK+IK)
14913C-----------------------------------------------------------------------
14914C     START COMPUTATION FOR
14915C              EN(IND) = C*U( A , A ,X)    JSET=1
14916C              EN(IND) = C*U(A+1,A+1,X)    JSET=2
14917C     FOR AN EVEN INTEGER A.
14918C-----------------------------------------------------------------------
14919      IC = 0
14920      AA = AH + AH
14921      AAMS = AA - 1.0E0
14922      AAMS = AAMS*AAMS
14923      TX = X + X
14924      FX = TX + TX
14925      AK = AH
14926      XTOL = TOL
14927      IF (TOL.LE.1.0E-3) XTOL = 20.0E0*TOL
14928      CT = AAMS + FX*AH
14929      EM = (AH+1.0E0)/((X+AA)*XTOL*SQRT(CT))
14930      BK = AA
14931      CC = AH*AH
14932C-----------------------------------------------------------------------
14933C     FORWARD RECURSION FOR P(IC),P(IC+1) AND INDEX IC FOR BACKWARD
14934C     RECURSION
14935C-----------------------------------------------------------------------
14936      P1 = 0.0E0
14937      P2 = 1.0E0
14938  190 CONTINUE
14939      IF (IC.EQ.99) GO TO 340
14940      IC = IC + 1
14941      AK = AK + 1.0E0
14942      AT = BK/(BK+AK+CC+IC)
14943      BK = BK + AK + AK
14944      A(IC) = AT
14945      BT = (AK+AK+X)/(AK+1.0E0)
14946      B(IC) = BT
14947      PT = P2
14948      P2 = BT*P2 - AT*P1
14949      P1 = PT
14950      CT = CT + FX
14951      EM = EM*AT*(1.0E0-TX/CT)
14952      IF (EM*(AK+1.0E0).GT.P1*P1) GO TO 190
14953      ICT = IC
14954      KK = IC + 1
14955      BT = TX/(CT+FX)
14956      Y2 = (BK/(BK+CC+KK))*(P1/P2)*(1.0E0-BT+0.375E0*BT*BT)
14957      Y1 = 1.0E0
14958C-----------------------------------------------------------------------
14959C     BACKWARD RECURRENCE FOR
14960C              Y1=             C*U( A ,A,X)
14961C              Y2= C*(A/(1+A/2))*U(A+1,A,X)
14962C-----------------------------------------------------------------------
14963      DO 200 K=1,ICT
14964        KK = KK - 1
14965        YT = Y1
14966        Y1 = (B(KK)*Y1-Y2)/A(KK)
14967        Y2 = YT
14968  200 CONTINUE
14969C-----------------------------------------------------------------------
14970C     THE CONTIGUOUS RELATION
14971C              X*U(B,C+1,X)=(C-B)*U(B,C,X)+U(B-1,C,X)
14972C     WITH  B=A+1 , C=A IS USED FOR
14973C              Y(2) = C * U(A+1,A+1,X)
14974C     X IS INCORPORATED INTO THE NORMALIZING RELATION
14975C-----------------------------------------------------------------------
14976      PT = Y2/Y1
14977      CNORM = 1.0E0 - PT*(AH+1.0E0)/AA
14978      Y(1) = 1.0E0/(CNORM*AA+X)
14979      Y(2) = CNORM*Y(1)
14980      IF (ICASE.EQ.3) GO TO 210
14981      EN(IND) = EMX*Y(JSET)
14982      IF (M.EQ.1) RETURN
14983      AA = KS
14984      GO TO (220, 240), ICASE
14985C-----------------------------------------------------------------------
14986C     RECURSION SECTION  N*E(N+1,X) + X*E(N,X)=EMX
14987C-----------------------------------------------------------------------
14988  210 EN(1) = EMX*(1.0E0-Y(1))/X
14989      RETURN
14990  220 K = IND - 1
14991      DO 230 I=1,ML
14992        AA = AA - 1.0E0
14993        EN(K) = (EMX-AA*EN(K+1))/X
14994        K = K - 1
14995  230 CONTINUE
14996      IF (MU.LE.0) RETURN
14997      AA = KS
14998  240 K = IND
14999      DO 250 I=1,MU
15000        EN(K+1) = (EMX-X*EN(K))/AA
15001        AA = AA + 1.0E0
15002        K = K + 1
15003  250 CONTINUE
15004      RETURN
15005  340 CONTINUE
15006      IERR = 2
15007      RETURN
15008      END
15009      DOUBLE PRECISION FUNCTION erfdp(x)
15010CCCCC RENAME TO AVOID CONFLICT WITH INTRINSIC "ERF" ROUTINE
15011CCCCC DOUBLE PRECISION FUNCTION erf(x)
15012C-----------------------------------------------------------------------
15013C             EVALUATION OF THE REAL ERROR FUNCTION
15014C-----------------------------------------------------------------------
15015C     .. Scalar Arguments ..
15016      DOUBLE PRECISION x
15017C     ..
15018C     .. Local Scalars ..
15019      DOUBLE PRECISION ax,bot,c,t,top,x2
15020C     ..
15021C     .. Local Arrays ..
15022      DOUBLE PRECISION a(5),b(3),p(8),q(8),r(5),s(4)
15023C     ..
15024C     .. Intrinsic Functions ..
15025      INTRINSIC abs,exp,sign
15026C     ..
15027C     .. Data statements ..
15028C-------------------------
15029C-------------------------
15030C-------------------------
15031C-------------------------
15032      DATA c/.564189583547756D0/
15033      DATA a(1)/.771058495001320D-04/,a(2)/-.133733772997339D-02/,
15034     +     a(3)/.323076579225834D-01/,a(4)/.479137145607681D-01/,
15035     +     a(5)/.128379167095513D+00/
15036      DATA b(1)/.301048631703895D-02/,b(2)/.538971687740286D-01/,
15037     +     b(3)/.375795757275549D+00/
15038      DATA p(1)/-1.36864857382717D-07/,p(2)/5.64195517478974D-01/,
15039     +     p(3)/7.21175825088309D+00/,p(4)/4.31622272220567D+01/,
15040     +     p(5)/1.52989285046940D+02/,p(6)/3.39320816734344D+02/,
15041     +     p(7)/4.51918953711873D+02/,p(8)/3.00459261020162D+02/
15042      DATA q(1)/1.00000000000000D+00/,q(2)/1.27827273196294D+01/,
15043     +     q(3)/7.70001529352295D+01/,q(4)/2.77585444743988D+02/,
15044     +     q(5)/6.38980264465631D+02/,q(6)/9.31354094850610D+02/,
15045     +     q(7)/7.90950925327898D+02/,q(8)/3.00459260956983D+02/
15046      DATA r(1)/2.10144126479064D+00/,r(2)/2.62370141675169D+01/,
15047     +     r(3)/2.13688200555087D+01/,r(4)/4.65807828718470D+00/,
15048     +     r(5)/2.82094791773523D-01/
15049      DATA s(1)/9.41537750555460D+01/,s(2)/1.87114811799590D+02/,
15050     +     s(3)/9.90191814623914D+01/,s(4)/1.80124575948747D+01/
15051C     ..
15052C     .. Executable Statements ..
15053C-------------------------
15054      ax = abs(x)
15055      IF (ax.GT.0.5D0) GO TO 10
15056      t = x*x
15057      top = ((((a(1)*t+a(2))*t+a(3))*t+a(4))*t+a(5)) + 1.0D0
15058      bot = ((b(1)*t+b(2))*t+b(3))*t + 1.0D0
15059      erfdp = x* (top/bot)
15060      RETURN
15061C
15062   10 IF (ax.GT.4.0D0) GO TO 20
15063      top = ((((((p(1)*ax+p(2))*ax+p(3))*ax+p(4))*ax+p(5))*ax+p(6))*ax+
15064     +      p(7))*ax + p(8)
15065      bot = ((((((q(1)*ax+q(2))*ax+q(3))*ax+q(4))*ax+q(5))*ax+q(6))*ax+
15066     +      q(7))*ax + q(8)
15067      erfdp = 0.5D0 + (0.5D0-exp(-x*x)*top/bot)
15068      IF (x.LT.0.0D0) erfdp = -erfdp
15069      RETURN
15070C
15071   20 IF (ax.GE.5.8D0) GO TO 30
15072      x2 = x*x
15073      t = 1.0D0/x2
15074      top = (((r(1)*t+r(2))*t+r(3))*t+r(4))*t + r(5)
15075      bot = (((s(1)*t+s(2))*t+s(3))*t+s(4))*t + 1.0D0
15076      erfdp = (c-top/ (x2*bot))/ax
15077      erfdp = 0.5D0 + (0.5D0-exp(-x2)*erfdp)
15078      IF (x.LT.0.0D0) erfdp = -erfdp
15079      RETURN
15080C
15081   30 erfdp = sign(1.0D0,x)
15082      RETURN
15083      END
15084      DOUBLE PRECISION FUNCTION erfc1(ind,x)
15085C-----------------------------------------------------------------------
15086C         EVALUATION OF THE COMPLEMENTARY ERROR FUNCTION
15087C
15088C          ERFC1(IND,X) = ERFC(X)            IF IND = 0
15089C          ERFC1(IND,X) = EXP(X*X)*ERFC(X)   OTHERWISE
15090C-----------------------------------------------------------------------
15091C     .. Scalar Arguments ..
15092      DOUBLE PRECISION x
15093      INTEGER ind
15094C     ..
15095C     .. Local Scalars ..
15096      DOUBLE PRECISION ax,bot,c,e,t,top,w
15097C     ..
15098C     .. Local Arrays ..
15099      DOUBLE PRECISION a(5),b(3),p(8),q(8),r(5),s(4)
15100C     ..
15101C     .. External Functions ..
15102      DOUBLE PRECISION exparg
15103      EXTERNAL exparg
15104C     ..
15105C     .. Intrinsic Functions ..
15106      INTRINSIC abs,dble,exp
15107C     ..
15108C     .. Data statements ..
15109C-------------------------
15110C-------------------------
15111C-------------------------
15112C-------------------------
15113      DATA c/.564189583547756D0/
15114      DATA a(1)/.771058495001320D-04/,a(2)/-.133733772997339D-02/,
15115     +     a(3)/.323076579225834D-01/,a(4)/.479137145607681D-01/,
15116     +     a(5)/.128379167095513D+00/
15117      DATA b(1)/.301048631703895D-02/,b(2)/.538971687740286D-01/,
15118     +     b(3)/.375795757275549D+00/
15119      DATA p(1)/-1.36864857382717D-07/,p(2)/5.64195517478974D-01/,
15120     +     p(3)/7.21175825088309D+00/,p(4)/4.31622272220567D+01/,
15121     +     p(5)/1.52989285046940D+02/,p(6)/3.39320816734344D+02/,
15122     +     p(7)/4.51918953711873D+02/,p(8)/3.00459261020162D+02/
15123      DATA q(1)/1.00000000000000D+00/,q(2)/1.27827273196294D+01/,
15124     +     q(3)/7.70001529352295D+01/,q(4)/2.77585444743988D+02/,
15125     +     q(5)/6.38980264465631D+02/,q(6)/9.31354094850610D+02/,
15126     +     q(7)/7.90950925327898D+02/,q(8)/3.00459260956983D+02/
15127      DATA r(1)/2.10144126479064D+00/,r(2)/2.62370141675169D+01/,
15128     +     r(3)/2.13688200555087D+01/,r(4)/4.65807828718470D+00/,
15129     +     r(5)/2.82094791773523D-01/
15130      DATA s(1)/9.41537750555460D+01/,s(2)/1.87114811799590D+02/,
15131     +     s(3)/9.90191814623914D+01/,s(4)/1.80124575948747D+01/
15132C     ..
15133C     .. Executable Statements ..
15134C-------------------------
15135C
15136C                     ABS(X) .LE. 0.5
15137C
15138      ax = abs(x)
15139      IF (ax.GT.0.5D0) GO TO 10
15140      t = x*x
15141      top = ((((a(1)*t+a(2))*t+a(3))*t+a(4))*t+a(5)) + 1.0D0
15142      bot = ((b(1)*t+b(2))*t+b(3))*t + 1.0D0
15143      erfc1 = 0.5D0 + (0.5D0-x* (top/bot))
15144      IF (ind.NE.0) erfc1 = exp(t)*erfc1
15145      RETURN
15146C
15147C                  0.5 .LT. ABS(X) .LE. 4
15148C
15149   10 IF (ax.GT.4.0D0) GO TO 20
15150      top = ((((((p(1)*ax+p(2))*ax+p(3))*ax+p(4))*ax+p(5))*ax+p(6))*ax+
15151     +      p(7))*ax + p(8)
15152      bot = ((((((q(1)*ax+q(2))*ax+q(3))*ax+q(4))*ax+q(5))*ax+q(6))*ax+
15153     +      q(7))*ax + q(8)
15154      erfc1 = top/bot
15155      GO TO 40
15156C
15157C                      ABS(X) .GT. 4
15158C
15159   20 IF (x.LE.-5.6D0) GO TO 60
15160      IF (ind.NE.0) GO TO 30
15161      IF (x.GT.100.0D0) GO TO 70
15162      IF (x*x.GT.-exparg(1)) GO TO 70
15163C
15164   30 t = (1.0D0/x)**2
15165      top = (((r(1)*t+r(2))*t+r(3))*t+r(4))*t + r(5)
15166      bot = (((s(1)*t+s(2))*t+s(3))*t+s(4))*t + 1.0D0
15167      erfc1 = (c-t*top/bot)/ax
15168C
15169C                      FINAL ASSEMBLY
15170C
15171   40 IF (ind.EQ.0) GO TO 50
15172      IF (x.LT.0.0D0) erfc1 = 2.0D0*exp(x*x) - erfc1
15173      RETURN
15174
15175   50 w = dble(x)*dble(x)
15176      t = w
15177      e = w - dble(t)
15178      erfc1 = ((0.5D0+ (0.5D0-e))*exp(-t))*erfc1
15179      IF (x.LT.0.0D0) erfc1 = 2.0D0 - erfc1
15180      RETURN
15181C
15182C             LIMIT VALUE FOR LARGE NEGATIVE X
15183C
15184   60 erfc1 = 2.0D0
15185      IF (ind.NE.0) erfc1 = 2.0D0*exp(x*x)
15186      RETURN
15187C
15188C             LIMIT VALUE FOR LARGE POSITIVE X
15189C                       WHEN IND = 0
15190C
15191   70 erfc1 = 0.0D0
15192      RETURN
15193
15194      END
15195      SUBROUTINE ERRCDF(X,ALPHA,CDF)
15196C
15197C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
15198C              FUNCTION VALUE FOR THE ERROR (OR EXPONENTIAL POWER OR
15199C              GENERAL ERROR OR SUBBOTIN) DISTRIBUTION.  NOTE THAT
15200C              THERE ARE SEVERAL DIFFERENT PARAMETERIZATIONS OF
15201C              THIS DISTRIBUTION.  WE USE THE ONE FROM THE
15202C              TADIKAMALLA PAPER (SEE REFERENCE BELOW).  SPECIFICALLY,
15203C              THE PDF IS:
15204C              F(X,ALPHA)=EXP(-|X|**ALPHA)/[2*ALPHA(1+1/ALPHA)]
15205C                         -INFINITY < X < INFINITY, ALPHA >= 1
15206C              WITH ALPHA DENOTING THE SHAPE PARAMETER.
15207C              AT THE VALUE ALPHA.
15208C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
15209C                                AT WHICH THE CUMULATIVE DISTRIBUTION
15210C                                FUNCTION IS TO BE EVALUATED.
15211C                                X CAN BE ANY REAL NUMBER
15212C                     --ALPHA  = THE SINGLE PRECISION VALUE
15213C                                OF THE TAIL LENGTH PARAMETER.
15214C                                ALPHA SHOULD BE >= 1..
15215C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
15216C                                DISTRIBUTION FUNCTION VALUE.
15217C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
15218C     RESTRICTIONS--ALPHA SHOULD BE >= 1.
15219C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
15220C     FORTRAN LIBRARY SUBROUTINES NEEDED--DGAMMA, DGAMI
15221C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
15222C     LANGUAGE--ANSI FORTRAN.
15223C     REFERENCES--PANDU R. RADIKAMALLA, "RANDOM SAMPLING FROM THE
15224C                 EXPONENTIAL POWER DISTRIBUTION", JOURNAL OF THE
15225C                 AMERICAN STATISTICAL ASSOCIATION, SEPTEMBER, 1980,
15226C                 PAGES 683-686.
15227C               --JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
15228C                 UNIVARIATE DISTRIBUTIONS--VOLUME 2, SECOND EDITION",
15229C                 WILEY, 1994.
15230C               --EVANS, HASTINGS AND PEACOCK, STATISTICAL
15231C                 DISTRIBUTIONS--THIRD EDITION", WILEY, 2000.
15232C     WRITTEN BY--JAMES J. FILLIBEN
15233C                 STATISTICAL ENGINEERING LABORATORY
15234C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15235C                 GAITHERSBURG, MD 20899
15236C                 PHONE:  301-975-2855
15237C     ORIGINAL VERSION--MAY       2003.
15238C
15239C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15240C
15241C-----COMMON----------------------------------------------------------
15242C
15243      INCLUDE 'DPCOP2.INC'
15244C
15245C---------------------------------------------------------------------
15246C
15247      DOUBLE PRECISION DX,DALPHA,DGAMMA,DGAMI,DCDF
15248      DOUBLE PRECISION DTERM1, DTERM2
15249      EXTERNAL DGAMI
15250      EXTERNAL DGAMMA
15251C
15252C     CHECK THE INPUT ARGUMENTS FOR ERRORS
15253C
15254      IF(ALPHA.LT.1.0)THEN
15255        WRITE(ICOUT,15)
15256        CALL DPWRST('XXX','BUG ')
15257        WRITE(ICOUT,16)
15258        CALL DPWRST('XXX','BUG ')
15259        WRITE(ICOUT,46)ALPHA
15260        CALL DPWRST('XXX','BUG ')
15261        CDF=0.0
15262        GOTO9999
15263      ENDIF
15264   15 FORMAT('***** FATAL ERROR--THE SHAPE PARAMETER FOR THE ERROR')
15265   16 FORMAT('      CDF FUNCTION IS LESS THAN ONE.')
15266   46 FORMAT('      THE VALUE OF THE ARGUMENT IS ',E15.8)
15267C
15268C-----START POINT-----------------------------------------------------
15269C
15270      DX=DBLE(X)
15271      DALPHA=DBLE(ALPHA)
15272C
15273C  ALPHA=1 IS DOUBLE EXPONENTIAL
15274C  ALPHA=2 IS NORMAL
15275C
15276      IF(ALPHA.LE.1.00005)THEN
15277        CALL DEXCDF(X,CDF)
15278        GOTO9999
15279      ELSEIF(ALPHA.EQ.2.0)THEN
15280        CALL NORCDF(X,CDF)
15281        GOTO9999
15282      ENDIF
15283C
15284      IF(X.EQ.0.0)THEN
15285        CDF=0.5
15286        GOTO9999
15287      ELSEIF(X.GT.0.0)THEN
15288        DTERM1=-DX*DGAMI(1.0D0/DALPHA,DX**DALPHA)
15289        DTERM2=2.0D0*DALPHA*(DX**DALPHA)**(1.0D0/DALPHA)*
15290     1         DGAMMA(1.0D0+1.0D0/DALPHA)
15291        DCDF=0.5D0 - DTERM1/DTERM2
15292      ELSE
15293        DX=-DX
15294        DTERM1=-DX*DGAMI(1.0D0/DALPHA,DX**DALPHA)
15295        DTERM2=2.0D0*DALPHA*(DX**DALPHA)**(1.0D0/DALPHA)*
15296     1         DGAMMA(1.0D0+1.0D0/DALPHA)
15297        DCDF=0.5D0 + DTERM1/DTERM2
15298      ENDIF
15299C
15300      CDF=REAL(DCDF)
15301 9999 CONTINUE
15302      RETURN
15303      END
15304      SUBROUTINE ERRPDF(X,ALPHA,PDF)
15305C
15306C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
15307C              FUNCTION VALUE FOR THE ERROR (OR EXPONENTIAL POWER OR
15308C              GENERAL ERROR OR SUBBOTIN) DISTRIBUTION.  NOTE THAT
15309C              THERE ARE SEVERAL DIFFERENT PARAMETERIZATIONS OF
15310C              THIS DISTRIBUTION.  WE USE THE ONE FROM THE
15311C              TADIKAMALLA PAPER (SEE REFERENCE BELOW).  SPECIFICALLY,
15312C              THE PDF IS:
15313C              F(X,ALPHA)=EXP(-|X|**ALPHA)/[2*ALPHA(1+1/ALPHA)]
15314C                         -INFINITY < X < INFINITY, ALPHA >= 1
15315C              WITH ALPHA DENOTING THE SHAPE PARAMETER.
15316C              AT THE VALUE ALPHA.
15317C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
15318C                                AT WHICH THE CUMULATIVE DISTRIBUTION
15319C                                FUNCTION IS TO BE EVALUATED.
15320C                                X CAN BE ANY REAL NUMBER
15321C                     --ALPHA  = THE SINGLE PRECISION VALUE
15322C                                OF THE TAIL LENGTH PARAMETER.
15323C                                ALPHA SHOULD BE >= 1..
15324C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
15325C                                DENSITY FUNCTION VALUE.
15326C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
15327C     RESTRICTIONS--ALPHA SHOULD BE >= 1.
15328C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
15329C     FORTRAN LIBRARY SUBROUTINES NEEDED--DEXP, DLOG.
15330C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
15331C     LANGUAGE--ANSI FORTRAN.
15332C     REFERENCES--PANDU R. RADIKAMALLA, "RANDOM SAMPLING FROM THE
15333C                 EXPONENTIAL POWER DISTRIBUTION", JOURNAL OF THE
15334C                 AMERICAN STATISTICAL ASSOCIATION, SEPTEMBER, 1980,
15335C                 PAGES 683-686.
15336C               --JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
15337C                 UNIVARIATE DISTRIBUTIONS--VOLUME 2, SECOND EDITION",
15338C                 WILEY, 1994.
15339C               --EVANS, HASTINGS AND PEACOCK, STATISTICAL
15340C                 DISTRIBUTIONS--THIRD EDITION", WILEY, 2000.
15341C     WRITTEN BY--JAMES J. FILLIBEN
15342C                 STATISTICAL ENGINEERING LABORATORY
15343C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15344C                 GAITHERSBURG, MD 20899
15345C                 PHONE:  301-975-2855
15346C     ORIGINAL VERSION--MAY       2003.
15347C
15348C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15349C
15350C-----COMMON----------------------------------------------------------
15351C
15352      INCLUDE 'DPCOP2.INC'
15353C
15354C---------------------------------------------------------------------
15355C
15356
15357      DOUBLE PRECISION DX,DALPHA,DLNGAM,DPDF
15358C
15359C     CHECK THE INPUT ARGUMENTS FOR ERRORS
15360C
15361      IF(ALPHA.LT.1.0)THEN
15362        WRITE(ICOUT,15)
15363        CALL DPWRST('XXX','BUG ')
15364        WRITE(ICOUT,16)
15365        CALL DPWRST('XXX','BUG ')
15366        WRITE(ICOUT,46)ALPHA
15367        CALL DPWRST('XXX','BUG ')
15368        PDF=0.0
15369        GOTO9999
15370      ENDIF
15371   15 FORMAT('***** FATAL ERROR--THE SHAPE PARAMETER FOR THE ERROR')
15372   16 FORMAT('      PDF FUNCTION IS LESS THAN ONE.')
15373   46 FORMAT('      THE VALUE OF THE ARGUMENT IS ',E15.8)
15374C
15375C-----START POINT-----------------------------------------------------
15376C
15377      DX=DBLE(X)
15378      DALPHA=DBLE(ALPHA)
15379C
15380      IF(ALPHA.EQ.1.0)THEN
15381        CALL DEXPDF(X,PDF)
15382        GOTO9999
15383      ELSEIF(ALPHA.EQ.2.0)THEN
15384        CALL NORPDF(X,PDF)
15385        GOTO9999
15386      ENDIF
15387C
15388      DPDF=-DABS(DX)**DALPHA-DLOG(2.0D0)-DLNGAM(1.0D0+1.0D0/DALPHA)
15389      IF(DPDF.LT.-80.D0)THEN
15390        PDF=0.0
15391      ELSEIF(DPDF.LT.LOG(CPUMAX))THEN
15392        PDF=REAL(DEXP(DPDF))
15393      ELSE
15394        PDF=LOG(CPUMAX)
15395        WRITE(ICOUT,105)
15396        CALL DPWRST('XXX','BUG ')
15397      ENDIF
15398C
15399  105 FORMAT('****** WARNING--OVERFLOW IN ERRPDF ROUTINE.')
15400C
15401 9999 CONTINUE
15402      RETURN
15403      END
15404      SUBROUTINE ERRPPF(P,ALPHA,PPF)
15405C
15406C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
15407C              FUNCTION VALUE FOR THE ERROR (OR EXPONENTIAL POWER OR
15408C              GENERAL ERROR OR SUBBOTIN) DISTRIBUTION.  NOTE THAT
15409C              THERE ARE SEVERAL DIFFERENT PARAMETERIZATIONS OF
15410C              THIS DISTRIBUTION.  WE USE THE ONE FROM THE
15411C              TADIKAMALLA PAPER (SEE REFERENCE BELOW).  SPECIFICALLY,
15412C              THE PPF IS:
15413C              F(X,ALPHA)=EXP(-|X|**ALPHA)/[2*ALPHA(1+1/ALPHA)]
15414C                         -INFINITY < X < INFINITY, ALPHA >= 1
15415C              WITH ALPHA DENOTING THE SHAPE PARAMETER.
15416C              AT THE VALUE ALPHA.
15417C              THE PERCENT POINT FUNCTION IS COMPUTED NUMERICALLY
15418C              USING A BISECTION METHOD.
15419C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
15420C                                AT WHICH THE PERCENT POINT
15421C                                FUNCTION IS TO BE EVALUATED.
15422C                                X CAN BE ANY REAL NUMBER
15423C                     --ALPHA  = THE SINGLE PRECISION VALUE
15424C                                OF THE TAIL LENGTH PARAMETER.
15425C                                ALPHA SHOULD BE >= 1..
15426C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT POINT
15427C                                FUNCTION VALUE.
15428C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
15429C     RESTRICTIONS--ALPHA SHOULD BE >= 1.
15430C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
15431C     FORTRAN LIBRARY SUBROUTINES NEEDED--DEXP, DLOG.
15432C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
15433C     LANGUAGE--ANSI FORTRAN.
15434C     REFERENCES--PANDU R. RADIKAMALLA, "RANDOM SAMPLING FROM THE
15435C                 EXPONENTIAL POWER DISTRIBUTION", JOURNAL OF THE
15436C                 AMERICAN STATISTICAL ASSOCIATION, SEPTEMBER, 1980,
15437C                 PAGES 683-686.
15438C               --JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
15439C                 UNIVARIATE DISTRIBUTIONS--VOLUME 2, SECOND EDITION",
15440C                 WILEY, 1994.
15441C               --EVANS, HASTINGS AND PEACOCK, STATISTICAL
15442C                 DISTRIBUTIONS--THIRD EDITION", WILEY, 2000.
15443C     WRITTEN BY--JAMES J. FILLIBEN
15444C                 STATISTICAL ENGINEERING LABORATORY
15445C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15446C                 GAITHERSBURG, MD 20899
15447C                 PHONE:  301-975-2855
15448C     ORIGINAL VERSION--MAY       2003.
15449C
15450C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15451C
15452C-----COMMON----------------------------------------------------------
15453C
15454      INCLUDE 'DPCOP2.INC'
15455C
15456C---------------------------------------------------------------------
15457C
15458      DOUBLE PRECISION DALPHA,DGAMMA
15459      EXTERNAL DGAMMA
15460C
15461      DATA EPS /0.00001/
15462      DATA SIG /1.0E-6/
15463      DATA ZERO /0./
15464      DATA MAXIT /500/
15465C
15466C-----START POINT-----------------------------------------------------
15467C
15468C     CHECK THE INPUT ARGUMENTS FOR ERRORS
15469C
15470      ASGN=1.0
15471      PPF=0.0
15472      IF(P.LE.0.0 .OR. P.GE.1.0)THEN
15473        WRITE(ICOUT,5)
15474        CALL DPWRST('XXX','BUG ')
15475        WRITE(ICOUT,6)
15476        CALL DPWRST('XXX','BUG ')
15477        WRITE(ICOUT,46)P
15478        CALL DPWRST('XXX','BUG ')
15479        GOTO9999
15480      ELSEIF(ALPHA.LT.1.0)THEN
15481        WRITE(ICOUT,15)
15482        CALL DPWRST('XXX','BUG ')
15483        WRITE(ICOUT,16)
15484        CALL DPWRST('XXX','BUG ')
15485        WRITE(ICOUT,46)ALPHA
15486        CALL DPWRST('XXX','BUG ')
15487        GOTO9999
15488      ENDIF
15489    5 FORMAT('***** ERROR--THE INPUT ARGUMENT FOR THE ERROR')
15490    6 FORMAT('      PERCENT POINT FUNCTION IS OUTSIDE THE ALLOWABLE ',
15491     1       '[0,1] INTERVAL.')
15492   15 FORMAT('***** ERROR--THE SHAPE PARAMETER FOR THE ERROR')
15493   16 FORMAT('      PERCENT POINT FUNCTION IS LESS THAN ONE.')
15494   46 FORMAT('      THE VALUE OF THE ARGUMENT IS ',G15.7,'.')
15495C
15496      IF(P.EQ.0.5)THEN
15497        PPF=0.0
15498        GOTO9999
15499      ELSEIF(ALPHA.LE.1.000005)THEN
15500        CALL DEXPPF(P,PPF)
15501        GOTO9999
15502      ELSEIF(ALPHA.EQ.2.0)THEN
15503        CALL NORPPF(P,PPF)
15504        GOTO9999
15505      ENDIF
15506C
15507      DALPHA=DBLE(ALPHA)
15508C
15509C  P = 0.5 IS ZERO.  USE SYMMETRY TO HANDLE P < 0.5 AND P > 0.5
15510C  CASES WITH SAME CODE (JUST NEED TO CHANGE SIGN OF FINAL PPF
15511C  VALUE).
15512C
15513      ASGN=1.0
15514      IF(P.LT.0.5)THEN
15515        P=1.0 - P
15516        ASGN=-1.0
15517      ENDIF
15518C
15519C  FIND BRACKETING INTERVAL.  BRACKETED ABOVE BY ZERO.  STANDARD
15520C  DEVIATION = SQRT(GAMMA(3/ALPHA)/GAMMA(1/ALPHA)).
15521C
15522      SD=DSQRT(DGAMMA(3.0D0/DALPHA)/DGAMMA(1.0D0/DALPHA))
15523      XL=0.0D0
15524      XINC=SD
15525      ICOUNT=0
15526      MAXCNT=200
15527C
15528   91 CONTINUE
15529      XR=XL+XINC
15530      IF(XL.LE.0.0)XL=0.0
15531      IF(XR.LE.0.0)XR=XL+1.0
15532      CALL ERRCDF(XL,ALPHA,CDFL)
15533      CALL ERRCDF(XR,ALPHA,CDFR)
15534      IF(CDFL.LT.P .AND. CDFR.LT.P)THEN
15535        XL=XR
15536      ELSEIF(CDFL.GT.P .AND. CDFR.GT.P)THEN
15537        XL=XL-XINC
15538      ELSE
15539        GOTO99
15540      ENDIF
15541      ICOUNT=ICOUNT+1
15542      IF(ICOUNT.GT.MAXCNT)THEN
15543        WRITE(ICOUT,96)
15544        CALL DPWRST('XXX','BUG ')
15545        PPF=0.0
15546        GOTO9999
15547      ENDIF
15548   96 FORMAT('***** ERROR--ERRPPF UNABLE TO FIND BRACKETING ',
15549     *       'INTERVAL. *****')
15550      GOTO91
15551C
15552C  BISECTION METHOD
15553C
15554   99 CONTINUE
15555      IC = 0
15556      FXL = -P
15557      FXR = 1.0 - P
15558  105 CONTINUE
15559      X = (XL+XR)*0.5
15560      CALL ERRCDF(X,ALPHA,CDF)
15561      P1=CDF
15562      PPF=X
15563      FCS = P1 - P
15564      IF(FCS*FXL.GT.ZERO)GOTO110
15565      XR = X
15566      FXR = FCS
15567      GOTO115
15568  110 CONTINUE
15569      XL = X
15570      FXL = FCS
15571  115 CONTINUE
15572      XRML = XR - XL
15573      IF(XRML.LE.SIG .AND. ABS(FCS).LE.EPS)GOTO9999
15574      IC = IC + 1
15575      IF(IC.LE.MAXIT)GOTO105
15576      WRITE(ICOUT,130)
15577      CALL DPWRST('XXX','BUG ')
15578  130 FORMAT('***** ERROR--ERRPPF ROUTINE DID NOT CONVERGE. ***')
15579      GOTO9999
15580C
15581C
15582 9999 CONTINUE
15583      PPF=ASGN*PPF
15584      RETURN
15585      END
15586      SUBROUTINE ERRRAN(N,ALPHA,ISEED,X)
15587C
15588C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
15589C              FROM THE ERROR DISTRIBUTION WITH SINGLE PRECISION SHAPE
15590C              PARAMETER = ALPHA.  THIS DISTRIBUTION IS ALSO REFERRED
15591C              TO AS THE SUBBOTIN, EXPONENTIAL POWER, OR GENERAL
15592C              ERROR DISTRIBUTION.  NOTE THAT
15593C              THERE ARE SEVERAL DIFFERENT PARAMETERIZATIONS OF
15594C              THIS DISTRIBUTION.  WE USE THE ONE FROM THE
15595C              TADIKAMALLA PAPER (SEE REFERENCE BELOW).  SPECIFICALLY,
15596C              THE PDF IS:
15597C              F(X,ALPHA)=EXP(-|X|**ALPHA)/[2*ALPHA(1+1/ALPHA)]
15598C                         -INFINITY < X < INFINITY, ALPHA >= 1
15599C              WITH ALPHA DENOTING THE SHAPE PARAMETER.
15600C              AT THE VALUE ALPHA.
15601C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
15602C                                OF RANDOM NUMBERS TO BE
15603C                                GENERATED.
15604C                     --ALPHA  = THE SINGLE PRECISION VALUE OF THE
15605C                                FIRST  SHAPE PARAMETER.
15606C                                ALPHA SHOULD BE GREATER THAN 1.0.
15607C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
15608C                                (OF DIMENSION AT LEAST N)
15609C                                INTO WHICH THE GENERATED
15610C                                RANDOM SAMPLE WILL BE PLACED.
15611C     OUTPUT--A RANDOM SAMPLE OF SIZE N
15612C             FROM THE ERROR DISTRIBUTION
15613C             WITH SHAPE PARAMETER VALUE = ALPHA
15614C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
15615C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
15616C                   OF N FOR THIS SUBROUTINE.
15617C                 --ALPHA SHOULD BE GREATER THAN
15618C                   OR EQUAL TO 1.0.
15619C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN, GAMRAN, DEXRAN,
15620C                                         GAMRAN.
15621C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE
15622C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
15623C     LANGUAGE--ANSI FORTRAN (1977)
15624C     REFERENCES--PANDU R. RADIKAMALLA, "RANDOM SAMPLING FROM THE
15625C                 EXPONENTIAL POWER DISTRIBUTION", JOURNAL OF THE
15626C                 AMERICAN STATISTICAL ASSOCIATION, SEPTEMBER, 1980,
15627C                 PAGES 683-686.
15628C               --JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
15629C                 UNIVARIATE DISTRIBUTIONS--VOLUME 2, SECOND EDITION",
15630C                 WILEY, 1994.
15631C               --EVANS, HASTINGS AND PEACOCK, STATISTICAL
15632C                 DISTRIBUTIONS--THIRD EDITION", WILEY, 2000.
15633C     WRITTEN BY--JAMES J. FILLIBEN
15634C                 STATISTICAL ENGINEERING DIVISION
15635C                 INFORMATION TECHNOLOGY LABORATORY
15636C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15637C                 GAITHERSBURG, MD 20899
15638C                 PHONE--301-975-2899
15639C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15640C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15641C     LANGUAGE--ANSI FORTRAN (1966)
15642C               EXCEPTION--HOLLARITH STRINGS IN FORMAT STATEMENTS
15643C                          DENOTED BY QUOTES RATHER THAN NH.
15644C     VERSION NUMBER--2003.5
15645C     ORIGINAL VERSION--MAY       2003.
15646C
15647C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15648C
15649C---------------------------------------------------------------------
15650C
15651      DIMENSION X(*)
15652      DIMENSION XTEMP(1)
15653C
15654C-----COMMON----------------------------------------------------------
15655C
15656      INCLUDE 'DPCOP2.INC'
15657C
15658C-----START POINT-----------------------------------------------------
15659C
15660C     CHECK THE INPUT ARGUMENTS FOR ERRORS
15661C
15662      IF(N.LT.1)THEN
15663        WRITE(ICOUT, 5)
15664        CALL DPWRST('XXX','BUG ')
15665        WRITE(ICOUT,47)N
15666        CALL DPWRST('XXX','BUG ')
15667        GOTO9000
15668      ENDIF
15669      IF(ALPHA.LT.1.0)THEN
15670        WRITE(ICOUT,16)
15671        CALL DPWRST('XXX','BUG ')
15672        WRITE(ICOUT,46)ALPHA
15673        CALL DPWRST('XXX','BUG ')
15674        GOTO9000
15675      ENDIF
15676    5 FORMAT('***** FATAL ERROR--THE NUMBER OF REQUESTED ERROR ',
15677     1'RANDOM NUMBERS IS NON-POSITIVE.')
15678   16 FORMAT('***** FATAL ERROR--THE SHAPE PARAMETER FOR THE ',
15679     1'ERROR DISTRIBUTION IS LESS THAN 1.0 *****')
15680   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
15681   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
15682C
15683C     GENERATE N ERROR RANDOM NUMBERS USING THE ALGORITHM OF
15684C     RADIKAMALLA.  THIS IS A FORTRAN IMPLEMENTATION OF THE ROUTINE
15685C     "gsl_ran_exppow" IN THE GNU GSL SCIENTIFIC LIBRARY.
15686C
15687      NTEMP=1
15688C
15689C  FIRST, HANDLE SPECIAL CASES (ALPHA = 1, 2 ARE DOUBLE EXPONENTIAL
15690C  AND NORMAL, RESPECTIVELY).
15691C
15692      IF(ALPHA.EQ.1.0)THEN
15693        CALL DEXRAN(N,ISEED,X)
15694      ELSEIF(ALPHA.EQ.2.0)THEN
15695        CALL NORRAN(N,ISEED,X)
15696C
15697C  CASE WHERE 1 < ALPHA < 2.  USE DOUBLE EXPONENTIAL DISTRIBUTION
15698C  FOR REJECTION METHOD.
15699C
15700      ELSEIF(ALPHA.GT.1.0 .AND. ALPHA.LT.2.0)THEN
15701        S=1.4489
15702        DO390I=1,N
15703  300     CONTINUE
15704            CALL DEXRAN(NTEMP,ISEED,XTEMP)
15705            AX=XTEMP(1)
15706            CALL DEXPDF(AX,AY)
15707            CALL ERRPDF(AX,ALPHA,AH)
15708            RATIO=AH/(S*AY)
15709            CALL UNIRAN(NTEMP,ISEED,XTEMP)
15710            U=XTEMP(1)
15711          IF(U.GT.RATIO)GOTO300
15712          X(I)=AX
15713  390   CONTINUE
15714C
15715C  CASE WHERE ALPHA > 2.  USE GAUSSIAN FOR FOR REJECTION METHOD.
15716C
15717      ELSE
15718        SIGMA=1.0/1.0/SQRT(2.0)
15719        S=2.4091
15720        DO490I=1,N
15721  400     CONTINUE
15722            CALL NORRAN(NTEMP,ISEED,XTEMP)
15723            AX=SIGMA*XTEMP(1)
15724            CALL NORPDF(AX/SIGMA,AY)
15725            AY=AY/SIGMA
15726            CALL ERRPDF(AX,ALPHA,AH)
15727            RATIO=AH/(S*AY)
15728            CALL UNIRAN(NTEMP,ISEED,XTEMP)
15729            U=XTEMP(1)
15730          IF(U.GT.RATIO)GOTO400
15731          X(I)=AX
15732  490   CONTINUE
15733      ENDIF
15734C
15735 9000 CONTINUE
15736      RETURN
15737      END
15738      SUBROUTINE ERRORF(IANS1,IANS2,IANS3,IANS4,AMIN,AMAX,DEF,
15739     1ANS2,IERROR)
15740C
15741C     PURPOSE--ANALYZE FLOATING POINT INPUT TERMINAL RESPONSE DURING
15742C              EXECUTION OF DATAPLOT AND
15743C              DETERMINE IF VALID.
15744C              ALSO, MAKE CONVERSION TO FLOATING POINT.
15745C     INPUT  ARGUMENTS--IANS1
15746C                     --IANS2
15747C                     --IANS3
15748C                     --IANS4
15749C                     --AMIN
15750C                     --AMAX
15751C                     --DEF
15752C     OUTPUT ARGUMENTS--ANS2
15753C                     --IERROR
15754C     WRITTEN BY--JAMES J. FILLIBEN
15755C                 STATISTICAL ENGINEERING DIVISION
15756C                 INFORMATION TECHNOLOGY LABORATORY
15757C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15758C                 GAITHERSBURG, MD 20899
15759C                 PHONE--301-975-2855
15760C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15761C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15762C     LANGUAGE--ANSI FORTRAN (1977)
15763C     VERSION NUMBER--82/7
15764C     ORIGINAL VERSION--OCTOBER 18, 1976.
15765C     UPDATED         --OCTOBER   1976.
15766C     UPDATED         --JULY      1978.
15767C     UPDATED         --OCTOBER   1978.
15768C     UPDATED         --FEBRUARY  1981.
15769C     UPDATED         --FEBRUARY  1982.
15770C     UPDATED         --MAY       1982.
15771C
15772C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15773C
15774      CHARACTER*4 IANS1
15775      CHARACTER*4 IANS2
15776      CHARACTER*4 IANS3
15777      CHARACTER*4 IANS4
15778      CHARACTER*4 IERROR
15779C
15780      CHARACTER*4 IBUG1
15781      CHARACTER*4 IBUG2
15782      CHARACTER*4 IA
15783C
15784C---------------------------------------------------------------------
15785C
15786      DIMENSION IA(20)
15787C
15788C-----COMMON----------------------------------------------------------
15789C
15790      INCLUDE 'DPCOP2.INC'
15791C
15792C-----START POINT-----------------------------------------------------
15793C
15794      ANS2=0
15795      IERROR='NO'
15796      IBUG1='OFF'
15797      IBUG2='OFF'
15798C
15799C               ************************************************************
15800C               **  DEFINE NUMASC = NUMBER OF ASCII CHARACTERS PER WORD.  **
15801C               **  THIS IS 4 REGARDLESS OF THE COMPUTER MAKE AND         **
15802C               **  REGARDLESS OF THE WORD SIZE.                          **
15803C               ************************************************************
15804C
15805      NUMASC=4
15806      NUMAS2=2*NUMASC
15807      NUMAS3=3*NUMASC
15808C
15809C               *******************************
15810C               **  STEP 1--                 **
15811C               **  CHECK FOR BLANK ENTRIES  **
15812C               *******************************
15813C
15814      IF(IANS1.EQ.'    '.AND.IANS2.EQ.'    '.AND.IANS3.EQ.'    '.AND.
15815     1IANS4.EQ.'    ')GOTO105
15816      GOTO110
15817  105 CONTINUE
15818      ANS2=DEF
15819      IF(AMIN.LE.ANS2.AND.ANS2.LE.AMAX)GOTO9000
15820      GOTO1750
15821  110 CONTINUE
15822C
15823C               *******************************************************
15824C               **  STEP 2--                                         **
15825C               **  DECOMPOSE THE INPUT WORDS                        **
15826C               **  IANS1, IANS2, IANS3, AND IANS4                   **
15827C               **  INTO 16 NUMBPC-BIT CHUNKS                        **
15828C               **  WHERE NUMBPC = NUMBER OF BITS PER CHARACTER      **
15829C               **  FOR THIS COMPUTER.                               **
15830C               **  EACH NUMBPC-BIT CHUNK WILL (BY CONSTRUCTION)     **
15831C               **  BE STORED                                        **
15832C               **  IN A LEFT-JUSTIFIED FASHION IN IA(.)             **
15833C               **  WITH (BY CONSTRUCTION) BLANK-FILL TO THE RIGHT.  **
15834C               *******************************************************
15835C
15836      DO150I=1,16
15837      IA(I)='    '
15838  150 CONTINUE
15839      DO200I=1,4
15840      ISTAR3=NUMBPC*(I-1)
15841      ISTAR3=IABS(ISTAR3)
15842      I1=I
15843      I2=I1+NUMASC
15844      I3=I1+NUMAS2
15845      I4=I1+NUMAS3
15846      CALL DPCHEX(ISTAR3,NUMBPC,IANS1,0,NUMBPC,IA(I1))
15847      CALL DPCHEX(ISTAR3,NUMBPC,IANS2,0,NUMBPC,IA(I2))
15848      CALL DPCHEX(ISTAR3,NUMBPC,IANS3,0,NUMBPC,IA(I3))
15849      CALL DPCHEX(ISTAR3,NUMBPC,IANS4,0,NUMBPC,IA(I4))
15850  200 CONTINUE
15851      IF(IBUG1.EQ.'OFF')GOTO350
15852      DO300I=1,16
15853      WRITE(ICOUT,305)IA(I)
15854  305 FORMAT(A4)
15855      CALL DPWRST('XXX','BUG ')
15856  300 CONTINUE
15857  350 CONTINUE
15858C
15859C               **********************************************
15860C               **  STEP 3--                                **
15861C               **  CHECK FOR AN EXIT, END, STOP, OR TERM.  **
15862C               **********************************************
15863C
15864      DO500I=1,16
15865      IP1=I+1
15866      IP2=I+2
15867      IP3=I+3
15868      IF(IA(I).EQ.'E'.AND.IA(IP1).EQ.'X'.AND.IA(IP2).EQ.'I'
15869     1.AND.IA(IP3).EQ.'T')GOTO510
15870      IF(IA(I).EQ.'E'.AND.IA(IP1).EQ.'N'.AND.IA(IP2).EQ.'D')
15871     1GOTO510
15872      IF(IA(I).EQ.'S'.AND.IA(IP1).EQ.'T'.AND.IA(IP2).EQ.'O'
15873     1.AND.IA(IP3).EQ.'P')GOTO510
15874      IF(IA(I).EQ.'T'.AND.IA(IP1).EQ.'E'.AND.IA(IP2).EQ.'R'
15875     1.AND.IA(IP3).EQ.'M')GOTO510
15876  500 CONTINUE
15877      GOTO550
15878  510 WRITE(ICOUT,520)
15879  520 FORMAT('THIS IS AN EXIT FROM DATAPLOT ')
15880      CALL DPWRST('XXX','BUG ')
15881      STOP
15882  550 CONTINUE
15883C
15884C               *********************************
15885C               **  STEP 4--                   **
15886C               **  CONVERT TO FLOATING POINT  **
15887C               *********************************
15888C
15889C               ************************************************************
15890C               **  STEP 4.1--                                            **
15891C               **  FIRST OF ALL, LOCATE THE DECIMAL POINT (IF EXISTENT)  **
15892C               ************************************************************
15893C
15894      ILOC=0
15895      IDECPT=0
15896      DO1000I=1,16
15897      IF(IA(I).EQ.'.')ILOC=I
15898      IF(IA(I).EQ.'.')IDECPT=IDECPT+1
15899 1000 CONTINUE
15900      IF(IDECPT.GE.2)GOTO1530
15901      IF(IDECPT.EQ.1)GOTO1150
15902      DO1100I=1,16
15903      IREV=16-I+1
15904      IF(IA(IREV).EQ.' ')GOTO1100
15905      IF(IA(IREV).EQ.'0')GOTO1110
15906      IF(IA(IREV).EQ.'1')GOTO1110
15907      IF(IA(IREV).EQ.'2')GOTO1110
15908      IF(IA(IREV).EQ.'3')GOTO1110
15909      IF(IA(IREV).EQ.'4')GOTO1110
15910      IF(IA(IREV).EQ.'5')GOTO1110
15911      IF(IA(IREV).EQ.'6')GOTO1110
15912      IF(IA(IREV).EQ.'7')GOTO1110
15913      IF(IA(IREV).EQ.'8')GOTO1110
15914      IF(IA(IREV).EQ.'9')GOTO1110
15915      IF(IA(IREV).EQ.'+')GOTO1530
15916      IF(IA(IREV).EQ.'-')GOTO1530
15917 1100 CONTINUE
15918      GOTO1530
15919 1110 ILOC=IREV+1
15920 1150 CONTINUE
15921      IF(IBUG2.EQ.'ON')WRITE(ICOUT,1111)ILOC,IDECPT
15922 1111 FORMAT('ILOC = ',I8,'    IDECPT = ',I8)
15923      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
15924C
15925C               *******************************************************
15926C               **  STEP 4.2--                                       **
15927C               **  SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE  **
15928C               *******************************************************
15929C
15930      SIGN=1.0
15931      IDIGI=0
15932      ISIGN=0
15933      SUMI=0
15934      ILOCM1=ILOC-1
15935      IF(ILOCM1.LT.1)GOTO1250
15936      DO1200I=1,ILOCM1
15937      IREV=ILOCM1-I+1
15938      IF(IA(IREV).EQ.' ')GOTO1200
15939      IF(IA(IREV).EQ.'0')GOTO1210
15940      IF(IA(IREV).EQ.'1')GOTO1211
15941      IF(IA(IREV).EQ.'2')GOTO1212
15942      IF(IA(IREV).EQ.'3')GOTO1213
15943      IF(IA(IREV).EQ.'4')GOTO1214
15944      IF(IA(IREV).EQ.'5')GOTO1215
15945      IF(IA(IREV).EQ.'6')GOTO1216
15946      IF(IA(IREV).EQ.'7')GOTO1217
15947      IF(IA(IREV).EQ.'8')GOTO1218
15948      IF(IA(IREV).EQ.'9')GOTO1219
15949      IF(IA(IREV).EQ.'+')GOTO1220
15950      IF(IA(IREV).EQ.'-')GOTO1221
15951      GOTO1530
15952 1210 ITERM=0
15953      GOTO1225
15954 1211 ITERM=1
15955      GOTO1225
15956 1212 ITERM=2
15957      GOTO1225
15958 1213 ITERM=3
15959      GOTO1225
15960 1214 ITERM=4
15961      GOTO1225
15962 1215 ITERM=5
15963      GOTO1225
15964 1216 ITERM=6
15965      GOTO1225
15966 1217 ITERM=7
15967      GOTO1225
15968 1218 ITERM=8
15969      GOTO1225
15970 1219 ITERM=9
15971      GOTO1225
15972 1220 ISIGN=ISIGN+1
15973      GOTO1200
15974 1221 ISIGN=ISIGN+1
15975      SIGN=-SIGN
15976      GOTO1200
15977 1225 IDIGI=IDIGI+1
15978      TERM=ITERM
15979      IEXP=IDIGI-1
15980      SUMI=SUMI+TERM*(10.0**IEXP)
15981 1200 CONTINUE
15982 1250 CONTINUE
15983      IF(ISIGN.GE.2)GOTO1530
15984      IF(IBUG2.EQ.'ON')WRITE(ICOUT,1255)IDIGI,SUMI
15985 1255 FORMAT('IDIGI = ',I8,'    SUMI = ',F20.10)
15986      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
15987C
15988C               ******************************************************
15989C               **  STEP 4.3--                                      **
15990C               **  THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE  **
15991C               ******************************************************
15992C
15993      IDIGD=0
15994      SUMD=0.0
15995      ILOCP1=ILOC+1
15996      IF(ILOCP1.GT.16)GOTO1350
15997      DO1300I=ILOCP1,16
15998      IF(IA(I).EQ.' ')GOTO1300
15999      IF(IA(I).EQ.'0')GOTO1310
16000      IF(IA(I).EQ.'1')GOTO1311
16001      IF(IA(I).EQ.'2')GOTO1312
16002      IF(IA(I).EQ.'3')GOTO1313
16003      IF(IA(I).EQ.'4')GOTO1314
16004      IF(IA(I).EQ.'5')GOTO1315
16005      IF(IA(I).EQ.'6')GOTO1316
16006      IF(IA(I).EQ.'7')GOTO1317
16007      IF(IA(I).EQ.'8')GOTO1318
16008      IF(IA(I).EQ.'9')GOTO1319
16009      GOTO1530
16010 1310 ITERM=0
16011      GOTO1325
16012 1311 ITERM=1
16013      GOTO1325
16014 1312 ITERM=2
16015      GOTO1325
16016 1313 ITERM=3
16017      GOTO1325
16018 1314 ITERM=4
16019      GOTO1325
16020 1315 ITERM=5
16021      GOTO1325
16022 1316 ITERM=6
16023      GOTO1325
16024 1317 ITERM=7
16025      GOTO1325
16026 1318 ITERM=8
16027      GOTO1325
16028 1319 ITERM=9
16029      GOTO1325
16030 1325 IDIGD=IDIGD+1
16031      TERM=ITERM
16032      SUMD=SUMD+TERM/(10.0**IDIGD)
16033 1300 CONTINUE
16034 1350 CONTINUE
16035      IF(IBUG2.EQ.'ON')WRITE(ICOUT,1355)IDIGD,SUMD
16036 1355 FORMAT('IDIGD = ',I8,'    SUMD = ',F20.10)
16037      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
16038      IDIGT=IDIGI+IDIGD
16039      IF(IDIGT.LE.0)GOTO1530
16040      ANS2=SUMI+SUMD
16041      IF(SIGN.LT.0.0)ANS2=-ANS2
16042      IF(AMIN.LE.ANS2.AND.ANS2.LE.AMAX)GOTO9000
16043      GOTO1750
16044C
16045 1530 CONTINUE
16046      WRITE(ICOUT,1531)
16047 1531 FORMAT('***** ERROR IN ERRORF--LAST ENTRY WAS ',
16048     1'INVALID ***')
16049      CALL DPWRST('XXX','BUG ')
16050      WRITE(ICOUT,1532)
16051 1532 FORMAT('      IT SHOULD HAVE BEEN SOME INTEGER OR ')
16052      CALL DPWRST('XXX','BUG ')
16053      WRITE(ICOUT,1533)
16054 1533 FORMAT('      FLOATING POINT NUMBER, BUT WAS NOT.')
16055      CALL DPWRST('XXX','BUG ')
16056      WRITE(ICOUT,1534)IANS1,IANS2,IANS3,IANS4
16057 1534 FORMAT('      THE ENTRY WAS ',4A4)
16058      CALL DPWRST('XXX','BUG ')
16059      WRITE(ICOUT,1535)
16060 1535 FORMAT('      REENTER PROPER VALUE NOW--')
16061      CALL DPWRST('XXX','BUG ')
16062      IERROR='YES'
16063      GOTO9000
16064C
16065 1750 CONTINUE
16066      WRITE(ICOUT,1531)
16067      CALL DPWRST('XXX','BUG ')
16068      WRITE(ICOUT,1752)
16069      CALL DPWRST('XXX','BUG ')
16070      WRITE(ICOUT,1753)
16071      CALL DPWRST('XXX','BUG ')
16072      WRITE(ICOUT,1754)AMIN,AMAX
16073      CALL DPWRST('XXX','BUG ')
16074      WRITE(ICOUT,1755)
16075      CALL DPWRST('XXX','BUG ')
16076      WRITE(ICOUT,1734)IANS1,IANS2,IANS3,IANS4
16077 1734 FORMAT('      THE ENTRY WAS ',4A4)
16078      CALL DPWRST('XXX','BUG ')
16079      WRITE(ICOUT,1735)
16080 1735 FORMAT('      REENTER PROPER VALUE NOW--')
16081      CALL DPWRST('XXX','BUG ')
16082 1752 FORMAT('      IT SHOULD HAVE BEEN SOME INTEGER OR ')
16083 1753 FORMAT('      FLOATING POINT NUMBER ')
16084 1754 FORMAT('      BETWEEN ',E15.7,' AND ',E15.7,' (INCLUSIVE),')
16085 1755 FORMAT('      BUT WAS NOT.')
16086      IERROR='YES'
16087      GOTO9000
16088C
16089C               *****************
16090C               **  STEP 90--  **
16091C               **  EXIT       **
16092C               *****************
16093C
16094 9000 CONTINUE
16095      RETURN
16096      END
16097      subroutine ess(y,n,len,ideg,njump,userw,rw,ys,res)
16098c
16099c  This routine is part of the Bill Cleveland seasonal loess
16100c  program.
16101c
16102      integer n, len, ideg, njump, newnj, nleft, nright, nsh, k, i, j
16103      real y(n), rw(n), ys(n), res(n), delta
16104      logical ok, userw
16105      if(.not.(n .lt. 2))goto 23019
16106      ys(1) = y(1)
16107      return
1610823019 continue
16109      newnj = min0(njump, n-1)
16110      if(.not.(len .ge. n))goto 23021
16111      nleft = 1
16112      nright = n
16113      do 23023 i = 1,n,newnj
16114      call est(y,n,len,ideg,float(i),ys(i),nleft,nright,res,userw,rw,ok)
16115      if(.not.( .not. ok))goto 23025
16116      ys(i) = y(i)
1611723025 continue
1611823023 continue
16119      goto 23022
1612023021 continue
16121      if(.not.(newnj .eq. 1))goto 23027
16122      nsh = (len+1)/2
16123      nleft = 1
16124      nright = len
16125      do 23029 i = 1,n
16126      if(.not.(i .gt. nsh  .and.  nright .ne. n))goto 23031
16127      nleft = nleft+1
16128      nright = nright+1
1612923031 continue
16130      call est(y,n,len,ideg,float(i),ys(i),nleft,nright,res,userw,rw,ok)
16131      if(.not.( .not. ok))goto 23033
16132      ys(i) = y(i)
1613323033 continue
1613423029 continue
16135      goto 23028
1613623027 continue
16137      nsh = (len+1)/2
16138      do 23035 i = 1,n,newnj
16139      if(.not.(i .lt. nsh))goto 23037
16140      nleft = 1
16141      nright = len
16142      goto 23038
1614323037 continue
16144      if(.not.(i .ge. n-nsh+1))goto 23039
16145      nleft = n-len+1
16146      nright = n
16147      goto 23040
1614823039 continue
16149      nleft = i-nsh+1
16150      nright = len+i-nsh
1615123040 continue
1615223038 continue
16153      call est(y,n,len,ideg,float(i),ys(i),nleft,nright,res,userw,rw,ok)
16154      if(.not.( .not. ok))goto 23041
16155      ys(i) = y(i)
1615623041 continue
1615723035 continue
1615823028 continue
1615923022 continue
16160      if(.not.(newnj .ne. 1))goto 23043
16161      do 23045 i = 1,n-newnj,newnj
16162      delta = (ys(i+newnj)-ys(i))/float(newnj)
16163      do 23047 j = i+1,i+newnj-1
16164      ys(j) = ys(i)+delta*float(j-i)
1616523047 continue
1616623045 continue
16167      k = ((n-1)/newnj)*newnj+1
16168      if(.not.(k .ne. n))goto 23049
16169      call est(y,n,len,ideg,float(n),ys(n),nleft,nright,res,userw,rw,ok)
16170      if(.not.( .not. ok))goto 23051
16171      ys(n) = y(n)
1617223051 continue
16173      if(.not.(k .ne. n-1))goto 23053
16174      delta = (ys(n)-ys(k))/float(n-k)
16175      do 23055 j = k+1,n-1
16176      ys(j) = ys(k)+delta*float(j-k)
1617723055 continue
1617823053 continue
1617923049 continue
1618023043 continue
16181      return
16182      end
16183      DOUBLE PRECISION FUNCTION esum(mu,x)
16184C-----------------------------------------------------------------------
16185C                    EVALUATION OF EXP(MU + X)
16186C-----------------------------------------------------------------------
16187C     .. Scalar Arguments ..
16188      DOUBLE PRECISION x
16189      INTEGER mu
16190C     ..
16191C     .. Local Scalars ..
16192      DOUBLE PRECISION w
16193C     ..
16194C     .. Intrinsic Functions ..
16195      INTRINSIC exp
16196C     ..
16197C     .. Executable Statements ..
16198
16199      IF (x.GT.0.0D0) GO TO 10
16200C
16201      IF (mu.LT.0) GO TO 20
16202      w = mu + x
16203      IF (w.GT.0.0D0) GO TO 20
16204      esum = exp(w)
16205      RETURN
16206C
16207   10 IF (mu.GT.0) GO TO 20
16208      w = mu + x
16209      IF (w.LT.0.0D0) GO TO 20
16210      esum = exp(w)
16211      RETURN
16212C
16213   20 w = mu
16214      esum = exp(w)*exp(x)
16215      RETURN
16216
16217      END
16218      subroutine est(y,n,len,ideg,xs,ys,nleft,nright,w,userw,rw,ok)
16219c
16220c  This routine is part of the Bill Cleveland seasonal loess
16221c  program.
16222c
16223      integer n, len, ideg, nleft, nright, j
16224      real y(n), w(n), rw(n), xs, ys, range, h, h1, h9, a, b, c, r
16225      logical userw,ok
16226      range = float(n)-float(1)
16227      h = amax1(xs-float(nleft),float(nright)-xs)
16228      if(.not.(len .gt. n))goto 23057
16229      h = h+float((len-n)/2)
1623023057 continue
16231      h9 = .999*h
16232      h1 = .001*h
16233      a = 0.0
16234      do 23059 j = nleft,nright
16235      w(j) = 0.
16236      r = abs(float(j)-xs)
16237      if(.not.(r .le. h9))goto 23061
16238      if(.not.(r .le. h1))goto 23063
16239      w(j) = 1.
16240      goto 23064
1624123063 continue
16242      w(j) = (1.0-(r/h)**3)**3
1624323064 continue
16244      if(.not.(userw))goto 23065
16245      w(j) = rw(j)*w(j)
1624623065 continue
16247      a = a+w(j)
1624823061 continue
1624923059 continue
16250      if(.not.(a .le. 0.0))goto 23067
16251      ok = .false.
16252      goto 23068
1625323067 continue
16254      ok = .true.
16255      do 23069 j = nleft,nright
16256      w(j) = w(j)/a
1625723069 continue
16258      if(.not.((h .gt. 0.) .and. (ideg .gt. 0)))goto 23071
16259      a = 0.0
16260      do 23073 j = nleft,nright
16261      a = a+w(j)*float(j)
1626223073 continue
16263      b = xs-a
16264      c = 0.0
16265      do 23075 j = nleft,nright
16266      c = c+w(j)*(float(j)-a)**2
1626723075 continue
16268      if(.not.(sqrt(c) .gt. .001*range))goto 23077
16269      b = b/c
16270      do 23079 j = nleft,nright
16271      w(j) = w(j)*(b*(float(j)-a)+1.0)
1627223079 continue
1627323077 continue
1627423071 continue
16275      ys = 0.0
16276      do 23081 j = nleft,nright
16277      ys = ys+w(j)*y(j)
1627823081 continue
1627923068 continue
16280      return
16281      end
16282      SUBROUTINE EV1CDF(X,MINMAX,CDF)
16283C
16284C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
16285C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
16286C              DISTRIBUTION.
16287C              THE EXTREME VALUE TYPE 1 DISTRIBUTION USED
16288C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
16289C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
16290C              THIS DISTRIBUTION IS DEFINED FOR ALL X
16291C              AND HAS THE PROBABILITY DENSITY FUNCTION
16292C              FOR THE MAXIMUM ORDER STATISTIC
16293C              F(X) = (EXP(-X)) * (EXP(-(EXP(-X))))
16294C              WHICH SIMPLIFIES TO:
16295C              F(X) = EXP(-X - EXP(-X))
16296C              FOR THE MINIMUIM ORDER STATISTIC
16297C              F(X) = (EXP(X)) * (EXP(-(EXP(X))))
16298C              WHICH SIMPLIFIES TO:
16299C              F(X) = EXP(X-EXP(X))
16300C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
16301C                                AT WHICH THE CUMULATIVE DISTRIBUTION
16302C                                FUNCTION IS TO BE EVALUATED.
16303C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
16304C                                DISTRIBUTION FUNCTION VALUE.
16305C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
16306C             FUNCTION VALUE CDF FOR THE EXTREME VALUE TYPE 1
16307C             DISTRIBUTION WITH MEAN = EULER'S NUMBER = 0.57721566
16308C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
16309C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
16310C     RESTRICTIONS--NONE.
16311C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
16312C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
16313C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
16314C     LANGUAGE--ANSI FORTRAN.
16315C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
16316C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
16317C     WRITTEN BY--JAMES J. FILLIBEN
16318C                 STATISTICAL ENGINEERING LABORATORY (205.03)
16319C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16320C                 GAITHERSBURG, MD 20899
16321C                 PHONE:  301-921-2315
16322C     ORIGINAL VERSION--APRIL     1994.
16323C     UPDATED         --JULY      2005. CODE IN DOUBLE PRECIONS FOR
16324C                                       BETTER ACCURACY
16325C
16326C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16327C
16328C---------------------------------------------------------------------
16329C
16330      DOUBLE PRECISION DX
16331      DOUBLE PRECISION DCDF
16332C
16333      INCLUDE 'DPCOP2.INC'
16334C
16335C---------------------------------------------------------------------
16336C
16337C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
16338C     NO INPUT ARGUMENT ERRORS POSSIBLE
16339C     FOR THIS DISTRIBUTION.
16340C
16341C-----START POINT-----------------------------------------------------
16342C
16343      DX=DBLE(X)
16344      DCDF=0.0D0
16345      IF(MINMAX.EQ.1)THEN
16346        DCDF=1.0D0-DEXP(-(DEXP(DX)))
16347      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
16348        DCDF=DEXP(-(DEXP(-DX)))
16349      ELSE
16350         WRITE(ICOUT,1800)
16351 1800    FORMAT('*****ERROR IN EV1CDF--MINMAX NOT 1 OR 2')
16352         CALL DPWRST('XXX','BUG ')
16353      END IF
16354      CDF=REAL(DCDF)
16355C
16356      RETURN
16357      END
16358      SUBROUTINE EV1CDD(X,MINMAX,CDF)
16359C
16360C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
16361C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
16362C              DISTRIBUTION.
16363C              THE EXTREME VALUE TYPE 1 DISTRIBUTION USED
16364C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
16365C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
16366C              THIS DISTRIBUTION IS DEFINED FOR ALL X
16367C              AND HAS THE PROBABILITY DENSITY FUNCTION
16368C              FOR THE MAXIMUM ORDER STATISTIC
16369C              F(X) = (EXP(-X)) * (EXP(-(EXP(-X))))
16370C              WHICH SIMPLIFIES TO:
16371C              F(X) = EXP(-X - EXP(-X))
16372C              FOR THE MINIMUIM ORDER STATISTIC
16373C              F(X) = (EXP(X)) * (EXP(-(EXP(X))))
16374C              WHICH SIMPLIFIES TO:
16375C              F(X) = EXP(X-EXP(X))
16376C     NOTE  --THIS IS A DOUBLE PRECISION VERSION OF EV1CDF USED
16377C             IN CALCULATING HAZARD FUNCTIONS.
16378C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
16379C                                AT WHICH THE CUMULATIVE DISTRIBUTION
16380C                                FUNCTION IS TO BE EVALUATED.
16381C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
16382C                                DISTRIBUTION FUNCTION VALUE.
16383C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
16384C             FUNCTION VALUE CDF FOR THE EXTREME VALUE TYPE 1
16385C             DISTRIBUTION WITH MEAN = EULER'S NUMBER = 0.57721566
16386C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
16387C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
16388C     RESTRICTIONS--NONE.
16389C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
16390C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
16391C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
16392C     LANGUAGE--ANSI FORTRAN.
16393C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
16394C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
16395C     WRITTEN BY--JAMES J. FILLIBEN
16396C                 STATISTICAL ENGINEERING LABORATORY (205.03)
16397C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16398C                 GAITHERSBURG, MD 20899
16399C                 PHONE:  301-921-2315
16400C     ORIGINAL VERSION--APRIL     1994.
16401C
16402C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16403C
16404      DOUBLE PRECISION X
16405      DOUBLE PRECISION CDF
16406C
16407C-----COMMON----------------------------------------------------------
16408C
16409      INCLUDE 'DPCOP2.INC'
16410C
16411C---------------------------------------------------------------------
16412C
16413C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
16414C     NO INPUT ARGUMENT ERRORS POSSIBLE
16415C     FOR THIS DISTRIBUTION.
16416C
16417C-----START POINT-----------------------------------------------------
16418C
16419      IF(MINMAX.EQ.1)THEN
16420        CDF=1.0D0-DEXP(-(DEXP(X)))
16421      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
16422        CDF=DEXP(-(DEXP(-X)))
16423      ELSE
16424         WRITE(ICOUT,1800)
16425 1800    FORMAT('*****ERROR IN EV1CDF--MINMAX NOT 1 OR 2')
16426         CALL DPWRST('XXX','BUG ')
16427      END IF
16428C
16429      RETURN
16430      END
16431      SUBROUTINE EV1CHA(X,MINMAX,HAZ)
16432C
16433C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE HAZARD
16434C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
16435C              DISTRIBUTION.
16436C              THE EXTREME VALUE TYPE 1 DISTRIBUTION USED
16437C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
16438C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
16439C              THIS DISTRIBUTION IS DEFINED FOR ALL X
16440C              AND HAS THE PROBABILITY DENSITY FUNCTION
16441C              FOR THE MAXIMUM ORDER STATISTIC
16442C              F(X) = (EXP(-X)) * (EXP(-(EXP(-X))))
16443C              WHICH SIMPLIFIES TO:
16444C              F(X) = EXP(-X - EXP(-X))
16445C              FOR THE MINIMUIM ORDER STATISTIC
16446C              F(X) = (EXP(X)) * (EXP(-(EXP(X))))
16447C              WHICH SIMPLIFIES TO:
16448C              F(X) = EXP(-X - EXP(-X))
16449C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
16450C                                AT WHICH THE CUMULATIVE DISTRIBUTION
16451C                                FUNCTION IS TO BE EVALUATED.
16452C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION CUMULATIVE HAZARD
16453C                                FUNCTION VALUE.
16454C     OUTPUT--THE SINGLE PRECISION CUMULATIVE HAZARD
16455C             FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
16456C             DISTRIBUTION WITH MEAN = EULER'S NUMBER = 0.57721566
16457C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
16458C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
16459C     RESTRICTIONS--NONE.
16460C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
16461C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
16462C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
16463C     LANGUAGE--ANSI FORTRAN.
16464C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
16465C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
16466C     WRITTEN BY--JAMES J. FILLIBEN
16467C                 STATISTICAL ENGINEERING LABORATORY (205.03)
16468C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16469C                 GAITHERSBURG, MD 20899
16470C                 PHONE:  301-975-2899
16471C     ORIGINAL VERSION--APRIL     1998.
16472C     UPDATED         --JUNE      1999. SIMPLIFY FORMULAS
16473C
16474C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16475C
16476CCCCC DOUBLE PRECISION CDF
16477      DOUBLE PRECISION DX
16478      DOUBLE PRECISION DTERM1
16479      DOUBLE PRECISION DTERM2
16480C
16481C-----COMMON----------------------------------------------------------
16482C
16483      INCLUDE 'DPCOP2.INC'
16484C
16485C---------------------------------------------------------------------
16486C
16487C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
16488C     NO INPUT ARGUMENT ERRORS POSSIBLE
16489C     FOR THIS DISTRIBUTION.
16490C
16491C-----START POINT-----------------------------------------------------
16492C
16493      IF(MINMAX.EQ.1)THEN
16494        HAZ=EXP(X)
16495CCCCC   CALL EV1CDD(DBLE(X),MINMAX,CDF)
16496CCCCC   IF(1.0D0-CDF.LE.0.0D0)THEN
16497CCCCC     WRITE(ICOUT,1100)
16498C1100     FORMAT('*****ERROR IN EV1CHA--CDF ESSENTIALLY 1.')
16499CCCCC     CALL DPWRST('XXX','BUG ')
16500CCCCC   ELSE
16501CCCCC     HAZ=REAL(-DLOG(1.0D0-CDF))
16502CCCCC   ENDIF
16503      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
16504        DX=DBLE(X)
16505        DTERM1=DEXP(-DEXP(-DX))
16506        DTERM2=1.0D0-DTERM1
16507        IF(DTERM2.GT.0.0D0)THEN
16508          HAZ=REAL(-DLOG(DTERM2))
16509        ELSE
16510          WRITE(ICOUT,1100)
16511          CALL DPWRST('XXX','BUG ')
16512          HAZ=0.0
16513        ENDIF
16514 1100   FORMAT('*****ERROR IN EV1CHA--UNABLE TO COMPUTE CUMULATIVE',
16515     1         'HAZARD FUNCTION.')
16516CCCCC   CALL EV1CDD(DBLE(X),MINMAX,CDF)
16517CCCCC   IF(1.0D0-CDF.LE.0.0D0)THEN
16518CCCCC     WRITE(ICOUT,1100)
16519CCCCC     CALL DPWRST('XXX','BUG ')
16520CCCCC   ELSE
16521CCCCC     HAZ=REAL(-DLOG(1.0D0-CDF))
16522CCCCC   ENDIF
16523      ELSE
16524        HAZ=0.0
16525        WRITE(ICOUT,1800)
16526 1800   FORMAT('*****ERROR IN EV1CHA--MINMAX NOT 1 OR 2')
16527        CALL DPWRST('XXX','BUG ')
16528      END IF
16529C
16530      RETURN
16531      END
16532      SUBROUTINE EV1EST(X,NOBS,ALOC,SCALE,ALOC2,SCALE2,MINMAX,IERROR)
16533C
16534C  COMPUTE MLES FOR SCALE PARAMETER (SCALE) AND LOCATION
16535C  PARAMETER (ALOC) BY SOLVING THE EQUATION
16536C     G(SCALE)=0, WHERE G IS
16537C  A MONOTONICALLY INCREASING FUNCTION OF SCALE.
16538C  THE INITIAL ESTIMATE IS THE METHOD OF MOMENTS ESTIMATOR
16539C  AND THE TOLERANCE IS   :   2*RI/(10**6).
16540C
16541      DIMENSION X(*)
16542C
16543      REAL GFM, GFM2
16544      REAL SCALEL, SCALEH, SCALEM
16545      REAL TOL
16546C
16547      CHARACTER*4 IBUGA3
16548      CHARACTER*4 IWRITE
16549      CHARACTER*4 IERROR
16550C
16551      IERROR='NO'
16552      RN=REAL(NOBS)
16553      SCALEL=0.0
16554      SCALEH=0.0
16555C
16556C  USE METHOD OF MOMENTS TO GET INITAL ESTIMATES OF LOCATION AND SCALE
16557C
16558      IBUGA3='OFF'
16559      IWRITE='OFF'
16560      CALL MEAN(X,NOBS,IWRITE,XMEAN,IBUGA3,IERROR)
16561      CALL SD(X,NOBS,IWRITE,XSD,IBUGA3,IERROR)
16562      SCALEM=SQRT(1.645)*XSD
16563      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
16564        ALOCM=XMEAN-0.5772*XSD
16565      ELSE
16566        ALOCM=XMEAN+0.5772*XSD
16567      ENDIF
16568      ALOC2=ALOCM
16569      SCALE2=SCALEM
16570C
16571      TOL=2.0*.000001*SCALEM
16572      CALL EV1FUN(X,NOBS,XMEAN,ALOCM,SCALEM,GFM,MINMAX)
16573C
16574C  IF G(SCALEM) .GE. 0, DIVIDE THE INITIAL ESTIMATE BY 2 UNTIL
16575C  THE ROOT IS BRACKETED BY SCALEL AND SCALEH.
16576C
16577      IF(GFM.GE.0.0D0)THEN
16578           SCALEH=SCALEM/2.0
16579           CALL EV1FUN(X,NOBS,XMEAN,ALOCM,SCALEM,GFM2,MINMAX)
16580           DCONST=2.0
16581           IF(GFM2.GT.GFM)DCONST=0.5
16582           DO 3 J=1,200
16583                SCALEH=SCALEM
16584                SCALEM=SCALEM/DCONST
16585                CALL EV1FUN(X,NOBS,XMEAN,ALOCM,SCALEM,GFM,MINMAX)
16586                IF(GFM.LE.0.0)GO TO 4
16587    3      CONTINUE
16588           IERROR='YES'
16589           GOTO9999
16590    4      CONTINUE
16591           SCALEL=SCALEM
16592C
16593C  IF G(SCALEM) .LT. 0, MULTIPLY THE INITIAL ESTIMATE BY 2 UNTIL
16594C  THE ROOT IS BRACKETED BY SCALEL AND SCALEH.
16595      ELSEIF(GFM.LT.0.0)THEN
16596           SCALEH=SCALEM/2.0
16597           CALL EV1FUN(X,NOBS,XMEAN,ALOCM,SCALEM,GFM2,MINMAX)
16598           DCONST=2.0
16599           IF(GFM2.LT.GFM)DCONST=0.5
16600           DO 7 J=1,2000
16601                SCALEL=SCALEM
16602                SCALEM=SCALEM*DCONST
16603                CALL EV1FUN(X,NOBS,XMEAN,ALOCM,SCALEM,GFM,MINMAX)
16604                IF(GFM.GE.0.0D0)GO TO 8
16605    7      CONTINUE
16606           IERROR='YES'
16607           GOTO9999
16608    8      CONTINUE
16609           SCALEH=SCALEM
16610      ENDIF
16611C
16612C SOLVE THE EQUATION G(SCALE)=0 FOR SCALE BY BISECTING THE
16613C   INTERVAL (SCALEL,SCALEH) UNTIL THE TOLERANCE IS MET
16614      MAXIT=20000
16615      NIT=0
16616   10 CONTINUE
16617      SCALEM=(SCALEL+SCALEH)/2.0
16618      CALL EV1FUN(X,NOBS,XMEAN,ALOCM,SCALEM,GFM,MINMAX)
16619      IF(GFM.GE.0.0)THEN
16620           SCALEH=SCALEM
16621      ENDIF
16622      IF(GFM.LT.0.0)THEN
16623           SCALEL=SCALEM
16624      ENDIF
16625      NIT=NIT+1
16626C
16627      IF(NIT.GT.MAXIT)THEN
16628        IERROR='YES'
16629        SCALE=(SCALEL+SCALEH)/2.0
16630        ALOC=ALOCM
16631        GOTO9999
16632      ENDIF
16633C
16634      IF(SCALEH-SCALEL.GT.TOL)GO TO 10
16635C
16636      SCALE=(SCALEL+SCALEH)/2.0
16637      ALOC=ALOCM
16638C
16639 9999 CONTINUE
16640      RETURN
16641      END
16642      SUBROUTINE EV1FUN(X,N,XMEAN,ALOC,SCALE,EV1VAL,MINMAX)
16643C
16644C   COMPUTE G FUNCTION USED IN ESTIMATING THE SHAPE AND SCALE
16645C   PARAMETERS FOR EV1 DISTRIBUTION.
16646C
16647      DOUBLE PRECISION DN, DSUM1, DSUM2, DTERM1, DX, DSCALE
16648      DIMENSION X(*)
16649C
16650C  CALCULATE SOME INTERMEDIATE VALUES
16651C
16652      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
16653        DN=DBLE(N)
16654        DSCALE=DBLE(SCALE)
16655        DSUM1=0.0
16656        DSUM2=0.0
16657        DO100I=1,N
16658          DX=DBLE(X(I))
16659          DSUM1=DSUM1 + DEXP(-DX/DSCALE)
16660          DSUM2=DSUM2 + DX*DEXP(-DX/DSCALE)
16661  100   CONTINUE
16662C
16663        ALOC=-SCALE*DLOG(DSUM1/DN)
16664C
16665        DTERM1=DBLE(XMEAN) - DSUM2/DSUM1
16666        EV1VAL=SCALE - REAL(DTERM1)
16667C
16668      ELSE
16669        DN=DBLE(N)
16670        DSCALE=DBLE(SCALE)
16671        DSUM1=0.0
16672        DSUM2=0.0
16673        DO200I=1,N
16674          DX=DBLE(X(I))
16675          DSUM1=DSUM1 + DEXP(DX/DSCALE)
16676          DSUM2=DSUM2 + DX*DEXP(DX/DSCALE)
16677  200   CONTINUE
16678C
16679        ALOC=SCALE*DLOG(DSUM1/DN)
16680C
16681        DTERM1=-DBLE(XMEAN) + DSUM2/DSUM1
16682        EV1VAL=SCALE - REAL(DTERM1)
16683C
16684      ENDIF
16685      RETURN
16686      END
16687      DOUBLE PRECISION FUNCTION EV1FU2 (SHAT,X)
16688C
16689C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE MAXIMUM LIKELIHOOD
16690C              ESTIMATE OF THE SCALE PARAMETER FOR THE GUMBEL
16691C              MODEL FOR FULL SAMPLE DATA (NO CENSORING).  THIS
16692C              FUNCTION FINDS THE ROOT OF THE EQUATION:
16693C
16694C              FOR THE MAXIMUM CASE:
16695C
16696C                 SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(-X(I)/SHAT)]/
16697C                        SUM[i=1 to N][EXP(-X(I)/SHAT)] = 0
16698C
16699C              FOR THE MINIMUM CASE:
16700C
16701C                 SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(X(I)/SHAT)]/
16702C                        SUM[i=1 to N][EXP(X(I)/SHAT)] = 0
16703C
16704C              WITH
16705C
16706C                 SHAT     = CURRENT ESTIMATE OF SCALE PARAMETER
16707C                 XBAR     = SAMPLE MEAN
16708C                 N        = SAMPLE SIZE
16709C                 MINMAX   = SPECIFY WHETHER MAXIMUM OR MINIMUM
16710C                            CASE IS BEING ESTIMATED
16711C
16712C              CALLED BY DFZER2 ROUTINE FOR FINDING THE ROOT OF A
16713C              FUNCTION.
16714C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
16715C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
16716C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
16717C                1999, CHAPTER 15.
16718C              --JOHNSON, KOTZ, AND BALAKRISNAN, "CONTINUOUS
16719C                UNIVARIATE DISTRIBUTIONS--VOLUME 1", SECOND EDITION,
16720C                WILEY, 1994, CHAPTER xx.
16721C     WRITTEN BY--JAMES J. FILLIBEN
16722C                 STATISTICAL ENGINEERING DIVISION
16723C                 INFORMATION TECHNOLOGY LABORATORY
16724C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16725C                 GAITHERSBUG, MD 20899-8980
16726C                 PHONE--301-975-2855
16727C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16728C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16729C     LANGUAGE--ANSI FORTRAN (1977)
16730C     VERSION NUMBER--2004/12
16731C     ORIGINAL VERSION--DECEMBER   2004.
16732C
16733C---------------------------------------------------------------------
16734C
16735      DOUBLE PRECISION SHAT
16736      DOUBLE PRECISION X(*)
16737C
16738      INTEGER N
16739      DOUBLE PRECISION XBAR
16740      COMMON/EV1CO2/XBAR,MINMAX,N
16741C
16742C---------------------------------------------------------------------
16743C
16744      DOUBLE PRECISION DSUM1
16745      DOUBLE PRECISION DSUM2
16746C
16747      INCLUDE 'DPCOP2.INC'
16748C
16749C-----START POINT-----------------------------------------------------
16750C
16751C  COMPUTE SOME SUMS
16752C
16753      DSUM1=0.0D0
16754      DSUM2=0.0D0
16755C
16756      IF(MINMAX.EQ.2)THEN
16757        DO100I=1,N
16758          DSUM1=DSUM1 + X(I)*DEXP(-X(I)/SHAT)
16759          DSUM2=DSUM2 + DEXP(-X(I)/SHAT)
16760  100   CONTINUE
16761        EV1FU2=SHAT - XBAR + DSUM1/DSUM2
16762      ELSE
16763        DO200I=1,N
16764          DSUM1=DSUM1 + X(I)*DEXP(X(I)/SHAT)
16765          DSUM2=DSUM2 + DEXP(X(I)/SHAT)
16766  200   CONTINUE
16767        EV1FU2=SHAT + XBAR - DSUM1/DSUM2
16768      ENDIF
16769C
16770C
16771      RETURN
16772      END
16773      DOUBLE PRECISION FUNCTION EV1FU3 (SHAT,X)
16774C
16775C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
16776C              BASED CONFIDECE INTERVALS FOR THE LOCATION AND SCALE
16777C              PARAMETERS OF A GUMBEL DISTRIBUTION.
16778C              THIS FUNCTION FINDS THE ROOT OF THE EQUATION:
16779C
16780C                 2*LL(MU,SIGMA) - 2*LL(M(sigma),sigma)
16781C                                - CHSPPF(alpha,1)
16782C
16783C              WITH
16784C
16785C                 LL(MU,SIGMA) = -N*LOG(SIGMA) - N*XBAR/SIGMA +
16786C                                N*MU/SIGMA -
16787C                                SUM[i=1 to N][EXP(-(X(I)-MU)/SIGMA)]
16788C
16789C              GIVEN CURRENT VALUE OF SIGMA (= SHAT),
16790C
16791C                 MU(SIGMA) = -SIGMA*LOG(SUM[i=1 to N][EXP(-X(I)/SIGMA)]/N]
16792C
16793C              CALLED BY DFZER2 ROUTINE FOR FINDING THE ROOT OF A
16794C              FUNCTION.
16795C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
16796C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
16797C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
16798C                1999, CHAPTER 15.
16799C     WRITTEN BY--JAMES J. FILLIBEN
16800C                 STATISTICAL ENGINEERING DIVISION
16801C                 INFORMATION TECHNOLOGY LABORATORY
16802C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16803C                 GAITHERSBUG, MD 20899-8980
16804C                 PHONE--301-975-2855
16805C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16806C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16807C     LANGUAGE--ANSI FORTRAN (1977)
16808C     VERSION NUMBER--2004/12
16809C     ORIGINAL VERSION--DECEMBER   2004.
16810C
16811C---------------------------------------------------------------------
16812C
16813      DOUBLE PRECISION SHAT
16814      DOUBLE PRECISION X(*)
16815C
16816      INTEGER N
16817      DOUBLE PRECISION XBAR
16818      COMMON/EV1CO2/XBAR,MINMAX,N
16819      DOUBLE PRECISION DK, DLLUS
16820      COMMON/EV1CO3/DK, DLLUS
16821C
16822      DOUBLE PRECISION DN
16823      DOUBLE PRECISION DMU
16824      DOUBLE PRECISION DTERM1
16825      DOUBLE PRECISION DSUM1
16826C
16827C-----COMMON----------------------------------------------------------
16828C
16829      INCLUDE 'DPCOP2.INC'
16830C
16831C-----START POINT-----------------------------------------------------
16832C
16833C
16834C  GIVEN SIGMA, COMPUTE ESTIMATE OF MU
16835C
16836      DSUM1=0.0D0
16837      DN=DBLE(N)
16838C
16839      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
16840        DO100I=1,N
16841          DSUM1=DSUM1 + DEXP(-X(I)/SHAT)
16842  100   CONTINUE
16843        DMU=-SHAT*DLOG(DSUM1/DN)
16844      ELSE
16845        DO200I=1,N
16846          DSUM1=DSUM1 + DEXP(X(I)/SHAT)
16847  200   CONTINUE
16848        DMU=SHAT*DLOG(DSUM1/DN)
16849      ENDIF
16850C
16851C  COMPUTE SOME SUMS
16852C
16853      DSUM1=0.0D0
16854C
16855      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
16856        DO300I=1,N
16857          DSUM1=DSUM1 + DEXP(-(X(I) - DMU)/SHAT)
16858  300   CONTINUE
16859        DTERM1=-DN*DLOG(SHAT) - DN*XBAR/SHAT + DN*DMU/SHAT - DSUM1
16860      ELSE
16861        DO400I=1,N
16862          DSUM1=DSUM1 + DEXP((X(I) + DMU)/SHAT)
16863  400   CONTINUE
16864        DTERM1=-DN*DLOG(SHAT) - DN*XBAR/SHAT + DN*DMU/SHAT - DSUM1
16865      ENDIF
16866C
16867      EV1FU3=2.0D0*DLLUS - 2.0D0*DTERM1 - DK
16868C
16869      RETURN
16870      END
16871      DOUBLE PRECISION FUNCTION EV1FU4 (DMU,X)
16872C
16873C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
16874C              BASED CONFIDECE INTERVALS FOR THE LOCATION AND SCALE
16875C              PARAMETERS OF A GUMBEL DISTRIBUTION.
16876C              THIS FUNCTION FINDS THE ROOT OF THE EQUATION:
16877C
16878C                 2*LL(MU,SIGMA) - 2*LL(mu,sigma(mu))
16879C                                - CHSPPF(alpha,1)
16880C
16881C              WITH
16882C
16883C                 LL(MU,SIGMA) = -N*LOG(SIGMA) - N*XBAR/SIGMA +
16884C                                N*MU/SIGMA -
16885C                                SUM[i=1 to N][EXP(-(X(I)-MU)/SIGMA)]
16886C
16887C              GIVEN CURRENT VALUE OF MU (= DMU), SIGMA IS ROOT OF:
16888C
16889C                 SIGMA + MU +
16890C                 SUM[i=1 to n][X(I)*EXP(-(X(I)-MU)/SIGMA]/N -
16891C                 MU*SUM[i=1 to n][EXP(-(X(I)-MU)/SIGMA]/N -  XBAR
16892C
16893C              CALLED BY DFZER2 ROUTINE FOR FINDING THE ROOT OF A
16894C              FUNCTION.
16895C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
16896C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
16897C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
16898C                1999, CHAPTER 15.
16899C     WRITTEN BY--JAMES J. FILLIBEN
16900C                 STATISTICAL ENGINEERING DIVISION
16901C                 INFORMATION TECHNOLOGY LABORATORY
16902C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16903C                 GAITHERSBUG, MD 20899-8980
16904C                 PHONE--301-975-2855
16905C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16906C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16907C     LANGUAGE--ANSI FORTRAN (1977)
16908C     VERSION NUMBER--2004/12
16909C     ORIGINAL VERSION--DECEMBER   2004.
16910C
16911C---------------------------------------------------------------------
16912C
16913      DOUBLE PRECISION DMU
16914      DOUBLE PRECISION X(*)
16915C
16916      INTEGER N
16917      DOUBLE PRECISION XBAR
16918      COMMON/EV1CO2/XBAR,MINMAX,N
16919      DOUBLE PRECISION DLLUS
16920      DOUBLE PRECISION DK
16921      COMMON/EV1CO3/DK, DLLUS
16922      DOUBLE PRECISION SHAT
16923      COMMON/EV1CO4/SHAT
16924      DOUBLE PRECISION DMU2
16925      COMMON/EV1CO5/DMU2
16926      DOUBLE PRECISION EV1FU5
16927      EXTERNAL EV1FU5
16928C
16929      DOUBLE PRECISION DN
16930      DOUBLE PRECISION DTERM1
16931      DOUBLE PRECISION DSUM1
16932      DOUBLE PRECISION AE
16933      DOUBLE PRECISION RE
16934      DOUBLE PRECISION XLOW
16935      DOUBLE PRECISION XUP
16936      DOUBLE PRECISION XSTRT
16937      DOUBLE PRECISION SHAT2
16938C
16939C-----COMMON----------------------------------------------------------
16940C
16941      INCLUDE 'DPCOP2.INC'
16942C
16943C-----START POINT-----------------------------------------------------
16944C
16945C  STEP 1: GIVEN VALUE OF LOCATION PARAMETER (MU), NEED TO COMPUTE
16946C          THE SCALE PARAMETER (WHICH IN TURN INVOLVES FINDING A
16947C          ROOT).
16948C
16949      DMU2=DMU
16950C
16951      AE=1.D-7
16952      RE=1.D-7
16953      XSTRT=SHAT
16954      XLOW=XSTRT/2.0D0
16955      XUP=XSTRT*2.0D0
16956      CALL DFZER3(EV1FU5,XLOW,XUP,XSTRT,RE,AE,IFLAG,X)
16957      SHAT2=XLOW
16958C
16959      DSUM1=0.0D0
16960      DN=DBLE(N)
16961C
16962C  COMPUTE SOME SUMS
16963C
16964      DSUM1=0.0D0
16965C
16966      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.2)THEN
16967        DO300I=1,N
16968          DSUM1=DSUM1 + DEXP(-(X(I) - DMU)/SHAT2)
16969  300   CONTINUE
16970        DTERM1=-DN*DLOG(SHAT2) - DN*XBAR/SHAT2 + DN*DMU/SHAT2 - DSUM1
16971      ELSE
16972        DO400I=1,N
16973          DSUM1=DSUM1 + DEXP((X(I) + DMU)/SHAT2)
16974  400   CONTINUE
16975        DTERM1=-DN*DLOG(SHAT2) - DN*XBAR/SHAT2 + DN*DMU/SHAT2 - DSUM1
16976      ENDIF
16977C
16978      EV1FU4=2.0D0*DLLUS - 2.0D0*DTERM1 - DK
16979C
16980      RETURN
16981      END
16982      DOUBLE PRECISION FUNCTION EV1FU5 (SHAT,X)
16983C
16984C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
16985C              BASED CONFIDECE INTERVALS FOR THE LOCATION AND SCALE
16986C              PARAMETERS OF A GUMBEL DISTRIBUTION.
16987C              THIS CONFIDENCE INTERVAL IS THE ROOT OF THE EQUATION
16988C
16989C                 2*LL(MU,SIGMA) - 2*LL(mu,sigma(mu))
16990C                                - CHSPPF(alpha,1)
16991C
16992C              WITH
16993C
16994C                 LL(MU,SIGMA) = -N*LOG(SIGMA) - N*XBAR/SIGMA +
16995C                                N*MU/SIGMA -
16996C                                SUM[i=1 to N][EXP(-(X(I)-MU)/SIGMA)]
16997C
16998C              GIVEN CURRENT VALUE OF MU (= DMU), SIGMA IS ROOT OF:
16999C
17000C                 SIGMA + MU +
17001C                 SUM[i=1 to n][X(I)*EXP(-(X(I)-MU)/SIGMA]/N -
17002C                 MU*SUM[i=1 to n][EXP(-(X(I)-MU)/SIGMA]/N -  XBAR
17003C
17004C              EV1FU5 IS USED IN SOLVING FOR THE VALUE OF SIGMA
17005C              GIVEN MU.
17006C
17007C              CALLED BY DFZER3 ROUTINE FOR FINDING THE ROOT OF A
17008C              FUNCTION.
17009C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
17010C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
17011C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
17012C                1999, CHAPTER 15.
17013C     WRITTEN BY--JAMES J. FILLIBEN
17014C                 STATISTICAL ENGINEERING DIVISION
17015C                 INFORMATION TECHNOLOGY LABORATORY
17016C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17017C                 GAITHERSBUG, MD 20899-8980
17018C                 PHONE--301-975-2855
17019C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17020C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17021C     LANGUAGE--ANSI FORTRAN (1977)
17022C     VERSION NUMBER--2004/12
17023C     ORIGINAL VERSION--DECEMBER   2004.
17024C
17025C---------------------------------------------------------------------
17026C
17027      DOUBLE PRECISION SHAT
17028      DOUBLE PRECISION X(*)
17029C
17030      INTEGER N
17031      DOUBLE PRECISION XBAR
17032      COMMON/EV1CO2/XBAR,MINMAX,N
17033      DOUBLE PRECISION DMU
17034      COMMON/EV1CO5/DMU
17035C
17036      DOUBLE PRECISION DN
17037      DOUBLE PRECISION DSUM1
17038      DOUBLE PRECISION DSUM2
17039C
17040C-----COMMON----------------------------------------------------------
17041C
17042      INCLUDE 'DPCOP2.INC'
17043C
17044C-----START POINT-----------------------------------------------------
17045C
17046C
17047C  GIVEN MU, FIND ROOT FOR SIGMA
17048C
17049      DSUM1=0.0D0
17050      DSUM2=0.0D0
17051      DN=DBLE(N)
17052C
17053      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
17054        DO100I=1,N
17055          DSUM1=DSUM1 + X(I)*DEXP(-(X(I)-DMU)/SHAT)
17056          DSUM2=DSUM2 + DEXP(-(X(I)-DMU)/SHAT)
17057  100   CONTINUE
17058        EV1FU5=SHAT + DMU + DSUM1/DN - DMU*DSUM2/DN - XBAR
17059      ELSE
17060        DO200I=1,N
17061          DSUM1=DSUM1 + X(I)*DEXP((X(I)+DMU)/SHAT)
17062          DSUM2=DSUM2 + DEXP((X(I)+DMU)/SHAT)
17063  200   CONTINUE
17064        EV1FU5=SHAT + DMU + DSUM1/DN - DMU*DSUM2/DN - XBAR
17065      ENDIF
17066C
17067C  COMPUTE SOME SUMS
17068C
17069C
17070C
17071      RETURN
17072      END
17073      DOUBLE PRECISION FUNCTION EV1FU6 (DPPF,X)
17074C
17075C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
17076C              BASED CONFIDECE INTERVALS FOR THE LOCATION AND SCALE
17077C              PARAMETERS OF A GUMBEL DISTRIBUTION.
17078C              THIS FUNCTION FINDS THE ROOT OF THE EQUATION:
17079C
17080C                 2*LL(MU,SIGMA) - 2*LL(mu(Q),S1(Q)
17081C                                - CHSPPF(alpha,1)
17082C
17083C              WITH
17084C
17085C                 LL(MU,SIGMA) = -N*LOG(SIGMA) - N*XBAR/SIGMA +
17086C                                N*MU/SIGMA -
17087C                                SUM[i=1 to N][EXP(-(X(I)-MU)/SIGMA)]
17088C
17089C              GIVEN A VALUE OF Q, EV1FU6 IS CALLED TO DETERMINE A
17090C              VALUE OF SIGMA.  THEN THE FOLLOWING IS USED TO
17091C              FIND THE VALUE OF M.
17092C
17093C                 MU = Q + LN(LN(1/q))*SHAT
17094C
17095C              CALLED BY DFZER2 ROUTINE FOR FINDING THE ROOT OF A
17096C              FUNCTION.
17097C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
17098C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
17099C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
17100C                1999, CHAPTER 15.
17101C     WRITTEN BY--JAMES J. FILLIBEN
17102C                 STATISTICAL ENGINEERING DIVISION
17103C                 INFORMATION TECHNOLOGY LABORATORY
17104C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17105C                 GAITHERSBUG, MD 20899-8980
17106C                 PHONE--301-975-2855
17107C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17108C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17109C     LANGUAGE--ANSI FORTRAN (1977)
17110C     VERSION NUMBER--2004/12
17111C     ORIGINAL VERSION--DECEMBER   2004.
17112C
17113C---------------------------------------------------------------------
17114C
17115      DOUBLE PRECISION DPPF
17116      DOUBLE PRECISION X(*)
17117C
17118      DOUBLE PRECISION EV1FU7
17119      EXTERNAL EV1FU7
17120C
17121      INTEGER N
17122      DOUBLE PRECISION XBAR
17123      COMMON/EV1CO2/XBAR,MINMAX,N
17124      DOUBLE PRECISION DLLUS
17125      DOUBLE PRECISION DK
17126      COMMON/EV1CO3/DK, DLLUS
17127      DOUBLE PRECISION DQ
17128      DOUBLE PRECISION SHATML
17129      COMMON/EV1CO6/DQ,SHATML
17130      DOUBLE PRECISION DQ2
17131      DOUBLE PRECISION DPPF2
17132      COMMON/EV1CO7/DQ2,DPPF2
17133C
17134      DOUBLE PRECISION DN
17135      DOUBLE PRECISION DMU
17136      DOUBLE PRECISION SHAT2
17137      DOUBLE PRECISION DSUM1
17138      DOUBLE PRECISION DTERM1
17139      DOUBLE PRECISION AE
17140      DOUBLE PRECISION RE
17141      DOUBLE PRECISION XLOW
17142      DOUBLE PRECISION XUP
17143      DOUBLE PRECISION XSTRT
17144C
17145C-----COMMON----------------------------------------------------------
17146C
17147      INCLUDE 'DPCOP2.INC'
17148C
17149C-----START POINT-----------------------------------------------------
17150C
17151C  STEP 1: GIVEN VALUE OF Q, NEED TO COMPUTE
17152C          THE SCALE PARAMETER (WHICH IN TURN INVOLVES FINDING A
17153C          ROOT).
17154C
17155      DQ2=DQ
17156      DPPF2=DPPF
17157C
17158      AE=1.D-7
17159      RE=1.D-7
17160      XSTRT=SHATML
17161      XLOW=XSTRT/5.0D0
17162      XUP=XSTRT*5.0D0
17163      CALL DFZER3(EV1FU7,XLOW,XUP,XSTRT,RE,AE,IFLAG,X)
17164      SHAT2=XLOW
17165C
17166C  STEP 2: NOW COMPUTE VALUE OF MU
17167C
17168      DMU=DPPF + DLOG(DLOG(1.0D0/DQ))*SHAT2
17169C
17170C  COMPUTE SOME SUMS
17171C
17172      DN=DBLE(N)
17173      DSUM1=0.0D0
17174C
17175      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
17176        DO300I=1,N
17177          DSUM1=DSUM1 + DEXP(-(X(I) - DMU)/SHAT2)
17178  300   CONTINUE
17179        DTERM1=-DN*DLOG(SHAT2) - DN*XBAR/SHAT2 + DN*DMU/SHAT2 - DSUM1
17180      ELSE
17181        DO400I=1,N
17182          DSUM1=DSUM1 + DEXP((X(I) + DMU)/SHAT2)
17183  400   CONTINUE
17184        DTERM1=-DN*DLOG(SHAT2) - DN*XBAR/SHAT2 + DN*DMU/SHAT2 - DSUM1
17185      ENDIF
17186C
17187      EV1FU6=2.0D0*DLLUS - 2.0D0*DTERM1 - DK
17188C
17189      RETURN
17190      END
17191      DOUBLE PRECISION FUNCTION EV1FU7 (SHAT,X)
17192C
17193C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
17194C              BASED CONFIDECE INTERVALS FOR A PERCENTILE OF THE
17195C              GUMBEL DISTRIBUTION.  THIS FUNCTION FINDS THE ROOT
17196C              OF THE EQUATION:
17197C
17198C              (N/SIGMA)*{(XBAR - Q)/SIGMA + (LOG(q)/N)*
17199C              SUM[i=1 to N][EXP(-(X(I)-Q)/SIGMA)*(X(I)-Q)/SIGMA)] - 1
17200C
17201C              WITH
17202C
17203C                 q       = DESIRED PERCENTILE (E.G., 0.95) (DQ IN CODE)
17204C                 Q       = POINT ESTIMATE OF PERCENTILE (EV1PPF(q) =
17205C                           DPPF IN CODE)
17206C
17207C              EV1FU7 IS USED IN SOLVING FOR THE VALUE OF SIGMA
17208C              GIVEN q AND Q.
17209C
17210C              CALLED BY DFZER3 ROUTINE FOR FINDING THE ROOT OF A
17211C              FUNCTION.
17212C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
17213C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
17214C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
17215C                1999, CHAPTER 15.
17216C     WRITTEN BY--JAMES J. FILLIBEN
17217C                 STATISTICAL ENGINEERING DIVISION
17218C                 INFORMATION TECHNOLOGY LABORATORY
17219C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17220C                 GAITHERSBUG, MD 20899-8980
17221C                 PHONE--301-975-2855
17222C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17223C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17224C     LANGUAGE--ANSI FORTRAN (1977)
17225C     VERSION NUMBER--2004/12
17226C     ORIGINAL VERSION--DECEMBER   2004.
17227C
17228C---------------------------------------------------------------------
17229C
17230      DOUBLE PRECISION SHAT
17231      DOUBLE PRECISION X(*)
17232C
17233      INTEGER N
17234      DOUBLE PRECISION XBAR
17235      COMMON/EV1CO2/XBAR,MINMAX,N
17236      DOUBLE PRECISION DQ
17237      DOUBLE PRECISION DPPF
17238      COMMON/EV1CO7/DQ,DPPF
17239C
17240      DOUBLE PRECISION DN
17241      DOUBLE PRECISION DSUM1
17242      DOUBLE PRECISION DTERM1
17243C
17244C-----COMMON----------------------------------------------------------
17245C
17246      INCLUDE 'DPCOP2.INC'
17247C
17248C-----START POINT-----------------------------------------------------
17249C
17250C
17251C  GIVEN MU, FIND ROOT FOR SIGMA
17252C
17253      DSUM1=0.0D0
17254      DN=DBLE(N)
17255      DTERM1=(XBAR-DPPF)/SHAT
17256C
17257      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
17258        DO100I=1,N
17259          DSUM1=DSUM1 + ((X(I)-DPPF)/SHAT)*DEXP(-(X(I)-DPPF)/SHAT)
17260  100   CONTINUE
17261      ELSE
17262        DO200I=1,N
17263          DSUM1=DSUM1 + ((X(I)-DPPF)/SHAT)*DEXP((X(I)-DPPF)/SHAT)
17264  200   CONTINUE
17265      ENDIF
17266C
17267      EV1FU7=(DN/SHAT)*(DTERM1 + (DLOG(DQ)/DN)*DSUM1 - 1.0D0)
17268C
17269      RETURN
17270      END
17271      SUBROUTINE EV1HAZ(X,MINMAX,HAZ)
17272C
17273C     PURPOSE--THIS SUBROUTINE COMPUTES THE HAZARD
17274C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
17275C              DISTRIBUTION.
17276C              THE EXTREME VALUE TYPE 1 DISTRIBUTION USED
17277C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
17278C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
17279C              THIS DISTRIBUTION IS DEFINED FOR ALL X
17280C              AND HAS THE PROBABILITY DENSITY FUNCTION
17281C              FOR THE MAXIMUM ORDER STATISTIC
17282C              F(X) = (EXP(-X)) * (EXP(-(EXP(-X))))
17283C              WHICH SIMPLIFIES TO:
17284C              F(X) = EXP(-X - EXP(-X))
17285C              FOR THE MINIMUIM ORDER STATISTIC
17286C              F(X) = (EXP(X)) * (EXP(-(EXP(X))))
17287C              WHICH SIMPLIFIES TO:
17288C              F(X) = EXP(-X - EXP(-X))
17289C              THE HAZARD FUNCTION IS:
17290C              EXP(-X)/(EXP(EXP(-X)-1))
17291C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
17292C                                AT WHICH THE CUMULATIVE DISTRIBUTION
17293C                                FUNCTION IS TO BE EVALUATED.
17294C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION HAZARD
17295C                                FUNCTION VALUE.
17296C     OUTPUT--THE SINGLE PRECISION HAZARD
17297C             FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
17298C             DISTRIBUTION WITH MEAN = EULER'S NUMBER = 0.57721566
17299C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
17300C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
17301C     RESTRICTIONS--NONE.
17302C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
17303C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
17304C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
17305C     LANGUAGE--ANSI FORTRAN.
17306C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
17307C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
17308C     WRITTEN BY--JAMES J. FILLIBEN
17309C                 STATISTICAL ENGINEERING LABORATORY (205.03)
17310C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17311C                 GAITHERSBURG, MD 20899
17312C                 PHONE:  301-975-2899
17313C     ORIGINAL VERSION--APRIL     1998.
17314C     UPDATED         --JUNE      1999. USE SIMPLIFIED FORMULA FOR
17315C                                       MINIMUM CASE.
17316C
17317C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17318C
17319      DOUBLE PRECISION DX
17320CCCCC DOUBLE PRECISION DCDF
17321CCCCC DOUBLE PRECISION DPDF
17322      DOUBLE PRECISION DHAZ
17323      DOUBLE PRECISION DTERM1
17324      DOUBLE PRECISION DTERM2
17325C
17326C-----COMMON----------------------------------------------------------
17327C
17328      INCLUDE 'DPCOMC.INC'
17329      INCLUDE 'DPCOP2.INC'
17330C
17331C---------------------------------------------------------------------
17332C
17333C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
17334C     NO INPUT ARGUMENT ERRORS POSSIBLE
17335C     FOR THIS DISTRIBUTION.
17336C
17337C-----START POINT-----------------------------------------------------
17338C
17339      IF(MINMAX.EQ.1)THEN
17340        IF(X.LE.REAL(I1MACH(15)))THEN
17341          HAZ=0.0
17342        ELSEIF(X.LE.REAL(I1MACH(16)))THEN
17343          HAZ=EXP(X)
17344        ELSE
17345          HAZ=0.0
17346          WRITE(ICOUT,1700)
17347          CALL DPWRST('XXX','BUG ')
17348        ENDIF
17349CCCCC   DX=DBLE(X)
17350CCCCC   CALL EV1CDD(DX,MINMAX,DCDF)
17351CCCCC   DCDF=1.0D0-DCDF
17352CCCCC   IF(DCDF.NE.0.0D0)THEN
17353CCCCC     DPDF=DEXP(DX-DEXP(DX))
17354CCCCC     DHAZ=DPDF/DCDF
17355CCCCC     HAZ=REAL(DHAZ)
17356CCCCC   ELSE
17357CCCCC     WRITE(ICOUT,1600)
17358C1600     FORMAT('*****ERROR IN EV1HAZ--CDF ESSENTIALLY 1.')
17359CCCCC     CALL DPWRST('XXX','BUG ')
17360CCCCC   ENDIF
17361      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
17362        DX=DBLE(-X)
17363CCCCC   DTERM1=DEXP(DX)-1.0D0
17364CCCCC   DHAZ=DEXP(DX-DTERM1)
17365        DTERM1=DEXP(DX)
17366        DTERM2=DEXP(DEXP(DX))-1.0D0
17367        IF(DTERM2.NE.0.0D0)THEN
17368          DHAZ=DTERM1/DTERM2
17369          HAZ=REAL(DHAZ)
17370        ELSE
17371          HAZ=0.0
17372          WRITE(ICOUT,1700)
17373 1700     FORMAT('*****ERROR IN EV1HAZ--UNABLE TO COMPUTE THE ',
17374     1          'HAZARD FUNCTION.')
17375          CALL DPWRST('XXX','BUG ')
17376        ENDIF
17377      ELSE
17378         HAZ=0.0
17379         WRITE(ICOUT,1800)
17380 1800    FORMAT('*****ERROR IN EV1HAZ--MINMAX NOT 1 OR 2')
17381         CALL DPWRST('XXX','BUG ')
17382      END IF
17383C
17384      RETURN
17385      END
17386      SUBROUTINE EV1LI1(Y,N,MINMAX,
17387     1                  ALOC,SCALE,
17388     1                  ALIK,AIC,AICC,BIC,
17389     1                  ISUBRO,IBUGA3,IERROR)
17390C
17391C     PURPOSE--THIS ROUTINE COMPUTES THE LIKELIHOOD FUNCTION FOR
17392C              THE GUMBEL (EXTREME VALUE TYPE 1) DISTRIBUTION.  THIS IS
17393C              FOR THE RAW DATA CASE (I.E., NO GROUPING AND NO CENSORING).
17394C
17395C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
17396C              PERFORMED.
17397C
17398C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
17399C                CAMBRIDGE UNIVERSITY PRESS, 1999, P. 272.
17400C     WRITTEN BY--JAMES J. FILLIBEN
17401C                 STATISTICAL ENGINEERING DIVISION
17402C                 INFORMATION TECHNOLOGY LABORATORY
17403C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17404C                 GAITHERSBURG, MD 20899-8980
17405C                 PHONE--301-975-2855
17406C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17407C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17408C     LANGUAGE--ANSI FORTRAN (1977)
17409C     VERSION NUMBER--2010/6
17410C     ORIGINAL VERSION--JUNE      2010.
17411C
17412C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17413C
17414      CHARACTER*4 ISUBRO
17415      CHARACTER*4 IBUGA3
17416      CHARACTER*4 IERROR
17417C
17418      CHARACTER*4 IWRITE
17419C
17420      CHARACTER*4 ISUBN1
17421      CHARACTER*4 ISUBN2
17422      CHARACTER*4 ISTEPN
17423C
17424      DOUBLE PRECISION DX
17425      DOUBLE PRECISION DS
17426      DOUBLE PRECISION DU
17427      DOUBLE PRECISION DN
17428      DOUBLE PRECISION DNP
17429      DOUBLE PRECISION DLIK
17430      DOUBLE PRECISION DSUM1
17431      DOUBLE PRECISION DSUM2
17432      DOUBLE PRECISION DTERM1
17433      DOUBLE PRECISION DTERM3
17434C
17435C---------------------------------------------------------------------
17436C
17437      DIMENSION Y(*)
17438C
17439C-----COMMON----------------------------------------------------------
17440C
17441      INCLUDE 'DPCOP2.INC'
17442C
17443C-----START POINT-----------------------------------------------------
17444C
17445      ISUBN1='EV1L'
17446      ISUBN2='I1  '
17447      IERROR='NO'
17448C
17449      ALIK=-99.0
17450      AIC=-99.0
17451      AICC=-99.0
17452      BIC=-99.0
17453C
17454      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'1LI1')THEN
17455        WRITE(ICOUT,999)
17456  999   FORMAT(1X)
17457        CALL DPWRST('XXX','WRIT')
17458        WRITE(ICOUT,51)
17459   51   FORMAT('**** AT THE BEGINNING OF EV1LI1--')
17460        CALL DPWRST('XXX','WRIT')
17461        WRITE(ICOUT,52)IBUGA3,ISUBRO
17462   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
17463        CALL DPWRST('XXX','WRIT')
17464        WRITE(ICOUT,55)N,ALOC,SCALE
17465   55   FORMAT('N,ALOC,SCALE = ',I8,2G15.7)
17466        CALL DPWRST('XXX','WRIT')
17467        DO56I=1,MIN(N,100)
17468          WRITE(ICOUT,57)I,Y(I)
17469   57     FORMAT('I,Y(I) = ',I8,G15.7)
17470          CALL DPWRST('XXX','WRIT')
17471   56   CONTINUE
17472      ENDIF
17473C
17474C               ******************************************
17475C               **  STEP 1--                            **
17476C               **  COMPUTE LIKELIHOOD FUNCTION         **
17477C               ******************************************
17478C
17479      ISTEPN='1'
17480      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'1LI1')
17481     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17482C
17483      IERFLG=0
17484      IERROR='NO'
17485      IWRITE='OFF'
17486C
17487      DN=DBLE(N)
17488      DS=DBLE(SCALE)
17489      DU=DBLE(ALOC)
17490      DTERM1=DN*DLOG(DS)
17491      DSUM1=0.0D0
17492      DSUM2=0.0D0
17493      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
17494        DO1000I=1,N
17495          DX=-(DBLE(Y(I)) - DU)/DS
17496          DTERM1=DEXP(DX - DEXP(DX))
17497          DSUM1=DSUM1 + DLOG(DTERM1/DS)
17498 1000   CONTINUE
17499      ELSE
17500        DO2000I=1,N
17501          DX=(DBLE(Y(I)) - DU)/DS
17502          DTERM1=DEXP(DX - DEXP(DX))
17503          DSUM1=DSUM1 + DLOG(DTERM1/DS)
17504 2000   CONTINUE
17505      ENDIF
17506      DLIK=DSUM1
17507C
17508      ALIK=REAL(DLIK)
17509      DNP=2.0D0
17510      AIC=REAL(-2.0D0*DLIK + 2.0D0*DNP)
17511      DTERM3=(2.0D0*DNP*(DNP+1.0D0))/(DN-DNP-1.0D0)
17512      AICC=REAL(-2.0D0*DLIK + 2.0D0*DNP + DTERM3)
17513      BIC=REAL(-2.0D0*DLIK + DNP*LOG(DN))
17514C
17515      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'1LI1')THEN
17516        WRITE(ICOUT,999)
17517        CALL DPWRST('XXX','WRIT')
17518        WRITE(ICOUT,9011)
17519 9011   FORMAT('**** AT THE END OF EV1LI1--')
17520        CALL DPWRST('XXX','WRIT')
17521        WRITE(ICOUT,9013)DSUM1,DSUM2,DTERM1,DTERM3
17522 9013   FORMAT('DSUM1,DSUM2,DTERM1,DTERM3 = ',3G15.7)
17523        CALL DPWRST('XXX','WRIT')
17524        WRITE(ICOUT,9014)ALIK,AIC,AICC,BIC
17525 9014   FORMAT('ALIK,AIC,AICC,BIC = ',4G15.7)
17526        CALL DPWRST('XXX','WRIT')
17527      ENDIF
17528C
17529      RETURN
17530      END
17531      SUBROUTINE EXPAND(XLAB,N1,XVAL,N2,IWRITE,Y,XLABC,TEMP1,
17532     1                  MAXOBV,ISUBRO,IBUGA3,IERROR)
17533C
17534C     PURPOSE--GIVEN A VECTOR OF LAB-ID'S AND A SET OF VALUES, XVAL,
17535C              CORRESPONDING TO UNIQUE VALUES OF THE LAB-ID'S, CREATE
17536C              A VECTOR OF THE SAME LENGTH AS LAB-ID WHERE THE
17537C              APPROPRIATE VALUE FROM XVAL IS INSERTED.
17538C
17539C              FOR EXAMPLE, SUPPOSE WE HAVE 100 LAB-ID'S WHERE THERE ARE
17540C              10 DISTINCT LAB-ID'S.  THEN XVAL SHOULD HAVE 10 VALUES.
17541C              THE FIRST VALUE IN XVAL WILL BE INSERTED INTO THE ROWS
17542C              WITH THE SMALLEST LAB-ID, THE SECOND VALUE IN XVAL WILL
17543C              BE INSERTED INTO THE ROWS WITH THE SECOND SMALLEST LAB-ID,
17544C              AND SO ON.
17545C
17546C     INPUT  ARGUMENTS--XLAB   = THE SINGLE PRECISION VECTOR CONTAINING
17547C                                THE LAB-ID'S.
17548C                     --XVAL   = THE SINGLE PRECISION VECTOR CONTAINING
17549C                                THE VALUES TO BE INSERTED INTO THE
17550C                                OUTPUT VECTOR.
17551C                     --N1     = THE INTEGER NUMBER OF OBSERVATIONS
17552C                                IN THE VECTOR XLAB.
17553C                     --N2     = THE INTEGER NUMBER OF OBSERVATIONS
17554C                                IN THE VECTOR XVAL.
17555C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR INTO WHICH
17556C                                THE CODED VALUES WILL BE PLACED.
17557C     OUTPUT--THE SINGLE PRECISION VECTOR Y
17558C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
17559C     OTHER DATAPAC   SUBROUTINES NEEDED--CODE.
17560C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
17561C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
17562C     LANGUAGE--ANSI FORTRAN (1977)
17563C     REFERENCES--NONE.
17564C     WRITTEN BY--ALAN HECKERT
17565C                 STATISTICAL ENGINEERING DIVISION
17566C                 INFORMATION TECHNOLOGY LABORATORY
17567C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17568C                 GAITHERSBURG, MD 20899
17569C                 PHONE--301-975-2899
17570C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17571C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17572C     LANGUAGE--ANSI FORTRAN (1977)
17573C     VERSION NUMBER--2012/1
17574C     ORIGINAL VERSION--JANUARY   2012.
17575C
17576C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17577C
17578      CHARACTER*4 IWRITE
17579      CHARACTER*4 ISUBRO
17580      CHARACTER*4 IBUGA3
17581      CHARACTER*4 IERROR
17582C
17583      CHARACTER*4 ISUBN1
17584      CHARACTER*4 ISUBN2
17585C
17586C---------------------------------------------------------------------
17587C
17588      DIMENSION XLAB(*)
17589      DIMENSION XVAL(*)
17590      DIMENSION Y(*)
17591      DIMENSION XLABC(*)
17592      DIMENSION TEMP1(*)
17593C
17594C-----COMMON----------------------------------------------------------
17595C
17596      INCLUDE 'DPCOP2.INC'
17597C
17598C-----START POINT-----------------------------------------------------
17599C
17600      ISUBN1='EXPA'
17601      ISUBN2='ND  '
17602      IERROR='NO'
17603C
17604      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PAND')THEN
17605        WRITE(ICOUT,999)
17606  999   FORMAT(1X)
17607        CALL DPWRST('XXX','BUG ')
17608        WRITE(ICOUT,51)
17609   51   FORMAT('***** AT THE BEGINNING OF EXPAND--')
17610        CALL DPWRST('XXX','BUG ')
17611        WRITE(ICOUT,52)IBUGA3,ISUBRO,N1,N2
17612   52   FORMAT('IBUGA3,ISUBRO,N1,N2 = ',2(A4,2X),2I8)
17613        CALL DPWRST('XXX','BUG ')
17614        DO55I=1,N1
17615          WRITE(ICOUT,56)I,XLAB(I)
17616   56     FORMAT('I,XLAB(I) = ',I8,G15.7)
17617          CALL DPWRST('XXX','BUG ')
17618   55   CONTINUE
17619        DO65I=1,N2
17620          WRITE(ICOUT,66)I,XVAL(I)
17621   66     FORMAT('I,XVAL(I) = ',I8,G15.7)
17622          CALL DPWRST('XXX','BUG ')
17623   65   CONTINUE
17624      ENDIF
17625C
17626      DO91I=1,N1
17627        XLABC(I)=0.0
17628   91 CONTINUE
17629C
17630C               ********************************************
17631C               **  STEP 1--                              **
17632C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
17633C               ********************************************
17634C
17635      IF(N1.LT.2)THEN
17636        WRITE(ICOUT,999)
17637        CALL DPWRST('XXX','BUG ')
17638        WRITE(ICOUT,111)
17639  111   FORMAT('***** ERROR IN EXPAND--')
17640        CALL DPWRST('XXX','BUG ')
17641        WRITE(ICOUT,113)
17642  113   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE LAB-IDs IS ',
17643     1         'LESS THAN 2.')
17644        CALL DPWRST('XXX','BUG ')
17645        WRITE(ICOUT,118)N1
17646  118   FORMAT('      THE NUMBER OF LAB-IDs IS ',I8)
17647        CALL DPWRST('XXX','BUG ')
17648        IERROR='YES'
17649        GOTO9000
17650      ELSEIF(N2.LT.1)THEN
17651        WRITE(ICOUT,999)
17652        CALL DPWRST('XXX','BUG ')
17653        WRITE(ICOUT,111)
17654        CALL DPWRST('XXX','BUG ')
17655        WRITE(ICOUT,123)
17656  123   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE GROUP ',
17657     1         'VALUES IS LESS THAN 1.')
17658        CALL DPWRST('XXX','BUG ')
17659        WRITE(ICOUT,128)N2
17660  128   FORMAT('      THE NUMBER OF GROUP VALUES IS ',I8)
17661        CALL DPWRST('XXX','BUG ')
17662        IERROR='YES'
17663        GOTO9000
17664      ENDIF
17665C
17666C               **********************************************************
17667C               **  STEP 2--                                            **
17668C               **  PERFORM THE CODING--                                **
17669C               **  CALL CODE ROUTINE AND THEN LOOP THROUGH VALUES IN   **
17670C               **  THE XVAL VECTOR.                                    **
17671C               **  THEN APPLY THE RANKS TO ALL THE VALUES.             **
17672C               **********************************************************
17673C
17674      CALL CODE(XLAB,N1,IWRITE,XLABC,TEMP1,MAXOBV,IBUGA3,IERROR)
17675      IF(IERROR.EQ.'YES')GOTO9000
17676      CALL MAXIM(XLABC,N1,IWRITE,XMAX,IBUGA3,IERROR)
17677      IMAX=INT(XMAX+0.1)
17678      IF(IMAX.GT.N2)THEN
17679        WRITE(ICOUT,999)
17680        CALL DPWRST('XXX','BUG ')
17681        WRITE(ICOUT,111)
17682        CALL DPWRST('XXX','BUG ')
17683        WRITE(ICOUT,201)
17684  201   FORMAT('      THE NUMBER OF UNIQUE VALUES FOR THE LAB-IDs IS ')
17685        CALL DPWRST('XXX','BUG ')
17686        WRITE(ICOUT,203)
17687  203   FORMAT('      GREATER THAN THE NUMBER OF GROUP VALUES.')
17688        CALL DPWRST('XXX','BUG ')
17689        WRITE(ICOUT,205)IMAX
17690  205   FORMAT('      THE NUMBER OF UNIQUE LAB-IDs IS ',I8)
17691        CALL DPWRST('XXX','BUG ')
17692        WRITE(ICOUT,208)N2
17693  208   FORMAT('      THE NUMBER OF GROUP VALUES IS ',I8)
17694        CALL DPWRST('XXX','BUG ')
17695        IERROR='YES'
17696        GOTO9000
17697      ENDIF
17698C
17699      DO310I=1,IMAX
17700        HOLD=XVAL(I)
17701        DO320J=1,N1
17702          IINDX=INT(XLABC(J)+0.1)
17703          IF(IINDX.EQ.I)Y(J)=HOLD
17704  320   CONTINUE
17705  310 CONTINUE
17706C
17707C               ******************************
17708C               **  STEP 3--                **
17709C               **  WRITE OUT A FEW LINES   **
17710C               **  OF SUMMARY INFORMATION  **
17711C               **  ABOUT THE CODING.       **
17712C               ******************************
17713C
17714      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
17715        WRITE(ICOUT,999)
17716        CALL DPWRST('XXX','BUG ')
17717        WRITE(ICOUT,811)IMAX
17718  811   FORMAT('NUMBER OF DISTINCT CODE VALUES = ',I8)
17719        CALL DPWRST('XXX','BUG ')
17720        WRITE(ICOUT,999)
17721        CALL DPWRST('XXX','BUG ')
17722        WRITE(ICOUT,812)XVAL(1)
17723  812   FORMAT('THE MINIMUM LAB-ID HAS CODED VALUE ',G15.7)
17724        CALL DPWRST('XXX','BUG ')
17725        WRITE(ICOUT,813)XVAL(IMAX)
17726  813   FORMAT('THE MAXIMUM LAB-ID HAS CODED VALUE ',G15.7)
17727        CALL DPWRST('XXX','BUG ')
17728      ENDIF
17729C
17730C               *****************
17731C               **  STEP 90--  **
17732C               **  EXIT.      **
17733C               *****************
17734C
17735 9000 CONTINUE
17736C
17737      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'PAND')THEN
17738        WRITE(ICOUT,999)
17739        CALL DPWRST('XXX','BUG ')
17740        WRITE(ICOUT,9011)
17741 9011   FORMAT('***** AT THE END OF EXPAND--')
17742        CALL DPWRST('XXX','BUG ')
17743        WRITE(ICOUT,9012)IERROR,IMAX
17744 9012   FORMAT('IERROR,IMAX = ',A4,2X,I8)
17745        CALL DPWRST('XXX','BUG ')
17746        DO9015I=1,N1
17747          WRITE(ICOUT,9016)I,XLAB(I),XLABC(I),Y(I)
17748 9016     FORMAT('I,XLAB(I),XLABC(I),Y(I) = ',I8,3G15.7)
17749          CALL DPWRST('XXX','BUG ')
17750 9015   CONTINUE
17751      ENDIF
17752C
17753      RETURN
17754      END
17755      DOUBLE PRECISION FUNCTION exparg(l)
17756C--------------------------------------------------------------------
17757C     IF L = 0 THEN  EXPARG(L) = THE LARGEST POSITIVE W FOR WHICH
17758C     EXP(W) CAN BE COMPUTED.
17759C
17760C     IF L IS NONZERO THEN  EXPARG(L) = THE LARGEST NEGATIVE W FOR
17761C     WHICH THE COMPUTED VALUE OF EXP(W) IS NONZERO.
17762C
17763C     NOTE... ONLY AN APPROXIMATE VALUE FOR EXPARG(L) IS NEEDED.
17764C--------------------------------------------------------------------
17765C     .. Scalar Arguments ..
17766      INTEGER l
17767C     ..
17768C     .. Local Scalars ..
17769      DOUBLE PRECISION lnb
17770      INTEGER b,m
17771C     ..
17772C     .. External Functions ..
17773CCCCC INTEGER ipmpar
17774CCCCC EXTERNAL ipmpar
17775C     ..
17776C     .. Intrinsic Functions ..
17777      INTRINSIC dble,dlog
17778C
17779      INCLUDE 'DPCOMC.INC'
17780C
17781C     ..
17782C     .. Executable Statements ..
17783C
17784CCCCC b = ipmpar(4)
17785      b = I1MACH(10)
17786      IF (b.NE.2) GO TO 10
17787      lnb = .69314718055995D0
17788      GO TO 40
17789
17790   10 IF (b.NE.8) GO TO 20
17791      lnb = 2.0794415416798D0
17792      GO TO 40
17793
17794   20 IF (b.NE.16) GO TO 30
17795      lnb = 2.7725887222398D0
17796      GO TO 40
17797
17798   30 lnb = dlog(dble(b))
17799C
17800   40 IF (l.EQ.0) GO TO 50
17801CCCCC m = ipmpar(9) - 1
17802      ival = i1mach(12)
17803      m = ival - 1
17804      exparg = 0.99999D0* (m*lnb)
17805      RETURN
17806
17807CCC50 m = ipmpar(10)
17808   50 m = i1mach(13)
17809      exparg = 0.99999D0* (m*lnb)
17810      RETURN
17811
17812      END
17813      SUBROUTINE EXPLI1(Y,N,ICASPL,
17814     1                  ALOC,SCALE,
17815     1                  ALIK,AIC,AICC,BIC,
17816     1                  ISUBRO,IBUGA3,IERROR)
17817C
17818C     PURPOSE--THIS ROUTINE COMPUTES THE LIKELIHOOD FUNCTION FOR
17819C              THE EXPONENTIAL DISTRIBUTION.  THIS IS FOR THE RAW DATA
17820C              CASE (I.E., NO GROUPING AND NO CENSORING).
17821C
17822C              NOTE THAT FOR THE 1-PARAMETER MODEL, JUST SET ALOC TO
17823C              ZERO BEFORE CALLING THIS ROUTINE.
17824C
17825C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
17826C              PERFORMED.
17827C
17828C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
17829C                CAMBRIDGE UNIVERSITY PRESS, 1999, P. 187.
17830C     WRITTEN BY--JAMES J. FILLIBEN
17831C                 STATISTICAL ENGINEERING DIVISION
17832C                 INFORMATION TECHNOLOGY LABORATORY
17833C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17834C                 GAITHERSBURG, MD 20899-8980
17835C                 PHONE--301-975-2855
17836C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17837C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17838C     LANGUAGE--ANSI FORTRAN (1977)
17839C     VERSION NUMBER--2010/6
17840C     ORIGINAL VERSION--JUNE      2010.
17841C
17842C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17843C
17844      CHARACTER*4 ICASPL
17845      CHARACTER*4 ISUBRO
17846      CHARACTER*4 IBUGA3
17847      CHARACTER*4 IERROR
17848C
17849      CHARACTER*4 IWRITE
17850C
17851      CHARACTER*4 ISUBN1
17852      CHARACTER*4 ISUBN2
17853      CHARACTER*4 ISTEPN
17854C
17855      DOUBLE PRECISION DX
17856      DOUBLE PRECISION DS
17857      DOUBLE PRECISION DU
17858      DOUBLE PRECISION DN
17859      DOUBLE PRECISION DNP
17860      DOUBLE PRECISION DLIK
17861      DOUBLE PRECISION DSUM1
17862      DOUBLE PRECISION DTERM1
17863      DOUBLE PRECISION DTERM3
17864C
17865C---------------------------------------------------------------------
17866C
17867      DIMENSION Y(*)
17868C
17869C-----COMMON----------------------------------------------------------
17870C
17871      INCLUDE 'DPCOP2.INC'
17872C
17873C-----START POINT-----------------------------------------------------
17874C
17875      ISUBN1='EXPL'
17876      ISUBN2='I1  '
17877      IERROR='NO'
17878C
17879      ALIK=-99.0
17880      AIC=-99.0
17881      AICC=-99.0
17882      BIC=-99.0
17883C
17884      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PLI1')THEN
17885        WRITE(ICOUT,999)
17886  999   FORMAT(1X)
17887        CALL DPWRST('XXX','WRIT')
17888        WRITE(ICOUT,51)
17889   51   FORMAT('**** AT THE BEGINNING OF EXPLI1--')
17890        CALL DPWRST('XXX','WRIT')
17891        WRITE(ICOUT,52)IBUGA3,ISUBRO
17892   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
17893        CALL DPWRST('XXX','WRIT')
17894        WRITE(ICOUT,55)N,ALOC,SCALE
17895   55   FORMAT('N,ALOC,SCALE = ',I8,2G15.7)
17896        CALL DPWRST('XXX','WRIT')
17897        DO56I=1,MIN(N,100)
17898          WRITE(ICOUT,57)I,Y(I)
17899   57     FORMAT('I,Y(I) = ',I8,G15.7)
17900          CALL DPWRST('XXX','WRIT')
17901   56   CONTINUE
17902      ENDIF
17903C
17904C               ******************************************
17905C               **  STEP 1--                            **
17906C               **  COMPUTE LIKELIHOOD FUNCTION         **
17907C               ******************************************
17908C
17909      ISTEPN='1'
17910      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PLI1')
17911     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17912C
17913      IERFLG=0
17914      IERROR='NO'
17915      IWRITE='OFF'
17916      IF(ICASPL.EQ.'1EXP')ALOC=0.0
17917C
17918C     THE LOG-LIKELIHOOD FUNCTION IS
17919C
17920C     SUM[i=1 to N][-(X(i)-U)/S] - N*LOG(S)
17921C
17922      DN=DBLE(N)
17923      DS=DBLE(SCALE)
17924      DU=DBLE(ALOC)
17925      DTERM1=DN*DLOG(DS)
17926      DSUM1=0.0D0
17927      DO1000I=1,N
17928        DX=DBLE(Y(I))
17929        DSUM1=DSUM1 - (DX-DU)/DS
17930 1000 CONTINUE
17931      DLIK=DSUM1 - DTERM1
17932C
17933      ALIK=REAL(DLIK)
17934      DNP=2.0D0
17935      IF(ICASPL.EQ.'1EXP')DNP=1.0D0
17936      AIC=REAL(-2.0D0*DLIK + 2.0D0*DNP)
17937      DTERM3=(2.0D0*DNP*(DNP+1.0D0))/(DN-DNP-1.0D0)
17938      AICC=REAL(-2.0D0*DLIK + 2.0D0*DNP + DTERM3)
17939      BIC=REAL(-2.0D0*DLIK + DNP*LOG(DN))
17940C
17941      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PLI1')THEN
17942        WRITE(ICOUT,999)
17943        CALL DPWRST('XXX','WRIT')
17944        WRITE(ICOUT,9011)
17945 9011   FORMAT('**** AT THE END OF EXPLI1--')
17946        CALL DPWRST('XXX','WRIT')
17947        WRITE(ICOUT,9013)DSUM1,DSUM2,DTERM1,DTERM3
17948 9013   FORMAT('DSUM1,DSUM2,DTERM1,DTERM3 = ',3G15.7)
17949        CALL DPWRST('XXX','WRIT')
17950        WRITE(ICOUT,9014)ALIK,AIC,AICC,BIC
17951 9014   FORMAT('ALIK,AIC,AICC,BIC = ',4G15.7)
17952        CALL DPWRST('XXX','WRIT')
17953      ENDIF
17954C
17955      RETURN
17956      END
17957      SUBROUTINE EXPLI2(Y,X,N,IR,ICASPL,
17958     1                  ALOC,SCALE,
17959     1                  ALIK,AIC,AICC,BIC,
17960     1                  ISUBRO,IBUGA3,IERROR)
17961C
17962C     PURPOSE--THIS ROUTINE COMPUTES THE LIKELIHOOD FUNCTION FOR
17963C              THE CENSORED EXPONENTIAL DISTRIBUTION.  THIS IS FOR THE
17964C              RAW DATA CASE (I.E., NO GROUPING).
17965C
17966C              NOTE THAT FOR THE 1-PARAMETER MODEL, JUST SET ALOC TO
17967C              ZERO BEFORE CALLING THIS ROUTINE.
17968C
17969C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
17970C              PERFORMED.
17971C
17972C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
17973C                CAMBRIDGE UNIVERSITY PRESS, 1999, P. 187.
17974C     WRITTEN BY--JAMES J. FILLIBEN
17975C                 STATISTICAL ENGINEERING DIVISION
17976C                 INFORMATION TECHNOLOGY LABORATORY
17977C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17978C                 GAITHERSBURG, MD 20899-8980
17979C                 PHONE--301-975-2855
17980C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17981C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17982C     LANGUAGE--ANSI FORTRAN (1977)
17983C     VERSION NUMBER--2010/6
17984C     ORIGINAL VERSION--JUNE      2010.
17985C
17986C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17987C
17988      CHARACTER*4 ICASPL
17989      CHARACTER*4 ISUBRO
17990      CHARACTER*4 IBUGA3
17991      CHARACTER*4 IERROR
17992C
17993      CHARACTER*4 IWRITE
17994C
17995      CHARACTER*4 ISUBN1
17996      CHARACTER*4 ISUBN2
17997      CHARACTER*4 ISTEPN
17998C
17999      DOUBLE PRECISION DX
18000      DOUBLE PRECISION DS
18001      DOUBLE PRECISION DU
18002      DOUBLE PRECISION DN
18003      DOUBLE PRECISION DR
18004      DOUBLE PRECISION DNP
18005      DOUBLE PRECISION DLIK
18006      DOUBLE PRECISION DSUM1
18007      DOUBLE PRECISION DTERM1
18008      DOUBLE PRECISION DTERM3
18009C
18010C---------------------------------------------------------------------
18011C
18012      DIMENSION Y(*)
18013C
18014C-----COMMON----------------------------------------------------------
18015C
18016      INCLUDE 'DPCOP2.INC'
18017C
18018C-----START POINT-----------------------------------------------------
18019C
18020      ISUBN1='EXPL'
18021      ISUBN2='I2  '
18022      IERROR='NO'
18023C
18024      ALIK=-99.0
18025      AIC=-99.0
18026      AICC=-99.0
18027      BIC=-99.0
18028C
18029      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PLI2')THEN
18030        WRITE(ICOUT,999)
18031  999   FORMAT(1X)
18032        CALL DPWRST('XXX','WRIT')
18033        WRITE(ICOUT,51)
18034   51   FORMAT('**** AT THE BEGINNING OF EXPLI2--')
18035        CALL DPWRST('XXX','WRIT')
18036        WRITE(ICOUT,52)IBUGA3,ISUBRO
18037   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
18038        CALL DPWRST('XXX','WRIT')
18039        WRITE(ICOUT,55)N,ALOC,SCALE
18040   55   FORMAT('N,ALOC,SCALE = ',I8,2G15.7)
18041        CALL DPWRST('XXX','WRIT')
18042        DO56I=1,MIN(N,100)
18043          WRITE(ICOUT,57)I,Y(I),X(I)
18044   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
18045          CALL DPWRST('XXX','WRIT')
18046   56   CONTINUE
18047      ENDIF
18048C
18049C               ******************************************
18050C               **  STEP 1--                            **
18051C               **  COMPUTE LIKELIHOOD FUNCTION         **
18052C               ******************************************
18053C
18054      ISTEPN='1'
18055      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PLI2')
18056     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18057C
18058      IERFLG=0
18059      IERROR='NO'
18060      IWRITE='OFF'
18061      IF(ICASPL.EQ.'1EXP')ALOC=0.0
18062C
18063C     THE LOG-LIKELIHOOD FUNCTION IS
18064C
18065C     SUM[i=1 to N][-(X(i)-U)/S] - R*LOG(S)   X(i) > U
18066C
18067      DN=DBLE(N)
18068      DS=DBLE(SCALE)
18069      DU=DBLE(ALOC)
18070      DR=DBLE(IR)
18071      DTERM1=DN*DLOG(DR)
18072      DSUM1=0.0D0
18073      DO1000I=1,N
18074        IF(X(I).GT.0.5 .AND. Y(I).GT.ALOC)THEN
18075          DX=DBLE(Y(I))
18076          DSUM1=DSUM1 - (DX-DU)/DS
18077        ENDIF
18078 1000 CONTINUE
18079      DLIK=DSUM1 - DTERM1
18080C
18081      ALIK=REAL(DLIK)
18082      DNP=2.0D0
18083      IF(ICASPL.EQ.'1EXP')DNP=1.0D0
18084      AIC=REAL(-2.0D0*DLIK + 2.0D0*DNP)
18085      DTERM3=(2.0D0*DNP*(DNP+1.0D0))/(DN-DNP-1.0D0)
18086      AICC=REAL(-2.0D0*DLIK + 2.0D0*DNP + DTERM3)
18087      BIC=REAL(-2.0D0*DLIK + DNP*LOG(DN))
18088C
18089      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PLI2')THEN
18090        WRITE(ICOUT,999)
18091        CALL DPWRST('XXX','WRIT')
18092        WRITE(ICOUT,9011)
18093 9011   FORMAT('**** AT THE END OF EXPLI2--')
18094        CALL DPWRST('XXX','WRIT')
18095        WRITE(ICOUT,9013)DSUM1,DSUM2,DTERM1,DTERM3
18096 9013   FORMAT('DSUM1,DSUM2,DTERM1,DTERM3 = ',3G15.7)
18097        CALL DPWRST('XXX','WRIT')
18098        WRITE(ICOUT,9014)ALIK,AIC,AICC,BIC
18099 9014   FORMAT('ALIK,AIC,AICC,BIC = ',4G15.7)
18100        CALL DPWRST('XXX','WRIT')
18101      ENDIF
18102C
18103      RETURN
18104      END
18105      SUBROUTINE EV1ML1(Y,N,MINMAX,IGUMBC,ICASE,
18106     1                  DTEMP,
18107     1                  ALOWLO,AUPPLO,ALOWSC,AUPPSC,
18108     1                  ALOWL2,AUPPL2,ALOWS2,AUPPS2,
18109     1                  ALPHA,NUMALP,NUMOUT,
18110     1                  XMEAN,XSD,XMIN,XMAX,
18111     1                  ALOCMO,ASCAMO,ALMOSE,ASMOSE,
18112     1                  ALOCML,ASCAML,ASC2ML,ALMLSE,ASMLSE,COVSE,
18113     1                  ISUBRO,IBUGA3,IERROR)
18114C
18115C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
18116C              FOR THE EXTREME VALUE TYPE 1 (GUMBEL) DISTRIBUTION FOR
18117C              THE RAW DATA CASE (I.E., NO CENSORING AND NO GROUPING).
18118C              IT WILL OPTIONALLY RETURN THE CONFIDENCE INTERVALS FOR
18119C              THE LOCATION AND SCALE PARAMETERS.
18120C
18121C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
18122C              PERFORMED.
18123C
18124C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
18125C              FROM MULTIPLE PLACES (DPMGU1 WILL GENERATE THE OUTPUT
18126C              FOR THE EXTREME VALUE TYPE 1 MLE COMMAND).
18127C
18128C     WRITTEN BY--ALAN HECKERT
18129C                 STATISTICAL ENGINEERING DIVISION
18130C                 INFORMATION TECHNOLOGY LABORATORY
18131C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18132C                 GAITHERSBURG, MD 20899-8980
18133C                 PHONE--301-975-2899
18134C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18135C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18136C     LANGUAGE--ANSI FORTRAN (1977)
18137C     VERSION NUMBER--2009/10
18138C     ORIGINAL VERSION--OCTOBER   2009. EXTRACTED AS A SEPARATE
18139C                                       SUBROUTINE (FROM DPMGU1)
18140C
18141C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18142C
18143      DIMENSION ALOWLO(*)
18144      DIMENSION AUPPLO(*)
18145      DIMENSION ALOWSC(*)
18146      DIMENSION AUPPSC(*)
18147      DIMENSION ALPHA(*)
18148      DIMENSION ALOWL2(*)
18149      DIMENSION AUPPL2(*)
18150      DIMENSION ALOWS2(*)
18151      DIMENSION AUPPS2(*)
18152C
18153      CHARACTER*4 IGUMBC
18154      CHARACTER*4 ISUBRO
18155      CHARACTER*4 IBUGA3
18156      CHARACTER*4 IERROR
18157C
18158      CHARACTER*4 IWRITE
18159      CHARACTER*40 IDIST
18160C
18161      CHARACTER*4 ISUBN1
18162      CHARACTER*4 ISUBN2
18163      CHARACTER*4 ISTEPN
18164C
18165      INTEGER IFLAG
18166      INTEGER ICASE
18167C
18168      DIMENSION Y(*)
18169      DOUBLE PRECISION DTEMP(*)
18170C
18171      DOUBLE PRECISION EV1FU2
18172      DOUBLE PRECISION EV1FU3
18173      DOUBLE PRECISION EV1FU4
18174      EXTERNAL EV1FU2
18175      EXTERNAL EV1FU3
18176      EXTERNAL EV1FU4
18177C
18178      INTEGER IN
18179      DOUBLE PRECISION XBAR
18180      COMMON/EV1CO2/XBAR,MINMX2,IN
18181      DOUBLE PRECISION DK
18182      DOUBLE PRECISION DLLUS
18183      COMMON/EV1CO3/DK, DLLUS
18184      DOUBLE PRECISION SHAT
18185      COMMON/EV1CO4/SHAT
18186      DOUBLE PRECISION DQ
18187      DOUBLE PRECISION SHATML
18188      COMMON/EV1CO6/DQ,SHATML
18189C
18190      DOUBLE PRECISION DN
18191      DOUBLE PRECISION DTERM1
18192      DOUBLE PRECISION DAE
18193      DOUBLE PRECISION DRE
18194      DOUBLE PRECISION DSUM1
18195      DOUBLE PRECISION DXSTRT
18196      DOUBLE PRECISION DXLOW
18197      DOUBLE PRECISION DXUP
18198      DOUBLE PRECISION XLOWSV
18199      DOUBLE PRECISION XUPSV
18200C
18201C-----COMMON----------------------------------------------------------
18202C
18203      INCLUDE 'DPCOP2.INC'
18204C
18205C-----START POINT-----------------------------------------------------
18206C
18207      ISUBN1='EV1M'
18208      ISUBN2='L1  '
18209      IWRITE='OFF'
18210      IERROR='NO'
18211C
18212      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'1ML1')THEN
18213        WRITE(ICOUT,999)
18214  999   FORMAT(1X)
18215        CALL DPWRST('XXX','WRIT')
18216        WRITE(ICOUT,51)
18217   51   FORMAT('**** AT THE BEGINNING OF EV1ML1--')
18218        CALL DPWRST('XXX','WRIT')
18219        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,MAXNXT,MINMAX,ICASE
18220   52   FORMAT('IBUGA3,ISUBRO,N,MAXNXT,MINMAX,ICASE = ',2(A4,2X),4I8)
18221        CALL DPWRST('XXX','WRIT')
18222        DO56I=1,MIN(N,100)
18223          WRITE(ICOUT,57)I,Y(I)
18224   57     FORMAT('I,Y(I) = ',I8,G15.7)
18225          CALL DPWRST('XXX','WRIT')
18226   56   CONTINUE
18227      ENDIF
18228C
18229C               ********************************************
18230C               **  STEP 1--                              **
18231C               **  CARRY OUT CALCULATIONS                **
18232C               **  FOR EXTREME VALUE TYPE 1 MLE ESTIMATE **
18233C               ********************************************
18234C
18235      ISTEPN='1'
18236      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'1ML1')
18237     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18238C
18239      IDIST='EXTREME VALUE TYPE 1'
18240      IFLAG=0
18241      CALL SUMRAW(Y,N,IDIST,IFLAG,
18242     1            XMEAN,XVAR,XSD,XMIN,XMAX,
18243     1            ISUBRO,IBUGA3,IERROR)
18244C
18245C     MOMENT ESTIMATES ARE:
18246C
18247C        MUHAT = XBAR - 0.45006*SD
18248C        SHAT  = 0.77970*SD
18249C
18250C     THE ML ESTIMATE OF THE SCALE PARAMETER IS THE SOLUTION TO
18251C     THE FOLLOWING EQUATION:
18252C
18253C         FOR THE MAXIMUM CASE:
18254C
18255C             SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(-X(I)/SHAT)]/
18256C                    SUM[i=1 to N][EXP(-X(I)/SHAT)] = 0
18257C
18258C         FOR THE MINIMUM CASE:
18259C
18260C             SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(X(I)/SHAT)]/
18261C                    SUM[i=1 to N][EXP(X(I)/SHAT)] = 0
18262C
18263C         WITH
18264C
18265C             SHAT     = CURRENT ESTIMATE OF SCALE PARAMETER
18266C             XBAR     = SAMPLE MEAN
18267C             N        = SAMPLE SIZE
18268C             MINMAX   = SPECIFY WHETHER MAXIMUM OR MINIMUM
18269C                        CASE IS BEING ESTIMATED
18270C
18271C     THE ML ESTIMATE OF LOCATION FOR THE MAXIMUM CASE IS
18272C
18273C         MUHAT = -SHAT*LOG(SUM[i=1 to N][EXP(-X(I)/SHAT)]/N)
18274C
18275C     THE ML ESTIMATE OF LOCATION FOR THE MINIMUM CASE IS
18276C
18277C         MUHAT = -SHAT*LOG(SUM[i=1 to N][EXP(X(I)/SHAT)]/N)
18278C
18279      AN=REAL(N)
18280      DN=DBLE(N)
18281      IF(MINMAX.EQ.0 .OR. MINMAX.EQ.2)THEN
18282        ALOCMO=XMEAN - 0.45006*XSD
18283      ELSE
18284        ALOCMO=XMEAN + 0.45006*XSD
18285      ENDIF
18286      ASCAMO=0.77970*XSD
18287      ALMOSE=SQRT(1.16781*ASCAMO**2/AN)
18288      ASMOSE=1.10001*XSD**2/AN
18289C
18290      XBAR=DBLE(XMEAN)
18291      MINMX2=MINMAX
18292      IN=N
18293C
18294      DXSTRT=DBLE(ASCAMO)
18295      DAE=2.0*0.000001D0*DXSTRT
18296      DRE=DAE
18297      IFLAG=0
18298      DXLOW=DXSTRT/2.0D0
18299      DXUP=2.0D0*DXSTRT
18300      ITBRAC=0
18301      DO3104I=1,N
18302        DTEMP(I)=DBLE(Y(I))
18303 3104 CONTINUE
18304C
18305 3105 CONTINUE
18306      XLOWSV=DXLOW
18307      XUPSV=DXUP
18308      CALL DFZER2(EV1FU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
18309C
18310      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
18311        DXLOW=XLOWSV/2.0D0
18312        DXUP=2.0D0*XUPSV
18313        ITBRAC=ITBRAC+1
18314        GOTO3105
18315      ENDIF
18316C
18317      IF(IFLAG.EQ.2)THEN
18318C
18319C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
18320CCCCC   WRITE(ICOUT,999)
18321CCCCC   CALL DPWRST('XXX','BUG ')
18322CCCCC   WRITE(ICOUT,111)
18323CC111   FORMAT('***** WARNING FROM GUMBEL MAXIMUM ',
18324CCCCC1         'LIKELIHOOD--')
18325CCCCC   CALL DPWRST('XXX','BUG ')
18326CCCCC   WRITE(ICOUT,113)
18327CC113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
18328CCCCC1         'DESIRED TOLERANCE.')
18329CCCCC   CALL DPWRST('XXX','BUG ')
18330      ELSEIF(IFLAG.EQ.3)THEN
18331        WRITE(ICOUT,999)
18332        CALL DPWRST('XXX','BUG ')
18333        WRITE(ICOUT,121)
18334  121   FORMAT('***** WARNING FROM GUMBEL MAXIMUM LIKELIHOOD--')
18335        CALL DPWRST('XXX','BUG ')
18336        WRITE(ICOUT,123)
18337  123   FORMAT('      ESTIMATE OF SCALE MAY BE NEAR A SINGULAR POINT.')
18338        CALL DPWRST('XXX','BUG ')
18339      ELSEIF(IFLAG.EQ.4)THEN
18340        WRITE(ICOUT,999)
18341        CALL DPWRST('XXX','BUG ')
18342        WRITE(ICOUT,131)
18343  131   FORMAT('***** ERROR FROM GUMBEL MAXIMUM LIKELIHOOD--')
18344        CALL DPWRST('XXX','BUG ')
18345        WRITE(ICOUT,133)
18346  133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
18347        CALL DPWRST('XXX','BUG ')
18348      ELSEIF(IFLAG.EQ.5)THEN
18349        WRITE(ICOUT,999)
18350        CALL DPWRST('XXX','BUG ')
18351        WRITE(ICOUT,121)
18352        CALL DPWRST('XXX','BUG ')
18353        WRITE(ICOUT,143)
18354  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
18355        CALL DPWRST('XXX','BUG ')
18356      ENDIF
18357C
18358      ASCAML=REAL(DXLOW)
18359      BN=(1.0 + 2.2/AN**1.13)
18360      ASC2ML=BN*ASCAML
18361C
18362      DSUM1=0.0D0
18363      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
18364        DO3108I=1,N
18365          DX=-DBLE(Y(I))
18366          DSUM1=DSUM1 + DEXP(DX/DBLE(ASCAML))
18367 3108   CONTINUE
18368        DTERM1=-DBLE(ASCAML)*DLOG(DSUM1/DN)
18369      ELSE
18370        DO3109I=1,N
18371          DX=DBLE(Y(I))
18372          DSUM1=DSUM1 + DEXP(DX/DBLE(ASCAML))
18373 3109   CONTINUE
18374        DTERM1=DBLE(ASCAML)*DLOG(DSUM1/DN)
18375      ENDIF
18376      ALOCML=REAL(DTERM1)
18377C
18378      ASMLSE=0.77970*ASCAML/SQRT(AN)
18379      ALMLSE=1.05293*ASCAML/SQRT(AN)
18380      COVSE=0.50697*ASCAML/SQRT(AN)
18381      IF(IGUMBC.EQ.'ON')THEN
18382        ASMLSE=ASMLSE*BN
18383        COVSE=COVSE*SQRT(BN)
18384      ENDIF
18385C
18386      IF(ICASE.EQ.0)GOTO9000
18387C
18388      IF(IGUMBC.EQ.'ON')THEN
18389        SCTEMP=ASC2ML
18390      ELSE
18391        SCTEMP=ASCAML
18392      ENDIF
18393C
18394      DSUM1=0.0D0
18395      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
18396        DO3110I=1,N
18397          DSUM1=DSUM1 + DEXP(-(Y(I) - DBLE(ALOCML))/DBLE(ASCAML))
18398 3110   CONTINUE
18399        DLLUS=-DN*DLOG(DBLE(ASCAML)) - DN*XBAR/DBLE(ASCAML) +
18400     1         DN*DBLE(ALOCML)/DBLE(ASCAML) - DSUM1
18401      ELSE
18402        DO3115I=1,N
18403          DSUM1=DSUM1 + DEXP((Y(I) + DBLE(ALOCML))/DBLE(ASCAML))
18404 3115   CONTINUE
18405        DLLUS=-DN*DLOG(DBLE(ASCAML)) - DN*XBAR/DBLE(ASCAML) +
18406     1         DN*DBLE(ALOCML)/DBLE(ASCAML) - DSUM1
18407      ENDIF
18408      SHAT=DBLE(SCTEMP)
18409C
18410      DAE=1.D-7
18411      DRE=1.D-7
18412      NUTEMP=1
18413C
18414      DO3120I=1,NUMALP
18415C
18416        ALP=ALPHA(I)
18417        P=1.0-(ALP/2.0)
18418        CALL NORPPF(P,APPF)
18419        ALOWSC(I)=SCTEMP - APPF*ASMLSE
18420        AUPPSC(I)=SCTEMP + APPF*ASMLSE
18421        ALOWLO(I)=ALOCML - APPF*ALMLSE
18422        AUPPLO(I)=ALOCML + APPF*ALMLSE
18423C
18424        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
18425        DK=DBLE(APPF)
18426C
18427        DXSTRT=DBLE(ALOWSC(I))
18428        DXLOW=DXSTRT/5.0D0
18429        DXUP=DBLE(SCTEMP)
18430        CALL DFZER2(EV1FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
18431        ALOWS2(I)=REAL(DXLOW)
18432C
18433        DXSTRT=DBLE(AUPPSC(I))
18434        DXUP=DXSTRT*5.0D0
18435        DXLOW=DBLE(SCTEMP)
18436        CALL DFZER2(EV1FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
18437        AUPPS2(I)=REAL(DXLOW)
18438C
18439        DXSTRT=DBLE(ALOWLO(I))
18440        DXLOW=DXSTRT/2.0D0
18441        DXUP=DBLE(ALOCML)
18442        CALL DFZER2(EV1FU4,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
18443        ALOWL2(I)=REAL(DXLOW)
18444C
18445        DXSTRT=DBLE(AUPPLO(I))
18446        DXUP=DXSTRT*2.0D0
18447        DXLOW=DBLE(ALOCML)
18448        CALL DFZER2(EV1FU4,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
18449        AUPPL2(I)=REAL(DXLOW)
18450C
18451 3120 CONTINUE
18452C
18453      NUMOUT=NUMALP
18454C
18455 9000 CONTINUE
18456      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'1ML1')THEN
18457        WRITE(ICOUT,999)
18458        CALL DPWRST('XXX','WRIT')
18459        WRITE(ICOUT,9011)
18460 9011   FORMAT('**** AT THE END OF EV1ML1--')
18461        CALL DPWRST('XXX','WRIT')
18462        WRITE(ICOUT,9055)N,XMEAN,XSD,XMIN,XMAX
18463 9055   FORMAT('N,XMEAN,XSD,XMIN,XMAX = ',I8,4G15.7)
18464        CALL DPWRST('XXX','WRIT')
18465        WRITE(ICOUT,9056)ALOCMO,ASCAMO,ALMOSE,ASMOSE
18466 9056   FORMAT('ALOCMO,ASCAMO,ALMOSE,ASMOSE = ',4G15.7)
18467        CALL DPWRST('XXX','WRIT')
18468        WRITE(ICOUT,9057)ALOCML,ASCAML,ALMLSE,ASMLSE
18469 9057   FORMAT('ALOCML,ASCAML,ALMLSE,ASMLSE = ',4G15.7)
18470        CALL DPWRST('XXX','WRIT')
18471        DO9060I=1,NUMALP
18472          WRITE(ICOUT,9065)I,ALPHA(I),ALOWLO(I),AUPPLO(I),ALOWSC(I),
18473     1                     AUPPSC(I)
18474 9065     FORMAT('I,ALPHA(I),ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I)=',
18475     1           I8,5G15.7)
18476          CALL DPWRST('XXX','WRIT')
18477          WRITE(ICOUT,9066)I,ALPHA(I),ALOWL2(I),AUPPL2(I),ALOWS2(I),
18478     1                     AUPPSC(I)
18479 9066     FORMAT('I,ALPHA(I),ALOWL2(I),AUPPL2(I),ALOWS2(I),AUPPS2(I)=',
18480     1           I8,5G15.7)
18481          CALL DPWRST('XXX','WRIT')
18482 9060   CONTINUE
18483      ENDIF
18484C
18485      RETURN
18486      END
18487      SUBROUTINE EV1PDF(X,MINMAX,PDF)
18488C
18489C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
18490C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
18491C              DISTRIBUTION.
18492C              THE EXTREME VALUE TYPE 1 DISTRIBUTION USED
18493C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
18494C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
18495C              THIS DISTRIBUTION IS DEFINED FOR ALL X
18496C              AND HAS THE PROBABILITY DENSITY FUNCTION
18497C              FOR THE MAXIMUM ORDER STATISTIC
18498C              F(X) = (EXP(-X)) * (EXP(-(EXP(-X))))
18499C              WHICH SIMPLIFIES TO:
18500C              F(X) = EXP(-X - EXP(-X))
18501C              FOR THE MINIMUIM ORDER STATISTIC
18502C              F(X) = (EXP(X)) * (EXP(-(EXP(X))))
18503C              WHICH SIMPLIFIES TO:
18504C              F(X) = EXP(-X - EXP(-X))
18505C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
18506C                                AT WHICH THE CUMULATIVE DISTRIBUTION
18507C                                FUNCTION IS TO BE EVALUATED.
18508C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
18509C                                DISTRIBUTION FUNCTION VALUE.
18510C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
18511C             FUNCTION VALUE CDF FOR THE EXTREME VALUE TYPE 1
18512C             DISTRIBUTION WITH MEAN = EULER'S NUMBER = 0.57721566
18513C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
18514C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
18515C     RESTRICTIONS--NONE.
18516C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
18517C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
18518C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
18519C     LANGUAGE--ANSI FORTRAN.
18520C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
18521C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
18522C     WRITTEN BY--JAMES J. FILLIBEN
18523C                 STATISTICAL ENGINEERING LABORATORY (205.03)
18524C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18525C                 GAITHERSBURG, MD 20899
18526C                 PHONE:  301-921-2315
18527C     ORIGINAL VERSION--APRIL     1994.
18528C     UPDATED         --JULY      2004. CODE IN DOUBLE PRECISION FOR
18529C                                       BETTER ACCURACY
18530C
18531C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18532C
18533C---------------------------------------------------------------------
18534C
18535      DOUBLE PRECISION DX
18536      DOUBLE PRECISION DPDF
18537C
18538      INCLUDE 'DPCOP2.INC'
18539C
18540C---------------------------------------------------------------------
18541C
18542C     CHECK THE INPUT ARGUMENTS FOR ERRORS.
18543C     NO INPUT ARGUMENT ERRORS POSSIBLE
18544C     FOR THIS DISTRIBUTION.
18545C
18546C-----START POINT-----------------------------------------------------
18547C
18548      DX=DBLE(X)
18549      DPDF=0.0D0
18550      IF(MINMAX.EQ.1)THEN
18551        DPDF=DEXP(DX-DEXP(DX))
18552      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
18553        DPDF=DEXP(-DX-DEXP(-DX))
18554      ELSE
18555         WRITE(ICOUT,1800)
18556 1800    FORMAT('*****ERROR IN EV1PDF--MINMAX NOT 1 OR 2')
18557         CALL DPWRST('XXX','BUG ')
18558      END IF
18559      PDF=REAL(DPDF)
18560C
18561      RETURN
18562      END
18563      SUBROUTINE EV1PPF(P,MINMAX,PPF)
18564CCCCC MINMAX ADDED TO ABOVE ARGUMENT LIST   MAY 1993
18565C
18566C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
18567C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 1
18568C              (= GUMBEL)
18569C              DISTRIBUTION.
18570C              THERE ARE 2 SUCH EV1 FAMILIES--
18571C                 ONE FOR THE MIN ORDER STAT AND
18572C                 ONE FOR THE MAX ORDER STAT (THE USUAL).
18573C              (SEE SARHAN & GREENBERG, PAGE 69)
18574C              THE EV1 TYPE IS SPECIFIED VIA   MINMAX
18575C              FOR MINMAX = 1  (FOR THE MINIMUM)
18576C                 THE WEIBULL DISTRIBUTION USED
18577C                 HEREIN IS DEFINED FOR ALL X,
18578C                 AND HAS THE PROBABILITY DENSITY FUNCTION
18579C                 F(X) = ...
18580C              FOR MINMAX = 2 (FOR THE DEFAULT MAXIMUM),
18581C                 THE EV1 DISTRIBUTION USED
18582C                 HEREIN IS DEFINED FOR ALL X,
18583C                 HAS MEAN = EULER'S NUMBER = 0.57721566
18584C                 HAS STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
18585C                 AND HAS THE PROBABILITY DENSITY FUNCTION
18586C                 F(X) = (EXP(-X)) * (EXP(-(EXP(-X))))
18587C              NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION
18588C              IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE
18589C              DISTRIBUTION FUNCTION OF THE DISTRIBUTION.
18590C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
18591C                                (BETWEEN 0.0 (EXCLUSIVELY)
18592C                                AND 1.0 (EXCLUSIVELY))
18593C                                AT WHICH THE PERCENT POINT
18594C                                FUNCTION IS TO BE EVALUATED.
18595C                     --MINMAX = THE INTEGER VALUE
18596C                                IDENTIFYING THE
18597C                                CHOSEN WEIBULL DISTRIBUTION.
18598C                                1 = MIN, 2 = MAX.
18599C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
18600C                                POINT FUNCTION VALUE.
18601C     OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION .
18602C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
18603C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
18604C                   AND 1.0 (EXCLUSIVELY).
18605C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
18606C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG.
18607C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
18608C     LANGUAGE--ANSI FORTRAN (1977)
18609C     REFERENCES--SARHAN & GREENBERG,
18610C                 CONTRIBUTIONS TO ORDER STATISTICS,
18611C                 1962, WILEY, PAGE 69.
18612C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
18613C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
18614C     WRITTEN BY--JAMES J. FILLIBEN
18615C                 STATISTICAL ENGINEERING DIVISION
18616C                 INFORMATION TECHNOLOGY LABORATORY
18617C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18618C                 GAITHERSBURG, MD 20899
18619C                 PHONE--301-975-2855
18620C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18621C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18622C     LANGUAGE--ANSI FORTRAN (1966)
18623C     VERSION NUMBER--82/7
18624C     ORIGINAL VERSION--NOVEMBER  1975.
18625C     UPDATED         --DECEMBER  1981.
18626C     UPDATED         --MAY       1982.
18627C     UPDATED         --MAY       1993. REWRITTEN--ADD EV1/MIN DIST.
18628C     UPDATED         --JANUARY   1994. ADD MINMAX ERROR MESSAGE
18629C     UPDATED         --JULY      2004. CODE IN DOUBLE PRECISION
18630C                                       FOR BETTER ACCURACY.
18631C
18632C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18633C
18634C---------------------------------------------------------------------
18635C
18636      DOUBLE PRECISION DP
18637      DOUBLE PRECISION DPPF
18638C
18639C-----COMMON----------------------------------------------------------
18640C
18641      INCLUDE 'DPCOP2.INC'
18642C
18643C-----START POINT-----------------------------------------------------
18644C
18645C     CHECK THE INPUT ARGUMENTS FOR ERRORS
18646C
18647      IF(P.LE.0.0.OR.P.GE.1.0)THEN
18648        WRITE(ICOUT,1)
18649        CALL DPWRST('XXX','BUG ')
18650        WRITE(ICOUT,46)P
18651        CALL DPWRST('XXX','BUG ')
18652        PPF=0.0
18653        GOTO9000
18654      ENDIF
18655    1 FORMAT('***** ERROR--THE FIRST  ARGUMENT TO EV1PPF ',
18656     1       'IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL')
18657   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7,'.')
18658C
18659CCCCC THE FOLLOWING LINE WAS REWRITTEN   MAY 1993
18660CCCCC PPF=(-(LOG(-LOG(P))))
18661C
18662CCCCC THE FOLLOWING SECTION WAS REWRITTEN      JANUARY 1994
18663      DPPF=0.0D0
18664      DP=DBLE(P)
18665      IF(MINMAX.EQ.1)THEN
18666         DPPF=DLOG(DLOG(1.0D0/(1.0D0-DP)))
18667      ELSE IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
18668         DPPF=(-(DLOG(DLOG(1.0D0/DP))))
18669      ELSE
18670         WRITE(ICOUT,1800)
18671 1800    FORMAT('*****ERROR IN EV1PPF--MINMAX NOT 1 OR 2')
18672         CALL DPWRST('XXX','BUG ')
18673      ENDIF
18674      PPF=REAL(DPPF)
18675C
18676 9000 CONTINUE
18677      RETURN
18678      END
18679      SUBROUTINE EV1RAN(N,MINMAX,ISEED,X)
18680CCCCC MINMAX WAS ADDED TO THE ABOVE ARGUMENT LIST   MAY 1993
18681C
18682C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
18683C              FROM THE EXTREME VALUE TYPE 1 DISTRIBUTION.
18684C              THE PROTOTYPE EXTREME VALUE TYPE 1 DISTRIBUTION USED
18685C              HEREIN HAS MEAN = EULER'S NUMBER = 0.57721566
18686C              AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
18687C              THIS DISTRIBUTION IS DEFINED FOR ALL X
18688C              AND HAS THE PROBABILITY DENSITY FUNCTION
18689C              F(X) = (EXP(-X)) * (EXP(-(EXP(-X))))
18690C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
18691C                                OF RANDOM NUMBERS TO BE
18692C                                GENERATED.
18693C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
18694C                                (OF DIMENSION AT LEAST N)
18695C                                INTO WHICH THE GENERATED
18696C                                RANDOM SAMPLE WILL BE PLACED.
18697C                     --MINMAX = THE INTEGER VALUE
18698C                                IDENTIFYING THE
18699C                                CHOSEN WEIBULL DISTRIBUTION.
18700C                                1 = MIN, 2 = MAX.
18701C     OUTPUT--A RANDOM SAMPLE OF SIZE N
18702C             FROM THE EXTREME VALUE TYPE 1 DISTRIBUTION
18703C             WITH MEAN = EULER'S NUMBER = 0.57721566
18704C             AND STANDARD DEVIATION = PI/SQRT(6) = 1.28254983.
18705C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
18706C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
18707C                   OF N FOR THIS SUBROUTINE.
18708C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
18709C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG.
18710C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
18711C     LANGUAGE--ANSI FORTRAN (1977)
18712C     REFERENCES--SARHAN & GREENBERG,
18713C                 CONTRIBUTIONS TO ORDER STATISTICS,
18714C                 1962, WILEY, PAGE 69.
18715C               --TOCHER, THE ART OF SIMULATION,
18716C                 1963, PAGES 14-15.
18717C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
18718C                 1964, PAGE 36.
18719C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
18720C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
18721C     WRITTEN BY--JAMES J. FILLIBEN
18722C                 STATISTICAL ENGINEERING DIVISION
18723C                 INFORMATION TECHNOLOGY LABORATORY
18724C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18725C                 GAITHERSBURG, MD 20899
18726C                 PHONE--301-975-2855
18727C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18728C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18729C     LANGUAGE--ANSI FORTRAN (1966)
18730C     VERSION NUMBER--82/7
18731C     ORIGINAL VERSION--NOVEMBER  1975.
18732C     UPDATED         --DECEMBER  1981.
18733C     UPDATED         --MAY       1982.
18734C     UPDATED         --MAY       1993. REWRITTEN--ADD EV1/MIN DIST.
18735C     UPDATED         --JANUARY   1994. ADD MINMAX ERROR MESSAGE
18736C
18737C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18738C
18739C---------------------------------------------------------------------
18740C
18741      DIMENSION X(*)
18742C
18743C-----COMMON----------------------------------------------------------
18744C
18745      INCLUDE 'DPCOP2.INC'
18746C
18747C-----START POINT-----------------------------------------------------
18748C
18749C     CHECK THE INPUT ARGUMENTS FOR ERRORS
18750C
18751      IF(N.LT.1)GOTO50
18752      GOTO90
18753   50 WRITE(ICOUT, 5)
18754      CALL DPWRST('XXX','BUG ')
18755      WRITE(ICOUT,47)N
18756      CALL DPWRST('XXX','BUG ')
18757      RETURN
18758   90 CONTINUE
18759    5 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ',
18760     1'EV1RAN SUBROUTINE IS NON-POSITIVE *****')
18761   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
18762C
18763C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
18764C
18765      CALL UNIRAN(N,ISEED,X)
18766C
18767C     GENERATE N EXTREME VALUE TYPE 1 RANDOM NUMBERS
18768C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
18769C
18770CCCCC THE FOLLOWING SECTION WAS REWRITTEN   MAY 1993
18771CCCCC DO100I=1,N
18772CCCCC X(I)=-LOG(LOG(1.0/X(I)))
18773CC100 CONTINUE
18774C
18775CCCCC THE FOLLOWING SECTION WAS REWRITTEN      JANUARY 1994
18776      IF(MINMAX.EQ.1)THEN
18777         DO100I=1,N
18778         X(I)=LOG(LOG(1.0/(1.0-X(I))))
18779  100    CONTINUE
18780      ELSE IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
18781         DO200I=1,N
18782         X(I)=(-(LOG(LOG(1.0/X(I)))))
18783  200    CONTINUE
18784      ELSE
18785         WRITE(ICOUT,1800)
18786 1800    FORMAT('*****ERROR IN EV1RAN--MINMAX NOT 1 OR 2')
18787         CALL DPWRST('XXX','BUG ')
18788      ENDIF
18789C
18790      RETURN
18791      END
18792      SUBROUTINE EV2CDF(X,GAMMA,MINMAX,CDF)
18793C
18794C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
18795C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2
18796C              DISTRIBUTION WITH SINGLE PRECISION
18797C              TAIL LENGTH PARAMETER = GAMMA.
18798C              THE EXTREME VALUE TYPE 2 DISTRIBUTION USED
18799C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
18800C              AND HAS THE PROBABILITY DENSITY FUNCTION
18801C              FOR THE MAXIMUM ORDER STATISTIC
18802C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
18803C              FOR THE MINIMUM ORDER STATISTIC
18804C              F(X) = GAMMA * ((-X)**(-GAMMA-1)) * EXP(-((-X)**(-GAMMA))).
18805C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
18806C                                AT WHICH THE CUMULATIVE DISTRIBUTION
18807C                                FUNCTION IS TO BE EVALUATED.
18808C                                X SHOULD BE NON-NEGATIVE.
18809C                     --GAMMA  = THE SINGLE PRECISION VALUE
18810C                                OF THE TAIL LENGTH PARAMETER.
18811C                                GAMMA SHOULD BE POSITIVE.
18812C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
18813C                                DISTRIBUTION FUNCTION VALUE.
18814C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
18815C             FUNCTION VALUE CDF FOR THE EXTREME VALUE TYPE 2
18816C             DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
18817C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
18818C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
18819C                 --X SHOULD BE NON-NEGATIVE.
18820C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
18821C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
18822C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
18823C     LANGUAGE--ANSI FORTRAN.
18824C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
18825C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
18826C     WRITTEN BY--JAMES J. FILLIBEN
18827C                 STATISTICAL ENGINEERING LABORATORY (205.03)
18828C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18829C                 GAITHERSBURG, MD 20899
18830C                 PHONE:  301-921-2315
18831C     ORIGINAL VERSION--APRIL     1994.
18832C
18833C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18834C
18835C-----COMMON----------------------------------------------------------
18836C
18837      INCLUDE 'DPCOP2.INC'
18838C
18839C---------------------------------------------------------------------
18840C
18841C     CHECK THE INPUT ARGUMENTS FOR ERRORS
18842C
18843      CDF=0.0
18844      IF(X.LT.0.0.AND.(MINMAX.EQ.2 .OR. MINMAX.EQ.0))THEN
18845        WRITE(ICOUT,4)
18846    4   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2CDF IS ',
18847     1         'NEGATIVE')
18848        CALL DPWRST('XXX','BUG ')
18849        WRITE(ICOUT,46)X
18850        CALL DPWRST('XXX','BUG ')
18851        WRITE(ICOUT,47)MINMAX
18852        CALL DPWRST('XXX','BUG ')
18853        GOTO9000
18854      ELSEIF(X.GT.0.0.AND.MINMAX.EQ.1)THEN
18855        WRITE(ICOUT,5)
18856    5   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2CDF IS ',
18857     1         'POSITIVE')
18858        CALL DPWRST('XXX','BUG ')
18859        WRITE(ICOUT,46)X
18860        CALL DPWRST('XXX','BUG ')
18861        WRITE(ICOUT,47)MINMAX
18862        CALL DPWRST('XXX','BUG ')
18863        GOTO9000
18864      ELSEIF(GAMMA.LE.0.0)THEN
18865        WRITE(ICOUT,15)
18866   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO EV2CDF ',
18867     1         'IS NON-POSITIVE')
18868        CALL DPWRST('XXX','BUG ')
18869        WRITE(ICOUT,46)GAMMA
18870        CALL DPWRST('XXX','BUG ')
18871        GOTO9000
18872      ENDIF
18873   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
18874   47 FORMAT('***** THE VALUE OF MINMAX IS ',I5)
18875C
18876C-----START POINT-----------------------------------------------------
18877C
18878      IF(MINMAX.EQ.1)THEN
18879        CDF=1.0
18880        IF(X.GE.0.0)GOTO9000
18881        CDF=1.0-EXP(-(-X)**(-GAMMA))
18882      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
18883        CDF=0.0
18884        IF(X.LE.0.0)GOTO9000
18885        CDF=EXP(-(X**(-GAMMA)))
18886      ELSE
18887         WRITE(ICOUT,1800)
18888 1800    FORMAT('*****ERROR IN EV2CDF--MINMAX NOT 1 OR 2')
18889         CALL DPWRST('XXX','BUG ')
18890      END IF
18891C
18892 9000 CONTINUE
18893      RETURN
18894      END
18895      SUBROUTINE EV2CDD(X,GAMMA,MINMAX,CDF)
18896C
18897C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
18898C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2
18899C              DISTRIBUTION WITH SINGLE PRECISION
18900C              TAIL LENGTH PARAMETER = GAMMA.
18901C              THE EXTREME VALUE TYPE 2 DISTRIBUTION USED
18902C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
18903C              AND HAS THE PROBABILITY DENSITY FUNCTION
18904C              FOR THE MAXIMUM ORDER STATISTIC
18905C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
18906C              FOR THE MINIMUM ORDER STATISTIC
18907C              F(X) = GAMMA * ((-X)**(-GAMMA-1)) * EXP(-((-X)**(-GAMMA))).
18908C     NOTE--THIS IS A DOUBLE PRECISION VERSION OF EV2CDF USED IN
18909C           CALCULATING HAZARD FUNCTIONS
18910C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
18911C                                AT WHICH THE CUMULATIVE DISTRIBUTION
18912C                                FUNCTION IS TO BE EVALUATED.
18913C                                X SHOULD BE NON-NEGATIVE.
18914C                     --GAMMA  = THE SINGLE PRECISION VALUE
18915C                                OF THE TAIL LENGTH PARAMETER.
18916C                                GAMMA SHOULD BE POSITIVE.
18917C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
18918C                                DISTRIBUTION FUNCTION VALUE.
18919C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
18920C             FUNCTION VALUE CDF FOR THE EXTREME VALUE TYPE 2
18921C             DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
18922C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
18923C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
18924C                 --X SHOULD BE NON-NEGATIVE.
18925C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
18926C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
18927C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
18928C     LANGUAGE--ANSI FORTRAN.
18929C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
18930C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
18931C     WRITTEN BY--JAMES J. FILLIBEN
18932C                 STATISTICAL ENGINEERING LABORATORY (205.03)
18933C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18934C                 GAITHERSBURG, MD 20899
18935C                 PHONE:  301-921-2315
18936C     ORIGINAL VERSION--APRIL     1994.
18937C
18938C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18939C
18940      DOUBLE PRECISION X
18941      DOUBLE PRECISION GAMMA
18942      DOUBLE PRECISION CDF
18943C
18944C-----COMMON----------------------------------------------------------
18945C
18946      INCLUDE 'DPCOP2.INC'
18947C
18948C---------------------------------------------------------------------
18949C
18950C     CHECK THE INPUT ARGUMENTS FOR ERRORS
18951C
18952      CDF=0.0D0
18953      IF(X.LT.0.0D0.AND.(MINMAX.EQ.2 .OR. MINMAX.EQ.0))THEN
18954        WRITE(ICOUT,4)
18955    4   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2CDF IS ',
18956     1         'NEGATIVE')
18957        CALL DPWRST('XXX','BUG ')
18958        WRITE(ICOUT,46)X
18959        CALL DPWRST('XXX','BUG ')
18960        WRITE(ICOUT,47)MINMAX
18961        CALL DPWRST('XXX','BUG ')
18962        GOTO9000
18963      ELSEIF(X.GT.0.0D0.AND.MINMAX.EQ.1)THEN
18964        WRITE(ICOUT,5)
18965    5   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2CDF IS ',
18966     1         'POSITIVE')
18967        CALL DPWRST('XXX','BUG ')
18968        WRITE(ICOUT,46)X
18969        CALL DPWRST('XXX','BUG ')
18970        WRITE(ICOUT,47)MINMAX
18971        CALL DPWRST('XXX','BUG ')
18972        GOTO9000
18973      ELSEIF(GAMMA.LE.0.0D0)THEN
18974        WRITE(ICOUT,15)
18975   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO EV2CDF ',
18976     1         'IS NON-POSITIVE')
18977        CALL DPWRST('XXX','BUG ')
18978        WRITE(ICOUT,46)GAMMA
18979        CALL DPWRST('XXX','BUG ')
18980        GOTO9000
18981      ENDIF
18982   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
18983   47 FORMAT('***** THE VALUE OF MINMAX IS ',I5)
18984C
18985C-----START POINT-----------------------------------------------------
18986C
18987      IF(MINMAX.EQ.1)THEN
18988        CDF=1.0D0
18989        IF(X.GE.0.0D0)GOTO9000
18990        CDF=1.0D0-DEXP(-(-X)**(-GAMMA))
18991      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
18992        CDF=0.0D0
18993        IF(X.LE.0.0D0)RETURN
18994        CDF=DEXP(-(X**(-GAMMA)))
18995      ELSE
18996         WRITE(ICOUT,1800)
18997 1800    FORMAT('*****ERROR IN EV2CDF--MINMAX NOT 1 OR 2')
18998         CALL DPWRST('XXX','BUG ')
18999      END IF
19000C
19001 9000 CONTINUE
19002      RETURN
19003      END
19004      SUBROUTINE EV2CHA(X,GAMMA,MINMAX,HAZ)
19005C
19006C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE HAZARD
19007C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2
19008C              DISTRIBUTION WITH SINGLE PRECISION
19009C              TAIL LENGTH PARAMETER = GAMMA.
19010C              THE EXTREME VALUE TYPE 2 DISTRIBUTION USED
19011C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
19012C              AND HAS THE PROBABILITY DENSITY FUNCTION
19013C              FOR THE MAXIMUM ORDER STATISTIC
19014C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
19015C              FOR THE MINIMUM ORDER STATISTIC
19016C              F(X) = GAMMA * ((-X)**(-GAMMA-1)) * EXP(-((-X)**(-GAMMA))).
19017C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
19018C                                AT WHICH THE PROBABILITY DENSITY
19019C                                FUNCTION IS TO BE EVALUATED.
19020C                                X SHOULD BE NON-NEGATIVE.
19021C                     --GAMMA  = THE SINGLE PRECISION VALUE
19022C                                OF THE TAIL LENGTH PARAMETER.
19023C                                GAMMA SHOULD BE POSITIVE.
19024C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION CUMULATIVE HAZARD
19025C                                FUNCTION VALUE.
19026C     OUTPUT--THE SINGLE PRECISION CUMULATIVE HAZARD
19027C             FUNCTION VALUE HAZ FOR THE EXTREME VALUE TYPE 2
19028C             DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
19029C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
19030C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
19031C                 --X SHOULD BE NON-NEGATIVE.
19032C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
19033C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
19034C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
19035C     LANGUAGE--ANSI FORTRAN.
19036C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
19037C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
19038C     WRITTEN BY--ALAN HECKERT
19039C                 STATISTICAL ENGINEERING LABORATORY (205.03)
19040C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19041C                 GAITHERSBURG, MD 20899
19042C                 PHONE:  301-975-2899
19043C     ORIGINAL VERSION--APRIL     1998.
19044C
19045C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19046C
19047      DOUBLE PRECISION CDF
19048      DOUBLE PRECISION DHAZ
19049C
19050C-----COMMON----------------------------------------------------------
19051C
19052      INCLUDE 'DPCOP2.INC'
19053C
19054C---------------------------------------------------------------------
19055C
19056C     CHECK THE INPUT ARGUMENTS FOR ERRORS
19057C
19058      HAZ=0.0
19059      IF(X.LT.0.0.AND.(MINMAX.EQ.2 .OR. MINMAX.EQ.0))THEN
19060        WRITE(ICOUT,4)
19061    4   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2CHA IS ',
19062     1         'NEGATIVE')
19063        CALL DPWRST('XXX','BUG ')
19064        WRITE(ICOUT,46)X
19065        CALL DPWRST('XXX','BUG ')
19066        WRITE(ICOUT,47)MINMAX
19067        CALL DPWRST('XXX','BUG ')
19068        GOTO9000
19069      ELSEIF(X.GT.0.0.AND.MINMAX.EQ.1)THEN
19070        WRITE(ICOUT,5)
19071    5   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2CHA IS ',
19072     1         'POSITIVE')
19073        CALL DPWRST('XXX','BUG ')
19074        WRITE(ICOUT,46)X
19075        CALL DPWRST('XXX','BUG ')
19076        WRITE(ICOUT,47)MINMAX
19077        CALL DPWRST('XXX','BUG ')
19078        GOTO9000
19079      ELSEIF(GAMMA.LE.0.0)THEN
19080        WRITE(ICOUT,15)
19081   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO EV2CHA ',
19082     1         'IS NON-POSITIVE')
19083        CALL DPWRST('XXX','BUG ')
19084        WRITE(ICOUT,46)GAMMA
19085        CALL DPWRST('XXX','BUG ')
19086        GOTO9000
19087      ENDIF
19088   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
19089   47 FORMAT('***** THE VALUE OF MINMAX IS ',I5)
19090C
19091C-----START POINT-----------------------------------------------------
19092C
19093      IF(MINMAX.EQ.1)THEN
19094        DGAMMA=DBLE(GAMMA)
19095        DX=DBLE(X)
19096        DHAZ=(-DX)**(-DGAMMA)
19097        HAZ=REAL(DHAZ)
19098      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
19099        CALL EV2CDD(DBLE(X),DBLE(GAMMA),MINMAX,CDF)
19100        CDF=1.0D0-CDF
19101        IF(CDF.LE.0.0D0)THEN
19102          WRITE(ICOUT,1100)
19103          CALL DPWRST('XXX','BUG ')
19104 1100     FORMAT('*****ERROR IN EV2CHA--CDF ESSENTIALLY 1.')
19105        ELSE
19106          DHAZ=-DLOG(CDF)
19107          HAZ=REAL(DHAZ)
19108        ENDIF
19109      ELSE
19110         WRITE(ICOUT,1800)
19111 1800    FORMAT('*****ERROR IN EV2CHA--MINMAX NOT 1 OR 2')
19112         CALL DPWRST('XXX','BUG ')
19113      END IF
19114C
19115 9000 CONTINUE
19116      RETURN
19117      END
19118      DOUBLE PRECISION FUNCTION EV2FUN (GHAT,X)
19119C
19120C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE MAXIMUM LIKELIHOOD
19121C              ESTIMATE OF GAMMA FOR THE 2-PARAMETER FRECHET
19122C              (EXTREME VALUE TYPE 2)
19123C              MODEL FOR FULL SAMPLE DATA (NO CENSORING).  THIS
19124C              FUNCTION FINDS THE ROOT OF THE EQUATION:
19125C
19126C                 (1/GHAT) +
19127C                 SUM[i=1 to n][Y(I)**(-GHAT)*LN(Y(I))]/
19128C                 SUM[i=1 to n][[Y(I)**(-GHAT)] -
19129C                 (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
19130C
19131C              WITH
19132C
19133C                 GHAT     = POINT ESTIMATE OF GAMMA (THIS IS THE
19134C                            PARAMETER WE ARE ITERATING OVER)
19135C
19136C              NOTE THAT THE THIRD TERM DOES NOT DEPEND ON GHAT,
19137C              SO THIS IS A CONSTANT.  FOR EFFICIENCY, SAVE THIS AS
19138C              A CONSTANT IN A COMMON BLOCK.
19139C
19140C              CALLED BY DFZER2 ROUTINE FOR FINDING THE ROOT OF A
19141C              FUNCTION.
19142C     EXAMPLE--FRECHET MAXIMUM LIKELIHOOD Y
19143C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
19144C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
19145C                1999, CHAPTER 16.
19146C     WRITTEN BY--ALAN HECKERT
19147C                 STATISTICAL ENGINEERING DIVISION
19148C                 INFORMATION TECHNOLOGY LABORATORY
19149C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19150C                 GAITHERSBUG, MD 20899-8980
19151C                 PHONE--301-975-2899
19152C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19153C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19154C     LANGUAGE--ANSI FORTRAN (1977)
19155C     VERSION NUMBER--2005/5
19156C     ORIGINAL VERSION--MAY        2005.
19157C     UPDATED         --JUNE       2013. CHECK FOR DIVISION BY ZERO
19158C
19159C---------------------------------------------------------------------
19160C
19161      DOUBLE PRECISION GHAT
19162      DOUBLE PRECISION X(*)
19163C
19164      INTEGER IN
19165      DOUBLE PRECISION DEV2SM
19166      COMMON/EV2COM/DEV2SM,IN
19167C
19168C---------------------------------------------------------------------
19169C
19170      DOUBLE PRECISION DSUM1
19171      DOUBLE PRECISION DSUM2
19172      DOUBLE PRECISION DTERM1
19173      DOUBLE PRECISION DTERM2
19174      DOUBLE PRECISION DX1
19175      DOUBLE PRECISION DG
19176C
19177      INCLUDE 'DPCOP2.INC'
19178C
19179C-----START POINT-----------------------------------------------------
19180C
19181C  COMPUTE SOME SUMS
19182C
19183      DSUM1=0.0D0
19184      DSUM2=0.0D0
19185      DG=GHAT
19186C
19187      DTERM1=1.0D0/DG
19188      DO100I=1,IN
19189        DX1=X(I)
19190        DSUM1=DSUM1 + (DX1**(-DG))*DLOG(DX1)
19191        DSUM2=DSUM2 + DX1**(-DG)
19192  100 CONTINUE
19193C
19194C     2013/06/20: IF DSUM2 IS ZERO, THEN SET DTERM2 TO A LARGE NUMBER
19195      IF(DSUM2.NE.0.0D0)THEN
19196        DTERM2=DSUM1/DSUM2
19197      ELSE
19198        DTERM2=CPUMAX/2.0D0
19199      ENDIF
19200C
19201      EV2FUN=DTERM1 + DTERM2 - DEV2SM
19202C
19203      RETURN
19204      END
19205      DOUBLE PRECISION FUNCTION EV2FU2 (DA,DX)
19206C
19207C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
19208C              BASED CONFIDECE INTERVAL FOR THE 2-PARAMETER FRECHET
19209C              MODEL (FULL SAMPLE).  THIS FUNCTION FINDS THE ROOT
19210C              OF THE EQUATION:
19211C
19212C                 2*LL(ALPHA,GAMMA) - 2*LL(S(a),,a) - CHSPPF(alpha,1)
19213C
19214C              WITH
19215C
19216C                 LL(ALPHA,GAMMA) = N*LN(GAMMA) + N*GAMMA*LN(ALPHA) -
19217C                          (GAMMA+1)*SUM[i=1 to n][LN(X(i))] -
19218C                          ALPHA**GAMMA*SUM[i=1 to n][(X(i)**(-GAMA)]
19219C                 ALPHA    = POINT ESTIMATE OF SCALE PARAMETER
19220C                 GAMMA    = POINT ESTIMATE OF SHAPE PARAMETER
19221C                 A        = PARAMETER WE ARE FINDING ROOT FOR
19222C                 K        = CHSPPF(ALPHA,1) (HERE, ALPHA IS THE
19223C                            SIGNIFICANCE LEVEL, NOT THE SCALE PARAMETER)
19224C
19225C              NOTE THAT QUANTITIES THAT DO NOT DEPEND ON A ARE
19226C              COMPUTED ONCE IN DPMLFR AND PASSED VIA COMMON BLOCK.
19227C
19228C              CALLED BY DFZER2 ROUTINE FOR FINDING THE ROOT OF A
19229C              FUNCTION.  DFZER2 IS MODIFIED VERSION OF DFZERO THAT
19230C              PASSES ALONG THE DATA ARRAY.
19231C
19232C     EXAMPLE--FRECHET MAXIMUM LIKELIHOOD Y
19233C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
19234C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 16 (SEE
19235C                EXAMPLE 16.4).
19236C     WRITTEN BY--JAMES J. FILLIBEN
19237C                 STATISTICAL ENGINEERING DIVISION
19238C                 INFORMATION TECHNOLOGY LABORATORY
19239C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19240C                 GAITHERSBUG, MD 20899-8980
19241C                 PHONE--301-975-2855
19242C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19243C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19244C     LANGUAGE--ANSI FORTRAN (1977)
19245C     VERSION NUMBER--2005/5
19246C     ORIGINAL VERSION--MAY        2005.
19247C
19248C---------------------------------------------------------------------
19249C
19250      DOUBLE PRECISION DA
19251      DOUBLE PRECISION DX(*)
19252C
19253      DOUBLE PRECISION DK
19254      DOUBLE PRECISION DTERM1
19255      DOUBLE PRECISION DTERM2
19256      COMMON/EV2CO2/DK,DTERM1,DTERM2,N
19257C
19258      DOUBLE PRECISION DN
19259      DOUBLE PRECISION DG
19260      DOUBLE PRECISION DSCALE
19261      DOUBLE PRECISION DSUM1
19262      DOUBLE PRECISION DTERM3
19263      DOUBLE PRECISION DTERM4
19264      DOUBLE PRECISION DTERM5
19265C
19266C-----COMMON----------------------------------------------------------
19267C
19268      INCLUDE 'DPCOP2.INC'
19269C
19270C-----START POINT-----------------------------------------------------
19271C
19272C  COMPUTE SOME SUMS
19273C
19274      DN=DBLE(N)
19275      DG=DA
19276C
19277      DSUM1=0.0D0
19278      DO100I=1,N
19279        DSUM1=DSUM1 + DX(I)**(-DG)
19280  100 CONTINUE
19281      DSCALE=(DSUM1/DN)**(-1.0D0/DG)
19282C
19283      DTERM3=DN*DLOG(DG) + DN*DG*DLOG(DSCALE)
19284      DTERM4=(DG+1.0D0)*DTERM2
19285      DTERM5=DSCALE**DG*DSUM1
19286C
19287      EV2FU2=DTERM1 - 2.0D0*(DTERM3 - DTERM4 - DTERM5) - DK
19288C
19289      RETURN
19290      END
19291      DOUBLE PRECISION FUNCTION EV2FU3 (DB,DX)
19292C
19293C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
19294C              BASED CONFIDENCE INTERVAL FOR THE SCALE PARAMETER OF A
19295C              2-PARAMETER FRECHET MODEL (FULL SAMPLE).  THIS
19296C              FUNCTION FINDS THE ROOT OF THE EQUATION:
19297C
19298C                 2*LL(ALPHA,GAMMA) - 2*LL(b,I(b)) - CHSPPF(alpha,1)
19299C
19300C              WITH
19301C
19302C                 LL(ALPHA,GAMMA) = N*LN(GAMMA) + N*GAMMA*LN(ALPHA) -
19303C                          (GAMMA+1)*SUM[i=1 to n][LN(X(i))] -
19304C                          ALPHA**GAMMA*SUM[i=1 to n][(X(i)**(-GAMMA)]
19305C                 ALPHA    = POINT ESTIMATE OF SCALE PARAMETER
19306C                 GAMMA    = POINT ESTIMATE OF SHAPE PARAMETER
19307C                 B        = PARAMETER (SCALE) WE ARE FINDING ROOT FOR
19308C                 K        = CHSPPF(ALPHA,1) (HERE, ALPHA IS THE
19309C                            SIGNIFICANCE LEVEL, NOT THE SCALE
19310C                            PARAMETER)
19311C
19312C              NOTE THAT QUANTITIES THAT DO NOT DEPEND ON B ARE
19313C              COMPUTED ONCE IN DPMLFR AND PASSED VIA COMMON BLOCK.
19314C
19315C              GIVEN A VALUE FOR THE SCALE PARAMETER (DB), WE NEED
19316C              TO CALL A ROOT FINDING ROUTINE TO DETERMINE THE VALUE
19317C              OF THE SHAPE PARAMETER (A).
19318C
19319C              CALLED BY DFZER2 ROUTINE FOR FINDING THE ROOT OF A
19320C              FUNCTION.  DFZER2 IS MODIFIED VERSION OF DFZERO THAT
19321C              PASSES ALONG THE DATA ARRAY.
19322C
19323C     EXAMPLE--FRECHET MAXIMUM LIKELIHOOD Y
19324C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
19325C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 16 (SEE
19326C                EXAMPLE 16.4).
19327C     WRITTEN BY--JAMES J. FILLIBEN
19328C                 STATISTICAL ENGINEERING DIVISION
19329C                 INFORMATION TECHNOLOGY LABORATORY
19330C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19331C                 GAITHERSBUG, MD 20899-8980
19332C                 PHONE--301-975-2855
19333C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19334C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19335C     LANGUAGE--ANSI FORTRAN (1977)
19336C     VERSION NUMBER--2005/5
19337C     ORIGINAL VERSION--MAY        2005.
19338C
19339C---------------------------------------------------------------------
19340C
19341      DOUBLE PRECISION DB
19342      DOUBLE PRECISION DX(*)
19343C
19344      DOUBLE PRECISION DK
19345      DOUBLE PRECISION DTERM6
19346      DOUBLE PRECISION DTERM7
19347      DOUBLE PRECISION DGAMMA
19348      COMMON/EV2CO3/DK,DTERM6,DTERM7,DGAMMA,N
19349C
19350      DOUBLE PRECISION DBTEMP
19351      COMMON/EV2CO4/DBTEMP,N2
19352C
19353      DOUBLE PRECISION AE
19354      DOUBLE PRECISION RE
19355      DOUBLE PRECISION XLOW
19356      DOUBLE PRECISION XUP
19357      DOUBLE PRECISION XSTRT
19358      DOUBLE PRECISION DA
19359      DOUBLE PRECISION DG
19360      DOUBLE PRECISION DN
19361      DOUBLE PRECISION DSCALE
19362      DOUBLE PRECISION DSUM1
19363      DOUBLE PRECISION DTERM3
19364      DOUBLE PRECISION DTERM4
19365      DOUBLE PRECISION DTERM5
19366C
19367      DOUBLE PRECISION EV2FU4
19368      EXTERNAL EV2FU4
19369C
19370C-----COMMON----------------------------------------------------------
19371C
19372      INCLUDE 'DPCOP2.INC'
19373C
19374C-----START POINT-----------------------------------------------------
19375C
19376C  STEP 1: GIVEN VALUE OF SCALE PARAMETER (DB), NEED TO COMPUTE
19377C          THE SHAPE PARAMETER (WHICH IN TURN INVOLVES FINDING A
19378C          ROOT).
19379
19380      N2=N
19381      DBTEMP=DB
19382      AE=1.D-7
19383      RE=1.D-7
19384      XSTRT=DGAMMA
19385      XLOW=XSTRT/5.0D0
19386      XUP=XSTRT*5.0D0
19387      CALL DFZER3(EV2FU4,XLOW,XUP,XSTRT,RE,AE,IFLAG,DX)
19388      DA=XLOW
19389C
19390C  COMPUTE SOME SUMS
19391C
19392      DN=DBLE(N)
19393      DG=DA
19394      DSCALE=DB
19395C
19396      DSUM1=0.0D0
19397      DO100I=1,N
19398        DSUM1=DSUM1 + DX(I)**(-DG)
19399  100 CONTINUE
19400C
19401      DTERM3=DN*DLOG(DG) + DN*DG*DLOG(DSCALE)
19402      DTERM4=(DG+1.0D0)*DTERM7
19403      DTERM5=DSCALE**DG*DSUM1
19404C
19405      EV2FU3=DTERM6 - 2.0D0*(DTERM3 - DTERM4 - DTERM5) - DK
19406C
19407      RETURN
19408      END
19409      DOUBLE PRECISION FUNCTION EV2FU4 (DA,DX)
19410C
19411C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
19412C              BASED CONFIDENCE INTERVAL FOR THE SCALE PARAMETER OF
19413C              THE 2-PARAMETER FRECHET MODEL (FULL SAMPLE).
19414C              SPECIFICALLY, IT IS USED TO DETERMINE AN ESTIMATE
19415C              OF THE SHAPE PARAMETER GIVEN A VALUE OF THE SCALE
19416C              PARAMETER.  IT FINDS THE ROOT OF THE FOLLOWING
19417C              EQUATION:
19418C
19419C                 (N/A) + N*LOG(B) - SUM[LOG(X)] -
19420C                       SUM[(B/X)**A*LOG(B/X)]
19421C
19422C              WITH A DENOTING THE SHAPE PARAMETER, B THE SCALE
19423C              PARAMETER, AND THE ROOT IS WITH RESPECT TO A.
19424C
19425C              CALLED BY DFZER3 ROUTINE FOR FINDING THE ROOT OF A
19426C              FUNCTION.  DFZER3 IS MODIFIED VERSION OF DFZERO THAT
19427C              PASSES ALONG THE DATA ARRAY.
19428C
19429C     EXAMPLE--FRECHET MAXIMUM LIKELIHOOD Y
19430C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
19431C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 16 (SEE
19432C                EXAMPLE 16.4).
19433C     WRITTEN BY--JAMES J. FILLIBEN
19434C                 STATISTICAL ENGINEERING DIVISION
19435C                 INFORMATION TECHNOLOGY LABORATORY
19436C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19437C                 GAITHERSBUG, MD 20899-8980
19438C                 PHONE--301-975-2855
19439C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19440C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19441C     LANGUAGE--ANSI FORTRAN (1977)
19442C     VERSION NUMBER--2005/5
19443C     ORIGINAL VERSION--MAY        2005.
19444C
19445C---------------------------------------------------------------------
19446C
19447      DOUBLE PRECISION DA
19448      DOUBLE PRECISION DX(*)
19449C
19450      DOUBLE PRECISION DB
19451      COMMON/EV2CO4/DB,N
19452C
19453      DOUBLE PRECISION DN
19454      DOUBLE PRECISION DSUM1
19455      DOUBLE PRECISION DSUM2
19456      DOUBLE PRECISION DTERM1
19457C
19458C-----COMMON----------------------------------------------------------
19459C
19460      INCLUDE 'DPCOP2.INC'
19461C
19462C-----START POINT-----------------------------------------------------
19463C
19464C  COMPUTE SOME SUMS
19465C
19466      DN=DBLE(N)
19467      DTERM1=(DN/DA) + DN*DLOG(DB)
19468C
19469      DSUM1=0.0D0
19470      DSUM2=0.0D0
19471      DO100I=1,N
19472        DSUM1=DSUM1 + DLOG(DX(I))
19473        DSUM2=DSUM2 + ((DB/DX(I))**DA)*DLOG(DB/DX(I))
19474  100 CONTINUE
19475C
19476      EV2FU4=DTERM1 - DSUM1 - DSUM2
19477C
19478      RETURN
19479      END
19480      SUBROUTINE EV2HAZ(X,GAMMA,MINMAX,HAZ)
19481C
19482C     PURPOSE--THIS SUBROUTINE COMPUTES THE HAZARD
19483C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2
19484C              DISTRIBUTION WITH SINGLE PRECISION
19485C              TAIL LENGTH PARAMETER = GAMMA.
19486C              THE EXTREME VALUE TYPE 2 DISTRIBUTION USED
19487C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
19488C              AND HAS THE PROBABILITY DENSITY FUNCTION
19489C              FOR THE MAXIMUM ORDER STATISTIC
19490C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
19491C              FOR THE MINIMUM ORDER STATISTIC
19492C              F(X) = GAMMA * ((-X)**(-GAMMA-1)) * EXP(-((-X)**(-GAMMA))).
19493C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
19494C                                AT WHICH THE PROBABILITY DENSITY
19495C                                FUNCTION IS TO BE EVALUATED.
19496C                                X SHOULD BE NON-NEGATIVE.
19497C                     --GAMMA  = THE SINGLE PRECISION VALUE
19498C                                OF THE TAIL LENGTH PARAMETER.
19499C                                GAMMA SHOULD BE POSITIVE.
19500C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION HAZARD
19501C                                FUNCTION VALUE.
19502C     OUTPUT--THE SINGLE PRECISION HAZARD
19503C             FUNCTION VALUE HAZ FOR THE EXTREME VALUE TYPE 2
19504C             DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
19505C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
19506C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
19507C                 --X SHOULD BE NON-NEGATIVE.
19508C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
19509C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
19510C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
19511C     LANGUAGE--ANSI FORTRAN.
19512C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
19513C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
19514C     WRITTEN BY--ALAN HECKERT
19515C                 STATISTICAL ENGINEERING LABORATORY (205.03)
19516C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19517C                 GAITHERSBURG, MD 20899
19518C                 PHONE:  301-975-2899
19519C     ORIGINAL VERSION--APRIL     1998.
19520C
19521C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19522C
19523      DOUBLE PRECISION CDF
19524      DOUBLE PRECISION DPDF
19525      DOUBLE PRECISION DX
19526      DOUBLE PRECISION DGAMMA
19527C
19528C-----COMMON----------------------------------------------------------
19529C
19530      INCLUDE 'DPCOP2.INC'
19531C
19532C---------------------------------------------------------------------
19533C
19534C     CHECK THE INPUT ARGUMENTS FOR ERRORS
19535C
19536      HAZ=0.0
19537      IF(X.LT.0.0.AND.(MINMAX.EQ.2 .OR. MINMAX.EQ.0))THEN
19538        WRITE(ICOUT,4)
19539    4   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2HAZ IS ',
19540     1         'NEGATIVE')
19541        CALL DPWRST('XXX','BUG ')
19542        WRITE(ICOUT,46)X
19543        CALL DPWRST('XXX','BUG ')
19544        WRITE(ICOUT,47)MINMAX
19545        CALL DPWRST('XXX','BUG ')
19546        GOTO9000
19547      ELSEIF(X.GT.0.0.AND.MINMAX.EQ.1)THEN
19548        WRITE(ICOUT,5)
19549    5   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2HAZ IS ',
19550     1         'POSITIVE')
19551        CALL DPWRST('XXX','BUG ')
19552        WRITE(ICOUT,46)X
19553        CALL DPWRST('XXX','BUG ')
19554        WRITE(ICOUT,47)MINMAX
19555        CALL DPWRST('XXX','BUG ')
19556        GOTO9000
19557      ELSEIF(GAMMA.LE.0.0)THEN
19558        WRITE(ICOUT,15)
19559   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO EV2HAZ ',
19560     1         'IS NON-POSITIVE')
19561        CALL DPWRST('XXX','BUG ')
19562        WRITE(ICOUT,46)GAMMA
19563        CALL DPWRST('XXX','BUG ')
19564        GOTO9000
19565      ENDIF
19566   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
19567   47 FORMAT('***** THE VALUE OF MINMAX IS ',I5)
19568C
19569C-----START POINT-----------------------------------------------------
19570C
19571      DGAMMA=DBLE(GAMMA)
19572      DX=DBLE(X)
19573      IF(MINMAX.EQ.1)THEN
19574        DHAZ=DGAMMA*(-DX)**(-DGAMMA-1.0D0)
19575        HAZ=REAL(DHAZ)
19576      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
19577        DPDF=DGAMMA*(DX**(-DGAMMA-1.0))*DEXP(-(DX**(-DGAMMA)))
19578        CALL EV2CDD(DBLE(X),DBLE(GAMMA),MINMAX,CDF)
19579        IF(1.0D0-CDF.LE.0.0D0)THEN
19580          WRITE(ICOUT,1100)
19581          CALL DPWRST('XXX','BUG ')
19582 1100     FORMAT('*****ERROR IN EV2HAZ--CDF ESSENTIALLY 1, ',
19583     1           'HAZARD SET TO 0.')
19584        ELSE
19585          HAZ=REAL(DPDF/(1.0D0-CDF))
19586        ENDIF
19587      ELSE
19588         WRITE(ICOUT,1800)
19589 1800    FORMAT('*****ERROR IN EV2HAZ--MINMAX NOT 1 OR 2')
19590         CALL DPWRST('XXX','BUG ')
19591      END IF
19592C
19593 9000 CONTINUE
19594      RETURN
19595      END
19596      SUBROUTINE EV2LI1(Y,N,ICASPL,MINMAX,ALOC,SCALE,SHAPE,
19597     1                  ALIK,AIC,AICC,BIC,
19598     1                  ISUBRO,IBUGA3,IERROR)
19599C
19600C     PURPOSE--THIS ROUTINE COMPUTES THE LIKELIHOOD FUNCTION FOR
19601C              THE FRECHET DISTRIBUTION.  THIS IS FOR THE RAW DATA
19602C              CASE (I.E., NO GROUPING AND NO CENSORING).
19603C
19604C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
19605C              PERFORMED.
19606C
19607C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
19608C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 16.
19609C     WRITTEN BY--ALAN HECKERT
19610C                 STATISTICAL ENGINEERING DIVISION
19611C                 INFORMATION TECHNOLOGY LABORATORY
19612C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19613C                 GAITHERSBURG, MD 20899-8980
19614C                 PHONE--301-975-2899
19615C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19616C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19617C     LANGUAGE--ANSI FORTRAN (1977)
19618C     VERSION NUMBER--2014/9
19619C     ORIGINAL VERSION--SEPTEMBER 2014.
19620C
19621C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19622C
19623      CHARACTER*4 ICASPL
19624      CHARACTER*4 ISUBRO
19625      CHARACTER*4 IBUGA3
19626      CHARACTER*4 IERROR
19627C
19628      CHARACTER*4 IWRITE
19629      CHARACTER*4 ISUBN1
19630      CHARACTER*4 ISUBN2
19631      CHARACTER*4 ISTEPN
19632C
19633      DOUBLE PRECISION DX
19634      DOUBLE PRECISION DG
19635      DOUBLE PRECISION DLOC
19636      DOUBLE PRECISION DSCALE
19637      DOUBLE PRECISION DPDF
19638      DOUBLE PRECISION DN
19639      DOUBLE PRECISION DNP
19640      DOUBLE PRECISION DLIK
19641      DOUBLE PRECISION DTERM1
19642      DOUBLE PRECISION DTERM3
19643C
19644C---------------------------------------------------------------------
19645C
19646      DIMENSION Y(*)
19647C
19648C-----COMMON----------------------------------------------------------
19649C
19650      INCLUDE 'DPCOP2.INC'
19651C
19652C-----START POINT-----------------------------------------------------
19653C
19654      ISUBN1='EV2L'
19655      ISUBN2='I1  '
19656      IERROR='NO'
19657C
19658      DPDF=0.0D0
19659      ALIK=-99.0
19660      AIC=-99.0
19661      AICC=-99.0
19662      BIC=-99.0
19663C
19664      IF(ALOC.EQ.CPUMIN)THEN
19665        ALOCT=0.0
19666      ELSE
19667        ALOCT=ALOC
19668      ENDIF
19669C
19670      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2LI1')THEN
19671        WRITE(ICOUT,999)
19672  999   FORMAT(1X)
19673        CALL DPWRST('XXX','WRIT')
19674        WRITE(ICOUT,51)
19675   51   FORMAT('**** AT THE BEGINNING OF EV2LI1--')
19676        CALL DPWRST('XXX','WRIT')
19677        WRITE(ICOUT,52)IBUGA3,ISUBRO
19678   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
19679        CALL DPWRST('XXX','WRIT')
19680        WRITE(ICOUT,55)N,ALOC,SCALE
19681   55   FORMAT('N,ALOC,SCALE = ',I8,2G15.7)
19682        CALL DPWRST('XXX','WRIT')
19683        DO56I=1,MIN(N,100)
19684          WRITE(ICOUT,57)I,Y(I)
19685   57     FORMAT('I,Y(I) = ',I8,G15.7)
19686          CALL DPWRST('XXX','WRIT')
19687   56   CONTINUE
19688      ENDIF
19689C
19690C               ******************************************
19691C               **  STEP 1--                            **
19692C               **  COMPUTE LIKELIHOOD FUNCTION         **
19693C               ******************************************
19694C
19695      ISTEPN='1'
19696      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2LI1')
19697     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19698C
19699      IERFLG=0
19700      IERROR='NO'
19701      IWRITE='OFF'
19702      IF(ICASPL.EQ.'FREC')ALOC=0.0
19703C
19704C     LOG-LIKELIHOOD FUNCTION IS:
19705C
19706C     N*(LOG(SHAPE) - SHAPE*LOG(SCALE)) +
19707C     (SHAPE-1)*SUM[i=1 to n][LOG(X(i) - LOC] -
19708C     SUM[i=1 to n][((X(i) - LOC)/SCALE)**SHAPE]
19709C
19710CCCCC DN=DBLE(N)
19711CCCCC DS=DBLE(SCALE)
19712CCCCC DU=DBLE(ALOC)
19713CCCCC DG=DBLE(SHAPE)
19714CCCCC DTERM1=DN*(DLOG(DG) - DG*DLOG(DS))
19715CCCCC DSUM1=0.0D0
19716CCCCC DSUM2=0.0D0
19717C
19718CCCCC IF(MINMAX.EQ.2)THEN
19719CCCCC   DO1010I=1,N
19720CCCCC     DX=DBLE(Y(I))
19721CCCCC     DSUM1=DSUM1 + DLOG(DU - DX)
19722CCCCC     DSUM2=DSUM2 + ((DU-DX)/DS)**DG
19723CC010   CONTINUE
19724CCCCC ELSE
19725CCCCC   DO1020I=1,N
19726CCCCC     DX=DBLE(Y(I))
19727CCCCC     DSUM1=DSUM1 + DLOG(DX - DU)
19728CCCCC     DSUM2=DSUM2 + ((DX-DU)/DS)**DG
19729CC020   CONTINUE
19730CCCCC ENDIF
19731C
19732      DG=DBLE(SHAPE)
19733      DLOC=DBLE(ALOC)
19734      DSCALE=DBLE(SCALE)
19735      DLIK=0.0D0
19736C
19737      DO1000I=1,N
19738        DX=DBLE(Y(I))
19739        DX=(DX-DLOC)/DSCALE
19740C
19741        IF(MINMAX.EQ.1)THEN
19742          DPDF=DG*((-DX)**(-DG-1.0D0))*DEXP(-((-DX)**(-DG)))
19743          DPDF=DPDF/DSCALE
19744        ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
19745          DPDF=DG*(DX**(-DG-1.0D0))*DEXP(-(DX**(-DG)))
19746        ENDIF
19747        IF(DPDF.LE.0.0D0)THEN
19748          IERROR='YES'
19749CCCCC     GOTO9000
19750          DTERM1=0.0D0
19751        ELSE
19752          DTERM1=DLOG(DPDF)
19753        ENDIF
19754        DLIK=DLIK + DTERM1
19755 1000 CONTINUE
19756C
19757      ALIK=REAL(DLIK)
19758      DN=DBLE(N)
19759      DNP=2.0D0
19760      IF(ICASPL.EQ.'3EV2' .OR. ICASPL.EQ.'3FRE')DNP=3.0
19761      AIC=REAL(-2.0D0*DLIK + 2.0D0*DNP)
19762      DTERM3=(2.0D0*DNP*(DNP+1.0D0))/(DN-DNP-1.0D0)
19763      AICC=REAL(-2.0D0*DLIK + 2.0D0*DNP + DTERM3)
19764      BIC=REAL(-2.0D0*DLIK + DNP*DLOG(DN))
19765C
19766      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2LI1')THEN
19767        WRITE(ICOUT,999)
19768        CALL DPWRST('XXX','WRIT')
19769        WRITE(ICOUT,9011)
19770 9011   FORMAT('**** AT THE END OF EV2LI1--')
19771        CALL DPWRST('XXX','WRIT')
19772        WRITE(ICOUT,9013)DSUM1,DSUM2,DTERM1,DTERM3
19773 9013   FORMAT('DSUM1,DSUM2,DTERM1,DTERM3 = ',4G15.7)
19774        CALL DPWRST('XXX','WRIT')
19775        WRITE(ICOUT,9014)ALIK,AIC,AICC,BIC
19776 9014   FORMAT('ALIK,AIC,AICC,BIC = ',4G15.7)
19777        CALL DPWRST('XXX','WRIT')
19778      ENDIF
19779C
19780      RETURN
19781      END
19782      SUBROUTINE EV2ML1(Y,N,MINMAX,
19783     1                  TEMP1,DTEMP1,
19784     1                  XMEAN,XSD,XVAR,XMIN,XMAX,XLOGSD,XLOGSM,
19785     1                  SCALML,SCALSE,SHAPML,SHAPSE,
19786     1                  SHAPBC,SHABSE,COVSE,COVBSE,
19787     1                  ISUBRO,IBUGA3,IERROR)
19788C
19789C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
19790C              FOR THE 2-PARAMETER EXTREME VALUE TYPE 2 (FRECHET)
19791C              DISTRIBUTION FOR THE RAW DATA CASE (I.E., NO CENSORING
19792C              AND NO GROUPING).  THIS ROUTINE RETURNS ONLY THE POINT
19793C              ESTIMATES (CONFIDENCE INTERVALS WILL BE COMPUTED IN A
19794C              SEPARATE ROUTINE).
19795C
19796C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
19797C              PERFORMED.
19798C
19799C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
19800C              FROM MULTIPLE PLACES (DPMLW1 WILL GENERATE THE OUTPUT
19801C              FOR THE FRECHET MLE COMMAND).
19802C
19803C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
19804C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 16.
19805C     WRITTEN BY--JAMES J. FILLIBEN
19806C                 STATISTICAL ENGINEERING DIVISION
19807C                 INFORMATION TECHNOLOGY LABORATORY
19808C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19809C                 GAITHERSBURG, MD 20899-8980
19810C                 PHONE--301-975-2855
19811C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19812C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19813C     LANGUAGE--ANSI FORTRAN (1977)
19814C     VERSION NUMBER--2010/2
19815C     ORIGINAL VERSION--FEBRUARY  2010. EXTRACTED AS A SEPARATE
19816C                                       SUBROUTINE (FROM DPMLFR)
19817C     UPDATED         --JUNE      2013. IMPROVED STARTING VALUES
19818C
19819C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19820C
19821      DIMENSION Y(*)
19822      DIMENSION TEMP1(*)
19823      DOUBLE PRECISION DTEMP1(*)
19824C
19825      CHARACTER*8 ICASE
19826      CHARACTER*4 ISUBRO
19827      CHARACTER*4 IBUGA3
19828      CHARACTER*4 IERROR
19829C
19830      DOUBLE PRECISION DN
19831      DOUBLE PRECISION DAE
19832      DOUBLE PRECISION DRE
19833      DOUBLE PRECISION DYT
19834      DOUBLE PRECISION DYBAR
19835      DOUBLE PRECISION DXBAR
19836      DOUBLE PRECISION DSUM1
19837      DOUBLE PRECISION DSUM2
19838      DOUBLE PRECISION DXSTRT
19839      DOUBLE PRECISION DXLOW
19840      DOUBLE PRECISION DXUP
19841      DOUBLE PRECISION XLOWSV
19842      DOUBLE PRECISION XUPSV
19843C
19844      DOUBLE PRECISION EV2FUN
19845      EXTERNAL EV2FUN
19846      INTEGER IN
19847      DOUBLE PRECISION DEV2SM
19848      COMMON/EV2COM/DEV2SM,IN
19849C
19850      CHARACTER*4 IWRITE
19851      CHARACTER*40 IDIST
19852C
19853      CHARACTER*4 ISUBN1
19854      CHARACTER*4 ISUBN2
19855      CHARACTER*4 ISTEPN
19856C
19857C-----COMMON----------------------------------------------------------
19858C
19859      INCLUDE 'DPCOP2.INC'
19860C
19861C-----START POINT-----------------------------------------------------
19862C
19863      ISUBN1='EV2M'
19864      ISUBN2='L1  '
19865      IERROR='NO'
19866      IWRITE='OFF'
19867C
19868      AN=REAL(N)
19869C
19870      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML1')THEN
19871        WRITE(ICOUT,999)
19872  999   FORMAT(1X)
19873        CALL DPWRST('XXX','WRIT')
19874        WRITE(ICOUT,51)
19875   51   FORMAT('**** AT THE BEGINNING OF EV2ML1--')
19876        CALL DPWRST('XXX','WRIT')
19877        WRITE(ICOUT,52)IBUGA3,ISUBRO,MINMAX
19878   52   FORMAT('IBUGA3,ISUBRO,MINMAX = ',2(A4,2X),I5)
19879        CALL DPWRST('XXX','WRIT')
19880        DO56I=1,MIN(N,100)
19881          WRITE(ICOUT,57)I,Y(I)
19882   57     FORMAT('I,Y(I) = ',I8,G15.7)
19883          CALL DPWRST('XXX','WRIT')
19884   56   CONTINUE
19885      ENDIF
19886C
19887C               ********************************************
19888C               **  STEP 1--                              **
19889C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
19890C               ********************************************
19891C
19892      ISTEPN='1'
19893      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML1')
19894     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19895C
19896      IF(MINMAX.NE.1)THEN
19897        DO1125I=1,N
19898          IF(Y(I).LE.0.0)THEN
19899            WRITE(ICOUT,999)
19900            CALL DPWRST('XXX','WRIT')
19901            WRITE(ICOUT,1111)
19902            CALL DPWRST('XXX','WRIT')
19903            WRITE(ICOUT,1122)
19904 1122       FORMAT('      A NON-POSITIVE VALUE WAS ENCOUNTERED IN ',
19905     1             'THE RESPONSE VARIABLE.')
19906            CALL DPWRST('XXX','WRIT')
19907            WRITE(ICOUT,1123)I,Y(I)
19908 1123       FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
19909            CALL DPWRST('XXX','WRIT')
19910            IERROR='YES'
19911            GOTO9000
19912          ELSE
19913            TEMP1(I)=LOG(Y(I))
19914          ENDIF
19915 1125   CONTINUE
19916      ELSE
19917        DO1135I=1,N
19918          IF(Y(I).GE.0.0)THEN
19919            WRITE(ICOUT,999)
19920            CALL DPWRST('XXX','WRIT')
19921            WRITE(ICOUT,1111)
19922            CALL DPWRST('XXX','WRIT')
19923            WRITE(ICOUT,1132)
19924 1132       FORMAT('      A NON-NEGATIVE VALUE WAS ENCOUNTERED IN ',
19925     1             'THE RESPONSE VARIABLE.')
19926            WRITE(ICOUT,1133)I,Y(I)
19927 1133       FORMAT('      ROW ',I8,' HAS THE VALUE = ',E15.7)
19928            CALL DPWRST('XXX','WRIT')
19929            IERROR='YES'
19930            GOTO9000
19931          ELSE
19932            TEMP1(I)=LOG(-Y(I))
19933          ENDIF
19934 1135   CONTINUE
19935      ENDIF
19936C
19937      HOLD=Y(1)
19938      DO1145I=2,N
19939        IF(Y(I).NE.HOLD)GOTO1149
19940 1145 CONTINUE
19941      WRITE(ICOUT,999)
19942      CALL DPWRST('XXX','WRIT')
19943      WRITE(ICOUT,1111)
19944      CALL DPWRST('XXX','WRIT')
19945      WRITE(ICOUT,1142)HOLD
19946 1142 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
19947      CALL DPWRST('XXX','WRIT')
19948      IERROR='YES'
19949      GOTO9000
19950 1149 CONTINUE
19951C
19952C               ******************************************
19953C               **  STEP 2--                            **
19954C               **  CARRY OUT CALCULATIONS              **
19955C               **  FOR FRECHET MLE ESTIMATE            **
19956C               ******************************************
19957C
19958      ISTEPN='2'
19959      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML1')
19960     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19961C
19962      IDIST='FRECHET'
19963CCCCC IFLAG=2
19964      IFLAG=0
19965      CALL SUMRAW(Y,N,IDIST,IFLAG,
19966     1            XMEAN,XVAR,XSD,XMIN,XMAX,
19967     1            ISUBRO,IBUGA3,IERROR)
19968      CALL SD(TEMP1,N,IWRITE,XLOGSD,IBUGA3,IERROR)
19969      CALL SUMDP(TEMP1,N,IWRITE,XLOGSM,IBUGA3,IERROR)
19970C
19971      SHAPML=CPUMIN
19972      SHAPBC=CPUMIN
19973      SHAPSE=CPUMIN
19974      SHABSE=CPUMIN
19975      SCALML=CPUMIN
19976      SCALSE=CPUMIN
19977      COVSE=CPUMIN
19978      COVBSE=CPUMIN
19979C
19980C     FOR THE SHAPE PARAMETER, SOLVE THE EQUATION:
19981C
19982C         (1/GHAT) +
19983C         SUM[i=1 to n][Y(I)**(-GHAT)*LN(Y(I))]/
19984C         SUM[i=1 to n][[Y(I)**(-GHAT)] -
19985C         (1/N)*SUM[i=1 to n][LN(Y(I))] = 0
19986C
19987C     THEN
19988C
19989C         SCALE = {((1/N)*SUM[i=1 to n][Y(I)**(-GHAT)])}**(-1/GHAT)
19990C
19991C     FOR STARTING VALUE, USE FACT THAT FRECHET = EXPONENTIAL OF
19992C     GUMBEL DISTRIBUTION.  THEN GHAT = 1/SCALE WITH SCALE DENOTING
19993C     THE SCALE ESTIMATE OF THE GUMBEL DISTRIBUTION.
19994C
19995C     2013/06: BASE STARTING VALUE FOR SHAPE ON "FRECHET" PLOT (SEE
19996C     PAGE 299 OF BURY).  THE FRECHET PLOT IS
19997C
19998C          -LN[LN[p(i)]] versus LN OF ORDERED DATA
19999C
20000C     WHERE p(i) = (i - 0.3)/(n + 0.4)
20001C
20002C     THEN
20003C
20004C           A0 = -GAMMA*LOG(SCALE)
20005C           A1 = GAMMA
20006C
20007C     FOR SIMPLE LINEAR REGRESSION,
20008C
20009C           A1 = SUM[X(i) - XBAR]*SUM[Y(i) - YBAR]/SUM[(X(i) - XBAR)**2]
20010C
20011C     IN ORDER TO AVOID HAVING TO PASS IN ADDITIONAL SCRATCH ARRAYS, DO
20012C     IN TWO PASSES.
20013C
20014      ISTEPN='21'
20015      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2EV2')
20016     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20017C
20018      ICASE='MAXIMUM'
20019      IF(MINMAX.EQ.1)THEN
20020        ICASE='MINIMUM'
20021        DO4103I=1,N
20022          Y(I)=-Y(I)
20023 4103   CONTINUE
20024      ENDIF
20025C
20026C     ESTIMATES FOR 2-PARAMETER MODEL.  USE DFZER2 TO FIND ROOT OF
20027C     THE EQUATION GIVEN ABOVE.
20028C
20029      DO4101I=1,N
20030        DTEMP1(I)=DBLE(Y(I))
20031 4101 CONTINUE
20032      KFLAG=1
20033      CALL DSORT(DTEMP1,DTEMP1,N,KFLAG,IERROR)
20034C
20035      DEV2SM=DBLE(XLOGSM/AN)
20036CCCCC DXSTRT=DBLE(SQRT(1.645)*XSD)
20037C
20038      DSUM1=0.0D0
20039      DSUM2=0.0D0
20040      DN=DBLE(N)
20041      DO3901I=1,N
20042        DYT=(DBLE(I) - 0.3D0)/(DN + 0.4D0)
20043        DYT=-LOG(-LOG(DYT))
20044        DSUM1=DSUM1 + DYT
20045        DSUM2=DSUM2 + DLOG(DTEMP1(I))
20046 3901 CONTINUE
20047      DYBAR=DSUM1/DN
20048      DXBAR=DSUM2/DN
20049C
20050      DSUM1=0.0D0
20051      DSUM2=0.0D0
20052      DO3903I=1,N
20053        DYT=(DBLE(I) - 0.3D0)/(DN + 0.4D0)
20054        DYT=-LOG(-LOG(DYT))
20055        DSUM1=DSUM1 + (DLOG(DTEMP1(I)) - DXBAR)*(DYT - DYBAR)
20056        DSUM2=DSUM2 + (DLOG(DTEMP1(I)) - DXBAR)**2
20057 3903 CONTINUE
20058      DXSTRT=DSUM1/DSUM2
20059C
20060      DAE=2.0*0.000001D0*DXSTRT
20061      DRE=DAE
20062      IN=N
20063      IFLAG=0
20064      DXLOW=DXSTRT/3.0D0
20065      DXUP=3.0D0*DXSTRT
20066      ITBRAC=0
20067 4105 CONTINUE
20068      XLOWSV=DXLOW
20069      XUPSV=DXUP
20070      CALL DFZER2(EV2FUN,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP1)
20071C
20072      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
20073        DXLOW=XLOWSV/2.0D0
20074        DXUP=2.0D0*XUPSV
20075        ITBRAC=ITBRAC+1
20076        GOTO4105
20077      ENDIF
20078C
20079      IF(IFLAG.EQ.2)THEN
20080C
20081CCCCC   NOTE: SUPPRESS THIS MESSAGE FOR NOW.
20082CCCCC   WRITE(ICOUT,999)
20083CCCCC   CALL DPWRST('XXX','BUG ')
20084CCCCC   WRITE(ICOUT,111)
20085CC111   FORMAT('***** WARNING FROM FRECHET MAXIMUM ',
20086CCCCC1         'LIKELIHOOD--')
20087CCCCC   CALL DPWRST('XXX','BUG ')
20088CCCCC   WRITE(ICOUT,113)
20089CC113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
20090CCCCC1         'DESIRED TOLERANCE.')
20091CCCCC   CALL DPWRST('XXX','BUG ')
20092      ELSEIF(IFLAG.EQ.3)THEN
20093        WRITE(ICOUT,999)
20094        CALL DPWRST('XXX','BUG ')
20095        WRITE(ICOUT,121)
20096  121   FORMAT('***** WARNING FROM FRECHET MAXIMUM LIKELIHOOD--')
20097        CALL DPWRST('XXX','BUG ')
20098        WRITE(ICOUT,123)
20099  123   FORMAT('      ESTIMATE OF GAMMA MAY BE NEAR A SINGULAR POINT.')
20100        CALL DPWRST('XXX','BUG ')
20101      ELSEIF(IFLAG.EQ.4)THEN
20102        WRITE(ICOUT,999)
20103        CALL DPWRST('XXX','BUG ')
20104        WRITE(ICOUT,1111)
20105 1111   FORMAT('****** ERROR IN FRECHERT MAXIMUM LIKELIHOOD--')
20106        CALL DPWRST('XXX','BUG ')
20107        WRITE(ICOUT,133)
20108  133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
20109        CALL DPWRST('XXX','BUG ')
20110      ELSEIF(IFLAG.EQ.5)THEN
20111        WRITE(ICOUT,999)
20112        CALL DPWRST('XXX','BUG ')
20113        WRITE(ICOUT,121)
20114        CALL DPWRST('XXX','BUG ')
20115        WRITE(ICOUT,143)
20116  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
20117        CALL DPWRST('XXX','BUG ')
20118      ENDIF
20119C
20120      SHAPML=REAL(DXLOW)
20121      DSUM=0.0D0
20122      DO4108I=1,N
20123        DSUM=DSUM + DBLE(Y(I)**(-SHAPML))
20124 4108 CONTINUE
20125      DSUM=(DSUM/DBLE(N))**(1.0D0/DBLE(-SHAPML))
20126      SCALML=REAL(DSUM)
20127      BN=1.0 + 2.2/AN**1.13
20128      SHAPBC=SHAPML/BN
20129C
20130C     COMPUTE STANDARD ERRORS (CAN BASE ON EITHER THE NORMAL BIASED
20131C     ESTIMATORS OR THE BIAS CORRECTED ESTIMATORS)
20132C
20133      SCALSE=1.05293*SCALML/(SHAPML*SQRT(AN))
20134      SHAPSE=0.77970*SHAPML/SQRT(AN)
20135      SHABSE=0.77970*SHAPML/(BN*SQRT(AN))
20136      COVSE=0.50697*SQRT(SCALML/AN)
20137      COVBSE=0.50697*SQRT(SCALML/(AN*BN))
20138C
20139 9000 CONTINUE
20140      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML1')THEN
20141        WRITE(ICOUT,999)
20142        CALL DPWRST('XXX','WRIT')
20143        WRITE(ICOUT,9011)
20144 9011   FORMAT('**** AT THE END OF EV2ML1--')
20145        CALL DPWRST('XXX','WRIT')
20146        WRITE(ICOUT,9013)N,XMEAN,XSD,XMIN,XMAX
20147 9013   FORMAT('N,XMEAN,XSD,XMIN,XMAX = ',I8,4G15.7)
20148        CALL DPWRST('XXX','WRIT')
20149        WRITE(ICOUT,9015)XLOGSD,XLOGSM
20150 9015   FORMAT('XLOGSD,XLOGSM = ',2G15.7)
20151        CALL DPWRST('XXX','WRIT')
20152        WRITE(ICOUT,9017)SHAPML,SCALML,SHAPSE,SCALSE
20153 9017   FORMAT('SHAPML,SCALML,SHAPSE,SCALSE =  ',4G15.7)
20154        CALL DPWRST('XXX','WRIT')
20155        WRITE(ICOUT,9019)SHAPBC,SHABSE,COVSE,COVBSE
20156 9019   FORMAT('SHAPBC,SHABSE,COVSE,COVBSE =  ',4G15.7)
20157        CALL DPWRST('XXX','WRIT')
20158      ENDIF
20159C
20160      RETURN
20161      END
20162      SUBROUTINE EV2ML3(Y,N,MINMAX,MAXNXT,ISEED,IDFTTY,IGEVML,
20163     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,DTEMP1,
20164     1                  XMOM,NMOM,VARCOV,
20165     1                  XMEAN,XSD,XVAR,XMIN,XMAX,XSKEW,
20166     1                  ALOCML,SCALML,SHAPML,
20167     1                  ALOCLM,SCALLM,SHAPLM,
20168     1                  ALOCEP,SCALEP,SHAPEP,
20169     1                  ISUBRO,IBUGA3,IERROR)
20170C
20171C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
20172C              FOR THE 3-PARAMETER FRECHET DISTRIBUTION FOR THE RAW DATA
20173C              CASE (I.E., NO CENSORING AND NO GROUPING).
20174C
20175C              THE DEFAULT IS FOR THE "MAXIMUM" FRECHET.  NOTE
20176C              THAT THE FOLLOWING ADDITIONAL CASES CAN BE HANDLED:
20177C
20178C                 1. THE REVERSE ("MINIMUM") FRECHET.  FOR THIS CASE, WE
20179C                    TAKE THE NEGATIVE OF THE ORIGINAL DATA AND THEN FIT
20180C                    THE MAXIMUM FRECHET CASE.  AFTER OBTAINING THE
20181C                    PARAMETER ESTIMATES, TAKE THE NEGATIVE OF THE
20182C                    LOCATION PARAMETER.
20183C
20184C                 2. NOTE THAT THE "INVERTED WEIBULL" IS REALLY JUST THE
20185C                    "MAXIMUM" FRECHET.  TREAT INVERTED WEIBULL AND
20186C                    FRECHET AS SYNONYMS.
20187C
20188C              GENERATE ESTIMATES BASED ON:
20189C
20190C                 1. MAXIMUM LIKELIHOOD (UNDER DEVELOPMENT)
20191C                 2. L-MOMENTS
20192C                 3. ELEMENTAL PERCENTILES
20193C
20194C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
20195C              FROM MULTIPLE PLACES (DPMLF3 WILL GENERATE THE OUTPUT
20196C              FOR THE 3-PARAMETER FRECHET MLE COMMAND).
20197C
20198C              NOTE THAT THE FRECHET CAN BE ESTIMATED IN TERMS OF THE
20199C              GENERALIZED EXTREME VALUE DISTRIBUTION AS FOLLOWS:
20200C
20201C              1. FOR MAXIMUM CASE:
20202C
20203C                    LOC    = LOC' + SCALE'/SHAPE'
20204C                    SCALE  = -SCALE'/SHAPE'
20205C                    SHAPE  = -1/SHAPE'
20206C
20207C              2. FOR MINIMUM CASE:
20208C
20209C                    LOC    = LOC' - SCALE'/SHAPE'
20210C                    SCALE  = -SCALE'/SHAPE'
20211C                    SHAPE  = -1/SHAPE'
20212C
20213C               WHERE LOC', SCALE', AND SHAPE' ARE THE PARAMETERS OF THE
20214C               3-PARAMETER GENERALIZED EXTREME VALUE DISTRIBUTION.
20215C
20216C     REFERENCES--CASTILLO, HADI, BALAKRISHNAN, AND SARABIA (2005),
20217C                 "EXTREME VALUE AND RELATED MODELS WITH APPLICATIONS
20218C                 IN ENGINEERING AND SCIENCE", WILEY.
20219C               --FORTRAN CODE WRITTEN FOR INCLUSION IN IBM
20220C                 RESEARCH REPORT RC20525, 'FORTRAN ROUTINES FOR
20221C                 USE WITH THE METHOD OF L-MOMENTS, VERSION 3',
20222C                 J. R. M. HOSKING, IBM RESEARCH DIVISION,
20223C                 T. J. WATSON RESEARCH CENTER, YORKTOWN HEIGHTS
20224C                 NEW YORK 10598, U.S.A., VERSION 3     AUGUST 1996
20225C               --HOSKING, ALGORITHM AS215   APPL. STATIST. (1985)
20226C                 VOL. 34, NO. 3, Modifications in AS R76 (1989)
20227C                 have been incorporated.
20228C     WRITTEN BY--ALAN HECKERT
20229C                 STATISTICAL ENGINEERING DIVISION
20230C                 INFORMATION TECHNOLOGY LABORATORY
20231C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20232C                 GAITHERSBURG, MD 20899-8980
20233C                 PHONE--301-975-2899
20234C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20235C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20236C     LANGUAGE--ANSI FORTRAN (1977)
20237C     VERSION NUMBER--2010/5
20238C     ORIGINAL VERSION--OCTOBER   2014
20239C
20240C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20241C
20242      DIMENSION Y(*)
20243      DIMENSION TEMP1(*)
20244      DIMENSION TEMP2(*)
20245      DIMENSION TEMP3(*)
20246      DIMENSION TEMP4(*)
20247      DIMENSION TEMP5(*)
20248      DOUBLE PRECISION DTEMP1(*)
20249C
20250      DOUBLE PRECISION VARCOV(*)
20251      DOUBLE PRECISION XMOM(*)
20252C
20253      CHARACTER*4 IDFTTY
20254      CHARACTER*4 IGEVML
20255      CHARACTER*4 ISUBRO
20256      CHARACTER*4 IBUGA3
20257      CHARACTER*4 IERROR
20258C
20259      CHARACTER*4 IWRITE
20260C
20261      CHARACTER*4 ISUBN1
20262      CHARACTER*4 ISUBN2
20263      CHARACTER*4 ISTEPN
20264      CHARACTER*4 IGEPDF
20265      CHARACTER*4 ICASPL
20266C
20267      LOGICAL MLFLAG
20268C
20269C-----COMMON----------------------------------------------------------
20270C
20271      INCLUDE 'DPCOP2.INC'
20272C
20273C-----START POINT-----------------------------------------------------
20274C
20275      ISUBN1='EV2M'
20276      ISUBN2='L3  '
20277C
20278      ALOCML=CPUMIN
20279      SCALML=CPUMIN
20280      SHAPML=CPUMIN
20281C
20282      ALOCEP=CPUMIN
20283      SCALEP=CPUMIN
20284      SHAPEP=CPUMIN
20285C
20286      ALOCLM=CPUMIN
20287      SCALLM=CPUMIN
20288      SHAPLM=CPUMIN
20289C
20290      IWRITE='OFF'
20291      IERROR='NO'
20292C
20293      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML3')THEN
20294        WRITE(ICOUT,999)
20295  999   FORMAT(1X)
20296        CALL DPWRST('XXX','WRIT')
20297        WRITE(ICOUT,51)
20298   51   FORMAT('**** AT THE BEGINNING OF EV2ML3--')
20299        CALL DPWRST('XXX','WRIT')
20300        WRITE(ICOUT,52)IBUGA3,ISUBRO,IGEVML,MINMAX
20301   52   FORMAT('IBUGA3,ISUBRO,IGEVML,MINMAX = ',3(A4,2X),I5)
20302        CALL DPWRST('XXX','WRIT')
20303        DO56I=1,MIN(N,100)
20304          WRITE(ICOUT,57)I,Y(I)
20305   57     FORMAT('I,Y(I) = ',I8,G15.7)
20306          CALL DPWRST('XXX','WRIT')
20307   56   CONTINUE
20308      ENDIF
20309C
20310      IF(N.LE.4)THEN
20311        WRITE(ICOUT,999)
20312        CALL DPWRST('XXX','WRIT')
20313        WRITE(ICOUT,111)
20314  111   FORMAT('***** ERROR IN 3-PARAMETER FRECHET MAXIMUM ',
20315     1         'LIKELIHOOD--')
20316        CALL DPWRST('XXX','WRIT')
20317        WRITE(ICOUT,112)
20318  112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
20319     1         'VARIABLE IS LESS THAN 5.')
20320        CALL DPWRST('XXX','WRIT')
20321        WRITE(ICOUT,113)N
20322  113   FORMAT('      SAMPLE SIZE = ',I8)
20323        CALL DPWRST('XXX','WRIT')
20324        IERROR='YES'
20325        GOTO9000
20326      ENDIF
20327C
20328C               ******************************************
20329C               **  STEP 1--                            **
20330C               **  CALL GEVML1 TO OBTAIN GEV PARAMETER **
20331C               **  ESTIMATES.                          **
20332C               ******************************************
20333C
20334      ISTEPN='1'
20335      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML3')
20336     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20337C
20338      CALL STMOM3(Y,N,IWRITE,XSKEW,IBUGA3,IERROR)
20339C
20340      MLFLAG=.TRUE.
20341CCCCC MLFLAG=.FALSE.
20342      IGEPDF='NULL'
20343      ICASPL='GEV'
20344      CALL GEVML1(Y,N,MAXNXT,MINMAX,ICASPL,MLFLAG,IGEPDF,
20345     1            ISEED,IDFTTY,IGEVML,
20346     1            TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
20347     1            DTEMP1,XMOM,NMOM,VARCOV,
20348     1            XMEAN,XSD,XVAR,XMIN,XMAX,
20349     1            ALOCLZ,SCALLZ,SHAPLZ,
20350     1            ALOCEZ,SCALEZ,SHAPEZ,
20351     1            ALOCMZ,SCALMZ,SHAPMZ,
20352     1            ISUBRO,IBUGA3,IERROR)
20353C
20354      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML3')THEN
20355        WRITE(ICOUT,1011)
20356 1011   FORMAT('**** AFTER CALL GEVML1')
20357        CALL DPWRST('XXX','WRIT')
20358        WRITE(ICOUT,1013)ALOCLZ,SCALLZ,SHAPLZ
20359 1013   FORMAT('L-MOMENTS: ALOCLZ,SCALLZ,SHAPLZ = ',3G15.7)
20360        CALL DPWRST('XXX','WRIT')
20361        WRITE(ICOUT,1015)ALOCEZ,SCALEZ,SHAPEZ
20362 1015   FORMAT('ELEMENTAL PERCENTILES: ALOCEZ,SCALEZ,SHAPEZ = ',3G15.7)
20363        CALL DPWRST('XXX','WRIT')
20364        WRITE(ICOUT,1021)ALOCMZ,SCALMZ,SHAPMZ
20365 1021   FORMAT('MLE: ALOCMZ,SCALMZ,SHAPMZ = ',3G15.7)
20366        CALL DPWRST('XXX','WRIT')
20367      ENDIF
20368C
20369C               ******************************************
20370C               **  STEP 2--                            **
20371C               **  TRANSFORM ESTIMATES TO FRECHET      **
20372C               **  PARAMETERS                          **
20373C               ******************************************
20374C
20375      ISTEPN='2'
20376      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML3')
20377     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20378C
20379      IF(MINMAX.EQ.0 .OR. MINMAX.EQ.2)THEN
20380        IF(SHAPMZ.NE.CPUMIN)THEN
20381          SHAPML=-1.0/SHAPMZ
20382          SCALML=-SCALMZ/SHAPMZ
20383          ALOCML=ALOCMZ + SCALMZ/SHAPMZ
20384        ENDIF
20385        IF(SHAPLZ.NE.CPUMIN)THEN
20386          SHAPLM=-1.0/SHAPLZ
20387          SCALLM=-SCALLZ/SHAPLZ
20388          ALOCLM=ALOCLZ + SCALLZ/SHAPLZ
20389        ENDIF
20390        IF(SHAPEZ.NE.CPUMIN)THEN
20391          SHAPEP=-1.0/SHAPEZ
20392          SCALEP=-SCALEZ/SHAPEZ
20393          ALOCEP=ALOCEZ + SCALEZ/SHAPEZ
20394        ENDIF
20395      ELSE
20396        IF(SHAPMZ.NE.CPUMIN)THEN
20397          SHAPML=-1.0/SHAPMZ
20398          SCALML=-SCALMZ/SHAPMZ
20399          ALOCML=ALOCMZ - SCALMZ/SHAPMZ
20400        ENDIF
20401        IF(SHAPLZ.NE.CPUMIN)THEN
20402          SHAPLM=-1.0/SHAPLZ
20403          SCALLM=-SCALLZ/SHAPLZ
20404          ALOCLM=ALOCLZ - SCALLZ/SHAPLZ
20405        ENDIF
20406        IF(SHAPEZ.NE.CPUMIN)THEN
20407          SHAPEP=-1.0/SHAPEZ
20408          SCALEP=-SCALEZ/SHAPEZ
20409          ALOCEP=ALOCEZ - SCALEZ/SHAPEZ
20410        ENDIF
20411      ENDIF
20412C
20413 9000 CONTINUE
20414C
20415      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'2ML3')THEN
20416        WRITE(ICOUT,999)
20417        CALL DPWRST('XXX','WRIT')
20418        WRITE(ICOUT,9011)
20419 9011   FORMAT('**** AT THE END OF EV2ML3--')
20420        CALL DPWRST('XXX','WRIT')
20421        WRITE(ICOUT,9013)ALOCLM,SCALLM,SHAPLM
20422 9013   FORMAT('L-MOMENTS: ALOCLM,SCALLM,SHAPLM = ',3G15.7)
20423        CALL DPWRST('XXX','WRIT')
20424        WRITE(ICOUT,9015)ALOCEP,SCALEP,SHAPEP
20425 9015   FORMAT('ELEMENTAL PERCENTILES: ALOCEP,SCALEP,SHAPEP = ',3G15.7)
20426        CALL DPWRST('XXX','WRIT')
20427        WRITE(ICOUT,9021)ALOCML,SCALML,SHAPML
20428 9021   FORMAT('MLE: ALOCML,SCALML,SHAPML = ',3G15.7)
20429        CALL DPWRST('XXX','WRIT')
20430      ENDIF
20431C
20432      RETURN
20433      END
20434      SUBROUTINE EV2PDF(X,GAMMA,MINMAX,PDF)
20435C
20436C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
20437C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2
20438C              DISTRIBUTION WITH SINGLE PRECISION
20439C              TAIL LENGTH PARAMETER = GAMMA.
20440C              THE EXTREME VALUE TYPE 2 DISTRIBUTION USED
20441C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
20442C              AND HAS THE PROBABILITY DENSITY FUNCTION
20443C              FOR THE MAXIMUM ORDER STATISTIC
20444C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
20445C              FOR THE MINIMUM ORDER STATISTIC
20446C              F(X) = GAMMA * ((-X)**(-GAMMA-1)) * EXP(-((-X)**(-GAMMA))).
20447C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE
20448C                                AT WHICH THE PROBABILITY DENSITY
20449C                                FUNCTION IS TO BE EVALUATED.
20450C                                X SHOULD BE NON-NEGATIVE.
20451C                     --GAMMA  = THE SINGLE PRECISION VALUE
20452C                                OF THE TAIL LENGTH PARAMETER.
20453C                                GAMMA SHOULD BE POSITIVE.
20454C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
20455C                                DENSITY FUNCTION VALUE.
20456C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
20457C             FUNCTION VALUE PDF FOR THE EXTREME VALUE TYPE 2
20458C             DISTRIBUTION WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
20459C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
20460C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
20461C                 --X SHOULD BE NON-NEGATIVE.
20462C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
20463C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
20464C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
20465C     LANGUAGE--ANSI FORTRAN.
20466C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
20467C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
20468C     WRITTEN BY--JAMES J. FILLIBEN
20469C                 STATISTICAL ENGINEERING LABORATORY (205.03)
20470C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20471C                 GAITHERSBURG, MD 20899
20472C                 PHONE:  301-975-2855
20473C     ORIGINAL VERSION--APRIL     1994.
20474C
20475C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20476C
20477C-----COMMOMN---------------------------------------------------------
20478C
20479      INCLUDE 'DPCOP2.INC'
20480C
20481C---------------------------------------------------------------------
20482C
20483C     CHECK THE INPUT ARGUMENTS FOR ERRORS
20484C
20485      PDF=0.0
20486      IF(X.LT.0.0.AND.(MINMAX.EQ.2 .OR. MINMAX.EQ.0))THEN
20487        WRITE(ICOUT,4)
20488    4   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2PDF IS ',
20489     1         'NEGATIVE')
20490        CALL DPWRST('XXX','BUG ')
20491        WRITE(ICOUT,46)X
20492        CALL DPWRST('XXX','BUG ')
20493        WRITE(ICOUT,47)MINMAX
20494        CALL DPWRST('XXX','BUG ')
20495        GOTO9000
20496      ELSEIF(X.GT.0.0.AND.MINMAX.EQ.1)THEN
20497        WRITE(ICOUT,5)
20498    5   FORMAT('***** WARNING--THE FIRST ARGUMENT TO EV2PDF IS ',
20499     1         'POSITIVE')
20500        CALL DPWRST('XXX','BUG ')
20501        WRITE(ICOUT,46)X
20502        CALL DPWRST('XXX','BUG ')
20503        WRITE(ICOUT,47)MINMAX
20504        CALL DPWRST('XXX','BUG ')
20505        GOTO9000
20506      ELSEIF(GAMMA.LE.0.0)THEN
20507        WRITE(ICOUT,15)
20508   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO EV2PDF ',
20509     1         'IS NON-POSITIVE')
20510        CALL DPWRST('XXX','BUG ')
20511        WRITE(ICOUT,46)GAMMA
20512        CALL DPWRST('XXX','BUG ')
20513        GOTO9000
20514      ENDIF
20515   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
20516   47 FORMAT('***** THE VALUE OF MINMAX IS ',I5)
20517C
20518C-----START POINT-----------------------------------------------------
20519C
20520      IF(MINMAX.EQ.1)THEN
20521        PDF=GAMMA*((-X)**(-GAMMA-1.0))*EXP(-((-X)**(-GAMMA)))
20522      ELSEIF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
20523        PDF=GAMMA*(X**(-GAMMA-1.0))*EXP(-(X**(-GAMMA)))
20524      ELSE
20525         WRITE(ICOUT,1800)
20526 1800    FORMAT('*****ERROR IN EV2PDF--MINMAX NOT 1 OR 2')
20527         CALL DPWRST('XXX','BUG ')
20528      END IF
20529C
20530 9000 CONTINUE
20531      RETURN
20532      END
20533      SUBROUTINE EV2PPF(P,GAMMA,MINMAX,PPF)
20534CCCCC MINMAX ADDED TO ABOVE ARGUMENT LIST   MAY 1993
20535C
20536C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
20537C              FUNCTION VALUE FOR THE EXTREME VALUE TYPE 2
20538C              (= FRECHET)
20539C              DISTRIBUTION WITH SINGLE PRECISION
20540C              TAIL LENGTH PARAMETER = GAMMA.
20541C              THERE ARE 2 SUCH EV2 FAMILIES--
20542C                 ONE FOR THE MIN ORDER STAT (THE USUAL) AND
20543C                 ONE FOR THE MAX ORDER STAT.
20544C              (SEE SARHAN & GREENBERG, PAGE 69)
20545C              THE EV2 TYPE IS SPECIFIED VIA   MINMAX
20546C              FOR MINMAX = 1  (FOR THE MINIMUM)
20547C                 THE EV2 DISTRIBUTION USED
20548C                 HEREIN IS DEFINED FOR ALL NEGATIVE X,
20549C                 AND HAS THE PROBABILITY DENSITY FUNCTION
20550C                 F(X) = ...
20551C              FOR MINMAX = 2 (FOR THE DEFAULT MAXIMUM),
20552C                 THE EV2 DISTRIBUTION USED
20553C                 HEREIN IS DEFINED FOR ALL POSITIVE X,
20554C                 AND HAS THE PROBABILITY DENSITY FUNCTION
20555C               F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
20556C              NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION
20557C              IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE
20558C              DISTRIBUTION FUNCTION OF THE DISTRIBUTION.
20559C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
20560C                                (BETWEEN 0.0 (EXCLUSIVELY)
20561C                                AND 1.0 (EXCLUSIVELY))
20562C                                AT WHICH THE PERCENT POINT
20563C                                FUNCTION IS TO BE EVALUATED.
20564C                     --GAMMA  = THE SINGLE PRECISION VALUE
20565C                                OF THE TAIL LENGTH PARAMETER.
20566C                                GAMMA SHOULD BE POSITIVE.
20567C                     --MINMAX = THE INTEGER VALUE
20568C                                IDENTIFYING THE
20569C                                CHOSEN WEIBULL DISTRIBUTION.
20570C                                1 = MIN, 2 = MAX.
20571C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
20572C                                POINT FUNCTION VALUE.
20573C     OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION .
20574C             VALUE PPF FOR THE EXTREME VALUE TYPE 2 DISTRIBUTION
20575C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
20576C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
20577C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
20578C                 --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY)
20579C                   AND 1.0 (EXCLUSIVELY).
20580C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
20581C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG.
20582C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
20583C     LANGUAGE--ANSI FORTRAN (1977)
20584C     REFERENCES--SARHAN & GREENBERG,
20585C                 CONTRIBUTIONS TO ORDER STATISTICS,
20586C                 1962, WILEY, PAGE 69.
20587C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
20588C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
20589C     WRITTEN BY--JAMES J. FILLIBEN
20590C                 STATISTICAL ENGINEERING DIVISION
20591C                 INFORMATION TECHNOLOGY LABORATORY
20592C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20593C                 GAITHERSBURG, MD 20899
20594C                 PHONE--301-975-2855
20595C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20596C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20597C     LANGUAGE--ANSI FORTRAN (1966)
20598C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
20599C                          DENOTED BY QUOTES RATHER THAN NH.
20600C     VERSION NUMBER--82/7
20601C     ORIGINAL VERSION--NOVEMBER  1975.
20602C     UPDATED         --DECEMBER  1981.
20603C     UPDATED         --MAY       1982.
20604C     UPDATED         --MAY       1993. REWRITTEN--ADD EV2/MAX DIST.
20605C     UPDATED         --JANUARY   1994. ADD MINMAX ERROR MESSAGE
20606C
20607C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20608C
20609C
20610C-----COMMON----------------------------------------------------------
20611C
20612      INCLUDE 'DPCOP2.INC'
20613C
20614C-----START POINT-----------------------------------------------------
20615C
20616C     CHECK THE INPUT ARGUMENTS FOR ERRORS
20617C
20618      PPF=0.0
20619      IF(P.LE.0.0.OR.P.GE.1.0)THEN
20620        WRITE(ICOUT,1)
20621    1   FORMAT('***** ERROR--THE FIRST ARGUMENT TO EV2PPF ',
20622     1         'IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL')
20623        CALL DPWRST('XXX','BUG ')
20624        WRITE(ICOUT,46)P
20625        CALL DPWRST('XXX','BUG ')
20626        GOTO9000
20627      ELSEIF(GAMMA.LE.0.0)THEN
20628        WRITE(ICOUT,15)
20629   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO EV2PPF IS ',
20630     1         'NON-POSITIVE')
20631        CALL DPWRST('XXX','BUG ')
20632        WRITE(ICOUT,46)GAMMA
20633        CALL DPWRST('XXX','BUG ')
20634        GOTO9000
20635      ENDIF
20636   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
20637C
20638CCCCC THE FOLLOWING LINE WAS REWRITTEN    MAY 1993
20639CCCCC PPF=(-LOG(P))**(-1.0/GAMMA)
20640C
20641CCCCC THE FOLLOWING SECTION WAS REWRITTEN      JANUARY 1994
20642      IF(MINMAX.EQ.1)THEN
20643         PPF= (-(LOG(1.0/(1.0-P)))**(-1.0/GAMMA))
20644      ELSE IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
20645         PPF= (LOG(1.0/P))**(-1.0/GAMMA)
20646      ELSE
20647         WRITE(ICOUT,1800)
20648 1800    FORMAT('*****ERROR IN EV2PPF--MINMAX NOT 1 OR 2')
20649         CALL DPWRST('XXX','BUG ')
20650      ENDIF
20651C
20652 9000 CONTINUE
20653      RETURN
20654      END
20655      SUBROUTINE EV2RAN(N,GAMMA,MINMAX,ISEED,X)
20656CCCCC MINMAX WAS ADDED TO THE ABOVE ARGUMENT LIST   MAY 1993
20657C
20658C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
20659C              FROM THE EXTREME VALUE TYPE 2 DISTRIBUTION
20660C              WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
20661C              THE PROTOTYPE EXTREME VALUE TYPE 2 DISTRIBUTION USED
20662C              HEREIN IS DEFINED FOR ALL NON-NEGATIVE X,
20663C              AND HAS THE PROBABILITY DENSITY FUNCTION
20664C              F(X) = GAMMA * (X**(-GAMMA-1)) * EXP(-(X**(-GAMMA))).
20665C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
20666C                                OF RANDOM NUMBERS TO BE
20667C                                GENERATED.
20668C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
20669C                                TAIL LENGTH PARAMETER.
20670C                                GAMMA SHOULD BE POSITIVE.
20671C                     --MINMAX = THE INTEGER VALUE
20672C                                IDENTIFYING THE
20673C                                CHOSEN WEIBULL DISTRIBUTION.
20674C                                1 = MIN, 2 = MAX.
20675C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
20676C                                (OF DIMENSION AT LEAST N)
20677C                                INTO WHICH THE GENERATED
20678C                                RANDOM SAMPLE WILL BE PLACED.
20679C     OUTPUT--A RANDOM SAMPLE OF SIZE N
20680C             FROM THE EXTREME VALUE TYPE 2 DISTRIBUTION
20681C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
20682C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
20683C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
20684C                   OF N FOR THIS SUBROUTINE.
20685C                 --GAMMA SHOULD BE POSITIVE.
20686C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
20687C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG.
20688C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
20689C     LANGUAGE--ANSI FORTRAN (1977)
20690C     REFERENCES--SARHAN & GREENBERG,
20691C                 CONTRIBUTIONS TO ORDER STATISTICS,
20692C                 1962, WILEY, PAGE 69.
20693C               --TOCHER, THE ART OF SIMULATION,
20694C                 1963, PAGES 14-15.
20695C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
20696C                 1964, PAGE 36.
20697C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
20698C                 DISTRIBUTIONS--1, 1970, PAGES 272-295.
20699C     WRITTEN BY--JAMES J. FILLIBEN
20700C                 STATISTICAL ENGINEERING DIVISION
20701C                 INFORMATION TECHNOLOGY LABORATORY
20702C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20703C                 GAITHERSBURG, MD 20899
20704C                 PHONE--301-975-2855
20705C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20706C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20707C     LANGUAGE--ANSI FORTRAN (1966)
20708C     VERSION NUMBER--82/7
20709C     ORIGINAL VERSION--NOVEMBER  1975.
20710C     UPDATED         --DECEMBER  1981.
20711C     UPDATED         --MAY       1982.
20712C     UPDATED         --MAY       1993. MINMAX
20713C     UPDATED         --JANUARY   1994. ADD MINMAX ERROR MESSAGE
20714C
20715C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20716C
20717C---------------------------------------------------------------------
20718C
20719      DIMENSION X(*)
20720C
20721C-----COMMON----------------------------------------------------------
20722C
20723      INCLUDE 'DPCOP2.INC'
20724C
20725C-----START POINT-----------------------------------------------------
20726C
20727C     CHECK THE INPUT ARGUMENTS FOR ERRORS
20728C
20729      IF(N.LT.1)THEN
20730        WRITE(ICOUT, 5)
20731    5   FORMAT('***** ERROR--THE REQUESTED NUMBER OF RANDON ',
20732     1         'NUMBERS IN EV2RAN IS NON-POSITIVE')
20733        CALL DPWRST('XXX','BUG ')
20734        WRITE(ICOUT,47)N
20735   47   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
20736        CALL DPWRST('XXX','BUG ')
20737        GOTO9000
20738      ELSEIF(GAMMA.LE.0.0)THEN
20739        WRITE(ICOUT,15)
20740   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO EV2RAN IS ',
20741     1         'NON-POSITIVE')
20742        CALL DPWRST('XXX','BUG ')
20743        WRITE(ICOUT,46)GAMMA
20744   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
20745        CALL DPWRST('XXX','BUG ')
20746        GOTO9000
20747      ENDIF
20748C
20749C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
20750C
20751      CALL UNIRAN(N,ISEED,X)
20752C
20753C     GENERATE N EXTREME VALUE TYPE 2 DISTRIBUTION RANDOM NUMBERS
20754C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
20755C
20756CCCCC THE FOLLOWING SECTION WAS REWRITTEN    MAY 1993
20757CCCCC DO100I=1,N
20758CCCCC X(I)=(-LOG(X(I)))**(-1.0/GAMMA)
20759CC100 CONTINUE
20760C
20761CCCCC THE FOLLOWING SECTION WAS REWRITTEN      JANUARY 1994
20762      IF(MINMAX.EQ.1)THEN
20763         DO100I=1,N
20764         X(I)= (-(LOG(1.0/(1.0-X(I))))**(-1.0/GAMMA))
20765  100    CONTINUE
20766      ELSE IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)THEN
20767         DO200I=1,N
20768         X(I)= (LOG(1.0/X(I)))**(-1.0/GAMMA)
20769  200    CONTINUE
20770      ELSE
20771         WRITE(ICOUT,1800)
20772 1800    FORMAT('*****ERROR IN EV2RAN--MINMAX NOT 1 OR 2')
20773         CALL DPWRST('XXX','BUG ')
20774      ENDIF
20775C
20776 9000 CONTINUE
20777      RETURN
20778      END
20779      SUBROUTINE EVALM(IW2,IW22,W2,ITYPE,ISTART,ISTOP,IANGLU,ANS,
20780     1                 SAVE1,SAVE2,SAVE3,SAVE4,SAVE5,SAVE6,SAVE7,SAVE8,
20781     1                 ILIBC1,ILIBC2,IBUGEV,IERROR)
20782C
20783C     PURPOSE--EVALUATE A STRING OF CODE THAT CONTAINS ONLY
20784C              VALUES, OPERATIONS, AND LIBRARY FUNCTIONS.
20785C     NOTE--THE DECEMBER UPDATE AUGMENTED THE USUAL MATH LIBRARY WITH
20786C           ARCSIN, ARCCOS, ARCTAN, OCTAL
20787C     NOTE--THE UPDATE WHICH ALLOWS 2 ARGUMENTS AND 3 ARGUMENTS
20788C           AS IN TCDF, CHSCDF, FCDF, ETC. HAS THE FOLLOWING RESTRICTIONS--
20789C           1) NO EXPRESSIONS FOR ARGUMENTS (MAYBE FOR FIRST)
20790C           2) NO NEGATIVE ARGUMENTS FOR SECOND AND THIRD ARGUMENTS
20791C              (FORTUNATELY THIS LAST RESTRICTION IS NO RESTRICTION
20792C              AT ALL FOR THE T, CHI-SQUARED, AND F DISTRIBUTIONS
20793C             BECAUSE THEY REQUIRE POSITIVE DEGREES OF FREEDOM ANYWAY.
20794C     WRITTEN BY--JAMES J. FILLIBEN
20795C                 STATISTICAL ENGINEERING DIVISION
20796C                 INFORMATION TECHNOLOGY LABORATORY
20797C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20798C                 GAITHERSBURG, MD 20899
20799C                 PHONE--301-975-2855
20800C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20801C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20802C     LANGUAGE--ANSI FORTRAN (1977)
20803C     VERSION NUMBER--82/7
20804C     ORIGINAL VERSION--NOVEMBER 1, 1976.
20805C     UPDATED--DECEMBER 21, 1977.
20806C     UPDATED--DECEMBER 28, 1977.
20807C     UPDATED         --JULY      1978.
20808C     UPDATED         --JULY      1978.
20809C     UPDATED         --OCTOBER   1978.
20810C     UPDATED         --JANUARY   1979.
20811C     UPDATED         --FEBRUARY  1979.
20812C     UPDATED         --JUNE      1979.
20813C     UPDATED         --JULY      1979.
20814C     UPDATED         --FEBRUARY  1981.
20815C     UPDATED         --JUNE      1981.
20816C     UPDATED         --JULY      1981.
20817C     UPDATED         --SEPTEMBER 1981.
20818C     UPDATED         --DECEMBER  1981.
20819C     UPDATED         --MAY       1982.
20820C     UPDATED         --MARCH     1989.  SAVE3 ARGUMENT (FOR JULIA SETS)
20821C     UPDATED         --JUNE      1989.  UNDERFLOW SET TO 0 FOR * AND /
20822C     UPDATED         --MAY       1994.  SET SAVE2 AND SAVE3 TO -99.9
20823C                                        TO AVOID FCDF ERROR WITH
20824C                                        TOO FEW ARGUMENTS.
20825C     UPDATED         --SEPTEMBER 1994.  ADD SAVE4 ARGUMENT FOR DNFCDF
20826C     UPDATED         --APRIL     1995.  INITIALIZE SAVE1 ... SAVE4
20827C                                        (BUG IN HEAVE FUNCTION, WHERE
20828C                                        ARGUMENTS OPTIONAL)
20829C                                        ALSO, BUG IN FOLLOWING
20830C                                        LET A = TPDF(X,2) - TPDF(X,3)
20831C                                        BOTH USE 2 FOR SECOND ARG.
20832C     UPDATED         --SEPTEMBER 1997.  WORKAROUND FOR "**" OPERATION
20833C                                        (BUG IN OLD LAHEY COMPILER)
20834C     UPDATED         --MAY       1998.  ADD SAVE5
20835C     UPDATED         --NOVEMBER  1998.  FIX FOR 0**(POSITIVE NUMB)
20836C     UPDATED         --JUNE      2003.  ADD SAVE6, SAVE7, SAVE8
20837C
20838C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20839C
20840      CHARACTER*4 IW2(*)
20841      CHARACTER*4 IW22(*)
20842      CHARACTER*4 ITYPE(*)
20843      CHARACTER*4 IANGLU
20844      CHARACTER*4 IBUGEV
20845      CHARACTER*4 IERROR
20846C
20847C
20848C---------------------------------------------------------------------
20849C
20850      DIMENSION W2(*)
20851C
20852CCCCC FOLLOWING SECTION ADDED APRIL 1995.
20853      DIMENSION SAVE1(*)
20854      DIMENSION SAVE2(*)
20855      DIMENSION SAVE3(*)
20856      DIMENSION SAVE4(*)
20857      DIMENSION SAVE5(*)
20858      DIMENSION SAVE6(*)
20859      DIMENSION SAVE7(*)
20860      DIMENSION SAVE8(*)
20861C
20862      DIMENSION TERM(80)
20863      DIMENSION IOP(80)
20864      CHARACTER*4 IOP
20865C
20866CCCCC FOLLOWING LINE FOR LAHEY BUG.  SEPTEMBER 1997.
20867C
20868C-----COMMON----------------------------------------------------------
20869C
20870      INCLUDE 'DPCOHO.INC'
20871      INCLUDE 'DPCOP2.INC'
20872C
20873C-----DATA STATEMENTS-------------------------------------------------
20874C
20875C     DEFINE THE UPPER LIMIT OF THE NUMBER OF 'TERMS' THAT THIS
20876C     SUBROUTINE CAN PROCESS.  THIS IS USUALLY THE SAME AS THE MAX
20877C     NUMBER OF CHARACTERS THAT MAY BE PROCESSED BY THE COMPIM SUBROUTINE
20878C     IF RESTRICT THE FUNCTIONAL EXPRESSION TO 1 LINE IMAGE, THEN A
20879C     REASONABLE UPPER BOUND IS 80.  WHATEVER UPPER BOUND IS SET, THE
20880C     DIMENSIONS OF THE VECTORS TERM(.) AND IOP(.),  USED HEREIN
20881C     MUST BE EQUAL OR LARGER TO THIS NUMBER.
20882C
20883      DATA MAXTER/80/
20884C
20885C-----START POINT-----------------------------------------------------
20886C
20887      ANS=0.0
20888      IERROR='NO'
20889C
20890      CUTOFF=0.00001
20891      AIABS2=(-999.0)
20892      ALCPUM=LOG(CPUMAX)
20893C
20894C     CHECK THAT THE INPUT PARAMETERS ISTART AND ISTOP)
20895C     ARE BOTH AT LEAST 1 AND BOTH AT MOST MAXTER
20896C     (WHERE MAXTER IS THE INTERNALLY DEFINED VARIABLE
20897C     WHICH CONTROLS DIMENSION SIZES AND WHICH
20898C     TYPICALLY HAS THE VALUE 80).
20899C     ALSO CHECK THAT ISTART DOES NOT EXCEED ISTOP.
20900C
20901      IF(ISTART.LT.1.OR.MAXTER.LT.ISTART)GOTO20
20902      IF(ISTOP.LT.1.OR.MAXTER.LT.ISTOP)GOTO20
20903      IF(ISTOP.LT.ISTART)GOTO20
20904      GOTO39
20905   20 CONTINUE
20906      WRITE(ICOUT,21)
20907   21 FORMAT('***** ERROR IN EVALM--')
20908      CALL DPWRST('XXX','BUG ')
20909      WRITE(ICOUT,22)
20910   22 FORMAT('      ILLEGAL VALUES FOR THE INPUT PARAMETERS ISTART ',
20911     1       'AND/OR ISTOP.')
20912      CALL DPWRST('XXX','BUG ')
20913      WRITE(ICOUT,24)MAXTER
20914   24 FORMAT('      BOTH ISTART AND ISTOP MUST BE AT LEAST 1 AND AT ',
20915     1       'MOST ',I5,'.')
20916      CALL DPWRST('XXX','BUG ')
20917      WRITE(ICOUT,28)
20918   28 FORMAT('      ALSO, ISTART MUST BE LESS THAN OR EQUAL TO ',
20919     1       'ISTOP.')
20920      CALL DPWRST('XXX','BUG ')
20921      WRITE(ICOUT,30)ISTART
20922   30 FORMAT('      ISTART = ',I8)
20923      CALL DPWRST('XXX','BUG ')
20924      WRITE(ICOUT,31)ISTOP
20925   31 FORMAT('      ISTOP  = ',I8)
20926      CALL DPWRST('XXX','BUG ')
20927      IERROR='YES'
20928      GOTO9000
20929   39 CONTINUE
20930C
20931      IF(IBUGEV.EQ.'ON')THEN
20932        WRITE(ICOUT,999)
20933  999   FORMAT(1X)
20934        CALL DPWRST('XXX','BUG ')
20935        WRITE(ICOUT,51)
20936   51   FORMAT('***** AT THE BEGINNING OF EVALM--')
20937        CALL DPWRST('XXX','BUG ')
20938        WRITE(ICOUT,52)ISTART,ISTOP,IBUGEV,IANGLU
20939   52   FORMAT('ISTART,ISTOP,IBUGEV,IANGLU = ',2I6,2(2X,A4))
20940        CALL DPWRST('XXX','BUG ')
20941        DO53I=ISTART,ISTOP
20942          WRITE(ICOUT,54)I,IW2(I),IW22(I),W2(I),ITYPE(I)
20943   54     FORMAT('I,IW2(I),IW22(I),W2(I),ITYPE(I) = ',I8,2(2X,A4),
20944     1           F15.7,2X,A4)
20945          CALL DPWRST('XXX','BUG ')
20946   53   CONTINUE
20947        WRITE(ICOUT,58)SAVE1(1),SAVE2(1),SAVE3(1),SAVE4(1)
20948   58   FORMAT('I=1,SAVE1,SAVE2,SAVE3,SAVE4 = ',4E15.7)
20949        CALL DPWRST('XXX','BUG ')
20950      ENDIF
20951C
20952C     BLANK-OUT THE IOP(.) VECTOR AND ZERO-OUT THE TERM(.) VECTOR.
20953C
20954      DO110I=1,MAXTER
20955        TERM(I)=0.0
20956        IOP(I)='    '
20957  110 CONTINUE
20958C
20959C               *********************************************************
20960C               **  STEP 1--                                           **
20961C               **  OPERATE ON THE VECTORS IW2(.) AND IW22(.).         **
20962C               **  THEY SHOULD CONTAIN NO PARENTHESES.                **
20963C               **  THEY SHOULD CONTAIN ONLY--                         **
20964C               **       NUMBERS                                       **
20965C               **       X VALUES                                      **
20966C               **       PARAMETER VALUES                              **
20967C               **       PREVIOUSLY COMPUTED VALUES                    **
20968C               **       OPERATIONS (5--+ - * / **)                    **
20969C               **       LIBRARY FUNCTIONS.                            **
20970C               **  COPY THE NUMBERS, X VALUES, PARAMETER VALUES, AND  **
20971C               **  PREVIOUSLY COMPUTED VALUES OVER TO THE TERM VECTOR.**
20972C               **  COPY THE OPERATIONS OVER TO THE OPERATIONS VECTOR. **
20973C               **  ELIMINATE THE LIBRARY FUNCTIONS BY EVALUATING THEM **
20974C               **  WITH THE NEXT POTENTIAL TERM AND PUTTING           **
20975C               **  THE EVALUATED RESULT INTO THAT NEXT TERM.          **
20976C               **  OUTPUT THE VECTOR TERMS(.) AND THE VECTOR IOP(.)   **
20977C               **  WHICH CONTAIN TERMS AND OPERATIONS RESPECTIVELY.   **
20978C               *********************************************************
20979C
20980      IF(ITYPE(ISTOP).EQ.'OP')THEN
20981        WRITE(ICOUT,21)
20982        CALL DPWRST('XXX','BUG ')
20983        WRITE(ICOUT,121)ITYPE(ISTOP)
20984  121   FORMAT('      LAST TERM IN AN INTERMEDIATE EXPRESSION = AN ',
20985     1         'OPERATION = ',A4)
20986        CALL DPWRST('XXX','BUG ')
20987        IERROR='YES'
20988        GOTO9000
20989      ELSEIF(ITYPE(ISTOP).EQ.'LF')THEN
20990        WRITE(ICOUT,21)
20991        CALL DPWRST('XXX','BUG ')
20992        WRITE(ICOUT,123)ITYPE(ISTOP)
20993  123   FORMAT('      LAST TERM IN AN INTERMEDIATE EXPRESSION = A ',
20994     1         'LIBRARY FUNCTION = ',A4)
20995        CALL DPWRST('XXX','BUG ')
20996        IERROR='YES'
20997        GOTO9000
20998      ENDIF
20999C
21000      NOP=0
21001      NTERM=0
21002      NUMSAV=0
21003      I=ISTART
21004C
21005  150 CONTINUE
21006      IDEL=1
21007      IP1=I+1
21008      IP2=I+2
21009      IP3=I+3
21010      IP4=I+4
21011      IP5=I+5
21012      IF(ITYPE(I).EQ.'N'   .OR. ITYPE(I).EQ.'X' .OR.
21013     1   ITYPE(I).EQ.'PAR' .OR. ITYPE(I).EQ.'V')THEN
21014        IF(NUMSAV.LT.1)THEN
21015          NTERM=NTERM+1
21016          TERM(NTERM)=W2(I)
21017          IOP(NTERM)='V'
21018        ELSEIF(NUMSAV.EQ.1)THEN
21019          SAVE1(ILIBC1)=W2(I)
21020        ELSEIF(NUMSAV.EQ.2)THEN
21021         SAVE2(ILIBC1)=W2(I)
21022        ELSEIF(NUMSAV.EQ.3)THEN
21023         SAVE3(ILIBC1)=W2(I)
21024        ELSEIF(NUMSAV.EQ.4)THEN
21025          SAVE4(ILIBC1)=W2(I)
21026        ELSEIF(NUMSAV.EQ.5)THEN
21027          SAVE5(ILIBC1)=W2(I)
21028        ELSEIF(NUMSAV.EQ.6)THEN
21029          SAVE6(ILIBC1)=W2(I)
21030        ELSEIF(NUMSAV.EQ.7)THEN
21031          SAVE7(ILIBC1)=W2(I)
21032        ELSEIF(NUMSAV.EQ.8)THEN
21033          SAVE8(ILIBC1)=W2(I)
21034        ENDIF
21035        GOTO100
21036      ELSEIF(ITYPE(I).EQ.'OP')THEN
21037        IF(IW2(I).EQ.'+' .OR. IW2(I).EQ.'-')THEN
21038          NOP=NOP+1
21039          IOP(NOP)=IW2(I)
21040          IF(NTERM.EQ.0)TERM(1)=0.0
21041          IF(NTERM.EQ.0)NTERM=1
21042          GOTO100
21043        ELSEIF(IW2(I).EQ.'*' .OR. IW2(I).EQ.'/' .OR.
21044     1         IW2(I).EQ.'**')THEN
21045          NOP=NOP+1
21046          IOP(NOP)=IW2(I)
21047          IF(NTERM.EQ.0)THEN
21048            WRITE(ICOUT,322)
21049  322       FORMAT('      *, /, OR ** STARTS AN EXPRESSION')
21050            CALL DPWRST('XXX','BUG ')
21051            IERROR='YES'
21052            GOTO9000
21053          ENDIF
21054          GOTO100
21055        ELSE
21056          WRITE(ICOUT,21)
21057          CALL DPWRST('XXX','BUG ')
21058          WRITE(ICOUT,305)
21059  305     FORMAT('      NOT ONE OF THE 5 OPERATIONS:  + - * / **')
21060          CALL DPWRST('XXX','BUG ')
21061          WRITE(ICOUT,306)I,IW2(I),IW22(I)
21062  306     FORMAT('      I,IW2(I),IW22(I) = ',I8,2(2X,A4))
21063          CALL DPWRST('XXX','BUG ')
21064          IERROR='YES'
21065          GOTO9000
21066        ENDIF
21067      ELSEIF(
21068     1  (ITYPE(I).EQ.'LF'.AND.ITYPE(IP1).EQ.'V') .OR.
21069     1  (ITYPE(I).EQ.'LF'.AND.ITYPE(IP1).EQ.'N') .OR.
21070     1  (ITYPE(I).EQ.'LF'.AND.ITYPE(IP1).EQ.'X') .OR.
21071     1  (ITYPE(I).EQ.'LF'.AND.ITYPE(IP1).EQ.'PAR'))THEN
21072        GOTO400
21073      ELSEIF(ITYPE(I).EQ.'COM')THEN
21074        NUMSAV=NUMSAV+1
21075        GOTO100
21076      ELSE
21077        WRITE(ICOUT,21)
21078        CALL DPWRST('XXX','BUG ')
21079        WRITE(ICOUT,105)
21080  105   FORMAT('      UNKNOWN ARGUMENT/OPERATION TYPE')
21081        CALL DPWRST('XXX','BUG ')
21082        WRITE(ICOUT,106)I,ITYPE(I)
21083  106   FORMAT('      I,ITYPE(I) = ',I8,2X,A4)
21084        CALL DPWRST('XXX','BUG ')
21085        IERROR='YES'
21086        GOTO9000
21087      ENDIF
21088C
21089  400 CONTINUE
21090C
21091C     PERFORM A LIBRARY FUNCTION EVALUATION.
21092C
21093      IF(IBUGEV.EQ.'ON')THEN
21094        WRITE(ICOUT,331)
21095  331   FORMAT('IN EVALM, BEFORE ENTERING DPLIBF--')
21096        CALL DPWRST('XXX','BUG ')
21097        WRITE(ICOUT,332)IW2(I),IW22(I),W2(IP1),IBUGEV
21098  332   FORMAT('IW2(I),IW22(I),W2(IP1),IBUGEV = ',2(A4,2X),F10.5,2X,A4)
21099        CALL DPWRST('XXX','BUG ')
21100      ENDIF
21101C
21102      ILIBC2=ILIBC2+1
21103      IF(ILIBC2.GT.0)THEN
21104        ASAV1=SAVE1(ILIBC2)
21105        ASAV2=SAVE2(ILIBC2)
21106        ASAV3=SAVE3(ILIBC2)
21107        ASAV4=SAVE4(ILIBC2)
21108        ASAV5=SAVE5(ILIBC2)
21109        ASAV6=SAVE6(ILIBC2)
21110        ASAV7=SAVE7(ILIBC2)
21111        ASAV8=SAVE8(ILIBC2)
21112      ELSE
21113        ASAV1=0.0
21114        ASAV2=0.0
21115        ASAV3=0.0
21116        ASAV4=0.0
21117        ASAV5=0.0
21118        ASAV6=0.0
21119        ASAV7=0.0
21120        ASAV8=0.0
21121      ENDIF
21122      CALL DPLIBF(IW2(I),IW22(I),W2(IP1),ASAV1,ASAV2,ASAV3,ASAV4,
21123     1            ASAV5,ASAV6,ASAV7,ASAV8,
21124     1            I,
21125     1            IANGLU,RESULT,IBUGEV,IERROR)
21126C
21127      IF(IBUGEV.EQ.'ON')THEN
21128        WRITE(ICOUT,333)
21129  333   FORMAT('IN EVALM, AFTER RETURNING FROM DPLIBF--')
21130        CALL DPWRST('XXX','BUG ')
21131        WRITE(ICOUT,334)RESULT,IERROR
21132  334   FORMAT('RESULT, IERROR = ',F20.10,2X,A4)
21133        CALL DPWRST('XXX','BUG ')
21134      ENDIF
21135C
21136      IF(IERROR.EQ.'YES')GOTO9000
21137      NTERM=NTERM+1
21138      TERM(NTERM)=RESULT
21139C
21140      IOP(NTERM)='V'
21141C
21142C     CHECK THAT NTERM HAS NOT EXCEEDED MAXTER (USUALLY 80)
21143C
21144      IF(NTERM.GT.MAXTER)THEN
21145        WRITE(ICOUT,21)
21146        CALL DPWRST('XXX','BUG ')
21147        WRITE(ICOUT,1902)
21148 1902   FORMAT('      THE VARIABLE NTERM HAS JUST EXCEEDED THE')
21149        CALL DPWRST('XXX','BUG ')
21150        WRITE(ICOUT,1903)MAXTER
21151 1903   FORMAT('      THE MAXIMUM ALLOWABLE LIMIT OF ',I5)
21152        CALL DPWRST('XXX','BUG ')
21153        IERROR='YES'
21154        GOTO9000
21155      ENDIF
21156C
21157      IDEL=2
21158  100 CONTINUE
21159      I=I+IDEL
21160      IF(I.LE.ISTOP)GOTO150
21161C
21162      IF(IBUGEV.EQ.'ON')THEN
21163        WRITE(ICOUT,491)
21164  491   FORMAT('AFTER THE LIBRARY FUNCTIONS HAVE BEEN ',
21165     1         'EVALUATED AND ELIMINATED--')
21166        CALL DPWRST('XXX','BUG ')
21167        WRITE(ICOUT,492)NTERM,NOP
21168  492   FORMAT('NTERM,NOP = ',2I6)
21169        CALL DPWRST('XXX','BUG ')
21170        DO493I=1,NTERM
21171          WRITE(ICOUT,494)I,TERM(I),IOP(I)
21172  494     FORMAT('I,TERM(I),IOP(I) = ',I6,E15.7,2X,A4)
21173          CALL DPWRST('XXX','BUG ')
21174  493   CONTINUE
21175      ENDIF
21176C
21177C               *******************************************************
21178C               **  STEP 2--                                         **
21179C               **  CHECK TO SEE THAT THE NUMBER OF TERMS =          **
21180C               **  ONE MORE THAN THE NUMBER OF OPERATIONS.          **
21181C               **  ALSO CHECK TO SEE IF THE SPECIAL CASE            **
21182C               **  EXISTS WHERE THERE IS ONLY 1 TERM--              **
21183C               **  IF SO, SET ANS = TO THIS FIRST TERM AND EXIT.    **
21184C               *******************************************************
21185C
21186      NOPP1=NOP+1
21187      IF(NTERM.EQ.NOPP1)THEN
21188        IF(NTERM.EQ.1)THEN
21189          ANS=TERM(1)
21190          GOTO9000
21191        ELSEIF(NTERM.EQ.0)THEN
21192          WRITE(ICOUT,21)
21193          CALL DPWRST('XXX','BUG ')
21194          WRITE(ICOUT,571)
21195  571     FORMAT('      NUMBER OF TERMS = 0 AT END OF STEP 2 ',
21196     1           '(LIBRARY FUNCTIONS ELIMINATED)')
21197          CALL DPWRST('XXX','BUG ')
21198          IERROR='YES'
21199          GOTO9000
21200        ENDIF
21201      ELSE
21202        WRITE(ICOUT,21)
21203        CALL DPWRST('XXX','BUG ')
21204        WRITE(ICOUT,560)
21205  560   FORMAT('      NUMBER OF TERMS NOT EQUAL TO NUMBER OF ',
21206     1         'OPERATIONS + 1')
21207        CALL DPWRST('XXX','BUG ')
21208        WRITE(ICOUT,566)NTERM,NOPP1
21209  566   FORMAT('      NTERM,NOPP1 = ',I8,2X,I8)
21210        CALL DPWRST('XXX','BUG ')
21211        IERROR='YES'
21212        GOTO9000
21213      ENDIF
21214C
21215C               ********************************************************
21216C               **  STEP 3--                                          **
21217C               **  OPERATE ON THE TERM(.) AND IOP(.) VECTORS.  AT    **
21218C               **  THIS POINT WE HAVE ONLY ALTERNATING TERMS AND     **
21219C               **  OPERATIONS WHERE AN OPERATION IS ANY ONE OF THE   **
21220C               **  5-- +   -   *   /   **.  EVALUATE AND ELIMINATE   **
21221C               **  ALL SQUEEZE THE TERM(.) AND IOP(.) VECTORS UNTIL  **
21222C               **  UNTIL ALL ** ARE GONE.                            **
21223C               ********************************************************
21224C
21225      I=1
21226 1100 CONTINUE
21227      IF(IOP(I).NE.'**')THEN
21228        I=I+1
21229        IF(I.LE.NOP)GOTO1100
21230        GOTO1500
21231      ENDIF
21232C
21233      IP1=I+1
21234      T1=TERM(I)
21235      T2=TERM(IP1)
21236      T3=ABS(T1)
21237      T4=ABS(T2)
21238      T34=0.0
21239      IF(T3.GT.0.0.AND.T4.GT.0.0)T34=T4*LOG(T3)
21240      IF(T34.GT.ALCPUM)GOTO8011
21241      IF(T1.NE.CPUMIN.AND.T1.NE.CPUMAX.AND.
21242     1   T2.NE.CPUMIN.AND.T2.NE.CPUMAX)GOTO1219
21243      IF(T1.EQ.CPUMIN.AND.T4.LE.1.0)GOTO1219
21244      IF(T2.EQ.CPUMIN.AND.T3.LE.1.0)GOTO1219
21245      IF(T1.EQ.CPUMAX.AND.T4.LE.1.0)GOTO1219
21246      IF(T2.EQ.CPUMAX.AND.T3.LE.1.0)GOTO1219
21247      GOTO8011
21248C
21249 1219 CONTINUE
21250      IF(T1.EQ.0.0)THEN
21251        IF(T2.GT.0.0)THEN
21252          TERM(I)=0.0
21253          GOTO1239
21254        ENDIF
21255C
21256        WRITE(ICOUT,999)
21257        CALL DPWRST('XXX','BUG ')
21258        WRITE(ICOUT,21)
21259        CALL DPWRST('XXX','BUG ')
21260        WRITE(ICOUT,1222)
21261 1222   FORMAT('      ATTEMPT TO RAISE A ZERO NUMBER ')
21262        CALL DPWRST('XXX','BUG ')
21263        WRITE(ICOUT,1223)
21264 1223   FORMAT('      TO A ZERO OR NEGATIVE POWER.')
21265        CALL DPWRST('XXX','BUG ')
21266        WRITE(ICOUT,1226)T2
21267 1226   FORMAT('      THE POWER           = ',E15.7)
21268        CALL DPWRST('XXX','BUG ')
21269        IERROR='YES'
21270        GOTO9000
21271      ELSEIF(T1.LT.0.0)THEN
21272C
21273        ABST2=ABS(T2)
21274        ISIGN=(-1)
21275        IF(T2.GE.0.0)ISIGN=1
21276        IABST2=INT(ABST2)
21277        IABS2=IABST2
21278        REM=ABST2-AIABS2
21279        ABSREM=ABS(REM)
21280        IF(ABSREM.GE.CUTOFF)THEN
21281          WRITE(ICOUT,999)
21282          CALL DPWRST('XXX','BUG ')
21283          WRITE(ICOUT,21)
21284          CALL DPWRST('XXX','BUG ')
21285          WRITE(ICOUT,1232)
21286 1232     FORMAT('      ATTEMPT TO RAISE A NEGATIVE NUMBER ')
21287          CALL DPWRST('XXX','BUG ')
21288          WRITE(ICOUT,1233)
21289 1233     FORMAT('      TO A FRACTIONAL POWER.')
21290          CALL DPWRST('XXX','BUG ')
21291          WRITE(ICOUT,1235)T1
21292 1235     FORMAT('      THE NEGATIVE NUMBER = ',E15.7)
21293          CALL DPWRST('XXX','BUG ')
21294          WRITE(ICOUT,1236)T2
21295 1236     FORMAT('      THE POWER           = ',E15.7)
21296          CALL DPWRST('XXX','BUG ')
21297          IERROR='YES'
21298          GOTO9000
21299        ENDIF
21300C
21301        IF(IBUGEV.EQ.'ON')THEN
21302          WRITE(ICOUT,7777)T1,T2,ABST2,ISIGN,IABST2
21303 7777     FORMAT('T1,T2,ABST2,ISIGN,IABST2 = ',3E15.7,2I8)
21304          CALL DPWRST('XXX','BUG ')
21305          WRITE(ICOUT,7778)AIABS2,REM,ABSREM,TERM(I)
21306 7778     FORMAT('AIABS2,REM,ABSREM,TERM(I) = ',4E15.7)
21307          CALL DPWRST('XXX','BUG ')
21308        ENDIF
21309C
21310        TERM(I)=TERM(I)**(ISIGN*IABST2)
21311        GOTO1239
21312      ENDIF
21313C
21314      IF(IBUGEV.EQ.'ON')THEN
21315        WRITE(ICOUT,1238)I,TERM(I),TERM(IP1),T1,T2,AIABS2,REM
21316 1238   FORMAT('I,TERM(I),TERM(IP1),T1,T2,AIABS2,REM = ',I4,6E15.7)
21317        CALL DPWRST('XXX','BUG ')
21318      ENDIF
21319C
21320CCCCC FOLLOWING LINE SEEMS TO SHOW A COMPILER BUG FOR THE OLDER LAHEY
21321CCCCC COMPILER.  WORKAROUND FOR THIS COMPILER.   SEPTEMBER 1997.
21322CCCCC TERM(I)=TERM(I)**TERM(IP1)
21323      IF(ICOMPI.NE.'LAHE')THEN
21324        TERM(I)=TERM(I)**TERM(IP1)
21325      ELSE
21326        ATEMP1=TERM(IP1)*LOG(TERM(I))
21327        TERM(I)=EXP(ATEMP1)
21328      ENDIF
21329C
21330 1239 CONTINUE
21331      NOPM1=NOP-1
21332      IF(I.LT.NOP)THEN
21333        DO1400J=I,NOPM1
21334          JP1=J+1
21335          JP2=J+2
21336          IOP(J)=IOP(JP1)
21337          TERM(JP1)=TERM(JP2)
21338 1400   CONTINUE
21339      ENDIF
21340      NOP=NOPM1
21341      IF(I.LE.NOP)GOTO1100
21342C
21343 1500 CONTINUE
21344      NTERM=NOP+1
21345C
21346      IF(IBUGEV.EQ.'ON')THEN
21347        WRITE(ICOUT,1991)
21348 1991   FORMAT('AFTER THE ** HAVE BEEN EVALUATED AND ELIMINATED--')
21349        CALL DPWRST('XXX','BUG ')
21350        WRITE(ICOUT,1992)NTERM,NOP
21351 1992   FORMAT('NTERM,NOP = ',2I6)
21352        CALL DPWRST('XXX','BUG ')
21353        DO1993I=1,NTERM
21354          WRITE(ICOUT,1994)I,TERM(I),IOP(I)
21355 1994     FORMAT('I,TERM(I),IOP(I) = ',I6,E15.7,2X,A4)
21356          CALL DPWRST('XXX','BUG ')
21357 1993   CONTINUE
21358      ENDIF
21359C
21360C               ********************************************************
21361C               **  STEP 4--                                          **
21362C               **  OPERATE ON THE TERM(.) AND IOP(.) VECTORS. AT     **
21363C               **  THIS POINT WE HAVE ONLY ALTERNATING TERMS AND     **
21364C               **  OPERATIONS WHERE AN OPERATION IS ANY ONE OF THE   **
21365C               **  4-- +   -   *   /   .                             **
21366C               **  EVALUATE AND ELIMINATE ALL * AND / IN SEQUENCE.   **
21367C               **  SQUEEZE THE TERM(.) AND IOP(.) VECTORS UNTIL      **
21368C               **  UNTIL ALL * AND / ARE GONE.                       **
21369C               ********************************************************
21370C
21371      I=1
21372 2100 CONTINUE
21373      IF(IOP(I).EQ.'*')THEN
21374        IP1=I+1
21375        T1=TERM(I)
21376        T2=TERM(IP1)
21377        T3=ABS(T1)
21378        T4=ABS(T2)
21379        T34=0.0
21380        IF(T3.GT.0.0.AND.T4.GT.0.0)T34=LOG(T3)+LOG(T4)
21381        IF(T34.GT.ALCPUM)GOTO8011
21382        IF(T34.LT.-ALCPUM)TERM(I)=0.0
21383        IF(T34.LT.-ALCPUM)GOTO2250
21384        IF(T1.NE.CPUMIN.AND.T1.NE.CPUMAX.AND.
21385     1     T2.NE.CPUMIN.AND.T2.NE.CPUMAX)GOTO2219
21386        IF(T1.EQ.CPUMIN.AND.T4.LE.1.0)GOTO2219
21387        IF(T2.EQ.CPUMIN.AND.T3.LE.1.0)GOTO2219
21388        IF(T1.EQ.CPUMAX.AND.T4.LE.1.0)GOTO2219
21389        IF(T2.EQ.CPUMAX.AND.T3.LE.1.0)GOTO2219
21390        GOTO8011
21391C
21392 2219   CONTINUE
21393        TERM(I)=TERM(I)*TERM(IP1)
21394        GOTO2250
21395      ELSEIF(IOP(I).EQ.'/')THEN
21396        IP1=I+1
21397        T1=TERM(I)
21398        T2=TERM(IP1)
21399        T3=ABS(T1)
21400        T4=ABS(T2)
21401        T34=0.0
21402        IF(T3.GT.0.0.AND.T4.GT.0.0)T34=LOG(T3)-LOG(T4)
21403        IF(T34.GT.ALCPUM)GOTO8011
21404        IF(T34.LT.-ALCPUM)TERM(I)=0.0
21405        IF(T34.LT.-ALCPUM)GOTO2250
21406        IF(T1.NE.CPUMIN.AND.T1.NE.CPUMAX.AND.
21407     1     T2.NE.CPUMIN.AND.T2.NE.CPUMAX)GOTO2229
21408        IF(T1.EQ.CPUMIN.AND.T4.GE.1.0)GOTO2229
21409        IF(T1.EQ.CPUMAX.AND.T4.GE.1.0)GOTO2229
21410        GOTO8011
21411C
21412 2229  CONTINUE
21413        IF(T2.EQ.0.0)THEN
21414          WRITE(ICOUT,999)
21415          CALL DPWRST('XXX','BUG ')
21416          WRITE(ICOUT,21)
21417          CALL DPWRST('XXX','BUG ')
21418          WRITE(ICOUT,2232)
21419 2232     FORMAT('      ATTEMPT TO DIVIDE A NUMBER BY ZERO.')
21420          CALL DPWRST('XXX','BUG ')
21421          WRITE(ICOUT,2235)T1
21422 2235     FORMAT('      THE NUMERATOR   = ',E15.7)
21423          CALL DPWRST('XXX','BUG ')
21424          WRITE(ICOUT,2236)T2
21425 2236     FORMAT('      THE DENOMINATOR = ',E15.7)
21426          CALL DPWRST('XXX','BUG ')
21427          IERROR='YES'
21428          GOTO9000
21429        ENDIF
21430C
21431        TERM(I)=TERM(I)/TERM(IP1)
21432        GOTO2250
21433      ELSE
21434        I=I+1
21435        GOTO2350
21436      ENDIF
21437C
21438 2250 CONTINUE
21439      NOPM1=NOP-1
21440      IF(I.LT.NOP)THEN
21441        DO2400J=I,NOPM1
21442          JP1=J+1
21443          JP2=J+2
21444          IOP(J)=IOP(JP1)
21445          TERM(JP1)=TERM(JP2)
21446 2400   CONTINUE
21447      ENDIF
21448      NOP=NOPM1
21449C
21450 2350 CONTINUE
21451      IF(I.LE.NOP)GOTO2100
21452      NTERM=NOP+1
21453C
21454      IF(IBUGEV.EQ.'ON')THEN
21455        WRITE(ICOUT,2991)
21456 2991   FORMAT('AFTER THE * AND / HAVE BEEN EVALUATED AND ELIMINATED--')
21457        CALL DPWRST('XXX','BUG ')
21458        WRITE(ICOUT,2992)NTERM,NOP
21459 2992   FORMAT('NTERM,NOP = ',2I6)
21460        CALL DPWRST('XXX','BUG ')
21461        DO2993I=1,NTERM
21462          WRITE(ICOUT,2994)I,TERM(I),IOP(I)
21463 2994     FORMAT('I,TERM(I),IOP(I) = ',I6,E15.7,2X,A4)
21464          CALL DPWRST('XXX','BUG ')
21465 2993   CONTINUE
21466      ENDIF
21467C
21468C               ********************************************************
21469C               **  STEP 5--                                          **
21470C               **  OPERATE ON THE TERM(.) AND IOP(.) VECTORS.  AT    **
21471C               **  THIS POINT WE HAVE ONLY ALTERNATING TERMS AND     **
21472C               **  OPERATIONS WHERE AN OPERATION IS ANY ONE OF THE   **
21473C               **  2-- + OR - .  EVALUATE ALL + OR - OPERATIONS IN   **
21474C               **  SEQUENCE.  SQUEEZE THE TERM(.) AND IOP(.) VECTORS **
21475C               **  UNTIL ALL + AND - OPERATIONS ARE GONE.            **
21476C               ********************************************************
21477C
21478      IF(NOP.LT.1)THEN
21479        ANS=TERM(1)
21480        GOTO9000
21481      ENDIF
21482      ANS=TERM(1)
21483      DO3200I=1,NOP
21484        IP1=I+1
21485        IF(IOP(I).EQ.'-')THEN
21486          T1=TERM(I)
21487          T2=TERM(IP1)
21488          IF(T1.NE.CPUMIN.AND.T1.NE.CPUMAX.AND.
21489     1       T2.NE.CPUMIN.AND.T2.NE.CPUMAX)GOTO3229
21490          IF(T1.EQ.CPUMIN.AND.T2.LE.0.0)GOTO3229
21491          IF(T2.EQ.CPUMIN.AND.T1.LE.0.0)GOTO3229
21492          IF(T1.EQ.CPUMAX.AND.T2.GE.0.0)GOTO3229
21493          IF(T2.EQ.CPUMAX.AND.T1.GE.0.0)GOTO3229
21494          GOTO8011
21495 3229     CONTINUE
21496          ANS=ANS-TERM(IP1)
21497        ELSE
21498          T1=TERM(I)
21499          T2=TERM(IP1)
21500          IF(T1.NE.CPUMIN.AND.T1.NE.CPUMAX.AND.
21501     1       T2.NE.CPUMIN.AND.T2.NE.CPUMAX)GOTO3219
21502          IF(T1.EQ.CPUMIN.AND.T2.GE.0.0)GOTO3219
21503          IF(T2.EQ.CPUMIN.AND.T1.GE.0.0)GOTO3219
21504          IF(T1.EQ.CPUMAX.AND.T2.LE.0.0)GOTO3219
21505          IF(T2.EQ.CPUMAX.AND.T1.LE.0.0)GOTO3219
21506          GOTO8011
21507 3219     CONTINUE
21508          ANS=ANS+TERM(IP1)
21509        ENDIF
21510C
21511 3200 CONTINUE
21512      GOTO9000
21513C
21514 8011 CONTINUE
21515      WRITE(ICOUT,999)
21516      CALL DPWRST('XXX','BUG ')
21517      WRITE(ICOUT,21)
21518      CALL DPWRST('XXX','BUG ')
21519      WRITE(ICOUT,8013)
21520 8013 FORMAT('      ATTEMPT TO CARRY OUT AN OPERATION WHICH RESULTS')
21521      CALL DPWRST('XXX','BUG ')
21522      WRITE(ICOUT,8014)
21523 8014 FORMAT('      IN AN OUT-OF-RANGE NUMBER.')
21524      CALL DPWRST('XXX','BUG ')
21525      WRITE(ICOUT,8015)
21526 8015 FORMAT('      THE OPERATION      = **')
21527      CALL DPWRST('XXX','BUG ')
21528      WRITE(ICOUT,8016)T1
21529 8016 FORMAT('      THE FIRST  OPERAND = ',E15.7)
21530      CALL DPWRST('XXX','BUG ')
21531      WRITE(ICOUT,8017)T2
21532 8017 FORMAT('      THE SECOND OPERAND = ',E15.7)
21533      CALL DPWRST('XXX','BUG ')
21534      IERROR='YES'
21535      GOTO9000
21536C               *****************
21537C               **  STEP 90--  **
21538C               **  EXIT.      **
21539C               *****************
21540C
21541 9000 CONTINUE
21542      IF(IBUGEV.EQ.'ON')THEN
21543        WRITE(ICOUT,999)
21544        CALL DPWRST('XXX','BUG ')
21545        WRITE(ICOUT,9011)
21546 9011   FORMAT('***** AT THE END       OF EVALM--')
21547        CALL DPWRST('XXX','BUG ')
21548        WRITE(ICOUT,9012)ANS,IERROR
21549 9012   FORMAT('ANS,IERROR = ',E15.7,2X,A4)
21550        CALL DPWRST('XXX','BUG ')
21551        DO9113I=1,5
21552          WRITE(ICOUT,9013)I,SAVE1(I),SAVE2(I),SAVE3(I),SAVE4(I)
21553 9013     FORMAT('I,SAVE1,SAVE2,SAVE3,SAVE4 = ',I3,5E15.7)
21554          CALL DPWRST('XXX','BUG ')
21555 9113   CONTINUE
21556      ENDIF
21557C
21558      RETURN
21559      END
21560      SUBROUTINE EWECDF(X,GAMMA,THETA,MINMAX,CDF)
21561C
21562C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
21563C              FUNCTION VALUE FOR THE EXPONENTIATED WEIBULL
21564C              DISTRIBUTION WITH SINGLE PRECISION
21565C              TAIL LENGTH PARAMETER = GAMMA, SHAPE PARAMETER THETA.
21566C              THERE ARE 2 SUCH EXPONETIATED WEIBULL FAMILIES--
21567C                 ONE FOR THE MIN ORDER STAT (THE USUAL) AND
21568C                 ONE FOR THE MAX ORDER STAT.
21569C              (SEE SARHAN & GREENBERG, PAGE 69)
21570C              THE EXPONETIATED WEIBULL TYPE IS SPECIFIED VIA   MINMAX
21571C              FOR MINMAX = 1  (FOR THE DEFAULT MINIMUM)
21572C                 THE EXPONETIATED EXPONENTIATED WEIBULL DISTRIBUTION USED
21573C                 HEREIN IS DEFINED FOR ALL POSITIVE X,
21574C                 AND HAS THE PROBABILITY DENSITY FUNCTION
21575C                 F(X) = (THETA*GAMMA)*(X**(GAMMA-1)) * EXP(-(X**GAMMA))
21576C                        *(1-EXP(-(X**GAMMA))**(THETA-1)
21577C              FOR MINMAX = 2 (FOR THE MAXIMUM),
21578C                 THE EXPONETIATED EXPONENTIATED WEIBULL DISTRIBUTION USED
21579C                 HEREIN IS DEFINED FOR ALL NEGATIVE X,
21580C                 AND HAS THE PROBABILITY DENSITY FUNCTION
21581C                 F(X) = ...
21582C                 F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)).
21583C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
21584C                                WHICH THE CUMULATIVE DISTRIBUTION
21585C                                FUNCTION IS TO BE EVALUATED.
21586C                                X SHOULD BE NON-NEGATIVE.
21587C                     --GAMMA  = THE SHAPE PARAMETER
21588C                                GAMMA SHOULD BE POSITIVE.
21589C                     --THETA  = THE SINGLE PRECISION VALUE
21590C                                OF THE SECOND SHAPE PARAMETER.
21591C                                THETA SHOULD BE POSITIVE.
21592C                     --MINMAX = THE INTEGER VALUE
21593C                                IDENTIFYING THE
21594C                                CHOSEN EXPONENTIATED WEIBULL DISTRIBUTION.
21595C                                1 = MIN, 2 = MAX.
21596C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
21597C                                DISTRIBUTION FUNCTION VALUE.
21598C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
21599C             FUNCTION VALUE CDF FOR THE EXPONENTIATED WEIBULL DISTRIBUTION
21600C             WITH TAIL LENGHT PARAMETER = GAMMA.
21601C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
21602C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
21603C                 --GAMMA SHOULD BE POSITIVE.
21604C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
21605C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
21606C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
21607C     LANGUAGE--ANSI FORTRAN (1977)
21608C     REFERENCES--SARHAN & GREENBERG,
21609C                 CONTRIBUTIONS TO ORDER STATISTICS,
21610C                 1962, WILEY, PAGE 69.
21611C               --MUDHOLKAR AND SRIVASTAVE, "THE EXPONENTIATED WEIBULL
21612C                 FAMILY: A REANALYSIS OF THE BUS-MOTOR-FAILURE DATA",
21613C                 TECHNOMETRICS, NOVEMBER, 1995, PP436-437.
21614C     WRITTEN BY--JAMES J. FILLIBEN
21615C                 STATISTICAL ENGINEERING DIVISION
21616C                 INFORMATION TECHNOLOGY LABORATORY
21617C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21618C                 GAITHERSBURG, MD 20899
21619C                 PHONE--301-975-2855
21620C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21621C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21622C     LANGUAGE--ANSI FORTRAN (1966)
21623C     VERSION NUMBER--95/10
21624C     ORIGINAL VERSION--OCTOBER   1995.
21625C
21626C---------------------------------------------------------------------
21627C
21628      DOUBLE PRECISION DCDF
21629      DOUBLE PRECISION DX
21630      DOUBLE PRECISION DG
21631      DOUBLE PRECISION DT
21632      DOUBLE PRECISION DTERM1, DTERM2
21633C
21634C-----COMMON----------------------------------------------------------
21635C
21636      INCLUDE 'DPCOP2.INC'
21637C
21638C-----START POINT-----------------------------------------------------
21639C
21640C     CHECK THE INPUT ARGUMENTS FOR ERRORS
21641C
21642      MINMSV=MINMAX
21643      MINMAX=1
21644      CDF=0.0
21645      IF(GAMMA.LE.0.0)THEN
21646        WRITE(ICOUT,15)
21647   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO ',
21648     1         'EWECDF IS NON-POSITIVE')
21649        CALL DPWRST('XXX','BUG ')
21650        WRITE(ICOUT,46)GAMMA
21651   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
21652        CALL DPWRST('XXX','BUG ')
21653        GOTO9000
21654      ELSEIF(THETA.LE.0.0)THEN
21655        WRITE(ICOUT,25)
21656   25   FORMAT('***** ERROR--THE THIRD ARGUMENT TO ',
21657     1         'EWECDF IS NON-POSITIVE')
21658        CALL DPWRST('XXX','BUG ')
21659        WRITE(ICOUT,46)THETA
21660        CALL DPWRST('XXX','BUG ')
21661        GOTO9000
21662      ENDIF
21663C
21664       IF(X.LE.0.0)THEN
21665         CDF=0.0
21666       ELSE
21667         DX=DBLE(X)
21668         DG=DBLE(GAMMA)
21669         DT=DBLE(THETA)
21670         DTERM1=DLOG(1.0D0-DEXP(-(DX**DG)))
21671         DTERM2=DT*DTERM1
21672         DCDF=DEXP(DTERM2)
21673         CDF=REAL(DCDF)
21674      ENDIF
21675C
21676 9000 CONTINUE
21677      MINMAX=MINMSV
21678      RETURN
21679      END
21680      SUBROUTINE EWECHA(X,GAMMA,THETA,MINMAX,HAZ)
21681C
21682C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE HAZARD
21683C              FUNCTION VALUE FOR THE EXPONENTIATED WEIBULL
21684C              DISTRIBUTION WITH SINGLE PRECISION
21685C              TAIL LENGTH PARAMETER = GAMMA, SHAPE PARAMETER THETA.
21686C              FOR MINMAX = 1  (FOR THE DEFAULT MINIMUM)
21687C                 THE EXPONETIATED EXPONENTIATED WEIBULL DISTRIBUTION USED
21688C                 HEREIN IS DEFINED FOR ALL POSITIVE X,
21689C                 AND HAS THE PROBABILITY DENSITY FUNCTION
21690C                 F(X) = (THETA*GAMMA)*(X**(GAMMA-1)) * EXP(-(X**GAMMA))
21691C                        *(1-EXP(-(X**GAMMA))**(THETA-1)
21692C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
21693C                                WHICH THE CUMULATIVE HAZARD
21694C                                FUNCTION IS TO BE EVALUATED.
21695C                                X SHOULD BE NON-NEGATIVE.
21696C                     --GAMMA  = THE SHAPE PARAMETER
21697C                                GAMMA SHOULD BE POSITIVE.
21698C                     --THETA  = THE SINGLE PRECISION VALUE
21699C                                OF THE SECOND SHAPE PARAMETER.
21700C                                THETA SHOULD BE POSITIVE.
21701C                     --MINMAX = THE INTEGER VALUE
21702C                                IDENTIFYING THE
21703C                                CHOSEN EXPONENTIATED WEIBULL DISTRIBUTION.
21704C                                1 = MIN, 2 = MAX.
21705C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION CUMULATIVE HAZARD
21706C                                FUNCTION VALUE.
21707C     OUTPUT--THE SINGLE PRECISION CUMULATIVE HAZARD
21708C             FUNCTION VALUE FOR THE EXPONENTIATED WEIBULL DISTRIBUTION
21709C             WITH TAIL LENGTH PARAMETER GAMMA, SHAPE PARAMETER THETA.
21710C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
21711C     RESTRICTIONS--X SHOULD BE POSITIVE
21712C                 --GAMMA, THETA SHOULD BE POSITIVE.
21713C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
21714C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
21715C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
21716C     LANGUAGE--ANSI FORTRAN (1977)
21717C     REFERENCES--MUDHOLKAR AND SRIVASTAVE, "THE EXPONENTIATED WEIBULL
21718C                 FAMILY: A REANALYSIS OF THE BUS-MOTOR-FAILURE DATA",
21719C                 TECHNOMETRICS, NOVEMBER, 1995, PP436-437.
21720C     WRITTEN BY--JAMES J. FILLIBEN
21721C                 STATISTICAL ENGINEERING DIVISION
21722C                 INFORMATION TECHNOLOGY LABORATORY
21723C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21724C                 GAITHERSBURG, MD 20899
21725C                 PHONE--301-975-2855
21726C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21727C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21728C     LANGUAGE--ANSI FORTRAN (1966)
21729C     VERSION NUMBER--98/5
21730C     ORIGINAL VERSION--MAY       1998.
21731C
21732C---------------------------------------------------------------------
21733C
21734      DOUBLE PRECISION DHAZ
21735      DOUBLE PRECISION DCDF
21736      DOUBLE PRECISION DX
21737      DOUBLE PRECISION DG
21738      DOUBLE PRECISION DT
21739      DOUBLE PRECISION DTERM1, DTERM2
21740C
21741C-----COMMON----------------------------------------------------------
21742C
21743      INCLUDE 'DPCOP2.INC'
21744C
21745C-----START POINT-----------------------------------------------------
21746C
21747C     CHECK THE INPUT ARGUMENTS FOR ERRORS
21748C
21749      HAZ=0.0
21750      MINMSV=MINMAX
21751      MINMAX=1
21752      IF(GAMMA.LE.0.0)THEN
21753        WRITE(ICOUT,15)
21754   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO ',
21755     1         'EWECHA IS NON-POSITIVE')
21756        CALL DPWRST('XXX','BUG ')
21757        WRITE(ICOUT,46)GAMMA
21758   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
21759        CALL DPWRST('XXX','BUG ')
21760        GOTO9000
21761      ELSEIF(THETA.LE.0.0)THEN
21762        WRITE(ICOUT,25)
21763   25   FORMAT('***** ERROR--THE THIRD ARGUMENT TO ',
21764     1         'EWECHA IS NON-POSITIVE')
21765        CALL DPWRST('XXX','BUG ')
21766        WRITE(ICOUT,46)THETA
21767        CALL DPWRST('XXX','BUG ')
21768        GOTO9000
21769      ENDIF
21770C
21771C
21772      IF(X.LE.0.0)THEN
21773        HAZ=0.0
21774      ELSE
21775C
21776        DX=DBLE(X)
21777        DT=DBLE(THETA)
21778        DG=DBLE(GAMMA)
21779        DTERM1=DLOG(1.0D0-DEXP(-(DX**DG)))
21780        DTERM2=DT*DTERM1
21781        DCDF=DEXP(DTERM2)
21782C
21783        DHAZ=-DLOG(1.0D0-DCDF)
21784        HAZ=SNGL(DHAZ)
21785C
21786      ENDIF
21787C
21788 9000 CONTINUE
21789      MINMAX=MINMSV
21790      RETURN
21791      END
21792      SUBROUTINE EWEHAZ(X,GAMMA,THETA,MINMAX,HAZ)
21793C
21794C     PURPOSE--THIS SUBROUTINE COMPUTES THE HAZARD
21795C              FUNCTION VALUE FOR THE EXPONENTIATED WEIBULL
21796C              DISTRIBUTION WITH SINGLE PRECISION
21797C              TAIL LENGTH PARAMETER = GAMMA, SHAPE PARAMETER THETA.
21798C              FOR MINMAX = 1  (FOR THE DEFAULT MINIMUM)
21799C                 THE EXPONETIATED EXPONENTIATED WEIBULL DISTRIBUTION USED
21800C                 HEREIN IS DEFINED FOR ALL POSITIVE X,
21801C                 AND HAS THE PROBABILITY DENSITY FUNCTION
21802C                 F(X) = (THETA*GAMMA)*(X**(GAMMA-1)) * EXP(-(X**GAMMA))
21803C                        *(1-EXP(-(X**GAMMA))**(THETA-1)
21804C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
21805C                                WHICH THE CUMULATIVE DISTRIBUTION
21806C                                FUNCTION IS TO BE EVALUATED.
21807C                                X SHOULD BE NON-NEGATIVE.
21808C                     --GAMMA  = THE SHAPE PARAMETER
21809C                                GAMMA SHOULD BE POSITIVE.
21810C                     --THETA  = THE SINGLE PRECISION VALUE
21811C                                OF THE SECOND SHAPE PARAMETER.
21812C                                THETA SHOULD BE POSITIVE.
21813C                     --MINMAX = THE INTEGER VALUE
21814C                                IDENTIFYING THE
21815C                                CHOSEN EXPONENTIATED WEIBULL DISTRIBUTION.
21816C                                1 = MIN, 2 = MAX.
21817C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION HAZARD FUNCTION
21818C                                VALUE.
21819C     OUTPUT--THE SINGLE PRECISION HAZARD
21820C             FUNCTION VALUE FOR THE EXPONENTIATED WEIBULL DISTRIBUTION
21821C             WITH TAIL LENGTH PARAMETER GAMMA, SHAPE PARAMETER THETA.
21822C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
21823C     RESTRICTIONS--X SHOULD BE POSITIVE
21824C                 --GAMMA, THETA SHOULD BE POSITIVE.
21825C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
21826C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
21827C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
21828C     LANGUAGE--ANSI FORTRAN (1977)
21829C     REFERENCES--MUDHOLKAR AND SRIVASTAVE, "THE EXPONENTIATED WEIBULL
21830C                 FAMILY: A REANALYSIS OF THE BUS-MOTOR-FAILURE DATA",
21831C                 TECHNOMETRICS, NOVEMBER, 1995, PP436-437.
21832C     WRITTEN BY--ALAN HECKERT
21833C                 STATISTICAL ENGINEERING DIVISION
21834C                 INFORMATION TECHNOLOGY LABORATORY
21835C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21836C                 GAITHERSBURG, MD 20899
21837C                 PHONE--301-975-2899
21838C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21839C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21840C     LANGUAGE--ANSI FORTRAN (1966)
21841C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
21842C                          DENOTED BY QUOTES RATHER THAN NH.
21843C     VERSION NUMBER--98/5
21844C     ORIGINAL VERSION--MAY       1998.
21845C
21846C---------------------------------------------------------------------
21847C
21848      DOUBLE PRECISION DHAZ
21849      DOUBLE PRECISION DX
21850      DOUBLE PRECISION DG
21851      DOUBLE PRECISION DT
21852      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4, DTERM5
21853      DOUBLE PRECISION DTERM6, DTERM7
21854C
21855C-----COMMON----------------------------------------------------------
21856C
21857      INCLUDE 'DPCOP2.INC'
21858C
21859C-----START POINT-----------------------------------------------------
21860C
21861C     CHECK THE INPUT ARGUMENTS FOR ERRORS
21862C
21863      MINMSV=MINMAX
21864      MINMAX=1
21865      IF(GAMMA.LE.0.0)THEN
21866        WRITE(ICOUT,15)
21867   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO ',
21868     1         'EWEHAZ IS NON-POSITIVE')
21869        CALL DPWRST('XXX','BUG ')
21870        WRITE(ICOUT,46)GAMMA
21871   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
21872        CALL DPWRST('XXX','BUG ')
21873        HAZ=0.0
21874        GOTO9000
21875      ENDIF
21876      IF(THETA.LE.0.0)THEN
21877        WRITE(ICOUT,25)
21878   25   FORMAT('***** ERROR--THE THIRD ARGUMENT TO ',
21879     1         'EWEHAZ IS NON-POSITIVE')
21880        CALL DPWRST('XXX','BUG ')
21881        WRITE(ICOUT,46)THETA
21882        CALL DPWRST('XXX','BUG ')
21883        HAZ=0.0
21884        GOTO9000
21885      ENDIF
21886C
21887      IF(X.LE.0.0)THEN
21888        HAZ=0.0
21889      ELSE
21890        DX=DBLE(X)
21891        DT=DBLE(THETA)
21892        DG=DBLE(GAMMA)
21893C
21894        DTERM7=DEXP(-(DX**DG))
21895        DTERM1=DLOG(DG) + DLOG(DT)
21896        DTERM2=(DT-1.0D0)*DLOG(1.0D0-DTERM7)
21897        DTERM3=-(DX**DG)
21898        DTERM4=(DG-1.0D0)*DLOG(DX)
21899        DTERM5=DLOG(1.0D0 - (1.0D0 - DTERM7)**DT)
21900        DTERM6=DTERM1+DTERM2+DTERM3+DTERM4-DTERM5
21901        DHAZ=DEXP(DTERM6)
21902        HAZ=REAL(DHAZ)
21903C
21904      ENDIF
21905C
21906 9000 CONTINUE
21907      MINMAX=MINMSV
21908      RETURN
21909      END
21910      SUBROUTINE EWEPDF(X,GAMMA,THETA,MINMAX,PDF)
21911C
21912C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
21913C              FUNCTION VALUE FOR THE EXPONENTIATED WEIBULL
21914C              DISTRIBUTION WITH SINGLE PRECISION
21915C              TAIL LENGTH PARAMETER = GAMMA, SHAPE PARAMETER THETA.
21916C              THERE ARE 2 SUCH EXPONETIATED WEIBULL FAMILIES--
21917C                 ONE FOR THE MIN ORDER STAT (THE USUAL) AND
21918C                 ONE FOR THE MAX ORDER STAT.
21919C              (SEE SARHAN & GREENBERG, PAGE 69)
21920C              THE EXPONETIATED WEIBULL TYPE IS SPECIFIED VIA   MINMAX
21921C              FOR MINMAX = 1  (FOR THE DEFAULT MINIMUM)
21922C                 THE EXPONETIATED EXPONENTIATED WEIBULL DISTRIBUTION USED
21923C                 HEREIN IS DEFINED FOR ALL POSITIVE X,
21924C                 AND HAS THE PROBABILITY DENSITY FUNCTION
21925C                 F(X) = (THETA*GAMMA)*(X**(GAMMA-1)) * EXP(-(X**GAMMA))
21926C                        *(1-EXP(-(X**GAMMA))**(THETA-1)
21927C              FOR MINMAX = 2 (FOR THE MAXIMUM),
21928C                 THE EXPONETIATED EXPONENTIATED WEIBULL DISTRIBUTION USED
21929C                 HEREIN IS DEFINED FOR ALL NEGATIVE X,
21930C                 AND HAS THE PROBABILITY DENSITY FUNCTION
21931C                 F(X) = ...
21932C                 F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)).
21933C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
21934C                                WHICH THE CUMULATIVE DISTRIBUTION
21935C                                FUNCTION IS TO BE EVALUATED.
21936C                                X SHOULD BE NON-NEGATIVE.
21937C                     --GAMMA  = THE SHAPE PARAMETER
21938C                                GAMMA SHOULD BE POSITIVE.
21939C                     --THETA  = THE SINGLE PRECISION VALUE
21940C                                OF THE SECOND SHAPE PARAMETER.
21941C                                THETA SHOULD BE POSITIVE.
21942C                     --MINMAX = THE INTEGER VALUE
21943C                                IDENTIFYING THE
21944C                                CHOSEN EXPONENTIATED WEIBULL DISTRIBUTION.
21945C                                1 = MIN, 2 = MAX.
21946C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
21947C                                DENSITY FUNCTION VALUE.
21948C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
21949C             FUNCTION VALUE FOR THE EXPONENTIATED WEIBULL DISTRIBUTION
21950C             WITH TAIL LENGHT PARAMETER = GAMMA.
21951C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
21952C     RESTRICTIONS--X SHOULD BE POSITIVE.
21953C                 --GAMMA SHOULD BE POSITIVE.
21954C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
21955C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
21956C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
21957C     LANGUAGE--ANSI FORTRAN (1977)
21958C     REFERENCES--SARHAN & GREENBERG,
21959C                 CONTRIBUTIONS TO ORDER STATISTICS,
21960C                 1962, WILEY, PAGE 69.
21961C               --MUDHOLKAR AND SRIVASTAVE, "THE EXPONENTIATED WEIBULL
21962C                 FAMILY: A REANALYSIS OF THE BUS-MOTOR-FAILURE DATA",
21963C                 TECHNOMETRICS, NOVEMBER, 1995, PP436-437.
21964C     WRITTEN BY--ALAN HECKERT
21965C                 STATISTICAL ENGINEERING DIVISION
21966C                 INFORMATION TECHNOLOGY LABORATORY
21967C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21968C                 GAITHERSBURG, MD 20899
21969C                 PHONE--301-975-2899
21970C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21971C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21972C     LANGUAGE--ANSI FORTRAN (1966)
21973C     VERSION NUMBER--95/10
21974C     ORIGINAL VERSION--OCTOBER   1995.
21975C
21976C---------------------------------------------------------------------
21977C
21978      DOUBLE PRECISION DPDF
21979      DOUBLE PRECISION DX
21980      DOUBLE PRECISION DG
21981      DOUBLE PRECISION DT
21982      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4, DTERM5
21983C
21984C-----COMMON----------------------------------------------------------
21985C
21986      INCLUDE 'DPCOP2.INC'
21987C
21988C-----START POINT-----------------------------------------------------
21989C
21990C     CHECK THE INPUT ARGUMENTS FOR ERRORS
21991C
21992      MINMSV=MINMAX
21993      MINMAX=1
21994      PDF=0.0
21995      IF(GAMMA.LE.0.0)THEN
21996        WRITE(ICOUT,15)
21997   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO ',
21998     1         'EWEPDF IS NON-POSITIVE')
21999        CALL DPWRST('XXX','BUG ')
22000        WRITE(ICOUT,46)GAMMA
22001   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
22002        CALL DPWRST('XXX','BUG ')
22003        GOTO9000
22004      ELSEIF(THETA.LE.0.0)THEN
22005        WRITE(ICOUT,25)
22006   25   FORMAT('***** ERROR--THE THIRD ARGUMENT TO ',
22007     1         'EWEPDF IS NON-POSITIVE')
22008        CALL DPWRST('XXX','BUG ')
22009        WRITE(ICOUT,46)THETA
22010        CALL DPWRST('XXX','BUG ')
22011        GOTO9000
22012      ENDIF
22013C
22014       IF(X.LE.0.0)THEN
22015         PDF=0.0
22016       ELSE
22017         DX=DBLE(X)
22018         IF(DX.LT.0.0000001D0)DX=0.0000001D0
22019         DG=DBLE(GAMMA)
22020         DT=DBLE(THETA)
22021         DTERM1=DLOG(DG) + DLOG(DT)
22022         DTERM2=(DT-1.0D0)*DLOG(1.0D0-DEXP(-(DX**DG)))
22023         DTERM3=-(DX**DG)
22024         DTERM4=(DG-1.0D0)*DLOG(DX)
22025         DTERM5=DTERM1+DTERM2+DTERM3+DTERM4
22026         DPDF=DEXP(DTERM5)
22027         PDF=REAL(DPDF)
22028      ENDIF
22029C
22030 9000 CONTINUE
22031      MINMAX=MINMSV
22032      RETURN
22033      END
22034      SUBROUTINE EWEPPF(P,GAMMA,THETA,MINMAX,PPF)
22035C
22036C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
22037C              FUNCTION VALUE FOR THE EXPONETIATED WEIBULL
22038C              DISTRIBUTION WITH SINGLE PRECISION
22039C              TAIL LENGTH PARAMETER = GAMMA, SHAPE PARAMETER THETA.
22040C              THERE ARE 2 SUCH EXPONETIATED WEIBULL FAMILIES--
22041C                 ONE FOR THE MIN ORDER STAT (THE USUAL) AND
22042C                 ONE FOR THE MAX ORDER STAT.
22043C              (SEE SARHAN & GREENBERG, PAGE 69)
22044C              THE EXPONETIATED WEIBULL TYPE IS SPECIFIED VIA   MINMAX
22045C              FOR MINMAX = 1  (FOR THE DEFAULT MINIMUM)
22046C                 THE EXPONETIATED WEIBULL DISTRIBUTION USED
22047C                 HEREIN IS DEFINED FOR ALL POSITIVE X,
22048C                 AND HAS THE PROBABILITY DENSITY FUNCTION
22049C                 F(X) = (THETA*GAMMA)*(X**(GAMMA-1)) * EXP(-(X**GAMMA))
22050C                        *(1-EXP(-(X**GAMMA))**(THETA-1)
22051C              FOR MINMAX = 2 (FOR THE MAXIMUM),
22052C                 THE EXPONETIATED WEIBULL DISTRIBUTION USED
22053C                 HEREIN IS DEFINED FOR ALL NEGATIVE X,
22054C                 AND HAS THE PROBABILITY DENSITY FUNCTION
22055C                 F(X) = ...
22056C              NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION
22057C              IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE
22058C              DISTRIBUTION FUNCTION OF THE DISTRIBUTION.
22059C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
22060C                                (BETWEEN 0.0 (INCLUSIVELY)
22061C                                AND 1.0 (EXCLUSIVELY))
22062C                                AT WHICH THE PERCENT POINT
22063C                                FUNCTION IS TO BE EVALUATED.
22064C                     --GAMMA  = THE SINGLE PRECISION VALUE
22065C                                OF THE TAIL LENGTH PARAMETER.
22066C                                GAMMA SHOULD BE POSITIVE.
22067C                     --THETA  = THE SINGLE PRECISION VALUE
22068C                                OF THE SECOND SHAPE PARAMETER.
22069C                                THETA SHOULD BE POSITIVE.
22070C                     --MINMAX = THE INTEGER VALUE
22071C                                IDENTIFYING THE
22072C                                CHOSEN EXPONETIATED WEIBULL DISTRIBUTION.
22073C                                1 = MIN, 2 = MAX.
22074C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
22075C                                POINT FUNCTION VALUE.
22076C     OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION .
22077C             VALUE PPF FOR THE EXPONETIATED WEIBULL DISTRIBUTION
22078C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
22079C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
22080C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
22081C                 --P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
22082C                   AND 1.0 (EXCLUSIVELY).
22083C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
22084C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG.
22085C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
22086C     LANGUAGE--ANSI FORTRAN (1977)
22087C     REFERENCES--SARHAN & GREENBERG,
22088C                 CONTRIBUTIONS TO ORDER STATISTICS,
22089C               --MUDHOLKAR AND SRIVASTAVE, "THE EXPONENTIATED WEIBULL
22090C                 FAMILY: A REANALYSIS OF THE BUS-MOTOR-FAILURE DATA",
22091C                 TECHNOMETRICS, NOVEMBER, 1995, PP436-437.
22092C     WRITTEN BY--ALAN HECKERT
22093C                 STATISTICAL ENGINEERING DIVISION
22094C                 INFORMATION TECHNOLOGY LABORATORY
22095C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22096C                 GAITHERSBURG, MD 20899
22097C                 PHONE--301-975-2899
22098C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22099C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22100C     LANGUAGE--ANSI FORTRAN (1966)
22101C     VERSION NUMBER--95/10
22102C     ORIGINAL VERSION--OCTOBER   1995.
22103C
22104C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22105C
22106C---------------------------------------------------------------------
22107C
22108      DOUBLE PRECISION DP
22109      DOUBLE PRECISION DG
22110      DOUBLE PRECISION DT
22111      DOUBLE PRECISION DPPF
22112      DOUBLE PRECISION DTERM1
22113C
22114      INCLUDE 'DPCOP2.INC'
22115C
22116C-----START POINT-----------------------------------------------------
22117C
22118C     CHECK THE INPUT ARGUMENTS FOR ERRORS
22119C
22120      MINMSV=MINMAX
22121      MINMAX=1
22122      PPF=0.0
22123      IF(P.LT.0.0.OR.P.GE.1.0)THEN
22124        WRITE(ICOUT,1)
22125    1   FORMAT('***** ERROR--THE FIRST ARGUMENT TO ',
22126     1         'EWEPPF IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL')
22127        CALL DPWRST('XXX','BUG ')
22128        WRITE(ICOUT,46)P
22129        CALL DPWRST('XXX','BUG ')
22130        GOTO9000
22131      ELSEIF(GAMMA.LE.0.0)THEN
22132        WRITE(ICOUT,15)
22133   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO ',
22134     1         'EWEPPF IS NON-POSITIVE')
22135        CALL DPWRST('XXX','BUG ')
22136        WRITE(ICOUT,46)GAMMA
22137   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
22138        CALL DPWRST('XXX','BUG ')
22139        GOTO9000
22140      ELSEIF(THETA.LE.0.0)THEN
22141        WRITE(ICOUT,25)
22142   25   FORMAT('***** ERROR--THE THIRD ARGUMENT TO ',
22143     1         'EWEPPF IS NON-POSITIVE')
22144        CALL DPWRST('XXX','BUG ')
22145        WRITE(ICOUT,46)THETA
22146        CALL DPWRST('XXX','BUG ')
22147        GOTO9000
22148      ENDIF
22149C
22150C
22151       IF(P.EQ.0.0)THEN
22152         PPF=0.0
22153       ELSE
22154         DP=DBLE(P)
22155         DG=DBLE(1.0/GAMMA)
22156         DT=DBLE(1.0/THETA)
22157         DTERM1=DG*DLOG(-DLOG(1.0D0-DP**DT))
22158         DPPF=DEXP(DTERM1)
22159         PPF=REAL(DPPF)
22160      ENDIF
22161C
22162 9000 CONTINUE
22163      MINMAX=MINMSV
22164      RETURN
22165      END
22166      SUBROUTINE EEWRAN(N,AL,GAMMA1,SCALE1,GAMMA2,SCALE2,ISEED,X)
22167C
22168C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
22169C              FROM THE END EFFECTS WEIBULL DISTRIBUTION.
22170C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
22171C                                OF RANDOM NUMBERS TO BE
22172C                                GENERATED.
22173C                     --AL     = THE SINGLE PRECISION VALUE OF THE
22174C                                FIBER LENGTH PARAMETER
22175C                     --GAMMA1 = THE SINGLE PRECISION VALUE OF THE
22176C                                SHAPE (1) PARAMETER.
22177C                     --SCALE1 = THE SINGLE PRECISION VALUE OF THE
22178C                                SCALE (1) PARAMETER.
22179C                     --GAMMA2 = THE SINGLE PRECISION VALUE OF THE
22180C                                SHAPE (2) PARAMETER.
22181C                     --SCALE2 = THE SINGLE PRECISION VALUE OF THE
22182C                                SCALE (2) PARAMETER.
22183C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
22184C                                (OF DIMENSION AT LEAST N)
22185C                                INTO WHICH THE GENERATED
22186C                                RANDOM SAMPLE WILL BE PLACED.
22187C     OUTPUT--A RANDOM SAMPLE OF SIZE N
22188C             FROM THE END EFFECTS WEIBULL DISTRIBUTION.
22189C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
22190C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
22191C                   OF N FOR THIS SUBROUTINE.
22192C                 --SHAPE PARAMETERS SHOULD BE POSITIVE.
22193C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
22194C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
22195C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
22196C     LANGUAGE--ANSI FORTRAN (1977)
22197C     WRITTEN BY--ALAN HECKERT
22198C                 STATISTICAL ENGINEERING DIVISION
22199C                 INFORMATION TECHNOLOGY LABORATORY
22200C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22201C                 GAITHERSBURG, MD 20899-8980
22202C                 PHONE--301-975-2899
22203C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22204C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22205C     LANGUAGE--ANSI FORTRAN (1977)
22206C     VERSION NUMBER--2010.7
22207C     ORIGINAL VERSION--JULY      2010.
22208C
22209C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22210C
22211C---------------------------------------------------------------------
22212C
22213      DIMENSION X(*)
22214      DOUBLE PRECISION DTEMP
22215C
22216C-----COMMON----------------------------------------------------------
22217C
22218      INCLUDE 'DPCOP2.INC'
22219C
22220C-----START POINT-----------------------------------------------------
22221C
22222C     CHECK THE INPUT ARGUMENTS FOR ERRORS
22223C
22224      IF(N.LT.1)THEN
22225        WRITE(ICOUT,55)
22226   55   FORMAT('***** ERROR--THE REQUESTED NUMBER OF END EFFECTS ',
22227     1         'WEIBULL RANDOM NUMBERS IS NON-POSITIVE.')
22228        CALL DPWRST('XXX','BUG ')
22229        WRITE(ICOUT,47)N
22230   47   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
22231        CALL DPWRST('XXX','BUG ')
22232        GOTO9000
22233      ELSEIF(SCALE1.LE.0.0D0)THEN
22234        WRITE(ICOUT,5)
22235    5   FORMAT('***** ERROR--THE SCALE1 PARAMETER FOR THE END ',
22236     1         'EFFECTS WEIBULL RANDOM NUMBERSIS NON-POSITIVE')
22237        CALL DPWRST('XXX','BUG ')
22238        WRITE(ICOUT,46)SCALE1
22239   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
22240        CALL DPWRST('XXX','BUG ')
22241        GOTO9000
22242      ELSEIF(GAMMA1.LE.0.0D0)THEN
22243        WRITE(ICOUT,15)
22244   15   FORMAT('***** ERROR--THE GAMMA1 PARAMETER FOR THE END ',
22245     1         'EFFECTS WEIBULL RANDOM NUMBERSIS NON-POSITIVE')
22246        CALL DPWRST('XXX','BUG ')
22247        WRITE(ICOUT,46)GAMMA1
22248        CALL DPWRST('XXX','BUG ')
22249        GOTO9000
22250      ELSEIF(SCALE2.LE.0.0D0)THEN
22251        WRITE(ICOUT,25)
22252   25   FORMAT('***** ERROR--THE SCALE2 PARAMETER FOR THE END ',
22253     1         'EFFECTS WEIBULL RANDOM NUMBERSIS NON-POSITIVE')
22254        CALL DPWRST('XXX','BUG ')
22255        WRITE(ICOUT,46)SCALE2
22256        CALL DPWRST('XXX','BUG ')
22257        GOTO9000
22258      ELSEIF(GAMMA2.LE.0.0D0)THEN
22259        WRITE(ICOUT,35)
22260   35   FORMAT('***** ERROR--THE GAMMA2 PARAMETER FOR THE END ',
22261     1         'EFFECTS WEIBULL RANDOM NUMBERSIS NON-POSITIVE')
22262        CALL DPWRST('XXX','BUG ')
22263        WRITE(ICOUT,46)GAMMA2
22264        CALL DPWRST('XXX','BUG ')
22265        GOTO9000
22266      ELSEIF(AL.LE.0.0D0)THEN
22267        WRITE(ICOUT,45)
22268   45   FORMAT('***** ERROR--THE L PARAMETER FOR THE END ',
22269     1         'EFFECTS WEIBULL RANDOM NUMBERSIS NON-POSITIVE')
22270        CALL DPWRST('XXX','BUG ')
22271        WRITE(ICOUT,46)AL
22272        CALL DPWRST('XXX','BUG ')
22273        GOTO9000
22274      ENDIF
22275C
22276C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
22277C
22278      CALL UNIRAN(N,ISEED,X)
22279C
22280C     GENERATE N END EFFECTS WEIBULL DISTRIBUTION RANDOM
22281C     NUMBERS USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
22282C
22283      DO100I=1,N
22284        CALL EEWPPF(DBLE(X(I)),DBLE(AL),DBLE(GAMMA1),DBLE(SCALE1),
22285     1              DBLE(GAMMA2),DBLE(SCALE2),DTEMP)
22286        X(I)=REAL(DTEMP)
22287  100 CONTINUE
22288C
22289 9000 CONTINUE
22290      RETURN
22291      END
22292      SUBROUTINE EWERAN(N,GAMMA,THETA,ISEED,X)
22293C
22294C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
22295C              FROM THE EXPONENTIATED WEIBULL DISTRIBUTION
22296C              WITH SHAPE PARAMETER VALUES = GAMMA, THETA.
22297C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
22298C                                OF RANDOM NUMBERS TO BE
22299C                                GENERATED.
22300C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
22301C                                FIRST SHAPE PARAMETER.
22302C                                GAMMA SHOULD BE POSITIVE.
22303C                     --THETA  = THE SINGLE PRECISION VALUE OF THE
22304C                                SECOND SHAPE PARAMETER.
22305C                                THETA SHOULD BE POSITIVE.
22306C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
22307C                                (OF DIMENSION AT LEAST N)
22308C                                INTO WHICH THE GENERATED
22309C                                RANDOM SAMPLE WILL BE PLACED.
22310C     OUTPUT--A RANDOM SAMPLE OF SIZE N
22311C             FROM THE EXPONENTIATED WEIBULL DISTRIBUTION
22312C             WITH SHAPE PARAMETER VALUES = GAMMA AND THETA.
22313C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
22314C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
22315C                   OF N FOR THIS SUBROUTINE.
22316C                 --GAMMA SHOULD BE POSITIVE.
22317C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
22318C     FORTRAN LIBRARY SUBROUTINES NEEDED--NON E.
22319C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
22320C     LANGUAGE--ANSI FORTRAN (1977)
22321C     WRITTEN BY--JAMES J. FILLIBEN
22322C                 STATISTICAL ENGINEERING DIVISION
22323C                 INFORMATION TECHNOLOGY LABORATORY
22324C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22325C                 GAITHERSBURG, MD 20899
22326C                 PHONE--301-975-2855
22327C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22328C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22329C     LANGUAGE--ANSI FORTRAN (1966)
22330C     VERSION NUMBER--2001.9
22331C     ORIGINAL VERSION--SEPTEMBER 2001.
22332C
22333C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22334C
22335C---------------------------------------------------------------------
22336C
22337      DIMENSION X(*)
22338C
22339C-----COMMON----------------------------------------------------------
22340C
22341      INCLUDE 'DPCOP2.INC'
22342C
22343C-----START POINT-----------------------------------------------------
22344C
22345C     CHECK THE INPUT ARGUMENTS FOR ERRORS
22346C
22347      IF(N.LT.1)THEN
22348        WRITE(ICOUT, 5)
22349        CALL DPWRST('XXX','BUG ')
22350        WRITE(ICOUT,47)N
22351        CALL DPWRST('XXX','BUG ')
22352        GOTO9000
22353      ENDIF
22354    5 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ',
22355     1'EWERAN SUBROUTINE IS NON-POSITIVE *****')
22356   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
22357C
22358C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
22359C
22360      CALL UNIRAN(N,ISEED,X)
22361C
22362C     GENERATE N EXPONENTIATED WEIBULL DISTRIBUTION RANDOM NUMBERS
22363C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
22364C
22365      MINMAX=1
22366      DO100I=1,N
22367        CALL EWEPPF(X(I),GAMMA,THETA,MINMAX,XTEMP)
22368        X(I)=XTEMP
22369  100 CONTINUE
22370C
22371 9000 CONTINUE
22372      RETURN
22373      END
22374      DOUBLE PRECISION FUNCTION EXP3(XVALUE)
22375C
22376C   DESCRIPTION
22377C
22378C      This function calculates
22379C
22380C           EXP3(X) = integral 0 to X  (exp(-t*t*t)) dt
22381C
22382C      The code uses Chebyshev expansions, whose coefficients are
22383C      given to 20 decimal places.
22384C
22385C
22386C   ERROR RETURNS
22387C
22388C      If XVALUE < 0, an error message is printed and the function
22389C      returns the value 0.
22390C
22391C
22392C   MACHINE-DEPENDENT CONSTANTS
22393C
22394C      NTERM1 - INTEGER - The no. of terms of the array AEXP3,
22395C                         The recommended value is such that
22396C                               AEXP3(NTERM1) < EPS/100.
22397C
22398C      NTERM2 - INTEGER - The no. of terms of the array AEXP3A.
22399C                         The recommended value is such that
22400C                               AEXP3A(NTERM2) < EPS/100.
22401C
22402C      XLOW - DOUBLE PRECISION - The value below which EXP3(X) = X to machine
22403C                    precision. The recommended value is
22404C                          cube root(4*EPSNEG)
22405C
22406C      XUPPER - DOUBLE PRECISION - The value above which EXP3(X) = 0.89297...
22407C                      to machine precision. The recommended value is
22408C                           cube root(-ln(EPSNEG))
22409C
22410C      For values of EPS and EPSNEG for various machine/compiler
22411C      combinations refer to the file MACHCON.TXT.
22412C
22413C      The machine-dependent constants are computed internally by
22414C      using the D1MACH subroutine.
22415C
22416C
22417C   INTRINSIC FUNCTIONS USED
22418C
22419C      EXP, LOG
22420C
22421C
22422C   OTHER MISCFUN SUBROUTINES USED:
22423C
22424C          CHEVAL , ERRPRN, D1MACH
22425C
22426C
22427C   AUTHOR
22428C
22429C      DR. ALLAN J. MACLEOD,
22430C      DEPARTMENT OF MATHEMATICS AND STATISTICS,
22431C      UNIVERSITY OF PAISLEY,
22432C      HIGH ST.,
22433C      PAISLEY
22434C      SCOTLAND.
22435C
22436C      (e-mail  macl_ms0@paisley.ac.uk )
22437C
22438C
22439C   LATEST MODIFICATION:  23 January, 1996
22440C
22441C
22442      INTEGER NTERM1,NTERM2
22443      DOUBLE PRECISION AEXP3(0:24),AEXP3A(0:24),CHEVAL,
22444     1      FOUR,FUNINF,HALF,ONE,ONEHUN,SIXTEN,T,THREE,
22445     2      TWO,X,XLOW,XUPPER,XVALUE,ZERO
22446CCCCC CHARACTER FNNAME*6,ERRMSG*14
22447C
22448C-----COMMON----------------------------------------------------------
22449C
22450      INCLUDE 'DPCOMC.INC'
22451      INCLUDE 'DPCOP2.INC'
22452C
22453CCCCC DATA FNNAME/'EXP3  '/
22454CCCCC DATA ERRMSG/'ARGUMENT < 0.0'/
22455      DATA ZERO,HALF,ONE/0.0 D 0 , 0.5 D 0 , 1.0 D 0/
22456      DATA TWO,THREE,FOUR/2.0 D 0 , 3.0 D 0 , 4.0 D 0 /
22457      DATA SIXTEN,ONEHUN/16.0 D 0 , 100.0 D 0/
22458      DATA FUNINF/0.89297 95115 69249 21122 D 0/
22459      DATA AEXP3(0)/  1.26919 84142 21126 01434  D    0/
22460      DATA AEXP3(1)/ -0.24884 64463 84140 98226  D    0/
22461      DATA AEXP3(2)/  0.80526 22071 72310 4125   D   -1/
22462      DATA AEXP3(3)/ -0.25772 73325 19683 2934   D   -1/
22463      DATA AEXP3(4)/  0.75998 78873 07377 429    D   -2/
22464      DATA AEXP3(5)/ -0.20306 95581 94040 510    D   -2/
22465      DATA AEXP3(6)/  0.49083 45866 99329 17     D   -3/
22466      DATA AEXP3(7)/ -0.10768 22391 42020 77     D   -3/
22467      DATA AEXP3(8)/  0.21551 72626 42898 4      D   -4/
22468      DATA AEXP3(9)/ -0.39567 05137 38429        D   -5/
22469      DATA AEXP3(10)/ 0.66992 40933 8956         D   -6/
22470      DATA AEXP3(11)/-0.10513 21808 0703         D   -6/
22471      DATA AEXP3(12)/ 0.15362 58019 825          D   -7/
22472      DATA AEXP3(13)/-0.20990 96036 36           D   -8/
22473      DATA AEXP3(14)/ 0.26921 09538 1            D   -9/
22474      DATA AEXP3(15)/-0.32519 52422              D  -10/
22475      DATA AEXP3(16)/ 0.37114 8157               D  -11/
22476      DATA AEXP3(17)/-0.40136 518                D  -12/
22477      DATA AEXP3(18)/ 0.41233 46                 D  -13/
22478      DATA AEXP3(19)/-0.40337 5                  D  -14/
22479      DATA AEXP3(20)/ 0.37658                    D  -15/
22480      DATA AEXP3(21)/-0.3362                     D  -16/
22481      DATA AEXP3(22)/ 0.288                      D  -17/
22482      DATA AEXP3(23)/-0.24                       D  -18/
22483      DATA AEXP3(24)/ 0.2                        D  -19/
22484      DATA AEXP3A(0)/  1.92704 64955 06827 37293  D    0/
22485      DATA AEXP3A(1)/ -0.34929 35652 04813 8054   D   -1/
22486      DATA AEXP3A(2)/  0.14503 38371 89830 093    D   -2/
22487      DATA AEXP3A(3)/ -0.89253 36718 32790 3      D   -4/
22488      DATA AEXP3A(4)/  0.70542 39219 11838        D   -5/
22489      DATA AEXP3A(5)/ -0.66717 27454 7611         D   -6/
22490      DATA AEXP3A(6)/  0.72426 75899 824          D   -7/
22491      DATA AEXP3A(7)/ -0.87825 82560 56           D   -8/
22492      DATA AEXP3A(8)/  0.11672 23442 78           D   -8/
22493      DATA AEXP3A(9)/ -0.16766 31281 2            D   -9/
22494      DATA AEXP3A(10)/ 0.25755 01577              D  -10/
22495      DATA AEXP3A(11)/-0.41957 8881               D  -11/
22496      DATA AEXP3A(12)/ 0.72010 412                D  -12/
22497      DATA AEXP3A(13)/-0.12949 055                D  -12/
22498      DATA AEXP3A(14)/ 0.24287 03                 D  -13/
22499      DATA AEXP3A(15)/-0.47331 1                  D  -14/
22500      DATA AEXP3A(16)/ 0.95531                    D  -15/
22501      DATA AEXP3A(17)/-0.19914                    D  -15/
22502      DATA AEXP3A(18)/ 0.4277                     D  -16/
22503      DATA AEXP3A(19)/-0.944                      D  -17/
22504      DATA AEXP3A(20)/ 0.214                      D  -17/
22505      DATA AEXP3A(21)/-0.50                       D  -18/
22506      DATA AEXP3A(22)/ 0.12                       D  -18/
22507      DATA AEXP3A(23)/-0.3                        D  -19/
22508      DATA AEXP3A(24)/ 0.1                        D  -19/
22509C
22510C   Start calculation
22511C
22512      X = XVALUE
22513C
22514C   Error test
22515C
22516      IF ( X .LT. ZERO ) THEN
22517CCCCC    CALL ERRPRN(FNNAME,ERRMSG)
22518         WRITE(ICOUT,999)
22519         CALL DPWRST('XXX','BUG ')
22520         WRITE(ICOUT,101)X
22521         CALL DPWRST('XXX','BUG ')
22522         EXP3 = ZERO
22523         RETURN
22524      ENDIF
22525  999 FORMAT(1X)
22526  101 FORMAT('***** ERROR FROM EXP3--ARGUMENT MUST BE ',
22527     1       'NON-NEGATIVE, ARGUMENT = ',G15.7)
22528C
22529C   Compute the machine-dependent constants.
22530C
22531      T = D1MACH(3)
22532      XLOW = ( FOUR * T ) ** (ONE/THREE)
22533      XUPPER = ( -LOG ( T ) ) ** (ONE/THREE)
22534      T = T / ONEHUN
22535      IF ( X .LE. TWO ) THEN
22536         DO 10 NTERM1 = 24 , 0 , -1
22537            IF ( ABS(AEXP3(NTERM1)) .GT. T ) GOTO 19
22538 10      CONTINUE
22539 19      CONTINUE
22540      ELSE
22541         DO 40 NTERM2 = 24 , 0 , -1
22542            IF ( ABS(AEXP3A(NTERM2)) .GT. T ) GOTO 49
22543 40      CONTINUE
22544 49      CONTINUE
22545      ENDIF
22546C
22547C   Code for XVALUE < =  2
22548C
22549      IF ( X .LE. TWO ) THEN
22550         IF ( X .LT. XLOW ) THEN
22551            EXP3 = X
22552         ELSE
22553            T =  (  ( X * X * X / FOUR ) - HALF ) - HALF
22554            EXP3 = X * CHEVAL ( NTERM1,AEXP3,T )
22555         ENDIF
22556      ELSE
22557C
22558C   Code for XVALUE > 2
22559C
22560         IF ( X .GT. XUPPER ) THEN
22561            EXP3 = FUNINF
22562         ELSE
22563            T = ( ( SIXTEN/ ( X * X * X ) ) - HALF ) - HALF
22564            T = CHEVAL ( NTERM2,AEXP3A,T )
22565            T = T * EXP ( -X * X * X ) / ( THREE * X * X )
22566            EXP3 = FUNINF - T
22567         ENDIF
22568      ENDIF
22569      RETURN
22570      END
22571      SUBROUTINE EXPLOS(X,N,ENGLSL,ENGUSL,COSUSL,IWRITE,XEL,
22572     1IBUGA3,IERROR)
22573C
22574C     PURPOSE--THIS SUBROUTINE COMPUTES THE
22575C              SAMPLE EXPECTED LOSS FROM THE DATA IN THE INPUT VECTOR X.
22576C              THIS CALCULATION ASSUMES--
22577C                 1) A QUADRATIC LOSS FUNCTION
22578C                 2) A NORMAL DISTRIBUTION
22579C                 3) WITH MEAN XBAR AND STANDARD DEVIATION S
22580C                 4) A DOLLAR COST    COSUSL   AT THE UPPER SPEC LIMIT
22581C                 5) THE TARGET IS MIDWAY BETWEEN ENGUSL AND ENGLSL
22582C              XEL = INTEGRAL K*(X-TARGET)**2 * NORMALPDF(XBAR,S)
22583C              WHERE K IS DERIVED FROM THE LOSS FUNCTION
22584C                 L(X) = K*(X-TARGET)**2
22585C              EVALUATED AT X = USL
22586C                 SOLVING     L(USL) = COSUSL
22587C                             K*(USL-TARGET)**2 = COSUSL
22588C                             K = COSUSL / (USL-TARGET)**2
22589C     THE FINAL FORM FOR XEL IS QUITE SIMPLE--
22590C        XEL = COSUSL * (KSIGMA**2 + KMU**2)
22591C     WHERE KSIGMA IS DEFINED VIA   SIGMA = KSIGMA * H
22592C     AND   KMU    IS DEFINED VIA   MU    = TARGET + KMU*H
22593C     YIELDING KSIGMA = SIGMA / H
22594C     AND      KMU    = (MU - TARGET) / H
22595C     IN PRACTICE, WE USE XBAR FOR MU AND S FOR SIGMA.
22596C     NOTE--XEL IS A MEASURE OF PROCESS COST AND IS
22597C           SENSITIVE TO LOSS FROM BOTH BIAS AND FROM VARIATION.
22598C     NOTE--XEL IS A MEASURE WHICH TAKES ON
22599C           THE VALUES 0 TO INFINITY.
22600C           A GOOD PROCESS YIELDS VALUES OF
22601C           EXPECTED LOSS NEAR 0.
22602C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
22603C                                (UNSORTED OR SORTED) OBSERVATIONS.
22604C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
22605C                                IN THE VECTOR X.
22606C                     --ENGLSL = LOWER (ENGINEERING) SPEC LIMIT
22607C                     --ENGUSL = UPPER (ENGINEERING) SPEC LIMIT
22608C                     --COSUSL = COST AT UPPER SPEC LIMIT
22609C     OUTPUT ARGUMENTS--EXPLOS = THE SINGLE PRECISION VALUE OF THE
22610C                                COMPUTED SAMPLE EXPECTED LOSS
22611C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
22612C             SAMPLE EXPECTED LOSS (IN XEL)
22613C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
22614C                   OF N FOR THIS SUBROUTINE.
22615C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
22616C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT.
22617C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
22618C     LANGUAGE--ANSI FORTRAN (1977)
22619C     REFERENCES--R&M 2000 AIR FORCE MANUAL
22620C     WRITTEN BY--JAMES J. FILLIBEN
22621C                 STATISTICAL ENGINEERING DIVISION
22622C                 INFORMATION TECHNOLOGY LABORATORY
22623C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22624C                 GAITHERSBURG, MD 20899
22625C                 PHONE--301-975-2855
22626C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22627C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22628C     LANGUAGE--ANSI FORTRAN (1977)
22629C     VERSION NUMBER--89.5
22630C     ORIGINAL VERSION--MAY       1989.
22631C     UPDATED         --SEPTEMBER 1990. REVERSE INPUT ARGS
22632C
22633C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22634C
22635      CHARACTER*4 IWRITE
22636      CHARACTER*4 IBUGA3
22637      CHARACTER*4 IERROR
22638C
22639      CHARACTER*4 ISUBN1
22640      CHARACTER*4 ISUBN2
22641C
22642C---------------------------------------------------------------------
22643C
22644      DOUBLE PRECISION DN
22645      DOUBLE PRECISION DX
22646      DOUBLE PRECISION DSUM
22647      DOUBLE PRECISION DMEAN
22648      DOUBLE PRECISION DVAR
22649      DOUBLE PRECISION DSD
22650C
22651      DOUBLE PRECISION DUSL
22652      DOUBLE PRECISION DLSL
22653C
22654      DOUBLE PRECISION DTARG
22655      DOUBLE PRECISION DH
22656      DOUBLE PRECISION DKMU
22657      DOUBLE PRECISION DKSIGM
22658      DOUBLE PRECISION DEL
22659C
22660      DIMENSION X(*)
22661C
22662C-----COMMON----------------------------------------------------------
22663C
22664      INCLUDE 'DPCOP2.INC'
22665C
22666C-----START POINT-----------------------------------------------------
22667C
22668      ISUBN1='EXPL'
22669      ISUBN2='OS  '
22670      IERROR='NO'
22671C
22672      DMEAN=0.0D0
22673C
22674      IF(IBUGA3.EQ.'OFF')GOTO90
22675      WRITE(ICOUT,999)
22676  999 FORMAT(1X)
22677      CALL DPWRST('XXX','BUG ')
22678      WRITE(ICOUT,51)
22679   51 FORMAT('***** AT THE BEGINNING OF EXPLOS--')
22680      CALL DPWRST('XXX','BUG ')
22681      WRITE(ICOUT,52)IBUGA3
22682   52 FORMAT('IBUGA3 = ',A4)
22683      CALL DPWRST('XXX','BUG ')
22684      WRITE(ICOUT,53)N
22685   53 FORMAT('N = ',I8)
22686      CALL DPWRST('XXX','BUG ')
22687      WRITE(ICOUT,54)ENGUSL,ENGLSL,COSUSL
22688   54 FORMAT('ENGUSL,ENGLSL,COSUSL = ',3E15.7)
22689      CALL DPWRST('XXX','BUG ')
22690      DO55I=1,N
22691      WRITE(ICOUT,56)I,X(I)
22692   56 FORMAT('I,X(I) = ',I8,E15.7)
22693      CALL DPWRST('XXX','BUG ')
22694   55 CONTINUE
22695   90 CONTINUE
22696C
22697C               ********************************************
22698C               **  COMPUTE PROCESS CAPABILITY INDEX EXPLOS  **
22699C               ********************************************
22700C
22701C               ********************************************
22702C               **  STEP 1--                              **
22703C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
22704C               ********************************************
22705C
22706      AN=N
22707C
22708      IF(N.GE.1)GOTO119
22709      IERROR='YES'
22710      WRITE(ICOUT,999)
22711      CALL DPWRST('XXX','BUG ')
22712      WRITE(ICOUT,111)
22713  111 FORMAT('***** ERROR IN EXPLOS--')
22714      CALL DPWRST('XXX','BUG ')
22715      WRITE(ICOUT,112)
22716  112 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
22717      CALL DPWRST('XXX','BUG ')
22718      WRITE(ICOUT,113)
22719  113 FORMAT('      IN THE VARIABLE FOR WHICH')
22720      CALL DPWRST('XXX','BUG ')
22721      WRITE(ICOUT,114)
22722  114 FORMAT('      THE EXPECTED LOSS IS TO BE COMPUTED')
22723      CALL DPWRST('XXX','BUG ')
22724      WRITE(ICOUT,115)
22725  115 FORMAT('      MUST BE 1 OR LARGER.')
22726      CALL DPWRST('XXX','BUG ')
22727      WRITE(ICOUT,116)
22728  116 FORMAT('      SUCH WAS NOT THE CASE HERE.')
22729      CALL DPWRST('XXX','BUG ')
22730      WRITE(ICOUT,117)N
22731  117 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
22732     1'.')
22733      CALL DPWRST('XXX','BUG ')
22734      GOTO9000
22735  119 CONTINUE
22736C
22737      IF(N.EQ.1)GOTO120
22738      GOTO129
22739  120 CONTINUE
22740CCCCC WRITE(ICOUT,999)
22741CCCCC CALL DPWRST('XXX','BUG ')
22742CCCCC WRITE(ICOUT,121)
22743CC121 FORMAT('***** NON-FATAL DIAGNOSTIC IN EXPLOS--',
22744CCCCC CALL DPWRST('XXX','BUG ')
22745CCCCC1'THE SECOND INPUT ARGUMENT (N) HAS THE VALUE 1')
22746      XSD=0.0
22747      GOTO9000
22748  129 CONTINUE
22749C
22750      HOLD=X(1)
22751      DO135I=2,N
22752      IF(X(I).NE.HOLD)GOTO139
22753  135 CONTINUE
22754CCCCC WRITE(ICOUT,999)
22755CCCCC CALL DPWRST('XXX','BUG ')
22756CCCCC WRITE(ICOUT,136)HOLD
22757CC136 FORMAT('***** NON-FATAL DIAGNOSTIC IN EXPLOS--',
22758CCCCC CALL DPWRST('XXX','BUG ')
22759CCCCC1'THE FIRST INPUT ARGUMENT (A VECTOR) HAS ALL ELEMENTS = ',E15.7)
22760      XSD=0.0
22761      GOTO9000
22762  139 CONTINUE
22763C
22764C               ***************************************
22765C               **  STEP 2--                         **
22766C               **  COMPUTE THE STANDARD DEVIATION.  **
22767C               ***************************************
22768C
22769      DN=N
22770      DSUM=0.0D0
22771      DO200I=1,N
22772      DX=X(I)
22773      DSUM=DSUM+DX
22774  200 CONTINUE
22775      DMEAN=DSUM/DN
22776C
22777      DSUM=0.0D0
22778      DO300I=1,N
22779      DX=X(I)
22780      DSUM=DSUM+(DX-DMEAN)**2
22781  300 CONTINUE
22782      DVAR=DSUM/(DN-1.0D0)
22783      DSD=0.0D0
22784      IF(DVAR.GT.0.0D0)DSD=DSQRT(DVAR)
22785      XSD=DSD
22786C
22787C               **************************************************
22788C               **  STEP 3--                                    **
22789C               **  COMPUTE THE EXPECTED LOSS                   **
22790C               **************************************************
22791C
22792      DUSL=ENGUSL
22793      DLSL=ENGLSL
22794C
22795      DTARG=(DUSL+DLSL)/2.0D0
22796      DH=(DUSL-DLSL)/2.0D0
22797C
22798      IF(DH.EQ.0.0D0)XEL=CPUMAX
22799      IF(DH.EQ.0.0D0)GOTO490
22800C
22801      DKSIGM=DSD/DH
22802      DKMU=(DMEAN-DTARG)/DH
22803C
22804      DCOSUS=COSUSL
22805      DEL=DCOSUS*(DKSIGM**2+DKMU**2)
22806      XEL=DEL
22807C
22808  490 CONTINUE
22809C
22810C               *******************************
22811C               **  STEP 3--                 **
22812C               **  WRITE OUT A LINE         **
22813C               **  OF SUMMARY INFORMATION.  **
22814C               *******************************
22815C
22816      IF(IFEEDB.EQ.'OFF')GOTO890
22817      IF(IWRITE.EQ.'OFF')GOTO890
22818      WRITE(ICOUT,999)
22819      CALL DPWRST('XXX','BUG ')
22820      WRITE(ICOUT,811)N,XEL
22821  811 FORMAT('THE EXPECTED LOSS ($) OF THE ',I8,' OBSERVATIONS = ',
22822     1E15.7)
22823      CALL DPWRST('XXX','BUG ')
22824  890 CONTINUE
22825C
22826C               *****************
22827C               **  STEP 90--  **
22828C               **  EXIT.      **
22829C               *****************
22830C
22831 9000 CONTINUE
22832      IF(IBUGA3.EQ.'OFF')GOTO9090
22833      WRITE(ICOUT,999)
22834      CALL DPWRST('XXX','BUG ')
22835      WRITE(ICOUT,9011)
22836 9011 FORMAT('***** AT THE END       OF EXPLOS--')
22837      CALL DPWRST('XXX','BUG ')
22838      WRITE(ICOUT,9012)IBUGA3,IERROR
22839 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
22840      CALL DPWRST('XXX','BUG ')
22841      WRITE(ICOUT,9013)N
22842 9013 FORMAT('N = ',I8)
22843      CALL DPWRST('XXX','BUG ')
22844      WRITE(ICOUT,9014)DMEAN
22845 9014 FORMAT('DMEAN = ',D15.7)
22846      CALL DPWRST('XXX','BUG ')
22847      WRITE(ICOUT,9015)DSD
22848 9015 FORMAT('DSD = ',E15.7)
22849      CALL DPWRST('XXX','BUG ')
22850      WRITE(ICOUT,9016)DUSL,DLSL,DTARG,DH
22851 9016 FORMAT('DUSL,DLSL,DTARG,DH = ',4D15.7)
22852      CALL DPWRST('XXX','BUG ')
22853      WRITE(ICOUT,9017)DKMU,DKSIGM,DEL,XEL
22854 9017 FORMAT('DKMU,DKSIGM,DEL,XEL = ',3D15.7,E15.7)
22855      CALL DPWRST('XXX','BUG ')
22856 9090 CONTINUE
22857C
22858      RETURN
22859      END
22860      SUBROUTINE EXPAFR(X1,X2,SCALE,AFR)
22861C
22862C     PURPOSE--THIS SUBROUTINE COMPUTES THE AVERAGE FAILURE
22863C              RATE (AFR) FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION.
22864C              THE AFR IS DEFINED AS:
22865C
22866C              AFR(X1,X2,LOC,SCALE) = (H(X2,LOC,SCALE) - H(X1,LOC,SCALE))/(X2-X1)
22867C
22868C              WHERE
22869C
22870C              H(X,LOC,SCALE) = (X-LOC)/SCALE
22871C
22872C              SO
22873C
22874C              AFR(X1,X2) = ((X2-LOC)/SCALE) - (X1-LOC)/SCALE)/(X2-X1)
22875C                         = 1/SCALE
22876C
22877C              NOTE THAT THE LOCATION PARAMETER CANCELS OUT, SO
22878C              WE OMIT THE ARGUMENT.
22879C     INPUT  ARGUMENTS--X1     = THE SINGLE PRECISION VALUE AT
22880C                                WHICH THE AFR FUNCTION IS TO BE
22881C                                EVALUATED.
22882C     INPUT  ARGUMENTS--X2     = THE SINGLE PRECISION VALUE AT
22883C                                WHICH THE AFR FUNCTION IS TO BE
22884C                                EVALUATED.
22885C     OUTPUT ARGUMENTS--AFR    = THE SINGLE PRECISION AVERAGE
22886C                                FAILURE RATE FUNCTION VALUE.
22887C     OUTPUT--THE SINGLE PRECISION AVERAGE FAILURE RATE
22888C             FUNCTION VALUE PDF.
22889C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
22890C     RESTRICTIONS--X2 AND X1  SHOULD BE NON-NEGATIVE AND NOT EQUAL.
22891C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
22892C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
22893C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
22894C     LANGUAGE--ANSI FORTRAN.
22895C     REFERENCES--TOBIAS AND TRINDALE, "APPLIED RELIABILITY", SECOND
22896C                 EDITION, CHAPMAN AND HALL/CRC, 1995.
22897C     WRITTEN BY--JAMES J. FILLIBEN
22898C                 STATISTICAL ENGINEERING DIVISION
22899C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22900C                 INFORMATION TECHNOLOGY LABORATORY
22901C                 GAITHERSBURG, MD 20899-8980
22902C                 PHONE:  301-975-2855
22903C     ORIGINAL VERSION--MARCH     2005.
22904C
22905C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22906C
22907C-----COMMON----------------------------------------------------------
22908C
22909      INCLUDE 'DPCOP2.INC'
22910C
22911C---------------------------------------------------------------------
22912C
22913C     CHECK THE INPUT ARGUMENTS FOR ERRORS
22914C
22915      X1MN=MIN(X1,X2)
22916      X1MX=MAX(X1,X2)
22917      IF(X1MN.EQ.X1MX)THEN
22918        WRITE(ICOUT,5)
22919        CALL DPWRST('XXX','BUG ')
22920        WRITE(ICOUT,47)X1MN
22921        CALL DPWRST('XXX','BUG ')
22922        WRITE(ICOUT,48)X1MX
22923        CALL DPWRST('XXX','BUG ')
22924        AFR=0.0
22925        GOTO9000
22926      ELSEIF(X1MN.LT.0.0)THEN
22927        WRITE(ICOUT,4)
22928        CALL DPWRST('XXX','BUG ')
22929        WRITE(ICOUT,46)X1MN
22930        CALL DPWRST('XXX','BUG ')
22931        AFR=0.0
22932        GOTO9000
22933      ELSEIF(SCALE.LE.0.0)THEN
22934        WRITE(ICOUT,6)
22935        CALL DPWRST('XXX','BUG ')
22936        WRITE(ICOUT,46)SCALE
22937        CALL DPWRST('XXX','BUG ')
22938        AFR=0.0
22939        GOTO9000
22940      ENDIF
22941    4 FORMAT('***** ERROR--THE FIRST ARGUMENT TO EXPAFR IS NEGATIVE.')
22942    5 FORMAT('***** ERROR--THE FIRST AND SECOND ARGUMENTS ',
22943     1       'TO EXPAFR ARE EQUAL')
22944    6 FORMAT('***** ERROR--THE FOURTH ARGUMENT TO EXPAFR ',
22945     1       '(THE SCALE) IS NON-POSITIVE')
22946   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
22947   47 FORMAT('***** THE VALUE OF THE FIRST ARGUMENT IS ',G15.7)
22948   48 FORMAT('***** THE VALUE OF THE SECOND ARGUMENT IS ',G15.7)
22949C
22950C-----START POINT-----------------------------------------------------
22951C
22952      AFR=1.0/SCALE
22953C
22954 9000 CONTINUE
22955      RETURN
22956      END
22957      SUBROUTINE EXPCDF(X,CDF)
22958C
22959C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
22960C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
22961C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
22962C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
22963C              AND HAS THE PROBABILITY DENSITY FUNCTION
22964C              F(X) = EXP(-X).
22965C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
22966C                                WHICH THE CUMULATIVE DISTRIBUTION
22967C                                FUNCTION IS TO BE EVALUATED.
22968C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
22969C                                DISTRIBUTION FUNCTION VALUE.
22970C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
22971C             FUNCTION VALUE CDF.
22972C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
22973C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
22974C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
22975C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
22976C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
22977C     LANGUAGE--ANSI FORTRAN.
22978C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
22979C                 DISTRIBUTIONS--1, 1970, PAGES 207-232.
22980C     WRITTEN BY--JAMES J. FILLIBEN
22981C                 STATISTICAL ENGINEERING LABORATORY (205.03)
22982C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22983C                 GAITHERSBURG, MD 20899
22984C                 PHONE:  301-921-2315
22985C     ORIGINAL VERSION--APRIL     1994.
22986C
22987C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22988C
22989C-----COMMON----------------------------------------------------------
22990C
22991      INCLUDE 'DPCOP2.INC'
22992C
22993C---------------------------------------------------------------------
22994C
22995C     CHECK THE INPUT ARGUMENTS FOR ERRORS
22996C
22997      IF(X.LT.0.0)THEN
22998CCCCC   WRITE(ICOUT,4)
22999CCCCC   CALL DPWRST('XXX','BUG ')
23000CCCCC   WRITE(ICOUT,46)X
23001CCCCC   CALL DPWRST('XXX','BUG ')
23002        CDF=0.0
23003      ELSE
23004        CDF=1.0-EXP(-X)
23005      ENDIF
23006C
23007CCCC4 FORMAT('***** WARNING--THE FIRST ARGUMENT TO EXPCDF IS NEGATIVE.')
23008CCC46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
23009C
23010      RETURN
23011      END
23012      SUBROUTINE EXPCHA(X,HAZ)
23013C
23014C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE HAZARD
23015C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
23016C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
23017C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
23018C              AND HAS THE PROBABILITY DENSITY FUNCTION
23019C              F(X) = EXP(-X) AND
23020C              CUMULATIVE HAZARD FUNCTION
23021C              H(X)=X.
23022C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
23023C                                WHICH THE PROBABILITY DENSITY
23024C                                FUNCTION IS TO BE EVALUATED.
23025C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION
23026C                                CUMULATIVE HAZARD FUNCTION VALUE.
23027C     OUTPUT--THE SINGLE PRECISION CUMULATIVE HAZARD
23028C             FUNCTION VALUE PDF.
23029C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
23030C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
23031C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
23032C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
23033C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
23034C     LANGUAGE--ANSI FORTRAN.
23035C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
23036C                 DISTRIBUTIONS--1, 1970, CHAPTER 19.
23037C     WRITTEN BY--JAMES J. FILLIBEN
23038C                 STATISTICAL ENGINEERING LABORATORY (205.03)
23039C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23040C                 GAITHERSBURG, MD 20899
23041C                 PHONE:  301-975-2855
23042C     ORIGINAL VERSION--APRIL     1998.
23043C
23044C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23045C
23046C-----COMMON----------------------------------------------------------
23047C
23048      INCLUDE 'DPCOP2.INC'
23049C
23050C---------------------------------------------------------------------
23051C
23052C     CHECK THE INPUT ARGUMENTS FOR ERRORS
23053C
23054      IF(X.LT.0.0)THEN
23055        WRITE(ICOUT,4)
23056        CALL DPWRST('XXX','BUG ')
23057        WRITE(ICOUT,46)X
23058        CALL DPWRST('XXX','BUG ')
23059        HAZ=0.0
23060      ELSE
23061        HAZ=X
23062      ENDIF
23063    4 FORMAT('***** WARNING--THE FIRST ARGUMENT TO EXPHAZ IS NEGATIVE.')
23064   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
23065C
23066      RETURN
23067      END
23068      DOUBLE PRECISION FUNCTION EXPFUN (DA)
23069C
23070C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE LIKELIHOOD RATIO
23071C              BASED CONFIDECE INTERVAL FOR THE 1-SAMPLE EXPONENTIAL
23072C              MODEL WITH TIME CENSORING.  THIS FUNCTION FINDS THE ROOT
23073C              OF THE EQUATION:
23074C
23075C                 2*IR*LN(SIGMAHAT) - (2/SIGMAHAT)*2*SUM[i=1 to N][X(i)]
23076C                 + 2*IR*LN(A) + (2/A)*SUM[i=1 to N][X(i)] - K
23077C
23078C              WITH
23079C
23080C                 IR       = NUMBER OF FAILURE TIMES
23081C                 SIGMAHAT = POINT ESTIMATE OF SIGMA
23082C                 A        = PARAMETER OF INTEREST
23083C                 K        = CHSPPF(ALPHA,1)
23084C
23085C              NOTE THAT THE SUM[X(I)], K, IR ARE COMPUTED IN
23086C              DPMLE2 AND PASSED VIA COMMON BLOCK.
23087C
23088C              CALLED BY DFZERO ROUTINE FOR FINDING THE ROOT OF A
23089C              FUNCTION.
23090C     EXAMPLE--EXPONENTIAL MAXIMUM LIKELIHOOD Y CENSOR
23091C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
23092C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 12 (SEE
23093C                EXAMPLE 12.3).
23094C     WRITTEN BY--JAMES J. FILLIBEN
23095C                 STATISTICAL ENGINEERING DIVISION
23096C                 INFORMATION TECHNOLOGY LABORATORY
23097C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23098C                 GAITHERSBUG, MD 20899-8980
23099C                 PHONE--301-975-2855
23100C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23101C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23102C     LANGUAGE--ANSI FORTRAN (1977)
23103C     VERSION NUMBER--2004/10
23104C     ORIGINAL VERSION--OCTOBER    2004.
23105C
23106C---------------------------------------------------------------------
23107C
23108      DOUBLE PRECISION DA
23109C
23110      DOUBLE PRECISION DC
23111      DOUBLE PRECISION DK
23112      DOUBLE PRECISION DR
23113      DOUBLE PRECISION SHAT
23114      DOUBLE PRECISION XSUM
23115      COMMON/EXPCOM/DK,DR,SHAT,XSUM,DC
23116C
23117C-----COMMON----------------------------------------------------------
23118C
23119      INCLUDE 'DPCOP2.INC'
23120C
23121C-----START POINT-----------------------------------------------------
23122C
23123C  COMPUTE SOME SUMS
23124C
23125      EXPFUN=DC - 2.0D0*(-DR*DLOG(DA) - XSUM/DA) - DK
23126C
23127      RETURN
23128      END
23129      REAL FUNCTION EXPFU2 (SIGHAT,X,N)
23130C
23131C     PURPOSE--THIS ROUTINE IS USED IN FINDING THE MAXIMUM LIKELIHOOD
23132C              ESTIMATE OF SIGMA FOR THE 1-PARAMETER EXPONENTIAL
23133C              MODEL FOR GROUPED DATA (NO CENSORING).  THIS FUNCTION
23134C              FINDS THE ROOT OF THE EQUATION:
23135C
23136C                 SUM[i=1 to k-1][N(i)*(X(i)-X(i-1))/
23137C                     (EXP(X(i)-X(I-1))/SIGMAHAT) - 1) -
23138C                 SUM[I=2 to k][N(i)*X(i-1)] = 0
23139C
23140C              WITH
23141C
23142C                 X(i)     = UPPER BOUNDARY OF iTH BIN
23143C                 N(i)     = COUNT FOR iTH INTERVAL
23144C                 SIGMAHAT = POINT ESTIMATE OF SIGMA (THIS IS THE
23145C                            PARAMETER WE ARE ITERATING OVER)
23146C                 K        = NUMBER OF INTERVALS
23147C
23148C              FORMULAS GO FROM 0 TO K.  FOR CONVENIENCE WITH
23149C              FORTRAN, WE WILL GO FROM 1 TO K+1.
23150C
23151C              CALLED BY FZEROY ROUTINE FOR FINDING THE ROOT OF A
23152C              FUNCTION.
23153C     EXAMPLE--EXPONENTIAL GROUPED MAXIMUM LIKELIHOOD Y X
23154C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
23155C                UNIVARIATE DISTRIBUTIONS--Volume 1", SECOND EDITION,
23156C                WILEY, 1994, PP. 509-510.
23157C     WRITTEN BY--JAMES J. FILLIBEN
23158C                 STATISTICAL ENGINEERING DIVISION
23159C                 INFORMATION TECHNOLOGY LABORATORY
23160C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23161C                 GAITHERSBUG, MD 20899-8980
23162C                 PHONE--301-975-2855
23163C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23164C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23165C     LANGUAGE--ANSI FORTRAN (1977)
23166C     VERSION NUMBER--2004/10
23167C     ORIGINAL VERSION--OCTOBER    2004.
23168C
23169C---------------------------------------------------------------------
23170C
23171      REAL SIGHAT
23172      REAL X(*)
23173      REAL N(*)
23174C
23175      INTEGER IK
23176      COMMON/EX2COM/IK
23177C
23178C---------------------------------------------------------------------
23179C
23180      DOUBLE PRECISION DSUM1
23181      DOUBLE PRECISION DSUM2
23182      DOUBLE PRECISION DTERM1
23183      DOUBLE PRECISION DNI
23184      DOUBLE PRECISION DX1
23185      DOUBLE PRECISION DX2
23186C
23187      INCLUDE 'DPCOP2.INC'
23188C
23189C-----START POINT-----------------------------------------------------
23190C
23191C  COMPUTE SOME SUMS
23192C
23193      DSUM1=0.0D0
23194      DSUM2=0.0D0
23195C
23196C  COMPUTE SUM FOR FIRST TERM
23197C
23198      DO100I=2,IK
23199        DNI=DBLE(N(I))
23200        DX1=DBLE(X(I))
23201        DX2=DBLE(X(I-1))
23202        DTERM1=DNI*(DX1-DX2)/(DEXP((DX1-DX2)/DBLE(SIGHAT))-1.0D0)
23203        DSUM1=DSUM1 + DTERM1
23204  100 CONTINUE
23205C
23206C  COMPUTE SUM FOR SECOND TERM
23207C
23208      DO200I=3,IK+1
23209        DNI=DBLE(N(I))
23210        DX2=DBLE(X(I-1))
23211        DSUM2=DSUM2 + DNI*DX2
23212  200 CONTINUE
23213C
23214      EXPFU2=REAL(DSUM1-DSUM2)
23215C
23216      RETURN
23217      END
23218      SUBROUTINE EXPHAZ(X,HAZ)
23219C
23220C     PURPOSE--THIS SUBROUTINE COMPUTES THE HAZARD
23221C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
23222C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
23223C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
23224C              AND HAS THE PROBABILITY DENSITY FUNCTION
23225C              F(X) = EXP(-X) AND
23226C              HAZARD FUNCTION
23227C              H(X)=1.
23228C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
23229C                                WHICH THE PROBABILITY DENSITY
23230C                                FUNCTION IS TO BE EVALUATED.
23231C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION
23232C                                HAZARD FUNCTION VALUE.
23233C     OUTPUT--THE SINGLE PRECISION HAZARD
23234C             FUNCTION VALUE PDF.
23235C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
23236C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
23237C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
23238C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
23239C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
23240C     LANGUAGE--ANSI FORTRAN.
23241C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
23242C                 DISTRIBUTIONS--1, 1970, CHAPTER 19.
23243C     WRITTEN BY--JAMES J. FILLIBEN
23244C                 STATISTICAL ENGINEERING LABORATORY (205.03)
23245C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23246C                 GAITHERSBURG, MD 20899
23247C                 PHONE:  301-975-2855
23248C     ORIGINAL VERSION--APRIL     1998.
23249C
23250C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23251C
23252C-----COMMON----------------------------------------------------------
23253C
23254      INCLUDE 'DPCOP2.INC'
23255C
23256C---------------------------------------------------------------------
23257C
23258C     CHECK THE INPUT ARGUMENTS FOR ERRORS
23259C
23260      IF(X.LT.0.0)THEN
23261        WRITE(ICOUT,4)
23262        CALL DPWRST('XXX','BUG ')
23263        WRITE(ICOUT,46)X
23264        CALL DPWRST('XXX','BUG ')
23265        HAZ=0.0
23266      ELSE
23267        HAZ=1.0
23268      ENDIF
23269    4 FORMAT('***** WARNING--THE FIRST ARGUMENT TO EXPHAZ IS NEGATIVE.')
23270   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
23271C
23272      RETURN
23273      END
23274      DOUBLE PRECISION FUNCTION EXPM1(DX)
23275C***BEGIN PROLOGUE  EXPM1
23276C***PURPOSE  Evaluate EXP(X)- 1
23277C
23278      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
23279C
23280C-----COMMON----------------------------------------------------------
23281C
23282      REAL R1MACH
23283      INCLUDE 'DPCOMC.INC'
23284      INCLUDE 'DPCOP2.INC'
23285C
23286      A=ABS(DX)
23287      IF(A.LT.D1MACH(4))THEN
23288        EXPM1=DX
23289        GOTO9000
23290      ELSEIF(A.GT.0.697)THEN
23291        EXPM1=EXP(DX) - 1.0D0
23292        GOTO9000
23293      ENDIF
23294C
23295      IF(A.GT.1.0D-8)THEN
23296        Y=EXP(DX) - 1.0D0
23297      ELSE
23298        Y=((DX/2.0D0) + 1.0D0)*DX
23299      ENDIF
23300      DTERM1=DLNREL(Y)
23301      EXPM1=Y - (1.0D0 + Y)*(DTERM1 - DX)
23302C
23303 9000 CONTINUE
23304      RETURN
23305      END
23306      SUBROUTINE EXPML1(Y,N,ICASE,IEXPBC,
23307     1                  ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,
23308     1                  NUMALP,NUMOUT,
23309     1                  XMEAN,XSD,XVAR,XMIN,XMAX,
23310     1                  ALOCML,ALOCSE,SCALML,SCALSE,
23311     1                  ALOCBC,ALOBSE,SCABML,SCABSE,
23312     1                  ISUBRO,IBUGA3,IERROR)
23313C
23314C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
23315C              FOR THE EXPONENTIAL DISTRIBUTION FOR THE RAW DATA CASE
23316C              (I.E., NO CENSORING AND NO GROUPING).  IT WILL ALSO
23317C              RETURN THE CONFIDENCE INTERVALS FOR THE LOCATION
23318C              AND SCALE PARAMETERS.  THIS ROUTINE WILL ESTIMATE EITHER
23319C              THE 2-PARAMETER CASE (I.E., BOTH LOCATION AND SCALE ARE
23320C              ESTIMATED) OR THE 1-PARAMETER CASE (ONLY SCALE IS
23321C              ESTIMATED) BASED ON VALUE OF ICASE.
23322C
23323C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
23324C              PERFORMED.
23325C
23326C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
23327C              FROM MULTIPLE PLACES (DPMLE1 WILL GENERATE THE OUTPUT
23328C              FOR THE EXPONENTIAL MLE COMMAND).
23329C
23330C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
23331C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 12.
23332C     WRITTEN BY--JAMES J. FILLIBEN
23333C                 STATISTICAL ENGINEERING DIVISION
23334C                 INFORMATION TECHNOLOGY LABORATORY
23335C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23336C                 GAITHERSBURG, MD 20899-8980
23337C                 PHONE--301-975-2855
23338C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23339C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23340C     LANGUAGE--ANSI FORTRAN (1977)
23341C     VERSION NUMBER--2010/1
23342C     ORIGINAL VERSION--JANUARY   2010. EXTRACTED AS A SEPARATE
23343C                                       SUBROUTINE (FROM DPMLE1)
23344C
23345C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23346C
23347      DIMENSION Y(*)
23348      DIMENSION ALOWLO(*)
23349      DIMENSION AUPPLO(*)
23350      DIMENSION ALOWSC(*)
23351      DIMENSION AUPPSC(*)
23352      DIMENSION ALPHA(*)
23353C
23354      CHARACTER*4 ICASE
23355      CHARACTER*4 IEXPBC
23356      CHARACTER*4 ISUBRO
23357      CHARACTER*4 IBUGA3
23358      CHARACTER*4 IERROR
23359C
23360      CHARACTER*40 IDIST
23361      CHARACTER*4 ISUBN1
23362      CHARACTER*4 ISUBN2
23363      CHARACTER*4 ISTEPN
23364C
23365C-----COMMON----------------------------------------------------------
23366C
23367      INCLUDE 'DPCOP2.INC'
23368C
23369C-----START POINT-----------------------------------------------------
23370C
23371      ISUBN1='EXPM'
23372      ISUBN2='L1  '
23373      IERROR='NO'
23374C
23375      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML1')THEN
23376        WRITE(ICOUT,999)
23377  999   FORMAT(1X)
23378        CALL DPWRST('XXX','WRIT')
23379        WRITE(ICOUT,51)
23380   51   FORMAT('**** AT THE BEGINNING OF EXPML1--')
23381        CALL DPWRST('XXX','WRIT')
23382        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASE,IEXPBC
23383   52   FORMAT('IBUGA3,ISUBRO,ICASE,IEXPBC = ',3(A4,2X),A4)
23384        CALL DPWRST('XXX','WRIT')
23385        DO56I=1,MIN(N,100)
23386          WRITE(ICOUT,57)I,Y(I)
23387   57     FORMAT('I,Y(I) = ',I8,G15.7)
23388          CALL DPWRST('XXX','WRIT')
23389   56   CONTINUE
23390      ENDIF
23391C
23392C               ******************************************
23393C               **  STEP 1--                            **
23394C               **  CARRY OUT CALCULATIONS              **
23395C               **  FOR NORMAL MLE ESTIMATE             **
23396C               ******************************************
23397C
23398      ISTEPN='1'
23399      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML1')
23400     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23401C
23402      IDIST='EXPONENTIAL'
23403      IFLAG=0
23404      CALL SUMRAW(Y,N,IDIST,IFLAG,
23405     1            XMEAN,XVAR,XSD,XMIN,XMAX,
23406     1            ISUBRO,IBUGA3,IERROR)
23407C
23408      ALOCML=CPUMIN
23409      ALOCBC=CPUMIN
23410      ALOCSE=CPUMIN
23411      ALOBSE=CPUMIN
23412      SCALML=CPUMIN
23413      SCALSE=CPUMIN
23414      SCABML=CPUMIN
23415      SCABSE=CPUMIN
23416      AN=REAL(N)
23417C
23418      IF(ICASE.EQ.'1')THEN
23419C
23420C       ONE-PARAMETER CASE
23421C
23422        SCALML=XMEAN
23423        SCALSE=SCALML/SQRT(AN)
23424C
23425        NU=2*N
23426        DO1110I=1,NUMALP
23427          ALP=ALPHA(I)
23428          P=1.0-(ALP/2.0)
23429          CALL CHSPPF(P,NU,PPF1)
23430          P=ALP/2.0
23431          CALL CHSPPF(P,NU,PPF2)
23432          ALOWSC(I)=2.0*AN*SCALML/PPF1
23433          AUPPSC(I)=2.0*AN*SCALML/PPF2
23434 1110   CONTINUE
23435C
23436      ELSEIF(ICASE.EQ.'2')THEN
23437C
23438C       TWO-PARAMETER CASE
23439C
23440        ALOCML=XMIN
23441        ALOCBC=(AN*XMIN - XMEAN)/(AN - 1.0)
23442        SCALML=XMEAN-XMIN
23443        SCALSE=SCALML/SQRT(AN - 1.0)
23444        SCABML=AN*(XMEAN - XMIN)/(AN - 1.0)
23445        SCABSE=SCABML/SQRT(AN - 1.0)
23446        ALOCSE=SCALML/SQRT(AN*(AN-1.0))
23447        ALOBSE=SCABML/SQRT(AN*(AN-1.0))
23448C
23449        IF(IEXPBC.EQ.'ON')THEN
23450          UTEMP=ALOCBC
23451          SCTEMP=SCABML
23452        ELSE
23453          UTEMP=ALOCML
23454          SCTEMP=SCALML
23455        ENDIF
23456C
23457        NU2=2*(N-1)
23458        DO2120I=1,NUMALP
23459          ALP=ALPHA(I)
23460          P=1.0-(ALP/2.0)
23461          CALL CHSPPF(P,NU2,PPF3)
23462          P=ALP/2.0
23463          CALL CHSPPF(P,NU2,PPF4)
23464          ALOWSC(I)=2.0*AN*SCTEMP/PPF3
23465          AUPPSC(I)=2.0*AN*SCTEMP/PPF4
23466          P=1.0-ALP
23467          ACONS1=(ALP/2.0)**(1.0/(1.0-AN)) - 1.0
23468          ACONS2=(1.0 - ALP/2.0)**(1.0/(1.0-AN)) - 1.0
23469          ATEMP1=XMIN - SCTEMP*ACONS1
23470          ATEMP2=XMIN - SCTEMP*ACONS2
23471          ALOWLO(I)=MIN(ATEMP1,ATEMP2)
23472          AUPPLO(I)=MAX(ATEMP1,ATEMP2)
23473 2120   CONTINUE
23474      ENDIF
23475C
23476      NUMOUT=NUMALP
23477C
23478      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML1')THEN
23479        WRITE(ICOUT,999)
23480        CALL DPWRST('XXX','WRIT')
23481        WRITE(ICOUT,9011)
23482 9011   FORMAT('**** AT THE END OF EXPML1--')
23483        CALL DPWRST('XXX','WRIT')
23484        WRITE(ICOUT,9013)N,XMEAN,XSD,XMIN,XMAX
23485 9013   FORMAT('N,XMEAN,XSD,XMIN,XMAX = ',I8,4G15.7)
23486        CALL DPWRST('XXX','WRIT')
23487        WRITE(ICOUT,9017)ALOCML,SCALML,ALOCSE,SCALSE
23488 9017   FORMAT('ALOCML,SCALML,ALOCSE,SCALSE = ',4G15.7)
23489        CALL DPWRST('XXX','WRIT')
23490        WRITE(ICOUT,9019)ALOCBC,SCALBC,ALOBSE,SCABSE
23491 9019   FORMAT('ALOCBC,SCALBC,ALOBSE,SCABSE = ',4G15.7)
23492        CALL DPWRST('XXX','WRIT')
23493      ENDIF
23494C
23495      RETURN
23496      END
23497      SUBROUTINE EXPML2(Y,TAG,N,ICASPL,ICASE,TEND,TEMP1,MAXNXT,
23498     1                  XMEAN,XSD,XVAR,XMIN,XMAX,XSUM,
23499     1                  ALOCML,ALOCSE,SCALML,SCALSE,
23500     1                  IR,IM,AN,AR,AM,
23501     1                  ISUBRO,IBUGA3,IERROR)
23502C
23503C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
23504C              FOR THE EXPONENTIAL DISTRIBUTION FOR THE RAW DATA CASE
23505C              WITH TIME CENSORING.  THIS ROUTINE GENERATES ONLY THE
23506C              POINT ESTIMATES FOR THE LOCATION AND SCALE PARAMETERS.
23507C              IT WILL ESTIMATE EITHER THE 2-PARAMETER CASE (I.E.,
23508C              BOTH LOCATION AND SCALE ARE ESTIMATED) OR THE 1-PARAMETER
23509C              CASE (ONLY SCALE IS ESTIMATED) BASED ON VALUE OF ICASE.
23510C
23511C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
23512C              PERFORMED.
23513C
23514C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
23515C              FROM MULTIPLE PLACES (DPMLE2 WILL GENERATE THE OUTPUT
23516C              FOR THE EXPONENTIAL MLE COMMAND).
23517C
23518C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
23519C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 12.
23520C     WRITTEN BY--JAMES J. FILLIBEN
23521C                 STATISTICAL ENGINEERING DIVISION
23522C                 INFORMATION TECHNOLOGY LABORATORY
23523C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23524C                 GAITHERSBURG, MD 20899-8980
23525C                 PHONE--301-975-2855
23526C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23527C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23528C     LANGUAGE--ANSI FORTRAN (1977)
23529C     VERSION NUMBER--2010/6
23530C     ORIGINAL VERSION--JUNE      2010. EXTRACTED AS A SEPARATE
23531C                                       SUBROUTINE (FROM DPMLE2)
23532C
23533C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23534C
23535      DIMENSION Y(*)
23536      DIMENSION TAG(*)
23537      DIMENSION TEMP1(*)
23538C
23539      CHARACTER*4 ICASPL
23540      CHARACTER*4 ICASE
23541      CHARACTER*4 ISUBRO
23542      CHARACTER*4 IBUGA3
23543      CHARACTER*4 IERROR
23544C
23545      CHARACTER*4 IWRITE
23546      CHARACTER*40 IDIST
23547C
23548      CHARACTER*4 ISUBN1
23549      CHARACTER*4 ISUBN2
23550      CHARACTER*4 ISTEPN
23551C
23552C-----COMMON----------------------------------------------------------
23553C
23554      INCLUDE 'DPCOP2.INC'
23555C
23556C-----START POINT-----------------------------------------------------
23557C
23558      ISUBN1='EXPM'
23559      ISUBN2='L2  '
23560      IERROR='NO'
23561C
23562      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML2')THEN
23563        WRITE(ICOUT,999)
23564  999   FORMAT(1X)
23565        CALL DPWRST('XXX','WRIT')
23566        WRITE(ICOUT,51)
23567   51   FORMAT('**** AT THE BEGINNING OF EXPML2--')
23568        CALL DPWRST('XXX','WRIT')
23569        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASPL,TEND,MAXNXT
23570   52   FORMAT('IBUGA3,ISUBRO,ICASE,TEND,MAXNST = ',
23571     1         2(A4,2X),A4,G15.7,I8)
23572        CALL DPWRST('XXX','WRIT')
23573        DO56I=1,MIN(N,100)
23574          WRITE(ICOUT,57)I,Y(I),TAG(I)
23575   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
23576          CALL DPWRST('XXX','WRIT')
23577   56   CONTINUE
23578      ENDIF
23579C
23580C               ******************************************
23581C               **  STEP 1--                            **
23582C               **  CARRY OUT CALCULATIONS              **
23583C               **  FOR EXPONENTIAL MLE ESTIMATE        **
23584C               ******************************************
23585C
23586      ISTEPN='1'
23587      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML2')
23588     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23589C
23590      IDIST='EXPONENTIAL'
23591      CALL CKCENS(TAG,TEMP1,N,IDIST,
23592     1            ISUBRO,IBUGA3,IERROR)
23593      IF(IERROR.EQ.'YES')GOTO9000
23594C
23595      IWRITE='OFF'
23596      IFLAG=0
23597      CALL SUMRAW(Y,N,IDIST,IFLAG,
23598     1            XMEAN,XVAR,XSD,XMIN,XMAX,
23599     1            ISUBRO,IBUGA3,IERROR)
23600C
23601      CALL SUMDP(Y,N,IWRITE,XSUM,IBUGA3,IERROR)
23602C
23603      ALOCML=CPUMIN
23604      ALOCSE=CPUMIN
23605      SCALML=CPUMIN
23606      SCALSE=CPUMIN
23607C
23608      CALL SORTC(Y,TAG,N,Y,TAG)
23609      IR=0
23610      DO2120I=1,N
23611        IF(TAG(I).EQ.1.0)IR=IR+1
23612 2120 CONTINUE
23613      IM=N-IR
23614C
23615      DR=DBLE(IR)
23616C
23617      IF(IM.EQ.0)THEN
23618        ICASE='NONE'
23619        WRITE(ICOUT,999)
23620        CALL DPWRST('XXX','WRIT')
23621        WRITE(ICOUT,2131)
23622 2131   FORMAT('***** WARNING FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
23623        CALL DPWRST('XXX','WRIT')
23624        WRITE(ICOUT,2133)
23625 2133   FORMAT('      NO CENSORING TIMES DETECTED.  IT IS RECOMMENDED')
23626        CALL DPWRST('XXX','WRIT')
23627        WRITE(ICOUT,2135)
23628 2135   FORMAT('      THAT THE FULL SAMPLE SYNTAX BE USED:')
23629        CALL DPWRST('XXX','WRIT')
23630        WRITE(ICOUT,999)
23631        CALL DPWRST('XXX','WRIT')
23632        WRITE(ICOUT,2137)
23633 2137   FORMAT('      EXPONENTIAL MAXIMUM LIKELIHOOD  Y')
23634        CALL DPWRST('XXX','WRIT')
23635        WRITE(ICOUT,999)
23636        CALL DPWRST('XXX','WRIT')
23637      ELSE
23638        ICASE='SING'
23639        AHOLD=Y(IR+1)
23640        DO2140I=IR+1,N
23641          IF(Y(I).NE.AHOLD)THEN
23642            ICASE='MULT'
23643            GOTO2149
23644          ENDIF
23645 2140   CONTINUE
23646 2149   CONTINUE
23647      ENDIF
23648C
23649C               ************************************
23650C               **  STEP 41--                     **
23651C               **  CARRY OUT CALCULATIONS        **
23652C               **  FOR EXPONENTIAL MLE           **
23653C               **  ESTIMATE (TIME CENSORED CASE) **
23654C               ************************************
23655C
23656      ISTEPN='41'
23657      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
23658     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23659C
23660      IERROR='NO'
23661      IWRITE='OFF'
23662      AN=REAL(N)
23663      AR=REAL(IR)
23664      AM=REAL(IM)
23665C
23666C     ESTIMATES FOR 1-PARAMETER MODEL
23667C
23668      IF(ICASPL.EQ.'1EXP')THEN
23669        ALOCML=0.0
23670        SCALML=XSUM/AR
23671        SCALSE=SCALML/SQRT(AR)
23672      ELSE
23673C
23674C     ESTIMATES FOR 2-PARAMETER MODEL
23675C
23676C     NOTE THAT THERE IS NO SIMPLE FORMULA FOR THE STANDARD ERROR
23677C     OF LOCATION PARAMETER.
23678C
23679        ALOCML=XMIN
23680        ALOCSE=CPUMIN
23681        DSUM1=0.0D0
23682        DO4120I=1,N
23683          DSUM1=DSUM1 + DBLE(Y(I) - XMIN)
23684 4120   CONTINUE
23685        SCALML=REAL(DSUM1/DBLE(IR))
23686        SCALSE=SCALML/SQRT(AR)
23687      ENDIF
23688C
23689C
23690 9000 CONTINUE
23691      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML2')THEN
23692        WRITE(ICOUT,999)
23693        CALL DPWRST('XXX','WRIT')
23694        WRITE(ICOUT,9011)
23695 9011   FORMAT('**** AT THE END OF EXPML2--')
23696        CALL DPWRST('XXX','WRIT')
23697        WRITE(ICOUT,9013)N,XMEAN,XSD,XMIN,XMAX
23698 9013   FORMAT('N,XMEAN,XSD,XMIN,XMAX = ',I8,4G15.7)
23699        CALL DPWRST('XXX','WRIT')
23700        WRITE(ICOUT,9017)ALOCML,SCALML,ALOCSE,SCALSE
23701 9017   FORMAT('ALOCML,SCALML,ALOCSE,SCALSE = ',4G15.7)
23702        CALL DPWRST('XXX','WRIT')
23703      ENDIF
23704C
23705      RETURN
23706      END
23707      SUBROUTINE EXPML3(Y,TAG,XTEMP,N,ICASPL,ICASE,TEND,MAXNXT,
23708     1                  XMEAN,XSD,XVAR,XMIN,XMAX,XSUM,
23709     1                  ALOCML,ALOCSE,SCALML,SCALSE,
23710     1                  IR,IM,AN,AR,AM,
23711     1                  ISUBRO,IBUGA3,IERROR)
23712C
23713C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
23714C              FOR THE EXPONENTIAL DISTRIBUTION FOR THE RAW DATA CASE
23715C              WITH FAILURE CENSORING.  THIS ROUTINE GENERATES ONLY THE
23716C              POINT ESTIMATES FOR THE LOCATION AND SCALE PARAMETERS.
23717C              IT WILL ESTIMATE EITHER THE 2-PARAMETER CASE (I.E.,
23718C              BOTH LOCATION AND SCALE ARE ESTIMATED) OR THE 1-PARAMETER
23719C              CASE (ONLY SCALE IS ESTIMATED) BASED ON VALUE OF ICASE.
23720C
23721C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
23722C              PERFORMED.
23723C
23724C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
23725C              FROM MULTIPLE PLACES (DPMLE3 WILL GENERATE THE OUTPUT
23726C              FOR THE EXPONENTIAL MLE COMMAND).
23727C
23728C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN ENGINEERING",
23729C                CAMBRIDGE UNIVERSITY PRESS, 1999, CHAPTER 12.
23730C     WRITTEN BY--JAMES J. FILLIBEN
23731C                 STATISTICAL ENGINEERING DIVISION
23732C                 INFORMATION TECHNOLOGY LABORATORY
23733C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23734C                 GAITHERSBURG, MD 20899-8980
23735C                 PHONE--301-975-2855
23736C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23737C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23738C     LANGUAGE--ANSI FORTRAN (1977)
23739C     VERSION NUMBER--2010/6
23740C     ORIGINAL VERSION--JUNE      2010. EXTRACTED AS A SEPARATE
23741C                                       SUBROUTINE (FROM DPMLE3)
23742C
23743C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23744C
23745      DIMENSION Y(*)
23746      DIMENSION TAG(*)
23747      DIMENSION XTEMP(*)
23748C
23749      CHARACTER*4 ICASPL
23750      CHARACTER*4 ICASE
23751      CHARACTER*4 ISUBRO
23752      CHARACTER*4 IBUGA3
23753      CHARACTER*4 IERROR
23754C
23755      CHARACTER*4 IWRITE
23756      CHARACTER*40 IDIST
23757C
23758      CHARACTER*4 ISUBN1
23759      CHARACTER*4 ISUBN2
23760      CHARACTER*4 ISTEPN
23761C
23762C-----COMMON----------------------------------------------------------
23763C
23764      INCLUDE 'DPCOP2.INC'
23765C
23766C-----START POINT-----------------------------------------------------
23767C
23768      ISUBN1='EXPM'
23769      ISUBN2='L3  '
23770      IERROR='NO'
23771C
23772      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML3')THEN
23773        WRITE(ICOUT,999)
23774  999   FORMAT(1X)
23775        CALL DPWRST('XXX','WRIT')
23776        WRITE(ICOUT,51)
23777   51   FORMAT('**** AT THE BEGINNING OF EXPML3--')
23778        CALL DPWRST('XXX','WRIT')
23779        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASPL,TEND,MAXNXT
23780   52   FORMAT('IBUGA3,ISUBRO,ICASE,TEND,MAXNXT = ',
23781     1         2(A4,2X),A4,G15.7,I8)
23782        CALL DPWRST('XXX','WRIT')
23783        DO56I=1,MIN(N,100)
23784          WRITE(ICOUT,57)I,Y(I),TAG(I)
23785   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
23786          CALL DPWRST('XXX','WRIT')
23787   56   CONTINUE
23788      ENDIF
23789C
23790C               ******************************************
23791C               **  STEP 1--                            **
23792C               **  CARRY OUT CALCULATIONS              **
23793C               **  FOR EXPONENTIAL MLE ESTIMATE        **
23794C               ******************************************
23795C
23796      ISTEPN='1'
23797      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML3')
23798     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23799C
23800      IDIST='EXPONENTIAL'
23801      CALL CKCENS(TAG,XTEMP,N,IDIST,
23802     1            ISUBRO,IBUGA3,IERROR)
23803      IF(IERROR.EQ.'YES')GOTO9000
23804C
23805      IWRITE='OFF'
23806      IFLAG=0
23807      CALL SUMRAW(Y,N,IDIST,IFLAG,
23808     1            XMEAN,XVAR,XSD,XMIN,XMAX,
23809     1            ISUBRO,IBUGA3,IERROR)
23810C
23811      CALL SUMDP(Y,N,IWRITE,XSUM,IBUGA3,IERROR)
23812C
23813      ALOCML=CPUMIN
23814      ALOCSE=CPUMIN
23815      SCALML=CPUMIN
23816      SCALSE=CPUMIN
23817C
23818      CALL SORTC(Y,TAG,N,Y,TAG)
23819      IR=0
23820      DO2120I=1,N
23821        IF(TAG(I).EQ.1.0)IR=IR+1
23822 2120 CONTINUE
23823      IM=N-IR
23824C
23825      DR=DBLE(IR)
23826C
23827      IF(IM.EQ.0)THEN
23828        ICASE='NONE'
23829        WRITE(ICOUT,999)
23830        CALL DPWRST('XXX','WRIT')
23831        WRITE(ICOUT,2131)
23832 2131   FORMAT('***** WARNING FROM EXPONENTIAL MAXIMUM LIKELIHOOD--')
23833        CALL DPWRST('XXX','WRIT')
23834        WRITE(ICOUT,2133)
23835 2133   FORMAT('      NO CENSORING TIMES DETECTED.  IT IS RECOMMENDED')
23836        CALL DPWRST('XXX','WRIT')
23837        WRITE(ICOUT,2135)
23838 2135   FORMAT('      THAT THE FULL SAMPLE SYNTAX BE USED:')
23839        CALL DPWRST('XXX','WRIT')
23840        WRITE(ICOUT,999)
23841        CALL DPWRST('XXX','WRIT')
23842        WRITE(ICOUT,2137)
23843 2137   FORMAT('      EXPONENTIAL MAXIMUM LIKELIHOOD  Y')
23844        CALL DPWRST('XXX','WRIT')
23845        WRITE(ICOUT,999)
23846        CALL DPWRST('XXX','WRIT')
23847      ELSE
23848        ICASE='SING'
23849        AHOLD=Y(IR+1)
23850        DO2140I=IR+1,N
23851          IF(Y(I).NE.AHOLD)THEN
23852            ICASE='MULT'
23853            GOTO2149
23854          ENDIF
23855 2140   CONTINUE
23856 2149   CONTINUE
23857      ENDIF
23858C
23859C               ************************************
23860C               **  STEP 41--                     **
23861C               **  CARRY OUT CALCULATIONS        **
23862C               **  FOR EXPONENTIAL MLE           **
23863C               **  ESTIMATE (TIME CENSORED CASE) **
23864C               ************************************
23865C
23866      ISTEPN='41'
23867      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE2')
23868     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23869C
23870      IERROR='NO'
23871      IWRITE='OFF'
23872      AN=REAL(N)
23873      AR=REAL(IR)
23874      AM=REAL(IM)
23875C
23876C     ESTIMATES FOR 1-PARAMETER MODEL
23877C
23878C     SIGMAHAT = (1/R)*SUM[i=1 to r][(1 + b(i)X(i)]
23879C
23880C     WHERE b(i) = NUMBER OF ITEMS CENSORED AT TIME i.
23881C
23882      IF(ICASPL.EQ.'1EXP')THEN
23883        ALOCML=0.0
23884        DO4103I=1,N
23885          IF(TAG(I).EQ.1.0)THEN
23886            AHOLD=Y(I)
23887            NCEN=0
23888            DO4105J=1,N
23889              IF(J.NE.I .AND. TAG(J).EQ.0.0 .AND. Y(J).EQ.AHOLD)THEN
23890                NCEN=NCEN+1
23891              ENDIF
23892 4105       CONTINUE
23893            XTEMP(I)=REAL(NCEN)
23894          ELSE
23895            XTEMP(I)=0.0
23896          ENDIF
23897 4103   CONTINUE
23898C
23899        DSUM1=0.0D0
23900        DO4107I=1,N
23901          IF(TAG(I).EQ.1.0)THEN
23902            DSUM1=DSUM1 + DBLE(1.0 + XTEMP(I))*DBLE(Y(I))
23903          ENDIF
23904 4107   CONTINUE
23905        SCALML=REAL(DSUM1/DR)
23906        SCALSE=SCALML/SQRT(AR)
23907C
23908      ELSE
23909C
23910C     ESTIMATES FOR 2-PARAMETER MODEL
23911C
23912        IF(ICASE.EQ.'SING')THEN
23913          DSUM1=0.0D0
23914          DO4145I=1,IR
23915            DSUM1=DSUM1 + DBLE(Y(I))
23916 4145     CONTINUE
23917          YSUMR=REAL(DSUM1)
23918C
23919          ALOCML=(1.0/(AN*(AR-1.0)))*(AN*AR*XMIN - YSUMR + AM*Y(IR))
23920          SCALML=(1.0/(AR-1.0))*(YSUMR - AN*Y(1) + AM*Y(IR))
23921          ALOCSE=(SCALML/AN)*SQRT(AR/(AR-1.0))
23922          SCALSE=SCALML/SQRT(AR-1.0)
23923        ENDIF
23924      ENDIF
23925C
23926 9000 CONTINUE
23927      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML3')THEN
23928        WRITE(ICOUT,999)
23929        CALL DPWRST('XXX','WRIT')
23930        WRITE(ICOUT,9011)
23931 9011   FORMAT('**** AT THE END OF EXPML3--')
23932        CALL DPWRST('XXX','WRIT')
23933        WRITE(ICOUT,9013)N,XMEAN,XSD,XMIN,XMAX
23934 9013   FORMAT('N,XMEAN,XSD,XMIN,XMAX = ',I8,4G15.7)
23935        CALL DPWRST('XXX','WRIT')
23936        WRITE(ICOUT,9017)ALOCML,SCALML,ALOCSE,SCALSE
23937 9017   FORMAT('ALOCML,SCALML,ALOCSE,SCALSE = ',4G15.7)
23938        CALL DPWRST('XXX','WRIT')
23939      ENDIF
23940C
23941      RETURN
23942      END
23943      SUBROUTINE EXPML4(Y,X1,X2,N,NUMV,MAXNXT,
23944     1                  XTEMP,TEMP2,TEMP3,
23945     1                  XMEAN,XVAR,XSD,XMIN,XMAX,NTOT,
23946     1                  SCALML,SCALSE,
23947     1                  ISUBRO,IBUGA3,IERROR)
23948C
23949C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
23950C              FOR THE 1-PARAMETER EXPONENTIAL DISTRIBUTION FOR THE
23951C              UNCENSORED CASE WITH GROUPED DATA.
23952C
23953C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
23954C              PERFORMED.  SPECIFICALLY, THE SAMPLE SIZE AND THE
23955C              PRESENCE OF NON-NEGATIVE VALUES.
23956C
23957C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
23958C                UNIVARIATE DISTRIBUTIONS--Volume 1", SECOND EDITION,
23959C                WILEY, 1994, PP. 509-510.
23960C     WRITTEN BY--JAMES J. FILLIBEN
23961C                 STATISTICAL ENGINEERING DIVISION
23962C                 INFORMATION TECHNOLOGY LABORATORY
23963C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23964C                 GAITHERSBURG, MD 20899-8980
23965C                 PHONE--301-975-2855
23966C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23967C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23968C     LANGUAGE--ANSI FORTRAN (1977)
23969C     VERSION NUMBER--2010/7
23970C     ORIGINAL VERSION--JULY      2010. EXTRACT FROM DPMLE4
23971C
23972C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23973C
23974      CHARACTER*4 ISUBRO
23975      CHARACTER*4 IBUGA3
23976      CHARACTER*4 IERROR
23977C
23978      CHARACTER*4 IWRITE
23979      CHARACTER*40 IDIST
23980C
23981      CHARACTER*4 ISUBN1
23982      CHARACTER*4 ISUBN2
23983      CHARACTER*4 ISTEPN
23984C
23985      INTEGER IFLAG
23986      INTEGER IFLAG1
23987      INTEGER IFLAG2
23988C
23989      COMMON/EX2COM/NK
23990      REAL     EXPFU2
23991      EXTERNAL EXPFU2
23992C
23993      DOUBLE PRECISION DSUM1
23994      DOUBLE PRECISION DTERM1
23995      DOUBLE PRECISION DSIGMA
23996      DOUBLE PRECISION DX1
23997      DOUBLE PRECISION DX2
23998C
23999C---------------------------------------------------------------------
24000C
24001      DIMENSION Y(*)
24002      DIMENSION X1(*)
24003      DIMENSION X2(*)
24004      DIMENSION XTEMP(*)
24005      DIMENSION TEMP2(*)
24006      DIMENSION TEMP3(*)
24007C
24008C-----COMMON----------------------------------------------------------
24009C
24010      INCLUDE 'DPCOP2.INC'
24011C
24012C-----START POINT-----------------------------------------------------
24013C
24014      ISUBN1='EXPM'
24015      ISUBN2='L4  '
24016      IERROR='NO'
24017C
24018      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML4')THEN
24019        WRITE(ICOUT,999)
24020  999   FORMAT(1X)
24021        CALL DPWRST('XXX','WRIT')
24022        WRITE(ICOUT,51)
24023   51   FORMAT('**** AT THE BEGINNING OF EXPML4--')
24024        CALL DPWRST('XXX','WRIT')
24025        WRITE(ICOUT,52)IBUGA3,ISUBRO
24026   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
24027        CALL DPWRST('XXX','WRIT')
24028        WRITE(ICOUT,55)N,NUMV
24029   55   FORMAT('N,NUMV = ',2I8)
24030        CALL DPWRST('XXX','WRIT')
24031        DO56I=1,N
24032          WRITE(ICOUT,57)I,X1(I),X2(I),Y(I)
24033   57     FORMAT('I,X1(I),X2(I),Y(I) = ',I8,3G15.7)
24034          CALL DPWRST('XXX','WRIT')
24035   56   CONTINUE
24036      ENDIF
24037C
24038C               ******************************************
24039C               **  STEP 1--                            **
24040C               **  COMPUTE SUMMARY STATISTICS          **
24041C               ******************************************
24042C
24043      ISTEPN='1'
24044      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML4')
24045     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24046C
24047      IF(NUMV.EQ.2)THEN
24048        IFLAG1=1
24049        IFLAG2=0
24050        CALL SUMGRP(Y,X1,N,IDIST,IFLAG1,IFLAG2,
24051     1              XTEMP,TEMP2,TEMP3,MAXNXT,
24052     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOT,
24053     1              ISUBRO,IBUGA3,IERROR)
24054        IF(IERROR.EQ.'YES')GOTO9000
24055      ELSEIF(NUMV.EQ.3)THEN
24056        IFLAG1=1
24057        IFLAG2=0
24058        CALL SUMGR2(Y,X1,X2,N,IDIST,IFLAG1,IFLAG2,
24059     1              XTEMP,TEMP2,TEMP3,MAXNXT,
24060     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOT,
24061     1              ISUBRO,IBUGA3,IERROR)
24062        IF(IERROR.EQ.'YES')GOTO9000
24063      ELSE
24064        IERROR='YES'
24065        GOTO9000
24066      ENDIF
24067C
24068C               ******************************************
24069C               **  STEP 2--                            **
24070C               **  CARRY OUT CALCULATIONS              **
24071C               **  FOR EXPONENTIAL MLE ESTIMATE        **
24072C               ******************************************
24073C
24074      ISTEPN='2'
24075      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML4')
24076     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24077C
24078      IERFLG=0
24079      IERROR='NO'
24080      IWRITE='OFF'
24081C
24082      IF(NUMV.EQ.2)THEN
24083C
24084C       DEFINE INTERVALS
24085C
24086        DELTA=(X1(2)-X1(1))/2.0
24087        ICNT=1
24088        X2(ICNT)=0.0
24089        ICNT=2
24090        X2(ICNT)=X1(1)+DELTA
24091        DO2110I=2,N
24092          DELTA=(X1(I)-X1(I-1))/2.0
24093          ICNT=ICNT+1
24094          X2(ICNT)=X1(I)+DELTA
24095 2110   CONTINUE
24096        NK=ICNT
24097        ICNT=ICNT+1
24098        X2(ICNT)=CPUMAX
24099        Y(NK)=0.0
24100        DO2120I=1,NK
24101          X1(I)=X2(I)
24102 2120   CONTINUE
24103C
24104      ELSE
24105C
24106C       DEFINE INTERVALS
24107C
24108        ICNT=0
24109        DO2130I=1,N
24110          ICNT=ICNT+1
24111          X1(ICNT)=X2(ICNT)
24112 2130   CONTINUE
24113        ICNT=ICNT+1
24114        X1(ICNT)=CPUMAX
24115        X2(ICNT)=CPUMAX
24116        NK=ICNT
24117        Y(N+1)=0.0
24118C
24119      ENDIF
24120C
24121      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MLE4')THEN
24122        WRITE(ICOUT,2155)NUMV,NK
24123 2155   FORMAT('NUMV,NK = ',2I8)
24124        CALL DPWRST('XXX','WRIT')
24125        DO2157I=1,NK+1
24126          WRITE(ICOUT,2156)I,X1(I),Y(I)
24127 2156     FORMAT('I,X1(I),Y(I) =',I8,2G15.7)
24128          CALL DPWRST('XXX','WRIT')
24129 2157   CONTINUE
24130      ENDIF
24131C
24132C     ESTIMATES FOR 1-PARAMETER MODEL.  USE FZEROY TO FIND ROOT OF
24133C     EQUATION GIVEN IN EXPFU2 (COMMENTS IN THAT ROUTINE GIVE
24134C     ACTUAL EQUATION).  USE OVERALL MEAN AS STARTING VALUE.
24135C
24136      AE=1.E-6
24137      RE=1.E-6
24138      IFLAG=0
24139      XLOW=X1(1)
24140      XUP=X1(NK-1)
24141      CALL FZEROY(EXPFU2,XLOW,XUP,XMEAN,RE,AE,IFLAG,X1,Y)
24142      SCALML=XLOW
24143C
24144      IF(IFLAG.EQ.2)THEN
24145C
24146C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
24147CCCCC   WRITE(ICOUT,999)
24148CCCCC   CALL DPWRST('XXX','BUG ')
24149CCCCC   WRITE(ICOUT,111)
24150CC111   FORMAT('***** WARNING FROM GROUPED EXPONENTIAL MAXIMUM ',
24151CCCCC1         'LIKELIHOOD--')
24152CCCCC   CALL DPWRST('XXX','BUG ')
24153CCCCC   WRITE(ICOUT,113)
24154CC113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
24155CCCCC1         'DESIRED TOLERANCE.')
24156CCCCC   CALL DPWRST('XXX','BUG ')
24157      ELSEIF(IFLAG.EQ.3)THEN
24158        WRITE(ICOUT,999)
24159        CALL DPWRST('XXX','BUG ')
24160        WRITE(ICOUT,121)
24161  121   FORMAT('***** WARNING FROM GROUPED EXPONENTIAL MAXIMUM ',
24162     1         'LIKELIHOOD--')
24163        CALL DPWRST('XXX','BUG ')
24164        WRITE(ICOUT,123)
24165  123   FORMAT('      ESTIMATE OF SIGMA MAY BE NEAR A SINGULAR POINT.')
24166        CALL DPWRST('XXX','BUG ')
24167      ELSEIF(IFLAG.EQ.4)THEN
24168        WRITE(ICOUT,999)
24169        CALL DPWRST('XXX','BUG ')
24170        WRITE(ICOUT,131)
24171  131   FORMAT('***** ERROR FROM GROUPED EXPONENTIAL MAXIMUM ',
24172     1         'LIKELIHOOD--')
24173        CALL DPWRST('XXX','BUG ')
24174        WRITE(ICOUT,133)
24175  133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
24176        CALL DPWRST('XXX','BUG ')
24177      ELSEIF(IFLAG.EQ.5)THEN
24178        WRITE(ICOUT,999)
24179        CALL DPWRST('XXX','BUG ')
24180        WRITE(ICOUT,141)
24181  141   FORMAT('***** WARNING FROM GROUPED EXPONENTIAL MAXIMUM ',
24182     1         'LIKELIHOOD--')
24183        CALL DPWRST('XXX','BUG ')
24184        WRITE(ICOUT,143)
24185  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
24186        CALL DPWRST('XXX','BUG ')
24187      ENDIF
24188C
24189      AN=REAL(NTOT)
24190      DSIGMA=DBLE(SCALML)
24191      DSUM1=0.0D0
24192      DO150I=2,NK
24193        DX1=DBLE(X1(I))
24194        DX2=DBLE(X1(I-1))
24195        DTERM1=(DX1-DX2)**2/(DEXP(DX1/DSIGMA) - DEXP(DX2/DSIGMA))
24196        DSUM1=DSUM1 + DTERM1
24197  150 CONTINUE
24198      SCALSE=SQRT(AN*REAL(DSUM1))
24199C
24200 9000 CONTINUE
24201      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PML4')THEN
24202        WRITE(ICOUT,999)
24203        CALL DPWRST('XXX','WRIT')
24204        WRITE(ICOUT,9011)
24205 9011   FORMAT('**** AT THE END OF EXPML4--')
24206        CALL DPWRST('XXX','WRIT')
24207        WRITE(ICOUT,9012)XMEAN,XSD,XMIN,XMAX
24208 9012   FORMAT('XMEAN,XSD,XMIN,XMAX = ',4G15.7)
24209        CALL DPWRST('XXX','WRIT')
24210        WRITE(ICOUT,9013)SCALML,SCALSE
24211 9013   FORMAT('SCALML,SCALSE = ',2G15.7)
24212        CALL DPWRST('XXX','WRIT')
24213      ENDIF
24214C
24215      RETURN
24216      END
24217      SUBROUTINE EXPPDF(X,PDF)
24218C
24219C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
24220C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
24221C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
24222C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
24223C              AND HAS THE PROBABILITY DENSITY FUNCTION
24224C              F(X) = EXP(-X).
24225C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
24226C                                WHICH THE PROBABILITY DENSITY
24227C                                FUNCTION IS TO BE EVALUATED.
24228C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
24229C                                DENSITY FUNCTION VALUE.
24230C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
24231C             FUNCTION VALUE PDF.
24232C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
24233C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
24234C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
24235C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
24236C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
24237C     LANGUAGE--ANSI FORTRAN.
24238C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
24239C                 DISTRIBUTIONS--1, 1970, PAGES 207-232.
24240C     WRITTEN BY--JAMES J. FILLIBEN
24241C                 STATISTICAL ENGINEERING LABORATORY (205.03)
24242C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24243C                 GAITHERSBURG, MD 20899
24244C                 PHONE:  301-921-2315
24245C     ORIGINAL VERSION--APRIL     1994.
24246C
24247C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24248C
24249C-----COMMON----------------------------------------------------------
24250C
24251      INCLUDE 'DPCOP2.INC'
24252C
24253C---------------------------------------------------------------------
24254C
24255C     CHECK THE INPUT ARGUMENTS FOR ERRORS
24256C
24257      IF(X.LT.0.0)THEN
24258        WRITE(ICOUT,4)
24259        CALL DPWRST('XXX','BUG ')
24260        WRITE(ICOUT,46)X
24261        CALL DPWRST('XXX','BUG ')
24262        PDF=0.0
24263      ELSE
24264        PDF=EXP(-X)
24265      ENDIF
24266    4 FORMAT('***** WARNING--THE FIRST ARGUMENT TO EXPPDF IS NEGATIVE.')
24267   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
24268C
24269      RETURN
24270      END
24271      SUBROUTINE EXPPPF(P,PPF)
24272C
24273C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
24274C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
24275C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
24276C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
24277C              AND HAS THE PROBABILITY DENSITY FUNCTION
24278C              F(X) = EXP(-X).
24279C              NOTE THAT THE PERCENT POINT FUNCTION OF A DISTRIBUTION
24280C              IS IDENTICALLY THE SAME AS THE INVERSE CUMULATIVE
24281C              DISTRIBUTION FUNCTION OF THE DISTRIBUTION.
24282C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
24283C                                (BETWEEN 0.0 AND 1.0)
24284C                                AT WHICH THE PERCENT POINT
24285C                                FUNCTION IS TO BE EVALUATED.
24286C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT
24287C                                POINT FUNCTION VALUE.
24288C     OUTPUT--THE SINGLE PRECISION PERCENT POINT
24289C             FUNCTION VALUE PPF.
24290C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
24291C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
24292C                   AND 1.0 (EXCLUSIVELY).
24293C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
24294C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG.
24295C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
24296C     LANGUAGE--ANSI FORTRAN (1977)
24297C     REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION
24298C                 OF THE LOCATION PARAMETER OF A SYMMETRIC
24299C                 DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION,
24300C                 PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231.
24301C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
24302C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
24303C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
24304C                 DISTRIBUTIONS--1, 1970, PAGES 207-232.
24305C     WRITTEN BY--JAMES J. FILLIBEN
24306C                 STATISTICAL ENGINEERING DIVISION
24307C                 INFORMATION TECHNOLOGY LABORATORY
24308C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24309C                 GAITHERSBURG, MD 20899
24310C                 PHONE--301-975-2855
24311C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24312C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
24313C     LANGUAGE--ANSI FORTRAN (1966)
24314C     VERSION NUMBER--82/7
24315C     ORIGINAL VERSION--JUNE      1972.
24316C     UPDATED         --SEPTEMBER 1975.
24317C     UPDATED         --NOVEMBER  1975.
24318C     UPDATED         --DECEMBER  1981.
24319C     UPDATED         --MAY       1982.
24320C
24321C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24322C
24323C-----COMMON----------------------------------------------------------
24324C
24325      INCLUDE 'DPCOP2.INC'
24326C
24327C-----START POINT-----------------------------------------------------
24328C
24329C     CHECK THE INPUT ARGUMENTS FOR ERRORS
24330C
24331      IF(P.LT.0.0.OR.P.GE.1.0)THEN
24332        WRITE(ICOUT,1)
24333        CALL DPWRST('XXX','BUG ')
24334        WRITE(ICOUT,46)P
24335        CALL DPWRST('XXX','BUG ')
24336      ELSE
24337        PPF=-LOG(1.0-P)
24338      ENDIF
24339    1 FORMAT('***** ERROR--THE FIRST ARGUMENT TO EXPPPF IS OUTSIDE ',
24340     1       'THE ALLOWABLE (0,1) INTERVAL.')
24341   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
24342C
24343      RETURN
24344      END
24345      SUBROUTINE EXPRAN(N,ISEED,X)
24346C
24347C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
24348C              FROM THE EXPONENTIAL DISTRIBUTION
24349C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
24350C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
24351C              AND HAS THE PROBABILITY DENSITY FUNCTION
24352C              F(X) = EXP(-X).
24353C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
24354C                                OF RANDOM NUMBERS TO BE
24355C                                GENERATED.
24356C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
24357C                                (OF DIMENSION AT LEAST N)
24358C                                INTO WHICH THE GENERATED
24359C                                RANDOM SAMPLE WILL BE PLACED.
24360C     OUTPUT--A RANDOM SAMPLE OF SIZE N
24361C             FROM THE EXPONENTIAL DISTRIBUTION
24362C             WITH MEAN = 1 AND STANDARD DEVIATION = 1.
24363C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
24364C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
24365C                   OF N FOR THIS SUBROUTINE.
24366C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
24367C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG.
24368C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
24369C     LANGUAGE--ANSI FORTRAN (1977)
24370C     REFERENCES--TOCHER, THE ART OF SIMULATION,
24371C                 1963, PAGES 14, 35-36.
24372C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
24373C                 1964, PAGE 36.
24374C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
24375C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
24376C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
24377C                 DISTRIBUTIONS--1, 1970, PAGES 207-232.
24378C               --HASTINGS AND PEACOCK, STATISTICAL
24379C                 DISTRIBUTIONS--A HANDBOOK FOR
24380C                 STUDENTS AND PRACTITIONERS, 1975,
24381C                 PAGE 58.
24382C     WRITTEN BY--JAMES J. FILLIBEN
24383C                 STATISTICAL ENGINEERING DIVISION
24384C                 INFORMATION TECHNOLOGY LABORATORY
24385C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24386C                 GAITHERSBURG, MD 20899
24387C                 PHONE--301-975-2855
24388C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24389C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
24390C     LANGUAGE--ANSI FORTRAN (1966)
24391C     VERSION NUMBER--82/7
24392C     ORIGINAL VERSION--JUNE      1972.
24393C     UPDATED         --SEPTEMBER 1975.
24394C     UPDATED         --NOVEMBER  1975.
24395C     UPDATED         --JULY      1976.
24396C     UPDATED         --DECEMBER  1981.
24397C     UPDATED         --MAY       1982.
24398C
24399C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24400C
24401C---------------------------------------------------------------------
24402C
24403      DIMENSION X(*)
24404C
24405C-----COMMON----------------------------------------------------------
24406C
24407      INCLUDE 'DPCOP2.INC'
24408C
24409C-----START POINT-----------------------------------------------------
24410C
24411C     CHECK THE INPUT ARGUMENTS FOR ERRORS
24412C
24413      IF(N.LT.1)THEN
24414        WRITE(ICOUT, 5)
24415        CALL DPWRST('XXX','BUG ')
24416        WRITE(ICOUT,47)N
24417        CALL DPWRST('XXX','BUG ')
24418        GOTO9000
24419      ENDIF
24420    5 FORMAT('***** ERROR--THE FIRST ARGUMENT TO THE ',
24421     1       'EXPRAN SUBROUTINE IS NON-POSITIVE.')
24422   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,'.')
24423C
24424C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
24425C
24426      CALL UNIRAN(N,ISEED,X)
24427C
24428C     GENERATE N EXPONENTIAL RANDOM NUMBERS
24429C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
24430C
24431      DO100I=1,N
24432        X(I)=-LOG(X(I))
24433  100 CONTINUE
24434C
24435 9000 CONTINUE
24436      RETURN
24437      END
24438      SUBROUTINE EXPSF(P,SF)
24439C
24440C     PURPOSE--THIS SUBROUTINE COMPUTES THE SPARSITY
24441C              FUNCTION VALUE FOR THE EXPONENTIAL DISTRIBUTION
24442C              WITH MEAN = 1 AND STANDARD DEVIATION = 1.
24443C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X,
24444C              AND HAS THE PROBABILITY DENSITY FUNCTION
24445C              F(X) = EXP(-X).
24446C              NOTE THAT THE SPARSITY FUNCTION OF A DISTRIBUTION
24447C              IS THE DERIVATIVE OF THE PERCENT POINT FUNCTION,
24448C              AND ALSO IS THE RECICOUTOCAL OF THE PROBABILITY
24449C              DENSITY FUNCTION (BUT IN UNITS OF P RATHER THAN X).
24450C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
24451C                                (BETWEEN 0.0 AND 1.0)
24452C                                AT WHICH THE SPARSITY
24453C                                FUNCTION IS TO BE EVALUATED.
24454C     OUTPUT ARGUMENTS--SF     = THE SINGLE PRECISION
24455C                                SPARSITY FUNCTION VALUE.
24456C     OUTPUT--THE SINGLE PRECISION SPARSITY
24457C             FUNCTION VALUE SF.
24458C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
24459C     RESTRICTIONS--P SHOULD BE BETWEEN 0.0 (INCLUSIVELY)
24460C                   AND 1.0 (EXCLUSIVELY).
24461C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
24462C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
24463C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
24464C     LANGUAGE--ANSI FORTRAN.
24465C     REFERENCES--FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION
24466C                 OF THE LOCATION PARAMETER OF A SYMMETRIC
24467C                 DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION,
24468C                 PRINCETON UNIVERSITY), 1969, PAGES 21-44, 229-231.
24469C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
24470C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
24471C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
24472C                 DISTRIBUTIONS--1, 1970, PAGES 207-232.
24473C     WRITTEN BY--JAMES J. FILLIBEN
24474C                 STATISTICAL ENGINEERING LABORATORY (205.03)
24475C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24476C                 GAITHERSBURG, MD 20899
24477C                 PHONE:  301-921-2315
24478C     ORIGINAL VERSION--APRIL     1994.
24479C
24480C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24481C
24482C-----COMMON----------------------------------------------------------
24483C
24484      INCLUDE 'DPCOP2.INC'
24485C
24486C---------------------------------------------------------------------
24487C
24488C     CHECK THE INPUT ARGUMENTS FOR ERRORS
24489C
24490      IF(P.LT.0.0.OR.P.GE.1.0)THEN
24491        WRITE(ICOUT,1)
24492        CALL DPWRST('XXX','BUG ')
24493        WRITE(ICOUT,46)P
24494        CALL DPWRST('XXX','BUG ')
24495      ELSE
24496        SF=1.0/(1.0-P)
24497      ENDIF
24498    1 FORMAT('***** ERROR--THE FIRST ARGUMENT TO EXPSF IS OUTSIDE ',
24499     1       'THE ALLOWABLE (0,1) INTERVAL.')
24500   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7,'.')
24501C
24502      RETURN
24503      END
24504      SUBROUTINE EXPSMO(X,TEMP,ALPHA,AMSE,NX,IWRITE,Y,IBUGA3,IERROR)
24505C
24506C     PURPOSE--COMPUTE EXPONETIAL SMOOTH OF AN ARRAY
24507C              THE ALPHA PARANETER IDENTIFIES THE SMOOTHING PARAMETER
24508C     NOTE--IT IS PERMISSIBLE TO HAVE THE OUTPUT VECTOR Y(.)
24509C           BEING IDENTICAL TO THE INPUT VECTOR X(.).
24510C     WRITTEN BY--JAMES J. FILLIBEN
24511C                 STATISTICAL ENGINEERING DIVISION
24512C                 INFORMATION TECHNOLOGY LABORATORY
24513C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24514C                 GAITHERSBURG, MD 20899
24515C                 PHONE--301-975-2855
24516C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24517C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
24518C     LANGUAGE--ANSI FORTRAN (1977)
24519C     VERSION NUMBER--98/5
24520C     ORIGINAL VERSION--MAY       1998.
24521C
24522C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24523C
24524      CHARACTER*4 IWRITE
24525      CHARACTER*4 IBUGA3
24526      CHARACTER*4 IERROR
24527C
24528      CHARACTER*4 ISUBN1
24529      CHARACTER*4 ISUBN2
24530C
24531      DOUBLE PRECISION DSUM
24532C
24533C---------------------------------------------------------------------
24534C
24535      DIMENSION X(*)
24536      DIMENSION Y(*)
24537      DIMENSION TEMP(*)
24538C
24539C-----COMMON----------------------------------------------------------
24540C
24541      INCLUDE 'DPCOP2.INC'
24542C
24543C-----START POINT-----------------------------------------------------
24544C
24545      ISUBN1='EXPS'
24546      ISUBN2='MO  '
24547      IERROR='NO'
24548C
24549      IF(IBUGA3.EQ.'ON')THEN
24550        WRITE(ICOUT,999)
24551  999   FORMAT(1X)
24552        CALL DPWRST('XXX','BUG ')
24553        WRITE(ICOUT,51)
24554   51   FORMAT('***** AT THE BEGINNING OF EXPSMO--')
24555        CALL DPWRST('XXX','BUG ')
24556        WRITE(ICOUT,52)IBUGA3,IWRITE,N,ALPHA
24557   52   FORMAT('IBUGA3,IWRITE,N,ALPHA = ',2(A4,2X),I8,G15.7)
24558        CALL DPWRST('XXX','BUG ')
24559        DO55I=1,NX
24560          WRITE(ICOUT,56)I,X(I)
24561   56     FORMAT('I,X(I) = ',I8,G15.7)
24562          CALL DPWRST('XXX','BUG ')
24563   55   CONTINUE
24564      ENDIF
24565C
24566C               **************************************
24567C               **  COMPUTE EXPONENTIAL SMOOTH      **
24568C               **************************************
24569C
24570      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
24571        WRITE(ICOUT,999)
24572        CALL DPWRST('XXX','BUG ')
24573        WRITE(ICOUT,101)
24574  101   FORMAT('***** ERROR FROM EXPSMO.  SMOOTHING PARAMETER MUST')
24575        CALL DPWRST('XXX','BUG ')
24576        WRITE(ICOUT,103)
24577  103   FORMAT('      BE > 0 AND < 1.  THE ENTERED VALUE WAS ',E15.7)
24578        CALL DPWRST('XXX','BUG ')
24579        WRITE(ICOUT,999)
24580        CALL DPWRST('XXX','BUG ')
24581        IERROR='YES'
24582        GOTO9000
24583      ENDIF
24584C
24585      DSUM=0.0D0
24586      TEMP(1)=X(1)
24587      DO200I=2,NX
24588        ATEMP=X(I)-TEMP(I-1)
24589        TEMP(I)=ALPHA*ATEMP + TEMP(I-1)
24590        DSUM=DSUM + DBLE(ATEMP)**2
24591  200 CONTINUE
24592      AMSE=REAL(DSUM)/REAL(NX-1)
24593C
24594      DO300I=1,NX
24595        Y(I)=TEMP(I)
24596  300 CONTINUE
24597C
24598      NY=NX
24599C
24600C               *****************
24601C               **  STEP 90--  **
24602C               **  EXIT.      **
24603C               *****************
24604C
24605 9000 CONTINUE
24606C
24607      IF(IBUGA3.EQ.'OFF')GOTO9090
24608      WRITE(ICOUT,999)
24609      CALL DPWRST('XXX','BUG ')
24610      WRITE(ICOUT,9011)
24611 9011 FORMAT('***** AT THE END       OF EXPSMO--')
24612      CALL DPWRST('XXX','BUG ')
24613      WRITE(ICOUT,9012)IBUGA3,IERROR
24614 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
24615      CALL DPWRST('XXX','BUG ')
24616      WRITE(ICOUT,9013)NX,NY
24617 9013 FORMAT('NX,NY = ',2I8)
24618      CALL DPWRST('XXX','BUG ')
24619      DO9015I=1,NX
24620      WRITE(ICOUT,9016)I,X(I),Y(I)
24621 9016 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
24622      CALL DPWRST('XXX','BUG ')
24623 9015 CONTINUE
24624 9090 CONTINUE
24625C
24626      RETURN
24627      END
24628      SUBROUTINE EXPSM2(X,TEMP,ALPHA,AMSE,NX,IWRITE,Y,IBUGA3,IERROR)
24629C
24630C     PURPOSE--COMPUTE EXPONETIAL SMOOTH OF AN ARRAY
24631C              THE ALPHA PARANETER IDENTIFIES THE SMOOTHING PARAMETER
24632C              NOTE: USE THIS VERSION IF ALPHA NOT SPECIFIED.
24633C                    USE AN ITERATIVE SEARCH TO FIND THE OPTIMAL
24634C                    VALUE FOR ALPHA.
24635C     NOTE--IT IS PERMISSIBLE TO HAVE THE OUTPUT VECTOR Y(.)
24636C           BEING IDENTICAL TO THE INPUT VECTOR X(.).
24637C     WRITTEN BY--JAMES J. FILLIBEN
24638C                 STATISTICAL ENGINEERING DIVISION
24639C                 INFORMATION TECHNOLOGY LABORATORY
24640C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24641C                 GAITHERSBURG, MD 20899
24642C                 PHONE--301-975-2855
24643C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24644C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
24645C     LANGUAGE--ANSI FORTRAN (1977)
24646C     VERSION NUMBER--99/2
24647C     ORIGINAL VERSION--FEBRUARY  1999.
24648C
24649C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24650C
24651      CHARACTER*4 IWRITE
24652      CHARACTER*4 IBUGA3
24653      CHARACTER*4 IERROR
24654C
24655      CHARACTER*4 ISUBN1
24656      CHARACTER*4 ISUBN2
24657C
24658C---------------------------------------------------------------------
24659C
24660      DIMENSION X(*)
24661      DIMENSION Y(*)
24662      DIMENSION TEMP(*)
24663C
24664      REAL AMSEV(20)
24665C
24666C-----COMMON----------------------------------------------------------
24667C
24668      INCLUDE 'DPCOP2.INC'
24669C
24670C-----START POINT-----------------------------------------------------
24671C
24672      ISUBN1='EXPS'
24673      ISUBN2='MO  '
24674      IERROR='NO'
24675C
24676      AX=CPUMIN
24677C
24678      IF(IBUGA3.EQ.'OFF')GOTO90
24679      WRITE(ICOUT,999)
24680  999 FORMAT(1X)
24681      CALL DPWRST('XXX','BUG ')
24682      WRITE(ICOUT,51)
24683   51 FORMAT('***** AT THE BEGINNING OF EXPSM2--')
24684      CALL DPWRST('XXX','BUG ')
24685      WRITE(ICOUT,52)IBUGA3
24686   52 FORMAT('IBUGA3 = ',A4)
24687      CALL DPWRST('XXX','BUG ')
24688      WRITE(ICOUT,53)NX,ALPHA
24689   53 FORMAT('NX,ALPHA = ',I8,1X,F10.5)
24690      CALL DPWRST('XXX','BUG ')
24691      DO55I=1,NX
24692      WRITE(ICOUT,56)I,X(I)
24693   56 FORMAT('I,X(I) = ',I8,E15.7)
24694      CALL DPWRST('XXX','BUG ')
24695   55 CONTINUE
24696   90 CONTINUE
24697C
24698C               **************************************
24699C               **  COMPUTE EXPONENTIAL SMOOTH      **
24700C               **************************************
24701C
24702CCCCC FIND BEST ALPHA TO FIRST DECIMAL PLACE.
24703C
24704      AMNVAL=CPUMAX
24705      DO100I=1,9
24706        ALPHA=REAL(I)/10.
24707        CALL EXPSMO(X,TEMP,ALPHA,AMSE,NX,IWRITE,Y,IBUGA3,IERROR)
24708        AMSEV(I)=AMSE
24709        IF(AMSEV(I).LT.AMNVAL)THEN
24710          AX=ALPHA
24711          AMNVAL=AMSEV(I)
24712        ENDIF
24713  100 CONTINUE
24714      ALPHA=AX
24715C
24716CCCCC FIND BEST ALPHA TO FIRST DECIMAL PLACE.
24717C
24718      AMNVAL=CPUMAX
24719      D=0.09
24720      DINC=0.01
24721      ASTRT=ALPHA-D
24722      DO200I=1,19
24723        ALPHA=ASTRT+REAL(I-1)*DINC
24724        CALL EXPSMO(X,TEMP,ALPHA,AMSE,NX,IWRITE,Y,IBUGA3,IERROR)
24725        AMSEV(I)=AMSE
24726        IF(AMSEV(I).LT.AMNVAL)THEN
24727          AX=ALPHA
24728          AMNVAL=AMSEV(I)
24729        ENDIF
24730  200 CONTINUE
24731      ALPHA=AX
24732C
24733CCCCC FIND BEST ALPHA TO THIRD DECIMAL PLACE.
24734C
24735      AMNVAL=CPUMAX
24736      D=0.009
24737      DINC=0.001
24738      ASTRT=ALPHA-D
24739      DO300I=1,19
24740        ALPHA=ASTRT+REAL(I-1)*DINC
24741        CALL EXPSMO(X,TEMP,ALPHA,AMSE,NX,IWRITE,Y,IBUGA3,IERROR)
24742        AMSEV(I)=AMSE
24743        IF(AMSEV(I).LT.AMNVAL)THEN
24744          AX=ALPHA
24745          AMNVAL=AMSEV(I)
24746        ENDIF
24747  300 CONTINUE
24748      ALPHA=AX
24749C
24750      IF(IWRITE.EQ.'ON')THEN
24751        WRITE(ICOUT,999)
24752        CALL DPWRST('XXX','BUG ')
24753        WRITE(ICOUT,510)ALPHA
24754  510   FORMAT('FOR EXPONENTIAL SMOOTHING, OPTIMAL VALUE OF ALPHA',
24755     1         '(TO 3 DECIMAL PLACES) = ',F6.3)
24756        CALL DPWRST('XXX','BUG ')
24757      ENDIF
24758C
24759C               *****************
24760C               **  STEP 90--  **
24761C               **  EXIT.      **
24762C               *****************
24763C
24764      IF(IBUGA3.EQ.'OFF')GOTO9090
24765      WRITE(ICOUT,999)
24766      CALL DPWRST('XXX','BUG ')
24767      WRITE(ICOUT,9011)
24768 9011 FORMAT('***** AT THE END       OF EXPSM2--')
24769      CALL DPWRST('XXX','BUG ')
24770      WRITE(ICOUT,9012)IBUGA3,IERROR
24771 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
24772      CALL DPWRST('XXX','BUG ')
24773      WRITE(ICOUT,9013)NX
24774 9013 FORMAT('NX = ',I8)
24775      CALL DPWRST('XXX','BUG ')
24776      DO9015I=1,NX
24777      WRITE(ICOUT,9016)I,X(I),Y(I)
24778 9016 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
24779      CALL DPWRST('XXX','BUG ')
24780 9015 CONTINUE
24781 9090 CONTINUE
24782C
24783      RETURN
24784      END
24785      SUBROUTINE EXTBOU(ICASPL,IBOUND)
24786C
24787C     PURPOSE--CERTAIN OF THE PROBABILITY ROUTINES USE LOWER AND
24788C              UPPER LIMIT PARAMETERS RATHER THAN LOCATION AND
24789C              SCALE PARAMETERS.  SET THE VALUE OF IBOUND TO 0
24790C              IF LOCATION AND SCALE PARAMETERS WILL BE USED AND
24791C              TO 1 IF LOWER AND UPPER LIMIT PARAMETERS WILL BE USED.
24792C     WRITTEN BY--JAMES J. FILLIBEN
24793C                 STATISTICAL ENGINEERING DIVISION
24794C                 INFORMATION TECHNOLOGY LABORAOTRY
24795C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
24796C                 GAITHERSBURG, MD 20899-8980
24797C                 PHONE--301-975-2855
24798C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24799C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
24800C     LANGUAGE--ANSI FORTRAN (1977)
24801C     VERSION NUMBER--2009/9
24802C     ORIGINAL VERSION--SEPTEMBER 2009.
24803C
24804C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24805C
24806      CHARACTER*4 ICASPL
24807C
24808C---------------------------------------------------------------------
24809C
24810C-----COMMON VARIABLES (GENERAL)--------------------------------------
24811C
24812      INCLUDE 'DPCOP2.INC'
24813C
24814      IBOUND=0
24815      IF(ICASPL.EQ.'UNIF')IBOUND=1
24816      IF(ICASPL.EQ.'BETA')IBOUND=1
24817      IF(ICASPL.EQ.'NCBE')IBOUND=1
24818      IF(ICASPL.EQ.'TRIA')IBOUND=1
24819      IF(ICASPL.EQ.'POWF')IBOUND=1
24820      IF(ICASPL.EQ.'RPOW')IBOUND=1
24821      IF(ICASPL.EQ.'JOSB')IBOUND=1
24822      IF(ICASPL.EQ.'TSPO')IBOUND=1
24823      IF(ICASPL.EQ.'GTOL')IBOUND=1
24824      IF(ICASPL.EQ.'RGTL')IBOUND=1
24825      IF(ICASPL.EQ.'SLOP')IBOUND=1
24826      IF(ICASPL.EQ.'OGIV')IBOUND=1
24827      IF(ICASPL.EQ.'TSSL')IBOUND=1
24828      IF(ICASPL.EQ.'TSOG')IBOUND=1
24829      IF(ICASPL.EQ.'KUMA')IBOUND=1
24830C
24831      RETURN
24832      END
24833      SUBROUTINE EXTDIG(IINPUT,IDIGIT,NDIGIT,IBUGA3,IERROR)
24834C
24835C     PURPOSE--EXTRACT THE DIGITS FROM AN INTEGER.
24836C              PROCEED LEFT TO RIGHT.
24837C     INPUT  ARGUMENTS--  IINPUT = AN INTEGER
24838C     OUTPUT ARGUMENTS--  IDIGIT   = VECTOR OF DIGITS
24839C                         NDIGIT   = NUMBER OF ELEMENTS IN IDIGIT
24840C     WRITTEN BY--JAMES J. FILLIBEN
24841C                 STATISTICAL ENGINEERING DIVISION
24842C                 INFORMATION TECHNOLOGY LABORATORY
24843C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24844C                 GAITHERSBURG, MD 20899
24845C                 PHONE--301-975-2855
24846C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24847C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
24848C     LANGUAGE--ANSI FORTRAN (1966)
24849C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
24850C                          DENOTED BY QUOTES RATHER THAN NH.
24851C     VERSION NUMBER--89.1
24852C     ORIGINAL VERSION--JANUARY   1989.
24853C
24854C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24855C
24856      CHARACTER*4 IBUGA3
24857      CHARACTER*4 IERROR
24858C
24859C---------------------------------------------------------------------
24860C
24861      DIMENSION IDIGIT(*)
24862C
24863C-----COMMON----------------------------------------------------------
24864C
24865      INCLUDE 'DPCOP2.INC'
24866C
24867C-----START POINT-----------------------------------------------------
24868C
24869      IERROR='NO'
24870      NDIGIT=0
24871C
24872      IF(IBUGA3.EQ.'OFF')GOTO90
24873      WRITE(ICOUT,999)
24874  999 FORMAT(1X)
24875      CALL DPWRST('XXX','BUG ')
24876      WRITE(ICOUT,51)
24877   51 FORMAT('***** AT THE BEGINNING OF EXTDIG--')
24878      CALL DPWRST('XXX','BUG ')
24879      WRITE(ICOUT,52)IINPUT
24880   52 FORMAT('IINPUT = ',I8)
24881      CALL DPWRST('XXX','BUG ')
24882      WRITE(ICOUT,53)IBUGA3
24883   53 FORMAT('IBUGA3 = ',A4)
24884      CALL DPWRST('XXX','BUG ')
24885   90 CONTINUE
24886C
24887C               **************************************************
24888C               **  STEP 11--                                   **
24889C               **  CHECK THE INPUT NUMBER FOR ERRORS           **
24890C               **************************************************
24891C
24892      IF(IINPUT.GE.0)GOTO1190
24893      WRITE(ICOUT,999)
24894      CALL DPWRST('XXX','BUG ')
24895      WRITE(ICOUT,1111)
24896 1111 FORMAT('***** ERROR IN EXTDIG--')
24897      CALL DPWRST('XXX','BUG ')
24898      WRITE(ICOUT,1112)
24899 1112 FORMAT('      THE INPUT NUMBER WAS NEGATIVE.')
24900      CALL DPWRST('XXX','BUG ')
24901      WRITE(ICOUT,1113)IINPUT
24902 1113 FORMAT('      THE INPUT NUMBER = ',I8)
24903      CALL DPWRST('XXX','BUG ')
24904      IERROR='YES'
24905      GOTO9000
24906 1190 CONTINUE
24907C
24908C               **************************************************
24909C               **  STEP 12--                                   **
24910C               **  DETERMINE THE NUMBER OF DIGITS              **
24911C               **  IN THE NUMBER                               **
24912C               **************************************************
24913C
24914      MAXDIG=9
24915      IREM=IINPUT
24916      DO1200I=1,MAXDIG
24917        IREV=MAXDIG-I+1
24918        IPOWER=INT(10.0**IREV + 0.0001)
24919        IRATIO=IREM/IPOWER
24920        IF(IRATIO.EQ.0)GOTO1200
24921        GOTO1290
24922 1200 CONTINUE
24923      IREV=0
24924 1290 CONTINUE
24925      NDIGIT=IREV+1
24926C
24927C               **************************************************
24928C               **  STEP 13--                                   **
24929C               **  EXTRACT THE INDIVIDUAL DIGITS               **
24930C               **************************************************
24931C
24932      IREM=IINPUT
24933      J=0
24934      DO1300I=1,NDIGIT
24935      J=J+1
24936      IREV=NDIGIT-I+1
24937      IPOWER=INT(10**(IREV-1) + 0.01)
24938      IDIGIT(I)=IREM/IPOWER
24939      IREM=IREM-IDIGIT(I)*IPOWER
24940 1300 CONTINUE
24941C
24942C               *******************
24943C               **   STEP 90--   **
24944C               **   EXIT        **
24945C               *******************
24946C
24947 9000 CONTINUE
24948      IF(IBUGA3.EQ.'OFF')GOTO9090
24949      WRITE(ICOUT,999)
24950      CALL DPWRST('XXX','BUG ')
24951      WRITE(ICOUT,9011)
24952 9011 FORMAT('***** AT THE END       OF EXTDIG--')
24953      CALL DPWRST('XXX','BUG ')
24954      WRITE(ICOUT,9012)IINPUT
24955 9012 FORMAT('IINPUT = ',I8)
24956      CALL DPWRST('XXX','BUG ')
24957      WRITE(ICOUT,9013)IBUGA3,IERROR
24958 9013 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
24959      CALL DPWRST('XXX','BUG ')
24960      WRITE(ICOUT,9021)NDIGIT
24961 9021 FORMAT('NDIGIT = ',I8)
24962      CALL DPWRST('XXX','BUG ')
24963      IF(NDIGIT.LE.0)GOTO9024
24964      DO9022I=1,NDIGIT
24965      WRITE(ICOUT,9023)I,IDIGIT(I)
24966 9023 FORMAT('I,IDIGIT(I) = ',2I8)
24967      CALL DPWRST('XXX','BUG ')
24968 9022 CONTINUE
24969 9024 CONTINUE
24970 9090 CONTINUE
24971C
24972      RETURN
24973      END
24974      SUBROUTINE EXTDIS(ICOM,ICOM2,IHARG,IHARG2,NUMARG,JMIN,JMAX,
24975     1                  IDISCS,IDISNM,IDISPR,IFOUND,ILOCV,
24976     1                  ISUBRO,IBUGG3,IERROR)
24977C
24978C     PURPOSE--EXTRACT THE NAME OF ONE OF 150+ DISTRIBUTIONS.  THIS
24979C              IS A COMMON ROUTINE CALLED BY:
24980C                1) DPPP    = <DIST> PROBABILITY PLOT
24981C                2) DP1KST  = <DIST> KOLMOGOROV SMIRNOV GOODNESS OF FIT
24982C                3) DPCHSQ  = <DIST> CHI-SQUARE SMIRNOV GOODNESS OF FIT
24983C                4) DPPPCC  = <DIST> PPCC PLOT
24984C                5) DPMLWE  = <DIST> MAXIMUM LIKELIHOOD
24985C                6) DPLRDI  = <DIST1> <DIST2> DISTRIBUTIONAL LIKELIHOOD
24986C                                             RATIO
24987C
24988C              NOTE THAT NOT ALL COMMANDS MAY SUPPORT ALL DISTRIBUTIONS.
24989C
24990C              THE FOLLOWING DISTRIBUTIONS ARE SUPPORTED:
24991C
24992C              1 ) UNIFORM
24993C              2 ) NORMAL
24994C              3 ) LOGISTIC
24995C              4 ) DOUBLE EXPONENTIAL
24996C              5 ) CAUCHY
24997C              6 ) TUKEY LAMBDA
24998C              7 ) LOGNORMAL
24999C              8 ) HALFNORMAL
25000C              9 ) T
25001C              10) CHI-SQUARED
25002C              11) F
25003C              12) EXPONENTIAL
25004C              13) GAMMA
25005C              14) BETA
25006C              15) WEIBULL---MIN & MAX
25007C              16) EXTREME VALUE TYPE 1 (GUMBEL)--MIN & MAX
25008C              17) EXTREME VALUE TYPE 2 (FRECHET)--MIN & MAX
25009C              18) PARETO
25010C              19) BINOMIAL
25011C              20) GEOMETRIC
25012C              21) POISSON
25013C              22) NEGATIVE BINOMIAL
25014C              23) SEMI-CIRCULAR
25015C              24) TRIANGULAR
25016C              25) INVERSE GAUUSIAN
25017C              26) WALD
25018C              27) RECIPROCAL INVERSE GAUUSIAN
25019C              28) FAILURE TIME
25020C              29) GENERALIZED PARETO
25021C              30) DISCRETE UNIFORM
25022C              31) NON-CENTRAL T
25023C              32) NON-CENTRAL F
25024C              33) NON-CENTRAL CHI-SQUARE
25025C              34) NON-CENTRAL BETA
25026C              35) DOUBLY NON-CENTRAL T
25027C              36) DOUBLY NON-CENTRAL F
25028C              36) HYPER-GEOMETRIC
25029C              37) VON-MISES
25030C              38) POWER NORMAL
25031C              39) POWER LOGNORMAL
25032C              40) COSINE
25033C              41) ALPHA
25034C              42) POWER FUNCTION
25035C              43) CHI
25036C              44) LOGARITMIC SERIES
25037C              45) LOG LOGISTIC
25038C              46) GENERALIZED GAMMA
25039C              47) WARING
25040C              48) ANGLIT
25041C              49) ARCSIN
25042C              50) FOLDED NORMAL
25043C              51) TRUNCATED NORMAL
25044C              52) LOG GAMMA
25045C              53) HYPERBOLIC SECANT
25046C              54) GOMPERTZ
25047C              55) PARETO SECOND KIND
25048C              56) DOUBLE WEIBULL
25049C              57) WRAPPED-UP CAUCHY
25050C              58) EXPONENTIAL WEIBULL
25051C              59) TRUNCATED EXPONENTIAL
25052C              60) GENERALIZED LOGISTIC
25053C              61) EXPONENTIAL POWER
25054C              62) DOUBLE GAMMA
25055C              63) MIELKE'S BETA-KAPPA
25056C              64) FOLDED CAUCHY
25057C              65) BETA BINOMIAL
25058C              66) BETA PASCAL
25059C              67) GENERALIZED EXPONENTIAL
25060C              68) RECIPROCAL PROB
25061C              69) NORMAL MIXTURE
25062C              70) INVERTED GAMMA
25063C              71) GENERALIZED TUKEY LAMBDA
25064C              72) JOHNSON SB
25065C              73) JOHNSON SU
25066C              74) INVERTED WEIBULL
25067C              75) LOG DOUBLE EXPONENTIAL
25068C              76) GEOMETRIC EXTREME EXPONENTIAL
25069C              77) TWO-SIDED POWER
25070C              78) BIWEIBULL
25071C              79) G-AND-H
25072C              80) LANDAU
25073C              81) ERROR
25074C              82) TRAPEZOID
25075C              83) GENERALIZED TRAPEZOID
25076C              84) FOLDED T
25077C              85) SLASH
25078C              86) SKEWED NORMAL
25079C              87) SKEWED T
25080C              88) INVERTED BETA
25081C              89) GOMPERTZ-MAKEHAM
25082C              90) LOG-SKEW-NORMAL
25083C              91) LOG-SKEW-T
25084C              92) GENERALIZED HALF-LOGISTIC
25085C              93) POLYA
25086C              94) HERMITE
25087C              95) YULE
25088C              96) SKEW DOUBLE EXPONENTIAL
25089C              97) ASYMMETRIC DOUBLE EXPONENTIAL
25090C              98) MAXWELL
25091C              99) RAYLEIGH
25092C             100) GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL
25093C             101) GENERALIZED INVERSE GAUSSIAN
25094C             102) MCLEISH
25095C             103) BESSEL I FUNCTION
25096C             104) BESSEL K FUNCTION
25097C             105) GENERALIZED MCLEISH
25098C             106) HYPERBOLIC
25099C             107) GENERALIZED LOGISTIC TYPE 5
25100C             108) GENERALIZED LOGISTIC TYPE 2
25101C             109) WAKEB
25102C             110) BETA NORMAL
25103C             111) GENERALIZED LOGISTIC TYPE 3
25104C             114) GENERALIZED LOGISTIC TYPE 4
25105C             115) ASYMMETRIC LOG DOUBLE EXPONENTIAL
25106C             116) BETA GEOMETRIC
25107C             117) ZETA
25108C             118) ZIPF
25109C             118) BOREL-TANNER
25110C             119) BETA NEGATIVE BINOMIAL
25111C             120) LAGRANGE POISON
25112C             121) LEADS IN COIN TOSSING (DISCRETE ARCSINE)
25113C             122) MATCHING
25114C             123) LOST GAMES
25115C             124) LOG BETA
25116C             125) POLYA AEPPLI
25117C             126) CLASSICAL OCCUPANCY (NOT ACTIVE)
25118C             127) GENERALIZED LOGARITHMIC SERIES
25119C             128) GENERALIZED NEGATIVE BINOMIAL
25120C             129) GEETA
25121C             130) QUASI BINOMIAL TYPE I
25122C             131) CONSUL (GENERALIZED GEOMETRIC)
25123C             132) LAGRANGE KATZ (NOT ACTIVE)
25124C             133) KATZ
25125C             134) DISCRETE WEIBULL
25126C             135) GENERALIZED LOST GAMES
25127C             136) TRUNCATED GENERALIZED NEGATIVE BINOMIAL
25128C             137) TOPP AND LEONE
25129C             138) GENERALIZED TOPP AND LEONE
25130C             139) REFLECTED GENERALIZED TOPP AND LEONE
25131C             140) SLOPE
25132C             141) TWO-SIDED SLOPE
25133C             142) OGIVE
25134C             143) TWO-SIDED OGIVE
25135C             144) UNEVEN TWO-SIDED POWER
25136C             145) DOUBLY UNIFORM PARETO
25137C             146) BURR TYPE 1 (= UNIFORM)
25138C             147) BURR TYPE 2
25139C             148) BURR TYPE 3
25140C             149) BURR TYPE 4
25141C             150) BURR TYPE 5
25142C             151) BURR TYPE 6
25143C             152) BURR TYPE 7
25144C             153) BURR TYPE 8
25145C             154) BURR TYPE 9
25146C             155) BURR TYPE 10
25147C             156) BURR TYPE 11
25148C             157) BURR TYPE 12
25149C             158) KUMARASWAMY
25150C             159) REFLECTED POWER
25151C             160) MUTH
25152C             161) LOGISTIC-EXPONENTIAL
25153C             162) TRUNCATED PARETO
25154C             163) BRITTLE FRACTURE
25155C             164) 3-PARAMETER LOGISTIC-EXPONENTIAL
25156C             165) KAPPA
25157C             166) PEARSON TYPE 3
25158C             167) POWER LAW
25159C             168) END EFFECTS WEIBULL
25160C             169) BRITTLE FIBER WEIBULL
25161C             170) ARCTANGENT
25162C             171) SINE
25163C             172) G
25164C             173) H
25165C
25166C     WRITTEN BY--ALAN HECKERT
25167C                 STATISTICAL ENGINEERING DIVISION
25168C                 INFORMATION TECHNOLOGY LABORATORY
25169C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
25170C                 GAITHERSBURG, MD 20899-8980
25171C                 PHONE--301-975-2899
25172C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
25173C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
25174C     LANGUAGE--ANSI FORTRAN (1977)
25175C     VERSION NUMBER--2009/8
25176C     ORIGINAL VERSION--AUGUST    2009.
25177C     UPDATED         --JUNE      2010. DISTINGUISH 2-PARAMETER AND
25178C                                       3-PARAMETER CASES FOR:
25179C                                       WEIBULL, LOGNORMAL, GAMMA,
25180C                                       INVERSE GAUSSIAN, INVERTED WEIBULL
25181C     UPDATED         --JULY      2010. DISTINGUISH 2-PARAMETER AND 1-PARAMETER
25182C                                       FOR EXPONENTIAL, RAYLEIGH, MAXWELL
25183C     UPDATED         --JULY      2010. END EFFECTS WEIBULL
25184C     UPDATED         --AUGUST    2010. BRITTLE FIBER WEIBULL
25185C     UPDATED         --JANUARY   2011. ARCTANGENT
25186C     UPDATED         --MARCH     2013. SINE
25187C     UPDATED         --APRIL     2014. ADD "G" AND "H" AS DISTINCT
25188C                                       FROM "G AND H"
25189C     UPDATED         --SEPTEMBER 2014. DISTINGUISH 2-PARAMETER AND
25190C                                       3-PARAMETER CASES FOR FRECHET
25191C
25192C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
25193C
25194      CHARACTER*4 ICOM
25195      CHARACTER*4 ICOM2
25196      CHARACTER*4 IHARG(*)
25197      CHARACTER*4 IHARG2(*)
25198      CHARACTER*4 ISUBRO
25199      CHARACTER*4 IBUGG3
25200      CHARACTER*4 IERROR
25201C
25202      CHARACTER*4  IDISCS
25203      CHARACTER*60 IDISNM
25204      CHARACTER*4  IFOUND
25205C
25206      CHARACTER*4 IWRITE
25207      CHARACTER*4 ISUBN1
25208      CHARACTER*4 ISUBN2
25209C
25210C---------------------------------------------------------------------
25211C
25212      PARAMETER (MAXDIS=329)
25213      PARAMETER (MAXSCL=4)
25214      CHARACTER*4 INAME(MAXDIS,MAXSCL)
25215      CHARACTER*4 INCASE(MAXDIS)
25216      CHARACTER*4 INTEMP(MAXDIS)
25217      CHARACTER*60 INLONG(MAXDIS)
25218      INTEGER INSHAP(MAXDIS)
25219C
25220C-----COMMON----------------------------------------------------------
25221C
25222      INCLUDE 'DPCOP2.INC'
25223C
25224C     CREATE TABLE OF STATISTIC NAMES.
25225C
25226C       1) INCASE      = 4-CHARACTER CODE FOR DISTRIBUTION
25227C       2) INAME       = MATCHING ENTRIES FOR DISTRIBUTION.
25228C       3) INSHAP      = NUMBER OF SHAPE PARAMETERS
25229C       4) INLONG      = DESCRIPTIVE NAME FOR STATISTIC.
25230C
25231C     UNIFORM
25232      DATA INCASE(1)/'UNIF'/
25233      DATA (INAME(1,J),J=1,4)/'UNIF','    ','    ','    '/
25234      DATA INSHAP(1)/0/
25235      DATA INLONG(1)/'UNIFORM'/
25236      DATA INCASE(2)/'UNIF'/
25237      DATA (INAME(2,J),J=1,4)/'RECT','    ','    ','    '/
25238      DATA INSHAP(2)/0/
25239      DATA INLONG(2)/'UNIFORM'/
25240C     NORMAL MIXTURE
25241      DATA INCASE(3)/'NORX'/
25242      DATA (INAME(3,J),J=1,4)/'NORM','MIXT','    ','    '/
25243      DATA INSHAP(3)/5/
25244      DATA INLONG(3)/'NORMAL MIXTURE'/
25245      DATA INCASE(4)/'NORX'/
25246      DATA (INAME(4,J),J=1,4)/'GAUS','MIXT','    ','    '/
25247      DATA INSHAP(4)/5/
25248      DATA INLONG(4)/'NORMAL MIXTURE'/
25249C     NORMAL
25250      DATA INCASE(5)/'NORM'/
25251      DATA (INAME(5,J),J=1,4)/'NORM','    ','    ','    '/
25252      DATA INSHAP(5)/0/
25253      DATA INLONG(5)/'NORMAL'/
25254      DATA INCASE(6)/'NORM'/
25255      DATA (INAME(6,J),J=1,4)/'GAUS','    ','    ','    '/
25256      DATA INSHAP(6)/0/
25257      DATA INLONG(6)/'NORMAL'/
25258C     LOGISTIC EXPONENTIAL
25259      DATA INCASE(7)/'LEXP'/
25260      DATA (INAME(7,J),J=1,4)/'LOGI','EXPO','    ','    '/
25261      DATA INSHAP(7)/1/
25262      DATA INLONG(7)/'LOGISTIC EXPONENTIAL'/
25263C     DOUBLE EXPONENTIAL
25264      DATA INCASE(8)/'DEXP'/
25265      DATA (INAME(8,J),J=1,4)/'DOUB','EXPO','    ','    '/
25266      DATA INSHAP(8)/0/
25267      DATA INLONG(8)/'DOUBLE EXPONENTIAL'/
25268      DATA INCASE(9)/'DEXP'/
25269      DATA (INAME(9,J),J=1,4)/'LAPL','    ','    ','    '/
25270      DATA INSHAP(9)/0/
25271      DATA INLONG(9)/'DOUBLE EXPONENTIAL'/
25272C     CAUCHY
25273      DATA INCASE(10)/'CAUC'/
25274      DATA (INAME(10,J),J=1,4)/'CAUC','    ','    ','    '/
25275      DATA INSHAP(10)/0/
25276      DATA INLONG(10)/'CAUCHY'/
25277C     TUKEY-LAMBDA
25278      DATA INCASE(11)/'TULA'/
25279      DATA (INAME(11,J),J=1,4)/'TUKE','LAMB','    ','    '/
25280      DATA INSHAP(11)/1/
25281      DATA INLONG(11)/'TUKEY-LAMBDA'/
25282      DATA INCASE(12)/'TULA'/
25283      DATA (INAME(12,J),J=1,4)/'TUKE','    ','    ','    '/
25284      DATA INSHAP(12)/1/
25285      DATA INLONG(12)/'TUKEY-LAMBDA'/
25286      DATA INCASE(13)/'TULA'/
25287      DATA (INAME(13,J),J=1,4)/'LAMB','    ','    ','    '/
25288      DATA INSHAP(13)/1/
25289      DATA INLONG(13)/'TUKEY-LAMBDA'/
25290C     LOGNORMAL
25291      DATA INCASE(14)/'LOGN'/
25292      DATA (INAME(14,J),J=1,4)/'LOG ','NORM','    ','    '/
25293      DATA INSHAP(14)/1/
25294      DATA INLONG(14)/'LOG-NORMAL'/
25295      DATA INCASE(15)/'LOGN'/
25296      DATA (INAME(15,J),J=1,4)/'LOGN','    ','    ','    '/
25297      DATA INSHAP(15)/1/
25298      DATA INLONG(15)/'LOG-NORMAL'/
25299C     HALF-NORMAL
25300      DATA INCASE(16)/'HNOR'/
25301      DATA (INAME(16,J),J=1,4)/'HALF','NORM','    ','    '/
25302      DATA INSHAP(16)/0/
25303      DATA INLONG(16)/'HALF-NORMAL'/
25304C
25305      DATA INCASE(17)/'HALO'/
25306      DATA (INAME(17,J),J=1,4)/'HALF','LOGI','    ','    '/
25307      DATA INSHAP(17)/0/
25308      DATA INLONG(17)/'HALF-LOGISITC'/
25309C     T
25310      DATA INCASE(18)/'TPP'/
25311      DATA (INAME(18,J),J=1,4)/'T   ','    ','    ','    '/
25312      DATA INSHAP(18)/1/
25313      DATA INLONG(18)/'T'/
25314      DATA INCASE(19)/'TPP'/
25315      DATA (INAME(19,J),J=1,4)/'STUD','T   ','    ','    '/
25316      DATA INSHAP(19)/1/
25317      DATA INLONG(19)/'T'/
25318C     CHI-SQUARE
25319      DATA INCASE(20)/'CHIS'/
25320      DATA (INAME(20,J),J=1,4)/'CHIS','    ','    ','    '/
25321      DATA INSHAP(20)/1/
25322      DATA INLONG(20)/'CHI-SQUARE'/
25323      DATA INCASE(21)/'CHIS'/
25324      DATA (INAME(21,J),J=1,4)/'CHI ','SQUA','    ','    '/
25325      DATA INSHAP(21)/1/
25326      DATA INLONG(21)/'CHI-SQUARE'/
25327C     F
25328      DATA INCASE(22)/'FPP'/
25329      DATA (INAME(22,J),J=1,4)/'F   ','    ','    ','    '/
25330      DATA INSHAP(22)/1/
25331      DATA INLONG(22)/'F'/
25332      DATA INCASE(23)/'FPP'/
25333      DATA (INAME(23,J),J=1,4)/'SNED','F   ','    ','    '/
25334      DATA INSHAP(24)/1/
25335      DATA INLONG(24)/'F'/
25336C     EXPONENTIAL POWER
25337      DATA INCASE(24)/'PEXP'/
25338      DATA (INAME(24,J),J=1,4)/'EXPO','POWE','    ','    '/
25339      DATA INSHAP(24)/1/
25340      DATA INLONG(24)/'POWER EXPONENTIAL'/
25341C     NEGATIVE EXPONENTIAL (= EXPONENTIAL)
25342      DATA INCASE(25)/'NEXP'/
25343      DATA (INAME(25,J),J=1,4)/'NEGA','EXPO','    ','    '/
25344      DATA INSHAP(25)/0/
25345      DATA INLONG(25)/'NEGATIVE EXPONENTIAL'/
25346C     GAMMA
25347      DATA INCASE(26)/'GAMM'/
25348      DATA (INAME(26,J),J=1,4)/'GAMM','    ','    ','    '/
25349      DATA INSHAP(26)/1/
25350      DATA INLONG(26)/'GAMMA'/
25351C
25352      DATA INCASE(27)/'BNOR'/
25353      DATA (INAME(27,J),J=1,4)/'BETA','NORM','    ','    '/
25354      DATA INSHAP(27)/4/
25355      DATA INLONG(27)/'BETA NORMAL'/
25356C     WEIBULL
25357      DATA INCASE(28)/'WEIB'/
25358      DATA (INAME(28,J),J=1,4)/'WEIB','    ','    ','    '/
25359      DATA INSHAP(28)/1/
25360      DATA INLONG(28)/'WEIBULL'/
25361C     EXTREME VALUE TYPE I (GUMBEL)
25362      DATA INCASE(29)/'EV1'/
25363      DATA (INAME(29,J),J=1,4)/'EXTR','VALU','TYPE','1   '/
25364      DATA INSHAP(29)/0/
25365      DATA INLONG(29)/'GUMBEL'/
25366      DATA INCASE(30)/'EV1'/
25367      DATA (INAME(30,J),J=1,4)/'EXTR','VALU','TYPE','I   '/
25368      DATA INSHAP(30)/0/
25369      DATA INLONG(30)/'GUMBEL'/
25370      DATA INCASE(31)/'EV1'/
25371      DATA (INAME(31,J),J=1,4)/'EV1 ','    ','    ','    '/
25372      DATA INSHAP(31)/0/
25373      DATA INLONG(31)/'GUMBEL'/
25374      DATA INCASE(32)/'EV1'/
25375      DATA (INAME(32,J),J=1,4)/'EVI ','    ','    ','    '/
25376      DATA INSHAP(32)/0/
25377      DATA INLONG(32)/'GUMBEL'/
25378      DATA INCASE(33)/'EV1'/
25379      DATA (INAME(33,J),J=1,4)/'GUMB','    ','    ','    '/
25380      DATA INSHAP(33)/0/
25381      DATA INLONG(33)/'GUMBEL'/
25382C     EXTREME VALUE TYPE II (FRECHET)
25383      DATA INCASE(34)/'EV2'/
25384      DATA (INAME(34,J),J=1,4)/'EXTR','VALU','TYPE','2   '/
25385      DATA INSHAP(34)/1/
25386      DATA INLONG(34)/'FRECHET'/
25387      DATA INCASE(35)/'EV2'/
25388      DATA (INAME(35,J),J=1,4)/'EXTR','VALU','TYPE','II  '/
25389      DATA INSHAP(35)/1/
25390      DATA INLONG(35)/'FRECHET'/
25391      DATA INCASE(36)/'EV2'/
25392      DATA (INAME(36,J),J=1,4)/'EVII','    ','    ','    '/
25393      DATA INSHAP(36)/1/
25394      DATA INLONG(36)/'FRECHET'/
25395      DATA INCASE(37)/'EV2'/
25396      DATA (INAME(37,J),J=1,4)/'EV2 ','    ','    ','    '/
25397      DATA INSHAP(37)/1/
25398      DATA INLONG(37)/'FRECHET'/
25399      DATA INCASE(38)/'EV2'/
25400      DATA (INAME(38,J),J=1,4)/'FREC','    ','    ','    '/
25401      DATA INSHAP(38)/1/
25402      DATA INLONG(38)/'FRECHET'/
25403C     PARETO
25404      DATA INCASE(39)/'PARE'/
25405      DATA (INAME(39,J),J=1,4)/'PARE','    ','    ','    '/
25406      DATA INSHAP(39)/1/
25407      DATA INLONG(39)/'PARETO'/
25408C     BINOMIAL
25409      DATA INCASE(40)/'BINO'/
25410      DATA (INAME(40,J),J=1,4)/'BINO','    ','    ','    '/
25411      DATA INSHAP(40)/2/
25412      DATA INLONG(40)/'BINOMIAL'/
25413C     GEOMETRIC EXTREME EXPONENTIAL
25414      DATA INCASE(41)/'GEEX'/
25415      DATA (INAME(41,J),J=1,4)/'GEOM','EXTR','EXPO','    '/
25416      DATA INSHAP(41)/1/
25417      DATA INLONG(41)/'GEOMETRIC EXTREME EXPONENTIAL'/
25418C
25419      DATA INCASE(42)/'POIS'/
25420      DATA (INAME(42,J),J=1,4)/'POIS','    ','    ','    '/
25421      DATA INSHAP(42)/1/
25422      DATA INLONG(42)/'POISSON'/
25423C     NEGATIVE BINOMIAL
25424      DATA INCASE(43)/'NEBI'/
25425      DATA (INAME(43,J),J=1,4)/'NEGA','BINO','    ','    '/
25426      DATA INSHAP(43)/2/
25427      DATA INLONG(43)/'NEGATIVE BINOMIAL'/
25428C     SEMI-CIRCULAR
25429      DATA INCASE(44)/'SEMC'/
25430      DATA (INAME(44,J),J=1,4)/'SEMI','CIRC','    ','    '/
25431      DATA INSHAP(44)/1/
25432      DATA INLONG(44)/'SEMI-CIRCULAR'/
25433      DATA INCASE(45)/'SEMC'/
25434      DATA (INAME(45,J),J=1,4)/'SEMI','    ','    ','    '/
25435      DATA INSHAP(45)/1/
25436      DATA INLONG(45)/'SEMI-CIRCULAR'/
25437C     TRIANGULAR
25438      DATA INCASE(46)/'TRIA'/
25439      DATA (INAME(46,J),J=1,4)/'TRIA','    ','    ','    '/
25440      DATA INSHAP(46)/1/
25441      DATA INLONG(46)/'TRIANGULAR'/
25442C     IVERSE GAUSSIAN
25443      DATA INCASE(47)/'INGA'/
25444      DATA (INAME(47,J),J=1,4)/'INVE','GAUS','    ','    '/
25445      DATA INSHAP(47)/2/
25446      DATA INLONG(47)/'INVERSE GAUSSIAN'/
25447      DATA INCASE(48)/'INGA'/
25448      DATA (INAME(48,J),J=1,4)/'IG  ','    ','    ','    '/
25449      DATA INSHAP(48)/2/
25450      DATA INLONG(48)/'INVERSE GAUSSIAN'/
25451C     WALD
25452      DATA INCASE(49)/'WALD'/
25453      DATA (INAME(49,J),J=1,4)/'WALD','    ','    ','    '/
25454      DATA INSHAP(49)/1/
25455      DATA INLONG(49)/'WALD'/
25456C     RECIPROCAL INVERSE GAUSSIAN
25457      DATA INCASE(50)/'RIGA'/
25458      DATA (INAME(50,J),J=1,4)/'RIG ','    ','    ','    '/
25459      DATA INSHAP(50)/2/
25460      DATA INLONG(50)/'RECIPROCAL INVERSE GAUSSIAN'/
25461      DATA INCASE(51)/'RIGA'/
25462      DATA (INAME(51,J),J=1,4)/'TWEE','    ','    ','    '/
25463      DATA INSHAP(51)/2/
25464      DATA INLONG(51)/'RECIPROCAL INVERSE GAUSSIAN'/
25465      DATA INCASE(52)/'RIGA'/
25466      DATA (INAME(52,J),J=1,4)/'RECI','INVE','GAUS','    '/
25467      DATA INSHAP(52)/2/
25468      DATA INLONG(52)/'RECIPROCAL INVERSE GAUSSIAN'/
25469C     FATIGUE LIFE
25470      DATA INCASE(53)/'FATL'/
25471      DATA (INAME(53,J),J=1,4)/'FATI','LIFE','    ','    '/
25472      DATA INSHAP(53)/1/
25473      DATA INLONG(53)/'FATIGUE LIFE'/
25474      DATA INCASE(54)/'FATL'/
25475      DATA (INAME(54,J),J=1,4)/'FL  ','    ','    ','    '/
25476      DATA INSHAP(54)/1/
25477      DATA INLONG(54)/'FATIGUE LIFE'/
25478      DATA INCASE(55)/'FATL'/
25479      DATA (INAME(55,J),J=1,4)/'BIRN','SAUN','    ','    '/
25480      DATA INSHAP(55)/1/
25481      DATA INLONG(55)/'FATIGUE LIFE'/
25482      DATA INCASE(56)/'FATL'/
25483      DATA (INAME(56,J),J=1,4)/'SAUN','BIRN','    ','    '/
25484      DATA INSHAP(56)/1/
25485      DATA INLONG(56)/'FATIGUE LIFE'/
25486C     GENERALIZED PARETO
25487      DATA INCASE(57)/'GPAR'/
25488      DATA (INAME(57,J),J=1,4)/'GENE','PARE','    ','    '/
25489      DATA INSHAP(57)/1/
25490      DATA INLONG(57)/'GENERALIZED PARETO'/
25491      DATA INCASE(58)/'GPAR'/
25492      DATA (INAME(58,J),J=1,4)/'GEP ','    ','    ','    '/
25493      DATA INSHAP(58)/1/
25494      DATA INLONG(58)/'GENERALIZED PARETO'/
25495      DATA INCASE(59)/'GPAR'/
25496      DATA (INAME(59,J),J=1,4)/'GP  ','    ','    ','    '/
25497      DATA INSHAP(59)/1/
25498      DATA INLONG(59)/'GENERALIZED PARETO'/
25499C     DISCRETE UNIFORM
25500      DATA INCASE(60)/'DUNI'/
25501      DATA (INAME(60,J),J=1,4)/'DISC','UNIF','    ','    '/
25502      DATA INSHAP(60)/1/
25503      DATA INLONG(60)/'DISCRETE UNIFORM'/
25504C     NON-CENTRAL T
25505      DATA INCASE(61)/'NCT'/
25506      DATA (INAME(61,J),J=1,4)/'NONC','T   ','    ','    '/
25507      DATA INSHAP(61)/2/
25508      DATA INLONG(61)/'NON-CENTRAL T'/
25509      DATA INCASE(62)/'NCT'/
25510      DATA (INAME(62,J),J=1,4)/'NON-','T   ','    ','    '/
25511      DATA INSHAP(62)/2/
25512      DATA INLONG(62)/'NON-CENTRAL T'/
25513      DATA INCASE(63)/'NCT'/
25514      DATA (INAME(63,J),J=1,4)/'NON ','CENT','T   ','    '/
25515      DATA INSHAP(63)/2/
25516      DATA INLONG(63)/'NON-CENTRAL T'/
25517C     NON-CENTRAL F
25518      DATA INCASE(64)/'NCF'/
25519      DATA (INAME(64,J),J=1,4)/'NONC','F   ','    ','    '/
25520      DATA INSHAP(64)/3/
25521      DATA INLONG(64)/'NON-CENTRAL F'/
25522      DATA INCASE(65)/'NCF'/
25523      DATA (INAME(65,J),J=1,4)/'NON-','F   ','    ','    '/
25524      DATA INSHAP(65)/3/
25525      DATA INLONG(65)/'NON-CENTRAL F'/
25526      DATA INCASE(66)/'NCF'/
25527      DATA (INAME(66,J),J=1,4)/'NON ','CENT','F   ','    '/
25528      DATA INSHAP(66)/3/
25529      DATA INLONG(66)/'NON-CENTRAL F'/
25530C
25531      DATA INCASE(67)/'NCBE'/
25532      DATA (INAME(67,J),J=1,4)/'NONC','BETA','    ','    '/
25533      DATA INSHAP(67)/3/
25534      DATA INLONG(67)/'NON-CENTRAL BETA'/
25535      DATA INCASE(68)/'NCBE'/
25536      DATA (INAME(68,J),J=1,4)/'NON-','BETA','    ','    '/
25537      DATA INSHAP(68)/3/
25538      DATA INLONG(68)/'NON-CENTRAL BETA'/
25539      DATA INCASE(69)/'NCBE'/
25540      DATA (INAME(69,J),J=1,4)/'NON ','CENT','BETA','    '/
25541      DATA INSHAP(69)/3/
25542      DATA INLONG(69)/'NON-CENTRAL BETA'/
25543C     NON-CENTRAL CHI-SQUARE
25544      DATA INCASE(70)/'NCCS'/
25545      DATA (INAME(70,J),J=1,4)/'NON ','CENT','CHIS','    '/
25546      DATA INSHAP(70)/2/
25547      DATA INLONG(70)/'NON-CENTRAL CHI-SQUARE'/
25548      DATA INCASE(71)/'NCCS'/
25549      DATA (INAME(71,J),J=1,4)/'NON ','CENT','CHI ','SQUA'/
25550      DATA INSHAP(71)/2/
25551      DATA INLONG(71)/'NON-CENTRAL CHI-SQUARE'/
25552      DATA INCASE(72)/'NCCS'/
25553      DATA (INAME(72,J),J=1,4)/'NONC','CHI ','SQUA','    '/
25554      DATA INSHAP(72)/2/
25555      DATA INLONG(72)/'NON-CENTRAL CHI-SQUARE'/
25556      DATA INCASE(73)/'NCCS'/
25557      DATA (INAME(73,J),J=1,4)/'NON-','CHI ','SQUA','    '/
25558      DATA INSHAP(73)/2/
25559      DATA INLONG(73)/'NON-CENTRAL CHI-SQUARE'/
25560      DATA INCASE(74)/'NCCS'/
25561      DATA (INAME(74,J),J=1,4)/'NONC','CHI-','    ','    '/
25562      DATA INSHAP(74)/2/
25563      DATA INLONG(74)/'NON-CENTRAL CHI-SQUARE'/
25564      DATA INCASE(75)/'NCCS'/
25565      DATA (INAME(75,J),J=1,4)/'NON-','CHI-','    ','    '/
25566      DATA INSHAP(75)/2/
25567      DATA INLONG(75)/'NON-CENTRAL CHI-SQUARE'/
25568      DATA INCASE(76)/'NCCS'/
25569      DATA (INAME(76,J),J=1,4)/'NONC','CHIS','    ','    '/
25570      DATA INSHAP(76)/2/
25571      DATA INLONG(76)/'NON-CENTRAL CHI-SQUARE'/
25572      DATA INCASE(77)/'NCCS'/
25573      DATA (INAME(77,J),J=1,4)/'NON-','CHIS','CHIS','    '/
25574      DATA INSHAP(77)/2/
25575      DATA INLONG(77)/'NON-CENTRAL CHI-SQUARE'/
25576C     DOUBLY NON-CENTRAL F
25577      DATA INCASE(78)/'DNCF'/
25578      DATA (INAME(78,J),J=1,4)/'DOUB','NONC','F   ','    '/
25579      DATA INSHAP(78)/4/
25580      DATA INLONG(78)/'DOUBLY NON-CENTRAL F'/
25581      DATA INCASE(79)/'DNCF'/
25582      DATA (INAME(79,J),J=1,4)/'DOUB','NON-','F   ','    '/
25583      DATA INSHAP(79)/4/
25584      DATA INLONG(79)/'DOUBLY NON-CENTRAL F'/
25585C     DOUBLY NON-CENTRAL T
25586      DATA INCASE(80)/'DNCT'/
25587      DATA (INAME(80,J),J=1,4)/'DOUB','NONC','T   ','    '/
25588      DATA INSHAP(80)/3/
25589      DATA INLONG(80)/'DOUBLY NON-CENTRAL T'/
25590      DATA INCASE(81)/'DNCT'/
25591      DATA (INAME(81,J),J=1,4)/'DOUB','NON ','CENT','T   '/
25592      DATA INSHAP(81)/3/
25593      DATA INLONG(81)/'DOUBLY NON-CENTRAL T'/
25594C     HYPERBOLIC SECANT
25595      DATA INCASE(82)/'HSEC'/
25596      DATA (INAME(82,J),J=1,4)/'HYPE','SECA','    ','    '/
25597      DATA INSHAP(82)/0/
25598      DATA INLONG(82)/'HYPERBOLIC SECANT'/
25599C     HYPERGEOMETRIC
25600      DATA INCASE(83)/'HYPG'/
25601      DATA (INAME(83,J),J=1,4)/'HYPE','GEO ','    ','    '/
25602      DATA INSHAP(83)/3/
25603      DATA INLONG(83)/'HYPERGEOMETRIC'/
25604C     VON MISES
25605      DATA INCASE(84)/'VONM'/
25606      DATA (INAME(84,J),J=1,4)/'VON ','MISE','    ','    '/
25607      DATA INSHAP(84)/1/
25608      DATA INLONG(84)/'VON MISES'/
25609      DATA INCASE(85)/'VONM'/
25610      DATA (INAME(85,J),J=1,4)/'VONM','    ','    ','    '/
25611      DATA INSHAP(85)/1/
25612      DATA INLONG(85)/'VON MISES'/
25613      DATA INCASE(86)/'VONM'/
25614      DATA (INAME(86,J),J=1,4)/'VON-','    ','    ','    '/
25615      DATA INSHAP(86)/1/
25616      DATA INLONG(86)/'VON MISES'/
25617C     POWER NORMAL
25618      DATA INCASE(87)/'POWN'/
25619      DATA (INAME(87,J),J=1,4)/'POWE','NORM','    ','    '/
25620      DATA INSHAP(87)/1/
25621      DATA INLONG(87)/'POWER NORMAL'/
25622C     POWER LOGNORMAL
25623      DATA INCASE(88)/'PLGN'/
25624      DATA (INAME(88,J),J=1,4)/'POWE','LOGN','    ','    '/
25625      DATA INSHAP(88)/2/
25626      DATA INLONG(88)/'POWER LOGNORMAL'/
25627      DATA INCASE(89)/'PLGN'/
25628      DATA (INAME(89,J),J=1,4)/'POWE','LGNO','    ','    '/
25629      DATA INSHAP(89)/2/
25630      DATA INLONG(89)/'POWER LOGNORMAL'/
25631      DATA INCASE(90)/'PLGN'/
25632      DATA (INAME(90,J),J=1,4)/'POWE','LOG-','    ','    '/
25633      DATA INSHAP(90)/2/
25634      DATA INLONG(90)/'POWER LOGNORMAL'/
25635C     COSINE
25636      DATA INCASE(91)/'COSI'/
25637      DATA (INAME(91,J),J=1,4)/'COSI','    ','    ','    '/
25638      DATA INSHAP(91)/0/
25639      DATA INLONG(91)/'COSINE'/
25640C     ALPHA
25641      DATA INCASE(92)/'ALPH'/
25642      DATA (INAME(92,J),J=1,4)/'ALPH','    ','    ','    '/
25643      DATA INSHAP(92)/1/
25644      DATA INLONG(92)/'ALPHA'/
25645C     POWER EXPONENTIAL
25646      DATA INCASE(93)/'PEXP'/
25647      DATA (INAME(93,J),J=1,4)/'POWE','EXPO','    ','    '/
25648      DATA INSHAP(93)/1/
25649      DATA INLONG(93)/'POWER EXPONENTIAL'/
25650C     POWER
25651      DATA INCASE(94)/'POWF'/
25652      DATA (INAME(94,J),J=1,4)/'POWE','FUNC','    ','    '/
25653      DATA INSHAP(94)/1/
25654      DATA INLONG(94)/'POWER FUNCTION'/
25655C     CHI
25656      DATA INCASE(95)/'CHI '/
25657      DATA (INAME(95,J),J=1,4)/'CHI ','    ','    ','    '/
25658      DATA INSHAP(95)/1/
25659      DATA INLONG(95)/'CHI'/
25660C     LOGARITHMIC SERIES
25661      DATA INCASE(96)/'LOGS'/
25662      DATA (INAME(96,J),J=1,4)/'LOGA','SERI','    ','    '/
25663      DATA INSHAP(96)/1/
25664      DATA INLONG(96)/'LOGARITHMIC SERIES'/
25665C     LOG LOGISTIC
25666      DATA INCASE(97)/'LOGL'/
25667      DATA (INAME(97,J),J=1,4)/'LOG ','LOGI','    ','    '/
25668      DATA INSHAP(97)/1/
25669      DATA INLONG(97)/'LOG-LOGISTIC'/
25670      DATA INCASE(98)/'LOGL'/
25671      DATA (INAME(98,J),J=1,4)/'LOG-','LOGI','    ','    '/
25672      DATA INSHAP(98)/1/
25673      DATA INLONG(98)/'LOG-LOGISTIC'/
25674      DATA INCASE(99)/'LOGL'/
25675      DATA (INAME(99,J),J=1,4)/'LOGL','    ','    ','    '/
25676      DATA INSHAP(99)/1/
25677      DATA INLONG(99)/'LOG-LOGISTIC'/
25678C     GENERALIZED GAMMA
25679      DATA INCASE(100)/'GGAM'/
25680      DATA (INAME(100,J),J=1,4)/'GENE','GAMM','    ','    '/
25681      DATA INSHAP(100)/2/
25682      DATA INLONG(100)/'GENERALIZED GAMMA'/
25683C     INVERTED GAMMA
25684      DATA INCASE(101)/'IGAM'/
25685      DATA (INAME(101,J),J=1,4)/'INVE','GAMM','    ','    '/
25686      DATA INSHAP(101)/1/
25687      DATA INLONG(101)/'INVERSE GAMMA'/
25688C     WARING
25689      DATA INCASE(102)/'WARI'/
25690      DATA (INAME(102,J),J=1,4)/'WARI','    ','    ','    '/
25691      DATA INSHAP(102)/2/
25692      DATA INLONG(102)/'WARING'/
25693C     YULE
25694      DATA INCASE(103)/'YULE'/
25695      DATA (INAME(103,J),J=1,4)/'YULE','    ','    ','    '/
25696      DATA INSHAP(103)/1/
25697      DATA INLONG(103)/'YULE'/
25698C     ANGLIT
25699      DATA INCASE(104)/'ANGL'/
25700      DATA (INAME(104,J),J=1,4)/'ANGL','    ','    ','    '/
25701      DATA INSHAP(104)/0/
25702      DATA INLONG(104)/'ANGLIT'/
25703C     ARCSINE
25704      DATA INCASE(105)/'ARSI'/
25705      DATA (INAME(105,J),J=1,4)/'ARCS','    ','    ','    '/
25706      DATA INSHAP(105)/0/
25707      DATA INLONG(105)/'ARCSINE'/
25708C     FOLDED NORMAL
25709      DATA INCASE(106)/'FNOR'/
25710      DATA (INAME(106,J),J=1,4)/'FOLD','NORM','    ','    '/
25711      DATA INSHAP(106)/2/
25712      DATA INLONG(106)/'FOLDED NORMAL'/
25713C     TRUNCATED NORMAL
25714      DATA INCASE(107)/'TNOR'/
25715      DATA (INAME(107,J),J=1,4)/'TRUN','NORM','    ','    '/
25716      DATA INSHAP(107)/4/
25717      DATA INLONG(107)/'TRUNCATED NORMAL'/
25718C     LOG GAMMA
25719      DATA INCASE(108)/'LGAM'/
25720      DATA (INAME(108,J),J=1,4)/'LOG ','GAMM','    ','    '/
25721      DATA INSHAP(108)/1/
25722      DATA INLONG(108)/'LOG-GAMMA'/
25723C     HYPERGEOMETRIC
25724      DATA INCASE(109)/'HYPG'/
25725      DATA (INAME(109,J),J=1,4)/'HYPE','    ','    ','    '/
25726      DATA INSHAP(109)/3/
25727      DATA INLONG(109)/'HYPERGEOMETRIC'/
25728C     GOMPERTZ MAKEHAM
25729      DATA INCASE(110)/'GOMM'/
25730      DATA (INAME(110,J),J=1,4)/'GOMP','MAKE','    ','    '/
25731      DATA INSHAP(110)/2/
25732      DATA INLONG(110)/'GOMPERTZ MAKEHAM'/
25733C     HALF CAUCHY
25734      DATA INCASE(111)/'HCAU'/
25735      DATA (INAME(111,J),J=1,4)/'HALF','CAUC','    ','    '/
25736      DATA INSHAP(111)/0/
25737      DATA INLONG(111)/'HALF-CAUCHY'/
25738C     GENERALIZED EXTREME VALUE
25739      DATA INCASE(112)/'GEV'/
25740      DATA (INAME(112,J),J=1,4)/'GENE','EXTR','VALU','    '/
25741      DATA INSHAP(112)/1/
25742      DATA INLONG(112)/'GENERALIZED EXTREME VALUE'/
25743      DATA INCASE(113)/'GEV'/
25744      DATA (INAME(113,J),J=1,4)/'GEV ','    ','    ','    '/
25745      DATA INSHAP(113)/1/
25746      DATA INLONG(113)/'GENERALIZED EXTREME VALUE'/
25747C     HALF-NORMAL
25748      DATA INCASE(114)/'HLOG'/
25749      DATA (INAME(114,J),J=1,4)/'HALF','LOGI','    ','    '/
25750      DATA INSHAP(114)/0/
25751      DATA INLONG(114)/'HALF-LOGISTIC'/
25752C
25753      DATA INCASE(115)/'PAR2'/
25754      DATA (INAME(115,J),J=1,4)/'PARE','SECO','KIND','    '/
25755      DATA INSHAP(115)/1/
25756      DATA INLONG(115)/'PARETO SECOND KIND'/
25757      DATA INCASE(116)/'PAR2'/
25758      DATA (INAME(116,J),J=1,4)/'PARE','TYPE','2   ','    '/
25759      DATA INSHAP(116)/1/
25760      DATA INLONG(116)/'PARETO SECOND KIND'/
25761      DATA INCASE(117)/'PAR2'/
25762      DATA (INAME(117,J),J=1,4)/'PARE','TYPE','II  ','    '/
25763      DATA INSHAP(117)/1/
25764      DATA INLONG(117)/'PARETO SECOND KIND'/
25765C     DOUBLE WEIBULL
25766      DATA INCASE(118)/'DWEI'/
25767      DATA (INAME(118,J),J=1,4)/'DOUB','WEIB','    ','    '/
25768      DATA INSHAP(118)/1/
25769      DATA INLONG(118)/'DOUBLE WEIBULL'/
25770C     EXPONENTIATED WEIBULL
25771      DATA INCASE(119)/'EWEI'/
25772      DATA (INAME(119,J),J=1,4)/'EXPO','WEIB','    ','    '/
25773      DATA INSHAP(119)/2/
25774      DATA INLONG(119)/'EXPONENTIATED WEIBULL'/
25775C     TRUNCATED EXPONENTIAL
25776      DATA INCASE(120)/'TEXP'/
25777      DATA (INAME(120,J),J=1,4)/'TRUN','EXPO','    ','    '/
25778      DATA INSHAP(120)/3/
25779      DATA INLONG(120)/'TRUNCATED EXPONENTIAL'/
25780C     WRAPPED CAUCHY
25781      DATA INCASE(121)/'WCAU'/
25782      DATA (INAME(121,J),J=1,4)/'WRAP','CAUC','    ','    '/
25783      DATA INSHAP(121)/1/
25784      DATA INLONG(121)/'WRAPPED CAUCHY'/
25785C     WAKEBY
25786      DATA INCASE(122)/'WAKE'/
25787      DATA (INAME(122,J),J=1,4)/'WAKE','    ','    ','    '/
25788      DATA INSHAP(122)/3/
25789      DATA INLONG(122)/'WAKEBY'/
25790C     EXPONENTIAL
25791      DATA INCASE(123)/'EXPO'/
25792      DATA (INAME(123,J),J=1,4)/'EXPO','    ','    ','    '/
25793      DATA INSHAP(123)/0/
25794      DATA INLONG(123)/'EXPONENTIAL'/
25795C     DOUBLE GAMMA
25796      DATA INCASE(124)/'DGAM'/
25797      DATA (INAME(124,J),J=1,4)/'DOUB','GAMM','    ','    '/
25798      DATA INSHAP(124)/1/
25799      DATA INLONG(124)/'DOUBLE GAMMA'/
25800C     MIELKE BETA KAPPA
25801      DATA INCASE(125)/'MBKA'/
25802      DATA (INAME(125,J),J=1,4)/'BETA','KAPP','    ','    '/
25803      DATA INSHAP(125)/2/
25804      DATA INLONG(125)/'MIELKE BETA KAPPA'/
25805      DATA INCASE(126)/'MBKA'/
25806      DATA (INAME(126,J),J=1,4)/'MIEL','BETA','KAPP','    '/
25807      DATA INSHAP(126)/2/
25808      DATA INLONG(126)/'MIELKE BETA KAPPA'/
25809C     FOLDED CAUCHY
25810      DATA INCASE(127)/'FCAU'/
25811      DATA (INAME(127,J),J=1,4)/'FOLD','CAUC','    ','    '/
25812      DATA INSHAP(127)/2/
25813      DATA INLONG(127)/'FOLDED CAUCHY'/
25814C     BETA BINOMIAL
25815      DATA INCASE(128)/'BBIN'/
25816      DATA (INAME(128,J),J=1,4)/'BETA','BINO','    ','    '/
25817      DATA INSHAP(128)/3/
25818      DATA INLONG(128)/'BETA BINOMIAL'/
25819C     BRADFORD
25820      DATA INCASE(129)/'BRAD'/
25821      DATA (INAME(129,J),J=1,4)/'BRAD','    ','    ','    '/
25822      DATA INSHAP(129)/1/
25823      DATA INLONG(129)/'BRADFORD'/
25824C     GENERALIZED EXPONENTIAL
25825      DATA INCASE(130)/'GEXP'/
25826      DATA (INAME(130,J),J=1,4)/'GENE','EXPO','    ','    '/
25827      DATA INSHAP(130)/3/
25828      DATA INLONG(130)/'GENERALIZED EXPONENTIAL'/
25829C     RECIPROCAL
25830      DATA INCASE(131)/'RECI'/
25831      DATA (INAME(131,J),J=1,4)/'RECI','    ','    ','    '/
25832      DATA INSHAP(131)/1/
25833      DATA INLONG(131)/'RECIPROCAL'/
25834C     INVERTED WEIBULL
25835      DATA INCASE(132)/'IWEI'/
25836      DATA (INAME(132,J),J=1,4)/'INVE','WEIB','    ','    '/
25837      DATA INSHAP(132)/1/
25838      DATA INLONG(132)/'INVERTED WEIBULL'/
25839C     LOG DOUBLE EXPONENTIAL
25840      DATA INCASE(133)/'LDEX'/
25841      DATA (INAME(133,J),J=1,4)/'LOG ','DOUB','EXPO','    '/
25842      DATA INSHAP(133)/1/
25843      DATA INLONG(133)/'LOG DOUBLE EXPONENTIAL'/
25844C     GENERALIZED TUKEY-LAMBDA
25845      DATA INCASE(134)/'GTLA'/
25846      DATA (INAME(134,J),J=1,4)/'GENE','TUKE','LAMB','    '/
25847      DATA INSHAP(134)/2/
25848      DATA INLONG(134)/'GENERALZIED TUKEY LAMBDA'/
25849C     JOHNSON SB
25850      DATA INCASE(135)/'JOSB'/
25851      DATA (INAME(135,J),J=1,4)/'JOHN','SB  ','    ','    '/
25852      DATA INSHAP(135)/2/
25853      DATA INLONG(135)/'JOHNSON SB'/
25854C     JOHNSON SU
25855      DATA INCASE(136)/'JOSU'/
25856      DATA (INAME(136,J),J=1,4)/'JOHN','SU  ','    ','    '/
25857      DATA INSHAP(136)/2/
25858      DATA INLONG(136)/'JOHNSON SU'/
25859C     GEOMETRIC
25860      DATA INCASE(137)/'GEOM'/
25861      DATA (INAME(137,J),J=1,4)/'GEOM','    ','    ','    '/
25862      DATA INSHAP(137)/1/
25863      DATA INLONG(137)/'GEOMETRIC'/
25864C     TWO-SIDED POWER
25865      DATA INCASE(138)/'TSPO'/
25866      DATA (INAME(138,J),J=1,4)/'TWO ','SIDE','POWE','    '/
25867      DATA INSHAP(138)/2/
25868      DATA INLONG(138)/'TWO-SIDED POWER'/
25869C     BI-WEIBULL
25870      DATA INCASE(139)/'BWEI'/
25871      DATA (INAME(139,J),J=1,4)/'BI  ','WEIB','    ','    '/
25872      DATA INSHAP(139)/5/
25873      DATA INLONG(139)/'BIWEIBULL'/
25874      DATA INCASE(140)/'BWEI'/
25875      DATA (INAME(140,J),J=1,4)/'BIWE','    ','    ','    '/
25876      DATA INSHAP(140)/5/
25877      DATA INLONG(140)/'BIWEIBULL'/
25878C     LANDAU
25879      DATA INCASE(141)/'LAND'/
25880      DATA (INAME(141,J),J=1,4)/'LAND','    ','    ','    '/
25881      DATA INSHAP(141)/0/
25882      DATA INLONG(141)/'LANDAU'/
25883C     ERROR (SUBOTTIN)
25884      DATA INCASE(142)/'ERRO'/
25885      DATA (INAME(142,J),J=1,4)/'ERRO','    ','    ','    '/
25886      DATA INSHAP(142)/1/
25887      DATA INLONG(142)/'ERROR'/
25888      DATA INCASE(143)/'ERRO'/
25889      DATA (INAME(143,J),J=1,4)/'SUBB','    ','    ','    '/
25890      DATA INSHAP(143)/1/
25891      DATA INLONG(143)/'ERROR'/
25892C     POWER LAW
25893      DATA INCASE(144)/'POWL'/
25894      DATA (INAME(144,J),J=1,4)/'POWE','LAW ','    ','    '/
25895      DATA INSHAP(144)/2/
25896      DATA INLONG(144)/'POWER LAW'/
25897C     TRAPEZOID
25898      DATA INCASE(145)/'TRAP'/
25899      DATA (INAME(145,J),J=1,4)/'TRAP','    ','    ','    '/
25900      DATA INSHAP(145)/4/
25901      DATA INLONG(145)/'TRAPEZOID'/
25902C     GENERALIZED TRAPEZOID
25903      DATA INCASE(146)/'GTRA'/
25904      DATA (INAME(146,J),J=1,4)/'GENE','TRAP','    ','    '/
25905      DATA INSHAP(146)/7/
25906      DATA INLONG(146)/'GENERALIZED TRAPEZOID'/
25907C     FOLDED T
25908      DATA INCASE(147)/'FT'/
25909      DATA (INAME(147,J),J=1,4)/'FOLD','T   ','    ','    '/
25910      DATA INSHAP(147)/3/
25911      DATA INLONG(147)/'FOLDED T'/
25912C     SKEW NORMAL
25913      DATA INCASE(148)/'SNOR'/
25914      DATA (INAME(148,J),J=1,4)/'SKEW','NORM','    ','    '/
25915      DATA INSHAP(148)/1/
25916      DATA INLONG(148)/'SKEWED NORMAL'/
25917C     SKEW T
25918      DATA INCASE(149)/'TSKE'/
25919      DATA (INAME(149,J),J=1,4)/'SKEW','T   ','    ','    '/
25920      DATA INSHAP(149)/2/
25921      DATA INLONG(149)/'SKEWED T'/
25922C     SLASH
25923      DATA INCASE(150)/'SLAS'/
25924      DATA (INAME(150,J),J=1,4)/'SLAS','    ','    ','    '/
25925      DATA INSHAP(150)/0/
25926      DATA INLONG(150)/'SLASH'/
25927C     INVERTED BETA
25928      DATA INCASE(151)/'IBET'/
25929      DATA (INAME(151,J),J=1,4)/'INVE','BETA','    ','    '/
25930      DATA INSHAP(151)/2/
25931      DATA INLONG(151)/'INVERTED BETA'/
25932C     GOMPERTZ
25933      DATA INCASE(152)/'GOMP'/
25934      DATA (INAME(152,J),J=1,4)/'GOMP','    ','    ','    '/
25935      DATA INSHAP(152)/2/
25936      DATA INLONG(152)/'GOMPERTZ'/
25937C     GENERALIZED INVERSE GAUSSIAN
25938      DATA INCASE(153)/'GIGA'/
25939      DATA (INAME(153,J),J=1,4)/'GENE','INVE','GAUS','    '/
25940      DATA INSHAP(153)/2/
25941      DATA INLONG(153)/'GENERALIZED INVERSE GAUSSIAN'/
25942C     GENERALIZED F
25943      DATA INCASE(154)/'GFPP'/
25944      DATA (INAME(154,J),J=1,4)/'GENE','F   ','    ','    '/
25945      DATA INSHAP(154)/3/
25946      DATA INLONG(154)/'GENERALIZED F'/
25947C     G AND H
25948      DATA INCASE(155)/'GHPP'/
25949      DATA (INAME(155,J),J=1,4)/'G-H ','    ','    ','    '/
25950      DATA INSHAP(155)/2/
25951      DATA INLONG(155)/'G AND H'/
25952      DATA INCASE(156)/'GHPP'/
25953      DATA (INAME(156,J),J=1,4)/'GH  ','    ','    ','    '/
25954      DATA INSHAP(156)/2/
25955      DATA INLONG(156)/'G AND H'/
25956      DATA INCASE(157)/'GHPP'/
25957      DATA (INAME(157,J),J=1,4)/'G   ','H   ','    ','    '/
25958      DATA INSHAP(157)/2/
25959      DATA INLONG(157)/'G AND H'/
25960      DATA INCASE(158)/'GHPP'/
25961      DATA (INAME(158,J),J=1,4)/'G   ','AND ','H   ','    '/
25962      DATA INSHAP(158)/2/
25963      DATA INLONG(158)/'G AND H'/
25964C     LOG SKEWED NORMAL
25965      DATA INCASE(159)/'LSNO'/
25966      DATA (INAME(159,J),J=1,4)/'LOG ','SKEW','NORM','    '/
25967      DATA INSHAP(159)/2/
25968      DATA INLONG(159)/'LOG SKEWED NORMAL'/
25969C     LOG SKEWED T
25970      DATA INCASE(160)/'LSKT'/
25971      DATA (INAME(160,J),J=1,4)/'LOG ','SKEW','T   ','    '/
25972      DATA INSHAP(160)/3/
25973      DATA INLONG(160)/'LOG SKEWED T'/
25974C     GENERALIZED HALF-LOGISTIC
25975      DATA INCASE(161)/'GHLO'/
25976      DATA (INAME(161,J),J=1,4)/'GENE','HALF','LOGI','    '/
25977      DATA INSHAP(161)/1/
25978      DATA INLONG(161)/'GENERALIZED HALF-LOGISITC'/
25979C     ARCSINE
25980      DATA INCASE(162)/'ARSI'/
25981      DATA (INAME(162,J),J=1,4)/'ARCS','    ','    ','    '/
25982      DATA INSHAP(162)/0/
25983      DATA INLONG(162)/'ARCSINE'/
25984C     POLY AEPPLI
25985      DATA INCASE(163)/'AEPP'/
25986      DATA (INAME(163,J),J=1,4)/'POLY','AEPP','    ','    '/
25987      DATA INSHAP(163)/2/
25988      DATA INLONG(163)/'POLYA AEPPLI'/
25989C     HERMITE
25990      DATA INCASE(164)/'HERM'/
25991      DATA (INAME(164,J),J=1,4)/'HERM','    ','    ','    '/
25992      DATA INSHAP(164)/2/
25993      DATA INLONG(164)/'HERMITE'/
25994C     SKEW DOUBLE EXPONENTIAL
25995      DATA INCASE(165)/'SDEX'/
25996      DATA (INAME(165,J),J=1,4)/'SKEW','DOUB','EXPO','    '/
25997      DATA INSHAP(165)/1/
25998      DATA INLONG(165)/'SKEW DOUBLE EXPONENTIAL'/
25999      DATA INCASE(166)/'SDEX'/
26000      DATA (INAME(166,J),J=1,4)/'SKEW','LAPL','    ','    '/
26001      DATA INSHAP(166)/1/
26002      DATA INLONG(166)/'SKEW DOUBLE EXPONENTIAL'/
26003C     ASYMMETRIC DOUBLE EXPONENTIAL
26004      DATA INCASE(167)/'ADEX'/
26005      DATA (INAME(167,J),J=1,4)/'ASYM','DOUB','EXPO','    '/
26006      DATA INSHAP(167)/1/
26007      DATA INLONG(167)/'ASYMMETRIC DOUBLE EXPONENTIAL'/
26008      DATA INCASE(168)/'ADEX'/
26009      DATA (INAME(168,J),J=1,4)/'ASYM','LAPL','    ','    '/
26010      DATA INSHAP(168)/1/
26011      DATA INLONG(168)/'ASYMMETRIC DOUBLE EXPONENTIAL'/
26012C     MAXWELL
26013      DATA INCASE(169)/'MAXW'/
26014      DATA (INAME(169,J),J=1,4)/'MAXW','    ','    ','    '/
26015      DATA INSHAP(169)/0/
26016      DATA INLONG(169)/'MAXWELL'/
26017C     RAYLEIGH
26018      DATA INCASE(170)/'RAYL'/
26019      DATA (INAME(170,J),J=1,4)/'RAYL','    ','    ','    '/
26020      DATA INSHAP(170)/0/
26021      DATA INLONG(170)/'RAYLEIGH'/
26022C     GENERALIZED ASYMETRIC DOUBLE EXPONENTIAL
26023      DATA INCASE(171)/'GALP'/
26024      DATA (INAME(171,J),J=1,4)/'GENE','ASYM','DOUB','EXPO'/
26025      DATA INSHAP(171)/2/
26026      DATA INLONG(171)/'GENERALIZED ASYMMETRIC LAPLACE'/
26027      DATA INCASE(172)/'GALP'/
26028      DATA (INAME(172,J),J=1,4)/'GENE','ASYM','LAPL','    '/
26029      DATA INSHAP(172)/2/
26030      DATA INLONG(172)/'GENERALIZED ASYMMETRIC LAPLACE'/
26031C     MCLEISH
26032      DATA (INAME(173,J),J=1,4)/'MCLE','    ','    ','    '/
26033      DATA INCASE(173)/'MCLE'/
26034      DATA INSHAP(173)/1/
26035      DATA INLONG(173)/'MCLEISH'/
26036C     BESSEL I FUNCTION
26037      DATA (INAME(174,J),J=1,4)/'BESS','I   ','FUNC','    '/
26038      DATA INCASE(174)/'BEIP'/
26039      DATA INSHAP(174)/3/
26040      DATA INLONG(174)/'BESSEL I FUNCTION'/
26041      DATA (INAME(175,J),J=1,4)/'BESS','I   ','    ','    '/
26042      DATA INCASE(175)/'BEIP'/
26043      DATA INSHAP(175)/3/
26044      DATA INLONG(175)/'BESSEL I FUNCTION'/
26045C     BESSEL K FUNCTION
26046      DATA (INAME(176,J),J=1,4)/'BESS','K   ','FUNC','    '/
26047      DATA INCASE(176)/'BEKP'/
26048      DATA INSHAP(176)/3/
26049      DATA INLONG(176)/'BESSEL K FUNCTION'/
26050      DATA (INAME(177,J),J=1,4)/'BESS','K   ','    ','    '/
26051      DATA INCASE(177)/'BEKP'/
26052      DATA INSHAP(177)/3/
26053      DATA INLONG(177)/'BESSEL K FUNCTION'/
26054C     GENERALIZED MCLEISH
26055      DATA (INAME(178,J),J=1,4)/'GENE','MCLE','    ','    '/
26056      DATA INCASE(178)/'GMCL'/
26057      DATA INSHAP(178)/2/
26058      DATA INLONG(178)/'GENERALIZED MCLEISH'/
26059C     LOG DOUBLE EXPONENTIAL (LOG LAPLACE)
26060      DATA INCASE(179)/'LLAP'/
26061      DATA (INAME(179,J),J=1,4)/'LOG ','LAPL','    ','    '/
26062      DATA INSHAP(179)/1/
26063      DATA INLONG(179)/'LOG LAPLACE'/
26064C     GENERALIZED LOGISTIC TYPE 5
26065      DATA INCASE(180)/'G5LO'/
26066      DATA (INAME(180,J),J=1,4)/'GENE','LOGI','TYPE','5   '/
26067      DATA INSHAP(180)/1/
26068      DATA INLONG(180)/'GENERALIZED LOGISTIC TYPE 5'/
26069      DATA INCASE(181)/'G5LO'/
26070      DATA (INAME(181,J),J=1,4)/'GENE','LOGI','TYPE','V   '/
26071      DATA INSHAP(181)/1/
26072      DATA INLONG(181)/'GENERALIZED LOGISTIC TYPE 5'/
26073      DATA INCASE(182)/'G5LO'/
26074      DATA (INAME(182,J),J=1,4)/'GENE','LOGI','HOSK','    '/
26075      DATA INSHAP(182)/1/
26076      DATA INLONG(182)/'GENERALIZED LOGISTIC TYPE 5'/
26077      DATA INCASE(183)/'G5LO'/
26078      DATA (INAME(183,J),J=1,4)/'HOSK','GENE','LOGI','    '/
26079      DATA INSHAP(183)/1/
26080      DATA INLONG(183)/'GENERALIZED LOGISTIC TYPE 5'/
26081      DATA INCASE(184)/'G5LO'/
26082      DATA (INAME(184,J),J=1,4)/'TYPE','5   ','GENE','LOGI'/
26083      DATA INSHAP(184)/1/
26084      DATA INLONG(184)/'GENERALIZED LOGISTIC TYPE 5'/
26085      DATA INCASE(185)/'G5LO'/
26086      DATA (INAME(185,J),J=1,4)/'TYPE','V   ','GENE','LOGI'/
26087      DATA INSHAP(185)/1/
26088      DATA INLONG(185)/'GENERALIZED LOGISTIC TYPE 5'/
26089C     GENERALIZED LOGISTIC TYPE 2
26090      DATA INCASE(186)/'G2LO'/
26091      DATA (INAME(186,J),J=1,4)/'GENE','LOGI','TYPE','2   '/
26092      DATA INSHAP(186)/1/
26093      DATA INLONG(186)/'GENERALIZED LOGISTIC TYPE 2'/
26094      DATA INCASE(187)/'G2LO'/
26095      DATA (INAME(187,J),J=1,4)/'GENE','LOGI','TYPE','II  '/
26096      DATA INSHAP(187)/1/
26097      DATA INLONG(187)/'GENERALIZED LOGISTIC TYPE 2'/
26098      DATA INCASE(188)/'G2LO'/
26099      DATA (INAME(188,J),J=1,4)/'TYPE','2   ','GENE','LOGI'/
26100      DATA INSHAP(188)/1/
26101      DATA INLONG(188)/'GENERALIZED LOGISTIC TYPE 2'/
26102      DATA INCASE(189)/'G2LO'/
26103      DATA (INAME(189,J),J=1,4)/'TYPE','II  ','GENE','LOGI'/
26104      DATA INSHAP(189)/1/
26105      DATA INLONG(189)/'GENERALIZED LOGISTIC TYPE 2'/
26106C     GENERALIZED LOGISTIC TYPE 3
26107      DATA INCASE(190)/'G3LO'/
26108      DATA (INAME(190,J),J=1,4)/'GENE','LOGI','TYPE','3   '/
26109      DATA INSHAP(190)/1/
26110      DATA INLONG(190)/'GENERALIZED LOGISTIC TYPE 3'/
26111      DATA INCASE(191)/'G3LO'/
26112      DATA (INAME(191,J),J=1,4)/'GENE','LOGI','TYPE','III '/
26113      DATA INSHAP(191)/1/
26114      DATA INLONG(191)/'GENERALIZED LOGISTIC TYPE 3'/
26115      DATA INCASE(192)/'G3LO'/
26116      DATA (INAME(192,J),J=1,4)/'TYPE','3   ','GENE','LOGI'/
26117      DATA INSHAP(192)/1/
26118      DATA INLONG(192)/'GENERALIZED LOGISTIC TYPE 3'/
26119      DATA INCASE(193)/'G3LO'/
26120      DATA (INAME(193,J),J=1,4)/'TYPE','III ','GENE','LOGI'/
26121      DATA INSHAP(193)/1/
26122      DATA INLONG(193)/'GENERALIZED LOGISTIC TYPE 3'/
26123C     GENERALIZED LOGISTIC TYPE 4
26124      DATA INCASE(194)/'G4LO'/
26125      DATA (INAME(194,J),J=1,4)/'GENE','LOGI','TYPE','4   '/
26126      DATA INSHAP(194)/2/
26127      DATA INLONG(194)/'GENERALIZED LOGISTIC TYPE 3'/
26128      DATA INCASE(195)/'G4LO'/
26129      DATA (INAME(195,J),J=1,4)/'GENE','LOGI','TYPE','IV  '/
26130      DATA INSHAP(195)/2/
26131      DATA INLONG(195)/'GENERALIZED LOGISTIC TYPE 4'/
26132      DATA INCASE(196)/'G4LO'/
26133      DATA (INAME(196,J),J=1,4)/'TYPE','4   ','GENE','LOGI'/
26134      DATA INSHAP(196)/2/
26135      DATA INLONG(196)/'GENERALIZED LOGISTIC TYPE 4'/
26136      DATA INCASE(197)/'G4LO'/
26137      DATA (INAME(197,J),J=1,4)/'TYPE','IV  ','GENE','LOGI'/
26138      DATA INSHAP(197)/2/
26139      DATA INLONG(197)/'GENERALIZED LOGISTIC TYPE 4'/
26140C     GENERALIZED LOGISTIC
26141      DATA INCASE(198)/'GLOG'/
26142      DATA (INAME(198,J),J=1,4)/'GENE','LOGI','    ','    '/
26143      DATA INSHAP(198)/1/
26144      DATA INLONG(198)/'GENERALIZED LOGISTIC'/
26145C     GENERALIZED TUKEY LAMBDA
26146      DATA INCASE(199)/'GTLA'/
26147      DATA (INAME(199,J),J=1,4)/'GENE','LAMB','    ','    '/
26148      DATA INSHAP(199)/2/
26149      DATA INLONG(199)/'GENERALIZED TUKEY-LAMBDA'/
26150C     BETA GEOMETRIC
26151      DATA INCASE(200)/'BGEO'/
26152      DATA (INAME(200,J),J=1,4)/'BETA','GEOM','    ','    '/
26153      DATA INSHAP(200)/2/
26154      DATA INLONG(200)/'BETA GEOMETRIC'/
26155C     LOG LAPLACE (DOUBLE EXPONENTIAL)
26156      DATA INCASE(201)/'LLAP'/
26157      DATA (INAME(201,J),J=1,4)/'LOG ','DOUB','EXPO','    '/
26158      DATA INSHAP(201)/1/
26159      DATA INLONG(201)/'LOG LAPLACE'/
26160C     ASYMETRIC LOG DOUBLE EXPONENTIAL (LAPLACE)
26161      DATA INCASE(202)/'ALDE'/
26162      DATA (INAME(202,J),J=1,4)/'ASYM','LOG ','DOUB','EXPO'/
26163      DATA INSHAP(202)/2/
26164      DATA INLONG(202)/'ASYMMETRIC LOG DOUBLE EXPONENTIAL'/
26165      DATA INCASE(203)/'ALDE'/
26166      DATA (INAME(203,J),J=1,4)/'ASYM','LOG ','LAPL','    '/
26167      DATA INSHAP(203)/2/
26168      DATA INLONG(203)/'ASYMMETRIC LOG DOUBLE EXPONENTIAL'/
26169C     ZETA
26170      DATA INCASE(204)/'ZETA'/
26171      DATA (INAME(204,J),J=1,4)/'ZETA','    ','    ','    '/
26172      DATA INSHAP(204)/1/
26173      DATA INLONG(204)/'ZETA'/
26174C     ZIPF
26175      DATA INCASE(205)/'ZIPF'/
26176      DATA (INAME(205,J),J=1,4)/'ZIPF','    ','    ','    '/
26177      DATA INSHAP(205)/2/
26178      DATA INLONG(205)/'ZIPF'/
26179C     BETA NEGATIVE BINOMIAL
26180      DATA INCASE(206)/'BNBI'/
26181      DATA (INAME(206,J),J=1,4)/'BETA','NEGA','BINO','    '/
26182      DATA INSHAP(206)/3/
26183      DATA INLONG(206)/'BETA NEGATIVE BINOMIAL'/
26184C     GENERALIZED WARING
26185      DATA INCASE(207)/'GWAR'/
26186      DATA (INAME(207,J),J=1,4)/'GENE','WARI','    ','    '/
26187      DATA INSHAP(207)/3/
26188      DATA INLONG(207)/'GENERALIZED WARING'/
26189C     BOREL TANNER
26190      DATA INCASE(208)/'BTAN'/
26191      DATA (INAME(208,J),J=1,4)/'BORE','TANN','    ','    '/
26192      DATA INSHAP(208)/2/
26193      DATA INLONG(208)/'BOREL TANNER'/
26194C     LOG BETA
26195      DATA INCASE(209)/'LBET'/
26196      DATA (INAME(209,J),J=1,4)/'LOG ','BETA','    ','    '/
26197      DATA INSHAP(209)/4/
26198      DATA INLONG(209)/'LOG BETA'/
26199C     4-PARAMETER BETA
26200      DATA INCASE(210)/'4BET'/
26201      DATA (INAME(210,J),J=1,4)/'4   ','PARA','BETA','    '/
26202      DATA INSHAP(210)/4/
26203      DATA INLONG(210)/'4-PARAMETER BETA'/
26204C     LAGRANGE POISSON
26205      DATA INCASE(211)/'LPOI'/
26206      DATA (INAME(211,J),J=1,4)/'LAGR','POIS','    ','    '/
26207      DATA INSHAP(211)/2/
26208      DATA INLONG(211)/'LAGRANGE POISSON'/
26209C     CONSUL GENERALIZED POISSON
26210      DATA INCASE(212)/'GPOI'/
26211      DATA (INAME(212,J),J=1,4)/'CONS','GENE','POIS','    '/
26212      DATA INSHAP(212)/2/
26213      DATA INLONG(212)/'CONSUL GENERALIZED POISSON'/
26214C     LEADS IN COIN TOSSING
26215      DATA INCASE(213)/'LICT'/
26216      DATA (INAME(213,J),J=1,4)/'LEAD','IN  ','COIN','TOSS'/
26217      DATA INSHAP(213)/1/
26218      DATA INLONG(213)/'LEADS IN COIN TOSSING'/
26219      DATA INCASE(214)/'LICT'/
26220      DATA (INAME(214,J),J=1,4)/'DISC','ARCS','    ','    '/
26221      DATA INSHAP(214)/1/
26222      DATA INLONG(214)/'DISCRETE ARCSINE'/
26223C     MATCHING
26224      DATA INCASE(215)/'MATC'/
26225      DATA (INAME(215,J),J=1,4)/'MATC','    ','    ','    '/
26226      DATA INSHAP(215)/1/
26227      DATA INLONG(215)/'MATCHING'/
26228C     CLASSICAL OCCUPANCY
26229      DATA INCASE(216)/'OCCU'/
26230      DATA (INAME(216,J),J=1,4)/'CLAS','OCCU','    ','    '/
26231      DATA INSHAP(216)/2/
26232      DATA INLONG(216)/'CLASSICAL OCCUPANCY'/
26233C     POLYA
26234      DATA INCASE(217)/'POLY'/
26235      DATA (INAME(217,J),J=1,4)/'POLY','    ','    ','    '/
26236      DATA INSHAP(217)/4/
26237      DATA INLONG(217)/'POLYA'/
26238C     LOST GAMES
26239      DATA INCASE(218)/'LOST'/
26240      DATA (INAME(218,J),J=1,4)/'LOST','GAME','    ','    '/
26241      DATA INSHAP(218)/2/
26242      DATA INLONG(218)/'LOST GAMES'/
26243C     GENERALIZED LOGARITHMIC SERIES
26244      DATA INCASE(219)/'GLOS'/
26245      DATA (INAME(219,J),J=1,4)/'GENE','LOGA','SERI','    '/
26246      DATA INSHAP(219)/2/
26247      DATA INLONG(219)/'GENERALIZED LOGARITHMIC SERIES'/
26248C     GENERALIZED NEGATIVE BINOMIAL
26249      DATA INCASE(220)/'GNBI'/
26250      DATA (INAME(220,J),J=1,4)/'GENE','NEGA','BINO','    '/
26251      DATA INSHAP(220)/2/
26252      DATA INLONG(220)/'GENERALZIED NEGATIVE BINOMIAL'/
26253C     GEETA
26254      DATA INCASE(221)/'GEET'/
26255      DATA (INAME(221,J),J=1,4)/'GEET','    ','    ','    '/
26256      DATA INSHAP(221)/2/
26257      DATA INLONG(221)/'GEETA'/
26258C     QUASI BINOMIAL TYPE I
26259      DATA INCASE(222)/'QBIN'/
26260      DATA (INAME(222,J),J=1,4)/'QUAS','BINO','TYPE','I   '/
26261      DATA INSHAP(222)/3/
26262      DATA INLONG(222)/'QUASI-BINOMIAL TYPE 1'/
26263      DATA INCASE(223)/'QBIN'/
26264      DATA (INAME(223,J),J=1,4)/'QUAS','BINO','TYPE','1   '/
26265      DATA INSHAP(223)/3/
26266      DATA INLONG(223)/'QUASI-BINOMIAL TYPE 1'/
26267      DATA INCASE(224)/'QBIN'/
26268      DATA (INAME(224,J),J=1,4)/'QUAS','BINO','I   ','    '/
26269      DATA INSHAP(224)/3/
26270      DATA INLONG(224)/'QUASI-BINOMIAL TYPE 1'/
26271      DATA INCASE(225)/'QBIN'/
26272      DATA (INAME(225,J),J=1,4)/'QUAS','BINO','1   ','    '/
26273      DATA INSHAP(225)/3/
26274      DATA INLONG(225)/'QUASI-BINOMIAL TYPE 1'/
26275C     CONSUL
26276      DATA INCASE(226)/'CONS'/
26277      DATA (INAME(226,J),J=1,4)/'CONS','    ','    ','    '/
26278      DATA INSHAP(226)/2/
26279      DATA INLONG(226)/'CONSUL'/
26280C     LAGRANZE KATZ
26281      DATA INCASE(227)/'LKAT'/
26282      DATA (INAME(227,J),J=1,4)/'LAGR','KATZ','    ','    '/
26283      DATA INSHAP(227)/3/
26284      DATA INLONG(227)/'LAGRANGE KATZ'/
26285C     KATZ
26286      DATA INCASE(228)/'KATZ'/
26287      DATA (INAME(228,J),J=1,4)/'KATZ','    ','    ','    '/
26288      DATA INSHAP(228)/2/
26289      DATA INLONG(228)/'KATZ'/
26290C     DISCRETE WEIBULL
26291      DATA INCASE(229)/'DISW'/
26292      DATA (INAME(229,J),J=1,4)/'DISC','WEIB','    ','    '/
26293      DATA INSHAP(229)/2/
26294      DATA INLONG(229)/'DISCRETE WEIBULL'/
26295C     GENERALIZED LOST GAMES
26296      DATA INCASE(230)/'GLGP'/
26297      DATA (INAME(230,J),J=1,4)/'GENE','LOST','GAME','    '/
26298      DATA INSHAP(230)/3/
26299      DATA INLONG(230)/'GENERALIZED LOST GAMES'/
26300C     TRUNCATED GENERALIZED NEGATIVE BINOMIAL
26301      DATA INCASE(231)/'TGNB'/
26302      DATA (INAME(231,J),J=1,4)/'TRUN','GENE','NEGA','BINO'/
26303      DATA INSHAP(231)/4/
26304      DATA INLONG(231)/'TRUNCATED GENERALIZED NEGATIVE BINOMIAL'/
26305C     TOPP AND LEONE
26306      DATA INCASE(232)/'TOPL'/
26307      DATA (INAME(232,J),J=1,4)/'TOPP','LEON','    ','    '/
26308      DATA INSHAP(232)/1/
26309      DATA INLONG(232)/'TOPP AND LEONE'/
26310      DATA INCASE(233)/'TOPL'/
26311      DATA (INAME(233,J),J=1,4)/'TOPP','AND ','LEON','    '/
26312      DATA INSHAP(233)/1/
26313      DATA INLONG(233)/'TOPP AND LEONE'/
26314C     GENERALIZED TOPP AND LEONE
26315      DATA INCASE(234)/'GTOL'/
26316      DATA (INAME(234,J),J=1,4)/'GENE','TOPP','AND ','LEON'/
26317      DATA INSHAP(234)/2/
26318      DATA INLONG(234)/'GENERALIZED TOPP AND LEONE'/
26319      DATA INCASE(235)/'GTOL'/
26320      DATA (INAME(235,J),J=1,4)/'GENE','TOPP','LEON','    '/
26321      DATA INSHAP(235)/2/
26322      DATA INLONG(235)/'GENERALIZED TOPP AND LEONE'/
26323C     REFLECTED GENERALIZED TOPP AND LEONE
26324      DATA INCASE(236)/'RGTL'/
26325      DATA (INAME(236,J),J=1,4)/'REFL','GENE','TOPP','LEON'/
26326      DATA INSHAP(236)/2/
26327      DATA INLONG(236)/'REFLECTED GENERALIZED TOPP AND LEONE'/
26328C     SLOPE
26329      DATA INCASE(237)/'SLOP'/
26330      DATA (INAME(237,J),J=1,4)/'SLOP','    ','    ','    '/
26331      DATA INSHAP(237)/1/
26332      DATA INLONG(237)/'SLOPE'/
26333C     TWO-SIDED SLOPE
26334      DATA INCASE(238)/'TSSL'/
26335      DATA (INAME(238,J),J=1,4)/'TWO ','SIDE','SLOP','    '/
26336      DATA INSHAP(238)/2/
26337      DATA INLONG(238)/'TWO-SIDED SLOPE'/
26338C     OGIVE
26339      DATA INCASE(239)/'OGIV'/
26340      DATA (INAME(239,J),J=1,4)/'OGIV','    ','    ','    '/
26341      DATA INSHAP(239)/1/
26342      DATA INLONG(239)/'OGIVE'/
26343C     TWO-SIDED OGIVE
26344      DATA INCASE(240)/'TSOG'/
26345      DATA (INAME(240,J),J=1,4)/'TWO ','SIDE','OGIV','    '/
26346      DATA INSHAP(240)/2/
26347      DATA INLONG(240)/'TWO-SIDED OGIVE'/
26348C     BURR TYPE 1
26349      DATA INCASE(241)/'UNIF'/
26350      DATA (INAME(241,J),J=1,4)/'BURR','TYPE','1   ','    '/
26351      DATA INSHAP(241)/0/
26352      DATA INLONG(241)/'BURR TYPE 1'/
26353      DATA INCASE(242)/'UNIF'/
26354      DATA (INAME(242,J),J=1,4)/'BURR','TYPE','I   ','    '/
26355      DATA INSHAP(242)/0/
26356      DATA INLONG(242)/'BURR TYPE 1'/
26357C     BURR TYPE 2
26358      DATA INCASE(243)/'BUR2'/
26359      DATA (INAME(243,J),J=1,4)/'BURR','TYPE','2   ','    '/
26360      DATA INSHAP(243)/1/
26361      DATA INLONG(243)/'BURR TYPE 2'/
26362      DATA INCASE(244)/'BUR2'/
26363      DATA (INAME(244,J),J=1,4)/'BURR','TYPE','II  ','    '/
26364      DATA INSHAP(244)/1/
26365      DATA INLONG(244)/'BURR TYPE 2'/
26366C     BURR TYPE 3
26367      DATA INCASE(245)/'BUR3'/
26368      DATA (INAME(245,J),J=1,4)/'BURR','TYPE','3   ','    '/
26369      DATA INSHAP(245)/2/
26370      DATA INLONG(245)/'BURR TYPE 3'/
26371      DATA INCASE(246)/'BUR3'/
26372      DATA (INAME(246,J),J=1,4)/'BURR','TYPE','3   ','    '/
26373      DATA INSHAP(246)/2/
26374      DATA INLONG(246)/'BURR TYPE 3'/
26375C     BURR TYPE 4
26376      DATA INCASE(247)/'BUR4'/
26377      DATA (INAME(247,J),J=1,4)/'BURR','TYPE','4   ','    '/
26378      DATA INSHAP(247)/2/
26379      DATA INLONG(247)/'BURR TYPE 4'/
26380      DATA INCASE(248)/'BUR4'/
26381      DATA (INAME(248,J),J=1,4)/'BURR','TYPE','IV  ','    '/
26382      DATA INSHAP(248)/2/
26383      DATA INLONG(248)/'BURR TYPE 4'/
26384C     BURR TYPE 5
26385      DATA INCASE(249)/'BUR5'/
26386      DATA (INAME(249,J),J=1,4)/'BURR','TYPE','5   ','    '/
26387      DATA INSHAP(249)/2/
26388      DATA INLONG(249)/'BURR TYPE 5'/
26389      DATA INCASE(250)/'BUR5'/
26390      DATA (INAME(250,J),J=1,4)/'BURR','TYPE','V   ','    '/
26391      DATA INSHAP(250)/2/
26392      DATA INLONG(250)/'BURR TYPE 5'/
26393C     BURR TYPE 6
26394      DATA INCASE(251)/'BUR6'/
26395      DATA (INAME(251,J),J=1,4)/'BURR','TYPE','6   ','    '/
26396      DATA INSHAP(251)/2/
26397      DATA INLONG(251)/'BURR TYPE 6'/
26398      DATA INCASE(252)/'BUR6'/
26399      DATA (INAME(252,J),J=1,4)/'BURR','TYPE','VI  ','    '/
26400      DATA INSHAP(252)/2/
26401      DATA INLONG(252)/'BURR TYPE 6'/
26402C     BURR TYPE 7
26403      DATA INCASE(253)/'BUR7'/
26404      DATA (INAME(253,J),J=1,4)/'BURR','TYPE','7   ','    '/
26405      DATA INSHAP(253)/1/
26406      DATA INLONG(253)/'BURR TYPE 7'/
26407      DATA INCASE(254)/'BUR7'/
26408      DATA (INAME(254,J),J=1,4)/'BURR','TYPE','VII ','    '/
26409      DATA INSHAP(254)/1/
26410      DATA INLONG(254)/'BURR TYPE 7'/
26411C     BURR TYPE 8
26412      DATA INCASE(255)/'BUR8'/
26413      DATA (INAME(255,J),J=1,4)/'BURR','TYPE','8   ','    '/
26414      DATA INSHAP(255)/1/
26415      DATA INLONG(255)/'BURR TYPE 8'/
26416      DATA INCASE(256)/'BUR8'/
26417      DATA (INAME(256,J),J=1,4)/'BURR','TYPE','VIII','    '/
26418      DATA INSHAP(256)/1/
26419      DATA INLONG(256)/'BURR TYPE 8'/
26420C     BURR TYPE 9
26421      DATA INCASE(257)/'BUR9'/
26422      DATA (INAME(257,J),J=1,4)/'BURR','TYPE','9   ','    '/
26423      DATA INSHAP(257)/2/
26424      DATA INLONG(257)/'BURR TYPE 9'/
26425      DATA INCASE(258)/'BUR9'/
26426      DATA (INAME(258,J),J=1,4)/'BURR','TYPE','IX  ','    '/
26427      DATA INSHAP(258)/2/
26428      DATA INLONG(258)/'BURR TYPE 9'/
26429C     BURR TYPE 10
26430      DATA INCASE(259)/'BU10'/
26431      DATA (INAME(259,J),J=1,4)/'BURR','TYPE','10  ','    '/
26432      DATA INSHAP(259)/1/
26433      DATA INLONG(259)/'BURR TYPE 10'/
26434      DATA INCASE(260)/'BU10'/
26435      DATA (INAME(260,J),J=1,4)/'BURR','TYPE','X   ','    '/
26436      DATA INSHAP(260)/1/
26437      DATA INLONG(260)/'BURR TYPE 10'/
26438C     BURR TYPE 11
26439      DATA INCASE(261)/'BU11'/
26440      DATA (INAME(261,J),J=1,4)/'BURR','TYPE','11  ','    '/
26441      DATA INSHAP(261)/1/
26442      DATA INLONG(261)/'BURR TYPE 11'/
26443      DATA INCASE(262)/'BU11'/
26444      DATA (INAME(262,J),J=1,4)/'BURR','TYPE','XI  ','    '/
26445      DATA INSHAP(262)/1/
26446      DATA INLONG(262)/'BURR TYPE 11'/
26447C     BURR TYPE 12
26448      DATA INCASE(263)/'BU12'/
26449      DATA (INAME(263,J),J=1,4)/'BURR','TYPE','12  ','    '/
26450      DATA INSHAP(263)/2/
26451      DATA INLONG(263)/'BURR TYPE 12'/
26452      DATA INCASE(264)/'BU12'/
26453      DATA (INAME(264,J),J=1,4)/'BURR','TYPE','XII ','    '/
26454      DATA INSHAP(264)/2/
26455      DATA INLONG(264)/'BURR TYPE 12'/
26456C     UNEVEN TWO-SIDED POWER
26457      DATA INCASE(265)/'UTSP'/
26458      DATA (INAME(265,J),J=1,4)/'UNEV','TWO ','SIDE','POWE'/
26459      DATA INSHAP(265)/6/
26460      DATA INLONG(265)/'UNEVEN TWO-SIDED POWER'/
26461C     DOUBLY PARETO UNIFORM
26462      DATA INCASE(266)/'DPUN'/
26463      DATA (INAME(266,J),J=1,4)/'DOUB','PARE','UNIF','    '/
26464      DATA INSHAP(266)/2/
26465      DATA INLONG(266)/'DOUBLY PARETO UNIFORM'/
26466C     KUMAR
26467      DATA INCASE(267)/'KUMA'/
26468      DATA (INAME(267,J),J=1,4)/'KUMA','    ','    ','    '/
26469      DATA INSHAP(267)/2/
26470      DATA INLONG(267)/'KUMARASWAMY'/
26471C     REFLECTED POWER
26472      DATA INCASE(268)/'RPOW'/
26473      DATA (INAME(268,J),J=1,4)/'REFL','POWE','    ','    '/
26474      DATA INSHAP(268)/1/
26475      DATA INLONG(268)/'REFLECTED POWER'/
26476C     MUTH
26477      DATA INCASE(269)/'MUTH'/
26478      DATA (INAME(269,J),J=1,4)/'MUTH','    ','    ','    '/
26479      DATA INSHAP(269)/1/
26480      DATA INLONG(269)/'MUTH'/
26481C     LOGISTIC
26482      DATA INCASE(270)/'LOGI'/
26483      DATA (INAME(270,J),J=1,4)/'LOGI','    ','    ','    '/
26484      DATA INSHAP(270)/0/
26485      DATA INLONG(270)/'LOGISTIC'/
26486C     TRUNCATED PARETO
26487      DATA INCASE(271)/'TPAR'/
26488      DATA (INAME(271,J),J=1,4)/'TRUN','PARE','    ','    '/
26489      DATA INSHAP(271)/3/
26490      DATA INLONG(271)/'TRUNCATED PARETO'/
26491C     BRITTLE FRACTURE
26492      DATA INCASE(272)/'BFRA'/
26493      DATA (INAME(272,J),J=1,4)/'BRIT','FRAC','    ','    '/
26494      DATA INSHAP(272)/3/
26495      DATA INLONG(272)/'BRITTLE FRACTURE'/
26496C     3-PARAMETER LOGISTIC EXPONENTIAL
26497      DATA INCASE(273)/'L3EX'/
26498      DATA (INAME(273,J),J=1,4)/'3   ','PARA','LOGI','EXPO'/
26499      DATA INSHAP(273)/3/
26500      DATA INLONG(273)/'3-PARAMETER LOGISTIC EXPONENTIAL'/
26501C     KAPPA
26502      DATA INCASE(274)/'KAPP'/
26503      DATA (INAME(274,J),J=1,4)/'KAPP','    ','    ','    '/
26504      DATA INSHAP(274)/2/
26505      DATA INLONG(274)/'KAPPA'/
26506C     PEARSON TYPE 3
26507      DATA INCASE(275)/'PEA3'/
26508      DATA (INAME(275,J),J=1,4)/'PEAR','TYPE','III ','    '/
26509      DATA INSHAP(275)/1/
26510      DATA INLONG(275)/'PEARSON TYPE 3'/
26511      DATA INCASE(276)/'PEA3'/
26512      DATA (INAME(276,J),J=1,4)/'PEAR','TYPE','3   ','    '/
26513      DATA INSHAP(276)/1/
26514      DATA INLONG(276)/'PEARSON TYPE 3'/
26515C     DOUBLY NONCENTRAL BETA
26516      DATA INCASE(277)/'DNCB'/
26517      DATA (INAME(277,J),J=1,4)/'DOUB','NONC','BETA','    '/
26518      DATA INSHAP(277)/4/
26519      DATA INLONG(277)/'DOUBLY NON-CENTRAL BETA'/
26520C     POWER
26521      DATA INCASE(278)/'POWF'/
26522      DATA (INAME(278,J),J=1,4)/'POWE','    ','    ','    '/
26523      DATA INSHAP(278)/1/
26524      DATA INLONG(278)/'POWER'/
26525C     3-PARAMETER WEIBULL
26526      DATA INCASE(279)/'3WEI'/
26527      DATA (INAME(279,J),J=1,4)/'3   ','PARA','WEIB','    '/
26528      DATA INSHAP(279)/1/
26529      DATA INLONG(279)/'3-PARAMETER WEIBULL'/
26530C     3-PARAMETER INVERTED WEIBULL
26531      DATA INCASE(280)/'3IWE'/
26532      DATA (INAME(280,J),J=1,4)/'3   ','PARA','INVE','WEIB'/
26533      DATA INSHAP(280)/1/
26534      DATA INLONG(280)/'3-PARAMETER INVERTED WEIBULL'/
26535C     3-PARAMETER GAMMA
26536      DATA INCASE(281)/'3GAM'/
26537      DATA (INAME(281,J),J=1,4)/'3   ','PARA','GAMM','    '/
26538      DATA INSHAP(281)/1/
26539      DATA INLONG(281)/'3-PARAMETER GAMMA'/
26540C     3-PARAMETER INVERSE GAUSSIAN
26541      DATA INCASE(282)/'3IGA'/
26542      DATA (INAME(282,J),J=1,4)/'3   ','PARA','INVE','GAUS'/
26543      DATA INSHAP(282)/2/
26544      DATA INLONG(282)/'3-PARAMETER INVERSE GAUSSIAN'/
26545C     3-PARAMETER LOGNORMAL
26546      DATA INCASE(283)/'3LGN'/
26547      DATA (INAME(283,J),J=1,4)/'3   ','PARA','LOGN','    '/
26548      DATA INSHAP(283)/1/
26549      DATA INLONG(283)/'3-PARAMETER LOGNORMAL'/
26550C     1-PARAMETER EXPONENTIAL
26551      DATA INCASE(284)/'1EXP'/
26552      DATA (INAME(284,J),J=1,4)/'1   ','PARA','EXPO','    '/
26553      DATA INSHAP(284)/0/
26554      DATA INLONG(284)/'1-PARAMETER EXPONENTIAL'/
26555C     1-PARAMETER EXPONENTIAL
26556      DATA INCASE(285)/'1EXP'/
26557      DATA (INAME(285,J),J=1,4)/'ONE ','PARA','EXPO','    '/
26558      DATA INSHAP(285)/0/
26559      DATA INLONG(285)/'1-PARAMETER EXPONENTIAL'/
26560C     2-PARAMETER EXPONENTIAL
26561      DATA INCASE(286)/'EXPO'/
26562      DATA (INAME(286,J),J=1,4)/'2   ','PARA','EXPO','    '/
26563      DATA INSHAP(286)/0/
26564      DATA INLONG(286)/'EXPONENTIAL'/
26565C     2-PARAMETER EXPONENTIAL
26566      DATA INCASE(287)/'EXPO'/
26567      DATA (INAME(287,J),J=1,4)/'TWO ','PARA','EXPO','    '/
26568      DATA INSHAP(287)/0/
26569      DATA INLONG(287)/'EXPONENTIAL'/
26570C     1-PARAMETER RAYLEIGH
26571      DATA INCASE(288)/'1RAY'/
26572      DATA (INAME(288,J),J=1,4)/'1   ','PARA','RAYL','    '/
26573      DATA INSHAP(288)/0/
26574      DATA INLONG(288)/'1-PARAMETER RAYLEIGH'/
26575C     1-PARAMETER RAYLEIGH
26576      DATA INCASE(289)/'1RAY'/
26577      DATA (INAME(289,J),J=1,4)/'ONE ','PARA','RAYL','    '/
26578      DATA INSHAP(289)/0/
26579      DATA INLONG(289)/'1-PARAMETER RAYLEIGH'/
26580C     2-PARAMETER RAYLEIGH
26581      DATA INCASE(290)/'RAYL'/
26582      DATA (INAME(290,J),J=1,4)/'2   ','PARA','RAYL','    '/
26583      DATA INSHAP(290)/0/
26584      DATA INLONG(290)/'RAYLEIGH'/
26585C     2-PARAMETER RAYLEIGH
26586      DATA INCASE(291)/'RAYL'/
26587      DATA (INAME(291,J),J=1,4)/'TWO ','PARA','RAYL','    '/
26588      DATA INSHAP(291)/0/
26589      DATA INLONG(291)/'RAYLEIGH'/
26590C     1-PARAMETER MAXWELL
26591      DATA INCASE(292)/'1MAX'/
26592      DATA (INAME(292,J),J=1,4)/'1   ','PARA','MAXW','    '/
26593      DATA INSHAP(292)/0/
26594      DATA INLONG(292)/'1-PARAMETER MAXWELL'/
26595C     1-PARAMETER MAXWELL
26596      DATA INCASE(293)/'1MAX'/
26597      DATA (INAME(293,J),J=1,4)/'ONE ','PARA','MAXW','    '/
26598      DATA INSHAP(293)/0/
26599      DATA INLONG(293)/'1-PARAMETER MAXWELL'/
26600C     2-PARAMETER MAXWELL
26601      DATA INCASE(294)/'MAXW'/
26602      DATA (INAME(294,J),J=1,4)/'2   ','PARA','MAXW','    '/
26603      DATA INSHAP(294)/0/
26604      DATA INLONG(294)/'MAXWELL'/
26605C     2-PARAMETER MAXWELL
26606      DATA INCASE(295)/'MAXW'/
26607      DATA (INAME(295,J),J=1,4)/'TWO ','PARA','MAXW','    '/
26608      DATA INSHAP(295)/0/
26609      DATA INLONG(295)/'MAXWELL'/
26610C     HALF WILL BE INTERPRETED AS HALF-NORMAL (TO SUPPORT
26611C     HALFNORMAL PROB PLOT Y SYNTAX)
26612      DATA INCASE(296)/'HNOR'/
26613      DATA (INAME(296,J),J=1,4)/'HALF','    ','    ','    '/
26614      DATA INSHAP(296)/0/
26615      DATA INLONG(296)/'HALF-NORMAL'/
26616C     END EFFECTS WEIBULL
26617      DATA INCASE(297)/'EEWE'/
26618      DATA (INAME(297,J),J=1,4)/'END ','EFFE','WEIB','    '/
26619      DATA INSHAP(297)/5/
26620      DATA INLONG(297)/'END-EFFECTS WEIBULL'/
26621C     BRITTLE FIBER WEIBULL
26622      DATA INCASE(298)/'BFWE'/
26623      DATA (INAME(298,J),J=1,4)/'BRIT','FIBE','WEIB','    '/
26624      DATA INSHAP(298)/1/
26625      DATA INLONG(298)/'BRITTLE FIBER WEIBULL'/
26626C     ARCTANGENT
26627      DATA INCASE(299)/'ARCT'/
26628      DATA (INAME(299,J),J=1,4)/'ARCT','    ','    ','    '/
26629      DATA INSHAP(299)/2/
26630      DATA INLONG(299)/'ARCTANGENT'/
26631C     SINE
26632      DATA INCASE(300)/'SINE'/
26633      DATA (INAME(300,J),J=1,4)/'SINE','    ','    ','    '/
26634      DATA INSHAP(300)/0/
26635      DATA INLONG(300)/'SINE'/
26636C     3-PARAMETER LOGNORMAL
26637      DATA INCASE(301)/'3LGN'/
26638      DATA (INAME(301,J),J=1,4)/'3   ','PARA','LOG ','NORM'/
26639      DATA INSHAP(301)/1/
26640      DATA INLONG(301)/'3-PARAMETER LOGNORMAL'/
26641C     G
26642      DATA INCASE(302)/'GPP '/
26643      DATA (INAME(302,J),J=1,4)/'G   ','    ','    ','    '/
26644      DATA INSHAP(302)/1/
26645      DATA INLONG(302)/'G'/
26646C     H
26647      DATA INCASE(303)/'HPP '/
26648      DATA (INAME(303,J),J=1,4)/'H   ','    ','    ','    '/
26649      DATA INSHAP(303)/1/
26650      DATA INLONG(303)/'H'/
26651C     4-PARAMETER BETA
26652      DATA INCASE(304)/'4BET'/
26653      DATA (INAME(304,J),J=1,4)/'FOUR','PARA','BETA','    '/
26654      DATA INSHAP(304)/4/
26655      DATA INLONG(304)/'4-PARAMETER BETA'/
26656C     BETA
26657      DATA INCASE(305)/'BETA'/
26658      DATA (INAME(305,J),J=1,4)/'BETA','    ','    ','    '/
26659      DATA INSHAP(305)/4/
26660      DATA INLONG(305)/'BETA'/
26661C     REFLECTED POWER
26662      DATA INCASE(306)/'RPOW'/
26663      DATA (INAME(306,J),J=1,4)/'REVE','POWE','    ','    '/
26664      DATA INSHAP(306)/1/
26665      DATA INLONG(306)/'REFLECTED POWER'/
26666C     REFLECTED POWER
26667      DATA INCASE(307)/'RPOW'/
26668      DATA (INAME(307,J),J=1,4)/'REFL','POWE','    ','    '/
26669      DATA INSHAP(307)/1/
26670      DATA INLONG(307)/'REFLECTED POWER'/
26671C     DEHAAN (GENERALIZED PARETO)
26672      DATA INCASE(308)/'GPDE'/
26673      DATA (INAME(308,J),J=1,4)/'DEHA','    ','    ','    '/
26674      DATA INSHAP(308)/1/
26675      DATA INLONG(308)/'DEHAAN (GENERALIZED PARETO)'/
26676C     CONDITIONAL MEAN EXCEEDANCE (GENERALIZED PARETO)
26677      DATA INCASE(309)/'GPCM'/
26678      DATA (INAME(309,J),J=1,4)/'CME ','    ','    ','    '/
26679      DATA INSHAP(309)/1/
26680      DATA INLONG(309)/'CME (GENERALIZED PARETO)'/
26681C     CONDITIONAL MEAN EXCEEDANCE (GENERALIZED PARETO)
26682      DATA INCASE(310)/'GPCM'/
26683      DATA (INAME(310,J),J=1,4)/'COND','MEAN','EXCE','    '/
26684      DATA INSHAP(310)/1/
26685      DATA INLONG(310)/'CME (GENERALIZED PARETO)'/
26686C     EXPONENTIAL LAW
26687      DATA INCASE(311)/'ELML'/
26688      DATA (INAME(311,J),J=1,4)/'EXPO','LAW ','    ','    '/
26689      DATA INSHAP(311)/2/
26690      DATA INLONG(311)/'EXPONENTIAL LAW'/
26691C     3-PARAMETER WEIBULL
26692      DATA INCASE(312)/'3WEI'/
26693      DATA (INAME(312,J),J=1,4)/'3   ','PAR ','WEIB','    '/
26694      DATA INSHAP(312)/1/
26695      DATA INLONG(312)/'3-PARAMETER WEIBULL'/
26696C     3-PARAMETER INVERTED WEIBULL
26697      DATA INCASE(313)/'3IWE'/
26698      DATA (INAME(313,J),J=1,4)/'3   ','PAR ','INVE','WEIB'/
26699      DATA INSHAP(313)/1/
26700      DATA INLONG(313)/'3-PARAMETER INVERTED WEIBULL'/
26701C     3-PARAMETER GAMMA
26702      DATA INCASE(314)/'3GAM'/
26703      DATA (INAME(314,J),J=1,4)/'3   ','PAR ','GAMM','    '/
26704      DATA INSHAP(314)/1/
26705      DATA INLONG(314)/'3-PARAMETER GAMMA'/
26706C     3-PARAMETER INVERSE GAUSSIAN
26707      DATA INCASE(315)/'3IGA'/
26708      DATA (INAME(315,J),J=1,4)/'3   ','PAR ','INVE','GAUS'/
26709      DATA INSHAP(315)/2/
26710      DATA INLONG(315)/'3-PARAMETER INVERSE GAUSSIAN'/
26711C     3-PARAMETER LOGNORMAL
26712      DATA INCASE(316)/'3LGN'/
26713      DATA (INAME(316,J),J=1,4)/'3   ','PAR ','LOGN','    '/
26714      DATA INSHAP(316)/1/
26715      DATA INLONG(316)/'3-PARAMETER LOGNORMAL'/
26716C     3-PARAMETER INVERSE GAUSSIAN
26717      DATA INCASE(317)/'3IGA'/
26718      DATA (INAME(317,J),J=1,4)/'3   ','PAR ','INVE','GAUS'/
26719      DATA INSHAP(317)/2/
26720      DATA INLONG(317)/'3-PARAMETER INVERSE GAUSSIAN'/
26721C     JOHNSON
26722      DATA INCASE(318)/'JOHN'/
26723      DATA (INAME(318,J),J=1,4)/'JOHN','    ','    ','    '/
26724      DATA INSHAP(318)/2/
26725      DATA INLONG(318)/'JOHNSON SB/SU'/
26726C     3-PARAMETER FRECHET
26727      DATA INCASE(319)/'3EV2'/
26728      DATA (INAME(319,J),J=1,4)/'3   ','PARA','FREC','    '/
26729      DATA INSHAP(319)/1/
26730      DATA INLONG(319)/'3-PARAMETER FRECHET'/
26731C     3-PARAMETER FRECHET
26732      DATA INCASE(320)/'3EV2'/
26733      DATA (INAME(320,J),J=1,4)/'3   ','PAR ','FREC','    '/
26734      DATA INSHAP(320)/1/
26735      DATA INLONG(320)/'3-PARAMETER FRECHET'/
26736C     3-PARAMETER FRECHET
26737      DATA INCASE(321)/'3EV2'/
26738      DATA (INAME(321,J),J=1,4)/'3PAR','FREC','    ','    '/
26739      DATA INSHAP(321)/1/
26740      DATA INLONG(321)/'3-PARAMETER FRECHET'/
26741C     3-PARAMETER FRECHET
26742      DATA INCASE(322)/'3EV2'/
26743      DATA (INAME(322,J),J=1,4)/'3PAR','EXTR','VALU','TWO '/
26744      DATA INSHAP(322)/1/
26745      DATA INLONG(322)/'3-PARAMETER FRECHET'/
26746C     3-PARAMETER FRECHET
26747      DATA INCASE(323)/'3EV2'/
26748      DATA (INAME(323,J),J=1,4)/'3PAR','EXTR','VALU','2   '/
26749      DATA INSHAP(323)/1/
26750      DATA INLONG(323)/'3-PARAMETER FRECHET'/
26751C     3-PARAMETER FRECHET
26752      DATA INCASE(323)/'3EV2'/
26753      DATA (INAME(323,J),J=1,4)/'3   ','PARA','EV2 ','    '/
26754      DATA INSHAP(323)/1/
26755      DATA INLONG(323)/'3-PARAMETER FRECHET'/
26756C     3-PARAMETER FRECHET
26757      DATA INCASE(324)/'3EV2'/
26758      DATA (INAME(324,J),J=1,4)/'3   ','PAR ','EV2 ','    '/
26759      DATA INSHAP(324)/1/
26760      DATA INLONG(324)/'3-PARAMETER FRECHET'/
26761C     3-PARAMETER FRECHET
26762      DATA INCASE(325)/'3EV2'/
26763      DATA (INAME(325,J),J=1,4)/'3PAR','EV2 ','    ','    '/
26764      DATA INSHAP(325)/1/
26765      DATA INLONG(325)/'3-PARAMETER FRECHET'/
26766C     1-PARAMETER HALF-NORMAL
26767      DATA INCASE(326)/'1HNO'/
26768      DATA (INAME(326,J),J=1,4)/'1   ','PARA','HALF','NORM'/
26769      DATA INSHAP(326)/0/
26770      DATA INLONG(326)/'1-PARAMETER HALF-NORMAL'/
26771C     1-PARAMETER HALF-NORMAL
26772      DATA INCASE(327)/'1HNO'/
26773      DATA (INAME(327,J),J=1,4)/'ONE ','PARA','HALF','NORM'/
26774      DATA INSHAP(327)/0/
26775      DATA INLONG(327)/'1-PARAMETER HALF-NORMAL'/
26776C     1-PARAMETER HALF-LOGISTIC
26777      DATA INCASE(328)/'1HAL'/
26778      DATA (INAME(328,J),J=1,4)/'1   ','PARA','HALF','LOGI'/
26779      DATA INSHAP(328)/0/
26780      DATA INLONG(328)/'1-PARAMETER HALF-LOGISITC'/
26781C     1-PARAMETER HALF-LOGISTIC
26782      DATA INCASE(329)/'1HAL'/
26783      DATA (INAME(329,J),J=1,4)/'ONE ','PARA','HALF','LOGI'/
26784      DATA INSHAP(329)/0/
26785      DATA INLONG(329)/'1-PARAMETER HALF-LOGISITC'/
26786C
26787C-----START POINT-----------------------------------------------------
26788C
26789      ISUBN1='EXTD'
26790      ISUBN2='IS  '
26791      IWRITE='OFF'
26792      IFOUND='NO'
26793      IERROR='NO'
26794C
26795      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TDIS')THEN
26796        WRITE(ICOUT,999)
26797  999   FORMAT(1X)
26798        CALL DPWRST('XXX','BUG ')
26799        WRITE(ICOUT,51)
26800   51   FORMAT('***** AT THE BEGINNING OF EXTDIS--')
26801        CALL DPWRST('XXX','BUG ')
26802        WRITE(ICOUT,52)IBUGG3,ISUBRO,NUMARG,JMIN,JMAX
26803   52   FORMAT('IBUGG3,ISUBRO,NUMARG,JMIN,JMAX = ',A4,2X,A4,3I8)
26804        CALL DPWRST('XXX','BUG ')
26805        WRITE(ICOUT,53)ICOM,ICOM2
26806   53   FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
26807        CALL DPWRST('XXX','BUG ')
26808        IF(NUMARG.GE.1)THEN
26809          DO60I=1,NUMARG
26810            WRITE(ICOUT,61)I,IHARG(I),IHARG2(I)
26811   61       FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,2X,A4)
26812            CALL DPWRST('XXX','BUG ')
26813   60     CONTINUE
26814        ENDIF
26815        WRITE(ICOUT,63)MAXDIS
26816   63   FORMAT('MAXDIS = ',I8)
26817        CALL DPWRST('XXX','BUG ')
26818      ENDIF
26819C
26820C     STEP 1: INITIALIZE THE MATCHING VARIABLE
26821C
26822      DO1010I=1,MAXDIS
26823        INTEMP(I)='    '
26824 1010 CONTINUE
26825      IF(JMIN.EQ.0)THEN
26826        INTEMP(1)=ICOM
26827        ICNT=1
26828        IF(JMIN.LT.JMAX)THEN
26829          DO1020I=JMIN+1,JMAX
26830            ICNT=ICNT+1
26831            INTEMP(ICNT)=IHARG(I)
26832 1020     CONTINUE
26833        ENDIF
26834C
26835        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TDIS')THEN
26836           WRITE(ICOUT,999)
26837           CALL DPWRST('XXX','BUG ')
26838           WRITE(ICOUT,1021)ICNT
26839 1021      FORMAT('JMIN = 0 CASE, ICNT = ',I8)
26840           CALL DPWRST('XXX','BUG ')
26841           DO1022II=1,ICNT
26842             WRITE(ICOUT,1023)II,INTEMP(II)
26843 1023        FORMAT('II,INTEMP(II) = ',I8,A4)
26844             CALL DPWRST('XXX','BUG ')
26845 1022      CONTINUE
26846        ENDIF
26847C
26848      ELSE
26849        INTEMP(1)=IHARG(JMIN)
26850        ICNT=1
26851        IF(JMAX.GT.JMIN)THEN
26852          DO1030I=JMIN+1,JMAX
26853            ICNT=ICNT+1
26854            INTEMP(ICNT)=IHARG(I)
26855 1030     CONTINUE
26856        ENDIF
26857C
26858        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TDIS')THEN
26859           WRITE(ICOUT,999)
26860           CALL DPWRST('XXX','BUG ')
26861           WRITE(ICOUT,1031)ICNT
26862 1031      FORMAT('JMIN > 0 CASE, ICNT = ',I8)
26863           CALL DPWRST('XXX','BUG ')
26864           DO1032II=1,ICNT
26865             WRITE(ICOUT,1033)II,INTEMP(II)
26866 1033        FORMAT('II,INTEMP(II) = ',I8,A4)
26867             CALL DPWRST('XXX','BUG ')
26868 1032      CONTINUE
26869        ENDIF
26870C
26871      ENDIF
26872C
26873C     STEP 2: NOW CHECK IF MATCHING VARIABLE MATCHES AN ENTRY
26874C             IN THE TABLE.  NOTE THAT WE NEED TO CHECK FOR
26875C             NAME CONFLICTS IN FIRST 4 CHARACTERS OF FIRST
26876C             ARGUMENT.
26877C
26878      DO2000I=1,MAXDIS
26879        IROW=I
26880        IF(INAME(I,1).NE.INTEMP(1))GOTO2000
26881C
26882        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TDIS')THEN
26883           WRITE(ICOUT,999)
26884           CALL DPWRST('XXX','BUG ')
26885           WRITE(ICOUT,2001)I,INAME(I,1),INTEMP(1)
26886 2001      FORMAT('I,INAME(I,1),INTEMP(1) = ',I8,2X,A4,2X,A4)
26887           CALL DPWRST('XXX','BUG ')
26888        ENDIF
26889C
26890C       NOW CHECK IF REMAINING ARGUMENTS MATCH
26891C
26892        ITEMP=1
26893        DO2022J=2,MAXSCL
26894          IF(INAME(IROW,J).NE.'    ')GOTO2022
26895            ITEMP=J-1
26896            GOTO2024
26897 2022   CONTINUE
26898        ITEMP=MAXSCL
26899 2024   CONTINUE
26900C
26901        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TDIS')THEN
26902           WRITE(ICOUT,2027)IROW,ITEMP
26903 2027      FORMAT('IROW,ITEMP = ',2I8)
26904           CALL DPWRST('XXX','BUG ')
26905        ENDIF
26906C
26907        IF(ITEMP.GT.1)THEN
26908          DO2028J=2,ITEMP
26909            IF(INAME(IROW,J).NE.INTEMP(J))GOTO2000
26910 2028     CONTINUE
26911        ENDIF
26912C
26913        IFOUND='YES'
26914        IF(ITEMP.EQ.1)THEN
26915          ILOCV=JMIN+1
26916        ELSE
26917          ILOCV=JMIN+(ITEMP-2)+1
26918        ENDIF
26919        IDISCS=INCASE(IROW)
26920        IDISPR=INSHAP(IROW)
26921        IDISNM=INLONG(IROW)
26922        GOTO2099
26923C
26924 2000 CONTINUE
26925 2099 CONTINUE
26926C
26927C
26928C               ******************
26929C               **   STEP 90--  **
26930C               **   EXIT       **
26931C               ******************
26932C
26933      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TDIS')THEN
26934        WRITE(ICOUT,999)
26935        CALL DPWRST('XXX','BUG ')
26936        WRITE(ICOUT,9011)
26937 9011   FORMAT('***** AT THE END       OF EXTDIS--')
26938        CALL DPWRST('XXX','BUG ')
26939        WRITE(ICOUT,9012)IBUGG3,ISUBRO,IFOUND
26940 9012   FORMAT('IBUGG3,ISUBRO,IFOUND = ',A4,2X,A4,2X,A4)
26941        CALL DPWRST('XXX','BUG ')
26942        IF(IFOUND.EQ.'YES')THEN
26943          WRITE(ICOUT,9013)IDISCS,IDISPR,ILOCV
26944 9013     FORMAT('IDISCS,IDISPR,ILOCV = ',A4,2X,I5,2X,2I8)
26945          CALL DPWRST('XXX','BUG ')
26946          WRITE(ICOUT,9014)IDISNM
26947 9014     FORMAT('IDISNM = ',A60)
26948          CALL DPWRST('XXX','BUG ')
26949        ENDIF
26950      ENDIF
26951C
26952      RETURN
26953      END
26954      SUBROUTINE EXTDST(ICASPL,IDISFL,ILOWLM,
26955     1                  SHAPE1,SHAPE2,SHAPE3,SHAPE4,
26956     1                  SHAPE5,SHAPE6,SHAPE7,
26957     1                  IADEDF,IGEPDF,IMAKDF,IBEIDF,
26958     1                  ILGADF,ISKNDF,IGLDDF,IBGEDF,
26959     1                  IGETDF,ICONDF,IGOMDF,IKATDF,
26960     1                  IGIGDF,IGEODF)
26961C
26962C     PURPOSE--SET VALUE OF IDISFL TO "CONT" OR "DISC" DEPENDING
26963C              ON WHETHER WE HAVE A CONTINOUS OR A DISCRETE
26964C              DISTRIBUTION.  ALSO RETURN THE VALUE OF THE LOWER LIMIT
26965C              (TYPICALLY EITHER 0 OR 1) IN ILOWLM.
26966C     WRITTEN BY--ALAN HECKERT
26967C                 STATISTICAL ENGINEERING DIVISION
26968C                 INFORMATION TECHNOLOGY LABORAOTRY
26969C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
26970C                 GAITHERSBURG, MD 20899-8980
26971C                 PHONE--301-975-2899
26972C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
26973C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
26974C     LANGUAGE--ANSI FORTRAN (1977)
26975C     VERSION NUMBER--2010/1
26976C     ORIGINAL VERSION--JANUARY   2010.
26977C
26978C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
26979C
26980      CHARACTER*4 ICASPL
26981      CHARACTER*4 IDISFL
26982      CHARACTER*4 IADEDF
26983      CHARACTER*4 IGEPDF
26984      CHARACTER*4 IMAKDF
26985      CHARACTER*4 IBEIDF
26986      CHARACTER*4 ILGADF
26987      CHARACTER*4 ISKNDF
26988      CHARACTER*4 IGLDDF
26989      CHARACTER*4 IBGEDF
26990      CHARACTER*4 IGETDF
26991      CHARACTER*4 ICONDF
26992      CHARACTER*4 IGOMDF
26993      CHARACTER*4 IKATDF
26994      CHARACTER*4 IGIGDF
26995      CHARACTER*4 IGEODF
26996      CHARACTER*4 IBUGG2
26997C
26998      DOUBLE PRECISION DZETA
26999C
27000C---------------------------------------------------------------------
27001C
27002C-----COMMON VARIABLES (GENERAL)--------------------------------------
27003C
27004      INCLUDE 'DPCOMC.INC'
27005      INCLUDE 'DPCOP2.INC'
27006C
27007      IBUGG2='OFF'
27008      IF(IBUGG2.EQ.'ON')THEN
27009        WRITE(ICOUT,55)SHAPE1,SHAPE2,SHAPE3,SHAPE4
27010   55   FORMAT('SHAPE1,SHAPE2,SHAPE3,SHAPE4 = ',4G15.7)
27011        CALL DPWRST('XXX','BUG ')
27012        WRITE(ICOUT,56)SHAPE5,SHAPE6,SHAPE7
27013   56   FORMAT('SHAPE5,SHAPE6,SHAPE7 = ',4G15.7)
27014        CALL DPWRST('XXX','BUG ')
27015        WRITE(ICOUT,57)ISKNDF,IBEIDF,IBGEDF,IGEODF,IGEPDF
27016   57   FORMAT('ISKNDF,IBEIDF,IBGEDF,IGEODF,IGEPDF = ',4(A4,2X),A4)
27017        CALL DPWRST('XXX','BUG ')
27018        WRITE(ICOUT,58)IGIGDF,IGLDDF,IKATDF,ILGADF,IADEDF
27019   58   FORMAT('IGIGDF,IGLDDF,IKATDF,ILGADF,IADEDF = ',4(A4,2X),A4)
27020        CALL DPWRST('XXX','BUG ')
27021        WRITE(ICOUT,59)ICONDF,IGETDF,IGOMDF,IMAKDF
27022   59   FORMAT('ICONDF,IGETDF,IGOMDF,IMAKDF = ',3(A4,2X),A4)
27023        CALL DPWRST('XXX','BUG ')
27024      ENDIF
27025C
27026      IDISFL='CONT'
27027      ILOWLM=0
27028C
27029      IF(ICASPL.EQ.'BINO')IDISFL='DISC'
27030      IF(ICASPL.EQ.'GEOM')IDISFL='DISC'
27031      IF(ICASPL.EQ.'POIS')IDISFL='DISC'
27032      IF(ICASPL.EQ.'NEBI')IDISFL='DISC'
27033      IF(ICASPL.EQ.'BBIN')IDISFL='DISC'
27034      IF(ICASPL.EQ.'BNBI')IDISFL='DISC'
27035      IF(ICASPL.EQ.'DUNI')IDISFL='DISC'
27036      IF(ICASPL.EQ.'HYPG')IDISFL='DISC'
27037      IF(ICASPL.EQ.'POLY')IDISFL='DISC'
27038      IF(ICASPL.EQ.'HERM')IDISFL='DISC'
27039      IF(ICASPL.EQ.'YULE')IDISFL='DISC'
27040      IF(ICASPL.EQ.'BGEO')THEN
27041        IDISFL='DISC'
27042        ILOWLM=1
27043        IF(IBGEDF.EQ.'SHIF')ILOWLM=0
27044      ENDIF
27045      IF(ICASPL.EQ.'ZETA')THEN
27046        IDISFL='DISC'
27047        ILOWLM=1
27048        CALL ZETA2(DBLE(SHAPE1),DZETA)
27049        DZETA=DZETA+1.0D0
27050      ENDIF
27051      IF(ICASPL.EQ.'ZIPF')THEN
27052        IDISFL='DISC'
27053        ILOWLM=1
27054CCCCC   IMAX=INT(AMAX+0.00001)
27055        IMAX=I1MACH(9)
27056        IF(INT(SHAPE2+0.1).LT.IMAX)SHAPE2=REAL(IMAX)
27057        CALL HNM(INT(SHAPE2+0.1),DBLE(SHAPE1),DZETA)
27058      ENDIF
27059      IF(ICASPL.EQ.'BTAN')THEN
27060        IDISFL='DISC'
27061        ILOWLM=INT(SHAPE2+0.1)
27062      ENDIF
27063      IF(ICASPL.EQ.'LPOI')IDISFL='DISC'
27064      IF(ICASPL.EQ.'OCCU')IDISFL='DISC'
27065      IF(ICASPL.EQ.'LICT')IDISFL='DISC'
27066      IF(ICASPL.EQ.'MATC')IDISFL='DISC'
27067      IF(ICASPL.EQ.'AEPP')IDISFL='DISC'
27068      IF(ICASPL.EQ.'LOST')THEN
27069        IDISFL='DISC'
27070        ILOWLM=INT(SHAPE2+0.1)
27071      ENDIF
27072      IF(ICASPL.EQ.'GLOS')THEN
27073        IDISFL='DISC'
27074CCCCC   ILOWLM=INT(SHAPE3+0.1)
27075        ILOWLM=1
27076      ENDIF
27077      IF(ICASPL.EQ.'GNBI')IDISFL='DISC'
27078      IF(ICASPL.EQ.'GEET')THEN
27079        IDISFL='DISC'
27080        ILOWLM=1
27081      ENDIF
27082      IF(ICASPL.EQ.'QBIN')IDISFL='DISC'
27083      IF(ICASPL.EQ.'CONS')THEN
27084        IDISFL='DISC'
27085        ILOWLM=1
27086      ENDIF
27087      IF(ICASPL.EQ.'LKAT')IDISFL='DISC'
27088      IF(ICASPL.EQ.'KATZ')IDISFL='DISC'
27089      IF(ICASPL.EQ.'DISW')IDISFL='DISC'
27090      IF(ICASPL.EQ.'GLGP')IDISFL='DISC'
27091      IF(ICASPL.EQ.'TGNB')IDISFL='DISC'
27092      IF(ICASPL.EQ.'WARI')IDISFL='DISC'
27093      IF(ICASPL.EQ.'GWAR')IDISFL='DISC'
27094      IF(ICASPL.EQ.'LOGS')THEN
27095        IDISFL='DISC'
27096        ILOWLM=1
27097      ENDIF
27098C
27099      RETURN
27100      END
27101      SUBROUTINE EXTIND(X,N,IWRITE,PSTAMV,XIND,ISUBRO,IBUGA3,IERROR)
27102C
27103C     PURPOSE--THIS SUBROUTINE COMPUTES THE INDEX WHERE THE
27104C              SAMPLE EXTREME OF THE DATA IN THE INPUT VECTOR X
27105C              OCCURS.
27106C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
27107C                                (UNSORTED OR SORTED) OBSERVATIONS.
27108C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
27109C                                IN THE VECTOR X.
27110C     OUTPUT ARGUMENTS--XIND   = THE SINGLE PRECISION VALUE OF THE
27111C                                COMPUTED INDEX OF THE SAMPLE EXTREME.
27112C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
27113C             SAMPLE INDEX OF THE EXTREME.
27114C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
27115C                   OF N FOR THIS SUBROUTINE.
27116C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
27117C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
27118C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
27119C     LANGUAGE--ANSI FORTRAN (1977)
27120C     WRITTEN BY--JAMES J. FILLIBEN
27121C                 STATISTICAL ENGINEERING DIVISION
27122C                 INFORMATION TECHNOLOGY LABORATORY
27123C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
27124C                 GAITHERSBURG, MD 20899-8980
27125C                 PHONE--301-975-2855
27126C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
27127C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
27128C     LANGUAGE--ANSI FORTRAN (1977)
27129C     VERSION NUMBER--2009.2
27130C     ORIGINAL VERSION--FEBRUARY  2009.
27131C     UPDATED  VERSION--APRIL     2010. SKIP "MISSING VALUES"
27132C
27133C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
27134C
27135      CHARACTER*4 IWRITE
27136      CHARACTER*4 ISUBRO
27137      CHARACTER*4 IBUGA3
27138      CHARACTER*4 IERROR
27139C
27140      CHARACTER*4 ISUBN1
27141      CHARACTER*4 ISUBN2
27142C
27143C---------------------------------------------------------------------
27144C
27145      DIMENSION X(*)
27146C
27147C-----COMMON----------------------------------------------------------
27148C
27149      INCLUDE 'DPCOP2.INC'
27150C
27151C-----START POINT-----------------------------------------------------
27152C
27153      ISUBN1='EXTI'
27154      ISUBN2='ND  '
27155      IERROR='NO'
27156C
27157      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TIND')THEN
27158        WRITE(ICOUT,999)
27159  999   FORMAT(1X)
27160        CALL DPWRST('XXX','BUG ')
27161        WRITE(ICOUT,51)
27162   51   FORMAT('***** AT THE BEGINNING OF EXTIND--')
27163        CALL DPWRST('XXX','BUG ')
27164        WRITE(ICOUT,52)IBUGA3
27165   52   FORMAT('IBUGA3 = ',A4)
27166        CALL DPWRST('XXX','BUG ')
27167        WRITE(ICOUT,53)N
27168   53   FORMAT('N = ',I8)
27169        CALL DPWRST('XXX','BUG ')
27170        DO55I=1,N
27171          WRITE(ICOUT,56)I,X(I)
27172   56     FORMAT('I,X(I) = ',I8,G15.7)
27173          CALL DPWRST('XXX','BUG ')
27174   55   CONTINUE
27175      ENDIF
27176C
27177C               ***********************
27178C               **  COMPUTE EXTREME  **
27179C               ***********************
27180C
27181C               ********************************************
27182C               **  STEP 1--                              **
27183C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
27184C               ********************************************
27185C
27186      AN=N
27187C
27188      IF(N.LT.1)THEN
27189        IERROR='YES'
27190        WRITE(ICOUT,999)
27191        CALL DPWRST('XXX','BUG ')
27192        WRITE(ICOUT,111)
27193  111   FORMAT('***** ERROR IN INDEX EXTREME--')
27194        CALL DPWRST('XXX','BUG ')
27195        WRITE(ICOUT,112)
27196  112   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR THE ',
27197     1         'RESPONSE')
27198        CALL DPWRST('XXX','BUG ')
27199        WRITE(ICOUT,113)
27200  113   FORMAT('      VARIABLE MUST BE 1 OR LARGER.')
27201        CALL DPWRST('XXX','BUG ')
27202        WRITE(ICOUT,116)
27203  116   FORMAT('      SUCH WAS NOT THE CASE HERE.')
27204        CALL DPWRST('XXX','BUG ')
27205        WRITE(ICOUT,117)N
27206  117   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
27207     1         '.')
27208        CALL DPWRST('XXX','BUG ')
27209        GOTO9000
27210      ENDIF
27211C
27212      IF(N.EQ.1)THEN
27213        XIND=1.0
27214        GOTO800
27215      ENDIF
27216C
27217C               *****************************************
27218C               **  STEP 2--                           **
27219C               **  COMPUTE THE INDEX OF THE EXTREME.  **
27220C               *****************************************
27221C
27222      XEXT=CPUMIN
27223      XIND=1.0
27224      DO200I=1,N
27225        XTEMP=ABS(X(I))
27226        IF(XEXT.EQ.CPUMIN)THEN
27227          IF(XTEMP.EQ.PSTAMV)GOTO200
27228          XEXT=XTEMP
27229          XIND=REAL(I)
27230        ELSE
27231          IF(XTEMP.NE.PSTAMV .AND. XTEMP.GT.XEXT)THEN
27232            XEXT=XTEMP
27233            XIND=REAL(I)
27234          ENDIF
27235        ENDIF
27236  200 CONTINUE
27237C
27238C               *******************************
27239C               **  STEP 3--                 **
27240C               **  WRITE OUT A LINE         **
27241C               **  OF SUMMARY INFORMATION.  **
27242C               *******************************
27243C
27244  800 CONTINUE
27245      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
27246        WRITE(ICOUT,999)
27247        CALL DPWRST('XXX','BUG ')
27248        WRITE(ICOUT,811)N,XIND
27249  811   FORMAT('THE INDEX FOR THE EXTREME VALUE OF THE ',I8,
27250     1         ' OBSERVATIONS = ',F12.0)
27251        CALL DPWRST('XXX','BUG ')
27252      ENDIF
27253C
27254C               *****************
27255C               **  STEP 90--  **
27256C               **  EXIT.      **
27257C               *****************
27258C
27259 9000 CONTINUE
27260      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TIND')THEN
27261        WRITE(ICOUT,999)
27262        CALL DPWRST('XXX','BUG ')
27263        WRITE(ICOUT,9011)
27264 9011   FORMAT('***** AT THE END       OF EXTIND--')
27265        CALL DPWRST('XXX','BUG ')
27266        WRITE(ICOUT,9012)IBUGA3,IERROR
27267 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
27268        CALL DPWRST('XXX','BUG ')
27269        WRITE(ICOUT,9013)N
27270 9013   FORMAT('N = ',I8)
27271        CALL DPWRST('XXX','BUG ')
27272        WRITE(ICOUT,9015)XEXT,XEXT2,XIND
27273 9015   FORMAT('XEXT,XEXT2,XIND = ',3G15.7)
27274        CALL DPWRST('XXX','BUG ')
27275      ENDIF
27276C
27277      RETURN
27278      END
27279      SUBROUTINE EXTINT(IATEMP,NCHAR,IVALUE,IBUGS2,ISUBRO,IERROR)
27280C
27281C     PURPOSE--THIS SUBROUTINE EXTRACTS AN INTEGER VALUE FROM
27282C              A CHARACTER STRING.  LOOK FOR FIRST AND LAST
27283C              NON-BLANK CHARACTERS (IF ENTIRE FIELD IS BLANK,
27284C              RETURN A 0).  IF A NON-INTEGER VALUE ENCOUNTERED,
27285C              PRINT AN ERROR MESSAGE.
27286C
27287C     WRITTEN BY--ALAN HECKERT
27288C                 STATISTICAL ENGINEERING DIVISION
27289C                 INFORMATION TECHNOLOGY LABORATORY
27290C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
27291C                 GAITHERSBURG, MD 20899-8980
27292C                 PHONE--301-975-2899
27293C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
27294C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
27295C     LANGUAGE--ANSI FORTRAN (1977)
27296C               HOST DEPENDENT
27297C     VERSION NUMBER--2014.10
27298C     ORIGINAL VERSION--OCTOBER    2014.
27299C     UPDATED         --NOVEMBER   2015. CHECK FOR "+" SIGN
27300C
27301C-----NON-COMMON VARIABLES (GRAPHICS)---------------------------------
27302C
27303      CHARACTER*(*) IATEMP
27304      CHARACTER*4   IBUGS2
27305      CHARACTER*4   ISUBRO
27306      CHARACTER*4   IERROR
27307      CHARACTER*10  IFORMT
27308C
27309C-----COMMON VARIABLES (GENERAL)--------------------------------------
27310C
27311      INCLUDE 'DPCOP2.INC'
27312C
27313C-----START POINT-----------------------------------------------------
27314C
27315      IERROR='NO'
27316C
27317      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'TINT')THEN
27318        WRITE(ICOUT,51)NCHAR
27319   51   FORMAT('START  OF EXTINT, NCHAR = ',I8)
27320        CALL DPWRST('XXX','BUG ')
27321      ENDIF
27322C
27323C     FIND FIRST NON-BLANK CHARACTER
27324C
27325      ISIGN=1
27326      ISTRT=0
27327      DO 100 I=1,NCHAR
27328         IF (IATEMP(I:I).EQ.' ')GOTO100
27329            ISTRT=I
27330            GOTO199
27331  100 CONTINUE
27332      IVALUE=0
27333      GOTO9090
27334  199 CONTINUE
27335C
27336C     FIND LAST NON-BLANK CHARACTER
27337C
27338      ILAST=NCHAR
27339      DO 200 I=NCHAR,ISTRT,-1
27340         IF (IATEMP(I:I).EQ.' ')GOTO200
27341            ILAST=I
27342            GOTO299
27343  200 CONTINUE
27344      IVALUE=0
27345      GOTO9090
27346  299 CONTINUE
27347C
27348C     TRUNCATED IF A DECIMAL POINT FOUND
27349C
27350      DO 2200 I=ISTRT,ILAST
27351         IF (IATEMP(I:I).EQ.'.')THEN
27352            ILAST=I-1
27353            GOTO2299
27354         ENDIF
27355 2200 CONTINUE
27356 2299 CONTINUE
27357C
27358      IF (ISTRT+3.LE.NCHAR) THEN
27359         IF (IATEMP(ISTRT:ISTRT+3).EQ.'NULL')THEN
27360            IVALUE=-999999
27361            GOTO9090
27362         ENDIF
27363      ENDIF
27364C
27365C     CONVERT TEXT TO INTEGER
27366C
27367      IF (IATEMP(ISTRT:ISTRT).EQ.'-') THEN
27368         ISIGN=-1
27369         ISTRT=ISTRT+1
27370C
27371C     2015/11: CHECK FOR "+" AS WELL
27372C
27373      ELSEIF (IATEMP(ISTRT:ISTRT).EQ.'+') THEN
27374         ISIGN=+1
27375         ISTRT=ISTRT+1
27376      ENDIF
27377      DO 300 I=ISTRT,ILAST
27378         IF (IATEMP(I:I).EQ.' ')THEN
27379            IATEMP(I:I)='0'
27380         ELSE
27381            ITEMP=ICHAR(IATEMP(I:I))
27382            IF(ITEMP.LT.48 .OR. ITEMP.GT.57)THEN
27383              WRITE(ICOUT,2301)
27384 2301         FORMAT('****** ERROR FROM READ CLIPBOAR (EXTINT)')
27385              CALL DPWRST('XXX','BUG ')
27386              WRITE(ICOUT,2303)
27387 2303         FORMAT('       NON-INTEGER VALUE ENCOUNTERED WHEN ',
27388     1               'EXTRACTING AN INTEGER FROM STRING.')
27389              CALL DPWRST('XXX','BUG ')
27390              WRITE(ICOUT,2305)CHAR(ITEMP)
27391 2305         FORMAT('       CHARACTER IS: ',A1)
27392              IVALUE=-999999
27393              IERROR='YES'
27394              GOTO9090
27395            END IF
27396         END IF
27397  300 CONTINUE
27398      NTEMP=ILAST-ISTRT+1
27399      IFORMT='(I      )'
27400      IF (NTEMP.LE.9)THEN
27401          WRITE(IFORMT(3:3),'(I1)')NTEMP
27402      ELSE IF (NTEMP.LE.99)THEN
27403          WRITE(IFORMT(3:4),'(I2)')NTEMP
27404      ELSE IF (NTEMP.LE.999)THEN
27405          WRITE(IFORMT(3:5),'(I3)')NTEMP
27406      ELSE IF (NTEMP.LE.9999)THEN
27407          WRITE(IFORMT(3:6),'(I4)')NTEMP
27408      ELSE IF (NTEMP.LE.99999)THEN
27409          WRITE(IFORMT(3:7),'(I5)')NTEMP
27410      ELSE IF (NTEMP.LE.999999)THEN
27411          WRITE(IFORMT(3:8),'(I6)')NTEMP
27412      END IF
27413      READ(IATEMP(ISTRT:ILAST),IFORMT,ERR=9010)IVALUE
27414      GOTO9090
27415C
27416 9010 CONTINUE
27417      WRITE(ICOUT,2301)
27418      CALL DPWRST('XXX','BUG ')
27419      WRITE(ICOUT,9015)
27420 9015 FORMAT('       UNABLE TO CONVERT STRING TO INTEGER')
27421      CALL DPWRST('XXX','BUG ')
27422      IERROR='YES'
27423      GOTO9090
27424C
27425 9090 CONTINUE
27426      IVALUE=ISIGN*IVALUE
27427      RETURN
27428      END
27429      SUBROUTINE EXTPA1(ICASPL,IDIST,A,B,
27430     1                  SHAPE1,SHAPE2,SHAPE3,SHAPE4,
27431     1                  SHAPE5,SHAPE6,SHAPE7,
27432     1                  IADEDF,IGEPDF,IMAKDF,IBEIDF,
27433     1                  ILGADF,ISKNDF,IGLDDF,IBGEDF,
27434     1                  IGETDF,ICONDF,IGOMDF,IKATDF,
27435     1                  IGIGDF,IGEODF,
27436     1                  IBFWLI,IEEWLI,
27437     1                  ISUBRO,IBUGG2,IERROR)
27438C
27439C     WRITTEN BY--ALAN HECKERT
27440C                 STATISTICAL ENGINEERING DIVISION
27441C                 INFORMATION TECHNOLOGY LABORAOTRY
27442C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
27443C                 GAITHERSBURG, MD 20899-8980
27444C                 PHONE--301-975-2899
27445C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
27446C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
27447C     LANGUAGE--ANSI FORTRAN (1977)
27448C     VERSION NUMBER--2009/8
27449C     ORIGINAL VERSION--AUGUST    2009.
27450C     UPDATED         --JULY      2010. END EFFECTS WEIBULL
27451C     UPDATED         --AUGUST    2010. BRITTLE FIBER WEIBULL
27452C     UPDATED         --OCTOBER   2010. IBFWLI, IEEWLI
27453C     UPDATED         --JANUARY   2011. ARCTANGENT
27454C
27455C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
27456C
27457      CHARACTER*30 IDIST
27458C
27459      CHARACTER*4 IADEDF
27460      CHARACTER*4 IGEPDF
27461      CHARACTER*4 IMAKDF
27462      CHARACTER*4 IBEIDF
27463      CHARACTER*4 ILGADF
27464      CHARACTER*4 ISKNDF
27465      CHARACTER*4 IGLDDF
27466      CHARACTER*4 IBGEDF
27467      CHARACTER*4 IGETDF
27468      CHARACTER*4 ICONDF
27469      CHARACTER*4 IGOMDF
27470      CHARACTER*4 IKATDF
27471      CHARACTER*4 IGIGDF
27472      CHARACTER*4 IGEODF
27473      CHARACTER*4 IBFWLI
27474      CHARACTER*4 IEEWLI
27475C
27476      CHARACTER*4 ICASPL
27477      CHARACTER*4 IBUGG2
27478      CHARACTER*4 ISUBRO
27479      CHARACTER*4 IERROR
27480C
27481      CHARACTER*4 ISUBN1
27482      CHARACTER*4 ISUBN2
27483      CHARACTER*4 ISTEPN
27484C
27485      CHARACTER*4 IH
27486      CHARACTER*4 IH2
27487      CHARACTER*4 IH21
27488      CHARACTER*4 IH22
27489      CHARACTER*4 IH31
27490      CHARACTER*4 IH32
27491      CHARACTER*4 IH41
27492      CHARACTER*4 IH42
27493      CHARACTER*4 IH51
27494      CHARACTER*4 IH52
27495      CHARACTER*4 LOWLTY
27496      CHARACTER*4 UPPLTY
27497      CHARACTER*4 LOWLT2
27498      CHARACTER*4 UPPLT2
27499      CHARACTER*4 LOWLT3
27500      CHARACTER*4 UPPLT3
27501      CHARACTER*4 LOWLT4
27502      CHARACTER*4 UPPLT4
27503      CHARACTER*4 LOWLT5
27504      CHARACTER*4 UPPLT5
27505C
27506      CHARACTER*4 IHWUSE
27507      CHARACTER*4 MESSAG
27508C
27509      INCLUDE 'DPCOMC.INC'
27510      INCLUDE 'DPCOPA.INC'
27511      INCLUDE 'DPCOHK.INC'
27512C
27513C---------------------------------------------------------------------
27514C
27515C-----COMMON VARIABLES (GENERAL)--------------------------------------
27516C
27517      INCLUDE 'DPCOP2.INC'
27518C
27519C               ***********************************************
27520C               **  STEP 1--                                 **
27521C               **  FOR THOSE DISTRIBUTIONS REQUIRING THEM,  **
27522C               **  DETERMINE IF THE ANALYST                 **
27523C               **  HAS SPECIFIED PARAMETER VALUES           **
27524C               ***********************************************
27525C
27526      SHAPE1=CPUMIN
27527      SHAPE2=CPUMIN
27528      SHAPE3=CPUMIN
27529      SHAPE4=CPUMIN
27530      SHAPE5=CPUMIN
27531      SHAPE6=CPUMIN
27532      SHAPE7=CPUMIN
27533C
27534      ISUBN1='EXTP'
27535      ISUBN2='A1  '
27536      ISTEPN='1'
27537      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TPA1')THEN
27538        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
27539        WRITE(ICOUT,55)IDIST
27540   55   FORMAT('AT BEGINNING OF EXTPA1: IDIST = ',A30)
27541        CALL DPWRST('XXX','BUG ')
27542        WRITE(ICOUT,57)ISKNDF,IBEIDF,IBGEDF,IGEODF,IGEPDF
27543   57   FORMAT('ISKNDF,IBEIDF,IBGEDF,IGEODF,IGEPDF = ',4(A4,2X),A4)
27544        CALL DPWRST('XXX','BUG ')
27545        WRITE(ICOUT,58)IGIGDF,IGLDDF,IKATDF,ILGADF
27546   58   FORMAT('IGIGDF,IGLDDF,IKATDF,ILGADF = ',3(A4,2X),A4)
27547        CALL DPWRST('XXX','BUG ')
27548      ENDIF
27549C
27550      IF(ICASPL.EQ.'TULA' .OR. ICASPL.EQ.'SNOR')THEN
27551        IH='LAMB'
27552        IH2='DA  '
27553        ALOWLM=CPUMIN
27554        AUPPLM=CPUMAX
27555        LOWLTY='>=  '
27556        UPPLTY='<=  '
27557        GOTO4100
27558      ELSEIF(ICASPL.EQ.'POIS')THEN
27559        IH='LAMB'
27560        IH2='DA  '
27561        ALOWLM=0.0
27562        AUPPLM=CPUMAX
27563        LOWLTY='>   '
27564        UPPLTY='<=  '
27565        GOTO4100
27566      ELSEIF(ICASPL.EQ.'TPP')THEN
27567        IH='NU  '
27568        IH2='    '
27569        ALOWLM=1.0
27570        AUPPLM=CPUMAX
27571        LOWLTY='>=  '
27572        UPPLTY='<=  '
27573        GOTO4100
27574      ELSEIF(
27575     1       ICASPL.EQ.'CHIS' .OR. ICASPL.EQ.'CHI' .OR.
27576     1       ICASPL.EQ.'FT  '
27577     1      )THEN
27578        IH='NU  '
27579        IH2='    '
27580        ILOWLM=1
27581        IUPPLM=I1MACH(9)
27582        LOWLTY='>=  '
27583        UPPLTY='<=  '
27584        GOTO5100
27585      ELSEIF(ICASPL.EQ.'FPP')THEN
27586        IH='NU1 '
27587        IH2='    '
27588        IDIST='F     '
27589        ILOWLM=1
27590        IUPPLM=I1MACH(9)
27591        LOWLTY='>=  '
27592        UPPLTY='<=  '
27593        IH21='NU2 '
27594        IH22='    '
27595        ILOWL2=1
27596        IUPPL2=I1MACH(9)
27597        LOWLT2='>=  '
27598        UPPLT2='<=  '
27599        GOTO5200
27600      ELSEIF(
27601     1   ICASPL.EQ.'GAMM' .OR. ICASPL.EQ.'WEIB' .OR.
27602     1   ICASPL.EQ.'EV2 ' .OR. ICASPL.EQ.'WALD' .OR.
27603     1   ICASPL.EQ.'FATL' .OR. ICASPL.EQ.'DWEI' .OR.
27604     1   ICASPL.EQ.'DGAM' .OR. ICASPL.EQ.'IGAM' .OR.
27605     1   ICASPL.EQ.'IWEI' .OR. ICASPL.EQ.'GEEX' .OR.
27606     1   ICASPL.EQ.'LGAM' .OR.
27607     1   ICASPL.EQ.'3GAM' .OR. ICASPL.EQ.'3WEI' .OR.
27608     1   ICASPL.EQ.'3IGA' .OR.
27609     1   ICASPL.EQ.'3IWE'
27610     1  )THEN
27611        IH='GAMM'
27612        IH2='A   '
27613        ALOWLM=0.
27614        AUPPLM=CPUMAX
27615        LOWLTY='>   '
27616        UPPLTY='<=  '
27617        GOTO4100
27618      ELSEIF(ICASPL.EQ.'PARE' .OR. ICASPL.EQ.'PAR2')THEN
27619        IH='GAMM'
27620        IH2='A   '
27621        ALOWLM=0.
27622        AUPPLM=CPUMAX
27623        LOWLTY='>   '
27624        UPPLTY='<=  '
27625        IH21='A   '
27626        IH22='    '
27627        ALOWL2=0.
27628        AUPPL2=CPUMAX
27629        LOWLT2='>   '
27630        UPPLT2='<=  '
27631        GOTO4200
27632      ELSEIF(ICASPL.EQ.'BFWE')THEN
27633        IH='GAMM'
27634        IH2='A   '
27635        ALOWLM=0.
27636        AUPPLM=CPUMAX
27637        LOWLTY='>   '
27638        UPPLTY='<=  '
27639        IF(IBFWLI.EQ.'VARI')THEN
27640          GOTO4100
27641        ELSE
27642          IH21='L   '
27643          IH22='    '
27644          ALOWL2=0.
27645          AUPPL2=CPUMAX
27646          LOWLT2='>   '
27647          UPPLT2='<=  '
27648          GOTO4200
27649         ENDIF
27650      ELSEIF(
27651     1   ICASPL.EQ.'PEA3' .OR. ICASPL.EQ.'GPAR' .OR.
27652     1   ICASPL.EQ.'GEV'
27653     1  )THEN
27654        IH='GAMM'
27655        IH2='A   '
27656        ALOWLM=CPUMIN
27657        AUPPLM=CPUMAX
27658        LOWLTY='>   '
27659        UPPLTY='<=  '
27660        GOTO4100
27661      ELSEIF(
27662     1   ICASPL.EQ.'BETA' .OR. ICASPL.EQ.'HERM' .OR.
27663     1   ICASPL.EQ.'BGEO' .OR. ICASPL.EQ.'IBET' .OR.
27664     1   ICASPL.EQ.'BNOR' .OR. ICASPL.EQ.'POWL'
27665     1  )THEN
27666        IH='ALPH'
27667        IH2='A   '
27668        ALOWLM=0.0
27669        AUPPLM=CPUMAX
27670        LOWLTY='>   '
27671        UPPLTY='<=  '
27672        IH21='BETA'
27673        IH22='    '
27674        ALOWL2=0.0
27675        AUPPL2=CPUMAX
27676        LOWLT2='>   '
27677        UPPLT2='<=  '
27678        GOTO4200
27679      ELSEIF(ICASPL.EQ.'TPAR')THEN
27680        IH='GAMM'
27681        IH2='A   '
27682        ALOWLM=0.
27683        AUPPLM=CPUMAX
27684        LOWLTY='>   '
27685        UPPLTY='<=  '
27686        IH21='A   '
27687        IH22='    '
27688        ALOWLM=0.
27689        AUPPLM=CPUMAX
27690        LOWLT2='>=  '
27691        UPPLT2='<=  '
27692        IH31='NU  '
27693        IH32='    '
27694        ALOWL3=0.0
27695        AUPPL3=CPUMAX
27696        LOWLT3='>   '
27697        UPPLT3='<=  '
27698        GOTO4300
27699      ELSEIF(ICASPL.EQ.'BFRA')THEN
27700        IH='ALPH'
27701        IH2='A   '
27702        ALOWLM=0.
27703        AUPPLM=CPUMAX
27704        LOWLTY='>   '
27705        UPPLTY='<=  '
27706        IH21='BETA'
27707        IH22='    '
27708        ALOWL2=0.
27709        AUPPL2=CPUMAX
27710        LOWLT2='>=  '
27711        UPPLT2='<=  '
27712        IH31='R   '
27713        IH32='    '
27714        ALOWL3=0.
27715        AUPPL3=CPUMAX
27716        LOWLT3='>   '
27717        UPPLT3='<=  '
27718        GOTO4300
27719      ELSEIF(ICASPL.EQ.'BINO')THEN
27720        IH='P   '
27721        IH2='    '
27722        ALOWLM=0.0
27723        AUPPLM=1.0
27724        LOWLTY='>=  '
27725        UPPLTY='<=  '
27726        IH21='N   '
27727        IH22='    '
27728        ILOWL2=1
27729        IUPPL2=I1MACH(9)
27730        LOWLT2='>=  '
27731        UPPLT2='<=  '
27732        GOTO4900
27733      ELSEIF(ICASPL.EQ.'GEOM')THEN
27734        IH='P   '
27735        IH2='    '
27736        ALOWLM=0.0
27737        AUPPLM=1.0
27738        LOWLTY='>   '
27739        UPPLTY='<   '
27740        GOTO4100
27741      ELSEIF(ICASPL.EQ.'NEBI')THEN
27742        IH='P   '
27743        IH2='    '
27744        ALOWLM=0.0
27745        AUPPLM=1.0
27746        LOWLTY='>   '
27747        UPPLTY='<   '
27748        IH21='K   '
27749        IH22='    '
27750        ALOWL2=0.0
27751        AUPPL2=CPUMAX
27752        LOWLT2='>   '
27753        UPPLT2='<=  '
27754        GOTO4200
27755      ELSEIF(ICASPL.EQ.'INGA' .OR. ICASPL.EQ.'RIGA')THEN
27756        IH='GAMM'
27757        IH2='A   '
27758        ALOWLM=0.
27759        AUPPLM=CPUMAX
27760        LOWLTY='>   '
27761        UPPLTY='<=  '
27762        IH21='MU  '
27763        IH22='    '
27764        ALOWL2=0.
27765        AUPPL2=CPUMAX
27766        LOWLT2='>   '
27767        UPPLT2='<=  '
27768        GOTO4200
27769      ELSEIF(ICASPL.EQ.'TRIA')THEN
27770C
27771C       NOTE: FOR TRIANGULAR DISTRIBUTION, THE SHAPE PARAMETER
27772C             IS BOUNDED BY THE MIN AND MAX OF THE DATA.
27773C
27774C             THERE ARE TWO WAYS TO DEAL WITH THIS:
27775C
27776C             1) ALLOW THE USER TO SPECIFY LOWER AND UPPER LIMITS
27777C                (AND SET C BASED ON THESE).
27778C
27779C                THE ADVANTAGE OF THIS APPROACH IS THAT C IS
27780C                GIVEN IN UNITS OF THE DATA.  THE DISADVANTAGE
27781C                IS THAT WE LOSE THE INVARIANCE OF LOCATION/SCALE
27782C                OF THE PPCC PLOT.
27783C
27784C             2) USE DEFAULT OF A = -1, B = 1 AND THEN RESTRICT
27785C                VALUE OF C TO (0,1) INTERVAL.  THE ADVANTAGE
27786C                OF THIS APPROACH IS THAT WE MAINTAIN THE
27787C                INVARIANCE OF LOCATION/SCALE (I.E., INDEPENDENT
27788C                ESTIMATES OF A AND B).  THE DISADVANTAGE IS THAT
27789C                THE OPTIMAL ESTIMATE OF C HAS TO BE SCALED IF THE
27790C                DATA IS OUTSIDE THE (0,1) INTERVAL.
27791C
27792C                USER CAN SPECIFY LOWER/UPPER LIMITS BY ENTERING
27793C                LET A = <LOWLIM>  AND  LET B = <UPPLIM>.  THESE
27794C                PARAMETERS WILL BE CHECKED BEFORE THIS ROUTINE
27795C                IS CALLED.
27796C
27797        IH='C   '
27798        IH2='    '
27799        ALOWLM=A
27800        AUPPLM=B
27801        LOWLTY='>=  '
27802        UPPLTY='<=  '
27803        GOTO4100
27804      ELSEIF(ICASPL.EQ.'DUNI' .OR. ICASPL.EQ.'LICT')THEN
27805        IH='N   '
27806        IH2='    '
27807        ILOWLM=1
27808        IUPPLM=I1MACH(9)
27809        LOWLTY='>=  '
27810        UPPLTY='<=  '
27811        GOTO5100
27812      ELSEIF(ICASPL.EQ.'MATC')THEN
27813        IH='K   '
27814        IH2='    '
27815        ILOWLM=0
27816        IUPPLM=I1MACH(9)
27817        LOWLTY='>=  '
27818        UPPLTY='<=  '
27819        GOTO5100
27820      ELSEIF(ICASPL.EQ.'OCCU')THEN
27821        IH='B   '
27822        IH2='    '
27823        ILOWLM=1
27824        IUPPLM=I1MACH(9)
27825        LOWLTY='>=  '
27826        UPPLTY='<=  '
27827        IH21='C   '
27828        IH22='    '
27829        ILOWL2=1
27830        IUPPL2=I1MACH(9)
27831        LOWLT2='>=  '
27832        UPPLT2='<=  '
27833        GOTO5200
27834      ELSEIF(ICASPL.EQ.'NCBE')THEN
27835        IH='ALPH'
27836        IH2='A   '
27837        ALOWLM=0.
27838        AUPPLM=CPUMAX
27839        LOWLTY='>   '
27840        UPPLTY='<=  '
27841        IH21='BETA'
27842        IH22='    '
27843        ALOWL2=0.
27844        AUPPL2=CPUMAX
27845        LOWLT2='>   '
27846        UPPLT2='<=  '
27847        IH31='LAMB'
27848        IH32='DA  '
27849        ALOWL3=0.
27850        AUPPL3=CPUMAX
27851        LOWLT3='>=  '
27852        UPPLT3='<=  '
27853        GOTO4300
27854      ELSEIF(ICASPL.EQ.'DNCB')THEN
27855        IH='ALPH'
27856        IH2='A   '
27857        ALOWLM=0.
27858        AUPPLM=CPUMAX
27859        LOWLTY='>   '
27860        UPPLTY='<=  '
27861        IH21='BETA'
27862        IH22='    '
27863        ALOWL2=0.
27864        AUPPL2=CPUMAX
27865        LOWLT2='>   '
27866        UPPLT2='<=  '
27867        IH31='LAMB'
27868        IH32='DA1 '
27869        ALOWL3=0.
27870        AUPPL3=CPUMAX
27871        LOWLT3='>=  '
27872        UPPLT3='<=  '
27873        IH41='LAMB'
27874        IH42='DA2 '
27875        ALOWL4=0.
27876        AUPPL4=CPUMAX
27877        LOWLT4='>=  '
27878        UPPLT4='<=  '
27879        GOTO4400
27880      ELSEIF(ICASPL.EQ.'NCCS' .OR. ICASPL.EQ.'NCT')THEN
27881        IH='NU  '
27882        IH2='    '
27883        ALOWLM=0.
27884        AUPPLM=CPUMAX
27885        LOWLTY='>   '
27886        UPPLTY='<=  '
27887        IH21='LAMB'
27888        IH22='DA  '
27889        ALOWL2=0.
27890        AUPPL2=CPUMAX
27891        LOWLT2='>=  '
27892        UPPLT2='<=  '
27893        GOTO4200
27894      ELSEIF(ICASPL.EQ.'NCF')THEN
27895        IH='NU1 '
27896        IH2='    '
27897        ALOWLM=0.
27898        AUPPLM=CPUMAX
27899        LOWLTY='>   '
27900        UPPLTY='<=  '
27901        IH21='NU2 '
27902        IH22='    '
27903        ALOWL2=0.
27904        AUPPL2=CPUMAX
27905        LOWLT2='>   '
27906        UPPLT2='<=  '
27907        IH31='LAMB'
27908        IH32='DA  '
27909        ALOWL3=0.
27910        AUPPL3=CPUMAX
27911        LOWLT3='>=  '
27912        UPPLT3='<=  '
27913        GOTO4300
27914      ELSEIF(ICASPL.EQ.'DNCF')THEN
27915        IH='NU1 '
27916        IH2='    '
27917        ALOWLM=0.
27918        AUPPLM=CPUMAX
27919        LOWLTY='>   '
27920        UPPLTY='<=  '
27921        IH21='NU2 '
27922        IH22='    '
27923        ALOWL2=0.
27924        AUPPL2=CPUMAX
27925        LOWLT2='>   '
27926        UPPLT2='<=  '
27927        IH31='LAMB'
27928        IH32='DA1 '
27929        ALOWL3=0.
27930        AUPPL3=CPUMAX
27931        LOWLT3='>=  '
27932        UPPLT3='<=  '
27933        IH41='LAMB'
27934        IH42='DA2 '
27935        ALOWL4=0.
27936        AUPPL4=CPUMAX
27937        LOWLT4='>=  '
27938        UPPLT4='<=  '
27939        GOTO4400
27940      ELSEIF(ICASPL.EQ.'DNCT')THEN
27941        IH='NU  '
27942        IH2='    '
27943        ALOWLM=0.
27944        AUPPLM=CPUMAX
27945        LOWLTY='>   '
27946        UPPLTY='<=  '
27947        IH21='LAMB'
27948        IH22='DA1 '
27949        ALOWL2=0.
27950        AUPPL2=CPUMAX
27951        LOWLT2='>=  '
27952        UPPLT2='<=  '
27953        IH31='LAMB'
27954        IH32='DA2 '
27955        ALOWL3=0.
27956        AUPPL3=CPUMAX
27957        LOWLT3='>=  '
27958        UPPLT3='<=  '
27959        GOTO4300
27960      ELSEIF(ICASPL.EQ.'HYPB')THEN
27961        IH='ALPH'
27962        IH2='A   '
27963        ALOWLM=0.
27964        AUPPLM=CPUMAX
27965        LOWLTY='>   '
27966        UPPLTY='<=  '
27967        IH21='XI  '
27968        IH22='A   '
27969        ALOWL2=0.
27970        AUPPL2=CPUMAX
27971        LOWLT2='>   '
27972        UPPLT2='<=  '
27973        GOTO4200
27974      ELSEIF(ICASPL.EQ.'HYPG')THEN
27975        IH='M   '
27976        IH2='    '
27977        ILOWLM=1
27978        IUPPLM=I1MACH(9)
27979        LOWLTY='>=  '
27980        UPPLTY='<=  '
27981        CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
27982     1              ISUBN1,ISUBN2,IERROR)
27983        IF(IERROR.EQ.'YES')GOTO9000
27984        SHAPE3=REAL(ISHAPE)
27985        IH='N   '
27986        IH2='    '
27987        ILOWLM=1
27988        IUPPLM=INT(SHAPE3+0.1)
27989        LOWLTY='>=  '
27990        UPPLTY='<=  '
27991        CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
27992     1              ISUBN1,ISUBN2,IERROR)
27993        IF(IERROR.EQ.'YES')GOTO9000
27994        SHAPE2=REAL(ISHAPE)
27995        IH='K   '
27996        IH2='    '
27997        ILOWLM=1
27998        IUPPLM=INT(SHAPE3+0.1)
27999        LOWLTY='>=  '
28000        UPPLTY='<=  '
28001        CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
28002     1              ISUBN1,ISUBN2,IERROR)
28003        SHAPE1=REAL(ISHAPE)
28004      ELSEIF(ICASPL.EQ.'VONM')THEN
28005        IH='B   '
28006        IH2='    '
28007        ALOWLM=0.
28008        AUPPLM=CPUMAX
28009        LOWLTY='>=  '
28010        UPPLTY='<=  '
28011        GOTO4100
28012      ELSEIF(ICASPL.EQ.'POWN')THEN
28013        IH='P   '
28014        IH2='    '
28015        ALOWLM=0.
28016        AUPPLM=CPUMAX
28017        LOWLTY='>   '
28018        UPPLTY='<=  '
28019        GOTO4100
28020      ELSEIF(ICASPL.EQ.'PLGN')THEN
28021        IH='P   '
28022        IH2='    '
28023        ALOWLM=0.
28024        AUPPLM=CPUMAX
28025        LOWLTY='>   '
28026        UPPLTY='<=  '
28027        IH21='SD  '
28028        IH22='    '
28029        ALOWL2=0.
28030        AUPPL2=CPUMAX
28031        LOWLT2='>   '
28032        UPPLT2='<=  '
28033        GOTO4200
28034      ELSEIF(
28035     1       ICASPL.EQ.'ALPH' .OR. ICASPL.EQ.'LDEX' .OR.
28036     1       ICASPL.EQ.'GLOG' .OR. ICASPL.EQ.'G2LO' .OR.
28037     1       ICASPL.EQ.'G3LO'
28038     1      )THEN
28039        IH='ALPH'
28040        IH2='A   '
28041        ALOWLM=0.
28042        AUPPLM=CPUMAX
28043        LOWLTY='>   '
28044        UPPLTY='<=  '
28045        GOTO4100
28046      ELSEIF(
28047     1       ICASPL.EQ.'TOPL' .OR. ICASPL.EQ.'BRAD'.OR.
28048     1       ICASPL.EQ.'LEXP' .OR. ICASPL.EQ.'PEXP'
28049     1      )THEN
28050        IH='BETA'
28051        IH2='    '
28052        ALOWLM=0.
28053        AUPPLM=CPUMAX
28054        LOWLTY='>   '
28055        UPPLTY='<=  '
28056        GOTO4100
28057      ELSEIF(ICASPL.EQ.'GTOL' .OR. ICASPL.EQ.'RGTL')THEN
28058        IH='ALPH'
28059        IH2='A   '
28060        ALOWLM=0.
28061        AUPPLM=2.0
28062        LOWLTY='>   '
28063        UPPLTY='<=  '
28064        IH21='BETA'
28065        IH22='    '
28066        ALOWL2=0.
28067        AUPPL2=CPUMAX
28068        LOWLT2='>   '
28069        UPPLT2='<=  '
28070        GOTO4200
28071      ELSEIF(ICASPL.EQ.'KUMA')THEN
28072        IH='BETA'
28073        IH2='    '
28074        ALOWLM=0.
28075        AUPPLM=CPUMAX
28076        LOWLTY='>   '
28077        UPPLTY='<=  '
28078        IH21='ALPH'
28079        IH22='A   '
28080        ALOWL2=0.
28081        AUPPL2=CPUMAX
28082        LOWLT2='>   '
28083        UPPLT2='<=  '
28084        GOTO4200
28085      ELSEIF(ICASPL.EQ.'LOGN' .OR. ICASPL.EQ.'3LGN')THEN
28086        IH='SIGM'
28087        IH2='A   '
28088        ALOWLM=0.
28089        AUPPLM=CPUMAX
28090        LOWLTY='>   '
28091        UPPLTY='<=  '
28092        GOTO4100
28093      ELSEIF(ICASPL.EQ.'POWF' .OR. ICASPL.EQ.'RPOW')THEN
28094        IH='C   '
28095        IH2='    '
28096        ALOWLM=0.
28097        AUPPLM=CPUMAX
28098        LOWLTY='>   '
28099        UPPLTY='<=  '
28100        GOTO4100
28101      ELSEIF(ICASPL.EQ.'LOGS')THEN
28102        IH='THET'
28103        IH2='A   '
28104        ALOWLM=0.
28105        AUPPLM=1.0
28106        LOWLTY='>   '
28107        UPPLTY='<   '
28108        GOTO4100
28109      ELSEIF(ICASPL.EQ.'GLOS')THEN
28110        IH='THET'
28111        IH2='A   '
28112        ALOWLM=0.
28113        AUPPLM=1.0
28114        LOWLTY='>   '
28115        UPPLTY='<   '
28116        CALL PARCHR(IH,IH2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28117     1              ISUBN1,ISUBN2,IERROR)
28118        IF(IERROR.EQ.'YES')GOTO9000
28119        IH21='BETA'
28120        IH22='    '
28121        ALOWL2=1.0
28122        AUPPL2=1.0/THETA
28123        LOWLT2='>=  '
28124        UPPLT2='<   '
28125        GOTO4200
28126      ELSEIF(ICASPL.EQ.'GNBI')THEN
28127        IH='THET'
28128        IH2='A   '
28129        ALOWLM=0.
28130        AUPPLM=1.0
28131        LOWLTY='>   '
28132        UPPLTY='<   '
28133        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28134     1              ISUBN1,ISUBN2,IERROR)
28135        IF(IERROR.EQ.'YES')GOTO9000
28136        IH='BETA'
28137        IH2='    '
28138        ALOWLM=1.0
28139        AUPPLM=1.0/THETA
28140        LOWLTY='>   '
28141        UPPLTY='<   '
28142        CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28143     1              ISUBN1,ISUBN2,IERROR)
28144        IF(IERROR.EQ.'YES')THEN
28145          IF(SHAPE2.NE.0.0)THEN
28146            GOTO9000
28147          ELSE
28148            IERROR='NO'
28149          ENDIF
28150        ENDIF
28151        IH='M   '
28152        IH2='    '
28153        ALOWLM=0.0
28154        AUPPLM=CPUMAX
28155        LOWLTY='>   '
28156        UPPLTY='<   '
28157        CALL PARCHR(IH,IH2,IDIST,SHAPE3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28158     1              ISUBN1,ISUBN2,IERROR)
28159      ELSEIF(ICASPL.EQ.'TGNB')THEN
28160        IH='THET'
28161        IH2='A   '
28162        ALOWLM=0.
28163        AUPPLM=1.0
28164        LOWLTY='>   '
28165        UPPLTY='<   '
28166        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28167     1              ISUBN1,ISUBN2,IERROR)
28168        IF(IERROR.EQ.'YES')GOTO9000
28169        IH='BETA'
28170        IH2='    '
28171        ALOWLM=1.0
28172        AUPPLM=1.0/THETA
28173        LOWLTY='>   '
28174        UPPLTY='<   '
28175        CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28176     1              ISUBN1,ISUBN2,IERROR)
28177        IF(IERROR.EQ.'YES')THEN
28178          IF(SHAPE2.NE.0.0)THEN
28179            GOTO9000
28180          ELSE
28181            IERROR='NO'
28182          ENDIF
28183        ENDIF
28184        IH='M   '
28185        IH2='    '
28186        ALOWLM=0.0
28187        AUPPLM=CPUMAX
28188        LOWLTY='>   '
28189        UPPLTY='<   '
28190        CALL PARCHR(IH,IH2,IDIST,SHAPE3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28191     1              ISUBN1,ISUBN2,IERROR)
28192        IF(IERROR.EQ.'YES')GOTO9000
28193        IH='N   '
28194        IH2='    '
28195        ILOWLM=1
28196        IUPPLM=I1MACH(9)
28197        LOWLTY='>=  '
28198        UPPLTY='<=  '
28199        CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
28200     1              ISUBN1,ISUBN2,IERROR)
28201        SHAPE4=REAL(ISHAPE)
28202      ELSEIF(ICASPL.EQ.'LKAT')THEN
28203        IH='A   '
28204        IH2='    '
28205        ALOWLM=0.
28206        AUPPLM=CPUMAX
28207        LOWLTY='>   '
28208        UPPLTY='<   '
28209        IH21='BETA'
28210        IH22='    '
28211        ALOWL2=CPUMIN
28212        AUPPL2=1.0
28213        LOWLT2='>   '
28214        UPPLT2='<   '
28215        IH31='B   '
28216        IH32='    '
28217        ALOWL3=0.0
28218        AUPPL3=CPUMAX
28219        LOWLT3='>   '
28220        UPPLT3='<   '
28221        GOTO4300
28222      ELSEIF(ICASPL.EQ.'KATZ')THEN
28223        IH='ALPH'
28224        IH2='A   '
28225        ALOWLM=0.
28226        AUPPLM=CPUMAX
28227        LOWLTY='>   '
28228        UPPLTY='<   '
28229        IH21='BETA'
28230        IH22='    '
28231        ALOWL2=CPUMIN
28232        AUPPL2=1.0
28233        LOWLT2='>   '
28234        UPPLT2='<   '
28235        GOTO4200
28236      ELSEIF(ICASPL.EQ.'QBIN')THEN
28237        IH='P   '
28238        IH2='    '
28239        ALOWLM=0.
28240        AUPPLM=1.0
28241        LOWLTY='>=  '
28242        UPPLTY='<=  '
28243        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28244     1              ISUBN1,ISUBN2,IERROR)
28245        IF(IERROR.EQ.'YES')GOTO9000
28246        IH='M   '
28247        IH2='    '
28248        ILOWLM=0
28249        IUPPLM=I1MACH(9)
28250        LOWLTY='>=  '
28251        UPPLTY='<=  '
28252        CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
28253     1              ISUBN1,ISUBN2,IERROR)
28254        SHAPE3=REAL(ISHAPE)
28255        IF(IERROR.EQ.'YES')GOTO9000
28256        IH='PHI '
28257        IH2='    '
28258        ALOWLM=-SHAPE1/SHAPE3
28259        AUPPLM=(1.0-SHAPE1)/SHAPE3
28260        LOWLTY='>   '
28261        UPPLTY='<   '
28262        CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28263     1              ISUBN1,ISUBN2,IERROR)
28264      ELSEIF(ICASPL.EQ.'GEET')THEN
28265        IF(IGETDF.EQ.'THET')THEN
28266          IH='THET'
28267          IH2='A   '
28268          ALOWLM=0.
28269          AUPPLM=1.0
28270          LOWLTY='>   '
28271          UPPLTY='<   '
28272          CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,
28273     1              LOWLTY,UPPLTY,
28274     1              ISUBN1,ISUBN2,IERROR)
28275          IF(IERROR.EQ.'YES')GOTO9000
28276          IH='BETA'
28277          IH2='    '
28278          ALOWLM=1.0
28279          AUPPLM=1.0/SHAPE1
28280          LOWLTY='>   '
28281          UPPLTY='<   '
28282          CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,
28283     1                LOWLTY,UPPLTY,
28284     1                ISUBN1,ISUBN2,IERROR)
28285          IF(IERROR.EQ.'YES')THEN
28286            IF(SHAPE2.NE.0.0)THEN
28287              GOTO9000
28288            ELSE
28289              IERROR='NO'
28290            ENDIF
28291          ENDIF
28292        ELSE
28293          IH='MU  '
28294          IH2='    '
28295          ALOWLM=1.0
28296          AUPPLM=CPUMAX
28297          LOWLTY='>   '
28298          UPPLTY='<   '
28299          IH21='BETA'
28300          IH22='    '
28301          ALOWL2=1.0
28302          AUPPL2=CPUMAX
28303          LOWLT2='>   '
28304          UPPLT2='<   '
28305          GOTO4200
28306        ENDIF
28307      ELSEIF(ICASPL.EQ.'CONS')THEN
28308        IF(ICONDF.EQ.'THET')THEN
28309          IH='THET'
28310          IH2='A   '
28311          ALOWLM=0.
28312          AUPPLM=1.0
28313          LOWLTY='>   '
28314          UPPLTY='<   '
28315          IH21='M   '
28316          IH22='    '
28317          ALOWL2=1.0
28318          AUPPL2=CPUMAX
28319          LOWLT2='>=  '
28320          UPPLT2='<=  '
28321          GOTO4200
28322        ELSE
28323          IH='MU  '
28324          IH2='    '
28325          ALOWLM=1.0
28326          AUPPLM=CPUMAX
28327          LOWLTY='>   '
28328          UPPLTY='<   '
28329          IH21='M   '
28330          IH22='    '
28331          ALOWL2=1.0
28332          AUPPL2=CPUMAX
28333          LOWLT2='>=  '
28334          UPPLT2='<   '
28335          GOTO4200
28336        ENDIF
28337      ELSEIF(ICASPL.EQ.'AEPP')THEN
28338        IH='THET'
28339        IH2='A   '
28340        ALOWLM=0.
28341        AUPPLM=CPUMAX
28342        LOWLTY='>   '
28343        UPPLTY='<   '
28344        IH21='P   '
28345        IH22='    '
28346        ALOWL2=0.
28347        AUPPL2=1.0
28348        LOWLT2='>   '
28349        UPPLT2='<   '
28350        GOTO4200
28351      ELSEIF(ICASPL.EQ.'LOST')THEN
28352        IH='P   '
28353        IH2='    '
28354        ALOWLM=0.5
28355        AUPPLM=1.0
28356        LOWLTY='>   '
28357        UPPLTY='<   '
28358        IH21='R   '
28359        IH22='    '
28360        ILOWL2=0
28361        IUPPL2=I1MACH(9)
28362        LOWLT2='>=  '
28363        UPPLT2='<=  '
28364        GOTO4900
28365      ELSEIF(ICASPL.EQ.'GLGP')THEN
28366        IH='P   '
28367        IH2='    '
28368        ALOWLM=0.5
28369        AUPPLM=1.0
28370        LOWLTY='>   '
28371        UPPLTY='<   '
28372        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28373     1              ISUBN1,ISUBN2,IERROR)
28374        IF(IERROR.EQ.'YES')GOTO9000
28375        IH='A   '
28376        IH2='    '
28377        ALOWLM=0.0
28378        AUPPLM=CPUMAX
28379        LOWLTY='>   '
28380        UPPLTY='<   '
28381        CALL PARCHR(IH,IH2,IDIST,SHAPE3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28382     1              ISUBN1,ISUBN2,IERROR)
28383        IF(IERROR.EQ.'YES')GOTO9000
28384        IH='J   '
28385        IH2='    '
28386        ILOWLM=0
28387        IUPPLM=I1MACH(9)
28388        LOWLTY='>=  '
28389        UPPLTY='<=  '
28390        CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
28391     1              ISUBN1,ISUBN2,IERROR)
28392        SHAPE2=REAL(ISHAPE)
28393      ELSEIF(ICASPL.EQ.'DISW')THEN
28394        IH='Q   '
28395        IH2='    '
28396        ALOWLM=0.
28397        AUPPLM=1.0
28398        LOWLTY='>   '
28399        UPPLTY='<   '
28400        IH21='BETA'
28401        IH22='    '
28402        ALOWL2=0.0
28403        AUPPL2=CPUMAX
28404        LOWLT2='>   '
28405        UPPLT2='<   '
28406        GOTO4200
28407      ELSEIF(ICASPL.EQ.'LOGL')THEN
28408        IH='DELT'
28409        IH2='A   '
28410        IDIST='LOG-LOGISTIC'
28411        ALOWLM=0.
28412        AUPPLM=CPUMAX
28413        LOWLTY='>   '
28414        UPPLTY='<=  '
28415        GOTO4100
28416      ELSEIF(ICASPL.EQ.'GGAM')THEN
28417        IH='ALPH'
28418        IH2='A   '
28419        ALOWLM=0.
28420        AUPPLM=CPUMAX
28421        LOWLTY='>   '
28422        UPPLTY='<=  '
28423        IH21='C   '
28424        IH22='    '
28425        ALOWL2=CPUMIN
28426        AUPPL2=CPUMAX
28427        LOWLT2='>   '
28428        UPPLT2='<=  '
28429        GOTO4200
28430      ELSEIF(ICASPL.EQ.'YULE')THEN
28431        IH='P   '
28432        IH2='    '
28433        ALOWLM=0.1
28434        AUPPLM=CPUMAX
28435        LOWLTY='>=  '
28436        UPPLTY='<   '
28437        GOTO4100
28438      ELSEIF(ICASPL.EQ.'WARI')THEN
28439        IH='C   '
28440        IH2='    '
28441        ALOWLM=0.0
28442        AUPPLM=CPUMAX
28443        LOWLTY='>   '
28444        UPPLTY='<=  '
28445        IH21='A   '
28446        IH22='    '
28447        ALOWL2=0.0
28448        AUPPL2=CPUMAX
28449        LOWLT2='>   '
28450        UPPLT2='<=  '
28451        GOTO4200
28452      ELSEIF(ICASPL.EQ.'FNOR')THEN
28453        IH='MU  '
28454        IH2='    '
28455        ALOWLM=CPUMIN
28456        AUPPLM=CPUMAX
28457        LOWLTY='>   '
28458        UPPLTY='<=  '
28459        IH21='SD  '
28460        IH22='    '
28461        ALOWL2=0.0
28462        AUPPL2=CPUMAX
28463        LOWLT2='>   '
28464        UPPLT2='<=  '
28465        GOTO4200
28466      ELSEIF(ICASPL.EQ.'TNOR')THEN
28467        IH='MU  '
28468        IH2='    '
28469        ALOWLM=A
28470        AUPPLM=B
28471        LOWLTY='>   '
28472        UPPLTY='<=  '
28473        IH21='SD  '
28474        IH22='    '
28475        ALOWL2=0.0
28476        AUPPL2=CPUMAX
28477        LOWLT2='>   '
28478        UPPLT2='<=  '
28479        GOTO4200
28480      ELSEIF(ICASPL.EQ.'GOMP')THEN
28481        IF(IGOMDF.EQ.'JOHN' .OR. IGOMDF.EQ.'DEFA')THEN
28482          IH='C   '
28483          IH2='    '
28484          ALOWLM=1.
28485          AUPPLM=CPUMAX
28486          LOWLTY='>   '
28487          UPPLTY='<=  '
28488          IH21='B   '
28489          IH22='    '
28490          ALOWL2=0.
28491          AUPPL2=CPUMAX
28492          LOWLT2='>   '
28493          UPPLT2='<=  '
28494          GOTO4200
28495        ELSE
28496          IH='ALPH'
28497          IH2='A   '
28498          ALOWLM=0.
28499          AUPPLM=CPUMAX
28500          LOWLTY='>   '
28501          UPPLTY='<=  '
28502          IH21='K   '
28503          IH22='    '
28504          ALOWL2=0.
28505          AUPPL2=CPUMAX
28506          LOWLT2='>   '
28507          UPPLT2='<=  '
28508          GOTO4200
28509        ENDIF
28510      ELSEIF(ICASPL.EQ.'GHLO')THEN
28511        IH='GAMM'
28512        IH2='A   '
28513        ALOWLM=0.0
28514        AUPPLM=5.0
28515        LOWLTY='>=  '
28516        UPPLTY='<=  '
28517        GOTO4100
28518      ELSEIF(ICASPL.EQ.'WCAU')THEN
28519        IH='P   '
28520        IH2='    '
28521        ALOWLM=0.
28522        AUPPLM=1.
28523        LOWLTY='>=  '
28524        UPPLTY='<=  '
28525        GOTO4100
28526      ELSEIF(ICASPL.EQ.'ARCT')THEN
28527        IH='PHI '
28528        IH2='    '
28529        ALOWLM=CPUMIN
28530        AUPPLM=CPUMAX
28531        LOWLTY='>   '
28532        UPPLTY='<   '
28533        IH21='ALPH'
28534        IH22='A   '
28535        ALOWL2=0.
28536        AUPPL2=CPUMAX
28537        LOWLT2='>   '
28538        UPPLT2='<=  '
28539        GOTO4200
28540      ELSEIF(ICASPL.EQ.'EWEI')THEN
28541        IH='GAMM'
28542        IH2='A   '
28543        ALOWLM=0.
28544        AUPPLM=CPUMAX
28545        LOWLTY='>   '
28546        UPPLTY='<=  '
28547        IH21='THET'
28548        IH22='A   '
28549        ALOWL2=0.
28550        AUPPL2=CPUMAX
28551        LOWLT2='>   '
28552        UPPLT2='<=  '
28553        GOTO4200
28554      ELSEIF(ICASPL.EQ.'TEXP')THEN
28555        IH='X0  '
28556        IH2='    '
28557        ALOWLM=0.
28558        AUPPLM=CPUMAX
28559        LOWLTY='>   '
28560        UPPLTY='<=  '
28561        IH21='M   '
28562        IH22='    '
28563        ALOWL2=0.
28564        AUPPL2=CPUMAX
28565        LOWLT2='>=  '
28566        UPPLT2='<=  '
28567        IH31='SD  '
28568        IH32='    '
28569        ALOWL3=0.
28570        AUPPL3=CPUMAX
28571        LOWLT3='>   '
28572        UPPLT3='<=  '
28573        GOTO4300
28574      ELSEIF(ICASPL.EQ.'G5LO')THEN
28575        IH='ALPH'
28576        IH2='A   '
28577        ALOWLM=CPUMIN
28578        AUPPLM=CPUMAX
28579        LOWLTY='>   '
28580        UPPLTY='<=  '
28581        GOTO4100
28582      ELSEIF(ICASPL.EQ.'G4LO')THEN
28583        IH='P   '
28584        IH2='    '
28585        ALOWLM=0.0
28586        AUPPLM=CPUMAX
28587        LOWLTY='>   '
28588        UPPLTY='<=  '
28589        IH21='Q   '
28590        IH22='    '
28591        ALOWL2=0.0
28592        AUPPL2=CPUMAX
28593        LOWLT2='>   '
28594        UPPLT2='<=  '
28595        GOTO4200
28596      ELSEIF(ICASPL.EQ.'WAKE')THEN
28597C
28598        IH='GAMM'
28599        IH2='A   '
28600        ALOWLM=CPUMIN
28601        AUPPLM=CPUMAX
28602        LOWLTY='>   '
28603        UPPLTY='<=  '
28604        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28605     1              ISUBN1,ISUBN2,IERROR)
28606        IF(IERROR.EQ.'YES')GOTO9000
28607C
28608        IH='BETA'
28609        IH2='    '
28610        ALOWLM=CPUMIN
28611        AUPPLM=CPUMAX
28612        LOWLTY='>   '
28613        UPPLTY='<=  '
28614        CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28615     1              ISUBN1,ISUBN2,IERROR)
28616        IF(IERROR.EQ.'YES')GOTO9000
28617C
28618        IH='DELT'
28619        IH2='A   '
28620        ALOWLM=CPUMIN
28621        AUPPLM=CPUMAX
28622        LOWLTY='>   '
28623        UPPLTY='<=  '
28624        CALL PARCHR(IH,IH2,IDIST,SHAPE3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28625     1              ISUBN1,ISUBN2,IERROR)
28626        IF(IERROR.EQ.'YES')GOTO9000
28627        IH='ALPH'
28628        IH2='A   '
28629        ALOWLM=CPUMIN
28630        AUPPLM=CPUMAX
28631        LOWLTY='>   '
28632        UPPLTY='<=  '
28633        CALL PARCHR(IH,IH2,IDIST,SHAPE4,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28634     1              ISUBN1,ISUBN2,IERROR)
28635        IF(IERROR.EQ.'YES')GOTO9000
28636        IH='CHI '
28637        IH2='    '
28638        ALOWLM=CPUMIN
28639        AUPPLM=CPUMAX
28640        LOWLTY='>   '
28641        UPPLTY='<=  '
28642        CALL PARCHR(IH,IH2,IDIST,SHAPE5,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28643     1              ISUBN1,ISUBN2,IERROR)
28644      ELSEIF(ICASPL.EQ.'MBKA')THEN
28645        IH='THET'
28646        IH2='A   '
28647        ALOWLM=0.
28648        AUPPLM=CPUMAX
28649        LOWLTY='>   '
28650        UPPLTY='<=  '
28651        IH21='K   '
28652        IH22='    '
28653        ALOWL2=0.
28654        AUPPL2=CPUMAX
28655        LOWLT2='>   '
28656        UPPLT2='<=  '
28657        GOTO4200
28658      ELSEIF(ICASPL.EQ.'KAPP')THEN
28659        IH='K   '
28660        IH2='    '
28661        ALOWLM=CPUMIN
28662        AUPPLM=CPUMAX
28663        LOWLTY='>   '
28664        UPPLTY='<=  '
28665        IH21='H   '
28666        IH22='    '
28667        ALOWL2=CPUMIN
28668        AUPPL2=CPUMAX
28669        LOWLT2='>   '
28670        UPPLT2='<=  '
28671        GOTO4200
28672      ELSEIF(ICASPL.EQ.'FCAU')THEN
28673        IH='LOC '
28674        IH2='    '
28675        ALOWLM=CPUMIN
28676        AUPPLM=CPUMAX
28677        LOWLTY='>   '
28678        UPPLTY='<=  '
28679        IH21='SCAL'
28680        IH22='E   '
28681        ALOWL2=0.0
28682        AUPPL2=CPUMAX
28683        LOWLT2='>   '
28684        UPPLT2='<=  '
28685        GOTO4200
28686      ELSEIF(ICASPL.EQ.'BBIN' .OR. ICASPL.EQ.'POLY')THEN
28687        IH='ALPH'
28688        IH2='A   '
28689        ALOWLM=0.
28690        AUPPLM=CPUMAX
28691        LOWLTY='>   '
28692        UPPLTY='<=  '
28693        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28694     1              ISUBN1,ISUBN2,IERROR)
28695        IF(IERROR.EQ.'YES')GOTO9000
28696        IH='BETA'
28697        IH2='    '
28698        ALOWLM=0.
28699        AUPPLM=CPUMAX
28700        LOWLTY='>   '
28701        UPPLTY='<=  '
28702        CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28703     1              ISUBN1,ISUBN2,IERROR)
28704        IF(IERROR.EQ.'YES')GOTO9000
28705        IH='N   '
28706        IH2='    '
28707        ILOWLM=0
28708        IUPPLM=I1MACH(9)
28709        LOWLTY='>   '
28710        UPPLTY='<=  '
28711        CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
28712     1              ISUBN1,ISUBN2,IERROR)
28713        SHAPE3=REAL(ISHAPE)
28714      ELSEIF(ICASPL.EQ.'BNBI' .OR. ICASPL.EQ.'GWAR')THEN
28715        IH='ALPH'
28716        IH2='A   '
28717        ALOWLM=0.
28718        AUPPLM=CPUMAX
28719        LOWLTY='>   '
28720        UPPLTY='<=  '
28721        IH21='BETA'
28722        IH22='    '
28723        ALOWL2=0.
28724        AUPPL2=CPUMAX
28725        LOWLT2='>   '
28726        UPPLT2='<=  '
28727        IH31='K   '
28728        IH32='    '
28729        ALOWL3=0.
28730        AUPPL3=CPUMAX
28731        LOWLT3='>   '
28732        UPPLT3='<=  '
28733        GOTO4300
28734      ELSEIF(ICASPL.EQ.'ZETA')THEN
28735        IH='ALPH'
28736        IH2='A   '
28737        ALOWLM=1.
28738        AUPPLM=CPUMAX
28739        LOWLTY='>   '
28740        UPPLTY='<=  '
28741        GOTO4100
28742      ELSEIF(ICASPL.EQ.'ZIPF')THEN
28743        IH='ALPH'
28744        IH2='A   '
28745        ALOWLM=1.
28746        AUPPLM=CPUMAX
28747        LOWLTY='>   '
28748        UPPLTY='<=  '
28749        IH21='N   '
28750        IH22='    '
28751        ILOWL2=1
28752        IUPPL2=I1MACH(9)
28753        LOWLT2='>   '
28754        UPPLT2='<=  '
28755        GOTO4900
28756      ELSEIF(ICASPL.EQ.'MUTH')THEN
28757        IH='BETA'
28758        IH2='    '
28759        ALOWLM=0.
28760        AUPPLM=1.0
28761        LOWLTY='>=  '
28762        UPPLTY='<=  '
28763        GOTO4100
28764      ELSEIF(ICASPL.EQ.'L3EX')THEN
28765        IH='BETA'
28766        IH2='    '
28767        ALOWLM=0.
28768        AUPPLM=CPUMAX
28769        LOWLTY='>   '
28770        UPPLTY='<=  '
28771        IH21='ALPH'
28772        IH22='A   '
28773        ALOWL2=0.
28774        AUPPL2=CPUMAX
28775        LOWLT2='>   '
28776        UPPLT2='<=  '
28777        IH31='THET'
28778        IH32='A   '
28779        ALOWL3=0.
28780        AUPPL3=CPUMAX
28781        LOWLT3='>=  '
28782        UPPLT3='<=  '
28783        GOTO4300
28784      ELSEIF(ICASPL.EQ.'GEXP')THEN
28785        IH='LAMB'
28786        IH2='DA1 '
28787        ALOWLM=0.
28788        AUPPLM=CPUMAX
28789        LOWLTY='>   '
28790        UPPLTY='<=  '
28791        IH21='LAMB'
28792        IH22='DA12'
28793        ALOWL2=0.
28794        AUPPL2=CPUMAX
28795        LOWLT2='>   '
28796        UPPLT2='<=  '
28797        IH31='S   '
28798        IH32='    '
28799        ALOWL3=0.
28800        AUPPL3=CPUMAX
28801        LOWLT3='>   '
28802        UPPLT3='<=  '
28803        GOTO4300
28804      ELSEIF(ICASPL.EQ.'RECI')THEN
28805        IH='B   '
28806        IH2='    '
28807        ALOWLM=1.
28808        AUPPLM=CPUMAX
28809        LOWLTY='>   '
28810        UPPLTY='<=  '
28811        GOTO4100
28812      ELSEIF(ICASPL.EQ.'NORX')THEN
28813        IH='U1  '
28814        IH2='    '
28815        ALOWLM=CPUMIN
28816        AUPPLM=CPUMAX
28817        LOWLTY='>=  '
28818        UPPLTY='<=  '
28819        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28820     1              ISUBN1,ISUBN2,IERROR)
28821        IF(IERROR.EQ.'YES')GOTO9000
28822        IH='SD1 '
28823        IH2='    '
28824        ALOWLM=0.0
28825        AUPPLM=CPUMAX
28826        LOWLTY='>=  '
28827        UPPLTY='<=  '
28828        CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28829     1              ISUBN1,ISUBN2,IERROR)
28830        IF(IERROR.EQ.'YES')GOTO9000
28831        IH='U2  '
28832        IH2='    '
28833        ALOWLM=CPUMIN
28834        AUPPLM=CPUMAX
28835        LOWLTY='>   '
28836        UPPLTY='<=  '
28837        CALL PARCHR(IH,IH2,IDIST,SHAPE3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28838     1              ISUBN1,ISUBN2,IERROR)
28839        IF(IERROR.EQ.'YES')GOTO9000
28840        IH='SD2 '
28841        IH2='    '
28842        ALOWLM=0.0
28843        AUPPLM=CPUMAX
28844        LOWLTY='>   '
28845        UPPLTY='<=  '
28846        CALL PARCHR(IH,IH2,IDIST,SHAPE4,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28847     1              ISUBN1,ISUBN2,IERROR)
28848        IF(IERROR.EQ.'YES')GOTO9000
28849        IH='P   '
28850        IH2='    '
28851        ALOWLM=0.0
28852        AUPPLM=1.0
28853        LOWLTY='>   '
28854        UPPLTY='<   '
28855        CALL PARCHR(IH,IH2,IDIST,SHAPE5,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28856     1              ISUBN1,ISUBN2,IERROR)
28857        IF(IERROR.EQ.'YES')GOTO9000
28858      ELSEIF(ICASPL.EQ.'ALDE')THEN
28859        IH='ALPH'
28860        IH2='A   '
28861        ALOWLM=0.
28862        AUPPLM=CPUMAX
28863        LOWLTY='>   '
28864        UPPLTY='<   '
28865        IH21='BETA'
28866        IH22='    '
28867        ALOWL2=0.
28868        AUPPL2=CPUMAX
28869        LOWLT2='>   '
28870        UPPLT2='<   '
28871        GOTO4200
28872      ELSEIF(ICASPL.EQ.'JOSU' .OR. ICASPL.EQ.'JOSB')THEN
28873        IH='ALPH'
28874        IH2='A1  '
28875        ALOWLM=CPUMIN
28876        AUPPLM=CPUMAX
28877        LOWLTY='>=  '
28878        UPPLTY='<=  '
28879        IH21='ALPH'
28880        IH22='A2  '
28881        ALOWL2=0.
28882        AUPPL2=CPUMAX
28883        LOWLT2='>   '
28884        UPPLT2='<=  '
28885        GOTO4200
28886      ELSEIF(ICASPL.EQ.'GTLA')THEN
28887        IH='LAMB'
28888        IH2='DA3 '
28889        ALOWLM=CPUMIN
28890        AUPPLM=CPUMAX
28891        LOWLTY='>=  '
28892        UPPLTY='<=  '
28893        IH21='LAMB'
28894        IH22='DA4 '
28895        ALOWL2=CPUMIN
28896        AUPPL2=CPUMAX
28897        LOWLT2='>   '
28898        UPPLT2='<=  '
28899        GOTO4200
28900      ELSEIF(ICASPL.EQ.'ERRO')THEN
28901        IH='ALPH'
28902        IH2='A   '
28903        ALOWLM=1.0
28904        AUPPLM=CPUMAX
28905        LOWLTY='>=  '
28906        UPPLTY='<=  '
28907        GOTO4100
28908      ELSEIF(ICASPL.EQ.'TSPO')THEN
28909        IH='THET'
28910        IH2='A   '
28911        ALOWLM=A
28912        AUPPLM=B
28913        LOWLTY='>=  '
28914        UPPLTY='<=  '
28915        IH21='N   '
28916        IH22='    '
28917        ALOWL2=0.
28918        AUPPL2=CPUMAX
28919        LOWLT2='>   '
28920        UPPLT2='<=  '
28921        GOTO4200
28922      ELSEIF(ICASPL.EQ.'BWEI')THEN
28923        IH='SCAL'
28924        IH2='E1  '
28925        ALOWLM=0.
28926        AUPPLM=CPUMAX
28927        LOWLTY='>   '
28928        UPPLTY='<=  '
28929        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28930     1              ISUBN1,ISUBN2,IERROR)
28931        IF(IERROR.EQ.'YES')GOTO9000
28932        IH='SCAL'
28933        IH2='E2  '
28934        ALOWLM=0.
28935        AUPPLM=CPUMAX
28936        LOWLTY='>   '
28937        UPPLTY='<=  '
28938        CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28939     1              ISUBN1,ISUBN2,IERROR)
28940        IF(IERROR.EQ.'YES')GOTO9000
28941        IH='GAMM'
28942        IH2='A1  '
28943        ALOWLM=0.
28944        AUPPLM=CPUMAX
28945        LOWLTY='>   '
28946        UPPLTY='<=  '
28947        CALL PARCHR(IH,IH2,IDIST,SHAPE3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28948     1              ISUBN1,ISUBN2,IERROR)
28949        IF(IERROR.EQ.'YES')GOTO9000
28950        IH='GAMM'
28951        IH2='A2  '
28952        ALOWLM=0.
28953        AUPPLM=CPUMAX
28954        LOWLTY='>   '
28955        UPPLTY='<=  '
28956        CALL PARCHR(IH,IH2,IDIST,SHAPE4,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28957     1              ISUBN1,ISUBN2,IERROR)
28958        IF(IERROR.EQ.'YES')GOTO9000
28959        IH='LOC2'
28960        IH2='    '
28961        ALOWLM=0.
28962        AUPPLM=CPUMAX
28963        LOWLTY='>   '
28964        UPPLTY='<=  '
28965        CALL PARCHR(IH,IH2,IDIST,SHAPE5,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
28966     1              ISUBN1,ISUBN2,IERROR)
28967        IF(IERROR.EQ.'YES')GOTO9000
28968      ELSEIF(ICASPL.EQ.'TRAP')THEN
28969        IH='A   '
28970        IH2='    '
28971        ALOWLM=CPUMIN
28972        AUPPLM=CPUMAX
28973        LOWLTY='>=  '
28974        UPPLTY='<=  '
28975        IH21='B   '
28976        IH22='    '
28977        ALOWL2=CPUMIN
28978        AUPPL2=CPUMAX
28979        LOWLT2='>=  '
28980        UPPLT2='<=  '
28981        IH31='C   '
28982        IH32='    '
28983        ALOWL3=CPUMIN
28984        AUPPL3=CPUMAX
28985        LOWLT3='>=  '
28986        UPPLT3='<=  '
28987        IH41='D   '
28988        IH42='    '
28989        ALOWL4=CPUMIN
28990        AUPPL4=CPUMAX
28991        LOWLT4='>=  '
28992        UPPLT4='<=  '
28993        GOTO4400
28994      ELSEIF(ICASPL.EQ.'GTRA')THEN
28995        IH='A   '
28996        IH2='    '
28997        ALOWLM=CPUMIN
28998        AUPPLM=CPUMAX
28999        LOWLTY='>=  '
29000        UPPLTY='<=  '
29001        CALL PARCHR(IH,IH2,IDIST,SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29002     1              ISUBN1,ISUBN2,IERROR)
29003        IF(IERROR.EQ.'YES')GOTO9000
29004        IH='B   '
29005        IH2='    '
29006        ALOWLM=CPUMIN
29007        AUPPLM=CPUMAX
29008        LOWLTY='>=  '
29009        UPPLTY='<=  '
29010        CALL PARCHR(IH,IH2,IDIST,SHAPE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29011     1              ISUBN1,ISUBN2,IERROR)
29012        IF(IERROR.EQ.'YES')GOTO9000
29013        IH='C   '
29014        IH2='    '
29015        ALOWLM=CPUMIN
29016        AUPPLM=CPUMAX
29017        LOWLTY='>=  '
29018        UPPLTY='<=  '
29019        CALL PARCHR(IH,IH2,IDIST,SHAPE3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29020     1              ISUBN1,ISUBN2,IERROR)
29021        IF(IERROR.EQ.'YES')GOTO9000
29022        IH='D   '
29023        IH2='    '
29024        ALOWLM=CPUMIN
29025        AUPPLM=CPUMAX
29026        LOWLTY='>=  '
29027        UPPLTY='<=  '
29028        CALL PARCHR(IH,IH2,IDIST,SHAPE4,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29029     1              ISUBN1,ISUBN2,IERROR)
29030        IF(IERROR.EQ.'YES')GOTO9000
29031        IH='ALPH'
29032        IH2='A   '
29033        ALOWLM=0.0
29034        AUPPLM=CPUMAX
29035        LOWLTY='>   '
29036        UPPLTY='<=  '
29037        CALL PARCHR(IH,IH2,IDIST,SHAPE5,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29038     1              ISUBN1,ISUBN2,IERROR)
29039        IF(IERROR.EQ.'YES')GOTO9000
29040        IH='NU1 '
29041        IH2='    '
29042        ALOWLM=0.0
29043        AUPPLM=CPUMAX
29044        LOWLTY='>   '
29045        UPPLTY='<=  '
29046        CALL PARCHR(IH,IH2,IDIST,SHAPE6,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29047     1              ISUBN1,ISUBN2,IERROR)
29048        IF(IERROR.EQ.'YES')GOTO9000
29049        IH='NU3 '
29050        IH2='    '
29051        ALOWLM=0.0
29052        AUPPLM=CPUMAX
29053        LOWLTY='>   '
29054        UPPLTY='<=  '
29055        CALL PARCHR(IH,IH2,IDIST,SHAPE7,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29056     1              ISUBN1,ISUBN2,IERROR)
29057        IF(IERROR.EQ.'YES')GOTO9000
29058C
29059        IF(SHAPE1.GE.SHAPE2 .OR. SHAPE2.GE.SHAPE3 .OR.
29060     1     SHAPE3.GE.SHAPE4)THEN
29061          WRITE(ICOUT,7322)
29062          CALL DPWRST('XXX','BUG ')
29063          WRITE(ICOUT,7323)
29064          CALL DPWRST('XXX','BUG ')
29065          WRITE(ICOUT,7324)
29066          CALL DPWRST('XXX','BUG ')
29067          WRITE(ICOUT,7326)SHAPE1,SHAPE2,SHAPE3,SHAPE4
29068          CALL DPWRST('XXX','BUG ')
29069          IERROR='YES'
29070          GOTO9000
29071        ENDIF
29072 7322   FORMAT(
29073     1'***** ERROR--FOR THE GENERALZIED TRAPEZOID DISTRIBUTION,')
29074 7323   FORMAT(
29075     1'      THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
29076 7324   FORMAT(
29077     1'         A < B < C < D')
29078 7326   FORMAT(
29079     1'      A, B, C, D = ',4G15.7)
29080C
29081      ELSEIF(ICASPL.EQ.'TSKE')THEN
29082        IH='NU  '
29083        IH2='    '
29084        ALOWLM=1.0
29085        AUPPLM=CPUMAX
29086        LOWLTY='>=  '
29087        UPPLTY='<=  '
29088        IH21='LAMB'
29089        IH22='DA  '
29090        ALOWL2=CPUMIN
29091        AUPPL2=CPUMAX
29092        LOWLT2='>   '
29093        UPPLT2='<   '
29094        GOTO4200
29095      ELSEIF(ICASPL.EQ.'GOMM')THEN
29096        IF(IMAKDF.EQ.'DLMF')THEN
29097          IH='XI  '
29098          IH2='    '
29099          ALOWLM=0.0
29100          AUPPLM=CPUMAX
29101          LOWLTY='>   '
29102          UPPLTY='<=  '
29103          IH21='LAMB'
29104          IH22='DA  '
29105          ALOWL2=0.0
29106          AUPPL2=CPUMAX
29107          LOWLT2='>=  '
29108          UPPLT2='<=  '
29109          IH31='THET'
29110          IH32='A   '
29111          ALOWL3=0.0
29112          AUPPL3=CPUMAX
29113          LOWLT3='>=  '
29114          UPPLT3='<=  '
29115          GOTO4300
29116        ELSEIF(IMAKDF.EQ.'MEEK')THEN
29117          IH='GAMM'
29118          IH2='A   '
29119          ALOWLM=0.0
29120          AUPPLM=CPUMAX
29121          LOWLTY='>   '
29122          UPPLTY='<=  '
29123          IH21='LAMB'
29124          IH22='DA  '
29125          ALOWL2=0.0
29126          AUPPL2=CPUMAX
29127          LOWLT2='>=  '
29128          UPPLT2='<=  '
29129          IH31='K   '
29130          IH32='    '
29131          ALOWL3=0.0
29132          AUPPL3=CPUMAX
29133          LOWLT3='>   '
29134          UPPLT3='<=  '
29135          GOTO4300
29136        ELSE
29137          IH='ETA '
29138          IH2='    '
29139          ALOWLM=CPUMIN
29140          AUPPLM=CPUMAX
29141          LOWLTY='>=  '
29142          UPPLTY='<=  '
29143          IH21='ZETA'
29144          IH22='    '
29145          ALOWL2=0.0
29146          AUPPL2=CPUMAX
29147          LOWLT2='>=  '
29148          UPPLT2='<=  '
29149          GOTO4200
29150        ENDIF
29151      ELSEIF(ICASPL.EQ.'GIGA')THEN
29152        IH='LAMB'
29153        IH2='DA  '
29154        ALOWLM=CPUMIN
29155        AUPPLM=CPUMAX
29156        LOWLTY='>=  '
29157        UPPLTY='<=  '
29158        CALL PARCHR(IH,IH2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29159     1              ISUBN1,ISUBN2,IERROR)
29160        IF(IERROR.EQ.'YES')GOTO9000
29161        IF(IGIGDF.EQ.'3PAR')THEN
29162          IH21='CHI '
29163          IH22='    '
29164          ALOWL2=0.0
29165          AUPPL2=CPUMAX
29166          LOWLT2='>   '
29167          IF(ALAMBA.GT.0.0)LOWLTY='>=  '
29168          UPPLTY='<=  '
29169          CALL PARCHR(IH,IH2,IDIST,CHI,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29170     1              ISUBN1,ISUBN2,IERROR)
29171          IF(IERROR.EQ.'YES')GOTO9000
29172          IH31='PSI '
29173          IH32='    '
29174          ALOWL3=0.0
29175          AUPPL3=CPUMAX
29176          LOWLT3='>   '
29177          IF(ALAMBA.LT.0.0)LOWLT3='>=  '
29178          UPPLT3='<=  '
29179          CALL PARCHR(IH,IH2,IDIST,PSI,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29180     1              ISUBN1,ISUBN2,IERROR)
29181          IF(IERROR.EQ.'YES')GOTO9000
29182C
29183          IF(CHI.EQ.0.0 .AND. PSI.EQ.0.0)THEN
29184            WRITE(ICOUT,999)
29185  999       FORMAT(1X)
29186            CALL DPWRST('XXX','BUG ')
29187            WRITE(ICOUT,1301)
29188 1301     FORMAT('***** ERROR-FOR THE GENERALIZED INVERSE GAUSSIAN ',
29189     1           'PROBABILITY PLOT')
29190            CALL DPWRST('XXX','BUG ')
29191            WRITE(ICOUT,1303)
29192 1303     FORMAT('      THE CHI AND PSI SHAPE PARAMETERS CANNOT BOTH ',
29193     1           'BE ZERO.')
29194            CALL DPWRST('XXX','BUG ')
29195            IERROR='YES'
29196            GOTO9000
29197          ENDIF
29198        ELSE
29199          IH='OMEG'
29200          IH2='A   '
29201          ALOWLM=0.0
29202          AUPPLM=CPUMAX
29203          LOWLTY='>=  '
29204          UPPLTY='<=  '
29205          GOTO4200
29206        ENDIF
29207      ELSEIF(ICASPL.EQ.'GHPP')THEN
29208        IH='G   '
29209        IH2='    '
29210        ALOWLM=CPUMIN
29211        AUPPLM=CPUMAX
29212        LOWLTY='>=  '
29213        UPPLTY='<=  '
29214        IH21='H   '
29215        IH22='    '
29216        ALOWL2=0.0
29217        AUPPL2=CPUMAX
29218        LOWLT2='>=  '
29219        UPPLT2='<=  '
29220        GOTO4200
29221      ELSEIF(ICASPL.EQ.'GPP')THEN
29222        IH='G   '
29223        IH2='    '
29224        ALOWLM=CPUMIN
29225        AUPPLM=CPUMAX
29226        LOWLTY='>=  '
29227        UPPLTY='<=  '
29228        GOTO4100
29229      ELSEIF(ICASPL.EQ.'HPP')THEN
29230        IH='H   '
29231        IH2='    '
29232        ALOWLM=CPUMIN
29233        AUPPLM=CPUMAX
29234        LOWLTY='>=  '
29235        UPPLTY='<=  '
29236        GOTO4100
29237      ELSEIF(ICASPL.EQ.'LSNO')THEN
29238        IH='LAMB'
29239        IH2='DA  '
29240        ALOWLM=CPUMIN
29241        AUPPLM=CPUMAX
29242        LOWLTY='>=  '
29243        UPPLTY='<=  '
29244        IH21='SD  '
29245        IH22='    '
29246        ALOWL2=0.0
29247        AUPPL2=CPUMAX
29248        LOWLT2='>   '
29249        UPPLT2='<=  '
29250        GOTO4200
29251      ELSEIF(ICASPL.EQ.'LSKT')THEN
29252        IH='NU  '
29253        IH2='    '
29254        ALOWLM=1.0
29255        AUPPLM=CPUMAX
29256        LOWLTY='>=  '
29257        UPPLTY='<=  '
29258        IH21='LAMB'
29259        IH22='DA  '
29260        ALOWL2=CPUMIN
29261        AUPPL2=CPUMAX
29262        LOWLT2='>=  '
29263        UPPLT2='<=  '
29264        IH31='SD  '
29265        IH32='    '
29266        ALOWL3=0.0
29267        AUPPL3=CPUMAX
29268        LOWLT3='>   '
29269        UPPLT3='<=  '
29270        GOTO4300
29271      ELSEIF(ICASPL.EQ.'SDEX')THEN
29272        IH='LAMB'
29273        IH2='DA  '
29274        ALOWLM=0.0
29275        AUPPLM=CPUMAX
29276        LOWLTY='>=  '
29277        UPPLTY='<   '
29278        GOTO4100
29279      ELSEIF(ICASPL.EQ.'ADEX')THEN
29280        IF(IADEDF.EQ.'K')THEN
29281          IH='K   '
29282          IH2='    '
29283          ALOWLM=0.0
29284          AUPPLM=CPUMAX
29285          LOWLTY='>   '
29286          UPPLTY='<   '
29287          GOTO4100
29288        ELSE
29289          IH='MU  '
29290          IH2='    '
29291          ALOWLM=0.0
29292          AUPPLM=CPUMAX
29293          LOWLTY='>   '
29294          UPPLTY='<   '
29295          GOTO4100
29296        ENDIF
29297      ELSEIF(ICASPL.EQ.'GALP')THEN
29298        IF(IADEDF.EQ.'K')THEN
29299          IH='K   '
29300          IH2='    '
29301          ALOWLM=0.0
29302          AUPPLM=CPUMAX
29303          LOWLTY='>   '
29304          UPPLTY='<   '
29305          IH21='TAU '
29306          IH22='    '
29307          ALOWL2=0.0
29308          AUPPL2=CPUMAX
29309          LOWLT2='>   '
29310          UPPLT2='<   '
29311          GOTO4200
29312        ELSE
29313          IH='MU  '
29314          IH2='    '
29315          ALOWLM=0.0
29316          AUPPLM=CPUMAX
29317          LOWLTY='>   '
29318          UPPLTY='<   '
29319          IH21='TAU '
29320          IH22='    '
29321          ALOWL2=0.0
29322          AUPPL2=CPUMAX
29323          LOWLT2='>   '
29324          UPPLT2='<   '
29325          GOTO4200
29326        ENDIF
29327      ELSEIF(ICASPL.EQ.'MCLE')THEN
29328        IH='ALPH'
29329        IH2='A   '
29330        ALOWLM=0.0
29331        AUPPLM=CPUMAX
29332        LOWLTY='>   '
29333        UPPLTY='<=  '
29334        GOTO4100
29335      ELSEIF(ICASPL.EQ.'GMCL')THEN
29336        IH='ALPH'
29337        IH2='A   '
29338        ALOWLM=0.0
29339        AUPPLM=CPUMAX
29340        LOWLTY='>   '
29341        UPPLTY='<=  '
29342        IH21='A   '
29343        IH22='    '
29344        ALOWL2=-1.0
29345        AUPPL2=1.0
29346        LOWLT2='>   '
29347        UPPLT2='<   '
29348        GOTO4200
29349      ELSEIF(ICASPL.EQ.'BEIP' .OR. IDIST.EQ.'BEKP')THEN
29350        IF(IBEIDF.EQ.'1')THEN
29351          IH='SIGM'
29352          IH2='A1SQ'
29353          ALOWLM=0.0
29354          AUPPLM=CPUMAX
29355          LOWLTY='>   '
29356          UPPLTY='<=  '
29357          IH21='SIGM'
29358          IH22='A2SQ'
29359          ALOWL2=0.0
29360          AUPPL2=CPUMAX
29361          LOWLT2='>   '
29362          UPPLT2='<=  '
29363          IH31='NU  '
29364          IH32='    '
29365          ALOWL3=0.0
29366          AUPPL3=CPUMAX
29367          LOWLT3='>   '
29368          UPPLT3='<=  '
29369          GOTO4300
29370        ELSE
29371          IH='B   '
29372          IH2='    '
29373          ALOWLM=0.0
29374          AUPPLM=CPUMAX
29375          LOWLTY='>   '
29376          UPPLTY='<=  '
29377          IH21='C   '
29378          IH22='    '
29379          ALOWL2=1.0
29380          AUPPL2=CPUMAX
29381          LOWLT2='>   '
29382          UPPLT2='<=  '
29383          IH31='M   '
29384          IH32='    '
29385          ALOWL3=0.5
29386          AUPPL3=CPUMAX
29387          LOWLT3='>   '
29388          UPPLT3='<=  '
29389          GOTO4300
29390        ENDIF
29391      ELSEIF(ICASPL.EQ.'BTAN')THEN
29392        IH='LAMB'
29393        IH2='DA  '
29394        ALOWLM=0.0
29395        AUPPLM=1.0
29396        LOWLTY='>   '
29397        UPPLTY='<   '
29398        IH21='K   '
29399        IH22='    '
29400        ILOWL2=1
29401        IUPPL2=I1MACH(9)
29402        LOWLT2='>=  '
29403        UPPLT2='<=  '
29404        GOTO4900
29405      ELSEIF(ICASPL.EQ.'LPOI')THEN
29406        IH='LAMB'
29407        IH2='DA  '
29408        ALOWLM=0.0
29409        AUPPLM=1.0
29410        LOWLTY='>   '
29411        UPPLTY='<   '
29412        IH21='THET'
29413        IH22='A   '
29414        ALOWL2=0.0
29415        AUPPL2=CPUMAX
29416        LOWLT2='>   '
29417        UPPLT2='<=  '
29418        GOTO4200
29419      ELSEIF(ICASPL.EQ.'LBET')THEN
29420        IH='ALPH'
29421        IH2='A   '
29422        ALOWLM=0.
29423        AUPPLM=CPUMAX
29424        LOWLTY='>   '
29425        UPPLTY='<=  '
29426        IH21='BETA'
29427        IH22='    '
29428        ALOWL2=0.
29429        AUPPL2=CPUMAX
29430        LOWLT2='>   '
29431        UPPLT2='<=  '
29432        IH31='C   '
29433        IH32='    '
29434        ALOWL3=0.
29435        AUPPL3=CPUMAX
29436        LOWLT3='>   '
29437        UPPLT3='<=  '
29438        IH41='D   '
29439        IH42='    '
29440        ALOWL4=0.
29441        AUPPL4=CPUMAX
29442        LOWLT4='>   '
29443        UPPLT4='<=  '
29444        GOTO4400
29445      ELSEIF(ICASPL.EQ.'SLOP')THEN
29446        IH='ALPH'
29447        IH2='A   '
29448        ALOWLM=0.
29449        AUPPLM=2.0
29450        LOWLTY='>   '
29451        UPPLTY='<=  '
29452        GOTO4100
29453      ELSEIF(ICASPL.EQ.'OGIV')THEN
29454        IH='N   '
29455        IH2='    '
29456        ALOWLM=0.5
29457        AUPPLM=CPUMAX
29458        LOWLTY='>=  '
29459        UPPLTY='<   '
29460        GOTO4100
29461      ELSEIF(ICASPL.EQ.'TSSL')THEN
29462        IH='THET'
29463        IH2='A   '
29464        ALOWLM=A
29465        AUPPLM=B
29466        LOWLTY='>=  '
29467        UPPLTY='<=  '
29468        IH21='ALPH'
29469        IH22='A   '
29470        ALOWL2=0.
29471        AUPPL2=2.0
29472        LOWLT2='>   '
29473        UPPLT2='<=  '
29474        GOTO4200
29475      ELSEIF(ICASPL.EQ.'TSOG')THEN
29476        IH='THET'
29477        IH2='A   '
29478        ALOWLM=A
29479        AUPPLM=B
29480        LOWLTY='>=  '
29481        UPPLTY='<=  '
29482        IH21='N   '
29483        IH22='    '
29484        ALOWL2=0.5
29485        AUPPL2=CPUMAX
29486        LOWLT2='>=  '
29487        UPPLT2='<   '
29488        GOTO4200
29489      ELSEIF(ICASPL.EQ.'BUR2' .OR. ICASPL.EQ.'BUR7' .OR.
29490     1       ICASPL.EQ.'BUR8' .OR. ICASPL.EQ.'BU10' .OR.
29491     1       ICASPL.EQ.'BU11' .OR. ICASPL.EQ.'SEMC')THEN
29492        IH='R   '
29493        IH2='    '
29494        ALOWLM=0.
29495        AUPPLM=CPUMAX
29496        LOWLTY='>   '
29497        UPPLTY='<=  '
29498        GOTO4100
29499      ELSEIF(ICASPL.EQ.'BUR3' .OR. ICASPL.EQ.'BUR5' .OR.
29500     1       ICASPL.EQ.'BUR6')THEN
29501        IH='R   '
29502        IH2='    '
29503        ALOWLM=0.
29504        AUPPLM=CPUMAX
29505        LOWLTY='>   '
29506        UPPLTY='<=  '
29507        IH21='K   '
29508        IH22='    '
29509        ALOWL2=0.
29510        AUPPL2=CPUMAX
29511        LOWLT2='>   '
29512        UPPLT2='<=  '
29513        GOTO4200
29514      ELSEIF(ICASPL.EQ.'BUR4')THEN
29515        IH='R   '
29516        IH2='    '
29517        ALOWLM=0.
29518        AUPPLM=CPUMAX
29519        LOWLTY='>   '
29520        UPPLTY='<=  '
29521        IH21='C   '
29522        IH22='    '
29523        ALOWL2=0.
29524        AUPPL2=CPUMAX
29525        LOWLT2='>   '
29526        UPPLT2='<=  '
29527        GOTO4200
29528      ELSEIF(ICASPL.EQ.'BUR9')THEN
29529        IH='K   '
29530        IH2='    '
29531        ALOWLM=0.
29532        AUPPLM=CPUMAX
29533        LOWLTY='>   '
29534        UPPLTY='<=  '
29535        IH21='R   '
29536        IH22='    '
29537        ALOWL2=0.
29538        AUPPL2=CPUMAX
29539        LOWLT2='>   '
29540        UPPLT2='<=  '
29541        GOTO4200
29542      ELSEIF(ICASPL.EQ.'BU12')THEN
29543        IH='C   '
29544        IH2='    '
29545        ALOWLM=0.
29546        AUPPLM=CPUMAX
29547        LOWLTY='>   '
29548        UPPLTY='<=  '
29549        IH21='K   '
29550        IH22='    '
29551        ALOWL2=0.
29552        AUPPL2=CPUMAX
29553        LOWLT2='>   '
29554        UPPLT2='<=  '
29555        GOTO4200
29556      ELSEIF(ICASPL.EQ.'DPUN')THEN
29557        IH='M   '
29558        IH2='    '
29559        ALOWLM=0.
29560        AUPPLM=CPUMAX
29561        LOWLTY='>   '
29562        UPPLTY='<=  '
29563        IH21='N   '
29564        IH22='    '
29565        ALOWL2=0.
29566        AUPPL2=CPUMAX
29567        LOWLT2='>   '
29568        UPPLT2='<=  '
29569        IH31='ALPH'
29570        IH32='A   '
29571        ALOWL3=0.
29572        AUPPL3=CPUMAX
29573        LOWLT3='>   '
29574        UPPLT3='<=  '
29575        IH41='BETA'
29576        IH42='    '
29577        ALOWL4=0.
29578        AUPPL4=CPUMAX
29579        LOWLT4='>   '
29580        UPPLT4='<=  '
29581        GOTO4400
29582      ELSEIF(ICASPL.EQ.'NCCS' .OR. ICASPL.EQ.'NCT')THEN
29583        IH='NU  '
29584        IH2='    '
29585        ALOWLM=0.
29586        AUPPLM=CPUMAX
29587        LOWLTY='>   '
29588        UPPLTY='<=  '
29589        IH21='LAMB'
29590        IH22='DA  '
29591        ALOWL2=0.
29592        AUPPL2=CPUMAX
29593        LOWLT2='>=  '
29594        UPPLT2='<=  '
29595        GOTO4200
29596      ELSEIF(ICASPL.EQ.'EEWE')THEN
29597        IH='GAMM'
29598        IH2='A1  '
29599        ALOWLM=0.
29600        AUPPLM=CPUMAX
29601        LOWLTY='>   '
29602        UPPLTY='<=  '
29603        IH21='SCAL'
29604        IH22='E1  '
29605        ALOWL2=0.
29606        AUPPL2=CPUMAX
29607        LOWLT2='>   '
29608        UPPLT2='<=  '
29609        IH31='GAMM'
29610        IH32='A2  '
29611        ALOWL3=0.
29612        AUPPL3=CPUMAX
29613        LOWLT3='>   '
29614        UPPLT3='<=  '
29615        IH41='SCAL'
29616        IH42='E2  '
29617        ALOWL4=0.
29618        AUPPL4=CPUMAX
29619        LOWLT4='>   '
29620        UPPLT4='<=  '
29621        IF(IEEWLI.EQ.'VARI')THEN
29622          GOTO4400
29623        ELSE
29624          IH51='L   '
29625          IH52='    '
29626          ALOWL5=0.
29627          AUPPL5=CPUMAX
29628          LOWLT5='>   '
29629          UPPLT5='<=  '
29630          GOTO4500
29631        ENDIF
29632      ELSEIF(ICASPL.EQ.'UTSP')THEN
29633        IDIST='UNEVEN TWO-SIDED POWER'
29634        IH='A   '
29635        IH2='    '
29636        IHWUSE='P'
29637        MESSAG='YES'
29638        CALL CHECKN(IH,IH2,IHWUSE,
29639     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
29640     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
29641        IF(IERROR.EQ.'YES')GOTO9000
29642        A=VALUE(ILOCP)
29643C
29644        IH='B   '
29645        IH2='    '
29646        IHWUSE='P'
29647        MESSAG='YES'
29648        CALL CHECKN(IH,IH2,IHWUSE,
29649     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
29650     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
29651        IF(IERROR.EQ.'YES')GOTO9000
29652        B=VALUE(ILOCP)
29653C
29654        IH='D   '
29655        IH2='    '
29656        IHWUSE='P'
29657        MESSAG='YES'
29658        CALL CHECKN(IH,IH2,IHWUSE,
29659     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
29660     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
29661        IF(IERROR.EQ.'YES')GOTO9000
29662        DZ=VALUE(ILOCP)
29663C
29664        IH='ALPH'
29665        IH2='A   '
29666        ALOWLM=0.0
29667        AUPPLM=CPUMAX
29668        LOWLTY='>   '
29669        UPPLTY='<=  '
29670        CALL PARCHR(IH,IH2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29671     1              ISUBN1,ISUBN2,IERROR)
29672        IF(IERROR.EQ.'YES')GOTO9000
29673C
29674        IH='NU1 '
29675        IH2='    '
29676        ALOWLM=0.0
29677        AUPPLM=CPUMAX
29678        LOWLTY='>   '
29679        UPPLTY='<=  '
29680        CALL PARCHR(IH,IH2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29681     1              ISUBN1,ISUBN2,IERROR)
29682        IF(IERROR.EQ.'YES')GOTO9000
29683C
29684        IH='NU3 '
29685        IH2='    '
29686        ALOWLM=0.0
29687        AUPPLM=CPUMAX
29688        LOWLTY='>   '
29689        UPPLTY='<=  '
29690        CALL PARCHR(IH,IH2,IDIST,ANU3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29691     1              ISUBN1,ISUBN2,IERROR)
29692        IF(IERROR.EQ.'YES')GOTO9000
29693C
29694        IF(A.GE.B .OR. B.GE.DZ)THEN
29695          WRITE(ICOUT,7332)
29696          CALL DPWRST('XXX','BUG ')
29697          WRITE(ICOUT,7333)
29698          CALL DPWRST('XXX','BUG ')
29699          WRITE(ICOUT,7334)
29700          CALL DPWRST('XXX','BUG ')
29701          WRITE(ICOUT,7336)A,B,DZ
29702          CALL DPWRST('XXX','BUG ')
29703          GOTO9000
29704        ENDIF
29705 7332   FORMAT(
29706     1'***** ERROR--FOR THE UNEVEN TWO-SIDED POWER DISTRIBUTION,')
29707 7333   FORMAT(
29708     1'      THE THREE SHAPE PARAMETERS (A, B, D) MUST SATISFY')
29709 7334   FORMAT(
29710     1'         A < B < D')
29711 7336   FORMAT(
29712     1'      A, B, D = ',3G15.7)
29713C
29714      ENDIF
29715C
29716      GOTO9000
29717C
29718C     THE ONE AND TWO SHAPE PARAMETER CASES ARE THE MOST
29719C     COMMON.  HANDLE THOSE HERE.
29720C
29721C     ONE SHAPE PARAMETER CASE
29722C
29723 4100 CONTINUE
29724      CALL PARCHR(IH,IH2,IDIST,
29725     1            SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29726     1            ISUBN1,ISUBN2,IERROR)
29727      IF(ICASPL.EQ.'LOGN' .AND. IERROR.EQ.'YES')THEN
29728        SHAPE1=1.0
29729      ELSEIF(ICASPL.EQ.'SEMC' .AND. IERROR.EQ.'YES')THEN
29730        SHAPE2=1.0
29731      ENDIF
29732      GOTO9000
29733C
29734C     TWO SHAPE PARAMETER CASE
29735C
29736 4200 CONTINUE
29737      CALL PARCHR(IH,IH2,IDIST,
29738     1            SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29739     1            ISUBN1,ISUBN2,IERROR)
29740      IF(ICASPL.EQ.'CONS' .AND. ICONDF.EQ.'THET')AUPPL2=1.0/SHAPE1
29741      IF(ICASPL.EQ.'FNOR' .AND. IERROR.EQ.'YES')THEN
29742        SHAPE1=0.0
29743      ELSEIF(ICASPL.EQ.'TNOR' .AND. IERROR.EQ.'YES')THEN
29744        SHAPE1=0.0
29745      ELSEIF(ICASPL.EQ.'FCAU' .AND. IERROR.EQ.'YES')THEN
29746        SHAPE1=0.0
29747      ENDIF
29748      CALL PARCHR(IH21,IH22,IDIST,
29749     1            SHAPE2,ALOWL2,AUPPL2,LOWLT2,UPPLT2,
29750     1            ISUBN1,ISUBN2,IERROR)
29751      IF(ICASPL.EQ.'INGA' .AND. IERROR.EQ.'YES')THEN
29752        SHAPE2=1.0
29753      ELSEIF(ICASPL.EQ.'PLGN' .AND. IERROR.EQ.'YES')THEN
29754        SHAPE2=1.0
29755      ELSEIF(ICASPL.EQ.'PARE' .AND. IERROR.EQ.'YES')THEN
29756        SHAPE2=1.0
29757      ELSEIF(ICASPL.EQ.'PAR2' .AND. IERROR.EQ.'YES')THEN
29758        SHAPE2=1.0
29759      ELSEIF(ICASPL.EQ.'FNOR' .AND. IERROR.EQ.'YES')THEN
29760        SHAPE2=1.0
29761      ELSEIF(ICASPL.EQ.'TNOR' .AND. IERROR.EQ.'YES')THEN
29762        SHAPE2=1.0
29763      ELSEIF(ICASPL.EQ.'FCAU' .AND. IERROR.EQ.'YES')THEN
29764        SHAPE2=1.0
29765      ELSEIF(ICASPL.EQ.'GGAM' .AND. SHAPE2.EQ.0.0)THEN
29766        WRITE(ICOUT,999)
29767        CALL DPWRST('XXX','BUG ')
29768        WRITE(ICOUT,4221)
29769 4221   FORMAT('***** ERROR IN EXTPA1--')
29770        CALL DPWRST('XXX','BUG ')
29771        WRITE(ICOUT,4222)
29772 4222   FORMAT('      THE SPECIFIED SHAPE PARAMETER C FOR THE ',
29773     1         'GENERALIZED GAMMA')
29774        CALL DPWRST('XXX','BUG ')
29775        WRITE(ICOUT,4223)
29776 4223   FORMAT('      DISTRIBUTION CANNOT BE EQUAL TO 0;')
29777        CALL DPWRST('XXX','BUG ')
29778        WRITE(ICOUT,4225)
29779 4225   FORMAT('      SUCH WAS NOT THE CASE HERE.')
29780        CALL DPWRST('XXX','BUG ')
29781        WRITE(ICOUT,4226)C
29782 4226   FORMAT('      THE SPECIFIED VALUE OF C = ',G15.7)
29783        CALL DPWRST('XXX','BUG ')
29784        IERROR='YES'
29785        GOTO9000
29786      ELSEIF(ICASPL.EQ.'WARI')THEN
29787        IF(SHAPE1.LE.SHAPE2)THEN
29788          WRITE(ICOUT,999)
29789          CALL DPWRST('XXX','BUG ')
29790          WRITE(ICOUT,4231)
29791 4231     FORMAT('***** ERROR IN WARING DISTRIBUTION--')
29792          CALL DPWRST('XXX','BUG ')
29793          WRITE(ICOUT,4232)
29794 4232     FORMAT('      THE VALUE FOR THE SHAPE PARAMETER C IS ',
29795     1           'LESS THAN OR EQUAL TO')
29796          CALL DPWRST('XXX','BUG ')
29797          WRITE(ICOUT,4233)
29798 4233     FORMAT('      THE VALUE FOR THE SHAPE PARAMETER A.')
29799          CALL DPWRST('XXX','BUG ')
29800          WRITE(ICOUT,4235)SHAPE1
29801 4235     FORMAT('      THE SPECIFIED VALUE OF C = ',G15.7)
29802          CALL DPWRST('XXX','BUG ')
29803          WRITE(ICOUT,4236)SHAPE2
29804 4236     FORMAT('      THE SPECIFIED VALUE OF A = ',G15.7)
29805          CALL DPWRST('XXX','BUG ')
29806          IERROR='YES'
29807          GOTO9000
29808        ENDIF
29809      ENDIF
29810      GOTO9000
29811C
29812C     THREE SHAPE PARAMETER CASE
29813C
29814 4300 CONTINUE
29815      CALL PARCHR(IH,IH2,IDIST,
29816     1            SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29817     1            ISUBN1,ISUBN2,IERROR)
29818      CALL PARCHR(IH21,IH22,IDIST,
29819     1            SHAPE2,ALOWL2,AUPPL2,LOWLT2,UPPLT2,
29820     1            ISUBN1,ISUBN2,IERROR)
29821      IF(ICASPL.EQ.'TPAR' .AND. IERROR.EQ.'YES')THEN
29822        SHAPE2=1.0
29823      ELSEIF(ICASPL.EQ.'TEXP' .AND. IERROR.EQ.'YES')THEN
29824        SHAPE2=0.0
29825      ENDIF
29826      IF(ICASPL.EQ.'TPAR')ALOWL3=SHAPE2
29827      IF(ICASPL.EQ.'LKAT')ALOWL3=-SHAPE2
29828      CALL PARCHR(IH31,IH32,IDIST,
29829     1            SHAPE3,ALOWL3,AUPPL3,LOWLT3,UPPLT3,
29830     1            ISUBN1,ISUBN2,IERROR)
29831      IF(ICASPL.EQ.'TEXP' .AND. IERROR.EQ.'YES')THEN
29832        SHAPE3=1.0
29833      ENDIF
29834      GOTO9000
29835C
29836C     FOUR SHAPE PARAMETER CASE
29837C
29838 4400 CONTINUE
29839      CALL PARCHR(IH,IH2,IDIST,
29840     1            SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29841     1            ISUBN1,ISUBN2,IERROR)
29842      CALL PARCHR(IH21,IH22,IDIST,
29843     1            SHAPE2,ALOWL2,AUPPL2,LOWLT2,UPPLT2,
29844     1            ISUBN1,ISUBN2,IERROR)
29845      CALL PARCHR(IH31,IH32,IDIST,
29846     1            SHAPE3,ALOWL3,AUPPL3,LOWLT3,UPPLT3,
29847     1            ISUBN1,ISUBN2,IERROR)
29848      CALL PARCHR(IH41,IH42,IDIST,
29849     1            SHAPE4,ALOWL4,AUPPL4,LOWLT4,UPPLT4,
29850     1            ISUBN1,ISUBN2,IERROR)
29851C
29852      IF(ICASPL.EQ.'TRAP')THEN
29853        IF(SHAPE1.GE.SHAPE2 .OR. SHAPE2.GE.SHAPE3 .OR.
29854     1     SHAPE3.GE.SHAPE4)THEN
29855          WRITE(ICOUT,4412)
29856          CALL DPWRST('XXX','BUG ')
29857          WRITE(ICOUT,4413)
29858          CALL DPWRST('XXX','BUG ')
29859          WRITE(ICOUT,4414)
29860          CALL DPWRST('XXX','BUG ')
29861          WRITE(ICOUT,4416)SHAPE1,SHAPE2,SHAPE3,SHAPE4
29862          CALL DPWRST('XXX','BUG ')
29863          IERROR='YES'
29864          GOTO9000
29865        ENDIF
29866 4412   FORMAT(
29867     1'***** ERROR--FOR THE TRAPEZOID DISTRIBUTION, THE FOUR')
29868 4413   FORMAT(
29869     1'      SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
29870 4414   FORMAT(
29871     1'         A < B < C < D')
29872 4416   FORMAT(
29873     1'      A, B, C, D = ',4G15.7)
29874      ENDIF
29875C
29876      GOTO9000
29877C
29878C     FIVE SHAPE PARAMETER CASE
29879C
29880 4500 CONTINUE
29881      CALL PARCHR(IH,IH2,IDIST,
29882     1            SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29883     1            ISUBN1,ISUBN2,IERROR)
29884      CALL PARCHR(IH21,IH22,IDIST,
29885     1            SHAPE2,ALOWL2,AUPPL2,LOWLT2,UPPLT2,
29886     1            ISUBN1,ISUBN2,IERROR)
29887      CALL PARCHR(IH31,IH32,IDIST,
29888     1            SHAPE3,ALOWL3,AUPPL3,LOWLT3,UPPLT3,
29889     1            ISUBN1,ISUBN2,IERROR)
29890      CALL PARCHR(IH41,IH42,IDIST,
29891     1            SHAPE4,ALOWL4,AUPPL4,LOWLT4,UPPLT4,
29892     1            ISUBN1,ISUBN2,IERROR)
29893      CALL PARCHR(IH51,IH52,IDIST,
29894     1            SHAPE5,ALOWL5,AUPPL5,LOWLT5,UPPLT5,
29895     1            ISUBN1,ISUBN2,IERROR)
29896C
29897      GOTO9000
29898C
29899 4900 CONTINUE
29900      CALL PARCHR(IH,IH2,IDIST,
29901     1            SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29902     1            ISUBN1,ISUBN2,IERROR)
29903      CALL PARCHI(IH21,IH22,IDIST,ISHAPE,ILOWL2,IUPPL2,LOWLT2,UPPLT2,
29904     1            ISUBN1,ISUBN2,IERROR)
29905      SHAPE2=REAL(ISHAPE)
29906      GOTO9000
29907C
29908 5100 CONTINUE
29909      CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
29910     1            ISUBN1,ISUBN2,IERROR)
29911      SHAPE1=REAL(ISHAPE)
29912      GOTO9000
29913C
29914 5200 CONTINUE
29915      CALL PARCHI(IH,IH2,IDIST,ISHAPE,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
29916     1            ISUBN1,ISUBN2,IERROR)
29917      SHAPE1=REAL(ISHAPE)
29918      CALL PARCHI(IH21,IH22,IDIST,ISHAPE,ILOWL2,IUPPL2,LOWLT2,UPPLT2,
29919     1            ISUBN1,ISUBN2,IERROR)
29920      SHAPE2=REAL(ISHAPE)
29921      GOTO9000
29922C
29923C6999 CONTINUE
29924CCCCC CALL PARCHR(IH,IH2,IDIST,
29925CCCCC1            SHAPE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
29926CCCCC1            ISUBN1,ISUBN2,IERROR)
29927      GOTO9000
29928C
29929 9000 CONTINUE
29930      RETURN
29931      END
29932      SUBROUTINE EXTPA2(ICASPL,IDIST,A,B,
29933     1                  SHAP11,SHAP12,SHAP21,SHAP22,
29934     1                  SHAPE1,SHAPE2,SHAPE3,SHAPE4,SHAPE5,
29935     1                  IADEDF,IGEPDF,IMAKDF,IBEIDF,
29936     1                  ILGADF,ISKNDF,IGLDDF,IBGEDF,
29937     1                  IGETDF,ICONDF,IGOMDF,IKATDF,
29938     1                  IGIGDF,IGEODF,
29939     1                  ISUBRO,IBUGG2,IERROR)
29940C
29941C     WRITTEN BY--ALAN HECKERT
29942C                 STATISTICAL ENGINEERING DIVISION
29943C                 INFORMATION TECHNOLOGY LABORAOTRY
29944C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
29945C                 GAITHERSBURG, MD 20899-8980
29946C                 PHONE--301-975-2899
29947C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
29948C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
29949C     LANGUAGE--ANSI FORTRAN (1977)
29950C     VERSION NUMBER--2009/10
29951C     ORIGINAL VERSION--OCTOBER   2009.
29952C     UPDATED         --AUGUST    2010. BRITTLE FIBER WEIBULL
29953C
29954C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
29955C
29956      CHARACTER*30 IDIST
29957C
29958      CHARACTER*4 IADEDF
29959      CHARACTER*4 IGEPDF
29960      CHARACTER*4 IMAKDF
29961      CHARACTER*4 IBEIDF
29962      CHARACTER*4 ILGADF
29963      CHARACTER*4 ISKNDF
29964      CHARACTER*4 IGLDDF
29965      CHARACTER*4 IBGEDF
29966      CHARACTER*4 IGETDF
29967      CHARACTER*4 ICONDF
29968      CHARACTER*4 IGOMDF
29969      CHARACTER*4 IKATDF
29970      CHARACTER*4 IGIGDF
29971      CHARACTER*4 IGEODF
29972C
29973      CHARACTER*4 ICASPL
29974      CHARACTER*4 IBUGG2
29975      CHARACTER*4 ISUBRO
29976      CHARACTER*4 IERROR
29977C
29978      CHARACTER*4 ISUBN1
29979      CHARACTER*4 ISUBN2
29980      CHARACTER*4 ISTEPN
29981C
29982      CHARACTER*4 IHP11
29983      CHARACTER*4 IHP12
29984      CHARACTER*4 IHP21
29985      CHARACTER*4 IHP22
29986      CHARACTER*4 IHP31
29987      CHARACTER*4 IHP32
29988      CHARACTER*4 IHP41
29989      CHARACTER*4 IHP42
29990      CHARACTER*4 LOWLTY
29991      CHARACTER*4 UPPLTY
29992      CHARACTER*4 LOWLT2
29993      CHARACTER*4 UPPLT2
29994      CHARACTER*4 LOWLT4
29995      CHARACTER*4 UPPLT4
29996C
29997      INCLUDE 'DPCOMC.INC'
29998      INCLUDE 'DPCOPA.INC'
29999      INCLUDE 'DPCOHK.INC'
30000C
30001C---------------------------------------------------------------------
30002C
30003C-----COMMON VARIABLES (GENERAL)--------------------------------------
30004C
30005      INCLUDE 'DPCOP2.INC'
30006C
30007C               ***********************************************
30008C               **  STEP 1--                                 **
30009C               **  FOR THOSE DISTRIBUTIONS REQUIRING THEM,  **
30010C               **  DETERMINE IF THE ANALYST                 **
30011C               **  HAS SPECIFIED PARAMETER VALUES           **
30012C               ***********************************************
30013C
30014      ISUBN1='EXTP'
30015      ISUBN2='A2  '
30016C
30017      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TPA2')THEN
30018        ISTEPN='1'
30019        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
30020        WRITE(ICOUT,55)IDIST
30021   55   FORMAT('AT BEGINNING OF EXTPA2: IDIST = ',A30)
30022        CALL DPWRST('XXX','BUG ')
30023        WRITE(ICOUT,56)SHAPE1,SHAPE2,SHAPE3,SHAPE4,SHAPE5
30024   56   FORMAT('SHAPE1,SHAPE2,SHAPE3,SHAPE4,SHAPE5 = ',5G15.7)
30025        CALL DPWRST('XXX','BUG ')
30026        WRITE(ICOUT,57)ISKNDF,IBEIDF,IBGEDF,IGEODF,IGEPDF
30027   57   FORMAT('ISKNDF,IBEIDF,IBGEDF,IGEODF,IGEPDF = ',4(A4,2X),A4)
30028        CALL DPWRST('XXX','BUG ')
30029        WRITE(ICOUT,58)IGIGDF,IGLDDF,IKATDF,ILGADF
30030   58   FORMAT('IGIGDF,IGLDDF,IKATDF,ILGADF = ',3(A4,2X),A4)
30031        CALL DPWRST('XXX','BUG ')
30032      ENDIF
30033C
30034C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER GAMMA
30035C
30036      IF(ICASPL.EQ.'WEIB' .OR. ICASPL.EQ.'IWEI' .OR.
30037     1   ICASPL.EQ.'3WEI' .OR. ICASPL.EQ.'3IWE' .OR.
30038     1   ICASPL.EQ.'GAMM' .OR. ICASPL.EQ.'IGAM' .OR.
30039     1   ICASPL.EQ.'3GAM' .OR. ICASPL.EQ.'3IGA' .OR.
30040     1   ICASPL.EQ.'LGAM' .OR. ICASPL.EQ.'GPAR' .OR.
30041     1   ICASPL.EQ.'GEEX' .OR. ICASPL.EQ.'FATL' .OR.
30042     1   ICASPL.EQ.'WALD' .OR. ICASPL.EQ.'EV2 ' .OR.
30043     1   ICASPL.EQ.'3EV2' .OR.
30044     1   ICASPL.EQ.'DWEI' .OR. ICASPL.EQ.'GEV ' .OR.
30045     1   ICASPL.EQ.'GHLO' .OR. ICASPL.EQ.'DGAM' .OR.
30046     1   ICASPL.EQ.'PEA3' .OR. ICASPL.EQ.'BFWE' .OR.
30047     1   ICASPL.EQ.'PARE' .OR. ICASPL.EQ.'PAR2'
30048     1 )THEN
30049C
30050        IHP11='GAMM'
30051        IHP12='A1  '
30052        IHP21='GAMM'
30053        IHP22='A2  '
30054        LOWLTY='>   '
30055        UPPLTY='<=  '
30056        ALOWLM=0.
30057        AUPPLM=CPUMAX
30058        ADEF1=1.0
30059        ADEF2=50.0
30060C
30061        IF(ICASPL.EQ.'WEIB')THEN
30062          IDIST='WEIBULL'
30063        ELSEIF(ICASPL.EQ.'3WEI')THEN
30064          IDIST='3-PARAMETER WEIBULL'
30065        ELSEIF(ICASPL.EQ.'GAMM')THEN
30066          IDIST='GAMMA'
30067          ADEF1=0.5
30068          ADEF2=25.0
30069        ELSEIF(ICASPL.EQ.'3GAM')THEN
30070          IDIST='3-PARAMETER GAMMA'
30071          ADEF1=0.5
30072          ADEF2=25.0
30073        ELSEIF(ICASPL.EQ.'IGAM')THEN
30074          IDIST='INVERTED GAMMA'
30075          ADEF1=0.5
30076          ADEF2=25.0
30077        ELSEIF(ICASPL.EQ.'3IGA')THEN
30078          IDIST='3-PARAMETER INVERTED GAMMA'
30079          ADEF1=0.5
30080          ADEF2=25.0
30081        ELSEIF(ICASPL.EQ.'LGAM')THEN
30082          IDIST='LOG GAMMA'
30083          ADEF1=0.5
30084          ADEF2=25.0
30085        ELSEIF(ICASPL.EQ.'IWEI')THEN
30086          IDIST='INVERTED WEIBULL'
30087          ADEF1=0.5
30088          ADEF2=10.0
30089        ELSEIF(ICASPL.EQ.'3IWE')THEN
30090          IDIST='3-PARAMETER INVERTED WEIBULL'
30091          ADEF1=0.5
30092          ADEF2=10.0
30093        ELSEIF(ICASPL.EQ.'GPAR')THEN
30094          IDIST='GENERALIZED PARETO'
30095          ALOWLM=CPUMIN
30096          ADEF1=-3.0
30097          ADEF2=3.0
30098        ELSEIF(ICASPL.EQ.'GEEX')THEN
30099          IDIST='GEOMETRIC EXTREME EXPONENTIAL'
30100          ADEF1=0.1
30101          ADEF2=10.0
30102        ELSEIF(ICASPL.EQ.'FATL')THEN
30103          IDIST='FATIGUE LIFE'
30104        ELSEIF(ICASPL.EQ.'WALD')THEN
30105          IDIST='WALD'
30106          ADEF1=0.5
30107          ADEF2=25.0
30108        ELSEIF(ICASPL.EQ.'EV2 ')THEN
30109          IDIST='FRECHET'
30110          ADEF1=-25.0
30111          ADEF2=25.0
30112        ELSEIF(ICASPL.EQ.'3EV2')THEN
30113          IDIST='3-PARAMETER FRECHET'
30114          ADEF1=0.1
30115          ADEF2=25.0
30116        ELSEIF(ICASPL.EQ.'PARE' .OR. ICASPL.EQ.'PAR2')THEN
30117          ADEF1=0.2
30118          ADEF2=5.0
30119          IDIST='PARETO'
30120          IF(ICASPL.EQ.'PAR2')IDIST='PARETO SECOND KIND'
30121C
30122C         FOR PARETO, SET VALUE FOR A
30123C
30124          IHP31='A   '
30125          IHP32='    '
30126          ALOWLM=0.0
30127          AUPPLM=CPUMAX
30128          LOWLTY='>   '
30129          UPPLTY='<=  '
30130          ADEF3=1.0
30131          CALL PARCH2(IHP31,IHP32,IDIST,SHAPE2,ADEF3,ALOWLM,AUPPLM,
30132     1              LOWLTY,UPPLTY,
30133     1              ISUBN1,ISUBN2,IERROR)
30134          IF(SHAPE2.LE.0.0)SHAPE2=1.0
30135C
30136        ELSEIF(ICASPL.EQ.'BFWE')THEN
30137          IDIST='BRITTLE FIBER WEIBULL'
30138C
30139C         FOR BRITTLE FIBER WEIBULL, SET VALUE FOR L
30140C
30141          IHP31='L   '
30142          IHP32='    '
30143          ALOWLM=0.0
30144          AUPPLM=CPUMAX
30145          LOWLTY='>   '
30146          UPPLTY='<=  '
30147          ADEF3=1.0
30148          CALL PARCH2(IHP31,IHP32,IDIST,SHAPE2,ADEF3,ALOWLM,AUPPLM,
30149     1              LOWLTY,UPPLTY,
30150     1              ISUBN1,ISUBN2,IERROR)
30151          IF(SHAPE2.LE.0.0)SHAPE2=ADEF3
30152        ELSEIF(ICASPL.EQ.'DWEI')THEN
30153          IDIST='DOUBLE WEIBULL'
30154          ADEF1=0.5
30155          ADEF2=10.0
30156        ELSEIF(ICASPL.EQ.'DGAM')THEN
30157          IDIST='DOUBLE GAMMA'
30158          ADEF1=0.5
30159          ADEF2=10.0
30160        ELSEIF(ICASPL.EQ.'GEV ')THEN
30161          IDIST='GENERALIZED EXTREME VALUE'
30162          ALOWLM=CPUMIN
30163          ADEF1=-5.0
30164          ADEF2=5.0
30165        ELSEIF(ICASPL.EQ.'GHLO')THEN
30166          IDIST='GENERALIZED HALF LOGISTIC'
30167          AUPPLM=5.0
30168          ADEF1=0.1
30169          ADEF2=2.5
30170        ELSEIF(ICASPL.EQ.'PEA3')THEN
30171          IDIST='PEARSON TYPE 3'
30172          ALOWLM=CPUMIN
30173          AUPPLM=CPUMAX
30174          ADEF1=-10.0
30175          ADEF2=10.0
30176        ENDIF
30177        GOTO4100
30178C
30179C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER SIGMA
30180C
30181      ELSEIF(ICASPL.EQ.'LOGN' .OR. ICASPL.EQ.'3LGN')THEN
30182        IDIST='LOGNORMAL'
30183        IHP11='SIGM'
30184        IHP12='A1  '
30185        IHP21='SIGM'
30186        IHP22='A2  '
30187        ALOWLM=0.
30188        AUPPLM=CPUMAX
30189        LOWLTY='>   '
30190        UPPLTY='<=  '
30191        ADEF1=0.5
30192        ADEF2=25.0
30193        GOTO4100
30194C
30195C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER LAMBDA
30196C
30197      ELSEIF(ICASPL.EQ.'TULA' .OR. ICASPL.EQ.'SDEX' .OR.
30198     1       ICASPL.EQ.'SNOR' .OR. ICASPL.EQ.'POIS' .OR.
30199     1       ICASPL.EQ.'BTAN')THEN
30200C
30201        IHP11='LAMB'
30202        IHP12='DA1 '
30203        IHP21='LAMB'
30204        IHP22='DA2 '
30205        ALOWLM=CPUMIN
30206        AUPPLM=CPUMAX
30207        LOWLTY='>=  '
30208        UPPLTY='<=  '
30209        IF(ICASPL.EQ.'TULA')THEN
30210          IDIST='TUKEY-LAMBDA'
30211          ADEF1=-2.0
30212          ADEF2=2.0
30213        ELSEIF(ICASPL.EQ.'SDEX')THEN
30214          IDIST='SKEW DOUBLE EXPONENTIAL'
30215          ADEF1=0.0
30216          ADEF2=10.0
30217        ELSEIF(ICASPL.EQ.'SNOR')THEN
30218          IDIST='SKEW NORMAL'
30219          ADEF1=-5.0
30220          ADEF2=5.0
30221        ELSEIF(ICASPL.EQ.'POIS')THEN
30222          IDIST='POISSON'
30223          ADEF1=1.0
30224          ADEF2=50.0
30225        ELSEIF(ICASPL.EQ.'BTAN')THEN
30226          IDIST='BOREL-TANNER'
30227          IHP21='K   '
30228          IHP22='    '
30229          ILOWL2=1
30230          IUPPL2=I1MACH(9)
30231          LOWLT2='>=  '
30232          UPPLT2='<=  '
30233          CALL PARCHI(IHP21,IHP22,IDIST,K,ILOWL2,IUPPL2,
30234     1                LOWLT2,UPPLT2,
30235     1                ISUBN1,ISUBN2,IERROR)
30236          IF(IERROR.EQ.'YES')GOTO9000
30237          SHAPE2=REAL(K)
30238          ALOWLM=0.0
30239          AUPPLM=1.0
30240          LOWLTY='>   '
30241          UPPLTY='<   '
30242          ADEF1=0.2
30243          ADEF2=0.95
30244        ENDIF
30245        GOTO4100
30246C
30247C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER NU
30248C
30249      ELSEIF(ICASPL.EQ.'TPP' .OR. ICASPL.EQ.'CHIS' .OR.
30250     1       ICASPL.EQ.'CHI ' .OR. ICASPL.EQ.'FT  ')THEN
30251C
30252        IHP11='NU1 '
30253        IHP12='    '
30254        IHP21='NU2 '
30255        IHP22='    '
30256        ALOWLM=1.
30257        AUPPLM=CPUMAX
30258        LOWLTY='>=  '
30259        UPPLTY='<=  '
30260        ADEF1=1.0
30261        ADEF2=50.0
30262        IF(ICASPL.EQ.'TPP')IDIST='T'
30263        IF(ICASPL.EQ.'CHIS')IDIST='CHI-SQUARE'
30264        IF(ICASPL.EQ.'CHI ')IDIST='CHI'
30265        IF(ICASPL.EQ.'FT  ')IDIST='FOLDED T'
30266        GOTO4100
30267C
30268C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER BETA
30269C
30270      ELSEIF(ICASPL.EQ.'BRAD' .OR. ICASPL.EQ.'TOPL' .OR.
30271     1       ICASPL.EQ.'PEXP' .OR. ICASPL.EQ.'MUTH' .OR.
30272     1       ICASPL.EQ.'LEXP')THEN
30273        IHP11='BETA'
30274        IHP12='1   '
30275        IHP21='BETA'
30276        IHP22='2   '
30277        ALOWLM=0.
30278        AUPPLM=CPUMAX
30279        LOWLTY='>   '
30280        UPPLTY='<=  '
30281        ADEF1=0.1
30282        ADEF2=10.0
30283        IF(ICASPL.EQ.'BRAD')THEN
30284          IDIST='BRADFORD'
30285          ADEF1=0.5
30286          ADEF2=25.0
30287        ELSEIF(ICASPL.EQ.'TOPL')THEN
30288          IDIST='TOPP AND LEONE'
30289        ELSEIF(ICASPL.EQ.'PEXP')THEN
30290          IDIST='EXPONENTIAL POWER'
30291          ADEF1=0.5
30292          ADEF2=10.0
30293        ELSEIF(ICASPL.EQ.'MUTH')THEN
30294          IDIST='MUTH'
30295          ADEF1=0.0
30296          ADEF2=1.0
30297          AUPPLM=1.0
30298          LOWLTY='>=  '
30299        ELSEIF(ICASPL.EQ.'LEXP')THEN
30300          IDIST='LOGISTIC-EXPONENTIAL'
30301        ENDIF
30302        GOTO4100
30303C
30304C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER B
30305C
30306      ELSEIF(ICASPL.EQ.'RECI' .OR. ICASPL.EQ.'VONM')THEN
30307        IHP11='B1  '
30308        IHP12='    '
30309        IHP21='B2  '
30310        IHP22='    '
30311        ALOWLM=1.0
30312        AUPPLM=CPUMAX
30313        LOWLTY='>   '
30314        UPPLTY='<=  '
30315        ADEF1=1.5
30316        ADEF2=20.0
30317        IF(ICASPL.EQ.'RECI')THEN
30318          IDIST='RECIPROCAL'
30319        ELSEIF(ICASPL.EQ.'VONM')THEN
30320          IDIST='VON MISES'
30321          ALOWLM=0.0
30322          LOWLTY='>=  '
30323          ADEF1=0.5
30324          ADEF2=25.0
30325        ENDIF
30326        GOTO4100
30327C
30328C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER ALPHA
30329C
30330      ELSEIF(ICASPL.EQ.'ERRO' .OR. ICASPL.EQ.'LLAP' .OR.
30331     1       ICASPL.EQ.'GLOG' .OR. ICASPL.EQ.'G2LO' .OR.
30332     1       ICASPL.EQ.'G3LO' .OR. ICASPL.EQ.'G5LO' .OR.
30333     1       ICASPL.EQ.'SLOP' .OR. ICASPL.EQ.'ALPH' .OR.
30334     1       ICASPL.EQ.'MCLE' .OR. ICASPL.EQ.'LDEX' .OR.
30335     1       ICASPL.EQ.'ZETA' .OR. ICASPL.EQ.'ZIPF')THEN
30336        IHP11='ALPH'
30337        IHP12='A1  '
30338        IHP21='ALPH'
30339        IHP22='A2  '
30340        ALOWLM=0.0
30341        AUPPLM=CPUMAX
30342        LOWLTY='>   '
30343        UPPLTY='<=  '
30344        ADEF1=0.1
30345        ADEF2=10.0
30346        IF(ICASPL.EQ.'ERRO')THEN
30347          IDIST='ERROR'
30348          ALOWLM=1.
30349          ADEF1=1.1
30350          ADEF2=5.0
30351        ELSEIF(ICASPL.EQ.'LLAP' .OR. ICASPL.EQ.'LDEX')THEN
30352          IDIST='LOG LAPLACE'
30353          ADEF1=0.5
30354          ADEF2=10.0
30355        ELSEIF(ICASPL.EQ.'GLOG')THEN
30356          IDIST='GENERALIZED LOGISTIC'
30357          ALOWLM=0.1
30358          ADEF1=0.2
30359          ADEF2=5.0
30360        ELSEIF(ICASPL.EQ.'G2LO')THEN
30361          IDIST='GENERALIZED LOGISTIC TYPE 2'
30362        ELSEIF(ICASPL.EQ.'G3LO')THEN
30363          IDIST='GENERALIZED LOGISTIC TYPE 3'
30364        ELSEIF(ICASPL.EQ.'G5LO')THEN
30365          IDIST='GENERALIZED LOGISTIC TYPE 5'
30366          ALOWLM=CPUMIN
30367          ADEF1=-2.0
30368          ADEF2=2.0
30369        ELSEIF(ICASPL.EQ.'SLOP')THEN
30370          IDIST='SLOPE'
30371          LOWLTY='>=  '
30372          AUPPLM=2.0
30373          ADEF1=0.1
30374          ADEF2=1.99
30375        ELSEIF(ICASPL.EQ.'ALPH')THEN
30376          IDIST='ALPHA'
30377          ADEF1=0.5
30378          ADEF2=10.0
30379        ELSEIF(ICASPL.EQ.'MCLE')THEN
30380          IDIST='MCLEISH'
30381          ADEF1=1.0
30382          ADEF2=15.5
30383        ELSEIF(ICASPL.EQ.'ZETA')THEN
30384          IDIST='ZETA'
30385          ALOWLM=1.0
30386          AUPPLM=CPUMAX
30387          ADEF1=1.5
30388          ADEF2=5.0
30389        ELSEIF(ICASPL.EQ.'ZIPF')THEN
30390          IDIST='ZIPF'
30391          IHP21='N   '
30392          IHP22='    '
30393          ILOWL2=1
30394          IUPPL2=I1MACH(9)
30395          LOWLT2='>=  '
30396          UPPLT2='<=  '
30397          CALL PARCHI(IHP21,IHP22,IDIST,NU,ILOWL2,IUPPL2,LOWLT2,UPPLT2,
30398     1                ISUBN1,ISUBN2,IERROR)
30399          SHAPE2=REAL(NU)
30400          IF(IERROR.EQ.'YES')GOTO9000
30401        ENDIF
30402        GOTO4100
30403C
30404C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER C
30405C
30406      ELSEIF(ICASPL.EQ.'TRIA' .OR. ICASPL.EQ.'POWF'.OR.
30407     1       ICASPL.EQ.'RFPP')THEN
30408        IHP11='C1  '
30409        IHP12='    '
30410        IHP21='C2  '
30411        IHP22='    '
30412        ALOWLM=0.0
30413        AUPPLM=CPUMAX
30414        LOWLTY='>   '
30415        UPPLTY='<=  '
30416        ADEF1=0.5
30417        ADEF2=25.0
30418        IF(ICASPL.EQ.'TRIA')THEN
30419          IDIST='TRIANGULAR'
30420          ALOWLM=CPUMIN
30421          AUPPLM=CPUMAX
30422          LOWLTY='>=  '
30423          UPPLTY='<=  '
30424          ADEF1=A
30425          ADEF2=B
30426        ELSEIF(ICASPL.EQ.'POWF')THEN
30427          IDIST='POWER'
30428        ELSEIF(ICASPL.EQ.'RPOW')THEN
30429          IDIST='REFLECTED POWER'
30430        ENDIF
30431        GOTO4100
30432C
30433C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER P
30434C
30435      ELSEIF(ICASPL.EQ.'POWN' .OR. ICASPL.EQ.'WCAU' .OR.
30436     1       ICASPL.EQ.'GEOM' .OR. ICASPL.EQ.'BINO' .OR.
30437     1       ICASPL.EQ.'YULE' .OR. ICASPL.EQ.'LOST')THEN
30438        IHP11='P1  '
30439        IHP12='    '
30440        IHP21='P2  '
30441        IHP22='    '
30442        ALOWLM=0.
30443        AUPPLM=CPUMAX
30444        LOWLTY='>   '
30445        UPPLTY='<=  '
30446        IF(ICASPL.EQ.'POWN')THEN
30447          IDIST='POWER NORMAL'
30448          ADEF1=1.0
30449          ADEF2=50.0
30450        ELSEIF(ICASPL.EQ.'WCAU')THEN
30451          IDIST='WRAPPED CAUCHY'
30452          AUPPLM=1.0
30453          ADEF1=0.0
30454          ADEF2=0.99
30455          LOWLTY='>=  '
30456          UPPLTY='<   '
30457        ELSEIF(ICASPL.EQ.'GEOM')THEN
30458          IDIST='GEOMETRIC'
30459          ALOWLM=0.0
30460          AUPPLM=1.0
30461          LOWLTY='>   '
30462          UPPLTY='<   '
30463          ADEF1=0.01
30464          ADEF2=0.99
30465        ELSEIF(ICASPL.EQ.'YULE')THEN
30466          IDIST='YULE'
30467          ALOWLM=0.3
30468          AUPPLM=CPUMAX
30469          LOWLTY='>   '
30470          UPPLTY='<   '
30471          ADEF1=0.5
30472          ADEF2=5.0
30473        ELSEIF(ICASPL.EQ.'BINO')THEN
30474          IDIST='BINOMIAL'
30475          ALOWLM=0.0
30476          AUPPLM=1.0
30477          LOWLTY='>   '
30478          UPPLTY='<   '
30479          ADEF1=0.01
30480          ADEF2=0.99
30481          IHP21='N   '
30482          IHP22='    '
30483          ILOWLM=1
30484          IUPPLM=I1MACH(9)
30485          LOWLT2='>=  '
30486          UPPLT2='<=  '
30487          CALL PARCHI(IHP21,IHP22,IDIST,NBINOM,ILOWLM,IUPPLM,
30488     1                LOWLT2,UPPLT2,
30489     1                ISUBN1,ISUBN2,IERROR)
30490          SHAPE2=REAL(NBINOM)
30491          IF(IERROR.EQ.'YES')GOTO9000
30492        ELSEIF(ICASPL.EQ.'LOST')THEN
30493          IDIST='LOST GAMES'
30494          ALOWLM=0.5
30495          AUPPLM=1.0
30496          LOWLTY='>   '
30497          UPPLTY='<   '
30498          ADEF1=0.51
30499          ADEF2=0.95
30500          IHP21='R   '
30501          IHP22='    '
30502          ILOWLM=1
30503          IUPPLM=I1MACH(9)
30504          LOWLT2='>=  '
30505          UPPLT2='<=  '
30506          CALL PARCHI(IHP21,IHP22,IDIST,IR,ILOWLM,IUPPLM,
30507     1                LOWLT2,UPPLT2,
30508     1                ISUBN1,ISUBN2,IERROR)
30509          SHAPE2=REAL(IR)
30510          IF(IERROR.EQ.'YES')GOTO9000
30511        ENDIF
30512        GOTO4100
30513C
30514C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER DELTA
30515C
30516      ELSEIF(ICASPL.EQ.'LOGL')THEN
30517        IDIST='LOG-LOGISTIC'
30518        IHP11='DELT'
30519        IHP12='A1  '
30520        IHP21='DELT'
30521        IHP22='A2  '
30522        ALOWLM=0.
30523        AUPPLM=CPUMAX
30524        LOWLTY='>   '
30525        UPPLTY='<=  '
30526        ADEF1=0.2
30527        ADEF2=25.0
30528        GOTO4100
30529C
30530C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER K
30531C
30532      ELSEIF(ICASPL.EQ.'ADEX' .AND. IADEDF.EQ.'K')THEN
30533        IDIST='ASYMMETRIC LAPLACE'
30534        IHP11='K1  '
30535        IHP12='    '
30536        IHP21='K2  '
30537        IHP22='    '
30538        ALOWLM=0.0
30539        AUPPLM=CPUMAX
30540        LOWLTY='>   '
30541        UPPLTY='<   '
30542        ADEF1=0.2
30543        ADEF2=10.0
30544        GOTO4100
30545C
30546C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER MU
30547C
30548      ELSEIF(ICASPL.EQ.'ADEX' .AND. IADEDF.EQ.'MU')THEN
30549        IHP11='MU1 '
30550        IHP12='    '
30551        IHP21='MU2 '
30552        IHP22='    '
30553        ALOWLM=CPUMIN
30554        AUPPLM=CPUMAX
30555        LOWLTY='>   '
30556        UPPLTY='<   '
30557        ADEF1=-5.0
30558        ADEF2=5.0
30559        GOTO4100
30560C
30561C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER N
30562C
30563      ELSEIF(ICASPL.EQ.'OGIV')THEN
30564        IDIST='OGIVE'
30565        IHP11='N1  '
30566        IHP12='    '
30567        IHP21='N2  '
30568        IHP22='    '
30569        ALOWLM=0.5
30570        AUPPLM=CPUMAX
30571        LOWLTY='>   '
30572        UPPLTY='<=  '
30573        ADEF1=0.51
30574        ADEF2=10.0
30575        GOTO4100
30576C
30577C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER R
30578C
30579      ELSEIF(ICASPL.EQ.'BUR2' .OR. ICASPL.EQ.'BUR7' .OR.
30580     1       ICASPL.EQ.'BUR8' .OR. ICASPL.EQ.'BU10' .OR.
30581     1       ICASPL.EQ.'BU11')THEN
30582        IHP11='R1  '
30583        IHP12='    '
30584        IHP21='R2  '
30585        IHP22='    '
30586        ALOWLM=0.
30587        AUPPLM=CPUMAX
30588        LOWLTY='>   '
30589        UPPLTY='<=  '
30590        ADEF1=0.5
30591        ADEF2=10.0
30592        IDIST='BURR TYPE 2'
30593        IF(ICASPL.EQ.'BUR7')IDIST='BURR TYPE 7'
30594        IF(ICASPL.EQ.'BUR8')IDIST='BURR TYPE 8'
30595        IF(ICASPL.EQ.'BU10')IDIST='BURR TYPE 10'
30596        IF(ICASPL.EQ.'BU11')IDIST='BURR TYPE 11'
30597        GOTO4100
30598C
30599C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER THETA
30600C
30601      ELSEIF(ICASPL.EQ.'LOGS')THEN
30602        IHP11='THET'
30603        IHP12='A1  '
30604        IHP21='THET'
30605        IHP22='A2  '
30606        ALOWLM=0.
30607        AUPPLM=1.0
30608        LOWLTY='>   '
30609        UPPLTY='<   '
30610        ADEF1=0.05
30611        ADEF2=0.95
30612        IDIST='LOGARITHMIC SERIES'
30613        GOTO4100
30614C
30615C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER G
30616C
30617      ELSEIF(ICASPL.EQ.'GPP')THEN
30618        IHP11='G1  '
30619        IHP12='    '
30620        IHP21='G2  '
30621        IHP22='    '
30622        ALOWLM=-1.0
30623        AUPPLM=1.0
30624        LOWLTY='>=  '
30625        UPPLTY='<=  '
30626        ADEF1=-1.0
30627        ADEF2=1.0
30628        IDIST='G'
30629        GOTO4100
30630C
30631C     DISTRIBUTIONS WITH SINGLE SHAPE PARAMETER H
30632C
30633      ELSEIF(ICASPL.EQ.'HPP')THEN
30634        IHP11='H1  '
30635        IHP12='    '
30636        IHP21='H2  '
30637        IHP22='    '
30638        ALOWLM=0.0
30639        AUPPLM=1.0
30640        LOWLTY='>   '
30641        UPPLTY='<   '
30642        ADEF1=0.0
30643        ADEF2=1.0
30644        IDIST='H'
30645        GOTO4100
30646C
30647C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS G AND H
30648C
30649      ELSEIF(ICASPL.EQ.'GHPP')THEN
30650        IHP11='G1  '
30651        IHP12='    '
30652        IHP21='G2  '
30653        IHP22='    '
30654        ALOWLM=CPUMIN
30655        AUPPLM=CPUMAX
30656        LOWLTY='>=  '
30657        UPPLTY='<=  '
30658        ADEF1=-1.0
30659        ADEF2=1.0
30660        IHP31='H1  '
30661        IHP32='    '
30662        IHP41='H2  '
30663        IHP42='    '
30664        ALOWL2=0.0
30665        AUPPL2=CPUMAX
30666        LOWLT2='>=  '
30667        UPPLT2='<=  '
30668        ADEF3=0.0
30669        ADEF4=1.0
30670        IDIST='G-H'
30671        GOTO4200
30672C
30673C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS LAMBDA3 AND LAMBDA4
30674C
30675      ELSEIF(ICASPL.EQ.'GTLA')THEN
30676        IHP11='LAMB'
30677        IHP12='DA31'
30678        IHP21='LAMB'
30679        IHP22='DA32'
30680        IHP31='LAMB'
30681        IHP32='DA41'
30682        IHP41='LAMB'
30683        IHP42='DA42'
30684        ALOWLM=CPUMIN
30685        AUPPLM=CPUMAX
30686        LOWLTY='>=  '
30687        UPPLTY='<=  '
30688        ADEF1=-5.0
30689        ADEF2=5.0
30690        ALOWL2=CPUMIN
30691        AUPPL2=CPUMAX
30692        LOWLT2='>=  '
30693        UPPLT2='<=  '
30694        ADEF3=-5.0
30695        ADEF4=5.0
30696        IDIST='GENERALIZED TUKEY-LAMBDA'
30697        GOTO4200
30698C
30699C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS NU1 AND NU2
30700C
30701      ELSEIF(ICASPL.EQ.'FPP')THEN
30702        IHP11='NU11'
30703        IHP12='    '
30704        IHP21='NU12'
30705        IHP22='    '
30706        IHP31='NU21'
30707        IHP32='    '
30708        IHP41='NU22'
30709        IHP42='    '
30710        ALOWLM=1.0
30711        AUPPLM=REAL(I1MACH(9))
30712        LOWLTY='>=  '
30713        UPPLTY='<=  '
30714        ADEF1=1.0
30715        ADEF2=25.0
30716        ALOWL2=1.0
30717        AUPPL2=REAL(I1MACH(9))
30718        LOWLT2='>=  '
30719        UPPLT2='<=  '
30720        ADEF3=1.0
30721        ADEF4=25.0
30722        IDIST='F '
30723        GOTO4200
30724C
30725C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS GAMMA AND MU
30726C
30727      ELSEIF(ICASPL.EQ.'INGA' .OR. ICASPL.EQ.'RIGA')THEN
30728        IHP11='GAMM'
30729        IHP12='A1  '
30730        IHP21='GAMM'
30731        IHP22='A2  '
30732        ALOWLM=0.
30733        AUPPLM=CPUMAX
30734        LOWLTY='>   '
30735        UPPLTY='<=  '
30736        ADEF1=0.5
30737        ADEF2=25.0
30738        IHP31='MU1 '
30739        IHP32='    '
30740        IHP41='MU2 '
30741        IHP42='    '
30742        ALOWL2=0.
30743        AUPPL2=CPUMAX
30744        LOWLT2='>   '
30745        UPPLT2='<=  '
30746        ADEF3=0.5
30747        ADEF4=25.0
30748        IDIST='INVERSE GAUSSIAN'
30749        IF(ICASPL.EQ.'RIGA')IDIST='RECIPROCAL INVERSE GAUSSIAN'
30750        GOTO4200
30751C
30752C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS GAMMA AND THETA
30753C
30754      ELSEIF(ICASPL.EQ.'EWEI')THEN
30755        IHP11='GAMM'
30756        IHP12='A1  '
30757        IHP21='GAMM'
30758        IHP22='A2  '
30759        ALOWLM=0.
30760        AUPPLM=CPUMAX
30761        LOWLTY='>   '
30762        UPPLTY='<=  '
30763        ADEF1=0.5
30764        ADEF2=5.0
30765        IHP31='THET'
30766        IHP32='A1  '
30767        IHP41='THET'
30768        IHP42='A2  '
30769        ALOWL2=0.
30770        AUPPL2=CPUMAX
30771        LOWLT2='>   '
30772        UPPLT2='<=  '
30773        ADEF3=0.5
30774        ADEF4=5.0
30775        IDIST='EXPONENTIATED WEIBULL'
30776        GOTO4200
30777C
30778C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS ALPHA AND BETA
30779C
30780      ELSEIF(ICASPL.EQ.'BETA' .OR. ICASPL.EQ.'IBET' .OR.
30781     1       ICASPL.EQ.'BNOR' .OR. ICASPL.EQ.'KUMA' .OR.
30782     1       ICASPL.EQ.'KATZ' .OR.
30783     1       ICASPL.EQ.'RGTL' .OR. ICASPL.EQ.'GTOL' .OR.
30784     1       ICASPL.EQ.'BBIN' .OR. ICASPL.EQ.'BGEO')THEN
30785C
30786        IHP11='ALPH'
30787        IHP12='A1  '
30788        IHP21='ALPH'
30789        IHP22='A2  '
30790        ALOWLM=0.0
30791        AUPPLM=CPUMAX
30792        LOWLTY='>   '
30793        UPPLTY='<=  '
30794        ADEF1=0.5
30795        ADEF2=5.0
30796        IHP31='BETA'
30797        IHP32='1   '
30798        IHP41='BETA'
30799        IHP42='2   '
30800        ALOWL2=0.0
30801        AUPPL2=CPUMAX
30802        LOWLT2='>   '
30803        UPPLT2='<=  '
30804        ADEF3=0.5
30805        ADEF4=5.0
30806        IDIST='BETA'
30807        IF(ICASPL.EQ.'IBET')IDIST='INVERTED BETA'
30808        IF(ICASPL.EQ.'BNOR')IDIST='BETA NORMAL'
30809        IF(ICASPL.EQ.'KUMA')IDIST='KUMARASWAMY'
30810        IF(ICASPL.EQ.'RGTL')THEN
30811          IDIST='REFLECTED GENE TOPP LEONE'
30812          ALOWLM=0.0
30813          AUPPLM=2.0
30814          ADEF1=0.1
30815          ADEF2=2.0
30816          ADEF3=0.5
30817          ADEF4=10.0
30818        ELSEIF(ICASPL.EQ.'GTOL')THEN
30819          IDIST='GENERALIZED TOPP LEONE'
30820          ALOWLM=0.0
30821          AUPPLM=2.0
30822          ADEF1=0.1
30823          ADEF2=2.0
30824          ADEF3=0.5
30825          ADEF4=10.0
30826        ELSEIF(ICASPL.EQ.'KATZ')THEN
30827          IDIST='KATZ'
30828          ADEF1=0.1
30829          ADEF2=10.0
30830          ALOWL2=CPUMIN
30831          AUPPL2=1.0
30832          LOWLT2='>   '
30833          UPPLT2='<   '
30834          ADEF3=-3.0
30835          ADEF4=0.95
30836        ELSEIF(ICASPL.EQ.'BBIN')THEN
30837          IDIST='BETA-BINOMIAL'
30838          IHP31='N   '
30839          IHP32='    '
30840          ILOWLM=1
30841          IUPPLM=I1MACH(9)
30842          LOWLTY='>=  '
30843          UPPLTY='<=  '
30844          CALL PARCHI(IHP31,IHP32,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
30845     1                ISUBN1,ISUBN2,IERROR)
30846          SHAPE3=REAL(NU)
30847          IF(IERROR.EQ.'YES')GOTO9000
30848C
30849        ELSEIF(ICASPL.EQ.'BGEOM')THEN
30850          IDIST='BETA-GEOMETRIC'
30851        ENDIF
30852        GOTO4200
30853C
30854C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS ALPHA AND C
30855C
30856      ELSEIF(ICASPL.EQ.'GGAM')THEN
30857        IHP11='ALPH'
30858        IHP12='A1  '
30859        IHP21='ALPH'
30860        IHP22='A2  '
30861        ALOWLM=0.
30862        AUPPLM=CPUMAX
30863        LOWLTY='>   '
30864        UPPLTY='<=  '
30865        ADEF1=0.5
30866        ADEF2=5.0
30867        IHP31='C1  '
30868        IHP32='    '
30869        IHP41='C2  '
30870        IHP42='    '
30871        ALOWL2=CPUMIN
30872        AUPPL2=CPUMAX
30873        LOWLT2='>   '
30874        UPPLT2='<=  '
30875        ADEF3=0.1
30876        ADEF4=3.0
30877        IDIST='GENERALIZED GAMMA'
30878        GOTO4200
30879C
30880C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS MU AND SD
30881C
30882      ELSEIF(ICASPL.EQ.'FNOR' .OR. ICASPL.EQ.'FCAU' .OR.
30883     1       ICASPL.EQ.'TNOR')THEN
30884        IHP11='MU1 '
30885        IHP12='    '
30886        IHP21='MU2 '
30887        IHP22='    '
30888        ALOWLM=CPUMIN
30889        AUPPLM=CPUMAX
30890        LOWLTY='>=  '
30891        UPPLTY='<=  '
30892        ADEF1=-25.0
30893        ADEF2=25.0
30894        IHP31='SD1 '
30895        IHP32='    '
30896        IHP41='SD2 '
30897        IHP42='    '
30898        ALOWL2=0.0
30899        AUPPL2=CPUMAX
30900        LOWLT2='>   '
30901        UPPLT2='<=  '
30902        ADEF3=0.5
30903        ADEF4=25.0
30904        IDIST='FOLDED NORMAL'
30905        IF(ICASPL.EQ.'FCAU')IDIST='FOLDED CAUCHY'
30906        IF(ICASPL.EQ.'TNOR')IDIST='TRUNCATED NORMAL'
30907        GOTO4200
30908C
30909C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS THETA AND N
30910C
30911      ELSEIF(ICASPL.EQ.'TSPO' .OR. ICASPL.EQ.'TSOG')THEN
30912        IHP11='THET'
30913        IHP12='A1  '
30914        IHP21='THET'
30915        IHP22='A2  '
30916        IHP31='N1  '
30917        IHP32='    '
30918        IHP41='N2  '
30919        IHP42='    '
30920        ALOWLM=A
30921        AUPPLM=B
30922        LOWLTY='>=  '
30923        UPPLTY='<=  '
30924        ADEF1=ALOWLM
30925        ADEF2=AUPPLM
30926        ALOWL2=0.0
30927        AUPPL2=CPUMAX
30928        LOWLT2='>   '
30929        UPPLT2='<   '
30930        ADEF3=0.1
30931        ADEF4=10.0
30932        IDIST='TWO-SIDED POWER'
30933        IF(ICASPL.EQ.'TSOG')THEN
30934          IDIST='TWO-SIDED OGIVE'
30935          ALOWL2=0.5
30936          ADEF3=0.51
30937        ENDIF
30938        GOTO4200
30939C
30940C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS P AND SD
30941C
30942      ELSEIF(ICASPL.EQ.'PLGN')THEN
30943        IHP11='P1  '
30944        IHP12='    '
30945        IHP21='P2  '
30946        IHP22='    '
30947        ALOWLM=0.0
30948        AUPPLM=CPUMAX
30949        LOWLTY='>   '
30950        UPPLTY='<=  '
30951        ADEF1=0.5
30952        ADEF2=20.0
30953        IHP31='SD1 '
30954        IHP32='    '
30955        IHP41='SD2 '
30956        IHP42='    '
30957        ALOWL2=0.0
30958        AUPPL2=CPUMAX
30959        LOWLT2='>   '
30960        UPPLT2='<=  '
30961        ADEF3=0.5
30962        ADEF4=25.0
30963        IDIST='POWER-LOGNORMAL'
30964        GOTO4200
30965C
30966C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS ALPHA1 AND ALPHA2
30967C
30968      ELSEIF(ICASPL.EQ.'JOSU' .OR. ICASPL.EQ.'JOSB')THEN
30969        IHP11='ALPH'
30970        IHP12='A11 '
30971        IHP21='ALPH'
30972        IHP22='A12 '
30973        ALOWLM=CPUMIN
30974        AUPPLM=CPUMAX
30975        LOWLTY='>   '
30976        UPPLTY='<   '
30977        ADEF1=-1.0
30978        ADEF2=5.0
30979        IF(ICASPL.EQ.'JOSB')THEN
30980          IDIST='JOHNSON SB'
30981          ADEF1=-3.0
30982        ELSEIF(ICASPL.EQ.'JOSB')THEN
30983          IDIST='JOHNSON SU'
30984        ENDIF
30985        IHP31='ALPH'
30986        IHP32='A21 '
30987        IHP41='ALPH'
30988        IHP42='A22 '
30989        ALOWL2=CPUMIN
30990        AUPPL2=CPUMAX
30991        LOWLT2='>   '
30992        UPPLT2='<   '
30993        ADEF3=0.5
30994        ADEF4=5.0
30995        GOTO4200
30996C
30997C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS C AND B
30998C
30999      ELSEIF(ICASPL.EQ.'GOMP' .AND. IGOMDF.EQ.'DEFA')THEN
31000        IHP11='C1  '
31001        IHP12='    '
31002        IHP21='C2  '
31003        IHP22='    '
31004        IHP31='B1  '
31005        IHP32='    '
31006        IHP41='B2  '
31007        IHP42='    '
31008        ALOWLM=1.0
31009        AUPPLM=CPUMAX
31010        LOWLTY='>   '
31011        UPPLTY='<=  '
31012        ADEF1=1.1
31013        ADEF2=10.0
31014        ALOWL2=0.0
31015        AUPPL2=CPUMAX
31016        LOWLT2='>   '
31017        UPPLT2='<=  '
31018        ADEF3=0.1
31019        ADEF4=5.0
31020        IDIST='COMPERTZ'
31021        GOTO4200
31022C
31023C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS ALPHA AND K
31024C
31025      ELSEIF(ICASPL.EQ.'GOMP' .AND. IGOMDF.EQ.'JOHN')THEN
31026        IHP11='ALPH'
31027        IHP12='A1  '
31028        IHP21='ALPH'
31029        IHP22='A2  '
31030        IHP31='K1  '
31031        IHP32='    '
31032        IHP41='K2  '
31033        IHP42='    '
31034        ALOWLM=0.0
31035        AUPPLM=CPUMAX
31036        LOWLTY='>   '
31037        UPPLTY='<=  '
31038        ADEF1=0.1
31039        ADEF2=10.0
31040        ALOWL2=0.0
31041        AUPPL2=CPUMAX
31042        LOWLT2='>   '
31043        UPPLT2='<=  '
31044        ADEF3=0.1
31045        ADEF4=5.0
31046        IDIST='COMPERTZ'
31047        GOTO4200
31048C
31049C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS ALPHA AND K
31050C
31051      ELSEIF(ICASPL.EQ.'GOMP' .AND. IGOMDF.EQ.'JOHN')THEN
31052        IHP11='C1  '
31053        IHP12='    '
31054        IHP21='C2  '
31055        IHP22='    '
31056        IHP31='ALPH'
31057        IHP32='A1  '
31058        IHP41='ALPH'
31059        IHP42='A2  '
31060        ALOWLM=1.0
31061        AUPPLM=CPUMAX
31062        LOWLTY='>   '
31063        UPPLTY='<=  '
31064        ADEF1=1.1
31065        ADEF2=10.0
31066        ALOWL2=0.0
31067        AUPPL2=CPUMAX
31068        LOWLT2='>   '
31069        UPPLT2='<=  '
31070        ADEF3=0.1
31071        ADEF4=5.0
31072        IDIST='COMPERTZ'
31073        GOTO4200
31074C
31075C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS R AND K
31076C
31077      ELSEIF(ICASPL.EQ.'BUR3' .OR. ICASPL.EQ.'BUR5' .OR.
31078     1       ICASPL.EQ.'BUR6' .OR. ICASPL.EQ.'BUR9')THEN
31079        IHP11='R1  '
31080        IHP12='    '
31081        IHP21='R2  '
31082        IHP22='    '
31083        IHP31='K1  '
31084        IHP32='    '
31085        IHP41='K2  '
31086        IHP42='    '
31087        ALOWLM=0.0
31088        AUPPLM=CPUMAX
31089        LOWLTY='>   '
31090        UPPLTY='<=  '
31091        ADEF1=0.5
31092        ADEF2=10.0
31093        ALOWL2=0.0
31094        AUPPL2=CPUMAX
31095        LOWLT2='>   '
31096        UPPLT2='<=  '
31097        ADEF3=0.5
31098        ADEF4=10.0
31099        IDIST='BURR TYPE 3'
31100        IF(ICASPL.EQ.'BUR5')IDIST='BURR TYPE 5'
31101        IF(ICASPL.EQ.'BUR6')IDIST='BURR TYPE 6'
31102        IF(ICASPL.EQ.'BUR9')IDIST='BURR TYPE 9'
31103        GOTO4200
31104C
31105C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS C AND K
31106C
31107      ELSEIF(ICASPL.EQ.'BU12')THEN
31108        IHP11='C1  '
31109        IHP12='    '
31110        IHP21='C2  '
31111        IHP22='    '
31112        IHP31='K1  '
31113        IHP32='    '
31114        IHP41='K2  '
31115        IHP42='    '
31116        ALOWLM=0.0
31117        AUPPLM=CPUMAX
31118        LOWLTY='>   '
31119        UPPLTY='<=  '
31120        ADEF1=0.5
31121        ADEF2=10.0
31122        ALOWL2=0.0
31123        AUPPL2=CPUMAX
31124        LOWLT2='>   '
31125        UPPLT2='<=  '
31126        ADEF3=0.5
31127        ADEF4=10.0
31128        IDIST='BURR TYPE 12'
31129        GOTO4200
31130C
31131C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS THETA AND ALPHA
31132C
31133      ELSEIF(ICASPL.EQ.'TSSL')THEN
31134        IHP11='THET'
31135        IHP12='A1  '
31136        IHP21='THET'
31137        IHP22='A2  '
31138        IHP31='ALPH'
31139        IHP32='A1  '
31140        IHP41='ALPH'
31141        IHP42='A2  '
31142        ALOWLM=A
31143        AUPPLM=B
31144        LOWLTY='>   '
31145        UPPLTY='<=  '
31146        ADEF1=ALOWLM
31147        ADEF2=AUPPLM
31148        ALOWL2=0.0
31149        AUPPL2=2.0
31150        LOWLT2='>=  '
31151        UPPLT2='<=  '
31152        ADEF3=0.01
31153        ADEF4=1.99
31154        IDIST='TWO-SIDED SLOPE'
31155C
31156C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS M AND N
31157C
31158      ELSEIF(ICASPL.EQ.'DPUN')THEN
31159        IHP11='M1  '
31160        IHP12='    '
31161        IHP21='M2  '
31162        IHP22='    '
31163        IHP31='N1  '
31164        IHP32='    '
31165        IHP41='N2  '
31166        IHP42='    '
31167        ALOWLM=0.0
31168        AUPPLM=CPUMAX
31169        LOWLTY='>   '
31170        UPPLTY='<=  '
31171        ADEF1=0.5
31172        ADEF2=10.0
31173        ALOWL2=0.0
31174        AUPPL2=CPUMAX
31175        LOWLT2='>   '
31176        UPPLT2='<=  '
31177        ADEF3=0.5
31178        ADEF4=10.0
31179        IDIST='DOUBLY PARETO UNIFORM'
31180C
31181C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS K AND THETA
31182C
31183      ELSEIF(ICASPL.EQ.'MBKA')THEN
31184        IHP11='K1  '
31185        IHP12='    '
31186        IHP21='K2  '
31187        IHP22='    '
31188        IHP31='THET'
31189        IHP32='A1  '
31190        IHP41='THET'
31191        IHP42='A2  '
31192        ALOWLM=0.0
31193        AUPPLM=CPUMAX
31194        LOWLTY='>   '
31195        UPPLTY='<=  '
31196        ADEF1=0.5
31197        ADEF2=10.0
31198        ALOWL2=0.0
31199        AUPPL2=CPUMAX
31200        LOWLT2='>   '
31201        UPPLT2='<=  '
31202        ADEF3=0.5
31203        ADEF4=10.0
31204        IDIST='MIELKE BETA-KAPPA'
31205        GOTO4200
31206C
31207C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS K AND H
31208C
31209      ELSEIF(ICASPL.EQ.'KAPP')THEN
31210        IHP11='K1  '
31211        IHP12='    '
31212        IHP21='K2  '
31213        IHP22='    '
31214        IHP31='H1  '
31215        IHP32='    '
31216        IHP41='H2  '
31217        IHP42='    '
31218        ALOWLM=CPUMIN
31219        AUPPLM=CPUMAX
31220        LOWLTY='>   '
31221        UPPLTY='<=  '
31222        ADEF1=-5.0
31223        ADEF2=5.0
31224        ALOWL2=CPUMIN
31225        AUPPL2=CPUMAX
31226        LOWLT2='>   '
31227        UPPLT2='<=  '
31228        ADEF3=-2.0
31229        ADEF4=5.0
31230        IDIST='KAPPA'
31231        GOTO4200
31232C
31233C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS K AND P
31234C
31235      ELSEIF(ICASPL.EQ.'NEBI')THEN
31236        IHP11='K1  '
31237        IHP12='    '
31238        IHP21='K2  '
31239        IHP22='    '
31240        IHP31='P1  '
31241        IHP32='    '
31242        IHP41='P2  '
31243        IHP42='    '
31244        ALOWLM=0.0
31245        AUPPLM=CPUMAX
31246        LOWLTY='>   '
31247        UPPLTY='<=  '
31248        ADEF1=1.0
31249        ADEF2=25.0
31250        ALOWL2=0.0
31251        AUPPL2=1.0
31252        LOWLT2='>   '
31253        UPPLT2='<   '
31254        ADEF3=0.05
31255        ADEF4=0.95
31256        IDIST='NEGATIVE BINOMIAL'
31257        GOTO4200
31258C
31259C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS NU AND LAMBDA
31260C
31261      ELSEIF(ICASPL.EQ.'NCT ' .OR. ICASPL.EQ.'NCCS')THEN
31262        IHP11='NU1 '
31263        IHP12='    '
31264        IHP21='NU2 '
31265        IHP22='    '
31266        IHP31='LAMB'
31267        IHP32='DA1 '
31268        IHP41='LAMB'
31269        IHP42='DA2 '
31270        ALOWLM=1.0
31271        AUPPLM=REAL(I1MACH(9))
31272        LOWLTY='>=  '
31273        UPPLTY='<=  '
31274        ADEF1=5.0
31275        ADEF2=20.0
31276        ALOWL2=0.
31277        AUPPL2=CPUMAX
31278        LOWLT2='>=  '
31279        UPPLT2='<=  '
31280        ADEF3=0.0
31281        ADEF4=10.0
31282        IF(ICASPL.EQ.'NCT ')THEN
31283          IDIST='NON-CENTRAL T'
31284        ELSEIF(ICASPL.EQ.'NCCS')THEN
31285          IDIST='NON-CENTRAL CHI-SQUARE'
31286        ELSEIF(ICASPL.EQ.'TSKE')THEN
31287          IDIST='SKEWED T'
31288          ADEF1=1.0
31289          ADEF2=25.0
31290          ALOWL2=CPUMIN
31291          ADEF3=-3.0
31292          ADEF4=3.0
31293        ENDIF
31294        GOTO4200
31295C
31296C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS THETA AND BETA
31297C
31298      ELSEIF(ICASPL.EQ.'GLOS' .OR.
31299     1      (ICASPL.EQ.'GEET' .AND. IGETDF.EQ.'THET'))THEN
31300        IHP11='THET'
31301        IHP12='A1  '
31302        IHP21='THET'
31303        IHP22='A2  '
31304        IHP31='BETA'
31305        IHP32='1   '
31306        IHP41='BETA'
31307        IHP42='2   '
31308        ALOWLM=0.
31309        AUPPLM=1.0
31310        LOWLTY='>   '
31311        UPPLTY='<   '
31312        ADEF1=0.05
31313        ADEF2=0.95
31314        ALOWL2=1.0
31315        AUPPL2=CPUMAX
31316        LOWLT2='>   '
31317        UPPLT2='<   '
31318        ADEF3=1.05
31319        ADEF4=5.0
31320        IDIST='GENERALIZED LOGARITHMIC SERIES'
31321        IF(ICASPL.EQ.'GEET' .AND. IGETDF.EQ.'THET')THEN
31322          IDIST='GEETA'
31323        ENDIF
31324        GOTO4200
31325C
31326C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS MU AND BETA
31327C
31328      ELSEIF(ICASPL.EQ.'GEET' .AND. IGETDF.EQ.'MU')THEN
31329        IHP11='MU1 '
31330        IHP12='    '
31331        IHP21='MU2 '
31332        IHP22='    '
31333        IHP31='BETA'
31334        IHP32='1   '
31335        IHP41='BETA'
31336        IHP42='2   '
31337        ALOWLM=1.0
31338        AUPPLM=CPUMAX
31339        LOWLTY='>=  '
31340        UPPLTY='<   '
31341        ADEF1=1.05
31342        ADEF2=5.0
31343        ALOWL2=1.0
31344        AUPPL2=CPUMAX
31345        LOWLT2='>=  '
31346        UPPLT2='<   '
31347        ADEF3=1.05
31348        ADEF4=5.0
31349        IDIST='GEETA'
31350        GOTO4200
31351C
31352C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS THETA AND M
31353C
31354      ELSEIF(ICASPL.EQ.'CONS' .AND. ICONDF.EQ.'THET')THEN
31355        IHP11='THET'
31356        IHP12='A1  '
31357        IHP21='THET'
31358        IHP22='A2  '
31359        IHP31='M1  '
31360        IHP32='    '
31361        IHP41='M2  '
31362        IHP42='    '
31363        ALOWLM=0.
31364        AUPPLM=1.0
31365        LOWLTY='>   '
31366        UPPLTY='<   '
31367        ADEF1=0.05
31368        ADEF2=0.95
31369        ALOWL2=1.0
31370        AUPPL2=CPUMAX
31371        LOWLT2='>=  '
31372        UPPLT2='<   '
31373        ADEF3=1.05
31374        ADEF4=5.0
31375        IDIST='CONSUL (GENERALIZED GEOMETRIC)'
31376        GOTO4200
31377C
31378C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS MU AND M
31379C
31380      ELSEIF(ICASPL.EQ.'CONS' .AND. ICONDF.EQ.'MU')THEN
31381        IHP11='MU1 '
31382        IHP12='    '
31383        IHP21='MU2 '
31384        IHP22='    '
31385        IHP31='M1  '
31386        IHP32='    '
31387        IHP41='M2  '
31388        IHP42='    '
31389        ALOWLM=1.0
31390        AUPPLM=CPUMAX
31391        LOWLTY='>=  '
31392        UPPLTY='<   '
31393        ADEF1=1.05
31394        ADEF2=5.0
31395        ALOWL2=1.0
31396        AUPPL2=CPUMAX
31397        LOWLT2='>=  '
31398        UPPLT2='<   '
31399        ADEF3=1.05
31400        ADEF4=5.0
31401        IDIST='CONSUL (GENERALIZED GEOMETRIC)'
31402        GOTO4200
31403C
31404C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS P AND PHI
31405C
31406      ELSEIF(ICASPL.EQ.'QBIN')THEN
31407        IDIST='QUASI BINOMIAL TYPE I'
31408        IHP31='M   '
31409        IHP32='    '
31410        ILOWLM=1
31411        IUPPLM=I1MACH(9)
31412        LOWLTY='>=  '
31413        UPPLTY='<=  '
31414        CALL PARCHI(IHP31,IHP32,IDIST,IM,ILOWLM,IUPPLM,
31415     1              LOWLTY,UPPLTY,
31416     1              ISUBN1,ISUBN2,IERROR)
31417        IF(IERROR.EQ.'YES')GOTO9000
31418        SHAPE3=REAL(IM)
31419C
31420        IHP11='P1  '
31421        IHP12='    '
31422        IHP21='P2  '
31423        IHP22='    '
31424        ALOWLM=0.
31425        AUPPLM=1.0
31426        LOWLTY='>   '
31427        UPPLTY='<   '
31428        ADEF1=0.05
31429        ADEF2=0.95
31430C
31431        CALL PARCH2(IHP11,IHP12,IDIST,SHAP11,ADEF1,ALOWLM,AUPPLM,
31432     1              LOWLTY,UPPLTY,
31433     1              ISUBN1,ISUBN2,IERROR)
31434        IF(IERROR.EQ.'YES')GOTO9000
31435        CALL PARCH2(IHP21,IHP22,IDIST,SHAP12,ADEF2,ALOWLM,AUPPLM,
31436     1              LOWLTY,UPPLTY,
31437     1              ISUBN1,ISUBN2,IERROR)
31438        IF(IERROR.EQ.'YES')GOTO9000
31439C
31440        IHP31='PHI1'
31441        IHP32='    '
31442        IHP41='PHI2'
31443        IHP42='    '
31444        ALOWL2=-SHAP11/SHAPE3
31445        AUPPL2=(1.0-SHAP11)/SHAPE3
31446        AINC=(AUPPL2-ALOWL2)/50.0
31447        LOWLT2='>=  '
31448        UPPLT2='<=  '
31449        ADEF3=ALOWL2+AINC
31450        ADEF4=AUPPL2-AINC
31451        CALL PARCH2(IHP31,IHP32,IDIST,SHAP21,ADEF3,ALOWL2,AUPPL2,
31452     1              LOWLT2,UPPLT2,
31453     1              ISUBN1,ISUBN2,IERROR)
31454        IF(IERROR.EQ.'YES')GOTO9000
31455        CALL PARCH2(IHP41,IHP42,IDIST,SHAP22,ADEF4,ALOWL2,AUPPL2,
31456     1              LOWLT2,UPPLT2,
31457     1              ISUBN1,ISUBN2,IERROR)
31458        IF(IERROR.EQ.'YES')GOTO9000
31459        GOTO9000
31460C
31461C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS C AND A
31462C
31463      ELSEIF(ICASPL.EQ.'WARI')THEN
31464        IHP11='C1  '
31465        IHP12='    '
31466        IHP21='C2  '
31467        IHP22='    '
31468        IHP31='A1  '
31469        IHP32='    '
31470        IHP41='A2  '
31471        IHP42='    '
31472        ALOWLM=0.0
31473        AUPPLM=CPUMAX
31474        LOWLTY='>   '
31475        UPPLTY='<   '
31476        ADEF1=0.5
31477        ADEF2=5.0
31478        ALOWL2=0.0
31479        AUPPL2=CPUMAX
31480        LOWLT2='>=  '
31481        UPPLT2='<   '
31482        ADEF3=0.5
31483        ADEF4=5.0
31484        IDIST='WARING'
31485        GOTO4200
31486C
31487C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS Q AND BETA
31488C
31489      ELSEIF(ICASPL.EQ.'DISW')THEN
31490        IHP11='Q1  '
31491        IHP12='    '
31492        IHP21='Q2  '
31493        IHP22='    '
31494        IHP31='BETA'
31495        IHP32='1   '
31496        IHP41='BETA'
31497        IHP42='1   '
31498        ALOWLM=0.
31499        AUPPLM=1.0
31500        LOWLTY='>   '
31501        UPPLTY='<   '
31502        ADEF1=0.05
31503        ADEF2=0.95
31504        ALOWL2=0.01
31505        AUPPL2=CPUMAX
31506        LOWLT2='>   '
31507        UPPLT2='<   '
31508        ADEF3=0.1
31509        ADEF4=3.0
31510        IDIST='DISCRETE WEIBULL'
31511        GOTO4200
31512C
31513C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS THETA AND P
31514C
31515      ELSEIF(ICASPL.EQ.'AEPP')THEN
31516        IHP11='THET'
31517        IHP12='A1  '
31518        IHP21='THET'
31519        IHP22='A2  '
31520        IHP31='P1  '
31521        IHP32='    '
31522        IHP41='P2  '
31523        IHP42='    '
31524        ALOWLM=0.0
31525        AUPPLM=CPUMAX
31526        LOWLTY='>   '
31527        UPPLTY='<   '
31528        ADEF1=1.0
31529        ADEF2=25.0
31530        ALOWL2=0.0
31531        AUPPL2=1.0
31532        LOWLT2='>   '
31533        UPPLT2='<   '
31534        ADEF3=0.05
31535        ADEF4=0.95
31536        IDIST='POLYA-AEPPLI'
31537        GOTO4200
31538C
31539C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS P AND A
31540C
31541      ELSEIF(ICASPL.EQ.'GLGP')THEN
31542        IDIST='GENERALIZED LOST GAMES'
31543        IHP31='J   '
31544        IHP32='    '
31545        ILOWLM=0
31546        IUPPLM=I1MACH(9)
31547        LOWLTY='>=  '
31548        UPPLTY='<=  '
31549        CALL PARCHI(IHP31,IHP32,IDIST,NU1,ILOWLM,IUPPLM,
31550     1              LOWLTY,UPPLTY,
31551     1              ISUBN1,ISUBN2,IERROR)
31552        SHAPE3=REAL(NU1)
31553        IF(IERROR.EQ.'YES')GOTO9000
31554C
31555        IHP11='P1  '
31556        IHP12='    '
31557        IHP21='P2  '
31558        IHP22='    '
31559        IHP31='A1  '
31560        IHP32='    '
31561        IHP41='A2  '
31562        IHP42='    '
31563        ALOWLM=0.5
31564        AUPPLM=1.0
31565        LOWLTY='>   '
31566        UPPLTY='<   '
31567        ADEF1=0.55
31568        ADEF2=0.95
31569        ALOWL2=0.0
31570        AUPPL2=CPUMAX
31571        LOWLT2='>   '
31572        UPPLT2='<   '
31573        ADEF3=0.5
31574        ADEF4=10.0
31575        GOTO4200
31576C
31577C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS LAMBDA AND THETA
31578C
31579      ELSEIF(ICASPL.EQ.'LPOI')THEN
31580        IHP11='LAMB'
31581        IHP12='DA1 '
31582        IHP21='LAMB'
31583        IHP22='DA2 '
31584        IHP31='THET'
31585        IHP32='A1  '
31586        IHP41='THET'
31587        IHP42='A2  '
31588        ALOWLM=0.0
31589        AUPPLM=1.0
31590        LOWLTY='>   '
31591        UPPLTY='<   '
31592        ADEF1=0.2
31593        ADEF2=0.95
31594        ALOWL2=0.0
31595        AUPPL2=CPUMAX
31596        LOWLT2='>   '
31597        UPPLT2='<   '
31598        ADEF3=0.5
31599        ADEF4=10.0
31600        IDIST='LAGRANGE-POISSON'
31601        GOTO4200
31602C
31603C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS M AND SD
31604C
31605      ELSEIF(ICASPL.EQ.'TEXP')THEN
31606        IDIST='TRUNCATED EXPONENTIAL'
31607        IHP31='X0  '
31608        IHP32='    '
31609        ALOWLM=0.
31610        AUPPLM=CPUMAX
31611        LOWLTY='>   '
31612        UPPLTY='<=  '
31613        CALL PARCHR(IHP31,IHP32,IDIST,SHAPE3,ALOWLM,AUPPLM,
31614     1              LOWLTY,UPPLTY,
31615     1              ISUBN1,ISUBN2,IERROR)
31616        IF(IERROR.EQ.'YES')GOTO9000
31617C
31618        IHP11='M1  '
31619        IHP12='    '
31620        IHP21='M2  '
31621        IHP22='    '
31622        IHP31='SD1 '
31623        IHP32='    '
31624        IHP41='SD2 '
31625        IHP42='    '
31626        ALOWLM=0.
31627        AUPPLM=CPUMAX
31628        LOWLTY='>=  '
31629        UPPLTY='<=  '
31630        ADEF1=0.0
31631        ADEF2=10.0
31632        ALOWL2=0.
31633        AUPPL2=CPUMAX
31634        LOWLT2='>   '
31635        UPPLT2='<=  '
31636        ADEF3=0.1
31637        ADEF4=10.0
31638C
31639C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS PHI AND ALPHA
31640C
31641      ELSEIF(ICASPL.EQ.'ARCT')THEN
31642        IHP11='PHI1'
31643        IHP12='    '
31644        IHP21='PHI2'
31645        IHP22='    '
31646        ALOWLM=CPUMIN
31647        AUPPLM=CPUMAX
31648        LOWLTY='>=  '
31649        UPPLTY='<=  '
31650        ADEF1=-50.0
31651        ADEF2=50.0
31652        IHP31='ALPH'
31653        IHP32='A1  '
31654        IHP41='ALPH'
31655        IHP42='A2  '
31656        ALOWL2=0.0
31657        AUPPL2=CPUMAX
31658        LOWLT2='>   '
31659        UPPLT2='<=  '
31660        ADEF3=0.1
31661        ADEF4=10.0
31662        IDIST='ARCTANGENT'
31663        GOTO4200
31664C
31665C       HANDLE TRAPEZOID DISTRIBUTION SEPARATELY.  ASSUME END POINTS
31666C       A AND D ARE KNOWN AND WANT TO ESTIMATE B AND C.  VALUES FOR
31667C       B AND C SHOULD BE IN THE INTERVAL DEFINED BY END_POINTS
31668C
31669      ELSEIF(ICASPL.EQ.'TRAP')THEN
31670        IDIST='TRAPEZOID'
31671        IHP11='A   '
31672        IHP12='    '
31673        ALOWLM=CPUMIN
31674        AUPPLM=CPUMAX
31675        LOWLTY='>=  '
31676        UPPLTY='<=  '
31677        CALL PARCHR(IHP11,IHP12,IDIST,SHAPE1,ALOWLM,AUPPLM,
31678     1              LOWLTY,UPPLTY,
31679     1              ISUBN1,ISUBN2,IERROR)
31680        IF(IERROR.EQ.'YES')GOTO9000
31681        IHP41='D   '
31682        IHP42='    '
31683        ALOWL4=ALOWLM
31684        AUPPL4=CPUMAX
31685        LOWLT4='>   '
31686        UPPLT4='<=  '
31687        CALL PARCHR(IHP41,IHP42,IDIST,SHAPE4,ALOWL4,AUPPL4,
31688     1              LOWLT4,UPPLT4,
31689     1              ISUBN1,ISUBN2,IERROR)
31690        IF(IERROR.EQ.'YES')GOTO9000
31691C
31692        IHP11='B1  '
31693        IHP12='    '
31694        IHP21='B2  '
31695        IHP22='    '
31696        ALOWLM=SHAPE1
31697        AUPPLM=SHAPE4
31698        LOWLTY='>   '
31699        UPPLTY='<   '
31700        ADEF1=SHAPE1+0.1
31701        ADEF2=SHAPE4-0.1
31702        CALL PARCH2(IHP11,IHP12,IDIST,SHAP11,ADEF1,ALOWLM,AUPPLM,
31703     1              LOWLTY,UPPLTY,
31704     1              ISUBN1,ISUBN2,IERROR)
31705        IF(IERROR.EQ.'YES')GOTO9000
31706        CALL PARCH2(IHP21,IHP22,IDIST,SHAP12,ADEF2,ALOWLM,AUPPLM,
31707     1              LOWLTY,UPPLTY,
31708     1              ISUBN1,ISUBN2,IERROR)
31709        IF(IERROR.EQ.'YES')GOTO9000
31710C
31711        IHP31='C1  '
31712        IHP32='    '
31713        IHP41='C2  '
31714        IHP42='    '
31715        ALOWL2=SHAPE1
31716        AUPPL2=SHAPE4
31717        LOWLT2='>   '
31718        UPPLT2='<   '
31719        ADEF3=SHAPE1+0.1
31720        ADEF4=SHAPE4-0.1
31721        CALL PARCH2(IHP31,IHP32,IDIST,SHAP21,ADEF3,ALOWL2,AUPPL2,
31722     1              LOWLT2,UPPLT2,
31723     1              ISUBN1,ISUBN2,IERROR)
31724        IF(IERROR.EQ.'YES')GOTO9000
31725        CALL PARCH2(IHP41,IHP42,IDIST,SHAP22,ADEF4,ALOWL2,AUPPL2,
31726     1              LOWLT2,UPPLT2,
31727     1              ISUBN1,ISUBN2,IERROR)
31728        IF(IERROR.EQ.'YES')GOTO9000
31729C
31730C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS ETA AND ZETA
31731C
31732      ELSEIF(ICASPL.EQ.'GOMM' .AND. IMAKDF.EQ.'REPA')THEN
31733        IHP11='ETA1'
31734        IHP12='    '
31735        IHP21='ETA2'
31736        IHP22='    '
31737        IHP31='ZETA'
31738        IHP32='1   '
31739        IHP41='ZETA'
31740        IHP42='2   '
31741        ALOWLM=CPUMIN
31742        AUPPLM=CPUMAX
31743        LOWLTY='>=  '
31744        UPPLTY='<=  '
31745        ADEF1=0.1
31746        ADEF2=5.0
31747        ALOWL2=0.
31748        AUPPL2=CPUMAX
31749        LOWLT2='>=  '
31750        UPPLT2='<=  '
31751        ADEF3=0.1
31752        ADEF4=5.0
31753        IDIST='GOMPERTZ-MAKEHAM'
31754        GOTO4200
31755C
31756C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS LAMBDA AND OMEGA
31757C
31758      ELSEIF(ICASPL.EQ.'GIGA')THEN
31759        IHP11='LAMB'
31760        IHP12='DA1 '
31761        IHP21='LAMB'
31762        IHP22='DA2 '
31763        IHP31='OMEG'
31764        IHP32='A1  '
31765        IHP41='OMEG'
31766        IHP42='A2  '
31767        ALOWLM=CPUMIN
31768        AUPPLM=CPUMAX
31769        LOWLTY='>=  '
31770        UPPLTY='<=  '
31771        ADEF1=-10.0
31772        ADEF2=10.0
31773        ALOWL2=0.0
31774        AUPPL2=CPUMAX
31775        LOWLT2='>   '
31776        UPPLT2='<=  '
31777        ADEF3=0.2
31778        ADEF4=10.0
31779        IDIST='GENERALIZED INVERSE GAUSSIAN'
31780        GOTO4200
31781C
31782C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS LAMBDA AND SD
31783C
31784      ELSEIF(ICASPL.EQ.'LSNO')THEN
31785        IHP11='LAMB'
31786        IHP12='DA1 '
31787        IHP21='LAMB'
31788        IHP22='DA2 '
31789        IHP31='SD1 '
31790        IHP32='    '
31791        IHP41='SD2 '
31792        IHP42='    '
31793        ALOWLM=CPUMIN
31794        AUPPLM=CPUMAX
31795        LOWLTY='>   '
31796        UPPLTY='<   '
31797        ADEF1=0.0
31798        ADEF2=5.0
31799        ALOWL2=0.0
31800        AUPPL2=CPUMAX
31801        LOWLT2='>   '
31802        UPPLT2='<=  '
31803        ADEF3=0.5
31804        ADEF4=10.0
31805        IDIST='LOG-SKEW-NORMAL'
31806        GOTO4200
31807C
31808C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS K AND TAU
31809C
31810      ELSEIF(ICASPL.EQ.'GALP' .AND. IADEDF.EQ.'K')THEN
31811        IHP11='K1  '
31812        IHP12='    '
31813        IHP21='K2  '
31814        IHP22='    '
31815        IHP31='TAU1'
31816        IHP32='    '
31817        IHP41='TAU2'
31818        IHP42='    '
31819        ALOWLM=0.2
31820        AUPPLM=CPUMAX
31821        LOWLTY='>=  '
31822        UPPLTY='<   '
31823        ADEF1=0.2
31824        ADEF2=5.0
31825        ALOWL2=0.2
31826        AUPPL2=CPUMAX
31827        LOWLT2='>=  '
31828        UPPLT2='<   '
31829        ADEF3=0.2
31830        ADEF4=5.0
31831        IDIST='GENE ASYMM DOUBLE EXPONENTIAL'
31832        GOTO4200
31833C
31834C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS K AND MU
31835C
31836      ELSEIF(ICASPL.EQ.'GALP' .AND. IADEDF.EQ.'MU')THEN
31837        IHP11='MU1 '
31838        IHP12='    '
31839        IHP21='MU2 '
31840        IHP22='    '
31841        IHP31='TAU1'
31842        IHP32='    '
31843        IHP41='TAU2'
31844        IHP42='    '
31845        ALOWLM=CPUMIN
31846        AUPPLM=CPUMAX
31847        LOWLTY='>   '
31848        UPPLTY='<   '
31849        ADEF1=-5.0
31850        ADEF2=5.0
31851        ALOWL2=0.2
31852        AUPPL2=CPUMAX
31853        LOWLT2='>=  '
31854        UPPLT2='<   '
31855        ADEF3=0.2
31856        ADEF4=5.0
31857        IDIST='GENE ASYMM DOUBLE EXPONENTIAL'
31858        GOTO4200
31859C
31860C     DISTRIBUTIONS WITH TWO SHAPE PARAMETERS ALPHA AND A
31861C
31862      ELSEIF(ICASPL.EQ.'GMCL')THEN
31863        IHP11='ALPH'
31864        IHP12='A1  '
31865        IHP21='ALPH'
31866        IHP22='A2  '
31867        IHP31='A1  '
31868        IHP32='    '
31869        IHP41='A2  '
31870        IHP42='    '
31871        ALOWLM=CPUMIN
31872        AUPPLM=CPUMAX
31873        LOWLTY='>   '
31874        UPPLTY='<=  '
31875        ADEF1=0.5
31876        ADEF2=10.0
31877        ALOWL2=-1.0
31878        AUPPL2=1.0
31879        LOWLT2='>   '
31880        UPPLT2='<   '
31881        ADEF3=-0.8
31882        ADEF4=0.8
31883        IDIST='GENERALIZED MCLEISH'
31884        GOTO4200
31885      ELSE
31886        IERRFL=1
31887      ENDIF
31888C
31889      GOTO9000
31890C
31891C     THE ONE AND TWO SHAPE PARAMETER CASES ARE THE MOST
31892C     COMMON.  HANDLE THOSE HERE.
31893C
31894 4100 CONTINUE
31895      CALL PARCH2(IHP11,IHP12,IDIST,
31896     1            SHAP11,ADEF1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
31897     1            ISUBN1,ISUBN2,IERROR)
31898      CALL PARCH2(IHP21,IHP22,IDIST,
31899     1            SHAP12,ADEF2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
31900     1            ISUBN1,ISUBN2,IERROR)
31901      GOTO9000
31902C
31903 4200 CONTINUE
31904      CALL PARCH2(IHP11,IHP12,IDIST,
31905     1            SHAP11,ADEF1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
31906     1            ISUBN1,ISUBN2,IERROR)
31907      CALL PARCH2(IHP21,IHP22,IDIST,
31908     1            SHAP12,ADEF2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
31909     1            ISUBN1,ISUBN2,IERROR)
31910      CALL PARCH2(IHP31,IHP32,IDIST,
31911     1            SHAP21,ADEF3,ALOWL2,AUPPL2,LOWLT2,UPPLT2,
31912     1            ISUBN1,ISUBN2,IERROR)
31913      CALL PARCH2(IHP41,IHP42,IDIST,
31914     1            SHAP22,ADEF4,ALOWL2,AUPPL2,LOWLT2,UPPLT2,
31915     1            ISUBN1,ISUBN2,IERROR)
31916      GOTO9000
31917C
31918 9000 CONTINUE
31919C
31920      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TPA2')THEN
31921        WRITE(ICOUT,9011)
31922 9011   FORMAT('AT END OF EXTPA2:')
31923        CALL DPWRST('XXX','BUG ')
31924        WRITE(ICOUT,9013)IHP11,IHP12,IHP21,IHP22,SHAP11,SHAP12
31925 9013   FORMAT('IHP11,IHP12,IHP21,IHP22,SHAP11,SHAP12 = ',
31926     1         2(A4,A4,2X),2G15.7)
31927        CALL DPWRST('XXX','BUG ')
31928        WRITE(ICOUT,9015)IHP31,IHP32,IHP41,IHP42,SHAP21,SHAP22
31929 9015   FORMAT('IHP31,IHP32,IHP41,IHP42,SHAP21,SHAP22 = ',
31930     1         2(A4,A4,2X),2G15.7)
31931        CALL DPWRST('XXX','BUG ')
31932      ENDIF
31933C
31934      RETURN
31935      END
31936      SUBROUTINE EXTREA(IATEMP,NCHAR,AVALUE,IBUGS2,ISUBRO,IERROR)
31937C
31938C     PURPOSE--THIS SUBROUTINE EXTRACTS A REAL VALUE FROM
31939C              A CHARACTER STRING.  LOOK FOR FIRST AND LAST
31940C              NON-BLANK CHARACTERS (IF ENTIRE FIELD IS BLANK,
31941C              RETURN A 0.).  THE INPUT STRING SHOULD CONTAIN ONLY
31942C              "+", "-", ".", OR A NUMBER.  IF ANY OTHER CHARACTER
31943C              ENCOUNTERED, THE REST OF THE STRING WILL BE
31944C              IGNORED.
31945C
31946C              NOTE THAT SOME REAL VALUES MAY CONTAIN A UNIT IDENTIFIER.
31947C              SO ONLY PROCESS THE CHARACTERS FROM THE FIRST NON-BLANK
31948C              CHARACTER TO THE FIRST SPACE AFTER THE FIRST NON-BLANK
31949C              CHARACTER.  ASSUME ANYTHING AFTER THIS IS SIMPLY A
31950C              UNIT SPECIFICATION.
31951C
31952C     WRITTEN BY--ALAN HECKERT
31953C                 STATISTICAL ENGINEERING DIVISION
31954C                 INFORMATION TECHNOLOGY LABORATORY
31955C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
31956C                 GAITHERSBURG, MD 20899-8980
31957C                 PHONE--301-975-2899
31958C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
31959C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
31960C     LANGUAGE--ANSI FORTRAN (1977)
31961C               HOST DEPENDENT
31962C     VERSION NUMBER--2014.10
31963C     ORIGINAL VERSION--OCTOBER    2014.
31964C     UPDATED         --JANUARY    2016. IF ENTIRE FIELD IS BLANK, THEN
31965C                                        RETURN CPUMIN RATHER THAN 0
31966C
31967C-----NON-COMMON VARIABLES (GRAPHICS)---------------------------------
31968C
31969      CHARACTER*(*) IATEMP
31970      CHARACTER*4   IBUGS2
31971      CHARACTER*4   ISUBRO
31972      CHARACTER*4   IERROR
31973      CHARACTER*10  IFORMT
31974C
31975C-----COMMON VARIABLES (GENERAL)--------------------------------------
31976C
31977      INCLUDE 'DPCOP2.INC'
31978C
31979C-----START POINT-----------------------------------------------------
31980C
31981      AVALUE=CPUMIN
31982      NTOT=0
31983      NLEFT=0
31984      NRIGHT=0
31985C
31986      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'TREA')THEN
31987        WRITE(ICOUT,999)
31988  999   FORMAT(1X)
31989        CALL DPWRST('XXX','BUG ')
31990        WRITE(ICOUT,51)NUMREC,NCHAR
31991  51    FORMAT('EXTREA: NUMREC,NCHAR = ',2I8)
31992        CALL DPWRST('XXX','BUG ')
31993        IF (NCHAR.GT.0) THEN
31994            WRITE(ICOUT,53)IATEMP(1:MIN(80,NCHAR))
31995  53        FORMAT('IATEMP(1:NCHAR) = ',A80)
31996            CALL DPWRST('XXX','BUG ')
31997         ENDIF
31998      ENDIF
31999C
32000C     FIND FIRST NON-BLANK CHARACTER
32001C
32002      IF (NCHAR.LE.0) GOTO9090
32003      IF (IATEMP(1:NCHAR).EQ.' ') GOTO9090
32004      IF (NCHAR.EQ.1) THEN
32005         IVAL=ICHAR(IATEMP(1:1))
32006         IF (IVAL.LE.47 .OR. IVAL.GT.127) GOTO9090
32007      ENDIF
32008C
32009      ISTRT=0
32010      DO 100 I=1,NCHAR
32011         IF (IATEMP(I:I).EQ.' ')GOTO100
32012            ISTRT=I
32013            GOTO109
32014  100 CONTINUE
32015      GOTO9090
32016  109 CONTINUE
32017C
32018C     FIND FIRST "BLANK" AFTER FIRST NON-BLANK CHARACTER
32019C
32020      ILAST=NCHAR
32021      DO 110 I=ISTRT,NCHAR
32022         IF (IATEMP(I:I).EQ.' ')THEN
32023            ILAST=I-1
32024            GOTO199
32025         ENDIF
32026  110 CONTINUE
32027  199 CONTINUE
32028C
32029C     FIND LAST NON-BLANK CHARACTER
32030C
32031C     CHECK FOR "NULL" OR "NAN" TO INDICATE MISSING DATA
32032C
32033      IF (ISTRT+3.LE.NCHAR) THEN
32034         IF (IATEMP(ISTRT:ISTRT+3).EQ.'NULL')THEN
32035            AVALUE=CPUMIN
32036            GOTO9090
32037         ENDIF
32038      ELSEIF (ISTRT+2.LE.NCHAR) THEN
32039         IF (IATEMP(ISTRT:ISTRT+2).EQ.'NAN')THEN
32040            AVALUE=CPUMIN
32041            GOTO9090
32042         ENDIF
32043      ELSEIF (ISTRT+2.LE.NCHAR) THEN
32044         IF (IATEMP(ISTRT:ISTRT+2).EQ.'NaN')THEN
32045            AVALUE=CPUMIN
32046            GOTO9090
32047         ENDIF
32048      ELSEIF (ISTRT+2.LE.NCHAR) THEN
32049         IF (IATEMP(ISTRT:ISTRT+2).EQ.'nan')THEN
32050            AVALUE=CPUMIN
32051            GOTO9090
32052         ENDIF
32053      ENDIF
32054C
32055C     CHECK FOR AN INTEGER VALUE
32056C
32057      IINT=1
32058      DO 310 I=ISTRT,ILAST
32059         IF (IATEMP(I:I).EQ.'.') THEN
32060            IINT=0
32061            GOTO319
32062         ENDIF
32063  310 CONTINUE
32064  319 CONTINUE
32065C
32066      IF (IINT.EQ.1) THEN
32067         CALL EXTINT(IATEMP,ILAST,IVALUE,IBUGS2,ISUBRO,IERROR)
32068         AVALUE=REAL(IVALUE)
32069         GOTO9090
32070      ENDIF
32071C
32072C     CHECK FOR "E" FORMAT.  HANDLE THIS BY EXTRACTING
32073C     THE REAL NUMBER BEFORE "E" AND THEN EXTRACTING
32074C     THE POWER AFTER THE "E".
32075C
32076      IPOSE=0
32077      IPOWER=0
32078      DO 400 I=ISTRT,ILAST
32079         IF (IATEMP(I:I).EQ.'E' .OR. IATEMP(I:I).EQ.'E')THEN
32080            ICURR=I+1
32081            ILAST=I-1
32082            IPOSE=I
32083            IF (IATEMP(ICURR:ICURR).EQ.'+') THEN
32084              READ(IATEMP(I+2:I+3),'(I2)')IPOWER
32085              GOTO409
32086            ELSE IF (IATEMP(ICURR:ICURR).EQ.'-') THEN
32087              READ(IATEMP(I+2:I+3),'(I2)')IPOWER
32088              IPOWER=-IPOWER
32089              GOTO409
32090            ELSE
32091              READ(IATEMP(I+1:I+2),'(I2)')IPOWER
32092              GOTO409
32093            ENDIF
32094         ENDIF
32095  400 CONTINUE
32096  409 CONTINUE
32097C
32098C     CONVERT TEXT TO REAL NUMBER
32099C
32100C     LOOK FOR "+", "-", ".", OR NUMBER.  FIRST CHARACTER THAT
32101C     IS NOT ONE OF THESE WILL CAUSE THE REST OF THE FIELD TO
32102C     BE IGNORED (THIS BASICALLY SHOULD STRIP OFF UNITS).
32103C     ALSO, "+" AND "-" ONLY VALID IF THE FIRST ELEMENT OF THE
32104C     FIELD.  ONLY ONE "." WILL BE RECOGNIZED.
32105C
32106      IFLAG=0
32107      DO 300 I=ISTRT,ILAST
32108         IF (IATEMP(I:I).EQ.' ')THEN
32109            ILAST=I-1
32110            GOTO399
32111         ELSEIF (IATEMP(I:I).EQ.'.')THEN
32112            IF (IFLAG.EQ.0)THEN
32113               IFLAG=1
32114               NTOT=NTOT+1
32115            ELSE
32116               ILAST=I-1
32117               GOTO399
32118            ENDIF
32119         ELSEIF (IATEMP(I:I).EQ.'+')THEN
32120            IF (NTOT.EQ.0)THEN
32121               AFACT=1.0
32122               NTOT=NTOT+1
32123            ELSE
32124               ILAST=I-1
32125               GOTO399
32126            ENDIF
32127         ELSEIF (IATEMP(I:I).EQ.'-')THEN
32128            IF (NTOT.EQ.0)THEN
32129               AFACT=-1.0
32130               NTOT=NTOT+1
32131            ELSE
32132               ILAST=I-1
32133               GOTO399
32134            ENDIF
32135         ELSE
32136            ITEMP=ICHAR(IATEMP(I:I))
32137            IF (ITEMP.LT.48 .OR. ITEMP.GT.57)THEN
32138               ILAST=I-1
32139               GOTO399
32140            ELSE
32141               IF (IFLAG.EQ.0)THEN
32142                  NTOT=NTOT+1
32143                  NLEFT=NLEFT+1
32144               ELSE
32145                  NTOT=NTOT+1
32146                  NRIGHT=NRIGHT+1
32147               ENDIF
32148            END IF
32149         END IF
32150  300 CONTINUE
32151  399 CONTINUE
32152      IFORMT='(F  .  )'
32153      IF (NRIGHT.GT.12)THEN
32154         NSUBT=NRIGHT-12
32155         ILAST=ILAST-NSUBT
32156         NTOT=NTOT-NSUBT
32157         NRIGHT=NRIGHT
32158      ENDIF
32159      WRITE(IFORMT(3:4),'(I2)')NTOT
32160      WRITE(IFORMT(6:7),'(I2)')NRIGHT
32161C
32162      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'TREA')THEN
32163        WRITE(ICOUT,1011)IATEMP(ISTRT:ILAST)
32164 1011   FORMAT('EXTREA: IATEMP(ISTRT:ILAST) = ',A80)
32165        CALL DPWRST('XXX','BUG ')
32166        WRITE(ICOUT,1013)NTOT,NLEFT,NRIGHT,IFORMT
32167 1013   FORMAT('NTOT,LEFT,NRIGHT,IFORMT = ',3G15.7,2X,A10)
32168        CALL DPWRST('XXX','BUG ')
32169      ENDIF
32170C
32171      READ(IATEMP(ISTRT:ILAST),IFORMT,ERR=9010)AVALUE
32172C
32173C     NOW CHECK FOR EXPONENTIAL POWER
32174C
32175      IF (IPOSE.GT.0 .AND. IPOWER.NE.0) THEN
32176         IF(IPOWER.GT.0)THEN
32177           AVALUE=AVALUE*10**IPOWER
32178         ELSEIF(IPOWER.LT.0)THEN
32179           IPOW2=-IPOWER
32180           AVALUE=AVALUE/(10**IPOW2)
32181         ENDIF
32182      ENDIF
32183C
32184      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'TREA')THEN
32185        WRITE(ICOUT,1091)IPOSE,IPOWER,AVALUE
32186 1091   FORMAT('EXTREA: IPOSE,IPOWER,AVALUE = ',3G15.7)
32187        CALL DPWRST('XXX','BUG ')
32188      ENDIF
32189C
32190      GOTO9090
32191C
32192 9010 CONTINUE
32193      WRITE(ICOUT,9013)
32194 9013 FORMAT('****** ERROR FROM READ CLIPBOARD (EXTREA)')
32195      CALL DPWRST('XXX','BUG ')
32196      WRITE(ICOUT,9015)
32197 9015 FORMAT('       UNABLE TO CONVERT STRING TO REAL NUMBER')
32198      CALL DPWRST('XXX','BUG ')
32199      IERROR='YES'
32200      GOTO9090
32201C
32202 9090 CONTINUE
32203      RETURN
32204      END
32205      SUBROUTINE EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,
32206     1                  JMIN,JMAX,
32207     1                  ISTACS,ISTANM,ISTANR,ISTADF,
32208     1                  IFOUND,ILOCV,ISUBRO,IBUGG3,IERROR)
32209C
32210C     PURPOSE--EXTRACT THE NAME OF ONE OF 90+ STATISTICS.  THIS
32211C              IS A COMMON ROUTINE CALLED BY:
32212C                1) CKSTAT  = LET A = <STAT>
32213C                2) DPSP    = <STAT> STATISTIC PLOT
32214C                3) DPCRPL  = CROSS TABULATE <STAT> PLOT
32215C                4) DPFLUC  = FLUCTUATION PLOT <STAT>
32216C                5) DPBLOC  = <STAT> BLOCK PLOT
32217C                6) DPJBSP  = BOOTSTRAP <STAT> PLOT
32218C                           = JACKNIFE <STAT> PLOT
32219C                7) DPDEXP  = DEX <STAT> PLOT
32220C                8) DPINCU  = <STAT> INFLUENCE CURVE
32221C                9) DPTABU  = TABULATE <MEAN>
32222C               10) DPCRTA  = CROSS TABULATE <STAT>
32223C               11) DPPOTA  = POSITIONAL TABULATION <STAT>
32224C               12) CKMATH  = MATRIX COLUMN <STAT>
32225C               13) CKMATH  = MATRIX ROW <STAT>
32226C               14) CKMATH  = MATRIX GRAND <STAT>
32227C               15) CKMATH  = MATRIX PARTITION <STAT>
32228C               16) CKMATH  = LET V = CROSS TABULATE <STAT>
32229C               17) CKMATH  = LET V = CROSS TABULATE CUMULATIVE <STAT>
32230C               18) CKMATH  = LET V = SORT BY <STAT>
32231C               19) CKMATH  = LET V = MOVING <STAT>
32232C               20) CKMATH  = LET V = CUMULATIVE <STAT>
32233C               21) DPISP   = <STAT> INTERACTION PLOT
32234C
32235C              NOTE THAT THE DEX ... PLOT, ... BLOCK PLOT, AND
32236C              ... INFLUENCE CURVE, MATRIX <COLUMN/ROW> ONLY SUPPORT
32237C              STATISTICS COMPUTED FROM A SINGLE RESPONSE VARIABLE.
32238C              ALSO, SOME COMMANDS MAY NOT SUPPORT ALL STATISTICS IN
32239C              THIS LIST (OR, LESS FREQUENTLY, A COMMAND MAY SUPPORT
32240C              SOME ADDITIONAL STATISTICS NOT COMPUTED HERE).
32241C
32242C              USING A COMMON ROUTINE MAKES IT EASIER TO ADD
32243C              A STATISTIC AND INCORPORATE IT INTO ALL THE
32244C              RELEVANT PLOTS/TABULATIONS.  SHOULD ALSO REDUCE
32245C              THE LIKELIHOOD OF BUGS, ETC.
32246C
32247C              FOLLOWING STATISTICS ARE SUPPORTED:
32248C
32249C              CASE 1: ONE RESPONSE VARIABLE
32250C
32251C              LOCATION STATISTICS:
32252C                 BIWEIGHT LOCATION
32253C                 GEOMETRIC MEAN
32254C                 H10 LOCATION
32255C                 H12 LOCATION
32256C                 H15 LOCATION
32257C                 H17 LOCATION
32258C                 H20 LOCATION
32259C                 HARMONIC MEAN
32260C                 HODGES-LEHMAN
32261C                 JSCORE
32262C                 LP LOCATION
32263C                 MEAN (OR AVERAGE)
32264C                 MEDIAN
32265C                 MIDHINGE
32266C                 MIDMEAN
32267C                 MIDRANGE
32268C                 SHORTEST HALF MIDMEAN
32269C                 SHORTEST HALF MIDRANGE
32270C                 STANDARD DEVIATION OF LP LOCATION
32271C                 STANDARD DEVIATION OF THE MEAN
32272C                 TRIMEAN
32273C                 TRIMMED MEAN
32274C                 TRIMMED MEAN STANDARD ERROR
32275C                 VARIANCE OF THE MEAN
32276C                 VARIANCE OF LP LOCATION
32277C                 WINSORIZED MEAN
32278C
32279C              SCALE STATISTICS:
32280C                 AVERAGE ABSOLUTE DEVIATION (AAD)
32281C                 AVERAGE ABSOLUTE DEVIATION FROM THE MEDIAN
32282C                 BIWEIGHT MIDVARIANCE
32283C                 BIWEIGHT SCALE
32284C                 COEFFICIENT OF DISPERSION
32285C                 COEFFICIENT OF VARIATION
32286C                 GEOMETRIC STANDARD DEVIATION
32287C                 H10 SCALE
32288C                 H12 SCALE
32289C                 H15 SCALE
32290C                 H17 SCALE
32291C                 H20 SCALE
32292C                 INDEX OF DISPERSION
32293C                 INTERQUARTILE RANGE
32294C                 LOGNORMAL COEFFICIENT OF VARIATION
32295C                 LOWER SEMI-INTERQUARTILE RANGE
32296C                 MAD TO MEDIAN
32297C                 MEDIAN ABSOLUTE DEVIATION (MAD)
32298C                 PERCENTAGE BEND MIDVARIANCE
32299C                 PRECISION
32300C                 QN
32301C                 Q QUANTILE RANGE
32302C                 QUARTILE COEFFICIENT OF DISPERSION
32303C                 RANGE
32304C                 RELATIVE LABORATORY PERFORMANCE (RLP)
32305C                 RELATIVE SD
32306C                 RELATIVE VARIANCE
32307C                 RESCALED SUM
32308C                 ROBUST POOLED RANGE
32309C                 ROBUST POOLED STANDARD DEVIATION
32310C                 ROOT MEAN SQUARE ERROR (OR RMS)
32311C                 SCALED MEDIAN ABSOLUTE DEVIATION (MADe)
32312C                 SIGNAL TO NOISE RATIO
32313C                 SN
32314C                 STANDARD DEVIATION (OR SD)
32315C                 SUM OF SQUARES
32316C                 SUM OF SQUARES FROM MEAN
32317C                 TRIMMED SD
32318C                 UNBIASED COEFFICIENT OF VARIATION
32319C                 UPPER SEMI-INTERQUARTILE RANGE
32320C                 VARIANCE
32321C                 WINSORIZED STANDARD DEVIATION
32322C                 WINSORIZED VARIANCE
32323C
32324C              PERCENTILE STATISTICS
32325C                 FIRST/SECOND/THIRD/FOURTH/FIFTH/SIXTH/SEVENTH/
32326C                       EIGHTH/NINTH DECILE
32327C                 DECILE RATIO
32328C                 EXTREME
32329C                 INDEX MINIMUM
32330C                 INDEX MAXIMUM
32331C                 INDEX EXTREME
32332C                 LOWER HINGE
32333C                 LOWER QUARTILE
32334C                 MINIMUM (MIN)
32335C                 MAXIMUM (MAX)
32336C                 <VALUE> PERCENTILE
32337C                 QUANTILE STANDARD ERROR
32338C                 UPPER HINGE
32339C                 UPPER QUARTILE
32340C
32341C              HIGHER MOMENTS
32342C                 GALTON SKEWNESS
32343C                 KURTOSIS
32344C                 PEARSON TWO SKEWNESS
32345C                 SKEWNESS
32346C
32347C              TIME SERIES STATISTICS
32348C                 AUTOCORRELATION
32349C                 AUTOCOVARIANCE
32350C                 SINE FREQUENCY
32351C                 SINE AMPLITUDE
32352C
32353C              QUALITY CONTROL STATISTICS
32354C                 CC
32355C                 CNP
32356C                 CNPK
32357C                 CNPM
32358C                 CNPMK
32359C                 CP
32360C                 CPK
32361C                 CPL
32362C                 CPM
32363C                 CPMK
32364C                 CPU
32365C                 EXPECTED LOSS
32366C                 (ACTUAL) PERCENT DEFECTIVE
32367C                 (THEORETICAL) PERCENT DEFECTIVE
32368C                 TAGUCHI SIGNAL-TO-NOISE (SN+, SN-, SN0, SN00)
32369C
32370C              STATISTICAL TESTS:
32371C                 A BASIS NORMAL
32372C                 A BASIS LOGNORMAL
32373C                 A BASIS WEIBULL
32374C                 A BASIS NONPARAMETRIC
32375C                 B BASIS NORMAL
32376C                 B BASIS LOGNORMAL
32377C                 B BASIS WEIBULL
32378C                 B BASIS NONPARAMETRIC
32379C                 ADJANCENCY RANDOMNESS TEST
32380C                 ADJANCENCY RANDOMNESS TEST CDF
32381C                 ADJANCENCY RANDOMNESS TEST PVALUE
32382C                 BINOMIAL PROPORTIONS
32383C                 BINOMIAL PROPORTIONS LOWER CONFIDENCE LIMIT
32384C                 BINOMIAL PROPORTIONS UPPER CONFIDENCE LIMIT
32385C                 CHI-SQUARE SD TEST
32386C                 CHI-SQUARE SD TEST CDF
32387C                 CHI-SQUARE SD TEST PVALUE
32388C                 CHI-SQUARE SD TEST LOWER TAIL PVALUE
32389C                 CHI-SQUARE SD TEST UPPER TAIL PVALUE
32390C                 CUMULATIVE SUM FORWARD TEST
32391C                 CUMULATIVE SUM FORWARD TEST PVALUE
32392C                 CUMULATIVE SUM BACKWARD TEST
32393C                 CUMULATIVE SUM BACKWARD TEST PVALUE
32394C                 DAVID
32395C                 DAVID CDF
32396C                 DAVID CRITICAL VALUE
32397C                 DAVID MINIMUM INDEX
32398C                 DAVID MAXIMUM INDEX
32399C                 DAVID PVALUE
32400C                 DIXON TEST
32401C                 DIXON MINIMUM TEST
32402C                 DIXON MAXIMUM TEST
32403C                 EXTREME STUDENTIZED DEVIATE
32404C                 FREQUENCY TEST
32405C                 FREQUENCY TEST CDF
32406C                 FREQUENCY WITHIN A BLOCK TEST
32407C                 FREQUENCY WITHIN A BLOCK TEST CDF
32408C                 GRUBB
32409C                 GRUBB CDF
32410C                 GRUBB DIRECTION
32411C                 GRUBB INDEX
32412C                 JARQUE BERA
32413C                 JARQUE BERA PVALUE
32414C                 JARQUE BERA CDF
32415C                 KURTOSIS OUTLIER
32416C                 KURTOSIS OUTLIER CDF
32417C                 KURTOSIS OUTLIER CRITICAL VALUE
32418C                 KURTOSIS OUTLIER INDEX
32419C                 KURTOSIS OUTLIER PVALUE
32420C                 LOWER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
32421C                 LOWER COEFFICIENT OF QUARTILE DISPERSION CONFIDENCE LIMIT
32422C                 LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMIT
32423C                 LOWER CONFIDENCE LIMIT
32424C                 LOWER LOGNORMAL COEFFICIENT OF VARIATION CONFIDENCE LIMIT
32425C                 LOWER BONETT STANDARD DEVIATION CONFIDENCE LIMIT
32426C                 LOWER PREDICTION BOUND
32427C                 LOWER PREDICTION LIMIT
32428C                 LOWER STANDARD DEVIATION CONFIDENCE LIMIT
32429C                 LOWER STANDARD DEVIATION PREDICTION LIMIT
32430C                 LJUNG BOX TEST
32431C                 MCCOOL WEIBULL LOCATION TEST
32432C                 MCCOOL WEIBULL LOCATION TEST PVALUE
32433C                 MCCOOL WEIBULL LOCATION TEST CDF
32434C                 MCCOOL WEIBULL LOCATION TEST CV50
32435C                 MCCOOL WEIBULL LOCATION TEST CV90
32436C                 MCCOOL WEIBULL LOCATION TEST CV95
32437C                 MEAN SUCCESSIVE DIFFERENCE
32438C                 MEAN SUCCESSIVE DIFFERENCE NORMALIZED
32439C                 MEAN SUCCESSIVE DIFFERENCE CDF
32440C                 MEAN SUCCESSIVE DIFFERENCE PVALUE
32441C                 NORMAL TOLERANCE K FACTOR
32442C                 NORMAL TOLERANCE LOWER LIMIT
32443C                 NORMAL TOLERANCE UPPER LIMIT
32444C                 NORMAL TOLERANCE ONE SIDED K FACTOR
32445C                 NORMAL TOLERANCE ONE SIDED LOWER LIMIT
32446C                 NORMAL TOLERANCE ONE SIDED UPPER LIMIT
32447C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST
32448C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST CDF
32449C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST PVALUE
32450C                 ONE SAMPLE COEFFICIENT OF VARIATION LOWER PVALUE
32451C                 ONE SAMPLE COEFFICIENT OF VARIATION UPPER PVALUE
32452C                 ONE SAMPLE SIGN TEST
32453C                 ONE SAMPLE SIGN TEST CDF
32454C                 ONE SAMPLE SIGN TEST PVALUE
32455C                 ONE SAMPLE SIGN TEST LOWER TAIL PVALUE
32456C                 ONE SAMPLE SIGN TEST UPPER TAIL PVALUE
32457C                 ONE SAMPLE T-TEST
32458C                 ONE SAMPLE T-TEST CDF
32459C                 ONE SAMPLE T-TEST PVALUE
32460C                 ONE SAMPLE T-TEST LOWER TAIL PVALUE
32461C                 ONE SAMPLE T-TEST UPPER TAIL PVALUE
32462C                 ONE SAMPLE WILCOXON SIGNED RANK TEST
32463C                 ONE SAMPLE WILCOXON SIGNED RANK TEST CDF
32464C                 ONE SAMPLE WILCOXON SIGNED RANK TEST PVALUE
32465C                 ONE SAMPLE WILCOXON SIGNED RANK TEST LOWER TAIL PVALUE
32466C                 ONE SAMPLE WILCOXON SIGNED RANK TEST UPPER TAIL PVALUE
32467C                 ONE-SIDED LOWER AGRESTI-COUL
32468C                 ONE-SIDED UPPER AGRESTI-COUL
32469C                 ONE-SIDED LOWER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
32470C                 ONE-SIDED LOWER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
32471C                 ONE-SIDED UPPER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
32472C                 ONE-SIDED LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMIT
32473C                 ONE-SIDED UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMIT
32474C                 ONE-SIDED LOWER CONFIDENCE LIMIT
32475C                 ONE-SIDED UPPER CONFIDENCE LIMIT
32476C                 ONE-SIDED LOWER EXACT BINOMIAL
32477C                 ONE-SIDED UPPER EXACT BINOMIAL
32478C                 ONE-SIDED LOWER PREDICTION BOUND
32479C                 ONE-SIDED LOWER STANDARD DEVIATION CONFIDENCE LIMIT
32480C                 ONE-SIDED LOWER STANDARD DEVIATION PREDICTION LIMIT
32481C                 ONE-SIDED UPPER PREDICTION BOUND
32482C                 ONE-SIDED LOWER PREDICTION LIMIT
32483C                 ONE-SIDED UPPER PREDICTION LIMIT
32484C                 ONE-SIDED UPPER STANDARD DEVIATION CONFIDENCE LIMIT
32485C                 ONE-SIDED UPPER STANDARD DEVIATION PREDICTION LIMIT
32486C                 POISSON DISPERSION TEST
32487C                 POISSON DISPERSION TEST CDF
32488C                 POISSON DISPERSION TEST CDF PVALUE
32489C                 SKEW OUTLIER
32490C                 SKEW OUTLIER CDF
32491C                 SKEW OUTLIER CRITICAL VALUE
32492C                 SKEW OUTLIER INDEX
32493C                 SKEW OUTLIER PVALUE
32494C                 TWO-SIDED LOWER AGRESTI-COUL
32495C                 TWO-SIDED UPPER AGRESTI-COUL
32496C                 TWO-SIDED LOWER EXACT BINOMIAL
32497C                 TWO-SIDED UPPER EXACT BINOMIAL
32498C                 UPPER COEFFICIENT OF DISPERSION CONFIDENCE LIMIT
32499C                 UPPER COEFFICIENT OF QUARTILE DISPERSION CONFIDENCE LIMIT
32500C                 UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMIT
32501C                 UPPER CONFIDENCE LIMIT
32502C                 UPPER LOGNORMAL COEFFICIENT OF VARIATION CONFIDENCE LIMIT
32503C                 UPPER BONETT STANDARD DEVIATION CONFIDENCE LIMIT
32504C                 UPPER PREDICTION BOUND
32505C                 UPPER PREDICTION LIMIT
32506C                 UPPER STANDARD DEVIATION CONFIDENCE LIMIT
32507C                 UPPER STANDARD DEVIATION PREDICTION LIMIT
32508C                 WILK SHAPIRO TEST
32509C                 WILK SHAPIRO TEST PVALUE
32510C
32511C              SPATIAL DATA:
32512C                 RELATIVE DISPERSION INDEX
32513C                 UNIFORM CHI-SQUARE
32514C                 VARIATIONAL DISTANCE
32515C
32516C              DISTRIBUTION:
32517C                 BOX COX NORMALITY  PPCC
32518C                 BOX COX NORMALITY  LAMBDA
32519C                 KAPPENMAN R
32520C                 KAPPENMAN R CUTOFF
32521C
32522C                 ANGLIT             PPCC
32523C                 ANGLIT             PPCC LOCATION
32524C                 ANGLIT             PPCC SCALE
32525C                 ARCSINE            PPCC
32526C                 ARCSINE            PPCC LOCATION
32527C                 ARCSINE            PPCC SCALE
32528C                 CAUCHY             PPCC
32529C                 CAUCHY             PPCC LOCATION
32530C                 CAUCHY             PPCC SCALE
32531C                 COSINE             PPCC
32532C                 COSINE             PPCC LOCATION
32533C                 COSINE             PPCC SCALE
32534C                 DOUBLE EXPONENTIAL PPCC
32535C                 DOUBLE EXPONENTIAL PPCC LOCATION
32536C                 DOUBLE EXPONENTIAL PPCC SCALE
32537C                 EXPONENTIAL        PPCC
32538C                 EXPONENTIAL        PPCC LOCATION
32539C                 EXPONENTIAL        PPCC SCALE
32540C                 FATIGUE LIFE       PPCC LOCATION
32541C                 FATIGUE LIFE       PPCC SCALE
32542C                 FATIGUE LIFE       PPCC SHAPE
32543C                 FATIGUE LIFE       PPCC STATISITC
32544C                 GAMMA              PPCC LOCATION
32545C                 GAMMA              PPCC SCALE
32546C                 GAMMA              PPCC SHAPE
32547C                 GAMMA              PPCC STATISTIC
32548C                 GENERALIZED PARETO PPCC LOCATION
32549C                 GENERALIZED PARETO PPCC SCALE
32550C                 GENERALIZED PARETO PPCC SHAPE
32551C                 GENERALIZED PARETO PPCC STATISITC
32552C                 GH                 PPCC LOCATION
32553C                 GH                 PPCC SCALE
32554C                 GH                 PPCC SHAPE ONE
32555C                 GH                 PPCC SHAPE TWO
32556C                 GH                 PPCC STATISTIC
32557C                 HALF-NORMAL        PPCC
32558C                 HALF-NORMAL        PPCC LOCATION
32559C                 HALF-NORMAL        PPCC SCALE
32560C                 HALF-CAUCHY        PPCC
32561C                 HALF-CAUCHY        PPCC LOCATION
32562C                 HALF-CAUCHY        PPCC SCALE
32563C                 HYPERBOLIC SECANT  PPCC
32564C                 HYPERBOLIC SECANT  PPCC LOCATION
32565C                 HYPERBOLIC SECANT  PPCC SCALE
32566C                 INVERTED WEIBULL   PPCC LOCATION
32567C                 INVERTED WEIBULL   PPCC SCALE
32568C                 INVERTED WEIBULL   PPCC SHAPE
32569C                 INVERTED WEIBULL   PPCC STATISTIC
32570C                 LOGISITC           PPCC
32571C                 LOGISITC           PPCC LOCATION
32572C                 LOGISITC           PPCC SCALE
32573C                 LOGNORMAL          PPCC LOCATION
32574C                 LOGNORMAL          PPCC SCALE
32575C                 LOGNORMAL          PPCC SHAPE
32576C                 LOGNORMAL          PPCC STATISTIC
32577C                 MAXWELL            PPCC
32578C                 MAXWELL            PPCC LOCATION
32579C                 MAXWELL            PPCC SCALE
32580C                 MINIMUM GUMBEL     PPCC
32581C                 MINIMUM GUMBEL     PPCC LOCATION
32582C                 MINIMUM GUMBEL     PPCC SCALE
32583C                 MAXIMUM GUMBEL     PPCC
32584C                 MAXIMUM GUMBEL     PPCC LOCATION
32585C                 MAXIMUM GUMBEL     PPCC SCALE
32586C                 NORMAL             PPCC
32587C                 NORMAL             PPCC LOCATION
32588C                 NORMAL             PPCC SCALE
32589C                 RAYLEIGH           PPCC
32590C                 RAYLEIGH           PPCC LOCATION
32591C                 RAYLEIGH           PPCC SCALE
32592C                 SEMI-CIRCULAR      PPCC
32593C                 SEMI-CIRCULAR      PPCC LOCATION
32594C                 SEMI-CIRCULAR      PPCC SCALE
32595C                 SINE               PPCC
32596C                 SINE               PPCC LOCATION
32597C                 SINE               PPCC SCALE
32598C                 SLASH              PPCC
32599C                 SLASH              PPCC LOCATION
32600C                 SLASH              PPCC SCALE
32601C                 TUKEY-LAMBDA       PPCC LOCATION
32602C                 TUKEY-LAMBDA       PPCC SCALE
32603C                 TUKEY-LAMBDA       PPCC SHAPE
32604C                 TUKEY-LAMBDA       PPCC STATISTIC
32605C                 UNIFORM            PPCC
32606C                 UNIFORM            PPCC LOCATION
32607C                 UNIFORM            PPCC SCALE
32608C                 WALD               PPCC LOCATION
32609C                 WALD               PPCC SCALE
32610C                 WALD               PPCC SHAPE
32611C                 WALD               PPCC STATISTIC
32612C                 WEIBULL            PPCC LOCATION
32613C                 WEIBULL            PPCC SCALE
32614C                 WEIBULL            PPCC SHAPE
32615C                 WEIBULL            PPCC STATISTIC
32616C                 2PAR WEIBULL       PPCC SCALE
32617C                 2PAR WEIBULL       PPCC SHAPE
32618C                 2PAR WEIBULL       PPCC STATISTIC
32619C
32620C                 DOUBLE EXPONENTIAL ANDERSON DARLING
32621C                 DOUBLE EXPONENTIAL ANDERSON DARLING LOCATION
32622C                 DOUBLE EXPONENTIAL ANDERSON DARLING SCALE
32623C                 EXPONENTIAL        ANDERSON DARLING
32624C                 EXPONENTIAL        ANDERSON DARLING LOCATION
32625C                 EXPONENTIAL        ANDERSON DARLING SCALE
32626C                 GAMMA (2-PAR)      ANDERSON DARLING
32627C                 GAMMA (2-PAR)      ANDERSON DARLING LOCATION
32628C                 GAMMA (2-PAR)      ANDERSON DARLING SCALE
32629C                 GUMBEL             ANDERSON DARLING
32630C                 GUMBEL             ANDERSON DARLING LOCATION
32631C                 GUMBEL             ANDERSON DARLING SCALE
32632C                 LOGISTIC           ANDERSON DARLING
32633C                 LOGISTIC           ANDERSON DARLING LOCATION
32634C                 LOGISTIC           ANDERSON DARLING SCALE
32635C                 LOGNORMAL (2-PAR)  ANDERSON DARLING
32636C                 LOGNORMAL (2-PAR)  ANDERSON DARLING LOCATION
32637C                 LOGNORMAL (2-PAR)  ANDERSON DARLING SCALE
32638C                 MAXWELL            ANDERSON DARLING
32639C                 MAXWELL            ANDERSON DARLING LOCATION
32640C                 MAXWELL            ANDERSON DARLING SCALE
32641C                 NORMAL             ANDERSON DARLING
32642C                 NORMAL             ANDERSON DARLING LOCATION
32643C                 NORMAL             ANDERSON DARLING SCALE
32644C                 RAYLEIGH           ANDERSON DARLING
32645C                 RAYLEIGH           ANDERSON DARLING LOCATION
32646C                 RAYLEIGH           ANDERSON DARLING SCALE
32647C                 UNIFORM            ANDERSON DARLING
32648C                 UNIFORM            ANDERSON DARLING LOCATION
32649C                 UNIFORM            ANDERSON DARLING SCALE
32650C                 WEIBULL (2-PAR)    ANDERSON DARLING
32651C                 WEIBULL (2-PAR)    ANDERSON DARLING LOCATION
32652C                 WEIBULL (2-PAR)    ANDERSON DARLING SCALE
32653C
32654C
32655C              MISCELLANOUS:
32656C                 COMMON DIGITS
32657C                 INTERVAL COUNT
32658C                 INTEGRAL
32659C                 NUMBER (OR COUNT OR SIZE)
32660C                 PRODUCT
32661C                 RAW SHANNON DIVERSITY INDEX
32662C                 RAW SHANNON EQUITABILITY INDEX
32663C                 RAW SIMPSON DIVERSITY INDEX
32664C                 SHANNON DIVERSITY INDEX
32665C                 SHANNON EQUITABILITY INDEX
32666C                 SIMPSON DIVERSITY INDEX
32667C                 SUM
32668C                 UNIQUE (NUMBER OF DISTINCT VALUES)
32669C                 VALUE COUNT
32670C                 PYTHON MEAN
32671C
32672C              FOLLOWING ARE USED BY LET ... = CROSS TABULATE ...
32673C                 GROUP ONE
32674C                 GROUP TWO
32675C                 GROUP THREE
32676C                 GROUP FOUR
32677C                 GROUP FIVE
32678C                 GROUP SIX
32679C
32680C              CASE 2: TWO RESPONSE VARIABLES
32681C
32682C              GROUP STATISTICS
32683C                 COMMON COEFFICIENT OF VARIATION
32684C                 COMMON BIAS CORRECTED COEFFICIENT OF VARIATION
32685C
32686C              WEIGHTED STATISTICS:
32687C                 WEIGHTED MEAN
32688C                 WEIGHTED ORDER STATISTIC MEAN
32689C                 WEIGHTED STANDARD DEVIATION
32690C                 WEIGHTED SKEWNESS
32691C                 WEIGHTED SUM
32692C                 WEIGHTED SUM OF ABSOLUTE VALUES
32693C                 WEIGHTED SUM OF SQUARES
32694C                 WEIGHTED TRIMMED MEAN
32695C                 WEIGHTED VARIANCE
32696C
32697C              CO-RELATION:
32698C                 ANGULAR COSINE DISTANCE
32699C                 ANGULAR COSINE SIMILARITY
32700C                 BINARY ASYMMETRIC DICE MATCH DISSIMILARITY
32701C                 BINARY ASYMMETRIC DICE MATCH SIMILARITY
32702C                 BINARY ASYMMETRIC SOKOL MATCH DISSIMILARITY
32703C                 BINARY ASYMMETRIC SOKOL MATCH SIMILARITY
32704C                 BINARY GAMMA COEFFICIENT
32705C                 BINARY JACCARD DISSIMILARITY
32706C                 BINARY JACCARD SIMILARITY
32707C                 BINARY MATCH DISSIMILARITY
32708C                 BINARY MATCH SIMILARITY
32709C                 BINARY ROGERS MATCH DISSIMILARITY
32710C                 BINARY ROGERS MATCH SIMILARITY
32711C                 BINARY SOKAL MATCH DISSIMILARITY
32712C                 BINARY SOKAL MATCH SIMILARITY
32713C                 BIWEIGHT MIDCOVARIANCE
32714C                 BIWEIGHT MIDCORRELATION
32715C                 CANBERRA DISTANCE
32716C                 CHEBYCHEV DISTANCE
32717C                 COMOVEMENT
32718C                 CORRELATION
32719C                 CORRELATION ABSOLUTE VALUE
32720C                 CORRELATION PVALUE
32721C                 CORRELATION CDF
32722C                 CORRELATION RATIO
32723C                 COSINE DISTANCE
32724C                 COSINE SIMILARITY
32725C                 COVARIANCE
32726C                 DOT PRODUCT
32727C                 EUCLIDEAN DISTANCE
32728C                 EUCLIDEAN LENGTH
32729C                 GENERALIZED JACCARD COEFFICIENT
32730C                 GENERALIZED JACCARD DISTANCE
32731C                 HAMMING DISTANCE
32732C                 INTRACLASS CORRELATION
32733C                 KENDALLS TAU (GAMMA CORRELATION COEFFICIENT)
32734C                 KENDALLS TAU A
32735C                 KENDALLS TAU B
32736C                 KENDALLS TAU C
32737C                 KENDALLS TAU ABSOLUTE VALUE
32738C                 KENDALLS TAU CDF
32739C                 KENDALLS TAU DISSIMILARITY
32740C                 KENDALLS TAU PVALUE
32741C                 KENDALLS TAU LOWER TAILED PVALUE
32742C                 KENDALLS TAU UPPER TAILED PVALUE
32743C                 MANHATTAN DISTANCE
32744C                 MINKOWSKI DISTANCE
32745C                 PERCENTAGE BEND CORRELATION
32746C                 PEARSON DISSIMILARITY
32747C                 PEARSON SIMILARITY
32748C                 RANK CORRELATION
32749C                 RANK CORRELATION ABSOLUTE VALUE
32750C                 RANK CORRELATION CDF
32751C                 RANK CORRELATION PVALUE
32752C                 RANK CORRELATION LOWER TAILED PVALUE
32753C                 RANK CORRELATION UPPER TAILED PVALUE
32754C                 RANK COMOVEMENT
32755C                 RANK COVARIANCE
32756C                 SPEARMAN DISSIMILARITY
32757C                 WINSORIZED COVARIANCE
32758C                 WINSORIZED CORRELATION
32759C                 YOUDEN INDEX
32760C                 YULES Q (BINARY GAMMA COEFFICIENT)
32761C                 YULES Y
32762C
32763C              REGRESSION/FITTING:
32764C                 CONSTANT INTERCEPT
32765C                 CONSTANT INTERCEPT SD
32766C                 LINEAR CORRELATION
32767C                 LINEAR DISTINCT X
32768C                 LINEAR INTERCEPT
32769C                 LINEAR INTERCEPT SD
32770C                 LINEAR RESSD
32771C                 LINEAR SLOPE
32772C                 LINEAR SLOPE SD
32773C                 REPEATABILITY SD
32774C                 REPRODUCABILITY SD
32775C
32776C              CATEGORICAL DATA:
32777C                 CRAMER CONTINGENCY COEFFICIENT
32778C                 FALSE POSITIVE
32779C                 FALSE NEGATIVE
32780C                 LOG ODDS RATIO (BIAS CORRECTED LOG ODDS RATIO)
32781C                 NEGATIVE PREDICTIVE VALUE
32782C                 ODDS RATIO (BIAS CORRECTED ODDS RATIO)
32783C                 PEARSON CONTINGENCY COEFFICIENT
32784C                 PERCENTAGE AGREE
32785C                 PERCENTAGE DISAGREE
32786C                 POSITIVE PREDICTIVE VALUE
32787C                 RATIO (= SUM1/SUM2)
32788C                 RELATIVE RISK
32789C                 STANDARD ERROR LOG ODDS RATIO (STANDARD ERROR OF
32790C                     THE BIAS CORRECTED LOG ODDS RATIO)
32791C                 STANDARD ERROR ODDS RATIO (STANDARD ERROR OF THE
32792C                     BIAS CORRECTED ODDS RATIO)
32793C                 TRUE NEGATIVE
32794C                 TRUE POSITIVE
32795C                 TEST SENSITIVITY
32796C                 TEST SPECIFICITY
32797C
32798C              DIFFERENCE OF LOCATION:
32799C                 DIFFERENCE OF BIWEIGHT LOCATION
32800C                 DIFFERENCE OF GEOMETRIC MEANS
32801C                 DIFFERENCE OF H10 LOCATION
32802C                 DIFFERENCE OF H12 LOCATION
32803C                 DIFFERENCE OF H15 LOCATION
32804C                 DIFFERENCE OF H17 LOCATION
32805C                 DIFFERENCE OF H20 LOCATION
32806C                 DIFFERENCE OF HARMONIC MEANS
32807C                 DIFFERENCE OF HODGES-LEHMAN
32808C                 DIFFERENCE OF LP LOCATION
32809C                 DIFFERENCE OF MEANS
32810C                 DIFFERENCE OF MEDIANS
32811C                 DIFFERENCE OF MIDHINGE
32812C                 DIFFERENCE OF MIDMEAN
32813C                 DIFFERENCE OF SHORTEST MIDMEAN
32814C                 DIFFERENCE OF SHORTEST MIDRANGE
32815C                 DIFFERENCE OF TRIMEAN
32816C                 DIFFERENCE OF TRIMMED MEANS
32817C                 DIFFERENCE OF WINSORIZED MEANS
32818C                 HEDGES G
32819C
32820C              DIFFERENCE OF SCALE AND HIGHER MOMENTS:
32821C                 DIFFERENCE OF AAD
32822C                 DIFFERENCE OF AVERAGE ABSOLUTE DEVIATION MEDIAN
32823C                 DIFFERENCE OF BIWEIGHT MIDVARIANCE
32824C                 DIFFERENCE OF BIWEIGHT SCALE
32825C                 DIFFERENCE OF COEFFICIENT OF DISPERSION
32826C                 DIFFERENCE OF COEFFICIENT OF VARIATION
32827C                 DIFFERENCE OF EXTREMES
32828C                 DIFFERENCE OF GEOMETRIC SD
32829C                 DIFFERENCE OF H10 SCALE
32830C                 DIFFERENCE OF H12 SCALE
32831C                 DIFFERENCE OF H15 SCALE
32832C                 DIFFERENCE OF H17 SCALE
32833C                 DIFFERENCE OF H20 SCALE
32834C                 DIFFERENCE OF INDEX OF DISPERSION
32835C                 DIFFERENCE OF INTERQUARTILE RANGE
32836C                 DIFFERENCE OF KURTOSIS
32837C                 DIFFERENCE OF EXCESS KURTOSIS
32838C                 DIFFERENCE OF MAD
32839C                 DIFFERENCE OF MAD TO MEDIAN
32840C                 DIFFERENCE OF MAXIMUM
32841C                 DIFFERENCE OF MIDRANGE
32842C                 DIFFERENCE OF MINIMUM
32843C                 DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE
32844C                 DIFFERENCE OF PERCENTAGE BEND
32845C                 DIFFERENCE OF PRECISION
32846C                 DIFFERENCE OF QN
32847C                 DIFFERENCE OF QUANTILE
32848C                 DIFFERENCE OF QUARTILE COEFFICIENT OF DISPERSION
32849C                 DIFFERENCE OF RANGE
32850C                 DIFFERENCE OF RELATIVE SD
32851C                 DIFFERENCE OF RELATIVE VARIANCE
32852C                 DIFFERENCE OF RESCALED SUM
32853C                 DIFFERENCE OF ROOT MEAN SQUARE ERROR (OR RMS)
32854C                 DIFFERENCE OF SCALED MAD
32855C                 DIFFERENCE OF SD OF LP LOCATION
32856C                 DIFFERENCE OF SD OF MEAN
32857C                 DIFFERENCE OF SKEWNESS
32858C                 DIFFERENCE OF GALTON SKEWNESS
32859C                 DIFFERENCE OF PEARSON TWO SKEWNESS
32860C                 DIFFERENCE OF SN
32861C                 DIFFERENCE OF SIGNAL TO NOISE RATIO
32862C                 DIFFERENCE OF SUM OF SQUARES
32863C                 DIFFERENCE OF SUM OF SQUARES FROM MEAN
32864C                 DIFFERENCE OF STANDARD DEVIATIONS
32865C                 DIFFERENCE OF VARIANCES
32866C                 DIFFERENCE OF VARIANCE OF LP LOCATION
32867C                 DIFFERENCE OF VARIANCE OF THE MEAN
32868C                 DIFFERENCE OF WINSORIZED SD
32869C                 DIFFERENCE OF WINSORIZED VARIANCE
32870C
32871C              PERCENTILE STATISTICS
32872C                 GROUPED QUANTILE
32873C                 GROUPED PERCENTILE
32874C                 GROUPED DECILE RATIO
32875C
32876C              STATISTICAL TESTS
32877C                 ANDERSON DARLING K SAMPLE TEST
32878C                 ANDERSON DARLING K SAMPLE TEST CRITICAL VALUE
32879C                 BINOMIAL RATIO
32880C                 BIVARIATE CRAMER VON MISES 95 CRITICAL VALUE
32881C                 BIVARIATE CRAMER VON MISES 05 CRITICAL VALUE
32882C                 BIVARIATE CRAMER VON MISES TEST
32883C                 COCHRAN VARIANCE OUTLIER TEST
32884C                 COCHRAN VARIANCE OUTLIER CV95
32885C                 COCHRAN VARIANCE OUTLIER CV99
32886C                 COCHRAN VARIANCE OUTLIER PVALUE
32887C                 COCHRAN VARIANCE OUTLIER CDF
32888C                 COCHRAN MINIMUM VARIANCE OUTLIER TEST
32889C                 COCHRAN MINIMUM VARIANCE OUTLIER CV05
32890C                 COCHRAN MINIMUM VARIANCE OUTLIER CV01
32891C                 COCHRAN MINIMUM VARIANCE OUTLIER PVALUE
32892C                 COCHRAN MINIMUM VARIANCE OUTLIER CDF
32893C                 DIFFERENCE OF BINOMIAL PROPORTIONS
32894C                 DIFFERENCE OF BINOMIAL PROPORTIONS LOWER CONF LIMIT
32895C                 DIFFERENCE OF BINOMIAL PROPORTIONS UPPER CONF LIMIT
32896C                 F TEST
32897C                 F TEST CDF
32898C                 F TEST PVALUE
32899C                 FISHER TWO SAMPLE RANDOMIZATION TEST
32900C                 FISHER TWO SAMPLE RANDOMIZATION TEST PVALUE
32901C                 FISHER TWO SAMPLE RANDOMIZATION LOWER TAIL PVALUE
32902C                 GROUPED POISSON DISPERSION TEST
32903C                 GROUPED POISSON DISPERSION TEST CDF
32904C                 GROUPED POISSON DISPERSION TEST CDF PVALUE
32905C                 KLOTZ TEST
32906C                 KLOTZ TEST CDF
32907C                 KLOTZ TEST PVALUE
32908C                 KLOTZ TEST LOWER TAILED PVALUE
32909C                 KLOTZ TEST UPPER TAILED PVALUE
32910C                 KRUSKALL WALLIS TEST
32911C                 KRUSKALL WALLIS TEST CDF
32912C                 KRUSKALL WALLIS TEST PVALUE
32913C                 MANN WHITNEY RANK SUM TEST
32914C                 MANN WHITNEY RANK SUM TEST CDF
32915C                 MANN WHITNEY RANK SUM TEST PVALUE
32916C                 MANN WHITNEY RANK SUM LOWER TAIL PVALUE
32917C                 MANN WHITNEY RANK SUM UPPER TAIL PVALUE
32918C                 MANN WHITNEY U STATISTIC
32919C                 MEAN NEAREST NEIGHBOR DISTANCE CDF
32920C                 MEAN NEAREST NEIGHBOR DISTANCE PVALUE
32921C                 MEAN NEAREST NEIGHBOR DISTANCE TEST
32922C                 MEDIAN TEST
32923C                 MEDIAN TEST CDF
32924C                 MEDIAN TEST PVALUE
32925C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST
32926C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST CDF
32927C                 ONE SAMPLE COEFFICIENT OF VARIATION TEST PVALUE
32928C                 ONE SAMPLE COEFFICIENT OF VARIATION LOWER PVALUE
32929C                 ONE SAMPLE COEFFICIENT OF VARIATION UPPER PVALUE
32930C                 POLLARD ONE CDF
32931C                 POLLARD ONE PVALUE
32932C                 POLLARD ONE TEST
32933C                 POLLARD TWO CDF
32934C                 POLLARD TWO PVALUE
32935C                 POLLARD TWO TEST
32936C                 POLLARD THREE CDF
32937C                 POLLARD THREE PVALUE
32938C                 POLLARD THREE TEST
32939C                 POLLARD FOUR CDF
32940C                 POLLARD FOUR PVALUE
32941C                 POLLARD FOUR TEST
32942C                 POLLARD FIVE CDF
32943C                 POLLARD FIVE PVALUE
32944C                 POLLARD FIVE TEST
32945C                 RATIO OF MEANS
32946C                 RATIO OF MEANS LOWER CONFIDENCE LIMIT
32947C                 RATIO OF MEANS UPPER CONFIDENCE LIMIT
32948C                 SQUARED RANK TEST
32949C                 SQUARED RANK TEST CDF
32950C                 SQUARED RANK TEST PVALUE
32951C                 SQUARED RANK TEST LOWER TAILED PVALUE
32952C                 SQUARED RANK TEST UPPER TAILED PVALUE
32953C                 SUMMARY LOWER COEFFIENT OF VARIATION
32954C                 SUMMARY LOWER SD CONFIDENCE LIMITS
32955C                 SUMMARY LOWER SD PREDICTION LIMITS
32956C                 SUMMARY ONE SIDED LOWER SD CONFIDENCE LIMITS
32957C                 SUMMARY ONE SIDED LOWER SD PREDICTION LIMITS
32958C                 SUMMARY ONE SIDED UPPER SD CONFIDENCE LIMITS
32959C                 SUMMARY ONE SIDED UPPER SD PREDICTION LIMITS
32960C                 SUMMARY UPPER COEFFIENT OF VARIATION
32961C                 SUMMARY UPPER SD CONFIDENCE LIMITS
32962C                 SUMMARY UPPER SD PREDICTION LIMITS
32963C                 TWO SAMPLE CHI-SQUARE TEST
32964C                 TWO SAMPLE CHI-SQUARE TEST CDF
32965C                 TWO SAMPLE CHI-SQUARE TEST PVALUE
32966C                 TWO SAMPLE COEFFICIENT OF VARIATION TEST
32967C                 TWO SAMPLE COEFFICIENT OF VARIATION TEST CDF
32968C                 TWO SAMPLE COEFFICIENT OF VARIATION TEST PVALUE
32969C                 TWO SAMPLE COEFFICIENT OF VARIATION LOWER PVALUE
32970C                 TWO SAMPLE COEFFICIENT OF VARIATION UPPER PVALUE
32971C                 TWO SAMPLE KOLMOGOROV SMIRNOV TEST
32972C                 TWO SAMPLE KOLMOGOROV SMIRNOV CRITICAL VALUE
32973C                 TWO SAMPLE PAIRED T-TEST
32974C                 TWO SAMPLE PAIRED T-TEST CDF
32975C                 TWO SAMPLE PAIRED T-TEST PVALUE
32976C                 TWO SAMPLE PAIRED T-TEST LOWER TAIL PVALUE
32977C                 TWO SAMPLE PAIRED T-TEST UPPER TAIL PVALUE
32978C                 TWO SAMPLE SIGN TEST
32979C                 TWO SAMPLE SIGN TEST CDF
32980C                 TWO SAMPLE SIGN TEST PVALUE
32981C                 TWO SAMPLE SIGN TEST LOWER TAIL PVALUE
32982C                 TWO SAMPLE SIGN TEST UPPER TAIL PVALUE
32983C                 TWO SAMPLE T-TEST
32984C                 TWO SAMPLE T-TEST CDF
32985C                 TWO SAMPLE T-TEST PVALUE
32986C                 TWO SAMPLE T-TEST LOWER TAIL PVALUE
32987C                 TWO SAMPLE T-TEST UPPER TAIL PVALUE
32988C                 TWO SAMPLE WILCOXON SIGNED RANK TEST
32989C                 TWO SAMPLE WILCOXON SIGNED RANK TEST CDF
32990C                 TWO SAMPLE WILCOXON SIGNED RANK TEST PVALUE
32991C                 TWO SAMPLE WILCOXON SIGNED RANK TEST LOWER TAIL PVALUE
32992C                 TWO SAMPLE WILCOXON SIGNED RANK TEST UPPER TAIL PVALUE
32993C
32994C              DISTRIBUTION:
32995C                 COMMON WEIBULL SHAPE TEST
32996C                 COMMON WEIBULL SHAPE TEST CDF
32997C                 COMMON WEIBULL SHAPE TEST PVALUE
32998C                 COMMON WEIBULL SHAPE TEST CV90
32999C                 COMMON WEIBULL SHAPE TEST CV95
33000C                 COMMON WEIBULL SHAPE TEST CV99
33001C
33002C              CONSENSUS MEANS:
33003C                 DERSIMONIAN LAIRD
33004C                 DERSIMONIAN LAIRD STANDARD ERROR
33005C                 DERSIMONIAN LAIRD HHD
33006C                 DERSIMONIAN LAIRD MINMAX
33007C                 MANDEL PAULE
33008C                 MANDEL PAULE STANDARD ERROR
33009C                 MODIFIED MANDEL PAULE
33010C                 MODIFIED MANDEL PAULE STANDARD ERROR
33011C                 VANGEL RUKHIN
33012C                 VANGEL RUKHIN STANDARD ERROR
33013C                 GENERALIZED CONFIDENCE INTERVAL
33014C                 GENERALIZED CONFIDENCE INTERVAL STANDARD ERROR
33015C                 BOB
33016C                 BOB STANDARD ERROR
33017C                 BCP
33018C                 BCP STANDARD ERROR
33019C                 MEAN OF MEANS
33020C                 MEAN OF MEANS STANDARD ERROR
33021C                 FAIRWEATHER
33022C                 FAIRWEATHER STANDARD ERROR
33023C                 SCHILLER-EBERHARDT
33024C                 SCHILLER-EBERHARDT STANDARD ERROR
33025C                 GRAYBILL DEAL
33026C                 GRAYBILL DEAL SINHA STANDARD ERROR
33027C                 GRAYBILL DEAL NAIVE STANDARD ERROR
33028C                 GRAYBILL DEAL ZHANG ONE STANDARD ERROR
33029C                 GRAYBILL DEAL ZHANG TWO STANDARD ERROR
33030C
33031C              MISCELLANEOUS:
33032C                 DIFFERENCE OF COUNTS
33033C                 DIFFERENCE OF SUMS
33034C                 DIFFERENCE OF PRODUCTS
33035C                 DIFFERENCE OF INTEGRALS
33036C                 DIFFERENCE OF BINOMIAL PROBABILITIES
33037C                 INDEX FIRST MATCH
33038C                 INDEX LAST  MATCH
33039C                 INDEX FIRST NOT MATCH
33040C                 INDEX LAST  NOT MATCH
33041C                 PERCENTAGE DIFFERENCE OF MEAN
33042C
33043C              CASE 3: THREE RESPONSE VARIABLES
33044C
33045C              WEIGHTED STATISTICS:
33046C                 GROUPED CORRELATION
33047C                 WEIGHTED CORRELATION
33048C                 WEIGHTED COSINE DISTANCE
33049C                 WEIGHTED COSINE SIMILARITY
33050C                 WEIGHTED COVARIANCE
33051C
33052C              FIT/CORRELATION
33053C                 EQUAL SLOPES
33054C                 EQUAL SLOPES CDF
33055C                 EQUAL SLOPES CRITICAL VALUE
33056C                 EQUAL SLOPES ONE SIDED PVALUE
33057C                 EQUAL SLOPES TWO SIDED PVALUE
33058C                 PARTIAL CORRELATION
33059C                 PARTIAL CORRELATION ABSOLUTE VALUE
33060C                 PARTIAL CORRELATION CDF
33061C                 PARTIAL CORRELATION PVALUE
33062C                 PARTIAL KENDALL TAU CORRELATION
33063C                 PARTIAL KENDALL TAU CORRELATION ABSOLUTE VALUE
33064C                 PARTIAL RANK CORRELATION
33065C                 PARTIAL RANK CORRELATION ABSOLUTE VALUE
33066C
33067C              STATISTICAL TESTS
33068C                 FRIEDMAN TEST
33069C                 FRIEDMAN TEST CDF
33070C                 FRIEDMAN TEST PVALUE
33071C                 PAGE TEST
33072C                 PAGE MODIFIED TEST
33073C                 PAGE TEST CDF
33074C                 PAGE TEST PVALUE
33075C                 QUADE TEST
33076C                 QUADE TEST CDF
33077C                 QUADE TEST PVALUE
33078C                 SUMMARY LOWER COEFFIENT OF VARIATION CONFIDENCE LIMITS
33079C                 SUMMARY LOWER CONFIDENCE LIMITS
33080C                 SUMMARY LOWER PREDICTION BOUNDS
33081C                 SUMMARY LOWER PREDICTION LIMITS
33082C                 SUMMARY NORMAL TOLERANCE K FACTOR
33083C                 SUMMARY NORMAL TOLERANCE LOWER LIMIT
33084C                 SUMMARY NORMAL TOLERANCE UPPER LIMIT
33085C                 SUMMARY NORMAL TOLERANCE ONE SIDED K FACTOR
33086C                 SUMMARY NORMAL TOLERANCE ONE SIDED LOWER LIMIT
33087C                 SUMMARY NORMAL TOLERANCE ONE SIDED UPPER LIMIT
33088C                 SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION CDF
33089C                 SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION PVALUE
33090C                 SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION TEST
33091C                 SUMMARY ONE SIDED LOWER CONFIDENCE LIMITS
33092C                 SUMMARY ONE SIDED LOWER PREDICTION BOUNDS
33093C                 SUMMARY ONE SIDED LOWER PREDICTION LIMITS
33094C                 SUMMARY ONE SIDED UPPER CONFIDENCE LIMITS
33095C                 SUMMARY ONE SIDED UPPER PREDICTION BOUNDS
33096C                 SUMMARY ONE SIDED UPPER PREDICTION LIMITS
33097C                 SUMMARY UPPER COEFFIENT OF VARIATION CONFIDENCE LIMITS
33098C                 SUMMARY UPPER CONFIDENCE LIMITS
33099C                 SUMMARY UPPER PREDICTION BOUNDS
33100C                 SUMMARY UPPER PREDICTION LIMITS
33101C
33102C              CONSENSUS MEANS
33103C                 ANDERSON DARLING K SAMPLE TEST
33104C                 SUMMARY DERSIMONIAN LAIRD
33105C                 SUMMARY DERSIMONIAN LAIRD STANDARD ERROR
33106C                 SUMMARY DERSIMONIAN LAIRD HHD
33107C                 SUMMARY DERSIMONIAN LAIRD MINMAX
33108C                 SUMMARY MANDEL PAULE
33109C                 SUMMARY MANDEL PAULE STANDARD ERROR
33110C                 SUMMARY MODIFIED MANDEL PAULE
33111C                 SUMMARY MODIFIED MANDEL PAULE STANDARD ERROR
33112C                 SUMMARY VANGEL RUKHIN
33113C                 SUMMARY VANGEL RUKHIN STANDARD ERROR
33114C                 SUMMARY GENERALIZED CONFIDENCE INTERVAL
33115C                 SUMMARY GENERALIZED CONFIDENCE INTERVAL STANDARD ERROR
33116C                 SUMMARY BOB
33117C                 SUMMARY BOB STANDARD ERROR
33118C                 SUMMARY BCP
33119C                 SUMMARY BCP STANDARD ERROR
33120C                 SUMMARY MEAN OF MEANS
33121C                 SUMMARY MEAN OF MEANS STANDARD ERROR
33122C                 SUMMARY FAIRWEATHER
33123C                 SUMMARY FAIRWEATHER STANDARD ERROR
33124C                 SUMMARY SCHILLER-EBERHARDT
33125C                 SUMMARY SCHILLER-EBERHARDT STANDARD ERROR
33126C                 SUMMARY GRAYBILL DEAL
33127C                 SUMMARY GRAYBILL DEAL SINHA STANDARD ERROR
33128C                 SUMMARY GRAYBILL DEAL NAIVE STANDARD ERROR
33129C                 SUMMARY GRAYBILL DEAL ZHANG ONE STANDARD ERROR
33130C                 SUMMARY GRAYBILL DEAL ZHANG TWO STANDARD ERROR
33131C
33132C     WRITTEN BY--ALAN HECKERT
33133C                 STATISTICAL ENGINEERING DIVISION
33134C                 INFORMATION TECHNOLOGY LABORATORY
33135C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33136C                 GAITHERSBURG, MD 20899-8980
33137C                 PHONE--301-975-2899
33138C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33139C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33140C     LANGUAGE--ANSI FORTRAN (1977)
33141C     VERSION NUMBER--2009/2
33142C     ORIGINAL VERSION--FEBRUARY  2009.
33143C     UPDATED         --JULY      2009. SUPPORT FOR H10, H12, H15,
33144C                                       H17, AND H20 LOCATION AND
33145C                                       SCALE ESTIMATES (AND
33146C                                       DIFFERENCE OF)
33147C     UPDATED         --SEPTEMBER 2009. QUANTILE AND PERCENTILE
33148C                                       COMMANDS CAN SUPPORT A
33149C                                       PARAMETER (E.G.,
33150C                                       LET X = XQ QUANTILE Y).
33151C                                       NEED TO ACCOUNT FOR THIS.
33152C     UPDATED         --NOVEMBER  2009. TIETJEN-MOORE TEST
33153C     UPDATED         --NOVEMBER  2009. EXTREME STUDENTIZED DEVIATE TEST
33154C     UPDATED         --JANUARY   2010. BINOMIAL RATIO
33155C     UPDATED         --JANUARY   2010. RMS AND DIFFERENCE OF RMS
33156C     UPDATED         --MARCH     2010. <ONE-SIDED/TWO-SIDED> <LOWER/UPPER>
33157C                                       AGRESTI-COUL
33158C     UPDATED         --MARCH     2010. <ONE-SIDED/TWO-SIDED> <LOWER/UPPER>
33159C                                       EXACT BINOMIAL
33160C     UPDATED         --MAY       2010. LINEAR INTERCEPT SD
33161C     UPDATED         --MAY       2010. LINEAR SLOPE     SD
33162C     UPDATED         --MAY       2010. LINEAR DISTINCT X
33163C     UPDATED         --JUNE      2010. VARIOUS CONSENSUS MEAN STATISTIC
33164C     UPDATED         --DECEMBER  2010. ROBUST POOLED SD
33165C     UPDATED         --DECEMBER  2010. ROBUST POOLED RANGE
33166C     UPDATED         --MARCH     2011. ANDERSON DARLING K SAMPLE TEST
33167C     UPDATED         --MARCH     2011. TWO SAMPLE KOLM SMIR TEST
33168C     UPDATED         --MARCH     2011. WILK SHAPIRO
33169C     UPDATED         --MARCH     2011. CUMULATIVE SUM
33170C     UPDATED         --MARCH     2011. NORMAL TOLERANCE LIMITS
33171C     UPDATED         --MARCH     2011. F-TEST
33172C     UPDATED         --APRIL     2011. TWO SAMPLE T-TEST
33173C     UPDATED         --APRIL     2011. ONE/TWO SAMPLE SIGN TEST
33174C     UPDATED         --MAY       2011. ABOUT A DOZEN ADDITIONAL PPCC
33175C     UPDATED         --MAY       2011. WILCOXON SIGNED RANK TEST
33176C     UPDATED         --MAY       2011. MANN WHITNEY RANK SUM TEST
33177C     UPDATED         --MAY       2011. KLOTZ TEST
33178C     UPDATED         --JUNE      2011. SQUARED RANK TEST
33179C     UPDATED         --JUNE      2011. MEDIAN TEST
33180C     UPDATED         --JUNE      2011. FISHER TWO SAMPLE RAND TEST
33181C     UPDATED         --JULY      2011. TWO SAMPLE CHI-SQUARE TEST
33182C     UPDATED         --JULY      2011. CHANGE ICASPL FOR LP LOCATION
33183C                                       TO AVOID CONFLICT WITH LEVEL
33184C                                       PLOT IN PLOTGE/PLOTG2
33185C     UPDATED         --JULY      2011. KRUSKALL WALLIS TEST
33186C     UPDATED         --JULY      2011. FRIEDMAN TEST
33187C     UPDATED         --JULY      2011. QUADE TEST
33188C     UPDATED         --JULY      2011. UNIQUE
33189C     UPDATED         --JULY      2011. PERCENTAGE AGREE
33190C                                       PERCENTAGE DISAGREE
33191C     UPDATED         --AUGUST    2011. SUMMARY NORMAL TOLERANCE LIMITS
33192C     UPDATED         --AUGUST    2011. CORRELATION ABSOLUTE VALUE
33193C     UPDATED         --NOVEMBER  2011. INDEX FIRST MATCH
33194C     UPDATED         --NOVEMBER  2011. INDEX LAST  MATCH
33195C     UPDATED         --NOVEMBER  2011. INDEX FIRST NOT MATCH
33196C     UPDATED         --NOVEMBER  2011. INDEX LAST  NOT MATCH
33197C     UPDATED         --DECEMBER  2011. SHANNON DIVERSITY INDEX
33198C     UPDATED         --DECEMBER  2011. SHANNON EQUITABILITY INDEX
33199C     UPDATED         --DECEMBER  2011. SIMPSON DIVERSITY INDEX
33200C     UPDATED         --DECEMBER  2011. JARQUE BERA
33201C     UPDATED         --FEBRUARY  2012. SUM OF SQUARES
33202C     UPDATED         --FEBRUARY  2012. RESCALED SUM
33203C     UPDATED         --FEBRUARY  2012. RELATIVE LABORATORY PERFORMANCE
33204C                                       (RLP)
33205C     UPDATED         --JUNE      2012. CORRELATION PVALUE
33206C     UPDATED         --JUNE      2012. CORRELATION CDF
33207C     UPDATED         --JUNE      2012. RANK CORRELATION ABSOLUTE VALUE
33208C     UPDATED         --JUNE      2012. KENDALL TAU CORRELATION
33209C                                       ABSOLUTE VALUE
33210C     UPDATED         --JUNE      2012. PARTIAL CORRELATION
33211C     UPDATED         --JUNE      2012. PARTIAL CORRELATION PVALUE
33212C     UPDATED         --JUNE      2012. PARTIAL CORRELATION CDF
33213C     UPDATED         --JUNE      2012. PARTIAL CORRELATION ABSOLUTE VALUE
33214C     UPDATED         --JUNE      2012. PARTIAL RANK CORRELATION
33215C     UPDATED         --JUNE      2012. PARTIAL RANK CORRELATION ABSO VALUE
33216C     UPDATED         --JUNE      2012. PARTIAL KENDALL TAU CORRELATION
33217C     UPDATED         --JUNE      2012. PARTIAL KENDALL TAU CORRELATION
33218C                                               ABSOLUTE VALUE
33219C     UPDATED         --JUNE      2012. WEIGHTED SUM
33220C     UPDATED         --JUNE      2012. WEIGHTED SUM OF SQUARES
33221C     UPDATED         --JUNE      2012. WEIGHTED SUM OF ABSOLUTE VALUES
33222C     UPDATED         --JUNE      2012. DIFFERENCE OF SUM OF SQUARES
33223C     UPDATED         --JUNE      2012. DIFFERENCE OF RESCALED SUM
33224C     UPDATED         --SEPTEMBER 2012. Q QUANTILE RANGE
33225C     UPDATED         --NOVEMBER  2012. WEIGHTED ORDER STATISTIC MEAN
33226C     UPDATED         --DECEMBER  2012. LOWER CONFIDENCE LIMIT
33227C     UPDATED         --DECEMBER  2012. ONE-SIDED LOWER CONFIDENCE
33228C                                       LIMIT
33229C     UPDATED         --DECEMBER  2012. UPPER CONFIDENCE LIMIT
33230C     UPDATED         --DECEMBER  2012. ONE-SIDED UPPER CONFIDENCE
33231C                                       LIMIT
33232C     UPDATED         --DECEMBER  2012. LOWER PREDICTION LIMIT
33233C     UPDATED         --DECEMBER  2012. ONE-SIDED LOWER PREDICTION
33234C                                       LIMIT
33235C     UPDATED         --DECEMBER  2012. UPPER PREDICTION LIMIT
33236C     UPDATED         --DECEMBER  2012. ONE-SIDED UPPER PREDICTION
33237C                                       LIMIT
33238C     UPDATED         --JANUARY   2013. NUMEROUS "PPCC" TYPE STATISTICS
33239C     UPDATED         --FEBRUARY  2013. NUMEROUS "PPCC" TYPE STATISTICS
33240C     UPDATED         --FEBRUARY  2013. LJUNG BOX TEST
33241C     UPDATED         --FEBRUARY  2013. PAGE TEST
33242C     UPDATED         --FEBRUARY  2013. KENDELL TAU CDF/PVALUE
33243C     UPDATED         --FEBRUARY  2013. SUM OF SQUARES FROM MEAN
33244C     UPDATED         --MARCH     2013. DIFFERENCE SUM OF SQUARES FROM MEAN
33245C     UPDATED         --MARCH     2013. PREDICTION BOUNDS
33246C     UPDATED         --MARCH     2013. SUMMARY PREDICTION LIMIT
33247C     UPDATED         --MARCH     2013. SUMMARY PREDICTION BOUNDS
33248C     UPDATED         --APRIL     2013. SD CONFIDENCE LIMITS
33249C     UPDATED         --APRIL     2013. SD PREDICTION LIMITS
33250C     UPDATED         --AUGUST    2013. MCCOOL WEIBULL LOCATION TEST
33251C     UPDATED         --OCTOBER   2013. CONSTANT INTERCEPT
33252C     UPDATED         --OCTOBER   2013. CONSTANT INTERCEPT SD
33253C     UPDATED         --NOVEMBER  2013. POISSON DISPERSION TEST
33254C     UPDATED         --NOVEMBER  2013. GROUPED POISSON DISPERSION TEST
33255C     UPDATED         --JANUARY   2014. BIVARIATE CRAMER VON MISES TEST
33256C     UPDATED         --JANUARY   2014. MEAN NEAREST NEIGHBOR DISTANCE
33257C                                       TEST
33258C     UPDATED         --JANUARY   2014. POLLARD TEST
33259C     UPDATED         --FEBRUARY  2014. VALUE COUNT
33260C     UPDATED         --MARCH     2014. VARIATIONAL DISTANCE
33261C     UPDATED         --MARCH     2014. RELATIVE DISPERSION INDEX
33262C     UPDATED         --MARCH     2014. UNIFORM CHI-SQUARE
33263C     UPDATED         --MARCH     2014. INTERDECILE RATIO
33264C     UPDATED         --MARCH     2014. GROUPED DECILE RATIO
33265C     UPDATED         --MARCH     2014. GROUPED PERCENTILE
33266C     UPDATED         --MARCH     2014. GROUPED QUANTILE
33267C     UPDATED         --APRIL     2014. COMMON WEIBULL SHAPE TEST
33268C     UPDATED         --MAY       2014. WEIGHTED SKEWNESS
33269C     UPDATED         --MAY       2014. KAPPENMAN R
33270C     UPDATED         --JULY      2014. BOX COX NORMALITY PPCC
33271C     UPDATED         --JULY      2014. BOX COX NORMALITY LAMBDA
33272C     UPDATED         --JULY      2014. AVERAGE ABSOLUTE DEVIATION
33273C                                       FROM THE MEDIAN
33274C     UPDATED         --JULY      2014. DIFFERENCE OF AVERAGE ABSOLUTE
33275C                                       DEVIATION FROM MEDIAN
33276C     UPDATED         --DECEMBER  2014. GALTON SKEWNESS
33277C     UPDATED         --DECEMBER  2014. PEARSON TWO SKEWNESS
33278C     UPDATED         --FEBRUARY  2015. BURR TYPE 10 ANDERSON DARLING
33279C     UPDATED         --FEBRUARY  2015. BURR TYPE 10 ANDERSON DARLING SHAPE
33280C     UPDATED         --FEBRUARY  2015. BURR TYPE 10 SCALE
33281C     UPDATED         --FEBRUARY  2015. DOUBLE EXPONENTIAL ANDERSON
33282C                                       DARLING
33283C     UPDATED         --FEBRUARY  2015. DOUBLE EXPONENTIAL ANDERSON
33284C                                       DARLING LOCATION
33285C     UPDATED         --FEBRUARY  2015. DOUBLE EXPONENTIAL ANDERSON
33286C                                       DARLING SCALE
33287C     UPDATED         --FEBRUARY  2015. EXPONENTIAL ANDERSON DARLING
33288C     UPDATED         --FEBRUARY  2015. EXPONENTIAL ANDERSON DARLING LOCATION
33289C     UPDATED         --FEBRUARY  2015. EXPONENTIAL ANDERSON DARLING SCALE
33290C     UPDATED         --FEBRUARY  2015. GAMMA ANDERSON DARLING
33291C     UPDATED         --FEBRUARY  2015. GAMMA ANDERSON DARLING SHAPE
33292C     UPDATED         --FEBRUARY  2015. GAMMA SCALE
33293C     UPDATED         --FEBRUARY  2015. FATIGUE LIFE ANDERSON DARLING
33294C     UPDATED         --FEBRUARY  2015. FATIGE LIFE ANDERSON DARLING SHAPE
33295C     UPDATED         --FEBRUARY  2015. FATIGUE LIFE SCALE
33296C     UPDATED         --FEBRUARY  2015. FRECHET ANDERSON DARLING
33297C     UPDATED         --FEBRUARY  2015. FRECHET ANDERSON DARLING SHAPE
33298C     UPDATED         --FEBRUARY  2015. FRECHET SCALE
33299C     UPDATED         --FEBRUARY  2015. GEOMETRIC EXPONENTIAL ANDERSON DARLING
33300C     UPDATED         --FEBRUARY  2015. GEOMETRIC EXPONENTIAL ANDERSON DARLING SHAPE
33301C     UPDATED         --FEBRUARY  2015. GEOMETRIC EXPONENTIAL SCALE
33302C     UPDATED         --FEBRUARY  2015. GUMBEL ANDERSON DARLING
33303C     UPDATED         --FEBRUARY  2015. GUMBEL ANDERSON DARLING LOCATION
33304C     UPDATED         --FEBRUARY  2015. GUMBEL SCALE
33305C     UPDATED         --FEBRUARY  2015. INVERTED GAMMA ANDERSON DARLING
33306C     UPDATED         --FEBRUARY  2015. INVERTED GAMMA ANDERSON DARLING SHAPE
33307C     UPDATED         --FEBRUARY  2015. INVERTED GAMMA SCALE
33308C     UPDATED         --FEBRUARY  2015. LOGISTIC ANDERSON DARLING
33309C     UPDATED         --FEBRUARY  2015. LOGISTIC ANDERSON DARLING LOCATION
33310C     UPDATED         --FEBRUARY  2015. LOGISTIC SCALE
33311C     UPDATED         --FEBRUARY  2015. LOGISTIC EXPONENTIAL ANDERSON DARLING
33312C     UPDATED         --FEBRUARY  2015. LOGISTIC EXPONENTIAL ANDERSON DARLING SHAPE
33313C     UPDATED         --FEBRUARY  2015. LOGISTIC EXPONENTIAL SCALE
33314C     UPDATED         --FEBRUARY  2015. LOGNORMAL ANDERSON DARLING
33315C     UPDATED         --FEBRUARY  2015. LOGNORMAL ANDERSON DARLING SHAPE
33316C     UPDATED         --FEBRUARY  2015. LOGNORMAL ANDERSON DARLING SCALE
33317C     UPDATED         --FEBRUARY  2015. MAXWELL ANDERSON DARLING
33318C     UPDATED         --FEBRUARY  2015. MAXWELL ANDERSON DARLING LOCATION
33319C     UPDATED         --FEBRUARY  2015. MAXWELL SCALE
33320C     UPDATED         --FEBRUARY  2015. NORMAL ANDERSON DARLING
33321C     UPDATED         --FEBRUARY  2015. NORMAL ANDERSON DARLING LOCATION
33322C     UPDATED         --FEBRUARY  2015. NORMAL ANDERSON DARLING SCALE
33323C     UPDATED         --FEBRUARY  2015. RAYLEIGH ANDERSON DARLING
33324C     UPDATED         --FEBRUARY  2015. RAYLEIGH ANDERSON DARLING LOCATION
33325C     UPDATED         --FEBRUARY  2015. RAYLEIGH SCALE
33326C     UPDATED         --FEBRUARY  2015. UNIFORM ANDERSON DARLING
33327C     UPDATED         --FEBRUARY  2015. UNIFORM ANDERSON DARLING LOCATION
33328C     UPDATED         --FEBRUARY  2015. UNIFORM SCALE
33329C     UPDATED         --FEBRUARY  2015. WEIBULL ANDERSON DARLING
33330C     UPDATED         --FEBRUARY  2015. WEIBULL ANDERSON DARLING SHAPE
33331C     UPDATED         --FEBRUARY  2015. WEIBULL ANDERSON DARLING SCALE
33332C     UPDATED         --FEBRUARY  2015. FOR RLP, SPECIFY 2 RESPONSE
33333C                                       VARIABLES
33334C     UPDATED         --FEBRUARY  2015. JSCORE STATISTIC
33335C     UPDATED         --MARCH     2015. COCHRAN VARIANCE OUTLIER TEST
33336C     UPDATED         --APRIL     2015. CPMK, CNP, CNPM, CNPMK
33337C     UPDATED         --OCTOBER   2015. EQUAL SLOPES TEST
33338C     UPDATED         --NOVEMBER  2015. DIFFERENCE OF EXCESS KURTOSIS
33339C     UPDATED         --NOVEMBER  2015. DIFFERENCE OF GALTON SKEWNESS
33340C     UPDATED         --NOVEMBER  2015. DIFFERENCE OF PEARSON TWO
33341C                                       SKEWNESS
33342C     UPDATED         --MARCH     2016. SCALED MAD
33343C     UPDATED         --MARCH     2016. NORMALIZED IQR
33344C     UPDATED         --MARCH     2016. DIFFERENCE OF SCALED MAD
33345C     UPDATED         --MARCH     2016. DIFFERENCE OF NORMALIZED IQR
33346C     UPDATED         --JUNE      2016. 2PARAMETER WEIBULL PPCC
33347C     UPDATED         --JUNE      2016. 2PARAMETER WEIBULL PPCC SCALE
33348C     UPDATED         --JUNE      2016. 2PARAMETER WEIBULL PPCC SHAPE
33349C     UPDATED         --AUGUST    2016. SUPPORT FOR FUNCTION BLOCKS
33350C     UPDATED         --DECEMBER  2016. COEFFICIENT OF VARIATION
33351C                                       CONFIDENCE LIMITS
33352C     UPDATED         --JANUARY   2017. UNBIASED COEFFICIENT OF VARIATION
33353C     UPDATED         --JANUARY   2017. SIGNAL TO NOISE RATIO
33354C     UPDATED         --JANUARY   2017. PRECISION
33355C     UPDATED         --JANUARY   2017. COEFFICIENT OF DISPERSION
33356C     UPDATED         --JANUARY   2017. QUARTILE COEFFICIENT OF
33357C                                       DISPERSION
33358C     UPDATED         --JANUARY   2017. INDEX OF DISPERSION
33359C     UPDATED         --JANUARY   2017. AAD TO MEDIAN
33360C     UPDATED         --FEBRUARY  2017. SHORTEST HALF MIDMEAN
33361C     UPDATED         --FEBRUARY  2017. SHORTEST HALF MIDRANGE
33362C     UPDATED         --FEBRUARY  2017. COMMON COEFFICIENT OF VARIATION
33363C     UPDATED         --FEBRUARY  2017. COMMON BIAS CORRECTED COEFFICIENT
33364C                                       OF VARIATION
33365C     UPDATED         --FEBRUARY  2017. LOWER COMMON COEFFICIENT OF
33366C                                       VARIATION CONFIDENCE LIMIT
33367C     UPDATED         --FEBRUARY  2017. UPPER COMMON COEFFICIENT OF
33368C                                       VARIATION CONFIDENCE LIMIT
33369C     UPDATED         --MARCH     2017. COSINE DISTANCE
33370C     UPDATED         --MARCH     2017. COSINE SIMILARITY
33371C     UPDATED         --MARCH     2017. ANGULAR COSINE DISTANCE
33372C     UPDATED         --MARCH     2017. ANGULAR COSINE SIMILARITY
33373C     UPDATED         --MARCH     2017. EUCLIDEAN DISTANCE
33374C     UPDATED         --MARCH     2017. EUCLIDEAN LENGTH
33375C     UPDATED         --MARCH     2017. DOT PRODUCT
33376C     UPDATED         --MARCH     2017. MANHATTAN DISTANCE
33377C     UPDATED         --MARCH     2017. DIFFERENCE OF PRECISION
33378C     UPDATED         --MARCH     2017. DIFFERENCE OF SNR
33379C     UPDATED         --JUNE      2017. PERCENTAGE DIFFERENCE OF MEAN
33380C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST
33381C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST CDF
33382C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI TEST PVALUE
33383C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI LOWER PVALUE
33384C     UPDATED         --JUNE      2017. ONE SAMPLE COEF OF VARI UPPER PVALUE
33385C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI TEST
33386C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI CDF
33387C     UPDATED         --JUNE      2017. SUMMARY ONE SAMPLE COEF OF VARI PVALUE
33388C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST
33389C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST CDF
33390C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI TEST PVALUE
33391C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI LOWER PVALUE
33392C     UPDATED         --JUNE      2017. TWO SAMPLE COEF OF VARI UPPER PVALUE
33393C     UPDATED         --JUNE      2017. DIFFERENCE OF AAD TO MEDIAN
33394C     UPDATED         --JUNE      2017. DIFFERENCE OF COEFFICIENT OF
33395C                                                  DISPERSION
33396C     UPDATED         --JUNE      2017. DIFFERENCE OF INDEX OF DISPERSION
33397C     UPDATED         --JUNE      2017. DIFFERENCE OF QUARTILE COEFFICIENT
33398C                                                  OF DISPERSION
33399C     UPDATED         --JULY      2017. HEDGES G
33400C     UPDATED         --JULY      2017. BIAS CORRECTED HEDGES G
33401C     UPDATED         --JULY      2017. COHENS D
33402C     UPDATED         --JULY      2017. GLASS G
33403C     UPDATED         --JULY      2017. MIDHINGE, TRIMEAN
33404C     UPDATED         --JULY      2017. DIFFERENCE OF MIDHINGE
33405C     UPDATED         --JULY      2017. DIFFERENCE OF TRIMEAN
33406C     UPDATED         --AUGUST    2017. PEARSON DISSIMILARITY
33407C     UPDATED         --AUGUST    2017. SPEARMAN DISSIMILARITY
33408C     UPDATED         --AUGUST    2017. KENDALL TAU DISSIMILARITY
33409C     UPDATED         --AUGUST    2017. BINARY MATCH DISSIMILARITY
33410C     UPDATED         --AUGUST    2017. BINARY MATCH SIMILARITY
33411C     UPDATED         --AUGUST    2017. BINARY ROGERS DISSIMILARITY
33412C     UPDATED         --AUGUST    2017. BINARY ROGERS SIMILARITY
33413C     UPDATED         --AUGUST    2017. BINARY SOKAL DISSIMILARITY
33414C     UPDATED         --AUGUST    2017. BINARY SOKAL SIMILARITY
33415C     UPDATED         --AUGUST    2017. BINARY JACCARD DISSIMILARITY
33416C     UPDATED         --AUGUST    2017. BINARY JACCARD SIMILARITY
33417C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC DICE DISSIMILARITY
33418C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC DICE SIMILARITY
33419C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC SOKAL DISSIMILARITY
33420C     UPDATED         --AUGUST    2017. BINARY ASYMMETRIC SOKAL SIMILARITY
33421C     UPDATED         --AUGUST    2017. GENERALZIED JACCARD COEFFICIENT
33422C     UPDATED         --AUGUST    2017. GENERALZIED JACCARD DISTANCE
33423C     UPDATED         --NOVEMBER  2017. DIFF OF BINO PROP LOWER CONF LIMIT
33424C     UPDATED         --NOVEMBER  2017. DIFF OF BINO PROP UPPER CONF LIMIT
33425C     UPDATED         --NOVEMBER  2017. COEFFICIENT OF DISPERSION
33426C                                       CONFIDENCE LIMITS
33427C     UPDATED         --DECEMBER  2017. COEFFICIENT OF QUARTILE DISPERSION
33428C                                       CONFIDENCE LIMITS
33429C     UPDATED         --JULY      2018. WEIGHTED COVARIANCE
33430C     UPDATED         --JULY      2018. WEIGHTED CORRELATION
33431C     UPDATED         --AUGUST    2018. PEARSON DISTANCE AS SYNONYM FOR
33432C                                       PEARSON DISSIMILARITY
33433C     UPDATED         --AUGUST    2018. HAMMING DISTANCE
33434C     UPDATED         --AUGUST    2018. WEIGHTED COSINE DISTANCE
33435C     UPDATED         --AUGUST    2018. CANBERRA DISTANCE
33436C     UPDATED         --OCTOBER   2018. INTERVAL COUNT SIMILARITY
33437C     UPDATED         --OCTOBER   2018. PEARSON SIMILARITY
33438C     UPDATED         --OCTOBER   2018. WEIGHTED COSINE SIMILARITY
33439C     UPDATED         --NOVEMBER  2018. GROUPED CORRELATION
33440C     UPDATED         --JANUARY   2019. PYTHON MEAN
33441C     UPDATED         --JULY      2019. LOWER SEMI-INTERQUARTILE RANGE
33442C     UPDATED         --JULY      2019. UPPER SEMI-INTERQUARTILE RANGE
33443C     UPDATED         --AUGUST    2019. GAMMA CORRELATION COEFFICIENT AS
33444C                                       SYNONYM FOR KENDALL'S TAU
33445C     UPDATED         --AUGUST    2019. BINARY GAMMA COEFFICIENT AS
33446C                                       SYNONYM FOR YULE'S Q
33447C     UPDATED         --AUGUST    2019. KENDALL TAU A
33448C     UPDATED         --AUGUST    2019. KENDALL TAU B
33449C     UPDATED         --AUGUST    2019. KENDALL TAU C
33450C     UPDATED         --AUGUST    2019. YULES Y
33451C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS
33452C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS LOWER CONFIDENCE
33453C                                       LIMIT
33454C     UPDATED         --SEPTEMBER 2019. RATIO OF MEANS UPPER CONFIDENCE
33455C                                       LIMIT
33456C     UPDATED         --OCTOBER   2019. DAVID TEST, DAVID TEST CDF
33457C     UPDATED         --OCTOBER   2019. DAVID TEST PVALUE
33458C     UPDATED         --OCTOBER   2019. DAVID TEST MINIMUM INDEX
33459C     UPDATED         --OCTOBER   2019. DAVID TEST MAXIMUM INDEX
33460C     UPDATED         --OCTOBER   2019. SKEW OUTLIER TEST
33461C     UPDATED         --OCTOBER   2019. SKEW OUTLIER CDF
33462C     UPDATED         --OCTOBER   2019. SKEW OUTLIER CRITICAL VALUE
33463C     UPDATED         --OCTOBER   2019. SKEW OUTLIER INDEX
33464C     UPDATED         --OCTOBER   2019. SKEW OUTLIER PVALUE
33465C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER TEST
33466C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER CDF
33467C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER CRITICAL VALUE
33468C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER INDEX
33469C     UPDATED         --OCTOBER   2019. KURTOSIS OUTLIER PVALUE
33470C
33471C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
33472C
33473      REAL ARG(*)
33474C
33475      CHARACTER*4 ICOM
33476      CHARACTER*4 ICOM2
33477      CHARACTER*4 IHARG(*)
33478      CHARACTER*4 IHARG2(*)
33479      CHARACTER*4 IARGT(*)
33480      CHARACTER*4 ISUBRO
33481      CHARACTER*4 IBUGG3
33482      CHARACTER*4 IERROR
33483C
33484      CHARACTER*4  ISTACS
33485      CHARACTER*4  ISTADF
33486      CHARACTER*60 ISTANM
33487      CHARACTER*4  IFOUND
33488C
33489      CHARACTER*4 IWRITE
33490      CHARACTER*4 ISUBN1
33491      CHARACTER*4 ISUBN2
33492C
33493C---------------------------------------------------------------------
33494C
33495      PARAMETER (MAXSTA=1557)
33496      PARAMETER (MAXSCL=8)
33497      INTEGER      INFLAV(MAXSTA)
33498      CHARACTER*4  INAME(MAXSTA,MAXSCL)
33499      CHARACTER*4  INCASE(MAXSTA)
33500      CHARACTER*60 INLONG(MAXSTA)
33501      CHARACTER*4  INTEMP(MAXSCL)
33502C
33503      CHARACTER*4 IPNAM1
33504      CHARACTER*4 IPNAM2
33505      COMMON/STATIS/APVAL,IPNAM1,IPNAM2
33506C
33507C-----COMMON----------------------------------------------------------
33508C
33509      INCLUDE 'DPCOPA.INC'
33510      INCLUDE 'DPCOSB.INC'
33511      INCLUDE 'DPCOP2.INC'
33512C
33513C     CREATE TABLE OF STATISTIC NAMES.
33514C
33515C       1) INCASE      = 4-CHARACTER CODE FOR STATISTIC
33516C       2) INAME       = MATCHING ENTRIES FOR STATISTIC.  NOTE
33517C                        THAT FIRST TWO ENTRIES ARE CHARACTERS
33518C                        1 - 4 AND 5 - 8, RESPECTIVELY.  THIS IS
33519C                        TO ACCOMODATE POTENTIAL NAME CONFLICTS
33520C                        (E.G., AUTOCORRELATION/AUTOCOVARIANCE).
33521C                        REMAINING ENTRIES ARE CHARACTERS 1 - 4
33522C                        OF SUBSEQUENT ARGUMENTS.
33523C        3) INFLAV     = NUMBER OF RESPONSE VARIABLES.
33524C        4) INLONG     = DESCRIPTIVE NAME FOR STATISTIC.
33525C
33526      DATA INCASE(1)/'NCDI'/
33527      DATA (INAME(1,J),J=1,MAXSCL)/
33528     1'NUMB','    ','OF  ','COMM','DIGI','    ','    ','    '/
33529      DATA INFLAV(1)/1/
33530      DATA INLONG(1)/'NUMBER'/
33531C
33532      DATA INCASE(2)/'NUMB'/
33533      DATA (INAME(2,J),J=1,MAXSCL)/
33534     1 'SIZE','    ','    ','    ','    ','    ','    ','    '/
33535      DATA INFLAV(2)/1/
33536      DATA INLONG(2)/'NUMBER'/
33537C
33538      DATA INCASE(3)/'NUMB'/
33539      DATA (INAME(3,J),J=1,MAXSCL)/
33540     1'COUN','    ','    ','    ','    ','    ','    ','    '/
33541      DATA INFLAV(3)/1/
33542      DATA INLONG(3)/'NUMB'/
33543C
33544      DATA INCASE(4)/'NUMB'/
33545      DATA (INAME(4,J),J=1,MAXSCL)/
33546     1'SAMP','    ','SIZE','    ','    ','    ','    ','    '/
33547      DATA INFLAV(4)/1/
33548      DATA INLONG(4)/'NUMBER'/
33549C
33550      DATA INCASE(5)/'NUMB'/
33551      DATA (INAME(5,J),J=1,MAXSCL)/
33552     1'SUBS','    ','SIZE','    ','    ','    ','    ','    '/
33553      DATA INFLAV(5)/1/
33554      DATA INLONG(5)/'NUMBER'/
33555C
33556      DATA INCASE(6)/'SSQM'/
33557      DATA (INAME(6,J),J=1,MAXSCL)/
33558     1'SUM ','    ','OF  ','SQUA','FROM','MEAN','    ','    '/
33559      DATA INFLAV(6)/1/
33560      DATA INLONG(6)/'SUM OF SQUARES FROM MEAN'/
33561C
33562      DATA INCASE(7)/'PROD'/
33563      DATA (INAME(7,J),J=1,MAXSCL)/
33564     1'PROD','    ','    ','    ','    ','    ','    ','    '/
33565      DATA INFLAV(7)/1/
33566      DATA INLONG(7)/'PRODUCT'/
33567C
33568      DATA INCASE(8)/'MIDR'/
33569      DATA (INAME(8,J),J=1,MAXSCL)/
33570     1'MIDR','    ','    ','    ','    ','    ','    ','    '/
33571      DATA INFLAV(8)/1/
33572      DATA INLONG(8)/'MID-RANGE'/
33573C
33574      DATA INCASE(9)/'WEME'/
33575      DATA (INAME(9,J),J=1,MAXSCL)/
33576     1'WEIG','    ','MEAN','    ','    ','    ','    ','    '/
33577      DATA INFLAV(9)/2/
33578      DATA INLONG(9)/'WEIGHTED MEAN'/
33579C
33580      DATA INCASE(10)/'MADR'/
33581      DATA (INAME(10,J),J=1,MAXSCL)/
33582     1'MAD ','    ','TO  ','MEDI','    ','    ','    ','    '/
33583      DATA INFLAV(10)/1/
33584      DATA INLONG(10)
33585     1 /'MAD TO MEDIAN'/
33586C
33587      DATA INCASE(11)/'AADM'/
33588      DATA (INAME(11,J),J=1,MAXSCL)/
33589     1'AVER','    ','ABSO','DEVI','FROM','THE ','MEDI','    '/
33590      DATA INFLAV(11)/1/
33591      DATA INLONG(11)/'AVERAGE ABSOLUTE DEVIATION FROM THE MEDIAN'/
33592C
33593      DATA INCASE(12)/'AAD '/
33594      DATA (INAME(12,J),J=1,MAXSCL)/
33595     1'AVER','    ','ABSO','DEVI','    ','    ','    ','    '/
33596      DATA INFLAV(12)/1/
33597      DATA INLONG(12)/'AVERAGE ABSOLUTE DEVIATION'/
33598C
33599      DATA INCASE(13)/'MIDM'/
33600      DATA (INAME(13,J),J=1,MAXSCL)/
33601     1'MIDM','    ','    ','    ','    ','    ','    ','    '/
33602      DATA INFLAV(13)/1/
33603      DATA INLONG(13)/'MID-MEAN'/
33604C
33605      DATA INCASE(15)/'MAD '/
33606      DATA (INAME(15,J),J=1,MAXSCL)/
33607     1'MAD ','    ','    ','    ','    ','    ','    ','    '/
33608      DATA INFLAV(15)/1/
33609      DATA INLONG(15)/'MEDIAN ABSOLUTE DEVIATION'/
33610C
33611      DATA INCASE(16)/'MAD '/
33612      DATA (INAME(16,J),J=1,MAXSCL)/
33613     1'MEDI','    ','ABSO','DEVI','    ','    ','    ','    '/
33614      DATA INFLAV(16)/1/
33615      DATA INLONG(16)/'MEDIAN ABSOLUTE DEVIATION'/
33616C
33617      DATA INCASE(17)/'WEMD'/
33618      DATA (INAME(17,J),J=1,MAXSCL)/
33619     1'WEIG','    ','MEDI','    ','    ','    ','    ','    '/
33620      DATA INFLAV(17)/2/
33621      DATA INLONG(17)/'WEIGHTED MEDIAN'/
33622C
33623      DATA INCASE(18)/'TMSE'/
33624      DATA (INAME(18,J),J=1,MAXSCL)/
33625     1'TRIM','    ','MEAN','STAN','ERRO','    ','    ','    '/
33626      DATA INFLAV(18)/1/
33627      DATA INLONG(18)/'TRIMMED MEAN STANDARD ERROR'/
33628C
33629      DATA INCASE(19)/'WINM'/
33630      DATA (INAME(19,J),J=1,MAXSCL)/
33631     1'WINS','    ','MEAN','    ','    ','    ','    ','    '/
33632      DATA INFLAV(19)/1/
33633      DATA INLONG(19)/'WINSORIZED MEAN'/
33634C
33635      DATA INCASE(20)/'WINM'/
33636      DATA (INAME(20,J),J=1,MAXSCL)/
33637     1'WIND','    ','MEAN','    ','    ','    ','    ','    '/
33638      DATA INFLAV(20)/1/
33639      DATA INLONG(20)/'WINSORIZED MEAN'/
33640C
33641      DATA INCASE(21)/'RANG'/
33642      DATA (INAME(21,J),J=1,MAXSCL)/
33643     1'RANG','    ','    ','    ','    ','    ','    ','    '/
33644      DATA INFLAV(21)/1/
33645      DATA INLONG(21)/'RANGE'/
33646C
33647      DATA INCASE(22)/'RANG'/
33648      DATA (INAME(22,J),J=1,MAXSCL)/
33649     1'R   ','    ','    ','    ','    ','    ','    ','    '/
33650      DATA INFLAV(22)/1/
33651      DATA INLONG(22)/'RANGE'/
33652C
33653      DATA INCASE(23)/'G1LO'/
33654      DATA (INAME(23,J),J=1,MAXSCL)/
33655     1'MINI','    ','GUMB','PPCC','LOCA','    ','    ','    '/
33656      DATA INFLAV(23)/1/
33657      DATA INLONG(23)/'MINIMUM GUMBEL PPCC LOCATION'/
33658C
33659      DATA INCASE(24)/'G2LO'/
33660      DATA (INAME(24,J),J=1,MAXSCL)/
33661     1'MAXI','    ','GUMB','PPCC','LOCA','    ','    ','    '/
33662      DATA INFLAV(24)/1/
33663      DATA INLONG(24)/'MAXIMUM GUMBEL PPCC LOCATION'/
33664C
33665      DATA INCASE(25)/'ESD '/
33666      DATA (INAME(25,J),J=1,MAXSCL)/
33667     1'EXTR','    ','STUD','DEVI','TEST','STAT','    ','    '/
33668      DATA INFLAV(25)/1/
33669      DATA INLONG(25)/'EXTREME STUDENTIZED DEVIATE TEST STATISTIC'/
33670C
33671      DATA INCASE(26)/'VM  '/
33672      DATA (INAME(26,J),J=1,MAXSCL)/
33673     1'VARI','    ','OF  ','THE ','MEAN','    ','    ','    '/
33674      DATA INFLAV(26)/1/
33675      DATA INLONG(26)/'VARIANCE OF THE MEAN'/
33676C
33677      DATA INCASE(27)/'VM  '/
33678      DATA (INAME(27,J),J=1,MAXSCL)/
33679     1'VARI','    ','OF  ','MEAN','    ','    ','    ','    '/
33680      DATA INFLAV(27)/1/
33681      DATA INLONG(27)/'VARIANCE OF THE MEAN'/
33682C
33683      DATA INCASE(28)/'VM  '/
33684      DATA (INAME(28,J),J=1,MAXSCL)/
33685     1'VARI','    ','MEAN','    ','    ','    ','    ','    '/
33686      DATA INFLAV(28)/1/
33687      DATA INLONG(28)/'VARIANCE OF THE MEAN'/
33688C
33689      DATA INCASE(29)/'LPVA'/
33690      DATA (INAME(29,J),J=1,MAXSCL)/
33691     1'VARI','    ','LP  ','LOCA','    ','    ','    ','    '/
33692      DATA INFLAV(29)/1/
33693      DATA INLONG(29)/'VARIANCE OF LP LOCATION'/
33694C
33695      DATA INCASE(30)/'SDME'/
33696      DATA (INAME(30,J),J=1,MAXSCL)/
33697     1'STAN','    ','DEVI','OF  ','THE ','MEAN','    ','    '/
33698      DATA INFLAV(30)/1/
33699      DATA INLONG(30)/'STANDARD DEVIATION OF THE MEAN'/
33700C
33701      DATA INCASE(31)/'SDME'/
33702      DATA (INAME(31,J),J=1,MAXSCL)/
33703     1'STAN','    ','DEVI','OF  ','MEAN','    ','    ','    '/
33704      DATA INFLAV(31)/1/
33705      DATA INLONG(31)/'STANDARD DEVIATION OF THE MEAN'/
33706C
33707      DATA INCASE(32)/'SDME'/
33708      DATA (INAME(32,J),J=1,MAXSCL)/
33709     1'STAN','    ','DEVI','MEAN','    ','    ','    ','    '/
33710      DATA INFLAV(32)/1/
33711      DATA INLONG(32)/'STANDARD DEVIATION OF THE MEAN'/
33712C
33713      DATA INCASE(33)/'SDME'/
33714      DATA (INAME(33,J),J=1,MAXSCL)/
33715     1'SD  ','    ','OF  ','THE ','MEAN','    ','    ','    '/
33716      DATA INFLAV(33)/1/
33717      DATA INLONG(33)/'STANDARD DEVIATION OF THE MEAN'/
33718C
33719      DATA INCASE(34)/'SDME'/
33720      DATA (INAME(34,J),J=1,MAXSCL)/
33721     1'SD  ','    ','OF  ','MEAN','    ','    ','    ','    '/
33722      DATA INFLAV(34)/1/
33723      DATA INLONG(34)/'STANDARD DEVIATION OF THE MEAN'/
33724C
33725      DATA INCASE(35)/'SDME'/
33726      DATA (INAME(35,J),J=1,MAXSCL)/
33727     1'SD  ','    ','MEAN','    ','    ','    ','    ','    '/
33728      DATA INFLAV(35)/1/
33729      DATA INLONG(35)/'STANDARD DEVIATION OF THE MEAN'/
33730C
33731      DATA INCASE(36)/'RESD'/
33732      DATA (INAME(36,J),J=1,MAXSCL)/
33733     1'RS  ','    ','    ','    ','    ','    ','    ','    '/
33734      DATA INFLAV(36)/1/
33735      DATA INLONG(36)/'RELATIVE STANDARD DEVIATION'/
33736C
33737      DATA INCASE(37)/'RESD'/
33738      DATA (INAME(37,J),J=1,MAXSCL)/
33739     1'RSD ','    ','    ','    ','    ','    ','    ','    '/
33740      DATA INFLAV(37)/1/
33741      DATA INLONG(37)/'RELATIVE STANDARD DEVIATION'/
33742C
33743      DATA INCASE(38)/'RESD'/
33744      DATA (INAME(38,J),J=1,MAXSCL)/
33745     1'RELS','    ','    ','    ','    ','    ','    ','    '/
33746      DATA INFLAV(38)/1/
33747      DATA INLONG(38)/'RELATIVE STANDARD DEVIATION'/
33748C
33749      DATA INCASE(39)/'RESD'/
33750      DATA (INAME(39,J),J=1,MAXSCL)/
33751     1'RELA','    ','STAN','DEVI','    ','    ','    ','    '/
33752      DATA INFLAV(39)/1/
33753      DATA INLONG(39)/'RELATIVE STANDARD DEVIATION'/
33754C
33755      DATA INCASE(40)/'RESD'/
33756      DATA (INAME(40,J),J=1,MAXSCL)/
33757     1'RELA','    ','SD  ','    ','    ','    ','    ','    '/
33758      DATA INFLAV(40)/1/
33759      DATA INLONG(40)/'RELATIVE STANDARD DEVIATION'/
33760C
33761      DATA INCASE(41)/'REVA'/
33762      DATA (INAME(41,J),J=1,MAXSCL)/
33763     1'RELA','    ','VARI','    ','    ','    ','    ','    '/
33764      DATA INFLAV(41)/1/
33765      DATA INLONG(41)/'RELATIVE VARIANCE'/
33766C
33767      DATA INCASE(42)/'REVA'/
33768      DATA (INAME(42,J),J=1,MAXSCL)/
33769     1'RV  ','    ','    ','    ','    ','    ','    ','    '/
33770      DATA INFLAV(42)/1/
33771      DATA INLONG(42)/'RELATIVE VARIANCE'/
33772C
33773      DATA INCASE(43)/'REVA'/
33774      DATA (INAME(43,J),J=1,MAXSCL)/
33775     1'RELV','    ','    ','    ','    ','    ','    ','    '/
33776      DATA INFLAV(43)/1/
33777      DATA INLONG(43)/'RELATIVE VARIANCE'/
33778C
33779      DATA INCASE(44)/'REVA'/
33780      DATA (INAME(44,J),J=1,MAXSCL)/
33781     1'RVAR','    ','    ','    ','    ','    ','    ','    '/
33782      DATA INFLAV(44)/1/
33783      DATA INLONG(44)/'RELATIVE VARIANCE'/
33784C
33785      DATA INCASE(45)/'CVAR'/
33786      DATA (INAME(45,J),J=1,MAXSCL)/
33787     1'COEF','    ','VARI','    ','    ','    ','    ','    '/
33788      DATA INFLAV(45)/1/
33789      DATA INLONG(45)/'COEFFCIENT OF VARIATION'/
33790C
33791      DATA INCASE(46)/'CVAR'/
33792      DATA (INAME(46,J),J=1,MAXSCL)/
33793     1'COEF','    ','OF  ','VARI','    ','    ','    ','    '/
33794      DATA INFLAV(46)/1/
33795      DATA INLONG(46)/'COEFFCIENT OF VARIATION'/
33796C
33797      DATA INCASE(47)/'LOWQ'/
33798      DATA (INAME(47,J),J=1,MAXSCL)/
33799     1'LOWE','    ','QUAR','    ','    ','    ','    ','    '/
33800      DATA INFLAV(47)/1/
33801      DATA INLONG(47)/'LOWER QUARTILE'/
33802C
33803      DATA INCASE(48)/'LOWQ'/
33804      DATA (INAME(48,J),J=1,MAXSCL)/
33805     1'FIRS','    ','QUAR','    ','    ','    ','    ','    '/
33806      DATA INFLAV(48)/1/
33807      DATA INLONG(48)/'LOWER QUARTILE'/
33808C
33809      DATA INCASE(49)/'MIDQ'/
33810      DATA (INAME(49,J),J=1,MAXSCL)/
33811     1'SECO','    ','QUAR','    ','    ','    ','    ','    '/
33812      DATA INFLAV(49)/1/
33813      DATA INLONG(49)/'MEDIAN'/
33814C
33815      DATA INCASE(50)/'UPPQ'/
33816      DATA (INAME(50,J),J=1,MAXSCL)/
33817     1'THIR','    ','QUAR','    ','    ','    ','    ','    '/
33818      DATA INFLAV(50)/1/
33819      DATA INLONG(50)/'UPPER QUARTILE'/
33820C
33821      DATA INCASE(51)/'UPPQ'/
33822      DATA (INAME(51,J),J=1,MAXSCL)/
33823     1'UPPE','    ','QUAR','    ','    ','    ','    ','    '/
33824      DATA INFLAV(51)/1/
33825      DATA INLONG(51)/'UPPER QUARTILE'/
33826C
33827      DATA INCASE(52)/'UPPH'/
33828      DATA (INAME(52,J),J=1,MAXSCL)/
33829     1'UPPE','    ','HING','    ','    ','    ','    ','    '/
33830      DATA INFLAV(52)/1/
33831      DATA INLONG(52)/'UPPER HINGE'/
33832C
33833      DATA INCASE(53)/'LOWH'/
33834      DATA (INAME(53,J),J=1,MAXSCL)/
33835     1'LOWE','    ','HING','    ','    ','    ','    ','    '/
33836      DATA INFLAV(53)/1/
33837      DATA INLONG(53)/'LOWER HINGE'/
33838C
33839      DATA INCASE(54)/'SKEW'/
33840      DATA (INAME(54,J),J=1,MAXSCL)/
33841     1'STAN','    ','THIR','CENT','MOME','    ','    ','    '/
33842      DATA INFLAV(54)/1/
33843      DATA INLONG(54)/'SKEWNESS'/
33844C
33845      DATA INCASE(55)/'SKEW'/
33846      DATA (INAME(55,J),J=1,MAXSCL)/
33847     1'STAN','    ','3RD ','CENT','MOME','    ','    ','    '/
33848      DATA INFLAV(55)/1/
33849      DATA INLONG(55)/'SKEWNESS'/
33850C
33851      DATA INCASE(56)/'SOPV'/
33852      DATA (INAME(56,J),J=1,MAXSCL)/
33853     1'SKEW','    ','OUTL','TEST','PVAL','    ','    ','    '/
33854      DATA INFLAV(56)/1/
33855      DATA INLONG(56)/'SKEWNESS OUTLIER TEST PVALUE'/
33856C
33857      DATA INCASE(57)/'KURT'/
33858      DATA (INAME(57,J),J=1,MAXSCL)/
33859     1'STAN','    ','FOUR','CENT','MOME','    ','    ','    '/
33860      DATA INFLAV(57)/1/
33861      DATA INLONG(57)/'KURTOSIS'/
33862C
33863      DATA INCASE(58)/'KURT'/
33864      DATA (INAME(58,J),J=1,MAXSCL)/
33865     1'STAN','    ','4TH ','CENT','MOME','    ','    ','    '/
33866      DATA INFLAV(58)/1/
33867      DATA INLONG(58)/'KURTOSIS'/
33868C
33869      DATA INCASE(59)/'KOPV'/
33870      DATA (INAME(59,J),J=1,MAXSCL)/
33871     1'KURT','    ','OUTL','TEST','PVAL','    ','    ','    '/
33872      DATA INFLAV(59)/1/
33873      DATA INLONG(59)/'KURTOSIS OUTLIER TEST PVALUE'/
33874C
33875      DATA INCASE(60)/'AUCV'/
33876      DATA (INAME(60,J),J=1,MAXSCL)/
33877     1'AUTO','COVA','STAT','    ','    ','    ','    ','    '/
33878      DATA INFLAV(60)/1/
33879      DATA INLONG(60)/'AUTOCOVARIANCE'/
33880C
33881      DATA INCASE(61)/'AUCR'/
33882      DATA (INAME(61,J),J=1,MAXSCL)/
33883     1'AUTO','CORR','STAT','    ','    ','    ','    ','    '/
33884      DATA INFLAV(61)/1/
33885      DATA INLONG(61)/'AUTOCORRELATION'/
33886C
33887      DATA INCASE(62)/'RACV'/
33888      DATA (INAME(62,J),J=1,MAXSCL)/
33889     1'RANK','    ','COVA','    ','    ','    ','    ','    '/
33890      DATA INFLAV(62)/2/
33891      DATA INLONG(62)/'RANK COVARIANCE'/
33892C
33893      DATA INCASE(63)/'RACA'/
33894      DATA (INAME(63,J),J=1,MAXSCL)/
33895     1'RANK','    ','CORR','ABSO','VALU','    ','    ','    '/
33896      DATA INFLAV(63)/2/
33897      DATA INLONG(63)/'RANK CORRELATION ABSOLUTE VALUE'/
33898C
33899      DATA INCASE(64)/'KTAA'/
33900      DATA (INAME(64,J),J=1,MAXSCL)/
33901     1'KEND','    ','TAU ','ABSO','VALU','    ','    ','    '/
33902      DATA INFLAV(64)/2/
33903      DATA INLONG(64)/'KENDALLS TAU ABSOLUTE VALUE'/
33904C
33905      DATA INCASE(65)/'1DEC'/
33906      DATA (INAME(65,J),J=1,MAXSCL)/
33907     1'FIRS','    ','DECI','    ','    ','    ','    ','    '/
33908      DATA INFLAV(65)/1/
33909      DATA INLONG(65)/'FIRST DECILE'/
33910C
33911      DATA INCASE(66)/'2DEC'/
33912      DATA (INAME(66,J),J=1,MAXSCL)/
33913     1'SECO','    ','DECI','    ','    ','    ','    ','    '/
33914      DATA INFLAV(66)/1/
33915      DATA INLONG(66)/'SECOND DECILE'/
33916C
33917      DATA INCASE(67)/'3DEC'/
33918      DATA (INAME(67,J),J=1,MAXSCL)/
33919     1'THIR','    ','DECI','    ','    ','    ','    ','    '/
33920      DATA INFLAV(67)/1/
33921      DATA INLONG(67)/'THIRD DECILE'/
33922C
33923      DATA INCASE(68)/'4DEC'/
33924      DATA (INAME(68,J),J=1,MAXSCL)/
33925     1'FOUR','    ','DECI','    ','    ','    ','    ','    '/
33926      DATA INFLAV(68)/1/
33927      DATA INLONG(68)/'FOURTH DECILE'/
33928C
33929      DATA INCASE(69)/'5DEC'/
33930      DATA (INAME(69,J),J=1,MAXSCL)/
33931     1'FIFT','    ','DECI','    ','    ','    ','    ','    '/
33932      DATA INFLAV(69)/1/
33933      DATA INLONG(69)/'FIFTH DECILE'/
33934C
33935      DATA INCASE(70)/'6DEC'/
33936      DATA (INAME(70,J),J=1,MAXSCL)/
33937     1'SIXT','    ','DECI','    ','    ','    ','    ','    '/
33938      DATA INFLAV(70)/1/
33939      DATA INLONG(70)/'SIXTH DECILE'/
33940C
33941      DATA INCASE(71)/'7DEC'/
33942      DATA (INAME(71,J),J=1,MAXSCL)/
33943     1'SEVE','    ','DECI','    ','    ','    ','    ','    '/
33944      DATA INFLAV(71)/1/
33945      DATA INLONG(71)/'SEVENTH DECILE'/
33946C
33947      DATA INCASE(72)/'8DEC'/
33948      DATA (INAME(72,J),J=1,MAXSCL)/
33949     1'EIGH','    ','DECI','    ','    ','    ','    ','    '/
33950      DATA INFLAV(72)/1/
33951      DATA INLONG(72)/'EIGTH DECILE'/
33952C
33953      DATA INCASE(73)/'9DEC'/
33954      DATA (INAME(73,J),J=1,MAXSCL)/
33955     1'NINT','    ','DECI','    ','    ','    ','    ','    '/
33956      DATA INFLAV(73)/1/
33957      DATA INLONG(73)/'NINTH DECILE'/
33958C
33959      DATA INCASE(74)/'DPBN'/
33960      DATA (INAME(74,J),J=1,MAXSCL)/
33961     1'DIFF','    ','OF  ','PERC','BEND','MIDV','    ','    '/
33962      DATA INFLAV(74)/2/
33963      DATA INLONG(74)/'DIFFERENCE OF PERCENTAGE BEND MIDVARIANCES'/
33964C
33965      DATA INCASE(75)/'SIFR'/
33966      DATA (INAME(75,J),J=1,MAXSCL)/
33967     1'SIN ','    ','FREQ','    ','    ','    ','    ','    '/
33968      DATA INFLAV(75)/1/
33969      DATA INLONG(75)/'SIN FREQUENCY'/
33970C
33971      DATA INCASE(76)/'SIFR'/
33972      DATA (INAME(76,J),J=1,MAXSCL)/
33973     1'SINE','    ','FREQ','    ','    ','    ','    ','    '/
33974      DATA INFLAV(76)/1/
33975      DATA INLONG(76)/'SIN FREQUENCY'/
33976C
33977      DATA INCASE(77)/'SIAM'/
33978      DATA (INAME(77,J),J=1,MAXSCL)/
33979     1'SIN ','    ','AMPL','    ','    ','    ','    ','    '/
33980      DATA INFLAV(77)/1/
33981      DATA INLONG(77)/'SIN AMPLITUDE'/
33982C
33983      DATA INCASE(78)/'SIAM'/
33984      DATA (INAME(78,J),J=1,MAXSCL)/
33985     1'SINE','    ','AMPL','    ','    ','    ','    ','    '/
33986      DATA INFLAV(78)/2/
33987      DATA INLONG(78)/'SIN AMPLITUDE'/
33988C
33989      DATA INCASE(79)/'LIIS'/
33990      DATA (INAME(79,J),J=1,MAXSCL)/
33991     1'LINE','    ','INTE','STAN','DEVI','    ','    ','    '/
33992      DATA INFLAV(79)/2/
33993      DATA INLONG(79)/'LINEAR INTERCEPT STANDARD DEVIATION'/
33994C
33995      DATA INCASE(80)/'LISS'/
33996      DATA (INAME(80,J),J=1,MAXSCL)/
33997     1'LINE','    ','SLOP','STAN','DEVI','    ','    ','    '/
33998      DATA INFLAV(80)/2/
33999      DATA INLONG(80)/'LINEAR SLOPE STANDARD DEVIATION'/
34000C
34001      DATA INCASE(81)/'LIRE'/
34002      DATA (INAME(81,J),J=1,MAXSCL)/
34003     1'LINE','    ','RESS','    ','    ','    ','    ','    '/
34004      DATA INFLAV(81)/2/
34005      DATA INLONG(81)/'LINEAR RESIDUAL SD'/
34006C
34007      DATA INCASE(82)/'LIRE'/
34008      DATA (INAME(82,J),J=1,MAXSCL)/
34009     1'LINE','    ','RESI','SD  ','    ','    ','    ','    '/
34010      DATA INFLAV(82)/2/
34011      DATA INLONG(82)/'LINEAR RESIDUAL SD'/
34012C
34013      DATA INCASE(83)/'LIRE'/
34014      DATA (INAME(83,J),J=1,MAXSCL)/
34015     1'LINE','    ','RESI','STAN','DEVI','    ','    ','    '/
34016      DATA INFLAV(83)/2/
34017      DATA INLONG(83)/'LINEAR RESIDUAL SD'/
34018C
34019      DATA INCASE(84)/'LICO'/
34020      DATA (INAME(84,J),J=1,MAXSCL)/
34021     1'LINE','    ','CORR','    ','    ','    ','    ','    '/
34022      DATA INFLAV(84)/2/
34023      DATA INLONG(84)/'LINEAR CORRELATION'/
34024C
34025      DATA INCASE(85)/'SNSC'/
34026      DATA (INAME(85,J),J=1,MAXSCL)/
34027     1'SN  ','    ','SCAL','    ','    ','    ','    ','    '/
34028      DATA INFLAV(85)/1/
34029      DATA INLONG(85)/'SN SCALE'/
34030C
34031      DATA INCASE(86)/'QNSC'/
34032      DATA (INAME(86,J),J=1,MAXSCL)/
34033     1'QN  ','    ','SCAL','    ','    ','    ','    ','    '/
34034      DATA INFLAV(86)/1/
34035      DATA INLONG(86)/'QN SCALE'/
34036C
34037      DATA INCASE(87)/'SN0 '/
34038      DATA (INAME(87,J),J=1,MAXSCL)/
34039     1'TAGU','   ','SN  ','    ','    ','    ','    ','    '/
34040      DATA INFLAV(87)/1/
34041      DATA INLONG(87)/'TAGUCHI SN'/
34042C
34043      DATA INCASE(88)/'SN0 '/
34044      DATA (INAME(88,J),J=1,MAXSCL)/
34045     1'TAGU','    ','SN0 ','    ','    ','    ','    ','    '/
34046      DATA INFLAV(88)/1/
34047      DATA INLONG(88)/'TAGUCHI SN0'/
34048C
34049      DATA INCASE(89)/'SN0 '/
34050      DATA (INAME(89,J),J=1,MAXSCL)/
34051     1'TAGU','    ','SNT ','    ','    ','    ','    ','    '/
34052      DATA INFLAV(89)/1/
34053      DATA INLONG(89)/'TAGUCHI SN0'/
34054C
34055      DATA INCASE(90)/'SN0 '/
34056      DATA (INAME(90,J),J=1,MAXSCL)/
34057     1'TAGU','    ','SNN ','    ','    ','    ','    ','    '/
34058      DATA INFLAV(90)/1/
34059      DATA INLONG(90)/'TAGUCHI SN0'/
34060C
34061      DATA INCASE(91)/'SN0 '/
34062      DATA (INAME(91,J),J=1,MAXSCL)/
34063     1'TAGU','    ','SNT1','    ','    ','    ','    ','    '/
34064      DATA INFLAV(91)/1/
34065      DATA INLONG(91)/'TAGUCHI SN0'/
34066C
34067      DATA INCASE(92)/'SN0 '/
34068      DATA (INAME(92,J),J=1,MAXSCL)/
34069     1'TAGU','    ','SNN1','    ','    ','    ','    ','    '/
34070      DATA INFLAV(92)/1/
34071      DATA INLONG(92)/'TAGUCHI SN0'/
34072C
34073      DATA INCASE(93)/'SN0 '/
34074      DATA (INAME(93,J),J=1,MAXSCL)/
34075     1'TAGU','    ','SN1 ','    ','    ','    ','    ','    '/
34076      DATA INFLAV(93)/1/
34077      DATA INLONG(93)/'TAGUCHI SN0'/
34078C
34079      DATA INCASE(94)/'SN+ '/
34080      DATA (INAME(94,J),J=1,MAXSCL)/
34081     1'TAGU','    ','SNL ','    ','    ','    ','    ','    '/
34082      DATA INFLAV(94)/1/
34083      DATA INLONG(94)/'TAGUCHI SN+'/
34084C
34085      DATA INCASE(95)/'SN+ '/
34086      DATA (INAME(95,J),J=1,MAXSCL)/
34087     1'TAGU','    ','SNB ','    ','    ','    ','    ','    '/
34088      DATA INFLAV(95)/1/
34089      DATA INLONG(95)/'TAGUCHI SN+'/
34090C
34091      DATA INCASE(96)/'SN+ '/
34092      DATA (INAME(96,J),J=1,MAXSCL)/
34093     1'TAGU','    ','SN+ ','    ','    ','    ','    ','    '/
34094      DATA INFLAV(96)/1/
34095      DATA INLONG(96)/'TAGUCHI SN+'/
34096C
34097      DATA INCASE(97)/'SN- '/
34098      DATA (INAME(97,J),J=1,MAXSCL)/
34099     1'TAGU','    ','SNS ','    ','    ','    ','    ','    '/
34100      DATA INFLAV(97)/1/
34101      DATA INLONG(97)/'TAGUCHI SN-'/
34102C
34103      DATA INCASE(98)/'SN- '/
34104      DATA (INAME(98,J),J=1,MAXSCL)/
34105     1'TAGU','    ','SN- ','    ','    ','    ','    ','    '/
34106      DATA INFLAV(98)/1/
34107      DATA INLONG(98)/'TAGUCHI SN-'/
34108C
34109      DATA INCASE(99)/'SN00'/
34110      DATA (INAME(99,J),J=1,MAXSCL)/
34111     1'TAGU','    ','SN2 ','    ','    ','    ','    ','    '/
34112      DATA INFLAV(99)/1/
34113      DATA INLONG(99)/'TAGUCHI SN00'/
34114C
34115      DATA INCASE(100)/'SN00'/
34116      DATA (INAME(100,J),J=1,MAXSCL)/
34117     1'TAGU','    ','SNT2','    ','    ','    ','    ','    '/
34118      DATA INFLAV(100)/1/
34119      DATA INLONG(100)/'TAGUCHI SN00'/
34120C
34121      DATA INCASE(101)/'SN00'/
34122      DATA (INAME(101,J),J=1,MAXSCL)/
34123     1'TAGU','    ','SNN2','    ','    ','    ','    ','    '/
34124      DATA INFLAV(101)/1/
34125      DATA INLONG(101)/'TAGUCHI SN00'/
34126C
34127      DATA INCASE(102)/'SN00'/
34128      DATA (INAME(102,J),J=1,MAXSCL)/
34129     1'TAGU','    ','SN00','    ','    ','    ','    ','    '/
34130      DATA INFLAV(102)/1/
34131      DATA INLONG(102)/'TAGUCHI SN00'/
34132C
34133      DATA INCASE(103)/'SN0 '/
34134      DATA (INAME(103,J),J=1,MAXSCL)/
34135     1'SN0 ','    ','    ','    ','    ','    ','    ','    '/
34136      DATA INFLAV(103)/1/
34137      DATA INLONG(103)/'TAGUCHI SN0'/
34138C
34139      DATA INCASE(104)/'SN0 '/
34140      DATA (INAME(104,J),J=1,MAXSCL)/
34141     1'SN  ','    ','    ','    ','    ','    ','    ','    '/
34142      DATA INFLAV(104)/1/
34143      DATA INLONG(104)/'TAGUCHI SN0'/
34144C
34145      DATA INCASE(105)/'SN0 '/
34146      DATA (INAME(105,J),J=1,MAXSCL)/
34147     1'SNT ','    ','    ','    ','    ','    ','    ','    '/
34148      DATA INFLAV(105)/1/
34149      DATA INLONG(105)/'TAGUCHI SN0'/
34150C
34151      DATA INCASE(106)/'SN0 '/
34152      DATA (INAME(106,J),J=1,MAXSCL)/
34153     1'SNN ','    ','    ','    ','    ','    ','    ','    '/
34154      DATA INFLAV(106)/1/
34155      DATA INLONG(106)/'TAGUCHI SN0'/
34156C
34157      DATA INCASE(107)/'SN0 '/
34158      DATA (INAME(107,J),J=1,MAXSCL)/
34159     1'SNT1','    ','    ','    ','    ','    ','    ','    '/
34160      DATA INFLAV(107)/1/
34161      DATA INLONG(107)/'TAGUCHI SN0'/
34162C
34163      DATA INCASE(108)/'SN0 '/
34164      DATA (INAME(108,J),J=1,MAXSCL)/
34165     1'SNN1','    ','    ','    ','    ','    ','    ','    '/
34166      DATA INFLAV(108)/1/
34167      DATA INLONG(108)/'TAGUCHI SN0'/
34168C
34169      DATA INCASE(109)/'SN0 '/
34170      DATA (INAME(109,J),J=1,MAXSCL)/
34171     1'SNN1','    ','    ','    ','    ','    ','    ','    '/
34172      DATA INFLAV(109)/1/
34173      DATA INLONG(109)/'TAGUCHI SN0'/
34174C
34175      DATA INCASE(110)/'SN0 '/
34176      DATA (INAME(110,J),J=1,MAXSCL)/
34177     1'SN1 ','    ','    ','    ','    ','    ','    ','    '/
34178      DATA INFLAV(110)/1/
34179      DATA INLONG(110)/'TAGUCHI SN0'/
34180C
34181      DATA INCASE(111)/'SN+ '/
34182      DATA (INAME(111,J),J=1,MAXSCL)/
34183     1'SNL ','    ','    ','    ','    ','    ','    ','    '/
34184      DATA INFLAV(111)/1/
34185      DATA INLONG(111)/'TAGUCHI SN+'/
34186C
34187      DATA INCASE(112)/'SN+ '/
34188      DATA (INAME(112,J),J=1,MAXSCL)/
34189     1'SNB ','    ','    ','    ','    ','    ','    ','    '/
34190      DATA INFLAV(112)/1/
34191      DATA INLONG(112)/'TAGUCHI SN+'/
34192C
34193      DATA INCASE(113)/'SN+ '/
34194      DATA (INAME(113,J),J=1,MAXSCL)/
34195     1'SN+ ','    ','    ','    ','    ','    ','    ','    '/
34196      DATA INFLAV(113)/1/
34197      DATA INLONG(113)/'TAGUCHI SN+'/
34198C
34199      DATA INCASE(114)/'SN- '/
34200      DATA (INAME(114,J),J=1,MAXSCL)/
34201     1'SN- ','    ','    ','    ','    ','    ','    ','    '/
34202      DATA INFLAV(114)/1/
34203      DATA INLONG(114)/'TAGUCHI SN-'/
34204C
34205      DATA INCASE(115)/'SN00'/
34206      DATA (INAME(115,J),J=1,MAXSCL)/
34207     1'SN00','    ','    ','    ','    ','    ','    ','    '/
34208      DATA INFLAV(115)/1/
34209      DATA INLONG(115)/'TAGUCHI SN00'/
34210C
34211      DATA INCASE(116)/'SN00'/
34212      DATA (INAME(116,J),J=1,MAXSCL)/
34213     1'SNT2','    ','    ','    ','    ','    ','    ','    '/
34214      DATA INFLAV(116)/1/
34215      DATA INLONG(116)/'TAGUCHI SN00'/
34216C
34217      DATA INCASE(117)/'SN00'/
34218      DATA (INAME(117,J),J=1,MAXSCL)/
34219     1'SNN2','    ','    ','    ','    ','    ','    ','    '/
34220      DATA INFLAV(117)/1/
34221      DATA INLONG(117)/'TAGUCHI SN00'/
34222C
34223      DATA INCASE(118)/'SN00'/
34224      DATA (INAME(118,J),J=1,MAXSCL)/
34225     1'SN2 ','    ','    ','    ','    ','    ','    ','    '/
34226      DATA INFLAV(118)/1/
34227      DATA INLONG(118)/'TAGUCHI SN00'/
34228C
34229      DATA INCASE(119)/'GEME'/
34230      DATA (INAME(119,J),J=1,MAXSCL)/
34231     1'GEOM','    ','MEAN','    ','    ','    ','    ','    '/
34232      DATA INFLAV(119)/1/
34233      DATA INLONG(119)/'GEOMETRIC MEAN'/
34234C
34235      DATA INCASE(120)/'GESD'/
34236      DATA (INAME(120,J),J=1,MAXSCL)/
34237     1'GEOM','    ','SD  ','    ','    ','    ','    ','    '/
34238      DATA INFLAV(120)/1/
34239      DATA INLONG(120)/'GEOMETRIC SD'/
34240C
34241      DATA INCASE(121)/'GESD'/
34242      DATA (INAME(121,J),J=1,MAXSCL)/
34243     1'GEOM','    ','STAN','DEVI','    ','    ','    ','    '/
34244      DATA INFLAV(121)/1/
34245      DATA INLONG(121)/'GEOMETRIC SD'/
34246C
34247      DATA INCASE(122)/'HAME'/
34248      DATA (INAME(122,J),J=1,MAXSCL)/
34249     1'HARM','    ','MEAN','    ','    ','    ','    ','    '/
34250      DATA INFLAV(122)/1/
34251      DATA INLONG(122)/'HARMONIC MEAN'/
34252C
34253      DATA INCASE(123)/'IQRA'/
34254      DATA (INAME(123,J),J=1,MAXSCL)/
34255     1'IQ  ','    ','RANG','    ','    ','    ','    ','    '/
34256      DATA INFLAV(123)/1/
34257      DATA INLONG(123)/'INTERQUARTILE RANGE'/
34258C
34259      DATA INCASE(124)/'IQRA'/
34260      DATA (INAME(124,J),J=1,MAXSCL)/
34261     1'INTE','    ','RANG','    ','    ','    ','    ','    '/
34262      DATA INFLAV(124)/1/
34263      DATA INLONG(124)/'INTERQUARTILE RANGE'/
34264C
34265      DATA INCASE(125)/'BILO'/
34266      DATA (INAME(125,J),J=1,MAXSCL)/
34267     1'BIWE','    ','LOCA','    ','    ','    ','    ','    '/
34268      DATA INFLAV(125)/1/
34269      DATA INLONG(125)/'BIWEIGHT LOCATION'/
34270C
34271      DATA INCASE(126)/'BISC'/
34272      DATA (INAME(126,J),J=1,MAXSCL)/
34273     1'BIWE','    ','SCAL','    ','    ','    ','    ','    '/
34274      DATA INFLAV(126)/1/
34275      DATA INLONG(126)/'BIWEIGHT SCALE'/
34276C
34277      DATA INCASE(127)/'WIVA'/
34278      DATA (INAME(127,J),J=1,MAXSCL)/
34279     1'WINS','    ','VARI','    ','    ','    ','    ','    '/
34280      DATA INFLAV(127)/1/
34281      DATA INLONG(127)/'WINSORIZED VARIANCE'/
34282C
34283      DATA INCASE(128)/'WIVA'/
34284      DATA (INAME(128,J),J=1,MAXSCL)/
34285     1'WIND','    ','VARI','    ','    ','    ','    ','    '/
34286      DATA INFLAV(128)/1/
34287      DATA INLONG(128)/'WINSORIZED VARIANCE'/
34288C
34289      DATA INCASE(129)/'WISD'/
34290      DATA (INAME(129,J),J=1,MAXSCL)/
34291     1'WINS','    ','SD  ','    ','    ','    ','    ','    '/
34292      DATA INFLAV(129)/1/
34293      DATA INLONG(129)/'WINSORIZED SD'/
34294C
34295      DATA INCASE(130)/'WISD'/
34296      DATA (INAME(130,J),J=1,MAXSCL)/
34297     1'WIND','    ','SD  ','    ','    ','    ','    ','    '/
34298      DATA INFLAV(130)/1/
34299      DATA INLONG(130)/'WINSORIZED SD'/
34300C
34301      DATA INCASE(131)/'WISD'/
34302      DATA (INAME(131,J),J=1,MAXSCL)/
34303     1'WINS','    ','STAN','DEVI','    ','    ','    ','    '/
34304      DATA INFLAV(131)/1/
34305      DATA INLONG(131)/'WINSORIZED SD'/
34306C
34307      DATA INCASE(132)/'WISD'/
34308      DATA (INAME(132,J),J=1,MAXSCL)/
34309     1'WIND','    ','STAN','DEVI','    ','    ','    ','    '/
34310      DATA INFLAV(132)/1/
34311      DATA INLONG(132)/'WINSORIZED SD'/
34312C
34313      DATA INCASE(133)/'WICV'/
34314      DATA (INAME(133,J),J=1,MAXSCL)/
34315     1'WINS','    ','COVA','    ','    ','    ','    ','    '/
34316      DATA INFLAV(133)/2/
34317      DATA INLONG(133)/'WINSORIZED COVARIANCE'/
34318C
34319      DATA INCASE(134)/'WICV'/
34320      DATA (INAME(134,J),J=1,MAXSCL)/
34321     1'WIND','    ','COVA','    ','    ','    ','    ','    '/
34322      DATA INFLAV(134)/2/
34323      DATA INLONG(134)/'WINSORIZED COVARIANCE'/
34324C
34325      DATA INCASE(135)/'WICR'/
34326      DATA (INAME(135,J),J=1,MAXSCL)/
34327     1'WINS','    ','CORR','    ','    ','    ','    ','    '/
34328      DATA INFLAV(135)/2/
34329      DATA INLONG(135)/'WINSORIZED CORRELATION'/
34330C
34331      DATA INCASE(136)/'WICR'/
34332      DATA (INAME(136,J),J=1,MAXSCL)/
34333     1'WIND','    ','CORR','    ','    ','    ','    ','    '/
34334      DATA INFLAV(136)/2/
34335      DATA INLONG(136)/'WINSORIZED CORRELATION'/
34336C
34337      DATA INCASE(137)/'BICR'/
34338      DATA (INAME(137,J),J=1,MAXSCL)/
34339     1'BIWE','    ','MIDC','    ','    ','    ','    ','    '/
34340      DATA INFLAV(137)/2/
34341      DATA INLONG(137)/'BIWEIGHT MIDCOVARIANCE'/
34342C
34343      DATA INCASE(138)/'BICR'/
34344      DATA (INAME(138,J),J=1,MAXSCL)/
34345     1'BIWE','    ','MID ','CORR','    ','    ','    ','    '/
34346      DATA INFLAV(138)/2/
34347      DATA INLONG(138)/'BIWEIGHT MIDCORRELATION'/
34348C
34349      DATA INCASE(139)/'BIMV'/
34350      DATA (INAME(139,J),J=1,MAXSCL)/
34351     1'BIWE','    ','MID ','VARI','    ','    ','    ','    '/
34352      DATA INFLAV(139)/1/
34353      DATA INLONG(139)/'BIWEIGHT MIDVARIANCE'/
34354C
34355      DATA INCASE(140)/'BIMV'/
34356      DATA (INAME(140,J),J=1,MAXSCL)/
34357     1'BIWE','    ','MIDV','    ','    ','    ','    ','    '/
34358      DATA INFLAV(140)/1/
34359      DATA INLONG(140)/'BIWEIGHT MIDVARIANCE'/
34360C
34361      DATA INCASE(141)/'PBMV'/
34362      DATA (INAME(141,J),J=1,MAXSCL)/
34363     1'PERC','    ','BEND','MIDV','    ','    ','    ','    '/
34364      DATA INFLAV(141)/1/
34365      DATA INLONG(141)/'PERCENTAGE BEND MIDVARINCE'/
34366C
34367      DATA INCASE(142)/'HLEH'/
34368      DATA (INAME(142,J),J=1,MAXSCL)/
34369     1'HODG','    ','LEHM','    ','    ','    ','    ','    '/
34370      DATA INFLAV(142)/1/
34371      DATA INLONG(142)/'HODGES-LEHMAN'/
34372C
34373      DATA INCASE(143)/'QUSE'/
34374      DATA (INAME(143,J),J=1,MAXSCL)/
34375     1'QUAN','    ','STAN','ERRO','    ','    ','    ','    '/
34376      DATA INFLAV(143)/1/
34377      DATA INLONG(143)/'QUANTILE STANDARD ERROR'/
34378C
34379      DATA INCASE(144)/'QUAN'/
34380      DATA (INAME(144,J),J=1,MAXSCL)/
34381     1'QUAN','    ','    ','    ','    ','    ','    ','    '/
34382      DATA INFLAV(144)/1/
34383      DATA INLONG(144)/'QUANTILE'/
34384C
34385      DATA INCASE(145)/'WETM'/
34386      DATA (INAME(145,J),J=1,MAXSCL)/
34387     1'WEIG','    ','TRIM','MEAN','    ','    ','    ','    '/
34388      DATA INFLAV(145)/1/
34389      DATA INLONG(145)/'WEIGHTED TRIMMED MEAN'/
34390C
34391      DATA INCASE(146)/'PBCR'/
34392      DATA (INAME(146,J),J=1,MAXSCL)/
34393     1'PERC','    ','BEND','CORR','    ','    ','    ','    '/
34394      DATA INFLAV(146)/2/
34395      DATA INLONG(146)/'PERCENTAGE BEND CORRELATION'/
34396C
34397      DATA INCASE(147)/'LICA'/
34398      DATA (INAME(147,J),J=1,MAXSCL)/
34399     1'LINE','    ','CALI','    ','    ','    ','    ','    '/
34400      DATA INFLAV(147)/2/
34401      DATA INLONG(147)/'LINEAR CALIBRATION'/
34402C
34403      DATA INCASE(148)/'QUCA'/
34404      DATA (INAME(148,J),J=1,MAXSCL)/
34405     1'QUAD','    ','CALI','    ','    ','    ','    ','    '/
34406      DATA INFLAV(148)/2/
34407      DATA INLONG(148)/'QUADRATIC CALIBRATION'/
34408C
34409      DATA INCASE(149)/'CP  '/
34410      DATA (INAME(149,J),J=1,MAXSCL)/
34411     1'CP  ','    ','    ','    ','    ','    ','    ','    '/
34412      DATA INFLAV(149)/1/
34413      DATA INLONG(149)/'CP'/
34414C
34415      DATA INCASE(150)/'CPK '/
34416      DATA (INAME(150,J),J=1,MAXSCL)/
34417     1'CPK ','    ','    ','    ','    ','    ','    ','    '/
34418      DATA INFLAV(150)/1/
34419      DATA INLONG(150)/'CPK'/
34420C
34421      DATA INCASE(151)/'CNPK'/
34422      DATA (INAME(151,J),J=1,MAXSCL)/
34423     1'CNPK','    ','    ','    ','    ','    ','    ','    '/
34424      DATA INFLAV(151)/1/
34425      DATA INLONG(151)/'CNPK'/
34426C
34427      DATA INCASE(152)/'CPM '/
34428      DATA (INAME(152,J),J=1,MAXSCL)/
34429     1'CPM ','    ','    ','    ','    ','    ','    ','    '/
34430      DATA INFLAV(152)/1/
34431      DATA INLONG(152)/'CPM'/
34432C
34433      DATA INCASE(153)/'CC  '/
34434      DATA (INAME(153,J),J=1,MAXSCL)/
34435     1'CC  ','    ','    ','    ','    ','    ','    ','    '/
34436      DATA INFLAV(153)/1/
34437      DATA INLONG(153)/'CC'/
34438C
34439      DATA INCASE(154)/'CPL '/
34440      DATA (INAME(154,J),J=1,MAXSCL)/
34441     1'CPL ','    ','    ','    ','    ','    ','    ','    '/
34442      DATA INFLAV(154)/1/
34443      DATA INLONG(154)/'CPL'/
34444C
34445      DATA INCASE(155)/'CPU '/
34446      DATA (INAME(155,J),J=1,MAXSCL)/
34447     1'CPU ','    ','    ','    ','    ','    ','    ','    '/
34448      DATA INFLAV(155)/1/
34449      DATA INLONG(155)/'CPU'/
34450C
34451      DATA INCASE(156)/'EXLO'/
34452      DATA (INAME(156,J),J=1,MAXSCL)/
34453     1'EXPE','    ','LOSS','    ','    ','    ','    ','    '/
34454      DATA INFLAV(156)/1/
34455      DATA INLONG(156)/'EXPECTED LOSS'/
34456C
34457      DATA INCASE(157)/'PEDE'/
34458      DATA (INAME(157,J),J=1,MAXSCL)/
34459     1'PERC','    ','DEFE','    ','    ','    ','    ','    '/
34460      DATA INFLAV(157)/1/
34461      DATA INLONG(157)/'PERCENT DEFECTIVE'/
34462C
34463      DATA INCASE(158)/'DMEA'/
34464      DATA (INAME(158,J),J=1,MAXSCL)/
34465     1'DIFF','    ','OF  ','MEAN','    ','    ','    ','    '/
34466      DATA INFLAV(158)/2/
34467      DATA INLONG(158)/'DIFFERENCE OF MEANS'/
34468C
34469      DATA INCASE(159)/'DAAM'/
34470      DATA (INAME(159,J),J=1,MAXSCL)/
34471     1'DIFF','    ','OF  ','AVER','ABSO','DEVI','FROM','MEDI'/
34472      DATA INFLAV(159)/2/
34473      DATA INLONG(159)/'DIFF OF AVERAGE ABSO DEVIATIONS FROM MEDIAN'/
34474C
34475      DATA INCASE(160)/'DAAD'/
34476      DATA (INAME(160,J),J=1,MAXSCL)/
34477     1'DIFF','    ','OF  ','AVER','ABSO','DEVI','    ','    '/
34478      DATA INFLAV(160)/2/
34479      DATA INLONG(160)/'DIFFERENCE OF AVERAGE ABSOLUTE DEVIATIONS'/
34480C
34481      DATA INCASE(161)/'DMMD'/
34482      DATA (INAME(161,J),J=1,MAXSCL)/
34483     1'DIFF','    ','OF  ','MAD ','TO  ','MEDI','    ','    '/
34484      DATA INFLAV(161)/2/
34485      DATA INLONG(161)/'DIFFERENCE OF AAD TO MEDIAN'/
34486C
34487      DATA INCASE(162)/'DMDM'/
34488      DATA (INAME(162,J),J=1,MAXSCL)/
34489     1'DIFF','    ','OF  ','MIDM','    ','    ','    ','    '/
34490      DATA INFLAV(162)/2/
34491      DATA INLONG(162)/'DIFFERENCE OF MID-MEANS'/
34492C
34493      DATA INCASE(163)/'DMAD'/
34494      DATA (INAME(163,J),J=1,MAXSCL)/
34495     1'DIFF','    ','OF  ','MAD ','    ','    ','    ','    '/
34496      DATA INFLAV(163)/2/
34497      DATA INLONG(163)/'DIFFERENCE OF MEDIAN ABSOLUTE DEVIATIONS'/
34498C
34499      DATA INCASE(164)/'DMAD'/
34500      DATA (INAME(164,J),J=1,MAXSCL)/
34501     1'DIFF','    ','OF  ','MEDI','ABSO','DEVI','    ','    '/
34502      DATA INFLAV(164)/2/
34503      DATA INLONG(164)/'DIFFERENCE OF MEDIAN ABSOLUTE DEVIATIONS'/
34504C
34505      DATA INCASE(165)/'DMED'/
34506      DATA (INAME(165,J),J=1,MAXSCL)/
34507     1'DIFF','    ','OF  ','MEDI','    ','    ','    ','    '/
34508      DATA INFLAV(165)/2/
34509      DATA INLONG(165)/'DIFFERENCE OF MEDIANS'/
34510C
34511      DATA INCASE(166)/'DTRM'/
34512      DATA (INAME(166,J),J=1,MAXSCL)/
34513     1'DIFF','    ','OF  ','TRIM','MEAN','    ','    ','    '/
34514      DATA INFLAV(166)/2/
34515      DATA INLONG(166)/'DIFFERENCE OF TRIMMED MEANS'/
34516C
34517      DATA INCASE(167)/'DWNM'/
34518      DATA (INAME(167,J),J=1,MAXSCL)/
34519     1'DIFF','    ','OF  ','WINS','MEAN','    ','    ','    '/
34520      DATA INFLAV(167)/2/
34521      DATA INLONG(167)/'DIFFERENCE OF WINSORIZED MEANS'/
34522C
34523      DATA INCASE(168)/'DWNM'/
34524      DATA (INAME(168,J),J=1,MAXSCL)/
34525     1'DIFF','    ','OF  ','WIND','MEAN','    ','    ','    '/
34526      DATA INFLAV(168)/2/
34527      DATA INLONG(168)/'DIFFERENCE OF WINSORIZED MEANS'/
34528C
34529      DATA INCASE(169)/'DGEO'/
34530      DATA (INAME(169,J),J=1,MAXSCL)/
34531     1'DIFF','    ','OF  ','GEOM','MEAN','    ','    ','    '/
34532      DATA INFLAV(169)/2/
34533      DATA INLONG(169)/'DIFFERENCE OF GEOMETRIC MEANS'/
34534C
34535      DATA INCASE(170)/'DHAR'/
34536      DATA (INAME(170,J),J=1,MAXSCL)/
34537     1'DIFF','    ','OF  ','HARM','MEAN','    ','    ','    '/
34538      DATA INFLAV(170)/2/
34539      DATA INLONG(170)/'DIFFERENCE OF HARMONIC MEANS'/
34540C
34541      DATA INCASE(171)/'DHDL'/
34542      DATA (INAME(171,J),J=1,MAXSCL)/
34543     1'DIFF','    ','OF  ','HODG','LEHM','    ','    ','    '/
34544      DATA INFLAV(171)/2/
34545      DATA INLONG(171)/'DIFFERENCE OF HODGES-LEHMAN'/
34546C
34547      DATA INCASE(172)/'DBIW'/
34548      DATA (INAME(172,J),J=1,MAXSCL)/
34549     1'DIFF','    ','OF  ','BIWE','LOCA','    ','    ','    '/
34550      DATA INFLAV(172)/2/
34551      DATA INLONG(172)/'DIFFERENCE OF BIWEIGHT LOCATIONS'/
34552C
34553      DATA INCASE(173)/'DSD '/
34554      DATA (INAME(173,J),J=1,MAXSCL)/
34555     1'DIFF','    ','OF  ','STAN','DEVI','    ','    ','    '/
34556      DATA INFLAV(173)/2/
34557      DATA INLONG(173)/'DIFFERENCE OF STANDARD DEVIATIONS'/
34558C
34559      DATA INCASE(174)/'DSD '/
34560      DATA (INAME(174,J),J=1,MAXSCL)/
34561     1'DIFF','    ','OF  ','SD  ','    ','    ','    ','    '/
34562      DATA INFLAV(174)/2/
34563      DATA INLONG(174)/'DIFFERENCE OF STANDARD DEVIATIONS'/
34564C
34565      DATA INCASE(175)/'DVAR'/
34566      DATA (INAME(175,J),J=1,MAXSCL)/
34567     1'DIFF','    ','OF  ','VARI','    ','    ','    ','    '/
34568      DATA INFLAV(175)/2/
34569      DATA INLONG(175)/'DIFFERENCE OF VARIANCES'/
34570C
34571      DATA INCASE(176)/'DSDM'/
34572      DATA (INAME(176,J),J=1,MAXSCL)/
34573     1'DIFF','    ','OF  ','STAN','DEVI','OF  ','MEAN','    '/
34574      DATA INFLAV(176)/2/
34575      DATA INLONG(176)
34576     1     /'DIFFERENCE OF STANDARD DEVIATIONS OF THE MEANS'/
34577C
34578      DATA INCASE(177)/'DSDM'/
34579      DATA (INAME(177,J),J=1,MAXSCL)/
34580     1'DIFF','    ','OF  ','STAN','DEVI','MEAN','    ','    '/
34581      DATA INFLAV(177)/2/
34582      DATA INLONG(177)
34583     1     /'DIFFERENCE OF STANDARD DEVIATIONS OF THE MEANS'/
34584C
34585      DATA INCASE(178)/'DSDM'/
34586      DATA (INAME(178,J),J=1,MAXSCL)/
34587     1'DIFF','    ','OF  ','SD  ','OF  ','THE ','MEAN','    '/
34588      DATA INFLAV(178)/2/
34589      DATA INLONG(178)
34590     1     /'DIFFERENCE OF STANDARD DEVIATIONS OF THE MEANS'/
34591C
34592      DATA INCASE(179)/'DSDM'/
34593      DATA (INAME(179,J),J=1,MAXSCL)/
34594     1'DIFF','    ','OF  ','SD  ','THE ','MEAN','    ','    '/
34595      DATA INFLAV(179)/2/
34596      DATA INLONG(179)
34597     1     /'DIFFERENCE OF STANDARD DEVIATIONS OF THE MEANS'/
34598C
34599      DATA INCASE(180)/'DSDM'/
34600      DATA (INAME(180,J),J=1,MAXSCL)/
34601     1'DIFF','OF  ','SD  ','MEAN','    ','    ','    ','    '/
34602      DATA INFLAV(180)/2/
34603      DATA INLONG(180)
34604     1     /'DIFFERENCE OF STANDARD DEVIATIONS OF THE MEANS'/
34605C
34606      DATA INCASE(181)/'DVAM'/
34607      DATA (INAME(181,J),J=1,MAXSCL)/
34608     1'DIFF','    ','OF  ','VARI','MEAN','    ','    ','    '/
34609      DATA INFLAV(181)/2/
34610      DATA INLONG(181)/'DIFFERENCE OF VARIANCE OF THE MEANS'/
34611C
34612      DATA INCASE(182)/'DVAM'/
34613      DATA (INAME(182,J),J=1,MAXSCL)/
34614     1'DIFF','    ','OF  ','VARI','OF  ','MEAN','    ','    '/
34615      DATA INFLAV(182)/2/
34616      DATA INLONG(182)/'DIFFERENCE OF VARIANCE OF THE MEANS'/
34617C
34618      DATA INCASE(183)/'DVAM'/
34619      DATA (INAME(183,J),J=1,MAXSCL)/
34620     1'DIFF','    ','OF  ','VARI','OF  ','THE ','MEAN','    '/
34621      DATA INFLAV(183)/2/
34622      DATA INLONG(183)/'DIFFERENCE OF VARIANCE OF THE MEANS'/
34623C
34624      DATA INCASE(184)/'DIQR'/
34625      DATA (INAME(184,J),J=1,MAXSCL)/
34626     1'DIFF','    ','OF  ','INTE','RANG','    ','    ','    '/
34627      DATA INFLAV(184)/2/
34628      DATA INLONG(184)/'DIFFERENCE OF INTERQUARTILE RANGES'/
34629C
34630      DATA INCASE(185)/'DIQR'/
34631      DATA (INAME(185,J),J=1,MAXSCL)/
34632     1'DIFF','    ','OF  ','IQ  ','RANG','    ','    ','    '/
34633      DATA INFLAV(185)/2/
34634      DATA INLONG(185)/'DIFFERENCE OF THE INTERQUARTILE RANGES'/
34635C
34636      DATA INCASE(186)/'DWSD'/
34637      DATA (INAME(186,J),J=1,MAXSCL)/
34638     1'DIFF','    ','OF  ','WINS','SD  ','    ','    ','    '/
34639      DATA INFLAV(186)/2/
34640      DATA INLONG(186)/'DIFFERENCE OF WINSORIZED STANDARD DEVIATIONS'/
34641C
34642      DATA INCASE(187)/'DWSD'/
34643      DATA (INAME(187,J),J=1,MAXSCL)/
34644     1'DIFF','    ','OF  ','WIND','SD  ','    ','    ','    '/
34645      DATA INFLAV(187)/2/
34646      DATA INLONG(187)/'DIFFERENCE OF WINSORIZED STANDARD DEVIATIONS'/
34647C
34648      DATA INCASE(188)/'DWSD'/
34649      DATA (INAME(188,J),J=1,MAXSCL)/
34650     1'DIFF','    ','OF  ','WINS','STAN','DEVI','    ','    '/
34651      DATA INFLAV(188)/2/
34652      DATA INLONG(188)/'DIFFERENCE OF WINSORIZED STANDARD DEVIATIONS'/
34653C
34654      DATA INCASE(189)/'DWSD'/
34655      DATA (INAME(189,J),J=1,MAXSCL)/
34656     1'DIFF','    ','OF  ','WIND','STAN','DEVI','    ','    '/
34657      DATA INFLAV(189)/2/
34658      DATA INLONG(189)/'DIFFERENCE OF WINSORIZED STANDARD DEVIATIONS'/
34659C
34660      DATA INCASE(190)/'DWVA'/
34661      DATA (INAME(190,J),J=1,MAXSCL)/
34662     1'DIFF','    ','OF  ','WINS','VARI','    ','    ','    '/
34663      DATA INFLAV(190)/2/
34664      DATA INLONG(190)/'DIFFERENCE OF WINSORIZED VARIANCES'/
34665C
34666      DATA INCASE(191)/'DWVA'/
34667      DATA (INAME(191,J),J=1,MAXSCL)/
34668     1'DIFF','    ','OF  ','WIND','VARI','    ','    ','    '/
34669      DATA INFLAV(191)/2/
34670      DATA INLONG(191)/'DIFFERENCE OF WINSORIZED VARIANCES'/
34671C
34672      DATA INCASE(192)/'DBIM'/
34673      DATA (INAME(192,J),J=1,MAXSCL)/
34674     1'DIFF','    ','OF  ','BIWE','MIDV','    ','    ','    '/
34675      DATA INFLAV(192)/2/
34676      DATA INLONG(192)/'DIFFERENCE OF BIWEIGHT MIDVARIANCES'/
34677C
34678      DATA INCASE(193)/'DBIS'/
34679      DATA (INAME(193,J),J=1,MAXSCL)/
34680     1'DIFF','    ','OF  ','BIWE','SCAL','    ','    ','    '/
34681      DATA INFLAV(193)/2/
34682      DATA INLONG(193)/'DKIFFERENCE OF BIWEIGHT SCALES'/
34683C
34684      DATA INCASE(194)/'PEAG'/
34685      DATA (INAME(194,J),J=1,MAXSCL)/
34686     1'PERC','    ','AGRE','    ','    ','    ','    ','    '/
34687      DATA INFLAV(194)/2/
34688      DATA INLONG(194)/'PERCENTAGE AGREEMENT'/
34689C
34690      DATA INCASE(195)/'DGSD'/
34691      DATA (INAME(195,J),J=1,MAXSCL)/
34692     1'DIFF','    ','OF  ','GEOM','SD  ','    ','    ','    '/
34693      DATA INFLAV(195)/2/
34694      DATA INLONG(195)/'DIFFERENCE OF GEOMETRIC STANDARD DEVIATIONS'/
34695C
34696      DATA INCASE(196)/'DGSD'/
34697      DATA (INAME(196,J),J=1,MAXSCL)/
34698     1'DIFF','    ','OF  ','GEOM','STAN','DEVI','    ','    '/
34699      DATA INFLAV(196)/2/
34700      DATA INLONG(196)/'DIFFERENCE OF GEOMETRIC STANDARD DEVIATIONS'/
34701C
34702      DATA INCASE(197)/'DRAN'/
34703      DATA (INAME(197,J),J=1,MAXSCL)/
34704     1'DIFF','    ','OF  ','RANG','    ','    ','    ','    '/
34705      DATA INFLAV(197)/2/
34706      DATA INLONG(197)/'DIFFERENCE OF RANGES'/
34707C
34708      DATA INCASE(198)/'DMDR'/
34709      DATA (INAME(198,J),J=1,MAXSCL)/
34710     1'DIFF','    ','OF  ','MIDR','    ','    ','    ','    '/
34711      DATA INFLAV(198)/2/
34712      DATA INLONG(198)/'DIFFERENCE OF MID-RANGES'/
34713C
34714      DATA INCASE(199)/'DMDR'/
34715      DATA (INAME(199,J),J=1,MAXSCL)/
34716     1'DIFF','    ','OF  ','MID ','RANG','    ','    ','    '/
34717      DATA INFLAV(199)/2/
34718      DATA INLONG(199)/'DIFFERENCE OF MID-RANGES'/
34719C
34720      DATA INCASE(200)/'DQUA'/
34721      DATA (INAME(200,J),J=1,MAXSCL)/
34722     1'DIFF','    ','OF  ','QUAN','    ','    ','    ','    '/
34723      DATA INFLAV(200)/2/
34724      DATA INLONG(200)/'DIFFERENCE OF QUANTILES'/
34725C
34726      DATA INCASE(201)/'DSKE'/
34727      DATA (INAME(201,J),J=1,MAXSCL)/
34728     1'DIFF','    ','OF  ','SKEW','    ','    ','    ','    '/
34729      DATA INFLAV(201)/2/
34730      DATA INLONG(201)/'DIFFERENCE OF SKEWNESS'/
34731C
34732      DATA INCASE(202)/'DSKE'/
34733      DATA (INAME(202,J),J=1,MAXSCL)/
34734     1'DIFF','    ','OF  ','STAN','CENT','THIR','MOME','    '/
34735      DATA INFLAV(202)/2/
34736      DATA INLONG(202)/'DIFFERENCE OF SKEWNESS'/
34737C
34738      DATA INCASE(203)/'DSKE'/
34739      DATA (INAME(203,J),J=1,MAXSCL)/
34740     1'DIFF','    ','OF  ','STAN','CENT','3RD ','MOME','    '/
34741      DATA INFLAV(203)/2/
34742      DATA INLONG(203)/'DIFFERENCE OF SKEWNESS'/
34743C
34744      DATA INCASE(204)/'DKUR'/
34745      DATA (INAME(204,J),J=1,MAXSCL)/
34746     1'DIFF','    ','OF  ','KURT','    ','    ','    ','    '/
34747      DATA INFLAV(204)/2/
34748      DATA INLONG(204)/'DIFFERENCE OF KURTOSIS'/
34749C
34750      DATA INCASE(205)/'DKUR'/
34751      DATA (INAME(205,J),J=1,MAXSCL)/
34752     1'DIFF','    ','OF  ','STAN','CENT','FOUR','MOME','    '/
34753      DATA INFLAV(205)/2/
34754      DATA INLONG(205)/'DIFFERENCE OF KURTOSIS'/
34755C
34756      DATA INCASE(206)/'DKUR'/
34757      DATA (INAME(206,J),J=1,MAXSCL)/
34758     1'DIFF','    ','OF  ','STAN','CENT','4TH ','MOME','    '/
34759      DATA INFLAV(206)/2/
34760      DATA INLONG(206)/'DIFFERENCE OF KURTOSIS'/
34761C
34762      DATA INCASE(207)/'DRSD'/
34763      DATA (INAME(207,J),J=1,MAXSCL)/
34764     1'DIFF','    ','OF  ','RELA','SD  ','    ','    ','    '/
34765      DATA INFLAV(207)/2/
34766      DATA INLONG(207)/'DIFFERENCE OF RELATIVE STANDARD DEVIATIONS'/
34767C
34768      DATA INCASE(208)/'DRSD'/
34769      DATA (INAME(208,J),J=1,MAXSCL)/
34770     1'DIFF','    ','OF  ','RELA','STAN','DEVI','    ','    '/
34771      DATA INFLAV(208)/2/
34772      DATA INLONG(208)/'DIFFERENCE OF RELATIVE STANDARD DEVIATIONS'/
34773C
34774      DATA INCASE(209)/'DRVA'/
34775      DATA (INAME(209,J),J=1,MAXSCL)/
34776     1'DIFF','    ','OF  ','RELA','VARI','    ','    ','    '/
34777      DATA INFLAV(209)/2/
34778      DATA INLONG(209)/'DIFFERENCE OF RELATIVE VARIANCES'/
34779C
34780      DATA INCASE(210)/'DMIN'/
34781      DATA (INAME(210,J),J=1,MAXSCL)/
34782     1'DIFF','    ','OF  ','MINI','    ','    ','    ','    '/
34783      DATA INFLAV(210)/2/
34784      DATA INLONG(210)/'DIFFERENCE OF MINIMUMS'/
34785C
34786      DATA INCASE(211)/'DMAX'/
34787      DATA (INAME(211,J),J=1,MAXSCL)/
34788     1'DIFF','    ','OF  ','MAXI','    ','    ','    ','    '/
34789      DATA INFLAV(211)/2/
34790      DATA INLONG(211)/'DIFFERENCE OF MAXIMUMS'/
34791C
34792      DATA INCASE(212)/'DEXT'/
34793      DATA (INAME(212,J),J=1,MAXSCL)/
34794     1'DIFF','    ','OF  ','EXTR','    ','    ','    ','    '/
34795      DATA INFLAV(212)/2/
34796      DATA INLONG(212)/'DIFFERENCE OF EXTREMES'/
34797C
34798      DATA INCASE(213)/'DCVA'/
34799      DATA (INAME(213,J),J=1,MAXSCL)/
34800     1'DIFF','    ','OF  ','COEF','OF  ','VARI','    ','    '/
34801      DATA INFLAV(213)/2/
34802      DATA INLONG(213)/'DIFFERENCE OF COEFFICIENT OF VARIATIONS'/
34803C
34804      DATA INCASE(214)/'DCVA'/
34805      DATA (INAME(214,J),J=1,MAXSCL)/
34806     1'DIFF','    ','OF  ','COEF','VARI','    ','    ','    '/
34807      DATA INFLAV(214)/2/
34808      DATA INLONG(214)/'DIFFERENCE OF COEFFICIENT OF VARIATIONS'/
34809C
34810      DATA INCASE(215)/'DSN '/
34811      DATA (INAME(215,J),J=1,MAXSCL)/
34812     1'DIFF','    ','OF  ','SN  ','SCAL','    ','    ','    '/
34813      DATA INFLAV(215)/2/
34814      DATA INLONG(215)/'DIFFERENCE OF SN SCALES'/
34815C
34816      DATA INCASE(216)/'DSN '/
34817      DATA (INAME(216,J),J=1,MAXSCL)/
34818     1'DIFF','    ','OF  ','SN  ','    ','    ','    ','    '/
34819      DATA INFLAV(216)/2/
34820      DATA INLONG(216)/'DIFFERENCE OF SN SCALES'/
34821C
34822      DATA INCASE(217)/'DQN '/
34823      DATA (INAME(217,J),J=1,MAXSCL)/
34824     1'DIFF','    ','OF  ','QN  ','SCAL','    ','    ','    '/
34825      DATA INFLAV(217)/2/
34826      DATA INLONG(217)/'DIFFERENCE OF QN SCALES'/
34827C
34828      DATA INCASE(218)/'DQN '/
34829      DATA (INAME(218,J),J=1,MAXSCL)/
34830     1'DIFF','    ','OF  ','QN  ','    ','    ','    ','    '/
34831      DATA INFLAV(218)/2/
34832      DATA INLONG(218)/'DIFFERENCE OF QN SCALES'/
34833C
34834      DATA INCASE(219)/'DSSM'/
34835      DATA (INAME(219,J),J=1,MAXSCL)/
34836     1'DIFF','    ','SUM ','OF  ','SQUA','FROM','MEAN','    '/
34837      DATA INFLAV(219)/2/
34838      DATA INLONG(219)/'DIFFERENCE OF SUM OF SQUARES FROM MEAN'/
34839C
34840      DATA INCASE(220)/'DSSM'/
34841      DATA (INAME(220,J),J=1,MAXSCL)/
34842     1'DIFF','    ','SUMS','OF  ','SQUA','FROM','MEAN','    '/
34843      DATA INFLAV(220)/2/
34844      DATA INLONG(220)/'DIFFERENCE OF SUM OF SQUARES FROM MEAN'/
34845C
34846      DATA INCASE(221)/'COVA'/
34847      DATA (INAME(221,J),J=1,MAXSCL)/
34848     1'COVA','    ','    ','    ','    ','    ','    ','    '/
34849      DATA INFLAV(221)/2/
34850      DATA INLONG(221)/'COVARIANCE'/
34851C
34852      DATA INCASE(222)/'BPRC'/
34853      DATA (INAME(222,J),J=1,MAXSCL)/
34854     1'CORR','    ','BINO','PROB','    ','    ','    ','    '/
34855      DATA INFLAV(222)/1/
34856      DATA INLONG(222)/'BINOMIAL PROPORTION (CONTINUITY CORRECTION)'/
34857C
34858      DATA INCASE(223)/'RMLL'/
34859      DATA (INAME(223,J),J=1,MAXSCL)/
34860     1'RATI','    ','OF  ','MEAN','LOWE','CONF','LIMI','    '/
34861      DATA INFLAV(223)/2/
34862      DATA INLONG(223)/'RATIO OF MEANS LOWER CONFIDENCE LIMIT'/
34863C
34864      DATA INCASE(224)/'ORSE'/
34865      DATA (INAME(224,J),J=1,MAXSCL)/
34866     1'ODDS','    ','RATI','STAN','ERRO','    ','    ','    '/
34867      DATA INFLAV(224)/2/
34868      DATA INLONG(224)/'ODDS RATIO STANDARD ERROR'/
34869C
34870      DATA INCASE(225)/'ODRA'/
34871      DATA (INAME(225,J),J=1,MAXSCL)/
34872     1'ODDS','    ','RATI','    ','    ','    ','    ','    '/
34873      DATA INFLAV(225)/2/
34874      DATA INLONG(225)/'ODDS RATIO'/
34875C
34876      DATA INCASE(226)/'RELR'/
34877      DATA (INAME(226,J),J=1,MAXSCL)/
34878     1'RELA','    ','RISK','    ','    ','    ','    ','    '/
34879      DATA INFLAV(226)/2/
34880      DATA INLONG(226)/'RELATIVE RISK'/
34881C
34882      DATA INCASE(227)/'CRAM'/
34883      DATA (INAME(227,J),J=1,MAXSCL)/
34884     1'CRAM','    ','CONT','COEF','    ','    ','    ','    '/
34885      DATA INFLAV(227)/2/
34886      DATA INLONG(227)/'CRAMER CONTINGENCY COEFFICIENT'/
34887C
34888      DATA INCASE(228)/'PEAR'/
34889      DATA (INAME(228,J),J=1,MAXSCL)/
34890     1'PEAR','    ','CONT','COEF','    ','    ','    ','    '/
34891      DATA INFLAV(228)/2/
34892      DATA INLONG(228)/'PEARSON CONTINGENCY COEFFICIENT'/
34893C
34894      DATA INCASE(229)/'FALP'/
34895      DATA (INAME(229,J),J=1,MAXSCL)/
34896     1'FALS','    ','POSI','    ','    ','    ','    ','    '/
34897      DATA INFLAV(229)/2/
34898      DATA INLONG(229)/'FALSE POSITIVE'/
34899C
34900      DATA INCASE(230)/'FALN'/
34901      DATA (INAME(230,J),J=1,MAXSCL)/
34902     1'FALS','    ','NEGA','    ','    ','    ','    ','    '/
34903      DATA INFLAV(230)/2/
34904      DATA INLONG(230)/'FALSE NEGATIVES'/
34905C
34906      DATA INCASE(231)/'TRUP'/
34907      DATA (INAME(231,J),J=1,MAXSCL)/
34908     1'TRUE','    ','POSI','    ','    ','    ','    ','    '/
34909      DATA INFLAV(231)/2/
34910      DATA INLONG(231)/'TRUE POSITIVES'/
34911C
34912      DATA INCASE(232)/'TRUN'/
34913      DATA (INAME(232,J),J=1,MAXSCL)/
34914     1'TRUE','    ','NEGA','    ','    ','    ','    ','    '/
34915      DATA INFLAV(232)/2/
34916      DATA INLONG(232)/'TRUE NEGATIVES'/
34917C
34918      DATA INCASE(233)/'SENS'/
34919      DATA (INAME(233,J),J=1,MAXSCL)/
34920     1'TEST','    ','SENS','    ','    ','    ','    ','    '/
34921      DATA INFLAV(233)/2/
34922      DATA INLONG(233)/'TEST SENSITIVITY'/
34923C
34924      DATA INCASE(234)/'SPEC'/
34925      DATA (INAME(234,J),J=1,MAXSCL)/
34926     1'TEST','    ','SPEC','    ','    ','    ','    ','    '/
34927      DATA INFLAV(234)/2/
34928      DATA INLONG(234)/'TEST SPECIFICITY'/
34929C
34930      DATA INCASE(235)/'SENS'/
34931      DATA (INAME(235,J),J=1,MAXSCL)/
34932     1'SENS','    ','    ','    ','    ','    ','    ','    '/
34933      DATA INFLAV(235)/2/
34934      DATA INLONG(235)/'TEST SENSITIVITY'/
34935C
34936      DATA INCASE(236)/'SPEC'/
34937      DATA (INAME(236,J),J=1,MAXSCL)/
34938     1'SPEC','IFIC','    ','    ','    ','    ','    ','    '/
34939      DATA INFLAV(236)/2/
34940      DATA INLONG(236)/'TEST SPECIFICITY'/
34941C
34942      DATA INCASE(237)/'PPV '/
34943      DATA (INAME(237,J),J=1,MAXSCL)/
34944     1'POSI','    ','PRED','VALU','    ','    ','    ','    '/
34945      DATA INFLAV(237)/2/
34946      DATA INLONG(237)/'POSITIVE PREDICTIVE VALUE'/
34947C
34948      DATA INCASE(238)/'PPV '/
34949      DATA (INAME(238,J),J=1,MAXSCL)/
34950     1'PPV ','    ','    ','    ','    ','    ','    ','    '/
34951      DATA INFLAV(238)/2/
34952      DATA INLONG(238)/'POSITIVE PREDICTIVE VALUE'/
34953C
34954      DATA INCASE(239)/'NPV '/
34955      DATA (INAME(239,J),J=1,MAXSCL)/
34956     1'NEGA','    ','PRED','VALU','    ','    ','    ','    '/
34957      DATA INFLAV(239)/2/
34958      DATA INLONG(239)/'NEGATIVE PREDICTIVE VALUE'/
34959C
34960      DATA INCASE(240)/'NPV '/
34961      DATA (INAME(240,J),J=1,MAXSCL)/
34962     1'NPV ','    ','    ','    ','    ','    ','    ','    '/
34963      DATA INFLAV(240)/2/
34964      DATA INLONG(240)/'NEGATIVE PREDICTIVE VALUE'/
34965C
34966      DATA INCASE(241)/'ORSE'/
34967      DATA (INAME(241,J),J=1,MAXSCL)/
34968     1'STAN','    ','ERRO','ODDS','RATI','    ','    ','    '/
34969      DATA INFLAV(241)/2/
34970      DATA INLONG(241)/'STANDARD ERROR OF THE ODDS RATIO'/
34971C
34972      DATA INCASE(242)/'LOSE'/
34973      DATA (INAME(242,J),J=1,MAXSCL)/
34974     1'STAN','    ','ERRO','LOG ','ODDS','RATI','    ','    '/
34975      DATA INFLAV(242)/2/
34976      DATA INLONG(242)/'STANDARD ERROR OF THE LOG ODDS RATIO'/
34977C
34978      DATA INCASE(243)/'LOSE'/
34979      DATA (INAME(243,J),J=1,MAXSCL)/
34980     1'STAN','    ','ERRO','LOGA','ODDS','RATI','    ','    '/
34981      DATA INFLAV(243)/2/
34982      DATA INLONG(243)/'STANDARD ERROR OF THE LOG ODDS RATIO'/
34983C
34984      DATA INCASE(244)/'LOSE'/
34985      DATA (INAME(244,J),J=1,MAXSCL)/
34986     1'LOG ','    ','ODDS','RATI','STAN','ERRO','    ','    '/
34987      DATA INFLAV(244)/2/
34988      DATA INLONG(244)/'STANDARD ERROR OF THE LOG ODDS RATIO'/
34989C
34990      DATA INCASE(245)/'LOSE'/
34991      DATA (INAME(245,J),J=1,MAXSCL)/
34992     1'LOGA','    ','ODDS','RATI','STAN','ERRO','    ','    '/
34993      DATA INFLAV(245)/2/
34994      DATA INLONG(245)/'STANDARD ERROR OF THE LOG ODDS RATIO'/
34995C
34996      DATA INCASE(246)/'LODR'/
34997      DATA (INAME(246,J),J=1,MAXSCL)/
34998     1'LOG ','    ','ODDS','RATI','    ','    ','    ','    '/
34999      DATA INFLAV(246)/2/
35000      DATA INLONG(246)/'LOG ODDS RATIO'/
35001C
35002      DATA INCASE(247)/'LODR'/
35003      DATA (INAME(247,J),J=1,MAXSCL)/
35004     1'LOGA','    ','ODDS','RATI','    ','    ','    ','    '/
35005      DATA INFLAV(247)/2/
35006      DATA INLONG(247)/'LOG ODDS RATIO'/
35007C
35008      DATA INCASE(248)/'TRSD'/
35009      DATA (INAME(248,J),J=1,MAXSCL)/
35010     1'TRIM','    ','STAN','DEVI','    ','    ','    ','    '/
35011      DATA INFLAV(248)/1/
35012      DATA INLONG(248)/'TRIMMED STANDARD DEVIATION'/
35013C
35014      DATA INCASE(249)/'TRSD'/
35015      DATA (INAME(249,J),J=1,MAXSCL)/
35016     1'TRIM','    ','SD  ','    ','    ','    ','    ','    '/
35017      DATA INFLAV(249)/1/
35018      DATA INLONG(249)/'TRIMMED STANDARD DEVIATION'/
35019C
35020      DATA INCASE(250)/'LPME'/
35021      DATA (INAME(250,J),J=1,MAXSCL)/
35022     1'LP  ','    ','LOCA','    ','    ','    ','    ','    '/
35023      DATA INFLAV(250)/1/
35024      DATA INLONG(250)/'LP LOCATION'/
35025C
35026      DATA INCASE(251)/'LPVA'/
35027      DATA (INAME(251,J),J=1,MAXSCL)/
35028     1'VARI','    ','OF  ','LP  ','LOCA','    ','    ','    '/
35029      DATA INFLAV(251)/1/
35030      DATA INLONG(251)/'VARIANCE OF LP LOCATION'/
35031C
35032      DATA INCASE(252)/'WEVA'/
35033      DATA (INAME(252,J),J=1,MAXSCL)/
35034     1'WEIG','    ','VARI','    ','    ','    ','    ','    '/
35035      DATA INFLAV(252)/2/
35036      DATA INLONG(252)/'WEIGHTED VARIANCE'/
35037C
35038      DATA INCASE(253)/'LPSD'/
35039      DATA (INAME(253,J),J=1,MAXSCL)/
35040     1'SD  ','    ','OF  ','LP  ','LOCA','    ','    ','    '/
35041      DATA INFLAV(253)/1/
35042      DATA INLONG(253)/'STANDARD DEVIATION OF LP LOCATION'/
35043C
35044      DATA INCASE(254)/'LPSD'/
35045      DATA (INAME(254,J),J=1,MAXSCL)/
35046     1'SD  ','    ','LP  ','LOCA','    ','    ','    ','    '/
35047      DATA INFLAV(254)/1/
35048      DATA INLONG(254)/'STANDARD DEVIATION OF LP LOCATION'/
35049C
35050      DATA INCASE(255)/'LPSD'/
35051      DATA (INAME(255,J),J=1,MAXSCL)/
35052     1'STAN','    ','DEVI','LP  ','LOCA','    ','    ','    '/
35053      DATA INFLAV(255)/1/
35054      DATA INLONG(255)/'STANDARD DEVIATION OF LP LOCATION'/
35055C
35056      DATA INCASE(256)/'LPSD'/
35057      DATA (INAME(256,J),J=1,MAXSCL)/
35058     1'STAN','    ','DEVI','OF  ','LP  ','LOCA','    ','    '/
35059      DATA INFLAV(256)/1/
35060      DATA INLONG(256)/'STANDARD DEVIATION OF LP LOCATION'/
35061C
35062      DATA INCASE(257)/'DLPL'/
35063      DATA (INAME(257,J),J=1,MAXSCL)/
35064     1'DIFF','    ','OF  ','LP  ','LOCA','    ','    ','    '/
35065      DATA INFLAV(257)/2/
35066      DATA INLONG(257)/'DIFFERENCE OF LP LOCATIONS'/
35067C
35068      DATA INCASE(258)/'DLPV'/
35069      DATA (INAME(258,J),J=1,MAXSCL)/
35070     1'DIFF','    ','OF  ','VARI','LP  ','LOCA','    ','    '/
35071      DATA INFLAV(258)/2/
35072      DATA INLONG(258)/'DIFFERENCE OF VARIANCE OF LP LOCATIONS'/
35073C
35074      DATA INCASE(259)/'DLPV'/
35075      DATA (INAME(259,J),J=1,MAXSCL)/
35076     1'DIFF','    ','OF  ','VARI','OF  ','LP  ','LOCA','    '/
35077      DATA INFLAV(259)/2/
35078      DATA INLONG(259)/'DIFFERENCE OF VARIANCE OF LP LOCATIONS'/
35079C
35080      DATA INCASE(260)/'DLPS'/
35081      DATA (INAME(260,J),J=1,MAXSCL)/
35082     1'DIFF','    ','OF  ','SD  ','LP  ','LOCA','    ','    '/
35083      DATA INFLAV(260)/2/
35084      DATA INLONG(260)
35085     1     /'DIFFERENCE OF STANDARD DEVIATIONS OF LP LOCATIONS'/
35086C
35087      DATA INCASE(261)/'DLPS'/
35088      DATA (INAME(261,J),J=1,MAXSCL)/
35089     1'DIFF','    ','OF  ','SD  ','OF  ','LP  ','LOCA','    '/
35090      DATA INFLAV(261)/2/
35091      DATA INLONG(261)
35092     1     /'DIFFERENCE OF STANDARD DEVIATIONS OF LP LOCATIONS'/
35093C
35094      DATA INCASE(262)/'BPLC'/
35095      DATA (INAME(262,J),J=1,MAXSCL)/
35096     1'BINO','    ','PROB','LOWE','CONF','LIMI','    ','    '/
35097      DATA INFLAV(262)/1/
35098      DATA INLONG(262)/'BINOMIAL PROPORTION LOWER CONFIDENCE LIMIT'/
35099C
35100      DATA INCASE(263)/'BPLC'/
35101      DATA (INAME(263,J),J=1,MAXSCL)/
35102     1'BINO','    ','PROP','LOWE','CONF','LIMI','    ','    '/
35103      DATA INFLAV(263)/1/
35104      DATA INLONG(263)/'BINOMIAL PROPORTION LOWER CONFIDENCE LIMIT'/
35105C
35106      DATA INCASE(264)/'DBLC'/
35107      DATA (INAME(264,J),J=1,MAXSCL)/
35108     1'DIFF','    ','BINO','PROB','LOWE','CONF','LIMI','    '/
35109      DATA INFLAV(264)/2/
35110      DATA INLONG(264)/'DIFF OF BINOMIAL PROPORTIONS LOWER CONF LIMIT'/
35111C
35112      DATA INCASE(265)/'DBLC'/
35113      DATA (INAME(265,J),J=1,MAXSCL)/
35114     1'DIFF','    ','BINO','PROP','LOWE','CONF','LIMI','    '/
35115      DATA INFLAV(265)/2/
35116      DATA INLONG(265)/'DIFF OF BINOMIAL PROPORTIONS LOWER CONF LIMIT'/
35117C
35118      DATA INCASE(266)/'DBLC'/
35119      DATA (INAME(266,J),J=1,MAXSCL)/
35120     1'DIFF','    ','OF  ','BINO','PROP','LOWE','CONF','LIMI'/
35121      DATA INFLAV(266)/2/
35122      DATA INLONG(266)/'DIFF OF BINOMIAL PROPORTIONS LOWER CONF LIMIT'/
35123C
35124      DATA INCASE(267)/'DBLC'/
35125      DATA (INAME(267,J),J=1,MAXSCL)/
35126     1'DIFF','    ','OF  ','BINO','PROB','LOWE','CONF','LIMI'/
35127      DATA INFLAV(267)/2/
35128      DATA INLONG(267)/'DIFF OF BINOMIAL PROPORTIONS LOWER CONF LIMIT'/
35129C
35130      DATA INCASE(268)/'1TCD'/
35131      DATA (INAME(268,J),J=1,MAXSCL)/
35132     1'ONE ','    ','SAMP','T   ','TEST','CDF ','    ','    '/
35133      DATA INFLAV(268)/1/
35134      DATA INLONG(268)/'ONE SAMPLE T-TEST CDF'/
35135C
35136      DATA INCASE(269)/'1T2P'/
35137      DATA (INAME(269,J),J=1,MAXSCL)/
35138     1'ONE ','    ','SAMP','T   ','TEST','PVAL','    ','    '/
35139      DATA INFLAV(269)/1/
35140      DATA INLONG(269)/'ONE SAMPLE T-TEST P-VALUE'/
35141C
35142      DATA INCASE(270)/'GCDF'/
35143      DATA (INAME(270,J),J=1,MAXSCL)/
35144     1'GRUB','    ','CDF ','    ','    ','    ','    ','    '/
35145      DATA INFLAV(270)/1/
35146      DATA INLONG(270)/'GRUBB TEST STATISTIC CDF'/
35147C
35148      DATA INCASE(271)/'GCDF'/
35149      DATA (INAME(271,J),J=1,MAXSCL)/
35150     1'GRUB','    ','TEST','CDF ','    ','    ','    ','    '/
35151      DATA INFLAV(271)/1/
35152      DATA INLONG(271)/'GRUBB TEST STATISTIC CDF'/
35153C
35154      DATA INCASE(272)/'GCDF'/
35155      DATA (INAME(272,J),J=1,MAXSCL)/
35156     1'GRUB','    ','STAT','CDF ','    ','    ','    ','    '/
35157      DATA INFLAV(272)/1/
35158      DATA INLONG(272)/'GRUBB TEST STATISTIC CDF'/
35159C
35160      DATA INCASE(273)/'GDIR'/
35161      DATA (INAME(273,J),J=1,MAXSCL)/
35162     1'GRUB','    ','DIRE','    ','    ','    ','    ','    '/
35163      DATA INFLAV(273)/1/
35164      DATA INLONG(273)/'GRUBB TEST STATISTIC DIRECTION'/
35165C
35166      DATA INCASE(274)/'GDIR'/
35167      DATA (INAME(274,J),J=1,MAXSCL)/
35168     1'GRUB','    ','TEST','STAT','DIRE','    ','    ','    '/
35169      DATA INFLAV(274)/1/
35170      DATA INLONG(274)/'GRUBB TEST STATISTIC DIRECTION'/
35171C
35172      DATA INCASE(275)/'GDIR'/
35173      DATA (INAME(275,J),J=1,MAXSCL)/
35174     1'GRUB','    ','TEST','DIRE','    ','    ','    ','    '/
35175      DATA INFLAV(275)/1/
35176      DATA INLONG(275)/'GRUBB TEST STATISTIC DIRECTION'/
35177C
35178      DATA INCASE(276)/'GDIR'/
35179      DATA (INAME(276,J),J=1,MAXSCL)/
35180     1'GRUB','    ','TEST','DIRE','    ','    ','    ','    '/
35181      DATA INFLAV(276)/1/
35182      DATA INLONG(276)/'GRUBB TEST STATISTIC DIRECTION'/
35183C
35184      DATA INCASE(277)/'GIND'/
35185      DATA (INAME(277,J),J=1,MAXSCL)/
35186     1'GRUB','    ','INDE','    ','    ','    ','    ','    '/
35187      DATA INFLAV(277)/1/
35188      DATA INLONG(277)/'GRUBB TEST STATISTIC INDEX'/
35189C
35190      DATA INCASE(278)/'GIND'/
35191      DATA (INAME(278,J),J=1,MAXSCL)/
35192     1'GRUB','    ','STAT','INDE','    ','    ','    ','    '/
35193      DATA INFLAV(278)/1/
35194      DATA INLONG(278)/'GRUBB TEST STATISTIC INDEX'/
35195C
35196      DATA INCASE(279)/'GIND'/
35197      DATA (INAME(279,J),J=1,MAXSCL)/
35198     1'GRUB','    ','TEST','INDE','    ','    ','    ','    '/
35199      DATA INFLAV(279)/1/
35200      DATA INLONG(279)/'GRUBB TEST STATISTIC INDEX'/
35201C
35202      DATA INCASE(280)/'GIND'/
35203      DATA (INAME(280,J),J=1,MAXSCL)/
35204     1'GRUB','    ','TEST','STAT','INDE','    ','    ','    '/
35205      DATA INFLAV(280)/1/
35206      DATA INLONG(280)/'GRUBB TEST STATISTIC INDEX'/
35207C
35208      DATA INCASE(281)/'GRUB'/
35209      DATA (INAME(281,J),J=1,MAXSCL)/
35210     1'GRUB','    ','TEST','STAT','    ','    ','    ','    '/
35211      DATA INFLAV(281)/1/
35212      DATA INLONG(281)/'GRUBB TEST STATISTIC'/
35213C
35214      DATA INCASE(282)/'GRUB'/
35215      DATA (INAME(282,J),J=1,MAXSCL)/
35216     1'GRUB','    ','TEST','    ','    ','    ','    ','    '/
35217      DATA INFLAV(282)/1/
35218      DATA INLONG(282)/'GRUBB TEST STATISTIC'/
35219C
35220      DATA INCASE(283)/'GRUB'/
35221      DATA (INAME(283,J),J=1,MAXSCL)/
35222     1'GRUB','    ','STAT','    ','    ','    ','    ','    '/
35223      DATA INFLAV(283)/1/
35224      DATA INLONG(283)/'GRUBB TEST STATISTIC'/
35225C
35226      DATA INCASE(284)/'GRUB'/
35227      DATA (INAME(284,J),J=1,MAXSCL)/
35228     1'GRUB','    ','    ','    ','    ','    ','    ','    '/
35229      DATA INFLAV(284)/1/
35230      DATA INLONG(284)/'GRUBB TEST STATISTIC'/
35231C
35232      DATA INCASE(285)/'CCDF'/
35233      DATA (INAME(285,J),J=1,MAXSCL)/
35234     1'CHI ','    ','SQUA','SD  ','TEST','CDF ','    ','    '/
35235      DATA INFLAV(285)/1/
35236      DATA INLONG(285)/'CHI-SQUARE STANDARD DEVIATION STATISTIC CDF'/
35237C
35238      DATA INCASE(286)/'CCDF'/
35239      DATA (INAME(286,J),J=1,MAXSCL)/
35240     1'CHI ','    ','SQUA','STAN','DEVI','TEST','CDF ','    '/
35241      DATA INFLAV(286)/1/
35242      DATA INLONG(286)/'CHI-SQUARE STANDARD DEVIATION STATISTIC CDF'/
35243C
35244      DATA INCASE(287)/'CS2P'/
35245      DATA (INAME(287,J),J=1,MAXSCL)/
35246     1'CHI ','    ','SQUA','STAN','DEVI','TEST','PVAL','    '/
35247      DATA INFLAV(287)/1/
35248      DATA INLONG(287)/'CHI-SQUARE STANDARD DEVIATION PVALUE'/
35249C
35250      DATA INCASE(288)/'FRCD'/
35251      DATA (INAME(288,J),J=1,MAXSCL)/
35252     1'FREQ','    ','TEST','CDF ','    ','    ','    ','    '/
35253      DATA INFLAV(288)/1/
35254      DATA INLONG(288)/'FREQUENCY TEST STATISTIC CDF'/
35255C
35256      DATA INCASE(289)/'FRET'/
35257      DATA (INAME(289,J),J=1,MAXSCL)/
35258     1'FREQ','    ','TEST','    ','    ','    ','    ','    '/
35259      DATA INFLAV(289)/1/
35260      DATA INLONG(289)/'FREQUENCY TEST STATISTIC'/
35261C
35262      DATA INCASE(290)/'FBLO'/
35263      DATA (INAME(290,J),J=1,MAXSCL)/
35264     1'FREQ','    ','WITH','A   ','BLOC','TEST','    ','    '/
35265      DATA INFLAV(290)/1/
35266      DATA INLONG(290)/'FREQUENCY WITHIN A BLOCK FREQUENCY TEST'/
35267C
35268      DATA INCASE(291)/'FBCD'/
35269      DATA (INAME(291,J),J=1,MAXSCL)/
35270     1'FREQ','    ','WITH','A   ','BLOC','TEST','CDF ','    '/
35271      DATA INFLAV(291)/1/
35272      DATA INLONG(291)/'FREQUENCY WITHIN A BLOCK FREQUENCY TEST CDF'/
35273C
35274      DATA INCASE(292)/'INMN'/
35275      DATA (INAME(292,J),J=1,MAXSCL)/
35276     1'INDE','    ','MINI','    ','    ','    ','    ','    '/
35277      DATA INFLAV(292)/1/
35278      DATA INLONG(292)/'INDEX MINIMUM'/
35279C
35280      DATA INCASE(293)/'NUMB'/
35281      DATA (INAME(293,J),J=1,MAXSCL)/
35282     1'NUMB','    ','    ','    ','    ','    ','    ','    '/
35283      DATA INFLAV(293)/1/
35284      DATA INLONG(293)/'NUMBER'/
35285C
35286      DATA INCASE(294)/'CDIG'/
35287      DATA (INAME(294,J),J=1,MAXSCL)/
35288     1'COMM','    ','DIGI','    ','    ','    ','    ','    '/
35289      DATA INFLAV(294)/1/
35290      DATA INLONG(294)/'COMMON DIGITS'/
35291C
35292      DATA INCASE(295)/'NOLO'/
35293      DATA (INAME(295,J),J=1,MAXSCL)/
35294     1'NORM','    ','PPCC','LOCA','    ','    ','    ','    '/
35295      DATA INFLAV(295)/1/
35296      DATA INLONG(295)/'NORMAL PPCC LOCATION'/
35297C
35298      DATA INCASE(296)/'UNLO'/
35299      DATA (INAME(296,J),J=1,MAXSCL)/
35300     1'UNIF','    ','PPCC','LOCA','    ','    ','    ','    '/
35301      DATA INFLAV(296)/1/
35302      DATA INLONG(296)/'UNIFORM PPCC LOCATION'/
35303C
35304      DATA INCASE(297)/'MINI'/
35305      DATA (INAME(297,J),J=1,MAXSCL)/
35306     1'MIN ','    ','    ','    ','    ','    ','    ','    '/
35307      DATA INFLAV(297)/1/
35308      DATA INLONG(297)/'MINIMUM'/
35309C
35310      DATA INCASE(298)/'MAXI'/
35311      DATA (INAME(298,J),J=1,MAXSCL)/
35312     1'MAX ','    ','    ','    ','    ','    ','    ','    '/
35313      DATA INFLAV(298)/1/
35314      DATA INLONG(298)/'MAXIMUM'/
35315C
35316      DATA INCASE(299)/'AUVA'/
35317      DATA (INAME(299,J),J=1,MAXSCL)/
35318     1'AUTO','COVA','    ','    ','    ','    ','    ','    '/
35319      DATA INFLAV(299)/1/
35320      DATA INLONG(299)/'AUTOCOVARIANCE'/
35321C
35322      DATA INCASE(300)/'AUCR'/
35323      DATA (INAME(300,J),J=1,MAXSCL)/
35324     1'AUTO','CORR','    ','    ','    ','    ','    ','    '/
35325      DATA INFLAV(300)/1/
35326      DATA INLONG(300)/'AUTOCORRELATION'/
35327C
35328      DATA INCASE(301)/'INMN'/
35329      DATA (INAME(301,J),J=1,MAXSCL)/
35330     1'INDE','    ','MIN ','    ','    ','    ','    ','    '/
35331      DATA INFLAV(301)/1/
35332      DATA INLONG(301)/'INDEX MINIMUM'/
35333C
35334      DATA INCASE(302)/'INMX'/
35335      DATA (INAME(302,J),J=1,MAXSCL)/
35336     1'INDE','    ','MAXI','    ','    ','    ','    ','    '/
35337      DATA INFLAV(302)/1/
35338      DATA INLONG(302)/'INDEX MAXIMUM'/
35339C
35340      DATA INCASE(303)/'INMX'/
35341      DATA (INAME(303,J),J=1,MAXSCL)/
35342     1'INDE','    ','MAX ','    ','    ','    ','    ','    '/
35343      DATA INFLAV(303)/1/
35344      DATA INLONG(303)/'INDEX MAXIMUM'/
35345C
35346      DATA INCASE(304)/'INEX'/
35347      DATA (INAME(304,J),J=1,MAXSCL)/
35348     1'INDE','    ','EXTR','    ','    ','    ','    ','    '/
35349      DATA INFLAV(304)/1/
35350      DATA INLONG(304)/'INDEX EXTREME'/
35351C
35352      DATA INCASE(305)/'DPRO'/
35353      DATA (INAME(305,J),J=1,MAXSCL)/
35354     1'DIFF','    ','OF  ','PROD','    ','    ','    ','    '/
35355      DATA INFLAV(305)/2/
35356      DATA INLONG(305)/'DIFFERENCE OF PRODUCTS'/
35357C
35358      DATA INCASE(306)/'DCOU'/
35359      DATA (INAME(306,J),J=1,MAXSCL)/
35360     1'DIFF','    ','OF  ','COUN','    ','    ','    ','    '/
35361      DATA INFLAV(306)/2/
35362      DATA INLONG(306)/'DIFFERENCE OF COUNTS'/
35363C
35364      DATA INCASE(307)/'DCOU'/
35365      DATA (INAME(307,J),J=1,MAXSCL)/
35366     1'DIFF','    ','OF  ','NUMB','    ','    ','    ','    '/
35367      DATA INFLAV(307)/2/
35368      DATA INLONG(307)/'DIFFERENCE OF COUNTS'/
35369C
35370      DATA INCASE(308)/'DCOU'/
35371      DATA (INAME(308,J),J=1,MAXSCL)/
35372     1'DIFF','    ','OF  ','SIZE','    ','    ','    ','    '/
35373      DATA INFLAV(308)/2/
35374      DATA INLONG(308)/'DIFFERENCE OF COUNTS'/
35375C
35376      DATA INCASE(309)/'DCOU'/
35377      DATA (INAME(309,J),J=1,MAXSCL)/
35378     1'DIFF','    ','OF  ','SUBS','SIZE','    ','    ','    '/
35379      DATA INFLAV(309)/2/
35380      DATA INLONG(309)/'DIFFERENCE OF COUNTS'/
35381C
35382      DATA INCASE(310)/'DPER'/
35383      DATA (INAME(310,J),J=1,MAXSCL)/
35384     1'DIFF','    ','OF  ','PERC','    ','    ','    ','    '/
35385      DATA INFLAV(310)/2/
35386      DATA INLONG(310)/'DIFFERENCE OF PERCENTILES'/
35387C
35388      DATA INCASE(311)/'D1DE'/
35389      DATA (INAME(311,J),J=1,MAXSCL)/
35390     1'DIFF','    ','OF  ','FIRS','DECI','    ','    ','    '/
35391      DATA INFLAV(311)/2/
35392      DATA INLONG(311)/'DIFFERENCE OF FIRST DECILES'/
35393C
35394      DATA INCASE(312)/'D2DE'/
35395      DATA (INAME(312,J),J=1,MAXSCL)/
35396     1'DIFF','    ','OF  ','SECO','DECI','    ','    ','    '/
35397      DATA INFLAV(312)/2/
35398      DATA INLONG(312)/'DIFFERENCE OF SECOND DECILES'/
35399C
35400      DATA INCASE(313)/'D3DE'/
35401      DATA (INAME(313,J),J=1,MAXSCL)/
35402     1'DIFF','    ','OF  ','THIR','DECI','    ','    ','    '/
35403      DATA INFLAV(313)/2/
35404      DATA INLONG(313)/'DIFFERENCE OF THIRD DECILES'/
35405C
35406      DATA INCASE(314)/'D4DE'/
35407      DATA (INAME(314,J),J=1,MAXSCL)/
35408     1'DIFF','    ','OF  ','FOUR','DECI','    ','    ','    '/
35409      DATA INFLAV(314)/2/
35410      DATA INLONG(314)/'DIFFERENCE OF FOURTH DECILES'/
35411C
35412      DATA INCASE(315)/'D5DE'/
35413      DATA (INAME(315,J),J=1,MAXSCL)/
35414     1'DIFF','    ','OF  ','FIFT','DECI','    ','    ','    '/
35415      DATA INFLAV(315)/2/
35416      DATA INLONG(315)/'DIFFERENCE OF FIFTH DECILES'/
35417C
35418      DATA INCASE(316)/'D6DE'/
35419      DATA (INAME(316,J),J=1,MAXSCL)/
35420     1'DIFF','    ','OF  ','SIXT','DECI','    ','    ','    '/
35421      DATA INFLAV(316)/2/
35422      DATA INLONG(316)/'DIFFERENCE OF SIXTH DECILES'/
35423C
35424      DATA INCASE(317)/'D7DE'/
35425      DATA (INAME(317,J),J=1,MAXSCL)/
35426     1'DIFF','    ','OF  ','SEVE','DECI','    ','    ','    '/
35427      DATA INFLAV(317)/2/
35428      DATA INLONG(317)/'DIFFERENCE OF SEVENTH DECILES'/
35429C
35430      DATA INCASE(318)/'D8DE'/
35431      DATA (INAME(318,J),J=1,MAXSCL)/
35432     1'DIFF','    ','OF  ','EIGH','DECI','    ','    ','    '/
35433      DATA INFLAV(318)/2/
35434      DATA INLONG(318)/'DIFFERENCE OF EIGHTH DECILES'/
35435C
35436      DATA INCASE(319)/'D9DE'/
35437      DATA (INAME(319,J),J=1,MAXSCL)/
35438     1'DIFF','    ','OF  ','NINT','DECI','    ','    ','    '/
35439      DATA INFLAV(319)/2/
35440      DATA INLONG(319)/'DIFFERENCE OF NINTH DECILES'/
35441C
35442      DATA INCASE(320)/'DQSE'/
35443      DATA (INAME(320,J),J=1,MAXSCL)/
35444     1'DIFF','    ','OF  ','QUAN','STAN','ERRO','    ','    '/
35445      DATA INFLAV(320)/2/
35446      DATA INLONG(320)/'DIFFERENCE OF QUANTILE STANDARD ERRORS'/
35447C
35448      DATA INCASE(321)/'DQSE'/
35449      DATA (INAME(321,J),J=1,MAXSCL)/
35450     1'DIFF','    ','OF  ','QUAN','STAN','DEVI','    ','    '/
35451      DATA INFLAV(321)/2/
35452      DATA INLONG(321)/'DIFFERENCE OF QUANTILE STANDARD ERRORS'/
35453C
35454      DATA INCASE(322)/'DQSE'/
35455      DATA (INAME(322,J),J=1,MAXSCL)/
35456     1'DIFF','    ','OF  ','QUAN','SD  ','    ','    ','    '/
35457      DATA INFLAV(322)/2/
35458      DATA INLONG(322)/'DIFFERENCE OF QUANTILE STANDARD ERRORS'/
35459C
35460      DATA INCASE(323)/'WESD'/
35461      DATA (INAME(323,J),J=1,MAXSCL)/
35462     1'WEIG','    ','STAN','DEVI','    ','    ','    ','    '/
35463      DATA INFLAV(323)/2/
35464      DATA INLONG(323)/'WEIGHTED STANDARD DEVIATION'/
35465C
35466      DATA INCASE(324)/'WESD'/
35467      DATA (INAME(324,J),J=1,MAXSCL)/
35468     1'WEIG','    ','SD  ','    ','    ','    ','    ','    '/
35469      DATA INFLAV(324)/2/
35470      DATA INLONG(324)/'WEIGHTED STANDARD DEVIATION'/
35471C
35472      DATA INCASE(325)/'SD  '/
35473      DATA (INAME(325,J),J=1,MAXSCL)/
35474     1'S   ','    ','    ','    ','    ','    ','    ','    '/
35475      DATA INFLAV(325)/1/
35476      DATA INLONG(325)/'STANDARD DEVIATION'/
35477C
35478      DATA INCASE(326)/'INTE'/
35479      DATA (INAME(326,J),J=1,MAXSCL)/
35480     1'INTE','GRAL','    ','    ','    ','    ','    ','    '/
35481      DATA INFLAV(326)/1/
35482      DATA INLONG(326)/'INTEGRAL'/
35483C
35484      DATA INCASE(327)/'CS2P'/
35485      DATA (INAME(327,J),J=1,MAXSCL)/
35486     1'CHI ','    ','SQUA','SD  ','TEST','PVAL','    ','    '/
35487      DATA INFLAV(327)/1/
35488      DATA INLONG(327)/'CHI-SQUARE STANDARD DEVIATION PVALUE'/
35489C
35490      DATA INCASE(328)/'CCDF'/
35491      DATA (INAME(328,J),J=1,MAXSCL)/
35492     1'CHI ','    ','SQUA','SD  ','CDF ','    ','    ','    '/
35493      DATA INFLAV(328)/1/
35494      DATA INLONG(328)/'CHI-SQUARE STANDARD DEVIATION STATISTIC CDF'/
35495C
35496      DATA INCASE(329)/'CCDF'/
35497      DATA (INAME(329,J),J=1,MAXSCL)/
35498     1'CHI ','    ','SQUA','STAN','DEVI','CDF ','    ','    '/
35499      DATA INFLAV(329)/1/
35500      DATA INLONG(329)/'CHI-SQUARE STANDARD DEVIATION STATISTIC CDF'/
35501C
35502      DATA INCASE(330)/'CS2P'/
35503      DATA (INAME(330,J),J=1,MAXSCL)/
35504     1'CHI ','    ','SQUA','SD  ','PVAL','    ','    ','    '/
35505      DATA INFLAV(330)/1/
35506      DATA INLONG(330)/'CHI-SQUARE STANDARD DEVIATION PVALUE'/
35507C
35508      DATA INCASE(331)/'DTSD'/
35509      DATA (INAME(331,J),J=1,MAXSCL)/
35510     1'DIFF','    ','OF  ','TRIM','STAN','DEVI','    ','    '/
35511      DATA INFLAV(331)/1/
35512      DATA INLONG(331)/'DIFFERENCE OF TRIMMED STANDARD DEVIATION'/
35513C
35514      DATA INCASE(332)/'DTSD'/
35515      DATA (INAME(332,J),J=1,MAXSCL)/
35516     1'DIFF','    ','OF  ','TRIM','SD  ','    ','    ','    '/
35517      DATA INFLAV(332)/1/
35518      DATA INLONG(332)/'DIFFERENCE OF TRIMMED STANDARD DEVIATION'/
35519C
35520      DATA INCASE(333)/'DLHI'/
35521      DATA (INAME(333,J),J=1,MAXSCL)/
35522     1'DIFF','    ','OF  ','LOWE','HING','    ','    ','    '/
35523      DATA INFLAV(333)/1/
35524      DATA INLONG(333)/'DIFFERENCE OF LOWER HINGE'/
35525C
35526      DATA INCASE(334)/'DUHI'/
35527      DATA (INAME(334,J),J=1,MAXSCL)/
35528     1'DIFF','    ','OF  ','UPPE','HING','    ','    ','    '/
35529      DATA INFLAV(334)/1/
35530      DATA INLONG(334)/'DIFFERENCE OF UPPER HINGE'/
35531C
35532      DATA INCASE(335)/'DLQU'/
35533      DATA (INAME(335,J),J=1,MAXSCL)/
35534     1'DIFF','    ','OF  ','LOWE','QUAR','    ','    ','    '/
35535      DATA INFLAV(335)/1/
35536      DATA INLONG(335)/'DIFFERENCE OF LOWER QUARTILE'/
35537C
35538      DATA INCASE(336)/'DUQU'/
35539      DATA (INAME(336,J),J=1,MAXSCL)/
35540     1'DIFF','    ','OF  ','UPPE','QUAR','    ','    ','    '/
35541      DATA INFLAV(336)/1/
35542      DATA INLONG(336)/'DIFFERENCE OF UPPER QUARTILE'/
35543C
35544      DATA INCASE(337)/'GCDF'/
35545      DATA (INAME(337,J),J=1,MAXSCL)/
35546     1'GRUB','    ','TEST','STAT','CDF ','    ','    ','    '/
35547      DATA INFLAV(337)/1/
35548      DATA INLONG(337)/'GRUBB TEST STATISTIC CDF'/
35549C
35550      DATA INCASE(338)/'DCOU'/
35551      DATA (INAME(338,J),J=1,MAXSCL)/
35552     1'DIFF','    ','OF  ','SUBS','SIZE','    ','    ','    '/
35553      DATA INFLAV(338)/2/
35554      DATA INLONG(338)/'DIFFERENCE OF COUNTS'/
35555C
35556      DATA INCASE(339)/'MDCL'/
35557      DATA (INAME(339,J),J=1,MAXSCL)/
35558     1'MEDI','    ','CONF','LIMI','    ','    ','    ','    '/
35559      DATA INFLAV(339)/1/
35560      DATA INLONG(339)/'MEDIAN CONFIDENCE LIMIT'/
35561C
35562      DATA INCASE(340)/'VDIS'/
35563      DATA (INAME(340,J),J=1,MAXSCL)/
35564     1'VARI','    ','DIST','    ','    ','    ','    ','    '/
35565      DATA INFLAV(340)/1/
35566      DATA INLONG(340)/'VARIATIONAL DISTANCE'/
35567C
35568      DATA INCASE(341)/'TRIM'/
35569      DATA (INAME(341,J),J=1,MAXSCL)/
35570     1'TRIM','    ','MEAN','    ','    ','    ','    ','    '/
35571      DATA INFLAV(341)/1/
35572      DATA INLONG(341)/'TRIMMED MEAN'/
35573C
35574      DATA INCASE(342)/'MECL'/
35575      DATA (INAME(342,J),J=1,MAXSCL)/
35576     1'MEAN','    ','CONF','LIMI','    ','    ','    ','    '/
35577      DATA INFLAV(342)/1/
35578      DATA INLONG(342)/'MEAN CONFIDENCE LIMIT'/
35579C
35580      DATA INCASE(343)/'LPS2'/
35581      DATA (INAME(343,J),J=1,MAXSCL)/
35582     1'STAN','    ','DEVI','PRED','INTE','    ','    ','    '/
35583      DATA INFLAV(343)/2/
35584      DATA INLONG(343)/'LOWER SD PREDICTION LIMITS'/
35585C
35586      DATA INCASE(344)/'LPS2'/
35587      DATA (INAME(344,J),J=1,MAXSCL)/
35588     1'SD  ','    ','PRED','INTE','    ','    ','    ','    '/
35589      DATA INFLAV(344)/2/
35590      DATA INLONG(344)/'LOWER SD PREDICTION LIMITS'/
35591C
35592      DATA INCASE(345)/'GRO1'/
35593      DATA (INAME(345,J),J=1,MAXSCL)/
35594     1'GROU','    ','ONE ','    ','    ','    ','    ','    '/
35595      DATA INFLAV(345)/1/
35596      DATA INLONG(345)/'GROUP ONE'/
35597C
35598      DATA INCASE(346)/'GRO1'/
35599      DATA (INAME(346,J),J=1,MAXSCL)/
35600     1'GROU','    ','1   ','    ','    ','    ','    ','    '/
35601      DATA INFLAV(346)/1/
35602      DATA INLONG(346)/'GROUP ONE'/
35603C
35604      DATA INCASE(347)/'GRO2'/
35605      DATA (INAME(347,J),J=1,MAXSCL)/
35606     1'GROU','    ','TWO ','    ','    ','    ','    ','    '/
35607      DATA INFLAV(347)/1/
35608      DATA INLONG(347)/'GROUP TWO'/
35609C
35610      DATA INCASE(348)/'GRO2'/
35611      DATA (INAME(348,J),J=1,MAXSCL)/
35612     1'GROU','    ','2   ','    ','    ','    ','    ','    '/
35613      DATA INFLAV(348)/1/
35614      DATA INLONG(348)/'GROUP TWO'/
35615C
35616      DATA INCASE(349)/'GRO3'/
35617      DATA (INAME(349,J),J=1,MAXSCL)/
35618     1'GROU','    ','THRE','    ','    ','    ','    ','    '/
35619      DATA INFLAV(349)/1/
35620      DATA INLONG(349)/'GROUP THREE'/
35621C
35622      DATA INCASE(350)/'GRO3'/
35623      DATA (INAME(350,J),J=1,MAXSCL)/
35624     1'GROU','    ','3   ','    ','    ','    ','    ','    '/
35625      DATA INFLAV(350)/1/
35626      DATA INLONG(350)/'GROUP THREE'/
35627C
35628      DATA INCASE(351)/'GRO4'/
35629      DATA (INAME(351,J),J=1,MAXSCL)/
35630     1'GROU','    ','FOUR','    ','    ','    ','    ','    '/
35631      DATA INFLAV(351)/1/
35632      DATA INLONG(351)/'GROUP FOUR'/
35633C
35634      DATA INCASE(352)/'GRO4'/
35635      DATA (INAME(352,J),J=1,MAXSCL)/
35636     1'GROU','    ','4   ','    ','    ','    ','    ','    '/
35637      DATA INFLAV(352)/1/
35638      DATA INLONG(352)/'GROUP FOUR'/
35639C
35640      DATA INCASE(353)/'GRO5'/
35641      DATA (INAME(353,J),J=1,MAXSCL)/
35642     1'GROU','    ','FIVE','    ','    ','    ','    ','    '/
35643      DATA INFLAV(353)/1/
35644      DATA INLONG(353)/'GROUP FIVE'/
35645C
35646      DATA INCASE(354)/'GRO5'/
35647      DATA (INAME(354,J),J=1,MAXSCL)/
35648     1'GROU','    ','5   ','    ','    ','    ','    ','    '/
35649      DATA INFLAV(354)/1/
35650      DATA INLONG(354)/'GROUP FIVE'/
35651C
35652      DATA INCASE(355)/'GRO6'/
35653      DATA (INAME(355,J),J=1,MAXSCL)/
35654     1'GROU','    ','SIX ','    ','    ','    ','    ','    '/
35655      DATA INFLAV(355)/1/
35656      DATA INLONG(355)/'GROUP SIX'/
35657C
35658      DATA INCASE(356)/'GRO6'/
35659      DATA (INAME(356,J),J=1,MAXSCL)/
35660     1'GROU','    ','6   ','    ','    ','    ','    ','    '/
35661      DATA INFLAV(356)/1/
35662      DATA INLONG(356)/'GROUP SIX'/
35663C
35664      DATA INCASE(357)/'MMES'/
35665      DATA (INAME(357,J),J=1,MAXSCL)/
35666     1'MEAN','    ','OF  ','MEAN','SE  ','    ','    ','    '/
35667      DATA INFLAV(357)/2/
35668      DATA INLONG(357)/'MEAN OF MEANS STANDARD ERROR'/
35669C
35670      DATA INCASE(358)/'MECD'/
35671      DATA (INAME(358,J),J=1,MAXSCL)/
35672     1'MEDI','    ','TEST','CDF ','    ','    ','    ','    '/
35673      DATA INFLAV(358)/2/
35674      DATA INLONG(358)/'MEDIAN TEST CDF'/
35675C
35676      DATA INCASE(359)/'H10L'/
35677      DATA (INAME(359,J),J=1,MAXSCL)/
35678     1'H10 ','    ','LOCA','    ','    ','    ','    ','    '/
35679      DATA INFLAV(359)/1/
35680      DATA INLONG(359)/'H10 LOCATION'/
35681C
35682      DATA INCASE(360)/'H12L'/
35683      DATA (INAME(360,J),J=1,MAXSCL)/
35684     1'H12 ','    ','LOCA','    ','    ','    ','    ','    '/
35685      DATA INFLAV(360)/1/
35686      DATA INLONG(360)/'H12 LOCATION'/
35687C
35688      DATA INCASE(361)/'H15L'/
35689      DATA (INAME(361,J),J=1,MAXSCL)/
35690     1'H15 ','    ','LOCA','    ','    ','    ','    ','    '/
35691      DATA INFLAV(361)/1/
35692      DATA INLONG(361)/'H15 LOCATION'/
35693C
35694      DATA INCASE(362)/'H17L'/
35695      DATA (INAME(362,J),J=1,MAXSCL)/
35696     1'H17 ','    ','LOCA','    ','    ','    ','    ','    '/
35697      DATA INFLAV(362)/1/
35698      DATA INLONG(362)/'H17 LOCATION'/
35699C
35700      DATA INCASE(363)/'H20L'/
35701      DATA (INAME(363,J),J=1,MAXSCL)/
35702     1'H20 ','    ','LOCA','    ','    ','    ','    ','    '/
35703      DATA INFLAV(363)/1/
35704      DATA INLONG(363)/'H20 LOCATION'/
35705C
35706      DATA INCASE(364)/'H10S'/
35707      DATA (INAME(364,J),J=1,MAXSCL)/
35708     1'H10 ','    ','SCAL','    ','    ','    ','    ','    '/
35709      DATA INFLAV(364)/1/
35710      DATA INLONG(364)/'H10 SCALE'/
35711C
35712      DATA INCASE(365)/'H12S'/
35713      DATA (INAME(365,J),J=1,MAXSCL)/
35714     1'H12 ','    ','SCAL','    ','    ','    ','    ','    '/
35715      DATA INFLAV(365)/1/
35716      DATA INLONG(365)/'H12 SCALE'/
35717C
35718      DATA INCASE(366)/'H15S'/
35719      DATA (INAME(366,J),J=1,MAXSCL)/
35720     1'H15 ','    ','SCAL','    ','    ','    ','    ','    '/
35721      DATA INFLAV(366)/1/
35722      DATA INLONG(366)/'H15 LOCATION'/
35723C
35724      DATA INCASE(367)/'H17S'/
35725      DATA (INAME(367,J),J=1,MAXSCL)/
35726     1'H17 ','    ','SCAL','    ','    ','    ','    ','    '/
35727      DATA INFLAV(367)/1/
35728      DATA INLONG(367)/'H17 SCALE'/
35729C
35730      DATA INCASE(368)/'H20S'/
35731      DATA (INAME(368,J),J=1,MAXSCL)/
35732     1'H20 ','    ','SCAL','    ','    ','    ','    ','    '/
35733      DATA INFLAV(368)/1/
35734      DATA INLONG(368)/'H20 SCALE'/
35735C
35736      DATA INCASE(369)/'10LD'/
35737      DATA (INAME(369,J),J=1,MAXSCL)/
35738     1'DIFF','    ','H10 ','LOCA','    ','    ','    ','    '/
35739      DATA INFLAV(369)/2/
35740      DATA INLONG(369)/'DIFFERENCE OF H10 LOCATION'/
35741C
35742      DATA INCASE(370)/'10LD'/
35743      DATA (INAME(370,J),J=1,MAXSCL)/
35744     1'DIFF','    ','OF  ','H10 ','LOCA','    ','    ','    '/
35745      DATA INFLAV(370)/2/
35746      DATA INLONG(370)/'DIFFERENCE OF H10 LOCATION'/
35747C
35748      DATA INCASE(371)/'12LD'/
35749      DATA (INAME(371,J),J=1,MAXSCL)/
35750     1'DIFF','    ','H12 ','LOCA','    ','    ','    ','    '/
35751      DATA INFLAV(371)/2/
35752      DATA INLONG(371)/'DIFFERENCE OF H10 LOCATION'/
35753C
35754      DATA INCASE(372)/'12LD'/
35755      DATA (INAME(372,J),J=1,MAXSCL)/
35756     1'DIFF','    ','OF  ','H12 ','LOCA','    ','    ','    '/
35757      DATA INFLAV(372)/2/
35758      DATA INLONG(372)/'DIFFERENCE OF H12 LOCATION'/
35759C
35760      DATA INCASE(373)/'15LD'/
35761      DATA (INAME(373,J),J=1,MAXSCL)/
35762     1'DIFF','    ','H15 ','LOCA','    ','    ','    ','    '/
35763      DATA INFLAV(373)/2/
35764      DATA INLONG(373)/'DIFFERENCE OF H15 LOCATION'/
35765C
35766      DATA INCASE(374)/'15LD'/
35767      DATA (INAME(374,J),J=1,MAXSCL)/
35768     1'DIFF','    ','OF  ','H15 ','LOCA','    ','    ','    '/
35769      DATA INFLAV(374)/2/
35770      DATA INLONG(374)/'DIFFERENCE OF H15 LOCATION'/
35771C
35772      DATA INCASE(374)/'17LD'/
35773      DATA (INAME(374,J),J=1,MAXSCL)/
35774     1'DIFF','    ','H17 ','LOCA','    ','    ','    ','    '/
35775      DATA INFLAV(374)/2/
35776      DATA INLONG(374)/'DIFFERENCE OF H17 LOCATION'/
35777C
35778      DATA INCASE(375)/'17LD'/
35779      DATA (INAME(375,J),J=1,MAXSCL)/
35780     1'DIFF','    ','OF  ','H17 ','LOCA','    ','    ','    '/
35781      DATA INFLAV(375)/2/
35782      DATA INLONG(375)/'DIFFERENCE OF H17 LOCATION'/
35783C
35784      DATA INCASE(376)/'20LD'/
35785      DATA (INAME(376,J),J=1,MAXSCL)/
35786     1'DIFF','    ','H20 ','LOCA','    ','    ','    ','    '/
35787      DATA INFLAV(376)/2/
35788      DATA INLONG(376)/'DIFFERENCE OF H20 LOCATION'/
35789C
35790      DATA INCASE(377)/'20LD'/
35791      DATA (INAME(377,J),J=1,MAXSCL)/
35792     1'DIFF','    ','OF  ','H20 ','LOCA','    ','    ','    '/
35793      DATA INFLAV(377)/2/
35794      DATA INLONG(377)/'DIFFERENCE OF H20 LOCATION'/
35795C
35796      DATA INCASE(378)/'10SD'/
35797      DATA (INAME(378,J),J=1,MAXSCL)/
35798     1'DIFF','    ','H10 ','SCAL','    ','    ','    ','    '/
35799      DATA INFLAV(378)/2/
35800      DATA INLONG(378)/'DIFFERENCE OF H10 SCALE'/
35801C
35802      DATA INCASE(379)/'10SD'/
35803      DATA (INAME(379,J),J=1,MAXSCL)/
35804     1'DIFF','    ','OF  ','H10 ','SCAL','    ','    ','    '/
35805      DATA INFLAV(379)/2/
35806      DATA INLONG(379)/'DIFFERENCE OF H10 SCALE'/
35807C
35808      DATA INCASE(380)/'12SD'/
35809      DATA (INAME(380,J),J=1,MAXSCL)/
35810     1'DIFF','    ','H12 ','SCAL','    ','    ','    ','    '/
35811      DATA INFLAV(380)/2/
35812      DATA INLONG(380)/'DIFFERENCE OF H12 SCALE'/
35813C
35814      DATA INCASE(381)/'12SD'/
35815      DATA (INAME(381,J),J=1,MAXSCL)/
35816     1'DIFF','    ','OF  ','H12 ','SCAL','    ','    ','    '/
35817      DATA INFLAV(381)/2/
35818      DATA INLONG(381)/'DIFFERENCE OF H12 SCALE'/
35819C
35820      DATA INCASE(382)/'15SD'/
35821      DATA (INAME(382,J),J=1,MAXSCL)/
35822     1'DIFF','    ','H15 ','SCAL','    ','    ','    ','    '/
35823      DATA INFLAV(382)/2/
35824      DATA INLONG(382)/'DIFFERENCE OF H15 SCALE'/
35825C
35826      DATA INCASE(383)/'15SD'/
35827      DATA (INAME(383,J),J=1,MAXSCL)/
35828     1'DIFF','    ','OF  ','H15 ','SCAL','    ','    ','    '/
35829      DATA INFLAV(383)/2/
35830      DATA INLONG(383)/'DIFFERENCE OF H15 SCALE'/
35831C
35832      DATA INCASE(384)/'17SD'/
35833      DATA (INAME(384,J),J=1,MAXSCL)/
35834     1'DIFF','    ','H17 ','SCAL','    ','    ','    ','    '/
35835      DATA INFLAV(384)/2/
35836      DATA INLONG(384)/'DIFFERENCE OF H17 SCALE'/
35837C
35838      DATA INCASE(385)/'17SD'/
35839      DATA (INAME(385,J),J=1,MAXSCL)/
35840     1'DIFF','    ','OF  ','H17 ','SCAL','    ','    ','    '/
35841      DATA INFLAV(385)/2/
35842      DATA INLONG(385)/'DIFFERENCE OF H17 SCALE'/
35843C
35844      DATA INCASE(386)/'20SD'/
35845      DATA (INAME(386,J),J=1,MAXSCL)/
35846     1'DIFF','    ','H20 ','SCAL','    ','    ','    ','    '/
35847      DATA INFLAV(386)/2/
35848      DATA INLONG(386)/'DIFFERENCE OF H20 SCALE'/
35849C
35850      DATA INCASE(387)/'20SD'/
35851      DATA (INAME(387,J),J=1,MAXSCL)/
35852     1'DIFF','    ','OF  ','H20 ','SCAL','    ','    ','    '/
35853      DATA INFLAV(387)/2/
35854      DATA INLONG(387)/'DIFFERENCE OF H20 SCALE'/
35855C
35856      DATA INCASE(388)/'TM2S'/
35857      DATA (INAME(388,J),J=1,MAXSCL)/
35858     1'TIET','    ','MOOR','TEST','STAT','    ','    ','    '/
35859      DATA INFLAV(388)/1/
35860      DATA INLONG(388)/'TIETJEN-MOORE TEST STATISTIC'/
35861C
35862      DATA INCASE(389)/'TM2S'/
35863      DATA (INAME(389,J),J=1,MAXSCL)/
35864     1'TIET','    ','MOOR','TEST','    ','    ','    ','    '/
35865      DATA INFLAV(389)/1/
35866      DATA INLONG(389)/'TIETJEN-MOORE TEST STATISTIC'/
35867C
35868      DATA INCASE(390)/'TM2S'/
35869      DATA (INAME(390,J),J=1,MAXSCL)/
35870     1'TIET','    ','MOOR','    ','    ','    ','    ','    '/
35871      DATA INFLAV(390)/1/
35872      DATA INLONG(390)/'TIETJEN-MOORE TEST STATISTIC'/
35873C
35874      DATA INCASE(391)/'TMMN'/
35875      DATA (INAME(391,J),J=1,MAXSCL)/
35876     1'TIET','    ','MOOR','MINI','TEST','STAT','    ','    '/
35877      DATA INFLAV(391)/1/
35878      DATA INLONG(391)/'TIETJEN-MOORE MINIMUM TEST STATISTIC'/
35879C
35880      DATA INCASE(392)/'TMMN'/
35881      DATA (INAME(392,J),J=1,MAXSCL)/
35882     1'TIET','    ','MOOR','MINI','TEST','    ','    ','    '/
35883      DATA INFLAV(392)/1/
35884      DATA INLONG(392)/'TIETJEN-MOORE MINIMUM TEST STATISTIC'/
35885C
35886      DATA INCASE(393)/'TMMN'/
35887      DATA (INAME(393,J),J=1,MAXSCL)/
35888     1'TIET','    ','MOOR','MINI','    ','    ','    ','    '/
35889      DATA INFLAV(393)/1/
35890      DATA INLONG(393)/'TIETJEN-MOORE MINIMUM TEST STATISTIC'/
35891C
35892      DATA INCASE(394)/'TMMX'/
35893      DATA (INAME(394,J),J=1,MAXSCL)/
35894     1'TIET','    ','MOOR','MAXI','TEST','STAT','    ','    '/
35895      DATA INFLAV(394)/1/
35896      DATA INLONG(394)/'TIETJEN-MOORE MAXIMUM TEST STATISTIC'/
35897C
35898      DATA INCASE(395)/'TMMX'/
35899      DATA (INAME(395,J),J=1,MAXSCL)/
35900     1'TIET','    ','MOOR','MAXI','TEST','    ','    ','    '/
35901      DATA INFLAV(395)/1/
35902      DATA INLONG(395)/'TIETJEN-MOORE MAXIMUM TEST STATISTIC'/
35903C
35904      DATA INCASE(396)/'TMMX'/
35905      DATA (INAME(396,J),J=1,MAXSCL)/
35906     1'TIET','    ','MOOR','MAXI','    ','    ','    ','    '/
35907      DATA INFLAV(396)/1/
35908      DATA INLONG(396)/'TIETJEN-MOORE MAXIMUM TEST STATISTIC'/
35909C
35910      DATA INCASE(397)/'ESD '/
35911      DATA (INAME(397,J),J=1,MAXSCL)/
35912     1'EXTR','    ','STUD','DEVI','TEST','    ','    ','    '/
35913      DATA INFLAV(397)/1/
35914      DATA INLONG(397)/'EXTREME STUDENTIZED DEVIATE TEST STATISTIC'/
35915C
35916      DATA INCASE(398)/'ESD '/
35917      DATA (INAME(398,J),J=1,MAXSCL)/
35918     1'EXTR','    ','STUD','DEVI','    ','    ','    ','    '/
35919      DATA INFLAV(398)/1/
35920      DATA INLONG(398)/'EXTREME STUDENTIZED DEVIATE TEST STATISTIC'/
35921C
35922      DATA INCASE(399)/'EXTR'/
35923      DATA (INAME(399,J),J=1,MAXSCL)/
35924     1'EXTR','    ','    ','    ','    ','    ','    ','    '/
35925      DATA INFLAV(399)/1/
35926      DATA INLONG(399)/'EXTREME'/
35927C
35928      DATA INCASE(400)/'DIMN'/
35929      DATA (INAME(400,J),J=1,MAXSCL)/
35930     1'DIXO','    ','MINI','TEST','    ','    ','    ','    '/
35931      DATA INFLAV(400)/1/
35932      DATA INLONG(400)/'DIXON MINIMUM TEST STATISTIC'/
35933C
35934      DATA INCASE(401)/'DIMN'/
35935      DATA (INAME(401,J),J=1,MAXSCL)/
35936     1'DIXO','    ','MINI','    ','    ','    ','    ','    '/
35937      DATA INFLAV(401)/1/
35938      DATA INLONG(401)/'DIXON MININUM TEST STATISTIC'/
35939C
35940      DATA INCASE(402)/'DIMX'/
35941      DATA (INAME(402,J),J=1,MAXSCL)/
35942     1'DIXO','    ','MAXI','TEST','    ','    ','    ','    '/
35943      DATA INFLAV(402)/1/
35944      DATA INLONG(402)/'DIXON MAXIMUM TEST STATISTIC'/
35945C
35946      DATA INCASE(403)/'DIMX'/
35947      DATA (INAME(403,J),J=1,MAXSCL)/
35948     1'DIXO','    ','MAXI','    ','    ','    ','    ','    '/
35949      DATA INFLAV(403)/1/
35950      DATA INLONG(403)/'DIXON MAXIMUM TEST STATISTIC'/
35951C
35952      DATA INCASE(404)/'DI2S'/
35953      DATA (INAME(404,J),J=1,MAXSCL)/
35954     1'DIXO','    ','TEST','    ','    ','    ','    ','    '/
35955      DATA INFLAV(404)/1/
35956      DATA INLONG(404)/'DIXON TEST STATISTIC'/
35957C
35958      DATA INCASE(405)/'DI2S'/
35959      DATA (INAME(405,J),J=1,MAXSCL)/
35960     1'DIXO','    ','    ','    ','    ','    ','    ','    '/
35961      DATA INFLAV(405)/1/
35962      DATA INLONG(405)/'DIXON TEST STATISTIC'/
35963C
35964      DATA INCASE(406)/'BRAT'/
35965      DATA (INAME(406,J),J=1,MAXSCL)/
35966     1'BINO','    ','RATI','    ','    ','    ','    ','    '/
35967      DATA INFLAV(406)/2/
35968      DATA INLONG(406)/'BINOMIAL RATIO'/
35969C
35970      DATA INCASE(407)/'RMS '/
35971      DATA (INAME(407,J),J=1,MAXSCL)/
35972     1'RMS ','    ','    ','    ','    ','    ','    ','    '/
35973      DATA INFLAV(407)/1/
35974      DATA INLONG(407)/'ROOT MEAN SQUARE ERROR'/
35975C
35976      DATA INCASE(408)/'RMS '/
35977      DATA (INAME(408,J),J=1,MAXSCL)/
35978     1'ROOT','    ','MEAN','SQUA','    ','ERRO','    ','    '/
35979      DATA INFLAV(408)/1/
35980      DATA INLONG(408)/'ROOT MEAN SQUARE ERROR'/
35981C
35982      DATA INCASE(409)/'RMS '/
35983      DATA (INAME(409,J),J=1,MAXSCL)/
35984     1'ROOT','    ','MEAN','SQUA','    ','    ','    ','    '/
35985      DATA INFLAV(409)/1/
35986      DATA INLONG(409)/'ROOT MEAN SQUARE ERROR'/
35987C
35988      DATA INCASE(410)/'DRMS'/
35989      DATA (INAME(410,J),J=1,MAXSCL)/
35990     1'DIFF','    ','OF  ','RMS ','    ','    ','    ','    '/
35991      DATA INFLAV(410)/2/
35992      DATA INLONG(410)/'DIFFERENCE OF ROOT MEAN SQUARE ERROR'/
35993C
35994      DATA INCASE(411)/'DRMS'/
35995      DATA (INAME(411,J),J=1,MAXSCL)/
35996     1'DIFF','    ','RMS ','    ','    ','    ','    ','    '/
35997      DATA INFLAV(411)/2/
35998      DATA INLONG(411)/'DIFFERENCE OF ROOT MEAN SQUARE ERROR'/
35999C
36000      DATA INCASE(412)/'DRMS'/
36001      DATA (INAME(412,J),J=1,MAXSCL)/
36002     1'DIFF','    ','OF  ','ROOT','MEAN','SQUA','ERRO','    '/
36003      DATA INFLAV(412)/2/
36004      DATA INLONG(412)/'DIFFERENCE OF ROOT MEAN SQUARE ERROR'/
36005C
36006      DATA INCASE(413)/'DRMS'/
36007      DATA (INAME(413,J),J=1,MAXSCL)/
36008     1'DIFF','    ','OF  ','ROOT','MEAN','SQUA','    ','    '/
36009      DATA INFLAV(413)/2/
36010      DATA INLONG(413)/'DIFFERENCE OF ROOT MEAN SQUARE ERROR'/
36011C
36012      DATA INCASE(414)/'DRMS'/
36013      DATA (INAME(414,J),J=1,MAXSCL)/
36014     1'DIFF','    ','ROOT','MEAN','SQUA','ERRO','    ','    '/
36015      DATA INFLAV(414)/2/
36016      DATA INLONG(414)/'DIFFERENCE OF ROOT MEAN SQUARE ERROR'/
36017C
36018      DATA INCASE(415)/'DRMS'/
36019      DATA (INAME(415,J),J=1,MAXSCL)/
36020     1'DIFF','    ','ROOT','MEAN','SQUA','    ','    ','    '/
36021      DATA INFLAV(415)/2/
36022      DATA INLONG(415)/'DIFFERENCE OF ROOT MEAN SQUARE ERROR'/
36023C
36024      DATA INCASE(416)/'RMS '/
36025      DATA (INAME(416,J),J=1,MAXSCL)/
36026     1'RMS0','    ','    ','    ','    ','    ','    ','    '/
36027      DATA INFLAV(416)/1/
36028      DATA INLONG(416)/'ROOT MEAN SQUARE ERROR'/
36029C
36030      DATA INCASE(417)/'DRMS'/
36031      DATA (INAME(417,J),J=1,MAXSCL)/
36032     1'DIFF','    ','OF  ','RMS0','    ','    ','    ','    '/
36033      DATA INFLAV(417)/2/
36034      DATA INLONG(417)/'DIFFERENCE OF ROOT MEAN SQUARE ERROR'/
36035C
36036      DATA INCASE(418)/'DRMS'/
36037      DATA (INAME(418,J),J=1,MAXSCL)/
36038     1'DIFF','    ','RMS0','    ','    ','    ','    ','    '/
36039      DATA INFLAV(418)/2/
36040      DATA INLONG(418)/'DIFFERENCE OF ROOT MEAN SQUARE ERROR'/
36041C
36042      DATA INCASE(419)/'1LAC'/
36043      DATA (INAME(419,J),J=1,MAXSCL)/
36044     1'ONE ','    ','SIDE','LOWE','AGRE','COUL','    ','    '/
36045      DATA INFLAV(419)/1/
36046      DATA INLONG(419)/'ONE-SIDED LOWER AGRESTI-COUL'/
36047C
36048      DATA INCASE(420)/'1UAC'/
36049      DATA (INAME(420,J),J=1,MAXSCL)/
36050     1'ONE ','    ','SIDE','UPPE','AGRE','COUL','    ','    '/
36051      DATA INFLAV(420)/1/
36052      DATA INLONG(420)/'ONE-SIDED UPPER AGRESTI-COUL'/
36053C
36054      DATA INCASE(421)/'2LAC'/
36055      DATA (INAME(421,J),J=1,MAXSCL)/
36056     1'TWO ','    ','SIDE','LOWE','AGRE','COUL','    ','    '/
36057      DATA INFLAV(421)/1/
36058      DATA INLONG(421)/'TWO-SIDED LOWER AGRESTI-COUL'/
36059C
36060      DATA INCASE(422)/'2UAC'/
36061      DATA (INAME(422,J),J=1,MAXSCL)/
36062     1'TWO ','    ','SIDE','UPPE','AGRE','COUL','    ','    '/
36063      DATA INFLAV(422)/1/
36064      DATA INLONG(422)/'TWO-SIDED UPPER AGRESTI-COUL'/
36065C
36066      DATA INCASE(423)/'1LEB'/
36067      DATA (INAME(423,J),J=1,MAXSCL)/
36068     1'ONE ','    ','SIDE','LOWE','EXAC','BINO','    ','    '/
36069      DATA INFLAV(423)/1/
36070      DATA INLONG(423)/'ONE-SIDED LOWER EXACT BINOMIAL'/
36071C
36072      DATA INCASE(424)/'1UEB'/
36073      DATA (INAME(424,J),J=1,MAXSCL)/
36074     1'ONE ','    ','SIDE','UPPE','EXAC','BINO','    ','    '/
36075      DATA INFLAV(424)/1/
36076      DATA INLONG(424)/'ONE-SIDED UPPER EXACT BINOMIAL'/
36077C
36078      DATA INCASE(425)/'2LEB'/
36079      DATA (INAME(425,J),J=1,MAXSCL)/
36080     1'TWO ','    ','SIDE','LOWE','EXAC','BINO','    ','    '/
36081      DATA INFLAV(425)/1/
36082      DATA INLONG(425)/'TWO-SIDED LOWER EXACT BINOMIAL'/
36083C
36084      DATA INCASE(426)/'2UEB'/
36085      DATA (INAME(426,J),J=1,MAXSCL)/
36086     1'TWO ','    ','SIDE','UPPE','EXAC','BINO','    ','    '/
36087      DATA INFLAV(426)/1/
36088      DATA INLONG(426)/'TWO-SIDED UPPER EXACT BINOMIAL'/
36089C
36090      DATA INCASE(427)/'REPE'/
36091      DATA (INAME(427,J),J=1,MAXSCL)/
36092     1'REPE','    ','STAN','DEVI','    ','    ','    ','    '/
36093      DATA INFLAV(427)/2/
36094      DATA INLONG(427)/'REPEATABILITY STANDARD DEVIATION'/
36095C
36096      DATA INCASE(428)/'REPE'/
36097      DATA (INAME(428,J),J=1,MAXSCL)/
36098     1'REPE','    ','SD  ','    ','    ','    ','    ','    '/
36099      DATA INFLAV(428)/2/
36100      DATA INLONG(428)/'REPEATABILITY STANDARD DEVIATION'/
36101C
36102      DATA INCASE(429)/'REPR'/
36103      DATA (INAME(429,J),J=1,MAXSCL)/
36104     1'REPR','    ','STAN','DEVI','    ','    ','    ','    '/
36105      DATA INFLAV(429)/2/
36106      DATA INLONG(429)/'REPRODUCIBILITY STANDARD DEVIATION'/
36107C
36108      DATA INCASE(430)/'REPR'/
36109      DATA (INAME(430,J),J=1,MAXSCL)/
36110     1'REPR','    ','SD  ','    ','    ','    ','    ','    '/
36111      DATA INFLAV(430)/2/
36112      DATA INLONG(430)/'REPRODUCIBILITY STANDARD DEVIATION'/
36113C
36114      DATA INCASE(431)/'LIIS'/
36115      DATA (INAME(431,J),J=1,MAXSCL)/
36116     1'LINE','    ','INTE','SD  ','    ','    ','    ','    '/
36117      DATA INFLAV(431)/2/
36118      DATA INLONG(431)/'LINEAR INTERCEPT STANDARD DEVIATION'/
36119C
36120      DATA INCASE(432)/'LISS'/
36121      DATA (INAME(432,J),J=1,MAXSCL)/
36122     1'LINE','    ','SLOP','SD  ','    ','    ','    ','    '/
36123      DATA INFLAV(432)/2/
36124      DATA INLONG(432)/'LINEAR SLOPE STANDARD DEVIATION'/
36125C
36126      DATA INCASE(433)/'LIIN'/
36127      DATA (INAME(433,J),J=1,MAXSCL)/
36128     1'LINE','    ','INTE','    ','    ','    ','    ','    '/
36129      DATA INFLAV(433)/2/
36130      DATA INLONG(433)/'LINEAR INTERCEPT'/
36131C
36132      DATA INCASE(434)/'LISL'/
36133      DATA (INAME(434,J),J=1,MAXSCL)/
36134     1'LINE','    ','SLOP','    ','    ','    ','    ','    '/
36135      DATA INFLAV(434)/2/
36136      DATA INLONG(434)/'LINEAR SLOPE'/
36137C
36138      DATA INCASE(435)/'LIDX'/
36139      DATA (INAME(435,J),J=1,MAXSCL)/
36140     1'LINE','    ','DIST','X   ','    ','    ','    ','    '/
36141      DATA INFLAV(435)/2/
36142      DATA INLONG(435)/'LINEAR DISTINCT X'/
36143C
36144      DATA INCASE(436)/'DHHD'/
36145      DATA (INAME(436,J),J=1,MAXSCL)/
36146     1'SUMM','    ','DERS','LAIR','HHD ','    ','    ','    '/
36147      DATA INFLAV(436)/3/
36148      DATA INLONG(436)/'DERSIMONIAN-LAIRD HHD'/
36149C
36150      DATA INCASE(437)/'DSSE'/
36151      DATA (INAME(437,J),J=1,MAXSCL)/
36152     1'SUMM','    ','DERS','LAIR','STAN','ERRO','    ','    '/
36153      DATA INFLAV(437)/3/
36154      DATA INLONG(437)/'DERSIMONIAN-LAIRD STANDARD ERROR'/
36155C
36156      DATA INCASE(438)/'DSSE'/
36157      DATA (INAME(438,J),J=1,MAXSCL)/
36158     1'SUMM','    ','DERS','LAIR','SE  ','    ','    ','    '/
36159      DATA INFLAV(438)/3/
36160      DATA INLONG(438)/'DERSIMONIAN-LAIRD STANDARD ERROR'/
36161C
36162      DATA INCASE(439)/'DSMM'/
36163      DATA (INAME(439,J),J=1,MAXSCL)/
36164     1'SUMM','    ','DERS','LAIR','MINM','    ','    ','    '/
36165      DATA INFLAV(439)/3/
36166      DATA INLONG(439)/'DERSIMONIAN-LAIRD MINMAX'/
36167C
36168      DATA INCASE(440)/'DSLA'/
36169      DATA (INAME(440,J),J=1,MAXSCL)/
36170     1'SUMM','    ','DERS','LAIR','    ','    ','    ','    '/
36171      DATA INFLAV(440)/3/
36172      DATA INLONG(440)/'DERSIMONIAN-LAIRD'/
36173C
36174      DATA INCASE(441)/'MPSE'/
36175      DATA (INAME(441,J),J=1,MAXSCL)/
36176     1'SUMM','    ','MAND','PAUL','STAN','ERRO','    ','    '/
36177      DATA INFLAV(441)/3/
36178      DATA INLONG(441)/'MANDEL-PAULE STANDARD ERROR'/
36179C
36180      DATA INCASE(442)/'MPSE'/
36181      DATA (INAME(442,J),J=1,MAXSCL)/
36182     1'SUMM','    ','MAND','PAUL','SE  ','    ','    ','    '/
36183      DATA INFLAV(442)/3/
36184      DATA INLONG(442)/'MANDEL-PAULE STANDARD ERROR'/
36185C
36186      DATA INCASE(443)/'MPAU'/
36187      DATA (INAME(443,J),J=1,MAXSCL)/
36188     1'SUMM','    ','MAND','PAUL','    ','    ','    ','    '/
36189      DATA INFLAV(443)/3/
36190      DATA INLONG(443)/'MANDEL-PAULE'/
36191C
36192      DATA INCASE(444)/'MMPS'/
36193      DATA (INAME(444,J),J=1,MAXSCL)/
36194     1'SUMM','    ','MODI','MAND','PAUL','STAN','ERRO','    '/
36195      DATA INFLAV(444)/3/
36196      DATA INLONG(444)/'MODIFIED MANDEL-PAULE SE'/
36197C
36198      DATA INCASE(445)/'MMPS'/
36199      DATA (INAME(445,J),J=1,MAXSCL)/
36200     1'SUMM','    ','MODI','MAND','PAUL','SE  ','    ','    '/
36201      DATA INFLAV(445)/3/
36202      DATA INLONG(445)/'MODIFIED MANDEL-PAULE SE'/
36203C
36204      DATA INCASE(446)/'MMPA'/
36205      DATA (INAME(446,J),J=1,MAXSCL)/
36206     1'SUMM','    ','MODI','MAND','PAUL','    ','    ','    '/
36207      DATA INFLAV(446)/3/
36208      DATA INLONG(446)/'MODIFIED MANDEL-PAULE'/
36209C
36210      DATA INCASE(447)/'VRSE'/
36211      DATA (INAME(447,J),J=1,MAXSCL)/
36212     1'SUMM','    ','VANG','RUKH','STAN','ERRO','    ','    '/
36213      DATA INFLAV(447)/3/
36214      DATA INLONG(447)/'VANGEL-RUKHIN SE'/
36215C
36216      DATA INCASE(448)/'VRSE'/
36217      DATA (INAME(448,J),J=1,MAXSCL)/
36218     1'SUMM','    ','VANG','RUKH','SE  ','    ','    ','    '/
36219      DATA INFLAV(448)/3/
36220      DATA INLONG(448)/'VANGEL-RUKHIN SE'/
36221C
36222      DATA INCASE(449)/'VARU'/
36223      DATA (INAME(449,J),J=1,MAXSCL)/
36224     1'SUMM','    ','VANG','RUKH','    ','    ','    ','    '/
36225      DATA INFLAV(449)/3/
36226      DATA INLONG(449)/'VANGEL-RUKHIN'/
36227C
36228      DATA INCASE(450)/'DHHD'/
36229      DATA (INAME(450,J),J=1,MAXSCL)/
36230     1'DERS','    ','LAIR','HHD ','    ','    ','    ','    '/
36231      DATA INFLAV(450)/2/
36232      DATA INLONG(450)/'DERSIMONIAN-LAIRD HHD'/
36233C
36234      DATA INCASE(451)/'DSSE'/
36235      DATA (INAME(451,J),J=1,MAXSCL)/
36236     1'DERS','    ','LAIR','STAN','ERRO','    ','    ','    '/
36237      DATA INFLAV(451)/2/
36238      DATA INLONG(451)/'DERSIMONIAN-LAIRD STANDARD ERROR'/
36239C
36240      DATA INCASE(452)/'DSSE'/
36241      DATA (INAME(452,J),J=1,MAXSCL)/
36242     1'DERS','    ','LAIR','SE  ','    ','    ','    ','    '/
36243      DATA INFLAV(452)/2/
36244      DATA INLONG(452)/'DERSIMONIAN-LAIRD STANDARD ERROR'/
36245C
36246      DATA INCASE(453)/'DSMM'/
36247      DATA (INAME(453,J),J=1,MAXSCL)/
36248     1'DERS','    ','LAIR','MINM','    ','    ','    ','    '/
36249      DATA INFLAV(453)/2/
36250      DATA INLONG(453)/'DERSIMONIAN-LAIRD MINMAX'/
36251C
36252      DATA INCASE(454)/'DSLA'/
36253      DATA (INAME(454,J),J=1,MAXSCL)/
36254     1'DERS','    ','LAIR','    ','    ','    ','    ','    '/
36255      DATA INFLAV(454)/2/
36256      DATA INLONG(454)/'DERSIMONIAN-LAIRD'/
36257C
36258      DATA INCASE(455)/'MPSE'/
36259      DATA (INAME(455,J),J=1,MAXSCL)/
36260     1'MAND','    ','PAUL','STAN','ERRO','    ','    ','    '/
36261      DATA INFLAV(455)/2/
36262      DATA INLONG(455)/'MANDEL-PAULE STANDARD ERROR'/
36263C
36264      DATA INCASE(456)/'MPSE'/
36265      DATA (INAME(456,J),J=1,MAXSCL)/
36266     1'MAND','    ','PAUL','SE  ','    ','    ','    ','    '/
36267      DATA INFLAV(456)/2/
36268      DATA INLONG(456)/'MANDEL-PAULE STANDARD ERROR'/
36269C
36270      DATA INCASE(457)/'MPAU'/
36271      DATA (INAME(457,J),J=1,MAXSCL)/
36272     1'MAND','    ','PAUL','    ','    ','    ','    ','    '/
36273      DATA INFLAV(457)/2/
36274      DATA INLONG(457)/'MANDEL-PAULE'/
36275C
36276      DATA INCASE(458)/'MMPS'/
36277      DATA (INAME(458,J),J=1,MAXSCL)/
36278     1'MODI','    ','MAND','PAUL','STAN','ERRO','    ','    '/
36279      DATA INFLAV(458)/2/
36280      DATA INLONG(458)/'MODIFIED MANDEL-PAULE SE'/
36281C
36282      DATA INCASE(459)/'MMPS'/
36283      DATA (INAME(459,J),J=1,MAXSCL)/
36284     1'MODI','    ','MAND','PAUL','SE  ','    ','    ','    '/
36285      DATA INFLAV(459)/2/
36286      DATA INLONG(459)/'MODIFIED MANDEL-PAULE SE'/
36287C
36288      DATA INCASE(460)/'MMPA'/
36289      DATA (INAME(460,J),J=1,MAXSCL)/
36290     1'MODI','    ','MAND','PAUL','    ','    ','    ','    '/
36291      DATA INFLAV(460)/2/
36292      DATA INLONG(460)/'MODIFIED MANDEL-PAULE'/
36293C
36294      DATA INCASE(461)/'VRSE'/
36295      DATA (INAME(461,J),J=1,MAXSCL)/
36296     1'VANG','    ','RUKH','STAN','ERRO','    ','    ','    '/
36297      DATA INFLAV(461)/2/
36298      DATA INLONG(461)/'VANGEL-RUKHIN SE'/
36299C
36300      DATA INCASE(462)/'VRSE'/
36301      DATA (INAME(462,J),J=1,MAXSCL)/
36302     1'VANG','    ','RUKH','SE  ','    ','    ','    ','    '/
36303      DATA INFLAV(462)/2/
36304      DATA INLONG(462)/'VANGEL-RUKHIN SE'/
36305C
36306      DATA INCASE(463)/'VARU'/
36307      DATA (INAME(463,J),J=1,MAXSCL)/
36308     1'VANG','    ','RUKH','    ','    ','    ','    ','    '/
36309      DATA INFLAV(463)/2/
36310      DATA INLONG(463)/'VANGEL-RUKHIN'/
36311C
36312      DATA INCASE(464)/'GCIS'/
36313      DATA (INAME(464,J),J=1,MAXSCL)/
36314     1'SUMM','    ','GENE','CONF','INTE','STAN','ERRO','    '/
36315      DATA INFLAV(464)/3/
36316      DATA INLONG(464)/'GENERALIZED CONFIDENCE INTERVAL SE'/
36317C
36318      DATA INCASE(465)/'GCIS'/
36319      DATA (INAME(465,J),J=1,MAXSCL)/
36320     1'SUMM','    ','GENE','CONF','INTE','SE  ','    ','    '/
36321      DATA INFLAV(465)/3/
36322      DATA INLONG(465)/'GENERALIZED CONFIDENCE INTERVAL SE'/
36323C
36324      DATA INCASE(466)/'GCIS'/
36325      DATA (INAME(466,J),J=1,MAXSCL)/
36326     1'SUMM','    ','GCI ','STAN','ERRO','    ','    ','    '/
36327      DATA INFLAV(466)/3/
36328      DATA INLONG(466)/'GENERALIZED CONFIDENCE INTERVAL SE'/
36329C
36330      DATA INCASE(467)/'GCIS'/
36331      DATA (INAME(467,J),J=1,MAXSCL)/
36332     1'SUMM','    ','GCI ','SE  ','    ','    ','    ','    '/
36333      DATA INFLAV(467)/3/
36334      DATA INLONG(467)/'GENERALIZED CONFIDENCE INTERVAL SE'/
36335C
36336      DATA INCASE(468)/'GCIN'/
36337      DATA (INAME(468,J),J=1,MAXSCL)/
36338     1'SUMM','    ','GENE','CONF','INTE','    ','    ','    '/
36339      DATA INFLAV(468)/3/
36340      DATA INLONG(468)/'GENERALIZED CONFIDENCE INTERVAL'/
36341C
36342      DATA INCASE(469)/'GCIS'/
36343      DATA (INAME(469,J),J=1,MAXSCL)/
36344     1'GENE','    ','CONF','INTE','STAN','ERRO','    ','    '/
36345      DATA INFLAV(469)/2/
36346      DATA INLONG(469)/'GENERALIZED CONFIDENCE INTERVAL SE'/
36347C
36348      DATA INCASE(470)/'GCIS'/
36349      DATA (INAME(470,J),J=1,MAXSCL)/
36350     1'GENE','    ','CONF','INTE','SE  ','    ','    ','    '/
36351      DATA INFLAV(470)/2/
36352      DATA INLONG(470)/'GENERALIZED CONFIDENCE INTERVAL SE'/
36353C
36354      DATA INCASE(471)/'GCIS'/
36355      DATA (INAME(471,J),J=1,MAXSCL)/
36356     1'GCI ','    ','STAN','ERRO','    ','    ','    ','    '/
36357      DATA INFLAV(471)/2/
36358      DATA INLONG(471)/'GENERALIZED CONFIDENCE INTERVAL SE'/
36359C
36360      DATA INCASE(472)/'GCIS'/
36361      DATA (INAME(472,J),J=1,MAXSCL)/
36362     1'GGI ','    ','SE  ','    ','    ','    ','    ','    '/
36363      DATA INFLAV(472)/2/
36364      DATA INLONG(472)/'GENERALIZED CONFIDENCE INTERVAL SE'/
36365C
36366      DATA INCASE(473)/'GCIN'/
36367      DATA (INAME(473,J),J=1,MAXSCL)/
36368     1'GENE','    ','CONF','INTE','    ','    ','    ','    '/
36369      DATA INFLAV(473)/2/
36370      DATA INLONG(473)/'GENERALIZED CONFIDENCE INTERVAL'/
36371C
36372      DATA INCASE(474)/'GCIN'/
36373      DATA (INAME(474,J),J=1,MAXSCL)/
36374     1'GCI ','    ','    ','    ','    ','    ','    ','    '/
36375      DATA INFLAV(474)/2/
36376      DATA INLONG(474)/'GENERALIZED CONFIDENCE INTERVAL'/
36377C
36378      DATA INCASE(475)/'BOBS'/
36379      DATA (INAME(475,J),J=1,MAXSCL)/
36380     1'SUMM','    ','BOB ','STAN','ERRO','    ','    ','    '/
36381      DATA INFLAV(475)/3/
36382      DATA INLONG(475)/'BOB STANDARD ERROR'/
36383C
36384      DATA INCASE(476)/'BOBS'/
36385      DATA (INAME(476,J),J=1,MAXSCL)/
36386     1'SUMM','    ','BOB ','SE  ','    ','    ','    ','    '/
36387      DATA INFLAV(476)/3/
36388      DATA INLONG(476)/'BOB STANDARD ERROR'/
36389C
36390      DATA INCASE(477)/'BOBS'/
36391      DATA (INAME(477,J),J=1,MAXSCL)/
36392     1'SUMM','    ','BOB ','    ','    ','    ','    ','    '/
36393      DATA INFLAV(477)/3/
36394      DATA INLONG(477)/'BOB'/
36395C
36396      DATA INCASE(478)/'BOBS'/
36397      DATA (INAME(478,J),J=1,MAXSCL)/
36398     1'BOB ','    ','STAN','ERRO','    ','    ','    ','    '/
36399      DATA INFLAV(478)/2/
36400      DATA INLONG(478)/'BOB STANDARD ERROR'/
36401C
36402      DATA INCASE(479)/'BOBS'/
36403      DATA (INAME(479,J),J=1,MAXSCL)/
36404     1'BOB ','    ','SE  ','    ','    ','    ','    ','    '/
36405      DATA INFLAV(479)/2/
36406      DATA INLONG(479)/'BOB STANDARD ERROR'/
36407C
36408      DATA INCASE(480)/'BOB '/
36409      DATA (INAME(480,J),J=1,MAXSCL)/
36410     1'BOB ','    ','    ','    ','    ','    ','    ','    '/
36411      DATA INFLAV(480)/2/
36412      DATA INLONG(480)/'BOB'/
36413C
36414      DATA INCASE(481)/'BCPS'/
36415      DATA (INAME(481,J),J=1,MAXSCL)/
36416     1'BCP ','    ','STAN','ERRO','    ','    ','    ','    '/
36417      DATA INFLAV(481)/2/
36418      DATA INLONG(481)/'BCP STANDARD ERROR'/
36419C
36420      DATA INCASE(482)/'BCPS'/
36421      DATA (INAME(482,J),J=1,MAXSCL)/
36422     1'BCP ','    ','SE  ','    ','    ','    ','    ','    '/
36423      DATA INFLAV(482)/2/
36424      DATA INLONG(482)/'BCP STANDARD ERROR'/
36425C
36426      DATA INCASE(483)/'BCP '/
36427      DATA (INAME(483,J),J=1,MAXSCL)/
36428     1'BCP ','    ','    ','    ','    ','    ','    ','    '/
36429      DATA INFLAV(483)/2/
36430      DATA INLONG(483)/'BCP'/
36431C
36432      DATA INCASE(484)/'BCPS'/
36433      DATA (INAME(484,J),J=1,MAXSCL)/
36434     1'BAYE','    ','CONS','PROC','STAN','ERRO','    ','    '/
36435      DATA INFLAV(484)/2/
36436      DATA INLONG(484)/'BCP STANDARD ERROR'/
36437C
36438      DATA INCASE(485)/'BCPS'/
36439      DATA (INAME(485,J),J=1,MAXSCL)/
36440     1'BAYE','    ','CONS','PROC','SE  ','    ','    ','    '/
36441      DATA INFLAV(485)/2/
36442      DATA INLONG(485)/'BCP STANDARD ERROR'/
36443C
36444      DATA INCASE(486)/'BCP '/
36445      DATA (INAME(486,J),J=1,MAXSCL)/
36446     1'BAYE','    ','CONS','PROC','    ','    ','    ','    '/
36447      DATA INFLAV(486)/2/
36448      DATA INLONG(486)/'BCP'/
36449C
36450      DATA INCASE(487)/'BCPS'/
36451      DATA (INAME(487,J),J=1,MAXSCL)/
36452     1'SUMM','    ','BCP ','STAN','ERRO','    ','    ','    '/
36453      DATA INFLAV(487)/3/
36454      DATA INLONG(487)/'BCP STANDARD ERROR'/
36455C
36456      DATA INCASE(488)/'BCPS'/
36457      DATA (INAME(488,J),J=1,MAXSCL)/
36458     1'SUMM','    ','BCP ','SE  ','    ','    ','    ','    '/
36459      DATA INFLAV(488)/3/
36460      DATA INLONG(488)/'BCP STANDARD ERROR'/
36461C
36462      DATA INCASE(489)/'BCP '/
36463      DATA (INAME(489,J),J=1,MAXSCL)/
36464     1'SUMM','    ','BCP ','    ','    ','    ','    ','    '/
36465      DATA INFLAV(489)/3/
36466      DATA INLONG(489)/'BCP'/
36467C
36468      DATA INCASE(489)/'BCPS'/
36469      DATA (INAME(489,J),J=1,MAXSCL)/
36470     1'SUMM','    ','BAYE','CONS','PROC','STAN','ERRO','    '/
36471      DATA INFLAV(489)/3/
36472      DATA INLONG(489)/'BCP STANDARD ERROR'/
36473C
36474      DATA INCASE(490)/'BCPS'/
36475      DATA (INAME(490,J),J=1,MAXSCL)/
36476     1'SUMM','    ','BAYE','CONS','PROC','SE  ','    ','    '/
36477      DATA INFLAV(490)/3/
36478      DATA INLONG(490)/'BCP STANDARD ERROR'/
36479C
36480      DATA INCASE(491)/'BCP '/
36481      DATA (INAME(491,J),J=1,MAXSCL)/
36482     1'SUMM','    ','BAYE','CONS','PROC','    ','    ','    '/
36483      DATA INFLAV(491)/3/
36484      DATA INLONG(491)/'BCP'/
36485C
36486      DATA INCASE(492)/'MMES'/
36487      DATA (INAME(492,J),J=1,MAXSCL)/
36488     1'SUMM','    ','MEAN','OF  ','MEAN','STAN','ERRO','    '/
36489      DATA INFLAV(492)/3/
36490      DATA INLONG(492)/'MEAN OF MEANS STANDARD ERROR'/
36491C
36492      DATA INCASE(493)/'MMES'/
36493      DATA (INAME(493,J),J=1,MAXSCL)/
36494     1'SUMM','    ','MEAN','OF  ','MEAN','SE  ','    ','    '/
36495      DATA INFLAV(493)/3/
36496      DATA INLONG(493)/'MEAN OF MEANS STANDARD ERROR'/
36497C
36498      DATA INCASE(494)/'MMEA'/
36499      DATA (INAME(494,J),J=1,MAXSCL)/
36500     1'SUMM','    ','MEAN','OF  ','MEAN','    ','    ','    '/
36501      DATA INFLAV(494)/3/
36502      DATA INLONG(494)/'MEAN OF MEANS'/
36503C
36504      DATA INCASE(495)/'MMES'/
36505      DATA (INAME(495,J),J=1,MAXSCL)/
36506     1'MEAN','    ','OF  ','MEAN','STAN','ERRO','    ','    '/
36507      DATA INFLAV(495)/2/
36508      DATA INLONG(495)/'MEAN OF MEANS STANDARD ERROR'/
36509C
36510      DATA INCASE(496)/'MMEA'/
36511      DATA (INAME(496,J),J=1,MAXSCL)/
36512     1'MEAN','    ','OF  ','MEAN','    ','    ','    ','    '/
36513      DATA INFLAV(496)/2/
36514      DATA INLONG(496)/'MEAN OF MEANS'/
36515C
36516      DATA INCASE(497)/'MSDN'/
36517      DATA (INAME(497,J),J=1,MAXSCL)/
36518     1'MEAN','    ','SUCC','DIFF','TEST','NORM','    ','    '/
36519      DATA INFLAV(497)/1/
36520      DATA INLONG(497)/'MEAN SUCCESSIVE DIFFERENCES NORMALIZED'/
36521C
36522      DATA INCASE(498)/'SESE'/
36523      DATA (INAME(498,J),J=1,MAXSCL)/
36524     1'SUMM','    ','SCHI','EBER','STAN','ERRO','    ','    '/
36525      DATA INFLAV(498)/3/
36526      DATA INLONG(498)/'SCHILLER-EBERHHARDT STANDARD ERROR'/
36527C
36528      DATA INCASE(499)/'SESE'/
36529      DATA (INAME(499,J),J=1,MAXSCL)/
36530     1'SUMM','    ','SCHI','EBER','SE  ','    ','    ','    '/
36531      DATA INFLAV(499)/3/
36532      DATA INLONG(499)/'SCHILLER-EBERHARDT STANDARD ERROR'/
36533C
36534      DATA INCASE(500)/'SCEB'/
36535      DATA (INAME(500,J),J=1,MAXSCL)/
36536     1'SUMM','    ','SCHI','EBER','    ','    ','    ','    '/
36537      DATA INFLAV(500)/3/
36538      DATA INLONG(500)/'SCHILLER-EBERHARDT'/
36539C
36540      DATA INCASE(501)/'SESE'/
36541      DATA (INAME(501,J),J=1,MAXSCL)/
36542     1'SCHI','    ','EBER','STAN','ERRO','    ','    ','    '/
36543      DATA INFLAV(501)/2/
36544      DATA INLONG(501)/'SCHILLER-EBERHHARDT STANDARD ERROR'/
36545C
36546      DATA INCASE(502)/'SESE'/
36547      DATA (INAME(502,J),J=1,MAXSCL)/
36548     1'SCHI','    ','EBER','SE  ','    ','    ','    ','    '/
36549      DATA INFLAV(502)/2/
36550      DATA INLONG(502)/'SCHILLER-EBERHARDT STANDARD ERROR'/
36551C
36552      DATA INCASE(503)/'GDSE'/
36553      DATA (INAME(503,J),J=1,MAXSCL)/
36554     1'SUMM','    ','GRAY','DEAL','SINH','STAN','ERRO','    '/
36555      DATA INFLAV(503)/3/
36556      DATA INLONG(503)/'GRAYBILL-DEAL SINHA STANDARD ERROR'/
36557C
36558      DATA INCASE(504)/'GDSE'/
36559      DATA (INAME(504,J),J=1,MAXSCL)/
36560     1'SUMM','    ','GRAY','DEAL','SINH','SE  ','    ','    '/
36561      DATA INFLAV(504)/3/
36562      DATA INLONG(504)/'GRAYBILL-DEAL SINHA STANDARD ERROR'/
36563C
36564      DATA INCASE(505)/'GDSN'/
36565      DATA (INAME(505,J),J=1,MAXSCL)/
36566     1'SUMM','    ','GRAY','DEAL','NAIV','STAN','ERRO','    '/
36567      DATA INFLAV(505)/3/
36568      DATA INLONG(505)/'GRAYBILL-DEAL NAIVE STANDARD ERROR'/
36569C
36570      DATA INCASE(506)/'GDSN'/
36571      DATA (INAME(506,J),J=1,MAXSCL)/
36572     1'SUMM','    ','GRAY','DEAL','NAIV','SE  ','    ','    '/
36573      DATA INFLAV(506)/3/
36574      DATA INLONG(506)/'GRAYBILL-DEAL NAIVE STANDARD ERROR'/
36575C
36576      DATA INCASE(507)/'GDZ1'/
36577      DATA (INAME(507,J),J=1,MAXSCL)/
36578     1'SUMM','    ','GRAY','DEAL','ZHAN','ONE ','STAN','ERRO'/
36579      DATA INFLAV(507)/3/
36580      DATA INLONG(507)/'GRAYBILL-DEAL ZHANG ONE STANDARD ERROR'/
36581C
36582      DATA INCASE(508)/'GDZ1'/
36583      DATA (INAME(508,J),J=1,MAXSCL)/
36584     1'SUMM','    ','GRAY','DEAL','ZHAN','1   ','STAN','ERRO'/
36585      DATA INFLAV(508)/3/
36586      DATA INLONG(508)/'GRAYBILL-DEAL ZHANG ONE STANDARD ERROR'/
36587C
36588      DATA INCASE(509)/'GDZ1'/
36589      DATA (INAME(509,J),J=1,MAXSCL)/
36590     1'SUMM','    ','GRAY','DEAL','ZHAN','ONE ','SE  ','    '/
36591      DATA INFLAV(509)/3/
36592      DATA INLONG(509)/'GRAYBILL-DEAL ZHANG ONE STANDARD ERROR'/
36593C
36594      DATA INCASE(510)/'GDZ1'/
36595      DATA (INAME(510,J),J=1,MAXSCL)/
36596     1'SUMM','    ','GRAY','DEAL','ZHAN','1   ','SE  ','    '/
36597      DATA INFLAV(510)/3/
36598      DATA INLONG(510)/'GRAYBILL-DEAL ZHANG ONE STANDARD ERROR'/
36599C
36600      DATA INCASE(511)/'GDZ2'/
36601      DATA (INAME(511,J),J=1,MAXSCL)/
36602     1'SUMM','    ','GRAY','DEAL','ZHAN','TWO ','STAN','ERRO'/
36603      DATA INFLAV(511)/3/
36604      DATA INLONG(511)/'GRAYBILL-DEAL ZHANG TWO STANDARD ERROR'/
36605C
36606      DATA INCASE(512)/'GDZ2'/
36607      DATA (INAME(512,J),J=1,MAXSCL)/
36608     1'SUMM','    ','GRAY','DEAL','ZHAN','2   ','STAN','ERRO'/
36609      DATA INFLAV(512)/3/
36610      DATA INLONG(512)/'GRAYBILL-DEAL ZHANG TWO STANDARD ERROR'/
36611C
36612      DATA INCASE(513)/'GDZ1'/
36613      DATA (INAME(513,J),J=1,MAXSCL)/
36614     1'SUMM','    ','GRAY','DEAL','ZHAN','TWO ','SE  ','    '/
36615      DATA INFLAV(513)/3/
36616      DATA INLONG(513)/'GRAYBILL-DEAL ZHANG TWO STANDARD ERROR'/
36617C
36618      DATA INCASE(514)/'GDZ2'/
36619      DATA (INAME(514,J),J=1,MAXSCL)/
36620     1'SUMM','    ','GRAY','DEAL','ZHAN','2   ','SE  ','    '/
36621      DATA INFLAV(514)/3/
36622      DATA INLONG(514)/'GRAYBILL-DEAL ZHANG TWO STANDARD ERROR'/
36623C
36624      DATA INCASE(515)/'GDSE'/
36625      DATA (INAME(515,J),J=1,MAXSCL)/
36626     1'SUMM','    ','GRAY','DEAL','STAN','ERRO','    ','    '/
36627      DATA INFLAV(515)/3/
36628      DATA INLONG(515)/'GRAYBILL-DEAL STANDARD ERROR'/
36629C
36630      DATA INCASE(516)/'GDSE'/
36631      DATA (INAME(516,J),J=1,MAXSCL)/
36632     1'SUMM','    ','GRAY','DEAL','SE  ','    ','    ','    '/
36633      DATA INFLAV(516)/3/
36634      DATA INLONG(516)/'GRAYBILL-DEAL STANDARD ERROR'/
36635C
36636      DATA INCASE(517)/'GDEA'/
36637      DATA (INAME(517,J),J=1,MAXSCL)/
36638     1'SUMM','    ','GRAY','DEAL','    ','    ','    ','    '/
36639      DATA INFLAV(517)/3/
36640      DATA INLONG(517)/'GRAYBILL-DEAL'/
36641C
36642      DATA INCASE(518)/'GDSE'/
36643      DATA (INAME(518,J),J=1,MAXSCL)/
36644     1'GRAY','    ','DEAL','SINH','STAN','ERRO','    ','    '/
36645      DATA INFLAV(518)/2/
36646      DATA INLONG(518)/'GRAYBILL-DEAL SINHA STANDARD ERROR'/
36647C
36648      DATA INCASE(519)/'GDSE'/
36649      DATA (INAME(519,J),J=1,MAXSCL)/
36650     1'GRAY','    ','DEAL','SINH','SE  ','    ','    ','    '/
36651      DATA INFLAV(519)/2/
36652      DATA INLONG(519)/'GRAYBILL-DEAL SINHA STANDARD ERROR'/
36653C
36654      DATA INCASE(520)/'GDSN'/
36655      DATA (INAME(520,J),J=1,MAXSCL)/
36656     1'GRAY','    ','DEAL','NAIV','STAN','ERRO','    ','    '/
36657      DATA INFLAV(520)/2/
36658      DATA INLONG(520)/'GRAYBILL-DEAL NAIVE STANDARD ERROR'/
36659C
36660      DATA INCASE(521)/'GDSN'/
36661      DATA (INAME(521,J),J=1,MAXSCL)/
36662     1'GRAY','    ','DEAL','NAIV','SE  ','    ','    ','    '/
36663      DATA INFLAV(521)/2/
36664      DATA INLONG(521)/'GRAYBILL-DEAL NAIVE STANDARD ERROR'/
36665C
36666      DATA INCASE(522)/'GDZ1'/
36667      DATA (INAME(522,J),J=1,MAXSCL)/
36668     1'GRAY','    ','DEAL','ZHAN','ONE ','STAN','ERRO','    '/
36669      DATA INFLAV(522)/2/
36670      DATA INLONG(522)/'GRAYBILL-DEAL ZHANG ONE STANDARD ERROR'/
36671C
36672      DATA INCASE(523)/'GDZ1'/
36673      DATA (INAME(523,J),J=1,MAXSCL)/
36674     1'GRAY','    ','DEAL','ZHAN','1   ','STAN','ERRO','    '/
36675      DATA INFLAV(523)/2/
36676      DATA INLONG(523)/'GRAYBILL-DEAL ZHANG ONE STANDARD ERROR'/
36677C
36678      DATA INCASE(524)/'GDZ1'/
36679      DATA (INAME(524,J),J=1,MAXSCL)/
36680     1'GRAY','    ','DEAL','ZHAN','ONE ','SE  ','    ','    '/
36681      DATA INFLAV(524)/2/
36682      DATA INLONG(524)/'GRAYBILL-DEAL ZHANG ONE STANDARD ERROR'/
36683C
36684      DATA INCASE(525)/'GDZ1'/
36685      DATA (INAME(525,J),J=1,MAXSCL)/
36686     1'GRAY','    ','DEAL','ZHAN','1   ','SE  ','    ','    '/
36687      DATA INFLAV(525)/2/
36688      DATA INLONG(525)/'GRAYBILL-DEAL ZHANG ONE STANDARD ERROR'/
36689C
36690      DATA INCASE(526)/'GDZ2'/
36691      DATA (INAME(526,J),J=1,MAXSCL)/
36692     1'GRAY','    ','DEAL','ZHAN','TWO ','STAN','ERRO','    '/
36693      DATA INFLAV(526)/2/
36694      DATA INLONG(526)/'GRAYBILL-DEAL ZHANG TWO STANDARD ERROR'/
36695C
36696      DATA INCASE(527)/'GDZ2'/
36697      DATA (INAME(527,J),J=1,MAXSCL)/
36698     1'GRAY','    ','DEAL','ZHAN','2   ','STAN','ERRO','    '/
36699      DATA INFLAV(527)/2/
36700      DATA INLONG(527)/'GRAYBILL-DEAL ZHANG TWO STANDARD ERROR'/
36701C
36702      DATA INCASE(528)/'GDZ2'/
36703      DATA (INAME(528,J),J=1,MAXSCL)/
36704     1'GRAY','    ','DEAL','ZHAN','TWO ','SE  ','    ','    '/
36705      DATA INFLAV(528)/2/
36706      DATA INLONG(528)/'GRAYBILL-DEAL ZHANG TWO STANDARD ERROR'/
36707C
36708      DATA INCASE(529)/'GDZ2'/
36709      DATA (INAME(529,J),J=1,MAXSCL)/
36710     1'GRAY','    ','DEAL','ZHAN','2   ','SE  ','    ','    '/
36711      DATA INFLAV(529)/2/
36712      DATA INLONG(529)/'GRAYBILL-DEAL ZHANG TWO STANDARD ERROR'/
36713C
36714      DATA INCASE(530)/'GDSE'/
36715      DATA (INAME(530,J),J=1,MAXSCL)/
36716     1'GRAY','    ','DEAL','STAN','ERRO','    ','    ','    '/
36717      DATA INFLAV(530)/2/
36718      DATA INLONG(530)/'GRAYBILL-DEAL SINHA STANDARD ERROR'/
36719C
36720      DATA INCASE(531)/'GDSE'/
36721      DATA (INAME(531,J),J=1,MAXSCL)/
36722     1'GRAY','    ','DEAL','SE  ','    ','    ','    ','    '/
36723      DATA INFLAV(531)/2/
36724      DATA INLONG(531)/'GRAYBILL-DEAL SINHA STANDARD ERROR'/
36725C
36726      DATA INCASE(532)/'GDEA'/
36727      DATA (INAME(532,J),J=1,MAXSCL)/
36728     1'GRAY','    ','DEAL','    ','    ','    ','    ','    '/
36729      DATA INFLAV(532)/2/
36730      DATA INLONG(532)/'GRAYBILL-DEAL'/
36731C
36732      DATA INCASE(533)/'FWSE'/
36733      DATA (INAME(533,J),J=1,MAXSCL)/
36734     1'SUMM','    ','FAIR','STAN','ERRO','    ','    ','    '/
36735      DATA INFLAV(533)/3/
36736      DATA INLONG(533)/'FAIRWEATHER STANDARD ERROR'/
36737C
36738      DATA INCASE(534)/'FWSE'/
36739      DATA (INAME(534,J),J=1,MAXSCL)/
36740     1'SUMM','    ','FAIR','SE  ','    ','    ','    ','    '/
36741      DATA INFLAV(534)/3/
36742      DATA INLONG(534)/'FAIRWEATHER STANDARD ERROR'/
36743C
36744      DATA INCASE(535)/'FAIR'/
36745      DATA (INAME(535,J),J=1,MAXSCL)/
36746     1'SUMM','    ','FAIR','    ','    ','    ','    ','    '/
36747      DATA INFLAV(535)/3/
36748      DATA INLONG(535)/'FAIRWEATHER'/
36749C
36750      DATA INCASE(536)/'FWSE'/
36751      DATA (INAME(536,J),J=1,MAXSCL)/
36752     1'FAIR','    ','STAN','ERRO','    ','    ','    ','    '/
36753      DATA INFLAV(536)/2/
36754      DATA INLONG(536)/'FAIRWEATHER STANDARD ERROR'/
36755C
36756      DATA INCASE(537)/'FWSE'/
36757      DATA (INAME(537,J),J=1,MAXSCL)/
36758     1'FAIR','    ','SE  ','    ','    ','    ','    ','    '/
36759      DATA INFLAV(537)/2/
36760      DATA INLONG(537)/'FAIRWEATHER STANDARD ERROR'/
36761C
36762      DATA INCASE(538)/'FAIR'/
36763      DATA (INAME(538,J),J=1,MAXSCL)/
36764     1'FAIR','    ','    ','    ','    ','    ','    ','    '/
36765      DATA INFLAV(538)/2/
36766      DATA INLONG(538)/'FAIRWEATHER'/
36767C
36768      DATA INCASE(539)/'SCEB'/
36769      DATA (INAME(539,J),J=1,MAXSCL)/
36770     1'SCHI','    ','EBER','    ','    ','    ','    ','    '/
36771      DATA INFLAV(539)/2/
36772      DATA INLONG(539)/'SCHILLER-EBERHARDT'/
36773C
36774      DATA INCASE(540)/'BPRC'/
36775      DATA (INAME(540,J),J=1,MAXSCL)/
36776     1'CORR','    ','BINO','PROP','    ','    ','    ','    '/
36777      DATA INFLAV(540)/1/
36778      DATA INLONG(540)/'BINOMIAL PROPORTION (CONTINUITY CORRECTION)'/
36779C
36780      DATA INCASE(541)/'COAB'/
36781      DATA (INAME(541,J),J=1,MAXSCL)/
36782     1'CORR','    ','ABSO','VALU','    ','    ','    ','    '/
36783      DATA INFLAV(541)/2/
36784      DATA INLONG(541)/'CORRELATION ABSOLUTE VALUE'/
36785C
36786      DATA INCASE(542)/'RPSD'/
36787      DATA (INAME(542,J),J=1,MAXSCL)/
36788     1'ROBU','    ','POOL','STAN','DEVI','    ','    ','    '/
36789      DATA INFLAV(542)/1/
36790      DATA INLONG(542)/'ROBUST POOLED STANDARD DEVIATION'/
36791C
36792      DATA INCASE(543)/'RPSD'/
36793      DATA (INAME(543,J),J=1,MAXSCL)/
36794     1'ROBU','    ','POOL','SD  ','    ','    ','    ','    '/
36795      DATA INFLAV(543)/1/
36796      DATA INLONG(543)/'ROBUST POOLED STANDARD DEVIATION'/
36797C
36798      DATA INCASE(544)/'RPRA'/
36799      DATA (INAME(544,J),J=1,MAXSCL)/
36800     1'ROBU','    ','POOL','RANG','    ','    ','    ','    '/
36801      DATA INFLAV(544)/1/
36802      DATA INLONG(544)/'ROBUST POOLED RANGE'/
36803C
36804      DATA INCASE(545)/'ADKC'/
36805      DATA (INAME(545,J),J=1,MAXSCL)/
36806     1'ANDE','    ','DARL','KSAM','TEST','CRIT','VALU','    '/
36807      DATA INFLAV(545)/2/
36808      DATA INLONG(545)/'ANDERSON DARLING K-SAMPLE TEST CRITICAL VALUE'/
36809C
36810      DATA INCASE(546)/'ADKC'/
36811      DATA (INAME(546,J),J=1,MAXSCL)/
36812     1'ANDE','    ','DARL','K   ','SAMP','TEST','CRIT','VALU'/
36813      DATA INFLAV(546)/2/
36814      DATA INLONG(546)/'ANDERSON DARLING K-SAMPLE TEST CRITICAL VALUE'/
36815C
36816      DATA INCASE(547)/'ADKS'/
36817      DATA (INAME(547,J),J=1,MAXSCL)/
36818     1'ANDE','    ','DARL','KSAM','TEST','    ','    ','    '/
36819      DATA INFLAV(547)/2/
36820      DATA INLONG(547)/'ANDERSON DARLING K-SAMPLE TEST'/
36821C
36822      DATA INCASE(548)/'ADKS'/
36823      DATA (INAME(548,J),J=1,MAXSCL)/
36824     1'ANDE','    ','DARL','K   ','SAMP','TEST','    ','    '/
36825      DATA INFLAV(548)/2/
36826      DATA INLONG(548)/'ANDERSON DARLING K-SAMPLE TEST'/
36827C
36828      DATA INCASE(549)/'KSCV'/
36829      DATA (INAME(549,J),J=1,MAXSCL)/
36830     1'KOLM','    ','SMIR','TWO ','SAMP','TEST','CRIT','VALU'/
36831      DATA INFLAV(549)/2/
36832      DATA INLONG(549)
36833     1     /'TWO SAMPLE KOLMOGOROV SMIRNOV TEST CRITICAL VALUE'/
36834C
36835      DATA INCASE(550)/'KSCV'/
36836      DATA (INAME(550,J),J=1,MAXSCL)/
36837     1'TWO ','    ','SAMP','KOLM','SMIR','TEST','CRIT','VALU'/
36838      DATA INFLAV(550)/2/
36839      DATA INLONG(550)
36840     1     /'TWO SAMPLE KOLMOGOROV SMIRNOV TEST CRITICAL VALUE'/
36841C
36842      DATA INCASE(551)/'KS2S'/
36843      DATA (INAME(551,J),J=1,MAXSCL)/
36844     1'KOLM','    ','SMIR','TWO ','SAMP','TEST','    ','    '/
36845      DATA INFLAV(551)/2/
36846      DATA INLONG(551)/'TWO SAMPLE KOLMOGOROV SMIRNOV TEST'/
36847C
36848      DATA INCASE(552)/'KS2S'/
36849      DATA (INAME(552,J),J=1,MAXSCL)/
36850     1'TWO ','    ','SAMP','KOLM','SMIR','TEST','    ','    '/
36851      DATA INFLAV(552)/2/
36852      DATA INLONG(552)/'TWO SAMPLE KOLMOGOROV SMIRNOV TEST'/
36853C
36854      DATA INCASE(553)/'WSPV'/
36855      DATA (INAME(553,J),J=1,MAXSCL)/
36856     1'WILK','    ','SHAP','NORM','TEST','PVAL','    ','    '/
36857      DATA INFLAV(553)/1/
36858      DATA INLONG(553)/'WILK SHAPIRO NORMALITY TEST P-VALUE'/
36859C
36860      DATA INCASE(554)/'WSPV'/
36861      DATA (INAME(554,J),J=1,MAXSCL)/
36862     1'WILK','    ','SHAP','TEST','PVAL','    ','    ','    '/
36863      DATA INFLAV(554)/1/
36864      DATA INLONG(554)/'WILK SHAPIRO NORMALITY TEST P-VALUE'/
36865C
36866      DATA INCASE(555)/'WSPV'/
36867      DATA (INAME(555,J),J=1,MAXSCL)/
36868     1'WILK','    ','SHAP','PVAL','    ','    ','    ','    '/
36869      DATA INFLAV(555)/1/
36870      DATA INLONG(555)/'WILK SHAPIRO NORMALITY TEST PVALUE'/
36871C
36872      DATA INCASE(556)/'WSHA'/
36873      DATA (INAME(556,J),J=1,MAXSCL)/
36874     1'WILK','    ','SHAP','NORM','TEST','    ','    ','    '/
36875      DATA INFLAV(556)/1/
36876      DATA INLONG(556)/'WILK SHAPIRO NORMALITY TEST'/
36877C
36878      DATA INCASE(557)/'WSHA'/
36879      DATA (INAME(557,J),J=1,MAXSCL)/
36880     1'WILK','    ','SHAP','TEST','    ','    ','    ','    '/
36881      DATA INFLAV(557)/1/
36882      DATA INLONG(557)/'WILK SHAPIRO NORMALITY TEST'/
36883C
36884      DATA INCASE(558)/'WSPV'/
36885      DATA (INAME(558,J),J=1,MAXSCL)/
36886     1'WILK','    ','SHAP','P   ','VALU','    ','    ','    '/
36887      DATA INFLAV(558)/1/
36888      DATA INLONG(558)/'WILK SHAPIRO NORMALITY TEST PVALUE'/
36889C
36890      DATA INCASE(559)/'CSFP'/
36891      DATA (INAME(559,J),J=1,MAXSCL)/
36892     1'CUMU','    ','SUM ','FORW','TEST','PVAL','    ','    '/
36893      DATA INFLAV(559)/1/
36894      DATA INLONG(559)/'CUMULATIVE SUM FORWARD TEST P-VALUE'/
36895C
36896      DATA INCASE(560)/'CSFP'/
36897      DATA (INAME(560,J),J=1,MAXSCL)/
36898     1'CUMU','    ','SUM ','FORW','TEST','P   ','VALU','    '/
36899      DATA INFLAV(560)/1/
36900      DATA INLONG(560)/'CUMULATIVE SUM FORWARD TEST P-VALUE'/
36901C
36902      DATA INCASE(561)/'CSFT'/
36903      DATA (INAME(561,J),J=1,MAXSCL)/
36904     1'CUMU','    ','SUM ','FORW','TEST','    ','    ','    '/
36905      DATA INFLAV(561)/1/
36906      DATA INLONG(561)/'CUMULATIVE SUM FORWARD TEST'/
36907C
36908      DATA INCASE(562)/'CSBP'/
36909      DATA (INAME(562,J),J=1,MAXSCL)/
36910     1'CUMU','    ','SUM ','BACK','TEST','PVAL','    ','    '/
36911      DATA INFLAV(562)/1/
36912      DATA INLONG(562)/'CUMULATIVE SUM BACKWARD TEST P-VALUE'/
36913C
36914      DATA INCASE(563)/'CSBP'/
36915      DATA (INAME(563,J),J=1,MAXSCL)/
36916     1'CUMU','    ','SUM ','BACK','TEST','P   ','VALU','    '/
36917      DATA INFLAV(563)/1/
36918      DATA INLONG(563)/'CUMULATIVE SUM BACKWARD TEST P-VALUE'/
36919C
36920      DATA INCASE(564)/'CSBT'/
36921      DATA (INAME(564,J),J=1,MAXSCL)/
36922     1'CUMU','    ','SUM ','BACK','TEST','    ','    ','    '/
36923      DATA INFLAV(564)/1/
36924      DATA INLONG(564)/'CUMULATIVE SUM BACKWARD TEST'/
36925C
36926      DATA INCASE(565)/'1LNT'/
36927      DATA (INAME(565,J),J=1,MAXSCL)/
36928     1'NORM','    ','TOLE','ONE ','SIDE','LOWE','LIMI','    '/
36929      DATA INFLAV(565)/1/
36930      DATA INLONG(565)/'NORMAL TOLERANCE ONE-SIDED LOWER LIMIT'/
36931C
36932      DATA INCASE(566)/'1UNT'/
36933      DATA (INAME(566,J),J=1,MAXSCL)/
36934     1'NORM','    ','TOLE','ONE ','SIDE','UPPE','LIMI','    '/
36935      DATA INFLAV(566)/1/
36936      DATA INLONG(566)/'NORMAL TOLERANCE ONE-SIDED UPPER LIMIT'/
36937C
36938      DATA INCASE(567)/'1KNT'/
36939      DATA (INAME(567,J),J=1,MAXSCL)/
36940     1'NORM','    ','TOLE','ONE ','SIDE','K   ','FACT','    '/
36941      DATA INFLAV(567)/1/
36942      DATA INLONG(567)/'NORMAL TOLERANCE ONE-SIDED K FACTOR'/
36943C
36944      DATA INCASE(568)/'2LNT'/
36945      DATA (INAME(568,J),J=1,MAXSCL)/
36946     1'NORM','    ','TOLE','LOWE','LIMI','    ','    ','    '/
36947      DATA INFLAV(568)/1/
36948      DATA INLONG(568)/'NORMAL TOLERANCE LOWER LIMIT'/
36949C
36950      DATA INCASE(569)/'2UNT'/
36951      DATA (INAME(569,J),J=1,MAXSCL)/
36952     1'NORM','    ','TOLE','UPPE','LIMI','    ','    ','    '/
36953      DATA INFLAV(569)/1/
36954      DATA INLONG(569)/'NORMAL TOLERANCE UPPER LIMIT'/
36955C
36956      DATA INCASE(570)/'2KNT'/
36957      DATA (INAME(570,J),J=1,MAXSCL)/
36958     1'NORM','    ','TOLE','K   ','FACT','    ','    ','    '/
36959      DATA INFLAV(570)/1/
36960      DATA INLONG(570)/'NORMAL TOLERANCE K FACTOR'/
36961C
36962      DATA INCASE(571)/'FTCD'/
36963      DATA (INAME(571,J),J=1,MAXSCL)/
36964     1'F   ','    ','TEST','CDF ','    ','    ','    ','    '/
36965      DATA INFLAV(571)/2/
36966      DATA INLONG(571)/'F TEST CDF'/
36967C
36968      DATA INCASE(572)/'FTPV'/
36969      DATA (INAME(572,J),J=1,MAXSCL)/
36970     1'F   ','    ','TEST','PVAL','    ','    ','    ','    '/
36971      DATA INFLAV(572)/2/
36972      DATA INLONG(572)/'F TEST PVALUE'/
36973C
36974      DATA INCASE(573)/'FTES'/
36975      DATA (INAME(573,J),J=1,MAXSCL)/
36976     1'F   ','    ','TEST','    ','    ','    ','    ','    '/
36977      DATA INFLAV(573)/2/
36978      DATA INLONG(573)/'F TEST'/
36979C
36980      DATA INCASE(574)/'1T2P'/
36981      DATA (INAME(574,J),J=1,MAXSCL)/
36982     1'ONE ','    ','SAMP','T   ','TEST','P   ','VALU','    '/
36983      DATA INFLAV(574)/1/
36984      DATA INLONG(574)/'ONE-SAMPLE T-TEST P-VALUE'/
36985C
36986      DATA INCASE(575)/'1TLP'/
36987      DATA (INAME(575,J),J=1,MAXSCL)/
36988     1'ONE ','    ','SAMP','T   ','TEST','LOWE','TAIL','PVAL'/
36989      DATA INFLAV(575)/1/
36990      DATA INLONG(575)/'ONE-SAMPLE T-TEST LOWER TAIL P-VALUE'/
36991C
36992      DATA INCASE(576)/'1TUP'/
36993      DATA (INAME(576,J),J=1,MAXSCL)/
36994     1'ONE ','    ','SAMP','T   ','TEST','UPPE','TAIL','PVAL'/
36995      DATA INFLAV(576)/1/
36996      DATA INLONG(576)/'ONE-SAMPLE T-TEST UPPER TAIL P-VALUE'/
36997C
36998      DATA INCASE(577)/'1TTE'/
36999      DATA (INAME(577,J),J=1,MAXSCL)/
37000     1'ONE ','    ','SAMP','T   ','TEST','    ','    ','    '/
37001      DATA INFLAV(577)/1/
37002      DATA INLONG(577)/'ONE-SAMPLE T-TEST'/
37003C
37004      DATA INCASE(578)/'2TCD'/
37005      DATA (INAME(578,J),J=1,MAXSCL)/
37006     1'TWO ','    ','SAMP','T   ','TEST','CDF ','    ','    '/
37007      DATA INFLAV(578)/2/
37008      DATA INLONG(578)/'TWO-SAMPLE T-TEST CDF'/
37009C
37010      DATA INCASE(579)/'2T2P'/
37011      DATA (INAME(579,J),J=1,MAXSCL)/
37012     1'TWO ','    ','SAMP','T   ','TEST','P   ','VALU','    '/
37013      DATA INFLAV(579)/2/
37014      DATA INLONG(579)/'TWO-SAMPLE T-TEST P-VALUE'/
37015C
37016      DATA INCASE(580)/'2T2P'/
37017      DATA (INAME(580,J),J=1,MAXSCL)/
37018     1'TWO ','    ','SAMP','T   ','TEST','PVAL','    ','    '/
37019      DATA INFLAV(580)/2/
37020      DATA INLONG(580)/'TWO-SAMPLE T-TEST P-VALUE'/
37021C
37022      DATA INCASE(581)/'2TLP'/
37023      DATA (INAME(581,J),J=1,MAXSCL)/
37024     1'TWO ','    ','SAMP','T   ','TEST','LOWE','TAIL','PVAL'/
37025      DATA INFLAV(581)/2/
37026      DATA INLONG(581)/'TWO-SAMPLE T-TEST LOWER TAIL P-VALUE'/
37027C
37028      DATA INCASE(582)/'2TUP'/
37029      DATA (INAME(582,J),J=1,MAXSCL)/
37030     1'TWO ','    ','SAMP','T   ','TEST','UPPE','TAIL','PVAL'/
37031      DATA INFLAV(582)/2/
37032      DATA INLONG(582)/'TWO-SAMPLE T-TEST UPPER TAIL P-VALUE'/
37033C
37034      DATA INCASE(583)/'2TTE'/
37035      DATA (INAME(583,J),J=1,MAXSCL)/
37036     1'TWO ','    ','SAMP','T   ','TEST','    ','    ','    '/
37037      DATA INFLAV(583)/2/
37038      DATA INLONG(583)/'TWO-SAMPLE T-TEST'/
37039C
37040      DATA INCASE(584)/'PTCD'/
37041      DATA (INAME(584,J),J=1,MAXSCL)/
37042     1'TWO ','    ','SAMP','PAIR','T   ','TEST','CDF ','    '/
37043      DATA INFLAV(584)/2/
37044      DATA INLONG(584)/'TWO-SAMPLE PAIRED T-TEST CDF'/
37045C
37046      DATA INCASE(585)/'PT2P'/
37047      DATA (INAME(585,J),J=1,MAXSCL)/
37048     1'TWO ','    ','SAMP','PAIR','T   ','TEST','P   ','VALU'/
37049      DATA INFLAV(585)/2/
37050      DATA INLONG(585)/'TWO-SAMPLE PAIRED T-TEST P-VALUE'/
37051C
37052      DATA INCASE(586)/'PT2P'/
37053      DATA (INAME(586,J),J=1,MAXSCL)/
37054     1'TWO ','    ','SAMP','PAIR','T   ','TEST','PVAL','    '/
37055      DATA INFLAV(586)/2/
37056      DATA INLONG(586)/'TWO-SAMPLE PAIRED T-TEST P-VALUE'/
37057C
37058      DATA INCASE(587)/'PTLP'/
37059      DATA (INAME(587,J),J=1,MAXSCL)/
37060     1'TWO ','    ','SAMP','PAIR','TTES','LOWE','TAIL','PVAL'/
37061      DATA INFLAV(587)/2/
37062      DATA INLONG(587)/'TWO-SAMPLE PAIRED T-TEST LOWER TAIL P-VALUE'/
37063C
37064      DATA INCASE(588)/'PTUP'/
37065      DATA (INAME(588,J),J=1,MAXSCL)/
37066     1'TWO ','    ','SAMP','PAIR','TTES','UPPE','TAIL','PVAL'/
37067      DATA INFLAV(588)/2/
37068      DATA INLONG(588)/'TWO-SAMPLE PAIRED T-TEST UPPER TAIL P-VALUE'/
37069C
37070      DATA INCASE(589)/'PTTE'/
37071      DATA (INAME(589,J),J=1,MAXSCL)/
37072     1'TWO ','    ','SAMP','PAIR','T   ','TEST','    ','    '/
37073      DATA INFLAV(589)/2/
37074      DATA INLONG(589)/'TWO-SAMPLE PAIRED T-TEST'/
37075C
37076      DATA INCASE(590)/'CSLP'/
37077      DATA (INAME(590,J),J=1,MAXSCL)/
37078     1'CHI ','    ','SQUA','SD  ','TEST','LOWE','TAIL','PVAL'/
37079      DATA INFLAV(590)/1/
37080      DATA INLONG(590)/'CHI-SQUARE SD LOWER TAIL PVALUE'/
37081C
37082      DATA INCASE(591)/'CSLP'/
37083      DATA (INAME(591,J),J=1,MAXSCL)/
37084     1'CHI ','    ','SQUA','STAN','DEVI','LOWE','TAIL','PVAL'/
37085      DATA INFLAV(591)/1/
37086      DATA INLONG(591)/'CHI-SQUARE SD LOWER TAIL PVALUE'/
37087C
37088      DATA INCASE(592)/'CSLP'/
37089      DATA (INAME(592,J),J=1,MAXSCL)/
37090     1'CHI ','    ','SQUA','SD  ','LOWE','TAIL','PVAL','    '/
37091      DATA INFLAV(592)/1/
37092      DATA INLONG(592)/'CHI-SQUARE SD LOWER TAIL PVALUE'/
37093C
37094      DATA INCASE(593)/'CSUP'/
37095      DATA (INAME(593,J),J=1,MAXSCL)/
37096     1'CHI ','    ','SQUA','SD  ','TEST','UPPE','TAIL','PVAL'/
37097      DATA INFLAV(593)/1/
37098      DATA INLONG(593)/'CHI-SQUARE SD UPPER TAIL PVALUE'/
37099C
37100      DATA INCASE(594)/'CSUP'/
37101      DATA (INAME(594,J),J=1,MAXSCL)/
37102     1'CHI ','    ','SQUA','STAN','DEVI','UPPE','TAIL','PVAL'/
37103      DATA INFLAV(594)/1/
37104      DATA INLONG(594)/'CHI-SQUARE SD UPPER TAIL PVALUE'/
37105C
37106      DATA INCASE(595)/'CSUP'/
37107      DATA (INAME(595,J),J=1,MAXSCL)/
37108     1'CHI ','    ','SQUA','SD  ','UPPE','TAIL','PVAL','    '/
37109      DATA INFLAV(595)/1/
37110      DATA INLONG(595)/'CHI-SQUARE SD UPPER TAIL PVALUE'/
37111C
37112      DATA INCASE(596)/'CSSD'/
37113      DATA (INAME(596,J),J=1,MAXSCL)/
37114     1'CHI ','    ','SQUA','STAN','DEVI','TEST','    ','    '/
37115      DATA INFLAV(596)/1/
37116      DATA INLONG(596)/'CHI-SQUARE STANDARD DEVIATION STATISTIC'/
37117C
37118      DATA INCASE(597)/'CSSD'/
37119      DATA (INAME(597,J),J=1,MAXSCL)/
37120     1'CHI ','    ','SQUA','SD  ','TEST','    ','    ','    '/
37121      DATA INFLAV(597)/1/
37122      DATA INLONG(597)/'CHI-SQUARE STANDARD DEVIATION STATISTIC'/
37123C
37124      DATA INCASE(598)/'CSSD'/
37125      DATA (INAME(598,J),J=1,MAXSCL)/
37126     1'CHI ','    ','SQUA','SD  ','    ','    ','    ','    '/
37127      DATA INFLAV(598)/1/
37128      DATA INLONG(598)/'CHI-SQUARE STANDARD DEVIATION STATISTIC'/
37129C
37130      DATA INCASE(599)/'CSSD'/
37131      DATA (INAME(599,J),J=1,MAXSCL)/
37132     1'CHI ','    ','SQUA','STAN','DEVI','    ','    ','    '/
37133      DATA INFLAV(599)/1/
37134      DATA INLONG(599)/'CHI-SQUARE STANDARD DEVIATION STATISTIC'/
37135C
37136      DATA INCASE(600)/'2SCD'/
37137      DATA (INAME(600,J),J=1,MAXSCL)/
37138     1'TWO ','    ','SAMP','SIGN','TEST','CDF ','    ','    '/
37139      DATA INFLAV(600)/2/
37140      DATA INLONG(600)/'TWO-SAMPLE SIGN TEST CDF'/
37141C
37142      DATA INCASE(601)/'2S2P'/
37143      DATA (INAME(601,J),J=1,MAXSCL)/
37144     1'TWO ','    ','SAMP','SIGN','TEST','P   ','VALU','    '/
37145      DATA INFLAV(601)/2/
37146      DATA INLONG(601)/'TWO-SAMPLE SIGN TEST P-VALUE'/
37147C
37148      DATA INCASE(602)/'2S2P'/
37149      DATA (INAME(602,J),J=1,MAXSCL)/
37150     1'TWO ','    ','SAMP','SIGN','TEST','PVAL','    ','    '/
37151      DATA INFLAV(602)/2/
37152      DATA INLONG(602)/'TWO-SAMPLE SIGN TEST P-VALUE'/
37153C
37154      DATA INCASE(603)/'2SLP'/
37155      DATA (INAME(603,J),J=1,MAXSCL)/
37156     1'TWO ','    ','SAMP','SIGN','TEST','LOWE','TAIL','PVAL'/
37157      DATA INFLAV(603)/2/
37158      DATA INLONG(603)/'TWO-SAMPLE SIGN TEST LOWER TAIL P-VALUE'/
37159C
37160      DATA INCASE(604)/'2SUP'/
37161      DATA (INAME(604,J),J=1,MAXSCL)/
37162     1'TWO ','    ','SAMP','SIGN','TEST','UPPE','TAIL','PVAL'/
37163      DATA INFLAV(604)/2/
37164      DATA INLONG(604)/'TWO-SAMPLE SIGN TEST UPPER TAIL P-VALUE'/
37165C
37166      DATA INCASE(605)/'2STE'/
37167      DATA (INAME(605,J),J=1,MAXSCL)/
37168     1'TWO ','    ','SAMP','SIGN','TEST','    ','    ','    '/
37169      DATA INFLAV(605)/2/
37170      DATA INLONG(605)/'TWO-SAMPLE SIGN TEST'/
37171C
37172      DATA INCASE(606)/'1SCD'/
37173      DATA (INAME(606,J),J=1,MAXSCL)/
37174     1'ONE ','    ','SAMP','SIGN','TEST','CDF ','    ','    '/
37175      DATA INFLAV(606)/1/
37176      DATA INLONG(606)/'ONE-SAMPLE SIGN TEST CDF'/
37177C
37178      DATA INCASE(607)/'1S2P'/
37179      DATA (INAME(607,J),J=1,MAXSCL)/
37180     1'ONE ','    ','SAMP','SIGN','TEST','P   ','VALU','    '/
37181      DATA INFLAV(607)/1/
37182      DATA INLONG(607)/'ONE-SAMPLE SIGN TEST P-VALUE'/
37183C
37184      DATA INCASE(608)/'1S2P'/
37185      DATA (INAME(608,J),J=1,MAXSCL)/
37186     1'ONE ','    ','SAMP','SIGN','TEST','PVAL','    ','    '/
37187      DATA INFLAV(608)/1/
37188      DATA INLONG(608)/'ONE-SAMPLE SIGN TEST P-VALUE'/
37189C
37190      DATA INCASE(609)/'1SLP'/
37191      DATA (INAME(609,J),J=1,MAXSCL)/
37192     1'ONE ','    ','SAMP','SIGN','TEST','LOWE','TAIL','PVAL'/
37193      DATA INFLAV(609)/1/
37194      DATA INLONG(609)/'ONE-SAMPLE SIGN TEST LOWER TAIL P-VALUE'/
37195C
37196      DATA INCASE(610)/'1SUP'/
37197      DATA (INAME(610,J),J=1,MAXSCL)/
37198     1'ONE ','    ','SAMP','SIGN','TEST','UPPE','TAIL','PVAL'/
37199      DATA INFLAV(610)/1/
37200      DATA INLONG(610)/'ONE-SAMPLE SIGN TEST UPPER TAIL P-VALUE'/
37201C
37202      DATA INCASE(611)/'1STE'/
37203      DATA (INAME(611,J),J=1,MAXSCL)/
37204     1'ONE ','    ','SAMP','SIGN','TEST','    ','    ','    '/
37205      DATA INFLAV(611)/1/
37206      DATA INLONG(611)/'ONE-SAMPLE SIGN TEST'/
37207C
37208      DATA INCASE(612)/'CALO'/
37209      DATA (INAME(612,J),J=1,MAXSCL)/
37210     1'CAUC','    ','PPCC','LOCA','    ','    ','    ','    '/
37211      DATA INFLAV(612)/1/
37212      DATA INLONG(612)/'CAUCHY PPCC LOCATION'/
37213C
37214      DATA INCASE(613)/'LOLO'/
37215      DATA (INAME(613,J),J=1,MAXSCL)/
37216     1'LOGI','    ','PPCC','LOCA','    ','    ','    ','    '/
37217      DATA INFLAV(613)/1/
37218      DATA INLONG(613)/'LOGISTIC PPCC LOCATION'/
37219C
37220      DATA INCASE(614)/'DELO'/
37221      DATA (INAME(614,J),J=1,MAXSCL)/
37222     1'DOUB','    ','EXPO','PPCC','LOCA','    ','    ','    '/
37223      DATA INFLAV(614)/1/
37224      DATA INLONG(614)/'DOUBLE EXPONENTIAL PPCC LOCATION'/
37225C
37226      DATA INCASE(615)/'HSLO'/
37227      DATA (INAME(615,J),J=1,MAXSCL)/
37228     1'HYPE','    ','SECA','PPCC','LOCA','    ','    ','    '/
37229      DATA INFLAV(615)/1/
37230      DATA INLONG(615)/'HYPERBOLIC SECANT PPCC LOCATION'/
37231C
37232      DATA INCASE(616)/'HNLO'/
37233      DATA (INAME(616,J),J=1,MAXSCL)/
37234     1'HALF','    ','NORM','PPCC','LOCA','    ','    ','    '/
37235      DATA INFLAV(616)/1/
37236      DATA INLONG(616)/'HALF-NORMAL PPCC LOCATION'/
37237C
37238      DATA INCASE(617)/'COLO'/
37239      DATA (INAME(617,J),J=1,MAXSCL)/
37240     1'COSI','    ','PPCC','LOCA','    ','    ','    ','    '/
37241      DATA INFLAV(617)/1/
37242      DATA INLONG(617)/'COSINE PPCC LOCATION'/
37243C
37244      DATA INCASE(618)/'ANLO'/
37245      DATA (INAME(618,J),J=1,MAXSCL)/
37246     1'ANGL','    ','PPCC','LOCA','    ','    ','    ','    '/
37247      DATA INFLAV(618)/1/
37248      DATA INLONG(618)/'ANGLIT PPCC LOCATION'/
37249C
37250      DATA INCASE(619)/'ARLO'/
37251      DATA (INAME(619,J),J=1,MAXSCL)/
37252     1'ARCS','    ','PPCC','LOCA','    ','    ','    ','    '/
37253      DATA INFLAV(619)/1/
37254      DATA INLONG(619)/'ARCSINE PPCC LOCATION'/
37255C
37256      DATA INCASE(620)/'EXLO'/
37257      DATA (INAME(620,J),J=1,MAXSCL)/
37258     1'EXPO','    ','PPCC','LOCA','    ','    ','    ','    '/
37259      DATA INFLAV(620)/1/
37260      DATA INLONG(620)/'EXPONENTIAL PPCC LOCATION'/
37261C
37262      DATA INCASE(621)/'SLLO'/
37263      DATA (INAME(621,J),J=1,MAXSCL)/
37264     1'SLAS','    ','PPCC','LOCA','    ','    ','    ','    '/
37265      DATA INFLAV(621)/1/
37266      DATA INLONG(621)/'SLASH PPCC LOCATION'/
37267C
37268      DATA INCASE(622)/'RALO'/
37269      DATA (INAME(622,J),J=1,MAXSCL)/
37270     1'RAYL','    ','PPCC','LOCA','    ','    ','    ','    '/
37271      DATA INFLAV(622)/1/
37272      DATA INLONG(622)/'RAYLEIGH PPCC LOCATION'/
37273C
37274      DATA INCASE(623)/'MXLO'/
37275      DATA (INAME(623,J),J=1,MAXSCL)/
37276     1'MAXW','    ','PPCC','LOCA','    ','    ','    ','    '/
37277      DATA INFLAV(623)/1/
37278      DATA INLONG(623)/'MAXWELL PPCC LOCATION'/
37279C
37280      DATA INCASE(624)/'TLPP'/
37281      DATA (INAME(624,J),J=1,MAXSCL)/
37282     1'TUKE','    ','LAMB','PPCC','STAT','    ','    ','    '/
37283      DATA INFLAV(624)/1/
37284      DATA INLONG(624)/'TUKEY LAMBDA PPCC'/
37285C
37286      DATA INCASE(625)/'DELO'/
37287      DATA (INAME(625,J),J=1,MAXSCL)/
37288     1'LAPL','    ','PPCC','LOCA','    ','    ','    ','    '/
37289      DATA INFLAV(625)/1/
37290      DATA INLONG(625)/'DOUBLE EXPONENTIAL PPCC LOCATION'/
37291C
37292      DATA INCASE(626)/'HCLO'/
37293      DATA (INAME(626,J),J=1,MAXSCL)/
37294     1'HALF','    ','CAUC','PPCC','LOCA','    ','    ','    '/
37295      DATA INFLAV(626)/1/
37296      DATA INLONG(626)/'HALF-CAUCHY PPCC LOCATION'/
37297C
37298      DATA INCASE(627)/'SCLO'/
37299      DATA (INAME(627,J),J=1,MAXSCL)/
37300     1'SEMI','    ','CIRC','PPCC','LOCA','    ','    ','    '/
37301      DATA INFLAV(627)/1/
37302      DATA INLONG(627)/'SEMI-CIRCULAR PPCC LOCATION'/
37303C
37304      DATA INCASE(628)/'G1SC'/
37305      DATA (INAME(628,J),J=1,MAXSCL)/
37306     1'MINI','    ','GUMB','PPCC','SCAL','    ','    ','    '/
37307      DATA INFLAV(628)/1/
37308      DATA INLONG(628)/'MINIMUM GUMBEL PPCC SCALE'/
37309C
37310      DATA INCASE(629)/'G2SC'/
37311      DATA (INAME(629,J),J=1,MAXSCL)/
37312     1'MAXI','    ','GUMB','PPCC','SCAL','    ','    ','    '/
37313      DATA INFLAV(629)/1/
37314      DATA INLONG(629)/'MAXIMUM GUMBEL PPCC SCALE'/
37315C
37316      DATA INCASE(630)/'WEPP'/
37317      DATA (INAME(630,J),J=1,MAXSCL)/
37318     1'WEIB','    ','PPCC','STAT','    ','    ','    ','    '/
37319      DATA INFLAV(630)/1/
37320      DATA INLONG(630)/'WEIBULL PPCC'/
37321C
37322      DATA INCASE(631)/'WABA'/
37323      DATA (INAME(631,J),J=1,MAXSCL)/
37324     1'WEIB','    ','A   ','BASI','    ','    ','    ','    '/
37325      DATA INFLAV(631)/1/
37326      DATA INLONG(631)/'WEIBULL A BASIS'/
37327C
37328      DATA INCASE(632)/'WABA'/
37329      DATA (INAME(632,J),J=1,MAXSCL)/
37330     1'WEIB','    ','ABAS','    ','    ','    ','    ','    '/
37331      DATA INFLAV(632)/1/
37332      DATA INLONG(632)/'WEIBULL A BASIS'/
37333C
37334      DATA INCASE(633)/'WBBA'/
37335      DATA (INAME(633,J),J=1,MAXSCL)/
37336     1'WEIB','    ','B   ','BASI','    ','    ','    ','    '/
37337      DATA INFLAV(633)/1/
37338      DATA INLONG(633)/'WEIBULL B BASIS'/
37339C
37340      DATA INCASE(634)/'WBBA'/
37341      DATA (INAME(634,J),J=1,MAXSCL)/
37342     1'WEIB','    ','BBAS','    ','    ','    ','    ','    '/
37343      DATA INFLAV(634)/1/
37344      DATA INLONG(634)/'WEIBULL B BASIS'/
37345C
37346      DATA INCASE(635)/'LABA'/
37347      DATA (INAME(635,J),J=1,MAXSCL)/
37348     1'LOGN','    ','A   ','BASI','    ','    ','    ','    '/
37349      DATA INFLAV(635)/1/
37350      DATA INLONG(635)/'LOGNORMAL A BASIS'/
37351C
37352      DATA INCASE(636)/'LABA'/
37353      DATA (INAME(636,J),J=1,MAXSCL)/
37354     1'LOGN','    ','ABAS','    ','    ','    ','    ','    '/
37355      DATA INFLAV(636)/1/
37356      DATA INLONG(636)/'LOGNORMAL A BASIS'/
37357C
37358      DATA INCASE(637)/'LBBA'/
37359      DATA (INAME(637,J),J=1,MAXSCL)/
37360     1'LOGN','    ','B   ','BASI','    ','    ','    ','    '/
37361      DATA INFLAV(637)/1/
37362      DATA INLONG(637)/'LOGNORMAL B BASIS'/
37363C
37364      DATA INCASE(638)/'LBBA'/
37365      DATA (INAME(638,J),J=1,MAXSCL)/
37366     1'LOGN','    ','BBAS','    ','    ','    ','    ','    '/
37367      DATA INFLAV(638)/1/
37368      DATA INLONG(638)/'LOGNORMAL B BASIS'/
37369C
37370      DATA INCASE(639)/'NABA'/
37371      DATA (INAME(639,J),J=1,MAXSCL)/
37372     1'NORM','    ','A   ','BASI','    ','    ','    ','    '/
37373      DATA INFLAV(639)/1/
37374      DATA INLONG(639)/'NORMAL A BASIS'/
37375C
37376      DATA INCASE(640)/'NABA'/
37377      DATA (INAME(640,J),J=1,MAXSCL)/
37378     1'NORM','    ','ABAS','    ','    ','    ','    ','    '/
37379      DATA INFLAV(640)/1/
37380      DATA INLONG(640)/'NORMAL A BASIS'/
37381C
37382      DATA INCASE(641)/'NBBA'/
37383      DATA (INAME(641,J),J=1,MAXSCL)/
37384     1'NORM','    ','B   ','BASI','    ','    ','    ','    '/
37385      DATA INFLAV(641)/1/
37386      DATA INLONG(641)/'NORMAL B BASIS'/
37387C
37388      DATA INCASE(642)/'NBBA'/
37389      DATA (INAME(642,J),J=1,MAXSCL)/
37390     1'NORM','    ','BBAS','    ','    ','    ','    ','    '/
37391      DATA INFLAV(642)/1/
37392      DATA INLONG(642)/'NORMAL B BASIS'/
37393C
37394      DATA INCASE(643)/'ZABA'/
37395      DATA (INAME(643,J),J=1,MAXSCL)/
37396     1'NONP','    ','A   ','BASI','    ','    ','    ','    '/
37397      DATA INFLAV(643)/1/
37398      DATA INLONG(643)/'NONPARAMETRIC A BASIS'/
37399C
37400      DATA INCASE(644)/'ZABA'/
37401      DATA (INAME(644,J),J=1,MAXSCL)/
37402     1'NONP','    ','ABAS','    ','    ','    ','    ','    '/
37403      DATA INFLAV(644)/1/
37404      DATA INLONG(644)/'NONPARAMETRIC A BASIS'/
37405C
37406      DATA INCASE(645)/'ZBBA'/
37407      DATA (INAME(645,J),J=1,MAXSCL)/
37408     1'NONP','    ','B   ','BASI','    ','    ','    ','    '/
37409      DATA INFLAV(645)/1/
37410      DATA INLONG(645)/'NONPARAMETRIC B BASIS'/
37411C
37412      DATA INCASE(646)/'ZBBA'/
37413      DATA (INAME(646,J),J=1,MAXSCL)/
37414     1'NONP','    ','BBAS','    ','    ','    ','    ','    '/
37415      DATA INFLAV(646)/1/
37416      DATA INLONG(646)/'NONPARAMETRIC B BASIS'/
37417C
37418      DATA INCASE(647)/'1WCD'/
37419      DATA (INAME(647,J),J=1,MAXSCL)/
37420     1'ONE ','    ','SAMP','WILC','SIGN','RANK','TEST','CDF '/
37421      DATA INFLAV(647)/1/
37422      DATA INLONG(647)/'ONE-SAMPLE WILCOXON SIGNED RANK TEST CDF'/
37423C
37424      DATA INCASE(648)/'1W2P'/
37425      DATA (INAME(648,J),J=1,MAXSCL)/
37426     1'ONE ','    ','SAMP','WILC','SIGN','RANK','TEST','PVAL'/
37427      DATA INFLAV(648)/1/
37428      DATA INLONG(648)/'ONE-SAMPLE WILCOXON SIGNED RANK TEST P-VALUE'/
37429C
37430      DATA INCASE(649)/'1WLP'/
37431      DATA (INAME(649,J),J=1,MAXSCL)/
37432     1'ONE ','    ','SAMP','WILC','TEST','LOWE','TAIL','PVAL'/
37433      DATA INFLAV(649)/1/
37434      DATA INLONG(649)/'ONE-SAMPLE WILCOXON TEST LOWER TAIL P-VALUE'/
37435C
37436      DATA INCASE(650)/'1WUP'/
37437      DATA (INAME(650,J),J=1,MAXSCL)/
37438     1'ONE ','    ','SAMP','WILC','TEST','UPPE','TAIL','PVAL'/
37439      DATA INFLAV(650)/1/
37440      DATA INLONG(650)/'ONE-SAMPLE WILCOXON TEST UPPER TAIL P-VALUE'/
37441C
37442      DATA INCASE(651)/'1WTE'/
37443      DATA (INAME(651,J),J=1,MAXSCL)/
37444     1'ONE ','    ','SAMP','WILC','SIGN','RANK','TEST','    '/
37445      DATA INFLAV(651)/1/
37446      DATA INLONG(651)/'ONE-SAMPLE T-TEST'/
37447C
37448      DATA INCASE(652)/'2WCD'/
37449      DATA (INAME(652,J),J=1,MAXSCL)/
37450     1'TWO ','    ','SAMP','WILC','SIGN','RANK','TEST','CDF '/
37451      DATA INFLAV(652)/2/
37452      DATA INLONG(652)/'TWO-SAMPLE WILCOXON SIGNED RANK TEST CDF'/
37453C
37454      DATA INCASE(653)/'2W2P'/
37455      DATA (INAME(653,J),J=1,MAXSCL)/
37456     1'TWO ','    ','SAMP','WILC','SIGN','RANK','TEST','PVAL'/
37457      DATA INFLAV(653)/2/
37458      DATA INLONG(653)/'TWO-SAMPLE WILCOXON SIGNED RANK TEST P-VALUE'/
37459C
37460      DATA INCASE(654)/'2WLP'/
37461      DATA (INAME(654,J),J=1,MAXSCL)/
37462     1'TWO ','    ','SAMP','WILC','TEST','LOWE','TAIL','PVAL'/
37463      DATA INFLAV(654)/2/
37464      DATA INLONG(654)/'TWO-SAMPLE WILCOXON TEST LOWER TAIL P-VALUE'/
37465C
37466      DATA INCASE(655)/'2WUP'/
37467      DATA (INAME(655,J),J=1,MAXSCL)/
37468     1'TWO ','    ','SAMP','WILC','TEST','UPPE','TAIL','PVAL'/
37469      DATA INFLAV(655)/2/
37470      DATA INLONG(655)/'TWO-SAMPLE WILCOXON TEST UPPER TAIL P-VALUE'/
37471C
37472      DATA INCASE(656)/'2WTE'/
37473      DATA (INAME(656,J),J=1,MAXSCL)/
37474     1'TWO ','    ','SAMP','WILC','SIGN','RANK','TEST','    '/
37475      DATA INFLAV(656)/2/
37476      DATA INLONG(656)/'TWO-SAMPLE WILCOXON SIGNED RANK TEST'/
37477C
37478      DATA INCASE(657)/'MWCD'/
37479      DATA (INAME(657,J),J=1,MAXSCL)/
37480     1'MANN','    ','WHIT','RANK','SUM ','TEST','CDF ','    '/
37481      DATA INFLAV(657)/2/
37482      DATA INLONG(657)/'MANN WHITNEY RANK SUM TEST CDF'/
37483C
37484      DATA INCASE(658)/'MW2P'/
37485      DATA (INAME(658,J),J=1,MAXSCL)/
37486     1'MANN','    ','WHIT','RANK','SUM ','TEST','PVAL','    '/
37487      DATA INFLAV(658)/2/
37488      DATA INLONG(658)/'MANN WHITNEY RANK SUM TEST PVALUE'/
37489C
37490      DATA INCASE(659)/'MWLP'/
37491      DATA (INAME(659,J),J=1,MAXSCL)/
37492     1'MANN','    ','WHIT','RANK','SUM ','LOWE','TAIL','PVAL'/
37493      DATA INFLAV(659)/2/
37494      DATA INLONG(659)/'MANN WHITNEY RANK SUM LOWER TAIL PVALUE'/
37495C
37496      DATA INCASE(660)/'MWUP'/
37497      DATA (INAME(660,J),J=1,MAXSCL)/
37498     1'MANN','    ','WHIT','RANK','SUM ','UPPE','TAIL','PVAL'/
37499      DATA INFLAV(660)/2/
37500      DATA INLONG(660)/'MANN WHITNEY RANK SUM UPPER TAIL PVALUE'/
37501C
37502      DATA INCASE(661)/'MWTE'/
37503      DATA (INAME(661,J),J=1,MAXSCL)/
37504     1'MANN','    ','WHIT','RANK','SUM ','TEST','    ','    '/
37505      DATA INFLAV(661)/2/
37506      DATA INLONG(661)/'MANN WHITNEY RANK SUM TEST'/
37507C
37508      DATA INCASE(662)/'MWUS'/
37509      DATA (INAME(662,J),J=1,MAXSCL)/
37510     1'MANN','    ','WHIT','U   ','STAT','    ','    ','    '/
37511      DATA INFLAV(662)/2/
37512      DATA INLONG(662)/'MANN WHITNEY U STATISTIC'/
37513C
37514      DATA INCASE(663)/'KLCD'/
37515      DATA (INAME(663,J),J=1,MAXSCL)/
37516     1'KLOT','    ','TEST','CDF ','    ','    ','    ','    '/
37517      DATA INFLAV(663)/2/
37518      DATA INLONG(663)/'KLOTZ TEST CDF'/
37519C
37520      DATA INCASE(664)/'KL2P'/
37521      DATA (INAME(664,J),J=1,MAXSCL)/
37522     1'KLOT','    ','TEST','PVAL','    ','    ','    ','    '/
37523      DATA INFLAV(664)/2/
37524      DATA INLONG(664)/'KLOTZ TEST PVALUE'/
37525C
37526      DATA INCASE(665)/'KLLP'/
37527      DATA (INAME(665,J),J=1,MAXSCL)/
37528     1'KLOT','    ','TEST','LOWE','TAIL','PVAL','    ','    '/
37529      DATA INFLAV(665)/2/
37530      DATA INLONG(665)/'KLOTZ TEST LOWER TAIL PVALUE'/
37531C
37532      DATA INCASE(666)/'KLUP'/
37533      DATA (INAME(666,J),J=1,MAXSCL)/
37534     1'KLOT','    ','TEST','UPPE','TAIL','PVAL','    ','    '/
37535      DATA INFLAV(666)/2/
37536      DATA INLONG(666)/'KLOTZ TEST UPPER TAIL PVALUE'/
37537C
37538      DATA INCASE(667)/'KLTE'/
37539      DATA (INAME(667,J),J=1,MAXSCL)/
37540     1'KLOT','    ','TEST','    ','    ','    ','    ','    '/
37541      DATA INFLAV(667)/2/
37542      DATA INLONG(667)/'KLOTZ TEST'/
37543C
37544      DATA INCASE(668)/'SRCD'/
37545      DATA (INAME(668,J),J=1,MAXSCL)/
37546     1'SQUA','    ','RANK','TEST','CDF ','    ','    ','    '/
37547      DATA INFLAV(668)/2/
37548      DATA INLONG(668)/'SQUARED RANK TEST CDF'/
37549C
37550      DATA INCASE(669)/'SR2P'/
37551      DATA (INAME(669,J),J=1,MAXSCL)/
37552     1'SQUA','    ','RANK','TEST','PVAL','    ','    ','    '/
37553      DATA INFLAV(669)/2/
37554      DATA INLONG(669)/'SQUARED RANK TEST PVALUE'/
37555C
37556      DATA INCASE(670)/'SRLP'/
37557      DATA (INAME(670,J),J=1,MAXSCL)/
37558     1'SQUA','    ','RANK','TEST','LOWE','TAIL','PVAL','    '/
37559      DATA INFLAV(670)/2/
37560      DATA INLONG(670)/'SQUARED RANK TEST LOWER TAILED PVALUE'/
37561C
37562      DATA INCASE(671)/'SRUP'/
37563      DATA (INAME(671,J),J=1,MAXSCL)/
37564     1'SQUA','    ','RANK','TEST','UPPE','TAIL','PVAL','    '/
37565      DATA INFLAV(671)/2/
37566      DATA INLONG(671)/'SQUARED RANK TEST UPPER TAILED PVALUE'/
37567C
37568      DATA INCASE(672)/'SRTE'/
37569      DATA (INAME(672,J),J=1,MAXSCL)/
37570     1'SQUA','    ','RANK','TEST','    ','    ','    ','    '/
37571      DATA INFLAV(672)/2/
37572      DATA INLONG(672)/'SQUARED RANK TEST'/
37573C
37574      DATA INCASE(673)/'ME2P'/
37575      DATA (INAME(673,J),J=1,MAXSCL)/
37576     1'MEDI','    ','TEST','PVAL','    ','    ','    ','    '/
37577      DATA INFLAV(673)/2/
37578      DATA INLONG(673)/'MEDIAN TEST PVALUE'/
37579C
37580      DATA INCASE(674)/'METE'/
37581      DATA (INAME(674,J),J=1,MAXSCL)/
37582     1'MEDI','    ','TEST','    ','    ','    ','    ','    '/
37583      DATA INFLAV(674)/2/
37584      DATA INLONG(674)/'MEDIAN TEST'/
37585C
37586      DATA INCASE(675)/'MEDI'/
37587      DATA (INAME(675,J),J=1,MAXSCL)/
37588     1'MEDI','    ','    ','    ','    ','    ','    ','    '/
37589      DATA INFLAV(675)/1/
37590      DATA INLONG(675)/'MEDIAN'/
37591C
37592      DATA INCASE(676)/'2F2P'/
37593      DATA (INAME(676,J),J=1,MAXSCL)/
37594     1'FISH','    ','TWO ','SAMP','RAND','TEST','PVAL','    '/
37595      DATA INFLAV(676)/2/
37596      DATA INLONG(676)/'FISHER TWO SAMPLE RANDOMIZATION TEST PVALUE'/
37597C
37598      DATA INCASE(677)/'2F2P'/
37599      DATA (INAME(677,J),J=1,MAXSCL)/
37600     1'FISH','    ','2   ','SAMP','RAND','TEST','PVAL','    '/
37601      DATA INFLAV(677)/2/
37602      DATA INLONG(677)/'FISHER TWO SAMPLE RANDOMIZATION TEST PVALUE'/
37603C
37604      DATA INCASE(678)/'2F1P'/
37605      DATA (INAME(678,J),J=1,MAXSCL)/
37606     1'FISH','    ','TWO ','SAMP','RAND','LOWE','TAIL','PVAL'/
37607      DATA INFLAV(678)/2/
37608      DATA INLONG(678)/'FISHER TWO SAMPLE RAND LOWER TAIL PVALUE'/
37609C
37610      DATA INCASE(679)/'2F1P'/
37611      DATA (INAME(679,J),J=1,MAXSCL)/
37612     1'FISH','    ','2   ','SAMP','RAND','LOWE','TAIL','PVAL'/
37613      DATA INFLAV(679)/2/
37614      DATA INLONG(679)/'FISHER TWO SAMPLE RAND LOWER TAIL PVALUE'/
37615C
37616      DATA INCASE(680)/'2SFR'/
37617      DATA (INAME(680,J),J=1,MAXSCL)/
37618     1'FISH','    ','TWO ','SAMP','RAND','TEST','    ','    '/
37619      DATA INFLAV(680)/2/
37620      DATA INLONG(680)/'FISHER TWO SAMPLE RANDOMIZATION TEST'/
37621C
37622      DATA INCASE(681)/'2SFR'/
37623      DATA (INAME(681,J),J=1,MAXSCL)/
37624     1'FISH','    ','2   ','SAMP','RAND','TEST','    ','    '/
37625      DATA INFLAV(681)/2/
37626      DATA INLONG(681)/'FISHER TWO SAMPLE RANDOMIZATION TEST'/
37627C
37628      DATA INCASE(682)/'CC2S'/
37629      DATA (INAME(682,J),J=1,MAXSCL)/
37630     1'CHI ','    ','SQUA','TWO ','SAMP','TEST','CDF ','    '/
37631      DATA INFLAV(682)/2/
37632      DATA INLONG(682)/'TWO SAMPLE CHI-SQUARE TEST CDF'/
37633C
37634      DATA INCASE(683)/'CC2S'/
37635      DATA (INAME(683,J),J=1,MAXSCL)/
37636     1'TWO ','    ','SAMP','CHI ','SQUA','TEST','CDF ','    '/
37637      DATA INFLAV(683)/2/
37638      DATA INLONG(683)/'TWO SAMPLE CHI-SQUARE TEST CDF'/
37639C
37640      DATA INCASE(684)/'CC2S'/
37641      DATA (INAME(684,J),J=1,MAXSCL)/
37642     1'CHI ','    ','SQUA','2   ','SAMP','TEST','CDF ','    '/
37643      DATA INFLAV(684)/2/
37644      DATA INLONG(684)/'TWO SAMPLE CHI-SQUARE TEST CDF'/
37645C
37646      DATA INCASE(685)/'CC2S'/
37647      DATA (INAME(685,J),J=1,MAXSCL)/
37648     1'2   ','    ','SAMP','CHI ','SQUA','TEST','CDF ','    '/
37649      DATA INFLAV(685)/2/
37650      DATA INLONG(685)/'TWO SAMPLE CHI-SQUARE TEST CDF'/
37651C
37652      DATA INCASE(686)/'CP2S'/
37653      DATA (INAME(686,J),J=1,MAXSCL)/
37654     1'CHI ','    ','SQUA','TWO ','SAMP','TEST','PVAL','    '/
37655      DATA INFLAV(686)/2/
37656      DATA INLONG(686)/'TWO SAMPLE CHI-SQUARE TEST PVALUE'/
37657C
37658      DATA INCASE(687)/'CP2S'/
37659      DATA (INAME(687,J),J=1,MAXSCL)/
37660     1'TWO ','    ','SAMP','CHI ','SQUA','TEST','PVAL','    '/
37661      DATA INFLAV(687)/2/
37662      DATA INLONG(687)/'TWO SAMPLE CHI-SQUARE TEST PVALUE'/
37663C
37664      DATA INCASE(688)/'CP2S'/
37665      DATA (INAME(688,J),J=1,MAXSCL)/
37666     1'CHI ','    ','SQUA','2   ','SAMP','TEST','PVAL','    '/
37667      DATA INFLAV(688)/2/
37668      DATA INLONG(688)/'TWO SAMPLE CHI-SQUARE TEST PVALUE'/
37669C
37670      DATA INCASE(689)/'CP2S'/
37671      DATA (INAME(689,J),J=1,MAXSCL)/
37672     1'2   ','    ','SAMP','CHI ','SQUA','TEST','PVAL','    '/
37673      DATA INFLAV(689)/2/
37674      DATA INLONG(689)/'TWO SAMPLE CHI-SQUARE TEST PVALUE'/
37675C
37676      DATA INCASE(690)/'CS2S'/
37677      DATA (INAME(690,J),J=1,MAXSCL)/
37678     1'CHI ','    ','SQUA','TWO ','SAMP','TEST','    ','    '/
37679      DATA INFLAV(690)/2/
37680      DATA INLONG(690)/'TWO SAMPLE CHI-SQUARE TEST'/
37681C
37682      DATA INCASE(691)/'CS2S'/
37683      DATA (INAME(691,J),J=1,MAXSCL)/
37684     1'TWO ','    ','SAMP','CHI ','SQUA','TEST','    ','    '/
37685      DATA INFLAV(691)/2/
37686      DATA INLONG(691)/'TWO SAMPLE CHI-SQUARE TEST'/
37687C
37688      DATA INCASE(692)/'CS2S'/
37689      DATA (INAME(692,J),J=1,MAXSCL)/
37690     1'CHI ','    ','SQUA','2   ','SAMP','TEST','    ','    '/
37691      DATA INFLAV(692)/2/
37692      DATA INLONG(692)/'TWO SAMPLE CHI-SQUARE TEST'/
37693C
37694      DATA INCASE(693)/'CS2S'/
37695      DATA (INAME(693,J),J=1,MAXSCL)/
37696     1'2   ','    ','SAMP','CHI ','SQUA','TEST','    ','    '/
37697      DATA INFLAV(693)/2/
37698      DATA INLONG(693)/'TWO SAMPLE CHI-SQUARE TEST'/
37699C
37700      DATA INCASE(694)/'KWCD'/
37701      DATA (INAME(694,J),J=1,MAXSCL)/
37702     1'KRUS','    ','WALL','TEST','CDF ','    ','    ','    '/
37703      DATA INFLAV(694)/2/
37704      DATA INLONG(694)/'KRUSKAL WALLIS TEST CDF'/
37705C
37706      DATA INCASE(695)/'KW2P'/
37707      DATA (INAME(695,J),J=1,MAXSCL)/
37708     1'KRUS','    ','WALL','TEST','PVAL','    ','    ','    '/
37709      DATA INFLAV(695)/2/
37710      DATA INLONG(695)/'KRUSKALL WALLIS TEST PVALUE'/
37711C
37712      DATA INCASE(696)/'KWTE'/
37713      DATA (INAME(696,J),J=1,MAXSCL)/
37714     1'KRUS','    ','WALL','TEST','    ','    ','    ','    '/
37715      DATA INFLAV(696)/2/
37716      DATA INLONG(696)/'KRUSKALL WALLIS TEST'/
37717C
37718      DATA INCASE(697)/'FZCD'/
37719      DATA (INAME(697,J),J=1,MAXSCL)/
37720     1'FRIE','    ','TEST','CDF ','    ','    ','    ','    '/
37721      DATA INFLAV(697)/3/
37722      DATA INLONG(697)/'FRIEDMAN TEST CDF'/
37723C
37724      DATA INCASE(698)/'FZ2P'/
37725      DATA (INAME(698,J),J=1,MAXSCL)/
37726     1'FRIE','    ','TEST','PVAL','    ','    ','    ','    '/
37727      DATA INFLAV(698)/3/
37728      DATA INLONG(698)/'FRIEDMAN TEST PVALUE'/
37729C
37730      DATA INCASE(699)/'FZTE'/
37731      DATA (INAME(699,J),J=1,MAXSCL)/
37732     1'FRIE','    ','TEST','    ','    ','    ','    ','    '/
37733      DATA INFLAV(699)/3/
37734      DATA INLONG(699)/'FRIEDMAN TEST'/
37735C
37736      DATA INCASE(700)/'QUCD'/
37737      DATA (INAME(700,J),J=1,MAXSCL)/
37738     1'QUAD','    ','TEST','CDF ','    ','    ','    ','    '/
37739      DATA INFLAV(700)/3/
37740      DATA INLONG(700)/'QUADE TEST CDF'/
37741C
37742      DATA INCASE(701)/'QU2P'/
37743      DATA (INAME(701,J),J=1,MAXSCL)/
37744     1'QUAD','    ','TEST','PVAL','    ','    ','    ','    '/
37745      DATA INFLAV(701)/3/
37746      DATA INLONG(701)/'QUADE TEST PVALUE'/
37747C
37748      DATA INCASE(702)/'QUTE'/
37749      DATA (INAME(702,J),J=1,MAXSCL)/
37750     1'QUAD','    ','TEST','    ','    ','    ','    ','    '/
37751      DATA INFLAV(702)/3/
37752      DATA INLONG(702)/'QUADE TEST'/
37753C
37754      DATA INCASE(703)/'UNIQ'/
37755      DATA (INAME(703,J),J=1,MAXSCL)/
37756     1 'UNIQ','    ','    ','    ','    ','    ','    ','    '/
37757      DATA INFLAV(703)/1/
37758      DATA INLONG(703)/'UNIQUE'/
37759C
37760      DATA INCASE(704)/'PEDI'/
37761      DATA (INAME(704,J),J=1,MAXSCL)/
37762     1'PERC','    ','DISA','    ','    ','    ','    ','    '/
37763      DATA INFLAV(704)/2/
37764      DATA INLONG(704)/'PERCENTAGE DISAGREE'/
37765C
37766      DATA INCASE(705)/'PDIF'/
37767      DATA (INAME(705,J),J=1,MAXSCL)/
37768     1'PERC','    ','DIFF','OF  ','MEAN','    ','    ','    '/
37769      DATA INFLAV(705)/2/
37770      DATA INLONG(705)/'PERCENTAGE DIFFERENCE OF MEANS'/
37771C
37772      DATA INCASE(706)/'1LNT'/
37773      DATA (INAME(706,J),J=1,MAXSCL)/
37774     1'SUMM','    ','NORM','TOLE','ONE ','SIDE','LOWE','LIMI'/
37775      DATA INFLAV(706)/3/
37776      DATA INLONG(706)/'NORMAL TOLERANCE ONE-SIDED LOWER LIMIT'/
37777C
37778      DATA INCASE(707)/'1UNT'/
37779      DATA (INAME(707,J),J=1,MAXSCL)/
37780     1'SUMM','    ','NORM','TOLE','ONE ','SIDE','UPPE','LIMI'/
37781      DATA INFLAV(707)/3/
37782      DATA INLONG(707)/'NORMAL TOLERANCE ONE-SIDED UPPER LIMIT'/
37783C
37784      DATA INCASE(708)/'1KNT'/
37785      DATA (INAME(708,J),J=1,MAXSCL)/
37786     1'SUMM','    ','NORM','TOLE','ONE ','SIDE','K   ','FACT'/
37787      DATA INFLAV(708)/3/
37788      DATA INLONG(708)/'NORMAL TOLERANCE ONE-SIDED K FACTOR'/
37789C
37790      DATA INCASE(709)/'2LNT'/
37791      DATA (INAME(709,J),J=1,MAXSCL)/
37792     1'SUMM','    ','NORM','TOLE','LOWE','LIMI','    ','    '/
37793      DATA INFLAV(709)/3/
37794      DATA INLONG(709)/'NORMAL TOLERANCE LOWER LIMIT'/
37795C
37796      DATA INCASE(710)/'2UNT'/
37797      DATA (INAME(710,J),J=1,MAXSCL)/
37798     1'SUMM','    ','NORM','TOLE','UPPE','LIMI','    ','    '/
37799      DATA INFLAV(710)/3/
37800      DATA INLONG(710)/'NORMAL TOLERANCE UPPER LIMIT'/
37801C
37802      DATA INCASE(711)/'2KNT'/
37803      DATA (INAME(711,J),J=1,MAXSCL)/
37804     1'SUMM','    ','NORM','TOLE','K   ','FACT','    ','    '/
37805      DATA INFLAV(711)/3/
37806      DATA INLONG(711)/'NORMAL TOLERANCE K FACTOR'/
37807C
37808      DATA INCASE(712)/'COPV'/
37809      DATA (INAME(712,J),J=1,MAXSCL)/
37810     1'CORR','    ','P   ','VALU','    ','    ','    ','    '/
37811      DATA INFLAV(712)/2/
37812      DATA INLONG(712)/'CORRELATION P-VALUE'/
37813C
37814      DATA INCASE(713)/'GCIN'/
37815      DATA (INAME(713,J),J=1,MAXSCL)/
37816     1'SUMM','    ','GENE','CONF','INTE','    ','    ','    '/
37817      DATA INFLAV(713)/3/
37818      DATA INLONG(713)/'GENERALIZED CONFIDENCE INTERVAL'/
37819C
37820      DATA INCASE(714)/'GCIN'/
37821      DATA (INAME(714,J),J=1,MAXSCL)/
37822     1'SUMM','    ','GCI ','    ','    ','    ','    ','    '/
37823      DATA INFLAV(714)/3/
37824      DATA INLONG(714)/'GENERALIZED CONFIDENCE INTERVAL'/
37825C
37826      DATA INCASE(715)/'BOB '/
37827      DATA (INAME(715,J),J=1,MAXSCL)/
37828     1'SUMM','    ','BOB ','    ','    ','    ','    ','    '/
37829      DATA INFLAV(715)/3/
37830      DATA INLONG(715)/'BOB'/
37831C
37832      DATA INCASE(716)/'FMAT'/
37833      DATA (INAME(716,J),J=1,MAXSCL)/
37834     1'INDE','    ','FIRS','MATC','    ','    ','    ','    '/
37835      DATA INFLAV(716)/2/
37836      DATA INLONG(716)/'INDEX FIRST MATCH'/
37837C
37838      DATA INCASE(717)/'LMAT'/
37839      DATA (INAME(717,J),J=1,MAXSCL)/
37840     1'INDE','    ','LAST','MATC','    ','    ','    ','    '/
37841      DATA INFLAV(717)/2/
37842      DATA INLONG(717)/'INDEX LAST MATCH'/
37843C
37844      DATA INCASE(718)/'FNOM'/
37845      DATA (INAME(718,J),J=1,MAXSCL)/
37846     1'INDE','    ','FIRS','NOT ','MATC','    ','    ','    '/
37847      DATA INFLAV(718)/2/
37848      DATA INLONG(718)/'INDEX FIRST NOT MATCH'/
37849C
37850      DATA INCASE(719)/'FNOM'/
37851      DATA (INAME(719,J),J=1,MAXSCL)/
37852     1'INDE','    ','FIRS','NO  ','MATC','    ','    ','    '/
37853      DATA INFLAV(719)/2/
37854      DATA INLONG(719)/'INDEX FIRST NOT MATCH'/
37855C
37856      DATA INCASE(720)/'LNOM'/
37857      DATA (INAME(720,J),J=1,MAXSCL)/
37858     1'INDE','    ','LAST','NOT ','MATC','    ','    ','    '/
37859      DATA INFLAV(720)/2/
37860      DATA INLONG(720)/'INDEX LAST NOT MATCH'/
37861C
37862      DATA INCASE(721)/'LNOM'/
37863      DATA (INAME(721,J),J=1,MAXSCL)/
37864     1'INDE','    ','LAST','NO  ','MATC','    ','    ','    '/
37865      DATA INFLAV(721)/2/
37866      DATA INLONG(721)/'INDEX LAST NOT MATCH'/
37867C
37868      DATA INCASE(722)/'SHDI'/
37869      DATA (INAME(722,J),J=1,MAXSCL)/
37870     1'SHAN','    ','DIVE','INDE','    ','    ','    ','    '/
37871      DATA INFLAV(722)/1/
37872      DATA INLONG(722)/'SHANNON DIVERSITY INDEX'/
37873C
37874      DATA INCASE(723)/'SINR'/
37875      DATA (INAME(723,J),J=1,MAXSCL)/
37876     1'RAW ','    ','SHAN','DIVE','INDE','    ','    ','    '/
37877      DATA INFLAV(723)/1/
37878      DATA INLONG(723)/'SHANNON DIVERSITY INDEX'/
37879C
37880      DATA INCASE(724)/'SIDI'/
37881      DATA (INAME(724,J),J=1,MAXSCL)/
37882     1'SIMP','    ','DIVE','INDE','    ','    ','    ','    '/
37883      DATA INFLAV(724)/1/
37884      DATA INLONG(724)/'SIMPSON DIVERSITY INDEX'/
37885C
37886      DATA INCASE(725)/'SDIR'/
37887      DATA (INAME(725,J),J=1,MAXSCL)/
37888     1'RAW ','    ','SIMP','DIVE','INDE','    ','    ','    '/
37889      DATA INFLAV(725)/1/
37890      DATA INLONG(725)/'SIMPSON DIVERSITY INDEX'/
37891C
37892      DATA INCASE(726)/'SHEI'/
37893      DATA (INAME(726,J),J=1,MAXSCL)/
37894     1'SHAN','    ','EQUI','INDE','    ','    ','    ','    '/
37895      DATA INFLAV(726)/1/
37896      DATA INLONG(726)/'SHANNON EQUITABILITY INDEX'/
37897C
37898      DATA INCASE(727)/'SEIR'/
37899      DATA (INAME(727,J),J=1,MAXSCL)/
37900     1'RAW ','    ','SHAN','EQUI','INDE','    ','    ','    '/
37901      DATA INFLAV(727)/1/
37902      DATA INLONG(727)/'SHANNON EQUITABILITY INDEX'/
37903C
37904      DATA INCASE(728)/'SHEI'/
37905      DATA (INAME(728,J),J=1,MAXSCL)/
37906     1'SHAN','    ','EVEN','INDE','    ','    ','    ','    '/
37907      DATA INFLAV(728)/1/
37908      DATA INLONG(728)/'SHANNON EQUITABILITY INDEX'/
37909C
37910      DATA INCASE(729)/'SEIR'/
37911      DATA (INAME(729,J),J=1,MAXSCL)/
37912     1'RAW ','    ','SHAN','EVEN','INDE','    ','    ','    '/
37913      DATA INFLAV(729)/1/
37914      DATA INLONG(729)/'SHANNON EQUITABILITY INDEX'/
37915C
37916      DATA INCASE(730)/'JAPV'/
37917      DATA (INAME(730,J),J=1,MAXSCL)/
37918     1'JARQ','    ','BERA','TEST','PVAL','    ','    ','    '/
37919      DATA INFLAV(730)/1/
37920      DATA INLONG(730)/'JARQUE-BERA NORMALITY TEST P-VALUE'/
37921C
37922      DATA INCASE(731)/'JACD'/
37923      DATA (INAME(731,J),J=1,MAXSCL)/
37924     1'JARQ','    ','BERA','TEST','CDF ','    ','    ','    '/
37925      DATA INFLAV(731)/1/
37926      DATA INLONG(731)/'JARQUE-BERA NORMALITY TEST CDF'/
37927C
37928      DATA INCASE(732)/'JABE'/
37929      DATA (INAME(732,J),J=1,MAXSCL)/
37930     1'JARQ','    ','BERA','TEST','    ','    ','    ','    '/
37931      DATA INFLAV(732)/1/
37932      DATA INLONG(732)/'JARQUE-BERA NORMALITY TEST'/
37933C
37934      DATA INCASE(733)/'JAPV'/
37935      DATA (INAME(733,J),J=1,MAXSCL)/
37936     1'JARQ','    ','BERA','PVAL','    ','    ','    ','    '/
37937      DATA INFLAV(733)/1/
37938      DATA INLONG(733)/'JARQUE-BERA NORMALITY TEST P-VALUE'/
37939C
37940      DATA INCASE(734)/'JACD'/
37941      DATA (INAME(734,J),J=1,MAXSCL)/
37942     1'JARQ','    ','BERA','CDF ','    ','    ','    ','    '/
37943      DATA INFLAV(734)/1/
37944      DATA INLONG(734)/'JARQUE-BERA NORMALITY TEST CDF'/
37945C
37946      DATA INCASE(735)/'JABE'/
37947      DATA (INAME(735,J),J=1,MAXSCL)/
37948     1'JARQ','    ','BERA','    ','    ','    ','    ','    '/
37949      DATA INFLAV(735)/1/
37950      DATA INLONG(735)/'JARQUE-BERA NORMALITY TEST'/
37951C
37952      DATA INCASE(736)/'SSQ'/
37953      DATA (INAME(736,J),J=1,MAXSCL)/
37954     1'SUM ','    ','OF  ','SQUA','    ','    ','    ','    '/
37955      DATA INFLAV(736)/1/
37956      DATA INLONG(736)/'SUM OF SQUARES'/
37957C
37958      DATA INCASE(737)/'RSUM'/
37959      DATA (INAME(737,J),J=1,MAXSCL)/
37960     1'RESC','    ','SUM ','    ','    ','    ','    ','    '/
37961      DATA INFLAV(737)/1/
37962      DATA INLONG(737)/'RESCALED SUM'/
37963C
37964      DATA INCASE(738)/'RLP '/
37965      DATA (INAME(738,J),J=1,MAXSCL)/
37966     1'RELA','    ','LABO','PERF','    ','    ','    ','    '/
37967      DATA INFLAV(738)/2/
37968      DATA INLONG(738)/'RELATIVE LABORATORY PERFORMANCE'/
37969C
37970      DATA INCASE(739)/'RLP '/
37971      DATA (INAME(739,J),J=1,MAXSCL)/
37972     1'RLP ','    ','    ','    ','    ','    ','    ','    '/
37973      DATA INFLAV(739)/2/
37974      DATA INLONG(739)/'RELATIVE LABORATORY PERFORMANCE'/
37975C
37976      DATA INCASE(740)/'WSPV'/
37977      DATA (INAME(740,J),J=1,MAXSCL)/
37978     1'WILK','    ','SHAP','NORM','TEST','P   ','VALU','    '/
37979      DATA INFLAV(740)/1/
37980      DATA INLONG(740)/'WILK SHAPIRO NORMALITY TEST P-VALUE'/
37981C
37982      DATA INCASE(741)/'WSPV'/
37983      DATA (INAME(741,J),J=1,MAXSCL)/
37984     1'WILK','    ','SHAP','TEST','P   ','VALU','    ','    '/
37985      DATA INFLAV(741)/1/
37986      DATA INLONG(741)/'WILK SHAPIRO NORMALITY TEST P-VALUE'/
37987C
37988      DATA INCASE(742)/'WSHA'/
37989      DATA (INAME(742,J),J=1,MAXSCL)/
37990     1'WILK','    ','SHAP','    ','    ','    ','    ','    '/
37991      DATA INFLAV(742)/1/
37992      DATA INLONG(742)/'WILK SHAPIRO NORMALITY TEST'/
37993C
37994      DATA INCASE(743)/'PCAB'/
37995      DATA (INAME(743,J),J=1,MAXSCL)/
37996     1'PART','    ','CORR','ABSO','VALU','    ','    ','    '/
37997      DATA INFLAV(743)/3/
37998      DATA INLONG(743)/'PARTIAL CORRELATION ABSOLUTE VALUE'/
37999C
38000      DATA INCASE(744)/'PCPV'/
38001      DATA (INAME(744,J),J=1,MAXSCL)/
38002     1'PART','    ','CORR','PVAL','    ','    ','    ','    '/
38003      DATA INFLAV(744)/3/
38004      DATA INLONG(744)/'PARTIAL CORRELATION P-VALUE'/
38005C
38006      DATA INCASE(745)/'PCPV'/
38007      DATA (INAME(745,J),J=1,MAXSCL)/
38008     1'PART','    ','CORR','P   ','VALU','    ','    ','    '/
38009      DATA INFLAV(745)/3/
38010      DATA INLONG(745)/'PARTIAL CORRELATION P-VALUE'/
38011C
38012      DATA INCASE(746)/'PCCD'/
38013      DATA (INAME(746,J),J=1,MAXSCL)/
38014     1'PART','    ','CORR','CDF ','    ','    ','    ','    '/
38015      DATA INFLAV(746)/3/
38016      DATA INLONG(746)/'PARTIAL CORRELATION CDF'/
38017C
38018      DATA INCASE(747)/'RPCA'/
38019      DATA (INAME(747,J),J=1,MAXSCL)/
38020     1'PART','    ','RANK','CORR','ABSO','VALU','    ','    '/
38021      DATA INFLAV(747)/3/
38022      DATA INLONG(747)/'PARTIAL RANK CORRELATION ABSOLUTE VALUE'/
38023C
38024      DATA INCASE(748)/'RPCR'/
38025      DATA (INAME(748,J),J=1,MAXSCL)/
38026     1'PART','    ','RANK','CORR','    ','    ','    ','    '/
38027      DATA INFLAV(748)/3/
38028      DATA INLONG(748)/'PARTIAL RANK CORRELATION'/
38029C
38030      DATA INCASE(749)/'PKAB'/
38031      DATA (INAME(749,J),J=1,MAXSCL)/
38032     1'PART','    ','KEND','TAU ','CORR','ABSO','VALU','    '/
38033      DATA INFLAV(749)/3/
38034      DATA INLONG(749)/'PARTIAL KENDALL TAU CORRELATION ABSO VALUE'/
38035C
38036      DATA INCASE(750)/'PKTA'/
38037      DATA (INAME(750,J),J=1,MAXSCL)/
38038     1'PART','    ','KEND','TAU ','CORR','    ','    ','    '/
38039      DATA INFLAV(750)/3/
38040      DATA INLONG(750)/'PARTIAL KENDALL TAU CORRELATION'/
38041C
38042      DATA INCASE(751)/'PKTA'/
38043      DATA (INAME(751,J),J=1,MAXSCL)/
38044     1'PART','    ','KEND','TAU ','    ','    ','    ','    '/
38045      DATA INFLAV(751)/3/
38046      DATA INLONG(751)/'PARTIAL KENDALL TAU CORRELATION'/
38047C
38048      DATA INCASE(752)/'RACC'/
38049      DATA (INAME(752,J),J=1,MAXSCL)/
38050     1'RANK','    ','CORR','CDF ','    ','    ','    ','    '/
38051      DATA INFLAV(752)/2/
38052      DATA INLONG(752)/'RANK CORRELATION CDF'/
38053C
38054      DATA INCASE(753)/'TAUA'/
38055      DATA (INAME(753,J),J=1,MAXSCL)/
38056     1'KEND','    ','TAU ','CORR','ABSO','VALU','    ','    '/
38057      DATA INFLAV(753)/2/
38058      DATA INLONG(753)/'KENDALLS TAU ABSOLUTE VALUE'/
38059C
38060      DATA INCASE(754)/'KTCD'/
38061      DATA (INAME(754,J),J=1,MAXSCL)/
38062     1'KEND','    ','TAU ','CORR','CD  ','    ','    ','    '/
38063      DATA INFLAV(754)/2/
38064      DATA INLONG(754)/'KENDALLS TAU CDF'/
38065C
38066      DATA INCASE(755)/'COPV'/
38067      DATA (INAME(755,J),J=1,MAXSCL)/
38068     1'CORR','    ','PVAL','    ','    ','    ','    ','    '/
38069      DATA INFLAV(755)/2/
38070      DATA INLONG(755)/'CORRELATION P-VALUE'/
38071C
38072      DATA INCASE(756)/'COCD'/
38073      DATA (INAME(756,J),J=1,MAXSCL)/
38074     1'CORR','    ','CDF ','    ','    ','    ','    ','    '/
38075      DATA INFLAV(756)/2/
38076      DATA INLONG(756)/'CORRELATION CDF'/
38077C
38078      DATA INCASE(757)/'COLC'/
38079      DATA (INAME(757,J),J=1,MAXSCL)/
38080     1'CORR','    ','LOWE','CONF','LIMI','    ','    ','    '/
38081      DATA INFLAV(757)/2/
38082      DATA INLONG(757)/'CORRELATION LOWER CONFIDENCE LIMIT'/
38083C
38084      DATA INCASE(758)/'COLC'/
38085      DATA (INAME(758,J),J=1,MAXSCL)/
38086     1'CORR','    ','LOWE','CONF','INTE','    ','    ','    '/
38087      DATA INFLAV(758)/2/
38088      DATA INLONG(758)/'CORRELATION LOWER CONFIDENCE LIMIT'/
38089C
38090      DATA INCASE(759)/'COUC'/
38091      DATA (INAME(759,J),J=1,MAXSCL)/
38092     1'CORR','    ','UPPE','CONF','LIMI','    ','    ','    '/
38093      DATA INFLAV(759)/2/
38094      DATA INLONG(759)/'CORRELATION UPPER CONFIDENCE LIMIT'/
38095C
38096      DATA INCASE(760)/'COUC'/
38097      DATA (INAME(760,J),J=1,MAXSCL)/
38098     1'CORR','    ','UPPE','CONF','INTE','    ','    ','    '/
38099      DATA INFLAV(760)/2/
38100      DATA INLONG(760)/'CORRELATION UPPER CONFIDENCE LIMIT'/
38101C
38102      DATA INCASE(761)/'CRAT'/
38103      DATA (INAME(761,J),J=1,MAXSCL)/
38104     1'CORR','    ','RATI','    ','    ','    ','    ','    '/
38105      DATA INFLAV(761)/2/
38106      DATA INLONG(761)/'CORRELATION RATIO'/
38107C
38108      DATA INCASE(762)/'PCOR'/
38109      DATA (INAME(762,J),J=1,MAXSCL)/
38110     1'PART','    ','CORR','    ','    ','    ','    ','    '/
38111      DATA INFLAV(762)/3/
38112      DATA INLONG(762)/'PARTIAL CORRELATION'/
38113C
38114      DATA INCASE(763)/'KTCD'/
38115      DATA (INAME(763,J),J=1,MAXSCL)/
38116     1'KEND','    ','TAU ','CDF ','    ','    ','    ','    '/
38117      DATA INFLAV(763)/2/
38118      DATA INLONG(763)/'KENDALLS TAU CDF'/
38119C
38120      DATA INCASE(764)/'WSSD'/
38121      DATA (INAME(764,J),J=1,MAXSCL)/
38122     1'WEIG','    ','SUM ','OF  ','SQUA','DEVI','FROM','MEAN'/
38123      DATA INFLAV(764)/2/
38124      DATA INLONG(764)/'WEIGHTED SUM OF SQUARED DEVIATIONS FROM MEAN'/
38125C
38126      DATA INCASE(765)/'WSAB'/
38127      DATA (INAME(765,J),J=1,MAXSCL)/
38128     1'WEIG','    ','SUM ','OF  ','ABSO','VALU','    ','    '/
38129      DATA INFLAV(765)/2/
38130      DATA INLONG(765)/'WEIGHTED SUM OF ABSOLUTE VALUES'/
38131C
38132      DATA INCASE(766)/'WSDV'/
38133      DATA (INAME(766,J),J=1,MAXSCL)/
38134     1'WEIG','    ','SUM ','OF  ','DEVI','FROM','MEAN','    '/
38135      DATA INFLAV(766)/2/
38136      DATA INLONG(766)/'WEIGHTED SUM OF DEVIATIONS FROM THE MEAN'/
38137C
38138      DATA INCASE(767)/'WSDV'/
38139      DATA (INAME(767,J),J=1,MAXSCL)/
38140     1'WEIG','    ','SUM ','OF  ','DEVI','FROM','THE ','MEAN'/
38141      DATA INFLAV(767)/2/
38142      DATA INLONG(767)/'WEIGHTED SUM OF DEVIATIONS FROM THE MEAN'/
38143C
38144      DATA INCASE(768)/'WAAB'/
38145      DATA (INAME(768,J),J=1,MAXSCL)/
38146     1'WEIG','    ','AVER','ABSO','VALU','    ','    ','    '/
38147      DATA INFLAV(768)/2/
38148      DATA INLONG(768)/'WEIGHTED AVERAGE ABSOLUTE VALUES'/
38149C
38150      DATA INCASE(769)/'WSSQ'/
38151      DATA (INAME(769,J),J=1,MAXSCL)/
38152     1'WEIG','    ','SUM ','OF  ','SQUA','    ','    ','    '/
38153      DATA INFLAV(769)/2/
38154      DATA INLONG(769)/'WEIGHTED SUM OF SQUARES'/
38155C
38156      DATA INCASE(770)/'WSUM'/
38157      DATA (INAME(770,J),J=1,MAXSCL)/
38158     1'WEIG','    ','SUM ','    ','    ','    ','    ','    '/
38159      DATA INFLAV(770)/2/
38160      DATA INLONG(770)/'WEIGHTED SUM'/
38161C
38162      DATA INCASE(771)/'WAAB'/
38163      DATA (INAME(771,J),J=1,MAXSCL)/
38164     1'WEIG','    ','AVER','OF  ','ABSO','VALU','    ','    '/
38165      DATA INFLAV(771)/2/
38166      DATA INLONG(771)/'WEIGHTED AVERAGE ABSOLUTE VALUES'/
38167C
38168      DATA INCASE(772)/'DSSM'/
38169      DATA (INAME(772,J),J=1,MAXSCL)/
38170     1'DIFF','    ','OF  ','SUM ','OF  ','SQUA','FROM','MEAN'/
38171      DATA INFLAV(772)/2/
38172      DATA INLONG(772)/'DIFFERENCE OF SUM OF SQUARES'/
38173C
38174      DATA INCASE(773)/'DSSM'/
38175      DATA (INAME(773,J),J=1,MAXSCL)/
38176     1'DIFF','    ','OF  ','SUMS','OF  ','SQUA','FROM','MEAN'/
38177      DATA INFLAV(773)/2/
38178      DATA INLONG(773)/'DIFFERENCE OF SUM OF SQUARES'/
38179C
38180      DATA INCASE(774)/'SSQ '/
38181      DATA (INAME(774,J),J=1,MAXSCL)/
38182     1'SSQ ','    ','    ','    ','    ','    ','    ','    '/
38183      DATA INFLAV(774)/1/
38184      DATA INLONG(774)/'SUM OF SQUARES'/
38185C
38186      DATA INCASE(775)/'DSUM'/
38187      DATA (INAME(775,J),J=1,MAXSCL)/
38188     1'DIFF','    ','OF  ','SUM ','    ','    ','    ','    '/
38189      DATA INFLAV(775)/2/
38190      DATA INLONG(775)/'DIFFERENCE OF SUMS'/
38191C
38192      DATA INCASE(776)/'DSUM'/
38193      DATA (INAME(776,J),J=1,MAXSCL)/
38194     1'DIFF','    ','OF  ','SUMS','    ','    ','    ','    '/
38195      DATA INFLAV(776)/2/
38196      DATA INLONG(776)/'DIFFERENCE OF SUMS'/
38197C
38198      DATA INCASE(777)/'DRSC'/
38199      DATA (INAME(777,J),J=1,MAXSCL)/
38200     1'DIFF','    ','OF  ','RESC','SUM ','    ','    ','    '/
38201      DATA INFLAV(777)/2/
38202      DATA INLONG(777)/'DIFFERENCE OF RESCALED SUM'/
38203C
38204      DATA INCASE(778)/'QQRA'/
38205      DATA (INAME(778,J),J=1,MAXSCL)/
38206     1'Q   ','    ','QUAN','RANG','    ','    ','    ','    '/
38207      DATA INFLAV(778)/1/
38208      DATA INLONG(778)/'Q QUANTILE RANGE'/
38209C
38210      DATA INCASE(779)/'QQRA'/
38211      DATA (INAME(779,J),J=1,MAXSCL)/
38212     1'QQUA','    ','RANG','    ','    ','    ','    ','    '/
38213      DATA INFLAV(779)/1/
38214      DATA INLONG(779)/'Q QUANTILE RANGE'/
38215C
38216      DATA INCASE(780)/'WOSM'/
38217      DATA (INAME(780,J),J=1,MAXSCL)/
38218     1'WEIG','    ','ORDE','STAT','MEAN','    ','    ','    '/
38219      DATA INFLAV(780)/2/
38220      DATA INLONG(780)/'WEIGHTED ORDER STATISTICS MEAN'/
38221C
38222      DATA INCASE(781)/'LCL '/
38223      DATA (INAME(781,J),J=1,MAXSCL)/
38224     1'LOWE','    ','CONF','LIMI','    ','    ','    ','    '/
38225      DATA INFLAV(781)/1/
38226      DATA INLONG(781)/'LOWER CONFIDENCE LIMIT'/
38227C
38228      DATA INCASE(782)/'LCL '/
38229      DATA (INAME(782,J),J=1,MAXSCL)/
38230     1'LOWE','    ','CONF','INTE','    ','    ','    ','    '/
38231      DATA INFLAV(782)/1/
38232      DATA INLONG(782)/'LOWER CONFIDENCE LIMIT'/
38233C
38234      DATA INCASE(783)/'UCL '/
38235      DATA (INAME(783,J),J=1,MAXSCL)/
38236     1'UPPE','    ','CONF','LIMI','    ','    ','    ','    '/
38237      DATA INFLAV(783)/1/
38238      DATA INLONG(783)/'UPPER CONFIDENCE LIMIT'/
38239C
38240      DATA INCASE(784)/'UCL '/
38241      DATA (INAME(784,J),J=1,MAXSCL)/
38242     1'UPPE','    ','CONF','INTE','    ','    ','    ','    '/
38243      DATA INFLAV(784)/1/
38244      DATA INLONG(784)/'UPPER CONFIDENCE LIMIT'/
38245C
38246      DATA INCASE(785)/'1LCL'/
38247      DATA (INAME(785,J),J=1,MAXSCL)/
38248     1'ONE ','    ','SIDE','LOWE','CONF','INTE','    ','    '/
38249      DATA INFLAV(785)/1/
38250      DATA INLONG(785)/'ONE-SIDED LOWER CONFIDENCE LIMIT'/
38251C
38252      DATA INCASE(786)/'1LCL'/
38253      DATA (INAME(786,J),J=1,MAXSCL)/
38254     1'ONE ','    ','SIDE','LOWE','CONF','LIMI','    ','    '/
38255      DATA INFLAV(786)/1/
38256      DATA INLONG(786)/'ONE-SIDED LOWER CONFIDENCE LIMIT'/
38257C
38258      DATA INCASE(787)/'1UCL'/
38259      DATA (INAME(787,J),J=1,MAXSCL)/
38260     1'ONE ','    ','SIDE','UPPE','CONF','INTE','    ','    '/
38261      DATA INFLAV(787)/1/
38262      DATA INLONG(787)/'ONE-SIDED UPPER CONFIDENCE LIMIT'/
38263C
38264      DATA INCASE(788)/'1UCL'/
38265      DATA (INAME(788,J),J=1,MAXSCL)/
38266     1'ONE ','    ','SIDE','UPPE','CONF','LIMI','    ','    '/
38267      DATA INFLAV(788)/1/
38268      DATA INLONG(788)/'ONE-SIDED UPPER CONFIDENCE LIMIT'/
38269C
38270      DATA INCASE(789)/'LPL '/
38271      DATA (INAME(789,J),J=1,MAXSCL)/
38272     1'LOWE','    ','PRED','LIMI','    ','    ','    ','    '/
38273      DATA INFLAV(789)/1/
38274      DATA INLONG(789)/'LOWER PREDICTION LIMIT'/
38275C
38276      DATA INCASE(790)/'LPL '/
38277      DATA (INAME(790,J),J=1,MAXSCL)/
38278     1'LOWE','    ','PRED','INTE','    ','    ','    ','    '/
38279      DATA INFLAV(790)/1/
38280      DATA INLONG(790)/'LOWER PREDICTION LIMIT'/
38281C
38282      DATA INCASE(791)/'UPL '/
38283      DATA (INAME(791,J),J=1,MAXSCL)/
38284     1'UPPE','    ','PRED','LIMI','    ','    ','    ','    '/
38285      DATA INFLAV(791)/1/
38286      DATA INLONG(791)/'UPPER PREDICTION LIMIT'/
38287C
38288      DATA INCASE(792)/'UPL '/
38289      DATA (INAME(792,J),J=1,MAXSCL)/
38290     1'UPPE','    ','PRED','INTE','    ','    ','    ','    '/
38291      DATA INFLAV(792)/1/
38292      DATA INLONG(792)/'UPPER PREDICTION LIMIT'/
38293C
38294      DATA INCASE(793)/'1LPL'/
38295      DATA (INAME(793,J),J=1,MAXSCL)/
38296     1'ONE ','    ','SIDE','LOWE','PRED','INTE','    ','    '/
38297      DATA INFLAV(793)/1/
38298      DATA INLONG(793)/'ONE-SIDED LOWER PREDICTION LIMIT'/
38299C
38300      DATA INCASE(794)/'1LPL'/
38301      DATA (INAME(794,J),J=1,MAXSCL)/
38302     1'ONE ','    ','SIDE','LOWE','PRED','LIMI','    ','    '/
38303      DATA INFLAV(794)/1/
38304      DATA INLONG(794)/'ONE-SIDED LOWER PREDICTION LIMIT'/
38305C
38306      DATA INCASE(795)/'1UPL'/
38307      DATA (INAME(795,J),J=1,MAXSCL)/
38308     1'ONE ','    ','SIDE','UPPE','PRED','INTE','    ','    '/
38309      DATA INFLAV(795)/1/
38310      DATA INLONG(795)/'ONE-SIDED UPPER PREDICTION LIMIT'/
38311C
38312      DATA INCASE(796)/'1UPL'/
38313      DATA (INAME(796,J),J=1,MAXSCL)/
38314     1'ONE ','    ','SIDE','UPPE','PRED','LIMI','    ','    '/
38315      DATA INFLAV(796)/1/
38316      DATA INLONG(796)/'ONE-SIDED UPPER PREDICTION LIMIT'/
38317C
38318      DATA INCASE(797)/'WESH'/
38319      DATA (INAME(797,J),J=1,MAXSCL)/
38320     1'WEIB','    ','PPCC','SHAP','    ','    ','    ','    '/
38321      DATA INFLAV(797)/1/
38322      DATA INLONG(797)/'WEIBULL SHAPE'/
38323C
38324      DATA INCASE(798)/'TLSH'/
38325      DATA (INAME(798,J),J=1,MAXSCL)/
38326     1'TUKE','    ','LAMB','PPCC','SHAP','    ','    ','    '/
38327      DATA INFLAV(798)/1/
38328      DATA INLONG(798)/'TUKEY-LAMBDA SHAPE'/
38329C
38330      DATA INCASE(799)/'MSDN'/
38331      DATA (INAME(799,J),J=1,MAXSCL)/
38332     1'MEAN','    ','SUCC','DIFF','NORM','    ','    ','    '/
38333      DATA INFLAV(799)/1/
38334      DATA INLONG(799)/'MEAN SUCCESSIVE DIFFERENCES NORMALIZED'/
38335C
38336      DATA INCASE(800)/'MSDC'/
38337      DATA (INAME(800,J),J=1,MAXSCL)/
38338     1'MEAN','    ','SUCC','DIFF','TEST','CDF ','    ','    '/
38339      DATA INFLAV(800)/1/
38340      DATA INLONG(800)/'MEAN SUCCESSIVE DIFFERENCES CDF'/
38341C
38342      DATA INCASE(801)/'WELO'/
38343      DATA (INAME(801,J),J=1,MAXSCL)/
38344     1'WEIB','    ','PPCC','LOCA','    ','    ','    ','    '/
38345      DATA INFLAV(801)/1/
38346      DATA INLONG(801)/'WEIBULL LOCATION'/
38347C
38348      DATA INCASE(802)/'WESC'/
38349      DATA (INAME(802,J),J=1,MAXSCL)/
38350     1'WEIB','    ','PPCC','SCAL','    ','    ','    ','    '/
38351      DATA INFLAV(802)/1/
38352      DATA INLONG(802)/'WEIBULL SCALE'/
38353C
38354      DATA INCASE(803)/'TLLO'/
38355      DATA (INAME(803,J),J=1,MAXSCL)/
38356     1'TUKE','    ','LAMB','PPCC','LOCA','    ','    ','    '/
38357      DATA INFLAV(803)/1/
38358      DATA INLONG(803)/'TUKEY-LAMBDA LOCATION'/
38359C
38360      DATA INCASE(804)/'TLSC'/
38361      DATA (INAME(804,J),J=1,MAXSCL)/
38362     1'TUKE','    ','LAMB','PPCC','SCAL','    ','    ','    '/
38363      DATA INFLAV(804)/1/
38364      DATA INLONG(804)/'TUKEY-LAMBDA SCALE'/
38365C
38366      DATA INCASE(805)/'NOSC'/
38367      DATA (INAME(805,J),J=1,MAXSCL)/
38368     1'NORM','    ','PPCC','SCAL','    ','    ','    ','    '/
38369      DATA INFLAV(805)/1/
38370      DATA INLONG(805)/'NORMAL PPCC SCALE'/
38371C
38372      DATA INCASE(806)/'NOPP'/
38373      DATA (INAME(806,J),J=1,MAXSCL)/
38374     1'NORM','    ','PPCC','    ','    ','    ','    ','    '/
38375      DATA INFLAV(806)/1/
38376      DATA INLONG(806)/'NORMAL PPCC'/
38377C
38378      DATA INCASE(807)/'UNSC'/
38379      DATA (INAME(807,J),J=1,MAXSCL)/
38380     1'UNIF','    ','PPCC','SCAL','    ','    ','    ','    '/
38381      DATA INFLAV(807)/1/
38382      DATA INLONG(807)/'UNIFORM PPCC SCALE'/
38383C
38384      DATA INCASE(808)/'UNPP'/
38385      DATA (INAME(808,J),J=1,MAXSCL)/
38386     1'UNIF','    ','PPCC','    ','    ','    ','    ','    '/
38387      DATA INFLAV(808)/1/
38388      DATA INLONG(808)/'UNIFORM PPCC'/
38389C
38390      DATA INCASE(809)/'CASC'/
38391      DATA (INAME(809,J),J=1,MAXSCL)/
38392     1'CAUC','    ','PPCC','SCAL','    ','    ','    ','    '/
38393      DATA INFLAV(809)/1/
38394      DATA INLONG(809)/'CAUCHY PPCC SCALE'/
38395C
38396      DATA INCASE(810)/'LOSC'/
38397      DATA (INAME(810,J),J=1,MAXSCL)/
38398     1'LOGI','    ','PPCC','SCAL','    ','    ','    ','    '/
38399      DATA INFLAV(810)/1/
38400      DATA INLONG(810)/'LOGISTIC PPCC SCALE'/
38401C
38402      DATA INCASE(811)/'DESC'/
38403      DATA (INAME(811,J),J=1,MAXSCL)/
38404     1'DOUB','    ','EXPO','PPCC','SCAL','    ','    ','    '/
38405      DATA INFLAV(811)/1/
38406      DATA INLONG(811)/'DOUBLE EXPONENTIAL PPCC SCALE'/
38407C
38408      DATA INCASE(812)/'HSSC'/
38409      DATA (INAME(812,J),J=1,MAXSCL)/
38410     1'HYPE','    ','SECA','PPCC','SCAL','    ','    ','    '/
38411      DATA INFLAV(812)/1/
38412      DATA INLONG(812)/'HYPERBOLIC SECANT PPCC SCALE'/
38413C
38414      DATA INCASE(813)/'HNSC'/
38415      DATA (INAME(813,J),J=1,MAXSCL)/
38416     1'HALF','    ','NORM','PPCC','SCAL','    ','    ','    '/
38417      DATA INFLAV(813)/1/
38418      DATA INLONG(813)/'HALF-NORMAL PPCC SCALE'/
38419C
38420      DATA INCASE(814)/'COSC'/
38421      DATA (INAME(814,J),J=1,MAXSCL)/
38422     1'COSI','    ','PPCC','SCAL','    ','    ','    ','    '/
38423      DATA INFLAV(814)/1/
38424      DATA INLONG(814)/'COSINE PPCC SCALE'/
38425C
38426      DATA INCASE(815)/'ANSC'/
38427      DATA (INAME(815,J),J=1,MAXSCL)/
38428     1'ANGL','    ','PPCC','SCAL','    ','    ','    ','    '/
38429      DATA INFLAV(815)/1/
38430      DATA INLONG(815)/'ANGLIT PPCC SCALE'/
38431C
38432      DATA INCASE(816)/'ARSC'/
38433      DATA (INAME(816,J),J=1,MAXSCL)/
38434     1'ARCS','    ','PPCC','SCAL','    ','    ','    ','    '/
38435      DATA INFLAV(816)/1/
38436      DATA INLONG(816)/'ARCSINE PPCC SCALE'/
38437C
38438      DATA INCASE(817)/'EXSC'/
38439      DATA (INAME(817,J),J=1,MAXSCL)/
38440     1'EXPO','    ','PPCC','SCAL','    ','    ','    ','    '/
38441      DATA INFLAV(817)/1/
38442      DATA INLONG(817)/'EXPONENTIAL PPCC SCALE'/
38443C
38444      DATA INCASE(819)/'SLSC'/
38445      DATA (INAME(819,J),J=1,MAXSCL)/
38446     1'SLAS','    ','PPCC','SCAL','    ','    ','    ','    '/
38447      DATA INFLAV(819)/1/
38448      DATA INLONG(819)/'SLASH PPCC SCALE'/
38449C
38450      DATA INCASE(820)/'RASC'/
38451      DATA (INAME(820,J),J=1,MAXSCL)/
38452     1'RAYL','    ','PPCC','SCAL','    ','    ','    ','    '/
38453      DATA INFLAV(820)/1/
38454      DATA INLONG(820)/'RAYLEIGH PPCC SCALE'/
38455C
38456      DATA INCASE(821)/'MXSC'/
38457      DATA (INAME(821,J),J=1,MAXSCL)/
38458     1'MAXW','    ','PPCC','SCAL','    ','    ','    ','    '/
38459      DATA INFLAV(821)/1/
38460      DATA INLONG(821)/'MAXWELL PPCC SCALE'/
38461C
38462      DATA INCASE(822)/'DESC'/
38463      DATA (INAME(822,J),J=1,MAXSCL)/
38464     1'LAPL','    ','PPCC','SCAL','    ','    ','    ','    '/
38465      DATA INFLAV(822)/1/
38466      DATA INLONG(822)/'DOUBLE EXPONENTIAL PPCC SCALE'/
38467C
38468      DATA INCASE(823)/'HCSC'/
38469      DATA (INAME(823,J),J=1,MAXSCL)/
38470     1'HALF','    ','CAUC','PPCC','SCAL','    ','    ','    '/
38471      DATA INFLAV(823)/1/
38472      DATA INLONG(823)/'HALF-CAUCHY PPCC SCALE'/
38473C
38474      DATA INCASE(824)/'SCSC'/
38475      DATA (INAME(824,J),J=1,MAXSCL)/
38476     1'SEMI','    ','CIRC','PPCC','SCAL','    ','    ','    '/
38477      DATA INFLAV(824)/1/
38478      DATA INLONG(824)/'SEMI-CIRCULAR PPCC SCALE'/
38479C
38480      DATA INCASE(825)/'CAPP'/
38481      DATA (INAME(825,J),J=1,MAXSCL)/
38482     1'CAUC','    ','PPCC','    ','    ','    ','    ','    '/
38483      DATA INFLAV(825)/1/
38484      DATA INLONG(825)/'CAUCHY PPCC'/
38485C
38486      DATA INCASE(826)/'LOPP'/
38487      DATA (INAME(826,J),J=1,MAXSCL)/
38488     1'LOGI','    ','PPCC','    ','    ','    ','    ','    '/
38489      DATA INFLAV(826)/1/
38490      DATA INLONG(826)/'LOGISTIC PPCC'/
38491C
38492      DATA INCASE(827)/'DEPP'/
38493      DATA (INAME(827,J),J=1,MAXSCL)/
38494     1'DOUB','    ','EXPO','PPCC','    ','    ','    ','    '/
38495      DATA INFLAV(827)/1/
38496      DATA INLONG(827)/'DOUBLE EXPONENTIAL PPCC'/
38497C
38498      DATA INCASE(828)/'HSPP'/
38499      DATA (INAME(828,J),J=1,MAXSCL)/
38500     1'HYPE','    ','SECA','PPCC','    ','    ','    ','    '/
38501      DATA INFLAV(828)/1/
38502      DATA INLONG(828)/'HYPERBOLIC SECANT PPCC'/
38503C
38504      DATA INCASE(829)/'HNPP'/
38505      DATA (INAME(829,J),J=1,MAXSCL)/
38506     1'HALF','    ','NORM','PPCC','    ','    ','    ','    '/
38507      DATA INFLAV(829)/1/
38508      DATA INLONG(829)/'HALF-NORMAL PPCC'/
38509C
38510      DATA INCASE(830)/'COPP'/
38511      DATA (INAME(830,J),J=1,MAXSCL)/
38512     1'COSI','    ','PPCC','    ','    ','    ','    ','    '/
38513      DATA INFLAV(830)/1/
38514      DATA INLONG(830)/'COSINE PPCC'/
38515C
38516      DATA INCASE(831)/'ANPP'/
38517      DATA (INAME(831,J),J=1,MAXSCL)/
38518     1'ANGL','    ','PPCC','    ','    ','    ','    ','    '/
38519      DATA INFLAV(831)/1/
38520      DATA INLONG(831)/'ANGLIT PPCC'/
38521C
38522      DATA INCASE(832)/'ARPP'/
38523      DATA (INAME(832,J),J=1,MAXSCL)/
38524     1'ARCS','    ','PPCC','    ','    ','    ','    ','    '/
38525      DATA INFLAV(832)/1/
38526      DATA INLONG(832)/'ARCSINE PPCC'/
38527C
38528      DATA INCASE(833)/'EXPP'/
38529      DATA (INAME(833,J),J=1,MAXSCL)/
38530     1'EXPO','    ','PPCC','    ','    ','    ','    ','    '/
38531      DATA INFLAV(833)/1/
38532      DATA INLONG(833)/'EXPONENTIAL PPCC'/
38533C
38534      DATA INCASE(834)/'SLPP'/
38535      DATA (INAME(834,J),J=1,MAXSCL)/
38536     1'SLAS','    ','PPCC','    ','    ','    ','    ','    '/
38537      DATA INFLAV(834)/1/
38538      DATA INLONG(834)/'SLASH PPCC'/
38539C
38540      DATA INCASE(835)/'RAPP'/
38541      DATA (INAME(835,J),J=1,MAXSCL)/
38542     1'RAYL','    ','PPCC','    ','    ','    ','    ','    '/
38543      DATA INFLAV(835)/1/
38544      DATA INLONG(835)/'RAYLEIGH PPCC'/
38545C
38546      DATA INCASE(836)/'MXPP'/
38547      DATA (INAME(836,J),J=1,MAXSCL)/
38548     1'MAXW','    ','PPCC','    ','    ','    ','    ','    '/
38549      DATA INFLAV(836)/1/
38550      DATA INLONG(836)/'MAXWELL PPCC'/
38551C
38552      DATA INCASE(837)/'DEPP'/
38553      DATA (INAME(837,J),J=1,MAXSCL)/
38554     1'LAPL','    ','PPCC','    ','    ','    ','    ','    '/
38555      DATA INFLAV(837)/1/
38556      DATA INLONG(837)/'DOUBLE EXPONENTIAL PPCC'/
38557C
38558      DATA INCASE(838)/'HCPP'/
38559      DATA (INAME(838,J),J=1,MAXSCL)/
38560     1'HALF','    ','CAUC','PPCC','    ','    ','    ','    '/
38561      DATA INFLAV(838)/1/
38562      DATA INLONG(838)/'HALF-CAUCHY PPCC'/
38563C
38564      DATA INCASE(839)/'SCPP'/
38565      DATA (INAME(839,J),J=1,MAXSCL)/
38566     1'SEMI','    ','CIRC','PPCC','    ','    ','    ','    '/
38567      DATA INFLAV(839)/1/
38568      DATA INLONG(839)/'SEMI-CIRCULAR PPCC'/
38569C
38570      DATA INCASE(840)/'G1PP'/
38571      DATA (INAME(840,J),J=1,MAXSCL)/
38572     1'MINI','    ','GUMB','PPCC','    ','    ','    ','    '/
38573      DATA INFLAV(840)/1/
38574      DATA INLONG(840)/'MINIMUM GUMBEL PPCC'/
38575C
38576      DATA INCASE(841)/'G2PP'/
38577      DATA (INAME(841,J),J=1,MAXSCL)/
38578     1'MAXI','    ','GUMB','PPCC','    ','    ','    ','    '/
38579      DATA INFLAV(841)/1/
38580      DATA INLONG(841)/'MAXIMUM GUMBEL PPCC'/
38581C
38582      DATA INCASE(842)/'MINI'/
38583      DATA (INAME(842,J),J=1,MAXSCL)/
38584     1'MINI','    ','    ','    ','    ','    ','    ','    '/
38585      DATA INFLAV(842)/1/
38586      DATA INLONG(842)/'MINIMUM'/
38587C
38588      DATA INCASE(843)/'LNLO'/
38589      DATA (INAME(843,J),J=1,MAXSCL)/
38590     1'LOG ','    ','NORM','PPCC','LOCA','    ','    ','    '/
38591      DATA INFLAV(843)/1/
38592      DATA INLONG(843)/'LOGNORMAL PPCC LOCATION'/
38593C
38594      DATA INCASE(844)/'LNSC'/
38595      DATA (INAME(844,J),J=1,MAXSCL)/
38596     1'LOG ','    ','NORM','PPCC','SCAL','    ','    ','    '/
38597      DATA INFLAV(844)/1/
38598      DATA INLONG(844)/'LOGNORMAL PPCC SCALE'/
38599C
38600      DATA INCASE(845)/'LNSH'/
38601      DATA (INAME(845,J),J=1,MAXSCL)/
38602     1'LOG ','    ','NORM','PPCC','SHAP','    ','    ','    '/
38603      DATA INFLAV(845)/1/
38604      DATA INLONG(845)/'LOGNORMAL PPCC SHAPE'/
38605C
38606      DATA INCASE(846)/'LNPP'/
38607      DATA (INAME(846,J),J=1,MAXSCL)/
38608     1'LOG ','    ','NORM','PPCC','STAT','    ','    ','    '/
38609      DATA INFLAV(846)/1/
38610      DATA INLONG(846)/'LOGNORMAL PPCC STATISTIC'/
38611C
38612      DATA INCASE(847)/'GPLO'/
38613      DATA (INAME(847,J),J=1,MAXSCL)/
38614     1'GENE','    ','PARE','PPCC','LOCA','    ','    ','    '/
38615      DATA INFLAV(847)/1/
38616      DATA INLONG(847)/'GENERALIZED PARETO PPCC LOCATION'/
38617C
38618      DATA INCASE(848)/'GPSC'/
38619      DATA (INAME(848,J),J=1,MAXSCL)/
38620     1'GENE','    ','PARE','PPCC','SCAL','    ','    ','    '/
38621      DATA INFLAV(848)/1/
38622      DATA INLONG(848)/'GENERALIZED PARETO PPCC SCALE'/
38623C
38624      DATA INCASE(849)/'GPSH'/
38625      DATA (INAME(849,J),J=1,MAXSCL)/
38626     1'GENE','    ','PARE','PPCC','SHAP','    ','    ','    '/
38627      DATA INFLAV(849)/1/
38628      DATA INLONG(849)/'GENERALIZED PARETO PPCC SHAPE'/
38629C
38630      DATA INCASE(850)/'GPPP'/
38631      DATA (INAME(850,J),J=1,MAXSCL)/
38632     1'GENE','    ','PARE','PPCC','STAT','    ','    ','    '/
38633      DATA INFLAV(850)/1/
38634      DATA INLONG(850)/'GENERALIZED PARETO PPCC STATISTIC'/
38635C
38636      DATA INCASE(851)/'GHLO'/
38637      DATA (INAME(851,J),J=1,MAXSCL)/
38638     1'G   ','    ','H   ','PPCC','LOCA','    ','    ','    '/
38639      DATA INFLAV(851)/1/
38640      DATA INLONG(851)/'G-AND-H PPCC LOCATION'/
38641C
38642      DATA INCASE(852)/'GHSC'/
38643      DATA (INAME(852,J),J=1,MAXSCL)/
38644     1'G   ','    ','H   ','PPCC','SCAL','    ','    ','    '/
38645      DATA INFLAV(852)/1/
38646      DATA INLONG(852)/'G-AND-H PPCC SCALE'/
38647C
38648      DATA INCASE(853)/'GHSH'/
38649      DATA (INAME(853,J),J=1,MAXSCL)/
38650     1'G   ','    ','H   ','PPCC','SHAP','ONE ','    ','    '/
38651      DATA INFLAV(853)/1/
38652      DATA INLONG(853)/'G-AND-H PPCC SHAPE ONE (G)'/
38653C
38654      DATA INCASE(854)/'GHS2'/
38655      DATA (INAME(854,J),J=1,MAXSCL)/
38656     1'G   ','    ','H   ','PPCC','SHAP','TWO ','    ','    '/
38657      DATA INFLAV(854)/1/
38658      DATA INLONG(854)/'G-AND-H PPCC SHAPE TWO (H)'/
38659C
38660      DATA INCASE(855)/'GHSH'/
38661      DATA (INAME(855,J),J=1,MAXSCL)/
38662     1'G   ','    ','H   ','PPCC','G   ','    ','    ','    '/
38663      DATA INFLAV(855)/1/
38664      DATA INLONG(855)/'G-AND-H PPCC SHAPE ONE (G)'/
38665C
38666      DATA INCASE(856)/'GHS2'/
38667      DATA (INAME(856,J),J=1,MAXSCL)/
38668     1'G   ','    ','H   ','PPCC','H   ','    ','    ','    '/
38669      DATA INFLAV(856)/1/
38670      DATA INLONG(856)/'G-AND-H PPCC SHAPE TWO (H)'/
38671C
38672      DATA INCASE(857)/'GHSH'/
38673      DATA (INAME(857,J),J=1,MAXSCL)/
38674     1'G   ','    ','H   ','PPCC','SHAP','    ','    ','    '/
38675      DATA INFLAV(857)/1/
38676      DATA INLONG(857)/'G-AND-H PPCC SHAPE ONE (G)'/
38677C
38678      DATA INCASE(858)/'GHPP'/
38679      DATA (INAME(858,J),J=1,MAXSCL)/
38680     1'G   ','    ','H   ','PPCC','STAT','    ','    ','    '/
38681      DATA INFLAV(858)/1/
38682      DATA INLONG(858)/'G-AND-H PPCC'/
38683C
38684      DATA INCASE(859)/'GHLO'/
38685      DATA (INAME(859,J),J=1,MAXSCL)/
38686     1'G   ','    ','AND ','H   ','PPCC','LOCA','    ','    '/
38687      DATA INFLAV(859)/1/
38688      DATA INLONG(859)/'G-AND-H PPCC LOCATION'/
38689C
38690      DATA INCASE(860)/'GHSC'/
38691      DATA (INAME(860,J),J=1,MAXSCL)/
38692     1'G   ','    ','AND ','H   ','PPCC','SCAL','    ','    '/
38693      DATA INFLAV(860)/1/
38694      DATA INLONG(860)/'G-AND-H PPCC SCALE'/
38695C
38696      DATA INCASE(861)/'GHSH'/
38697      DATA (INAME(861,J),J=1,MAXSCL)/
38698     1'G   ','    ','AND ','H   ','PPCC','SHAP','ONE ','    '/
38699      DATA INFLAV(861)/1/
38700      DATA INLONG(861)/'G-AND-H PPCC SHAPE ONE (G)'/
38701C
38702      DATA INCASE(862)/'GHS2'/
38703      DATA (INAME(862,J),J=1,MAXSCL)/
38704     1'G   ','    ','AND ','H   ','PPCC','SHAP','TWO ','    '/
38705      DATA INFLAV(862)/1/
38706      DATA INLONG(862)/'G-AND-H PPCC SHAPE TWO (H)'/
38707C
38708      DATA INCASE(863)/'GHSH'/
38709      DATA (INAME(863,J),J=1,MAXSCL)/
38710     1'G   ','    ','AND ','H   ','PPCC','G   ','    ','    '/
38711      DATA INFLAV(863)/1/
38712      DATA INLONG(863)/'G-AND-H PPCC SHAPE ONE (G)'/
38713C
38714      DATA INCASE(864)/'GHS2'/
38715      DATA (INAME(864,J),J=1,MAXSCL)/
38716     1'G   ','    ','AND ','H   ','PPCC','H   ','    ','    '/
38717      DATA INFLAV(864)/1/
38718      DATA INLONG(864)/'G-AND-H PPCC SHAPE TWO (H)'/
38719C
38720      DATA INCASE(865)/'GHSH'/
38721      DATA (INAME(865,J),J=1,MAXSCL)/
38722     1'G   ','    ','AND ','H   ','PPCC','SHAP','    ','    '/
38723      DATA INFLAV(865)/1/
38724      DATA INLONG(865)/'G-AND-H PPCC SHAPE ONE (G)'/
38725C
38726      DATA INCASE(866)/'GHPP'/
38727      DATA (INAME(866,J),J=1,MAXSCL)/
38728     1'G   ','    ','AND ','H   ','PPCC','STAT','    ','    '/
38729      DATA INFLAV(866)/1/
38730      DATA INLONG(866)/'G-AND-H PPCC'/
38731C
38732      DATA INCASE(867)/'LNLO'/
38733      DATA (INAME(867,J),J=1,MAXSCL)/
38734     1'LOGN','    ','PPCC','LOCA','    ','    ','    ','    '/
38735      DATA INFLAV(867)/1/
38736      DATA INLONG(867)/'LOGNORMAL PPCC LOCATION'/
38737C
38738      DATA INCASE(868)/'LNSC'/
38739      DATA (INAME(868,J),J=1,MAXSCL)/
38740     1'LOGN','    ','PPCC','SCAL','    ','    ','    ','    '/
38741      DATA INFLAV(868)/1/
38742      DATA INLONG(868)/'LOGNORMAL PPCC SCALE'/
38743C
38744      DATA INCASE(869)/'LNSH'/
38745      DATA (INAME(869,J),J=1,MAXSCL)/
38746     1'LOGN','    ','PPCC','SHAP','    ','    ','    ','    '/
38747      DATA INFLAV(869)/1/
38748      DATA INLONG(869)/'LOGNORMAL PPCC SHAPE'/
38749C
38750      DATA INCASE(870)/'LNPP'/
38751      DATA (INAME(870,J),J=1,MAXSCL)/
38752     1'LOGN','    ','PPCC','STAT','    ','    ','    ','    '/
38753      DATA INFLAV(870)/1/
38754      DATA INLONG(870)/'LOGNORMAL PPCC STATISTIC'/
38755C
38756      DATA INCASE(871)/'WALO'/
38757      DATA (INAME(871,J),J=1,MAXSCL)/
38758     1'WALD','    ','PPCC','LOCA','    ','    ','    ','    '/
38759      DATA INFLAV(871)/1/
38760      DATA INLONG(871)/'WALD PPCC LOCATION'/
38761C
38762      DATA INCASE(872)/'WASC'/
38763      DATA (INAME(872,J),J=1,MAXSCL)/
38764     1'WALD','    ','PPCC','SCAL','    ','    ','    ','    '/
38765      DATA INFLAV(872)/1/
38766      DATA INLONG(872)/'WALD PPCC SCALE'/
38767C
38768      DATA INCASE(873)/'WASH'/
38769      DATA (INAME(873,J),J=1,MAXSCL)/
38770     1'WALD','    ','PPCC','SHAP','    ','    ','    ','    '/
38771      DATA INFLAV(873)/1/
38772      DATA INLONG(873)/'WALD PPCC SHAPE'/
38773C
38774      DATA INCASE(874)/'WAPP'/
38775      DATA (INAME(874,J),J=1,MAXSCL)/
38776     1'WALD','    ','PPCC','STAT','    ','    ','    ','    '/
38777      DATA INFLAV(874)/1/
38778      DATA INLONG(874)/'WALD PPCC STATISTIC'/
38779C
38780      DATA INCASE(875)/'GALO'/
38781      DATA (INAME(875,J),J=1,MAXSCL)/
38782     1'GAMM','    ','PPCC','LOCA','    ','    ','    ','    '/
38783      DATA INFLAV(875)/1/
38784      DATA INLONG(875)/'GAMMA PPCC LOCATION'/
38785C
38786      DATA INCASE(876)/'GASC'/
38787      DATA (INAME(876,J),J=1,MAXSCL)/
38788     1'GAMM','    ','PPCC','SCAL','    ','    ','    ','    '/
38789      DATA INFLAV(876)/1/
38790      DATA INLONG(876)/'GAMMA PPCC SCALE'/
38791C
38792      DATA INCASE(877)/'GASH'/
38793      DATA (INAME(877,J),J=1,MAXSCL)/
38794     1'GAMM','    ','PPCC','SHAP','    ','    ','    ','    '/
38795      DATA INFLAV(877)/1/
38796      DATA INLONG(877)/'GAMMA PPCC SHAPE'/
38797C
38798      DATA INCASE(878)/'GAPP'/
38799      DATA (INAME(878,J),J=1,MAXSCL)/
38800     1'GAMM','    ','PPCC','STAT','    ','    ','    ','    '/
38801      DATA INFLAV(878)/1/
38802      DATA INLONG(878)/'GAMMA PPCC STATISTIC'/
38803C
38804      DATA INCASE(879)/'FLLO'/
38805      DATA (INAME(879,J),J=1,MAXSCL)/
38806     1'FATI','    ','LIFE','PPCC','LOCA','    ','    ','    '/
38807      DATA INFLAV(879)/1/
38808      DATA INLONG(879)/'FATIGUE LIFE PPCC LOCATION'/
38809C
38810      DATA INCASE(880)/'FLSC'/
38811      DATA (INAME(880,J),J=1,MAXSCL)/
38812     1'FATI','    ','LIFE','PPCC','SCAL','    ','    ','    '/
38813      DATA INFLAV(880)/1/
38814      DATA INLONG(880)/'FATIGUE LIFE PPCC SCALE'/
38815C
38816      DATA INCASE(881)/'FLSH'/
38817      DATA (INAME(881,J),J=1,MAXSCL)/
38818     1'FATI','    ','LIFE','PPCC','SHAP','    ','    ','    '/
38819      DATA INFLAV(881)/1/
38820      DATA INLONG(881)/'FATIGUE LIFE PPCC SHAPE'/
38821C
38822      DATA INCASE(882)/'FLPP'/
38823      DATA (INAME(882,J),J=1,MAXSCL)/
38824     1'FATI','    ','LIFE','PPCC','STAT','    ','    ','    '/
38825      DATA INFLAV(882)/1/
38826      DATA INLONG(882)/'FATIGUE LIFE PPCC STATISTIC'/
38827C
38828      DATA INCASE(883)/'IWLO'/
38829      DATA (INAME(883,J),J=1,MAXSCL)/
38830     1'INVE','    ','WEIB','PPCC','LOCA','    ','    ','    '/
38831      DATA INFLAV(883)/1/
38832      DATA INLONG(883)/'INVERTED WEIBULL PPCC LOCATION'/
38833C
38834      DATA INCASE(884)/'IWSH'/
38835      DATA (INAME(884,J),J=1,MAXSCL)/
38836     1'INVE','    ','WEIB','PPCC','SCAL','    ','    ','    '/
38837      DATA INFLAV(884)/1/
38838      DATA INLONG(884)/'INVERTED WEIBULL PPCC SCALE'/
38839C
38840      DATA INCASE(885)/'IWSH'/
38841      DATA (INAME(885,J),J=1,MAXSCL)/
38842     1'INVE','    ','WEIB','PPCC','SHAP','    ','    ','    '/
38843      DATA INFLAV(885)/1/
38844      DATA INLONG(885)/'INVERTED WEIBULL PPCC SHAPE'/
38845C
38846      DATA INCASE(886)/'IWPP'/
38847      DATA (INAME(886,J),J=1,MAXSCL)/
38848     1'INVE','    ','WEIB','PPCC','STAT','    ','    ','    '/
38849      DATA INFLAV(886)/1/
38850      DATA INLONG(886)/'INVERTED WEIBULL PPCC'/
38851C
38852      DATA INCASE(887)/'PACD'/
38853      DATA (INAME(887,J),J=1,MAXSCL)/
38854     1'PAGE','    ','TEST','CDF ','    ','    ','    ','    '/
38855      DATA INFLAV(887)/3/
38856      DATA INLONG(887)/'PAGE TEST CDF'/
38857C
38858      DATA INCASE(888)/'PAPV'/
38859      DATA (INAME(888,J),J=1,MAXSCL)/
38860     1'PAGE','    ','TEST','PVAL','    ','    ','    ','    '/
38861      DATA INFLAV(888)/3/
38862      DATA INLONG(888)/'PAGE TEST PVALUE'/
38863C
38864      DATA INCASE(889)/'PAT2'/
38865      DATA (INAME(889,J),J=1,MAXSCL)/
38866     1'PAGE','    ','TEST','NORM','    ','    ','    ','    '/
38867      DATA INFLAV(889)/3/
38868      DATA INLONG(889)/'PAGE TEST NORMALIZED'/
38869C
38870      DATA INCASE(890)/'PATE'/
38871      DATA (INAME(890,J),J=1,MAXSCL)/
38872     1'PAGE','    ','TEST','    ','    ','    ','    ','    '/
38873      DATA INFLAV(890)/3/
38874      DATA INLONG(890)/'PAGE TEST'/
38875C
38876      DATA INCASE(891)/'LJCD'/
38877      DATA (INAME(891,J),J=1,MAXSCL)/
38878     1'LJUN','    ','BOX ','TEST','CDF ','    ','    ','    '/
38879      DATA INFLAV(891)/1/
38880      DATA INLONG(891)/'LJUNG-BOX TEST'/
38881C
38882      DATA INCASE(892)/'LJPV'/
38883      DATA (INAME(892,J),J=1,MAXSCL)/
38884     1'LJUN','    ','BOX ','TEST','PVAL','    ','    ','    '/
38885      DATA INFLAV(892)/1/
38886      DATA INLONG(892)/'LJUNG-BOX TEST PVALUE'/
38887C
38888      DATA INCASE(893)/'LJUN'/
38889      DATA (INAME(893,J),J=1,MAXSCL)/
38890     1'LJUN','    ','BOX ','TEST','    ','    ','    ','    '/
38891      DATA INFLAV(893)/1/
38892      DATA INLONG(893)/'LJUNG-BOX TEST'/
38893C
38894      DATA INCASE(894)/'MSDC'/
38895      DATA (INAME(894,J),J=1,MAXSCL)/
38896     1'MEAN','    ','SUCC','DIFF','CDF ','    ','    ','    '/
38897      DATA INFLAV(894)/1/
38898      DATA INLONG(894)/'MEAN SUCCESSIVE DIFFERENCES CDF'/
38899C
38900      DATA INCASE(895)/'MSDP'/
38901      DATA (INAME(895,J),J=1,MAXSCL)/
38902     1'MEAN','    ','SUCC','DIFF','TEST','PVAL','    ','    '/
38903      DATA INFLAV(895)/1/
38904      DATA INLONG(895)/'MEAN SUCCESSIVE DIFFERENCES PVALUE'/
38905C
38906      DATA INCASE(896)/'MSDP'/
38907      DATA (INAME(896,J),J=1,MAXSCL)/
38908     1'MEAN','    ','SUCC','DIFF','PVAL','    ','    ','    '/
38909      DATA INFLAV(896)/1/
38910      DATA INLONG(896)/'MEAN SUCCESSIVE DIFFERENCES PVALUE'/
38911C
38912      DATA INCASE(897)/'MSDT'/
38913      DATA (INAME(897,J),J=1,MAXSCL)/
38914     1'MEAN','    ','SUCC','DIFF','TEST','    ','    ','    '/
38915      DATA INFLAV(897)/1/
38916      DATA INLONG(897)/'MEAN SUCCESSIVE DIFFERENCES'/
38917C
38918      DATA INCASE(898)/'MSDT'/
38919      DATA (INAME(898,J),J=1,MAXSCL)/
38920     1'MEAN','    ','SUCC','DIFF','    ','    ','    ','    '/
38921      DATA INFLAV(898)/1/
38922      DATA INLONG(898)/'MEAN SUCCESSIVE DIFFERENCES'/
38923C
38924      DATA INCASE(899)/'KTPV'/
38925      DATA (INAME(899,J),J=1,MAXSCL)/
38926     1'KEND','    ','TAU ','PVAL','    ','    ','    ','    '/
38927      DATA INFLAV(899)/2/
38928      DATA INLONG(899)/'KENDALLS TAU PVALUE'/
38929C
38930      DATA INCASE(900)/'KTPV'/
38931      DATA (INAME(900,J),J=1,MAXSCL)/
38932     1'KEND','    ','TAU ','PVAL','    ','    ','    ','    '/
38933      DATA INFLAV(900)/2/
38934      DATA INLONG(900)/'KENDALLS TAU PVALUE'/
38935C
38936      DATA INCASE(901)/'KTPL'/
38937      DATA (INAME(901,J),J=1,MAXSCL)/
38938     1'KEND','    ','TAU ','LOWE','TAIL','PVAL','    ','    '/
38939      DATA INFLAV(901)/2/
38940      DATA INLONG(901)/'KENDALLS TAU LOWER TAILED PVALUE'/
38941C
38942      DATA INCASE(902)/'MNNP'/
38943      DATA (INAME(902,J),J=1,MAXSCL)/
38944     1'MEAN','    ','NEAR','NEIG','DIST','PVAL','    ','    '/
38945      DATA INFLAV(902)/2/
38946      DATA INLONG(902)/'MEAN NEAREST NEIGHBOR DISTANCE PVALUE'/
38947C
38948      DATA INCASE(903)/'MAXI'/
38949      DATA (INAME(903,J),J=1,MAXSCL)/
38950     1'MAXI','    ','    ','    ','    ','    ','    ','    '/
38951      DATA INFLAV(903)/1/
38952      DATA INLONG(903)/'MAXIMUM'/
38953C
38954      DATA INCASE(904)/'MNNC'/
38955      DATA (INAME(904,J),J=1,MAXSCL)/
38956     1'MEAN','    ','NEAR','NEIG','DIST','CDF ','    ','    '/
38957      DATA INFLAV(904)/2/
38958      DATA INLONG(904)/'MEAN NEAREST NEIGHBOR DISTANCE CDF'/
38959C
38960      DATA INCASE(905)/'SUM '/
38961      DATA (INAME(905,J),J=1,MAXSCL)/
38962     1'SUM ','    ','    ','    ','    ','    ','    ','    '/
38963      DATA INFLAV(905)/1/
38964      DATA INLONG(905)/'SUM'/
38965C
38966      DATA INCASE(906)/'RACP'/
38967      DATA (INAME(906,J),J=1,MAXSCL)/
38968     1'RANK','    ','CORR','PVAL','    ','    ','    ','    '/
38969      DATA INFLAV(906)/2/
38970      DATA INLONG(906)/'RANK CORRELATION P-VALUE'/
38971C
38972      DATA INCASE(907)/'RALP'/
38973      DATA (INAME(907,J),J=1,MAXSCL)/
38974     1'RANK','    ','CORR','LOWE','TAIL','PVAL','    ','    '/
38975      DATA INFLAV(907)/2/
38976      DATA INLONG(907)/'RANK CORRELATION LOWER TAILED P-VALUE'/
38977C
38978      DATA INCASE(908)/'RAUP'/
38979      DATA (INAME(908,J),J=1,MAXSCL)/
38980     1'RANK','    ','CORR','UPPE','TAIL','PVAL','    ','    '/
38981      DATA INFLAV(908)/2/
38982      DATA INLONG(908)/'RANK CORRELATION UPPER TAILED P-VALUE'/
38983C
38984      DATA INCASE(909)/'RACR'/
38985      DATA (INAME(909,J),J=1,MAXSCL)/
38986     1'RANK','    ','CORR','    ','    ','    ','    ','    '/
38987      DATA INFLAV(909)/2/
38988      DATA INLONG(909)/'RANK CORRELATION'/
38989C
38990      DATA INCASE(910)/'RACC'/
38991      DATA (INAME(910,J),J=1,MAXSCL)/
38992     1'SPEA','    ','RHO ','CDF ','    ','    ','    ','    '/
38993      DATA INFLAV(910)/2/
38994      DATA INLONG(910)/'RANK CORRELATION CDF'/
38995C
38996      DATA INCASE(911)/'RACP'/
38997      DATA (INAME(911,J),J=1,MAXSCL)/
38998     1'SPEA','    ','RHO ','PVAL','    ','    ','    ','    '/
38999      DATA INFLAV(911)/2/
39000      DATA INLONG(911)/'RANK CORRELATION PVALUE'/
39001C
39002      DATA INCASE(912)/'RALP'/
39003      DATA (INAME(912,J),J=1,MAXSCL)/
39004     1'SPEA','    ','RHO ','LOWE','TAIL','PVAL','    ','    '/
39005      DATA INFLAV(912)/2/
39006      DATA INLONG(912)/'RANK CORRELATION LOWER TAILED PVALUE'/
39007C
39008      DATA INCASE(913)/'RAUP'/
39009      DATA (INAME(913,J),J=1,MAXSCL)/
39010     1'SPEA','    ','RHO ','UPPE','TAIL','PVAL','    ','    '/
39011      DATA INFLAV(913)/2/
39012      DATA INLONG(913)/'RANK CORRELATION UPPER TAILED PVALUE'/
39013C
39014      DATA INCASE(914)/'RACR'/
39015      DATA (INAME(914,J),J=1,MAXSCL)/
39016     1'SPEA','    ','RHO ','    ','    ','    ','    ','    '/
39017      DATA INFLAV(914)/2/
39018      DATA INLONG(914)/'RANK CORRELATION'/
39019C
39020      DATA INCASE(915)/'KTPU'/
39021      DATA (INAME(915,J),J=1,MAXSCL)/
39022     1'KEND','    ','TAU ','UPPE','TAIL','PVAL','    ','    '/
39023      DATA INFLAV(915)/2/
39024      DATA INLONG(915)/'KENDALLS TAU UPPER TAILED PVALUE'/
39025C
39026      DATA INCASE(916)/'KDIS'/
39027      DATA (INAME(916,J),J=1,MAXSCL)/
39028     1'KEND','    ','TAU ','DISS','    ','    ','    ','    '/
39029      DATA INFLAV(916)/2/
39030      DATA INLONG(916)/'KENDALLS TAU DISSIMILARITY'/
39031C
39032      DATA INCASE(917)/'DSSQ'/
39033      DATA (INAME(917,J),J=1,MAXSCL)/
39034     1'DIFF','    ','SUM ','OF  ','SQUA','    ','    ','    '/
39035      DATA INFLAV(917)/2/
39036      DATA INLONG(917)/'DIFFERENCE OF SUM OF SQUARES'/
39037C
39038      DATA INCASE(918)/'DSSQ'/
39039      DATA (INAME(918,J),J=1,MAXSCL)/
39040     1'DIFF','    ','SUMS','OF  ','SQUA','    ','    ','    '/
39041      DATA INFLAV(918)/2/
39042      DATA INLONG(918)/'DIFFERENCE OF SUM OF SQUARES'/
39043C
39044      DATA INCASE(919)/'DSSQ'/
39045      DATA (INAME(919,J),J=1,MAXSCL)/
39046     1'DIFF','    ','OF  ','SUM ','OF  ','SQUA','    ','    '/
39047      DATA INFLAV(919)/2/
39048      DATA INLONG(919)/'DIFFERENCE OF SUM OF SQUARES'/
39049C
39050      DATA INCASE(920)/'DSSQ'/
39051      DATA (INAME(920,J),J=1,MAXSCL)/
39052     1'DIFF','    ','OF  ','SUMS','OF  ','SQUA','    ','    '/
39053      DATA INFLAV(920)/2/
39054      DATA INLONG(920)/'DIFFERENCE OF SUM OF SQUARES'/
39055C
39056      DATA INCASE(921)/'LPB '/
39057      DATA (INAME(921,J),J=1,MAXSCL)/
39058     1'LOWE','    ','PRED','BOUN','    ','    ','    ','    '/
39059      DATA INFLAV(921)/1/
39060      DATA INLONG(921)/'LOWER PREDICTION BOUND'/
39061C
39062      DATA INCASE(922)/'UPB '/
39063      DATA (INAME(922,J),J=1,MAXSCL)/
39064     1'UPPE','    ','PRED','BOUN','    ','    ','    ','    '/
39065      DATA INFLAV(922)/1/
39066      DATA INLONG(922)/'UPPER PREDICTION BOUND'/
39067C
39068      DATA INCASE(923)/'1LPB'/
39069      DATA (INAME(923,J),J=1,MAXSCL)/
39070     1'ONE ','    ','SIDE','LOWE','PRED','BOUN','    ','    '/
39071      DATA INFLAV(923)/1/
39072      DATA INLONG(923)/'ONE-SIDED LOWER PREDICTION BOUND'/
39073C
39074      DATA INCASE(924)/'1UPL'/
39075      DATA (INAME(924,J),J=1,MAXSCL)/
39076     1'ONE ','    ','SIDE','UPPE','PRED','BOUN','    ','    '/
39077      DATA INFLAV(924)/1/
39078      DATA INLONG(924)/'ONE-SIDED UPPER PREDICTION BOUND'/
39079C
39080      DATA INCASE(925)/'SLPL'/
39081      DATA (INAME(925,J),J=1,MAXSCL)/
39082     1'SUMM','    ','LOWE','PRED','LIMI','    ','    ','    '/
39083      DATA INFLAV(925)/3/
39084      DATA INLONG(925)/'SUMMARY LOWER PREDICTION LIMITS'/
39085C
39086      DATA INCASE(926)/'SLPL'/
39087      DATA (INAME(926,J),J=1,MAXSCL)/
39088     1'SUMM','    ','LOWE','PRED','INTE','    ','    ','    '/
39089      DATA INFLAV(926)/3/
39090      DATA INLONG(926)/'SUMMARY LOWER PREDICTION LIMITS'/
39091C
39092      DATA INCASE(927)/'SLP1'/
39093      DATA (INAME(927,J),J=1,MAXSCL)/
39094     1'SUMM','    ','ONE ','SIDE','LOWE','PRED','LIMI','    '/
39095      DATA INFLAV(927)/3/
39096      DATA INLONG(927)/'SUMMARY ONE SIDED LOWER PREDICTION LIMITS'/
39097C
39098      DATA INCASE(928)/'SLP1'/
39099      DATA (INAME(928,J),J=1,MAXSCL)/
39100     1'SUMM','    ','ONE ','SIDE','LOWE','PRED','INTE','    '/
39101      DATA INFLAV(928)/3/
39102      DATA INLONG(928)/'SUMMARY ONE SIDED LOWER PREDICTION LIMITS'/
39103C
39104      DATA INCASE(929)/'SUPL'/
39105      DATA (INAME(929,J),J=1,MAXSCL)/
39106     1'SUMM','    ','UPPE','PRED','LIMI','    ','    ','    '/
39107      DATA INFLAV(929)/3/
39108      DATA INLONG(929)/'SUMMARY UPPER PREDICTION LIMITS'/
39109C
39110      DATA INCASE(930)/'SUPL'/
39111      DATA (INAME(930,J),J=1,MAXSCL)/
39112     1'SUMM','    ','UPPE','PRED','INTE','    ','    ','    '/
39113      DATA INFLAV(930)/3/
39114      DATA INLONG(930)/'SUMMARY UPPER PREDICTION LIMITS'/
39115C
39116      DATA INCASE(931)/'SUP1'/
39117      DATA (INAME(931,J),J=1,MAXSCL)/
39118     1'SUMM','    ','ONE ','SIDE','UPPE','PRED','LIMI','    '/
39119      DATA INFLAV(931)/3/
39120      DATA INLONG(931)/'SUMMARY ONE SIDE UPPER PREDICTION LIMITS'/
39121C
39122      DATA INCASE(932)/'SUP1'/
39123      DATA (INAME(932,J),J=1,MAXSCL)/
39124     1'SUMM','    ','ONE ','SIDE','UPPE','PRED','INTE','    '/
39125      DATA INFLAV(932)/3/
39126      DATA INLONG(932)/'SUMMARY ONE SIDE UPPER PREDICTION LIMITS'/
39127C
39128      DATA INCASE(933)/'SLPB'/
39129      DATA (INAME(933,J),J=1,MAXSCL)/
39130     1'SUMM','    ','LOWE','PRED','BOUN','    ','    ','    '/
39131      DATA INFLAV(933)/3/
39132      DATA INLONG(933)/'SUMMARY LOWER PREDICTION BOUNDS'/
39133C
39134      DATA INCASE(934)/'SUPB'/
39135      DATA (INAME(934,J),J=1,MAXSCL)/
39136     1'SUMM','    ','UPPE','PRED','BOUN','    ','    ','    '/
39137      DATA INFLAV(934)/3/
39138      DATA INLONG(934)/'SUMMARY UPPER PREDICTION BOUNDS'/
39139C
39140      DATA INCASE(935)/'SLB1'/
39141      DATA (INAME(935,J),J=1,MAXSCL)/
39142     1'SUMM','    ','ONE ','SIDE','LOWE','PRED','BOUN','    '/
39143      DATA INFLAV(935)/3/
39144      DATA INLONG(935)/'SUMMARY ONE SIDED LOWER PREDICTION BOUNDS'/
39145C
39146      DATA INCASE(936)/'SUB1'/
39147      DATA (INAME(936,J),J=1,MAXSCL)/
39148     1'SUMM','    ','ONE ','SIDE','UPPE','PRED','BOUN','    '/
39149      DATA INFLAV(936)/3/
39150      DATA INLONG(936)/'SUMMARY ONE SIDED UPPER PREDICTION BOUNDS'/
39151C
39152      DATA INCASE(937)/'SILO'/
39153      DATA (INAME(937,J),J=1,MAXSCL)/
39154     1'SINE','    ','PPCC','LOCA','    ','    ','    ','    '/
39155      DATA INFLAV(937)/1/
39156      DATA INLONG(937)/'SINE PPCC LOCATION'/
39157C
39158      DATA INCASE(938)/'SISC'/
39159      DATA (INAME(938,J),J=1,MAXSCL)/
39160     1'SINE','    ','PPCC','SCAL','    ','    ','    ','    '/
39161      DATA INFLAV(938)/1/
39162      DATA INLONG(938)/'SINE PPCC SCALE'/
39163C
39164      DATA INCASE(939)/'SIPP'/
39165      DATA (INAME(939,J),J=1,MAXSCL)/
39166     1'SINE','    ','PPCC','    ','    ','    ','    ','    '/
39167      DATA INFLAV(939)/1/
39168      DATA INLONG(939)/'SINE PPCC'/
39169C
39170      DATA INCASE(940)/'SUS1'/
39171      DATA (INAME(940,J),J=1,MAXSCL)/
39172     1'SUMM','    ','ONE ','SIDE','UPPE','SD  ','PRED','LIMI'/
39173      DATA INFLAV(940)/2/
39174      DATA INLONG(940)/'SUMMARY ONE SIDED UPPER SD PREDICTION LIMITS'/
39175C
39176      DATA INCASE(941)/'SUS1'/
39177      DATA (INAME(941,J),J=1,MAXSCL)/
39178     1'SUMM','    ','ONE ','SIDE','UPPE','SD  ','PRED','INTE'/
39179      DATA INFLAV(941)/2/
39180      DATA INLONG(941)/'SUMMARY ONE SIDED UPPER SD PREDICTION LIMITS'/
39181C
39182      DATA INCASE(942)/'SLS1'/
39183      DATA (INAME(942,J),J=1,MAXSCL)/
39184     1'SUMM','    ','ONE ','SIDE','LOWE','SD  ','PRED','LIMI'/
39185      DATA INFLAV(942)/2/
39186      DATA INLONG(942)/'SUMMARY ONE SIDED LOWER SD PREDICTION LIMITS'/
39187C
39188      DATA INCASE(943)/'SLS1'/
39189      DATA (INAME(943,J),J=1,MAXSCL)/
39190     1'SUMM','    ','ONE ','SIDE','LOWE','SD  ','PRED','LIMI'/
39191      DATA INFLAV(943)/2/
39192      DATA INLONG(943)/'SUMMARY ONE SIDED LOWER SD PREDICTION LIMITS'/
39193C
39194      DATA INCASE(944)/'SUS2'/
39195      DATA (INAME(944,J),J=1,MAXSCL)/
39196     1'SUMM','    ','UPPE','SD  ','PRED','LIMI','    ','    '/
39197      DATA INFLAV(944)/2/
39198      DATA INLONG(944)/'SUMMARY UPPER SD PREDICTION LIMITS'/
39199C
39200      DATA INCASE(945)/'SUS2'/
39201      DATA (INAME(945,J),J=1,MAXSCL)/
39202     1'SUMM','    ','UPPE','SD  ','PRED','INTE','    ','    '/
39203      DATA INFLAV(945)/2/
39204      DATA INLONG(945)/'SUMMARY UPPER SD PREDICTION LIMITS'/
39205C
39206      DATA INCASE(946)/'SUS2'/
39207      DATA (INAME(946,J),J=1,MAXSCL)/
39208     1'SUMM','    ','UPPE','STAN','DEVI','PRED','LIMI','    '/
39209      DATA INFLAV(946)/2/
39210      DATA INLONG(946)/'SUMMARY UPPER SD PREDICTION LIMITS'/
39211C
39212      DATA INCASE(947)/'SUS2'/
39213      DATA (INAME(947,J),J=1,MAXSCL)/
39214     1'SUMM','    ','UPPE','STAN','DEVI','PRED','INTE','    '/
39215      DATA INFLAV(947)/2/
39216      DATA INLONG(947)/'SUMMARY UPPER SD PREDICTION LIMITS'/
39217C
39218      DATA INCASE(948)/'SLS2'/
39219      DATA (INAME(948,J),J=1,MAXSCL)/
39220     1'SUMM','    ','LOWE','SD  ','PRED','LIMI','    ','    '/
39221      DATA INFLAV(948)/2/
39222      DATA INLONG(948)/'SUMMARY LOWER SD PREDICTION LIMITS'/
39223C
39224      DATA INCASE(949)/'SLS2'/
39225      DATA (INAME(949,J),J=1,MAXSCL)/
39226     1'SUMM','    ','LOWE','SD  ','PRED','INTE','    ','    '/
39227      DATA INFLAV(949)/2/
39228      DATA INLONG(949)/'SUMMARY LOWER SD PREDICTION LIMITS'/
39229C
39230      DATA INCASE(950)/'SLS2'/
39231      DATA (INAME(950,J),J=1,MAXSCL)/
39232     1'SUMM','    ','LOWE','STAN','DEVI','PRED','LIMI','    '/
39233      DATA INFLAV(950)/2/
39234      DATA INLONG(950)/'SUMMARY LOWER SD PREDICTION LIMITS'/
39235C
39236      DATA INCASE(951)/'SLS2'/
39237      DATA (INAME(951,J),J=1,MAXSCL)/
39238     1'SUMM','    ','LOWE','STAN','DEVI','PRED','INTE','    '/
39239      DATA INFLAV(951)/2/
39240      DATA INLONG(951)/'SUMMARY LOWER SD PREDICTION LIMITS'/
39241C
39242      DATA INCASE(952)/'UPS1'/
39243      DATA (INAME(952,J),J=1,MAXSCL)/
39244     1'ONE ','    ','SIDE','UPPE','SD  ','PRED','LIMI','    '/
39245      DATA INFLAV(952)/1/
39246      DATA INLONG(952)/'ONE SIDED UPPER SD PREDICTION LIMITS'/
39247C
39248      DATA INCASE(953)/'UPS1'/
39249      DATA (INAME(953,J),J=1,MAXSCL)/
39250     1'ONE ','    ','SIDE','UPPE','SD  ','PRED','INTE','    '/
39251      DATA INFLAV(953)/1/
39252      DATA INLONG(953)/'ONE SIDED UPPER SD PREDICTION LIMITS'/
39253C
39254      DATA INCASE(954)/'UPS1'/
39255      DATA (INAME(954,J),J=1,MAXSCL)/
39256     1'ONE ','    ','SIDE','UPPE','STAN','DEVI','PRED','LIMI'/
39257      DATA INFLAV(954)/1/
39258      DATA INLONG(954)/'ONE SIDED UPPER SD PREDICTION LIMITS'/
39259C
39260      DATA INCASE(955)/'UPS1'/
39261      DATA (INAME(955,J),J=1,MAXSCL)/
39262     1'ONE ','    ','SIDE','UPPE','STAN','DEVI','PRED','INTE'/
39263      DATA INFLAV(955)/1/
39264      DATA INLONG(955)/'ONE SIDED UPPER SD PREDICTION LIMITS'/
39265C
39266      DATA INCASE(956)/'LPS1'/
39267      DATA (INAME(956,J),J=1,MAXSCL)/
39268     1'ONE ','    ','SIDE','LOWE','SD  ','PRED','LIMI','    '/
39269      DATA INFLAV(956)/1/
39270      DATA INLONG(956)/'ONE SIDED LOWER SD PREDICTION LIMITS'/
39271C
39272      DATA INCASE(957)/'LPS1'/
39273      DATA (INAME(957,J),J=1,MAXSCL)/
39274     1'ONE ','    ','SIDE','LOWE','SD  ','PRED','INTE','    '/
39275      DATA INFLAV(957)/1/
39276      DATA INLONG(957)/'ONE SIDED LOWER SD PREDICTION LIMITS'/
39277C
39278      DATA INCASE(958)/'LPS1'/
39279      DATA (INAME(958,J),J=1,MAXSCL)/
39280     1'ONE ','    ','SIDE','LOWE','STAN','DEVI','PRED','LIMI'/
39281      DATA INFLAV(958)/1/
39282      DATA INLONG(958)/'ONE SIDED LOWER SD PREDICTION LIMITS'/
39283C
39284      DATA INCASE(959)/'LPS1'/
39285      DATA (INAME(959,J),J=1,MAXSCL)/
39286     1'ONE ','    ','SIDE','LOWE','STAN','DEVI','PRED','INTE'/
39287      DATA INFLAV(959)/1/
39288      DATA INLONG(959)/'ONE SIDED LOWER SD PREDICTION LIMITS'/
39289C
39290      DATA INCASE(960)/'UPS2'/
39291      DATA (INAME(960,J),J=1,MAXSCL)/
39292     1'UPPE','    ','SD  ','PRED','LIMI','    ','    ','    '/
39293      DATA INFLAV(960)/1/
39294      DATA INLONG(960)/'UPPER SD PREDICTION LIMITS'/
39295C
39296      DATA INCASE(961)/'UPS2'/
39297      DATA (INAME(961,J),J=1,MAXSCL)/
39298     1'UPPE','    ','SD  ','PRED','INTE','    ','    ','    '/
39299      DATA INFLAV(961)/1/
39300      DATA INLONG(961)/'UPPER SD PREDICTION LIMITS'/
39301C
39302      DATA INCASE(962)/'UPS2'/
39303      DATA (INAME(962,J),J=1,MAXSCL)/
39304     1'UPPE','    ','STAN','DEVI','PRED','LIMI','    ','    '/
39305      DATA INFLAV(962)/1/
39306      DATA INLONG(962)/'UPPER SD PREDICTION LIMITS'/
39307C
39308      DATA INCASE(963)/'UPS2'/
39309      DATA (INAME(963,J),J=1,MAXSCL)/
39310     1'UPPE','    ','STAN','DEVI','PRED','INTE','    ','    '/
39311      DATA INFLAV(963)/1/
39312      DATA INLONG(963)/'UPPER SD PREDICTION LIMITS'/
39313C
39314      DATA INCASE(964)/'LPS2'/
39315      DATA (INAME(964,J),J=1,MAXSCL)/
39316     1'LOWE','    ','SD  ','PRED','LIMI','    ','    ','    '/
39317      DATA INFLAV(964)/1/
39318      DATA INLONG(964)/'LOWER SD PREDICTION LIMITS'/
39319C
39320      DATA INCASE(965)/'LPS2'/
39321      DATA (INAME(965,J),J=1,MAXSCL)/
39322     1'LOWE','    ','SD  ','PRED','INTE','    ','    ','    '/
39323      DATA INFLAV(965)/1/
39324      DATA INLONG(965)/'LOWER SD PREDICTION LIMITS'/
39325C
39326      DATA INCASE(966)/'LPS2'/
39327      DATA (INAME(966,J),J=1,MAXSCL)/
39328     1'LOWE','    ','STAN','DEVI','PRED','LIMI','    ','    '/
39329      DATA INFLAV(966)/1/
39330      DATA INLONG(966)/'LOWER SD PREDICTION LIMITS'/
39331C
39332      DATA INCASE(967)/'LPS2'/
39333      DATA (INAME(967,J),J=1,MAXSCL)/
39334     1'LOWE','    ','STAN','DEVI','PRED','INTE','    ','    '/
39335      DATA INFLAV(967)/1/
39336      DATA INLONG(967)/'LOWER SD PREDICTION LIMITS'/
39337C
39338      DATA INCASE(968)/'LCS2'/
39339      DATA (INAME(968,J),J=1,MAXSCL)/
39340     1'LOWE','    ','STAN','DEVI','CONF','INTE','    ','    '/
39341      DATA INFLAV(968)/1/
39342      DATA INLONG(968)/'LOWER SD CONFIDENCE LIMITS'/
39343C
39344      DATA INCASE(969)/'SUZ1'/
39345      DATA (INAME(969,J),J=1,MAXSCL)/
39346     1'SUMM','    ','ONE ','SIDE','UPPE','SD  ','CONF','LIMI'/
39347      DATA INFLAV(969)/2/
39348      DATA INLONG(969)/'SUMMARY ONE SIDED UPPER SD CONFIDENCE LIMITS'/
39349C
39350      DATA INCASE(970)/'SUZ1'/
39351      DATA (INAME(970,J),J=1,MAXSCL)/
39352     1'SUMM','    ','ONE ','SIDE','UPPE','SD  ','CONF','INTE'/
39353      DATA INFLAV(970)/2/
39354      DATA INLONG(970)/'SUMMARY ONE SIDED UPPER SD CONFIDENCE LIMITS'/
39355C
39356      DATA INCASE(971)/'SLZ1'/
39357      DATA (INAME(971,J),J=1,MAXSCL)/
39358     1'SUMM','    ','ONE ','SIDE','LOWE','SD  ','CONF','LIMI'/
39359      DATA INFLAV(971)/2/
39360      DATA INLONG(971)/'SUMMARY ONE SIDED LOWER SD CONFIDENCE LIMITS'/
39361C
39362      DATA INCASE(972)/'SLZ1'/
39363      DATA (INAME(972,J),J=1,MAXSCL)/
39364     1'SUMM','    ','ONE ','SIDE','LOWE','SD  ','CONF','INTE'/
39365      DATA INFLAV(972)/2/
39366      DATA INLONG(972)/'SUMMARY ONE SIDED LOWER SD CONFIDENCE LIMITS'/
39367C
39368      DATA INCASE(973)/'SUZ2'/
39369      DATA (INAME(973,J),J=1,MAXSCL)/
39370     1'SUMM','    ','UPPE','SD  ','CONF','LIMI','    ','    '/
39371      DATA INFLAV(973)/2/
39372      DATA INLONG(973)/'SUMMARY UPPER SD CONFIDENCE LIMITS'/
39373C
39374      DATA INCASE(974)/'SUZ2'/
39375      DATA (INAME(974,J),J=1,MAXSCL)/
39376     1'SUMM','    ','UPPE','SD  ','CONF','INTE','    ','    '/
39377      DATA INFLAV(974)/2/
39378      DATA INLONG(974)/'SUMMARY UPPER SD CONFIDENCE LIMITS'/
39379C
39380      DATA INCASE(975)/'SUZ2'/
39381      DATA (INAME(975,J),J=1,MAXSCL)/
39382     1'SUMM','    ','UPPE','STAN','DEVI','CONF','LIMI','    '/
39383      DATA INFLAV(975)/2/
39384      DATA INLONG(975)/'SUMMARY UPPER SD CONFIDENCE LIMITS'/
39385C
39386      DATA INCASE(976)/'SUZ2'/
39387      DATA (INAME(976,J),J=1,MAXSCL)/
39388     1'SUMM','    ','UPPE','STAN','DEVI','CONF','INTE','    '/
39389      DATA INFLAV(976)/2/
39390      DATA INLONG(976)/'SUMMARY UPPER SD CONFIDENCE LIMITS'/
39391C
39392      DATA INCASE(977)/'SLZ2'/
39393      DATA (INAME(977,J),J=1,MAXSCL)/
39394     1'SUMM','    ','LOWE','SD  ','CONF','LIMI','    ','    '/
39395      DATA INFLAV(977)/2/
39396      DATA INLONG(977)/'SUMMARY LOWER SD CONFIDENCE LIMITS'/
39397C
39398      DATA INCASE(977)/'SLZ2'/
39399      DATA (INAME(977,J),J=1,MAXSCL)/
39400     1'SUMM','    ','LOWE','SD  ','CONF','INTE','    ','    '/
39401      DATA INFLAV(977)/2/
39402      DATA INLONG(977)/'SUMMARY LOWER SD CONFIDENCE LIMITS'/
39403C
39404      DATA INCASE(978)/'SLZ2'/
39405      DATA (INAME(978,J),J=1,MAXSCL)/
39406     1'SUMM','    ','LOWE','STAN','DEVI','CONF','LIMI','    '/
39407      DATA INFLAV(978)/2/
39408      DATA INLONG(978)/'SUMMARY LOWER SD CONFIDENCE LIMITS'/
39409C
39410      DATA INCASE(979)/'SLZ2'/
39411      DATA (INAME(979,J),J=1,MAXSCL)/
39412     1'SUMM','    ','LOWE','STAN','DEVI','CONF','INTE','    '/
39413      DATA INFLAV(979)/2/
39414      DATA INLONG(979)/'SUMMARY LOWER SD CONFIDENCE LIMITS'/
39415C
39416      DATA INCASE(980)/'UCS1'/
39417      DATA (INAME(980,J),J=1,MAXSCL)/
39418     1'ONE ','    ','SIDE','UPPE','SD  ','CONF','LIMI','    '/
39419      DATA INFLAV(980)/1/
39420      DATA INLONG(980)/'ONE SIDED UPPER SD CONFIDENCE LIMITS'/
39421C
39422      DATA INCASE(981)/'UCS1'/
39423      DATA (INAME(981,J),J=1,MAXSCL)/
39424     1'ONE ','    ','SIDE','UPPE','SD  ','CONF','INTE','    '/
39425      DATA INFLAV(981)/1/
39426      DATA INLONG(981)/'ONE SIDED UPPER SD CONFIDENCE LIMITS'/
39427C
39428      DATA INCASE(982)/'UCS1'/
39429      DATA (INAME(982,J),J=1,MAXSCL)/
39430     1'ONE ','    ','SIDE','UPPE','STAN','DEVI','CONF','LIMI'/
39431      DATA INFLAV(982)/1/
39432      DATA INLONG(982)/'ONE SIDED UPPER SD CONFIDENCE LIMITS'/
39433C
39434      DATA INCASE(983)/'UCS1'/
39435      DATA (INAME(983,J),J=1,MAXSCL)/
39436     1'ONE ','    ','SIDE','UPPE','STAN','DEVI','CONF','INTE'/
39437      DATA INFLAV(983)/1/
39438      DATA INLONG(983)/'ONE SIDED UPPER SD CONFIDENCE LIMITS'/
39439C
39440      DATA INCASE(984)/'LCS1'/
39441      DATA (INAME(984,J),J=1,MAXSCL)/
39442     1'ONE ','    ','SIDE','LOWE','SD  ','CONF','LIMI','    '/
39443      DATA INFLAV(984)/1/
39444      DATA INLONG(984)/'ONE SIDED LOWER SD CONFIDENCE LIMITS'/
39445C
39446      DATA INCASE(985)/'LCS1'/
39447      DATA (INAME(985,J),J=1,MAXSCL)/
39448     1'ONE ','    ','SIDE','LOWE','SD  ','CONF','INTE','    '/
39449      DATA INFLAV(985)/1/
39450      DATA INLONG(985)/'ONE SIDED LOWER SD CONFIDENCE LIMITS'/
39451C
39452      DATA INCASE(986)/'LCS1'/
39453      DATA (INAME(986,J),J=1,MAXSCL)/
39454     1'ONE ','    ','SIDE','LOWE','STAN','DEVI','CONF','LIMI'/
39455      DATA INFLAV(986)/1/
39456      DATA INLONG(986)/'ONE SIDED LOWER SD CONFIDENCE LIMITS'/
39457C
39458      DATA INCASE(987)/'LCS1'/
39459      DATA (INAME(987,J),J=1,MAXSCL)/
39460     1'ONE ','    ','SIDE','LOWE','STAN','DEVI','CONF','INTE'/
39461      DATA INFLAV(987)/1/
39462      DATA INLONG(987)/'ONE SIDED LOWER SD CONFIDENCE LIMITS'/
39463C
39464      DATA INCASE(988)/'UCS2'/
39465      DATA (INAME(988,J),J=1,MAXSCL)/
39466     1'UPPE','    ','SD  ','CONF','LIMI','    ','    ','    '/
39467      DATA INFLAV(988)/1/
39468      DATA INLONG(988)/'UPPER SD CONFIDENCE LIMITS'/
39469C
39470      DATA INCASE(989)/'UCS2'/
39471      DATA (INAME(989,J),J=1,MAXSCL)/
39472     1'UPPE','    ','SD  ','CONF','INTE','    ','    ','    '/
39473      DATA INFLAV(989)/1/
39474      DATA INLONG(989)/'UPPER SD CONFIDENCE LIMITS'/
39475C
39476      DATA INCASE(990)/'UCS2'/
39477      DATA (INAME(990,J),J=1,MAXSCL)/
39478     1'UPPE','    ','STAN','DEVI','CONF','LIMI','    ','    '/
39479      DATA INFLAV(990)/1/
39480      DATA INLONG(990)/'UPPER SD CONFIDENCE LIMITS'/
39481C
39482      DATA INCASE(991)/'UCS2'/
39483      DATA (INAME(991,J),J=1,MAXSCL)/
39484     1'UPPE','    ','STAN','DEVI','CONF','INTE','    ','    '/
39485      DATA INFLAV(991)/1/
39486      DATA INLONG(991)/'UPPER SD CONFIDENCE LIMITS'/
39487C
39488      DATA INCASE(992)/'LCS2'/
39489      DATA (INAME(992,J),J=1,MAXSCL)/
39490     1'LOWE','    ','SD  ','CONF','LIMI','    ','    ','    '/
39491      DATA INFLAV(992)/1/
39492      DATA INLONG(992)/'LOWER SD CONFIDENCE LIMITS'/
39493C
39494      DATA INCASE(993)/'LCS2'/
39495      DATA (INAME(993,J),J=1,MAXSCL)/
39496     1'LOWE','    ','SD  ','CONF','INTE','    ','    ','    '/
39497      DATA INFLAV(993)/1/
39498      DATA INLONG(993)/'LOWER SD CONFIDENCE LIMITS'/
39499C
39500      DATA INCASE(994)/'LCS2'/
39501      DATA (INAME(994,J),J=1,MAXSCL)/
39502     1'LOWE','    ','STAN','DEVI','CONF','LIMI','    ','    '/
39503      DATA INFLAV(994)/1/
39504      DATA INLONG(994)/'LOWER SD CONFIDENCE LIMITS'/
39505C
39506      DATA INCASE(995)/'SD  '/
39507      DATA (INAME(995,J),J=1,MAXSCL)/
39508     1'STAN','    ','DEVI','    ','    ','    ','    ','    '/
39509      DATA INFLAV(995)/1/
39510      DATA INLONG(995)/'STANDARD DEVIATION'/
39511C
39512      DATA INCASE(996)/'SD  '/
39513      DATA (INAME(996,J),J=1,MAXSCL)/
39514     1'SD  ','    ','    ','    ','    ','    ','    ','    '/
39515      DATA INFLAV(996)/1/
39516      DATA INLONG(996)/'STANDARD DEVIATION'/
39517C
39518      DATA INCASE(997)/'SLCL'/
39519      DATA (INAME(997,J),J=1,MAXSCL)/
39520     1'SUMM','    ','LOWE','CONF','LIMI','    ','    ','    '/
39521      DATA INFLAV(997)/3/
39522      DATA INLONG(997)/'SUMMARY LOWER CONFIDENCE LIMIT'/
39523C
39524      DATA INCASE(998)/'SLCL'/
39525      DATA (INAME(998,J),J=1,MAXSCL)/
39526     1'SUMM','    ','LOWE','CONF','INTE','    ','    ','    '/
39527      DATA INFLAV(998)/3/
39528      DATA INLONG(998)/'SUMMARY LOWER CONFIDENCE LIMIT'/
39529C
39530      DATA INCASE(999)/'SUCL'/
39531      DATA (INAME(999,J),J=1,MAXSCL)/
39532     1'SUMM','    ','UPPE','CONF','LIMI','    ','    ','    '/
39533      DATA INFLAV(999)/3/
39534      DATA INLONG(999)/'SUMMARY UPPER CONFIDENCE LIMIT'/
39535C
39536      DATA INCASE(1000)/'SUCL'/
39537      DATA (INAME(1000,J),J=1,MAXSCL)/
39538     1'SUMM','    ','UPPE','CONF','INTE','    ','    ','    '/
39539      DATA INFLAV(1000)/3/
39540      DATA INLONG(1000)/'SUMMARY UPPER CONFIDENCE LIMIT'/
39541C
39542      DATA INCASE(1001)/'SLC1'/
39543      DATA (INAME(1001,J),J=1,MAXSCL)/
39544     1'SUMM','    ','ONE ','SIDE','LOWE','CONF','LIMI','    '/
39545      DATA INFLAV(1001)/3/
39546      DATA INLONG(1001)/'SUMMARY ONE SIDED LOWER CONFIDENCE LIMIT'/
39547C
39548      DATA INCASE(1002)/'SLC1'/
39549      DATA (INAME(1002,J),J=1,MAXSCL)/
39550     1'SUMM','    ','ONE ','SIDE','LOWE','CONF','INTE','    '/
39551      DATA INFLAV(1002)/3/
39552      DATA INLONG(1002)/'SUMMARY ONE SIDED LOWER CONFIDENCE LIMIT'/
39553C
39554      DATA INCASE(1003)/'SUC1'/
39555      DATA (INAME(1003,J),J=1,MAXSCL)/
39556     1'SUMM','    ','ONE ','SIDE','UPPE','CONF','LIMI','    '/
39557      DATA INFLAV(1003)/3/
39558      DATA INLONG(1003)/'SUMMARY ONE SIDED UPPER CONFIDENCE LIMIT'/
39559C
39560      DATA INCASE(1004)/'SUC1'/
39561      DATA (INAME(1004,J),J=1,MAXSCL)/
39562     1'SUMM','    ','ONE ','SIDE','UPPE','CONF','INTE','    '/
39563      DATA INFLAV(1004)/3/
39564      DATA INLONG(1004)/'SUMMARY ONE SIDED UPPER CONFIDENCE LIMIT'/
39565C
39566      DATA INCASE(1005)/'MWPV'/
39567      DATA (INAME(1005,J),J=1,MAXSCL)/
39568     1'MCCO','    ','WEIB','LOCA','TEST','PVAL','    ','    '/
39569      DATA INFLAV(1005)/2/
39570      DATA INLONG(1005)/'MCCOOL WEIBULL LOCATION TEST PVALUE'/
39571C
39572      DATA INCASE(1006)/'MWLC'/
39573      DATA (INAME(1006,J),J=1,MAXSCL)/
39574     1'MCCO','    ','WEIB','LOCA','TEST','CDF ','    ','    '/
39575      DATA INFLAV(1006)/2/
39576      DATA INLONG(1006)/'MCCOOL WEIBULL LOCATION TEST CDF'/
39577C
39578      DATA INCASE(1007)/'MW50'/
39579      DATA (INAME(1007,J),J=1,MAXSCL)/
39580     1'MCCO','    ','WEIB','LOCA','TEST','CV50','    ','    '/
39581      DATA INFLAV(1007)/2/
39582      DATA INLONG(1007)/'MCCOOL WEIBULL LOCATION TEST CV50'/
39583C
39584      DATA INCASE(1008)/'MW90'/
39585      DATA (INAME(1008,J),J=1,MAXSCL)/
39586     1'MCCO','    ','WEIB','LOCA','TEST','CV90','    ','    '/
39587      DATA INFLAV(1008)/2/
39588      DATA INLONG(1008)/'MCCOOL WEIBULL LOCATION TEST CV90'/
39589C
39590      DATA INCASE(1009)/'MW95'/
39591      DATA (INAME(1009,J),J=1,MAXSCL)/
39592     1'MCCO','    ','WEIB','LOCA','TEST','CV95','    ','    '/
39593      DATA INFLAV(1009)/2/
39594      DATA INLONG(1009)/'MCCOOL WEIBULL LOCATION TEST CV95'/
39595C
39596      DATA INCASE(1010)/'MWLT'/
39597      DATA (INAME(1010,J),J=1,MAXSCL)/
39598     1'MCCO','    ','WEIB','LOCA','TEST','    ','    ','    '/
39599      DATA INFLAV(1010)/2/
39600      DATA INLONG(1010)/'MCCOOL WEIBULL LOCATION TEST'/
39601C
39602      DATA INCASE(1011)/'CSD '/
39603      DATA (INAME(1011,J),J=1,MAXSCL)/
39604     1'CONS','    ','SD  ','    ','    ','    ','    ','    '/
39605      DATA INFLAV(1011)/1/
39606      DATA INLONG(1011)/'CONSTANT INTERCEPT SD'/
39607C
39608      DATA INCASE(1012)/'CSD '/
39609      DATA (INAME(1012,J),J=1,MAXSCL)/
39610     1'CONS','    ','STAN','DEVI','    ','    ','    ','    '/
39611      DATA INFLAV(1012)/1/
39612      DATA INLONG(1012)/'CONSTANT INTERCEPT SD'/
39613C
39614      DATA INCASE(1013)/'CINT'/
39615      DATA (INAME(1013,J),J=1,MAXSCL)/
39616     1'CONS','    ','INTE','    ','    ','    ','    ','    '/
39617      DATA INFLAV(1013)/1/
39618      DATA INLONG(1013)/'CONSTANT INTERCEPT'/
39619C
39620      DATA INCASE(1014)/'PDCD'/
39621      DATA (INAME(1014,J),J=1,MAXSCL)/
39622     1'POIS','    ','DISP','TEST','CDF ','    ','    ','    '/
39623      DATA INFLAV(1014)/1/
39624      DATA INLONG(1014)/'POISSON DISPERSION TEST CDF'/
39625C
39626      DATA INCASE(1015)/'PDPV'/
39627      DATA (INAME(1015,J),J=1,MAXSCL)/
39628     1'POIS','    ','DISP','TEST','PVAL','    ','    ','    '/
39629      DATA INFLAV(1015)/1/
39630      DATA INLONG(1015)/'POISSON DISPERSION TEST PVALUE'/
39631C
39632      DATA INCASE(1016)/'PDTE'/
39633      DATA (INAME(1016,J),J=1,MAXSCL)/
39634     1'POIS','    ','DISP','TEST','    ','    ','    ','    '/
39635      DATA INFLAV(1016)/1/
39636      DATA INLONG(1016)/'POISSON DISPERSION TEST'/
39637C
39638      DATA INCASE(1017)/'GPDC'/
39639      DATA (INAME(1017,J),J=1,MAXSCL)/
39640     1'GROU','    ','POIS','DISP','TEST','CDF ','    ','    '/
39641      DATA INFLAV(1017)/2/
39642      DATA INLONG(1017)/'POISSON DISPERSION TEST CDF'/
39643C
39644      DATA INCASE(1018)/'GPDP'/
39645      DATA (INAME(1018,J),J=1,MAXSCL)/
39646     1'GROU','    ','POIS','DISP','TEST','PVAL','    ','    '/
39647      DATA INFLAV(1018)/2/
39648      DATA INLONG(1018)/'POISSON DISPERSION TEST PVALUE'/
39649C
39650      DATA INCASE(1019)/'GPDT'/
39651      DATA (INAME(1019,J),J=1,MAXSCL)/
39652     1'GROU','    ','POIS','DISP','TEST','    ','    ','    '/
39653      DATA INFLAV(1019)/2/
39654      DATA INLONG(1019)/'POISSON DISPERSION TEST'/
39655C
39656      DATA INCASE(1020)/'BCVM'/
39657      DATA (INAME(1020,J),J=1,MAXSCL)/
39658     1'BIVA','    ','CRAM','VON ','MISE','TEST','    ','    '/
39659      DATA INFLAV(1020)/2/
39660      DATA INLONG(1020)/'BIVARIATE CRAMER VON MISES TEST'/
39661C
39662      DATA INCASE(1021)/'BC95'/
39663      DATA (INAME(1021,J),J=1,MAXSCL)/
39664     1'BIVA','    ','CRAM','VON ','MISE','95  ','CRIT','VALU'/
39665      DATA INFLAV(1021)/2/
39666      DATA INLONG(1021)/'BIVARIATE CRAMER VON MISES 95 CRITICAL VALUE'/
39667C
39668      DATA INCASE(1022)/'BC05'/
39669      DATA (INAME(1022,J),J=1,MAXSCL)/
39670     1'BIVA','    ','CRAM','VON ','MISE','05  ','CRIT','VALU'/
39671      DATA INFLAV(1022)/2/
39672      DATA INLONG(1022)/'BIVARIATE CRAMER VON MISES 05 CRITICAL VALUE'/
39673C
39674      DATA INCASE(1023)/'MNND'/
39675      DATA (INAME(1023,J),J=1,MAXSCL)/
39676     1'MEAN','    ','NEAR','NEIG','DIST','TEST','    ','    '/
39677      DATA INFLAV(1023)/2/
39678      DATA INLONG(1023)/'MEAN NEAREST NEIGHBOR DISTANCE TEST'/
39679C
39680      DATA INCASE(1024)/'MEAN'/
39681      DATA (INAME(1024,J),J=1,MAXSCL)/
39682     1'MEAN','    ','    ','    ','    ','    ','    ','    '/
39683      DATA INFLAV(1024)/1/
39684      DATA INLONG(1024)/'MEAN'/
39685C
39686      DATA INCASE(1025)/'PO1P'/
39687      DATA (INAME(1025,J),J=1,MAXSCL)/
39688     1'POLL','    ','ONE ','TEST','PVAL','    ','    ','    '/
39689      DATA INFLAV(1025)/2/
39690      DATA INLONG(1025)/'POLLARD ONE TEST PVALUE'/
39691C
39692      DATA INCASE(1026)/'PO1P'/
39693      DATA (INAME(1026,J),J=1,MAXSCL)/
39694     1'POLL','    ','ONE ','PVAL','    ','    ','    ','    '/
39695      DATA INFLAV(1026)/2/
39696      DATA INLONG(1026)/'POLLARD ONE TEST PVALUE'/
39697C
39698      DATA INCASE(1027)/'PO1C'/
39699      DATA (INAME(1027,J),J=1,MAXSCL)/
39700     1'POLL','    ','ONE ','TEST','CDF ','    ','    ','    '/
39701      DATA INFLAV(1027)/2/
39702      DATA INLONG(1027)/'POLLARD ONE TEST CDF'/
39703C
39704      DATA INCASE(1028)/'PO1C'/
39705      DATA (INAME(1028,J),J=1,MAXSCL)/
39706     1'POLL','    ','ONE ','CDF ','    ','    ','    ','    '/
39707      DATA INFLAV(1028)/2/
39708      DATA INLONG(1028)/'POLLARD ONE TEST CDF'/
39709C
39710      DATA INCASE(1029)/'POL1'/
39711      DATA (INAME(1029,J),J=1,MAXSCL)/
39712     1'POLL','    ','ONE ','TEST','    ','    ','    ','    '/
39713      DATA INFLAV(1029)/2/
39714      DATA INLONG(1029)/'POLLARD ONE STATISTIC'/
39715C
39716      DATA INCASE(1030)/'POL1'/
39717      DATA (INAME(1030,J),J=1,MAXSCL)/
39718     1'POLL','    ','ONE ','STAT','    ','    ','    ','    '/
39719      DATA INFLAV(1030)/2/
39720      DATA INLONG(1030)/'POLLARD ONE STATISTIC'/
39721C
39722      DATA INCASE(1031)/'POL1'/
39723      DATA (INAME(1031,J),J=1,MAXSCL)/
39724     1'POLL','    ','ONE ','    ','    ','    ','    ','    '/
39725      DATA INFLAV(1031)/2/
39726      DATA INLONG(1031)/'POLLARD ONE STATISTIC'/
39727C
39728      DATA INCASE(1032)/'PO1P'/
39729      DATA (INAME(1032,J),J=1,MAXSCL)/
39730     1'POLL','    ','1   ','TEST','PVAL','    ','    ','    '/
39731      DATA INFLAV(1032)/2/
39732      DATA INLONG(1032)/'POLLARD ONE TEST PVALUE'/
39733C
39734      DATA INCASE(1033)/'PO1P'/
39735      DATA (INAME(1033,J),J=1,MAXSCL)/
39736     1'POLL','    ','1   ','PVAL','    ','    ','    ','    '/
39737      DATA INFLAV(1033)/2/
39738      DATA INLONG(1033)/'POLLARD ONE TEST PVALUE'/
39739C
39740      DATA INCASE(1034)/'PO1C'/
39741      DATA (INAME(1034,J),J=1,MAXSCL)/
39742     1'POLL','    ','1   ','TEST','CDF ','    ','    ','    '/
39743      DATA INFLAV(1034)/2/
39744      DATA INLONG(1034)/'POLLARD ONE TEST CDF'/
39745C
39746      DATA INCASE(1035)/'PO1C'/
39747      DATA (INAME(1035,J),J=1,MAXSCL)/
39748     1'POLL','    ','1   ','CDF ','    ','    ','    ','    '/
39749      DATA INFLAV(1035)/2/
39750      DATA INLONG(1035)/'POLLARD ONE TEST CDF'/
39751C
39752      DATA INCASE(1036)/'POL1'/
39753      DATA (INAME(1036,J),J=1,MAXSCL)/
39754     1'POLL','    ','1   ','TEST','    ','    ','    ','    '/
39755      DATA INFLAV(1036)/2/
39756      DATA INLONG(1036)/'POLLARD ONE STATISTIC'/
39757C
39758      DATA INCASE(1037)/'POL1'/
39759      DATA (INAME(1037,J),J=1,MAXSCL)/
39760     1'POLL','    ','1   ','STAT','    ','    ','    ','    '/
39761      DATA INFLAV(1037)/2/
39762      DATA INLONG(1037)/'POLLARD ONE STATISTIC'/
39763C
39764      DATA INCASE(1038)/'POL1'/
39765      DATA (INAME(1038,J),J=1,MAXSCL)/
39766     1'POLL','    ','1   ','    ','    ','    ','    ','    '/
39767      DATA INFLAV(1038)/2/
39768      DATA INLONG(1038)/'POLLARD ONE STATISTIC'/
39769C
39770      DATA INCASE(1039)/'PO2P'/
39771      DATA (INAME(1039,J),J=1,MAXSCL)/
39772     1'POLL','    ','TWO ','TEST','PVAL','    ','    ','    '/
39773      DATA INFLAV(1039)/2/
39774      DATA INLONG(1039)/'POLLARD TWO TEST PVALUE'/
39775C
39776      DATA INCASE(1040)/'PO2P'/
39777      DATA (INAME(1040,J),J=1,MAXSCL)/
39778     1'POLL','    ','TWO ','PVAL','    ','    ','    ','    '/
39779      DATA INFLAV(1040)/2/
39780      DATA INLONG(1040)/'POLLARD TWO TEST PVALUE'/
39781C
39782      DATA INCASE(1041)/'PO2C'/
39783      DATA (INAME(1041,J),J=1,MAXSCL)/
39784     1'POLL','    ','TWO ','TEST','CDF ','    ','    ','    '/
39785      DATA INFLAV(1041)/2/
39786      DATA INLONG(1041)/'POLLARD TWO TEST CDF'/
39787C
39788      DATA INCASE(1042)/'PO2C'/
39789      DATA (INAME(1042,J),J=1,MAXSCL)/
39790     1'POLL','    ','TWO ','CDF ','    ','    ','    ','    '/
39791      DATA INFLAV(1042)/2/
39792      DATA INLONG(1042)/'POLLARD TWO TEST CDF'/
39793C
39794      DATA INCASE(1043)/'POL2'/
39795      DATA (INAME(1043,J),J=1,MAXSCL)/
39796     1'POLL','    ','TWO ','TEST','    ','    ','    ','    '/
39797      DATA INFLAV(1043)/2/
39798      DATA INLONG(1043)/'POLLARD TWO STATISTIC'/
39799C
39800      DATA INCASE(1044)/'POL2'/
39801      DATA (INAME(1044,J),J=1,MAXSCL)/
39802     1'POLL','    ','TWO ','STAT','    ','    ','    ','    '/
39803      DATA INFLAV(1044)/2/
39804      DATA INLONG(1044)/'POLLARD TWO STATISTIC'/
39805C
39806      DATA INCASE(1045)/'POL2'/
39807      DATA (INAME(1045,J),J=1,MAXSCL)/
39808     1'POLL','    ','TWO ','    ','    ','    ','    ','    '/
39809      DATA INFLAV(1045)/2/
39810      DATA INLONG(1045)/'POLLARD TWO STATISTIC'/
39811C
39812      DATA INCASE(1046)/'PO2P'/
39813      DATA (INAME(1046,J),J=1,MAXSCL)/
39814     1'POLL','    ','2   ','TEST','PVAL','    ','    ','    '/
39815      DATA INFLAV(1046)/2/
39816      DATA INLONG(1046)/'POLLARD TWO TEST PVALUE'/
39817C
39818      DATA INCASE(1047)/'PO2P'/
39819      DATA (INAME(1047,J),J=1,MAXSCL)/
39820     1'POLL','    ','2   ','PVAL','    ','    ','    ','    '/
39821      DATA INFLAV(1047)/2/
39822      DATA INLONG(1047)/'POLLARD TWO TEST PVALUE'/
39823C
39824      DATA INCASE(1048)/'PO2C'/
39825      DATA (INAME(1048,J),J=1,MAXSCL)/
39826     1'POLL','    ','2   ','TEST','CDF ','    ','    ','    '/
39827      DATA INFLAV(1048)/2/
39828      DATA INLONG(1048)/'POLLARD TWO TEST CDF'/
39829C
39830      DATA INCASE(1049)/'PO2C'/
39831      DATA (INAME(1049,J),J=1,MAXSCL)/
39832     1'POLL','    ','2   ','CDF ','    ','    ','    ','    '/
39833      DATA INFLAV(1049)/2/
39834      DATA INLONG(1049)/'POLLARD TWO TEST CDF'/
39835C
39836      DATA INCASE(1050)/'POL2'/
39837      DATA (INAME(1050,J),J=1,MAXSCL)/
39838     1'POLL','    ','2   ','TEST','    ','    ','    ','    '/
39839      DATA INFLAV(1050)/2/
39840      DATA INLONG(1050)/'POLLARD TWO STATISTIC'/
39841C
39842      DATA INCASE(1051)/'POL2'/
39843      DATA (INAME(1051,J),J=1,MAXSCL)/
39844     1'POLL','    ','2   ','STAT','    ','    ','    ','    '/
39845      DATA INFLAV(1051)/2/
39846      DATA INLONG(1051)/'POLLARD TWO STATISTIC'/
39847C
39848      DATA INCASE(1052)/'POL2'/
39849      DATA (INAME(1052,J),J=1,MAXSCL)/
39850     1'POLL','    ','2   ','    ','    ','    ','    ','    '/
39851      DATA INFLAV(1052)/2/
39852      DATA INLONG(1052)/'POLLARD TWO STATISTIC'/
39853C
39854      DATA INCASE(1053)/'PO3P'/
39855      DATA (INAME(1053,J),J=1,MAXSCL)/
39856     1'POLL','    ','THRE','TEST','PVAL','    ','    ','    '/
39857      DATA INFLAV(1053)/2/
39858      DATA INLONG(1053)/'POLLARD THREE TEST PVALUE'/
39859C
39860      DATA INCASE(1054)/'PO3P'/
39861      DATA (INAME(1054,J),J=1,MAXSCL)/
39862     1'POLL','    ','THRE','PVAL','    ','    ','    ','    '/
39863      DATA INFLAV(1054)/2/
39864      DATA INLONG(1054)/'POLLARD THREE TEST PVALUE'/
39865C
39866      DATA INCASE(1055)/'PO3C'/
39867      DATA (INAME(1055,J),J=1,MAXSCL)/
39868     1'POLL','    ','THRE','TEST','CDF ','    ','    ','    '/
39869      DATA INFLAV(1055)/2/
39870      DATA INLONG(1055)/'POLLARD THREE TEST CDF'/
39871C
39872      DATA INCASE(1056)/'PO3C'/
39873      DATA (INAME(1056,J),J=1,MAXSCL)/
39874     1'POLL','    ','THRE','CDF ','    ','    ','    ','    '/
39875      DATA INFLAV(1056)/2/
39876      DATA INLONG(1056)/'POLLARD THREE TEST CDF'/
39877C
39878      DATA INCASE(1057)/'POL3'/
39879      DATA (INAME(1057,J),J=1,MAXSCL)/
39880     1'POLL','    ','THRE','TEST','    ','    ','    ','    '/
39881      DATA INFLAV(1057)/2/
39882      DATA INLONG(1057)/'POLLARD THREE STATISTIC'/
39883C
39884      DATA INCASE(1058)/'POL3'/
39885      DATA (INAME(1058,J),J=1,MAXSCL)/
39886     1'POLL','    ','THRE','STAT','    ','    ','    ','    '/
39887      DATA INFLAV(1058)/2/
39888      DATA INLONG(1058)/'POLLARD THREE STATISTIC'/
39889C
39890      DATA INCASE(1059)/'POL3'/
39891      DATA (INAME(1059,J),J=1,MAXSCL)/
39892     1'POLL','    ','THRE','    ','    ','    ','    ','    '/
39893      DATA INFLAV(1059)/2/
39894      DATA INLONG(1059)/'POLLARD THREE STATISTIC'/
39895C
39896      DATA INCASE(1060)/'PO3P'/
39897      DATA (INAME(1060,J),J=1,MAXSCL)/
39898     1'POLL','    ','3   ','TEST','PVAL','    ','    ','    '/
39899      DATA INFLAV(1060)/2/
39900      DATA INLONG(1060)/'POLLARD THREE TEST PVALUE'/
39901C
39902      DATA INCASE(1061)/'PO3P'/
39903      DATA (INAME(1061,J),J=1,MAXSCL)/
39904     1'POLL','    ','3   ','PVAL','    ','    ','    ','    '/
39905      DATA INFLAV(1061)/2/
39906      DATA INLONG(1061)/'POLLARD THREE TEST PVALUE'/
39907C
39908      DATA INCASE(1062)/'PO3C'/
39909      DATA (INAME(1062,J),J=1,MAXSCL)/
39910     1'POLL','    ','3   ','TEST','CDF ','    ','    ','    '/
39911      DATA INFLAV(1062)/2/
39912      DATA INLONG(1062)/'POLLARD THREE TEST CDF'/
39913C
39914      DATA INCASE(1063)/'PO3C'/
39915      DATA (INAME(1063,J),J=1,MAXSCL)/
39916     1'POLL','    ','3   ','CDF ','    ','    ','    ','    '/
39917      DATA INFLAV(1063)/2/
39918      DATA INLONG(1063)/'POLLARD THREE TEST CDF'/
39919C
39920      DATA INCASE(1064)/'POL3'/
39921      DATA (INAME(1064,J),J=1,MAXSCL)/
39922     1'POLL','    ','3   ','TEST','    ','    ','    ','    '/
39923      DATA INFLAV(1064)/2/
39924      DATA INLONG(1064)/'POLLARD THREE STATISTIC'/
39925C
39926      DATA INCASE(1065)/'POL3'/
39927      DATA (INAME(1065,J),J=1,MAXSCL)/
39928     1'POLL','    ','3   ','STAT','    ','    ','    ','    '/
39929      DATA INFLAV(1065)/2/
39930      DATA INLONG(1065)/'POLLARD THREE STATISTIC'/
39931C
39932      DATA INCASE(1066)/'POL3'/
39933      DATA (INAME(1066,J),J=1,MAXSCL)/
39934     1'POLL','    ','3   ','    ','    ','    ','    ','    '/
39935      DATA INFLAV(1066)/2/
39936      DATA INLONG(1066)/'POLLARD THREE STATISTIC'/
39937C
39938      DATA INCASE(1067)/'PO4P'/
39939      DATA (INAME(1067,J),J=1,MAXSCL)/
39940     1'POLL','    ','FOUR','TEST','PVAL','    ','    ','    '/
39941      DATA INFLAV(1067)/2/
39942      DATA INLONG(1067)/'POLLARD FOUR TEST PVALUE'/
39943C
39944      DATA INCASE(1068)/'PO4P'/
39945      DATA (INAME(1068,J),J=1,MAXSCL)/
39946     1'POLL','    ','FOUR','PVAL','    ','    ','    ','    '/
39947      DATA INFLAV(1068)/2/
39948      DATA INLONG(1068)/'POLLARD FOUR TEST PVALUE'/
39949C
39950      DATA INCASE(1069)/'PO4C'/
39951      DATA (INAME(1069,J),J=1,MAXSCL)/
39952     1'POLL','    ','FOUR','TEST','CDF ','    ','    ','    '/
39953      DATA INFLAV(1069)/2/
39954      DATA INLONG(1069)/'POLLARD FOUR TEST CDF'/
39955C
39956      DATA INCASE(1070)/'PO4C'/
39957      DATA (INAME(1070,J),J=1,MAXSCL)/
39958     1'POLL','    ','FOUR','CDF ','    ','    ','    ','    '/
39959      DATA INFLAV(1070)/2/
39960      DATA INLONG(1070)/'POLLARD FOUR TEST CDF'/
39961C
39962      DATA INCASE(1071)/'POL4'/
39963      DATA (INAME(1071,J),J=1,MAXSCL)/
39964     1'POLL','    ','FOUR','TEST','    ','    ','    ','    '/
39965      DATA INFLAV(1071)/2/
39966      DATA INLONG(1071)/'POLLARD FOUR STATISTIC'/
39967C
39968      DATA INCASE(1072)/'POL4'/
39969      DATA (INAME(1072,J),J=1,MAXSCL)/
39970     1'POLL','    ','FOUR','STAT','    ','    ','    ','    '/
39971      DATA INFLAV(1072)/2/
39972      DATA INLONG(1072)/'POLLARD FOUR STATISTIC'/
39973C
39974      DATA INCASE(1073)/'POL4'/
39975      DATA (INAME(1073,J),J=1,MAXSCL)/
39976     1'POLL','    ','FOUR','    ','    ','    ','    ','    '/
39977      DATA INFLAV(1073)/2/
39978      DATA INLONG(1073)/'POLLARD FOUR STATISTIC'/
39979C
39980      DATA INCASE(1074)/'PO4P'/
39981      DATA (INAME(1074,J),J=1,MAXSCL)/
39982     1'POLL','    ','4   ','TEST','PVAL','    ','    ','    '/
39983      DATA INFLAV(1074)/2/
39984      DATA INLONG(1074)/'POLLARD FOUR TEST PVALUE'/
39985C
39986      DATA INCASE(1075)/'PO4P'/
39987      DATA (INAME(1075,J),J=1,MAXSCL)/
39988     1'POLL','    ','4   ','PVAL','    ','    ','    ','    '/
39989      DATA INFLAV(1075)/2/
39990      DATA INLONG(1075)/'POLLARD FOUR TEST PVALUE'/
39991C
39992      DATA INCASE(1076)/'PO4C'/
39993      DATA (INAME(1076,J),J=1,MAXSCL)/
39994     1'POLL','    ','4   ','TEST','CDF ','    ','    ','    '/
39995      DATA INFLAV(1076)/2/
39996      DATA INLONG(1076)/'POLLARD FOUR TEST CDF'/
39997C
39998      DATA INCASE(1077)/'PO4C'/
39999      DATA (INAME(1077,J),J=1,MAXSCL)/
40000     1'POLL','    ','4   ','CDF ','    ','    ','    ','    '/
40001      DATA INFLAV(1077)/2/
40002      DATA INLONG(1077)/'POLLARD FOUR TEST CDF'/
40003C
40004      DATA INCASE(1078)/'POL4'/
40005      DATA (INAME(1078,J),J=1,MAXSCL)/
40006     1'POLL','    ','4   ','TEST','    ','    ','    ','    '/
40007      DATA INFLAV(1078)/2/
40008      DATA INLONG(1078)/'POLLARD FOUR STATISTIC'/
40009C
40010      DATA INCASE(1079)/'POL4'/
40011      DATA (INAME(1079,J),J=1,MAXSCL)/
40012     1'POLL','    ','4   ','STAT','    ','    ','    ','    '/
40013      DATA INFLAV(1079)/2/
40014      DATA INLONG(1079)/'POLLARD FOUR STATISTIC'/
40015C
40016      DATA INCASE(1080)/'POL4'/
40017      DATA (INAME(1080,J),J=1,MAXSCL)/
40018     1'POLL','    ','4   ','    ','    ','    ','    ','    '/
40019      DATA INFLAV(1080)/2/
40020      DATA INLONG(1080)/'POLLARD FOUR STATISTIC'/
40021C
40022      DATA INCASE(1081)/'PO5P'/
40023      DATA (INAME(1081,J),J=1,MAXSCL)/
40024     1'POLL','    ','FIVE','TEST','PVAL','    ','    ','    '/
40025      DATA INFLAV(1081)/2/
40026      DATA INLONG(1081)/'POLLARD FIVE TEST PVALUE'/
40027C
40028      DATA INCASE(1082)/'PO5P'/
40029      DATA (INAME(1082,J),J=1,MAXSCL)/
40030     1'POLL','    ','FIVE','PVAL','    ','    ','    ','    '/
40031      DATA INFLAV(1082)/2/
40032      DATA INLONG(1082)/'POLLARD FIVE TEST PVALUE'/
40033C
40034      DATA INCASE(1083)/'PO5C'/
40035      DATA (INAME(1083,J),J=1,MAXSCL)/
40036     1'POLL','    ','FIVE','TEST','CDF ','    ','    ','    '/
40037      DATA INFLAV(1083)/2/
40038      DATA INLONG(1083)/'POLLARD FIVE TEST CDF'/
40039C
40040      DATA INCASE(1084)/'PO5C'/
40041      DATA (INAME(1084,J),J=1,MAXSCL)/
40042     1'POLL','    ','FIVE','CDF ','    ','    ','    ','    '/
40043      DATA INFLAV(1084)/2/
40044      DATA INLONG(1084)/'POLLARD FIVE TEST CDF'/
40045C
40046      DATA INCASE(1085)/'POL5'/
40047      DATA (INAME(1085,J),J=1,MAXSCL)/
40048     1'POLL','    ','FIVE','TEST','    ','    ','    ','    '/
40049      DATA INFLAV(1085)/2/
40050      DATA INLONG(1085)/'POLLARD FIVE STATISTIC'/
40051C
40052      DATA INCASE(1086)/'POL5'/
40053      DATA (INAME(1086,J),J=1,MAXSCL)/
40054     1'POLL','    ','6IVE','STAT','    ','    ','    ','    '/
40055      DATA INFLAV(1086)/2/
40056      DATA INLONG(1086)/'POLLARD FIVE STATISTIC'/
40057C
40058      DATA INCASE(1087)/'POL5'/
40059      DATA (INAME(1087,J),J=1,MAXSCL)/
40060     1'POLL','    ','FIVE','    ','    ','    ','    ','    '/
40061      DATA INFLAV(1087)/2/
40062      DATA INLONG(1087)/'POLLARD FIVE STATISTIC'/
40063C
40064      DATA INCASE(1088)/'PO5P'/
40065      DATA (INAME(1088,J),J=1,MAXSCL)/
40066     1'POLL','    ','5   ','TEST','PVAL','    ','    ','    '/
40067      DATA INFLAV(1088)/2/
40068      DATA INLONG(1088)/'POLLARD FIVE TEST PVALUE'/
40069C
40070      DATA INCASE(1089)/'PO5P'/
40071      DATA (INAME(1089,J),J=1,MAXSCL)/
40072     1'POLL','    ','5   ','PVAL','    ','    ','    ','    '/
40073      DATA INFLAV(1089)/2/
40074      DATA INLONG(1089)/'POLLARD FIVE TEST PVALUE'/
40075C
40076      DATA INCASE(1090)/'PO5C'/
40077      DATA (INAME(1090,J),J=1,MAXSCL)/
40078     1'POLL','    ','5   ','TEST','CDF ','    ','    ','    '/
40079      DATA INFLAV(1090)/2/
40080      DATA INLONG(1090)/'POLLARD FIVE TEST CDF'/
40081C
40082      DATA INCASE(1091)/'PO5C'/
40083      DATA (INAME(1091,J),J=1,MAXSCL)/
40084     1'POLL','    ','5   ','CDF ','    ','    ','    ','    '/
40085      DATA INFLAV(1091)/2/
40086      DATA INLONG(1091)/'POLLARD FIVE TEST CDF'/
40087C
40088      DATA INCASE(1092)/'POL5'/
40089      DATA (INAME(1092,J),J=1,MAXSCL)/
40090     1'POLL','    ','5   ','TEST','    ','    ','    ','    '/
40091      DATA INFLAV(1092)/2/
40092      DATA INLONG(1092)/'POLLARD FIVE STATISTIC'/
40093C
40094      DATA INCASE(1093)/'POL5'/
40095      DATA (INAME(1093,J),J=1,MAXSCL)/
40096     1'POLL','    ','5   ','STAT','    ','    ','    ','    '/
40097      DATA INFLAV(1093)/2/
40098      DATA INLONG(1093)/'POLLARD FIVE STATISTIC'/
40099C
40100      DATA INCASE(1094)/'POL5'/
40101      DATA (INAME(1094,J),J=1,MAXSCL)/
40102     1'POLL','    ','5   ','    ','    ','    ','    ','    '/
40103      DATA INFLAV(1094)/2/
40104      DATA INLONG(1094)/'POLLARD FIVE STATISTIC'/
40105C
40106      DATA INCASE(1095)/'VALC'/
40107      DATA (INAME(1095,J),J=1,MAXSCL)/
40108     1'VALU','    ','COUN','    ','    ','    ','    ','    '/
40109      DATA INFLAV(1095)/1/
40110      DATA INLONG(1095)/'VALUE COUNT'/
40111C
40112      DATA INCASE(1096)/'VARI'/
40113      DATA (INAME(1096,J),J=1,MAXSCL)/
40114     1'VARI','    ','    ','    ','    ','    ','    ','    '/
40115      DATA INFLAV(1096)/1/
40116      DATA INLONG(1096)/'VARIANCE'/
40117C
40118      DATA INCASE(1097)/'RDI '/
40119      DATA (INAME(1097,J),J=1,MAXSCL)/
40120     1'RELA','    ','DISP','INDE','    ','    ','    ','    '/
40121      DATA INFLAV(1097)/1/
40122      DATA INLONG(1097)/'RELATIVE DISPERSION INDEX'/
40123C
40124      DATA INCASE(1098)/'UCHS'/
40125      DATA (INAME(1098,J),J=1,MAXSCL)/
40126     1'UNIF','    ','CHI ','SQUA','    ','    ','    ','    '/
40127      DATA INFLAV(1098)/1/
40128      DATA INLONG(1098)/'UNIFORM CHI-SQUARE'/
40129C
40130      DATA INCASE(1099)/'UCHS'/
40131      DATA (INAME(1099,J),J=1,MAXSCL)/
40132     1'UNIF','    ','CHIS','    ','    ','    ','    ','    '/
40133      DATA INFLAV(1099)/1/
40134      DATA INLONG(1099)/'UNIFORM CHI-SQUARE'/
40135C
40136      DATA INCASE(1100)/'UCHS'/
40137      DATA (INAME(1100,J),J=1,MAXSCL)/
40138     1'UNIF','    ','CHI-','    ','    ','    ','    ','    '/
40139      DATA INFLAV(1100)/1/
40140      DATA INLONG(1100)/'UNIFORM CHI-SQUARE'/
40141C
40142      DATA INCASE(1101)/'DRAT'/
40143      DATA (INAME(1101,J),J=1,MAXSCL)/
40144     1'DECI','    ','RATI','    ','    ','    ','    ','    '/
40145      DATA INFLAV(1101)/1/
40146      DATA INLONG(1101)/'INTER DECILE RATIO'/
40147C
40148      DATA INCASE(1102)/'DRAT'/
40149      DATA (INAME(1102,J),J=1,MAXSCL)/
40150     1'INTE','RDEC','RATI','    ','    ','    ','    ','    '/
40151      DATA INFLAV(1102)/1/
40152      DATA INLONG(1102)/'DECILE RATIO'/
40153C
40154      DATA INCASE(1103)/'DRAT'/
40155      DATA (INAME(1103,J),J=1,MAXSCL)/
40156     1'INTE','    ','DECI','RATI','    ','    ','    ','    '/
40157      DATA INFLAV(1103)/1/
40158      DATA INLONG(1103)/'DECILE RATIO'/
40159C
40160      DATA INCASE(1104)/'GDRA'/
40161      DATA (INAME(1104,J),J=1,MAXSCL)/
40162     1'GROU','    ','DECI','RATI','    ','    ','    ','    '/
40163      DATA INFLAV(1104)/2/
40164      DATA INLONG(1104)/'DECILE RATIO (GROUPED DATA)'/
40165C
40166      DATA INCASE(1105)/'GDRA'/
40167      DATA (INAME(1105,J),J=1,MAXSCL)/
40168     1'GROU','    ','INTE','DECI','RATI','    ','    ','    '/
40169      DATA INFLAV(1105)/2/
40170      DATA INLONG(1105)/'DECILE RATIO (GROUPED DATA)'/
40171C
40172      DATA INCASE(1106)/'GDRA'/
40173      DATA (INAME(1106,J),J=1,MAXSCL)/
40174     1'GROU','    ','INTE','RATI','    ','    ','    ','    '/
40175      DATA INFLAV(1106)/2/
40176      DATA INLONG(1106)/'DECILE RATIO (GROUPED DATA)'/
40177C
40178      DATA INCASE(1107)/'GQUA'/
40179      DATA (INAME(1107,J),J=1,MAXSCL)/
40180     1'GROU','    ','QUAN','    ','    ','    ','    ','    '/
40181      DATA INFLAV(1107)/2/
40182      DATA INLONG(1107)/'QUANTILE (GROUPED DATA)'/
40183C
40184      DATA INCASE(1108)/'GPER'/
40185      DATA (INAME(1108,J),J=1,MAXSCL)/
40186     1'GROU','    ','PERC','    ','    ','    ','    ','    '/
40187      DATA INFLAV(1108)/2/
40188      DATA INLONG(1108)/'PERCENTILE (GROUPED DATA)'/
40189C
40190      DATA INCASE(1109)/'WSCD'/
40191      DATA (INAME(1109,J),J=1,MAXSCL)/
40192     1'COMM','    ','WEIB','SHAP','TEST','CDF ','    ','    '/
40193      DATA INFLAV(1109)/2/
40194      DATA INLONG(1109)/'COMMON WEIBULL SHAPE TEST CDF'/
40195C
40196      DATA INCASE(1110)/'WSHP'/
40197      DATA (INAME(1110,J),J=1,MAXSCL)/
40198     1'COMM','    ','WEIB','SHAP','TEST','PVAL','    ','    '/
40199      DATA INFLAV(1110)/2/
40200      DATA INLONG(1110)/'COMMON WEIBULL SHAPE TEST PVALUE'/
40201C
40202      DATA INCASE(1111)/'WS90'/
40203      DATA (INAME(1111,J),J=1,MAXSCL)/
40204     1'COMM','    ','WEIB','SHAP','TEST','CV90','    ','    '/
40205      DATA INFLAV(1111)/2/
40206      DATA INLONG(1111)/'COMMON WEIBULL SHAPE TEST CV90'/
40207C
40208      DATA INCASE(1112)/'WS95'/
40209      DATA (INAME(1112,J),J=1,MAXSCL)/
40210     1'COMM','    ','WEIB','SHAP','TEST','CV95','    ','    '/
40211      DATA INFLAV(1112)/2/
40212      DATA INLONG(1112)/'COMMON WEIBULL SHAPE TEST CV95'/
40213C
40214      DATA INCASE(1113)/'WS99'/
40215      DATA (INAME(1113,J),J=1,MAXSCL)/
40216     1'COMM','    ','WEIB','SHAP','TEST','CV99','    ','    '/
40217      DATA INFLAV(1113)/2/
40218      DATA INLONG(1113)/'COMMON WEIBULL SHAPE TEST CV99'/
40219C
40220      DATA INCASE(1114)/'WSHT'/
40221      DATA (INAME(1114,J),J=1,MAXSCL)/
40222     1'COMM','    ','WEIB','SHAP','TEST','    ','    ','    '/
40223      DATA INFLAV(1114)/2/
40224      DATA INLONG(1114)/'COMMON WEIBULL SHAPE TEST'/
40225C
40226      DATA INCASE(1115)/'WESK'/
40227      DATA (INAME(1115,J),J=1,MAXSCL)/
40228     1'WEIG','    ','SKEW','    ','    ','    ','    ','    '/
40229      DATA INFLAV(1115)/2/
40230      DATA INLONG(1115)/'WEIGHTED SKEWNESS'/
40231C
40232      DATA INCASE(1116)/'KARC'/
40233      DATA (INAME(1116,J),J=1,MAXSCL)/
40234     1'KAPP','    ','R   ','CUTO','    ','    ','    ','    '/
40235      DATA INFLAV(1116)/1/
40236      DATA INLONG(1116)/'KAPPENMMAN R CUTOFF'/
40237C
40238      DATA INCASE(1117)/'KAPR'/
40239      DATA (INAME(1117,J),J=1,MAXSCL)/
40240     1'KAPP','    ','R   ','    ','    ','    ','    ','    '/
40241      DATA INFLAV(1117)/1/
40242      DATA INLONG(1117)/'KAPPENMMAN R'/
40243C
40244      DATA INCASE(1118)/'BCPP'/
40245      DATA (INAME(1118,J),J=1,MAXSCL)/
40246     1'BOX ','    ','COX ','NORM','PPCC','    ','    ','    '/
40247      DATA INFLAV(1118)/1/
40248      DATA INLONG(1118)/'BOX-COX NORMALITY PPCC'/
40249C
40250      DATA INCASE(1119)/'BCLA'/
40251      DATA (INAME(1119,J),J=1,MAXSCL)/
40252     1'BOX ','    ','COX ','NORM','LAMB','    ','    ','    '/
40253      DATA INFLAV(1119)/1/
40254      DATA INLONG(1119)/'BOX-COX NORMALITY LAMBDA'/
40255C
40256      DATA INCASE(1120)/'MEAN'/
40257      DATA (INAME(1120,J),J=1,MAXSCL)/
40258     1'AVER','    ','    ','    ','    ','    ','    ','    '/
40259      DATA INFLAV(1120)/1/
40260      DATA INLONG(1120)/'MEAN'/
40261C
40262      DATA INCASE(1121)/'DMEA'/
40263      DATA (INAME(1121,J),J=1,MAXSCL)/
40264     1'DIFF','    ','OF  ','AVER','    ','    ','    ','    '/
40265      DATA INFLAV(1121)/2/
40266      DATA INLONG(1121)/'DIFFERENCE OF MEANS'/
40267C
40268      DATA INCASE(1122)/'GSKE'/
40269      DATA (INAME(1122,J),J=1,MAXSCL)/
40270     1'GALT','    ','SKEW','    ','    ','    ','    ','    '/
40271      DATA INFLAV(1122)/1/
40272      DATA INLONG(1122)/'GALTON SKEWNESS'/
40273C
40274      DATA INCASE(1123)/'PSK2'/
40275      DATA (INAME(1123,J),J=1,MAXSCL)/
40276     1'PEAR','    ','TWO ','SKEW','    ','    ','    ','    '/
40277      DATA INFLAV(1123)/1/
40278      DATA INLONG(1123)/'PEARSON TWO SKEWNESS'/
40279C
40280      DATA INCASE(1124)/'PSK2'/
40281      DATA (INAME(1124,J),J=1,MAXSCL)/
40282     1'PEAR','    ','2   ','SKEW','    ','    ','    ','    '/
40283      DATA INFLAV(1124)/1/
40284      DATA INLONG(1124)/'PEARSON TWO SKEWNESS'/
40285C
40286      DATA INCASE(1125)/'PSK2'/
40287      DATA (INAME(1125,J),J=1,MAXSCL)/
40288     1'PEAR','    ','TYPE','TWO ','SKEW','    ','    ','    '/
40289      DATA INFLAV(1125)/1/
40290      DATA INLONG(1125)/'PEARSON TWO SKEWNESS'/
40291C
40292      DATA INCASE(1126)/'PSK2'/
40293      DATA (INAME(1126,J),J=1,MAXSCL)/
40294     1'PEAR','    ','TYPE','2   ','SKEW','    ','    ','    '/
40295      DATA INFLAV(1126)/1/
40296      DATA INLONG(1126)/'PEARSON TWO SKEWNESS'/
40297C
40298      DATA INCASE(1127)/'EKUR'/
40299      DATA (INAME(1127,J),J=1,MAXSCL)/
40300     1'EXCE','    ','KURT','    ','    ','    ','    ','    '/
40301      DATA INFLAV(1127)/1/
40302      DATA INLONG(1127)/'EXCESS KURTOSIS'/
40303C
40304      DATA INCASE(1128)/'NADL'/
40305      DATA (INAME(1128,J),J=1,MAXSCL)/
40306     1'NORM','    ','AD  ','LOCA','    ','    ','    ','    '/
40307      DATA INFLAV(1128)/1/
40308      DATA INLONG(1128)/'NORMAL ANDERSON DARLING LOCATION'/
40309C
40310      DATA INCASE(1129)/'NADL'/
40311      DATA (INAME(1129,J),J=1,MAXSCL)/
40312     1'NORM','    ','ANDE','DARL','LOCA','    ','    ','    '/
40313      DATA INFLAV(1129)/1/
40314      DATA INLONG(1129)/'NORMAL ANDERSON DARLING LOCATION'/
40315C
40316      DATA INCASE(1130)/'NADS'/
40317      DATA (INAME(1130,J),J=1,MAXSCL)/
40318     1'NORM','    ','AD  ','SCAL','    ','    ','    ','    '/
40319      DATA INFLAV(1130)/1/
40320      DATA INLONG(1130)/'NORMAL ANDERSON DARLING SCALE'/
40321C
40322      DATA INCASE(1131)/'NADS'/
40323      DATA (INAME(1131,J),J=1,MAXSCL)/
40324     1'NORM','    ','ANDE','DARL','SCAL','    ','    ','    '/
40325      DATA INFLAV(1131)/1/
40326      DATA INLONG(1131)/'NORMAL ANDERSON DARLING SCALE'/
40327C
40328      DATA INCASE(1132)/'NOAD'/
40329      DATA (INAME(1132,J),J=1,MAXSCL)/
40330     1'NORM','    ','AD  ','    ','    ','    ','    ','    '/
40331      DATA INFLAV(1132)/1/
40332      DATA INLONG(1132)/'NORMAL ANDERSON DARLING STATISTIC'/
40333C
40334      DATA INCASE(1133)/'NOAD'/
40335      DATA (INAME(1133,J),J=1,MAXSCL)/
40336     1'NORM','    ','ANDE','DARL','    ','    ','    ','    '/
40337      DATA INFLAV(1133)/1/
40338      DATA INLONG(1133)/'NORMAL ANDERSON DARLING STATISTIC'/
40339C
40340      DATA INCASE(1134)/'EADL'/
40341      DATA (INAME(1134,J),J=1,MAXSCL)/
40342     1'EXPO','    ','AD  ','LOCA','    ','    ','    ','    '/
40343      DATA INFLAV(1134)/1/
40344      DATA INLONG(1134)/'EXPONENTIAL ANDERSON DARLING LOCATION'/
40345C
40346      DATA INCASE(1135)/'EADL'/
40347      DATA (INAME(1135,J),J=1,MAXSCL)/
40348     1'EXPO','    ','ANDE','DARL','LOCA','    ','    ','    '/
40349      DATA INFLAV(1135)/1/
40350      DATA INLONG(1135)/'EXPONENTIAL ANDERSON DARLING LOCATION'/
40351C
40352      DATA INCASE(1136)/'EADS'/
40353      DATA (INAME(1136,J),J=1,MAXSCL)/
40354     1'EXPO','    ','AD  ','SCAL','    ','    ','    ','    '/
40355      DATA INFLAV(1136)/1/
40356      DATA INLONG(1136)/'EXPONENTIAL ANDERSON DARLING SCALE'/
40357C
40358      DATA INCASE(1137)/'EADS'/
40359      DATA (INAME(1137,J),J=1,MAXSCL)/
40360     1'EXPO','    ','ANDE','DARL','SCAL','    ','    ','    '/
40361      DATA INFLAV(1137)/1/
40362      DATA INLONG(1137)/'EXPONENTIAL ANDERSON DARLING SCALE'/
40363C
40364      DATA INCASE(1138)/'EXAD'/
40365      DATA (INAME(1138,J),J=1,MAXSCL)/
40366     1'EXPO','    ','AD  ','    ','    ','    ','    ','    '/
40367      DATA INFLAV(1138)/1/
40368      DATA INLONG(1138)/'EXPONENTIAL ANDERSON DARLING STATISTIC'/
40369C
40370      DATA INCASE(1139)/'EXAD'/
40371      DATA (INAME(1139,J),J=1,MAXSCL)/
40372     1'EXPO','    ','ANDE','DARL','    ','    ','    ','    '/
40373      DATA INFLAV(1139)/1/
40374      DATA INLONG(1139)/'EXPONENTIAL ANDERSON DARLING STATISTIC'/
40375C
40376      DATA INCASE(1140)/'DXAL'/
40377      DATA (INAME(1140,J),J=1,MAXSCL)/
40378     1'DOUB','    ','EXPO','AD  ','LOCA','    ','    ','    '/
40379      DATA INFLAV(1140)/1/
40380      DATA INLONG(1140)/'DOUBLE EXPONENTIAL ANDERSON DARLING LOCATION'/
40381C
40382      DATA INCASE(1141)/'DXAL'/
40383      DATA (INAME(1141,J),J=1,MAXSCL)/
40384     1'DOUB','    ','EXPO','ANDE','DARL','LOCA','    ','    '/
40385      DATA INFLAV(1141)/1/
40386      DATA INLONG(1141)/'DOUBLE EXPONENTIAL ANDERSON DARLING LOCATION'/
40387C
40388      DATA INCASE(1142)/'DXAS'/
40389      DATA (INAME(1142,J),J=1,MAXSCL)/
40390     1'DOUB','    ','EXPO','AD  ','SCAL','    ','    ','    '/
40391      DATA INFLAV(1142)/1/
40392      DATA INLONG(1142)/'DOUBLE EXPONENTIAL ANDERSON DARLING SCALE'/
40393C
40394      DATA INCASE(1143)/'DXAS'/
40395      DATA (INAME(1143,J),J=1,MAXSCL)/
40396     1'DOUB','    ','EXPO','ANDE','DARL','SCAL','    ','    '/
40397      DATA INFLAV(1143)/1/
40398      DATA INLONG(1143)/'DOUBLE EXPONENTIAL ANDERSON DARLING SCALE'/
40399C
40400      DATA INCASE(1144)/'DXAD'/
40401      DATA (INAME(1144,J),J=1,MAXSCL)/
40402     1'DOUB','    ','EXPO','AD  ','    ','    ','    ','    '/
40403      DATA INFLAV(1144)/1/
40404      DATA INLONG(1144)/'DOUBLE EXPONENTIAL ANDERSON DARLING'/
40405C
40406      DATA INCASE(1145)/'DXAD'/
40407      DATA (INAME(1145,J),J=1,MAXSCL)/
40408     1'DOUB','    ','EXPO','ANDE','DARL','    ','    ','    '/
40409      DATA INFLAV(1145)/1/
40410      DATA INLONG(1145)/'DOUBLE EXPONENTIAL ANDERSON DARLING'/
40411C
40412      DATA INCASE(1146)/'DXAL'/
40413      DATA (INAME(1146,J),J=1,MAXSCL)/
40414     1'LAPL','    ','AD  ','LOCA','    ','    ','    ','    '/
40415      DATA INFLAV(1146)/1/
40416      DATA INLONG(1146)/'DOUBLE EXPONENTIAL ANDERSON DARLING LOCATION'/
40417C
40418      DATA INCASE(1147)/'DXAL'/
40419      DATA (INAME(1147,J),J=1,MAXSCL)/
40420     1'LAPL','    ','ANDE','DARL','LOCA','    ','    ','    '/
40421      DATA INFLAV(1147)/1/
40422      DATA INLONG(1147)/'DOUBLE EXPONENTIAL ANDERSON DARLING LOCATION'/
40423C
40424      DATA INCASE(1148)/'DXAS'/
40425      DATA (INAME(1148,J),J=1,MAXSCL)/
40426     1'LAPL','    ','AD  ','SCAL','    ','    ','    ','    '/
40427      DATA INFLAV(1148)/1/
40428      DATA INLONG(1148)/'DOUBLE EXPONENTIAL ANDERSON DARLING SCALE'/
40429C
40430      DATA INCASE(1149)/'DXAS'/
40431      DATA (INAME(1149,J),J=1,MAXSCL)/
40432     1'LAPL','    ','ANDE','DARL','SCAL','    ','    ','    '/
40433      DATA INFLAV(1149)/1/
40434      DATA INLONG(1149)/'DOUBLE EXPONENTIAL ANDERSON DARLING SCALE'/
40435C
40436      DATA INCASE(1150)/'DXAD'/
40437      DATA (INAME(1150,J),J=1,MAXSCL)/
40438     1'LAPL','    ','AD  ','    ','    ','    ','    ','    '/
40439      DATA INFLAV(1150)/1/
40440      DATA INLONG(1150)/'DOUBLE EXPONENTIAL ANDERSON DARLING'/
40441C
40442      DATA INCASE(1151)/'DXAD'/
40443      DATA (INAME(1151,J),J=1,MAXSCL)/
40444     1'LAPL','    ','ANDE','DARL','    ','    ','    ','    '/
40445      DATA INFLAV(1151)/1/
40446      DATA INLONG(1151)/'DOUBLE EXPONENTIAL ANDERSON DARLING'/
40447C
40448      DATA INCASE(1152)/'GUAL'/
40449      DATA (INAME(1152,J),J=1,MAXSCL)/
40450     1'GUMB','    ','AD  ','LOCA','    ','    ','    ','    '/
40451      DATA INFLAV(1152)/1/
40452      DATA INLONG(1152)/'GUMBEL ANDERSON DARLING LOCATION'/
40453C
40454      DATA INCASE(1153)/'GUAL'/
40455      DATA (INAME(1153,J),J=1,MAXSCL)/
40456     1'GUMB','    ','ANDE','DARL','LOCA','    ','    ','    '/
40457      DATA INFLAV(1153)/1/
40458      DATA INLONG(1153)/'GUMBEL ANDERSON DARLING LOCATION'/
40459C
40460      DATA INCASE(1154)/'GUAS'/
40461      DATA (INAME(1154,J),J=1,MAXSCL)/
40462     1'GUMB','    ','AD  ','SCAL','    ','    ','    ','    '/
40463      DATA INFLAV(1154)/1/
40464      DATA INLONG(1154)/'GUMBEL ANDERSON DARLING SCALE'/
40465C
40466      DATA INCASE(1155)/'GUAS'/
40467      DATA (INAME(1155,J),J=1,MAXSCL)/
40468     1'GUMB','    ','ANDE','DARL','SCAL','    ','    ','    '/
40469      DATA INFLAV(1155)/1/
40470      DATA INLONG(1155)/'GUMBEL ANDERSON DARLING SCALE'/
40471C
40472      DATA INCASE(1156)/'GUAD'/
40473      DATA (INAME(1156,J),J=1,MAXSCL)/
40474     1'GUMB','    ','AD  ','    ','    ','    ','    ','    '/
40475      DATA INFLAV(1156)/1/
40476      DATA INLONG(1156)/'GUMBEL ANDERSON DARLING'/
40477C
40478      DATA INCASE(1157)/'GUAD'/
40479      DATA (INAME(1157,J),J=1,MAXSCL)/
40480     1'GUMB','    ','ANDE','DARL','    ','    ','    ','    '/
40481      DATA INFLAV(1157)/1/
40482      DATA INLONG(1157)/'GUMBEL ANDERSON DARLING'/
40483C
40484      DATA INCASE(1158)/'GAAZ'/
40485      DATA (INAME(1158,J),J=1,MAXSCL)/
40486     1'GAMM','    ','AD  ','SHAP','    ','    ','    ','    '/
40487      DATA INFLAV(1158)/1/
40488      DATA INLONG(1158)/'GAMMA ANDERSON DARLING SHAPE'/
40489C
40490      DATA INCASE(1159)/'GAAZ'/
40491      DATA (INAME(1159,J),J=1,MAXSCL)/
40492     1'GAMM','    ','ANDE','DARL','SHAP','    ','    ','    '/
40493      DATA INFLAV(1159)/1/
40494      DATA INLONG(1159)/'GAMMA ANDERSON DARLING SHAPE'/
40495C
40496      DATA INCASE(1160)/'GAAS'/
40497      DATA (INAME(1160,J),J=1,MAXSCL)/
40498     1'GAMM','    ','AD  ','SCAL','    ','    ','    ','    '/
40499      DATA INFLAV(1160)/1/
40500      DATA INLONG(1160)/'GAMMA ANDERSON DARLING SCALE'/
40501C
40502      DATA INCASE(1161)/'GAAS'/
40503      DATA (INAME(1161,J),J=1,MAXSCL)/
40504     1'GAMM','    ','ANDE','DARL','SCAL','    ','    ','    '/
40505      DATA INFLAV(1161)/1/
40506      DATA INLONG(1161)/'GAMMA ANDERSON DARLING SCALE'/
40507C
40508      DATA INCASE(1162)/'GAAD'/
40509      DATA (INAME(1162,J),J=1,MAXSCL)/
40510     1'GAMM','    ','AD  ','STAT','    ','    ','    ','    '/
40511      DATA INFLAV(1162)/1/
40512      DATA INLONG(1162)/'GAMMA ANDERSON DARLING'/
40513C
40514      DATA INCASE(1163)/'GAAD'/
40515      DATA (INAME(1163,J),J=1,MAXSCL)/
40516     1'GAMM','    ','ANDE','DARL','STAT','    ','    ','    '/
40517      DATA INFLAV(1163)/1/
40518      DATA INLONG(1163)/'GAMMA ANDERSON DARLING'/
40519C
40520      DATA INCASE(1164)/'WEAZ'/
40521      DATA (INAME(1164,J),J=1,MAXSCL)/
40522     1'WEIB','    ','AD  ','SHAP','    ','    ','    ','    '/
40523      DATA INFLAV(1164)/1/
40524      DATA INLONG(1164)/'WEIBULL ANDERSON DARLING SHAPE'/
40525C
40526      DATA INCASE(1165)/'WEAZ'/
40527      DATA (INAME(1165,J),J=1,MAXSCL)/
40528     1'WEIB','    ','ANDE','DARL','SHAP','    ','    ','    '/
40529      DATA INFLAV(1165)/1/
40530      DATA INLONG(1165)/'WEIBULL ANDERSON DARLING SHAPE'/
40531C
40532      DATA INCASE(1166)/'WEAS'/
40533      DATA (INAME(1166,J),J=1,MAXSCL)/
40534     1'WEIB','    ','AD  ','SCAL','    ','    ','    ','    '/
40535      DATA INFLAV(1166)/1/
40536      DATA INLONG(1166)/'WEIBULL ANDERSON DARLING SCALE'/
40537C
40538      DATA INCASE(1167)/'WEAS'/
40539      DATA (INAME(1167,J),J=1,MAXSCL)/
40540     1'WEIB','    ','ANDE','DARL','SCAL','    ','    ','    '/
40541      DATA INFLAV(1167)/1/
40542      DATA INLONG(1167)/'WEIBULL ANDERSON DARLING SCALE'/
40543C
40544      DATA INCASE(1168)/'WEAD'/
40545      DATA (INAME(1168,J),J=1,MAXSCL)/
40546     1'WEIB','    ','AD  ','STAT','    ','    ','    ','    '/
40547      DATA INFLAV(1168)/1/
40548      DATA INLONG(1168)/'WEIBULL ANDERSON DARLING'/
40549C
40550      DATA INCASE(1169)/'WEAD'/
40551      DATA (INAME(1169,J),J=1,MAXSCL)/
40552     1'WEIB','    ','ANDE','DARL','STAT','    ','    ','    '/
40553      DATA INFLAV(1169)/1/
40554      DATA INLONG(1169)/'WEIBULL ANDERSON DARLING'/
40555C
40556      DATA INCASE(1170)/'LNAZ'/
40557      DATA (INAME(1170,J),J=1,MAXSCL)/
40558     1'LOGN','    ','AD  ','SHAP','    ','    ','    ','    '/
40559      DATA INFLAV(1170)/1/
40560      DATA INLONG(1170)/'LOGNORMAL ANDERSON DARLING SHAPE'/
40561C
40562      DATA INCASE(1171)/'LNAZ'/
40563      DATA (INAME(1171,J),J=1,MAXSCL)/
40564     1'LOGN','    ','ANDE','DARL','SHAP','    ','    ','    '/
40565      DATA INFLAV(1171)/1/
40566      DATA INLONG(1171)/'LOGNORMAL ANDERSON DARLING SHAPE'/
40567C
40568      DATA INCASE(1172)/'LNAS'/
40569      DATA (INAME(1172,J),J=1,MAXSCL)/
40570     1'LOGN','    ','AD  ','SCAL','    ','    ','    ','    '/
40571      DATA INFLAV(1172)/1/
40572      DATA INLONG(1172)/'LOGNORMAL ANDERSON DARLING SCALE'/
40573C
40574      DATA INCASE(1173)/'LNAS'/
40575      DATA (INAME(1173,J),J=1,MAXSCL)/
40576     1'LOGN','    ','ANDE','DARL','SCAL','    ','    ','    '/
40577      DATA INFLAV(1173)/1/
40578      DATA INLONG(1173)/'LOGNORMAL ANDERSON DARLING SCALE'/
40579C
40580      DATA INCASE(1174)/'LNAD'/
40581      DATA (INAME(1174,J),J=1,MAXSCL)/
40582     1'LOGN','    ','AD  ','STAT','    ','    ','    ','    '/
40583      DATA INFLAV(1174)/1/
40584      DATA INLONG(1174)/'LOGNORMAL ANDERSON DARLING'/
40585C
40586      DATA INCASE(1175)/'LNAD'/
40587      DATA (INAME(1175,J),J=1,MAXSCL)/
40588     1'LOGN','    ','ANDE','DARL','STAT','    ','    ','    '/
40589      DATA INFLAV(1175)/1/
40590      DATA INLONG(1175)/'LOGNORMAL ANDERSON DARLING'/
40591C
40592      DATA INCASE(1176)/'LOAL'/
40593      DATA (INAME(1176,J),J=1,MAXSCL)/
40594     1'LOGI','    ','AD  ','LOCA','    ','    ','    ','    '/
40595      DATA INFLAV(1176)/1/
40596      DATA INLONG(1176)/'LOGISTIC ANDERSON DARLING LOCATION'/
40597C
40598      DATA INCASE(1177)/'LOAL'/
40599      DATA (INAME(1177,J),J=1,MAXSCL)/
40600     1'LOGI','    ','ANDE','DARL','LOCA','    ','    ','    '/
40601      DATA INFLAV(1177)/1/
40602      DATA INLONG(1177)/'LOGISTIC ANDERSON DARLING LOCATION'/
40603C
40604      DATA INCASE(1178)/'LOAS'/
40605      DATA (INAME(1178,J),J=1,MAXSCL)/
40606     1'LOGI','    ','AD  ','SCAL','    ','    ','    ','    '/
40607      DATA INFLAV(1178)/1/
40608      DATA INLONG(1178)/'LOGISTIC ANDERSON DARLING SCALE'/
40609C
40610      DATA INCASE(1179)/'LOAS'/
40611      DATA (INAME(1179,J),J=1,MAXSCL)/
40612     1'LOGI','    ','ANDE','DARL','SCAL','    ','    ','    '/
40613      DATA INFLAV(1179)/1/
40614      DATA INLONG(1179)/'LOGISTIC ANDERSON DARLING SCALE'/
40615C
40616      DATA INCASE(1180)/'LOAD'/
40617      DATA (INAME(1180,J),J=1,MAXSCL)/
40618     1'LOGI','    ','AD  ','    ','    ','    ','    ','    '/
40619      DATA INFLAV(1180)/1/
40620      DATA INLONG(1180)/'LOGISTIC ANDERSON DARLING'/
40621C
40622      DATA INCASE(1181)/'LOAD'/
40623      DATA (INAME(1181,J),J=1,MAXSCL)/
40624     1'LOGI','    ','ANDE','DARL','    ','    ','    ','    '/
40625      DATA INFLAV(1181)/1/
40626      DATA INLONG(1181)/'LOGISTIC ANDERSON DARLING'/
40627C
40628      DATA INCASE(1182)/'UNAL'/
40629      DATA (INAME(1182,J),J=1,MAXSCL)/
40630     1'UNIF','    ','AD  ','LOCA','    ','    ','    ','    '/
40631      DATA INFLAV(1182)/1/
40632      DATA INLONG(1182)/'UNIFORM ANDERSON DARLING LOCATION'/
40633C
40634      DATA INCASE(1183)/'UNAL'/
40635      DATA (INAME(1183,J),J=1,MAXSCL)/
40636     1'UNIF','    ','ANDE','DARL','LOCA','    ','    ','    '/
40637      DATA INFLAV(1183)/1/
40638      DATA INLONG(1183)/'UNIFORM ANDERSON DARLING LOCATION'/
40639C
40640      DATA INCASE(1184)/'UNAS'/
40641      DATA (INAME(1184,J),J=1,MAXSCL)/
40642     1'UNIF','    ','AD  ','SCAL','    ','    ','    ','    '/
40643      DATA INFLAV(1184)/1/
40644      DATA INLONG(1184)/'UNIFORM ANDERSON DARLING SCALE'/
40645C
40646      DATA INCASE(1185)/'UNAS'/
40647      DATA (INAME(1185,J),J=1,MAXSCL)/
40648     1'UNIF','    ','ANDE','DARL','SCAL','    ','    ','    '/
40649      DATA INFLAV(1185)/1/
40650      DATA INLONG(1185)/'UNIFORM ANDERSON DARLING SCALE'/
40651C
40652      DATA INCASE(1186)/'UNAD'/
40653      DATA (INAME(1186,J),J=1,MAXSCL)/
40654     1'UNIF','    ','AD  ','    ','    ','    ','    ','    '/
40655      DATA INFLAV(1186)/1/
40656      DATA INLONG(1186)/'UNIFORM ANDERSON DARLING'/
40657C
40658      DATA INCASE(1187)/'UNAD'/
40659      DATA (INAME(1187,J),J=1,MAXSCL)/
40660     1'UNIF','    ','ANDE','DARL','    ','    ','    ','    '/
40661      DATA INFLAV(1187)/1/
40662      DATA INLONG(1187)/'UNIFORM ANDERSON DARLING'/
40663C
40664      DATA INCASE(1188)/'MXAL'/
40665      DATA (INAME(1188,J),J=1,MAXSCL)/
40666     1'MAXW','    ','AD  ','LOCA','    ','    ','    ','    '/
40667      DATA INFLAV(1188)/1/
40668      DATA INLONG(1188)/'MAXWELL ANDERSON DARLING LOCATION'/
40669C
40670      DATA INCASE(1189)/'MXAL'/
40671      DATA (INAME(1189,J),J=1,MAXSCL)/
40672     1'MAXW','    ','ANDE','DARL','LOCA','    ','    ','    '/
40673      DATA INFLAV(1189)/1/
40674      DATA INLONG(1189)/'MAXWELL ANDERSON DARLING LOCATION'/
40675C
40676      DATA INCASE(1190)/'MXAS'/
40677      DATA (INAME(1190,J),J=1,MAXSCL)/
40678     1'MAXW','    ','AD  ','SCAL','    ','    ','    ','    '/
40679      DATA INFLAV(1190)/1/
40680      DATA INLONG(1190)/'MAXWELL ANDERSON DARLING SCALE'/
40681C
40682      DATA INCASE(1191)/'MXAS'/
40683      DATA (INAME(1191,J),J=1,MAXSCL)/
40684     1'MAXW','    ','ANDE','DARL','SCAL','    ','    ','    '/
40685      DATA INFLAV(1191)/1/
40686      DATA INLONG(1191)/'MAXWELL ANDERSON DARLING SCALE'/
40687C
40688      DATA INCASE(1192)/'MXAD'/
40689      DATA (INAME(1192,J),J=1,MAXSCL)/
40690     1'MAXW','    ','AD  ','    ','    ','    ','    ','    '/
40691      DATA INFLAV(1192)/1/
40692      DATA INLONG(1192)/'MAXWELL ANDERSON DARLING'/
40693C
40694      DATA INCASE(1193)/'MXAD'/
40695      DATA (INAME(1193,J),J=1,MAXSCL)/
40696     1'MAXW','    ','ANDE','DARL','    ','    ','    ','    '/
40697      DATA INFLAV(1193)/1/
40698      DATA INLONG(1193)/'MAXWELL ANDERSON DARLING'/
40699C
40700      DATA INCASE(1194)/'RAAL'/
40701      DATA (INAME(1194,J),J=1,MAXSCL)/
40702     1'RAYL','    ','AD  ','LOCA','    ','    ','    ','    '/
40703      DATA INFLAV(1194)/1/
40704      DATA INLONG(1194)/'RAYLEIGH ANDERSON DARLING LOCATION'/
40705C
40706      DATA INCASE(1195)/'RAAL'/
40707      DATA (INAME(1195,J),J=1,MAXSCL)/
40708     1'RAYL','    ','ANDE','DARL','LOCA','    ','    ','    '/
40709      DATA INFLAV(1195)/1/
40710      DATA INLONG(1195)/'RAYLEIGH ANDERSON DARLING LOCATION'/
40711C
40712      DATA INCASE(1196)/'RAAS'/
40713      DATA (INAME(1196,J),J=1,MAXSCL)/
40714     1'RAYL','    ','AD  ','SCAL','    ','    ','    ','    '/
40715      DATA INFLAV(1196)/1/
40716      DATA INLONG(1196)/'RAYLEIGH ANDERSON DARLING SCALE'/
40717C
40718      DATA INCASE(1197)/'RAAS'/
40719      DATA (INAME(1197,J),J=1,MAXSCL)/
40720     1'RAYL','    ','ANDE','DARL','SCAL','    ','    ','    '/
40721      DATA INFLAV(1197)/1/
40722      DATA INLONG(1197)/'RAYLEIGH ANDERSON DARLING SCALE'/
40723C
40724      DATA INCASE(1198)/'RAAD'/
40725      DATA (INAME(1198,J),J=1,MAXSCL)/
40726     1'RAYL','    ','AD  ','    ','    ','    ','    ','    '/
40727      DATA INFLAV(1198)/1/
40728      DATA INLONG(1198)/'RAYLEIGH ANDERSON DARLING'/
40729C
40730      DATA INCASE(1199)/'RAAD'/
40731      DATA (INAME(1199,J),J=1,MAXSCL)/
40732     1'RAYL','    ','ANDE','DARL','    ','    ','    ','    '/
40733      DATA INFLAV(1199)/1/
40734      DATA INLONG(1199)/'RAYLEIGH ANDERSON DARLING'/
40735C
40736      DATA INCASE(1200)/'FLAZ'/
40737      DATA (INAME(1200,J),J=1,MAXSCL)/
40738     1'FATI','    ','LIFE','AD  ','SHAP','    ','    ','    '/
40739      DATA INFLAV(1200)/1/
40740      DATA INLONG(1200)/'FATIGUE LIFE ANDERSON DARLING SHAPE'/
40741C
40742      DATA INCASE(1201)/'FLAZ'/
40743      DATA (INAME(1201,J),J=1,MAXSCL)/
40744     1'FATI','    ','LIFE','ANDE','DARL','SHAP','    ','    '/
40745      DATA INFLAV(1201)/1/
40746      DATA INLONG(1201)/'FATIGUE LIFE ANDERSON DARLING SHAPE'/
40747C
40748      DATA INCASE(1202)/'FLAS'/
40749      DATA (INAME(1202,J),J=1,MAXSCL)/
40750     1'FATI','    ','LIFE','AD  ','SCAL','    ','    ','    '/
40751      DATA INFLAV(1202)/1/
40752      DATA INLONG(1202)/'FATIGUE LIFE ANDERSON DARLING SCALE'/
40753C
40754      DATA INCASE(1203)/'FLAS'/
40755      DATA (INAME(1203,J),J=1,MAXSCL)/
40756     1'FATI','    ','LIFE','ANDE','DARL','SCAL','    ','    '/
40757      DATA INFLAV(1203)/1/
40758      DATA INLONG(1203)/'FATIGUE LIFE ANDERSON DARLING SCALE'/
40759C
40760      DATA INCASE(1204)/'FLAD'/
40761      DATA (INAME(1204,J),J=1,MAXSCL)/
40762     1'FATI','    ','LIFE','AD  ','STAT','    ','    ','    '/
40763      DATA INFLAV(1204)/1/
40764      DATA INLONG(1204)/'FATIGUE LIFE ANDERSON DARLING'/
40765C
40766      DATA INCASE(1205)/'FLAD'/
40767      DATA (INAME(1205,J),J=1,MAXSCL)/
40768     1'FATI','    ','LIFE','ANDE','DARL','STAT','    ','    '/
40769      DATA INFLAV(1205)/1/
40770      DATA INLONG(1205)/'FATIGUE LIFE ANDERSON DARLING'/
40771C
40772      DATA INCASE(1206)/'FRAZ'/
40773      DATA (INAME(1206,J),J=1,MAXSCL)/
40774     1'FREC','    ','AD  ','SHAP','    ','    ','    ','    '/
40775      DATA INFLAV(1206)/1/
40776      DATA INLONG(1206)/'FRECHET ANDERSON DARLING SHAPE'/
40777C
40778      DATA INCASE(1207)/'FRAZ'/
40779      DATA (INAME(1207,J),J=1,MAXSCL)/
40780     1'FREC','    ','ANDE','DARL','SHAP','    ','    ','    '/
40781      DATA INFLAV(1207)/1/
40782      DATA INLONG(1207)/'FRECHET ANDERSON DARLING SHAPE'/
40783C
40784      DATA INCASE(1208)/'FRAS'/
40785      DATA (INAME(1208,J),J=1,MAXSCL)/
40786     1'FREC','    ','AD  ','SCAL','    ','    ','    ','    '/
40787      DATA INFLAV(1208)/1/
40788      DATA INLONG(1208)/'FRECHET ANDERSON DARLING SCALE'/
40789C
40790      DATA INCASE(1209)/'FRAS'/
40791      DATA (INAME(1209,J),J=1,MAXSCL)/
40792     1'FREC','    ','ANDE','DARL','SCAL','    ','    ','    '/
40793      DATA INFLAV(1209)/1/
40794      DATA INLONG(1209)/'FRECHET ANDERSON DARLING SCALE'/
40795C
40796      DATA INCASE(1210)/'FRAD'/
40797      DATA (INAME(1210,J),J=1,MAXSCL)/
40798     1'FREC','    ','AD  ','STAT','    ','    ','    ','    '/
40799      DATA INFLAV(1210)/1/
40800      DATA INLONG(1210)/'FRECHET ANDERSON DARLING'/
40801C
40802      DATA INCASE(1211)/'FRAD'/
40803      DATA (INAME(1211,J),J=1,MAXSCL)/
40804     1'FREC','    ','ANDE','DARL','STAT','    ','    ','    '/
40805      DATA INFLAV(1211)/1/
40806      DATA INLONG(1211)/'FRECHET ANDERSON DARLING'/
40807C
40808      DATA INCASE(1212)/'LXAZ'/
40809      DATA (INAME(1212,J),J=1,MAXSCL)/
40810     1'LOGI','    ','EXPO','AD  ','SHAP','    ','    ','    '/
40811      DATA INFLAV(1212)/1/
40812      DATA INLONG(1212)/'LOGISTIC EXPONENTIAL ANDERSON DARLING SHAPE'/
40813C
40814      DATA INCASE(1213)/'LXAZ'/
40815      DATA (INAME(1213,J),J=1,MAXSCL)/
40816     1'LOGI','    ','EXPO','ANDE','DARL','SHAP','    ','    '/
40817      DATA INFLAV(1213)/1/
40818      DATA INLONG(1213)/'LOGISTIC EXPONENTIAL ANDERSON DARLING SHAPE'/
40819C
40820      DATA INCASE(1214)/'LXAS'/
40821      DATA (INAME(1214,J),J=1,MAXSCL)/
40822     1'LOGI','    ','EXPO','AD  ','SCAL','    ','    ','    '/
40823      DATA INFLAV(1214)/1/
40824      DATA INLONG(1214)/'LOGISTIC EXPONENTIAL ANDERSON DARLING SCALE'/
40825C
40826      DATA INCASE(1215)/'LXAS'/
40827      DATA (INAME(1215,J),J=1,MAXSCL)/
40828     1'LOGI','    ','EXPO','ANDE','DARL','SCAL','    ','    '/
40829      DATA INFLAV(1215)/1/
40830      DATA INLONG(1215)/'LOGISTIC EXPONENTIAL ANDERSON DARLING SCALE'/
40831C
40832      DATA INCASE(1216)/'LXAD'/
40833      DATA (INAME(1216,J),J=1,MAXSCL)/
40834     1'LOGI','    ','EXPO','AD  ','STAT','    ','    ','    '/
40835      DATA INFLAV(1216)/1/
40836      DATA INLONG(1216)/'LOGISTIC EXPONENTIAL ANDERSON DARLING'/
40837C
40838      DATA INCASE(1217)/'LXAD'/
40839      DATA (INAME(1217,J),J=1,MAXSCL)/
40840     1'LOGI','    ','EXPO','ANDE','DARL','STAT','    ','    '/
40841      DATA INFLAV(1217)/1/
40842      DATA INLONG(1217)/'LOGISTIC EXPONENTIAL ANDERSON DARLING'/
40843C
40844      DATA INCASE(1218)/'IGAZ'/
40845      DATA (INAME(1218,J),J=1,MAXSCL)/
40846     1'INVE','    ','GAMM','AD  ','SHAP','    ','    ','    '/
40847      DATA INFLAV(1218)/1/
40848      DATA INLONG(1218)/'INVERTED GAMMA ANDERSON DARLING SHAPE'/
40849C
40850      DATA INCASE(1219)/'IGAZ'/
40851      DATA (INAME(1219,J),J=1,MAXSCL)/
40852     1'INVE','    ','GAMM','ANDE','DARL','SHAP','    ','    '/
40853      DATA INFLAV(1219)/1/
40854      DATA INLONG(1219)/'INVERTED GAMMA ANDERSON DARLING SHAPE'/
40855C
40856      DATA INCASE(1220)/'IGAS'/
40857      DATA (INAME(1220,J),J=1,MAXSCL)/
40858     1'INVE','    ','GAMM','AD  ','SCAL','    ','    ','    '/
40859      DATA INFLAV(1220)/1/
40860      DATA INLONG(1220)/'INVERTED GAMMA ANDERSON DARLING SCALE'/
40861C
40862      DATA INCASE(1221)/'IGAS'/
40863      DATA (INAME(1221,J),J=1,MAXSCL)/
40864     1'INVE','    ','GAMM','ANDE','DARL','SCAL','    ','    '/
40865      DATA INFLAV(1221)/1/
40866      DATA INLONG(1221)/'INVERTED GAMMA ANDERSON DARLING SCALE'/
40867C
40868      DATA INCASE(1222)/'IGAD'/
40869      DATA (INAME(1222,J),J=1,MAXSCL)/
40870     1'INVE','    ','GAMM','AD  ','STAT','    ','    ','    '/
40871      DATA INFLAV(1222)/1/
40872      DATA INLONG(1222)/'INVERTED GAMMA ANDERSON DARLING'/
40873C
40874      DATA INCASE(1223)/'IGAD'/
40875      DATA (INAME(1223,J),J=1,MAXSCL)/
40876     1'INVE','    ','GAMM','ANDE','DARL','STAT','    ','    '/
40877      DATA INFLAV(1223)/1/
40878      DATA INLONG(1223)/'INVERTED GAMMA ANDERSON DARLING'/
40879C
40880      DATA INCASE(1224)/'B1AZ'/
40881      DATA (INAME(1224,J),J=1,MAXSCL)/
40882     1'BURR','    ','TYPE','10  ','AD  ','SHAP','    ','    '/
40883      DATA INFLAV(1224)/1/
40884      DATA INLONG(1224)/'BURR TYPE 10 ANDERSON DARLING SHAPE'/
40885C
40886      DATA INCASE(1225)/'B1AZ'/
40887      DATA (INAME(1225,J),J=1,MAXSCL)/
40888     1'BURR','    ','TYPE','10  ','ANDE','DARL','SHAP','    '/
40889      DATA INFLAV(1225)/1/
40890      DATA INLONG(1225)/'BURR TYPE 10 ANDERSON DARLING SHAPE'/
40891C
40892      DATA INCASE(1226)/'B1AS'/
40893      DATA (INAME(1226,J),J=1,MAXSCL)/
40894     1'BURR','    ','TYPE','10  ','AD  ','SCAL','    ','    '/
40895      DATA INFLAV(1226)/1/
40896      DATA INLONG(1226)/'BURR TYPE 10 ANDERSON DARLING SCALE'/
40897C
40898      DATA INCASE(1227)/'B1AS'/
40899      DATA (INAME(1227,J),J=1,MAXSCL)/
40900     1'BURR','    ','TYPE','10  ','ANDE','DARL','SCAL','    '/
40901      DATA INFLAV(1227)/1/
40902      DATA INLONG(1227)/'BURR TYPE 10 ANDERSON DARLING SCALE'/
40903C
40904      DATA INCASE(1228)/'B1AD'/
40905      DATA (INAME(1228,J),J=1,MAXSCL)/
40906     1'BURR','    ','TYPE','10  ','AD  ','STAT','    ','    '/
40907      DATA INFLAV(1228)/1/
40908      DATA INLONG(1228)/'BURR TYPE 10 ANDERSON DARLING'/
40909C
40910      DATA INCASE(1229)/'B1AD'/
40911      DATA (INAME(1229,J),J=1,MAXSCL)/
40912     1'BURR','    ','TYPE','10  ','ANDE','DARL','STAT','    '/
40913      DATA INFLAV(1229)/1/
40914      DATA INLONG(1229)/'BURR TYPE 10 ANDERSON DARLING'/
40915C
40916      DATA INCASE(1230)/'GEAZ'/
40917      DATA (INAME(1230,J),J=1,MAXSCL)/
40918     1'GEOM','    ','EXTR','EXPO','AD  ','SHAP','    ','    '/
40919      DATA INFLAV(1230)/1/
40920      DATA INLONG(1230)/'GEOMETRIC EXTR EXPO ANDERSON DARLING SHAPE'/
40921C
40922      DATA INCASE(1231)/'GEAZ'/
40923      DATA (INAME(1231,J),J=1,MAXSCL)/
40924     1'GEOM','    ','EXTR','EXPO','ANDE','DARL','SHAP','    '/
40925      DATA INFLAV(1231)/1/
40926      DATA INLONG(1231)/'GEOMETRIC EXTR EXPO ANDERSON DARLING SHAPE'/
40927C
40928      DATA INCASE(1232)/'GEAS'/
40929      DATA (INAME(1232,J),J=1,MAXSCL)/
40930     1'GEOM','    ','EXTR','EXPO','AD  ','SCAL','    ','    '/
40931      DATA INFLAV(1232)/1/
40932      DATA INLONG(1232)/'GEOMETRIC EXTR EXPO ANDERSON DARLING SCALE'/
40933C
40934      DATA INCASE(1233)/'GEAS'/
40935      DATA (INAME(1233,J),J=1,MAXSCL)/
40936     1'GEOM','    ','EXTR','EXPO','ANDE','DARL','SCAL','    '/
40937      DATA INFLAV(1233)/1/
40938      DATA INLONG(1233)/'GEOMETRIC EXTR EXPO ANDERSON DARLING SCALE'/
40939C
40940      DATA INCASE(1234)/'GEAD'/
40941      DATA (INAME(1234,J),J=1,MAXSCL)/
40942     1'GEOM','    ','EXTR','EXPO','AD  ','STAT','    ','    '/
40943      DATA INFLAV(1234)/1/
40944      DATA INLONG(1234)/'GEOMETRIC EXTR EXPO ANDERSON DARLING'/
40945C
40946      DATA INCASE(1235)/'GEAD'/
40947      DATA (INAME(1235,J),J=1,MAXSCL)/
40948     1'GEOM','    ','EXTR','EXPO','ANDE','DARL','STAT','    '/
40949      DATA INFLAV(1235)/1/
40950      DATA INLONG(1235)/'GEOMETRIC EXTR EXPO ANDERSON DARLING'/
40951C
40952      DATA INCASE(1236)/'GLOC'/
40953      DATA (INAME(1236,J),J=1,MAXSCL)/
40954     1'G   ','    ','PPCC','LOCA','    ','    ','    ','    '/
40955      DATA INFLAV(1236)/1/
40956      DATA INLONG(1236)/'G PPCC LOCATION'/
40957C
40958      DATA INCASE(1237)/'GSCA'/
40959      DATA (INAME(1237,J),J=1,MAXSCL)/
40960     1'G   ','    ','PPCC','SCAL','    ','    ','    ','    '/
40961      DATA INFLAV(1237)/1/
40962      DATA INLONG(1237)/'G PPCC SCALE'/
40963C
40964      DATA INCASE(1238)/'GSHA'/
40965      DATA (INAME(1238,J),J=1,MAXSCL)/
40966     1'G   ','    ','PPCC','SHAP','    ','    ','    ','    '/
40967      DATA INFLAV(1238)/1/
40968      DATA INLONG(1238)/'G PPCC SHAPE (G)'/
40969C
40970      DATA INCASE(1239)/'GSHA'/
40971      DATA (INAME(1239,J),J=1,MAXSCL)/
40972     1'G   ','    ','PPCC','G   ','    ','    ','    ','    '/
40973      DATA INFLAV(1239)/1/
40974      DATA INLONG(1239)/'G PPCC SHAPE (G)'/
40975C
40976      DATA INCASE(1240)/'GPPC'/
40977      DATA (INAME(1240,J),J=1,MAXSCL)/
40978     1'G   ','    ','PPCC','STAT','    ','    ','    ','    '/
40979      DATA INFLAV(1240)/1/
40980      DATA INLONG(1240)/'G PPCC'/
40981C
40982      DATA INCASE(1241)/'JSCO'/
40983      DATA (INAME(1241,J),J=1,MAXSCL)/
40984     1'JSCO','    ','STAT','    ','    ','    ','    ','    '/
40985      DATA INFLAV(1241)/1/
40986      DATA INLONG(1241)/'JSCORE'/
40987C
40988      DATA INCASE(1242)/'ADCD'/
40989      DATA (INAME(1242,J),J=1,MAXSCL)/
40990     1'ADJA','    ','RAND','TEST','CDF ','    ','    ','    '/
40991      DATA INFLAV(1242)/1/
40992      DATA INLONG(1242)/'ADJACENCY RANDOMNESS TEST CDF'/
40993C
40994      DATA INCASE(1243)/'ADPV'/
40995      DATA (INAME(1243,J),J=1,MAXSCL)/
40996     1'ADJA','    ','RAND','TEST','PVAL','    ','    ','    '/
40997      DATA INFLAV(1243)/1/
40998      DATA INLONG(1243)/'ADJACENCY RANDOMNESS TEST P-VALUE'/
40999C
41000      DATA INCASE(1244)/'AD01'/
41001      DATA (INAME(1244,J),J=1,MAXSCL)/
41002     1'ADJA','    ','RAND','TEST','CV01','    ','    ','    '/
41003      DATA INFLAV(1244)/1/
41004      DATA INLONG(1244)/'ADJACENCY RANDOMNESS TEST CV01'/
41005C
41006      DATA INCASE(1245)/'AD05'/
41007      DATA (INAME(1245,J),J=1,MAXSCL)/
41008     1'ADJA','    ','RAND','TEST','CV05','    ','    ','    '/
41009      DATA INFLAV(1245)/1/
41010      DATA INLONG(1245)/'ADJACENCY RANDOMNESS TEST CV05'/
41011C
41012      DATA INCASE(1246)/'AD95'/
41013      DATA (INAME(1246,J),J=1,MAXSCL)/
41014     1'ADJA','    ','RAND','TEST','CV95','    ','    ','    '/
41015      DATA INFLAV(1246)/1/
41016      DATA INLONG(1246)/'ADJACENCY RANDOMNESS TEST CV95'/
41017C
41018      DATA INCASE(1247)/'AD99'/
41019      DATA (INAME(1247,J),J=1,MAXSCL)/
41020     1'ADJA','    ','RAND','TEST','CV99','    ','    ','    '/
41021      DATA INFLAV(1247)/1/
41022      DATA INLONG(1247)/'ADJACENCY RANDOMNESS TEST CV99'/
41023C
41024      DATA INCASE(1248)/'ADRA'/
41025      DATA (INAME(1248,J),J=1,MAXSCL)/
41026     1'ADJA','    ','RAND','TEST','    ','    ','    ','    '/
41027      DATA INFLAV(1248)/1/
41028      DATA INLONG(1248)/'ADJACENCY RANDOMNESS TEST'/
41029C
41030      DATA INCASE(1249)/'ADCD'/
41031      DATA (INAME(1249,J),J=1,MAXSCL)/
41032     1'ADJA','    ','TEST','CDF ','    ','    ','    ','    '/
41033      DATA INFLAV(1249)/1/
41034      DATA INLONG(1249)/'ADJACENCY RANDOMNESS TEST CDF'/
41035C
41036      DATA INCASE(1250)/'ADPV'/
41037      DATA (INAME(1250,J),J=1,MAXSCL)/
41038     1'ADJA','    ','TEST','PVAL','    ','    ','    ','    '/
41039      DATA INFLAV(1250)/1/
41040      DATA INLONG(1250)/'ADJACENCY RANDOMNESS TEST P-VALUE'/
41041C
41042      DATA INCASE(1251)/'AD01'/
41043      DATA (INAME(1251,J),J=1,MAXSCL)/
41044     1'ADJA','    ','TEST','CV01','    ','    ','    ','    '/
41045      DATA INFLAV(1251)/1/
41046      DATA INLONG(1251)/'ADJACENCY RANDOMNESS TEST CV01'/
41047C
41048      DATA INCASE(1252)/'AD05'/
41049      DATA (INAME(1252,J),J=1,MAXSCL)/
41050     1'ADJA','    ','TEST','CV05','    ','    ','    ','    '/
41051      DATA INFLAV(1252)/1/
41052      DATA INLONG(1252)/'ADJACENCY RANDOMNESS TEST CV05'/
41053C
41054      DATA INCASE(1253)/'AD95'/
41055      DATA (INAME(1253,J),J=1,MAXSCL)/
41056     1'ADJA','    ','TEST','CV95','    ','    ','    ','    '/
41057      DATA INFLAV(1253)/1/
41058      DATA INLONG(1253)/'ADJACENCY RANDOMNESS TEST CV95'/
41059C
41060      DATA INCASE(1254)/'AD99'/
41061      DATA (INAME(1254,J),J=1,MAXSCL)/
41062     1'ADJA','    ','TEST','CV99','    ','    ','    ','    '/
41063      DATA INFLAV(1254)/1/
41064      DATA INLONG(1254)/'ADJACENCY RANDOMNESS TEST CV99'/
41065C
41066      DATA INCASE(1255)/'ADRA'/
41067      DATA (INAME(1255,J),J=1,MAXSCL)/
41068     1'ADJA','    ','TEST','    ','    ','    ','    ','    '/
41069      DATA INFLAV(1255)/1/
41070      DATA INLONG(1255)/'ADJACENCY RANDOMNESS TEST'/
41071C
41072      DATA INCASE(1256)/'NPMK'/
41073      DATA (INAME(1256,J),J=1,MAXSCL)/
41074     1'CNPM','K   ','    ','    ','    ','    ','    ','    '/
41075      DATA INFLAV(1256)/1/
41076      DATA INLONG(1256)/'CNPMK'/
41077C
41078      DATA INCASE(1257)/'CNPM'/
41079      DATA (INAME(1257,J),J=1,MAXSCL)/
41080     1'CNPM','    ','    ','    ','    ','    ','    ','    '/
41081      DATA INFLAV(1257)/1/
41082      DATA INLONG(1257)/'CNPM'/
41083C
41084      DATA INCASE(1258)/'CNP '/
41085      DATA (INAME(1258,J),J=1,MAXSCL)/
41086     1'CNP ','    ','    ','    ','    ','    ','    ','    '/
41087      DATA INFLAV(1258)/1/
41088      DATA INLONG(1258)/'CNP'/
41089C
41090      DATA INCASE(1259)/'CPMK'/
41091      DATA (INAME(1259,J),J=1,MAXSCL)/
41092     1'CPMK','    ','    ','    ','    ','    ','    ','    '/
41093      DATA INFLAV(1259)/1/
41094      DATA INLONG(1259)/'CPMK'/
41095C
41096      DATA INCASE(1260)/'CV95'/
41097      DATA (INAME(1260,J),J=1,MAXSCL)/
41098     1'COCH','    ','VARI','OUTL','CV95','    ','    ','    '/
41099      DATA INFLAV(1260)/2/
41100      DATA INLONG(1260)/'COCHRAN VARIANCE OUTLIER CV95'/
41101C
41102      DATA INCASE(1261)/'CV99'/
41103      DATA (INAME(1261,J),J=1,MAXSCL)/
41104     1'COCH','    ','VARI','OUTL','CV99','    ','    ','    '/
41105      DATA INFLAV(1261)/2/
41106      DATA INLONG(1261)/'COCHRAN VARIANCE OUTLIER CV99'/
41107C
41108      DATA INCASE(1262)/'CVCD'/
41109      DATA (INAME(1262,J),J=1,MAXSCL)/
41110     1'COCH','    ','VARI','OUTL','CDF ','    ','    ','    '/
41111      DATA INFLAV(1262)/2/
41112      DATA INLONG(1262)/'COCHRAN VARIANCE OUTLIER CDF'/
41113C
41114      DATA INCASE(1263)/'CVPV'/
41115      DATA (INAME(1263,J),J=1,MAXSCL)/
41116     1'COCH','    ','VARI','OUTL','PVAL','    ','    ','    '/
41117      DATA INFLAV(1263)/2/
41118      DATA INLONG(1263)/'COCHRAN VARIANCE OUTLIER P-VALUE'/
41119C
41120      DATA INCASE(1264)/'CVOT'/
41121      DATA (INAME(1264,J),J=1,MAXSCL)/
41122     1'COCH','    ','VARI','OUTL','TEST','    ','    ','    '/
41123      DATA INFLAV(1264)/2/
41124      DATA INLONG(1264)/'COCHRAN VARIANCE OUTLIER TEST'/
41125C
41126      DATA INCASE(1265)/'CVOT'/
41127      DATA (INAME(1265,J),J=1,MAXSCL)/
41128     1'COCH','    ','VARI','TEST','    ','    ','    ','    '/
41129      DATA INFLAV(1265)/2/
41130      DATA INLONG(1265)/'COCHRAN VARIANCE OUTLIER TEST'/
41131C
41132      DATA INCASE(1266)/'CV05'/
41133      DATA (INAME(1266,J),J=1,MAXSCL)/
41134     1'COCH','    ','MINI','VARI','OUTL','CV05','    ','    '/
41135      DATA INFLAV(1266)/2/
41136      DATA INLONG(1266)/'COCHRAN MINIMUMUM VARIANCE OUTLIER CV05'/
41137C
41138      DATA INCASE(1267)/'CV01'/
41139      DATA (INAME(1267,J),J=1,MAXSCL)/
41140     1'COCH','    ','MINI','VARI','OUTL','CV01','    ','    '/
41141      DATA INFLAV(1267)/2/
41142      DATA INLONG(1267)/'COCHRAN MINIMUM VARIANCE OUTLIER CV01'/
41143C
41144      DATA INCASE(1268)/'CMVC'/
41145      DATA (INAME(1268,J),J=1,MAXSCL)/
41146     1'COCH','    ','MINI','VARI','OUTL','CDF ','    ','    '/
41147      DATA INFLAV(1268)/2/
41148      DATA INLONG(1268)/'COCHRAN MINIMUM VARIANCE OUTLIER CDF'/
41149C
41150      DATA INCASE(1269)/'CMVP'/
41151      DATA (INAME(1269,J),J=1,MAXSCL)/
41152     1'COCH','    ','MINI','VARI','OUTL','PVAL','    ','    '/
41153      DATA INFLAV(1269)/2/
41154      DATA INLONG(1269)/'COCHRAN MINIMUM VARIANCE OUTLIER P-VALUE'/
41155C
41156      DATA INCASE(1270)/'CVMO'/
41157      DATA (INAME(1270,J),J=1,MAXSCL)/
41158     1'COCH','    ','MINI','VARI','OUTL','TEST','    ','    '/
41159      DATA INFLAV(1270)/2/
41160      DATA INLONG(1270)/'COCHRAN VARIANCE OUTLIER TEST'/
41161C
41162      DATA INCASE(1271)/'CVMO'/
41163      DATA (INAME(1271,J),J=1,MAXSCL)/
41164     1'COCH','    ','MINI','VARI','TEST','    ','    ','    '/
41165      DATA INFLAV(1271)/2/
41166      DATA INLONG(1271)/'COCHRAN MINIMUM VARIANCE OUTLIER TEST'/
41167C
41168      DATA INCASE(1272)/'ESCD'/
41169      DATA (INAME(1272,J),J=1,MAXSCL)/
41170     1'EQUA','    ','SLOP','TEST','CDF ','    ','    ','    '/
41171      DATA INFLAV(1272)/3/
41172      DATA INLONG(1272)/'EQUAL SLOPES TEST CDF'/
41173C
41174      DATA INCASE(1273)/'ESCV'/
41175      DATA (INAME(1273,J),J=1,MAXSCL)/
41176     1'EQUA','    ','SLOP','TEST','CRIT','VALU','    ','    '/
41177      DATA INFLAV(1273)/3/
41178      DATA INLONG(1273)/'EQUAL SLOPES TEST CRITICAL VALUE'/
41179C
41180      DATA INCASE(1274)/'ESCV'/
41181      DATA (INAME(1274,J),J=1,MAXSCL)/
41182     1'EQUA','    ','SLOP','TEST','CV95','    ','    ','    '/
41183      DATA INFLAV(1274)/3/
41184      DATA INLONG(1274)/'EQUAL SLOPES TEST CRITICAL VALUE'/
41185C
41186      DATA INCASE(1275)/'ESPV'/
41187      DATA (INAME(1275,J),J=1,MAXSCL)/
41188     1'EQUA','    ','SLOP','TEST','PVAL','    ','    ','    '/
41189      DATA INFLAV(1275)/3/
41190      DATA INLONG(1275)/'EQUAL SLOPES PVALUE'/
41191C
41192      DATA INCASE(1276)/'ESP1'/
41193      DATA (INAME(1276,J),J=1,MAXSCL)/
41194     1'EQUA','    ','SLOP','TEST','ONE ','SIDE','PVAL','    '/
41195      DATA INFLAV(1276)/3/
41196      DATA INLONG(1276)/'EQUAL SLOPES PVALUE'/
41197C
41198      DATA INCASE(1277)/'ESPV'/
41199      DATA (INAME(1277,J),J=1,MAXSCL)/
41200     1'EQUA','    ','SLOP','TEST','P   ','VALU','    ','    '/
41201      DATA INFLAV(1277)/3/
41202      DATA INLONG(1277)/'EQUAL SLOPES TEST PVALUE'/
41203C
41204      DATA INCASE(1278)/'ESP1'/
41205      DATA (INAME(1278,J),J=1,MAXSCL)/
41206     1'EQUA','    ','SLOP','TEST','ONE ','SIDE','P   ','VALU'/
41207      DATA INFLAV(1278)/3/
41208      DATA INLONG(1278)/'EQUAL SLOPES TEST ONE SIDED PVALUE'/
41209C
41210      DATA INCASE(1279)/'ESLO'/
41211      DATA (INAME(1279,J),J=1,MAXSCL)/
41212     1'EQUA','    ','SLOP','TEST','    ','    ','    ','    '/
41213      DATA INFLAV(1279)/3/
41214      DATA INLONG(1279)/'EQUAL SLOPES TEST'/
41215C
41216      DATA INCASE(1280)/'DEKU'/
41217      DATA (INAME(1280,J),J=1,MAXSCL)/
41218     1'DIFF','    ','OF  ','EXCE','KURT','    ','    ','    '/
41219      DATA INFLAV(1280)/2/
41220      DATA INLONG(1280)/'DIFFERENCE OF EXCESS KURTOSIS'/
41221C
41222      DATA INCASE(1281)/'DEKU'/
41223      DATA (INAME(1281,J),J=1,MAXSCL)/
41224     1'DIFF','    ','EXCE','KURT','    ','    ','    ','    '/
41225      DATA INFLAV(1281)/2/
41226      DATA INLONG(1281)/'DIFFERENCE OF EXCESS KURTOSIS'/
41227C
41228      DATA INCASE(1282)/'DKUR'/
41229      DATA (INAME(1282,J),J=1,MAXSCL)/
41230     1'DIFF','    ','KURT','    ','    ','    ','    ','    '/
41231      DATA INFLAV(1282)/2/
41232      DATA INLONG(1282)/'DIFFERENCE OF KURTOSIS'/
41233C
41234      DATA INCASE(1283)/'DINT'/
41235      DATA (INAME(1283,J),J=1,MAXSCL)/
41236     1'DIFF','    ','OF  ','INTE','GRAL','    ','    ','    '/
41237      DATA INFLAV(1283)/2/
41238      DATA INLONG(1283)/'DIFFERENCE OF INTEGRALS'/
41239C
41240      DATA INCASE(1284)/'DINT'/
41241      DATA (INAME(1284,J),J=1,MAXSCL)/
41242     1'DIFF','    ','INTE','    ','    ','    ','    ','    '/
41243      DATA INFLAV(1284)/2/
41244      DATA INLONG(1284)/'DIFFERENCE OF INTEGRALS'/
41245C
41246      DATA INCASE(1285)/'DGSK'/
41247      DATA (INAME(1285,J),J=1,MAXSCL)/
41248     1'DIFF','    ','OF  ','GALT','SKEW','    ','    ','    '/
41249      DATA INFLAV(1285)/2/
41250      DATA INLONG(1285)/'DIFFERENCE OF GALTON SKEWNESS'/
41251C
41252      DATA INCASE(1286)/'DGSK'/
41253      DATA (INAME(1286,J),J=1,MAXSCL)/
41254     1'DIFF','    ','GALT','SKEW','    ','    ','    ','    '/
41255      DATA INFLAV(1286)/2/
41256      DATA INLONG(1286)/'DIFFERENCE OF GALTON SKEWNESS'/
41257C
41258      DATA INCASE(1287)/'DPSK'/
41259      DATA (INAME(1287,J),J=1,MAXSCL)/
41260     1'DIFF','    ','OF  ','PEAR','TWO ','SKEW','    ','    '/
41261      DATA INFLAV(1287)/2/
41262      DATA INLONG(1287)/'DIFFERENCE OF PEARSON SKEWNESS'/
41263C
41264      DATA INCASE(1288)/'DPSK'/
41265      DATA (INAME(1288,J),J=1,MAXSCL)/
41266     1'DIFF','    ','PEAR','TWO ','SKEW','    ','    ','    '/
41267      DATA INFLAV(1288)/2/
41268      DATA INLONG(1288)/'DIFFERENCE OF PEARSON SKEWNESS'/
41269C
41270      DATA INCASE(1289)/'DPSK'/
41271      DATA (INAME(1289,J),J=1,MAXSCL)/
41272     1'DIFF','    ','OF  ','PEAR','2   ','SKEW','    ','    '/
41273      DATA INFLAV(1289)/2/
41274      DATA INLONG(1289)/'DIFFERENCE OF PEARSON SKEWNESS'/
41275C
41276      DATA INCASE(1290)/'DPSK'/
41277      DATA (INAME(1290,J),J=1,MAXSCL)/
41278     1'DIFF','    ','PEAR','2   ','SKEW','    ','    ','    '/
41279      DATA INFLAV(1290)/2/
41280      DATA INLONG(1290)/'DIFFERENCE OF PEARSON SKEWNESS'/
41281C
41282      DATA INCASE(1291)/'MADN'/
41283      DATA (INAME(1291,J),J=1,MAXSCL)/
41284     1'MADN','    ','    ','    ','    ','    ','    ','    '/
41285      DATA INFLAV(1291)/1/
41286      DATA INLONG(1291)/'SCALED MEDIAN ABSOLUTE DEVIATION'/
41287C
41288      DATA INCASE(1292)/'MADN'/
41289      DATA (INAME(1292,J),J=1,MAXSCL)/
41290     1'SCAL','    ','MEDI','ABSO','DEVI','    ','    ','    '/
41291      DATA INFLAV(1292)/1/
41292      DATA INLONG(1292)/'SCALED MEDIAN ABSOLUTE DEVIATION'/
41293C
41294      DATA INCASE(1293)/'MADN'/
41295      DATA (INAME(1293,J),J=1,MAXSCL)/
41296     1'NORM','    ','MEDI','ABSO','DEVI','    ','    ','    '/
41297      DATA INFLAV(1293)/1/
41298      DATA INLONG(1293)/'SCALED MEDIAN ABSOLUTE DEVIATION'/
41299C
41300      DATA INCASE(1294)/'DMAN'/
41301      DATA (INAME(1294,J),J=1,MAXSCL)/
41302     1'DIFF','    ','OF  ','MADN','    ','    ','    ','    '/
41303      DATA INFLAV(1294)/2/
41304      DATA INLONG(1294)/'DIFF OF SCALED MEDIAN ABSOLUTE DEVIATION'/
41305C
41306      DATA INCASE(1295)/'DMAN'/
41307      DATA (INAME(1295,J),J=1,MAXSCL)/
41308     1'DIFF','    ','MADN','    ','    ','    ','    ','    '/
41309      DATA INFLAV(1295)/2/
41310      DATA INLONG(1295)/'DIFF OF SCALED MEDIAN ABSOLUTE DEVIATION'/
41311C
41312      DATA INCASE(1296)/'DMAN'/
41313      DATA (INAME(1296,J),J=1,MAXSCL)/
41314     1'DIFF','    ','OF  ','SCAL','MEDI','ABSO','DEVI','    '/
41315      DATA INFLAV(1296)/2/
41316      DATA INLONG(1296)/'DIFF OF SCALED MEDIAN ABSOLUTE DEVIATION'/
41317C
41318      DATA INCASE(1297)/'DMAN'/
41319      DATA (INAME(1297,J),J=1,MAXSCL)/
41320     1'DIFF','    ','OF  ','NORM','MEDI','ABSO','DEVI','    '/
41321      DATA INFLAV(1297)/2/
41322      DATA INLONG(1297)/'DIFF OF SCALED MEDIAN ABSOLUTE DEVIATION'/
41323C
41324      DATA INCASE(1298)/'DMAN'/
41325      DATA (INAME(1298,J),J=1,MAXSCL)/
41326     1'DIFF','    ','SCAL','MEDI','ABSO','DEVI','    ','    '/
41327      DATA INFLAV(1298)/2/
41328      DATA INLONG(1298)/'DIFF OF SCALED MEDIAN ABSOLUTE DEVIATION'/
41329C
41330      DATA INCASE(1299)/'DMAN'/
41331      DATA (INAME(1299,J),J=1,MAXSCL)/
41332     1'DIFF','    ','NORM','MEDI','ABSO','DEVI','    ','    '/
41333      DATA INFLAV(1299)/2/
41334      DATA INLONG(1299)/'DIFF OF SCALED MEDIAN ABSOLUTE DEVIATION'/
41335C
41336      DATA INCASE(1300)/'IQRA'/
41337      DATA (INAME(1300,J),J=1,MAXSCL)/
41338     1'IQR ','    ','    ','    ','    ','    ','    ','    '/
41339      DATA INFLAV(1300)/1/
41340      DATA INLONG(1300)/'INTERQUARTILE RANGE'/
41341C
41342      DATA INCASE(1301)/'NIQR'/
41343      DATA (INAME(1301,J),J=1,MAXSCL)/
41344     1'NORM','    ','IQR ','    ','    ','    ','    ','    '/
41345      DATA INFLAV(1301)/1/
41346      DATA INLONG(1301)/'NORMALIZED INTERQUARTILE RANGE'/
41347C
41348      DATA INCASE(1302)/'NIQR'/
41349      DATA (INAME(1302,J),J=1,MAXSCL)/
41350     1'SCAL','    ','IQR ','    ','    ','    ','    ','    '/
41351      DATA INFLAV(1302)/1/
41352      DATA INLONG(1302)/'NORMALIZED INTERQUARTILE RANGE'/
41353C
41354      DATA INCASE(1303)/'NIQR'/
41355      DATA (INAME(1303,J),J=1,MAXSCL)/
41356     1'NORM','    ','IQ  ','RANG','    ','    ','    ','    '/
41357      DATA INFLAV(1303)/1/
41358      DATA INLONG(1303)/'NORMALIZED INTERQUARTILE RANGE'/
41359C
41360      DATA INCASE(1304)/'NIQR'/
41361      DATA (INAME(1304,J),J=1,MAXSCL)/
41362     1'SCAL','    ','IQ  ','RANG','    ','    ','    ','    '/
41363      DATA INFLAV(1304)/1/
41364      DATA INLONG(1304)/'NORMALIZED INTERQUARTILE RANGE'/
41365C
41366      DATA INCASE(1305)/'NIQR'/
41367      DATA (INAME(1305,J),J=1,MAXSCL)/
41368     1'NORM','    ','INTE','RANG','    ','    ','    ','    '/
41369      DATA INFLAV(1305)/1/
41370      DATA INLONG(1305)/'INTERQUARTILE RANGE'/
41371C
41372      DATA INCASE(1306)/'NIQR'/
41373      DATA (INAME(1306,J),J=1,MAXSCL)/
41374     1'SCAL','    ','INTE','RANG','    ','    ','    ','    '/
41375      DATA INFLAV(1306)/1/
41376      DATA INLONG(1306)/'INTERQUARTILE RANGE'/
41377C
41378      DATA INCASE(1307)/'DIQR'/
41379      DATA (INAME(1307,J),J=1,MAXSCL)/
41380     1'DIFF','    ','OF  ','IQR ','    ','    ','    ','    '/
41381      DATA INFLAV(1307)/2/
41382      DATA INLONG(1307)/'DIFFERENCE OF INTERQUARTILE RANGES'/
41383C
41384      DATA INCASE(1308)/'DIQR'/
41385      DATA (INAME(1308,J),J=1,MAXSCL)/
41386     1'DIFF','    ','IQR ','    ','    ','    ','    ','    '/
41387      DATA INFLAV(1308)/2/
41388      DATA INLONG(1308)/'DIFFERENCE OF INTERQUARTILE RANGES'/
41389C
41390      DATA INCASE(1309)/'DNIQ'/
41391      DATA (INAME(1309,J),J=1,MAXSCL)/
41392     1'DIFF','    ','NORM','IQR ','    ','    ','    ','    '/
41393      DATA INFLAV(1309)/2/
41394      DATA INLONG(1309)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41395C
41396      DATA INCASE(1310)/'DNIQ'/
41397      DATA (INAME(1310,J),J=1,MAXSCL)/
41398     1'DIFF','    ','SCAL','IQR ','    ','    ','    ','    '/
41399      DATA INFLAV(1310)/2/
41400      DATA INLONG(1310)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41401C
41402      DATA INCASE(1311)/'DNIQ'/
41403      DATA (INAME(1311,J),J=1,MAXSCL)/
41404     1'DIFF','    ','OF  ','NORM','IQR ','    ','    ','    '/
41405      DATA INFLAV(1311)/2/
41406      DATA INLONG(1311)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41407C
41408      DATA INCASE(1312)/'DNIQ'/
41409      DATA (INAME(1312,J),J=1,MAXSCL)/
41410     1'DIFF','    ','OF  ','NORM','IQR ','    ','    ','    '/
41411      DATA INFLAV(1312)/2/
41412      DATA INLONG(1312)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41413C
41414      DATA INCASE(1313)/'DNIQ'/
41415      DATA (INAME(1313,J),J=1,MAXSCL)/
41416     1'DIFF','    ','OF  ','NORM','IQ  ','RANG','    ','    '/
41417      DATA INFLAV(1313)/2/
41418      DATA INLONG(1313)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41419C
41420      DATA INCASE(1314)/'DNIQ'/
41421      DATA (INAME(1314,J),J=1,MAXSCL)/
41422     1'DIFF','    ','OF  ','SCAL','IQ  ','RANG','    ','    '/
41423      DATA INFLAV(1314)/2/
41424      DATA INLONG(1314)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41425C
41426      DATA INCASE(1313)/'DNIQ'/
41427      DATA (INAME(1313,J),J=1,MAXSCL)/
41428     1'DIFF','    ','NORM','IQ  ','RANG','    ','    ','    '/
41429      DATA INFLAV(1313)/2/
41430      DATA INLONG(1313)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41431C
41432      DATA INCASE(1314)/'DNIQ'/
41433      DATA (INAME(1314,J),J=1,MAXSCL)/
41434     1'DIFF','    ','SCAL','IQ  ','RANG','    ','    ','    '/
41435      DATA INFLAV(1314)/2/
41436      DATA INLONG(1314)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41437C
41438      DATA INCASE(1315)/'DNIQ'/
41439      DATA (INAME(1315,J),J=1,MAXSCL)/
41440     1'DIFF','    ','OF  ','NORM','INTE','QUAR','RANG','    '/
41441      DATA INFLAV(1315)/2/
41442      DATA INLONG(1315)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41443C
41444      DATA INCASE(1316)/'DNIQ'/
41445      DATA (INAME(1316,J),J=1,MAXSCL)/
41446     1'DIFF','    ','OF  ','SCAL','INTE','QUAR','RANG','    '/
41447      DATA INFLAV(1316)/2/
41448      DATA INLONG(1316)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41449C
41450      DATA INCASE(1317)/'DNIQ'/
41451      DATA (INAME(1317,J),J=1,MAXSCL)/
41452     1'DIFF','    ','NORM','INTE','QUAR','RANG','    ','    '/
41453      DATA INFLAV(1317)/2/
41454      DATA INLONG(1317)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41455C
41456      DATA INCASE(1318)/'DNIQ'/
41457      DATA (INAME(1318,J),J=1,MAXSCL)/
41458     1'DIFF','    ','SCAL','INTE','QUAR','RANG','    ','    '/
41459      DATA INFLAV(1318)/2/
41460      DATA INLONG(1318)/'DIFFERENCE OF NORMALIZED INTERQUARTILE RANGE'/
41461C
41462      DATA INCASE(1319)/'W2PP'/
41463      DATA (INAME(1319,J),J=1,MAXSCL)/
41464     1'2PAR','    ','WEIB','PPCC','STAT','    ','    ','    '/
41465      DATA INFLAV(1319)/1/
41466      DATA INLONG(1319)/'2-PARAMETER WEIBULL PPCC'/
41467C
41468      DATA INCASE(1320)/'W2SH'/
41469      DATA (INAME(1320,J),J=1,MAXSCL)/
41470     1'2PAR','    ','WEIB','PPCC','SHAP','    ','    ','    '/
41471      DATA INFLAV(1320)/1/
41472      DATA INLONG(1320)/'2-PARAMETER WEIBULL SHAPE'/
41473C
41474      DATA INCASE(1321)/'W2SC'/
41475      DATA (INAME(1321,J),J=1,MAXSCL)/
41476     1'2PAR','    ','WEIB','PPCC','SCAL','    ','    ','    '/
41477      DATA INFLAV(1321)/1/
41478      DATA INLONG(1321)/'2-PARAMETER WEIBULL SCALE'/
41479C
41480      DATA INCASE(1322)/'CVLC'/
41481      DATA (INAME(1322,J),J=1,MAXSCL)/
41482     1'LOWE','    ','COEF','OF  ','VARI','CONF','LIMI','    '/
41483      DATA INFLAV(1322)/1/
41484      DATA INLONG(1322)
41485     1 /'LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41486C
41487      DATA INCASE(1323)/'CVLC'/
41488      DATA (INAME(1323,J),J=1,MAXSCL)/
41489     1'LOWE','    ','COEF','OF  ','VARI','CONF','INTE','    '/
41490      DATA INFLAV(1323)/1/
41491      DATA INLONG(1323)
41492     1 /'LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41493C
41494      DATA INCASE(1324)/'CVUC'/
41495      DATA (INAME(1324,J),J=1,MAXSCL)/
41496     1'UPPE','    ','COEF','OF  ','VARI','CONF','LIMI','    '/
41497      DATA INFLAV(1324)/1/
41498      DATA INLONG(1324)
41499     1 /'UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41500C
41501      DATA INCASE(1325)/'CVUC'/
41502      DATA (INAME(1325,J),J=1,MAXSCL)/
41503     1'UPPE','    ','COEF','OF  ','VARI','CONF','INTE','    '/
41504      DATA INFLAV(1325)/1/
41505      DATA INLONG(1325)
41506     1 /'UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41507C
41508      DATA INCASE(1326)/'CVLO'/
41509      DATA (INAME(1326,J),J=1,MAXSCL)/
41510     1'LOWE','    ','ONES','COEF','OF  ','VARI','CONF','LIMI'/
41511      DATA INFLAV(1326)/1/
41512      DATA INLONG(1326)
41513     1 /'ONE-SIDED LOWER COEF OF VARIATION CONFIDENCE LIMIT'/
41514C
41515      DATA INCASE(1327)/'CVLO'/
41516      DATA (INAME(1327,J),J=1,MAXSCL)/
41517     1'LOWE','    ','ONES','COEF','OF  ','VARI','CONF','INTE'/
41518      DATA INFLAV(1327)/1/
41519      DATA INLONG(1327)
41520     1 /'ONE-SIDED LOWER COEF OF VARIATION CONFIDENCE LIMIT'/
41521C
41522      DATA INCASE(1328)/'CVUO'/
41523      DATA (INAME(1328,J),J=1,MAXSCL)/
41524     1'UPPE','    ','ONES','COEF','OF  ','VARI','CONF','LIMI'/
41525      DATA INFLAV(1328)/1/
41526      DATA INLONG(1328)
41527     1 /'ONE-SIDED UPPER COEF OF VARIATION CONFIDENCE LIMIT'/
41528C
41529      DATA INCASE(1329)/'CVUO'/
41530      DATA (INAME(1329,J),J=1,MAXSCL)/
41531     1'UPPE','    ','ONES','COEF','OF  ','VARI','CONF','INTE'/
41532      DATA INFLAV(1329)/1/
41533      DATA INLONG(1329)
41534     1 /'ONE-SIDED UPPER COEF OF VARIATION CONFIDENCE LIMIT'/
41535C
41536      DATA INCASE(1330)/'SCVL'/
41537      DATA (INAME(1330,J),J=1,MAXSCL)/
41538     1'SUMM','    ','LOWE','COEF','OF  ','VARI','CONF','LIMI'/
41539      DATA INFLAV(1330)/3/
41540      DATA INLONG(1330)
41541     1 /'LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41542C
41543      DATA INCASE(1331)/'SCVL'/
41544      DATA (INAME(1331,J),J=1,MAXSCL)/
41545     1'SUMM','    ','LOWE','COEF','OF  ','VARI','CONF','INTE'/
41546      DATA INFLAV(1331)/3/
41547      DATA INLONG(1331)
41548     1 /'LOWER COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41549C
41550      DATA INCASE(1332)/'SCVU'/
41551      DATA (INAME(1332,J),J=1,MAXSCL)/
41552     1'SUMM','    ','UPPE','COEF','OF  ','VARI','CONF','LIMI'/
41553      DATA INFLAV(1332)/3/
41554      DATA INLONG(1332)
41555     1 /'UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41556C
41557      DATA INCASE(1333)/'SCVU'/
41558      DATA (INAME(1333,J),J=1,MAXSCL)/
41559     1'SUMM','    ','UPPE','COEF','OF  ','VARI','CONF','INTE'/
41560      DATA INFLAV(1333)/3/
41561      DATA INLONG(1333)
41562     1 /'UPPER COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41563C
41564      DATA INCASE(1334)/'SCVA'/
41565      DATA (INAME(1334,J),J=1,MAXSCL)/
41566     1'SUMM','    ','COEF','OF  ','VARI','    ','    ','    '/
41567      DATA INFLAV(1334)/2/
41568      DATA INLONG(1334)
41569     1 /'COEFFICIENT OF VARIATION'/
41570C
41571      DATA INCASE(1335)/'UCVA'/
41572      DATA (INAME(1335,J),J=1,MAXSCL)/
41573     1'UNBI','    ','COEF','OF  ','VARI','    ','    ','    '/
41574      DATA INFLAV(1335)/1/
41575      DATA INLONG(1335)
41576     1 /'UNBIASED COEFFICIENT OF VARIATION'/
41577C
41578      DATA INCASE(1336)/'SNRA'/
41579      DATA (INAME(1336,J),J=1,MAXSCL)/
41580     1'SIGN','    ','TO  ','NOIS','RATI','    ','    ','    '/
41581      DATA INFLAV(1336)/1/
41582      DATA INLONG(1336)
41583     1 /'SIGNAL TO NOISE RATIO'/
41584C
41585      DATA INCASE(1337)/'QCDI'/
41586      DATA (INAME(1337,J),J=1,MAXSCL)/
41587     1'QUAR','    ','COEF','OF  ','DISP','    ','    ','    '/
41588      DATA INFLAV(1337)/1/
41589      DATA INLONG(1337)
41590     1 /'QUARTILE COEFFICIENT OF DISPERSION'/
41591C
41592      DATA INCASE(1338)/'LLCV'/
41593      DATA (INAME(1338,J),J=1,MAXSCL)/
41594     1'LOWE','    ','LOGN','COEF','OF  ','VARI','CONF','LIMI'/
41595      DATA INFLAV(1338)/1/
41596      DATA INLONG(1338)
41597     1 /'LOWER LOGNORMAL COEFFICENT OF VARIATION CONFIDENCE LIMIT'/
41598C
41599      DATA INCASE(1339)/'LLCV'/
41600      DATA (INAME(1339,J),J=1,MAXSCL)/
41601     1'LOWE','    ','LOGN','COEF','OF  ','VARI','CONF','INTE'/
41602      DATA INFLAV(1339)/1/
41603      DATA INLONG(1339)
41604     1 /'LOWER LOGNORMAL COEFFICENT OF VARIATION CONFIDENCE LIMIT'/
41605C
41606      DATA INCASE(1340)/'ULCV'/
41607      DATA (INAME(1340,J),J=1,MAXSCL)/
41608     1'UPPE','    ','LOGN','COEF','OF  ','VARI','CONF','LIMI'/
41609      DATA INFLAV(1340)/1/
41610      DATA INLONG(1340)
41611     1 /'UPPER LOGNORMAL COEFFICENT OF VARIATION CONFIDENCE LIMIT'/
41612C
41613      DATA INCASE(1341)/'ULCV'/
41614      DATA (INAME(1341,J),J=1,MAXSCL)/
41615     1'UPPE','    ','LOGN','COEF','OF  ','VARI','CONF','INTE'/
41616      DATA INFLAV(1341)/1/
41617      DATA INLONG(1341)
41618     1 /'UPPER LOGNORMAL COEFFICENT OF VARIATION CONFIDENCE LIMIT'/
41619C
41620      DATA INCASE(1342)/'LCVA'/
41621      DATA (INAME(1342,J),J=1,MAXSCL)/
41622     1'LOGN','    ','COEF','OF  ','VARI','    ','    ','    '/
41623      DATA INFLAV(1342)/1/
41624      DATA INLONG(1342)
41625     1 /'LOGNORMAL COEFFICIENT OF VARIATION'/
41626C
41627      DATA INCASE(1343)/'SNRA'/
41628      DATA (INAME(1343,J),J=1,MAXSCL)/
41629     1'SNR ','    ','    ','    ','    ','    ','    ','    '/
41630      DATA INFLAV(1343)/1/
41631      DATA INLONG(1343)
41632     1 /'SIGNAL TO NOISE RATIO'/
41633C
41634      DATA INCASE(1344)/'PREC'/
41635      DATA (INAME(1344,J),J=1,MAXSCL)/
41636     1'PREC','    ','    ','    ','    ','    ','    ','    '/
41637      DATA INFLAV(1344)/1/
41638      DATA INLONG(1344)
41639     1 /'PRECISION'/
41640C
41641      DATA INCASE(1345)/'CCVA'/
41642      DATA (INAME(1345,J),J=1,MAXSCL)/
41643     1'COMM','    ','COEF','OF  ','VARI','    ','    ','    '/
41644      DATA INFLAV(1345)/2/
41645      DATA INLONG(1345)
41646     1 /'COMMON COEFFICIENT OF VARIATION'/
41647C
41648      DATA INCASE(1346)/'UCCV'/
41649      DATA (INAME(1346,J),J=1,MAXSCL)/
41650     1'COMM','    ','BIAS','CORR','COEF','OF  ','VARI','    '/
41651      DATA INFLAV(1346)/2/
41652      DATA INLONG(1346)
41653     1 /'COMMON BIAS CORRECTED COEFFICIENT OF VARIATION'/
41654C
41655      DATA INCASE(1347)/'LCCV'/
41656      DATA (INAME(1347,J),J=1,MAXSCL)/
41657     1'LOWE','    ','COMM','COEF','OF  ','VARI','CONF','LIMI'/
41658      DATA INFLAV(1347)/2/
41659      DATA INLONG(1347)
41660     1 /'LOWER COMMON COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41661C
41662      DATA INCASE(1348)/'UCC2'/
41663      DATA (INAME(1348,J),J=1,MAXSCL)/
41664     1'UPPE','    ','COMM','COEF','OF  ','VARI','CONF','LIMI'/
41665      DATA INFLAV(1348)/2/
41666      DATA INLONG(1348)
41667     1 /'UPPER COMMON COEFFICIENT OF VARIATION CONFIDENCE LIMIT'/
41668C
41669      DATA INCASE(1349)/'QCDI'/
41670      DATA (INAME(1349,J),J=1,MAXSCL)/
41671     1'QCD ','    ','    ','    ','    ','    ','    ','    '/
41672      DATA INFLAV(1349)/1/
41673      DATA INLONG(1349)
41674     1 /'QUARTILE COEFFICIENT OF DISPERSION'/
41675C
41676      DATA INCASE(1350)/'CDIS'/
41677      DATA (INAME(1350,J),J=1,MAXSCL)/
41678     1'COEF','    ','OF  ','DISP','    ','    ','    ','    '/
41679      DATA INFLAV(1350)/1/
41680      DATA INLONG(1350)
41681     1 /'COEFFICIENT OF DISPERSION'/
41682C
41683      DATA INCASE(1351)/'IDIS'/
41684      DATA (INAME(1351,J),J=1,MAXSCL)/
41685     1'INDE','    ','OF  ','DISP','    ','    ','    ','    '/
41686      DATA INFLAV(1351)/1/
41687      DATA INLONG(1351)
41688     1 /'INDEX OF DISPERSION'/
41689C
41690      DATA INCASE(1352)/'AAD '/
41691      DATA (INAME(1352,J),J=1,MAXSCL)/
41692     1'AAD ','    ','    ','    ','    ','    ','    ','    '/
41693      DATA INFLAV(1352)/1/
41694      DATA INLONG(1352)/'AVERAGE ABSOLUTE DEVIATION'/
41695C
41696      DATA INCASE(1353)/'SHMM'/
41697      DATA (INAME(1353,J),J=1,MAXSCL)/
41698     1'SHOR','    ','HALF','MIDM','    ','    ','    ','    '/
41699      DATA INFLAV(1353)/1/
41700      DATA INLONG(1353)/'SHORTEST HALF MIDMEAN'/
41701C
41702      DATA INCASE(1354)/'SHMM'/
41703      DATA (INAME(1354,J),J=1,MAXSCL)/
41704     1'SHOR','    ','HALF','MID ','MEAN','    ','    ','    '/
41705      DATA INFLAV(1354)/1/
41706      DATA INLONG(1354)/'SHORTEST HALF MIDMEAN'/
41707C
41708      DATA INCASE(1355)/'SHMR'/
41709      DATA (INAME(1355,J),J=1,MAXSCL)/
41710     1'SHOR','    ','HALF','MIDR','    ','    ','    ','    '/
41711      DATA INFLAV(1355)/1/
41712      DATA INLONG(1355)/'SHORTEST HALF MIDRANGE'/
41713C
41714      DATA INCASE(1356)/'SHMR'/
41715      DATA (INAME(1356,J),J=1,MAXSCL)/
41716     1'SHOR','    ','HALF','MID ','RANG','    ','    ','    '/
41717      DATA INFLAV(1356)/1/
41718      DATA INLONG(1356)/'SHORTEST HALF MIDRANGE'/
41719C
41720      DATA INCASE(1357)/'COSD'/
41721      DATA (INAME(1357,J),J=1,MAXSCL)/
41722     1'COSI','    ','DIST','    ','    ','    ','    ','    '/
41723      DATA INFLAV(1357)/2/
41724      DATA INLONG(1357)/'COSINE DISTANCE'/
41725C
41726      DATA INCASE(1358)/'COSS'/
41727      DATA (INAME(1358,J),J=1,MAXSCL)/
41728     1'COSI','    ','SIMI','    ','    ','    ','    ','    '/
41729      DATA INFLAV(1358)/2/
41730      DATA INLONG(1358)/'COSINE SIMILARITY'/
41731C
41732      DATA INCASE(1359)/'ACOD'/
41733      DATA (INAME(1359,J),J=1,MAXSCL)/
41734     1'ANGU','    ','COSI','DIST','    ','    ','    ','    '/
41735      DATA INFLAV(1359)/2/
41736      DATA INLONG(1359)/'ANGULAR COSINE DISTANCE'/
41737C
41738      DATA INCASE(1360)/'ACOS'/
41739      DATA (INAME(1360,J),J=1,MAXSCL)/
41740     1'ANGU','    ','COSI','SIMI','    ','    ','    ','    '/
41741      DATA INFLAV(1360)/2/
41742      DATA INLONG(1360)/'ANGULAR COSINE SIMILARITY'/
41743C
41744      DATA INCASE(1361)/'EUCD'/
41745      DATA (INAME(1361,J),J=1,MAXSCL)/
41746     1'EUCL','    ','DIST','    ','    ','    ','    ','    '/
41747      DATA INFLAV(1361)/2/
41748      DATA INLONG(1361)/'EUCLIDEAN DISTANCE'/
41749C
41750      DATA INCASE(1362)/'EUCL'/
41751      DATA (INAME(1362,J),J=1,MAXSCL)/
41752     1'EUCL','    ','LENG','    ','    ','    ','    ','    '/
41753      DATA INFLAV(1362)/1/
41754      DATA INLONG(1362)/'EUCLIDEAN LENGTH'/
41755C
41756      DATA INCASE(1363)/'DOTP'/
41757      DATA (INAME(1363,J),J=1,MAXSCL)/
41758     1'DOT ','    ','PROD','    ','    ','    ','    ','    '/
41759      DATA INFLAV(1363)/2/
41760      DATA INLONG(1363)/'DOT PRODUCT'/
41761C
41762      DATA INCASE(1364)/'MAND'/
41763      DATA (INAME(1364,J),J=1,MAXSCL)/
41764     1'MANH','    ','DIST','    ','    ','    ','    ','    '/
41765      DATA INFLAV(1364)/2/
41766      DATA INLONG(1364)/'MANHATTAN DISTANCE'/
41767C
41768      DATA INCASE(1365)/'DPRE'/
41769      DATA (INAME(1365,J),J=1,MAXSCL)/
41770     1'DIFF','    ','OF  ','PREC','    ','    ','    ','    '/
41771      DATA INFLAV(1365)/2/
41772      DATA INLONG(1365)/'DIFFERENCE OF PRECISION'/
41773C
41774      DATA INCASE(1366)/'DPRE'/
41775      DATA (INAME(1366,J),J=1,MAXSCL)/
41776     1'DIFF','    ','PREC','    ','    ','    ','    ','    '/
41777      DATA INFLAV(1366)/2/
41778      DATA INLONG(1366)/'DIFFERENCE OF PRECISION'/
41779C
41780      DATA INCASE(1367)/'DSNR'/
41781      DATA (INAME(1367,J),J=1,MAXSCL)/
41782     1'DIFF','    ','OF  ','SNR ','    ','    ','    ','    '/
41783      DATA INFLAV(1367)/2/
41784      DATA INLONG(1367)/'DIFFERENCE OF SNR'/
41785C
41786      DATA INCASE(1368)/'DSNR'/
41787      DATA (INAME(1368,J),J=1,MAXSCL)/
41788     1'DIFF','    ','SNR ','    ','    ','    ','    ','    '/
41789      DATA INFLAV(1368)/2/
41790      DATA INLONG(1368)/'DIFFERENCE OF SNR'/
41791C
41792      DATA INCASE(1369)/'DSNR'/
41793      DATA (INAME(1369,J),J=1,MAXSCL)/
41794     1'DIFF','    ','OF  ','SIGN','TO  ','NOIS','RATI','    '/
41795      DATA INFLAV(1369)/2/
41796      DATA INLONG(1369)/'DIFFERENCE OF SNR'/
41797C
41798      DATA INCASE(1370)/'DSNR'/
41799      DATA (INAME(1370,J),J=1,MAXSCL)/
41800     1'DIFF','    ','SIGN','TO  ','NOIS','RATI','    ','    '/
41801      DATA INFLAV(1370)/2/
41802      DATA INLONG(1370)/'DIFFERENCE OF SNR'/
41803C
41804      DATA INCASE(1371)/'1CCD'/
41805      DATA (INAME(1371,J),J=1,MAXSCL)/
41806     1'ONE ','    ','SAMP','COEF','OF  ','VARI','TEST','CDF '/
41807      DATA INFLAV(1371)/2/
41808      DATA INLONG(1371)/'ONE SAMPLE COEFFICIENT OF VARIATION TEST CDF'/
41809C
41810      DATA INCASE(1372)/'1C2P'/
41811      DATA (INAME(1372,J),J=1,MAXSCL)/
41812     1'ONE ','    ','SAMP','COEF','OF  ','VARI','TEST','PVAL'/
41813      DATA INFLAV(1372)/2/
41814      DATA INLONG(1372)/'ONE SAMPLE COEFFICIENT OF VARIATION P-VALUE'/
41815C
41816      DATA INCASE(1373)/'1CLP'/
41817      DATA (INAME(1373,J),J=1,MAXSCL)/
41818     1'ONE ','    ','SAMP','COEF','OF  ','VARI','LOWE','PVAL'/
41819      DATA INFLAV(1373)/2/
41820      DATA INLONG(1373)
41821     1     /'ONE SAMPLE COEFFICIENT OF VARIATION LOWER P-VALUE'/
41822C
41823      DATA INCASE(1374)/'1CUP'/
41824      DATA (INAME(1374,J),J=1,MAXSCL)/
41825     1'ONE ','    ','SAMP','COEF','OF  ','VARI','UPPE','PVAL'/
41826      DATA INFLAV(1374)/2/
41827      DATA INLONG(1374)
41828     1     /'ONE SAMPLE COEFFICIENT OF VARIATION UPPER P-VALUE'/
41829C
41830      DATA INCASE(1375)/'1CCD'/
41831      DATA (INAME(1375,J),J=1,MAXSCL)/
41832     1'1   ','    ','SAMP','COEF','OF  ','VARI','TEST','CDF '/
41833      DATA INFLAV(1375)/2/
41834      DATA INLONG(1375)/'ONE SAMPLE COEFFICIENT OF VARIATION TEST CDF'/
41835C
41836      DATA INCASE(1376)/'1C2P'/
41837      DATA (INAME(1376,J),J=1,MAXSCL)/
41838     1'1   ','    ','SAMP','COEF','OF  ','VARI','TEST','PVAL'/
41839      DATA INFLAV(1376)/2/
41840      DATA INLONG(1376)/'ONE SAMPLE COEFFICIENT OF VARIATION P-VALUE'/
41841C
41842      DATA INCASE(1377)/'1CLP'/
41843      DATA (INAME(1377,J),J=1,MAXSCL)/
41844     1'1   ','    ','SAMP','COEF','OF  ','VARI','LOWE','PVAL'/
41845      DATA INFLAV(1377)/2/
41846      DATA INLONG(1377)
41847     1     /'ONE SAMPLE COEFFICIENT OF VARIATION LOWER P-VALUE'/
41848C
41849      DATA INCASE(1378)/'1CUP'/
41850      DATA (INAME(1378,J),J=1,MAXSCL)/
41851     1'ONE ','    ','SAMP','COEF','OF  ','VARI','UPPE','PVAL'/
41852      DATA INFLAV(1378)/2/
41853      DATA INLONG(1378)
41854     1     /'ONE SAMPLE COEFFICIENT OF VARIATION UPPER P-VALUE'/
41855C
41856      DATA INCASE(1379)/'1CTE'/
41857      DATA (INAME(1379,J),J=1,MAXSCL)/
41858     1'ONE ','    ','SAMP','COEF','OF  ','VARI','TEST','    '/
41859      DATA INFLAV(1379)/2/
41860      DATA INLONG(1379)/'ONE SAMPLE COEFFICIENT OF VARIATION TEST'/
41861C
41862      DATA INCASE(1380)/'1CTE'/
41863      DATA (INAME(1380,J),J=1,MAXSCL)/
41864     1'1   ','    ','SAMP','COEF','OF  ','VARI','TEST','    '/
41865      DATA INFLAV(1380)/2/
41866      DATA INLONG(1380)/'ONE SAMPLE COEFFICIENT OF VARIATION TEST'/
41867C
41868      DATA INCASE(1381)/'S1CT'/
41869      DATA (INAME(1381,J),J=1,MAXSCL)/
41870     1'SUMM','    ','ONE ','SAMP','COEF','OF  ','VARI','TEST'/
41871      DATA INFLAV(1381)/3/
41872      DATA INLONG(1381)
41873     1  /'SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION TEST'/
41874C
41875      DATA INCASE(1382)/'S1CT'/
41876      DATA (INAME(1382,J),J=1,MAXSCL)/
41877     1'SUMM','    ','1   ','SAMP','COEF','OF  ','VARI','TEST'/
41878      DATA INFLAV(1382)/3/
41879      DATA INLONG(1382)
41880     1  /'SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION TEST'/
41881C
41882      DATA INCASE(1383)/'S1CC'/
41883      DATA (INAME(1383,J),J=1,MAXSCL)/
41884     1'SUMM','    ','ONE ','SAMP','COEF','OF  ','VARI','CDF '/
41885      DATA INFLAV(1383)/3/
41886      DATA INLONG(1383)
41887     1  /'SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION CDF VALUE'/
41888C
41889      DATA INCASE(1384)/'S1CC'/
41890      DATA (INAME(1384,J),J=1,MAXSCL)/
41891     1'SUMM','    ','1   ','SAMP','COEF','OF  ','VARI','CDF '/
41892      DATA INFLAV(1384)/3/
41893      DATA INLONG(1384)
41894     1  /'SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION CDF VALUE'/
41895C
41896      DATA INCASE(1385)/'S1CP'/
41897      DATA (INAME(1385,J),J=1,MAXSCL)/
41898     1'SUMM','    ','ONE ','SAMP','COEF','OF  ','VARI','PVAL'/
41899      DATA INFLAV(1385)/3/
41900      DATA INLONG(1385)
41901     1  /'SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION P-VALUE'/
41902C
41903      DATA INCASE(1386)/'S1CP'/
41904      DATA (INAME(1386,J),J=1,MAXSCL)/
41905     1'SUMM','    ','1   ','SAMP','COEF','OF  ','VARI','PVAL'/
41906      DATA INFLAV(1386)/3/
41907      DATA INLONG(1386)
41908     1  /'SUMMARY ONE SAMPLE COEFFICIENT OF VARIATION P-VALUE'/
41909C
41910      DATA INCASE(1387)/'2CCD'/
41911      DATA (INAME(1387,J),J=1,MAXSCL)/
41912     1'TWO ','    ','SAMP','COEF','OF  ','VARI','TEST','CDF '/
41913      DATA INFLAV(1387)/2/
41914      DATA INLONG(1387)/'TWO SAMPLE COEFFICIENT OF VARIATION TEST CDF'/
41915C
41916      DATA INCASE(1388)/'2C2P'/
41917      DATA (INAME(1388,J),J=1,MAXSCL)/
41918     1'TWO ','    ','SAMP','COEF','OF  ','VARI','TEST','PVAL'/
41919      DATA INFLAV(1388)/2/
41920      DATA INLONG(1388)/'TWO SAMPLE COEFFICIENT OF VARIATION P-VALUE'/
41921C
41922      DATA INCASE(1389)/'2CLP'/
41923      DATA (INAME(1389,J),J=1,MAXSCL)/
41924     1'TWO ','    ','SAMP','COEF','OF  ','VARI','LOWE','PVAL'/
41925      DATA INFLAV(1389)/2/
41926      DATA INLONG(1389)
41927     1     /'TWO SAMPLE COEFFICIENT OF VARIATION LOWER P-VALUE'/
41928C
41929      DATA INCASE(1390)/'2CUP'/
41930      DATA (INAME(1390,J),J=1,MAXSCL)/
41931     1'TWO ','    ','SAMP','COEF','OF  ','VARI','UPPE','PVAL'/
41932      DATA INFLAV(1390)/2/
41933      DATA INLONG(1390)
41934     1     /'TWO SAMPLE COEFFICIENT OF VARIATION UPPER P-VALUE'/
41935C
41936      DATA INCASE(1391)/'2CCD'/
41937      DATA (INAME(1391,J),J=1,MAXSCL)/
41938     1'2   ','    ','SAMP','COEF','OF  ','VARI','TEST','CDF '/
41939      DATA INFLAV(1391)/2/
41940      DATA INLONG(1391)/'TWO SAMPLE COEFFICIENT OF VARIATION TEST CDF'/
41941C
41942      DATA INCASE(1392)/'2C2P'/
41943      DATA (INAME(1392,J),J=1,MAXSCL)/
41944     1'2   ','    ','SAMP','COEF','OF  ','VARI','TEST','PVAL'/
41945      DATA INFLAV(1392)/2/
41946      DATA INLONG(1392)/'TWO SAMPLE COEFFICIENT OF VARIATION P-VALUE'/
41947C
41948      DATA INCASE(1393)/'2CLP'/
41949      DATA (INAME(1393,J),J=1,MAXSCL)/
41950     1'2   ','    ','SAMP','COEF','OF  ','VARI','LOWE','PVAL'/
41951      DATA INFLAV(1393)/2/
41952      DATA INLONG(1393)
41953     1     /'TWO SAMPLE COEFFICIENT OF VARIATION LOWER P-VALUE'/
41954C
41955      DATA INCASE(1394)/'2CUP'/
41956      DATA (INAME(1394,J),J=1,MAXSCL)/
41957     1'TWO ','    ','SAMP','COEF','OF  ','VARI','UPPE','PVAL'/
41958      DATA INFLAV(1394)/2/
41959      DATA INLONG(1394)
41960     1     /'TWO SAMPLE COEFFICIENT OF VARIATION UPPER P-VALUE'/
41961C
41962      DATA INCASE(1395)/'2CTE'/
41963      DATA (INAME(1395,J),J=1,MAXSCL)/
41964     1'TWO ','    ','SAMP','COEF','OF  ','VARI','TEST','    '/
41965      DATA INFLAV(1395)/2/
41966      DATA INLONG(1395)/'TWO SAMPLE COEFFICIENT OF VARIATION TEST'/
41967C
41968      DATA INCASE(1396)/'2CTE'/
41969      DATA (INAME(1396,J),J=1,MAXSCL)/
41970     1'2   ','    ','SAMP','COEF','OF  ','VARI','TEST','    '/
41971      DATA INFLAV(1396)/2/
41972      DATA INLONG(1396)/'TWO SAMPLE COEFFICIENT OF VARIATION TEST'/
41973C
41974      DATA INCASE(1397)/'DCDI'/
41975      DATA (INAME(1397,J),J=1,MAXSCL)/
41976     1'DIFF','    ','OF  ','COEF','OF  ','DISP','    ','    '/
41977      DATA INFLAV(1397)/2/
41978      DATA INLONG(1397)/'DIFFERENCE OF COEFFICIENT OF DISPERSION'/
41979C
41980      DATA INCASE(1398)/'DIDI'/
41981      DATA (INAME(1398,J),J=1,MAXSCL)/
41982     1'DIFF','    ','OF  ','INDE','OF  ','DISP','    ','    '/
41983      DATA INFLAV(1398)/2/
41984      DATA INLONG(1398)/'DIFFERENCE OF INDEX OF DISPERSION'/
41985C
41986      DATA INCASE(1399)/'DQDI'/
41987      DATA (INAME(1399,J),J=1,MAXSCL)/
41988     1'DIFF','    ','OF  ','QUAR','COEF','OF  ','DISP','    '/
41989      DATA INFLAV(1399)/2/
41990      DATA INLONG(1399)/
41991     1     'DIFFERENCE OF QuARTILE COEFFICIENT OF DISPERSION'/
41992C
41993      DATA INCASE(1400)/'DAAD'/
41994      DATA (INAME(1400,J),J=1,MAXSCL)/
41995     1'DIFF','    ','OF  ','AAD ','    ','    ','    ','    '/
41996      DATA INFLAV(1400)/2/
41997      DATA INLONG(1400)/'DIFFERENCE OF AVERAGE ABSOLUTE DEVIATIONS'/
41998C
41999      DATA INCASE(1401)/'DSHM'/
42000      DATA (INAME(1401,J),J=1,MAXSCL)/
42001     1'DIFF','    ','OF  ','SHOR','HALF','MIDM','    ','    '/
42002      DATA INFLAV(1401)/2/
42003      DATA INLONG(1401)/'DIFFERENCE OF SHORTEST HALF MIDMEAN'/
42004C
42005      DATA INCASE(1402)/'DSHM'/
42006      DATA (INAME(1401,J),J=1,MAXSCL)/
42007     1'DIFF','    ','OF  ','SHOR','HALF','MID ','MEAN','    '/
42008      DATA INFLAV(1402)/2/
42009      DATA INLONG(1402)/'DIFFERENCE OF SHORTEST HALF MIDMEAN'/
42010C
42011      DATA INCASE(1403)/'DSHR'/
42012      DATA (INAME(1403,J),J=1,MAXSCL)/
42013     1'DIFF','    ','OF  ','SHOR','HALF','MIDR','    ','    '/
42014      DATA INFLAV(1403)/2/
42015      DATA INLONG(1403)/'DIFFERENCE OF SHORTEST HALF MIDRANGE'/
42016C
42017      DATA INCASE(1404)/'DSHR'/
42018      DATA (INAME(1404,J),J=1,MAXSCL)/
42019     1'DIFF','    ','OF  ','SHOR','HALF','MID ','RANG','    '/
42020      DATA INFLAV(1404)/2/
42021      DATA INLONG(1404)/'DIFFERENCE OF SHORTEST HALF MIDRANGE'/
42022C
42023      DATA INCASE(1405)/'HESE'/
42024      DATA (INAME(1405,J),J=1,MAXSCL)/
42025     1'HEDG','    ','G   ','STAN','ERRO','    ','    ','    '/
42026      DATA INFLAV(1405)/2/
42027      DATA INLONG(1405)/'HEDGES G STANDARD ERROR'/
42028C
42029      DATA INCASE(1406)/'BCHG'/
42030      DATA (INAME(1406,J),J=1,MAXSCL)/
42031     1'BIAS','    ','CORR','HEDG','G   ','    ','    ','    '/
42032      DATA INFLAV(1406)/2/
42033      DATA INLONG(1406)/'BIAS CORRECTED HEDGES G'/
42034C
42035      DATA INCASE(1407)/'GLAS'/
42036      DATA (INAME(1407,J),J=1,MAXSCL)/
42037     1'GLAS','    ','G   ','    ','    ','    ','    ','    '/
42038      DATA INFLAV(1407)/2/
42039      DATA INLONG(1407)/'GLASS G'/
42040C
42041      DATA INCASE(1408)/'COHD'/
42042      DATA (INAME(1408,J),J=1,MAXSCL)/
42043     1'COHE','    ','D   ','    ','    ','    ','    ','    '/
42044      DATA INFLAV(1408)/2/
42045      DATA INLONG(1408)/'COHENS D'/
42046C
42047      DATA INCASE(1409)/'MHIN'/
42048      DATA (INAME(1409,J),J=1,MAXSCL)/
42049     1'MIDH','    ','    ','    ','    ','    ','    ','    '/
42050      DATA INFLAV(1409)/1/
42051      DATA INLONG(1409)/'MID-HINGE'/
42052C
42053      DATA INCASE(1410)/'MHIN'/
42054      DATA (INAME(1410,J),J=1,MAXSCL)/
42055     1'MID ','    ','HING','    ','    ','    ','    ','    '/
42056      DATA INFLAV(1410)/1/
42057      DATA INLONG(1410)/'MID-HINGE'/
42058C
42059      DATA INCASE(1411)/'TMEA'/
42060      DATA (INAME(1411,J),J=1,MAXSCL)/
42061     1'TRIM','EAN ','    ','    ','    ','    ','    ','    '/
42062      DATA INFLAV(1411)/1/
42063      DATA INLONG(1411)/'TRI-MEAN'/
42064C
42065      DATA INCASE(1412)/'TMEA'/
42066      DATA (INAME(1412,J),J=1,MAXSCL)/
42067     1'TRI ','    ','MEAN','    ','    ','    ','    ','    '/
42068      DATA INFLAV(1412)/1/
42069      DATA INLONG(1412)/'TRI-MEAN'/
42070C
42071      DATA INCASE(1413)/'DMHI'/
42072      DATA (INAME(1413,J),J=1,MAXSCL)/
42073     1'DIFF','    ','OF  ','MID ','HING','    ','    ','    '/
42074      DATA INFLAV(1413)/2/
42075      DATA INLONG(1413)/'DIFFERENCE OF MID-HINGE'/
42076C
42077      DATA INCASE(1414)/'DMHI'/
42078      DATA (INAME(1414,J),J=1,MAXSCL)/
42079     1'DIFF','    ','OF  ','MIDH','    ','    ','    ','    '/
42080      DATA INFLAV(1414)/2/
42081      DATA INLONG(1414)/'DIFFERENCE OF MID-HINGE'/
42082C
42083      DATA INCASE(1415)/'DTRI'/
42084      DATA (INAME(1415,J),J=1,MAXSCL)/
42085     1'DIFF','    ','OF  ','TRI ','MEAN','    ','    ','    '/
42086      DATA INFLAV(1415)/2/
42087      DATA INLONG(1415)/'DIFFERENCE OF TRI-MEAN'/
42088C
42089      DATA INCASE(1416)/'DTRI'/
42090      DATA (INAME(1416,J),J=1,MAXSCL)/
42091     1'DIFF','    ','OF  ','TRIM','    ','    ','    ','    '/
42092      DATA INFLAV(1416)/2/
42093      DATA INLONG(1416)/'DIFFERENCE OF TRI-MEAN'/
42094C
42095      DATA INCASE(1417)/'PDIS'/
42096      DATA (INAME(1417,J),J=1,MAXSCL)/
42097     1'PEAR','    ','DISS','    ','    ','    ','    ','    '/
42098      DATA INFLAV(1417)/2/
42099      DATA INLONG(1417)/'PEARSON DISSIMILARITY'/
42100C
42101      DATA INCASE(1418)/'RDIS'/
42102      DATA (INAME(1418,J),J=1,MAXSCL)/
42103     1'SPEA','    ','DISS','    ','    ','    ','    ','    '/
42104      DATA INFLAV(1418)/2/
42105      DATA INLONG(1418)/'SPEARMAN DISSIMILARITY'/
42106C
42107      DATA INCASE(1419)/'KSIM'/
42108      DATA (INAME(1419,J),J=1,MAXSCL)/
42109     1'KEND','    ','TAU ','SIMI','    ','    ','    ','    '/
42110      DATA INFLAV(1419)/2/
42111      DATA INLONG(1419)/'KENDELLS TAU SIMILARITY'/
42112C
42113      DATA INCASE(1420)/'CHDI'/
42114      DATA (INAME(1420,J),J=1,MAXSCL)/
42115     1'CHEB','    ','DIST','    ','    ','    ','    ','    '/
42116      DATA INFLAV(1420)/2/
42117      DATA INLONG(1420)/'CHEBYSHEV DISTANCE'/
42118C
42119      DATA INCASE(1421)/'MDIS'/
42120      DATA (INAME(1421,J),J=1,MAXSCL)/
42121     1'MINK','    ','DIST','    ','    ','    ','    ','    '/
42122      DATA INFLAV(1421)/2/
42123      DATA INLONG(1421)/'MINKOWSKI DISTANCE'/
42124C
42125      DATA INCASE(1422)/'BMDI'/
42126      DATA (INAME(1422,J),J=1,MAXSCL)/
42127     1'BINA','    ','MATC','DISS','    ','    ','    ','    '/
42128      DATA INFLAV(1422)/2/
42129      DATA INLONG(1422)/'BINARY MATCH DISSIMILARITY'/
42130C
42131      DATA INCASE(1423)/'BMRD'/
42132      DATA (INAME(1423,J),J=1,MAXSCL)/
42133     1'BINA','    ','ROGE','MATC','DISS','    ','    ','    '/
42134      DATA INFLAV(1423)/2/
42135      DATA INLONG(1423)/'BINARY ROGERS MATCH DISSIMILARITY'/
42136C
42137      DATA INCASE(1424)/'BMSD'/
42138      DATA (INAME(1424,J),J=1,MAXSCL)/
42139     1'BINA','    ','SOKA','MATC','DISS','    ','    ','    '/
42140      DATA INFLAV(1424)/2/
42141      DATA INLONG(1424)/'BINARY SOKAL MATCH DISSIMILARITY'/
42142C
42143      DATA INCASE(1425)/'BJDI'/
42144      DATA (INAME(1425,J),J=1,MAXSCL)/
42145     1'BINA','    ','JACC','DISS','    ','    ','    ','    '/
42146      DATA INFLAV(1425)/2/
42147      DATA INLONG(1425)/'BINARY JACCARD DISSIMILARITY'/
42148C
42149      DATA INCASE(1426)/'BSDI'/
42150      DATA (INAME(1426,J),J=1,MAXSCL)/
42151     1'BINA','    ','ASYM','SOKA','DISS','    ','    ','    '/
42152      DATA INFLAV(1426)/2/
42153      DATA INLONG(1426)/'BINARY ASYYMETRIC SOKAL DISSIMILARITY'/
42154C
42155      DATA INCASE(1427)/'BDDI'/
42156      DATA (INAME(1427,J),J=1,MAXSCL)/
42157     1'BINA','    ','ASYM','DICE','DISS','    ','    ','    '/
42158      DATA INFLAV(1427)/2/
42159      DATA INLONG(1427)/'BINARY ASYYMETRIC DICE DISSIMILARITY'/
42160C
42161      DATA INCASE(1428)/'BMSI'/
42162      DATA (INAME(1428,J),J=1,MAXSCL)/
42163     1'BINA','    ','MATC','SIMI','    ','    ','    ','    '/
42164      DATA INFLAV(1428)/2/
42165      DATA INLONG(1428)/'BINARY MATCH SIMILARITY'/
42166C
42167      DATA INCASE(1429)/'BMRS'/
42168      DATA (INAME(1429,J),J=1,MAXSCL)/
42169     1'BINA','    ','ROGE','MATC','SIMI','    ','    ','    '/
42170      DATA INFLAV(1429)/2/
42171      DATA INLONG(1429)/'BINARY ROGERS MATCH SIMILARITY'/
42172C
42173      DATA INCASE(1430)/'BMSS'/
42174      DATA (INAME(1430,J),J=1,MAXSCL)/
42175     1'BINA','    ','SOKA','MATC','SIMI','    ','    ','    '/
42176      DATA INFLAV(1430)/2/
42177      DATA INLONG(1430)/'BINARY SOKAL MATCH SIMILARITY'/
42178C
42179      DATA INCASE(1431)/'BJSI'/
42180      DATA (INAME(1431,J),J=1,MAXSCL)/
42181     1'BINA','    ','JACC','SIMI','    ','    ','    ','    '/
42182      DATA INFLAV(1431)/2/
42183      DATA INLONG(1431)/'BINARY JACCARD SIMILARITY'/
42184C
42185      DATA INCASE(1432)/'BSSI'/
42186      DATA (INAME(1432,J),J=1,MAXSCL)/
42187     1'BINA','    ','ASYM','SOKA','SIMI','    ','    ','    '/
42188      DATA INFLAV(1432)/2/
42189      DATA INLONG(1432)/'BINARY ASYYMETRIC SOKAL SIMILARITY'/
42190C
42191      DATA INCASE(1433)/'BDSI'/
42192      DATA (INAME(1433,J),J=1,MAXSCL)/
42193     1'BINA','    ','ASYM','DICE','SIMI','    ','    ','    '/
42194      DATA INFLAV(1433)/2/
42195      DATA INLONG(1433)/'BINARY ASYYMETRIC DICE SIMILARITY'/
42196C
42197      DATA INCASE(1434)/'GJCO'/
42198      DATA (INAME(1434,J),J=1,MAXSCL)/
42199     1'GENE','    ','JACC','COEF','    ','    ','    ','    '/
42200      DATA INFLAV(1434)/2/
42201      DATA INLONG(1434)/'JACCARD SIMILARITY'/
42202C
42203      DATA INCASE(1435)/'GJDI'/
42204      DATA (INAME(1435,J),J=1,MAXSCL)/
42205     1'GENE','    ','JACC','DIST','    ','    ','    ','    '/
42206      DATA INFLAV(1435)/2/
42207      DATA INLONG(1435)/'JACCARD DISTANCE'/
42208C
42209      DATA INCASE(1436)/'YULQ'/
42210      DATA (INAME(1436,J),J=1,MAXSCL)/
42211     1'YULE','    ','Q   ','    ','    ','    ','    ','    '/
42212      DATA INFLAV(1436)/2/
42213      DATA INLONG(1436)/'YULES Q'/
42214C
42215      DATA INCASE(1437)/'DBUC'/
42216      DATA (INAME(1437,J),J=1,MAXSCL)/
42217     1'DIFF','    ','BINO','PROB','UPPE','CONF','LIMI','    '/
42218      DATA INFLAV(1437)/2/
42219      DATA INLONG(1437)/'DIFF OF BINOMIAL PROPORTIONS UPPER CONF LIMIT'/
42220C
42221      DATA INCASE(1438)/'DBUC'/
42222      DATA (INAME(1438,J),J=1,MAXSCL)/
42223     1'DIFF','    ','BINO','PROP','UPPE','CONF','LIMI','    '/
42224      DATA INFLAV(1438)/2/
42225      DATA INLONG(1438)/'DIFF OF BINOMIAL PROPORTIONS UPPER CONF LIMIT'/
42226C
42227      DATA INCASE(1439)/'DBUC'/
42228      DATA (INAME(1439,J),J=1,MAXSCL)/
42229     1'DIFF','    ','OF  ','BINO','PROP','UPPE','CONF','LIMI'/
42230      DATA INFLAV(1439)/2/
42231      DATA INLONG(1439)/'DIFF OF BINOMIAL PROPORTIONS UPPER CONF LIMIT'/
42232C
42233      DATA INCASE(1440)/'DBUC'/
42234      DATA (INAME(1440,J),J=1,MAXSCL)/
42235     1'DIFF','    ','OF  ','BINO','PROB','UPPE','CONF','LIMI'/
42236      DATA INFLAV(1440)/2/
42237      DATA INLONG(1440)/'DIFF OF BINOMIAL PROPORTIONS UPPER CONF LIMIT'/
42238C
42239      DATA INCASE(1441)/'DBPR'/
42240      DATA (INAME(1441,J),J=1,MAXSCL)/
42241     1'DIFF','    ','BINO','PROB','    ','    ','    ','    '/
42242      DATA INFLAV(1441)/2/
42243      DATA INLONG(1441)/'DIFFERENCE OF BINOMIAL PROPORTIONS'/
42244C
42245      DATA INCASE(1441)/'DBPR'/
42246      DATA (INAME(1441,J),J=1,MAXSCL)/
42247     1'DIFF','    ','BINO','PROP','    ','    ','    ','    '/
42248      DATA INFLAV(1441)/2/
42249      DATA INLONG(1441)/'DIFFERENCE OF BINOMIAL PROPORTIONS'/
42250C
42251      DATA INCASE(1442)/'DBPR'/
42252      DATA (INAME(1442,J),J=1,MAXSCL)/
42253     1'DIFF','    ','OF  ','BINO','PROP','    ','    ','    '/
42254      DATA INFLAV(1442)/2/
42255      DATA INLONG(1442)/'DIFFERENCE OF BINOMIAL PROPORTIONS'/
42256C
42257      DATA INCASE(1443)/'DBPR'/
42258      DATA (INAME(1443,J),J=1,MAXSCL)/
42259     1'DIFF','    ','OF  ','BINO','PROB','    ','    ','    '/
42260      DATA INFLAV(1443)/2/
42261      DATA INLONG(1443)/'DIFFERENCE OF BINOMIAL PROPORTIONS'/
42262C
42263      DATA INCASE(1444)/'BPUC'/
42264      DATA (INAME(1444,J),J=1,MAXSCL)/
42265     1'BINO','    ','PROB','UPPE','CONF','LIMI','    ','    '/
42266      DATA INFLAV(1444)/1/
42267      DATA INLONG(1444)/'BINOMIAL PROPORTION UPPER CONFIDENCE LIMIT'/
42268C
42269      DATA INCASE(1445)/'BPUC'/
42270      DATA (INAME(1445,J),J=1,MAXSCL)/
42271     1'BINO','    ','PROP','UPPE','CONF','LIMI','    ','    '/
42272      DATA INFLAV(1445)/1/
42273      DATA INLONG(1445)/'BINOMIAL PROPORTION UPPER CONFIDENCE LIMIT'/
42274C
42275      DATA INCASE(1446)/'BPRO'/
42276      DATA (INAME(1446,J),J=1,MAXSCL)/
42277     1'BINO','    ','PROB','    ','    ','    ','    ','    '/
42278      DATA INFLAV(1446)/1/
42279      DATA INLONG(1446)/'BINOMIAL PROPORTION'/
42280C
42281      DATA INCASE(1447)/'LCDL'/
42282      DATA (INAME(1447,J),J=1,MAXSCL)/
42283     1'LOWE','    ','COEF','OF  ','DISP','CONF','LIMI','    '/
42284      DATA INFLAV(1447)/1/
42285      DATA INLONG(1447)/'LOWER COEF OF DISPERSION CONFIDENCE LIMIT'/
42286C
42287      DATA INCASE(1448)/'LCDL'/
42288      DATA (INAME(1448,J),J=1,MAXSCL)/
42289     1'LOWE','    ','COEF','DISP','CONF','LIMI','    ','    '/
42290      DATA INFLAV(1448)/1/
42291      DATA INLONG(1448)/'LOWER COEF OF DISPERSION CONFIDENCE LIMIT'/
42292C
42293      DATA INCASE(1449)/'UCDL'/
42294      DATA (INAME(1449,J),J=1,MAXSCL)/
42295     1'UPPE','    ','COEF','OF  ','DISP','CONF','LIMI','    '/
42296      DATA INFLAV(1449)/1/
42297      DATA INLONG(1449)/'UPPER COEF OF DISPERSION CONFIDENCE LIMIT'/
42298C
42299      DATA INCASE(1450)/'UCDL'/
42300      DATA (INAME(1450,J),J=1,MAXSCL)/
42301     1'UPPE','    ','COEF','DISP','CONF','LIMI','    ','    '/
42302      DATA INFLAV(1450)/1/
42303      DATA INLONG(1450)/'UPPER COEF OF DISPERSION CONFIDENCE LIMIT'/
42304C
42305      DATA INCASE(1451)/'1LCD'/
42306      DATA (INAME(1451,J),J=1,MAXSCL)/
42307     1'ONE ','    ','SIDE','LOWE','COEF','DISP','CONF','LIMI'/
42308      DATA INFLAV(1451)/1/
42309      DATA INLONG(1451)/'ONE SIDED LOWER COEF OF DISP CONF LIMIT'/
42310C
42311      DATA INCASE(1452)/'1UCD'/
42312      DATA (INAME(1452,J),J=1,MAXSCL)/
42313     1'ONE ','    ','SIDE','UPPE','COEF','DISP','CONF','LIMI'/
42314      DATA INFLAV(1452)/1/
42315      DATA INLONG(1452)/'ONE SIDED UPPER COEF OF DISP CONF LIMIT'/
42316C
42317      DATA INCASE(1453)/'BPRO'/
42318      DATA (INAME(1453,J),J=1,MAXSCL)/
42319     1'BINO','    ','PROP','    ','    ','    ','    ','    '/
42320      DATA INFLAV(1453)/1/
42321      DATA INLONG(1453)/'BINOMIAL PROPORTION'/
42322C
42323      DATA INCASE(1454)/'1LCD'/
42324      DATA (INAME(1454,J),J=1,MAXSCL)/
42325     1'ONES','    ','LOWE','COEF','OF  ','DISP','CONF','LIMI'/
42326      DATA INFLAV(1454)/1/
42327      DATA INLONG(1454)/'ONE SIDED LOWER COEF OF DISP CONF LIMIT'/
42328C
42329      DATA INCASE(1455)/'1UCD'/
42330      DATA (INAME(1455,J),J=1,MAXSCL)/
42331     1'ONES','    ','UPPE','COEF','OF  ','DISP','CONF','LIMI'/
42332      DATA INFLAV(1455)/1/
42333      DATA INLONG(1455)/'ONE SIDED UPPER COEF OF DISP CONF LIMIT'/
42334C
42335      DATA INCASE(1456)/'DQDI'/
42336      DATA (INAME(1456,J),J=1,MAXSCL)/
42337     1'DIFF','    ','OF  ','QUAR','COEF','OF  ','VARI','    '/
42338      DATA INFLAV(1456)/2/
42339      DATA INLONG(1456)/
42340     1     'DIFFERENCE OF QUARTILE COEFFICIENT OF DISPERSION'/
42341C
42342      DATA INCASE(1457)/'DQDI'/
42343      DATA (INAME(1457,J),J=1,MAXSCL)/
42344     1'DIFF','    ','OF  ','COEF','OF  ','QUAR','VARI','    '/
42345      DATA INFLAV(1457)/2/
42346      DATA INLONG(1457)/
42347     1     'DIFFERENCE OF QUARTILE COEFFICIENT OF DISPERSION'/
42348C
42349      DATA INCASE(1458)/'DQDI'/
42350      DATA (INAME(1458,J),J=1,MAXSCL)/
42351     1'DIFF','    ','OF  ','COEF','OF  ','QUAR','DISP','    '/
42352      DATA INFLAV(1458)/2/
42353      DATA INLONG(1458)/
42354     1     'DIFFERENCE OF QUARTILE COEFFICIENT OF DISPERSION'/
42355C
42356      DATA INCASE(1459)/'QCDI'/
42357      DATA (INAME(1459,J),J=1,MAXSCL)/
42358     1'COEF','    ','OF  ','QUAR','DISP','    ','    ','    '/
42359      DATA INFLAV(1459)/1/
42360      DATA INLONG(1459)/'QUARTILE COEFFICIENT OF DISPERSION'/
42361C
42362      DATA INCASE(1460)/'QCDI'/
42363      DATA (INAME(1460,J),J=1,MAXSCL)/
42364     1'COEF','    ','OF  ','QUAR','VARI','    ','    ','    '/
42365      DATA INFLAV(1460)/1/
42366      DATA INLONG(1460)/'QUARTILE COEFFICIENT OF DISPERSION'/
42367C
42368      DATA INCASE(1461)/'QCDI'/
42369      DATA (INAME(1461,J),J=1,MAXSCL)/
42370     1'QUAR','    ','COEF','OF  ','VARI','    ','    ','    '/
42371      DATA INFLAV(1461)/1/
42372      DATA INLONG(1461)/'QUARTILE COEFFICIENT OF DISPERSION'/
42373C
42374      DATA INCASE(1462)/'LCDQ'/
42375      DATA (INAME(1462,J),J=1,MAXSCL)/
42376     1'LOWE','    ','COEF','OF  ','QUAR','DISP','CONF','LIMI'/
42377      DATA INFLAV(1462)/1/
42378      DATA INLONG(1462)/
42379     1     'LOWER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42380C
42381      DATA INCASE(1463)/'LCDQ'/
42382      DATA (INAME(1463,J),J=1,MAXSCL)/
42383     1'LOWE','    ','COEF','OF  ','QUAR','VARI','CONF','LIMI'/
42384      DATA INFLAV(1463)/1/
42385      DATA INLONG(1463)/
42386     1     'LOWER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42387C
42388      DATA INCASE(1464)/'LCDQ'/
42389      DATA (INAME(1464,J),J=1,MAXSCL)/
42390     1'LOWE','    ','COEF','QUAR','DISP','CONF','LIMI','    '/
42391      DATA INFLAV(1464)/1/
42392      DATA INLONG(1464)/
42393     1     'LOWER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42394C
42395      DATA INCASE(1465)/'LCDQ'/
42396      DATA (INAME(1465,J),J=1,MAXSCL)/
42397     1'LOWE','    ','COEF','QUAR','VARI','CONF','LIMI','    '/
42398      DATA INFLAV(1465)/1/
42399      DATA INLONG(1465)/
42400     1     'LOWER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42401C
42402      DATA INCASE(1466)/'LCDQ'/
42403      DATA (INAME(1466,J),J=1,MAXSCL)/
42404     1'LOWE','    ','QUAR','COEF','OF  ','DISP','CONF','LIMI'/
42405      DATA INFLAV(1466)/1/
42406      DATA INLONG(1466)/
42407     1     'LOWER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42408C
42409      DATA INCASE(1467)/'LCDQ'/
42410      DATA (INAME(1467,J),J=1,MAXSCL)/
42411     1'LOWE','    ','QUAR','COEF','OF  ','VARI','CONF','LIMI'/
42412      DATA INFLAV(1467)/1/
42413      DATA INLONG(1467)/
42414     1     'LOWER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42415C
42416      DATA INCASE(1468)/'UCDQ'/
42417      DATA (INAME(1468,J),J=1,MAXSCL)/
42418     1'UPPE','    ','COEF','OF  ','QUAR','DISP','CONF','LIMI'/
42419      DATA INFLAV(1468)/1/
42420      DATA INLONG(1468)/
42421     1     'UPPER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42422C
42423      DATA INCASE(1469)/'UCDQ'/
42424      DATA (INAME(1469,J),J=1,MAXSCL)/
42425     1'UPPE','    ','COEF','OF  ','QUAR','VARI','CONF','LIMI'/
42426      DATA INFLAV(1469)/1/
42427      DATA INLONG(1469)/
42428     1     'UPPER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42429C
42430      DATA INCASE(1470)/'UCDQ'/
42431      DATA (INAME(1470,J),J=1,MAXSCL)/
42432     1'UPPE','    ','COEF','QUAR','DISP','CONF','LIMI','    '/
42433      DATA INFLAV(1470)/1/
42434      DATA INLONG(1470)/
42435     1     'UPPER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42436C
42437      DATA INCASE(1471)/'UCDQ'/
42438      DATA (INAME(1471,J),J=1,MAXSCL)/
42439     1'UPPE','    ','COEF','QUAR','VARI','CONF','LIMI','    '/
42440      DATA INFLAV(1471)/1/
42441      DATA INLONG(1471)/
42442     1     'UPPER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42443C
42444      DATA INCASE(1472)/'UCDQ'/
42445      DATA (INAME(1472,J),J=1,MAXSCL)/
42446     1'UPPE','    ','QUAR','COEF','OF  ','DISP','CONF','LIMI'/
42447      DATA INFLAV(1472)/1/
42448      DATA INLONG(1472)/
42449     1     'UPPER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42450C
42451      DATA INCASE(1473)/'UCDQ'/
42452      DATA (INAME(1473,J),J=1,MAXSCL)/
42453     1'UPPE','    ','QUAR','COEF','OF  ','VARI','CONF','LIMI'/
42454      DATA INFLAV(1473)/1/
42455      DATA INLONG(1473)/
42456     1     'UPPER COEF OF QUARTILE DISPERSION CONFIDENCE LIMIT'/
42457C
42458      DATA INCASE(1474)/'BLSD'/
42459      DATA (INAME(1474,J),J=1,MAXSCL)/
42460     1'LOWE','    ','BONE','STAN','DEVI','CONF','LIMI','    '/
42461      DATA INFLAV(1474)/1/
42462      DATA INLONG(1474)/
42463     1     'LOWER BONETT STANDARD DEVIATION CONFIDENCE LIMIT'/
42464C
42465      DATA INCASE(1475)/'BLSD'/
42466      DATA (INAME(1475,J),J=1,MAXSCL)/
42467     1'LOWE','    ','BONE','STAN','DEVI','CONF','INTE','    '/
42468      DATA INFLAV(1475)/1/
42469      DATA INLONG(1475)/
42470     1     'LOWER BONETT STANDARD DEVIATION CONFIDENCE LIMIT'/
42471C
42472      DATA INCASE(1476)/'BLSD'/
42473      DATA (INAME(1476,J),J=1,MAXSCL)/
42474     1'LOWE','    ','BONE','SD  ','CONF','LIMI','    ','    '/
42475      DATA INFLAV(1476)/1/
42476      DATA INLONG(1476)/
42477     1     'LOWER BONETT STANDARD DEVIATION CONFIDENCE LIMIT'/
42478C
42479      DATA INCASE(1477)/'BLSD'/
42480      DATA (INAME(1477,J),J=1,MAXSCL)/
42481     1'LOWE','    ','BONE','SD  ','CONF','INTE','    ','    '/
42482      DATA INFLAV(1477)/1/
42483      DATA INLONG(1477)/
42484     1     'LOWER BONETT STANDARD DEVIATION CONFIDENCE LIMIT'/
42485C
42486      DATA INCASE(1478)/'BUSD'/
42487      DATA (INAME(1478,J),J=1,MAXSCL)/
42488     1'UPPE','    ','BONE','STAN','DEVI','CONF','LIMI','    '/
42489      DATA INFLAV(1478)/1/
42490      DATA INLONG(1478)/
42491     1     'UPPER BONETT STANDARD DEVIATION CONFIDENCE LIMIT'/
42492C
42493      DATA INCASE(1479)/'BUSD'/
42494      DATA (INAME(1479,J),J=1,MAXSCL)/
42495     1'UPPE','    ','BONE','STAN','DEVI','CONF','INTE','    '/
42496      DATA INFLAV(1479)/1/
42497      DATA INLONG(1479)/
42498     1     'UPPER BONETT STANDARD DEVIATION CONFIDENCE LIMIT'/
42499C
42500      DATA INCASE(1480)/'BUSD'/
42501      DATA (INAME(1480,J),J=1,MAXSCL)/
42502     1'UPPE','    ','BONE','SD  ','CONF','LIMI','    ','    '/
42503      DATA INFLAV(1480)/1/
42504      DATA INLONG(1480)/
42505     1     'UPPER BONETT STANDARD DEVIATION CONFIDENCE LIMIT'/
42506C
42507      DATA INCASE(1481)/'BUSD'/
42508      DATA (INAME(1481,J),J=1,MAXSCL)/
42509     1'UPPE','    ','BONE','SD  ','CONF','INTE','    ','    '/
42510      DATA INFLAV(1481)/1/
42511      DATA INLONG(1481)/
42512     1     'UPPER BONETT STANDARD DEVIATION CONFIDENCE LIMIT'/
42513C
42514      DATA INCASE(1482)/'PERC'/
42515      DATA (INAME(1482,J),J=1,MAXSCL)/
42516     1'PERC','    ','    ','    ','    ','    ','    ','    '/
42517      DATA INFLAV(1482)/1/
42518      DATA INLONG(1482)/'PERCENTILE'/
42519C
42520      DATA INCASE(1483)/'WCOV'/
42521      DATA (INAME(1483,J),J=1,MAXSCL)/
42522     1'WEIG','    ','COVA','    ','    ','    ','    ','    '/
42523      DATA INFLAV(1483)/3/
42524      DATA INLONG(1483)/'WEIGHTED COVARIANCE'/
42525C
42526      DATA INCASE(1484)/'WCOR'/
42527      DATA (INAME(1484,J),J=1,MAXSCL)/
42528     1'WEIG','    ','CORR','    ','    ','    ','    ','    '/
42529      DATA INFLAV(1484)/3/
42530      DATA INLONG(1484)/'WEIGHTED CORRELATION'/
42531C
42532      DATA INCASE(1485)/'GJCO'/
42533      DATA (INAME(1485,J),J=1,MAXSCL)/
42534     1'JACC','    ','SIMI','    ','    ','    ','    ','    '/
42535      DATA INFLAV(1485)/2/
42536      DATA INLONG(1485)/'JACCARD SIMILARITY'/
42537C
42538      DATA INCASE(1486)/'GJDI'/
42539      DATA (INAME(1486,J),J=1,MAXSCL)/
42540     1'JACC','    ','DIST','    ','    ','    ','    ','    '/
42541      DATA INFLAV(1486)/2/
42542      DATA INLONG(1486)/'JACCARD DISTANCE'/
42543C
42544      DATA INCASE(1487)/'HELC'/
42545      DATA (INAME(1487,J),J=1,MAXSCL)/
42546     1'HEDG','    ','G   ','LOWE','CONF','LIMI','    ','    '/
42547      DATA INFLAV(1487)/2/
42548      DATA INLONG(1487)/'HEDGES G LOWER CONFIDENCE LIMIT'/
42549C
42550      DATA INCASE(1488)/'HELC'/
42551      DATA (INAME(1488,J),J=1,MAXSCL)/
42552     1'HEDG','    ','G   ','LOWE','CONF','LEVE','    ','    '/
42553      DATA INFLAV(1488)/2/
42554      DATA INLONG(1488)/'HEDGES G LOWER CONFIDENCE LIMIT'/
42555C
42556      DATA INCASE(1489)/'HEUC'/
42557      DATA (INAME(1489,J),J=1,MAXSCL)/
42558     1'HEDG','    ','G   ','UPPE','CONF','LIMI','    ','    '/
42559      DATA INFLAV(1489)/2/
42560      DATA INLONG(1489)/'HEDGES G UPPER CONFIDENCE LIMIT'/
42561C
42562      DATA INCASE(1490)/'HEUC'/
42563      DATA (INAME(1490,J),J=1,MAXSCL)/
42564     1'HEDG','    ','G   ','UPPE','CONF','LEVE','    ','    '/
42565      DATA INFLAV(1490)/2/
42566      DATA INLONG(1490)/'HEDGES G UPPER CONFIDENCE LIMIT'/
42567C
42568      DATA INCASE(1491)/'HEDG'/
42569      DATA (INAME(1491,J),J=1,MAXSCL)/
42570     1'HEDG','    ','G   ','    ','    ','    ','    ','    '/
42571      DATA INFLAV(1491)/2/
42572      DATA INLONG(1491)/'HEDGES G'/
42573C
42574      DATA INCASE(1492)/'PDIS'/
42575      DATA (INAME(1492,J),J=1,MAXSCL)/
42576     1'PEAR','    ','DIST','    ','    ','    ','    ','    '/
42577      DATA INFLAV(1492)/2/
42578      DATA INLONG(1492)/'PEARSON DISTANCE'/
42579C
42580      DATA INCASE(1493)/'HDIS'/
42581      DATA (INAME(1493,J),J=1,MAXSCL)/
42582     1'HAMM','    ','DIST','    ','    ','    ','    ','    '/
42583      DATA INFLAV(1493)/2/
42584      DATA INLONG(1493)/'HAMMING DISTANCE'/
42585C
42586      DATA INCASE(1494)/'WCDI'/
42587      DATA (INAME(1494,J),J=1,MAXSCL)/
42588     1'WEIG','    ','COSI','DIST','    ','    ','    ','    '/
42589      DATA INFLAV(1494)/3/
42590      DATA INLONG(1494)/'WEIGHTED COSINE DISTANCE'/
42591C
42592      DATA INCASE(1495)/'CNDI'/
42593      DATA (INAME(1495,J),J=1,MAXSCL)/
42594     1'CANB','    ','DIST','    ','    ','    ','    ','    '/
42595      DATA INFLAV(1495)/2/
42596      DATA INLONG(1495)/'CANBERRA DISTANCE'/
42597C
42598      DATA INCASE(1496)/'CORR'/
42599      DATA (INAME(1496,J),J=1,MAXSCL)/
42600     1'CORR','    ','    ','    ','    ','    ','    ','    '/
42601      DATA INFLAV(1496)/2/
42602      DATA INLONG(1496)/'CORRELATION'/
42603C
42604      DATA INCASE(1497)/'ICCR'/
42605      DATA (INAME(1497,J),J=1,MAXSCL)/
42606     1'INTR','ACLA','CORR','    ','    ','    ','    ','    '/
42607      DATA INFLAV(1497)/2/
42608      DATA INLONG(1497)/'INTRACLASS CORRELATION'/
42609C
42610      DATA INCASE(1498)/'ICCR'/
42611      DATA (INAME(1498,J),J=1,MAXSCL)/
42612     1'INTR','    ','CLAS','CORR','    ','    ','    ','    '/
42613      DATA INFLAV(1498)/2/
42614      DATA INLONG(1498)/'INTRACLASS CORRELATION'/
42615C
42616      DATA INCASE(1499)/'INTC'/
42617      DATA (INAME(1499,J),J=1,MAXSCL)/
42618     1'INTE','    ','COUN','    ','    ','    ','    ','    '/
42619      DATA INFLAV(1499)/1/
42620      DATA INLONG(1499)/'INTERVAL COUNT'/
42621C
42622      DATA INCASE(1500)/'PSIM'/
42623      DATA (INAME(1500,J),J=1,MAXSCL)/
42624     1'PEAR','    ','SIMI','    ','    ','    ','    ','    '/
42625      DATA INFLAV(1500)/2/
42626      DATA INLONG(1500)/'PEARSON SIMILARITY'/
42627C
42628      DATA INCASE(1501)/'RSIM'/
42629      DATA (INAME(1501,J),J=1,MAXSCL)/
42630     1'SPEA','    ','SIMI','    ','    ','    ','    ','    '/
42631      DATA INFLAV(1501)/2/
42632      DATA INLONG(1501)/'SPEARMAN SIMILARITY'/
42633C
42634      DATA INCASE(1502)/'RDIS'/
42635      DATA (INAME(1502,J),J=1,MAXSCL)/
42636     1'SPEA','    ','DIST','    ','    ','    ','    ','    '/
42637      DATA INFLAV(1502)/2/
42638      DATA INLONG(1502)/'SPEARMAN DISSIMILARITY'/
42639C
42640      DATA INCASE(1503)/'KDIS'/
42641      DATA (INAME(1503,J),J=1,MAXSCL)/
42642     1'KEND','    ','TAU ','DIST','    ','    ','    ','    '/
42643      DATA INFLAV(1503)/2/
42644      DATA INLONG(1503)/'KENDALLS TAU DISSIMILARITY'/
42645C
42646      DATA INCASE(1504)/'TAUA'/
42647      DATA (INAME(1504,J),J=1,MAXSCL)/
42648     1'KEND','    ','TAU ','A   ','    ','    ','    ','    '/
42649      DATA INFLAV(1504)/2/
42650      DATA INLONG(1504)/'KENDALLS TAU A'/
42651C
42652      DATA INCASE(1505)/'WCSI'/
42653      DATA (INAME(1505,J),J=1,MAXSCL)/
42654     1'WEIG','    ','COSI','SIMI','    ','    ','    ','    '/
42655      DATA INFLAV(1505)/3/
42656      DATA INLONG(1505)/'WEIGHTED COSINE SIMILARITY'/
42657C
42658      DATA INCASE(1506)/'GCOR'/
42659      DATA (INAME(1506,J),J=1,MAXSCL)/
42660     1'GROU','    ','CORR','    ','    ','    ','    ','    '/
42661      DATA INFLAV(1506)/3/
42662      DATA INLONG(1506)/'GROUPED CORRELATION'/
42663C
42664      DATA INCASE(1507)/'PMEA'/
42665      DATA (INAME(1507,J),J=1,MAXSCL)/
42666     1'PYTH','    ','MEAN','    ','    ','    ','    ','    '/
42667      DATA INFLAV(1507)/1/
42668      DATA INLONG(1507)/'PYTHON MEAN'/
42669C
42670      DATA INCASE(1508)/'YOUD'/
42671      DATA (INAME(1508,J),J=1,MAXSCL)/
42672     1'YOUD','    ','INDE','    ','    ','    ','    ','    '/
42673      DATA INFLAV(1508)/2/
42674      DATA INLONG(1508)/'YOUDEN INDEX'/
42675C
42676      DATA INCASE(1509)/'SIQL'/
42677      DATA (INAME(1509,J),J=1,MAXSCL)/
42678     1'LOWE','    ','SEMI','INTE','RANG','    ','    ','    '/
42679      DATA INFLAV(1509)/1/
42680      DATA INLONG(1509)/'LOWER SEMI-INTERQUARTILE RANGE'/
42681C
42682      DATA INCASE(1510)/'SIQU'/
42683      DATA (INAME(1510,J),J=1,MAXSCL)/
42684     1'UPPE','    ','SEMI','INTE','RANG','    ','    ','    '/
42685      DATA INFLAV(1510)/1/
42686      DATA INLONG(1510)/'UPPER SEMI-INTERQUARTILE RANGE'/
42687C
42688      DATA INCASE(1511)/'YULQ'/
42689      DATA (INAME(1511,J),J=1,MAXSCL)/
42690     1'BINA','    ','GAMM','COEF','    ','    ','    ','    '/
42691      DATA INFLAV(1511)/2/
42692      DATA INLONG(1511)/'YULES Q'/
42693C
42694      DATA INCASE(1512)/'YULQ'/
42695      DATA (INAME(1512,J),J=1,MAXSCL)/
42696     1'KRUS','    ','GOOD','BINA','GAMM','COEF','    ','    '/
42697      DATA INFLAV(1512)/2/
42698      DATA INLONG(1512)/'YULES Q'/
42699C
42700      DATA INCASE(1513)/'YULY'/
42701      DATA (INAME(1513,J),J=1,MAXSCL)/
42702     1'YULE','    ','Y   ','    ','    ','    ','    ','    '/
42703      DATA INFLAV(1513)/2/
42704      DATA INLONG(1513)/'YULES Y'/
42705C
42706      DATA INCASE(1514)/'KTAU'/
42707      DATA (INAME(1514,J),J=1,MAXSCL)/
42708     1'GAMM','    ','CORR','COEF','    ','    ','    ','    '/
42709      DATA INFLAV(1514)/2/
42710      DATA INLONG(1514)/'GAMMA CORRELATION COEFFICIENT (KENDALL TAU)'/
42711C
42712      DATA INCASE(1515)/'KTAU'/
42713      DATA (INAME(1515,J),J=1,MAXSCL)/
42714     1'KRUS','    ','GOOD','GAMM','CORR','COEF','    ','    '/
42715      DATA INFLAV(1515)/2/
42716      DATA INLONG(1515)/'GAMMA CORRELATION COEFFICIENT (KENDALL TAU)'/
42717C
42718      DATA INCASE(1516)/'KTAB'/
42719      DATA (INAME(1516,J),J=1,MAXSCL)/
42720     1'KEND','    ','TAU ','B   ','    ','    ','    ','    '/
42721      DATA INFLAV(1516)/2/
42722      DATA INLONG(1516)/'KENDALLS TAU B'/
42723C
42724      DATA INCASE(1517)/'KTAC'/
42725      DATA (INAME(1517,J),J=1,MAXSCL)/
42726     1'KEND','    ','TAU ','C   ','    ','    ','    ','    '/
42727      DATA INFLAV(1517)/2/
42728      DATA INLONG(1517)/'KENDALLS TAU C'/
42729C
42730      DATA INCASE(1518)/'KTAU'/
42731      DATA (INAME(1518,J),J=1,MAXSCL)/
42732     1'KEND','    ','TAU ','    ','    ','    ','    ','    '/
42733      DATA INFLAV(1518)/2/
42734      DATA INLONG(1518)/'KENDALLS TAU'/
42735C
42736      DATA INCASE(1519)/'RMLL'/
42737      DATA (INAME(1519,J),J=1,MAXSCL)/
42738     1'RATI','    ','OF  ','MEAN','LOWE','CONF','INTE','    '/
42739      DATA INFLAV(1519)/2/
42740      DATA INLONG(1519)/'RATIO OF MEANS LOWER CONFIDENCE LIMIT'/
42741C
42742      DATA INCASE(1520)/'RMUL'/
42743      DATA (INAME(1520,J),J=1,MAXSCL)/
42744     1'RATI','    ','OF  ','MEAN','UPPE','CONF','LIMI','    '/
42745      DATA INFLAV(1520)/2/
42746      DATA INLONG(1520)/'RATIO OF MEANS UPPER CONFIDENCE LIMIT'/
42747C
42748      DATA INCASE(1521)/'RMUL'/
42749      DATA (INAME(1521,J),J=1,MAXSCL)/
42750     1'RATI','    ','OF  ','MEAN','UPPE','CONF','INTE','    '/
42751      DATA INFLAV(1521)/2/
42752      DATA INLONG(1521)/'RATIO OF MEANS UPPER CONFIDENCE LIMIT'/
42753C
42754      DATA INCASE(1522)/'RMEA'/
42755      DATA (INAME(1522,J),J=1,MAXSCL)/
42756     1'RATI','    ','OF  ','MEAN','    ','    ','    ','    '/
42757      DATA INFLAV(1522)/2/
42758      DATA INLONG(1522)/'RATIO OF MEANS'/
42759C
42760      DATA INCASE(1523)/'RATI'/
42761      DATA (INAME(1523,J),J=1,MAXSCL)/
42762     1'RATI','    ','    ','    ','    ','    ','    ','    '/
42763      DATA INFLAV(1523)/2/
42764      DATA INLONG(1523)/'RATIO'/
42765C
42766      DATA INCASE(1524)/'DCDF'/
42767      DATA (INAME(1524,J),J=1,MAXSCL)/
42768     1'DAVI','    ','TEST','CDF ','    ','    ','    ','    '/
42769      DATA INFLAV(1524)/1/
42770      DATA INLONG(1524)/'DAVID TEST CDF'/
42771C
42772      DATA INCASE(1525)/'DCDF'/
42773      DATA (INAME(1525,J),J=1,MAXSCL)/
42774     1'DAVI','    ','CDF ','    ','    ','    ','    ','    '/
42775      DATA INFLAV(1525)/1/
42776      DATA INLONG(1525)/'DAVID TEST CDF'/
42777C
42778      DATA INCASE(1526)/'DPVA'/
42779      DATA (INAME(1526,J),J=1,MAXSCL)/
42780     1'DAVI','    ','TEST','PVAL','    ','    ','    ','    '/
42781      DATA INFLAV(1526)/1/
42782      DATA INLONG(1526)/'DAVID TEST P-VALUE'/
42783C
42784      DATA INCASE(1527)/'DPVA'/
42785      DATA (INAME(1527,J),J=1,MAXSCL)/
42786     1'DAVI','    ','TEST','P   ','VALU','    ','    ','    '/
42787      DATA INFLAV(1527)/1/
42788      DATA INLONG(1527)/'DAVID TEST P-VALUE'/
42789C
42790      DATA INCASE(1528)/'DPVA'/
42791      DATA (INAME(1528,J),J=1,MAXSCL)/
42792     1'DAVI','    ','PVAL','    ','    ','    ','    ','    '/
42793      DATA INFLAV(1528)/1/
42794      DATA INLONG(1528)/'DAVID TEST P-VALUE'/
42795C
42796      DATA INCASE(1529)/'DPVA'/
42797      DATA (INAME(1529,J),J=1,MAXSCL)/
42798     1'DAVI','    ','P   ','VALU','    ','    ','    ','    '/
42799      DATA INFLAV(1529)/1/
42800      DATA INLONG(1529)/'DAVID TEST P-VALUE'/
42801C
42802      DATA INCASE(1530)/'DMNI'/
42803      DATA (INAME(1530,J),J=1,MAXSCL)/
42804     1'DAVI','    ','TEST','MINI','INDE','    ','    ','    '/
42805      DATA INFLAV(1530)/1/
42806      DATA INLONG(1530)/'DAVID TEST MINIMUM INDEX'/
42807C
42808      DATA INCASE(1531)/'DMNI'/
42809      DATA (INAME(1531,J),J=1,MAXSCL)/
42810     1'DAVI','    ','MINI','INDE','    ','    ','    ','    '/
42811      DATA INFLAV(1531)/1/
42812      DATA INLONG(1531)/'DAVID TEST MINIMUM INDEX'/
42813C
42814      DATA INCASE(1532)/'DMXI'/
42815      DATA (INAME(1532,J),J=1,MAXSCL)/
42816     1'DAVI','    ','TEST','MAXI','INDE','    ','    ','    '/
42817      DATA INFLAV(1532)/1/
42818      DATA INLONG(1532)/'DAVID TEST MAXIMUM INDEX'/
42819C
42820      DATA INCASE(1533)/'DMXI'/
42821      DATA (INAME(1533,J),J=1,MAXSCL)/
42822     1'DAVI','    ','MINI','INDE','    ','    ','    ','    '/
42823      DATA INFLAV(1533)/1/
42824      DATA INLONG(1533)/'DAVID TEST MAXIMUM INDEX'/
42825C
42826      DATA INCASE(1534)/'DACV'/
42827      DATA (INAME(1534,J),J=1,MAXSCL)/
42828     1'DAVI','    ','TEST','CRIT','VALU','    ','    ','    '/
42829      DATA INFLAV(1534)/1/
42830      DATA INLONG(1534)/'DAVID TEST CRITICAL VALUE'/
42831C
42832      DATA INCASE(1535)/'DACV'/
42833      DATA (INAME(1535,J),J=1,MAXSCL)/
42834     1'DAVI','    ','CRIT','VALU','    ','    ','    ','    '/
42835      DATA INFLAV(1535)/1/
42836      DATA INLONG(1535)/'DAVID TEST CRITICAL VALUE'/
42837C
42838      DATA INCASE(1536)/'DAVI'/
42839      DATA (INAME(1536,J),J=1,MAXSCL)/
42840     1'DAVI','    ','TEST','    ','    ','    ','    ','    '/
42841      DATA INFLAV(1536)/1/
42842      DATA INLONG(1536)/'DAVID TEST'/
42843C
42844      DATA INCASE(1537)/'DAVI'/
42845      DATA (INAME(1537,J),J=1,MAXSCL)/
42846     1'DAVI','    ','    ','    ','    ','    ','    ','    '/
42847      DATA INFLAV(1537)/1/
42848      DATA INLONG(1537)/'DAVID TEST'/
42849C
42850      DATA INCASE(1538)/'SOCD'/
42851      DATA (INAME(1538,J),J=1,MAXSCL)/
42852     1'SKEW','    ','OUTL','CDF ','    ','    ','    ','    '/
42853      DATA INFLAV(1538)/1/
42854      DATA INLONG(1538)/'SKEWNESS OUTLIER TEST CDF'/
42855C
42856      DATA INCASE(1539)/'SOCD'/
42857      DATA (INAME(1539,J),J=1,MAXSCL)/
42858     1'SKEW','    ','OUTL','TEST','CDF ','    ','    ','    '/
42859      DATA INFLAV(1539)/1/
42860      DATA INLONG(1539)/'SKEWNESS OUTLIER TEST CDF'/
42861C
42862      DATA INCASE(1540)/'SOCV'/
42863      DATA (INAME(1540,J),J=1,MAXSCL)/
42864     1'SKEW','    ','OUTL','CRIT','VALU','    ','    ','    '/
42865      DATA INFLAV(1540)/1/
42866      DATA INLONG(1540)/'SKEWNESS OUTLIER TEST CRITICAL VALUE'/
42867C
42868      DATA INCASE(1541)/'SOCV'/
42869      DATA (INAME(1541,J),J=1,MAXSCL)/
42870     1'SKEW','    ','OUTL','TEST','CRIT','VALU','    ','    '/
42871      DATA INFLAV(1541)/1/
42872      DATA INLONG(1541)/'SKEWNESS OUTLIER TEST CDF'/
42873C
42874      DATA INCASE(1542)/'SOIN'/
42875      DATA (INAME(1542,J),J=1,MAXSCL)/
42876     1'SKEW','    ','OUTL','INDE','    ','    ','    ','    '/
42877      DATA INFLAV(1542)/1/
42878      DATA INLONG(1542)/'SKEWNESS OUTLIER TEST INDEX'/
42879C
42880      DATA INCASE(1543)/'SOIN'/
42881      DATA (INAME(1543,J),J=1,MAXSCL)/
42882     1'SKEW','    ','OUTL','TEST','INDE','    ','    ','    '/
42883      DATA INFLAV(1543)/1/
42884      DATA INLONG(1543)/'SKEWNESS OUTLIER TEST INDEX'/
42885C
42886      DATA INCASE(1544)/'SOPV'/
42887      DATA (INAME(1544,J),J=1,MAXSCL)/
42888     1'SKEW','    ','OUTL','PVAL','    ','    ','    ','    '/
42889      DATA INFLAV(1544)/1/
42890      DATA INLONG(1544)/'SKEWNESS OUTLIER TEST PVALUE'/
42891C
42892      DATA INCASE(1545)/'SOUT'/
42893      DATA (INAME(1545,J),J=1,MAXSCL)/
42894     1'SKEW','    ','OUTL','TEST','    ','    ','    ','    '/
42895      DATA INFLAV(1545)/1/
42896      DATA INLONG(1545)/'SKEWNESS OUTLIER TEST'/
42897C
42898      DATA INCASE(1546)/'SOUT'/
42899      DATA (INAME(1546,J),J=1,MAXSCL)/
42900     1'SKEW','    ','OUTL','    ','    ','    ','    ','    '/
42901      DATA INFLAV(1546)/1/
42902      DATA INLONG(1546)/'SKEWNESS OUTLIER TEST'/
42903C
42904      DATA INCASE(1547)/'SKEW'/
42905      DATA (INAME(1547,J),J=1,MAXSCL)/
42906     1'SKEW','    ','    ','    ','    ','    ','    ','    '/
42907      DATA INFLAV(1547)/1/
42908      DATA INLONG(1547)/'SKEWNESS'/
42909C
42910      DATA INCASE(1548)/'KOCD'/
42911      DATA (INAME(1548,J),J=1,MAXSCL)/
42912     1'KURT','    ','OUTL','CDF ','    ','    ','    ','    '/
42913      DATA INFLAV(1548)/1/
42914      DATA INLONG(1548)/'KURTOSIS OUTLIER TEST CDF'/
42915C
42916      DATA INCASE(1549)/'KOCD'/
42917      DATA (INAME(1549,J),J=1,MAXSCL)/
42918     1'KURT','    ','OUTL','TEST','CDF ','    ','    ','    '/
42919      DATA INFLAV(1549)/1/
42920      DATA INLONG(1549)/'KURTOSIS OUTLIER TEST CDF'/
42921C
42922      DATA INCASE(1550)/'KOCV'/
42923      DATA (INAME(1550,J),J=1,MAXSCL)/
42924     1'KURT','    ','OUTL','CRIT','VALU','    ','    ','    '/
42925      DATA INFLAV(1550)/1/
42926      DATA INLONG(1550)/'KURTOSIS OUTLIER TEST CRITICAL VALUE'/
42927C
42928      DATA INCASE(1551)/'KOCV'/
42929      DATA (INAME(1551,J),J=1,MAXSCL)/
42930     1'KURT','    ','OUTL','TEST','CRIT','VALU','    ','    '/
42931      DATA INFLAV(1551)/1/
42932      DATA INLONG(1551)/'KURTOSIS OUTLIER TEST CDF'/
42933C
42934      DATA INCASE(1552)/'KOIN'/
42935      DATA (INAME(1552,J),J=1,MAXSCL)/
42936     1'KURT','    ','OUTL','INDE','    ','    ','    ','    '/
42937      DATA INFLAV(1552)/1/
42938      DATA INLONG(1552)/'KURTOSIS OUTLIER TEST INDEX'/
42939C
42940      DATA INCASE(1553)/'KOIN'/
42941      DATA (INAME(1553,J),J=1,MAXSCL)/
42942     1'KURT','    ','OUTL','TEST','INDE','    ','    ','    '/
42943      DATA INFLAV(1553)/1/
42944      DATA INLONG(1553)/'KURTOSIS OUTLIER TEST INDEX'/
42945C
42946      DATA INCASE(1554)/'KOPV'/
42947      DATA (INAME(1554,J),J=1,MAXSCL)/
42948     1'KURT','    ','OUTL','PVAL','    ','    ','    ','    '/
42949      DATA INFLAV(1554)/1/
42950      DATA INLONG(1554)/'KURTOSIS OUTLIER TEST PVALUE'/
42951C
42952      DATA INCASE(1555)/'KOUT'/
42953      DATA (INAME(1555,J),J=1,MAXSCL)/
42954     1'KURT','    ','OUTL','TEST','    ','    ','    ','    '/
42955      DATA INFLAV(1555)/1/
42956      DATA INLONG(1555)/'KURTOSIS OUTLIER TEST'/
42957C
42958      DATA INCASE(1556)/'KOUT'/
42959      DATA (INAME(1556,J),J=1,MAXSCL)/
42960     1'KURT','    ','OUTL','    ','    ','    ','    ','    '/
42961      DATA INFLAV(1556)/1/
42962      DATA INLONG(1556)/'KURTOSIS OUTLIER TEST'/
42963C
42964      DATA INCASE(1557)/'KURT'/
42965      DATA (INAME(1557,J),J=1,MAXSCL)/
42966     1'KURT','    ','    ','    ','    ','    ','    ','    '/
42967      DATA INFLAV(1557)/1/
42968      DATA INLONG(1557)/'KURTOSIS'/
42969C
42970C-----START POINT-----------------------------------------------------
42971C
42972      ISUBN1='EXTS'
42973      ISUBN2='TA  '
42974      IWRITE='OFF'
42975      ISUBN1='EXTS'
42976      ISUBN2='TA  '
42977      IWRITE='OFF'
42978      IFOUND='NO'
42979      IERROR='NO'
42980C
42981      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TSTA')THEN
42982        WRITE(ICOUT,999)
42983  999   FORMAT(1X)
42984        CALL DPWRST('XXX','BUG ')
42985        WRITE(ICOUT,51)
42986   51   FORMAT('***** AT THE BEGINNING OF EXTSTA--')
42987        CALL DPWRST('XXX','BUG ')
42988        WRITE(ICOUT,52)IBUGG3,ISUBRO,NUMARG,JMIN,JMAX
42989   52   FORMAT('IBUGG3,ISUBRO,NUMARG,JMIN,JMAX = ',A4,2X,A4,3I8)
42990        CALL DPWRST('XXX','BUG ')
42991        WRITE(ICOUT,53)ICOM,ICOM2
42992   53   FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
42993        CALL DPWRST('XXX','BUG ')
42994        IF(NUMARG.GE.1)THEN
42995          DO60I=1,NUMARG
42996            WRITE(ICOUT,61)I,IHARG(I),IHARG2(I)
42997   61       FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,2X,A4)
42998            CALL DPWRST('XXX','BUG ')
42999   60     CONTINUE
43000        ENDIF
43001        WRITE(ICOUT,63)MAXSTA,MAXSCL
43002   63   FORMAT('MAXSTA,MAXSCL = ',2I8)
43003        CALL DPWRST('XXX','BUG ')
43004      ENDIF
43005C
43006C     STEP 1: INITIALIZE THE MATCHING VARIABLE
43007C
43008      DO1010I=1,MAXSCL
43009        INTEMP(I)='    '
43010 1010 CONTINUE
43011      IF(JMIN.EQ.0)THEN
43012        INTEMP(1)=ICOM
43013        INTEMP(2)=ICOM2
43014        ICNT=2
43015        IF(JMIN.LT.JMAX)THEN
43016          DO1020I=JMIN+1,JMAX
43017            ICNT=ICNT+1
43018            INTEMP(ICNT)=IHARG(I)
43019 1020     CONTINUE
43020        ENDIF
43021C
43022        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TSTA')THEN
43023           WRITE(ICOUT,999)
43024           CALL DPWRST('XXX','BUG ')
43025           WRITE(ICOUT,1021)ICNT
43026 1021      FORMAT('JMIN = 0 CASE, ICNT = ',I8)
43027           CALL DPWRST('XXX','BUG ')
43028           DO1022II=1,ICNT
43029             WRITE(ICOUT,1023)II,INTEMP(II)
43030 1023        FORMAT('II,INTEMP(II) = ',I8,A4)
43031             CALL DPWRST('XXX','BUG ')
43032 1022      CONTINUE
43033        ENDIF
43034C
43035      ELSE
43036        INTEMP(1)=IHARG(JMIN)
43037        INTEMP(2)=IHARG2(JMIN)
43038        ICNT=2
43039        IF(JMAX.GT.JMIN)THEN
43040          DO1030I=JMIN+1,JMAX
43041            ICNT=ICNT+1
43042            INTEMP(ICNT)=IHARG(I)
43043 1030     CONTINUE
43044        ENDIF
43045C
43046        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TSTA')THEN
43047           WRITE(ICOUT,999)
43048           CALL DPWRST('XXX','BUG ')
43049           WRITE(ICOUT,1031)ICNT
43050 1031      FORMAT('JMIN > 0 CASE, ICNT = ',I8)
43051           CALL DPWRST('XXX','BUG ')
43052           DO1032II=1,ICNT
43053             WRITE(ICOUT,1033)II,INTEMP(II)
43054 1033        FORMAT('II,INTEMP(II) = ',I8,A4)
43055             CALL DPWRST('XXX','BUG ')
43056 1032      CONTINUE
43057        ENDIF
43058C
43059      ENDIF
43060C
43061C     STEP 1A: CHECK FOR "QUANTILE" OR "PERCENTILE" AS SECOND
43062C              ARGUMENT (INTEMP(3)).  IF SO, SAVE THE PARAMETER
43063C              NAME IN A COMMON BLOCK (IF ARGUMENT TYPE IS
43064C              NUMERIC, SAVE THE VALUE).
43065C
43066      IPNAM1='    '
43067      IPNAM2='    '
43068      APVAL=CPUMIN
43069      IFLAGQ=0
43070      IF((INTEMP(3).EQ.'QUAN' .OR. INTEMP(3).EQ.'PERC' ).AND.
43071     1   INTEMP(1).NE.'Q   ' .AND. INTEMP(1).NE.'BOOT' .AND.
43072     1   INTEMP(1).NE.'JACK')THEN
43073        IF(IARGT(JMIN).EQ.'NUMB')THEN
43074          APVAL=ARG(JMIN)
43075        ELSE
43076          IPNAM1=INTEMP(1)
43077          IPNAM2=INTEMP(2)
43078        ENDIF
43079        INTEMP(1)=INTEMP(3)
43080        INTEMP(2)='    '
43081        DO1090I=3,MAXSCL-1
43082          INTEMP(I)=INTEMP(I+1)
43083 1090   CONTINUE
43084        INTEMP(MAXSCL)='    '
43085        IFLAGQ=1
43086      ENDIF
43087C
43088C     STEP 2: NOW CHECK IF MATCHING VARIABLE MATCHES AN ENTRY
43089C             IN THE TABLE.  NOTE THAT WE NEED TO CHECK FOR
43090C             NAME CONFLICTS IN FIRST 4 CHARACTERS OF FIRST
43091C             ARGUMENT.
43092C
43093      DO2000I=1,MAXSTA
43094        IROW=I
43095        IF(INAME(I,1).NE.INTEMP(1))GOTO2000
43096C
43097        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TSTA')THEN
43098           WRITE(ICOUT,999)
43099           CALL DPWRST('XXX','BUG ')
43100           WRITE(ICOUT,2001)I,INAME(I,1),INTEMP(1)
43101 2001      FORMAT('I,INAME(I,1),INTEMP(1) = ',I8,2X,A4,2X,A4)
43102           CALL DPWRST('XXX','BUG ')
43103        ENDIF
43104C
43105C       FIRST 4 CHARACTERS MATCHED.  NEED TO CHECK IF CHARACTERS
43106C       5-8 MATCH FOR CERTAIN CASES.
43107C
43108        IF(INAME(I,2).NE.'    ')THEN
43109          IF(INAME(I,2).NE.INTEMP(2))GOTO2000
43110        ENDIF
43111C
43112C       NOW CHECK IF REMAINING ARGUMENTS MATCH
43113C
43114        ITEMP=1
43115        DO2022J=3,MAXSCL
43116          IF(INAME(IROW,J).NE.'    ')GOTO2022
43117            ITEMP=J-1
43118            GOTO2024
43119 2022   CONTINUE
43120        ITEMP=MAXSCL
43121 2024   CONTINUE
43122C
43123        IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TSTA')THEN
43124           WRITE(ICOUT,2027)IROW,ITEMP
43125 2027      FORMAT('IROW,ITEMP = ',2I8)
43126           CALL DPWRST('XXX','BUG ')
43127        ENDIF
43128C
43129        IF(ITEMP.GT.2)THEN
43130          DO2028J=3,ITEMP
43131            IF(INAME(IROW,J).NE.INTEMP(J))GOTO2000
43132 2028     CONTINUE
43133        ENDIF
43134C
43135        IFOUND='YES'
43136        IF(ITEMP.EQ.1)THEN
43137          ILOCV=JMIN+1
43138        ELSE
43139          ILOCV=JMIN+(ITEMP-2)+1
43140        ENDIF
43141        IF(IFLAGQ.EQ.1)ILOCV=ILOCV+1
43142        ISTACS=INCASE(IROW)
43143        ISTANR=INFLAV(IROW)
43144        ISTANM=INLONG(IROW)
43145        ISTADF='OFF'
43146        IF(INTEMP(1).EQ.'DIFF')ISTADF='ON'
43147        GOTO2099
43148C
43149 2000 CONTINUE
43150C
43151C     2016/08: IF NO MATCH FOUND, CHECK FOR "STATISTIC BLOCK".
43152C
43153      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TSTA')THEN
43154        WRITE(ICOUT,2101)
43155 2101   FORMAT('AFTER CHECK PRE-DEFINED STATISTICS')
43156        CALL DPWRST('XXX','BUG ')
43157        WRITE(ICOUT,2103)ISBNA1
43158 2103   FORMAT('ISBNA1 = ',A8)
43159        CALL DPWRST('XXX','BUG ')
43160        WRITE(ICOUT,2105)ISBNA2
43161 2105   FORMAT('ISBNA2 = ',A8)
43162        CALL DPWRST('XXX','BUG ')
43163        WRITE(ICOUT,2107)ISBNA3
43164 2107   FORMAT('ISBNA3 = ',A8)
43165        CALL DPWRST('XXX','BUG ')
43166        WRITE(ICOUT,2109)INTEMP(1),INTEMP(2)
43167 2109   FORMAT('INTEMP(1),INTEMP(2) = ',A4,2X,A4)
43168        CALL DPWRST('XXX','BUG ')
43169      ENDIF
43170C
43171      IF(INTEMP(1).EQ.ISBNA1(1:4).AND.INTEMP(2).EQ.ISBNA1(5:8))THEN
43172        IFOUND='YES'
43173        ILOCV=JMIN+1
43174        ISTACS='SBL1'
43175        ISTANR=ISBCP1
43176        ISTANM='STATISTIC BLOCK ONE'
43177        ISTADF='OFF'
43178      ELSEIF(INTEMP(1).EQ.ISBNA2(1:4).AND.INTEMP(2).EQ.ISBNA2(5:8))THEN
43179        IFOUND='YES'
43180        ILOCV=JMIN+1
43181        ISTACS='SBL2'
43182        ISTANR=ISBCP1
43183        ISTANM='STATISTIC BLOCK TWO'
43184        ISTADF='OFF'
43185      ELSEIF(INTEMP(1).EQ.ISBNA3(1:4).AND.INTEMP(2).EQ.ISBNA3(5:8))THEN
43186        IFOUND='YES'
43187        ILOCV=JMIN+1
43188        ISTACS='SBL3'
43189        ISTANR=ISBCP3
43190        ISTANM='STATISTIC BLOCK THREE'
43191        ISTADF='OFF'
43192      ENDIF
43193C
43194 2099 CONTINUE
43195C
43196C               ******************
43197C               **   STEP 90--  **
43198C               **   EXIT       **
43199C               ******************
43200C
43201      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TSTA')THEN
43202        WRITE(ICOUT,999)
43203        CALL DPWRST('XXX','BUG ')
43204        WRITE(ICOUT,9011)
43205 9011   FORMAT('***** AT THE END       OF EXTSTA--')
43206        CALL DPWRST('XXX','BUG ')
43207        WRITE(ICOUT,9012)IBUGG3,ISUBRO,IFOUND
43208 9012   FORMAT('IBUGG3,ISUBRO,IFOUND = ',A4,2X,A4,2X,A4)
43209        CALL DPWRST('XXX','BUG ')
43210        IF(IFOUND.EQ.'YES')THEN
43211          WRITE(ICOUT,9013)ISTACS,ISTADF,ISTANR,ILOCV
43212 9013     FORMAT('ISTACS,ISTADF,ISTANR,ILOCV = ',A4,2X,A4,2X,2I8)
43213          CALL DPWRST('XXX','BUG ')
43214          WRITE(ICOUT,9014)ISTANM
43215 9014     FORMAT('ISTANM = ',A60)
43216          CALL DPWRST('XXX','BUG ')
43217        ENDIF
43218      ENDIF
43219C
43220      RETURN
43221      END
43222      SUBROUTINE EXTSTR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXIND,
43223     1                  IHNAME,IHNAM2,IUSE,NUMNAM,
43224     1                  ISTRN1,ISTRN2,NUMSTR,
43225     1                  IWRITE,IBUGA2,ISUBRO,IERROR)
43226C
43227C     PURPOSE--EXAMINE IHARG(.) AND IHARG2(.) FROM JMIN TO JMAX, EXTRACT
43228C              ALL NAMES (INCLUDING THOSE IMPLIED BY A   TO   KEYWORD)
43229C              AND PLACE THESE NAMES IN ISTRN1(.) AND ISTRN2(.).
43230C              NOTE THE NUMBER OF SUCH NAMES AND PLACE IT IN NUMSTR.
43231C              NUMSTR STANDS FOR NUMBER OF STRINGS.
43232C     NOTE--JMIN   = START POINT IN IHARG/IHARG2 FOR THE SCAN
43233C           JMAX   = STOP POINT  IN IHARG/IHARG2 FOR THE SCAN
43234C           MAXIND = MAXIMUM PERMITTED NUMBER OF STRINGS
43235C     NOTE--THIS SUBROUTINE ALSO CHECKS TO MAKE SURE THE LIST ITEMS ARE
43236C           IN FACT STRINGS (AS OPPOSED TO PARAMETERS, VARIABLES,
43237C           MATRICES, OR UNKNOWNS).
43238C     OUTPUT--ISTRN1(.), ISTRN2(.), AND NUMSTR.
43239C     ORIGINAL VERSION--JANUARY   2006.
43240C     UPDATED         --JULY      2009. ALLOW "Y1 TO Y1" (USEFUL FOR
43241C                                       MACROS WHERE NUMBER OF STRINGS
43242C                                       IS NOT KNOWN IN ADVANCE)
43243C
43244C---------------------------------------------------------------------
43245C
43246      DIMENSION IHARG(*)
43247      DIMENSION IHARG2(*)
43248      DIMENSION IHNAME(*)
43249      DIMENSION IHNAM2(*)
43250      DIMENSION IUSE(*)
43251      DIMENSION ISTRN1(*)
43252      DIMENSION ISTRN2(*)
43253C
43254C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
43255C
43256      CHARACTER*4 IHARG
43257      CHARACTER*4 IHARG2
43258      CHARACTER*4 IHNAME
43259      CHARACTER*4 IHNAM2
43260      CHARACTER*4 IUSE
43261      CHARACTER*4 ISTRN1
43262      CHARACTER*4 ISTRN2
43263      CHARACTER*4 IWRITE
43264      CHARACTER*4 IBUGA2
43265      CHARACTER*4 ISUBRO
43266      CHARACTER*4 IERROR
43267C
43268      CHARACTER*4 IH1
43269      CHARACTER*4 IH2
43270      CHARACTER*4 ICASTO
43271C
43272C-----COMMON----------------------------------------------------------
43273C
43274      INCLUDE 'DPCOP2.INC'
43275C
43276C-----START POINT-----------------------------------------------------
43277C
43278      NUMSTR=0
43279      JM1=0
43280C
43281      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TSTR')THEN
43282        WRITE(ICOUT,999)
43283  999   FORMAT(1X)
43284        CALL DPWRST('XXX','BUG ')
43285        WRITE(ICOUT,51)
43286   51   FORMAT('***** AT THE BEGINNING OF EXTSTR--')
43287        CALL DPWRST('XXX','BUG ')
43288        WRITE(ICOUT,53)IBUGA2,ISUBRO
43289   53   FORMAT('IBUGA2,ISUBRO = ',A4,2X,A4)
43290        CALL DPWRST('XXX','BUG ')
43291        WRITE(ICOUT,54)JMIN,JMAX,MAXIND,NUMSTR,NUMARG,NUMNAM
43292   54   FORMAT('JMIN,JMAX,MAXIND,NUMSTR,NUMARG,NUMNAM = ',5I6)
43293        CALL DPWRST('XXX','BUG ')
43294        DO62I=1,NUMARG
43295          WRITE(ICOUT,63)I,IHARG(I),IHARG2(I)
43296   63     FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2(2X,A4))
43297          CALL DPWRST('XXX','BUG ')
43298   62   CONTINUE
43299        DO72I=1,NUMNAM
43300          WRITE(ICOUT,73)I,IHNAME(I),IHNAM2(I),IUSE(I)
43301   73     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I) = ',
43302     1           I8,2X,2A4,2X,A4,2I8,G15.7)
43303        CALL DPWRST('XXX','BUG ')
43304   72   CONTINUE
43305      ENDIF
43306C
43307      IISKIP=0
43308C
43309      DO1200J=JMIN,JMAX
43310C
43311        IF(IISKIP.EQ.1)THEN
43312          IISKIP=0
43313          GOTO1200
43314        ENDIF
43315C
43316        IH1=IHARG(J)
43317        IH2=IHARG2(J)
43318        ICASTO='OFF'
43319C
43320        IF(IH1.EQ.'TO  ')THEN
43321          ICASTO='ON'
43322          JM1=J-1
43323          JP1=J+1
43324          CALL DPEXTL(IHARG(JM1),IHARG2(JM1),IHARG(JP1),IHARG2(JP1),
43325     1                KNUMB,IVAL1,IVAL2,IBUGA2,ISUBRO,IERROR)
43326C
43327          IF(IVAL1.EQ.IVAL2)THEN
43328            IISKIP=1
43329            GOTO1200
43330          ENDIF
43331C
43332          IVA1P1=IVAL1+1
43333          IVA2M1=IVAL2-1
43334          IF(IVA1P1.GT.IVA2M1)GOTO1200
43335          IVAL=IVAL1
43336          IVAL=IVAL+1
43337          IF(IVAL.GE.IVAL2)GOTO1200
43338          CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL,
43339     1                IH1,IH2,IBUGA2,ISUBRO,IERROR)
43340        ENDIF
43341C
43342 1215   CONTINUE
43343C
43344        DO1300I=1,NUMNAM
43345          I2=I
43346          IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN
43347            IF(IUSE(I).EQ.'V')GOTO1320
43348            IF(IUSE(I).EQ.'P')GOTO1320
43349            IF(IUSE(I).EQ.'M')GOTO1320
43350            IF(IUSE(I).EQ.'F')GOTO1310
43351          ENDIF
43352 1300   CONTINUE
43353        GOTO1320
43354C
43355 1310   CONTINUE
43356        NUMSTR=NUMSTR+1
43357        IF(NUMSTR.GT.MAXIND)THEN
43358          WRITE(ICOUT,999)
43359          CALL DPWRST('XXX','BUG ')
43360          WRITE(ICOUT,1331)
43361 1331     FORMAT('***** ERROR IN EXTSTR--')
43362          CALL DPWRST('XXX','BUG ')
43363          WRITE(ICOUT,1332)
43364 1332     FORMAT('      THE NUMBER OF STRINGS PERMITTED HAS JUST')
43365          CALL DPWRST('XXX','BUG ')
43366          WRITE(ICOUT,1334)MAXIND
43367 1334     FORMAT('      EXCEEDED THE ALLOWABLE MAXIMUM (',I8,')')
43368          CALL DPWRST('XXX','BUG ')
43369          WRITE(ICOUT,1336)IH1,IH2
43370 1336     FORMAT('      THE STRING IN QUESTION WAS ',2A4,'   .')
43371          CALL DPWRST('XXX','BUG ')
43372          IERROR='YES'
43373          GOTO9000
43374        ENDIF
43375        ISTRN1(NUMSTR)=IH1
43376        ISTRN2(NUMSTR)=IH2
43377        GOTO1280
43378C
43379 1320   CONTINUE
43380        IF(IWRITE.EQ.'ON')THEN
43381          WRITE(ICOUT,999)
43382          CALL DPWRST('XXX','BUG ')
43383          WRITE(ICOUT,1311)
43384 1311     FORMAT('***** ERROR IN EXTSTR--')
43385          CALL DPWRST('XXX','BUG ')
43386          WRITE(ICOUT,1312)
43387 1312     FORMAT('      A NAME IN THE LIST OF STRINGS INCLUDED THE ',
43388     1           'NAME OF A')
43389          CALL DPWRST('XXX','BUG ')
43390          WRITE(ICOUT,1315)
43391 1315     FORMAT('      NON-EXISTENT STRING OR A NON-STRING.')
43392          CALL DPWRST('XXX','BUG ')
43393          WRITE(ICOUT,1316)IH1,IH2
43394 1316     FORMAT('      THE NAME IN QUESTION WAS ',2A4,'   .')
43395          CALL DPWRST('XXX','BUG ')
43396        ENDIF
43397        IERROR='YES'
43398        GOTO9000
43399C
43400 1280   CONTINUE
43401        IF(ICASTO.EQ.'ON')THEN
43402          IVAL=IVAL+1
43403          IF(IVAL.GE.IVAL2)GOTO1200
43404          CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL,
43405     1                IH1,IH2,IBUGA2,ISUBRO,IERROR)
43406          GOTO1215
43407        ENDIF
43408C
43409 1200 CONTINUE
43410C
43411C               *****************
43412C               **  STEP 90--  **
43413C               **  EXIT       **
43414C               *****************
43415C
43416 9000 CONTINUE
43417      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TSTR')THEN
43418        WRITE(ICOUT,999)
43419        CALL DPWRST('XXX','BUG ')
43420        WRITE(ICOUT,9011)
43421 9011   FORMAT('***** AT THE END       OF EXTSTR--')
43422        CALL DPWRST('XXX','BUG ')
43423        WRITE(ICOUT,9013)IBUGA2,ISUBRO
43424 9013   FORMAT('IBUGA2,ISUBRO = ',A4,2X,A4)
43425        CALL DPWRST('XXX','BUG ')
43426        WRITE(ICOUT,9014)JMIN,JMAX,NUMSTR
43427 9014   FORMAT('JMIN,JMAX,NUMSTR = ',3I8)
43428        CALL DPWRST('XXX','BUG ')
43429        DO9042I=1,NUMSTR
43430          WRITE(ICOUT,9043)I,ISTRN1(I),ISTRN2(I)
43431 9043     FORMAT('I,ISTRN1(I),ISTRN2(I) = ',I8,2(2X,A4))
43432          CALL DPWRST('XXX','BUG ')
43433 9042   CONTINUE
43434      ENDIF
43435C
43436      RETURN
43437      END
43438      SUBROUTINE EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXIND,
43439     1IHNAME,IHNAM2,IUSE,NUMNAM,
43440     1IVARN1,IVARN2,NUMIND,IBUGA2,ISUBRO,IERROR)
43441C
43442C     PURPOSE--EXAMINE IHARG(.) AND IHARG2(.) FROM JMIN TO JMAX,
43443C              EXTRACT ALL NAMES
43444C              (INCLUDING THOSE IMPLIED BY A   TO   KEYWORD)
43445C              AND PLACE THESE NAMES IN IVARN1(.) AND IVARN2(.).
43446C              NOTE THE NUMBER OF SUCH NAMES AND PLACE IT IN NUMIND.
43447C              NUMIND STANDS FOR NUMBER OF INDEPENDENT VARIABLES
43448C              (NOT INCLUDING THE IMPLICIT UNITY VARIABLE).
43449C     NOTE--JMIN   = START POINT IN IHARG/IHARG2 FOR THE SCAN
43450C           JMAX   = STOP POINT  IN IHARG/IHARG2 FOR THE SCAN
43451C           MAXIND = MAXIMUM PERMITTED NUMBER OF VARIABLES
43452C     NOTE--THIS SUBROUTINE IS USED IN CONJUNCTION
43453C           WITH THE MULTI-LINEAR OPTION OF THE FIT COMMAND;
43454C           IT IS CALLED BY DPFIT.
43455C     NOTE--THIS SUBROUTINE ALSO CHECKS TO MAKE SURE THE
43456C           LIST ITEMS ARE IN FACT VARIABLES (AS OPPOSED
43457C           TO PARAMETERS, FUNCTIONS, MATRICES, OR
43458C           UNKNOWNS).
43459C     OUTPUT--IVARN1(.), IVARN2(.), AND NUMIND.
43460C     EXAMPLE--FIT Y X1 X2 X3
43461C              WOULD YIELD NUMIND = 3
43462C     EXAMPLE--FIT Y X1 TO X15
43463C              WOULD YIELD NUMIND = 15
43464C     EXAMPLE--FIT Y R1 R2 X5 TO X11 Z1 Z2
43465C              WOULD YIELD NUMIND = 11
43466C     ORIGINAL VERSION--JUNE      1989.
43467C     UPDATED         --JULY      1989. FIX FORMAT STATEMENT
43468C     UPDATED         --JULY      2009. ALLOW "Y1 TO Y1" (USEFUL FOR
43469C                                       MACROS WHERE NUMBER OF VARIABLES
43470C                                       NOT KNOWN IN ADVANCE)
43471C
43472C---------------------------------------------------------------------
43473C
43474      DIMENSION IHARG(*)
43475      DIMENSION IHARG2(*)
43476      DIMENSION IHNAME(*)
43477      DIMENSION IHNAM2(*)
43478      DIMENSION IUSE(*)
43479      DIMENSION IVARN1(*)
43480      DIMENSION IVARN2(*)
43481C
43482C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
43483C
43484      CHARACTER*4 IHARG
43485      CHARACTER*4 IHARG2
43486      CHARACTER*4 IHNAME
43487      CHARACTER*4 IHNAM2
43488      CHARACTER*4 IUSE
43489      CHARACTER*4 IVARN1
43490      CHARACTER*4 IVARN2
43491      CHARACTER*4 IBUGA2
43492      CHARACTER*4 ISUBRO
43493      CHARACTER*4 IERROR
43494C
43495      CHARACTER*4 IH1
43496      CHARACTER*4 IH2
43497      CHARACTER*4 ICASTO
43498C
43499C-----COMMON----------------------------------------------------------
43500C
43501      INCLUDE 'DPCOPA.INC'
43502      INCLUDE 'DPCOP2.INC'
43503C
43504C-----START POINT-----------------------------------------------------
43505C
43506      NUMIND=0
43507      JM1=0
43508C
43509      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'TVAR')GOTO90
43510      WRITE(ICOUT,999)
43511  999 FORMAT(1X)
43512      CALL DPWRST('XXX','BUG ')
43513      WRITE(ICOUT,51)
43514   51 FORMAT('***** AT THE BEGINNING OF EXTVAR--')
43515      CALL DPWRST('XXX','BUG ')
43516      WRITE(ICOUT,53)IBUGA2,ISUBRO
43517   53 FORMAT('IBUGA2,ISUBRO = ',A4,2X,A4)
43518      CALL DPWRST('XXX','BUG ')
43519      WRITE(ICOUT,54)JMIN,JMAX,MAXIND,NUMIND
43520   54 FORMAT('JMIN,JMAX,MAXIND,NUMIND = ',4I8)
43521      CALL DPWRST('XXX','BUG ')
43522      WRITE(ICOUT,61)NUMARG
43523   61 FORMAT('NUMARG = ',A4)
43524      CALL DPWRST('XXX','BUG ')
43525      DO62I=1,NUMARG
43526      WRITE(ICOUT,63)I,IHARG(I),IHARG2(I)
43527   63 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,2X,A4)
43528      CALL DPWRST('XXX','BUG ')
43529   62 CONTINUE
43530      WRITE(ICOUT,71)NUMNAM
43531   71 FORMAT('NUMNAM = ',I8)
43532      CALL DPWRST('XXX','BUG ')
43533      DO72I=1,NUMNAM
43534      WRITE(ICOUT,73)I,IHNAME(I),IHNAM2(I),IUSE(I)
43535   73 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I) = ',
43536     1I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
43537      CALL DPWRST('XXX','BUG ')
43538   72 CONTINUE
43539   90 CONTINUE
43540C
43541      IISKIP=0
43542C
43543      DO1200J=JMIN,JMAX
43544C
43545      IF(IISKIP.EQ.1)THEN
43546        IISKIP=0
43547        GOTO1200
43548      ENDIF
43549C
43550      IH1=IHARG(J)
43551      IH2=IHARG2(J)
43552      ICASTO='OFF'
43553C
43554      IF (IH1.EQ.'TO  ')GOTO1210
43555      GOTO1220
43556C
43557 1210 CONTINUE
43558      ICASTO='ON'
43559      JM1=J-1
43560      JP1=J+1
43561      CALL DPEXTL(IHARG(JM1),IHARG2(JM1),IHARG(JP1),IHARG2(JP1),
43562     1KNUMB,IVAL1,IVAL2,IBUGA2,ISUBRO,IERROR)
43563C
43564      IF(IVAL1.EQ.IVAL2)THEN
43565        IISKIP=1
43566        GOTO1200
43567      ENDIF
43568C
43569      IVA1P1=IVAL1+1
43570      IVA2M1=IVAL2-1
43571      IF(IVA1P1.GT.IVA2M1)GOTO1200
43572      IVAL=IVAL1
43573C
43574 1215 CONTINUE
43575      IVAL=IVAL+1
43576      IF(IVAL.GE.IVAL2)GOTO1200
43577C
43578      CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL,
43579     1IH1,IH2,IBUGA2,ISUBRO,IERROR)
43580      GOTO1220
43581C
43582 1220 CONTINUE
43583      DO1300I=1,NUMNAM
43584      I2=I
43585      IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))GOTO1305
43586      GOTO1300
43587 1305 CONTINUE
43588      IF(IUSE(I).EQ.'V')GOTO1310
43589      IF(IUSE(I).EQ.'P')GOTO1320
43590      IF(IUSE(I).EQ.'M')GOTO1320
43591      IF(IUSE(I).EQ.'F')GOTO1320
43592 1300 CONTINUE
43593      GOTO1320
43594C
43595 1310 CONTINUE
43596      NUMIND=NUMIND+1
43597      IF(NUMIND.GT.MAXIND)GOTO1330
43598      IVARN1(NUMIND)=IH1
43599      IVARN2(NUMIND)=IH2
43600      GOTO1280
43601C
43602 1320 CONTINUE
43603      WRITE(ICOUT,999)
43604      CALL DPWRST('XXX','BUG ')
43605      WRITE(ICOUT,1311)
43606 1311 FORMAT('***** ERROR IN EXTVAR--')
43607      CALL DPWRST('XXX','BUG ')
43608      WRITE(ICOUT,1312)
43609 1312 FORMAT('      A NAME IN THE LIST ')
43610      CALL DPWRST('XXX','BUG ')
43611      WRITE(ICOUT,1313)
43612 1313 FORMAT('      OF VARIABLES TO BE FIT ')
43613      CALL DPWRST('XXX','BUG ')
43614      WRITE(ICOUT,1314)
43615 1314 FORMAT('      INCLUDED THE NAME OF A ')
43616      CALL DPWRST('XXX','BUG ')
43617      WRITE(ICOUT,1315)
43618 1315 FORMAT('      NON-EXISTENT VARIABLE OR A NON-VARIABLE.')
43619      CALL DPWRST('XXX','BUG ')
43620      WRITE(ICOUT,1316)IH1,IH2
43621 1316 FORMAT('      THE NAME IN QUESTION WAS ',
43622     12A4,'   .')
43623      CALL DPWRST('XXX','BUG ')
43624      WRITE(ICOUT,1317)
43625 1317 FORMAT('      NO FIT WAS CARRIED OUT.')
43626      CALL DPWRST('XXX','BUG ')
43627      IERROR='YES'
43628      GOTO9000
43629C
43630 1330 CONTINUE
43631      WRITE(ICOUT,999)
43632      CALL DPWRST('XXX','BUG ')
43633      WRITE(ICOUT,1331)
43634 1331 FORMAT('***** ERROR IN EXTVAR--')
43635      CALL DPWRST('XXX','BUG ')
43636      WRITE(ICOUT,1332)
43637 1332 FORMAT('      THE NUMBER OF VARIABLES PERMITTED')
43638      CALL DPWRST('XXX','BUG ')
43639      WRITE(ICOUT,1333)
43640 1333 FORMAT('      IN A MULTI-LINEAR FIT')
43641      CALL DPWRST('XXX','BUG ')
43642      WRITE(ICOUT,1334)
43643 1334 FORMAT('      HAS JUST EXCEEDED THE ALLOWABLE MAXIMUM')
43644      CALL DPWRST('XXX','BUG ')
43645      WRITE(ICOUT,1335)MAXIND
43646 1335 FORMAT('       (',I8,')')
43647      CALL DPWRST('XXX','BUG ')
43648      WRITE(ICOUT,1336)IH1,IH2
43649 1336 FORMAT('      THE VARIBLE IN QUESTION WAS ',
43650     12A4,'   .')
43651      CALL DPWRST('XXX','BUG ')
43652      WRITE(ICOUT,1337)
43653 1337 FORMAT('      NO FIT WAS CARRIED OUT.')
43654      CALL DPWRST('XXX','BUG ')
43655      IERROR='YES'
43656      GOTO9000
43657C
43658 1280 CONTINUE
43659      IF(ICASTO.EQ.'ON')GOTO1215
43660C
43661 1200 CONTINUE
43662C
43663C               *****************
43664C               **  STEP 90--  **
43665C               **  EXIT       **
43666C               *****************
43667C
43668 9000 CONTINUE
43669      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'TVAR')GOTO9090
43670      WRITE(ICOUT,999)
43671      CALL DPWRST('XXX','BUG ')
43672      WRITE(ICOUT,9011)
43673 9011 FORMAT('***** AT THE END       OF EXTVAR--')
43674      CALL DPWRST('XXX','BUG ')
43675      WRITE(ICOUT,9013)IBUGA2,ISUBRO
43676 9013 FORMAT('IBUGA2,ISUBRO = ',A4,2X,A4)
43677      CALL DPWRST('XXX','BUG ')
43678      WRITE(ICOUT,9014)JMIN,JMAX,NUMIND
43679 9014 FORMAT('JMIN,JMAX,NUMIND = ',3I8)
43680      CALL DPWRST('XXX','BUG ')
43681      WRITE(ICOUT,9021)NUMARG
43682 9021 FORMAT('NUMARG = ',A4)
43683      CALL DPWRST('XXX','BUG ')
43684      DO9022I=1,NUMARG
43685      WRITE(ICOUT,9023)I,IHARG(I),IHARG2(I)
43686 9023 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,2X,A4)
43687      CALL DPWRST('XXX','BUG ')
43688 9022 CONTINUE
43689      WRITE(ICOUT,9031)NUMNAM
43690 9031 FORMAT('NUMNAM = ',I8)
43691      CALL DPWRST('XXX','BUG ')
43692      DO9032I=1,NUMNAM
43693      WRITE(ICOUT,9033)I,IHNAME(I),IHNAM2(I),IUSE(I)
43694CCCCC THE FOLLOWING FORMAT STATEMENT WAS FIXED JULY 1989
43695      CALL DPWRST('XXX','BUG ')
43696C9033 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I) = ',
43697CCCCC1I8,2X,A4,A4,2X,A4,I8,I8,E1901.7)
43698 9033 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I) = ',
43699     1I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
43700 9032 CONTINUE
43701      WRITE(ICOUT,9041)NUMIND
43702 9041 FORMAT('NUMIND = ',I8)
43703      CALL DPWRST('XXX','BUG ')
43704      DO9042I=1,NUMIND
43705      WRITE(ICOUT,9043)I,IVARN1(I),IVARN2(I)
43706 9043 FORMAT('I,IVARN1(I),IVARN2(I) = ',I8,2X,A4,2X,A4)
43707      CALL DPWRST('XXX','BUG ')
43708 9042 CONTINUE
43709 9090 CONTINUE
43710C
43711      RETURN
43712      END
43713      SUBROUTINE EXTVA2(IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,MAXIND,
43714     1                  IHNAME,IHNAM2,IUSE,NUMNAM,
43715     1                  IVARN1,IVARN2,IVARTY,PVAR,NUMIND,
43716     1                  IFLAGM,IFLAGP,IFLAGT,
43717     1                  IBUGA2,ISUBRO,IERROR)
43718C
43719C     PURPOSE--EXAMINE IHARG(.) AND IHARG2(.) FROM JMIN TO JMAX, EXTRACT
43720C              ALL NAMES (INCLUDING THOSE IMPLIED BY A   TO   KEYWORD)
43721C              AND PLACE THESE NAMES IN IVARN1(.) AND IVARN2(.).
43722C              NOTE THE NUMBER OF SUCH NAMES AND PLACE IT IN NUMIND.
43723C              NUMIND STANDS FOR NUMBER OF INDEPENDENT VARIABLES
43724C              (NOT INCLUDING THE IMPLICIT UNITY VARIABLE).
43725C              THIS ROUTINE IS SIMILAR TO "EXTVAR".  HOWEVER, IT
43726C              ALSO ALLOWS PARAMETER NAMES, NUMERIC VALUES, AND
43727C              MATRIX NAMES TO BE EXTRACTED.  THE ARRAY "IVARTY"
43728C              WILL BE CREATED TO STORE THE NAME TYPE AND PVAR
43729C              WILL CONTAIN THE VALUE OF ANY NUMERIC VALUES ENTERED.
43730C              THIS WILL MAKE THE "DPPARS" ROUTINE MORE GENERAL IN
43731C              THAT IT CAN HANDLE COMMANDS THAT ALLOW MATRICES AND
43732C              PARAMETER/SCALAR TO BE USED AS ARGUMENTS.
43733C     NOTE--JMIN   = START POINT IN IHARG/IHARG2 FOR THE SCAN
43734C           JMAX   = STOP POINT  IN IHARG/IHARG2 FOR THE SCAN
43735C           MAXIND = MAXIMUM PERMITTED NUMBER OF VARIABLES
43736C     OUTPUT--IVARN1(.), IVARN2(.), IVARTY(.), PVAR(.) AND NUMIND.
43737C     ORIGINAL VERSION--SEPTEMBER 2009.
43738C
43739C---------------------------------------------------------------------
43740C
43741      CHARACTER*4 IHARG(*)
43742      CHARACTER*4 IHARG2(*)
43743      CHARACTER*4 IARGT(*)
43744      CHARACTER*4 IHNAME(*)
43745      CHARACTER*4 IHNAM2(*)
43746      CHARACTER*4 IUSE(*)
43747      CHARACTER*4 IVARN1(*)
43748      CHARACTER*4 IVARN2(*)
43749      CHARACTER*4 IVARTY(*)
43750      REAL        ARG(*)
43751      REAL        PVAR(*)
43752C
43753C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
43754C
43755      CHARACTER*4 IBUGA2
43756      CHARACTER*4 ISUBRO
43757      CHARACTER*4 IERROR
43758C
43759      CHARACTER*4 IH1
43760      CHARACTER*4 IH2
43761      CHARACTER*4 IHT
43762      CHARACTER*4 ICASTO
43763C
43764C-----COMMON----------------------------------------------------------
43765C
43766      INCLUDE 'DPCOPA.INC'
43767      INCLUDE 'DPCOP2.INC'
43768C
43769C-----START POINT-----------------------------------------------------
43770C
43771      NUMIND=0
43772      JM1=0
43773C
43774      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TVA2')THEN
43775        WRITE(ICOUT,999)
43776  999   FORMAT(1X)
43777        CALL DPWRST('XXX','BUG ')
43778        WRITE(ICOUT,51)
43779   51   FORMAT('***** AT THE BEGINNING OF EXTVA2--')
43780        CALL DPWRST('XXX','BUG ')
43781        WRITE(ICOUT,53)IBUGA2,ISUBRO,IFLAGM,IFLAGP,IFLAGT
43782   53   FORMAT('IBUGA2,ISUBRO,IFLAGM,IFLAGP,IFLAGT = ',2(A4,2X),3I5)
43783        CALL DPWRST('XXX','BUG ')
43784        WRITE(ICOUT,54)JMIN,JMAX,MAXIND,NUMIND,NUMARG
43785   54   FORMAT('JMIN,JMAX,MAXIND,NUMIND,NUMARG = ',5I8)
43786        CALL DPWRST('XXX','BUG ')
43787        IF(NUMARG.GE.1)THEN
43788          DO62I=1,NUMARG
43789            WRITE(ICOUT,63)I,IHARG(I),IHARG2(I),IARGT(I),ARG(I)
43790   63       FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),ARG(I) = ',
43791     1             I8,2X,3(A4,2X),G15.7)
43792            CALL DPWRST('XXX','BUG ')
43793   62     CONTINUE
43794        ENDIF
43795        WRITE(ICOUT,71)NUMNAM
43796   71   FORMAT('NUMNAM = ',I8)
43797        CALL DPWRST('XXX','BUG ')
43798        DO72I=1,NUMNAM
43799          WRITE(ICOUT,73)I,IHNAME(I),IHNAM2(I),IUSE(I)
43800   73     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I) = ',
43801     1           I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
43802          CALL DPWRST('XXX','BUG ')
43803   72   CONTINUE
43804      ENDIF
43805C
43806      IISKIP=0
43807C
43808      DO1200J=JMIN,JMAX
43809C
43810C       CHECK FIRST TO SEE IF THE ARGUMENT IS ACTUALLY
43811C       A "NUMBER" (AS OPPOSSED TO A VARIABLE OR PARAMETER
43812C       NAME).
43813C
43814C       2010/12: MOVE THIS BELOW.
43815C
43816CCCCC   IF(IARGT(J).EQ.'NUMB')THEN
43817CCCCC     NUMIND=NUMIND+1
43818CCCCC     IF(NUMIND.GT.MAXIND)GOTO1330
43819CCCCC     IVARN1(NUMIND)='    '
43820CCCCC     IVARN2(NUMIND)='    '
43821CCCCC     IVARTY(NUMIND)='NUMB'
43822CCCCC     PVAR(NUMIND)=ARG(J)
43823CCCCC     GOTO1200
43824CCCCC   ENDIF
43825C
43826        IF(IISKIP.EQ.1)THEN
43827          IISKIP=0
43828          GOTO1200
43829        ENDIF
43830C
43831        IH1=IHARG(J)
43832        IH2=IHARG2(J)
43833        ICASTO='OFF'
43834C
43835        IF(IH1.EQ.'TO  ')GOTO1210
43836        GOTO1220
43837C
43838 1210   CONTINUE
43839          ICASTO='ON'
43840          JM1=J-1
43841          JP1=J+1
43842          CALL DPEXTL(IHARG(JM1),IHARG2(JM1),IHARG(JP1),IHARG2(JP1),
43843     1                KNUMB,IVAL1,IVAL2,IBUGA2,ISUBRO,IERROR)
43844C
43845          IF(IVAL1.EQ.IVAL2)THEN
43846            IISKIP=1
43847            GOTO1200
43848          ENDIF
43849C
43850          IVA1P1=IVAL1+1
43851          IVA2M1=IVAL2-1
43852          IF(IVA1P1.GT.IVA2M1)GOTO1200
43853          IVAL=IVAL1
43854C
43855 1215     CONTINUE
43856          IVAL=IVAL+1
43857          IF(IVAL.GE.IVAL2)GOTO1200
43858C
43859          CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL,
43860     1                IH1,IH2,IBUGA2,ISUBRO,IERROR)
43861          GOTO1220
43862C
43863 1220   CONTINUE
43864        IHT='NONE'
43865        DO1300I=1,NUMNAM
43866          I2=I
43867          IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN
43868            IHT=IUSE(I)
43869            IF(IUSE(I).EQ.'V')THEN
43870              NUMIND=NUMIND+1
43871              IF(NUMIND.GT.MAXIND)GOTO1330
43872              IVARN1(NUMIND)=IH1
43873              IVARN2(NUMIND)=IH2
43874              IVARTY(NUMIND)='VARI'
43875              PVAR(NUMIND)=CPUMIN
43876              IF(ICASTO.EQ.'ON')GOTO1215
43877              GOTO1200
43878            ELSEIF(IUSE(I).EQ.'P')THEN
43879              IF(IFLAGP.EQ.0)GOTO1320
43880              NUMIND=NUMIND+1
43881              IF(NUMIND.GT.MAXIND)GOTO1330
43882              IVARN1(NUMIND)=IH1
43883              IVARN2(NUMIND)=IH2
43884              IVARTY(NUMIND)='PARA'
43885              PVAR(NUMIND)=CPUMIN
43886              IF(ICASTO.EQ.'ON')GOTO1215
43887              GOTO1200
43888            ELSEIF(IUSE(I).EQ.'M')THEN
43889              IF(IFLAGM.EQ.0)GOTO1320
43890              NUMIND=NUMIND+1
43891              IF(NUMIND.GT.MAXIND)GOTO1330
43892              IVARN1(NUMIND)=IH1
43893              IVARN2(NUMIND)=IH2
43894              IVARTY(NUMIND)='MATR'
43895              PVAR(NUMIND)=CPUMIN
43896              IF(ICASTO.EQ.'ON')GOTO1215
43897              GOTO1200
43898            ELSEIF(IUSE(I).EQ.'F')THEN
43899              IF(IFLAGT.EQ.0)GOTO1320
43900              NUMIND=NUMIND+1
43901              IF(NUMIND.GT.MAXIND)GOTO1330
43902              IVARN1(NUMIND)=IH1
43903              IVARN2(NUMIND)=IH2
43904              IVARTY(NUMIND)='F   '
43905              PVAR(NUMIND)=CPUMIN
43906              IF(ICASTO.EQ.'ON')GOTO1215
43907              GOTO1200
43908            ENDIF
43909          ENDIF
43910 1300   CONTINUE
43911C
43912C       2010/12: IF NO NAME FOUND, CHECK IF IT IS A LITERAL
43913C                NUMBER.
43914C
43915        IF(IARGT(J).EQ.'NUMB')THEN
43916          NUMIND=NUMIND+1
43917          IF(NUMIND.GT.MAXIND)GOTO1330
43918          IVARN1(NUMIND)='    '
43919          IVARN2(NUMIND)='    '
43920          IVARTY(NUMIND)='NUMB'
43921          PVAR(NUMIND)=ARG(J)
43922          GOTO1200
43923        ENDIF
43924C
43925        IF(IFLAGT.EQ.1)THEN
43926          NUMIND=NUMIND+1
43927          IF(NUMIND.GT.MAXIND)GOTO1330
43928          IVARN1(NUMIND)=IH1
43929          IVARN2(NUMIND)=IH2
43930          IVARTY(NUMIND)='UNKN'
43931          PVAR(NUMIND)=CPUMIN
43932          IF(ICASTO.EQ.'ON')GOTO1215
43933          GOTO1200
43934        ENDIF
43935C
43936 1320   CONTINUE
43937        WRITE(ICOUT,999)
43938        CALL DPWRST('XXX','BUG ')
43939        WRITE(ICOUT,1311)
43940 1311   FORMAT('***** ERROR IN EXTVA2--')
43941        CALL DPWRST('XXX','BUG ')
43942        WRITE(ICOUT,1312)
43943 1312   FORMAT('      A NAME IN THE LIST OF EXTRACTED NAMES INCLUDED A')
43944        CALL DPWRST('XXX','BUG ')
43945        WRITE(ICOUT,1315)
43946 1315   FORMAT('      NON-EXISTENT NAME OR A NAME OF THE WRONG TYPE.')
43947        CALL DPWRST('XXX','BUG ')
43948        WRITE(ICOUT,1316)IH1,IH2,IHT
43949 1316   FORMAT('      THE NAME IN QUESTION WAS ',A4,A4,' AND IS OF ',
43950     1         'TYPE ',A4)
43951        CALL DPWRST('XXX','BUG ')
43952        IERROR='YES'
43953        GOTO9000
43954C
43955 1330   CONTINUE
43956        WRITE(ICOUT,999)
43957        CALL DPWRST('XXX','BUG ')
43958        WRITE(ICOUT,1311)
43959        CALL DPWRST('XXX','BUG ')
43960        WRITE(ICOUT,1332)
43961 1332   FORMAT('      THE NUMBER OF VARIABLES EXTRACTED FROM THIS ',
43962     1         'COMMAND HAS JUST')
43963        CALL DPWRST('XXX','BUG ')
43964        WRITE(ICOUT,1334)MAXIND
43965 1334   FORMAT('      EXCEEDED THE ALLOWABLE MAXIMUM (',I8,')')
43966        CALL DPWRST('XXX','BUG ')
43967        WRITE(ICOUT,1316)IH1,IH2,IHT
43968        CALL DPWRST('XXX','BUG ')
43969        IERROR='YES'
43970        GOTO9000
43971C
43972 1200 CONTINUE
43973C
43974C               *****************
43975C               **  STEP 90--  **
43976C               **  EXIT       **
43977C               *****************
43978C
43979 9000 CONTINUE
43980      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TVA2')THEN
43981        WRITE(ICOUT,999)
43982        CALL DPWRST('XXX','BUG ')
43983        WRITE(ICOUT,9011)
43984 9011   FORMAT('***** AT THE END       OF EXTVA2--')
43985        CALL DPWRST('XXX','BUG ')
43986        WRITE(ICOUT,9013)IBUGA2,ISUBRO
43987 9013   FORMAT('IBUGA2,ISUBRO = ',A4,2X,A4)
43988        CALL DPWRST('XXX','BUG ')
43989        WRITE(ICOUT,9014)JMIN,JMAX,NUMIND,NUMARG
43990 9014   FORMAT('JMIN,JMAX,NUMIND,NUMARG = ',4I8)
43991        CALL DPWRST('XXX','BUG ')
43992        WRITE(ICOUT,9041)NUMIND
43993 9041   FORMAT('NUMIND = ',I8)
43994        CALL DPWRST('XXX','BUG ')
43995        IF(NUMIND.GE.1)THEN
43996          DO9042I=1,NUMIND
43997            WRITE(ICOUT,9043)I,IVARN1(I),IVARN2(I),IVARTY(I),PVAR(I)
43998 9043       FORMAT('I,IVARN1(I),IVARN2(I),IVARTY(I),PVAR(I) = ',
43999     1             I8,2X,A4,2X,A4,2X,A4,2X,G15.7)
44000            CALL DPWRST('XXX','BUG ')
44001 9042     CONTINUE
44002        ENDIF
44003      ENDIF
44004C
44005      RETURN
44006      END
44007      SUBROUTINE EXTVA3(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXIND,
44008     1                  IHNAME,IHNAM2,NUMNAM,
44009     1                  IVARN1,IVARN2,NUMIND,
44010     1                  IBUGA2,ISUBRO,IERROR)
44011C
44012C     PURPOSE--EXAMINE IHARG(.) AND IHARG2(.) FROM JMIN TO JMAX, EXTRACT
44013C              ALL NAMES (INCLUDING THOSE IMPLIED BY A   TO   KEYWORD)
44014C              AND PLACE THESE NAMES IN IVARN1(.) AND IVARN2(.).
44015C              NOTE THE NUMBER OF SUCH NAMES AND PLACE IT IN NUMIND.
44016C              NUMIND STANDS FOR NUMBER OF INDEPENDENT VARIABLES
44017C              (NOT INCLUDING THE IMPLICIT UNITY VARIABLE).
44018C              THIS ROUTINE IS SIMILAR TO "EXTVAR" AND "EXTVA2".  HOWEVER,
44019C              THIS ROUTINE SIMPLY RETURNS THE LIST OF NAMES WITHOUT ANY
44020C              ERROR PROCESSING (I.E., DO NOT CHECK FOR EXISTENCE OR
44021C              TYPE).
44022C     NOTE--JMIN   = START POINT IN IHARG/IHARG2 FOR THE SCAN
44023C           JMAX   = STOP POINT  IN IHARG/IHARG2 FOR THE SCAN
44024C           MAXIND = MAXIMUM PERMITTED NUMBER OF VARIABLES
44025C     OUTPUT--IVARN1(.), IVARN2(.), AND NUMIND.
44026C     ORIGINAL VERSION--SEPTEMBER 2009.
44027C
44028C---------------------------------------------------------------------
44029C
44030      CHARACTER*4 IHARG(*)
44031      CHARACTER*4 IHARG2(*)
44032      CHARACTER*4 IHNAME(*)
44033      CHARACTER*4 IHNAM2(*)
44034      CHARACTER*4 IVARN1(*)
44035      CHARACTER*4 IVARN2(*)
44036C
44037C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
44038C
44039      CHARACTER*4 IBUGA2
44040      CHARACTER*4 ISUBRO
44041      CHARACTER*4 IERROR
44042C
44043      CHARACTER*4 IH1
44044      CHARACTER*4 IH2
44045      CHARACTER*4 ICASTO
44046C
44047C-----COMMON----------------------------------------------------------
44048C
44049      INCLUDE 'DPCOPA.INC'
44050      INCLUDE 'DPCOP2.INC'
44051C
44052C-----START POINT-----------------------------------------------------
44053C
44054      NUMIND=0
44055      JM1=0
44056C
44057      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TVA3')THEN
44058        WRITE(ICOUT,999)
44059  999   FORMAT(1X)
44060        CALL DPWRST('XXX','BUG ')
44061        WRITE(ICOUT,51)
44062   51   FORMAT('***** AT THE BEGINNING OF EXTVA3--')
44063        CALL DPWRST('XXX','BUG ')
44064        WRITE(ICOUT,53)IBUGA2,ISUBRO,JMIN,JMAX,NUMARG,NUMNAM,MAXIND
44065   53   FORMAT('IBUGA2,ISUBRO,JMIN,JMAX,NUMARG,NUMNAM,MAXIND = ',
44066     1         2(A4,2X),5I8)
44067        CALL DPWRST('XXX','BUG ')
44068        IF(NUMARG.GE.1)THEN
44069          DO62I=1,NUMARG
44070            WRITE(ICOUT,63)I,IHARG(I),IHARG2(I)
44071   63       FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2(2X,A4))
44072            CALL DPWRST('XXX','BUG ')
44073   62     CONTINUE
44074        ENDIF
44075        DO72I=1,NUMNAM
44076          WRITE(ICOUT,73)I,IHNAME(I),IHNAM2(I)
44077   73     FORMAT('I,IHNAME(I),IHNAM2(I) = ',I8,2(A4,2X))
44078          CALL DPWRST('XXX','BUG ')
44079   72   CONTINUE
44080      ENDIF
44081C
44082      IISKIP=0
44083C
44084      DO1200J=JMIN,JMAX
44085C
44086        IF(IISKIP.EQ.1)THEN
44087          IISKIP=0
44088          GOTO1200
44089        ENDIF
44090C
44091        IH1=IHARG(J)
44092        IH2=IHARG2(J)
44093        ICASTO='OFF'
44094C
44095        IF(IH1.NE.'TO  ')GOTO1220
44096C
44097          ICASTO='ON'
44098          JM1=J-1
44099          JP1=J+1
44100          CALL DPEXTL(IHARG(JM1),IHARG2(JM1),IHARG(JP1),IHARG2(JP1),
44101     1                KNUMB,IVAL1,IVAL2,IBUGA2,ISUBRO,IERROR)
44102C
44103          IF(IVAL1.EQ.IVAL2)THEN
44104            IISKIP=1
44105            GOTO1200
44106          ENDIF
44107C
44108          IVA1P1=IVAL1+1
44109          IVA2M1=IVAL2-1
44110          IF(IVA1P1.GT.IVA2M1)GOTO1200
44111          IVAL=IVAL1
44112C
44113 1215     CONTINUE
44114          IVAL=IVAL+1
44115          IF(IVAL.GE.IVAL2)GOTO1200
44116C
44117          CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL,
44118     1                IH1,IH2,IBUGA2,ISUBRO,IERROR)
44119C
44120 1220   CONTINUE
44121        NUMIND=NUMIND+1
44122        IVARN1(NUMIND)=IH1
44123        IVARN2(NUMIND)=IH2
44124        IF(ICASTO.EQ.'ON')GOTO1215
44125C
44126 1200 CONTINUE
44127C
44128C               *****************
44129C               **  STEP 90--  **
44130C               **  EXIT       **
44131C               *****************
44132C
44133      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TVA2')THEN
44134        WRITE(ICOUT,999)
44135        CALL DPWRST('XXX','BUG ')
44136        WRITE(ICOUT,9011)
44137 9011   FORMAT('***** AT THE END       OF EXTVA3--')
44138        CALL DPWRST('XXX','BUG ')
44139        WRITE(ICOUT,9013)IBUGA2,ISUBRO
44140 9013   FORMAT('IBUGA2,ISUBRO = ',A4,2X,A4)
44141        CALL DPWRST('XXX','BUG ')
44142        WRITE(ICOUT,9014)JMIN,JMAX,NUMIND,NUMARG
44143 9014   FORMAT('JMIN,JMAX,NUMIND,NUMARG = ',4I8)
44144        CALL DPWRST('XXX','BUG ')
44145        IF(NUMIND.GE.1)THEN
44146          DO9042I=1,NUMIND
44147            WRITE(ICOUT,9043)I,IVARN1(I),IVARN2(I)
44148 9043       FORMAT('I,IVARN1(I),IVARN2(I) = ',
44149     1             I8,2X,A4,2X,A4,2X,A4,2X,G15.7)
44150            CALL DPWRST('XXX','BUG ')
44151 9042     CONTINUE
44152        ENDIF
44153      ENDIF
44154C
44155      RETURN
44156      END
44157      SUBROUTINE FALNEG(X,Y,N,IWRITE,XIDTEM,STAT,IBUGA3,IERROR)
44158C
44159C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROPORTION OF
44160C              FALSE NEGATIVES BETEEN TWO VARIABLES.
44161C
44162C              THIS IS SPECIFICALLY FOR THE 2X2 CASE.  THAT IS,
44163C              EACH VARIABLE HAS TWO MUTUALLY EXCLUSIVE
44164C              CHOICES CODED AS 1 (FOR SUCCESS) OR 0 (FOR
44165C              FAILURE).  A FALSE NEGATIVE IS DEFINED AS THE
44166C              ERROR WHERE THE SECOND VARIABLE IS 1 AND THE FIRST
44167C              VARIABLE IS A 0.
44168C
44169C              A TYPICAL EXAMPLE WOULD BE WHERE VARIABLE ONE
44170C              DENOTES THE GROUND TRUTH AND A VALUE OF 1
44171C              INDICATES "PRESENT" AND A VALUE OF 0 INDICATES
44172C              "NOT PRESENT".  VARIABLE TWO REPRESENTS SOME TYPE
44173C              OF DETECTION DEVICE WHERE A VALUE OF 1 INDICATES
44174C              THE DEVICE DETECTED THE SPECIFIED OBJECT WHILE A
44175C              VALUE OF 0 INDICATES THAT THE OBJECT WAS NOT
44176C              DETECTED.  A FALSE NEGATIVE THEN IS THE CASE WHERE
44177C              THE DEVICE FAILED TO DETECT THE OBJECT WHEN IT WAS
44178C              ACTUALY THERE.
44179C
44180C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
44181C                                (UNSORTED) OBSERVATIONS
44182C                                WHICH CONSTITUTE THE FIRST SET
44183C                                OF DATA.
44184C                     --Y      = THE SINGLE PRECISION VECTOR OF
44185C                                (UNSORTED) OBSERVATIONS
44186C                                WHICH CONSTITUTE THE SECOND SET
44187C                                OF DATA.
44188C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
44189C                                IN THE VECTOR X, OR EQUIVALENTLY,
44190C                                THE INTEGER NUMBER OF OBSERVATIONS
44191C                                IN THE VECTOR Y.
44192C     OUTPUT ARGUMENTS--STAT   = THE SINGLE PRECISION VALUE OF THE
44193C                                COMPUTED FALSE NEGATIVE PROPORTION
44194C                                BETWEEN THE 2 SETS OF DATA
44195C                                IN THE INPUT VECTORS X AND Y.
44196C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
44197C             SAMPLE FALSE NEGATIVE PROPORTION BETWEEN THE 2 SETS
44198C             OF DATA IN THE INPUT VECTORS X AND Y.
44199C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
44200C                   OF N FOR THIS SUBROUTINE.
44201C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
44202C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
44203C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
44204C     LANGUAGE--ANSI FORTRAN (1977)
44205C     WRITTEN BY--JAMES J. FILLIBEN
44206C                 STATISTICAL ENGINEERING DIVISION
44207C                 INFORMATION TECHNOLOGY LABORATORY
44208C                 NATIONAL INSTIUTE OF STANDARDS AND TECHNOLOGY
44209C                 GAITHERSBURG, MD 20899-8980
44210C                 PHONE--301-975-2899
44211C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
44212C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
44213C     LANGUAGE--ANSI FORTRAN (1977)
44214C     VERSION NUMBER--2007/3
44215C     ORIGINAL VERSION--MARCH     2007.
44216C     UPDATED         --AUGUST    2007. IF 2X2 CASE, CHECK IF SUM
44217C                                       OF ENTRIES IS <= 4.  IN THIS
44218C                                       CASE, ASSUME WE HAVE RAW DATA
44219C
44220C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
44221C
44222      CHARACTER*4 IWRITE
44223      CHARACTER*4 IBUGA3
44224      CHARACTER*4 IERROR
44225C
44226      CHARACTER*4 ISTEPN
44227      CHARACTER*4 ISUBN1
44228      CHARACTER*4 ISUBN2
44229C
44230C---------------------------------------------------------------------
44231C
44232      DIMENSION X(*)
44233      DIMENSION Y(*)
44234      DIMENSION XIDTEM(*)
44235C
44236C-----COMMON----------------------------------------------------------
44237C
44238      INCLUDE 'DPCOP2.INC'
44239C
44240C-----START POINT-----------------------------------------------------
44241C
44242      ISUBN1='FALN'
44243      ISUBN2='EG  '
44244      IERROR='NO'
44245C
44246C
44247      IF(IBUGA3.EQ.'ON')THEN
44248        WRITE(ICOUT,999)
44249  999   FORMAT(1X)
44250        CALL DPWRST('XXX','BUG ')
44251        WRITE(ICOUT,51)
44252   51   FORMAT('***** AT THE BEGINNING OF FALNEG--')
44253        CALL DPWRST('XXX','BUG ')
44254        WRITE(ICOUT,52)IBUGA3
44255   52   FORMAT('IBUGA3 = ',A4)
44256        CALL DPWRST('XXX','BUG ')
44257        WRITE(ICOUT,53)N
44258   53   FORMAT('N = ',I8)
44259        CALL DPWRST('XXX','BUG ')
44260        DO55I=1,N
44261          WRITE(ICOUT,56)I,X(I),Y(I)
44262   56     FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
44263          CALL DPWRST('XXX','BUG ')
44264   55   CONTINUE
44265      ENDIF
44266C
44267C               ********************************************
44268C               **  STEP 21--                             **
44269C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
44270C               ********************************************
44271C
44272      ISTEPN='21'
44273      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44274C
44275      IF(N.LT.2)THEN
44276        WRITE(ICOUT,999)
44277        CALL DPWRST('XXX','WRIT')
44278        WRITE(ICOUT,1201)
44279 1201   FORMAT('***** ERROR IN THE FALSE NEGATIVE PROPORTION')
44280        CALL DPWRST('XXX','WRIT')
44281        WRITE(ICOUT,1203)
44282 1203   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
44283     1         'VARIABLES IS LESS THAN TWO')
44284        CALL DPWRST('XXX','WRIT')
44285        WRITE(ICOUT,1205)N
44286 1205   FORMAT('SAMPLE SIZE = ',I8)
44287        CALL DPWRST('XXX','WRIT')
44288        IERROR='YES'
44289        GOTO9000
44290      ENDIF
44291C
44292C               ********************************************
44293C               **  STEP 22--                             **
44294C               **  CHECK THAT THE VARIABLES HAVE AT MOST **
44295C               **  TWO DISTINCT VALUES (1 INDICATES A    **
44296C               **  SUCCESS, 0 INDICATES A FAILURE).      **
44297C               ********************************************
44298C
44299      ISTEPN='22'
44300      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44301C
44302C     NOTE: CHECK FOR SPECIAL CASE N = 2.  IN THIS CASE,
44303C           ASSUME WE HAVE A 2X2 TABLE OF COUNTS INSTEAD
44304C           OF RAW DATA.
44305C
44306      IF(N.EQ.2)THEN
44307        N11=INT(X(1)+0.5)
44308        N21=INT(X(2)+0.5)
44309        N12=INT(Y(1)+0.5)
44310        N22=INT(Y(2)+0.5)
44311C
44312C       CHECK IF ALL ENTRIES 0 OR 1. IF SO, ASSUME
44313C       RAW DATA CASE.
44314C
44315        IF((N11.EQ.0 .OR. N11.EQ.1) .AND.
44316     1     (N12.EQ.0 .OR. N12.EQ.1) .AND.
44317     1     (N21.EQ.0 .OR. N21.EQ.1) .AND.
44318     1     (N22.EQ.0 .OR. N22.EQ.1)) GOTO1349
44319C
44320        IF(N11.LT.0)THEN
44321          WRITE(ICOUT,999)
44322          CALL DPWRST('XXX','BUG ')
44323          WRITE(ICOUT,1201)
44324          CALL DPWRST('XXX','BUG ')
44325          WRITE(ICOUT,1311)
44326 1311     FORMAT('      ROW 1 COLUMN 1 OF THE COUNTS TABLE IS ',
44327     1           'NEGATIVE.')
44328          CALL DPWRST('XXX','BUG ')
44329        ELSEIF(N21.LT.0)THEN
44330          WRITE(ICOUT,999)
44331          CALL DPWRST('XXX','BUG ')
44332          WRITE(ICOUT,1201)
44333          CALL DPWRST('XXX','BUG ')
44334          WRITE(ICOUT,1321)
44335 1321     FORMAT('      ROW 2 COLUMN 1 OF THE COUNTS TABLE IS ',
44336     1           'NEGATIVE.')
44337          CALL DPWRST('XXX','BUG ')
44338        ELSEIF(N12.LT.0)THEN
44339          WRITE(ICOUT,999)
44340          CALL DPWRST('XXX','BUG ')
44341          WRITE(ICOUT,1201)
44342          CALL DPWRST('XXX','BUG ')
44343          WRITE(ICOUT,1331)
44344 1331     FORMAT('      ROW 1 COLUMN 2 OF THE COUNTS TABLE IS ',
44345     1           'NEGATIVE.')
44346          CALL DPWRST('XXX','BUG ')
44347        ELSEIF(N22.LT.0)THEN
44348          WRITE(ICOUT,999)
44349          CALL DPWRST('XXX','BUG ')
44350          WRITE(ICOUT,1201)
44351          CALL DPWRST('XXX','BUG ')
44352          WRITE(ICOUT,1341)
44353 1341     FORMAT('      ROW 2 COLUMN 2 OF THE COUNTS TABLE IS ',
44354     1           'NEGATIVE.')
44355          CALL DPWRST('XXX','BUG ')
44356        ENDIF
44357C
44358        NTEMP=N11 + N12 + N21 + N22
44359        STAT=REAL(N12)/REAL(NTEMP)
44360        GOTO3000
44361      ENDIF
44362C
44363 1349 CONTINUE
44364C
44365      CALL DISTIN(X,N,IWRITE,XIDTEM,NDIST,IBUGA3,IERROR)
44366      IF(NDIST.EQ.1)THEN
44367        AVAL=XIDTEM(1)
44368        IF(ABS(AVAL).LE.0.5)THEN
44369          AVAL=0.0
44370        ELSE
44371          AVAL=1.0
44372        ENDIF
44373        DO2202I=1,N
44374          X(I)=1.0
44375 2202   CONTINUE
44376      ELSEIF(NDIST.EQ.2)THEN
44377        IF(XIDTEM(1).EQ.1.0 .OR. XIDTEM(2).EQ.1.0)THEN
44378          DO2203I=1,N
44379            IF(X(I).NE.1.0)X(I)=0.0
44380 2203     CONTINUE
44381        ELSE
44382          ATEMP1=MIN(XIDTEM(1),XIDTEM(2))
44383          ATEMP2=MAX(XIDTEM(1),XIDTEM(2))
44384          DO2208I=1,N
44385            IF(X(I).EQ.ATEMP1)X(I)=0.0
44386            IF(X(I).EQ.ATEMP2)X(I)=1.0
44387 2208     CONTINUE
44388        ENDIF
44389      ELSEIF(NDIST.GT.2)THEN
44390        N11=0
44391        N12=0
44392        N21=0
44393        DO2510I=1,N
44394          IF(Y(I).EQ.X(I))THEN
44395            N11=N11+1
44396          ELSEIF(Y(I).LT.X(I))THEN
44397            N12=N12+1
44398          ELSEIF(Y(I).GT.X(I))THEN
44399            N21=N21+1
44400          ENDIF
44401 2510   CONTINUE
44402        STAT=REAL(N12)/REAL(N)
44403        GOTO9000
44404      ELSE
44405CCCCC   WRITE(ICOUT,999)
44406CCCCC   CALL DPWRST('XXX','BUG ')
44407CCCCC   WRITE(ICOUT,1201)
44408CCCCC   CALL DPWRST('XXX','BUG ')
44409CCCCC   WRITE(ICOUT,2211)
44410C2211   FORMAT('      RESPONSE VARIABLE ONE SHOULD CONTAIN AT MOST')
44411CCCCC   CALL DPWRST('XXX','BUG ')
44412CCCCC   WRITE(ICOUT,2213)
44413C2213   FORMAT('      TWO DISTINCT VALUES.')
44414CCCCC   CALL DPWRST('XXX','BUG ')
44415CCCCC   WRITE(ICOUT,2215)NDIST
44416C2215   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
44417CCCCC   CALL DPWRST('XXX','BUG ')
44418CCCCC   IERROR='YES'
44419CCCCC   GOTO9000
44420      ENDIF
44421C
44422      CALL DISTIN(Y,N,IWRITE,XIDTEM,NDIST,IBUGA3,IERROR)
44423      IF(NDIST.EQ.1)THEN
44424        AVAL=XIDTEM(1)
44425        IF(ABS(AVAL).LE.0.5)THEN
44426          AVAL=0.0
44427        ELSE
44428          AVAL=1.0
44429        ENDIF
44430        DO2302I=1,N
44431          Y(I)=1.0
44432 2302   CONTINUE
44433      ELSEIF(NDIST.EQ.2)THEN
44434        IF(XIDTEM(1).EQ.1.0 .OR. XIDTEM(2).EQ.1.0)THEN
44435          DO2303I=1,N
44436            IF(Y(I).NE.1.0)Y(I)=0.0
44437 2303     CONTINUE
44438        ELSE
44439          ATEMP1=MIN(XIDTEM(1),XIDTEM(2))
44440          ATEMP2=MAX(XIDTEM(1),XIDTEM(2))
44441          DO2308I=1,N
44442            IF(Y(I).EQ.ATEMP1)Y(I)=0.0
44443            IF(Y(I).EQ.ATEMP2)Y(I)=1.0
44444 2308     CONTINUE
44445        ENDIF
44446      ELSEIF(NDIST.GT.2)THEN
44447        N11=0
44448        N12=0
44449        N21=0
44450        DO2520I=1,N
44451          IF(Y(I).EQ.X(I))THEN
44452            N11=N11+1
44453          ELSEIF(Y(I).LT.X(I))THEN
44454            N12=N12+1
44455          ELSEIF(Y(I).GT.X(I))THEN
44456            N21=N21+1
44457          ENDIF
44458 2520   CONTINUE
44459        STAT=REAL(N12)/REAL(N)
44460        GOTO9000
44461      ELSE
44462CCCCC   WRITE(ICOUT,999)
44463CCCCC   CALL DPWRST('XXX','BUG ')
44464CCCCC   WRITE(ICOUT,1201)
44465CCCCC   CALL DPWRST('XXX','BUG ')
44466CCCCC   WRITE(ICOUT,2311)
44467C2311   FORMAT('      RESPONSE VARIABLE TWO SHOULD CONTAIN AT MOST')
44468CCCCC   CALL DPWRST('XXX','BUG ')
44469CCCCC   WRITE(ICOUT,2313)
44470C2313   FORMAT('      TWO DISTINCT VALUES.')
44471CCCCC   CALL DPWRST('XXX','BUG ')
44472CCCCC   WRITE(ICOUT,2315)NDIST
44473C2315   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
44474CCCCC   CALL DPWRST('XXX','BUG ')
44475CCCCC   IERROR='YES'
44476CCCCC   GOTO9000
44477      ENDIF
44478C
44479      N11=0
44480      N12=0
44481      N21=0
44482      N22=0
44483      DO2410I=1,N
44484        IF(X(I).EQ.1.0 .AND. Y(I).EQ.1.0)THEN
44485          N11=N11+1
44486        ELSEIF(X(I).EQ.0.0 .AND. Y(I).EQ.0.0)THEN
44487          N22=N22+1
44488        ELSEIF(X(I).EQ.1.0 .AND. Y(I).EQ.0.0)THEN
44489          N12=N12+1
44490        ELSEIF(X(I).EQ.0.0 .AND. Y(I).EQ.1.0)THEN
44491          N21=N21+1
44492        ENDIF
44493 2410 CONTINUE
44494C
44495      STAT=REAL(N12)/REAL(N)
44496C
44497 3000 CONTINUE
44498C
44499C
44500C               *******************************
44501C               **  STEP 3--                 **
44502C               **  WRITE OUT A LINE         **
44503C               **  OF SUMMARY INFORMATION.  **
44504C               *******************************
44505C
44506      IF(IFEEDB.EQ.'OFF')GOTO890
44507      IF(IWRITE.EQ.'OFF' .OR. IWRITE.EQ.'NO')GOTO890
44508      WRITE(ICOUT,999)
44509      CALL DPWRST('XXX','BUG ')
44510      WRITE(ICOUT,811)STAT
44511  811 FORMAT('THE FALSE NEGATIVE PROPORTION = ',G15.7)
44512      CALL DPWRST('XXX','BUG ')
44513  890 CONTINUE
44514C
44515C               *****************
44516C               **  STEP 90--  **
44517C               **  EXIT.      **
44518C               *****************
44519C
44520 9000 CONTINUE
44521      IF(IBUGA3.EQ.'ON')THEN
44522        WRITE(ICOUT,999)
44523        CALL DPWRST('XXX','BUG ')
44524        WRITE(ICOUT,9011)
44525 9011   FORMAT('***** AT THE END OF FALNEG--')
44526        CALL DPWRST('XXX','BUG ')
44527        WRITE(ICOUT,9012)IBUGA3,IERROR
44528 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
44529        CALL DPWRST('XXX','BUG ')
44530        WRITE(ICOUT,9013)N,N11,N12,N21,N22
44531 9013   FORMAT('N,N11,N12,N21,N22 = ',5I10)
44532        CALL DPWRST('XXX','BUG ')
44533        WRITE(ICOUT,9015)STAT
44534 9015   FORMAT('STAT = ',G15.7)
44535        CALL DPWRST('XXX','BUG ')
44536      ENDIF
44537C
44538      RETURN
44539      END
44540      SUBROUTINE FALPOS(X,Y,N,IWRITE,XIDTEM,STAT,IBUGA3,IERROR)
44541C
44542C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROPORTION OF
44543C              FALSE POSITIVES BETEEN TWO VARIABLES.
44544C
44545C              THIS IS SPECIFICALLY FOR THE 2X2 CASE.  THAT IS,
44546C              EACH VARIABLE HAS TWO MUTUALLY EXCLUSIVE
44547C              CHOICES CODED AS 1 (FOR SUCCESS) OR 0 (FOR
44548C              FAILURE).  A FALSE POSITIVE IS DEFINED AS THE
44549C              ERROR WHERE THE SECOND VARIABLE IS 1 AND THE FIRST
44550C              VARIABLE IS A 0.
44551C
44552C              A TYPICAL EXAMPLE WOULD BE WHERE VARIABLE ONE
44553C              DENOTES THE GROUND TRUTH AND A VALUE OF 1
44554C              INDICATES "PRESENT" AND A VALUE OF 0 INDICATES
44555C              "NOT PRESENT".  VARIABLE TWO REPRESENTS SOME TYPE
44556C              OF DETECTION DEVICE WHERE A VALUE OF 1 INDICATES
44557C              THE DEVICE DETECTED THE SPECIFIED OBJECT WHILE A
44558C              VALUE OF 0 INDICATES THAT THE OBJECT WAS NOT
44559C              DETECTED.  A FALSE POSITIVE THEN IS THE CASE WHERE
44560C              THE DEVICE DETECTED THE OBJECT WHEN IT WAS NOT
44561C              ACTUALY THERE.
44562C
44563C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
44564C                                (UNSORTED) OBSERVATIONS
44565C                                WHICH CONSTITUTE THE FIRST SET
44566C                                OF DATA.
44567C                     --Y      = THE SINGLE PRECISION VECTOR OF
44568C                                (UNSORTED) OBSERVATIONS
44569C                                WHICH CONSTITUTE THE SECOND SET
44570C                                OF DATA.
44571C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
44572C                                IN THE VECTOR X, OR EQUIVALENTLY,
44573C                                THE INTEGER NUMBER OF OBSERVATIONS
44574C                                IN THE VECTOR Y.
44575C     OUTPUT ARGUMENTS--STAT   = THE SINGLE PRECISION VALUE OF THE
44576C                                COMPUTED FALSE POSITIVE PROPORTION
44577C                                BETWEEN THE 2 SETS OF DATA
44578C                                IN THE INPUT VECTORS X AND Y.
44579C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
44580C             SAMPLE FALSE POSITIVE PROPORTION BETWEEN THE 2 SETS
44581C             OF DATA IN THE INPUT VECTORS X AND Y.
44582C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
44583C                   OF N FOR THIS SUBROUTINE.
44584C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
44585C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
44586C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
44587C     LANGUAGE--ANSI FORTRAN (1977)
44588C     WRITTEN BY--JAMES J. FILLIBEN
44589C                 STATISTICAL ENGINEERING DIVISION
44590C                 INFORMATION TECHNOLOGY LABORATORY
44591C                 NATIONAL INSTIUTE OF STANDARDS AND TECHNOLOGY
44592C                 GAITHERSBURG, MD 20899-8980
44593C                 PHONE--301-975-2899
44594C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
44595C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
44596C     LANGUAGE--ANSI FORTRAN (1977)
44597C     VERSION NUMBER--2007/3
44598C     ORIGINAL VERSION--MARCH     2007.
44599C     UPDATED         --AUGUST    2007. IF 2X2 CASE, CHECK IF SUM
44600C                                       OF ENTRIES IS <= 4.  IN THIS
44601C                                       CASE, ASSUME WE HAVE RAW DATA
44602C
44603C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
44604C
44605      CHARACTER*4 IWRITE
44606      CHARACTER*4 IBUGA3
44607      CHARACTER*4 IERROR
44608C
44609      CHARACTER*4 ISTEPN
44610      CHARACTER*4 ISUBN1
44611      CHARACTER*4 ISUBN2
44612C
44613C---------------------------------------------------------------------
44614C
44615      DIMENSION X(*)
44616      DIMENSION Y(*)
44617      DIMENSION XIDTEM(*)
44618C
44619C-----COMMON----------------------------------------------------------
44620C
44621      INCLUDE 'DPCOP2.INC'
44622C
44623C-----START POINT-----------------------------------------------------
44624C
44625      ISUBN1='FALP'
44626      ISUBN2='OS  '
44627      IERROR='NO'
44628C
44629      IF(IBUGA3.EQ.'ON')THEN
44630        WRITE(ICOUT,999)
44631  999   FORMAT(1X)
44632        CALL DPWRST('XXX','BUG ')
44633        WRITE(ICOUT,51)
44634   51   FORMAT('***** AT THE BEGINNING OF FALPOS--')
44635        CALL DPWRST('XXX','BUG ')
44636        WRITE(ICOUT,52)IBUGA3
44637   52   FORMAT('IBUGA3 = ',A4)
44638        CALL DPWRST('XXX','BUG ')
44639        WRITE(ICOUT,53)N
44640   53   FORMAT('N = ',I8)
44641        CALL DPWRST('XXX','BUG ')
44642        DO55I=1,N
44643          WRITE(ICOUT,56)I,X(I),Y(I)
44644   56     FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
44645          CALL DPWRST('XXX','BUG ')
44646   55   CONTINUE
44647      ENDIF
44648C
44649C               ********************************************
44650C               **  STEP 21--                             **
44651C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
44652C               ********************************************
44653C
44654      ISTEPN='21'
44655      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44656C
44657      IF(N.LT.2)THEN
44658        WRITE(ICOUT,999)
44659        CALL DPWRST('XXX','WRIT')
44660        WRITE(ICOUT,1201)
44661 1201   FORMAT('***** ERROR IN THE FALSE POSITIVE PROPORTION')
44662        CALL DPWRST('XXX','WRIT')
44663        WRITE(ICOUT,1203)
44664 1203   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
44665     1         'VARIABLES IS LESS THAN TWO')
44666        CALL DPWRST('XXX','WRIT')
44667        WRITE(ICOUT,1205)N
44668 1205   FORMAT('SAMPLE SIZE = ',I8)
44669        CALL DPWRST('XXX','WRIT')
44670        IERROR='YES'
44671        GOTO9000
44672      ENDIF
44673C
44674C               ********************************************
44675C               **  STEP 22--                             **
44676C               **  CHECK THAT THE VARIABLES HAVE AT MOST **
44677C               **  TWO DISTINCT VALUES (1 INDICATES A    **
44678C               **  SUCCESS, 0 INDICATES A FAILURE).      **
44679C               ********************************************
44680C
44681      ISTEPN='22'
44682      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44683C
44684C     NOTE: CHECK FOR SPECIAL CASE N = 2.  IN THIS CASE,
44685C           ASSUME WE HAVE A 2X2 TABLE OF COUNTS INSTEAD
44686C           OF RAW DATA.
44687C
44688      IF(N.EQ.2)THEN
44689        N11=INT(X(1)+0.5)
44690        N21=INT(X(2)+0.5)
44691        N12=INT(Y(1)+0.5)
44692        N22=INT(Y(2)+0.5)
44693C
44694C       CHECK IF ALL ENTRIES 0 OR 1. IF SO, ASSUME
44695C       RAW DATA CASE.
44696C
44697        IF((N11.EQ.0 .OR. N11.EQ.1) .AND.
44698     1     (N12.EQ.0 .OR. N12.EQ.1) .AND.
44699     1     (N21.EQ.0 .OR. N21.EQ.1) .AND.
44700     1     (N22.EQ.0 .OR. N22.EQ.1)) GOTO1349
44701C
44702        IF(N11.LT.0)THEN
44703          WRITE(ICOUT,999)
44704          CALL DPWRST('XXX','BUG ')
44705          WRITE(ICOUT,1201)
44706          CALL DPWRST('XXX','BUG ')
44707          WRITE(ICOUT,1311)
44708 1311     FORMAT('      ROW 1 COLUMN 1 OF THE COUNTS TABLE IS ',
44709     1           'NEGATIVE.')
44710          CALL DPWRST('XXX','BUG ')
44711        ELSEIF(N21.LT.0)THEN
44712          WRITE(ICOUT,999)
44713          CALL DPWRST('XXX','BUG ')
44714          WRITE(ICOUT,1201)
44715          CALL DPWRST('XXX','BUG ')
44716          WRITE(ICOUT,1321)
44717 1321     FORMAT('      ROW 2 COLUMN 1 OF THE COUNTS TABLE IS ',
44718     1           'NEGATIVE.')
44719          CALL DPWRST('XXX','BUG ')
44720        ELSEIF(N12.LT.0)THEN
44721          WRITE(ICOUT,999)
44722          CALL DPWRST('XXX','BUG ')
44723          WRITE(ICOUT,1201)
44724          CALL DPWRST('XXX','BUG ')
44725          WRITE(ICOUT,1331)
44726 1331     FORMAT('      ROW 1 COLUMN 2 OF THE COUNTS TABLE IS ',
44727     1           'NEGATIVE.')
44728          CALL DPWRST('XXX','BUG ')
44729        ELSEIF(N22.LT.0)THEN
44730          WRITE(ICOUT,999)
44731          CALL DPWRST('XXX','BUG ')
44732          WRITE(ICOUT,1201)
44733          CALL DPWRST('XXX','BUG ')
44734          WRITE(ICOUT,1341)
44735 1341     FORMAT('      ROW 2 COLUMN 2 OF THE COUNTS TABLE IS ',
44736     1           'NEGATIVE.')
44737          CALL DPWRST('XXX','BUG ')
44738        ENDIF
44739C
44740        NTEMP=N11 + N12 + N21 + N22
44741        STAT=REAL(N21)/REAL(NTEMP)
44742        GOTO3000
44743      ENDIF
44744C
44745 1349 CONTINUE
44746C
44747      CALL DISTIN(X,N,IWRITE,XIDTEM,NDIST,IBUGA3,IERROR)
44748      IF(NDIST.EQ.1)THEN
44749        AVAL=XIDTEM(1)
44750        IF(ABS(AVAL).LE.0.5)THEN
44751          AVAL=0.0
44752        ELSE
44753          AVAL=1.0
44754        ENDIF
44755        DO2202I=1,N
44756          X(I)=1.0
44757 2202   CONTINUE
44758      ELSEIF(NDIST.EQ.2)THEN
44759        IF(XIDTEM(1).EQ.1.0 .OR. XIDTEM(2).EQ.1.0)THEN
44760          DO2203I=1,N
44761            IF(X(I).NE.1.0)X(I)=0.0
44762 2203     CONTINUE
44763        ELSE
44764          ATEMP1=MIN(XIDTEM(1),XIDTEM(2))
44765          ATEMP2=MAX(XIDTEM(1),XIDTEM(2))
44766          DO2208I=1,N
44767            IF(X(I).EQ.ATEMP1)X(I)=0.0
44768            IF(X(I).EQ.ATEMP2)X(I)=1.0
44769 2208     CONTINUE
44770        ENDIF
44771      ELSEIF(NDIST.GT.2)THEN
44772C
44773C       CASE WITH MORE THAN 2 DISTINCT VALUES FOR GROUND
44774C       TRUTH VARIABLE.  IN THIS CASE, JUST CHECK IF
44775C
44776C          X(I) = Y(I)
44777C          X(I) < Y(I)
44778C          X(I) > Y(I)
44779C
44780        N11=0
44781        N12=0
44782        N21=0
44783        DO2510I=1,N
44784          IF(Y(I).EQ.X(I))THEN
44785            N11=N11+1
44786          ELSEIF(Y(I).LT.X(I))THEN
44787            N12=N12+1
44788          ELSEIF(Y(I).GT.X(I))THEN
44789            N21=N21+1
44790          ENDIF
44791 2510   CONTINUE
44792        STAT=REAL(N21)/REAL(N)
44793        GOTO9000
44794      ELSE
44795CCCCC   WRITE(ICOUT,999)
44796CCCCC   CALL DPWRST('XXX','BUG ')
44797CCCCC   WRITE(ICOUT,1201)
44798CCCCC   CALL DPWRST('XXX','BUG ')
44799CCCCC   WRITE(ICOUT,2211)
44800C2211   FORMAT('      RESPONSE VARIABLE ONE SHOULD CONTAIN AT MOST')
44801CCCCC   CALL DPWRST('XXX','BUG ')
44802CCCCC   WRITE(ICOUT,2213)
44803C2213   FORMAT('      TWO DISTINCT VALUES.')
44804CCCCC   CALL DPWRST('XXX','BUG ')
44805CCCCC   WRITE(ICOUT,2215)NDIST
44806C2215   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
44807CCCCC   CALL DPWRST('XXX','BUG ')
44808CCCCC   IERROR='YES'
44809CCCCC   GOTO9000
44810      ENDIF
44811C
44812      CALL DISTIN(Y,N,IWRITE,XIDTEM,NDIST,IBUGA3,IERROR)
44813      IF(NDIST.EQ.1)THEN
44814        AVAL=XIDTEM(1)
44815        IF(ABS(AVAL).LE.0.5)THEN
44816          AVAL=0.0
44817        ELSE
44818          AVAL=1.0
44819        ENDIF
44820        DO2302I=1,N
44821          Y(I)=1.0
44822 2302   CONTINUE
44823      ELSEIF(NDIST.EQ.2)THEN
44824        IF(XIDTEM(1).EQ.1.0 .OR. XIDTEM(2).EQ.1.0)THEN
44825          DO2303I=1,N
44826            IF(Y(I).NE.1.0)Y(I)=0.0
44827 2303     CONTINUE
44828        ELSE
44829          ATEMP1=MIN(XIDTEM(1),XIDTEM(2))
44830          ATEMP2=MAX(XIDTEM(1),XIDTEM(2))
44831          DO2308I=1,N
44832            IF(Y(I).EQ.ATEMP1)Y(I)=0.0
44833            IF(Y(I).EQ.ATEMP2)Y(I)=1.0
44834 2308     CONTINUE
44835        ENDIF
44836      ELSEIF(NDIST.GT.2)THEN
44837        N11=0
44838        N12=0
44839        N21=0
44840        DO2520I=1,N
44841          IF(Y(I).EQ.X(I))THEN
44842            N11=N11+1
44843          ELSEIF(Y(I).LT.X(I))THEN
44844            N12=N12+1
44845          ELSEIF(Y(I).GT.X(I))THEN
44846            N21=N21+1
44847          ENDIF
44848 2520   CONTINUE
44849        STAT=REAL(N21)/REAL(N)
44850        GOTO9000
44851      ELSE
44852CCCCC   WRITE(ICOUT,999)
44853CCCCC   CALL DPWRST('XXX','BUG ')
44854CCCCC   WRITE(ICOUT,1201)
44855CCCCC   CALL DPWRST('XXX','BUG ')
44856CCCCC   WRITE(ICOUT,2311)
44857C2311   FORMAT('      RESPONSE VARIABLE TWO SHOULD CONTAIN AT MOST')
44858CCCCC   CALL DPWRST('XXX','BUG ')
44859CCCCC   WRITE(ICOUT,2313)
44860C2313   FORMAT('      TWO DISTINCT VALUES.')
44861CCCCC   CALL DPWRST('XXX','BUG ')
44862CCCCC   WRITE(ICOUT,2315)NDIST
44863C2315   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
44864CCCCC   CALL DPWRST('XXX','BUG ')
44865CCCCC   IERROR='YES'
44866CCCCC   GOTO9000
44867      ENDIF
44868C
44869      N11=0
44870      N12=0
44871      N21=0
44872      N22=0
44873      DO2410I=1,N
44874        IF(X(I).EQ.1.0 .AND. Y(I).EQ.1.0)THEN
44875          N11=N11+1
44876        ELSEIF(X(I).EQ.0.0 .AND. Y(I).EQ.0.0)THEN
44877          N22=N22+1
44878        ELSEIF(X(I).EQ.1.0 .AND. Y(I).EQ.0.0)THEN
44879          N12=N12+1
44880        ELSEIF(X(I).EQ.0.0 .AND. Y(I).EQ.1.0)THEN
44881          N21=N21+1
44882        ENDIF
44883 2410 CONTINUE
44884C
44885      STAT=REAL(N21)/REAL(N)
44886C
44887 3000 CONTINUE
44888C
44889C
44890C               *******************************
44891C               **  STEP 3--                 **
44892C               **  WRITE OUT A LINE         **
44893C               **  OF SUMMARY INFORMATION.  **
44894C               *******************************
44895C
44896      IF(IFEEDB.EQ.'OFF')GOTO890
44897      IF(IWRITE.EQ.'OFF' .OR. IWRITE.EQ.'NO')GOTO890
44898      WRITE(ICOUT,999)
44899      CALL DPWRST('XXX','BUG ')
44900      WRITE(ICOUT,811)STAT
44901  811 FORMAT('THE FALSE POSITIVE PROPORTION = ',G15.7)
44902      CALL DPWRST('XXX','BUG ')
44903  890 CONTINUE
44904C
44905C               *****************
44906C               **  STEP 90--  **
44907C               **  EXIT.      **
44908C               *****************
44909C
44910 9000 CONTINUE
44911      IF(IBUGA3.EQ.'ON')THEN
44912        WRITE(ICOUT,999)
44913        CALL DPWRST('XXX','BUG ')
44914        WRITE(ICOUT,9011)
44915 9011   FORMAT('***** AT THE END OF FALPOS--')
44916        CALL DPWRST('XXX','BUG ')
44917        WRITE(ICOUT,9012)IBUGA3,IERROR
44918 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
44919        CALL DPWRST('XXX','BUG ')
44920        WRITE(ICOUT,9013)N,N11,N12,N21,N22
44921 9013   FORMAT('N,N11,N12,N21,N22 = ',5I10)
44922        CALL DPWRST('XXX','BUG ')
44923        WRITE(ICOUT,9015)STAT
44924 9015   FORMAT('STAT = ',G15.7)
44925        CALL DPWRST('XXX','BUG ')
44926      ENDIF
44927C
44928      RETURN
44929      END
44930      SUBROUTINE FCACDF(X,U,SD,CDF)
44931C
44932C     NOTE--FOLDED-CAUCHY PDF IS:
44933C              FCAPDF(X,U,S)=(1/S)*(CAUPDF((X-U)/S)+CAUPDF((X+U)/S)))
44934C     WRITTEN BY--JAMES J. FILLIBEN
44935C                 STATISTICAL ENGINEERING DIVISION
44936C                 INFORMATION TECHNOLOGY LABORATORY
44937C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
44938C                 GAITHERSBURG, MD 20899
44939C                 PHONE--301-975-2855
44940C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
44941C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
44942C     LANGUAGE--ANSI FORTRAN (1977)
44943C     VERSION NUMBER--96/1
44944C     ORIGINAL VERSION--JANUARY   1996.
44945C
44946C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
44947C
44948C-----COMMON----------------------------------------------------------
44949C
44950      INCLUDE 'DPCOP2.INC'
44951C
44952C-----START POINT-----------------------------------------------------
44953C
44954      CDF=0.0
44955C
44956      IF(X.LT.0.0)THEN
44957        WRITE(ICOUT,4)
44958        CALL DPWRST('XXX','BUG ')
44959        WRITE(ICOUT,46)SD
44960        CALL DPWRST('XXX','BUG ')
44961        CDF=0.0
44962        GOTO9999
44963      ENDIF
44964      IF(SD.LE.0.0)THEN
44965        WRITE(ICOUT,201)
44966        CALL DPWRST('XXX','BUG ')
44967        WRITE(ICOUT,46)SD
44968        CALL DPWRST('XXX','BUG ')
44969        CDF=0.0
44970        GOTO9999
44971      ENDIF
44972    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT ',
44973     1'TO THE FCACDF SUBROUTINE IS NEGATIVE *****')
44974   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
44975  201 FORMAT('***** FATAL DIAGNOSTIC--THE THIRD  INPUT ARGUMENT ',
44976     1' TO THE FCACDF SUBROUTINE IS NEGATIVE *****')
44977C
44978      TERM1=(X-U)/SD
44979      CALL CAUCDF(TERM1,TERM2)
44980      TERM3=(-X-U)/SD
44981      CALL CAUCDF(TERM3,TERM4)
44982      CDF=TERM2-TERM4
44983      GOTO9999
44984C
44985 9999 CONTINUE
44986      RETURN
44987      END
44988      SUBROUTINE FCAPDF(X,U,SD,PDF)
44989C
44990C     NOTE--FOLDED-CAUCHY PDF IS:
44991C              FCAPDF(X,U,S)=(1/S)*(CAUPDF((X-U)/S) + CAUPDF((X+U)/S)))
44992C           WHERE CAUPDF IS THE PDF OF THE STANDARD CAUCHY DISTRIBUTION
44993C     WRITTEN BY--JAMES J. FILLIBEN
44994C                 STATISTICAL ENGINEERING DIVISION
44995C                 INFORMATION TECHNOLOGY LABORATORY
44996C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
44997C                 GAITHERSBURG, MD 20899
44998C                 PHONE--301-975-2855
44999C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
45000C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
45001C     LANGUAGE--ANSI FORTRAN (1977)
45002C     VERSION NUMBER--96/1
45003C     ORIGINAL VERSION--JANUARY   1996.
45004C
45005C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
45006C
45007C-----COMMON----------------------------------------------------------
45008C
45009      INCLUDE 'DPCOP2.INC'
45010C
45011C-----START POINT-----------------------------------------------------
45012C
45013      PDF=0.0
45014C
45015      IF(X.LT.0.0)THEN
45016        WRITE(ICOUT,4)
45017        CALL DPWRST('XXX','BUG ')
45018        WRITE(ICOUT,46)X
45019        CALL DPWRST('XXX','BUG ')
45020        PDF=0.0
45021        GOTO9999
45022      ENDIF
45023      IF(SD.LE.0.0)THEN
45024        WRITE(ICOUT,201)
45025        CALL DPWRST('XXX','BUG ')
45026        WRITE(ICOUT,46)SD
45027        CALL DPWRST('XXX','BUG ')
45028        GOTO9999
45029      ENDIF
45030    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT ',
45031     1'TO THE FCAPDF SUBROUTINE IS NEGATIVE *****')
45032   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
45033  201 FORMAT('***** FATAL DIAGNOSTIC--THE THIRD  INPUT ARGUMENT ',
45034     1'TO THE FCAPDF SUBROUTINE IS NON-POSITIVE *****')
45035C
45036      TERM1=(X-U)/SD
45037      CALL CAUPDF(TERM1,TERM2)
45038      TERM2=TERM2/SD
45039      TERM3=(X+U)/SD
45040      CALL CAUPDF(TERM3,TERM4)
45041      TERM4=TERM4/SD
45042      PDF=TERM2+TERM4
45043      GOTO9999
45044C
45045 9999 CONTINUE
45046      RETURN
45047      END
45048      SUBROUTINE FCAPPF(P,U,SD,PPF)
45049C
45050C     PURPOSE   --PERCENT POINT FUNCTION FOR THE FOLDED CAUCHY
45051C                 DISTRIBUTION.  USES A BISECTION METHOD.
45052C     WRITTEN BY--JAMES J. FILLIBEN
45053C                 STATISTICAL ENGINEERING DIVISION
45054C                 INFORMATION TECHNOLOGY LABORATORY
45055C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
45056C                 GAITHERSBURG, MD 20899
45057C                 PHONE--301-975-2855
45058C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
45059C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
45060C     LANGUAGE--ANSI FORTRAN (1977)
45061C     VERSION NUMBER--96/1
45062C     ORIGINAL VERSION--JANUARY 1996.
45063C
45064C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
45065C
45066C---------------------------------------------------------------------
45067C
45068      DOUBLE PRECISION DU
45069      DOUBLE PRECISION DMEAN
45070      DOUBLE PRECISION DSD
45071CCCCC DOUBLE PRECISION DPI
45072      DOUBLE PRECISION DSDF
45073CCCCC DOUBLE PRECISION DTERM1, DTERM2
45074C
45075      INCLUDE 'DPCOP2.INC'
45076C
45077CCCCC DATA DPI /3.14159265358979D0/
45078      DATA EPSZ /0.0001/
45079      DATA SIGZ /1.0E-5/
45080      DATA ZERO /0./
45081      DATA MAXIT /30000/
45082C
45083C-----START POINT-----------------------------------------------------
45084C
45085C     CHECK THE INPUT ARGUMENTS FOR ERRORS
45086C
45087      PPF=0.0
45088      IF(P.LT.0.0.OR.P.GE.1.0)THEN
45089        WRITE(ICOUT,1)
45090    1   FORMAT('***** ERROR--THE FIRST ARGUMENT TO FCAPPF ',
45091     1         'IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL.')
45092        CALL DPWRST('XXX','BUG ')
45093        WRITE(ICOUT,46)P
45094   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7,'.')
45095        CALL DPWRST('XXX','BUG ')
45096        GOTO9999
45097      ELSEIF(SD.LE.0.0)THEN
45098        WRITE(ICOUT,35)
45099   35   FORMAT('***** ERROR--THE THIRD ARGUMENT TO FCAPPF ',
45100     1         'IS NON-POSITIVE.')
45101        CALL DPWRST('XXX','BUG ')
45102        WRITE(ICOUT,46)SD
45103        CALL DPWRST('XXX','BUG ')
45104        GOTO9999
45105      ENDIF
45106C
45107C  IF P IS 0, PPF IS ZERO.  HANDLE THIS TRIVIAL CASE.
45108C
45109      IF(P.EQ.0.0)THEN
45110        PPF=0.0
45111        GOTO9999
45112      ENDIF
45113C
45114C  FIND BRACKETING INTERVAL.
45115C  AFTER SUCCESSFULLY FIND BRACKETING INTERVAL, THEN SWITCH TO
45116C  MORE EFFICIENT BISECTION METHOD.
45117C
45118      EPS=EPSZ
45119      SIG=SIGZ
45120      DU=DBLE(U)
45121      DSD=DBLE(SD)
45122CCCCC DTERM1=DEXP(-DU**2/(2.0D0*DSD**2))
45123CCCCC DTERM2=DSQRT(2.D0/DPI)
45124CCCCC TERM3=-U/SD
45125CCCCC CALL CAUCDF(TERM3,TERM4)
45126CCCCC DMEAN=DTERM2*DSD*DTERM1 + DU*(1.D0-2.D0*DBLE(TERM4))
45127CCCCC DSDF=DMEAN**2 + DU*DU + DSD*DSD
45128      DMEAN=DU
45129      DSDF=DSD**2
45130C
45131      XL=SNGL(DMEAN)
45132      XINC=SNGL(DSDF)
45133      IF(XINC.LT.1.0)XINC=1.0
45134      ICOUNT=0
45135C
45136   91 CONTINUE
45137      XR=XL+XINC
45138      IF(XL.LE.0.0)XL=0.0
45139      IF(XR.LE.0.0)XR=XL+XINC
45140      CALL FCACDF(XL,U,SD,CDFL)
45141      CALL FCACDF(XR,U,SD,CDFR)
45142      IF(CDFL.LT.P .AND. CDFR.LT.P)THEN
45143        XL=XR
45144      ELSEIF(CDFL.GT.P .AND. CDFR.GT.P)THEN
45145        XL=XL-XINC
45146      ELSE
45147        GOTO99
45148      ENDIF
45149      ICOUNT=ICOUNT+1
45150      IF(ICOUNT.GT.MAXIT)THEN
45151        WRITE(ICOUT,96)
45152        CALL DPWRST('XXX','BUG ')
45153        PPF=0.0
45154        GOTO9999
45155      ENDIF
45156   96 FORMAT('***** ERROR--FCAPPF UNABLE TO FIND BRACKETING ',
45157     *       'INTERVAL.')
45158      GOTO91
45159C
45160C  BISECTION METHOD
45161C
45162   99 CONTINUE
45163      IF(XR.GT.10000.0)THEN
45164        EPS=0.001
45165        SIG=5.0E-2
45166      ELSEIF(XR.GT.1000.0)THEN
45167        EPS=0.001
45168        SIG=5.0E-3
45169      ELSEIF(XR.GT.500.0)THEN
45170        EPS=0.0001
45171        SIG=5.0E-4
45172      ELSEIF(XR.GT.100.0)THEN
45173        EPS=0.0001
45174        SIG=1.0E-4
45175      ENDIF
45176C
45177      IC = 0
45178      FXL = -P
45179      FXR = 1.0 - P
45180  105 CONTINUE
45181      X = (XL+XR)*0.5
45182      CALL FCACDF(X,U,SD,CDF)
45183      P1=CDF
45184      PPF=X
45185      FCS = P1 - P
45186      IF(FCS*FXL.GT.ZERO)GOTO110
45187      XR = X
45188      FXR = FCS
45189      GOTO115
45190  110 CONTINUE
45191      XL = X
45192      FXL = FCS
45193  115 CONTINUE
45194      XRML = XR - XL
45195      IF(XRML.LE.SIG .AND. ABS(FCS).LE.EPS)GOTO9999
45196      IC = IC + 1
45197      IF(IC.LE.MAXIT)GOTO105
45198      WRITE(ICOUT,130)
45199      CALL DPWRST('XXX','BUG ')
45200  130 FORMAT('***** WARNING--FCAPPF ROUTINE DID NOT CONVERGE.')
45201      GOTO9999
45202C
45203 9999 CONTINUE
45204      RETURN
45205      END
45206      SUBROUTINE FCARAN(N,ALOC,ASCALE,ISEED,X)
45207C
45208C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
45209C              FROM THE FOLDED CAUCHY DISTRIBUTION.  THE FOLDED CAUCHY
45210C              IS THE ABSOLUTE VALUE OF A CAUCHY DISTRIBUTION.
45211C              GENERATE FOLDED CAUCHY RANDOM NUMBERS BY FINDING CAUCHY
45212C              RANDOM NUMBERS AND THEN TAKING ABSOLUTE VALUE.
45213C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
45214C                                OF RANDOM NUMBERS TO BE
45215C                                GENERATED.
45216C                     --ALOC   = LOCATION PARAMETER OF PARENT CAUCHY
45217C                                DISTRIBUTION.
45218C                     --ASCALE = SCALE PARAMETER OF PARENT CAUCHY
45219C                                DISTRIBUTION.
45220C                     --ISEED  = SEED FOR UNIFORM RANDOM NUMBER GENERATOR
45221C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
45222C                                (OF DIMENSION AT LEAST N)
45223C                                INTO WHICH THE GENERATED
45224C                                RANDOM SAMPLE WILL BE PLACED.
45225C     OUTPUT--A RANDOM SAMPLE OF SIZE N
45226C             FUNCTION VALUE FOR THE FOLDED CAUCHY DISTRIBUTION.
45227C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
45228C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
45229C                   OF N FOR THIS SUBROUTINE.
45230C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
45231C     FORTRAN LIBRARY SUBROUTINES NEEDED--SIN, COS.
45232C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
45233C     LANGUAGE--ANSI FORTRAN (1977)
45234C     REFERENCES--TOCHER, THE ART OF SIMULATION,
45235C                 1963, PAGE 15.
45236C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
45237C                 1964, PAGE 36.
45238C               --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION
45239C                 OF THE LOCATION PARAMETER OF A SYMMETRIC
45240C                 DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION,
45241C                 PRINCETON UNIVERSITY), 1969, PAGE 231.
45242C               --FILLIBEN, 'THE PERCENT POINT FUNCTION',
45243C                 (UNPUBLISHED MANUSCRIPT), 1970, PAGES 28-31.
45244C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
45245C                 DISTRIBUTIONS--1, 1970, PAGES 154-165.
45246C     WRITTEN BY--JAMES J. FILLIBEN
45247C                 STATISTICAL ENGINEERING DIVISION
45248C                 INFORMATION TECHNOLOGY LABORATORY
45249C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
45250C                 GAITHERSBURG, MD 20899
45251C                 PHONE--301-975-2899
45252C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
45253C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
45254C     LANGUAGE--ANSI FORTRAN (1966)
45255C     VERSION NUMBER--2003/7
45256C     ORIGINAL VERSION--JULY      2003.
45257C
45258C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
45259C
45260C---------------------------------------------------------------------
45261C
45262      DIMENSION X(*)
45263C
45264C---------------------------------------------------------------------
45265C
45266      INCLUDE 'DPCOP2.INC'
45267C
45268C-----DATA STATEMENTS-------------------------------------------------
45269C
45270      DATA PI/3.14159265359/
45271C
45272C-----START POINT-----------------------------------------------------
45273C
45274C     CHECK THE INPUT ARGUMENTS FOR ERRORS
45275C
45276      IF(N.LT.1)THEN
45277        WRITE(ICOUT,5)
45278        CALL DPWRST('XXX','BUG ')
45279        WRITE(ICOUT,47)N
45280        CALL DPWRST('XXX','BUG ')
45281        GOTO9000
45282      ENDIF
45283    5 FORMAT('***** ERROR--THE REQUESTED NUMBER OF FOLDED CAUCHY ',
45284     1'RANDON NUMBERS IS NON-POSITIVE.')
45285   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
45286      IF(ASCALE.LE.0.0)THEN
45287        WRITE(ICOUT,15)
45288        CALL DPWRST('XXX','BUG ')
45289        WRITE(ICOUT,48)ASCALE
45290        CALL DPWRST('XXX','BUG ')
45291        GOTO9000
45292      ENDIF
45293   15 FORMAT('***** FATAL ERROR--THE SCALE PARAMETER FOR THE FOLDED ',
45294     1'CAUCHY RANDON NUMBERS IS NON-POSITIVE.')
45295   48 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.7)
45296C
45297C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
45298C
45299      CALL UNIRAN(N,ISEED,X)
45300C
45301C     GENERATE N CAUCHY RANDOM NUMBERS
45302C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
45303C     THEN APPLY LOCATION AND SCALE TRANSFORMATION AND TAKE ABSOLUTE VALUE.
45304C
45305      DO100I=1,N
45306        ARG=PI*X(I)
45307        X(I)=-COS(ARG)/SIN(ARG)
45308        X(I)=ABS(ALOC + ASCALE*X(I))
45309  100 CONTINUE
45310C
45311 9000 CONTINUE
45312      RETURN
45313      END
45314      SUBROUTINE FCDF(X,NU1,NU2,CDF)
45315C
45316C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
45317C              FUNCTION VALUE FOR THE F DISTRIBUTION
45318C              WITH INTEGER DEGREES OF FREEDOM
45319C              PARAMETERS = NU1 AND NU2.
45320C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
45321C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
45322C              IN THE REFERENCES BELOW.
45323C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
45324C                                WHICH THE CUMULATIVE DISTRIBUTION
45325C                                FUNCTION IS TO BE EVALUATED.
45326C                                X SHOULD BE NON-NEGATIVE.
45327C                     --NU1    = THE INTEGER DEGREES OF FREEDOM
45328C                                FOR THE NUMERATOR OF THE F RATIO.
45329C                                NU1 SHOULD BE POSITIVE.
45330C                     --NU2    = THE INTEGER DEGREES OF FREEDOM
45331C                                FOR THE DENOMINATOR OF THE F RATIO.
45332C                                NU2 SHOULD BE POSITIVE.
45333C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
45334C                                DISTRIBUTION FUNCTION VALUE.
45335C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
45336C             FUNCTION VALUE CDF FOR THE F DISTRIBUTION
45337C             WITH DEGREES OF FREEDOM
45338C             PARAMETERS = NU1 AND NU2.
45339C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
45340C     RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
45341C                 --NU1 SHOULD BE A POSITIVE INTEGER VARIABLE.
45342C                 --NU2 SHOULD BE A POSITIVE INTEGER VARIABLE.
45343C     OTHER DATAPAC   SUBROUTINES NEEDED--NORCDF,CHSCDF.
45344C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
45345C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
45346C     LANGUAGE--ANSI FORTRAN (1977)
45347C     REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS
45348C                 SERIES 55, 1964, PAGES 946-947,
45349C                 FORMULAE 26.6.4, 26.6.5, 26.6.8, AND 26.6.15.
45350C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
45351C                 DISTRIBUTIONS--2, 1970, PAGE 83, FORMULA 20,
45352C                 AND PAGE 84, THIRD FORMULA.
45353C               --PAULSON, AN APPROXIMATE NORMAILIZATION
45354C                 OF THE ANALYSIS OF VARIANCE DISTRIBUTION,
45355C                 ANNALS OF MATHEMATICAL STATISTICS, 1942,
45356C                 NUMBER 13, PAGES 233-135.
45357C               --SCHEFFE AND TUKEY, A FORMULA FOR SAMPLE SIZES
45358C                 FOR POPULATION TOLERANCE LIMITS, 1944,
45359C                 NUMBER 15, PAGE 217.
45360C     WRITTEN BY--JAMES J. FILLIBEN
45361C                 STATISTICAL ENGINEERING DIVISION
45362C                 INFORMATION TECHNOLOGY LABORATORY
45363C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
45364C                 GAITHERSBURG, MD 20899
45365C                 PHONE--301-975-2855
45366C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
45367C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
45368C     LANGUAGE--ANSI FORTRAN (1966)
45369C     VERSION NUMBER--82/7
45370C     ORIGINAL VERSION--AUGUST    1972.
45371C     UPDATED         --SEPTEMBER 1975.
45372C     UPDATED         --NOVEMBER  1975.
45373C     UPDATED         --OCTOBER   1976.
45374C     UPDATED         --DECEMBER  1981.
45375C     UPDATED         --MAY       1982.
45376C
45377C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
45378C
45379C---------------------------------------------------------------------
45380C
45381      DOUBLE PRECISION DX,PI,ANU1,ANU2,Z,SUM,TERM,AI,COEF1,COEF2,ARG
45382      DOUBLE PRECISION COEF
45383      DOUBLE PRECISION THETA,SINTH,COSTH,A,B
45384      DOUBLE PRECISION DSQRT,DATAN
45385      DOUBLE PRECISION DFACT1,DFACT2,DNUM,DDEN
45386      DOUBLE PRECISION DPOW1,DPOW2
45387      DOUBLE PRECISION DNU1,DNU2
45388      DOUBLE PRECISION TERM1,TERM2,TERM3
45389C
45390C-----COMMON----------------------------------------------------------
45391C
45392      INCLUDE 'DPCOP2.INC'
45393C
45394C-----DATA STATEMENTS-------------------------------------------------
45395C
45396      DATA PI/3.14159265358979D0/
45397CCCCC DATA DPOW1,DPOW2/0.33333333333333D0,0.66666666666667D0/
45398C     THE FOLLOWING WAS COMMENTED OUT AND CHANGED
45399C     IN AUGUST OF 1986 DUE TO BOMB ON VAX
45400C     FOR FCDF(2,400,100)    .
45401C     CHANGING NUCUT2 FROM 1000 TO 250 WAS SUFFICIENT
45402C     TO SOLVE THE PROBLEM.
45403CCCCC DATA NUCUT1,NUCUT2/100,1000/
45404      DATA NUCUT1,NUCUT2/100,250/
45405C
45406C-----START POINT-----------------------------------------------------
45407C
45408      B=0.0
45409C
45410C     CHECK THE INPUT ARGUMENTS FOR ERRORS
45411C
45412      IF(NU1.LE.0)GOTO50
45413      IF(NU2.LE.0)GOTO55
45414      IF(X.LT.0.0)GOTO60
45415      GOTO90
45416   50 WRITE(ICOUT,15)
45417      CALL DPWRST('XXX','BUG ')
45418      WRITE(ICOUT,47)NU1
45419      CALL DPWRST('XXX','BUG ')
45420      CDF=0.0
45421      RETURN
45422   55 WRITE(ICOUT,23)
45423      CALL DPWRST('XXX','BUG ')
45424      WRITE(ICOUT,47)NU2
45425      CALL DPWRST('XXX','BUG ')
45426      CDF=0.0
45427      RETURN
45428   60 WRITE(ICOUT,4)
45429      CALL DPWRST('XXX','BUG ')
45430      WRITE(ICOUT,46)X
45431      CALL DPWRST('XXX','BUG ')
45432      CDF=0.0
45433      RETURN
45434   90 CONTINUE
45435    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE 1ST INPUT ARGUMENT ',
45436     1'TO THE FCDF   SUBROUTINE IS NEGATIVE *****')
45437   15 FORMAT('***** FATAL ERROR--THE 2ND INPUT ARGUMENT TO THE ',
45438     1'FCDF   SUBROUTINE IS NON-POSITIVE *****')
45439   23 FORMAT('***** FATAL ERROR--THE 3RD INPUT ARGUMENT TO THE ',
45440     1'FCDF   SUBROUTINE IS NON-POSITIVE *****')
45441   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
45442   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
45443C
45444      DX=X
45445      M=NU1
45446      N=NU2
45447      ANU1=NU1
45448      ANU2=NU2
45449      DNU1=NU1
45450      DNU2=NU2
45451C
45452C     IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN.
45453C     IF NU2 IS 5 THROUGH 9 AND X IS MORE THAN 3000
45454C     STANDARD DEVIATIONS BELOW THE MEAN,
45455C     SET CDF = 0.0 AND RETURN.
45456C     IF NU2 IS 10 OR LARGER AND X IS MORE THAN 150
45457C     STANDARD DEVIATIONS BELOW THE MEAN,
45458C     SET CDF = 0.0 AND RETURN.
45459C     IF NU2 IS 5 THROUGH 9 AND X IS MORE THAN 3000
45460C     STANDARD DEVIATIONS ABOVE THE MEAN,
45461C     SET CDF = 1.0 AND RETURN.
45462C     IF NU2 IS 10 OR LARGER AND X IS MORE THAN 150
45463C     STANDARD DEVIATIONS ABOVE THE MEAN,
45464C     SET CDF = 1.0 AND RETURN.
45465C
45466      IF(X.LE.0.0)GOTO105
45467      IF(NU2.LE.4)GOTO109
45468      T1=2.0/ANU1
45469      T2=ANU2/(ANU2-2.0)
45470      T3=(ANU1+ANU2-2.0)/(ANU2-4.0)
45471      AMEAN=T2
45472      SD=SQRT(T1*T2*T2*T3)
45473      ZRATIO=(X-AMEAN)/SD
45474      IF(NU2.LT.10.AND.ZRATIO.LT.-3000.0)GOTO105
45475      IF(NU2.GE.10.AND.ZRATIO.LT.-150.0)GOTO105
45476      IF(NU2.LT.10.AND.ZRATIO.GT.3000.0)GOTO107
45477      IF(NU2.GE.10.AND.ZRATIO.GT.150.0)GOTO107
45478      GOTO109
45479  105 CDF=0.0
45480      RETURN
45481  107 CDF=1.0
45482      RETURN
45483  109 CONTINUE
45484C
45485C     DISTINGUISH BETWEEN 6 SEPARATE REGIONS
45486C     OF THE (NU1,NU2) SPACE.
45487C     BRANCH TO THE PROPER COMPUTATIONAL METHOD
45488C     DEPENDING ON THE REGION.
45489C     NUCUT1 HAS THE VALUE 100.
45490C     NUCUT2 HAS THE VALUE 1000.
45491C
45492      IF(NU1.LT.NUCUT2.AND.NU2.LT.NUCUT2)GOTO1000
45493      IF(NU1.GE.NUCUT2.AND.NU2.GE.NUCUT2)GOTO2000
45494      IF(NU1.LT.NUCUT1.AND.NU2.GE.NUCUT2)GOTO3000
45495      IF(NU1.GE.NUCUT1.AND.NU2.GE.NUCUT2)GOTO2000
45496      IF(NU1.GE.NUCUT2.AND.NU2.LT.NUCUT1)GOTO5000
45497      IF(NU1.GE.NUCUT2.AND.NU2.GE.NUCUT1)GOTO2000
45498      IBRAN=5
45499      WRITE(ICOUT,99)IBRAN
45500   99 FORMAT('*****INTERNAL ERROR IN   FCDF SUBROUTINE--',
45501     1'IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ',I8)
45502      CALL DPWRST('XXX','BUG ')
45503      RETURN
45504C
45505C     TREAT THE CASE WHEN NU1 AND NU2
45506C     ARE BOTH SMALL OR MODERATE
45507C     (THAT IS, BOTH ARE SMALLER THAN 1000).
45508C     METHOD UTILIZED--EXACT FINITE SUM
45509C     (SEE AMS 55, PAGE 946, FORMULAE 26.6.4, 26.6.5,
45510C     AND 26.6.8).
45511C
45512 1000 CONTINUE
45513      Z=ANU2/(ANU2+ANU1*DX)
45514      IFLAG1=NU1-2*(NU1/2)
45515      IFLAG2=NU2-2*(NU2/2)
45516      IF(IFLAG1.EQ.0)GOTO120
45517      IF(IFLAG2.EQ.0)GOTO150
45518      GOTO250
45519C
45520C     DO THE NU1 EVEN AND NU2 EVEN OR ODD CASE
45521C
45522  120 SUM=0.0D0
45523      TERM=1.0D0
45524      IMAX=(M-2)/2
45525      IF(IMAX.LE.0)GOTO110
45526      DO100I=1,IMAX
45527      AI=I
45528      COEF1=2.0D0*(AI-1.0D0)
45529      COEF2=2.0D0*AI
45530      TERM=TERM*((ANU2+COEF1)/COEF2)*(1.0D0-Z)
45531      SUM=SUM+TERM
45532  100 CONTINUE
45533C
45534  110 SUM=SUM+1.0D0
45535      SUM=(Z**(ANU2/2.0D0))*SUM
45536      CDF=1.0D0-SUM
45537      RETURN
45538C
45539C     DO THE NU1 ODD AND NU2 EVEN CASE
45540C
45541  150 SUM=0.0D0
45542      TERM=1.0D0
45543      IMAX=(N-2)/2
45544      IF(IMAX.LE.0)GOTO210
45545      DO200I=1,IMAX
45546      AI=I
45547      COEF1=2.0D0*(AI-1.0D0)
45548      COEF2=2.0D0*AI
45549      TERM=TERM*((ANU1+COEF1)/COEF2)*Z
45550      SUM=SUM+TERM
45551  200 CONTINUE
45552C
45553  210 SUM=SUM+1.0D0
45554      CDF=((1.0D0-Z)**(ANU1/2.0D0))*SUM
45555      RETURN
45556C
45557C     DO THE NU1 ODD AND NU2 ODD CASE
45558C
45559  250 SUM=0.0D0
45560      TERM=1.0D0
45561      ARG=DSQRT((ANU1/ANU2)*DX)
45562      THETA=DATAN(ARG)
45563      SINTH=ARG/DSQRT(1.0D0+ARG*ARG)
45564      COSTH=1.0D0/DSQRT(1.0D0+ARG*ARG)
45565      IF(N.EQ.1)GOTO320
45566      IF(N.EQ.3)GOTO310
45567      IMAX=N-2
45568      DO300I=3,IMAX,2
45569      AI=I
45570      COEF1=AI-1.0D0
45571      COEF2=AI
45572      TERM=TERM*(COEF1/COEF2)*(COSTH*COSTH)
45573      SUM=SUM+TERM
45574  300 CONTINUE
45575C
45576  310 SUM=SUM+1.0D0
45577      SUM=SUM*SINTH*COSTH
45578C
45579  320 CONTINUE
45580      A=(2.0D0/PI)*(THETA+SUM)
45581      SUM=0.0D0
45582      TERM=1.0D0
45583      IF(M.EQ.1)B=0.0D0
45584      IF(M.EQ.1)GOTO450
45585      IF(M.EQ.3)GOTO410
45586      IMAX=M-3
45587      DO400I=1,IMAX,2
45588      AI=I
45589      COEF1=AI
45590      COEF2=AI+2.0D0
45591      TERM=TERM*((ANU2+COEF1)/COEF2)*(SINTH*SINTH)
45592      SUM=SUM+TERM
45593  400 CONTINUE
45594C
45595  410 SUM=SUM+1.0D0
45596      SUM=SUM*SINTH*(COSTH**N)
45597      COEF=1.0D0
45598      IEVODD=N-2*(N/2)
45599      IMIN=3
45600      IF(IEVODD.EQ.0)IMIN=2
45601      IF(IMIN.GT.N)GOTO420
45602      DO430I=IMIN,N,2
45603      AI=I
45604      COEF=((AI-1.0D0)/AI)*COEF
45605  430 CONTINUE
45606C
45607  420 COEF=COEF*ANU2
45608      IF(IEVODD.EQ.0)GOTO440
45609      COEF=COEF*(2.0D0/PI)
45610C
45611  440 B=COEF*SUM
45612C
45613  450 CDF=A-B
45614      RETURN
45615C
45616C     TREAT THE CASE WHEN NU1 AND NU2
45617C     ARE BOTH LARGE
45618C     (THAT IS, BOTH ARE EQUAL TO OR LARGER THAN 1000);
45619C     OR WHEN NU1 IS MODERATE AND NU2 IS LARGE
45620C     (THAT IS, WHEN NU1 IS EQUAL TO OR GREATER THAN 100
45621C     BUT SMALLER THAN 1000,
45622C     AND NU2 IS EQUAL TO OR LARGER THAN 1000);
45623C     OR WHEN NU2 IS MODERATE AND NU1 IS LARGE
45624C     (THAT IS WHEN NU2 IS EQUAL TO OR GREATER THAN 100
45625C     BUT SMALLER THAN 1000,
45626C     AND NU1 IS EQUAL TO OR LARGER THAN 1000).
45627C     METHOD UTILIZED--PAULSON APPROXIMATION
45628C     (SEE AMS 55, PAGE 947, FORMULA 26.6.15).
45629C
45630 2000 CONTINUE
45631      DFACT1=1.0D0/(4.5D0*DNU1)
45632      DFACT2=1.0D0/(4.5D0*DNU2)
45633      DPOW1=1.0D0/3.0D0
45634      DPOW2=2.0D0/3.0D0
45635      DNUM=((1.0D0-DFACT2)*(DX**DPOW1))-(1.0D0-DFACT1)
45636      DDEN=DSQRT((DFACT2*(DX**DPOW2))+DFACT1)
45637      U=DNUM/DDEN
45638      CALL NORCDF(U,GCDF)
45639      CDF=GCDF
45640      RETURN
45641C
45642C     TREAT THE CASE WHEN NU1 IS SMALL
45643C     AND NU2 IS LARGE
45644C     (THAT IS, WHEN NU1 IS SMALLER THAN 100,
45645C     AND NU2 IS EQUAL TO OR LARGER THAN 1000).
45646C     METHOD UTILIZED--SHEFFE-TUKEY APPROXIMATION
45647C     (SEE JOHNSON AND KOTZ, VOLUME 2, PAGE 84, THIRD FORMULA).
45648C
45649 3000 CONTINUE
45650      TERM1=DNU1
45651      TERM2=(DNU1/DNU2)*(0.5D0*DNU1-1.0D0)
45652      TERM3=-(DNU1/DNU2)*0.5D0
45653      U=(TERM1+TERM2)/((1.0D0/DX)-TERM3)
45654      CALL CHSCDF(U,NU1,CCDF)
45655      CDF=CCDF
45656      RETURN
45657C
45658C     TREAT THE CASE WHEN NU2 IS SMALL
45659C     AND NU1 IS LARGE
45660C     (THAT IS, WHEN NU2 IS SMALLER THAN 100,
45661C     AND NU1 IS EQUAL TO OR LARGER THAN 1000).
45662C     METHOD UTILIZED--SHEFFE-TUKEY APPROXIMATION
45663C     (SEE JOHNSON AND KOTZ, VOLUME 2, PAGE 84, THIRD FORMULA).
45664C
45665 5000 CONTINUE
45666      TERM1=DNU2
45667      TERM2=(DNU2/DNU1)*(0.5D0*DNU2-1.0D0)
45668      TERM3=-(DNU2/DNU1)*0.5D0
45669      U=(TERM1+TERM2)/(DX-TERM3)
45670      CALL CHSCDF(U,NU2,CCDF)
45671      CDF=1.0-CCDF
45672      RETURN
45673C
45674      END
45675      DOUBLE PRECISION FUNCTION FDM0P5(XVALUE)
45676C
45677C   DESCRIPTION:
45678C
45679C      This function computes the Fermi-Dirac function of
45680C      order -1/2, defined as
45681C
45682C                     Int{0 to inf} t**(-1/2) / (1+exp(t-x)) dt
45683C         FDM0P5(x) = -----------------------------------------
45684C                                 Gamma(1/2)
45685C
45686C      The function uses Chebyshev expansions which are given to
45687C      16 decimal places for x <= 2, but only 10 decimal places
45688C      for x > 2.
45689C
45690C
45691C   ERROR RETURNS:
45692C
45693C      None.
45694C
45695C
45696C   MACHINE-DEPENDENT CONSTANTS:
45697C
45698C      NTERMS1 - INTEGER - The number of terms used from the array
45699C                          ARRFD1. The recommended value is such that
45700C                               ABS(ARRFD1(NTERMS1)) < EPS/10
45701C                          subject to 1 <= NTERMS1 <= 14.
45702C
45703C      NTERMS2 - INTEGER - The number of terms used from the array
45704C                          ARRFD2. The recommended value is such that
45705C                               ABS(ARRFD2(NTERMS2)) < EPS/10
45706C                          subject to 1 <= NTERMS1 <= 23.
45707C
45708C      NTERMS3 - INTEGER - The number of terms used from the array
45709C                          ARRFD3. The recommended value is such that
45710C                               ABS(ARRFD3(NTERMS3)) < EPS/10
45711C                          subject to 1 <= NTERMS3 <= 28.
45712C
45713C      XMIN1 - REAL - The value of x below which
45714C                         FDM0P5(x) = exp(x)
45715C                     to machine precision. The recommended value
45716C                     is    LN ( SQRT(2) * EPSNEG )
45717C
45718C      XMIN2 - REAL - The value of x below which
45719C                         FDM0P5(x) = 0.0
45720C                     to machine precision. The recommended value
45721C                     is    LN ( XMIN )
45722C
45723C      XHIGH - REAL - The value of x above which
45724C                         FDM0P5(x) = 2 sqrt (x/pi)
45725C                     to machine precision. The recommended value
45726C                     is    1 / sqrt( 2 * EPSNEG )
45727C
45728C      For values of EPS, EPSNEG, and XMIN the user should refer to the
45729C      paper by Cody in ACM. Trans. Math. Soft. Vol. 14 (1988) p303-311.
45730C
45731C      This code is provided with single and double precision values
45732C      of the machine-dependent parameters, suitable for machines
45733C      which satisfy the IEEE floating-point standard.
45734C
45735C
45736C   AUTHOR:
45737C          DR. ALLAN MACLEOD,
45738C          DEPT. OF MATHEMATICS AND STATISTICS,
45739C          UNIVERSITY OF PAISLEY,
45740C          HIGH ST.,
45741C          PAISLEY,
45742C          SCOTLAND
45743C          PA1 2BE
45744C
45745C          (e-mail: macl-ms0@paisley.ac.uk )
45746C
45747C
45748C   LATEST UPDATE:
45749C                 20 NOVEMBER, 1996
45750C
45751      INTEGER NTERM1,NTERM2,NTERM3
45752      DOUBLE PRECISION
45753     1     ARRFD1(0:14),ARRFD2(0:23),ARRFD3(0:58),
45754     2     CHEVAL,CHV,EXPX,FIFTY,FORTY2,
45755     3     GAM1P5,ONE,T,THREE,TWO,TWOE,
45756     4     X,XHIGH,XMIN1,XMIN2,XSQ,XVALUE,ZERO
45757      DATA ARRFD1/1.7863 5963 8510 2264  D   0,
45758     1           -0.9993 7200 7632 333   D  -1,
45759     2            0.6414 4652 2160 54    D  -2,
45760     3           -0.4356 4153 7134 5     D  -3,
45761     4            0.3052 1670 0310       D  -4,
45762     5           -0.2181 0648 110        D  -5,
45763     6            0.1580 0507 81         D  -6,
45764     7           -0.1156 2057 0          D  -7,
45765     8            0.8525 860             D  -9,
45766     9           -0.6325 29              D -10,
45767     X            0.4715 9               D -11,
45768     1           -0.3530                 D -12,
45769     2            0.265                  D -13,
45770     3           -0.20                   D -14,
45771     4            0.2                    D -15/
45772      DATA ARRFD2( 0)/ 1.6877 1115 2605 2352  D   0/
45773      DATA ARRFD2( 1)/ 0.5978 3602 2633 6983  D   0/
45774      DATA ARRFD2( 2)/ 0.3572 2600 4541 669   D  -1/
45775      DATA ARRFD2( 3)/-0.1321 4478 6506 426   D  -1/
45776      DATA ARRFD2( 4)/-0.4040 1342 0744 7     D  -3/
45777      DATA ARRFD2( 5)/ 0.5330 0118 4688 7     D  -3/
45778      DATA ARRFD2( 6)/-0.1489 2350 4863       D  -4/
45779      DATA ARRFD2( 7)/-0.2188 6382 2916       D  -4/
45780      DATA ARRFD2( 8)/ 0.1965 2084 277        D  -5/
45781      DATA ARRFD2( 9)/ 0.8565 8304 66         D  -6/
45782      DATA ARRFD2(10)/-0.1407 7231 33         D  -6/
45783      DATA ARRFD2(11)/-0.3051 7580 3          D  -7/
45784      DATA ARRFD2(12)/ 0.8352 4532            D  -8/
45785      DATA ARRFD2(13)/ 0.9025 750             D  -9/
45786      DATA ARRFD2(14)/-0.4455 471             D  -9/
45787      DATA ARRFD2(15)/-0.1483 42              D -10/
45788      DATA ARRFD2(16)/ 0.2192 66              D -10/
45789      DATA ARRFD2(17)/-0.6579                 D -12/
45790      DATA ARRFD2(18)/-0.1000 9               D -11/
45791      DATA ARRFD2(19)/ 0.936                  D -13/
45792      DATA ARRFD2(20)/ 0.420                  D -13/
45793      DATA ARRFD2(21)/-0.71                   D -14/
45794      DATA ARRFD2(22)/-0.16                   D -14/
45795      DATA ARRFD2(23)/ 0.4                    D -15/
45796      DATA ARRFD3(0)/  0.8707 1950 2959 0563  D    0/
45797      DATA ARRFD3(1)/  0.5983 3110 2317 33    D   -2/
45798      DATA ARRFD3(2)/ -0.4326 7047 0895 746   D   -1/
45799      DATA ARRFD3(3)/ -0.3930 8368 1608 590   D   -1/
45800      DATA ARRFD3(4)/ -0.1914 8268 8045 932   D   -1/
45801      DATA ARRFD3(5)/ -0.6558 2880 9801 58    D   -2/
45802      DATA ARRFD3(6)/ -0.2227 6691 5163 12    D   -2/
45803      DATA ARRFD3(7)/ -0.8466 7869 3617 8     D   -3/
45804      DATA ARRFD3(8)/ -0.2807 4594 8921 9     D   -3/
45805      DATA ARRFD3(9)/ -0.9555 7502 4348       D   -4/
45806      DATA ARRFD3(10)/-0.3623 6766 2803       D   -4/
45807      DATA ARRFD3(11)/-0.1091 5846 8869       D   -4/
45808      DATA ARRFD3(12)/-0.3935 6701 000        D   -5/
45809      DATA ARRFD3(13)/-0.1310 8192 725        D   -5/
45810      DATA ARRFD3(14)/-0.2468 8163 88         D   -6/
45811      DATA ARRFD3(15)/-0.1048 3803 11         D   -6/
45812      DATA ARRFD3(16)/ 0.2361 8148 7          D   -7/
45813      DATA ARRFD3(17)/ 0.2271 4535 9          D   -7/
45814      DATA ARRFD3(18)/ 0.1457 7517 4          D   -7/
45815      DATA ARRFD3(19)/ 0.1539 2676 7          D   -7/
45816      DATA ARRFD3(20)/ 0.5692 4772            D   -8/
45817      DATA ARRFD3(21)/ 0.5062 3068            D   -8/
45818      DATA ARRFD3(22)/ 0.2342 6075            D   -8/
45819      DATA ARRFD3(23)/ 0.1265 2275            D   -8/
45820      DATA ARRFD3(24)/ 0.8927 773             D   -9/
45821      DATA ARRFD3(25)/ 0.2994 501             D   -9/
45822      DATA ARRFD3(26)/ 0.2822 785             D   -9/
45823      DATA ARRFD3(27)/ 0.9106 85              D  -10/
45824      DATA ARRFD3(28)/ 0.6962 85              D  -10/
45825      DATA ARRFD3(29)/ 0.3662 25              D  -10/
45826      DATA ARRFD3(30)/ 0.1243 51              D  -10/
45827      DATA ARRFD3(31)/ 0.1450 19              D  -10/
45828      DATA ARRFD3(32)/ 0.1664 5               D  -11/
45829      DATA ARRFD3(33)/ 0.4585 6               D  -11/
45830      DATA ARRFD3(34)/ 0.6092                 D  -12/
45831      DATA ARRFD3(35)/ 0.9331                 D  -12/
45832      DATA ARRFD3(36)/ 0.5238                 D  -12/
45833      DATA ARRFD3(37)/-0.56                   D  -14/
45834      DATA ARRFD3(38)/ 0.3170                 D  -12/
45835      DATA ARRFD3(39)/-0.926                  D  -13/
45836      DATA ARRFD3(40)/ 0.1265                 D  -12/
45837      DATA ARRFD3(41)/-0.327                  D  -13/
45838      DATA ARRFD3(42)/ 0.276                  D  -13/
45839      DATA ARRFD3(43)/ 0.33                   D  -14/
45840      DATA ARRFD3(44)/-0.42                   D  -14/
45841      DATA ARRFD3(45)/ 0.101                  D  -13/
45842      DATA ARRFD3(46)/-0.73                   D  -14/
45843      DATA ARRFD3(47)/ 0.64                   D  -14/
45844      DATA ARRFD3(48)/-0.37                   D  -14/
45845      DATA ARRFD3(49)/ 0.23                   D  -14/
45846      DATA ARRFD3(50)/-0.9                    D  -15/
45847      DATA ARRFD3(51)/ 0.2                    D  -15/
45848      DATA ARRFD3(52)/ 0.2                    D  -15/
45849      DATA ARRFD3(53)/-0.3                    D  -15/
45850      DATA ARRFD3(54)/ 0.4                    D  -15/
45851      DATA ARRFD3(55)/-0.3                    D  -15/
45852      DATA ARRFD3(56)/ 0.2                    D  -15/
45853      DATA ARRFD3(57)/-0.1                    D  -15/
45854      DATA ARRFD3(58)/ 0.1                    D  -15/
45855      DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0/
45856      DATA THREE,FORTY2,FIFTY/ 3.0 D 0 , 42.0 D 0 , 50.0 D 0/
45857      DATA GAM1P5/0.8862 2692 5452 7580 D 0/
45858      DATA TWOE/5.4365 6365 6918 0905 D 0/
45859C
45860C   Machine-dependent constants
45861C
45862      DATA NTERM1,NTERM2,NTERM3/14,23,58/
45863      DATA XMIN1,XMIN2,XHIGH/-36.39023D0,-708.39641D0,67108864.0D0/
45864C
45865C   Start calculation
45866C
45867      X=XVALUE
45868C
45869C   Code for x < -1
45870C
45871      IF ( X .LT. -ONE ) THEN
45872         IF ( X .GT. XMIN1 ) THEN
45873            EXPX = EXP(X)
45874            T = TWOE * EXPX - ONE
45875            FDM0P5 = EXPX * CHEVAL ( NTERM1 , ARRFD1 , T )
45876         ELSE
45877            IF ( X .LT. XMIN2 ) THEN
45878               FDM0P5 = ZERO
45879            ELSE
45880               FDM0P5 = EXP(X)
45881            ENDIF
45882         ENDIF
45883      ELSE
45884C
45885C   Code for -1 <= x <= 2
45886C
45887         IF ( X .LE. TWO ) THEN
45888            T = ( TWO * X - ONE ) / THREE
45889            FDM0P5 = CHEVAL ( NTERM2 , ARRFD2 , T )
45890         ELSE
45891C
45892C   Code for x > 2
45893C
45894            FDM0P5 = SQRT(X) / GAM1P5
45895            IF ( X .LE. XHIGH ) THEN
45896               XSQ = X * X
45897               T = ( FIFTY - XSQ ) / ( FORTY2 + XSQ )
45898               CHV = CHEVAL ( NTERM3 , ARRFD3 , T )
45899               FDM0P5 = FDM0P5 * ( ONE - CHV / XSQ )
45900            ENDIF
45901         ENDIF
45902      ENDIF
45903      RETURN
45904      END
45905      DOUBLE PRECISION FUNCTION FDP0P5(XVALUE)
45906C
45907C   DESCRIPTION:
45908C
45909C      This function computes the Fermi-Dirac function of
45910C      order 1/2, defined as
45911C
45912C                     Int{0 to inf} t**(1/2) / (1+exp(t-x)) dt
45913C         FDP0P5(x) = -----------------------------------------
45914C                                 Gamma(3/2)
45915C
45916C      The function uses Chebyshev expansions which are given to
45917C      16 decimal places for x <= 2, but only 10 decimal places
45918C      for x > 2.
45919C
45920C
45921C   ERROR RETURNS:
45922C
45923C      If XVALUE too large and positive, the function value
45924C      will overflow. An error message is printed and the function
45925C      returns the value 0.0.
45926C
45927C
45928C   MACHINE-DEPENDENT CONSTANTS:
45929C
45930C      NTERMS1 - INTEGER - The number of terms used from the array
45931C                          ARRFD1. The recommended value is such that
45932C                               ABS(ARRFD1(NTERMS1)) < EPS/10
45933C                          subject to 1 <= NTERMS1 <= 13.
45934C
45935C      NTERMS2 - INTEGER - The number of terms used from the array
45936C                          ARRFD2. The recommended value is such that
45937C                               ABS(ARRFD2(NTERMS2)) < EPS/10
45938C                          subject to 1 <= NTERMS1 <= 23.
45939C
45940C      NTERMS3 - INTEGER - The number of terms used from the array
45941C                          ARRFD3. The recommended value is such that
45942C                               ABS(ARRFD3(NTERMS3)) < EPS/10
45943C                          subject to 1 <= NTERMS3 <= 32.
45944C
45945C      XMIN1 - REAL - The value of x below which
45946C                         FDP0P5(x) = exp(x)
45947C                     to machine precision. The recommended value
45948C                     is   1.5*LN(2) + LN(EPSNEG)
45949C
45950C      XMIN2 - REAL - The value of x below which
45951C                         FDP0P5(x) = 0.0
45952C                     to machine precision. The recommended value
45953C                     is    LN ( XMIN )
45954C
45955C      XHIGH1 - REAL - The value of x above which
45956C                         FDP0P5(x) = x**(3/2)/GAMMA(5/2)
45957C                     to machine precision. The recommended value
45958C                     is   pi / SQRT(8*EPS)
45959C
45960C      XHIGH2 - REAL - The value of x above which FDP0P5 would
45961C                      overflow. The reommended value is
45962C                              (1.329*XMAX)**(2/3)
45963C
45964C      For values of EPS, EPSNEG, and XMIN the user should refer to the
45965C      paper by Cody in ACM. Trans. Math. Soft. Vol. 14 (1988) p303-311.
45966C
45967C      This code is provided with single and double precision values
45968C      of the machine-dependent parameters, suitable for machines
45969C      which satisfy the IEEE floating-point standard.
45970C
45971C
45972C   AUTHOR:
45973C          DR. ALLAN MACLEOD,
45974C          DEPT. OF MATHEMATICS AND STATISTICS,
45975C          UNIVERSITY OF PAISLEY,
45976C          HIGH ST.,
45977C          PAISLEY,
45978C          SCOTLAND
45979C          PA1 2BE
45980C
45981C          (e-mail: macl-ms0@paisley.ac.uk )
45982C
45983C
45984C   LATEST UPDATE:
45985C                 20 NOVEMBER, 1996
45986C
45987      INTEGER NTERM1,NTERM2,NTERM3
45988      DOUBLE PRECISION
45989     1     ARRFD1(0:13),ARRFD2(0:23),ARRFD3(0:53),
45990     2     CHEVAL,CHV,EXPX,FIFTY,FORTY2,
45991     3     GAM2P5,ONE,T,THREE,TWO,TWOE,X,XHIGH1,
45992     4     XHIGH2,XMIN1,XMIN2,XSQ,XVALUE,ZERO
45993C
45994C-----COMMON----------------------------------------------------------
45995C
45996      INCLUDE 'DPCOP2.INC'
45997C
45998      DATA ARRFD1/1.8862 9683 9273 4597  D   0,
45999     1           -0.5435 8081 7644 053   D  -1,
46000     2            0.2364 4975 4397 20    D  -2,
46001     3           -0.1216 9293 6588 0     D  -3,
46002     4            0.6869 5130 622        D  -5,
46003     5           -0.4112 0761 72         D  -6,
46004     6            0.2563 5162 8          D  -7,
46005     7           -0.1646 5008            D  -8,
46006     8            0.1081 948             D  -9,
46007     9           -0.7239 2               D -11,
46008     X            0.4915                 D -12,
46009     1           -0.338                  D -13,
46010     2            0.23                   D -14,
46011     3           -0.2                    D -15/
46012      DATA ARRFD2( 0)/ 2.6982 4927 8817 0612  D   0/
46013      DATA ARRFD2( 1)/ 1.2389 9141 4113 3012  D   0/
46014      DATA ARRFD2( 2)/ 0.2291 4393 7981 6278  D   0/
46015      DATA ARRFD2( 3)/ 0.9031 6534 6872 79    D  -2/
46016      DATA ARRFD2( 4)/-0.2577 6524 6912 46    D  -2/
46017      DATA ARRFD2( 5)/-0.5836 8160 5388       D  -4/
46018      DATA ARRFD2( 6)/ 0.6936 0945 8725       D  -4/
46019      DATA ARRFD2( 7)/-0.1806 1670 265        D  -5/
46020      DATA ARRFD2( 8)/-0.2132 1530 005        D  -5/
46021      DATA ARRFD2( 9)/ 0.1754 9839 51         D  -6/
46022      DATA ARRFD2(10)/ 0.6653 2547 0          D  -7/
46023      DATA ARRFD2(11)/-0.1016 7597 7          D  -7/
46024      DATA ARRFD2(12)/-0.1963 7597            D  -8/
46025      DATA ARRFD2(13)/ 0.5075 769             D  -9/
46026      DATA ARRFD2(14)/ 0.4914 69              D -10/
46027      DATA ARRFD2(15)/-0.2337 37              D -10/
46028      DATA ARRFD2(16)/-0.6645                 D -12/
46029      DATA ARRFD2(17)/ 0.1011 5               D -11/
46030      DATA ARRFD2(18)/-0.313                  D -13/
46031      DATA ARRFD2(19)/-0.412                  D -13/
46032      DATA ARRFD2(20)/ 0.38                   D -14/
46033      DATA ARRFD2(21)/ 0.16                   D -14/
46034      DATA ARRFD2(22)/-0.3                    D -15/
46035      DATA ARRFD2(23)/-0.1                    D -15/
46036      DATA ARRFD3(0)/  2.5484 3841 9800 9122  D    0/
46037      DATA ARRFD3(1)/  0.5104 3940 8960 652   D   -1/
46038      DATA ARRFD3(2)/  0.7749 3527 6282 94    D   -2/
46039      DATA ARRFD3(3)/ -0.7504 1656 5849 53    D   -2/
46040      DATA ARRFD3(4)/ -0.7754 0826 3202 96    D   -2/
46041      DATA ARRFD3(5)/ -0.4581 0844 5399 77    D   -2/
46042      DATA ARRFD3(6)/ -0.2343 1641 5873 63    D   -2/
46043      DATA ARRFD3(7)/ -0.1178 8049 5135 91    D   -2/
46044      DATA ARRFD3(8)/ -0.5802 7393 5970 2     D   -3/
46045      DATA ARRFD3(9)/ -0.2825 3507 0053 7     D   -3/
46046      DATA ARRFD3(10)/-0.1388 1366 5179 9     D   -3/
46047      DATA ARRFD3(11)/-0.6806 9508 4875       D   -4/
46048      DATA ARRFD3(12)/-0.3353 5635 0608       D   -4/
46049      DATA ARRFD3(13)/-0.1665 3301 8734       D   -4/
46050      DATA ARRFD3(14)/-0.8271 4908 266        D   -5/
46051      DATA ARRFD3(15)/-0.4142 5714 409        D   -5/
46052      DATA ARRFD3(16)/-0.2080 5255 294        D   -5/
46053      DATA ARRFD3(17)/-0.1047 9767 478        D   -5/
46054      DATA ARRFD3(18)/-0.5315 2738 02         D   -6/
46055      DATA ARRFD3(19)/-0.2694 0611 78         D   -6/
46056      DATA ARRFD3(20)/-0.1374 8787 49         D   -6/
46057      DATA ARRFD3(21)/-0.7023 0888 7          D   -7/
46058      DATA ARRFD3(22)/-0.3595 4394 2          D   -7/
46059      DATA ARRFD3(23)/-0.1851 0612 6          D   -7/
46060      DATA ARRFD3(24)/-0.9502 3937            D   -8/
46061      DATA ARRFD3(25)/-0.4918 4811            D   -8/
46062      DATA ARRFD3(26)/-0.2537 1950            D   -8/
46063      DATA ARRFD3(27)/-0.1315 1532            D   -8/
46064      DATA ARRFD3(28)/-0.6835 168             D   -9/
46065      DATA ARRFD3(29)/-0.3538 244             D   -9/
46066      DATA ARRFD3(30)/-0.1853 182             D   -9/
46067      DATA ARRFD3(31)/-0.9589 83              D  -10/
46068      DATA ARRFD3(32)/-0.5040 83              D  -10/
46069      DATA ARRFD3(33)/-0.2622 38              D  -10/
46070      DATA ARRFD3(34)/-0.1372 55              D  -10/
46071      DATA ARRFD3(35)/-0.7234 0               D  -11/
46072      DATA ARRFD3(36)/-0.3742 9               D  -11/
46073      DATA ARRFD3(37)/-0.2005 9               D  -11/
46074      DATA ARRFD3(38)/-0.1026 9               D  -11/
46075      DATA ARRFD3(39)/-0.5551                 D  -12/
46076      DATA ARRFD3(40)/-0.2857                 D  -12/
46077      DATA ARRFD3(41)/-0.1520                 D  -12/
46078      DATA ARRFD3(42)/-0.811                  D  -13/
46079      DATA ARRFD3(43)/-0.410                  D  -13/
46080      DATA ARRFD3(44)/-0.234                  D  -13/
46081      DATA ARRFD3(45)/-0.110                  D  -13/
46082      DATA ARRFD3(46)/-0.67                   D  -14/
46083      DATA ARRFD3(47)/-0.30                   D  -14/
46084      DATA ARRFD3(48)/-0.19                   D  -14/
46085      DATA ARRFD3(49)/-0.9                    D  -15/
46086      DATA ARRFD3(50)/-0.5                    D  -15/
46087      DATA ARRFD3(51)/-0.3                    D  -15/
46088      DATA ARRFD3(52)/-0.1                    D  -15/
46089      DATA ARRFD3(53)/-0.1                    D  -15/
46090      DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0/
46091      DATA THREE,FORTY2,FIFTY/ 3.0 D 0 , 42.0 D 0 , 50.0 D 0/
46092      DATA GAM2P5/0.1329 3403 8817 9137 D 1/
46093      DATA TWOE/5.4365 6365 6918 0905 D 0/
46094C
46095C   Machine-dependent constants (suitable for IEEE machines)
46096C
46097      DATA NTERM1,NTERM2,NTERM3/13,23,53/
46098      DATA XMIN1,XMIN2/-35.7D00,-708.394D00/
46099      DATA XHIGH1,XHIGH2/7.45467D7,3.8392996D205/
46100C
46101C   Start calculation
46102C
46103      X=XVALUE
46104C
46105C   Test for error condition
46106C
46107      IF ( X .GT. XHIGH2 ) THEN
46108         WRITE(ICOUT,11)
46109   11    FORMAT('**** ERROR FROM FDP0P5: X (=',G15.7,') TOO LARGE, ',
46110     1          'WOULD RESULT IN OVERFLOW.')
46111         CALL DPWRST('XXX','BUG ')
46112         FDP0P5 = ZERO
46113         RETURN
46114      ENDIF
46115C
46116C   Code for x < -1
46117C
46118      IF ( X .LT. -ONE ) THEN
46119         IF ( X .GT. XMIN1 ) THEN
46120            EXPX = EXP(X)
46121            T = TWOE * EXPX - ONE
46122            FDP0P5 = EXPX * CHEVAL ( NTERM1 , ARRFD1 , T )
46123         ELSE
46124            IF ( X .LT. XMIN2 ) THEN
46125               FDP0P5 = ZERO
46126            ELSE
46127               FDP0P5 = EXP(X)
46128            ENDIF
46129         ENDIF
46130      ELSE
46131C
46132C   Code for -1 <= x <= 2
46133C
46134         IF ( X .LE. TWO ) THEN
46135            T = ( TWO * X - ONE ) / THREE
46136            FDP0P5 = CHEVAL ( NTERM2 , ARRFD2 , T )
46137         ELSE
46138C
46139C   Code for x > 2
46140C
46141            FDP0P5 = X * SQRT(X) / GAM2P5
46142            IF ( X .LE. XHIGH1 ) THEN
46143               XSQ = X * X
46144               T = ( FIFTY - XSQ ) / ( FORTY2 + XSQ )
46145               CHV = CHEVAL ( NTERM3 , ARRFD3 , T )
46146               FDP0P5 = FDP0P5 * ( ONE + CHV / XSQ )
46147            ENDIF
46148         ENDIF
46149      ENDIF
46150      RETURN
46151      END
46152      DOUBLE PRECISION FUNCTION FDP1P5(XVALUE)
46153C
46154C   DESCRIPTION:
46155C
46156C      This function computes the Fermi-Dirac function of
46157C      order 3/2, defined as
46158C
46159C                     Int{0 to inf} t**(3/2) / (1+exp(t-x)) dt
46160C         FDP1P5(x) = -----------------------------------------
46161C                                 Gamma(5/2)
46162C
46163C      The function uses Chebyshev expansions which are given to
46164C      16 decimal places for x <= 2, but only 10 decimal places
46165C      for x > 2.
46166C
46167C
46168C   ERROR RETURNS:
46169C
46170C      If XVALUE too large and positive, the function value
46171C      will overflow. An error message is printed and the function
46172C      returns the value 0.0.
46173C
46174C
46175C   MACHINE-DEPENDENT CONSTANTS:
46176C
46177C      NTERMS1 - INTEGER - The number of terms used from the array
46178C                          ARRFD1. The recommended value is such that
46179C                               ABS(ARRFD1(NTERMS1)) < EPS/10
46180C                          subject to 1 <= NTERMS1 <= 12.
46181C
46182C      NTERMS2 - INTEGER - The number of terms used from the array
46183C                          ARRFD2. The recommended value is such that
46184C                               ABS(ARRFD2(NTERMS2)) < EPS/10
46185C                          subject to 1 <= NTERMS1 <= 22.
46186C
46187C      NTERMS3 - INTEGER - The number of terms used from the array
46188C                          ARRFD3. The recommended value is such that
46189C                               ABS(ARRFD3(NTERMS3)) < EPS/10
46190C                          subject to 1 <= NTERMS3 <= 33.
46191C
46192C      XMIN1 - REAL - The value of x below which
46193C                         FDP1P5(x) = exp(x)
46194C                     to machine precision. The recommended value
46195C                     is   2.5*LN(2) + LN(EPSNEG)
46196C
46197C      XMIN2 - REAL - The value of x below which
46198C                         FDP1P5(x) = 0.0
46199C                     to machine precision. The recommended value
46200C                     is    LN ( XMIN )
46201C
46202C      XHIGH1 - REAL - The value of x above which
46203C                         FDP1P5(x) = x**(5/2)/GAMMA(7/2)
46204C                     to machine precision. The recommended value
46205C                     is   pi * SQRT(1.6/EPS)
46206C
46207C      XHIGH2 - REAL - The value of x above which FDP1P5 would
46208C                      overflow. The reommended value is
46209C                              (3.233509*XMAX)**(2/5)
46210C
46211C      For values of EPS, EPSNEG, and XMIN the user should refer to the
46212C      paper by Cody in ACM. Trans. Math. Soft. Vol. 14 (1988) p303-311.
46213C
46214C      This code is provided with single and double precision values
46215C      of the machine-dependent parameters, suitable for machines
46216C      which satisfy the IEEE floating-point standard.
46217C
46218C
46219C   AUTHOR:
46220C          DR. ALLAN MACLEOD,
46221C          DEPT. OF MATHEMATICS AND STATISTICS,
46222C          UNIVERSITY OF PAISLEY,
46223C          HIGH ST.,
46224C          PAISLEY,
46225C          SCOTLAND
46226C          PA1 2BE
46227C
46228C          (e-mail: macl_ms0@paisley.ac.uk )
46229C
46230C
46231C   LATEST UPDATE:
46232C                 21 NOVEMBER, 1996
46233C
46234      INTEGER NTERM1,NTERM2,NTERM3
46235      DOUBLE PRECISION
46236     1     ARRFD1(0:12),ARRFD2(0:22),ARRFD3(0:55),
46237     2     CHEVAL,CHV,EXPX,FIFTY,FORTY2,
46238     3     GAM3P5,ONE,T,THREE,TWO,TWOE,X,XHIGH1,
46239     4     XHIGH2,XMIN1,XMIN2,XSQ,XVALUE,ZERO
46240C
46241C-----COMMON----------------------------------------------------------
46242C
46243      INCLUDE 'DPCOMC.INC'
46244      INCLUDE 'DPCOP2.INC'
46245C
46246      DATA ARRFD1/1.9406 5492 1037 8650  D   0,
46247     1           -0.2878 6747 5518 043   D  -1,
46248     2            0.8509 1579 5231 3     D  -3,
46249     3           -0.3327 8452 5669       D  -4,
46250     4            0.1517 1202 058        D  -5,
46251     5           -0.7622 0087 4          D  -7,
46252     6            0.4095 5489            D  -8,
46253     7           -0.2311 964             D  -9,
46254     8            0.1355 37              D -10,
46255     9           -0.8187                 D -12,
46256     X            0.507                  D -13,
46257     1           -0.32                   D -14,
46258     2            0.2                    D -15/
46259      DATA ARRFD2( 0)/ 3.5862 2516 1563 4306 D   0/
46260      DATA ARRFD2( 1)/ 1.8518 2900 5626 5751 D   0/
46261      DATA ARRFD2( 2)/ 0.4612 3491 0241 7150 D   0/
46262      DATA ARRFD2( 3)/ 0.5793 0397 6126 881  D  -1/
46263      DATA ARRFD2( 4)/ 0.1704 3790 5548 75   D  -2/
46264      DATA ARRFD2( 5)/-0.3970 5201 2249 6    D  -3/
46265      DATA ARRFD2( 6)/-0.7070 2491 890       D  -5/
46266      DATA ARRFD2( 7)/ 0.7659 9748 792       D  -5/
46267      DATA ARRFD2( 8)/-0.1857 8113 33        D  -6/
46268      DATA ARRFD2( 9)/-0.1832 2379 56        D  -6/
46269      DATA ARRFD2(10)/ 0.1392 4949 5         D  -7/
46270      DATA ARRFD2(11)/ 0.4670 2027           D  -8/
46271      DATA ARRFD2(12)/-0.6671 984            D  -9/
46272      DATA ARRFD2(13)/-0.1161 292            D  -9/
46273      DATA ARRFD2(14)/ 0.2844 38             D -10/
46274      DATA ARRFD2(15)/ 0.2490 6              D -11/
46275      DATA ARRFD2(16)/-0.1143 1              D -11/
46276      DATA ARRFD2(17)/-0.279                 D -13/
46277      DATA ARRFD2(18)/ 0.439                 D -13/
46278      DATA ARRFD2(19)/-0.14                  D -14/
46279      DATA ARRFD2(20)/-0.16                  D -14/
46280      DATA ARRFD2(21)/ 0.1                   D -15/
46281      DATA ARRFD2(22)/ 0.1                   D -15/
46282      DATA ARRFD3( 0)/12.1307 5817 3688 4627  D   0/
46283      DATA ARRFD3( 1)/-0.1547 5011 1128 7255  D   0/
46284      DATA ARRFD3( 2)/-0.7390 0738 8850 999   D  -1/
46285      DATA ARRFD3( 3)/-0.3072 3537 7959 258   D  -1/
46286      DATA ARRFD3( 4)/-0.1145 4857 9330 328   D  -1/
46287      DATA ARRFD3( 5)/-0.4056 7636 8095 39    D  -2/
46288      DATA ARRFD3( 6)/-0.1398 0158 3732 27    D  -2/
46289      DATA ARRFD3( 7)/-0.4454 9018 1015 3     D  -3/
46290      DATA ARRFD3( 8)/-0.1173 9461 1270 4     D  -3/
46291      DATA ARRFD3( 9)/-0.1484 0898 0093       D  -4/
46292      DATA ARRFD3(10)/ 0.1188 9515 4223       D  -4/
46293      DATA ARRFD3(11)/ 0.1464 7695 8178       D  -4/
46294      DATA ARRFD3(12)/ 0.1132 2874 1730       D  -4/
46295      DATA ARRFD3(13)/ 0.7576 2292 948        D  -5/
46296      DATA ARRFD3(14)/ 0.4712 0400 466        D  -5/
46297      DATA ARRFD3(15)/ 0.2813 2628 202        D  -5/
46298      DATA ARRFD3(16)/ 0.1637 0517 341        D  -5/
46299      DATA ARRFD3(17)/ 0.9351 0762 72         D  -6/
46300      DATA ARRFD3(18)/ 0.5278 6892 10         D  -6/
46301      DATA ARRFD3(19)/ 0.2951 0798 70         D  -6/
46302      DATA ARRFD3(20)/ 0.1638 6001 90         D  -6/
46303      DATA ARRFD3(21)/ 0.9052 0540 9          D  -7/
46304      DATA ARRFD3(22)/ 0.4977 5697 5          D  -7/
46305      DATA ARRFD3(23)/ 0.2729 5586 3          D  -7/
46306      DATA ARRFD3(24)/ 0.1492 1458 5          D  -7/
46307      DATA ARRFD3(25)/ 0.8142 0359            D  -8/
46308      DATA ARRFD3(26)/ 0.4434 9200            D  -8/
46309      DATA ARRFD3(27)/ 0.2411 6032            D  -8/
46310      DATA ARRFD3(28)/ 0.1310 5018            D  -8/
46311      DATA ARRFD3(29)/ 0.7109 736             D  -9/
46312      DATA ARRFD3(30)/ 0.3856 721             D  -9/
46313      DATA ARRFD3(31)/ 0.2089 529             D  -9/
46314      DATA ARRFD3(32)/ 0.1131 735             D  -9/
46315      DATA ARRFD3(33)/ 0.6127 85              D -10/
46316      DATA ARRFD3(34)/ 0.3314 48              D -10/
46317      DATA ARRFD3(35)/ 0.1794 19              D -10/
46318      DATA ARRFD3(36)/ 0.9695 3               D -11/
46319      DATA ARRFD3(37)/ 0.5246 3               D -11/
46320      DATA ARRFD3(38)/ 0.2834 3               D -11/
46321      DATA ARRFD3(39)/ 0.1532 3               D -11/
46322      DATA ARRFD3(40)/ 0.8284                 D -12/
46323      DATA ARRFD3(41)/ 0.4472                 D -12/
46324      DATA ARRFD3(42)/ 0.2421                 D -12/
46325      DATA ARRFD3(43)/ 0.1304                 D -12/
46326      DATA ARRFD3(44)/ 0.707                  D -13/
46327      DATA ARRFD3(45)/ 0.381                  D -13/
46328      DATA ARRFD3(46)/ 0.206                  D -13/
46329      DATA ARRFD3(47)/ 0.111                  D -13/
46330      DATA ARRFD3(48)/ 0.60                   D -14/
46331      DATA ARRFD3(49)/ 0.33                   D -14/
46332      DATA ARRFD3(50)/ 0.17                   D -14/
46333      DATA ARRFD3(51)/ 0.11                   D -14/
46334      DATA ARRFD3(52)/ 0.5                    D -15/
46335      DATA ARRFD3(53)/ 0.3                    D -15/
46336      DATA ARRFD3(54)/ 0.1                    D -15/
46337      DATA ARRFD3(55)/ 0.1                    D -15/
46338      DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0/
46339      DATA THREE,FORTY2,FIFTY/ 3.0 D 0 , 42.0 D 0 , 50.0 D 0/
46340      DATA GAM3P5/0.3323 3509 7044 7843 D 1/
46341      DATA TWOE/5.4365 6365 6918 0905 D 0/
46342C
46343C   Machine-dependent constants (suitable for IEEE machines)
46344C
46345      DATA NTERM1,NTERM2,NTERM3/12,22,55/
46346      DATA XMIN1,XMIN2/-35.004D0,-708.396418D0/
46347      DATA XHIGH1,XHIGH2/166674733.2D0,3.204467D123/
46348C
46349C   Start calculation
46350C
46351      X=XVALUE
46352C
46353C   Test for error condition
46354C
46355      IF ( X .GT. XHIGH2 ) THEN
46356         WRITE(ICOUT,11)
46357   11    FORMAT('**** ERROR FROM FDP1P5: X (=',G15.7,') TOO LARGE, ',
46358     1          'WOULD RESULT IN OVERFLOW.')
46359         CALL DPWRST('XXX','BUG ')
46360         FDP1P5 = ZERO
46361         RETURN
46362      ENDIF
46363C
46364C   Code for x < -1
46365C
46366      IF ( X .LT. -ONE ) THEN
46367         IF ( X .GT. XMIN1 ) THEN
46368            EXPX = EXP(X)
46369            T = TWOE * EXPX - ONE
46370            FDP1P5 = EXPX * CHEVAL ( NTERM1 , ARRFD1 , T )
46371         ELSE
46372            IF ( X .LT. XMIN2 ) THEN
46373               FDP1P5 = ZERO
46374            ELSE
46375               FDP1P5 = EXP(X)
46376            ENDIF
46377         ENDIF
46378      ELSE
46379C
46380C   Code for -1 <= x <= 2
46381C
46382         IF ( X .LE. TWO ) THEN
46383            T = ( TWO * X - ONE ) / THREE
46384            FDP1P5 = CHEVAL ( NTERM2 , ARRFD2 , T )
46385         ELSE
46386C
46387C   Code for x > 2
46388C
46389            FDP1P5 = X * X * SQRT(X) / GAM3P5
46390            IF ( X .LE. XHIGH1 ) THEN
46391               XSQ = X * X
46392               T = ( FIFTY - XSQ ) / ( FORTY2 + XSQ )
46393               CHV = CHEVAL ( NTERM3 , ARRFD3 , T )
46394               FDP1P5 = FDP1P5 * ( ONE + CHV / XSQ )
46395            ENDIF
46396         ENDIF
46397      ENDIF
46398      RETURN
46399      END
46400      DOUBLE PRECISION FUNCTION FDP2P5(XVALUE)
46401C
46402C   DESCRIPTION:
46403C
46404C      This function computes the Fermi-Dirac function of
46405C      order 5/2, defined as
46406C
46407C                     Int{0 to inf} t**(5/2) / (1+exp(t-x)) dt
46408C         FDP2P5(x) = -----------------------------------------
46409C                                 Gamma(7/2)
46410C
46411C      The function uses Chebyshev expansions which are given to
46412C      16 decimal places for x <= 2, but only 10 decimal places
46413C      for x > 2.
46414C
46415C
46416C   ERROR RETURNS:
46417C
46418C      If XVALUE too large and positive, the function value
46419C      will overflow. An error message is printed and the function
46420C      returns the value 0.0.
46421C
46422C
46423C   MACHINE-DEPENDENT CONSTANTS:
46424C
46425C      NTERMS1 - INTEGER - The number of terms used from the array
46426C                          ARRFD1. The recommended value is such that
46427C                               ABS(ARRFD1(NTERMS1)) < EPS/10
46428C                          subject to 1 <= NTERMS1 <= 11.
46429C
46430C      NTERMS2 - INTEGER - The number of terms used from the array
46431C                          ARRFD2. The recommended value is such that
46432C                               ABS(ARRFD2(NTERMS2)) < EPS/10
46433C                          subject to 1 <= NTERMS1 <= 21.
46434C
46435C      NTERMS3 - INTEGER - The number of terms used from the array
46436C                          ARRFD3. The recommended value is such that
46437C                               ABS(ARRFD3(NTERMS3)) < EPS/10
46438C                          subject to 1 <= NTERMS3 <= 39.
46439C
46440C      XMIN1 - REAL - The value of x below which
46441C                         FDP2P5(x) = exp(x)
46442C                     to machine precision. The recommended value
46443C                     is   3.5*LN(2) + LN(EPSNEG)
46444C
46445C      XMIN2 - REAL - The value of x below which
46446C                         FDP2P5(x) = 0.0
46447C                     to machine precision. The recommended value
46448C                     is    LN ( XMIN )
46449C
46450C      XHIGH1 - REAL - The value of x above which
46451C                         FDP2P5(x) = x**(7/2)/GAMMA(9/2)
46452C                     to machine precision. The recommended value
46453C                     is   pi * SQRT(35/(12*EPS))
46454C
46455C      XHIGH2 - REAL - The value of x above which FDP2P5 would
46456C                      overflow. The reommended value is
46457C                              (11.6317*XMAX)**(2/7)
46458C
46459C      For values of EPS, EPSNEG, and XMIN the user should refer to the
46460C      paper by Cody in ACM. Trans. Math. Soft. Vol. 14 (1988) p303-311.
46461C
46462C      This code is provided with single and double precision values
46463C      of the machine-dependent parameters, suitable for machines
46464C      which satisfy the IEEE floating-point standard.
46465C
46466C
46467C   AUTHOR:
46468C          DR. ALLAN MACLEOD,
46469C          DEPT. OF MATHEMATICS AND STATISTICS,
46470C          UNIVERSITY OF PAISLEY,
46471C          HIGH ST.,
46472C          PAISLEY,
46473C          SCOTLAND
46474C          PA1 2BE
46475C
46476C          (e-mail: macl-ms0@paisley.ac.uk )
46477C
46478C
46479C   LATEST UPDATE:
46480C                 21 NOVEMBER, 1996
46481C
46482      INTEGER NTERM1,NTERM2,NTERM3
46483      DOUBLE PRECISION
46484     1     ARRFD1(0:11),ARRFD2(0:21),ARRFD3(0:61),
46485     2     CHEVAL,CHV,EXPX,FIFTY,FORTY2,
46486     3     GAM4P5,ONE,T,THREE,TWO,TWOE,X,XHIGH1,
46487     4     XHIGH2,XMIN1,XMIN2,XSQ,XVALUE,ZERO
46488C
46489C-----COMMON----------------------------------------------------------
46490C
46491      INCLUDE 'DPCOMC.INC'
46492      INCLUDE 'DPCOP2.INC'
46493C
46494      DATA ARRFD1/1.9694 4166 8589 6693  D   0,
46495     1           -0.1496 9179 4643 492   D  -1,
46496     2            0.3006 9558 1662 7     D  -3,
46497     3           -0.8946 2485 950        D  -5,
46498     4            0.3298 0720 25         D  -6,
46499     5           -0.1392 3929 8          D  -7,
46500     6            0.6455 885             D  -9,
46501     7           -0.3206 23              D -10,
46502     8            0.1678 3               D -11,
46503     9           -0.916                  D -13,
46504     X            0.52                   D -14,
46505     1           -0.3                    D -15/
46506      DATA ARRFD2( 0)/ 4.2642 8383 9865 5301  D   0/
46507      DATA ARRFD2( 1)/ 2.3437 4268 8491 2867  D   0/
46508      DATA ARRFD2( 2)/ 0.6727 1197 8005 2076  D   0/
46509      DATA ARRFD2( 3)/ 0.1148 8263 2796 5569  D   0/
46510      DATA ARRFD2( 4)/ 0.1093 6396 8046 758   D  -1/
46511      DATA ARRFD2( 5)/ 0.2567 1739 5701 5     D  -3/
46512      DATA ARRFD2( 6)/-0.5058 8998 3911       D  -4/
46513      DATA ARRFD2( 7)/-0.7376 2157 74         D  -6/
46514      DATA ARRFD2( 8)/ 0.7352 9987 58         D  -6/
46515      DATA ARRFD2( 9)/-0.1664 2173 6          D  -7/
46516      DATA ARRFD2(10)/-0.1409 2049 9          D  -7/
46517      DATA ARRFD2(11)/ 0.9949 192             D  -9/
46518      DATA ARRFD2(12)/ 0.2991 457             D  -9/
46519      DATA ARRFD2(13)/-0.4013 32              D -10/
46520      DATA ARRFD2(14)/-0.6354 6               D -11/
46521      DATA ARRFD2(15)/ 0.1479 3               D -11/
46522      DATA ARRFD2(16)/ 0.1181                 D -12/
46523      DATA ARRFD2(17)/-0.524                  D -13/
46524      DATA ARRFD2(18)/-0.11                   D -14/
46525      DATA ARRFD2(19)/ 0.18                   D -14/
46526      DATA ARRFD2(20)/-0.1                    D -15/
46527      DATA ARRFD2(21)/-0.1                    D -15/
46528      DATA ARRFD3( 0)/30.2895 6768 5980 2579  D   0/
46529      DATA ARRFD3( 1)/ 1.1678 9766 4206 0562  D   0/
46530      DATA ARRFD3( 2)/ 0.6420 5918 0082 1472  D   0/
46531      DATA ARRFD3( 3)/ 0.3461 7238 6840 7417  D   0/
46532      DATA ARRFD3( 4)/ 0.1840 8167 9078 1889  D   0/
46533      DATA ARRFD3( 5)/ 0.9730 9243 5354 509   D  -1/
46534      DATA ARRFD3( 6)/ 0.5139 7329 2675 393   D  -1/
46535      DATA ARRFD3( 7)/ 0.2717 0980 1041 757   D  -1/
46536      DATA ARRFD3( 8)/ 0.1438 3327 1401 165   D  -1/
46537      DATA ARRFD3( 9)/ 0.7626 4863 9521 55    D  -2/
46538      DATA ARRFD3(10)/ 0.4050 3695 7672 02    D  -2/
46539      DATA ARRFD3(11)/ 0.2154 3961 4641 49    D  -2/
46540      DATA ARRFD3(12)/ 0.1147 5689 9017 77    D  -2/
46541      DATA ARRFD3(13)/ 0.6120 6223 6928 2     D  -3/
46542      DATA ARRFD3(14)/ 0.3268 3403 3785 9     D  -3/
46543      DATA ARRFD3(15)/ 0.1747 1455 2274 2     D  -3/
46544      DATA ARRFD3(16)/ 0.9348 7845 7860       D  -4/
46545      DATA ARRFD3(17)/ 0.5006 9221 2553       D  -4/
46546      DATA ARRFD3(18)/ 0.2683 7382 1846       D  -4/
46547      DATA ARRFD3(19)/ 0.1439 5719 1251       D  -4/
46548      DATA ARRFD3(20)/ 0.7727 2440 700        D  -5/
46549      DATA ARRFD3(21)/ 0.4150 3820 336        D  -5/
46550      DATA ARRFD3(22)/ 0.2230 5118 261        D  -5/
46551      DATA ARRFD3(23)/ 0.1199 3697 093        D  -5/
46552      DATA ARRFD3(24)/ 0.6452 3443 69         D  -6/
46553      DATA ARRFD3(25)/ 0.3472 8228 81         D  -6/
46554      DATA ARRFD3(26)/ 0.1869 9642 15         D  -6/
46555      DATA ARRFD3(27)/ 0.1007 3002 72         D  -6/
46556      DATA ARRFD3(28)/ 0.5428 0756 1          D  -7/
46557      DATA ARRFD3(29)/ 0.2926 0782 9          D  -7/
46558      DATA ARRFD3(30)/ 0.1577 8591 8          D  -7/
46559      DATA ARRFD3(31)/ 0.8511 0768            D  -8/
46560      DATA ARRFD3(32)/ 0.4592 2760            D  -8/
46561      DATA ARRFD3(33)/ 0.2478 5001            D  -8/
46562      DATA ARRFD3(34)/ 0.1338 0255            D  -8/
46563      DATA ARRFD3(35)/ 0.7225 103             D  -9/
46564      DATA ARRFD3(36)/ 0.3902 350             D  -9/
46565      DATA ARRFD3(37)/ 0.2108 157             D  -9/
46566      DATA ARRFD3(38)/ 0.1139 122             D  -9/
46567      DATA ARRFD3(39)/ 0.6156 38              D -10/
46568      DATA ARRFD3(40)/ 0.3327 81              D -10/
46569      DATA ARRFD3(41)/ 0.1799 19              D -10/
46570      DATA ARRFD3(42)/ 0.9728 8               D -11/
46571      DATA ARRFD3(43)/ 0.5261 7               D -11/
46572      DATA ARRFD3(44)/ 0.2846 1               D -11/
46573      DATA ARRFD3(45)/ 0.1539 7               D -11/
46574      DATA ARRFD3(46)/ 0.8331                 D -12/
46575      DATA ARRFD3(47)/ 0.4508                 D -12/
46576      DATA ARRFD3(48)/ 0.2440                 D -12/
46577      DATA ARRFD3(49)/ 0.1321                 D -12/
46578      DATA ARRFD3(50)/ 0.715                  D -13/
46579      DATA ARRFD3(51)/ 0.387                  D -13/
46580      DATA ARRFD3(52)/ 0.210                  D -13/
46581      DATA ARRFD3(53)/ 0.114                  D -13/
46582      DATA ARRFD3(54)/ 0.61                   D -14/
46583      DATA ARRFD3(55)/ 0.33                   D -14/
46584      DATA ARRFD3(56)/ 0.18                   D -14/
46585      DATA ARRFD3(57)/ 0.11                   D -14/
46586      DATA ARRFD3(58)/ 0.5                    D -15/
46587      DATA ARRFD3(59)/ 0.3                    D -15/
46588      DATA ARRFD3(60)/ 0.2                    D -15/
46589      DATA ARRFD3(61)/ 0.1                    D -15/
46590      DATA ZERO,ONE,TWO/ 0.0 D 0 , 1.0 D 0 , 2.0 D 0/
46591      DATA THREE,FORTY2,FIFTY/ 3.0 D 0 , 42.0 D 0 , 50.0 D 0/
46592      DATA GAM4P5/0.1163 1728 3965 6745 D 2/
46593      DATA TWOE/5.4365 6365 6918 0905 D 0/
46594C
46595C   Machine-dependent constants (suitable for IEEE machines)
46596C
46597      DATA NTERM1,NTERM2,NTERM3/11,21,61/
46598      DATA XMIN1,XMIN2/-34.3107854D0,-708.396418D0/
46599      DATA XHIGH1,XHIGH2/254599860.5D0,2.383665D88/
46600C
46601C   Start calculation
46602C
46603      X=XVALUE
46604C
46605C   Test for error condition
46606C
46607      IF ( X .GT. XHIGH2 ) THEN
46608         WRITE(ICOUT,11)
46609   11    FORMAT('**** ERROR FROM FDP2P5: X (=',G15.7,') TOO LARGE, ',
46610     1          'WOULD RESULT IN OVERFLOW.')
46611         CALL DPWRST('XXX','BUG ')
46612         FDP2P5 = ZERO
46613         RETURN
46614      ENDIF
46615C
46616C   Code for x < -1
46617C
46618      IF ( X .LT. -ONE ) THEN
46619         IF ( X .GT. XMIN1 ) THEN
46620            EXPX = EXP(X)
46621            T = TWOE * EXPX - ONE
46622            FDP2P5 = EXPX * CHEVAL ( NTERM1 , ARRFD1 , T )
46623         ELSE
46624            IF ( X .LT. XMIN2 ) THEN
46625               FDP2P5 = ZERO
46626            ELSE
46627               FDP2P5 = EXP(X)
46628            ENDIF
46629         ENDIF
46630      ELSE
46631C
46632C   Code for -1 <= x <= 2
46633C
46634         IF ( X .LE. TWO ) THEN
46635            T = ( TWO * X - ONE ) / THREE
46636            FDP2P5 = CHEVAL ( NTERM2 , ARRFD2 , T )
46637         ELSE
46638C
46639C   Code for x > 2
46640C
46641            FDP2P5 = X * X * X * SQRT(X) / GAM4P5
46642            IF ( X .LE. XHIGH1 ) THEN
46643               XSQ = X * X
46644               T = ( FIFTY - XSQ ) / ( FORTY2 + XSQ )
46645               CHV = CHEVAL ( NTERM3 , ARRFD3 , T )
46646               FDP2P5 = FDP2P5 * ( ONE + CHV / XSQ )
46647            ENDIF
46648         ENDIF
46649      ENDIF
46650      RETURN
46651      END
46652      SUBROUTINE FIBONN(N,X,IERROR)
46653C
46654C     PURPOSE--THIS SUBROUTINE GENERATES THE FIRST N FIBONNACI NUMBERS--
46655C              1, 1, 2, 3, 5, 8, 13, 21, ...
46656C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
46657C                                OF FIBONNACI NUMBERS
46658C                                TO BE GENERATED.
46659C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
46660C                                (OF DIMENSION AT LEAST N)
46661C                                INTO WHICH THE GENERATED
46662C                                FIBONNACI NUMBERS
46663C                                WILL BE PLACED.
46664C     OUTPUT--THE FIRST N FIBONNACI NUMBERS.
46665C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
46666C                   OF N FOR THIS SUBROUTINE.
46667C     LANGUAGE--ANSI FORTRAN (1977)
46668C     WRITTEN BY--JAMES J. FILLIBEN
46669C                 STATISTICAL ENGINEERING DIVISION
46670C                 INFORMATION TECHNOLOGY LABORATORY
46671C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
46672C                 GAITHERSBURG, MD 20899
46673C                 PHONE--301-975-2855
46674C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
46675C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
46676C     LANGUAGE--ANSI FORTRAN (1977)
46677C     VERSION NUMBER--87.10
46678C     ORIGINAL VERSION--SEPTEMBER 1987.
46679C
46680C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
46681C
46682      CHARACTER*4 IERROR
46683C
46684C---------------------------------------------------------------------
46685C
46686      DIMENSION X(*)
46687C
46688C-----COMMON----------------------------------------------------------
46689C
46690      INCLUDE 'DPCOP2.INC'
46691C
46692C-----START POINT-----------------------------------------------------
46693C
46694      CPUMA3=CPUMAX/3.0
46695C
46696C               ******************************************
46697C               **  TREAT THE FIBONNACCI SEQUENCE CASE  **
46698C               ******************************************
46699C
46700C               *******************************************
46701C               **  STEP 1--                             **
46702C               **  TEST THE INPUT ARGUMENTS FOR ERRORS  **
46703C               *******************************************
46704C
46705      IF(N.GE.1)GOTO190
46706      WRITE(ICOUT,999)
46707  999 FORMAT(1X)
46708      CALL DPWRST('XXX','BUG ')
46709      WRITE(ICOUT,101)
46710  101 FORMAT('***** ERROR IN GENMS--')
46711      CALL DPWRST('XXX','BUG ')
46712      WRITE(ICOUT,102)
46713  102 FORMAT('      THE LENGTH OF THE DESIRED SEQUENCE')
46714      CALL DPWRST('XXX','BUG ')
46715      WRITE(ICOUT,103)
46716  103 FORMAT('      OF FIBONNACI NUMBERS MUST BE 1 OR LARGER;')
46717      CALL DPWRST('XXX','BUG ')
46718      WRITE(ICOUT,104)
46719  104 FORMAT('      SUCH WAS NOT THE CASE HERE.')
46720      CALL DPWRST('XXX','BUG ')
46721      WRITE(ICOUT,105)N
46722  105 FORMAT('      N = ',I8)
46723      CALL DPWRST('XXX','BUG ')
46724      IERROR='YES'
46725      GOTO9000
46726  190 CONTINUE
46727C
46728C               ******************************
46729C               **  STEP 2--                **
46730C               **  GENERATE THE SEQUENCE   **
46731C               ******************************
46732C
46733      X(1)=1.0
46734      X(2)=1.0
46735      IF(N.LT.3)GOTO1190
46736      DO1100I=3,N
46737      I2=I
46738      IM2=I-2
46739      IM1=I-1
46740      X(I)=X(IM2)+X(IM1)
46741      IF(X(I).GE.CPUMA3)GOTO1150
46742 1100 CONTINUE
46743      GOTO1190
46744C
46745 1150 CONTINUE
46746      I2P1=I2+1
46747      WRITE(ICOUT,1151)
46748 1151 FORMAT('***** ERROR IN FIBONN--')
46749      CALL DPWRST('XXX','BUG ')
46750      WRITE(ICOUT,1152)
46751 1152 FORMAT('      A NUMBER IN THE FIBONNACCI SEQUENCE')
46752      CALL DPWRST('XXX','BUG ')
46753      WRITE(ICOUT,1153)
46754 1153 FORMAT('      HAS JUST EXCEEDED THE ')
46755      CALL DPWRST('XXX','BUG ')
46756      WRITE(ICOUT,1154)
46757 1154 FORMAT('      LARGEST FLOATING POINT NUMBER')
46758      CALL DPWRST('XXX','BUG ')
46759      WRITE(ICOUT,1155)
46760 1155 FORMAT('      ALLOWABLE FOR THIS COMPUTER (',E15.7,').')
46761      CALL DPWRST('XXX','BUG ')
46762      WRITE(ICOUT,1156)
46763 1156 FORMAT('      THE VALUE CAUSING THE OVERFLOW WAS')
46764      CALL DPWRST('XXX','BUG ')
46765      WRITE(ICOUT,1157)I2P1
46766 1157 FORMAT('      THE ',I8,'-TH NUMBER IN THE')
46767      CALL DPWRST('XXX','BUG ')
46768      WRITE(ICOUT,1158)
46769 1158 FORMAT('      FIBONNACCI SEQUENCE.')
46770      CALL DPWRST('XXX','BUG ')
46771      IERROR='YES'
46772      GOTO9000
46773C
46774 1190 CONTINUE
46775C
46776C               *****************
46777C               **  STEP 90--  **
46778C               **  EXIT       **
46779C               *****************
46780C
46781 9000 CONTINUE
46782      RETURN
46783      END
46784      SUBROUTINE FILLHT(IPHORI,ICHORI,AUPPER,ALOWER,XHORIZ,NHORP,ICASEF,
46785     1IBUGU2,ISUBRO,IERROR)
46786C
46787C     PURPOSE--FILL IN (LINEARLY INTERPOLATE) VALUES IN THE HORIZON
46788C              TABLES FROM ELEMENTS IPREV TO ICUR, INCLUSIVE.
46789C     REFERENCE--ROGERS, DAVID F. (1985).  PROCEDURAL
46790C                ELEMENTS FOR COMPUTER GRAPHICS.
46791C                MCGRAW-HILL, NEW YORK, PAGE 197-201.
46792C     WRITTEN BY--JAMES J. FILLIBEN
46793C                 STATISTICAL ENGINEERING DIVISION
46794C                 INFORMATION TECHNOLOGY LABORATORY
46795C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
46796C                 GAITHERSBURG, MD 20899
46797C                 PHONE--301-975-2855
46798C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
46799C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
46800C     LANGUAGE--ANSI FORTRAN (1977)
46801C     VERSION NUMBER--88/9
46802C     ORIGINAL VERSION--AUGUST    1988.
46803C
46804C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
46805C
46806      CHARACTER*4 ICASEF
46807C
46808      CHARACTER*4 IBUGU2
46809      CHARACTER*4 ISUBRO
46810      CHARACTER*4 IERROR
46811C
46812      CHARACTER*4 ISUBN1
46813      CHARACTER*4 ISUBN2
46814CCCCC CHARACTER*4 ISTEPN
46815C
46816C---------------------------------------------------------------------
46817C
46818      DIMENSION AUPPER(*)
46819      DIMENSION ALOWER(*)
46820      DIMENSION XHORIZ(*)
46821C
46822C-----COMMON VARIABLES (GENERAL)--------------------------------------
46823C
46824      INCLUDE 'DPCOP2.INC'
46825C
46826C-----START POINT-----------------------------------------------------
46827C
46828      ISUBN1='FILL'
46829      ISUBN2='HT  '
46830C
46831      IF(IBUGU2.EQ.'ON'.OR.ISUBRO.EQ.'LLHT')GOTO50
46832      GOTO90
46833   50 CONTINUE
46834      WRITE(ICOUT,999)
46835  999 FORMAT(1X)
46836      CALL DPWRST('XXX','BUG ')
46837      WRITE(ICOUT,51)
46838   51 FORMAT('***** AT THE BEGINNING OF FILLHT--')
46839      CALL DPWRST('XXX','BUG ')
46840      WRITE(ICOUT,52)IBUGU2,ISUBRO,IERROR
46841   52 FORMAT('IBUGU2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
46842      CALL DPWRST('XXX','BUG ')
46843      WRITE(ICOUT,53)ICASEF
46844   53 FORMAT('ICASEF = ',A4)
46845      CALL DPWRST('XXX','BUG ')
46846      WRITE(ICOUT,61)IPHORI,ICHORI,NHORP
46847   61 FORMAT('IPHORI,ICHORI,NHORP = ',3I8)
46848      CALL DPWRST('XXX','BUG ')
46849      DO65I=IPHORI,ICHORI
46850      WRITE(ICOUT,66)I,AUPPER(I),ALOWER(I),XHORIZ(I)
46851   66 FORMAT('I,AUPPER(I),ALOWER(I),XHORIZ(I) = ',I8,3E15.7)
46852      CALL DPWRST('XXX','BUG ')
46853   65 CONTINUE
46854   90 CONTINUE
46855C
46856      YPU=AUPPER(IPHORI)
46857      YPL=ALOWER(IPHORI)
46858      XP=XHORIZ(IPHORI)
46859C
46860      YCU=AUPPER(ICHORI)
46861      YCL=ALOWER(ICHORI)
46862      XC=XHORIZ(ICHORI)
46863C
46864C               **************************************************
46865C               **  STEP 10--                                   **
46866C               **  BRANCH, BASED ON                            **
46867C               **  INDEX DIFFERENCE AND SLOPE                  **
46868C               **************************************************
46869C
46870      IDEL=ICHORI-IPHORI
46871      IF(IDEL.LE.1)GOTO9000
46872      IF(XC.EQ.XP)GOTO6000
46873      GOTO7000
46874C
46875C               **************************************************
46876C               **  STEP 60--                                   **
46877C     ----------**  TREAT THE CASE OF NON-ADJ. HORIZON CELL     **----------
46878C               **  AND INFINITE SLOPE                          **
46879C               **  (SHOULD BE IMPOSSIBLE)                      **
46880C               **************************************************
46881C
46882 6000 CONTINUE
46883      WRITE(ICOUT,999)
46884      CALL DPWRST('XXX','BUG ')
46885      WRITE(ICOUT,6010)
46886 6010 FORMAT('***** INTERNAL ERROR IN FILLHT--')
46887      CALL DPWRST('XXX','BUG ')
46888      WRITE(ICOUT,6011)
46889 6011 FORMAT('      AT BRANCH POINT 4000 (AN IMPOSSIBLE BRANCH)')
46890      CALL DPWRST('XXX','BUG ')
46891      WRITE(ICOUT,6012)
46892 6012 FORMAT('      CONDITION = ADJACENT CELL BUT INFINITE SLOPE.')
46893      CALL DPWRST('XXX','BUG ')
46894      WRITE(ICOUT,6013)
46895 6013 FORMAT('      IF HAVE INFINITE SLOPE, THEN NECESSARILY MUST')
46896      CALL DPWRST('XXX','BUG ')
46897      WRITE(ICOUT,6014)
46898 6014 FORMAT('      BE IN SAME CELL.')
46899      CALL DPWRST('XXX','BUG ')
46900      WRITE(ICOUT,6015)IPHORI,ICHORI
46901 6015 FORMAT('IPHORI,ICHORI = ',2I8)
46902      CALL DPWRST('XXX','BUG ')
46903      WRITE(ICOUT,6016)XHORIZ(IPHORI),XHORIZ(ICHORI)
46904 6016 FORMAT('XHORIZ(IPHORI),XHORIZ(ICHORI) = ',2E15.7)
46905      CALL DPWRST('XXX','BUG ')
46906      IERROR='YES'
46907      GOTO9000
46908C
46909C               **************************************************
46910C               **  STEP 70--                                   **
46911C     ----------**  TREAT THE CASE OF NON-ADJ. HORIZON CELL     **----------
46912C               **  AND FINITE SLOPE                            **
46913C               **************************************************
46914C
46915 7000 CONTINUE
46916      IF(ICASEF.EQ.'UPPE'.OR.ICASEF.EQ.'BOTH')GOTO7100
46917      GOTO7190
46918 7100 CONTINUE
46919      SLOPEU=(YCU-YPU)/(XC-XP)
46920      IMIN=IPHORI+1
46921      IMAX=ICHORI-1
46922      DO7110I=IMIN,IMAX
46923      XTEMP=XHORIZ(I)
46924      YTEMPU=YPU+(XTEMP-XP)*SLOPEU
46925      IF(YTEMPU.GT.AUPPER(I))AUPPER(I)=YTEMPU
46926 7110 CONTINUE
46927 7190 CONTINUE
46928C
46929      IF(ICASEF.EQ.'LOWE'.OR.ICASEF.EQ.'BOTH')GOTO7200
46930      GOTO7290
46931 7200 CONTINUE
46932      SLOPEL=(YCL-YPL)/(XC-XP)
46933      IMIN=IPHORI+1
46934      IMAX=ICHORI-1
46935      DO7210I=IMIN,IMAX
46936      XTEMP=XHORIZ(I)
46937      YTEMPL=YPL+(XTEMP-XP)*SLOPEL
46938      IF(YTEMPL.LT.ALOWER(I))ALOWER(I)=YTEMPL
46939 7210 CONTINUE
46940 7290 CONTINUE
46941C
46942C               **************************************************
46943C               **  STEP 90--                                   **
46944C               **  EXIT.                                       **
46945C               **************************************************
46946C
46947 9000 CONTINUE
46948      IF(IBUGU2.EQ.'ON'.OR.ISUBRO.EQ.'LLHT')GOTO9010
46949      GOTO9090
46950 9010 CONTINUE
46951      WRITE(ICOUT,999)
46952      CALL DPWRST('XXX','BUG ')
46953      WRITE(ICOUT,9011)
46954 9011 FORMAT('***** AT THE END       OF FILLHT--')
46955      CALL DPWRST('XXX','BUG ')
46956      WRITE(ICOUT,9012)IBUGU2,ISUBRO,IERROR
46957 9012 FORMAT('IBUGU2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
46958      CALL DPWRST('XXX','BUG ')
46959      WRITE(ICOUT,9013)ICASEF
46960 9013 FORMAT('ICASEF = ',A4)
46961      CALL DPWRST('XXX','BUG ')
46962      WRITE(ICOUT,9021)IPHORI,ICHORI,NHORP
46963 9021 FORMAT('IPHORI,ICHORI,NHORP = ',3I8)
46964      CALL DPWRST('XXX','BUG ')
46965      DO9025I=IPHORI,ICHORI
46966      WRITE(ICOUT,9026)I,AUPPER(I),ALOWER(I),XHORIZ(I)
46967 9026 FORMAT('I,AUPPER(I),ALOWER(I),XHORIZ(I) = ',I8,3E15.7)
46968      CALL DPWRST('XXX','BUG ')
46969 9025 CONTINUE
46970 9090 CONTINUE
46971C
46972      RETURN
46973      END
46974      SUBROUTINE FISHER(X, M, Y, N, TOTAL, POSSIB, P,
46975     1                  SUMX, SUMY, MEANX, MEANY,
46976     1                  WS1, WS2, WS3, MAXSAM, MAXNXT,
46977     1                  IFAULT,IBUGA3)
46978C
46979C        ALGORITHM AS 304.1 APPL.STATIST. (1996), VOL.45, NO.3
46980C
46981C        Fisher's non-parametric randomization test for two small
46982C        independent random samples
46983C
46984CCCCC INTEGER M, N, TOTAL, POSSIB, IFAULT
46985CCCCC INTEGER WS3(MAXSAM)
46986      INTEGER M, N, TOTAL, IFAULT
46987      INTEGER WS3(*)
46988      REAL X(*), Y(*), P
46989CCCCC REAL WS1(MAXSIZ), WS2(MAXSIZ)
46990      REAL WS1(*), WS2(*)
46991C
46992      INTEGER MAXSAM, MAXSIZ, MAXNXT
46993CCCCC PARAMETER (MAXSAM = 14, MAXSIZ = 3432)
46994C
46995C        Important : set MAXSIZ >= COMB(MAXSAM, MAXSAM / 2)
46996C
46997CCCCC INTEGER K, SIZE1, SIZE2, COUNT
46998      INTEGER K, SIZE1, SIZE2
46999CCCCC REAL SUMX, SUMY, SUMM, POSSIB
47000      REAL SUMX, SUMY, POSSIB
47001      REAL MEANX, MEANY
47002C
47003      INTEGER TRADES
47004CCCCC REAL MEAN, SUM
47005CCCCC EXTERNAL COMB, SUM, TRADES
47006      REAL BINOM
47007      EXTERNAL BINOM, TRADES
47008C
47009      EXTERNAL CMPLMT, EXCHNG, KTRADE
47010C
47011      CHARACTER*4 IBUGA3
47012      CHARACTER*4 IWRITE
47013      CHARACTER*4 IERROR
47014C
47015CCCCC MEAN(SUMM, COUNT) = SUMM / REAL(COUNT)
47016C
47017      IWRITE='OFF'
47018CCCCC IF (COMB(MAXSAM, MAXSAM/2) .GT. MAXSIZ) THEN
47019      ATEMP=BINOM(MAXSAM,MAXSAM/2)
47020      MAXSIZ=INT(ATEMP+0.5)
47021C
47022      IF (MAXSIZ.GT.MAXNXT) THEN
47023         IFAULT = 1
47024      ELSE IF (M .GT. MAXSAM .OR. N .GT. MAXSAM) THEN
47025              IFAULT = 2
47026           ELSE
47027              IFAULT = 0
47028              CALL SUMDP(X,M,IWRITE,SUMX,IBUGA3,IERROR)
47029              CALL SUMDP(Y,N,IWRITE,SUMY,IBUGA3,IERROR)
47030              MEANX=SUMX/REAL(M)
47031              MEANY=SUMY/REAL(N)
47032CCCCC         IF (MEAN(SUMX, M) .GT. MEAN(SUMY, N)) THEN
47033              IF (MEANX.GT.MEANY) THEN
47034                 CALL EXCHNG(X, M, Y, N, SUMX, SUMY)
47035           END IF
47036           TOTAL = 0
47037           IF (M .EQ. N) THEN
47038              DO 10 K = 1, (M-1)/2
47039                 CALL KTRADE(X, M, WS1, SIZE1, WS3, K)
47040                 CALL KTRADE(Y, N, WS2, SIZE2, WS3, K)
47041                 TOTAL = TOTAL + TRADES(WS1, SIZE1, WS2, SIZE2)
47042                 CALL CMPLMT(WS1, SIZE1, SUMX)
47043                 CALL CMPLMT(WS2, SIZE2, SUMY)
47044                 TOTAL = TOTAL + TRADES(WS1, SIZE1, WS2, SIZE2)
47045   10         CONTINUE
47046              IF (MOD(M, 2) .EQ. 0) THEN
47047                 CALL KTRADE(X, M, WS1, SIZE1, WS3, K)
47048                 CALL KTRADE(Y, N, WS2, SIZE2, WS3, K)
47049                 TOTAL = TOTAL + TRADES(WS1, SIZE1, WS2, SIZE2)
47050              END IF
47051         ELSE
47052            DO 20 K = 1, MIN(M, N)
47053               CALL KTRADE(X, M, WS1, SIZE1, WS3, K)
47054               CALL KTRADE(Y, N, WS2, SIZE2, WS3, K)
47055               TOTAL = TOTAL + TRADES(WS1, SIZE1, WS2, SIZE2)
47056   20       CONTINUE
47057         END IF
47058CCCCC    POSSIB = COMB(M+N, M)
47059         POSSIB = BINOM(M+N, M)
47060         P = REAL(TOTAL + 1)/POSSIB
47061      END IF
47062C
47063      RETURN
47064      END
47065      SUBROUTINE FLCDF(X,GAMMA,CDF)
47066C
47067C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
47068C              FUNCTION VALUE FOR THE FATIGUE LIFE DISTRIBUTION
47069C              WITH SHAPE PARAMETER = GAMMA
47070C              AND LOCATION PARAMETER = 1.
47071C              THE FATIGUE LIFE DISTRIBUTION IS "HALF WAY BETWEEN"
47072C              THE INVERSE GAUSSIAN DISTRIBUTION AND
47073C              THE RECIPROCAL INVERSE GAUSSIAN DISTRIBUTION.
47074C     NOTE--THE FATIGUE LIFE DISTRIBUTION HAS--
47075C              FLPDF(X,GAMMA) = (IGPDF(X,GAMMA)+RIGPDF(X,GAMMA)) / 2
47076C                             = ((1+X)/2)*IGPDF(X,GAMMA)
47077C              FLCDF(X,GAMMA) = (IGCDF(X,GAMMA)+RIGCDF(X,GAMMA)) / 2
47078C                             = NORCDF((1/GAMMA)*(SQRT(X)-SQRT(1/X)))
47079C              FLPPF(P,GAMMA) = (SEE FLPPF.FOR)
47080C     NOTE--THE FATIGUE LIFE DISTRIBUTION--
47081C              GOES FROM 0 TO INFINITY
47082C              HAS MEAN = MU = 1
47083C              HAS STANDARD DEVIATION = MU*GAMMA*SQRT(1+(5/4)*GAMMA**2)
47084C              HAS SHAPE PARAMETER = GAMMA
47085C              IS NEAR-SYMMETRIC AND MODERATE-TAILED FOR SMALL GAMMA
47086C              IS HIGHLY-SKEWED AND LONG-TAILED FOR LARGE GAMMA
47087C              APPROACHES NORMALITY AS GAMMA APPROACHES 0
47088C     NOTE--TO OBTAIN THE PPF FOR GENERAL MU,
47089C           COMPUTE THE PPF FOR X AROUND 1, AND THEN
47090C           SIMPLY SCALE UP THE HORIZONTAL AXIS X BY THE DESIRED MU
47091C           AS IN Y2 = MU*Y
47092C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
47093C                                WHICH THE CUMULATIVE DISTRIBUTION
47094C                                FUNCTION IS TO BE EVALUATED.
47095C                                X SHOULD BE POSITIVE.
47096C                     --GAMMA  = THE SHAPE PARAMETER
47097C                                GAMMA SHOULD BE POSITIVE.
47098C                                (ALSO = COEF. OF VARIATION)
47099C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
47100C                                DISTRIBUTION FUNCTION VALUE.
47101C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
47102C             FUNCTION VALUE CDF FOR THE FATIGUE LIFE DISTRIBUTION
47103C             WITH TAIL LENGTH PARAMETER = GAMMA
47104C             AND WITH SCALE PARAMETER = 1
47105C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
47106C     RESTRICTIONS--X SHOULD BE POSITIVE.
47107C                 --GAMMA SHOULD BE POSITIVE.
47108C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
47109C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
47110C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
47111C     LANGUAGE--ANSI FORTRAN (1977)
47112C     REFERENCES--SAM SAUNDERS TALK, MAY 1990
47113C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
47114C                 DISTRIBUTIONS--1, 1970, PAGES
47115C     WRITTEN BY--JAMES J. FILLIBEN
47116C                 STATISTICAL ENGINEERING DIVISION
47117C                 INFORMATION TECHNOLOGY LABORATORY
47118C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47119C                 GAITHERSBURG, MD 20899
47120C                 PHONE--301-975-2855
47121C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47122C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47123C     LANGUAGE--ANSI FORTRAN (1977)
47124C     VERSION NUMBER--90.6
47125C     ORIGINAL VERSION--MAY       1990.
47126C     UPDATED         --JUNE      1999. REVERT TO NORCDF VERSION.
47127C                                       OTHER CODE PRODUCED NONSENSE.
47128C
47129C---------------------------------------------------------------------
47130C
47131      DOUBLE PRECISION DCDF
47132      DOUBLE PRECISION DX
47133      DOUBLE PRECISION DGAMMA
47134      DOUBLE PRECISION DTERM1
47135C
47136      INCLUDE 'DPCOP2.INC'
47137C
47138C-----START POINT-----------------------------------------------------
47139C
47140C     CHECK THE INPUT ARGUMENTS FOR ERRORS
47141C
47142      CDF=0.0
47143      IF(GAMMA.LE.0)THEN
47144        WRITE(ICOUT,51)
47145   51   FORMAT('***** ERROR--THE SECOND ARGUMENT TO FLCDF IS ',
47146     1         'NON-POSITIVE')
47147        CALL DPWRST('XXX','BUG ')
47148        WRITE(ICOUT,52)GAMMA
47149   52   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
47150        CALL DPWRST('XXX','BUG ')
47151        GOTO9000
47152      ELSEIF(X.LT.0.0)THEN
47153        WRITE(ICOUT,56)
47154   56   FORMAT('***** ERROR--THE FIRST  ARGUMENT TO FLCDF IS ',
47155     1         'NON-POSITIVE')
47156        CALL DPWRST('XXX','BUG ')
47157        WRITE(ICOUT,52)X
47158        CALL DPWRST('XXX','BUG ')
47159        GOTO9000
47160      ENDIF
47161C
47162      IF(X.EQ.0.0)THEN
47163        CDF=0.0
47164      ELSE
47165CCCCC   CALL IGCDF(X,GAMMA,CDF1)
47166CCCCC   CALL RIGCDF(X,GAMMA,CDF2)
47167CCCCC   CDF=(CDF1+CDF2)/2.0
47168        DX=DBLE(X)
47169        DGAMMA=DBLE(GAMMA)
47170        DTERM1=(DSQRT(DX)-DSQRT(1.0D0/DX))/DGAMMA
47171        CALL NODCDF(DTERM1,DCDF)
47172        CDF=REAL(DCDF)
47173      ENDIF
47174C
47175 9000 CONTINUE
47176      RETURN
47177      END
47178      SUBROUTINE FLCHA(X,GAMMA,HAZ)
47179C
47180C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE HAZARD
47181C              FUNCTION VALUE FOR THE FATIGUE LIFE DISTRIBUTION
47182C              WITH SHAPE PARAMETER = GAMMA
47183C              AND LOCATION PARAMETER = 1.
47184C              THE FATIGUE LIFE DISTRIBUTION IS "HALF WAY BETWEEN"
47185C              THE INVERSE GAUSSIAN DISTRIBUTION AND
47186C              THE RECIPROCAL INVERSE GAUSSIAN DISTRIBUTION.
47187C     NOTE--THE FATIGUE LIFE DISTRIBUTION HAS--
47188C              FLPDF(X,GAMMA) = (IGPDF(X,GAMMA)+RIGPDF(X,GAMMA)) / 2
47189C                             = ((1+X)/2)*IGPDF(X,GAMMA)
47190C              FLCDF(X,GAMMA) = (IGCDF(X,GAMMA)+RIGCDF(X,GAMMA)) / 2
47191C                             = NORCDF((1/GAMMA)*(SQRT(X)-SQRT(1/X)))
47192C              FLPPF(P,GAMMA) = (SEE FLPPF.FOR)
47193C     NOTE--THE FATIGUE LIFE DISTRIBUTION--
47194C              GOES FROM 0 TO INFINITY
47195C              HAS MEAN = MU = 1
47196C              HAS STANDARD DEVIATION = MU*GAMMA*SQRT(1+(5/4)*GAMMA**2)
47197C              HAS SHAPE PARAMETER = GAMMA
47198C              IS NEAR-SYMMETRIC AND MODERATE-TAILED FOR SMALL GAMMA
47199C              IS HIGHLY-SKEWED AND LONG-TAILED FOR LARGE GAMMA
47200C              APPROACHES NORMALITY AS GAMMA APPROACHES 0
47201C     NOTE--TO OBTAIN THE PPF FOR GENERAL MU,
47202C           COMPUTE THE PPF FOR X AROUND 1, AND THEN
47203C           SIMPLY SCALE UP THE HORIZONTAL AXIS X BY THE DESIRED MU
47204C           AS IN Y2 = MU*Y
47205C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
47206C                                WHICH THE CUMULATIVE HAZARD
47207C                                FUNCTION IS TO BE EVALUATED.
47208C                                X SHOULD BE POSITIVE.
47209C                     --GAMMA  = THE SHAPE PARAMETER
47210C                                GAMMA SHOULD BE POSITIVE.
47211C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION CUMULATIVE HAZARD
47212C                                FUNCTION VALUE.
47213C     OUTPUT--THE SINGLE PRECISION CUMULATIVE HAZARD
47214C             FUNCTION VALUE FOR THE FATIGUE LIFE DISTRIBUTION
47215C             WITH TAIL LENGTH PARAMETER = GAMMA
47216C             AND WITH LOCATION PARAMETER = 1
47217C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
47218C     RESTRICTIONS--X SHOULD BE POSITIVE.
47219C                 --GAMMA SHOULD BE POSITIVE.
47220C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
47221C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
47222C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
47223C     LANGUAGE--ANSI FORTRAN (1977)
47224C     REFERENCES--SAM SAUNDERS TALK, MAY 1990
47225C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
47226C                 DISTRIBUTIONS--1, 1970, PAGES
47227C     WRITTEN BY--JAMES J. FILLIBEN
47228C                 STATISTICAL ENGINEERING DIVISION
47229C                 INFORMATION TECHNOLOGY LABORATORY
47230C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47231C                 GAITHERSBURG, MD 20899
47232C                 PHONE--301-975-2855
47233C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47234C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47235C     LANGUAGE--ANSI FORTRAN (1977)
47236C     VERSION NUMBER--98.4
47237C     ORIGINAL VERSION--APRIL     1998.
47238C     UPDATED         --JULY      1999.
47239C
47240C---------------------------------------------------------------------
47241C
47242      DOUBLE PRECISION DCDF
47243      DOUBLE PRECISION DX
47244      DOUBLE PRECISION DGAMMA
47245      DOUBLE PRECISION DTERM1
47246C
47247      INCLUDE 'DPCOP2.INC'
47248C
47249C-----START POINT-----------------------------------------------------
47250C
47251C     CHECK THE INPUT ARGUMENTS FOR ERRORS
47252C
47253      IF(GAMMA.LE.0)GOTO50
47254      IF(X.LT.0.0)GOTO55
47255      GOTO90
47256   50 CONTINUE
47257      WRITE(ICOUT,51)
47258   51 FORMAT('***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ',
47259     1'ARGUMENT TO THE FLCHA SUBROUTINE IS NON-POSITIVE *****')
47260      CALL DPWRST('XXX','BUG ')
47261      WRITE(ICOUT,52)GAMMA
47262   52 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',
47263     1E15.8,' *****')
47264      CALL DPWRST('XXX','BUG ')
47265      HAZ=0.0
47266      GOTO9000
47267   55 CONTINUE
47268      WRITE(ICOUT,56)
47269   56 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ',
47270     1'ARGUMENT TO THE FLCHA SUBROUTINE IS NON-POSITIVE *****')
47271      CALL DPWRST('XXX','BUG ')
47272      WRITE(ICOUT,57)X
47273   57 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',
47274     1E15.8,' *****')
47275      CALL DPWRST('XXX','BUG ')
47276      HAZ=0.0
47277      GOTO9000
47278   90 CONTINUE
47279C
47280      IF(X.EQ.0.0)THEN
47281        HAZ=0.0
47282      ELSEIF(X.GT.0.0)THEN
47283CCCCC    CALL FLCDF(X,GAMMA,CDF)
47284         DX=DBLE(X)
47285         DGAMMA=DBLE(GAMMA)
47286         DTERM1=(DSQRT(DX)-DSQRT(1.0D0/DX))/DGAMMA
47287         CALL NODCDF(DTERM1,DCDF)
47288         DCDF=1.0D0-DCDF
47289         IF(DCDF.GT.0.0D0)THEN
47290           HAZ=REAL(-DLOG(DCDF))
47291         ELSE
47292           WRITE(ICOUT,162)X
47293  162    FORMAT('***** FOR THE VALUE OF THE ARGUMENT ',
47294     1   E15.8,' THE CDF IS ESSENTIALLY 1, HAZARD SET TO 0.')
47295         CALL DPWRST('XXX','BUG ')
47296         HAZ=0.0
47297         ENDIF
47298      ENDIF
47299C
47300 9000 CONTINUE
47301      RETURN
47302      END
47303      SUBROUTINE FLHAZ(X,GAMMA,HAZ)
47304C
47305C     PURPOSE--THIS SUBROUTINE COMPUTES THE HAZARD
47306C              FUNCTION VALUE FOR THE FATIGUE LIFE DISTRIBUTION
47307C              WITH SHAPE PARAMETER = GAMMA
47308C              AND LOCATION PARAMETER = 1.
47309C              THE FATIGUE LIFE DISTRIBUTION IS "HALF WAY BETWEEN"
47310C              THE INVERSE GAUSSIAN DISTRIBUTION AND
47311C              THE RECIPROCAL INVERSE GAUSSIAN DISTRIBUTION.
47312C     NOTE--THE FATIGUE LIFE DISTRIBUTION HAS--
47313C              FLPDF(X,GAMMA) = (IGPDF(X,GAMMA)+RIGPDF(X,GAMMA)) / 2
47314C                             = ((1+X)/2)*IGPDF(X,GAMMA)
47315C              FLCDF(X,GAMMA) = (IGCDF(X,GAMMA)+RIGCDF(X,GAMMA)) / 2
47316C                             = NORCDF((1/GAMMA)*(SQRT(X)-SQRT(1/X)))
47317C              FLPPF(P,GAMMA) = (SEE FLPPF.FOR)
47318C     NOTE--THE FATIGUE LIFE DISTRIBUTION--
47319C              GOES FROM 0 TO INFINITY
47320C              HAS MEAN = MU = 1
47321C              HAS STANDARD DEVIATION = MU*GAMMA*SQRT(1+(5/4)*GAMMA**2)
47322C              HAS SHAPE PARAMETER = GAMMA
47323C              IS NEAR-SYMMETRIC AND MODERATE-TAILED FOR SMALL GAMMA
47324C              IS HIGHLY-SKEWED AND LONG-TAILED FOR LARGE GAMMA
47325C              APPROACHES NORMALITY AS GAMMA APPROACHES 0
47326C     NOTE--TO OBTAIN THE PPF FOR GENERAL MU,
47327C           COMPUTE THE PPF FOR X AROUND 1, AND THEN
47328C           SIMPLY SCALE UP THE HORIZONTAL AXIS X BY THE DESIRED MU
47329C           AS IN Y2 = MU*Y
47330C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
47331C                                WHICH THE PROBABILITY DENSITY
47332C                                FUNCTION IS TO BE EVALUATED.
47333C                                X SHOULD BE POSITIVE.
47334C                     --GAMMA  = THE SHAPE PARAMETER
47335C                                GAMMA SHOULD BE POSITIVE.
47336C                                (ALSO = COEF. OF VARIATION)
47337C     OUTPUT ARGUMENTS--HAZ    = THE SINGLE PRECISION HAZARD
47338C                                FUNCTION VALUE.
47339C     OUTPUT--THE SINGLE PRECISION HAZARD
47340C             FUNCTION VALUE FOR THE FATIGUE LIFE DISTRIBUTION
47341C             WITH TAIL LENGTH PARAMETER = GAMMA
47342C             AND WITH LOCATION PARAMETER = 1
47343C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
47344C     RESTRICTIONS--X SHOULD BE POSITIVE.
47345C                 --GAMMA SHOULD BE POSITIVE.
47346C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
47347C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
47348C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
47349C     LANGUAGE--ANSI FORTRAN (1977)
47350C     REFERENCES--SAM SAUNDERS TALK, MAY 1990
47351C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
47352C                 DISTRIBUTIONS--1, 1970, PAGES
47353C     WRITTEN BY--JAMES J. FILLIBEN
47354C                 STATISTICAL ENGINEERING DIVISION
47355C                 INFORMATION TECHNOLOGY LABORATORY
47356C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47357C                 GAITHERSBURG, MD 20899
47358C                 PHONE--301-975-2855
47359C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47360C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47361C     LANGUAGE--ANSI FORTRAN (1977)
47362C     VERSION NUMBER--98.4
47363C     ORIGINAL VERSION--APRIL     1998.
47364C
47365C---------------------------------------------------------------------
47366C
47367      DOUBLE PRECISION DCDF
47368      DOUBLE PRECISION DX
47369      DOUBLE PRECISION DGAMMA
47370      DOUBLE PRECISION DTERM1
47371      DOUBLE PRECISION DTERM2
47372      DOUBLE PRECISION DTERM3
47373      DOUBLE PRECISION DTERM4
47374      DOUBLE PRECISION DPDF
47375C
47376      INCLUDE 'DPCOP2.INC'
47377C
47378C-----START POINT-----------------------------------------------------
47379C
47380C     CHECK THE INPUT ARGUMENTS FOR ERRORS
47381C
47382      IF(GAMMA.LE.0)GOTO50
47383      IF(X.LT.0.0)GOTO55
47384      GOTO90
47385   50 CONTINUE
47386      WRITE(ICOUT,51)
47387   51 FORMAT('***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ',
47388     1'ARGUMENT TO THE FLHAZ SUBROUTINE IS NON-POSITIVE *****')
47389      CALL DPWRST('XXX','BUG ')
47390      WRITE(ICOUT,52)GAMMA
47391   52 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',
47392     1E15.8,' *****')
47393      CALL DPWRST('XXX','BUG ')
47394      HAZ=0.0
47395      GOTO9000
47396   55 CONTINUE
47397      WRITE(ICOUT,56)
47398   56 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ',
47399     1'ARGUMENT TO THE FLHAZ SUBROUTINE IS NON-POSITIVE *****')
47400      CALL DPWRST('XXX','BUG ')
47401      WRITE(ICOUT,57)X
47402   57 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',
47403     1E15.8,' *****')
47404      CALL DPWRST('XXX','BUG ')
47405      HAZ=0.0
47406      GOTO9000
47407   90 CONTINUE
47408C
47409      IF(X.EQ.0.0)THEN
47410        HAZ=0.0
47411      ELSEIF(X.GT.0.0)THEN
47412CCCCC    CALL FLCDF(X,GAMMA,CDF)
47413CCCCC    CDF=1.0-CDF
47414         DX=DBLE(X)
47415         DGAMMA=DBLE(GAMMA)
47416         DTERM1=(DSQRT(DX)-DSQRT(1.0D0/DX))/DGAMMA
47417         CALL NODCDF(DTERM1,DCDF)
47418         DCDF=1.0D0-DCDF
47419         IF(DCDF.GT.0.0D0)THEN
47420CCCCC      CALL FLPDF(X,GAMMA,PDF)
47421           DTERM1=DLOG(DSQRT(DX)+DSQRT(1.0D0/DX))
47422           DTERM2=DLOG(2.0D0*DX*DGAMMA)
47423           DTERM3=(DSQRT(DX)-DSQRT(1.0D0/DX))/DGAMMA
47424           CALL NODPDF(DTERM3,DTERM4)
47425           IF(DTERM4.LE.0.0D0)THEN
47426             DPDF=0.0D0
47427           ELSE
47428             DTERM4=DLOG(DTERM4)
47429             DPDF=DEXP(DTERM1-DTERM2+DTERM4)
47430           ENDIF
47431           HAZ=REAL(DPDF/DCDF)
47432         ELSE
47433           WRITE(ICOUT,162)X
47434  162    FORMAT('***** FOR THE VALUE OF THE ARGUMENT ',
47435     1   E15.8,' THE CDF IS ESSENTIALLY 1, HAZARD SET TO 0.')
47436         CALL DPWRST('XXX','BUG ')
47437         HAZ=0.0
47438         ENDIF
47439      ENDIF
47440C
47441 9000 CONTINUE
47442      RETURN
47443      END
47444      SUBROUTINE FLFUN (N, X, FVEC, IFLAG, XDATA, NOBS)
47445C
47446C     PURPOSE--THIS ROUTINE COMPUTES THE FUNCTIONS FOR THE
47447C              FATIGUE LIFE MAXIMUM LIKELIHOOD EQUATIONS.
47448C
47449C              THE MAXIMUM LIKELIHOOD ESTIMATE OF BETA IS THE
47450C              POSITIVE ROOT OF:
47451C
47452C                 BHAT**2 - BHAT*{2*H+K(BHAT)} + H*{TBAR+K(BHAT)}=0
47453C
47454C              WITH
47455C
47456C                  H=1/[N*SUM[i=1 to N][1/X(i)]
47457C                  TBAR = SUM[i=1 to N][X(i)]/N
47458C                  K(BHAT) = 1/[N*SUM[i=1 to N][1/(BHAT+X(i))]
47459C
47460C              AND
47461C
47462C                  AHAT = 2*SQRT[0.5*(TBAR/BHAT + BHAT/H) - 1]
47463C
47464C              FLFUN IS CALLED BY DNSQE ROUTINE FOR SOLVING
47465C              SIMULTANEOUS NONLINEAR EQUATIONS.  NOTE THAT THE
47466C              CALLING SEQUENCE DID NOT ACCOMODATE A DATA ARRAY
47467C              (AND ASSCIATED NUMBER OF OBSERVATIONS), SO THESE WERE
47468C              ADDED TO THE CALL LIST.
47469C     EXAMPLE--FATIGUE LIFE MAXIMUM LIKELIHOOD Y
47470C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN (1994).  "CONTINUOUS
47471C                UNIVARIATE DISTRIBUTIONS: VOLUME 2", SECOND EDITION,
47472C                JOHN WILEY, PP.  651-658.
47473C     WRITTEN BY--JAMES J. FILLIBEN
47474C                 STATISTICAL ENGINEERING DIVISION
47475C                 INFORMATION TECHNOLOGY LABORATORY
47476C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47477C                 GAITHERSBUG, MD 20899-8980
47478C                 PHONE--301-975-2855
47479C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47480C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47481C     LANGUAGE--ANSI FORTRAN (1977)
47482C     VERSION NUMBER--2004/3
47483C     ORIGINAL VERSION--MARCH     2004.
47484C
47485C---------------------------------------------------------------------
47486C
47487      DOUBLE PRECISION X(*)
47488      DOUBLE PRECISION FVEC(*)
47489      REAL XDATA(*)
47490C
47491      DOUBLE PRECISION DN
47492      DOUBLE PRECISION DX
47493      DOUBLE PRECISION DBETA
47494      DOUBLE PRECISION DSUM1
47495      DOUBLE PRECISION DSUM2
47496      DOUBLE PRECISION DSUM3
47497      DOUBLE PRECISION TBAR
47498      DOUBLE PRECISION H
47499      DOUBLE PRECISION DK
47500C
47501C-----COMMON----------------------------------------------------------
47502C
47503      INCLUDE 'DPCOP2.INC'
47504C
47505C-----START POINT-----------------------------------------------------
47506C
47507C  COMPUTE SOME SUMS
47508C
47509      N=1
47510      IFLAG=0
47511C
47512      DBETA=X(1)
47513      DN=DBLE(NOBS)
47514C
47515      DSUM1=0.0D0
47516      DSUM2=0.0D0
47517      DSUM3=0.0D0
47518C
47519      DO200I=1,NOBS
47520        DX=DBLE(XDATA(I))
47521        DSUM1=DSUM1 + DX
47522        DSUM2=DSUM2 + 1.0D0/DX
47523        DSUM3=DSUM3 + 1.0D0/(DX + DBETA)
47524  200 CONTINUE
47525      TBAR=DSUM1/DN
47526      H=DN/DSUM2
47527      DK=DN/DSUM3
47528      FVEC(1)=DBETA**2 - DBETA*(2.0D0*H + DK) + H*(TBAR+DK)
47529C
47530      RETURN
47531      END
47532      SUBROUTINE FLML1(Y,N,MAXNXT,
47533     1                  TEMP1,DTEMP1,
47534     1                  XMEAN,XSD,XVAR,XMIN,XMAX,
47535     1                  SCALML,SHAPML,SCALMO,SHAPMO,
47536     1                  ISUBRO,IBUGA3,IERROR)
47537C
47538C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
47539C              FOR THE 2-PARAMETER FATIGUE LIFE DISTRIBUTION FOR THE
47540C              RAW DATA CASE (I.E., NO CENSORING AND NO GROUPING).  THIS
47541C              ROUTINE RETURNS ONLY THE POINT ESTIMATES (CONFIDENCE
47542C              INTERVALS WILL BE COMPUTED IN A SEPARATE ROUTINE).
47543C
47544C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
47545C              PERFORMED.
47546C
47547C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
47548C              FROM MULTIPLE PLACES (DPMLFL WILL GENERATE THE OUTPUT
47549C              FOR THE FATIGUE LIFE MLE COMMAND).
47550C
47551C     REFERENCE--JOHNSON, KOTZ, AND BALAKRISHNAN.  "CONTINUOUS
47552C                UNIVARIATE DISTRIBUTIONS, VOLUME I", SECOND
47553C                EDITION, WILEY, 1994, PP. 614-619.
47554C     WRITTEN BY--JAMES J. FILLIBEN
47555C                 STATISTICAL ENGINEERING DIVISION
47556C                 INFORMATION TECHNOLOGY LABORATORY
47557C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47558C                 GAITHERSBURG, MD 20899-8980
47559C                 PHONE--301-975-2855
47560C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47561C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47562C     LANGUAGE--ANSI FORTRAN (1977)
47563C     VERSION NUMBER--2010/2
47564C     ORIGINAL VERSION--FEBRUARY  2010. EXTRACTED AS A SEPARATE
47565C                                       SUBROUTINE (FROM DPMLE1)
47566C
47567C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
47568C
47569      DIMENSION Y(*)
47570      DIMENSION TEMP1(*)
47571      DOUBLE PRECISION DTEMP1(*)
47572C
47573      DOUBLE PRECISION DGAMM1
47574      DOUBLE PRECISION DALPHA
47575      DOUBLE PRECISION DALPH2
47576      DOUBLE PRECISION DSUM1
47577      DOUBLE PRECISION DSUM2
47578      DOUBLE PRECISION DSUM3
47579      DOUBLE PRECISION DSUM4
47580      DOUBLE PRECISION DX
47581      DOUBLE PRECISION DN
47582      DOUBLE PRECISION TBAR
47583      DOUBLE PRECISION H
47584      DOUBLE PRECISION DK
47585      DOUBLE PRECISION TOL
47586      DOUBLE PRECISION XPAR(1)
47587      DOUBLE PRECISION FVEC(1)
47588C
47589      EXTERNAL FLFUN
47590C
47591      CHARACTER*4 ISUBRO
47592      CHARACTER*4 IBUGA3
47593      CHARACTER*4 IERROR
47594C
47595      CHARACTER*4 IWRITE
47596      CHARACTER*40 IDIST
47597C
47598      CHARACTER*4 ISUBN1
47599      CHARACTER*4 ISUBN2
47600      CHARACTER*4 ISTEPN
47601C
47602C-----COMMON----------------------------------------------------------
47603C
47604      INCLUDE 'DPCOP2.INC'
47605C
47606C-----START POINT-----------------------------------------------------
47607C
47608      ISUBN1='FLML'
47609      ISUBN2='1   '
47610      IERROR='NO'
47611      IWRITE='NO'
47612C
47613      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LML1')THEN
47614        WRITE(ICOUT,999)
47615  999   FORMAT(1X)
47616        CALL DPWRST('XXX','WRIT')
47617        WRITE(ICOUT,51)
47618   51   FORMAT('**** AT THE BEGINNING OF FLML1--')
47619        CALL DPWRST('XXX','WRIT')
47620        WRITE(ICOUT,52)IBUGA3,ISUBRO
47621   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
47622        CALL DPWRST('XXX','WRIT')
47623        DO56I=1,MIN(N,100)
47624          WRITE(ICOUT,57)I,Y(I),TEMP1(I)
47625   57     FORMAT('I,Y(I),TEMP1(I) = ',I8,2G15.7)
47626          CALL DPWRST('XXX','WRIT')
47627   56   CONTINUE
47628      ENDIF
47629C
47630C               ********************************************
47631C               **  STEP 1--                              **
47632C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
47633C               ********************************************
47634C
47635      ISTEPN='1'
47636      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LML1')
47637     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47638C
47639C               *******************************************
47640C               **  STEP 2--                             **
47641C               **  CARRY OUT CALCULATIONS               **
47642C               **  FOR FATIGUE LIFE MLE ESTIMATE        **
47643C               *******************************************
47644C
47645      ISTEPN='2'
47646      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LML1')
47647     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
47648C
47649      IDIST='FATIGUE LIFE'
47650C
47651      IFLAG=2
47652      CALL SUMRAW(Y,N,IDIST,IFLAG,
47653     1            XMEAN,XVAR,XSD,XMIN,XMAX,
47654     1            ISUBRO,IBUGA3,IERROR)
47655C
47656      SHAPML=CPUMIN
47657      SCALML=CPUMIN
47658      SHAPMO=CPUMIN
47659      SCALMO=CPUMIN
47660C
47661      DN=DBLE(N)
47662      DSUM1=0.0D0
47663      DSUM2=0.0D0
47664      DSUM3=0.0D0
47665      DSUM4=0.0D0
47666      DO2110I=1,N
47667        DX=DBLE(Y(I))
47668        DSUM1=DSUM1 + DSQRT(DX)
47669        DSUM2=DSUM2 + 1.0D0/DSQRT(DX)
47670        DSUM3=DSUM3 + DX
47671        DSUM4=DSUM4 + 1.0D0/DX
47672 2110 CONTINUE
47673      DGAMM1=DSUM1/DSUM2
47674      XPAR(1)=DSQRT(DSUM3/DSUM4)
47675C
47676      DSUM1=0.0D0
47677      DO2120I=1,N
47678        DX=DBLE(Y(I))
47679        DSUM1=DSUM1 + (DSQRT(DX/DGAMM1) - DSQRT(DGAMM1/DX))**2
47680 2120 CONTINUE
47681      DALPHA=DSQRT(DSUM1/DN)
47682      SCALMO=REAL(DGAMM1)
47683      SHAPMO=REAL(DALPHA)
47684C
47685      XPAR(1)=DGAMM1
47686C
47687      IOPT=2
47688      TOL=1.0D-6
47689      NVAR=1
47690      NPRINT=-1
47691      INFO=0
47692      LWA=MAXNXT
47693      CALL DNSQE(FLFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
47694     1           DTEMP1,MAXNXT,Y,N)
47695C
47696      DSUM1=0.0D0
47697      DSUM2=0.0D0
47698      DSUM3=0.0D0
47699C
47700      DO200I=1,N
47701        DX=DBLE(Y(I))
47702        DSUM1=DSUM1 + DX
47703        DSUM2=DSUM2 + 1.0D0/DX
47704        DSUM3=DSUM3 + 1.0D0/(DX + XPAR(1))
47705  200 CONTINUE
47706      TBAR=DSUM1/DN
47707      H=DN/DSUM2
47708      DK=DN/DSUM3
47709      DALPH2=2.0D0*DSQRT(0.5D0*((TBAR/XPAR(1)) + XPAR(1)/H) - 1.0D0)
47710      SCALML=REAL(XPAR(1))
47711      SHAPML=REAL(DALPH2)
47712C
47713      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LML1')THEN
47714        WRITE(ICOUT,999)
47715        CALL DPWRST('XXX','WRIT')
47716        WRITE(ICOUT,9011)
47717 9011   FORMAT('**** AT THE END OF FLML1--')
47718        CALL DPWRST('XXX','WRIT')
47719        WRITE(ICOUT,9013)N,XMEAN,XSD,XMIN,XMAX
47720 9013   FORMAT('N,XMEAN,XSD,XMIN,XMAX = ',I8,4G15.7)
47721        CALL DPWRST('XXX','WRIT')
47722        WRITE(ICOUT,9017)SHAPML,SCALML,SHAPMO,SCALMO
47723 9017   FORMAT('SHAPML,SCALML,SHAPMO,SCALMO =  ',4G15.7)
47724        CALL DPWRST('XXX','WRIT')
47725      ENDIF
47726C
47727      RETURN
47728      END
47729      SUBROUTINE FLPDF(X,GAMMA,PDF)
47730C
47731C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
47732C              FUNCTION VALUE FOR THE FATIGUE LIFE DISTRIBUTION
47733C              WITH SHAPE PARAMETER = GAMMA
47734C              AND LOCATION PARAMETER = 1.
47735C              THE FATIGUE LIFE DISTRIBUTION IS "HALF WAY BETWEEN"
47736C              THE INVERSE GAUSSIAN DISTRIBUTION AND
47737C              THE RECIPROCAL INVERSE GAUSSIAN DISTRIBUTION.
47738C     NOTE--THE FATIGUE LIFE DISTRIBUTION HAS--
47739C              FLPDF(X,GAMMA) = (IGPDF(X,GAMMA)+RIGPDF(X,GAMMA)) / 2
47740C                             = ((1+X)/2)*IGPDF(X,GAMMA)
47741C              FLCDF(X,GAMMA) = (IGCDF(X,GAMMA)+RIGCDF(X,GAMMA)) / 2
47742C                             = NORCDF((1/GAMMA)*(SQRT(X)-SQRT(1/X)))
47743C              FLPPF(P,GAMMA) = (SEE FLPPF.FOR)
47744C     NOTE--THE FATIGUE LIFE DISTRIBUTION--
47745C              GOES FROM 0 TO INFINITY
47746C              HAS MEAN = MU = 1
47747C              HAS STANDARD DEVIATION = MU*GAMMA*SQRT(1+(5/4)*GAMMA**2)
47748C              HAS SHAPE PARAMETER = GAMMA
47749C              IS NEAR-SYMMETRIC AND MODERATE-TAILED FOR SMALL GAMMA
47750C              IS HIGHLY-SKEWED AND LONG-TAILED FOR LARGE GAMMA
47751C              APPROACHES NORMALITY AS GAMMA APPROACHES 0
47752C     NOTE--TO OBTAIN THE PPF FOR GENERAL MU,
47753C           COMPUTE THE PPF FOR X AROUND 1, AND THEN
47754C           SIMPLY SCALE UP THE HORIZONTAL AXIS X BY THE DESIRED MU
47755C           AS IN Y2 = MU*Y
47756C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
47757C                                WHICH THE PROBABILITY DENSITY
47758C                                FUNCTION IS TO BE EVALUATED.
47759C                                X SHOULD BE POSITIVE.
47760C                     --GAMMA  = THE SHAPE PARAMETER
47761C                                GAMMA SHOULD BE POSITIVE.
47762C                                (ALSO = COEF. OF VARIATION)
47763C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
47764C                                DENSITY FUNCTION VALUE.
47765C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
47766C             FUNCTION VALUE PDF FOR THE FATIGUE LIFE DISTRIBUTION
47767C             WITH TAIL LENGTH PARAMETER = GAMMA
47768C             AND WITH SCALE PARAMETER = 1
47769C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
47770C     RESTRICTIONS--X SHOULD BE POSITIVE.
47771C                 --GAMMA SHOULD BE POSITIVE.
47772C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
47773C     FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
47774C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
47775C     LANGUAGE--ANSI FORTRAN (1977)
47776C     REFERENCES--SAM SAUNDERS TALK, MAY 1990
47777C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
47778C                 DISTRIBUTIONS--1, 1970, PAGES
47779C     WRITTEN BY--JAMES J. FILLIBEN
47780C                 STATISTICAL ENGINEERING DIVISION
47781C                 INFORMATION TECHNOLOGY LABORATORY
47782C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47783C                 GAITHERSBURG, MD 20899
47784C                 PHONE--301-975-2855
47785C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47786C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47787C     LANGUAGE--ANSI FORTRAN (1977)
47788C     VERSION NUMBER--90.6
47789C     ORIGINAL VERSION--MAY       1990.
47790C     UPDATED         --JULY      1999. USE DIFFERENT FORMULA
47791C
47792C---------------------------------------------------------------------
47793C
47794      DOUBLE PRECISION DX
47795      DOUBLE PRECISION DGAMMA
47796      DOUBLE PRECISION DTERM1
47797      DOUBLE PRECISION DTERM2
47798      DOUBLE PRECISION DTERM3
47799      DOUBLE PRECISION DTERM4
47800      DOUBLE PRECISION DPDF
47801C
47802C-----COMMON----------------------------------------------------------
47803C
47804      INCLUDE 'DPCOP2.INC'
47805C
47806C-----START POINT-----------------------------------------------------
47807C
47808C     CHECK THE INPUT ARGUMENTS FOR ERRORS
47809C
47810      IF(GAMMA.LE.0)GOTO50
47811      IF(X.LT.0.0)GOTO55
47812      GOTO90
47813   50 CONTINUE
47814      WRITE(ICOUT,51)
47815   51 FORMAT('***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ',
47816     1'ARGUMENT TO THE WFPDF SUBROUTINE IS NON-POSITIVE *****')
47817      CALL DPWRST('XXX','BUG ')
47818      WRITE(ICOUT,52)GAMMA
47819   52 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',
47820     1E15.8,' *****')
47821      CALL DPWRST('XXX','BUG ')
47822      PDF=0.0
47823      GOTO9000
47824   55 CONTINUE
47825      WRITE(ICOUT,56)
47826   56 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ',
47827     1'ARGUMENT TO THE WFPDF SUBROUTINE IS NON-POSITIVE *****')
47828      CALL DPWRST('XXX','BUG ')
47829      WRITE(ICOUT,57)X
47830   57 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',
47831     1E15.8,' *****')
47832      CALL DPWRST('XXX','BUG ')
47833      PDF=0.0
47834      GOTO9000
47835   90 CONTINUE
47836C
47837      IF(X.EQ.0.0)GOTO1100
47838      GOTO1200
47839C
47840 1100 CONTINUE
47841      PDF=0.0
47842      GOTO9000
47843C
47844 1200 CONTINUE
47845C
47846CCCCC JULY 1999.  USE DIFFERENT FORMULA
47847CCCCC CALL IGPDF(X,GAMMA,PDF1)
47848CCCCC CALL RIGPDF(X,GAMMA,PDF2)
47849C
47850      DX=DBLE(X)
47851      DGAMMA=DBLE(GAMMA)
47852      DTERM1=DLOG(DSQRT(DX)+DSQRT(1.0D0/DX))
47853      DTERM2=DLOG(2.0D0*DX*DGAMMA)
47854      DTERM3=(DSQRT(DX)-DSQRT(1.0D0/DX))/DGAMMA
47855      CALL NODPDF(DTERM3,DTERM4)
47856      IF(DTERM4.LE.0.0D0)THEN
47857        PDF=0.0
47858        GOTO9000
47859      ENDIF
47860      DTERM4=DLOG(DTERM4)
47861      DPDF=DEXP(DTERM1-DTERM2+DTERM4)
47862      PDF=REAL(DPDF)
47863CCCCC PDF=(PDF1+PDF2)/2.0
47864CCCCC ARG1=(X**0.5+X**1.5)/(2.0*GAMMA)
47865CCCCC ARG2=(1.0/GAMMA)
47866CCCCC ARG3=SQRT(X)-1.0/SQRT(X)
47867CCCCC ARG4=ARG2*ARG3
47868CCCCC CALL NORPDF(ARG4,PDFN)
47869CCCCC PDF=ARG1*PDFN
47870      GOTO9000
47871C
47872 9000 CONTINUE
47873      RETURN
47874      END
47875      SUBROUTINE FLPPF(P,GAMMA,PPF)
47876C
47877C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
47878C              FUNCTION VALUE FOR THE FATIGUE LIFE DISTRIBUTION
47879C              WITH SHAPE PARAMETER = GAMMA
47880C              AND LOCATION PARAMETER = 1.
47881C              THE FATIGUE LIFE DISTRIBUTION IS "HALF WAY BETWEEN"
47882C              THE INVERSE GAUSSIAN DISTRIBUTION AND
47883C              THE RECIPROCAL INVERSE GAUSSIAN DISTRIBUTION.
47884C     NOTE--THE FATIGUE LIFE DISTRIBUTION HAS--
47885C              FLPDF(X,GAMMA) = (IGPDF(X,GAMMA)+RIGPDF(X,GAMMA)) / 2
47886C                             = ((1+X)/2)*IGPDF(X,GAMMA)
47887C              FLCDF(X,GAMMA) = (IGCDF(X,GAMMA)+RIGCDF(X,GAMMA)) / 2
47888C                             = NORCDF((1/GAMMA)*(SQRT(X)-SQRT(1/X)))
47889C              FLPPF(P,GAMMA) = (SEE BELOW)
47890C     NOTE--THE FATIGUE LIFE DISTRIBUTION--
47891C              GOES FROM 0 TO INFINITY
47892C              HAS MEAN = MU = 1
47893C              HAS STANDARD DEVIATION = MU*GAMMA*SQRT(1+(5/4)*GAMMA**2)
47894C              HAS SHAPE PARAMETER = GAMMA
47895C              IS NEAR-SYMMETRIC AND MODERATE-TAILED FOR SMALL GAMMA
47896C              IS HIGHLY-SKEWED AND LONG-TAILED FOR LARGE GAMMA
47897C              APPROACHES NORMALITY AS GAMMA APPROACHES 0
47898C     NOTE--TO OBTAIN THE PPF FOR GENERAL MU,
47899C           COMPUTE THE PPF FOR X AROUND 1, AND THEN
47900C           SIMPLY SCALE UP THE HORIZONTAL AXIS X BY THE DESIRED MU
47901C           AS IN Y2 = MU*Y
47902C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
47903C                                (BETWEEN 0.0 AND 1.0)
47904C                                AT WHICH THE PERCENT POINT
47905C                                FUNCTION IS TO BE EVALUATED.
47906C                     --GAMMA  = THE SHAPE PARAMETER
47907C                                GAMMA SHOULD BE POSITIVE.
47908C                                (ALSO = COEF. OF VARIATION)
47909C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT POINT
47910C                                FUNCTION VALUE.
47911C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
47912C     OUTPUT--THE SINGLE PRECISION PERCENT POINT
47913C             FUNCTION VALUE PPF FOR THE INVERSE GAUSSIAN DISRIBUTION
47914C             WITH SHAPE PARAMETER GAMMA
47915C             AND SCALE PARAMETER 1
47916C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
47917C     RESTRICTIONS--P SHOULD BE BETWEEN
47918C                   0.0 (INCLUSIVELY) AND 1.0 (EXCLUSIVELY).
47919C                 --GAMMA SHOULD BE POSITIVE
47920C     OTHER DATAPAC   SUBROUTINES NEEDED--IGCDF, NORCDF
47921C     FORTRAN LIBRARY SUBROUTINES NEEDED--
47922C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
47923C     LANGUAGE--ANSI FORTRAN (1977)
47924C     REFERENCES--SAM SAUNDERS TALK, MAY 1990
47925C     REFERENCES--JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
47926C                 DISTRIBUTIONS--1, 1970, PAGES
47927C     WRITTEN BY--JAMES J. FILLIBEN
47928C                 STATISTICAL ENGINEERING DIVISION
47929C                 INFORMATION TECHNOLOGY LABORATORY
47930C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47931C                 GAITHERSBURG, MD 20899
47932C                 PHONE--301-975-2855
47933C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47934C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47935C     LANGUAGE--ANSI FORTRAN (1977)
47936C     VERSION NUMBER--90.6
47937C     ORIGINAL VERSION--MAY       1990.
47938C
47939C-----COMMON----------------------------------------------------------
47940C
47941      INCLUDE 'DPCOP2.INC'
47942C
47943C-----START POINT-----------------------------------------------------
47944C
47945C     CHECK THE INPUT ARGUMENTS FOR ERRORS
47946C
47947      IF(GAMMA.LE.0)GOTO50
47948      IF(P.LT.0.0.OR.P.GE.1.0)GOTO60
47949      GOTO90
47950   50 CONTINUE
47951      WRITE(ICOUT,51)
47952   51 FORMAT('***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ',
47953     1'ARGUMENT TO THE FLPPF SUBROUTINE IS NON-POSITIVE *****')
47954      CALL DPWRST('XXX','BUG ')
47955      WRITE(ICOUT,52)GAMMA
47956   52 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',
47957     1E15.8,' *****')
47958      CALL DPWRST('XXX','BUG ')
47959      PPF=0.0
47960      GOTO9000
47961   60 CONTINUE
47962      WRITE(ICOUT,61)
47963   61 FORMAT('***** FATAL ERROR--THE FIRST  INPUT ARGUMENT ',
47964     1'TO THE FLPPF SUBROUTINE ',
47965     1'IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****')
47966      CALL DPWRST('XXX','BUG ')
47967      WRITE(ICOUT,62)P
47968   62 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',
47969     1E15.8,' *****')
47970      CALL DPWRST('XXX','BUG ')
47971      PPF=0.0
47972      GOTO9000
47973   90 CONTINUE
47974C
47975      CALL NORPPF(P,PPFN)
47976      C=GAMMA*PPFN
47977C
47978      C2=C+SQRT(C*C+4.0)
47979CCCCC C3=C2/2.0
47980CCCCC PPF=C3**2
47981      PPF=0.25*(C2*C2)
47982C
47983 9000 CONTINUE
47984      RETURN
47985      END
47986      SUBROUTINE FLRAN(N,GAMMA,ISEED,X)
47987C
47988C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
47989C              FROM THE FATIGUE LIFE DISTRIBUTION
47990C              WITH SHAPE PARAMETER VALUE = GAMMA
47991C              AND LOCATION PARAMETER MU = 1.
47992C              THE PROTOTYPE FATIGUE LIFE DISTRIBUTION USED
47993C              HEREIN IS DEFINED FOR ALL POSITIVE X,
47994C              AND HAS THE PROBABILITY DENSITY FUNCTION
47995C              RIGPDF(X,GAMMA) = ???
47996C                     WITH MU = 1
47997C     NOTE--THE FATIGUE LIFE DISTRIBUTION--
47998C              GOES FROM 0 TO INFINITY
47999C              HAS MEAN = MU = 1
48000C              HAS STANDARD DEVIATION =
48001C              HAS SHAPE PARAMETER = GAMMA
48002C              IS HIGHLY-SKEWED AND LONG-TAILED FOR SMALL GAMMA???
48003C              IS SYMMETRIC AND MODERATE-TAILED FOR LARGE GAMMA???
48004C              APPROACHES NORMALITY AS GAMMA APPROACHES INFINITY???
48005C     NOTE--TO OBTAIN THE PDF FOR GENERAL MU,
48006C           COMPUTE THE PDF FOR X AROUND 1, AND THEN
48007C           SIMPLY SCALE UP THE HORIZONTAL AXIS X BY THE DESIRED MU
48008C           AS IN Y2 = MU*Y
48009C              F(X) = GAMMA * (X**(GAMMA-1)) * EXP(-(X**GAMMA)).
48010C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
48011C                                OF RANDOM NUMBERS TO BE
48012C                                GENERATED.
48013C                     --GAMMA  = THE SINGLE PRECISION VALUE OF THE
48014C                                TAIL LENGTH PARAMETER.
48015C                                GAMMA SHOULD BE POSITIVE.
48016C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
48017C                                (OF DIMENSION AT LEAST N)
48018C                                INTO WHICH THE GENERATED
48019C                                RANDOM SAMPLE WILL BE PLACED.
48020C     OUTPUT--A RANDOM SAMPLE OF SIZE N
48021C             FROM THE FATIGUE LIFE DISTRIBUTION
48022C             WITH TAIL LENGTH PARAMETER VALUE = GAMMA.
48023C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
48024C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
48025C                   OF N FOR THIS SUBROUTINE.
48026C                 --GAMMA SHOULD BE POSITIVE.
48027C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
48028C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE HEREIN.
48029C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
48030C     LANGUAGE--ANSI FORTRAN (1977)
48031C     REFERENCES--JOHNSON AND KOTZ
48032C               --SAM SAUNDERS
48033C     WRITTEN BY--JAMES J. FILLIBEN
48034C                 STATISTICAL ENGINEERING DIVISION
48035C                 INFORMATION TECHNOLOGY LABORATORY
48036C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
48037C                 GAITHERSBURG, MD 20899
48038C                 PHONE--301-975-2855
48039C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
48040C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
48041C     LANGUAGE--ANSI FORTRAN (1966)
48042C     VERSION NUMBER--90.6
48043C     ORIGINAL VERSION--MAY       1990.
48044C
48045C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
48046C
48047C---------------------------------------------------------------------
48048C
48049      DIMENSION X(*)
48050C
48051C-----COMMON----------------------------------------------------------
48052C
48053      INCLUDE 'DPCOP2.INC'
48054C
48055C-----START POINT-----------------------------------------------------
48056C
48057C     CHECK THE INPUT ARGUMENTS FOR ERRORS
48058C
48059      IF(N.LT.1)GOTO50
48060      IF(GAMMA.LE.0.0)GOTO60
48061      GOTO90
48062   50 WRITE(ICOUT, 5)
48063      CALL DPWRST('XXX','BUG ')
48064      WRITE(ICOUT,47)N
48065      CALL DPWRST('XXX','BUG ')
48066      RETURN
48067   60 WRITE(ICOUT,15)
48068      CALL DPWRST('XXX','BUG ')
48069      WRITE(ICOUT,46)GAMMA
48070      CALL DPWRST('XXX','BUG ')
48071      RETURN
48072   90 CONTINUE
48073    5 FORMAT('***** FATAL ERROR--THE FIRST  INPUT ARGUMENT ',
48074     1'TO THE FLRAN SUBROUTINE IS NON-POSITIVE *****')
48075   15 FORMAT('***** FATAL ERROR--THE SECOND INPUT ARGUMENT ',
48076     1'TO THE FLRAN SUBROUTINE IS NON-POSITIVE *****')
48077   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,
48078     1' *****')
48079   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,
48080     1' *****')
48081C
48082C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
48083C
48084      CALL UNIRAN(N,ISEED,X)
48085C
48086C     GENERATE N FATIGUE LIFE DISTRIBUTION RANDOM NUMBERS
48087C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
48088C
48089      DO100I=1,N
48090      XTEMP=X(I)
48091      CALL FLPPF(XTEMP,GAMMA,X(I))
48092  100 CONTINUE
48093C
48094      RETURN
48095      END
48096      REAL FUNCTION FMINDP(AX,BX,F,TOL)
48097C
48098C   NOTE: ADDED TO DATAPLOT 12/2003.  USE THIS ROUTINE FOR INTERNAL
48099C         DATAPLOT USE.  THE DPOPT2 ROUTINE IS ESSENTIALLY A DATAPLOT
48100C         ADAPTATION OF FMIN THAT IMPLEMENTS "LET A = OPTIMIZE ..."
48101C         COMMANDS.  IT IS MORE EFFICIENT FOR INTERNAL USE TO USE
48102C         FMIN EXPLICITLY (AVOID OVERHEAD OF FUNCTION PARSING, ETC.)
48103C
48104C   NOTE: MARCH 2005.  RENAME TO FMINDP TO AVOID NAME CONFLICT ON MAC OSX.
48105C
48106C***BEGIN PROLOGUE  FMIN
48107C***DATE WRITTEN   730101  (YYMMDD)
48108C***REVISION DATE  730101  (YYMMDD)
48109C***CATEGORY NO.  G1A2
48110C***KEYWORDS  ONE-DIMENSIONAL MINIMIZATION, UNIMODAL FUNCTION
48111C***AUTHOR  BRENT, R.
48112C***PURPOSE  An approximation to the point where F attains a minimum on
48113C            the interval (AX,BX) is determined as the value of the
48114C            function FMIN.
48115C***DESCRIPTION
48116C
48117C     From the book, "Numerical Methods and Software" by
48118C                D. Kahaner, C. Moler, S. Nash
48119C                Prentice Hall, 1988
48120C
48121C     The method used is a combination of golden section search and
48122C     successive parabolic interpolation.  Convergence is never much
48123C     slower than that for a Fibonacci search.  If F has a continuous
48124C     second derivative which is positive at the minimum (which is not
48125C     at AX or BX), then convergence is superlinear, and usually of the
48126C     order of about 1.324....
48127C
48128C     The function F is never evaluated at two points closer together
48129C     than EPS*ABS(FMIN) + (TOL/3), where EPS is approximately the
48130C     square root of the relative machine precision.  If F is a unimodal
48131C     function and the computed values of F are always unimodal when
48132C     separated by at least EPS*ABS(XSTAR) + (TOL/3), then FMIN
48133C     approximates the abcissa of the global minimum of F on the
48134C     interval AX,BX with an error less than 3*EPS*ABS(FMIN) + TOL.
48135C     If F is not unimodal, then FMIN may approximate a local, but
48136C     perhaps non-global, minimum to the same accuracy.
48137C
48138C     This function subprogram is a slightly modified version of the
48139C     ALGOL 60 procedure LOCALMIN given in Richard Brent, Algorithms for
48140C     Minimization Without Derivatives, Prentice-Hall, Inc. (1973).
48141C
48142C INPUT PARAMETERS
48143C
48144C  AX    (real)  left endpoint of initial interval
48145C  BX    (real) right endpoint of initial interval
48146C  F     Real function of the form REAL FUNCTION F(X) which evaluates
48147C          F(X)  for any  X in the interval  (AX,BX)
48148C        Must be declared EXTERNAL in calling routine.
48149C  TOL   (real) desired length of the interval of uncertainty of the
48150C        final result ( .ge. 0.0)
48151C
48152C
48153C OUTPUT PARAMETERS
48154C
48155C FMIN   abcissa approximating the minimizer of F
48156C AX     lower bound for minimizer
48157C BX     upper bound for minimizer
48158C
48159C***REFERENCES  RICHARD BRENT, ALGORITHMS FOR MINIMIZATION WITHOUT
48160C                 DERIVATIVES, PRENTICE-HALL, INC. (1973).
48161C***ROUTINES CALLED  (NONE)
48162C***END PROLOGUE  FMIN
48163      REAL  AX,BX,F,TOL
48164      REAL  A,B,C,D,E,EPS,XM,P,Q,R,TOL1,TOL2,U,V,W
48165      REAL  FU,FV,FW,FX,X
48166      REAL  ABS,SQRT,SIGN
48167C***FIRST EXECUTABLE STATEMENT  FMIN
48168      C = 0.5*(3. - SQRT(5.0))
48169C
48170C  C is the squared inverse of the golden ratio
48171C
48172C  EPS is approximately the square root of the relative machine
48173C  precision.
48174C
48175      EPS = 1.0
48176   10 EPS = EPS/2.0
48177      TOL1 = 1.0 + EPS
48178      IF (TOL1 .GT. 1.0) GO TO 10
48179      EPS = SQRT(EPS)
48180C
48181C  initialization
48182C
48183      A = AX
48184      B = BX
48185      V = A + C*(B - A)
48186      W = V
48187      X = V
48188      E = 0.0
48189      FX = F(X)
48190      FV = FX
48191      FW = FX
48192      D=0.0
48193      C=0.0
48194C
48195C  main loop starts here
48196C
48197   20 XM = 0.5*(A + B)
48198      TOL1 = EPS*ABS(X) + TOL/3.0
48199      TOL2 = 2.0*TOL1
48200C
48201C  check stopping criterion
48202C
48203      IF (ABS(X - XM) .LE. (TOL2 - 0.5*(B - A))) GO TO 90
48204C
48205C is golden-section necessary
48206C
48207      IF (ABS(E) .LE. TOL1) GO TO 40
48208C
48209C  fit parabola
48210C
48211      R = (X - W)*(FX - FV)
48212      Q = (X - V)*(FX - FW)
48213      P = (X - V)*Q - (X - W)*R
48214      Q = 2.0*(Q - R)
48215      IF (Q .GT. 0.0) P = -P
48216      Q = ABS(Q)
48217      R = E
48218      E = D
48219C
48220C  is parabola acceptable
48221C
48222      IF (ABS(P) .GE. ABS(0.5*Q*R)) GO TO 40
48223      IF (P .LE. Q*(A - X)) GO TO 40
48224      IF (P .GE. Q*(B - X)) GO TO 40
48225C
48226C  a parabolic interpolation step
48227C
48228      D = P/Q
48229      U = X + D
48230C
48231C  F must not be evaluated too close to AX or BX
48232C
48233      IF ((U - A) .LT. TOL2) D = SIGN(TOL1, XM - X)
48234      IF ((B - U) .LT. TOL2) D = SIGN(TOL1, XM - X)
48235      GO TO 50
48236C
48237C  a golden-section step
48238C
48239   40 IF (X .GE. XM) E = A - X
48240      IF (X .LT. XM) E = B - X
48241      D = C*E
48242C
48243C  F must not be evaluated too close to X
48244C
48245   50 IF (ABS(D) .GE. TOL1) U = X + D
48246      IF (ABS(D) .LT. TOL1) U = X + SIGN(TOL1, D)
48247      FU = F(U)
48248C
48249C  update  A, B, V, W, and X
48250C
48251      IF (FU .GT. FX) GO TO 60
48252      IF (U .GE. X) A = X
48253      IF (U .LT. X) B = X
48254      V = W
48255      FV = FW
48256      W = X
48257      FW = FX
48258      X = U
48259      FX = FU
48260      GO TO 20
48261   60 IF (U .LT. X) A = U
48262      IF (U .GE. X) B = U
48263      IF (FU .LE. FW) GO TO 70
48264      IF (W .EQ. X) GO TO 70
48265      IF (FU .LE. FV) GO TO 80
48266      IF (V .EQ. X) GO TO 80
48267      IF (V .EQ. W) GO TO 80
48268      GO TO 20
48269   70 V = W
48270      FV = FW
48271      W = U
48272      FW = FU
48273      GO TO 20
48274   80 V = U
48275      FV = FU
48276      GO TO 20
48277C
48278C  end of main loop
48279C
48280   90 FMINDP = X
48281      RETURN
48282      END
48283      REAL FUNCTION FMIND2(AX,BX,F,DTEMP1,N,TOL)
48284C
48285C   NOTE: THIS VERSION OF FMIN ALLOWS PASSING OF ARRAY OF
48286C         DATA (DTEMP1 AND N TO DENOTE THE SAMPLE SIZE).
48287C
48288C***BEGIN PROLOGUE  FMIN
48289C***DATE WRITTEN   730101  (YYMMDD)
48290C***REVISION DATE  730101  (YYMMDD)
48291C***CATEGORY NO.  G1A2
48292C***KEYWORDS  ONE-DIMENSIONAL MINIMIZATION, UNIMODAL FUNCTION
48293C***AUTHOR  BRENT, R.
48294C***PURPOSE  An approximation to the point where F attains a minimum on
48295C            the interval (AX,BX) is determined as the value of the
48296C            function FMIN.
48297C***DESCRIPTION
48298C
48299C     From the book, "Numerical Methods and Software" by
48300C                D. Kahaner, C. Moler, S. Nash
48301C                Prentice Hall, 1988
48302C
48303C     The method used is a combination of golden section search and
48304C     successive parabolic interpolation.  Convergence is never much
48305C     slower than that for a Fibonacci search.  If F has a continuous
48306C     second derivative which is positive at the minimum (which is not
48307C     at AX or BX), then convergence is superlinear, and usually of the
48308C     order of about 1.324....
48309C
48310C     The function F is never evaluated at two points closer together
48311C     than EPS*ABS(FMIN) + (TOL/3), where EPS is approximately the
48312C     square root of the relative machine precision.  If F is a unimodal
48313C     function and the computed values of F are always unimodal when
48314C     separated by at least EPS*ABS(XSTAR) + (TOL/3), then FMIN
48315C     approximates the abcissa of the global minimum of F on the
48316C     interval AX,BX with an error less than 3*EPS*ABS(FMIN) + TOL.
48317C     If F is not unimodal, then FMIN may approximate a local, but
48318C     perhaps non-global, minimum to the same accuracy.
48319C
48320C     This function subprogram is a slightly modified version of the
48321C     ALGOL 60 procedure LOCALMIN given in Richard Brent, Algorithms for
48322C     Minimization Without Derivatives, Prentice-Hall, Inc. (1973).
48323C
48324C INPUT PARAMETERS
48325C
48326C  AX    (real)  left endpoint of initial interval
48327C  BX    (real) right endpoint of initial interval
48328C  F     Real function of the form REAL FUNCTION F(X) which evaluates
48329C          F(X)  for any  X in the interval  (AX,BX)
48330C        Must be declared EXTERNAL in calling routine.
48331C  TOL   (real) desired length of the interval of uncertainty of the
48332C        final result ( .ge. 0.0)
48333C
48334C
48335C OUTPUT PARAMETERS
48336C
48337C FMIN   abcissa approximating the minimizer of F
48338C AX     lower bound for minimizer
48339C BX     upper bound for minimizer
48340C
48341C***REFERENCES  RICHARD BRENT, ALGORITHMS FOR MINIMIZATION WITHOUT
48342C                 DERIVATIVES, PRENTICE-HALL, INC. (1973).
48343C***ROUTINES CALLED  (NONE)
48344C***END PROLOGUE  FMIN
48345      REAL  AX,BX,F,TOL
48346      REAL  A,B,C,D,E,EPS,XM,P,Q,R,TOL1,TOL2,U,V,W
48347      REAL  FU,FV,FW,FX,X
48348      REAL  ABS,SQRT,SIGN
48349      DOUBLE PRECISION DTEMP1(*)
48350C
48351      INCLUDE 'DPCOP2.INC'
48352C
48353C***FIRST EXECUTABLE STATEMENT  FMIN
48354      FMIND2 = CPUMIN
48355C
48356      C = 0.5*(3. - SQRT(5.0))
48357C
48358C  C is the squared inverse of the golden ratio
48359C
48360C  EPS is approximately the square root of the relative machine
48361C  precision.
48362C
48363      EPS = 1.0
48364   10 EPS = EPS/2.0
48365      TOL1 = 1.0 + EPS
48366      IF (TOL1 .GT. 1.0) GO TO 10
48367      EPS = SQRT(EPS)
48368C
48369C  initialization
48370C
48371      A = AX
48372      B = BX
48373      V = A + C*(B - A)
48374      W = V
48375      X = V
48376      E = 0.0
48377      FX = F(X,DTEMP1,N)
48378      FV = FX
48379      FW = FX
48380      D=0.0
48381      C=0.0
48382C
48383C  main loop starts here
48384C
48385   20 XM = 0.5*(A + B)
48386      TOL1 = EPS*ABS(X) + TOL/3.0
48387      TOL2 = 2.0*TOL1
48388C
48389C  check stopping criterion
48390C
48391      IF (ABS(X - XM) .LE. (TOL2 - 0.5*(B - A))) GO TO 90
48392C
48393C is golden-section necessary
48394C
48395      IF (ABS(E) .LE. TOL1) GO TO 40
48396C
48397C  fit parabola
48398C
48399      R = (X - W)*(FX - FV)
48400      Q = (X - V)*(FX - FW)
48401      P = (X - V)*Q - (X - W)*R
48402      Q = 2.0*(Q - R)
48403      IF (Q .GT. 0.0) P = -P
48404      Q = ABS(Q)
48405      R = E
48406      E = D
48407C
48408C  is parabola acceptable
48409C
48410      IF (ABS(P) .GE. ABS(0.5*Q*R)) GO TO 40
48411      IF (P .LE. Q*(A - X)) GO TO 40
48412      IF (P .GE. Q*(B - X)) GO TO 40
48413C
48414C  a parabolic interpolation step
48415C
48416      D = P/Q
48417      U = X + D
48418C
48419C  F must not be evaluated too close to AX or BX
48420C
48421      IF ((U - A) .LT. TOL2) D = SIGN(TOL1, XM - X)
48422      IF ((B - U) .LT. TOL2) D = SIGN(TOL1, XM - X)
48423      GO TO 50
48424C
48425C  a golden-section step
48426C
48427   40 IF (X .GE. XM) E = A - X
48428      IF (X .LT. XM) E = B - X
48429      D = C*E
48430C
48431C  F must not be evaluated too close to X
48432C
48433   50 IF (ABS(D) .GE. TOL1) U = X + D
48434      IF (ABS(D) .LT. TOL1) U = X + SIGN(TOL1, D)
48435      FU = F(U,DTEMP1,N)
48436C
48437C  update  A, B, V, W, and X
48438C
48439      IF (FU .GT. FX) GO TO 60
48440      IF (U .GE. X) A = X
48441      IF (U .LT. X) B = X
48442      V = W
48443      FV = FW
48444      W = X
48445      FW = FX
48446      X = U
48447      FX = FU
48448      GO TO 20
48449   60 IF (U .LT. X) A = U
48450      IF (U .GE. X) B = U
48451      IF (FU .LE. FW) GO TO 70
48452      IF (W .EQ. X) GO TO 70
48453      IF (FU .LE. FV) GO TO 80
48454      IF (V .EQ. X) GO TO 80
48455      IF (V .EQ. W) GO TO 80
48456      GO TO 20
48457   70 V = W
48458      FV = FW
48459      W = U
48460      FW = FU
48461      GO TO 20
48462   80 V = U
48463      FV = FU
48464      GO TO 20
48465C
48466C  end of main loop
48467C
48468   90 FMIND2 = X
48469      RETURN
48470      END
48471      FUNCTION FNALPH(X,NOBS,BETA,XGM)
48472C
48473C COMPUTE MLE FOR SCALE PARAMETER (ALPHA)
48474C    XGM IS THE GEOMETRIC MEAN OF THE X'S
48475C
48476      DOUBLE PRECISION SUMZ
48477      DIMENSION X(*)
48478C
48479      RN=FLOAT(NOBS)
48480C
48481      SUMZ=0.0D0
48482      DO 20 I=1,NOBS
48483        SUMZ=SUMZ+DBLE((X(I)/XGM)**BETA)
48484   20 CONTINUE
48485C
48486      FNALPH=XGM*(SNGL(SUMZ)/RN)**(1./BETA)
48487C
48488      RETURN
48489      END
48490      FUNCTION FNALP2(X,NOBS,IR,GAMMA)
48491C
48492C    COMPUTE MLE FOR SCALE PARAMETER (ALPHA)
48493C    THIS IS FOR THE TYPE 2 CENSORED CASE.
48494C    XGM IS THE GEOMETRIC MEAN OF THE X'S
48495C
48496      DOUBLE PRECISION DG
48497      DOUBLE PRECISION DSUM1
48498      DOUBLE PRECISION DTERM1
48499      DOUBLE PRECISION DTERM2
48500      DOUBLE PRECISION DTERM3
48501C
48502      DIMENSION X(*)
48503C
48504      DG=DBLE(GAMMA)
48505C
48506      DSUM1=0.0D0
48507      DO 20 I=1,IR
48508        DSUM1=DSUM1+(DBLE(X(I))**DG)
48509   20 CONTINUE
48510      DTERM1=DSUM1/DBLE(IR)
48511      DTERM2=DBLE(NOBS-IR)*DBLE(X(I))**DG
48512      DTERM3=(DTERM1 + DTERM2)**(1.0D0/DG)
48513C
48514      FNALP2=REAL(DTERM3)
48515C
48516      RETURN
48517      END
48518      DOUBLE PRECISION FUNCTION FNCMVT(N, W)
48519*
48520*     Integrand subroutine
48521*
48522      INTEGER N, NUIN, INFIN(*), INFIS
48523      DOUBLE PRECISION W(*), LOWER(*), UPPER(*), CORREL(*), D, E
48524      INTEGER NL, IJ, I, J, NU
48525      PARAMETER ( NL = 20 )
48526      DOUBLE PRECISION COV((NL*(NL+1))/2), A(NL), B(NL), Y(NL)
48527      INTEGER INFI(NL)
48528      DOUBLE PRECISION PROD, D1, E1, DI, EI, SUM, STDINV, YD, UI, MVTNIT
48529      SAVE NU, D1, E1, A, B, INFI, COV
48530      DI = D1
48531      EI = E1
48532      PROD = EI - DI
48533      IJ = 1
48534      YD = 1.0D0
48535      DO 100 I = 1, N
48536         UI = STDINV( NU+I-1, DI + W(I)*( EI - DI ) )
48537         Y(I) = UI/YD
48538         YD = YD/SQRT( 1.0D0 + ( UI - 1.0D0 )*( UI + 1.0D0 )/
48539     +        DBLE( NU + I ) )
48540         SUM = 0.0D0
48541         DO 200 J = 1, I
48542            IJ = IJ + 1
48543            SUM = SUM + COV(IJ)*Y(J)
48544  200    CONTINUE
48545         IJ = IJ + 1
48546         CALL MVTLMS( NU+I, ( A(I+1) - SUM )*YD, ( B(I+1) - SUM )*YD,
48547     &                INFI(I+1), DI, EI )
48548         PROD = PROD*( EI - DI )
48549  100 CONTINUE
48550      FNCMVT = PROD
48551      RETURN
48552*
48553*     Entry point for intialization
48554*
48555      ENTRY MVTNIT( N, NUIN, CORREL, LOWER, UPPER, INFIN, INFIS, D, E )
48556      MVTNIT = 0.0D0
48557*
48558*     Initialization and computation of covariance matrix Cholesky factor
48559*
48560      CALL MVTSRT( N, NUIN, LOWER, UPPER, CORREL, INFIN, Y, INFIS,
48561     &             A, B, INFI, COV, D, E )
48562      NU = NUIN
48563      D1 = D
48564      E1 = E
48565C
48566      RETURN
48567      END
48568      SUBROUTINE FNRCDF(X,U,SD,CDF)
48569C
48570C     NOTE--FOLDED-NORMAL PDF IS:
48571C              FNRPDF(X,U,S,P) = NORPDF((X-U)/S) + NORPDF((X+U)/S))
48572C     WRITTEN BY--ALAN HECKERT
48573C                 STATISTICAL ENGINEERING DIVISION
48574C                 INFORMATION TECHNOLOGY LABORATORY
48575C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
48576C                 GAITHERSBURG, MD 20899-8980
48577C                 PHONE--301-975-2899
48578C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
48579C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
48580C     LANGUAGE--ANSI FORTRAN (1977)
48581C     VERSION NUMBER--95/9
48582C     ORIGINAL VERSION--SEPTEMBER 1995.
48583C
48584C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
48585C
48586C-----COMMON----------------------------------------------------------
48587C
48588      INCLUDE 'DPCOP2.INC'
48589C
48590C-----START POINT-----------------------------------------------------
48591C
48592      CDF=0.0
48593C
48594      IF(X.LT.0.0)THEN
48595        CDF=0.0
48596        GOTO9999
48597      ENDIF
48598      IF(SD.LE.0.0)THEN
48599        WRITE(ICOUT,201)
48600  201   FORMAT('***** ERROR--THE THIRD ARGUMENT TO FNRCDF (STANDARD ',
48601     1         'DEVIATION) IS NON-POSITIVE.')
48602        CALL DPWRST('XXX','BUG ')
48603        WRITE(ICOUT,46)SD
48604   46   FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
48605        CALL DPWRST('XXX','BUG ')
48606        GOTO9999
48607      ENDIF
48608C
48609      TERM1=(X-U)/SD
48610      CALL NORCDF(TERM1,TERM2)
48611      TERM2=TERM2
48612      TERM3=(-X-U)/SD
48613      CALL NORCDF(TERM3,TERM4)
48614      TERM4=TERM4
48615      CDF=TERM2-TERM4
48616      GOTO9999
48617C
48618 9999 CONTINUE
48619      RETURN
48620      END
48621      SUBROUTINE FNRFUN (N, X, FVEC, IFLAG, XDATA, NOBS)
48622C
48623C     PURPOSE--THIS ROUTINE COMPUTES THE FUNCTIONS FOR THE
48624C              FOLDED NORMAL MAXIMUM LIKELIHOOD
48625C              EQUATIONS.
48626C
48627C              MU**2 + SIGMA**2 - SUM[i=1 to n][X(i)**2]/N
48628C
48629C              MU - SUM[i=1 to n][X(i)*TANH(LOC*X(i)/SIGMA**2)]/N
48630C
48631C              WITH LOC AND SCALE DENOTING THE SHAPE PARAMETERS.
48632C
48633C              CALLED BY DNSQE ROUTINE FOR SOLVING SIMULTANEOUS
48634C              NONLINEAR EQUATIONS.  NOTE THAT THE CALLING SEQUENCE
48635C              DID NOT ACCOMODATE A DATA ARRAY (AND ASSCIATED NUMBER OF
48636C              OBSERVATIONS), SO THESE WERE ADDED TO THE CALL LIST.
48637C     EXAMPLE--FOLDED NORMAL MAXIMUM LIKELIHOOD Y
48638C     REFERENCE--"CONTINUOUS UNIVARIATE DISTRIBUTIONS-VVOLUME II",
48639C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
48640C                1994, WILEY, P. 454.
48641C     WRITTEN BY--JAMES J. FILLIBEN
48642C                 STATISTICAL ENGINEERING DIVISION
48643C                 INFORMATION TECHNOLOGY LABORATORY
48644C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
48645C                 GAITHERSBUG, MD 20899-8980
48646C                 PHONE--301-975-2855
48647C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
48648C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
48649C     LANGUAGE--ANSI FORTRAN (1977)
48650C     VERSION NUMBER--2004/3
48651C     ORIGINAL VERSION--MARCH     2004.
48652C
48653C---------------------------------------------------------------------
48654C
48655      DOUBLE PRECISION X(*)
48656      DOUBLE PRECISION FVEC(*)
48657      REAL XDATA(*)
48658C
48659      DOUBLE PRECISION DN
48660      DOUBLE PRECISION DX
48661      DOUBLE PRECISION DLOC
48662      DOUBLE PRECISION DSCALE
48663      DOUBLE PRECISION DSUM1
48664      DOUBLE PRECISION DSUM2
48665C
48666C-----COMMON----------------------------------------------------------
48667C
48668      INCLUDE 'DPCOP2.INC'
48669C
48670C-----START POINT-----------------------------------------------------
48671C
48672C  COMPUTE SOME SUMS
48673C
48674      N=2
48675      IFLAG=0
48676C
48677      DLOC=X(1)
48678      DSCALE=X(2)
48679      DN=DBLE(NOBS)
48680C
48681      DSUM1=0.0D0
48682      DSUM2=0.0D0
48683C
48684      DO200I=1,NOBS
48685        DX=DBLE(XDATA(I))
48686        DSUM1=DSUM1 + DX*DX
48687        DSUM2=DSUM2 + DX*TANH(DLOC*DX/DSCALE)
48688  200 CONTINUE
48689C
48690      FVEC(1)=DLOC*DLOC + DSCALE - (DSUM1/DN)
48691      FVEC(2)=DLOC - (DSUM2/DN)
48692C
48693      RETURN
48694      END
48695      DOUBLE PRECISION FUNCTION FNRFU2 (DX)
48696C
48697C     PURPOSE--THIS ROUTINE COMPUTES A FUNCTION NEEDED TO OBTAIN THE
48698C              PARAMETER COVARIANCE MATRIX FOR THE FOLDED NORMAL MLE.
48699C
48700C              SPECIFICALLY, THE INDEFINITE INTEGRAL IS NEEDED FOR
48701C
48702C              X**2*EXP(0.5*X**2)*SECH(THETA*X)
48703C
48704C              CALLED BY DQAGI.
48705C     REFERENCE--N. L. JOHNSON (1962), "THE FOLDED NORMAL DISTRIBUTION:
48706C                ACCURACY OF ESTIMATION BY MAXIMUM LIKELIHOOD",
48707C                TECHNOMETRICS, VOL. 4, NO. 2, PP. 249-256.
48708C     WRITTEN BY--ALAN HECKERT
48709C                 STATISTICAL ENGINEERING DIVISION
48710C                 INFORMATION TECHNOLOGY LABORATORY
48711C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
48712C                 GAITHERSBUG, MD 20899-8980
48713C                 PHONE--301-975-2855
48714C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
48715C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
48716C     LANGUAGE--ANSI FORTRAN (1977)
48717C     VERSION NUMBER--2014/5
48718C     ORIGINAL VERSION--MAY       2014.
48719C
48720C---------------------------------------------------------------------
48721C
48722      DOUBLE PRECISION DX
48723C
48724      DOUBLE PRECISION DTERM1
48725      DOUBLE PRECISION DTERM2
48726      DOUBLE PRECISION DARG
48727C
48728      DOUBLE PRECISION DTHETA
48729      COMMON/FNRCOM/DTHETA
48730C
48731C-----COMMON----------------------------------------------------------
48732C
48733      INCLUDE 'DPCOP2.INC'
48734C
48735C-----START POINT-----------------------------------------------------
48736C
48737C  COMPUTE SOME SUMS
48738C
48739      DTERM1=DX**2*DEXP(-0.5D0*DX**2)
48740      DARG=DTHETA*DX
48741      DTERM2=2.0D0/(DEXP(DARG)+DEXP(-DARG))
48742      FNRFU2=DTERM1*DTERM2
48743C
48744      RETURN
48745      END
48746      SUBROUTINE FNRLI1(Y,N,ALOC,SCALE,
48747     1                  ALIK,AIC,AICC,BIC,
48748     1                  ISUBRO,IBUGA3,IERROR)
48749C
48750C     PURPOSE--THIS ROUTINE COMPUTES THE LIKELIHOOD FUNCTION FOR
48751C              THE FOLED NORMAL DISTRIBUTION.  THIS IS FOR THE FULL
48752C              SAMPLE RAW DATA CASE (I.E., NO GROUPING AND NO CENSORING).
48753C
48754C     REFERENCE--N. L. JOHNSON (1962), "THE FOLDED NORMAL DISTRIBUTION:
48755C                ACCURACY OF ESTIMATION BY MAXIMUM LIKELIHOOD",
48756C                TECHNOMETRICS, VOL. 4, NO. 2, PP. 249-256.
48757C     WRITTEN BY--ALAN HECKERT
48758C                 STATISTICAL ENGINEERING DIVISION
48759C                 INFORMATION TECHNOLOGY LABORATORY
48760C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
48761C                 GAITHERSBURG, MD 20899-8980
48762C                 PHONE--301-975-2855
48763C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
48764C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
48765C     LANGUAGE--ANSI FORTRAN (1977)
48766C     VERSION NUMBER--2014/05
48767C     ORIGINAL VERSION--MAY       2014.
48768C
48769C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
48770C
48771      CHARACTER*4 ISUBRO
48772      CHARACTER*4 IBUGA3
48773      CHARACTER*4 IERROR
48774C
48775      CHARACTER*4 IWRITE
48776C
48777      CHARACTER*4 ISUBN1
48778      CHARACTER*4 ISUBN2
48779      CHARACTER*4 ISTEPN
48780C
48781      DOUBLE PRECISION DX
48782      DOUBLE PRECISION DS
48783      DOUBLE PRECISION DU
48784      DOUBLE PRECISION DTHETA
48785      DOUBLE PRECISION DN
48786      DOUBLE PRECISION DPI
48787      DOUBLE PRECISION DNP
48788      DOUBLE PRECISION DLIK
48789      DOUBLE PRECISION DSUM1
48790      DOUBLE PRECISION DSUM2
48791      DOUBLE PRECISION DTERM1
48792      DOUBLE PRECISION DTERM2
48793      DOUBLE PRECISION DTERM3
48794C
48795C---------------------------------------------------------------------
48796C
48797      DIMENSION Y(*)
48798C
48799C---------------------------------------------------------------------
48800C
48801      INCLUDE 'DPCOP2.INC'
48802C
48803      DATA DPI / 3.1415926535 8979323846 2643383279 503 D0 /
48804C
48805C-----START POINT-----------------------------------------------------
48806C
48807      ISUBN1='NORL'
48808      ISUBN2='I1  '
48809C
48810      IERROR='NO'
48811C
48812      ALIK=CPUMIN
48813      AIC=CPUMIN
48814      AICC=CPUMIN
48815      BIC=CPUMIN
48816C
48817      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'RLI1')THEN
48818        WRITE(ICOUT,999)
48819  999   FORMAT(1X)
48820        CALL DPWRST('XXX','WRIT')
48821        WRITE(ICOUT,51)
48822   51   FORMAT('**** AT THE BEGINNING OF FNRLI1--')
48823        CALL DPWRST('XXX','WRIT')
48824        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,ALOC,SCALE
48825   52   FORMAT('IBUGA3,ISUBRO,N,ALOC,SCALE = ',2(A4,2X),I8,2G15.7)
48826        CALL DPWRST('XXX','WRIT')
48827        DO56I=1,MIN(N,100)
48828          WRITE(ICOUT,57)I,Y(I)
48829   57     FORMAT('I,Y(I) = ',I8,G15.7)
48830          CALL DPWRST('XXX','WRIT')
48831   56   CONTINUE
48832      ENDIF
48833C
48834C               ******************************************
48835C               **  STEP 1--                            **
48836C               **  COMPUTE LIKELIHOOD FUNCTION         **
48837C               ******************************************
48838C
48839      ISTEPN='1'
48840      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'RLI1')
48841     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
48842C
48843      IERFLG=0
48844      IERROR='NO'
48845      IWRITE='OFF'
48846C
48847C     NOTE THAT THE LOG-LIKELIHOOD IS GIVEN IN TERMS OF SIGMA AND
48848C     THETA = (MU/SIGMA).
48849C
48850C     THE LOG-LIKELIHOOD FUNCTION IS THEN:
48851C
48852C     -(N/2)*LOG(2*PI) - N*LOG(SIGMA) - N*THETA**2/2 -
48853C     0.5*SUM[i=1 to N][X(I)**2]/SIGMA)**2 +
48854C     SUM[i=1 to N][LOG(COSH(THETA*X(I)/SIGMA))]
48855C
48856      DN=DBLE(N)
48857      DS=DBLE(SCALE)
48858      DU=DBLE(ALOC)
48859      DTHETA=DU/DS
48860      DTERM1=(DN/2.0D0)*DLOG(2.0D0/DPI) - DN*DLOG(DS) -
48861     1       DN*DTHETA**2/2.0D0
48862C
48863      DSUM1=0.0D0
48864      DSUM2=0.0D0
48865      DO1000I=1,N
48866        DX=DBLE(Y(I))
48867        DSUM1=DSUM1 + (DX/DS)**2
48868        DTERM2=DTHETA*DX/DS
48869        DTERM3=(DEXP(DTERM2)+DEXP(-DTERM2))/2.0D0
48870        DSUM2=DSUM2 + DLOG(DTERM3)
48871 1000 CONTINUE
48872C
48873      DLIK=DTERM1 - 0.5D0*DSUM1 + DSUM2
48874      ALIK=REAL(DLIK)
48875      DNP=2.0D0
48876      AIC=REAL(-2.0D0*DLIK + 2.0D0*DNP)
48877      DTERM3=(2.0D0*DNP*(DNP+1.0D0))/(DN-DNP-1.0D0)
48878      AICC=REAL(-2.0D0*DLIK + 2.0D0*DNP + DTERM3)
48879      BIC=REAL(-2.0D0*DLIK + DNP*LOG(DN))
48880C
48881      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'RLI1')THEN
48882        WRITE(ICOUT,999)
48883        CALL DPWRST('XXX','WRIT')
48884        WRITE(ICOUT,9011)
48885 9011   FORMAT('**** AT THE END OF FNRLI1--')
48886        CALL DPWRST('XXX','WRIT')
48887        WRITE(ICOUT,9013)DSUM1,DSUM2,DTERM1,DTERM3
48888 9013   FORMAT('DSUM1,DSUM2,DTERM1,DTERM3 = ',4G15.7)
48889        CALL DPWRST('XXX','WRIT')
48890        WRITE(ICOUT,9014)ALIK,AIC,AICC,BIC
48891 9014   FORMAT('ALIK,AIC,AICC,BIC = ',4G15.7)
48892        CALL DPWRST('XXX','WRIT')
48893      ENDIF
48894C
48895      RETURN
48896      END
48897      SUBROUTINE FNRML1(Y,N,MAXNXT,
48898     1                  TEMP1,DTEMP1,
48899     1                  XMEAN,XSD,XVAR,XMIN,XMAX,
48900     1                  ALOCML,SCALML,
48901     1                  ISUBRO,IBUGA3,IERROR)
48902C
48903C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
48904C              FOR THE 2-PARAMETER FOLDED NORMAL DISTRIBUTION FOR THE
48905C              RAW DATA CASE (I.E., NO CENSORING AND NO GROUPING).  THIS
48906C              ROUTINE RETURNS ONLY THE POINT ESTIMATES (CONFIDENCE
48907C              INTERVALS WILL BE COMPUTED IN A SEPARATE ROUTINE).
48908C
48909C              IT IS ASSUMED THAT BASIC ERROR CHECKING HAS ALREADY BEEN
48910C              PERFORMED.
48911C
48912C              PUT THIS IN A SEPARATE ROUTINE AS IT MAY BE CALLED
48913C              FROM MULTIPLE PLACES (DPMLFN WILL GENERATE THE OUTPUT
48914C              FOR THE FOLDED NORMAL MLE COMMAND).
48915C
48916C     REFERENCE--"CONTINUOUS UNIVARIATE DISTRIBUTIONS-VVOLUME II",
48917C                SECOND EDITION, JOHNSON, KOTZ, AND BALAKRISHNAN,
48918C                1994, WILEY, P. 454.
48919C     WRITTEN BY--ALAN HECKERT
48920C                 STATISTICAL ENGINEERING DIVISION
48921C                 INFORMATION TECHNOLOGY LABORATORY
48922C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
48923C                 GAITHERSBURG, MD 20899-8980
48924C                 PHONE--301-975-2899
48925C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
48926C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
48927C     LANGUAGE--ANSI FORTRAN (1977)
48928C     VERSION NUMBER--2010/2
48929C     ORIGINAL VERSION--FEBRUARY  2010. EXTRACTED AS A SEPARATE
48930C                                       SUBROUTINE (FROM DPMLE1)
48931C
48932C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
48933C
48934      DIMENSION Y(*)
48935      DIMENSION TEMP1(*)
48936      DOUBLE PRECISION DTEMP1(*)
48937C
48938      DOUBLE PRECISION TOL
48939      DOUBLE PRECISION XPAR(2)
48940      DOUBLE PRECISION FVEC(2)
48941C
48942      EXTERNAL FNRFUN
48943C
48944      CHARACTER*4 ISUBRO
48945      CHARACTER*4 IBUGA3
48946      CHARACTER*4 IERROR
48947C
48948      CHARACTER*4 IWRITE
48949      CHARACTER*40 IDIST
48950C
48951      CHARACTER*4 ISUBN1
48952      CHARACTER*4 ISUBN2
48953      CHARACTER*4 ISTEPN
48954C
48955C---------------------------------------------------------------------
48956C
48957      INCLUDE 'DPCOP2.INC'
48958C
48959C-----START POINT-----------------------------------------------------
48960C
48961      ISUBN1='FNRM'
48962      ISUBN2='L1  '
48963      IERROR='NO'
48964      IWRITE='OFF'
48965C
48966      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'RML1')THEN
48967        WRITE(ICOUT,999)
48968  999   FORMAT(1X)
48969        CALL DPWRST('XXX','WRIT')
48970        WRITE(ICOUT,51)
48971   51   FORMAT('**** AT THE BEGINNING OF FNRML1--')
48972        CALL DPWRST('XXX','WRIT')
48973        WRITE(ICOUT,52)IBUGA3,ISUBRO
48974   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
48975        CALL DPWRST('XXX','WRIT')
48976        DO56I=1,MIN(N,100)
48977          WRITE(ICOUT,57)I,Y(I),TEMP1(I)
48978   57     FORMAT('I,Y(I),TEMP1((I) = ',I8,2G15.7)
48979          CALL DPWRST('XXX','WRIT')
48980   56   CONTINUE
48981      ENDIF
48982C
48983C               ********************************************
48984C               **  STEP 1--                              **
48985C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
48986C               ********************************************
48987C
48988      ISTEPN='1'
48989      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'RML1')
48990     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
48991C
48992C               *****************************************************
48993C               **  STEP 2--                                       **
48994C               **  CARRY OUT CALCULATIONS                         **
48995C               **  FOR FOLDED NORMAL MLE ESTIMATE                 **
48996C               *****************************************************
48997C
48998      ISTEPN='2'
48999      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'RML1')
49000     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
49001C
49002      IDIST='FOLDED NORMAL'
49003C
49004      IFLAG=2
49005      CALL SUMRAW(Y,N,IDIST,IFLAG,
49006     1            XMEAN,XVAR,XSD,XMIN,XMAX,
49007     1            ISUBRO,IBUGA3,IERROR)
49008C
49009      ALOCML=CPUMIN
49010      SCALML=CPUMIN
49011C
49012      XPAR(1)=DBLE(XMEAN)
49013      XPAR(2)=DBLE(XSD*XSD)
49014C
49015      IOPT=2
49016      TOL=1.0D-5
49017      NVAR=2
49018      NPRINT=-1
49019      INFO=0
49020      LWA=MAXNXT
49021      CALL DNSQE(FNRFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
49022     1           DTEMP1,MAXNXT,Y,N)
49023C
49024      ALOCML=REAL(XPAR(1))
49025      SCALML=REAL(XPAR(2))
49026      SCALML=SQRT(SCALML)
49027C
49028      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'RML1')THEN
49029        WRITE(ICOUT,999)
49030        CALL DPWRST('XXX','WRIT')
49031        WRITE(ICOUT,9011)
49032 9011   FORMAT('**** AT THE END OF FNRML1--')
49033        CALL DPWRST('XXX','WRIT')
49034        WRITE(ICOUT,9013)N,XMEAN,XSD,XMIN,XMAX
49035 9013   FORMAT('N,XMEAN,XSD,XMIN,XMAX = ',I8,4G15.7)
49036        CALL DPWRST('XXX','WRIT')
49037        WRITE(ICOUT,9017)ALOCML,SCALML
49038 9017   FORMAT('ALOCML,SCALML =  ',2G15.7)
49039        CALL DPWRST('XXX','WRIT')
49040      ENDIF
49041C
49042      RETURN
49043      END
49044      SUBROUTINE FNRPDF(X,U,SD,PDF)
49045C
49046C     NOTE--FOLDED-NORMAL PDF IS:
49047C              FNRPDF(X,U,S)=(1/S)*(NORPDF((X-U)/S) + NORPDF((X+U)/S)))
49048C           WHERE NORPDF IS THE PDF OF THE STANDARD NORMAL DISTRIBUTION
49049C     WRITTEN BY--ALAN HECKERT
49050C                 STATISTICAL ENGINEERING DIVISION
49051C                 INFORMATION TECHNOLOGY LABORATORY
49052C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
49053C                 GAITHERSBURG, MD 20899-8980
49054C                 PHONE--301-975-2899
49055C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
49056C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
49057C     LANGUAGE--ANSI FORTRAN (1977)
49058C     VERSION NUMBER--95/4
49059C     ORIGINAL VERSION--APRIL     1995.
49060C
49061C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
49062C
49063C-----COMMON----------------------------------------------------------
49064C
49065      INCLUDE 'DPCOP2.INC'
49066C
49067C-----START POINT-----------------------------------------------------
49068C
49069      PDF=0.0
49070C
49071      IF(X.LT.0.0)THEN
49072        WRITE(ICOUT,4)
49073        CALL DPWRST('XXX','BUG ')
49074        WRITE(ICOUT,46)X
49075        CALL DPWRST('XXX','BUG ')
49076        PDF=0.0
49077        GOTO9999
49078      ENDIF
49079      IF(SD.LE.0.0)THEN
49080        WRITE(ICOUT,201)
49081        CALL DPWRST('XXX','BUG ')
49082        WRITE(ICOUT,46)SD
49083        CALL DPWRST('XXX','BUG ')
49084        GOTO9999
49085      ENDIF
49086    4 FORMAT('***** ERROR--THE FIRST ARGUMENT TO FNRPDF IS NEGATIVE.')
49087   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
49088  201 FORMAT('***** ERROR--THE THIRD ARGUMENT TO FNRPDF (STANDARD ',
49089     1       'DEVIATION) IS NON-POSITIVE.')
49090C
49091      TERM1=(X-U)/SD
49092      CALL NORPDF(TERM1,TERM2)
49093      TERM2=TERM2/SD
49094      TERM3=(X+U)/SD
49095      CALL NORPDF(TERM3,TERM4)
49096      TERM4=TERM4/SD
49097      PDF=TERM2+TERM4
49098      GOTO9999
49099C
49100 9999 CONTINUE
49101      RETURN
49102      END
49103      SUBROUTINE FNRPPF(P,U,SD,PPF)
49104C
49105C     PURPOSE   --PERCENT POINT FUNCTION FOR THE FOLDED NORMAL
49106C                 DISTRIBUTION.  USES A BISECTION METHOD.
49107C     WRITTEN BY--ALAN HECKERT
49108C                 STATISTICAL ENGINEERING DIVISION
49109C                 INFORMATION TECHNOLOGY LABORATORY
49110C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
49111C                 GAITHERSBURG, MD 20899-8980
49112C                 PHONE--301-975-2899
49113C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
49114C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
49115C     LANGUAGE--ANSI FORTRAN (1977)
49116C     VERSION NUMBER--95/9
49117C     ORIGINAL VERSION--SEPTEMBER 1995.
49118C
49119C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
49120C
49121C---------------------------------------------------------------------
49122C
49123      DOUBLE PRECISION DU
49124      DOUBLE PRECISION DMEAN
49125      DOUBLE PRECISION DSD
49126      DOUBLE PRECISION DPI
49127      DOUBLE PRECISION DSDF
49128C
49129      DOUBLE PRECISION DP
49130      DOUBLE PRECISION EPS
49131      DOUBLE PRECISION SIG
49132      DOUBLE PRECISION ZERO
49133      DOUBLE PRECISION DTERM1
49134      DOUBLE PRECISION DTERM2
49135      DOUBLE PRECISION DTERM3
49136      DOUBLE PRECISION DTERM4
49137      DOUBLE PRECISION XL
49138      DOUBLE PRECISION XR
49139      DOUBLE PRECISION XINC
49140      DOUBLE PRECISION X
49141      DOUBLE PRECISION FXL
49142      DOUBLE PRECISION FXR
49143      DOUBLE PRECISION P1
49144      DOUBLE PRECISION FCS
49145      DOUBLE PRECISION XRML
49146      DOUBLE PRECISION DCDF
49147      DOUBLE PRECISION CDFL
49148      DOUBLE PRECISION CDFR
49149C
49150      INCLUDE 'DPCOP2.INC'
49151C
49152      DATA DPI /3.14159265358979D0/
49153      DATA EPS /0.00001D0/
49154      DATA SIG /1.0D-6/
49155      DATA ZERO /0.0D0/
49156      DATA MAXIT /5000/
49157C
49158C-----START POINT-----------------------------------------------------
49159C
49160C     CHECK THE INPUT ARGUMENTS FOR ERRORS
49161C
49162      PPF=0.0
49163      IF(P.LT.0.0.OR.P.GE.1.0)THEN
49164        WRITE(ICOUT,1)
49165    1   FORMAT('***** ERROR--THE FIRST ARGUMENT TO FNRPPF IS OUTSIDE ',
49166     1         'THE ALLOWABLE (0,1) INTERVAL.')
49167        CALL DPWRST('XXX','BUG ')
49168        WRITE(ICOUT,46)P
49169        CALL DPWRST('XXX','BUG ')
49170        GOTO9999
49171      ELSEIF(SD.LE.0.0)THEN
49172        WRITE(ICOUT,35)
49173   35   FORMAT('***** ERROR--THE THIRD ARGUMENT TO FNRPPF IS ',
49174     1         'NON-POSITIVE.')
49175        CALL DPWRST('XXX','BUG ')
49176        WRITE(ICOUT,46)SD
49177        CALL DPWRST('XXX','BUG ')
49178        GOTO9999
49179      ENDIF
49180C
49181   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7)
49182C
49183C  NOVEMBER 1995.  IF P IS 0, PPF IS ZERO.  HANDLE THIS TRIVIAL CASE.
49184C
49185      IF(P.EQ.0.0)THEN
49186        PPF=0.0
49187        GOTO9999
49188      ENDIF
49189C
49190C  FIND BRACKETING INTERVAL.
49191C  AFTER SUCCESSFULLY FIND BRACKETING INTERVAL, THEN SWITCH TO
49192C  MORE EFFICIENT BISECTION METHOD.
49193C
49194C  CALCULATE MEAN AND STANDARD DEVIATION OF FOLDED NORMAL
49195C
49196      DU=DBLE(U)
49197      DSD=DBLE(SD)
49198      DP=DBLE(P)
49199      DTERM1=DEXP(-DU**2/(2.0D0*DSD**2))
49200      DTERM2=DSQRT(2.D0/DPI)
49201      DTERM3=-DU/DSD
49202      CALL NODCDF(DTERM3,DTERM4)
49203      DMEAN=DTERM2*DSD*DTERM1 + DU*(1.D0-2.D0*DTERM4)
49204      DSDF=DMEAN**2 + DU*DU + DSD*DSD
49205C
49206      XL=DMEAN
49207      XINC=DSDF
49208      IF(XINC.LT.1.0D0)XINC=1.0D0
49209      ICOUNT=0
49210C
49211   91 CONTINUE
49212      XR=XL+XINC
49213      IF(XL.LE.0.0D0)XL=0.0D0
49214      IF(XR.LE.0.0D0)XR=XL+1.0D0
49215CCCCC CALL FNRCDF(XL,U,SD,CDFL)
49216C
49217      DTERM1=(XL-DU)/DSD
49218      CALL NODCDF(DTERM1,DTERM2)
49219      DTERM3=(-XL-DU)/DSD
49220      CALL NODCDF(DTERM3,DTERM4)
49221      CDFL=DTERM2-DTERM4
49222C
49223CCCCC CALL FNRCDF(XR,U,SD,CDFR)
49224C
49225      DTERM1=(XR-DU)/DSD
49226      CALL NODCDF(DTERM1,DTERM2)
49227      DTERM3=(-XR-DU)/DSD
49228      CALL NODCDF(DTERM3,DTERM4)
49229      CDFR=DTERM2-DTERM4
49230C
49231      IF(CDFL.LT.DP .AND. CDFR.LT.DP)THEN
49232        XL=XR
49233      ELSEIF(CDFL.GT.DP .AND. CDFR.GT.DP)THEN
49234        XL=XL-XINC
49235      ELSE
49236        GOTO99
49237      ENDIF
49238      ICOUNT=ICOUNT+1
49239      IF(ICOUNT.GT.MAXIT)THEN
49240        WRITE(ICOUT,96)
49241        CALL DPWRST('XXX','BUG ')
49242        PPF=0.0
49243        GOTO9999
49244      ENDIF
49245   96 FORMAT('***** FATAL ERROR--FNRPPF UNABLE TO FIND BRACKETING ',
49246     *       'INTERVAL. *****')
49247      GOTO91
49248C
49249C  BISECTION METHOD
49250C
49251   99 CONTINUE
49252      IC = 0
49253      FXL = -DP
49254      FXR = 1.0D0 - DP
49255  105 CONTINUE
49256      X = (XL+XR)*0.5D0
49257CCCCC CALL FNRCDF(X,U,SD,CDF)
49258C
49259      DTERM1=(X-DU)/DSD
49260      CALL NODCDF(DTERM1,DTERM2)
49261      DTERM3=(-X-DU)/DSD
49262      CALL NODCDF(DTERM3,DTERM4)
49263      DCDF=DTERM2-DTERM4
49264C
49265      P1=DCDF
49266      PPF=X
49267      FCS = P1 - DP
49268      IF(FCS*FXL.GT.ZERO)GOTO110
49269      XR = X
49270      FXR = FCS
49271      GOTO115
49272  110 CONTINUE
49273      XL = X
49274      FXL = FCS
49275  115 CONTINUE
49276      XRML = XR - XL
49277      IF(XRML.LE.SIG .AND. ABS(FCS).LE.EPS)GOTO9999
49278      IC = IC + 1
49279      IF(IC.LE.MAXIT)GOTO105
49280      WRITE(ICOUT,130)
49281      CALL DPWRST('XXX','BUG ')
49282  130 FORMAT('***** FATAL ERROR--FNRPPF ROUTINE DID NOT CONVERGE. ***')
49283      GOTO9999
49284C
49285 9999 CONTINUE
49286      RETURN
49287      END
49288      SUBROUTINE FNRRAN(N,U,SD,ISEED,X)
49289C
49290C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
49291C              FROM THE FOLDED NORMAL DISTRIBUTION.
49292C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
49293C                                OF RANDOM NUMBERS TO BE
49294C                                GENERATED.
49295C                       U      = MEAN OF PARENT NORMAL DISTRIBUTION
49296C                       SD     = STANDARD DEVIATION OF PARENT NORMAL
49297C                                DISTRIBUTION
49298C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
49299C                                (OF DIMENSION AT LEAST N)
49300C                                INTO WHICH THE GENERATED
49301C                                RANDOM SAMPLE WILL BE PLACED.
49302C     OUTPUT--A RANDOM SAMPLE OF SIZE N
49303C             FROM THE FOLDED-NORMAL DISTRIBUTION
49304C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
49305C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
49306C                   OF N FOR THIS SUBROUTINE.
49307C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
49308C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG, SQRT, SIN, COS.
49309C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
49310C     LANGUAGE--ANSI FORTRAN (1977)
49311C     REFERENCES--TOCHER, THE ART OF SIMULATION,
49312C                 1963, PAGES 14-15.
49313C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
49314C                 1964, PAGE 36.
49315C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
49316C                 DISTRIBUTIONS--1, 1970, PAGES 53, 59, 81, 83.
49317C     WRITTEN BY--JAMES J. FILLIBEN
49318C                 STATISTICAL ENGINEERING DIVISION
49319C                 INFORMATION TECHNOLOGY LABORATORY
49320C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
49321C                 GAITHERSBURG, MD 20899
49322C                 PHONE--301-975-2855
49323C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
49324C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
49325C     LANGUAGE--ANSI FORTRAN (1966)
49326C     VERSION NUMBER--95/10
49327C     ORIGINAL VERSION--OCTOBER   1995.
49328C
49329C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
49330C
49331C---------------------------------------------------------------------
49332C
49333      DIMENSION X(*)
49334      DIMENSION Y(2)
49335C
49336C-----COMMOMN---------------------------------------------------------
49337C
49338      INCLUDE 'DPCOP2.INC'
49339C
49340C-----DATA STATEMENTS-------------------------------------------------
49341C
49342      DATA PI/3.14159265359/
49343C
49344C-----START POINT-----------------------------------------------------
49345C
49346C     CHECK THE INPUT ARGUMENTS FOR ERRORS
49347C
49348      IF(N.LT.1)GOTO50
49349      GOTO90
49350   50 WRITE(ICOUT, 5)
49351      CALL DPWRST('XXX','BUG ')
49352      WRITE(ICOUT,47)N
49353      CALL DPWRST('XXX','BUG ')
49354      RETURN
49355   90 CONTINUE
49356    5 FORMAT('***** FATAL ERROR--THE 1ST INPUT ARGUMENT TO THE ',
49357     1'FNRRAN SUBROUTINE IS NON-POSITIVE *****')
49358   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
49359C
49360C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
49361C     THEN GENERATE 2 ADDITIONAL UNIFORM (0,1) RANDOM NUMBERS
49362C     (TO BE USED BELOW IN FORMING THE N-TH NORMAL
49363C     RANDOM NUMBER WHEN THE DESIRED SAMPLE SIZE N
49364C     HAPPENS TO BE ODD).
49365C
49366      CALL UNIRAN(N,ISEED,X)
49367      CALL UNIRAN(2,ISEED,Y)
49368C
49369C     GENERATE N NORMAL RANDOM NUMBERS
49370C     USING THE BOX-MULLER METHOD.
49371C
49372      DO200I=1,N,2
49373      IP1=I+1
49374      U1=X(I)
49375      IF(I.EQ.N)GOTO210
49376      U2=X(IP1)
49377      GOTO220
49378  210 U2=Y(2)
49379  220 ARG1=-2.0*LOG(U1)
49380      ARG2=2.0*PI*U2
49381      SQRT1=SQRT(ARG1)
49382      Z1=SQRT1*COS(ARG2)
49383      Z2=SQRT1*SIN(ARG2)
49384      X(I)=Z1
49385      IF(I.EQ.N)GOTO200
49386      X(IP1)=Z2
49387  200 CONTINUE
49388C
49389C     GENERATE N FOLDED NORMAL RANDOM NUMBERS
49390C     USING THE DEFINITION THAT
49391C     A FOLDED NORMAL VARIATE
49392C     EQUALS THE ABSOLUTE VALUE OF A NORMAL VARIATE WITH
49393C     MEAN U AND STANDARD DEVIATION SD.
49394C
49395      DO400I=1,N
49396      X(I)=SD*X(I)+U
49397      IF(X(I).LT.0.0)X(I)=-X(I)
49398  400 CONTINUE
49399C
49400      RETURN
49401      END
49402      SUBROUTINE FTCDF(X,NU,CDF)
49403C
49404C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
49405C              FUNCTION VALUE FOR THE FOLDED T DISTRIBUTION
49406C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
49407C              THIS DISTRIBUTION IS DEFINED FOR NON-NEGATIVE X
49408C              AND IS THE ABSOLUTE VALUE OF THE STUDENT'S T
49409C              DISTRIBUTION.
49410C              THE CUMULATIVE DISTRIBUTION FUNCTION IS COMPUTED
49411C              FROM THE CORRESPONDING T CDF FUNCTION
49412C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
49413C                                WHICH THE CUMULATIVE DISTRIBUTION
49414C                                FUNCTION IS TO BE EVALUATED.
49415C                                X SHOULD BE NON-NEGATIVE.
49416C                     --NU     = THE INTEGER NUMBER OF DEGREES
49417C                                OF FREEDOM.
49418C                                NU SHOULD BE POSITIVE.
49419C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION PROBABILITY
49420C                                DENSITY FUNCTION VALUE.
49421C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
49422C             FUNCTION VALUE CDF FOR THE FODLED T DISTRIBUTION
49423C             WITH DEGREES OF FREEDOM PARAMETER = NU.
49424C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
49425C     RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE.
49426C     OTHER DATAPAC   SUBROUTINES NEEDED--TCDF.
49427C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
49428C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
49429C     LANGUAGE--ANSI FORTRAN (1977)
49430C     REFERENCES--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
49431C                 UNIVARIATE DISTRIBUTIONS, VOLUME 2, 1994, PAGE 403,
49432C                 JOHN WILEY.
49433C                 PAGES 132-134.
49434C     WRITTEN BY--JAMES J. FILLIBEN
49435C                 STATISTICAL ENGINEERING LABORATORY (205.03)
49436C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
49437C                 GAITHERSBURG, MD 20899
49438C                 PHONE:  301-975-2855
49439C     ORIGINAL VERSION--NOVEMBER  2003.
49440C     UPDATED         --OCTOBER   2006. CALL LIST TO TCDF
49441C
49442C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
49443C
49444C-----COMMON----------------------------------------------------------
49445C
49446      INCLUDE 'DPCOP2.INC'
49447C
49448C---------------------------------------------------------------------
49449C
49450C     CHECK THE INPUT ARGUMENTS FOR ERRORS
49451C
49452      IF(X.LT.0.0)THEN
49453        WRITE(ICOUT,4)
49454        CALL DPWRST('XXX','BUG ')
49455        WRITE(ICOUT,5)
49456        CALL DPWRST('XXX','BUG ')
49457        WRITE(ICOUT,46)X
49458        CALL DPWRST('XXX','BUG ')
49459        CDF=0.0
49460        GOTO9999
49461      ENDIF
49462      IF(NU.LE.0)THEN
49463        WRITE(ICOUT,15)
49464        CALL DPWRST('XXX','BUG ')
49465        WRITE(ICOUT,47)NU
49466        CALL DPWRST('XXX','BUG ')
49467        CDF=0.0
49468        GOTO9999
49469      ENDIF
49470    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT')
49471    5 FORMAT('      TO THE FOLDED T CDF SUBROUTINE IS NEGATIVE *****')
49472   15 FORMAT('***** FATAL ERROR--THE DEGREES OF FREEDOM ARGUMENT ',
49473     1       'TO THE FOLDED T CDF SUBROUTINE IS NON-POSITIVE *****')
49474   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
49475   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
49476C
49477C-----START POINT-----------------------------------------------------
49478C
49479      CALL TCDF(X,REAL(NU),CDF)
49480      CDF=2.0*CDF - 1.0
49481C
49482 9999 CONTINUE
49483      RETURN
49484      END
49485      SUBROUTINE FTPDF(X,NU,PDF)
49486C
49487C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
49488C              FUNCTION VALUE FOR THE FOLDED T DISTRIBUTION
49489C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
49490C              THIS DISTRIBUTION IS DEFINED FOR NON-NEGATIVE X
49491C              AND IS THE ABSOLUTE VALUE OF THE STUDENT'S T
49492C              DISTRIBUTION.
49493C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
49494C              IN THE REFERENCES BELOW.
49495C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
49496C                                WHICH THE PROBABILITY DENSITY
49497C                                FUNCTION IS TO BE EVALUATED.
49498C                                X SHOULD BE NON-NEGATIVE.
49499C                     --NU     = THE INTEGER NUMBER OF DEGREES
49500C                                OF FREEDOM.
49501C                                NU SHOULD BE POSITIVE.
49502C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
49503C                                DENSITY FUNCTION VALUE.
49504C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
49505C             FUNCTION VALUE PDF FOR THE FODLED T DISTRIBUTION
49506C             WITH DEGREES OF FREEDOM PARAMETER = NU.
49507C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
49508C     RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE.
49509C     OTHER DATAPAC   SUBROUTINES NEEDED--TPDF.
49510C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
49511C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
49512C     LANGUAGE--ANSI FORTRAN (1977)
49513C     REFERENCES--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
49514C                 UNIVARIATE DISTRIBUTIONS, VOLUME 2, 1994, PAGE 403,
49515C                 JOHN WILEY.
49516C                 PAGES 132-134.
49517C     WRITTEN BY--JAMES J. FILLIBEN
49518C                 STATISTICAL ENGINEERING LABORATORY (205.03)
49519C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
49520C                 GAITHERSBURG, MD 20899
49521C                 PHONE:  301-975-2855
49522C     ORIGINAL VERSION--NOVEMBER  2003.
49523C     UPDATED         --OCTOBER   2006. CALL LIST TO TPDF
49524C
49525C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
49526C
49527C-----COMMON----------------------------------------------------------
49528C
49529      INCLUDE 'DPCOP2.INC'
49530C
49531C---------------------------------------------------------------------
49532C
49533C     CHECK THE INPUT ARGUMENTS FOR ERRORS
49534C
49535      IF(X.LT.0.0)THEN
49536        WRITE(ICOUT,4)
49537        CALL DPWRST('XXX','BUG ')
49538        WRITE(ICOUT,5)
49539        CALL DPWRST('XXX','BUG ')
49540        WRITE(ICOUT,46)X
49541        CALL DPWRST('XXX','BUG ')
49542        PDF=0.0
49543        GOTO9999
49544      ENDIF
49545      IF(NU.LE.0)THEN
49546        WRITE(ICOUT,15)
49547        CALL DPWRST('XXX','BUG ')
49548        WRITE(ICOUT,47)NU
49549        CALL DPWRST('XXX','BUG ')
49550        PDF=0.0
49551        GOTO9999
49552      ENDIF
49553    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT')
49554    5 FORMAT('      TO THE FOLDED T PDF SUBROUTINE IS NEGATIVE *****')
49555   15 FORMAT('***** FATAL ERROR--THE DEGREES OF FREEDOM ARGUMENT ',
49556     1       'TO THE FOLDED T PDF SUBROUTINE IS NON-POSITIVE *****')
49557   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
49558   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
49559C
49560C-----START POINT-----------------------------------------------------
49561C
49562      CALL TPDF(X,REAL(NU),PDF)
49563      PDF=2.0*PDF
49564C
49565 9999 CONTINUE
49566      RETURN
49567      END
49568      SUBROUTINE FTPPF(P,NU,PPF)
49569C
49570C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
49571C              FUNCTION VALUE FOR THE FOLDED T DISTRIBUTION
49572C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
49573C              THIS DISTRIBUTION IS DEFINED FOR NON-NEGATIVE X
49574C              AND IS THE ABSOLUTE VALUE OF THE STUDENT'S T
49575C              DISTRIBUTION.
49576C              THE PERCENT POINT FUNCTION IS COMPUTED
49577C              FROM THE CORRESPONDING T PPF FUNCTION
49578C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE (BETWEEN
49579C                                0.0 AND 1.0) AT WHICH THE PERCENT
49580C                                POINT FUNCTION IS TO BE EVALUATED.
49581C                     --NU     = THE INTEGER NUMBER OF DEGREES
49582C                                OF FREEDOM.
49583C                                NU SHOULD BE POSITIVE.
49584C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT POINT
49585C                                FUNCTION VALUE.
49586C     OUTPUT--THE SINGLE PRECISION PERCENT POINT
49587C             FUNCTION VALUE PPF FOR THE FODLED T DISTRIBUTION
49588C             WITH DEGREES OF FREEDOM PARAMETER = NU.
49589C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
49590C     RESTRICTIONS--NU SHOULD BE A POSITIVE INTEGER VARIABLE.
49591C     OTHER DATAPAC   SUBROUTINES NEEDED--TPPF.
49592C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
49593C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
49594C     LANGUAGE--ANSI FORTRAN (1977)
49595C     REFERENCES--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
49596C                 UNIVARIATE DISTRIBUTIONS, VOLUME 2, 1994, PAGE 403,
49597C                 JOHN WILEY.
49598C                 PAGES 132-134.
49599C     WRITTEN BY--JAMES J. FILLIBEN
49600C                 STATISTICAL ENGINEERING LABORATORY (205.03)
49601C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
49602C                 GAITHERSBURG, MD 20899
49603C                 PHONE:  301-975-2855
49604C     ORIGINAL VERSION--NOVEMBER  2003.
49605C     UPDATED         --OCTOBER   2006. CALL LIST TO TPPF
49606C
49607C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
49608C
49609C-----COMMON----------------------------------------------------------
49610C
49611      INCLUDE 'DPCOP2.INC'
49612C
49613C---------------------------------------------------------------------
49614C
49615C     CHECK THE INPUT ARGUMENTS FOR ERRORS
49616C
49617      IF(P.LT.0.0 .OR. P.GE.1.0)THEN
49618        WRITE(ICOUT,4)
49619        CALL DPWRST('XXX','BUG ')
49620        WRITE(ICOUT,5)
49621        CALL DPWRST('XXX','BUG ')
49622        WRITE(ICOUT,6)
49623        CALL DPWRST('XXX','BUG ')
49624        WRITE(ICOUT,46)P
49625        CALL DPWRST('XXX','BUG ')
49626        PPF=0.0
49627        GOTO9999
49628      ENDIF
49629      IF(NU.LE.0)THEN
49630        WRITE(ICOUT,15)
49631        CALL DPWRST('XXX','BUG ')
49632        WRITE(ICOUT,47)NU
49633        CALL DPWRST('XXX','BUG ')
49634        PPF=0.0
49635        GOTO9999
49636      ENDIF
49637    4 FORMAT('***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT')
49638    5 FORMAT('      TO THE FOLDED T PPF SUBROUTINE IS OUTSIDE THE ')
49639    6 FORMAT('      ALLOWABLE (0,1] INTERVAL.')
49640   15 FORMAT('***** FATAL ERROR--THE DEGREES OF FREEDOM ARGUMENT ',
49641     1       'TO THE FOLDED T PPF SUBROUTINE IS NON-POSITIVE *****')
49642   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
49643   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
49644C
49645C-----START POINT-----------------------------------------------------
49646C
49647      ARG=(1.0+P)/2.0
49648      CALL TPPF(ARG,REAL(NU),PPF)
49649      IF(PPF.LE.0.0)PPF=0.0
49650C
49651 9999 CONTINUE
49652      RETURN
49653      END
49654      SUBROUTINE FTRAN(N,NU,ISEED,X)
49655C
49656C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
49657C              FROM THE FOLDED T DISTRIBUTION
49658C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
49659C              THE FOLDED T IS THE ABSOLUTE VALUE OF THE
49660C              STUDENT'S T DISTRIBUTION.
49661C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
49662C                                OF RANDOM NUMBERS TO BE
49663C                                GENERATED.
49664C                     --NU     = THE INTEGER DEGREES OF FREEDOM
49665C                                (PARAMETER) FOR THE FOLDED T
49666C                                DISTRIBUTION.
49667C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
49668C                                (OF DIMENSION AT LEAST N)
49669C                                INTO WHICH THE GENERATED
49670C                                RANDOM SAMPLE WILL BE PLACED.
49671C     OUTPUT--A RANDOM SAMPLE OF SIZE N
49672C             FROM THE FOLDED T DISTRIBUTION
49673C             WITH DEGREES OF FREEDOM PARAMETER = NU.
49674C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
49675C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
49676C                   OF N FOR THIS SUBROUTINE.
49677C                 --NU SHOULD BE A POSITIVE INTEGER VARIABLE.
49678C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
49679C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG, SQRT, SIN, COS.
49680C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
49681C     LANGUAGE--ANSI FORTRAN (1977)
49682C     REFERENCES--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
49683C                 UNIVARIATE DISTRIBUTIONS, VOLUME 2", 1994,
49684C                 JOHN WILEY, P. 403.
49685C                 ALGORITHM IS TO FIND T RANDOM NUMBERS AND THEN
49686C                 TAKE ABSOLUTE VALUE.
49687C     WRITTEN BY--JAMES J. FILLIBEN
49688C                 STATISTICAL ENGINEERING DIVISION
49689C                 INFORMATION TECHNOLOGY LABORATORY
49690C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
49691C                 GAITHERSBURG, MD 20899
49692C                 PHONE--301-975-2855
49693C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
49694C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
49695C     LANGUAGE--ANSI FORTRAN (1966)
49696C     VERSION NUMBER--2003.11
49697C     ORIGINAL VERSION--NOVEMBER  2003.
49698C
49699C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
49700C
49701C---------------------------------------------------------------------
49702C
49703      DIMENSION X(*)
49704      DIMENSION Y(2),Z(2)
49705C
49706C-----COMMON----------------------------------------------------------
49707C
49708      INCLUDE 'DPCOP2.INC'
49709C
49710C-----DATA STATEMENTS-------------------------------------------------
49711C
49712      DATA PI/3.14159265359/
49713C
49714C-----START POINT-----------------------------------------------------
49715C
49716C     CHECK THE INPUT ARGUMENTS FOR ERRORS
49717C
49718      IF(N.LT.1)THEN
49719        WRITE(ICOUT,5)
49720        CALL DPWRST('XXX','BUG ')
49721        WRITE(ICOUT,47)N
49722        CALL DPWRST('XXX','BUG ')
49723        GOTO9999
49724      ENDIF
49725      IF(NU.LE.0)THEN
49726        WRITE(ICOUT,15)
49727        CALL DPWRST('XXX','BUG ')
49728        WRITE(ICOUT,47)NU
49729        CALL DPWRST('XXX','BUG ')
49730        GOTO9999
49731      ENDIF
49732    5 FORMAT('***** FATAL ERROR--FOR THE FOLDED T DISTRIBUTION, THE',
49733     1'REQUESTED NUMBER OF RANDOM NUMBERS WAS NON-POSITIVE.')
49734   15 FORMAT('***** FATAL ERROR--FOR THE FOLDED T DISTRIBUTION, THE',
49735     1'SPECIFIED SHAPE PARAMETER WAS NON-POSITIVE.')
49736   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
49737C
49738C     GENERATE N STUDENT'S T RANDOM NUMBERS
49739C     USING THE DEFINITION THAT
49740C     A STUDENT'S T VARIATE WITH NU DEGREES OF FREEDOM
49741C     EQUALS A NORMAL VARIATE DIVIDED BY
49742C     A STANDARDIZED CHI VARIATE
49743C     (WHERE THE LATTER EQUALS SQRT(CHI-SQUARED/NU).
49744C     FIRST GENERATE A NORMAL RANDOM NUMBER,
49745C     THEN GENERATE A STANDARDIZED CHI RANDOM NUMBER,
49746C     THEN FORM THE RATIO OF THE FIRST DIVIDED BY
49747C     THE SECOND.
49748C
49749C     FOR FOLDED T, TAKE THE ABSOLUTE VALUE.
49750C
49751      ANU=NU
49752      DO100I=1,N
49753C
49754      CALL UNIRAN(2,ISEED,Y)
49755      ARG1=-2.0*LOG(Y(1))
49756      ARG2=2.0*PI*Y(2)
49757      ZNORM=(SQRT(ARG1))*(COS(ARG2))
49758C
49759      SUM=0.0
49760      DO200J=1,NU,2
49761      CALL UNIRAN(2,ISEED,Y)
49762      ARG1=-2.0*LOG(Y(1))
49763      ARG2=2.0*PI*Y(2)
49764      Z(1)=(SQRT(ARG1))*(COS(ARG2))
49765      Z(2)=(SQRT(ARG1))*(SIN(ARG2))
49766      SUM=SUM+Z(1)*Z(1)
49767      IF(J.EQ.NU)GOTO200
49768      SUM=SUM+Z(2)*Z(2)
49769  200 CONTINUE
49770C
49771      X(I)=ABS(ZNORM/SQRT(SUM/ANU))
49772C
49773  100 CONTINUE
49774C
49775 9999 CONTINUE
49776      RETURN
49777      END
49778      SUBROUTINE FORSLV(NR,N,A,X,B)
49779      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
49780C
49781C PURPOSE
49782C -------
49783C SOLVE  AX=B  WHERE A IS LOWER TRIANGULAR MATRIX
49784C
49785C PARAMETERS
49786C ----------
49787C NR           --> ROW DIMENSION OF MATRIX
49788C N            --> DIMENSION OF PROBLEM
49789C A(N,N)       --> LOWER TRIANGULAR MATRIX (PRESERVED)
49790C X(N)        <--  SOLUTION VECTOR
49791C B(N)         --> RIGHT-HAND SIDE VECTOR
49792C
49793C NOTE
49794C ----
49795C IF B IS NO LONGER REQUIRED BY CALLING ROUTINE,
49796C THEN VECTORS B AND X MAY SHARE THE SAME STORAGE.
49797C
49798      DIMENSION A(NR,*),X(*),B(*)
49799C
49800C SOLVE LX=B. (FOREWARD SOLVE)
49801C
49802      X(1)=B(1)/A(1,1)
49803      IF(N.EQ.1) RETURN
49804      DO 20 I=2,N
49805        SUM=0.0D0
49806        IM1=I-1
49807        DO 10 J=1,IM1
49808          SUM=SUM+A(I,J)*X(J)
49809   10   CONTINUE
49810        X(I)=(B(I)-SUM)/A(I,I)
49811   20 CONTINUE
49812      RETURN
49813      END
49814      SUBROUTINE FOUTRA(Y1,Y2,YC,SCRTCH,N1,ITCASE,IWRITE,Y12,IFTEXP,
49815     1                  IFTORD,Y3,Y4,N3,
49816     1                  IBUGA3,IERROR)
49817C
49818C     PURPOSE--CARRY OUT FOURIER TRANSFORM-TYPE OPERATIONS
49819C              OF THE COMPLEX DATA IN Y1 AND Y2.
49820C
49821C     OPERATIONS--FOURIER TRANSFORM
49822C                 INVERSE FOURIER TRANSFORM
49823C                 FFT
49824C                 INVERSE FFT
49825C
49826C     EXAMPLES--LET T1 T2 = FOURIER TRANSFORM Y1 Y2
49827C               LET Y1 Y2 = INVERSE FOURIER TRANSFORM T1 T2
49828C               LET T1 T2 = FFT Y1 Y2
49829C               LET Y1 Y2 = INVERSE FFT T1 T2
49830C     INPUT  ARGUMENTS--Y1 (REAL PART)       Y2 (IMAGINARY PART)
49831C     OUTPUT ARGUMENTS--Y3 (REAL PART)       Y4 (IMAGINARY PART)
49832C
49833C     NOTE--FOR THE FOURIER TRANSFORM AND THE FFT--
49834C              Y3(1) = A0 =
49835C              Y3(2) = A1
49836C              Y3(3) = A2
49837C              .
49838C              .
49839C              .
49840C              Y3(N) = A(N-1) =
49841C
49842C              Y4(1) = B0 =
49843C              Y4(2) = B1
49844C              Y4(3) = B2
49845C              .
49846C              .
49847C              .
49848C              Y4(N) = B(N-1) =
49849C
49850C     NOTE--IT IS NOT PERMISSIBLE TO HAVE THE OUTPUT VECTORS Y3(.) AND Y4(.)
49851C           BEING IDENTICAL TO THE INPUT VECTORS Y1(.) AND Y2(.).
49852C     WRITTEN BY--JAMES J. FILLIBEN
49853C                 STATISTICAL ENGINEERING DIVISION
49854C                 INFORMATION TECHNOLOGY LABORATORY
49855C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
49856C                 GAITHERSBURG, MD 20899
49857C                 PHONE--301-975-2855
49858C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
49859C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
49860C     LANGUAGE--ANSI FORTRAN (1977)
49861C     VERSION NUMBER--87/5
49862C     ORIGINAL VERSION--APRIL    1987.
49863C     UPDATED--SEPTEMBER 1987   (FFT AND INVERSE FFT)
49864C     UPDATED--AUGUST    1995   REPLACE NUMERICAL RECIPES ROUTINE
49865C                               WITH CMLIB ROUTINE.  ALSO, GO FROM
49866C                               1 TO N RATHER THAN -N/2 TO N/2.
49867C     UPDATED--DECEMBER  2009   MAKE YC REAL RATHER THAN COMPLEX
49868C                               TO ACCOMODATE INTEL VERSION 11
49869C                               COMPILER
49870C
49871C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
49872C
49873      CHARACTER*4 ITCASE
49874      CHARACTER*4 IWRITE
49875      CHARACTER*4 IFTEXP
49876CCCCC AUGUST 1995.  ADD FOLLOWING LINE
49877      CHARACTER*4 IFTORD
49878      CHARACTER*4 IBUGA3
49879      CHARACTER*4 IERROR
49880C
49881      CHARACTER*4 ISUBN1
49882      CHARACTER*4 ISUBN2
49883C
49884      CHARACTER*4 ITCAS2
49885C
49886C-----DOUBLE PRECISION STATEMENTS FOR NON-COMMON VARIABLES-------------------
49887C
49888      DOUBLE PRECISION DPI
49889      DOUBLE PRECISION DN1
49890      DOUBLE PRECISION DI
49891      DOUBLE PRECISION DK
49892      DOUBLE PRECISION DKM1
49893      DOUBLE PRECISION DOMEGA
49894      DOUBLE PRECISION DY1K
49895      DOUBLE PRECISION DY2K
49896C
49897      DOUBLE PRECISION DC
49898      DOUBLE PRECISION DS
49899      DOUBLE PRECISION DTCR
49900      DOUBLE PRECISION DTSR
49901      DOUBLE PRECISION DTCI
49902      DOUBLE PRECISION DTSI
49903      DOUBLE PRECISION DSUMCR
49904      DOUBLE PRECISION DSUMSR
49905      DOUBLE PRECISION DSUMCI
49906      DOUBLE PRECISION DSUMSI
49907CCCCC AUGUST 1995.  ADD FOLLOWING LINE
49908CCCCC COMPLEX YC
49909C
49910C---------------------------------------------------------------------
49911C
49912      DIMENSION Y1(*)
49913      DIMENSION Y2(*)
49914      DIMENSION Y3(*)
49915      DIMENSION Y4(*)
49916      DIMENSION Y12(*)
49917CCCCC AUGUST 1995.  ADD FOLLOWING 2 LINES.
49918      DIMENSION YC(*)
49919      DIMENSION SCRTCH(*)
49920C
49921C-----COMMON----------------------------------------------------------
49922C
49923      INCLUDE 'DPCOP2.INC'
49924C
49925C-----START POINT-----------------------------------------------------
49926C
49927      ISUBN1='FOUT'
49928      ISUBN2='RA  '
49929      IERROR='NO'
49930C
49931      DN1=(-999.0D0)
49932      ITCAS2='-999'
49933      DPI=3.14159265358979D0
49934C
49935      IF(IBUGA3.EQ.'ON')THEN
49936        WRITE(ICOUT,999)
49937  999   FORMAT(1X)
49938        CALL DPWRST('XXX','BUG ')
49939        WRITE(ICOUT,51)
49940   51   FORMAT('***** AT THE BEGINNING OF FOUTRA--')
49941        CALL DPWRST('XXX','BUG ')
49942        WRITE(ICOUT,52)IBUGA3,ITCASE,IWRITE,IFTEXP
49943   52   FORMAT('IBUGA3,ITCASE,IWRITE,IFTEXP = ',3(A4,2X),A4)
49944        CALL DPWRST('XXX','BUG ')
49945        WRITE(ICOUT,54)N1
49946   54   FORMAT('N1 = ',I8)
49947        CALL DPWRST('XXX','BUG ')
49948        DO55I=1,N1
49949          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y12(I)
49950   56     FORMAT('I,Y1(I),Y2(I),Y12(I) = ',I8,3G15.7)
49951          CALL DPWRST('XXX','BUG ')
49952   55   CONTINUE
49953      ENDIF
49954C
49955C               ***************************************************
49956C               **  CARRY OUT FOURIER TRANSFORM-TYPE OPERATIONS  **
49957C               ***************************************************
49958C
49959C               ********************************************
49960C               **  STEP 11--                             **
49961C               **  CHECK NUMBER OF INPUT OBSERVATIONS.   **
49962C               ********************************************
49963C
49964      IF(N1.LT.1)GOTO1100
49965      GOTO1190
49966C
49967 1100 CONTINUE
49968      IERROR='YES'
49969      WRITE(ICOUT,999)
49970      CALL DPWRST('XXX','BUG ')
49971      WRITE(ICOUT,1151)
49972 1151 FORMAT('***** ERROR IN FOUTRA--')
49973      CALL DPWRST('XXX','BUG ')
49974      WRITE(ICOUT,1152)
49975 1152 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
49976      CALL DPWRST('XXX','BUG ')
49977      WRITE(ICOUT,1153)
49978 1153 FORMAT('      IN THE VARIABLE FOR WHICH')
49979      CALL DPWRST('XXX','BUG ')
49980      IF(ITCASE.EQ.'FOUT'.OR.ITCASE.EQ.'FOU1')WRITE(ICOUT,1154)
49981 1154 FORMAT('      THE FOURIER TRANSFORM IS TO BE ',
49982     1'COMPUTED')
49983      IF(ITCASE.EQ.'FOUT'.OR.ITCASE.EQ.'FOU1')CALL DPWRST('XXX','BUG ')
49984      IF(ITCASE.EQ.'IFOU'.OR.ITCASE.EQ.'IFO1')WRITE(ICOUT,1155)
49985 1155 FORMAT('      THE INVERSE FOURIER TRANSFORM IS TO BE ',
49986     1'COMPUTED')
49987      IF(ITCASE.EQ.'IFOU'.OR.ITCASE.EQ.'IFO1')CALL DPWRST('XXX','BUG ')
49988      IF(ITCASE.EQ.'FFT'.OR.ITCASE.EQ.'FFT1')WRITE(ICOUT,1156)
49989 1156 FORMAT('      THE FFT IS TO BE ',
49990     1'COMPUTED')
49991      IF(ITCASE.EQ.'FFT'.OR.ITCASE.EQ.'FFT1')CALL DPWRST('XXX','BUG ')
49992      IF(ITCASE.EQ.'IFFT'.OR.ITCASE.EQ.'IFF1')WRITE(ICOUT,1157)
49993 1157 FORMAT('      THE INVERSE FFT IS TO BE ',
49994     1'COMPUTED')
49995      IF(ITCASE.EQ.'IFFT'.OR.ITCASE.EQ.'IFF1')CALL DPWRST('XXX','BUG ')
49996      WRITE(ICOUT,1181)
49997 1181 FORMAT('      MUST BE 1 OR LARGER.')
49998      CALL DPWRST('XXX','BUG ')
49999      WRITE(ICOUT,1182)
50000 1182 FORMAT('      SUCH WAS NOT THE CASE HERE.')
50001      CALL DPWRST('XXX','BUG ')
50002      WRITE(ICOUT,1183)N1
50003 1183 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
50004     1'.')
50005      CALL DPWRST('XXX','BUG ')
50006      GOTO9000
50007C
50008 1190 CONTINUE
50009C
50010C               *********************************
50011C               **  STEP 12--                  **
50012C               **  BRANCH TO THE PROPER CASE  **
50013C               *********************************
50014C
50015      IF(ITCASE.EQ.'FOUT')GOTO2100
50016      IF(ITCASE.EQ.'FOU1')GOTO2100
50017      IF(ITCASE.EQ.'IFOU')GOTO2100
50018      IF(ITCASE.EQ.'IFO1')GOTO2100
50019      IF(ITCASE.EQ.'FFT')GOTO2300
50020      IF(ITCASE.EQ.'FFT1')GOTO2300
50021      IF(ITCASE.EQ.'IFFT')GOTO2300
50022      IF(ITCASE.EQ.'IFF1')GOTO2300
50023C
50024      WRITE(ICOUT,999)
50025      CALL DPWRST('XXX','BUG ')
50026      WRITE(ICOUT,1211)
50027 1211 FORMAT('***** INTERNAL ERROR IN FOUTRA--')
50028      CALL DPWRST('XXX','BUG ')
50029      WRITE(ICOUT,1212)
50030 1212 FORMAT('      ITCASE NOT EQUAL TO')
50031      CALL DPWRST('XXX','BUG ')
50032      WRITE(ICOUT,1213)
50033 1213 FORMAT('      FOUT, FOU1, IFOU, IFO1')
50034      CALL DPWRST('XXX','BUG ')
50035      WRITE(ICOUT,1214)
50036 1214 FORMAT('      FFT, FFT1, IFFT, OR IFF1')
50037      CALL DPWRST('XXX','BUG ')
50038      WRITE(ICOUT,1215)
50039 1215 FORMAT('      ITCASE = ',A4)
50040      CALL DPWRST('XXX','BUG ')
50041      IERROR='YES'
50042      GOTO9000
50043C
50044C               ************************************************
50045C               **  STEP 21--                                 **
50046C               **  TREAT THE FOURIER TRANSFORM         CASE  **
50047C               **  TREAT THE INVERSE FOURIER TRANSFORM CASE  **
50048C               **  BY OPERATING ON THE REAL AND              **
50049C               **  COMPLEX PARTS,                            **
50050C               **  BY TAKING                                 **
50051C               **     COSINE TRANSFORM OF REAL      PART     **
50052C               **     SINE   TRANSFORM OF REAL      PART     **
50053C               **     COSINE TRANSFORM OF IMAGINARY PART     **
50054C               **     SINE   TRANSFORM OF IMAGINARY PART,    **
50055C               **  AND BY COMBINING PROPERLY.                **
50056C               ************************************************
50057C
50058 2100 CONTINUE
50059C
50060      DN1=N1
50061CCCCC AUGUST 1995.  FOLLOWING DEFINITION FOR FOURIER EXPONENT
50062CCCCC "+" CASE.  FOURIER EXPONENT "-" CASE USES OPPOSSITE
50063CCCCC DEFINITIONS.
50064CCCCC IF(ITCASE.EQ.'FOUT')ITCAS2='FT'
50065CCCCC IF(ITCASE.EQ.'FOU1')ITCAS2='FT'
50066CCCCC IF(ITCASE.EQ.'IFOU')ITCAS2='IFT'
50067CCCCC IF(ITCASE.EQ.'IFO1')ITCAS2='IFT'
50068      IF(IFTEXP.EQ.'+')THEN
50069        IF(ITCASE.EQ.'FOUT')ITCAS2='FT'
50070        IF(ITCASE.EQ.'FOU1')ITCAS2='FT'
50071        IF(ITCASE.EQ.'IFOU')ITCAS2='IFT'
50072        IF(ITCASE.EQ.'IFO1')ITCAS2='IFT'
50073      ELSE
50074        IF(ITCASE.EQ.'FOUT')ITCAS2='IFT'
50075        IF(ITCASE.EQ.'FOU1')ITCAS2='IFT'
50076        IF(ITCASE.EQ.'IFOU')ITCAS2='FT'
50077        IF(ITCASE.EQ.'IFO1')ITCAS2='FT'
50078      ENDIF
50079C
50080      L=N1/2
50081      M=0
50082      DO2110IP1=1,N1
50083      I=IP1-1
50084      L=L+1
50085      IF(L.GT.N1)L=1
50086      M=M+1
50087      DI=I
50088      DOMEGA=2.0*DPI*(DI/DN1)
50089      DSUMCR=0.0
50090      DSUMSR=0.0
50091      DSUMCI=0.0
50092      DSUMSI=0.0
50093C
50094CCCCC AUGUST 1995.  FOR 'STANDARD' ORDERING.
50095      IF(IFTORD.EQ.'STAN')THEN
50096        M2=0
50097      ELSE
50098        IF(ITCAS2.EQ.'FT')M2=0
50099        IF(ITCAS2.EQ.'IFT')M2=N1/2
50100      ENDIF
50101CCCCC END CHANGE
50102      DO2120K=1,N1
50103      DK=K
50104      DKM1=DK-1.0D0
50105      M2=M2+1
50106      IF(M2.GT.N1)M2=1
50107      DY1K=Y1(M2)
50108      DY2K=Y2(M2)
50109CCCCC DSUMCR=DSUMCR+DY1K*DCOS(DOMEGA*DKM1)
50110CCCCC DSUMSR=DSUMSR+DY1K*DSIN(DOMEGA*DKM1)
50111CCCCC DSUMCI=DSUMCI+DY2K*DCOS(DOMEGA*DKM1)
50112CCCCC DSUMSI=DSUMSI+DY2K*DSIN(DOMEGA*DKM1)
50113      DC=DCOS(DOMEGA*DKM1)
50114      DS=DSIN(DOMEGA*DKM1)
50115      DTCR=DC*DY1K
50116      DTSR=DS*DY1K
50117      DTCI=DC*DY2K
50118      DTSI=DS*DY2K
50119      DSUMCR=DSUMCR+DTCR
50120      DSUMSR=DSUMSR+DTSR
50121      DSUMCI=DSUMCI+DTCI
50122      DSUMSI=DSUMSI+DTSI
50123      IF(IBUGA3.EQ.'OFF')GOTO779
50124      WRITE(ICOUT,999)
50125      CALL DPWRST('XXX','BUG ')
50126      WRITE(ICOUT,774)I,K,M2,DY1K,DY2K
50127  774 FORMAT('I,K,M2,DY1K,DY2K = ',3I8,2E15.7)
50128      CALL DPWRST('XXX','BUG ')
50129      WRITE(ICOUT,775)DKM1,DOMEGA,DC,DS
50130  775 FORMAT('DKM1,DOMEGA,DC,DS = ',4E15.7)
50131      CALL DPWRST('XXX','BUG ')
50132      WRITE(ICOUT,776)DTCR,DTSR,DTCI,DTSI
50133  776 FORMAT('DTCR,DTSR,DTCI,DTSI = ',4E15.7)
50134      CALL DPWRST('XXX','BUG ')
50135      WRITE(ICOUT,778)DSUMCR,DSUMSR,DSUMCI,DSUMSI
50136  778 FORMAT('DSUMCR,DSUMSR,DSUMCI,DSUMSI = ',4E15.7)
50137      CALL DPWRST('XXX','BUG ')
50138  779 CONTINUE
50139 2120 CONTINUE
50140C
50141C     THE FOLLOWING COMMENTED OUT CODE IS APPROPRIATE
50142C     IF THE FORWARD TRANSFORM IS DEFINED WITH A - IN THE EXPONENT
50143C     (AS IS THE USUAL CLASSIC DEFINITION)
50144C
50145CCCCC IF(ITCAS2.EQ.'FT')Y3(L)=DSUMCR+DSUMSI
50146CCCCC IF(ITCAS2.EQ.'FT')Y4(L)=DSUMCI-DSUMSR
50147CCCCC IF(ITCAS2.EQ.'IFT')Y3(M)=(DSUMCR-DSUMSI)/DN1
50148CCCCC IF(ITCAS2.EQ.'IFT')Y4(M)=(DSUMCI+DSUMSR)/DN1
50149C
50150C     THE FOLLOWING CODE IS APPROPRIATE
50151C     IF THE FORWARD TRANSFORM IS DEFINED WITH A + IN THE EXPONENT
50152C     (AS DEFINED BY PRESS ET AL (NUMERICAL RECIPES))
50153C
50154CCCCC AUGUST 1995.  FIX FOR STANDARD ORDERING
50155      IF(IFTORD.EQ.'STAN')THEN
50156        IF(ITCAS2.EQ.'FT')Y3(M)=DSUMCR-DSUMSI
50157        IF(ITCAS2.EQ.'FT')Y4(M)=DSUMCI+DSUMSR
50158        IF(ITCAS2.EQ.'IFT')Y3(M)=(DSUMCR+DSUMSI)/DN1
50159        IF(ITCAS2.EQ.'IFT')Y4(M)=(DSUMCI-DSUMSR)/DN1
50160      ELSE
50161        IF(ITCAS2.EQ.'FT')Y3(L)=DSUMCR-DSUMSI
50162        IF(ITCAS2.EQ.'FT')Y4(L)=DSUMCI+DSUMSR
50163        IF(ITCAS2.EQ.'IFT')Y3(M)=(DSUMCR+DSUMSI)/DN1
50164        IF(ITCAS2.EQ.'IFT')Y4(M)=(DSUMCI-DSUMSR)/DN1
50165      ENDIF
50166C
50167      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,2121)I,IP1,L,M,DN1,DI
50168 2121 FORMAT('I,IP1,L,M,DN1,DI = ',4I8,2D15.7)
50169      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
50170      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,2122)DSUMCR,DSUMSR,DSUMCI,DSUMSI
50171 2122 FORMAT('DSUMCR,DSUMSR,DSUMCI,DSUMSI = ',4D15.7)
50172      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
50173      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,999)
50174      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
50175C
50176 2110 CONTINUE
50177      N3=N1
50178      GOTO9000
50179C
50180C               ************************************************
50181C               **  STEP 23--                                 **
50182C               **  TREAT THE FFT                       CASE  **
50183C               **  TREAT THE INVERSE FFT               CASE  **
50184C               **  (NOTE--N1 IS ASSUMED TO BE A POWER OF 2)  **
50185C               ************************************************
50186C
50187 2300 CONTINUE
50188C
50189      AN1=N1
50190      NN2=2*N1
50191C
50192CCCCC AUGUST 1995.  SET ISIGN CORRECTLY
50193      IF(IFTEXP.EQ.'+')THEN
50194        ISIGN=1
50195        IF(ITCASE.EQ.'IFFT')ISIGN=(-1)
50196        IF(ITCASE.EQ.'IFF1')ISIGN=(-1)
50197      ELSE
50198        ISIGN=(-1)
50199        IF(ITCASE.EQ.'IFFT')ISIGN=1
50200        IF(ITCASE.EQ.'IFF1')ISIGN=1
50201      ENDIF
50202CCCCC IF(ITCASE.EQ.'FFT')GOTO2310
50203CCCCC IF(ITCASE.EQ.'FFT1')GOTO2310
50204CCCCC AUGUST 1995.  BE CONSISTENT IN SCALING!!!
50205CCCCC ADD FOLLOWING 2 LINES
50206CCCCC IF(ITCASE.EQ.'IFFT')GOTO2310
50207CCCCC IF(ITCASE.EQ.'IFF1')GOTO2310
50208CCCCC GOTO2319
50209C2310 CONTINUE
50210CCCCC J=(-1)
50211CCCCC DO2311I=1,N1
50212CCCCC J=J+2
50213CCCCC JP1=J+1
50214CCCCC Y12(J)=Y1(I)
50215CCCCC Y12(JP1)=Y2(I)
50216C2311 CONTINUE
50217C2319 CONTINUE
50218C
50219CCCCC AUGUST 1995.  BE CONSISTENT IN SCALING!!!
50220CCCCC COMMENT OUT FOLLOWING 2 LINES
50221CCCCC IF(ITCASE.EQ.'IFFT')GOTO2320
50222CCCCC IF(ITCASE.EQ.'IFF1')GOTO2320
50223CCCCC GOTO2329
50224C2320 CONTINUE
50225CCCCC J=N1-1
50226CCCCC DO2321I=1,N1
50227CCCCC J=J+2
50228CCCCC IF(J.GT.NN2)J=1
50229CCCCC JP1=J+1
50230CCCCC Y12(J)=Y1(I)
50231CCCCC Y12(JP1)=Y2(I)
50232C2321 CONTINUE
50233C2329 CONTINUE
50234C
50235CCCCC AUGUST 1995.  FOR CMLIB ROUTINE, STORE IN A COMPLEX ARRAY.
50236CCCCC NOTE THAT DATAPLOT ORDER IMPLIES (-N/2,N/2) RATHER THAN
50237CCCCC (1,N).
50238C
50239      IF(IFTORD.EQ.'STAN')THEN
50240        DO2360I=1,N1
50241          I1=2*(I-1)+1
50242          I2=I1+1
50243CCCCC     YC(I)=CMPLX(Y1(I),Y2(I))
50244          YC(I1)=Y1(I1)
50245          YC(I2)=Y2(I2)
50246 2360   CONTINUE
50247      ELSE
50248        IF(ISIGN.LT.0)THEN
50249          J=N1/2
50250          DO2363I=1,N1
50251            J=J+1
50252            IF(J.GT.N1)J=1
50253            I1=2*(I-1)+1
50254            I2=I1+1
50255CCCCC       YC(J)=CMPLX(Y1(I),Y2(I))
50256            YC(I1)=Y1(I1)
50257            YC(I2)=Y2(I2)
50258 2363     CONTINUE
50259        ELSE
50260          DO2368I=1,N1
50261            I1=2*(I-1)+1
50262            I2=I1+1
50263CCCCC       YC(I)=CMPLX(Y1(I),Y2(I))
50264            YC(I1)=Y1(I1)
50265            YC(I2)=Y2(I2)
50266 2368     CONTINUE
50267        ENDIF
50268      ENDIF
50269C
50270CCCCC AUGUST 1995.  DETERMINE VALUE OF ISIGN BEFORE CREATE INPUT FILE.
50271CCCCC ISIGN=1
50272CCCCC IF(ITCASE.EQ.'IFFT')ISIGN=(-1)
50273CCCCC IF(ITCASE.EQ.'IFF1')ISIGN=(-1)
50274CCCCC IF(IFTEXP.EQ.'+')ISIGN=(-ISIGN)
50275C
50276      IF(IBUGA3.EQ.'OFF')GOTO2333
50277      DO2331I=1,NN2
50278CCCCC WRITE(ICOUT,2332)I,NN2,Y12(I)
50279      I1=2*(I-1)+1
50280      I2=I1+1
50281      WRITE(ICOUT,2332)I,NN2,YC(I1),YC(I2)
50282 2332 FORMAT('I,NN2,YC(I) = ',2I8,2E15.7)
50283      CALL DPWRST('XXX','BUG ')
50284 2331 CONTINUE
50285 2333 CONTINUE
50286C
50287CCCCC CALL FOUR1(Y12,NN2,ISIGN)
50288CCCCC AUGUST 1995.  REPLACE NUMERICAL RECIPES ROUTINES WITH
50289CCCCC CMLIB ROUTINE.
50290CCCCC CALL FOUR1(Y12,N1,ISIGN)
50291      CALL CFFTI(N1,SCRTCH)
50292      IF(ISIGN.LT.0)THEN
50293        CALL CFFTF(N1,YC,SCRTCH)
50294      ELSE
50295        CALL CFFTB(N1,YC,SCRTCH)
50296      ENDIF
50297C
50298      IF(IBUGA3.EQ.'OFF')GOTO2337
50299      DO2335I=1,NN2
50300CCCCC WRITE(ICOUT,2336)I,NN2,Y12(I)
50301      I1=2*(I-1)+1
50302      I2=I1+1
50303      WRITE(ICOUT,2336)I,NN2,YC(I1),YC(I2)
50304 2336 FORMAT('I,NN2,YC(I) = ',2I8,2E15.7)
50305      CALL DPWRST('XXX','BUG ')
50306 2335 CONTINUE
50307 2337 CONTINUE
50308C
50309CCCCC AUGUST 1995.  BE CONSISTENT IN SCALING!!!
50310CCCCC COMMENT OUT FOLLOWING 2 LINES
50311CCCCC IF(ITCASE.EQ.'FFT')GOTO2340
50312CCCCC IF(ITCASE.EQ.'FFT1')GOTO2340
50313CCCCC GOTO2349
50314C2340 CONTINUE
50315CCCCC J=N1-1
50316CCCCC DO2341I=1,N1
50317CCCCC J=J+2
50318CCCCC IF(J.GT.NN2)J=1
50319CCCCC JP1=J+1
50320CCCCC Y3(I)=Y12(J)
50321CCCCC Y4(I)=Y12(JP1)
50322C2341 CONTINUE
50323C2349 CONTINUE
50324C
50325CCCCC AUGUST 1995.  BE CONSISTENT IN SCALING!!!
50326CCCCC ADD FOLLOWING 2 LINES
50327CCCCC IF(ITCASE.EQ.'FFT')GOTO2350
50328CCCCC IF(ITCASE.EQ.'FFT1')GOTO2350
50329CCCCC IF(ITCASE.EQ.'IFFT')GOTO2350
50330CCCCC IF(ITCASE.EQ.'IFF1')GOTO2350
50331CCCCC GOTO2359
50332C2350 CONTINUE
50333CCCCC J=(-1)
50334CCCCC AUGUST 1995.  RETURN THE DATA IN "STANDARD" ORDER OR IN
50335CCCCC "DATAPLOT" ORDER.  "STANDARD" ORDER IS WHAT IS RETURNED BY
50336CCCCC CFFTF AND CFFTB ROUTINES
50337      IF(IFTORD.EQ.'STAN')THEN
50338        DO2351I=1,N1
50339CCCCC     J=J+2
50340CCCCC     JP1=J+1
50341CCCCC     Y3(I)=Y12(J)/AN1
50342CCCCC     Y4(I)=Y12(JP1)/AN1
50343          I1=2*(I-1)+1
50344          I2=I1+1
50345CCCCC     Y3(I)=REAL(YC(I))
50346CCCCC     Y4(I)=AIMAG(YC(I))
50347          Y3(I)=YC(I1)
50348          Y4(I)=YC(I2)
50349 2351   CONTINUE
50350      ELSE
50351        IF(ISIGN.GT.0)THEN
50352          J=N1/2
50353          DO2356I=1,N1
50354            J=J+1
50355            IF(J.GT.N1)J=1
50356            I1=2*(J-1)+1
50357            I2=I1+1
50358CCCCCC      Y3(I)=REAL(YC(J))
50359CCCCCC      Y4(I)=AIMAG(YC(J))
50360            Y3(I)=YC(I1)
50361            Y4(I)=YC(I2)
50362 2356     CONTINUE
50363        ELSE
50364          DO2358I=1,N1
50365            I1=2*(I-1)+1
50366            I2=I1+1
50367CCCCC       Y3(I)=REAL(YC(I))
50368CCCCC       Y4(I)=AIMAG(YC(I))
50369            Y3(I)=YC(I1)
50370            Y4(I)=YC(I2)
50371 2358     CONTINUE
50372        ENDIF
50373      ENDIF
50374C2359 CONTINUE
50375C
50376C
50377CCCCC AUGUST 1995.  DIVIDE BY N IF ISIGN IS -1
50378      IF(ISIGN.LT.0.0)THEN
50379        DO2370I=1,N1
50380          Y3(I)=Y3(I)/AN1
50381          Y4(I)=Y4(I)/AN1
50382 2370   CONTINUE
50383      ENDIF
50384C
50385      N3=N1
50386      GOTO9000
50387C
50388C               *****************
50389C               **  STEP 90--  **
50390C               **  EXIT.      **
50391C               *****************
50392C
50393 9000 CONTINUE
50394C
50395      IF(IBUGA3.EQ.'OFF')GOTO9090
50396      WRITE(ICOUT,999)
50397      CALL DPWRST('XXX','BUG ')
50398      WRITE(ICOUT,9011)
50399 9011 FORMAT('***** AT THE END       OF FOUTRA--')
50400      CALL DPWRST('XXX','BUG ')
50401      WRITE(ICOUT,9012)IBUGA3,ITCASE,IWRITE,IERROR
50402 9012 FORMAT('IBUGA3,ITCASE,IWRITE,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
50403      CALL DPWRST('XXX','BUG ')
50404      WRITE(ICOUT,9013)IFTEXP
50405 9013 FORMAT('IFTEXP = ',A4)
50406      CALL DPWRST('XXX','BUG ')
50407      WRITE(ICOUT,9014)N1,N3,NN2,ISIGN,ITCAS2
50408 9014 FORMAT('N1,N3,NN2,ISIGN,ITCAS2 = ',4I8,2X,A4)
50409      CALL DPWRST('XXX','BUG ')
50410      DO9015I=1,N1
50411      WRITE(ICOUT,9016)I,Y1(I),Y2(I),Y3(I),Y4(I)
50412 9016 FORMAT('I,Y1(I),Y2(I),Y3(I),Y4(I) = ',I8,4E15.7)
50413      CALL DPWRST('XXX','BUG ')
50414 9015 CONTINUE
50415      DO9025I=1,NN2
50416      WRITE(ICOUT,9026)I,NN2,YC(I)
50417 9026 FORMAT('I,NN2,YC(I) = ',2I8,2E15.7)
50418      CALL DPWRST('XXX','BUG ')
50419 9025 CONTINUE
50420 9090 CONTINUE
50421C
50422      RETURN
50423      END
50424      SUBROUTINE FPDF(X,NU1,NU2,PDF)
50425C
50426C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
50427C              FUNCTION VALUE FOR F DISTRIBUTION
50428C              WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU1 AND NU2.
50429C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
50430C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
50431C              IN THE REFERENCES BELOW.
50432C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
50433C                                WHICH THE PROBABILITY DENSITY
50434C                                FUNCTION IS TO BE EVALUATED.
50435C                                X SHOULD BE NON-NEGATIVE.
50436C                     --NU1    = THE INTEGER NUMBER OF DEGREES
50437C                                OF FREEDOM.
50438C                                NU1 SHOULD BE POSITIVE.
50439C                     --NU2    = THE INTEGER NUMBER OF DEGREES
50440C                                OF FREEDOM.
50441C                                NU2 SHOULD BE POSITIVE.
50442C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
50443C                                DENSITY FUNCTION VALUE.
50444C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
50445C             FUNCTION VALUE PDF FOR THE STUDENT'S T DISTRIBUTION
50446C             WITH DEGREES OF FREEDOM PARAMETER = NU.
50447C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
50448C     RESTRICTIONS--NU1 AND NU2 SHOULD BE A POSITIVE INTEGER VARIABLE.
50449C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
50450C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
50451C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
50452C     LANGUAGE--ANSI FORTRAN (1977)
50453C     REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHMATICS
50454C                 SERIES 55, 1964, PAGE 946, FORMULA 26.6.1.
50455C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
50456C                 DISTRIBUTIONS--2, 1970, PAGES XXX.
50457C     WRITTEN BY--JAMES J. FILLIBEN
50458C                 STATISTICAL ENGINEERING DIVISION
50459C                 INFORMATION TECHNOLOGY LABORATORY
50460C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
50461C                 GAITHERSBURG, MD 20899
50462C                 PHONE--301-975-2855
50463C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
50464C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
50465C     LANGUAGE--ANSI FORTRAN (1966)
50466C     VERSION NUMBER--82/7
50467C     ORIGINAL VERSION--AUGUST    1977.
50468C     UPDATED         --NOVEMBER  1981.
50469C     UPDATED         --MAY       1982.
50470C
50471C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
50472C
50473C---------------------------------------------------------------------
50474C
50475      DOUBLE PRECISION DX
50476      DOUBLE PRECISION DNU1
50477      DOUBLE PRECISION DNU2
50478      DOUBLE PRECISION DNU1H
50479      DOUBLE PRECISION DNU2H
50480      DOUBLE PRECISION DNU12H
50481      DOUBLE PRECISION DGF1
50482      DOUBLE PRECISION DGF2
50483      DOUBLE PRECISION DGF12
50484      DOUBLE PRECISION DTERM
50485      DOUBLE PRECISION DTERM1
50486      DOUBLE PRECISION DTERM2
50487      DOUBLE PRECISION DTERM3
50488      DOUBLE PRECISION DTERM4
50489      DOUBLE PRECISION DTERM5
50490      DOUBLE PRECISION DCONST
50491C
50492C-----COMMON----------------------------------------------------------
50493C
50494      INCLUDE 'DPCOP2.INC'
50495C
50496C-----START POINT-----------------------------------------------------
50497C
50498C               ********************************************
50499C               **  STEP 1--                              **
50500C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
50501C               ********************************************
50502C
50503      IF(NU1.LE.0)GOTO110
50504      GOTO119
50505  110 CONTINUE
50506      WRITE(ICOUT,115)
50507  115 FORMAT('***** FATAL ERROR--THE SECOND INPUT ARGUMENT ',
50508     1'TO THE   FPDF   SUBROUTINE IS NON-POSITIVE *****')
50509      CALL DPWRST('XXX','BUG ')
50510      WRITE(ICOUT,117)NU1
50511  117 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,
50512     1' *****')
50513      CALL DPWRST('XXX','BUG ')
50514      PDF=0.0
50515      GOTO9000
50516  119 CONTINUE
50517C
50518      IF(NU2.LE.0)GOTO120
50519      GOTO129
50520  120 CONTINUE
50521      WRITE(ICOUT,125)
50522  125 FORMAT('***** FATAL ERROR--THE SECOND INPUT ARGUMENT ',
50523     1'TO THE   FPDF   SUBROUTINE IS NON-POSITIVE *****')
50524      CALL DPWRST('XXX','BUG ')
50525      WRITE(ICOUT,127)NU2
50526  127 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,
50527     1' *****')
50528      CALL DPWRST('XXX','BUG ')
50529      PDF=0.0
50530      GOTO9000
50531  129 CONTINUE
50532C
50533C               ****************************************************************
50534C               **  STEP 2--
50535C               **  COMPUTE THE CONSTANT = ((NU1**(NU1/2))*(NU2**(NU2/2))/(BETA(
50536C               ****************************************************************
50537C
50538      DX=X
50539      DNU1=NU1
50540      DNU2=NU2
50541      DNU1H=DNU1/2.0
50542      DNU2H=DNU2/2.0
50543C
50544      DTERM1=DNU1**DNU1H
50545      DTERM2=DNU2**DNU2H
50546      CALL DGAMMF(DNU1H,DGF1)
50547      CALL DGAMMF(DNU2H,DGF2)
50548      DNU12H=DNU1H+DNU2H
50549      CALL DGAMMF(DNU12H,DGF12)
50550      DTERM3=(DGF1*DGF2)/DGF12
50551      DCONST=(DTERM1*DTERM2)/DTERM3
50552C
50553C               ************************************
50554C               **  STEP 3--                      **
50555C               **  COMPUTE THE DENSITY FUNCTION  **
50556C               ************************************
50557C
50558      IF(DX.LE.0.0D0)PDF=0.0
50559      IF(DX.LE.0.0D0)GOTO9000
50560C
50561      DTERM4=DX**(DNU1H-1.0D0)
50562      DTERM5=(DNU2+DNU1*DX)**(-DNU1H-DNU2H)
50563      DTERM=DTERM4*DTERM5
50564      PDF=DCONST*DTERM
50565      GOTO9000
50566C
50567 9000 CONTINUE
50568      RETURN
50569      END
50570      SUBROUTINE FPPF(P,NU1,NU2,PPF)
50571C
50572C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
50573C              FOR THE F DISTRIBUTION
50574C              WITH INTEGER DEGREES OF FREEDOM
50575C              PARAMETERS = NU1 AND NU2.
50576C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
50577C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
50578C              IN THE REFERENCES BELOW.
50579C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE
50580C                                (BETWEEN 0.0 AND 1.0)
50581C                                AT WHICH THE PERCENT POINT
50582C                                FUNCTION IS TO BE EVALUATED.
50583C                     --NU1    = THE INTEGER DEGREES OF FREEDOM
50584C                                FOR THE NUMERATOR OF THE F RATIO.
50585C                                NU1 SHOULD BE POSITIVE.
50586C                     --NU2    = THE INTEGER DEGREES OF FREEDOM
50587C                                FOR THE DENOMINATOR OF THE F RATIO.
50588C                                NU2 SHOULD BE POSITIVE.
50589C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT POINT
50590C                                FUNCTION VALUE.
50591C     OUTPUT--THE SINGLE PRECISION PERCENT POINT
50592C             FUNCTION VALUE PPF FOR THE F DISTRIBUTION
50593C             WITH DEGREES OF FREEDOM
50594C             PARAMETERS = NU1 AND NU2.
50595C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
50596C     RESTRICTIONS--P SHOULD BE BETWEEN
50597C                   0.0 (INCLUSIVELY) AND 1.0 (EXCLUSIVELY).
50598C                 --NU1 SHOULD BE A POSITIVE INTEGER VARIABLE.
50599C                 --NU2 SHOULD BE A POSITIVE INTEGER VARIABLE.
50600C     OTHER DATAPAC   SUBROUTINES NEEDED--FCDF, NORCDF, CHSCDF.
50601C     FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DATAN.
50602C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
50603C     LANGUAGE--ANSI FORTRAN (1977)
50604C     REFERENCES--NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY APPLIED MATHEMATICS
50605C                 SERIES 55, 1964, PAGES 946-947,
50606C                 FORMULAE 26.6.4, 26.6.5, 26.6.8, AND 26.6.15.
50607C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
50608C                 DISTRIBUTIONS--2, 1970, PAGE 83, FORMULA 20,
50609C                 AND PAGE 84, THIRD FORMULA.
50610C               --PAULSON, AN APPROXIMATE NORMAILIZATION
50611C                 OF THE ANALYSIS OF VARIANCE DISTRIBUTION,
50612C                 ANNALS OF MATHEMATICAL STATISTICS, 1942,
50613C                 NUMBER 13, PAGES 233-135.
50614C               --SCHEFFE AND TUKEY, A FORMULA FOR SAMPLE SIZES
50615C                 FOR POPULATION TOLERANCE LIMITS, 1944,
50616C                 NUMBER 15, PAGE 217.
50617C     WRITTEN BY--JAMES J. FILLIBEN
50618C                 STATISTICAL ENGINEERING DIVISION
50619C                 INFORMATION TECHNOLOGY LABORATORY
50620C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
50621C                 GAITHERSBURG, MD 20899
50622C                 PHONE--301-975-2855
50623C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
50624C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
50625C     LANGUAGE--ANSI FORTRAN (1966)
50626C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
50627C                          DENOTED BY QUOTES RATHER THAN NH.
50628C     VERSION NUMBER--82/7
50629C     ORIGINAL VERSION--MAY       1978.
50630C     UPDATED         --AUGUST    1979.
50631C     UPDATED         --DECEMBER  1981.
50632C     UPDATED         --MAY       1982.
50633C
50634C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
50635C
50636C-----COMMON----------------------------------------------------------
50637C
50638      INCLUDE 'DPCOP2.INC'
50639C
50640C-----START POINT-----------------------------------------------------
50641C
50642C     CHECK THE INPUT ARGUMENTS FOR ERRORS
50643C
50644      PPF=0.0
50645      IF(NU1.LE.0)THEN
50646        WRITE(ICOUT,15)
50647   15   FORMAT('***** ERROR--THE SECOND ARGUMENT TO FPPF IS ',
50648     1         'NON-POSITIVE.')
50649        CALL DPWRST('XXX','BUG ')
50650        WRITE(ICOUT,47)NU1
50651        CALL DPWRST('XXX','BUG ')
50652        GOTO9000
50653      ELSEIF(NU2.LE.0)THEN
50654        WRITE(ICOUT,23)
50655   23   FORMAT('***** ERROR--THE THIRD ARGUMENT TO FPPF IS ',
50656     1         'FCDF NON-POSITIVE.')
50657        CALL DPWRST('XXX','BUG ')
50658        WRITE(ICOUT,47)NU2
50659        CALL DPWRST('XXX','BUG ')
50660        GOTO9000
50661      ELSEIF(P.LT.0.0.OR.P.GE.1.0)THEN
50662        WRITE(ICOUT,4)
50663    4   FORMAT('***** ERROR--THE FIRST ARGUMENT TO FPPF IS ',
50664     1         'OUTSIDE THE ALLOWABLE (0,1) INTERVAL.')
50665        CALL DPWRST('XXX','BUG ')
50666        WRITE(ICOUT,46)P
50667        CALL DPWRST('XXX','BUG ')
50668        GOTO9000
50669      ENDIF
50670   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',G15.7,'.')
50671   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,'.')
50672C
50673C-----START POINT-----------------------------------------------------
50674C
50675      IBUG=0
50676      TOL=0.000001
50677      MAXIT=100
50678      XMIN=0.0
50679      XMAX=10.0**30
50680      XLOW=XMIN
50681      XUP=XMAX
50682C
50683      ANU1=NU1
50684      ANU2=NU2
50685C
50686      EXPF=0.5*((1.0/ANU2)-(1.0/ANU1))
50687      SDF=SQRT(0.5*((1.0/ANU2)+(1.0/ANU1)))
50688      CALL NORPPF(P,ZN)
50689      XN=EXPF+ZN*SDF
50690      XMID=EXP(2*XN)
50691      IF(IBUG.EQ.1)THEN
50692        WRITE(ICOUT,101)XMID
50693  101   FORMAT('XMID = ',G15.7)
50694        CALL DPWRST('XXX','BUG ')
50695      ENDIF
50696C
50697      IF(P.EQ.0.0)THEN
50698        PPF=XMIN
50699        GOTO9000
50700      ENDIF
50701C
50702      ICOUNT=0
50703C
50704  200 CONTINUE
50705      X=XMID
50706      CALL FCDF(X,NU1,NU2,PCALC)
50707      IF(PCALC.EQ.P)GOTO240
50708      IF(PCALC.GT.P)GOTO220
50709C
50710  210 CONTINUE
50711      XLOW=XMID
50712      X=XMID*2.0
50713      IF(X.GE.XUP)GOTO211
50714      XMID=X
50715      IF(IBUG.EQ.1)THEN
50716        WRITE(ICOUT,101)XMID
50717        CALL DPWRST('XXX','BUG ')
50718      ENDIF
50719      CALL FCDF(X,NU1,NU2,PCALC)
50720      IF(PCALC.EQ.P)GOTO240
50721      IF(PCALC.LT.P)GOTO210
50722      XUP=X
50723  211 CONTINUE
50724      XMID=(XLOW+XUP)/2.0
50725      IF(IBUG.EQ.1)THEN
50726        WRITE(ICOUT,101)XMID
50727        CALL DPWRST('XXX','BUG ')
50728      ENDIF
50729      GOTO230
50730C
50731  220 CONTINUE
50732      XUP=XMID
50733      X=XMID/2.0
50734      IF(X.LE.XLOW)GOTO221
50735      XMID=X
50736      IF(IBUG.EQ.1)THEN
50737        WRITE(ICOUT,101)XMID
50738        CALL DPWRST('XXX','BUG ')
50739      ENDIF
50740      CALL FCDF(X,NU1,NU2,PCALC)
50741      IF(PCALC.EQ.P)GOTO240
50742      IF(PCALC.GT.P)GOTO220
50743      XLOW=X
50744  221 CONTINUE
50745      XMID=(XLOW+XUP)/2.0
50746      IF(IBUG.EQ.1)WRITE(ICOUT,101)XMID
50747      IF(IBUG.EQ.1)CALL DPWRST('XXX','BUG ')
50748      GOTO230
50749C
50750  230 CONTINUE
50751      XDEL=ABS(XMID-XLOW)
50752      ICOUNT=ICOUNT+1
50753      IF(XDEL.LT.TOL.OR.ICOUNT.GT.MAXIT)GOTO240
50754      GOTO200
50755C
50756  240 CONTINUE
50757      PPF=XMID
50758C
50759 9000 CONTINUE
50760      RETURN
50761      END
50762      DOUBLE PRECISION FUNCTION fpser(a,b,x,eps)
50763C-----------------------------------------------------------------------
50764C
50765C                 EVALUATION OF I (A,B)
50766C                                X
50767C
50768C          FOR B .LT. MIN(EPS,EPS*A) AND X .LE. 0.5.
50769C
50770C-----------------------------------------------------------------------
50771C
50772C                  SET  FPSER = X**A
50773C
50774C     .. Scalar Arguments ..
50775      DOUBLE PRECISION a,b,eps,x
50776C     ..
50777C     .. Local Scalars ..
50778      DOUBLE PRECISION an,c,s,t,tol
50779C     ..
50780C     .. External Functions ..
50781      DOUBLE PRECISION exparg
50782      EXTERNAL exparg
50783C     ..
50784C     .. Intrinsic Functions ..
50785      INTRINSIC abs,dlog,exp
50786C     ..
50787C     .. Executable Statements ..
50788
50789      fpser = 1.0D0
50790      IF (a.LE.1.D-3*eps) GO TO 10
50791      fpser = 0.0D0
50792      t = a*dlog(x)
50793      IF (t.LT.exparg(1)) RETURN
50794      fpser = exp(t)
50795C
50796C                NOTE THAT 1/B(A,B) = B
50797C
50798   10 fpser = (b/a)*fpser
50799      tol = eps/a
50800      an = a + 1.0D0
50801      t = x
50802      s = t/an
50803   20 an = an + 1.0D0
50804      t = x*t
50805      c = t/an
50806      s = s + c
50807      IF (abs(c).GT.tol) GO TO 20
50808C
50809      fpser = fpser* (1.0D0+a*s)
50810      RETURN
50811
50812      END
50813      SUBROUTINE FRACTA(X1,Y1,N1,IWRITE,
50814     1X2,Y2,N2,IBUGA3,IERROR)
50815C
50816C     PURPOSE--CARRY OUT FRACTAL GENERATION
50817C              OF THE DATA IN X1 AND Y1.
50818C
50819C     EXAMPLES--LET X1 Y1 = FRACTAL X2 Y2
50820C     INPUT  ARGUMENTS--X1 (X COOR)       Y1 (Y COOR)
50821C     OUTPUT ARGUMENTS--X2 (X COOR)       Y2 (Y COOR)
50822C
50823C     NOTE--FOR STEP 1 OF THE LOOP
50824C           (2 POINTS IN AND 5 POINTS OUT)
50825C           (1 LINE IN AND 4 LINES OUT)--
50826C
50827C            X2(1) = X1(1)
50828C            X2(2) = X1(1) + (1/3)DELX
50829C            X2(3) = X1(1) + (1/2)DELX - (SQRT(3)/6)DELY
50830C            X2(4) = X1(1) + (2/3)DELX
50831C            X2(5) = X1(2)
50832C
50833C            Y2(1) = Y1(1)
50834C            Y2(2) = Y1(1) + (1/3)DELY
50835C            Y2(3) = Y1(1) + (1/2)DELY + (SQRT(3)/6)DELX
50836C            Y2(4) = Y1(1) + (2/3)DELY
50837C            Y2(5) = Y1(2)
50838C
50839C     NOTE--IT IS NOT PERMISSIBLE TO HAVE THE OUTPUT VECTORS X2(.) AND Y2(.)
50840C           BEING IDENTICAL TO THE INPUT VECTORS X1(.) AND Y1(.).
50841C     WRITTEN BY--JAMES J. FILLIBEN
50842C                 STATISTICAL ENGINEERING DIVISION
50843C                 INFORMATION TECHNOLOGY LABORATORY
50844C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
50845C                 GAITHERSBURG, MD 20899
50846C                 PHONE--301-975-2855
50847C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
50848C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
50849C     LANGUAGE--ANSI FORTRAN (1977)
50850C     REFERENCE--RUCKER. INFINITY AND THE MIND, PAGE 9.
50851C     VERSION NUMBER--88/10
50852C     ORIGINAL VERSION--JULY     1988.
50853C
50854C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
50855C
50856      CHARACTER*4 IWRITE
50857      CHARACTER*4 IBUGA3
50858      CHARACTER*4 IERROR
50859C
50860      CHARACTER*4 ISUBN1
50861      CHARACTER*4 ISUBN2
50862C
50863C---------------------------------------------------------------------
50864C
50865      DIMENSION X1(*)
50866      DIMENSION Y1(*)
50867      DIMENSION X2(*)
50868      DIMENSION Y2(*)
50869C
50870C-----COMMON----------------------------------------------------------
50871C
50872      INCLUDE 'DPCOP2.INC'
50873C
50874C-----START POINT-----------------------------------------------------
50875C
50876      ISUBN1='FRAC'
50877      ISUBN2='TA  '
50878      IERROR='NO'
50879C
50880      IF(IBUGA3.EQ.'OFF')GOTO90
50881        WRITE(ICOUT,999)
50882  999   FORMAT(1X)
50883        CALL DPWRST('XXX','BUG ')
50884        WRITE(ICOUT,51)
50885   51   FORMAT('***** AT THE BEGINNING OF FRACTA--')
50886        CALL DPWRST('XXX','BUG ')
50887        WRITE(ICOUT,52)IBUGA3,IWRITE
50888   52   FORMAT('IBUGA3,IWRITE = ',A4,2X,A4)
50889        CALL DPWRST('XXX','BUG ')
50890        WRITE(ICOUT,54)N1
50891   54   FORMAT('N1 = ',I8)
50892        CALL DPWRST('XXX','BUG ')
50893        DO55I=1,N1
50894        WRITE(ICOUT,56)I,X1(I),Y1(I)
50895   56   FORMAT('I,X1(I),Y1(I) = ',I8,2E15.7)
50896        CALL DPWRST('XXX','BUG ')
50897   55   CONTINUE
50898   90 CONTINUE
50899C
50900C                 *******************************************************
50901C                 **  CARRY OUT FOURIER FRACTAL-GENERATION OPERATIONS  **
50902C                 *******************************************************
50903C
50904C                 ********************************************
50905C                 **  STEP 11--                             **
50906C                 **  CHECK NUMBER OF INPUT OBSERVATIONS.   **
50907C                 ********************************************
50908C
50909        IF(N1.LT.2)GOTO1100
50910        GOTO1190
50911C
50912 1100 CONTINUE
50913      IERROR='YES'
50914      WRITE(ICOUT,999)
50915      CALL DPWRST('XXX','BUG ')
50916      WRITE(ICOUT,1151)
50917 1151 FORMAT('***** ERROR IN FRACTA--')
50918      CALL DPWRST('XXX','BUG ')
50919      WRITE(ICOUT,1152)
50920 1152 FORMAT('        THE INPUT NUMBER OF OBSERVATIONS')
50921      CALL DPWRST('XXX','BUG ')
50922      WRITE(ICOUT,1153)
50923 1153 FORMAT('        IN THE VARIABLES FROM WHICH')
50924      CALL DPWRST('XXX','BUG ')
50925      WRITE(ICOUT,1154)
50926 1154 FORMAT('        THE AUGMENTED FRACTAL VARIABLE IS TO BE ')
50927      CALL DPWRST('XXX','BUG ')
50928      WRITE(ICOUT,1181)
50929 1181 FORMAT('        CREATED, MUST BE 2 OR LARGER.')
50930      CALL DPWRST('XXX','BUG ')
50931      WRITE(ICOUT,1182)
50932 1182 FORMAT('        SUCH WAS NOT THE CASE HERE.')
50933      CALL DPWRST('XXX','BUG ')
50934      WRITE(ICOUT,1183)N1
50935 1183 FORMAT('        THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
50936     1'.')
50937      CALL DPWRST('XXX','BUG ')
50938      GOTO9000
50939C
50940 1190 CONTINUE
50941C
50942C                 ************************************************
50943C                 **  STEP 21--                                 **
50944C                 **  COMPUTE THE FRACTAL SET OF POINTS         **
50945C                 ************************************************
50946C
50947C2100 CONTINUE
50948C
50949      C=SQRT(3.0)/6.0
50950      N1M1=N1-1
50951      L=0
50952      DO2110I=1,N1M1
50953      IP1=I+1
50954      A1=X1(I)
50955      B1=Y1(I)
50956      A5=X1(IP1)
50957      B5=Y1(IP1)
50958      DELX=A5-A1
50959      DELY=B5-B1
50960      A2=A1+DELX/3
50961      A3=A1+DELX/2-C*DELY
50962      A4=A1+2*DELX/3
50963      B2=B1+DELY/3
50964      B3=B1+DELY/2+C*DELX
50965      B4=B1+2*DELY/3
50966      L=L+1
50967      X2(L)=A1
50968      Y2(L)=B1
50969      L=L+1
50970      X2(L)=A2
50971      Y2(L)=B2
50972      L=L+1
50973      X2(L)=A3
50974      Y2(L)=B3
50975      L=L+1
50976      X2(L)=A4
50977      Y2(L)=B4
50978      L=L+1
50979      X2(L)=A5
50980      Y2(L)=B5
50981 2110 CONTINUE
50982      N2=L
50983C
50984C                 *****************
50985C                 **  STEP 90--  **
50986C                 **  EXIT.      **
50987C                 *****************
50988C
50989 9000 CONTINUE
50990C
50991      IF(IBUGA3.EQ.'OFF')GOTO9090
50992      WRITE(ICOUT,999)
50993      CALL DPWRST('XXX','BUG ')
50994      WRITE(ICOUT,9011)
50995 9011 FORMAT('***** AT THE END         OF FRACTA--')
50996      CALL DPWRST('XXX','BUG ')
50997      WRITE(ICOUT,9012)IBUGA3,IWRITE,IERROR
50998 9012 FORMAT('IBUGA3,IWRITE,IERROR = ',A4,2X,A4,2X,A4)
50999      CALL DPWRST('XXX','BUG ')
51000      WRITE(ICOUT,9014)N1,N2
51001 9014 FORMAT('N1,N2 = ',2I8)
51002      CALL DPWRST('XXX','BUG ')
51003      DO9015I=1,N1
51004      WRITE(ICOUT,9016)I,X1(I),Y1(I)
51005 9016 FORMAT('I,X1(I),Y1(I) = ',I8,2E15.7)
51006      CALL DPWRST('XXX','BUG ')
51007 9015 CONTINUE
51008      DO9017I=1,N2
51009      WRITE(ICOUT,9018)I,X2(I),Y2(I)
51010 9018 FORMAT('I,X2(I),Y2(I) = ',I8,2E15.7)
51011      CALL DPWRST('XXX','BUG ')
51012 9017 CONTINUE
51013 9090 CONTINUE
51014C
51015      RETURN
51016      END
51017      SUBROUTINE FRAN(N,ANU1,ANU2,ISEED,X)
51018C
51019C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
51020C              FROM THE F DISTRIBUTION
51021C              WITH INTEGER DEGREES OF FREEDOM
51022C              PARAMETERS = NU1 AND NU2.
51023C              THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
51024C              THE PROBABILITY DENSITY FUNCTION IS GIVEN
51025C              IN THE REFERENCES BELOW.
51026C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
51027C                                OF RANDOM NUMBERS TO BE
51028C                                GENERATED.
51029C                     --NU1    = THE INTEGER DEGREES OF FREEDOM
51030C                                FOR THE NUMERATOR OF THE F RATIO.
51031C                     --NU2    = THE INTEGER DEGREES OF FREEDOM
51032C                                FOR THE DENOMINATOR OF THE F RATIO.
51033C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
51034C                                (OF DIMENSION AT LEAST N)
51035C                                INTO WHICH THE GENERATED
51036C                                RANDOM SAMPLE WILL BE PLACED.
51037C     OUTPUT--A RANDOM SAMPLE OF SIZE N
51038C             FROM THE F DISTRIBUTION
51039C             WITH DEGREES OF FREEDOM
51040C             PARAMETERS = NU1 AND NU2.
51041C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
51042C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
51043C                   OF N FOR THIS SUBROUTINE.
51044C                 --NU1 SHOULD BE A POSITIVE INTEGER VARIABLE.
51045C                 --NU2 SHOULD BE A POSITIVE INTEGER VARIABLE.
51046C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN.
51047C     FORTRAN LIBRARY SUBROUTINES NEEDED--LOG, SQRT, SIN, COS.
51048C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
51049C     LANGUAGE--ANSI FORTRAN (1977)
51050C     REFERENCES--MOOD AND GRABLE, INTRODUCTION TO THE
51051C                 THEORY OF STATISTICS, 1963, PAGES 231-232.
51052C               --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
51053C                 DISTRIBUTIONS--2, 1970, PAGES 75-93.
51054C               --HASTINGS AND PEACOCK, STATISTICAL
51055C                 DISTRIBUTIONS--A HANDBOOK FOR
51056C                 STUDENTS AND PRACTITIONERS, 1975,
51057C                 PAGE 64.
51058C     WRITTEN BY--JAMES J. FILLIBEN
51059C                 STATISTICAL ENGINEERING DIVISION
51060C                 INFORMATION TECHNOLOGY LABORATORY
51061C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
51062C                 GAITHERSBURG, MD 20899
51063C                 PHONE--301-975-2855
51064C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
51065C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
51066C     LANGUAGE--ANSI FORTRAN (1966)
51067C     VERSION NUMBER--82/7
51068C     ORIGINAL VERSION--NOVEMBER  1975.
51069C     UPDATED         --DECEMBER  1981.
51070C     UPDATED         --MAY       1982.
51071C     UPDATED         --MAY       2004. SUPPORT REAL VALUES FOR
51072C                                       DEGREES OF FREEDOM PARAMETERS
51073C
51074C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
51075C
51076C---------------------------------------------------------------------
51077C
51078      CHARACTER*4 ICASE
51079C
51080      DIMENSION X(*)
51081      DIMENSION Y(2),Z(2)
51082C
51083C-----COMMON----------------------------------------------------------
51084C
51085      INCLUDE 'DPCOP2.INC'
51086C
51087C-----DATA STATEMENTS-------------------------------------------------
51088C
51089      DATA PI/3.14159265359/
51090      DATA EPS/0.00001/
51091C
51092C-----START POINT-----------------------------------------------------
51093C
51094C     CHECK THE INPUT ARGUMENTS FOR ERRORS
51095C
51096      IF(N.LT.1)THEN
51097        WRITE(ICOUT,5)
51098        CALL DPWRST('XXX','BUG ')
51099        WRITE(ICOUT,47)N
51100        CALL DPWRST('XXX','BUG ')
51101        GOTO9000
51102      ELSEIF(ANU1.LE.0.0)THEN
51103        WRITE(ICOUT,15)
51104        CALL DPWRST('XXX','BUG ')
51105        WRITE(ICOUT,47)NU1
51106        CALL DPWRST('XXX','BUG ')
51107        GOTO9000
51108      ELSEIF(ANU2.LE.0.0)THEN
51109        WRITE(ICOUT,25)
51110        CALL DPWRST('XXX','BUG ')
51111        WRITE(ICOUT,47)NU2
51112        CALL DPWRST('XXX','BUG ')
51113        GOTO9000
51114      ENDIF
51115    5 FORMAT('***** ERROR--THE FIRST ARGUMENT TO FRAN ',
51116     1       'IS NON-POSITIVE.')
51117   15 FORMAT('***** ERROR--THE SECOND ARGUMENT TO FRAN ',
51118     1       'IS NON-POSITIVE.')
51119   25 FORMAT('***** ERROR--THE THIRD ARGUMENT TO FRAN ',
51120     1        'IS NON-POSITIVE.')
51121   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,'.')
51122C
51123      NU1=INT(ANU1+0.1)
51124      ANU12=REAL(NU1)
51125      NU2=INT(ANU2+0.1)
51126      ANU22=REAL(NU2)
51127      IF(ABS(ANU1-ANU12).LE.EPS .AND. ABS(ANU2-ANU22).LE.EPS)THEN
51128        ICASE='INTE'
51129        IF(NU1.EQ.0 .OR. NU2.EQ.0)THEN
51130          ICASE='REAL'
51131        ENDIF
51132      ELSE
51133        ICASE='REAL'
51134      ENDIF
51135C
51136C     CASE 1: INTEGER DEGREES OF FREEDOM
51137C
51138      IF(ICASE.EQ.'INTE')THEN
51139C       GENERATE N F RANDOM NUMBERS
51140C       USING THE DEFINITION THAT
51141C       A F VARIATE WITH NU1 AND NU2 DEGREES OF FREEDOM
51142C       EQUALS (CHS1/NU1)/(CHS2/NU2)
51143C       WHERE CHS1 IS A CHI-SQUARED VARIATE
51144C       WITH NU1 DEGREES OF FREEDOM,
51145C       AND   CHS2 IS A CHI-SQUARED VARIATE
51146C       WITH NU2 DEGREES OF FREEDOM.
51147C       FIRST GENERATE UNIFORM (0,1) RANDOM NUMBERS,
51148C       THEN GENERATE NORMAL RANDOM NUMBERS,
51149C       THEN CHI-SQUARED RANDOM NUMBERS WITH NU1 DEGREES
51150C       OF FREEDOM,
51151C       THEN CHI-SQUARED RANDOM NUMBERS WITH NU2 DEGREES
51152C       OF FREEDOM,
51153C       AND THEN FINALLY THE F RANDOM NUMBER.
51154C
51155        ANU1=NU1
51156        ANU2=NU2
51157        DO100I=1,N
51158C
51159          SUM=0.0
51160          DO200J=1,NU1,2
51161            CALL UNIRAN(2,ISEED,Y)
51162            ARG1=-2.0*LOG(Y(1))
51163            ARG2=2.0*PI*Y(2)
51164            Z(1)=(SQRT(ARG1))*(COS(ARG2))
51165            Z(2)=(SQRT(ARG1))*(SIN(ARG2))
51166            SUM=SUM+Z(1)*Z(1)
51167            IF(J.EQ.NU1)GOTO200
51168            SUM=SUM+Z(2)*Z(2)
51169  200     CONTINUE
51170          CHS1=SUM
51171C
51172          SUM=0.0
51173          DO300J=1,NU2,2
51174            CALL UNIRAN(2,ISEED,Y)
51175            ARG1=-2.0*LOG(Y(1))
51176            ARG2=2.0*PI*Y(2)
51177            Z(1)=(SQRT(ARG1))*(COS(ARG2))
51178            Z(2)=(SQRT(ARG1))*(SIN(ARG2))
51179            SUM=SUM+Z(1)*Z(1)
51180            IF(J.EQ.NU2)GOTO300
51181            SUM=SUM+Z(2)*Z(2)
51182  300     CONTINUE
51183          CHS2=SUM
51184C
51185          X(I)=(CHS1/ANU1)/(CHS2/ANU2)
51186C
51187  100   CONTINUE
51188C
51189      ELSE
51190        P=ANU1/2.0
51191        Q=ANU2/2.0
51192        CALL BETRAN(N,P,Q,ISEED,X)
51193        DO500I=1,N
51194          ATEMP=X(I)
51195          X(I)=ANU2*ATEMP/(ANU1*(1.0-ATEMP))
51196  500   CONTINUE
51197      ENDIF
51198C
51199 9000 CONTINUE
51200      RETURN
51201      END
51202      SUBROUTINE FREQUE(X,NX,D,ND,NUMVAR,IWRITE,
51203     1                  Y,NY,IBUGA3,IERROR)
51204C
51205C     PURPOSE--COMPUTE FREQUENCIES FOR SPECIFIED VALUES OF A VARIABLE
51206C              (OR IF NO VALUES SPECIFIED, COMPUTE FREQUENCIES
51207C              FOR DISTINCT VALUES OF A VARIABLE).
51208C     NOTE--IT IS PERMISSIBLE TO HAVE THE OUTPUT VECTOR Y(.)
51209C           BEING IDENTICAL TO THE INPUT VECTOR X(.).
51210C     WRITTEN BY--JAMES J. FILLIBEN
51211C                 STATISTICAL ENGINEERING DIVISION
51212C                 INFORMATION TECHNOLOGY LABORATORY
51213C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
51214C                 GAITHERSBURG, MD 20899
51215C                 PHONE--301-975-2855
51216C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
51217C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
51218C     LANGUAGE--ANSI FORTRAN (1977)
51219C     VERSION NUMBER--82/7
51220C     ORIGINAL VERSION--FEBRUARY  1979.
51221C     UPDATED         --APRIL     1979.
51222C     UPDATED         --AUGUST    1981.
51223C     UPDATED         --MAY       1982.
51224C
51225C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
51226C
51227      CHARACTER*4 IWRITE
51228      CHARACTER*4 IBUGA3
51229      CHARACTER*4 IERROR
51230C
51231      CHARACTER*4 ISUBN1
51232      CHARACTER*4 ISUBN2
51233C
51234C---------------------------------------------------------------------
51235C
51236      DIMENSION X(*)
51237      DIMENSION D(*)
51238      DIMENSION Y(*)
51239C
51240C-----COMMON----------------------------------------------------------
51241C
51242      INCLUDE 'DPCOP2.INC'
51243C
51244C-----START POINT-----------------------------------------------------
51245C
51246      ISUBN1='FREQ'
51247      ISUBN2='UE  '
51248      IERROR='NO'
51249C
51250      IF(IBUGA3.EQ.'ON')THEN
51251        WRITE(ICOUT,999)
51252  999   FORMAT(1X)
51253        CALL DPWRST('XXX','BUG ')
51254        WRITE(ICOUT,51)
51255   51   FORMAT('***** AT THE BEGINNING OF FREQUE--')
51256        CALL DPWRST('XXX','BUG ')
51257        WRITE(ICOUT,52)IBUGA3,IWRITE
51258   52   FORMAT('IBUGA3,IWRITE = ',A4,2X,A4)
51259        CALL DPWRST('XXX','BUG ')
51260        WRITE(ICOUT,53)NX,ND,NUMVAR
51261   53   FORMAT('NX,ND,NUMVAR = ',3I8)
51262        CALL DPWRST('XXX','BUG ')
51263        DO55I=1,NX
51264          WRITE(ICOUT,56)I,X(I)
51265   56     FORMAT('I,X(I) = ',I8,G15.7)
51266          CALL DPWRST('XXX','BUG ')
51267   55   CONTINUE
51268        WRITE(ICOUT,999)
51269        CALL DPWRST('XXX','BUG ')
51270        DO60I=1,ND
51271          WRITE(ICOUT,61)I,D(I)
51272   61     FORMAT('I,D(I) = ',I8,G15.7)
51273          CALL DPWRST('XXX','BUG ')
51274   60   CONTINUE
51275      ENDIF
51276C
51277C               ********************************
51278C               **  STEP 1--                  **
51279C               **  COMPUTE DISTINCT VALUES  **
51280C               **  (IF NECESSARY)            **
51281C               ********************************
51282C
51283      IF(NUMVAR.GE.2)GOTO190
51284C
51285      ND=0
51286      IF(NX.LT.1)GOTO150
51287      DO100I=1,NX
51288      IF(I.EQ.1)GOTO130
51289      DO120J=1,ND
51290      IF(X(I).EQ.D(J))GOTO100
51291  120 CONTINUE
51292  130 CONTINUE
51293      ND=ND+1
51294      D(ND)=X(I)
51295  100 CONTINUE
51296      GOTO190
51297C
51298  150 CONTINUE
51299      IERROR='YES'
51300      WRITE(ICOUT,999)
51301      CALL DPWRST('XXX','BUG ')
51302      WRITE(ICOUT,151)
51303  151 FORMAT('***** ERROR IN FREQUE--')
51304      CALL DPWRST('XXX','BUG ')
51305      WRITE(ICOUT,152)
51306  152 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
51307      CALL DPWRST('XXX','BUG ')
51308      WRITE(ICOUT,153)
51309  153 FORMAT('      IN THE VARIABLE FOR WHICH')
51310      CALL DPWRST('XXX','BUG ')
51311      WRITE(ICOUT,154)
51312  154 FORMAT('      THE DISTINCT VALUES ARE TO BE FOUND')
51313      CALL DPWRST('XXX','BUG ')
51314      WRITE(ICOUT,155)
51315  155 FORMAT('      MUST BE 1 OR LARGER.')
51316      CALL DPWRST('XXX','BUG ')
51317      WRITE(ICOUT,156)
51318  156 FORMAT('      SUCH WAS NOT THE CASE HERE.')
51319      CALL DPWRST('XXX','BUG ')
51320      WRITE(ICOUT,157)NX
51321  157 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
51322     1'.')
51323      CALL DPWRST('XXX','BUG ')
51324C
51325  190 CONTINUE
51326C
51327C               ***************************
51328C               **  STEP 2--             **
51329C               **  COMPUTE FREQUENCIES  **
51330C               ***************************
51331C
51332      NY=ND
51333      IF(ND.LT.1)GOTO250
51334      DO210J=1,ND
51335      ISUM=0
51336      DO220I=1,NX
51337      IF(X(I).EQ.D(J))GOTO230
51338      GOTO220
51339  230 CONTINUE
51340      ISUM=ISUM+1
51341  220 CONTINUE
51342      Y(J)=ISUM
51343  210 CONTINUE
51344      GOTO290
51345C
51346  250 CONTINUE
51347      IERROR='YES'
51348      WRITE(ICOUT,999)
51349      CALL DPWRST('XXX','BUG ')
51350      WRITE(ICOUT,251)
51351  251 FORMAT('***** ERROR IN FREQUE--')
51352      CALL DPWRST('XXX','BUG ')
51353      WRITE(ICOUT,252)
51354  252 FORMAT('      THE INPUT NUMBER OF DISTINCT VALUES')
51355      CALL DPWRST('XXX','BUG ')
51356      WRITE(ICOUT,253)
51357  253 FORMAT('      OF THE VARIABLE FOR WHICH')
51358      CALL DPWRST('XXX','BUG ')
51359      WRITE(ICOUT,254)
51360  254 FORMAT('      FREQUENCIES ARE TO BE FOUND')
51361      CALL DPWRST('XXX','BUG ')
51362      WRITE(ICOUT,255)
51363  255 FORMAT('      MUST BE 1 OR LARGER.')
51364      CALL DPWRST('XXX','BUG ')
51365      WRITE(ICOUT,256)
51366  256 FORMAT('      SUCH WAS NOT THE CASE HERE.')
51367      CALL DPWRST('XXX','BUG ')
51368      WRITE(ICOUT,257)ND
51369  257 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
51370     1'.')
51371      CALL DPWRST('XXX','BUG ')
51372C
51373  290 CONTINUE
51374C
51375C               *****************
51376C               **  STEP 90--  **
51377C               **  EXIT.      **
51378C               *****************
51379C
51380      IF(IBUGA3.EQ.'ON')THEN
51381        WRITE(ICOUT,999)
51382        CALL DPWRST('XXX','BUG ')
51383        WRITE(ICOUT,9011)
51384 9011   FORMAT('***** AT THE END       OF FREQUE--')
51385        CALL DPWRST('XXX','BUG ')
51386        WRITE(ICOUT,9013)IERROR,NX,ND,NY
51387 9013   FORMAT('IERROR,NX,ND,NY = ',A4,2X,3I8)
51388        CALL DPWRST('XXX','BUG ')
51389        DO9015I=1,NX
51390          WRITE(ICOUT,9016)I,X(I),D(I),Y(I)
51391 9016     FORMAT('I,X(I),D(I),Y(I) = ',I8,3E15.7)
51392          CALL DPWRST('XXX','BUG ')
51393 9015   CONTINUE
51394      ENDIF
51395C
51396      RETURN
51397      END
51398      SUBROUTINE FSTOCD (N, X, SX, RNOISE, G)
51399CCCCC SUBROUTINE FSTOCD (N, X, OPTFCN, SX, RNOISE, G)
51400      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
51401C PURPOSE
51402C -------
51403C FIND CENTRAL DIFFERENCE APPROXIMATION G TO THE FIRST DERIVATIVE
51404C (GRADIENT) OF THE FUNCTION DEFINED BY FCN AT THE POINT X.
51405C
51406C PARAMETERS
51407C ----------
51408C N            --> DIMENSION OF PROBLEM
51409C X            --> POINT AT WHICH GRADIENT IS TO BE APPROXIMATED.
51410C FCN          --> NAME OF SUBROUTINE TO EVALUATE FUNCTION.
51411C SX           --> DIAGONAL SCALING MATRIX FOR X.
51412C RNOISE       --> RELATIVE NOISE IN FCN [F(X)].
51413C G           <--  CENTRAL DIFFERENCE APPROXIMATION TO GRADIENT.
51414C
51415C
51416      DIMENSION X(N)
51417      DIMENSION SX(N)
51418      DIMENSION G(N)
51419      DIMENSION FHAT(1)
51420C
51421C FIND I TH  STEPSIZE, EVALUATE TWO NEIGHBORS IN DIRECTION OF I TH
51422C UNIT VECTOR, AND EVALUATE I TH  COMPONENT OF GRADIENT.
51423C
51424      THIRD = 1.0/3.0
51425      DO 10 I = 1, N
51426         STEPI = RNOISE**THIRD * MAX(ABS(X(I)), 1.0/SX(I))
51427         XTEMPI = X(I)
51428         X(I) = XTEMPI + STEPI
51429         CALL OPTFCN (N, X, FHAT)
51430         FPLUS=FHAT(1)
51431         X(I) = XTEMPI - STEPI
51432         CALL OPTFCN (N, X, FHAT)
51433         FMINUS=FHAT(1)
51434         X(I) = XTEMPI
51435         G(I) = (FPLUS - FMINUS)/(2.0*STEPI)
51436   10 CONTINUE
51437      RETURN
51438      END
51439      SUBROUTINE FSTOFD(NR,M,N,XPLS,FPLS,A,SX,RNOISE,FHAT,
51440CDPLT SUBROUTINE FSTOFD(NR,M,N,XPLS,OPTFCN,FPLS,A,SX,RNOISE,FHAT,
51441     +ICASE)
51442      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
51443C PURPOSE
51444C -------
51445C FIND FIRST ORDER FORWARD FINITE DIFFERENCE APPROXIMATION "A" TO THE
51446C FIRST DERIVATIVE OF THE FUNCTION DEFINED BY THE SUBPROGRAM "FNAME"
51447C EVALUATED AT THE NEW ITERATE "XPLS".
51448C
51449C
51450C FOR OPTIMIZATION USE THIS ROUTINE TO ESTIMATE:
51451C 1) THE FIRST DERIVATIVE (GRADIENT) OF THE OPTIMIZATION FUNCTION "FCN
51452C    ANALYTIC USER ROUTINE HAS BEEN SUPPLIED;
51453C 2) THE SECOND DERIVATIVE (HESSIAN) OF THE OPTIMIZATION FUNCTION
51454C    IF NO ANALYTIC USER ROUTINE HAS BEEN SUPPLIED FOR THE HESSIAN BUT
51455C    ONE HAS BEEN SUPPLIED FOR THE GRADIENT ("FCN") AND IF THE
51456C    OPTIMIZATION FUNCTION IS INEXPENSIVE TO EVALUATE
51457C
51458C NOTE
51459C ----
51460C _M=1 (OPTIMIZATION) ALGORITHM ESTIMATES THE GRADIENT OF THE FUNCTION
51461C      (FCN).   FCN(X) # F: R(N)-->R(1)
51462C _M=N (SYSTEMS) ALGORITHM ESTIMATES THE JACOBIAN OF THE FUNCTION
51463C      FCN(X) # F: R(N)-->R(N).
51464C _M=N (OPTIMIZATION) ALGORITHM ESTIMATES THE HESSIAN OF THE OPTIMIZATIO
51465C      FUNCTION, WHERE THE HESSIAN IS THE FIRST DERIVATIVE OF "FCN"
51466C
51467C PARAMETERS
51468C ----------
51469C NR           --> ROW DIMENSION OF MATRIX
51470C M            --> NUMBER OF ROWS IN A
51471C N            --> NUMBER OF COLUMNS IN A; DIMENSION OF PROBLEM
51472C XPLS(N)      --> NEW ITERATE:  X[K]
51473C OPTFCN       --> NAME OF SUBROUTINE TO EVALUATE FUNCTION
51474C FPLS(M)      --> _M=1 (OPTIMIZATION) FUNCTION VALUE AT NEW ITERATE:
51475C                       FCN(XPLS)
51476C                  _M=N (OPTIMIZATION) VALUE OF FIRST DERIVATIVE
51477C                       (GRADIENT) GIVEN BY USER FUNCTION FCN
51478C                  _M=N (SYSTEMS)  FUNCTION VALUE OF ASSOCIATED
51479C                       MINIMIZATION FUNCTION
51480C A(NR,N)     <--  FINITE DIFFERENCE APPROXIMATION (SEE NOTE).  ONLY
51481C                  LOWER TRIANGULAR MATRIX AND DIAGONAL ARE RETURNED
51482C SX(N)        --> DIAGONAL SCALING MATRIX FOR X
51483C RNOISE       --> RELATIVE NOISE IN FCN [F(X)]
51484C FHAT(M)      --> WORKSPACE
51485C ICASE        --> =1 OPTIMIZATION (GRADIENT)
51486C                  =2 SYSTEMS
51487C                  =3 OPTIMIZATION (HESSIAN)
51488C
51489C INTERNAL VARIABLES
51490C ------------------
51491C STEPSZ - STEPSIZE IN THE J-TH VARIABLE DIRECTION
51492C
51493CDPLT DIMENSION XPLS(N),FPLS(M)
51494CDPLT DIMENSION FHAT(M)
51495CDPLT DIMENSION SX(N)
51496      DIMENSION XPLS(*),FPLS(*)
51497      DIMENSION FHAT(*)
51498      DIMENSION SX(*)
51499      DIMENSION A(NR,1)
51500CDPLT EXTERNAL OPTFCN
51501C
51502C FIND J-TH COLUMN OF A
51503C EACH COLUMN IS DERIVATIVE OF F(FCN) WITH RESPECT TO XPLS(J)
51504C
51505      DO 30 J=1,N
51506        STEPSZ=SQRT(RNOISE)*MAX(ABS(XPLS(J)),1.D0/SX(J))
51507        XTMPJ=XPLS(J)
51508        XPLS(J)=XTMPJ+STEPSZ
51509        CALL OPTFCN(N,XPLS,FHAT)
51510        XPLS(J)=XTMPJ
51511        DO 20 I=1,M
51512          A(I,J)=(FHAT(I)-FPLS(I))/STEPSZ
51513   20   CONTINUE
51514   30 CONTINUE
51515      IF(ICASE.NE.3) RETURN
51516C
51517C IF COMPUTING HESSIAN, A MUST BE SYMMETRIC
51518C
51519      IF(N.EQ.1) RETURN
51520      NM1=N-1
51521      DO 50 J=1,NM1
51522        JP1=J+1
51523        DO 40 I=JP1,M
51524          A(I,J)=(A(I,J)+A(J,I))/2.0D0
51525   40   CONTINUE
51526   50 CONTINUE
51527      RETURN
51528      END
51529      subroutine fts(x,n,np,trend,work)
51530c
51531c  This routine is part of the Bill Cleveland seasonal loess
51532c  program.
51533c
51534      integer n, np
51535      real x(n), trend(n), work(n)
51536      call ma(x,n,np,trend)
51537      call ma(trend,n-np+1,np,work)
51538      call ma(work,n-2*np+2,3,trend)
51539      return
51540      end
51541      subroutine fexact (nrow, ncol, table, ldtabl, expect, percnt,
51542     &                   emin, prt, pre,
51543     &                   rwrk,dwrk,iwrk,iwkmax)
51544c-----------------------------------------------------------------------
51545c  Name:       FEXACT
51546c
51547c  Purpose:    Computes Fisher's exact test probabilities and a hybrid
51548c              approximation to Fisher exact test probabilities for a
51549c              contingency table using the network algorithm.
51550c
51551c  Usage:      CALL FEXACT (NROW, NCOL, TABLE, LDTABL, EXPECT, PERCNT,
51552c                          EMIN, PRT, PRE)
51553c
51554c  Arguments:
51555c     NROW   - The number of rows in the table.  (Input)
51556c     NCOL   - The number of columns in the table.  (Input)
51557c     TABLE  - NROW by NCOL matrix containing the contingency table.
51558c              (Input)
51559c     LDTABL - Leading dimension of TABLE exactly as specified in the
51560c              dimension statement in the calling program.  (Input)
51561c     EXPECT - Expected value used in the hybrid algorithm for
51562c              deciding when to use asymptotic theory probabilities.
51563c              (Input)
51564c              If EXPECT .LE. 0.0 then asymptotic theory probabilities
51565c              are not used and Fisher exact test probabilities are
51566c              computed.  Otherwise, if PERCNT or more of the cells in
51567c              the remaining table have estimated expected values of
51568c              EXPECT or more, with no remaining cell having expected
51569c              value less than EMIN, then asymptotic chi-squared
51570c              probabilities are used.  See the algorithm section of the
51571c              manual document for details.  Use EXPECT = 5.0 to obtain
51572c              the 'Cochran' condition.
51573c     PERCNT - Percentage of remaining cells that must have estimated
51574c              expected  values greater than EXPECT before asymptotic
51575c              probabilities can be used.  (Input)
51576c              See argument EXPECT for details.  Use PERCNT = 80.0 to
51577c              obtain the 'Cochran' condition.
51578c     EMIN   - Minimum cell estimated expected value allowed for
51579c              asymptotic chi-squared probabilities to be used.  (Input)
51580c              See argument EXPECT for details.  Use EMIN = 1.0 to
51581c              obtain the 'Cochran' condition.
51582c     PRT    - Probability of the observed table for fixed marginal
51583c              totals.  (Output)
51584c     PRE    - Table p-value.  (Output)
51585c              PRE is the probability of a more extreme table, where
51586c              'extreme' is in a probabilistic sense.
51587c              If EXPECT .LT. 0 then the Fisher exact probability
51588c              is returned.  Otherwise, an approximation to the
51589c              Fisher exact probability is computed based upon
51590c              asymptotic chi-squared probabilities for ``large''
51591c              table expected values.  The user defines ``large''
51592c              through the arguments EXPECT, PERCNT, and EMIN.
51593c
51594c  Remarks:
51595c  1. For many problems one megabyte or more of workspace can be
51596c     required.  If the environment supports it, the user should begin
51597c     by increasing the workspace used to 200,000 units.
51598c
51599c  2. In FEXACT, LDSTP = 30*LDKEY.  The proportion of table space used
51600c     by STP may be changed by changing the line MULT = 30 below to
51601c     another value.
51602c
51603c  3. FEXACT may be converted to single precision by setting IREAL = 3,
51604c     and converting all DOUBLE PRECISION specifications (except the
51605c     specifications for RWRK, IWRK, and DWRK) to REAL.  This will
51606c     require changing the names and specifications of the intrinsic
51607c     functions LOG, AMAX1, AMIN1, EXP, and REAL.  In addition, the
51608c     machine specific constants will need to be changed, and the name
51609c     DWRK will need to be changed to RWRK in the call to F2XACT.
51610c
51611c  4. Machine specific constants are specified and documented in F2XACT.
51612c     A missing value code is specified in both FEXACT and F2XACT.
51613c
51614c  5. Although not a restriction, is is not generally practical to call
51615c     this routine with large tables which are not sparse and in
51616c     which the 'hybrid' algorithm has little effect.  For example,
51617c     although it is feasible to compute exact probabilities for the
51618c     table
51619c            1 8 5 4 4 2 2
51620c            5 3 3 4 3 1 0
51621c           10 1 4 0 0 0 0,
51622c     computing exact probabilities for a similar table which has been
51623c     enlarged by the addition of an extra row (or column) may not be
51624c     feasible.
51625c-----------------------------------------------------------------------
51626c                                  SPECIFICATIONS FOR ARGUMENTS
51627      integer    nrow, ncol, ldtabl
51628      double precision expect, percnt, emin, prt, pre, table(ldtabl,*)
51629c                                  SPECIFICATIONS FOR LOCAL VARIABLES
51630      integer    i, i1, i10, i2, i3, i3a, i3b, i3c, i4, i5, i6, i7,
51631     &           i8, i9, i9a, iiwk, ireal, irwk, iwkmax, iwkpt,
51632     &           j, k, kk, ldkey, ldstp, mult, nco, nro,
51633     &           ntot, numb
51634c                                  SPECIFICATIONS FOR INTRINSICS
51635      intrinsic  max0
51636ccccc integer    max0
51637c                                  SPECIFICATIONS FOR SUBROUTINES
51638ccccc external   prterr, f2xact
51639      external   f2xact
51640c                                  SPECIFICATIONS FOR FUNCTIONS
51641      external   iwork
51642      integer    iwork
51643c***********************************************************************
51644c                                  To increase workspace, increase the
51645c                                  size of of rwrk and set the value of
51646c                                  IWKMAX to the new dimension
51647c
51648c                                  When changing precision, the
51649c                                  following declarations should not be
51650c                                  changed.
51651c***********************************************************************
51652ccccc real       rwrk(200000)
51653ccccc double precision dwrk(100000)
51654ccccc integer    iwrk(100000)
51655ccccc equivalence (rwrk(1), iwrk(1)), (rwrk(1),dwrk(1))
51656      real rwrk(*)
51657      double precision dwrk(*)
51658      integer iwrk(*)
51659c                                  Set workspace size
51660      INCLUDE 'DPCOP2.INC'
51661C
51662      RWRK(1)=0.0
51663ccccc iwkmax = 200000
51664c
51665c***********************************************************************
51666c                                  To increase the length of the table
51667c                                  of paste path lengths relative to the
51668c                                  length of the hash table,  increase
51669c                                  MULT
51670c***********************************************************************
51671      mult   = 30
51672c***********************************************************************
51673c                                  Set IREAL = 4 for DOUBLE PRECISION
51674c                                  Set IREAL = 3 for SINGLE PRECISION
51675c***********************************************************************
51676      ireal  = 4
51677c***********************************************************************
51678c                                  AMISS is a missing value indicator
51679c                                  which is returned when the
51680c                                  probability is not defined.
51681c***********************************************************************
51682      amiss = -12345.0d0
51683c
51684      iwkpt  = 1
51685c
51686CCCCC print *,'fexact: nrow,ncol,ldtabl=',nrow,ncol,ldtabl
51687CCCCC print *,'table(1,1) = ',table(1,1)
51688CCCCC print *,'table(2,1) = ',table(2,1)
51689CCCCC print *,'table(1,2) = ',table(1,2)
51690CCCCC print *,'table(2,2) = ',table(2,2)
51691CCCCC print *,'expect,percnt,emin=',expect,percnt,emin
51692c
51693      if (nrow .gt. ldtabl) then
51694CCCCC    call prterr (1, 'NROW must be less than or equal to '//
51695CCCCC&               'LDTABL.')
51696      WRITE(ICOUT,999)
51697  999 FORMAT(1X)
51698      CALL DPWRST('XXX','BUG ')
51699      WRITE(ICOUT,9011)
51700 9011 FORMAT('***** ERROR FROM FEXACT.')
51701      CALL DPWRST('XXX','BUG ')
51702      WRITE(ICOUT,9013)
51703 9013 FORMAT('      NROW must be less than or equal to LDTABL.')
51704      CALL DPWRST('XXX','BUG ')
51705      end if
51706      ntot = 0
51707      do 20  i=1, nrow
51708         do 10  j=1, ncol
51709            if (table(i,j) .lt. 0) then
51710CCCCC          call prterr (2, 'All elements of TABLE must '//
51711CCCCC&                     'be positive.')
51712      WRITE(ICOUT,999)
51713      CALL DPWRST('XXX','BUG ')
51714      WRITE(ICOUT,9011)
51715      CALL DPWRST('XXX','BUG ')
51716      WRITE(ICOUT,9113)
51717 9113 FORMAT('      All elements of TABLE must be non-negative.')
51718      CALL DPWRST('XXX','BUG ')
51719            end if
51720            ntot = ntot + int(table(i,j))
51721   10    continue
51722   20 continue
51723      if (ntot .eq. 0) then
51724ccccc    call prterr (3, 'All elements of TABLE are zero.  '//
51725ccccc&               'PRT and PRE are set to missing values '//
51726ccccc&               '(NaN, not a number).')
51727      WRITE(ICOUT,999)
51728      CALL DPWRST('XXX','BUG ')
51729      WRITE(ICOUT,9011)
51730      CALL DPWRST('XXX','BUG ')
51731      WRITE(ICOUT,9213)
51732 9213 FORMAT('      All elements of TABLE are zero.  PRT and PRE are')
51733      CALL DPWRST('XXX','BUG ')
51734      WRITE(ICOUT,9215)
51735 9215 FORMAT('      set to missing values (NaN, not a number).')
51736      CALL DPWRST('XXX','BUG ')
51737         prt = amiss
51738         pre = amiss
51739         go to 9000
51740      end if
51741c
51742      nco = max0(nrow,ncol)
51743      nro = nrow + ncol - nco
51744      k   = nrow + ncol + 1
51745      kk  = k*max0(nrow,ncol)
51746c
51747      i1   = iwork(iwkmax,iwkpt,ntot+1,ireal)
51748      i2   = iwork(iwkmax,iwkpt,nco,2)
51749      i3   = iwork(iwkmax,iwkpt,nco,2)
51750      i3a  = iwork(iwkmax,iwkpt,nco,2)
51751      i3b  = iwork(iwkmax,iwkpt,nro,2)
51752      i3c  = iwork(iwkmax,iwkpt,nro,2)
51753      iiwk = iwork(iwkmax,iwkpt,max0(5*k+2*kk,800+7*max0(nrow,ncol)),2)
51754      irwk = iwork(iwkmax,iwkpt,max0(400+max0(nrow,ncol)+1,k),ireal)
51755c                                  Double precision
51756      if (ireal .eq. 4) then
51757         numb  = 18 + 10*mult
51758         ldkey = (iwkmax-iwkpt+1)/numb
51759      else
51760c                                  Real workspace
51761         numb  = 12 + 8*mult
51762         ldkey = (iwkmax-iwkpt+1)/numb
51763      end if
51764c
51765      ldstp = mult*ldkey
51766      i4    = iwork(iwkmax,iwkpt,2*ldkey,2)
51767      i5    = iwork(iwkmax,iwkpt,2*ldkey,2)
51768      i6    = iwork(iwkmax,iwkpt,2*ldstp,ireal)
51769      i7    = iwork(iwkmax,iwkpt,6*ldstp,2)
51770      i8    = iwork(iwkmax,iwkpt,2*ldkey,ireal)
51771      i9    = iwork(iwkmax,iwkpt,2*ldkey,ireal)
51772      i9a   = iwork(iwkmax,iwkpt,2*ldkey,ireal)
51773      i10   = iwork(iwkmax,iwkpt,2*ldkey,2)
51774c***********************************************************************
51775c                                  To convert to double precision,
51776c                                  change RWRK to WWRK in the next CALL
51777c***********************************************************************
51778c
51779      call f2xact (nrow, ncol, table, ldtabl, expect, percnt, emin,
51780     &             prt, pre, dwrk(i1), iwrk(i2), iwrk(i3), iwrk(i3a),
51781     &             iwrk(i3b), iwrk(i3c), iwrk(i4), ldkey, iwrk(i5),
51782     &             dwrk(i6), ldstp, iwrk(i7), dwrk(i8), dwrk(i9),
51783     &             dwrk(i9a), iwrk(i10), iwrk(iiwk), dwrk(irwk))
51784c
51785 9000 return
51786      end
51787      subroutine f2xact (nrow, ncol, table, ldtabl, expect, percnt,
51788     &                   emin, prt, pre, fact, ico, iro, kyy, idif,
51789     &                   irn, key, ldkey, ipoin, stp, ldstp, ifrq,
51790     &                   dlp, dsp, tm, key2, iwk, rwk)
51791c-----------------------------------------------------------------------
51792c  Name:       F2XACT
51793c
51794c  Purpose:    Computes Fisher's exact test for a contingency table,
51795c              routine with workspace variables specified.
51796c
51797c  Usage:      CALL F2XACT (NROW, NCOL, TABLE, LDTABL, EXPECT, PERCNT,
51798c                          EMIN, PRT, PRE, FACT, ICO, IRO, KYY, IDIF,
51799c                          IRN, KEY, LDKEY, IPOIN, STP, LDSTP, IFRQ,
51800c                          DLP, DSP, TM, KEY2, IWK, RWK)
51801c-----------------------------------------------------------------------
51802c                                  SPECIFICATIONS FOR ARGUMENTS
51803      integer    nrow, ncol, ldtabl, ldkey, ldstp, ico(*), iro(*),
51804     &           kyy(*), idif(*), irn(*), key(*), ipoin(*), ifrq(*),
51805     &           key2(*), iwk(*)
51806      double precision expect, percnt, emin, prt, pre, table(ldtabl,*),
51807     &           fact(0:*), stp(*), dlp(*), dsp(*), tm(*), rwk(*)
51808c                                  SPECIFICATIONS FOR LOCAL VARIABLES
51809      integer    i, i31, i310, i311, i32, i33, i34, i35, i36, i37,
51810     &           i38, i39, i41, i42, i43, i44, i45, i46, i47, i48,
51811     &           iflag, ifreq, ii, ikkey, ikstp, ikstp2, ipn, ipo,
51812     &           itmp, itop, itp, j, jkey, jstp, jstp2, jstp3, jstp4,
51813     &           k, k1, kb, kd, kmax, ks, kval, last, n, ncell, nco,
51814     &           nrb, nro, nro2, ntot, ifault, imax
51815      double precision dd, ddf, df, drn, dro, dspt, emn, obs, obs2,
51816     &           obs3, pastp, pv, tmp, tol
51817      logical    chisq, ipsh
51818c                                  SPECIFICATIONS FOR INTRINSICS
51819      intrinsic  dlog, dmax1, dmin1, dexp, max0, min0, mod, nint, dble
51820ccccc integer    max0, min0, mod, nint
51821ccccc double precision dlog, dmax1, dmin1, dexp, dble
51822c                                  SPECIFICATIONS FOR SUBROUTINES
51823ccccc external   prterr, f3xact, f4xact, f5xact, f6xact, f7xact, isort
51824      external   f3xact, f4xact, f5xact, f6xact, f7xact, isort
51825c                                  SPECIFICATIONS FOR FUNCTIONS
51826      external   f9xact, gammds
51827      double precision f9xact, gammds
51828C
51829      INCLUDE 'DPCOP2.INC'
51830C
51831c***********************************************************************
51832c                                  IMAX is the largest representable
51833c                                  integer on the machine
51834c***********************************************************************
51835      data imax/2147483647/
51836c***********************************************************************
51837c                                  AMISS is a missing value indicator
51838c                                  which is returned when the
51839c                                  probability is not defined.
51840c***********************************************************************
51841      data amiss/-12345.0d0/
51842c***********************************************************************
51843c                                  TOL is chosen as the square root of
51844c                                  the smallest relative spacing
51845c***********************************************************************
51846      data tol/3.45254d-07/
51847c***********************************************************************
51848c                                  EMX is a large positive value used
51849c                                  in comparing expected values
51850c***********************************************************************
51851      data emx/1.0d30/
51852c                                  Initialize KEY array
51853      chisq = .true.
51854      tmp=0.0d0
51855c
51856      do 10  i=1, 2*ldkey
51857         key(i)  = -9999
51858         key2(i) = -9999
51859   10 continue
51860c                                  Initialize parameters
51861      pre  = 0.0
51862      itop = 0
51863      if (expect .gt. 0.0d0) then
51864         emn = emin
51865      else
51866         emn = emx
51867      end if
51868c                                  Initialize pointers for workspace
51869      k = max0(nrow,ncol)
51870c                                  f3xact
51871      i31  = 1
51872      i32  = i31 + k
51873      i33  = i32 + k
51874      i34  = i33 + k
51875      i35  = i34 + k
51876      i36  = i35 + k
51877      i37  = i36 + k
51878      i38  = i37 + k
51879      i39  = i38 + 400
51880      i310 = 1
51881      i311 = 401
51882c                                  f4xact
51883      k   = nrow + ncol + 1
51884      i41 = 1
51885      i42 = i41 + k
51886      i43 = i42 + k
51887      i44 = i43 + k
51888      i45 = i44 + k
51889      i46 = i45 + k
51890      i47 = i46 + k*max0(nrow,ncol)
51891      i48 = 1
51892c                                  Check table dimensions
51893      if (nrow .gt. ldtabl) then
51894CCCCC    call prterr (1, 'NROW must be less than or equal to '//
51895CCCCC&               'LDTABL.')
51896         WRITE(ICOUT,999)
51897  999    FORMAT(1X)
51898         CALL DPWRST('XXX','BUG ')
51899         WRITE(ICOUT,9011)
51900 9011    FORMAT('***** ERROR IN F2XACT--')
51901         CALL DPWRST('XXX','BUG ')
51902         WRITE(ICOUT,9013)
51903 9013    FORMAT('      NROW must be less than or equal to LDTABL.')
51904         CALL DPWRST('XXX','BUG ')
51905      end if
51906      if (ncol .le. 1) then
51907ccccc    call prterr (4, 'NCOL must be greater than 1.0.')
51908         WRITE(ICOUT,999)
51909         CALL DPWRST('XXX','BUG ')
51910         WRITE(ICOUT,9011)
51911         CALL DPWRST('XXX','BUG ')
51912         WRITE(ICOUT,9113)
51913 9113    FORMAT('      NCOL must be greater than 1.0.')
51914         CALL DPWRST('XXX','BUG ')
51915      end if
51916c                                  Compute row marginals and total
51917      ntot = 0
51918      do 30  i=1, nrow
51919         iro(i) = 0
51920         do 20  j=1, ncol
51921            if (table(i,j) .lt. -0.0001d0) then
51922CCCCC          call prterr (2, 'All elements of TABLE must be '//
51923CCCCC&                     'positive.')
51924         WRITE(ICOUT,999)
51925         CALL DPWRST('XXX','BUG ')
51926         WRITE(ICOUT,9011)
51927         CALL DPWRST('XXX','BUG ')
51928         WRITE(ICOUT,9123)
51929 9123    FORMAT('       All elements of TABLE must be positive.')
51930         CALL DPWRST('XXX','BUG ')
51931            end if
51932            iro(i) = iro(i) + nint(table(i,j))
51933            ntot   = ntot + nint(table(i,j))
51934   20    continue
51935   30 continue
51936c
51937      if (ntot .eq. 0) then
51938CCCCC    call prterr (3, 'All elements of TABLE are zero.  '//
51939CCCCC&               'PRT and PRE are set to missing values '//
51940CCCCC&               '(NaN, not a number).')
51941         WRITE(ICOUT,999)
51942         CALL DPWRST('XXX','BUG ')
51943         WRITE(ICOUT,9011)
51944         CALL DPWRST('XXX','BUG ')
51945         WRITE(ICOUT,9133)
51946 9133    FORMAT('       All elements of TABLE are zero.  PRT and PRE')
51947         CALL DPWRST('XXX','BUG ')
51948         WRITE(ICOUT,9135)
51949 9135    FORMAT('       are set to missing values (NaN, not a ',
51950     &          'number).')
51951         CALL DPWRST('XXX','BUG ')
51952         prt = amiss
51953         pre = amiss
51954         go to 9000
51955      end if
51956c                                  Column marginals
51957      do 50  i=1, ncol
51958         ico(i) = 0
51959         do 40  j=1, nrow
51960            ico(i) = ico(i) + nint(table(j,i))
51961   40    continue
51962   50 continue
51963c                                  sort
51964      call isort (nrow, iro)
51965      call isort (ncol, ico)
51966c                                  Determine row and column marginals
51967c
51968      if (nrow .gt. ncol) then
51969         nro = ncol
51970         nco = nrow
51971c                                  Interchange row and column marginals
51972         do 60  i=1, nrow
51973            itmp = iro(i)
51974            if (i .le. ncol) iro(i) = ico(i)
51975            ico(i) = itmp
51976   60    continue
51977      else
51978         nro = nrow
51979         nco = ncol
51980      end if
51981c
51982c                                  Get multiplers for stack
51983      kyy(1) = 1
51984      do 70  i=2, nro
51985c                                  Hash table multipliers
51986         if (iro(i-1)+1 .le. imax/kyy(i-1)) then
51987            kyy(i) = kyy(i-1)*(iro(i-1)+1)
51988            j      = j/kyy(i-1)
51989         else
51990CCCCC       call prterr (5, 'The hash table key cannot be computed'//
51991CCCCC&                  ' because the largest key is larger than the'//
51992CCCCC&                  ' largest representable integer.  The '//
51993CCCCC&                  'algorithm cannot proceed.')
51994         WRITE(ICOUT,999)
51995         CALL DPWRST('XXX','BUG ')
51996         WRITE(ICOUT,9011)
51997         CALL DPWRST('XXX','BUG ')
51998         WRITE(ICOUT,9143)
51999 9143    FORMAT('       The hash table key cannot be computed because')
52000         CALL DPWRST('XXX','BUG ')
52001         WRITE(ICOUT,9145)
52002 9145    FORMAT('       the largest key is larger than the largest')
52003         CALL DPWRST('XXX','BUG ')
52004         WRITE(ICOUT,9147)
52005 9147    FORMAT('       representable integer.  The algorithm cannot',
52006     &          ' proceed.')
52007         CALL DPWRST('XXX','BUG ')
52008         end if
52009   70 continue
52010c                                  Maximum product
52011      if (iro(nro-1)+1 .le. imax/kyy(nro-1)) then
52012         kmax = (iro(nro)+1)*kyy(nro-1)
52013      else
52014ccccc    call prterr (5, 'The hash table key cannot be computed'//
52015ccccc&               ' because the largest key is larger than the'//
52016ccccc&               ' largest representable integer.  The '//
52017ccccc&               'algorithm cannot proceed.')
52018         WRITE(ICOUT,999)
52019         CALL DPWRST('XXX','BUG ')
52020         WRITE(ICOUT,9011)
52021         CALL DPWRST('XXX','BUG ')
52022         WRITE(ICOUT,9143)
52023         CALL DPWRST('XXX','BUG ')
52024         WRITE(ICOUT,9145)
52025         CALL DPWRST('XXX','BUG ')
52026         WRITE(ICOUT,9147)
52027         CALL DPWRST('XXX','BUG ')
52028         go to 9000
52029      end if
52030c                                  Compute log factorials
52031      fact(0) = 0.0d0
52032      fact(1) = 0.0d0
52033      fact(2) = dlog(2.0d0)
52034      do 80  i=3, ntot, 2
52035         fact(i) = fact(i-1) + dlog(dble(i))
52036         j       = i + 1
52037         if (j .le. ntot) fact(j) = fact(i) + fact(2) + fact(j/2) -
52038     &       fact(j/2-1)
52039   80 continue
52040c                                  Compute observed path length: OBS
52041      obs  = tol
52042      ntot = 0
52043      do 100  j=1, nco
52044         dd = 0.0
52045         do 90  i=1, nro
52046            if (nrow .le. ncol) then
52047               dd   = dd + fact(nint(table(i,j)))
52048               ntot = ntot + nint(table(i,j))
52049            else
52050               dd   = dd + fact(nint(table(j,i)))
52051               ntot = ntot + nint(table(j,i))
52052            end if
52053   90    continue
52054         obs = obs + fact(ico(j)) - dd
52055  100 continue
52056c                                  Denominator of observed table: DRO
52057      dro = f9xact(nro,ntot,iro,fact)
52058      prt = dexp(obs-dro)
52059c                                  Initialize pointers
52060      k        = nco
52061      last     = ldkey + 1
52062      jkey     = ldkey + 1
52063      jstp     = ldstp + 1
52064      jstp2    = 3*ldstp + 1
52065      jstp3    = 4*ldstp + 1
52066      jstp4    = 5*ldstp + 1
52067      ikkey    = 0
52068      ikstp    = 0
52069      ikstp2   = 2*ldstp
52070      ipo      = 1
52071      ipoin(1) = 1
52072      stp(1)   = 0.0
52073      ifrq(1)  = 1
52074      ifrq(ikstp2+1) = -1
52075c
52076  110 kb = nco - k + 1
52077      ks   = 0
52078      n    = ico(kb)
52079      kd   = nro + 1
52080      kmax = nro
52081c                                  IDIF is the difference in going to th
52082c                                  daughter
52083      do 120  i=1, nro
52084         idif(i) = 0
52085  120 continue
52086c                                  Generate the first daughter
52087  130 kd = kd - 1
52088      ntot     = min0(n,iro(kd))
52089      idif(kd) = ntot
52090      if (idif(kmax) .eq. 0) kmax = kmax - 1
52091      n = n - ntot
52092      if (n.gt.0 .and. kd.ne.1) go to 130
52093      if (n .ne. 0) go to 310
52094c
52095      k1   = k - 1
52096      n    = ico(kb)
52097      ntot = 0
52098      do 140  i=kb + 1, nco
52099         ntot = ntot + ico(i)
52100  140 continue
52101c                                  Arc to daughter length=ICO(KB)
52102  150 do 160  i=1, nro
52103         irn(i) = iro(i) - idif(i)
52104  160 continue
52105c                                  Sort irn
52106      if (k1 .gt. 1) then
52107         if (nro .eq. 2) then
52108            if (irn(1) .gt. irn(2)) then
52109               ii     = irn(1)
52110               irn(1) = irn(2)
52111               irn(2) = ii
52112            end if
52113         else if (nro .eq. 3) then
52114            ii = irn(1)
52115            if (ii .gt. irn(3)) then
52116               if (ii .gt. irn(2)) then
52117                  if (irn(2) .gt. irn(3)) then
52118                     irn(1) = irn(3)
52119                     irn(3) = ii
52120                  else
52121                     irn(1) = irn(2)
52122                     irn(2) = irn(3)
52123                     irn(3) = ii
52124                  end if
52125               else
52126                  irn(1) = irn(3)
52127                  irn(3) = irn(2)
52128                  irn(2) = ii
52129               end if
52130            else if (ii .gt. irn(2)) then
52131               irn(1) = irn(2)
52132               irn(2) = ii
52133            else if (irn(2) .gt. irn(3)) then
52134               ii     = irn(2)
52135               irn(2) = irn(3)
52136               irn(3) = ii
52137            end if
52138         else
52139            do 180  j=2, nro
52140               i  = j - 1
52141               ii = irn(j)
52142  170          if (ii .lt. irn(i)) then
52143                  irn(i+1) = irn(i)
52144                  i        = i - 1
52145                  if (i .gt. 0) go to 170
52146               end if
52147               irn(i+1) = ii
52148  180       continue
52149         end if
52150c                                  Adjust start for zero
52151         do 190  i=1, nro
52152            if (irn(i) .ne. 0) go to 200
52153  190    continue
52154  200    nrb = i
52155         nro2 = nro - i + 1
52156      else
52157         nrb  = 1
52158         nro2 = nro
52159      end if
52160c                                  Some table values
52161      ddf = f9xact(nro,n,idif,fact)
52162      drn = f9xact(nro2,ntot,irn(nrb),fact) - dro + ddf
52163c                                  Get hash value
52164      if (k1 .gt. 1) then
52165         kval = irn(1) + irn(2)*kyy(2)
52166         do 210  i=3, nro
52167            kval = kval + irn(i)*kyy(i)
52168  210    continue
52169c                                  Get hash table entry
52170         i = mod(kval,2*ldkey) + 1
52171c                                  Search for unused location
52172         do 220  itp=i, 2*ldkey
52173            ii = key2(itp)
52174            if (ii .eq. kval) then
52175               go to 240
52176            else if (ii .lt. 0) then
52177               key2(itp) = kval
52178               dlp(itp)  = 1.0d0
52179               dsp(itp)  = 1.0d0
52180               go to 240
52181            end if
52182  220    continue
52183c
52184         do 230  itp=1, i - 1
52185            ii = key2(itp)
52186            if (ii .eq. kval) then
52187               go to 240
52188            else if (ii .lt. 0) then
52189               key2(itp) = kval
52190               dlp(itp)  = 1.0
52191               go to 240
52192            end if
52193  230    continue
52194c
52195ccccc    call prterr (6, 'LDKEY is too small.  It is not possible to '//
52196ccccc&               'give thevalue of LDKEY required, but you could '//
52197ccccc&               'try doubling LDKEY (and possibly LDSTP).')
52198         WRITE(ICOUT,999)
52199         CALL DPWRST('XXX','BUG ')
52200         WRITE(ICOUT,9011)
52201         CALL DPWRST('XXX','BUG ')
52202         WRITE(ICOUT,9153)
52203 9153    FORMAT('        LDKEY is too small.  It is not possible to ')
52204         CALL DPWRST('XXX','BUG ')
52205         WRITE(ICOUT,9155)
52206 9155    FORMAT('        give the value of LDKEY required, but you')
52207         CALL DPWRST('XXX','BUG ')
52208         WRITE(ICOUT,9157)
52209 9157    FORMAT('        could try doubling LDKEY (and possibly ',
52210     &          'LDSTP).')
52211         CALL DPWRST('XXX','BUG ')
52212      end if
52213c
52214  240 ipsh = .true.
52215c                                  Recover pastp
52216      ipn   = ipoin(ipo+ikkey)
52217      pastp = stp(ipn+ikstp)
52218      ifreq = ifrq(ipn+ikstp)
52219c                                  Compute shortest and longest path
52220      if (k1 .gt. 1) then
52221         obs2 = obs - fact(ico(kb+1)) - fact(ico(kb+2)) - ddf
52222         do 250  i=3, k1
52223            obs2 = obs2 - fact(ico(kb+i))
52224  250    continue
52225c
52226         if (dlp(itp) .gt. 0.0d0) then
52227            dspt = obs - obs2 - ddf
52228c                                  Compute longest path
52229            dlp(itp) = 0.0d0
52230            call f3xact (nro2, irn(nrb), k1, ico(kb+1), dlp(itp),
52231     &                   ntot, fact, iwk(i31), iwk(i32), iwk(i33),
52232     &                   iwk(i34), iwk(i35), iwk(i36), iwk(i37),
52233     &                   iwk(i38), iwk(i39), rwk(i310), rwk(i311), tol)
52234            dlp(itp) = dmin1(0.0d0,dlp(itp))
52235c                                  Compute shortest path
52236            dsp(itp) = dspt
52237            call f4xact (nro2, irn(nrb), k1, ico(kb+1), dsp(itp),
52238     &                   fact, iwk(i47), iwk(i41), iwk(i42), iwk(i43),
52239     &                   iwk(i44), iwk(i45), iwk(i46), rwk(i48), tol)
52240            dsp(itp) = dmin1(0.0d0,dsp(itp)-dspt)
52241c                                  Use chi-squared approximation?
52242            if (dble(irn(nrb)*ico(kb+1))/dble(ntot) .gt. emn) then
52243               ncell = 0
52244               do 270  i=1, nro2
52245                  do 260  j=1, k1
52246                     if (irn(nrb+i-1)*ico(kb+j) .ge. ntot*expect) then
52247                        ncell = ncell + 1
52248                     end if
52249  260             continue
52250  270          continue
52251               if (ncell*100 .ge. k1*nro2*percnt) then
52252                  tmp = 0.0
52253                  do 280  i=1, nro2
52254                     tmp = tmp + fact(irn(nrb+i-1)) -
52255     &                     fact(irn(nrb+i-1)-1)
52256  280             continue
52257                  tmp = tmp*(k1-1)
52258                  do 290  j=1, k1
52259                     tmp = tmp + (nro2-1)*(fact(ico(kb+j))-fact(ico(kb+
52260     &                     j)-1))
52261  290             continue
52262                  df      = (nro2-1)*(k1-1)
52263                  tmp     = tmp + df*1.83787706640934548356065947281d0
52264                  tmp     = tmp - (nro2*k1-1)*(fact(ntot)-fact(ntot-1))
52265                  tm(itp) = -2.0d0*(obs-dro) - tmp
52266               else
52267c                                  tm(itp) set to a flag value
52268                  tm(itp) = -9876.0d0
52269               end if
52270            else
52271               tm(itp) = -9876.0d0
52272            end if
52273         end if
52274         obs3 = obs2 - dlp(itp)
52275         obs2 = obs2 - dsp(itp)
52276         if (tm(itp) .eq. -9876.0d0) then
52277            chisq = .false.
52278         else
52279            chisq = .true.
52280            tmp   = tm(itp)
52281         end if
52282      else
52283         obs2 = obs - drn - dro
52284         obs3 = obs2
52285      end if
52286c                                  Process node with new PASTP
52287  300 if (pastp .le. obs3) then
52288c                                  Update pre
52289         pre = pre + dble(ifreq)*dexp(pastp+drn)
52290c
52291      else if (pastp .lt. obs2) then
52292         if (chisq) then
52293            df  = (nro2-1)*(k1-1)
52294            pv  = 1.0 - gammds(dmax1(0.0d0,tmp+2.0d0*(pastp+drn))/
52295     &            2.0d0,df/2.0d0,ifault)
52296            pre = pre + dble(ifreq)*dexp(pastp+drn)*pv
52297         else
52298c                                  Put daughter on queue
52299            call f5xact (pastp+ddf, tol, kval, key(jkey), ldkey,
52300     &                   ipoin(jkey), stp(jstp), ldstp, ifrq(jstp),
52301     &                   ifrq(jstp2), ifrq(jstp3), ifrq(jstp4), ifreq,
52302     &                   itop, ipsh)
52303            ipsh = .false.
52304         end if
52305      end if
52306c                                  Get next PASTP on chain
52307      ipn = ifrq(ipn+ikstp2)
52308      if (ipn .gt. 0) then
52309         pastp = stp(ipn+ikstp)
52310         ifreq = ifrq(ipn+ikstp)
52311         go to 300
52312      end if
52313c                                  Generate a new daughter node
52314      call f7xact (kmax, iro, idif, kd, ks, iflag)
52315      if (iflag .ne. 1) go to 150
52316c                                  Go get a new mother from stage K
52317  310 iflag = 1
52318      call f6xact (nro, iro, iflag, kyy, key(ikkey+1), ldkey, last,
52319     &             ipo)
52320c                                  Update pointers
52321      if (iflag .eq. 3) then
52322         k      = k - 1
52323         itop   = 0
52324         ikkey  = jkey - 1
52325         ikstp  = jstp - 1
52326         ikstp2 = jstp2 - 1
52327         jkey   = ldkey - jkey + 2
52328         jstp   = ldstp - jstp + 2
52329         jstp2  = 2*ldstp + jstp
52330         do 320  i=1, 2*ldkey
52331            key2(i) = -9999
52332  320    continue
52333         if (k .ge. 2) go to 310
52334      else
52335         go to 110
52336      end if
52337c
52338 9000 return
52339      end
52340      subroutine f3xact (nrow, irow, ncol, icol, dlp, mm, fact, ico,
52341     &                   iro, it, lb, nr, nt, nu, itc, ist, stv, alen,
52342     &                   tol)
52343c-----------------------------------------------------------------------
52344c  Name:       F3XACT
52345c
52346c  Purpose:    Computes the shortest path length for a given table.
52347c
52348c  Usage:      CALL F3XACT (NROW, IROW, NCOL, ICOL, DLP, MM, FACT, ICO,
52349c                          IRO, IT, LB, NR, NT, NU, ITC, IST, STV, ALEN,
52350c                          TOL)
52351c
52352c  Arguments:
52353c     NROW   - The number of rows in the table.  (Input)
52354c     IROW   - Vector of length NROW containing the row sums for the
52355c              table.  (Input)
52356c     NCOL   - The number of columns in the table.  (Input)
52357c     ICOL   - Vector of length K containing the column sums for the
52358c              table.  (Input)
52359c     DLP    - The longest path for the table.  (Output)
52360c     MM     - The total count in the table.  (Output)
52361c     FACT   - Vector containing the logarithms of factorials.  (Input)
52362c     ICO    - Work vector of length MAX(NROW,NCOL).
52363c     IRO    - Work vector of length MAX(NROW,NCOL).
52364c     IT     - Work vector of length MAX(NROW,NCOL).
52365c     LB     - Work vector of length MAX(NROW,NCOL).
52366c     NR     - Work vector of length MAX(NROW,NCOL).
52367c     NT     - Work vector of length MAX(NROW,NCOL).
52368c     NU     - Work vector of length MAX(NROW,NCOL).
52369c     ITC    - Work vector of length 400.
52370c     IST    - Work vector of length 400.
52371c     STV    - Work vector of length 400.
52372c     ALEN   - Work vector of length MAX(NROW,NCOL).
52373c     TOL    - Tolerance.  (Input)
52374c-----------------------------------------------------------------------
52375c                                  SPECIFICATIONS FOR ARGUMENTS
52376      integer    nrow, ncol, mm, irow(*), icol(*), ico(*), iro(*),
52377     &           it(*), lb(*), nr(*), nt(*), nu(*), itc(*), ist(*)
52378      double precision dlp, tol, fact(0:*), stv(*), alen(0:*)
52379c                                  SPECIFICATIONS FOR LOCAL VARIABLES
52380      integer    i, ic1, ic2, ii, ipn, irl, itp, k, key, ks, kyy, lev,
52381     &           n11, n12, nc1, nc1s, nco, nct, nn, nn1, nr1, nro, nrt
52382      double precision v, val, vmn
52383      logical    xmin
52384c                                  SPECIFICATIONS FOR SAVE VARIABLES
52385      integer    ldst, nitc, nst
52386      save       ldst, nitc, nst
52387c                                  SPECIFICATIONS FOR INTRINSICS
52388      intrinsic  dmin1, int, mod, dble
52389ccccc integer    int, mod
52390ccccc double precision dmin1, dble
52391c                                  SPECIFICATIONS FOR SUBROUTINES
52392ccccc external   prterr, f10act, isort
52393      external   f10act, isort
52394C
52395      INCLUDE 'DPCOP2.INC'
52396C
52397c***********************************************************************
52398c
52399      data ldst/200/, nst/0/, nitc/0/
52400c
52401      do 10  i=0, ncol
52402         alen(i) = 0.0
52403   10 continue
52404      do 20  i=1, 400
52405         ist(i) = -1
52406   20 continue
52407c                                  nrow is 1
52408      if (nrow .le. 1) then
52409         if (nrow .gt. 0) then
52410            dlp = dlp - fact(icol(1))
52411            do 30  i=2, ncol
52412               dlp = dlp - fact(icol(i))
52413   30       continue
52414         end if
52415         go to 9000
52416      end if
52417c                                  ncol is 1
52418      if (ncol .le. 1) then
52419         if (ncol .gt. 0) then
52420            dlp = dlp - fact(irow(1)) - fact(irow(2))
52421            do 40  i=3, nrow
52422               dlp = dlp - fact(irow(i))
52423   40       continue
52424         end if
52425         go to 9000
52426      end if
52427c                                  2 by 2 table
52428      if (nrow*ncol .eq. 4) then
52429         n11 = (irow(1)+1)*(icol(1)+1)/(mm+2)
52430         n12 = irow(1) - n11
52431         dlp = dlp - fact(n11) - fact(n12) - fact(icol(1)-n11) -
52432     &         fact(icol(2)-n12)
52433         go to 9000
52434      end if
52435c                                  Test for optimal table
52436      val  = 0.0
52437      xmin = .false.
52438      if (irow(nrow) .le. irow(1)+ncol) then
52439         call f10act (nrow, irow, ncol, icol, val, xmin, fact, lb, nu,
52440     &                nr)
52441      end if
52442      if (.not.xmin) then
52443         if (icol(ncol) .le. icol(1)+nrow) then
52444            call f10act (ncol, icol, nrow, irow, val, xmin, fact, lb,
52445     &                   nu, nr)
52446         end if
52447      end if
52448c
52449      if (xmin) then
52450         dlp = dlp - val
52451         go to 9000
52452      end if
52453c                                  Setup for dynamic programming
52454      nn = mm
52455c                                  Minimize ncol
52456      if (nrow .ge. ncol) then
52457         nro = nrow
52458         nco = ncol
52459c
52460         do 50  i=1, nrow
52461            iro(i) = irow(i)
52462   50    continue
52463c
52464         ico(1) = icol(1)
52465         nt(1)  = nn - ico(1)
52466         do 60  i=2, ncol
52467            ico(i) = icol(i)
52468            nt(i)  = nt(i-1) - ico(i)
52469   60    continue
52470      else
52471         nro = ncol
52472         nco = nrow
52473c
52474         ico(1) = irow(1)
52475         nt(1)  = nn - ico(1)
52476         do 70  i=2, nrow
52477            ico(i) = irow(i)
52478            nt(i)  = nt(i-1) - ico(i)
52479   70    continue
52480c
52481         do 80  i=1, ncol
52482            iro(i) = icol(i)
52483   80    continue
52484      end if
52485c                                  Initialize pointers
52486      vmn  = 1.0d10
52487      nc1s = nco - 1
52488      irl  = 1
52489      ks   = 0
52490      k    = ldst
52491      kyy  = ico(nco) + 1
52492      go to 100
52493c                                  Test for optimality
52494   90 xmin = .false.
52495      if (iro(nro) .le. iro(irl)+nco) then
52496         call f10act (nro, iro(irl), nco, ico, val, xmin, fact, lb,
52497     &                nu, nr)
52498      end if
52499      if (.not.xmin) then
52500         if (ico(nco) .le. ico(1)+nro) then
52501            call f10act (nco, ico, nro, iro(irl), val, xmin, fact, lb,
52502     &                   nu, nr)
52503         end if
52504      end if
52505c
52506      if (xmin) then
52507         if (val .lt. vmn) vmn = val
52508         go to 200
52509      end if
52510c                                  Setup to generate new node
52511  100 lev = 1
52512      nr1   = nro - 1
52513      nrt   = iro(irl)
52514      nct   = ico(1)
52515      lb(1) = int(dble((nrt+1)*(nct+1))/dble(nn+nr1*nc1s+1)-tol) - 1
52516      nu(1) = int(dble((nrt+nc1s)*(nct+nr1))/dble(nn+nr1+nc1s)) -
52517     &        lb(1) + 1
52518      nr(1) = nrt - lb(1)
52519c                                  Generate a node
52520  110 nu(lev) = nu(lev) - 1
52521      if (nu(lev) .eq. 0) then
52522         if (lev .eq. 1) go to 200
52523         lev = lev - 1
52524         go to 110
52525      end if
52526      lb(lev) = lb(lev) + 1
52527      nr(lev) = nr(lev) - 1
52528  120 alen(lev) = alen(lev-1) + fact(lb(lev))
52529      if (lev .lt. nc1s) then
52530         nn1     = nt(lev)
52531         nrt     = nr(lev)
52532         lev     = lev + 1
52533         nc1     = nco - lev
52534         nct     = ico(lev)
52535         lb(lev) = int(dble((nrt+1)*(nct+1))/dble(nn1+nr1*nc1+1) - tol)
52536         nu(lev) = int(dble((nrt+nc1)*(nct+nr1))/dble(nn1+nr1+nc1) -
52537     &             lb(lev) + 1)
52538         nr(lev) = nrt - lb(lev)
52539         go to 120
52540      end if
52541      alen(nco) = alen(lev) + fact(nr(lev))
52542      lb(nco)   = nr(lev)
52543c
52544      v = val + alen(nco)
52545      if (nro .eq. 2) then
52546c                                  Only 1 row left
52547         v = v + fact(ico(1)-lb(1)) + fact(ico(2)-lb(2))
52548         do 130  i=3, nco
52549            v = v + fact(ico(i)-lb(i))
52550  130    continue
52551         if (v .lt. vmn) vmn = v
52552      else if (nro.eq.3 .and. nco.eq.2) then
52553c                                  3 rows and 2 columns
52554         nn1 = nn - iro(irl) + 2
52555         ic1 = ico(1) - lb(1)
52556         ic2 = ico(2) - lb(2)
52557         n11 = (iro(irl+1)+1)*(ic1+1)/nn1
52558         n12 = iro(irl+1) - n11
52559         v   = v + fact(n11) + fact(n12) + fact(ic1-n11) +
52560     &         fact(ic2-n12)
52561         if (v .lt. vmn) vmn = v
52562      else
52563c                                  Column marginals are new node
52564         do 140  i=1, nco
52565            it(i) = ico(i) - lb(i)
52566  140    continue
52567c                                  Sort column marginals
52568         if (nco .eq. 2) then
52569            if (it(1) .gt. it(2)) then
52570               ii    = it(1)
52571               it(1) = it(2)
52572               it(2) = ii
52573            end if
52574         else if (nco .eq. 3) then
52575            ii = it(1)
52576            if (ii .gt. it(3)) then
52577               if (ii .gt. it(2)) then
52578                  if (it(2) .gt. it(3)) then
52579                     it(1) = it(3)
52580                     it(3) = ii
52581                  else
52582                     it(1) = it(2)
52583                     it(2) = it(3)
52584                     it(3) = ii
52585                  end if
52586               else
52587                  it(1) = it(3)
52588                  it(3) = it(2)
52589                  it(2) = ii
52590               end if
52591            else if (ii .gt. it(2)) then
52592               it(1) = it(2)
52593               it(2) = ii
52594            else if (it(2) .gt. it(3)) then
52595               ii    = it(2)
52596               it(2) = it(3)
52597               it(3) = ii
52598            end if
52599         else
52600            call isort (nco, it)
52601         end if
52602c                                  Compute hash value
52603         key = it(1)*kyy + it(2)
52604         do 150  i=3, nco
52605            key = it(i) + key*kyy
52606  150    continue
52607c                                  Table index
52608         ipn = mod(key,ldst) + 1
52609c                                  Find empty position
52610         ii = ks + ipn
52611         do 160  itp=ipn, ldst
52612            if (ist(ii) .lt. 0) then
52613               go to 180
52614            else if (ist(ii) .eq. key) then
52615               go to 190
52616            end if
52617            ii = ii + 1
52618  160    continue
52619c
52620         ii = ks + 1
52621         do 170  itp=1, ipn - 1
52622            if (ist(ii) .lt. 0) then
52623               go to 180
52624            else if (ist(ii) .eq. key) then
52625               go to 190
52626            end if
52627            ii = ii + 1
52628  170    continue
52629c
52630CCCCC    call prterr (30, 'Stack length exceeded in f3xact.'//
52631CCCCC&               '  This problem should not occur.')
52632         WRITE(ICOUT,999)
52633  999    FORMAT(1X)
52634         CALL DPWRST('XXX','BUG ')
52635         WRITE(ICOUT,9011)
52636 9011    FORMAT('***** ERROR IN R3XACT--')
52637         CALL DPWRST('XXX','BUG ')
52638         WRITE(ICOUT,9013)
52639 9013    FORMAT('      Stack length exceeded in f3xact.  This ',
52640     1          'problem should not occur.')
52641         CALL DPWRST('XXX','BUG ')
52642c                                  Push onto stack
52643  180    ist(ii) = key
52644         stv(ii) = v
52645         nst     = nst + 1
52646         ii      = nst + ks
52647         itc(ii) = itp
52648         go to 110
52649c                                  Marginals already on stack
52650  190    stv(ii) = dmin1(v,stv(ii))
52651      end if
52652      go to 110
52653c                                  Pop item from stack
52654  200 if (nitc .gt. 0) then
52655c                                  Stack index
52656         itp      = itc(nitc+k) + k
52657         nitc     = nitc - 1
52658         val      = stv(itp)
52659         key      = ist(itp)
52660         ist(itp) = -1
52661c                                  Compute marginals
52662         do 210  i=nco, 2, -1
52663            ico(i) = mod(key,kyy)
52664            key    = key/kyy
52665  210    continue
52666         ico(1) = key
52667c                                  Set up nt array
52668         nt(1) = nn - ico(1)
52669         do 220  i=2, nco
52670            nt(i) = nt(i-1) - ico(i)
52671  220    continue
52672         go to 90
52673c
52674      else if (nro.gt.2 .and. nst.gt.0) then
52675c                                  Go to next level
52676         nitc = nst
52677         nst  = 0
52678         k    = ks
52679         ks   = ldst - ks
52680         nn   = nn - iro(irl)
52681         irl  = irl + 1
52682         nro  = nro - 1
52683         go to 200
52684      end if
52685c
52686      dlp = dlp - vmn
52687 9000 return
52688      end
52689      subroutine f4xact (nrow, irow, ncol, icol, dsp, fact, icstk,
52690     &                   ncstk, lstk, mstk, nstk, nrstk, irstk, ystk,
52691     &                   tol)
52692c-----------------------------------------------------------------------
52693c  Name:       F4XACT
52694c
52695c  Purpose:    Computes the longest path length for a given table.
52696c
52697c  Usage:      CALL F4XACT (NROW, IROW, NCOL, ICOL, DSP, FACT, ICSTK,
52698c                          NCSTK, LSTK, MSTK, NSTK, NRSTK, IRSTK, YSTK,
52699c                          TOL)
52700c
52701c  Arguments:
52702c     NROW   - The number of rows in the table.  (Input)
52703c     IROW   - Vector of length NROW containing the row sums for the
52704c              table.  (Input)
52705c     NCOL   - The number of columns in the table.  (Input)
52706c     ICOL   - Vector of length K containing the column sums for the
52707c              table.  (Input)
52708c     DSP    - The shortest path for the table.  (Output)
52709c     FACT   - Vector containing the logarithms of factorials.  (Input)
52710c     ICSTK  - NCOL by NROW+NCOL+1 work array.
52711c     NCSTK  - Work vector of length NROW+NCOL+1.
52712c     LSTK   - Work vector of length NROW+NCOL+1.
52713c     MSTK   - Work vector of length NROW+NCOL+1.
52714c     NSTK   - Work vector of length NROW+NCOL+1.
52715c     NRSTK  - Work vector of length NROW+NCOL+1.
52716c     IRSTK  - NROW by MAX(NROW,NCOL) work array.
52717c     YSTK   - Work vector of length NROW+NCOL+1.
52718c     TOL    - Tolerance.  (Input)
52719c-----------------------------------------------------------------------
52720c                                  SPECIFICATIONS FOR ARGUMENTS
52721      integer    nrow, ncol, irow(*), icol(*), icstk(ncol,*),
52722     &           ncstk(*), lstk(*), mstk(*), nstk(*), nrstk(*),
52723     &           irstk(nrow,*)
52724      double precision dsp, tol, fact(0:*), ystk(*)
52725c                                  SPECIFICATIONS FOR LOCAL VARIABLES
52726      integer    i, ic1, ict, ir1, irt, istk, j, k, l, m, mn, n, nco,
52727     &           nro
52728      double precision amx, y
52729c                                  SPECIFICATIONS FOR SUBROUTINES
52730      external   f11act, f8xact
52731c                                  Take care of the easy cases firstkt
52732      if (nrow .eq. 1) then
52733         do 10  i=1, ncol
52734            dsp = dsp - fact(icol(i))
52735   10    continue
52736         go to 9000
52737      end if
52738c
52739      if (ncol .eq. 1) then
52740         do 20  i=1, nrow
52741            dsp = dsp - fact(irow(i))
52742   20    continue
52743         go to 9000
52744      end if
52745c
52746      if (nrow*ncol .eq. 4) then
52747         if (irow(2) .le. icol(2)) then
52748            dsp = dsp - fact(irow(2)) - fact(icol(1)) -
52749     &            fact(icol(2)-irow(2))
52750         else
52751            dsp = dsp - fact(icol(2)) - fact(irow(1)) -
52752     &            fact(irow(2)-icol(2))
52753         end if
52754         go to 9000
52755      end if
52756c                                  initialization before loop
52757      do 30  i=1, nrow
52758         irstk(i,1) = irow(nrow-i+1)
52759   30 continue
52760c
52761      do 40  j=1, ncol
52762         icstk(j,1) = icol(ncol-j+1)
52763   40 continue
52764c
52765      nro      = nrow
52766      nco      = ncol
52767      nrstk(1) = nro
52768      ncstk(1) = nco
52769      ystk(1)  = 0.0
52770      y        = 0.0
52771      istk     = 1
52772      l        = 1
52773      amx      = 0.0
52774c
52775   50 ir1 = irstk(1,istk)
52776      ic1 = icstk(1,istk)
52777      if (ir1 .gt. ic1) then
52778         if (nro .ge. nco) then
52779            m = nco - 1
52780            n = 2
52781         else
52782            m = nro
52783            n = 1
52784         end if
52785      else if (ir1 .lt. ic1) then
52786         if (nro .le. nco) then
52787            m = nro - 1
52788            n = 1
52789         else
52790            m = nco
52791            n = 2
52792         end if
52793      else
52794         if (nro .le. nco) then
52795            m = nro - 1
52796            n = 1
52797         else
52798            m = nco - 1
52799            n = 2
52800         end if
52801      end if
52802c
52803   60 if (n .eq. 1) then
52804         i = l
52805         j = 1
52806      else
52807         i = 1
52808         j = l
52809      end if
52810c
52811      irt = irstk(i,istk)
52812      ict = icstk(j,istk)
52813      mn  = irt
52814      if (mn .gt. ict) mn = ict
52815      y = y + fact(mn)
52816      if (irt .eq. ict) then
52817         nro = nro - 1
52818         nco = nco - 1
52819         call f11act (irstk(1,istk), i, nro, irstk(1,istk+1))
52820         call f11act (icstk(1,istk), j, nco, icstk(1,istk+1))
52821      else if (irt .gt. ict) then
52822         nco = nco - 1
52823         call f11act (icstk(1,istk), j, nco, icstk(1,istk+1))
52824         call f8xact (irstk(1,istk), irt-ict, i, nro, irstk(1,istk+1))
52825      else
52826         nro = nro - 1
52827         call f11act (irstk(1,istk), i, nro, irstk(1,istk+1))
52828         call f8xact (icstk(1,istk), ict-irt, j, nco, icstk(1,istk+1))
52829      end if
52830c
52831      if (nro .eq. 1) then
52832         do 70  k=1, nco
52833            y = y + fact(icstk(k,istk+1))
52834   70    continue
52835         go to 90
52836      end if
52837c
52838      if (nco .eq. 1) then
52839         do 80  k=1, nro
52840            y = y + fact(irstk(k,istk+1))
52841   80    continue
52842         go to 90
52843      end if
52844c
52845      lstk(istk)  = l
52846      mstk(istk)  = m
52847      nstk(istk)  = n
52848      istk        = istk + 1
52849      nrstk(istk) = nro
52850      ncstk(istk) = nco
52851      ystk(istk)  = y
52852      l           = 1
52853      go to 50
52854c
52855   90 if (y .gt. amx) then
52856         amx = y
52857         if (dsp-amx .le. tol) then
52858            dsp = 0.0
52859            go to 9000
52860         end if
52861      end if
52862c
52863  100 istk = istk - 1
52864      if (istk .eq. 0) then
52865         dsp = dsp - amx
52866         if (dsp-amx .le. tol) dsp = 0.0
52867         go to 9000
52868      end if
52869      l = lstk(istk) + 1
52870c
52871  110 if (l .gt. mstk(istk)) go to 100
52872      n   = nstk(istk)
52873      nro = nrstk(istk)
52874      nco = ncstk(istk)
52875      y   = ystk(istk)
52876      if (n .eq. 1) then
52877         if (irstk(l,istk) .lt. irstk(l-1,istk)) go to 60
52878      else if (n .eq. 2) then
52879         if (icstk(l,istk) .lt. icstk(l-1,istk)) go to 60
52880      end if
52881c
52882      l = l + 1
52883      go to 110
52884 9000 return
52885      end
52886      subroutine f5xact (pastp, tol, kval, key, ldkey, ipoin, stp,
52887     &                   ldstp, ifrq, npoin, nr, nl, ifreq, itop, ipsh)
52888c-----------------------------------------------------------------------
52889c  Name:       F5XACT
52890c
52891c  Purpose:    Put node on stack in network algorithm.
52892c
52893c  Usage:      CALL F5XACT (PASTP, TOL, KVAL, KEY, LDKEY, IPOIN, STP,
52894c                          LDSTP, IFRQ, NPOIN, NR, NL, IFREQ, ITOP,
52895c                          IPSH)
52896c
52897c  Arguments:
52898c     PASTP  - The past path length.  (Input)
52899c     TOL    - Tolerance for equivalence of past path lengths.  (Input)
52900c     KVAL   - Key value.  (Input)
52901c     KEY    - Vector of length LDKEY containing the key values.
52902c              (Input/output)
52903c     LDKEY  - Length of vector KEY.  (Input)
52904c     IPOIN  - Vector of length LDKEY pointing to the linked list
52905c              of past path lengths.  (Input/output)
52906c     STP    - Vector of length LSDTP containing the linked lists
52907c              of past path lengths.  (Input/output)
52908c     LDSTP  - Length of vector STP.  (Input)
52909c     IFRQ   - Vector of length LDSTP containing the past path
52910c              frequencies.  (Input/output)
52911c     NPOIN  - Vector of length LDSTP containing the pointers to
52912c              the next past path length.  (Input/output)
52913c     NR     - Vector of length LDSTP containing the right object
52914c              pointers in the tree of past path lengths.
52915c              (Input/output)
52916c     NL     - Vector of length LDSTP containing the left object
52917c              pointers in the tree of past path lengths.
52918c              (Input/output)
52919c     IFREQ  - Frequency of the current path length.  (Input)
52920c     ITOP   - Pointer to the top of STP.  (Input)
52921c     IPSH   - Option parameter.  (Input)
52922c              If IPSH is true, the past path length is found in the
52923c              table KEY.  Otherwise the location of the past path
52924c              length is assumed known and to have been found in
52925c              a previous call.
52926c-----------------------------------------------------------------------
52927c                                  SPECIFICATIONS FOR ARGUMENTS
52928      integer    kval, ldkey, ldstp, ifreq, itop, key(*), ipoin(*),
52929     &           ifrq(*), npoin(*), nr(*), nl(*)
52930      double precision pastp, tol, stp(*)
52931      logical    ipsh
52932c                                  SPECIFICATIONS FOR LOCAL VARIABLES
52933      integer    ipn, irdzz, itmp
52934      double precision test1, test2
52935c                                  SPECIFICATIONS FOR SAVE VARIABLES
52936      integer    itp
52937      save       itp
52938c                                  SPECIFICATIONS FOR INTRINSICS
52939      intrinsic  mod
52940ccccc integer    mod
52941c                                  SPECIFICATIONS FOR SUBROUTINES
52942ccccc external   prterr
52943c
52944      INCLUDE 'DPCOP2.INC'
52945C
52946      if (ipsh) then
52947c                                  Convert KVAL to integer in range
52948c                                  1, ..., LDKEY.
52949         irdzz = mod(kval,ldkey) + 1
52950c                                  Search for an unused location
52951         do 10  itp=irdzz, ldkey
52952            if (key(itp) .eq. kval) go to 40
52953            if (key(itp) .lt. 0) go to 30
52954   10    continue
52955c
52956         do 20  itp=1, irdzz - 1
52957            if (key(itp) .eq. kval) go to 40
52958            if (key(itp) .lt. 0) go to 30
52959   20    continue
52960c                                  Return if KEY array is full
52961CCCCC    call prterr(6, 'LDKEY is too small for this problem.  It is '//
52962CCCCC&               'not possible to estimate the value of LDKEY '//
52963CCCCC&               'required, but twice the current value may be '//
52964CCCCC&               'sufficient.')
52965      WRITE(ICOUT,999)
52966  999 FORMAT(1X)
52967      CALL DPWRST('XXX','BUG ')
52968      WRITE(ICOUT,9011)
52969 9011 FORMAT('***** ERROR IN FISHER EXACT TEST.')
52970      CALL DPWRST('XXX','BUG ')
52971      WRITE(ICOUT,9013)
52972 9013 FORMAT('      LDKEY is too small for this proble,.  It is not')
52973      CALL DPWRST('XXX','BUG ')
52974      WRITE(ICOUT,9015)
52975 9015 FORMAT('      possible to estimate the value of LDKEY required,')
52976      CALL DPWRST('XXX','BUG ')
52977      WRITE(ICOUT,9017)
52978 9017 FORMAT('      possible to estimate the value of LDKEY required,')
52979      CALL DPWRST('XXX','BUG ')
52980c                                  Update KEY
52981   30    key(itp) = kval
52982         itop       = itop + 1
52983         ipoin(itp) = itop
52984c                                  Return if STP array full
52985         if (itop .gt. ldstp) then
52986CCCCC       call prterr(7, 'LDSTP is too small for this problem.  It '//
52987CCCCC&                  'is not possible to estimate the value of '//
52988CCCCC&                  'LDSTP required, but twice the current value '//
52989CCCCC&                  'may be sufficient.')
52990            WRITE(ICOUT,999)
52991            CALL DPWRST('XXX','BUG ')
52992            WRITE(ICOUT,9111)
52993            CALL DPWRST('XXX','BUG ')
52994            WRITE(ICOUT,9113)
52995            CALL DPWRST('XXX','BUG ')
52996            WRITE(ICOUT,9115)
52997            CALL DPWRST('XXX','BUG ')
52998            WRITE(ICOUT,9117)
52999            CALL DPWRST('XXX','BUG ')
53000         end if
53001 9111 FORMAT('***** ERROR IN FISHER EXACT TEST.')
53002 9113 FORMAT('      LDSTP is too small for this problem.  It is not')
53003 9115 FORMAT('      possible to estimate the value of LDSTP required,')
53004 9117 FORMAT('      but twice the current value may be sufficient.')
53005c                                  Update STP, etc.
53006         npoin(itop) = -1
53007         nr(itop)    = -1
53008         nl(itop)    = -1
53009         stp(itop)   = pastp
53010         ifrq(itop)  = ifreq
53011         go to 9000
53012      end if
53013c                                  Find location, if any, of pastp
53014   40 ipn = ipoin(itp)
53015      test1 = pastp - tol
53016      test2 = pastp + tol
53017c
53018   50 if (stp(ipn) .lt. test1) then
53019         ipn = nl(ipn)
53020         if (ipn .gt. 0) go to 50
53021      else if (stp(ipn) .gt. test2) then
53022         ipn = nr(ipn)
53023         if (ipn .gt. 0) go to 50
53024      else
53025         ifrq(ipn) = ifrq(ipn) + ifreq
53026         go to 9000
53027      end if
53028c                                  Return if STP array full
53029      itop = itop + 1
53030      if (itop .gt. ldstp) then
53031ccccc    call prterr(7, 'LDSTP is too small for this problem.  It is '//
53032ccccc&               'not possible to estimate the value of LDSTP '//
53033ccccc&               'rerquired, but twice the current value may be '//
53034ccccc&               'sufficient.')
53035            WRITE(ICOUT,999)
53036            CALL DPWRST('XXX','BUG ')
53037            WRITE(ICOUT,9111)
53038            CALL DPWRST('XXX','BUG ')
53039            WRITE(ICOUT,9113)
53040            CALL DPWRST('XXX','BUG ')
53041            WRITE(ICOUT,9115)
53042            CALL DPWRST('XXX','BUG ')
53043            WRITE(ICOUT,9117)
53044            CALL DPWRST('XXX','BUG ')
53045         go to 9000
53046      end if
53047c                                  Find location to add value
53048      ipn  = ipoin(itp)
53049      itmp = ipn
53050   60 if (stp(ipn) .lt. test1) then
53051         itmp = ipn
53052         ipn  = nl(ipn)
53053         if (ipn .gt. 0) then
53054            go to 60
53055         else
53056            nl(itmp) = itop
53057         end if
53058      else if (stp(ipn) .gt. test2) then
53059         itmp = ipn
53060         ipn  = nr(ipn)
53061         if (ipn .gt. 0) then
53062            go to 60
53063         else
53064            nr(itmp) = itop
53065         end if
53066      end if
53067c                                  Update STP, etc.
53068      npoin(itop) = npoin(itmp)
53069      npoin(itmp) = itop
53070      stp(itop)   = pastp
53071      ifrq(itop)  = ifreq
53072      nl(itop)    = -1
53073      nr(itop)    = -1
53074c
53075 9000 return
53076      end
53077      subroutine f6xact (nrow, irow, iflag, kyy, key, ldkey, last, ipn)
53078c-----------------------------------------------------------------------
53079c  Name:       F6XACT
53080c
53081c  Purpose:    Pop a node off the stack.
53082c
53083c  Usage:      CALL F6XACT (NROW, IROW, IFLAG, KYY, KEY, LDKEY, LAST,
53084c                          IPN)
53085c
53086c  Arguments:
53087c     NROW   - The number of rows in the table.  (Input)
53088c     IROW   - Vector of length nrow containing the row sums on output.
53089c              (Output)
53090c     IFLAG  - Set to 3 if there are no additional nodes to process.
53091c              (Output)
53092c     KYY    - Constant mutlipliers used in forming the hash table key.
53093c              (Input)
53094c     KEY    - Vector of length LDKEY containing the hash table keys.
53095c              (Input/output)
53096c     LDKEY  - Length of vector KEY.  (Input)
53097c     LAST   - Index of the last key popped off the stack.
53098c              (Input/output)
53099c     IPN    - Pointer to the linked list of past path lengths.
53100c              (Output)
53101c-----------------------------------------------------------------------
53102c                                  SPECIFICATIONS FOR ARGUMENTS
53103      integer    nrow, iflag, ldkey, last, ipn, irow(*), kyy(*), key(*)
53104c                                  SPECIFICATIONS FOR LOCAL VARIABLES
53105      integer    j, kval
53106c                                  SPECIFICATIONS FOR SAVE VARIABLES
53107c
53108   10 last = last + 1
53109      if (last .le. ldkey) then
53110         if (key(last) .lt. 0) go to 10
53111c                                  Get KVAL from the stack
53112         kval      = key(last)
53113         key(last) = -9999
53114         do 20  j=nrow, 2, -1
53115            irow(j) = kval/kyy(j)
53116            kval    = kval - irow(j)*kyy(j)
53117   20    continue
53118         irow(1) = kval
53119         ipn     = last
53120      else
53121         last  = 0
53122         iflag = 3
53123      end if
53124      return
53125      end
53126      subroutine f7xact (nrow, imax, idif, k, ks, iflag)
53127c-----------------------------------------------------------------------
53128c  Name:       F7XACT
53129c
53130c  Purpose:    Generate the new nodes for given marinal totals.
53131c
53132c  Usage:      CALL F7XACT (NROW, IMAX, IDIF, K, KS, IFLAG)
53133c
53134c  Arguments:
53135c     NROW   - The number of rows in the table.  (Input)
53136c     IMAX   - The row marginal totals.  (Input)
53137c     IDIF   - The column counts for the new column.  (Input/output)
53138c     K      - Indicator for the row to decrement.  (Input/output)
53139c     KS     - Indicator for the row to increment.  (Input/output)
53140c     IFLAG  - Status indicator.  (Output)
53141c              If IFLAG is zero, a new table was generated.  For
53142c              IFLAG = 1, no additional tables could be generated.
53143c-----------------------------------------------------------------------
53144c                                  SPECIFICATIONS FOR ARGUMENTS
53145      integer    nrow, k, ks, iflag, imax(*), idif(*)
53146c                                  SPECIFICATIONS FOR LOCAL VARIABLES
53147      integer    i, k1, m, mm
53148c                                  SPECIFICATIONS FOR INTRINSICS
53149      intrinsic  min0
53150ccccc integer    min0
53151c
53152      iflag = 0
53153c                                  Find node which can be
53154c                                  incremented, ks
53155      if (ks .eq. 0) then
53156   10    ks = ks + 1
53157         if (idif(ks) .eq. imax(ks)) go to 10
53158      end if
53159c                                 Find node to decrement (>ks)
53160      if (idif(k).gt.0 .and. k.gt.ks) then
53161         idif(k) = idif(k) - 1
53162   30    k = k - 1
53163         if (imax(k) .eq. 0) go to 30
53164         m = k
53165c                                 Find node to increment (>=ks)
53166   40    if (idif(m) .ge. imax(m)) then
53167            m = m - 1
53168            go to 40
53169         end if
53170         idif(m) = idif(m) + 1
53171c                                 Change ks
53172         if (m .eq. ks) then
53173            if (idif(m) .eq. imax(m)) ks = k
53174         end if
53175      else
53176c                                 Check for finish
53177   50    do 60  k1=k + 1, nrow
53178            if (idif(k1) .gt. 0) go to 70
53179   60    continue
53180         iflag = 1
53181         go to 9000
53182c                                 Reallocate counts
53183   70    mm = 1
53184         do 80  i=1, k
53185            mm      = mm + idif(i)
53186            idif(i) = 0
53187   80    continue
53188         k = k1
53189   90    k = k - 1
53190         m       = min0(mm,imax(k))
53191         idif(k) = m
53192         mm      = mm - m
53193         if (mm.gt.0 .and. k.ne.1) go to 90
53194c                                 Check that all counts
53195c                                 reallocated
53196         if (mm .gt. 0) then
53197            if (k1 .ne. nrow) then
53198               k = k1
53199               go to 50
53200            end if
53201            iflag = 1
53202            go to 9000
53203         end if
53204c                                 Get ks
53205         idif(k1) = idif(k1) - 1
53206         ks       = 0
53207  100    ks = ks + 1
53208         if (ks .gt. k) go to 9000
53209         if (idif(ks) .ge. imax(ks)) go to 100
53210      end if
53211c
53212 9000 return
53213      end
53214      subroutine f8xact (irow, is, i1, izero, new)
53215c-----------------------------------------------------------------------
53216c  Name:       F8XACT
53217c
53218c  Purpose:    Routine for reducing a vector when there is a zero
53219c              element.
53220c
53221c  Usage:      CALL F8XACT (IROW, IS, I1, IZERO, NEW)
53222c
53223c  Arguments:
53224c     IROW   - Vector containing the row counts.  (Input)
53225c     IS     - Indicator.  (Input)
53226c     I1     - Indicator.  (Input)
53227c     IZERO  - Position of the zero.  (Input)
53228c     NEW    - Vector of new row counts.  (Output)
53229c-----------------------------------------------------------------------
53230c                                  SPECIFICATIONS FOR ARGUMENTS
53231      integer    is, i1, izero, irow(*), new(*)
53232c                                  SPECIFICATIONS FOR LOCAL VARIABLES
53233      integer    i
53234c
53235      do 10  i=1, i1 - 1
53236         new(i) = irow(i)
53237   10 continue
53238c
53239      do 20  i=i1, izero - 1
53240         if (is .ge. irow(i+1)) go to 30
53241         new(i) = irow(i+1)
53242   20 continue
53243c
53244      i = izero
53245   30 new(i) = is
53246   40 i = i + 1
53247      if (i .gt. izero) return
53248      new(i) = irow(i)
53249      go to 40
53250      end
53251      double precision function f9xact (n, mm, ir, fact)
53252c-----------------------------------------------------------------------
53253c  Name:       F9XACT
53254c
53255c  Purpose:    Computes the log of a multinomial coefficient.
53256c
53257c  Usage:      F9XACT(N, MM, IR, FACT)
53258c
53259c  Arguments:
53260c     N      - Length of IR.  (Input)
53261c     MM     - Number for factorial in numerator.  (Input)
53262c     IR     - Vector of length N containing the numebers for the
53263c              denominator of the factorial.  (Input)
53264c     FACT   - Table of log factorials.  (Input)
53265c     F9XACT  - The log of the multinomal coefficient.  (Output)
53266c-----------------------------------------------------------------------
53267c                                  SPECIFICATIONS FOR ARGUMENTS
53268      integer    n, mm, ir(*)
53269      double precision fact(0:*)
53270c                                  SPECIFICATIONS FOR LOCAL VARIABLES
53271      integer    k
53272c
53273      f9xact = fact(mm)
53274      do 10  k=1, n
53275         f9xact = f9xact - fact(ir(k))
53276   10 continue
53277c
53278      return
53279      end
53280      subroutine f10act (nrow, irow, ncol, icol, val, xmin, fact, nd,
53281     &                   ne, m)
53282c----------------------------------------------------------------------
53283c  Name:       F10ACT
53284c
53285c  Purpose:    Computes the shortest path length for special tables.
53286c
53287c  Usage:      CALL F10ACT(NROW, IROW, NCOL, ICOL, VAL, XMIN, FACT, ND,
53288c                          NE, M)
53289c
53290c  Arguments:
53291c     NROW   - The number of rows in the table.  (Input)
53292c     IROW   - Vector of length NROW containing the row totals. (Input)
53293c     NCOL   - The number of columns in the table.  (Input)
53294c     ICO    - Vector of length NCOL containing the column totals.
53295c              (Input)
53296c     VAL    - The shortest path.  (Output)
53297c     XMIN   - Set to true if shortest path obtained.  (Output)
53298c     FACT   - Vector containing the logarithms of factorials.
53299c              (Input)
53300c     ND     - Workspace vector of length NROW.
53301c     NE     - Workspace vector of length NCOL.
53302c     M      - Workspace vector of length NCOL.
53303c
53304c  Chapter:    STAT/LIBRARY Categorical and Discrete Data Analysis
53305c----------------------------------------------------------------------
53306c                                  SPECIFICATIONS FOR ARGUMENTS
53307      integer    nrow, ncol, irow(*), icol(*), nd(*), ne(*), m(*)
53308      double precision val, fact(0:*)
53309      logical    xmin
53310c                                  SPECIFICATIONS FOR LOCAL VARIABLES
53311      integer    i, is, ix, nrw1
53312c
53313      do 10  i=1, nrow - 1
53314         nd(i) = 0
53315   10 continue
53316c
53317      is    = icol(1)/nrow
53318      ne(1) = is
53319      ix    = icol(1) - nrow*is
53320      m(1)  = ix
53321      if (ix .ne. 0) nd(ix) = nd(ix) + 1
53322c
53323      do 20  i=2, ncol
53324         ix    = icol(i)/nrow
53325         ne(i) = ix
53326         is    = is + ix
53327         ix    = icol(i) - nrow*ix
53328         m(i)  = ix
53329         if (ix .ne. 0) nd(ix) = nd(ix) + 1
53330   20 continue
53331c
53332      do 30  i=nrow - 2, 1, -1
53333         nd(i) = nd(i) + nd(i+1)
53334   30 continue
53335c
53336      ix   = 0
53337      nrw1 = nrow + 1
53338      do 40  i=nrow, 2, -1
53339         ix = ix + is + nd(nrw1-i) - irow(i)
53340         if (ix .lt. 0) return
53341   40 continue
53342c
53343      do 50  i=1, ncol
53344         ix  = ne(i)
53345         is  = m(i)
53346         val = val + is*fact(ix+1) + (nrow-is)*fact(ix)
53347   50 continue
53348      xmin = .true.
53349c
53350      return
53351      end
53352      subroutine f11act (irow, i1, i2, new)
53353c---------------------------------------------------------------------
53354c  Name:       F11ACT
53355c
53356c  Purpose:    Routine for revising row totals.
53357c
53358c  Usage:      CALL F11ACT (IROW, I1, I2, NEW)
53359c
53360c  Arguments:
53361c     IROW   - Vector containing the row totals.  (Input)
53362c     I1     - Indicator.  (Input)
53363c     I2     - Indicator.  (Input)
53364c     NEW    - Vector containing the row totals.  (Input)
53365c----------------------------------------------------------------------
53366c                                  SPECIFICATIONS FOR ARGUMENTS
53367      integer    i1, i2, irow(*), new(*)
53368c                                  SPECIFICATIONS FOR LOCAL VARIABLES
53369      integer    i
53370c
53371      do 10  i=1, i1 - 1
53372         new(i) = irow(i)
53373   10 continue
53374c
53375      do 20  i=i1, i2
53376         new(i) = irow(i+1)
53377   20 continue
53378c
53379      return
53380      end
53381      double precision function ff (x)
53382c
53383c      NOTE: This subroutine used in computing the consensus mean
53384c            using the Iyer and Wang generalized tolerance interval
53385c            approach.
53386c
53387c            Modified for Dataplot 3/2006.
53388c
53389      implicit none
53390c
53391      double precision  x
53392c
53393      integer kk
53394      double precision aa, ybar, cc, bb(100), yy(100)
53395      common /cmn1/ kk
53396      common /cmn2/ aa, ybar, cc, bb, yy
53397c
53398      integer i
53399      double precision s1, s2, s3, s4, s5, tmp
53400c
53401      if (x .le. 0.0d0) then
53402          ff = aa - cc
53403          return
53404      end if
53405c
53406      s1 = 0.0d0
53407      s2 = 0.0d0
53408      s3 = 0.0d0
53409      s4 = 0.0d0
53410      s5 = 0.0d0
53411c
53412      do 10 i = 1, kk
53413         tmp = x + bb(i)
53414         s1 = s1 + yy(i)**2/tmp
53415         s2 = s2 + yy(i)/tmp
53416         s3 = s3 + 1.0d0/tmp
53417         s4 = s4 + yy(i)*bb(i)/tmp
53418         s5 = s5 + bb(i)/tmp
53419   10 continue
53420c
53421      ff = s1 - 2.0d0*ybar*s2 + ybar**2 * s3 - (s4 - ybar*s5)**2/
53422     1     (x * (kk - s5)) - cc
53423c
53424      return
53425      end
53426      SUBROUTINE FACCUR(H0,H1,FACC,X0,F,TWOINF,F0,F1)
53427      REAL H0,H1,FACC,A0,A1,F00,F2,DELTAF,T0,T1,X0,F,DF(5),F0,F1
53428     +        ,TWOINF
53429      INTEGER J
53430      EXTERNAL F
53431C
53432      INCLUDE 'DPCOMC.INC'
53433      INCLUDE 'DPCOP2.INC'
53434C
53435      T0 = 0.
53436      T1 = 0.
53437      IF(H0.NE.0.) THEN
53438          IF(X0+H0.NE.0.) THEN
53439              F00 = F1
53440          ELSE
53441              H0 = 0.875*H0
53442              F00 = F(X0+H0)
53443          ENDIF
53444          IF(ABS(H1) .GE. 32.*TWOINF) H1 = H1/8.
53445          IF(16.*ABS(H1) .GT. ABS(H0)) H1 = SIGN(H1,1.)*ABS(H0)/16.
53446          IF(F(X0+H0-H1) .EQ. F00) THEN
53447              IF(256.*ABS(H1) .LE. ABS(H0)) THEN
53448                  H1 = 2.*H1
53449   10             IF(F(X0+H0-H1).NE.F00 .OR. 256.*ABS(H1).GT.ABS(H0))
53450     +                    GOTO 20
53451                  H1 = 2.*H1
53452                  GOTO 10
53453   20             H1 = 8.*H1
53454
53455              ELSE
53456                  H1 = SIGN(H1,1.)*ABS(H0)/16.
53457              ENDIF
53458          ELSE
53459              IF(256.*TWOINF .LE. ABS(H0)) THEN
53460   30             IF(F(X0+H0-H1/2.).EQ.F00 .OR. ABS(H1).LT.4.*TWOINF)
53461     +                GOTO 40
53462                  H1 = H1/2.
53463                  GOTO 30
53464   40             CONTINUE
53465                  H1 = 8.*H1
53466                  IF(16.*ABS(H1) .GT. ABS(H0)) H1 = SIGN(H1,1.)
53467     +                     *ABS(H0)/16.
53468              ELSE
53469                  H1 = SIGN(H1,1.)*ABS(H0)/16.
53470              ENDIF
53471          ENDIF
53472      ELSE
53473          F00 = F0
53474      ENDIF
53475
53476      DO 50 J = 1,5
53477          F2 = F(X0+H0-FLOAT(2*J-1)*H1)
53478          DF(J) = F2 - F00
53479          T0 = T0+DF(J)
53480          T1 = T1+FLOAT(2*J-1)*DF(J)
53481   50 CONTINUE
53482      A0 = (33.*T0-5.*T1)/73.
53483      A1 = (-5.*T0+1.2*T1)/73.
53484      FACC = ABS(A0)
53485      DO 70 J = 1,5
53486          DELTAF = ABS(DF(J)-(A0+FLOAT(2*J-1)*A1))
53487          IF(FACC.LT.DELTAF) FACC = DELTAF
53488   70 CONTINUE
53489      FACC = 2.*FACC
53490      RETURN
53491      END
53492      subroutine fastg(xreal, ximag, n, itype)
53493c
53494c       Algorithm AS 83.2 Appl. Statist. (1975) vol.24, no.1
53495c
53496c       Radix 4 complex discrete fast Fourier transform without
53497c       unscrambling, suitable for convolutions or other applications
53498c       which do not require unscrambling.   Called by subroutine
53499c       FASTF which also does the unscrambling.
53500c
53501        implicit double precision (A-H, O-Z)
53502      double precision  xreal(n), ximag(n)
53503      data    zero, half, one, one5, two, four
53504     +          /0.0D0,  0.5D0, 1.0D0,  1.5D0, 2.0D0,  4.0D0/
53505c
53506      sw2=0.0d0
53507      sw3=0.0d0
53508      cw3=0.0d0
53509      cw2=0.0d0
53510c
53511      pi = four * atan(one)
53512      ifaca = n / 4
53513      if (itype .eq. 0) return
53514      if (itype .gt. 0) go to 5
53515c
53516c       ITYPE < 0 indicates inverse transform required.
53517c       Calculate conjugate.
53518c
53519      do 4 k = 1, n
53520        ximag(k) = -ximag(k)
53521    4 continue
53522c
53523c       Following code is executed for IFACA = N/4, N/16, N/64, ...
53524c       until IFACA <= 1.
53525c
53526    5   ifcab = ifaca * 4
53527      z = pi / ifcab
53528      bcos = -two * sin(z)**2
53529      bsin = sin(two * z)
53530      cw1 = one
53531      sw1 = zero
53532      do 10 litla = 1, ifaca
53533        do 8 i0 = litla, n, ifcab
53534          i1 = i0 + ifaca
53535          i2 = i1 + ifaca
53536          i3 = i2 + ifaca
53537          xs0 = xreal(i0) + xreal(i2)
53538          xs1 = xreal(i0) - xreal(i2)
53539          ys0 = ximag(i0) + ximag(i2)
53540          ys1 = ximag(i0) - ximag(i2)
53541          xs2 = xreal(i1) + xreal(i3)
53542          xs3 = xreal(i1) - xreal(i3)
53543          ys2 = ximag(i1) + ximag(i3)
53544          ys3 = ximag(i1) - ximag(i3)
53545          xreal(i0) = xs0 + xs2
53546          ximag(i0) = ys0 + ys2
53547          x1 = xs1 + ys3
53548          y1 = ys1 - xs3
53549          x2 = xs0 - xs2
53550          y2 = ys0 - ys2
53551          x3 = xs1 - ys3
53552          y3 = ys1 + xs3
53553          if (litla .eq. 1) then
53554            xreal(i2) = x1
53555            ximag(i2) = y1
53556            xreal(i1) = x2
53557            ximag(i1) = y2
53558            xreal(i3) = x3
53559            ximag(i3) = y3
53560          else
53561            xreal(i2) = x1 * cw1 + y1 * sw1
53562            ximag(i2) = y1 * cw1 - x1 * sw1
53563            xreal(i1) = x2 * cw2 + y2 * sw2
53564            ximag(i1) = y2 * cw2 - x2 * sw2
53565            xreal(i3) = x3 * cw3 + y3 * sw3
53566            ximag(i3) = y3 * cw3 - x3 * sw3
53567          end if
53568    8     continue
53569c
53570c       Calculate a new set of twiddle factors.
53571c
53572        if (litla .lt. ifaca) then
53573          z = cw1 * bcos - sw1 * bsin + cw1
53574          sw1 = bcos * sw1 + bsin * cw1 + sw1
53575          tempr = one5 - half * (z * z + sw1 * sw1)
53576          cw1 = z * tempr
53577          sw1 = sw1 * tempr
53578          cw2 = cw1 * cw1 - sw1 * sw1
53579          sw2 = two * cw1 * sw1
53580          cw3 = cw1 * cw2 - sw1 * sw2
53581          sw3 = cw1 * sw2 + cw2 * sw1
53582        end if
53583   10   continue
53584      if (ifaca .le. 1) go to 14
53585c
53586c       Set up the transform split for the next stage.
53587c
53588      ifaca = ifaca / 4
53589      if (ifaca .gt. 0) go to 5
53590c
53591c       Radix 2 calculation, if needed.
53592c
53593      if (ifaca .lt. 0) return
53594      do 13 k = 1, n, 2
53595        tempr = xreal(k) + xreal(k+1)
53596        xreal(k+1) = xreal(k) - xreal(k+1)
53597        xreal(k) = tempr
53598        tempr = ximag(k) + ximag(k+1)
53599        ximag(k+1) = ximag(k) - ximag(k+1)
53600        ximag(k) = tempr
53601   13   continue
53602   14   if (itype .lt. 0) then
53603c
53604c       Inverse transform; conjugate the result.
53605c
53606        do 16 k = 1, n
53607          ximag(k) = -ximag(k)
53608   16   continue
53609        return
53610      end if
53611c
53612c       Forward transform
53613c
53614      z = one / n
53615      do 18 k = 1, n
53616        xreal(k) = xreal(k) * z
53617        ximag(k) = ximag(k) * z
53618   18   continue
53619c
53620      return
53621      end
53622      SUBROUTINE FORRT(X, M)
53623C
53624C     ALGORITHM AS 97  APPL. STATIST. (1976) VOL.25, NO. 2
53625C
53626C     Forward discrete Fourier transform in one dimension of real
53627C     data using complex transform subroutine FASTG.
53628C
53629C     X = array of real input data, type real, dimension M.
53630C     M = length of the transform, must be a power of 2.
53631C     The minimum length is 8, maximum 2**21.
53632C
53633C     The result is placed in X as described in the text of the paper.
53634C
53635C     Auxiliary routines required: SCRAG (or SCRAM) & FASTG from AS 83,
53636C     but with SCRAG modified as described on page 168 of the paper for
53637C     this algorithm.
53638C
53639      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
53640      DOUBLE PRECISION X(M)
53641      DATA ZERO/0.0D0/, QUART/0.25D0/, HALF/0.5D0/, ONE/1.0D0/,
53642     *  ONE5/1.5D0/, TWO/2.0D0/, FOUR/4.0D0/
53643C
53644C     Check for valid transform size.
53645C
53646      II = 8
53647      DO 2 K = 3, 21
53648      IPOW = K
53649      IF (II .EQ. M) GO TO 3
53650      II = II * 2
53651    2 CONTINUE
53652C
53653C     If this point is reached, an illegal size was specified.
53654C
53655      RETURN
53656    3 PIE = FOUR * ATAN(ONE)
53657C
53658C     Separate odd and even parts into two halves.
53659C     First bit reverse the whole array of length M.
53660C
53661      CALL SCRAG(X, M, IPOW)
53662C
53663C     Next bit reverse the half arrays separately.
53664C
53665      N = M / 2
53666      JPOW = IPOW - 1
53667      CALL SCRAG(X, N, JPOW)
53668      CALL SCRAG(X(N+1), N, JPOW)
53669C
53670C     Faster alternative to the two lines above to SCRAM.
53671C           CALL SCRAM(X, X(N+1), N, JPOW)
53672C
53673C     Now do the transform.
53674C
53675      CALL FASTG(X, X(N+1), N, 1)
53676C
53677C     Unscramble the transform results.
53678C
53679      CALL SCRAG(X, N, JPOW)
53680      CALL SCRAG(X(N+1), N, JPOW)
53681C
53682C     Faster alternative to the two lines above to SCRAM.
53683C           CALL SCRAM(X, X(N+1), N, JPOW)
53684C
53685      NN = N / 2
53686C
53687C     Now unravel the result; first the special cases.
53688C
53689      Z = HALF * (X(1) + X(N+1))
53690      X(N+1) = HALF * (X(1) - X(N+1))
53691      X(1) = Z
53692      NN1 = NN + 1
53693      NN2 = NN1 + N
53694      X(NN1) = HALF * X(NN1)
53695      X(NN2) = -HALF * X(NN2)
53696      Z = PIE / N
53697      BCOS = -TWO * (SIN(Z / TWO) **2)
53698      BSIN = SIN(Z)
53699      UN = ONE
53700      VN = ZERO
53701      DO 4 K = 2, NN
53702      Z = UN * BCOS + VN * BSIN + UN
53703      VN = VN * BCOS - UN * BSIN + VN
53704      SAVE1 = ONE5 - HALF * (Z * Z + VN * VN)
53705      UN = Z * SAVE1
53706      VN = VN * SAVE1
53707      KI = N + K
53708      L = N + 2 - K
53709      LI = N + L
53710      AN = QUART * (X(K) + X(L))
53711      BN = QUART * (X(KI) - X(LI))
53712      CN = QUART * (X(KI) + X(LI))
53713      DN = QUART * (X(L) - X(K))
53714      XN = UN * CN - VN * DN
53715      YN = UN * DN + VN * CN
53716      X(K) = AN + XN
53717      X(KI) = BN + YN
53718      X(L) = AN - XN
53719      X(LI) = YN - BN
53720    4 CONTINUE
53721      RETURN
53722      END
53723      DOUBLE PRECISION FUNCTION FULSUM(S, CENTER, HWIDTH, X, G, F)
53724*
53725****  To compute fully symmetric basic rule sum
53726*
53727      EXTERNAL F
53728      INTEGER S, IXCHNG, LXCHNG, I, L
53729      DOUBLE PRECISION CENTER(S), HWIDTH(S), X(S), G(S), F
53730      DOUBLE PRECISION INTSUM, GL, GI
53731      FULSUM = 0
53732      LXCHNG = 0
53733*
53734*     Compute centrally symmetric sum for permutation of G
53735*
53736 10   INTSUM = 0
53737      DO 100 I = 1,S
53738         X(I) = CENTER(I) + G(I)*HWIDTH(I)
53739 100  CONTINUE
53740 20   INTSUM = INTSUM + F(S,X)
53741      DO 200 I = 1,S
53742         G(I) = -G(I)
53743         X(I) = CENTER(I) + G(I)*HWIDTH(I)
53744         IF ( G(I) .LT. 0 ) GO TO 20
53745 200  CONTINUE
53746      FULSUM = FULSUM + INTSUM
53747*
53748*     Find next distinct permuation of G and loop back for next sum
53749*
53750      DO 300 I = 2,S
53751         IF ( G(I-1) .GT. G(I) ) THEN
53752            GI = G(I)
53753            IXCHNG = I - 1
53754            DO 400 L = 1,(I-1)/2
53755               GL = G(L)
53756               G(L) = G(I-L)
53757               G(I-L) = GL
53758               IF (  GL  .LE. GI ) IXCHNG = IXCHNG - 1
53759               IF ( G(L) .GT. GI ) LXCHNG = L
53760  400       CONTINUE
53761            IF ( G(IXCHNG) .LE. GI ) IXCHNG = LXCHNG
53762            G(I) = G(IXCHNG)
53763            G(IXCHNG) = GI
53764            GO TO 10
53765         ENDIF
53766  300 CONTINUE
53767*
53768*     End loop for permutations of G and associated sums
53769*
53770*     Restore original order to G's
53771*
53772      DO 500 I = 1,S/2
53773         GI = G(I)
53774         G(I) = G(S+1-I)
53775         G(S+1-I) = GI
53776 500  CONTINUE
53777C
53778      RETURN
53779      END
53780      SUBROUTINE FZERO(F,B,C,R,RE,AE,IFLAG)
53781C
53782C   ADDED TO DATAPLOT 12/2003.  USE THIS ROUTINE FOR INTERNAL
53783C   COMPUTATIONS (THE ROOTS COMMAND IMPLEMENTS FOR USER DEFINED
53784C   FUNCTIONS).  THIS ROUTINE CAN BE MORE EFFICIENT FOR INTERNAL
53785C   USE SINCE WE CAN AVOID OVERHEAD OF FUNCTION PARSING, ETC.
53786C
53787C***BEGIN PROLOGUE  FZERO
53788C***DATE WRITTEN   700901   (YYMMDD)
53789C***REVISION DATE  860411   (YYMMDD)
53790C***CATEGORY NO.  F1B
53791C***KEYWORDS  BISECTION,NONLINEAR,ROOTS,ZEROS
53792C***AUTHOR  SHAMPINE,L.F.,SNLA
53793C           WATTS,H.A.,SNLA
53794C***PURPOSE  FZERO searches for a zero of a function F(X) in a given
53795C            interval (B,C).  It is designed primarily for problems
53796C            where F(B) and F(C) have opposite signs.
53797C***DESCRIPTION
53798C
53799C    From the book "Numerical Methods and Software"
53800C       by  D. Kahaner, C. Moler, S. Nash
53801C           Prentice Hall 1988
53802C
53803C     Based on a method by T J Dekker
53804C     written by L F Shampine and H A Watts
53805C
53806C            FZERO searches for a zero of a function F(X) between
53807C            the given values B and C until the width of the interval
53808C            (B,C) has collapsed to within a tolerance specified by
53809C            the stopping criterion, ABS(B-C) .LE. 2.*(RW*ABS(B)+AE).
53810C            The method used is an efficient combination of bisection
53811C            and the secant rule.
53812C
53813C     Description Of Arguments
53814C
53815C     F,B,C,R,RE and AE are input parameters
53816C     B,C and IFLAG are output parameters (flagged by an * below)
53817C
53818C        F     - Name of the real valued external function.  This name
53819C                must be in an EXTERNAL statement in the calling
53820C                program.  F must be a function of one real argument.
53821C
53822C       *B     - One end of the interval (B,C).  The value returned for
53823C                B usually is the better approximation to a zero of F.
53824C
53825C       *C     - The other end of the interval (B,C)
53826C
53827C        R     - A (better) guess of a zero of F which could help in
53828C                speeding up convergence.  If F(B) and F(R) have
53829C                opposite signs, a root will be found in the interval
53830C                (B,R); if not, but F(R) and F(C) have opposite
53831C                signs, a root will be found in the interval (R,C);
53832C                otherwise, the interval (B,C) will be searched for a
53833C                possible root.  When no better guess is known, it is
53834C                recommended that r be set to B or C; because if R is
53835C                not interior to the interval (B,C), it will be ignored.
53836C
53837C        RE    - Relative error used for RW in the stopping criterion.
53838C                If the requested RE is less than machine precision,
53839C                then RW is set to approximately machine precision.
53840C
53841C        AE    - Absolute error used in the stopping criterion.  If the
53842C                given interval (B,C) contains the origin, then a
53843C                nonzero value should be chosen for AE.
53844C
53845C       *IFLAG - A status code.  User must check IFLAG after each call.
53846C                Control returns to the user from FZERO in all cases.
53847C
53848C                1  B is within the requested tolerance of a zero.
53849C                   The interval (B,C) collapsed to the requested
53850C                   tolerance, the function changes sign in (B,C), and
53851C                   F(X) decreased in magnitude as (B,C) collapsed.
53852C
53853C                2  F(B) = 0.  However, the interval (B,C) may not have
53854C                   collapsed to the requested tolerance.
53855C
53856C                3  B may be near a singular point of F(X).
53857C                   The interval (B,C) collapsed to the requested tol-
53858C                   erance and the function changes sign in (B,C), but
53859C                   F(X) increased in magnitude as (B,C) collapsed,i.e.
53860C                     abs(F(B out)) .GT. max(abs(F(B in)),abs(F(C in)))
53861C
53862C                4  No change in sign of F(X) was found although the
53863C                   interval (B,C) collapsed to the requested tolerance.
53864C                   The user must examine this case and decide whether
53865C                   B is near a local minimum of F(X), or B is near a
53866C                   zero of even multiplicity, or neither of these.
53867C
53868C                5  Too many (.GT. 500) function evaluations used.
53869C***REFERENCES  L. F. SHAMPINE AND H. A. WATTS, *FZERO, A ROOT-SOLVING
53870C                 CODE*, SC-TM-70-631, SEPTEMBER 1970.
53871C               T. J. DEKKER, *FINDING A ZERO BY MEANS OF SUCCESSIVE
53872C                 LINEAR INTERPOLATION*, 'CONSTRUCTIVE ASPECTS OF THE
53873C                 FUNDAMENTAL THEOREM OF ALGEBRA', EDITED BY B. DEJON
53874C                 P. HENRICI, 1969.
53875C***ROUTINES CALLED  R1MACH
53876C***END PROLOGUE  FZERO
53877      REAL A,ACBS,ACMB,AE,AW,B,C,CMB,ER,FA,FB,FC,FX,FZ,P,Q,R
53878      REAL RE,RW,T,TOL,Z
53879      INTEGER IC,IFLAG,KOUNT
53880C
53881      INCLUDE 'DPCOMC.INC'
53882      INCLUDE 'DPCOP2.INC'
53883C
53884C     ER IS TWO TIMES THE COMPUTER UNIT ROUNDOFF VALUE WHICH IS
53885C     DEFINED HERE BY THE FUNCTION R1MACH.
53886C
53887C***FIRST EXECUTABLE STATEMENT  FZERO
53888      ER = 2.0E0 * R1MACH(4)
53889C
53890C     INITIALIZE
53891C
53892      Z=R
53893      IF(R.LE.AMIN1(B,C).OR.R.GE.AMAX1(B,C)) Z=C
53894      RW=AMAX1(RE,ER)
53895      AW=AMAX1(AE,0.0)
53896      IC=0
53897      T=Z
53898      FZ=F(T)
53899      FC=FZ
53900      T=B
53901      FB=F(T)
53902      KOUNT=2
53903      IF(SIGN(1.0E0,FZ).EQ.SIGN(1.0E0,FB)) GO TO 1
53904      C=Z
53905      GO TO 2
53906    1 IF(Z.EQ.C) GO TO 2
53907      T=C
53908      FC=F(T)
53909      KOUNT=3
53910      IF(SIGN(1.0E0,FZ).EQ.SIGN(1.0E0,FC)) GO TO 2
53911      B=Z
53912      FB=FZ
53913    2 A=C
53914      FA=FC
53915      ACBS=ABS(B-C)
53916      FX=AMAX1(ABS(FB),ABS(FC))
53917C
53918    3 IF (ABS(FC) .GE. ABS(FB)) GO TO 4
53919C     PERFORM INTERCHANGE
53920      A=B
53921      FA=FB
53922      B=C
53923      FB=FC
53924      C=A
53925      FC=FA
53926C
53927    4 CMB=0.5*(C-B)
53928      ACMB=ABS(CMB)
53929      TOL=RW*ABS(B)+AW
53930C
53931C     TEST STOPPING CRITERION AND FUNCTION COUNT
53932C
53933      IF (ACMB .LE. TOL) GO TO 10
53934      IF(FB.EQ.0.E0) GO TO 11
53935      IF(KOUNT.GE.500) GO TO 14
53936C
53937C     CALCULATE NEW ITERATE IMPLICITLY AS B+P/Q
53938C     WHERE WE ARRANGE P .GE. 0.
53939C     THE IMPLICIT FORM IS USED TO PREVENT OVERFLOW.
53940C
53941      P=(B-A)*FB
53942      Q=FA-FB
53943      IF (P .GE. 0.) GO TO 5
53944      P=-P
53945      Q=-Q
53946C
53947C     UPDATE A AND CHECK FOR SATISFACTORY REDUCTION
53948C     IN THE SIZE OF THE BRACKETING INTERVAL.
53949C     IF NOT, PERFORM BISECTION.
53950C
53951    5 A=B
53952      FA=FB
53953      IC=IC+1
53954      IF (IC .LT. 4) GO TO 6
53955      IF (8.*ACMB .GE. ACBS) GO TO 8
53956      IC=0
53957      ACBS=ACMB
53958C
53959C     TEST FOR TOO SMALL A CHANGE
53960C
53961    6 IF (P .GT. ABS(Q)*TOL) GO TO 7
53962C
53963C     INCREMENT BY TOLERANCE
53964C
53965      B=B+SIGN(TOL,CMB)
53966      GO TO 9
53967C
53968C     ROOT OUGHT TO BE BETWEEN B AND (C+B)/2.
53969C
53970    7 IF (P .GE. CMB*Q) GO TO 8
53971C
53972C     USE SECANT RULE
53973C
53974      B=B+P/Q
53975      GO TO 9
53976C
53977C     USE BISECTION
53978C
53979    8 B=0.5*(C+B)
53980C
53981C     HAVE COMPLETED COMPUTATION FOR NEW ITERATE B
53982C
53983    9 T=B
53984      FB=F(T)
53985      KOUNT=KOUNT+1
53986C
53987C     DECIDE WHETHER NEXT STEP IS INTERPOLATION OR EXTRAPOLATION
53988C
53989      IF (SIGN(1.0,FB) .NE. SIGN(1.0,FC)) GO TO 3
53990      C=A
53991      FC=FA
53992      GO TO 3
53993C
53994C
53995C     FINISHED. PROCESS RESULTS FOR PROPER SETTING OF IFLAG
53996C
53997   10 IF (SIGN(1.0,FB) .EQ. SIGN(1.0,FC)) GO TO 13
53998      IF (ABS(FB) .GT. FX) GO TO 12
53999      IFLAG = 1
54000      RETURN
54001   11 IFLAG = 2
54002      RETURN
54003   12 IFLAG = 3
54004      RETURN
54005   13 IFLAG = 4
54006      RETURN
54007   14 IFLAG = 5
54008      RETURN
54009      END
54010      SUBROUTINE FZEROY(F,B,C,R,RE,AE,IFLAG,XTEMP,YTEMP)
54011C
54012C   ADDED TO DATAPLOT 12/2003.  USE THIS ROUTINE FOR INTERNAL
54013C   COMPUTATIONS (THE ROOTS COMMAND IMPLEMENTS FOR USER DEFINED
54014C   FUNCTIONS).  THIS ROUTINE CAN BE MORE EFFICIENT FOR INTERNAL
54015C   USE SINCE WE CAN AVOID OVERHEAD OF FUNCTION PARSING, ETC.
54016C
54017C   COPY OF FZERO.  ADDS XTEMP AND YTEMP TO FUNCTION CALL
54018C   (NEEDED BY DPMLYU AND DPMLWA).
54019C
54020C***BEGIN PROLOGUE  FZERO
54021C***DATE WRITTEN   700901   (YYMMDD)
54022C***REVISION DATE  860411   (YYMMDD)
54023C***CATEGORY NO.  F1B
54024C***KEYWORDS  BISECTION,NONLINEAR,ROOTS,ZEROS
54025C***AUTHOR  SHAMPINE,L.F.,SNLA
54026C           WATTS,H.A.,SNLA
54027C***PURPOSE  FZERO searches for a zero of a function F(X) in a given
54028C            interval (B,C).  It is designed primarily for problems
54029C            where F(B) and F(C) have opposite signs.
54030C***DESCRIPTION
54031C
54032C    From the book "Numerical Methods and Software"
54033C       by  D. Kahaner, C. Moler, S. Nash
54034C           Prentice Hall 1988
54035C
54036C     Based on a method by T J Dekker
54037C     written by L F Shampine and H A Watts
54038C
54039C            FZERO searches for a zero of a function F(X) between
54040C            the given values B and C until the width of the interval
54041C            (B,C) has collapsed to within a tolerance specified by
54042C            the stopping criterion, ABS(B-C) .LE. 2.*(RW*ABS(B)+AE).
54043C            The method used is an efficient combination of bisection
54044C            and the secant rule.
54045C
54046C     Description Of Arguments
54047C
54048C     F,B,C,R,RE and AE are input parameters
54049C     B,C and IFLAG are output parameters (flagged by an * below)
54050C
54051C        F     - Name of the real valued external function.  This name
54052C                must be in an EXTERNAL statement in the calling
54053C                program.  F must be a function of one real argument.
54054C
54055C       *B     - One end of the interval (B,C).  The value returned for
54056C                B usually is the better approximation to a zero of F.
54057C
54058C       *C     - The other end of the interval (B,C)
54059C
54060C        R     - A (better) guess of a zero of F which could help in
54061C                speeding up convergence.  If F(B) and F(R) have
54062C                opposite signs, a root will be found in the interval
54063C                (B,R); if not, but F(R) and F(C) have opposite
54064C                signs, a root will be found in the interval (R,C);
54065C                otherwise, the interval (B,C) will be searched for a
54066C                possible root.  When no better guess is known, it is
54067C                recommended that r be set to B or C; because if R is
54068C                not interior to the interval (B,C), it will be ignored.
54069C
54070C        RE    - Relative error used for RW in the stopping criterion.
54071C                If the requested RE is less than machine precision,
54072C                then RW is set to approximately machine precision.
54073C
54074C        AE    - Absolute error used in the stopping criterion.  If the
54075C                given interval (B,C) contains the origin, then a
54076C                nonzero value should be chosen for AE.
54077C
54078C       *IFLAG - A status code.  User must check IFLAG after each call.
54079C                Control returns to the user from FZERO in all cases.
54080C
54081C                1  B is within the requested tolerance of a zero.
54082C                   The interval (B,C) collapsed to the requested
54083C                   tolerance, the function changes sign in (B,C), and
54084C                   F(X) decreased in magnitude as (B,C) collapsed.
54085C
54086C                2  F(B) = 0.  However, the interval (B,C) may not have
54087C                   collapsed to the requested tolerance.
54088C
54089C                3  B may be near a singular point of F(X).
54090C                   The interval (B,C) collapsed to the requested tol-
54091C                   erance and the function changes sign in (B,C), but
54092C                   F(X) increased in magnitude as (B,C) collapsed,i.e.
54093C                     abs(F(B out)) .GT. max(abs(F(B in)),abs(F(C in)))
54094C
54095C                4  No change in sign of F(X) was found although the
54096C                   interval (B,C) collapsed to the requested tolerance.
54097C                   The user must examine this case and decide whether
54098C                   B is near a local minimum of F(X), or B is near a
54099C                   zero of even multiplicity, or neither of these.
54100C
54101C                5  Too many (.GT. 500) function evaluations used.
54102C***REFERENCES  L. F. SHAMPINE AND H. A. WATTS, *FZERO, A ROOT-SOLVING
54103C                 CODE*, SC-TM-70-631, SEPTEMBER 1970.
54104C               T. J. DEKKER, *FINDING A ZERO BY MEANS OF SUCCESSIVE
54105C                 LINEAR INTERPOLATION*, 'CONSTRUCTIVE ASPECTS OF THE
54106C                 FUNDAMENTAL THEOREM OF ALGEBRA', EDITED BY B. DEJON
54107C                 P. HENRICI, 1969.
54108C***ROUTINES CALLED  R1MACH
54109C***END PROLOGUE  FZERO
54110      REAL A,ACBS,ACMB,AE,AW,B,C,CMB,ER,FA,FB,FC,FX,FZ,P,Q,R
54111      REAL RE,RW,T,TOL,Z
54112      INTEGER IC,IFLAG,KOUNT
54113C
54114      REAL YTEMP(*)
54115      REAL XTEMP(*)
54116C
54117      INCLUDE 'DPCOMC.INC'
54118      INCLUDE 'DPCOP2.INC'
54119C
54120C     ER IS TWO TIMES THE COMPUTER UNIT ROUNDOFF VALUE WHICH IS
54121C     DEFINED HERE BY THE FUNCTION R1MACH.
54122C
54123C***FIRST EXECUTABLE STATEMENT  FZERO
54124      ER = 2.0E0 * R1MACH(4)
54125C
54126C     INITIALIZE
54127C
54128      Z=R
54129      IF(R.LE.AMIN1(B,C).OR.R.GE.AMAX1(B,C)) Z=C
54130      RW=AMAX1(RE,ER)
54131      AW=AMAX1(AE,0.0)
54132      IC=0
54133      T=Z
54134      FZ=F(T,XTEMP,YTEMP)
54135      FC=FZ
54136      T=B
54137      FB=F(T,XTEMP,YTEMP)
54138      KOUNT=2
54139      IF(SIGN(1.0E0,FZ).EQ.SIGN(1.0E0,FB)) GO TO 1
54140      C=Z
54141      GO TO 2
54142    1 IF(Z.EQ.C) GO TO 2
54143      T=C
54144      FC=F(T,XTEMP,YTEMP)
54145      KOUNT=3
54146      IF(SIGN(1.0E0,FZ).EQ.SIGN(1.0E0,FC)) GO TO 2
54147      B=Z
54148      FB=FZ
54149    2 A=C
54150      FA=FC
54151      ACBS=ABS(B-C)
54152      FX=AMAX1(ABS(FB),ABS(FC))
54153C
54154    3 IF (ABS(FC) .GE. ABS(FB)) GO TO 4
54155C     PERFORM INTERCHANGE
54156      A=B
54157      FA=FB
54158      B=C
54159      FB=FC
54160      C=A
54161      FC=FA
54162C
54163    4 CMB=0.5*(C-B)
54164      ACMB=ABS(CMB)
54165      TOL=RW*ABS(B)+AW
54166C
54167C     TEST STOPPING CRITERION AND FUNCTION COUNT
54168C
54169      IF (ACMB .LE. TOL) GO TO 10
54170      IF(FB.EQ.0.E0) GO TO 11
54171      IF(KOUNT.GE.500) GO TO 14
54172C
54173C     CALCULATE NEW ITERATE IMPLICITLY AS B+P/Q
54174C     WHERE WE ARRANGE P .GE. 0.
54175C     THE IMPLICIT FORM IS USED TO PREVENT OVERFLOW.
54176C
54177      P=(B-A)*FB
54178      Q=FA-FB
54179      IF (P .GE. 0.) GO TO 5
54180      P=-P
54181      Q=-Q
54182C
54183C     UPDATE A AND CHECK FOR SATISFACTORY REDUCTION
54184C     IN THE SIZE OF THE BRACKETING INTERVAL.
54185C     IF NOT, PERFORM BISECTION.
54186C
54187    5 A=B
54188      FA=FB
54189      IC=IC+1
54190      IF (IC .LT. 4) GO TO 6
54191      IF (8.*ACMB .GE. ACBS) GO TO 8
54192      IC=0
54193      ACBS=ACMB
54194C
54195C     TEST FOR TOO SMALL A CHANGE
54196C
54197    6 IF (P .GT. ABS(Q)*TOL) GO TO 7
54198C
54199C     INCREMENT BY TOLERANCE
54200C
54201      B=B+SIGN(TOL,CMB)
54202      GO TO 9
54203C
54204C     ROOT OUGHT TO BE BETWEEN B AND (C+B)/2.
54205C
54206    7 IF (P .GE. CMB*Q) GO TO 8
54207C
54208C     USE SECANT RULE
54209C
54210      B=B+P/Q
54211      GO TO 9
54212C
54213C     USE BISECTION
54214C
54215    8 B=0.5*(C+B)
54216C
54217C     HAVE COMPLETED COMPUTATION FOR NEW ITERATE B
54218C
54219    9 T=B
54220      FB=F(T,XTEMP,YTEMP)
54221      KOUNT=KOUNT+1
54222C
54223C     DECIDE WHETHER NEXT STEP IS INTERPOLATION OR EXTRAPOLATION
54224C
54225      IF (SIGN(1.0,FB) .NE. SIGN(1.0,FC)) GO TO 3
54226      C=A
54227      FC=FA
54228      GO TO 3
54229C
54230C
54231C     FINISHED. PROCESS RESULTS FOR PROPER SETTING OF IFLAG
54232C
54233   10 IF (SIGN(1.0,FB) .EQ. SIGN(1.0,FC)) GO TO 13
54234      IF (ABS(FB) .GT. FX) GO TO 12
54235      IFLAG = 1
54236      RETURN
54237   11 IFLAG = 2
54238      RETURN
54239   12 IFLAG = 3
54240      RETURN
54241   13 IFLAG = 4
54242      RETURN
54243   14 IFLAG = 5
54244      RETURN
54245      END
54246