1      SUBROUTINE DPTIQP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
2     1                  ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
3C
4C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
5C              THAT WILL DEFINE A TRUNCATED INFORMATIVE QUANTILE
6C              (TIQ) PLOT.
7C     EXAMPLES--NORMAL TIQ PLOT Y
8C               LOGNORMAL TIQ PLOT Y
9C               UNIFORM TIQ PLOT Y
10C               GUMBEL TIQ PLOT Y
11C               WEIBULL TIQ PLOT Y
12C               LOGISTIC TIQ PLOT Y
13C               DOUBLE EXPONENTIAL TIQ PLOT Y
14C               CAUCHY TIQ PLOT Y
15C               SEMICIRCULAR TIQ PLOT Y
16C               COSINE TIQ PLOT Y
17C               ANGLIT TIQ PLOT Y
18C               HYPERBOLIC SECANT TIQ PLOT Y
19C               HALF-NORMAL TIQ PLOT Y
20C               ARCSINE TIQ PLOT Y
21C               EXPONENTIAL TIQ PLOT Y
22C               HALF-CAUCHY TIQ PLOT Y
23C               SLASH TIQ PLOT Y
24C               RAYLEIGH TIQ PLOT Y
25C               MAXWELL TIQ PLOT Y
26C
27C     REFERENCE--"MIL-HDBK-17-1F Volume 1: Guidelines for Characterization
28C                of Structural Materials", Depeartment of Defense,
29C                chapter 8, 2002.
30C     WRITTEN BY--ALAN HECKERT
31C                 STATISTICAL ENGINEERING DIVISION
32C                 INFORMATION TECHNOLOGY LABORATORY
33C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
34C                 GAITHERSBURG, MD 20899-8980
35C                 PHONE--301-975-2899
36C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
37C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
38C     LANGUAGE--ANSI FORTRAN (1977)
39C     VERSION NUMBER--2017/03
40C     ORIGINAL VERSION--MARCH     2017.
41C
42C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
43C
44      CHARACTER*4 ICASPL
45      CHARACTER*4 IAND1
46      CHARACTER*4 IAND2
47      CHARACTER*4 ISUBRO
48      CHARACTER*4 IBUGG2
49      CHARACTER*4 IBUGG3
50      CHARACTER*4 IBUGQ
51      CHARACTER*4 IFOUND
52      CHARACTER*4 IERROR
53C
54      CHARACTER*4 ICASE2
55      CHARACTER*4 ICASE
56      CHARACTER*4 ISUBN1
57      CHARACTER*4 ISUBN2
58      CHARACTER*4 ISTEPN
59C
60C---------------------------------------------------------------------
61C
62      INCLUDE 'DPCOPA.INC'
63C
64      DIMENSION Y1(MAXOBV)
65      DIMENSION TEMP1(MAXOBV)
66      DIMENSION TEMP2(MAXOBV)
67      DIMENSION TEMP3(MAXOBV)
68      DIMENSION TEMP4(MAXOBV)
69C
70      INCLUDE 'DPCOZZ.INC'
71C
72      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
73      EQUIVALENCE (GARBAG(IGARB2),TEMP1(1))
74      EQUIVALENCE (GARBAG(IGARB3),TEMP2(1))
75      EQUIVALENCE (GARBAG(IGARB4),TEMP3(1))
76      EQUIVALENCE (GARBAG(IGARB5),TEMP4(1))
77C
78      CHARACTER*40 INAME
79      PARAMETER (MAXSPN=30)
80      CHARACTER*4 IVARN1(MAXSPN)
81      CHARACTER*4 IVARN2(MAXSPN)
82      CHARACTER*4 IVARTY(MAXSPN)
83      REAL PVAR(MAXSPN)
84      INTEGER ILIS(MAXSPN)
85      INTEGER NRIGHT(MAXSPN)
86      INTEGER ICOLR(MAXSPN)
87C
88C-----COMMON----------------------------------------------------------
89C
90      INCLUDE 'DPCOHK.INC'
91      INCLUDE 'DPCODA.INC'
92      INCLUDE 'DPCOS2.INC'
93      INCLUDE 'DPCOP2.INC'
94C
95C-----START POINT-----------------------------------------------------
96C
97      IFOUND='NO'
98      IERROR='NO'
99      ISUBN1='DPTI'
100      ISUBN2='QP  '
101      ICASPL='TIQP'
102C
103      MAXCP1=MAXCOL+1
104      MAXCP2=MAXCOL+2
105      MAXCP3=MAXCOL+3
106      MAXCP4=MAXCOL+4
107      MAXCP5=MAXCOL+5
108      MAXCP6=MAXCOL+6
109      MAXV2=1
110      MINN2=20
111C
112C               ***************************************************
113C               **  TREAT THE TIQ            PLOT                **
114C               ***************************************************
115C
116      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TIQP')THEN
117        WRITE(ICOUT,999)
118  999   FORMAT(1X)
119        CALL DPWRST('XXX','BUG ')
120        WRITE(ICOUT,51)
121   51   FORMAT('***** AT THE BEGINNING OF DPTIQP--')
122        CALL DPWRST('XXX','BUG ')
123        WRITE(ICOUT,52)ICASPL,IAND1,IAND2,NS
124   52   FORMAT('ICASPL,IAND1,IAND2,NS = ',3(A4,2X),I8)
125        CALL DPWRST('XXX','BUG ')
126        WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ,ISUBRO
127   53   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
128        CALL DPWRST('XXX','BUG ')
129      ENDIF
130C
131C               ******************************************************
132C               **  STEP 1--                                        **
133C               **  EXTRACT THE COMMAND                             **
134C               **  REPLICATION AND MULTIPLE NOT SUPPORTED FOR THIS **
135C               **  COMMAND.                                        **
136C               ******************************************************
137C
138      ISTEPN='1'
139      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TIQP')
140     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
141C
142
143      IF(ICOM.EQ.'NORM' .AND. IHARG(1).EQ.'TIQ ' .AND.
144     1   IHARG(2).EQ.'PLOT')THEN
145         ILASTC=2
146         ICASE='NORM'
147      ELSEIF(ICOM.EQ.'NORM' .AND. IHARG(1).EQ.'TRUN' .AND.
148     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
149     1       IHARG(4).EQ.'PLOT')THEN
150         ILASTC=4
151         ICASE='NORM'
152      ELSEIF(ICOM.EQ.'LOGN' .AND. IHARG(1).EQ.'TIQ ' .AND.
153     1       IHARG(2).EQ.'PLOT')THEN
154         ILASTC=2
155         ICASE='LOGN'
156      ELSEIF(ICOM.EQ.'LOGN' .AND. IHARG(1).EQ.'TRUN' .AND.
157     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
158     1       IHARG(4).EQ.'PLOT')THEN
159         ILASTC=4
160         ICASE='LOGN'
161      ELSEIF(ICOM.EQ.'WEIB' .AND. IHARG(1).EQ.'TIQ ' .AND.
162     1       IHARG(2).EQ.'PLOT')THEN
163         ILASTC=2
164         ICASE='WEIB'
165      ELSEIF(ICOM.EQ.'WEIB' .AND. IHARG(1).EQ.'TRUN' .AND.
166     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
167     1       IHARG(4).EQ.'PLOT')THEN
168         ILASTC=4
169         ICASE='WEIB'
170      ELSEIF(ICOM.EQ.'GUMB' .AND. IHARG(1).EQ.'TIQ ' .AND.
171     1       IHARG(2).EQ.'PLOT')THEN
172         ILASTC=2
173         ICASE='GUMB'
174      ELSEIF(ICOM.EQ.'GUMB' .AND. IHARG(1).EQ.'TRUN' .AND.
175     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
176     1       IHARG(4).EQ.'PLOT')THEN
177         ILASTC=4
178         ICASE='GUMB'
179      ELSEIF(ICOM.EQ.'EXTR' .AND. IHARG(1).EQ.'VALU' .AND.
180     1       IHARG(2).EQ.'TYPE' .AND.
181     1      (IHARG(3).EQ.'1   ' .OR. IHARG(3).EQ.'I   ')  .AND.
182     1       IHARG(4).EQ.'TIQ ' .AND.
183     1       IHARG(5).EQ.'PLOT')THEN
184         ILASTC=5
185         ICASE='GUMB'
186      ELSEIF(ICOM.EQ.'EXTR' .AND. IHARG(1).EQ.'VALU' .AND.
187     1       IHARG(2).EQ.'TYPE' .AND.
188     1      (IHARG(3).EQ.'1   ' .OR.  IHARG(3).EQ.'I   ')  .AND.
189     1       IHARG(4).EQ.'TRUN' .AND. IHARG(5).EQ.'INFO' .AND.
190     1       IHARG(6).EQ.'QUAN' .AND. IHARG(7).EQ.'PLOT')THEN
191         ILASTC=7
192         ICASE='GUMB'
193      ELSEIF(ICOM.EQ.'UNIF' .AND. IHARG(1).EQ.'TIQ ' .AND.
194     1       IHARG(2).EQ.'PLOT')THEN
195         ILASTC=2
196         ICASE='UNIF'
197      ELSEIF(ICOM.EQ.'UNIF' .AND. IHARG(1).EQ.'TRUN' .AND.
198     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
199     1       IHARG(4).EQ.'PLOT')THEN
200         ILASTC=4
201         ICASE='UNIF'
202      ELSEIF(ICOM.EQ.'LOGI' .AND. IHARG(1).EQ.'TIQ ' .AND.
203     1       IHARG(2).EQ.'PLOT')THEN
204         ILASTC=2
205         ICASE='LOGI'
206      ELSEIF(ICOM.EQ.'LOGI' .AND. IHARG(1).EQ.'TRUN' .AND.
207     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
208     1       IHARG(4).EQ.'PLOT')THEN
209         ILASTC=4
210         ICASE='LOGI'
211      ELSEIF(ICOM.EQ.'EXPO' .AND. IHARG(1).EQ.'TIQ ' .AND.
212     1       IHARG(2).EQ.'PLOT')THEN
213         ILASTC=2
214         ICASE='EXPO'
215      ELSEIF(ICOM.EQ.'EXPO' .AND. IHARG(1).EQ.'TRUN' .AND.
216     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
217     1       IHARG(4).EQ.'PLOT')THEN
218         ILASTC=4
219         ICASE='EXPO'
220      ELSEIF(ICOM.EQ.'ARCS' .AND. IHARG(1).EQ.'TIQ ' .AND.
221     1       IHARG(2).EQ.'PLOT')THEN
222         ILASTC=2
223         ICASE='ARCS'
224      ELSEIF(ICOM.EQ.'ARCS' .AND. IHARG(1).EQ.'TRUN' .AND.
225     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
226     1       IHARG(4).EQ.'PLOT')THEN
227         ILASTC=4
228         ICASE='ARCS'
229      ELSEIF(ICOM.EQ.'ANGL' .AND. IHARG(1).EQ.'TIQ ' .AND.
230     1       IHARG(2).EQ.'PLOT')THEN
231         ILASTC=2
232         ICASE='ANGL'
233      ELSEIF(ICOM.EQ.'ANGL' .AND. IHARG(1).EQ.'TRUN' .AND.
234     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
235     1       IHARG(4).EQ.'PLOT')THEN
236         ILASTC=4
237         ICASE='ANGL'
238      ELSEIF(ICOM.EQ.'COSI' .AND. IHARG(1).EQ.'TIQ ' .AND.
239     1       IHARG(2).EQ.'PLOT')THEN
240         ILASTC=2
241         ICASE='COSI'
242      ELSEIF(ICOM.EQ.'COSI' .AND. IHARG(1).EQ.'TRUN' .AND.
243     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
244     1       IHARG(4).EQ.'PLOT')THEN
245         ILASTC=4
246         ICASE='COSI'
247      ELSEIF(ICOM.EQ.'CAUC' .AND. IHARG(1).EQ.'TIQ ' .AND.
248     1       IHARG(2).EQ.'PLOT')THEN
249         ILASTC=2
250         ICASE='CAUC'
251      ELSEIF(ICOM.EQ.'CAUC' .AND. IHARG(1).EQ.'TRUN' .AND.
252     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
253     1       IHARG(4).EQ.'PLOT')THEN
254         ILASTC=4
255         ICASE='CAUC'
256      ELSEIF(ICOM.EQ.'SLAS' .AND. IHARG(1).EQ.'TIQ ' .AND.
257     1       IHARG(2).EQ.'PLOT')THEN
258         ILASTC=2
259         ICASE='SLAS'
260      ELSEIF(ICOM.EQ.'SLAS' .AND. IHARG(1).EQ.'TRUN' .AND.
261     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
262     1       IHARG(4).EQ.'PLOT')THEN
263         ILASTC=4
264         ICASE='SLAS'
265      ELSEIF(ICOM.EQ.'SLAS' .AND. IHARG(1).EQ.'TIQ ' .AND.
266     1       IHARG(2).EQ.'PLOT')THEN
267         ILASTC=2
268         ICASE='SLAS'
269      ELSEIF(ICOM.EQ.'SLAS' .AND. IHARG(1).EQ.'TRUN' .AND.
270     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
271     1       IHARG(4).EQ.'PLOT')THEN
272         ILASTC=4
273         ICASE='SLAS'
274      ELSEIF(ICOM.EQ.'RAYL' .AND. IHARG(1).EQ.'TIQ ' .AND.
275     1       IHARG(2).EQ.'PLOT')THEN
276         ILASTC=2
277         ICASE='RAYL'
278      ELSEIF(ICOM.EQ.'RAYL' .AND. IHARG(1).EQ.'TRUN' .AND.
279     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
280     1       IHARG(4).EQ.'PLOT')THEN
281         ILASTC=4
282         ICASE='RAYL'
283      ELSEIF(ICOM.EQ.'MAXW' .AND. IHARG(1).EQ.'TIQ ' .AND.
284     1       IHARG(2).EQ.'PLOT')THEN
285         ILASTC=2
286         ICASE='MAXW'
287      ELSEIF(ICOM.EQ.'MAXW' .AND. IHARG(1).EQ.'TRUN' .AND.
288     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
289     1       IHARG(4).EQ.'PLOT')THEN
290         ILASTC=4
291         ICASE='MAXW'
292      ELSEIF(ICOM.EQ.'HALF' .AND. IHARG(1).EQ.'NORM' .AND.
293     1       IHARG(2).EQ.'TIQ ' .AND. IHARG(3).EQ.'PLOT')THEN
294         ILASTC=3
295         ICASE='HANO'
296      ELSEIF(ICOM.EQ.'HALF' .AND. IHARG(1).EQ.'NORM' .AND.
297     1       IHARG(2).EQ.'TRUN' .AND. IHARG(3).EQ.'INFO' .AND.
298     1       IHARG(4).EQ.'QUAN' .AND. IHARG(5).EQ.'PLOT')THEN
299         ILASTC=5
300         ICASE='HANO'
301      ELSEIF(ICOM.EQ.'HALF' .AND. IHARG(1).EQ.'CAUC' .AND.
302     1       IHARG(2).EQ.'TIQ ' .AND. IHARG(3).EQ.'PLOT')THEN
303         ILASTC=3
304         ICASE='HACA'
305      ELSEIF(ICOM.EQ.'HALF' .AND. IHARG(1).EQ.'CAUC' .AND.
306     1       IHARG(2).EQ.'TRUN' .AND. IHARG(3).EQ.'INFO' .AND.
307     1       IHARG(4).EQ.'QUAN' .AND. IHARG(5).EQ.'PLOT')THEN
308         ILASTC=5
309         ICASE='HACO'
310      ELSEIF(ICOM.EQ.'HYPE' .AND. IHARG(1).EQ.'SECA' .AND.
311     1       IHARG(2).EQ.'TIQ ' .AND. IHARG(3).EQ.'PLOT')THEN
312         ILASTC=3
313         ICASE='HSE '
314      ELSEIF(ICOM.EQ.'HYPE' .AND. IHARG(1).EQ.'SECA' .AND.
315     1       IHARG(2).EQ.'TRUN' .AND. IHARG(3).EQ.'INFO' .AND.
316     1       IHARG(4).EQ.'QUAN' .AND. IHARG(5).EQ.'PLOT')THEN
317         ILASTC=5
318         ICASE='HSE '
319      ELSEIF(ICOM.EQ.'LAPL' .AND. IHARG(1).EQ.'TIQ ' .AND.
320     1       IHARG(2).EQ.'PLOT')THEN
321         ILASTC=2
322         ICASE='DEX '
323      ELSEIF(ICOM.EQ.'LAPL' .AND. IHARG(1).EQ.'TRUN' .AND.
324     1       IHARG(2).EQ.'INFO' .AND. IHARG(3).EQ.'QUAN' .AND.
325     1       IHARG(4).EQ.'PLOT')THEN
326         ILASTC=4
327         ICASE='DEX '
328      ELSEIF(ICOM.EQ.'DOUB' .AND. IHARG(1).EQ.'EXPO' .AND.
329     1       IHARG(2).EQ.'TIQ ' .AND. IHARG(3).EQ.'PLOT')THEN
330         ILASTC=3
331         ICASE='DEX '
332      ELSEIF(ICOM.EQ.'DOUB' .AND. IHARG(1).EQ.'EXPO' .AND.
333     1       IHARG(2).EQ.'TRUN' .AND. IHARG(3).EQ.'INFO' .AND.
334     1       IHARG(4).EQ.'QUAN' .AND. IHARG(5).EQ.'PLOT')THEN
335         ILASTC=5
336         ICASE='DEX '
337      ELSEIF(ICOM.EQ.'SEMI' .AND. IHARG(1).EQ.'CIRC' .AND.
338     1       IHARG(2).EQ.'TIQ ' .AND. IHARG(3).EQ.'PLOT')THEN
339         ILASTC=3
340         ICASE='SEMC'
341      ELSEIF(ICOM.EQ.'SEMI' .AND. IHARG(1).EQ.'CIRC' .AND.
342     1       IHARG(2).EQ.'TRUN' .AND. IHARG(3).EQ.'INFO' .AND.
343     1       IHARG(4).EQ.'QUAN' .AND. IHARG(5).EQ.'PLOT')THEN
344         ILASTC=5
345         ICASE='SEMC'
346      ELSE
347        GOTO9000
348      ENDIF
349C
350      IFOUND='YES'
351      IF(ILASTC.GE.1)THEN
352        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
353        ILASTC=0
354      ENDIF
355C
356      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'TIQP')THEN
357        WRITE(ICOUT,112)ICASPL,IMULT,IREPL
358  112   FORMAT('ICASPL,IMULT,IREPL = ',2(A4,2X),A4)
359        CALL DPWRST('XXX','BUG ')
360      ENDIF
361C
362C               ****************************************
363C               **  STEP 2--                          **
364C               **  EXTRACT THE VARIABLE LIST         **
365C               ****************************************
366C
367      ISTEPN='2'
368      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TIQP')
369     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
370C
371      INAME='TRUNCATED INFORMATIVE QUANTILE PLOT'
372      MINNA=1
373      MAXNA=100
374      MINN2=5
375      IFLAGE=1
376      IFLAGM=1
377      IFLAGP=0
378      JMIN=1
379      JMAX=NUMARG
380      MINNVA=1
381      MAXNVA=1
382C
383      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
384     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
385     1            JMIN,JMAX,
386     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
387     1            IVARN1,IVARN2,IVARTY,PVAR,
388     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
389     1            MINNVA,MAXNVA,
390     1            IFLAGM,IFLAGP,
391     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
392      IF(IERROR.EQ.'YES')GOTO9000
393C
394      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TIQP')THEN
395        WRITE(ICOUT,999)
396        CALL DPWRST('XXX','BUG ')
397        WRITE(ICOUT,281)
398  281   FORMAT('***** AFTER CALL DPPARS--')
399        CALL DPWRST('XXX','BUG ')
400        WRITE(ICOUT,282)NQ,NUMVAR
401  282   FORMAT('NQ,NUMVAR = ',2I8)
402        CALL DPWRST('XXX','BUG ')
403        IF(NUMVAR.GT.0)THEN
404          DO285I=1,NUMVAR
405            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
406     1                      ICOLR(I)
407  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
408     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
409            CALL DPWRST('XXX','BUG ')
410  285     CONTINUE
411        ENDIF
412      ENDIF
413C
414C               ********************************************
415C               **  STEP 6--                              **
416C               **  GENERATE THE TIQ            PLOTS FOR **
417C               **  THE VARIOUS CASES.                    **
418C               ********************************************
419C
420      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TIQP')THEN
421        ISTEPN='6'
422        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
423        WRITE(ICOUT,601)NRESP,NREPL
424  601   FORMAT('NRESP,NREPL = ',2I5)
425        CALL DPWRST('XXX','BUG ')
426      ENDIF
427C
428C               ******************************************
429C               **  STEP 8A--                           **
430C               ******************************************
431C
432      ISTEPN='8A'
433      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TIQP')
434     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
435C
436      NPLOTP=0
437      ICOL=1
438      NUMVA2=1
439      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
440     1            INAME,IVARN1,IVARN2,IVARTY,
441     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
442     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
443     1            MAXCP4,MAXCP5,MAXCP6,
444     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
445     1            Y1,TEMP1,TEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE2,
446     1            IBUGG3,ISUBRO,IFOUND,IERROR)
447      IF(IERROR.EQ.'YES')GOTO9000
448C
449C               *****************************************************
450C               **  STEP 8B--                                      **
451C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
452C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
453C               *****************************************************
454C
455      CALL DPTIQ2(Y1,TEMP1,TEMP2,TEMP3,TEMP4,NLOCAL,
456     1            ICASE,MINMAX,
457     1            Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
458C
459C               *****************
460C               **  STEP 90--  **
461C               **  EXIT       **
462C               *****************
463C
464 9000 CONTINUE
465      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TIQP')THEN
466        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
467        WRITE(ICOUT,999)
468        CALL DPWRST('XXX','BUG ')
469        WRITE(ICOUT,9011)
470 9011   FORMAT('***** AT THE END       OF DPTIQP--')
471        CALL DPWRST('XXX','BUG ')
472        WRITE(ICOUT,9012)IFOUND,IERROR,ICASPL,IAND1,IAND2
473 9012   FORMAT('IFOUND,IERROR,ICASPL,IAND1,IAND2 = ',4(A4,2X),A4)
474        CALL DPWRST('XXX','BUG ')
475        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NLOCAL
476 9013   FORMAT('NPLOTV,NPLOTP,NLOCAL = ',3I8)
477        CALL DPWRST('XXX','BUG ')
478        IF(NPLOTP.GE.1)THEN
479          DO9015I=1,NPLOTP
480            WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
481 9016       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
482            CALL DPWRST('XXX','BUG ')
483 9015     CONTINUE
484        ENDIF
485      ENDIF
486C
487      RETURN
488      END
489      SUBROUTINE DPTIQ2(Y,AIQHAT,TIQHAT,UTEMP,QUHAT,N,
490     1                  ICASPL,MINMAX,
491     1                  Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
492C
493C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
494C              THAT WILL DEFINE A TRUNCATED INFORMATIVE QUANTILE
495C              (TIQ) PLOT.
496C
497C     REFERENCE--"MIL-HDBK-17-1F Volume 1: Guidelines for Characterization
498C                of Structural Materials", Depeartment of Defense,
499C                chapter 8, 2002.
500C
501C     WRITTEN BY--ALAN HECKERT
502C                 STATISTICAL ENGINEERING DIVISION
503C                 INFORMATION TECHNOLOGY LABORATORY
504C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
505C                 GAITHERSBURG, MD 20899-8980
506C                 PHONE--301-975-2899
507C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
508C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
509C     LANGUAGE--ANSI FORTRAN (1977)
510C     VERSION NUMBER--2017/03
511C     ORIGINAL VERSION--MARCH     2017.
512C
513C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
514C
515      CHARACTER*4 ICASPL
516      CHARACTER*4 IBUGG3
517      CHARACTER*4 ISUBRO
518      CHARACTER*4 IERROR
519C
520      CHARACTER*4 ISUBN1
521      CHARACTER*4 ISUBN2
522      CHARACTER*4 IWRITE
523C
524C---------------------------------------------------------------------
525C
526      DIMENSION Y(*)
527      DIMENSION UTEMP(*)
528      DIMENSION AIQHAT(*)
529      DIMENSION TIQHAT(*)
530      DIMENSION QUHAT(*)
531      DIMENSION Y2(*)
532      DIMENSION X2(*)
533      DIMENSION D2(*)
534C
535C-----COMMON----------------------------------------------------------
536C
537      INCLUDE 'DPCOST.INC'
538      INCLUDE 'DPCOP2.INC'
539C
540C-----START POINT-----------------------------------------------------
541C
542      ISUBN1='DPTI'
543      ISUBN2='Q2  '
544      IWRITE='OFF '
545      IERROR='NO'
546C
547      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TIQ2')THEN
548        WRITE(ICOUT,999)
549        CALL DPWRST('XXX','BUG ')
550        WRITE(ICOUT,70)
551   70   FORMAT('***** AT THE BEGINNING OF DPTIQ2--')
552        CALL DPWRST('XXX','BUG ')
553        WRITE(ICOUT,72)N,MINMAX,ICASPL
554   72   FORMAT('N,MINMAX,ICASPL = ',2I8,2X,A4)
555        CALL DPWRST('XXX','BUG ')
556        DO73I=1,N
557          WRITE(ICOUT,74)I,Y(I)
558   74     FORMAT('I, Y(I) = ',I8,G15.7)
559          CALL DPWRST('XXX','BUG ')
560   73   CONTINUE
561      ENDIF
562C
563C               ********************************************
564C               **  STEP 1--                              **
565C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
566C               ********************************************
567C
568      IF(N.LT.5)THEN
569        WRITE(ICOUT,999)
570  999   FORMAT(1X)
571        CALL DPWRST('XXX','BUG ')
572        WRITE(ICOUT,31)
573   31   FORMAT('***** ERROR IN TRUNCATED INFORMATIVE QUANTILE PLOT--')
574        CALL DPWRST('XXX','BUG ')
575        WRITE(ICOUT,32)
576   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 5;')
577        CALL DPWRST('XXX','BUG ')
578        WRITE(ICOUT,34)N
579   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
580        CALL DPWRST('XXX','BUG ')
581        WRITE(ICOUT,999)
582        CALL DPWRST('XXX','BUG ')
583        IERROR='YES'
584        GOTO9000
585      ENDIF
586C
587      HOLD=Y(1)
588      DO60I=1,N
589      IF(Y(I).NE.HOLD)GOTO69
590   60 CONTINUE
591      WRITE(ICOUT,999)
592      CALL DPWRST('XXX','BUG ')
593      WRITE(ICOUT,31)
594      CALL DPWRST('XXX','BUG ')
595      WRITE(ICOUT,62)
596   62 FORMAT('      ALL INPUT HORIZONTAL AXIS ELEMENTS')
597      CALL DPWRST('XXX','BUG ')
598      WRITE(ICOUT,63)HOLD
599   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',G15.7)
600      CALL DPWRST('XXX','BUG ')
601      WRITE(ICOUT,999)
602      CALL DPWRST('XXX','BUG ')
603      IERROR='YES'
604      GOTO9000
605   69 CONTINUE
606C
607C               **********************************************
608C               **  STEP 2--                                **
609C               **  FOR WEIBULL AND LOGNORMAL, NEED TO TAKE **
610C               **  LOG OF THE DATA.                        **
611C               **********************************************
612C
613      IF(ICASPL.EQ.'WEIB' .OR. ICASPL.EQ.'LOGN')THEN
614        DO200I=1,N
615          IF(Y(I).LE.0.0)THEN
616            WRITE(ICOUT,999)
617            CALL DPWRST('XXX','BUG ')
618            WRITE(ICOUT,31)
619            CALL DPWRST('XXX','BUG ')
620            WRITE(ICOUT,202)I
621  202       FORMAT('      ROW ',I8,' OF THE RESPONSE VARIABLE IS ',
622     1             'NON-POSITIVE.')
623            CALL DPWRST('XXX','BUG ')
624            WRITE(ICOUT,204)Y(I)
625  204       FORMAT('      IT HAS THE VALUE ',G15.7)
626            CALL DPWRST('XXX','BUG ')
627            IERROR='YES'
628            GOTO9000
629          ENDIF
630          Y(I)=LOG(Y(I))
631  200   CONTINUE
632      ENDIF
633C
634C               **********************************************
635C               **  STEP 3--                                **
636C               **  CALL EMPQUA ROUTINE TO COMPUTE THE      **
637C               **  TRUNCATED INFORMATIVE QUANTILE FUNCTION **
638C               **********************************************
639C
640C
641      CALL EMPTIQ(Y,N,IWRITE,AIQHAT,TIQHAT,UTEMP,QUHAT,NOUT,
642     1            IBUGG3,ISUBRO,IERROR)
643      IF(IERROR.EQ.'YES')GOTO9000
644C
645      DO310I=1,NOUT
646        N2=N2+1
647        Y2(N2)=TIQHAT(I)
648        X2(N2)=100.0*UTEMP(I)
649        D2(N2)=1.0
650  310 CONTINUE
651C
652C               **********************************************
653C               **  STEP 4--                                **
654C               **  NOW COMPUTE THE TRUNCATED INFORMATIVE   **
655C               **  QUANTILE FUNCTION FOR A THEORETICAL     **
656C               **  DISTRIBUTION.                           **
657C               **********************************************
658C
659C
660      U25=0.25
661      U50=0.50
662      U75=0.75
663      PINC=0.01
664C
665      IF(ICASPL.EQ.'NORM' .OR. ICASPL.EQ.'LOGN')THEN
666        CALL NORPPF(U25,QU25)
667        CALL NORPPF(U50,QU50)
668        CALL NORPPF(U75,QU75)
669        PVAL=0.01
670        DO401I=1,99
671          CALL NORPPF(PVAL,PPF)
672          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
673          IF(AVAL.LE.-1.0)AVAL=-1.0
674          IF(AVAL.GT.1.0)AVAL=1.0
675          N2=N2+1
676          Y2(N2)=AVAL
677          X2(N2)=100.0*PVAL
678          D2(N2)=2.0
679          PVAL=PVAL + PINC
680  401   CONTINUE
681      ELSEIF(ICASPL.EQ.'UNIF')THEN
682        CALL UNIPPF(U25,QU25)
683        CALL UNIPPF(U50,QU50)
684        CALL UNIPPF(U75,QU75)
685        PVAL=0.01
686        DO403I=1,99
687          CALL UNIPPF(PVAL,PPF)
688          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
689          IF(AVAL.LE.-1.0)AVAL=-1.0
690          IF(AVAL.GT.1.0)AVAL=1.0
691          N2=N2+1
692          Y2(N2)=AVAL
693          X2(N2)=100.0*PVAL
694          D2(N2)=2.0
695          PVAL=PVAL + PINC
696  403   CONTINUE
697      ELSEIF(ICASPL.EQ.'GUMB' .OR. ICASPL.EQ.'WEIB')THEN
698        MINMX2=MINMAX
699        IF(ICASPL.EQ.'WEIB')MINMX2=1
700        CALL EV1PPF(U25,MINMX2,QU25)
701        CALL EV1PPF(U50,MINMX2,QU50)
702        CALL EV1PPF(U75,MINMX2,QU75)
703        PVAL=0.01
704        DO405I=1,99
705          CALL EV1PPF(PVAL,MINMX2,PPF)
706          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
707          IF(AVAL.LE.-1.0)AVAL=-1.0
708          IF(AVAL.GT.1.0)AVAL=1.0
709          N2=N2+1
710          Y2(N2)=AVAL
711          X2(N2)=100.0*PVAL
712          D2(N2)=2.0
713          PVAL=PVAL + PINC
714  405   CONTINUE
715      ELSEIF(ICASPL.EQ.'LOGI')THEN
716        CALL LOGPPF(U25,QU25)
717        CALL LOGPPF(U50,QU50)
718        CALL LOGPPF(U75,QU75)
719        PVAL=0.01
720        DO411I=1,99
721          CALL LOGPPF(PVAL,PPF)
722          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
723          IF(AVAL.LE.-1.0)AVAL=-1.0
724          IF(AVAL.GT.1.0)AVAL=1.0
725          N2=N2+1
726          Y2(N2)=AVAL
727          X2(N2)=100.0*PVAL
728          D2(N2)=2.0
729          PVAL=PVAL + PINC
730  411   CONTINUE
731      ELSEIF(ICASPL.EQ.'DEX ')THEN
732        CALL DEXPPF(U25,QU25)
733        CALL DEXPPF(U50,QU50)
734        CALL DEXPPF(U75,QU75)
735        PVAL=0.01
736        DO413I=1,99
737          CALL DEXPPF(PVAL,PPF)
738          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
739          IF(AVAL.LE.-1.0)AVAL=-1.0
740          IF(AVAL.GT.1.0)AVAL=1.0
741          N2=N2+1
742          Y2(N2)=AVAL
743          X2(N2)=100.0*PVAL
744          D2(N2)=2.0
745          PVAL=PVAL + PINC
746  413   CONTINUE
747      ELSEIF(ICASPL.EQ.'CAUC')THEN
748        CALL CAUPPF(U25,QU25)
749        CALL CAUPPF(U50,QU50)
750        CALL CAUPPF(U75,QU75)
751        PVAL=0.01
752        DO415I=1,99
753          CALL CAUPPF(PVAL,PPF)
754          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
755          IF(AVAL.LE.-1.0)AVAL=-1.0
756          IF(AVAL.GT.1.0)AVAL=1.0
757          N2=N2+1
758          Y2(N2)=AVAL
759          X2(N2)=100.0*PVAL
760          D2(N2)=2.0
761          PVAL=PVAL + PINC
762  415   CONTINUE
763      ELSEIF(ICASPL.EQ.'SEMC')THEN
764        R=1.0
765        CALL SEMPPF(U25,R,QU25)
766        CALL SEMPPF(U50,R,QU50)
767        CALL SEMPPF(U75,R,QU75)
768        PVAL=0.01
769        DO417I=1,99
770          CALL SEMPPF(PVAL,R,PPF)
771          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
772          IF(AVAL.LE.-1.0)AVAL=-1.0
773          IF(AVAL.GT.1.0)AVAL=1.0
774          N2=N2+1
775          Y2(N2)=AVAL
776          X2(N2)=100.0*PVAL
777          D2(N2)=2.0
778          PVAL=PVAL + PINC
779  417   CONTINUE
780      ELSEIF(ICASPL.EQ.'COSI')THEN
781        CALL COSPPF(U25,QU25)
782        CALL COSPPF(U50,QU50)
783        CALL COSPPF(U75,QU75)
784        PVAL=0.01
785        DO419I=1,99
786          CALL COSPPF(PVAL,PPF)
787          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
788          IF(AVAL.LE.-1.0)AVAL=-1.0
789          IF(AVAL.GT.1.0)AVAL=1.0
790          N2=N2+1
791          Y2(N2)=AVAL
792          X2(N2)=100.0*PVAL
793          D2(N2)=2.0
794          PVAL=PVAL + PINC
795  419   CONTINUE
796      ELSEIF(ICASPL.EQ.'ANGL')THEN
797        CALL ANGPPF(U25,QU25)
798        CALL ANGPPF(U50,QU50)
799        CALL ANGPPF(U75,QU75)
800        PVAL=0.01
801        DO421I=1,99
802          CALL ANGPPF(PVAL,PPF)
803          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
804          IF(AVAL.LE.-1.0)AVAL=-1.0
805          IF(AVAL.GT.1.0)AVAL=1.0
806          N2=N2+1
807          Y2(N2)=AVAL
808          X2(N2)=100.0*PVAL
809          D2(N2)=2.0
810          PVAL=PVAL + PINC
811  421   CONTINUE
812      ELSEIF(ICASPL.EQ.'HSE ')THEN
813        CALL HSEPPF(U25,QU25)
814        CALL HSEPPF(U50,QU50)
815        CALL HSEPPF(U75,QU75)
816        PVAL=0.01
817        DO423I=1,99
818          CALL HSEPPF(PVAL,PPF)
819          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
820          IF(AVAL.LE.-1.0)AVAL=-1.0
821          IF(AVAL.GT.1.0)AVAL=1.0
822          N2=N2+1
823          Y2(N2)=AVAL
824          X2(N2)=100.0*PVAL
825          D2(N2)=2.0
826          PVAL=PVAL + PINC
827  423   CONTINUE
828      ELSEIF(ICASPL.EQ.'HANO')THEN
829        CALL HFNPPF(U25,QU25)
830        CALL HFNPPF(U50,QU50)
831        CALL HFNPPF(U75,QU75)
832        PVAL=0.01
833        DO425I=1,99
834          CALL HFNPPF(PVAL,PPF)
835          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
836          IF(AVAL.LE.-1.0)AVAL=-1.0
837          IF(AVAL.GT.1.0)AVAL=1.0
838          N2=N2+1
839          Y2(N2)=AVAL
840          X2(N2)=100.0*PVAL
841          D2(N2)=2.0
842          PVAL=PVAL + PINC
843  425   CONTINUE
844      ELSEIF(ICASPL.EQ.'ARCS')THEN
845        print *,'at arcsine case'
846        CALL ARSPPF(U25,QU25)
847        CALL ARSPPF(U50,QU50)
848        CALL ARSPPF(U75,QU75)
849        PVAL=0.01
850        DO427I=1,99
851          CALL ARSPPF(PVAL,PPF)
852          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
853          IF(AVAL.LE.-1.0)AVAL=-1.0
854          IF(AVAL.GT.1.0)AVAL=1.0
855          N2=N2+1
856          Y2(N2)=AVAL
857          X2(N2)=100.0*PVAL
858          D2(N2)=2.0
859          PVAL=PVAL + PINC
860  427   CONTINUE
861      ELSEIF(ICASPL.EQ.'EXPO')THEN
862        CALL EXPPPF(U25,QU25)
863        CALL EXPPPF(U50,QU50)
864        CALL EXPPPF(U75,QU75)
865        PVAL=0.01
866        DO429I=1,99
867          CALL EXPPPF(PVAL,PPF)
868          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
869          IF(AVAL.GT.1.0)AVAL=1.0
870          IF(AVAL.LE.-1.0)AVAL=-1.0
871          N2=N2+1
872          Y2(N2)=AVAL
873          X2(N2)=100.0*PVAL
874          D2(N2)=2.0
875          PVAL=PVAL + PINC
876  429   CONTINUE
877      ELSEIF(ICASPL.EQ.'HACA')THEN
878        CALL HFCPPF(U25,QU25)
879        CALL HFCPPF(U50,QU50)
880        CALL HFCPPF(U75,QU75)
881        PVAL=0.01
882        DO431I=1,99
883          CALL HFCPPF(PVAL,PPF)
884          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
885          IF(AVAL.LE.-1.0)AVAL=-1.0
886          IF(AVAL.GT.1.0)AVAL=1.0
887          N2=N2+1
888          Y2(N2)=AVAL
889          X2(N2)=100.0*PVAL
890          D2(N2)=2.0
891          PVAL=PVAL + PINC
892  431   CONTINUE
893      ELSEIF(ICASPL.EQ.'SLAS')THEN
894        CALL SLAPPF(U25,QU25)
895        CALL SLAPPF(U50,QU50)
896        CALL SLAPPF(U75,QU75)
897        PVAL=0.01
898        DO433I=1,99
899          CALL SLAPPF(PVAL,PPF)
900          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
901          IF(AVAL.LE.-1.0)AVAL=-1.0
902          IF(AVAL.GT.1.0)AVAL=1.0
903          N2=N2+1
904          Y2(N2)=AVAL
905          X2(N2)=100.0*PVAL
906          D2(N2)=2.0
907          PVAL=PVAL + PINC
908  433   CONTINUE
909      ELSEIF(ICASPL.EQ.'RAYL')THEN
910        CALL RAYPPF(U25,QU25)
911        CALL RAYPPF(U50,QU50)
912        CALL RAYPPF(U75,QU75)
913        PVAL=0.01
914        DO435I=1,99
915          CALL RAYPPF(PVAL,PPF)
916          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
917          IF(AVAL.LE.-1.0)AVAL=-1.0
918          IF(AVAL.GT.1.0)AVAL=1.0
919          N2=N2+1
920          Y2(N2)=AVAL
921          X2(N2)=100.0*PVAL
922          D2(N2)=2.0
923          PVAL=PVAL + PINC
924  435   CONTINUE
925      ELSEIF(ICASPL.EQ.'MAXW')THEN
926        CALL MAXPPF(U25,QU25)
927        CALL MAXPPF(U50,QU50)
928        CALL MAXPPF(U75,QU75)
929        PVAL=0.01
930        DO437I=1,99
931          CALL MAXPPF(PVAL,PPF)
932          AVAL=(PPF - QU50)/(2.0*(QU75-QU25))
933          IF(AVAL.LE.-1.0)AVAL=-1.0
934          IF(AVAL.GT.1.0)AVAL=1.0
935          N2=N2+1
936          Y2(N2)=AVAL
937          X2(N2)=100.0*PVAL
938          D2(N2)=2.0
939          PVAL=PVAL + PINC
940  437   CONTINUE
941      ENDIF
942C
943      NPLOTV=2
944      GOTO9000
945C
946C               ******************
947C               **   STEP 90--  **
948C               **   EXIT       **
949C               ******************
950C
951 9000 CONTINUE
952      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TIQ2')THEN
953        WRITE(ICOUT,999)
954        CALL DPWRST('XXX','BUG ')
955        WRITE(ICOUT,9011)
956 9011   FORMAT('***** AT THE END       OF DPTIQ2--')
957        CALL DPWRST('XXX','BUG ')
958        WRITE(ICOUT,9012)ICASPL,IERROR,N2
959 9012   FORMAT('ICASPL,IERROR,N2 = ',2(A4,2X),I8)
960        CALL DPWRST('XXX','BUG ')
961        DO9015I=1,N2
962          WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
963 9016     FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2G15.7,F9.2)
964          CALL DPWRST('XXX','BUG ')
965 9015   CONTINUE
966      ENDIF
967C
968      RETURN
969      END
970      SUBROUTINE DPTISC(ICOM,IHARG,NUMARG,
971     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
972     1IFOUND,IERROR)
973C
974C     PURPOSE--DEFINE THE 4 TIC SCALES CONTAINED IN THE
975C              4 VARIABLES IX1TSC,IX2TSC,IY1TSC,IY2TSC  .
976C              SUCH TIC SCALE SWITCHES DEFINE THE SCALES
977C              (LINEAR OR WEIBULL OR NORMAL)
978C              FOR THE TICS ON THE 4 FRAME LINES OF A PLOT.
979C     FOCUS OF SUBROUTINE DPTISC--LOG
980C                         DPTIS2--WEIBULL
981C                         DPTIS3--NORMAL
982C
983C     INPUT  ARGUMENTS--ICOM
984C                     --IHARG  (A  HOLLERITH VECTOR)
985C                     --NUMARG
986C     OUTPUT ARGUMENTS--
987C                     --IX1TSC = LOWER HORIZONTAL TIC SCALE
988C                     --IX2TSC = UPPER HORIZONTAL TIC SCALE
989C                     --IY1TSC = LEFT  VERTICAL   TIC SCALE
990C                     --IY2TSC = RIGHT VERTICAL   TIC SCALE
991C                     --IFOUND ('YES' OR 'NO' )
992C                     --IERROR ('YES' OR 'NO' )
993C     WRITTEN BY--JAMES J. FILLIBEN
994C                 STATISTICAL ENGINEERING DIVISION
995C                 INFORMATION TECHNOLOGY LABORATORY
996C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
997C                 GAITHERSBURG, MD 20899-8980
998C                 PHONE--301-975-2855
999C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1000C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1001C     LANGUAGE--ANSI FORTRAN (1977)
1002C     VERSION NUMBER--82/7
1003C     ORIGINAL VERSION--SEPTEMBER 1980.
1004C     UPDATED         --MARCH     1981.
1005C     UPDATED         --MAY       1982.
1006C
1007C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1008C
1009      CHARACTER*4 ICOM
1010      CHARACTER*4 IHARG
1011C
1012      CHARACTER*4 IX1TSC
1013      CHARACTER*4 IX2TSC
1014      CHARACTER*4 IY1TSC
1015      CHARACTER*4 IY2TSC
1016C
1017      CHARACTER*4 IFOUND
1018      CHARACTER*4 IERROR
1019C
1020C---------------------------------------------------------------------
1021C
1022      DIMENSION IHARG(*)
1023C
1024C-----COMMON----------------------------------------------------------
1025C
1026      INCLUDE 'DPCOP2.INC'
1027C
1028C-----START POINT-----------------------------------------------------
1029C
1030      IFOUND='NO'
1031      IERROR='NO'
1032C
1033      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
1034      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORN')GOTO1900
1035C
1036C               *****************************************************
1037C               **  TREAT THE CASE WHEN                           **
1038C               **  BOTH HORIZONTAL LOG SCALES  ARE TO BE LOG      **
1039C               *****************************************************
1040C
1041      IF(ICOM.EQ.'XLOG')GOTO1100
1042      GOTO1199
1043C
1044 1100 CONTINUE
1045      IF(NUMARG.LE.0)GOTO1110
1046      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
1047      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
1048      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
1049      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
1050      IERROR='YES'
1051      GOTO1900
1052C
1053 1110 CONTINUE
1054      IFOUND='YES'
1055      IX1TSC='LOG'
1056      IX2TSC='LOG'
1057C
1058      IF(IFEEDB.EQ.'OFF')GOTO1119
1059      WRITE(ICOUT,999)
1060  999 FORMAT(1X)
1061      CALL DPWRST('XXX','BUG ')
1062      WRITE(ICOUT,1115)
1063 1115 FORMAT('THE XLOG SWITCH (FOR BOTH HORIZONTAL LOG SCALES ) ',
1064     1'HAS JUST BEEN TURNED ON')
1065      CALL DPWRST('XXX','BUG ')
1066 1119 CONTINUE
1067      GOTO1900
1068C
1069 1120 CONTINUE
1070      IFOUND='YES'
1071      IX1TSC='LINE'
1072      IX2TSC='LINE'
1073C
1074      IF(IFEEDB.EQ.'OFF')GOTO1129
1075      WRITE(ICOUT,999)
1076      CALL DPWRST('XXX','BUG ')
1077      WRITE(ICOUT,1125)
1078 1125 FORMAT('THE XLOG SWITCH (FOR BOTH HORIZONTAL LOG SCALES ) ',
1079     1'HAS JUST BEEN TURNED OFF')
1080      CALL DPWRST('XXX','BUG ')
1081 1129 CONTINUE
1082      GOTO1900
1083C
1084 1199 CONTINUE
1085C
1086C               **************************************************************
1087C               **  TREAT THE CASE WHEN                                     **
1088C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE IS TO BE LOG      **
1089C               **************************************************************
1090C
1091      IF(ICOM.EQ.'X1LO')GOTO1200
1092      GOTO1299
1093C
1094 1200 CONTINUE
1095      IF(NUMARG.LE.0)GOTO1210
1096      IF(IHARG(NUMARG).EQ.'ON')GOTO1210
1097      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
1098      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1210
1099      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1210
1100      IERROR='YES'
1101      GOTO1900
1102C
1103 1210 CONTINUE
1104      IFOUND='YES'
1105      IX1TSC='LOG'
1106C
1107      IF(IFEEDB.EQ.'OFF')GOTO1219
1108      WRITE(ICOUT,999)
1109      CALL DPWRST('XXX','BUG ')
1110      WRITE(ICOUT,1215)
1111 1215 FORMAT('THE X1LOG   SWITCH (FOR THE BOTTOM HORIZONTAL ',
1112     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED ON')
1113      CALL DPWRST('XXX','BUG ')
1114 1219 CONTINUE
1115      GOTO1900
1116C
1117 1220 CONTINUE
1118      IFOUND='YES'
1119      IX1TSC='LINE'
1120C
1121      IF(IFEEDB.EQ.'OFF')GOTO1229
1122      WRITE(ICOUT,999)
1123      CALL DPWRST('XXX','BUG ')
1124      WRITE(ICOUT,1225)
1125 1225 FORMAT('THE X1LOG   SWITCH (FOR THE BOTTOM HORIZONTAL ',
1126     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED OFF')
1127      CALL DPWRST('XXX','BUG ')
1128 1229 CONTINUE
1129      GOTO1900
1130C
1131 1299 CONTINUE
1132C
1133C               **************************************************************
1134C               **  TREAT THE CASE WHEN                                     **
1135C               **  ONLY THE TOP    HORIZONTAL FRAME LINE IS TO BE LOG      **
1136C               **************************************************************
1137C
1138      IF(ICOM.EQ.'X2LO')GOTO1300
1139      GOTO1399
1140C
1141 1300 CONTINUE
1142      IF(NUMARG.LE.0)GOTO1310
1143      IF(IHARG(NUMARG).EQ.'ON')GOTO1310
1144      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
1145      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1310
1146      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1310
1147      IERROR='YES'
1148      GOTO1900
1149C
1150 1310 CONTINUE
1151      IFOUND='YES'
1152      IX2TSC='LOG'
1153C
1154      IF(IFEEDB.EQ.'OFF')GOTO1319
1155      WRITE(ICOUT,999)
1156      CALL DPWRST('XXX','BUG ')
1157      WRITE(ICOUT,1315)
1158 1315 FORMAT('THE X2LOG   SWITCH (FOR THE TOP HORIZONTAL ',
1159     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED ON')
1160      CALL DPWRST('XXX','BUG ')
1161 1319 CONTINUE
1162      GOTO1900
1163C
1164 1320 CONTINUE
1165      IFOUND='YES'
1166      IX2TSC='LINE'
1167C
1168      IF(IFEEDB.EQ.'OFF')GOTO1329
1169      WRITE(ICOUT,999)
1170      CALL DPWRST('XXX','BUG ')
1171      WRITE(ICOUT,1325)
1172 1325 FORMAT('THE X2LOG   SWITCH (FOR THE TOP HORIZONTAL ',
1173     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED OFF')
1174      CALL DPWRST('XXX','BUG ')
1175 1329 CONTINUE
1176      GOTO1900
1177C
1178 1399 CONTINUE
1179C
1180C               ***************************************************
1181C               **  TREAT THE CASE WHEN                          **
1182C               **  BOTH VERTICAL LOG SCALES  ARE TO BE LOG      **
1183C               ***************************************************
1184C
1185      IF(ICOM.EQ.'YLOG')GOTO1400
1186      GOTO1499
1187C
1188 1400 CONTINUE
1189      IF(NUMARG.LE.0)GOTO1410
1190      IF(IHARG(NUMARG).EQ.'ON')GOTO1410
1191      IF(IHARG(NUMARG).EQ.'OFF')GOTO1420
1192      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1410
1193      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1410
1194      IERROR='YES'
1195      GOTO1900
1196C
1197 1410 CONTINUE
1198      IFOUND='YES'
1199      IY1TSC='LOG'
1200      IY2TSC='LOG'
1201C
1202      IF(IFEEDB.EQ.'OFF')GOTO1419
1203      WRITE(ICOUT,999)
1204      CALL DPWRST('XXX','BUG ')
1205      WRITE(ICOUT,1415)
1206 1415 FORMAT('THE YLOG   SWITCH (FOR BOTH VERTICAL LOG SCALES ) ',
1207     1'HAS JUST BEEN TURNED ON')
1208      CALL DPWRST('XXX','BUG ')
1209 1419 CONTINUE
1210      GOTO1900
1211C
1212 1420 CONTINUE
1213      IFOUND='YES'
1214      IY1TSC='LINE'
1215      IY2TSC='LINE'
1216C
1217      IF(IFEEDB.EQ.'OFF')GOTO1429
1218      WRITE(ICOUT,999)
1219      CALL DPWRST('XXX','BUG ')
1220      WRITE(ICOUT,1425)
1221 1425 FORMAT('THE YLOG   SWITCH (FOR BOTH VERTICAL LOG SCALES ) ',
1222     1'HAS JUST BEEN TURNED OFF')
1223      CALL DPWRST('XXX','BUG ')
1224 1429 CONTINUE
1225      GOTO1900
1226C
1227 1499 CONTINUE
1228C
1229C               **************************************************************
1230C               **  TREAT THE CASE WHEN                                     **
1231C               **  ONLY THE LEFT   VERTICAL   FRAME LINE IS TO BE LOG      **
1232C               **************************************************************
1233C
1234      IF(ICOM.EQ.'Y1LO')GOTO1500
1235      GOTO1599
1236C
1237 1500 CONTINUE
1238      IF(NUMARG.LE.0)GOTO1510
1239      IF(IHARG(NUMARG).EQ.'ON')GOTO1510
1240      IF(IHARG(NUMARG).EQ.'OFF')GOTO1520
1241      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1510
1242      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1510
1243      IERROR='YES'
1244      GOTO1900
1245C
1246 1510 CONTINUE
1247      IFOUND='YES'
1248      IY1TSC='LOG'
1249C
1250      IF(IFEEDB.EQ.'OFF')GOTO1519
1251      WRITE(ICOUT,999)
1252      CALL DPWRST('XXX','BUG ')
1253      WRITE(ICOUT,1515)
1254 1515 FORMAT('THE Y1LOG   SWITCH (FOR THE LEFT VERTICAL ',
1255     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED ON')
1256      CALL DPWRST('XXX','BUG ')
1257 1519 CONTINUE
1258      GOTO1900
1259C
1260 1520 CONTINUE
1261      IFOUND='YES'
1262      IY1TSC='LINE'
1263C
1264      IF(IFEEDB.EQ.'OFF')GOTO1529
1265      WRITE(ICOUT,999)
1266      CALL DPWRST('XXX','BUG ')
1267      WRITE(ICOUT,1525)
1268 1525 FORMAT('THE Y1LOG   SWITCH (FOR THE LEFT VERTICAL ',
1269     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED OFF')
1270      CALL DPWRST('XXX','BUG ')
1271 1529 CONTINUE
1272      GOTO1900
1273C
1274 1599 CONTINUE
1275C
1276C               **************************************************************
1277C               **  TREAT THE CASE WHEN                                     **
1278C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE IS TO BE LOG      **
1279C               **************************************************************
1280C
1281      IF(ICOM.EQ.'Y2LO')GOTO1600
1282      GOTO1699
1283C
1284 1600 CONTINUE
1285      IF(NUMARG.LE.0)GOTO1610
1286      IF(IHARG(NUMARG).EQ.'ON')GOTO1610
1287      IF(IHARG(NUMARG).EQ.'OFF')GOTO1620
1288      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1610
1289      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1610
1290      IERROR='YES'
1291      GOTO1900
1292C
1293 1610 CONTINUE
1294      IFOUND='YES'
1295      IY2TSC='LOG'
1296C
1297      IF(IFEEDB.EQ.'OFF')GOTO1619
1298      WRITE(ICOUT,999)
1299      CALL DPWRST('XXX','BUG ')
1300      WRITE(ICOUT,1615)
1301 1615 FORMAT('THE Y2LOG   SWITCH (FOR THE RIGHT VERTICAL ',
1302     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED ON')
1303      CALL DPWRST('XXX','BUG ')
1304 1619 CONTINUE
1305      GOTO1900
1306C
1307 1620 CONTINUE
1308      IFOUND='YES'
1309      IY2TSC='LINE'
1310C
1311      IF(IFEEDB.EQ.'OFF')GOTO1629
1312      WRITE(ICOUT,999)
1313      CALL DPWRST('XXX','BUG ')
1314      WRITE(ICOUT,1625)
1315 1625 FORMAT('THE Y2LOG   SWITCH (FOR THE RIGHT VERTICAL ',
1316     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED OFF')
1317      CALL DPWRST('XXX','BUG ')
1318 1629 CONTINUE
1319      GOTO1900
1320C
1321 1699 CONTINUE
1322C
1323C               **************************************************
1324C               **  TREAT THE CASE WHEN                         **
1325C               **  THE ENTIRE 4-SIDED FRAME IS TO BE LOG       **
1326C               **************************************************
1327C
1328      IF(ICOM.EQ.'XYLO')GOTO1700
1329      IF(ICOM.EQ.'YXLO')GOTO1700
1330      IF(ICOM.EQ.'LOG ')GOTO1700
1331      IF(ICOM.EQ.'LOGL')GOTO1700
1332      GOTO1799
1333C
1334 1700 CONTINUE
1335      IF(NUMARG.LE.0)GOTO1710
1336      IF(IHARG(NUMARG).EQ.'ON')GOTO1710
1337      IF(IHARG(NUMARG).EQ.'OFF')GOTO1720
1338      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1710
1339      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1710
1340      IERROR='YES'
1341      GOTO1900
1342C
1343 1710 CONTINUE
1344      IFOUND='YES'
1345      IX1TSC='LOG'
1346      IX2TSC='LOG'
1347      IY1TSC='LOG'
1348      IY2TSC='LOG'
1349C
1350      IF(IFEEDB.EQ.'OFF')GOTO1719
1351      WRITE(ICOUT,999)
1352      CALL DPWRST('XXX','BUG ')
1353      WRITE(ICOUT,1715)
1354 1715 FORMAT('THE LOG   SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
1355     1'HAS JUST BEEN TURNED ON')
1356      CALL DPWRST('XXX','BUG ')
1357 1719 CONTINUE
1358      GOTO1900
1359C
1360 1720 CONTINUE
1361      IFOUND='YES'
1362      IX1TSC='LINE'
1363      IX2TSC='LINE'
1364      IY1TSC='LINE'
1365      IY2TSC='LINE'
1366C
1367      IF(IFEEDB.EQ.'OFF')GOTO1729
1368      WRITE(ICOUT,999)
1369      CALL DPWRST('XXX','BUG ')
1370      WRITE(ICOUT,1725)
1371 1725 FORMAT('THE LOG   SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
1372     1'HAS JUST BEEN TURNED OFF')
1373      CALL DPWRST('XXX','BUG ')
1374 1729 CONTINUE
1375      GOTO1900
1376C
1377 1799 CONTINUE
1378C
1379 1900 CONTINUE
1380      RETURN
1381      END
1382      SUBROUTINE DPTIS2(ICOM,IHARG,NUMARG,
1383     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
1384     1IFOUND,IERROR)
1385C
1386C     PURPOSE--DEFINE THE 4 TIC SCALES CONTAINED IN THE
1387C              4 VARIABLES IX1TSC,IX2TSC,IY1TSC,IY2TSC  .
1388C              SUCH TIC SCALE SWITCHES DEFINE THE SCALES
1389C              (LINEAR OR WEIBULL OR NORMAL)
1390C              FOR THE TICS ON THE 4 FRAME LINES OF A PLOT.
1391C     FOCUS OF SUBROUTINE DPTISC--LOG
1392C                         DPTIS2--WEIBULL
1393C                         DPTIS3--NORMAL
1394C
1395C     INPUT  ARGUMENTS--ICOM
1396C                     --IHARG  (A  HOLLERITH VECTOR)
1397C                     --NUMARG
1398C     OUTPUT ARGUMENTS--
1399C                     --IX1TSC = LOWER HORIZONTAL TIC SCALE
1400C                     --IX2TSC = UPPER HORIZONTAL TIC SCALE
1401C                     --IY1TSC = LEFT  VERTICAL   TIC SCALE
1402C                     --IY2TSC = RIGHT VERTICAL   TIC SCALE
1403C                     --IFOUND ('YES' OR 'NO' )
1404C                     --IERROR ('YES' OR 'NO' )
1405C     WRITTEN BY--JAMES J. FILLIBEN
1406C                 STATISTICAL ENGINEERING DIVISION
1407C                 INFORMATION TECHNOLOGY LABORATORY
1408C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1409C                 GAITHERSBURG, MD 20899-8980
1410C                 PHONE--301-975-2855
1411C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1412C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1413C     LANGUAGE--ANSI FORTRAN (1977)
1414C     VERSION NUMBER--82/7
1415C     ORIGINAL VERSION--SEPTEMBER 1980.
1416C     UPDATED         --MARCH     1981.
1417C     UPDATED         --MAY       1982.
1418C
1419C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1420C
1421      CHARACTER*4 ICOM
1422      CHARACTER*4 IHARG
1423C
1424      CHARACTER*4 IX1TSC
1425      CHARACTER*4 IX2TSC
1426      CHARACTER*4 IY1TSC
1427      CHARACTER*4 IY2TSC
1428C
1429      CHARACTER*4 IFOUND
1430      CHARACTER*4 IERROR
1431C
1432C---------------------------------------------------------------------
1433C
1434      DIMENSION IHARG(*)
1435C
1436C-----COMMON----------------------------------------------------------
1437C
1438      INCLUDE 'DPCOP2.INC'
1439C
1440C-----START POINT-----------------------------------------------------
1441C
1442      IFOUND='NO'
1443      IERROR='NO'
1444C
1445      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
1446      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORN')GOTO1900
1447C
1448C               ********************************************************
1449C               **  TREAT THE CASE WHEN                               **
1450C               **  BOTH HORIZONTAL FRAME LINES     ARE TO BE WEIBULL **
1451C               ********************************************************
1452C
1453      IF(ICOM.EQ.'XWEI')GOTO1100
1454      GOTO1199
1455C
1456 1100 CONTINUE
1457      IF(NUMARG.LE.0)GOTO1110
1458      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
1459      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
1460      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
1461      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
1462      IERROR='YES'
1463      GOTO1900
1464C
1465 1110 CONTINUE
1466      IFOUND='YES'
1467      IX1TSC='WEIB'
1468      IX2TSC='WEIB'
1469C
1470      IF(IFEEDB.EQ.'OFF')GOTO1119
1471      WRITE(ICOUT,999)
1472  999 FORMAT(1X)
1473      CALL DPWRST('XXX','BUG ')
1474      WRITE(ICOUT,1115)
1475 1115 FORMAT('THE XWEIB SWITCH (FOR BOTH HORIZ. WEIBULL SCALES)',
1476     1'HAS JUST BEEN TURNED ON')
1477      CALL DPWRST('XXX','BUG ')
1478 1119 CONTINUE
1479      GOTO1900
1480C
1481 1120 CONTINUE
1482      IFOUND='YES'
1483      IX1TSC='LINE'
1484      IX2TSC='LINE'
1485C
1486      IF(IFEEDB.EQ.'OFF')GOTO1129
1487      WRITE(ICOUT,999)
1488      CALL DPWRST('XXX','BUG ')
1489      WRITE(ICOUT,1125)
1490 1125 FORMAT('THE XWEIB SWITCH (FOR BOTH HORIZ. WEIBULL SCALES)',
1491     1'HAS JUST BEEN TURNED OFF')
1492      CALL DPWRST('XXX','BUG ')
1493 1129 CONTINUE
1494      GOTO1900
1495C
1496 1199 CONTINUE
1497C
1498C               ********************************************************
1499C               **  TREAT THE CASE WHEN
1500C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE IS TO BE WEIBU
1501C               ********************************************************
1502C
1503      IF(ICOM.EQ.'X1WE')GOTO1200
1504      GOTO1299
1505C
1506 1200 CONTINUE
1507      IF(NUMARG.LE.0)GOTO1210
1508      IF(IHARG(NUMARG).EQ.'ON')GOTO1210
1509      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
1510      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1210
1511      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1210
1512      IERROR='YES'
1513      GOTO1900
1514C
1515 1210 CONTINUE
1516      IFOUND='YES'
1517      IX1TSC='WEIB'
1518C
1519      IF(IFEEDB.EQ.'OFF')GOTO1219
1520      WRITE(ICOUT,999)
1521      CALL DPWRST('XXX','BUG ')
1522      WRITE(ICOUT,1215)
1523 1215 FORMAT('THE X1WEIB   SWITCH (FOR THE BOTTOM HORIZONTAL ',
1524     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED ON')
1525      CALL DPWRST('XXX','BUG ')
1526 1219 CONTINUE
1527      GOTO1900
1528C
1529 1220 CONTINUE
1530      IFOUND='YES'
1531      IX1TSC='LINE'
1532C
1533      IF(IFEEDB.EQ.'OFF')GOTO1229
1534      WRITE(ICOUT,999)
1535      CALL DPWRST('XXX','BUG ')
1536      WRITE(ICOUT,1225)
1537 1225 FORMAT('THE X1WEIB   SWITCH (FOR THE BOTTOM HORIZONTAL ',
1538     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED OFF')
1539      CALL DPWRST('XXX','BUG ')
1540 1229 CONTINUE
1541      GOTO1900
1542C
1543 1299 CONTINUE
1544C
1545C               ********************************************************
1546C               **  TREAT THE CASE WHEN
1547C               **  ONLY THE TOP    HORIZONTAL FRAME LINE IS TO BE WEIBU
1548C               ********************************************************
1549C
1550      IF(ICOM.EQ.'X2WE')GOTO1300
1551      GOTO1399
1552C
1553 1300 CONTINUE
1554      IF(NUMARG.LE.0)GOTO1310
1555      IF(IHARG(NUMARG).EQ.'ON')GOTO1310
1556      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
1557      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1310
1558      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1310
1559      IERROR='YES'
1560      GOTO1900
1561C
1562 1310 CONTINUE
1563      IFOUND='YES'
1564      IX2TSC='WEIB'
1565C
1566      IF(IFEEDB.EQ.'OFF')GOTO1319
1567      WRITE(ICOUT,999)
1568      CALL DPWRST('XXX','BUG ')
1569      WRITE(ICOUT,1315)
1570 1315 FORMAT('THE X2WEIB   SWITCH (FOR THE TOP HORIZONTAL ',
1571     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED ON')
1572      CALL DPWRST('XXX','BUG ')
1573 1319 CONTINUE
1574      GOTO1900
1575C
1576 1320 CONTINUE
1577      IFOUND='YES'
1578      IX2TSC='LINE'
1579C
1580      IF(IFEEDB.EQ.'OFF')GOTO1329
1581      WRITE(ICOUT,999)
1582      CALL DPWRST('XXX','BUG ')
1583      WRITE(ICOUT,1325)
1584 1325 FORMAT('THE X2WEIB   SWITCH (FOR THE TOP HORIZONTAL ',
1585     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED OFF')
1586      CALL DPWRST('XXX','BUG ')
1587 1329 CONTINUE
1588      GOTO1900
1589C
1590 1399 CONTINUE
1591C
1592C               ******************************************************
1593C               **  TREAT THE CASE WHEN                             **
1594C               **  BOTH VERTICAL FRAME LINES     ARE TO BE WEIBULL **
1595C               ******************************************************
1596C
1597      IF(ICOM.EQ.'YWEI')GOTO1400
1598      GOTO1499
1599C
1600 1400 CONTINUE
1601      IF(NUMARG.LE.0)GOTO1410
1602      IF(IHARG(NUMARG).EQ.'ON')GOTO1410
1603      IF(IHARG(NUMARG).EQ.'OFF')GOTO1420
1604      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1410
1605      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1410
1606      IERROR='YES'
1607      GOTO1900
1608C
1609 1410 CONTINUE
1610      IFOUND='YES'
1611      IY1TSC='WEIB'
1612      IY2TSC='WEIB'
1613C
1614      IF(IFEEDB.EQ.'OFF')GOTO1419
1615      WRITE(ICOUT,999)
1616      CALL DPWRST('XXX','BUG ')
1617      WRITE(ICOUT,1415)
1618 1415 FORMAT('THE YWEIB   SWITCH (FOR BOTH VERT. WEIBULL SCALES)',
1619     1'HAS JUST BEEN TURNED ON')
1620      CALL DPWRST('XXX','BUG ')
1621 1419 CONTINUE
1622      GOTO1900
1623C
1624 1420 CONTINUE
1625      IFOUND='YES'
1626      IY1TSC='LINE'
1627      IY2TSC='LINE'
1628C
1629      IF(IFEEDB.EQ.'OFF')GOTO1429
1630      WRITE(ICOUT,999)
1631      CALL DPWRST('XXX','BUG ')
1632      WRITE(ICOUT,1425)
1633 1425 FORMAT('THE YWEIB   SWITCH (FOR BOTH VERT. WEIBULL SCALES)',
1634     1'HAS JUST BEEN TURNED OFF')
1635      CALL DPWRST('XXX','BUG ')
1636 1429 CONTINUE
1637      GOTO1900
1638C
1639 1499 CONTINUE
1640C
1641C               ********************************************************
1642C               **  TREAT THE CASE WHEN
1643C               **  ONLY THE LEFT   VERTICAL   FRAME LINE IS TO BE WEIBU
1644C               ********************************************************
1645C
1646      IF(ICOM.EQ.'Y1WE')GOTO1500
1647      GOTO1599
1648C
1649 1500 CONTINUE
1650      IF(NUMARG.LE.0)GOTO1510
1651      IF(IHARG(NUMARG).EQ.'ON')GOTO1510
1652      IF(IHARG(NUMARG).EQ.'OFF')GOTO1520
1653      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1510
1654      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1510
1655      IERROR='YES'
1656      GOTO1900
1657C
1658 1510 CONTINUE
1659      IFOUND='YES'
1660      IY1TSC='WEIB'
1661C
1662      IF(IFEEDB.EQ.'OFF')GOTO1519
1663      WRITE(ICOUT,999)
1664      CALL DPWRST('XXX','BUG ')
1665      WRITE(ICOUT,1515)
1666 1515 FORMAT('THE Y1WEIB   SWITCH (FOR THE LEFT VERTICAL ',
1667     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED ON')
1668      CALL DPWRST('XXX','BUG ')
1669 1519 CONTINUE
1670      GOTO1900
1671C
1672 1520 CONTINUE
1673      IFOUND='YES'
1674      IY1TSC='LINE'
1675C
1676      IF(IFEEDB.EQ.'OFF')GOTO1529
1677      WRITE(ICOUT,999)
1678      CALL DPWRST('XXX','BUG ')
1679      WRITE(ICOUT,1525)
1680 1525 FORMAT('THE Y1WEIB   SWITCH (FOR THE LEFT VERTICAL ',
1681     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED OFF')
1682      CALL DPWRST('XXX','BUG ')
1683 1529 CONTINUE
1684      GOTO1900
1685C
1686 1599 CONTINUE
1687C
1688C               ********************************************************
1689C               **  TREAT THE CASE WHEN
1690C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE IS TO BE WEIBU
1691C               ********************************************************
1692C
1693      IF(ICOM.EQ.'Y2WE')GOTO1600
1694      GOTO1699
1695C
1696 1600 CONTINUE
1697      IF(NUMARG.LE.0)GOTO1610
1698      IF(IHARG(NUMARG).EQ.'ON')GOTO1610
1699      IF(IHARG(NUMARG).EQ.'OFF')GOTO1620
1700      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1610
1701      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1610
1702      IERROR='YES'
1703      GOTO1900
1704C
1705 1610 CONTINUE
1706      IFOUND='YES'
1707      IY2TSC='WEIB'
1708C
1709      IF(IFEEDB.EQ.'OFF')GOTO1619
1710      WRITE(ICOUT,999)
1711      CALL DPWRST('XXX','BUG ')
1712      WRITE(ICOUT,1615)
1713 1615 FORMAT('THE Y2WEIB   SWITCH (FOR THE RIGHT VERTICAL ',
1714     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED ON')
1715      CALL DPWRST('XXX','BUG ')
1716 1619 CONTINUE
1717      GOTO1900
1718C
1719 1620 CONTINUE
1720      IFOUND='YES'
1721      IY2TSC='LINE'
1722C
1723      IF(IFEEDB.EQ.'OFF')GOTO1629
1724      WRITE(ICOUT,999)
1725      CALL DPWRST('XXX','BUG ')
1726      WRITE(ICOUT,1625)
1727 1625 FORMAT('THE Y2WEIB   SWITCH (FOR THE RIGHT VERTICAL ',
1728     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED OFF')
1729      CALL DPWRST('XXX','BUG ')
1730 1629 CONTINUE
1731      GOTO1900
1732C
1733 1699 CONTINUE
1734C
1735C               **************************************************
1736C               **  TREAT THE CASE WHEN                         **
1737C               **  THE ENTIRE 4-SIDED FRAME IS TO BE WEIBULL       **
1738C               **************************************************
1739C
1740      IF(ICOM.EQ.'XYWE')GOTO1700
1741      IF(ICOM.EQ.'YXWE')GOTO1700
1742      IF(ICOM.EQ.'WEIB')GOTO1700
1743CCCCC IF(ICOM.EQ.'WEIW'GOTO1700
1744      GOTO1799
1745C
1746 1700 CONTINUE
1747      IF(NUMARG.LE.0)GOTO1710
1748      IF(IHARG(NUMARG).EQ.'ON')GOTO1710
1749      IF(IHARG(NUMARG).EQ.'OFF')GOTO1720
1750      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1710
1751      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1710
1752      IERROR='YES'
1753      GOTO1900
1754C
1755 1710 CONTINUE
1756      IFOUND='YES'
1757      IX1TSC='WEIB'
1758      IX2TSC='WEIB'
1759      IY1TSC='WEIB'
1760      IY2TSC='WEIB'
1761C
1762      IF(IFEEDB.EQ.'OFF')GOTO1719
1763      WRITE(ICOUT,999)
1764      CALL DPWRST('XXX','BUG ')
1765      WRITE(ICOUT,1715)
1766 1715 FORMAT('THE WEIBULL   SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
1767     1'HAS JUST BEEN TURNED ON')
1768      CALL DPWRST('XXX','BUG ')
1769 1719 CONTINUE
1770      GOTO1900
1771C
1772 1720 CONTINUE
1773      IFOUND='YES'
1774      IX1TSC='LINE'
1775      IX2TSC='LINE'
1776      IY1TSC='LINE'
1777      IY2TSC='LINE'
1778C
1779      IF(IFEEDB.EQ.'OFF')GOTO1729
1780      WRITE(ICOUT,999)
1781      CALL DPWRST('XXX','BUG ')
1782      WRITE(ICOUT,1725)
1783 1725 FORMAT('THE WEIBULL   SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
1784     1'HAS JUST BEEN TURNED OFF')
1785      CALL DPWRST('XXX','BUG ')
1786 1729 CONTINUE
1787      GOTO1900
1788C
1789 1799 CONTINUE
1790C
1791 1900 CONTINUE
1792      RETURN
1793      END
1794      SUBROUTINE DPTIS3(ICOM,IHARG,NUMARG,
1795     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
1796     1IFOUND,IERROR)
1797C
1798C     PURPOSE--DEFINE THE 4 TIC SCALES CONTAINED IN THE
1799C              4 VARIABLES IX1TSC,IX2TSC,IY1TSC,IY2TSC  .
1800C              SUCH TIC SCALE SWITCHES DEFINE THE SCALES
1801C              (LINEAR OR WEIBULL OR NORMAL)
1802C              FOR THE TICS ON THE 4 FRAME LINES OF A PLOT.
1803C     FOCUS OF SUBROUTINE DPTISC--LOG
1804C                         DPTIS2--WEIBULL
1805C                         DPTIS3--NORMAL
1806C
1807C     INPUT  ARGUMENTS--ICOM
1808C                     --IHARG  (A  HOLLERITH VECTOR)
1809C                     --NUMARG
1810C     OUTPUT ARGUMENTS--
1811C                     --IX1TSC = LOWER HORIZONTAL TIC SCALE
1812C                     --IX2TSC = UPPER HORIZONTAL TIC SCALE
1813C                     --IY1TSC = LEFT  VERTICAL   TIC SCALE
1814C                     --IY2TSC = RIGHT VERTICAL   TIC SCALE
1815C                     --IFOUND ('YES' OR 'NO' )
1816C                     --IERROR ('YES' OR 'NO' )
1817C     WRITTEN BY--JAMES J. FILLIBEN
1818C                 STATISTICAL ENGINEERING DIVISION
1819C                 INFORMATION TECHNOLOGY LABORATORY
1820C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1821C                 GAITHERSBURG, MD 20899-8980
1822C                 PHONE--301-975-2855
1823C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1824C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1825C     LANGUAGE--ANSI FORTRAN (1977)
1826C     VERSION NUMBER--82/7
1827C     ORIGINAL VERSION--SEPTEMBER 1980.
1828C     UPDATED         --MARCH     1981.
1829C     UPDATED         --MAY       1982.
1830C
1831C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1832C
1833      CHARACTER*4 ICOM
1834      CHARACTER*4 IHARG
1835C
1836      CHARACTER*4 IX1TSC
1837      CHARACTER*4 IX2TSC
1838      CHARACTER*4 IY1TSC
1839      CHARACTER*4 IY2TSC
1840C
1841      CHARACTER*4 IFOUND
1842      CHARACTER*4 IERROR
1843C
1844C---------------------------------------------------------------------
1845C
1846      DIMENSION IHARG(*)
1847C
1848C-----COMMON----------------------------------------------------------
1849C
1850      INCLUDE 'DPCOP2.INC'
1851C
1852C-----START POINT-----------------------------------------------------
1853C
1854      IFOUND='NO'
1855      IERROR='NO'
1856C
1857      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
1858      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORN')GOTO1900
1859C
1860C               ********************************************************
1861C               **  TREAT THE CASE WHEN                               **
1862C               **  BOTH HORIZONTAL FRAME LINES     ARE TO BE NORMAL  **
1863C               ********************************************************
1864C
1865      IF(ICOM.EQ.'XNOR')GOTO1100
1866      GOTO1199
1867C
1868 1100 CONTINUE
1869      IF(NUMARG.LE.0)GOTO1110
1870      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
1871      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
1872      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
1873      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
1874      IERROR='YES'
1875      GOTO1900
1876C
1877 1110 CONTINUE
1878      IFOUND='YES'
1879      IX1TSC='NORM'
1880      IX2TSC='NORM'
1881C
1882      IF(IFEEDB.EQ.'OFF')GOTO1119
1883      WRITE(ICOUT,999)
1884  999 FORMAT(1X)
1885      CALL DPWRST('XXX','BUG ')
1886      WRITE(ICOUT,1115)
1887 1115 FORMAT('THE XNORM SWITCH (FOR BOTH HORIZ. NORMAL  SCALES)',
1888     1'HAS JUST BEEN TURNED ON')
1889      CALL DPWRST('XXX','BUG ')
1890 1119 CONTINUE
1891      GOTO1900
1892C
1893 1120 CONTINUE
1894      IFOUND='YES'
1895      IX1TSC='LINE'
1896      IX2TSC='LINE'
1897C
1898      IF(IFEEDB.EQ.'OFF')GOTO1129
1899      WRITE(ICOUT,999)
1900      CALL DPWRST('XXX','BUG ')
1901      WRITE(ICOUT,1125)
1902 1125 FORMAT('THE XNORM SWITCH (FOR BOTH HORIZ. NORMAL  SCALES)',
1903     1'HAS JUST BEEN TURNED OFF')
1904      CALL DPWRST('XXX','BUG ')
1905 1129 CONTINUE
1906      GOTO1900
1907C
1908 1199 CONTINUE
1909C
1910C               ********************************************************
1911C               **  TREAT THE CASE WHEN
1912C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE IS TO BE NOR
1913C               ********************************************************
1914C
1915      IF(ICOM.EQ.'X1NO')GOTO1200
1916      GOTO1299
1917C
1918 1200 CONTINUE
1919      IF(NUMARG.LE.0)GOTO1210
1920      IF(IHARG(NUMARG).EQ.'ON')GOTO1210
1921      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
1922      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1210
1923      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1210
1924      IERROR='YES'
1925      GOTO1900
1926C
1927 1210 CONTINUE
1928      IFOUND='YES'
1929      IX1TSC='NORM'
1930C
1931      IF(IFEEDB.EQ.'OFF')GOTO1219
1932      WRITE(ICOUT,999)
1933      CALL DPWRST('XXX','BUG ')
1934      WRITE(ICOUT,1215)
1935 1215 FORMAT('THE X1NORMAL SWITCH (FOR THE BOTTOM HORIZONTAL ',
1936     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED ON')
1937      CALL DPWRST('XXX','BUG ')
1938 1219 CONTINUE
1939      GOTO1900
1940C
1941 1220 CONTINUE
1942      IFOUND='YES'
1943      IX1TSC='LINE'
1944C
1945      IF(IFEEDB.EQ.'OFF')GOTO1229
1946      WRITE(ICOUT,999)
1947      CALL DPWRST('XXX','BUG ')
1948      WRITE(ICOUT,1225)
1949 1225 FORMAT('THE X1NORMAL SWITCH (FOR THE BOTTOM HORIZONTAL ',
1950     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED OFF')
1951      CALL DPWRST('XXX','BUG ')
1952 1229 CONTINUE
1953      GOTO1900
1954C
1955 1299 CONTINUE
1956C
1957C               ********************************************************
1958C               **  TREAT THE CASE WHEN
1959C               **  ONLY THE TOP    HORIZONTAL FRAME LINE IS TO BE NORM
1960C               ********************************************************
1961C
1962      IF(ICOM.EQ.'X2NO')GOTO1300
1963      GOTO1399
1964C
1965 1300 CONTINUE
1966      IF(NUMARG.LE.0)GOTO1310
1967      IF(IHARG(NUMARG).EQ.'ON')GOTO1310
1968      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
1969      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1310
1970      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1310
1971      IERROR='YES'
1972      GOTO1900
1973C
1974 1310 CONTINUE
1975      IFOUND='YES'
1976      IX2TSC='NORM'
1977C
1978      IF(IFEEDB.EQ.'OFF')GOTO1319
1979      WRITE(ICOUT,999)
1980      CALL DPWRST('XXX','BUG ')
1981      WRITE(ICOUT,1315)
1982 1315 FORMAT('THE X2NORMAL SWITCH (FOR THE TOP HORIZONTAL ',
1983     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED ON')
1984      CALL DPWRST('XXX','BUG ')
1985 1319 CONTINUE
1986      GOTO1900
1987C
1988 1320 CONTINUE
1989      IFOUND='YES'
1990      IX2TSC='LINE'
1991C
1992      IF(IFEEDB.EQ.'OFF')GOTO1329
1993      WRITE(ICOUT,999)
1994      CALL DPWRST('XXX','BUG ')
1995      WRITE(ICOUT,1325)
1996 1325 FORMAT('THE X2NORMAL SWITCH (FOR THE TOP HORIZONTAL ',
1997     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED OFF')
1998      CALL DPWRST('XXX','BUG ')
1999 1329 CONTINUE
2000      GOTO1900
2001C
2002 1399 CONTINUE
2003C
2004C               ******************************************************
2005C               **  TREAT THE CASE WHEN                             **
2006C               **  BOTH VERTICAL FRAME LINES     ARE TO BE NORMAL  **
2007C               ******************************************************
2008C
2009      IF(ICOM.EQ.'YNOR')GOTO1400
2010      GOTO1499
2011C
2012 1400 CONTINUE
2013      IF(NUMARG.LE.0)GOTO1410
2014      IF(IHARG(NUMARG).EQ.'ON')GOTO1410
2015      IF(IHARG(NUMARG).EQ.'OFF')GOTO1420
2016      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1410
2017      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1410
2018      IERROR='YES'
2019      GOTO1900
2020C
2021 1410 CONTINUE
2022      IFOUND='YES'
2023      IY1TSC='NORM'
2024      IY2TSC='NORM'
2025C
2026      IF(IFEEDB.EQ.'OFF')GOTO1419
2027      WRITE(ICOUT,999)
2028      CALL DPWRST('XXX','BUG ')
2029      WRITE(ICOUT,1415)
2030 1415 FORMAT('THE YNORM   SWITCH (FOR BOTH VERT. NORMAL  SCALES)',
2031     1'HAS JUST BEEN TURNED ON')
2032      CALL DPWRST('XXX','BUG ')
2033 1419 CONTINUE
2034      GOTO1900
2035C
2036 1420 CONTINUE
2037      IFOUND='YES'
2038      IY1TSC='LINE'
2039      IY2TSC='LINE'
2040C
2041      IF(IFEEDB.EQ.'OFF')GOTO1429
2042      WRITE(ICOUT,999)
2043      CALL DPWRST('XXX','BUG ')
2044      WRITE(ICOUT,1425)
2045 1425 FORMAT('THE YNORM   SWITCH (FOR BOTH VERT. NORMAL  SCALES)',
2046     1'HAS JUST BEEN TURNED OFF')
2047      CALL DPWRST('XXX','BUG ')
2048 1429 CONTINUE
2049      GOTO1900
2050C
2051 1499 CONTINUE
2052C
2053C               ********************************************************
2054C               **  TREAT THE CASE WHEN
2055C               **  ONLY THE LEFT   VERTICAL   FRAME LINE IS TO BE NORM
2056C               ********************************************************
2057C
2058      IF(ICOM.EQ.'Y1NO')GOTO1500
2059      GOTO1599
2060C
2061 1500 CONTINUE
2062      IF(NUMARG.LE.0)GOTO1510
2063      IF(IHARG(NUMARG).EQ.'ON')GOTO1510
2064      IF(IHARG(NUMARG).EQ.'OFF')GOTO1520
2065      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1510
2066      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1510
2067      IERROR='YES'
2068      GOTO1900
2069C
2070 1510 CONTINUE
2071      IFOUND='YES'
2072      IY1TSC='NORM'
2073C
2074      IF(IFEEDB.EQ.'OFF')GOTO1519
2075      WRITE(ICOUT,999)
2076      CALL DPWRST('XXX','BUG ')
2077      WRITE(ICOUT,1515)
2078 1515 FORMAT('THE Y1NORMAL SWITCH (FOR THE LEFT VERTICAL ',
2079     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED ON')
2080      CALL DPWRST('XXX','BUG ')
2081 1519 CONTINUE
2082      GOTO1900
2083C
2084 1520 CONTINUE
2085      IFOUND='YES'
2086      IY1TSC='LINE'
2087C
2088      IF(IFEEDB.EQ.'OFF')GOTO1529
2089      WRITE(ICOUT,999)
2090      CALL DPWRST('XXX','BUG ')
2091      WRITE(ICOUT,1525)
2092 1525 FORMAT('THE Y1NORMAL SWITCH (FOR THE LEFT VERTICAL ',
2093     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED OFF')
2094      CALL DPWRST('XXX','BUG ')
2095 1529 CONTINUE
2096      GOTO1900
2097C
2098 1599 CONTINUE
2099C
2100C               ********************************************************
2101C               **  TREAT THE CASE WHEN
2102C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE IS TO BE NORM
2103C               ********************************************************
2104C
2105      IF(ICOM.EQ.'Y2NO')GOTO1600
2106      GOTO1699
2107C
2108 1600 CONTINUE
2109      IF(NUMARG.LE.0)GOTO1610
2110      IF(IHARG(NUMARG).EQ.'ON')GOTO1610
2111      IF(IHARG(NUMARG).EQ.'OFF')GOTO1620
2112      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1610
2113      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1610
2114      IERROR='YES'
2115      GOTO1900
2116C
2117 1610 CONTINUE
2118      IFOUND='YES'
2119      IY2TSC='NORM'
2120C
2121      IF(IFEEDB.EQ.'OFF')GOTO1619
2122      WRITE(ICOUT,999)
2123      CALL DPWRST('XXX','BUG ')
2124      WRITE(ICOUT,1615)
2125 1615 FORMAT('THE Y2NORMAL SWITCH (FOR THE RIGHT VERTICAL ',
2126     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED ON')
2127      CALL DPWRST('XXX','BUG ')
2128 1619 CONTINUE
2129      GOTO1900
2130C
2131 1620 CONTINUE
2132      IFOUND='YES'
2133      IY2TSC='LINE'
2134C
2135      IF(IFEEDB.EQ.'OFF')GOTO1629
2136      WRITE(ICOUT,999)
2137      CALL DPWRST('XXX','BUG ')
2138      WRITE(ICOUT,1625)
2139 1625 FORMAT('THE Y2NORMAL SWITCH (FOR THE RIGHT VERTICAL ',
2140     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED OFF')
2141      CALL DPWRST('XXX','BUG ')
2142 1629 CONTINUE
2143      GOTO1900
2144C
2145 1699 CONTINUE
2146C
2147C               **************************************************
2148C               **  TREAT THE CASE WHEN                         **
2149C               **  THE ENTIRE 4-SIDED FRAME IS TO BE NORMAL        **
2150C               **************************************************
2151C
2152      IF(ICOM.EQ.'XYNO')GOTO1700
2153      IF(ICOM.EQ.'YXNO')GOTO1700
2154CCCCC IF(ICOM.EQ.'NORM')GOTO1700
2155      GOTO1799
2156C
2157 1700 CONTINUE
2158      IF(NUMARG.LE.0)GOTO1710
2159      IF(IHARG(NUMARG).EQ.'ON')GOTO1710
2160      IF(IHARG(NUMARG).EQ.'OFF')GOTO1720
2161      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1710
2162      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1710
2163      IERROR='YES'
2164      GOTO1900
2165C
2166 1710 CONTINUE
2167      IFOUND='YES'
2168      IX1TSC='NORM'
2169      IX2TSC='NORM'
2170      IY1TSC='NORM'
2171      IY2TSC='NORM'
2172C
2173      IF(IFEEDB.EQ.'OFF')GOTO1719
2174      WRITE(ICOUT,999)
2175      CALL DPWRST('XXX','BUG ')
2176      WRITE(ICOUT,1715)
2177 1715 FORMAT('THE NORMAL    SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
2178     1'HAS JUST BEEN TURNED ON')
2179      CALL DPWRST('XXX','BUG ')
2180 1719 CONTINUE
2181      GOTO1900
2182C
2183 1720 CONTINUE
2184      IFOUND='YES'
2185      IX1TSC='LINE'
2186      IX2TSC='LINE'
2187      IY1TSC='LINE'
2188      IY2TSC='LINE'
2189C
2190      IF(IFEEDB.EQ.'OFF')GOTO1729
2191      WRITE(ICOUT,999)
2192      CALL DPWRST('XXX','BUG ')
2193      WRITE(ICOUT,1725)
2194 1725 FORMAT('THE NORMAL    SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
2195     1'HAS JUST BEEN TURNED OFF')
2196      CALL DPWRST('XXX','BUG ')
2197 1729 CONTINUE
2198      GOTO1900
2199C
2200 1799 CONTINUE
2201C
2202 1900 CONTINUE
2203      RETURN
2204      END
2205      SUBROUTINE DPTISZ(IHARG,IARGT,ARG,NUMARG,
2206     1PDEFHE,PDEFWI,
2207     1PTITHE,PTITWI,PTITVG,PTITHG,
2208     1IFOUND,IERROR)
2209C
2210C     PURPOSE--DEFINE THE SIZE FOR THE TITLE
2211C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
2212C              THE SIZE FOR THE TITLE WILL BE PLACED
2213C              IN THE FLOATING POINT VARIABLE PTITHE.
2214C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
2215C                     --NUMARG
2216C                     --PDEFHE
2217C                     --PDEFWI
2218C     OUTPUT ARGUMENTS--PTITHE = TITLE HEIGHT
2219C                     --PTITWI = TITLE WIDTH
2220C                     --PTITVG = TITLE VERTICAL GAP
2221C                     --PTITHG = TITLE HORIZONTAL GAP
2222C                     --IFOUND ('YES' OR 'NO' )
2223C                     --IERROR ('YES' OR 'NO' )
2224C     WRITTEN BY--JAMES J. FILLIBEN
2225C                 STATISTICAL ENGINEERING DIVISION
2226C                 INFORMATION TECHNOLOGY LABORATORY
2227C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2228C                 GAITHERSBURG, MD 20899-8980
2229C                 PHONE--301-975-2855
2230C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2231C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2232C     LANGUAGE--ANSI FORTRAN (1977)
2233C     VERSION NUMBER--82/7
2234C     ORIGINAL VERSION--SEPTEMBER 1980.
2235C     UPDATED         --MAY       1982.
2236C     UPDATED         --DECEMBER  1988.  DEFAULT WIDTH
2237C
2238C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2239C
2240      CHARACTER*4 IHARG
2241      CHARACTER*4 IARGT
2242      CHARACTER*4 IFOUND
2243      CHARACTER*4 IERROR
2244C
2245C---------------------------------------------------------------------
2246C
2247      DIMENSION IHARG(*)
2248      DIMENSION IARGT(*)
2249      DIMENSION ARG(*)
2250C
2251C-----COMMON----------------------------------------------------------
2252C
2253      INCLUDE 'DPCOP2.INC'
2254C
2255C-----START POINT-----------------------------------------------------
2256C
2257      IFOUND='NO'
2258      IERROR='NO'
2259C
2260      IF(NUMARG.LE.0)GOTO1199
2261      IF(IHARG(1).NE.'SIZE')GOTO1199
2262      IF(NUMARG.EQ.1)GOTO1150
2263      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
2264      GOTO1110
2265C
2266 1110 CONTINUE
2267      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
2268      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
2269      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
2270      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
2271C
2272      IERROR='YES'
2273      WRITE(ICOUT,1121)
2274 1121 FORMAT('***** ERROR IN DPTISZ--')
2275      CALL DPWRST('XXX','BUG ')
2276      WRITE(ICOUT,1122)
2277 1122 FORMAT('      ILLEGAL FORM FOR TITLE SIZE ',
2278     1'COMMAND.')
2279      CALL DPWRST('XXX','BUG ')
2280      WRITE(ICOUT,1124)
2281 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
2282     1'PROPER FORM--')
2283      CALL DPWRST('XXX','BUG ')
2284      WRITE(ICOUT,1125)
2285 1125 FORMAT('      SUPPOSE IT IS DESIRED TO HAVE ')
2286      CALL DPWRST('XXX','BUG ')
2287      WRITE(ICOUT,1126)
2288 1126 FORMAT('      THE TITLE ONE AND ONE HALF TIMES AS BIG ')
2289      CALL DPWRST('XXX','BUG ')
2290      WRITE(ICOUT,1127)
2291 1127 FORMAT('      AS THE DEFAULT SIZE (WHICH IS SIZE 1), ')
2292      CALL DPWRST('XXX','BUG ')
2293      WRITE(ICOUT,1128)
2294 1128 FORMAT('      THEN THE ALLOWABLE FORM IS--')
2295      CALL DPWRST('XXX','BUG ')
2296      WRITE(ICOUT,1131)
2297 1131 FORMAT('      TITLE SIZE 1.5 ')
2298      CALL DPWRST('XXX','BUG ')
2299      GOTO9000
2300C
2301 1150 CONTINUE
2302      PTITHE=PDEFHE
2303      PTITWI=PDEFWI
2304      GOTO1180
2305C
2306 1160 CONTINUE
2307      PTITHE=ARG(NUMARG)
2308      PTITWI=PTITHE*0.5
2309      PTITVG=PTITHE*0.375
2310      PTITHG=PTITHE*0.125
2311      GOTO1180
2312C
2313 1180 CONTINUE
2314      IFOUND='YES'
2315C
2316      IF(IFEEDB.EQ.'OFF')GOTO1189
2317      WRITE(ICOUT,999)
2318  999 FORMAT(1X)
2319      CALL DPWRST('XXX','BUG ')
2320      WRITE(ICOUT,1181)PTITHE
2321 1181 FORMAT('THE TITLE SIZE HAS JUST BEEN SET TO ',
2322     1E15.7)
2323      CALL DPWRST('XXX','BUG ')
2324 1189 CONTINUE
2325      GOTO1199
2326C
2327 1199 CONTINUE
2328      GOTO9000
2329C
2330 9000 CONTINUE
2331      RETURN
2332      END
2333      SUBROUTINE DPTIT(IANS,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
2334CCCCC SUBROUTINE DPTIT(IANS,IWIDTH,IHARG,IHARG2,NUMARG,
2335CCCCC THE ABOVE LINE WAS CHANGED        SEPTEMBER 1993
2336CCCCC SO AS TO ALLOW FOR LOWER CASE     SEPTEMBER 1993
2337CCCCC SUBROUTINE DPTIT(IANS,IWIDTH,IHARG,NUMARG,
2338CCCCC THE ABOVE LINE WAS AUGMENTED AUGUST 1992
2339CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1992
2340CCCCC1ITITTE,NCTITL,IBUGP2,IFOUND,IERROR)
2341     1ITITTE,NCTITL,ITIAUT,IBUGP2,IFOUND,IERROR)
2342C
2343C     PURPOSE--EXTRACT THE STRING TO BE USED AS A TITLE;
2344C              SAVE THIS STRING FOR USE ON PRINTER PLOTS;
2345C              ALSO, CONVERT THIS STRING INTO PROPER FORM
2346C              (ASCII INTEGER REPRESENTATION) FOR USE
2347C              WITH TEKTRONIX (OR EQUIVALENT) SOFTWARE.
2348C     INPUT  ARGUMENTS--IANS   (A  CHARACTER VECTOR)
2349C                     --IWIDTH
2350C                     --IHARG  (A  CHARACTER VECTOR)
2351C                     --IHARG2  (A  CHARACTER VECTOR)
2352C                     --NUMARG
2353C     OUTPUT ARGUMENTS--ITITTE (A CHARACTER VECTOR
2354C                              CONTAINING THE STRING FOR THE TITLE).
2355C                     --NCTITL  (AN INTEGER VARIABLE
2356C                              CONTAINING THE
2357C                              NUMBER OF CHARACTERS IN THE TITLE).
2358C                     --IFOUND ('YES' OR 'NO' )
2359C                     --IERROR ('YES' OR 'NO' )
2360C     WRITTEN BY--JAMES J. FILLIBEN
2361C                 STATISTICAL ENGINEERING DIVISION
2362C                 INFORMATION TECHNOLOGY LABORATORY
2363C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2364C                 GAITHERSBURG, MD 20899-8980
2365C                 PHONE--301-975-2855
2366C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2367C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2368C     LANGUAGE--ANSI FORTRAN (1977)
2369C     VERSION NUMBER--82/7
2370C     ORIGINAL VERSION--JANUARY    1978.
2371C     UPDATED         --JUNE       1978.
2372C     UPDATED         --JUNE       1979.
2373C     UPDATED         --SEPTEMBER  1980.
2374C     UPDATED         --MARCH      1981.
2375C     UPDATED         --DECEMBER   1981.
2376C     UPDATED         --MAY        1982.
2377C     UPDATED         --AUGUST     1992. ADD TITLE SWITCH
2378C                                        FOR AUTOMATIC
2379C     UPDATED         --SEPTEMBER  1993. ALLOW LOWER CASE
2380C
2381C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2382C
2383      CHARACTER*4 IANS
2384CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
2385CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
2386      CHARACTER*4 IANSLC
2387      CHARACTER*4 IHARG
2388CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
2389      CHARACTER*4 IHARG2
2390C
2391      CHARACTER*4 ITITTE
2392C
2393CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
2394      CHARACTER*4 ITIAUT
2395C
2396      CHARACTER*4 IBUGP2
2397      CHARACTER*4 IFOUND
2398      CHARACTER*4 IERROR
2399C
2400C---------------------------------------------------------------------
2401C
2402      DIMENSION IANS(*)
2403CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
2404CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
2405      DIMENSION IANSLC(*)
2406      DIMENSION IHARG(*)
2407CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
2408      DIMENSION IHARG2(*)
2409C
2410      DIMENSION ITITTE(*)
2411C
2412C-----COMMON----------------------------------------------------------
2413C
2414      INCLUDE 'DPCOP2.INC'
2415C
2416C-----START POINT-----------------------------------------------------
2417C
2418      IFOUND='NO'
2419      IERROR='NO'
2420C
2421      IF(IBUGP2.NE.'ON')GOTO90
2422      WRITE(ICOUT,999)
2423  999 FORMAT(1X)
2424      CALL DPWRST('XXX','BUG ')
2425      WRITE(ICOUT,51)
2426   51 FORMAT('AT THE BEGINNING OF DPTIT--')
2427      CALL DPWRST('XXX','BUG ')
2428      WRITE(ICOUT,53)NCTITL
2429   53 FORMAT('NCTITL = ',I5)
2430      CALL DPWRST('XXX','BUG ')
2431      WRITE(ICOUT,999)
2432      CALL DPWRST('XXX','BUG ')
2433      ILENT=NCTITL
2434      WRITE(ICOUT,41)(ITITTE(I),I=1,ILENT)
2435   41 FORMAT('CHARACTER ITITTE(.) --',100A1)
2436      CALL DPWRST('XXX','BUG ')
2437      WRITE(ICOUT,999)
2438      CALL DPWRST('XXX','BUG ')
2439      WRITE(ICOUT,999)
2440      CALL DPWRST('XXX','BUG ')
2441   90 CONTINUE
2442C
2443C     *****************************************
2444C     **  STEP 1--                           **
2445C     **  DETERMINE THE COMMAND              **
2446C     **  (TITLE) AND ITS LOCATION           **
2447C     **  ON THE LINE.                       **
2448C     *****************************************
2449C
2450      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COLO')GOTO9000
2451      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'COLO')GOTO9000
2452      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'SIZE')GOTO9000
2453      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'SIZE')GOTO9000
2454C
2455      DO1000I=1,IWIDTH
2456      I2=I
2457      IP1=I+1
2458      IP2=I+2
2459      IP3=I+3
2460      IP4=I+4
2461      IP5=I+5
2462      IP6=I+6
2463      IF(IANS(I).EQ.'T'.AND.IANS(IP1).EQ.'I'
2464     1.AND.IANS(IP2).EQ.'T'.AND.IANS(IP3).EQ.'L'
2465     1.AND.IANS(IP4).EQ.'E')
2466     1GOTO100
2467C
2468 1000 CONTINUE
2469      WRITE(ICOUT,1001)
2470 1001 FORMAT('***** ERROR IN DPTIT--')
2471      CALL DPWRST('XXX','BUG ')
2472      WRITE(ICOUT,1002)
2473 1002 FORMAT('      NO MATCH FOR COMMAND.')
2474      CALL DPWRST('XXX','BUG ')
2475      IERROR='YES'
2476      GOTO800
2477C
2478C     **********************************************************
2479C     **  STEP 2--                                            **
2480C     **  DEFINE THE START POSITION (ISTART) FOR THE STRING.  **
2481C     **********************************************************
2482C
2483  100 CONTINUE
2484      ISTART=I2+6
2485      GOTO300
2486C
2487C     ********************************************************
2488C     **  STEP 3--                                          **
2489C     **  DEFINE THE STOP POSITION (ISTOP) FOR THE STRING.  **
2490C     ********************************************************
2491C
2492  300 CONTINUE
2493      IFOUND='YES'
2494      ISTOP=0
2495      IF(ISTART.GT.IWIDTH)GOTO329
2496      DO320I=ISTART,IWIDTH
2497      IREV=IWIDTH-I+ISTART
2498      IF(IANS(IREV).NE.' ')GOTO325
2499  320 CONTINUE
2500      GOTO329
2501  325 CONTINUE
2502      ISTOP=IREV
2503  329 CONTINUE
2504C
2505C     *****************************************
2506C     **  STEP 4--                           **
2507C     **  COPY OVER THE STRING OF INTEREST.  **
2508C     *****************************************
2509C
2510      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ON')GOTO359
2511      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'OFF')GOTO359
2512CCCCC IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO')GOTO359
2513      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DEFA')GOTO359
2514      IF(NUMARG.EQ.0)GOTO359
2515C
2516      IF(ISTART.GT.ISTOP)GOTO359
2517      IF(ISTOP.EQ.0)GOTO359
2518      J=0
2519      DO350I=ISTART,ISTOP
2520      J=J+1
2521CCCCC THE FOLLOWING LINE WAS   CHANGED   SEPTEMBER 1993
2522CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
2523CCCCC ITITTE(J)=IANS(I)
2524      ITITTE(J)=IANSLC(I)
2525  350 CONTINUE
2526      NCTITL=J
2527      GOTO800
2528  359 CONTINUE
2529C
2530C     ************************************
2531C     **  STEP 5--                      **
2532C     **  TREAT THE EMPTY-STRING CASE.  **
2533C     ************************************
2534C
2535      NCTITL=0
2536      GOTO800
2537C
2538C     ***************************
2539C     **  STEP 6--             **
2540C     **  PRINT OUT A MESSAGE  **
2541C     ***************************
2542C
2543  800 CONTINUE
2544      ILENT=NCTITL
2545C
2546CCCCC THE FOLLOWING 6 LINES WERE ADDED AUGUST 1992
2547      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
2548     1IHARG2(1).EQ.'MATI')THEN
2549         ITIAUT='ON'
2550      ELSE
2551         ITIAUT='OFF'
2552      ENDIF
2553      IF(IFEEDB.EQ.'OFF')GOTO889
2554      WRITE(ICOUT,999)
2555      CALL DPWRST('XXX','BUG ')
2556      WRITE(ICOUT,811)
2557  811 FORMAT('THE TITLE HAS JUST BEEN SET TO')
2558      CALL DPWRST('XXX','BUG ')
2559      IF(ILENT.EQ.0)THEN
2560        WRITE(ICOUT,999)
2561        CALL DPWRST('XXX','BUG ')
2562      ELSEIF(ILENT.GE.1)THEN
2563        WRITE(ICOUT,812)(ITITTE(I),I=1,MIN(ILENT,120))
2564  812   FORMAT(10X,120A1)
2565        CALL DPWRST('XXX','BUG ')
2566      ENDIF
2567  889 CONTINUE
2568      GOTO9000
2569C
2570C     ****************
2571C     **  STEP 90-- **
2572C     **  EXIT      **
2573C     ****************
2574C
2575 9000 CONTINUE
2576      IF(IBUGP2.NE.'ON')GOTO9090
2577      WRITE(ICOUT,999)
2578      CALL DPWRST('XXX','BUG ')
2579      WRITE(ICOUT,9011)
2580 9011 FORMAT('AT THE END       OF DPTIT--')
2581      CALL DPWRST('XXX','BUG ')
2582      WRITE(ICOUT,9012)NCTITL
2583 9012 FORMAT('NCTITL = ',I5)
2584      CALL DPWRST('XXX','BUG ')
2585      WRITE(ICOUT,999)
2586      CALL DPWRST('XXX','BUG ')
2587      ILENT=NCTITL
2588      WRITE(ICOUT,9021)(ITITTE(I),I=1,ILENT)
2589 9021 FORMAT('CHARACTER ITITTE(.) --',100A1)
2590      CALL DPWRST('XXX','BUG ')
2591      WRITE(ICOUT,999)
2592      CALL DPWRST('XXX','BUG ')
2593 9090 CONTINUE
2594C
2595      RETURN
2596      END
2597      SUBROUTINE DPTIDS(IHARG,ARG,NUMARG,PDEFDS,PTITDS,IFOUND,IERROR)
2598C
2599C     PURPOSE--DEFINE THE DISPLACEMENT FOR THE TITLE
2600C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
2601C              THE DISPLACEMENT FOR THE TITLE WILL BE PLACED
2602C              IN THE REAL VARIABLE PTITDS.
2603C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
2604C                     --ARG    (A  REAL VECTOR)
2605C                     --NUMARG
2606C                     --PDEFDS
2607C     OUTPUT ARGUMENTS--PTITDS
2608C                     --IFOUND ('YES' OR 'NO' )
2609C                     --IERROR ('YES' OR 'NO' )
2610C     WRITTEN BY--JAMES J. FILLIBEN
2611C                 STATISTICAL ENGINEERING DIVISION
2612C                 INFORMATION TECHNOLOGY LABORATORY
2613C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2614C                 GAITHERSBURG, MD 20899-8980
2615C                 PHONE--301-975-2855
2616C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2617C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2618C     LANGUAGE--ANSI FORTRAN (1977)
2619C     VERSION NUMBER--89/8
2620C     ORIGINAL VERSION--JULY      1989.
2621C
2622C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2623C
2624      CHARACTER*4 IHARG
2625      CHARACTER*4 IFOUND
2626      CHARACTER*4 IERROR
2627C
2628C---------------------------------------------------------------------
2629C
2630      DIMENSION IHARG(*)
2631      DIMENSION ARG(*)
2632C
2633C-----COMMON----------------------------------------------------------
2634C
2635      INCLUDE 'DPCOP2.INC'
2636C
2637C-----START POINT-----------------------------------------------------
2638C
2639      IFOUND='NO'
2640      IERROR='NO'
2641C
2642      IF(NUMARG.LE.0)GOTO1199
2643      IF(IHARG(1).EQ.'DISP')GOTO1110
2644      IF(IHARG(1).EQ.'OFFS')GOTO1110
2645      IF(IHARG(1).EQ.'GAP')GOTO1110
2646      GOTO1199
2647C
2648 1110 CONTINUE
2649      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
2650      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
2651      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
2652      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
2653      IF(NUMARG.EQ.1)GOTO1150
2654      GOTO1160
2655C
2656 1150 CONTINUE
2657      PTITDS=PDEFDS
2658      GOTO1180
2659C
2660 1160 CONTINUE
2661      PTITDS=ARG(NUMARG)
2662      GOTO1180
2663C
2664 1180 CONTINUE
2665      IFOUND='YES'
2666C
2667      IF(IFEEDB.EQ.'OFF')GOTO1189
2668      WRITE(ICOUT,999)
2669  999 FORMAT(1X)
2670      CALL DPWRST('XXX','BUG ')
2671      WRITE(ICOUT,1181)PTITDS
2672 1181 FORMAT('THE TITLE DISPLACEMENT HAS JUST BEEN ',
2673     1'SET TO ',E15.7)
2674      CALL DPWRST('XXX','BUG ')
2675 1189 CONTINUE
2676      GOTO1199
2677C
2678 1199 CONTINUE
2679      RETURN
2680      END
2681      SUBROUTINE DPTITH(IHARG,ARG,NUMARG,PDEFTH,PTITTH,IFOUND,IERROR)
2682C
2683C     PURPOSE--DEFINE THE THICKNESS FOR THE TITLE
2684C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
2685C              THE THICKNESS FOR THE TITLE WILL BE PLACED
2686C              IN THE REAL VARIABLE PTITTH.
2687C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
2688C                     --ARG    (A  REAL VECTOR)
2689C                     --NUMARG
2690C                     --PDEFTH
2691C     OUTPUT ARGUMENTS--PTITTH
2692C                     --IFOUND ('YES' OR 'NO' )
2693C                     --IERROR ('YES' OR 'NO' )
2694C     WRITTEN BY--ALAN HECKERT
2695C                 COMPUTER SERVICES DIVISION
2696C                 INFORMATION TECHNOLOGY LABORATORY
2697C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2698C                 GAITHERSBURG, MD 20899-8980
2699C                 PHONE--301-975-2899
2700C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2701C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2702C     LANGUAGE--ANSI FORTRAN (1977)
2703C     VERSION NUMBER--89/2
2704C     ORIGINAL VERSION--JANUARY   1989.
2705C
2706C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2707C
2708      CHARACTER*4 IHARG
2709      CHARACTER*4 IFOUND
2710      CHARACTER*4 IERROR
2711C
2712C---------------------------------------------------------------------
2713C
2714      DIMENSION IHARG(*)
2715      DIMENSION ARG(*)
2716C
2717C-----COMMON----------------------------------------------------------
2718C
2719      INCLUDE 'DPCOP2.INC'
2720C
2721C-----START POINT-----------------------------------------------------
2722C
2723      IFOUND='NO'
2724      IERROR='NO'
2725C
2726      IF(NUMARG.LE.0)GOTO1199
2727      IF(IHARG(1).EQ.'THIC')GOTO1110
2728      GOTO1199
2729C
2730 1110 CONTINUE
2731      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
2732      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
2733      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
2734      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
2735      IF(NUMARG.EQ.1)GOTO1150
2736      GOTO1160
2737C
2738 1150 CONTINUE
2739      PTITTH=PDEFTH
2740      GOTO1180
2741C
2742 1160 CONTINUE
2743      PTITTH=ARG(NUMARG)
2744      GOTO1180
2745C
2746 1180 CONTINUE
2747      IFOUND='YES'
2748C
2749      IF(IFEEDB.EQ.'OFF')GOTO1189
2750      WRITE(ICOUT,999)
2751  999 FORMAT(1X)
2752      CALL DPWRST('XXX','BUG ')
2753      WRITE(ICOUT,1181)PTITTH
2754 1181 FORMAT('THE TITLE THICKNESS HAS JUST BEEN SET TO ',
2755     1E15.7)
2756      CALL DPWRST('XXX','BUG ')
2757 1189 CONTINUE
2758      GOTO1199
2759C
2760 1199 CONTINUE
2761      RETURN
2762      END
2763      SUBROUTINE DPTL(ICOM,IHARG,NUMARG,
2764     1IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW,
2765     1IFOUND,IERROR)
2766C
2767C     PURPOSE--DEFINE THE 4 TIC LABEL SWITCHES CONTAINED IN THE
2768C              4 VARIABLES IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW
2769C              SUCH TIC LABEL SWITCHES TURN ON OR OFF
2770C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
2771C     INPUT  ARGUMENTS--ICOM
2772C                     --IHARG  (A  HOLLERITH VECTOR)
2773C                     --NUMARG
2774C     OUTPUT ARGUMENTS--
2775C                     --IX1ZSW = LOWER HORIZONTAL TIC LABELS
2776C                     --IX2ZSW = UPPER HORIZONTAL TIC LABELS
2777C                     --IY1ZSW = LEFT  VERTICAL   TIC LABELS
2778C                     --IY2ZSW = RIGHT VERTICAL   TIC LABELS
2779C                     --IFOUND ('YES' OR 'NO' )
2780C                     --IERROR ('YES' OR 'NO' )
2781C     WRITTEN BY--JAMES J. FILLIBEN
2782C                 STATISTICAL ENGINEERING DIVISION
2783C                 INFORMATION TECHNOLOGY LABORATORY
2784C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2785C                 GAITHERSBURG, MD 20899-8980
2786C                 PHONE--301-975-2855
2787C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2788C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2789C     LANGUAGE--ANSI FORTRAN (1977)
2790C     VERSION NUMBER--82/7
2791C     ORIGINAL VERSION--SEPTEMBER 1980.
2792C     UPDATED         --MARCH     1981.
2793C     UPDATED         --MAY       1982.
2794C
2795C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2796C
2797      CHARACTER*4 ICOM
2798      CHARACTER*4 IHARG
2799C
2800      CHARACTER*4 IX1ZSW
2801      CHARACTER*4 IX2ZSW
2802      CHARACTER*4 IY1ZSW
2803      CHARACTER*4 IY2ZSW
2804C
2805      CHARACTER*4 IFOUND
2806      CHARACTER*4 IERROR
2807C
2808      CHARACTER*4 IHOLD
2809C
2810C---------------------------------------------------------------------
2811C
2812      DIMENSION IHARG(*)
2813C
2814C-----COMMON----------------------------------------------------------
2815C
2816      INCLUDE 'DPCOP2.INC'
2817C
2818C-----START POINT-----------------------------------------------------
2819C
2820      IFOUND='NO'
2821      IERROR='NO'
2822C
2823      IF(NUMARG.LE.0)GOTO1900
2824C
2825      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1900
2826C
2827      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
2828     1IHARG(2).EQ.'NUMB')GOTO1900
2829C  FOLLOWING 4 LINES ADDED MAY, 1990.
2830      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFFS')GOTO1900
2831C
2832      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
2833     1IHARG(2).EQ.'OFFS')GOTO1900
2834C
2835      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
2836     1IHARG(2).EQ.'COLO')GOTO1900
2837      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
2838     1IHARG(2).EQ.'SIZE')GOTO1900
2839      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
2840     1IHARG(2).EQ.'HW')GOTO1900
2841      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
2842     1IHARG(2).EQ.'FORM')GOTO1900
2843      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
2844     1IHARG(2).EQ.'CONT')GOTO1900
2845      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
2846     1IHARG(2).EQ.'NUMB')GOTO1900
2847C
2848      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
2849     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'COLO')GOTO1900
2850      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
2851     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'SIZE')GOTO1900
2852      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
2853     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'HW')GOTO1900
2854      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
2855     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'FORM')GOTO1900
2856      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
2857     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'CONT')GOTO1900
2858      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
2859     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'NUMB')GOTO1900
2860C
2861C               *****************************************************
2862C               **  TREAT THE CASE WHEN                            **
2863C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
2864C               *****************************************************
2865C
2866      IF(ICOM.EQ.'XTIC')GOTO1100
2867      GOTO1199
2868C
2869 1100 CONTINUE
2870      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
2871      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
2872      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
2873      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
2874      IF(IHARG(NUMARG).EQ.'LABE')GOTO1160
2875      GOTO1150
2876C
2877 1150 CONTINUE
2878      IHOLD='ON'
2879      GOTO1180
2880C
2881 1160 CONTINUE
2882      IHOLD='OFF'
2883      GOTO1180
2884C
2885 1180 CONTINUE
2886      IFOUND='YES'
2887      IX1ZSW=IHOLD
2888      IX2ZSW=IHOLD
2889C
2890      IF(IFEEDB.EQ.'OFF')GOTO1189
2891      WRITE(ICOUT,999)
2892  999 FORMAT(1X)
2893      CALL DPWRST('XXX','BUG ')
2894      WRITE(ICOUT,1181)
2895 1181 FORMAT('THE TIC MARK LABEL (FOR BOTH HORIZONTAL ',
2896     1'FRAME LINES)')
2897      CALL DPWRST('XXX','BUG ')
2898      WRITE(ICOUT,1182)IHOLD
2899 1182 FORMAT('HAS JUST BEEN TURNED ',A4)
2900      CALL DPWRST('XXX','BUG ')
2901 1189 CONTINUE
2902      GOTO1900
2903C
2904 1199 CONTINUE
2905C
2906C               **************************************************************
2907C               **  TREAT THE CASE WHEN                                     **
2908C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
2909C               **************************************************************
2910C
2911      IF(ICOM.EQ.'X1TI')GOTO1200
2912      GOTO1299
2913C
2914 1200 CONTINUE
2915      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
2916      IF(IHARG(NUMARG).EQ.'OFF')GOTO1260
2917      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
2918      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
2919      IF(IHARG(NUMARG).EQ.'LABE')GOTO1260
2920      GOTO1250
2921C
2922 1250 CONTINUE
2923      IHOLD='ON'
2924      GOTO1280
2925C
2926 1260 CONTINUE
2927      IHOLD='OFF'
2928      GOTO1280
2929C
2930 1280 CONTINUE
2931      IFOUND='YES'
2932      IX1ZSW=IHOLD
2933C
2934      IF(IFEEDB.EQ.'OFF')GOTO1289
2935      WRITE(ICOUT,999)
2936      CALL DPWRST('XXX','BUG ')
2937      WRITE(ICOUT,1281)
2938 1281 FORMAT('THE TIC MARK LABEL (FOR THE BOTTOM ',
2939     1'HORIZONTAL FRAME LINE)')
2940      CALL DPWRST('XXX','BUG ')
2941      WRITE(ICOUT,1282)IHOLD
2942 1282 FORMAT('HAS JUST BEEN TURNED ',A4)
2943      CALL DPWRST('XXX','BUG ')
2944 1289 CONTINUE
2945      GOTO1900
2946C
2947 1299 CONTINUE
2948C
2949C               **************************************************************
2950C               **  TREAT THE CASE WHEN                                     **
2951C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
2952C               **************************************************************
2953C
2954      IF(ICOM.EQ.'X2TI')GOTO1300
2955      GOTO1399
2956C
2957 1300 CONTINUE
2958      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
2959      IF(IHARG(NUMARG).EQ.'OFF')GOTO1360
2960      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
2961      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
2962      IF(IHARG(NUMARG).EQ.'LABE')GOTO1360
2963      GOTO1350
2964C
2965 1350 CONTINUE
2966      IHOLD='ON'
2967      GOTO1380
2968C
2969 1360 CONTINUE
2970      IHOLD='OFF'
2971      GOTO1380
2972C
2973 1380 CONTINUE
2974      IFOUND='YES'
2975      IX2ZSW=IHOLD
2976C
2977      IF(IFEEDB.EQ.'OFF')GOTO1389
2978      WRITE(ICOUT,999)
2979      CALL DPWRST('XXX','BUG ')
2980      WRITE(ICOUT,1381)
2981 1381 FORMAT('THE TIC MARK LABEL (FOR THE TOP HORIZONTAL ',
2982     1'FRAME LINE)')
2983      CALL DPWRST('XXX','BUG ')
2984      WRITE(ICOUT,1382)IHOLD
2985 1382 FORMAT('HAS JUST BEEN TURNED ',A4)
2986      CALL DPWRST('XXX','BUG ')
2987 1389 CONTINUE
2988      GOTO1900
2989C
2990 1399 CONTINUE
2991C
2992C               *****************************************************
2993C               **  TREAT THE CASE WHEN                            **
2994C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
2995C               *****************************************************
2996C
2997      IF(ICOM.EQ.'YTIC')GOTO1400
2998      GOTO1499
2999C
3000 1400 CONTINUE
3001      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
3002      IF(IHARG(NUMARG).EQ.'OFF')GOTO1460
3003      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
3004      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
3005      IF(IHARG(NUMARG).EQ.'LABE')GOTO1460
3006      GOTO1450
3007C
3008 1450 CONTINUE
3009      IHOLD='ON'
3010      GOTO1480
3011C
3012 1460 CONTINUE
3013      IHOLD='OFF'
3014      GOTO1480
3015C
3016 1480 CONTINUE
3017      IFOUND='YES'
3018      IY1ZSW=IHOLD
3019      IY2ZSW=IHOLD
3020C
3021      IF(IFEEDB.EQ.'OFF')GOTO1489
3022      WRITE(ICOUT,999)
3023      CALL DPWRST('XXX','BUG ')
3024      WRITE(ICOUT,1481)
3025 1481 FORMAT('THE TIC MARK LABEL (FOR BOTH VERTICAL ',
3026     1'FRAME LINES)')
3027      CALL DPWRST('XXX','BUG ')
3028      WRITE(ICOUT,1482)IHOLD
3029 1482 FORMAT('HAS JUST BEEN TURNED ',A4)
3030      CALL DPWRST('XXX','BUG ')
3031 1489 CONTINUE
3032      GOTO1900
3033C
3034 1499 CONTINUE
3035C
3036C               **************************************************************
3037C               **  TREAT THE CASE WHEN                                     **
3038C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
3039C               **************************************************************
3040C
3041      IF(ICOM.EQ.'Y1TI')GOTO1500
3042      GOTO1599
3043C
3044 1500 CONTINUE
3045      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
3046      IF(IHARG(NUMARG).EQ.'OFF')GOTO1560
3047      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
3048      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
3049      IF(IHARG(NUMARG).EQ.'LABE')GOTO1560
3050      GOTO1550
3051C
3052 1550 CONTINUE
3053      IHOLD='ON'
3054      GOTO1580
3055C
3056 1560 CONTINUE
3057      IHOLD='OFF'
3058      GOTO1580
3059C
3060 1580 CONTINUE
3061      IFOUND='YES'
3062      IY1ZSW=IHOLD
3063C
3064      IF(IFEEDB.EQ.'OFF')GOTO1589
3065      WRITE(ICOUT,999)
3066      CALL DPWRST('XXX','BUG ')
3067      WRITE(ICOUT,1581)
3068 1581 FORMAT('THE TIC MARK LABEL (FOR THE LEFT VERTICAL ',
3069     1'FRAME LINE)')
3070      CALL DPWRST('XXX','BUG ')
3071      WRITE(ICOUT,1582)IHOLD
3072 1582 FORMAT('HAS JUST BEEN TURNED ',A4)
3073      CALL DPWRST('XXX','BUG ')
3074 1589 CONTINUE
3075      GOTO1900
3076C
3077 1599 CONTINUE
3078C
3079C               **************************************************************
3080C               **  TREAT THE CASE WHEN                                     **
3081C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
3082C               **************************************************************
3083C
3084      IF(ICOM.EQ.'Y2TI')GOTO1600
3085      GOTO1699
3086C
3087 1600 CONTINUE
3088      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
3089      IF(IHARG(NUMARG).EQ.'OFF')GOTO1660
3090      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
3091      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
3092      IF(IHARG(NUMARG).EQ.'LABE')GOTO1660
3093      GOTO1650
3094C
3095 1650 CONTINUE
3096      IHOLD='ON'
3097      GOTO1680
3098C
3099 1660 CONTINUE
3100      IHOLD='OFF'
3101      GOTO1680
3102C
3103 1680 CONTINUE
3104      IFOUND='YES'
3105      IY2ZSW=IHOLD
3106C
3107      IF(IFEEDB.EQ.'OFF')GOTO1689
3108      WRITE(ICOUT,999)
3109      CALL DPWRST('XXX','BUG ')
3110      WRITE(ICOUT,1681)
3111 1681 FORMAT('THE TIC MARK LABEL (FOR THE RIGHT VERTICAL ',
3112     1'FRAME LINE)')
3113      CALL DPWRST('XXX','BUG ')
3114      WRITE(ICOUT,1682)IHOLD
3115 1682 FORMAT('HAS JUST BEEN TURNED ',A4)
3116      CALL DPWRST('XXX','BUG ')
3117 1689 CONTINUE
3118      GOTO1900
3119C
3120 1699 CONTINUE
3121C
3122C               *****************************************************
3123C               **  TREAT THE CASE WHEN                            **
3124C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
3125C               *****************************************************
3126C
3127      IF(ICOM.EQ.'TIC')GOTO1700
3128      IF(ICOM.EQ.'TICS')GOTO1700
3129      IF(ICOM.EQ.'XYTI')GOTO1700
3130      IF(ICOM.EQ.'YXTI')GOTO1700
3131      GOTO1799
3132C
3133 1700 CONTINUE
3134      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
3135      IF(IHARG(NUMARG).EQ.'OFF')GOTO1760
3136      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
3137      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
3138      IF(IHARG(NUMARG).EQ.'LABE')GOTO1760
3139      GOTO1750
3140C
3141 1750 CONTINUE
3142      IHOLD='ON'
3143      GOTO1780
3144C
3145 1760 CONTINUE
3146      IHOLD='OFF'
3147      GOTO1780
3148C
3149 1780 CONTINUE
3150      IFOUND='YES'
3151      IX1ZSW=IHOLD
3152      IX2ZSW=IHOLD
3153      IY1ZSW=IHOLD
3154      IY2ZSW=IHOLD
3155C
3156      IF(IFEEDB.EQ.'OFF')GOTO1789
3157      WRITE(ICOUT,999)
3158      CALL DPWRST('XXX','BUG ')
3159      WRITE(ICOUT,1781)
3160 1781 FORMAT('THE TIC MARK LABEL (FOR ALL 4 ',
3161     1'FRAME LINES)')
3162      CALL DPWRST('XXX','BUG ')
3163      WRITE(ICOUT,1782)IHOLD
3164 1782 FORMAT('HAS JUST BEEN TURNED ',A4)
3165      CALL DPWRST('XXX','BUG ')
3166 1789 CONTINUE
3167      GOTO1900
3168C
3169 1799 CONTINUE
3170C
3171 1900 CONTINUE
3172      RETURN
3173      END
3174      SUBROUTINE DPTLAN(ICOM,IHARG,ARG,NUMARG,
3175     1PDEFAN,
3176     1PX1ZAN,PX2ZAN,PY1ZAN,PY2ZAN,
3177     1IFOUND,IERROR)
3178C
3179C     PURPOSE--DEFINE THE 4 TIC LABEL ANGLES CONTAINED IN THE
3180C              4 VARIABLES PX1ZAN,PX2ZAN,PY1ZAN,PY2ZAN
3181C              SUCH TIC LABEL ANGLES DEFINE THE ANGLES FOR
3182C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
3183C     INPUT  ARGUMENTS--ICOM
3184C                     --IHARG  (A  HOLLERITH VECTOR)
3185C                     --ARG    (A REAL VECTOR)
3186C                     --NUMARG
3187C                     --PDEFAN
3188C     OUTPUT ARGUMENTS--
3189C                     --PX1ZAN = LOWER HORIZONTAL TIC LABEL ANGLE
3190C                     --PX2ZAN = UPPER HORIZONTAL TIC LABEL ANGLE
3191C                     --PY1ZAN = LEFT  VERTICAL   TIC LABEL ANGLE
3192C                     --PY2ZAN = RIGHT VERTICAL   TIC LABEL ANGLE
3193C                     --IFOUND ('YES' OR 'NO' )
3194C                     --IERROR ('YES' OR 'NO' )
3195C     WRITTEN BY--ALAN HECKERT
3196C                 COMPUTER SERVICES DIVISION
3197C                 INFORMATION TECHNOLOGY LABORATORY
3198C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3199C                 GAITHERSBURG, MD 20899-8980
3200C                 PHONE--301-975-2899
3201C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3202C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3203C     LANGUAGE--ANSI FORTRAN (1977)
3204C     VERSION NUMBER--89/2
3205C     ORIGINAL VERSION--JANUARY   1989.
3206C
3207C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3208C
3209      CHARACTER*4 ICOM
3210      CHARACTER*4 IHARG
3211C
3212C
3213      CHARACTER*4 IFOUND
3214      CHARACTER*4 IERROR
3215C
3216C---------------------------------------------------------------------
3217C
3218      DIMENSION IHARG(*)
3219      DIMENSION ARG(*)
3220C
3221C-----COMMON----------------------------------------------------------
3222C
3223      INCLUDE 'DPCOP2.INC'
3224C
3225C-----START POINT-----------------------------------------------------
3226C
3227      IFOUND='NO'
3228      IERROR='NO'
3229C
3230      IF(NUMARG.LE.1)GOTO1900
3231      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
3232     1IHARG(2).EQ.'ANGL')GOTO1090
3233      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
3234     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'ANGL')GOTO1090
3235      GOTO1900
3236 1090 CONTINUE
3237C
3238C               *****************************************************
3239C               **  TREAT THE CASE WHEN                            **
3240C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
3241C               *****************************************************
3242C
3243      IF(ICOM.EQ.'XTIC')GOTO1100
3244      GOTO1199
3245C
3246 1100 CONTINUE
3247      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
3248      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
3249      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
3250      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
3251      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1150
3252      GOTO1160
3253C
3254 1150 CONTINUE
3255      PHOLD=PDEFAN
3256      GOTO1180
3257C
3258 1160 CONTINUE
3259      PHOLD=ARG(NUMARG)
3260      GOTO1180
3261C
3262 1180 CONTINUE
3263      IFOUND='YES'
3264      PX1ZAN=PHOLD
3265      PX2ZAN=PHOLD
3266C
3267      IF(IFEEDB.EQ.'OFF')GOTO1189
3268      WRITE(ICOUT,999)
3269  999 FORMAT(1X)
3270      CALL DPWRST('XXX','BUG ')
3271      WRITE(ICOUT,1181)
3272 1181 FORMAT('THE TIC MARK LABEL ANGLE (FOR BOTH HORIZONTAL ',
3273     1'FRAME LINES)')
3274      CALL DPWRST('XXX','BUG ')
3275      WRITE(ICOUT,1182)PHOLD
3276 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
3277      CALL DPWRST('XXX','BUG ')
3278 1189 CONTINUE
3279      GOTO1900
3280C
3281 1199 CONTINUE
3282C
3283C               **************************************************************
3284C               **  TREAT THE CASE WHEN                                     **
3285C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
3286C               **************************************************************
3287C
3288      IF(ICOM.EQ.'X1TI')GOTO1200
3289      GOTO1299
3290C
3291 1200 CONTINUE
3292      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
3293      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
3294      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
3295      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
3296      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1250
3297      GOTO1260
3298C
3299 1250 CONTINUE
3300      PHOLD=PDEFAN
3301      GOTO1280
3302C
3303 1260 CONTINUE
3304      PHOLD=ARG(NUMARG)
3305      GOTO1280
3306C
3307 1280 CONTINUE
3308      IFOUND='YES'
3309      PX1ZAN=PHOLD
3310C
3311      IF(IFEEDB.EQ.'OFF')GOTO1289
3312      WRITE(ICOUT,999)
3313      CALL DPWRST('XXX','BUG ')
3314      WRITE(ICOUT,1281)
3315 1281 FORMAT('THE TIC MARK LABEL ANGLE (FOR THE BOTTOM ',
3316     1'HORIZONTAL FRAME LINE)')
3317      CALL DPWRST('XXX','BUG ')
3318      WRITE(ICOUT,1282)PHOLD
3319 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
3320      CALL DPWRST('XXX','BUG ')
3321 1289 CONTINUE
3322      GOTO1900
3323C
3324 1299 CONTINUE
3325C
3326C               **************************************************************
3327C               **  TREAT THE CASE WHEN                                     **
3328C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
3329C               **************************************************************
3330C
3331      IF(ICOM.EQ.'X2TI')GOTO1300
3332      GOTO1399
3333C
3334 1300 CONTINUE
3335      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
3336      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
3337      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
3338      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
3339      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1350
3340      GOTO1360
3341C
3342 1350 CONTINUE
3343      PHOLD=PDEFAN
3344      GOTO1380
3345C
3346 1360 CONTINUE
3347      PHOLD=ARG(NUMARG)
3348      GOTO1380
3349C
3350 1380 CONTINUE
3351      IFOUND='YES'
3352      PX2ZAN=PHOLD
3353C
3354      IF(IFEEDB.EQ.'OFF')GOTO1389
3355      WRITE(ICOUT,999)
3356      CALL DPWRST('XXX','BUG ')
3357      WRITE(ICOUT,1381)
3358 1381 FORMAT('THE TIC MARK LABEL ANGLE (FOR THE TOP HORIZONTAL ',
3359     1'FRAME LINE)')
3360      CALL DPWRST('XXX','BUG ')
3361      WRITE(ICOUT,1382)PHOLD
3362 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
3363      CALL DPWRST('XXX','BUG ')
3364 1389 CONTINUE
3365      GOTO1900
3366C
3367 1399 CONTINUE
3368C
3369C               *****************************************************
3370C               **  TREAT THE CASE WHEN                            **
3371C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
3372C               *****************************************************
3373C
3374      IF(ICOM.EQ.'YTIC')GOTO1400
3375      GOTO1499
3376C
3377 1400 CONTINUE
3378      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
3379      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
3380      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
3381      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
3382      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1450
3383      GOTO1460
3384C
3385 1450 CONTINUE
3386      PHOLD=PDEFAN
3387      GOTO1480
3388C
3389 1460 CONTINUE
3390      PHOLD=ARG(NUMARG)
3391      GOTO1480
3392C
3393 1480 CONTINUE
3394      IFOUND='YES'
3395      PY1ZAN=PHOLD
3396      PY2ZAN=PHOLD
3397C
3398      IF(IFEEDB.EQ.'OFF')GOTO1489
3399      WRITE(ICOUT,999)
3400      CALL DPWRST('XXX','BUG ')
3401      WRITE(ICOUT,1481)
3402 1481 FORMAT('THE TIC MARK LABEL ANGLE (FOR BOTH VERTICAL ',
3403     1'FRAME LINES)')
3404      CALL DPWRST('XXX','BUG ')
3405      WRITE(ICOUT,1482)PHOLD
3406 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
3407      CALL DPWRST('XXX','BUG ')
3408 1489 CONTINUE
3409      GOTO1900
3410C
3411 1499 CONTINUE
3412C
3413C               **************************************************************
3414C               **  TREAT THE CASE WHEN                                     **
3415C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
3416C               **************************************************************
3417C
3418      IF(ICOM.EQ.'Y1TI')GOTO1500
3419      GOTO1599
3420C
3421 1500 CONTINUE
3422      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
3423      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
3424      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
3425      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
3426      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1550
3427      GOTO1560
3428C
3429 1550 CONTINUE
3430      PHOLD=PDEFAN
3431      GOTO1580
3432C
3433 1560 CONTINUE
3434      PHOLD=ARG(NUMARG)
3435      GOTO1580
3436C
3437 1580 CONTINUE
3438      IFOUND='YES'
3439      PY1ZAN=PHOLD
3440C
3441      IF(IFEEDB.EQ.'OFF')GOTO1589
3442      WRITE(ICOUT,999)
3443      CALL DPWRST('XXX','BUG ')
3444      WRITE(ICOUT,1581)
3445 1581 FORMAT('THE TIC MARK LABEL ANGLE (FOR THE LEFT VERTICAL ',
3446     1'FRAME LINE)')
3447      CALL DPWRST('XXX','BUG ')
3448      WRITE(ICOUT,1582)PHOLD
3449 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
3450      CALL DPWRST('XXX','BUG ')
3451 1589 CONTINUE
3452      GOTO1900
3453C
3454 1599 CONTINUE
3455C
3456C               **************************************************************
3457C               **  TREAT THE CASE WHEN                                     **
3458C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
3459C               **************************************************************
3460C
3461      IF(ICOM.EQ.'Y2TI')GOTO1600
3462      GOTO1699
3463C
3464 1600 CONTINUE
3465      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
3466      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
3467      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
3468      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
3469      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1650
3470      GOTO1660
3471C
3472 1650 CONTINUE
3473      PHOLD=PDEFAN
3474      GOTO1680
3475C
3476 1660 CONTINUE
3477      PHOLD=ARG(NUMARG)
3478      GOTO1680
3479C
3480 1680 CONTINUE
3481      IFOUND='YES'
3482      PY2ZAN=PHOLD
3483C
3484      IF(IFEEDB.EQ.'OFF')GOTO1689
3485      WRITE(ICOUT,999)
3486      CALL DPWRST('XXX','BUG ')
3487      WRITE(ICOUT,1681)
3488 1681 FORMAT('THE TIC MARK LABEL ANGLE (FOR THE RIGHT VERTICAL ',
3489     1'FRAME LINE)')
3490      CALL DPWRST('XXX','BUG ')
3491      WRITE(ICOUT,1682)PHOLD
3492 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
3493      CALL DPWRST('XXX','BUG ')
3494 1689 CONTINUE
3495      GOTO1900
3496C
3497 1699 CONTINUE
3498C
3499C               *****************************************************
3500C               **  TREAT THE CASE WHEN                            **
3501C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
3502C               *****************************************************
3503C
3504      IF(ICOM.EQ.'TIC')GOTO1700
3505      IF(ICOM.EQ.'TICS')GOTO1700
3506      IF(ICOM.EQ.'XYTI')GOTO1700
3507      IF(ICOM.EQ.'YXTI')GOTO1700
3508      GOTO1799
3509C
3510 1700 CONTINUE
3511      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
3512      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
3513      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
3514      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
3515      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1750
3516      GOTO1760
3517C
3518 1750 CONTINUE
3519      PHOLD=PDEFAN
3520      GOTO1780
3521C
3522 1760 CONTINUE
3523      PHOLD=ARG(NUMARG)
3524      GOTO1780
3525C
3526 1780 CONTINUE
3527      IFOUND='YES'
3528      PX1ZAN=PHOLD
3529      PX2ZAN=PHOLD
3530      PY1ZAN=PHOLD
3531      PY2ZAN=PHOLD
3532C
3533      IF(IFEEDB.EQ.'OFF')GOTO1789
3534      WRITE(ICOUT,999)
3535      CALL DPWRST('XXX','BUG ')
3536      WRITE(ICOUT,1781)
3537 1781 FORMAT('THE TIC MARK LABEL ANGLE (FOR ALL 4 ',
3538     1'FRAME LINES)')
3539      CALL DPWRST('XXX','BUG ')
3540      WRITE(ICOUT,1782)PHOLD
3541 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
3542      CALL DPWRST('XXX','BUG ')
3543 1789 CONTINUE
3544      GOTO1900
3545C
3546 1799 CONTINUE
3547C
3548 1900 CONTINUE
3549      RETURN
3550      END
3551      SUBROUTINE DPTLCA(ICOM,IHARG,NUMARG,
3552     1IDEFCA,
3553     1IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA,
3554     1IFOUND,IERROR)
3555C
3556C     PURPOSE--DEFINE THE 4 TIC LABEL CASES CONTAINED IN THE
3557C              4 VARIABLES IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA
3558C              SUCH TIC LABEL CASES DEFINE THE CASES FOR
3559C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
3560C     INPUT  ARGUMENTS--ICOM
3561C                     --IHARG  (A  HOLLERITH VECTOR)
3562C                     --NUMARG
3563C                     --IDEFCA
3564C     OUTPUT ARGUMENTS--
3565C                     --IX1ZCA = LOWER HORIZONTAL TIC LABEL CASE
3566C                     --IX2ZCA = UPPER HORIZONTAL TIC LABEL CASE
3567C                     --IY1ZCA = LEFT  VERTICAL   TIC LABEL CASE
3568C                     --IY2ZCA = RIGHT VERTICAL   TIC LABEL CASE
3569C                     --IFOUND ('YES' OR 'NO' )
3570C                     --IERROR ('YES' OR 'NO' )
3571C     WRITTEN BY--ALAN HECKERT
3572C                 COMPUTER SERVICES DIVISION
3573C                 INFORMATION TECHNOLOGY LABORATORY
3574C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3575C                 GAITHERSBURG, MD 20899-8980
3576C                 PHONE--301-975-2899
3577C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3578C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3579C     LANGUAGE--ANSI FORTRAN (1977)
3580C     VERSION NUMBER--89/2
3581C     ORIGINAL VERSION--JANUARY   1989.
3582C
3583C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3584C
3585      CHARACTER*4 ICOM
3586      CHARACTER*4 IHARG
3587C
3588      CHARACTER*4 IDEFCA
3589C
3590      CHARACTER*4 IX1ZCA
3591      CHARACTER*4 IX2ZCA
3592      CHARACTER*4 IY1ZCA
3593      CHARACTER*4 IY2ZCA
3594C
3595      CHARACTER*4 IFOUND
3596      CHARACTER*4 IERROR
3597C
3598      CHARACTER*4 IHOLD
3599C
3600C---------------------------------------------------------------------
3601C
3602      DIMENSION IHARG(*)
3603C
3604C-----COMMON----------------------------------------------------------
3605C
3606      INCLUDE 'DPCOP2.INC'
3607C
3608C-----START POINT-----------------------------------------------------
3609C
3610      IFOUND='NO'
3611      IERROR='NO'
3612C
3613      IF(NUMARG.LE.1)GOTO1900
3614      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
3615     1IHARG(2).EQ.'CASE')GOTO1090
3616      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
3617     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'CASE')GOTO1090
3618      GOTO1900
3619 1090 CONTINUE
3620C
3621C               *****************************************************
3622C               **  TREAT THE CASE WHEN                            **
3623C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
3624C               *****************************************************
3625C
3626      IF(ICOM.EQ.'XTIC')GOTO1100
3627      GOTO1199
3628C
3629 1100 CONTINUE
3630      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
3631      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
3632      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
3633      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
3634      IF(IHARG(NUMARG).EQ.'CASE')GOTO1150
3635      GOTO1160
3636C
3637 1150 CONTINUE
3638      IHOLD=IDEFCA
3639      GOTO1180
3640C
3641 1160 CONTINUE
3642      IHOLD=IHARG(NUMARG)
3643      GOTO1180
3644C
3645 1180 CONTINUE
3646      IFOUND='YES'
3647      IX1ZCA=IHOLD
3648      IX2ZCA=IHOLD
3649C
3650      IF(IFEEDB.EQ.'OFF')GOTO1189
3651      WRITE(ICOUT,999)
3652  999 FORMAT(1X)
3653      CALL DPWRST('XXX','BUG ')
3654      WRITE(ICOUT,1181)
3655 1181 FORMAT('THE TIC MARK LABEL CASE (FOR BOTH HORIZONTAL ',
3656     1'FRAME LINES)')
3657      CALL DPWRST('XXX','BUG ')
3658      WRITE(ICOUT,1182)IHOLD
3659 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
3660      CALL DPWRST('XXX','BUG ')
3661 1189 CONTINUE
3662      GOTO1900
3663C
3664 1199 CONTINUE
3665C
3666C               **************************************************************
3667C               **  TREAT THE CASE WHEN                                     **
3668C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
3669C               **************************************************************
3670C
3671      IF(ICOM.EQ.'X1TI')GOTO1200
3672      GOTO1299
3673C
3674 1200 CONTINUE
3675      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
3676      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
3677      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
3678      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
3679      IF(IHARG(NUMARG).EQ.'CASE')GOTO1250
3680      GOTO1260
3681C
3682 1250 CONTINUE
3683      IHOLD=IDEFCA
3684      GOTO1280
3685C
3686 1260 CONTINUE
3687      IHOLD=IHARG(NUMARG)
3688      GOTO1280
3689C
3690 1280 CONTINUE
3691      IFOUND='YES'
3692      IX1ZCA=IHOLD
3693C
3694      IF(IFEEDB.EQ.'OFF')GOTO1289
3695      WRITE(ICOUT,999)
3696      CALL DPWRST('XXX','BUG ')
3697      WRITE(ICOUT,1281)
3698 1281 FORMAT('THE TIC MARK LABEL CASE (FOR THE BOTTOM ',
3699     1'HORIZONTAL FRAME LINE)')
3700      CALL DPWRST('XXX','BUG ')
3701      WRITE(ICOUT,1282)IHOLD
3702 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
3703      CALL DPWRST('XXX','BUG ')
3704 1289 CONTINUE
3705      GOTO1900
3706C
3707 1299 CONTINUE
3708C
3709C               **************************************************************
3710C               **  TREAT THE CASE WHEN                                     **
3711C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
3712C               **************************************************************
3713C
3714      IF(ICOM.EQ.'X2TI')GOTO1300
3715      GOTO1399
3716C
3717 1300 CONTINUE
3718      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
3719      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
3720      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
3721      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
3722      IF(IHARG(NUMARG).EQ.'CASE')GOTO1350
3723      GOTO1360
3724C
3725 1350 CONTINUE
3726      IHOLD=IDEFCA
3727      GOTO1380
3728C
3729 1360 CONTINUE
3730      IHOLD=IHARG(NUMARG)
3731      GOTO1380
3732C
3733 1380 CONTINUE
3734      IFOUND='YES'
3735      IX2ZCA=IHOLD
3736C
3737      IF(IFEEDB.EQ.'OFF')GOTO1389
3738      WRITE(ICOUT,999)
3739      CALL DPWRST('XXX','BUG ')
3740      WRITE(ICOUT,1381)
3741 1381 FORMAT('THE TIC MARK LABEL CASE (FOR THE TOP HORIZONTAL ',
3742     1'FRAME LINE)')
3743      CALL DPWRST('XXX','BUG ')
3744      WRITE(ICOUT,1382)IHOLD
3745 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
3746      CALL DPWRST('XXX','BUG ')
3747 1389 CONTINUE
3748      GOTO1900
3749C
3750 1399 CONTINUE
3751C
3752C               *****************************************************
3753C               **  TREAT THE CASE WHEN                            **
3754C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
3755C               *****************************************************
3756C
3757      IF(ICOM.EQ.'YTIC')GOTO1400
3758      GOTO1499
3759C
3760 1400 CONTINUE
3761      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
3762      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
3763      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
3764      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
3765      IF(IHARG(NUMARG).EQ.'CASE')GOTO1450
3766      GOTO1460
3767C
3768 1450 CONTINUE
3769      IHOLD=IDEFCA
3770      GOTO1480
3771C
3772 1460 CONTINUE
3773      IHOLD=IHARG(NUMARG)
3774      GOTO1480
3775C
3776 1480 CONTINUE
3777      IFOUND='YES'
3778      IY1ZCA=IHOLD
3779      IY2ZCA=IHOLD
3780C
3781      IF(IFEEDB.EQ.'OFF')GOTO1489
3782      WRITE(ICOUT,999)
3783      CALL DPWRST('XXX','BUG ')
3784      WRITE(ICOUT,1481)
3785 1481 FORMAT('THE TIC MARK LABEL CASE (FOR BOTH VERTICAL ',
3786     1'FRAME LINES)')
3787      CALL DPWRST('XXX','BUG ')
3788      WRITE(ICOUT,1482)IHOLD
3789 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
3790      CALL DPWRST('XXX','BUG ')
3791 1489 CONTINUE
3792      GOTO1900
3793C
3794 1499 CONTINUE
3795C
3796C               **************************************************************
3797C               **  TREAT THE CASE WHEN                                     **
3798C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
3799C               **************************************************************
3800C
3801      IF(ICOM.EQ.'Y1TI')GOTO1500
3802      GOTO1599
3803C
3804 1500 CONTINUE
3805      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
3806      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
3807      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
3808      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
3809      IF(IHARG(NUMARG).EQ.'CASE')GOTO1550
3810      GOTO1560
3811C
3812 1550 CONTINUE
3813      IHOLD=IDEFCA
3814      GOTO1580
3815C
3816 1560 CONTINUE
3817      IHOLD=IHARG(NUMARG)
3818      GOTO1580
3819C
3820 1580 CONTINUE
3821      IFOUND='YES'
3822      IY1ZCA=IHOLD
3823C
3824      IF(IFEEDB.EQ.'OFF')GOTO1589
3825      WRITE(ICOUT,999)
3826      CALL DPWRST('XXX','BUG ')
3827      WRITE(ICOUT,1581)
3828 1581 FORMAT('THE TIC MARK LABEL CASE (FOR THE LEFT VERTICAL ',
3829     1'FRAME LINE)')
3830      CALL DPWRST('XXX','BUG ')
3831      WRITE(ICOUT,1582)IHOLD
3832 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
3833      CALL DPWRST('XXX','BUG ')
3834 1589 CONTINUE
3835      GOTO1900
3836C
3837 1599 CONTINUE
3838C
3839C               **************************************************************
3840C               **  TREAT THE CASE WHEN                                     **
3841C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
3842C               **************************************************************
3843C
3844      IF(ICOM.EQ.'Y2TI')GOTO1600
3845      GOTO1699
3846C
3847 1600 CONTINUE
3848      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
3849      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
3850      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
3851      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
3852      IF(IHARG(NUMARG).EQ.'CASE')GOTO1650
3853      GOTO1660
3854C
3855 1650 CONTINUE
3856      IHOLD=IDEFCA
3857      GOTO1680
3858C
3859 1660 CONTINUE
3860      IHOLD=IHARG(NUMARG)
3861      GOTO1680
3862C
3863 1680 CONTINUE
3864      IFOUND='YES'
3865      IY2ZCA=IHOLD
3866C
3867      IF(IFEEDB.EQ.'OFF')GOTO1689
3868      WRITE(ICOUT,999)
3869      CALL DPWRST('XXX','BUG ')
3870      WRITE(ICOUT,1681)
3871 1681 FORMAT('THE TIC MARK LABEL CASE (FOR THE RIGHT VERTICAL ',
3872     1'FRAME LINE)')
3873      CALL DPWRST('XXX','BUG ')
3874      WRITE(ICOUT,1682)IHOLD
3875 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
3876      CALL DPWRST('XXX','BUG ')
3877 1689 CONTINUE
3878      GOTO1900
3879C
3880 1699 CONTINUE
3881C
3882C               *****************************************************
3883C               **  TREAT THE CASE WHEN                            **
3884C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
3885C               *****************************************************
3886C
3887      IF(ICOM.EQ.'TIC')GOTO1700
3888      IF(ICOM.EQ.'TICS')GOTO1700
3889      IF(ICOM.EQ.'XYTI')GOTO1700
3890      IF(ICOM.EQ.'YXTI')GOTO1700
3891      GOTO1799
3892C
3893 1700 CONTINUE
3894      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
3895      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
3896      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
3897      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
3898      IF(IHARG(NUMARG).EQ.'CASE')GOTO1750
3899      GOTO1760
3900C
3901 1750 CONTINUE
3902      IHOLD=IDEFCA
3903      GOTO1780
3904C
3905 1760 CONTINUE
3906      IHOLD=IHARG(NUMARG)
3907      GOTO1780
3908C
3909 1780 CONTINUE
3910      IFOUND='YES'
3911      IX1ZCA=IHOLD
3912      IX2ZCA=IHOLD
3913      IY1ZCA=IHOLD
3914      IY2ZCA=IHOLD
3915C
3916      IF(IFEEDB.EQ.'OFF')GOTO1789
3917      WRITE(ICOUT,999)
3918      CALL DPWRST('XXX','BUG ')
3919      WRITE(ICOUT,1781)
3920 1781 FORMAT('THE TIC MARK LABEL CASE (FOR ALL 4 ',
3921     1'FRAME LINES)')
3922      CALL DPWRST('XXX','BUG ')
3923      WRITE(ICOUT,1782)IHOLD
3924 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
3925      CALL DPWRST('XXX','BUG ')
3926 1789 CONTINUE
3927      GOTO1900
3928C
3929 1799 CONTINUE
3930C
3931 1900 CONTINUE
3932      RETURN
3933      END
3934      SUBROUTINE DPTLCL(ICOM,IHARG,NUMARG,
3935     1IDEFCO,
3936     1IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO,
3937     1IFOUND,IERROR)
3938C
3939C     PURPOSE--DEFINE THE 4 TIC LABEL COLORS CONTAINED IN THE
3940C              4 VARIABLES IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO
3941C              SUCH TIC LABEL COLORS DEFINE THE COLORS FOR
3942C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
3943C     INPUT  ARGUMENTS--ICOM
3944C                     --IHARG  (A  HOLLERITH VECTOR)
3945C                     --NUMARG
3946C                     --IDEFCO
3947C     OUTPUT ARGUMENTS--
3948C                     --IX1ZCO = LOWER HORIZONTAL TIC LABEL COLOR
3949C                     --IX2ZCO = UPPER HORIZONTAL TIC LABEL COLOR
3950C                     --IY1ZCO = LEFT  VERTICAL   TIC LABEL COLOR
3951C                     --IY2ZCO = RIGHT VERTICAL   TIC LABEL COLOR
3952C                     --IFOUND ('YES' OR 'NO' )
3953C                     --IERROR ('YES' OR 'NO' )
3954C     WRITTEN BY--JAMES J. FILLIBEN
3955C                 STATISTICAL ENGINEERING DIVISION
3956C                 INFORMATION TECHNOLOGY LABORATORY
3957C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3958C                 GAITHERSBURG, MD 20899-8980
3959C                 PHONE--301-975-2855
3960C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3961C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3962C     LANGUAGE--ANSI FORTRAN (1977)
3963C     VERSION NUMBER--82/7
3964C     ORIGINAL VERSION--SEPTEMBER 1980.
3965C     UPDATED         --MARCH     1981.
3966C     UPDATED         --MAY       1982.
3967C
3968C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3969C
3970      CHARACTER*4 ICOM
3971      CHARACTER*4 IHARG
3972C
3973      CHARACTER*4 IDEFCO
3974C
3975      CHARACTER*4 IX1ZCO
3976      CHARACTER*4 IX2ZCO
3977      CHARACTER*4 IY1ZCO
3978      CHARACTER*4 IY2ZCO
3979C
3980      CHARACTER*4 IFOUND
3981      CHARACTER*4 IERROR
3982C
3983      CHARACTER*4 IHOLD
3984C
3985C---------------------------------------------------------------------
3986C
3987      DIMENSION IHARG(*)
3988C
3989C-----COMMON----------------------------------------------------------
3990C
3991      INCLUDE 'DPCOP2.INC'
3992C
3993C-----START POINT-----------------------------------------------------
3994C
3995      IFOUND='NO'
3996      IERROR='NO'
3997C
3998      IF(NUMARG.LE.1)GOTO1900
3999      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
4000     1IHARG(2).EQ.'COLO')GOTO1090
4001      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
4002     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'COLO')GOTO1090
4003      GOTO1900
4004 1090 CONTINUE
4005C
4006C               *****************************************************
4007C               **  TREAT THE CASE WHEN                            **
4008C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
4009C               *****************************************************
4010C
4011      IF(ICOM.EQ.'XTIC')GOTO1100
4012      GOTO1199
4013C
4014 1100 CONTINUE
4015      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
4016      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
4017      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
4018      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
4019      IF(IHARG(NUMARG).EQ.'COLO')GOTO1150
4020      GOTO1160
4021C
4022 1150 CONTINUE
4023      IHOLD=IDEFCO
4024      GOTO1180
4025C
4026 1160 CONTINUE
4027      IHOLD=IHARG(NUMARG)
4028      GOTO1180
4029C
4030 1180 CONTINUE
4031      IFOUND='YES'
4032      IX1ZCO=IHOLD
4033      IX2ZCO=IHOLD
4034C
4035      IF(IFEEDB.EQ.'OFF')GOTO1189
4036      WRITE(ICOUT,999)
4037  999 FORMAT(1X)
4038      CALL DPWRST('XXX','BUG ')
4039      WRITE(ICOUT,1181)
4040 1181 FORMAT('THE TIC MARK LABEL COLOR (FOR BOTH HORIZONTAL ',
4041     1'FRAME LINES)')
4042      CALL DPWRST('XXX','BUG ')
4043      WRITE(ICOUT,1182)IHOLD
4044 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
4045      CALL DPWRST('XXX','BUG ')
4046 1189 CONTINUE
4047      GOTO1900
4048C
4049 1199 CONTINUE
4050C
4051C               **************************************************************
4052C               **  TREAT THE CASE WHEN                                     **
4053C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
4054C               **************************************************************
4055C
4056      IF(ICOM.EQ.'X1TI')GOTO1200
4057      GOTO1299
4058C
4059 1200 CONTINUE
4060      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
4061      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
4062      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
4063      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
4064      IF(IHARG(NUMARG).EQ.'COLO')GOTO1250
4065      GOTO1260
4066C
4067 1250 CONTINUE
4068      IHOLD=IDEFCO
4069      GOTO1280
4070C
4071 1260 CONTINUE
4072      IHOLD=IHARG(NUMARG)
4073      GOTO1280
4074C
4075 1280 CONTINUE
4076      IFOUND='YES'
4077      IX1ZCO=IHOLD
4078C
4079      IF(IFEEDB.EQ.'OFF')GOTO1289
4080      WRITE(ICOUT,999)
4081      CALL DPWRST('XXX','BUG ')
4082      WRITE(ICOUT,1281)
4083 1281 FORMAT('THE TIC MARK LABEL COLOR (FOR THE BOTTOM ',
4084     1'HORIZONTAL FRAME LINE)')
4085      CALL DPWRST('XXX','BUG ')
4086      WRITE(ICOUT,1282)IHOLD
4087 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
4088      CALL DPWRST('XXX','BUG ')
4089 1289 CONTINUE
4090      GOTO1900
4091C
4092 1299 CONTINUE
4093C
4094C               **************************************************************
4095C               **  TREAT THE CASE WHEN                                     **
4096C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
4097C               **************************************************************
4098C
4099      IF(ICOM.EQ.'X2TI')GOTO1300
4100      GOTO1399
4101C
4102 1300 CONTINUE
4103      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
4104      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
4105      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
4106      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
4107      IF(IHARG(NUMARG).EQ.'COLO')GOTO1350
4108      GOTO1360
4109C
4110 1350 CONTINUE
4111      IHOLD=IDEFCO
4112      GOTO1380
4113C
4114 1360 CONTINUE
4115      IHOLD=IHARG(NUMARG)
4116      GOTO1380
4117C
4118 1380 CONTINUE
4119      IFOUND='YES'
4120      IX2ZCO=IHOLD
4121C
4122      IF(IFEEDB.EQ.'OFF')GOTO1389
4123      WRITE(ICOUT,999)
4124      CALL DPWRST('XXX','BUG ')
4125      WRITE(ICOUT,1381)
4126 1381 FORMAT('THE TIC MARK LABEL COLOR (FOR THE TOP HORIZONTAL ',
4127     1'FRAME LINE)')
4128      CALL DPWRST('XXX','BUG ')
4129      WRITE(ICOUT,1382)IHOLD
4130 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
4131      CALL DPWRST('XXX','BUG ')
4132 1389 CONTINUE
4133      GOTO1900
4134C
4135 1399 CONTINUE
4136C
4137C               *****************************************************
4138C               **  TREAT THE CASE WHEN                            **
4139C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
4140C               *****************************************************
4141C
4142      IF(ICOM.EQ.'YTIC')GOTO1400
4143      GOTO1499
4144C
4145 1400 CONTINUE
4146      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
4147      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
4148      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
4149      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
4150      IF(IHARG(NUMARG).EQ.'COLO')GOTO1450
4151      GOTO1460
4152C
4153 1450 CONTINUE
4154      IHOLD=IDEFCO
4155      GOTO1480
4156C
4157 1460 CONTINUE
4158      IHOLD=IHARG(NUMARG)
4159      GOTO1480
4160C
4161 1480 CONTINUE
4162      IFOUND='YES'
4163      IY1ZCO=IHOLD
4164      IY2ZCO=IHOLD
4165C
4166      IF(IFEEDB.EQ.'OFF')GOTO1489
4167      WRITE(ICOUT,999)
4168      CALL DPWRST('XXX','BUG ')
4169      WRITE(ICOUT,1481)
4170 1481 FORMAT('THE TIC MARK LABEL COLOR (FOR BOTH VERTICAL ',
4171     1'FRAME LINES)')
4172      CALL DPWRST('XXX','BUG ')
4173      WRITE(ICOUT,1482)IHOLD
4174 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
4175      CALL DPWRST('XXX','BUG ')
4176 1489 CONTINUE
4177      GOTO1900
4178C
4179 1499 CONTINUE
4180C
4181C               **************************************************************
4182C               **  TREAT THE CASE WHEN                                     **
4183C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
4184C               **************************************************************
4185C
4186      IF(ICOM.EQ.'Y1TI')GOTO1500
4187      GOTO1599
4188C
4189 1500 CONTINUE
4190      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
4191      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
4192      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
4193      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
4194      IF(IHARG(NUMARG).EQ.'COLO')GOTO1550
4195      GOTO1560
4196C
4197 1550 CONTINUE
4198      IHOLD=IDEFCO
4199      GOTO1580
4200C
4201 1560 CONTINUE
4202      IHOLD=IHARG(NUMARG)
4203      GOTO1580
4204C
4205 1580 CONTINUE
4206      IFOUND='YES'
4207      IY1ZCO=IHOLD
4208C
4209      IF(IFEEDB.EQ.'OFF')GOTO1589
4210      WRITE(ICOUT,999)
4211      CALL DPWRST('XXX','BUG ')
4212      WRITE(ICOUT,1581)
4213 1581 FORMAT('THE TIC MARK LABEL COLOR (FOR THE LEFT VERTICAL ',
4214     1'FRAME LINE)')
4215      CALL DPWRST('XXX','BUG ')
4216      WRITE(ICOUT,1582)IHOLD
4217 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
4218      CALL DPWRST('XXX','BUG ')
4219 1589 CONTINUE
4220      GOTO1900
4221C
4222 1599 CONTINUE
4223C
4224C               **************************************************************
4225C               **  TREAT THE CASE WHEN                                     **
4226C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
4227C               **************************************************************
4228C
4229      IF(ICOM.EQ.'Y2TI')GOTO1600
4230      GOTO1699
4231C
4232 1600 CONTINUE
4233      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
4234      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
4235      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
4236      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
4237      IF(IHARG(NUMARG).EQ.'COLO')GOTO1650
4238      GOTO1660
4239C
4240 1650 CONTINUE
4241      IHOLD=IDEFCO
4242      GOTO1680
4243C
4244 1660 CONTINUE
4245      IHOLD=IHARG(NUMARG)
4246      GOTO1680
4247C
4248 1680 CONTINUE
4249      IFOUND='YES'
4250      IY2ZCO=IHOLD
4251C
4252      IF(IFEEDB.EQ.'OFF')GOTO1689
4253      WRITE(ICOUT,999)
4254      CALL DPWRST('XXX','BUG ')
4255      WRITE(ICOUT,1681)
4256 1681 FORMAT('THE TIC MARK LABEL COLOR (FOR THE RIGHT VERTICAL ',
4257     1'FRAME LINE)')
4258      CALL DPWRST('XXX','BUG ')
4259      WRITE(ICOUT,1682)IHOLD
4260 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
4261      CALL DPWRST('XXX','BUG ')
4262 1689 CONTINUE
4263      GOTO1900
4264C
4265 1699 CONTINUE
4266C
4267C               *****************************************************
4268C               **  TREAT THE CASE WHEN                            **
4269C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
4270C               *****************************************************
4271C
4272      IF(ICOM.EQ.'TIC')GOTO1700
4273      IF(ICOM.EQ.'TICS')GOTO1700
4274      IF(ICOM.EQ.'XYTI')GOTO1700
4275      IF(ICOM.EQ.'YXTI')GOTO1700
4276      GOTO1799
4277C
4278 1700 CONTINUE
4279      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
4280      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
4281      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
4282      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
4283      IF(IHARG(NUMARG).EQ.'COLO')GOTO1750
4284      GOTO1760
4285C
4286 1750 CONTINUE
4287      IHOLD=IDEFCO
4288      GOTO1780
4289C
4290 1760 CONTINUE
4291      IHOLD=IHARG(NUMARG)
4292      GOTO1780
4293C
4294 1780 CONTINUE
4295      IFOUND='YES'
4296      IX1ZCO=IHOLD
4297      IX2ZCO=IHOLD
4298      IY1ZCO=IHOLD
4299      IY2ZCO=IHOLD
4300C
4301      IF(IFEEDB.EQ.'OFF')GOTO1789
4302      WRITE(ICOUT,999)
4303      CALL DPWRST('XXX','BUG ')
4304      WRITE(ICOUT,1781)
4305 1781 FORMAT('THE TIC MARK LABEL COLOR (FOR ALL 4 ',
4306     1'FRAME LINES)')
4307      CALL DPWRST('XXX','BUG ')
4308      WRITE(ICOUT,1782)IHOLD
4309 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
4310      CALL DPWRST('XXX','BUG ')
4311 1789 CONTINUE
4312      GOTO1900
4313C
4314 1799 CONTINUE
4315C
4316 1900 CONTINUE
4317      RETURN
4318      END
4319      SUBROUTINE DPTLCN(ICOM,IHARG,NUMARG,
4320CCCCC                   THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
4321CCCCC                   TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
4322CCCCC1                  IANS,IWIDTH,
4323     1                  IANS,IANSLC,IWIDTH,
4324     1                  IX1ZCN,IX2ZCN,IY1ZCN,IY2ZCN,
4325     1                  IFOUND,IERROR)
4326C
4327C     PURPOSE--DEFINE THE 4 TIC LABEL CONTENTS CONTAINED IN THE
4328C              4 VARIABLES IX1ZCN,IX2ZCN,IY1ZCN,IY2ZCN
4329C              SUCH TIC LABEL CONTENTS DEFINE THE CONTENTS FOR
4330C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
4331C     INPUT  ARGUMENTS--ICOM
4332C                     --IHARG  (A  HOLLERITH VECTOR)
4333C                     --NUMARG
4334C     OUTPUT ARGUMENTS--
4335C                     --IX1ZCN = LOWER HORIZONTAL TIC LABEL CONTENTS
4336C                     --IX2ZCN = UPPER HORIZONTAL TIC LABEL CONTENTS
4337C                     --IY1ZCN = LEFT  VERTICAL   TIC LABEL CONTENTS
4338C                     --IY2ZCN = RIGHT VERTICAL   TIC LABEL CONTENTS
4339C                     --IFOUND ('YES' OR 'NO' )
4340C                     --IERROR ('YES' OR 'NO' )
4341C     WRITTEN BY--JAMES J. FILLIBEN
4342C                 STATISTICAL ENGINEERING DIVISION
4343C                 INFORMATION TECHNOLOGY LABORATORY
4344C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4345C                 GAITHERSBURG, MD 20899-8980
4346C                 PHONE--301-975-2855
4347C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4348C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4349C     LANGUAGE--ANSI FORTRAN (1977)
4350C     VERSION NUMBER--88/2
4351C     ORIGINAL VERSION--JANUARY   1988.
4352C     UPDATED         --AUGUST    2001. UPDATE DIMENSIONS FROM 130
4353C                                       TO 160
4354C     UPDATED         --SEPTEMBER 2014. UPDATE DIMENSIONS FROM 512 TO
4355C                                       2048
4356C     UPDATED         --APRIL     2017. SOME RECODING FOR BETTER READABILITY
4357C
4358C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4359C
4360      CHARACTER*4 IANS
4361CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
4362CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
4363      CHARACTER*4 IANSLC
4364C
4365      CHARACTER*4 ICOM
4366      CHARACTER*4 IHARG
4367C
4368      CHARACTER*2048 IHOLCN
4369      CHARACTER*2048 ICJUNK
4370C
4371      CHARACTER*2048 IX1ZCN
4372      CHARACTER*2048 IX2ZCN
4373      CHARACTER*2048 IY1ZCN
4374      CHARACTER*2048 IY2ZCN
4375C
4376      CHARACTER*4 IFOUND
4377      CHARACTER*4 IERROR
4378C
4379C---------------------------------------------------------------------
4380C
4381      DIMENSION IHARG(*)
4382C
4383      DIMENSION IANS(*)
4384CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
4385CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
4386      DIMENSION IANSLC(*)
4387C
4388C-----COMMON----------------------------------------------------------
4389C
4390      INCLUDE 'DPCOP2.INC'
4391C
4392C-----START POINT-----------------------------------------------------
4393C
4394      IFOUND='NO'
4395      IERROR='NO'
4396C
4397      IF(NUMARG.LE.1)GOTO9000
4398      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
4399     1   IHARG(2).EQ.'CONT')GOTO1009
4400      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
4401     1   IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'CONT')GOTO1009
4402      GOTO9000
4403 1009 CONTINUE
4404C
4405C               ************************************
4406C               **  EXTRACT THE FULL STRING       **
4407C               ************************************
4408C
4409      DO1010I=1,IWIDTH-6
4410        I2=I
4411        IF(IANS(I).EQ.'C'.AND.IANS(I+1).EQ.'O'.AND.
4412     1     IANS(I+2).EQ.'N'.AND.IANS(I+3).EQ.'T'.AND.
4413     1     IANS(I+4).EQ.'E'.AND.IANS(I+5).EQ.'N'.AND.
4414     1     IANS(I+6).EQ.'T')THEN
4415          IFOUND='YES'
4416          ISTART=I+8
4417          IF(IANS(I+7).EQ.'S')ISTART=ISTART+1
4418          GOTO1019
4419        ENDIF
4420 1010 CONTINUE
4421C
4422      WRITE(ICOUT,1011)
4423 1011 FORMAT('***** ERROR IN TIC MARK LABEL CONTENT--')
4424      CALL DPWRST('XXX','BUG ')
4425      WRITE(ICOUT,1012)
4426 1012 FORMAT('      NO MATCH FOR COMMAND.')
4427      CALL DPWRST('XXX','BUG ')
4428      IERROR='YES'
4429      GOTO9000
4430C
4431 1019 CONTINUE
4432C
4433      ISTOP=0
4434      IF(ISTART.GT.IWIDTH)GOTO1039
4435      DO1030I=ISTART,IWIDTH
4436        IREV=IWIDTH-I+ISTART
4437        IF(IANS(IREV).NE.' ')THEN
4438          ISTOP=IREV
4439          GOTO1039
4440        ENDIF
4441 1030 CONTINUE
4442 1039 CONTINUE
4443C
4444      ICJUNK=' '
4445      NCJUNK=0
4446      IF(ISTART.LE.ISTOP .AND. ISTOP.GT.0)THEN
4447        J=0
4448        DO1040I=ISTART,ISTOP
4449          J=J+1
4450CCCCC     THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
4451CCCCC     TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
4452CCCCC     ICJUNK(J:J)=IANS(I)
4453          ICJUNK(J:J)=IANSLC(I)
4454 1040   CONTINUE
4455        NCJUNK=J
4456      ENDIF
4457C
4458C               *****************************************************
4459C               **  TREAT THE CASE WHEN                            **
4460C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
4461C               *****************************************************
4462C
4463      IF(ICOM.EQ.'XTIC')THEN
4464        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF' .OR.
4465     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
4466     1     IHARG(NUMARG).EQ.'CONT')THEN
4467          IHOLCN='DEFAULT'
4468        ELSE
4469          IHOLCN=ICJUNK
4470        ENDIF
4471C
4472        IFOUND='YES'
4473        IX1ZCN=IHOLCN
4474        IX2ZCN=IHOLCN
4475C
4476        IF(IFEEDB.EQ.'ON')THEN
4477          WRITE(ICOUT,999)
4478  999     FORMAT(1X)
4479          CALL DPWRST('XXX','BUG ')
4480          WRITE(ICOUT,1181)
4481 1181     FORMAT('THE TIC MARK LABEL CONTENTS FOR BOTH HORIZONTAL')
4482          CALL DPWRST('XXX','BUG ')
4483          WRITE(ICOUT,1183)
4484 1183     FORMAT('FRAME LINES HAS JUST BEEN SET TO')
4485          CALL DPWRST('XXX','BUG ')
4486          IF(NCJUNK.LE.0)THEN
4487            WRITE(ICOUT,1185)
4488 1185       FORMAT('FLOAT WITH THE DATA.')
4489            CALL DPWRST('XXX','BUG ')
4490          ELSE
4491            WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,MIN(80,NCJUNK))
4492 1184       FORMAT(80A1)
4493            CALL DPWRST('XXX','BUG ')
4494            IF(NCJUNK.GE.81)THEN
4495              WRITE(ICOUT,1184)(IHOLCN(I:I),I=81,MIN(160,NCJUNK))
4496              CALL DPWRST('XXX','BUG ')
4497            ENDIF
4498            IF(NCJUNK.GE.161)THEN
4499              WRITE(ICOUT,1184)(IHOLCN(I:I),I=161,MIN(240,NCJUNK))
4500              CALL DPWRST('XXX','BUG ')
4501            ENDIF
4502          ENDIF
4503        ENDIF
4504        GOTO9000
4505      ENDIF
4506C
4507C               ******************************************************
4508C               **  TREAT THE CASE WHEN                             **
4509C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE  **
4510C               **  CHANGED                                         **
4511C               ******************************************************
4512C
4513      IF(ICOM.EQ.'X1TI')THEN
4514        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
4515     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
4516     1     IHARG(NUMARG).EQ.'CONT')THEN
4517          IHOLCN='DEFAULT'
4518        ELSE
4519          IHOLCN=ICJUNK
4520        ENDIF
4521        IFOUND='YES'
4522        IX1ZCN=IHOLCN
4523C
4524        IF(IFEEDB.EQ.'ON')THEN
4525          WRITE(ICOUT,999)
4526          CALL DPWRST('XXX','BUG ')
4527          WRITE(ICOUT,1281)
4528 1281     FORMAT('THE TIC MARK LABEL CONTENTS FOR THE BOTTOM ',
4529     1           'HORIZONTAL')
4530          CALL DPWRST('XXX','BUG ')
4531          WRITE(ICOUT,1283)
4532 1283     FORMAT('FRAME LINE HAS JUST BEEN SET TO')
4533          CALL DPWRST('XXX','BUG ')
4534          IF(NCJUNK.LE.0)THEN
4535            WRITE(ICOUT,1185)
4536            CALL DPWRST('XXX','BUG ')
4537          ELSE
4538            WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,MIN(80,NCJUNK))
4539            CALL DPWRST('XXX','BUG ')
4540            IF(NCJUNK.GE.81)THEN
4541              WRITE(ICOUT,1184)(IHOLCN(I:I),I=81,MIN(160,NCJUNK))
4542              CALL DPWRST('XXX','BUG ')
4543            ENDIF
4544            IF(NCJUNK.GE.161)THEN
4545              WRITE(ICOUT,1184)(IHOLCN(I:I),I=161,MIN(NCJUNK,240))
4546              CALL DPWRST('XXX','BUG ')
4547            ENDIF
4548          ENDIF
4549        ENDIF
4550        GOTO9000
4551      ENDIF
4552C
4553C               **************************************************************
4554C               **  TREAT THE CASE WHEN                                     **
4555C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
4556C               **************************************************************
4557C
4558      IF(ICOM.EQ.'X2TI')THEN
4559        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
4560     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
4561     1     IHARG(NUMARG).EQ.'CONT')THEN
4562          IHOLCN='DEFAULT'
4563        ELSE
4564          IHOLCN=ICJUNK
4565        ENDIF
4566        IFOUND='YES'
4567        IX2ZCN=IHOLCN
4568C
4569        IF(IFEEDB.EQ.'ON')THEN
4570          WRITE(ICOUT,999)
4571          CALL DPWRST('XXX','BUG ')
4572          WRITE(ICOUT,1381)
4573 1381     FORMAT('THE TIC MARK LABEL CONTENTS FOR THE TOP HORIZONTAL')
4574          CALL DPWRST('XXX','BUG ')
4575          WRITE(ICOUT,1383)
4576 1383     FORMAT('FRAME LINE HAS JUST BEEN SET TO')
4577          CALL DPWRST('XXX','BUG ')
4578          IF(NCJUNK.LE.0)THEN
4579            WRITE(ICOUT,1185)
4580            CALL DPWRST('XXX','BUG ')
4581          ELSE
4582            WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,MIN(80,NCJUNK))
4583            CALL DPWRST('XXX','BUG ')
4584            IF(NCJUNK.GE.81)THEN
4585              WRITE(ICOUT,1184)(IHOLCN(I:I),I=81,MIN(160,NCJUNK))
4586              CALL DPWRST('XXX','BUG ')
4587            ENDIF
4588            IF(NCJUNK.GE.161)THEN
4589              WRITE(ICOUT,1184)(IHOLCN(I:I),I=161,MIN(240,NCJUNK))
4590              CALL DPWRST('XXX','BUG ')
4591            ENDIF
4592          ENDIF
4593        ENDIF
4594        GOTO9000
4595      ENDIF
4596C
4597C               *****************************************************
4598C               **  TREAT THE CASE WHEN                            **
4599C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
4600C               *****************************************************
4601C
4602      IF(ICOM.EQ.'YTIC')THEN
4603        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
4604     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
4605     1     IHARG(NUMARG).EQ.'CONT')THEN
4606          IHOLCN='DEFAULT'
4607        ELSE
4608          IHOLCN=ICJUNK
4609        ENDIF
4610        IFOUND='YES'
4611        IY1ZCN=IHOLCN
4612        IY2ZCN=IHOLCN
4613C
4614        IF(IFEEDB.EQ.'ON')THEN
4615          WRITE(ICOUT,999)
4616          CALL DPWRST('XXX','BUG ')
4617          WRITE(ICOUT,1481)
4618 1481     FORMAT('THE TIC MARK LABEL CONTENTS FOR BOTH VERTICAL')
4619          CALL DPWRST('XXX','BUG ')
4620          WRITE(ICOUT,1483)
4621 1483     FORMAT('FRAME LINES HAS JUST BEEN SET TO')
4622          CALL DPWRST('XXX','BUG ')
4623          IF(NCJUNK.LE.0)THEN
4624            WRITE(ICOUT,1185)
4625            CALL DPWRST('XXX','BUG ')
4626          ELSE
4627            WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,MIN(80,NCJUNK))
4628            CALL DPWRST('XXX','BUG ')
4629            IF(NCJUNK.GE.81)THEN
4630              WRITE(ICOUT,1184)(IHOLCN(I:I),I=81,MIN(160,NCJUNK))
4631              CALL DPWRST('XXX','BUG ')
4632            ENDIF
4633            IF(NCJUNK.GE.161)THEN
4634              WRITE(ICOUT,1184)(IHOLCN(I:I),I=161,MIN(240,NCJUNK))
4635              CALL DPWRST('XXX','BUG ')
4636            ENDIF
4637          ENDIF
4638        ENDIF
4639        GOTO9000
4640      ENDIF
4641C
4642C               **************************************************************
4643C               **  TREAT THE CASE WHEN                                     **
4644C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
4645C               **************************************************************
4646C
4647      IF(ICOM.EQ.'Y1TI')THEN
4648        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
4649     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
4650     1     IHARG(NUMARG).EQ.'CONT')THEN
4651          IHOLCN='DEFAULT'
4652        ELSE
4653          IHOLCN=ICJUNK
4654        ENDIF
4655        IFOUND='YES'
4656        IY1ZCN=IHOLCN
4657C
4658        IF(IFEEDB.EQ.'ON')THEN
4659          WRITE(ICOUT,999)
4660          CALL DPWRST('XXX','BUG ')
4661          WRITE(ICOUT,1581)
4662 1581     FORMAT('THE TIC MARK LABEL CONTENTS FOR THE LEFT VERTICAL')
4663          CALL DPWRST('XXX','BUG ')
4664          WRITE(ICOUT,1583)
4665 1583     FORMAT('FRAME LINE HAS JUST BEEN SET TO')
4666          CALL DPWRST('XXX','BUG ')
4667          IF(NCJUNK.LE.0)THEN
4668            WRITE(ICOUT,1185)
4669            CALL DPWRST('XXX','BUG ')
4670          ELSE
4671            WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,MIN(80,NCJUNK))
4672            CALL DPWRST('XXX','BUG ')
4673            IF(NCJUNK.GE.81)THEN
4674              WRITE(ICOUT,1184)(IHOLCN(I:I),I=81,MIN(160,NCJUNK))
4675              CALL DPWRST('XXX','BUG ')
4676            ENDIF
4677            IF(NCJUNK.GE.161)THEN
4678              WRITE(ICOUT,1184)(IHOLCN(I:I),I=161,MIN(240,NCJUNK))
4679              CALL DPWRST('XXX','BUG ')
4680            ENDIF
4681          ENDIF
4682        ENDIF
4683        GOTO9000
4684      ENDIF
4685C
4686C               **************************************************************
4687C               **  TREAT THE CASE WHEN                                     **
4688C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
4689C               **************************************************************
4690C
4691      IF(ICOM.EQ.'Y2TI')THEN
4692        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
4693     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
4694     1     IHARG(NUMARG).EQ.'CONT')THEN
4695          IHOLCN='DEFAULT'
4696        ELSE
4697          IHOLCN=ICJUNK
4698        ENDIF
4699        IFOUND='YES'
4700        IY2ZCN=IHOLCN
4701C
4702        IF(IFEEDB.EQ.'ON')THEN
4703          WRITE(ICOUT,999)
4704          CALL DPWRST('XXX','BUG ')
4705          WRITE(ICOUT,1681)
4706 1681     FORMAT('THE TIC MARK LABEL CONTENTS OR THE RIGHT VERTICAL')
4707          CALL DPWRST('XXX','BUG ')
4708          WRITE(ICOUT,1683)
4709 1683     FORMAT('FRAME LINE HAS JUST BEEN SET TO')
4710          CALL DPWRST('XXX','BUG ')
4711          IF(NCJUNK.LE.0)THEN
4712            WRITE(ICOUT,1185)
4713            CALL DPWRST('XXX','BUG ')
4714          ELSE
4715            WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,MIN(80,NCJUNK))
4716            CALL DPWRST('XXX','BUG ')
4717            IF(NCJUNK.GE.81)THEN
4718              WRITE(ICOUT,1184)(IHOLCN(I:I),I=81,MIN(160,NCJUNK))
4719              CALL DPWRST('XXX','BUG ')
4720            ENDIF
4721            IF(NCJUNK.GE.161)THEN
4722              WRITE(ICOUT,1184)(IHOLCN(I:I),I=161,MIN(240,NCJUNK))
4723              CALL DPWRST('XXX','BUG ')
4724            ENDIF
4725          ENDIF
4726        ENDIF
4727        GOTO9000
4728      ENDIF
4729C
4730C               *****************************************************
4731C               **  TREAT THE CASE WHEN                            **
4732C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
4733C               *****************************************************
4734C
4735      IF(ICOM.EQ.'TIC'  .OR. ICOM.EQ.'TICS' .OR.
4736     1   ICOM.EQ.'XYTI' .OR. ICOM.EQ.'YXTI')THEN
4737        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
4738     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
4739     1     IHARG(NUMARG).EQ.'CONT')THEN
4740          IHOLCN='DEFAULT'
4741        ELSE
4742          IHOLCN=ICJUNK
4743        ENDIF
4744        IFOUND='YES'
4745        IX1ZCN=IHOLCN
4746        IX2ZCN=IHOLCN
4747        IY1ZCN=IHOLCN
4748        IY2ZCN=IHOLCN
4749C
4750        IF(IFEEDB.EQ.'ON')THEN
4751          WRITE(ICOUT,999)
4752          CALL DPWRST('XXX','BUG ')
4753          WRITE(ICOUT,1781)
4754 1781     FORMAT('THE TIC MARK LABEL CONTENTS FOR ALL 4 FRAME LINES')
4755          CALL DPWRST('XXX','BUG ')
4756          WRITE(ICOUT,1783)
4757 1783     FORMAT('HAVE JUST BEEN SET TO')
4758          CALL DPWRST('XXX','BUG ')
4759          IF(NCJUNK.LE.0)THEN
4760            WRITE(ICOUT,1185)
4761            CALL DPWRST('XXX','BUG ')
4762          ELSE
4763            WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,MIN(80,NCJUNK))
4764            CALL DPWRST('XXX','BUG ')
4765            IF(NCJUNK.GE.81)THEN
4766              WRITE(ICOUT,1184)(IHOLCN(I:I),I=81,MIN(160,NCJUNK))
4767              CALL DPWRST('XXX','BUG ')
4768            ENDIF
4769            IF(NCJUNK.GE.161)THEN
4770              WRITE(ICOUT,1184)(IHOLCN(I:I),I=161,MIN(240,NCJUNK))
4771              CALL DPWRST('XXX','BUG ')
4772            ENDIF
4773          ENDIF
4774        ENDIF
4775        GOTO9000
4776      ENDIF
4777C
4778 9000 CONTINUE
4779      RETURN
4780      END
4781      SUBROUTINE DPTLDI(ICOM,IHARG,NUMARG,
4782     1IDEFDI,
4783     1IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI,
4784     1IFOUND,IERROR)
4785C
4786C     PURPOSE--DEFINE THE 4 TIC LABEL DIRECTIONS CONTAINED IN THE
4787C              4 VARIABLES IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI
4788C              SUCH TIC LABEL DIRECTIONS DEFINE THE DIRECTIONS FOR
4789C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
4790C     INPUT  ARGUMENTS--ICOM
4791C                     --IHARG  (A  HOLLERITH VECTOR)
4792C                     --NUMARG
4793C                     --IDEFDI
4794C     OUTPUT ARGUMENTS--
4795C                     --IX1ZDI = LOWER HORIZONTAL TIC LABEL DIRECTION
4796C                     --IX2ZDI = UPPER HORIZONTAL TIC LABEL DIRECTION
4797C                     --IY1ZDI = LEFT  VERTICAL   TIC LABEL DIRECTION
4798C                     --IY2ZDI = RIGHT VERTICAL   TIC LABEL DIRECTION
4799C                     --IFOUND ('YES' OR 'NO' )
4800C                     --IERROR ('YES' OR 'NO' )
4801C     WRITTEN BY--ALAN HECKERT
4802C                 COMPUTER SERVICES DIVISION
4803C                 INFORMATION TECHNOLOGY LABORATORY
4804C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4805C                 GAITHERSBURG, MD 20899-8980
4806C                 PHONE--301-975-2899
4807C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4808C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4809C     LANGUAGE--ANSI FORTRAN (1977)
4810C     VERSION NUMBER--89/2
4811C     ORIGINAL VERSION--JANUARY   1989.
4812C
4813C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4814C
4815      CHARACTER*4 ICOM
4816      CHARACTER*4 IHARG
4817C
4818      CHARACTER*4 IDEFDI
4819C
4820      CHARACTER*4 IX1ZDI
4821      CHARACTER*4 IX2ZDI
4822      CHARACTER*4 IY1ZDI
4823      CHARACTER*4 IY2ZDI
4824C
4825      CHARACTER*4 IFOUND
4826      CHARACTER*4 IERROR
4827C
4828      CHARACTER*4 IHOLD
4829C
4830C---------------------------------------------------------------------
4831C
4832      DIMENSION IHARG(*)
4833C
4834C-----COMMON----------------------------------------------------------
4835C
4836      INCLUDE 'DPCOP2.INC'
4837C
4838C-----START POINT-----------------------------------------------------
4839C
4840      IFOUND='NO'
4841      IERROR='NO'
4842C
4843      IF(NUMARG.LE.1)GOTO1900
4844      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
4845     1IHARG(2).EQ.'DIRE')GOTO1090
4846      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
4847     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'DIRE')GOTO1090
4848      GOTO1900
4849 1090 CONTINUE
4850C
4851C               *****************************************************
4852C               **  TREAT THE CASE WHEN                            **
4853C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
4854C               *****************************************************
4855C
4856      IF(ICOM.EQ.'XTIC')GOTO1100
4857      GOTO1199
4858C
4859 1100 CONTINUE
4860      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
4861      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
4862      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
4863      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
4864      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1150
4865      GOTO1160
4866C
4867 1150 CONTINUE
4868      IHOLD=IDEFDI
4869      GOTO1180
4870C
4871 1160 CONTINUE
4872      IHOLD=IHARG(NUMARG)
4873      GOTO1180
4874C
4875 1180 CONTINUE
4876      IFOUND='YES'
4877      IX1ZDI=IHOLD
4878      IX2ZDI=IHOLD
4879C
4880      IF(IFEEDB.EQ.'OFF')GOTO1189
4881      WRITE(ICOUT,999)
4882  999 FORMAT(1X)
4883      CALL DPWRST('XXX','BUG ')
4884      WRITE(ICOUT,1181)
4885 1181 FORMAT('THE TIC MARK LABEL DIRECTION (FOR BOTH HORIZONTAL ',
4886     1'FRAME LINES)')
4887      CALL DPWRST('XXX','BUG ')
4888      WRITE(ICOUT,1182)IHOLD
4889 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
4890      CALL DPWRST('XXX','BUG ')
4891 1189 CONTINUE
4892      GOTO1900
4893C
4894 1199 CONTINUE
4895C
4896C               **************************************************************
4897C               **  TREAT THE CASE WHEN                                     **
4898C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
4899C               **************************************************************
4900C
4901      IF(ICOM.EQ.'X1TI')GOTO1200
4902      GOTO1299
4903C
4904 1200 CONTINUE
4905      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
4906      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
4907      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
4908      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
4909      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1250
4910      GOTO1260
4911C
4912 1250 CONTINUE
4913      IHOLD=IDEFDI
4914      GOTO1280
4915C
4916 1260 CONTINUE
4917      IHOLD=IHARG(NUMARG)
4918      GOTO1280
4919C
4920 1280 CONTINUE
4921      IFOUND='YES'
4922      IX1ZDI=IHOLD
4923C
4924      IF(IFEEDB.EQ.'OFF')GOTO1289
4925      WRITE(ICOUT,999)
4926      CALL DPWRST('XXX','BUG ')
4927      WRITE(ICOUT,1281)
4928 1281 FORMAT('THE TIC MARK LABEL DIRECTION (FOR THE BOTTOM ',
4929     1'HORIZONTAL FRAME LINE)')
4930      CALL DPWRST('XXX','BUG ')
4931      WRITE(ICOUT,1282)IHOLD
4932 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
4933      CALL DPWRST('XXX','BUG ')
4934 1289 CONTINUE
4935      GOTO1900
4936C
4937 1299 CONTINUE
4938C
4939C               **************************************************************
4940C               **  TREAT THE CASE WHEN                                     **
4941C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
4942C               **************************************************************
4943C
4944      IF(ICOM.EQ.'X2TI')GOTO1300
4945      GOTO1399
4946C
4947 1300 CONTINUE
4948      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
4949      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
4950      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
4951      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
4952      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1350
4953      GOTO1360
4954C
4955 1350 CONTINUE
4956      IHOLD=IDEFDI
4957      GOTO1380
4958C
4959 1360 CONTINUE
4960      IHOLD=IHARG(NUMARG)
4961      GOTO1380
4962C
4963 1380 CONTINUE
4964      IFOUND='YES'
4965      IX2ZDI=IHOLD
4966C
4967      IF(IFEEDB.EQ.'OFF')GOTO1389
4968      WRITE(ICOUT,999)
4969      CALL DPWRST('XXX','BUG ')
4970      WRITE(ICOUT,1381)
4971 1381 FORMAT('THE TIC MARK LABEL DIRECTION (FOR THE TOP HORIZONTAL ',
4972     1'FRAME LINE)')
4973      CALL DPWRST('XXX','BUG ')
4974      WRITE(ICOUT,1382)IHOLD
4975 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
4976      CALL DPWRST('XXX','BUG ')
4977 1389 CONTINUE
4978      GOTO1900
4979C
4980 1399 CONTINUE
4981C
4982C               *****************************************************
4983C               **  TREAT THE CASE WHEN                            **
4984C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
4985C               *****************************************************
4986C
4987      IF(ICOM.EQ.'YTIC')GOTO1400
4988      GOTO1499
4989C
4990 1400 CONTINUE
4991      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
4992      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
4993      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
4994      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
4995      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1450
4996      GOTO1460
4997C
4998 1450 CONTINUE
4999      IHOLD=IDEFDI
5000      GOTO1480
5001C
5002 1460 CONTINUE
5003      IHOLD=IHARG(NUMARG)
5004      GOTO1480
5005C
5006 1480 CONTINUE
5007      IFOUND='YES'
5008      IY1ZDI=IHOLD
5009      IY2ZDI=IHOLD
5010C
5011      IF(IFEEDB.EQ.'OFF')GOTO1489
5012      WRITE(ICOUT,999)
5013      CALL DPWRST('XXX','BUG ')
5014      WRITE(ICOUT,1481)
5015 1481 FORMAT('THE TIC MARK LABEL DIRECTION (FOR BOTH VERTICAL ',
5016     1'FRAME LINES)')
5017      CALL DPWRST('XXX','BUG ')
5018      WRITE(ICOUT,1482)IHOLD
5019 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
5020      CALL DPWRST('XXX','BUG ')
5021 1489 CONTINUE
5022      GOTO1900
5023C
5024 1499 CONTINUE
5025C
5026C               **************************************************************
5027C               **  TREAT THE CASE WHEN                                     **
5028C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
5029C               **************************************************************
5030C
5031      IF(ICOM.EQ.'Y1TI')GOTO1500
5032      GOTO1599
5033C
5034 1500 CONTINUE
5035      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
5036      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
5037      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
5038      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
5039      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1550
5040      GOTO1560
5041C
5042 1550 CONTINUE
5043      IHOLD=IDEFDI
5044      GOTO1580
5045C
5046 1560 CONTINUE
5047      IHOLD=IHARG(NUMARG)
5048      GOTO1580
5049C
5050 1580 CONTINUE
5051      IFOUND='YES'
5052      IY1ZDI=IHOLD
5053C
5054      IF(IFEEDB.EQ.'OFF')GOTO1589
5055      WRITE(ICOUT,999)
5056      CALL DPWRST('XXX','BUG ')
5057      WRITE(ICOUT,1581)
5058 1581 FORMAT('THE TIC MARK LABEL DIRECTION (FOR THE LEFT VERTICAL ',
5059     1'FRAME LINE)')
5060      CALL DPWRST('XXX','BUG ')
5061      WRITE(ICOUT,1582)IHOLD
5062 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
5063      CALL DPWRST('XXX','BUG ')
5064 1589 CONTINUE
5065      GOTO1900
5066C
5067 1599 CONTINUE
5068C
5069C               **************************************************************
5070C               **  TREAT THE CASE WHEN                                     **
5071C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
5072C               **************************************************************
5073C
5074      IF(ICOM.EQ.'Y2TI')GOTO1600
5075      GOTO1699
5076C
5077 1600 CONTINUE
5078      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
5079      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
5080      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
5081      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
5082      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1650
5083      GOTO1660
5084C
5085 1650 CONTINUE
5086      IHOLD=IDEFDI
5087      GOTO1680
5088C
5089 1660 CONTINUE
5090      IHOLD=IHARG(NUMARG)
5091      GOTO1680
5092C
5093 1680 CONTINUE
5094      IFOUND='YES'
5095      IY2ZDI=IHOLD
5096C
5097      IF(IFEEDB.EQ.'OFF')GOTO1689
5098      WRITE(ICOUT,999)
5099      CALL DPWRST('XXX','BUG ')
5100      WRITE(ICOUT,1681)
5101 1681 FORMAT('THE TIC MARK LABEL DIRECTION (FOR THE RIGHT VERTICAL ',
5102     1'FRAME LINE)')
5103      CALL DPWRST('XXX','BUG ')
5104      WRITE(ICOUT,1682)IHOLD
5105 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
5106      CALL DPWRST('XXX','BUG ')
5107 1689 CONTINUE
5108      GOTO1900
5109C
5110 1699 CONTINUE
5111C
5112C               *****************************************************
5113C               **  TREAT THE CASE WHEN                            **
5114C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
5115C               *****************************************************
5116C
5117      IF(ICOM.EQ.'TIC')GOTO1700
5118      IF(ICOM.EQ.'TICS')GOTO1700
5119      IF(ICOM.EQ.'XYTI')GOTO1700
5120      IF(ICOM.EQ.'YXTI')GOTO1700
5121      GOTO1799
5122C
5123 1700 CONTINUE
5124      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
5125      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
5126      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
5127      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
5128      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1750
5129      GOTO1760
5130C
5131 1750 CONTINUE
5132      IHOLD=IDEFDI
5133      GOTO1780
5134C
5135 1760 CONTINUE
5136      IHOLD=IHARG(NUMARG)
5137      GOTO1780
5138C
5139 1780 CONTINUE
5140      IFOUND='YES'
5141      IX1ZDI=IHOLD
5142      IX2ZDI=IHOLD
5143      IY1ZDI=IHOLD
5144      IY2ZDI=IHOLD
5145C
5146      IF(IFEEDB.EQ.'OFF')GOTO1789
5147      WRITE(ICOUT,999)
5148      CALL DPWRST('XXX','BUG ')
5149      WRITE(ICOUT,1781)
5150 1781 FORMAT('THE TIC MARK LABEL DIRECTION (FOR ALL 4 ',
5151     1'FRAME LINES)')
5152      CALL DPWRST('XXX','BUG ')
5153      WRITE(ICOUT,1782)IHOLD
5154 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
5155      CALL DPWRST('XXX','BUG ')
5156 1789 CONTINUE
5157      GOTO1900
5158C
5159 1799 CONTINUE
5160C
5161 1900 CONTINUE
5162      RETURN
5163      END
5164      SUBROUTINE DPTLDS(ICOM,IHARG,IARGT,ARG,NUMARG,
5165     1PDEFHG,PDEFVG,
5166     1PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS,
5167     1IFOUND,IERROR)
5168C
5169C     PURPOSE--DEFINE THE TIC MARK LABEL DISPLACEMENT SWITCHES
5170C              FOR ANY OF THE 4 FRAME LINES.
5171C              SUCH TIC MARK SWITCHES DEFINE THE DISPLACEMENT
5172C              OF THE TIC MARK LABELS ON THE 4 FRAME LINES OF A PLOT.
5173C     INPUT  ARGUMENTS--ICOM
5174C                     --IHARG  (A  HOLLERITH VECTOR)
5175C                     --IARGT  (A  HOLLERITH VECTOR)
5176C                     --ARG    (A  FLOATING POINT VECTOR)
5177C                     --NUMARG
5178C                     --PDEFHG
5179C                     --PDEFVG
5180C     OUTPUT ARGUMENTS--
5181C                     --PX1ZDS,
5182C                     --PX2ZDS,
5183C                     --PY1ZDS,
5184C                     --PY2ZDS,
5185C                     --IFOUND ('YES' OR 'NO' )
5186C                     --IERROR ('YES' OR 'NO' )
5187C     WRITTEN BY--JAMES J. FILLIBEN
5188C                 STATISTICAL ENGINEERING DIVISION
5189C                 INFORMATION TECHNOLOGY LABORATORY
5190C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5191C                 GAITHERSBURG, MD 20899-8980
5192C                 PHONE--301-975-2855
5193C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5194C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5195C     LANGUAGE--ANSI FORTRAN (1977)
5196C     VERSION NUMBER--91/9
5197C     ORIGINAL VERSION--AUGUST    1991.
5198C
5199C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5200C
5201      CHARACTER*4 ICOM
5202      CHARACTER*4 IHARG
5203      CHARACTER*4 IARGT
5204      CHARACTER*4 IFOUND
5205      CHARACTER*4 IERROR
5206C
5207C---------------------------------------------------------------------
5208C
5209      DIMENSION IHARG(*)
5210      DIMENSION IARGT(*)
5211      DIMENSION ARG(*)
5212C
5213C-----COMMON----------------------------------------------------------
5214C
5215      INCLUDE 'DPCOP2.INC'
5216C
5217C-----START POINT-----------------------------------------------------
5218C
5219      IFOUND='NO'
5220      IERROR='NO'
5221C
5222CCCCC IF(NUMARG.LE.1)GOTO1900
5223      IF(NUMARG.LE.1)GOTO9000
5224      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
5225     1IHARG(2).EQ.'DISP')GOTO1090
5226      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
5227     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'DISP')GOTO1090
5228      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
5229     1IHARG(2).EQ.'OFFS')GOTO1090
5230      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
5231     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'OFFS')GOTO1090
5232      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
5233     1IHARG(2).EQ.'GAP')GOTO1090
5234      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
5235     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'GAP')GOTO1090
5236CCCCC GOTO1900
5237      GOTO9000
5238 1090 CONTINUE
5239      HOLD1=(-999.9)
5240      HOLD2=(-999.9)
5241C
5242C               *****************************************************
5243C               **  TREAT THE CASE WHEN                            **
5244C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
5245C               *****************************************************
5246C
5247      IF(ICOM.EQ.'XTIC')GOTO1100
5248      GOTO1199
5249C
5250 1100 CONTINUE
5251      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
5252      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
5253      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
5254      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
5255      IF(IHARG(NUMARG).EQ.'DISP')GOTO1150
5256      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
5257      IERROR='YES'
5258      GOTO9000
5259C
5260 1150 CONTINUE
5261      HOLD1=PDEFHG
5262      GOTO1180
5263C
5264 1160 CONTINUE
5265      HOLD1=ARG(NUMARG)
5266      GOTO1180
5267C
5268 1180 CONTINUE
5269      IFOUND='YES'
5270      PX1ZDS=HOLD1
5271      PX2ZDS=HOLD1
5272C
5273      IF(IFEEDB.EQ.'OFF')GOTO1189
5274      WRITE(ICOUT,999)
5275  999 FORMAT(1X)
5276      CALL DPWRST('XXX','BUG ')
5277      WRITE(ICOUT,1181)
5278 1181 FORMAT('THE TIC MARK LABEL DISPLACEMENT')
5279      CALL DPWRST('XXX','BUG ')
5280      WRITE(ICOUT,1182)
5281 1182 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES)')
5282      CALL DPWRST('XXX','BUG ')
5283      WRITE(ICOUT,1183)HOLD1
5284 1183 FORMAT('HAS JUST BEEN SET TO ',E15.7)
5285      CALL DPWRST('XXX','BUG ')
5286 1189 CONTINUE
5287      GOTO1900
5288C
5289 1199 CONTINUE
5290C
5291C               **************************************************************
5292C               **  TREAT THE CASE WHEN                                     **
5293C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
5294C               **************************************************************
5295C
5296      IF(ICOM.EQ.'X1TI')GOTO1200
5297      GOTO1299
5298C
5299 1200 CONTINUE
5300      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
5301      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
5302      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
5303      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
5304      IF(IHARG(NUMARG).EQ.'DISP')GOTO1250
5305      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
5306      IERROR='YES'
5307      GOTO9000
5308C
5309 1250 CONTINUE
5310      HOLD1=PDEFHG
5311      GOTO1280
5312C
5313 1260 CONTINUE
5314      HOLD1=ARG(NUMARG)
5315      GOTO1280
5316C
5317 1280 CONTINUE
5318      IFOUND='YES'
5319      PX1ZDS=HOLD1
5320C
5321      IF(IFEEDB.EQ.'OFF')GOTO1289
5322      WRITE(ICOUT,999)
5323      CALL DPWRST('XXX','BUG ')
5324      WRITE(ICOUT,1181)
5325      CALL DPWRST('XXX','BUG ')
5326      WRITE(ICOUT,1282)
5327 1282 FORMAT('(FOR THE BOTTOM HORIZONTAL FRAME LINE)')
5328      CALL DPWRST('XXX','BUG ')
5329      WRITE(ICOUT,1183)HOLD1
5330      CALL DPWRST('XXX','BUG ')
5331 1289 CONTINUE
5332      GOTO1900
5333C
5334 1299 CONTINUE
5335C
5336C               **************************************************************
5337C               **  TREAT THE CASE WHEN                                     **
5338C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
5339C               **************************************************************
5340C
5341      IF(ICOM.EQ.'X2TI')GOTO1300
5342      GOTO1399
5343C
5344 1300 CONTINUE
5345      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
5346      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
5347      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
5348      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
5349      IF(IHARG(NUMARG).EQ.'DISP')GOTO1350
5350      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
5351      IERROR='YES'
5352      GOTO9000
5353C
5354 1350 CONTINUE
5355      HOLD1=PDEFHG
5356      GOTO1380
5357C
5358 1360 CONTINUE
5359      HOLD1=ARG(NUMARG)
5360      GOTO1380
5361C
5362 1380 CONTINUE
5363      IFOUND='YES'
5364      PX2ZDS=HOLD1
5365C
5366      IF(IFEEDB.EQ.'OFF')GOTO1389
5367      WRITE(ICOUT,999)
5368      CALL DPWRST('XXX','BUG ')
5369      WRITE(ICOUT,1181)
5370      CALL DPWRST('XXX','BUG ')
5371      WRITE(ICOUT,1382)
5372 1382 FORMAT('(FOR THE TOP HORIZONTAL FRAME LINE)')
5373      CALL DPWRST('XXX','BUG ')
5374      WRITE(ICOUT,1183)HOLD1
5375      CALL DPWRST('XXX','BUG ')
5376 1389 CONTINUE
5377      GOTO1900
5378C
5379 1399 CONTINUE
5380C
5381C               *****************************************************
5382C               **  TREAT THE CASE WHEN                            **
5383C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
5384C               *****************************************************
5385C
5386      IF(ICOM.EQ.'YTIC')GOTO1400
5387      GOTO1499
5388C
5389 1400 CONTINUE
5390      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
5391      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
5392      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
5393      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
5394      IF(IHARG(NUMARG).EQ.'DISP')GOTO1450
5395      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
5396      IERROR='YES'
5397      GOTO9000
5398C
5399 1450 CONTINUE
5400      HOLD1=PDEFVG
5401      GOTO1480
5402C
5403 1460 CONTINUE
5404      HOLD1=ARG(NUMARG)
5405      GOTO1480
5406C
5407 1480 CONTINUE
5408      IFOUND='YES'
5409      PY1ZDS=HOLD1
5410      PY2ZDS=HOLD1
5411C
5412      IF(IFEEDB.EQ.'OFF')GOTO1489
5413      WRITE(ICOUT,999)
5414      CALL DPWRST('XXX','BUG ')
5415      WRITE(ICOUT,1181)
5416      CALL DPWRST('XXX','BUG ')
5417      WRITE(ICOUT,1482)
5418 1482 FORMAT('(FOR BOTH VERTICAL FRAME LINES)')
5419      CALL DPWRST('XXX','BUG ')
5420      WRITE(ICOUT,1183)HOLD1
5421      CALL DPWRST('XXX','BUG ')
5422 1489 CONTINUE
5423      GOTO1900
5424C
5425 1499 CONTINUE
5426C
5427C               **************************************************************
5428C               **  TREAT THE CASE WHEN                                     **
5429C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
5430C               **************************************************************
5431C
5432      IF(ICOM.EQ.'Y1TI')GOTO1500
5433      GOTO1599
5434C
5435 1500 CONTINUE
5436      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
5437      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
5438      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
5439      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
5440      IF(IHARG(NUMARG).EQ.'DISP')GOTO1550
5441      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
5442      IERROR='YES'
5443      GOTO9000
5444C
5445 1550 CONTINUE
5446      HOLD1=PDEFVG
5447      GOTO1580
5448C
5449 1560 CONTINUE
5450      HOLD1=ARG(NUMARG)
5451      GOTO1580
5452C
5453 1580 CONTINUE
5454      IFOUND='YES'
5455      PY1ZDS=HOLD1
5456C
5457      IF(IFEEDB.EQ.'OFF')GOTO1589
5458      WRITE(ICOUT,999)
5459      CALL DPWRST('XXX','BUG ')
5460      WRITE(ICOUT,1181)
5461      CALL DPWRST('XXX','BUG ')
5462      WRITE(ICOUT,1582)
5463 1582 FORMAT('(FOR THE LEFT VERTICAL FRAME LINE)')
5464      CALL DPWRST('XXX','BUG ')
5465      WRITE(ICOUT,1183)HOLD1
5466      CALL DPWRST('XXX','BUG ')
5467 1589 CONTINUE
5468      GOTO1900
5469C
5470 1599 CONTINUE
5471C
5472C               **************************************************************
5473C               **  TREAT THE CASE WHEN                                     **
5474C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
5475C               **************************************************************
5476C
5477      IF(ICOM.EQ.'Y2TI')GOTO1600
5478      GOTO1699
5479C
5480 1600 CONTINUE
5481      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
5482      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
5483      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
5484      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
5485      IF(IHARG(NUMARG).EQ.'DISP')GOTO1650
5486      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
5487      IERROR='YES'
5488      GOTO9000
5489C
5490 1650 CONTINUE
5491      HOLD1=PDEFVG
5492      GOTO1680
5493C
5494 1660 CONTINUE
5495      HOLD1=ARG(NUMARG)
5496      GOTO1680
5497C
5498 1680 CONTINUE
5499      IFOUND='YES'
5500      PY2ZDS=HOLD1
5501C
5502      IF(IFEEDB.EQ.'OFF')GOTO1689
5503      WRITE(ICOUT,999)
5504      CALL DPWRST('XXX','BUG ')
5505      WRITE(ICOUT,1181)
5506      CALL DPWRST('XXX','BUG ')
5507      WRITE(ICOUT,1682)
5508 1682 FORMAT('(FOR THE RIGHT VERTICAL FRAME LINE)')
5509      CALL DPWRST('XXX','BUG ')
5510      WRITE(ICOUT,1183)HOLD1
5511      CALL DPWRST('XXX','BUG ')
5512 1689 CONTINUE
5513      GOTO1900
5514C
5515 1699 CONTINUE
5516C
5517C               *****************************************************
5518C               **  TREAT THE CASE WHEN                            **
5519C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
5520C               *****************************************************
5521C
5522      IF(ICOM.EQ.'TIC')GOTO1700
5523      IF(ICOM.EQ.'TICS')GOTO1700
5524      IF(ICOM.EQ.'XYTI')GOTO1700
5525      IF(ICOM.EQ.'YXTI')GOTO1700
5526      GOTO1799
5527C
5528 1700 CONTINUE
5529      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
5530      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
5531      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
5532      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
5533      IF(IHARG(NUMARG).EQ.'DISP')GOTO1750
5534      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
5535      IERROR='YES'
5536      GOTO9000
5537C
5538 1750 CONTINUE
5539      HOLD1=PDEFHG
5540      HOLD2=PDEFVG
5541      GOTO1780
5542C
5543 1760 CONTINUE
5544      HOLD1=ARG(NUMARG)
5545      HOLD2=ARG(NUMARG)
5546      GOTO1780
5547C
5548 1780 CONTINUE
5549      IFOUND='YES'
5550      PX1ZDS=HOLD1
5551      PX2ZDS=HOLD1
5552      PY1ZDS=HOLD2
5553      PY2ZDS=HOLD2
5554C
5555      IF(IFEEDB.EQ.'OFF')GOTO1789
5556      WRITE(ICOUT,999)
5557      CALL DPWRST('XXX','BUG ')
5558      WRITE(ICOUT,1181)
5559      CALL DPWRST('XXX','BUG ')
5560      WRITE(ICOUT,1782)
5561 1782 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES)')
5562      CALL DPWRST('XXX','BUG ')
5563      WRITE(ICOUT,1183)HOLD1
5564      CALL DPWRST('XXX','BUG ')
5565      WRITE(ICOUT,1181)
5566      CALL DPWRST('XXX','BUG ')
5567      WRITE(ICOUT,1784)
5568 1784 FORMAT('(FOR BOTH VERTICAL   FRAME LINES)')
5569      CALL DPWRST('XXX','BUG ')
5570      WRITE(ICOUT,1183)HOLD2
5571      CALL DPWRST('XXX','BUG ')
5572 1789 CONTINUE
5573      GOTO1900
5574C
5575 1799 CONTINUE
5576C
5577 1900 CONTINUE
5578C
5579      GOTO9000
5580C
5581 9000 CONTINUE
5582      RETURN
5583      END
5584      SUBROUTINE DPTLFI(ICOM,IHARG,NUMARG,
5585     1IDEFFI,
5586     1IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI,
5587     1IFOUND,IERROR)
5588C
5589C     PURPOSE--DEFINE THE 4 TIC LABEL FILLS CONTAINED IN THE
5590C              4 VARIABLES IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI
5591C              SUCH TIC LABEL FILLS DEFINE THE FILLS FOR
5592C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
5593C     INPUT  ARGUMENTS--ICOM
5594C                     --IHARG  (A  HOLLERITH VECTOR)
5595C                     --NUMARG
5596C                     --IDEFFI
5597C     OUTPUT ARGUMENTS--
5598C                     --IX1ZFI = LOWER HORIZONTAL TIC LABEL FILL
5599C                     --IX2ZFI = UPPER HORIZONTAL TIC LABEL FILL
5600C                     --IY1ZFI = LEFT  VERTICAL   TIC LABEL FILL
5601C                     --IY2ZFI = RIGHT VERTICAL   TIC LABEL FILL
5602C                     --IFOUND ('YES' OR 'NO' )
5603C                     --IERROR ('YES' OR 'NO' )
5604C     WRITTEN BY--ALAN HECKERT
5605C                 COMPUTER SERVICES DIVISION
5606C                 INFORMATION TECHNOLOGY LABORATORY
5607C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5608C                 GAITHERSBURG, MD 20899-8980
5609C                 PHONE--301-975-2899
5610C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5611C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5612C     LANGUAGE--ANSI FORTRAN (1977)
5613C     VERSION NUMBER--89/2
5614C     ORIGINAL VERSION--JANUARY   1989.
5615C
5616C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5617C
5618      CHARACTER*4 ICOM
5619      CHARACTER*4 IHARG
5620C
5621      CHARACTER*4 IDEFFI
5622C
5623      CHARACTER*4 IX1ZFI
5624      CHARACTER*4 IX2ZFI
5625      CHARACTER*4 IY1ZFI
5626      CHARACTER*4 IY2ZFI
5627C
5628      CHARACTER*4 IFOUND
5629      CHARACTER*4 IERROR
5630C
5631      CHARACTER*4 IHOLD
5632C
5633C---------------------------------------------------------------------
5634C
5635      DIMENSION IHARG(*)
5636C
5637C-----COMMON----------------------------------------------------------
5638C
5639      INCLUDE 'DPCOP2.INC'
5640C
5641C-----START POINT-----------------------------------------------------
5642C
5643      IFOUND='NO'
5644      IERROR='NO'
5645C
5646      IF(NUMARG.LE.1)GOTO1900
5647      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
5648     1IHARG(2).EQ.'FILL')GOTO1090
5649      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
5650     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'FILL')GOTO1090
5651      GOTO1900
5652 1090 CONTINUE
5653C
5654C               *****************************************************
5655C               **  TREAT THE CASE WHEN                            **
5656C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
5657C               *****************************************************
5658C
5659      IF(ICOM.EQ.'XTIC')GOTO1100
5660      GOTO1199
5661C
5662 1100 CONTINUE
5663      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
5664      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
5665      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
5666      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
5667      IF(IHARG(NUMARG).EQ.'FILL')GOTO1150
5668      GOTO1160
5669C
5670 1150 CONTINUE
5671      IHOLD=IDEFFI
5672      GOTO1180
5673C
5674 1160 CONTINUE
5675      IHOLD=IHARG(NUMARG)
5676      GOTO1180
5677C
5678 1180 CONTINUE
5679      IFOUND='YES'
5680      IX1ZFI=IHOLD
5681      IX2ZFI=IHOLD
5682C
5683      IF(IFEEDB.EQ.'OFF')GOTO1189
5684      WRITE(ICOUT,999)
5685  999 FORMAT(1X)
5686      CALL DPWRST('XXX','BUG ')
5687      WRITE(ICOUT,1181)
5688 1181 FORMAT('THE TIC MARK LABEL FILL (FOR BOTH HORIZONTAL ',
5689     1'FRAME LINES)')
5690      CALL DPWRST('XXX','BUG ')
5691      WRITE(ICOUT,1182)IHOLD
5692 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
5693      CALL DPWRST('XXX','BUG ')
5694 1189 CONTINUE
5695      GOTO1900
5696C
5697 1199 CONTINUE
5698C
5699C               **************************************************************
5700C               **  TREAT THE CASE WHEN                                     **
5701C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
5702C               **************************************************************
5703C
5704      IF(ICOM.EQ.'X1TI')GOTO1200
5705      GOTO1299
5706C
5707 1200 CONTINUE
5708      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
5709      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
5710      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
5711      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
5712      IF(IHARG(NUMARG).EQ.'FILL')GOTO1250
5713      GOTO1260
5714C
5715 1250 CONTINUE
5716      IHOLD=IDEFFI
5717      GOTO1280
5718C
5719 1260 CONTINUE
5720      IHOLD=IHARG(NUMARG)
5721      GOTO1280
5722C
5723 1280 CONTINUE
5724      IFOUND='YES'
5725      IX1ZFI=IHOLD
5726C
5727      IF(IFEEDB.EQ.'OFF')GOTO1289
5728      WRITE(ICOUT,999)
5729      CALL DPWRST('XXX','BUG ')
5730      WRITE(ICOUT,1281)
5731 1281 FORMAT('THE TIC MARK LABEL FILL (FOR THE BOTTOM ',
5732     1'HORIZONTAL FRAME LINE)')
5733      CALL DPWRST('XXX','BUG ')
5734      WRITE(ICOUT,1282)IHOLD
5735 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
5736      CALL DPWRST('XXX','BUG ')
5737 1289 CONTINUE
5738      GOTO1900
5739C
5740 1299 CONTINUE
5741C
5742C               **************************************************************
5743C               **  TREAT THE CASE WHEN                                     **
5744C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
5745C               **************************************************************
5746C
5747      IF(ICOM.EQ.'X2TI')GOTO1300
5748      GOTO1399
5749C
5750 1300 CONTINUE
5751      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
5752      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
5753      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
5754      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
5755      IF(IHARG(NUMARG).EQ.'FILL')GOTO1350
5756      GOTO1360
5757C
5758 1350 CONTINUE
5759      IHOLD=IDEFFI
5760      GOTO1380
5761C
5762 1360 CONTINUE
5763      IHOLD=IHARG(NUMARG)
5764      GOTO1380
5765C
5766 1380 CONTINUE
5767      IFOUND='YES'
5768      IX2ZFI=IHOLD
5769C
5770      IF(IFEEDB.EQ.'OFF')GOTO1389
5771      WRITE(ICOUT,999)
5772      CALL DPWRST('XXX','BUG ')
5773      WRITE(ICOUT,1381)
5774 1381 FORMAT('THE TIC MARK LABEL FILL (FOR THE TOP HORIZONTAL ',
5775     1'FRAME LINE)')
5776      CALL DPWRST('XXX','BUG ')
5777      WRITE(ICOUT,1382)IHOLD
5778 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
5779      CALL DPWRST('XXX','BUG ')
5780 1389 CONTINUE
5781      GOTO1900
5782C
5783 1399 CONTINUE
5784C
5785C               *****************************************************
5786C               **  TREAT THE CASE WHEN                            **
5787C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
5788C               *****************************************************
5789C
5790      IF(ICOM.EQ.'YTIC')GOTO1400
5791      GOTO1499
5792C
5793 1400 CONTINUE
5794      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
5795      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
5796      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
5797      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
5798      IF(IHARG(NUMARG).EQ.'FILL')GOTO1450
5799      GOTO1460
5800C
5801 1450 CONTINUE
5802      IHOLD=IDEFFI
5803      GOTO1480
5804C
5805 1460 CONTINUE
5806      IHOLD=IHARG(NUMARG)
5807      GOTO1480
5808C
5809 1480 CONTINUE
5810      IFOUND='YES'
5811      IY1ZFI=IHOLD
5812      IY2ZFI=IHOLD
5813C
5814      IF(IFEEDB.EQ.'OFF')GOTO1489
5815      WRITE(ICOUT,999)
5816      CALL DPWRST('XXX','BUG ')
5817      WRITE(ICOUT,1481)
5818 1481 FORMAT('THE TIC MARK LABEL FILL (FOR BOTH VERTICAL ',
5819     1'FRAME LINES)')
5820      CALL DPWRST('XXX','BUG ')
5821      WRITE(ICOUT,1482)IHOLD
5822 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
5823      CALL DPWRST('XXX','BUG ')
5824 1489 CONTINUE
5825      GOTO1900
5826C
5827 1499 CONTINUE
5828C
5829C               **************************************************************
5830C               **  TREAT THE CASE WHEN                                     **
5831C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
5832C               **************************************************************
5833C
5834      IF(ICOM.EQ.'Y1TI')GOTO1500
5835      GOTO1599
5836C
5837 1500 CONTINUE
5838      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
5839      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
5840      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
5841      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
5842      IF(IHARG(NUMARG).EQ.'FILL')GOTO1550
5843      GOTO1560
5844C
5845 1550 CONTINUE
5846      IHOLD=IDEFFI
5847      GOTO1580
5848C
5849 1560 CONTINUE
5850      IHOLD=IHARG(NUMARG)
5851      GOTO1580
5852C
5853 1580 CONTINUE
5854      IFOUND='YES'
5855      IY1ZFI=IHOLD
5856C
5857      IF(IFEEDB.EQ.'OFF')GOTO1589
5858      WRITE(ICOUT,999)
5859      CALL DPWRST('XXX','BUG ')
5860      WRITE(ICOUT,1581)
5861 1581 FORMAT('THE TIC MARK LABEL FILL (FOR THE LEFT VERTICAL ',
5862     1'FRAME LINE)')
5863      CALL DPWRST('XXX','BUG ')
5864      WRITE(ICOUT,1582)IHOLD
5865 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
5866      CALL DPWRST('XXX','BUG ')
5867 1589 CONTINUE
5868      GOTO1900
5869C
5870 1599 CONTINUE
5871C
5872C               **************************************************************
5873C               **  TREAT THE CASE WHEN                                     **
5874C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
5875C               **************************************************************
5876C
5877      IF(ICOM.EQ.'Y2TI')GOTO1600
5878      GOTO1699
5879C
5880 1600 CONTINUE
5881      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
5882      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
5883      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
5884      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
5885      IF(IHARG(NUMARG).EQ.'FILL')GOTO1650
5886      GOTO1660
5887C
5888 1650 CONTINUE
5889      IHOLD=IDEFFI
5890      GOTO1680
5891C
5892 1660 CONTINUE
5893      IHOLD=IHARG(NUMARG)
5894      GOTO1680
5895C
5896 1680 CONTINUE
5897      IFOUND='YES'
5898      IY2ZFI=IHOLD
5899C
5900      IF(IFEEDB.EQ.'OFF')GOTO1689
5901      WRITE(ICOUT,999)
5902      CALL DPWRST('XXX','BUG ')
5903      WRITE(ICOUT,1681)
5904 1681 FORMAT('THE TIC MARK LABEL FILL (FOR THE RIGHT VERTICAL ',
5905     1'FRAME LINE)')
5906      CALL DPWRST('XXX','BUG ')
5907      WRITE(ICOUT,1682)IHOLD
5908 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
5909      CALL DPWRST('XXX','BUG ')
5910 1689 CONTINUE
5911      GOTO1900
5912C
5913 1699 CONTINUE
5914C
5915C               *****************************************************
5916C               **  TREAT THE CASE WHEN                            **
5917C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
5918C               *****************************************************
5919C
5920      IF(ICOM.EQ.'TIC')GOTO1700
5921      IF(ICOM.EQ.'TICS')GOTO1700
5922      IF(ICOM.EQ.'XYTI')GOTO1700
5923      IF(ICOM.EQ.'YXTI')GOTO1700
5924      GOTO1799
5925C
5926 1700 CONTINUE
5927      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
5928      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
5929      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
5930      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
5931      IF(IHARG(NUMARG).EQ.'FILL')GOTO1750
5932      GOTO1760
5933C
5934 1750 CONTINUE
5935      IHOLD=IDEFFI
5936      GOTO1780
5937C
5938 1760 CONTINUE
5939      IHOLD=IHARG(NUMARG)
5940      GOTO1780
5941C
5942 1780 CONTINUE
5943      IFOUND='YES'
5944      IX1ZFI=IHOLD
5945      IX2ZFI=IHOLD
5946      IY1ZFI=IHOLD
5947      IY2ZFI=IHOLD
5948C
5949      IF(IFEEDB.EQ.'OFF')GOTO1789
5950      WRITE(ICOUT,999)
5951      CALL DPWRST('XXX','BUG ')
5952      WRITE(ICOUT,1781)
5953 1781 FORMAT('THE TIC MARK LABEL FILL (FOR ALL 4 ',
5954     1'FRAME LINES)')
5955      CALL DPWRST('XXX','BUG ')
5956      WRITE(ICOUT,1782)IHOLD
5957 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
5958      CALL DPWRST('XXX','BUG ')
5959 1789 CONTINUE
5960      GOTO1900
5961C
5962 1799 CONTINUE
5963C
5964 1900 CONTINUE
5965      RETURN
5966      END
5967      SUBROUTINE DPTLFM(ICOM,IHARG,NUMARG,
5968     1                  IDETLF,
5969     1                  IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM,
5970     1                  IFOUND,IERROR)
5971C
5972C     PURPOSE--DEFINE THE 4 TIC LABEL FORMATS CONTAINED IN THE
5973C              4 VARIABLES IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM
5974C              SUCH TIC LABEL FORMATS DEFINE THE FORMATS FOR
5975C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
5976C     INPUT  ARGUMENTS--ICOM
5977C                     --IHARG  (A  HOLLERITH VECTOR)
5978C                     --NUMARG
5979C                     --IDETLF
5980C     OUTPUT ARGUMENTS--
5981C                     --IX1ZFM = LOWER HORIZONTAL TIC LABEL FORMAT
5982C                     --IX2ZFM = UPPER HORIZONTAL TIC LABEL FORMAT
5983C                     --IY1ZFM = LEFT  VERTICAL   TIC LABEL FORMAT
5984C                     --IY2ZFM = RIGHT VERTICAL   TIC LABEL FORMAT
5985C                     --IFOUND ('YES' OR 'NO' )
5986C                     --IERROR ('YES' OR 'NO' )
5987C     WRITTEN BY--JAMES J. FILLIBEN
5988C                 STATISTICAL ENGINEERING DIVISION
5989C                 INFORMATION TECHNOLOGY LABORATORY
5990C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5991C                 GAITHERSBURG, MD 20899-8980
5992C                 PHONE--301-975-2855
5993C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5994C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5995C     LANGUAGE--ANSI FORTRAN (1977)
5996C     VERSION NUMBER--88/2
5997C     ORIGINAL VERSION--FEBRUARY  1988.
5998C     UPDATED         --JANUARY   2004. ADD SUPPORT FOR:
5999C                                           ROW LABEL
6000C                                           GROUP LABEL
6001C                                           VARIABLE
6002C     UPDATED         --APRIL     2017. ROW LABEL CAN HAVE A
6003C                                       A START ROW AND A STOP
6004C                                       ROW.  ALSO SOME RE-CODING
6005C                                       FOR BETTER READABILTY
6006C
6007C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6008C
6009      CHARACTER*4 ICOM
6010      CHARACTER*4 IHARG
6011      CHARACTER*4 IDETLF
6012      CHARACTER*4 IX1ZFM
6013      CHARACTER*4 IX2ZFM
6014      CHARACTER*4 IY1ZFM
6015      CHARACTER*4 IY2ZFM
6016      CHARACTER*4 IFOUND
6017      CHARACTER*4 IERROR
6018C
6019      CHARACTER*4 IHOLD
6020C
6021C---------------------------------------------------------------------
6022C
6023      DIMENSION IHARG(*)
6024C
6025C-----COMMON----------------------------------------------------------
6026C
6027      INCLUDE 'DPCOP2.INC'
6028C
6029C-----START POINT-----------------------------------------------------
6030C
6031      IFOUND='NO'
6032      IERROR='NO'
6033C
6034      IF(NUMARG.LE.1)GOTO1900
6035      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
6036     1IHARG(2).EQ.'FORM')GOTO1090
6037      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
6038     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'FORM')GOTO1090
6039      GOTO1900
6040 1090 CONTINUE
6041C
6042C               *****************************************************
6043C               **  TREAT THE CASE WHEN                            **
6044C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
6045C               *****************************************************
6046C
6047      IF(ICOM.EQ.'XTIC')THEN
6048        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
6049     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
6050     1     IHARG(NUMARG).EQ.'FORM')THEN
6051          IHOLD=IDETLF
6052        ELSEIF(IHARG(NUMARG).EQ.'ROWL')THEN
6053          IHOLD='ROWL'
6054        ELSEIF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')
6055     1  THEN
6056          IHOLD='ROWL'
6057        ELSEIF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')
6058     1  THEN
6059           IHOLD='GLAB'
6060        ELSEIF(IHARG(NUMARG).EQ.'VARI')THEN
6061           IHOLD='VARI'
6062        ELSE
6063          IHOLD=IHARG(NUMARG)
6064          IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
6065        ENDIF
6066C
6067        IFOUND='YES'
6068        IX1ZFM=IHOLD
6069        IX2ZFM=IHOLD
6070C
6071        IF(IFEEDB.EQ.'ON')THEN
6072          WRITE(ICOUT,999)
6073  999     FORMAT(1X)
6074          CALL DPWRST('XXX','BUG ')
6075          WRITE(ICOUT,1181)
6076 1181     FORMAT('THE TIC MARK LABEL FORMAT (FOR BOTH HORIZONTAL ',
6077     1           'FRAME LINES)')
6078          CALL DPWRST('XXX','BUG ')
6079          WRITE(ICOUT,1182)IHOLD
6080 1182     FORMAT('HAS JUST BEEN SET TO ',A4)
6081          CALL DPWRST('XXX','BUG ')
6082        ENDIF
6083        GOTO1900
6084      ENDIF
6085C
6086C               *******************************************************
6087C               **  TREAT THE CASE WHEN ONLY THE BOTTOM              **
6088C               **  HORIZONTAL TIC MARKS ARE TO BE CHANGED           **
6089C               *******************************************************
6090C
6091      IF(ICOM.EQ.'X1TI')THEN
6092        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
6093     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
6094     1     IHARG(NUMARG).EQ.'FORM')THEN
6095          IHOLD=IDETLF
6096        ELSEIF(IHARG(NUMARG).EQ.'ROWL')THEN
6097          IHOLD='ROWL'
6098        ELSEIF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')
6099     1  THEN
6100          IHOLD='ROWL'
6101        ELSEIF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')
6102     1  THEN
6103           IHOLD='GLAB'
6104        ELSEIF(IHARG(NUMARG).EQ.'VARI')THEN
6105           IHOLD='VARI'
6106        ELSE
6107          IHOLD=IHARG(NUMARG)
6108          IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
6109        ENDIF
6110C
6111        IFOUND='YES'
6112        IX1ZFM=IHOLD
6113C
6114        IF(IFEEDB.EQ.'ON')THEN
6115          WRITE(ICOUT,999)
6116          CALL DPWRST('XXX','BUG ')
6117          WRITE(ICOUT,1281)
6118 1281     FORMAT('THE TIC MARK LABEL FORMAT (FOR THE BOTTOM ',
6119     1           'HORIZONTAL FRAME LINE)')
6120          CALL DPWRST('XXX','BUG ')
6121          WRITE(ICOUT,1282)IHOLD
6122 1282     FORMAT('HAS JUST BEEN SET TO ',A4)
6123          CALL DPWRST('XXX','BUG ')
6124        ENDIF
6125        GOTO1900
6126      ENDIF
6127C
6128C               *******************************************************
6129C               **  TREAT THE CASE WHEN ONLY THE TOP                 **
6130C               **  HORIZONTAL TIC MARKS ARE TO BE CHANGED           **
6131C               *******************************************************
6132C
6133      IF(ICOM.EQ.'X2TI')THEN
6134        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
6135     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
6136     1     IHARG(NUMARG).EQ.'FORM')THEN
6137          IHOLD=IDETLF
6138        ELSEIF(IHARG(NUMARG).EQ.'ROWL')THEN
6139          IHOLD='ROWL'
6140        ELSEIF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')
6141     1  THEN
6142          IHOLD='ROWL'
6143        ELSEIF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')
6144     1  THEN
6145           IHOLD='GLAB'
6146        ELSEIF(IHARG(NUMARG).EQ.'VARI')THEN
6147           IHOLD='VARI'
6148        ELSE
6149          IHOLD=IHARG(NUMARG)
6150          IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
6151        ENDIF
6152C
6153        IFOUND='YES'
6154        IX2ZFM=IHOLD
6155C
6156        IF(IFEEDB.EQ.'ON')THEN
6157          WRITE(ICOUT,999)
6158          CALL DPWRST('XXX','BUG ')
6159          WRITE(ICOUT,1381)
6160 1381     FORMAT('THE TIC MARK LABEL FORMAT (FOR THE TOP HORIZONTAL ',
6161     1           'FRAME LINE)')
6162          CALL DPWRST('XXX','BUG ')
6163          WRITE(ICOUT,1382)IHOLD
6164 1382     FORMAT('HAS JUST BEEN SET TO ',A4)
6165          CALL DPWRST('XXX','BUG ')
6166        ENDIF
6167        GOTO1900
6168      ENDIF
6169C
6170C               *****************************************************
6171C               **  TREAT THE CASE WHEN                            **
6172C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
6173C               *****************************************************
6174C
6175      IF(ICOM.EQ.'YTIC')THEN
6176        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
6177     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
6178     1     IHARG(NUMARG).EQ.'FORM')THEN
6179          IHOLD=IDETLF
6180        ELSEIF(IHARG(NUMARG).EQ.'ROWL')THEN
6181          IHOLD='ROWL'
6182        ELSEIF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')
6183     1  THEN
6184          IHOLD='ROWL'
6185        ELSEIF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')
6186     1  THEN
6187           IHOLD='GLAB'
6188        ELSEIF(IHARG(NUMARG).EQ.'VARI')THEN
6189           IHOLD='VARI'
6190        ELSE
6191          IHOLD=IHARG(NUMARG)
6192          IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
6193        ENDIF
6194C
6195        IFOUND='YES'
6196        IY1ZFM=IHOLD
6197        IY2ZFM=IHOLD
6198C
6199        IF(IFEEDB.EQ.'ON')THEN
6200          WRITE(ICOUT,999)
6201          CALL DPWRST('XXX','BUG ')
6202          WRITE(ICOUT,1481)
6203 1481     FORMAT('THE TIC MARK LABEL FORMAT (FOR BOTH VERTICAL ',
6204     1           'FRAME LINES)')
6205          CALL DPWRST('XXX','BUG ')
6206          WRITE(ICOUT,1482)IHOLD
6207 1482     FORMAT('HAS JUST BEEN SET TO ',A4)
6208          CALL DPWRST('XXX','BUG ')
6209        ENDIF
6210        GOTO1900
6211      ENDIF
6212C
6213C               *******************************************************
6214C               **  TREAT THE CASE WHEN ONLY THE LEFT                **
6215C               **  VERTICAL   TIC MARKS ARE TO BE CHANGED           **
6216C               *******************************************************
6217C
6218      IF(ICOM.EQ.'Y1TI')THEN
6219        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
6220     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
6221     1     IHARG(NUMARG).EQ.'FORM')THEN
6222          IHOLD=IDETLF
6223        ELSEIF(IHARG(NUMARG).EQ.'ROWL')THEN
6224          IHOLD='ROWL'
6225        ELSEIF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')
6226     1  THEN
6227          IHOLD='ROWL'
6228        ELSEIF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')
6229     1  THEN
6230           IHOLD='GLAB'
6231        ELSEIF(IHARG(NUMARG).EQ.'VARI')THEN
6232           IHOLD='VARI'
6233        ELSE
6234          IHOLD=IHARG(NUMARG)
6235          IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
6236        ENDIF
6237C
6238        IFOUND='YES'
6239        IY1ZFM=IHOLD
6240C
6241        IF(IFEEDB.EQ.'ON')THEN
6242          WRITE(ICOUT,999)
6243          CALL DPWRST('XXX','BUG ')
6244          WRITE(ICOUT,1581)
6245 1581     FORMAT('THE TIC MARK LABEL FORMAT (FOR THE LEFT VERTICAL ',
6246     1           'FRAME LINE)')
6247          CALL DPWRST('XXX','BUG ')
6248          WRITE(ICOUT,1582)IHOLD
6249 1582     FORMAT('HAS JUST BEEN SET TO ',A4)
6250          CALL DPWRST('XXX','BUG ')
6251        ENDIF
6252        GOTO1900
6253      ENDIF
6254C
6255C               *******************************************************
6256C               **  TREAT THE CASE WHEN ONLY THE RIGHT               **
6257C               **  VERTICAL   TIC MARKS ARE TO BE CHANGED           **
6258C               *******************************************************
6259C
6260      IF(ICOM.EQ.'Y2TI')THEN
6261        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
6262     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
6263     1     IHARG(NUMARG).EQ.'FORM')THEN
6264          IHOLD=IDETLF
6265        ELSEIF(IHARG(NUMARG).EQ.'ROWL')THEN
6266          IHOLD='ROWL'
6267        ELSEIF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')
6268     1  THEN
6269          IHOLD='ROWL'
6270        ELSEIF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')
6271     1  THEN
6272           IHOLD='GLAB'
6273        ELSEIF(IHARG(NUMARG).EQ.'VARI')THEN
6274           IHOLD='VARI'
6275        ELSE
6276          IHOLD=IHARG(NUMARG)
6277          IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
6278        ENDIF
6279C
6280        IFOUND='YES'
6281        IY2ZFM=IHOLD
6282C
6283        IF(IFEEDB.EQ.'ON')THEN
6284          WRITE(ICOUT,999)
6285          CALL DPWRST('XXX','BUG ')
6286          WRITE(ICOUT,1681)
6287 1681     FORMAT('THE TIC MARK LABEL FORMAT (FOR THE RIGHT VERTICAL ',
6288     1           'FRAME LINE)')
6289          CALL DPWRST('XXX','BUG ')
6290          WRITE(ICOUT,1682)IHOLD
6291 1682     FORMAT('HAS JUST BEEN SET TO ',A4)
6292          CALL DPWRST('XXX','BUG ')
6293        ENDIF
6294        GOTO1900
6295      ENDIF
6296C
6297C               *****************************************************
6298C               **  TREAT THE CASE WHEN                            **
6299C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
6300C               *****************************************************
6301C
6302      IF(ICOM.EQ.'TIC'  .OR. ICOM.EQ.'TICS' .OR.
6303     1   ICOM.EQ.'XYTI' .OR. ICOM.EQ.'YXTI')THEN
6304        IF(IHARG(NUMARG).EQ.'ON'   .OR. IHARG(NUMARG).EQ.'OFF'  .OR.
6305     1     IHARG(NUMARG).EQ.'AUTO' .OR. IHARG(NUMARG).EQ.'DEFA' .OR.
6306     1     IHARG(NUMARG).EQ.'FORM')THEN
6307          IHOLD=IDETLF
6308        ELSEIF(IHARG(NUMARG).EQ.'ROWL')THEN
6309          IHOLD='ROWL'
6310        ELSEIF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')
6311     1  THEN
6312          IHOLD='ROWL'
6313        ELSEIF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')
6314     1  THEN
6315           IHOLD='GLAB'
6316        ELSEIF(IHARG(NUMARG).EQ.'VARI')THEN
6317           IHOLD='VARI'
6318        ELSE
6319          IHOLD=IHARG(NUMARG)
6320          IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
6321        ENDIF
6322C
6323        IFOUND='YES'
6324        IX1ZFM=IHOLD
6325        IX2ZFM=IHOLD
6326        IY1ZFM=IHOLD
6327        IY2ZFM=IHOLD
6328C
6329        IF(IFEEDB.EQ.'ON')THEN
6330          WRITE(ICOUT,999)
6331          CALL DPWRST('XXX','BUG ')
6332          WRITE(ICOUT,1781)
6333 1781     FORMAT('THE TIC MARK LABEL FORMAT (FOR ALL 4 ',
6334     1           'FRAME LINES)')
6335          CALL DPWRST('XXX','BUG ')
6336          WRITE(ICOUT,1782)IHOLD
6337 1782     FORMAT('HAS JUST BEEN SET TO ',A4)
6338          CALL DPWRST('XXX','BUG ')
6339        ENDIF
6340        GOTO1900
6341      ENDIF
6342C
6343 1900 CONTINUE
6344      RETURN
6345      END
6346      SUBROUTINE DPTLFO(ICOM,IHARG,NUMARG,
6347     1IDEFFO,
6348     1IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO,
6349     1IFOUND,IERROR)
6350C
6351C     PURPOSE--DEFINE THE 4 TIC LABEL FONTS CONTAINED IN THE
6352C              4 VARIABLES IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO
6353C              SUCH TIC LABEL FONTS DEFINE THE FONTS FOR
6354C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
6355C     INPUT  ARGUMENTS--ICOM
6356C                     --IHARG  (A  HOLLERITH VECTOR)
6357C                     --NUMARG
6358C                     --IDEFFO
6359C     OUTPUT ARGUMENTS--
6360C                     --IX1ZFO = LOWER HORIZONTAL TIC LABEL FONT
6361C                     --IX2ZFO = UPPER HORIZONTAL TIC LABEL FONT
6362C                     --IY1ZFO = LEFT  VERTICAL   TIC LABEL FONT
6363C                     --IY2ZFO = RIGHT VERTICAL   TIC LABEL FONT
6364C                     --IFOUND ('YES' OR 'NO' )
6365C                     --IERROR ('YES' OR 'NO' )
6366C     WRITTEN BY--ALAN HECKERT
6367C                 STATISTICAL ENGINEERING DIVISION
6368C                 INFORMATION TECHNOLOGY LABORATORY
6369C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6370C                 GAITHERSBURG, MD 20899-8980
6371C                 PHONE--301-975-2899
6372C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6373C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6374C     LANGUAGE--ANSI FORTRAN (1977)
6375C     VERSION NUMBER--89/2
6376C     ORIGINAL VERSION--JANUARY   1989.
6377C
6378C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6379C
6380      CHARACTER*4 ICOM
6381      CHARACTER*4 IHARG
6382C
6383      CHARACTER*4 IDEFFO
6384C
6385      CHARACTER*4 IX1ZFO
6386      CHARACTER*4 IX2ZFO
6387      CHARACTER*4 IY1ZFO
6388      CHARACTER*4 IY2ZFO
6389C
6390      CHARACTER*4 IFOUND
6391      CHARACTER*4 IERROR
6392C
6393      CHARACTER*4 IHOLD
6394C
6395C---------------------------------------------------------------------
6396C
6397      DIMENSION IHARG(*)
6398C
6399C-----COMMON----------------------------------------------------------
6400C
6401      INCLUDE 'DPCOP2.INC'
6402C
6403C-----START POINT-----------------------------------------------------
6404C
6405      IFOUND='NO'
6406      IERROR='NO'
6407C
6408      IF(NUMARG.LE.1)GOTO1900
6409      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
6410     1IHARG(2).EQ.'FONT')GOTO1090
6411      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
6412     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'FONT')GOTO1090
6413      GOTO1900
6414 1090 CONTINUE
6415C
6416C               *****************************************************
6417C               **  TREAT THE CASE WHEN                            **
6418C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
6419C               *****************************************************
6420C
6421      IF(ICOM.EQ.'XTIC')GOTO1100
6422      GOTO1199
6423C
6424 1100 CONTINUE
6425      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
6426      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
6427      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
6428      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
6429      IF(IHARG(NUMARG).EQ.'FONT')GOTO1150
6430      GOTO1160
6431C
6432 1150 CONTINUE
6433      IHOLD=IDEFFO
6434      GOTO1180
6435C
6436 1160 CONTINUE
6437      IHOLD=IHARG(NUMARG)
6438      GOTO1180
6439C
6440 1180 CONTINUE
6441      IFOUND='YES'
6442      IX1ZFO=IHOLD
6443      IX2ZFO=IHOLD
6444C
6445      IF(IFEEDB.EQ.'OFF')GOTO1189
6446      WRITE(ICOUT,999)
6447  999 FORMAT(1X)
6448      CALL DPWRST('XXX','BUG ')
6449      WRITE(ICOUT,1181)
6450 1181 FORMAT('THE TIC MARK LABEL FONT (FOR BOTH HORIZONTAL ',
6451     1'FRAME LINES)')
6452      CALL DPWRST('XXX','BUG ')
6453      WRITE(ICOUT,1182)IHOLD
6454 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
6455      CALL DPWRST('XXX','BUG ')
6456 1189 CONTINUE
6457      GOTO1900
6458C
6459 1199 CONTINUE
6460C
6461C               **************************************************************
6462C               **  TREAT THE CASE WHEN                                     **
6463C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
6464C               **************************************************************
6465C
6466      IF(ICOM.EQ.'X1TI')GOTO1200
6467      GOTO1299
6468C
6469 1200 CONTINUE
6470      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
6471      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
6472      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
6473      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
6474      IF(IHARG(NUMARG).EQ.'FONT')GOTO1250
6475      GOTO1260
6476C
6477 1250 CONTINUE
6478      IHOLD=IDEFFO
6479      GOTO1280
6480C
6481 1260 CONTINUE
6482      IHOLD=IHARG(NUMARG)
6483      GOTO1280
6484C
6485 1280 CONTINUE
6486      IFOUND='YES'
6487      IX1ZFO=IHOLD
6488C
6489      IF(IFEEDB.EQ.'OFF')GOTO1289
6490      WRITE(ICOUT,999)
6491      CALL DPWRST('XXX','BUG ')
6492      WRITE(ICOUT,1281)
6493 1281 FORMAT('THE TIC MARK LABEL FONT (FOR THE BOTTOM ',
6494     1'HORIZONTAL FRAME LINE)')
6495      CALL DPWRST('XXX','BUG ')
6496      WRITE(ICOUT,1282)IHOLD
6497 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
6498      CALL DPWRST('XXX','BUG ')
6499 1289 CONTINUE
6500      GOTO1900
6501C
6502 1299 CONTINUE
6503C
6504C               **************************************************************
6505C               **  TREAT THE CASE WHEN                                     **
6506C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
6507C               **************************************************************
6508C
6509      IF(ICOM.EQ.'X2TI')GOTO1300
6510      GOTO1399
6511C
6512 1300 CONTINUE
6513      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
6514      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
6515      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
6516      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
6517      IF(IHARG(NUMARG).EQ.'FONT')GOTO1350
6518      GOTO1360
6519C
6520 1350 CONTINUE
6521      IHOLD=IDEFFO
6522      GOTO1380
6523C
6524 1360 CONTINUE
6525      IHOLD=IHARG(NUMARG)
6526      GOTO1380
6527C
6528 1380 CONTINUE
6529      IFOUND='YES'
6530      IX2ZFO=IHOLD
6531C
6532      IF(IFEEDB.EQ.'OFF')GOTO1389
6533      WRITE(ICOUT,999)
6534      CALL DPWRST('XXX','BUG ')
6535      WRITE(ICOUT,1381)
6536 1381 FORMAT('THE TIC MARK LABEL FONT (FOR THE TOP HORIZONTAL ',
6537     1'FRAME LINE)')
6538      CALL DPWRST('XXX','BUG ')
6539      WRITE(ICOUT,1382)IHOLD
6540 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
6541      CALL DPWRST('XXX','BUG ')
6542 1389 CONTINUE
6543      GOTO1900
6544C
6545 1399 CONTINUE
6546C
6547C               *****************************************************
6548C               **  TREAT THE CASE WHEN                            **
6549C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
6550C               *****************************************************
6551C
6552      IF(ICOM.EQ.'YTIC')GOTO1400
6553      GOTO1499
6554C
6555 1400 CONTINUE
6556      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
6557      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
6558      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
6559      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
6560      IF(IHARG(NUMARG).EQ.'FONT')GOTO1450
6561      GOTO1460
6562C
6563 1450 CONTINUE
6564      IHOLD=IDEFFO
6565      GOTO1480
6566C
6567 1460 CONTINUE
6568      IHOLD=IHARG(NUMARG)
6569      GOTO1480
6570C
6571 1480 CONTINUE
6572      IFOUND='YES'
6573      IY1ZFO=IHOLD
6574      IY2ZFO=IHOLD
6575C
6576      IF(IFEEDB.EQ.'OFF')GOTO1489
6577      WRITE(ICOUT,999)
6578      CALL DPWRST('XXX','BUG ')
6579      WRITE(ICOUT,1481)
6580 1481 FORMAT('THE TIC MARK LABEL FONT (FOR BOTH VERTICAL ',
6581     1'FRAME LINES)')
6582      CALL DPWRST('XXX','BUG ')
6583      WRITE(ICOUT,1482)IHOLD
6584 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
6585      CALL DPWRST('XXX','BUG ')
6586 1489 CONTINUE
6587      GOTO1900
6588C
6589 1499 CONTINUE
6590C
6591C               **************************************************************
6592C               **  TREAT THE CASE WHEN                                     **
6593C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
6594C               **************************************************************
6595C
6596      IF(ICOM.EQ.'Y1TI')GOTO1500
6597      GOTO1599
6598C
6599 1500 CONTINUE
6600      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
6601      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
6602      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
6603      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
6604      IF(IHARG(NUMARG).EQ.'FONT')GOTO1550
6605      GOTO1560
6606C
6607 1550 CONTINUE
6608      IHOLD=IDEFFO
6609      GOTO1580
6610C
6611 1560 CONTINUE
6612      IHOLD=IHARG(NUMARG)
6613      GOTO1580
6614C
6615 1580 CONTINUE
6616      IFOUND='YES'
6617      IY1ZFO=IHOLD
6618C
6619      IF(IFEEDB.EQ.'OFF')GOTO1589
6620      WRITE(ICOUT,999)
6621      CALL DPWRST('XXX','BUG ')
6622      WRITE(ICOUT,1581)
6623 1581 FORMAT('THE TIC MARK LABEL FONT (FOR THE LEFT VERTICAL ',
6624     1'FRAME LINE)')
6625      CALL DPWRST('XXX','BUG ')
6626      WRITE(ICOUT,1582)IHOLD
6627 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
6628      CALL DPWRST('XXX','BUG ')
6629 1589 CONTINUE
6630      GOTO1900
6631C
6632 1599 CONTINUE
6633C
6634C               **************************************************************
6635C               **  TREAT THE CASE WHEN                                     **
6636C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
6637C               **************************************************************
6638C
6639      IF(ICOM.EQ.'Y2TI')GOTO1600
6640      GOTO1699
6641C
6642 1600 CONTINUE
6643      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
6644      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
6645      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
6646      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
6647      IF(IHARG(NUMARG).EQ.'FONT')GOTO1650
6648      GOTO1660
6649C
6650 1650 CONTINUE
6651      IHOLD=IDEFFO
6652      GOTO1680
6653C
6654 1660 CONTINUE
6655      IHOLD=IHARG(NUMARG)
6656      GOTO1680
6657C
6658 1680 CONTINUE
6659      IFOUND='YES'
6660      IY2ZFO=IHOLD
6661C
6662      IF(IFEEDB.EQ.'OFF')GOTO1689
6663      WRITE(ICOUT,999)
6664      CALL DPWRST('XXX','BUG ')
6665      WRITE(ICOUT,1681)
6666 1681 FORMAT('THE TIC MARK LABEL FONT (FOR THE RIGHT VERTICAL ',
6667     1'FRAME LINE)')
6668      CALL DPWRST('XXX','BUG ')
6669      WRITE(ICOUT,1682)IHOLD
6670 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
6671      CALL DPWRST('XXX','BUG ')
6672 1689 CONTINUE
6673      GOTO1900
6674C
6675 1699 CONTINUE
6676C
6677C               *****************************************************
6678C               **  TREAT THE CASE WHEN                            **
6679C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
6680C               *****************************************************
6681C
6682      IF(ICOM.EQ.'TIC')GOTO1700
6683      IF(ICOM.EQ.'TICS')GOTO1700
6684      IF(ICOM.EQ.'XYTI')GOTO1700
6685      IF(ICOM.EQ.'YXTI')GOTO1700
6686      GOTO1799
6687C
6688 1700 CONTINUE
6689      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
6690      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
6691      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
6692      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
6693      IF(IHARG(NUMARG).EQ.'FONT')GOTO1750
6694      GOTO1760
6695C
6696 1750 CONTINUE
6697      IHOLD=IDEFFO
6698      GOTO1780
6699C
6700 1760 CONTINUE
6701      IHOLD=IHARG(NUMARG)
6702      GOTO1780
6703C
6704 1780 CONTINUE
6705      IFOUND='YES'
6706      IX1ZFO=IHOLD
6707      IX2ZFO=IHOLD
6708      IY1ZFO=IHOLD
6709      IY2ZFO=IHOLD
6710C
6711      IF(IFEEDB.EQ.'OFF')GOTO1789
6712      WRITE(ICOUT,999)
6713      CALL DPWRST('XXX','BUG ')
6714      WRITE(ICOUT,1781)
6715 1781 FORMAT('THE TIC MARK LABEL FONT (FOR ALL 4 ',
6716     1'FRAME LINES)')
6717      CALL DPWRST('XXX','BUG ')
6718      WRITE(ICOUT,1782)IHOLD
6719 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
6720      CALL DPWRST('XXX','BUG ')
6721 1789 CONTINUE
6722      GOTO1900
6723C
6724 1799 CONTINUE
6725C
6726 1900 CONTINUE
6727      RETURN
6728      END
6729      SUBROUTINE DPTLHW(ICOM,IHARG,IARGT,ARG,NUMARG,
6730     1PDEFHE,PDEFWI,
6731     1PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
6732     1PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
6733     1PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
6734     1PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
6735     1IFOUND,IERROR)
6736C
6737C     PURPOSE--DEFINE THE TIC MARK LABEL HEIGHT AND WIDTH SWITCHES
6738C              FOR ANY OF THE 4 FRAME LINES.
6739C              SUCH TIC MARK SWITCHES DEFINE THE HEIGHT AND WIDTH
6740C              OF THE TIC MARK LABELS ON THE 4 FRAME LINES OF A PLOT.
6741C     INPUT  ARGUMENTS--ICOM
6742C                     --IHARG  (A  HOLLERITH VECTOR)
6743C                     --IARGT  (A  HOLLERITH VECTOR)
6744C                     --ARG    (A  FLOATING POINT VECTOR)
6745C                     --NUMARG
6746C                     --PDEFHE
6747C                     --PDEFWI
6748C     OUTPUT ARGUMENTS--
6749C                     --PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
6750C                     --PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
6751C                     --PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
6752C                     --PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
6753C                     --IFOUND ('YES' OR 'NO' )
6754C                     --IERROR ('YES' OR 'NO' )
6755C     WRITTEN BY--JAMES J. FILLIBEN
6756C                 STATISTICAL ENGINEERING DIVISION
6757C                 INFORMATION TECHNOLOGY LABORATORY
6758C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6759C                 GAITHERSBURG, MD 20899-8980
6760C                 PHONE--301-975-2855
6761C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6762C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6763C     LANGUAGE--ANSI FORTRAN (1977)
6764C     VERSION NUMBER--82/7
6765C     ORIGINAL VERSION--JULY      1987.
6766C     UPDATED         --DECEMBER  1988.    ADD DEFAULT WIDTH
6767C
6768C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6769C
6770      CHARACTER*4 ICOM
6771      CHARACTER*4 IHARG
6772      CHARACTER*4 IARGT
6773      CHARACTER*4 IFOUND
6774      CHARACTER*4 IERROR
6775C
6776C---------------------------------------------------------------------
6777C
6778      DIMENSION IHARG(*)
6779      DIMENSION IARGT(*)
6780      DIMENSION ARG(*)
6781C
6782C-----COMMON----------------------------------------------------------
6783C
6784      INCLUDE 'DPCOP2.INC'
6785C
6786C-----START POINT-----------------------------------------------------
6787C
6788      IFOUND='NO'
6789      IERROR='NO'
6790C
6791      NUMAM1=NUMARG-1
6792C
6793CCCCC IF(NUMARG.LE.1)GOTO1900
6794      IF(NUMARG.LE.1)GOTO9000
6795      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
6796     1IHARG(2).EQ.'HW')GOTO1090
6797      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
6798     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'HW')GOTO1090
6799CCCCC GOTO1900
6800      GOTO9000
6801 1090 CONTINUE
6802C
6803C               *****************************************************
6804C               **  TREAT THE CASE WHEN                            **
6805C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
6806C               *****************************************************
6807C
6808      IF(ICOM.EQ.'XTIC')GOTO1100
6809      GOTO1199
6810C
6811 1100 CONTINUE
6812      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
6813      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
6814      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
6815      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
6816      IF(IHARG(NUMARG).EQ.'HW')GOTO1150
6817      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
6818     1   IARGT(NUMARG).EQ.'NUMB')GOTO1160
6819      IERROR='YES'
6820      GOTO9000
6821C
6822 1150 CONTINUE
6823      HOLD1=PDEFHE
6824      HOLD2=PDEFWI
6825      GOTO1180
6826C
6827 1160 CONTINUE
6828      HOLD1=ARG(NUMAM1)
6829      HOLD2=ARG(NUMARG)
6830      GOTO1180
6831C
6832 1180 CONTINUE
6833      IFOUND='YES'
6834      PX1ZHE=HOLD1
6835      PX2ZHE=HOLD1
6836      PX1ZWI=HOLD2
6837      PX2ZWI=HOLD2
6838C
6839      IF(IFEEDB.EQ.'OFF')GOTO1189
6840      WRITE(ICOUT,999)
6841  999 FORMAT(1X)
6842      CALL DPWRST('XXX','BUG ')
6843      WRITE(ICOUT,1181)
6844 1181 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR BOTH ',
6845     1'HORIZONTAL FRAME LINES)')
6846      CALL DPWRST('XXX','BUG ')
6847      WRITE(ICOUT,1182)HOLD1,HOLD2
6848 1182 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
6849      CALL DPWRST('XXX','BUG ')
6850 1189 CONTINUE
6851      GOTO1900
6852C
6853 1199 CONTINUE
6854C
6855C               **************************************************************
6856C               **  TREAT THE CASE WHEN                                     **
6857C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
6858C               **************************************************************
6859C
6860      IF(ICOM.EQ.'X1TI')GOTO1200
6861      GOTO1299
6862C
6863 1200 CONTINUE
6864      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
6865      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
6866      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
6867      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
6868      IF(IHARG(NUMARG).EQ.'HW')GOTO1250
6869      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
6870     1   IARGT(NUMARG).EQ.'NUMB')GOTO1260
6871      IERROR='YES'
6872      GOTO9000
6873C
6874 1250 CONTINUE
6875      HOLD1=PDEFHE
6876      HOLD2=PDEFWI
6877      GOTO1280
6878C
6879 1260 CONTINUE
6880      HOLD1=ARG(NUMAM1)
6881      HOLD2=ARG(NUMARG)
6882      GOTO1280
6883C
6884 1280 CONTINUE
6885      IFOUND='YES'
6886      PX1ZHE=HOLD1
6887      PX1ZWI=HOLD2
6888C
6889      IF(IFEEDB.EQ.'OFF')GOTO1289
6890      WRITE(ICOUT,999)
6891      CALL DPWRST('XXX','BUG ')
6892      WRITE(ICOUT,1281)
6893 1281 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR THE BOTTOM ',
6894     1'HORIZONTAL FRAME LINE)')
6895      CALL DPWRST('XXX','BUG ')
6896      WRITE(ICOUT,1282)HOLD1,HOLD2
6897 1282 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
6898      CALL DPWRST('XXX','BUG ')
6899 1289 CONTINUE
6900      GOTO1900
6901C
6902 1299 CONTINUE
6903C
6904C               **************************************************************
6905C               **  TREAT THE CASE WHEN                                     **
6906C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
6907C               **************************************************************
6908C
6909      IF(ICOM.EQ.'X2TI')GOTO1300
6910      GOTO1399
6911C
6912 1300 CONTINUE
6913      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
6914      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
6915      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
6916      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
6917      IF(IHARG(NUMARG).EQ.'HW')GOTO1350
6918      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
6919     1   IARGT(NUMARG).EQ.'NUMB')GOTO1360
6920      IERROR='YES'
6921      GOTO9000
6922C
6923 1350 CONTINUE
6924      HOLD1=PDEFHE
6925      HOLD2=PDEFWI
6926      GOTO1380
6927C
6928 1360 CONTINUE
6929      HOLD1=ARG(NUMAM1)
6930      HOLD2=ARG(NUMARG)
6931      GOTO1380
6932C
6933 1380 CONTINUE
6934      IFOUND='YES'
6935      PX2ZHE=HOLD1
6936      PX2ZWI=HOLD2
6937C
6938      IF(IFEEDB.EQ.'OFF')GOTO1389
6939      WRITE(ICOUT,999)
6940      CALL DPWRST('XXX','BUG ')
6941      WRITE(ICOUT,1381)
6942 1381 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR THE TOP ',
6943     1'HORIZONTAL FRAME LINE)')
6944      CALL DPWRST('XXX','BUG ')
6945      WRITE(ICOUT,1382)HOLD1,HOLD2
6946 1382 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
6947      CALL DPWRST('XXX','BUG ')
6948 1389 CONTINUE
6949      GOTO1900
6950C
6951 1399 CONTINUE
6952C
6953C               *****************************************************
6954C               **  TREAT THE CASE WHEN                            **
6955C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
6956C               *****************************************************
6957C
6958      IF(ICOM.EQ.'YTIC')GOTO1400
6959      GOTO1499
6960C
6961 1400 CONTINUE
6962      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
6963      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
6964      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
6965      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
6966      IF(IHARG(NUMARG).EQ.'HW')GOTO1450
6967      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
6968     1   IARGT(NUMARG).EQ.'NUMB')GOTO1460
6969      IERROR='YES'
6970      GOTO9000
6971C
6972 1450 CONTINUE
6973      HOLD1=PDEFHE
6974      HOLD2=PDEFWI
6975      GOTO1480
6976C
6977 1460 CONTINUE
6978      HOLD1=ARG(NUMAM1)
6979      HOLD2=ARG(NUMARG)
6980      GOTO1480
6981C
6982 1480 CONTINUE
6983      IFOUND='YES'
6984      PY1ZHE=HOLD1
6985      PY2ZHE=HOLD1
6986      PY1ZWI=HOLD2
6987      PY2ZWI=HOLD2
6988C
6989      IF(IFEEDB.EQ.'OFF')GOTO1489
6990      WRITE(ICOUT,999)
6991      CALL DPWRST('XXX','BUG ')
6992      WRITE(ICOUT,1481)
6993 1481 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR BOTH ',
6994     1'VERTICAL FRAME LINES)')
6995      CALL DPWRST('XXX','BUG ')
6996      WRITE(ICOUT,1482)HOLD1,HOLD2
6997 1482 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
6998      CALL DPWRST('XXX','BUG ')
6999 1489 CONTINUE
7000      GOTO1900
7001C
7002 1499 CONTINUE
7003C
7004C               **************************************************************
7005C               **  TREAT THE CASE WHEN                                     **
7006C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
7007C               **************************************************************
7008C
7009      IF(ICOM.EQ.'Y1TI')GOTO1500
7010      GOTO1599
7011C
7012 1500 CONTINUE
7013      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
7014      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
7015      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
7016      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
7017      IF(IHARG(NUMARG).EQ.'HW')GOTO1550
7018      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
7019     1   IARGT(NUMARG).EQ.'NUMB')GOTO1560
7020      IERROR='YES'
7021      GOTO9000
7022C
7023 1550 CONTINUE
7024      HOLD1=PDEFHE
7025      HOLD2=PDEFWI
7026      GOTO1580
7027C
7028 1560 CONTINUE
7029      HOLD1=ARG(NUMAM1)
7030      HOLD2=ARG(NUMARG)
7031      GOTO1580
7032C
7033 1580 CONTINUE
7034      IFOUND='YES'
7035      PY1ZHE=HOLD1
7036      PY1ZWI=HOLD2
7037C
7038      IF(IFEEDB.EQ.'OFF')GOTO1589
7039      WRITE(ICOUT,999)
7040      CALL DPWRST('XXX','BUG ')
7041      WRITE(ICOUT,1581)
7042 1581 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR THE LEFT ',
7043     1'VERTICAL FRAME LINE)')
7044      CALL DPWRST('XXX','BUG ')
7045      WRITE(ICOUT,1582)HOLD1,HOLD2
7046 1582 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
7047      CALL DPWRST('XXX','BUG ')
7048 1589 CONTINUE
7049      GOTO1900
7050C
7051 1599 CONTINUE
7052C
7053C               **************************************************************
7054C               **  TREAT THE CASE WHEN                                     **
7055C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
7056C               **************************************************************
7057C
7058      IF(ICOM.EQ.'Y2TI')GOTO1600
7059      GOTO1699
7060C
7061 1600 CONTINUE
7062      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
7063      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
7064      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
7065      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
7066      IF(IHARG(NUMARG).EQ.'HW')GOTO1650
7067      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
7068     1   IARGT(NUMARG).EQ.'NUMB')GOTO1660
7069      IERROR='YES'
7070      GOTO9000
7071C
7072 1650 CONTINUE
7073      HOLD1=PDEFHE
7074      HOLD2=PDEFWI
7075      GOTO1680
7076C
7077 1660 CONTINUE
7078      HOLD1=ARG(NUMAM1)
7079      HOLD2=ARG(NUMARG)
7080      GOTO1680
7081C
7082 1680 CONTINUE
7083      IFOUND='YES'
7084      PY2ZHE=HOLD1
7085      PY2ZWI=HOLD2
7086C
7087      IF(IFEEDB.EQ.'OFF')GOTO1689
7088      WRITE(ICOUT,999)
7089      CALL DPWRST('XXX','BUG ')
7090      WRITE(ICOUT,1681)
7091 1681 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR THE RIGHT ',
7092     1'VERTICAL FRAME LINE)')
7093      CALL DPWRST('XXX','BUG ')
7094      WRITE(ICOUT,1682)HOLD1,HOLD2
7095 1682 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
7096      CALL DPWRST('XXX','BUG ')
7097 1689 CONTINUE
7098      GOTO1900
7099C
7100 1699 CONTINUE
7101C
7102C               *****************************************************
7103C               **  TREAT THE CASE WHEN                            **
7104C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
7105C               *****************************************************
7106C
7107      IF(ICOM.EQ.'TIC')GOTO1700
7108      IF(ICOM.EQ.'TICS')GOTO1700
7109      IF(ICOM.EQ.'XYTI')GOTO1700
7110      IF(ICOM.EQ.'YXTI')GOTO1700
7111      GOTO1799
7112C
7113 1700 CONTINUE
7114      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
7115      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
7116      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
7117      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
7118      IF(IHARG(NUMARG).EQ.'HW')GOTO1750
7119      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
7120     1   IARGT(NUMARG).EQ.'NUMB')GOTO1760
7121      IERROR='YES'
7122      GOTO9000
7123C
7124 1750 CONTINUE
7125      HOLD1=PDEFHE
7126      HOLD2=PDEFWI
7127      GOTO1780
7128C
7129 1760 CONTINUE
7130      HOLD1=ARG(NUMAM1)
7131      HOLD2=ARG(NUMARG)
7132      GOTO1780
7133C
7134 1780 CONTINUE
7135      IFOUND='YES'
7136      PX1ZHE=HOLD1
7137      PX2ZHE=HOLD1
7138      PY1ZHE=HOLD1
7139      PY2ZHE=HOLD1
7140      PX1ZWI=HOLD2
7141      PX2ZWI=HOLD2
7142      PY1ZWI=HOLD2
7143      PY2ZWI=HOLD2
7144C
7145      IF(IFEEDB.EQ.'OFF')GOTO1789
7146      WRITE(ICOUT,999)
7147      CALL DPWRST('XXX','BUG ')
7148      WRITE(ICOUT,1781)
7149 1781 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR ',
7150     1'ALL 4 FRAME LINES)')
7151      CALL DPWRST('XXX','BUG ')
7152      WRITE(ICOUT,1782)HOLD1,HOLD2
7153 1782 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
7154      CALL DPWRST('XXX','BUG ')
7155 1789 CONTINUE
7156      GOTO1900
7157C
7158 1799 CONTINUE
7159C
7160 1900 CONTINUE
7161C
7162      PX1ZVG=PX1ZHE*0.375
7163      PX2ZVG=PX2ZHE*0.375
7164      PY1ZVG=PY1ZHE*0.375
7165      PY2ZVG=PY2ZHE*0.375
7166C
7167      PX1ZHG=PX1ZHE*0.125
7168      PX2ZHG=PX2ZHE*0.125
7169      PY1ZHG=PY1ZHE*0.125
7170      PY2ZHG=PY2ZHE*0.125
7171      GOTO9000
7172C
7173 9000 CONTINUE
7174      RETURN
7175      END
7176      SUBROUTINE DPTLJU(ICOM,IHARG,NUMARG,
7177     1IDEFJU,
7178     1IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU,
7179     1IFOUND,IERROR)
7180C
7181C     PURPOSE--DEFINE THE 4 TIC LABEL JUSTIFICATIONS CONTAINED IN THE
7182C              4 VARIABLES IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU
7183C              SUCH TIC LABEL JUSTIFICATIONS DEFINE THE JUSTIFICATIONS FOR
7184C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
7185C     INPUT  ARGUMENTS--ICOM
7186C                     --IHARG  (A  HOLLERITH VECTOR)
7187C                     --NUMARG
7188C                     --IDEFJU
7189C     OUTPUT ARGUMENTS--
7190C                     --IX1ZJU = LOWER HORIZONTAL TIC LABEL JUSTIFICATION
7191C                     --IX2ZJU = UPPER HORIZONTAL TIC LABEL JUSTIFICATION
7192C                     --IY1ZJU = LEFT  VERTICAL   TIC LABEL JUSTIFICATION
7193C                     --IY2ZJU = RIGHT VERTICAL   TIC LABEL JUSTIFICATION
7194C                     --IFOUND ('YES' OR 'NO' )
7195C                     --IERROR ('YES' OR 'NO' )
7196C     WRITTEN BY--ALAN HECKERT
7197C                 STATISTICAL ENGINEERING DIVISION
7198C                 INFORMATION TECHNOLOGY LABORATORY
7199C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7200C                 GAITHERSBURG, MD 20899-8980
7201C                 PHONE--301-975-2899
7202C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7203C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7204C     LANGUAGE--ANSI FORTRAN (1977)
7205C     VERSION NUMBER--89/2
7206C     ORIGINAL VERSION--JANUARY   1989.
7207C
7208C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
7209C
7210      CHARACTER*4 ICOM
7211      CHARACTER*4 IHARG
7212C
7213      CHARACTER*4 IDEFJU
7214C
7215      CHARACTER*4 IX1ZJU
7216      CHARACTER*4 IX2ZJU
7217      CHARACTER*4 IY1ZJU
7218      CHARACTER*4 IY2ZJU
7219C
7220      CHARACTER*4 IFOUND
7221      CHARACTER*4 IERROR
7222C
7223      CHARACTER*4 IHOLD
7224C
7225C---------------------------------------------------------------------
7226C
7227      DIMENSION IHARG(*)
7228C
7229C-----COMMON----------------------------------------------------------
7230C
7231      INCLUDE 'DPCOP2.INC'
7232C
7233C-----START POINT-----------------------------------------------------
7234C
7235      IFOUND='NO'
7236      IERROR='NO'
7237C
7238      IF(NUMARG.LE.1)GOTO1900
7239      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
7240     1IHARG(2).EQ.'JUST')GOTO1090
7241      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
7242     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'JUST')GOTO1090
7243      GOTO1900
7244 1090 CONTINUE
7245C
7246C               *****************************************************
7247C               **  TREAT THE CASE WHEN                            **
7248C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
7249C               *****************************************************
7250C
7251      IF(ICOM.EQ.'XTIC')GOTO1100
7252      GOTO1199
7253C
7254 1100 CONTINUE
7255      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
7256      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
7257      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
7258      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
7259      IF(IHARG(NUMARG).EQ.'JUST')GOTO1150
7260      GOTO1160
7261C
7262 1150 CONTINUE
7263      IHOLD=IDEFJU
7264      GOTO1180
7265C
7266 1160 CONTINUE
7267      IHOLD=IHARG(NUMARG)
7268      GOTO1180
7269C
7270 1180 CONTINUE
7271      IFOUND='YES'
7272      IX1ZJU=IHOLD
7273      IX2ZJU=IHOLD
7274C
7275      IF(IFEEDB.EQ.'OFF')GOTO1189
7276      WRITE(ICOUT,999)
7277  999 FORMAT(1X)
7278      CALL DPWRST('XXX','BUG ')
7279      WRITE(ICOUT,1181)
7280 1181 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR BOTH ',
7281     1'HORIZONTAL FRAME LINES)')
7282      CALL DPWRST('XXX','BUG ')
7283      WRITE(ICOUT,1182)IHOLD
7284 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
7285      CALL DPWRST('XXX','BUG ')
7286 1189 CONTINUE
7287      GOTO1900
7288C
7289 1199 CONTINUE
7290C
7291C               **************************************************************
7292C               **  TREAT THE CASE WHEN                                     **
7293C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
7294C               **************************************************************
7295C
7296      IF(ICOM.EQ.'X1TI')GOTO1200
7297      GOTO1299
7298C
7299 1200 CONTINUE
7300      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
7301      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
7302      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
7303      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
7304      IF(IHARG(NUMARG).EQ.'JUST')GOTO1250
7305      GOTO1260
7306C
7307 1250 CONTINUE
7308      IHOLD=IDEFJU
7309      GOTO1280
7310C
7311 1260 CONTINUE
7312      IHOLD=IHARG(NUMARG)
7313      GOTO1280
7314C
7315 1280 CONTINUE
7316      IFOUND='YES'
7317      IX1ZJU=IHOLD
7318C
7319      IF(IFEEDB.EQ.'OFF')GOTO1289
7320      WRITE(ICOUT,999)
7321      CALL DPWRST('XXX','BUG ')
7322      WRITE(ICOUT,1281)
7323 1281 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR THE BOTTOM ',
7324     1'HORIZONTAL FRAME LINE)')
7325      CALL DPWRST('XXX','BUG ')
7326      WRITE(ICOUT,1282)IHOLD
7327 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
7328      CALL DPWRST('XXX','BUG ')
7329 1289 CONTINUE
7330      GOTO1900
7331C
7332 1299 CONTINUE
7333C
7334C               **************************************************************
7335C               **  TREAT THE CASE WHEN                                     **
7336C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
7337C               **************************************************************
7338C
7339      IF(ICOM.EQ.'X2TI')GOTO1300
7340      GOTO1399
7341C
7342 1300 CONTINUE
7343      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
7344      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
7345      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
7346      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
7347      IF(IHARG(NUMARG).EQ.'JUST')GOTO1350
7348      GOTO1360
7349C
7350 1350 CONTINUE
7351      IHOLD=IDEFJU
7352      GOTO1380
7353C
7354 1360 CONTINUE
7355      IHOLD=IHARG(NUMARG)
7356      GOTO1380
7357C
7358 1380 CONTINUE
7359      IFOUND='YES'
7360      IX2ZJU=IHOLD
7361C
7362      IF(IFEEDB.EQ.'OFF')GOTO1389
7363      WRITE(ICOUT,999)
7364      CALL DPWRST('XXX','BUG ')
7365      WRITE(ICOUT,1381)
7366 1381 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR THE TOP ',
7367     1'HORIZONTAL FRAME LINE)')
7368      CALL DPWRST('XXX','BUG ')
7369      WRITE(ICOUT,1382)IHOLD
7370 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
7371      CALL DPWRST('XXX','BUG ')
7372 1389 CONTINUE
7373      GOTO1900
7374C
7375 1399 CONTINUE
7376C
7377C               *****************************************************
7378C               **  TREAT THE CASE WHEN                            **
7379C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
7380C               *****************************************************
7381C
7382      IF(ICOM.EQ.'YTIC')GOTO1400
7383      GOTO1499
7384C
7385 1400 CONTINUE
7386      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
7387      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
7388      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
7389      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
7390      IF(IHARG(NUMARG).EQ.'JUST')GOTO1450
7391      GOTO1460
7392C
7393 1450 CONTINUE
7394      IHOLD=IDEFJU
7395      GOTO1480
7396C
7397 1460 CONTINUE
7398      IHOLD=IHARG(NUMARG)
7399      GOTO1480
7400C
7401 1480 CONTINUE
7402      IFOUND='YES'
7403      IY1ZJU=IHOLD
7404      IY2ZJU=IHOLD
7405C
7406      IF(IFEEDB.EQ.'OFF')GOTO1489
7407      WRITE(ICOUT,999)
7408      CALL DPWRST('XXX','BUG ')
7409      WRITE(ICOUT,1481)
7410 1481 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR BOTH VERTICAL ',
7411     1'FRAME LINES)')
7412      CALL DPWRST('XXX','BUG ')
7413      WRITE(ICOUT,1482)IHOLD
7414 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
7415      CALL DPWRST('XXX','BUG ')
7416 1489 CONTINUE
7417      GOTO1900
7418C
7419 1499 CONTINUE
7420C
7421C               **************************************************************
7422C               **  TREAT THE CASE WHEN                                     **
7423C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
7424C               **************************************************************
7425C
7426      IF(ICOM.EQ.'Y1TI')GOTO1500
7427      GOTO1599
7428C
7429 1500 CONTINUE
7430      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
7431      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
7432      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
7433      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
7434      IF(IHARG(NUMARG).EQ.'JUST')GOTO1550
7435      GOTO1560
7436C
7437 1550 CONTINUE
7438      IHOLD=IDEFJU
7439      GOTO1580
7440C
7441 1560 CONTINUE
7442      IHOLD=IHARG(NUMARG)
7443      GOTO1580
7444C
7445 1580 CONTINUE
7446      IFOUND='YES'
7447      IY1ZJU=IHOLD
7448C
7449      IF(IFEEDB.EQ.'OFF')GOTO1589
7450      WRITE(ICOUT,999)
7451      CALL DPWRST('XXX','BUG ')
7452      WRITE(ICOUT,1581)
7453 1581 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR THE LEFT ',
7454     1'VERTICAL FRAME LINE)')
7455      CALL DPWRST('XXX','BUG ')
7456      WRITE(ICOUT,1582)IHOLD
7457 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
7458      CALL DPWRST('XXX','BUG ')
7459 1589 CONTINUE
7460      GOTO1900
7461C
7462 1599 CONTINUE
7463C
7464C               **************************************************************
7465C               **  TREAT THE CASE WHEN                                     **
7466C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
7467C               **************************************************************
7468C
7469      IF(ICOM.EQ.'Y2TI')GOTO1600
7470      GOTO1699
7471C
7472 1600 CONTINUE
7473      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
7474      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
7475      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
7476      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
7477      IF(IHARG(NUMARG).EQ.'JUST')GOTO1650
7478      GOTO1660
7479C
7480 1650 CONTINUE
7481      IHOLD=IDEFJU
7482      GOTO1680
7483C
7484 1660 CONTINUE
7485      IHOLD=IHARG(NUMARG)
7486      GOTO1680
7487C
7488 1680 CONTINUE
7489      IFOUND='YES'
7490      IY2ZJU=IHOLD
7491C
7492      IF(IFEEDB.EQ.'OFF')GOTO1689
7493      WRITE(ICOUT,999)
7494      CALL DPWRST('XXX','BUG ')
7495      WRITE(ICOUT,1681)
7496 1681 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR THE RIGHT ',
7497     1'VERTICAL FRAME LINE)')
7498      CALL DPWRST('XXX','BUG ')
7499      WRITE(ICOUT,1682)IHOLD
7500 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
7501      CALL DPWRST('XXX','BUG ')
7502 1689 CONTINUE
7503      GOTO1900
7504C
7505 1699 CONTINUE
7506C
7507C               *****************************************************
7508C               **  TREAT THE CASE WHEN                            **
7509C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
7510C               *****************************************************
7511C
7512      IF(ICOM.EQ.'TIC')GOTO1700
7513      IF(ICOM.EQ.'TICS')GOTO1700
7514      IF(ICOM.EQ.'XYTI')GOTO1700
7515      IF(ICOM.EQ.'YXTI')GOTO1700
7516      GOTO1799
7517C
7518 1700 CONTINUE
7519      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
7520      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
7521      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
7522      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
7523      IF(IHARG(NUMARG).EQ.'JUST')GOTO1750
7524      GOTO1760
7525C
7526 1750 CONTINUE
7527      IHOLD=IDEFJU
7528      GOTO1780
7529C
7530 1760 CONTINUE
7531      IHOLD=IHARG(NUMARG)
7532      GOTO1780
7533C
7534 1780 CONTINUE
7535      IFOUND='YES'
7536      IX1ZJU=IHOLD
7537      IX2ZJU=IHOLD
7538      IY1ZJU=IHOLD
7539      IY2ZJU=IHOLD
7540C
7541      IF(IFEEDB.EQ.'OFF')GOTO1789
7542      WRITE(ICOUT,999)
7543      CALL DPWRST('XXX','BUG ')
7544      WRITE(ICOUT,1781)
7545 1781 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR ALL 4 ',
7546     1'FRAME LINES)')
7547      CALL DPWRST('XXX','BUG ')
7548      WRITE(ICOUT,1782)IHOLD
7549 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
7550      CALL DPWRST('XXX','BUG ')
7551 1789 CONTINUE
7552      GOTO1900
7553C
7554 1799 CONTINUE
7555C
7556 1900 CONTINUE
7557      RETURN
7558      END
7559      SUBROUTINE DPTLSZ(ICOM,IHARG,IARGT,ARG,NUMARG,
7560     1PDEFHE,PDEFWI,
7561     1PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
7562     1PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
7563     1PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
7564     1PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
7565     1IFOUND,IERROR)
7566C
7567C     PURPOSE--DEFINE THE TIC MARK LABEL SIZE SWITCHES
7568C              FOR ANY OF THE 4 FRAME LINES.
7569C              SUCH TIC MARK SWITCHES DEFINE THE SIZE (HEIGHT)
7570C              OF THE TIC MARK LABELS ON THE 4 FRAME LINES OF A PLOT.
7571C     INPUT  ARGUMENTS--ICOM
7572C                     --IHARG  (A  HOLLERITH VECTOR)
7573C                     --IARGT  (A  HOLLERITH VECTOR)
7574C                     --ARG    (A  FLOATING POINT VECTOR)
7575C                     --NUMARG
7576C                     --PDEFHE
7577C     OUTPUT ARGUMENTS--
7578C                     --PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
7579C                     --PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
7580C                     --PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
7581C                     --PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
7582C                     --IFOUND ('YES' OR 'NO' )
7583C                     --IERROR ('YES' OR 'NO' )
7584C     WRITTEN BY--JAMES J. FILLIBEN
7585C                 STATISTICAL ENGINEERING DIVISION
7586C                 INFORMATION TECHNOLOGY LABORATORY
7587C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7588C                 GAITHERSBURG, MD 20899-8980
7589C                 PHONE--301-975-2855
7590C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7591C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7592C     LANGUAGE--ANSI FORTRAN (1977)
7593C     VERSION NUMBER--82/7
7594C     ORIGINAL VERSION--OCTOBER   1980.
7595C     UPDATED         --MAY       1982.
7596C     UPDATED         --DECEMBER  1988.  DEFAULT WIDTH
7597C
7598C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
7599C
7600      CHARACTER*4 ICOM
7601      CHARACTER*4 IHARG
7602      CHARACTER*4 IARGT
7603      CHARACTER*4 IFOUND
7604      CHARACTER*4 IERROR
7605C
7606C---------------------------------------------------------------------
7607C
7608      DIMENSION IHARG(*)
7609      DIMENSION IARGT(*)
7610      DIMENSION ARG(*)
7611C
7612C-----COMMON----------------------------------------------------------
7613C
7614      INCLUDE 'DPCOP2.INC'
7615C
7616C-----START POINT-----------------------------------------------------
7617C
7618      IFOUND='NO'
7619      IERROR='NO'
7620C
7621CCCCC IF(NUMARG.LE.1)GOTO1900
7622      IF(NUMARG.LE.1)GOTO9000
7623      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
7624     1IHARG(2).EQ.'SIZE')GOTO1090
7625      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
7626     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'SIZE')GOTO1090
7627CCCCC GOTO1900
7628      GOTO9000
7629 1090 CONTINUE
7630C
7631C               *****************************************************
7632C               **  TREAT THE CASE WHEN                            **
7633C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
7634C               *****************************************************
7635C
7636      IF(ICOM.EQ.'XTIC')GOTO1100
7637      GOTO1199
7638C
7639 1100 CONTINUE
7640      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
7641      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
7642      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
7643      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
7644      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1150
7645      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
7646      IERROR='YES'
7647      GOTO9000
7648C
7649 1150 CONTINUE
7650      HOLD1=PDEFHE
7651      HOLD2=PDEFWI
7652      GOTO1180
7653C
7654 1160 CONTINUE
7655      HOLD1=ARG(NUMARG)
7656      HOLD2=HOLD1*0.5
7657      GOTO1180
7658C
7659 1180 CONTINUE
7660      IFOUND='YES'
7661      PX1ZHE=HOLD1
7662      PX2ZHE=HOLD1
7663      PX1ZWI=HOLD2
7664      PX2ZWI=HOLD2
7665C
7666      IF(IFEEDB.EQ.'OFF')GOTO1189
7667      WRITE(ICOUT,999)
7668  999 FORMAT(1X)
7669      CALL DPWRST('XXX','BUG ')
7670      WRITE(ICOUT,1181)
7671 1181 FORMAT('THE TIC MARK LABEL SIZE (FOR BOTH HORIZONTAL ',
7672     1'FRAME LINES)')
7673      CALL DPWRST('XXX','BUG ')
7674      WRITE(ICOUT,1182)HOLD1
7675 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
7676      CALL DPWRST('XXX','BUG ')
7677 1189 CONTINUE
7678      GOTO1900
7679C
7680 1199 CONTINUE
7681C
7682C               **************************************************************
7683C               **  TREAT THE CASE WHEN                                     **
7684C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
7685C               **************************************************************
7686C
7687      IF(ICOM.EQ.'X1TI')GOTO1200
7688      GOTO1299
7689C
7690 1200 CONTINUE
7691      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
7692      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
7693      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
7694      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
7695      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1250
7696      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
7697      IERROR='YES'
7698      GOTO9000
7699C
7700 1250 CONTINUE
7701      HOLD1=PDEFHE
7702      HOLD2=PDEFWI
7703      GOTO1280
7704C
7705 1260 CONTINUE
7706      HOLD1=ARG(NUMARG)
7707      HOLD2=HOLD1*0.5
7708      GOTO1280
7709C
7710 1280 CONTINUE
7711      IFOUND='YES'
7712      PX1ZHE=HOLD1
7713      PX1ZWI=HOLD2
7714C
7715      IF(IFEEDB.EQ.'OFF')GOTO1289
7716      WRITE(ICOUT,999)
7717      CALL DPWRST('XXX','BUG ')
7718      WRITE(ICOUT,1281)
7719 1281 FORMAT('THE TIC MARK LABEL SIZE (FOR THE BOTTOM HORIZONTAL ',
7720     1'FRAME LINE)')
7721      CALL DPWRST('XXX','BUG ')
7722      WRITE(ICOUT,1282)HOLD1
7723 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
7724      CALL DPWRST('XXX','BUG ')
7725 1289 CONTINUE
7726      GOTO1900
7727C
7728 1299 CONTINUE
7729C
7730C               **************************************************************
7731C               **  TREAT THE CASE WHEN                                     **
7732C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
7733C               **************************************************************
7734C
7735      IF(ICOM.EQ.'X2TI')GOTO1300
7736      GOTO1399
7737C
7738 1300 CONTINUE
7739      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
7740      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
7741      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
7742      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
7743      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1350
7744      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
7745      IERROR='YES'
7746      GOTO9000
7747C
7748 1350 CONTINUE
7749      HOLD1=PDEFHE
7750      HOLD2=PDEFWI
7751      GOTO1380
7752C
7753 1360 CONTINUE
7754      HOLD1=ARG(NUMARG)
7755      HOLD2=HOLD1*0.5
7756      GOTO1380
7757C
7758 1380 CONTINUE
7759      IFOUND='YES'
7760      PX2ZHE=HOLD1
7761      PX2ZWI=HOLD2
7762C
7763      IF(IFEEDB.EQ.'OFF')GOTO1389
7764      WRITE(ICOUT,999)
7765      CALL DPWRST('XXX','BUG ')
7766      WRITE(ICOUT,1381)
7767 1381 FORMAT('THE TIC MARK LABEL SIZE (FOR THE TOP HORIZONTAL ',
7768     1'FRAME LINE)')
7769      CALL DPWRST('XXX','BUG ')
7770      WRITE(ICOUT,1382)HOLD1
7771 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
7772      CALL DPWRST('XXX','BUG ')
7773 1389 CONTINUE
7774      GOTO1900
7775C
7776 1399 CONTINUE
7777C
7778C               *****************************************************
7779C               **  TREAT THE CASE WHEN                            **
7780C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
7781C               *****************************************************
7782C
7783      IF(ICOM.EQ.'YTIC')GOTO1400
7784      GOTO1499
7785C
7786 1400 CONTINUE
7787      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
7788      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
7789      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
7790      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
7791      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1450
7792      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
7793      IERROR='YES'
7794      GOTO9000
7795C
7796 1450 CONTINUE
7797      HOLD1=PDEFHE
7798      HOLD2=PDEFWI
7799      GOTO1480
7800C
7801 1460 CONTINUE
7802      HOLD1=ARG(NUMARG)
7803      HOLD2=HOLD1*0.5
7804      GOTO1480
7805C
7806 1480 CONTINUE
7807      IFOUND='YES'
7808      PY1ZHE=HOLD1
7809      PY2ZHE=HOLD1
7810      PY1ZWI=HOLD2
7811      PY2ZWI=HOLD2
7812C
7813      IF(IFEEDB.EQ.'OFF')GOTO1489
7814      WRITE(ICOUT,999)
7815      CALL DPWRST('XXX','BUG ')
7816      WRITE(ICOUT,1481)
7817 1481 FORMAT('THE TIC MARK LABEL SIZE (FOR BOTH VERTICAL ',
7818     1'FRAME LINES)')
7819      CALL DPWRST('XXX','BUG ')
7820      WRITE(ICOUT,1482)HOLD1
7821 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
7822      CALL DPWRST('XXX','BUG ')
7823 1489 CONTINUE
7824      GOTO1900
7825C
7826 1499 CONTINUE
7827C
7828C               **************************************************************
7829C               **  TREAT THE CASE WHEN                                     **
7830C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
7831C               **************************************************************
7832C
7833      IF(ICOM.EQ.'Y1TI')GOTO1500
7834      GOTO1599
7835C
7836 1500 CONTINUE
7837      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
7838      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
7839      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
7840      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
7841      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1550
7842      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
7843      IERROR='YES'
7844      GOTO9000
7845C
7846 1550 CONTINUE
7847      HOLD1=PDEFHE
7848      HOLD2=PDEFWI
7849      GOTO1580
7850C
7851 1560 CONTINUE
7852      HOLD1=ARG(NUMARG)
7853      HOLD2=HOLD1*0.5
7854      GOTO1580
7855C
7856 1580 CONTINUE
7857      IFOUND='YES'
7858      PY1ZHE=HOLD1
7859      PY1ZWI=HOLD2
7860C
7861      IF(IFEEDB.EQ.'OFF')GOTO1589
7862      WRITE(ICOUT,999)
7863      CALL DPWRST('XXX','BUG ')
7864      WRITE(ICOUT,1581)
7865 1581 FORMAT('THE TIC MARK LABEL SIZE (FOR THE LEFT VERTICAL ',
7866     1'FRAME LINE)')
7867      CALL DPWRST('XXX','BUG ')
7868      WRITE(ICOUT,1582)HOLD1
7869 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
7870      CALL DPWRST('XXX','BUG ')
7871 1589 CONTINUE
7872      GOTO1900
7873C
7874 1599 CONTINUE
7875C
7876C               **************************************************************
7877C               **  TREAT THE CASE WHEN                                     **
7878C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
7879C               **************************************************************
7880C
7881      IF(ICOM.EQ.'Y2TI')GOTO1600
7882      GOTO1699
7883C
7884 1600 CONTINUE
7885      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
7886      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
7887      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
7888      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
7889      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1650
7890      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
7891      IERROR='YES'
7892      GOTO9000
7893C
7894 1650 CONTINUE
7895      HOLD1=PDEFHE
7896      HOLD2=PDEFWI
7897      GOTO1680
7898C
7899 1660 CONTINUE
7900      HOLD1=ARG(NUMARG)
7901      HOLD2=HOLD1*0.5
7902      GOTO1680
7903C
7904 1680 CONTINUE
7905      IFOUND='YES'
7906      PY2ZHE=HOLD1
7907      PY2ZWI=HOLD2
7908C
7909      IF(IFEEDB.EQ.'OFF')GOTO1689
7910      WRITE(ICOUT,999)
7911      CALL DPWRST('XXX','BUG ')
7912      WRITE(ICOUT,1681)
7913 1681 FORMAT('THE TIC MARK LABEL SIZE (FOR THE RIGHT VERTICAL ',
7914     1'FRAME LINE)')
7915      CALL DPWRST('XXX','BUG ')
7916      WRITE(ICOUT,1682)HOLD1
7917 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
7918      CALL DPWRST('XXX','BUG ')
7919 1689 CONTINUE
7920      GOTO1900
7921C
7922 1699 CONTINUE
7923C
7924C               *****************************************************
7925C               **  TREAT THE CASE WHEN                            **
7926C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
7927C               *****************************************************
7928C
7929      IF(ICOM.EQ.'TIC')GOTO1700
7930      IF(ICOM.EQ.'TICS')GOTO1700
7931      IF(ICOM.EQ.'XYTI')GOTO1700
7932      IF(ICOM.EQ.'YXTI')GOTO1700
7933      GOTO1799
7934C
7935 1700 CONTINUE
7936      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
7937      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
7938      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
7939      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
7940      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1750
7941      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
7942      IERROR='YES'
7943      GOTO9000
7944C
7945 1750 CONTINUE
7946      HOLD1=PDEFHE
7947      HOLD2=PDEFWI
7948      GOTO1780
7949C
7950 1760 CONTINUE
7951      HOLD1=ARG(NUMARG)
7952      HOLD2=HOLD1*0.5
7953      GOTO1780
7954C
7955 1780 CONTINUE
7956      IFOUND='YES'
7957      PX1ZHE=HOLD1
7958      PX2ZHE=HOLD1
7959      PY1ZHE=HOLD1
7960      PY2ZHE=HOLD1
7961      PX1ZWI=HOLD2
7962      PX2ZWI=HOLD2
7963      PY1ZWI=HOLD2
7964      PY2ZWI=HOLD2
7965C
7966      IF(IFEEDB.EQ.'OFF')GOTO1789
7967      WRITE(ICOUT,999)
7968      CALL DPWRST('XXX','BUG ')
7969      WRITE(ICOUT,1781)
7970 1781 FORMAT('THE TIC MARK LABEL SIZE (FOR ALL 4 ',
7971     1'FRAME LINES)')
7972      CALL DPWRST('XXX','BUG ')
7973      WRITE(ICOUT,1782)HOLD1
7974 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
7975      CALL DPWRST('XXX','BUG ')
7976 1789 CONTINUE
7977      GOTO1900
7978C
7979 1799 CONTINUE
7980C
7981 1900 CONTINUE
7982C
7983      PX1ZVG=PX1ZHE*0.375
7984      PX2ZVG=PX2ZHE*0.375
7985      PY1ZVG=PY1ZHE*0.375
7986      PY2ZVG=PY2ZHE*0.375
7987C
7988      PX1ZHG=PX1ZHE*0.125
7989      PX2ZHG=PX2ZHE*0.125
7990      PY1ZHG=PY1ZHE*0.125
7991      PY2ZHG=PY2ZHE*0.125
7992      GOTO9000
7993C
7994 9000 CONTINUE
7995      RETURN
7996      END
7997      SUBROUTINE DPTLTH(ICOM,IHARG,ARG,NUMARG,
7998     1PDEFTH,
7999     1PTIZTH,
8000     1IFOUND,IERROR)
8001C
8002C     PURPOSE--DEFINE THE 4 TIC LABEL THICKNESSS CONTAINED IN THE
8003C              4 VARIABLES PTIZTH,PTIZTH,PTIZTH,PTIZTH
8004C              SUCH TIC LABEL THICKNESSS DEFINE THE THICKNESSS FOR
8005C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
8006C              NOTE: ALL 4 THICKNESS CURRENTLY LIMITED TO ONE
8007C                    SETTING, PTIZTH
8008C     INPUT  ARGUMENTS--ICOM
8009C                     --IHARG  (A  HOLLERITH VECTOR)
8010C                     --ARG    (A REAL VECTOR)
8011C                     --NUMARG
8012C                     --PDEFTH
8013C     OUTPUT ARGUMENTS--
8014C                     --PTIZTH = LOWER HORIZONTAL TIC LABEL THICKNESS
8015C                     --PTIZTH = UPPER HORIZONTAL TIC LABEL THICKNESS
8016C                     --PTIZTH = LEFT  VERTICAL   TIC LABEL THICKNESS
8017C                     --PTIZTH = RIGHT VERTICAL   TIC LABEL THICKNESS
8018C                     --IFOUND ('YES' OR 'NO' )
8019C                     --IERROR ('YES' OR 'NO' )
8020C     WRITTEN BY--ALAN HECKERT
8021C                 STATISTICAL ENGINEERING DIVISION
8022C                 INFORMATION TECHNOLOGY LABORATORY
8023C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8024C                 GAITHERSBURG, MD 20899-8980
8025C                 PHONE--301-975-2899
8026C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8027C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8028C     LANGUAGE--ANSI FORTRAN (1977)
8029C     VERSION NUMBER--89/2
8030C     ORIGINAL VERSION--JANUARY   1989.
8031C
8032C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8033C
8034      CHARACTER*4 ICOM
8035      CHARACTER*4 IHARG
8036C
8037C
8038      CHARACTER*4 IFOUND
8039      CHARACTER*4 IERROR
8040C
8041C---------------------------------------------------------------------
8042C
8043      DIMENSION IHARG(*)
8044      DIMENSION ARG(*)
8045C
8046C-----COMMON----------------------------------------------------------
8047C
8048      INCLUDE 'DPCOP2.INC'
8049C
8050C-----START POINT-----------------------------------------------------
8051C
8052      IFOUND='NO'
8053      IERROR='NO'
8054C
8055      IF(NUMARG.LE.1)GOTO1900
8056      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
8057     1IHARG(2).EQ.'THIC')GOTO1090
8058      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
8059     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'THIC')GOTO1090
8060      GOTO1900
8061 1090 CONTINUE
8062C
8063C               *****************************************************
8064C               **  TREAT THE CASE WHEN                            **
8065C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
8066C               *****************************************************
8067C
8068      IF(ICOM.EQ.'XTIC')GOTO1100
8069      GOTO1199
8070C
8071 1100 CONTINUE
8072      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
8073      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
8074      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
8075      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
8076      IF(IHARG(NUMARG).EQ.'THIC')GOTO1150
8077      GOTO1160
8078C
8079 1150 CONTINUE
8080      PHOLD=PDEFTH
8081      GOTO1180
8082C
8083 1160 CONTINUE
8084      PHOLD=ARG(NUMARG)
8085      GOTO1180
8086C
8087 1180 CONTINUE
8088      IFOUND='YES'
8089      PTIZTH=PHOLD
8090C
8091      IF(IFEEDB.EQ.'OFF')GOTO1189
8092      WRITE(ICOUT,999)
8093  999 FORMAT(1X)
8094      CALL DPWRST('XXX','BUG ')
8095      WRITE(ICOUT,1181)
8096 1181 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
8097     1'FRAME LINES)')
8098      CALL DPWRST('XXX','BUG ')
8099      WRITE(ICOUT,1182)PHOLD
8100 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
8101      CALL DPWRST('XXX','BUG ')
8102 1189 CONTINUE
8103      GOTO1900
8104C
8105 1199 CONTINUE
8106C
8107C               **************************************************************
8108C               **  TREAT THE CASE WHEN                                     **
8109C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
8110C               **************************************************************
8111C
8112      IF(ICOM.EQ.'X1TI')GOTO1200
8113      GOTO1299
8114C
8115 1200 CONTINUE
8116      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
8117      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
8118      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
8119      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
8120      IF(IHARG(NUMARG).EQ.'THIC')GOTO1250
8121      GOTO1260
8122C
8123 1250 CONTINUE
8124      PHOLD=PDEFTH
8125      GOTO1280
8126C
8127 1260 CONTINUE
8128      PHOLD=ARG(NUMARG)
8129      GOTO1280
8130C
8131 1280 CONTINUE
8132      IFOUND='YES'
8133      PTIZTH=PHOLD
8134C
8135      IF(IFEEDB.EQ.'OFF')GOTO1289
8136      WRITE(ICOUT,999)
8137      CALL DPWRST('XXX','BUG ')
8138      WRITE(ICOUT,1281)
8139 1281 FORMAT('THE TIC MARK LABEL THICKNESS (ALL ',
8140     1'FRAME LINES)')
8141      CALL DPWRST('XXX','BUG ')
8142      WRITE(ICOUT,1282)PHOLD
8143 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
8144      CALL DPWRST('XXX','BUG ')
8145 1289 CONTINUE
8146      GOTO1900
8147C
8148 1299 CONTINUE
8149C
8150C               **************************************************************
8151C               **  TREAT THE CASE WHEN                                     **
8152C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
8153C               **************************************************************
8154C
8155      IF(ICOM.EQ.'X2TI')GOTO1300
8156      GOTO1399
8157C
8158 1300 CONTINUE
8159      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
8160      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
8161      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
8162      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
8163      IF(IHARG(NUMARG).EQ.'THIC')GOTO1350
8164      GOTO1360
8165C
8166 1350 CONTINUE
8167      PHOLD=PDEFTH
8168      GOTO1380
8169C
8170 1360 CONTINUE
8171      PHOLD=ARG(NUMARG)
8172      GOTO1380
8173C
8174 1380 CONTINUE
8175      IFOUND='YES'
8176      PTIZTH=PHOLD
8177C
8178      IF(IFEEDB.EQ.'OFF')GOTO1389
8179      WRITE(ICOUT,999)
8180      CALL DPWRST('XXX','BUG ')
8181      WRITE(ICOUT,1381)
8182 1381 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
8183     1'FRAME LINES)')
8184      CALL DPWRST('XXX','BUG ')
8185      WRITE(ICOUT,1382)PHOLD
8186 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
8187      CALL DPWRST('XXX','BUG ')
8188 1389 CONTINUE
8189      GOTO1900
8190C
8191 1399 CONTINUE
8192C
8193C               *****************************************************
8194C               **  TREAT THE CASE WHEN                            **
8195C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
8196C               *****************************************************
8197C
8198      IF(ICOM.EQ.'YTIC')GOTO1400
8199      GOTO1499
8200C
8201 1400 CONTINUE
8202      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
8203      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
8204      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
8205      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
8206      IF(IHARG(NUMARG).EQ.'THIC')GOTO1450
8207      GOTO1460
8208C
8209 1450 CONTINUE
8210      PHOLD=PDEFTH
8211      GOTO1480
8212C
8213 1460 CONTINUE
8214      PHOLD=ARG(NUMARG)
8215      GOTO1480
8216C
8217 1480 CONTINUE
8218      IFOUND='YES'
8219      PTIZTH=PHOLD
8220C
8221      IF(IFEEDB.EQ.'OFF')GOTO1489
8222      WRITE(ICOUT,999)
8223      CALL DPWRST('XXX','BUG ')
8224      WRITE(ICOUT,1481)
8225 1481 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
8226     1'FRAME LINES)')
8227      CALL DPWRST('XXX','BUG ')
8228      WRITE(ICOUT,1482)PHOLD
8229 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
8230      CALL DPWRST('XXX','BUG ')
8231 1489 CONTINUE
8232      GOTO1900
8233C
8234 1499 CONTINUE
8235C
8236C               **************************************************************
8237C               **  TREAT THE CASE WHEN                                     **
8238C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
8239C               **************************************************************
8240C
8241      IF(ICOM.EQ.'Y1TI')GOTO1500
8242      GOTO1599
8243C
8244 1500 CONTINUE
8245      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
8246      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
8247      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
8248      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
8249      IF(IHARG(NUMARG).EQ.'THIC')GOTO1550
8250      GOTO1560
8251C
8252 1550 CONTINUE
8253      PHOLD=PDEFTH
8254      GOTO1580
8255C
8256 1560 CONTINUE
8257      PHOLD=ARG(NUMARG)
8258      GOTO1580
8259C
8260 1580 CONTINUE
8261      IFOUND='YES'
8262      PTIZTH=PHOLD
8263C
8264      IF(IFEEDB.EQ.'OFF')GOTO1589
8265      WRITE(ICOUT,999)
8266      CALL DPWRST('XXX','BUG ')
8267      WRITE(ICOUT,1581)
8268 1581 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
8269     1'FRAME LINES)')
8270      CALL DPWRST('XXX','BUG ')
8271      WRITE(ICOUT,1582)PHOLD
8272 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
8273      CALL DPWRST('XXX','BUG ')
8274 1589 CONTINUE
8275      GOTO1900
8276C
8277 1599 CONTINUE
8278C
8279C               **************************************************************
8280C               **  TREAT THE CASE WHEN                                     **
8281C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
8282C               **************************************************************
8283C
8284      IF(ICOM.EQ.'Y2TI')GOTO1600
8285      GOTO1699
8286C
8287 1600 CONTINUE
8288      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
8289      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
8290      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
8291      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
8292      IF(IHARG(NUMARG).EQ.'THIC')GOTO1650
8293      GOTO1660
8294C
8295 1650 CONTINUE
8296      PHOLD=PDEFTH
8297      GOTO1680
8298C
8299 1660 CONTINUE
8300      PHOLD=ARG(NUMARG)
8301      GOTO1680
8302C
8303 1680 CONTINUE
8304      IFOUND='YES'
8305      PTIZTH=PHOLD
8306C
8307      IF(IFEEDB.EQ.'OFF')GOTO1689
8308      WRITE(ICOUT,999)
8309      CALL DPWRST('XXX','BUG ')
8310      WRITE(ICOUT,1681)
8311 1681 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
8312     1'FRAME LINES)')
8313      CALL DPWRST('XXX','BUG ')
8314      WRITE(ICOUT,1682)PHOLD
8315 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
8316      CALL DPWRST('XXX','BUG ')
8317 1689 CONTINUE
8318      GOTO1900
8319C
8320 1699 CONTINUE
8321C
8322C               *****************************************************
8323C               **  TREAT THE CASE WHEN                            **
8324C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
8325C               *****************************************************
8326C
8327      IF(ICOM.EQ.'TIC')GOTO1700
8328      IF(ICOM.EQ.'TICS')GOTO1700
8329      IF(ICOM.EQ.'XYTI')GOTO1700
8330      IF(ICOM.EQ.'YXTI')GOTO1700
8331      GOTO1799
8332C
8333 1700 CONTINUE
8334      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
8335      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
8336      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
8337      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
8338      IF(IHARG(NUMARG).EQ.'THIC')GOTO1750
8339      GOTO1760
8340C
8341 1750 CONTINUE
8342      PHOLD=PDEFTH
8343      GOTO1780
8344C
8345 1760 CONTINUE
8346      PHOLD=ARG(NUMARG)
8347      GOTO1780
8348C
8349 1780 CONTINUE
8350      IFOUND='YES'
8351      PTIZTH=PHOLD
8352C
8353      IF(IFEEDB.EQ.'OFF')GOTO1789
8354      WRITE(ICOUT,999)
8355      CALL DPWRST('XXX','BUG ')
8356      WRITE(ICOUT,1781)
8357 1781 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL 4 ',
8358     1'FRAME LINES)')
8359      CALL DPWRST('XXX','BUG ')
8360      WRITE(ICOUT,1782)PHOLD
8361 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
8362      CALL DPWRST('XXX','BUG ')
8363 1789 CONTINUE
8364      GOTO1900
8365C
8366 1799 CONTINUE
8367C
8368 1900 CONTINUE
8369      RETURN
8370      END
8371      SUBROUTINE DPTMCO(XTEMP1,XTEMP2,MAXNXT,ICASAN,
8372     1                  ICAPSW,IFORSW,IMULT,IREPL,
8373     1                  ISUBRO,IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
8374C
8375C     PURPOSE--GENERATE CONFIDENCE LIMITS FOR THE TRIMMED MEAN
8376C              FOR PROBABILITY VALUE P = .90, .95, .99, .999, AND .9999.
8377C     WRITTEN BY--ALAN HECKERT
8378C                 STATISTICAL ENGINEERING DIVISION
8379C                 INFORMATION TECHNOLOGY LABORATORY
8380C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8381C                 GAITHERSBURG, MD 20899-8980
8382C                 PHONE--301-975-2899
8383C     REFERENCE--"INTRODUCTION TO ROBUST ESTIMATION AND HYPOTHESIS
8384C                TESTING", RAND R. WILCOX, ACADEMIC PRESS, 1997.
8385C                1977.
8386C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8387C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8388C     LANGUAGE--ANSI FORTRAN (1977)
8389C     VERSION NUMBER--2003/2
8390C     ORIGINAL VERSION--FEBRUARY  2003.
8391C     UPDATED         --OCTOBER   2003. ADD SUPPORT FOR HTML, LATEX
8392C                                       OUTPUT
8393C     UPDATED         --MARCH     2010. USE DPDTA1, DPDTA4 TO GENERATE
8394C                                       HTML, LATEX, RTF FORMAT
8395C     UPDATED         --MARCH     2010. SUPPORT FOR MULTIPLE RESPONSE
8396C                                       VARIABLES AND FOR GROUP-ID
8397C                                       VARIABLES (I.E., REPLICATION
8398C                                       CASE)
8399C     UPDATED         --MARCH     2010. USE DPPAR3 TO EXTRACT EITHER A
8400C                                       RESPONSE VARIABLE OR A MATRIX
8401C                                       NAME
8402C     UPDATED         --OCTOBER   2012. TRIMMING CAN BE SPECIFIED EITHER
8403C                                       AS A PROPORTION OR AS A SPECIFIC
8404C                                       NUMBER TO TRIM
8405C     UPDATED         --AUGUST    2019. ADD CTL999, CTU999
8406C
8407C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8408C
8409      CHARACTER*4 ICAPSW
8410      CHARACTER*4 IFORSW
8411      CHARACTER*4 IBUGA2
8412      CHARACTER*4 IBUGA3
8413      CHARACTER*4 IBUGQ
8414      CHARACTER*4 ISUBRO
8415      CHARACTER*4 IFOUND
8416      CHARACTER*4 IERROR
8417C
8418      CHARACTER*4 IHWUSE
8419      CHARACTER*4 MESSAG
8420      CHARACTER*4 ICASEQ
8421      CHARACTER*4 IH
8422      CHARACTER*4 IH2
8423      CHARACTER*4 ICASAN
8424      CHARACTER*4 ICASE
8425      CHARACTER*4 ISUBN1
8426      CHARACTER*4 ISUBN2
8427      CHARACTER*4 ISTEPN
8428      CHARACTER*4 IFLAGU
8429      CHARACTER*4 IREPL
8430      CHARACTER*4 IMULT
8431C
8432      LOGICAL IFRST
8433      LOGICAL ILAST
8434C
8435      CHARACTER*40 INAME
8436      PARAMETER (MAXSPN=30)
8437      CHARACTER*4 IVARN1(MAXSPN)
8438      CHARACTER*4 IVARN2(MAXSPN)
8439      CHARACTER*4 IVARTY(MAXSPN)
8440      CHARACTER*4 IVARID(MAXSPN)
8441      CHARACTER*4 IVARI2(MAXSPN)
8442      REAL PVAR(MAXSPN)
8443      REAL PID(MAXSPN)
8444      INTEGER ILIS(MAXSPN)
8445      INTEGER NRIGHT(MAXSPN)
8446      INTEGER ICOLR(MAXSPN)
8447C
8448C---------------------------------------------------------------------
8449C
8450      INCLUDE 'DPCOPA.INC'
8451C
8452      DIMENSION XTEMP1(*)
8453      DIMENSION XTEMP2(*)
8454      DIMENSION W(MAXOBV)
8455      DIMENSION TEMP1(MAXOBV)
8456      DIMENSION TEMP2(MAXOBV)
8457C
8458      DIMENSION XDESGN(MAXOBV,6)
8459      DIMENSION XIDTEM(MAXOBV)
8460      DIMENSION XIDTE2(MAXOBV)
8461      DIMENSION XIDTE3(MAXOBV)
8462      DIMENSION XIDTE4(MAXOBV)
8463      DIMENSION XIDTE5(MAXOBV)
8464      DIMENSION XIDTE6(MAXOBV)
8465C
8466      INCLUDE 'DPCOZZ.INC'
8467      EQUIVALENCE (GARBAG(IGARB1),XIDTEM(1))
8468      EQUIVALENCE (GARBAG(IGARB2),XIDTE2(1))
8469      EQUIVALENCE (GARBAG(IGARB3),XIDTE3(1))
8470      EQUIVALENCE (GARBAG(IGARB4),XIDTE4(1))
8471      EQUIVALENCE (GARBAG(IGARB5),XIDTE5(1))
8472      EQUIVALENCE (GARBAG(IGARB6),XIDTE6(1))
8473      EQUIVALENCE (GARBAG(IGARB7),TEMP1(1))
8474      EQUIVALENCE (GARBAG(IGARB8),TEMP2(1))
8475      EQUIVALENCE (GARBAG(IGARB9),W(1))
8476      EQUIVALENCE (GARBAG(IGAR10),XDESGN(1,1))
8477C
8478C-----COMMON----------------------------------------------------------
8479C
8480      INCLUDE 'DPCOHK.INC'
8481      INCLUDE 'DPCOSU.INC'
8482      INCLUDE 'DPCODA.INC'
8483      INCLUDE 'DPCOHO.INC'
8484      INCLUDE 'DPCOST.INC'
8485      INCLUDE 'DPCOP2.INC'
8486C
8487C-----START POINT-----------------------------------------------------
8488C
8489      ISUBN1='DPTM'
8490      ISUBN2='CO  '
8491      IFOUND='YES'
8492      IERROR='NO'
8493C
8494      MAXCP1=MAXCOL+1
8495      MAXCP2=MAXCOL+2
8496      MAXCP3=MAXCOL+3
8497      MAXCP4=MAXCOL+4
8498      MAXCP5=MAXCOL+5
8499      MAXCP6=MAXCOL+6
8500C
8501C               *****************************************************
8502C               **  TREAT THE TRIMMED MEAN CONFIDENCE LIMITS CASE  **
8503C               *****************************************************
8504C
8505      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
8506        WRITE(ICOUT,999)
8507  999   FORMAT(1X)
8508        CALL DPWRST('XXX','BUG ')
8509        WRITE(ICOUT,51)
8510   51   FORMAT('***** AT THE BEGINNING OF DPTMCO--')
8511        CALL DPWRST('XXX','BUG ')
8512        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ICASAN,MAXNXT
8513   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ICASAN,MAXNXT = ',4(A4,2X),I8)
8514        CALL DPWRST('XXX','BUG ')
8515      ENDIF
8516C
8517C               *********************************
8518C               **  STEP 1--                   **
8519C               **  EXTRACT THE VARIABLE LIST  **
8520C               *********************************
8521C
8522      ISTEPN='1'
8523      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
8524     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8525C
8526      INAME='TRIMMED MEAN CONFIDENCE LIMITS'
8527      MAXNA=100
8528      MINNVA=1
8529      MAXNVA=100
8530      MINNA=1
8531      IFLAGE=1
8532      IF(IREPL.EQ.'ON')THEN
8533        MAXNVA=7
8534      ELSE
8535        MAXNVA=100
8536        IFLAGE=0
8537      ENDIF
8538      MINN2=2
8539      IFLAGM=1
8540      IFLAGP=0
8541      JMIN=1
8542      JMAX=NUMARG
8543C
8544      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
8545     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
8546     1            JMIN,JMAX,
8547     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
8548     1            IVARN1,IVARN2,IVARTY,PVAR,
8549     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
8550     1            MINNVA,MAXNVA,
8551     1            IFLAGM,IFLAGP,
8552     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
8553      IF(IERROR.EQ.'YES')GOTO9000
8554C
8555      IF(NUMVAR.GT.1 .AND. IREPL.EQ.'OFF')IMULT='ON'
8556C
8557      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
8558        WRITE(ICOUT,999)
8559        CALL DPWRST('XXX','BUG ')
8560        WRITE(ICOUT,181)
8561  181   FORMAT('***** AFTER CALL DPPARS--')
8562        CALL DPWRST('XXX','BUG ')
8563        WRITE(ICOUT,182)NQ,NUMVAR,IMULT,IREPL
8564  182   FORMAT('NQ,NUMVAR,IMULT,IREPL = ',2I8,2X,A4,2X,A4)
8565        CALL DPWRST('XXX','BUG ')
8566        IF(NUMVAR.GT.0)THEN
8567          DO185I=1,NUMVAR
8568            WRITE(ICOUT,187)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
8569     1                      ICOLR(I)
8570  187       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
8571     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
8572            CALL DPWRST('XXX','BUG ')
8573  185     CONTINUE
8574        ENDIF
8575      ENDIF
8576C
8577C               ***********************************************
8578C               **  STEP 2--                                 **
8579C               **  DETERMINE:                               **
8580C               **  1) NUMBER OF REPLICATION VARIABLES (0-6) **
8581C               **  2) NUMBER OF RESPONSE    VARIABLES (>= 1)**
8582C               ***********************************************
8583C
8584      ISTEPN='2'
8585      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
8586     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8587C
8588      NRESP=0
8589      NREPL=0
8590C
8591      IF(IMULT.EQ.'ON')THEN
8592        NRESP=NUMVAR
8593      ELSEIF(IREPL.EQ.'ON')THEN
8594        NRESP=1
8595        NREPL=NUMVAR-NRESP
8596        IF(NREPL.LT.1 .OR. NREPL.GT.6)THEN
8597          WRITE(ICOUT,999)
8598          CALL DPWRST('XXX','BUG ')
8599          WRITE(ICOUT,101)
8600  101     FORMAT('***** ERROR IN TRIMMED MEAN CONFIDENCE LIMITS--')
8601          CALL DPWRST('XXX','BUG ')
8602          WRITE(ICOUT,211)
8603  211     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
8604     1           'REPLICATION VARIABLES')
8605          CALL DPWRST('XXX','BUG ')
8606          WRITE(ICOUT,213)NREPL
8607  213     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
8608          CALL DPWRST('XXX','BUG ')
8609          IERROR='YES'
8610          GOTO9000
8611        ENDIF
8612      ELSE
8613        NRESP=1
8614      ENDIF
8615C
8616      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
8617        WRITE(ICOUT,221)NRESP,NREPL
8618  221   FORMAT('NRESP,NREPL = ',2I5)
8619        CALL DPWRST('XXX','BUG ')
8620      ENDIF
8621C
8622      DO230I=1,MAXN
8623        W(I)=1.0
8624  230 CONTINUE
8625C
8626C     ******************************************************
8627C     **  STEP 3--                                        **
8628C     **  DETERMINE VALUE OF TRIMMING CONSTANTS (OBTAINED **
8629C     **  FROM PARAMETERS P1 AND P2)                      **
8630C     ******************************************************
8631C
8632C
8633C        2012/10: FOR TRIMMED MEAN, CAN SPECIFY EITHER A SPECIFIC NUMBER
8634C                 TO TRIM OR A PERCENTAGE TO TRIM.  CHECK FOR SPECIFIC
8635C                 NUMBER FIRST AND IF NOT SPECIFIED, CHECK FOR A
8636C                 PERCENTAGE.
8637C
8638        NTRIM1=-1
8639        NTRIM2=-1
8640        P1=-99.0
8641        P2=-99.0
8642C
8643        IH='NTRI'
8644        IH2='M1  '
8645        IHWUSE='P'
8646        MESSAG='NO'
8647        CALL CHECKN(IH,IH2,IHWUSE,
8648     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
8649     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
8650        IF(IERROR.EQ.'NO')THEN
8651          NTRIM1=INT(VALUE(ILOCP)+0.1)
8652          IF(NTRIM1.LT.0)NTRIM1=0
8653        ENDIF
8654C
8655        IH='NTRI'
8656        IH2='M2  '
8657        IHWUSE='P'
8658        MESSAG='NO'
8659        CALL CHECKN(IH,IH2,IHWUSE,
8660     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
8661     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
8662        IF(IERROR.EQ.'NO')THEN
8663          NTRIM2=INT(VALUE(ILOCP)+0.1)
8664          IF(NTRIM2.LT.0)NTRIM2=0
8665        ENDIF
8666C
8667        IF(NTRIM1.LE.0)THEN
8668          IH='P1  '
8669          IH2='    '
8670          IHWUSE='P'
8671          MESSAG='YES'
8672          CALL CHECKN(IH,IH2,IHWUSE,
8673     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
8674     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
8675          IF(IERROR.EQ.'YES')GOTO9000
8676          IF(PROP1.LT.0.0 .OR. PROP1.GT.100.0)THEN
8677            WRITE(ICOUT,999)
8678            CALL DPWRST('XXX','BUG ')
8679            WRITE(ICOUT,301)
8680  301       FORMAT('***** ERROR IN TRIMMED MEAN CONFIDENCE LIMITS--')
8681            CALL DPWRST('XXX','BUG ')
8682            WRITE(ICOUT,302)
8683  302       FORMAT('      THE PROPORTION FOR TRIMMING BELOW MUST BE')
8684            CALL DPWRST('XXX','BUG ')
8685            WRITE(ICOUT,303)
8686  303       FORMAT('      BETWEEN 0 AND 100, BUT WAS NOT.')
8687            CALL DPWRST('XXX','BUG ')
8688            WRITE(ICOUT,304)PROP1
8689  304       FORMAT('      PARAMETER P1 = LOWER PROPORTION = ',G15.7)
8690            CALL DPWRST('XXX','BUG ')
8691            WRITE(ICOUT,305)
8692  305       FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P1 AS IN')
8693            CALL DPWRST('XXX','BUG ')
8694            WRITE(ICOUT,306)
8695  306       FORMAT('      LET P1 = 25')
8696            CALL DPWRST('XXX','BUG ')
8697            IERROR='YES'
8698            GOTO9000
8699          ELSE
8700            PROP1=VALUE(ILOCP)
8701          ENDIF
8702        ENDIF
8703C
8704        IF(NTRIM2.LE.0)THEN
8705          IH='P2  '
8706          IH2='    '
8707          IHWUSE='P'
8708          MESSAG='YES'
8709          CALL CHECKN(IH,IH2,IHWUSE,
8710     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
8711     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
8712          IF(IERROR.EQ.'YES')GOTO9000
8713          IF(PROP2.LT.0.0 .OR. PROP2.GT.100.0)THEN
8714            WRITE(ICOUT,999)
8715            CALL DPWRST('XXX','BUG ')
8716            WRITE(ICOUT,301)
8717            CALL DPWRST('XXX','BUG ')
8718            WRITE(ICOUT,312)
8719  312       FORMAT('      THE PROPORTION FOR TRIMMING ABOVE MUST BE')
8720            CALL DPWRST('XXX','BUG ')
8721            WRITE(ICOUT,303)
8722            CALL DPWRST('XXX','BUG ')
8723            WRITE(ICOUT,314)PROP2
8724  314       FORMAT('      PARAMETER P2 = LOWER PROPORTION = ',G15.7)
8725            CALL DPWRST('XXX','BUG ')
8726            WRITE(ICOUT,315)
8727  315       FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P2 AS IN')
8728            CALL DPWRST('XXX','BUG ')
8729            WRITE(ICOUT,316)
8730  316       FORMAT('      LET P2 = 25')
8731            CALL DPWRST('XXX','BUG ')
8732            IERROR='YES'
8733            GOTO9000
8734          ELSE
8735            PROP2=VALUE(ILOCP)
8736          ENDIF
8737        ENDIF
8738C
8739C
8740C               ******************************************************
8741C               **  STEP 3--                                        **
8742C               **  GENERATE THE CONFIDENCE LIMITS FOR THE VARIOUS  **
8743C               **  CASES                                           **
8744C               ******************************************************
8745C
8746      ISTEPN='3'
8747      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
8748     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8749C
8750C               *****************************************
8751C               **  STEP 3A--                          **
8752C               **  CASE 1: SINGLE RESPONSE VARIABLE   **
8753C               **          WITH NO REPLICATION        **
8754C               *****************************************
8755C
8756      IF(IMULT.EQ.'OFF' .AND. NREPL.EQ.0)THEN
8757        ISTEPN='3A'
8758        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
8759     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8760C
8761        PID(1)=CPUMIN
8762        IVARID(1)=IVARN1(1)
8763        IVARI2(1)=IVARN2(1)
8764C
8765        ICOL=1
8766        NUMVA2=1
8767        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
8768     1              INAME,IVARN1,IVARN2,IVARTY,
8769     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
8770     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
8771     1              MAXCP4,MAXCP5,MAXCP6,
8772     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
8773     1              Y,XTEMP1,XTEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE,
8774     1              IBUGA3,ISUBRO,IFOUND,IERROR)
8775        IF(IERROR.EQ.'YES')GOTO9000
8776C
8777C               ******************************************************
8778C               **  STEP 3B--                                       **
8779C               **  PREPARE FOR ENTRANCE INTO DPTMC2--              **
8780C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.      **
8781C               ******************************************************
8782C
8783        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
8784          ISTEPN='3B'
8785          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8786          WRITE(ICOUT,999)
8787          CALL DPWRST('XXX','BUG ')
8788          WRITE(ICOUT,331)
8789  331     FORMAT('***** FROM DPTMCO, AS WE ARE ABOUT TO CALL DPTMC2--')
8790          CALL DPWRST('XXX','BUG ')
8791          WRITE(ICOUT,332)NLOCAL,MAXN
8792  332     FORMAT('NLOCAL,MAXN = ',2I8)
8793          CALL DPWRST('XXX','BUG ')
8794          DO335I=1,N
8795            WRITE(ICOUT,336)I,Y(I)
8796  336       FORMAT('I,Y(I) = ',I8,G15.7)
8797            CALL DPWRST('XXX','BUG ')
8798  335     CONTINUE
8799        ENDIF
8800C
8801        CALL DPTMC2(Y,NLOCAL,W,PROP1,PROP2,NTRIM1,NTRIM2,
8802     1              XTEMP1,XTEMP2,MAXNXT,
8803     1              PID,IVARID,IVARI2,NREPL,
8804     1              CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
8805     1              CTL999,CTU999,
8806     1              ICAPSW,ICAPTY,IFORSW,
8807     1              ICASAN,ISUBRO,IBUGA3,IERROR)
8808C
8809        IFLAGU='ON'
8810        IFRST=.FALSE.
8811        ILAST=.FALSE.
8812        CALL DPCNF3(CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
8813     1              CTL999,CTU999,
8814     1              IFLAGU,IFRST,ILAST,ICASAN,
8815     1              IBUGA2,IBUGA3,ISUBRO,IERROR)
8816C
8817C               *******************************************
8818C               **  STEP 4A--                            **
8819C               **  CASE 2: MULTIPLE RESPONSE VARIABLES  **
8820C               *******************************************
8821C
8822      ELSEIF(IMULT.EQ.'ON')THEN
8823        ISTEPN='4A'
8824        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
8825     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8826C
8827C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
8828C
8829        NCURVE=0
8830        DO410IRESP=1,NRESP
8831          NCURVE=NCURVE+1
8832C
8833          IINDX=ICOLR(IRESP)
8834          PID(1)=CPUMIN
8835          IVARID(1)=IVARN1(IRESP)
8836          IVARI2(1)=IVARN2(IRESP)
8837C
8838          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
8839            WRITE(ICOUT,999)
8840            CALL DPWRST('XXX','BUG ')
8841            WRITE(ICOUT,411)IRESP,NCURVE
8842  411       FORMAT('IRESP,NCURVE = ',2I5)
8843            CALL DPWRST('XXX','BUG ')
8844          ENDIF
8845C
8846          ICOL=IRESP
8847          NUMVA2=1
8848          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
8849     1                INAME,IVARN1,IVARN2,IVARTY,
8850     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
8851     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
8852     1                MAXCP4,MAXCP5,MAXCP6,
8853     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
8854     1                Y,XTEMP1,XTEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE,
8855     1                IBUGA3,ISUBRO,IFOUND,IERROR)
8856          IF(IERROR.EQ.'YES')GOTO9000
8857C
8858C         *****************************************************
8859C         **  STEP 4B--                                      **
8860C         *****************************************************
8861C
8862          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TMCO')THEN
8863            ISTEPN='4B'
8864            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8865            WRITE(ICOUT,999)
8866            CALL DPWRST('XXX','BUG ')
8867            WRITE(ICOUT,422)
8868  422       FORMAT('***** FROM THE MIDDLE  OF DPTMCO--')
8869            CALL DPWRST('XXX','BUG ')
8870            WRITE(ICOUT,423)ICASAN,NUMVAR,NLOCAL,IRESP
8871  423       FORMAT('ICASAN,NUMVAR,NLOCAL,IRESP = ',A4,3I8)
8872            CALL DPWRST('XXX','BUG ')
8873            IF(NLOCAL.GE.1)THEN
8874              DO425I=1,NLOCAL
8875                WRITE(ICOUT,426)I,Y(I)
8876  426           FORMAT('I,Y(I) = ',I8,F12.5)
8877                CALL DPWRST('XXX','BUG ')
8878  425         CONTINUE
8879            ENDIF
8880          ENDIF
8881C
8882          CALL DPTMC2(Y,NLOCAL,W,PROP1,PROP2,NTRIM1,NTRIM2,
8883     1                XTEMP1,XTEMP2,MAXNXT,
8884     1                PID,IVARID,IVARI2,NREPL,
8885     1                CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
8886     1                CTL999,CTU999,
8887     1                ICAPSW,ICAPTY,IFORSW,
8888     1                ICASAN,ISUBRO,IBUGA3,IERROR)
8889C
8890          IFLAGU='FILE'
8891          IFRST=.FALSE.
8892          ILAST=.FALSE.
8893          IF(IRESP.EQ.1)IFRST=.TRUE.
8894          IF(IRESP.EQ.NRESP)ILAST=.TRUE.
8895          CALL DPCNF3(CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
8896     1                CTL999,CTU999,
8897     1                IFLAGU,IFRST,ILAST,ICASAN,
8898     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
8899C
8900  410   CONTINUE
8901C
8902C               ****************************************************
8903C               **  STEP 5A--                                     **
8904C               **  CASE 3: ONE OR MORE REPLICATION VARIABLES.    **
8905C               **          FOR THIS CASE, ALL VARIABLES MUST     **
8906C               **          HAVE THE SAME LENGTH.                 **
8907C               ****************************************************
8908C
8909      ELSEIF(IREPL.EQ.'ON')THEN
8910        ISTEPN='5A'
8911        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
8912     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8913C
8914        J=0
8915        IMAX=NRIGHT(1)
8916        IF(NQ.LT.NRIGHT(1))IMAX=NQ
8917        DO510I=1,IMAX
8918          IF(ISUB(I).EQ.0)GOTO510
8919          J=J+1
8920C
8921C         RESPONSE VARIABLE IN Y
8922C
8923          ICOLC=1
8924          IJ=MAXN*(ICOLR(ICOLC)-1)+I
8925          IF(ICOLR(ICOLC).LE.MAXCOL)Y(J)=V(IJ)
8926          IF(ICOLR(ICOLC).EQ.MAXCP1)Y(J)=PRED(I)
8927          IF(ICOLR(ICOLC).EQ.MAXCP2)Y(J)=RES(I)
8928          IF(ICOLR(ICOLC).EQ.MAXCP3)Y(J)=YPLOT(I)
8929          IF(ICOLR(ICOLC).EQ.MAXCP4)Y(J)=XPLOT(I)
8930          IF(ICOLR(ICOLC).EQ.MAXCP5)Y(J)=X2PLOT(I)
8931          IF(ICOLR(ICOLC).EQ.MAXCP6)Y(J)=TAGPLO(I)
8932C
8933          IF(NREPL.GE.1)THEN
8934            DO520IR=1,MIN(NREPL,6)
8935              ICOLC=ICOLC+1
8936              ICOLT=ICOLR(ICOLC)
8937              IJ=MAXN*(ICOLT-1)+I
8938              IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
8939              IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
8940              IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
8941              IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
8942              IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
8943              IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
8944              IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
8945  520       CONTINUE
8946          ENDIF
8947C
8948  510   CONTINUE
8949        NLOCAL=J
8950C
8951        ISTEPN='5B'
8952        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
8953     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8954C
8955        PID(1)=CPUMIN
8956        IVARID(1)=IVARN1(1)
8957        IVARI2(1)=IVARN2(1)
8958        IADD=1
8959        DO540II=1,NREPL
8960          IVARID(II+IADD)=IVARN1(II+IADD)
8961          IVARI2(II+IADD)=IVARN2(II+IADD)
8962  540   CONTINUE
8963C
8964C       *****************************************************
8965C       **  STEP 5C--                                      **
8966C       **                                                 **
8967C       **  FOR THIS CASE, WE NEED TO LOOP THROUGH THE     **
8968C       **  VARIOUS REPLICATIONS.                          **
8969C       *****************************************************
8970C
8971C
8972        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TMCO')THEN
8973          ISTEPN='5C'
8974          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8975          WRITE(ICOUT,999)
8976          CALL DPWRST('XXX','BUG ')
8977          WRITE(ICOUT,541)
8978  541     FORMAT('***** FROM THE MIDDLE  OF DPTMCO--')
8979          CALL DPWRST('XXX','BUG ')
8980          WRITE(ICOUT,542)ICASAN,NUMVAR,NLOCAL,NREPL
8981  542     FORMAT('ICASAN,NUMVAR,NLOCAL,NREPL = ',A4,2X,3I8)
8982          CALL DPWRST('XXX','BUG ')
8983          IF(NLOCAL.GE.1)THEN
8984            DO545I=1,NLOCAL
8985              WRITE(ICOUT,546)I,Y(I),XDESGN(I,1),XDESGN(I,2)
8986  546         FORMAT('I,Y(I),XDESGN(I,1),XDESGN(I,2) = ',
8987     1               I8,3F12.5)
8988              CALL DPWRST('XXX','BUG ')
8989  545       CONTINUE
8990          ENDIF
8991        ENDIF
8992C
8993C       *****************************************************
8994C       **  STEP 5C--                                      **
8995C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
8996C       **  REPLICATION VARIABLES.                         **
8997C       *****************************************************
8998C
8999        CALL DPPP5(XDESGN(1,1),XDESGN(1,2),XDESGN(1,3),
9000     1             XDESGN(1,4),XDESGN(1,5),XDESGN(1,6),
9001     1             NREPL,NLOCAL,MAXOBV,
9002     1             XIDTEM,XIDTE2,XIDTE3,XIDTE4,XIDTE5,XIDTE6,
9003     1             XTEMP1,XTEMP2,
9004     1             NUMSE1,NUMSE2,NUMSE3,NUMSE4,NUMSE5,NUMSE6,
9005     1             IBUGA3,ISUBRO,IERROR)
9006C
9007C       *****************************************************
9008C       **  STEP 5D--                                      **
9009C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
9010C       *****************************************************
9011C
9012        NPLOTP=0
9013        NCURVE=0
9014        IF(NREPL.EQ.1)THEN
9015          J=0
9016          DO1110ISET1=1,NUMSE1
9017            K=0
9018            PID(IADD+1)=XIDTEM(ISET1)
9019            DO1130I=1,NLOCAL
9020              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
9021                K=K+1
9022                TEMP1(K)=Y(I)
9023              ENDIF
9024 1130       CONTINUE
9025            NTEMP=K
9026            NCURVE=NCURVE+1
9027            IF(NTEMP.GT.0)THEN
9028              CALL DPTMC2(TEMP1,NTEMP,W,PROP1,PROP2,NTRIM1,NTRIM2,
9029     1                    XTEMP1,XTEMP2,MAXNXT,
9030     1                    PID,IVARID,IVARI2,NREPL,
9031     1                    CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9032     1                    CTL999,CTU999,
9033     1                    ICAPSW,ICAPTY,IFORSW,
9034     1                    ICASAN,ISUBRO,IBUGA3,IERROR)
9035            ENDIF
9036C
9037            IFLAGU='FILE'
9038            IFRST=.FALSE.
9039            ILAST=.FALSE.
9040            IF(NCURVE.EQ.1)IFRST=.TRUE.
9041            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
9042            CALL DPCNF3(CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9043     1                  CTL999,CTU999,
9044     1                  IFLAGU,IFRST,ILAST,ICASAN,
9045     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
9046 1110     CONTINUE
9047        ELSEIF(NREPL.EQ.2)THEN
9048          J=0
9049          NTOT=NUMSE1*NUMSE2
9050          DO1210ISET1=1,NUMSE1
9051          DO1220ISET2=1,NUMSE2
9052            K=0
9053            PID(1+IADD)=XIDTEM(ISET1)
9054            PID(2+IADD)=XIDTE2(ISET2)
9055            DO1290I=1,NLOCAL
9056              IF(
9057     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
9058     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
9059     1          )THEN
9060                K=K+1
9061                TEMP1(K)=Y(I)
9062              ENDIF
9063 1290       CONTINUE
9064            NTEMP=K
9065            NCURVE=NCURVE+1
9066            NPLOT1=NPLOTP
9067            IF(NTEMP.GT.0)THEN
9068              CALL DPTMC2(TEMP1,NTEMP,W,PROP1,PROP2,NTRIM1,NTRIM2,
9069     1                    XTEMP1,XTEMP2,MAXNXT,
9070     1                    PID,IVARID,IVARI2,NREPL,
9071     1                    CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9072     1                    CTL999,CTU999,
9073     1                    ICAPSW,ICAPTY,IFORSW,
9074     1                    ICASAN,ISUBRO,IBUGA3,IERROR)
9075            ENDIF
9076            NPLOT2=NPLOTP
9077            IFLAGU='FILE'
9078            IFRST=.FALSE.
9079            ILAST=.FALSE.
9080            IF(NCURVE.EQ.1)IFRST=.TRUE.
9081            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
9082            CALL DPCNF3(CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9083     1                  CTL999,CTU999,
9084     1                  IFLAGU,IFRST,ILAST,ICASAN,
9085     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
9086 1220     CONTINUE
9087 1210     CONTINUE
9088        ELSEIF(NREPL.EQ.3)THEN
9089          J=0
9090          NTOT=NUMSE1*NUMSE2*NUMSE3
9091          DO1310ISET1=1,NUMSE1
9092          DO1320ISET2=1,NUMSE2
9093          DO1330ISET3=1,NUMSE3
9094            K=0
9095            PID(1+IADD)=XIDTEM(ISET1)
9096            PID(2+IADD)=XIDTE2(ISET2)
9097            PID(3+IADD)=XIDTE3(ISET3)
9098            DO1390I=1,NLOCAL
9099              IF(
9100     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
9101     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
9102     1           XIDTE3(ISET3).EQ.XDESGN(I,3)
9103     1          )THEN
9104                K=K+1
9105                TEMP1(K)=Y(I)
9106              ENDIF
9107 1390       CONTINUE
9108            NTEMP=K
9109            NCURVE=NCURVE+1
9110            IF(NTEMP.GT.0)THEN
9111              CALL DPTMC2(TEMP1,NTEMP,W,PROP1,PROP2,NTRIM1,NTRIM2,
9112     1                    XTEMP1,XTEMP2,MAXNXT,
9113     1                    PID,IVARID,IVARI2,NREPL,
9114     1                    CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9115     1                    CTL999,CTU999,
9116     1                    ICAPSW,ICAPTY,IFORSW,
9117     1                    ICASAN,ISUBRO,IBUGA3,IERROR)
9118            ENDIF
9119            IFLAGU='FILE'
9120            IFRST=.FALSE.
9121            ILAST=.FALSE.
9122            IF(NCURVE.EQ.1)IFRST=.TRUE.
9123            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
9124            CALL DPCNF3(CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9125     1                  CTL999,CTU999,
9126     1                  IFLAGU,IFRST,ILAST,ICASAN,
9127     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
9128 1330     CONTINUE
9129 1320     CONTINUE
9130 1310     CONTINUE
9131        ELSEIF(NREPL.EQ.4)THEN
9132          J=0
9133          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4
9134          DO1410ISET1=1,NUMSE1
9135          DO1420ISET2=1,NUMSE2
9136          DO1430ISET3=1,NUMSE3
9137          DO1440ISET4=1,NUMSE4
9138            K=0
9139            PID(1+IADD)=XIDTEM(ISET1)
9140            PID(2+IADD)=XIDTE2(ISET2)
9141            PID(3+IADD)=XIDTE3(ISET3)
9142            PID(4+IADD)=XIDTE4(ISET4)
9143            DO1490I=1,NLOCAL
9144              IF(
9145     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
9146     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
9147     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
9148     1           XIDTE4(ISET4).EQ.XDESGN(I,4)
9149     1          )THEN
9150                K=K+1
9151                TEMP1(K)=Y(I)
9152              ENDIF
9153 1490       CONTINUE
9154            NTEMP=K
9155            NCURVE=NCURVE+1
9156            IF(NTEMP.GT.0)THEN
9157              CALL DPTMC2(TEMP1,NTEMP,W,PROP1,PROP2,NTRIM1,NTRIM2,
9158     1                    XTEMP1,XTEMP2,MAXNXT,
9159     1                    PID,IVARID,IVARI2,NREPL,
9160     1                    CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9161     1                    CTL999,CTU999,
9162     1                    ICAPSW,ICAPTY,IFORSW,
9163     1                    ICASAN,ISUBRO,IBUGA3,IERROR)
9164            ENDIF
9165            IFLAGU='FILE'
9166            IFRST=.FALSE.
9167            ILAST=.FALSE.
9168            IF(NCURVE.EQ.1)IFRST=.TRUE.
9169            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
9170            CALL DPCNF3(CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9171     1                  CTL999,CTU999,
9172     1                  IFLAGU,IFRST,ILAST,ICASAN,
9173     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
9174 1440     CONTINUE
9175 1430     CONTINUE
9176 1420     CONTINUE
9177 1410     CONTINUE
9178        ELSEIF(NREPL.EQ.5)THEN
9179          J=0
9180          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5
9181          DO1510ISET1=1,NUMSE1
9182          DO1520ISET2=1,NUMSE2
9183          DO1530ISET3=1,NUMSE3
9184          DO1540ISET4=1,NUMSE4
9185          DO1550ISET5=1,NUMSE5
9186            K=0
9187            PID(1+IADD)=XIDTEM(ISET1)
9188            PID(2+IADD)=XIDTE2(ISET2)
9189            PID(3+IADD)=XIDTE3(ISET3)
9190            PID(4+IADD)=XIDTE4(ISET4)
9191            PID(5+IADD)=XIDTE5(ISET4)
9192            DO1590I=1,NLOCAL
9193              IF(
9194     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
9195     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
9196     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
9197     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
9198     1           XIDTE5(ISET5).EQ.XDESGN(I,5)
9199     1          )THEN
9200                K=K+1
9201                TEMP1(K)=Y(I)
9202              ENDIF
9203 1590       CONTINUE
9204            NTEMP=K
9205            NCURVE=NCURVE+1
9206            IF(NTEMP.GT.0)THEN
9207              CALL DPTMC2(TEMP1,NTEMP,W,PROP1,PROP2,NTRIM1,NTRIM2,
9208     1                    XTEMP1,XTEMP2,MAXNXT,
9209     1                    PID,IVARID,IVARI2,NREPL,
9210     1                    CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9211     1                    CTL999,CTU999,
9212     1                    ICAPSW,ICAPTY,IFORSW,
9213     1                    ICASAN,ISUBRO,IBUGA3,IERROR)
9214            ENDIF
9215            IFLAGU='FILE'
9216            IFRST=.FALSE.
9217            ILAST=.FALSE.
9218            IF(NCURVE.EQ.1)IFRST=.TRUE.
9219            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
9220            CALL DPCNF3(CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9221     1                  CTL999,CTU999,
9222     1                  IFLAGU,IFRST,ILAST,ICASAN,
9223     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
9224 1550     CONTINUE
9225 1540     CONTINUE
9226 1530     CONTINUE
9227 1520     CONTINUE
9228 1510     CONTINUE
9229        ELSEIF(NREPL.EQ.6)THEN
9230          J=0
9231          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5*NUMSE6
9232          DO1610ISET1=1,NUMSE1
9233          DO1620ISET2=1,NUMSE2
9234          DO1630ISET3=1,NUMSE3
9235          DO1640ISET4=1,NUMSE4
9236          DO1650ISET5=1,NUMSE5
9237          DO1660ISET6=1,NUMSE6
9238            K=0
9239            PID(1+IADD)=XIDTEM(ISET1)
9240            PID(2+IADD)=XIDTE2(ISET2)
9241            PID(3+IADD)=XIDTE3(ISET3)
9242            PID(4+IADD)=XIDTE4(ISET4)
9243            PID(5+IADD)=XIDTE5(ISET4)
9244            PID(6+IADD)=XIDTE6(ISET4)
9245            DO1690I=1,NLOCAL
9246              IF(
9247     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
9248     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
9249     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
9250     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
9251     1           XIDTE5(ISET5).EQ.XDESGN(I,5) .AND.
9252     1           XIDTE6(ISET6).EQ.XDESGN(I,6)
9253     1          )THEN
9254                K=K+1
9255                TEMP1(K)=Y(I)
9256              ENDIF
9257 1690       CONTINUE
9258            NTEMP=K
9259            NCURVE=NCURVE+1
9260            IF(NTEMP.GT.0)THEN
9261              CALL DPTMC2(TEMP1,NTEMP,W,PROP1,PROP2,NTRIM1,NTRIM2,
9262     1                    XTEMP1,XTEMP2,MAXNXT,
9263     1                    PID,IVARID,IVARI2,NREPL,
9264     1                    CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9265     1                    CTL999,CTU999,
9266     1                    ICAPSW,ICAPTY,IFORSW,
9267     1                    ICASAN,ISUBRO,IBUGA3,IERROR)
9268            ENDIF
9269            IFLAGU='FILE'
9270            IFRST=.FALSE.
9271            ILAST=.FALSE.
9272            IF(NCURVE.EQ.1)IFRST=.TRUE.
9273            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
9274            CALL DPCNF3(CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9275     1                  CTL999,CTU999,
9276     1                  IFLAGU,IFRST,ILAST,ICASAN,
9277     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
9278 1660     CONTINUE
9279 1650     CONTINUE
9280 1640     CONTINUE
9281 1630     CONTINUE
9282 1620     CONTINUE
9283 1610     CONTINUE
9284        ENDIF
9285C
9286      ENDIF
9287C
9288C               *****************
9289C               **  STEP 90--  **
9290C               **  EXIT       **
9291C               *****************
9292C
9293 9000 CONTINUE
9294      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
9295        WRITE(ICOUT,999)
9296        CALL DPWRST('XXX','BUG ')
9297        WRITE(ICOUT,9011)
9298 9011   FORMAT('***** AT THE END       OF DPTMCO--')
9299        CALL DPWRST('XXX','BUG ')
9300        WRITE(ICOUT,9014)ICASEQ,NRIGHT(1),NS
9301 9014   FORMAT('ICASEQ,NRIGHT(1),NS = ',A4,2X,2I8)
9302        CALL DPWRST('XXX','BUG ')
9303        WRITE(ICOUT,9016)IFOUND,IERROR
9304 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
9305        CALL DPWRST('XXX','BUG ')
9306      ENDIF
9307C
9308      RETURN
9309      END
9310      SUBROUTINE DPTMC2(Y,N,W,PROP1,PROP2,NTRIM1,NTRIM2,
9311     1                  XTEMP1,XTEMP2,MAXNXT,
9312     1                  PID,IVARID,IVARI2,NREPL,
9313     1                  CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
9314     1                  CTL999,CTU999,
9315     1                  ICAPSW,ICAPTY,IFORSW,
9316     1                  ICASAN,ISUBRO,IBUGA3,IERROR)
9317C
9318C     PURPOSE--THIS ROUTINE GENERATES TRIMMED MEAN CONFIDENCE LIMITS
9319C              FOR THE DATA IN THE INPUT VECTOR Y.
9320C     NOTE--ASSUMPTION--MODEL IS   RESPONSE = CONSTANT + ERROR.
9321C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
9322C                                OF OBSERVATIONS
9323C                       N      = THE INTEGER NUMBER OF
9324C                                OBSERVATIONS IN THE VECTOR Y.
9325C     WRITTEN BY--ALAN HECKERT
9326C                 STATISTICAL ENGINEERING DIVISION
9327C                 INFORMATION TECHNOLOGY LABORATORY
9328C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9329C                 GAITHERSBURG, MD 20899-8980
9330C                 PHONE--301-975-2899
9331C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9332C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9333C     LANGUAGE--ANSI FORTRAN (1977)
9334C     VERSION NUMBER--2003/2
9335C     ORIGINAL VERSION--FEBRUARY  2003.
9336C     UPDATED         --OCTOBER   2003. ADD SUPPORT FOR HTML, LATEX
9337C                                       OUTPUT
9338C
9339C     UPDATED         --OCTOBER   2006. CALL LIST TO TPPF
9340C     UPDATED         --MARCH     2010. USE DPDTA2 AND DPDTA4 TO
9341C                                       GENERATE OUTPUT (ADDS RTF
9342C                                       SUPPORT)
9343C     UPDATED         --MARCH     2010. SOME MODIFICATIONS TO THE
9344C                                       OUTPUT (AESTHETIC, NOT
9345C                                       SUBSTANTIVE)
9346C     UPDATED         --AUGUST    2019. ADD CTL999, CTU999
9347C
9348C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
9349C
9350      CHARACTER*4 IBUGA3
9351      CHARACTER*4 ISUBRO
9352      CHARACTER*4 IERROR
9353C
9354      CHARACTER*4 IWRITE
9355      CHARACTER*4 ICASAN
9356      CHARACTER*4 ICASA2
9357      CHARACTER*4 ICAPSW
9358      CHARACTER*4 ICAPTY
9359      CHARACTER*4 IFORSW
9360C
9361      CHARACTER*4 IVARID(*)
9362      CHARACTER*4 IVARI2(*)
9363C
9364      CHARACTER*4 ISUBN1
9365      CHARACTER*4 ISUBN2
9366      CHARACTER*4 ISTEPN
9367C
9368C---------------------------------------------------------------------
9369C
9370      DIMENSION Y(*)
9371      DIMENSION W(*)
9372      DIMENSION XTEMP1(*)
9373      DIMENSION XTEMP2(*)
9374      DIMENSION PID(*)
9375C
9376      PARAMETER (NUMALP=8)
9377C
9378      DIMENSION CONF(NUMALP)
9379      DIMENSION T(NUMALP)
9380      DIMENSION TSDM(NUMALP)
9381      DIMENSION ALOWER(NUMALP)
9382      DIMENSION AUPPER(NUMALP)
9383C
9384      PARAMETER(NUMCLI=5)
9385      PARAMETER(MAXLIN=2)
9386      PARAMETER (MAXROW=20)
9387      CHARACTER*60 ITITLE
9388      CHARACTER*60 ITITLZ
9389      CHARACTER*60 ITEXT(MAXROW)
9390      REAL         AVALUE(MAXROW)
9391      INTEGER      NCTEXT(MAXROW)
9392      INTEGER      IDIGIT(MAXROW)
9393      INTEGER      NTOT(MAXROW)
9394      LOGICAL IFRST
9395      LOGICAL ILAST
9396C
9397C-----COMMON----------------------------------------------------------
9398C
9399      INCLUDE 'DPCOP2.INC'
9400C
9401C-----START POINT-----------------------------------------------------
9402C
9403      ISUBN1='DPTM'
9404      ISUBN2='C2  '
9405      IWRITE='OFF'
9406      IERROR='NO'
9407      ICASA2='TMCO'
9408C
9409      NUMDIG=7
9410      IF(IFORSW.EQ.'1')NUMDIG=1
9411      IF(IFORSW.EQ.'2')NUMDIG=2
9412      IF(IFORSW.EQ.'3')NUMDIG=3
9413      IF(IFORSW.EQ.'4')NUMDIG=4
9414      IF(IFORSW.EQ.'5')NUMDIG=5
9415      IF(IFORSW.EQ.'6')NUMDIG=6
9416      IF(IFORSW.EQ.'7')NUMDIG=7
9417      IF(IFORSW.EQ.'8')NUMDIG=8
9418      IF(IFORSW.EQ.'9')NUMDIG=9
9419      IF(IFORSW.EQ.'0')NUMDIG=0
9420      IF(IFORSW.EQ.'E')NUMDIG=-2
9421      IF(IFORSW.EQ.'-2')NUMDIG=-2
9422      IF(IFORSW.EQ.'-3')NUMDIG=-3
9423      IF(IFORSW.EQ.'-4')NUMDIG=-4
9424      IF(IFORSW.EQ.'-5')NUMDIG=-5
9425      IF(IFORSW.EQ.'-6')NUMDIG=-6
9426      IF(IFORSW.EQ.'-7')NUMDIG=-7
9427      IF(IFORSW.EQ.'-8')NUMDIG=-8
9428      IF(IFORSW.EQ.'-9')NUMDIG=-9
9429C
9430      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')THEN
9431        WRITE(ICOUT,999)
9432  999   FORMAT(1X)
9433        CALL DPWRST('XXX','WRIT')
9434        WRITE(ICOUT,51)
9435   51   FORMAT('**** AT THE BEGINNING OF DPTMC2--')
9436        CALL DPWRST('XXX','WRIT')
9437        WRITE(ICOUT,52)N,NUMDIG,PROP1,PROP2,IBUGA3,ICASAN
9438   52   FORMAT('N,NUMDIG,PROP1,PROP2,IBUGA3,ICASAN = ',
9439     1         2I8,2X,2G15.7,2X,A4,2X,A4)
9440        CALL DPWRST('XXX','WRIT')
9441        DO56I=1,N
9442          WRITE(ICOUT,57)I,Y(I),W(I)
9443   57     FORMAT('I,Y(I),W(I) = ',I8,2G15.7)
9444          CALL DPWRST('XXX','WRIT')
9445   56   CONTINUE
9446      ENDIF
9447C
9448C               ********************************************
9449C               **  STEP 1--                              **
9450C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
9451C               ********************************************
9452C
9453      ISTEPN='1'
9454      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
9455     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9456C
9457      IF(N.LT.5)THEN
9458        WRITE(ICOUT,999)
9459        CALL DPWRST('XXX','WRIT')
9460        WRITE(ICOUT,111)
9461  111   FORMAT('***** ERROR IN TRIMMED MEAN--')
9462        CALL DPWRST('XXX','WRIT')
9463        WRITE(ICOUT,112)
9464  112   FORMAT('      THE NUMBER OF OBSERVATIONS IN THE RESPONSE ',
9465     1         'VARIABLE IS LESS THAN 5')
9466        CALL DPWRST('XXX','WRIT')
9467        WRITE(ICOUT,113)N
9468  113   FORMAT('SAMPLE SIZE = ',I8)
9469        CALL DPWRST('XXX','WRIT')
9470        IERROR='YES'
9471        GOTO9000
9472      ENDIF
9473C
9474      HOLD=Y(1)
9475      DO135I=2,N
9476      IF(Y(I).NE.HOLD)GOTO139
9477  135 CONTINUE
9478      WRITE(ICOUT,999)
9479      CALL DPWRST('XXX','WRIT')
9480      WRITE(ICOUT,111)
9481      CALL DPWRST('XXX','WRIT')
9482      WRITE(ICOUT,131)HOLD
9483  131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
9484      CALL DPWRST('XXX','WRIT')
9485      GOTO9000
9486  139 CONTINUE
9487C
9488C               ***************************************************
9489C               **  STEP 3--                                     **
9490C               **  COMPUTE THE TRIMMED MEAN LOCATION ESTIMATE   **
9491C               **  COMPUTE THE TRIMMED MEAN STANDARD ERROR      **
9492C               ***************************************************
9493C
9494C
9495      ISTEPN='3'
9496      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
9497     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9498C
9499      IWRITE='OFF'
9500C
9501      CALL TRIMME(Y,N,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,XTEMP1,
9502     1            MAXNXT,YTRMME,
9503     1            IBUGA3,ISUBRO,IERROR)
9504      CALL TRIMSE(Y,N,PROP1,PROP2,NRIM1,NTRIM2,IWRITE,XTEMP1,XTEMP2,
9505     1            MAXNXT,YTRMSE,
9506     1            IBUGA3,ISUBRO,IERROR)
9507C
9508      AN1=N
9509      LAMBDA=INT(AN1*(PROP1+PROP2)/100.)
9510      V=0.7*(AN1-1.0)
9511      IV=N - LAMBDA - 1
9512      IF(IV.LT.1)IV=1
9513C
9514C               ***************************************
9515C               **  STEP 4--                         **
9516C               **  COMPUTE CONFIDENCE LIMITS        **
9517C               **  FOR VARIOUS PROBABILITY VALUES.  **
9518C               ***************************************
9519C
9520      ISTEPN='4'
9521      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
9522     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9523C
9524      CONF(1)=50.0
9525      CONF(2)=75.0
9526      CONF(3)=90.0
9527      CONF(4)=95.0
9528      CONF(5)=99.0
9529      CONF(6)=99.9
9530      CONF(7)=99.99
9531      CONF(8)=99.999
9532C
9533      DO1400I=1,8
9534        PCONF=CONF(I)/100.0
9535        CDF=0.5+PCONF/2.0
9536        CALL TPPF(CDF,REAL(IV),T(I))
9537        TSDM(I)=T(I)*YTRMSE
9538        ALOWER(I)=YTRMME-TSDM(I)
9539        AUPPER(I)=YTRMME+TSDM(I)
9540 1400 CONTINUE
9541      CUTL90=ALOWER(3)
9542      CUTU90=AUPPER(3)
9543      CUTL95=ALOWER(4)
9544      CUTU95=AUPPER(4)
9545      CUTL99=ALOWER(5)
9546      CUTU99=AUPPER(5)
9547      CTL999=ALOWER(6)
9548      CTU999=AUPPER(6)
9549C
9550C     ADD A FUDGE FACTOR SO THAT CONFIDENCE LEVEL WILL
9551C     BE PRINTED CORRECTLY TO 3 DECIMAL PLACES.
9552C
9553      CONF(1)=50.0001
9554      CONF(2)=75.0001
9555      CONF(3)=90.0001
9556      CONF(4)=95.0001
9557      CONF(5)=99.0001
9558      CONF(6)=99.9001
9559      CONF(7)=99.9901
9560      CONF(8)=99.9991
9561C
9562C               ****************************
9563C               **  STEP 7--              **
9564C               **  WRITE EVERYTHING OUT  **
9565C               ****************************
9566C
9567      ISTEPN='7'
9568      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
9569     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9570C
9571      IF(IPRINT.EQ.'OFF')GOTO9000
9572C
9573      ITITLE='Confidence Limits for the Trimmed Mean'
9574      NCTITL=38
9575      ITITLZ='(Two-Sided)'
9576      NCTITZ=11
9577C
9578      ICNT=1
9579      ITEXT(ICNT)=' '
9580      NCTEXT(ICNT)=0
9581      AVALUE(ICNT)=0.0
9582      IDIGIT(ICNT)=-1
9583      ICNT=ICNT+1
9584      ITEXT(ICNT)='Response Variable: '
9585      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
9586      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
9587      NCTEXT(ICNT)=27
9588      AVALUE(ICNT)=0.0
9589      IDIGIT(ICNT)=-1
9590C
9591      IF(NREPL.GT.0)THEN
9592        NRESP=1
9593        DO4101I=1,NREPL
9594          ICNT=ICNT+1
9595          ITEMP=I+NRESP
9596          ITEXT(ICNT)='Factor Variable  : '
9597          WRITE(ITEXT(ICNT)(17:17),'(I1)')I
9598          WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(ITEMP)(1:4)
9599          WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(ITEMP)(1:4)
9600          NCTEXT(ICNT)=27
9601          AVALUE(ICNT)=PID(ITEMP)
9602          IDIGIT(ICNT)=NUMDIG
9603 4101   CONTINUE
9604      ENDIF
9605C
9606      ICNT=ICNT+1
9607      ITEXT(ICNT)=' '
9608      NCTEXT(ICNT)=1
9609      AVALUE(ICNT)=0.0
9610      IDIGIT(ICNT)=-1
9611C
9612      ICNT=ICNT+1
9613      ITEXT(ICNT)='Summary Statistics:'
9614      NCTEXT(ICNT)=19
9615      AVALUE(ICNT)=0.0
9616      IDIGIT(ICNT)=-1
9617      ICNT=ICNT+1
9618      ITEXT(ICNT)='Number of Observations:'
9619      NCTEXT(ICNT)=23
9620      AVALUE(ICNT)=REAL(N)
9621      IDIGIT(ICNT)=0
9622      ICNT=ICNT+1
9623      ITEXT(ICNT)='Percentage Trimmed Below:'
9624      NCTEXT(ICNT)=25
9625      AVALUE(ICNT)=PROP1
9626      IDIGIT(ICNT)=NUMDIG
9627      ICNT=ICNT+1
9628      ITEXT(ICNT)='Percentage Trimmed Above:'
9629      NCTEXT(ICNT)=25
9630      AVALUE(ICNT)=PROP2
9631      IDIGIT(ICNT)=NUMDIG
9632      ICNT=ICNT+1
9633      ITEXT(ICNT)='Sample Trimmed Mean:'
9634      NCTEXT(ICNT)=20
9635      AVALUE(ICNT)=YTRMME
9636      IDIGIT(ICNT)=NUMDIG
9637      ICNT=ICNT+1
9638      ITEXT(ICNT)='Sample Trimmed Mean Standard Error:'
9639      NCTEXT(ICNT)=35
9640      AVALUE(ICNT)=YTRMSE
9641      IDIGIT(ICNT)=NUMDIG
9642      ICNT=ICNT+1
9643      ITEXT(ICNT)='Degrees of Freedom:'
9644      NCTEXT(ICNT)=19
9645      AVALUE(ICNT)=REAL(IV)
9646      IDIGIT(ICNT)=NUMDIG
9647      ICNT=ICNT+1
9648      ITEXT(ICNT)=' '
9649      NCTEXT(ICNT)=1
9650      AVALUE(ICNT)=0.0
9651      IDIGIT(ICNT)=-1
9652C
9653      NUMROW=ICNT
9654      DO4210I=1,NUMROW
9655        NTOT(I)=15
9656 4210 CONTINUE
9657C
9658      IFRST=.TRUE.
9659      ILAST=.TRUE.
9660C
9661      ISTEPN='5A'
9662      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
9663     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9664C
9665      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
9666     1            AVALUE,IDIGIT,
9667     1            NTOT,NUMROW,
9668     1            ICAPSW,ICAPTY,ILAST,IFRST,
9669     1            ISUBRO,IBUGA3,IERROR)
9670C
9671      ISTEPN='5B'
9672      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CNF2')
9673     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9674C
9675      CALL DPDT11(CONF,T,TSDM,ALOWER,AUPPER,
9676     1            ICASA2,ICAPSW,ICAPTY,NUMDIG,
9677     1            ISUBRO,IBUGA3,IERROR)
9678C
9679C               *****************
9680C               **  STEP 90--  **
9681C               **  EXIT       **
9682C               *****************
9683C
9684 9000 CONTINUE
9685      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')THEN
9686      WRITE(ICOUT,999)
9687      CALL DPWRST('XXX','WRIT')
9688      WRITE(ICOUT,9011)
9689 9011 FORMAT('***** AT THE END       OF DPTMC2--')
9690      CALL DPWRST('XXX','WRIT')
9691      WRITE(ICOUT,9012)N,IBUGA3,IERROR
9692 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
9693      CALL DPWRST('XXX','WRIT')
9694      WRITE(ICOUT,9013)YTRMME,YTRMSE,IV
9695 9013 FORMAT('YTRMME,YTRMSE,IV = ',2G15.7,I8)
9696      CALL DPWRST('XXX','WRIT')
9697      ENDIF
9698C
9699      RETURN
9700      END
9701      SUBROUTINE DPTNS1(Y,X,N,T,
9702     1                  TEMP1,
9703     1                  MUMOME,SDMOME,MUML,SDML,
9704     1                  MUMLSE,SDMLSE,COVSE,
9705     1                  ISUBRO,IBUGA3,IERROR)
9706C
9707C     PURPOSE--THIS ROUTINE ESTIMATES THE PARAMETERS FOR THE
9708C              "DETECTION LIMIT PLOT" COMMAND.  NOTE THAT THIS
9709C              IS ACTUALLY A SINGLY LEFT CENSORED PROBLEM (THE
9710C              DISTINCTION BETWEEN CENSORING AND TRUNCATION IS
9711C              THAT FOR THE CENSORED CASE WE KNOW HOW MANY
9712C              MEASUREMENTS ARE RESTRICTED WHILE FOR THE TRUNCATED
9713C              CASE WE DO NOT.
9714C
9715C              THE 3-MOMENT  ESTIMATES ARE:
9716C
9717C                  SIGMA* = SQRT{(V1P**2 - V1P*V2P)/(V2P - 2*V1P**2)}
9718C                  MU*    = T + A*
9719C
9720C              WHERE
9721C
9722C                  A*   = (V3P - 2*V1P*V2P)/(V2P - 2*V1P**2)
9723C                  V1P  = XBAR - T
9724C                  V2P = S**2 + (XBAR - T)**2
9725C                  V3P = SUM[i=1 to n][(X(i) - XBAR)**3]/n
9726C
9727C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
9728C
9729C                  SIGMAHAT = SQRT{S**2 + lambda(h,alphahat)*(XBAR - T)**2}
9730C                  MUHAT    = XBAR - lambda(h,alphahat)*(XBAR - T)
9731C
9732C              WHERE
9733C
9734C                   alphahat = S**2/(XBAR - T)**2
9735C                   h        = c/N
9736C                   N        = TOTAL NUMBER OF OBSERVATIONS
9737C                   n        = NUMBER OF NON-TRUNCATED OBSERVATIONS
9738C                   c        = NUMBER OF TRUNCATED OBSERVATIONS
9739C
9740C               XBAR AND S ARE THE MEAN AND SD OF THE NON-TRUNCATED
9741C               OBSERVATIONS.
9742C
9743C               LAMBDA(H,ALPHAHAT) IS A TABULATED VALUE IN THE
9744C               COHEN REFERENCE.  HOWEVER, WE DETERMINE IT BY
9745C               SOLVING THE FUNCTION
9746C
9747C                  ((1 - OMEGA(h,XI)*(OMEGA(h,XI) - XI))/
9748C                  (OMEGA(h,XI) - XI)**2) - S**2/(MU - T)**2
9749C
9750C               FOR XI WHERE
9751C
9752C                  OMEGA(h,XI) = (h/(1-h))*NORPDF(XI)/NORCDF(XI)
9753C
9754C               NOTE THAT XI IS THE STANDARDIZED TRUNCATION
9755C               POINT.  ONCE WE SOLVE FOR XI, WE PLUG IT INTO
9756C               THE FUNCTION
9757C
9758C                   LAMBDA = OMEGA(h,XI)/(OMEGA(h,XI) - XI)
9759C
9760C               NOTE THAT THERE MAY BE TWO SOLUTIONS TO THIS
9761C               EQUATION.  WE PICK THE ONE THAT RESULTS IN A
9762C               POSITIVE LAMBDA.
9763C
9764C     REFERENCE--CLIFFORD COHEN (1991), "TRUNCATED AND CENSORED
9765C                SAMPLES", MARCEL DEKKER INC., CHAPTER 2.
9766C     WRITTEN BY--JAMES J. FILLIBEN
9767C                 STATISTICAL ENGINEERING DIVISION
9768C                 INFORMATION TECHNOLOGY LABORATORY
9769C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9770C                 GAITHERSBURG, MD 20899-8980
9771C                 PHONE--301-975-2855
9772C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9773C           OF THE NATIONAL BUREAU OF STANDARDS.
9774C     LANGUAGE--ANSI FORTRAN (1977)
9775C     VERSION NUMBER--2008/12
9776C     ORIGINAL VERSION--DECEMBER  2008.
9777C
9778C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
9779C
9780      CHARACTER*4 ISUBRO
9781      CHARACTER*4 IBUGA3
9782      CHARACTER*4 IERROR
9783C
9784      CHARACTER*4 IWRITE
9785      CHARACTER*4 ISUBN1
9786      CHARACTER*4 ISUBN2
9787C
9788C---------------------------------------------------------------------
9789C
9790      DIMENSION Y(*)
9791      DIMENSION X(*)
9792      DIMENSION TEMP1(*)
9793C
9794      DOUBLE PRECISION DSUM1
9795      DOUBLE PRECISION DMEAN
9796      DOUBLE PRECISION DVARI
9797      DOUBLE PRECISION DT
9798      DOUBLE PRECISION V1P
9799      DOUBLE PRECISION V2P
9800      DOUBLE PRECISION V3P
9801      DOUBLE PRECISION DNTOT
9802      DOUBLE PRECISION DNFULL
9803      DOUBLE PRECISION DPDF
9804      DOUBLE PRECISION DCDF
9805      DOUBLE PRECISION DTERM1
9806      DOUBLE PRECISION DNUM1
9807      DOUBLE PRECISION DNUM2
9808      DOUBLE PRECISION DDENOM
9809      DOUBLE PRECISION DDENO2
9810      DOUBLE PRECISION DOMEGA
9811      DOUBLE PRECISION DLAMB
9812      DOUBLE PRECISION DQ
9813      DOUBLE PRECISION DPHI11
9814      DOUBLE PRECISION DPHI12
9815      DOUBLE PRECISION DPHI22
9816      DOUBLE PRECISION DU11
9817      DOUBLE PRECISION DU12
9818      DOUBLE PRECISION DU22
9819C
9820      REAL MUMOME
9821      REAL SDMOME
9822      REAL MUML
9823      REAL SDML
9824      REAL MUMLSE
9825      REAL SDMLSE
9826C
9827      DOUBLE PRECISION AE
9828      DOUBLE PRECISION RE
9829      DOUBLE PRECISION XLOW
9830      DOUBLE PRECISION XUP
9831      DOUBLE PRECISION XMID
9832      DOUBLE PRECISION XI
9833C
9834      DOUBLE PRECISION TNRFUN
9835      EXTERNAL TNRFUN
9836C
9837      DOUBLE PRECISION DC1
9838      DOUBLE PRECISION DH
9839      COMMON/TNRCOM/DC1,DH
9840C
9841C-----COMMON----------------------------------------------------------
9842C
9843      INCLUDE 'DPCOP2.INC'
9844C
9845C-----START POINT-----------------------------------------------------
9846C
9847      ISUBN1='DPTN'
9848      ISUBN2='S1  '
9849      IERROR='NO'
9850      IWRITE='OFF'
9851C
9852C               ********************************************
9853C               **  STEP 1--                              **
9854C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
9855C               ********************************************
9856C
9857      IF(N.LE.2)THEN
9858        WRITE(ICOUT,999)
9859  999   FORMAT(1X)
9860        CALL DPWRST('XXX','BUG ')
9861        WRITE(ICOUT,31)
9862   31   FORMAT('***** ERROR IN TRUNCATED NORMAL SINGLY TRUNCATED ',
9863     1         'PARAMETER ESTIMATION--')
9864        CALL DPWRST('XXX','BUG ')
9865        WRITE(ICOUT,32)
9866   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
9867        CALL DPWRST('XXX','BUG ')
9868        WRITE(ICOUT,34)N
9869   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
9870        CALL DPWRST('XXX','BUG ')
9871        WRITE(ICOUT,999)
9872        CALL DPWRST('XXX','BUG ')
9873        IERROR='YES'
9874        GOTO9000
9875      ENDIF
9876C
9877      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TNS1')THEN
9878        WRITE(ICOUT,999)
9879        CALL DPWRST('XXX','BUG ')
9880        WRITE(ICOUT,70)
9881   70   FORMAT('***** AT THE BEGINNING OF DPTNS1--')
9882        CALL DPWRST('XXX','BUG ')
9883        WRITE(ICOUT,71)N
9884   71   FORMAT('N = ',I8)
9885        CALL DPWRST('XXX','BUG ')
9886        DO73I=1,N
9887          WRITE(ICOUT,74)I,Y(I),X(I)
9888   74     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
9889          CALL DPWRST('XXX','BUG ')
9890   73   CONTINUE
9891      ENDIF
9892C
9893C               **********************************************
9894C               **  STEP 2--                                **
9895C               **  COMPUTE SUMMARY STATISTICS              **
9896C               **********************************************
9897C
9898      MUMOME=0.0
9899      SDMOME=0.0
9900      MUML=0.0
9901      SDML=0.0
9902C
9903      NC=0
9904      NFULL=0
9905      YMIN=CPUMAX
9906      DSUM1=0.0D0
9907C
9908      DO1010I=1,N
9909        IF(X(I).GT.0.0)THEN
9910          NFULL=NFULL+1
9911          TEMP1(NFULL)=Y(I)
9912          DSUM1=DSUM1 + DBLE(Y(I))
9913          IF(Y(I).LT.YMIN)YMIN=Y(I)
9914        ELSE
9915          NC=NC+1
9916        ENDIF
9917 1010 CONTINUE
9918      DNFULL=DBLE(NFULL)
9919      DNC=DBLE(NC)
9920      DNTOT=DBLE(N)
9921      DMEAN=DSUM1/DNFULL
9922      IF(T.GT.CPUMIN .AND. T.LE.YMIN)THEN
9923        DT=DBLE(T)
9924      ELSE
9925        DT=DBLE(YMIN)
9926      ENDIF
9927C
9928      IF(NFULL.LT.2)THEN
9929        WRITE(ICOUT,999)
9930        CALL DPWRST('XXX','BUG ')
9931        WRITE(ICOUT,31)
9932        CALL DPWRST('XXX','BUG ')
9933        WRITE(ICOUT,1012)
9934 1012   FORMAT('      THE NUMBER OF UNTRUNCATED OBSERVATIONS MUST BE ',
9935     1         'AT LEAST 2.')
9936        CALL DPWRST('XXX','BUG ')
9937        WRITE(ICOUT,1014)NFULL
9938 1014   FORMAT('      THE NUMBER OF UNTRUNCATED OBSERVATIONS HERE = ',
9939     1         I8)
9940        CALL DPWRST('XXX','BUG ')
9941        WRITE(ICOUT,999)
9942        CALL DPWRST('XXX','BUG ')
9943        IERROR='YES'
9944        GOTO9000
9945      ENDIF
9946C
9947      DVARI=0.0D0
9948      V3P=0.0D0
9949      DO1020I=1,NFULL
9950        DVARI=DVARI + (DBLE(TEMP1(I)) - DMEAN)**2/DNFULL
9951        V3P=V3P + (DBLE(TEMP1(I)) - DT)**3/DNFULL
9952 1020 CONTINUE
9953      V1P=DMEAN - DT
9954      V2P=DVARI + (DMEAN - DT)**2
9955C
9956      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TNS1')THEN
9957        WRITE(ICOUT,999)
9958        CALL DPWRST('XXX','BUG ')
9959        WRITE(ICOUT,1031)
9960 1031   FORMAT('***** DPTNS1: AFTER COMPUTE SUMMARY STATISTICS')
9961        CALL DPWRST('XXX','BUG ')
9962        WRITE(ICOUT,1032)N,NFULL,NC
9963 1032   FORMAT('N,NFULL,NC = ',3I8)
9964        CALL DPWRST('XXX','BUG ')
9965        WRITE(ICOUT,1033)DMEAN,DVARI,DT,V1P,V2P,V3P
9966 1033   FORMAT('DMEAN,DVARI,DT,V1P,V2P,V3P = ',6G15.7)
9967        CALL DPWRST('XXX','BUG ')
9968      ENDIF
9969C
9970C               **********************************************
9971C               **  STEP 3--                                **
9972C               **  COMPUTE 3-MOMENT ESTIMATES              **
9973C               **********************************************
9974C
9975      DNUM1=V2P**2 - V1P*V3P
9976      DDENOM=V2P - 2.0D0*V1P**2
9977      SDMOME=REAL(DSQRT(DNUM1/DDENOM))
9978      DNUM2=V3P - 2.0D0*V1P*V2P
9979      DDENO2=V2P - 2.0D0*V1P**2
9980      MUMOME=REAL(DT + (DNUM2/DDENO2))
9981C
9982      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TNS1')THEN
9983        WRITE(ICOUT,999)
9984        CALL DPWRST('XXX','BUG ')
9985        WRITE(ICOUT,1101)
9986 1101   FORMAT('***** DPTNS1: AFTER COMPUTE 3-MOMENT ESTIMATES')
9987        CALL DPWRST('XXX','BUG ')
9988        WRITE(ICOUT,1102)DNUM1,DDENOM,SDMOME
9989 1102   FORMAT('DNUM1,DDENOM,SDMOME = ',3G15.7)
9990        CALL DPWRST('XXX','BUG ')
9991        WRITE(ICOUT,1103)DNUM2,DDENO2,MUMOME
9992 1103   FORMAT('DNUM2,DENO2,MUMOME = ',3G15.7)
9993        CALL DPWRST('XXX','BUG ')
9994      ENDIF
9995C
9996C               **********************************************
9997C               **  STEP 4--                                **
9998C               **  COMPUTE MAXIMUM LIKELIHOOD ESTIMATES    **
9999C               **********************************************
10000C
10001C     DEFINE SOME CONSTANTS FOR THE FUNCTION SOLVER
10002C
10003      DH=DNC/DNTOT
10004      DC1=DVARI/(DMEAN - DT)**2
10005C
10006C     USE DFZERO TO SOLVE THE LAMBDAHAT FUNCTION
10007C
10008      AE=1.D-7
10009      RE=1.D-7
10010      XLOW=-10.0D0
10011      XUP=10.0D0
10012      IF(DMEAN.GT.DT)THEN
10013        XMID=-1.0D0
10014      ELSE
10015        XMID=1.0D0
10016      ENDIF
10017      ITER=0
10018C
10019 1410 CONTINUE
10020      CALL DFZERO(TNRFUN,XLOW,XUP,XMID,RE,AE,IFLAG)
10021      XI=XLOW
10022C
10023C     NOW EVALUATE - CHECK FOR POSITIVE RESULT
10024C
10025      CALL NODPDF(XI,DPDF)
10026      CALL NODCDF(XI,DCDF)
10027      DOMEGA=(DH/(1.0D0-DH))*DPDF/DCDF
10028      DLAMB=DOMEGA/(DOMEGA - XI)
10029      IF(DLAMB.LT.0.0D0)THEN
10030        IF(ITER.EQ.0)THEN
10031          ITER=1
10032          XLOW=-10.0D0
10033          XUP=XI-0.1D0
10034          XMID=(XLOW+XUP)/2.0D0
10035          GOTO1410
10036        ELSEIF(ITER.EQ.1)THEN
10037          ITER=2
10038          XLOW=XI+0.1D0
10039          XUP=10.0D0
10040          XMID=(XLOW+XUP)/2.0D0
10041          GOTO1410
10042        ELSE
10043          WRITE(ICOUT,999)
10044          CALL DPWRST('XXX','BUG ')
10045          WRITE(ICOUT,31)
10046          CALL DPWRST('XXX','BUG ')
10047          WRITE(ICOUT,1413)
10048 1413     FORMAT('      UNABLE TO DETERMINE MAXIMUM LIKELIHOOD ',
10049     1           'ESTIMATES.')
10050          CALL DPWRST('XXX','BUG ')
10051          GOTO1499
10052        ENDIF
10053      ENDIF
10054C
10055      SDML=REAL(DSQRT(DVARI + DLAMB*(DMEAN - DT)**2))
10056      MUML=REAL(DMEAN - DLAMB*(DMEAN - DT))
10057C
10058C     NOW COMPUTE STANDARD ERRORS
10059C
10060      IF(DCDF.GE.1.0D0)THEN
10061        WRITE(ICOUT,999)
10062        CALL DPWRST('XXX','BUG ')
10063        WRITE(ICOUT,1431)
10064 1431   FORMAT('***** WARNING IN TRUNCATED NORMAL SINGLY TRUNCATED ',
10065     1         'PARAMETER ESTIMATION--')
10066        CALL DPWRST('XXX','BUG ')
10067        WRITE(ICOUT,1433)
10068 1433   FORMAT('      UNABLE TO COMPUTE STANDARD ERRORS OF THE ',
10069     1         'MAXIMUM LIKELIHOOD ESTIMATES.')
10070        CALL DPWRST('XXX','BUG ')
10071        GOTO1499
10072      ENDIF
10073C
10074      DQ=DPDF/(1.0D0 - DCDF)
10075      DPHI11=1.0D0 - DQ*(DQ - XI)
10076      DPHI12=DQ*(1.0D0 - XI*(DQ - XI))
10077      DPHI22=2.0D0 + XI*DPHI12
10078      DDENOM=DPHI11*DPHI22 - DPHI12**2
10079      DU11=DPHI22/DDENOM
10080      DU22=DPHI11/DDENOM
10081      DU12=-DPHI12/DDENOM
10082CCCCC DTERM1=DBLE(SDML)**2/DBLE(NFULL)
10083      DTERM1=DBLE(SDML)**2/DNTOT
10084      MUMLSE=REAL(DSQRT(DTERM1*DU11))
10085      SDMLSE=REAL(DSQRT(DTERM1*DU22))
10086      COVSE=REAL(DTERM1*DU12)
10087C
10088 1499 CONTINUE
10089C
10090      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TNS1')THEN
10091        WRITE(ICOUT,999)
10092        CALL DPWRST('XXX','BUG ')
10093        WRITE(ICOUT,1111)
10094 1111   FORMAT('***** DPTNS1: AFTER COMPUTE ML ESTIMATES')
10095        CALL DPWRST('XXX','BUG ')
10096        WRITE(ICOUT,1112)DH,XI,DPDF,DCDF
10097 1112   FORMAT('DH,XI,DPDF,DCDF = ',4G15.7)
10098        CALL DPWRST('XXX','BUG ')
10099        WRITE(ICOUT,1113)DTERM1,DOMEGA,DLAMB
10100 1113   FORMAT('DTERM1,DOMEGA,DLAMB = ',3G15.7)
10101        CALL DPWRST('XXX','BUG ')
10102        WRITE(ICOUT,1114)MUML,SDML
10103 1114   FORMAT('MUML,SDML = ',2G15.7)
10104        CALL DPWRST('XXX','BUG ')
10105        WRITE(ICOUT,1115)DQ,DPHI11,DPHI12,DPHI22
10106 1115   FORMAT('DQ,DPHI11,DPHI12,DPHI22 = ',4G15.7)
10107        CALL DPWRST('XXX','BUG ')
10108        WRITE(ICOUT,1116)DDENOM,DU11,DU22,DU12
10109 1116   FORMAT('DDENOM,DU11,DU22,DU12 = ',4G15.7)
10110        CALL DPWRST('XXX','BUG ')
10111      ENDIF
10112C
10113C               ******************
10114C               **   STEP 90--  **
10115C               **   EXIT       **
10116C               ******************
10117C
10118 9000 CONTINUE
10119      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TNS1')THEN
10120        WRITE(ICOUT,999)
10121        CALL DPWRST('XXX','BUG ')
10122        WRITE(ICOUT,9011)
10123 9011   FORMAT('***** AT THE END       OF DPTNS1--')
10124        CALL DPWRST('XXX','BUG ')
10125      ENDIF
10126C
10127      RETURN
10128      END
10129      SUBROUTINE DPTOLI(XTEMP1,XTEMP2,XTEMP3,MAXNXT,
10130     1                  ICASAN,ICAPSW,IFORSW,
10131     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
10132C
10133C     PURPOSE--GENERATE TOLERANCE LIMITS
10134C     WRITTEN BY--JAMES J. FILLIBEN
10135C                 STATISTICAL ENGINEERING DIVISION
10136C                 INFORMATION TECHNOLOGY LABORATORY
10137C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10138C                 GAITHERSBURG, MD 20899-8980
10139C                 PHONE--301-975-2855
10140C     EXAMPLE--TOLERANCE LIMITS Y
10141C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10142C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
10143C     LANGUAGE--ANSI FORTRAN (1977)
10144C     VERSION NUMBER--98/11
10145C     ORIGINAL VERSION--NOVEMBER  1998.
10146C     UPDATED         --MARCH     2011. USE DPPARS ROUTINE
10147C     UPATED          --MARCH     2011. REWRITTEN TO HANDLE MULTIPLE
10148C                                       RESPONSE VARIABLES, GROUP-ID
10149C                                       VARIABLES, OR A LAB-ID VARIABLE
10150C     UPATED          --AUGUST    2011. CHECK FOR CONFLICT WITH ABASIS AND
10151C                                       BBASIS TOLERANCE INTERVALS
10152C     UPATED          --AUGUST    2011. ADD ONE-SIDED CASE FOR NORMAL TOLERANCE
10153C                                       LIMITS
10154C     UPATED          --AUGUST    2011. ADD SUMMARY DATA FOR NORMAL TOLERANCE
10155C                                       LIMITS (I.E., MEAN, SD, SAMPLE SIZE)
10156C     UPATED          --AUGUST    2011. ADD WEIBULL TOLERANCE LIMITS
10157C     UPATED          --MAY       2014. ADD LOGNORMAL TOLERANCE LIMITS
10158C     UPATED          --MAY       2014. ADD BOX COX TOLERANCE LIMITS
10159C     UPATED          --JULY      2019. TWEAK SCRATCH SPACE
10160C
10161C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10162C
10163      CHARACTER*4 ICASAN
10164      CHARACTER*4 ICASA2
10165      CHARACTER*4 ICAPSW
10166      CHARACTER*4 ICASDI
10167      CHARACTER*4 IFORSW
10168      CHARACTER*4 IBUGA2
10169      CHARACTER*4 IBUGA3
10170      CHARACTER*4 IBUGQ
10171      CHARACTER*4 ISUBRO
10172      CHARACTER*4 IFOUND
10173      CHARACTER*4 IERROR
10174C
10175      CHARACTER*4 IDATSW
10176      CHARACTER*4 ISUBN1
10177      CHARACTER*4 ISUBN2
10178      CHARACTER*4 ISTEPN
10179      CHARACTER*4 IREPL
10180      CHARACTER*4 IMULT
10181      CHARACTER*4 ICTMP1
10182      CHARACTER*4 ICTMP2
10183      CHARACTER*4 ICTMP3
10184      CHARACTER*4 ICTMP4
10185      CHARACTER*4 ICASE
10186C
10187      CHARACTER*40 INAME
10188      PARAMETER (MAXSPN=30)
10189      CHARACTER*4 IVARN1(MAXSPN)
10190      CHARACTER*4 IVARN2(MAXSPN)
10191      CHARACTER*4 IVARTY(MAXSPN)
10192      CHARACTER*4 IVARID(1)
10193      CHARACTER*4 IVARI2(1)
10194      REAL PVAR(MAXSPN)
10195      REAL PID(MAXSPN)
10196      INTEGER ILIS(MAXSPN)
10197      INTEGER NRIGHT(MAXSPN)
10198      INTEGER ICOLR(MAXSPN)
10199C
10200C---------------------------------------------------------------------
10201C
10202      INCLUDE 'DPCOPA.INC'
10203C
10204      DIMENSION XTEMP1(*)
10205      DIMENSION XTEMP2(*)
10206      DIMENSION XTEMP3(*)
10207      DIMENSION Y1(MAXOBV)
10208C
10209      DIMENSION XDESGN(MAXOBV,7)
10210      DIMENSION XIDTEM(MAXOBV)
10211      DIMENSION XIDTE2(MAXOBV)
10212      DIMENSION XIDTE3(MAXOBV)
10213      DIMENSION XIDTE4(MAXOBV)
10214      DIMENSION XIDTE5(MAXOBV)
10215      DIMENSION XIDTE6(MAXOBV)
10216C
10217      DIMENSION TEMP1(MAXOBV)
10218      DOUBLE PRECISION DTEMP1(MAXOBV)
10219C
10220      INCLUDE 'DPCOZZ.INC'
10221      INCLUDE 'DPCOZD.INC'
10222C
10223      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
10224      EQUIVALENCE (GARBAG(IGARB2),TEMP1(1))
10225      EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
10226      EQUIVALENCE (GARBAG(IGARB4),XIDTE2(1))
10227      EQUIVALENCE (GARBAG(IGARB5),XIDTE3(1))
10228      EQUIVALENCE (GARBAG(IGARB6),XIDTE4(1))
10229      EQUIVALENCE (GARBAG(IGARB7),XIDTE5(1))
10230      EQUIVALENCE (GARBAG(IGARB8),XIDTE6(1))
10231      EQUIVALENCE (GARBAG(IGARB9),XDESGN(1,1))
10232      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1))
10233C
10234C-----COMMON----------------------------------------------------------
10235C
10236      INCLUDE 'DPCOHK.INC'
10237      INCLUDE 'DPCODA.INC'
10238      INCLUDE 'DPCOSU.INC'
10239      INCLUDE 'DPCOS2.INC'
10240      INCLUDE 'DPCOHO.INC'
10241      INCLUDE 'DPCOMC.INC'
10242      INCLUDE 'DPCOST.INC'
10243      INCLUDE 'DPCOP2.INC'
10244C
10245C-----START POINT-----------------------------------------------------
10246C
10247      IERROR='NO'
10248      IFOUND='NO'
10249      ICASAN='TOLE'
10250      ICASA2='TWOS'
10251      ICASDI='NORM'
10252      IREPL='OFF'
10253      IMULT='OFF'
10254      ISUBN1='DPTO'
10255      ISUBN2='LI  '
10256      XMEAN=CPUMIN
10257      XSD=CPUMIN
10258      AN=CPUMIN
10259C
10260      MAXCP1=MAXCOL+1
10261      MAXCP2=MAXCOL+2
10262      MAXCP3=MAXCOL+3
10263      MAXCP4=MAXCOL+4
10264      MAXCP5=MAXCOL+5
10265      MAXCP6=MAXCOL+6
10266C
10267C               ***********************************************
10268C               **  TREAT THE TOLERANCE LIMITS TEST  CASE    **
10269C               ***********************************************
10270C
10271      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TOLI')THEN
10272        WRITE(ICOUT,999)
10273  999   FORMAT(1X)
10274        CALL DPWRST('XXX','BUG ')
10275        WRITE(ICOUT,51)
10276   51   FORMAT('***** AT THE BEGINNING OF DPTOLI--')
10277        CALL DPWRST('XXX','BUG ')
10278        WRITE(ICOUT,52)ICASAN,MAXNXT
10279   52   FORMAT('ICASAN,MAXNXT = ',A4,2X,I8)
10280        CALL DPWRST('XXX','BUG ')
10281        WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ,ISUBRO
10282   53   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
10283        CALL DPWRST('XXX','BUG ')
10284      ENDIF
10285C
10286C               *****************************************************
10287C               **  STEP 1--                                       **
10288C               **  EXTRACT THE COMMAND                            **
10289C               **  LOOK FOR ONE OF THE FOLLOWING COMMANDS:        **
10290C               **    1) TOLERANCE LIMITS Y                        **
10291C               **    2) MULTIPLE TOLERANCE LIMITS Y1 ... YK       **
10292C               **    3) REPLICATED TOLERANCE LIMITS Y X1 ... XK   **
10293C               *****************************************************
10294C
10295      ISTEPN='1'
10296      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')
10297     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10298C
10299      ILASTC=9999
10300      ILASTZ=9999
10301      ICASAN='TOLE'
10302      IDATSW='RAW'
10303C
10304      DO100I=0,NUMARG-1
10305C
10306        IF(I.EQ.0)THEN
10307          ICTMP1=ICOM
10308        ELSE
10309          ICTMP1=IHARG(I)
10310        ENDIF
10311        ICTMP2=IHARG(I+1)
10312        ICTMP3=IHARG(I+2)
10313        ICTMP4=IHARG(I+3)
10314C
10315        IF(ICTMP1.EQ.'=')THEN
10316          IFOUND='NO'
10317          GOTO9000
10318        ELSEIF(ICTMP1.EQ.'ABAS')THEN
10319          IFOUND='NO'
10320          GOTO9000
10321        ELSEIF(ICTMP1.EQ.'A   ' .AND. ICTMP2.EQ.'BASI')THEN
10322          IFOUND='NO'
10323          GOTO9000
10324        ELSEIF(ICTMP1.EQ.'BBAS')THEN
10325          IFOUND='NO'
10326          GOTO9000
10327        ELSEIF(ICTMP1.EQ.'B   ' .AND. ICTMP2.EQ.'BASI')THEN
10328          IFOUND='NO'
10329          GOTO9000
10330        ELSEIF(ICTMP1.EQ.'TOLE' .AND.
10331     1        (ICTMP2.EQ.'LIMI' .OR. ICTMP2.EQ.'INTE'))THEN
10332          IFOUND='YES'
10333          ILASTC=I
10334          ILASTZ=I+1
10335        ELSEIF(ICTMP1.EQ.'TOLE')THEN
10336          IFOUND='YES'
10337          ILASTC=I
10338          ILASTZ=I
10339        ELSEIF(ICTMP1.EQ.'REPL')THEN
10340          IREPL='ON'
10341          ILASTC=MIN(ILASTC,I)
10342          ILASTZ=MAX(ILASTZ,I)
10343        ELSEIF(ICTMP1.EQ.'MULT')THEN
10344          IMULT='ON'
10345          ILASTC=MIN(ILASTC,I)
10346          ILASTZ=MAX(ILASTZ,I)
10347        ELSEIF(ICTMP1.EQ.'NORM')THEN
10348          ICASAN='NTOL'
10349          ICASDI='NORM'
10350          ILASTC=MIN(ILASTC,I)
10351          ILASTZ=MAX(ILASTZ,I)
10352        ELSEIF(ICTMP1.EQ.'WEIB')THEN
10353          ICASDI='WEIB'
10354          ILASTC=MIN(ILASTC,I)
10355          ILASTZ=MAX(ILASTZ,I)
10356        ELSEIF(ICTMP1.EQ.'LOGN')THEN
10357          ICASAN='LNTO'
10358          ICASDI='LOGN'
10359          ILASTC=MIN(ILASTC,I)
10360          ILASTZ=MAX(ILASTZ,I)
10361        ELSEIF(ICTMP1.EQ.'BOXC')THEN
10362          ICASAN='BCTO'
10363          ICASDI='BOXC'
10364          ILASTC=MIN(ILASTC,I)
10365          ILASTZ=MAX(ILASTZ,I)
10366        ELSEIF(ICTMP1.EQ.'BOX' .AND. ICTMP2.EQ.'COX')THEN
10367          ICASAN='BCTO'
10368          ICASDI='BOXC'
10369          ILASTC=MIN(ILASTC,I)
10370          ILASTZ=MAX(ILASTZ,I+1)
10371        ELSEIF(ICTMP1.EQ.'LOWE')THEN
10372          ICASA2='LOWE'
10373          ILASTC=MIN(ILASTC,I)
10374          ILASTZ=MAX(ILASTZ,I)
10375        ELSEIF(ICTMP1.EQ.'UPPE')THEN
10376          ICASA2='UPPE'
10377          ILASTC=MIN(ILASTC,I)
10378          ILASTZ=MAX(ILASTZ,I)
10379        ELSEIF(ICTMP1.EQ.'SUMM')THEN
10380          IDATSW='SUMM'
10381          ILASTC=MIN(ILASTC,I)
10382          ILASTZ=MAX(ILASTZ,I)
10383        ELSEIF(ICTMP1.EQ.'NONP')THEN
10384          ICASAN='NPTO'
10385          ILASTC=MIN(ILASTC,I)
10386          ILASTZ=MAX(ILASTZ,I)
10387        ENDIF
10388  100 CONTINUE
10389C
10390      IF(IFOUND.EQ.'NO')GOTO9000
10391C
10392      ISHIFT=ILASTZ
10393      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
10394     1            IBUGA2,IERROR)
10395C
10396      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')THEN
10397        WRITE(ICOUT,91)ICASAN,IMULT,IREPL,ISHIFT
10398   91   FORMAT('DPTOLI: ICASAN,IMULT,IREPL,ISHIFT = ',3(A4,2X),I5)
10399        CALL DPWRST('XXX','BUG ')
10400      ENDIF
10401C
10402      IF(IMULT.EQ.'ON')THEN
10403        IF(IREPL.EQ.'ON')THEN
10404          WRITE(ICOUT,999)
10405          CALL DPWRST('XXX','BUG ')
10406          WRITE(ICOUT,101)
10407  101     FORMAT('***** ERROR IN TOLERANCE LIMITS--')
10408          CALL DPWRST('XXX','BUG ')
10409          WRITE(ICOUT,102)
10410  102     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
10411     1           '"REPLICATION"')
10412          CALL DPWRST('XXX','BUG ')
10413          WRITE(ICOUT,104)
10414  104     FORMAT('      FOR THE TOLERANCE LIMITS TEST COMMAND.')
10415          CALL DPWRST('XXX','BUG ')
10416          IERROR='YES'
10417          GOTO9000
10418        ENDIF
10419      ENDIF
10420C
10421      IF(IDATSW.EQ.'SUMM')THEN
10422        IF(IREPL.EQ.'ON')THEN
10423          WRITE(ICOUT,999)
10424          CALL DPWRST('XXX','BUG ')
10425          WRITE(ICOUT,101)
10426          CALL DPWRST('XXX','BUG ')
10427          WRITE(ICOUT,112)
10428  112     FORMAT('      YOU CANNOT SPECIFY BOTH "SUMMARY" AND ',
10429     1           '"REPLICATION"')
10430          CALL DPWRST('XXX','BUG ')
10431          WRITE(ICOUT,104)
10432          CALL DPWRST('XXX','BUG ')
10433          IERROR='YES'
10434          GOTO9000
10435        ELSEIF(IMULT.EQ.'ON')THEN
10436          WRITE(ICOUT,999)
10437          CALL DPWRST('XXX','BUG ')
10438          WRITE(ICOUT,101)
10439          CALL DPWRST('XXX','BUG ')
10440          WRITE(ICOUT,122)
10441  122     FORMAT('      YOU CANNOT SPECIFY BOTH "SUMMARY" AND ',
10442     1           '"MULTIPLE"')
10443          CALL DPWRST('XXX','BUG ')
10444          WRITE(ICOUT,104)
10445          CALL DPWRST('XXX','BUG ')
10446          IERROR='YES'
10447          GOTO9000
10448        ELSEIF(ICASDI.EQ.'WEIB')THEN
10449          WRITE(ICOUT,999)
10450          CALL DPWRST('XXX','BUG ')
10451          WRITE(ICOUT,101)
10452          CALL DPWRST('XXX','BUG ')
10453          WRITE(ICOUT,132)
10454  132     FORMAT('      YOU CANNOT SPECIFY BOTH "SUMMARY" AND ',
10455     1           '"WEIBULL"')
10456          CALL DPWRST('XXX','BUG ')
10457          WRITE(ICOUT,104)
10458          CALL DPWRST('XXX','BUG ')
10459          IERROR='YES'
10460        ELSEIF(ICASDI.EQ.'LOGN')THEN
10461          WRITE(ICOUT,999)
10462          CALL DPWRST('XXX','BUG ')
10463          WRITE(ICOUT,101)
10464          CALL DPWRST('XXX','BUG ')
10465          WRITE(ICOUT,142)
10466  142     FORMAT('      YOU CANNOT SPECIFY BOTH "SUMMARY" AND ',
10467     1           '"LOGNORMAL"')
10468          CALL DPWRST('XXX','BUG ')
10469          WRITE(ICOUT,104)
10470          CALL DPWRST('XXX','BUG ')
10471          IERROR='YES'
10472        ENDIF
10473      ENDIF
10474C
10475C               *********************************
10476C               **  STEP 4--                   **
10477C               **  EXTRACT THE VARIABLE LIST  **
10478C               *********************************
10479C
10480      ISTEPN='4'
10481      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')
10482     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10483C
10484      INAME='TOLERANCE LIMITS'
10485      MINNA=1
10486      MAXNA=100
10487      MINN2=2
10488      IFLAGE=0
10489      IFLAGM=1
10490      IF(IREPL.EQ.'ON')THEN
10491        IFLAGM=0
10492        IFLAGE=1
10493      ENDIF
10494      IFLAGP=0
10495      JMIN=1
10496      JMAX=NUMARG
10497      MINNVA=1
10498      MAXNVA=MAXSPN
10499      IF(IDATSW.EQ.'SUMM')THEN
10500        MINN2=1
10501        IFLAGM=0
10502        IFLAGP=19
10503        MINNVA=3
10504        MAXNVA=3
10505      ENDIF
10506C
10507      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
10508     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
10509     1            JMIN,JMAX,
10510     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
10511     1            IVARN1,IVARN2,IVARTY,PVAR,
10512     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
10513     1            MINNVA,MAXNVA,
10514     1            IFLAGM,IFLAGP,
10515     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
10516      IF(IERROR.EQ.'YES')GOTO9000
10517C
10518      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')THEN
10519        WRITE(ICOUT,999)
10520        CALL DPWRST('XXX','BUG ')
10521        WRITE(ICOUT,281)
10522  281   FORMAT('***** AFTER CALL DPPARS--')
10523        CALL DPWRST('XXX','BUG ')
10524        WRITE(ICOUT,282)NQ,NUMVAR
10525  282   FORMAT('NQ,NUMVAR = ',2I8)
10526        CALL DPWRST('XXX','BUG ')
10527        IF(NUMVAR.GT.0)THEN
10528          DO285I=1,NUMVAR
10529            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
10530     1                      ICOLR(I)
10531  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
10532     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
10533            CALL DPWRST('XXX','BUG ')
10534  285     CONTINUE
10535        ENDIF
10536      ENDIF
10537C
10538C               ***********************************************
10539C               **  STEP 5--                                 **
10540C               **  DETERMINE:                               **
10541C               **  1) NUMBER OF REPLICATION VARIABLES (0-6) **
10542C               **  2) NUMBER OF RESPONSE    VARIABLES (>= 1)**
10543C               ***********************************************
10544C
10545      ISTEPN='5'
10546      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')
10547     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10548C
10549      IF(IDATSW.EQ.'SUMM')GOTO599
10550      NRESP=0
10551      NREPL=0
10552      IF(IMULT.EQ.'ON')THEN
10553        NRESP=NUMVAR
10554      ELSEIF(IREPL.EQ.'ON')THEN
10555        NRESP=1
10556        NREPL=NUMVAR-NRESP
10557        IF(NREPL.LT.1 .OR. NREPL.GT.6)THEN
10558          WRITE(ICOUT,999)
10559          CALL DPWRST('XXX','BUG ')
10560          WRITE(ICOUT,101)
10561          CALL DPWRST('XXX','BUG ')
10562          WRITE(ICOUT,511)
10563  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
10564     1           'REPLICATION VARIABLES')
10565          CALL DPWRST('XXX','BUG ')
10566          WRITE(ICOUT,512)
10567  512     FORMAT('      MUST BE BETWEEN ONE AND SIX.')
10568          CALL DPWRST('XXX','BUG ')
10569          WRITE(ICOUT,513)NREPL
10570  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
10571          CALL DPWRST('XXX','BUG ')
10572          IERROR='YES'
10573          GOTO9000
10574        ENDIF
10575      ELSE
10576        NRESP=NUMVAR
10577        IMULT='ON'
10578      ENDIF
10579C
10580      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')THEN
10581        WRITE(ICOUT,521)NRESP,NREPL
10582  521   FORMAT('NRESP,NREPL = ',2I5)
10583        CALL DPWRST('XXX','BUG ')
10584      ENDIF
10585C
10586  599 CONTINUE
10587C
10588C               ******************************************************
10589C               **  STEP 6--                                        **
10590C               **  GENERATE THE TOLERANCE LIMITS TEST FOR THE      **
10591C               **  VARIOUS CASES                                   **
10592C               ******************************************************
10593C
10594      ISTEPN='6'
10595      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')
10596     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10597C
10598C               ******************************************
10599C               **  STEP 7A--                           **
10600C               **  CASE 0: SUMMARY CASE                **
10601C               ******************************************
10602C
10603      IF(IDATSW.EQ.'SUMM')THEN
10604        ISTEPN='7A'
10605        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')
10606     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10607C
10608C       TWO CASES: EITHER DATA ENTERED AS 3 PARAMETERS OR
10609C                  AS 3 VARIABLES
10610C
10611        NREPL=0
10612        IF(IVARTY(1).EQ.'PARA')THEN
10613          XMEAN=PVAR(1)
10614          XSD=PVAR(2)
10615          AN=PVAR(3)
10616          PID(1)=CPUMIN
10617          IVARID(1)='ROW '
10618          IVARI2(1)='1  '
10619          IF(ICASA2.EQ.'LOWE')THEN
10620            CALL TOL2(Y1,NLOCAL,XMEAN,XSD,AN,
10621     1                ICASA2,ICAPSW,ICAPTY,IFORSW,
10622     1                PID,IVARID,IVARI2,NREPL,
10623     1                ISUBRO,IBUGA3,IERROR)
10624          ELSEIF(ICASA2.EQ.'UPPE')THEN
10625            CALL TOL2(Y1,NLOCAL,XMEAN,XSD,AN,
10626     1                ICASA2,ICAPSW,ICAPTY,IFORSW,
10627     1                PID,IVARID,IVARI2,NREPL,
10628     1                ISUBRO,IBUGA3,IERROR)
10629          ELSE
10630            CALL TOL(Y1,NLOCAL,XMEAN,XSD,AN,
10631     1               XTEMP1,XTEMP2,XTEMP3,
10632     1               ICASAN,ICAPSW,ICAPTY,IFORSW,
10633     1               PID,IVARID,IVARI2,NREPL,
10634     1               ISUBRO,IBUGA3,IERROR)
10635          ENDIF
10636        ELSE
10637          ICOL=1
10638          NUMVA2=3
10639          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
10640     1                INAME,IVARN1,IVARN2,IVARTY,
10641     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
10642     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
10643     1                MAXCP4,MAXCP5,MAXCP6,
10644     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
10645     1                Y1,XTEMP1,XTEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE,
10646     1                IBUGA3,ISUBRO,IFOUND,IERROR)
10647          IF(IERROR.EQ.'YES')GOTO9000
10648C
10649          DO710IROW=1,NLOCAL
10650C
10651            PID(1)=CPUMIN
10652            IVARID(1)='ROW '
10653            WRITE(IVARI2(1)(1:4),'(I4)')IROW
10654            XMEAN=Y1(IROW)
10655            XSD=XTEMP1(IROW)
10656            AN=XTEMP2(IROW)
10657C
10658            IF(ICASA2.EQ.'LOWE')THEN
10659              CALL TOL2(Y1,NLOCAL,XMEAN,XSD,AN,
10660     1                  ICASA2,ICAPSW,ICAPTY,IFORSW,
10661     1                  PID,IVARID,IVARI2,NREPL,
10662     1                  ISUBRO,IBUGA3,IERROR)
10663            ELSEIF(ICASA2.EQ.'UPPE')THEN
10664              CALL TOL2(Y1,NLOCAL,XMEAN,XSD,AN,
10665     1                  ICASA2,ICAPSW,ICAPTY,IFORSW,
10666     1                  PID,IVARID,IVARI2,NREPL,
10667     1                  ISUBRO,IBUGA3,IERROR)
10668            ELSE
10669              CALL TOL(Y1,NLOCAL,XMEAN,XSD,AN,
10670     1                 XTEMP1,XTEMP2,XTEMP3,
10671     1                 ICASAN,ICAPSW,ICAPTY,IFORSW,
10672     1                 PID,IVARID,IVARI2,NREPL,
10673     1                 ISUBRO,IBUGA3,IERROR)
10674            ENDIF
10675C
10676  710     CONTINUE
10677        ENDIF
10678        GOTO9000
10679      ENDIF
10680C
10681C
10682C               ******************************************
10683C               **  STEP 8A--                           **
10684C               **  CASE 1: NO REPLICATION VARIABLES    **
10685C               ******************************************
10686C
10687      IF(NREPL.LT.1)THEN
10688        ISTEPN='8A'
10689        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')
10690     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10691C
10692C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
10693C
10694        NCURVE=0
10695        DO810IRESP=1,NRESP
10696          NCURVE=NCURVE+1
10697C
10698          IINDX=ICOLR(IRESP)
10699          PID(1)=CPUMIN
10700          IVARID(1)=IVARN1(IRESP)
10701          IVARI2(1)=IVARN2(IRESP)
10702C
10703          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')THEN
10704            WRITE(ICOUT,999)
10705            CALL DPWRST('XXX','BUG ')
10706            WRITE(ICOUT,811)IRESP,NCURVE
10707  811       FORMAT('IRESP,NCURVE = ',2I5)
10708            CALL DPWRST('XXX','BUG ')
10709          ENDIF
10710C
10711          ICOL=IRESP
10712          NUMVA2=1
10713          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
10714     1                INAME,IVARN1,IVARN2,IVARTY,
10715     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
10716     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
10717     1                MAXCP4,MAXCP5,MAXCP6,
10718     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
10719     1                Y1,XTEMP1,XTEMP1,NLOCAL,NLOCA2,NLOCA3,ICASE,
10720     1                IBUGA3,ISUBRO,IFOUND,IERROR)
10721          IF(IERROR.EQ.'YES')GOTO9000
10722C
10723C         *****************************************************
10724C         **  STEP 8B--                                      **
10725C         *****************************************************
10726C
10727          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TOLI')THEN
10728            ISTEPN='8B'
10729            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10730            WRITE(ICOUT,999)
10731            CALL DPWRST('XXX','BUG ')
10732            WRITE(ICOUT,822)
10733  822       FORMAT('***** FROM THE MIDDLE  OF DPTOLI--')
10734            CALL DPWRST('XXX','BUG ')
10735            WRITE(ICOUT,823)ICASAN,NUMVAR,IDATSW,NLOCAL
10736  823       FORMAT('ICASAN,NUMVAR,IDATSW,NQ = ',
10737     1             A4,I8,2X,A4,I8)
10738            CALL DPWRST('XXX','BUG ')
10739            IF(NLOCAL.GE.1)THEN
10740              DO825I=1,NLOCAL
10741                WRITE(ICOUT,826)I,Y1(I)
10742  826           FORMAT('I,Y1(I) = ',I8,G15.7)
10743                CALL DPWRST('XXX','BUG ')
10744  825         CONTINUE
10745            ENDIF
10746          ENDIF
10747C
10748          IF(ICASDI.EQ.'WEIB')THEN
10749            CALL TOLWEI(Y1,NLOCAL,
10750     1                  MINMAX,IWEIBC,XTEMP1,DTEMP1,
10751     1                  ICASA2,ICAPSW,ICAPTY,IFORSW,
10752     1                  PID,IVARID,IVARI2,NREPL,
10753     1                  ISUBRO,IBUGA3,IERROR)
10754          ELSEIF(ICASA2.EQ.'LOWE')THEN
10755            CALL TOL2(Y1,NLOCAL,XMEAN,XSD,AN,
10756     1                ICASA2,ICAPSW,ICAPTY,IFORSW,
10757     1                PID,IVARID,IVARI2,NREPL,
10758     1                ISUBRO,IBUGA3,IERROR)
10759          ELSEIF(ICASA2.EQ.'UPPE')THEN
10760            CALL TOL2(Y1,NLOCAL,XMEAN,XSD,AN,
10761     1                ICASA2,ICAPSW,ICAPTY,IFORSW,
10762     1                PID,IVARID,IVARI2,NREPL,
10763     1                ISUBRO,IBUGA3,IERROR)
10764          ELSE
10765            CALL TOL(Y1,NLOCAL,XMEAN,XSD,AN,
10766     1               XTEMP1,XTEMP2,XTEMP3,
10767     1               ICASAN,ICAPSW,ICAPTY,IFORSW,
10768     1               PID,IVARID,IVARI2,NREPL,
10769     1               ISUBRO,IBUGA3,IERROR)
10770          ENDIF
10771C
10772  810   CONTINUE
10773C
10774C               ****************************************************
10775C               **  STEP 9A--                                     **
10776C               **  CASE 3: ONE OR MORE REPLICATION VARIABLES.    **
10777C               **          FOR THIS CASE, THE NUMBER OF RESPONSE **
10778C               **          VARIABLES MUST BE EXACTLY 1.          **
10779C               **          FOR THIS CASE, ALL VARIABLES MUST     **
10780C               **          HAVE THE SAME LENGTH.                 **
10781C               ****************************************************
10782C
10783      ELSEIF(NREPL.GE.1)THEN
10784        ISTEPN='9A'
10785        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TOLI')
10786     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10787C
10788        J=0
10789        IMAX=NRIGHT(1)
10790        IF(NQ.LT.NRIGHT(1))IMAX=NQ
10791        DO910I=1,IMAX
10792          IF(ISUB(I).EQ.0)GOTO910
10793          J=J+1
10794C
10795C         RESPONSE VARIABLE IN Y1
10796C
10797          ICOLC=1
10798          IJ=MAXN*(ICOLR(ICOLC)-1)+I
10799          IF(ICOLR(ICOLC).LE.MAXCOL)Y1(J)=V(IJ)
10800          IF(ICOLR(ICOLC).EQ.MAXCP1)Y1(J)=PRED(I)
10801          IF(ICOLR(ICOLC).EQ.MAXCP2)Y1(J)=RES(I)
10802          IF(ICOLR(ICOLC).EQ.MAXCP3)Y1(J)=YPLOT(I)
10803          IF(ICOLR(ICOLC).EQ.MAXCP4)Y1(J)=XPLOT(I)
10804          IF(ICOLR(ICOLC).EQ.MAXCP5)Y1(J)=X2PLOT(I)
10805          IF(ICOLR(ICOLC).EQ.MAXCP6)Y1(J)=TAGPLO(I)
10806C
10807          IF(NREPL.GE.1)THEN
10808            DO920IR=1,MIN(NREPL,6)
10809              ICOLC=ICOLC+1
10810              ICOLT=ICOLR(ICOLC)
10811              IJ=MAXN*(ICOLT-1)+I
10812              IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
10813              IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
10814              IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
10815              IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
10816              IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
10817              IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
10818              IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
10819  920       CONTINUE
10820          ENDIF
10821C
10822  910   CONTINUE
10823        NLOCAL=J
10824C
10825C       *****************************************************
10826C       **  STEP 9B--                                      **
10827C       **  CALL TOL    TO PERFORM TOLERANCE LIMITS TEST.  **
10828C       *****************************************************
10829C
10830C
10831        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TOLI')THEN
10832          ISTEPN='9C'
10833          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10834          WRITE(ICOUT,999)
10835          CALL DPWRST('XXX','BUG ')
10836          WRITE(ICOUT,941)
10837  941     FORMAT('***** FROM THE MIDDLE  OF DPTOLI--')
10838          CALL DPWRST('XXX','BUG ')
10839          WRITE(ICOUT,942)ICASAN,NUMVAR,NLOCAL,NREPL
10840  942     FORMAT('ICASAN,NUMVAR,NLOCAL,NREPL = ',
10841     1           A4,3I8)
10842          CALL DPWRST('XXX','BUG ')
10843          IF(NLOCAL.GE.1)THEN
10844            DO945I=1,NLOCAL
10845              WRITE(ICOUT,946)I,Y1(I),XDESGN(I,1),XDESGN(I,2)
10846  946         FORMAT('I,Y1(I),XDESGN(I,1),XDESGN(I,2) = ',
10847     1               I8,4F12.5)
10848              CALL DPWRST('XXX','BUG ')
10849  945       CONTINUE
10850          ENDIF
10851        ENDIF
10852C
10853C       *****************************************************
10854C       **  STEP 9C--                                      **
10855C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
10856C       **  REPLICATION VARIABLES.                         **
10857C       *****************************************************
10858C
10859        CALL DPPP5(XDESGN(1,1),XDESGN(1,2),XDESGN(1,3),
10860     1             XDESGN(1,4),XDESGN(1,5),XDESGN(1,6),
10861     1             NREPL,NLOCAL,MAXOBV,
10862     1             XIDTEM,XIDTE2,XIDTE3,XIDTE4,XIDTE5,XIDTE6,
10863     1             XTEMP1,XTEMP2,
10864     1             NUMSE1,NUMSE2,NUMSE3,NUMSE4,NUMSE5,NUMSE6,
10865     1             IBUGA3,ISUBRO,IERROR)
10866C
10867C       *****************************************************
10868C       **  STEP 9D--                                      **
10869C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
10870C       *****************************************************
10871C
10872        NPLOTP=0
10873        NCURVE=0
10874        IADD=1
10875C
10876        IF(NREPL.EQ.1)THEN
10877          J=0
10878          DO1110ISET1=1,NUMSE1
10879            K=0
10880            PID(IADD+1)=XIDTEM(ISET1)
10881            DO1130I=1,NLOCAL
10882              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
10883                K=K+1
10884                TEMP1(K)=Y1(I)
10885              ENDIF
10886 1130       CONTINUE
10887            NTEMP=K
10888            NCURVE=NCURVE+1
10889            NPLOT1=NPLOTP
10890            IF(NTEMP.GT.0)THEN
10891              IF(ICASDI.EQ.'WEIB')THEN
10892                CALL TOLWEI(TEMP1,NTEMP,
10893     1                      MINMAX,IWEIBC,XTEMP1,DTEMP1,
10894     1                      ICASA2,ICAPSW,ICAPTY,IFORSW,
10895     1                      PID,IVARID,IVARI2,NREPL,
10896     1                      ISUBRO,IBUGA3,IERROR)
10897              ELSEIF(ICASA2.EQ.'LOWE')THEN
10898                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
10899     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
10900     1                    PID,IVARN1,IVARN2,NREPL,
10901     1                    ISUBRO,IBUGA3,IERROR)
10902              ELSEIF(ICASA2.EQ.'UPPE')THEN
10903                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
10904     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
10905     1                    PID,IVARN1,IVARN2,NREPL,
10906     1                    ISUBRO,IBUGA3,IERROR)
10907              ELSE
10908                CALL TOL(TEMP1,NTEMP,XMEAN,XSD,AN,
10909     1                   XTEMP1,XTEMP2,XTEMP3,
10910     1                   ICASAN,ICAPSW,ICAPTY,IFORSW,
10911     1                   PID,IVARN1,IVARN2,NREPL,
10912     1                   ISUBRO,IBUGA3,IERROR)
10913              ENDIF
10914            ENDIF
10915 1110     CONTINUE
10916        ELSEIF(NREPL.EQ.2)THEN
10917          J=0
10918          NTOT=NUMSE1*NUMSE2
10919          DO1210ISET1=1,NUMSE1
10920          DO1220ISET2=1,NUMSE2
10921            K=0
10922            PID(1+IADD)=XIDTEM(ISET1)
10923            PID(2+IADD)=XIDTE2(ISET2)
10924            DO1290I=1,NLOCAL
10925              IF(
10926     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
10927     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
10928     1          )THEN
10929                K=K+1
10930                TEMP1(K)=Y1(I)
10931              ENDIF
10932 1290       CONTINUE
10933            NTEMP=K
10934            NCURVE=NCURVE+1
10935            NPLOT1=NPLOTP
10936            IF(NTEMP.GT.0)THEN
10937              IF(ICASDI.EQ.'WEIB')THEN
10938                CALL TOLWEI(TEMP1,NTEMP,
10939     1                      MINMAX,IWEIBC,XTEMP1,DTEMP1,
10940     1                      ICASA2,ICAPSW,ICAPTY,IFORSW,
10941     1                      PID,IVARID,IVARI2,NREPL,
10942     1                      ISUBRO,IBUGA3,IERROR)
10943              ELSEIF(ICASA2.EQ.'LOWE')THEN
10944                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
10945     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
10946     1                    PID,IVARN1,IVARN2,NREPL,
10947     1                    ISUBRO,IBUGA3,IERROR)
10948              ELSEIF(ICASA2.EQ.'UPPE')THEN
10949                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
10950     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
10951     1                    PID,IVARN1,IVARN2,NREPL,
10952     1                    ISUBRO,IBUGA3,IERROR)
10953              ELSE
10954                CALL TOL(TEMP1,NTEMP,XMEAN,XSD,AN,
10955     1                   XTEMP1,XTEMP2,XTEMP3,
10956     1                   ICASAN,ICAPSW,ICAPTY,IFORSW,
10957     1                   PID,IVARN1,IVARN2,NREPL,
10958     1                   ISUBRO,IBUGA3,IERROR)
10959              ENDIF
10960            ENDIF
10961 1220     CONTINUE
10962 1210     CONTINUE
10963        ELSEIF(NREPL.EQ.3)THEN
10964          J=0
10965          NTOT=NUMSE1*NUMSE2*NUMSE3
10966          DO1310ISET1=1,NUMSE1
10967          DO1320ISET2=1,NUMSE2
10968          DO1330ISET3=1,NUMSE3
10969            K=0
10970            PID(1+IADD)=XIDTEM(ISET1)
10971            PID(2+IADD)=XIDTE2(ISET2)
10972            PID(3+IADD)=XIDTE3(ISET3)
10973            DO1390I=1,NLOCAL
10974              IF(
10975     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
10976     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
10977     1           XIDTE3(ISET3).EQ.XDESGN(I,3)
10978     1          )THEN
10979                K=K+1
10980                TEMP1(K)=Y1(I)
10981              ENDIF
10982 1390       CONTINUE
10983            NTEMP=K
10984            NCURVE=NCURVE+1
10985            NPLOT1=NPLOTP
10986            IF(NTEMP.GT.0)THEN
10987              IF(ICASDI.EQ.'WEIB')THEN
10988                CALL TOLWEI(TEMP1,NTEMP,
10989     1                      MINMAX,IWEIBC,XTEMP1,DTEMP1,
10990     1                      ICASA2,ICAPSW,ICAPTY,IFORSW,
10991     1                      PID,IVARID,IVARI2,NREPL,
10992     1                      ISUBRO,IBUGA3,IERROR)
10993              ELSEIF(ICASA2.EQ.'LOWE')THEN
10994                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
10995     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
10996     1                    PID,IVARN1,IVARN2,NREPL,
10997     1                    ISUBRO,IBUGA3,IERROR)
10998              ELSEIF(ICASA2.EQ.'UPPE')THEN
10999                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
11000     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
11001     1                    PID,IVARN1,IVARN2,NREPL,
11002     1                    ISUBRO,IBUGA3,IERROR)
11003              ELSE
11004                CALL TOL(TEMP1,NTEMP,XMEAN,XSD,AN,
11005     1                   XTEMP1,XTEMP2,XTEMP3,
11006     1                   ICASAN,ICAPSW,ICAPTY,IFORSW,
11007     1                   PID,IVARN1,IVARN2,NREPL,
11008     1                   ISUBRO,IBUGA3,IERROR)
11009              ENDIF
11010            ENDIF
11011 1330     CONTINUE
11012 1320     CONTINUE
11013 1310     CONTINUE
11014        ELSEIF(NREPL.EQ.4)THEN
11015          J=0
11016          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4
11017          DO1410ISET1=1,NUMSE1
11018          DO1420ISET2=1,NUMSE2
11019          DO1430ISET3=1,NUMSE3
11020          DO1440ISET4=1,NUMSE4
11021            K=0
11022            PID(1+IADD)=XIDTEM(ISET1)
11023            PID(2+IADD)=XIDTE2(ISET2)
11024            PID(3+IADD)=XIDTE3(ISET3)
11025            PID(4+IADD)=XIDTE4(ISET4)
11026            DO1490I=1,NLOCAL
11027              IF(
11028     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
11029     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
11030     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
11031     1           XIDTE4(ISET4).EQ.XDESGN(I,4)
11032     1          )THEN
11033                K=K+1
11034                TEMP1(K)=Y1(I)
11035              ENDIF
11036 1490       CONTINUE
11037            NTEMP=K
11038            NCURVE=NCURVE+1
11039            NPLOT1=NPLOTP
11040            IF(NTEMP.GT.0)THEN
11041              IF(ICASDI.EQ.'WEIB')THEN
11042                CALL TOLWEI(TEMP1,NTEMP,
11043     1                      MINMAX,IWEIBC,XTEMP1,DTEMP1,
11044     1                      ICASA2,ICAPSW,ICAPTY,IFORSW,
11045     1                      PID,IVARID,IVARI2,NREPL,
11046     1                      ISUBRO,IBUGA3,IERROR)
11047              ELSEIF(ICASA2.EQ.'LOWE')THEN
11048                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
11049     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
11050     1                    PID,IVARN1,IVARN2,NREPL,
11051     1                    ISUBRO,IBUGA3,IERROR)
11052              ELSEIF(ICASA2.EQ.'UPPE')THEN
11053                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
11054     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
11055     1                    PID,IVARN1,IVARN2,NREPL,
11056     1                    ISUBRO,IBUGA3,IERROR)
11057              ELSE
11058                CALL TOL(TEMP1,NTEMP,XMEAN,XSD,AN,
11059     1                   XTEMP1,XTEMP2,XTEMP3,
11060     1                   ICASAN,ICAPSW,ICAPTY,IFORSW,
11061     1                   PID,IVARN1,IVARN2,NREPL,
11062     1                   ISUBRO,IBUGA3,IERROR)
11063              ENDIF
11064            ENDIF
11065 1440     CONTINUE
11066 1430     CONTINUE
11067 1420     CONTINUE
11068 1410     CONTINUE
11069        ELSEIF(NREPL.EQ.5)THEN
11070          J=0
11071          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5
11072          DO1510ISET1=1,NUMSE1
11073          DO1520ISET2=1,NUMSE2
11074          DO1530ISET3=1,NUMSE3
11075          DO1540ISET4=1,NUMSE4
11076          DO1550ISET5=1,NUMSE5
11077            K=0
11078            PID(1+IADD)=XIDTEM(ISET1)
11079            PID(2+IADD)=XIDTE2(ISET2)
11080            PID(3+IADD)=XIDTE3(ISET3)
11081            PID(4+IADD)=XIDTE4(ISET4)
11082            PID(5+IADD)=XIDTE5(ISET4)
11083            DO1590I=1,NLOCAL
11084              IF(
11085     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
11086     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
11087     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
11088     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
11089     1           XIDTE5(ISET5).EQ.XDESGN(I,5)
11090     1          )THEN
11091                K=K+1
11092                TEMP1(K)=Y1(I)
11093              ENDIF
11094 1590       CONTINUE
11095            NTEMP=K
11096            NCURVE=NCURVE+1
11097            NPLOT1=NPLOTP
11098            IF(NTEMP.GT.0)THEN
11099              IF(ICASDI.EQ.'WEIB')THEN
11100                CALL TOLWEI(TEMP1,NTEMP,
11101     1                      MINMAX,IWEIBC,XTEMP1,DTEMP1,
11102     1                      ICASA2,ICAPSW,ICAPTY,IFORSW,
11103     1                      PID,IVARID,IVARI2,NREPL,
11104     1                      ISUBRO,IBUGA3,IERROR)
11105              ELSEIF(ICASA2.EQ.'LOWE')THEN
11106                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
11107     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
11108     1                    PID,IVARN1,IVARN2,NREPL,
11109     1                    ISUBRO,IBUGA3,IERROR)
11110              ELSEIF(ICASA2.EQ.'UPPE')THEN
11111                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
11112     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
11113     1                    PID,IVARN1,IVARN2,NREPL,
11114     1                    ISUBRO,IBUGA3,IERROR)
11115              ELSE
11116                CALL TOL(TEMP1,NTEMP,XMEAN,XSD,AN,
11117     1                   XTEMP1,XTEMP2,XTEMP3,
11118     1                   ICASAN,ICAPSW,ICAPTY,IFORSW,
11119     1                   PID,IVARN1,IVARN2,NREPL,
11120     1                   ISUBRO,IBUGA3,IERROR)
11121              ENDIF
11122            ENDIF
11123 1550     CONTINUE
11124 1540     CONTINUE
11125 1530     CONTINUE
11126 1520     CONTINUE
11127 1510     CONTINUE
11128        ELSEIF(NREPL.EQ.6)THEN
11129          J=0
11130          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5*NUMSE6
11131          DO1610ISET1=1,NUMSE1
11132          DO1620ISET2=1,NUMSE2
11133          DO1630ISET3=1,NUMSE3
11134          DO1640ISET4=1,NUMSE4
11135          DO1650ISET5=1,NUMSE5
11136          DO1660ISET6=1,NUMSE6
11137            K=0
11138            PID(1+IADD)=XIDTEM(ISET1)
11139            PID(2+IADD)=XIDTE2(ISET2)
11140            PID(3+IADD)=XIDTE3(ISET3)
11141            PID(4+IADD)=XIDTE4(ISET4)
11142            PID(5+IADD)=XIDTE5(ISET4)
11143            PID(6+IADD)=XIDTE6(ISET4)
11144            DO1690I=1,NLOCAL
11145              IF(
11146     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
11147     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
11148     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
11149     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
11150     1           XIDTE5(ISET5).EQ.XDESGN(I,5) .AND.
11151     1           XIDTE6(ISET6).EQ.XDESGN(I,6)
11152     1          )THEN
11153                K=K+1
11154                TEMP1(K)=Y1(I)
11155              ENDIF
11156 1690       CONTINUE
11157            NTEMP=K
11158            NCURVE=NCURVE+1
11159            NPLOT1=NPLOTP
11160            IF(NTEMP.GT.0)THEN
11161              IF(ICASDI.EQ.'WEIB')THEN
11162                CALL TOLWEI(TEMP1,NTEMP,
11163     1                      MINMAX,IWEIBC,XTEMP1,DTEMP1,
11164     1                      ICASA2,ICAPSW,ICAPTY,IFORSW,
11165     1                      PID,IVARID,IVARI2,NREPL,
11166     1                      ISUBRO,IBUGA3,IERROR)
11167              ELSEIF(ICASA2.EQ.'LOWE')THEN
11168                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
11169     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
11170     1                    PID,IVARN1,IVARN2,NREPL,
11171     1                    ISUBRO,IBUGA3,IERROR)
11172              ELSEIF(ICASA2.EQ.'UPPE')THEN
11173                CALL TOL2(TEMP1,NTEMP,XMEAN,XSD,AN,
11174     1                    ICASA2,ICAPSW,ICAPTY,IFORSW,
11175     1                    PID,IVARN1,IVARN2,NREPL,
11176     1                    ISUBRO,IBUGA3,IERROR)
11177              ELSE
11178                CALL TOL(TEMP1,NTEMP,XMEAN,XSD,AN,
11179     1                   XTEMP1,XTEMP2,XTEMP3,
11180     1                   ICASAN,ICAPSW,ICAPTY,IFORSW,
11181     1                   PID,IVARN1,IVARN2,NREPL,
11182     1                   ISUBRO,IBUGA3,IERROR)
11183              ENDIF
11184            ENDIF
11185 1660     CONTINUE
11186 1650     CONTINUE
11187 1640     CONTINUE
11188 1630     CONTINUE
11189 1620     CONTINUE
11190 1610     CONTINUE
11191        ENDIF
11192C
11193      ENDIF
11194C
11195C               *****************
11196C               **  STEP 90--  **
11197C               **  EXIT       **
11198C               *****************
11199C
11200 9000 CONTINUE
11201C
11202      IF(IERROR.EQ.'YES')THEN
11203        IF(IWIDTH.GE.1)THEN
11204          WRITE(ICOUT,9001)(IANS(I),I=1,MIN(100,IWIDTH))
11205 9001     FORMAT(100A1)
11206          CALL DPWRST('XXX','BUG ')
11207        ENDIF
11208      ENDIF
11209C
11210      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TOLI')THEN
11211        WRITE(ICOUT,999)
11212        CALL DPWRST('XXX','BUG ')
11213        WRITE(ICOUT,9011)
11214 9011   FORMAT('***** AT THE END       OF DPTOLI--')
11215        CALL DPWRST('XXX','BUG ')
11216        WRITE(ICOUT,9012)IFOUND,IERROR,ICASAN
11217 9012   FORMAT('IFOUND,IERROR,ICASAN = ',2(A4,2X),A4)
11218        CALL DPWRST('XXX','BUG ')
11219      ENDIF
11220C
11221      RETURN
11222      END
11223      SUBROUTINE DPTOL3(X,N,XMEAN,XSD,AN,ANU,
11224     1                 ICASAN,ALPHA,GAMMA,ITOLGC,ITOLM2,
11225     1                 AK,ALOWLM,AUPPLM,
11226     1                 ISUBRO,IBUGA3,IERROR)
11227C
11228C     PURPOSE--THIS SUBROUTINE COMPUTES NORMAL ONE-SIDED AND
11229C              TWO-SIDED NORMAL TOLERANCE LOWER AND UPPER LIMITS
11230C              AND K-FACTORS.  THIS IS FOR USE BY THE "STATISTICS"
11231C              COMMAND.
11232C     INPUT ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
11233C                               (UNSORTED OR SORTED) OBSERVATIONS.
11234C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
11235C                               IN THE VECTOR X.
11236C     OTHER DATAPAC   SUBROUTINES NEEDED--CHSPPF, NORPPF, NCTPPF.
11237C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
11238C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
11239C     LANGUAGE--ANSI FORTRAN.
11240C     REFERENCES--GARDINER AND HULL, TECHNOMETRICS, 1966, PAGES 115-122
11241C               --WILKS, ANNALS OF MATHEMATICAL STATISTICS, 1941, PAGE 92
11242C               --MOOD AND GRABLE, PAGES 416-417
11243C               --HOWE (1969), "TWO-SIDED TOLERANCE LIMITS FOR NORMAL
11244C                 POPULATIONS - SOME IMPROVEMENTS", JOURNAL OF THE
11245C                 AMERICAN STATISTICAL ASSOCIATION, VOL. 64, PP.
11246C                 610-620.
11247C               --GUENTHER (1977), "SAMPLING INSPECTION IN STATISTICAL
11248C                 QUALITY CONTROL", GRIFFIN'S STATISTICAL MONOGRAPHS,
11249C                 NUMBER 37, LONDON.
11250C               --MARY NATRELLA (1963), "EXPERIMENTAL STATISTICS, NBS
11251C                 HANDBOOK 91", US DEPARTMENT OF COMMERCE.
11252C     WRITTEN BY--ALAN HECKERT
11253C                 STATISTICAL ENGINEERING LABORATORY
11254C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11255C                 GAITHERSBURG, MD 20899-8980
11256C                 PHONE--301-975-2899
11257C     ORIGINAL VERSION--MARCH     2011.
11258C     UPDATED         --MAY       2018. OPTION FOR NU (DEGREES OF
11259C                                       FREEDOM INDEPENDENT OF
11260C                                       CURRENT SAMPLE)
11261C     UPDATED         --MAY       2018. FOR 2-SIDED CASE, ADJUST FORMULA
11262C                                       SO THAT COVERAGE FACTORS < 0.5
11263C                                       WILL BE COMPUTED CORRECTLY.
11264C     UPDATED         --MAY       2018. OPTIONALLY COMPUTE GUENTHER
11265C                                       CORRECTION TO HOWE FORMULA
11266C                                       FOR TWO-SIDED CASE
11267C
11268C---------------------------------------------------------------------
11269C
11270      DIMENSION X(*)
11271C
11272      CHARACTER*4 ICASAN
11273      CHARACTER*4 ITOLGC
11274      CHARACTER*4 ITOLM2
11275      CHARACTER*4 ISUBRO
11276      CHARACTER*4 IBUGA3
11277      CHARACTER*4 IERROR
11278C
11279      DOUBLE PRECISION DTEMP
11280      DOUBLE PRECISION DTEMP2
11281      DOUBLE PRECISION DA
11282      DOUBLE PRECISION DB
11283      DOUBLE PRECISION DTERM1
11284C
11285      CHARACTER*4 IWRITE
11286      CHARACTER*4 ISUBN1
11287      CHARACTER*4 ISUBN2
11288      CHARACTER*4 ISTEPN
11289C
11290C-----COMMON----------------------------------------------------------
11291C
11292      INCLUDE 'DPCOP2.INC'
11293C
11294C-----START POINT-----------------------------------------------------
11295C
11296C
11297      ISUBN1='TOL3'
11298      ISUBN2='    '
11299      IWRITE='OFF'
11300      IERROR='NO'
11301C
11302      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TOL3')THEN
11303        WRITE(ICOUT,999)
11304  999   FORMAT(1X)
11305        CALL DPWRST('XXX','WRIT')
11306        WRITE(ICOUT,51)
11307   51   FORMAT('**** AT THE BEGINNING OF DPTOL3--')
11308        CALL DPWRST('XXX','WRIT')
11309        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASAN,N,ALPHA,GAMMA
11310   52   FORMAT('IBUGA3,ISUBRO,ICASAN,N,ALPHA,GAMMA = ',
11311     1         3(A4,2X),I8,2G15.7)
11312        CALL DPWRST('XXX','WRIT')
11313        WRITE(ICOUT,53)XMEAN,XSD,ITOLGC,ITOLM2
11314   53   FORMAT('XMEAN,XSD,ITOLGC,ITOLM2 = ',2G15.7,2(2X,A4))
11315        CALL DPWRST('XXX','WRIT')
11316        IF(XMEAN.EQ.CPUMIN)THEN
11317          DO56I=1,N
11318            WRITE(ICOUT,57)I,X(I)
11319   57       FORMAT('I,X(I) = ',I8,G15.7)
11320            CALL DPWRST('XXX','WRIT')
11321   56     CONTINUE
11322        ENDIF
11323      ENDIF
11324C
11325C               ********************************************
11326C               **  STEP 11--                             **
11327C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
11328C               ********************************************
11329C
11330      ISTEPN='11'
11331      IF(IBUGA3.EQ.'ON'.AND.ISUBRO.EQ.'TOL3')
11332     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11333C
11334      IF(XMEAN.EQ.CPUMIN .AND. N.LT.2)THEN
11335        WRITE(ICOUT,999)
11336        CALL DPWRST('XXX','WRIT')
11337        WRITE(ICOUT,101)
11338  101   FORMAT('***** ERROR: TOLERANCE LIMITS--')
11339        CALL DPWRST('XXX','WRIT')
11340        WRITE(ICOUT,102)
11341  102   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.',
11342     1         '  SUCH WAS NOT THE CASE HERE.')
11343        CALL DPWRST('XXX','WRIT')
11344        WRITE(ICOUT,103)N
11345  103   FORMAT('      SAMPLE SIZE = ',I8)
11346        CALL DPWRST('XXX','WRIT')
11347        IERROR='YES'
11348        GOTO9000
11349      ENDIF
11350C
11351      IF(XMEAN.EQ.CPUMIN)THEN
11352        HOLD=X(1)
11353        DO135I=2,N
11354          IF(X(I).NE.HOLD)GOTO139
11355  135   CONTINUE
11356        WRITE(ICOUT,999)
11357        CALL DPWRST('XXX','WRIT')
11358        WRITE(ICOUT,101)
11359        CALL DPWRST('XXX','WRIT')
11360        WRITE(ICOUT,131)HOLD
11361  131   FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
11362        CALL DPWRST('XXX','WRIT')
11363        GOTO9000
11364  139   CONTINUE
11365      ENDIF
11366C
11367C               ********************************************
11368C               **  STEP 21--                             **
11369C               **  CARRY OUT CALCULATIONS FOR TOLERANCE  **
11370C               **  LIMITS.                               **
11371C               ********************************************
11372C
11373      ISTEPN='21'
11374      IF(IBUGA3.EQ.'ON'.AND.ISUBRO.EQ.'TOL3')
11375     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11376C
11377C     COMPUTE MEAN AND STANDARD DEVIATION
11378C
11379      ALOWLM=CPUMIN
11380      AUPPLM=CPUMIN
11381      AK=CPUMIN
11382      AN=REAL(N)
11383      IF(XMEAN.EQ.CPUMIN)THEN
11384        CALL MEAN(X,N,IWRITE,XMEAN,IBUGA3,IERROR)
11385        CALL SD(X,N,IWRITE,XSD,IBUGA3,IERROR)
11386      ELSE
11387         N=INT(AN+0.1)
11388      ENDIF
11389C
11390C     NOTE: ALPHA IS THE CONFIDENCE AND GAMMA IS THE COVERAGE
11391C
11392      IF(ALPHA.GE.1.0 .AND. ALPHA.LT.100.0)THEN
11393        ALPHA=ALPHA/100.
11394      ENDIF
11395      IF(ALPHA.GT.0.0 .AND. ALPHA.LT.1.0)THEN
11396        IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
11397      ELSE
11398        ALPHA=0.95
11399      ENDIF
11400C
11401      IF(GAMMA.GE.1.0 .AND. GAMMA.LT.100.0)THEN
11402        GAMMA=GAMMA/100.
11403      ENDIF
11404      IF(GAMMA.GT.0.0 .AND. GAMMA.LT.1.0)THEN
11405        IF(GAMMA.LT.0.5)GAMMA=1.0 - GAMMA
11406      ELSE
11407        GAMMA=0.95
11408      ENDIF
11409C
11410C     COMPUTE THE NORMAL TWO-SIDED TOLERANCE LIMITS USING HOWE'S METHOD,
11411C     OPTIONALLY APPLY GUENTHER'S CORRECTION
11412C
11413      AN=REAL(N)
11414      IF(ICASAN(1:1).EQ.'2')THEN
11415        IF(ANU.GT.0.0)THEN
11416          NU=INT(ANU+0.5)
11417        ELSE
11418          NU=N-1
11419        ENDIF
11420        IF(NU.LT.1)NU=1
11421        AN=REAL(N)
11422        ANU=REAL(NU)
11423        TERM2=ANU*(1.0 + (1.0/AN))
11424        PCOV=GAMMA
11425        PCONF=ALPHA
11426        TERM1=(1.0 + PCOV)/2.0
11427        CALL NORPPF(TERM1,Z)
11428        AVAL=1.0 - PCONF
11429        CALL CHSPPF(AVAL,NU,TERM3)
11430        AK=Z*SQRT(TERM2/TERM3)
11431C
11432C       APPLY GUENTHER CORRECTION IF REQUESTED
11433C
11434        IF(ITOLGC.EQ.'ON')THEN
11435           ANUM=AN - 3.0 - TERM3
11436           DENOM=2.0*(AN+1)**2
11437           TERM4=SQRT(1.0 + (ANUM/DENOM))
11438           AK=TERM4*AK
11439        ENDIF
11440C
11441        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TOL3')THEN
11442          WRITE(ICOUT,201)AN,ANU,TERM2,TERM1,Z,AVAL,TERM3
11443  201     FORMAT('AN,ANU,TERM2,TERM1,Z,AVAL,TERM3 = ',7G15.7)
11444          CALL DPWRST('XXX','WRIT')
11445          IF(ITOLGC.EQ.'ON')THEN
11446            WRITE(ICOUT,203)ANUM,DENOM,TERM4
11447  203       FORMAT('ANUM,DENOM,TERM4 = ',3G15.7)
11448            CALL DPWRST('XXX','WRIT')
11449          ENDIF
11450        ENDIF
11451C
11452      ELSEIF(ICASAN(1:1).EQ.'1')THEN
11453C
11454C       FOR ONE-SIDED INTERVAL, USE EITHER APPROXIMATION BASED ON
11455C       NON-CENTRAL T OR APPROXIMATION BASED ON NORMAL.  THE
11456C       NON-CENTRAL T IS CONSIDERED MORE ACCURATE, BUT NON-CENTRAL T
11457C       MAY LOSE ACCURACY AS N BECOMES LARGE.
11458C
11459        IF(ITOLM2.EQ.'NONC')THEN
11460          IF(ANU.GT.0.0)THEN
11461            NU=INT(ANU+0.5)
11462            IF(NU.LT.2)NU=2
11463            AF=REAL(NU-1)
11464          ELSE
11465            AF=AN - 1.0
11466          ENDIF
11467          CALL NODPPF(DBLE(GAMMA),DTEMP)
11468          DELTA=REAL(DTEMP*DSQRT(DBLE(N)))
11469          CALL NCTPPF(ALPHA,AF,DELTA,PPF)
11470          AK=PPF/SQRT(AN)
11471        ELSE
11472          CALL NODPPF(DBLE(ALPHA),DTEMP)
11473          DA=1.0D0 - DTEMP**2/(2.0*(DBLE(N) - 1.0D0))
11474          CALL NODPPF(DBLE(GAMMA),DTEMP2)
11475          DB=DTEMP2**2 - DTEMP**2/DBLE(N)
11476          DTERM1=(DTEMP2 + DSQRT(DTEMP2**2 - DA*DB))/DA
11477          AK=REAL(DTERM1)
11478        ENDIF
11479      ELSE
11480        IERROR='YES'
11481        GOTO9000
11482      ENDIF
11483      ALOWLM=XMEAN - AK*XSD
11484      AUPPLM=XMEAN + AK*XSD
11485C
11486 9000 CONTINUE
11487      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TOL3')THEN
11488        WRITE(ICOUT,999)
11489        CALL DPWRST('XXX','WRIT')
11490        WRITE(ICOUT,9051)
11491 9051   FORMAT('**** AT THE END OF DPTOL3--')
11492        CALL DPWRST('XXX','WRIT')
11493        WRITE(ICOUT,9052)XBAR,XSD,AK,ALOWLM,AUPPLM
11494 9052   FORMAT('XBAR,XSD,AK,ALOWLM,AUPPLM = ',5G15.7)
11495        CALL DPWRST('XXX','WRIT')
11496        WRITE(ICOUT,9054)ALPHA,GAMMA,AN
11497 9054   FORMAT('ALPHA,GAMMA,N = ',2G15.7,I8)
11498        CALL DPWRST('XXX','WRIT')
11499        IF(ICASAN(1:1).EQ.'2')THEN
11500          WRITE(ICOUT,9056)NU,DTEMP,ANP,AK
11501 9056     FORMAT('NU,DTEMP,ANP,AK = ',4G15.7)
11502          CALL DPWRST('XXX','WRIT')
11503        ELSE
11504          WRITE(ICOUT,9058)AF,DTEMP,DELTA,PPF
11505 9058     FORMAT('AF,DTEMP,DELTA,PPF = ',4G15.7)
11506          CALL DPWRST('XXX','WRIT')
11507        ENDIF
11508      ENDIF
11509C
11510      RETURN
11511      END
11512      SUBROUTINE DPTPCO(IHARG,NUMARG,IDETPC,MAXTEX,ITEPCO,
11513     1IBUGP2,IFOUND,IERROR)
11514C
11515C     PURPOSE--DEFINE THE TEXT PATTERN COLORS = THE COLORS
11516C              OF THE LINES MAKING UP A PATTERN WITHIN A TEXT.
11517C              THESE ARE LOCATED IN THE VECTOR ITEPCO(.).
11518C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
11519C                     --NUMARG
11520C                     --IDETPC
11521C                     --MAXTEX
11522C                     --IBUGP2 ('ON' OR 'OFF' )
11523C     OUTPUT ARGUMENTS--ITEPCO (A CHARACTER VECTOR)
11524C                     --IFOUND ('YES' OR 'NO' )
11525C                     --IERROR ('YES' OR 'NO' )
11526C     WRITTEN BY--JAMES J. FILLIBEN
11527C                 STATISTICAL ENGINEERING DIVISION
11528C                 INFORMATION TECHNOLOGY LABORATORY
11529C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11530C                 GAITHERSBURG, MD 20899-8980
11531C                 PHONE--301-975-2855
11532C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11533C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11534C     LANGUAGE--ANSI FORTRAN (1977)
11535C     VERSION NUMBER--82/7
11536C     ORIGINAL VERSION--DECEMBER  1983.
11537C
11538C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11539C
11540      CHARACTER*4 IHARG
11541      CHARACTER*4 IDETPC
11542      CHARACTER*4 ITEPCO
11543C
11544      CHARACTER*4 IBUGP2
11545      CHARACTER*4 IFOUND
11546      CHARACTER*4 IERROR
11547C
11548      CHARACTER*4 IHOLD1
11549      CHARACTER*4 IHOLD2
11550C
11551      CHARACTER*4 ISUBN1
11552      CHARACTER*4 ISUBN2
11553      CHARACTER*4 ISTEPN
11554C
11555      DIMENSION IHARG(*)
11556      DIMENSION ITEPCO(*)
11557C
11558C-----COMMON----------------------------------------------------------
11559C
11560      INCLUDE 'DPCOP2.INC'
11561C
11562C-----START POINT-----------------------------------------------------
11563C
11564      IFOUND='NO'
11565      IERROR='NO'
11566      ISUBN1='DPTP'
11567      ISUBN2='CO  '
11568C
11569      NUMTEX=0
11570      IHOLD1='-999'
11571      IHOLD2='-999'
11572C
11573      IF(IBUGP2.EQ.'OFF')GOTO90
11574      WRITE(ICOUT,999)
11575  999 FORMAT(1X)
11576      CALL DPWRST('XXX','BUG ')
11577      WRITE(ICOUT,51)
11578   51 FORMAT('***** AT THE BEGINNING OF DPTPCO--')
11579      CALL DPWRST('XXX','BUG ')
11580      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
11581   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11582      CALL DPWRST('XXX','BUG ')
11583      WRITE(ICOUT,53)MAXTEX,NUMTEX
11584   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11585      CALL DPWRST('XXX','BUG ')
11586      WRITE(ICOUT,54)IHOLD1,IHOLD2
11587   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
11588      CALL DPWRST('XXX','BUG ')
11589      WRITE(ICOUT,55)IDETPC
11590   55 FORMAT('IDETPC = ',A4)
11591      CALL DPWRST('XXX','BUG ')
11592      WRITE(ICOUT,60)NUMARG
11593   60 FORMAT('NUMARG = ',I8)
11594      CALL DPWRST('XXX','BUG ')
11595      DO65I=1,NUMARG
11596      WRITE(ICOUT,66)IHARG(I)
11597   66 FORMAT('IHARG(I) = ',A4)
11598      CALL DPWRST('XXX','BUG ')
11599   65 CONTINUE
11600      WRITE(ICOUT,70)ITEPCO(1)
11601   70 FORMAT('ITEPCO(1) = ',A4)
11602      CALL DPWRST('XXX','BUG ')
11603      DO75I=1,10
11604      WRITE(ICOUT,76)I,ITEPCO(I)
11605   76 FORMAT('I,ITEPCO(I) = ',I8,2X,A4)
11606      CALL DPWRST('XXX','BUG ')
11607   75 CONTINUE
11608   90 CONTINUE
11609C
11610C               **************************************
11611C               **  STEP 1--                        **
11612C               **  BRANCH TO THE APPROPRIATE CASE  **
11613C               **************************************
11614C
11615      ISTEPN='1'
11616      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11617C
11618      IF(NUMARG.LE.1)GOTO9000
11619      IF(NUMARG.EQ.2)GOTO1120
11620      IF(NUMARG.EQ.3)GOTO1130
11621      IF(NUMARG.EQ.4)GOTO1140
11622      GOTO1150
11623C
11624 1120 CONTINUE
11625      GOTO1200
11626C
11627 1130 CONTINUE
11628      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
11629      IF(IHARG(3).EQ.'ALL')GOTO1300
11630      GOTO1200
11631C
11632 1140 CONTINUE
11633      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
11634      IF(IHARG(3).EQ.'ALL')GOTO1300
11635      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
11636      IF(IHARG(4).EQ.'ALL')GOTO1300
11637      GOTO1200
11638C
11639 1150 CONTINUE
11640      GOTO1200
11641C
11642C               *************************************************
11643C               **  STEP 2--                                   **
11644C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
11645C               *************************************************
11646C
11647 1200 CONTINUE
11648      ISTEPN='2'
11649      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11650C
11651      IF(NUMARG.LE.2)GOTO1210
11652      GOTO1220
11653C
11654 1210 CONTINUE
11655      NUMTEX=1
11656      ITEPCO(1)=IDETPC
11657      GOTO1270
11658C
11659 1220 CONTINUE
11660      NUMTEX=NUMARG-2
11661      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
11662      DO1225I=1,NUMTEX
11663      J=I+2
11664      IHOLD1=IHARG(J)
11665      IHOLD2=IHOLD1
11666      IF(IHOLD1.EQ.'ON')IHOLD2=IDETPC
11667      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETPC
11668      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPC
11669      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPC
11670      ITEPCO(I)=IHOLD2
11671 1225 CONTINUE
11672      GOTO1270
11673C
11674 1270 CONTINUE
11675      IF(IFEEDB.EQ.'OFF')GOTO1279
11676      WRITE(ICOUT,999)
11677      CALL DPWRST('XXX','BUG ')
11678      DO1278I=1,NUMTEX
11679      WRITE(ICOUT,1276)I,ITEPCO(I)
11680 1276 FORMAT('THE COLOR OF TEXT PATTERN ',I6,
11681     1' HAS JUST BEEN SET TO ',A4)
11682      CALL DPWRST('XXX','BUG ')
11683 1278 CONTINUE
11684 1279 CONTINUE
11685      IFOUND='YES'
11686      GOTO9000
11687C
11688C               **************************
11689C               **  STEP 3--            **
11690C               **  TREAT THE ALL CASE  **
11691C               **************************
11692C
11693 1300 CONTINUE
11694      ISTEPN='3'
11695      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11696C
11697      NUMTEX=MAXTEX
11698      IHOLD2=IHOLD1
11699      IF(IHOLD1.EQ.'ON')IHOLD2=IDETPC
11700      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETPC
11701      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPC
11702      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPC
11703      DO1315I=1,NUMTEX
11704      ITEPCO(I)=IHOLD2
11705 1315 CONTINUE
11706      GOTO1370
11707C
11708 1370 CONTINUE
11709      IF(IFEEDB.EQ.'OFF')GOTO1319
11710      WRITE(ICOUT,999)
11711      CALL DPWRST('XXX','BUG ')
11712      I=1
11713      WRITE(ICOUT,1316)ITEPCO(I)
11714 1316 FORMAT('THE COLOR OF ALL TEXT PATTERNS',
11715     1' HAS JUST BEEN SET TO ',A4)
11716      CALL DPWRST('XXX','BUG ')
11717 1319 CONTINUE
11718      IFOUND='YES'
11719      GOTO9000
11720C
11721C               *****************
11722C               **  STEP 90--  **
11723C               **  EXIT       **
11724C               *****************
11725C
11726 9000 CONTINUE
11727      IF(IBUGP2.EQ.'OFF')GOTO9090
11728      WRITE(ICOUT,9011)
11729 9011 FORMAT('***** AT THE END       OF DPTPCO--')
11730      CALL DPWRST('XXX','BUG ')
11731      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
11732 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11733      CALL DPWRST('XXX','BUG ')
11734      WRITE(ICOUT,9013)MAXTEX,NUMTEX
11735 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11736      CALL DPWRST('XXX','BUG ')
11737      WRITE(ICOUT,9014)IHOLD1,IHOLD2
11738 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
11739      CALL DPWRST('XXX','BUG ')
11740      WRITE(ICOUT,9015)IDETPC
11741 9015 FORMAT('IDETPC = ',A4)
11742      CALL DPWRST('XXX','BUG ')
11743      WRITE(ICOUT,9020)NUMARG
11744 9020 FORMAT('NUMARG = ',I8)
11745      CALL DPWRST('XXX','BUG ')
11746      DO9025I=1,NUMARG
11747      WRITE(ICOUT,9026)IHARG(I)
11748 9026 FORMAT('IHARG(I) = ',A4)
11749      CALL DPWRST('XXX','BUG ')
11750 9025 CONTINUE
11751      WRITE(ICOUT,9030)ITEPCO(1)
11752 9030 FORMAT('ITEPCO(1) = ',A4)
11753      CALL DPWRST('XXX','BUG ')
11754      DO9035I=1,10
11755      WRITE(ICOUT,9036)I,ITEPCO(I)
11756 9036 FORMAT('I,ITEPCO(I) = ',I8,2X,A4)
11757      CALL DPWRST('XXX','BUG ')
11758 9035 CONTINUE
11759 9090 CONTINUE
11760C
11761      RETURN
11762      END
11763      SUBROUTINE DPTPLI(IHARG,IHARG2,NUMARG,IDETPL,MAXTEX,ITEPLI,
11764CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
11765CCCC  SUBROUTINE DPTPLI(IHARG,NUMARG,IDETPL,MAXTEX,ITEPLI,
11766     1IBUGP2,IFOUND,IERROR)
11767C
11768C     PURPOSE--DEFINE THE PATTERN LINES = THE LINES TYPES
11769C              OF THE PATTERN WITHIN THE TEXTS.
11770C              THESE ARE LOCATED IN THE VECTOR ITEPLI(.).
11771C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
11772C                     --NUMARG
11773C                     --IDETPL
11774C                     --MAXTEX
11775C                     --IBUGP2 ('ON' OR 'OFF' )
11776C     OUTPUT ARGUMENTS--ITEPLI (A CHARACTER VECTOR)
11777C                     --IFOUND ('YES' OR 'NO' )
11778C                     --IERROR ('YES' OR 'NO' )
11779C     WRITTEN BY--JAMES J. FILLIBEN
11780C                 STATISTICAL ENGINEERING DIVISION
11781C                 INFORMATION TECHNOLOGY LABORATORY
11782C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11783C                 GAITHERSBURG, MD 20899-8980
11784C                 PHONE--301-975-2855
11785C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11786C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11787C     LANGUAGE--ANSI FORTRAN (1977)
11788C     VERSION NUMBER--82/7
11789C     ORIGINAL VERSION--DECEMBER  1983.
11790C     UPDATED         --AUGUST    1995.  DASH2 BUG
11791C
11792C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11793C
11794      CHARACTER*4 IHARG
11795CCCCC AUGUST 1995.  ADD FOLLOWING LINE
11796      CHARACTER*4 IHARG2
11797      CHARACTER*4 IDETPL
11798      CHARACTER*4 ITEPLI
11799C
11800      CHARACTER*4 IBUGP2
11801      CHARACTER*4 IFOUND
11802      CHARACTER*4 IERROR
11803C
11804      CHARACTER*4 IHOLD1
11805      CHARACTER*4 IHOLD2
11806C
11807      CHARACTER*4 ISUBN1
11808      CHARACTER*4 ISUBN2
11809      CHARACTER*4 ISTEPN
11810C
11811      DIMENSION IHARG(*)
11812CCCCC AUGUST 1995.  ADD FOLLOWING LINE
11813      DIMENSION IHARG2(*)
11814      DIMENSION ITEPLI(*)
11815C
11816C-----COMMON----------------------------------------------------------
11817C
11818      INCLUDE 'DPCOP2.INC'
11819C
11820C-----START POINT-----------------------------------------------------
11821C
11822      IFOUND='NO'
11823      IERROR='NO'
11824      ISUBN1='DPTP'
11825      ISUBN2='LI  '
11826C
11827      NUMTEX=0
11828      IHOLD1='-999'
11829      IHOLD2='-999'
11830C
11831      IF(IBUGP2.EQ.'OFF')GOTO90
11832      WRITE(ICOUT,999)
11833  999 FORMAT(1X)
11834      CALL DPWRST('XXX','BUG ')
11835      WRITE(ICOUT,51)
11836   51 FORMAT('***** AT THE BEGINNING OF DPTPLI--')
11837      CALL DPWRST('XXX','BUG ')
11838      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
11839   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11840      CALL DPWRST('XXX','BUG ')
11841      WRITE(ICOUT,53)MAXTEX,NUMTEX
11842   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11843      CALL DPWRST('XXX','BUG ')
11844      WRITE(ICOUT,54)IHOLD1,IHOLD2
11845   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
11846      CALL DPWRST('XXX','BUG ')
11847      WRITE(ICOUT,55)IDETPL
11848   55 FORMAT('IDETPL = ',A4)
11849      CALL DPWRST('XXX','BUG ')
11850      WRITE(ICOUT,60)NUMARG
11851   60 FORMAT('NUMARG = ',I8)
11852      CALL DPWRST('XXX','BUG ')
11853      DO65I=1,NUMARG
11854      WRITE(ICOUT,66)IHARG(I)
11855   66 FORMAT('IHARG(I) = ',A4)
11856      CALL DPWRST('XXX','BUG ')
11857   65 CONTINUE
11858      WRITE(ICOUT,70)ITEPLI(1)
11859   70 FORMAT('ITEPLI(1) = ',A4)
11860      CALL DPWRST('XXX','BUG ')
11861      DO75I=1,10
11862      WRITE(ICOUT,76)I,ITEPLI(I)
11863   76 FORMAT('I,ITEPLI(I) = ',I8,2X,A4)
11864      CALL DPWRST('XXX','BUG ')
11865   75 CONTINUE
11866   90 CONTINUE
11867C
11868C               **************************************
11869C               **  STEP 1--                        **
11870C               **  BRANCH TO THE APPROPRIATE CASE  **
11871C               **************************************
11872C
11873      ISTEPN='1'
11874      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11875C
11876      IF(NUMARG.LE.2)GOTO9000
11877      IF(NUMARG.EQ.3)GOTO1130
11878      IF(NUMARG.EQ.4)GOTO1140
11879      IF(NUMARG.EQ.5)GOTO1150
11880      GOTO1160
11881C
11882 1130 CONTINUE
11883      GOTO1200
11884C
11885 1140 CONTINUE
11886      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
11887      IF(IHARG(5).EQ.'ALL')GOTO1300
11888      GOTO1200
11889C
11890 1150 CONTINUE
11891CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
11892      IF(IHARG(5).EQ.'ALL')THEN
11893        IHOLD1=IHARG(6)
11894        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
11895        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
11896        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
11897        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
11898        GOTO1300
11899      ENDIF
11900      IF(IHARG(6).EQ.'ALL')THEN
11901        IHOLD1=IHARG(5)
11902        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
11903        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
11904        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
11905        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
11906        GOTO1300
11907      ENDIF
11908      GOTO1200
11909C
11910 1160 CONTINUE
11911      GOTO1200
11912C
11913C               *************************************************
11914C               **  STEP 2--                                   **
11915C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
11916C               *************************************************
11917C
11918 1200 CONTINUE
11919      ISTEPN='2'
11920      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11921C
11922      IF(NUMARG.LE.3)GOTO1210
11923      GOTO1220
11924C
11925 1210 CONTINUE
11926      NUMTEX=1
11927      ITEPLI(1)='    '
11928      GOTO1270
11929C
11930 1220 CONTINUE
11931      NUMTEX=NUMARG-3
11932      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
11933      DO1225I=1,NUMTEX
11934      J=I+3
11935      IHOLD1=IHARG(J)
11936      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
11937      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
11938      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
11939      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
11940      IHOLD2=IHOLD1
11941      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
11942      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
11943      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPL
11944      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPL
11945      ITEPLI(I)=IHOLD2
11946 1225 CONTINUE
11947      GOTO1270
11948C
11949 1270 CONTINUE
11950      IF(IFEEDB.EQ.'OFF')GOTO1279
11951      WRITE(ICOUT,999)
11952      CALL DPWRST('XXX','BUG ')
11953      DO1278I=1,NUMTEX
11954      WRITE(ICOUT,1276)I,ITEPLI(I)
11955 1276 FORMAT('THE LINE TYPE FOR TEXT PATTERN ',I6,
11956     1' HAS JUST BEEN SET TO ',A4)
11957      CALL DPWRST('XXX','BUG ')
11958 1278 CONTINUE
11959 1279 CONTINUE
11960      IFOUND='YES'
11961      GOTO9000
11962C
11963C               **************************
11964C               **  STEP 3--            **
11965C               **  TREAT THE ALL CASE  **
11966C               **************************
11967C
11968 1300 CONTINUE
11969      ISTEPN='3'
11970      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11971C
11972      NUMTEX=MAXTEX
11973      IHOLD2=IHOLD1
11974      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
11975      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
11976      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPL
11977      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPL
11978      DO1315I=1,NUMTEX
11979      ITEPLI(I)=IHOLD2
11980 1315 CONTINUE
11981      GOTO1370
11982C
11983 1370 CONTINUE
11984      IF(IFEEDB.EQ.'OFF')GOTO1319
11985      WRITE(ICOUT,999)
11986      CALL DPWRST('XXX','BUG ')
11987      I=1
11988      WRITE(ICOUT,1316)ITEPLI(I)
11989 1316 FORMAT('THE LINE TYPE FOR ALL TEXT PATTERNS',
11990     1' HAS JUST BEEN SET TO ',A4)
11991      CALL DPWRST('XXX','BUG ')
11992 1319 CONTINUE
11993      IFOUND='YES'
11994      GOTO9000
11995C
11996C               *****************
11997C               **  STEP 90--  **
11998C               **  EXIT       **
11999C               *****************
12000C
12001 9000 CONTINUE
12002      IF(IBUGP2.EQ.'OFF')GOTO9090
12003      WRITE(ICOUT,9011)
12004 9011 FORMAT('***** AT THE END       OF DPTPLI--')
12005      CALL DPWRST('XXX','BUG ')
12006      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
12007 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
12008      CALL DPWRST('XXX','BUG ')
12009      WRITE(ICOUT,9013)MAXTEX,NUMTEX
12010 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
12011      CALL DPWRST('XXX','BUG ')
12012      WRITE(ICOUT,9014)IHOLD1,IHOLD2
12013 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
12014      CALL DPWRST('XXX','BUG ')
12015      WRITE(ICOUT,9015)IDETPL
12016 9015 FORMAT('IDETPL = ',A4)
12017      CALL DPWRST('XXX','BUG ')
12018      WRITE(ICOUT,9020)NUMARG
12019 9020 FORMAT('NUMARG = ',I8)
12020      CALL DPWRST('XXX','BUG ')
12021      DO9025I=1,NUMARG
12022      WRITE(ICOUT,9026)IHARG(I)
12023 9026 FORMAT('IHARG(I) = ',A4)
12024      CALL DPWRST('XXX','BUG ')
12025 9025 CONTINUE
12026      WRITE(ICOUT,9030)ITEPLI(1)
12027 9030 FORMAT('ITEPLI(1) = ',A4)
12028      CALL DPWRST('XXX','BUG ')
12029      DO9035I=1,10
12030      WRITE(ICOUT,9036)I,ITEPLI(I)
12031 9036 FORMAT('I,ITEPLI(I) = ',I8,2X,A4)
12032      CALL DPWRST('XXX','BUG ')
12033 9035 CONTINUE
12034 9090 CONTINUE
12035C
12036      RETURN
12037      END
12038      SUBROUTINE DPTPSP(IHARG,IARGT,ARG,NUMARG,PDETPS,MAXTEX,PTEPSP,
12039     1IBUGP2,IFOUND,IERROR)
12040C
12041C     PURPOSE--DEFINE THE TEXT PATTERN SPACINGS = THE SPACINGS
12042C              BETWEEN THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE TEXTS.
12043C              THESE ARE LOCATED IN THE VECTOR PTEPSP(.).
12044C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
12045C                     --IARGT  (A  CHARACTER VECTOR)
12046C                     --ARG
12047C                     --NUMARG
12048C                     --PDETPS
12049C                     --MAXTEX
12050C                     --IBUGP2 ('ON' OR 'OFF' )
12051C     OUTPUT ARGUMENTS--PTEPSP (A FLOATING POINT VECTOR)
12052C                     --IFOUND ('YES' OR 'NO' )
12053C                     --IERROR ('YES' OR 'NO' )
12054C     WRITTEN BY--JAMES J. FILLIBEN
12055C                 STATISTICAL ENGINEERING DIVISION
12056C                 INFORMATION TECHNOLOGY LABORATORY
12057C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12058C                 GAITHERSBURG, MD 20899-8980
12059C                 PHONE--301-975-2855
12060C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12061C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12062C     LANGUAGE--ANSI FORTRAN (1977)
12063C     VERSION NUMBER--82/7
12064C     ORIGINAL VERSION--DECEMBER  1983.
12065C
12066C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12067C
12068      CHARACTER*4 IHARG
12069      CHARACTER*4 IARGT
12070C
12071      CHARACTER*4 IBUGP2
12072      CHARACTER*4 IFOUND
12073      CHARACTER*4 IERROR
12074C
12075      CHARACTER*4 IHOLD1
12076C
12077      CHARACTER*4 ISUBN1
12078      CHARACTER*4 ISUBN2
12079      CHARACTER*4 ISTEPN
12080C
12081      DIMENSION IHARG(*)
12082      DIMENSION IARGT(*)
12083      DIMENSION ARG(*)
12084      DIMENSION PTEPSP(*)
12085C
12086C-----COMMON----------------------------------------------------------
12087C
12088      INCLUDE 'DPCOP2.INC'
12089C
12090C-----START POINT-----------------------------------------------------
12091C
12092      IFOUND='NO'
12093      IERROR='NO'
12094      ISUBN1='DPTP'
12095      ISUBN2='SP  '
12096C
12097      NUMTEX=0
12098      IHOLD1='-999'
12099      HOLD1=-999.0
12100      HOLD2=-999.0
12101C
12102      IF(IBUGP2.EQ.'OFF')GOTO90
12103      WRITE(ICOUT,999)
12104  999 FORMAT(1X)
12105      CALL DPWRST('XXX','BUG ')
12106      WRITE(ICOUT,51)
12107   51 FORMAT('***** AT THE BEGINNING OF DPTPSP--')
12108      CALL DPWRST('XXX','BUG ')
12109      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
12110   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
12111      CALL DPWRST('XXX','BUG ')
12112      WRITE(ICOUT,53)MAXTEX,NUMTEX
12113   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
12114      CALL DPWRST('XXX','BUG ')
12115      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
12116   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
12117      CALL DPWRST('XXX','BUG ')
12118      WRITE(ICOUT,55)PDETPS
12119   55 FORMAT('PDETPS = ',E15.7)
12120      CALL DPWRST('XXX','BUG ')
12121      WRITE(ICOUT,60)NUMARG
12122   60 FORMAT('NUMARG = ',I8)
12123      CALL DPWRST('XXX','BUG ')
12124      DO65I=1,NUMARG
12125      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
12126   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
12127      CALL DPWRST('XXX','BUG ')
12128   65 CONTINUE
12129      WRITE(ICOUT,70)PTEPSP(1)
12130   70 FORMAT('PTEPSP(1) = ',E15.7)
12131      CALL DPWRST('XXX','BUG ')
12132      DO75I=1,10
12133      WRITE(ICOUT,76)I,PTEPSP(I)
12134   76 FORMAT('I,PTEPSP(I) = ',I8,2X,E15.7)
12135      CALL DPWRST('XXX','BUG ')
12136   75 CONTINUE
12137   90 CONTINUE
12138C
12139C               **************************************
12140C               **  STEP 1--                        **
12141C               **  BRANCH TO THE APPROPRIATE CASE  **
12142C               **************************************
12143C
12144      ISTEPN='1'
12145      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12146C
12147      IF(NUMARG.LE.1)GOTO9000
12148      IF(NUMARG.EQ.2)GOTO1120
12149      IF(NUMARG.EQ.3)GOTO1130
12150      IF(NUMARG.EQ.4)GOTO1140
12151      GOTO1150
12152C
12153 1120 CONTINUE
12154      GOTO1200
12155C
12156 1130 CONTINUE
12157      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
12158      IF(IHARG(3).EQ.'ALL')HOLD1=PDETPS
12159      IF(IHARG(3).EQ.'ALL')GOTO1300
12160      GOTO1200
12161C
12162 1140 CONTINUE
12163      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
12164      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
12165      IF(IHARG(3).EQ.'ALL')GOTO1300
12166      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
12167      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
12168      IF(IHARG(4).EQ.'ALL')GOTO1300
12169      GOTO1200
12170C
12171 1150 CONTINUE
12172      GOTO1200
12173C
12174C               *************************************************
12175C               **  STEP 2--                                   **
12176C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
12177C               *************************************************
12178C
12179 1200 CONTINUE
12180      ISTEPN='2'
12181      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12182C
12183      IF(NUMARG.LE.2)GOTO1210
12184      GOTO1220
12185C
12186 1210 CONTINUE
12187      NUMTEX=1
12188      PTEPSP(1)=PDETPS
12189      GOTO1270
12190C
12191 1220 CONTINUE
12192      NUMTEX=NUMARG-2
12193      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
12194      DO1225I=1,NUMTEX
12195      J=I+2
12196      IHOLD1=IHARG(J)
12197      HOLD1=ARG(J)
12198      HOLD2=HOLD1
12199      IF(IHOLD1.EQ.'ON')HOLD2=PDETPS
12200      IF(IHOLD1.EQ.'OFF')HOLD2=PDETPS
12201      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETPS
12202      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETPS
12203      PTEPSP(I)=HOLD2
12204 1225 CONTINUE
12205      GOTO1270
12206C
12207 1270 CONTINUE
12208      IF(IFEEDB.EQ.'OFF')GOTO1279
12209      WRITE(ICOUT,999)
12210      CALL DPWRST('XXX','BUG ')
12211      DO1278I=1,NUMTEX
12212      WRITE(ICOUT,1276)I,PTEPSP(I)
12213 1276 FORMAT('THE SPACING BETWEEN (LINES WITHIN) PATTERN ',I6,
12214     1' HAS JUST BEEN SET TO ',E15.7)
12215      CALL DPWRST('XXX','BUG ')
12216 1278 CONTINUE
12217 1279 CONTINUE
12218      IFOUND='YES'
12219      GOTO9000
12220C
12221C               **************************
12222C               **  STEP 3--            **
12223C               **  TREAT THE ALL CASE  **
12224C               **************************
12225C
12226 1300 CONTINUE
12227      ISTEPN='3'
12228      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12229C
12230      NUMTEX=MAXTEX
12231      HOLD2=HOLD1
12232      IF(IHOLD1.EQ.'ON')HOLD2=PDETPS
12233      IF(IHOLD1.EQ.'OFF')HOLD2=PDETPS
12234      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETPS
12235      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETPS
12236      DO1315I=1,NUMTEX
12237      PTEPSP(I)=HOLD2
12238 1315 CONTINUE
12239      GOTO1370
12240C
12241 1370 CONTINUE
12242      IF(IFEEDB.EQ.'OFF')GOTO1319
12243      WRITE(ICOUT,999)
12244      CALL DPWRST('XXX','BUG ')
12245      I=1
12246      WRITE(ICOUT,1316)PTEPSP(I)
12247 1316 FORMAT('THE SPACING BETWEEN (LINES WITHIN) ALL PATTERNS',
12248     1' HAS JUST BEEN SET TO ',E15.7)
12249      CALL DPWRST('XXX','BUG ')
12250 1319 CONTINUE
12251      IFOUND='YES'
12252      GOTO9000
12253C
12254C               *****************
12255C               **  STEP 90--  **
12256C               **  EXIT       **
12257C               *****************
12258C
12259 9000 CONTINUE
12260      IF(IBUGP2.EQ.'OFF')GOTO9090
12261      WRITE(ICOUT,9011)
12262 9011 FORMAT('***** AT THE END       OF DPTPSP--')
12263      CALL DPWRST('XXX','BUG ')
12264      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
12265 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
12266      CALL DPWRST('XXX','BUG ')
12267      WRITE(ICOUT,9013)MAXTEX,NUMTEX
12268 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
12269      CALL DPWRST('XXX','BUG ')
12270      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
12271 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
12272      CALL DPWRST('XXX','BUG ')
12273      WRITE(ICOUT,9015)PDETPS
12274 9015 FORMAT('PDETPS = ',E15.7)
12275      CALL DPWRST('XXX','BUG ')
12276      WRITE(ICOUT,9020)NUMARG
12277 9020 FORMAT('NUMARG = ',I8)
12278      CALL DPWRST('XXX','BUG ')
12279      DO9025I=1,NUMARG
12280      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
12281 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
12282      CALL DPWRST('XXX','BUG ')
12283 9025 CONTINUE
12284      WRITE(ICOUT,9030)PTEPSP(1)
12285 9030 FORMAT('PTEPSP(1) = ',E15.7)
12286      CALL DPWRST('XXX','BUG ')
12287      DO9035I=1,10
12288      WRITE(ICOUT,9036)I,PTEPSP(I)
12289 9036 FORMAT('I,PTEPSP(I) = ',I8,2X,E15.7)
12290      CALL DPWRST('XXX','BUG ')
12291 9035 CONTINUE
12292 9090 CONTINUE
12293C
12294      RETURN
12295      END
12296      SUBROUTINE DPTPTH(IHARG,IARGT,ARG,NUMARG,PDETPT,MAXTEX,PTEPTH,
12297     1IBUGP2,IFOUND,IERROR)
12298C
12299C     PURPOSE--DEFINE THE TEXT PATTERN THICKNESSES = THE THICKNESSES
12300C              OF THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE TEXTS.
12301C              THESE ARE LOCATED IN THE VECTOR PTEPTH(.).
12302C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
12303C                     --IARGT  (A  CHARACTER VECTOR)
12304C                     --ARG
12305C                     --NUMARG
12306C                     --PDETPT
12307C                     --MAXTEX
12308C                     --IBUGP2 ('ON' OR 'OFF' )
12309C     OUTPUT ARGUMENTS--PTEPTH (A FLOATING POINT VECTOR)
12310C                     --IFOUND ('YES' OR 'NO' )
12311C                     --IERROR ('YES' OR 'NO' )
12312C     WRITTEN BY--JAMES J. FILLIBEN
12313C                 STATISTICAL ENGINEERING DIVISION
12314C                 INFORMATION TECHNOLOGY LABORATORY
12315C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12316C                 GAITHERSBURG, MD 20899-8980
12317C                 PHONE--301-975-2855
12318C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12319C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12320C     LANGUAGE--ANSI FORTRAN (1977)
12321C     VERSION NUMBER--82/7
12322C     ORIGINAL VERSION--DECEMBER  1983.
12323C
12324C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12325C
12326      CHARACTER*4 IHARG
12327      CHARACTER*4 IARGT
12328C
12329      CHARACTER*4 IBUGP2
12330      CHARACTER*4 IFOUND
12331      CHARACTER*4 IERROR
12332C
12333      CHARACTER*4 IHOLD1
12334C
12335      CHARACTER*4 ISUBN1
12336      CHARACTER*4 ISUBN2
12337      CHARACTER*4 ISTEPN
12338C
12339      DIMENSION IHARG(*)
12340      DIMENSION IARGT(*)
12341      DIMENSION ARG(*)
12342      DIMENSION PTEPTH(*)
12343C
12344C-----COMMON----------------------------------------------------------
12345C
12346      INCLUDE 'DPCOP2.INC'
12347C
12348C-----START POINT-----------------------------------------------------
12349C
12350      IFOUND='NO'
12351      IERROR='NO'
12352      ISUBN1='DPTP'
12353      ISUBN2='TH  '
12354C
12355      NUMTEX=0
12356      IHOLD1='-999'
12357      HOLD1=-999.0
12358      HOLD2=-999.0
12359C
12360      IF(IBUGP2.EQ.'OFF')GOTO90
12361      WRITE(ICOUT,999)
12362  999 FORMAT(1X)
12363      CALL DPWRST('XXX','BUG ')
12364      WRITE(ICOUT,51)
12365   51 FORMAT('***** AT THE BEGINNING OF DPTPTH--')
12366      CALL DPWRST('XXX','BUG ')
12367      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
12368   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
12369      CALL DPWRST('XXX','BUG ')
12370      WRITE(ICOUT,53)MAXTEX,NUMTEX
12371   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
12372      CALL DPWRST('XXX','BUG ')
12373      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
12374   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
12375      CALL DPWRST('XXX','BUG ')
12376      WRITE(ICOUT,55)PDETPT
12377   55 FORMAT('PDETPT = ',E15.7)
12378      CALL DPWRST('XXX','BUG ')
12379      WRITE(ICOUT,60)NUMARG
12380   60 FORMAT('NUMARG = ',I8)
12381      CALL DPWRST('XXX','BUG ')
12382      DO65I=1,NUMARG
12383      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
12384   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
12385      CALL DPWRST('XXX','BUG ')
12386   65 CONTINUE
12387      WRITE(ICOUT,70)PTEPTH(1)
12388   70 FORMAT('PTEPTH(1) = ',E15.7)
12389      CALL DPWRST('XXX','BUG ')
12390      DO75I=1,10
12391      WRITE(ICOUT,76)I,PTEPTH(I)
12392   76 FORMAT('I,PTEPTH(I) = ',I8,2X,E15.7)
12393      CALL DPWRST('XXX','BUG ')
12394   75 CONTINUE
12395   90 CONTINUE
12396C
12397C               **************************************
12398C               **  STEP 1--                        **
12399C               **  BRANCH TO THE APPROPRIATE CASE  **
12400C               **************************************
12401C
12402      ISTEPN='1'
12403      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12404C
12405      IF(NUMARG.LE.1)GOTO9000
12406      IF(NUMARG.EQ.2)GOTO1120
12407      IF(NUMARG.EQ.3)GOTO1130
12408      IF(NUMARG.EQ.4)GOTO1140
12409      GOTO1150
12410C
12411 1120 CONTINUE
12412      GOTO1200
12413C
12414 1130 CONTINUE
12415      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
12416      IF(IHARG(3).EQ.'ALL')HOLD1=PDETPT
12417      IF(IHARG(3).EQ.'ALL')GOTO1300
12418      GOTO1200
12419C
12420 1140 CONTINUE
12421      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
12422      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
12423      IF(IHARG(3).EQ.'ALL')GOTO1300
12424      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
12425      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(2)
12426      IF(IHARG(4).EQ.'ALL')GOTO1300
12427      GOTO1200
12428C
12429 1150 CONTINUE
12430      GOTO1200
12431C
12432C               *************************************************
12433C               **  STEP 2--                                   **
12434C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
12435C               *************************************************
12436C
12437 1200 CONTINUE
12438      ISTEPN='2'
12439      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12440C
12441      IF(NUMARG.LE.2)GOTO1210
12442      GOTO1220
12443C
12444 1210 CONTINUE
12445      NUMTEX=1
12446      PTEPTH(1)=PDETPT
12447      GOTO1270
12448C
12449 1220 CONTINUE
12450      NUMTEX=NUMARG-2
12451      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
12452      DO1225I=1,NUMTEX
12453      J=I+2
12454      IHOLD1=IHARG(J)
12455      HOLD1=ARG(J)
12456      HOLD2=HOLD1
12457      IF(IHOLD1.EQ.'ON')HOLD2=PDETPT
12458      IF(IHOLD1.EQ.'OFF')HOLD2=PDETPT
12459      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETPT
12460      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETPT
12461      PTEPTH(I)=HOLD2
12462 1225 CONTINUE
12463      GOTO1270
12464C
12465 1270 CONTINUE
12466      IF(IFEEDB.EQ.'OFF')GOTO1279
12467      WRITE(ICOUT,999)
12468      CALL DPWRST('XXX','BUG ')
12469      DO1278I=1,NUMTEX
12470      WRITE(ICOUT,1276)I,PTEPTH(I)
12471 1276 FORMAT('THE THICKNESS OF (LINES WITHIN) PATTERN ',I6,
12472     1' HAS JUST BEEN SET TO ',E15.7)
12473      CALL DPWRST('XXX','BUG ')
12474 1278 CONTINUE
12475 1279 CONTINUE
12476      IFOUND='YES'
12477      GOTO9000
12478C
12479C               **************************
12480C               **  STEP 3--            **
12481C               **  TREAT THE ALL CASE  **
12482C               **************************
12483C
12484 1300 CONTINUE
12485      ISTEPN='3'
12486      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12487C
12488      NUMTEX=MAXTEX
12489      HOLD2=HOLD1
12490      IF(IHOLD1.EQ.'ON')HOLD2=PDETPT
12491      IF(IHOLD1.EQ.'OFF')HOLD2=PDETPT
12492      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETPT
12493      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETPT
12494      DO1315I=1,NUMTEX
12495      PTEPTH(I)=HOLD2
12496 1315 CONTINUE
12497      GOTO1370
12498C
12499 1370 CONTINUE
12500      IF(IFEEDB.EQ.'OFF')GOTO1319
12501      WRITE(ICOUT,999)
12502      CALL DPWRST('XXX','BUG ')
12503      I=1
12504      WRITE(ICOUT,1316)PTEPTH(I)
12505 1316 FORMAT('THE THICKNESS OF (LINES WITHIN) ALL PATTERNS',
12506     1' HAS JUST BEEN SET TO ',E15.7)
12507      CALL DPWRST('XXX','BUG ')
12508 1319 CONTINUE
12509      IFOUND='YES'
12510      GOTO9000
12511C
12512C               *****************
12513C               **  STEP 90--  **
12514C               **  EXIT       **
12515C               *****************
12516C
12517 9000 CONTINUE
12518      IF(IBUGP2.EQ.'OFF')GOTO9090
12519      WRITE(ICOUT,9011)
12520 9011 FORMAT('***** AT THE END       OF DPTPTH--')
12521      CALL DPWRST('XXX','BUG ')
12522      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
12523 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
12524      CALL DPWRST('XXX','BUG ')
12525      WRITE(ICOUT,9013)MAXTEX,NUMTEX
12526 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
12527      CALL DPWRST('XXX','BUG ')
12528      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
12529 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
12530      CALL DPWRST('XXX','BUG ')
12531      WRITE(ICOUT,9015)PDETPT
12532 9015 FORMAT('PDETPT = ',E15.7)
12533      CALL DPWRST('XXX','BUG ')
12534      WRITE(ICOUT,9020)NUMARG
12535 9020 FORMAT('NUMARG = ',I8)
12536      CALL DPWRST('XXX','BUG ')
12537      DO9025I=1,NUMARG
12538      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
12539 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
12540      CALL DPWRST('XXX','BUG ')
12541 9025 CONTINUE
12542      WRITE(ICOUT,9030)PTEPTH(1)
12543 9030 FORMAT('PTEPTH(1) = ',E15.7)
12544      CALL DPWRST('XXX','BUG ')
12545      DO9035I=1,10
12546      WRITE(ICOUT,9036)I,PTEPTH(I)
12547 9036 FORMAT('I,PTEPTH(I) = ',I8,2X,E15.7)
12548      CALL DPWRST('XXX','BUG ')
12549 9035 CONTINUE
12550 9090 CONTINUE
12551C
12552      RETURN
12553      END
12554      SUBROUTINE DPTPTY(IHARG,NUMARG,IDETPT,MAXTEX,ITEPTY,
12555     1IBUGP2,IFOUND,IERROR)
12556C
12557C     PURPOSE--DEFINE THE PATTERN TYPES = THE TYPES
12558C              OF THE PATTERN WITHIN THE TEXTS.
12559C              THESE ARE LOCATED IN THE VECTOR ITEPTY(.).
12560C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
12561C                     --NUMARG
12562C                     --IDETPT
12563C                     --MAXTEX
12564C                     --IBUGP2 ('ON' OR 'OFF' )
12565C     OUTPUT ARGUMENTS--ITEPTY (A CHARACTER VECTOR)
12566C                     --IFOUND ('YES' OR 'NO' )
12567C                     --IERROR ('YES' OR 'NO' )
12568C     WRITTEN BY--JAMES J. FILLIBEN
12569C                 STATISTICAL ENGINEERING DIVISION
12570C                 INFORMATION TECHNOLOGY LABORATORY
12571C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12572C                 GAITHERSBURG, MD 20899-8980
12573C                 PHONE--301-975-2855
12574C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12575C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12576C     LANGUAGE--ANSI FORTRAN (1977)
12577C     VERSION NUMBER--82/7
12578C     ORIGINAL VERSION--DECEMBER  1983.
12579C
12580C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12581C
12582      CHARACTER*4 IHARG
12583      CHARACTER*4 IDETPT
12584      CHARACTER*4 ITEPTY
12585C
12586      CHARACTER*4 IBUGP2
12587      CHARACTER*4 IFOUND
12588      CHARACTER*4 IERROR
12589C
12590      CHARACTER*4 IHOLD1
12591      CHARACTER*4 IHOLD2
12592C
12593      CHARACTER*4 ISUBN1
12594      CHARACTER*4 ISUBN2
12595      CHARACTER*4 ISTEPN
12596C
12597      DIMENSION IHARG(*)
12598      DIMENSION ITEPTY(*)
12599C
12600C-----COMMON----------------------------------------------------------
12601C
12602      INCLUDE 'DPCOP2.INC'
12603C
12604C-----START POINT-----------------------------------------------------
12605C
12606      IFOUND='NO'
12607      IERROR='NO'
12608      ISUBN1='DPTP'
12609      ISUBN2='TY  '
12610C
12611      NUMTEX=0
12612      IHOLD1='-999'
12613      IHOLD2='-999'
12614C
12615      IF(IBUGP2.EQ.'OFF')GOTO90
12616      WRITE(ICOUT,999)
12617  999 FORMAT(1X)
12618      CALL DPWRST('XXX','BUG ')
12619      WRITE(ICOUT,51)
12620   51 FORMAT('***** AT THE BEGINNING OF DPTPTY--')
12621      CALL DPWRST('XXX','BUG ')
12622      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
12623   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
12624      CALL DPWRST('XXX','BUG ')
12625      WRITE(ICOUT,53)MAXTEX,NUMTEX
12626   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
12627      CALL DPWRST('XXX','BUG ')
12628      WRITE(ICOUT,54)IHOLD1,IHOLD2
12629   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
12630      CALL DPWRST('XXX','BUG ')
12631      WRITE(ICOUT,55)IDETPT
12632   55 FORMAT('IDETPT = ',A4)
12633      CALL DPWRST('XXX','BUG ')
12634      WRITE(ICOUT,60)NUMARG
12635   60 FORMAT('NUMARG = ',I8)
12636      CALL DPWRST('XXX','BUG ')
12637      DO65I=1,NUMARG
12638      WRITE(ICOUT,66)IHARG(I)
12639   66 FORMAT('IHARG(I) = ',A4)
12640      CALL DPWRST('XXX','BUG ')
12641   65 CONTINUE
12642      WRITE(ICOUT,70)ITEPTY(1)
12643   70 FORMAT('ITEPTY(1) = ',A4)
12644      CALL DPWRST('XXX','BUG ')
12645      DO75I=1,10
12646      WRITE(ICOUT,76)I,ITEPTY(I)
12647   76 FORMAT('I,ITEPTY(I) = ',I8,2X,A4)
12648      CALL DPWRST('XXX','BUG ')
12649   75 CONTINUE
12650   90 CONTINUE
12651C
12652C               **************************************
12653C               **  STEP 1--                        **
12654C               **  BRANCH TO THE APPROPRIATE CASE  **
12655C               **************************************
12656C
12657      ISTEPN='1'
12658      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12659C
12660      IF(NUMARG.LE.1)GOTO9000
12661      IF(NUMARG.EQ.2)GOTO1120
12662      IF(NUMARG.EQ.3)GOTO1130
12663      IF(NUMARG.EQ.4)GOTO1140
12664      GOTO1150
12665C
12666 1120 CONTINUE
12667      GOTO1200
12668C
12669 1130 CONTINUE
12670      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
12671      IF(IHARG(3).EQ.'ALL')GOTO1300
12672      GOTO1200
12673C
12674 1140 CONTINUE
12675      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
12676      IF(IHARG(3).EQ.'ALL')GOTO1300
12677      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
12678      IF(IHARG(4).EQ.'ALL')GOTO1300
12679      GOTO1200
12680C
12681 1150 CONTINUE
12682      GOTO1200
12683C
12684C               *************************************************
12685C               **  STEP 2--                                   **
12686C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
12687C               *************************************************
12688C
12689 1200 CONTINUE
12690      ISTEPN='2'
12691      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12692C
12693      IF(NUMARG.LE.2)GOTO1210
12694      GOTO1220
12695C
12696 1210 CONTINUE
12697      NUMTEX=1
12698      ITEPTY(1)='    '
12699      GOTO1270
12700C
12701 1220 CONTINUE
12702      NUMTEX=NUMARG-2
12703      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
12704      DO1225I=1,NUMTEX
12705      J=I+2
12706      IHOLD1=IHARG(J)
12707      IHOLD2=IHOLD1
12708      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
12709      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
12710      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPT
12711      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPT
12712      ITEPTY(I)=IHOLD2
12713 1225 CONTINUE
12714      GOTO1270
12715C
12716 1270 CONTINUE
12717      IF(IFEEDB.EQ.'OFF')GOTO1279
12718      WRITE(ICOUT,999)
12719      CALL DPWRST('XXX','BUG ')
12720      DO1278I=1,NUMTEX
12721      WRITE(ICOUT,1276)I,ITEPTY(I)
12722 1276 FORMAT('THE TYPE FOR TEXT PATTERN ',I6,
12723     1' HAS JUST BEEN SET TO ',A4)
12724      CALL DPWRST('XXX','BUG ')
12725 1278 CONTINUE
12726 1279 CONTINUE
12727      IFOUND='YES'
12728      GOTO9000
12729C
12730C               **************************
12731C               **  STEP 3--            **
12732C               **  TREAT THE ALL CASE  **
12733C               **************************
12734C
12735 1300 CONTINUE
12736      ISTEPN='3'
12737      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12738C
12739      NUMTEX=MAXTEX
12740      IHOLD2=IHOLD1
12741      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
12742      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
12743      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPT
12744      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPT
12745      DO1315I=1,NUMTEX
12746      ITEPTY(I)=IHOLD2
12747 1315 CONTINUE
12748      GOTO1370
12749C
12750 1370 CONTINUE
12751      IF(IFEEDB.EQ.'OFF')GOTO1319
12752      WRITE(ICOUT,999)
12753      CALL DPWRST('XXX','BUG ')
12754      I=1
12755      WRITE(ICOUT,1316)ITEPTY(I)
12756 1316 FORMAT('THE TYPE FOR ALL TEXT PATTERNS',
12757     1' HAS JUST BEEN SET TO ',A4)
12758      CALL DPWRST('XXX','BUG ')
12759 1319 CONTINUE
12760      IFOUND='YES'
12761      GOTO9000
12762C
12763C               *****************
12764C               **  STEP 90--  **
12765C               **  EXIT       **
12766C               *****************
12767C
12768 9000 CONTINUE
12769      IF(IBUGP2.EQ.'OFF')GOTO9090
12770      WRITE(ICOUT,9011)
12771 9011 FORMAT('***** AT THE END       OF DPTPTY--')
12772      CALL DPWRST('XXX','BUG ')
12773      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
12774 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
12775      CALL DPWRST('XXX','BUG ')
12776      WRITE(ICOUT,9013)MAXTEX,NUMTEX
12777 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
12778      CALL DPWRST('XXX','BUG ')
12779      WRITE(ICOUT,9014)IHOLD1,IHOLD2
12780 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
12781      CALL DPWRST('XXX','BUG ')
12782      WRITE(ICOUT,9015)IDETPT
12783 9015 FORMAT('IDETPT = ',A4)
12784      CALL DPWRST('XXX','BUG ')
12785      WRITE(ICOUT,9020)NUMARG
12786 9020 FORMAT('NUMARG = ',I8)
12787      CALL DPWRST('XXX','BUG ')
12788      DO9025I=1,NUMARG
12789      WRITE(ICOUT,9026)IHARG(I)
12790 9026 FORMAT('IHARG(I) = ',A4)
12791      CALL DPWRST('XXX','BUG ')
12792 9025 CONTINUE
12793      WRITE(ICOUT,9030)ITEPTY(1)
12794 9030 FORMAT('ITEPTY(1) = ',A4)
12795      CALL DPWRST('XXX','BUG ')
12796      DO9035I=1,10
12797      WRITE(ICOUT,9036)I,ITEPTY(I)
12798 9036 FORMAT('I,ITEPTY(I) = ',I8,2X,A4)
12799      CALL DPWRST('XXX','BUG ')
12800 9035 CONTINUE
12801 9090 CONTINUE
12802C
12803      RETURN
12804      END
12805      SUBROUTINE DPTREN(XTEMP2,MAXNXT,ICAPSW,IFORSW,
12806     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
12807C
12808C     PURPOSE--CARRY OUT 3 TRENDS TEST FOR RELIABILITY ANALYSIS.
12809C              1) REVERSE ARRANGEMENTS TEST
12810C              2) MILITARY HANDBOOK TEST
12811C              3) LAPLACE TEST
12812C     EXAMPLES--LET TEND = <VALUE>; RELIABILITY TREND TEST Y
12813C             --LET TEND = <VALUE>; RELIABILITY TREND TEST Y GROUPID
12814C             --RELIABILITY TREND TEST Y GROUPID CENSOR
12815C     REFERENCE--TOBIAS AND TRINDADE (1995), "APPLIED RELIABILITY
12816C                ANALYSIS", SECOND EDITION, CHAPMAN & HALL/CRC,
12817C                PP. 344-354.
12818C     WRITTEN BY--ALAN HECKERT
12819C                 STATISTICAL ENGINEERING DIVISION
12820C                 INFORMATION TECHNOLOGY LABORATORY
12821C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12822C                 GAITHERSBURG, MD 20899-8980
12823C                 PHONE--301-975-2899
12824C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12825C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12826C     LANGUAGE--ANSI FORTRAN (1977)
12827C     VERSION NUMBER--98/5
12828C     ORIGINAL VERSION--MAY       1998.
12829C     UPDATED         --OCTOBER   2006. SUPPORT FOR MULTIPLE SYSTEMS
12830C     UPDATED         --OCTOBER   2006. CAPTURE HTML/LATEX/RTF
12831C     UPDATED         --FEBRUARY  2011. USE DPPARS AND DPPAR3
12832C
12833C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12834C
12835      CHARACTER*4 ICAPSW
12836      CHARACTER*4 IFORSW
12837      CHARACTER*4 IBUGA2
12838      CHARACTER*4 IBUGA3
12839      CHARACTER*4 IBUGQ
12840      CHARACTER*4 ISUBRO
12841      CHARACTER*4 IFOUND
12842      CHARACTER*4 IERROR
12843C
12844      CHARACTER*4 IHP
12845      CHARACTER*4 IHP2
12846      CHARACTER*4 IHWUSE
12847      CHARACTER*4 MESSAG
12848C
12849      CHARACTER*4 ISUBN1
12850      CHARACTER*4 ISUBN2
12851      CHARACTER*4 ISTEPN
12852C
12853      CHARACTER*4 ICASE
12854      CHARACTER*40 INAME
12855      PARAMETER (MAXSPN=20)
12856      CHARACTER*4 IVARN1(MAXSPN)
12857      CHARACTER*4 IVARN2(MAXSPN)
12858      CHARACTER*4 IVARTY(MAXSPN)
12859      REAL PVAR(MAXSPN)
12860      INTEGER ILIS(MAXSPN)
12861      INTEGER NRIGHT(MAXSPN)
12862      INTEGER ICOLR(MAXSPN)
12863C
12864C---------------------------------------------------------------------
12865C
12866      INCLUDE 'DPCOPA.INC'
12867C
12868      DIMENSION XTEMP2(*)
12869C
12870      DIMENSION Y1(MAXOBV)
12871      DIMENSION X1(MAXOBV)
12872      DIMENSION XCEN(MAXOBV)
12873      DIMENSION TEMP1(MAXOBV)
12874      DIMENSION TEMP2(MAXOBV)
12875      DIMENSION TEMP3(MAXOBV)
12876      DIMENSION TEMP4(MAXOBV)
12877      DIMENSION TEMP5(MAXOBV)
12878      DIMENSION TEMP6(MAXOBV)
12879C
12880      INCLUDE 'DPCOZZ.INC'
12881      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
12882      EQUIVALENCE (GARBAG(IGARB2),X1(1))
12883      EQUIVALENCE (GARBAG(IGARB3),XCEN(1))
12884      EQUIVALENCE (GARBAG(IGARB4),TEMP1(1))
12885      EQUIVALENCE (GARBAG(IGARB5),TEMP2(1))
12886      EQUIVALENCE (GARBAG(IGARB6),TEMP3(1))
12887      EQUIVALENCE (GARBAG(IGARB7),TEMP4(1))
12888      EQUIVALENCE (GARBAG(IGARB8),TEMP5(1))
12889      EQUIVALENCE (GARBAG(IGARB9),TEMP6(1))
12890C
12891C-----COMMON----------------------------------------------------------
12892C
12893      INCLUDE 'DPCOHK.INC'
12894      INCLUDE 'DPCOSU.INC'
12895      INCLUDE 'DPCODA.INC'
12896      INCLUDE 'DPCOP2.INC'
12897C
12898C-----START POINT-----------------------------------------------------
12899C
12900      ISUBN1='DPTR'
12901      ISUBN2='EN  '
12902      IFOUND='YES'
12903      IERROR='NO'
12904C
12905      MAXCP1=MAXCOL+1
12906      MAXCP2=MAXCOL+2
12907      MAXCP3=MAXCOL+3
12908      MAXCP4=MAXCOL+4
12909      MAXCP5=MAXCOL+5
12910      MAXCP6=MAXCOL+6
12911C
12912      NGROUP=0
12913      NCENS=0
12914C
12915C               **********************************
12916C               **  TREAT THE TRENDS TEST CASE  **
12917C               **********************************
12918C
12919      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TREN')THEN
12920        WRITE(ICOUT,999)
12921  999   FORMAT(1X)
12922        CALL DPWRST('XXX','BUG ')
12923        WRITE(ICOUT,51)
12924   51   FORMAT('***** AT THE BEGINNING OF DPTREN--')
12925        CALL DPWRST('XXX','BUG ')
12926        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO
12927   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
12928        CALL DPWRST('XXX','BUG ')
12929      ENDIF
12930C
12931C               *********************************
12932C               **  STEP 1--                   **
12933C               **  EXTRACT THE VARIABLE LIST  **
12934C               *********************************
12935C
12936      ISTEPN='4'
12937      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
12938     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12939C
12940      INAME='RELIABILITY TREND TEST'
12941      MINNA=1
12942      MAXNA=100
12943      MINN2=4
12944      IFLAGE=1
12945      IFLAGM=9
12946      IFLAGP=0
12947      JMIN=1
12948      JMAX=NUMARG
12949      MINNVA=1
12950      MAXNVA=3
12951C
12952      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
12953     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
12954     1            JMIN,JMAX,
12955     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
12956     1            IVARN1,IVARN2,IVARTY,PVAR,
12957     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
12958     1            MINNVA,MAXNVA,
12959     1            IFLAGM,IFLAGP,
12960     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
12961      IF(IERROR.EQ.'YES')GOTO9000
12962C
12963      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')THEN
12964        WRITE(ICOUT,999)
12965        CALL DPWRST('XXX','BUG ')
12966        WRITE(ICOUT,281)
12967  281   FORMAT('***** AFTER CALL DPPARS--')
12968        CALL DPWRST('XXX','BUG ')
12969        WRITE(ICOUT,282)NQ,NUMVAR
12970  282   FORMAT('NQ,NUMVAR = ',2I8)
12971        CALL DPWRST('XXX','BUG ')
12972        IF(NUMVAR.GT.0)THEN
12973          DO285I=1,NUMVAR
12974            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
12975     1                      ICOLR(I),PVAR(I)
12976  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
12977     1             'ICOLR(I),PVAR(I) = ',I8,2X,A4,A4,2X,3I8,G15.7)
12978            CALL DPWRST('XXX','BUG ')
12979  285     CONTINUE
12980        ENDIF
12981      ENDIF
12982C
12983      ICOL=1
12984      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
12985     1            INAME,IVARN1,IVARN2,IVARTY,
12986     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
12987     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
12988     1            MAXCP4,MAXCP5,MAXCP6,
12989     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
12990     1            Y1,X1,XCEN,NS,NGROUP,NCENS,ICASE,
12991     1            IBUGA3,ISUBRO,IFOUND,IERROR)
12992C
12993C               *****************************************
12994C               **  STEP 3--                           **
12995C               **  CHECK TO SEE THE IF THE PARAMETER  **
12996C               **  TEND (TO SPECIFY THE CENSORING TIME)*
12997C               *****************************************
12998C
12999      IHP='TEND'
13000      IHP2='    '
13001      IHWUSE='P'
13002      MESSAG='NO'
13003      CALL CHECKN(IHP,IHP2,IHWUSE,
13004     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
13005     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
13006      IF(IERROR.EQ.'YES')THEN
13007        TEND=CPUMIN
13008      ELSE
13009        TEND=VALUE(ILOCP)
13010      ENDIF
13011C
13012C               ***********************************************
13013C               **  STEP 4--                                 **
13014C               **  PREPARE FOR ENTRANCE INTO DPTREN2--      **
13015C               ***********************************************
13016C
13017      ISTEPN='4'
13018      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
13019     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13020C
13021      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TREN')THEN
13022        WRITE(ICOUT,999)
13023        CALL DPWRST('XXX','BUG ')
13024        WRITE(ICOUT,1211)
13025 1211   FORMAT('***** FROM DPTREN, AS WE ARE ABOUT TO CALL DPTRE2--')
13026        CALL DPWRST('XXX','BUG ')
13027        WRITE(ICOUT,1212)NS
13028 1212   FORMAT('NS = ',I8)
13029        CALL DPWRST('XXX','BUG ')
13030        DO1215I=1,NS
13031          WRITE(ICOUT,1216)I,Y1(I),X1(I),XCEN(I)
13032 1216     FORMAT('I,Y1(I),X1(I),XCEN(I) = ',I8,3G15.7)
13033          CALL DPWRST('XXX','BUG ')
13034 1215   CONTINUE
13035      ENDIF
13036C
13037      CALL DPTRE2(Y1,NS,X1,NGROUP,XCEN,NCENS,
13038     1            ICAPSW,ICAPTY,IFORSW,
13039     1            XTEMP2,TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
13040     1            TEND,MAXNXT,
13041     1            ISUBRO,IBUGA3,IERROR)
13042C
13043C               *****************
13044C               **  STEP 90--  **
13045C               **  EXIT       **
13046C               *****************
13047C
13048 9000 CONTINUE
13049      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TREN')THEN
13050        WRITE(ICOUT,999)
13051        CALL DPWRST('XXX','BUG ')
13052        WRITE(ICOUT,9011)
13053 9011   FORMAT('***** AT THE END       OF DPTREN--')
13054        CALL DPWRST('XXX','BUG ')
13055        WRITE(ICOUT,9016)IFOUND,IERROR
13056 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
13057        CALL DPWRST('XXX','BUG ')
13058      ENDIF
13059C
13060      RETURN
13061      END
13062      SUBROUTINE DPTRE2(Y,N,X1,NGROUP,XCEN,NCENS,
13063     1                  ICAPSW,ICAPTY,IFORSW,
13064     1                  XTEMP1,XIDTEM,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
13065     1                  TEND,MAXNXT,
13066     1                  ISUBRO,IBUGA3,IERROR)
13067C
13068C     PURPOSE--THIS ROUTINE CARRIES OUT A TRENDS ANALYSIS
13069C              FOR THE DATA IN THE INPUT VECTOR Y.
13070C     INPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
13071C                               (UNSORTED) REPAIR/CENSORING TIMES.
13072C                    --X1     = THE OPTIONAL SINGLE PRECISION VECTOR
13073C                               GROUP-ID VALUES
13074C                    --XCEN   = THE OPTIONAL SINGLE PRECISION VECTOR
13075C                               OF CENSOR VALUES (1 = REPAIR
13076C                               TIME, 0 = CENSOR TIME).
13077C                      NY     = THE INTEGER NUMBER OF OBSERVATIONS
13078C                               IN THE VECTOR Y.
13079C                      NX     = THE INTEGER NUMBER OF OBSERVATIONS
13080C                               IN THE VECTOR X1.
13081C                      NC     = THE INTEGER NUMBER OF OBSERVATIONS
13082C                               IN THE VECTOR XCEN.
13083C     REFERENCE--TOBIAS AND TRINDADE (1995), "APPLIED
13084C                RELIABILITY", SECOND EDITION, CHAPMAN AND HALL,
13085C                PP. 314.
13086C     NOTE--3 TRENDS TESTS ARE PERFORMED:
13087C           1) REVERSE ARRANGEMENT TEST
13088C           2) MILITARY HANDBOOK TEST
13089C           3) LAPLACE TEST
13090C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
13091C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
13092C     LANGUAGE--ANSI 77 FORTRAN.
13093C     WRITTEN BY--ALAN HECKERT
13094C                 STATISTICAL ENGINEERING DIVISION
13095C                 INFORMATION TECHNOLOGY LABORATORY
13096C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13097C                 GAITHERSBURG, MD 20899-8980
13098C                 PHONE--301-975-2899
13099C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13100C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13101C     LANGUAGE--ANSI FORTRAN (1977)
13102C     VERSION NUMBER--98/5
13103C     ORIGINAL VERSION--MAY       1998.
13104C     UPDATED         --OCTOBER   2006. SUPPORT FOR MULTIPLE SYSTEMS
13105C     UPDATED         --OCTOBER   2006. SUPPORT FOR HTML/LATEX/RFT
13106C                                       OUTPUT
13107C     UPDATED         --OCTOBER   2006. CHANGE OUTPUT FORMAT FOR
13108C                                       REVERSE ARRANGEMENT TEST
13109C                                       AND CORRECTED BUG IN THIS
13110C                                       TEST
13111C     UPDATED         --OCTOBER   2006. CODE FOR SINGLE TEST
13112C                                       EXTRACTED TO DPTRE3
13113C     UPDATED         --FEBRUARY  2011. USE DPDTA1 AND DPDTA5 TO PRINT
13114C                                       TABLES
13115C
13116C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
13117C
13118      CHARACTER*4 ICAPSW
13119      CHARACTER*4 ICAPTY
13120      CHARACTER*4 IFORSW
13121      CHARACTER*4 ISUBRO
13122      CHARACTER*4 IBUGA3
13123      CHARACTER*4 IERROR
13124C
13125      CHARACTER*4 ISUBN1
13126      CHARACTER*4 ISUBN2
13127      CHARACTER*4 ISTEPN
13128C
13129      DOUBLE PRECISION DSUM1
13130      DOUBLE PRECISION DSUM2
13131      DOUBLE PRECISION DSUM3
13132      DOUBLE PRECISION DVAL2
13133      DOUBLE PRECISION DVAL3
13134C
13135      REAL MHTPVA
13136C
13137C---------------------------------------------------------------------
13138C
13139      DIMENSION Y(*)
13140      DIMENSION X1(*)
13141      DIMENSION XCEN(*)
13142      DIMENSION XTEMP1(*)
13143      DIMENSION XIDTEM(*)
13144      DIMENSION TEMP2(*)
13145      DIMENSION TEMP3(*)
13146      DIMENSION TEMP4(*)
13147      DIMENSION TEMP5(*)
13148      DIMENSION TEMP6(*)
13149C
13150      PARAMETER (NUMALP=3)
13151      PARAMETER(NUMCLI=5)
13152      PARAMETER(MAXLIN=3)
13153      PARAMETER (MAXROW=NUMALP)
13154      PARAMETER (MAXRO2=25)
13155      CHARACTER*60 ITITLE
13156      CHARACTER*60 ITITLZ
13157      CHARACTER*60 ITITL9
13158      CHARACTER*60 ITEXT(MAXRO2)
13159      CHARACTER*4  ALIGN(NUMCLI)
13160      CHARACTER*4  VALIGN(NUMCLI)
13161      REAL         AVALUE(MAXRO2)
13162      INTEGER      NCTEXT(MAXRO2)
13163      INTEGER      IDIGIT(MAXRO2)
13164      INTEGER      NTOT(MAXRO2)
13165      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
13166      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
13167      CHARACTER*4  ITYPCO(NUMCLI)
13168      INTEGER      NCTIT2(MAXLIN,NUMCLI)
13169      INTEGER      NCVALU(MAXROW,NUMCLI)
13170      INTEGER      IWHTML(NUMCLI)
13171      INTEGER      IWRTF(NUMCLI)
13172      REAL         AMAT(MAXROW,NUMCLI)
13173      LOGICAL IFRST
13174      LOGICAL ILAST
13175      LOGICAL IFLAGS
13176      LOGICAL IFLAGE
13177C
13178C
13179C-----COMMON----------------------------------------------------------
13180C
13181      INCLUDE 'DPCOP2.INC'
13182C
13183C-----START POINT-----------------------------------------------------
13184C
13185      ISUBN1='DPTR'
13186      ISUBN2='E2  '
13187      IERROR='NO'
13188C
13189      MAXSYS=10000
13190C
13191      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRE2')THEN
13192        WRITE(ICOUT,999)
13193  999   FORMAT(1X)
13194        CALL DPWRST('XXX','BUG ')
13195        WRITE(ICOUT,51)
13196   51   FORMAT('**** AT THE BEGINNING OF DPTRE2--')
13197        CALL DPWRST('XXX','BUG ')
13198        WRITE(ICOUT,52)N,IBUGA3,ISUBRO
13199   52   FORMAT('N,IBUGA3,ISUBRO = ',I8,2X,A4,2X,A4)
13200        CALL DPWRST('XXX','BUG ')
13201        DO56I=1,MIN(N,100)
13202          WRITE(ICOUT,57)I,Y(I),X1(I),XCEN(I)
13203   57     FORMAT('I,Y(I),X1(I),XCEN(I) = ',I8,3G15.7)
13204          CALL DPWRST('XXX','BUG ')
13205   56   CONTINUE
13206      ENDIF
13207C
13208C               ********************************************
13209C               **  STEP 1--                              **
13210C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
13211C               ********************************************
13212C
13213      ISTEPN='1'
13214      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE2')
13215     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13216C
13217      IF(N.LT.4)THEN
13218        WRITE(ICOUT,999)
13219        CALL DPWRST('XXX','BUG ')
13220        WRITE(ICOUT,111)
13221  111   FORMAT('***** ERROR IN RELIABILITY TREND TEST--')
13222        CALL DPWRST('XXX','BUG ')
13223        WRITE(ICOUT,112)
13224  112   FORMAT('      THE NUMBER OF OBSERVATIONS IN THE RESPONSE ',
13225     1        'VARIABLE IS LESS THAN 4.')
13226        CALL DPWRST('XXX','BUG ')
13227        WRITE(ICOUT,115)N
13228  115   FORMAT('SAMPLE SIZE = ',I8)
13229        CALL DPWRST('XXX','BUG ')
13230        IERROR='YES'
13231        GOTO9000
13232      ENDIF
13233C
13234      HOLD=Y(1)
13235      DO135I=2,N
13236      IF(Y(I).NE.HOLD)GOTO139
13237  135 CONTINUE
13238      WRITE(ICOUT,999)
13239      CALL DPWRST('XXX','BUG ')
13240      WRITE(ICOUT,111)
13241      CALL DPWRST('XXX','BUG ')
13242      WRITE(ICOUT,131)HOLD
13243  131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
13244      CALL DPWRST('XXX','BUG ')
13245      IERROR='YES'
13246      GOTO9000
13247  139 CONTINUE
13248C
13249C               ********************************************
13250C               **  STEP 11--                             **
13251C               **  GENERATE THE RELIABILITY TREND TESTS  **
13252C               ********************************************
13253C
13254      ISTEPN='11'
13255      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE2')
13256     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13257C
13258C     CASE 1: NO GROUP OR CENSORING VARIABLE
13259C
13260      IF(NGROUP.EQ.0 .AND. NCENS.EQ.0)THEN
13261        ISET=1
13262        CALL DPTRE3(Y,N,XTEMP1,TEND,MAXNXT,
13263     1              RATPVA,MHTPVA,DSUM1,DVAL2,DVAL3,
13264     1              ISET,ICAPSW,ICAPTY,IFORSW,
13265     1              ISUBRO,IBUGA3,IERROR)
13266        NUMSET=1
13267C
13268C       CASE 2: GROUP VARIABLE, BUT NO CENSORING VARIABLE
13269C
13270      ELSEIF(NCENS.EQ.0)THEN
13271C
13272C       STEP 1: DETERMINE UNIQUE GROUPS
13273C
13274        NUMSET=0
13275        DO1051I=1,N
13276          IF(NUMSET.EQ.0)GOTO1053
13277          DO1052J=1,NUMSET
13278            IF(X1(I).EQ.XIDTEM(J))GOTO1051
13279 1052     CONTINUE
13280 1053     CONTINUE
13281          NUMSET=NUMSET+1
13282          XIDTEM(NUMSET)=X1(I)
13283 1051   CONTINUE
13284        CALL SORT(XIDTEM,NUMSET,XIDTEM)
13285C
13286C       STEP 2: GENERATE TRACES FOR EACH GROUP
13287C
13288        J=0
13289        DO1090ISET=1,NUMSET
13290C
13291          K=0
13292          DO1091I=1,N
13293            IF(X1(I).EQ.XIDTEM(ISET))THEN
13294              K=K+1
13295              TEMP2(K)=Y(I)
13296            ENDIF
132971091      CONTINUE
13298          NI=K
13299          CALL DPTRE3(TEMP2,NI,XTEMP1,TEND,MAXNXT,
13300     1                RATPVA,MHTPVA,DSUM1,DVAL2,DVAL3,
13301     1                ISET,ICAPSW,ICAPTY,IFORSW,
13302     1                ISUBRO,IBUGA3,IERROR)
13303          TEMP6(ISET)=RATPVA
13304          TEMP6(MAXSYS+ISET)=MHTPVA
13305          TEMP6(2*MAXSYS+ISET)=REAL(DSUM1)
13306          TEMP6(3*MAXSYS+ISET)=REAL(DVAL2)
13307          TEMP6(4*MAXSYS+ISET)=REAL(DVAL3)
133081090    CONTINUE
13309C
13310C       CASE 3: BOTH GROUP VARIABLE AND CENSORING VARIABLE
13311C
13312      ELSE
13313C
13314C       STEP 1: DETERMINE UNIQUE GROUPS
13315C
13316        NUMSET=0
13317        DO1111I=1,N
13318          IF(NUMSET.EQ.0)GOTO1113
13319          DO1112J=1,NUMSET
13320            IF(X1(I).EQ.XIDTEM(J))GOTO1111
13321 1112     CONTINUE
13322 1113     CONTINUE
13323          NUMSET=NUMSET+1
13324          XIDTEM(NUMSET)=X1(I)
13325 1111   CONTINUE
13326        CALL SORT(XIDTEM,NUMSET,XIDTEM)
13327C
13328C       STEP 2A: EXTRACT RESPONSE AND CENSORING DATA FOR EACH
13329C                GROUP
13330C
13331        J=0
13332        ISETMX=NUMSET
13333        DO1120ISET=1,NUMSET
13334C
13335          K=0
13336          DO1121I=1,N
13337            IF(X1(I).EQ.XIDTEM(ISET))THEN
13338              K=K+1
13339              TEMP2(K)=Y(I)
13340              TEMP3(K)=XCEN(I)
13341            ENDIF
133421121      CONTINUE
13343          NI=K
13344C
13345C       STEP 2B: PROCESS THE CENSORING VARIABLE.  THERE CAN
13346C                BE AT MOST ONE CENSORING POINT FOR EACH
13347C                GROUP.
13348C
13349          CALL SORTC(TEMP2,TEMP3,NI,TEMP4,TEMP5)
13350          DO1160I=1,NI
13351            TEMP2(I)=TEMP4(I)
13352            TEMP3(I)=TEMP5(I)
13353 1160     CONTINUE
13354          AREP=TEMP3(1)
13355          ACEN=TEMP2(NI)
13356          IF(NI.LE.1)THEN
13357            NTEMPR=1
13358            NTEMPC=0
13359          ELSE
13360            IF(AREP.EQ.ACEN)THEN
13361              NTEMPR=NI
13362              NTEMPC=0
13363              DO1170I=1,NI
13364                IF(TEMP3(I).NE.AREP)THEN
13365                  WRITE(ICOUT,999)
13366                  CALL DPWRST('XXX','BUG ')
13367                  WRITE(ICOUT,111)
13368                  CALL DPWRST('XXX','BUG ')
13369                  WRITE(ICOUT,1171)
13370                  CALL DPWRST('XXX','BUG ')
13371                  WRITE(ICOUT,1172)
13372                  CALL DPWRST('XXX','BUG ')
13373                  WRITE(ICOUT,1173)
13374                  CALL DPWRST('XXX','BUG ')
13375                  WRITE(ICOUT,1174)XIDTEM(ISET)
13376                  CALL DPWRST('XXX','BUG ')
13377                  IERROR='YES'
13378                  GOTO1120
13379                ENDIF
13380 1170         CONTINUE
13381            ELSE
13382              TEND=TEMP2(NI)
13383              NTEMPR=NI-1
13384              NTEMPC=1
13385              DO1180I=1,NTEMPR
13386                IF(TEMP3(I).NE.AREP)THEN
13387                  WRITE(ICOUT,999)
13388                  CALL DPWRST('XXX','BUG ')
13389                  WRITE(ICOUT,111)
13390                  CALL DPWRST('XXX','BUG ')
13391                  WRITE(ICOUT,1171)
13392                  CALL DPWRST('XXX','BUG ')
13393                  WRITE(ICOUT,1172)
13394                  CALL DPWRST('XXX','BUG ')
13395                  WRITE(ICOUT,1173)
13396                  CALL DPWRST('XXX','BUG ')
13397                  WRITE(ICOUT,1174)XIDTEM(ISET)
13398                  CALL DPWRST('XXX','BUG ')
13399                  IERROR='YES'
13400                  GOTO1120
13401                ENDIF
13402 1180         CONTINUE
13403            ENDIF
13404          ENDIF
13405 1171 FORMAT('      FOR EACH SYSTEM, THERE SHOULD BE AT MOST')
13406 1172 FORMAT('      ONE CENSORING TIME AND IT MUST BE THE MAXIMUM')
13407 1173 FORMAT('      VALUE FOR THAT SYSTEM.')
13408 1174 FORMAT('      SUCH WAS NOT THE CASE FOR SYSTEM ',G15.7)
13409C
13410C       STEP 2C: COMPUTE THE TREND TEST FOR A SINGLE SYSTEM
13411C
13412          TEND=ACEN
13413          CALL DPTRE3(TEMP2,NTEMPR,XTEMP1,TEND,MAXNXT,
13414     1                RATPVA,MHTPVA,DSUM1,DVAL2,DVAL3,
13415     1                ISET,ICAPSW,ICAPTY,IFORSW,
13416     1                ISUBRO,IBUGA3,IERROR)
13417          TEMP6(ISET)=RATPVA
13418          TEMP6(MAXSYS+ISET)=MHTPVA
13419          TEMP6(2*MAXSYS+ISET)=REAL(DSUM1)
13420          TEMP6(3*MAXSYS+ISET)=REAL(DVAL2)
13421          TEMP6(4*MAXSYS+ISET)=REAL(DVAL3)
13422C
134231120    CONTINUE
13424      ENDIF
13425C
13426C               ********************************************
13427C               **  STEP 21--                             **
13428C               **  PERFORM COMPOSITE TESTS               **
13429C               ********************************************
13430C
13431      ISTEPN='21'
13432      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE2')
13433     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13434C
13435      IF(NUMSET.LE.1)GOTO9000
13436C
13437C     COMPOSITE TESTS
13438C
13439C     PRINT SUMMARY STATISTICS TABLE
13440C
13441      IF(IPRINT.EQ.'OFF')GOTO9000
13442C
13443      NUMDIG=7
13444      IF(IFORSW.EQ.'1')NUMDIG=1
13445      IF(IFORSW.EQ.'2')NUMDIG=2
13446      IF(IFORSW.EQ.'3')NUMDIG=3
13447      IF(IFORSW.EQ.'4')NUMDIG=4
13448      IF(IFORSW.EQ.'5')NUMDIG=5
13449      IF(IFORSW.EQ.'6')NUMDIG=6
13450      IF(IFORSW.EQ.'7')NUMDIG=7
13451      IF(IFORSW.EQ.'8')NUMDIG=8
13452      IF(IFORSW.EQ.'9')NUMDIG=9
13453      IF(IFORSW.EQ.'0')NUMDIG=0
13454      IF(IFORSW.EQ.'E')NUMDIG=-2
13455      IF(IFORSW.EQ.'-2')NUMDIG=-2
13456      IF(IFORSW.EQ.'-3')NUMDIG=-3
13457      IF(IFORSW.EQ.'-4')NUMDIG=-4
13458      IF(IFORSW.EQ.'-5')NUMDIG=-5
13459      IF(IFORSW.EQ.'-6')NUMDIG=-6
13460      IF(IFORSW.EQ.'-7')NUMDIG=-7
13461      IF(IFORSW.EQ.'-8')NUMDIG=-8
13462      IF(IFORSW.EQ.'-9')NUMDIG=-9
13463C
13464      IDF=2
13465      ISUM=0
13466      SUM1=0.0
13467      SUM2=0.0
13468      DO2010I=1,NUMSET
13469        PVAL=TEMP6(I)
13470        ATERM1=-2.0*LOG(PVAL)
13471        SUM1=SUM1 + PVAL
13472        SUM2=SUM2 + ATERM1
13473        ISUM=ISUM+IDF
13474 2010 CONTINUE
13475C
13476      ALP90=0.90
13477      CALL CHSPPF(ALP90,ISUM,CV1)
13478      ALP95=0.95
13479      CALL CHSPPF(ALP95,ISUM,CV2)
13480      ALP99=0.99
13481      CALL CHSPPF(ALP99,ISUM,CV3)
13482C
13483      ITITLE='Reverse Arrangements Test: Fisher Composite Test'
13484      NCTITL=48
13485      ITITLZ=' '
13486      NCTITZ=0
13487C
13488      ICNT=0
13489      ICNT=ICNT+1
13490      ITEXT(ICNT)='Summary Statistics:'
13491      NCTEXT(ICNT)=19
13492      AVALUE(ICNT)=0.0
13493      IDIGIT(ICNT)=-1
13494      ICNT=ICNT+1
13495      ITEXT(ICNT)='Number of Systems:'
13496      NCTEXT(ICNT)=18
13497      AVALUE(ICNT)=REAL(NUMSET)
13498      IDIGIT(ICNT)=0
13499      ICNT=ICNT+1
13500      ITEXT(ICNT)='Sum of -2*LN(p-value):'
13501      NCTEXT(ICNT)=22
13502      AVALUE(ICNT)=SUM2
13503      IDIGIT(ICNT)=NUMDIG
13504      ICNT=ICNT+1
13505      ITEXT(ICNT)='Total Degrees of Freedom:'
13506      NCTEXT(ICNT)=25
13507      AVALUE(ICNT)=REAL(ISUM)
13508      IDIGIT(ICNT)=0
13509      ICNT=ICNT+1
13510      ITEXT(ICNT)=' '
13511      NCTEXT(ICNT)=0
13512      AVALUE(ICNT)=0.0
13513      IDIGIT(ICNT)=-1
13514C
13515      ICNT=ICNT+1
13516      ITEXT(ICNT)='H0: No Trend for Interarrival Times'
13517      NCTEXT(ICNT)=35
13518      AVALUE(ICNT)=0.0
13519      IDIGIT(ICNT)=-1
13520      ICNT=ICNT+1
13521      ITEXT(ICNT)='Ha: There is a Trend for Interarrival Times'
13522      NCTEXT(ICNT)=43
13523      AVALUE(ICNT)=0.0
13524      IDIGIT(ICNT)=-1
13525C
13526      NUMROW=ICNT
13527      DO2020I=1,NUMROW
13528        NTOT(I)=15
13529 2020 CONTINUE
13530C
13531      IFRST=.TRUE.
13532      ILAST=.TRUE.
13533      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
13534     1            AVALUE,IDIGIT,
13535     1            NTOT,NUMROW,
13536     1            ICAPSW,ICAPTY,ILAST,IFRST,
13537     1            ISUBRO,IBUGA3,IERROR)
13538C
13539      ITITLE(1:25)=' '
13540      NCTITL=0
13541      ITITL9=' '
13542      NCTIT9=0
13543C
13544      DO2030J=1,5
13545        DO2040I=1,3
13546          ITITL2(I,J)=' '
13547          NCTIT2(I,J)=0
13548 2040   CONTINUE
13549 2030 CONTINUE
13550C
13551      ITITL2(2,1)='Null'
13552      NCTIT2(2,1)=4
13553      ITITL2(3,1)='Hypothesis'
13554      NCTIT2(3,1)=10
13555C
13556      ITITL2(2,2)='Significance'
13557      NCTIT2(2,2)=12
13558      ITITL2(3,2)='Level'
13559      NCTIT2(3,2)=5
13560C
13561      ITITL2(2,3)='Chi-Square'
13562      NCTIT2(2,3)=10
13563      ITITL2(3,3)='Test Statistic'
13564      NCTIT2(3,3)=14
13565C
13566      ITITL2(2,4)='Critical'
13567      NCTIT2(2,4)=8
13568      ITITL2(3,4)='Region (>=)'
13569      NCTIT2(3,4)=11
13570C
13571      ITITL2(1,5)='Null'
13572      NCTIT2(1,5)=4
13573      ITITL2(2,5)='Hypothesis'
13574      NCTIT2(2,5)=10
13575      ITITL2(3,5)='Conclusion'
13576      NCTIT2(3,5)=10
13577C
13578      NMAX=0
13579      NUMCOL=5
13580      DO2050I=1,NUMCOL
13581        VALIGN(I)='b'
13582        ALIGN(I)='r'
13583        NTOT(I)=15
13584        IF(I.EQ.1)NTOT(I)=10
13585        NMAX=NMAX+NTOT(I)
13586        ITYPCO(I)='NUME'
13587        IDIGIT(I)=NUMDIG
13588        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
13589          ITYPCO(I)='ALPH'
13590        ENDIF
13591        IWHTML(1)=150
13592        IWHTML(2)=125
13593        IWHTML(3)=150
13594        IWHTML(4)=150
13595        IWHTML(5)=150
13596        IINC=1600
13597        IINC2=1400
13598        IINC3=2200
13599        IWRTF(1)=IINC
13600        IWRTF(2)=IWRTF(1)+IINC
13601        IWRTF(3)=IWRTF(2)+IINC2
13602        IWRTF(4)=IWRTF(3)+IINC
13603        IWRTF(5)=IWRTF(4)+IINC
13604C
13605        DO2060J=1,3
13606          IVALUE(J,1)='No Trend'
13607          NCVALU(J,1)=8
13608          IF(J.EQ.1)THEN
13609            IVALUE(J,2)='0.90'
13610            NCVALU(J,2)=4
13611            AMAT(J,3)=SUM2
13612            AMAT(J,4)=CV1
13613            IF(SUM2.GT.CV1)THEN
13614              IVALUE(J,5)(1:6)='REJECT'
13615            ELSE
13616              IVALUE(J,5)(1:6)='ACCEPT'
13617            ENDIF
13618            NCVALU(J,5)=6
13619          ELSEIF(J.EQ.2)THEN
13620            IVALUE(J,2)='0.95'
13621            NCVALU(J,2)=4
13622            AMAT(J,3)=SUM2
13623            AMAT(J,4)=CV2
13624            IF(SUM2.GT.CV2)THEN
13625              IVALUE(J,5)(1:6)='REJECT'
13626            ELSE
13627              IVALUE(J,5)(1:6)='ACCEPT'
13628            ENDIF
13629            NCVALU(J,5)=6
13630          ELSEIF(J.EQ.3)THEN
13631            IVALUE(J,2)='0.99'
13632            NCVALU(J,2)=4
13633            AMAT(J,3)=SUM2
13634            AMAT(J,4)=CV3
13635            IF(SUM2.GT.CV3)THEN
13636              IVALUE(J,5)(1:6)='REJECT'
13637            ELSE
13638              IVALUE(J,5)(1:6)='ACCEPT'
13639            ENDIF
13640            NCVALU(J,5)=6
13641          ENDIF
13642 2060   CONTINUE
13643C
13644 2050 CONTINUE
13645C
13646      ICNT=3
13647      NUMLIN=3
13648      NUMCOL=5
13649      IFRST=.TRUE.
13650      ILAST=.TRUE.
13651      IFLAGS=.TRUE.
13652      IFLAGE=.TRUE.
13653      CALL DPDTA5(ITITLE,NCTITL,
13654     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
13655     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
13656     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
13657     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
13658     1            ICAPSW,ICAPTY,IFRST,ILAST,
13659     1            IFLAGS,IFLAGE,
13660     1            ISUBRO,IBUGA3,IERROR)
13661C
13662C     COMPOSITE TEST FOR MILITARY HANDBOOK TEST
13663C
13664        IDF=2
13665        ISUM=0
13666        SUM1=0.0
13667        SUM2=0.0
13668        DO3010I=1,NUMSET
13669          PVAL=TEMP6(MAXSYS+I)
13670          ATERM1=-2.0*LOG(PVAL)
13671          SUM1=SUM1 + PVAL
13672          SUM2=SUM2 + ATERM1
13673          ISUM=ISUM+IDF
13674 3010   CONTINUE
13675C
13676      ALP90=0.90
13677      CALL CHSPPF(ALP90,ISUM,CV1)
13678      ALP95=0.95
13679      CALL CHSPPF(ALP95,ISUM,CV2)
13680      ALP99=0.99
13681      CALL CHSPPF(ALP99,ISUM,CV3)
13682C
13683      ITITLE='Military Handbook Test: Fisher Composite Test'
13684      NCTITL=45
13685      ITITLZ=' '
13686      NCTITZ=0
13687C
13688      ICNT=0
13689      ICNT=ICNT+1
13690      ITEXT(ICNT)='Summary Statistics:'
13691      NCTEXT(ICNT)=19
13692      AVALUE(ICNT)=0.0
13693      IDIGIT(ICNT)=-1
13694      ICNT=ICNT+1
13695      ITEXT(ICNT)='Number of Systems:'
13696      NCTEXT(ICNT)=18
13697      AVALUE(ICNT)=REAL(NUMSET)
13698      IDIGIT(ICNT)=0
13699      ICNT=ICNT+1
13700      ITEXT(ICNT)='Sum of -2*LN(p-value):'
13701      NCTEXT(ICNT)=22
13702      AVALUE(ICNT)=SUM2
13703      IDIGIT(ICNT)=NUMDIG
13704      ICNT=ICNT+1
13705      ITEXT(ICNT)='Total Degrees of Freedom:'
13706      NCTEXT(ICNT)=25
13707      AVALUE(ICNT)=REAL(ISUM)
13708      IDIGIT(ICNT)=0
13709      ICNT=ICNT+1
13710      ITEXT(ICNT)=' '
13711      NCTEXT(ICNT)=0
13712      AVALUE(ICNT)=0.0
13713      IDIGIT(ICNT)=-1
13714C
13715      ICNT=ICNT+1
13716      ITEXT(ICNT)='H0: No Trend for Interarrival Times'
13717      NCTEXT(ICNT)=35
13718      AVALUE(ICNT)=0.0
13719      IDIGIT(ICNT)=-1
13720      ICNT=ICNT+1
13721      ITEXT(ICNT)='Ha: There is a Trend for Interarrival Times'
13722      NCTEXT(ICNT)=43
13723      AVALUE(ICNT)=0.0
13724      IDIGIT(ICNT)=-1
13725      ICNT=ICNT+1
13726      ITEXT(ICNT)='Ha: There is a Trend Following a NHPP'
13727      NCTEXT(ICNT)=37
13728      AVALUE(ICNT)=0.0
13729      IDIGIT(ICNT)=-1
13730      ICNT=ICNT+1
13731      ITEXT(ICNT)='    Power Law Model'
13732      NCTEXT(ICNT)=19
13733      AVALUE(ICNT)=0.0
13734      IDIGIT(ICNT)=-1
13735C
13736      NUMROW=ICNT
13737      DO3020I=1,NUMROW
13738        NTOT(I)=15
13739 3020 CONTINUE
13740C
13741      IFRST=.TRUE.
13742      ILAST=.TRUE.
13743      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
13744     1            NCTEXT,AVALUE,IDIGIT,
13745     1            NTOT,NUMROW,
13746     1            ICAPSW,ICAPTY,ILAST,IFRST,
13747     1            ISUBRO,IBUGA3,IERROR)
13748C
13749      ITITLE(1:25)=' '
13750      NCTITL=0
13751      ITITL9=' '
13752      NCTIT9=0
13753C
13754      NMAX=0
13755      NUMCOL=5
13756      DO3050I=1,NUMCOL
13757        VALIGN(I)='b'
13758        ALIGN(I)='r'
13759        NTOT(I)=15
13760        IF(I.EQ.1)NTOT(I)=10
13761        NMAX=NMAX+NTOT(I)
13762        ITYPCO(I)='NUME'
13763        IDIGIT(I)=NUMDIG
13764        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
13765          ITYPCO(I)='ALPH'
13766        ENDIF
13767C
13768        DO3060J=1,3
13769          IF(J.EQ.1)THEN
13770            AMAT(J,3)=SUM2
13771            AMAT(J,4)=CV1
13772            IF(SUM2.GT.CV1)THEN
13773              IVALUE(J,5)(1:6)='REJECT'
13774            ELSE
13775              IVALUE(J,5)(1:6)='ACCEPT'
13776            ENDIF
13777            NCVALU(J,5)=6
13778          ELSEIF(J.EQ.2)THEN
13779            AMAT(J,3)=SUM2
13780            AMAT(J,4)=CV2
13781            IF(SUM2.GT.CV2)THEN
13782              IVALUE(J,5)(1:6)='REJECT'
13783            ELSE
13784              IVALUE(J,5)(1:6)='ACCEPT'
13785            ENDIF
13786            NCVALU(J,5)=6
13787          ELSEIF(J.EQ.3)THEN
13788            AMAT(J,3)=SUM2
13789            AMAT(J,4)=CV3
13790            IF(SUM2.GT.CV3)THEN
13791              IVALUE(J,5)(1:6)='REJECT'
13792            ELSE
13793              IVALUE(J,5)(1:6)='ACCEPT'
13794            ENDIF
13795            NCVALU(J,5)=6
13796          ENDIF
13797 3060   CONTINUE
13798C
13799 3050 CONTINUE
13800C
13801      ICNT=3
13802      IFRST=.TRUE.
13803      ILAST=.TRUE.
13804      IFLAGS=.TRUE.
13805      IFLAGE=.TRUE.
13806      CALL DPDTA5(ITITLE,NCTITL,
13807     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
13808     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
13809     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
13810     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
13811     1            ICAPSW,ICAPTY,IFRST,ILAST,
13812     1            IFLAGS,IFLAGE,
13813     1            ISUBRO,IBUGA3,IERROR)
13814C
13815C     LAPLACE COMPOSITE TEST
13816C
13817      DSUM1=0.0D0
13818      DSUM2=0.0D0
13819      DSUM3=0.0D0
13820      DO4010I=1,NUMSET
13821        VAL1=TEMP6(2*MAXSYS+I)
13822        VAL2=TEMP6(3*MAXSYS+I)
13823        VAL3=TEMP6(4*MAXSYS+I)
13824        DSUM1=DSUM1 + DBLE(VAL1)
13825        DSUM2=DSUM2 + DBLE(VAL2)
13826        DSUM3=DSUM3 + DBLE(VAL3)
13827 4010 CONTINUE
13828      DSUM2=-0.5D0*DSUM2
13829      Z=REAL((DSUM1 + DSUM2)/DSQRT(DSUM3/12.0D0))
13830      CALL NORCDF(Z,CDF)
13831      ALP01=0.01
13832      CALL NORPPF(ALP01,CV1)
13833      ALP05=0.05
13834      CALL NORPPF(ALP05,CV2)
13835      ALP10=0.10
13836      CALL NORPPF(ALP10,CV3)
13837      ALP90=0.90
13838      CALL NORPPF(ALP90,CV4)
13839      ALP95=0.95
13840      CALL NORPPF(ALP95,CV5)
13841      ALP99=0.99
13842      CALL NORPPF(ALP99,CV6)
13843C
13844      ITITLE='Laplace Test: Composite Test'
13845      NCTITL=28
13846      ITITLZ=' '
13847      NCTITZ=0
13848C
13849      ICNT=0
13850      ICNT=ICNT+1
13851      ITEXT(ICNT)='Summary Statistics:'
13852      NCTEXT(ICNT)=19
13853      AVALUE(ICNT)=0.0
13854      IDIGIT(ICNT)=-1
13855      ICNT=ICNT+1
13856      ITEXT(ICNT)='Normal Test Statistic Value:'
13857      NCTEXT(ICNT)=28
13858      AVALUE(ICNT)=Z
13859      IDIGIT(ICNT)=NUMDIG
13860      ICNT=ICNT+1
13861      ITEXT(ICNT)='Normal Test Statistic CDF Value:'
13862      NCTEXT(ICNT)=32
13863      AVALUE(ICNT)=CDF
13864      IDIGIT(ICNT)=NUMDIG
13865      ICNT=ICNT+1
13866      ITEXT(ICNT)=' '
13867      NCTEXT(ICNT)=0
13868      AVALUE(ICNT)=0.0
13869      IDIGIT(ICNT)=-1
13870C
13871      ICNT=ICNT+1
13872      ITEXT(ICNT)='H0: No Trend for Interarrival Times'
13873      NCTEXT(ICNT)=35
13874      AVALUE(ICNT)=0.0
13875      IDIGIT(ICNT)=-1
13876      ICNT=ICNT+1
13877      ITEXT(ICNT)='Ha: There is a Trend Following a NHPP'
13878      NCTEXT(ICNT)=37
13879      AVALUE(ICNT)=0.0
13880      IDIGIT(ICNT)=-1
13881      ICNT=ICNT+1
13882      ITEXT(ICNT)='    Exponential Law Model'
13883      NCTEXT(ICNT)=25
13884      AVALUE(ICNT)=0.0
13885      IDIGIT(ICNT)=-1
13886C
13887      NUMROW=ICNT
13888      DO2310I=1,NUMROW
13889        NTOT(I)=15
13890 2310 CONTINUE
13891C
13892      IFRST=.TRUE.
13893      ILAST=.TRUE.
13894      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
13895     1            NCTEXT,AVALUE,IDIGIT,
13896     1            NTOT,NUMROW,
13897     1            ICAPSW,ICAPTY,ILAST,IFRST,
13898     1            ISUBRO,IBUGA3,IERROR)
13899C
13900      ITITLE(1:25)=' '
13901      NCTITL=0
13902      ITITL9=' '
13903      NCTIT9=0
13904C
13905      ITITL2(2,3)='Normal'
13906      NCTIT2(2,3)=6
13907      ITITL2(3,3)='Test Statistic'
13908      NCTIT2(3,3)=14
13909C
13910      ITITL2(2,4)='Critical'
13911      NCTIT2(2,4)=8
13912      ITITL2(3,4)='Region (>=)'
13913      NCTIT2(3,4)=11
13914C
13915      NMAX=0
13916      DO4050I=1,NUMCOL
13917        VALIGN(I)='b'
13918        ALIGN(I)='r'
13919        NTOT(I)=15
13920        IF(I.EQ.1)NTOT(I)=10
13921        NMAX=NMAX+NTOT(I)
13922        ITYPCO(I)='NUME'
13923        IDIGIT(I)=NUMDIG
13924        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
13925          ITYPCO(I)='ALPH'
13926        ENDIF
13927C
13928        DO4060J=1,3
13929          IF(J.EQ.1)THEN
13930            IVALUE(J,2)='0.01'
13931            NCVALU(J,2)=4
13932            AMAT(J,3)=Z
13933            AMAT(J,4)=CV1
13934            IF(Z.LE.CV1)THEN
13935              IVALUE(J,5)(1:6)='REJECT'
13936            ELSE
13937              IVALUE(J,5)(1:6)='ACCEPT'
13938            ENDIF
13939            NCVALU(J,5)=6
13940          ELSEIF(J.EQ.2)THEN
13941            IVALUE(J,2)='0.05'
13942            NCVALU(J,2)=4
13943            AMAT(J,3)=Z
13944            AMAT(J,4)=CV2
13945            IF(Z.LE.CV2)THEN
13946              IVALUE(J,5)(1:6)='REJECT'
13947            ELSE
13948              IVALUE(J,5)(1:6)='ACCEPT'
13949            ENDIF
13950            NCVALU(J,5)=6
13951          ELSEIF(J.EQ.3)THEN
13952            IVALUE(J,2)='0.10'
13953            NCVALU(J,2)=4
13954            AMAT(J,3)=Z
13955            AMAT(J,4)=CV3
13956            IF(Z.LE.CV3)THEN
13957              IVALUE(J,5)(1:6)='REJECT'
13958            ELSE
13959              IVALUE(J,5)(1:6)='ACCEPT'
13960            ENDIF
13961            NCVALU(J,5)=6
13962          ENDIF
13963 4060   CONTINUE
13964C
13965 4050 CONTINUE
13966C
13967      ICNT=3
13968      CALL DPDTA5(ITITLE,NCTITL,
13969     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
13970     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
13971     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
13972     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
13973     1            ICAPSW,ICAPTY,IFRST,ILAST,
13974     1            IFLAGS,IFLAGE,
13975     1            ISUBRO,IBUGA3,IERROR)
13976C
13977      ITITLE(1:25)=' '
13978      NCTITL=0
13979      ITITL9=' '
13980      NCTIT9=0
13981C
13982      ITITL2(2,4)='Critical'
13983      NCTIT2(2,4)=8
13984      ITITL2(3,4)='Region (<=)'
13985      NCTIT2(3,4)=11
13986C
13987      DO4150I=1,NUMCOL
13988        NTOT(I)=15
13989        IF(I.EQ.1)NTOT(I)=10
13990C
13991        DO4160J=1,3
13992          IF(J.EQ.1)THEN
13993            IVALUE(J,2)='0.90'
13994            NCVALU(J,2)=4
13995            AMAT(J,3)=Z
13996            AMAT(J,4)=CV4
13997            IF(Z.GE.CV4)THEN
13998              IVALUE(J,5)(1:6)='REJECT'
13999            ELSE
14000              IVALUE(J,5)(1:6)='ACCEPT'
14001            ENDIF
14002            NCVALU(J,5)=6
14003          ELSEIF(J.EQ.2)THEN
14004            IVALUE(J,2)='0.95'
14005            NCVALU(J,2)=4
14006            AMAT(J,3)=Z
14007            AMAT(J,4)=CV5
14008            IF(Z.GE.CV5)THEN
14009              IVALUE(J,5)(1:6)='REJECT'
14010            ELSE
14011              IVALUE(J,5)(1:6)='ACCEPT'
14012            ENDIF
14013            NCVALU(J,5)=6
14014          ELSEIF(J.EQ.3)THEN
14015            IVALUE(J,2)='0.99'
14016            NCVALU(J,2)=4
14017            AMAT(J,3)=Z
14018            AMAT(J,4)=CV6
14019            IF(Z.GE.CV6)THEN
14020              IVALUE(J,5)(1:6)='REJECT'
14021            ELSE
14022              IVALUE(J,5)(1:6)='ACCEPT'
14023            ENDIF
14024            NCVALU(J,5)=6
14025          ENDIF
14026 4160   CONTINUE
14027C
14028 4150 CONTINUE
14029C
14030      ICNT=3
14031      CALL DPDTA5(ITITLE,NCTITL,
14032     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
14033     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
14034     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
14035     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
14036     1            ICAPSW,ICAPTY,IFRST,ILAST,
14037     1            IFLAGS,IFLAGE,
14038     1            ISUBRO,IBUGA3,IERROR)
14039C
14040C               *****************
14041C               **  STEP 90--  **
14042C               **  EXIT       **
14043C               *****************
14044C
14045 9000 CONTINUE
14046      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRE2')THEN
14047        WRITE(ICOUT,999)
14048        CALL DPWRST('XXX','BUG ')
14049        WRITE(ICOUT,9011)
14050 9011   FORMAT('***** AT THE END       OF DPTRE2--')
14051        CALL DPWRST('XXX','BUG ')
14052        WRITE(ICOUT,9012)N,IBUGA3,IERROR
14053 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
14054        CALL DPWRST('XXX','BUG ')
14055        DO9016I=1,N
14056          WRITE(ICOUT,9017)I,Y(I)
14057 9017     FORMAT('I,Y(I),W(I) = ',I8,E15.7)
14058          CALL DPWRST('XXX','BUG ')
14059 9016   CONTINUE
14060      ENDIF
14061C
14062      RETURN
14063      END
14064      SUBROUTINE DPTRE3(Y,N,XTEMP1,TEND,MAXNXT,
14065     1                  RATPVA,MHTPVA,DSUM1,DVAL2,DVAL3,
14066     1                  ISET,ICAPSW,ICAPTY,IFORSW,
14067     1                  ISUBRO,IBUGA3,IERROR)
14068C
14069C     PURPOSE--THIS ROUTINE CARRIES OUT A TRENDS ANALYSIS
14070C              FOR THE DATA IN THE INPUT VECTOR Y.
14071C     NOTE--DPTRE2 CAN LOOP THROUGH MULTIPLE SYSTEMS.
14072C           THIS ROUTINE IS USED TO COMPUTE THE TESTS FOR
14073C           A SINGLE SYSTEM.
14074C     NOTE--3 TRENDS TESTS ARE PERFORMED:
14075C           1) REVERSE ARRANGEMENT TEST
14076C           2) MILITARY HANDBOOK TEST
14077C           3) LAPLACE TEST
14078C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
14079C                                OF FAILURE TIMES
14080C                       N      = THE INTEGER NUMBER OF
14081C                                OBSERVATIONS IN THE VECTOR Y.
14082C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
14083C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
14084C     LANGUAGE--ANSI 77 FORTRAN.
14085C     WRITTEN BY--ALAN HECKERT
14086C                 STATISTICAL ENGINEERING DIVISION
14087C                 INFORMATION TECHNOLOGY LABORATORY
14088C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14089C                 GAITHERSBURG, MD 20899-8980
14090C                 PHONE--301-975-2899
14091C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14092C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14093C     LANGUAGE--ANSI FORTRAN (1977)
14094C     VERSION NUMBER--2006/10
14095C     ORIGINAL VERSION--OCTOBER   2006. EXTRACTED FROM DPTRE3
14096C     UPDATED         --FEBRUARY  2011. USE DPDTA1 AND DPDTA5 TO
14097C                                       PRINT TABLES
14098C
14099C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
14100C
14101      CHARACTER*4 ICAPSW
14102      CHARACTER*4 ICAPTY
14103      CHARACTER*4 IFORSW
14104C
14105      CHARACTER*4 ISUBRO
14106      CHARACTER*4 IBUGA3
14107      CHARACTER*4 IERROR
14108C
14109      CHARACTER*4 IWRITE
14110      CHARACTER*4 ISUBN1
14111      CHARACTER*4 ISUBN2
14112      CHARACTER*4 ISTEPN
14113C
14114C---------------------------------------------------------------------
14115C
14116      DOUBLE PRECISION DSUM
14117      DOUBLE PRECISION DSUM1
14118      DOUBLE PRECISION DVAL2
14119      DOUBLE PRECISION DVAL3
14120C
14121      REAL MHTPVA
14122C
14123      DIMENSION Y(*)
14124      DIMENSION XTEMP1(*)
14125C
14126      PARAMETER (NUMALP=3)
14127      PARAMETER(NUMCLI=5)
14128      PARAMETER(MAXLIN=3)
14129      PARAMETER (MAXROW=NUMALP)
14130      PARAMETER (MAXRO2=25)
14131      CHARACTER*60 ITITLE
14132      CHARACTER*60 ITITLZ
14133      CHARACTER*60 ITITL9
14134      CHARACTER*60 ITEXT(MAXRO2)
14135      CHARACTER*4  ALIGN(NUMCLI)
14136      CHARACTER*4  VALIGN(NUMCLI)
14137      REAL         AVALUE(MAXRO2)
14138      INTEGER      NCTEXT(MAXRO2)
14139      INTEGER      IDIGIT(MAXRO2)
14140      INTEGER      NTOT(MAXRO2)
14141      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
14142      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
14143      CHARACTER*4  ITYPCO(NUMCLI)
14144      INTEGER      NCTIT2(MAXLIN,NUMCLI)
14145      INTEGER      NCVALU(MAXROW,NUMCLI)
14146      INTEGER      IWHTML(NUMCLI)
14147      INTEGER      IWRTF(NUMCLI)
14148      REAL         AMAT(MAXROW,NUMCLI)
14149      LOGICAL IFRST
14150      LOGICAL ILAST
14151      LOGICAL IFLAGS
14152      LOGICAL IFLAGE
14153C
14154C-----COMMON----------------------------------------------------------
14155C
14156      INCLUDE 'DPCOP2.INC'
14157C
14158C-----START POINT-----------------------------------------------------
14159C
14160      ISUBN1='DPTR'
14161      ISUBN2='E3  '
14162      IERROR='NO'
14163C
14164      IRMN01=0
14165      IRMN05=0
14166      IRMN10=0
14167      IRMN90=0
14168      IRMN95=0
14169      IRMN99=0
14170C
14171      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRE3')THEN
14172        WRITE(ICOUT,999)
14173  999   FORMAT(1X)
14174        CALL DPWRST('XXX','BUG ')
14175        WRITE(ICOUT,51)
14176   51   FORMAT('**** AT THE BEGINNING OF DPTRE3--')
14177        CALL DPWRST('XXX','BUG ')
14178        WRITE(ICOUT,52)N,MAXNXT,IBUGA3
14179   52   FORMAT('N,MAXNXT,IBUGA3 = ',2I8,2X,A4)
14180        CALL DPWRST('XXX','BUG ')
14181        DO56I=1,N
14182          WRITE(ICOUT,57)I,Y(I)
14183   57     FORMAT('I,Y(I) = ',I8,G15.7)
14184          CALL DPWRST('XXX','BUG ')
14185   56   CONTINUE
14186      ENDIF
14187C
14188C               ********************************************
14189C               **  STEP 1--                              **
14190C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
14191C               ********************************************
14192C
14193      ISTEPN='1'
14194      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
14195     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14196C
14197      IF(N.LT.4)THEN
14198        WRITE(ICOUT,999)
14199        CALL DPWRST('XXX','BUG ')
14200        WRITE(ICOUT,111)ISET
14201  111   FORMAT('***** ERROR IN RELIABILITY TREND TEST--SYSTEM ',I8)
14202        CALL DPWRST('XXX','BUG ')
14203        WRITE(ICOUT,113)
14204  113   FORMAT('      THE NUMBER OF OBSERVATONS IS LESS THAN 4.')
14205        CALL DPWRST('XXX','BUG ')
14206        WRITE(ICOUT,112)N
14207  112   FORMAT('SAMPLE SIZE = ',I8)
14208        CALL DPWRST('XXX','BUG ')
14209        IERROR='YES'
14210        GOTO9000
14211      ENDIF
14212C
14213      HOLD=Y(1)
14214      DO135I=2,N
14215        IF(Y(I).NE.HOLD)GOTO139
14216  135 CONTINUE
14217      WRITE(ICOUT,999)
14218      CALL DPWRST('XXX','BUG ')
14219      WRITE(ICOUT,111)ISET
14220      CALL DPWRST('XXX','BUG ')
14221      WRITE(ICOUT,131)HOLD
14222  131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
14223      CALL DPWRST('XXX','BUG ')
14224      GOTO9000
14225  139 CONTINUE
14226C
14227C               ********************************************
14228C               **  STEP 11--                             **
14229C               **  REVERSE ARRANGEMENTS TEST             **
14230C               ********************************************
14231C
14232C               ********************************************
14233C               **  STEP 11A-                             **
14234C               **  CREATE INTERARRIVAL TIME ARRAY        **
14235C               ********************************************
14236C
14237      ISTEPN='11'
14238      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
14239     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14240C
14241      IWRITE='NO'
14242      CALL INTARR(Y,N,IWRITE,XTEMP1,NX,IBUGA3,IERROR)
14243C
14244C               ********************************************
14245C               **  STEP 11B-                             **
14246C               **  CALCULATE NUMBER OF REVERSALS         **
14247C               ********************************************
14248      IREV=0
14249      DO140J=1,N-1
14250        DO149K=J+1,N
14251          IF(XTEMP1(K).GT.XTEMP1(J))IREV=IREV+1
14252  149   CONTINUE
14253  140 CONTINUE
14254      IRMAX=N*(N-1)/2
14255      AN=REAL(N)
14256      REXP=AN*(AN-1.0)/4.0
14257      RVAR=(2.0*AN + 5.0)*(AN - 1.0)*AN/72.0
14258      RSD=SQRT(RVAR)
14259C
14260      R=REAL(IREV)
14261      ANUM=R + 0.5 - REXP
14262      Z=ANUM/RSD
14263      CALL NORCDF(Z,CDF)
14264      RATPVA=CDF
14265C
14266C               *************************
14267C               **  STEP 11C-          **
14268C               **  FORM Z STATISTICS  **
14269C               *************************
14270C
14271      ISTEPN='11C'
14272      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
14273     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14274C
14275      ALP01=0.01
14276      CALL NORPPF(ALP01,PPF01)
14277      ALP05=0.05
14278      CALL NORPPF(ALP05,PPF05)
14279      ALP10=0.10
14280      CALL NORPPF(ALP10,PPF10)
14281      ALP90=0.90
14282      CALL NORPPF(ALP90,PPF90)
14283      ALP95=0.95
14284      CALL NORPPF(ALP95,PPF95)
14285      ALP99=0.99
14286      CALL NORPPF(ALP99,PPF99)
14287      IF(N.EQ.4)THEN
14288        IRMN01=-1
14289        IRMN05=0
14290        IRMN10=0
14291        IRMN90=6
14292        IRMN95=6
14293        IRMN99=-1
14294      ELSEIF(N.EQ.5)THEN
14295        IRMN01=0
14296        IRMN05=1
14297        IRMN10=1
14298        IRMN90=9
14299        IRMN95=9
14300        IRMN99=10
14301      ELSEIF(N.EQ.6)THEN
14302        IRMN01=1
14303        IRMN05=2
14304        IRMN10=3
14305        IRMN90=12
14306        IRMN95=13
14307        IRMN99=14
14308      ELSEIF(N.EQ.7)THEN
14309        IRMN01=2
14310        IRMN05=4
14311        IRMN10=5
14312        IRMN90=16
14313        IRMN95=17
14314        IRMN99=19
14315      ELSEIF(N.EQ.8)THEN
14316        IRMN01=4
14317        IRMN05=6
14318        IRMN10=8
14319        IRMN90=20
14320        IRMN95=22
14321        IRMN99=24
14322      ELSEIF(N.EQ.9)THEN
14323        IRMN01=6
14324        IRMN05=9
14325        IRMN10=11
14326        IRMN90=25
14327        IRMN95=27
14328        IRMN99=30
14329      ELSEIF(N.EQ.10)THEN
14330        IRMN01=9
14331        IRMN05=12
14332        IRMN10=14
14333        IRMN90=31
14334        IRMN95=33
14335        IRMN99=36
14336      ELSEIF(N.EQ.11)THEN
14337        IRMN01=12
14338        IRMN05=16
14339        IRMN10=18
14340        IRMN90=37
14341        IRMN95=39
14342        IRMN99=43
14343      ELSEIF(N.EQ.12)THEN
14344        IRMN01=16
14345        IRMN05=20
14346        IRMN10=23
14347        IRMN90=43
14348        IRMN95=46
14349        IRMN99=50
14350      ELSEIF(N.GT.12)THEN
14351        IRMN01=INT(PPF01*RSD + REXP - 0.5)
14352        IRMN05=INT(PPF05*RSD + REXP - 0.5)
14353        IRMN10=INT(PPF10*RSD + REXP - 0.5)
14354        IRMN90=INT(PPF90*RSD + REXP - 0.5)
14355        IRMN95=INT(PPF95*RSD + REXP - 0.5)
14356        IRMN99=INT(PPF99*RSD + REXP - 0.5)
14357      ENDIF
14358C
14359C               ****************************
14360C               **  STEP 11D-             **
14361C               **  WRITE EVERYTHING OUT  **
14362C               ****************************
14363C
14364      ISTEPN='11D'
14365      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
14366     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14367C
14368C     PRINT SUMMARY STATISTICS TABLE
14369C
14370      IF(IPRINT.EQ.'OFF')GOTO9000
14371C
14372      NUMDIG=7
14373      IF(IFORSW.EQ.'1')NUMDIG=1
14374      IF(IFORSW.EQ.'2')NUMDIG=2
14375      IF(IFORSW.EQ.'3')NUMDIG=3
14376      IF(IFORSW.EQ.'4')NUMDIG=4
14377      IF(IFORSW.EQ.'5')NUMDIG=5
14378      IF(IFORSW.EQ.'6')NUMDIG=6
14379      IF(IFORSW.EQ.'7')NUMDIG=7
14380      IF(IFORSW.EQ.'8')NUMDIG=8
14381      IF(IFORSW.EQ.'9')NUMDIG=9
14382      IF(IFORSW.EQ.'0')NUMDIG=0
14383      IF(IFORSW.EQ.'E')NUMDIG=-2
14384      IF(IFORSW.EQ.'-2')NUMDIG=-2
14385      IF(IFORSW.EQ.'-3')NUMDIG=-3
14386      IF(IFORSW.EQ.'-4')NUMDIG=-4
14387      IF(IFORSW.EQ.'-5')NUMDIG=-5
14388      IF(IFORSW.EQ.'-6')NUMDIG=-6
14389      IF(IFORSW.EQ.'-7')NUMDIG=-7
14390      IF(IFORSW.EQ.'-8')NUMDIG=-8
14391      IF(IFORSW.EQ.'-9')NUMDIG=-9
14392C
14393      ITITLE='Reverse Arrangements Test: (System      )'
14394      NCTITL=41
14395      WRITE(ITITLE(36:40),'(I5)')ISET
14396      ITITLZ=' '
14397      NCTITZ=0
14398C
14399      ICNT=0
14400      ICNT=ICNT+1
14401      ITEXT(ICNT)='Summary Statistics:'
14402      NCTEXT(ICNT)=19
14403      AVALUE(ICNT)=0.0
14404      IDIGIT(ICNT)=-1
14405      ICNT=ICNT+1
14406      ITEXT(ICNT)='Number of Failure Times:'
14407      NCTEXT(ICNT)=24
14408      AVALUE(ICNT)=REAL(N)
14409      IDIGIT(ICNT)=0
14410      ICNT=ICNT+1
14411      ITEXT(ICNT)='Observed Number of Reversals:'
14412      NCTEXT(ICNT)=29
14413      AVALUE(ICNT)=REAL(IREV)
14414      IDIGIT(ICNT)=0
14415      ICNT=ICNT+1
14416      ITEXT(ICNT)='Maximum Possible Number of Reversals:'
14417      NCTEXT(ICNT)=37
14418      AVALUE(ICNT)=REAL(IRMAX)
14419      IDIGIT(ICNT)=0
14420      ICNT=ICNT+1
14421      ITEXT(ICNT)='Expected Number of Reversals:'
14422      NCTEXT(ICNT)=29
14423      AVALUE(ICNT)=REXP
14424      IDIGIT(ICNT)=NUMDIG
14425      ICNT=ICNT+1
14426      ITEXT(ICNT)='Variance(Expected Number of Reversals):'
14427      NCTEXT(ICNT)=39
14428      AVALUE(ICNT)=RVAR
14429      IDIGIT(ICNT)=NUMDIG
14430      ICNT=ICNT+1
14431      ITEXT(ICNT)='Value of Test Statistic (Z-Score):'
14432      NCTEXT(ICNT)=34
14433      AVALUE(ICNT)=Z
14434      IDIGIT(ICNT)=NUMDIG
14435      ICNT=ICNT+1
14436      ITEXT(ICNT)='Z-Score CDF Value:'
14437      NCTEXT(ICNT)=18
14438      AVALUE(ICNT)=CDF
14439      IDIGIT(ICNT)=NUMDIG
14440      ICNT=ICNT+1
14441      ITEXT(ICNT)=' '
14442      NCTEXT(ICNT)=0
14443      AVALUE(ICNT)=0.0
14444      IDIGIT(ICNT)=-1
14445C
14446      ICNT=ICNT+1
14447      ITEXT(ICNT)='Improvement Test'
14448      NCTEXT(ICNT)=16
14449      AVALUE(ICNT)=0.0
14450      IDIGIT(ICNT)=-1
14451      ICNT=ICNT+1
14452      ITEXT(ICNT)='H0: No Trend for Interarrival Times'
14453      NCTEXT(ICNT)=35
14454      AVALUE(ICNT)=0.0
14455      IDIGIT(ICNT)=-1
14456      ICNT=ICNT+1
14457      ITEXT(ICNT)='Ha: Increasing Trend for Interarrival Times'
14458      NCTEXT(ICNT)=43
14459      AVALUE(ICNT)=0.0
14460      IDIGIT(ICNT)=-1
14461C
14462      NUMROW=ICNT
14463      DO2310I=1,NUMROW
14464        NTOT(I)=15
14465 2310 CONTINUE
14466C
14467      IFRST=.TRUE.
14468      ILAST=.TRUE.
14469      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
14470     1            NCTEXT,AVALUE,IDIGIT,
14471     1            NTOT,NUMROW,
14472     1            ICAPSW,ICAPTY,ILAST,IFRST,
14473     1            ISUBRO,IBUGA3,IERROR)
14474C
14475      ITITLE(1:25)=' '
14476      NCTITL=0
14477      ITITL9=' '
14478      NCTIT9=0
14479C
14480      DO2320J=1,5
14481        DO2325I=1,3
14482          ITITL2(I,J)=' '
14483          NCTIT2(I,J)=0
14484 2325   CONTINUE
14485 2320 CONTINUE
14486C
14487      ITITL2(2,1)='Null'
14488      NCTIT2(2,1)=4
14489      ITITL2(3,1)='Hypothesis'
14490      NCTIT2(3,1)=10
14491C
14492      ITITL2(2,2)='Significance'
14493      NCTIT2(2,2)=12
14494      ITITL2(3,2)='Level'
14495      NCTIT2(3,2)=5
14496C
14497      ITITL2(2,3)='Number of'
14498      NCTIT2(2,3)=9
14499      ITITL2(3,3)='Reversals'
14500      NCTIT2(3,3)=9
14501C
14502      ITITL2(2,4)='Critical'
14503      NCTIT2(2,4)=8
14504      ITITL2(3,4)='Region (>=)'
14505      NCTIT2(3,4)=11
14506C
14507      ITITL2(1,5)='Null'
14508      NCTIT2(1,5)=4
14509      ITITL2(2,5)='Hypothesis'
14510      NCTIT2(2,5)=10
14511      ITITL2(3,5)='Conclusion'
14512      NCTIT2(3,5)=10
14513C
14514      NMAX=0
14515      NUMCOL=5
14516      DO5210I=1,NUMCOL
14517        VALIGN(I)='b'
14518        ALIGN(I)='r'
14519        NTOT(I)=15
14520        IF(I.EQ.1)NTOT(I)=10
14521        NMAX=NMAX+NTOT(I)
14522        ITYPCO(I)='NUME'
14523        IDIGIT(I)=NUMDIG
14524        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
14525          ITYPCO(I)='ALPH'
14526        ENDIF
14527        IF(I.EQ.3 .OR. I.EQ.4)THEN
14528          IDIGIT(I)=0
14529        ENDIF
14530        IWHTML(1)=150
14531        IWHTML(2)=125
14532        IWHTML(3)=150
14533        IWHTML(4)=150
14534        IWHTML(5)=150
14535        IINC=1600
14536        IINC2=1400
14537        IINC3=2200
14538        IWRTF(1)=IINC
14539        IWRTF(2)=IWRTF(1)+IINC
14540        IWRTF(3)=IWRTF(2)+IINC2
14541        IWRTF(4)=IWRTF(3)+IINC
14542        IWRTF(5)=IWRTF(4)+IINC
14543C
14544        DO5289J=1,3
14545          IVALUE(J,1)='No Trend'
14546          NCVALU(J,1)=8
14547          IF(J.EQ.1)THEN
14548            IVALUE(J,2)='0.90'
14549            NCVALU(J,2)=4
14550            AMAT(J,3)=REAL(IREV)
14551            AMAT(J,4)=REAL(IRMN90)
14552            IF(IREV.GE.IRMN90)THEN
14553              IVALUE(J,5)(1:6)='REJECT'
14554            ELSE
14555              IVALUE(J,5)(1:6)='ACCEPT'
14556            ENDIF
14557            NCVALU(J,5)=6
14558          ELSEIF(J.EQ.2)THEN
14559            IVALUE(J,2)='0.95'
14560            NCVALU(J,2)=4
14561            AMAT(J,3)=REAL(IREV)
14562            AMAT(J,4)=REAL(IRMN95)
14563            IF(IREV.GE.IRMN95)THEN
14564              IVALUE(J,5)(1:6)='REJECT'
14565            ELSE
14566              IVALUE(J,5)(1:6)='ACCEPT'
14567            ENDIF
14568            NCVALU(J,5)=6
14569          ELSEIF(J.EQ.3)THEN
14570            IVALUE(J,2)='0.99'
14571            NCVALU(J,2)=4
14572            AMAT(J,3)=REAL(IREV)
14573            AMAT(J,4)=REAL(IRMN99)
14574            IF(IREV.GE.IRMN99)THEN
14575              IVALUE(J,5)(1:6)='REJECT'
14576            ELSE
14577              IVALUE(J,5)(1:6)='ACCEPT'
14578            ENDIF
14579            NCVALU(J,5)=6
14580          ENDIF
14581 5289   CONTINUE
14582C
14583 5210 CONTINUE
14584C
14585      ICNT=3
14586      NUMLIN=3
14587      NUMCOL=5
14588      IFRST=.TRUE.
14589      ILAST=.TRUE.
14590      IFLAGS=.TRUE.
14591      IFLAGE=.TRUE.
14592      CALL DPDTA5(ITITLE,NCTITL,
14593     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
14594     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
14595     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
14596     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
14597     1            ICAPSW,ICAPTY,IFRST,ILAST,
14598     1            IFLAGS,IFLAGE,
14599     1            ISUBRO,IBUGA3,IERROR)
14600C
14601      ICNT=0
14602      ICNT=ICNT+1
14603      ITEXT(ICNT)=' '
14604      NCTEXT(ICNT)=0
14605      AVALUE(ICNT)=0.0
14606      IDIGIT(ICNT)=-1
14607      ICNT=ICNT+1
14608      ITEXT(ICNT)='Degradation Test'
14609      NCTEXT(ICNT)=16
14610      AVALUE(ICNT)=0.0
14611      IDIGIT(ICNT)=-1
14612      ICNT=ICNT+1
14613      ITEXT(ICNT)='H0: No Trend for Interarrival Times'
14614      NCTEXT(ICNT)=35
14615      AVALUE(ICNT)=0.0
14616      IDIGIT(ICNT)=-1
14617      ICNT=ICNT+1
14618      ITEXT(ICNT)='Ha: Declining Trend for Interarrival Times'
14619      NCTEXT(ICNT)=42
14620      AVALUE(ICNT)=0.0
14621      IDIGIT(ICNT)=-1
14622C
14623      NUMROW=ICNT
14624      DO6210I=1,NUMROW
14625        NTOT(I)=15
14626 6210 CONTINUE
14627C
14628      IFRST=.TRUE.
14629      ILAST=.TRUE.
14630      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
14631     1            NCTEXT,AVALUE,IDIGIT,
14632     1            NTOT,NUMROW,
14633     1            ICAPSW,ICAPTY,ILAST,IFRST,
14634     1            ISUBRO,IBUGA3,IERROR)
14635C
14636      ITITLE(1:25)=' '
14637      NCTITL=0
14638      ITITL9=' '
14639      NCTIT9=0
14640C
14641      ITITL2(2,4)='Critical'
14642      NCTIT2(2,4)=8
14643      ITITL2(3,4)='Region (<=)'
14644      NCTIT2(3,4)=11
14645C
14646      DO6310I=1,NUMCOL
14647C
14648        NTOT(I)=15
14649        IF(I.EQ.1)NTOT(I)=10
14650        ITYPCO(I)='NUME'
14651        IDIGIT(I)=NUMDIG
14652        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
14653          ITYPCO(I)='ALPH'
14654        ENDIF
14655        IF(I.EQ.3 .OR. I.EQ.4)THEN
14656          IDIGIT(I)=0
14657        ENDIF
14658C
14659        DO6389J=1,3
14660          IF(J.EQ.3)THEN
14661            IVALUE(J,2)='0.01'
14662            NCVALU(J,2)=4
14663            AMAT(J,4)=REAL(IRMN01)
14664            IF(IREV.LE.IRMN01)THEN
14665              IVALUE(J,5)(1:6)='REJECT'
14666            ELSE
14667              IVALUE(J,5)(1:6)='ACCEPT'
14668            ENDIF
14669            NCVALU(J,5)=6
14670          ELSEIF(J.EQ.2)THEN
14671            IVALUE(J,2)='0.05'
14672            NCVALU(J,2)=4
14673            AMAT(J,4)=REAL(IRMN05)
14674            IF(IREV.LE.IRMN05)THEN
14675              IVALUE(J,5)(1:6)='REJECT'
14676            ELSE
14677              IVALUE(J,5)(1:6)='ACCEPT'
14678            ENDIF
14679            NCVALU(J,5)=6
14680          ELSEIF(J.EQ.1)THEN
14681            IVALUE(J,2)='0.10'
14682            NCVALU(J,2)=4
14683            AMAT(J,4)=REAL(IRMN10)
14684            IF(IREV.LE.IRMN10)THEN
14685              IVALUE(J,5)(1:6)='REJECT'
14686            ELSE
14687              IVALUE(J,5)(1:6)='ACCEPT'
14688            ENDIF
14689            NCVALU(J,5)=6
14690          ENDIF
14691 6389   CONTINUE
14692C
14693 6310 CONTINUE
14694C
14695      ICNT=3
14696      CALL DPDTA5(ITITLE,NCTITL,
14697     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
14698     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
14699     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
14700     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
14701     1            ICAPSW,ICAPTY,IFRST,ILAST,
14702     1            IFLAGS,IFLAGE,
14703     1            ISUBRO,IBUGA3,IERROR)
14704C
14705C               ********************************************
14706C               **  STEP 21--                             **
14707C               **  MILITARY HANDBOOK    TEST             **
14708C               ********************************************
14709C
14710      ISTEPN='21'
14711      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
14712     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14713C
14714C               ********************************************
14715C               **  STEP 21B-                             **
14716C               **  CALCULATE TEST STATISTIC              **
14717C               ********************************************
14718C
14719      DSUM=0.0D0
14720      DO310I=1,N
14721        IF(Y(I).GE.TEND)THEN
14722          WRITE(ICOUT,311)
14723  311     FORMAT('***** ERROR FROM MILITARY HANDBOOK TEST--')
14724          CALL DPWRST('XXX','BUG ')
14725          WRITE(ICOUT,312)ISET
14726  312     FORMAT('      FOR SYSTEM ',I8)
14727          CALL DPWRST('XXX','BUG ')
14728          WRITE(ICOUT,313)TEND
14729  313     FORMAT('      THE SPECIFIED CENSORING TIME,',G15.7,',')
14730          CALL DPWRST('XXX','BUG ')
14731          WRITE(ICOUT,314)
14732  314     FORMAT('      IS LESS THAN AT LEAST ONE FAILURE TIME.')
14733          CALL DPWRST('XXX','BUG ')
14734          WRITE(ICOUT,316)I,Y(I)
14735  316     FORMAT('      FAILURE TIME ',I8,' = ',G15.7)
14736          CALL DPWRST('XXX','BUG ')
14737          IERROR='YES'
14738          GOTO9000
14739        ELSEIF(Y(I).LE.0.0)THEN
14740          WRITE(ICOUT,311)
14741          CALL DPWRST('XXX','BUG ')
14742          WRITE(ICOUT,317)I
14743  317     FORMAT('      FAILURE ',I8,' IS NON-POSITIVE. ')
14744          CALL DPWRST('XXX','BUG ')
14745          WRITE(ICOUT,318)Y(I)
14746  318     FORMAT('      IT HAS THE VALUE ',G15.7)
14747          CALL DPWRST('XXX','BUG ')
14748          IERROR='YES'
14749          GOTO9000
14750        ENDIF
14751        DSUM=DSUM + DLOG(DBLE(TEND/Y(I)))
14752  310 CONTINUE
14753      Z=REAL(2.0D0*DSUM)
14754      INU=2*N
14755      CALL CHSCDF(Z,INU,CDF)
14756      MHTPVA=CDF
14757C
14758      ALP01=0.01
14759      CALL CHSPPF(ALP01,INU,CV1)
14760      ALP05=0.05
14761      CALL CHSPPF(ALP05,INU,CV2)
14762      ALP10=0.10
14763      CALL CHSPPF(ALP10,INU,CV3)
14764      ALP90=0.90
14765      CALL CHSPPF(ALP90,INU,CV4)
14766      ALP95=0.95
14767      CALL CHSPPF(ALP95,INU,CV5)
14768      ALP99=0.99
14769      CALL CHSPPF(ALP99,INU,CV6)
14770C
14771C               ****************************
14772C               **  STEP 21B-             **
14773C               **  WRITE EVERYTHING OUT  **
14774C               ****************************
14775C
14776      ISTEPN='21B'
14777      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14778C
14779      ITITLE='Military Handbook Test: (System      )'
14780      NCTITL=38
14781      WRITE(ITITLE(33:37),'(I5)')ISET
14782      ITITLZ=' '
14783      NCTITZ=0
14784C
14785      ICNT=0
14786      ICNT=ICNT+1
14787      ITEXT(ICNT)='Summary Statistics:'
14788      NCTEXT(ICNT)=19
14789      AVALUE(ICNT)=0.0
14790      IDIGIT(ICNT)=-1
14791      ICNT=ICNT+1
14792      ITEXT(ICNT)='Number of Failure Times:'
14793      NCTEXT(ICNT)=24
14794      AVALUE(ICNT)=REAL(N)
14795      IDIGIT(ICNT)=0
14796      ICNT=ICNT+1
14797      ITEXT(ICNT)='Chi-Square Test Statistic Value:'
14798      NCTEXT(ICNT)=32
14799      AVALUE(ICNT)=Z
14800      IDIGIT(ICNT)=NUMDIG
14801      ICNT=ICNT+1
14802      ITEXT(ICNT)='Chi-Square Test Statistic CDF Value:'
14803      NCTEXT(ICNT)=36
14804      AVALUE(ICNT)=CDF
14805      IDIGIT(ICNT)=NUMDIG
14806      ICNT=ICNT+1
14807      ITEXT(ICNT)=' '
14808      NCTEXT(ICNT)=0
14809      AVALUE(ICNT)=0.0
14810      IDIGIT(ICNT)=-1
14811C
14812      ICNT=ICNT+1
14813      ITEXT(ICNT)='Improvement Test'
14814      NCTEXT(ICNT)=16
14815      AVALUE(ICNT)=0.0
14816      IDIGIT(ICNT)=-1
14817      ICNT=ICNT+1
14818      ITEXT(ICNT)='H0: No Trend for Interarrival Times:'
14819      NCTEXT(ICNT)=36
14820      AVALUE(ICNT)=0.0
14821      IDIGIT(ICNT)=-1
14822      ICNT=ICNT+1
14823      ITEXT(ICNT)='Ha: There is a Trend Following a NHPP'
14824      NCTEXT(ICNT)=37
14825      AVALUE(ICNT)=0.0
14826      IDIGIT(ICNT)=-1
14827      ICNT=ICNT+1
14828      ITEXT(ICNT)='    Power Law Model'
14829      NCTEXT(ICNT)=19
14830      AVALUE(ICNT)=0.0
14831      IDIGIT(ICNT)=-1
14832C
14833      NUMROW=ICNT
14834      DO7310I=1,NUMROW
14835        NTOT(I)=15
14836 7310 CONTINUE
14837C
14838      IFRST=.TRUE.
14839      ILAST=.TRUE.
14840      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
14841     1            NCTEXT,AVALUE,IDIGIT,
14842     1            NTOT,NUMROW,
14843     1            ICAPSW,ICAPTY,ILAST,IFRST,
14844     1            ISUBRO,IBUGA3,IERROR)
14845C
14846      ITITLE(1:25)=' '
14847      NCTITL=0
14848      ITITL9=' '
14849      NCTIT9=0
14850C
14851      ITITL2(2,3)='Chi-Square'
14852      NCTIT2(2,3)=10
14853      ITITL2(3,3)='Test Statistic'
14854      NCTIT2(3,3)=14
14855C
14856      ITITL2(2,4)='Critical'
14857      NCTIT2(2,4)=8
14858      ITITL2(3,4)='Region (>=)'
14859      NCTIT2(3,4)=11
14860C
14861      DO5310I=1,NUMCOL
14862C
14863        NTOT(I)=15
14864        IF(I.EQ.1)NTOT(I)=10
14865        ITYPCO(I)='NUME'
14866        IDIGIT(I)=NUMDIG
14867        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
14868          ITYPCO(I)='ALPH'
14869        ENDIF
14870        IF(I.EQ.3 .OR. I.EQ.4)THEN
14871          IDIGIT(I)=NUMDIG
14872        ENDIF
14873C
14874        DO5389J=1,3
14875          IF(J.EQ.1)THEN
14876            IVALUE(J,2)='0.90'
14877            NCVALU(J,2)=4
14878            AMAT(J,3)=Z
14879            AMAT(J,4)=CV4
14880            IF(0.000.LE.CDF.AND.CDF.LE.0.9)THEN
14881              IVALUE(J,5)(1:6)='ACCEPT'
14882            ELSE
14883              IVALUE(J,5)(1:6)='REJECT'
14884            ENDIF
14885            NCVALU(J,5)=6
14886          ELSEIF(J.EQ.2)THEN
14887            IVALUE(J,2)='0.95'
14888            NCVALU(J,2)=4
14889            AMAT(J,3)=Z
14890            AMAT(J,4)=CV5
14891            IF(0.000.LE.CDF.AND.CDF.LE.0.95)THEN
14892              IVALUE(J,5)(1:6)='ACCEPT'
14893            ELSE
14894              IVALUE(J,5)(1:6)='REJECT'
14895            ENDIF
14896            NCVALU(J,5)=6
14897          ELSEIF(J.EQ.3)THEN
14898            IVALUE(J,2)='0.99'
14899            NCVALU(J,2)=4
14900            AMAT(J,3)=Z
14901            AMAT(J,4)=CV6
14902            IF(0.000.LE.CDF.AND.CDF.LE.0.99)THEN
14903              IVALUE(J,5)(1:6)='ACCEPT'
14904            ELSE
14905              IVALUE(J,5)(1:6)='REJECT'
14906            ENDIF
14907            NCVALU(J,5)=6
14908          ENDIF
14909 5389   CONTINUE
14910C
14911 5310 CONTINUE
14912C
14913      ICNT=3
14914      CALL DPDTA5(ITITLE,NCTITL,
14915     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
14916     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
14917     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
14918     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
14919     1            ICAPSW,ICAPTY,IFRST,ILAST,
14920     1            IFLAGS,IFLAGE,
14921     1            ISUBRO,IBUGA3,IERROR)
14922C
14923      ICNT=0
14924      ICNT=ICNT+1
14925      ITEXT(ICNT)=' '
14926      NCTEXT(ICNT)=0
14927      AVALUE(ICNT)=0.0
14928      IDIGIT(ICNT)=-1
14929      ICNT=ICNT+1
14930      ITEXT(ICNT)='Degradation Test'
14931      NCTEXT(ICNT)=16
14932      AVALUE(ICNT)=0.0
14933      IDIGIT(ICNT)=-1
14934      ICNT=ICNT+1
14935      ITEXT(ICNT)='H0: No Trend for Interarrival Times'
14936      NCTEXT(ICNT)=35
14937      AVALUE(ICNT)=0.0
14938      IDIGIT(ICNT)=-1
14939      ICNT=ICNT+1
14940      ITEXT(ICNT)='Ha: There is a Trend Following a NHPP'
14941      NCTEXT(ICNT)=37
14942      AVALUE(ICNT)=0.0
14943      IDIGIT(ICNT)=-1
14944      ICNT=ICNT+1
14945      ITEXT(ICNT)='    Power Law Model'
14946      NCTEXT(ICNT)=19
14947      AVALUE(ICNT)=0.0
14948      IDIGIT(ICNT)=-1
14949C
14950      NUMROW=ICNT
14951      DO7390I=1,NUMROW
14952        NTOT(I)=15
14953 7390 CONTINUE
14954C
14955      IFRST=.TRUE.
14956      ILAST=.TRUE.
14957      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
14958     1            NCTEXT,AVALUE,IDIGIT,
14959     1            NTOT,NUMROW,
14960     1            ICAPSW,ICAPTY,ILAST,IFRST,
14961     1            ISUBRO,IBUGA3,IERROR)
14962C
14963      ITITLE(1:25)=' '
14964      NCTITL=0
14965      ITITL9=' '
14966      NCTIT9=0
14967C
14968      ITITL2(2,4)='Critical'
14969      NCTIT2(2,4)=8
14970      ITITL2(3,4)='Region (<=)'
14971      NCTIT2(3,4)=11
14972C
14973      DO7410I=1,NUMCOL
14974C
14975        NTOT(I)=15
14976        IF(I.EQ.1)NTOT(I)=10
14977        ITYPCO(I)='NUME'
14978        IDIGIT(I)=NUMDIG
14979        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
14980          ITYPCO(I)='ALPH'
14981        ENDIF
14982        IF(I.EQ.3 .OR. I.EQ.4)THEN
14983          IDIGIT(I)=NUMDIG
14984        ENDIF
14985C
14986        DO7489J=1,3
14987          IF(J.EQ.3)THEN
14988            IVALUE(J,2)='0.01'
14989            NCVALU(J,2)=4
14990            AMAT(J,4)=CV1
14991            IF(CDF.GE.0.01)THEN
14992              IVALUE(J,5)(1:6)='ACCEPT'
14993            ELSE
14994              IVALUE(J,5)(1:6)='REJECT'
14995            ENDIF
14996            NCVALU(J,5)=6
14997          ELSEIF(J.EQ.2)THEN
14998            IVALUE(J,2)='0.05'
14999            NCVALU(J,2)=4
15000            AMAT(J,4)=CV2
15001            IF(CDF.GE.0.05)THEN
15002              IVALUE(J,5)(1:6)='ACCEPT'
15003            ELSE
15004              IVALUE(J,5)(1:6)='REJECT'
15005            ENDIF
15006            NCVALU(J,5)=6
15007          ELSEIF(J.EQ.1)THEN
15008            IVALUE(J,2)='0.10'
15009            NCVALU(J,2)=4
15010            AMAT(J,4)=CV3
15011            IF(CDF.GE.0.10)THEN
15012              IVALUE(J,5)(1:6)='ACCEPT'
15013            ELSE
15014              IVALUE(J,5)(1:6)='REJECT'
15015            ENDIF
15016            NCVALU(J,5)=6
15017          ENDIF
15018 7489   CONTINUE
15019C
15020 7410 CONTINUE
15021C
15022      ICNT=3
15023      CALL DPDTA5(ITITLE,NCTITL,
15024     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
15025     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
15026     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
15027     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
15028     1            ICAPSW,ICAPTY,IFRST,ILAST,
15029     1            IFLAGS,IFLAGE,
15030     1            ISUBRO,IBUGA3,IERROR)
15031C
15032C               ********************************************
15033C               **  STEP 31--                             **
15034C               **  LAPLACE              TEST             **
15035C               ********************************************
15036C
15037      ISTEPN='31'
15038      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
15039     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15040C
15041C               ********************************************
15042C               **  STEP 31B-                             **
15043C               **  CALCULATE TEST STATISTIC              **
15044C               ********************************************
15045C
15046       DSUM=0.0D0
15047       DSUM1=0.0D0
15048       DO510I=1,N
15049         IF(Y(I).GE.TEND)THEN
15050           WRITE(ICOUT,511)TEND
15051  511      FORMAT('***** ERROR FROM LAPLACE TREND TEST--')
15052           CALL DPWRST('XXX','BUG ')
15053           WRITE(ICOUT,512)ISET
15054  512      FORMAT('      FOR SYSTEM ',I8)
15055           CALL DPWRST('XXX','BUG ')
15056           WRITE(ICOUT,513)TEND
15057  513      FORMAT('      THE SPECIFIED CENSORING TIME, ',G15.7)
15058           CALL DPWRST('XXX','BUG ')
15059           WRITE(ICOUT,514)
15060  514      FORMAT('      IS LESS THAN AT LEAST ONE FAILURE TIME.')
15061           CALL DPWRST('XXX','BUG ')
15062           WRITE(ICOUT,516)I,Y(I)
15063  516      FORMAT('      FAILURE TIME ',I8,' = ',G15.7)
15064           CALL DPWRST('XXX','BUG ')
15065           IERROR='YES'
15066           GOTO9000
15067         ENDIF
15068         IF(Y(I).LE.0.0)THEN
15069           WRITE(ICOUT,511)TEND
15070           CALL DPWRST('XXX','BUG ')
15071           WRITE(ICOUT,512)ISET
15072           CALL DPWRST('XXX','BUG ')
15073           WRITE(ICOUT,521)I
15074  521      FORMAT('      FAILURE ',I8,' IS NOT POSITIVE.')
15075           CALL DPWRST('XXX','BUG ')
15076           WRITE(ICOUT,523)Y(I)
15077  523      FORMAT('      IT HAS THE VALUE ',G15.7)
15078           CALL DPWRST('XXX','BUG ')
15079           IERROR='YES'
15080           GOTO9000
15081         ENDIF
15082         DSUM=DSUM + DBLE(Y(I)-TEND/2.0)
15083         DSUM1=DSUM1 + DBLE(Y(I))
15084  510 CONTINUE
15085      DVAL2=DBLE(N)*DBLE(TEND)
15086      DVAL3=DBLE(N)*DBLE(TEND)**2
15087C
15088      AN=REAL(N)
15089      Z=REAL(DBLE(SQRT(12.0*AN))*DSUM/DBLE(AN*TEND))
15090      CALL NORCDF(Z,CDF)
15091C
15092      ALP01=0.01
15093      CALL NORPPF(ALP01,CV1)
15094      ALP05=0.05
15095      CALL NORPPF(ALP05,CV2)
15096      ALP10=0.10
15097      CALL NORPPF(ALP10,CV3)
15098      ALP90=0.90
15099      CALL NORPPF(ALP90,CV4)
15100      ALP95=0.95
15101      CALL NORPPF(ALP95,CV5)
15102      ALP99=0.99
15103      CALL NORPPF(ALP99,CV6)
15104C
15105C               ****************************
15106C               **  STEP 31B-             **
15107C               **  WRITE EVERYTHING OUT  **
15108C               ****************************
15109C
15110      ISTEPN='31B'
15111      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
15112     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15113C
15114      ITITLE='Laplace Test: (System      )'
15115      NCTITL=28
15116      WRITE(ITITLE(23:27),'(I5)')ISET
15117      ITITLZ=' '
15118      NCTITZ=0
15119C
15120      ICNT=0
15121      ICNT=ICNT+1
15122      ITEXT(ICNT)='Summary Statistics:'
15123      NCTEXT(ICNT)=19
15124      AVALUE(ICNT)=0.0
15125      IDIGIT(ICNT)=-1
15126      ICNT=ICNT+1
15127      ITEXT(ICNT)='Number of Failure Times:'
15128      NCTEXT(ICNT)=24
15129      AVALUE(ICNT)=REAL(N)
15130      IDIGIT(ICNT)=0
15131      ICNT=ICNT+1
15132      ITEXT(ICNT)='Normal Test Statistic Value:'
15133      NCTEXT(ICNT)=28
15134      AVALUE(ICNT)=Z
15135      IDIGIT(ICNT)=NUMDIG
15136      ICNT=ICNT+1
15137      ITEXT(ICNT)='Normal Test Statistic CDF Value:'
15138      NCTEXT(ICNT)=32
15139      AVALUE(ICNT)=CDF
15140      IDIGIT(ICNT)=NUMDIG
15141      ICNT=ICNT+1
15142      ITEXT(ICNT)=' '
15143      NCTEXT(ICNT)=0
15144      AVALUE(ICNT)=0.0
15145      IDIGIT(ICNT)=-1
15146C
15147      ICNT=ICNT+1
15148      ITEXT(ICNT)='Improvement Test'
15149      NCTEXT(ICNT)=16
15150      AVALUE(ICNT)=0.0
15151      IDIGIT(ICNT)=-1
15152      ICNT=ICNT+1
15153      ITEXT(ICNT)='H0: No Trend for Interarrival Times:'
15154      NCTEXT(ICNT)=36
15155      AVALUE(ICNT)=0.0
15156      IDIGIT(ICNT)=-1
15157      ICNT=ICNT+1
15158      ITEXT(ICNT)='Ha: There is a Trend Following a NHPP'
15159      NCTEXT(ICNT)=37
15160      AVALUE(ICNT)=0.0
15161      IDIGIT(ICNT)=-1
15162      ICNT=ICNT+1
15163      ITEXT(ICNT)='    Exponential Law Model'
15164      NCTEXT(ICNT)=25
15165      AVALUE(ICNT)=0.0
15166      IDIGIT(ICNT)=-1
15167C
15168      NUMROW=ICNT
15169      DO8210I=1,NUMROW
15170        NTOT(I)=15
15171 8210 CONTINUE
15172C
15173      IFRST=.TRUE.
15174      ILAST=.TRUE.
15175      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
15176     1            NCTEXT,AVALUE,IDIGIT,
15177     1            NTOT,NUMROW,
15178     1            ICAPSW,ICAPTY,ILAST,IFRST,
15179     1            ISUBRO,IBUGA3,IERROR)
15180C
15181      ITITLE(1:25)=' '
15182      NCTITL=0
15183      ITITL9=' '
15184      NCTIT9=0
15185C
15186      ITITL2(2,3)='Normal'
15187      NCTIT2(2,3)=6
15188      ITITL2(3,3)='Test Statistic'
15189      NCTIT2(3,3)=14
15190C
15191      ITITL2(2,4)='Critical'
15192      NCTIT2(2,4)=8
15193      ITITL2(3,4)='Region (>=)'
15194      NCTIT2(3,4)=11
15195C
15196      DO8310I=1,NUMCOL
15197C
15198        NTOT(I)=15
15199        IF(I.EQ.1)NTOT(I)=10
15200        ITYPCO(I)='NUME'
15201        IDIGIT(I)=NUMDIG
15202        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
15203          ITYPCO(I)='ALPH'
15204        ENDIF
15205        IF(I.EQ.3 .OR. I.EQ.4)THEN
15206          IDIGIT(I)=NUMDIG
15207        ENDIF
15208C
15209        DO8389J=1,3
15210          IF(J.EQ.1)THEN
15211            IVALUE(J,2)='0.90'
15212            NCVALU(J,2)=4
15213            AMAT(J,3)=Z
15214            AMAT(J,4)=CV4
15215            IF(0.000.LE.CDF.AND.CDF.LE.0.9)THEN
15216              IVALUE(J,5)(1:6)='ACCEPT'
15217            ELSE
15218              IVALUE(J,5)(1:6)='REJECT'
15219            ENDIF
15220            NCVALU(J,5)=6
15221          ELSEIF(J.EQ.2)THEN
15222            IVALUE(J,2)='0.95'
15223            NCVALU(J,2)=4
15224            AMAT(J,3)=Z
15225            AMAT(J,4)=CV5
15226            IF(0.000.LE.CDF.AND.CDF.LE.0.95)THEN
15227              IVALUE(J,5)(1:6)='ACCEPT'
15228            ELSE
15229              IVALUE(J,5)(1:6)='REJECT'
15230            ENDIF
15231            NCVALU(J,5)=6
15232          ELSEIF(J.EQ.3)THEN
15233            IVALUE(J,2)='0.99'
15234            NCVALU(J,2)=4
15235            AMAT(J,3)=Z
15236            AMAT(J,4)=CV6
15237            IF(0.000.LE.CDF.AND.CDF.LE.0.99)THEN
15238              IVALUE(J,5)(1:6)='ACCEPT'
15239            ELSE
15240              IVALUE(J,5)(1:6)='REJECT'
15241            ENDIF
15242            NCVALU(J,5)=6
15243          ENDIF
15244 8389   CONTINUE
15245C
15246 8310 CONTINUE
15247C
15248      ICNT=3
15249      CALL DPDTA5(ITITLE,NCTITL,
15250     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
15251     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
15252     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
15253     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
15254     1            ICAPSW,ICAPTY,IFRST,ILAST,
15255     1            IFLAGS,IFLAGE,
15256     1            ISUBRO,IBUGA3,IERROR)
15257C
15258      ICNT=0
15259      ICNT=ICNT+1
15260      ITEXT(ICNT)=' '
15261      NCTEXT(ICNT)=0
15262      AVALUE(ICNT)=0.0
15263      IDIGIT(ICNT)=-1
15264      ICNT=ICNT+1
15265      ITEXT(ICNT)='Degradation Test'
15266      NCTEXT(ICNT)=16
15267      AVALUE(ICNT)=0.0
15268      IDIGIT(ICNT)=-1
15269      ICNT=ICNT+1
15270      ITEXT(ICNT)='H0: No Trend for Interarrival Times'
15271      NCTEXT(ICNT)=35
15272      AVALUE(ICNT)=0.0
15273      IDIGIT(ICNT)=-1
15274      ICNT=ICNT+1
15275      ITEXT(ICNT)='Ha: There is a Trend Following a NHPP'
15276      NCTEXT(ICNT)=37
15277      AVALUE(ICNT)=0.0
15278      IDIGIT(ICNT)=-1
15279      ICNT=ICNT+1
15280      ITEXT(ICNT)='    Exponential Law Model'
15281      NCTEXT(ICNT)=25
15282      AVALUE(ICNT)=0.0
15283      IDIGIT(ICNT)=-1
15284C
15285      NUMROW=ICNT
15286      DO8390I=1,NUMROW
15287        NTOT(I)=15
15288 8390 CONTINUE
15289C
15290      IFRST=.TRUE.
15291      ILAST=.TRUE.
15292      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
15293     1            NCTEXT,AVALUE,IDIGIT,
15294     1            NTOT,NUMROW,
15295     1            ICAPSW,ICAPTY,ILAST,IFRST,
15296     1            ISUBRO,IBUGA3,IERROR)
15297C
15298      ITITLE(1:25)=' '
15299      NCTITL=0
15300      ITITL9=' '
15301      NCTIT9=0
15302C
15303      ITITL2(2,4)='Critical'
15304      NCTIT2(2,4)=8
15305      ITITL2(3,4)='Region (<=)'
15306      NCTIT2(3,4)=11
15307C
15308      DO8410I=1,NUMCOL
15309C
15310        NTOT(I)=15
15311        IF(I.EQ.1)NTOT(I)=10
15312        ITYPCO(I)='NUME'
15313        IDIGIT(I)=NUMDIG
15314        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
15315          ITYPCO(I)='ALPH'
15316        ENDIF
15317        IF(I.EQ.3 .OR. I.EQ.4)THEN
15318          IDIGIT(I)=NUMDIG
15319        ENDIF
15320C
15321        DO8489J=1,3
15322          IF(J.EQ.3)THEN
15323            IVALUE(J,2)='0.01'
15324            NCVALU(J,2)=4
15325            AMAT(J,4)=CV1
15326            IF(CDF.GE.0.01)THEN
15327              IVALUE(J,5)(1:6)='ACCEPT'
15328            ELSE
15329              IVALUE(J,5)(1:6)='REJECT'
15330            ENDIF
15331            NCVALU(J,5)=6
15332          ELSEIF(J.EQ.2)THEN
15333            IVALUE(J,2)='0.05'
15334            NCVALU(J,2)=4
15335            AMAT(J,4)=CV2
15336            IF(CDF.GE.0.05)THEN
15337              IVALUE(J,5)(1:6)='ACCEPT'
15338            ELSE
15339              IVALUE(J,5)(1:6)='REJECT'
15340            ENDIF
15341            NCVALU(J,5)=6
15342          ELSEIF(J.EQ.1)THEN
15343            IVALUE(J,2)='0.10'
15344            NCVALU(J,2)=4
15345            AMAT(J,4)=CV3
15346            IF(CDF.GE.0.10)THEN
15347              IVALUE(J,5)(1:6)='ACCEPT'
15348            ELSE
15349              IVALUE(J,5)(1:6)='REJECT'
15350            ENDIF
15351            NCVALU(J,5)=6
15352          ENDIF
15353 8489   CONTINUE
15354C
15355 8410 CONTINUE
15356C
15357      ICNT=3
15358      CALL DPDTA5(ITITLE,NCTITL,
15359     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
15360     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
15361     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
15362     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
15363     1            ICAPSW,ICAPTY,IFRST,ILAST,
15364     1            IFLAGS,IFLAGE,
15365     1            ISUBRO,IBUGA3,IERROR)
15366C
15367C               *****************
15368C               **  STEP 90--  **
15369C               **  EXIT       **
15370C               *****************
15371C
15372 9000 CONTINUE
15373      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRE3')THEN
15374        WRITE(ICOUT,999)
15375        CALL DPWRST('XXX','BUG ')
15376        WRITE(ICOUT,9011)
15377 9011   FORMAT('***** AT THE END       OF DPTRE3--')
15378        CALL DPWRST('XXX','BUG ')
15379        WRITE(ICOUT,9012)N,IBUGA3,IERROR
15380 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
15381        CALL DPWRST('XXX','BUG ')
15382        DO9016I=1,N
15383          WRITE(ICOUT,9017)I,Y(I),XTEMP1(I)
15384 9017     FORMAT('I,Y(I),XTEMP1(I) = ',I8,2G15.7)
15385          CALL DPWRST('XXX','BUG ')
15386 9016   CONTINUE
15387      ENDIF
15388C
15389      RETURN
15390      END
15391      SUBROUTINE DPTRI2(X1,Y1,X2,Y2,X3,Y3,
15392     1IFIG,
15393     1ILINPA,ILINCO,PLINTH,
15394     1AREGBA,
15395     1IREBLI,IREBCO,PREBTH,
15396     1IREFSW,IREFCO,
15397     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
15398     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
15399C
15400C     PURPOSE--DRAW A TRIANGLE
15401C              WITH FRONT FACE VERTICES AT (X1,Y1),
15402C              (X2,Y2), AND (X3,Y3).
15403C     WRITTEN BY--JAMES J. FILLIBEN
15404C                 STATISTICAL ENGINEERING DIVISION
15405C                 INFORMATION TECHNOLOGY LABORATORY
15406C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15407C                 GAITHERSBURG, MD 20899-8980
15408C                 PHONE--301-975-2855
15409C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15410C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15411C     LANGUAGE--ANSI FORTRAN (1977)
15412C     VERSION NUMBER--82/7
15413C     ORIGINAL VERSION--APRIL     1981.
15414C     UPDATED         --MAY       1982.
15415C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
15416C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
15417C
15418C-----NON-COMMON VARIABLES-------------------------------------
15419C
15420      CHARACTER*4 IFIG
15421      CHARACTER*4 IPATT2
15422C
15423      CHARACTER*4 ILINPA
15424      CHARACTER*4 ILINCO
15425C
15426      CHARACTER*4 IREBLI
15427      CHARACTER*4 IREBCO
15428      CHARACTER*4 IREFSW
15429      CHARACTER*4 IREFCO
15430      CHARACTER*4 IREPTY
15431      CHARACTER*4 IREPLI
15432      CHARACTER*4 IREPCO
15433C
15434      CHARACTER*4 IPATT
15435      CHARACTER*4 ICOLF
15436      CHARACTER*4 ICOLP
15437      CHARACTER*4 ICOL
15438      CHARACTER*4 IFLAG
15439C
15440      DIMENSION PX(10)
15441      DIMENSION PY(10)
15442CCCCC DIMENSION PX3(10)
15443CCCCC DIMENSION PY3(10)
15444C
15445      DIMENSION ILINPA(*)
15446      DIMENSION ILINCO(*)
15447      DIMENSION PLINTH(*)
15448C
15449      DIMENSION AREGBA(*)
15450      DIMENSION IREBLI(*)
15451      DIMENSION IREBCO(*)
15452      DIMENSION PREBTH(*)
15453      DIMENSION IREFSW(*)
15454      DIMENSION IREFCO(*)
15455      DIMENSION IREPTY(*)
15456      DIMENSION IREPLI(*)
15457      DIMENSION IREPCO(*)
15458      DIMENSION PREPTH(*)
15459      DIMENSION PREPSP(*)
15460C
15461C-----COMMON----------------------------------------------------------
15462C
15463      INCLUDE 'DPCOGR.INC'
15464      INCLUDE 'DPCOBE.INC'
15465      INCLUDE 'DPCOP2.INC'
15466C
15467C-----START POINT-----------------------------------------------------
15468C
15469      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRI2')GOTO90
15470      WRITE(ICOUT,999)
15471  999 FORMAT(1X)
15472      CALL DPWRST('XXX','BUG ')
15473      WRITE(ICOUT,51)
15474   51 FORMAT('***** AT THE BEGINNING OF DPTRI2--')
15475      CALL DPWRST('XXX','BUG ')
15476      WRITE(ICOUT,53)X1,Y1
15477   53 FORMAT('X1,Y1 = ',2E15.7)
15478      CALL DPWRST('XXX','BUG ')
15479      WRITE(ICOUT,54)X2,Y2
15480   54 FORMAT('X2,Y2 = ',2E15.7)
15481      CALL DPWRST('XXX','BUG ')
15482      WRITE(ICOUT,59)IFIG
15483   59 FORMAT('IFIG = ',A4)
15484      CALL DPWRST('XXX','BUG ')
15485      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
15486   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
15487      CALL DPWRST('XXX','BUG ')
15488      WRITE(ICOUT,62)AREGBA(1)
15489   62 FORMAT('AREGBA(1) = ',E15.7)
15490      CALL DPWRST('XXX','BUG ')
15491      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
15492   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
15493      CALL DPWRST('XXX','BUG ')
15494      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
15495   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
15496      CALL DPWRST('XXX','BUG ')
15497      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
15498   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
15499     1A4,2X,A4,2X,A4,2E15.7)
15500      CALL DPWRST('XXX','BUG ')
15501      WRITE(ICOUT,69)PTEXHE,PTEXWI
15502   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
15503      CALL DPWRST('XXX','BUG ')
15504      WRITE(ICOUT,70)PTEXVG,PTEXHG
15505   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
15506      CALL DPWRST('XXX','BUG ')
15507      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
15508   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
15509      CALL DPWRST('XXX','BUG ')
15510   90 CONTINUE
15511C
15512C               *********************************
15513C               **  STEP 1--                   **
15514C               **  DETERMINE THE COORDINATES  **
15515C               **  FOR THE TRIANGLE           **
15516C               *********************************
15517C
15518      PX(1)=X1
15519      PY(1)=Y1
15520C
15521      PX(2)=X2
15522      PY(2)=Y2
15523C
15524      PX(3)=X3
15525      PY(3)=Y3
15526C
15527      PX(4)=X1
15528      PY(4)=Y1
15529C
15530      NP=4
15531C
15532C
15533C               ***********************
15534C               **  STEP 2--         **
15535C               **  FILL THE FIGURE  **
15536C               **  (IF CALLED FOR)  **
15537C               ***********************
15538C
15539      IF(IREFSW(1).EQ.'OFF')GOTO2190
15540      IPATT=IREPTY(1)
15541      IPATT2='SOLI'
15542      PTHICK=PREPTH(1)
15543      PXGAP=PREPSP(1)
15544      PYGAP=PREPSP(1)
15545      ICOLF=IREFCO(1)
15546      ICOLP=IREPCO(1)
15547      CALL DPFIRE(PX,PY,NP,
15548     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
15549 2190 CONTINUE
15550C
15551C               ***************************
15552C               **  STEP 3--             **
15553C               **  DRAW OUT THE FIGURE  **
15554C               ***************************
15555C
15556      IPATT=ILINPA(1)
15557      PTHICK=PLINTH(1)
15558      ICOL=ILINCO(1)
15559      IFLAG='ON'
15560CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
15561CCCCC1IFIG,IPATT,PTHICK,ICOL)
15562      CALL DPDRPL(PX,PY,NP,
15563     1IFIG,IPATT,PTHICK,ICOL,
15564     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
15565C
15566C               *****************
15567C               **  STEP 90--  **
15568C               **  EXIT       **
15569C               *****************
15570C
15571      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRI2')GOTO9090
15572      WRITE(ICOUT,999)
15573      CALL DPWRST('XXX','BUG ')
15574      WRITE(ICOUT,9011)
15575 9011 FORMAT('***** AT THE END       OF DPTRI2--')
15576      CALL DPWRST('XXX','BUG ')
15577      WRITE(ICOUT,9013)NP
15578 9013 FORMAT('NP = ',I8)
15579      CALL DPWRST('XXX','BUG ')
15580      DO9015I=1,NP
15581      WRITE(ICOUT,9016)I,PX(I),PY(I)
15582 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
15583      CALL DPWRST('XXX','BUG ')
15584 9015 CONTINUE
15585      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
15586 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
15587      CALL DPWRST('XXX','BUG ')
15588 9090 CONTINUE
15589C
15590      RETURN
15591      END
15592      SUBROUTINE DPTRIA(IHARG,IARGT,ARG,NUMARG,
15593     1                  PXSTAR,PYSTAR,PXEND,PYEND,
15594     1                  ILINPA,ILINCO,PLINTH,
15595     1                  AREGBA,IREBLI,IREBCO,PREBTH,
15596     1                  IREFSW,IREFCO,
15597     1                  IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
15598     1                  PTEXHE,PTEXWI,PTEXVG,PTEXHG,
15599     1                  IGRASW,IDIASW,
15600     1                  PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
15601     1                  PDIAHE,PDIAWI,PDIAVG,PDIAHG,
15602     1                  NUMDEV,IDMANU,IDMODE,IDMOD2,IDMOD3,
15603     1                  IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
15604     1                  IDNVOF,IDNHOF,IDFONT,UNITSW,PDSCAL,
15605     1                  IBUGD2,IFOUND,IERROR)
15606C
15607C     PURPOSE--DRAW ONE OR MORE TRIANGLES
15608C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
15609C              THE COORDINATES ARE IN STANDARDIZED UNITS
15610C              OF 0 TO 100.
15611C     NOTE--THE INPUT COORDINATES DEFINE THE VERTICES
15612C           OF THE TRIANGLE.
15613C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 3
15614C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*3 = 6.
15615C     NOTE--IF 4 NUMBERS ARE PROVIDED,
15616C           THEN THE DRAWN TRIANGLE WILL GO
15617C           FROM THE LAST CURSOR POSITION
15618C           (ASSUMED TO BE AT VERTEX 1)
15619C           THROUGH THE (X,Y) POINT
15620C           (EITHER ABSOLUTE OR RELATIVE)
15621C           AS DEFINED BY THE FIRST AND SECOND NUMBERS
15622C           (ASSUMED TO BE AT VERTEX 2)
15623C           TO THE (X,Y) POINT
15624C           (EITHER ABSOLUTE OR RELATIVE)
15625C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
15626C           (ASSUMED TO BE AT VERTEX 3)
15627C           AND CONTINUING BACK THE START POINT TO CLOSE THE TRIANGLE.
15628C     NOTE--IF 6 NUMBERS ARE PROVIDED,
15629C           THEN THE DRAWN TRIANGLE WILL GO
15630C           FROM THE ABSOLUTE (X,Y) POSITION
15631C           AS RESULTING FORM THE FIRST AND SECOND NUMBERS
15632C           (ASSUMED TO BE AT VERTEX 1)
15633C           THROUGH THE (X,Y) POINT
15634C           (EITHER ABSOLUTE OR RELATIVE)
15635C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
15636C           (ASSUMED TO BE AT VERTEX 2)
15637C           TO THE (X,Y) POINT
15638C           (EITHER ABSOLUTE OR RELATIVE)
15639C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS
15640C           (ASSUMED TO BE AT VERTEX 3)
15641C           AND THEN CONTINUING BACK THE START POINT TO CLOSE THE TRIANGLE.
15642C     NOTE--AND SO FORTH FOR 10, 14, 18, ... NUMBERS.
15643C     INPUT  ARGUMENTS--IHARG
15644C                     --IARGT
15645C                     --ARG
15646C                     --NUMARG
15647C                     --PXSTAR
15648C                     --PYSTAR
15649C     OUTPUT ARGUMENTS--PXEND
15650C                     --PYEND
15651C                     --IFOUND ('YES' OR 'NO' )
15652C                     --IERROR ('YES' OR 'NO' )
15653C     WRITTEN BY--JAMES J. FILLIBEN
15654C                 STATISTICAL ENGINEERING DIVISION
15655C                 INFORMATION TECHNOLOGY LABORATORY
15656C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15657C                 GAITHERSBURG, MD 20899-8980
15658C                 PHONE--301-975-2855
15659C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15660C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15661C     LANGUAGE--ANSI FORTRAN (1977)
15662C     VERSION NUMBER--82/7
15663C     ORIGINAL VERSION--APRIL     1981.
15664C     UPDATED         --MARCH     1982.
15665C     UPDATED         --MAY       1982.
15666C     UPDATED         --NOVEMBER  1982.
15667C     UPDATED         --JANUARY   1989. CALL LIST FOR OFFSET VAR (ALAN)
15668C     UPDATED         --MARCH     1997. SUPPORT FOR DEVICE FONT (ALAN)
15669C     UPDATED         --JULY      1997. SUPPORT FOR "DATA" UNITS (ALAN)
15670C     UPDATED         --DECEMBER  2018. SUPPORT FOR "DEVICE ... SCALE"
15671C                                       COMMAND
15672C
15673C-----NON-COMMON VARIABLES-----------------------------------------
15674C
15675      CHARACTER*4 IHARG
15676      CHARACTER*4 IARGT
15677C
15678      CHARACTER*4 ILINPA
15679      CHARACTER*4 ILINCO
15680C
15681      CHARACTER*4 IREBLI
15682      CHARACTER*4 IREBCO
15683      CHARACTER*4 IREFSW
15684      CHARACTER*4 IREFCO
15685      CHARACTER*4 IREPTY
15686      CHARACTER*4 IREPLI
15687      CHARACTER*4 IREPCO
15688C
15689      CHARACTER*4 IGRASW
15690      CHARACTER*4 IDIASW
15691C
15692      CHARACTER*4 IDMANU
15693      CHARACTER*4 IDMODE
15694      CHARACTER*4 IDMOD2
15695      CHARACTER*4 IDMOD3
15696      CHARACTER*4 IDPOWE
15697      CHARACTER*4 IDCONT
15698      CHARACTER*4 IDCOLO
15699CCCCC ADD FOLLOWING LINE MARCH 1997.
15700      CHARACTER*4 IDFONT
15701CCCCC ADD FOLLOWING LINE JULY 1997.
15702      CHARACTER*4 UNITSW
15703C
15704      CHARACTER*4 IFOUND
15705      CHARACTER*4 IBUGD2
15706      CHARACTER*4 IERROR
15707      CHARACTER*4 ISUBRO
15708C
15709      CHARACTER*4 IFIG
15710      CHARACTER*4 IBELSW
15711      CHARACTER*4 IERASW
15712      CHARACTER*4 IBACCO
15713      CHARACTER*4 ICOPSW
15714      CHARACTER*4 ITYPEO
15715C
15716      DIMENSION IHARG(*)
15717      DIMENSION IARGT(*)
15718      DIMENSION ARG(*)
15719C
15720      DIMENSION ILINPA(*)
15721      DIMENSION ILINCO(*)
15722      DIMENSION PLINTH(*)
15723C
15724      DIMENSION AREGBA(*)
15725      DIMENSION IREBLI(*)
15726      DIMENSION IREBCO(*)
15727      DIMENSION PREBTH(*)
15728      DIMENSION IREFSW(*)
15729      DIMENSION IREFCO(*)
15730      DIMENSION IREPTY(*)
15731      DIMENSION IREPLI(*)
15732      DIMENSION IREPCO(*)
15733      DIMENSION PREPTH(*)
15734      DIMENSION PREPSP(*)
15735      DIMENSION PDSCAL(*)
15736C
15737      DIMENSION IDMANU(*)
15738      DIMENSION IDMODE(*)
15739      DIMENSION IDMOD2(*)
15740      DIMENSION IDMOD3(*)
15741      DIMENSION IDPOWE(*)
15742      DIMENSION IDCONT(*)
15743      DIMENSION IDCOLO(*)
15744CCCCC ADD FOLLOWING LINE MARCH 1997.
15745      DIMENSION IDFONT(*)
15746      DIMENSION IDNVPP(*)
15747      DIMENSION IDNHPP(*)
15748      DIMENSION IDUNIT(*)
15749C
15750      DIMENSION IDNVOF(*)
15751      DIMENSION IDNHOF(*)
15752C
15753C-----COMMON----------------------------------------------------------
15754C
15755      INCLUDE 'DPCOGR.INC'
15756      INCLUDE 'DPCOBE.INC'
15757      INCLUDE 'DPCOP2.INC'
15758C
15759C-----START POINT-----------------------------------------------------
15760C
15761      IFOUND='NO'
15762      IERROR='NO'
15763      IERRG4=IERROR
15764CCCCC IBUGG4=IBUGD2
15765CCCCC ISUBG4=ISUBRO
15766C
15767      ILOCFN=0
15768      NUMNUM=0
15769C
15770      X1=0.0
15771      Y1=0.0
15772      X2=0.0
15773      Y2=0.0
15774C
15775      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRIA')GOTO90
15776      WRITE(ICOUT,999)
15777  999 FORMAT(1X)
15778      CALL DPWRST('XXX','BUG ')
15779      WRITE(ICOUT,51)
15780   51 FORMAT('***** AT THE BEGINNING OF DPTRIA--')
15781      CALL DPWRST('XXX','BUG ')
15782      WRITE(ICOUT,53)NUMARG
15783   53 FORMAT('NUMARG = ',I8)
15784      CALL DPWRST('XXX','BUG ')
15785      DO55I=1,NUMARG
15786      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
15787   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
15788      CALL DPWRST('XXX','BUG ')
15789   55 CONTINUE
15790      WRITE(ICOUT,57)PXSTAR,PYSTAR
15791   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
15792      CALL DPWRST('XXX','BUG ')
15793      WRITE(ICOUT,58)PXEND,PYEND
15794   58 FORMAT('PXEND,PYEND = ',2E15.7)
15795      CALL DPWRST('XXX','BUG ')
15796      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
15797   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
15798      CALL DPWRST('XXX','BUG ')
15799      WRITE(ICOUT,62)AREGBA(1)
15800   62 FORMAT('AREGBA(1) = ',E15.7)
15801      CALL DPWRST('XXX','BUG ')
15802      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
15803   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
15804      CALL DPWRST('XXX','BUG ')
15805      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
15806   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
15807      CALL DPWRST('XXX','BUG ')
15808      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
15809   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
15810     1A4,2X,A4,2X,A4,2E15.7)
15811      CALL DPWRST('XXX','BUG ')
15812      WRITE(ICOUT,69)PTEXHE,PTEXWI
15813   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
15814      CALL DPWRST('XXX','BUG ')
15815      WRITE(ICOUT,70)PTEXVG,PTEXHG
15816   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
15817      CALL DPWRST('XXX','BUG ')
15818      WRITE(ICOUT,76)IGRASW,IDIASW
15819   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
15820      CALL DPWRST('XXX','BUG ')
15821      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
15822   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
15823      CALL DPWRST('XXX','BUG ')
15824      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
15825   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
15826      CALL DPWRST('XXX','BUG ')
15827      WRITE(ICOUT,80)NUMDEV
15828   80 FORMAT('NUMDEV= ',I8)
15829      CALL DPWRST('XXX','BUG ')
15830      DO81I=1,NUMDEV
15831      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
15832   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
15833     1A4,2X,A4,2X,A4,2X,A4)
15834      CALL DPWRST('XXX','BUG ')
15835      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
15836   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
15837     1A4,2X,A4,2X,A4)
15838      CALL DPWRST('XXX','BUG ')
15839      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
15840   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
15841     1I8,I8,I8)
15842      CALL DPWRST('XXX','BUG ')
15843   81 CONTINUE
15844      WRITE(ICOUT,87)IFOUND
15845   87 FORMAT('IFOUND= ',A4)
15846      CALL DPWRST('XXX','BUG ')
15847      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
15848   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
15849      CALL DPWRST('XXX','BUG ')
15850      WRITE(ICOUT,89)IBUGD2,IERROR
15851   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
15852      CALL DPWRST('XXX','BUG ')
15853   90 CONTINUE
15854C
15855      IFIG='TRIA'
15856      NUMPT=3
15857      NUMPT2=2*NUMPT
15858C
15859C               ********************************
15860C               **  STEP 0--                  **
15861C               **  STEP THROUGH EACH DEVICE  **
15862C               ********************************
15863C
15864      IF(NUMDEV.LE.0)GOTO9000
15865      DO8000IDEVIC=1,NUMDEV
15866C
15867      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
15868      IF(IDMANU(IDEVIC).EQ.'OFF')GOTO8000
15869      IF(IDMANU(IDEVIC).EQ.'NULL')GOTO8000
15870      IF(IDMANU(IDEVIC).EQ.'NONE')GOTO8000
15871      IF(IDMANU(IDEVIC).EQ.'DISC')GOTO8000
15872C
15873      IMANUF=IDMANU(IDEVIC)
15874      IMODEL=IDMODE(IDEVIC)
15875      IMODE2=IDMOD2(IDEVIC)
15876      IMODE3=IDMOD3(IDEVIC)
15877      IGCONT=IDCONT(IDEVIC)
15878      IGCOLO=IDCOLO(IDEVIC)
15879      IGFONT=IDFONT(IDEVIC)
15880      NUMVPP=IDNVPP(IDEVIC)
15881      NUMHPP=IDNHPP(IDEVIC)
15882      ANUMVP=NUMVPP
15883      ANUMHP=NUMHPP
15884      IOFFSV=IDNVOF(IDEVIC)
15885      IOFFSH=IDNHOF(IDEVIC)
15886      IGUNIT=IDUNIT(IDEVIC)
15887      PCHSCA=PDSCAL(IDEVIC)
15888C
15889C               ************************************
15890C               **  STEP 1--                      **
15891C               **  CARRY OUT OPENING OPERATIONS  **
15892C               **  ON THE GRAPHICS DEVICES       **
15893C               ************************************
15894C
15895      CALL DPOPDE
15896C
15897      IBELSW='OFF'
15898      NUMRIN=0
15899      IERASW='OFF'
15900      IBACCO='JUNK'
15901C
15902      CALL DPOPPL(IGRASW,
15903     1IBELSW,NUMRIN,IERASW,
15904     1IBACCO)
15905C
15906C               *****************************************
15907C               **  STEP 2--                           **
15908C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
15909C               *****************************************
15910C
15911      IF(NUMARG.GE.2.AND.
15912     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
15913     1GOTO1111
15914      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
15915     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
15916     1GOTO1112
15917      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
15918     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
15919     1GOTO1113
15920      GOTO1130
15921C
15922 1111 CONTINUE
15923      ITYPEO='ABSO'
15924      ILOCFN=1
15925      GOTO1119
15926C
15927 1112 CONTINUE
15928      ITYPEO='ABSO'
15929      ILOCFN=2
15930      GOTO1119
15931C
15932 1113 CONTINUE
15933      ITYPEO='RELA'
15934      ILOCFN=2
15935      GOTO1119
15936 1119 CONTINUE
15937C
15938      IF(ILOCFN.GT.NUMARG)GOTO1129
15939      DO1120I=ILOCFN,NUMARG
15940      IF(IARGT(I).EQ.'NUMB')GOTO1120
15941      GOTO1129
15942 1120 CONTINUE
15943      IFOUND='YES'
15944      GOTO1149
15945 1129 CONTINUE
15946      GOTO1130
15947C
15948 1130 CONTINUE
15949      IERRG4='YES'
15950      WRITE(ICOUT,1131)
15951 1131 FORMAT('***** ERROR IN DPTRIA--')
15952      CALL DPWRST('XXX','BUG ')
15953      WRITE(ICOUT,1132)
15954 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
15955     1'COMMAND.')
15956      CALL DPWRST('XXX','BUG ')
15957      WRITE(ICOUT,1134)
15958 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
15959     1'PROPER FORM--')
15960      CALL DPWRST('XXX','BUG ')
15961      WRITE(ICOUT,1135)
15962 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A TRIANGLE ')
15963      CALL DPWRST('XXX','BUG ')
15964      WRITE(ICOUT,1136)
15965 1136 FORMAT('      WITH VERTICES (20,20), (50,20), (35,40)')
15966      CALL DPWRST('XXX','BUG ')
15967      WRITE(ICOUT,1141)
15968 1141 FORMAT('      THEN ALLOWABLE FORMS ARE--')
15969      CALL DPWRST('XXX','BUG ')
15970      WRITE(ICOUT,1142)
15971 1142 FORMAT('      TRIANGLE 20 20 50 20 35 40')
15972      CALL DPWRST('XXX','BUG ')
15973      WRITE(ICOUT,1143)
15974 1143 FORMAT('      TRIANGLE ABSOLUTE 20 20 50 20 35 40')
15975      CALL DPWRST('XXX','BUG ')
15976      GOTO9000
15977 1149 CONTINUE
15978C
15979C               ****************************
15980C               **  STEP 3--              **
15981C               **  DRAW OUT THE LINE(S)  **
15982C               ****************************
15983C
15984      NUMNUM=NUMARG-ILOCFN+1
15985      IF(NUMNUM.LT.NUMPT2)GOTO1151
15986      GOTO1152
15987C
15988 1151 CONTINUE
15989      J=ILOCFN-1
15990      X1=PXSTAR
15991      Y1=PYSTAR
15992      GOTO1159
15993C
15994 1152 CONTINUE
15995      J=ILOCFN
15996      IF(J.GT.NUMARG)GOTO1190
15997      X1=ARG(J)
15998CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
15999      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
16000      J=J+1
16001      IF(J.GT.NUMARG)GOTO1190
16002      Y1=ARG(J)
16003CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
16004      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
16005      GOTO1159
16006 1159 CONTINUE
16007C
16008 1160 CONTINUE
16009      J=J+1
16010      IF(J.GT.NUMARG)GOTO1190
16011      X2=ARG(J)
16012CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
16013      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
16014      IF(ITYPEO.EQ.'RELA')X2=X1+X2
16015      J=J+1
16016      IF(J.GT.NUMARG)GOTO1190
16017      Y2=ARG(J)
16018CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
16019      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
16020      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
16021C
16022      J=J+1
16023      IF(J.GT.NUMARG)GOTO1190
16024      X3=ARG(J)
16025CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
16026      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X3,X3,IBUGD2,ISUBRO,IERROR)
16027      IF(ITYPEO.EQ.'RELA')X3=X2+X3
16028      J=J+1
16029      IF(J.GT.NUMARG)GOTO1190
16030      Y3=ARG(J)
16031CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
16032      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y3,Y3,IBUGD2,ISUBRO,IERROR)
16033      IF(ITYPEO.EQ.'RELA')Y3=Y2+Y3
16034C
16035      CALL DPTRI2(X1,Y1,X2,Y2,X3,Y3,
16036     1IFIG,
16037     1ILINPA,ILINCO,PLINTH,
16038     1AREGBA,
16039     1IREBLI,IREBCO,PREBTH,
16040     1IREFSW,IREFCO,
16041     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
16042     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
16043C
16044      X1=X3
16045      Y1=Y3
16046C
16047      GOTO1160
16048 1190 CONTINUE
16049C
16050      PXEND=X3
16051      PYEND=Y3
16052C
16053C               ************************************
16054C               **  STEP 4--                      **
16055C               **  CARRY OUT CLOSING OPERATIONS  **
16056C               **  ON THE GRAPHICS DEVICES       **
16057C               ************************************
16058C
16059      ICOPSW='OFF'
16060      NUMCOP=0
16061      CALL DPCLPL(ICOPSW,NUMCOP,
16062     1PGRAXF,PGRAYF,
16063     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
16064     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
16065C
16066      CALL DPCLDE
16067C
16068 8000 CONTINUE
16069C
16070C               *****************
16071C               **  STEP 90--  **
16072C               **  EXIT       **
16073C               *****************
16074C
16075 9000 CONTINUE
16076      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRIA')GOTO9090
16077      WRITE(ICOUT,999)
16078      CALL DPWRST('XXX','BUG ')
16079      WRITE(ICOUT,9011)
16080 9011 FORMAT('***** AT THE END       OF DPTRIA--')
16081      CALL DPWRST('XXX','BUG ')
16082      WRITE(ICOUT,9012)ILOCFN,NUMNUM
16083 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
16084      CALL DPWRST('XXX','BUG ')
16085      WRITE(ICOUT,9013)X1,Y1,X2,Y2,X3,Y3
16086 9013 FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6E15.7)
16087      CALL DPWRST('XXX','BUG ')
16088      WRITE(ICOUT,9015)PXSTAR,PYSTAR
16089 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
16090      CALL DPWRST('XXX','BUG ')
16091      WRITE(ICOUT,9016)PXEND,PYEND
16092 9016 FORMAT('PXEND,PYEND = ',2E15.7)
16093      CALL DPWRST('XXX','BUG ')
16094      WRITE(ICOUT,9017)IFIG
16095 9017 FORMAT('IFIG = ',A4)
16096      CALL DPWRST('XXX','BUG ')
16097      WRITE(ICOUT,9027)IFOUND
16098 9027 FORMAT('IFOUND = ',A4)
16099      CALL DPWRST('XXX','BUG ')
16100      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
16101 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
16102      CALL DPWRST('XXX','BUG ')
16103      WRITE(ICOUT,9029)IBUGD2,IERROR
16104 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
16105      CALL DPWRST('XXX','BUG ')
16106 9090 CONTINUE
16107C
16108      RETURN
16109      END
16110      SUBROUTINE DPTRIP(IHARG,NUMARG,IDEFPR,IHMXPR,
16111     1IPREC,IFOUND,IERROR)
16112C
16113C     PURPOSE--DEFINE THE PRECISION SWITCH
16114C              AS TRIPLE PRECISION.
16115C              THIS IN TURN SPECIFIES THAT SUBSEQUENT
16116C              CALCULATIONS WILL ALL BE CARRIED OUT
16117C              IN TRIPLE PRECISION.
16118C              THE SPECIFIED PRECISION SWITCH SPECIFICATION
16119C              WILL BE PLACED IN THE HOLLERITH VARIABLE IPREC.
16120C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
16121C                     --NUMARG (AN INTEGER VARIABLE)
16122C                     --IDEFPR (A  HOLLERITH VARIABLE)
16123C                     --IHMXPR (A  HOLLERITH VARIABLE)
16124C     OUTPUT ARGUMENTS--IPREC  (A HOLLERITH VARIABLE)
16125C                     --IFOUND ('YES' OR 'NO' )
16126C                     --IERROR ('YES' OR 'NO' )
16127C     WRITTEN BY--JAMES J. FILLIBEN
16128C                 STATISTICAL ENGINEERING DIVISION
16129C                 INFORMATION TECHNOLOGY LABORATORY
16130C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16131C                 GAITHERSBURG, MD 20899-8980
16132C                 PHONE--301-975-2855
16133C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16134C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16135C     LANGUAGE--ANSI FORTRAN (1977)
16136C     VERSION NUMBER--82/7
16137C     ORIGINAL VERSION--NOVEMBER  1980.
16138C     UPDATED         --SEPTEMBER 1981.
16139C     UPDATED         --MAY       1982.
16140C
16141C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16142C
16143      CHARACTER*4 IHARG
16144      CHARACTER*4 IDEFPR
16145      CHARACTER*4 IHMXPR
16146      CHARACTER*4 IPREC
16147      CHARACTER*4 IFOUND
16148      CHARACTER*4 IERROR
16149C
16150      CHARACTER*4 IHOLD
16151C
16152C---------------------------------------------------------------------
16153C
16154      DIMENSION IHARG(*)
16155C
16156C-----COMMON----------------------------------------------------------
16157C
16158      INCLUDE 'DPCOP2.INC'
16159C
16160C-----START POINT-----------------------------------------------------
16161C
16162      IFOUND='NO'
16163      IERROR='NO'
16164      IFOUND='YES'
16165C
16166      IF(NUMARG.LE.0)GOTO1120
16167      IF(IHARG(NUMARG).EQ.'ON')GOTO1130
16168      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
16169      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1130
16170      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
16171      GOTO1130
16172C
16173 1120 CONTINUE
16174      IHOLD=IDEFPR
16175      GOTO1160
16176C
16177 1130 CONTINUE
16178      IHOLD='TRIP'
16179      GOTO1160
16180C
16181 1160 CONTINUE
16182      IF(IHOLD.EQ.'DOUB'.AND.IHMXPR.EQ.'SING')GOTO1170
16183      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'SING')GOTO1170
16184      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'DOUB')GOTO1170
16185      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'SING')GOTO1170
16186      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'DOUB')GOTO1170
16187      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'TRIP')GOTO1170
16188      GOTO1180
16189C
16190 1170 CONTINUE
16191      IERROR='YES'
16192      WRITE(ICOUT,999)
16193  999 FORMAT(1X)
16194      CALL DPWRST('XXX','BUG ')
16195      WRITE(ICOUT,1172)
16196 1172 FORMAT('***** ERROR IN DPTRIP--')
16197      CALL DPWRST('XXX','BUG ')
16198      WRITE(ICOUT,1173)
16199 1173 FORMAT('      THE DESIRED PRECISION IS HIGHER')
16200      CALL DPWRST('XXX','BUG ')
16201      WRITE(ICOUT,1174)
16202 1174 FORMAT('      THAN PERMITTED ON THIS COMPUTER.')
16203      CALL DPWRST('XXX','BUG ')
16204      WRITE(ICOUT,1175)IHOLD
16205 1175 FORMAT('      DESIRED PRECISION           = ',A4)
16206      CALL DPWRST('XXX','BUG ')
16207      WRITE(ICOUT,1176)IHMXPR
16208 1176 FORMAT('      MAXIMUM ALLOWABLE PRECISION = ',A4)
16209      CALL DPWRST('XXX','BUG ')
16210      GOTO1199
16211C
16212 1180 CONTINUE
16213      IPREC=IHOLD
16214C
16215      IF(IFEEDB.EQ.'OFF')GOTO1189
16216      WRITE(ICOUT,999)
16217      CALL DPWRST('XXX','BUG ')
16218      WRITE(ICOUT,1188)IPREC
16219 1188 FORMAT('THE PRECISION SWITCH HAS JUST BEEN SET TO ',
16220     1A4)
16221      CALL DPWRST('XXX','BUG ')
16222 1189 CONTINUE
16223      GOTO1199
16224C
16225 1199 CONTINUE
16226      RETURN
16227      END
16228      SUBROUTINE DPTRPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
16229     1                  IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
16230C
16231C     PURPOSE--GENERATE A TRILINEAR PLOT.
16232C     WRITTEN BY--ALAN HECKERT
16233C                 STATISTICAL ENGINEERING DIVISION
16234C                 INFORMATION TECHNOLOGY LABORATORY
16235C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16236C                 GAITHERSBURG, MD 20899-8980
16237C                 PHONE--301-975-2899
16238C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16239C           OF THE NATIONAL BUREAU OF STANDARDS.
16240C     LANGUAGE--ANSI FORTRAN (1977)
16241C     VERSION NUMBER--2006/12
16242C     ORIGINAL VERSION--DECEMBER  2006.
16243C     UPDATED         --FEBRUARY  2011. USE DPPARS AND DPPAR3
16244C
16245C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16246C
16247      CHARACTER*4 ICASPL
16248      CHARACTER*4 IAND1
16249      CHARACTER*4 IAND2
16250      CHARACTER*4 IBUGG2
16251      CHARACTER*4 IBUGG3
16252      CHARACTER*4 ISUBRO
16253      CHARACTER*4 IBUGQ
16254      CHARACTER*4 IFOUND
16255      CHARACTER*4 IERROR
16256C
16257      CHARACTER*4 ISUBN1
16258      CHARACTER*4 ISUBN2
16259      CHARACTER*4 ISTEPN
16260      CHARACTER*4 IREPL
16261C
16262      CHARACTER*40 INAME
16263      PARAMETER (MAXSPN=20)
16264      CHARACTER*4 IVARN1(MAXSPN)
16265      CHARACTER*4 IVARN2(MAXSPN)
16266      CHARACTER*4 IVARTY(MAXSPN)
16267      REAL PVAR(MAXSPN)
16268      INTEGER ILIS(MAXSPN)
16269      INTEGER NRIGHT(MAXSPN)
16270      INTEGER ICOLR(MAXSPN)
16271C
16272C---------------------------------------------------------------------
16273C
16274C-----COMMON----------------------------------------------------------
16275C
16276      INCLUDE 'DPCOPA.INC'
16277C
16278      DIMENSION Y1(MAXOBV)
16279      DIMENSION Y2(MAXOBV)
16280      DIMENSION Y3(MAXOBV)
16281      DIMENSION GROUP(MAXOBV)
16282      DIMENSION TEMP1(MAXOBV)
16283      DIMENSION TEMP2(MAXOBV)
16284      DIMENSION TEMP3(MAXOBV)
16285      DIMENSION TEMP4(MAXOBV)
16286C
16287      INCLUDE 'DPCOZZ.INC'
16288      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
16289      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
16290      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
16291      EQUIVALENCE (GARBAG(IGARB4),GROUP(1))
16292      EQUIVALENCE (GARBAG(IGARB5),TEMP1(1))
16293      EQUIVALENCE (GARBAG(IGARB6),TEMP2(1))
16294      EQUIVALENCE (GARBAG(IGARB7),TEMP3(1))
16295      EQUIVALENCE (GARBAG(IGARB8),TEMP4(1))
16296C
16297C-----COMMON VARIABLES (GENERAL)--------------------------------------
16298C
16299      INCLUDE 'DPCOHK.INC'
16300      INCLUDE 'DPCODA.INC'
16301      INCLUDE 'DPCOP2.INC'
16302C
16303C-----START POINT-----------------------------------------------------
16304C
16305      IFOUND='NO'
16306      IERROR='NO'
16307      ISUBN1='DPTR'
16308      ISUBN2='PL  '
16309C
16310      MAXCP1=MAXCOL+1
16311      MAXCP2=MAXCOL+2
16312      MAXCP3=MAXCOL+3
16313      MAXCP4=MAXCOL+4
16314      MAXCP5=MAXCOL+5
16315      MAXCP6=MAXCOL+6
16316C
16317C               ***************************
16318C               **  TREAT THE PLOT CASE  **
16319C               ***************************
16320C
16321      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'TRPL')THEN
16322        WRITE(ICOUT,999)
16323  999   FORMAT(1X)
16324        CALL DPWRST('XXX','BUG ')
16325        WRITE(ICOUT,51)
16326   51   FORMAT('***** AT THE BEGINNING OF DPTRPL--')
16327        CALL DPWRST('XXX','BUG ')
16328        WRITE(ICOUT,53)ICASPL,IAND1,IAND2,MAXNPP
16329   53   FORMAT('ICASPL,IAND1,IAND2,MAXNPP = ',3(A4,2X),I8)
16330        CALL DPWRST('XXX','BUG ')
16331        WRITE(ICOUT,54)IBUGG2,IBUGG3,ISUBRO,IBUGQ
16332   54   FORMAT('IBUGG2,IBUGG3,ISUBRO,IBUGQ = ',3(A4,2X),A4)
16333        CALL DPWRST('XXX','BUG ')
16334        WRITE(ICOUT,55)IFOUND,IERROR
16335   55   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
16336        CALL DPWRST('XXX','BUG ')
16337      ENDIF
16338C
16339C               *******************************************
16340C               **  STEP 1--                             **
16341C               **  SEARCH FOR TRILINEAR PLOT            **
16342C               *******************************************
16343C
16344      ISTEPN='1'
16345      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TRPL')
16346     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16347C
16348      ICASPL='TRPL'
16349      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')THEN
16350        ILASTC=1
16351        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
16352        IFOUND='YES'
16353        IHARG(NUMARG+1)='    '
16354        IHARG2(NUMARG+1)='    '
16355      ELSE
16356        ICASPL='    '
16357        IFOUND='NO'
16358        GOTO9000
16359      ENDIF
16360C
16361C               *********************************
16362C               **  STEP 4--                   **
16363C               **  EXTRACT THE VARIABLE LIST  **
16364C               *********************************
16365C
16366      ISTEPN='4'
16367      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TRPL')
16368     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16369C
16370      INAME='TRILINEAR PLOT'
16371      MINNA=3
16372      MAXNA=100
16373      MINN2=1
16374      IFLAGE=1
16375      IFLAGM=0
16376      IFLAGP=0
16377      JMIN=1
16378      JMAX=NUMARG
16379      MINNVA=3
16380      MAXNVA=4
16381C
16382      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
16383     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
16384     1            JMIN,JMAX,
16385     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
16386     1            IVARN1,IVARN2,IVARTY,PVAR,
16387     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
16388     1            MINNVA,MAXNVA,
16389     1            IFLAGM,IFLAGP,
16390     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
16391      IF(IERROR.EQ.'YES')GOTO9000
16392C
16393      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TRPL')THEN
16394        WRITE(ICOUT,999)
16395        CALL DPWRST('XXX','BUG ')
16396        WRITE(ICOUT,281)
16397  281   FORMAT('***** AFTER CALL DPPARS--')
16398        CALL DPWRST('XXX','BUG ')
16399        WRITE(ICOUT,282)NQ,NUMVAR
16400  282   FORMAT('NQ,NUMVAR = ',2I8)
16401        CALL DPWRST('XXX','BUG ')
16402        IF(NUMVAR.GT.0)THEN
16403          DO285I=1,NUMVAR
16404            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
16405     1                      ICOLR(I),PVAR(I)
16406  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
16407     1             'ICOLR(I),PVAR(I) = ',I8,2X,A4,A4,2X,3I8,G15.7)
16408            CALL DPWRST('XXX','BUG ')
16409  285     CONTINUE
16410        ENDIF
16411      ENDIF
16412C
16413      ICOL=1
16414      CALL DPPAR5(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
16415     1            INAME,IVARN1,IVARN2,IVARTY,
16416     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
16417     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
16418     1            MAXCP4,MAXCP5,MAXCP6,
16419     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
16420     1            Y1,Y2,Y3,GROUP,GROUP,GROUP,GROUP,NS,
16421     1            IBUGG3,ISUBRO,IFOUND,IERROR)
16422C
16423C               *****************************************************
16424C               **  STEP 41--                                      **
16425C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
16426C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR    **
16427C               **  THE PLOT.                                      **
16428C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .    **
16429C               **  DEFINE THE NUMBER OF PLOT POINTS   (NPLOTP).   **
16430C               **  DEFINE THE NUMBER OF PLOT VARIABLES(NPLOTV).   **
16431C               *****************************************************
16432C
16433      ISTEPN='61'
16434      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TRPL')
16435     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16436C
16437      CALL DPTRP2(Y1,Y2,Y3,GROUP,NS,
16438     1            ICASPL,IREPL,MAXN,TEMP1,
16439     1            Y,X,X3D,D,NPLOTP,NPLOTV,
16440     1            IBUGG3,ISUBRO,IERROR)
16441C
16442C               *****************
16443C               **  STEP 90--  **
16444C               **  EXIT.      **
16445C               *****************
16446C
16447 9000 CONTINUE
16448      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'TRPL')THEN
16449        WRITE(ICOUT,999)
16450        CALL DPWRST('XXX','BUG ')
16451        WRITE(ICOUT,9011)
16452 9011   FORMAT('***** AT THE END OF DPTRPL--')
16453        CALL DPWRST('XXX','BUG ')
16454        WRITE(ICOUT,9012)IFOUND,IERROR
16455 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
16456        CALL DPWRST('XXX','BUG ')
16457        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
16458 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
16459     1         I8,I8,I8,2X,A4,2X,A4,2X,A4)
16460        CALL DPWRST('XXX','BUG ')
16461        WRITE(ICOUT,9014)IBUGG2,IBUGG3
16462 9014   FORMAT('IBUGG2,IBUGG3 = ', A4,2X,A4)
16463        CALL DPWRST('XXX','BUG ')
16464        WRITE(ICOUT,9020)
16465 9020   FORMAT('I,Y(.),X(.),D(.),ISUB(.)--')
16466        CALL DPWRST('XXX','BUG ')
16467        DO9021I=1,NPLOTP
16468          WRITE(ICOUT,9022)I,Y(I),X(I),D(I),ISUB(I)
16469 9022     FORMAT(I8,E15.7,E15.7,E15.7,I8)
16470          CALL DPWRST('XXX','BUG ')
16471 9021   CONTINUE
16472      ENDIF
16473C
16474      RETURN
16475      END
16476      SUBROUTINE DPTRP2(Y1,Y2,Y3,GROUP,NS,
16477     1            ICASPL,IREPL,MAXN,TEMP1,
16478     1            Y,X,X3D,D,NPLOTP,NPLOTV,
16479     1            IBUGG3,ISUBRO,IERROR)
16480C
16481C     PURPOSE--FORM A TRILINEAR PLOT.
16482C     REFERENCE--WAINER (1997), "VISUAL REVELATIONS",
16483C                COPERNICUS, PP. 111-118.
16484C     WRITTEN BY--JAMES J. FILLIBEN
16485C                 STATISTICAL ENGINEERING DIVISION
16486C                 INFORMATION TECHNOLOGY LABORATORY
16487C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16488C                 GAITHERSBURG, MD 20899-8980
16489C                 PHONE--301-975-2855
16490C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16491C           OF THE NATIONAL BUREAU OF STANDARDS.
16492C     LANGUAGE--ANSI FORTRAN (1977)
16493C     VERSION NUMBER--2006/12
16494C     ORIGINAL VERSION--DECEMBER  2006.
16495C
16496C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16497C
16498      CHARACTER*4 ICASPL
16499      CHARACTER*4 IREPL
16500      CHARACTER*4 IBUGG3
16501      CHARACTER*4 ISUBRO
16502      CHARACTER*4 IERROR
16503C
16504      CHARACTER*4 ISUBN1
16505      CHARACTER*4 ISUBN2
16506      CHARACTER*4 ISTEPN
16507      CHARACTER*4 IWRITE
16508C
16509      DIMENSION Y1(*)
16510      DIMENSION Y2(*)
16511      DIMENSION Y3(*)
16512      DIMENSION GROUP(*)
16513      DIMENSION TEMP1(*)
16514      DIMENSION Y(*)
16515      DIMENSION X(*)
16516      DIMENSION X3D(*)
16517      DIMENSION D(*)
16518C
16519C-----COMMON----------------------------------------------------------
16520C
16521      INCLUDE 'DPCOP2.INC'
16522C
16523C-----START POINT-----------------------------------------------------
16524C
16525      ISUBN1='DPTR'
16526      ISUBN2='PL  '
16527      IERROR='NO'
16528C
16529      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TRP2')THEN
16530        WRITE(ICOUT,999)
16531  999   FORMAT(1X)
16532        CALL DPWRST('XXX','BUG ')
16533        WRITE(ICOUT,51)
16534   51   FORMAT('***** AT THE BEGINNING OF DPTRPL--')
16535        CALL DPWRST('XXX','BUG ')
16536        WRITE(ICOUT,52)NPLOTV,NPLOTP,NS,MAXN
16537   52   FORMAT('NPLOTV,NPLOTP,NS,MAXN = ',4I8)
16538        CALL DPWRST('XXX','BUG ')
16539        WRITE(ICOUT,53)ICASPL,IREPL,IBUGG3,IERROR
16540   53   FORMAT('ICASPL,IREPL,IBUGG3,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
16541        CALL DPWRST('XXX','BUG ')
16542        DO55I=1,MIN(NS,100)
16543          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I),GROUP(I)
16544   56     FORMAT('I,Y1(I),Y2(I),Y3(I),GROUP(I) = ',I8,4G15.7)
16545          CALL DPWRST('XXX','BUG ')
16546   55   CONTINUE
16547      ENDIF
16548C
16549      ISTEPN='1'
16550      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TRP2')
16551     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16552C
16553C               ********************************************
16554C               **  STEP 1--                              **
16555C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
16556C               **  1) THE SUM OF Y1, Y2, AND Y3 MUST BE  **
16557C               **     EITHER 1 OR 100 (FOR PERCENTAGE    **
16558C               **     UNITS).                            **
16559C               **  2) EACH OF THE COMPONENTS MUST BE IN  **
16560C               **     THE INTERVAL (0,1) OR (0,100).     **
16561C               ********************************************
16562C
16563      N=NS
16564      ACASE=1.0
16565C
16566      DO120I=1,N
16567        ASUM=Y1(I)+Y2(I)+Y3(I)
16568        IF(I.EQ.1)THEN
16569          IF(ABS(ASUM - 1.0).LE.0.001)THEN
16570            ACASE=1.0
16571            EPS=0.001
16572          ELSEIF(ABS(ASUM - 100.0).LE.0.1)THEN
16573            ACASE=100.0
16574            EPS=0.1
16575          ELSE
16576            WRITE(ICOUT,999)
16577            CALL DPWRST('XXX','BUG ')
16578            WRITE(ICOUT,121)
16579  121       FORMAT('***** ERROR IN TRILINEAR PLOT--')
16580            CALL DPWRST('XXX','BUG ')
16581            WRITE(ICOUT,123)I
16582  123       FORMAT('      FOR ROW ',I8,', THE COMPONENTS DO NOT ',
16583     1             'SUM TO EITHER 1 OR 100')
16584            CALL DPWRST('XXX','BUG ')
16585            WRITE(ICOUT,124)ASUM
16586  124       FORMAT('      SUM              = ',G15.7)
16587            CALL DPWRST('XXX','BUG ')
16588            WRITE(ICOUT,125)Y1(I)
16589  125       FORMAT('      COMPONENT 1      = ',G15.7)
16590            CALL DPWRST('XXX','BUG ')
16591            WRITE(ICOUT,126)Y2(I)
16592  126       FORMAT('      COMPONENT 2      = ',G15.7)
16593            CALL DPWRST('XXX','BUG ')
16594            WRITE(ICOUT,127)Y3(I)
16595  127       FORMAT('      COMPONENT 3      = ',G15.7)
16596            CALL DPWRST('XXX','BUG ')
16597            IERROR='YES'
16598            GOTO9000
16599          ENDIF
16600        ELSE
16601          IF(ABS(ASUM - ACASE).GT.EPS)THEN
16602            WRITE(ICOUT,999)
16603            CALL DPWRST('XXX','BUG ')
16604            WRITE(ICOUT,121)
16605            CALL DPWRST('XXX','BUG ')
16606            WRITE(ICOUT,133)I,ACASE
16607  133       FORMAT('      FOR ROW ',I8,', THE COMPONENTS DO NOT ',
16608     1             'SUM TO ',F7.1)
16609            CALL DPWRST('XXX','BUG ')
16610            WRITE(ICOUT,124)ASUM
16611            CALL DPWRST('XXX','BUG ')
16612            WRITE(ICOUT,125)Y1(I)
16613            CALL DPWRST('XXX','BUG ')
16614            WRITE(ICOUT,126)Y2(I)
16615            CALL DPWRST('XXX','BUG ')
16616            WRITE(ICOUT,127)Y3(I)
16617            CALL DPWRST('XXX','BUG ')
16618            IERROR='YES'
16619            GOTO9000
16620          ENDIF
16621        ENDIF
16622  120 CONTINUE
16623C
16624C               ****************************************************
16625C               **  STEP 2--                                      **
16626C               **  COMPUTE COORDINATES FOR TRILINEAR PLOT        **
16627C               ****************************************************
16628C
16629      IF(IREPL.EQ.'ON')THEN
16630        CALL DISTIN(GROUP,N,IWRITE,TEMP1,NDIST,IBUGG3,IERROR)
16631        DO1010I=1,N
16632          Y(I)=Y1(I)
16633          X(I)=Y2(I)
16634          X3D(I)=Y3(I)
16635          D(I)=1.0
16636          DO1020J=1,NDIST
16637            IF(GROUP(I).EQ.TEMP1(J))THEN
16638              D(I)=REAL(J)
16639              GOTO1029
16640            ENDIF
16641 1020     CONTINUE
16642 1029     CONTINUE
16643 1010   CONTINUE
16644        NPLOTP=N
16645        NPLOTV=3
16646      ELSE
16647        DO2010I=1,N
16648          Y(I)=Y1(I)
16649          X(I)=Y2(I)
16650          X3D(I)=Y3(I)
16651          D(I)=1.0
16652 2010   CONTINUE
16653        NPLOTP=N
16654        NPLOTV=3
16655      ENDIF
16656C
16657C               *****************
16658C               **  STEP 90--  **
16659C               **  EXIT       **
16660C               *****************
16661C
16662 9000 CONTINUE
16663      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TRP2')THEN
16664        WRITE(ICOUT,999)
16665        CALL DPWRST('XXX','BUG ')
16666        WRITE(ICOUT,9011)
16667 9011   FORMAT('***** AT THE END OF DPTRPL--')
16668        CALL DPWRST('XXX','BUG ')
16669        WRITE(ICOUT,9012)IFOUND,IERROR
16670 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
16671        CALL DPWRST('XXX','BUG ')
16672        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL
16673 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL = ',
16674     1         I8,I8,I8,2X,A4)
16675        CALL DPWRST('XXX','BUG ')
16676        WRITE(ICOUT,9020)
16677 9020   FORMAT('I,Y(.),X(.),X3D(.),D(.)--')
16678        CALL DPWRST('XXX','BUG ')
16679        DO9021I=1,NPLOTP
16680          WRITE(ICOUT,9022)I,Y(I),X(I),X3D(I),D(I)
16681 9022     FORMAT(I8,4F15.7)
16682          CALL DPWRST('XXX','BUG ')
16683 9021   CONTINUE
16684      ENDIF
16685C
16686      RETURN
16687      END
16688      SUBROUTINE DPTRPO(X,Y,N,
16689     1                  TX,TY,SX,SY,THETA,
16690     1                  X2,Y2,
16691     1                  ISUBRO,IBUGA3,IERROR)
16692C
16693C     PURPOSE--GIVEN A SET OF (X,Y) PAIRS, PERFORM A TRANSLATION,
16694C              SCALING, AND ROTATION TRANSFORMATION.
16695C
16696C              THE TRANSLATION CAN BE IMPLEMENTED AS:
16697C
16698C                  X'=X - Tx
16699C                  Y'=Y - Ty
16700C
16701C              THE SCALING CAN BE IMPLENENTED AS:
16702C
16703C                 X'=X*Sx
16704C                 Y'=Y*Sy
16705C
16706C              THE ROTATION CAN BE IMPLEMENTED AS:
16707C
16708C                 X'=COS(THETA)*X + SIN(THETA)*Y
16709C                 Y'=-SIN(THETA)*X + COS(THETA)*Y
16710C
16711C     INPUT  ARGUMENTS--X      = A REAL VECTOR CONTAINING THE X
16712C                                COORDINATES OF THE POINTS
16713C                     --Y      = A REAL VECTOR CONTAINING THE Y
16714C                                COORDINATES OF THE POINTS
16715C                     --N      = NUMBER OF POINTS IN X, Y
16716C                     --TX     = TRANSLATION IN X DIRECTION
16717C                     --TY     = TRANSLATION IN Y DIRECTION
16718C                     --SX     = SCALING IN X DIRECTION
16719C                     --SY     = SCALING IN Y DIRECTION
16720C                     --THETA  = ANGLE OF ROTATION (IN COUNTER CLOCKWISE
16721C                                DIRECTION) IN RADIANS
16722C     OUTPUT ARGUMENTS--X2     = A REAL VECTOR CONTAINING THE X
16723C                                COORDINATES OF THE TRANSFORMED POINTS
16724C                     --Y      = A REAL VECTOR CONTAINING THE Y
16725C                                COORDINATES OF THE TRANSFORMED POINTS
16726C     REFERENCE--XXXXX
16727C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
16728C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
16729C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
16730C     LANGUAGE--ANSI FORTRAN (1977)
16731C     WRITTEN BY--ALAN HECKERT
16732C                 STATISTICAL ENGINEERING DIVISION
16733C                 INFORMATION TECHNOLOGY LABORATORY
16734C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16735C                 GAITHERSBURG, MD 20899-8980
16736C                 PHONE--301-975-2899
16737C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16738C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16739C     LANGUAGE--ANSI FORTRAN (1977)
16740C     VERSION NUMBER--2012.10
16741C     ORIGINAL VERSION--OCTOBER   2012.
16742C
16743C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16744C
16745C
16746      REAL X(*)
16747      REAL Y(*)
16748      REAL X2(*)
16749      REAL Y2(*)
16750C
16751      DOUBLE PRECISION PI
16752      DOUBLE PRECISION DX
16753      DOUBLE PRECISION DY
16754      DOUBLE PRECISION DXP
16755      DOUBLE PRECISION DYP
16756      DOUBLE PRECISION DTHETA
16757C
16758      INTEGER N
16759C
16760      CHARACTER*4 ISUBRO
16761      CHARACTER*4 IBUGA3
16762      CHARACTER*4 IERROR
16763C
16764C-----COMMON----------------------------------------------------------
16765C
16766      INCLUDE 'DPCOP2.INC'
16767C
16768      DATA PI / 3.1415926535 8979323846 2643383279 503 D0 /
16769C
16770C-----START POINT-----------------------------------------------------
16771C
16772      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRPO')THEN
16773        WRITE(ICOUT,999)
16774  999   FORMAT(1X)
16775        CALL DPWRST('XXX','BUG ')
16776        WRITE(ICOUT,51)
16777   51   FORMAT('***** AT THE BEGINNING OF DPTRPO--')
16778        CALL DPWRST('XXX','BUG ')
16779        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
16780   52   FORMAT('IBUGA3,ISUBRO,N = ',2(A4,2X),I8)
16781        CALL DPWRST('XXX','BUG ')
16782        WRITE(ICOUT,54)TX,TY,SX,SY,THETA
16783   54   FORMAT('TX,TY,SX,SY,THETA = ',5G15.7)
16784        CALL DPWRST('XXX','BUG ')
16785        IF(N.GT.0)THEN
16786          DO65I=1,N
16787            WRITE(ICOUT,66)I,X(I),Y(I)
16788   66       FORMAT('I,X(I),Y(I) = ',I8,2X,2G15.7)
16789            CALL DPWRST('XXX','BUG ')
16790   65     CONTINUE
16791        ENDIF
16792      ENDIF
16793C
16794      IF(SX.LE.0.0)THEN
16795        WRITE(ICOUT,999)
16796        CALL DPWRST('XXX','BUG ')
16797        WRITE(ICOUT,101)
16798  101   FORMAT('***** ERROR IN  TRANSFORM POINTS--')
16799        CALL DPWRST('XXX','BUG ')
16800        WRITE(ICOUT,103)SX
16801  103   FORMAT('      THE SCALING FACTOR ',G15.7,' FOR THE X ',
16802     1         'DIRECTION IS NON-POSITIVE.')
16803        CALL DPWRST('XXX','BUG ')
16804        IERROR='YES'
16805        GOTO9000
16806      ENDIF
16807C
16808      IF(SY.LE.0.0)THEN
16809        WRITE(ICOUT,999)
16810        CALL DPWRST('XXX','BUG ')
16811        WRITE(ICOUT,101)
16812        CALL DPWRST('XXX','BUG ')
16813        WRITE(ICOUT,108)SY
16814  108   FORMAT('      THE SCALING FACTOR ',G15.7,' FOR THE Y ',
16815     1         'DIRECTION IS NON-POSITIVE.')
16816        CALL DPWRST('XXX','BUG ')
16817        IERROR='YES'
16818        GOTO9000
16819      ENDIF
16820C
16821      DTHETA=DBLE(THETA)
16822      IF((DTHETA.LT.-PI) .OR. (DTHETA.GT.PI))THEN
16823        WRITE(ICOUT,999)
16824        CALL DPWRST('XXX','BUG ')
16825        WRITE(ICOUT,101)
16826        CALL DPWRST('XXX','BUG ')
16827        WRITE(ICOUT,113)THETA
16828  113   FORMAT('      THE ROTATION FACTOR ',G15.7,
16829     1         'IS OUTSIDE THE (-PI,PI) INTERVAL.')
16830        CALL DPWRST('XXX','BUG ')
16831        IERROR='YES'
16832        GOTO9000
16833      ENDIF
16834C
16835      DO100IROW=1,N
16836        DX=DBLE(X(IROW))
16837        DY=DBLE(Y(IROW))
16838        DXP= DCOS(DTHETA)*DX + DSIN(DTHETA)*DY
16839        DYP=-DSIN(DTHETA)*DX + DCOS(DTHETA)*DY
16840        DXP=DXP - DBLE(TX)
16841        DYP=DYP - DBLE(TY)
16842        DXP=DXP*DBLE(SX)
16843        DYP=DYP*DBLE(SY)
16844        X2(IROW)=REAL(DXP)
16845        Y2(IROW)=REAL(DYP)
16846  100 CONTINUE
16847C
16848 9000 CONTINUE
16849C
16850      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRPO')THEN
16851        WRITE(ICOUT,9051)
16852 9051   FORMAT('***** AT THE END OF DPTRPO--')
16853        CALL DPWRST('XXX','BUG ')
16854        DO9055I=1,N
16855          WRITE(ICOUT,9056)I,X2(I),Y2(I)
16856 9056     FORMAT('I,X2(I),Y2(I) = ',I8,2X,2G15.7)
16857          CALL DPWRST('XXX','BUG ')
16858 9055   CONTINUE
16859      ENDIF
16860C
16861      RETURN
16862      END
16863      SUBROUTINE DPTTES(XTEMP1,MAXNXT,ICAPSW,IFORSW,
16864     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
16865C
16866C     PURPOSE--CARRY OUT A 1-SAMPLE OR A 2-SAMPLE T TEST
16867C     EXAMPLE--T TEST Y MU
16868C              T TEST MU Y
16869C              T TEST Y1 Y2
16870C              T TEST Y1 Y2 Y3 Y4 MU
16871C              T TEST Y1 Y2 Y3 Y4 Y5
16872C              PAIRED T TEST Y1 Y2
16873C     WRITTEN BY--JAMES J. FILLIBEN
16874C                 STATISTICAL ENGINEERING DIVISION
16875C                 INFORMATION TECHNOLOGY LABORATORY
16876C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16877C                 GAITHERSBURG, MD 20899-8980
16878C                 PHONE--301-921-3651
16879C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16880C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16881C     LANGUAGE--ANSI FORTRAN (1977)
16882C     VERSION NUMBER--82/7
16883C     ORIGINAL VERSION--JULY      1984.
16884C     UPDATED         --FEBRUARY  1994.  ADD COMMENTS ABOVE
16885C     UPDATED         --DECEMBER  1994.  COPY T TEST PARAMETERS
16886C     UPDATED         --MAY       1995.  BUG FIX (DECLARATIONS)
16887C     UPDATED         --MARCH     2011.  USE DPPARS AND DPPAR3
16888C     UPDATED         --MARCH     2011.  SUPPORT FOR PAIRED T-TEST
16889C
16890C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16891C
16892      CHARACTER*4 ICAPSW
16893      CHARACTER*4 IFORSW
16894      CHARACTER*4 IBUGA2
16895      CHARACTER*4 IBUGA3
16896      CHARACTER*4 IBUGQ
16897      CHARACTER*4 ISUBRO
16898      CHARACTER*4 IFOUND
16899      CHARACTER*4 IERROR
16900C
16901      CHARACTER*4 ICASAN
16902      CHARACTER*4 ICASA2
16903      CHARACTER*4 ICASA3
16904      CHARACTER*4 ICTMP1
16905      CHARACTER*4 ICTMP2
16906      CHARACTER*4 ICTMP3
16907      CHARACTER*4 IREPL
16908      CHARACTER*4 IMULT
16909      CHARACTER*4 IPAIR
16910      CHARACTER*4 ISUBN1
16911      CHARACTER*4 ISUBN2
16912      CHARACTER*4 ISTEPN
16913C
16914      CHARACTER*4 ICASE
16915      CHARACTER*4 IVARID
16916      CHARACTER*4 IVARI2
16917      CHARACTER*4 IVARI3
16918      CHARACTER*4 IVARI4
16919      CHARACTER*40 INAME
16920      PARAMETER (MAXSPN=30)
16921      CHARACTER*4 IVARN1(MAXSPN)
16922      CHARACTER*4 IVARN2(MAXSPN)
16923      CHARACTER*4 IVARTY(MAXSPN)
16924      REAL PVAR(MAXSPN)
16925      INTEGER ILIS(MAXSPN)
16926      INTEGER NRIGHT(MAXSPN)
16927      INTEGER ICOLR(MAXSPN)
16928C
16929      CHARACTER*4 IFLAGU
16930      LOGICAL IFRST
16931      LOGICAL ILAST
16932C
16933C---------------------------------------------------------------------
16934C
16935      DIMENSION XTEMP1(*)
16936C
16937C-----COMMON----------------------------------------------------------
16938C
16939      INCLUDE 'DPCOPA.INC'
16940      INCLUDE 'DPCOHK.INC'
16941      INCLUDE 'DPCOSU.INC'
16942      INCLUDE 'DPCODA.INC'
16943      INCLUDE 'DPCOHO.INC'
16944      INCLUDE 'DPCOST.INC'
16945      INCLUDE 'DPCOP2.INC'
16946C
16947C-----START POINT-----------------------------------------------------
16948C
16949      ISUBN1='DPTT'
16950      ISUBN2='ES  '
16951      IFOUND='NO'
16952      IERROR='NO'
16953C
16954      MAXCP1=MAXCOL+1
16955      MAXCP2=MAXCOL+2
16956      MAXCP3=MAXCOL+3
16957      MAXCP4=MAXCOL+4
16958      MAXCP5=MAXCOL+5
16959      MAXCP6=MAXCOL+6
16960C
16961C               ********************************
16962C               **  TREAT THE T TEST CASE  **
16963C               ********************************
16964C
16965      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TTES')THEN
16966        WRITE(ICOUT,999)
16967  999   FORMAT(1X)
16968        CALL DPWRST('XXX','BUG ')
16969        WRITE(ICOUT,51)
16970   51   FORMAT('***** AT THE BEGINNING OF DPTTES--')
16971        CALL DPWRST('XXX','BUG ')
16972        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO,MAXNXT
16973   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',4(A4,2X),I8)
16974        CALL DPWRST('XXX','BUG ')
16975      ENDIF
16976C
16977C               *********************************************************
16978C               **  STEP 1--                                           **
16979C               **  EXTRACT THE COMMAND                                **
16980C               *********************************************************
16981C
16982      ISTEPN='1'
16983      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TTES')
16984     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16985C
16986      ILASTC=9999
16987      ILASTZ=9999
16988      ICASAN='TTES'
16989      ICASA2='UNKN'
16990      ICASA3='UNKN'
16991      IPAIR='OFF'
16992      IREPL='OFF'
16993      IMULT='OFF'
16994C
16995C     LOOK FOR:
16996C
16997C          T TEST/TTEST
16998C          MULTIPLE
16999C          REPLICATED
17000C          PAIRED
17001C          ONE SAMPLE (OR 1 SAMPLE)
17002C          TWO SAMPLE (OR 2 SAMPLE)
17003C
17004      DO100I=0,NUMARG-1
17005C
17006        IF(I.EQ.0)THEN
17007          ICTMP1=ICOM
17008        ELSE
17009          ICTMP1=IHARG(I)
17010        ENDIF
17011        ICTMP2=IHARG(I+1)
17012        ICTMP3=IHARG(I+2)
17013C
17014        IF(ICTMP1.EQ.'=')THEN
17015          IFOUND='NO'
17016          GOTO9000
17017        ELSEIF(ICTMP1.EQ.'T   ' .AND. ICTMP2.EQ.'TEST')THEN
17018          IFOUND='YES'
17019          ICASAN='TTES'
17020          ILASTC=I
17021          ILASTZ=I+1
17022        ELSEIF(ICTMP1.EQ.'TTES')THEN
17023          IFOUND='YES'
17024          ICASAN='TTES'
17025          ILASTC=I
17026          ILASTZ=I
17027        ELSEIF(ICTMP1.EQ.'REPL')THEN
17028          IREPL='ON'
17029          ILASTC=MIN(ILASTC,I)
17030          ILASTZ=MAX(ILASTZ,I)
17031        ELSEIF(ICTMP1.EQ.'MULT')THEN
17032          IMULT='ON'
17033          ILASTC=MIN(ILASTC,I)
17034          ILASTZ=MAX(ILASTZ,I)
17035        ELSEIF(ICTMP1.EQ.'PAIR')THEN
17036          IPAIR='ON'
17037          ILASTC=MIN(ILASTC,I)
17038          ILASTZ=MAX(ILASTZ,I)
17039        ELSEIF(ICTMP1.EQ.'ONE' .AND. ICTMP2.EQ.'SAMP')THEN
17040          ICASA2='ONES'
17041          ILASTC=MIN(ILASTC,I)
17042          ILASTZ=MAX(ILASTZ,I+1)
17043        ELSEIF(ICTMP1.EQ.'1' .AND. ICTMP2.EQ.'SAMP')THEN
17044          ICASA2='ONES'
17045          ILASTC=MIN(ILASTC,I)
17046          ILASTZ=MAX(ILASTZ,I+1)
17047        ELSEIF(ICTMP1.EQ.'TWO' .AND. ICTMP2.EQ.'SAMP')THEN
17048          ICASA2='TWOS'
17049          ILASTC=MIN(ILASTC,I)
17050          ILASTZ=MAX(ILASTZ,I+1)
17051        ELSEIF(ICTMP1.EQ.'2' .AND. ICTMP2.EQ.'SAMP')THEN
17052          ICASA2='TWOS'
17053          ILASTC=MIN(ILASTC,I)
17054          ILASTZ=MAX(ILASTZ,I+1)
17055        ELSEIF(ICTMP1.EQ.'LOWE' .AND. ICTMP2.EQ.'TAIL')THEN
17056          ICASA3='LOWE'
17057          ILASTC=MIN(ILASTC,I)
17058          ILASTZ=MAX(ILASTZ,I+1)
17059        ELSEIF(ICTMP1.EQ.'UPPE' .AND. ICTMP2.EQ.'TAIL')THEN
17060          ICASA3='UPPE'
17061          ILASTC=MIN(ILASTC,I)
17062          ILASTZ=MAX(ILASTZ,I+1)
17063        ELSEIF(ICTMP1.EQ.'TWO' .AND. ICTMP2.EQ.'TAIL')THEN
17064          ICASA3='TWOT'
17065          ILASTC=MIN(ILASTC,I)
17066          ILASTZ=MAX(ILASTZ,I+1)
17067        ELSEIF(ICTMP1.EQ.'2' .AND. ICTMP2.EQ.'TAIL')THEN
17068          ICASA3='TWOT'
17069          ILASTC=MIN(ILASTC,I)
17070          ILASTZ=MAX(ILASTZ,I+1)
17071        ENDIF
17072  100 CONTINUE
17073C
17074      IF(IFOUND.EQ.'NO')GOTO9000
17075C
17076      ISHIFT=ILASTZ
17077      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
17078     1            IBUGA2,IERROR)
17079C
17080      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TTES')THEN
17081        WRITE(ICOUT,91)ICASAN,ICASA2,IMULT,IREPL,ISHIFT
17082   91   FORMAT('DPTTES: ICASAN,ICASA2,IMULT,IREPL,ISHIFT = ',
17083     1         4(A4,2X),I5)
17084        CALL DPWRST('XXX','BUG ')
17085      ENDIF
17086C
17087      IF(IFOUND.EQ.'NO')GOTO9000
17088      IF(IMULT.EQ.'ON')THEN
17089        IF(IREPL.EQ.'ON')THEN
17090          WRITE(ICOUT,999)
17091          CALL DPWRST('XXX','BUG ')
17092          WRITE(ICOUT,101)
17093  101     FORMAT('***** ERROR IN T-TEST--')
17094          CALL DPWRST('XXX','BUG ')
17095          WRITE(ICOUT,102)
17096  102     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ')
17097          CALL DPWRST('XXX','BUG ')
17098          WRITE(ICOUT,103)
17099  103     FORMAT('      "REPLICATION" FOR THE T-TEST COMMAND. ')
17100          CALL DPWRST('XXX','BUG ')
17101          IERROR='YES'
17102          GOTO9000
17103        ENDIF
17104      ENDIF
17105C
17106C               ****************************************
17107C               **  STEP 2--                          **
17108C               **  EXTRACT THE VARIABLE LIST         **
17109C               ****************************************
17110C
17111      ISTEPN='2'
17112      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TTES')
17113     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17114C
17115      INAME='T-TEST'
17116      MINNA=1
17117      MAXNA=100
17118      MINN2=2
17119      IFLAGE=0
17120      IFLAGM=1
17121      MINNVA=2
17122      MAXNVA=MAXSPN
17123      IFLAGP=29
17124      IF(IREPL.EQ.'ON')THEN
17125        IFLAGE=1
17126        IFLAGM=0
17127      ENDIF
17128      IF(IPAIR.EQ.'ON')THEN
17129        IFLAGE=1
17130        ICASA2='TWOS'
17131      ENDIF
17132      IF(ICASA2.EQ.'TWOS')THEN
17133        IFLAGP=0
17134      ENDIF
17135      JMIN=1
17136      JMAX=NUMARG
17137C
17138      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
17139     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
17140     1            JMIN,JMAX,
17141     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
17142     1            IVARN1,IVARN2,IVARTY,PVAR,
17143     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
17144     1            MINNVA,MAXNVA,
17145     1            IFLAGM,IFLAGP,
17146     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
17147      IF(IERROR.EQ.'YES')GOTO9000
17148C
17149      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TTES')THEN
17150        WRITE(ICOUT,999)
17151        CALL DPWRST('XXX','BUG ')
17152        WRITE(ICOUT,281)
17153  281   FORMAT('***** AFTER CALL DPPARS--')
17154        CALL DPWRST('XXX','BUG ')
17155        WRITE(ICOUT,282)NQ,NUMVAR
17156  282   FORMAT('NQ,NUMVAR = ',2I8)
17157        CALL DPWRST('XXX','BUG ')
17158        IF(NUMVAR.GT.0)THEN
17159          DO285I=1,NUMVAR
17160            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),IVARTY(I),
17161     1                      ILIS(I),NRIGHT(I),ICOLR(I)
17162  287       FORMAT('I,IVARN1(I),IVARN2(I),IVARTY(I),ILIS(I),',
17163     1             'NRIGHT(I),ICOLR(I) = ',I8,2X,2A4,2X,A4,2X,3I8)
17164            CALL DPWRST('XXX','BUG ')
17165  285     CONTINUE
17166        ENDIF
17167      ENDIF
17168C
17169C     IF EITHER FIRST OR LAST ARGUMENT IS A PARAMETER, THEN
17170C     WE HAVE THE ONE-SAMPLE T-TEST.  OTHERWISE, HAVE ASSUME
17171C     A TWO-SAMPLE T-TEST.
17172C
17173      IF(ICASA2.EQ.'ONES')THEN
17174        IF(IVARTY(1).NE.'PARA' .AND. IVARTY(NUMVAR).NE.'PARA')THEN
17175          WRITE(ICOUT,999)
17176          CALL DPWRST('XXX','BUG ')
17177          WRITE(ICOUT,101)
17178          CALL DPWRST('XXX','BUG ')
17179          WRITE(ICOUT,292)
17180  292     FORMAT('      FOR THE ONE-SAMPLE TEST, EITHER THE FIRST OR')
17181          CALL DPWRST('XXX','BUG ')
17182          WRITE(ICOUT,294)
17183  294     FORMAT('      THE LAST ARGUMENT MUST BE A PARAMETER.')
17184          CALL DPWRST('XXX','BUG ')
17185          IERROR='YES'
17186          GOTO9000
17187        ENDIF
17188        ISTART=1
17189        ISTOP=NUMVAR-1
17190        AMU0=PVAR(NUMVAR)
17191      ELSEIF(IVARTY(1).EQ.'PARA')THEN
17192        ICASA2='ONES'
17193        ISTART=2
17194        ISTOP=NUMVAR
17195        AMU0=PVAR(1)
17196      ELSEIF(IVARTY(NUMVAR).EQ.'PARA')THEN
17197        ICASA2='ONES'
17198        ISTART=1
17199        ISTOP=NUMVAR-1
17200        AMU0=PVAR(NUMVAR)
17201      ELSE
17202        ICASA2='TWOS'
17203        ISTART=1
17204        ISTOP=NUMVAR
17205      ENDIF
17206C
17207C               ******************************************************
17208C               **  STEP 3A--                                       **
17209C               **  CASE 1: TWO RESPONSE VARIABLES, NO REPLICATION  **
17210C               **          HANDLE MULTIPLE RESPONSE VARIABLES      **
17211C               **          DIFFERENTLY FOR ONE SAMPLE AND TWO      **
17212C               **          SAMPLE TESTS.                           **
17213C               ******************************************************
17214C
17215      ISTEPN='3A'
17216      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TTES')
17217     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17218C
17219      NUMVA2=1
17220      DO5210I=ISTART,ISTOP
17221        ICOL=I
17222        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
17223     1              INAME,IVARN1,IVARN2,IVARTY,
17224     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
17225     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
17226     1              MAXCP4,MAXCP5,MAXCP6,
17227     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
17228     1              Y,Y,Y,NS1,NLOCA2,NLOCA3,ICASE,
17229     1              IBUGA3,ISUBRO,IFOUND,IERROR)
17230        IF(IERROR.EQ.'YES')GOTO9000
17231C
17232        IF(ICASA2.EQ.'ONES')THEN
17233          ISTRT2=1
17234          ISTOP2=1
17235        ELSE
17236          ISTRT2=I+1
17237          ISTOP2=ISTOP
17238        ENDIF
17239C
17240        DO5220J=ISTRT2,ISTOP2
17241C
17242          IF(ICASA2.EQ.'TWOS')THEN
17243            ICOL=J
17244            CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
17245     1                  INAME,IVARN1,IVARN2,IVARTY,
17246     1                  ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
17247     1                  MAXCOL,MAXCP1,MAXCP2,MAXCP3,
17248     1                  MAXCP4,MAXCP5,MAXCP6,
17249     1                  V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
17250     1                  X,X,X,NS2,NLOCA2,NLOCA3,ICASE,
17251     1                  IBUGA3,ISUBRO,IFOUND,IERROR)
17252            IF(IERROR.EQ.'YES')GOTO9000
17253          ENDIF
17254C
17255C               *****************************************
17256C               **  STEP 52--                          **
17257C               **  PERFORM 2-SAMPLE T-TEST            **
17258C               *****************************************
17259C
17260          ISTEPN='52'
17261          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TTES')THEN
17262            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17263            WRITE(ICOUT,999)
17264            CALL DPWRST('XXX','BUG ')
17265            WRITE(ICOUT,5211)
17266 5211       FORMAT('***** FROM DPTTES, BEFORE CALL DPTTE2--')
17267            CALL DPWRST('XXX','BUG ')
17268            WRITE(ICOUT,5212)I,J,NS1,NS2,MAXN
17269 5212       FORMAT('I,J,NS1,NS2,MAXN = ',5I8)
17270            CALL DPWRST('XXX','BUG ')
17271            IF(ICASA2.EQ.'ONES')NS2=NS1
17272            DO5215II=1,MAX(NS1,NS2)
17273              WRITE(ICOUT,5216)II,Y(II),X(II)
17274 5216         FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
17275              CALL DPWRST('XXX','BUG ')
17276 5215       CONTINUE
17277          ENDIF
17278C
17279          IVARID=IVARN1(I)
17280          IVARI2=IVARN2(I)
17281          IVARI3=IVARN1(J)
17282          IVARI4=IVARN2(J)
17283          CALL DPTTE2(Y,NS1,X,NS2,AMU0,ICASA2,ICASA3,IPAIR,
17284     1                XTEMP1,MAXNXT,
17285     1                ICAPSW,ICAPTY,IFORSW,ITTEVA,
17286     1                IVARID,IVARI2,IVARI3,IVARI4,
17287     1                STATVA,STATCD,STATNU,POOLSD,
17288     1                STATV2,STATC2,STATN2,
17289     1                PVAL2T,PVALLT,PVALUT,
17290     1                CTL999,CUTL99,CUTL95,CUTL90,CUTL80,CUTL50,
17291     1                CTU999,CUTU99,CUTU95,CUTU90,CUTU80,CUTU50,
17292     1                IBUGA3,ISUBRO,IERROR)
17293          IF(IERROR.EQ.'YES')GOTO9000
17294C
17295C               ***************************************
17296C               **  STEP 8C--                        **
17297C               **  UPDATE INTERNAL DATAPLOT TABLES  **
17298C               ***************************************
17299C
17300          ISTEPN='8C'
17301          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
17302     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17303C
17304          IF(ICASA2.EQ.'TWOS')THEN
17305            IF(NUMVAR.GT.2)THEN
17306              IFLAGU='FILE'
17307            ELSE
17308              IFLAGU='ON'
17309            ENDIF
17310            IFRST=.FALSE.
17311            ILAST=.FALSE.
17312            IF(I.EQ.1 .AND. J.EQ.2)IFRST=.TRUE.
17313            IF(I.EQ.NUMVAR .AND. J.EQ.NUMVAR)ILAST=.TRUE.
17314            IF(IPAIR.EQ.'OFF')THEN
17315              IF(ITTEVA.EQ.'EQUA')THEN
17316                STATV2=STATVA
17317                STATC2=STATCD
17318                STATN2=STATNU
17319              ENDIF
17320            ENDIF
17321          ELSE
17322            IF(ISTOP-ISTART.GT.0)THEN
17323              IFLAGU='FILE'
17324            ELSE
17325              IFLAGU='ON'
17326            ENDIF
17327            IFRST=.FALSE.
17328            ILAST=.FALSE.
17329            IF(I.EQ.ISTART)IFRST=.TRUE.
17330            IF(I.EQ.ISTOP)ILAST=.TRUE.
17331          ENDIF
17332          CALL DPTTE5(ICASA2,STATVA,STATCD,STATNU,
17333     1                STATV2,STATC2,STATN2,
17334     1                PVAL2T,PVALLT,PVALUT,
17335     1                CTL999,CUTL99,CUTL95,CUTL90,CUTL80,CUTL50,
17336     1                CTU999,CUTU99,CUTU95,CUTU90,CUTU80,CUTU50,
17337     1                IFLAGU,IFRST,ILAST,
17338     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
17339C
17340 5220   CONTINUE
17341 5210 CONTINUE
17342C
17343C               *****************
17344C               **  STEP 90--  **
17345C               **  EXIT       **
17346C               *****************
17347C
17348 9000 CONTINUE
17349      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TTES')THEN
17350        WRITE(ICOUT,999)
17351        CALL DPWRST('XXX','BUG ')
17352        WRITE(ICOUT,9011)
17353 9011   FORMAT('***** AT THE END       OF DPTTES--')
17354        CALL DPWRST('XXX','BUG ')
17355        WRITE(ICOUT,9016)IFOUND,IERROR
17356 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
17357        CALL DPWRST('XXX','BUG ')
17358      ENDIF
17359C
17360      RETURN
17361      END
17362      SUBROUTINE DPTTE2(Y1,N1,Y2,N2,AMU0,ICASA2,ICASA3,IPAIR,
17363     1                  XTEMP1,MAXNXT,
17364     1                  ICAPSW,ICAPTY,IFORSW,ITTEVA,
17365     1                  IVARID,IVARI2,IVARI3,IVARI4,
17366     1                  STATVA,STATCD,STATNU,POOLSD,
17367     1                  STATV2,STATC2,STATN2,
17368     1                  PVAL2T,PVALLT,PVALUT,
17369     1                  CTL999,CUTL99,CUTL95,CUTL90,CUTL80,CUTL50,
17370     1                  CTU999,CUTU99,CUTU95,CUTU90,CUTU80,CUTU50,
17371     1                  IBUGA3,ISUBRO,IERROR)
17372C
17373C     PURPOSE--THIS ROUTINE CARRIES OUT A T TEST
17374C              (1-SAMPLE OR UNPAIRED 2-SAMPLE)
17375C     EXAMPLE--T TEST Y MU
17376C              T TEST MU Y
17377C              T TEST Y1 Y2
17378C     SAMPLE 1 IS IN INPUT VECTOR Y1
17379C              (WITH N1 OBSERVATIONS).
17380C     SAMPLE 2 IS IN INPUT VECTOR Y2
17381C              (WITH N2 OBSERVATIONS).
17382C     WRITTEN BY--JAMES J. FILLIBEN
17383C                 STATISTICAL ENGINEERING DIVISION
17384C                 INFORMATION TECHNOLOGY LABORATORY
17385C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17386C                 GAITHERSBURG, MD 20899-8980
17387C                 PHONE--301-975-2855
17388C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17389C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17390C     LANGUAGE--ANSI FORTRAN (1977)
17391C     VERSION NUMBER--82/7
17392C     ORIGINAL VERSION--MAY       1984.
17393C     UPDATED         --APRIL     1987.  (LARRY KNAB CORRECTION--
17394C                                        BROWNLEE, P. 225)
17395C     UPDATED         --FEBRUARY  1994.  REFORMAT OUTPUT
17396C     UPDATED         --FEBRUARY  1994.  DPWRST: 'BUG ' => 'WRIT'
17397C     UPDATED         --DECEMBER  1994.  COPY T TEST PARAMETERS
17398C     UPDATED         --OCTOBER   2006.  CALL LIST TO TCDF/TPPF
17399C     UPDATED         --NOVEMBER  2007.  ALLOW USER-SPECIFIED
17400C                                        SIGNIFICANCE LEVEL
17401C     UPDATED         --APRIL     2011.  USE DPDTA1, DPDTA5 TO PRINT
17402C                                        OUTPUT.  REFORMAT OUTPUT
17403C                                        SOMEWHAT AS WELL.
17404C
17405C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17406C
17407      CHARACTER*4 IVARID
17408      CHARACTER*4 IVARI2
17409      CHARACTER*4 IVARI3
17410      CHARACTER*4 IVARI4
17411      CHARACTER*4 ICAPSW
17412      CHARACTER*4 ICAPTY
17413      CHARACTER*4 IFORSW
17414      CHARACTER*4 ITTEVA
17415      CHARACTER*4 ICASA2
17416      CHARACTER*4 ICASA3
17417      CHARACTER*4 IPAIR
17418      CHARACTER*4 IBUGA3
17419      CHARACTER*4 ISUBRO
17420      CHARACTER*4 IERROR
17421C
17422      CHARACTER*4 IWRITE
17423      CHARACTER*4 ISUBN1
17424      CHARACTER*4 ISUBN2
17425      CHARACTER*4 ISTEPN
17426C
17427C---------------------------------------------------------------------
17428C
17429      DIMENSION Y1(*)
17430      DIMENSION Y2(*)
17431      DIMENSION XTEMP1(*)
17432C
17433      PARAMETER (NUMALP=6)
17434      REAL ALPHA(NUMALP)
17435C
17436      PARAMETER(NUMCLI=4)
17437      PARAMETER(MAXLIN=3)
17438      PARAMETER (MAXROW=NUMALP)
17439      PARAMETER (MAXRO2=40)
17440      CHARACTER*60 ITITLE
17441      CHARACTER*60 ITITLZ
17442      CHARACTER*60 ITITL9
17443      CHARACTER*60 ITEXT(MAXRO2)
17444      CHARACTER*4  ALIGN(NUMCLI)
17445      CHARACTER*4  VALIGN(NUMCLI)
17446      REAL         AVALUE(MAXRO2)
17447      INTEGER      NCTEXT(MAXRO2)
17448      INTEGER      IDIGIT(MAXRO2)
17449      INTEGER      NTOT(MAXRO2)
17450      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
17451      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
17452      CHARACTER*4  ITYPCO(NUMCLI)
17453      INTEGER      NCTIT2(MAXLIN,NUMCLI)
17454      INTEGER      NCVALU(MAXROW,NUMCLI)
17455      INTEGER      IWHTML(NUMCLI)
17456      INTEGER      IWRTF(NUMCLI)
17457      REAL         AMAT(MAXROW,NUMCLI)
17458      LOGICAL IFRST
17459      LOGICAL ILAST
17460      LOGICAL IFLAGS
17461      LOGICAL IFLAGE
17462C
17463C-----COMMON----------------------------------------------------------
17464C
17465      INCLUDE 'DPCOP2.INC'
17466C
17467      DATA ALPHA/0.50, 0.80, 0.90, 0.95, 0.99, 0.999/
17468C
17469C-----START POINT-----------------------------------------------------
17470C
17471      ISUBN1='DPTT'
17472      ISUBN2='E2  '
17473      IERROR='NO'
17474      IWRITE='OFF'
17475C
17476      NUMDIG=7
17477      IF(IFORSW.EQ.'1')NUMDIG=1
17478      IF(IFORSW.EQ.'2')NUMDIG=2
17479      IF(IFORSW.EQ.'3')NUMDIG=3
17480      IF(IFORSW.EQ.'4')NUMDIG=4
17481      IF(IFORSW.EQ.'5')NUMDIG=5
17482      IF(IFORSW.EQ.'6')NUMDIG=6
17483      IF(IFORSW.EQ.'7')NUMDIG=7
17484      IF(IFORSW.EQ.'8')NUMDIG=8
17485      IF(IFORSW.EQ.'9')NUMDIG=9
17486      IF(IFORSW.EQ.'0')NUMDIG=0
17487      IF(IFORSW.EQ.'E')NUMDIG=-2
17488      IF(IFORSW.EQ.'-2')NUMDIG=-2
17489      IF(IFORSW.EQ.'-3')NUMDIG=-3
17490      IF(IFORSW.EQ.'-4')NUMDIG=-4
17491      IF(IFORSW.EQ.'-5')NUMDIG=-5
17492      IF(IFORSW.EQ.'-6')NUMDIG=-6
17493      IF(IFORSW.EQ.'-7')NUMDIG=-7
17494      IF(IFORSW.EQ.'-8')NUMDIG=-8
17495      IF(IFORSW.EQ.'-9')NUMDIG=-9
17496C
17497      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TTE2')THEN
17498        WRITE(ICOUT,999)
17499  999   FORMAT(1X)
17500        CALL DPWRST('XXX','WRIT')
17501        WRITE(ICOUT,51)
17502   51   FORMAT('**** AT THE BEGINNING OF DPTTE2--')
17503        CALL DPWRST('XXX','WRIT')
17504        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASA2,ITTEVA
17505   52   FORMAT('IBUGA3,ISUBRO = ',3(A4,2X),A4)
17506        CALL DPWRST('XXX','WRIT')
17507        WRITE(ICOUT,55)N1,N2,NUMDIG,MAXNXT,AMU
17508   55   FORMAT('N1,N2,NUMDIG,MAXNXT,AMU = ',4I8,G15.7)
17509        CALL DPWRST('XXX','WRIT')
17510        IF(N1.GE.1)THEN
17511          DO56I=1,N1
17512            WRITE(ICOUT,57)I,Y1(I)
17513   57       FORMAT('I,Y1(I) = ',I8,G15.7)
17514            CALL DPWRST('XXX','WRIT')
17515   56     CONTINUE
17516        ENDIF
17517        IF(N2.GE.1 .AND. ICASA2.EQ.'TWOS')THEN
17518          DO66I=1,N2
17519            WRITE(ICOUT,67)I,Y2(I)
17520   67       FORMAT('I,Y2(I) = ',I8,G15.7)
17521            CALL DPWRST('XXX','WRIT')
17522   66     CONTINUE
17523        ENDIF
17524      ENDIF
17525C
17526C               ************************************
17527C               **   STEP 1--                     **
17528C               **   BRANCH DEPENDING ON WHETHER  **
17529C               **   1-SAMPLE T TEST OR           **
17530C               **   2-SAMPLE T TEST.             **
17531C               ************************************
17532C
17533      ISTEPN='1'
17534      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
17535     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17536C
17537      IF(ICASA2.EQ.'ONES')THEN
17538        GOTO2100
17539      ELSEIF(ICASA2.EQ.'TWOS')THEN
17540        IF(IPAIR.EQ.'OFF')GOTO3100
17541        IF(IPAIR.EQ.'ON')GOTO4100
17542      ELSE
17543        GOTO9000
17544      ENDIF
17545C
17546C               ******************************
17547C               **  STEP 21--               **
17548C               **  CARRY OUT CALCULATIONS  **
17549C               **  FOR A 1-SAMPLE T TEST   **
17550C               ******************************
17551C
17552 2100 CONTINUE
17553C
17554      ISTEPN='21'
17555      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
17556     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17557C
17558      CALL DPTTE3(Y1,N1,AMU0,IWRITE,STATVA,STATCD,STATNU,
17559     1            YMEAN,YSD,YSDM,DEL,
17560     1            PVAL2T,PVALLT,PVALUT,
17561     1            ISUBRO,IBUGA3,IERROR)
17562C
17563      CALL TPPF(.0005,STATNU,CTL999)
17564      CALL TPPF(.005,STATNU,CUTL99)
17565      CALL TPPF(.025,STATNU,CUTL95)
17566      CALL TPPF(.05,STATNU,CUTL90)
17567      CALL TPPF(.1,STATNU,CUTL80)
17568      CALL TPPF(.25,STATNU,CUTL50)
17569      CALL TPPF(.75,STATNU,CUTU50)
17570      CALL TPPF(.90,STATNU,CUTU80)
17571      CALL TPPF(.95,STATNU,CUTU90)
17572      CALL TPPF(.975,STATNU,CUTU95)
17573      CALL TPPF(.995,STATNU,CUTU99)
17574      CALL TPPF(.9995,STATNU,CTU999)
17575C
17576C               ******************************
17577C               **   STEP 22--              **
17578C               **   WRITE OUT EVERYTHING   **
17579C               **   FOR A 1-SAMPLE T TEST  **
17580C               ******************************
17581C
17582      ISTEPN='22'
17583      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
17584     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17585C
17586      IF(IPRINT.EQ.'OFF')GOTO9000
17587C
17588      ITITLE='One Sample t-Test for the Mean'
17589      NCTITL=30
17590      ITITLZ=' '
17591      NCTITZ=0
17592C
17593      ICNT=1
17594      ITEXT(ICNT)=' '
17595      NCTEXT(ICNT)=0
17596      AVALUE(ICNT)=0.0
17597      IDIGIT(ICNT)=-1
17598C
17599      ICNT=ICNT+1
17600      ITEXT(ICNT)='Response Variable: '
17601      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1:4)
17602      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1:4)
17603      NCTEXT(ICNT)=27
17604      AVALUE(ICNT)=0.0
17605      IDIGIT(ICNT)=-1
17606C
17607      ICNT=ICNT+1
17608      ITEXT(ICNT)=' '
17609      NCTEXT(ICNT)=1
17610      AVALUE(ICNT)=0.0
17611      IDIGIT(ICNT)=-1
17612C
17613      ICNT=ICNT+1
17614      ITEXT(ICNT)='H0: Mean Equal'
17615      NCTEXT(ICNT)=14
17616      AVALUE(ICNT)=AMU0
17617      IDIGIT(ICNT)=NUMDIG
17618      ICNT=ICNT+1
17619      ITEXT(ICNT)='Ha: Mean Not Equal'
17620      NCTEXT(ICNT)=18
17621      AVALUE(ICNT)=AMU0
17622      IDIGIT(ICNT)=NUMDIG
17623C
17624      ICNT=ICNT+1
17625      ITEXT(ICNT)=' '
17626      NCTEXT(ICNT)=1
17627      AVALUE(ICNT)=0.0
17628      IDIGIT(ICNT)=-1
17629      ICNT=ICNT+1
17630      ITEXT(ICNT)='Summary Statistics:'
17631      NCTEXT(ICNT)=19
17632      AVALUE(ICNT)=0.0
17633      IDIGIT(ICNT)=-1
17634      ICNT=ICNT+1
17635      ITEXT(ICNT)='Number of Observations:'
17636      NCTEXT(ICNT)=23
17637      AVALUE(ICNT)=REAL(N1)
17638      IDIGIT(ICNT)=0
17639      ICNT=ICNT+1
17640      ITEXT(ICNT)='Sample Mean:'
17641      NCTEXT(ICNT)=12
17642      AVALUE(ICNT)=YMEAN
17643      IDIGIT(ICNT)=NUMDIG
17644      ICNT=ICNT+1
17645      ITEXT(ICNT)='Sample Standard Deviation:'
17646      NCTEXT(ICNT)=26
17647      AVALUE(ICNT)=YSD
17648      IDIGIT(ICNT)=NUMDIG
17649      ICNT=ICNT+1
17650      ITEXT(ICNT)='Sample Standard Deviation of the Mean:'
17651      NCTEXT(ICNT)=38
17652      AVALUE(ICNT)=YSDM
17653      IDIGIT(ICNT)=NUMDIG
17654      ICNT=ICNT+1
17655      ITEXT(ICNT)=' '
17656      NCTEXT(ICNT)=1
17657      AVALUE(ICNT)=0.0
17658      IDIGIT(ICNT)=-1
17659C
17660      ICNT=ICNT+1
17661      ITEXT(ICNT)='Test:'
17662      NCTEXT(ICNT)=5
17663      AVALUE(ICNT)=0.0
17664      IDIGIT(ICNT)=-1
17665      ICNT=ICNT+1
17666      ITEXT(ICNT)='Mean - Mu0:'
17667      NCTEXT(ICNT)=11
17668      AVALUE(ICNT)=DEL
17669      IDIGIT(ICNT)=NUMDIG
17670      ICNT=ICNT+1
17671      ITEXT(ICNT)='t-Test Statistic Value:'
17672      NCTEXT(ICNT)=23
17673      AVALUE(ICNT)=STATVA
17674      IDIGIT(ICNT)=NUMDIG
17675      ICNT=ICNT+1
17676      ITEXT(ICNT)='Degrees of Freedom:'
17677      NCTEXT(ICNT)=19
17678      AVALUE(ICNT)=INT(STATNU+0.1)
17679      IDIGIT(ICNT)=0
17680      ICNT=ICNT+1
17681      ITEXT(ICNT)='CDF Value:'
17682      NCTEXT(ICNT)=10
17683      AVALUE(ICNT)=STATCD
17684      IDIGIT(ICNT)=NUMDIG
17685      ICNT=ICNT+1
17686      ITEXT(ICNT)='P-Value (2-tailed test):'
17687      NCTEXT(ICNT)=24
17688      AVALUE(ICNT)=PVAL2T
17689      IDIGIT(ICNT)=NUMDIG
17690      ICNT=ICNT+1
17691      ITEXT(ICNT)='P-Value (lower-tailed test):'
17692      NCTEXT(ICNT)=28
17693      AVALUE(ICNT)=PVALLT
17694      IDIGIT(ICNT)=NUMDIG
17695      ICNT=ICNT+1
17696      ITEXT(ICNT)='P-Value (upper-tailed test):'
17697      NCTEXT(ICNT)=28
17698      AVALUE(ICNT)=PVALUT
17699      IDIGIT(ICNT)=NUMDIG
17700C
17701      NUMROW=ICNT
17702      DO2110I=1,NUMROW
17703        NTOT(I)=15
17704 2110 CONTINUE
17705C
17706      IFRST=.TRUE.
17707      ILAST=.TRUE.
17708C
17709      ISTEPN='21A'
17710      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
17711     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17712C
17713      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
17714     1            AVALUE,IDIGIT,
17715     1            NTOT,NUMROW,
17716     1            ICAPSW,ICAPTY,ILAST,IFRST,
17717     1            ISUBRO,IBUGA3,IERROR)
17718C
17719      ISTEPN='21B'
17720      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
17721     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17722C
17723      ITITLE='Two-Tailed Test'
17724      NCTITL=15
17725      ITITL9='H0: u = m0; Ha: u <> m0'
17726      NCTIT9=23
17727C
17728      DO2130J=1,4
17729        DO2140I=1,3
17730          ITITL2(I,J)=' '
17731          NCTIT2(I,J)=0
17732 2140   CONTINUE
17733 2130 CONTINUE
17734C
17735      ITITL2(2,1)='Significance'
17736      NCTIT2(2,1)=12
17737      ITITL2(3,1)='Level'
17738      NCTIT2(3,1)=5
17739C
17740      ITITL2(2,2)='Test '
17741      NCTIT2(2,2)=4
17742      ITITL2(3,2)='Statistic'
17743      NCTIT2(3,2)=9
17744C
17745      ITITL2(2,3)='Critical'
17746      NCTIT2(2,3)=8
17747      ITITL2(3,3)='Value (+/-)'
17748      NCTIT2(3,3)=11
17749C
17750      ITITL2(1,4)='Null'
17751      NCTIT2(1,4)=4
17752      ITITL2(2,4)='Hypothesis'
17753      NCTIT2(2,4)=10
17754      ITITL2(3,4)='Conclusion'
17755      NCTIT2(3,4)=10
17756C
17757      NMAX=0
17758      NUMCOL=4
17759      DO2150I=1,NUMCOL
17760        VALIGN(I)='b'
17761        ALIGN(I)='r'
17762        NTOT(I)=15
17763        NMAX=NMAX+NTOT(I)
17764        ITYPCO(I)='NUME'
17765        IDIGIT(I)=NUMDIG
17766        IF(I.EQ.1 .OR. I.EQ.4)THEN
17767          ITYPCO(I)='ALPH'
17768        ENDIF
17769 2150 CONTINUE
17770C
17771      IWHTML(1)=125
17772      IWHTML(2)=175
17773      IWHTML(3)=175
17774      IWHTML(4)=175
17775      IINC=1800
17776      IINC2=1400
17777      IWRTF(1)=IINC
17778      IWRTF(2)=IWRTF(1)+IINC
17779      IWRTF(3)=IWRTF(2)+IINC
17780      IWRTF(4)=IWRTF(3)+IINC
17781C
17782      DO2160J=1,NUMALP
17783C
17784        AMAT(J,2)=STATVA
17785        IF(J.EQ.1)THEN
17786          AMAT(J,3)=CUTU50
17787        ELSEIF(J.EQ.2)THEN
17788          AMAT(J,3)=CUTU80
17789        ELSEIF(J.EQ.3)THEN
17790          AMAT(J,3)=CUTU90
17791        ELSEIF(J.EQ.4)THEN
17792          AMAT(J,3)=CUTU95
17793        ELSEIF(J.EQ.5)THEN
17794          AMAT(J,3)=CUTU99
17795        ELSEIF(J.EQ.6)THEN
17796          AMAT(J,3)=CTU999
17797        ENDIF
17798        IVALUE(J,4)(1:6)='REJECT'
17799        IF(ABS(STATVA).LT.AMAT(J,3))THEN
17800          IVALUE(J,4)(1:6)='ACCEPT'
17801        ENDIF
17802        NCVALU(J,4)=6
17803C
17804        ALPHAT=100.0*ALPHA(J)
17805        WRITE(IVALUE(J,1)(1:4),'(F4.1)')ALPHAT
17806        IVALUE(J,1)(5:5)='%'
17807        NCVALU(J,1)=5
17808 2160 CONTINUE
17809C
17810      ICNT=NUMALP
17811      NUMLIN=3
17812      NUMCOL=4
17813      IFRST=.TRUE.
17814      ILAST=.TRUE.
17815      IFLAGS=.TRUE.
17816      IFLAGE=.TRUE.
17817      IF(ICASA3.NE.'LOWE' .AND. ICASA3.NE.'UPPE')THEN
17818        CALL DPDTA5(ITITLE,NCTITL,
17819     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
17820     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17821     1              IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
17822     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17823     1              ICAPSW,ICAPTY,IFRST,ILAST,
17824     1              IFLAGS,IFLAGE,
17825     1              ISUBRO,IBUGA3,IERROR)
17826      ENDIF
17827      IF(ICASA3.EQ.'TWOT')GOTO9000
17828C
17829      ITITLE='Lower One-Tailed Test'
17830      NCTITL=21
17831      ITITL9='H0: u = m0; Ha: u < m0'
17832      NCTIT9=22
17833C
17834      ITITL2(2,3)='Critical'
17835      NCTIT2(2,3)=8
17836      ITITL2(3,3)='Value (<)'
17837      NCTIT2(3,3)=9
17838C
17839      NMAX=0
17840      NUMCOL=4
17841      DO2250I=1,NUMCOL
17842        NTOT(I)=15
17843        NMAX=NMAX+NTOT(I)
17844 2250 CONTINUE
17845C
17846      DO2260J=1,NUMALP
17847        ALPHAT=1.0 - ALPHA(J)
17848        CALL TPPF(ALPHAT,STATNU,ATEMP)
17849        AMAT(J,3)=ATEMP
17850        IVALUE(J,4)(1:6)='REJECT'
17851        IF(STATVA.GE.AMAT(J,3))THEN
17852          IVALUE(J,4)(1:6)='ACCEPT'
17853        ENDIF
17854        NCVALU(J,4)=6
17855 2260 CONTINUE
17856C
17857      ICNT=NUMALP
17858      NUMLIN=3
17859      IFRST=.TRUE.
17860      ILAST=.TRUE.
17861      IFLAGS=.TRUE.
17862      IFLAGE=.TRUE.
17863      IF(ICASA3.NE.'UPPE')THEN
17864        CALL DPDTA5(ITITLE,NCTITL,
17865     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
17866     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17867     1              IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
17868     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17869     1              ICAPSW,ICAPTY,IFRST,ILAST,
17870     1              IFLAGS,IFLAGE,
17871     1              ISUBRO,IBUGA3,IERROR)
17872      ENDIF
17873C
17874      IF(ICASA3.EQ.'LOWE')GOTO9000
17875C
17876      ITITLE='Upper One-Tailed Test'
17877      NCTITL=21
17878      ITITL9='H0: u = m0; Ha: u > m0'
17879      NCTIT9=22
17880C
17881      ITITL2(2,3)='Critical'
17882      NCTIT2(2,3)=8
17883      ITITL2(3,3)='Value (>)'
17884      NCTIT2(3,3)=9
17885C
17886      NMAX=0
17887      NUMCOL=4
17888      DO2350I=1,NUMCOL
17889        NTOT(I)=15
17890        NMAX=NMAX+NTOT(I)
17891 2350 CONTINUE
17892C
17893      DO2360J=1,NUMALP
17894        ALPHAT=ALPHA(J)
17895        CALL TPPF(ALPHAT,STATNU,ATEMP)
17896        AMAT(J,3)=ATEMP
17897        IVALUE(J,4)(1:6)='REJECT'
17898        IF(STATVA.LE.AMAT(J,3))THEN
17899          IVALUE(J,4)(1:6)='ACCEPT'
17900        ENDIF
17901        NCVALU(J,4)=6
17902 2360 CONTINUE
17903C
17904      ICNT=NUMALP
17905      NUMLIN=3
17906      IFRST=.TRUE.
17907      ILAST=.TRUE.
17908      IFLAGS=.TRUE.
17909      IFLAGE=.TRUE.
17910      CALL DPDTA5(ITITLE,NCTITL,
17911     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
17912     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17913     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
17914     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17915     1            ICAPSW,ICAPTY,IFRST,ILAST,
17916     1            IFLAGS,IFLAGE,
17917     1            ISUBRO,IBUGA3,IERROR)
17918C
17919      GOTO9000
17920C
17921C               ****************************************
17922C               **  STEP 31--                         **
17923C               **  CARRY OUT CALCULATIONS            **
17924C               **  FOR AN UNPAIRED 2-SAMPLE T TEST   **
17925C               ****************************************
17926C
17927 3100 CONTINUE
17928C
17929      ISTEPN='31'
17930      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
17931     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17932C
17933      CALL DPTTE4(Y1,N1,Y2,N2,IWRITE,
17934     1            STATVA,STATCD,STATNU,
17935     1            STATV2,STATC2,STATN2,
17936     1            Y1MEAN,Y1SD,Y1SDM,
17937     1            Y2MEAN,Y2SD,Y2SDM,
17938     1            DEL,POOLSD,DELSD,DELSD2,CDFBAR,
17939     1            PVAL2T,PVALLT,PVALUT,
17940     1            ISUBRO,IBUGA3,IERROR)
17941      IF(IERROR.EQ.'YES')GOTO9000
17942C
17943C               ******************************
17944C               **   STEP 32--              **
17945C               **   WRITE OUT EVERYTHING   **
17946C               **   FOR A 2-SAMPLE T TEST  **
17947C               ******************************
17948C
17949      ISTEPN='32'
17950      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
17951     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17952C
17953      IF(IPRINT.EQ.'OFF')GOTO9000
17954C
17955      ITITLE='Two Sample t-Test for Equal Means'
17956      NCTITL=34
17957      ITITLZ=' '
17958      NCTITZ=0
17959C
17960      ICNT=1
17961      ITEXT(ICNT)=' '
17962      NCTEXT(ICNT)=0
17963      AVALUE(ICNT)=0.0
17964      IDIGIT(ICNT)=-1
17965C
17966      ICNT=ICNT+1
17967      ITEXT(ICNT)='First Response Variable:  '
17968      WRITE(ITEXT(ICNT)(27:30),'(A4)')IVARID(1:4)
17969      WRITE(ITEXT(ICNT)(31:34),'(A4)')IVARI2(1:4)
17970      NCTEXT(ICNT)=34
17971      AVALUE(ICNT)=0.0
17972      IDIGIT(ICNT)=-1
17973C
17974      ICNT=ICNT+1
17975      ITEXT(ICNT)='Second Response Variable: '
17976      WRITE(ITEXT(ICNT)(27:30),'(A4)')IVARI3(1:4)
17977      WRITE(ITEXT(ICNT)(31:34),'(A4)')IVARI4(1:4)
17978      NCTEXT(ICNT)=34
17979      AVALUE(ICNT)=0.0
17980      IDIGIT(ICNT)=-1
17981C
17982      ICNT=ICNT+1
17983      ITEXT(ICNT)=' '
17984      NCTEXT(ICNT)=0
17985      AVALUE(ICNT)=0.0
17986      IDIGIT(ICNT)=-1
17987C
17988      ICNT=ICNT+1
17989      ITEXT(ICNT)='H0: Population Means Are Equal (u1=u2)'
17990      NCTEXT(ICNT)=30
17991      AVALUE(ICNT)=0.0
17992      IDIGIT(ICNT)=-1
17993      ICNT=ICNT+1
17994      ITEXT(ICNT)='Ha: Population Means Are Not Equal'
17995      NCTEXT(ICNT)=34
17996      AVALUE(ICNT)=0.0
17997      IDIGIT(ICNT)=-1
17998C
17999      ICNT=ICNT+1
18000      ITEXT(ICNT)=' '
18001      NCTEXT(ICNT)=1
18002      AVALUE(ICNT)=0.0
18003      IDIGIT(ICNT)=-1
18004C
18005      ICNT=ICNT+1
18006      ITEXT(ICNT)='Sample One Summary Statistics:'
18007      NCTEXT(ICNT)=30
18008      AVALUE(ICNT)=0.0
18009      IDIGIT(ICNT)=-1
18010      ICNT=ICNT+1
18011      ITEXT(ICNT)='Number of Observations:'
18012      NCTEXT(ICNT)=23
18013      AVALUE(ICNT)=REAL(N1)
18014      IDIGIT(ICNT)=0
18015      ICNT=ICNT+1
18016      ITEXT(ICNT)='Sample Mean:'
18017      NCTEXT(ICNT)=12
18018      AVALUE(ICNT)=Y1MEAN
18019      IDIGIT(ICNT)=NUMDIG
18020      ICNT=ICNT+1
18021      ITEXT(ICNT)='Sample Standard Deviation:'
18022      NCTEXT(ICNT)=26
18023      AVALUE(ICNT)=Y1SD
18024      IDIGIT(ICNT)=NUMDIG
18025      ICNT=ICNT+1
18026      ITEXT(ICNT)='Sample Standard Deviation of the Mean:'
18027      NCTEXT(ICNT)=38
18028      AVALUE(ICNT)=Y1SDM
18029      IDIGIT(ICNT)=NUMDIG
18030      ICNT=ICNT+1
18031      ITEXT(ICNT)=' '
18032      NCTEXT(ICNT)=1
18033      AVALUE(ICNT)=0.0
18034      IDIGIT(ICNT)=-1
18035C
18036      ICNT=ICNT+1
18037      ITEXT(ICNT)='Sample Two Summary Statistics:'
18038      NCTEXT(ICNT)=30
18039      AVALUE(ICNT)=0.0
18040      IDIGIT(ICNT)=-1
18041      ICNT=ICNT+1
18042      ITEXT(ICNT)='Number of Observations:'
18043      NCTEXT(ICNT)=23
18044      AVALUE(ICNT)=REAL(N2)
18045      IDIGIT(ICNT)=0
18046      ICNT=ICNT+1
18047      ITEXT(ICNT)='Sample Mean:'
18048      NCTEXT(ICNT)=12
18049      AVALUE(ICNT)=Y2MEAN
18050      IDIGIT(ICNT)=NUMDIG
18051      ICNT=ICNT+1
18052      ITEXT(ICNT)='Sample Standard Deviation:'
18053      NCTEXT(ICNT)=26
18054      AVALUE(ICNT)=Y2SD
18055      IDIGIT(ICNT)=NUMDIG
18056      ICNT=ICNT+1
18057      ITEXT(ICNT)='Sample Standard Deviation of the Mean:'
18058      NCTEXT(ICNT)=38
18059      AVALUE(ICNT)=Y2SDM
18060      IDIGIT(ICNT)=NUMDIG
18061      ICNT=ICNT+1
18062      ITEXT(ICNT)=' '
18063      NCTEXT(ICNT)=1
18064      AVALUE(ICNT)=0.0
18065      IDIGIT(ICNT)=-1
18066C
18067      IF(ITTEVA.EQ.'EQUA' .OR. ITTEVA.EQ.'BOTH')THEN
18068        ICNT=ICNT+1
18069        ITEXT(ICNT)='Test When Assume Equal Variances:'
18070        NCTEXT(ICNT)=33
18071        AVALUE(ICNT)=0.0
18072        IDIGIT(ICNT)=-1
18073        ICNT=ICNT+1
18074        ITEXT(ICNT)='Pooled Standard Deviation:'
18075        NCTEXT(ICNT)=26
18076        AVALUE(ICNT)=POOLSD
18077        IDIGIT(ICNT)=NUMDIG
18078        ICNT=ICNT+1
18079        ITEXT(ICNT)='Difference (Delta) in Means:'
18080        NCTEXT(ICNT)=28
18081        AVALUE(ICNT)=DEL
18082        IDIGIT(ICNT)=NUMDIG
18083        ICNT=ICNT+1
18084        ITEXT(ICNT)='Standard Deviation of Delta:'
18085        NCTEXT(ICNT)=28
18086        AVALUE(ICNT)=DELSD
18087        IDIGIT(ICNT)=NUMDIG
18088        ICNT=ICNT+1
18089        ITEXT(ICNT)='t-Test Statistic Value:'
18090        NCTEXT(ICNT)=23
18091        AVALUE(ICNT)=STATVA
18092        IDIGIT(ICNT)=NUMDIG
18093        ICNT=ICNT+1
18094        ITEXT(ICNT)='Degrees of Freedom:'
18095        NCTEXT(ICNT)=19
18096        AVALUE(ICNT)=STATNU
18097        IDIGIT(ICNT)=0
18098        ICNT=ICNT+1
18099        ITEXT(ICNT)='CDF Value:'
18100        NCTEXT(ICNT)=10
18101        AVALUE(ICNT)=STATCD
18102        IDIGIT(ICNT)=NUMDIG
18103        ICNT=ICNT+1
18104        ITEXT(ICNT)='P-Value (2-tailed test):'
18105        NCTEXT(ICNT)=24
18106        IF(STATVA.LE.0.0)THEN
18107          ATEMP=2.0*STATCD
18108        ELSE
18109          ATEMP=2.0*(1.0-STATCD)
18110        ENDIF
18111        AVALUE(ICNT)=ATEMP
18112        IDIGIT(ICNT)=NUMDIG
18113        ICNT=ICNT+1
18114        ITEXT(ICNT)='P-Value (lower-tailed test):'
18115        NCTEXT(ICNT)=28
18116        AVALUE(ICNT)=STATCD
18117        IDIGIT(ICNT)=NUMDIG
18118        ICNT=ICNT+1
18119        ITEXT(ICNT)='P-Value (upper-tailed test):'
18120        NCTEXT(ICNT)=28
18121        AVALUE(ICNT)=1.0 - STATCD
18122        IDIGIT(ICNT)=NUMDIG
18123        ICNT=ICNT+1
18124        ITEXT(ICNT)=' '
18125        NCTEXT(ICNT)=1
18126        AVALUE(ICNT)=0.0
18127        IDIGIT(ICNT)=-1
18128      ENDIF
18129C
18130      IF(ITTEVA.EQ.'UNEQ' .OR. ITTEVA.EQ.'BOTH')THEN
18131        ICNT=ICNT+1
18132        ITEXT(ICNT)='Test When Assume Unequal Variances:'
18133        NCTEXT(ICNT)=35
18134        AVALUE(ICNT)=0.0
18135        IDIGIT(ICNT)=-1
18136        ICNT=ICNT+1
18137        ITEXT(ICNT)='Bartlett CDF Value:'
18138        NCTEXT(ICNT)=19
18139        AVALUE(ICNT)=CDFBAR
18140        IDIGIT(ICNT)=NUMDIG
18141        ICNT=ICNT+1
18142        ITEXT(ICNT)='Difference (Delta) in Means:'
18143        NCTEXT(ICNT)=28
18144        AVALUE(ICNT)=DEL
18145        IDIGIT(ICNT)=NUMDIG
18146        ICNT=ICNT+1
18147        ITEXT(ICNT)='Standard Deviation of Delta:'
18148        NCTEXT(ICNT)=28
18149        AVALUE(ICNT)=DELSD2
18150        IDIGIT(ICNT)=NUMDIG
18151        ICNT=ICNT+1
18152        ITEXT(ICNT)='t-Test Statistic Value:'
18153        NCTEXT(ICNT)=23
18154        AVALUE(ICNT)=STATV2
18155        IDIGIT(ICNT)=NUMDIG
18156        ICNT=ICNT+1
18157        ITEXT(ICNT)='Degrees of Freedom:'
18158        NCTEXT(ICNT)=19
18159        AVALUE(ICNT)=STATN2
18160        IDIGIT(ICNT)=0
18161        ICNT=ICNT+1
18162        ITEXT(ICNT)='CDF Value:'
18163        NCTEXT(ICNT)=10
18164        AVALUE(ICNT)=STATC2
18165        IDIGIT(ICNT)=NUMDIG
18166        ICNT=ICNT+1
18167        ITEXT(ICNT)='P-Value (2-tailed test):'
18168        NCTEXT(ICNT)=24
18169        AVALUE(ICNT)=PVAL2T
18170        IDIGIT(ICNT)=NUMDIG
18171        ICNT=ICNT+1
18172        ITEXT(ICNT)='P-Value (lower-tailed test):'
18173        NCTEXT(ICNT)=28
18174        AVALUE(ICNT)=PVALLT
18175        IDIGIT(ICNT)=NUMDIG
18176        ICNT=ICNT+1
18177        ITEXT(ICNT)='P-Value (upper-tailed test):'
18178        NCTEXT(ICNT)=28
18179        AVALUE(ICNT)=PVALUT
18180        IDIGIT(ICNT)=NUMDIG
18181      ENDIF
18182C
18183      NUMROW=ICNT
18184      DO3110I=1,NUMROW
18185        NTOT(I)=15
18186 3110 CONTINUE
18187C
18188      IFRST=.TRUE.
18189      ILAST=.TRUE.
18190C
18191      ISTEPN='31A'
18192      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
18193     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18194C
18195      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
18196     1            AVALUE,IDIGIT,
18197     1            NTOT,NUMROW,
18198     1            ICAPSW,ICAPTY,ILAST,IFRST,
18199     1            ISUBRO,IBUGA3,IERROR)
18200C
18201      ISTEPN='31B'
18202      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
18203     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18204C
18205      DO3199ICASE=1,2
18206C
18207        IF(ICASE.EQ.1 .AND. ITTEVA.EQ.'UNEQ')GOTO3199
18208        IF(ICASE.EQ.2 .AND. ITTEVA.EQ.'EQUA')GOTO3199
18209C
18210        IF(ICASE.EQ.1)THEN
18211          ITITLE='Two-Tailed Test (Assume Equal Variances)'
18212          NCTITL=40
18213          STATV=STATVA
18214          STATC=STATCD
18215          STATN=STATNU
18216          PVALL=STATCD
18217          PVALU=1.0 - STATCD
18218          IF(STATVA.LE.0.0)THEN
18219            PVAL2=2.0*STATCD
18220          ELSE
18221            PVAL2=2.0*(1.0 - STATCD)
18222          ENDIF
18223        ELSEIF(ICASE.EQ.2)THEN
18224          ITITLE='Two-Tailed Test (Assume Unequal Variances)'
18225          NCTITL=42
18226          STATV=STATV2
18227          STATC=STATC2
18228          STATN=STATN2
18229          PVAL2=PVAL2T
18230          PVALL=PVALLT
18231          PVALU=PVALUT
18232        ENDIF
18233C
18234        CALL TPPF(.0005,STATN,CTL999)
18235        CALL TPPF(.005,STATN,CUTL99)
18236        CALL TPPF(.025,STATN,CUTL95)
18237        CALL TPPF(.05,STATN,CUTL90)
18238        CALL TPPF(.1,STATN,CUTL80)
18239        CALL TPPF(.25,STATN,CUTL50)
18240        CALL TPPF(.75,STATN,CUTU50)
18241        CALL TPPF(.90,STATN,CUTU80)
18242        CALL TPPF(.95,STATN,CUTU90)
18243        CALL TPPF(.975,STATN,CUTU95)
18244        CALL TPPF(.995,STATN,CUTU99)
18245        CALL TPPF(.9995,STATN,CTU999)
18246C
18247        ITITL9='H0: u1 = u2; Ha: u1 <> u2'
18248        NCTIT9=25
18249C
18250        DO3130J=1,4
18251          DO3140I=1,3
18252            ITITL2(I,J)=' '
18253            NCTIT2(I,J)=0
18254 3140     CONTINUE
18255 3130   CONTINUE
18256C
18257        ITITL2(2,1)='Significance'
18258        NCTIT2(2,1)=12
18259        ITITL2(3,1)='Level'
18260        NCTIT2(3,1)=5
18261C
18262        ITITL2(2,2)='Test '
18263        NCTIT2(2,2)=4
18264        ITITL2(3,2)='Statistic'
18265        NCTIT2(3,2)=9
18266C
18267        ITITL2(2,3)='Critical'
18268        NCTIT2(2,3)=8
18269        ITITL2(3,3)='Value (+/-)'
18270        NCTIT2(3,3)=11
18271C
18272        ITITL2(1,4)='Null'
18273        NCTIT2(1,4)=4
18274        ITITL2(2,4)='Hypothesis'
18275        NCTIT2(2,4)=10
18276        ITITL2(3,4)='Conclusion'
18277        NCTIT2(3,4)=10
18278C
18279        NMAX=0
18280        NUMCOL=4
18281        DO3150I=1,NUMCOL
18282          VALIGN(I)='b'
18283          ALIGN(I)='r'
18284          NTOT(I)=15
18285          NMAX=NMAX+NTOT(I)
18286          ITYPCO(I)='NUME'
18287          IDIGIT(I)=NUMDIG
18288          IF(I.EQ.1 .OR. I.EQ.4)THEN
18289            ITYPCO(I)='ALPH'
18290          ENDIF
18291 3150   CONTINUE
18292C
18293        IWHTML(1)=125
18294        IWHTML(2)=175
18295        IWHTML(3)=175
18296        IWHTML(4)=175
18297        IINC=1800
18298        IINC2=1400
18299        IWRTF(1)=IINC
18300        IWRTF(2)=IWRTF(1)+IINC
18301        IWRTF(3)=IWRTF(2)+IINC
18302        IWRTF(4)=IWRTF(3)+IINC
18303C
18304        DO3160J=1,NUMALP
18305          AMAT(J,2)=STATV
18306          IF(J.EQ.1)THEN
18307            AMAT(J,3)=CUTU50
18308          ELSEIF(J.EQ.2)THEN
18309            AMAT(J,3)=CUTU80
18310          ELSEIF(J.EQ.3)THEN
18311            AMAT(J,3)=CUTU90
18312          ELSEIF(J.EQ.4)THEN
18313            AMAT(J,3)=CUTU95
18314          ELSEIF(J.EQ.5)THEN
18315            AMAT(J,3)=CUTU99
18316          ELSEIF(J.EQ.6)THEN
18317            AMAT(J,3)=CTU999
18318          ENDIF
18319          IVALUE(J,4)(1:6)='REJECT'
18320          IF(ABS(STATV).LT.AMAT(J,3))THEN
18321            IVALUE(J,4)(1:6)='ACCEPT'
18322          ENDIF
18323          NCVALU(J,4)=6
18324C
18325          ALPHAT=100.0*ALPHA(J)
18326          WRITE(IVALUE(J,1)(1:4),'(F4.1)')ALPHAT
18327          IVALUE(J,1)(5:5)='%'
18328          NCVALU(J,1)=5
18329 3160   CONTINUE
18330C
18331        ICNT=NUMALP
18332        NUMLIN=3
18333        IFRST=.TRUE.
18334        ILAST=.TRUE.
18335        IFLAGS=.TRUE.
18336        IFLAGE=.TRUE.
18337        IF(ICASA3.NE.'LOWE' .AND. ICASA3.NE.'UPPE')THEN
18338          CALL DPDTA5(ITITLE,NCTITL,
18339     1                ITITL9,NCTIT9,ITITL2,NCTIT2,
18340     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18341     1                IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
18342     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18343     1                ICAPSW,ICAPTY,IFRST,ILAST,
18344     1                IFLAGS,IFLAGE,
18345     1                ISUBRO,IBUGA3,IERROR)
18346        ENDIF
18347        IF(ICASA3.EQ.'TWOT')GOTO3199
18348C
18349        IF(ICASE.EQ.1)THEN
18350          ITITLE='Lower One-Tailed Test (Assume Equal Variances)'
18351          NCTITL=46
18352        ELSEIF(ICASE.EQ.2)THEN
18353          ITITLE='Lower One-Tailed Test (Assume Unequal Variances)'
18354          NCTITL=48
18355        ENDIF
18356C
18357        ITITL9='H0: u1 = u2; Ha: u1 < u2'
18358        NCTIT9=24
18359C
18360        ITITL2(2,3)='Critical'
18361        NCTIT2(2,3)=8
18362        ITITL2(3,3)='Value (<)'
18363        NCTIT2(3,3)=9
18364C
18365        NMAX=0
18366        NUMCOL=4
18367        DO3250I=1,NUMCOL
18368          NTOT(I)=15
18369          NMAX=NMAX+NTOT(I)
18370 3250   CONTINUE
18371C
18372        DO3260J=1,NUMALP
18373          ALPHAT=ALPHA(J)
18374          CALL TPPF(ALPHAT,STATN,ATEMP)
18375          AMAT(J,3)=-ATEMP
18376          IVALUE(J,4)(1:6)='REJECT'
18377          IF(STATV.GE.AMAT(J,3))THEN
18378            IVALUE(J,4)(1:6)='ACCEPT'
18379          ENDIF
18380          NCVALU(J,4)=6
18381 3260   CONTINUE
18382C
18383        ICNT=NUMALP
18384        NUMLIN=3
18385        IFRST=.TRUE.
18386        ILAST=.TRUE.
18387        IFLAGS=.TRUE.
18388        IFLAGE=.TRUE.
18389        IF(ICASA3.NE.'UPPE')THEN
18390          CALL DPDTA5(ITITLE,NCTITL,
18391     1                ITITL9,NCTIT9,ITITL2,NCTIT2,
18392     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18393     1                IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
18394     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18395     1                ICAPSW,ICAPTY,IFRST,ILAST,
18396     1                IFLAGS,IFLAGE,
18397     1                ISUBRO,IBUGA3,IERROR)
18398        ENDIF
18399C
18400        IF(ICASA3.EQ.'LOWE')GOTO3199
18401C
18402        IF(ICASE.EQ.1)THEN
18403          ITITLE='Upper One-Tailed Test (Assume Equal Variances)'
18404          NCTITL=46
18405        ELSEIF(ICASE.EQ.2)THEN
18406          ITITLE='Upper One-Tailed Test (Assume Unequal Variances)'
18407          NCTITL=48
18408        ENDIF
18409C
18410        ITITL9='H0: u1 = u2; Ha: u1 > u2'
18411        NCTIT9=24
18412C
18413        ITITL2(2,3)='Critical'
18414        NCTIT2(2,3)=8
18415        ITITL2(3,3)='Value (>)'
18416        NCTIT2(3,3)=9
18417C
18418        NMAX=0
18419        NUMCOL=4
18420        DO3350I=1,NUMCOL
18421          NTOT(I)=15
18422          NMAX=NMAX+NTOT(I)
18423 3350   CONTINUE
18424C
18425        DO3360J=1,NUMALP
18426          ALPHAT=ALPHA(J)
18427          CALL TPPF(ALPHAT,STATN,ATEMP)
18428          AMAT(J,3)=ATEMP
18429          IVALUE(J,4)(1:6)='REJECT'
18430          IF(STATV.LE.AMAT(J,3))THEN
18431            IVALUE(J,4)(1:6)='ACCEPT'
18432          ENDIF
18433          NCVALU(J,4)=6
18434 3360   CONTINUE
18435C
18436        ICNT=NUMALP
18437        NUMLIN=3
18438        IFRST=.TRUE.
18439        ILAST=.TRUE.
18440        IFLAGS=.TRUE.
18441        IFLAGE=.TRUE.
18442        CALL DPDTA5(ITITLE,NCTITL,
18443     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
18444     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18445     1              IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
18446     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18447     1              ICAPSW,ICAPTY,IFRST,ILAST,
18448     1              IFLAGS,IFLAGE,
18449     1              ISUBRO,IBUGA3,IERROR)
18450C
18451 3199 CONTINUE
18452C
18453      GOTO9000
18454C
18455 4100 CONTINUE
18456C
18457      ISTEPN='41'
18458      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
18459     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18460C
18461      CALL DPTTE6(Y1,N1,Y2,N2,XTEMP1,IWRITE,
18462     1            STATVA,STATCD,STATNU,
18463     1            Y1MEAN,Y1SD,Y1SDM,
18464     1            Y2MEAN,Y2SD,Y2SDM,
18465     1            YDMEAN,YDSD,YDSDM,
18466     1            PVAL2T,PVALLT,PVALUT,
18467     1            ISUBRO,IBUGA3,IERROR)
18468      IF(IERROR.EQ.'YES')GOTO9000
18469C
18470      CALL TPPF(.0005,STATNU,CTL999)
18471      CALL TPPF(.005,STATNU,CUTL99)
18472      CALL TPPF(.025,STATNU,CUTL95)
18473      CALL TPPF(.05,STATNU,CUTL90)
18474      CALL TPPF(.1,STATNU,CUTL80)
18475      CALL TPPF(.25,STATNU,CUTL50)
18476      CALL TPPF(.75,STATNU,CUTU50)
18477      CALL TPPF(.90,STATNU,CUTU80)
18478      CALL TPPF(.95,STATNU,CUTU90)
18479      CALL TPPF(.975,STATNU,CUTU95)
18480      CALL TPPF(.995,STATNU,CUTU99)
18481      CALL TPPF(.9995,STATNU,CTU999)
18482C
18483C               ******************************
18484C               **   STEP 32--              **
18485C               **   WRITE OUT EVERYTHING   **
18486C               **   FOR A 2-SAMPLE T TEST  **
18487C               ******************************
18488C
18489      ISTEPN='42'
18490      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
18491     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18492C
18493      IF(IPRINT.EQ.'OFF')GOTO9000
18494C
18495      ITITLE='Two Sample Paired t-Test for Equal Means'
18496      NCTITL=41
18497      ITITLZ=' '
18498      NCTITZ=0
18499C
18500      ICNT=1
18501      ITEXT(ICNT)=' '
18502      NCTEXT(ICNT)=0
18503      AVALUE(ICNT)=0.0
18504      IDIGIT(ICNT)=-1
18505C
18506      ICNT=ICNT+1
18507      ITEXT(ICNT)='First Response Variable:  '
18508      WRITE(ITEXT(ICNT)(27:30),'(A4)')IVARID(1:4)
18509      WRITE(ITEXT(ICNT)(31:34),'(A4)')IVARI2(1:4)
18510      NCTEXT(ICNT)=34
18511      AVALUE(ICNT)=0.0
18512      IDIGIT(ICNT)=-1
18513C
18514      ICNT=ICNT+1
18515      ITEXT(ICNT)='Second Response Variable: '
18516      WRITE(ITEXT(ICNT)(27:30),'(A4)')IVARI3(1:4)
18517      WRITE(ITEXT(ICNT)(31:34),'(A4)')IVARI4(1:4)
18518      NCTEXT(ICNT)=34
18519      AVALUE(ICNT)=0.0
18520      IDIGIT(ICNT)=-1
18521C
18522      ICNT=ICNT+1
18523      ITEXT(ICNT)=' '
18524      NCTEXT(ICNT)=0
18525      AVALUE(ICNT)=0.0
18526      IDIGIT(ICNT)=-1
18527C
18528      ICNT=ICNT+1
18529      ITEXT(ICNT)='H0: Population Means Are Equal (u1=u2)'
18530      NCTEXT(ICNT)=30
18531      AVALUE(ICNT)=0.0
18532      IDIGIT(ICNT)=-1
18533      ICNT=ICNT+1
18534      ITEXT(ICNT)='Ha: Population Means Are Not Equal'
18535      NCTEXT(ICNT)=34
18536      AVALUE(ICNT)=0.0
18537      IDIGIT(ICNT)=-1
18538C
18539      ICNT=ICNT+1
18540      ITEXT(ICNT)=' '
18541      NCTEXT(ICNT)=1
18542      AVALUE(ICNT)=0.0
18543      IDIGIT(ICNT)=-1
18544C
18545      ICNT=ICNT+1
18546      ITEXT(ICNT)='Sample One Summary Statistics:'
18547      NCTEXT(ICNT)=30
18548      AVALUE(ICNT)=0.0
18549      IDIGIT(ICNT)=-1
18550      ICNT=ICNT+1
18551      ITEXT(ICNT)='Number of Observations:'
18552      NCTEXT(ICNT)=23
18553      AVALUE(ICNT)=REAL(N1)
18554      IDIGIT(ICNT)=0
18555      ICNT=ICNT+1
18556      ITEXT(ICNT)='Sample Mean:'
18557      NCTEXT(ICNT)=12
18558      AVALUE(ICNT)=Y1MEAN
18559      IDIGIT(ICNT)=NUMDIG
18560      ICNT=ICNT+1
18561      ITEXT(ICNT)='Sample Standard Deviation:'
18562      NCTEXT(ICNT)=26
18563      AVALUE(ICNT)=Y1SD
18564      IDIGIT(ICNT)=NUMDIG
18565      ICNT=ICNT+1
18566      ITEXT(ICNT)=' '
18567      NCTEXT(ICNT)=1
18568      AVALUE(ICNT)=0.0
18569      IDIGIT(ICNT)=-1
18570C
18571      ICNT=ICNT+1
18572      ITEXT(ICNT)='Sample Two Summary Statistics:'
18573      NCTEXT(ICNT)=30
18574      AVALUE(ICNT)=0.0
18575      IDIGIT(ICNT)=-1
18576      ICNT=ICNT+1
18577      ITEXT(ICNT)='Number of Observations:'
18578      NCTEXT(ICNT)=23
18579      AVALUE(ICNT)=REAL(N2)
18580      IDIGIT(ICNT)=0
18581      ICNT=ICNT+1
18582      ITEXT(ICNT)='Sample Mean:'
18583      NCTEXT(ICNT)=12
18584      AVALUE(ICNT)=Y2MEAN
18585      IDIGIT(ICNT)=NUMDIG
18586      ICNT=ICNT+1
18587      ITEXT(ICNT)='Sample Standard Deviation:'
18588      NCTEXT(ICNT)=26
18589      AVALUE(ICNT)=Y2SD
18590      IDIGIT(ICNT)=NUMDIG
18591      ICNT=ICNT+1
18592      ITEXT(ICNT)=' '
18593      NCTEXT(ICNT)=1
18594      AVALUE(ICNT)=0.0
18595      IDIGIT(ICNT)=-1
18596C
18597      ICNT=ICNT+1
18598      ITEXT(ICNT)='Summary Statistics of Paired Data:'
18599      NCTEXT(ICNT)=34
18600      AVALUE(ICNT)=0.0
18601      IDIGIT(ICNT)=-1
18602      ICNT=ICNT+1
18603      ITEXT(ICNT)='Number of Observations:'
18604      NCTEXT(ICNT)=23
18605      AVALUE(ICNT)=REAL(N1)
18606      IDIGIT(ICNT)=0
18607      ICNT=ICNT+1
18608      ITEXT(ICNT)='Sample Mean:'
18609      NCTEXT(ICNT)=12
18610      AVALUE(ICNT)=YDMEAN
18611      IDIGIT(ICNT)=NUMDIG
18612      ICNT=ICNT+1
18613      ITEXT(ICNT)='Sample Standard Deviation:'
18614      NCTEXT(ICNT)=26
18615      AVALUE(ICNT)=YDSD
18616      IDIGIT(ICNT)=NUMDIG
18617      ICNT=ICNT+1
18618      ITEXT(ICNT)='Sample Standard Deviation of the Mean:'
18619      NCTEXT(ICNT)=38
18620      AVALUE(ICNT)=YDSDM
18621      IDIGIT(ICNT)=NUMDIG
18622      ICNT=ICNT+1
18623      ITEXT(ICNT)=' '
18624      NCTEXT(ICNT)=1
18625      AVALUE(ICNT)=0.0
18626      IDIGIT(ICNT)=-1
18627C
18628      ICNT=ICNT+1
18629      ITEXT(ICNT)='Test:'
18630      NCTEXT(ICNT)=5
18631      AVALUE(ICNT)=0.0
18632      IDIGIT(ICNT)=-1
18633      ICNT=ICNT+1
18634      ITEXT(ICNT)='Difference (Delta) in Means:'
18635      NCTEXT(ICNT)=28
18636      DEL=Y1MEAN-Y2MEAN
18637      AVALUE(ICNT)=DEL
18638      IDIGIT(ICNT)=NUMDIG
18639      ICNT=ICNT+1
18640      ITEXT(ICNT)='t-Test Statistic Value:'
18641      NCTEXT(ICNT)=23
18642      AVALUE(ICNT)=STATVA
18643      IDIGIT(ICNT)=NUMDIG
18644      ICNT=ICNT+1
18645      ITEXT(ICNT)='Degrees of Freedom:'
18646      NCTEXT(ICNT)=19
18647      AVALUE(ICNT)=STATNU
18648      IDIGIT(ICNT)=0
18649      ICNT=ICNT+1
18650      ITEXT(ICNT)='CDF Value:'
18651      NCTEXT(ICNT)=10
18652      AVALUE(ICNT)=STATCD
18653      IDIGIT(ICNT)=NUMDIG
18654      ICNT=ICNT+1
18655      ITEXT(ICNT)='P-Value (2-tailed test):'
18656      NCTEXT(ICNT)=24
18657      AVALUE(ICNT)=PVAL2T
18658      IDIGIT(ICNT)=NUMDIG
18659      ICNT=ICNT+1
18660      ITEXT(ICNT)='P-Value (lower-tailed test):'
18661      NCTEXT(ICNT)=28
18662      AVALUE(ICNT)=PVALLT
18663      IDIGIT(ICNT)=NUMDIG
18664      ICNT=ICNT+1
18665      ITEXT(ICNT)='P-Value (upper-tailed test):'
18666      NCTEXT(ICNT)=28
18667      AVALUE(ICNT)=PVALUT
18668      IDIGIT(ICNT)=NUMDIG
18669      NUMROW=ICNT
18670      DO4110I=1,NUMROW
18671        NTOT(I)=15
18672 4110 CONTINUE
18673C
18674      IFRST=.TRUE.
18675      ILAST=.TRUE.
18676C
18677      ISTEPN='31A'
18678      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
18679     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18680C
18681      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
18682     1            AVALUE,IDIGIT,
18683     1            NTOT,NUMROW,
18684     1            ICAPSW,ICAPTY,ILAST,IFRST,
18685     1            ISUBRO,IBUGA3,IERROR)
18686C
18687      ISTEPN='31B'
18688      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TTE2')
18689     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18690C
18691      ITITLE='Two-Tailed Test'
18692      NCTITL=15
18693      ITITL9='H0: u1 = u2; Ha: u1 <> u2'
18694      NCTIT9=25
18695C
18696      DO4130J=1,4
18697        DO4140I=1,3
18698          ITITL2(I,J)=' '
18699          NCTIT2(I,J)=0
18700 4140   CONTINUE
18701 4130 CONTINUE
18702C
18703      ITITL2(2,1)='Significance'
18704      NCTIT2(2,1)=12
18705      ITITL2(3,1)='Level'
18706      NCTIT2(3,1)=5
18707C
18708      ITITL2(2,2)='Test '
18709      NCTIT2(2,2)=4
18710      ITITL2(3,2)='Statistic'
18711      NCTIT2(3,2)=9
18712C
18713      ITITL2(2,3)='Critical'
18714      NCTIT2(2,3)=8
18715      ITITL2(3,3)='Value (+/-)'
18716      NCTIT2(3,3)=11
18717C
18718      ITITL2(1,4)='Null'
18719      NCTIT2(1,4)=4
18720      ITITL2(2,4)='Hypothesis'
18721      NCTIT2(2,4)=10
18722      ITITL2(3,4)='Conclusion'
18723      NCTIT2(3,4)=10
18724C
18725      NMAX=0
18726      NUMCOL=4
18727      DO4150I=1,NUMCOL
18728        VALIGN(I)='b'
18729        ALIGN(I)='r'
18730        NTOT(I)=15
18731        NMAX=NMAX+NTOT(I)
18732        ITYPCO(I)='NUME'
18733        IDIGIT(I)=NUMDIG
18734        IF(I.EQ.1 .OR. I.EQ.4)THEN
18735          ITYPCO(I)='ALPH'
18736        ENDIF
18737 4150 CONTINUE
18738C
18739      IWHTML(1)=125
18740      IWHTML(2)=175
18741      IWHTML(3)=175
18742      IWHTML(4)=175
18743      IINC=1800
18744      IINC2=1400
18745      IWRTF(1)=IINC
18746      IWRTF(2)=IWRTF(1)+IINC
18747      IWRTF(3)=IWRTF(2)+IINC
18748      IWRTF(4)=IWRTF(3)+IINC
18749C
18750      DO4160J=1,NUMALP
18751        AMAT(J,2)=STATVA
18752        IF(J.EQ.1)THEN
18753          AMAT(J,3)=CUTU50
18754        ELSEIF(J.EQ.2)THEN
18755          AMAT(J,3)=CUTU80
18756        ELSEIF(J.EQ.3)THEN
18757          AMAT(J,3)=CUTU90
18758        ELSEIF(J.EQ.4)THEN
18759          AMAT(J,3)=CUTU95
18760        ELSEIF(J.EQ.5)THEN
18761          AMAT(J,3)=CUTU99
18762        ELSEIF(J.EQ.6)THEN
18763          AMAT(J,3)=CTU999
18764        ENDIF
18765        IVALUE(J,4)(1:6)='REJECT'
18766        IF(ABS(STATVA).LT.AMAT(J,3))THEN
18767          IVALUE(J,4)(1:6)='ACCEPT'
18768        ENDIF
18769        NCVALU(J,4)=6
18770C
18771        ALPHAT=100.0*ALPHA(J)
18772        WRITE(IVALUE(J,1)(1:4),'(F4.1)')ALPHAT
18773        IVALUE(J,1)(5:5)='%'
18774        NCVALU(J,1)=5
18775 4160 CONTINUE
18776C
18777      ICNT=NUMALP
18778      NUMLIN=3
18779      IFRST=.TRUE.
18780      ILAST=.TRUE.
18781      IFLAGS=.TRUE.
18782      IFLAGE=.TRUE.
18783      IF(ICASA3.NE.'LOWE' .AND. ICASA3.NE.'UPPE')THEN
18784        CALL DPDTA5(ITITLE,NCTITL,
18785     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
18786     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18787     1              IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
18788     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18789     1              ICAPSW,ICAPTY,IFRST,ILAST,
18790     1              IFLAGS,IFLAGE,
18791     1              ISUBRO,IBUGA3,IERROR)
18792      ENDIF
18793      IF(ICASA3.EQ.'TWOT')GOTO9000
18794C
18795      ITITLE='Lower One-Tailed Test'
18796      NCTITL=21
18797      ITITL9='H0: u1 = u2; Ha: u1 < u2'
18798      NCTIT9=24
18799C
18800      ITITL2(2,3)='Critical'
18801      NCTIT2(2,3)=8
18802      ITITL2(3,3)='Value (<)'
18803      NCTIT2(3,3)=9
18804C
18805      NMAX=0
18806      NUMCOL=4
18807      DO4250I=1,NUMCOL
18808        NTOT(I)=15
18809        NMAX=NMAX+NTOT(I)
18810 4250 CONTINUE
18811C
18812      DO4260J=1,NUMALP
18813        ALPHAT=ALPHA(J)
18814        CALL TPPF(ALPHAT,STATNU,ATEMP)
18815        AMAT(J,3)=-ATEMP
18816        IVALUE(J,4)(1:6)='REJECT'
18817        IF(STATVA.GE.AMAT(J,3))THEN
18818          IVALUE(J,4)(1:6)='ACCEPT'
18819        ENDIF
18820        NCVALU(J,4)=6
18821 4260 CONTINUE
18822C
18823      ICNT=NUMALP
18824      NUMLIN=3
18825      IFRST=.TRUE.
18826      ILAST=.TRUE.
18827      IFLAGS=.TRUE.
18828      IFLAGE=.TRUE.
18829      IF(ICASA3.NE.'UPPE')THEN
18830        CALL DPDTA5(ITITLE,NCTITL,
18831     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
18832     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18833     1              IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
18834     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18835     1              ICAPSW,ICAPTY,IFRST,ILAST,
18836     1              IFLAGS,IFLAGE,
18837     1              ISUBRO,IBUGA3,IERROR)
18838      ENDIF
18839C
18840      IF(ICASA3.EQ.'LOWE')GOTO9000
18841C
18842      ITITLE='Upper One-Tailed Test'
18843      NCTITL=21
18844      ITITL9='H0: u1 = u2; Ha: u1 > u2'
18845      NCTIT9=24
18846C
18847      ITITL2(2,3)='Critical'
18848      NCTIT2(2,3)=8
18849      ITITL2(3,3)='Value (>)'
18850      NCTIT2(3,3)=9
18851C
18852      NMAX=0
18853      NUMCOL=4
18854      DO4350I=1,NUMCOL
18855        NTOT(I)=15
18856        NMAX=NMAX+NTOT(I)
18857 4350 CONTINUE
18858C
18859      DO4360J=1,NUMALP
18860        ALPHAT=ALPHA(J)
18861        CALL TPPF(ALPHAT,STATNU,ATEMP)
18862        AMAT(J,3)=ATEMP
18863        IVALUE(J,4)(1:6)='REJECT'
18864        IF(STATVA.LE.AMAT(J,3))THEN
18865          IVALUE(J,4)(1:6)='ACCEPT'
18866        ENDIF
18867        NCVALU(J,4)=6
18868 4360 CONTINUE
18869C
18870      ICNT=NUMALP
18871      NUMLIN=3
18872      IFRST=.TRUE.
18873      ILAST=.TRUE.
18874      IFLAGS=.TRUE.
18875      IFLAGE=.TRUE.
18876      CALL DPDTA5(ITITLE,NCTITL,
18877     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
18878     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18879     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
18880     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18881     1            ICAPSW,ICAPTY,IFRST,ILAST,
18882     1            IFLAGS,IFLAGE,
18883     1            ISUBRO,IBUGA3,IERROR)
18884C
18885      GOTO9000
18886C               *****************
18887C               **  STEP 90--  **
18888C               **  EXIT       **
18889C               *****************
18890C
18891 9000 CONTINUE
18892      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TTE2')THEN
18893        WRITE(ICOUT,999)
18894        CALL DPWRST('XXX','WRIT')
18895        WRITE(ICOUT,9011)
18896 9011   FORMAT('***** AT THE END       OF DPTTE2--')
18897        CALL DPWRST('XXX','WRIT')
18898        WRITE(ICOUT,9013)STATVA,STATCD,PVAL2T,PVALLT,PVALUT
18899 9013   FORMAT('STATVA,STATCD,PVAL2T,PVALLT,PVALUT = ',5G15.7)
18900        CALL DPWRST('XXX','WRIT')
18901      ENDIF
18902C
18903      RETURN
18904      END
18905      SUBROUTINE DPTTE3(X,N,AMU,IWRITE,STATVA,STATCD,STATNU,
18906     1                  XMEAN,XSD,XSDM,DEL,
18907     1                  PVAL2T,PVALLT,PVALUT,
18908     1                  ISUBRO,IBUGA3,IERROR)
18909C
18910C     PURPOSE--THIS SUBROUTINE COMPUTES THE ONE SAMPLE T-TEST (AND
18911C              ALTERNATIVELY THE CDF VALUE).
18912C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
18913C                                (UNSORTED OR SORTED) OBSERVATIONS.
18914C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
18915C                                IN THE VECTOR X.
18916C                     --AMU    = THE SINGLE PRECISION VALUE FOR WHICH
18917C                                THE TEST IS PERFORMED (I.E.,
18918C                                H0: MU = AMU).
18919C     OUTPUT ARGUMENTS--STATVA = THE SINGLE PRECISION VALUE OF THE
18920C                                COMPUTED STATISTIC.
18921C                     --STATCD = THE SINGLE PRECISION VALUE OF THE
18922C                                COMPUTED CDF OF THE TEST STATISTIC.
18923C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
18924C             TEST STATISTIC.
18925C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
18926C                   OF N FOR THIS SUBROUTINE.
18927C     OTHER DATAPAC   SUBROUTINES NEEDED--TPPF.
18928C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
18929C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
18930C     LANGUAGE--ANSI FORTRAN (1977)
18931C     WRITTEN BY--JAMES J. FILLIBEN
18932C                 STATISTICAL ENGINEERING DIVISION
18933C                 INFORMATION TECHNOLOGY LABORATORY
18934C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18935C                 GAITHERSBURG, MD 20899-8980
18936C                 PHONE--301-975-2855
18937C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18938C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18939C     LANGUAGE--ANSI FORTRAN (1977)
18940C     VERSION NUMBER--2009.2
18941C     ORIGINAL VERSION--FEBRUARY  2009.
18942C
18943C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18944C
18945      CHARACTER*4 IWRITE
18946      CHARACTER*4 IWRTSV
18947      CHARACTER*4 ISUBRO
18948      CHARACTER*4 IBUGA3
18949      CHARACTER*4 IERROR
18950C
18951      CHARACTER*4 ISUBN1
18952      CHARACTER*4 ISUBN2
18953C
18954C---------------------------------------------------------------------
18955C
18956      DIMENSION X(*)
18957C
18958C-----COMMON----------------------------------------------------------
18959C
18960      INCLUDE 'DPCOP2.INC'
18961C
18962C-----START POINT-----------------------------------------------------
18963C
18964      ISUBN1='DPTT'
18965      ISUBN2='E3  '
18966      IWRTSV=IWRITE
18967C
18968      IERROR='NO'
18969C
18970      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TTE3')THEN
18971        WRITE(ICOUT,999)
18972  999   FORMAT(1X)
18973        CALL DPWRST('XXX','BUG ')
18974        WRITE(ICOUT,51)
18975   51   FORMAT('***** AT THE BEGINNING OF DPTTE3--')
18976        CALL DPWRST('XXX','BUG ')
18977        WRITE(ICOUT,52)IBUGA3
18978   52   FORMAT('IBUGA3 = ',A4)
18979        CALL DPWRST('XXX','BUG ')
18980        WRITE(ICOUT,53)N,ANU
18981   53   FORMAT('N,AMU = ',I8,G15.7)
18982        CALL DPWRST('XXX','BUG ')
18983        DO55I=1,N
18984          WRITE(ICOUT,56)I,X(I)
18985   56     FORMAT('I,X(I) = ',I8,G15.7)
18986          CALL DPWRST('XXX','BUG ')
18987   55   CONTINUE
18988      ENDIF
18989C
18990C               *********************************
18991C               **  COMPUTE ONE SAMPLE T-TEST  **
18992C               *********************************
18993C
18994C               ********************************************
18995C               **  STEP 1--                              **
18996C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
18997C               ********************************************
18998C
18999      STATVA=-99.0
19000      STATCD=-99.0
19001      STATNU=-99.0
19002      PVAL2T=-99.0
19003      PVALLT=-99.0
19004      PVALUT=-99.0
19005      IWRITE='OFF'
19006C
19007      AN=N
19008C
19009      IF(N.LE.1)THEN
19010        IERROR='YES'
19011        WRITE(ICOUT,999)
19012        CALL DPWRST('XXX','BUG ')
19013        WRITE(ICOUT,111)
19014  111   FORMAT('***** ERROR IN ONE SAMPLE T-TEST--')
19015        CALL DPWRST('XXX','BUG ')
19016        WRITE(ICOUT,112)
19017  112   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR THE ',
19018     1         'RESPONSE')
19019        CALL DPWRST('XXX','BUG ')
19020        WRITE(ICOUT,113)
19021  113   FORMAT('      VARIABLE MUST BE 2 OR LARGER.')
19022        CALL DPWRST('XXX','BUG ')
19023        WRITE(ICOUT,116)
19024  116   FORMAT('      SUCH WAS NOT THE CASE HERE.')
19025        CALL DPWRST('XXX','BUG ')
19026        WRITE(ICOUT,117)N
19027  117   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS HERE = ',I8,
19028     1         '.')
19029        CALL DPWRST('XXX','BUG ')
19030        GOTO9000
19031      ENDIF
19032C
19033C               *****************************************
19034C               **  STEP 2--                           **
19035C               **  COMPUTE THE ONE SAMPLE T-TEST.     **
19036C               *****************************************
19037C
19038      CALL MEAN(X,N,IWRITE,XMEAN,IBUGA3,IERROR)
19039      CALL SD(X,N,IWRITE,XSD,IBUGA3,IERROR)
19040      CALL SDMEAN(X,N,IWRITE,XSDM,IBUGA3,IERROR)
19041      DEL=XMEAN-AMU
19042      STATVA=DEL/XSDM
19043      IDF=N-1
19044      STATNU=REAL(IDF)
19045      CALL TCDF(STATVA,STATNU,STATCD)
19046C
19047      PVALLT=STATCD
19048      PVALUT=1.0 - STATCD
19049      IF(STATVA.LE.0.0)THEN
19050        PVAL2T=2.0*PVALLT
19051      ELSE
19052        PVAL2T=2.0*PVALUT
19053      ENDIF
19054C
19055C               *******************************
19056C               **  STEP 3--                 **
19057C               **  WRITE OUT A LINE         **
19058C               **  OF SUMMARY INFORMATION.  **
19059C               *******************************
19060C
19061      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
19062        WRITE(ICOUT,999)
19063        CALL DPWRST('XXX','BUG ')
19064        WRITE(ICOUT,811)N,STATVA
19065  811   FORMAT('THE VALUE OF THE ONE SAMPLE T-TEST OF THE ',I8,
19066     1         ' OBSERVATIONS = ',G15.7)
19067        CALL DPWRST('XXX','BUG ')
19068      ENDIF
19069C
19070C               *****************
19071C               **  STEP 90--  **
19072C               **  EXIT.      **
19073C               *****************
19074C
19075 9000 CONTINUE
19076C
19077      IWRITE=IWRTSV
19078C
19079      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TTE3')THEN
19080        WRITE(ICOUT,999)
19081        CALL DPWRST('XXX','BUG ')
19082        WRITE(ICOUT,9011)
19083 9011   FORMAT('***** AT THE END       OF DPTTE3--')
19084        CALL DPWRST('XXX','BUG ')
19085        WRITE(ICOUT,9012)IBUGA3,IERROR
19086 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
19087        CALL DPWRST('XXX','BUG ')
19088        WRITE(ICOUT,9015)STATVA,STATCD
19089 9015   FORMAT('STATVA,STATCD = ',2G15.7)
19090        CALL DPWRST('XXX','BUG ')
19091        WRITE(ICOUT,9016)XMEAN,XSD,XSDM
19092 9016   FORMAT('XMEAN,XSD,XSDM = ',3G15.7)
19093        CALL DPWRST('XXX','BUG ')
19094      ENDIF
19095C
19096      RETURN
19097      END
19098      SUBROUTINE DPTTE4(Y1,N1,Y2,N2,IWRITE,
19099     1                  STATVA,STATCD,STATNU,
19100     1                  STATV2,STATC2,STATN2,
19101     1                  Y1MEAN,Y1SD,Y1SDM,
19102     1                  Y2MEAN,Y2SD,Y2SDM,
19103     1                  DEL,POOLSD,DELSD,DELSD2,CDFBAR,
19104     1                  PVAL2T,PVALLT,PVALUT,
19105     1                  ISUBRO,IBUGA3,IERROR)
19106C
19107C     PURPOSE--THIS SUBROUTINE COMPUTES THE UNPAIRED TWO SAMPLE T-TEST
19108C              (AND ALTERNATIVELY THE CDF OR P-VALUES).
19109C     INPUT  ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
19110C                                (UNSORTED OR SORTED) OBSERVATIONS
19111C                                FOR THE FIRST RESPONSE VARIABLE.
19112C                     --N1     = THE INTEGER NUMBER OF OBSERVATIONS
19113C                                IN THE VECTOR Y1.
19114C                     --Y2     = THE SINGLE PRECISION VECTOR OF
19115C                                (UNSORTED OR SORTED) OBSERVATIONS
19116C                                FOR THE SECOND RESPONSE VARIABLE.
19117C                     --N2     = THE INTEGER NUMBER OF OBSERVATIONS
19118C                                IN THE VECTOR Y2.
19119C     OUTPUT ARGUMENTS--STATVA = THE SINGLE PRECISION VALUE OF THE
19120C                                COMPUTED STATISTIC.
19121C                     --STATCD = THE SINGLE PRECISION VALUE OF THE
19122C                                COMPUTED CDF OF THE TEST STATISTIC.
19123C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
19124C             TEST STATISTIC.
19125C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
19126C                   OF N FOR THIS SUBROUTINE.
19127C     OTHER DATAPAC   SUBROUTINES NEEDED--TPPF.
19128C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
19129C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
19130C     LANGUAGE--ANSI FORTRAN (1977)
19131C     WRITTEN BY--JAMES J. FILLIBEN
19132C                 STATISTICAL ENGINEERING DIVISION
19133C                 INFORMATION TECHNOLOGY LABORATORY
19134C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19135C                 GAITHERSBURG, MD 20899-8980
19136C                 PHONE--301-975-2855
19137C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19138C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19139C     LANGUAGE--ANSI FORTRAN (1977)
19140C     VERSION NUMBER--2011.4
19141C     ORIGINAL VERSION--APRIL     2011. EXTRACTED FROM DPTTE2 TO
19142C                                       ALLOWED IT TO BE CALLED FROM
19143C                                       CMPSTA (I.E., FOR USE AS A
19144C                                       "STATISTIC")
19145C
19146C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19147C
19148      CHARACTER*4 IWRITE
19149      CHARACTER*4 IWRTSV
19150      CHARACTER*4 ISUBRO
19151      CHARACTER*4 IBUGA3
19152      CHARACTER*4 IERROR
19153C
19154      CHARACTER*4 ISUBN1
19155      CHARACTER*4 ISUBN2
19156C
19157C---------------------------------------------------------------------
19158C
19159      DIMENSION Y1(*)
19160      DIMENSION Y2(*)
19161C
19162C-----COMMON----------------------------------------------------------
19163C
19164      INCLUDE 'DPCOP2.INC'
19165C
19166C-----START POINT-----------------------------------------------------
19167C
19168      ISUBN1='DPTT'
19169      ISUBN2='E4  '
19170      IWRTSV=IWRITE
19171      IERROR='NO'
19172C
19173      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TTE4')THEN
19174        WRITE(ICOUT,999)
19175  999   FORMAT(1X)
19176        CALL DPWRST('XXX','BUG ')
19177        WRITE(ICOUT,51)
19178   51   FORMAT('***** AT THE BEGINNING OF DPTTE4--')
19179        CALL DPWRST('XXX','BUG ')
19180        WRITE(ICOUT,52)IBUGA3,ISUBRO
19181   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
19182        CALL DPWRST('XXX','BUG ')
19183        WRITE(ICOUT,53)N1,N2
19184   53   FORMAT('N1,N2 = ',2I8)
19185        CALL DPWRST('XXX','BUG ')
19186        DO55I=1,N1
19187          WRITE(ICOUT,56)I,Y1(I)
19188   56     FORMAT('I,Y1(I) = ',I8,G15.7)
19189          CALL DPWRST('XXX','BUG ')
19190   55   CONTINUE
19191        DO65I=1,N1
19192          WRITE(ICOUT,66)I,Y2(I)
19193   66     FORMAT('I,Y2(I) = ',I8,G15.7)
19194          CALL DPWRST('XXX','BUG ')
19195   65   CONTINUE
19196      ENDIF
19197C
19198C               *********************************
19199C               **  COMPUTE TWO SAMPLE T-TEST  **
19200C               *********************************
19201C
19202C               ********************************************
19203C               **  STEP 1--                              **
19204C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
19205C               ********************************************
19206C
19207      STATVA=-99.0
19208      STATCD=-99.0
19209      STATNU=-99.0
19210      STATV2=-99.0
19211      STATC2=-99.0
19212      STATN2=-99.0
19213      PVAL2T=-99.0
19214      PVALLT=-99.0
19215      PVALUT=-99.0
19216      IWRITE='OFF'
19217C
19218      IF(N1.LT.2)THEN
19219        WRITE(ICOUT,999)
19220        CALL DPWRST('XXX','WRIT')
19221        WRITE(ICOUT,111)
19222  111   FORMAT('***** ERROR IN T-TEST--')
19223        CALL DPWRST('XXX','WRIT')
19224        WRITE(ICOUT,112)
19225  112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE FIRST ',
19226     1         'RESPONSE VARIABLE IS LESS THAN 2.')
19227        CALL DPWRST('XXX','WRIT')
19228        WRITE(ICOUT,113)N1
19229  113   FORMAT('SAMPLE SIZE = ',I8)
19230        CALL DPWRST('XXX','WRIT')
19231        IERROR='YES'
19232        GOTO9000
19233      ENDIF
19234C
19235      HOLD=Y1(1)
19236      DO135I=2,N1
19237        IF(Y1(I).NE.HOLD)GOTO139
19238  135 CONTINUE
19239      WRITE(ICOUT,999)
19240      CALL DPWRST('XXX','WRIT')
19241      WRITE(ICOUT,111)
19242      CALL DPWRST('XXX','WRIT')
19243      WRITE(ICOUT,131)HOLD
19244  131 FORMAT('      THE FIRST RESPONSE VARIABLE HAS ALL ELEMENTS = ',
19245     1       G15.7)
19246      CALL DPWRST('XXX','WRIT')
19247      GOTO9000
19248  139 CONTINUE
19249C
19250      IF(N2.LT.2)THEN
19251        WRITE(ICOUT,999)
19252        CALL DPWRST('XXX','WRIT')
19253        WRITE(ICOUT,111)
19254        CALL DPWRST('XXX','WRIT')
19255        WRITE(ICOUT,142)
19256  142   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE SECOND ',
19257     1         'RESPONSE VARIABLE IS LESS THAN 2.')
19258        CALL DPWRST('XXX','WRIT')
19259        WRITE(ICOUT,113)N2
19260        CALL DPWRST('XXX','WRIT')
19261        IERROR='YES'
19262        GOTO9000
19263      ENDIF
19264C
19265      HOLD=Y2(1)
19266      DO155I=2,N1
19267        IF(Y2(I).NE.HOLD)GOTO159
19268  155 CONTINUE
19269      WRITE(ICOUT,999)
19270      CALL DPWRST('XXX','WRIT')
19271      WRITE(ICOUT,111)
19272      CALL DPWRST('XXX','WRIT')
19273      WRITE(ICOUT,151)HOLD
19274  151 FORMAT('      THE SECOND RESPONSE VARIABLE HAS ALL ELEMENTS = ',
19275     1       G15.7)
19276      CALL DPWRST('XXX','WRIT')
19277      GOTO9000
19278  159 CONTINUE
19279C
19280C               **************************************************
19281C               **  STEP 2--                                    **
19282C               **  COMPUTE THE TWO SAMPLE UNPAIRED T-TEST.     **
19283C               **************************************************
19284C
19285      CALL MEAN(Y1,N1,IWRITE,Y1MEAN,IBUGA3,IERROR)
19286      CALL SD(Y1,N1,IWRITE,Y1SD,IBUGA3,IERROR)
19287      Y1VAR=Y1SD**2
19288      CALL SDMEAN(Y1,N1,IWRITE,Y1SDM,IBUGA3,IERROR)
19289C
19290      CALL MEAN(Y2,N2,IWRITE,Y2MEAN,IBUGA3,IERROR)
19291      CALL SD(Y2,N2,IWRITE,Y2SD,IBUGA3,IERROR)
19292      Y2VAR=Y2SD**2
19293      CALL SDMEAN(Y2,N2,IWRITE,Y2SDM,IBUGA3,IERROR)
19294C
19295      AN1=N1
19296      AN2=N2
19297C
19298      DEL=Y1MEAN-Y2MEAN
19299      POOLSS=(AN1-1.0)*Y1VAR+(AN2-1.0)*Y2VAR
19300      POOLVA=POOLSS/(AN1+AN2-2.0)
19301      POOLSD=SQRT(POOLVA)
19302      POOLN=1.0/((1.0/AN1)+(1.0/AN2))
19303      DELSD=POOLSD/SQRT(POOLN)
19304      STATVA=DEL/DELSD
19305      IDF=N1+N2-2
19306      STATNU=REAL(IDF)
19307      CALL TCDF(STATVA,STATNU,STATCD)
19308C
19309      DEL2=DEL
19310      DELVA2=(Y1VAR/AN1)+(Y2VAR/AN2)
19311      DELSD2=SQRT(DELVA2)
19312      STATV2=DEL2/DELSD2
19313      C=(Y1VAR/AN1)/((Y1VAR/AN1)+(Y2VAR/AN2))
19314      TERM1=C*C/(AN1-1.0)
19315      TERM2=(1-C)*(1-C)/(AN2-1.0)
19316      SUM=TERM1+TERM2
19317      STATN2=1.0/SUM
19318      CALL TCDF(STATV2,STATN2,STATC2)
19319C
19320      TERM11=1.0/(AN1-1.0)
19321      TERM12=1.0/(AN2-1.0)
19322      TERM13=1.0/(AN1+AN2-2.0)
19323      SUMC=TERM11+TERM12-TERM13
19324      CBART=1.0+SUMC/3.0
19325      TERM21=(AN1-1.0)*2*LOG(Y1SD/POOLSD)
19326      TERM22=(AN2-1.0)*2*LOG(Y2SD/POOLSD)
19327      BBART=(-TERM21-TERM22)
19328      BART=BBART/CBART
19329      IDFBAR=1
19330      CALL CHSCDF(BART,IDFBAR,CDFBAR)
19331C
19332      PVALLT=STATC2
19333      PVALUT=1.0 - STATC2
19334      IF(STATV2.LE.0.0)THEN
19335        PVAL2T=2.0*PVALLT
19336      ELSE
19337        PVAL2T=2.0*PVALUT
19338      ENDIF
19339C
19340C               *******************************
19341C               **  STEP 3--                 **
19342C               **  WRITE OUT A LINE         **
19343C               **  OF SUMMARY INFORMATION.  **
19344C               *******************************
19345C
19346      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
19347        WRITE(ICOUT,999)
19348        CALL DPWRST('XXX','BUG ')
19349        WRITE(ICOUT,811)STATVA
19350  811   FORMAT('THE VALUE OF THE TWO SAMPLE T-TEST = ',G15.7)
19351        CALL DPWRST('XXX','BUG ')
19352      ENDIF
19353C
19354C               *****************
19355C               **  STEP 90--  **
19356C               **  EXIT.      **
19357C               *****************
19358C
19359 9000 CONTINUE
19360C
19361      IWRITE=IWRTSV
19362C
19363      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TTE4')THEN
19364        WRITE(ICOUT,999)
19365        CALL DPWRST('XXX','BUG ')
19366        WRITE(ICOUT,9011)
19367 9011   FORMAT('***** AT THE END       OF DPTTE4--')
19368        CALL DPWRST('XXX','BUG ')
19369        WRITE(ICOUT,9012)IERROR
19370 9012   FORMAT('IERROR = ',A4)
19371        CALL DPWRST('XXX','BUG ')
19372        WRITE(ICOUT,9015)STATVA,STATCD,STATNU
19373 9015   FORMAT('STATVA,STATCD,STATNU = ',3G15.7)
19374        CALL DPWRST('XXX','BUG ')
19375        WRITE(ICOUT,9016)STATV2,STATC2,STATN2
19376 9016   FORMAT('STATV2,STATC2,STATN2 = ',3G15.7)
19377        CALL DPWRST('XXX','BUG ')
19378        WRITE(ICOUT,9017)Y1MEAN,Y1SD,Y1SDM
19379 9017   FORMAT('Y1MEAN,Y1SD,Y1SDM = ',3G15.7)
19380        CALL DPWRST('XXX','BUG ')
19381        WRITE(ICOUT,9018)Y2MEAN,Y2SD,Y2SDM
19382 9018   FORMAT('Y2MEAN,Y2SD,Y2SDM = ',3G15.7)
19383        CALL DPWRST('XXX','BUG ')
19384      ENDIF
19385C
19386      RETURN
19387      END
19388      SUBROUTINE DPTTE5(ICASAN,STATVA,STATCD,STATNU,
19389     1                  STATV2,STATC2,STATN2,
19390     1                  PVAL2T,PVALLT,PVALUT,
19391     1                  CTL999,CUTL99,CUTL95,CUTL90,CUTL80,CUTL50,
19392     1                  CTU999,CUTU99,CUTU95,CUTU90,CUTU80,CUTU50,
19393     1                  IFLAGU,IFRST,ILAST,
19394     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
19395C
19396C     PURPOSE--UTILITY ROUTINE USED BY DPTTES TO UPDATE VARIOUS
19397C              INTERNAL PARAMETERS AFTER A T-TEST.
19398C
19399C     WRITTEN BY--ALAN HECKERT
19400C                 STATISTICAL ENGINEERING DIVISION
19401C                 INFORMATION TECHNOLOGY LABORAOTRY
19402C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
19403C                 GAITHERSBURG, MD 20899-8980
19404C                 PHONE--301-975-2899
19405C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19406C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
19407C     LANGUAGE--ANSI FORTRAN (1977)
19408C     VERSION NUMBER--2011/4
19409C     ORIGINAL VERSION--APRIL     2011.
19410C
19411C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19412C
19413      CHARACTER*4 ICASAN
19414      CHARACTER*4 IFLAGU
19415      CHARACTER*4 IBUGA2
19416      CHARACTER*4 IBUGA3
19417      CHARACTER*4 ISUBRO
19418      CHARACTER*4 IERROR
19419C
19420      LOGICAL IFRST
19421      LOGICAL ILAST
19422C
19423      CHARACTER*4 IH
19424      CHARACTER*4 IH2
19425      CHARACTER*4 ISUBN0
19426C
19427      CHARACTER*4 ISUBN1
19428      CHARACTER*4 ISUBN2
19429      CHARACTER*4 ISTEPN
19430C
19431C---------------------------------------------------------------------
19432C
19433      INCLUDE 'DPCOPA.INC'
19434      INCLUDE 'DPCOHK.INC'
19435      INCLUDE 'DPCOHO.INC'
19436C
19437      CHARACTER*4 IOP
19438      SAVE IOUNI1
19439C
19440C-----COMMON----------------------------------------------------------
19441C
19442      INCLUDE 'DPCOP2.INC'
19443C
19444C-----START POINT-----------------------------------------------------
19445C
19446      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TTE5')THEN
19447        ISTEPN='1'
19448        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19449        WRITE(ICOUT,999)
19450  999   FORMAT(1X)
19451        CALL DPWRST('XXX','BUG ')
19452        WRITE(ICOUT,51)
19453   51   FORMAT('***** AT THE BEGINNING OF DPTTE5--')
19454        CALL DPWRST('XXX','BUG ')
19455        WRITE(ICOUT,53)STATVA,STATCD,STATNU,PVAL2T,PVALLT,PVALUT
19456   53   FORMAT('STATVA,STATCD,STATNU,PVAL2T,PVALLT,PVALUT = ',6G15.7)
19457        CALL DPWRST('XXX','BUG ')
19458        WRITE(ICOUT,54)CUTL50,CUTL80,CUTL90,CUTL95,CUTL99,CTL999
19459   54   FORMAT('CUTL50,CUTL80,CUTL90,CUTL95,CUTL99,CTL999 = ',6G15.7)
19460        CALL DPWRST('XXX','BUG ')
19461        WRITE(ICOUT,55)CUTU50,CUTU80,CUTU90,CUTU95,CUTU99,CTU999
19462   55   FORMAT('CUTU50,CUTU80,CUTU90,CUTU95,CUTU99,CTU999 = ',6G15.7)
19463        CALL DPWRST('XXX','BUG ')
19464      ENDIF
19465C
19466      IF(ICASAN.EQ.'ONES' .OR. ICASAN.EQ.'PDTE')THEN
19467        STATV=STATVA
19468        STATC=STATCD
19469        STATN=STATNU
19470      ELSE
19471        STATV=STATV2
19472        STATC=STATC2
19473        STATN=STATN2
19474      ENDIF
19475C
19476      IF(IFLAGU.EQ.'FILE')THEN
19477C
19478        IF(IFRST)THEN
19479          IOP='OPEN'
19480          IFLAG1=1
19481          IFLAG2=0
19482          IFLAG3=0
19483          IFLAG4=0
19484          IFLAG5=0
19485          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
19486     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
19487     1                IBUGA3,ISUBRO,IERROR)
19488          IF(IERROR.EQ.'YES')GOTO9000
19489C
19490          WRITE(IOUNI1,295)
19491  295     FORMAT(11X,'STATVAL',8X,'STATCDF',8X,'STATNU',
19492     1            9X,'PVAL2T',9X,'PVALLT',X,'PVALUT',
19493     1            7X,'CUTLOW50',7X,'CUTLOW80',7X,'CUTLOW90',
19494     1            7X,'CUTLOW95',7X,'CUTLOW99',7X,'CUTLO999',
19495     1            7X,'CUTUPP50',7X,'CUTUPP80',7X,'CUTUPP90',
19496     1            7X,'CUTUPP95',7X,'CUTUPP99',7X,'CUTUP999')
19497        ENDIF
19498        WRITE(IOUNI1,299)STATV,STATC,STATN,PVAL2T,PVALLT,PVALUT,
19499     1                   CUTL50,CUTL80,CUTL90,CUTL95,CUTL99,CTL999,
19500     1                   CUTU50,CUTU80,CUTU90,CUTU95,CUTU99,CTU999
19501  299   FORMAT(18E15.7)
19502      ELSEIF(IFLAGU.EQ.'ON')THEN
19503        IF(STATV.NE.CPUMIN)THEN
19504          IH='STAT'
19505          IH2='VAL '
19506          VALUE0=STATV
19507          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19508     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19509     1                IANS,IWIDTH,IBUGA3,IERROR)
19510        ENDIF
19511C
19512        IF(STATC.NE.CPUMIN)THEN
19513          IH='STAT'
19514          IH2='CDF '
19515          VALUE0=STATC
19516          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19517     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19518     1                IANS,IWIDTH,IBUGA3,IERROR)
19519        ENDIF
19520C
19521        IF(STATN.NE.CPUMIN)THEN
19522          IH='STAT'
19523          IH2='NU  '
19524          VALUE0=STATN
19525          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19526     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19527     1                IANS,IWIDTH,IBUGA3,IERROR)
19528        ENDIF
19529C
19530        IF(PVAL2T.NE.CPUMIN)THEN
19531          IH='PVAL'
19532          IH2='UE  '
19533          VALUE0=PVAL2T
19534          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19535     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19536     1                IANS,IWIDTH,IBUGA3,IERROR)
19537        ENDIF
19538C
19539        IF(PVALLT.NE.CPUMIN)THEN
19540          IH='PVAL'
19541          IH2='UELT'
19542          VALUE0=PVALLT
19543          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19544     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19545     1                IANS,IWIDTH,IBUGA3,IERROR)
19546        ENDIF
19547C
19548        IF(PVALUT.NE.CPUMIN)THEN
19549          IH='PVAL'
19550          IH2='UEUT'
19551          VALUE0=PVALUT
19552          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19553     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19554     1                IANS,IWIDTH,IBUGA3,IERROR)
19555        ENDIF
19556C
19557        IF(CUTU50.NE.CPUMIN)THEN
19558          IH='CUTU'
19559          IH2='PP50'
19560          VALUE0=CUTU50
19561          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19562     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19563     1                IANS,IWIDTH,IBUGA3,IERROR)
19564        ENDIF
19565C
19566        IF(CUTL50.NE.CPUMIN)THEN
19567          IH='CUTL'
19568          IH2='OW50'
19569          VALUE0=CUTU50
19570          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19571     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19572     1                IANS,IWIDTH,IBUGA3,IERROR)
19573        ENDIF
19574C
19575        IF(CUTU80.NE.CPUMIN)THEN
19576          IH='CUTU'
19577          IH2='PP80'
19578          VALUE0=CUTU80
19579          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19580     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19581     1                IANS,IWIDTH,IBUGA3,IERROR)
19582        ENDIF
19583C
19584        IF(CUTL80.NE.CPUMIN)THEN
19585          IH='CUTL'
19586          IH2='OW80'
19587          VALUE0=CUTL80
19588          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19589     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19590     1                IANS,IWIDTH,IBUGA3,IERROR)
19591        ENDIF
19592C
19593        IF(CUTU90.NE.CPUMIN)THEN
19594          IH='CUTU'
19595          IH2='PP90'
19596          VALUE0=CUTU90
19597          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19598     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19599     1                IANS,IWIDTH,IBUGA3,IERROR)
19600        ENDIF
19601C
19602        IF(CUTL90.NE.CPUMIN)THEN
19603          IH='CUTL'
19604          IH2='OW90'
19605          VALUE0=CUTL90
19606          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19607     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19608     1                IANS,IWIDTH,IBUGA3,IERROR)
19609        ENDIF
19610C
19611        IF(CUTU95.NE.CPUMIN)THEN
19612          IH='CUTU'
19613          IH2='PP95'
19614          VALUE0=CUTU95
19615          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19616     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19617     1                IANS,IWIDTH,IBUGA3,IERROR)
19618        ENDIF
19619C
19620        IF(CUTL95.NE.CPUMIN)THEN
19621          IH='CUTL'
19622          IH2='OW95'
19623          VALUE0=CUTL95
19624          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19625     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19626     1                IANS,IWIDTH,IBUGA3,IERROR)
19627        ENDIF
19628C
19629        IF(CUTU99.NE.CPUMIN)THEN
19630          IH='CUTU'
19631          IH2='PP99'
19632          VALUE0=CUTU99
19633          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19634     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19635     1                IANS,IWIDTH,IBUGA3,IERROR)
19636        ENDIF
19637C
19638        IF(CUTL99.NE.CPUMIN)THEN
19639          IH='CUTL'
19640          IH2='OW99'
19641          VALUE0=CUTL99
19642          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19643     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19644     1                IANS,IWIDTH,IBUGA3,IERROR)
19645        ENDIF
19646C
19647        IF(CTU999.NE.CPUMIN)THEN
19648          IH='CUTU'
19649          IH2='P999'
19650          VALUE0=CTU999
19651          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19652     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19653     1                IANS,IWIDTH,IBUGA3,IERROR)
19654        ENDIF
19655C
19656        IF(CTL999.NE.CPUMIN)THEN
19657          IH='CUTL'
19658          IH2='O999'
19659          VALUE0=CTL999
19660          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19661     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19662     1                IANS,IWIDTH,IBUGA3,IERROR)
19663        ENDIF
19664C
19665      ENDIF
19666C
19667      IF(IFLAGU.EQ.'FILE')THEN
19668        IF(ILAST)THEN
19669          IOP='CLOS'
19670          IFLAG1=1
19671          IFLAG2=0
19672          IFLAG3=0
19673          IFLAG4=0
19674          IFLAG5=0
19675          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
19676     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
19677     1                IBUGA3,ISUBRO,IERROR)
19678C
19679          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TTE5')THEN
19680            ISTEPN='3A'
19681            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19682            WRITE(ICOUT,999)
19683            CALL DPWRST('XXX','BUG ')
19684            WRITE(ICOUT,301)IERROR
19685  301       FORMAT('AFTER CALL DPCLFI, IERROR = ',A4)
19686            CALL DPWRST('XXX','BUG ')
19687          ENDIF
19688C
19689          IF(IERROR.EQ.'YES')GOTO9000
19690        ENDIF
19691      ENDIF
19692C
19693C               *****************
19694C               **  STEP 90--  **
19695C               **  EXIT       **
19696C               *****************
19697C
19698 9000 CONTINUE
19699C
19700      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TTE5')THEN
19701        WRITE(ICOUT,999)
19702        CALL DPWRST('XXX','BUG ')
19703        WRITE(ICOUT,9011)
19704 9011   FORMAT('***** AT THE END OF DPTTE5--')
19705        CALL DPWRST('XXX','BUG ')
19706      ENDIF
19707C
19708      RETURN
19709      END
19710      SUBROUTINE DPTTE6(Y1,N1,Y2,N2,YTEMP,IWRITE,
19711     1                  STATVA,STATCD,STATNU,
19712     1                  Y1MEAN,Y1SD,Y1SDM,
19713     1                  Y2MEAN,Y2SD,Y2SDM,
19714     1                  YDMEAN,YDSD,YDSDM,
19715     1                  PVAL2T,PVALLT,PVALUT,
19716     1                  ISUBRO,IBUGA3,IERROR)
19717C
19718C     PURPOSE--THIS SUBROUTINE COMPUTES THE PAIRED TWO SAMPLE T-TEST
19719C              (AND ALTERNATIVELY THE CDF OR P-VALUES).
19720C     INPUT  ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
19721C                                (UNSORTED OR SORTED) OBSERVATIONS
19722C                                FOR THE FIRST RESPONSE VARIABLE.
19723C                     --N1     = THE INTEGER NUMBER OF OBSERVATIONS
19724C                                IN THE VECTOR Y1.
19725C                     --Y2     = THE SINGLE PRECISION VECTOR OF
19726C                                (UNSORTED OR SORTED) OBSERVATIONS
19727C                                FOR THE SECOND RESPONSE VARIABLE.
19728C                     --N2     = THE INTEGER NUMBER OF OBSERVATIONS
19729C                                IN THE VECTOR Y2.
19730C     OUTPUT ARGUMENTS--STATVA = THE SINGLE PRECISION VALUE OF THE
19731C                                COMPUTED STATISTIC.
19732C                     --STATCD = THE SINGLE PRECISION VALUE OF THE
19733C                                COMPUTED CDF OF THE TEST STATISTIC.
19734C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
19735C             TEST STATISTIC.
19736C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
19737C                   OF N FOR THIS SUBROUTINE.
19738C     OTHER DATAPAC   SUBROUTINES NEEDED--TCDF.
19739C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
19740C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
19741C     LANGUAGE--ANSI FORTRAN (1977)
19742C     WRITTEN BY--ALAN HECKERT
19743C                 STATISTICAL ENGINEERING DIVISION
19744C                 INFORMATION TECHNOLOGY LABORATORY
19745C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19746C                 GAITHERSBURG, MD 20899-8980
19747C                 PHONE--301-975-2888
19748C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19749C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19750C     LANGUAGE--ANSI FORTRAN (1977)
19751C     VERSION NUMBER--2011.4
19752C     ORIGINAL VERSION--APRIL     2011
19753C
19754C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19755C
19756      CHARACTER*4 IWRITE
19757      CHARACTER*4 IWRTSV
19758      CHARACTER*4 ISUBRO
19759      CHARACTER*4 IBUGA3
19760      CHARACTER*4 IERROR
19761C
19762      CHARACTER*4 ISUBN1
19763      CHARACTER*4 ISUBN2
19764C
19765C---------------------------------------------------------------------
19766C
19767      DIMENSION Y1(*)
19768      DIMENSION Y2(*)
19769      DIMENSION YTEMP(*)
19770C
19771C-----COMMON----------------------------------------------------------
19772C
19773      INCLUDE 'DPCOP2.INC'
19774C
19775C-----START POINT-----------------------------------------------------
19776C
19777      ISUBN1='DPTT'
19778      ISUBN2='E6  '
19779      IWRTSV=IWRITE
19780      IERROR='NO'
19781C
19782      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TTE6')THEN
19783        WRITE(ICOUT,999)
19784  999   FORMAT(1X)
19785        CALL DPWRST('XXX','BUG ')
19786        WRITE(ICOUT,51)
19787   51   FORMAT('***** AT THE BEGINNING OF DPTTE6--')
19788        CALL DPWRST('XXX','BUG ')
19789        WRITE(ICOUT,52)IBUGA3,ISUBRO
19790   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
19791        CALL DPWRST('XXX','BUG ')
19792        WRITE(ICOUT,53)N1,N2
19793   53   FORMAT('N1,N2 = ',2I8)
19794        CALL DPWRST('XXX','BUG ')
19795        DO55I=1,MIN(N1,N2)
19796          WRITE(ICOUT,56)I,Y1(I),Y2(I)
19797   56     FORMAT('I,Y1(I),Y2(I) = ',I8,2G15.7)
19798          CALL DPWRST('XXX','BUG ')
19799   55   CONTINUE
19800      ENDIF
19801C
19802C               ****************************************
19803C               **  COMPUTE TWO SAMPLE PAIRED T-TEST  **
19804C               ****************************************
19805C
19806C               ********************************************
19807C               **  STEP 1--                              **
19808C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
19809C               ********************************************
19810C
19811      STATVA=-99.0
19812      STATCD=-99.0
19813      STATNU=-99.0
19814      PVAL2T=-99.0
19815      PVALLT=-99.0
19816      PVALUT=-99.0
19817      IWRITE='OFF'
19818C
19819      IF(N1.NE.N2)THEN
19820        WRITE(ICOUT,999)
19821        CALL DPWRST('XXX','WRIT')
19822        WRITE(ICOUT,111)
19823        CALL DPWRST('XXX','WRIT')
19824        WRITE(ICOUT,102)
19825  102   FORMAT('      FOR THE PAIRED TEST, THE SAMPLE SIZES FOR THE')
19826        CALL DPWRST('XXX','WRIT')
19827        WRITE(ICOUT,103)
19828  103   FORMAT('      RESPONSE VARIABLES MUST BE EQUAL.')
19829        CALL DPWRST('XXX','WRIT')
19830        WRITE(ICOUT,104)N1
19831  104   FORMAT('SAMPLE SIZE FOR THE FIRST  RESPONSE VARIABLE = ',I8)
19832        CALL DPWRST('XXX','WRIT')
19833        WRITE(ICOUT,105)N2
19834  105   FORMAT('SAMPLE SIZE FOR THE SECOND RESPONSE VARIABLE = ',I8)
19835        CALL DPWRST('XXX','WRIT')
19836        IERROR='YES'
19837        GOTO9000
19838      ENDIF
19839C
19840      IF(N1.LT.2)THEN
19841        WRITE(ICOUT,999)
19842        CALL DPWRST('XXX','WRIT')
19843        WRITE(ICOUT,111)
19844  111   FORMAT('***** ERROR IN PAIRED T-TEST--')
19845        CALL DPWRST('XXX','WRIT')
19846        WRITE(ICOUT,112)
19847  112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE FIRST ',
19848     1         'RESPONSE VARIABLE IS LESS THAN 2.')
19849        CALL DPWRST('XXX','WRIT')
19850        WRITE(ICOUT,113)N1
19851  113   FORMAT('SAMPLE SIZE = ',I8)
19852        CALL DPWRST('XXX','WRIT')
19853        IERROR='YES'
19854        GOTO9000
19855      ENDIF
19856C
19857      HOLD=Y1(1)
19858      DO135I=2,N1
19859        IF(Y1(I).NE.HOLD)GOTO139
19860  135 CONTINUE
19861      WRITE(ICOUT,999)
19862      CALL DPWRST('XXX','WRIT')
19863      WRITE(ICOUT,111)
19864      CALL DPWRST('XXX','WRIT')
19865      WRITE(ICOUT,131)HOLD
19866  131 FORMAT('      THE FIRST RESPONSE VARIABLE HAS ALL ELEMENTS = ',
19867     1       G15.7)
19868      CALL DPWRST('XXX','WRIT')
19869      GOTO9000
19870  139 CONTINUE
19871C
19872      IF(N2.LT.2)THEN
19873        WRITE(ICOUT,999)
19874        CALL DPWRST('XXX','WRIT')
19875        WRITE(ICOUT,111)
19876        CALL DPWRST('XXX','WRIT')
19877        WRITE(ICOUT,142)
19878  142   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE SECOND ',
19879     1         'RESPONSE VARIABLE IS LESS THAN 2.')
19880        CALL DPWRST('XXX','WRIT')
19881        WRITE(ICOUT,113)N2
19882        CALL DPWRST('XXX','WRIT')
19883        IERROR='YES'
19884        GOTO9000
19885      ENDIF
19886C
19887      HOLD=Y2(1)
19888      DO155I=2,N1
19889        IF(Y2(I).NE.HOLD)GOTO159
19890  155 CONTINUE
19891      WRITE(ICOUT,999)
19892      CALL DPWRST('XXX','WRIT')
19893      WRITE(ICOUT,111)
19894      CALL DPWRST('XXX','WRIT')
19895      WRITE(ICOUT,151)HOLD
19896  151 FORMAT('      THE SECOND RESPONSE VARIABLE HAS ALL ELEMENTS = ',
19897     1       G15.7)
19898      CALL DPWRST('XXX','WRIT')
19899      GOTO9000
19900  159 CONTINUE
19901C
19902C               **************************************************
19903C               **  STEP 2--                                    **
19904C               **  COMPUTE THE TWO SAMPLE PAIRED T-TEST.       **
19905C               **************************************************
19906C
19907      DO200I=1,N1
19908        YTEMP(I)=Y1(I) - Y2(I)
19909  200 CONTINUE
19910C
19911      CALL MEAN(Y1,N1,IWRITE,Y1MEAN,IBUGA3,IERROR)
19912      CALL SD(Y1,N1,IWRITE,Y1SD,IBUGA3,IERROR)
19913      Y1VAR=Y1SD**2
19914      CALL SDMEAN(Y1,N1,IWRITE,Y1SDM,IBUGA3,IERROR)
19915C
19916      CALL MEAN(Y2,N2,IWRITE,Y2MEAN,IBUGA3,IERROR)
19917      CALL SD(Y2,N2,IWRITE,Y2SD,IBUGA3,IERROR)
19918      Y2VAR=Y2SD**2
19919      CALL SDMEAN(Y2,N2,IWRITE,Y2SDM,IBUGA3,IERROR)
19920C
19921      CALL MEAN(YTEMP,N2,IWRITE,YDMEAN,IBUGA3,IERROR)
19922      CALL SD(YTEMP,N2,IWRITE,YDSD,IBUGA3,IERROR)
19923      YDVAR=YDSD**2
19924      CALL SDMEAN(YTEMP,N2,IWRITE,YDSDM,IBUGA3,IERROR)
19925C
19926      AN1=N1
19927      AN2=N2
19928C
19929      DEL=Y1MEAN-Y2MEAN
19930      STATVA=DEL/YDSDM
19931      IDF=N1-1
19932      STATNU=REAL(IDF)
19933      CALL TCDF(STATVA,STATNU,STATCD)
19934C
19935      PVALLT=STATCD
19936      PVALUT=1.0 - STATCD
19937      IF(STATVA.LE.0.0)THEN
19938        PVAL2T=2.0*PVALLT
19939      ELSE
19940        PVAL2T=2.0*PVALUT
19941      ENDIF
19942C
19943C               *******************************
19944C               **  STEP 3--                 **
19945C               **  WRITE OUT A LINE         **
19946C               **  OF SUMMARY INFORMATION.  **
19947C               *******************************
19948C
19949      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
19950        WRITE(ICOUT,999)
19951        CALL DPWRST('XXX','BUG ')
19952        WRITE(ICOUT,811)STATVA
19953  811   FORMAT('THE VALUE OF THE PAIRED TWO SAMPLE T-TEST = ',G15.7)
19954        CALL DPWRST('XXX','BUG ')
19955      ENDIF
19956C
19957C               *****************
19958C               **  STEP 90--  **
19959C               **  EXIT.      **
19960C               *****************
19961C
19962 9000 CONTINUE
19963C
19964      IWRITE=IWRTSV
19965C
19966      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TTE6')THEN
19967        WRITE(ICOUT,999)
19968        CALL DPWRST('XXX','BUG ')
19969        WRITE(ICOUT,9011)
19970 9011   FORMAT('***** AT THE END       OF DPTTE6--')
19971        CALL DPWRST('XXX','BUG ')
19972        WRITE(ICOUT,9012)IERROR
19973 9012   FORMAT('IERROR = ',A4)
19974        CALL DPWRST('XXX','BUG ')
19975        WRITE(ICOUT,9015)STATVA,STATCD,STATNU
19976 9015   FORMAT('STATVA,STATCD,STATNU = ',3G15.7)
19977        CALL DPWRST('XXX','BUG ')
19978        WRITE(ICOUT,9017)Y1MEAN,Y1SD,Y1SDM
19979 9017   FORMAT('Y1MEAN,Y1SD,Y1SDM = ',3G15.7)
19980        CALL DPWRST('XXX','BUG ')
19981        WRITE(ICOUT,9018)Y2MEAN,Y2SD,Y2SDM
19982 9018   FORMAT('Y2MEAN,Y2SD,Y2SDM = ',3G15.7)
19983        CALL DPWRST('XXX','BUG ')
19984        WRITE(ICOUT,9019)YDMEAN,YDSD,YDSDM
19985 9019   FORMAT('YDMEAN,YDSD,YDSDM = ',3G15.7)
19986        CALL DPWRST('XXX','BUG ')
19987      ENDIF
19988C
19989      RETURN
19990      END
19991      SUBROUTINE DPTUMD(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
19992     1                  IANGLU,MAXNPP,
19993     1                  IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
19994C
19995C     PURPOSE--FORM A TUKEY MEAN DIFFERENCE PLOT
19996C              (USEFUL FOR DISTRIBUTIONALLY COMPARING 2 DATA SETS).
19997C     WRITTEN BY--ALAN HECKERT
19998C                 STATISTICAL ENGINEERING DIVISION
19999C                 INFORMATION TECHNOLOGY LABORATORY
20000C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20001C                 GAITHERSBURG, MD 20899-8980
20002C                 PHONE--301-975-2855
20003C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20004C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20005C     LANGUAGE--ANSI FORTRAN (1977)
20006C     VERSION NUMBER--99/8
20007C     ORIGINAL VERSION--SEPTEMBER 1999 .
20008C     UPDATED         --FEBRUARY  2011. USE DPPARS, DPPAR3
20009C     UPDATED         --FEBRUARY  2011. SUPPORT FOR "HIGHLIGHTED" OPTION
20010C     UPDATED         --JUNE      2016. ALLOW USER-SPECIFED PERCENTILES
20011C
20012C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20013C
20014      CHARACTER*4 ICASPL
20015      CHARACTER*4 IAND1
20016      CHARACTER*4 IAND2
20017      CHARACTER*4 IANGLU
20018      CHARACTER*4 IBUGG2
20019      CHARACTER*4 IBUGG3
20020      CHARACTER*4 IBUGQ
20021      CHARACTER*4 ISUBRO
20022      CHARACTER*4 IFOUND
20023      CHARACTER*4 IERROR
20024C
20025      CHARACTER*4 ISUBN1
20026      CHARACTER*4 ISUBN2
20027      CHARACTER*4 ISTEPN
20028      CHARACTER*4 ICASE
20029      CHARACTER*4 IHIGH
20030C
20031      CHARACTER*40 INAME
20032      PARAMETER (MAXSPN=20)
20033      CHARACTER*4 IVARN1(MAXSPN)
20034      CHARACTER*4 IVARN2(MAXSPN)
20035      CHARACTER*4 IVARTY(MAXSPN)
20036      REAL PVAR(MAXSPN)
20037      INTEGER ILIS(MAXSPN)
20038      INTEGER NRIGHT(MAXSPN)
20039      INTEGER ICOLR(MAXSPN)
20040C
20041C---------------------------------------------------------------------
20042C
20043      INCLUDE 'DPCOPA.INC'
20044      DIMENSION Y1(MAXOBV)
20045      DIMENSION Y2(MAXOBV)
20046      DIMENSION Y3(MAXOBV)
20047      DIMENSION Y4(MAXOBV)
20048      DIMENSION XD(MAXOBV)
20049      DIMENSION YD(MAXOBV)
20050      DIMENSION XHIGH(MAXOBV)
20051      DIMENSION XDIST(MAXOBV)
20052      DIMENSION TEMP1(MAXOBV)
20053      DIMENSION TEMP2(MAXOBV)
20054C
20055      INCLUDE 'DPCOZZ.INC'
20056      DIMENSION YLARGE(MAXOBV)
20057      DIMENSION YSMALL(MAXOBV)
20058      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
20059      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
20060      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
20061      EQUIVALENCE (GARBAG(IGARB4),Y4(1))
20062      EQUIVALENCE (GARBAG(IGARB5),XD(1))
20063      EQUIVALENCE (GARBAG(IGARB6),YD(1))
20064      EQUIVALENCE (GARBAG(IGARB7),YLARGE(1))
20065      EQUIVALENCE (GARBAG(IGARB8),YSMALL(1))
20066      EQUIVALENCE (GARBAG(IGARB9),XHIGH(1))
20067      EQUIVALENCE (GARBAG(IGAR10),XDIST(1))
20068      EQUIVALENCE (GARBAG(JGAR11),TEMP1(1))
20069      EQUIVALENCE (GARBAG(JGAR12),TEMP2(1))
20070C
20071C-----COMMON----------------------------------------------------------
20072C
20073      INCLUDE 'DPCOHK.INC'
20074      INCLUDE 'DPCODA.INC'
20075      INCLUDE 'DPCOST.INC'
20076      INCLUDE 'DPCOP2.INC'
20077C
20078C-----START POINT-----------------------------------------------------
20079C
20080      ISUBN1='DPTU'
20081      ISUBN2='MD  '
20082      IFOUND='NO'
20083      IERROR='NO'
20084C
20085      MAXCP1=MAXCOL+1
20086      MAXCP2=MAXCOL+2
20087      MAXCP3=MAXCOL+3
20088      MAXCP4=MAXCOL+4
20089      MAXCP5=MAXCOL+5
20090      MAXCP6=MAXCOL+6
20091C
20092      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')THEN
20093        WRITE(ICOUT,999)
20094  999   FORMAT(1X)
20095        CALL DPWRST('XXX','BUG ')
20096        WRITE(ICOUT,51)
20097   51   FORMAT('***** AT THE BEGINNING OF DPTUMD--')
20098        CALL DPWRST('XXX','BUG ')
20099        WRITE(ICOUT,52)NPLOTV,NPLOTP,NS,MAXN,MAXNPP,IQQNPR
20100   52   FORMAT('NPLOTV,NPLOTP,NS,MAXN,MAXNPP,IQQNPR = ',6I8)
20101        CALL DPWRST('XXX','BUG ')
20102        WRITE(ICOUT,53)ICASPL,IAND1,IAND2
20103   53   FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
20104        CALL DPWRST('XXX','BUG ')
20105        WRITE(ICOUT,54)IANGLU,IBUGG2,IBUGG3,IBUGQ,ISUBRO
20106   54   FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',4(A4,2X),A4)
20107        CALL DPWRST('XXX','BUG ')
20108        WRITE(ICOUT,57)IFOUND,IERROR
20109   57   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
20110        CALL DPWRST('XXX','BUG ')
20111      ENDIF
20112C
20113C               *******************************************
20114C               **  TREAT THE TUKEY MEAN-DIFFERENCE CASE **
20115C               *******************************************
20116C
20117C               ***************************
20118C               **  STEP 11--            **
20119C               **  EXTRACT THE COMMAND  **
20120C               ***************************
20121C
20122      ISTEPN='11'
20123      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
20124     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20125C
20126      IHIGH='OFF'
20127      IF(ICOM.EQ.'TUKE')THEN
20128        IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MEAN'.AND.
20129     1    IHARG(2).EQ.'DIFF')THEN
20130           IF((IHARG(3).EQ.'HIGH' .OR. IHARG(3).EQ.'SUBS') .AND.
20131     1       IHARG(4).EQ.'PLOT')THEN
20132             IHIGH='ON'
20133             ILASTC=4
20134           ELSEIF(IHARG(3).EQ.'PLOT')THEN
20135             ILASTC=3
20136           ELSE
20137             GOTO9000
20138           ENDIF
20139        ELSEIF(NUMARG.GE.3.AND.IHARG(1).EQ.'M   '.AND.
20140     1        IHARG(2).EQ.'D   ')THEN
20141          IF((IHARG(3).EQ.'HIGH' .OR. IHARG(3).EQ.'SUBS') .AND.
20142     1      IHARG(4).EQ.'PLOT')THEN
20143             ILASTC=4
20144             IHIGH='ON'
20145          ELSEIF(IHARG(3).EQ.'PLOT')THEN
20146             ILASTC=3
20147          ELSE
20148             GOTO9000
20149          ENDIF
20150        ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'MD  ')THEN
20151          IF((IHARG(2).EQ.'HIGH' .OR. IHARG(2).EQ.'SUBS') .AND.
20152     1      IHARG(3).EQ.'PLOT')THEN
20153             ILASTC=3
20154             IHIGH='ON'
20155          ELSEIF(IHARG(2).EQ.'PLOT')THEN
20156             ILASTC=2
20157          ELSE
20158             GOTO9000
20159          ENDIF
20160        ENDIF
20161      ELSEIF(ICOM.EQ.'HIGH' .OR. ICOM.EQ.'SUBS')THEN
20162        IHIGH='ON'
20163        IF(NUMARG.GE.3.AND.IHARG(1).EQ.'TUKE'.AND.
20164     1    IHARG(2).EQ.'MEAN'.AND.IHARG(3).EQ.'DIFF'.AND.
20165     1    IHARG(4).EQ.'PLOT')THEN
20166             IHIGH='ON'
20167             ILASTC=4
20168        ELSEIF(NUMARG.GE.3.AND.IHARG(1).EQ.'TUKE'.AND.
20169     1    IHARG(2).EQ.'M   '.AND.IHARG(3).EQ.'D   '.AND.
20170     1    IHARG(4).EQ.'PLOT')THEN
20171             ILASTC=3
20172             IHIGH='ON'
20173        ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'TUKE'.AND.
20174     1    IHARG(2).EQ.'MD  '.AND.IHARG(3).EQ.'PLOT')THEN
20175             ILASTC=3
20176        ELSE
20177          GOTO9000
20178        ENDIF
20179      ELSE
20180        GOTO9000
20181      ENDIF
20182C
20183      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
20184      IFOUND='YES'
20185      ICASPL='TUMD'
20186C
20187C               ****************************************
20188C               **  STEP 2--                          **
20189C               **  EXTRACT THE VARIABLE LIST         **
20190C               ****************************************
20191C
20192      ISTEPN='2'
20193      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
20194     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20195C
20196      INAME='TUKEY MEAN-DIFFERENCE PLOT'
20197      MINNA=2
20198      MAXNA=100
20199      MINN2=2
20200      IFLAGE=0
20201      IFLAGM=1
20202      IFLAGP=0
20203      JMIN=1
20204      JMAX=NUMARG
20205      MINNVA=2
20206      MAXNVA=2
20207      IF(IHIGH.EQ.'ON')THEN
20208        MINNA=3
20209        MINNVA=3
20210        MAXNVA=3
20211      ENDIF
20212C
20213      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
20214     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
20215     1            JMIN,JMAX,
20216     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
20217     1            IVARN1,IVARN2,IVARTY,PVAR,
20218     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
20219     1            MINNVA,MAXNVA,
20220     1            IFLAGM,IFLAGP,
20221     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
20222      IF(IERROR.EQ.'YES')GOTO9000
20223C
20224      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')THEN
20225        WRITE(ICOUT,999)
20226        CALL DPWRST('XXX','BUG ')
20227        WRITE(ICOUT,281)
20228  281   FORMAT('***** AFTER CALL DPPARS--')
20229        CALL DPWRST('XXX','BUG ')
20230        WRITE(ICOUT,282)NQ,NUMVAR
20231  282   FORMAT('NQ,NUMVAR = ',2I8)
20232        CALL DPWRST('XXX','BUG ')
20233        IF(NUMVAR.GT.0)THEN
20234          DO285I=1,NUMVAR
20235            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
20236     1                      ICOLR(I)
20237  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
20238     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
20239            CALL DPWRST('XXX','BUG ')
20240  285     CONTINUE
20241        ENDIF
20242      ENDIF
20243C
20244      DO290I=1,MAX(NRIGHT(1),NRIGHT(2))
20245        XHIGH(I)=1.0
20246  290 CONTINUE
20247C
20248C     IN ORDER TO ACCOMODATE MATRIX ARGUMENTS, CALL EACH
20249C     VARIABLE SEPARATELY.
20250C
20251      NUMVA2=1
20252      ICOL=1
20253      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
20254     1            INAME,IVARN1,IVARN2,IVARTY,
20255     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
20256     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
20257     1            MAXCP4,MAXCP5,MAXCP6,
20258     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
20259     1            Y1,Y1,Y1,NS1,NTEMP,NTEMP,ICASE,
20260     1            IBUGG3,ISUBRO,IFOUND,IERROR)
20261      IF(IERROR.EQ.'YES')GOTO9000
20262C
20263      ICOL=2
20264      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
20265     1            INAME,IVARN1,IVARN2,IVARTY,
20266     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
20267     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
20268     1            MAXCP4,MAXCP5,MAXCP6,
20269     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
20270     1            Y2,Y2,Y2,NS2,NTEMP,NTEMP,ICASE,
20271     1            IBUGG3,ISUBRO,IFOUND,IERROR)
20272C
20273      IF(IHIGH.EQ.'ON')THEN
20274        ICOL=3
20275        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
20276     1              INAME,IVARN1,IVARN2,IVARTY,
20277     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
20278     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
20279     1              MAXCP4,MAXCP5,MAXCP6,
20280     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
20281     1              XHIGH,XHIGH,XHIGH,NHIGH,NTEMP,NTEMP,ICASE,
20282     1              IBUGG3,ISUBRO,IFOUND,IERROR)
20283      ELSE
20284        NHIGH=0
20285      ENDIF
20286C
20287C               ****************************************************
20288C               **  STEP 41--                                      *
20289C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          *
20290C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR    *
20291C               **   THE PLOT.                                     *
20292C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .    *
20293C               **  THIS WILL BE BOTH ONES FOR BOTH CASES          *
20294C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  *
20295C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  *
20296C               ****************************************************
20297C
20298      ISTEPN='41'
20299      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
20300     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20301C
20302      NS=NS1
20303      IF(NS2.GT.NS1)NS=NS2
20304      CALL DPTUM2(Y1,NS1,Y2,NS2,ICASPL,MAXN,IQQNPR,
20305     1            Y,X,D,NPLOTP,NPLOTV,
20306     1            YLARGE,YSMALL,TEMP1,TEMP2,
20307     1            XHIGH,NHIGH,XDIST,
20308     1            IBUGG3,ISUBRO,IERROR)
20309C
20310C
20311C               *****************
20312C               **  STEP 90--  **
20313C               **  EXIT       **
20314C               *****************
20315C
20316 9000 CONTINUE
20317      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')THEN
20318        WRITE(ICOUT,999)
20319        CALL DPWRST('XXX','BUG ')
20320        WRITE(ICOUT,9011)
20321 9011   FORMAT('***** AT THE END       OF DPTUMD--')
20322        CALL DPWRST('XXX','BUG ')
20323        WRITE(ICOUT,9012)IFOUND,IERROR
20324 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
20325        CALL DPWRST('XXX','BUG ')
20326        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NUMVAR,NS,ICASPL,IAND1,IAND2
20327 9013   FORMAT('NPLOTV,NPLOTP,NUMVAR,NS,ICASPL,IAND1,IAND2 = ',
20328     1         4I8,2X,2(A4,2X),A4)
20329        CALL DPWRST('XXX','BUG ')
20330        WRITE(ICOUT,9014)ICASPL,MAXN,NUMVAR
20331 9014   FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
20332        CALL DPWRST('XXX','BUG ')
20333        IF(NPLOTP.GE.1)THEN
20334          DO9020I=1,NPLOTP
20335            WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
20336 9021       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
20337            CALL DPWRST('XXX','BUG ')
20338 9020     CONTINUE
20339        ENDIF
20340      ENDIF
20341C
20342      RETURN
20343      END
20344      SUBROUTINE DPTUM2(Y,NY,X,NX,ICASPL,MAXN,IQQNPR,
20345     1                  Y2,X2,D2,N2,NPLOTV,
20346     1                  YLARGE,YSMALL,TEMP1,TEMP2,
20347     1                  XHIGH,NHIGH,XDIST,
20348     1                  IBUGG3,ISUBRO,IERROR)
20349C
20350C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
20351C              THAT WILL DEFINE A TUKEY MEAN-DIFFERENCE PLOT
20352C              (USEFUL FOR DISTRIBUTIONALLY COMPARING 2 DATA SETS).
20353C              AFTER CALCULATING COORDINATES FOR Q-Q PLOT, CALCULATE
20354C              (Bi - Ti) VERSUS (Bi+Ti)/2 WHERE Bi AND Ti ARE
20355C              THE QUANTILES FOR THE RESPECTIVE DATA SETS.
20356C     WRITTEN BY--ALAN HECKERT
20357C                 STATISTICAL ENGINEERING DIVISION
20358C                 INFORMATION TECHNOLOGY LABORATORY
20359C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20360C                 GAITHERSBURG, MD 20899-8980
20361C                 PHONE--301-975-2899
20362C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20363C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20364C     LANGUAGE--ANSI FORTRAN (1977)
20365C     VERSION NUMBER--99/9
20366C     ORIGINAL VERSION--SEPTEMBER 1999.
20367C     UPDATED         --FEBRUARY  2011.
20368C     UPDATED         --JUNE      2016. ALLOW USER-SPECIFED PERCENTILES
20369C     UPDATED         --JUNE      2016. DON'T TREAT N=1 OR ALL DATA
20370C                                       VALUES EQUAL AS AN ERROR.  TREAT
20371C                                       AS A "DEGENERATE" CASE.
20372C
20373C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20374C
20375      CHARACTER*4 IBUGG3
20376      CHARACTER*4 ISUBRO
20377      CHARACTER*4 IERROR
20378C
20379      CHARACTER*4 ICASE
20380      CHARACTER*4 ICASPL
20381C
20382      CHARACTER*4 ISUBN1
20383      CHARACTER*4 ISUBN2
20384      CHARACTER*4 ISTEPN
20385      CHARACTER*4 IWRITE
20386C
20387C---------------------------------------------------------------------
20388C
20389      INCLUDE 'DPCOPA.INC'
20390C
20391      DIMENSION Y(*)
20392      DIMENSION X(*)
20393      DIMENSION XHIGH(*)
20394      DIMENSION Y2(*)
20395      DIMENSION X2(*)
20396      DIMENSION D2(*)
20397C
20398      DIMENSION YLARGE(*)
20399      DIMENSION YSMALL(*)
20400      DIMENSION XDIST(*)
20401      DIMENSION TEMP1(*)
20402      DIMENSION TEMP2(*)
20403C
20404C-----COMMON----------------------------------------------------------
20405C
20406      INCLUDE 'DPCOP2.INC'
20407C
20408C-----START POINT-----------------------------------------------------
20409C
20410      ISUBN1='DPQU'
20411      ISUBN2='M2  '
20412      IERROR='NO'
20413      IWRITE='OFF'
20414      ICASE=ICASPL
20415C
20416      ANY=NY
20417      ANX=NX
20418C
20419      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TUM2')THEN
20420        WRITE(ICOUT,999)
20421  999   FORMAT(1X)
20422        CALL DPWRST('XXX','BUG ')
20423        WRITE(ICOUT,51)
20424   51   FORMAT('***** AT THE BEGINNING OF DPTUM2--')
20425        CALL DPWRST('XXX','BUG ')
20426        WRITE(ICOUT,52)IBUGG3,ISUBRO,ICASPL
20427   52   FORMAT('IBUGG3,ISUBRO,ICASPL = ',2(A4,2X),A4)
20428        CALL DPWRST('XXX','BUG ')
20429        WRITE(ICOUT,53)NX,NY,NHIGH,IQQNPR
20430   53   FORMAT('NX,NY.NHIGH,IQQNPR = ',4I8)
20431        CALL DPWRST('XXX','BUG ')
20432        IF(NY.GE.1)THEN
20433          DO61I=1,NY
20434            WRITE(ICOUT,62)I,Y(I)
20435   62       FORMAT('I,Y(I) = ',I8,G15.7)
20436            CALL DPWRST('XXX','BUG ')
20437   61     CONTINUE
20438        ENDIF
20439        IF(NX.GE.1)THEN
20440          DO71I=1,NX
20441           WRITE(ICOUT,72)I,X(I)
20442   72      FORMAT('I,X(I) = ',I8,G15.7)
20443           CALL DPWRST('XXX','BUG ')
20444   71    CONTINUE
20445        ENDIF
20446      ENDIF
20447C
20448C               ********************************************
20449C               **  STEP 11--                             **
20450C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
20451C               ********************************************
20452C
20453C     2016/06: ONLY REQUIRE N >= 1.
20454C
20455CCCCC IF(NY.LT.2)THEN
20456      IF(NY.LT.1)THEN
20457        WRITE(ICOUT,999)
20458        CALL DPWRST('XXX','BUG ')
20459        WRITE(ICOUT,1111)
20460 1111   FORMAT('***** ERROR IN TUKEY MEAN DIFFERENCE PLOT--')
20461        CALL DPWRST('XXX','BUG ')
20462        WRITE(ICOUT,1112)
20463 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE FIRST ',
20464     1         'RESPONSE VARIABLE')
20465        CALL DPWRST('XXX','BUG ')
20466        WRITE(ICOUT,1113)
20467 1113   FORMAT('      MUST BE AT LEAST 1;')
20468        CALL DPWRST('XXX','BUG ')
20469        WRITE(ICOUT,1114)NY
20470 1114   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
20471        CALL DPWRST('XXX','BUG ')
20472        IERROR='YES'
20473        GOTO9000
20474      ELSEIF(NX.LT.1)THEN
20475        WRITE(ICOUT,999)
20476        CALL DPWRST('XXX','BUG ')
20477        WRITE(ICOUT,1111)
20478        CALL DPWRST('XXX','BUG ')
20479        WRITE(ICOUT,1122)
20480 1122   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE SECOND ',
20481     1         'RESPONSE VARIABLE')
20482        CALL DPWRST('XXX','BUG ')
20483        WRITE(ICOUT,1113)
20484        CALL DPWRST('XXX','BUG ')
20485        WRITE(ICOUT,1114)NX
20486        CALL DPWRST('XXX','BUG ')
20487        IERROR='YES'
20488        GOTO9000
20489      ELSEIF(NHIGH.GT.0 .AND. NHIGH.NE.MIN(NX,NY))THEN
20490        WRITE(ICOUT,999)
20491        CALL DPWRST('XXX','BUG ')
20492        WRITE(ICOUT,1111)
20493        CALL DPWRST('XXX','BUG ')
20494        WRITE(ICOUT,1125)
20495 1125   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE HIGHLIGHTING ',
20496     1         'VARIABLE IS')
20497        CALL DPWRST('XXX','BUG ')
20498        WRITE(ICOUT,1126)
20499 1126   FORMAT('      NOT EQUAL TO THE NUMBER OF OBSERVATIONS IN THE ',
20500     1         'SHORTER RESPONSE VARIABLE.')
20501        CALL DPWRST('XXX','BUG ')
20502        WRITE(ICOUT,1127)NY
20503 1127   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE FIRST     ',
20504     1         'RESPONSE VARIABLE = ',I8)
20505        CALL DPWRST('XXX','BUG ')
20506        WRITE(ICOUT,1128)NX
20507 1128   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE SECOND    ',
20508     1         'RESPONSE VARIABLE = ',I8)
20509        CALL DPWRST('XXX','BUG ')
20510        WRITE(ICOUT,1129)NHIGH
20511 1129   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE HIGHLIGHT ',
20512     1         'VARIABLE          = ',I8)
20513        CALL DPWRST('XXX','BUG ')
20514        IERROR='YES'
20515        GOTO9000
20516      ENDIF
20517C
20518CCCCC HOLD=Y(1)
20519CCCCC DO1130I=1,NY
20520CCCCC   IF(Y(I).NE.HOLD)GOTO1139
20521C1130 CONTINUE
20522CCCCC WRITE(ICOUT,999)
20523CCCCC CALL DPWRST('XXX','BUG ')
20524CCCCC WRITE(ICOUT,1111)
20525CCCCC CALL DPWRST('XXX','BUG ')
20526CCCCC WRITE(ICOUT,1132)
20527C1132 FORMAT('      ALL INPUT ELEMENTS FOR THE FIRST RESPONSE VARIABLE')
20528CCCCC CALL DPWRST('XXX','BUG ')
20529CCCCC WRITE(ICOUT,1133)HOLD
20530C1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',G15.7)
20531CCCCC CALL DPWRST('XXX','BUG ')
20532CCCCC WRITE(ICOUT,999)
20533CCCCC CALL DPWRST('XXX','BUG ')
20534CCCCC IERROR='YES'
20535CCCCC GOTO9000
20536C1139 CONTINUE
20537C
20538CCCCC HOLD=X(1)
20539CCCCC DO1140I=1,NY
20540CCCCC   IF(X(I).NE.HOLD)GOTO1149
20541C1140 CONTINUE
20542CCCCC WRITE(ICOUT,999)
20543CCCCC CALL DPWRST('XXX','BUG ')
20544CCCCC WRITE(ICOUT,1111)
20545CCCCC CALL DPWRST('XXX','BUG ')
20546CCCCC WRITE(ICOUT,1142)
20547C1142 FORMAT('      ALL INPUT ELEMENTS FOR THE SECOND RESPONSE ',
20548CCCCC1       'VARIABLE')
20549CCCCC CALL DPWRST('XXX','BUG ')
20550CCCCC WRITE(ICOUT,1133)HOLD
20551CCCCC CALL DPWRST('XXX','BUG ')
20552CCCCC WRITE(ICOUT,999)
20553CCCCC CALL DPWRST('XXX','BUG ')
20554CCCCC IERROR='YES'
20555CCCCC GOTO9000
20556C1149 CONTINUE
20557C
20558C               ****************************************************
20559C               **  STEP 21--                                     **
20560C               **  SORT Y AND SORT X                             **
20561C               ****************************************************
20562C
20563      IF(NHIGH.LE.0)THEN
20564        IF(IQQNPR.GT.0)THEN
20565          CALL PERCE2(IQQNPR,X,NX,IWRITE,TEMP2,MAXN,TEMP1,
20566     1                IBUGG3,ISUBRO,IERROR)
20567          DO2010II=1,IQQNPR
20568            X(II)=TEMP1(II)
20569 2010     CONTINUE
20570          NX=IQQNPR
20571C
20572          CALL PERCE2(IQQNPR,Y,NY,IWRITE,TEMP2,MAXN,TEMP1,
20573     1                IBUGG3,ISUBRO,IERROR)
20574          DO2020II=1,IQQNPR
20575            Y(II)=TEMP2(II)
20576 2020     CONTINUE
20577          NY=IQQNPR
20578C
20579        ELSE
20580          CALL SORT(X,NX,X)
20581          CALL SORT(Y,NY,Y)
20582        ENDIF
20583      ELSEIF(NY.LE.NX)THEN
20584        CALL SORT(X,NX,X)
20585        CALL SORTC(Y,XHIGH,NY,Y,XDIST)
20586        DO2101I=1,NY
20587          XHIGH(I)=XDIST(I)
20588 2101   CONTINUE
20589      ELSEIF(NY.GT.NX)THEN
20590        CALL SORT(Y,NY,Y)
20591        CALL SORTC(X,XHIGH,NX,X,XDIST)
20592        DO2103I=1,NX
20593          XHIGH(I)=XDIST(I)
20594 2103   CONTINUE
20595      ENDIF
20596C
20597C               *****************************************
20598C               **  STEP 22--                          **
20599C               **  DETERMINE THE TYPE CASE            **
20600C               **  EQUAL SAMPLE SIZES OR NOT)         **
20601C               **  AND BRANCH ACORDINGLY              **
20602C               *****************************************
20603C
20604      ICASE='UNEQ'
20605      IF(NY.EQ.NX)ICASE='EQUA'
20606      IF(ICASE.EQ.'EQUA')GOTO5100
20607C
20608C               **************************************************
20609C               **  STEP 23--                                   **
20610C               **  DETERMINE THE SMALLER OF THE 2--            **
20611C               **  NY OR NX                                    **
20612C               **  DETERMINE THE LARGER OF THE 2--             **
20613C               **  NY OR NX                                    **
20614C               **************************************************
20615C
20616      NSMALL=NX
20617      IF(NY.LT.NX)NSMALL=NY
20618      ANSMAL=NSMALL
20619C
20620      NLARGE=NX
20621      IF(NY.GT.NX)NLARGE=NY
20622      ANLARG=NLARGE
20623C
20624C               ****************************************************
20625C               **  STEP 24--                                     **
20626C               **  STEP THROUGH THE VARIOUS SORTED VALUES OF     **
20627C               **  THE SMALLER OF Y OR X.                        **
20628C               **  COMPUTE A CORRESPONDING PERCENTAGE.           **
20629C               **  ESTIMATE THIS PERCENT  POINT                  **
20630C               **  IN THE LARGER OF Y OR X.                      **
20631C               ****************************************************
20632C
20633      DO2400I=1,NSMALL
20634        AI=I
20635        PSMALL=(AI-0.5)/ANSMAL
20636        IF(NY.LE.NX)YSMALL(I)=Y(I)
20637        IF(NY.GT.NX)YSMALL(I)=X(I)
20638C
20639        PLARGE=0.0
20640        DO2410J=1,NLARGE
20641          AJ=J
20642          J2=J
20643          J2M1=J2-1
20644          PPRIOR=PLARGE
20645          PLARGE=(AJ-0.5)/ANLARG
20646C
20647          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TUM2')THEN
20648            WRITE(ICOUT,777)I,J,J2,J2M1,PSMALL,PLARGE,PPRIOR
20649  777       FORMAT('I,J,J2,J2M1,PSMALL,PLARGE,PPRIOR = ',4I8,3G15.7)
20650            CALL DPWRST('XXX','BUG ')
20651          ENDIF
20652C
20653          IF(PLARGE.LT.PSMALL)GOTO2410
20654          IF(PLARGE.EQ.PSMALL)THEN
20655            IF(NY.LE.NX)YLARGE(I)=X(J2)
20656            IF(NY.GT.NX)YLARGE(I)=Y(J2)
20657          ELSE
20658            RATIO=(PSMALL-PPRIOR)/(PLARGE-PPRIOR)
20659            IF(NY.LE.NX)YLARGE(I)=RATIO*X(J2M1)+(1.0-RATIO)*X(J2)
20660            IF(NY.GT.NX)YLARGE(I)=RATIO*Y(J2M1)+(1.0-RATIO)*Y(J2)
20661          ENDIF
20662          GOTO2400
20663 2410   CONTINUE
20664 2400 CONTINUE
20665C
20666C               *******************************************
20667C               **  STEP 51--                            **
20668C               **  FORM PLOT COORDINATES                **
20669C               *******************************************
20670C
20671 5100 CONTINUE
20672C
20673      ISTEPN='51'
20674      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TUM2')
20675     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20676C
20677      IF(NHIGH.GT.0)THEN
20678        CALL CODE(XHIGH,NHIGH,IWRITE,XDIST,D2,MAXN,IBUGG3,IERROR)
20679        CALL MAXIM(XDIST,NHIGH,IWRITE,XMAX,IBUGG3,IERROR)
20680      ELSE
20681        XMAX=1.0
20682      ENDIF
20683C
20684      IF(ICASE.EQ.'EQUA')THEN
20685        J=0
20686        DO5111I=1,NY
20687          J=J+1
20688          ADIFF=Y(I)-X(I)
20689          AMEAN=(Y(I)+X(I))/2.0
20690          Y2(J)=ADIFF
20691          X2(J)=AMEAN
20692          IF(NHIGH.EQ.0)THEN
20693            D2(J)=1.0
20694          ELSE
20695            D2(J)=XDIST(J)
20696          ENDIF
20697 5111   CONTINUE
20698        J=J+1
20699        X2(J)=X2(1)
20700        Y2(J)=0.0
20701        D2(J)=XMAX+1.0
20702        J=J+1
20703        X2(J)=X2(NY)
20704        Y2(J)=0.0
20705        D2(J)=XMAX+1.0
20706C
20707      ELSE
20708C
20709        J=0
20710        DO5121I=1,NSMALL
20711          J=J+1
20712          IF(NY.LE.NX)Y2(J)=YSMALL(I)
20713          IF(NY.GT.NX)Y2(J)=YLARGE(I)
20714          IF(NY.LE.NX)X2(J)=YLARGE(I)
20715          IF(NY.GT.NX)X2(J)=YSMALL(I)
20716          IF(NHIGH.EQ.0)THEN
20717            D2(J)=1.0
20718          ELSE
20719            D2(J)=XDIST(J)
20720          ENDIF
20721          ADIFF=Y2(J)-X2(J)
20722          AMEAN=(Y2(J)+X2(J))/2.0
20723          Y2(J)=ADIFF
20724          X2(J)=AMEAN
20725 5121   CONTINUE
20726C
20727        J=J+1
20728        X2(J)=X2(1)
20729        Y2(J)=0.0
20730        D2(J)=XMAX+1.0
20731        J=J+1
20732        X2(J)=X2(NSMALL)
20733        Y2(J)=0.0
20734        D2(J)=XMAX+1.0
20735      ENDIF
20736C
20737      N2=J
20738      NPLOTV=3
20739C
20740C               *****************
20741C               **  STEP 90--  **
20742C               **  EXIT       **
20743C               *****************
20744C
20745 9000 CONTINUE
20746      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TUM2')THEN
20747        WRITE(ICOUT,999)
20748        CALL DPWRST('XXX','BUG ')
20749        WRITE(ICOUT,9011)
20750 9011   FORMAT('***** AT THE END       OF DPTUM2--')
20751        CALL DPWRST('XXX','BUG ')
20752        WRITE(ICOUT,9012)ICASPL,ICASE,IERROR,MAXNXT,N2
20753 9012   FORMAT('ICASPL,ICASE,IERROR,MAXNXT,N2 = ',3(A4,2X),2I8)
20754        CALL DPWRST('XXX','BUG ')
20755        DO9015I=1,N2
20756          WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
20757 9016     FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
20758          CALL DPWRST('XXX','BUG ')
20759 9015   CONTINUE
20760        WRITE(ICOUT,9031)NY,NX,NSMALL,NLARGE,RATIO
20761 9031   FORMAT('NY,NX,NSMALL,NLARGE,RATIO = ',4I8,G15.7)
20762        CALL DPWRST('XXX','BUG ')
20763        DO9032I=1,NLARGE
20764          WRITE(ICOUT,9033)I,YLARGE(I)
20765 9033     FORMAT('I,YLARGE(I) = ',I8,E15.7)
20766          CALL DPWRST('XXX','BUG ')
20767 9032   CONTINUE
20768        DO9042I=1,NSMALL
20769          WRITE(ICOUT,9043)I,YSMALL(I)
20770 9043     FORMAT('I,YSMALL(I) = ',I8,E15.7)
20771          CALL DPWRST('XXX','BUG ')
20772 9042   CONTINUE
20773      ENDIF
20774C
20775      RETURN
20776      END
20777      SUBROUTINE DPTWFP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
20778     1                  IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
20779C
20780C     PURPOSE--GIVEN DATA OF THE FORM
20781C
20782C                 RESPONSE   LAB-ID  MAT-ID
20783C
20784C              GENERATE EITHER A "LABORATORIES WITHIN MATERIALS"
20785C              OR A "MATERIALS WITHIN LABORATORIES" PLOT.
20786C
20787C              THIS IS ESSENTIALLY A RUN SEQUENCE PLOT SORTED
20788C              BY 2 FACTOR VARIABLES.
20789C
20790C              THIS PLOT IS MOTIVATED BY THE DESIRE TO PLOT
20791C              RESIDUALS FOR THE "PHASE 3" ANALYSIS IN THE
20792C              ASTM E-691 STANDARD.  THE PHASE 3 ANALYSIS
20793C              (ESSENTIALLY A ROW-LINEAR MODEL FOR THE TABLE)
20794C              WAS SUGGESTED BY JOHN MANDEL (SEE REFERENCES
20795C              BELOW) AS AN ADDITIONAL STEP IN THE E-691 ANALYSIS
20796C              (THE PHASE 3 ANALYSIS IS NOT PART OF THE STANDARD).
20797C              IN PARTICULAR, HE RECOMMENDED A PLOT OF THE
20798C              STANDARDIZED RESIDUALS FROM THE ROW-LINEAR MODEL
20799C              (SPECIFIC PLOTS FOR THE H AND K CONSISTENCY
20800C              STATISTICS CAN ALREADY BE GENERATED USING THE
20801C              H CONSISTENCY PLOT COMMAND).
20802C
20803C              ALTHOUGH MOTIVATED BY THE EXTENSION TO THE
20804C              ASTM E-691 STANDARD, THIS PLOT CAN BE APPLIED
20805C              TO ANY TWO FACTOR SET OF DATA.
20806C
20807C              THERE ARE TWO FORMATS FOR THE PLOT:
20808C
20809C              1) THE VALUES ARE PLOTTED LINEARLY.  THAT IS,
20810C
20811C                 LAB:  1  2  3  1  2  3  1  2  3
20812C                 MAT:  1  1  1  2  2  2  3  3  3
20813C
20814C              2) YOU CAN STACK THE LAB VALUES VERTICALLY
20815C
20816C                 LAB:  1  1  1
20817C                       2  2  2
20818C                       3  3  3
20819C                 MAT:  1  2  3
20820C
20821C              MULTIPLE AND REPLICATION OPTIONS ARE NOT SUPPORTED
20822C              FOR THIS PLOT.
20823C
20824C
20825C     EXAMPLE--TWO FACTOR PLOT Y LABID MATID
20826C     WRITTEN BY--ALAN HECKERT
20827C                 STATISTICAL ENGINEERING DIVISION
20828C                 INFORMATION TECHNOLOGY LABORATORY
20829C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20830C                 GAITHERSBURG, MD 20899-8980
20831C                 PHONE--301-975-2899
20832C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20833C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20834C     LANGUAGE--ANSI FORTRAN (1977)
20835C     VERSION NUMBER--2015/6
20836C     ORIGINAL VERSION--JUNE       2015.
20837C
20838C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20839C
20840      CHARACTER*4 ICASPL
20841      CHARACTER*4 IAND1
20842      CHARACTER*4 IAND2
20843      CHARACTER*4 IBUGG2
20844      CHARACTER*4 IBUGG3
20845      CHARACTER*4 IBUGQ
20846      CHARACTER*4 ISUBRO
20847      CHARACTER*4 IFOUND
20848      CHARACTER*4 IERROR
20849C
20850      CHARACTER*4 ISUBN1
20851      CHARACTER*4 ISUBN2
20852      CHARACTER*4 ISTEPN
20853C
20854      CHARACTER*40 INAME
20855      PARAMETER (MAXSPN=10)
20856      CHARACTER*4 IVARN1(MAXSPN)
20857      CHARACTER*4 IVARN2(MAXSPN)
20858      CHARACTER*4 IVARTY(MAXSPN)
20859      REAL PVAR(MAXSPN)
20860      INTEGER ILIS(MAXSPN)
20861      INTEGER NRIGHT(MAXSPN)
20862      INTEGER ICOLR(MAXSPN)
20863C
20864C---------------------------------------------------------------------
20865C
20866      INCLUDE 'DPCOPA.INC'
20867      INCLUDE 'DPCOZZ.INC'
20868C
20869      REAL Y1(MAXOBV)
20870      REAL MATID(MAXOBV)
20871      REAL LABID(MAXOBV)
20872      REAL XIDTEM(MAXOBV)
20873      REAL XIDTE2(MAXOBV)
20874      REAL TEMP1(MAXOBV)
20875      REAL TEMP2(MAXOBV)
20876C
20877      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
20878      EQUIVALENCE (GARBAG(IGARB2),MATID(1))
20879      EQUIVALENCE (GARBAG(IGARB3),LABID(1))
20880      EQUIVALENCE (GARBAG(IGARB4),XIDTEM(1))
20881      EQUIVALENCE (GARBAG(IGARB5),XIDTE2(1))
20882      EQUIVALENCE (GARBAG(IGARB6),TEMP1(1))
20883      EQUIVALENCE (GARBAG(IGARB7),TEMP2(1))
20884C
20885C-----COMMON----------------------------------------------------------
20886C
20887      INCLUDE 'DPCOST.INC'
20888      INCLUDE 'DPCOHO.INC'
20889      INCLUDE 'DPCOHK.INC'
20890      INCLUDE 'DPCODA.INC'
20891      INCLUDE 'DPCOP2.INC'
20892C
20893C-----START POINT-----------------------------------------------------
20894C
20895      IERROR='NO'
20896      IFOUND='NO'
20897      ISUBN1='DPTW'
20898      ISUBN2='FP  '
20899C
20900      MAXCP1=MAXCOL+1
20901      MAXCP2=MAXCOL+2
20902      MAXCP3=MAXCOL+3
20903      MAXCP4=MAXCOL+4
20904      MAXCP5=MAXCOL+5
20905      MAXCP6=MAXCOL+6
20906C
20907C               ****************************************
20908C               **  TREAT THE TWO FACTOR PLOT CASE    **
20909C               ****************************************
20910C
20911      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWFP')THEN
20912        WRITE(ICOUT,999)
20913  999   FORMAT(1X)
20914        CALL DPWRST('XXX','BUG ')
20915        WRITE(ICOUT,51)
20916   51   FORMAT('***** AT THE BEGINNING OF DPTWFP--')
20917        CALL DPWRST('XXX','BUG ')
20918        WRITE(ICOUT,52)IBUGG2,IBUGG3,IBUGQ,ISUBRO
20919   52   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
20920        CALL DPWRST('XXX','BUG ')
20921        WRITE(ICOUT,53)ICASPL,IAND1,IAND2,MAXN
20922   53   FORMAT('ICASPL,IAND1,IAND2,MAXN = ',3(A4,2X),I8)
20923        CALL DPWRST('XXX','BUG ')
20924      ENDIF
20925C
20926C               ***************************
20927C               **  STEP 1--             **
20928C               **  EXTRACT THE COMMAND  **
20929C               ***************************
20930C
20931      ISTEPN='11'
20932      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWFP')
20933     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20934C
20935      IF(NUMARG.GE.2.AND.ICOM.EQ.'TWO '.AND.IHARG(1).EQ.'FACT'.AND.
20936     1  IHARG(2).EQ.'PLOT')THEN
20937        ILASTC=2
20938        ICASPL='TWFP'
20939      ELSE
20940        GOTO9000
20941      ENDIF
20942C
20943      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
20944      IFOUND='YES'
20945C
20946C               ****************************************
20947C               **  STEP 2--                          **
20948C               **  EXTRACT THE VARIABLE LIST         **
20949C               ****************************************
20950C
20951      ISTEPN='2'
20952      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWFP')
20953     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20954C
20955      INAME='TWO FACTOR PLOT'
20956      MINNA=3
20957      MAXNA=100
20958      MINN2=5
20959      IFLAGE=1
20960      IFLAGM=0
20961      IFLAGP=0
20962      JMIN=1
20963      JMAX=NUMARG
20964      MINNVA=3
20965      MAXNVA=3
20966C
20967      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
20968     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
20969     1            JMIN,JMAX,
20970     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
20971     1            IVARN1,IVARN2,IVARTY,PVAR,
20972     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
20973     1            MINNVA,MAXNVA,
20974     1            IFLAGM,IFLAGP,
20975     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
20976      IF(IERROR.EQ.'YES')GOTO9000
20977C
20978      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWFP')THEN
20979        WRITE(ICOUT,999)
20980        CALL DPWRST('XXX','BUG ')
20981        WRITE(ICOUT,281)
20982  281   FORMAT('***** AFTER CALL DPPARS--')
20983        CALL DPWRST('XXX','BUG ')
20984        WRITE(ICOUT,282)NQ,NUMVAR
20985  282   FORMAT('NQ,NUMVAR = ',2I8)
20986        CALL DPWRST('XXX','BUG ')
20987        IF(NUMVAR.GT.0)THEN
20988          DO285I=1,NUMVAR
20989            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
20990     1                      ICOLR(I),IVARTY(I)
20991  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
20992     1             'ICOLR(I),IVARTY(I) = ',I8,2X,A4,A4,2X,3I8,2X,A4)
20993            CALL DPWRST('XXX','BUG ')
20994  285     CONTINUE
20995        ENDIF
20996      ENDIF
20997C
20998C               **********************************************
20999C               **  STEP 33--                               **
21000C               **  FORM THE SUBSETTED VARIABLES            **
21001C               **       Y(.)                               **
21002C               **       LABID(.)                           **
21003C               **       MATID(.)                           **
21004C               **********************************************
21005C
21006      ISTEPN='33'
21007      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWFP')
21008     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21009C
21010      ICOL=1
21011      CALL DPPAR5(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
21012     1            INAME,IVARN1,IVARN2,IVARTY,
21013     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
21014     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
21015     1            MAXCP4,MAXCP5,MAXCP6,
21016     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
21017     1            Y1,LABID,MATID,XIDTEM,XIDTEM,XIDTEM,XIDTEM,NS,
21018     1            IBUGG3,ISUBRO,IFOUND,IERROR)
21019      IF(IERROR.EQ.'YES')GOTO9000
21020C
21021C               *******************************************************
21022C               **  STEP 8--                                         **
21023C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            **
21024C               **  VALUES Y(.) AND X(.) FOR THE PLOT.               **
21025C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).    **
21026C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).    **
21027C               *******************************************************
21028C
21029      ISTEPN='5'
21030      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWFP')
21031     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21032C
21033      CALL DPTWF2(Y1,LABID,MATID,NS,NUMVAR,ICASPL,
21034     1            ITWFPT,ITWFGP,ITWFLM,
21035     1            ITWFM1,ITWFM2,ITWFL1,ITWFL2,
21036     1            XIDTEM,XIDTE2,TEMP1,TEMP2,
21037     1            Y,X,D,
21038     1            NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
21039C
21040C               *****************
21041C               **  STEP 9--   **
21042C               **  EXIT       **
21043C               *****************
21044C
21045 9000 CONTINUE
21046      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWFP')THEN
21047        WRITE(ICOUT,999)
21048        CALL DPWRST('XXX','BUG ')
21049        WRITE(ICOUT,9011)
21050 9011   FORMAT('***** AT THE END       OF DPTWFP--')
21051        CALL DPWRST('XXX','BUG ')
21052        WRITE(ICOUT,9013)IFOUND,IERROR
21053 9013   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
21054        CALL DPWRST('XXX','BUG ')
21055        WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
21056 9014   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',3I8,3(2X,A4))
21057        CALL DPWRST('XXX','BUG ')
21058      ENDIF
21059C
21060      RETURN
21061      END
21062      SUBROUTINE DPTWF2(Y1,LABID,MATID,N,NUMVAR,ICASPL,
21063     1                  ITWFPT,ITWFGP,ITWFLM,
21064     1                  ITWFM1,ITWFM2,ITWFL1,ITWFL2,
21065     1                  XIDTEM,XIDTE2,TEMP1,TEMP2,
21066     1                  Y,X,D,
21067     1                  NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
21068C
21069C     PURPOSE--GIVEN DATA OF THE FORM
21070C
21071C                 RESPONSE   LAB-ID  MAT-ID
21072C
21073C              GENERATE EITHER A "LABORATORIES WITHIN MATERIALS"
21074C              OR A "MATERIALS WITHIN LABORATORIES" PLOT.
21075C
21076C              THIS IS ESSENTIALLY A RUN SEQUENCE PLOT SORTED
21077C              BY 2 FACTOR VARIABLES.
21078C
21079C              THIS PLOT IS MOTIVATED BY THE DESIRE TO PLOT
21080C              RESIDUALS FOR THE "PHASE 3" ANALYSIS IN THE
21081C              ASTM E-691 STANDARD.  THE PHASE 3 ANALYSIS
21082C              (ESSENTIALLY A ROW-LINEAR MODEL FOR THE TABLE)
21083C              WAS SUGGESTED BY JOHN MANDEL (SEE REFERENCES
21084C              BELOW) AS AN ADDITIONAL STEP IN THE E-691 ANALYSIS
21085C              (THE PHASE 3 ANALYSIS IS NOT PART OF THE STANDARD).
21086C              IN PARTICULAR, HE RECOMMENDED A PLOT OF THE
21087C              STANDARDIZED RESIDUALS FROM THE ROW-LINEAR MODEL
21088C              (SPECIFIC PLOTS FOR THE H AND K CONSISTENCY
21089C              STATISTICS CAN ALREADY BE GENERATED USING THE
21090C              H CONSISTENCY PLOT COMMAND).
21091C
21092C              ALTHOUGH MOTIVATED BY THE EXTENSION TO THE
21093C              ASTM E-691 STANDARD, THIS PLOT CAN BE APPLIED
21094C              TO ANY TWO FACTOR SET OF DATA.
21095C
21096C              THERE ARE TWO FORMATS FOR THE PLOT:
21097C
21098C              1) THE VALUES ARE PLOTTED LINEARLY.  THAT IS,
21099C
21100C                 LAB:  1  2  3  1  2  3  1  2  3
21101C                 MAT:  1  1  1  2  2  2  3  3  3
21102C
21103C              2) YOU CAN STACK THE LAB VALUES VERTICALLY
21104C
21105C                 LAB:  1  1  1
21106C                       2  2  2
21107C                       3  3  3
21108C                 MAT:  1  2  3
21109C
21110C              MULTIPLE AND REPLICATION OPTIONS ARE NOT SUPPORTED
21111C              FOR THIS PLOT.
21112C
21113C     REFERENCES--"Standard Practice for Conducting an Interlaboratory
21114C                 Study to Determine the Precision of a Test Method",
21115C                 ASTM International, 100 Barr Harbor Drive, PO BOX C700,
21116C                 West Conshohoceken, PA 19428-2959, USA.
21117C               --Mandel (1994), "Analyzing Interlaboratory Data
21118C                 According to ASTM Standard E691", Quality and
21119C                 Statistics: Total Quality Management,ASTM STP 1209,
21120C                 Kowalewski, Ed., American Society for Testing and
21121C                 Materials, Philadelphia, PA 1994, pp. 59-70.
21122C               --Mandel (1995), "Structure and Outliers in
21123C                 Interlaboratory Studies", Journal of Testing and
21124C                 Evaluation, Vol. 23, No. 5, pp. 364-369.
21125C               --Mandel (1991), "Evaluation and Control of
21126C                 Measurements", Marcel Dekker, Inc., chapter 7.
21127C     WRITTEN BY--ALAN HECKERT
21128C                 STATISTICAL ENGINEERING DIVISION
21129C                 INFORMATION TECHNOLOGY LABORATORY
21130C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21131C                 GAITHERSBURG, MD 20899-8980
21132C                 PHONE--301-975-2899
21133C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21134C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21135C     LANGUAGE--ANSI FORTRAN (1977)
21136C     VERSION NUMBER--2015/6
21137C     ORIGINAL VERSION--JUNE      2015.
21138C
21139C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21140C
21141      CHARACTER*4 ICASPL
21142      CHARACTER*4 ITWFPT
21143      CHARACTER*4 ITWFLM
21144      CHARACTER*4 IBUGG3
21145      CHARACTER*4 ISUBRO
21146      CHARACTER*4 IERROR
21147C
21148      CHARACTER*4 IWRITE
21149      CHARACTER*4 ISUBN1
21150      CHARACTER*4 ISUBN2
21151      CHARACTER*4 ISTEPN
21152C
21153C---------------------------------------------------------------------
21154C
21155      REAL Y1(*)
21156      REAL MATID(*)
21157      REAL LABID(*)
21158      REAL XIDTEM(*)
21159      REAL XIDTE2(*)
21160      REAL TEMP1(*)
21161      REAL TEMP2(*)
21162C
21163      REAL Y(*)
21164      REAL X(*)
21165      REAL D(*)
21166C
21167C-----COMMON----------------------------------------------------------
21168C
21169      INCLUDE 'DPCOP2.INC'
21170C
21171C-----START POINT-----------------------------------------------------
21172C
21173      ISUBN1='DPTW'
21174      ISUBN2='F2  '
21175      IWRITE='OFF'
21176      IERROR='NO'
21177      NPLOTP=0
21178      NPLOTV=3
21179C
21180      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TWF2')THEN
21181        WRITE(ICOUT,999)
21182        CALL DPWRST('XXX','BUG ')
21183        WRITE(ICOUT,71)
21184   71   FORMAT('***** AT THE BEGINNING OF DPTWF2--')
21185        CALL DPWRST('XXX','BUG ')
21186        WRITE(ICOUT,72)IBUGG3,ISUBRO,ICASPL,N,NUMVAR
21187   72   FORMAT('IBUGG3,ISUBRO,ICASPL,N,NUMVAR = ',3(A4,2X),2I8)
21188        CALL DPWRST('XXX','BUG ')
21189        IF(N.GT.0)THEN
21190          DO81I=1,N
21191            WRITE(ICOUT,82)I,Y1(I),MATID(I),LABID(I)
21192   82       FORMAT('I,Y1(I),MATID(I),LABID(I) = ',I8,3G15.7)
21193            CALL DPWRST('XXX','BUG ')
21194   81     CONTINUE
21195        ENDIF
21196      ENDIF
21197C
21198C               ********************************************
21199C               **  STEP 1--                              **
21200C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
21201C               ********************************************
21202C
21203      IF(N.LT.5)THEN
21204        WRITE(ICOUT,999)
21205  999   FORMAT(1X)
21206        CALL DPWRST('XXX','BUG ')
21207        WRITE(ICOUT,31)
21208   31   FORMAT('***** ERROR IN TWO FACTOR PLOT--')
21209        CALL DPWRST('XXX','BUG ')
21210        WRITE(ICOUT,32)
21211   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 5.')
21212        CALL DPWRST('XXX','BUG ')
21213        WRITE(ICOUT,34)N
21214   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
21215        CALL DPWRST('XXX','BUG ')
21216        WRITE(ICOUT,999)
21217        CALL DPWRST('XXX','BUG ')
21218        IERROR='YES'
21219        GOTO9000
21220      ENDIF
21221C
21222C               ******************************************************
21223C               **  STEP 1--                                        **
21224C               **  DETERMINE THE NUMBER OF DISTINCT VALUES         **
21225C               **  FOR THE GROUP VARIABLES (LABID, MATID).         **
21226C               **  CHECK FOR MISSING CELLS AND FOR REPLICATION     **
21227C               **  WITHIN CELLS (REPLICATED VALUES WILL BE         **
21228C               **  REPLACED WITH THEIR MEAN VALUE).                **
21229C               ******************************************************
21230C
21231      ISTEPN='1'
21232      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TWF2')
21233     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21234C
21235      CALL DISTIN(LABID,N,IWRITE,XIDTEM,NUMSE1,IBUGG3,IERROR)
21236      CALL SORT(XIDTEM,NUMSE1,XIDTEM)
21237      CALL DISTIN(MATID,N,IWRITE,XIDTE2,NUMSE2,IBUGG3,IERROR)
21238      CALL SORT(XIDTE2,NUMSE2,XIDTE2)
21239C
21240C     CHECK FOR MISSING CELLS (PLOT CURRENTLY NOT SUPPORTED FOR
21241C     CASE WHERE THERE IS MISSING CELLS).  IF REPLICATION IS DETECTED,
21242C     REPLACE RAW DATA WITH CELL AVERAGES.
21243C
21244      IREPL=0
21245      DO110ISET1=1,NUMSE1
21246        AHOLD1=XIDTEM(ISET1)
21247        DO120ISET2=1,NUMSE2
21248          AHOLD2=XIDTE2(ISET2)
21249          K=0
21250          DO130I=1,N
21251            IF(LABID(I).EQ.AHOLD1 .AND. MATID(I).EQ.AHOLD2)THEN
21252              K=K+1
21253              GOTO139
21254            ENDIF
21255  130     CONTINUE
21256  139     CONTINUE
21257          IF(K.EQ.0)THEN
21258            WRITE(ICOUT,999)
21259            CALL DPWRST('XXX','BUG ')
21260            WRITE(ICOUT,31)
21261            CALL DPWRST('XXX','BUG ')
21262            WRITE(ICOUT,142)
21263  142       FORMAT('      THERE IS NO DATA FOR:')
21264            CALL DPWRST('XXX','BUG ')
21265            WRITE(ICOUT,144)AHOLD1
21266  144       FORMAT('      GROUP ONE VARIABLE WITH VALUE: ',G15.7)
21267            CALL DPWRST('XXX','BUG ')
21268            WRITE(ICOUT,146)AHOLD2
21269  146       FORMAT('      GROUP TWO VARIABLE WITH VALUE: ',G15.7)
21270            CALL DPWRST('XXX','BUG ')
21271            WRITE(ICOUT,148)
21272  148       FORMAT('      THIS COMMAND IS NOT SUPPORTED FOR THE CASE ',
21273     1             'WHERE THERE ARE MISSING CELLS.')
21274            CALL DPWRST('XXX','BUG ')
21275            IERROR='YES'
21276            GOTO9000
21277          ELSEIF(K.GT.1)THEN
21278            IREPL=1
21279          ENDIF
21280  120   CONTINUE
21281  110 CONTINUE
21282C
21283C     IF REPLICATION DETECTED, REPLACE RAW VALUES WITH MEANS
21284C
21285      ICNT=0
21286      IF(IREPL.EQ.1)THEN
21287        DO210ISET1=1,NUMSE1
21288          AHOLD1=XIDTEM(ISET1)
21289          DO220ISET2=1,NUMSE2
21290            AHOLD2=XIDTE2(ISET2)
21291            K=0
21292            DO230I=1,N
21293              IF(LABID(I).EQ.AHOLD1 .AND. MATID(I).EQ.AHOLD2)THEN
21294                K=K+1
21295                TEMP1(K)=Y(I)
21296              ENDIF
21297  230       CONTINUE
21298C
21299            ICNT=ICNT+1
21300            IF(K.EQ.1)THEN
21301              TEMP2(ICNT)=TEMP1(1)
21302            ELSE
21303              CALL MEAN(TEMP1,K,IWRITE,XMEAN,IBUGG3,IERROR)
21304              TEMP2(ICNT)=XMEAN
21305            ENDIF
21306            XIDTEM(ICNT)=AHOLD1
21307            XIDTE2(ICNT)=AHOLD2
21308C
21309  220     CONTINUE
21310  210   CONTINUE
21311C
21312        DO310I=1,ICNT
21313          Y(I)=TEMP2(I)
21314          LABID(I)=XIDTEM(I)
21315          MATID(I)=XIDTE2(I)
21316  310   CONTINUE
21317        N=ICNT
21318      ENDIF
21319C
21320C
21321C
21322C               ********************************************
21323C               **  STEP 2--                              **
21324C               **  GENERATE THE PLOT COORDINATES.        **
21325C               ********************************************
21326C
21327C       NOTE: TYPICALLY, WE WANT TO COMPUTE THE H AND K CONSISTENCY
21328C             STATISTICS BASED ON ALL LAB's AND MATERIALS.  HOWEVER,
21329C             WE SOMETIMES WANT TO RESTRICT THE PLOT TO A SUBSET
21330C             OF MATERIALS OR LABORATORIES FOR BETTER PLOT
21331C             RESOLUTION.
21332C
21333C             TO ADDRESS THIS, THE FOLLOWING COMMANDS WERE ADDED:
21334C
21335C                 SET TWO FACTOR PLOT MATERIAL   FIRST <value>
21336C                 SET TWO FACTOR PLOT MATERIAL   LAST  <value>
21337C                 SET TWO FACTOR PLOT LABORATORY FIRST <value>
21338C                 SET TWO FACTOR PLOT LABORATORY LAST  <value>
21339C
21340      IWRITE='OFF'
21341      CALL DISTIN(LABID,N,IWRITE,XIDTEM,NLAB,IBUGG3,IERROR)
21342      CALL DISTIN(MATID,N,IWRITE,XIDTE2,NMAT,IBUGG3,IERROR)
21343      NTOT=NLAB*NMAT
21344      IMAT1=ITWFM1
21345      IF(IMAT1.LT.1 .OR. IMAT1.GT.NMAT)IMAT1=1
21346      IMAT2=ITWFM2
21347      IF(IMAT2.LT.1 .OR. IMAT2.GT.NMAT)IMAT2=NMAT
21348      ILAB1=ITWFL1
21349      IF(ILAB1.LT.1 .OR. ILAB1.GT.NLAB)ILAB1=1
21350      ILAB2=ITWFL2
21351      IF(ILAB2.LT.1 .OR. ILAB2.GT.NLAB)ILAB2=NLAB
21352      IF(IMAT1.GT.IMAT2)IMAT1=IMAT2
21353      IF(ILAB1.GT.ILAB2)ILAB1=ILAB2
21354C
21355      NPLOTP=0
21356C
21357      IF(ITWFPT.EQ.'DEFA')THEN
21358        IXCNT=0
21359        IXCNT2=0
21360        IF(ITWFLM.EQ.'LABO')THEN
21361          DO1010J=1,NMAT
21362            DO1020I=1,NLAB
21363              IXCNT=IXCNT+1
21364              IF(J.LT.IMAT1 .OR. J.GT.IMAT2)GOTO1020
21365              IF(I.LT.ILAB1 .OR. I.GT.ILAB2)GOTO1020
21366              IXCNT2=IXCNT2+1
21367              NPLOTP=NPLOTP+1
21368              Y(NPLOTP)=Y1(IXCNT)
21369              X(NPLOTP)=REAL(IXCNT2)
21370              D(NPLOTP)=1.0
21371 1020       CONTINUE
21372            IF(ITWFGP.GT.0 .AND. J.LT.NMAT)IXCNT2=IXCNT2+ITWFGP
21373 1010     CONTINUE
21374          ITAG=1
21375          NLAST=IXCNT2
21376        ELSE
21377          DO1030J=1,NLAB
21378            DO1040I=1,NMAT
21379              IF(J.LT.ILAB1 .OR. J.GT.ILAB2)GOTO1040
21380              IF(I.LT.IMAT1 .OR. I.GT.IMAT2)GOTO1040
21381              IXCNT=IXCNT+1
21382              IXCNT2=IXCNT2+1
21383              IXCNT3=(I-1)*NLAB + J
21384              NPLOTP=NPLOTP+1
21385              Y(NPLOTP)=Y1(IXCNT3)
21386              X(NPLOTP)=REAL(IXCNT2)
21387              D(NPLOTP)=1.0
21388 1040       CONTINUE
21389            IF(ITWFGP.GT.0 .AND. J.LT.NMAT)IXCNT2=IXCNT2+ITWFGP
21390 1030     CONTINUE
21391          ITAG=1
21392          NLAST=IXCNT2
21393        ENDIF
21394      ELSE
21395        IXCNT=0
21396        IF(ITWFLM.EQ.'LABO')THEN
21397          DO1110J=1,NMAT
21398            DO1120I=1,NLAB
21399              IXCNT=IXCNT+1
21400              IF(J.LT.IMAT1 .OR. J.GT.IMAT2)GOTO1120
21401              IF(I.LT.ILAB1 .OR. I.GT.ILAB2)GOTO1120
21402              NPLOTP=NPLOTP+1
21403              Y(NPLOTP)=Y1(IXCNT)
21404              X(NPLOTP)=REAL(J)
21405              D(NPLOTP)=REAL(I)
21406 1120       CONTINUE
21407 1110     CONTINUE
21408          ITAG=NLAB
21409          NLAST=NMAT
21410        ELSE
21411          DO1130J=1,NLAB
21412            DO1140I=1,NMAT
21413              IF(J.LT.ILAB1 .OR. J.GT.ILAB2)GOTO1140
21414              IF(I.LT.IMAT1 .OR. I.GT.IMAT2)GOTO1140
21415              IXCNT=IXCNT+1
21416              NPLOTP=NPLOTP+1
21417              IXCNT3=(I-1)*NLAB + J
21418              Y(NPLOTP)=Y1(IXCNT3)
21419              X(NPLOTP)=REAL(J)
21420              D(NPLOTP)=REAL(I)
21421 1140       CONTINUE
21422 1130     CONTINUE
21423          ITAG=NMAT
21424          NLAST=NLAB
21425        ENDIF
21426      ENDIF
21427C
21428C               *****************
21429C               **  STEP 90--  **
21430C               **  EXIT       **
21431C               *****************
21432C
21433 9000 CONTINUE
21434      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TWF2')THEN
21435        WRITE(ICOUT,999)
21436        CALL DPWRST('XXX','BUG ')
21437        WRITE(ICOUT,9011)
21438 9011   FORMAT('***** AT THE END       OF DPTWF2--')
21439        CALL DPWRST('XXX','BUG ')
21440        WRITE(ICOUT,9013)IERROR,NPLOTP,NPLOTV
21441 9013   FORMAT('IERROR,NPLOTP,NPLOTV = ',A4,2X,2I8)
21442        CALL DPWRST('XXX','BUG ')
21443        IF(NPLOTP.GT.0)THEN
21444          DO9035I=1,NPLOTP
21445            WRITE(ICOUT,9036)I,Y(I),X(I),D(I)
21446 9036       FORMAT('I,Y(I),X(I),D(I) = ',I8,2G15.7,F9.2)
21447            CALL DPWRST('XXX','BUG ')
21448 9035     CONTINUE
21449        ENDIF
21450      ENDIF
21451C
21452      RETURN
21453      END
21454      SUBROUTINE DPTWPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
21455     1                  ICAPSW,ICAPTY,IFORSW,
21456     1                  IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
21457C
21458C     PURPOSE--GENERATE MANDEL'S ROW-LINEAR OR COLUMN-LINEAR PLOTS FOR
21459C              JOHN MANDEL'S TWO-WAY TABLE ANALYSIS
21460C
21461C     WRITTEN BY--ALAN HECKERT
21462C                 STATISTICAL ENGINEERING DIVISION
21463C                 INFORMATION TECHNOLOGY LABORATORY
21464C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21465C                 GAITHERSBURG, MD 20899-8980
21466C                 PHONE--301-975-2899
21467C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21468C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21469C     LANGUAGE--ANSI FORTRAN (1977)
21470C     VERSION NUMBER--2015/06
21471C     ORIGINAL VERSION--JUNE      2015.
21472C
21473C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21474C
21475      CHARACTER*4 ICAPSW
21476      CHARACTER*4 ICAPTY
21477      CHARACTER*4 IFORSW
21478      CHARACTER*4 ICASPL
21479      CHARACTER*4 ICASP2
21480      CHARACTER*4 IAND1
21481      CHARACTER*4 IAND2
21482      CHARACTER*4 ICONT
21483      CHARACTER*4 ISUBRO
21484      CHARACTER*4 IBUGG2
21485      CHARACTER*4 IBUGG3
21486      CHARACTER*4 IBUGQ
21487      CHARACTER*4 IFOUND
21488      CHARACTER*4 IERROR
21489C
21490      CHARACTER*4 ISUBN1
21491      CHARACTER*4 ISUBN2
21492      CHARACTER*4 ISTEPN
21493C
21494      CHARACTER*40 INAME
21495      PARAMETER (MAXSPN=30)
21496      CHARACTER*4 IVARN1(MAXSPN)
21497      CHARACTER*4 IVARN2(MAXSPN)
21498      CHARACTER*4 IVARTY(MAXSPN)
21499      REAL PVAR(MAXSPN)
21500      INTEGER ILIS(MAXSPN)
21501      INTEGER NRIGHT(MAXSPN)
21502      INTEGER ICOLR(MAXSPN)
21503      CHARACTER*12 IX1LAB
21504      CHARACTER*12 IX2LAB
21505      CHARACTER*25 IYLAB
21506C
21507C---------------------------------------------------------------------
21508C
21509      INCLUDE 'DPCOPA.INC'
21510      INCLUDE 'DPCOZZ.INC'
21511C
21512      DIMENSION Y1(MAXOBV)
21513      DIMENSION TAG1(MAXOBV)
21514      DIMENSION TAG2(MAXOBV)
21515      DIMENSION XIDTEM(MAXOBV)
21516      DIMENSION XIDTE2(MAXOBV)
21517      DIMENSION TEMP1(MAXOBV)
21518      DIMENSION TEMP2(MAXOBV)
21519      DIMENSION TEMP3(MAXOBV)
21520      DIMENSION TEMP4(MAXOBV)
21521      DIMENSION TEMP5(MAXOBV)
21522C
21523      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
21524      EQUIVALENCE (GARBAG(IGARB2),XIDTEM(1))
21525      EQUIVALENCE (GARBAG(IGARB3),XIDTE2(1))
21526      EQUIVALENCE (GARBAG(IGARB4),TEMP1(1))
21527      EQUIVALENCE (GARBAG(IGARB5),TEMP2(1))
21528      EQUIVALENCE (GARBAG(IGARB6),TEMP3(1))
21529      EQUIVALENCE (GARBAG(IGARB7),TEMP4(1))
21530      EQUIVALENCE (GARBAG(IGARB8),TEMP5(1))
21531      EQUIVALENCE (GARBAG(IGARB9),TAG1(1))
21532      EQUIVALENCE (GARBAG(IGAR10),TAG2(1))
21533C
21534C-----COMMON----------------------------------------------------------
21535C
21536      INCLUDE 'DPCOHK.INC'
21537      INCLUDE 'DPCODA.INC'
21538      INCLUDE 'DPCOHO.INC'
21539      INCLUDE 'DPCOST.INC'
21540      INCLUDE 'DPCOP2.INC'
21541C
21542C-----START POINT-----------------------------------------------------
21543C
21544      IERROR='NO'
21545      ISUBN1='DPTW'
21546      ISUBN2='PL  '
21547      ICASPL='TWOW'
21548      ICASP2='ROW'
21549C
21550      MAXCP1=MAXCOL+1
21551      MAXCP2=MAXCOL+2
21552      MAXCP3=MAXCOL+3
21553      MAXCP4=MAXCOL+4
21554      MAXCP5=MAXCOL+5
21555      MAXCP6=MAXCOL+6
21556C
21557C               ******************************************
21558C               **  TREAT THE CROSS TABULATE PLOT CASE  **
21559C               ******************************************
21560C
21561      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWPL')THEN
21562        WRITE(ICOUT,999)
21563  999   FORMAT(1X)
21564        CALL DPWRST('XXX','BUG ')
21565        WRITE(ICOUT,51)
21566   51   FORMAT('***** AT THE BEGINNING OF DPTWPL--')
21567        CALL DPWRST('XXX','BUG ')
21568        WRITE(ICOUT,52)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
21569   52   FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',5(A4,2X),A4)
21570        CALL DPWRST('XXX','BUG ')
21571        WRITE(ICOUT,53)ICASPL,IAND1,IAND2
21572   53   FORMAT('ICASPL,IAND1,IAND2 = ',2(A4,2X),A4)
21573        CALL DPWRST('XXX','BUG ')
21574      ENDIF
21575C
21576C               *************************************
21577C               **  STEP 1--                       **
21578C               **  EXTRACT THE COMMAND            **
21579C               **  COMMAND SYNTAX IS:             **
21580C               **  TWO-WAY <ROW/COLUMN> PLOT      **
21581C               *************************************
21582C
21583      ISTEPN='1'
21584      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWPL')
21585     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21586C
21587      IF(NUMARG.LE.2)GOTO9000
21588      IF(ICOM.EQ.'TWO ' .AND. IHARG(1).EQ.'WAY')THEN
21589        IF(IHARG(2).EQ.'PLOT')THEN
21590          IFOUND='YES'
21591          ILASTC=2
21592        ELSEIF(IHARG(2).EQ.'ROW ' .AND. IHARG(3).EQ.'PLOT')THEN
21593          IFOUND='YES'
21594          ILASTC=3
21595        ELSEIF(IHARG(2).EQ.'COLU' .AND. IHARG(3).EQ.'PLOT')THEN
21596          ICASP2='COLU'
21597          IFOUND='YES'
21598          ILASTC=3
21599        ELSE
21600          IFOUND='NO'
21601          GOTO9000
21602        ENDIF
21603      ENDIF
21604C
21605      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
21606C
21607C               *********************************
21608C               **  STEP 2--                   **
21609C               **  EXTRACT THE VARIABLE LIST  **
21610C               *********************************
21611C
21612      INAME='TWO-WAY ROW PLOT'
21613      IF(ICASP2.EQ.'COLU') INAME='TWO-WAY COLUMN PLOT'
21614      MINNA=1
21615      MAXNA=100
21616      MINN2=5
21617      IFLAGE=1
21618      IFLAGM=8
21619      IFLAGP=0
21620      JMIN=1
21621      JMAX=NUMARG
21622      MINNVA=3
21623      MAXNVA=3
21624C
21625      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
21626     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
21627     1            JMIN,JMAX,
21628     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
21629     1            IVARN1,IVARN2,IVARTY,PVAR,
21630     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
21631     1            MINNVA,MAXNVA,
21632     1            IFLAGM,IFLAGP,
21633     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
21634      IF(IERROR.EQ.'YES')GOTO9000
21635C
21636      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWPL')THEN
21637        WRITE(ICOUT,999)
21638        CALL DPWRST('XXX','BUG ')
21639        WRITE(ICOUT,281)
21640  281   FORMAT('***** AFTER CALL DPPARS--')
21641        CALL DPWRST('XXX','BUG ')
21642        WRITE(ICOUT,282)NQ,NUMVAR
21643  282   FORMAT('NQ,NUMVAR = ',2I8)
21644        CALL DPWRST('XXX','BUG ')
21645        IF(NUMVAR.GT.0)THEN
21646          DO285I=1,NUMVAR
21647            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
21648     1                      ICOLR(I)
21649  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
21650     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
21651            CALL DPWRST('XXX','BUG ')
21652  285     CONTINUE
21653        ENDIF
21654      ENDIF
21655C
21656C     NEED FOLLOWING VARIABLES:
21657C     1) TWO GROUP-ID VARIABLE
21658C     2) ONE RESPONSE VARIABLE
21659C        VARIABLES
21660C
21661C
21662C               ********************************
21663C               **  STEP 3--                  **
21664C               **  EXTRACT THE DATA          **
21665C               ********************************
21666C
21667      ISTEPN='3'
21668      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWPL')
21669     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21670C
21671      IYLAB=' '
21672      IX1LAB=' '
21673      IX2LAB=' '
21674      IF(NUMVAR.EQ.1)THEN
21675        ICOL=1
21676        IF(IVARLB(ICOLR(1)).EQ.' ')THEN
21677          IYLAB(1:4)=IVARN1(1)(1:4)
21678          IYLAB(5:8)=IVARN2(1)(1:4)
21679        ELSE
21680          IYLAB(1:25)=IVARLB(ICOLR(1))(1:25)
21681        ENDIF
21682        IX1LAB='ROW'
21683        IX2LAB='COLUMN'
21684        CALL DPPARZ(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
21685     1              INAME,IVARN1,IVARN2,IVARTY,
21686     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
21687     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
21688     1              MAXCP4,MAXCP5,MAXCP6,
21689     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
21690     1              Y1,TAG1,TAG2,NLOCAL,
21691     1              IBUGG3,ISUBRO,IFOUND,IERROR)
21692      ELSE
21693        ICOL=1
21694        IF(IVARLB(ICOLR(1)).EQ.' ')THEN
21695          IYLAB(1:4)=IVARN1(1)(1:4)
21696          IYLAB(5:8)=IVARN2(1)(1:4)
21697        ELSE
21698          IYLAB(1:25)=IVARLB(ICOLR(1))(1:25)
21699        ENDIF
21700        IF(IVARLB(ICOLR(2)).EQ.' ')THEN
21701          IX1LAB(1:4)=IVARN1(2)(1:4)
21702          IX1LAB(5:8)=IVARN2(2)(1:4)
21703        ELSE
21704          IX1LAB(1:12)=IVARLB(ICOLR(2))(1:12)
21705        ENDIF
21706        IF(IVARLB(ICOLR(3)).EQ.' ')THEN
21707          IX2LAB(1:4)=IVARN1(3)(1:4)
21708          IX2LAB(5:8)=IVARN2(3)(1:4)
21709        ELSE
21710          IX2LAB(1:12)=IVARLB(ICOLR(3))(1:12)
21711        ENDIF
21712        CALL DPPAR5(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
21713     1              INAME,IVARN1,IVARN2,IVARTY,
21714     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
21715     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
21716     1              MAXCP4,MAXCP5,MAXCP6,
21717     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
21718     1              Y1,TAG1,TAG2,TEMP1,TEMP1,TEMP1,TEMP1,NLOCAL,
21719     1              IBUGG3,ISUBRO,IFOUND,IERROR)
21720      ENDIF
21721      IF(IERROR.EQ.'YES')GOTO9000
21722C
21723C               ******************************************************
21724C               **  STEP 4--                                        **
21725C               **  FORM THE VERTICAL AND HORIZONTAL AXIS           **
21726C               **  VALUES Y(.) AND X(.) FOR THE PLOT.              **
21727C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).   **
21728C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).   **
21729C               ******************************************************
21730C
21731      ISTEPN='4'
21732      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWPL')
21733     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21734C
21735      CALL DPTWP2(Y1,TAG1,TAG2,NLOCAL,NUMVAR,ICASPL,ICASP2,
21736     1            IYLAB,IX1LAB,IX2LAB,
21737     1            ICAPSW,ICAPTY,IFORSW,
21738     1            TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,XIDTEM,XIDTE2,
21739     1            Y,X,D,NPLOTP,NPLOTV,ISUBRO,IBUGG3,IERROR)
21740C
21741C
21742C               *****************
21743C               **  STEP 90--  **
21744C               **  EXIT       **
21745C               *****************
21746C
21747 9000 CONTINUE
21748      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TWPL')THEN
21749        WRITE(ICOUT,999)
21750        CALL DPWRST('XXX','BUG ')
21751        WRITE(ICOUT,9011)
21752 9011   FORMAT('***** AT THE END       OF DPTWPL--')
21753        CALL DPWRST('XXX','BUG ')
21754        WRITE(ICOUT,9013)IFOUND,IERROR,NPLOTV,NPLOTP,NS
21755 9013   FORMAT('IFOUND,IERROR,NPLOTV,NPLOTP,NS = ',2(A4,2X),3I8)
21756        CALL DPWRST('XXX','BUG ')
21757        WRITE(ICOUT,9017)IHLEFT,IHLEF2,ICOLL,NLEFT
21758 9017   FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
21759        CALL DPWRST('XXX','BUG ')
21760        IF(IFOUND.EQ.'YES'.AND.NPLOTP.GT.0)THEN
21761          DO9025I=1,NPLOTP
21762            WRITE(ICOUT,9026)I,Y(I),X(I),D(I)
21763 9026       FORMAT('I,Y(I),X(I),D(I) = ',I8,3G15.7)
21764            CALL DPWRST('XXX','BUG ')
21765 9025     CONTINUE
21766        ENDIF
21767      ENDIF
21768C
21769      RETURN
21770      END
21771      SUBROUTINE DPTWP2(Y,TAG1,TAG2,N,NUMV2,ICASPL,ICASP2,
21772     1                  IYLAB,IX1LAB,IX2LAB,
21773     1                  ICAPSW,ICAPTY,IFORSW,
21774     1                  TEMP1,TEMP2,COLAVE,ROWAVE,SLOPES,XIDTEM,XIDTE2,
21775     1                  Y2,X2,D2,N2,NPLOTV,ISUBRO,IBUGG3,IERROR)
21776C
21777C     PURPOSE--GENERATE MANDEL'S ROW-LINEAR OR COLUMN-LINEAR PLOTS FOR
21778C              JOHN MANDEL'S TWO-WAY TABLE ANALYSIS
21779C     WRITTEN BY--ALAN HECKERT
21780C                 STATISTICAL ENGINEERING DIVISION
21781C                 INFORMATION TECHNOLOGY LABORATORY
21782C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21783C                 GAITHERSBURG, MD 20899-8980
21784C                 PHONE--301-975-2899
21785C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21786C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21787C     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
21788C     LANGUAGE--ANSI FORTRAN (1977)
21789C     VERSION NUMBER--2015/06
21790C     ORIGINAL VERSION--JUNE      2015.
21791C
21792C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21793C
21794      CHARACTER*4 ICAPSW
21795      CHARACTER*4 ICAPTY
21796      CHARACTER*4 IFORSW
21797      CHARACTER*4 ICASPL
21798      CHARACTER*4 ICASP2
21799      CHARACTER*25 IYLAB
21800      CHARACTER*12 IX1LAB
21801      CHARACTER*12 IX2LAB
21802      CHARACTER*4 ISUBRO
21803      CHARACTER*4 IBUGG3
21804      CHARACTER*4 IERROR
21805C
21806      CHARACTER*4 IWRITE
21807      CHARACTER*4 ISUBN1
21808      CHARACTER*4 ISUBN2
21809      CHARACTER*4 ISTEPN
21810      CHARACTER*4 IOP
21811C
21812C---------------------------------------------------------------------
21813C
21814      DIMENSION Y(*)
21815      DIMENSION TAG1(*)
21816      DIMENSION TAG2(*)
21817      DIMENSION Y2(*)
21818      DIMENSION X2(*)
21819      DIMENSION D2(*)
21820C
21821      DIMENSION TEMP1(*)
21822      DIMENSION TEMP2(*)
21823      DIMENSION COLAVE(*)
21824      DIMENSION ROWAVE(*)
21825      DIMENSION SLOPES(*)
21826      DIMENSION XIDTEM(*)
21827      DIMENSION XIDTE2(*)
21828C
21829      PARAMETER(NUMCLI=6)
21830      PARAMETER(MAXLIN=2)
21831      PARAMETER (MAXROW=45)
21832      CHARACTER*65 ITITLE
21833      CHARACTER*1  ITITL9
21834      CHARACTER*4  ALIGN(NUMCLI)
21835      CHARACTER*4  VALIGN(NUMCLI)
21836      INTEGER      IDIGIT(MAXROW)
21837      INTEGER      NTOT(MAXROW)
21838      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
21839      CHARACTER*40 ITTEMP
21840      CHARACTER*20 IVALUE(MAXROW,NUMCLI)
21841      CHARACTER*4  ITYPCO(NUMCLI)
21842      CHARACTER*1  IBASLC
21843      INTEGER      NCTIT2(MAXLIN,NUMCLI)
21844      INTEGER      NCVALU(MAXROW,NUMCLI)
21845      INTEGER      IWHTML(NUMCLI)
21846      INTEGER      IWRTF(NUMCLI)
21847      REAL         AMAT(MAXROW,NUMCLI)
21848      LOGICAL IFRST
21849      LOGICAL ILAST
21850      LOGICAL IFLAGA
21851      LOGICAL IFLAGB
21852C
21853      DOUBLE PRECISION DSUM
21854      DOUBLE PRECISION DSUM1
21855      DOUBLE PRECISION DSUM2
21856      DOUBLE PRECISION DSUM3
21857      DOUBLE PRECISION DTERM1
21858      DOUBLE PRECISION DTERM2
21859      DOUBLE PRECISION DSSTO
21860      DOUBLE PRECISION DSSROW
21861      DOUBLE PRECISION DSSCOL
21862      DOUBLE PRECISION DSSERR
21863      DOUBLE PRECISION DSSSL
21864      DOUBLE PRECISION DSSER2
21865      DOUBLE PRECISION DSSRGR
21866C
21867C-----COMMON----------------------------------------------------------
21868C
21869      INCLUDE 'DPCOST.INC'
21870C
21871      CHARACTER*4 IRTFMZ
21872      CHARACTER*4 IRTFMD
21873      COMMON/COMRTF/IRTFMD
21874C
21875C
21876C-----COMMON VARIABLES (GENERAL)--------------------------------------
21877C
21878      INCLUDE 'DPCOP2.INC'
21879C
21880C-----START POINT-----------------------------------------------------
21881C
21882      ISUBN1='DPTW'
21883      ISUBN2='P2  '
21884      IWRITE='OFF'
21885      IRTFSV=IRTFPS
21886      IRTFPS=16
21887      CALL DPCONA(92,IBASLC)
21888      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
21889        WRITE(ICOUT,103)IBASLC,IRTFPS
21890  103   FORMAT(A1,'fs',I2)
21891        CALL DPWRST('XXX','WRIT')
21892      ENDIF
21893C
21894      ATAG=0.0
21895C
21896      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TWP2')THEN
21897        WRITE(ICOUT,70)
21898   70   FORMAT('AT THE BEGINNING OF DPTWP2--')
21899        CALL DPWRST('XXX','BUG ')
21900        WRITE(ICOUT,71)IBUGG3,ISUBRO,ICASPL,ICASP2,N,NUMV2
21901   71   FORMAT('IBUGG3,ISUBRO,ICASPL,ICASP2,N,NUMV2 = ',4(A4,2X),2I8)
21902        CALL DPWRST('XXX','BUG ')
21903        WRITE(ICOUT,72)ITWOYA,ITWOFI,ITWOAV,ITWOAN
21904   72   FORMAT('ITWOYA,ITWOFI,ITWOAV,ITWOAN = ',3(A4,2X),A4)
21905        CALL DPWRST('XXX','BUG ')
21906        DO73I=1,N
21907          WRITE(ICOUT,74)I,Y(I),TAG1(I),TAG2(I)
21908   74     FORMAT('I, Y(I),TAG1(I)TAG2(I) = ',I8,5G15.7)
21909          CALL DPWRST('XXX','BUG ')
21910   73   CONTINUE
21911      ENDIF
21912C
21913C     WRITE FOLLOWING TO DPST1F.DAT
21914C
21915C       1. DPST1F.DAT: ROW, HEIGHT, SLOPE, RESSD, STANDARD ERROR OF SLOPE
21916C       2. DPST2F.DAT: COLUMN, COLUMN AVERAGE
21917C       3. DPST3F.DAT: ROW, COL, Y(ROW,COL), RES(ROW,COL), PRED(ROW,COL)
21918C
21919      IOP='OPEN'
21920      IFLG11=1
21921      IFLG21=1
21922      IFLG31=1
21923      IFLG41=0
21924      IFLG51=0
21925      CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLA41,IFLG51,
21926     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
21927     1            IBUGG3,ISUBRO,IERROR)
21928C
21929C     CHECK THE INPUT ARGUMENTS FOR ERRORS
21930C
21931      IF(N.LT.5)THEN
21932        WRITE(ICOUT,999)
21933  999   FORMAT(1X)
21934        CALL DPWRST('XXX','BUG ')
21935        WRITE(ICOUT,31)
21936   31   FORMAT('***** ERROR IN TWO-WAY <ROW/COLUMN> PLOT--')
21937        CALL DPWRST('XXX','BUG ')
21938        WRITE(ICOUT,32)
21939   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 5;')
21940        CALL DPWRST('XXX','BUG ')
21941        WRITE(ICOUT,34)N
21942   34   FORMAT('      THE NUMBER OF OBSERVATIONS = ',I6)
21943        CALL DPWRST('XXX','BUG ')
21944        WRITE(ICOUT,999)
21945        CALL DPWRST('XXX','BUG ')
21946        IERROR='YES'
21947        GOTO9000
21948      ENDIF
21949C
21950C               ******************************************************
21951C               **  STEP 1--                                        **
21952C               **  DETERMINE THE NUMBER OF DISTINCT VALUES         **
21953C               **  FOR THE GROUP VARIABLES (TAG1, TAG2)            **
21954C               **  IF ALL VALUES ARE DISTINCT, THEN THIS           **
21955C               **  IMPLIES WE HAVE THE NO REPLICATION CASE         **
21956C               **  WHICH IS AN ERROR CONDITION FOR A PLOT.         **
21957C               ******************************************************
21958C
21959      ISTEPN='1'
21960      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TWP2')
21961     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21962C
21963      CALL DISTIN(TAG1,N,IWRITE,XIDTEM,NUMSE1,IBUGG3,IERROR)
21964      CALL SORT(XIDTEM,NUMSE1,XIDTEM)
21965      CALL DISTIN(TAG2,N,IWRITE,XIDTE2,NUMSE2,IBUGG3,IERROR)
21966      CALL SORT(XIDTE2,NUMSE2,XIDTE2)
21967C
21968C     CHECK FOR MISSING CELLS (PLOT CURRENTLY NOT SUPPORTED FOR
21969C     CASE WHERE THERE IS MISSING CELLS).  IF REPLICATION IS DETECTED,
21970C     REPLACE RAW DATA WITH CELL AVERAGES.
21971C
21972      IREPL=0
21973      DO110ISET1=1,NUMSE1
21974        AHOLD1=XIDTEM(ISET1)
21975        DO120ISET2=1,NUMSE2
21976          AHOLD2=XIDTE2(ISET2)
21977          K=0
21978          DO130I=1,N
21979            IF(TAG1(I).EQ.AHOLD1 .AND. TAG2(I).EQ.AHOLD2)THEN
21980              K=K+1
21981              GOTO139
21982            ENDIF
21983  130     CONTINUE
21984  139     CONTINUE
21985          IF(K.EQ.0)THEN
21986            WRITE(ICOUT,999)
21987            CALL DPWRST('XXX','BUG ')
21988            WRITE(ICOUT,31)
21989            CALL DPWRST('XXX','BUG ')
21990            WRITE(ICOUT,142)
21991  142       FORMAT('      THERE IS NO DATA FOR:')
21992            CALL DPWRST('XXX','BUG ')
21993            WRITE(ICOUT,144)AHOLD1
21994  144       FORMAT('      GROUP ONE VARIABLE WITH VALUE: ',G15.7)
21995            CALL DPWRST('XXX','BUG ')
21996            WRITE(ICOUT,146)AHOLD2
21997  146       FORMAT('      GROUP TWO VARIABLE WITH VALUE: ',G15.7)
21998            CALL DPWRST('XXX','BUG ')
21999            WRITE(ICOUT,148)
22000  148       FORMAT('      THIS COMMAND IS NOT SUPPORTED FOR THE CASE ',
22001     1             'WHERE THERE ARE MISSING CELLS.')
22002            CALL DPWRST('XXX','BUG ')
22003            IERROR='YES'
22004            GOTO9000
22005          ELSEIF(K.GT.1)THEN
22006            IREPL=1
22007          ENDIF
22008  120   CONTINUE
22009  110 CONTINUE
22010C
22011C     IF REPLICATION DETECTED, REPLACE RAW VALUES WITH MEANS
22012C
22013      ICNT=0
22014      IF(IREPL.EQ.1)THEN
22015        DO210ISET1=1,NUMSE1
22016          AHOLD1=XIDTEM(ISET1)
22017          DO220ISET2=1,NUMSE2
22018            AHOLD2=XIDTE2(ISET2)
22019            K=0
22020            DO230I=1,N
22021              IF(TAG1(I).EQ.AHOLD1 .AND. TAG2(I).EQ.AHOLD2)THEN
22022                K=K+1
22023                TEMP1(K)=Y(I)
22024              ENDIF
22025  230       CONTINUE
22026C
22027            ICNT=ICNT+1
22028            IF(K.EQ.1)THEN
22029              TEMP2(ICNT)=TEMP1(1)
22030            ELSE
22031              CALL MEAN(TEMP1,K,IWRITE,XMEAN,IBUGG3,IERROR)
22032              TEMP2(ICNT)=XMEAN
22033            ENDIF
22034            XIDTEM(ICNT)=AHOLD1
22035            XIDTE2(ICNT)=AHOLD2
22036C
22037  220     CONTINUE
22038  210   CONTINUE
22039C
22040        DO310I=1,ICNT
22041          Y(I)=TEMP2(I)
22042          TAG1(I)=XIDTEM(I)
22043          TAG2(I)=XIDTE2(I)
22044  310   CONTINUE
22045        N=ICNT
22046      ENDIF
22047C
22048      AN=N
22049      ANUMS1=NUMSE1
22050      ANUMS2=NUMSE2
22051C
22052      NUMDIG=0
22053      IF(IPRINT.EQ.'ON')THEN
22054        NUMDIG=7
22055        IF(IFORSW.EQ.'1')NUMDIG=1
22056        IF(IFORSW.EQ.'2')NUMDIG=2
22057        IF(IFORSW.EQ.'3')NUMDIG=3
22058        IF(IFORSW.EQ.'4')NUMDIG=4
22059        IF(IFORSW.EQ.'5')NUMDIG=5
22060        IF(IFORSW.EQ.'6')NUMDIG=6
22061        IF(IFORSW.EQ.'7')NUMDIG=7
22062        IF(IFORSW.EQ.'8')NUMDIG=8
22063        IF(IFORSW.EQ.'9')NUMDIG=9
22064        IF(IFORSW.EQ.'0')NUMDIG=0
22065        IF(IFORSW.EQ.'E')NUMDIG=-2
22066        IF(IFORSW.EQ.'-2')NUMDIG=-2
22067        IF(IFORSW.EQ.'-3')NUMDIG=-3
22068        IF(IFORSW.EQ.'-4')NUMDIG=-4
22069        IF(IFORSW.EQ.'-5')NUMDIG=-5
22070        IF(IFORSW.EQ.'-6')NUMDIG=-6
22071        IF(IFORSW.EQ.'-7')NUMDIG=-7
22072        IF(IFORSW.EQ.'-8')NUMDIG=-8
22073        IF(IFORSW.EQ.'-9')NUMDIG=-9
22074      ENDIF
22075C
22076      NCX1=1
22077      DO906I=12,1,-1
22078        IF(IX1LAB(I:I).NE.' ')THEN
22079          NCX1=I
22080          GOTO908
22081        ENDIF
22082  906 CONTINUE
22083  908 CONTINUE
22084C
22085      NCX2=1
22086      DO916I=12,1,-1
22087        IF(IX2LAB(I:I).NE.' ')THEN
22088          NCX2=I
22089          GOTO918
22090        ENDIF
22091  916 CONTINUE
22092  918 CONTINUE
22093C
22094C
22095C               ****************************************************
22096C               **  STEP 11--                                     **
22097C               **  COMPUTE THE SPECIFIED STATISTIC               **
22098C               **  FOR EACH CROSS-TAB CATEGORY OF THE DATA, AND  **
22099C               **  THEN FOR THE FULL DATA SET                    **
22100C               ****************************************************
22101C
22102      ISTEPN='11'
22103      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TWP2')
22104     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
22105C
22106C     FOR "ROW" CASE, PLOT Y(ij) - R(i) VERSUS R(i) FOR ALL j.
22107C
22108C     THAT IS, WE PLOT DEVIATION FROM COLUMN AVERAGE VERSUS THE COLUMN AVERAGE
22109C
22110      IF(ICASP2.EQ.'ROW')THEN
22111C
22112        WRITE(IOUNI1,1001)
22113 1001   FORMAT(5X,'ROW',11X,'HEIGHT',10X,'SLOPE',10X,'RESSD',4X,
22114     1         'SD OF SLOPE',4X,'CORRELATION')
22115        WRITE(IOUNI2,1002)
22116 1002   FORMAT(2X,'COLUMN',6X,'COLUMN MEAN')
22117        WRITE(IOUNI3,1003)
22118 1003   FORMAT(2X,'ROW-ID',2X,'COL-ID',10X,'Y(ij)',7X,'PRED(ij)',8X,
22119     1         'RES(ij)',1X,'STAND. RES(ij)')
22120C
22121        ITITL9=' '
22122        NCTIT9=0
22123        ITITLE='Parameters of Row-Linear Fit for '
22124        WRITE(ITITLE(34:58),'(A25)')IYLAB
22125        NCTITL=58
22126C
22127        NUMLIN=2
22128        NUMCOL=6
22129        ITITL2(1,1)=' '
22130        ITITL2(2,1)=IX1LAB(1:NCX1)
22131        NCTIT2(1,1)=0
22132        NCTIT2(2,1)=NCX1
22133        ITITL2(1,2)=' '
22134        ITITL2(2,2)='Height'
22135        NCTIT2(1,2)=0
22136        NCTIT2(2,2)=6
22137        ITITL2(1,3)=' '
22138        ITITL2(2,3)='Slope'
22139        NCTIT2(1,3)=0
22140        NCTIT2(2,3)=5
22141        ITITL2(1,4)=' '
22142        ITITL2(2,4)='RESSD'
22143        NCTIT2(1,4)=0
22144        NCTIT2(2,4)=5
22145        ITITL2(1,5)='Standard Error'
22146        ITITL2(2,5)='of Slope'
22147        NCTIT2(1,5)=14
22148        NCTIT2(2,5)=8
22149        ITITL2(1,6)='Correlation'
22150        ITITL2(2,6)='Coefficient'
22151        NCTIT2(1,6)=11
22152        NCTIT2(2,6)=11
22153C
22154        NMAX=0
22155        NUMROW=NUMSE1
22156        IF(NUMROW.GT.MAXROW)NUMROW=NUMSE1
22157        DO1032II=1,NUMCOL
22158          VALIGN(II)='b'
22159          ALIGN(II)='r'
22160          NTOT(II)=15
22161          IF(II.EQ.1)NTOT(II)=10
22162          NMAX=NMAX+NTOT(II)
22163          IDIGIT(II)=NUMDIG
22164          ITYPCO(II)='NUME'
22165 1032   CONTINUE
22166        IDIGIT(1)=0
22167        IDIGIT(6)=4
22168        IF(ITWOLA.EQ.'VALU' .AND. ITWODE.GT.0)THEN
22169          IDIGIT(1)=ITWODE
22170        ENDIF
22171        DO1033II=1,MAXROW
22172        DO1035JJ=1,NUMCOL
22173          NCVALU(II,JJ)=0
22174          IVALUE(II,JJ)=' '
22175          NCVALU(II,JJ)=0
22176          AMAT(II,JJ)=0.0
22177 1035   CONTINUE
22178 1033   CONTINUE
22179C
22180        IWHTML(1)=125
22181        IWHTML(2)=150
22182        IWHTML(3)=150
22183        IWHTML(4)=150
22184        IWHTML(5)=150
22185        IWHTML(6)=150
22186        IWRTF(1)=1300
22187        IWRTF(2)=IWRTF(1)+1700
22188        IWRTF(3)=IWRTF(2)+1700
22189        IWRTF(4)=IWRTF(3)+1700
22190        IWRTF(5)=IWRTF(4)+1700
22191        IWRTF(6)=IWRTF(5)+1500
22192        IFRST=.TRUE.
22193        ILAST=.TRUE.
22194C
22195C       COMPUTE THE COLUMN AVERAGES
22196C
22197        DO1000ISET2=1,NUMSE2
22198C
22199          K=0
22200          DO1005I=1,N
22201            IF(TAG2(I).EQ.XIDTE2(ISET2))THEN
22202              K=K+1
22203              TEMP1(K)=Y(I)
22204            ENDIF
22205 1005     CONTINUE
22206C
22207          CALL MEAN(TEMP1,K,IWRITE,XMEAN,IBUGG3,IERROR)
22208          COLAVE(ISET2)=XMEAN
22209C
22210          IF(ITWOLA.EQ.'VALU')THEN
22211            WRITE(IOUNI2,1008)XIDTE2(ISET2),COLAVE(ISET2)
22212 1008       FORMAT(2E15.7)
22213          ELSE
22214            WRITE(IOUNI2,1007)ISET2,COLAVE(ISET2)
22215 1007       FORMAT(I8,2X,E15.7)
22216          ENDIF
22217C
22218 1000   CONTINUE
22219        CALL MINIM(COLAVE,NUMSE2,IWRITE,XMIN,IBUGG3,IERROR)
22220        CALL MAXIM(COLAVE,NUMSE2,IWRITE,XMAX,IBUGG3,IERROR)
22221        CALL MEAN(COLAVE,NUMSE2,IWRITE,XGRAND,IBUGG3,IERROR)
22222C
22223C       NOW COMPUTE DEVIATIONS FROM COLUMN AVERAGES FOR EACH ROW
22224C
22225        J=0
22226        ATAG=0.0
22227        DSUM=0.0D0
22228        ICNTRW=0
22229        DO1100ISET1=1,NUMSE1
22230C
22231          K=0
22232          DO1101I=1,N
22233            IF(TAG1(I).EQ.XIDTEM(ISET1))THEN
22234              K=K+1
22235              TEMP1(K)=Y(I)
22236            ENDIF
22237 1101     CONTINUE
22238C
22239C         NOW COMPUTE ROW AVERAGE
22240C
22241          CALL MEAN(TEMP1,K,IWRITE,AVAL,IBUGG3,IERROR)
22242          ROWAVE(ISET1)=AVAL
22243C
22244          ATAG=ATAG+1.0
22245          IF(ITWOYA.EQ.'RAW')THEN
22246            DO1103I=1,K
22247              J=J+1
22248              X2(J)=COLAVE(I)
22249              TEMP2(I)=TEMP1(I)
22250              Y2(J)=TEMP1(I)
22251              D2(J)=ATAG
22252 1103       CONTINUE
22253          ELSE
22254            DO1105I=1,K
22255              J=J+1
22256              X2(J)=COLAVE(I)
22257              TEMP2(I)=TEMP1(I) - COLAVE(I)
22258              Y2(J)=TEMP2(I)
22259              D2(J)=ATAG
22260 1105       CONTINUE
22261          ENDIF
22262          CALL LINFIT(TEMP2,COLAVE,K,
22263     1                PPA0,PPA1,XRESSD,XRESDF,PPCC,SDPPA0,SDPPA1,CCALBE,
22264     1                ISUBRO,IBUGG3,IERROR)
22265          ATAG=ATAG+1.0
22266          AY1=PPA0 + PPA1*XMIN
22267          AY2=PPA0 + PPA1*XMAX
22268          SLOPES(ISET1)=PPA1
22269C
22270          DO1108II=1,K
22271            PREDVA=PPA0 + PPA1*COLAVE(II)
22272            RESVA=TEMP2(II) - PREDVA
22273            RESVA2=RESVA/XRESSD
22274            IF(ITWOLA.EQ.'VALU')THEN
22275              WRITE(IOUNI3,1119)XIDTEM(ISET1),II,TEMP2(II),PREDVA,
22276     1                          RESVA,RESVA2
22277 1119         FORMAT(E15.7,I8,4E15.7)
22278            ELSE
22279              WRITE(IOUNI3,1109)ISET1,II,TEMP2(II),PREDVA,
22280     1                          RESVA,RESVA2
22281 1109         FORMAT(2I8,4E15.7)
22282            ENDIF
22283 1108     CONTINUE
22284C
22285          CALL MEAN(TEMP2,K,IWRITE,AVAL,IBUGG3,IERROR)
22286          ICNTRW=ICNTRW+1
22287          IF(ISET1.GT.MAXROW)THEN
22288            IF(ITWOFI.EQ.'ON')THEN
22289              CALL DPDTA4(ITITL9,NCTIT9,
22290     1                    ITITLE,NCTITL,ITITL2,NCTIT2,
22291     1                    MAXLIN,NUMLIN,NUMCLI,NUMCOL,
22292     1                    IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNTRW,
22293     1                    IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
22294     1                    ICAPSW,ICAPTY,IFRST,ILAST,
22295     1                    ISUBRO,IBUGG3,IERROR)
22296            ENDIF
22297            ICNTRW=1
22298          ENDIF
22299          IF(ITWOLA.EQ.'VALU')THEN
22300            AMAT(ICNTRW,1)=XIDTEM(ISET1)
22301          ELSE
22302            AMAT(ICNTRW,1)=REAL(ISET1)
22303          ENDIF
22304          AMAT(ICNTRW,2)=AVAL
22305          AMAT(ICNTRW,3)=PPA1
22306          AMAT(ICNTRW,4)=XRESSD
22307          AMAT(ICNTRW,5)=SDPPA1
22308          AMAT(ICNTRW,6)=PPCC
22309          DSUM=DSUM + DBLE(XRESSD)**2
22310C
22311          IF(ITWOLA.EQ.'VALU')THEN
22312            WRITE(IOUNI1,1106)XIDTEM(ISET1),AVAL,PPA1,XRESSD,SDPPA1,PPCC
22313 1106       FORMAT(6E15.7)
22314          ELSE
22315            WRITE(IOUNI1,1107)ISET1,AVAL,PPA1,XRESSD,SDPPA1,PPCC
22316 1107       FORMAT(I8,2X,5E15.7)
22317          ENDIF
22318C
22319          J=J+1
22320          X2(J)=XMIN
22321          Y2(J)=AY1
22322          D2(J)=ATAG
22323          J=J+1
22324          X2(J)=XMAX
22325          Y2(J)=AY2
22326          D2(J)=ATAG
22327 1100   CONTINUE
22328C
22329        IF(ITWOFI.EQ.'ON')THEN
22330          CALL DPDTA4(ITITL9,NCTIT9,
22331     1                ITITLE,NCTITL,ITITL2,NCTIT2,
22332     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
22333     1                IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNTRW,
22334     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
22335     1                ICAPSW,ICAPTY,IFRST,ILAST,
22336     1                ISUBRO,IBUGG3,IERROR)
22337C
22338          CALL SD(SLOPES,NUMSE1,IWRITE,SDSLOP,IBUGG3,IERROR)
22339C
22340          IRTFMZ=IRTFMD
22341          IRTFMD='OFF'
22342          IFLAGA=.TRUE.
22343          IFLAGB=.FALSE.
22344          ISIZE=0
22345          NTOTAL=40
22346          NBLNK1=0
22347          NBLNK2=0
22348          ITYPE=3
22349          ITTEMP='Standard Deviation of Slopes: '
22350          NCTEMP=30
22351          CALL DPDTXT(ITTEMP,NCTEMP,SDSLOP,NUMDIG,NTOTAL,
22352     1                NBLNK1,NBLNK2,IFLAGA,IFLAGB,ISIZE,
22353     1                ICAPSW,ICAPTY,ITYPE,ISUBRO,IBUGG3,IERROR)
22354C
22355          DTERM1=DSUM/DBLE(NUMSE1-1)
22356          AVAL=REAL(DSQRT(DTERM1))
22357          IFLAGA=.FALSE.
22358          IFLAGB=.TRUE.
22359          NBLNK2=2
22360          ITTEMP='Pooled Standard Deviation of Fit: '
22361          NCTEMP=34
22362          CALL DPDTXT(ITTEMP,NCTEMP,AVAL,NUMDIG,NTOTAL,
22363     1                NBLNK1,NBLNK2,IFLAGA,IFLAGB,ISIZE,
22364     1                ICAPSW,ICAPTY,ITYPE,ISUBRO,IBUGG3,IERROR)
22365          IRTFMD=IRTFMZ
22366        ENDIF
22367C
22368        ITITL9=' '
22369        NCTIT9=0
22370        ITITLE='Column Averages'
22371        NCTITL=15
22372C
22373        NUMLIN=2
22374        NUMCOL=2
22375        ITITL2(1,1)=' '
22376        ITITL2(2,1)=IX2LAB(1:NCX2)
22377        NCTIT2(1,1)=0
22378        NCTIT2(2,1)=NCX2
22379        ITITL2(1,2)='Column'
22380        ITITL2(2,2)='Average'
22381        NCTIT2(1,2)=6
22382        NCTIT2(2,2)=7
22383C
22384        NMAX=0
22385        NUMROW=NUMSE2
22386        DO1042II=1,NUMCOL
22387          VALIGN(II)='b'
22388          ALIGN(II)='r'
22389          NTOT(II)=15
22390          IF(II.EQ.1)NTOT(II)=12
22391          NMAX=NMAX+NTOT(II)
22392          IDIGIT(II)=NUMDIG
22393          ITYPCO(II)='NUME'
22394 1042   CONTINUE
22395        IDIGIT(1)=0
22396        IF(ITWOLA.EQ.'VALU' .AND. ITWODE.GT.0)THEN
22397          IDIGIT(1)=ITWODE
22398        ENDIF
22399        DO1043II=1,MAXROW
22400        DO1045JJ=1,NUMCOL
22401          NCVALU(II,JJ)=0
22402          IVALUE(II,JJ)=' '
22403          NCVALU(II,JJ)=0
22404          AMAT(II,JJ)=0.0
22405 1045   CONTINUE
22406 1043   CONTINUE
22407C
22408        IWHTML(1)=125
22409        IWHTML(2)=150
22410        IWRTF(1)=1300
22411        IWRTF(2)=IWRTF(1)+1700
22412        IFRST=.TRUE.
22413        ILAST=.TRUE.
22414C
22415        DO1051ISET2=1,NUMSE2
22416          IF(ITWOLA.EQ.'VALU')THEN
22417            AMAT(ISET2,1)=XIDTE2(ISET2)
22418          ELSE
22419            AMAT(ISET2,1)=REAL(ISET2)
22420          ENDIF
22421          AMAT(ISET2,2)=COLAVE(ISET2)
22422 1051   CONTINUE
22423C
22424        IF(ITWOAV.EQ.'ON')THEN
22425          CALL DPDTA4(ITITL9,NCTIT9,
22426     1                ITITLE,NCTITL,ITITL2,NCTIT2,
22427     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
22428     1                IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
22429     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
22430     1                ICAPSW,ICAPTY,IFRST,ILAST,
22431     1                ISUBRO,IBUGG3,IERROR)
22432C
22433          CALL MEAN(COLAVE,NUMSE2,IWRITE,GMEAN,IBUGG3,IERROR)
22434          IRTFMZ=IRTFMD
22435          IRTFMD='OFF'
22436          IFLAGA=.TRUE.
22437          IFLAGB=.TRUE.
22438          ISIZE=0
22439          NTOTAL=30
22440          NBLNK1=0
22441          NBLNK2=2
22442          ITYPE=3
22443          ITTEMP='Mean of Column Means: '
22444          NCTEMP=22
22445          CALL DPDTXT(ITTEMP,NCTEMP,GMEAN,NUMDIG,NTOTAL,
22446     1                NBLNK1,NBLNK2,IFLAGA,IFLAGB,ISIZE,
22447     1                ICAPSW,ICAPTY,ITYPE,ISUBRO,IBUGG3,IERROR)
22448          IRTFMD=IRTFMZ
22449        ENDIF
22450C
22451C       IF REQUESTED, GENERATE AN EXTENDED ANOVA TABLE
22452C
22453        IF(ITWOAN.EQ.'ON')THEN
22454C
22455C         COMPUTE SSTO
22456C
22457          DSUM1=0.0D0
22458          DTERM1=DBLE(NUMSE1)*DBLE(NUMSE2)*DBLE(XGRAND)**2
22459C
22460          DO1610II=1,N
22461            DSUM1=DSUM1 + DBLE(Y(II))**2
22462 1610     CONTINUE
22463          DSSTO=DSUM1 -DTERM1
22464C
22465C         COMPUTE SS(ROWS)
22466C
22467          DSUM1=0.0D0
22468          DO1620II=1,NUMSE1
22469            DSUM1=DSUM1 + DBLE(ROWAVE(II))**2
22470 1620     CONTINUE
22471          DSSROW=DBLE(NUMSE2)*DSUM1 - DTERM1
22472C
22473C         COMPUTE SS(COLS)
22474C
22475          DSUM1=0.0D0
22476          DO1630II=1,NUMSE2
22477            DSUM1=DSUM1 + DBLE(COLAVE(II))**2
22478 1630     CONTINUE
22479          DSSCOL=DBLE(NUMSE1)*DSUM1 - DTERM1
22480C
22481C         COMPUTE ERROR SUM OF SQUARES
22482C
22483          DSSERR=DSSTO - DSSROW - DSSCOL
22484C
22485          DSUM1=0.0D0
22486          DO1640II=1,NUMSE1
22487            DTERM1=DBLE(SLOPES(II) - 1.0)**2
22488            DSUM1=DSUM1 + DTERM1
22489 1640     CONTINUE
22490C
22491          DSUM2=0.0D0
22492          DO1650II=1,NUMSE2
22493            DTERM2=DBLE((COLAVE(II) - XGRAND)**2)
22494            DSUM2=DSUM2 + DTERM2
22495 1650     CONTINUE
22496          DSSSL=DSUM1*DSUM2
22497          DSSER2=DSSERR-DSSSL
22498C
22499C         COMPUTE SUM OF SQUARES FOR COHERENCE.  FORMULAS FROM
22500C         MANDEL's 1961 JASA PAPER.  THESE FURTHER DECOMPOSE
22501C         "SLOPE" SUM OF SQUARES INTO "CONCURRENCE" AND
22502C         "NON-CONCURRENCE".
22503C
22504          DSUM1=0.0D0
22505          DSUM2=0.0D0
22506          DSUM3=0.0D0
22507          DO1660II=1,NUMSE1
22508            DTERM1=DBLE(ROWAVE(II)-XGRAND)
22509            DSUM1=DSUM1 + DTERM1*DBLE(SLOPES(II))
22510            DSUM2=DSUM2 + DTERM1**2
22511 1660     CONTINUE
22512          DO1670JJ=1,NUMSE2
22513            DTERM1=DBLE(COLAVE(JJ)-XGRAND)
22514            DSUM3=DSUM3 + DTERM1**2
22515 1670     CONTINUE
22516          DSSRGR=(DSUM1**2/DSUM2)*DSUM3
22517          DSSNCN=DSSSL - DSSRGR
22518C
22519          ITITL9=' '
22520          NCTIT9=0
22521          ITITLE='ANOVA Table for Row-Linear Fit'
22522          NCTITL=30
22523C
22524          NUMLIN=2
22525          NUMCOL=4
22526          ITITL2(1,1)=' '
22527          ITITL2(2,1)='Source'
22528          NCTIT2(1,1)=0
22529          NCTIT2(2,1)=6
22530          ITITL2(1,2)='Degrees of'
22531          ITITL2(2,2)='Freedom'
22532          NCTIT2(1,2)=10
22533          NCTIT2(2,2)=7
22534          ITITL2(1,3)='Sum of'
22535          ITITL2(2,3)='Squares'
22536          NCTIT2(1,3)=6
22537          NCTIT2(2,3)=7
22538          ITITL2(1,4)='Mean'
22539          ITITL2(2,4)='Square'
22540          NCTIT2(1,4)=4
22541          NCTIT2(2,4)=6
22542          ITITL2(1,5)='F'
22543          ITITL2(2,5)='Statistic'
22544          NCTIT2(1,5)=1
22545          NCTIT2(2,5)=9
22546          ITITL2(1,6)=' '
22547          ITITL2(2,6)='F CDF'
22548          NCTIT2(1,6)=0
22549          NCTIT2(2,6)=5
22550C
22551          NMAX=0
22552          NUMROW=8
22553          IWRTF(1)=1900
22554          DO1742II=1,NUMCOL
22555            VALIGN(II)='b'
22556            ALIGN(II)='r'
22557            NTOT(II)=15
22558            IF(II.EQ.1)NTOT(II)=20
22559            NMAX=NMAX+NTOT(II)
22560            IDIGIT(II)=NUMDIG
22561            IF(II.GE.3.AND.II.LE.4.AND.ITWOAD.GE.-9)IDIGIT(II)=ITWOAD
22562            ITYPCO(II)='NUME'
22563            IWHTML(II)=150
22564            IF(II.GE.2)IWRTF(II)=IWRTF(II-1)+1700
22565 1742     CONTINUE
22566          IDIGIT(1)=0
22567          IDIGIT(2)=0
22568          ALIGN(1)='l'
22569          ITYPCO(1)='ALPH'
22570          DO1743II=1,MAXROW
22571          DO1745JJ=1,NUMCOL
22572            NCVALU(II,JJ)=0
22573            IVALUE(II,JJ)=' '
22574            NCVALU(II,JJ)=0
22575            AMAT(II,JJ)=0.0
22576 1745     CONTINUE
22577 1743     CONTINUE
22578C
22579          IFRST=.TRUE.
22580          ILAST=.TRUE.
22581C
22582C         LABEL
22583C
22584          IVALUE(1,1)='Total'
22585          NCVALU(1,1)=5
22586          IVALUE(2,1)='Rows'
22587          NCVALU(2,1)=4
22588          IVALUE(3,1)='Columns'
22589          NCVALU(3,1)=6
22590          IVALUE(4,1)='Error'
22591          NCVALU(4,1)=5
22592          IVALUE(5,1)='  Residuals'
22593          NCVALU(5,1)=11
22594          IVALUE(6,1)='  Slopes'
22595          NCVALU(6,1)=8
22596          IVALUE(7,1)='    Concurrence'
22597          NCVALU(7,1)=15
22598          IVALUE(8,1)='    Non-Concurrence'
22599          NCVALU(8,1)=19
22600C
22601C         DEGREES OF FREEDOM
22602C
22603          AMAT(1,2)=REAL(NUMSE1-1) + REAL(NUMSE2-1) +
22604     1              REAL((NUMSE1-1)*(NUMSE2-1))
22605          AMAT(2,2)=REAL(NUMSE1-1)
22606          AMAT(3,2)=REAL(NUMSE2-1)
22607          AMAT(4,2)=REAL((NUMSE1-1)*(NUMSE2-1))
22608          AMAT(5,2)=REAL((NUMSE1-1)*(NUMSE2-1)) - REAL(NUMSE1-1)
22609          AMAT(6,2)=REAL(NUMSE1-1)
22610          AMAT(7,2)=1.0
22611          AMAT(8,2)=REAL(NUMSE1-2)
22612C
22613C         SUM OF SQUARES
22614C
22615          AMAT(1,3)=REAL(DSSTO)
22616          AMAT(2,3)=REAL(DSSROW)
22617          AMAT(3,3)=REAL(DSSCOL)
22618          AMAT(4,3)=REAL(DSSERR)
22619          AMAT(5,3)=REAL(DSSER2)
22620          AMAT(6,3)=REAL(DSSSL)
22621          AMAT(7,3)=REAL(DSSRGR)
22622          AMAT(8,3)=REAL(DSSNCN)
22623C
22624C         MEAN SQUARE
22625C
22626          AMAT(1,4)=AMAT(1,3)/AMAT(1,2)
22627          AMAT(2,4)=AMAT(2,3)/AMAT(2,2)
22628          AMAT(3,4)=AMAT(3,3)/AMAT(3,2)
22629          AMAT(4,4)=AMAT(4,3)/AMAT(4,2)
22630          AMAT(5,4)=AMAT(5,3)/AMAT(5,2)
22631          AMAT(6,4)=AMAT(6,3)/AMAT(6,2)
22632          AMAT(7,4)=AMAT(7,3)/AMAT(7,2)
22633          AMAT(8,4)=AMAT(8,3)/AMAT(8,2)
22634C
22635          CALL DPDTA4(ITITL9,NCTIT9,
22636     1                ITITLE,NCTITL,ITITL2,NCTIT2,
22637     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
22638     1                IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
22639     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
22640     1                ICAPSW,ICAPTY,IFRST,ILAST,
22641     1                ISUBRO,IBUGG3,IERROR)
22642C
22643        ENDIF
22644C
22645C     FOR "COLUMN" CASE, PLOT Y(ij) - R(i) VERSUS R(i) FOR ALL j.
22646C
22647C     THAT IS, WE PLOT DEVIATION FROM ROW AVERAGE VERSUS THE ROW AVERAGE
22648C
22649      ELSE
22650C
22651        WRITE(IOUNI1,2001)
22652 2001   FORMAT(2X,'COLUMN',11X,'HEIGHT',10X,'SLOPE',10X,'RESSD',4X,
22653     1         'SD OF SLOPE',4X,'CORRELATION')
22654        WRITE(IOUNI2,2002)
22655 2002   FORMAT(5X,'ROW',9X,'ROW MEAN')
22656        WRITE(IOUNI3,2003)
22657 2003   FORMAT(2X,'ROW-ID',2X,'COL-ID',10X,'Y(ij)',7X,'PRED(ij)',8X,
22658     1         'RES(ij)',1X,'STAND. RES(ij)')
22659C
22660        ITITL9=' '
22661        NCTIT9=0
22662        ITITLE='Parameters of Column-Linear Fit for '
22663        WRITE(ITITLE(37:61),'(A25)')IYLAB
22664        NCTITL=61
22665C
22666        NUMLIN=2
22667        NUMCOL=6
22668        ITITL2(1,1)=' '
22669        ITITL2(2,1)=IX2LAB(1:NCX2)
22670        NCTIT2(1,1)=0
22671        NCTIT2(2,1)=NCX2
22672        ITITL2(1,2)=' '
22673        ITITL2(2,2)='Height'
22674        NCTIT2(1,2)=0
22675        NCTIT2(2,2)=6
22676        ITITL2(1,3)=' '
22677        ITITL2(2,3)='Slope'
22678        NCTIT2(1,3)=0
22679        NCTIT2(2,3)=5
22680        ITITL2(1,4)=' '
22681        ITITL2(2,4)='RESSD'
22682        NCTIT2(1,4)=0
22683        NCTIT2(2,4)=5
22684        ITITL2(1,5)='Standard Error'
22685        ITITL2(2,5)='of Slope'
22686        NCTIT2(1,5)=14
22687        NCTIT2(2,5)=8
22688        ITITL2(1,6)='Correlation'
22689        ITITL2(2,6)='Coefficient'
22690        NCTIT2(1,6)=11
22691        NCTIT2(2,6)=11
22692C
22693        NMAX=0
22694        NUMROW=NUMSE2
22695        IF(NUMROW.GT.MAXROW)NUMROW=NUMSE2
22696        DO2032II=1,NUMCOL
22697          VALIGN(II)='b'
22698          ALIGN(II)='r'
22699          NTOT(II)=15
22700          IF(II.EQ.1)NTOT(II)=12
22701          NMAX=NMAX+NTOT(II)
22702          IDIGIT(II)=NUMDIG
22703          ITYPCO(II)='NUME'
22704 2032   CONTINUE
22705        IDIGIT(1)=0
22706        IDIGIT(6)=4
22707        IF(ITWOLA.EQ.'VALU' .AND. ITWODE.GT.0)THEN
22708          IDIGIT(1)=ITWODE
22709        ENDIF
22710        DO2033II=1,MAXROW
22711        DO2035JJ=1,NUMCOL
22712          NCVALU(II,JJ)=0
22713          IVALUE(II,JJ)=' '
22714          NCVALU(II,JJ)=0
22715          AMAT(II,JJ)=0.0
22716 2035   CONTINUE
22717 2033   CONTINUE
22718C
22719        IWHTML(1)=125
22720        IWHTML(2)=150
22721        IWHTML(3)=150
22722        IWHTML(4)=150
22723        IWHTML(5)=150
22724        IWHTML(6)=150
22725        IWRTF(1)=1300
22726        IWRTF(2)=IWRTF(1)+1700
22727        IWRTF(3)=IWRTF(2)+1700
22728        IWRTF(4)=IWRTF(3)+1700
22729        IWRTF(5)=IWRTF(4)+1700
22730        IWRTF(6)=IWRTF(5)+1700
22731        IFRST=.TRUE.
22732        ILAST=.TRUE.
22733C
22734C       COMPUTE THE ROW AVERAGES
22735C
22736        DO2000ISET1=1,NUMSE1
22737C
22738          K=0
22739          DO2005I=1,N
22740            IF(TAG1(I).EQ.XIDTEM(ISET1))THEN
22741              K=K+1
22742              TEMP1(K)=Y(I)
22743            ENDIF
22744 2005     CONTINUE
22745C
22746          CALL MEAN(TEMP1,K,IWRITE,XMEAN,IBUGG3,IERROR)
22747          COLAVE(ISET1)=XMEAN
22748C
22749          IF(ITWOLA.EQ.'VALU')THEN
22750            WRITE(IOUNI2,2008)XIDTEM(ISET1),COLAVE(ISET1)
22751 2008       FORMAT(2E15.7)
22752          ELSE
22753            WRITE(IOUNI2,2007)ISET1,COLAVE(ISET1)
22754 2007       FORMAT(I8,2X,E15.7)
22755        ENDIF
22756C
22757 2000   CONTINUE
22758        CALL MINIM(COLAVE,NUMSE1,IWRITE,XMIN,IBUGG3,IERROR)
22759        CALL MAXIM(COLAVE,NUMSE1,IWRITE,XMAX,IBUGG3,IERROR)
22760C
22761C       NOW COMPUTE DEVIATIONS FROM ROW AVERAGES FOR EACH COLUMN
22762C
22763        J=0
22764        ATAG1=0.0
22765        DSUM=0.0D0
22766        ICNTRW=0
22767        DO2100ISET2=1,NUMSE2
22768C
22769          K=0
22770          DO2101I=1,N
22771            IF(TAG2(I).EQ.XIDTE2(ISET2))THEN
22772              K=K+1
22773              TEMP1(K)=Y(I)
22774            ENDIF
22775 2101     CONTINUE
22776C
22777C         NOW COMPUTE COLUMN AVERAGE
22778C
22779          CALL MEAN(TEMP1,K,IWRITE,AVAL,IBUGG3,IERROR)
22780          ROWAVE(ISET2)=AVAL
22781C
22782          ATAG=ATAG+1.0
22783          IF(ITWOYA.EQ.'RAW')THEN
22784            DO2103I=1,K
22785              J=J+1
22786              X2(J)=COLAVE(I)
22787              TEMP2(I)=TEMP1(I)
22788              Y2(J)=TEMP1(I)
22789              D2(J)=ATAG
22790 2103       CONTINUE
22791          ELSE
22792            DO2105I=1,K
22793              J=J+1
22794              X2(J)=COLAVE(I)
22795              TEMP2(I)=TEMP1(I) - COLAVE(I)
22796              Y2(J)=TEMP2(I)
22797              D2(J)=ATAG
22798 2105       CONTINUE
22799          ENDIF
22800          CALL LINFIT(TEMP2,COLAVE,K,
22801     1                PPA0,PPA1,XRESSD,XRESDF,PPCC,SDPPA0,SDPPA1,CCALBE,
22802     1                ISUBRO,IBUGG3,IERROR)
22803          ATAG=ATAG+1.0
22804          AY1=PPA0 + PPA1*XMIN
22805          AY2=PPA0 + PPA1*XMAX
22806          SLOPES(ISET2)=PPA1
22807C
22808          DO2108II=1,K
22809            PREDVA=PPA0 + PPA1*COLAVE(II)
22810            RESVA=TEMP2(II) - PREDVA
22811            RESVA2=RESVA2/XRESSD
22812            IF(ITWOLA.EQ.'VALU')THEN
22813              WRITE(IOUNI3,2119)XIDTE2(ISET2),II,TEMP2(II),PREDVA,
22814     1                          RESVA,RESVA2
22815 2119         FORMAT(E15.7,I8,4E15.7)
22816            ELSE
22817              WRITE(IOUNI3,2109)ISET2,II,TEMP2(II),PREDVA,
22818     1                          RESVA,RESVA2
22819 2109         FORMAT(2I8,4E15.7)
22820            ENDIF
22821 2108     CONTINUE
22822C
22823          CALL MEAN(TEMP2,K,IWRITE,AVAL,IBUGG3,IERROR)
22824          ICNTRW=ICNTRW+1
22825          IF(ISET2.GT.MAXROW)THEN
22826            IF(ITWOFI.EQ.'ON')THEN
22827              CALL DPDTA4(ITITL9,NCTIT9,
22828     1                    ITITLE,NCTITL,ITITL2,NCTIT2,
22829     1                    MAXLIN,NUMLIN,NUMCLI,NUMCOL,
22830     1                    IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNTRW,
22831     1                    IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
22832     1                    ICAPSW,ICAPTY,IFRST,ILAST,
22833     1                    ISUBRO,IBUGG3,IERROR)
22834            ENDIF
22835            ICNTRW=ICNTRW+1
22836          ENDIF
22837          IF(ITWOLA.EQ.'VALU')THEN
22838            AMAT(ICNTRW,1)=XIDTE2(ISET2)
22839          ELSE
22840            AMAT(ICNTRW,1)=REAL(ISET2)
22841          ENDIF
22842          AMAT(ICNTRW,2)=AVAL
22843          AMAT(ICNTRW,3)=PPA1
22844          AMAT(ICNTRW,4)=XRESSD
22845          AMAT(ICNTRW,5)=SDPPA1
22846          AMAT(ICNTRW,6)=PPCC
22847          DSUM=DSUM + DBLE(XRESSD)**2
22848C
22849          IF(ITWOLA.EQ.'VALU')THEN
22850            WRITE(IOUNI1,2106)XIDTE2(ISET2),AVAL,PPA1,XRESSD,SDPPA1,PPCC
22851 2106       FORMAT(6E15.7)
22852          ELSE
22853            WRITE(IOUNI1,2107)ISET2,AVAL,PPA1,XRESSD,SDPPA1,PPCC
22854 2107       FORMAT(I8,2X,5E15.7)
22855          ENDIF
22856C
22857          J=J+1
22858          X2(J)=XMIN
22859          Y2(J)=AY1
22860          D2(J)=ATAG
22861          J=J+1
22862          X2(J)=XMAX
22863          Y2(J)=AY2
22864          D2(J)=ATAG
22865 2100   CONTINUE
22866C
22867        IF(ITWOFI.EQ.'ON')THEN
22868          CALL DPDTA4(ITITL9,NCTIT9,
22869     1                ITITLE,NCTITL,ITITL2,NCTIT2,
22870     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
22871     1                IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNTRW,
22872     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
22873     1                ICAPSW,ICAPTY,IFRST,ILAST,
22874     1                ISUBRO,IBUGG3,IERROR)
22875C
22876          CALL SD(SLOPES,NUMSE2,IWRITE,SDSLOP,IBUGG3,IERROR)
22877C
22878          IRTFMZ=IRTFMD
22879          IRTFMD='OFF'
22880          IFLAGA=.TRUE.
22881          IFLAGB=.FALSE.
22882          ISIZE=0
22883          NTOTAL=40
22884          NBLNK1=0
22885          NBLNK2=0
22886          ITYPE=2
22887          ITTEMP='Standard Deviation of Slopes: '
22888          NCTEMP=30
22889          CALL DPDTXT(ITTEMP,NCTEMP,SDSLOP,NUMDIG,NTOTAL,
22890     1              NBLNK1,NBLNK2,IFLAGA,IFLAGB,ISIZE,
22891     1              ICAPSW,ICAPTY,ITYPE,ISUBRO,IBUGG3,IERROR)
22892C
22893          DTERM1=DSUM/DBLE(NUMSE2-1)
22894          AVAL=REAL(DSQRT(DTERM1))
22895          IFLAGA=.FALSE.
22896          IFLAGB=.TRUE.
22897          NBLNK1=0
22898          NBLNK2=2
22899          ITYPE=2
22900          ITTEMP='Pooled Standard Deviation of Fit: '
22901          NCTEMP=34
22902          CALL DPDTXT(ITTEMP,NCTEMP,AVAL,NUMDIG,NTOTAL,
22903     1                NBLNK1,NBLNK2,IFLAGA,IFLAGB,ISIZE,
22904     1                ICAPSW,ICAPTY,ITYPE,ISUBRO,IBUGG3,IERROR)
22905          IRTFMD=IRTFMZ
22906        ENDIF
22907C
22908        ITITL9=' '
22909        NCTIT9=0
22910        ITITLE='Row Averages'
22911        NCTITL=12
22912C
22913        NUMLIN=2
22914        NUMCOL=2
22915        ITITL2(1,1)=' '
22916        ITITL2(2,1)=IX1LAB(1:NCX1)
22917        NCTIT2(1,1)=0
22918        NCTIT2(2,1)=NCX1
22919        ITITL2(1,2)='Row'
22920        ITITL2(2,2)='Average'
22921        NCTIT2(1,2)=3
22922        NCTIT2(2,2)=7
22923C
22924        NMAX=0
22925        NUMROW=NUMSE1
22926        DO2042II=1,NUMCOL
22927          VALIGN(II)='b'
22928          ALIGN(II)='r'
22929          NTOT(II)=15
22930          IF(II.EQ.1)NTOT(II)=12
22931          NMAX=NMAX+NTOT(II)
22932          IDIGIT(II)=NUMDIG
22933          ITYPCO(II)='NUME'
22934 2042   CONTINUE
22935        IDIGIT(1)=0
22936        IF(ITWOLA.EQ.'VALU' .AND. ITWODE.GT.0)THEN
22937          IDIGIT(1)=ITWODE
22938        ENDIF
22939        DO2043II=1,MAXROW
22940        DO2045JJ=1,NUMCOL
22941          NCVALU(II,JJ)=0
22942          IVALUE(II,JJ)=' '
22943          NCVALU(II,JJ)=0
22944          AMAT(II,JJ)=0.0
22945 2045   CONTINUE
22946 2043   CONTINUE
22947C
22948        IWHTML(1)=125
22949        IWHTML(2)=150
22950        IWRTF(1)=1300
22951        IWRTF(2)=IWRTF(1)+1700
22952        IFRST=.TRUE.
22953        ILAST=.TRUE.
22954C
22955        DO2051ISET1=1,NUMSE1
22956          IF(ITWOLA.EQ.'VALU')THEN
22957            AMAT(ISET1,1)=XIDTEM(ISET1)
22958          ELSE
22959            AMAT(ISET1,1)=REAL(ISET1)
22960          ENDIF
22961          AMAT(ISET1,2)=COLAVE(ISET1)
22962 2051   CONTINUE
22963C
22964        IF(ITWOAV.EQ.'ON')THEN
22965          CALL DPDTA4(ITITL9,NCTIT9,
22966     1                ITITLE,NCTITL,ITITL2,NCTIT2,
22967     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
22968     1                IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
22969     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
22970     1                ICAPSW,ICAPTY,IFRST,ILAST,
22971     1                ISUBRO,IBUGG3,IERROR)
22972C
22973          CALL MEAN(COLAVE,NUMSE1,IWRITE,GMEAN,IBUGG3,IERROR)
22974          IRTFMZ=IRTFMD
22975          IRTFMD='OFF'
22976          IFLAGA=.TRUE.
22977          IFLAGB=.TRUE.
22978          ISIZE=0
22979          NTOTAL=30
22980          NBLNK1=0
22981          NBLNK2=2
22982          ITYPE=2
22983          ITTEMP='Mean of Row Means: '
22984          NCTEMP=19
22985          CALL DPDTXT(ITTEMP,NCTEMP,GMEAN,NUMDIG,NTOTAL,
22986     1                NBLNK1,NBLNK2,IFLAGA,IFLAGB,ISIZE,
22987     1                ICAPSW,ICAPTY,ITYPE,ISUBRO,IBUGG3,IERROR)
22988          IRTFMD=IRTFMZ
22989        ENDIF
22990C
22991C       IF REQUESTED, GENERATE AN EXTENDED ANOVA TABLE
22992C
22993        IF(ITWOAN.EQ.'ON')THEN
22994C
22995C         COMPUTE SSTO
22996C
22997          DSUM1=0.0D0
22998          DTERM1=DBLE(NUMSE1)*DBLE(NUMSE2)*DBLE(XGRAND)**2
22999C
23000          DO2610II=1,N
23001            DSUM1=DSUM1 + DBLE(Y(II))**2
23002 2610     CONTINUE
23003          DSSTO=DSUM1 -DTERM1
23004C
23005C         COMPUTE SS(ROWS)
23006C
23007          DSUM1=0.0D0
23008          DO2620II=1,NUMSE1
23009            DSUM1=DSUM1 + DBLE(ROWAVE(II))**2
23010 2620     CONTINUE
23011          DSSROW=DBLE(NUMSE2)*DSUM1 - DTERM1
23012C
23013C         COMPUTE SS(COLS)
23014C
23015          DSUM1=0.0D0
23016          DO2630II=1,NUMSE2
23017            DSUM1=DSUM1 + DBLE(COLAVE(II))**2
23018 2630     CONTINUE
23019          DSSCOL=DBLE(NUMSE1)*DSUM1 - DTERM1
23020C
23021          DSSERR=DSSTO - DSSROW - DSSCOL
23022C
23023          DSUM1=0.0D0
23024          DO2640II=1,NUMSE2
23025            DTERM1=DBLE(SLOPES(II) - 1.0)**2
23026            DSUM1=DSUM1 + DTERM1
23027 2640     CONTINUE
23028C
23029          DSUM2=0.0D0
23030          DO2650II=1,NUMSE1
23031            DTERM2=DBLE((COLAVE(II) - XGRAND)**2)
23032            DSUM2=DSUM2 + DTERM2
23033 2650     CONTINUE
23034          DSSSL=DSUM1*DSUM2
23035          DSSER2=DSSERR-DSSSL
23036C
23037C         COMPUTE SUM OF SQUARES FOR COHERENCE.  FORMULAS FROM
23038C         MANDEL's 1961 JASA PAPER.  THESE FURTHER DECOMPOSE
23039C         "SLOPE" SUM OF SQUARES INTO "CONCURRENCE" AND
23040C         "NON-CONCURRENCE".
23041C
23042          DSUM1=0.0D0
23043          DSUM2=0.0D0
23044          DSUM3=0.0D0
23045          DO2660II=1,NUMSE1
23046            DTERM1=DBLE(ROWAVE(II)-XGRAND)
23047            DSUM1=DSUM1 + DTERM1*DBLE(SLOPES(II))
23048            DSUM2=DSUM2 + DTERM1**2
23049 2660     CONTINUE
23050          DO2670JJ=1,NUMSE2
23051            DTERM1=DBLE(COLAVE(JJ)-XGRAND)
23052            DSUM3=DSUM3 + DTERM1**2
23053 2670     CONTINUE
23054          DSSRGR=(DSUM1**2/DSUM2)*DSUM3
23055          DSSNCN=DSSSL - DSSRGR
23056C
23057          ITITL9=' '
23058          NCTIT9=0
23059          ITITLE='ANOVA Table for Column-Linear Fit'
23060          NCTITL=33
23061C
23062          NUMLIN=2
23063          NUMCOL=4
23064          ITITL2(1,1)=' '
23065          ITITL2(2,1)='Source'
23066          NCTIT2(1,1)=0
23067          NCTIT2(2,1)=6
23068          ITITL2(1,2)='Degrees of'
23069          ITITL2(2,2)='Freedom'
23070          NCTIT2(1,2)=10
23071          NCTIT2(2,2)=7
23072          ITITL2(1,3)='Sum of'
23073          ITITL2(2,3)='Squares'
23074          NCTIT2(1,3)=6
23075          NCTIT2(2,3)=7
23076          ITITL2(1,4)='Mean'
23077          ITITL2(2,4)='Square'
23078          NCTIT2(1,4)=4
23079          NCTIT2(2,4)=6
23080          ITITL2(1,5)='F'
23081          ITITL2(2,5)='Statistic'
23082          NCTIT2(1,5)=1
23083          NCTIT2(2,5)=9
23084          ITITL2(1,6)=' '
23085          ITITL2(2,6)='F CDF'
23086          NCTIT2(1,6)=0
23087          NCTIT2(2,6)=5
23088C
23089          NMAX=0
23090          NUMROW=8
23091          IWRTF(1)=1900
23092          DO2742II=1,NUMCOL
23093            VALIGN(II)='b'
23094            ALIGN(II)='r'
23095            NTOT(II)=15
23096            IF(II.EQ.1)NTOT(II)=20
23097            NMAX=NMAX+NTOT(II)
23098            IDIGIT(II)=NUMDIG
23099            IF(II.GE.3.AND.II.LE.4.AND.ITWOAD.GE.-9)IDIGIT(II)=ITWOAD
23100            ITYPCO(II)='NUME'
23101            IWHTML(II)=150
23102            IF(II.GE.2)IWRTF(II)=IWRTF(II-1)+1700
23103 2742     CONTINUE
23104          IDIGIT(1)=0
23105          IDIGIT(2)=0
23106          ALIGN(1)='l'
23107          ITYPCO(1)='ALPH'
23108          DO2743II=1,MAXROW
23109          DO2745JJ=1,NUMCOL
23110            NCVALU(II,JJ)=0
23111            IVALUE(II,JJ)=' '
23112            NCVALU(II,JJ)=0
23113            AMAT(II,JJ)=0.0
23114 2745     CONTINUE
23115 2743     CONTINUE
23116C
23117          IFRST=.TRUE.
23118          ILAST=.TRUE.
23119C
23120C         LABEL
23121C
23122          IVALUE(1,1)='Total'
23123          NCVALU(1,1)=5
23124          IVALUE(2,1)='Rows'
23125          NCVALU(2,1)=4
23126          IVALUE(3,1)='Columns'
23127          NCVALU(3,1)=6
23128          IVALUE(4,1)='Error'
23129          NCVALU(4,1)=5
23130          IVALUE(5,1)='  Residuals'
23131          NCVALU(5,1)=11
23132          IVALUE(6,1)='  Slopes'
23133          NCVALU(6,1)=8
23134          IVALUE(7,1)='    Concurrence'
23135          NCVALU(7,1)=15
23136          IVALUE(8,1)='    Non-Concurrence'
23137          NCVALU(8,1)=19
23138C
23139C         DEGREES OF FREEDOM
23140C
23141          AMAT(1,2)=REAL(NUMSE1-1) + REAL(NUMSE2-1) +
23142     1              REAL((NUMSE1-1)*(NUMSE2-1))
23143          AMAT(2,2)=REAL(NUMSE1-1)
23144          AMAT(3,2)=REAL(NUMSE2-1)
23145          AMAT(4,2)=REAL((NUMSE1-1)*(NUMSE2-1))
23146          AMAT(5,2)=REAL((NUMSE1-1)*(NUMSE2-1)) - REAL(NUMSE1-1)
23147          AMAT(6,2)=REAL(NUMSE1-1)
23148          AMAT(7,2)=1.0
23149          AMAT(8,2)=REAL(NUMSE1-2)
23150C
23151C         SUM OF SQUARES
23152C
23153          AMAT(1,3)=REAL(DSSTO)
23154          AMAT(2,3)=REAL(DSSROW)
23155          AMAT(3,3)=REAL(DSSCOL)
23156          AMAT(4,3)=REAL(DSSERR)
23157          AMAT(5,3)=REAL(DSSER2)
23158          AMAT(6,3)=REAL(DSSSL)
23159          AMAT(7,3)=REAL(DSSRGR)
23160          AMAT(8,3)=REAL(DSSNCN)
23161C
23162C         MEAN SQUARE
23163C
23164          AMAT(1,4)=AMAT(1,3)/AMAT(1,2)
23165          AMAT(2,4)=AMAT(2,3)/AMAT(2,2)
23166          AMAT(3,4)=AMAT(3,3)/AMAT(3,2)
23167          AMAT(4,4)=AMAT(4,3)/AMAT(4,2)
23168          AMAT(5,4)=AMAT(5,3)/AMAT(5,2)
23169          AMAT(6,4)=AMAT(6,3)/AMAT(6,2)
23170          AMAT(7,4)=AMAT(7,3)/AMAT(7,2)
23171          AMAT(8,4)=AMAT(8,3)/AMAT(8,2)
23172C
23173          CALL DPDTA4(ITITL9,NCTIT9,
23174     1                ITITLE,NCTITL,ITITL2,NCTIT2,
23175     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
23176     1                IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
23177     1                IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
23178     1                ICAPSW,ICAPTY,IFRST,ILAST,
23179     1                ISUBRO,IBUGG3,IERROR)
23180C
23181        ENDIF
23182C
23183      ENDIF
23184C
23185      N2=J
23186      NPLOTV=3
23187      GOTO9000
23188C
23189C               ******************
23190C               **   STEP 90--  **
23191C               **   EXIT       **
23192C               ******************
23193C
23194 9000 CONTINUE
23195C
23196      IRTFPS=IRTFSV
23197      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
23198        WRITE(ICOUT,103)IBASLC,IRTFPS
23199        CALL DPWRST('XXX','WRIT')
23200      ENDIF
23201C
23202      IOP='CLOS'
23203      CALL DPAUFI(IOP,IFLG11,IFLG21,IFLG31,IFLA41,IFLG51,
23204     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
23205     1            IBUGG3,ISUBRO,IERROR)
23206C
23207      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TWP2')THEN
23208        WRITE(ICOUT,999)
23209        CALL DPWRST('XXX','BUG ')
23210        WRITE(ICOUT,9011)
23211 9011   FORMAT('***** AT THE END       OF DPTWP2--')
23212        CALL DPWRST('XXX','BUG ')
23213        WRITE(ICOUT,9013)IERROR,NUMSE1,NUMSE2,N2
23214 9013   FORMAT('IERROR,NUMSE1,NUMSE2,N2 = ',A4,3I8)
23215        CALL DPWRST('XXX','BUG ')
23216        DO9020I=1,N2
23217          WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I)
23218 9021     FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,3G15.7)
23219          CALL DPWRST('XXX','BUG ')
23220 9020   CONTINUE
23221      ENDIF
23222C
23223      RETURN
23224      END
23225      SUBROUTINE DPTY3B(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,
23226     1                  IBUGA3,
23227     1                  IFOUZ2,ISTAR2,ISTOP2,
23228     1                  ITYPE2,IHOL,IHOL2,INTZ,FLOAT,IERROR)
23229C
23230C     NOTE--THIS SUBROUTINE IS IDENTICAL TO DPTYP3
23231C           AND HAS BEEN DUPLICATED ONLY FOR MAPPING PURPOSES.
23232C           DATE--SEPTEMBER 5, 1981.
23233C
23234C     PURPOSE--SCAN THE CHARACTER ARRAY IANS(.) BETWEEN
23235C              COLUMNS ISTAR1 AND ISTOP1
23236C              FOR THE STRING DEFINED IN STRIN AND ISTRI2.
23237C     NOTE THAT THE STRING DEFINED IN ISTRIN AND ISTRI2
23238C     MAY BE EXPRESSED IN SEVERAL WAYS--
23239C          1) EXPLICITELY, E.G., LET    FOR    SUBSET, ETC.
23240C          2) IMPLICITELY WITH ! REPRESENTING THE FIRST
23241C             NON-BLANK CHARACTER THAT IS ENCOUNTERED;
23242C          3) IMPLICITELY WITH ; REPRESENTING ANY STRING
23243C             (INCLUDING ALL CHARACTERS, EVEN BLANKS));
23244C          4) IMPLICITELY WITH : REPRESENTING THE FIRST
23245C            BLANK CHARACTER THAT IS ENCOUNTERED.
23246C     NOTE--A GIVEN ARGUMENT MAY END UP WITH
23247C            3 DIFFERENT REPRESENTATIONS--
23248C            HOLLERITH, INTEGER, AND FLOATING POINT.
23249C     INPUT  ARGUMENTS--IANS   = A HOLLERITH 1-CHARACTER-PER-WORD
23250C                                VARIABLE CONTAINING THE INPUT LINE
23251C                                TO BE EXAMINED.
23252C                     --IWIDTH = THE (FULL) WIDTH OF THE INPUT LINE
23253C                                (THAT IS, THE NUMBER OF COLUMNS)
23254C                     --ISTAR1 = THE FIRST COLUMN FOR WHICH THE
23255C                                SCAN IS TO BE CARRIED OUT.
23256C                     --ISTOP1 = THE LAST  COLUMN FOR WHICH THE
23257C                                SCAN IS TO BE CARRIED OUT.
23258C                     --ISTRIN = THE HOLLERITH VARIABLE
23259C                                WHICH CONTAINS CHARACTERS 1 TO 4
23260C                                OF THE STRING TO BE SEARCHED FOR.
23261C                                THE DEFINITION OF THE STRING IN ISTRIN MAY
23262C                                MAY BE DONE EXPLICTELY (BUT IS LIMITED
23263C                                TO 4 CHARACTERS) OR IMPLICITELY
23264C                                WHICH IS NOT LIMITED TO 4 CHARACTERS AND IS MOR
23265C                                IS MORE GENERAL IN
23266C                                OTHER WAYS ALSO.
23267C                     --ISTRI2 = THE HOLLERITH VARIABLE
23268C                                WHICH CONTAINS CHARACTERS 5 TO 8
23269C                                OF THE STRING TO BE SEARCHED FOR.
23270C                                THE DEFINITION OF THE STRING IN ISTRIN MAY
23271C                                MAY BE DONE EXPLICTELY (BUT IS LIMITED
23272C                                TO 4 CHARACTERS) OR IMPLICITELY
23273C                                WHICH IS NOT LIMITED TO 4 CHARACTERS AND IS MOR
23274C                                IS MORE GENERAL IN
23275C                                OTHER WAYS ALSO.
23276C                     --INEX   = A HOLLERITH VARIABLE WHICH
23277C                                WILL CONTAIN ONE OF THE FOLLOWING 4 VALUES--
23278C                                II, IE, EI, EE THAT STANDS FOR
23279C                                WHERE I STANDS FOR INCLUSIVE AND
23280C                                WHERE E STANDS FOR EXCLUSIVE;
23281C                                INEX SPECIFIES WHETHER THE FIRST OR LAST CHARAC
23282C                                CHARACTER IS TO BE INCLUDED OR EXCLUDED IN
23283C                                IN DEFINING ISTAR2 AND ISTOP2.
23284C     OUTPUT ARGUMENTS--IFOUZ2 = A HOLLERITH VARIABLE
23285C                                WITH THE VALUE 'YES'
23286C                                IF THE STRING WAS FOUND;
23287C                                AND THE VALUE 'NO'
23288C                                IF THE STRING WAS NOT FOUND.
23289C                     --ISTAR2 = THE START COLUMN OF THE FOUND STRING
23290C                     --ISTOP2 = THE STOP COLUMN OF THE FIUND STRING.
23291C                     --ITYPE2 = A HOLLERITH VARIABLE
23292C                                WITH THE VALUE 'WORD' IF THE STRING CONTAINS
23293C                                ANY NON-NUMERIC (EXCLUDING BLANKS) CHARACTER;
23294C                                AND WITH THE VALUE 'NUMB' IF THE STRING CONTA
23295C                                ALL NUMERIC VALUES OR DECIMAL POINT OR + OR -
23296C                                (WITH INTERMITTENT BLANKS IGNORED).
23297C                     --IHOL   = THE HOLLERITH VARIABLE
23298C                                CONTAINING THE PACKED (4 CHARACTERS) VERSION
23299C                                OF CHARACTERS 1 TO 4 OF THE FOUND STRING.
23300C                     --IHOL2  = THE HOLLERITH VARIABLE
23301C                                CONTAINING THE PACKED (4 CHARACTERS) VERSION
23302C                                OF CHARACTERS 5 TO 8 OF THE FOUND STRING.
23303C                     --INT    = THE INTEGER VARIABLE
23304C                                CONTAINING THE INTEGER REPRESENTATION
23305C                                (IF POSSIBLE) OF THE FOUND STRING.
23306C                     --FLOAT  = THE FLOATING POINT VARIABLE
23307C                                CONTAINING THE FLOATING POINT REPRESENTATION
23308C                                (IF POSSIBLE) OF THE FOUND STRING.
23309C                     --IERROR = A HOLLERITH VARIABLE WITH VALUE
23310C                                'YES' OR 'NO' INDICATING IF AN
23311C                                ERROR CONDITION EXISTS.
23312C     WRITTEN BY--JAMES J. FILLIBEN
23313C                 STATISTICAL ENGINEERING DIVISION
23314C                 INFORMATION TECHNOLOGY LABORATORY
23315C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23316C                 GAITHERSBURG, MD 20899-8980
23317C                 PHONE--301-975-2855
23318C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23319C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23320C     LANGUAGE--ANSI FORTRAN (1977)
23321C     VERSION NUMBER--82/7
23322C     ORIGINAL VERSION--FEBRUARY  1978.
23323C     UPDATED         --JULY      1978.
23324C     UPDATED         --OCTOBER   1978.
23325C     UPDATED         --NOVEMBER  1980.
23326C     UPDATED         --JANUARY   1981.
23327C     UPDATED         --JUNE      1981.
23328C     UPDATED         --MARCH     1982.
23329C     UPDATED         --MAY       1982.
23330C
23331C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23332C
23333      CHARACTER*4 IANS
23334      CHARACTER*4 ISTRIN
23335      CHARACTER*4 ISTRI2
23336      CHARACTER*4 INEX
23337      CHARACTER*4 IBUGA3
23338      CHARACTER*4 IFOUZ2
23339      CHARACTER*4 ITYPE2
23340      CHARACTER*4 IHOL
23341      CHARACTER*4 IHOL2
23342      CHARACTER*4 IERROR
23343C
23344      CHARACTER*4 IBUG1
23345      CHARACTER*4 IBUG2
23346      CHARACTER*4 ITEMP
23347      CHARACTER*4 IFLUNK
23348      CHARACTER*4 ISTRI3
23349C
23350      CHARACTER*4 ISUBN1
23351      CHARACTER*4 ISUBN2
23352      CHARACTER*4 ISTEPN
23353C
23354C---------------------------------------------------------------------
23355C
23356      DIMENSION IANS(*)
23357C
23358      DIMENSION ISTRI3(20)
23359C
23360C-----COMMON----------------------------------------------------------
23361C
23362      INCLUDE 'DPCOP2.INC'
23363C
23364C-----START POINT-----------------------------------------------------
23365C
23366      ISUBN1='DPTY'
23367      ISUBN2='P3  '
23368      IERROR='NO'
23369C
23370      I2=0
23371      IPJM1=0
23372C
23373      IF(IBUGA3.EQ.'ON')THEN
23374        WRITE(ICOUT,999)
23375  999   FORMAT(1X)
23376        CALL DPWRST('XXX','BUG ')
23377        WRITE(ICOUT,51)
23378   51   FORMAT('***** AT THE BEGINNING OF DPTY3B--')
23379        CALL DPWRST('XXX','BUG ')
23380        WRITE(ICOUT,53)ISTAR1,ISTOP1
23381   53   FORMAT('ISTAR1,ISTOP1 = ',2I8)
23382        CALL DPWRST('XXX','BUG ')
23383        WRITE(ICOUT,54)IBUGA3,ISTRI,ISTRI2
23384   54   FORMAT('IBUGA3,ISTRIN,ISTRI2 = ',2(A4,2X),A4)
23385        CALL DPWRST('XXX','BUG ')
23386      ENDIF
23387C
23388      NUMASC=4
23389C
23390      IBUG1='OFF'
23391      IBUG2='OFF'
23392C
23393C               ******************************************************
23394C               **  STEP 1--                                        **
23395C               **  INITIALIZE THE OUTPUT PARAMETERS AND VARIABLES  **
23396C               ******************************************************
23397C
23398      ISTEPN='1'
23399      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23400C
23401      IF(IBUG1.EQ.'OFF')GOTO150
23402      WRITE(ICOUT,101)
23403  101 FORMAT('AT THE BEGINNING OF DPTY3B--')
23404      CALL DPWRST('XXX','BUG ')
23405      WRITE(ICOUT,102)IWIDTH
23406  102 FORMAT('IWIDTH = ',I8)
23407      CALL DPWRST('XXX','BUG ')
23408      WRITE(ICOUT,103)(IANS(I),I=1,IWIDTH)
23409  103 FORMAT('IANS(.) = ',80A1)
23410      CALL DPWRST('XXX','BUG ')
23411      WRITE(ICOUT,104)ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX
23412  104 FORMAT('ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX = ',I8,I8,A4,A4,A4)
23413      CALL DPWRST('XXX','BUG ')
23414  150 CONTINUE
23415      IFOUZ2='NO'
23416      ISTAR2=-1
23417      ISTOP2=-1
23418      ITYPE2='9999'
23419      IHOL ='9999'
23420      IHOL2='9999'
23421      INTZ = -999999
23422      FLOAT=-999999.0
23423C
23424C               ************************************************************
23425C               **  STEP 2--                                              **
23426C               **  DECOMPOSE THE INPUT SEARCH STRING INTO A1 CHARACTERS  **
23427C               ************************************************************
23428C
23429      ISTEPN='2'
23430      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23431      IMAX=2*NUMASC
23432      DO300I=1,IMAX
23433      I2=I
23434      J=I
23435      IF(I.GT.NUMASC)J=I-NUMASC
23436      ISTAR3=NUMBPC*(J-1)
23437      ISTAR3=IABS(ISTAR3)
23438      ITEMP='    '
23439      IF(I.LE.NUMASC)CALL DPCHEX(ISTAR3,NUMBPC,ISTRIN,0,NUMBPC,ITEMP)
23440      IF(I.GT.NUMASC)CALL DPCHEX(ISTAR3,NUMBPC,ISTRI2,0,NUMBPC,ITEMP)
23441      IF(ITEMP.EQ.'    ')GOTO350
23442      ISTRI3(I)=ITEMP
23443  300 CONTINUE
23444      ILEN2=I2
23445      GOTO390
23446  350 CONTINUE
23447      ILEN2=I2-1
23448  390 CONTINUE
23449C
23450      IF(IBUG2.EQ.'OFF')GOTO399
23451      WRITE(ICOUT,391)
23452  391 FORMAT('IN THE MIDDLE OF DPTY3B (AFTER STEP 2)--')
23453      CALL DPWRST('XXX','BUG ')
23454      WRITE(ICOUT,392)ILEN2
23455  392 FORMAT('ILEN2 = ',I8)
23456      CALL DPWRST('XXX','BUG ')
23457      WRITE(ICOUT,393)(ISTRI3(I),I=1,ILEN2)
23458  393 FORMAT('ISTRI3(.) = ',6A1)
23459      CALL DPWRST('XXX','BUG ')
23460  399 CONTINUE
23461C
23462C               ****************************************************************
23463C               **  STEP 3--
23464C               **  DISTINGUISH BETWEEN THE 3 TYPES OF POSSIBLE SEARCH STRINGS--
23465C               **  1) AN EXPLICITELY-DEFINED STRING; E.G.,
23466C               **     LET     FOR     SUBSET     =     5.3     -2.6666666
23467C               **     (AS IN COMMANDS, KEY WORDS, AND NUMBERS);
23468C               **  2) A STRING STARTING WITH THE FIRST NON-BLANK CHARACTER
23469C               **     AND ENDING WITH SOME SPECIFIED CHARACTER; E.G., XXXXX(
23470C               **     (AS IN THE VARIABLE NAME OF A SUBSCRIPTED VARIABLE,
23471C               **     OR THE ARGUMENT (I. E., THE SUBSCRIPT) IN A SUBSCRIPTED
23472C               **     VARIABLE);
23473C               **  3) A STRING STARTING WITH THE FIRST NON-BLANK CHARACTER
23474C               **     AND ENDING WITH THE FIRST SUBSEQUENT BLANK CHARCTER (EXCL
23475C               **     E.G., XXXX
23476C               **     (AS IN SOME UNSPECIFIED PARAMETER OR VARIABLE NAME).
23477C               ****************************************************************
23478C
23479      ISTEPN='3'
23480      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23481      ICASE=1
23482      IF(ISTRI3(1).NE.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).NE.':')
23483     1ICASE=2
23484      IF(ISTRI3(1).EQ.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).NE.':')
23485     1ICASE=3
23486      IF(ISTRI3(1).EQ.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).EQ.':')
23487     1ICASE=4
23488      IF(ILEN2.EQ.1.OR.ILEN2.EQ.2)ICASE=1
23489C
23490      IF(IBUG2.EQ.'OFF')GOTO398
23491      WRITE(ICOUT,395)
23492  395 FORMAT('AFTER STEP 3 OF DPTY3B--')
23493      CALL DPWRST('XXX','BUG ')
23494      WRITE(ICOUT,396)ICASE
23495  396 FORMAT('ICASE = ',I8)
23496      CALL DPWRST('XXX','BUG ')
23497  398 CONTINUE
23498C
23499C               *********************************************************
23500C               **  STEP 4--                                           **
23501C               **  DETERMINE IF THE DESIRED SEARCH STRING IS PRESENT  **
23502C               *********************************************************
23503C
23504      ISTEPN='4'
23505      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23506      IF(ICASE.EQ.1)GOTO400
23507      IF(ICASE.EQ.2)GOTO500
23508      IF(ICASE.EQ.3)GOTO600
23509      IF(ICASE.EQ.4)GOTO700
23510C
23511  400 CONTINUE
23512      DO410I=ISTAR1,ISTOP1
23513      I2=I
23514      IF(IANS(I).EQ.ISTRI3(1))GOTO420
23515      GOTO410
23516  420 CONTINUE
23517      DO430J=1,ILEN2
23518      IPJM1=J+I-1
23519      IF(IPJM1.GT.ISTOP1)GOTO410
23520      IF(IANS(IPJM1).EQ.ISTRI3(J))GOTO430
23521      GOTO410
23522  430 CONTINUE
23523      IFOUZ2='YES'
23524      IF(INEX.EQ.'II')ISTAR2=I2
23525      IF(INEX.EQ.'IE')ISTAR2=I2
23526      IF(INEX.EQ.'EI')ISTAR2=I2+1
23527      IF(INEX.EQ.'EE')ISTAR2=I2+1
23528      IF(INEX.EQ.'II')ISTOP2=IPJM1
23529      IF(INEX.EQ.'IE')ISTOP2=IPJM1-1
23530      IF(INEX.EQ.'EI')ISTOP2=IPJM1
23531      IF(INEX.EQ.'EE')ISTOP2=IPJM1-1
23532      IF(ISTAR2.LE.ISTOP2)GOTO990
23533      GOTO900
23534  410 CONTINUE
23535      IFOUZ2='NO'
23536      GOTO9000
23537C
23538  500 CONTINUE
23539      DO510I=ISTAR1,ISTOP1
23540      I2=I
23541      IF(IANS(I).EQ.ISTRI3(1))GOTO520
23542  510 CONTINUE
23543      IFOUZ2='NO'
23544      GOTO9000
23545  520 CONTINUE
23546      IMIN=I2
23547      DO530I=IMIN,ISTOP1
23548      I2=I
23549      IF(IANS(I).EQ.ISTRI3(ILEN2))GOTO540
23550  530 CONTINUE
23551      IFOUZ2='NO'
23552      GOTO9000
23553  540 CONTINUE
23554      IFOUZ2='YES'
23555      IF(INEX.EQ.'II')ISTAR2=IMIN
23556      IF(INEX.EQ.'IE')ISTAR2=IMIN
23557      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
23558      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
23559      IF(INEX.EQ.'II')ISTOP2=I2
23560      IF(INEX.EQ.'IE')ISTOP2=I2-1
23561      IF(INEX.EQ.'EI')ISTOP2=I2
23562      IF(INEX.EQ.'EE')ISTOP2=I2-1
23563      IF(ISTAR2.LE.ISTOP2)GOTO990
23564      GOTO900
23565C
23566  600 CONTINUE
23567      DO610I=ISTAR1,ISTOP1
23568      I2=I
23569      IF(IANS(I).NE.' ')GOTO620
23570  610 CONTINUE
23571      IFOUZ2='NO'
23572      GOTO9000
23573  620 CONTINUE
23574      IMIN=I2
23575      DO630I=IMIN,ISTOP1
23576      I2=I
23577      IF(IANS(I).EQ.ISTRI3(ILEN2))GOTO640
23578  630 CONTINUE
23579      IFOUZ2='NO'
23580      GOTO9000
23581  640 CONTINUE
23582      IFOUZ2='YES'
23583      IF(INEX.EQ.'II')ISTAR2=IMIN
23584      IF(INEX.EQ.'IE')ISTAR2=IMIN
23585      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
23586      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
23587      IF(INEX.EQ.'II')ISTOP2=I2
23588      IF(INEX.EQ.'IE')ISTOP2=I2-1
23589      IF(INEX.EQ.'EI')ISTOP2=I2
23590      IF(INEX.EQ.'EE')ISTOP2=I2-1
23591      IF(ISTAR2.LE.ISTOP2)GOTO990
23592      GOTO900
23593C
23594  700 CONTINUE
23595      DO710I=ISTAR1,ISTOP1
23596      I2=I
23597      IF(IANS(I).NE.' ')GOTO720
23598  710 CONTINUE
23599      IFOUZ2='NO'
23600      GOTO9000
23601  720 CONTINUE
23602      IMIN=I2
23603      DO730I=IMIN,ISTOP1
23604      I2=I
23605      IF(IANS(I).EQ.' ')GOTO740
23606  730 CONTINUE
23607      IFOUZ2='NO'
23608      GOTO9000
23609  740 CONTINUE
23610      IFOUZ2='YES'
23611      IF(INEX.EQ.'II')ISTAR2=IMIN
23612      IF(INEX.EQ.'IE')ISTAR2=IMIN
23613      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
23614      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
23615      IF(INEX.EQ.'II')ISTOP2=I2
23616      IF(INEX.EQ.'IE')ISTOP2=I2-1
23617      IF(INEX.EQ.'EI')ISTOP2=I2
23618      IF(INEX.EQ.'EE')ISTOP2=I2-1
23619      IF(ISTAR2.LE.ISTOP2)GOTO990
23620      GOTO900
23621C
23622  900 CONTINUE
23623C
23624C     NOTE--THE FOLLOWING SECTION HAS BEEN 'BUGGED' OUT
23625C           TO CIRCUMVENT A PROBLEM WITH Y=(...
23626C           WHILE IT STILL LOOKED FOR A VARIABLE NAME
23627C           BETWEEN THE = AND THE (     .
23628C     CAUTION--WHEN IBUGA3 = 'OFF', AS IT USUALLY IS,
23629C              IERROR CAN NEVER BE 'YES'
23630C              UPON RETURN FROM DPTY3B:
23631C              BUT WHEN IBUGA3 = 'ON' (AS IN ERROR TRACING)
23632C              IERROR MAY = 'YES' WHICH MAY CHANGE THE
23633C              LOGIC PATH BACK IN DPTYP2.
23634C
23635      IF(IBUGA3.EQ.'OFF')GOTO9000
23636      WRITE(ICOUT,921)
23637  921 FORMAT('***** INTERNAL ERROR IN DPTY3B SUBROUTINE')
23638      CALL DPWRST('XXX','BUG ')
23639      WRITE(ICOUT,922)
23640  922 FORMAT('ISTAR2 GREATER THAN ISTOP2')
23641      CALL DPWRST('XXX','BUG ')
23642      WRITE(ICOUT,923)ISTAR2,ISTOP2
23643  923 FORMAT('ISTAR2, ISTOP2 = ',2I8)
23644      CALL DPWRST('XXX','BUG ')
23645      WRITE(ICOUT,924)ICASE
23646  924 FORMAT('ICASE = ',I8)
23647      CALL DPWRST('XXX','BUG ')
23648      WRITE(ICOUT,999)
23649      CALL DPWRST('XXX','BUG ')
23650      WRITE(ICOUT,925)IWIDTH
23651  925 FORMAT('IWIDTH = ',I8)
23652      CALL DPWRST('XXX','BUG ')
23653      WRITE(ICOUT,926)(IANS(I),I=1,IWIDTH)
23654  926 FORMAT('IANS(.) = ',80A1)
23655      CALL DPWRST('XXX','BUG ')
23656      WRITE(ICOUT,927)ISTAR1,ISTOP1
23657  927 FORMAT('ISTAR1, ISTOP1 = ',2I8)
23658      CALL DPWRST('XXX','BUG ')
23659      WRITE(ICOUT,928)ILEN2
23660  928 FORMAT('ILEN2 = ',I8)
23661      CALL DPWRST('XXX','BUG ')
23662      WRITE(ICOUT,929)(ISTRI3(I),I=1,ILEN2)
23663  929 FORMAT('ISTRI3(.) = ',80A1)
23664      CALL DPWRST('XXX','BUG ')
23665      WRITE(ICOUT,930)ISTRIN,ISTRI2
23666  930 FORMAT('ISTRIN,ISTRI2 = ',2A4)
23667      CALL DPWRST('XXX','BUG ')
23668      WRITE(ICOUT,931)INEX
23669  931 FORMAT('INEX = ',A4)
23670      CALL DPWRST('XXX','BUG ')
23671      IERROR='YES'
23672      GOTO9000
23673  990 CONTINUE
23674C
23675C               ********************************************************
23676C               **  STEP 5--                                          **
23677C               **  CONVERT THE STRING INTO 2 HOLLERITH A4 WORDS.     **
23678C               **  IF MORE THAN 8 CHARACTERS, CONVERT ONLY           **
23679C               **  THE FIRST 8 CHARACTERS.                           **
23680C               **  OUTPUT THESE HOLLERITH WORDS AS IHOL AND IHOL2.   **
23681C               ********************************************************
23682C
23683      ISTEPN='5'
23684      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23685      IHOL ='    '
23686      IHOL2='    '
23687      IMAX=2*NUMASC
23688      J=0
23689      DO1000I=ISTAR2,ISTOP2
23690      J=J+1
23691      K=J
23692      IF(J.GT.NUMASC)K=J-NUMASC
23693      ISTAR3=NUMBPC*(K-1)
23694      ISTAR3=IABS(ISTAR3)
23695      IF(J.LE.NUMASC)CALL DPCHEX(0,NUMBPC,IANS(I),ISTAR3,NUMBPC,IHOL)
23696      IF(J.GT.NUMASC)CALL DPCHEX(0,NUMBPC,IANS(I),ISTAR3,NUMBPC,IHOL2)
23697      IF(J.GE.IMAX)GOTO1050
23698 1000 CONTINUE
23699 1050 CONTINUE
23700C
23701C               ****************************************************************
23702C               **  STEP 6--
23703C               **  CONVERT (IF POSSIBLE) THE STRING INTO AN INTEGER ARGUMENT.
23704C               **  OUTPUT  THIS INTEGER VALUE IN INT.
23705C               ****************************************************************
23706C
23707      ISTEPN='6'
23708      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23709      IFLUNK='NO'
23710      ITYPE2='NUMB'
23711      IDIG=0
23712      ISIGN=0
23713      IDECPT=0
23714      ISUM=0
23715      DO2700I=ISTAR2,ISTOP2
23716      IREV=ISTOP2-(I-ISTAR2)
23717      IF(IANS(IREV).EQ.' ')GOTO2700
23718      IF(IANS(IREV).EQ.'0')GOTO2710
23719      IF(IANS(IREV).EQ.'1')GOTO2711
23720      IF(IANS(IREV).EQ.'2')GOTO2712
23721      IF(IANS(IREV).EQ.'3')GOTO2713
23722      IF(IANS(IREV).EQ.'4')GOTO2714
23723      IF(IANS(IREV).EQ.'5')GOTO2715
23724      IF(IANS(IREV).EQ.'6')GOTO2716
23725      IF(IANS(IREV).EQ.'7')GOTO2717
23726      IF(IANS(IREV).EQ.'8')GOTO2718
23727      IF(IANS(IREV).EQ.'9')GOTO2719
23728      IF(IANS(IREV).EQ.'+')GOTO2720
23729      IF(IANS(IREV).EQ.'-')GOTO2721
23730      IF(IANS(IREV).EQ.'.')GOTO2722
23731      IFLUNK='YES'
23732      GOTO2800
23733 2710 ITERM=0
23734      GOTO2725
23735 2711 ITERM=1
23736      GOTO2725
23737 2712 ITERM=2
23738      GOTO2725
23739 2713 ITERM=3
23740      GOTO2725
23741 2714 ITERM=4
23742      GOTO2725
23743 2715 ITERM=5
23744      GOTO2725
23745 2716 ITERM=6
23746      GOTO2725
23747 2717 ITERM=7
23748      GOTO2725
23749 2718 ITERM=8
23750      GOTO2725
23751 2719 ITERM=9
23752      GOTO2725
23753 2720 ISIGN=ISIGN+1
23754      GOTO2700
23755 2721 ISIGN=ISIGN+1
23756      ISUM=-ISUM
23757      GOTO2700
23758 2722 IDECPT=IDECPT+1
23759      IF(IDECPT.EQ.1.AND.IDIG.EQ.0)GOTO2700
23760      GOTO2800
23761 2725 IDIG=IDIG+1
23762      TERM2=10.0**(IDIG-1)
23763      ITERM2=INT(TERM2 + 0.01)
23764      ISUM=ISUM+ITERM*ITERM2
23765 2700 CONTINUE
23766      IF(IDIG.LE.0)GOTO2800
23767      IF(ISIGN.GE.2)GOTO2800
23768      INTZ=ISUM
23769 2800 CONTINUE
23770      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
23771C
23772C               *******************************************************
23773C               **  STEP 7--                                         **
23774C               **  CONVERT (IF POSSIBLE) THE STRING INTO A FLOATING **
23775C               **  POINT ARGUMENT.                                  **
23776C               **  OUTPUT THIS FLOATING POINT VALUE IN FLOAT.       **
23777C               *******************************************************
23778C
23779      ISTEPN='7'
23780      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23781      AMIN=-1000000.
23782      AMAX=+1000000.
23783      IFLUNK='NO'
23784      ITYPE2='NUMB'
23785      FLOAT=-1.0
23786C
23787      ILOC=0
23788      IDECPT=0
23789      DO3060I=ISTAR2,ISTOP2
23790      IF(IANS(I).EQ.'.')ILOC=I
23791      IF(IANS(I).EQ.'.')IDECPT=IDECPT+1
23792 3060 CONTINUE
23793      IF(IDECPT.GE.2)GOTO3900
23794      IF(IDECPT.EQ.1)GOTO3150
23795      DO3100I=ISTAR2,ISTOP2
23796      IREV=ISTOP2-(I-ISTAR2)
23797      IF(IANS(IREV).EQ.' ')GOTO3100
23798      IF(IANS(IREV).EQ.'0')GOTO3110
23799      IF(IANS(IREV).EQ.'1')GOTO3110
23800      IF(IANS(IREV).EQ.'2')GOTO3110
23801      IF(IANS(IREV).EQ.'3')GOTO3110
23802      IF(IANS(IREV).EQ.'4')GOTO3110
23803      IF(IANS(IREV).EQ.'5')GOTO3110
23804      IF(IANS(IREV).EQ.'6')GOTO3110
23805      IF(IANS(IREV).EQ.'7')GOTO3110
23806      IF(IANS(IREV).EQ.'8')GOTO3110
23807      IF(IANS(IREV).EQ.'9')GOTO3110
23808      IFLUNK='YES'
23809      IF(IANS(IREV).EQ.'+')GOTO3900
23810      IF(IANS(IREV).EQ.'-')GOTO3900
23811      GOTO3900
23812 3100 CONTINUE
23813      IFLUNK='YES'
23814      GOTO3900
23815 3110 ILOC=IREV+1
23816 3150 CONTINUE
23817      IF(IBUG2.EQ.'ON')WRITE(ICOUT,3111)ILOC,IDECPT
23818 3111 FORMAT('ILOC = ',I8,'    IDECPT = ',I8)
23819      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
23820C
23821C     SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE
23822C
23823      SIGN=1.0
23824      IDIGI=0
23825      ISIGN=0
23826      SUMI=0
23827      ILOCM1=ILOC-1
23828      IF(ILOCM1.LT.ISTAR2)GOTO3250
23829      DO3200I=ISTAR2,ILOCM1
23830      IREV=ILOCM1-(I-ISTAR2)
23831      IF(IANS(IREV).EQ.' ')GOTO3200
23832      IF(IANS(IREV).EQ.'0')GOTO3210
23833      IF(IANS(IREV).EQ.'1')GOTO3211
23834      IF(IANS(IREV).EQ.'2')GOTO3232
23835      IF(IANS(IREV).EQ.'3')GOTO3213
23836      IF(IANS(IREV).EQ.'4')GOTO3214
23837      IF(IANS(IREV).EQ.'5')GOTO3215
23838      IF(IANS(IREV).EQ.'6')GOTO3216
23839      IF(IANS(IREV).EQ.'7')GOTO3217
23840      IF(IANS(IREV).EQ.'8')GOTO3218
23841      IF(IANS(IREV).EQ.'9')GOTO3219
23842      IF(IANS(IREV).EQ.'+')GOTO3220
23843      IF(IANS(IREV).EQ.'-')GOTO3221
23844      IFLUNK='YES'
23845      GOTO3900
23846 3210 ITERM=0
23847      GOTO3225
23848 3211 ITERM=1
23849      GOTO3225
23850 3232 ITERM=2
23851      GOTO3225
23852 3213 ITERM=3
23853      GOTO3225
23854 3214 ITERM=4
23855      GOTO3225
23856 3215 ITERM=5
23857      GOTO3225
23858 3216 ITERM=6
23859      GOTO3225
23860 3217 ITERM=7
23861      GOTO3225
23862 3218 ITERM=8
23863      GOTO3225
23864 3219 ITERM=9
23865      GOTO3225
23866 3220 ISIGN=ISIGN+1
23867      GOTO3200
23868 3221 ISIGN=ISIGN+1
23869      SIGN=-SIGN
23870      GOTO3200
23871 3225 IDIGI=IDIGI+1
23872      TERM=ITERM
23873      IEXP=IDIGI-1
23874      SUMI=SUMI+TERM*(10.0**IEXP)
23875 3200 CONTINUE
23876 3250 CONTINUE
23877      IF(ISIGN.GE.2)GOTO3900
23878      IF(IBUG2.EQ.'ON')WRITE(ICOUT,3255)IDIGI,SUMI
23879 3255 FORMAT('IDIGI = ',I8,'    SUMI = ',F20.10)
23880      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
23881C
23882C     THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE
23883C
23884      IDIGD=0
23885      SUMD=0.0
23886      ILOCP1=ILOC+1
23887      IF(ILOCP1.GT.ISTOP2)GOTO3350
23888      DO3300I=ILOCP1,ISTOP2
23889      IF(IANS(I).EQ.' ')GOTO3300
23890      IF(IANS(I).EQ.'0')GOTO3310
23891      IF(IANS(I).EQ.'1')GOTO3311
23892      IF(IANS(I).EQ.'2')GOTO3312
23893      IF(IANS(I).EQ.'3')GOTO3333
23894      IF(IANS(I).EQ.'4')GOTO3314
23895      IF(IANS(I).EQ.'5')GOTO3315
23896      IF(IANS(I).EQ.'6')GOTO3316
23897      IF(IANS(I).EQ.'7')GOTO3317
23898      IF(IANS(I).EQ.'8')GOTO3318
23899      IF(IANS(I).EQ.'9')GOTO3319
23900      IFLUNK='YES'
23901      GOTO3900
23902 3310 ITERM=0
23903      GOTO3325
23904 3311 ITERM=1
23905      GOTO3325
23906 3312 ITERM=2
23907      GOTO3325
23908 3333 ITERM=3
23909      GOTO3325
23910 3314 ITERM=4
23911      GOTO3325
23912 3315 ITERM=5
23913      GOTO3325
23914 3316 ITERM=6
23915      GOTO3325
23916 3317 ITERM=7
23917      GOTO3325
23918 3318 ITERM=8
23919      GOTO3325
23920 3319 ITERM=9
23921      GOTO3325
23922 3325 IDIGD=IDIGD+1
23923      TERM=ITERM
23924      SUMD=SUMD+TERM/(10.0**IDIGD)
23925 3300 CONTINUE
23926 3350 CONTINUE
23927      IF(IBUG2.EQ.'ON')WRITE(ICOUT,3355)IDIGD,SUMD
23928 3355 FORMAT('IDIGD = ',I8,'    SUMD = ',F20.10)
23929      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
23930      IDIGT=IDIGI+IDIGD
23931      IF(IDIGT.LE.0)GOTO3900
23932      FLOAT=SUMI+SUMD
23933      IF(SIGN.LT.0.0)FLOAT=-FLOAT
23934      IF(AMIN.LE.FLOAT.AND.FLOAT.LE.AMAX)GOTO3000
23935      GOTO3900
23936C
23937 3900 CONTINUE
23938      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
23939 3000 CONTINUE
23940      GOTO9000
23941C
23942 9000 CONTINUE
23943      IF(IBUGA3.EQ.'ON')THEN
23944        WRITE(ICOUT,999)
23945        CALL DPWRST('XXX','BUG ')
23946        WRITE(ICOUT,9001)
23947 9001   FORMAT('AT THE END OF DPTY3B--')
23948        CALL DPWRST('XXX','BUG ')
23949        WRITE(ICOUT,9002)IFOUZ2,ISTAR2,ISTOP2
23950 9002   FORMAT('IFOUZ2, ISTAR2, ISTOP2 = ',A4,2I8)
23951        CALL DPWRST('XXX','BUG ')
23952        WRITE(ICOUT,9003)ITYPE2,IHOL,IHOL2,INTZ,FLOAT,IERROR
23953 9003   FORMAT('ITYPE2,IHOL,IHOL2,INTZ,FLOAT,IERROR = ',A4,2X,2A4,2X,
23954     1         I8,F15.7,2X,A4)
23955        CALL DPWRST('XXX','BUG ')
23956      ENDIF
23957C
23958      RETURN
23959      END
23960      SUBROUTINE DPTYP2(IANS,IWIDTH,IHNAME,IHNAM2,NUMNAM,MAXNAM,IBUGA3,
23961     1           IUSE,IVALUE,VALUE,IN,
23962     1           IFOUNZ,IBEGIN,IEND,
23963     1           ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
23964     1           NUMCL,NUMPL,NUMAOL,ITYW1L,ICAT1L,INLI1L,ITYW2L,
23965     1           NUMCR,NUMPR,NUMAOR,ITYW1R,ICAT1R,INLI1R,ITYW2R)
23966C
23967C     PURPOSE--SCAN THE CHARACTER ARRAY IANS(.)
23968C              AND EXTRACT INFORMATION
23969C              REGARDING THE EXISTENCE AND LOACTION
23970C              OF CERTAIN SUBSTRINGS USED IN THE LET COMMAND.
23971C     THIS SUBROUTINE (DPTYP2) IS CALLED BY DPLET.
23972C     OTHER SUBROUINTES NEEDED--DPTYP3
23973C     MOST GENERAL FORM--LET X(I) = XXX FOR I = A B C
23974C                      --LET X(I) = XXX SUBSET XX A B
23975C     INPUT  ARGUMENTS--IANS   = A HOLLERITH 1-CHARACTER-PER-WORD
23976C                                VARIABLE CONTAINING THE INPUT LINE
23977C                                TO BE EXAMINED.
23978C                     --IWIDTH = AN INTEGER VARIABLE CONTAINING
23979C                                THE (FULL) WIDTH OF THE INPUT LINE
23980C                                (THAT IS, THE NUMBER OF COLUMNS)
23981C     OUTPUT ARGUMENTS--IFOUNZ = A HOLLERITH ARRAY
23982C                                WITH THE VALUE 'YES'
23983C                                IF THE SUBSTRING WAS FOUND;
23984C                                AND THE VALUE 'NO'
23985C                                IF THE SUBSTRING WAS NOT FOUND.
23986C                     --IBEGIN = AN INTEGER ARRAY WITH
23987C                                THE START COLUMN OF THE FOUND SUBSTRING
23988C                     --IEND   = AN INTEGER ARRAY WITH
23989C                                THE STOP COLUMN OF THE FIUND SUBSTRING.
23990C                     --ITYPE  = A HOLLERITH ARRAY
23991C                                WITH THE VALUE 'WORD' IF THE SUBSTRING CONTAINS
23992C                                ANY NON-NUMERIC (EXCLUDING BLANKS) CHARACTER;
23993C                                AND WITH THE VALUE 'NUMB' IF THE SUBSTRING CO
23994C                                ALL NUMERIC VALUES OR DECIMAL POINT OR + OR -
23995C                                (WITH INTERMITTENT BLANKS IGNORED).
23996C                     --IHOL   = AN HOLLERITH ARRAY
23997C                                CONTAINING THE PACKED (FIRST 4 CHARACTERS) VERS
23998C                                OF THE FOUND SUBSTRING.
23999C                     --IHOL2  = AN HOLLERITH ARRAY
24000C                                CONTAINING THE PACKED (NEXT 4 CHARACTERS) VERSI
24001C                                OF THE FOUND SUBSTRING.
24002C                     --INT1   = AN INTEGER ARRAY
24003C                                CONTAINING THE INTEGER REPRESENTATION
24004C                                (IF POSSIBLE) OF THE FOUND SUBSTRING.
24005C                     --FLOAT1 = AN FLOATING POINT ARRAY
24006C                                CONTAINING THE FLOATING POINT REPRESENTATION
24007C                                (IF POSSIBLE) OF THE FOUND SUBSTRING.
24008C                     --IERRO1 = AN HOLLERITH ARRAY
24009C                                WITH THE VALUE 'NO' IF
24010C                                NO ERROR HAS BEEN ENCOUNTERED,
24011C                                AND THE VALUE 'YES' IF AN
24012C                                ERROR HAS BEEN ENCOUNTERED.
24013C                     --NUMCL  = AN INTEGER VARIABLE CONTAINING THE
24014C                                NUMBER OF COMPONENTS
24015C                                ON THE LEFT SIDE
24016C                                (NOT COUNTING LET OR THE = SIGN).
24017C                     --NUMPL  = AN INTEGER VARIABLE CONTAINING THE
24018C                                NUMBER OF PARENTHESES (LEFT + RIGHT)
24019C                                ON THE LEFT SIDE
24020C                                (NOT COUNTING LET OR THE = SIGN).
24021C                     --NUMAOL = AN INTEGER VARIABLE CONTAINING THE
24022C                                NUMBER OF ARITHMETIC OPERATIONS
24023C                                ON THE LEFT SIDE
24024C                                (NOT COUNTING LET OR THE = SIGN).
24025C                     --ITYW1L = A HOLLERITH VARIABLE CONTAINING THE
24026C                                TYPE ('WORD' VERSUS 'NUMB')
24027C                                FOR THE FIRST WORD
24028C                                (THAT IS, THE VARIABLE
24029C                                OR PARAMETER NAME)
24030C                                ON THE LEFT SIDE
24031C                                (NOT COUNTING LET OR THE = SIGN).
24032C                     --ITYW2L = A HOLLERITH VARIABLE CONTAINING THE
24033C                                TYPE ('WORD' VERSUS 'NUMB')
24034C                                FOR THE SECOND WORD
24035C                                (THAT IS, THE ARGUMENT)
24036C                                ON THE LEFT SIDE
24037C                                (NOT COUNTING LET OR THE = SIGN).
24038C                     --INLI1L = A HOLLERITH VARIABLE CONTAINING THE
24039C                                ANSWER ('YES' VERSUS 'NO')
24040C                                TO THE QUESTION AS TO WHETHER
24041C                                THE FIRST WORD ON THE LEFT
24042C                                (THAT IS, THE VARIABLE
24043C                                OR PARAMETER NAME)
24044C                                IS ALREADY EXISTENT IN THE
24045C                                INTERNAL DATAPLOT NAME LIST
24046C                                (NOT COUNTING LET OR THE = SIGN).
24047C                     --NUMCR  = AN INTEGER VARIABLE CONTAINING THE
24048C                                NUMBER OF COMPONENTS
24049C                                ON THE RIGHT SIDE
24050C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
24051C                     --NUMPR  = AN INTEGER VARIABLE CONTAINING THE
24052C                                NUMBER OF PARENTHESES (RIGHT + RIGHT)
24053C                                ON THE RIGHT SIDE
24054C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
24055C                     --NUMAOR = AN INTEGER VARIABLE CONTAINING THE
24056C                                NUMBER OF ARITHMETIC OPERATIONS
24057C                                ON THE RIGHT SIDE
24058C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
24059C                     --ITYW1R = A HOLLERITH VARIABLE CONTAINING THE
24060C                                TYPE ('WORD' VERSUS 'NUMB')
24061C                                FOR THE FIRST WORD
24062C                                (THAT IS, THE VARIABLE
24063C                                OR PARAMETER NAME)
24064C                                ON THE RIGHT SIDE
24065C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
24066C                     --ITYW2R = A HOLLERITH VARIABLE CONTAINING THE
24067C                                TYPE ('WORD' VERSUS 'NUMB')
24068C                                FOR THE SECOND WORD
24069C                                (THAT IS, THE ARGUMENT)
24070C                                ON THE RIGHT SIDE
24071C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
24072C                     --INLI1R = A HOLLERITH VARIABLE CONTAINING THE
24073C                                ANSWER ('YES' VERSUS 'NO')
24074C                                TO THE QUESTION AS TO WHETHER
24075C                                THE FIRST WORD ON THE RIGHT
24076C                                (THAT IS, THE VARIABLE
24077C                                OR PARAMETER NAME)
24078C                                IS ALREADY EXISTENT IN THE
24079C                                INTERNAL DATAPLOT NAME LIST
24080C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
24081C     WRITTEN BY--JAMES J. FILLIBEN
24082C                 STATISTICAL ENGINEERING DIVISION
24083C                 INFORMATION TECHNOLOGY LABORATORY
24084C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24085C                 GAITHERSBURG, MD 20899-8980
24086C                 PHONE--301-975-2855
24087C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24088C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
24089C     LANGUAGE--ANSI FORTRAN (1977)
24090C     VERSION NUMBER--82/7
24091C     ORIGINAL VERSION--MARCH     1978
24092C     UPDATED         --JUNE      1978.
24093C     UPDATED         --JULY      1978.
24094C     UPDATED         --JUNE      1981.
24095C     UPDATED         --JULY      1981.
24096C     UPDATED         --OCTOBER   1981.
24097C     UPDATED         --JANUARY   1982.
24098C     UPDATED         --MARCH     1982.
24099C     UPDATED         --MAY       1982.
24100C     UPDATED         --JANUARY   1983.
24101C     UPDATED         --DECEMBER  1988.  ELIM. SPUR. ERROR MESS. FOR IFRINGE
24102C     UPDATED         --JANAURY   1989.  IANS(IENDP) WITH IENDP = 0 (ALAN)
24103C     UPDATED         --NOVEMBER  1989.  FIX IANS(IENDP=0) (NELSON)
24104C
24105C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
24106C
24107      CHARACTER*4 IANS
24108      CHARACTER*4 IHNAME
24109      CHARACTER*4 IHNAM2
24110      CHARACTER*4 IBUGA3
24111      CHARACTER*4 IUSE
24112      CHARACTER*4 IFOUNZ
24113      CHARACTER*4 ITYPE
24114      CHARACTER*4 IHOL
24115      CHARACTER*4 IHOL2
24116      CHARACTER*4 IERRO1
24117      CHARACTER*4 ITYW1L
24118      CHARACTER*4 ICAT1L
24119      CHARACTER*4 INLI1L
24120      CHARACTER*4 ITYW2L
24121      CHARACTER*4 ITYW1R
24122      CHARACTER*4 ICAT1R
24123      CHARACTER*4 INLI1R
24124      CHARACTER*4 ITYW2R
24125C
24126      CHARACTER*4 ISTRIN
24127      CHARACTER*4 ISTRI2
24128      CHARACTER*4 INEX
24129      CHARACTER*4 IVARL
24130      CHARACTER*4 IVARL2
24131      CHARACTER*4 IVARR
24132      CHARACTER*4 IVARR2
24133      CHARACTER*4 IQUAL
24134      CHARACTER*4 IHSTAT
24135      CHARACTER*4 IHSTA2
24136      CHARACTER*4 IHMAN
24137      CHARACTER*4 IHMAN2
24138      CHARACTER*4 IERROR
24139      CHARACTER*4 ISUBN1
24140      CHARACTER*4 ISUBN2
24141      CHARACTER*4 ISTEPN
24142C
24143C---------------------------------------------------------------------
24144C
24145      DIMENSION IANS(*)
24146      DIMENSION IHNAME(*)
24147      DIMENSION IHNAM2(*)
24148C
24149      DIMENSION IUSE(*)
24150      DIMENSION IVALUE(*)
24151      DIMENSION VALUE(*)
24152      DIMENSION IN(*)
24153C
24154      DIMENSION IFOUNZ(*)
24155      DIMENSION IBEGIN(*)
24156      DIMENSION IEND(*)
24157      DIMENSION ITYPE(*)
24158      DIMENSION IHOL(*)
24159      DIMENSION IHOL2(*)
24160      DIMENSION INT1(*)
24161      DIMENSION FLOAT1(*)
24162      DIMENSION IERRO1(*)
24163C
24164      DIMENSION IHMAN(10)
24165      DIMENSION IHMAN2(10)
24166      DIMENSION IHSTAT(25)
24167      DIMENSION IHSTA2(25)
24168C
24169C-----COMMON----------------------------------------------------------
24170C
24171      INCLUDE 'DPCOP2.INC'
24172C
24173C-----DATA STATEMENTS-------------------------------------------------
24174C
24175      DATA NUMMAN/8/
24176C
24177      DATA IHMAN(1),IHMAN2(1)/'SORT','    '/
24178      DATA IHMAN(2),IHMAN2(2)/'RANK','    '/
24179      DATA IHMAN(3),IHMAN2(3)/'CODE','    '/
24180      DATA IHMAN(4),IHMAN2(4)/'DIST','INCT'/
24181      DATA IHMAN(5),IHMAN2(5)/'SEQU','ENTI'/
24182      DATA IHMAN(6),IHMAN2(6)/'CUMU','LATI'/
24183      DATA IHMAN(7),IHMAN2(7)/'CUMU','LATI'/
24184      DATA IHMAN(8),IHMAN2(8)/'CUMU','LATI'/
24185C
24186      DATA NUMSTA/22/
24187C
24188      DATA IHSTAT(1),IHSTA2(1)/'SIZE','    '/
24189      DATA IHSTAT(2),IHSTA2(2)/'NUMB','ER  '/
24190      DATA IHSTAT(3),IHSTA2(3)/'SUM ','    '/
24191      DATA IHSTAT(4),IHSTA2(4)/'MIDR','ANGE'/
24192      DATA IHSTAT(5),IHSTA2(5)/'MEAN','    '/
24193      DATA IHSTAT(6),IHSTA2(6)/'AVER','AGE '/
24194      DATA IHSTAT(7),IHSTA2(7)/'MIDM','EAN '/
24195      DATA IHSTAT(8),IHSTA2(8)/'MEDI','AN  '/
24196      DATA IHSTAT(9),IHSTA2(9)/'STAN','ARD '/
24197      DATA IHSTAT(10),IHSTA2(10)/'VARI','ANCE'/
24198      DATA IHSTAT(11),IHSTA2(11)/'RELA','TIVE'/
24199      DATA IHSTAT(12),IHSTA2(12)/'RANG','E   '/
24200      DATA IHSTAT(13),IHSTA2(13)/'MINI','MUM '/
24201      DATA IHSTAT(14),IHSTA2(14)/'MAXI','MUM '/
24202      DATA IHSTAT(15),IHSTA2(15)/'STAN','DARD'/
24203      DATA IHSTAT(16),IHSTA2(16)/'SKEW','NESS'/
24204      DATA IHSTAT(17),IHSTA2(17)/'STAN','DARD'/
24205      DATA IHSTAT(18),IHSTA2(18)/'KURT','OSIS'/
24206      DATA IHSTAT(19),IHSTA2(19)/'AUTO','CORR'/
24207      DATA IHSTAT(20),IHSTA2(20)/'STAN','DARD'/
24208      DATA IHSTAT(21),IHSTA2(21)/'CORR','ELAT'/
24209      DATA IHSTAT(22),IHSTA2(22)/'RANK','    '/
24210C
24211C-----START POINT-----------------------------------------------------
24212C
24213      ISUBN1='DPTY'
24214      ISUBN2='P2  '
24215      IERROR='NO'
24216      IQUAL='UNKN'
24217C
24218      IMAXR=0
24219C
24220      IF(IBUGA3.EQ.'ON')THEN
24221        WRITE(ICOUT,999)
24222  999   FORMAT(1X)
24223        CALL DPWRST('XXX','BUG ')
24224        WRITE(ICOUT,51)
24225   51   FORMAT('***** AT THE BEGINNING OF DPTYP2--')
24226        CALL DPWRST('XXX','BUG ')
24227        WRITE(ICOUT,52)IBUGA3,IWIDTH,MAXNAM,IN(1)
24228   52   FORMAT('IBUGA3,IWIDTH,MAXNAM,IN(1) = ',A4,2X,2I5,I8)
24229        CALL DPWRST('XXX','BUG ')
24230        WRITE(ICOUT,54)(IANS(I),I=1,MIN(80,IWIDTH))
24231   54   FORMAT('IANS(.) = ',80A1)
24232        CALL DPWRST('XXX','BUG ')
24233      ENDIF
24234C
24235C               ******************************************************
24236C               **  STEP 1--                                        **
24237C               **  INITIALIZE THE OUTPUT PARAMETERS AND VARIABLES  **
24238C               ******************************************************
24239C
24240      ISTEPN='1'
24241      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24242C
24243      DO100I=1,30
24244      IFOUNZ(I)='NO'
24245      IBEGIN(I)=-1
24246      IEND(I)=-1
24247      ITYPE(I)='9999'
24248      IHOL(I)='9999'
24249      IHOL2(I)='9999'
24250      INT1(I)=-999999
24251      FLOAT1(I)=-999999.0
24252      IERRO1(I)='NO'
24253  100 CONTINUE
24254C
24255      NUMCL=0
24256      NUMPL=0
24257      NUMAOL=0
24258      ITYW1L='9999'
24259      ICAT1L='9999'
24260      INLI1L='9999'
24261      ITYW2L='9999'
24262      NUMCR=0
24263      NUMPR=0
24264      NUMAOR=0
24265      ITYW1R='9999'
24266      ICAT1R='9999'
24267      INLI1R='9999'
24268      ITYW2R='9999'
24269C
24270C               ****************************************************************
24271C               **  STEP 2--
24272C               **  EXAMINE THE LEFT-HAND SIDE OF EXPRESSION.
24273C               **  DETERMINE IF PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN
24274C               **  HAS PARENTHESES.
24275C               **  IF IT HAS PARENTHESES, THIS MEANS THAT WE WILL BE
24276C               **  DEFINING    PART     OF A VARIABLE.
24277C               **  COMPONENT 1  = LET
24278C               **  COMPONENT 2  = VARIABLE NAME
24279C               **  COMPONENT 3  = (                             (IF IT EXISTS)
24280C               **  COMPONENT 4  = ARGUMENT (I.E., ROW OF TABLE) (IF IT EXISTS)
24281C               **  COMPONENT 5  = )                             (IF IT EXISTS)
24282C               **  COMPONENT 6  = =
24283C               ****************************************************************
24284C
24285C     MOST GENERAL FORM--LET X(I) = XXX FOR I = A B C
24286C                      --LET X(I) = XXX SUBSET XX A B
24287C
24288      ISTEPN='2'
24289      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24290C
24291C     STEP 2.1--SEARCH FOR LET.
24292C
24293      ISTAR1=1
24294      ISTOP1=IWIDTH
24295      ISTRIN='LET'
24296      ISTRI2='    '
24297      INEX='II'
24298      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24299     1      IFOUNZ(1),IBEGIN(1),IEND(1),
24300     1      ITYPE(1),IHOL(1),IHOL2(1),INT1(1),FLOAT1(1),IERRO1(1))
24301      IF(IFOUNZ(1).EQ.'YES')GOTO2190
24302      CALL DPLETE(IANS,IWIDTH)
24303      IERROR='YES'
24304      GOTO9000
24305 2190 CONTINUE
24306C
24307C     STEP 2.2--SEARCH FOR = SIGN.
24308C
24309      ISTAR1=IEND(1)+1
24310      ISTOP1=IWIDTH
24311      ISTRIN='='
24312      ISTRI2='    '
24313      INEX='II'
24314      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24315     1      IFOUNZ(6),IBEGIN(6),IEND(6),
24316     1      ITYPE(6),IHOL(6),IHOL2(6),INT1(6),FLOAT1(6),IERRO1(6))
24317      IF(IFOUNZ(6).EQ.'YES')GOTO2290
24318      CALL DPLETE(IANS,IWIDTH)
24319      IERROR='YES'
24320      GOTO9000
24321 2290 CONTINUE
24322C
24323C     STEP 2.3--SEARCH FOR LEFT-HAND SIDE (;
24324C     SEARCH BETWEEN LET AND =.
24325C
24326      ISTAR1=IEND(1)+1
24327      ISTOP1=IBEGIN(6)-1
24328      ISTRIN='('
24329      ISTRI2='    '
24330      INEX='II'
24331      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24332     1      IFOUNZ(3),IBEGIN(3),IEND(3),
24333     1      ITYPE(3),IHOL(3),IHOL2(3),INT1(3),FLOAT1(3),IERRO1(3))
24334      IF(IFOUNZ(3).EQ.'YES')GOTO2390
24335      GOTO2500
24336 2390 CONTINUE
24337C
24338C     STEP 2.4--SEARCH FOR LEFT-HAND SIDE );
24339C     SEARCH BETWEEN ( AND =.
24340C
24341      ISTAR1=IEND(3)+1
24342      ISTOP1=IBEGIN(6)-1
24343      ISTRIN=')'
24344      ISTRI2='    '
24345      INEX='II'
24346      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24347     1      IFOUNZ(5),IBEGIN(5),IEND(5),
24348     1      ITYPE(5),IHOL(5),IHOL2(5),INT1(5),FLOAT1(5),IERRO1(5))
24349      IF(IFOUNZ(5).EQ.'YES')GOTO2490
24350      CALL DPLETE(IANS,IWIDTH)
24351      IERROR='YES'
24352      GOTO9000
24353 2490 CONTINUE
24354      GOTO2600
24355C
24356C     STEP 2.5--IF NO LEFT-HAND SIDE PARENTHESES FOUND,
24357C     EXTRACT VARIABLE NAME;
24358C     SEARCH BETWEEN LET AND =.
24359C
24360 2500 CONTINUE
24361      ISTAR1=IEND(1)+1
24362      ISTOP1=IBEGIN(6)
24363      ISTRIN='!;='
24364      ISTRI2='    '
24365      INEX='IE'
24366      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24367     1      IFOUNZ(2),IBEGIN(2),IEND(2),
24368     1      ITYPE(2),IHOL(2),IHOL2(2),INT1(2),FLOAT1(2),IERRO1(2))
24369      IF(IFOUNZ(2).EQ.'YES')GOTO2590
24370      CALL DPLETE(IANS,IWIDTH)
24371      IERROR='YES'
24372      GOTO9000
24373 2590 CONTINUE
24374      GOTO2800
24375C
24376C     STEP 2.6--IF LEFT-HAND SIDE PARENTHESES FOUND,
24377C     FIRST EXTRACT VARIABLE NAME;
24378C     SEARCH BETWEEN LET AND (.
24379C
24380 2600 CONTINUE
24381      ISTAR1=IEND(1)+1
24382      ISTOP1=IBEGIN(3)
24383      ISTRIN='!;('
24384      ISTRI2='    '
24385      INEX='IE'
24386      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24387     1      IFOUNZ(2),IBEGIN(2),IEND(2),
24388     1      ITYPE(2),IHOL(2),IHOL2(2),INT1(2),FLOAT1(2),IERRO1(2))
24389      IF(IFOUNZ(2).EQ.'YES')GOTO2690
24390      CALL DPLETE(IANS,IWIDTH)
24391      IERROR='YES'
24392      GOTO9000
24393 2690 CONTINUE
24394C
24395C     STEP 2.7--ALSO IF LEFT-HAND SIDE PARENTHESES FOUND,
24396C     SEARCH FOR LEFT-HAND SIDE ARGUMENT NAME OR VALUE;
24397C     SEARCH BETWEEN ( AND ).
24398C
24399      ISTAR1=IEND(3)
24400      ISTOP1=IBEGIN(5)
24401      ISTRIN='(;)'
24402      ISTRI2='    '
24403      INEX='EE'
24404      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24405     1      IFOUNZ(4),IBEGIN(4),IEND(4),
24406     1      ITYPE(4),IHOL(4),IHOL2(4),INT1(4),FLOAT1(4),IERRO1(4))
24407      IF(IFOUNZ(4).EQ.'YES')GOTO2790
24408      CALL DPLETE(IANS,IWIDTH)
24409      IERROR='YES'
24410      GOTO9000
24411 2790 CONTINUE
24412      K=4
24413      IF(ITYPE(K).EQ.'WORD')
24414     1CALL DPCHEC(K,IHOL,IHOL2,
24415     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
24416     1INT1,FLOAT1,IBUGA3,IERROR)
24417C
24418 2800 CONTINUE
24419C
24420C               *******************************************************
24421C               **  STEP 3--                                         **
24422C               **  EXAMINE THE RIGHT-HAND SIDE OF EXPRESSION.       **
24423C               **  DETERMINE WHICH OF THE 3 CASES WE HAVE--         **
24424C               **      1) LET X(I) =                                **
24425C               **      2) LET X(I) =       SUBSET XX  A  B          **
24426C               **      3) LET X(I) =       FOR XX = A  B  C         **
24427C               **  IF CASE 1 (THE NON-SUBSET AND NON-FOR CASE),     **
24428C               **  SEARCH FOR COMPONENTS 7, 8, 9, AND 10--          **
24429C               **  COMPONENT 7  = VARIABLE NAME                     **
24430C               **  COMPONENT 8  = (                                 **
24431C               **  COMPONENT 9  = ARGUMENT (THAT IS, ROW OF TABLE)  **
24432C               **  COMPONENT 10 = )                                 **
24433C               **  IF CASE 2 (THE SUBSET CASE), JUMP TO STEP 4      **
24434C               **  IF CASE 3 (THE FOR CASE), JUMP TO STEP 5.        **
24435C               *******************************************************
24436C
24437      ISTEPN='3'
24438      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24439C
24440C     STEP 3.1A--SEARCH FOR SUBSET.
24441C
24442      ISTAR1=IEND(6)+1
24443      ISTOP1=IWIDTH
24444      ISTRIN='SUBS'
24445      ISTRI2='ET  '
24446      INEX='II'
24447      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24448     1      IFOUNZ(11),IBEGIN(11),IEND(11),
24449     1      ITYPE(11),IHOL(11),IHOL2(11),INT1(11),FLOAT1(11),IERRO1(11))
24450CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1988 TO AVOID
24451CCCCC SPURIOUS ERROR MESSAGES WITH A LONG VARIABLE NAME LIKE SUBSETXX
24452CCCCC THE SECTION WAS CORRECTED ALSO IN JANUARY 1988 AND NOVEMBER 1989
24453      IENDP=IEND(11)+1
24454      IF(IENDP.LE.0)IFOUNZ(11)='NO'
24455      IF(IENDP.LE.0)GOTO3119
24456      IF(IFOUNZ(11).EQ.'YES'.AND.
24457     1   IENDP.LE.ISTOP1.AND.
24458     1   IANS(IENDP).NE.' ')IFOUNZ(11)='NO'
24459      IF(IFOUNZ(11).EQ.'YES')GOTO4000
24460 3119 CONTINUE
24461C
24462C     STEP 3.1B--SEARCH FOR EXCEPT.
24463C
24464      ISTAR1=IEND(6)+1
24465      ISTOP1=IWIDTH
24466      ISTRIN='EXCE'
24467      ISTRI2='PT  '
24468      INEX='II'
24469      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24470     1      IFOUNZ(11),IBEGIN(11),IEND(11),
24471     1      ITYPE(11),IHOL(11),IHOL2(11),INT1(11),FLOAT1(11),IERRO1(11))
24472CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1988 TO AVOID
24473CCCCC SPURIOUS ERROR MESSAGES WITH A LONG VARIABLE NAME LIKE EXCEPTXX
24474CCCCC THE SECTION WAS CORRECTED ALSO IN JANUARY 1988 AND NOVEMBER 1989
24475      IENDP=IEND(11)+1
24476      IF(IENDP.LE.0)IFOUNZ(11)='NO'
24477      IF(IENDP.LE.0)GOTO3129
24478      IF(IFOUNZ(11).EQ.'YES'.AND.
24479     1   IENDP.LE.ISTOP1.AND.
24480     1   IANS(IENDP).NE.' ')IFOUNZ(11)='NO'
24481      IF(IFOUNZ(11).EQ.'YES')GOTO4000
24482 3129 CONTINUE
24483C
24484C     STEP 3.1C--SEARCH FOR FOR.
24485C
24486      ISTAR1=IEND(6)+1
24487      ISTOP1=IWIDTH
24488      ISTRIN='FOR'
24489      ISTRI2='    '
24490      INEX='II'
24491      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24492     1      IFOUNZ(21),IBEGIN(21),IEND(21),
24493     1      ITYPE(21),IHOL(21),IHOL2(21),INT1(21),FLOAT1(21),IERRO1(21))
24494CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1988 TO AVOID
24495CCCCC SPURIOUS ERROR MESSAGES WITH A LONG VARIABLE NAME LIKE FORTUNE
24496CCCCC THE SECTION WAS CORRECTED ALSO IN JANUARY 1988 AND NOVEMBER 1989
24497      IENDP=IEND(21)+1
24498      IF(IENDP.LE.0)IFOUNZ(21)='NO'
24499      IF(IENDP.LE.0)GOTO3139
24500      IF(IFOUNZ(21).EQ.'YES'.AND.
24501     1   IENDP.LE.ISTOP1.AND.
24502     1   IANS(IENDP).NE.' ')IFOUNZ(21)='NO'
24503      IF(IFOUNZ(21).EQ.'YES')GOTO5000
24504 3139 CONTINUE
24505C
24506C     STEP 3.1D--SEARCH FOR IF.
24507C
24508      ISTAR1=IEND(6)+1
24509      ISTOP1=IWIDTH
24510      ISTRIN='IF  '
24511      ISTRI2='    '
24512      INEX='II'
24513      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24514     1      IFOUNZ(11),IBEGIN(11),IEND(11),
24515     1      ITYPE(11),IHOL(11),IHOL2(11),INT1(11),FLOAT1(11),IERRO1(11))
24516CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1988 TO AVOID
24517CCCCC SPURIOUS ERROR MESSAGES WITH A LONG VARIABLE NAME LIKE IFRING
24518CCCCC THE SECTION WAS CORRECTED ALSO IN JANUARY 1988 AND NOVEMBER 1989
24519      IENDP=IEND(11)+1
24520      IF(IENDP.LE.0)IFOUNZ(11)='NO'
24521      IF(IENDP.LE.0)GOTO3149
24522      IF(IFOUNZ(11).EQ.'YES'.AND.
24523     1   IENDP.LE.ISTOP1.AND.
24524     1   IANS(IENDP).NE.' ')IFOUNZ(11)='NO'
24525      IF(IFOUNZ(11).EQ.'YES')GOTO4000
24526 3149 CONTINUE
24527C
24528C     STEP 3.2--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
24529C     SEARCH FOR RIGHT-HAND SIDE (;
24530C     SEARCH BETWEEN = AND END OF LINE.
24531C
24532      ISTAR1=IEND(6)+1
24533      ISTOP1=IWIDTH
24534      ISTRIN='('
24535      ISTRI2='    '
24536      INEX='II'
24537      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24538     1      IFOUNZ(8),IBEGIN(8),IEND(8),
24539     1      ITYPE(8),IHOL(8),IHOL2(8),INT1(8),FLOAT1(8),IERRO1(8))
24540      IF(IFOUNZ(8).EQ.'YES')GOTO3290
24541      GOTO3400
24542 3290 CONTINUE
24543C
24544C     STEP 3.3--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
24545C     SEARCH FOR RIGHT-HAND SIDE );
24546C     SEARCH BETWEEN ( AND END OF LINE.
24547C
24548      ISTAR1=IEND(8)+1
24549      ISTOP1=IWIDTH
24550      ISTRIN=')'
24551      ISTRI2='    '
24552      INEX='II'
24553      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24554     1      IFOUNZ(10),IBEGIN(10),IEND(10),
24555     1      ITYPE(10),IHOL(10),IHOL2(10),INT1(10),FLOAT1(10),IERRO1(10))
24556      IF(IFOUNZ(10).EQ.'YES')GOTO3390
24557      CALL DPLETE(IANS,IWIDTH)
24558      IERROR='YES'
24559      GOTO9000
24560 3390 CONTINUE
24561      GOTO3500
24562C
24563C     STEP 3.4--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
24564C     IF NO RIGHT-HAND SIDE PARENTHESES FOUND,
24565C     EXTRACT VARIABLE NAME OR VALUE;
24566C     SEARCH BETWEEN = AND END OF LINE.
24567C     ALSO, TO HANDLE THE COLUMN NAMING CASE
24568C     (E.G., LET X = COLUMN 1),
24569C     CHECK TO SEE IF ANOTHER ITEM
24570C     FOLLOWS THE VARIABLE NAME OR VALUE.
24571C     AND FURTERMORE, TO HANDLE THE DATA GENERATION CASE
24572C     (E.G., LET X = 1 1 10),
24573C     CHECK TO SEE OF 2 ITEMS
24574C     FOLLOW THE FIRST VALUE.
24575C
24576 3400 CONTINUE
24577      ISTAR1=IEND(6)+1
24578      ISTOP1=IWIDTH
24579      ISTRIN='!;:'
24580      ISTRI2='    '
24581      INEX='IE'
24582      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24583     1      IFOUNZ(7),IBEGIN(7),IEND(7),
24584     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
24585      IF(IFOUNZ(7).EQ.'YES')GOTO3410
24586      CALL DPLETE(IANS,IWIDTH)
24587      IERROR='YES'
24588      GOTO9000
24589C
24590 3410 CONTINUE
24591      ISTAR1=IEND(7)+1
24592      ISTOP1=IWIDTH
24593      ISTRIN='!;:'
24594      ISTRI2='    '
24595      INEX='IE'
24596      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24597     1      IFOUNZ(8),IBEGIN(8),IEND(8),
24598     1      ITYPE(8),IHOL(8),IHOL2(8),INT1(8),FLOAT1(8),IERRO1(8))
24599      IF(IFOUNZ(8).EQ.'YES')GOTO3420
24600      GOTO3900
24601C
24602 3420 CONTINUE
24603      ISTAR1=IEND(8)+1
24604      ISTOP1=IWIDTH
24605      ISTRIN='!;:'
24606      ISTRI2='    '
24607      INEX='IE'
24608      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24609     1      IFOUNZ(9),IBEGIN(9),IEND(9),
24610     1      ITYPE(9),IHOL(9),IHOL2(9),INT1(9),FLOAT1(9),IERRO1(9))
24611      GOTO3900
24612C
24613C     STEP 3.5--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
24614C     IF RIGHT-HAND SIDE PARENTHESES FOUND,
24615C     FIRST EXTRACT VARIABLE NAME;
24616C     SEARCH BETWEEN = AND (.
24617C
24618 3500 CONTINUE
24619      ISTAR1=IEND(6)+1
24620      ISTOP1=IBEGIN(8)
24621      ISTRIN='!;('
24622      ISTRI2='    '
24623      INEX='IE'
24624      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24625     1      IFOUNZ(7),IBEGIN(7),IEND(7),
24626     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
24627      IF(IFOUNZ(7).EQ.'YES')GOTO3590
24628      CALL DPLETE(IANS,IWIDTH)
24629      IERROR='YES'
24630      GOTO9000
24631 3590 CONTINUE
24632C
24633C     STEP 3.6--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
24634C     ALSO IF RIGHT-HAND SIDE PARENTHESES FOUND,
24635C     SEARCH FOR RIGHT-HAND SIDE ARGUMENT NAME OR VALUE;
24636C     SEARCH BETWEEN ( AND ).
24637C
24638      ISTAR1=IEND(8)
24639      ISTOP1=IBEGIN(10)
24640      ISTRIN='(;)'
24641      ISTRI2='    '
24642      INEX='EE'
24643      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24644     1      IFOUNZ(9),IBEGIN(9),IEND(9),
24645     1      ITYPE(9),IHOL(9),IHOL2(9),INT1(9),FLOAT1(9),IERRO1(9))
24646      IF(IFOUNZ(9).EQ.'YES')GOTO3690
24647      CALL DPLETE(IANS,IWIDTH)
24648      IERROR='YES'
24649      GOTO9000
24650 3690 CONTINUE
24651      K=9
24652      IF(ITYPE(K).EQ.'WORD')
24653     1CALL DPCHEC(K,IHOL,IHOL2,
24654     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
24655     1INT1,FLOAT1,IBUGA3,IERROR)
24656C
24657 3900 CONTINUE
24658      GOTO6000
24659C
24660C               **********************************************************
24661C               **  STEP 4--                                            **
24662C               **  FOR THE CASE WHEN HAVE     LET X(I) =               **
24663C               **  EXAMINE THE RIGHT-HAND SIDE FOR    SUBSET XX  A  B  **
24664C               **  COMPONENT 7  = VARIABLE NAME                        **
24665C               **  COMPONENT 8  = (                                    **
24666C               **  COMPONENT 9  = ARGUMENT (THAT IS, ROW OF TABLE)     **
24667C               **  COMPONENT 10 = )                                    **
24668C               **  COMPONENT 11 = SUBSET                               **
24669C               **  COMPONENT 12 = LOWER LIMIT             OF SUBSET    **
24670C               **  COMPONENT 13 = UPPER LIMIT (IF EXISTS) OF SUBSET    **
24671C               **********************************************************
24672C
24673 4000 CONTINUE
24674      ISTEPN='4'
24675      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24676C
24677C     STEP 4.2--IF SUBSET HAS BEEN FOUND,
24678C     SEARCH FOR RIGHT-HAND SIDE (;
24679C     SEARCH BETWEEN = AND SUBSET.
24680C
24681      ISTAR1=IEND(6)+1
24682      ISTOP1=IBEGIN(11)-1
24683      ISTRIN='('
24684      ISTRI2='    '
24685      INEX='II'
24686      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24687     1      IFOUNZ(8),IBEGIN(8),IEND(8),
24688     1      ITYPE(8),IHOL(8),IHOL2(8),INT1(8),FLOAT1(8),IERRO1(8))
24689      IF(IFOUNZ(8).EQ.'YES')GOTO4090
24690      GOTO4400
24691 4090 CONTINUE
24692C
24693C     STEP 4.3--IF SUBSET HAS BEEN FOUND,
24694C     SEARCH FOR RIGHT-HAND SIDE );
24695C     SEARCH BETWEEN ( AND SUBSET.
24696C
24697      ISTAR1=IEND(8)+1
24698      ISTOP1=IBEGIN(11)-1
24699      ISTRIN=')'
24700      ISTRI2='    '
24701      INEX='II'
24702      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24703     1      IFOUNZ(10),IBEGIN(10),IEND(10),
24704     1      ITYPE(10),IHOL(10),IHOL2(10),INT1(10),FLOAT1(10),IERRO1(10))
24705      IF(IFOUNZ(10).EQ.'YES')GOTO4390
24706      CALL DPLETE(IANS,IWIDTH)
24707      IERROR='YES'
24708      GOTO9000
24709 4390 CONTINUE
24710      GOTO4500
24711C
24712C     STEP 4.4--IF SUBSET HAS BEEN FOUND,
24713C     IF NO RIGHT-HAND SIDE PARENTHESES FOUND,
24714C     EXTRACT VARIABLE NAME OR VALUE;
24715C     SEARCH BETWEEN = AND SUBSET.
24716C
24717 4400 CONTINUE
24718      ISTAR1=IEND(6)+1
24719      ISTOP1=IBEGIN(11)
24720      ISTRIN='!;:'
24721      ISTRI2='    '
24722      INEX='IE'
24723      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24724     1      IFOUNZ(7),IBEGIN(7),IEND(7),
24725     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
24726      IF(IFOUNZ(7).EQ.'YES')GOTO4490
24727      CALL DPLETE(IANS,IWIDTH)
24728      IERROR='YES'
24729      GOTO9000
24730 4490 CONTINUE
24731      GOTO4700
24732C
24733C     STEP 4.5--IF SUBSET HAS BEEN FOUND,
24734C     IF RIGHT-HAND SIDE PARENTHESES FOUND,
24735C     FIRST EXTRACT VARIABLE NAME;
24736C     SEARCH BETWEEN = AND (.
24737C
24738 4500 CONTINUE
24739      ISTAR1=IEND(6)+1
24740      ISTOP1=IBEGIN(8)
24741      ISTRIN='!;('
24742      ISTRI2='    '
24743      INEX='IE'
24744      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24745     1      IFOUNZ(7),IBEGIN(7),IEND(7),
24746     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
24747      IF(IFOUNZ(7).EQ.'YES')GOTO4590
24748      CALL DPLETE(IANS,IWIDTH)
24749      IERROR='YES'
24750      GOTO9000
24751 4590 CONTINUE
24752C
24753C     STEP 4.6--IF SUBSET HAS BEEN FOUND,
24754C     ALSO IF RIGHT-HAND SIDE PARENTHESES FOUND,
24755C     SEARCH FOR RIGHT-HAND SIDE ARGUMENT NAME OR VALUE;
24756C     SEARCH BETWEEN ( AND ).
24757C
24758      ISTAR1=IEND(8)
24759      ISTOP1=IBEGIN(10)
24760      ISTRIN='(;)'
24761      ISTRI2='    '
24762      INEX='EE'
24763      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24764     1      IFOUNZ(9),IBEGIN(9),IEND(9),
24765     1      ITYPE(9),IHOL(9),IHOL2(9),INT1(9),FLOAT1(9),IERRO1(9))
24766      IF(IFOUNZ(9).EQ.'YES')GOTO4690
24767      CALL DPLETE(IANS,IWIDTH)
24768      IERROR='YES'
24769      GOTO9000
24770 4690 CONTINUE
24771      K=9
24772      IF(ITYPE(K).EQ.'WORD')
24773     1CALL DPCHEC(K,IHOL,IHOL2,
24774     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
24775     1INT1,FLOAT1,IBUGA3,IERROR)
24776C
24777C     STEP 4.7--IF SUBSET HAS BEEN FOUND,
24778C     SEARCH FOR VARIABLE NAME AFTER SUBSET;
24779C     SEARCH BETWEEN SUBSET AND THE END OF THE LINE.
24780C
24781 4700 CONTINUE
24782      ISTAR1=IEND(11)+1
24783      ISTOP1=IWIDTH
24784      ISTRIN='!;:'
24785      ISTRI2='    '
24786      INEX='IE'
24787      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24788     1      IFOUNZ(12),IBEGIN(12),IEND(12),
24789     1      ITYPE(12),IHOL(12),IHOL2(12),INT1(12),FLOAT1(12),IERRO1(12))
24790      IF(IFOUNZ(12).EQ.'YES')GOTO4790
24791      CALL DPLETE(IANS,IWIDTH)
24792      IERROR='YES'
24793      GOTO9000
24794 4790 CONTINUE
24795C
24796C     STEP 4.8--IF SUBSET HAS BEEN FOUND,
24797C     SEARCH FOR LOWER LIMIT VALUE AFTER     SUBSET XXX
24798C     SEARCH BETWEEN VARIABLE NAME AND THE END OF THE LINE.
24799C
24800      ISTAR1=IEND(12)+1
24801      ISTOP1=IWIDTH
24802      ISTRIN='!;:'
24803      ISTRI2='    '
24804      INEX='IE'
24805      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24806     1      IFOUNZ(13),IBEGIN(13),IEND(13),
24807     1      ITYPE(13),IHOL(13),IHOL2(13),INT1(13),FLOAT1(13),IERRO1(13))
24808      IF(IFOUNZ(13).EQ.'YES')GOTO4890
24809      CALL DPLETE(IANS,IWIDTH)
24810      IERROR='YES'
24811      GOTO9000
24812 4890 CONTINUE
24813C
24814C     STEP 4.9--IF SUBSET HAS BEEN FOUND,
24815C     SEARCH FOR UPPER LIMIT (IF EXISTENT) AFTER     SUBSET XXX
24816C     SEARCH BETWEEN LOWER LIMIT AND THE END OF THE LINE.
24817C
24818      ISTAR1=IEND(13)+1
24819      ISTOP1=IWIDTH
24820      ISTRIN='!;:'
24821      ISTRI2='    '
24822      INEX='IE'
24823      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24824     1      IFOUNZ(14),IBEGIN(14),IEND(14),
24825     1      ITYPE(14),IHOL(14),IHOL2(14),INT1(14),FLOAT1(14),IERRO1(14))
24826      GOTO6000
24827C
24828C               *******************************************************
24829C               **  STEP 5--                                         **
24830C               **  FOR THE CASE WHEN HAVE     LET X(I) =            **
24831C               **  EXAMINE THE RIGHT-HAND SIDE FOR    FOR I = A  B  C*
24832C               **  COMPONENT 7  = VARIABLE NAME                     **
24833C               **  COMPONENT 8  = (                                 **
24834C               **  COMPONENT 9  = ARGUMENT (THAT IS, ROW OF TABLE)  **
24835C               **  COMPONENT 10 = )                                 **
24836C               **  COMPONENT 21 = FOR                               **
24837C               **  COMPONENT 22 = =                                 **
24838C               **  COMPONENT 23 = START     VALUE FOR DUMMY INDEX   **
24839C               **  COMPONENT 24 = INCREMENT VALUE FOR DUMMY INDEX   **
24840C               **  COMPONENT 25 = STOP      VALUE FOR SUMMY INDEX   **
24841C               *******************************************************
24842C
24843 5000 CONTINUE
24844      ISTEPN='5'
24845      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24846C
24847C     STEP 5.2--IF FOR HAS BEEN FOUND,
24848C     SEARCH FOR RIGHT-HAND SIDE (;
24849C     SEARCH BETWEEN = AND FOR.
24850C
24851      ISTAR1=IEND(6)+1
24852      ISTOP1=IBEGIN(21)-1
24853      ISTRIN='('
24854      ISTRI2='    '
24855      INEX='II'
24856      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24857     1      IFOUNZ(8),IBEGIN(8),IEND(8),
24858     1      ITYPE(8),IHOL(8),IHOL2(8),INT1(8),FLOAT1(8),IERRO1(8))
24859      IF(IFOUNZ(8).EQ.'YES')GOTO5290
24860      GOTO5400
24861 5290 CONTINUE
24862C
24863C     STEP 5.3--IF FOR HAS BEEN FOUND,
24864C     SEARCH FOR RIGHT-HAND SIDE );
24865C     SEARCH BETWEEN ( AND FOR.
24866C
24867      ISTAR1=IEND(8)+1
24868      ISTOP1=IBEGIN(21)-1
24869      ISTRIN=')'
24870      ISTRI2='    '
24871      INEX='II'
24872      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24873     1      IFOUNZ(10),IBEGIN(10),IEND(10),
24874     1      ITYPE(10),IHOL(10),IHOL2(10),INT1(10),FLOAT1(10),IERRO1(10))
24875      IF(IFOUNZ(10).EQ.'YES')GOTO5390
24876      CALL DPLETE(IANS,IWIDTH)
24877      IERROR='YES'
24878      GOTO9000
24879 5390 CONTINUE
24880      GOTO5500
24881C
24882C     STEP 5.4--IF FOR HAS BEEN FOUND,
24883C     IF NO RIGHT-HAND SIDE PARENTHESES FOUND,
24884C     EXTRACT VARIABLE NAME OR VALUE;
24885C     SEARCH BETWEEN = AND FOR.
24886C
24887 5400 CONTINUE
24888      ISTAR1=IEND(6)+1
24889      ISTOP1=IBEGIN(21)
24890      ISTRIN='!;:'
24891      ISTRI2='    '
24892      INEX='IE'
24893      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24894     1      IFOUNZ(7),IBEGIN(7),IEND(7),
24895     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
24896      IF(IFOUNZ(7).EQ.'YES')GOTO5490
24897      CALL DPLETE(IANS,IWIDTH)
24898      IERROR='YES'
24899      GOTO9000
24900 5490 CONTINUE
24901      GOTO5700
24902C
24903C     STEP 5.5--IF FOR HAS BEEN FOUND,
24904C     IF RIGHT-HAND SIDE PARENTHESES FOUND,
24905C     FIRST EXTRACT VARIABLE NAME;
24906C     SEARCH BETWEEN = AND (.
24907C
24908 5500 CONTINUE
24909      ISTAR1=IEND(6)+1
24910      ISTOP1=IBEGIN(8)
24911      ISTRIN='!;('
24912      ISTRI2='    '
24913      INEX='IE'
24914      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24915     1      IFOUNZ(7),IBEGIN(7),IEND(7),
24916     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
24917      IF(IFOUNZ(7).EQ.'YES')GOTO5590
24918      CALL DPLETE(IANS,IWIDTH)
24919      IERROR='YES'
24920      GOTO9000
24921 5590 CONTINUE
24922C
24923C     STEP 5.6--IF FOR HAS BEEN FOUND,
24924C     ALSO IF RIGHT-HAND SIDE PARENTHESES FOUND,
24925C     SEARCH FOR RIGHT-HAND SIDE ARGUMENT NAME OR VALUE;
24926C     SEARCH BETWEEN ( AND ).
24927C
24928      ISTAR1=IEND(8)
24929      ISTOP1=IBEGIN(10)
24930      ISTRIN='(;)'
24931      ISTRI2='    '
24932      INEX='EE'
24933      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24934     1      IFOUNZ(9),IBEGIN(9),IEND(9),
24935     1      ITYPE(9),IHOL(9),IHOL2(9),INT1(9),FLOAT1(9),IERRO1(9))
24936      IF(IFOUNZ(9).EQ.'YES')GOTO5690
24937      CALL DPLETE(IANS,IWIDTH)
24938      IERROR='YES'
24939      GOTO9000
24940 5690 CONTINUE
24941      K=9
24942      IF(ITYPE(K).EQ.'WORD')
24943     1CALL DPCHEC(K,IHOL,IHOL2,
24944     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
24945     1INT1,FLOAT1,IBUGA3,IERROR)
24946C
24947C     STEP 5.7--IF FOR HAS BEEN FOUND,
24948C     SEARCH FOR VARIABLE NAME AFTER FOR;
24949C     SEARCH BETWEEN FOR AND THE END OF THE LINE.
24950C
24951 5700 CONTINUE
24952      ISTAR1=IEND(21)+1
24953      ISTOP1=IWIDTH
24954      ISTRIN='!;:'
24955      ISTRI2='    '
24956      INEX='IE'
24957      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24958     1      IFOUNZ(22),IBEGIN(22),IEND(22),
24959     1      ITYPE(22),IHOL(22),IHOL2(22),INT1(22),FLOAT1(22),IERRO1(22))
24960      IF(IFOUNZ(22).EQ.'YES')GOTO5790
24961      CALL DPLETE(IANS,IWIDTH)
24962      IERROR='YES'
24963      GOTO9000
24964 5790 CONTINUE
24965C
24966C     STEP 5.8--IF FOR HAS BEEN FOUND,
24967C     SEARCH FOR = SIGN AFTER    FOR XXX
24968C     SEARCH BETWEEN VARIABLE NAME AND END OF LINE.
24969C
24970      ISTAR1=IEND(22)+1
24971      ISTOP1=IWIDTH
24972      ISTRIN='='
24973      ISTRI2='    '
24974      INEX='II'
24975      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24976     1      IFOUNZ(23),IBEGIN(23),IEND(23),
24977     1      ITYPE(23),IHOL(23),IHOL2(23),INT1(23),FLOAT1(23),IERRO1(23))
24978      IF(IFOUNZ(23).EQ.'YES')GOTO5890
24979      CALL DPLETE(IANS,IWIDTH)
24980      IERROR='YES'
24981      GOTO9000
24982 5890 CONTINUE
24983C
24984C     STEP 5.9--IF FOR HAS BEEN FOUND,
24985C     SEARCH FOR START VALUE AFTER     FOR XXX =
24986C     SEARCH BETWEEN = AND THE END OF THE LINE.
24987C
24988      ISTAR1=IEND(23)+1
24989      ISTOP1=IWIDTH
24990      ISTRIN='!;:'
24991      ISTRI2='    '
24992      INEX='IE'
24993      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
24994     1      IFOUNZ(24),IBEGIN(24),IEND(24),
24995     1      ITYPE(24),IHOL(24),IHOL2(24),INT1(24),FLOAT1(24),IERRO1(24))
24996      IF(IFOUNZ(24).EQ.'YES')GOTO5990
24997      CALL DPLETE(IANS,IWIDTH)
24998      IERROR='YES'
24999      GOTO9000
25000 5990 CONTINUE
25001C
25002C     STEP 5.10--IF FOR HAS BEEN FOUND,
25003C     SEARCH FOR INCREMENT VALUE AFTER     FOR XXX =
25004C     SEARCH BETWEEN START VALUE AND THE END OF THE LINE.
25005C
25006      ISTAR1=IEND(24)+1
25007      ISTOP1=IWIDTH
25008      ISTRIN='!;:'
25009      ISTRI2='    '
25010      INEX='IE'
25011      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
25012     1      IFOUNZ(25),IBEGIN(25),IEND(25),
25013     1      ITYPE(25),IHOL(25),IHOL2(25),INT1(25),FLOAT1(25),IERRO1(25))
25014      IF(IFOUNZ(25).EQ.'YES')GOTO5930
25015      CALL DPLETE(IANS,IWIDTH)
25016      IERROR='YES'
25017      GOTO9000
25018 5930 CONTINUE
25019C
25020C     STEP 5.11--IF FOR HAS BEEN FOUND,
25021C     SEARCH FOR STOP VALUE AFTER     FOR XXX =
25022C     SEARCH BETWEEN INCREMENT VALUE AND THE END OF THE LINE.
25023C
25024      ISTAR1=IEND(25)+1
25025      ISTOP1=IWIDTH
25026      ISTRIN='!;:'
25027      ISTRI2='    '
25028      INEX='IE'
25029      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
25030     1      IFOUNZ(26),IBEGIN(26),IEND(26),
25031     1      ITYPE(26),IHOL(26),IHOL2(26),INT1(26),FLOAT1(26),IERRO1(26))
25032      IF(IFOUNZ(26).EQ.'YES')GOTO5950
25033      CALL DPLETE(IANS,IWIDTH)
25034      IERROR='YES'
25035      GOTO9000
25036 5950 CONTINUE
25037      GOTO6000
25038C
25039C               ************************************************
25040C               **  STEP 6--                                  **
25041C               **  DETERMINE VARIOUS SUMMARY VARIABLES       **
25042C               **  FOR THE LEFT SIDE                         **
25043C               **  OF THE COMMAND LINE                       **
25044C               **  WHICH WILL BE HELPFUL BACK IN DPLET       **
25045C               **  FOR BRANCHING TO THE CORRECT              **
25046C               **  TYPE OF OPERATION.                        **
25047C               **  NOTE THAT THE    LEFT SIDE                    **
25048C               **  WILL BE FROM     LET                      **
25049C               **  TO THE           = SIGN                   **
25050C               **  BUT WILL NOT INCLUDE EITHER.              **
25051C               ************************************************
25052C
25053 6000 CONTINUE
25054      ISTEPN='6'
25055      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25056C
25057C     STEP 6.0--
25058C     DETERMINE THE LIMITS OF THE LEFT SIDE
25059C
25060      IMINL=0
25061      IF(IFOUNZ(1).EQ.'YES')IMINL=IEND(1)+1
25062C
25063      IMAXL=0
25064      IF(IFOUNZ(6).EQ.'YES')IMAXL=IBEGIN(6)-1
25065C
25066      IF(IMINL.LE.0)GOTO6900
25067      IF(IMAXL.LE.0)GOTO6900
25068      IF(IMINL.GT.IMAXL)GOTO6900
25069C
25070C     STEP 6.1--
25071C     DETERMINE THE NUMBER OF COMPONENTS ON THE LEFT.
25072C     A COMPONET HERE = A WORD OR A PARENTHESIS.
25073C
25074      ISUM=0
25075      IMIN=2
25076      IMAX=5
25077      DO6100I=IMIN,IMAX
25078      IF(IFOUNZ(I).EQ.'YES')ISUM=ISUM+1
25079 6100 CONTINUE
25080      NUMCL=ISUM
25081C
25082C     STEP 6.2--
25083C     DETERMINE THE NUMBER OF PARENTHESES (LEFT + RIGHT).
25084C
25085      ISUM=0
25086      IMIN=IMINL
25087      IMAX=IMAXL
25088      DO6200I=IMIN,IMAX
25089      IF(IANS(I).EQ.'('.OR.IANS(I).EQ.')')ISUM=ISUM+1
25090 6200 CONTINUE
25091      NUMPL=ISUM
25092C
25093C     STEP 6.3--
25094C     DETERMINE THE NUMBER OF ARITHMETIC OPERATIONS
25095C     +  -  *  /      ON THE LEFT
25096C     (IT SHOULD BE 0).
25097C     NOTE THAT THE ARITHMETIC OPERATION   **
25098C     WILL BE LUMPED IN WITH    *    .
25099C
25100      ISUM=0
25101      IMIN=IMINL
25102      IMAX=IMAXL
25103      DO6300I=IMIN,IMAX
25104      IF(IANS(I).EQ.'+'.OR.IANS(I).EQ.'-'.
25105     1OR.IANS(I).EQ.'*'.OR.IANS(I).EQ.'/')ISUM=ISUM+1
25106 6300 CONTINUE
25107      NUMAOL=ISUM
25108C
25109C     STEP 6.4--
25110C     DETERMINE THE TYPE ('NUMB' OR 'WORD')
25111C     FOR THE FIRST WORD ON THE LEFT.
25112C     THIS SHOULD BE THE VARIABLE OR PARAMETER
25113C     DESIGNATION,
25114C     AND IT SHOULD BE A 'WORD'.
25115C
25116      ITYW1L=ITYPE(2)
25117C
25118C     STEP 6.5--
25119C     DETERMINE IF FIRST WORD ON THE LEFT
25120C     IS ALREADY IN THE NAME LIST OR NOT.
25121C
25122      INLI1L='NO'
25123      IVARL=IHOL(2)
25124      IVARL2=IHOL2(2)
25125      DO6500I=1,NUMNAM
25126      IF(IVARL.EQ.IHNAME(I).AND.IVARL2.EQ.IHNAM2(I))INLI1L='YES'
25127 6500 CONTINUE
25128C
25129C     STEP 6.6--
25130C     DETERMINE IF FIRST WORD ON THE LEFT
25131C     IS IN THE VARIABLE/PARAMETER NAME LIST, OR
25132C     IS A COLUMN NAMING (I.E., THE WORD 'COLU' OR 'COL', OR
25133C     IS A DATA MANIPULATION FUNCTION, OR
25134C     IS A STATISTICAL CALCULATION FUNCTION
25135C     (SEARCH IS DONE IN THAT ORDER).
25136C
25137C
25138      ICAT1L='NONE'
25139      IVARL=IHOL(2)
25140      IVARL2=IHOL2(2)
25141C
25142      IF(INLI1L.EQ.'YES'.AND.IVARL.NE.'COLU')GOTO6615
25143      IF(INLI1L.EQ.'YES'.AND.IVARL.NE.'COL ')GOTO6615
25144      IF(INLI1L.EQ.'YES'.AND.IVARL.EQ.'COLU'.AND.IVARL2.EQ.'MN  '.AND.
25145     1IFOUNZ(3).EQ.'NO')GOTO6615
25146      IF(INLI1L.EQ.'YES'.AND.IVARL.EQ.'COL '.AND.IVARL2.EQ.'    '.AND.
25147     1IFOUNZ(3).EQ.'NO')GOTO6615
25148      IF(INLI1L.EQ.'YES'.AND.IVARL.EQ.'COLU'.AND.IVARL2.EQ.'MN  '.AND.
25149     1IFOUNZ(3).EQ.'YES'.AND.ITYPE(3).NE.'NUMB')GOTO6615
25150      IF(INLI1L.EQ.'YES'.AND.IVARL.EQ.'COL '.AND.IVARL2.EQ.'    '.AND.
25151     1IFOUNZ(3).EQ.'YES'.AND.ITYPE(3).NE.'NUMB')GOTO6615
25152      GOTO6620
25153 6615 CONTINUE
25154      ICAT1L='VARP'
25155      GOTO6690
25156C
25157 6620 CONTINUE
25158      IF(IVARL.EQ.'COLU'.AND.IVARL2.EQ.'MN  '.AND.
25159     1IFOUNZ(3).EQ.'YES'.AND.ITYPE(3).EQ.'NUMB')GOTO6625
25160      IF(IVARL.EQ.'COL '.AND.IVARL2.EQ.'    '.AND.
25161     1IFOUNZ(3).EQ.'YES'.AND.ITYPE(3).EQ.'NUMB')GOTO6625
25162      GOTO6630
25163 6625 CONTINUE
25164      ICAT1L='COL'
25165      GOTO6690
25166C
25167 6630 CONTINUE
25168      DO6632I=1,NUMMAN
25169      IF(IVARL.EQ.IHMAN(I).AND.IVARL2.EQ.IHMAN2(I))GOTO6635
25170 6632 CONTINUE
25171      GOTO6640
25172 6635 CONTINUE
25173      ICAT1L='MANI'
25174      GOTO6690
25175C
25176 6640 CONTINUE
25177      DO6642I=1,NUMSTA
25178      IF(IVARL.EQ.IHSTAT(I).AND.IVARL2.EQ.IHSTA2(I))GOTO6645
25179 6642 CONTINUE
25180      GOTO6690
25181 6645 CONTINUE
25182      ICAT1L='STAT'
25183      GOTO6690
25184C
25185 6690 CONTINUE
25186C
25187C     STEP 6.7--
25188C     DETERMINE THE TYPE ('NUMB' OR 'WORD')
25189C     FOR THE SECOND WORD
25190C     (AS OPPOSED TO THE SECOND COMPONENT)
25191C     ON THE LEFT.
25192C     IF EXISTENT, THIS SHOULD BE THE ARGUMENT DESIGNATION
25193C     OF A VARIABLE,
25194C     AND IT MAY BE EITHER A 'WORD' OR A 'NUMB'.
25195C
25196      ITYW2L=ITYPE(4)
25197C
25198 6900 CONTINUE
25199C
25200C               *******************************************************
25201C               **  STEP 7--                                         **
25202C               **  DETERMINE VARIOUS SUMMARY VARIABLES FOR THE      **
25203C               **  RIGHT SIDE OF THE COMMAND LINE WHICH WILL BE     **
25204C               **  HELPFUL BACK IN DPLET FOR BRANCHING TO THE       **
25205C               **  CORRECT TYPE OF OPERATION.  NOTE THAT THE        **
25206C               **  RIGHT SIDE WILL BE FROM THE = SIGN               **
25207C               **  TO THE           END OF THE LINE,                **
25208C               **  OR TO AN         ISOLATED FOR,                   **
25209C               **  OR TO AN         ISOLATED SUBSET                 **
25210C               **  (WHICHEVER OF THE 3 IS SMALLEST).                **
25211C               **  ALSO DETERMINE WHETHER THE QUALIFICATION         **
25212C               **  ON THE FAR RIGHT OF THE CARD IS                  **
25213C               **           1) BLANK (THAT IS, NO QUALIFICATION)    **
25214C               **           2) SUBSET                               **
25215C               **           3) FOR                                  **
25216C               **  THE VARIABLE IQUAL WILL BE DEFINED IN            **
25217C               **  THIS REGARD                                      **
25218C               **  IQUAL WILL = 'NONE', 'FOR', 'SUBS', OR 'ERRO'.   **
25219C               *******************************************************
25220C
25221      ISTEPN='7'
25222      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25223C
25224C     STEP 7.0--
25225C     DETERMINE THE LIMITS OF THE    RIGHT SIDE
25226C
25227      IMINR=0
25228      IF(IFOUNZ(6).EQ.'YES')IMINR=IEND(6)+1
25229C
25230      IF(IFOUNZ(11).EQ.'YES'.AND.IFOUNZ(21).EQ.'YES')GOTO7020
25231      GOTO7030
25232C
25233 7020 CONTINUE
25234      WRITE(ICOUT,7021)
25235 7021 FORMAT('***** ERROR IN DPTYP2--')
25236      CALL DPWRST('XXX','BUG ')
25237      WRITE(ICOUT,7022)
25238 7022 FORMAT('      BOTH FOR CASE AND SUBSET CASE FOUND')
25239      CALL DPWRST('XXX','BUG ')
25240      WRITE(ICOUT,7023)IWIDTH
25241 7023 FORMAT('IWIDTH = ',I8)
25242      CALL DPWRST('XXX','BUG ')
25243      WRITE(ICOUT,7024)
25244 7024 FORMAT('THE COMMAND LINE IS AS FOLLOWS--')
25245      CALL DPWRST('XXX','BUG ')
25246      WRITE(ICOUT,7025)(IANS(I),I=1,IWIDTH)
25247 7025 FORMAT(80A1)
25248      CALL DPWRST('XXX','BUG ')
25249      IQUAL = 'ERRO'
25250      IMAXR=0
25251      GOTO7090
25252C
25253 7030 CONTINUE
25254      IF(IFOUNZ(11).EQ.'NO'.AND.IFOUNZ(21).EQ.'NO')IQUAL='NONE'
25255      IF(IFOUNZ(11).EQ.'YES')IQUAL='SUBS'
25256      IF(IFOUNZ(21).EQ.'YES')IQUAL='FOR'
25257      IF(IQUAL.EQ.'NONE')IMAXR=IWIDTH
25258      IF(IQUAL.EQ.'SUBS')IMAXR=IBEGIN(11)-1
25259      IF(IQUAL.EQ.'FOR')IMAXR=IBEGIN(21)-1
25260C
25261 7090 CONTINUE
25262      IF(IMINR.LE.0)GOTO7900
25263      IF(IMAXR.LE.0)GOTO7900
25264      IF(IMINR.GT.IMAXR)GOTO7900
25265C
25266C     STEP 7.1--
25267C     DETERMINE THE NUMBER OF COMPONENTS ON THE RIGHT.
25268C     A COMPONENT HERE = A WORD OR A PARENTHESIS.
25269C
25270      ISUM=0
25271      IMIN=7
25272      IMAX=10
25273      DO7100I=IMIN,IMAX
25274      IF(IFOUNZ(I).EQ.'YES')ISUM=ISUM+1
25275 7100 CONTINUE
25276      NUMCR=ISUM
25277C
25278C     STEP 7.2--
25279C     DETERMINE THE NUMBER OF PARENTHESES (LEFT + RIGHT).
25280C
25281      ISUM=0
25282      IMIN=IMINR
25283      IMAX=IMAXR
25284      DO7200I=IMIN,IMAX
25285      IF(IANS(I).EQ.'('.OR.IANS(I).EQ.')')ISUM=ISUM+1
25286 7200 CONTINUE
25287      NUMPR=ISUM
25288C
25289C     STEP 7.3--
25290C     DETERMINE THE NUMBER OF ARITHMETIC OPERATIONS
25291C     +  -  *  /      ON THE RIGHT
25292C     (IT SHOULD BE 0).
25293C     NOTE THAT THE ARITHMETIC OPERATION   **
25294C     WILL BE LUMPED IN WITH    *    .
25295C
25296      ISUM=0
25297      IMIN=IMINR
25298      IMAX=IMAXR
25299      DO7300I=IMIN,IMAX
25300      IF(IANS(I).EQ.'+'.OR.IANS(I).EQ.'-'.OR.
25301     1   IANS(I).EQ.'*'.OR.IANS(I).EQ.'/')ISUM=ISUM+1
25302 7300 CONTINUE
25303      NUMAOR=ISUM
25304C
25305C     STEP 7.4--
25306C     DETERMINE THE TYPE ('NUMB' OR 'WORD')
25307C     FOR THE FIRST WORD ON THE RIGHT.
25308C     THIS SHOULD BE THE VARIABLE OR PARAMETER
25309C     DESIGNATION,
25310C     AND IT SHOULD BE A 'WORD'.
25311C
25312      ITYW1R=ITYPE(7)
25313C
25314C     STEP 7.5--
25315C     DETERMINE IF FIRST WORD ON THE RIGHT
25316C     IS ALREADY IN THE NAME LIST OR NOT.
25317C
25318      INLI1R='NO'
25319      IVARR=IHOL(7)
25320      IVARR2=IHOL2(7)
25321      DO7500I=1,NUMNAM
25322      IF(IVARR.EQ.IHNAME(I).AND.IVARR2.EQ.IHNAM2(I))INLI1R='YES'
25323 7500 CONTINUE
25324C
25325C     STEP 7.6--
25326C     DETERMINE IF FIRST WORD ON THE RIGHT
25327C     IS IN THE VARIABLE/PARAMETER NAME LIST, OR
25328C     IS A COLUMN NAMING (I.E., THE WORD 'COLU' OR 'COL', OR
25329C     IS A DATA MANIPULATION FUNCTION, OR
25330C     IS A STATISTICAL CALCULATION FUNCTION
25331C     (SEARCH IS DONE IN THAT ORDER).
25332C
25333      ICAT1R='NONE'
25334      IVARR=IHOL(7)
25335      IVARR2=IHOL2(7)
25336C
25337      IF(INLI1R.EQ.'YES'.AND.IVARR.NE.'COLU')GOTO7615
25338      IF(INLI1R.EQ.'YES'.AND.IVARR.NE.'COL ')GOTO7615
25339      IF(INLI1R.EQ.'YES'.AND.IVARR.EQ.'COLU'.AND.IVARR2.EQ.'MN  '.AND.
25340     1IFOUNZ(8).EQ.'NO')GOTO7615
25341      IF(INLI1R.EQ.'YES'.AND.IVARR.EQ.'COL '.AND.IVARR2.EQ.'    '.AND.
25342     1IFOUNZ(8).EQ.'NO')GOTO7615
25343      IF(INLI1R.EQ.'YES'.AND.IVARR.EQ.'COLU'.AND.IVARR2.EQ.'MN  '.AND.
25344     1IFOUNZ(8).EQ.'YES'.AND.ITYPE(8).NE.'NUMB')GOTO7615
25345      IF(INLI1R.EQ.'YES'.AND.IVARR.EQ.'COL '.AND.IVARR2.EQ.'    '.AND.
25346     1IFOUNZ(8).EQ.'YES'.AND.ITYPE(8).NE.'NUMB')GOTO7615
25347      GOTO7620
25348 7615 CONTINUE
25349      ICAT1R='VARP'
25350      GOTO7690
25351C
25352 7620 CONTINUE
25353      IF(IVARR.EQ.'COLU'.AND.IVARR2.EQ.'MN  '.AND.
25354     1IFOUNZ(8).EQ.'YES'.AND.ITYPE(8).EQ.'NUMB')GOTO7625
25355      IF(IVARR.EQ.'COL '.AND.IVARR2.EQ.'    '.AND.
25356     1IFOUNZ(8).EQ.'YES'.AND.ITYPE(8).EQ.'NUMB')GOTO7625
25357      GOTO7630
25358 7625 CONTINUE
25359      ICAT1R='COL'
25360      GOTO7690
25361C
25362 7630 CONTINUE
25363      DO7632I=1,NUMMAN
25364      IF(IVARR.EQ.IHMAN(I).AND.IVARR2.EQ.IHMAN2(I))GOTO7635
25365 7632 CONTINUE
25366      GOTO7640
25367 7635 CONTINUE
25368      ICAT1R='MANI'
25369      GOTO7690
25370C
25371 7640 CONTINUE
25372      DO7642I=1,NUMSTA
25373      IF(IVARR.EQ.IHSTAT(I).AND.IVARR2.EQ.IHSTA2(I))GOTO7645
25374 7642 CONTINUE
25375      GOTO7690
25376 7645 CONTINUE
25377      ICAT1R='STAT'
25378      GOTO7690
25379C
25380 7690 CONTINUE
25381C
25382C     STEP 7.7--
25383C     DETERMINE THE TYPE ('NUMB' OR 'WORD')
25384C     FOR THE SECOND WORD
25385C     (AS OPPOSED TO THE SECOND COMPONENT)
25386C     ON THE RIGHT.
25387C     IF EXISTENT, THIS SHOULD BE THE ARGUMENT DESIGNATION
25388C     OF A VARIABLE,
25389C     AND IT MAY BE EITHER A 'WORD' OR A 'NUMB'.
25390C
25391      ITYW2R=ITYPE(9)
25392C
25393 7900 CONTINUE
25394C
25395C               *****************
25396C               **  STEP 90--  **
25397C               **  EXIT       **
25398C               *****************
25399C
25400 9000 CONTINUE
25401      IF(IBUGA3.EQ.'ON')THEN
25402        WRITE(ICOUT,999)
25403        CALL DPWRST('XXX','BUG ')
25404        WRITE(ICOUT,9011)
25405 9011   FORMAT('****** AT THE END      OF DPTYP2--')
25406        CALL DPWRST('XXX','BUG ')
25407        DO9020I=1,30
25408          IF(18.LE.I.AND.I.LE.20)GOTO9020
25409          IF(I.GE.25)GOTO9020
25410          WRITE(ICOUT,999)
25411          CALL DPWRST('XXX','BUG ')
25412          WRITE(ICOUT,9022)
25413 9022     FORMAT('I--IFOUNZ,IBEGIN,IEND,',
25414     1           'ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1')
25415          CALL DPWRST('XXX','BUG ')
25416          WRITE(ICOUT,9025)I,IFOUNZ(I),IBEGIN(I),IEND(I),ITYPE(I),
25417     1                     IHOL(I),IHOL2(I),INT1(I),FLOAT1(I),IERRO1(I)
25418 9025     FORMAT(I3,'--',A4,2(2X,I2),4X,3(A4,2X),I8,2X,D15.7,2X,A4)
25419          CALL DPWRST('XXX','BUG ')
25420 9020   CONTINUE
25421C
25422        WRITE(ICOUT,999)
25423        CALL DPWRST('XXX','BUG ')
25424        WRITE(ICOUT,9031)NUMCL,NUMPL,NUMAOL,ITYW1L,ITYW2L,INLI1L,ICAT1L
25425 9031   FORMAT('NUMCL,NUMPL,NUMAOL,ITYW1L,ITYW2L,INLI1L,ICAT1L = ',
25426     1         3I8,4(2X,A4))
25427        CALL DPWRST('XXX','BUG ')
25428        WRITE(ICOUT,9032)NUMCR,NUMPR,NUMAOR,ITYW1R,ITYW2R,INLI1R,ICAT1R
25429 9032   FORMAT('NUMCR,NUMPR,NUMAOR,ITYW1R,ITYW2R,INLI1R,ICAT1R = ',
25430     1         3I8,4(2X,A4))
25431        CALL DPWRST('XXX','BUG ')
25432      ENDIF
25433C
25434      RETURN
25435      END
25436      SUBROUTINE DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,
25437     1                  IBUGA3,
25438     1                  IFOUZ2,ISTAR2,ISTOP2,
25439     1                  ITYPE2,IHOL,IHOL2,INTZ,FLOATZ,IERROR)
25440C
25441C     NOTE--THIS SUBROUTINE IS IDENTICAL TO DPTY3C
25442C           AND HAS BEEN DUPLICATED ONLY FOR MAPPING PURPOSES.
25443C           DATE--JULY 7, 1978.
25444C
25445C     PURPOSE--SCAN THE CHARACTER ARRAY IANS(.) BETWEEN
25446C              COLUMNS ISTAR1 AND ISTOP1
25447C              FOR THE STRING DEFINED IN STRIN AND ISTRI2.
25448C     NOTE THAT THE STRING DEFINED IN ISTRIN AND ISTRI2
25449C     MAY BE EXPRESSED IN SEVERAL WAYS--
25450C          1) EXPLICITELY, E.G., LET    FOR    SUBSET, ETC.
25451C          2) IMPLICITELY WITH ! REPRESENTING THE FIRST
25452C             NON-BLANK CHARACTER THAT IS ENCOUNTERED;
25453C          3) IMPLICITELY WITH ; REPRESENTING ANY STRING
25454C             (INCLUDING ALL CHARACTERS, EVEN BLANKS));
25455C          4) IMPLICITELY WITH : REPRESENTING THE FIRST
25456C            BLANK CHARACTER THAT IS ENCOUNTERED.
25457C     NOTE--A GIVEN ARGUMENT MAY END UP WITH
25458C            3 DIFFERENT REPRESENTATIONS--
25459C            HOLLERITH, INTEGER, AND FLOATING POINT.
25460C     INPUT  ARGUMENTS--IANS   = A HOLLERITH 1-CHARACTER-PER-WORD
25461C                                VARIABLE CONTAINING THE INPUT LINE
25462C                                TO BE EXAMINED.
25463C                     --IWIDTH = THE (FULL) WIDTH OF THE INPUT LINE
25464C                                (THAT IS, THE NUMBER OF COLUMNS)
25465C                     --ISTAR1 = THE FIRST COLUMN FOR WHICH THE
25466C                                SCAN IS TO BE CARRIED OUT.
25467C                     --ISTOP1 = THE LAST  COLUMN FOR WHICH THE
25468C                                SCAN IS TO BE CARRIED OUT.
25469C                     --ISTRIN = THE HOLLERITH VARIABLE
25470C                                WHICH CONTAINS CHARACTERS 1 TO 4
25471C                                OF THE STRING TO BE SEARCHED FOR.
25472C                                THE DEFINITION OF THE STRING IN ISTRIN MAY
25473C                                MAY BE DONE EXPLICTELY (BUT IS LIMITED
25474C                                TO 4 CHARACTERS) OR IMPLICITELY
25475C                                WHICH IS NOT LIMITED TO 4 CHARACTERS AND IS MOR
25476C                                IS MORE GENERAL IN
25477C                                OTHER WAYS ALSO.
25478C                     --ISTRI2 = THE HOLLERITH VARIABLE
25479C                                WHICH CONTAINS CHARACTERS 5 TO 8
25480C                                OF THE STRING TO BE SEARCHED FOR.
25481C                                THE DEFINITION OF THE STRING IN ISTRIN MAY
25482C                                MAY BE DONE EXPLICTELY (BUT IS LIMITED
25483C                                TO 4 CHARACTERS) OR IMPLICITELY
25484C                                WHICH IS NOT LIMITED TO 4 CHARACTERS AND IS MOR
25485C                                IS MORE GENERAL IN
25486C                                OTHER WAYS ALSO.
25487C                     --INEX   = A HOLLERITH VARIABLE WHICH
25488C                                WILL CONTAIN ONE OF THE FOLLOWING 4 VALUES--
25489C                                II, IE, EI, EE THAT STANDS FOR
25490C                                WHERE I STANDS FOR INCLUSIVE AND
25491C                                WHERE E STANDS FOR EXCLUSIVE;
25492C                                INEX SPECIFIES WHETHER THE FIRST OR LAST CHARAC
25493C                                CHARACTER IS TO BE INCLUDED OR EXCLUDED IN
25494C                                IN DEFINING ISTAR2 AND ISTOP2.
25495C     OUTPUT ARGUMENTS--IFOUZ2 = A HOLLERITH VARIABLE
25496C                                WITH THE VALUE 'YES'
25497C                                IF THE STRING WAS FOUND;
25498C                                AND THE VALUE 'NO'
25499C                                IF THE STRING WAS NOT FOUND.
25500C                     --ISTAR2 = THE START COLUMN OF THE FOUND STRING
25501C                     --ISTOP2 = THE STOP COLUMN OF THE FIUND STRING.
25502C                     --ITYPE2 = A HOLLERITH VARIABLE
25503C                                WITH THE VALUE 'WORD' IF THE STRING CONTAINS
25504C                                ANY NON-NUMERIC (EXCLUDING BLANKS) CHARACTER;
25505C                                AND WITH THE VALUE 'NUMB' IF THE STRING CONTA
25506C                                ALL NUMERIC VALUES OR DECIMAL POINT OR + OR -
25507C                                (WITH INTERMITTENT BLANKS IGNORED).
25508C                     --IHOL   = THE HOLLERITH VARIABLE
25509C                                CONTAINING THE PACKED (4 CHARACTERS) VERSION
25510C                                OF CHARACTERS 1 TO 4 OF THE FOUND STRING.
25511C                     --IHOL2  = THE HOLLERITH VARIABLE
25512C                                CONTAINING THE PACKED (4 CHARACTERS) VERSION
25513C                                OF CHARACTERS 5 TO 8 OF THE FOUND STRING.
25514C                     --INT    = THE INTEGER VARIABLE
25515C                                CONTAINING THE INTEGER REPRESENTATION
25516C                                (IF POSSIBLE) OF THE FOUND STRING.
25517C                     --FLOAT  = THE FLOATING POINT VARIABLE
25518C                                CONTAINING THE FLOATING POINT REPRESENTATION
25519C                                (IF POSSIBLE) OF THE FOUND STRING.
25520C                     --IERROR = A HOLLERITH VARIABLE WITH VALUE
25521C                                'YES' OR 'NO' INDICATING IF AN
25522C                                ERROR CONDITION EXISTS.
25523C     WRITTEN BY--JAMES J. FILLIBEN
25524C                 STATISTICAL ENGINEERING DIVISION
25525C                 INFORMATION TECHNOLOGY LABORATORY
25526C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
25527C                 GAITHERSBURG, MD 20899-8980
25528C                 PHONE--301-975-2855
25529C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
25530C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
25531C     LANGUAGE--ANSI FORTRAN (1977)
25532C     VERSION NUMBER--82/7
25533C     ORIGINAL VERSION--FEBRUARY  1978.
25534C     UPDATED         --JULY      1978.
25535C     UPDATED         --OCTOBER   1978.
25536C     UPDATED         --NOVEMBER  1980.
25537C     UPDATED         --JANUARY   1981.
25538C     UPDATED         --JUNE      1981.
25539C     UPDATED         --MARCH     1982.
25540C     UPDATED         --MAY       1982.
25541C
25542C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
25543C
25544      CHARACTER*4 IANS
25545      CHARACTER*4 ISTRIN
25546      CHARACTER*4 ISTRI2
25547      CHARACTER*4 INEX
25548      CHARACTER*4 IBUGA3
25549      CHARACTER*4 IFOUZ2
25550      CHARACTER*4 ITYPE2
25551      CHARACTER*4 IHOL
25552      CHARACTER*4 IHOL2
25553      CHARACTER*4 IERROR
25554C
25555      CHARACTER*4 ITEMP
25556      CHARACTER*4 IFLUNK
25557      CHARACTER*4 ISTRI3
25558      CHARACTER*4 ILAST
25559      CHARACTER*4 ISUBN1
25560      CHARACTER*4 ISUBN2
25561      CHARACTER*4 ISTEPN
25562C
25563C---------------------------------------------------------------------
25564C
25565      DIMENSION IANS(*)
25566C
25567      DIMENSION ISTRI3(20)
25568C
25569C-----COMMON----------------------------------------------------------
25570C
25571      INCLUDE 'DPCOP2.INC'
25572C
25573C-----START POINT-----------------------------------------------------
25574C
25575      ISUBN1='DPTY'
25576      ISUBN2='P3  '
25577      IERROR='NO'
25578C
25579      IPJM1=0
25580C
25581      IF(IBUGA3.EQ.'ON')THEN
25582        WRITE(ICOUT,999)
25583  999   FORMAT(1X)
25584        CALL DPWRST('XXX','BUG ')
25585        WRITE(ICOUT,51)
25586   51   FORMAT('***** AT THE BEGINNING OF DPTYP3--')
25587        CALL DPWRST('XXX','BUG ')
25588        WRITE(ICOUT,53)ISTAR1,ISTOP1
25589   53   FORMAT('ISTAR1,ISTOP1 = ',I8,I8)
25590        CALL DPWRST('XXX','BUG ')
25591        WRITE(ICOUT,54)IBUGA3,ISTRIN,ISTRI2
25592   54   FORMAT('IBUGA3,ISTRIN,ISTRI2 = ',2(A4,2X),A4)
25593        CALL DPWRST('XXX','BUG ')
25594      ENDIF
25595C
25596      NUMASC=4
25597C
25598C               ******************************************************
25599C               **  STEP 1--                                        **
25600C               **  INITIALIZE THE OUTPUT PARAMETERS AND VARIABLES  **
25601C               ******************************************************
25602C
25603      ISTEPN='1'
25604      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25605C
25606      IF(IBUGA3.EQ.'OFF')GOTO150
25607      WRITE(ICOUT,101)
25608  101 FORMAT('AT THE BEGINNING OF DPTYP3--')
25609      CALL DPWRST('XXX','BUG ')
25610      WRITE(ICOUT,102)IWIDTH
25611  102 FORMAT('IWIDTH = ',I8)
25612      CALL DPWRST('XXX','BUG ')
25613      WRITE(ICOUT,103)(IANS(I),I=1,IWIDTH)
25614  103 FORMAT('IANS(.) = ',80A1)
25615      CALL DPWRST('XXX','BUG ')
25616      WRITE(ICOUT,104)ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX
25617  104 FORMAT('ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX = ',I8,I8,A4,A4,A4)
25618      CALL DPWRST('XXX','BUG ')
25619  150 CONTINUE
25620      IFOUZ2='NO'
25621      ISTAR2=-1
25622      ISTOP2=-1
25623      ITYPE2='9999'
25624      IHOL ='9999'
25625      IHOL2='9999'
25626      FLOATZ=-999999.0
25627C
25628C               *********************************************************
25629C               **  STEP 2--                                           **
25630C               **  DECOMPOSE THE INPUT SEARCH STRING INTO A1 CHARACTERS*
25631C               *********************************************************
25632C
25633      ISTEPN='2'
25634      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25635      IMAX=2*NUMASC
25636      DO300I=1,IMAX
25637      I2=I
25638      J=I
25639      IF(I.GT.NUMASC)J=I-NUMASC
25640      ISTAR3=NUMBPC*(J-1)
25641      ISTAR3=IABS(ISTAR3)
25642      ITEMP='    '
25643      IF(I.LE.NUMASC)CALL DPCHEX(ISTAR3,NUMBPC,ISTRIN,0,NUMBPC,ITEMP)
25644      IF(I.GT.NUMASC)CALL DPCHEX(ISTAR3,NUMBPC,ISTRI2,0,NUMBPC,ITEMP)
25645      IF(ITEMP.EQ.'    ')GOTO350
25646      ISTRI3(I)=ITEMP
25647  300 CONTINUE
25648      ILEN2=I2
25649      GOTO390
25650  350 CONTINUE
25651      ILEN2=I2-1
25652  390 CONTINUE
25653C
25654      IF(IBUGA3.EQ.'OFF')GOTO399
25655      WRITE(ICOUT,391)
25656  391 FORMAT('IN THE MIDDLE OF DPTYP3 (AFTER STEP 2)--')
25657      CALL DPWRST('XXX','BUG ')
25658      WRITE(ICOUT,392)ILEN2
25659  392 FORMAT('ILEN2 = ',I8)
25660      CALL DPWRST('XXX','BUG ')
25661      WRITE(ICOUT,393)(ISTRI3(I),I=1,ILEN2)
25662  393 FORMAT('ISTRI3(.) = ',6A1)
25663      CALL DPWRST('XXX','BUG ')
25664  399 CONTINUE
25665C
25666C               ****************************************************************
25667C               **  STEP 3--
25668C               **  DISTINGUISH BETWEEN THE 3 TYPES OF POSSIBLE SEARCH STRINGS--
25669C               **  1) AN EXPLICITELY-DEFINED STRING; E.G.,
25670C               **     LET     FOR     SUBSET     =     5.3     -2.6666666
25671C               **     (AS IN COMMANDS, KEY WORDS, AND NUMBERS);
25672C               **  2) A STRING STARTING WITH THE FIRST NON-BLANK CHARACTER
25673C               **     AND ENDING WITH SOME SPECIFIED CHARACTER; E.G., XXXXX(
25674C               **     (AS IN THE VARIABLE NAME OF A SUBSCRIPTED VARIABLE,
25675C               **     OR THE ARGUMENT (I. E., THE SUBSCRIPT) IN A SUBSCRIPTED
25676C               **     VARIABLE);
25677C               **  3) A STRING STARTING WITH THE FIRST NON-BLANK CHARACTER
25678C               **     AND ENDING WITH THE FIRST SUBSEQUENT BLANK CHARACTER
25679C               **     (OR ENDING WITH THE END OF THE LINE).
25680C               **     E.G., XXXX
25681C               **     (AS IN SOME UNSPECIFIED PARAMETER OR VARIABLE NAME).
25682C               ****************************************************************
25683C
25684      ISTEPN='3'
25685      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25686      ICASE=1
25687      IF(ISTRI3(1).NE.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).NE.':')
25688     1ICASE=2
25689      IF(ISTRI3(1).EQ.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).NE.':')
25690     1ICASE=3
25691      IF(ISTRI3(1).EQ.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).EQ.':')
25692     1ICASE=4
25693      IF(ILEN2.EQ.1.OR.ILEN2.EQ.2)ICASE=1
25694C
25695      IF(IBUGA3.EQ.'OFF')GOTO398
25696      WRITE(ICOUT,395)
25697  395 FORMAT('AFTER STEP 3 OF DPTYP3--')
25698      CALL DPWRST('XXX','BUG ')
25699      WRITE(ICOUT,396)ICASE
25700  396 FORMAT('ICASE = ',I8)
25701      CALL DPWRST('XXX','BUG ')
25702  398 CONTINUE
25703C
25704C               *********************************************************
25705C               **  STEP 4--                                           **
25706C               **  DETERMINE IF THE DESIRED SEARCH STRING IS PRESENT  **
25707C               *********************************************************
25708C
25709      ISTEPN='4'
25710      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25711      IF(ICASE.EQ.1)GOTO400
25712      IF(ICASE.EQ.2)GOTO500
25713      IF(ICASE.EQ.3)GOTO600
25714      IF(ICASE.EQ.4)GOTO700
25715C
25716  400 CONTINUE
25717      DO410I=ISTAR1,ISTOP1
25718      I2=I
25719      IF(IANS(I).EQ.ISTRI3(1))GOTO420
25720      GOTO410
25721  420 CONTINUE
25722      DO430J=1,ILEN2
25723      IPJM1=J+I-1
25724      IF(IPJM1.GT.ISTOP1)GOTO410
25725      IF(IANS(IPJM1).EQ.ISTRI3(J))GOTO430
25726      GOTO410
25727  430 CONTINUE
25728      IFOUZ2='YES'
25729      IF(INEX.EQ.'II')ISTAR2=I2
25730      IF(INEX.EQ.'IE')ISTAR2=I2
25731      IF(INEX.EQ.'EI')ISTAR2=I2+1
25732      IF(INEX.EQ.'EE')ISTAR2=I2+1
25733      IF(INEX.EQ.'II')ISTOP2=IPJM1
25734      IF(INEX.EQ.'IE')ISTOP2=IPJM1-1
25735      IF(INEX.EQ.'EI')ISTOP2=IPJM1
25736      IF(INEX.EQ.'EE')ISTOP2=IPJM1-1
25737      IF(ISTAR2.LE.ISTOP2)GOTO990
25738      GOTO900
25739  410 CONTINUE
25740      IFOUZ2='NO'
25741      GOTO9000
25742C
25743  500 CONTINUE
25744      DO510I=ISTAR1,ISTOP1
25745      I2=I
25746      IF(IANS(I).EQ.ISTRI3(1))GOTO520
25747  510 CONTINUE
25748      IFOUZ2='NO'
25749      GOTO9000
25750  520 CONTINUE
25751      IMIN=I2
25752      DO530I=IMIN,ISTOP1
25753      I2=I
25754      IF(IANS(I).EQ.ISTRI3(ILEN2))GOTO540
25755  530 CONTINUE
25756      IFOUZ2='NO'
25757      GOTO9000
25758  540 CONTINUE
25759      IFOUZ2='YES'
25760      IF(INEX.EQ.'II')ISTAR2=IMIN
25761      IF(INEX.EQ.'IE')ISTAR2=IMIN
25762      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
25763      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
25764      IF(INEX.EQ.'II')ISTOP2=I2
25765      IF(INEX.EQ.'IE')ISTOP2=I2-1
25766      IF(INEX.EQ.'EI')ISTOP2=I2
25767      IF(INEX.EQ.'EE')ISTOP2=I2-1
25768      IF(ISTAR2.LE.ISTOP2)GOTO990
25769      GOTO900
25770C
25771  600 CONTINUE
25772      DO610I=ISTAR1,ISTOP1
25773      I2=I
25774      IF(IANS(I).NE.' ')GOTO620
25775  610 CONTINUE
25776      IFOUZ2='NO'
25777      GOTO9000
25778  620 CONTINUE
25779      IMIN=I2
25780      DO630I=IMIN,ISTOP1
25781      I2=I
25782      IF(IANS(I).EQ.ISTRI3(ILEN2))GOTO640
25783  630 CONTINUE
25784      IFOUZ2='NO'
25785      GOTO9000
25786  640 CONTINUE
25787      IFOUZ2='YES'
25788      IF(INEX.EQ.'II')ISTAR2=IMIN
25789      IF(INEX.EQ.'IE')ISTAR2=IMIN
25790      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
25791      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
25792      IF(INEX.EQ.'II')ISTOP2=I2
25793      IF(INEX.EQ.'IE')ISTOP2=I2-1
25794      IF(INEX.EQ.'EI')ISTOP2=I2
25795      IF(INEX.EQ.'EE')ISTOP2=I2-1
25796      IF(ISTAR2.LE.ISTOP2)GOTO990
25797      GOTO900
25798C
25799  700 CONTINUE
25800      ILAST='BLAN'
25801      DO710I=ISTAR1,ISTOP1
25802      I2=I
25803      IF(IANS(I).NE.' ')GOTO720
25804  710 CONTINUE
25805      IFOUZ2='NO'
25806      GOTO9000
25807  720 CONTINUE
25808      IMIN=I2
25809      DO730I=IMIN,ISTOP1
25810      I2=I
25811      IF(IANS(I).EQ.' ')GOTO740
25812  730 CONTINUE
25813      ILAST='NOBL'
25814      IF(ISTOP1.EQ.IWIDTH)GOTO740
25815      IFOUZ2='NO'
25816      GOTO9000
25817  740 CONTINUE
25818      IFOUZ2='YES'
25819      IF(INEX.EQ.'II')ISTAR2=IMIN
25820      IF(INEX.EQ.'IE')ISTAR2=IMIN
25821      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
25822      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
25823      IF(INEX.EQ.'II'.AND.ISTOP1.NE.IWIDTH)
25824     1ISTOP2=I2
25825      IF(INEX.EQ.'II'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.EQ.'BLAN')
25826     1ISTOP2=I2
25827      IF(INEX.EQ.'II'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.NE.'BLAN')
25828     1ISTOP2=I2
25829      IF(INEX.EQ.'IE'.AND.ISTOP1.NE.IWIDTH)
25830     1ISTOP2=I2-1
25831      IF(INEX.EQ.'IE'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.EQ.'BLAN')
25832     1ISTOP2=I2-1
25833      IF(INEX.EQ.'IE'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.NE.'BLAN')
25834     1ISTOP2=I2
25835      IF(INEX.EQ.'EI'.AND.ISTOP1.NE.IWIDTH)
25836     1ISTOP2=I2
25837      IF(INEX.EQ.'EI'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.EQ.'BLAN')
25838     1ISTOP2=I2
25839      IF(INEX.EQ.'EI'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.NE.'BLAN')
25840     1ISTOP2=I2
25841      IF(INEX.EQ.'EE'.AND.ISTOP1.NE.IWIDTH)
25842     1ISTOP2=I2-1
25843      IF(INEX.EQ.'EE'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.EQ.'BLAN')
25844     1ISTOP2=I2-1
25845      IF(INEX.EQ.'EE'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.NE.'BLAN')
25846     1ISTOP2=I2
25847      IF(ISTAR2.LE.ISTOP2)GOTO990
25848      GOTO900
25849C
25850  900 CONTINUE
25851C
25852C     NOTE--THE FOLLOWING SECTION HAS BEEN 'BUGGED' OUT
25853C           TO CIRCUMVENT A PROBLEM WITH Y=(...
25854C           WHILE IT STILL LOOKED FOR A VARIABLE NAME
25855C           BETWEEN THE = AND THE (     .
25856C     CAUTION--WHEN IBUGA3 = 'OFF', AS IT USUALLY IS,
25857C              IERROR CAN NEVER BE 'YES'
25858C              UPON RETURN FROM DPTYP3:
25859C              BUT WHEN IBUGA3 = 'ON' (AS IN ERROR TRACING)
25860C              IERROR MAY = 'YES' WHICH MAY CHANGE THE
25861C              LOGIC PATH BACK IN DPTYP2.
25862C
25863      IF(IBUGA3.EQ.'OFF')GOTO9000
25864      WRITE(ICOUT,921)
25865  921 FORMAT('***** INTERNAL ERROR IN DPTYP3 SUBROUTINE')
25866      CALL DPWRST('XXX','BUG ')
25867      WRITE(ICOUT,922)
25868  922 FORMAT('ISTAR2 GREATER THAN ISTOP2')
25869      CALL DPWRST('XXX','BUG ')
25870      WRITE(ICOUT,923)ISTAR2,ISTOP2
25871  923 FORMAT('ISTAR2, ISTOP2 = ',2I8)
25872      CALL DPWRST('XXX','BUG ')
25873      WRITE(ICOUT,924)ICASE
25874  924 FORMAT('ICASE = ',I8)
25875      CALL DPWRST('XXX','BUG ')
25876      WRITE(ICOUT,999)
25877      CALL DPWRST('XXX','BUG ')
25878      WRITE(ICOUT,925)IWIDTH
25879  925 FORMAT('IWIDTH = ',I8)
25880      CALL DPWRST('XXX','BUG ')
25881      WRITE(ICOUT,926)(IANS(I),I=1,IWIDTH)
25882  926 FORMAT('IANS(.) = ',80A1)
25883      CALL DPWRST('XXX','BUG ')
25884      WRITE(ICOUT,927)ISTAR1,ISTOP1
25885  927 FORMAT('ISTAR1, ISTOP1 = ',2I8)
25886      CALL DPWRST('XXX','BUG ')
25887      WRITE(ICOUT,928)ILEN2
25888  928 FORMAT('ILEN2 = ',I8)
25889      CALL DPWRST('XXX','BUG ')
25890      WRITE(ICOUT,929)(ISTRI3(I),I=1,ILEN2)
25891  929 FORMAT('ISTRI3(.) = ',80A1)
25892      CALL DPWRST('XXX','BUG ')
25893      WRITE(ICOUT,930)ISTRIN,ISTRI2
25894  930 FORMAT('ISTRIN,ISTRI2 = ',2A4)
25895      CALL DPWRST('XXX','BUG ')
25896      WRITE(ICOUT,931)INEX
25897  931 FORMAT('INEX = ',A4)
25898      CALL DPWRST('XXX','BUG ')
25899      IERROR='YES'
25900      GOTO9000
25901  990 CONTINUE
25902C
25903C               ********************************************************
25904C               **  STEP 5--                                          **
25905C               **  CONVERT THE STRING INTO 2 HOLLERITH A4 WORDS.     **
25906C               **  IF MORE THAN 8 CHARACTERS, CONVERT ONLY           **
25907C               **  THE FIRST 8 CHARACTERS.                           **
25908C               **  OUTPUT THESE HOLLERITH WORDS AS IHOL AND IHOL2.   **
25909C               ********************************************************
25910C
25911      ISTEPN='5'
25912      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25913      IHOL ='    '
25914      IHOL2='    '
25915      IMAX=2*NUMASC
25916      J=0
25917      DO1000I=ISTAR2,ISTOP2
25918      J=J+1
25919      K=J
25920      IF(J.GT.NUMASC)K=J-NUMASC
25921      ISTAR3=NUMBPC*(K-1)
25922      ISTAR3=IABS(ISTAR3)
25923      IF(J.LE.NUMASC)CALL DPCHEX(0,NUMBPC,IANS(I),ISTAR3,NUMBPC,IHOL)
25924      IF(J.GT.NUMASC)CALL DPCHEX(0,NUMBPC,IANS(I),ISTAR3,NUMBPC,IHOL2)
25925      IF(J.GE.IMAX)GOTO1050
25926 1000 CONTINUE
25927 1050 CONTINUE
25928C
25929C               ****************************************************************
25930C               **  STEP 6--
25931C               **  CONVERT (IF POSSIBLE) THE STRING INTO AN INTEGER ARGUMENT.
25932C               **  OUTPUT  THIS INTEGER VALUE IN INT.
25933C               ****************************************************************
25934C
25935      ISTEPN='6'
25936      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25937      IFLUNK='NO'
25938      ITYPE2='NUMB'
25939      IDIG=0
25940      ISIGN=0
25941      IDECPT=0
25942      ISUM=0
25943      DO2700I=ISTAR2,ISTOP2
25944      IREV=ISTOP2-(I-ISTAR2)
25945      IF(IANS(IREV).EQ.' ')GOTO2700
25946      IF(IANS(IREV).EQ.'0')GOTO2710
25947      IF(IANS(IREV).EQ.'1')GOTO2711
25948      IF(IANS(IREV).EQ.'2')GOTO2712
25949      IF(IANS(IREV).EQ.'3')GOTO2713
25950      IF(IANS(IREV).EQ.'4')GOTO2714
25951      IF(IANS(IREV).EQ.'5')GOTO2715
25952      IF(IANS(IREV).EQ.'6')GOTO2716
25953      IF(IANS(IREV).EQ.'7')GOTO2717
25954      IF(IANS(IREV).EQ.'8')GOTO2718
25955      IF(IANS(IREV).EQ.'9')GOTO2719
25956      IF(IANS(IREV).EQ.'+')GOTO2720
25957      IF(IANS(IREV).EQ.'-')GOTO2721
25958      IF(IANS(IREV).EQ.'.')GOTO2722
25959      IFLUNK='YES'
25960      GOTO2800
25961 2710 ITERM=0
25962      GOTO2725
25963 2711 ITERM=1
25964      GOTO2725
25965 2712 ITERM=2
25966      GOTO2725
25967 2713 ITERM=3
25968      GOTO2725
25969 2714 ITERM=4
25970      GOTO2725
25971 2715 ITERM=5
25972      GOTO2725
25973 2716 ITERM=6
25974      GOTO2725
25975 2717 ITERM=7
25976      GOTO2725
25977 2718 ITERM=8
25978      GOTO2725
25979 2719 ITERM=9
25980      GOTO2725
25981 2720 ISIGN=ISIGN+1
25982      GOTO2700
25983 2721 ISIGN=ISIGN+1
25984      ISUM=-ISUM
25985      GOTO2700
25986 2722 IDECPT=IDECPT+1
25987      IF(IDECPT.EQ.1.AND.IDIG.EQ.0)GOTO2700
25988      GOTO2800
25989 2725 IDIG=IDIG+1
25990      TERM2=10.0**(IDIG-1)
25991      ITERM2=INT(TERM2 + 0.01)
25992      ISUM=ISUM+ITERM*ITERM2
25993 2700 CONTINUE
25994      IF(IDIG.LE.0)GOTO2800
25995      IF(ISIGN.GE.2)GOTO2800
25996      INTZ=ISUM
25997 2800 CONTINUE
25998      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
25999C
26000C               *******************************************************
26001C               **  STEP 7--                                         **
26002C               **  CONVERT (IF POSSIBLE) THE STRING INTO A FLOATING **
26003C               **  POINT ARGUMENT.                                  **
26004C               **  OUTPUT THIS FLOATING POINT VALUE IN FLOAT.       **
26005C               *******************************************************
26006C
26007      ISTEPN='7'
26008      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26009      AMIN=-1000000.
26010      AMAX=+1000000.
26011      IFLUNK='NO'
26012      ITYPE2='NUMB'
26013      FLOATZ=-1.0
26014C
26015      ILOC=0
26016      IDECPT=0
26017      DO3060I=ISTAR2,ISTOP2
26018      IF(IANS(I).EQ.'.')ILOC=I
26019      IF(IANS(I).EQ.'.')IDECPT=IDECPT+1
26020 3060 CONTINUE
26021      IF(IDECPT.GE.2)GOTO3900
26022      IF(IDECPT.EQ.1)GOTO3150
26023      DO3100I=ISTAR2,ISTOP2
26024      IREV=ISTOP2-(I-ISTAR2)
26025      IF(IANS(IREV).EQ.' ')GOTO3100
26026      IF(IANS(IREV).EQ.'0')GOTO3110
26027      IF(IANS(IREV).EQ.'1')GOTO3110
26028      IF(IANS(IREV).EQ.'2')GOTO3110
26029      IF(IANS(IREV).EQ.'3')GOTO3110
26030      IF(IANS(IREV).EQ.'4')GOTO3110
26031      IF(IANS(IREV).EQ.'5')GOTO3110
26032      IF(IANS(IREV).EQ.'6')GOTO3110
26033      IF(IANS(IREV).EQ.'7')GOTO3110
26034      IF(IANS(IREV).EQ.'8')GOTO3110
26035      IF(IANS(IREV).EQ.'9')GOTO3110
26036      IFLUNK='YES'
26037      IF(IANS(IREV).EQ.'+')GOTO3900
26038      IF(IANS(IREV).EQ.'-')GOTO3900
26039      GOTO3900
26040 3100 CONTINUE
26041      IFLUNK='YES'
26042      GOTO3900
26043 3110 ILOC=IREV+1
26044 3150 CONTINUE
26045      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3111)ILOC,IDECPT
26046 3111 FORMAT('ILOC = ',I8,'    IDECPT = ',I8)
26047      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
26048C
26049C     SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE
26050C
26051      SIGN=1.0
26052      IDIGI=0
26053      ISIGN=0
26054      SUMI=0
26055      ILOCM1=ILOC-1
26056      IF(ILOCM1.LT.ISTAR2)GOTO3250
26057      DO3200I=ISTAR2,ILOCM1
26058      IREV=ILOCM1-(I-ISTAR2)
26059      IF(IANS(IREV).EQ.' ')GOTO3200
26060      IF(IANS(IREV).EQ.'0')GOTO3210
26061      IF(IANS(IREV).EQ.'1')GOTO3211
26062      IF(IANS(IREV).EQ.'2')GOTO3232
26063      IF(IANS(IREV).EQ.'3')GOTO3213
26064      IF(IANS(IREV).EQ.'4')GOTO3214
26065      IF(IANS(IREV).EQ.'5')GOTO3215
26066      IF(IANS(IREV).EQ.'6')GOTO3216
26067      IF(IANS(IREV).EQ.'7')GOTO3217
26068      IF(IANS(IREV).EQ.'8')GOTO3218
26069      IF(IANS(IREV).EQ.'9')GOTO3219
26070      IF(IANS(IREV).EQ.'+')GOTO3220
26071      IF(IANS(IREV).EQ.'-')GOTO3221
26072      IFLUNK='YES'
26073      GOTO3900
26074 3210 ITERM=0
26075      GOTO3225
26076 3211 ITERM=1
26077      GOTO3225
26078 3232 ITERM=2
26079      GOTO3225
26080 3213 ITERM=3
26081      GOTO3225
26082 3214 ITERM=4
26083      GOTO3225
26084 3215 ITERM=5
26085      GOTO3225
26086 3216 ITERM=6
26087      GOTO3225
26088 3217 ITERM=7
26089      GOTO3225
26090 3218 ITERM=8
26091      GOTO3225
26092 3219 ITERM=9
26093      GOTO3225
26094 3220 ISIGN=ISIGN+1
26095      GOTO3200
26096 3221 ISIGN=ISIGN+1
26097      SIGN=-SIGN
26098      GOTO3200
26099 3225 IDIGI=IDIGI+1
26100      TERM=ITERM
26101      IEXP=IDIGI-1
26102      SUMI=SUMI+TERM*(10.0**IEXP)
26103 3200 CONTINUE
26104 3250 CONTINUE
26105      IF(ISIGN.GE.2)GOTO3900
26106      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3255)IDIGI,SUMI
26107 3255 FORMAT('IDIGI = ',I8,'    SUMI = ',F20.10)
26108      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
26109C
26110C     THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE
26111C
26112      IDIGD=0
26113      SUMD=0.0
26114      ILOCP1=ILOC+1
26115      IF(ILOCP1.GT.ISTOP2)GOTO3350
26116      DO3300I=ILOCP1,ISTOP2
26117      IF(IANS(I).EQ.' ')GOTO3300
26118      IF(IANS(I).EQ.'0')GOTO3310
26119      IF(IANS(I).EQ.'1')GOTO3311
26120      IF(IANS(I).EQ.'2')GOTO3312
26121      IF(IANS(I).EQ.'3')GOTO3333
26122      IF(IANS(I).EQ.'4')GOTO3314
26123      IF(IANS(I).EQ.'5')GOTO3315
26124      IF(IANS(I).EQ.'6')GOTO3316
26125      IF(IANS(I).EQ.'7')GOTO3317
26126      IF(IANS(I).EQ.'8')GOTO3318
26127      IF(IANS(I).EQ.'9')GOTO3319
26128      IFLUNK='YES'
26129      GOTO3900
26130 3310 ITERM=0
26131      GOTO3325
26132 3311 ITERM=1
26133      GOTO3325
26134 3312 ITERM=2
26135      GOTO3325
26136 3333 ITERM=3
26137      GOTO3325
26138 3314 ITERM=4
26139      GOTO3325
26140 3315 ITERM=5
26141      GOTO3325
26142 3316 ITERM=6
26143      GOTO3325
26144 3317 ITERM=7
26145      GOTO3325
26146 3318 ITERM=8
26147      GOTO3325
26148 3319 ITERM=9
26149      GOTO3325
26150 3325 IDIGD=IDIGD+1
26151      TERM=ITERM
26152      SUMD=SUMD+TERM/(10.0**IDIGD)
26153 3300 CONTINUE
26154 3350 CONTINUE
26155      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3355)IDIGD,SUMD
26156 3355 FORMAT('IDIGD = ',I8,'    SUMD = ',F20.10)
26157      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
26158      IDIGT=IDIGI+IDIGD
26159      IF(IDIGT.LE.0)GOTO3900
26160      FLOATZ=SUMI+SUMD
26161      IF(SIGN.LT.0.0)FLOATZ=-FLOATZ
26162      IF(AMIN.LE.FLOATZ.AND.FLOATZ.LE.AMAX)GOTO3000
26163      GOTO3900
26164C
26165 3900 CONTINUE
26166      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
26167 3000 CONTINUE
26168      GOTO9000
26169C
26170 9000 CONTINUE
26171      IF(IBUGA3.EQ.'OFF')GOTO9900
26172      WRITE(ICOUT,999)
26173      CALL DPWRST('XXX','BUG ')
26174      WRITE(ICOUT,9001)
26175 9001 FORMAT('****** AT THE END       OF DPTYP3--')
26176      CALL DPWRST('XXX','BUG ')
26177      WRITE(ICOUT,9002)IFOUZ2,ISTAR2,ISTOP2
26178 9002 FORMAT('IFOUZ2, ISTAR2, ISTOP2 = ',A4,I8,I8)
26179      CALL DPWRST('XXX','BUG ')
26180      WRITE(ICOUT,9003)ITYPE2,IHOL,IHOL2,INTZ,FLOATZ,IERROR
26181 9003 FORMAT('ITYPE2,IHOL,IHOL2,INTZ,FLOATZ,IERROR = ',
26182     1       A4,2X,2A4,2X,I8,F15.7,2X,A4)
26183      CALL DPWRST('XXX','BUG ')
26184C
26185 9900 CONTINUE
26186      RETURN
26187      END
26188      SUBROUTINE DPTYPE(IANSLC,IWIDTH,IBUGTY,
26189     1                  ICOM,ICOM2,ICOMT,ICOMI,ACOM,ICOMLC,ICOML2,
26190     1                  IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
26191     1                  IHARG,IHARG2,IARGT,IARG,ARG,
26192     1                  IHARLC,IHARL2,NUMARG,
26193     1                  IHOST1,IHOST2)
26194C
26195C     PUTPOSE--TAKE THE COMPONENTS OF AN INPUT COMMAND LINE
26196C              AND COMPUTE HOLLERITH, INTEGER, AND FLOATING POINT
26197C              EQUIVALENTS FOR EACH COMPONENT.
26198C     INPUT  ARGUMENTS--IANSLC   (A HOLLERITH VECTOR)
26199C                     --IWIDTH (AN INTEGER VARIABLE)
26200C     OUTPUT ARGUMENTS--ICOM   (AN A4 HOLLERITH VALUE FOR COMMAND)
26201C                     --ICOM2  (AN A4 HOLLERITH VALUE FOR COMMAND)
26202C                     --ICOMLC  (AN A4 HOLLERITH VALUE FOR COMMAND)
26203C                     --ICOML2  (AN A4 HOLLERITH VALUE FOR COMMAND)
26204C                     --IHARG  (AN A4 HOLLERITH VECTOR)
26205C                     --IHARG2 (AN A4 HOLLERITH VECTOR)
26206C                     --IARG   (AN INTEGER VECTOR)
26207C                     --ARG    (A FLOATING POINT VECTOR)
26208C                     --IHARLC (AN A4 HOLLERITH VECTOR)
26209C                     --IHARL2 (AN A4 HOLLERITH VECTOR)
26210C                     --NUMARG (AN INTEGER VARIABLE)
26211C      NOTE--A GIVEN ARGUMENT MAY END UP WITH
26212C            3 DIFFERENT REPRESENTATIONS--
26213C            HOLLERITH, INTEGER, AND FLOATING POINT.
26214C     WRITTEN BY--JAMES J. FILLIBEN
26215C                 STATISTICAL ENGINEERING DIVISION
26216C                 INFORMATION TECHNOLOGY LABORATORY
26217C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
26218C                 GAITHERSBURG, MD 20899-8980
26219C                 PHONE--301-975-2855
26220C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
26221C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
26222C     LANGUAGE--ANSI FORTRAN (1977)
26223C     VERSION NUMBER--82/7
26224C     ORIGINAL VERSION--NOVEMBER 10, 1977.
26225C     UPDATED         --MAY       1978.
26226C     UPDATED         --OCTOBER   1978.
26227C     UPDATED         --SEPTEMBER 1980.
26228C     UPDATED         --NOVEMBER  1980.
26229C     UPDATED         --AUGUST    1981.
26230C     UPDATED         --OCTOBER   1981.
26231C     UPDATED         --MAY       1982.
26232C     UPDATED         --NOVEMBER  1982.
26233C     UPDATED         --SEPTEMBER 1986.
26234C     UPDATED         --FEBRUARY  1989. ADJUST <> CASE (ALAN)
26235C     UPDATED         --AUGUST    1990. FIX HONEYWELL/PRIME > PROBLEM
26236C     UPDATED         --OCTOBER   1997. CHECK FOR EXPONENTIAL NUMBERS
26237C     UPDATED         --OCTOBER   2001. BUG ON SUN
26238C     UPDATED         --APRIL     2018. TREAT COMMA AS DELIMITER (IN
26239C                                       ADDITION TO SPACE AND HYPHEN)
26240C     UPDATED         --APRIL     2018. OPTIONS TO TURN OFF HYPHEN,
26241C                                       COMMA, OR EQUAL AS A DELIMITER
26242C     UPDATED         --APRIL     2018. IF EQUAL SIGN NOT A DELIMITER,
26243C                                       THEN QUOTE TO RIGHT OF EQUAL
26244C                                       DOES NOT START A NEW WORD
26245C                                       (BUT DO TURN QUOTING ON),
26246C                                       NEEDED FOR:
26247C                                          CALL TITLE="Sample Title"
26248C
26249C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
26250C
26251      CHARACTER*4 IERROR
26252      CHARACTER*4 IANSLC
26253      CHARACTER*4 IBUGTY
26254      CHARACTER*4 ICOM
26255      CHARACTER*4 ICOM2
26256      CHARACTER*4 ICOMT
26257      CHARACTER*4 ICOMLC
26258      CHARACTER*4 ICOML2
26259      CHARACTER*4 IHNAME
26260      CHARACTER*4 IHNAM2
26261      CHARACTER*4 IUSE
26262      CHARACTER*4 IHARG
26263      CHARACTER*4 IHARG2
26264      CHARACTER*4 IARGT
26265      CHARACTER*4 IHARLC
26266      CHARACTER*4 IHARL2
26267      CHARACTER*4 IHOST1
26268      CHARACTER*4 IHOST2
26269C
26270      CHARACTER*4 IFLUNK
26271      CHARACTER*4 IB
26272      CHARACTER*4 IANS1
26273      CHARACTER*4 IANS2
26274      CHARACTER*4 IH
26275      CHARACTER*4 IH2
26276C
26277      CHARACTER*4 ISUBN1
26278      CHARACTER*4 ISUBN2
26279      CHARACTER*4 ISTEPN
26280C
26281      CHARACTER*10 ICJUNK
26282      CHARACTER*5 IFRMT
26283C
26284C---------------------------------------------------------------------
26285C
26286      DIMENSION IANSLC(*)
26287C
26288      DIMENSION IHNAME(*)
26289      DIMENSION IHNAM2(*)
26290      DIMENSION IUSE(*)
26291      DIMENSION IVALUE(*)
26292      DIMENSION VALUE(*)
26293C
26294      DIMENSION IHARG(*)
26295      DIMENSION IHARG2(*)
26296      DIMENSION IARGT(*)
26297      DIMENSION IARG(*)
26298      DIMENSION ARG(*)
26299      DIMENSION IHARLC(*)
26300      DIMENSION IHARL2(*)
26301C
26302CCCCC PARAMETER (MAXZZZ=255)
26303      PARAMETER (MAXZZZ=1024)
26304C
26305      DIMENSION ISTART(MAXZZZ)
26306      DIMENSION ISTOP(MAXZZZ)
26307      DIMENSION IB(MAXZZZ)
26308C
26309C-----COMMON----------------------------------------------------------
26310C
26311      INCLUDE 'DPCOST.INC'
26312      INCLUDE 'DPCOP2.INC'
26313C
26314C-----START POINT-----------------------------------------------------
26315C
26316      ISUBN1='DPTY'
26317      ISUBN2='PE  '
26318      IERROR='OFF'
26319C
26320      IF(IBUGTY.EQ.'ON')THEN
26321        WRITE(ICOUT,999)
26322  999   FORMAT(1X)
26323        CALL DPWRST('XXX','BUG ')
26324        WRITE(ICOUT,51)
26325   51   FORMAT('***** AT THE BEGINNING OF DPTYPE--')
26326        CALL DPWRST('XXX','BUG ')
26327        WRITE(ICOUT,53)(IANSLC(I),I=1,MIN(120,IWIDTH))
26328   53   FORMAT('(IANSLC(.) = ',120A1)
26329        CALL DPWRST('XXX','BUG ')
26330        WRITE(ICOUT,61)IWIDTH,IHOST1,IHOST2
26331   61   FORMAT('IWIDTH,IHOST1,IHOST2 = ',I8,2(2X,A4))
26332        CALL DPWRST('XXX','BUG ')
26333      ENDIF
26334C
26335C               ************************************************************
26336C               **  DEFINE NUMASC = NUMBER OF ASCII CHARACTERS PER WORD.  **
26337C               **  THIS IS 4 REGARDLESS OF THE COMPUTER MAKE AND         **
26338C               **  REGARDLESS OF THE WORD SIZE.                          **
26339C               ************************************************************
26340C
26341      NUMASC=4
26342C
26343C               **********************************
26344C               **  STEP 1--                    **
26345C               **  INITIALIZE SOME VARIABLES.  **
26346C               **********************************
26347C
26348      ISTEPN='1'
26349      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26350C
26351      ICOM='    '
26352      ICOM2='    '
26353      ICOMT='NUMB'
26354      ICOMI=(-1)
26355      ACOM=(-1.0)
26356      ICOMLC='    '
26357      ICOML2='    '
26358      DO110I=1,100
26359        IHARG(I)='    '
26360        IHARG2(I)='    '
26361        IARGT(I)='NUMB'
26362        IARG(I)=(-1)
26363        ARG(I)=(-1.0)
26364        IHARLC(I)='    '
26365        IHARL2(I)='    '
26366  110 CONTINUE
26367      NUMARG=(-1)
26368C
26369C               **********************************************************
26370C               **  STEP 2--                                             *
26371C               **  SEPARATE IANSLC(.) INTO COMPONENTS WHERE A COMPONENT *
26372C               **  IS DEFINED AS THAT SEPARATED BY 1 OR MORE BLANKS     *
26373C               **  IN ADDITION, AN EQUAL SIGN (=),                      *
26374C               **  IN ADDITION, A COMMA (,), (2018/04)                  *
26375C
26376CCCCC --------------------------------------------------------------------
26377CCCCC THE FOLLOWING DEALING WITH > AND < WAS DEACTIVATED AUGUST 1990
26378CCCCC DUE TO FACT THAT > IS A DIRECTORY SEPARATOR FOR   AUGUST 1990
26379CCCCC CERTAIN COMPUTERS (E.G., HONEYWELL, PRIME).  AUGUST 1990
26380CCCCC AND     CALL DATAPLOT>DPSYSF.TEX    WAS BOMBING      AUGUST 1990
26381CCCCC WITH ARRAY OVERFLOW.                              AUGUST 1990
26382CCCCC THEREFORE--USER MUST MANUALLY MAKE SURE THAT > AND < AUGUST 1990
26383CCCCC            ARE SURROUNDED BY SPACES IN MATH COMMANDS.  AUGUST 1990
26384C
26385C               **  A GREATER-THAN SIGN (>), AND A LESS-THAN SIGN (<)    *
26386C               **  ARE ALSO CONSIDERED AS A COMPONENT UNTO ITSELF       *
26387C               **  REGARDLESS OF WHETHER OR NOT                         *
26388C               **  IT HAS PRECEEDING AND SUCCEEDING BLANKS.             *
26389CCCCC --------------------------------------------------------------------
26390C               **  FINALLY, A HYPHEN WHEN IMMEDIATELY PRECEDED          *
26391C               **  AND SUCCEEDED BY A NON-BLANK CHARACTER               *
26392C               **  WILL ALSO BE CONSIDERED AS A SEPARATOR               *
26393C               **  AND SO WILL NOT BE COPIED AS A CHARACTER.            *
26394C               **  HOWEVER, IF THERE IS A BLANK BEFORE OR AFTER THE     *
26395C               **  HYPEN (AS IN DEFINING THE    -    AS A PLOT CHARACTER*
26396C               **  TYPE), THEN THE HYPHEN WILL BE TREATED AND COPIED    *
26397C               **  AS A SEPARATE COMPONENT.                             *
26398C               **  OCTOBER 1997: CHECK FOR EXPONENTIAL NOTATION, I.E.   *
26399C               **      1.2E02, 1.2E-02, 1.2E+02, 1.2D02, 1.2D-02, 1.2D+02
26400C               **  TREAT THE CASE WHERE THE ORIGINAL LINE IANSLC(.) WAS NON-EMP
26401C               **  LOCATE THE START AND STOP COLUMNS FOR EACH 'WORD'.   *
26402C               **********************************************************
26403C
26404      ISTEPN='2'
26405      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26406C
26407      NUMWD=0
26408      DO300I=1,IWIDTH
26409        IM1=I-1
26410        IM2=I-2
26411        IP1=I+1
26412C
26413        IF(IEQUCL.EQ.'ON'.AND.IANSLC(I).EQ.'=')GOTO350
26414        IF(IHOST1.EQ.'HONE')THEN
26415          IF(IANSLC(I).EQ.'>')GOTO350
26416          IF(IANSLC(I).EQ.'<')GOTO350
26417        ENDIF
26418C       ADD "<>  " CASE
26419        IF(I.GT.1.AND.IANSLC(I).EQ.'>'.AND.IANSLC(I-1).EQ.'<')GOTO300
26420C
26421CCCCC   THE FOLLOWING LINE WAS COMMENTED OUT AUGUST 1990
26422CCCCC   DUE TO BOMB ON HONEYWELL/PRIME WHEN TRYING TO EXECUTE  AUGUST 1990
26423CCCCC   CALL DATAPLOT>DPSYSF.TEX   (> IS A DIRECTORY SYMBOL   AUGUST 1990
26424CCCCC   ON HONEYWELL AND PRIME)               AUGUST 1990
26425CCCCC   IF(IANSLC(I).EQ.'>')GOTO350
26426        IF(IANSLC(I).EQ.'<'.AND.IANSLC(I+1).EQ.'>')GOTO345
26427C
26428CCCCC   THE FOLLOWING LINE WAS COMMENTED OUT AUGUST 1990
26429CCCCC   TO PARALLEL THE COMMENTING OUT FOR    >   2 LINES ABOVE  AUGUST 1990
26430CCCCC   IF(IANSLC(I).EQ.'<')GOTO350
26431C
26432        IF(IANSLC(I).NE.' '.AND.I.LE.1)GOTO350
26433C
26434        IF(I.LE.1)GOTO360
26435        IF(IANSLC(I).NE.' '.AND.IANSLC(IM1).EQ.' ')GOTO350
26436        IF(IEQUCL.EQ.'ON'.AND.IANSLC(I).NE.' '.AND.
26437     1     IANSLC(IM1).EQ.'=')GOTO350
26438        IF(IHOST1.EQ.'HONE')THEN
26439          IF(IANSLC(I).NE.' '.AND.IANSLC(IM1).EQ.'>')GOTO350
26440          IF(IANSLC(I).NE.' '.AND.IANSLC(IM1).EQ.'<')GOTO350
26441        ENDIF
26442C
26443        IF(I.LE.2)GOTO360
26444C
26445CCCCC   OCTOBER 1997.  CHECK FOR EXPONENTIAL NOTATION,
26446CCCCC                  I.E., IF "-" IS PRECEDED BY AN "E" AND SUCCEDED
26447CCCCC                  BY ANUMBER.
26448C
26449        IF(IANSLC(IM1).EQ.'-')THEN
26450          IF(IANSLC(IM2).EQ.'E' .OR. IANSLC(IM2).EQ.'e')THEN
26451            CALL DPCOAN(IANSLC(I),IJUNK)
26452            IF(IJUNK.GE.48 .AND. IJUNK.LE.57)GOTO370
26453          ENDIF
26454        ENDIF
26455C
26456        IF(IHYPCL.EQ.'ON'.AND.IANSLC(I).NE.' '.AND.
26457     1     IANSLC(IM1).EQ.'-')GOTO340
26458        IF(ICOMCL.EQ.'ON'.AND.IANSLC(I).NE.' '.AND.
26459     1     IANSLC(IM1).EQ.',')GOTO340
26460        GOTO360
26461C
26462  340   CONTINUE
26463        IF(IEQUCL.EQ.'ON'.AND.IANSLC(IM2).EQ.'=')GOTO360
26464        IF(IHYPCL.EQ.'ON'.AND.IANSLC(IM2).EQ.'-')GOTO355
26465        IF(ICOMCL.EQ.'ON'.AND.IANSLC(IM2).EQ.',')GOTO355
26466        IF(IANSLC(IM2).NE.' ')GOTO350
26467        GOTO360
26468C
26469C  ADD "<>  " CASE
26470  345   CONTINUE
26471        NUMWD=NUMWD+1
26472        ISTART(NUMWD)=I
26473        ISTOP(NUMWD)=I+1
26474        GOTO390
26475C       END ADD
26476  350   CONTINUE
26477        NUMWD=NUMWD+1
26478C
26479  355   CONTINUE
26480        ISTART(NUMWD)=I
26481C
26482  360   CONTINUE
26483        IF(IEQUCL.EQ.'ON'.AND.IANSLC(I).EQ.'=')GOTO370
26484CCCCC   IF(IANSLC(I).EQ.'>')GOTO370
26485CCCCC   IF(IANSLC(I).EQ.'<')GOTO370
26486        IF(IANSLC(I).NE.' '.AND.I.GE.IWIDTH)GOTO370
26487C
26488        IF(I.GE.IWIDTH)GOTO390
26489        IF(IANSLC(I).NE.' '.AND.IANSLC(IP1).EQ.' ')GOTO370
26490        IF(IEQUCL.EQ.'ON'.AND.IANSLC(I).NE.' '.AND.
26491     1     IANSLC(IP1).EQ.'=')GOTO370
26492CCCCC   IF(IANSLC(I).NE.' '.AND.IANSLC(IP1).EQ.'>')GOTO370
26493CCCCC   IF(IANSLC(I).NE.' '.AND.IANSLC(IP1).EQ.'<')GOTO370
26494        IF(IHYPCL.EQ.'ON'.AND.IANSLC(I).NE.' '.AND.
26495     1     IANSLC(IP1).EQ.'-')GOTO370
26496        IF(ICOMCL.EQ.'ON'.AND.IANSLC(I).NE.' '.AND.
26497     1     IANSLC(IP1).EQ.',')GOTO370
26498C
26499        GOTO390
26500C
26501  370   CONTINUE
26502        ISTOP(NUMWD)=I
26503C
26504  390   CONTINUE
26505C
26506        IF(IBUGTY.EQ.'ON')THEN
26507          WRITE(ICOUT,391)NUMWD
26508  391     FORMAT('NUMWD = ',I8)
26509          CALL DPWRST('XXX','BUG ')
26510          IF(NUMWD.GE.1)THEN
26511            WRITE(ICOUT,392)I,NUMWD,ISTART(NUMWD),ISTOP(NUMWD)
26512  392       FORMAT('I,NUMWD,ISTART(NUMWD),ISTOP(NUMWD) = ',4I8)
26513            CALL DPWRST('XXX','BUG ')
26514          ENDIF
26515        ENDIF
26516C
26517  300 CONTINUE
26518      IF(NUMWD.LE.0)GOTO9000
26519C
26520C               ***********************************************************
26521C               **  STEP 3--                                             **
26522C               **  CONVERT THE FIRST STRING TO A COMMAND                **
26523C               **  EXTRACT THE FIRST 4 CHARACTERS OF                    **
26524C               **  THE COMMAND.  PACK THESE 4 CHARACTERS                **
26525C               **  INTO THE HOLLERITH VARIABLE ICOM.                    **
26526C               **  ONLY 4 CHARACTERS ARE RETAINED                       **
26527C               **  REGARDLESS OF THE MAX NUMBER OF                      **
26528C               **  CHARACTERS PER WORD ON A GIVEN                       **
26529C               **  COMPUTER (E.G., EVEN THOUGH UNIVAC                   **
26530C               **  COULD RETAIN 6 CHARACTERS PER WORD,                  **
26531C               **  IT IS SUFFICIENT              TO RETAIN              **
26532C               **  ONLY 4 CHARACTERS PER WORD--ON A UNIVAC              **
26533C               **  OR ANY OTHER COMPUTER.                               **
26534C               **  OR ANY OTHER COMPUTER.                               **
26535C               **  ALSO, IF THE NUMBER OF CHARACTERS                    **
26536C               **  IN THE FIRST WORD IS 5 OR MORE,                      **
26537C               **  THEN PACK CHARACTERS 5 THROUGH 8                     **
26538C               **  (OR CHARACTERS 5 THROUGH THE END OF THE WORD         **
26539C               **  IF THE END OF THE WORD IS BEFORE CHARACTER 8)        **
26540C               **  INTO THE 4-CHARACTER WORD ICOM2.                     **
26541C               ***********************************************************
26542C
26543      ISTEPN='3'
26544      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26545C
26546      IWORD=1
26547      IWID=ISTOP(IWORD)-ISTART(IWORD)+1
26548      JMIN=ISTART(IWORD)
26549      JMAX=ISTOP(IWORD)
26550      I=0
26551      DO800J=JMIN,JMAX
26552        I=I+1
26553        IB(I)=IANSLC(J)
26554  800 CONTINUE
26555C
26556      IANS1='    '
26557      IANS2='    '
26558      IMAX=2*NUMASC
26559      IF(IWID.LT.IMAX)IMAX=IWID
26560C
26561      IF(IBUGTY.EQ.'ON')THEN
26562        WRITE(ICOUT,901)IMAX
26563  901   FORMAT('IMAX = ',I6)
26564        CALL DPWRST('XXX','BUG ')
26565      ENDIF
26566C
26567      DO900I=1,IMAX
26568        IF(IB(I).EQ.' ')GOTO910
26569        IM4=I-4
26570        IF(I.LE.NUMASC)IANS1(I:I)=IB(I)
26571        IF(I.GT.NUMASC)IANS2(IM4:IM4)=IB(I)
26572  900 CONTINUE
26573  910 CONTINUE
26574      ICOMLC=IANS1
26575      ICOML2=IANS2
26576      CALL DPUPP4(ICOMLC,ICOM,IBUGTY,IERROR)
26577      CALL DPUPP4(ICOML2,ICOM2,IBUGTY,IERROR)
26578C
26579C               ********************************************
26580C               **  STEP 4--                              **
26581C               **  CONVERT STRINGS 2 THROUGH END         **
26582C               **  TO HOLLERITH A4 ARGUMENTS.            **
26583C               **  IF MORE THAN 8 CHARACTERS,            **
26584C               **  CONVERT ONLY THE FIRST 8 CHARACTERS   **
26585C               **  (REGARDLESS OF THE COMPUTER TYPE).    **
26586C               ********************************************
26587C
26588      ISTEPN='4'
26589      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26590C
26591      NUMARG=NUMWD-1
26592      IF(NUMWD.LE.1)GOTO1999
26593      DO1000IWORD=2,NUMWD
26594        IWID=ISTOP(IWORD)-ISTART(IWORD)+1
26595C
26596        JMIN=ISTART(IWORD)
26597        JMAX=ISTOP(IWORD)
26598        I=0
26599        DO1100J=JMIN,JMAX
26600          I=I+1
26601          IB(I)=IANSLC(J)
26602 1100   CONTINUE
26603C
26604        IANS1='    '
26605        IANS2='    '
26606        IMAX=2*NUMASC
26607        IF(IWID.LT.IMAX)IMAX=IWID
26608        DO1200I=1,IMAX
26609          IF(IB(I).EQ.' ')GOTO1210
26610          IM4=I-4
26611          IF(I.LE.NUMASC)IANS1(I:I)=IB(I)
26612          IF(I.GT.NUMASC)IANS2(IM4:IM4)=IB(I)
26613 1200   CONTINUE
26614 1210   CONTINUE
26615        IWORM1=IWORD-1
26616        IHARLC(IWORM1)=IANS1
26617        IHARL2(IWORM1)=IANS2
26618C
26619 1000 CONTINUE
26620 1999 CONTINUE
26621C
26622C               **********************************************************
26623C               **  STEP 4.5--                                          **
26624C               **  CONVERT EACH ARGUMENT TO UPPER CASE.                **
26625C               **********************************************************
26626C
26627      ISTEPN='4.5'
26628      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26629C
26630      IF(NUMARG.LE.0)GOTO1390
26631      DO1300I=1,NUMARG
26632        CALL DPUPP4(IHARLC(I),IHARG(I),IBUGTY,IERROR)
26633        CALL DPUPP4(IHARL2(I),IHARG2(I),IBUGTY,IERROR)
26634 1300 CONTINUE
26635 1390 CONTINUE
26636C
26637C               **********************************************************
26638C               **  STEP 5--                                            **
26639C               **  CONVERT STRINGS 1 THROUGH END TO INTEGER ARGUMENTS  **
26640C               **********************************************************
26641C
26642      ISTEPN='5'
26643      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26644C
26645      IF(NUMWD.LE.0)GOTO2999
26646      DO2000IWORD=1,NUMWD
26647        IWORM1=IWORD-1
26648C
26649        IF(IWORD.LE.1)THEN
26650          IH=ICOM
26651          IH2=ICOM2
26652        ELSE
26653          IH=IHARG(IWORM1)
26654          IH2=IHARG2(IWORM1)
26655        ENDIF
26656C
26657        IF(NUMNAM.LE.0)GOTO2040
26658        DO2010INAME=1,NUMNAM
26659          IF(IH.EQ.IHNAME(INAME).AND.IH2.EQ.IHNAM2(INAME))THEN
26660            IF(IUSE(INAME).EQ.'P')THEN
26661              IF(IWORM1.GT.0)IARGT(IWORM1)='NUMB'
26662              IF(IWORM1.GT.0)IARG(IWORM1)=IVALUE(INAME)
26663              GOTO2000
26664            ELSE
26665              GOTO2040
26666            ENDIF
26667          ENDIF
26668 2010   CONTINUE
26669 2040   CONTINUE
26670C
26671        IFLUNK='NO'
26672        IANS3=(-1)
26673        IWID=ISTOP(IWORD)-ISTART(IWORD)+1
26674        JMIN=ISTART(IWORD)
26675        JMAX=ISTOP(IWORD)
26676        I=0
26677        DO2100J=JMIN,JMAX
26678          I=I+1
26679          IB(I)=IANSLC(J)
26680 2100   CONTINUE
26681C
26682        IDIG=0
26683        ISIGN=0
26684        IDECP2=0
26685        ISUM=0
26686        DO2700I=1,IWID
26687          IREV=IWID-I+1
26688          IF(IB(IREV).EQ.' ')THEN
26689            GOTO2700
26690          ELSEIF(IB(IREV).EQ.'0')THEN
26691            ITERM=0
26692            GOTO2725
26693          ELSEIF(IB(IREV).EQ.'1')THEN
26694            ITERM=1
26695            GOTO2725
26696          ELSEIF(IB(IREV).EQ.'2')THEN
26697            ITERM=2
26698            GOTO2725
26699          ELSEIF(IB(IREV).EQ.'3')THEN
26700            ITERM=3
26701            GOTO2725
26702          ELSEIF(IB(IREV).EQ.'4')THEN
26703            ITERM=4
26704            GOTO2725
26705          ELSEIF(IB(IREV).EQ.'5')THEN
26706            ITERM=5
26707            GOTO2725
26708          ELSEIF(IB(IREV).EQ.'6')THEN
26709            ITERM=6
26710            GOTO2725
26711          ELSEIF(IB(IREV).EQ.'7')THEN
26712            ITERM=7
26713            GOTO2725
26714          ELSEIF(IB(IREV).EQ.'8')THEN
26715            ITERM=8
26716            GOTO2725
26717          ELSEIF(IB(IREV).EQ.'9')THEN
26718            ITERM=9
26719            GOTO2725
26720          ELSEIF(IB(IREV).EQ.'+')THEN
26721            ISIGN=ISIGN+1
26722            GOTO2700
26723          ELSEIF(IB(IREV).EQ.'-')THEN
26724            ISIGN=ISIGN+1
26725            ISUM=-ISUM
26726            GOTO2700
26727          ELSEIF(IB(IREV).EQ.'.')THEN
26728            IDECP2=IDECP2+1
26729            IF(IDECP2.EQ.1.AND.IDIG.EQ.0)GOTO2700
26730            GOTO2800
26731          ELSE
26732            IFLUNK='YES'
26733            GOTO2800
26734          ENDIF
26735C
26736 2725     CONTINUE
26737          IDIG=IDIG+1
26738          IF(IDIG.EQ.1)THEN
26739            ISUM=ISUM+ITERM
26740          ELSE
26741CCCCC       FOLLOWING FIXES WHAT APPEARS TO BE COMPILER BUG ON LAHEY 95
26742CCCCC       COMPILER.  MAY 2001
26743CCCCC       SPECIFICALLY, 10**IPOW SEEMS TO RETURN A 0.
26744CCCCC       ISUM=ISUM+ITERM*10**(IDIG-1)
26745            ITERM1=IDIG-1
26746            ITERM2=INT(10.0**ITERM1 + 0.01)
26747            ISUM=ISUM+ITERM*ITERM2
26748          ENDIF
26749C
26750 2700   CONTINUE
26751        IF(IDIG.LE.0)GOTO2800
26752        IF(ISIGN.GE.2)GOTO2800
26753        IANS3=ISUM
26754C
26755 2800   CONTINUE
26756        IWORM1=IWORD-1
26757        IF(IWORD.LE.1)ICOMI=IANS3
26758        IF(IWORD.GE.2)IARG(IWORM1)=IANS3
26759        IF(IWORD.LE.1.AND.IFLUNK.EQ.'YES')ICOMT='WORD'
26760        IF(IWORD.GE.2.AND.IFLUNK.EQ.'YES')IARGT(IWORM1)='WORD'
26761 2000 CONTINUE
26762 2999 CONTINUE
26763C
26764C               ***************************************************************
26765C               **  STEP 6--                                                 **
26766C               **  CONVERT STRINGS 2 THROUGH N TO FLOATING POINT ARGUMENTS  **
26767C               ***************************************************************
26768C
26769      ISTEPN='6'
26770      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26771C
26772C               ************************************************************
26773C               **  STEP 6.1--                                            **
26774C               **  FIRST OF ALL, LOCATE THE DECIMAL POINT (IF EXISTENT)  **
26775C               **  OCTOBER 1997.  CHECK FOR EXPONENTIAL NOTATION.   I.E. **
26776C               **  1.2E02, 1.2E-02, 1.2E+02                              **
26777C               ************************************************************
26778C
26779      ISTEPN='6.1'
26780      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26781C
26782CCCCC OCTOBER 1997.  FOR EXPONENTIAL NOTATION, NEED TO ALLOW LARGER NUMBERS
26783CCCCC AMIN=-1000000.
26784CCCCC AMAX=+1000000.
26785      AMIN=CPUMIN
26786      AMAX=CPUMAX
26787      NUMARG=NUMWD-1
26788CCCCC IF(NUMARG.LE.0)GOTO3999
26789      IF(NUMWD.LE.0)GOTO3999
26790      DO3000IWORD=1,NUMWD
26791C
26792        IWORM1=IWORD-1
26793        IF(IWORD.LE.1)THEN
26794          IH=ICOM
26795          IH2=ICOM2
26796        ELSE
26797          IH=IHARG(IWORM1)
26798          IH2=IHARG2(IWORM1)
26799        ENDIF
26800C
26801        IF(NUMNAM.LE.0)GOTO3040
26802        DO3010INAME=1,NUMNAM
26803          IF(IH.EQ.IHNAME(INAME).AND.IH2.EQ.IHNAM2(INAME))THEN
26804            IF(IUSE(INAME).EQ.'P')THEN
26805              IF(IWORD.LE.1)ICOMT='NUMB'
26806              IF(IWORD.GE.2)IARGT(IWORM1)='NUMB'
26807              IF(IWORD.LE.1)ACOM=VALUE(INAME)
26808              IF(IWORD.GE.2)ARG(IWORM1)=VALUE(INAME)
26809              GOTO3000
26810            ELSE
26811              GOTO3040
26812            ENDIF
26813          ENDIF
26814 3010   CONTINUE
26815 3040   CONTINUE
26816C
26817        IFLUNK='NO'
26818        ANS2=(-1.0)
26819        IWID=ISTOP(IWORD)-ISTART(IWORD)+1
26820        JMIN=ISTART(IWORD)
26821        JMAX=ISTOP(IWORD)
26822        I=0
26823        DO3050J=JMIN,JMAX
26824          I=I+1
26825          IB(I)=IANSLC(J)
26826 3050   CONTINUE
26827C
26828        ILOC=0
26829        IDECP2=0
26830        ILOCE=0
26831        IEXPPT=0
26832        DO3060I=1,IWID
26833          IF(IB(I).EQ.'.')ILOC=I
26834          IF(IB(I).EQ.'.')IDECP2=IDECP2+1
26835          IF(IB(I).EQ.'E'.OR.IB(I).EQ.'e')ILOCE=I
26836          IF(IB(I).EQ.'E'.OR.IB(I).EQ.'e')IEXPPT=IEXPPT+1
26837 3060   CONTINUE
26838        IF(IDECP2.GE.2)GOTO3900
26839        IF(IEXPPT.GE.2)GOTO3900
26840C
26841        IESCAL=0
26842        IESIGN=1
26843        IWID2=IWID
26844        IF(ILOCE+1.GT.IWID)THEN
26845          IFLUNK='YES'
26846          GOTO3900
26847        ENDIF
26848        IF(IEXPPT.EQ.1)THEN
26849          IWID=ILOCE-1
26850          IF(IB(ILOCE+1).EQ.'-')THEN
26851            IESIGN=-1
26852            ISTRT2=ILOCE+2
26853          ELSEIF(IB(ILOCE+1).EQ.'+')THEN
26854            IESIGN=1
26855            ISTRT2=ILOCE+2
26856          ELSE
26857            IESIGN=1
26858            ISTRT2=ILOCE+1
26859          ENDIF
26860          ICOUNT=0
26861          ICJUNK='        '
26862          IF(ISTRT2.GT.IWID2)THEN
26863            IFLUNK='YES'
26864            GOTO3900
26865          ENDIF
26866          DO13065I=ISTRT2,IWID2
26867            IF(IB(I).EQ.' ')GOTO13065
26868            IF(IB(I).EQ.'0')GOTO13060
26869            IF(IB(I).EQ.'1')GOTO13060
26870            IF(IB(I).EQ.'2')GOTO13060
26871            IF(IB(I).EQ.'3')GOTO13060
26872            IF(IB(I).EQ.'4')GOTO13060
26873            IF(IB(I).EQ.'5')GOTO13060
26874            IF(IB(I).EQ.'6')GOTO13060
26875            IF(IB(I).EQ.'7')GOTO13060
26876            IF(IB(I).EQ.'8')GOTO13060
26877            IF(IB(I).EQ.'9')GOTO13060
26878            IFLUNK='YES'
26879            GOTO3900
26880C
2688113060       CONTINUE
26882            ICOUNT=ICOUNT+1
26883            ICJUNK(ICOUNT:ICOUNT)=IB(I)(1:1)
26884C
2688513065     CONTINUE
26886CCCCC     FOLLOWING TO ADDRESS BUG ON SUN.  OCTOBER 2001.
26887          IFRMT(1:5)='(I  )'
26888          IF(ICOUNT.LE.9)THEN
26889            WRITE(IFRMT(3:3),'(I1)')ICOUNT
26890          ELSE
26891            WRITE(IFRMT(3:4),'(I2)')ICOUNT
26892          ENDIF
26893          READ(ICJUNK(1:ICOUNT),IFRMT)IESCAL
26894        ENDIF
26895C
26896        IF(IDECP2.EQ.1)GOTO3150
26897        DO3100I=1,IWID
26898          IREV=IWID-I+1
26899          IF(IB(IREV).EQ.' ')GOTO3100
26900          IF(IB(IREV).EQ.'0' .OR. IB(IREV).EQ.'1' .OR.
26901     1           IB(IREV).EQ.'2' .OR. IB(IREV).EQ.'3' .OR.
26902     1           IB(IREV).EQ.'4' .OR. IB(IREV).EQ.'5' .OR.
26903     1           IB(IREV).EQ.'6' .OR. IB(IREV).EQ.'7' .OR.
26904     1           IB(IREV).EQ.'8' .OR. IB(IREV).EQ.'9')THEN
26905            GOTO3110
26906          ENDIF
26907          IFLUNK='YES'
26908          IF(IB(IREV).EQ.'+')GOTO3900
26909          IF(IB(IREV).EQ.'-')GOTO3900
26910          GOTO3900
26911C
26912 3100   CONTINUE
26913        IFLUNK='YES'
26914        GOTO3900
26915C
26916 3110   ILOC=IREV+1
26917 3150   CONTINUE
26918C
26919        IF(IBUGTY.NE.'OFF')THEN
26920          WRITE(ICOUT,3111)ILOC,IDECP2
26921 3111     FORMAT('ILOC = ',I8,'    IDECP2 = ',I8)
26922          CALL DPWRST('XXX','BUG ')
26923        ENDIF
26924C
26925C               *******************************************************
26926C               **  STEP 6.2--                                       **
26927C               **  SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE  **
26928C               *******************************************************
26929C
26930        ISTEPN='6.2'
26931        IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
26932C
26933        SIGN=1.0
26934        IDIGI=0
26935        ISIGN=0
26936        SUMI=0
26937        ILOCM1=ILOC-1
26938        IF(ILOCM1.LT.1)GOTO3250
26939        DO3200I=1,ILOCM1
26940          IREV=ILOCM1-I+1
26941          IF(IB(IREV).EQ.' ')THEN
26942            GOTO3200
26943          ELSEIF(IB(IREV).EQ.'0')THEN
26944            ITERM=0
26945            GOTO3225
26946          ELSEIF(IB(IREV).EQ.'1')THEN
26947            ITERM=1
26948            GOTO3225
26949          ELSEIF(IB(IREV).EQ.'2')THEN
26950            ITERM=2
26951            GOTO3225
26952          ELSEIF(IB(IREV).EQ.'3')THEN
26953            ITERM=3
26954            GOTO3225
26955          ELSEIF(IB(IREV).EQ.'4')THEN
26956            ITERM=4
26957            GOTO3225
26958          ELSEIF(IB(IREV).EQ.'5')THEN
26959            ITERM=5
26960            GOTO3225
26961          ELSEIF(IB(IREV).EQ.'6')THEN
26962            ITERM=6
26963            GOTO3225
26964          ELSEIF(IB(IREV).EQ.'7')THEN
26965            ITERM=7
26966            GOTO3225
26967          ELSEIF(IB(IREV).EQ.'8')THEN
26968            ITERM=8
26969            GOTO3225
26970          ELSEIF(IB(IREV).EQ.'9')THEN
26971            ITERM=9
26972            GOTO3225
26973          ELSEIF(IB(IREV).EQ.'+')THEN
26974            ISIGN=ISIGN+1
26975            GOTO3200
26976          ELSEIF(IB(IREV).EQ.'-')THEN
26977            ISIGN=ISIGN+1
26978            SIGN=-SIGN
26979            GOTO3200
26980          ELSE
26981            IFLUNK='YES'
26982            GOTO3900
26983          ENDIF
26984C
26985 3225     CONTINUE
26986          IDIGI=IDIGI+1
26987          TERM=ITERM
26988          IEXP=IDIGI-1
26989          SUMI=SUMI+TERM*(10.0          **IEXP)
26990 3200   CONTINUE
26991 3250   CONTINUE
26992        IF(ISIGN.GE.2)GOTO3900
26993C
26994        IF(IBUGTY.NE.'OFF')THEN
26995          WRITE(ICOUT,3255)IDIGI,SUMI
26996 3255     FORMAT('IDIGI = ',I8,'    SUMI = ',F20.10)
26997          CALL DPWRST('XXX','BUG ')
26998        ENDIF
26999C
27000C               ******************************************************
27001C               **  STEP 6.3--                                      **
27002C               **  THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE  **
27003C               ******************************************************
27004C
27005        ISTEPN='6.3'
27006        IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
27007C
27008        IDIGD=0
27009        SUMD=0.0
27010        ILOCP1=ILOC+1
27011        IF(ILOCP1.GT.IWID)GOTO3350
27012        DO3300I=ILOCP1,IWID
27013          IF(IB(I).EQ.' ')THEN
27014            GOTO3300
27015          ELSEIF(IB(I).EQ.'0')THEN
27016            ITERM=0
27017            GOTO3325
27018          ELSEIF(IB(I).EQ.'1')THEN
27019            ITERM=1
27020            GOTO3325
27021          ELSEIF(IB(I).EQ.'2')THEN
27022            ITERM=2
27023            GOTO3325
27024          ELSEIF(IB(I).EQ.'3')THEN
27025            ITERM=3
27026            GOTO3325
27027          ELSEIF(IB(I).EQ.'4')THEN
27028            ITERM=4
27029            GOTO3325
27030          ELSEIF(IB(I).EQ.'5')THEN
27031            ITERM=5
27032            GOTO3325
27033          ELSEIF(IB(I).EQ.'6')THEN
27034            ITERM=6
27035            GOTO3325
27036          ELSEIF(IB(I).EQ.'7')THEN
27037            ITERM=7
27038            GOTO3325
27039          ELSEIF(IB(I).EQ.'8')THEN
27040            ITERM=8
27041            GOTO3325
27042          ELSEIF(IB(I).EQ.'9')THEN
27043            ITERM=9
27044            GOTO3325
27045          ELSE
27046            IFLUNK='YES'
27047            GOTO3900
27048          ENDIF
27049C
27050 3325     IDIGD=IDIGD+1
27051          TERM=ITERM
27052          SUMD=SUMD+TERM/(10.0**IDIGD)
27053C
27054 3300   CONTINUE
27055 3350   CONTINUE
27056C
27057        IF(IBUGTY.EQ.'ON')THEN
27058          WRITE(ICOUT,3355)IDIGD,SUMD
27059 3355     FORMAT('IDIGD = ',I8,'    SUMD = ',F20.10)
27060          CALL DPWRST('XXX','BUG ')
27061        ENDIF
27062C
27063        IDIGT=IDIGI+IDIGD
27064        IF(IDIGT.LE.0)GOTO3900
27065        ANS2=SUMI+SUMD
27066        IF(SIGN.LT.0.0)ANS2=-ANS2
27067        ANS2=ANS2*10.0**(IESIGN*IESCAL)
27068        IWORM1=IWORD-1
27069        IF(IWORD.LE.1)ACOM=ANS2
27070        IF(IWORD.GE.2)ARG(IWORM1)=ANS2
27071CCCC    OCTOBER 1997.  IF EXPONENTIAL NUMBER, NEED TO RESET IARGT
27072        IF(AMIN.LE.ANS2.AND.ANS2.LE.AMAX)THEN
27073          IF(IWORM1.GE.1)IARGT(IWORM1)='NUMB'
27074          GOTO3000
27075        ELSE
27076          GOTO3900
27077        ENDIF
27078C
27079 3900   CONTINUE
27080        IF(IWORM1.LT.1) GOTO 3000
27081        IWORM1=IWORD-1
27082        ARG(IWORM1)=ANS2
27083        IF(IFLUNK.EQ.'YES')IARGT(IWORM1)='WORD'
27084 3000 CONTINUE
27085 3999 CONTINUE
27086C
27087C               *****************
27088C               **  STEP 90--  **
27089C               **  EXIT       **
27090C               *****************
27091C
27092 9000 CONTINUE
27093      IF(IBUGTY.EQ.'ON')THEN
27094        WRITE(ICOUT,999)
27095        CALL DPWRST('XXX','BUG ')
27096        WRITE(ICOUT,9011)
27097 9011   FORMAT('***** AT THE END       OF DPTYPE--')
27098        CALL DPWRST('XXX','BUG ')
27099        WRITE(ICOUT,9012)ICOM,ICOM2,ICOMT,ACOM,ICOMI
27100 9012   FORMAT('ICOM,ICOM2,ICOMT,ACOM,ICOMI = ',
27101     1         2(A4,2X),A4,E15.7,I8)
27102        CALL DPWRST('XXX','BUG ')
27103        WRITE(ICOUT,9013)ICOMLC,ICOML2,NUMARG
27104 9013   FORMAT('ICOMLC,ICOML2,NUMARG = ',2(A4,2X),I8)
27105        CALL DPWRST('XXX','BUG ')
27106        DO9015I=1,NUMARG
27107          WRITE(ICOUT,9016)I,IHARG(I),IHARG2(I),IARG(I),ARG(I),IARGT(I)
27108 9016     FORMAT('I,IHARG(I),IHARG2(I),IARG(I),ARG(I),IARGT(I) = ',
27109     1           I6,2(1X,A4),1X,I6,1X,E15.7,1X,A4)
27110          CALL DPWRST('XXX','BUG ')
27111          WRITE(ICOUT,9017)I,IHARLC(I),IHARL2(I)
27112 9017     FORMAT('I,IHARLC(I),IHARL2(I) = ',I6,1X,A4,1X,A4)
27113          CALL DPWRST('XXX','BUG ')
27114 9015   CONTINUE
27115        WRITE(ICOUT,9021)IHOST1,IHOST2
27116 9021   FORMAT('IHOST1,IHOST2 = ',A4,2X,A4)
27117        CALL DPWRST('XXX','BUG ')
27118      ENDIF
27119C
27120      RETURN
27121      END
27122