1      SUBROUTINE DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
2C
3C     NOTE--THIS SUBROUTINE IS IDENTICAL TO THE DPSUB2 SUBROUTINE
4C           AND THE DPSUB3 SUBROUTINE
5C           AND HAS BEEN DUPLICATED TO THEM ONLY FOR ECONOMY OF MAPPING PURPOSES
6C           THAT IS, TO SAVE STORAGE IN THE MAPPING.
7C           FOR VIRTUAL OPERATING SYSTEMS, THIS DUPLICATION IS NEEDLESS.
8C           ANY CALLS TO SUBROUTINES DPSUB2 AND SPSUB3 COULD BE CHANGED
9C           TO CALLS TO DPSUBS.
10C
11C     PURPOSE--DEFINE AN INTEGER 0-1 VECTOR ISUB
12C              WHICH WILL BE USED IN OTHER SUBROUTINES
13C              FOR EXTRACTING SUBSETS.
14C     NOTE THAT IF THE WORDS   SUBSET   OR   EXCEPT   IS NOT
15C     IN THE ARGUMENT LIST,
16C     THEN THE OUTPUT PARAMETER WILL BE SET TO NUMARG+1.
17C     WRITTEN BY--JAMES J. FILLIBEN
18C                 STATISTICAL ENGINEERING DIVISION
19C                 INFORMATION TECHNOLOGY LABORATORY
20C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21C                 GAITHERSBURG, MD 20899-8980
22C                 PHONE--301-975-2899
23C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
25C     LANGUAGE--ANSI FORTRAN (1977)
26C     VERSION NUMBER--82/7
27C     ORIGINAL VERSION--JANUARY  1978.
28C     UPDATED         --JANUARY   1978.
29C     UPDATED         --FEBRUARY  1978.
30C     UPDATED         --MAY       1978.
31C     UPDATED         --OCTOBER   1978.
32C     UPDATED         --NOVEMBER  1978.
33C     UPDATED         --FEBRUARY  1979.
34C     UPDATED         --NOVEMBER  1980.
35C     UPDATED         --JANUARY   1981.
36C     UPDATED         --JULY      1981.
37C     UPDATED         --SEPTEMBER 1981.
38C     UPDATED         --DECEMBER  1981.
39C     UPDATED         --MARCH     1982.
40C     UPDATED         --MAY       1982.
41C     UPDATED         --MARCH     1988.  ALLOW    NOT EQUAL   <> >< NOT=
42C     UPDATED         --JANUARY   1989.  CHECK FOR EMPTY SUBSETS (ALAN)
43C
44C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
45C
46      CHARACTER*4 IBUGQ
47      CHARACTER*4 IERROR
48C
49      CHARACTER*4 ICASSC
50      CHARACTER*4 ICASQU
51      CHARACTER*4 ICASVA
52      CHARACTER*4 IHWUSE
53      CHARACTER*4 MESSAG
54      CHARACTER*4 ICASOP
55      CHARACTER*4 IHSET
56      CHARACTER*4 IHSET2
57      CHARACTER*4 IH
58      CHARACTER*4 IH2
59C
60      CHARACTER*4 ISUBN1
61      CHARACTER*4 ISUBN2
62      CHARACTER*4 ISTEPN
63C
64C-----COMMON----------------------------------------------------------
65C
66      INCLUDE 'DPCOPA.INC'
67      INCLUDE 'DPCOHK.INC'
68      INCLUDE 'DPCODA.INC'
69      INCLUDE 'DPCOP2.INC'
70C
71C-----START POINT-----------------------------------------------------
72C
73      ISUBN1='DPSU'
74      ISUBN2='BS  '
75      IERROR='NO'
76C
77      MAXCP1=MAXCOL+1
78      MAXCP2=MAXCOL+2
79      MAXCP3=MAXCOL+3
80      MAXCP4=MAXCOL+4
81      MAXCP5=MAXCOL+5
82      MAXCP6=MAXCOL+6
83      TARGET=0.0
84C
85C               ********************************
86C               **  TREAT THE SUBSET CASE     **
87C               ********************************
88C
89      IF(IBUGQ.EQ.'ON')THEN
90        WRITE(ICOUT,999)
91  999   FORMAT(1X)
92        CALL DPWRST('XXX','BUG ')
93        WRITE(ICOUT,51)
94   51   FORMAT('***** AT THE BEGINNING OF DPSUBS--')
95        CALL DPWRST('XXX','BUG ')
96        WRITE(ICOUT,52)NIOLD,ILOCS,NS
97   52   FORMAT('NIOLD,ILOCS,NS = ',3I8)
98        CALL DPWRST('XXX','BUG ')
99        WRITE(ICOUT,54)IBUGQ,IERROR
100   54   FORMAT('IBUGQ,IERROR = ',A4,2X,A4)
101        CALL DPWRST('XXX','BUG ')
102        WRITE(ICOUT,55)NUMARG,NUMNAM,MAXNAM,N,MAXN
103   55   FORMAT('NUMARG,NUMNAM,MAXNAM,N,MAXN = ',5I8)
104        CALL DPWRST('XXX','BUG ')
105        WRITE(ICOUT,56)IWIDTH,ILOCS,ILOCS2,ILOCTG
106   56   FORMAT('IWIDTH,ILOCS,ILOCS2,ILOCTG = ',4I8)
107        CALL DPWRST('XXX','BUG ')
108      ENDIF
109C
110C               ********************************************************
111C               **  STEP 1--                                          **
112C               **  INITIALIZE THE SUBSET SIZE (NS) TO NIOLD. CHECK   **
113C               **  FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  ALSO   **
114C               **  CHECK THAT THE RELEVANT NUMBER OF OBSERVATIONS    **
115C               **  (NIOLD) IS POSITIVE.                              **
116C               ********************************************************
117C
118      ISTEPN='1'
119      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
120C
121      NS=NIOLD
122      ILOCS=NUMARG+1
123      MINNA=0
124      MAXNA=100
125      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
126     1            IERROR)
127      IF(IERROR.EQ.'YES')GOTO9000
128C
129      IF(NIOLD.LT.1)THEN
130        WRITE(ICOUT,999)
131        CALL DPWRST('XXX','BUG ')
132        WRITE(ICOUT,111)
133  111   FORMAT('***** ERROR IN DPSUBS--')
134        CALL DPWRST('XXX','BUG ')
135        WRITE(ICOUT,112)
136  112   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS (FROM WHICH')
137        CALL DPWRST('XXX','BUG ')
138        WRITE(ICOUT,113)
139  113   FORMAT('      A SUBSET WAS TO HAVE BEEN EXTRACTED) IS 0.')
140        CALL DPWRST('XXX','BUG ')
141        IERROR='YES'
142        GOTO9000
143      ENDIF
144C
145C               ********************************************************
146C               **  STEP 2.1--                                        **
147C               **  INITIALIZE ALL ELEMENTS IN ISUB(.) TO 11          **
148C               **  ISUB(.) WILL TAKE ON 4 VALUES AT MOST--           **
149C               **  00, 01, 10, 11   .                                **
150C               **  THE FIRST  DIGIT INDICATES WHETHER OR NOT THE     **
151C               **  GIVEN ELEMENT IS OUT (0) OR IN (1) OF THE LOCAL   **
152C               **  CUMULATIVE UNION SET.                             **
153C               **  THE SECOND DIGIT INDICATES WHETHER OR NOT THE     **
154C               **  GIVEN ELEMENT IS OUT (0) OR IN (1) OF THE GLOBAL  **
155C               **  CUMULATIVE INTERSECTION SET.                      **
156C               **  THE INITIALIZATION OF ALL ELEMENTS TO 11 THUS     **
157C               **  INDICATES THAT INITIALLY ALL ELEMENTS (TEMPORARILY)*
158C               **  ARE IN THE LOCAL UNION SET, AND INITIALLY ALL     **
159C               **  ELEMENTS ARE IN THE GLOBAL INTERSECTION SET.      **
160C               ********************************************************
161C
162      ISTEPN='2.1'
163      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
164C
165      DO200I=1,NIOLD
166        ISUB(I)=11
167  200 CONTINUE
168C
169C               *************************************************
170C               **  STEP 2.2--                                 **
171C               **  IF EXISTENT,                               **
172C               **  PACK < = INTO <=                           **
173C               **  PACK = < INTO =<                           **
174C               **  PACK > = INTO >=                           **
175C               **  PACK = > INTO =>                           **
176C               **  THIS IS BECAUSE = SIGNS ARE AUTOMATICALLY  **
177C               **  GIVEN A SPACE IN DPTYPE AND TREATED AS     **
178C               **  AS A SEPARATE WORD.                        **
179C               **  NOTE THAT NUMARG WILL BE CHANGED.          **
180C               *************************************************
181C
182      ISTEPN='2.2'
183      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
184C
185      CALL ADJUS2(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
186C
187C               ************************************************
188C               **  STEP 3.1--                                **
189C               **  CHECK TO SEE IF HAVE THE  SUBSET  CASE.   **
190C               **  CHECK TO SEE IF HAVE THE  EXCEPT  CASE.   **
191C               **  LOCATE THE POSITION IN THE ARGUMENT LIST  **
192C               **  OF THE WORD   SUBSET   OR   EXCEPT  .     **
193C               ************************************************
194C
195      ISTEPN='3.1'
196      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
197C
198      JMAX=0
199      ICASSC='SEAR'
200      ICASQU='UNKN'
201      NUMSV=0
202      DO300IPASS=1,100
203C
204      IF(IBUGQ.EQ.'ON')THEN
205        WRITE(ICOUT,999)
206        CALL DPWRST('XXX','BUG ')
207        WRITE(ICOUT,301)
208  301   FORMAT('***** AT THE BEGINNING OF ANOTHER PASS--')
209        CALL DPWRST('XXX','BUG ')
210        WRITE(ICOUT,302)IPASS,ILOCTG
211  302   FORMAT('IPASS,ILOCTG = ',2I8)
212        CALL DPWRST('XXX','BUG ')
213        IF(ILOCTG.GE.1)THEN
214          WRITE(ICOUT,303)ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG)
215  303     FORMAT('ICASSC,ILOCTG,IHARG(ILOCTG),IHARG2(ILOCTG) = ',
216     1           A4,I8,2(2X,A4))
217          CALL DPWRST('XXX','BUG ')
218        ENDIF
219        WRITE(ICOUT,304)JMAX
220  304   FORMAT('JMAX= ',I8)
221        CALL DPWRST('XXX','BUG ')
222      ENDIF
223C
224      IF(ICASSC.EQ.'STOP')GOTO1100
225      JMIN=JMAX+1
226      IF(JMIN.GT.NUMARG)GOTO1100
227      IF(JMIN.EQ.NUMARG.AND.IHARG(JMIN).EQ.'AND '.AND.
228     1IHARG2(JMIN).EQ.'    ')GOTO1100
229C
230      IF(ICASSC.EQ.'CONT')GOTO600
231      DO310I=1,NIOLD
232        ITEMP=ISUB(I)
233        IF(ITEMP.EQ.00)ISUB(I)=00
234        IF(ITEMP.EQ.10)ISUB(I)=00
235        IF(ITEMP.EQ.01)ISUB(I)=00
236        IF(ITEMP.EQ.11)ISUB(I)=11
237  310 CONTINUE
238      ICASQU='UNKN'
239      DO340J=JMIN,NUMARG
240        J2=J
241        IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')THEN
242          ICASQU='SUBS'
243          ILOCS=J2
244CCCCC     THE FOLLOWING 6 LINES WERE INSERTED MARCH 1988.
245          ILOCS2=ILOCS+2
246          IHSET=IHARG(ILOCS2)
247          IHSET2=IHARG2(ILOCS2)
248          IF(IHSET.EQ.'<>  ')ICASQU='EXCE'
249          IF(IHSET.EQ.'><  ')ICASQU='EXCE'
250          IF(IHSET.EQ.'NOT=')ICASQU='EXCE'
251          GOTO390
252        ELSEIF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')THEN
253          ICASQU='EXCE'
254          ILOCS=J2
255          GOTO390
256        ENDIF
257  340 CONTINUE
258      ILOCS=NUMARG+1
259      GOTO1100
260C
261  390 CONTINUE
262C
263      IF(IBUGQ.EQ.'ON')THEN
264        WRITE(ICOUT,391)IPASS,ICASQU,ILOCS
265  391   FORMAT('IPASS,ICASQU,ILOCS = ',I8,2X,A4,I8)
266        CALL DPWRST('XXX','BUG ')
267      ENDIF
268C
269C               *******************************************
270C               **  STEP 3.2--                           **
271C               **  IF HAVE THE SUBSET CASE,             **
272C               **  INITIALIZE ISUB(.) TO 0X--00 OR 01.  **
273C               **  IF HAVE THE EXCEPT CASE,             **
274C               **  INITIALIZE ISUB(.) TO 1X--10 OR 11.  **
275C               *******************************************
276C
277      ISTEPN='3.2'
278      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
279C
280      IF(ICASQU.EQ.'SUBS')THEN
281        DO401I=1,NIOLD
282          ITEMP=ISUB(I)
283          IF(ITEMP.EQ.00)ISUB(I)=00
284          IF(ITEMP.EQ.10)ISUB(I)=00
285          IF(ITEMP.EQ.01)ISUB(I)=01
286          IF(ITEMP.EQ.11)ISUB(I)=01
287  401   CONTINUE
288      ELSE
289        DO406I=1,NIOLD
290          ITEMP=ISUB(I)
291          IF(ITEMP.EQ.00)ISUB(I)=10
292          IF(ITEMP.EQ.10)ISUB(I)=10
293          IF(ITEMP.EQ.01)ISUB(I)=11
294          IF(ITEMP.EQ.11)ISUB(I)=11
295  406   CONTINUE
296      ENDIF
297C
298C               ********************************************************
299C               **  STEP 4--                                          **
300C               **  CHECK VALIDITY OF FIRST ARGUMENT AFTER     SUBSET **
301C               **  OR    EXCEPT    .                                 **
302C               **  THIS SHOULD BE THE SUBSET VARIABLE                **
303C               **  OR THE DUMMY INDEX    I   .                       **
304C               ********************************************************
305C
306      ISTEPN='4'
307      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
308C
309      ICASVA='UNKN'
310      ILOCS1=ILOCS+1
311      JMAX=ILOCS1
312      IF(ILOCS1.GT.NUMARG)THEN
313        WRITE(ICOUT,999)
314        CALL DPWRST('XXX','BUG ')
315        WRITE(ICOUT,111)
316        CALL DPWRST('XXX','BUG ')
317        WRITE(ICOUT,412)
318  412   FORMAT('      THE WORD    SUBSET    OR    EXCEPT    WAS THE')
319        CALL DPWRST('XXX','BUG ')
320        WRITE(ICOUT,413)
321  413   FORMAT('      FINAL WORD ON THE COMMAND LINE.')
322        CALL DPWRST('XXX','BUG ')
323        WRITE(ICOUT,414)
324  414   FORMAT('      THE WORD    SUBSET  OR   EXCEPT   SHOULD HAVE')
325        CALL DPWRST('XXX','BUG ')
326        WRITE(ICOUT,415)
327  415   FORMAT('      BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN')
328        CALL DPWRST('XXX','BUG ')
329        WRITE(ICOUT,416)
330  416   FORMAT('           SUBSET X = 4')
331        CALL DPWRST('XXX','BUG ')
332        WRITE(ICOUT,417)
333  417   FORMAT('           SUBSET X = 4 7 9 15 22')
334        CALL DPWRST('XXX','BUG ')
335        WRITE(ICOUT,418)
336  418   FORMAT('           SUBSET X = 4 TO 10')
337        CALL DPWRST('XXX','BUG ')
338        WRITE(ICOUT,419)
339  419   FORMAT('           SUBSET X >= 7')
340        CALL DPWRST('XXX','BUG ')
341        WRITE(ICOUT,420)
342  420   FORMAT('           AND SO FORTH.')
343        CALL DPWRST('XXX','BUG ')
344        WRITE(ICOUT,421)
345  421   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
346        CALL DPWRST('XXX','BUG ')
347        IF(IWIDTH.GE.1)THEN
348          WRITE(ICOUT,422)(IANS(I),I=1,MIN(IWIDTH,100))
349  422     FORMAT('      ',100A1)
350          CALL DPWRST('XXX','BUG ')
351        ENDIF
352        IERROR='YES'
353        GOTO9000
354      ENDIF
355C
356      IHSET=IHARG(ILOCS1)
357      IHSET2=IHARG2(ILOCS1)
358C
359      IF(IHSET.EQ.'I   '.AND.IHSET2.EQ.'    ')THEN
360        ICASVA='I   '
361        IF(NUMNAM.LE.0)GOTO490
362        DO435I=1,NUMNAM
363          IF(IHNAME(I).EQ.IHSET.AND.IHNAM2(I).EQ.IHSET2.AND.
364     1       IUSE(I).EQ.'V   ')GOTO440
365  435   CONTINUE
366        GOTO490
367      ENDIF
368C
369  440 CONTINUE
370      ICASVA='V   '
371      IHWUSE='V'
372      MESSAG='YES'
373      CALL CHECKN(IHSET,IHSET2,IHWUSE,
374     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
375     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
376      IF(IERROR.EQ.'YES')GOTO9000
377      ISETV=IVALUE(ILOC)
378C
379      IF(IBUGQ.EQ.'ON')THEN
380        WRITE(ICOUT,451)ILOCS1,IHSET,IHSET2,ISETV
381  451   FORMAT('ILOCS1,IHSET,IHSET2,ISETV = ',I8,3X,2A4,3X,I8)
382        CALL DPWRST('XXX','BUG ')
383      ENDIF
384C
385      GOTO490
386C
387  490 CONTINUE
388      IF(IBUGQ.EQ.'ON')THEN
389        WRITE(ICOUT,491)IPASS,IHSET,IHSET2,ICASVA,ISETV
390  491   FORMAT('IPASS,IHSET,IHSET2,ICASVA,ISETV = ',I8,3(2X,A4),I8)
391        CALL DPWRST('XXX','BUG ')
392      ENDIF
393C
394C               *******************************************************
395C               **  STEP 5--                                         **
396C               **  CHECK TO SEE IF NEXT ARGUMENT IS                 **
397C               **        <                                          **
398C               **        <=                                         **
399C               **        =                                          **
400C               **        >=                                         **
401C               **        >                                          **
402C               **        <>   ><   NOT=                             **
403C               **  IF NONE OF THE ABOVE, THEN ASSUME  =   .         **
404C               *******************************************************
405C
406      ISTEPN='5'
407      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
408C
409      ICASOP='UNKN'
410      ILOCS2=ILOCS+2
411      JMAX=ILOCS2
412      IF(ILOCS2.GT.NUMARG)THEN
413        WRITE(ICOUT,999)
414        CALL DPWRST('XXX','BUG ')
415        WRITE(ICOUT,111)
416        CALL DPWRST('XXX','BUG ')
417        WRITE(ICOUT,502)
418  502   FORMAT('      THE SUBSET/EXCEPT VARIABLE NAME WAS THE')
419        CALL DPWRST('XXX','BUG ')
420        WRITE(ICOUT,503)
421  503   FORMAT('      FINAL WORD ON THE COMMAND LINE.')
422        CALL DPWRST('XXX','BUG ')
423        WRITE(ICOUT,504)
424  504   FORMAT('      THE SUBSET/EXCEPT VARIABLE NAME SHOULD HAVE')
425        CALL DPWRST('XXX','BUG ')
426        WRITE(ICOUT,505)
427  505   FORMAT('      BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN')
428        CALL DPWRST('XXX','BUG ')
429        WRITE(ICOUT,506)
430  506   FORMAT('           SUBSET X = 4')
431        CALL DPWRST('XXX','BUG ')
432        WRITE(ICOUT,507)
433  507   FORMAT('           SUBSET X = 4 7 9 15 22')
434        CALL DPWRST('XXX','BUG ')
435        WRITE(ICOUT,508)
436  508   FORMAT('           SUBSET X = 4 TO 10')
437        CALL DPWRST('XXX','BUG ')
438        WRITE(ICOUT,509)
439  509   FORMAT('           SUBSET X >= 7')
440        CALL DPWRST('XXX','BUG ')
441        WRITE(ICOUT,510)
442  510   FORMAT('           AND SO FORTH.')
443        CALL DPWRST('XXX','BUG ')
444        WRITE(ICOUT,521)
445  521   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
446        CALL DPWRST('XXX','BUG ')
447        IF(IWIDTH.GE.1)THEN
448          WRITE(ICOUT,422)(IANS(I),I=1,MIN(IWIDTH,100))
449          CALL DPWRST('XXX','BUG ')
450        ENDIF
451        IERROR='YES'
452        GOTO9000
453      ENDIF
454C
455      IHSET=IHARG(ILOCS2)
456      IHSET2=IHARG2(ILOCS2)
457C
458      IF(IHSET.EQ.'<   ')THEN
459        ICASOP='<   '
460        ILOCTG=ILOCS2
461      ELSEIF(IHSET.EQ.'<=  ' .OR. IHSET.EQ.'=<  ')THEN
462        ICASOP='<=  '
463        ILOCTG=ILOCS2
464      ELSEIF(IHSET.EQ.'=   ')THEN
465        ICASOP='=   '
466        ILOCTG=ILOCS2
467      ELSEIF(IHSET.EQ.'>=  ' .OR. IHSET.EQ.'=>  ')THEN
468        ICASOP='>=  '
469        ILOCTG=ILOCS2
470      ELSEIF(IHSET.EQ.'>   ')THEN
471        ICASOP='>   '
472        ILOCTG=ILOCS2
473      ELSEIF(IHSET.EQ.'<>  ' .OR. IHSET.EQ.'><  ' .OR.
474     1       IHSET.EQ.'NOT=')THEN
475        ICASOP='=   '
476        ILOCTG=ILOCS2
477      ELSE
478        ICASOP='=ASS'
479        ILOCTG=ILOCS2-1
480        GOTO590
481      ENDIF
482C
483  590 CONTINUE
484C
485      IF(IBUGQ.EQ.'ON')THEN
486        WRITE(ICOUT,591)IPASS,IHSET,IHSET2,ICASVA,ICASOP
487  591   FORMAT('IPASS,IHSET,IHSET2,ICASVA,ICASOP = ',
488     1         I8,4(2X,A4))
489        CALL DPWRST('XXX','BUG ')
490      ENDIF
491C
492C               ********************************************************
493C               **  STEP 6--                                          **
494C               **  DETERMINE THE LOWER LIMIT OF THE INTERVAL OF      **
495C               **  INTEREST.  THIS IS DONE BY CHECKING THE FIRST     **
496C               **  (NEXT) ARGUMENT IN THE LIST.                      **
497C               **  ALSO, FOR THOSE 4 CASES IN WHICH                  **
498C               **  ICASOP IS   <   <=   >=   >                       **
499C               **  DETERMINE THE UPPER LIMIT OF THE INTERVAL OF      **
500C               **  INTEREST.                                         **
501C               ********************************************************
502C
503  600 CONTINUE
504C
505      ISTEPN='6'
506      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
507C
508      IF(IBUGQ.EQ.'ON')THEN
509        WRITE(ICOUT,601)
510  601   FORMAT('     AT THE BEGINNING OF STEP 6 IN DPSUBS--')
511        CALL DPWRST('XXX','BUG ')
512        DO605I=1,NIOLD
513          WRITE(ICOUT,606)I,ISUB(I)
514  606     FORMAT('I,ISUB(I) = ',I8,I8)
515          CALL DPWRST('XXX','BUG ')
516  605   CONTINUE
517      ENDIF
518C
519      ILOCTG=ILOCTG+1
520      JMAX=ILOCTG
521      IF(ILOCTG.GT.NUMARG)THEN
522C
523        WRITE(ICOUT,999)
524        CALL DPWRST('XXX','BUG ')
525        WRITE(ICOUT,111)
526        CALL DPWRST('XXX','BUG ')
527        WRITE(ICOUT,612)
528  612   FORMAT('      THE SUBSET/EXCEPT OPERATION   <   <=  =  >=  >')
529        CALL DPWRST('XXX','BUG ')
530        WRITE(ICOUT,613)
531  613   FORMAT('      WAS THE FINAL WORD ON THE COMMAND LINE.')
532        CALL DPWRST('XXX','BUG ')
533        WRITE(ICOUT,614)
534  614   FORMAT('      THE SUBSET/EXCEPT VARIABLE NAME SHOULD HAVE')
535        CALL DPWRST('XXX','BUG ')
536        WRITE(ICOUT,615)
537  615   FORMAT('      BEEN FOLLOWED BY OTHER ARGUMENTS, AS IN')
538        CALL DPWRST('XXX','BUG ')
539        WRITE(ICOUT,506)
540        CALL DPWRST('XXX','BUG ')
541        WRITE(ICOUT,507)
542        CALL DPWRST('XXX','BUG ')
543        WRITE(ICOUT,508)
544        CALL DPWRST('XXX','BUG ')
545        WRITE(ICOUT,509)
546        CALL DPWRST('XXX','BUG ')
547        WRITE(ICOUT,510)
548        CALL DPWRST('XXX','BUG ')
549        WRITE(ICOUT,521)
550        CALL DPWRST('XXX','BUG ')
551        IF(IWIDTH.GE.1)THEN
552          WRITE(ICOUT,422)(IANS(I),I=1,MIN(IWIDTH,100))
553          CALL DPWRST('XXX','BUG ')
554        ENDIF
555        IERROR='YES'
556        GOTO9000
557      ENDIF
558C
559      IF(IARGT(ILOCTG).EQ.'NUMB')THEN
560        DMIN=ARG(ILOCTG)
561        DMAX=ARG(ILOCTG)
562        IF(ICASOP.EQ.'<   ')THEN
563          DMIN=CPUMIN
564          DMAX=ARG(ILOCTG)
565        ELSEIF(ICASOP.EQ.'<=  ')THEN
566          DMIN=CPUMIN
567          DMAX=ARG(ILOCTG)
568        ELSEIF(ICASOP.EQ.'>=  ')THEN
569          DMIN=ARG(ILOCTG)
570          DMAX=CPUMAX
571        ELSEIF(ICASOP.EQ.'>   ')THEN
572          DMIN=ARG(ILOCTG)
573          DMAX=CPUMAX
574        ENDIF
575      ELSEIF(IARGT(ILOCTG).EQ.'WORD')THEN
576        IH=IHARG(ILOCTG)
577        IH2=IHARG2(ILOCTG)
578        IHWUSE='P'
579        MESSAG='YES'
580        CALL CHECKN(IH,IH2,IHWUSE,
581     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
582     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
583        IF(IERROR.EQ.'YES')GOTO9000
584        DMIN=VALUE(ILOC)
585        DMAX=VALUE(ILOC)
586        IF(ICASOP.EQ.'<   ')THEN
587          DMIN=CPUMIN
588          DMAX=VALUE(ILOC)
589        ELSEIF(ICASOP.EQ.'<=  ')THEN
590          DMIN=CPUMIN
591          DMAX=VALUE(ILOC)
592        ELSEIF(ICASOP.EQ.'>=  ')THEN
593          DMIN=VALUE(ILOC)
594          DMAX=CPUMAX
595        ELSEIF(ICASOP.EQ.'>   ')THEN
596          DMIN=VALUE(ILOC)
597          DMAX=CPUMAX
598        ENDIF
599      ELSE
600        WRITE(ICOUT,999)
601        CALL DPWRST('XXX','BUG ')
602        WRITE(ICOUT,111)
603        CALL DPWRST('XXX','BUG ')
604        WRITE(ICOUT,632)
605  632   FORMAT('      AN ARGUMENT TYPE WHICH SHOULD BE ')
606        CALL DPWRST('XXX','BUG ')
607        WRITE(ICOUT,633)
608  633   FORMAT('      EITHER A NUMBER OR A WORD, IS NEITHER.')
609        CALL DPWRST('XXX','BUG ')
610        WRITE(ICOUT,634)IHARG(ILOCTG),IHARG2(ILOCTG)
611  634   FORMAT('      ARGUMENT                  = ',2A4)
612        CALL DPWRST('XXX','BUG ')
613        WRITE(ICOUT,635)ILOCTG
614  635   FORMAT('      LOCATION IN ARGUMENT LIST = ',I8)
615        CALL DPWRST('XXX','BUG ')
616        WRITE(ICOUT,636)IARGT(ILOCTG)
617  636   FORMAT('      ARGUMENT TYPE             = ',A4)
618        CALL DPWRST('XXX','BUG ')
619        WRITE(ICOUT,521)
620        CALL DPWRST('XXX','BUG ')
621        IF(IWIDTH.GE.1)THEN
622          WRITE(ICOUT,422)(IANS(I),I=1,MIN(IWIDTH,100))
623          CALL DPWRST('XXX','BUG ')
624        ENDIF
625        IERROR='YES'
626        GOTO9000
627      ENDIF
628C
629      IF(IBUGQ.EQ.'ON')THEN
630        WRITE(ICOUT,691)IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX
631  691   FORMAT('IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX = ',
632     1         I8,4(2X,A4),2G15.7)
633        CALL DPWRST('XXX','BUG ')
634      ENDIF
635C
636C               ********************************************************
637C               **  STEP 7--                                          **
638C               **  DETERMINE THE UPPER LIMIT OF THE INTERVAL OF      **
639C               **  INTEREST.  NOTE THAT FOR THOSE 4 CASES IN WHICH   **
640C               **  ICASOP IS   <   <=   >=   >                       **
641C               **  THE UPPER LIMIT OF THE INTERVAL                   **
642C               **  HAS ALREADY BEEN DETERMINED AND SO                **
643C               **  ALL OF THE CODE OF THIS SECTION MAY BE SKIPPED.   **
644C               **  ON THE OTHER HAND WHEN THE OPERATION IS    =   ,  **
645C               **  (EXPLICITLY OR ASSUMED),                          **
646C               **  THE UPPER LIMIT MUST BE DETERMINED.               **
647C               **  THIS IS DONE BY CHECKING THE NEXT ARGUMENT        **
648C               **  IN THE LIST.                                      **
649C               **  IF THIS NEXT ARGUMENT IS    TO   ,   THIS         **
650C               **  IMPLIES THAT AN UPPER LIMIT WILL BE PROVIDED      **
651C               **  (IN THE ARGUMENT AFTER THE   TO   ).              **
652C               **  HOWEVER, IF THE NEXT ARGUMENT IS NOT A    TO   ,  **
653C               **  THEN THIS IMPLIES THAT THE LIST CONSISTS          **
654C               **  OF INDIVIDUAL ELEMENTS OF THE SUBSET              **
655C               **  AND SO THE UPPER LIMIT WILL BE IDENTICAL          **
656C               **  TO THE LOWER LIMIT.                               **
657C               ********************************************************
658C
659      ISTEPN='7'
660      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
661C
662      IF(ICASOP.EQ.'<   ' .OR. ICASOP.EQ.'<=  ' .OR.
663     1   ICASOP.EQ.'>=  ' .OR. ICASOP.EQ.'>   ')THEN
664        ICASSC='SEAR'
665        GOTO790
666      ENDIF
667C
668      ILOCTG=ILOCTG+1
669C
670      IF(ILOCTG.GT.NUMARG)GOTO710
671      IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND.
672     1IHARG2(ILOCTG).EQ.'    ')GOTO710
673      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND.
674     1IHARG2(ILOCTG).EQ.'ET  ')GOTO720
675      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND.
676     1IHARG2(ILOCTG).EQ.'PT  ')GOTO720
677      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO  '.AND.
678     1IHARG2(ILOCTG).EQ.'    ')GOTO750
679      GOTO730
680C
681  710 CONTINUE
682      ILOCTG=ILOCTG-1
683      JMAX=ILOCTG
684      ICASSC='STOP'
685      DMAX=DMIN
686      GOTO790
687C
688  720 CONTINUE
689      ILOCTG=ILOCTG-1
690      JMAX=ILOCTG
691      ICASSC='SEAR'
692      DMAX=DMIN
693      GOTO790
694C
695  730 CONTINUE
696      ILOCTG=ILOCTG-1
697      JMAX=ILOCTG
698      ICASSC='CONT'
699      DMAX=DMIN
700      GOTO790
701C
702  750 CONTINUE
703      ILOCTG=ILOCTG+1
704      JMAX=ILOCTG
705      IF(ILOCTG.GT.NUMARG)GOTO760
706      IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND.
707     1IHARG2(ILOCTG).EQ.'    ')GOTO760
708      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND.
709     1IHARG2(ILOCTG).EQ.'ET  ')GOTO760
710      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND.
711     1IHARG2(ILOCTG).EQ.'PT  ')GOTO760
712      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'TO  '.AND.
713     1IHARG2(ILOCTG).EQ.'    ')GOTO760
714      GOTO770
715C
716  760 CONTINUE
717      WRITE(ICOUT,999)
718      CALL DPWRST('XXX','BUG ')
719      WRITE(ICOUT,111)
720      CALL DPWRST('XXX','BUG ')
721      WRITE(ICOUT,762)
722  762 FORMAT('      THE WORD    TO    SHOULD HAVE')
723      CALL DPWRST('XXX','BUG ')
724      WRITE(ICOUT,763)
725  763 FORMAT('      BEEN FOLLOWED BY A NUMBER OR')
726      CALL DPWRST('XXX','BUG ')
727      WRITE(ICOUT,764)
728  764 FORMAT('      BY A PARAMETER NAME, BUT WAS NOT.')
729      CALL DPWRST('XXX','BUG ')
730      WRITE(ICOUT,765)IHARG(ILOCTG),IHARG2(ILOCTG)
731  765 FORMAT('      TO    WAS FOLLOWED BY THE WORD   ',A4,A4)
732      CALL DPWRST('XXX','BUG ')
733      WRITE(ICOUT,521)
734      CALL DPWRST('XXX','BUG ')
735      IF(IWIDTH.GE.1)THEN
736        WRITE(ICOUT,422)(IANS(I),I=1,MIN(IWIDTH,100))
737        CALL DPWRST('XXX','BUG ')
738      ENDIF
739      IERROR='YES'
740      GOTO9000
741C
742  770 CONTINUE
743      IF(IARGT(ILOCTG).EQ.'NUMB')THEN
744        DMAX=ARG(ILOCTG)
745      ELSEIF(IARGT(ILOCTG).EQ.'WORD')THEN
746        IH=IHARG(ILOCTG)
747        IH2=IHARG2(ILOCTG)
748        IHWUSE='P'
749        MESSAG='YES'
750        CALL CHECKN(IH,IH2,IHWUSE,
751     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
752     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
753        IF(IERROR.EQ.'YES')GOTO9000
754        DMAX=VALUE(ILOC)
755      ELSE
756        IBRAN=770
757        WRITE(ICOUT,771)IBRAN
758  771   FORMAT('***** INTERNAL ERROR IN DPSUBS--',
759     1         'IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ',I8)
760        CALL DPWRST('XXX','BUG ')
761        WRITE(ICOUT,772)ILOCTG,IARGT(ILOCTG)
762  772   FORMAT('ILOCTG, IARGT(ILOCTG) = ',I8,2X,A4)
763        CALL DPWRST('XXX','BUG ')
764        IERROR='YES'
765        GOTO9000
766      ENDIF
767C
768      ILOCTG=ILOCTG+1
769      ICASSC='CONT'
770      IF(ILOCTG.GT.NUMARG)ICASSC='STOP'
771      IF(ILOCTG.EQ.NUMARG.AND.IHARG(ILOCTG).EQ.'AND '.AND.
772     1IHARG2(ILOCTG).EQ.'    ')ICASSC='STOP'
773      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'SUBS'.AND.
774     1IHARG2(ILOCTG).EQ.'ET  ')ICASSC='SEAR'
775      IF(ILOCTG.LE.NUMARG.AND.IHARG(ILOCTG).EQ.'EXCE'.AND.
776     1IHARG2(ILOCTG).EQ.'PT  ')ICASSC='SEAR'
777      ILOCTG=ILOCTG-1
778      JMAX=ILOCTG
779C
780  790 CONTINUE
781C
782      IF(IBUGQ.EQ.'ON')THEN
783        WRITE(ICOUT,791)IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX
784  791   FORMAT('IPASS,ICASVA,ICASOP,IH,IH2,DMIN,DMAX = ',
785     1         I8,4(2X,A4),2G15.7)
786        CALL DPWRST('XXX','BUG ')
787      ENDIF
788C
789C               ***************************************************
790C               **  STEP 8--                                     **
791C               **  TO ALLOW FOR ROUNDOFF ERRORS IN THE          **
792C               **  STORAGE OF NUMBERS,                          **
793C               **  JUDICIOUSLY EXPAND THE INTERVAL OF INTEREST  **
794C               **  BY AN    EPSILON    AMOUNT.                  **
795C               ***************************************************
796C
797      ISTEPN='8'
798C
799      IF(IBUGQ.EQ.'ON')THEN
800        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
801        WRITE(ICOUT,801)
802  801   FORMAT('      AT THE BEGINNING OF STEP 8--')
803        CALL DPWRST('XXX','BUG ')
804        WRITE(ICOUT,802)DMIN,DMAX
805  802   FORMAT('DMIN,DMAX = ',2E15.7)
806        CALL DPWRST('XXX','BUG ')
807      ENDIF
808C
809      IF(DMIN.LE.DMAX)GOTO809
810      HOLD=DMIN
811      DMIN=DMAX
812      DMAX=HOLD
813  809 CONTINUE
814C
815      IF(DMIN.EQ.CPUMIN)GOTO819
816      IF(DMIN.EQ.CPUMAX)GOTO819
817      IF(ABS(DMIN).EQ.0.0)EPS=0.000001
818      IF(ABS(DMIN).NE.0.0)EPS=ABS(DMIN*0.000001)
819      IF(ICASOP.EQ.'=   ')DMIN=DMIN-EPS
820      IF(ICASOP.EQ.'=ASS')DMIN=DMIN-EPS
821      IF(ICASOP.EQ.'<   ')DMIN=DMIN-EPS
822      IF(ICASOP.EQ.'<=  ')DMIN=DMIN-EPS
823      IF(ICASOP.EQ.'>=  ')DMIN=DMIN-EPS
824      IF(ICASOP.EQ.'>   ')DMIN=DMIN+EPS
825  819 CONTINUE
826C
827      IF(DMAX.EQ.CPUMAX)GOTO829
828      IF(DMAX.EQ.CPUMIN)GOTO829
829      IF(ABS(DMAX).EQ.0.0)EPS=0.000001
830      IF(ABS(DMAX).NE.0.0)EPS=ABS(DMAX*0.000001)
831      IF(ICASOP.EQ.'=   ')DMAX=DMAX+EPS
832      IF(ICASOP.EQ.'=ASS')DMAX=DMAX+EPS
833      IF(ICASOP.EQ.'<   ')DMAX=DMAX-EPS
834      IF(ICASOP.EQ.'<=  ')DMAX=DMAX+EPS
835      IF(ICASOP.EQ.'>=  ')DMAX=DMAX+EPS
836      IF(ICASOP.EQ.'>   ')DMAX=DMAX+EPS
837  829 CONTINUE
838C
839      IF(IBUGQ.EQ.'ON')THEN
840        WRITE(ICOUT,891)IPASS,ICASVA,ICASOP,IH,IH2
841  891   FORMAT('IPASS,ICASVA,ICASOP,IH,IH2 = ',I8,4(2X,A4))
842        CALL DPWRST('XXX','BUG ')
843        WRITE(ICOUT,892)EPS,DMIN,DMAX,CPUMIN,CPUMAX
844  892   FORMAT('EPS,DMIN,DMAX,CPUMIN,CPUMAX = ',5E15.7)
845        CALL DPWRST('XXX','BUG ')
846      ENDIF
847C
848C               ****************************************************
849C               **  STEP 9--                                      **
850C               **  DEFINE THE ISUB(.) VECTOR--                   **
851C               **  FOR ANY K (K = 1 TO NIOLD),                  **
852C               **  IF THE K-TH ELEMENT OF THE                    **
853C               **  SUBSET SPECIFICATION VARIABLE                 **
854C               **  (THE VARIABLE SPECIFIED AFTER    SUBSET   **
855C               **  IN THE COMMAND LINE)                          **
856C               **  IS WITHIN THE SPECIFIED (DMIN,DMAX) LIMITS,   **
857C               **  THEN ISUB(K) SHOULD RESULT IN A VALUE OF 1;   **
858C               **  BUT IF THE K-TH ELEMENT OF THE                **
859C               **  SUBSET SPECIFICATION VARIABLE                 **
860C               **  IS OUTSIDE THE SPECIFIED (DMIN,DMAX) LIMITS,  **
861C               **  THEN ISUB(K) SHOULD RESULT IN A 0 .           **
862C               ****************************************************
863C
864      ISTEPN='9'
865      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
866C
867      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,901)ILOCS1,IHSET,IHSET2,ICASVA,ISETV,
868     1MAXCOL
869  901 FORMAT('ILOCS1,IHSET,IHSET2,ICASVA,ISETV,MAXCOL = ',
870     1I8,2X,A4,2X,A4,2X,A4,I8,I8)
871      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
872C
873      IF(ICASVA.EQ.'UNKN')GOTO910
874      IF(ICASVA.EQ.'I   ')GOTO930
875      IF(ISETV.LE.MAXCOL)GOTO940
876      IF(ISETV.EQ.MAXCP1)GOTO950
877CCCCC IF(ISETV.EQ.MAXCP2)GOTO960
878      IF(ISETV.EQ.MAXCP2)GOTO950
879      IF(ISETV.EQ.MAXCP3)GOTO950
880      IF(ISETV.EQ.MAXCP4)GOTO950
881      IF(ISETV.EQ.MAXCP5)GOTO950
882      IF(ISETV.EQ.MAXCP6)GOTO950
883C
884  910 CONTINUE
885      WRITE(ICOUT,999)
886      CALL DPWRST('XXX','BUG ')
887      WRITE(ICOUT,911)
888  911 FORMAT('***** INTERNAL ERROR IN DPSUBS--')
889      CALL DPWRST('XXX','BUG ')
890      WRITE(ICOUT,912)
891  912 FORMAT('      IMPROPER VALUE FOR ICASVA AND/OR ISETV')
892      CALL DPWRST('XXX','BUG ')
893      WRITE(ICOUT,913)ICASVA,ISETV,MAXCOL,MAXCP1,MAXCP2
894  913 FORMAT('      ICASVA,ISETV,MAXCOL,MAXCP1,MAXCP2 = ',A4,4I8)
895      CALL DPWRST('XXX','BUG ')
896      IERROR='YES'
897      GOTO9000
898C
899  930 CONTINUE
900      NS=0
901      ND=0
902      DO931I=1,NIOLD
903      TARGET=I
904      IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX)
905     1GOTO932
906      IF(ICASQU.EQ.'SUBS')GOTO933
907      IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX)
908     1GOTO934
909      IF(ICASQU.EQ.'EXCE')GOTO935
910      GOTO931
911  932 CONTINUE
912      ITEMP=ISUB(I)
913      IF(ITEMP.EQ.00)ISUB(I)=10
914      IF(ITEMP.EQ.10)ISUB(I)=10
915      IF(ITEMP.EQ.01)ISUB(I)=11
916      IF(ITEMP.EQ.11)ISUB(I)=11
917      NS=NS+1
918      GOTO931
919  933 CONTINUE
920      ND=ND+1
921      GOTO931
922  934 CONTINUE
923      ITEMP=ISUB(I)
924      IF(ITEMP.EQ.00)ISUB(I)=00
925      IF(ITEMP.EQ.10)ISUB(I)=00
926      IF(ITEMP.EQ.01)ISUB(I)=01
927      IF(ITEMP.EQ.11)ISUB(I)=01
928      ND=ND+1
929      GOTO931
930  935 CONTINUE
931      NS=NS+1
932      GOTO931
933  931 CONTINUE
934      GOTO990
935C
936  940 CONTINUE
937      NS=0
938      ND=0
939      DO941I=1,NIOLD
940      IJ=MAXN*(ISETV-1)+I
941      VIJ=V(IJ)
942      IF(IBUGQ.EQ.'ON')WRITE(9,947)I,NIOLD,ISETV,DMIN,DMAX,VIJ
943  947 FORMAT('I,NIOLD,ISETV,DMIN,DMAX,VIJ = ',
944     13I8,3E12.4)
945      TARGET=VIJ
946      IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX)
947     1GOTO942
948      IF(ICASQU.EQ.'SUBS')GOTO943
949      IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX)
950     1GOTO944
951      IF(ICASQU.EQ.'EXCE')GOTO945
952      GOTO941
953  942 CONTINUE
954      ITEMP=ISUB(I)
955      IF(ITEMP.EQ.00)ISUB(I)=10
956      IF(ITEMP.EQ.10)ISUB(I)=10
957      IF(ITEMP.EQ.01)ISUB(I)=11
958      IF(ITEMP.EQ.11)ISUB(I)=11
959      NS=NS+1
960      GOTO941
961  943 CONTINUE
962      ND=ND+1
963      GOTO941
964  944 CONTINUE
965      ITEMP=ISUB(I)
966      IF(ITEMP.EQ.00)ISUB(I)=00
967      IF(ITEMP.EQ.10)ISUB(I)=00
968      IF(ITEMP.EQ.01)ISUB(I)=01
969      IF(ITEMP.EQ.11)ISUB(I)=01
970      ND=ND+1
971      GOTO941
972  945 CONTINUE
973      NS=NS+1
974      GOTO941
975  941 CONTINUE
976      GOTO990
977C
978  950 CONTINUE
979      NS=0
980      ND=0
981      DO951I=1,NIOLD
982CCCCC TARGET=PRED(I)
983      IF(ISETV.EQ.MAXCP1)TARGET=PRED(I)
984      IF(ISETV.EQ.MAXCP2)TARGET=RES(I)
985      IF(ISETV.EQ.MAXCP3)TARGET=YPLOT(I)
986      IF(ISETV.EQ.MAXCP4)TARGET=XPLOT(I)
987      IF(ISETV.EQ.MAXCP5)TARGET=X2PLOT(I)
988      IF(ISETV.EQ.MAXCP6)TARGET=TAGPLO(I)
989      IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX)
990     1GOTO952
991      IF(ICASQU.EQ.'SUBS')GOTO953
992      IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX)
993     1GOTO954
994      IF(ICASQU.EQ.'EXCE')GOTO955
995      GOTO951
996  952 CONTINUE
997      ITEMP=ISUB(I)
998      IF(ITEMP.EQ.00)ISUB(I)=10
999      IF(ITEMP.EQ.10)ISUB(I)=10
1000      IF(ITEMP.EQ.01)ISUB(I)=11
1001      IF(ITEMP.EQ.11)ISUB(I)=11
1002      NS=NS+1
1003      GOTO951
1004  953 CONTINUE
1005      ND=ND+1
1006      GOTO951
1007  954 CONTINUE
1008      ITEMP=ISUB(I)
1009      IF(ITEMP.EQ.00)ISUB(I)=00
1010      IF(ITEMP.EQ.10)ISUB(I)=00
1011      IF(ITEMP.EQ.01)ISUB(I)=01
1012      IF(ITEMP.EQ.11)ISUB(I)=01
1013      ND=ND+1
1014      GOTO951
1015  955 CONTINUE
1016      NS=NS+1
1017      GOTO951
1018  951 CONTINUE
1019      GOTO990
1020C
1021CC960 CONTINUE
1022CCCCC NS=0
1023CCCCC ND=0
1024CCCCC DO961I=1,NIOLD
1025CCCCC TARGET=RES(I)
1026CCCCC IF(ICASQU.EQ.'SUBS'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX)
1027CCCCC1GOTO962
1028CCCCC IF(ICASQU.EQ.'SUBS')GOTO963
1029CCCCC IF(ICASQU.EQ.'EXCE'.AND.DMIN.LE.TARGET.AND.TARGET.LE.DMAX)
1030CCCCC1GOTO964
1031CCCCC IF(ICASQU.EQ.'EXCE')GOTO965
1032CCCCC GOTO961
1033CC962 CONTINUE
1034CCCCC ITEMP=ISUB(I)
1035CCCCC IF(ITEMP.EQ.00)ISUB(I)=10
1036CCCCC IF(ITEMP.EQ.10)ISUB(I)=10
1037CCCCC IF(ITEMP.EQ.01)ISUB(I)=11
1038CCCCC IF(ITEMP.EQ.11)ISUB(I)=11
1039CCCCC NS=NS+1
1040CCCCC GOTO961
1041CC963 CONTINUE
1042CCCCC ND=ND+1
1043CCCCC GOTO961
1044CC964 CONTINUE
1045CCCCC ITEMP=ISUB(I)
1046CCCCC IF(ITEMP.EQ.00)ISUB(I)=00
1047CCCCC IF(ITEMP.EQ.10)ISUB(I)=00
1048CCCCC IF(ITEMP.EQ.01)ISUB(I)=01
1049CCCCC IF(ITEMP.EQ.11)ISUB(I)=01
1050CCCCC ND=ND+1
1051CCCCC GOTO961
1052CC965 CONTINUE
1053CCCCC NS=NS+1
1054CCCCC GOTO961
1055CC961 CONTINUE
1056CCCCC GOTO990
1057C
1058  990 CONTINUE
1059      IF(IBUGQ.EQ.'ON')WRITE(ICOUT,991)IPASS,ICASQU,DMIN,DMAX,EPS,
1060     1NIOLD,NS,ND
1061  991 FORMAT('IPASS,ICASQU,DMIN,DMAX,EPS,NIOLD,NS,ND = ',
1062     1I8,2X,A4,3E15.7,3I8)
1063      IF(IBUGQ.EQ.'ON')CALL DPWRST('XXX','BUG ')
1064      IF(IBUGQ.EQ.'OFF')GOTO994
1065      DO992I=1,NIOLD
1066      WRITE(ICOUT,993)I,ISUB(I)
1067  993 FORMAT('I,ISUB(I) = ',I8,I8)
1068      CALL DPWRST('XXX','BUG ')
1069  992 CONTINUE
1070  994 CONTINUE
1071C
1072C               *************************************************
1073C               **  STEP 10--                                  **
1074C               **  WRITE OUT A MESSAGE FOR THIS STEP          **
1075C               **  INDICATING                                 **
1076C               **  THE SUBSET VARIABLE NAME,                  **
1077C               **  THE SUBSET MINIMUM,                        **
1078C               **  THE SUBSET MAXIMUM,                        **
1079C               **  THE INPUT NUMBER OF OBSERVATIONS (LOCAL),  **
1080C               **  THE NUMBER OF OBSERVATIONS IGNORED         **
1081C               **  AND THE OUTPUT NUMBER OF OBSERVATIONS      **
1082C               **  (THAT IS, THE SUBSET SAMPLE SIZE).         **
1083C               **  ALSO, CHECK THAT NS IS POSITIVE.           **
1084C               *************************************************
1085C
1086      ISTEPN='10'
1087      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1088C
1089      IF(ICASQU.EQ.'EXCE')GOTO1020
1090      GOTO1010
1091C
1092 1010 CONTINUE
1093      IF(IFEEDB.EQ.'OFF')GOTO1019
1094      WRITE(ICOUT,999)
1095      CALL DPWRST('XXX','BUG ')
1096      WRITE(ICOUT,1011)
1097 1011 FORMAT('***** NOTE--')
1098      CALL DPWRST('XXX','BUG ')
1099      WRITE(ICOUT,1012)IHARG(ILOCS1),IHARG2(ILOCS1)
1100 1012 FORMAT('      SUBSET VARIABLE = ',2A4)
1101      CALL DPWRST('XXX','BUG ')
1102      WRITE(ICOUT,1013)DMIN
1103 1013 FORMAT('      SUBSET MINIMUM  = ',E17.10)
1104      CALL DPWRST('XXX','BUG ')
1105      WRITE(ICOUT,1014)DMAX
1106 1014 FORMAT('      SUBSET MAXIMUM  = ',E17.10)
1107      CALL DPWRST('XXX','BUG ')
1108      WRITE(ICOUT,1015)NIOLD
1109 1015 FORMAT('      INPUT  NUMBER OF OBSERVATIONS  = ',I8)
1110      CALL DPWRST('XXX','BUG ')
1111      WRITE(ICOUT,1016)ND
1112 1016 FORMAT('      NUMBER OF OBSERVATIONS IGNORED = ',I8)
1113      CALL DPWRST('XXX','BUG ')
1114      WRITE(ICOUT,1017)NS
1115 1017 FORMAT('      OUTPUT NUMBER OF OBSERVATIONS  = ',I8)
1116      CALL DPWRST('XXX','BUG ')
1117 1019 CONTINUE
1118      GOTO1050
1119C
1120 1020 CONTINUE
1121      IF(IFEEDB.EQ.'OFF')GOTO1029
1122      WRITE(ICOUT,999)
1123      CALL DPWRST('XXX','BUG ')
1124      WRITE(ICOUT,1021)
1125 1021 FORMAT('***** NOTE--')
1126      CALL DPWRST('XXX','BUG ')
1127      WRITE(ICOUT,1022)IHARG(ILOCS1),IHARG2(ILOCS1)
1128 1022 FORMAT('      EXCEPTED SUBSET VARIABLE = ',2A4)
1129      CALL DPWRST('XXX','BUG ')
1130      WRITE(ICOUT,1023)DMIN
1131 1023 FORMAT('      EXCEPTED SUBSET MINIMUM  = ',E17.10)
1132      CALL DPWRST('XXX','BUG ')
1133      WRITE(ICOUT,1024)DMAX
1134 1024 FORMAT('      EXCEPTED SUBSET MAXIMUM  = ',E17.10)
1135      CALL DPWRST('XXX','BUG ')
1136      WRITE(ICOUT,1025)NIOLD
1137 1025 FORMAT('      INPUT  NUMBER OF OBSERVATIONS  = ',I8)
1138      CALL DPWRST('XXX','BUG ')
1139      WRITE(ICOUT,1026)ND
1140 1026 FORMAT('      NUMBER OF OBSERVATIONS IGNORED = ',I8)
1141      CALL DPWRST('XXX','BUG ')
1142      WRITE(ICOUT,1027)NS
1143 1027 FORMAT('      OUTPUT NUMBER OF OBSERVATIONS  = ',I8)
1144      CALL DPWRST('XXX','BUG ')
1145 1029 CONTINUE
1146      GOTO1050
1147C
1148 1050 CONTINUE
1149CCCCC IF(NS.GE.1)GOTO1059
1150CCCCC WRITE(ICOUT,999)
1151CCCCC CALL DPWRST('XXX','BUG ')
1152CCCCC WRITE(ICOUT,1051)
1153C1051 FORMAT('***** ERROR IN DPSUBS--')
1154CCCCC CALL DPWRST('XXX','BUG ')
1155CCCCC WRITE(ICOUT,1052)
1156C1052 FORMAT('      THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.')
1157CCCCC CALL DPWRST('XXX','BUG ')
1158CCCCC IERROR='YES'
1159CCCCC GOTO9000
1160C1059 CONTINUE
1161C
1162      NUMSV=IPASS
1163C
1164  300 CONTINUE
1165C
1166 1100 CONTINUE
1167      DO1110I=1,NIOLD
1168        ITEMP=ISUB(I)
1169        IF(ITEMP.EQ.00)ISUB(I)=00
1170        IF(ITEMP.EQ.10)ISUB(I)=00
1171        IF(ITEMP.EQ.01)ISUB(I)=00
1172        IF(ITEMP.EQ.11)ISUB(I)=11
1173 1110 CONTINUE
1174C
1175C               *************************************
1176C               **  STEP 11--                      **
1177C               **  PUT ISUB(.) IN FINAL 0,1 FORM  **
1178C               *************************************
1179C
1180      ISTEPN='11'
1181      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1182C
1183      DO1210I=1,NIOLD
1184        ITEMP=ISUB(I)
1185        IF(ITEMP.EQ.00)ISUB(I)=0
1186        IF(ITEMP.EQ.10)ISUB(I)=0
1187        IF(ITEMP.EQ.01)ISUB(I)=1
1188        IF(ITEMP.EQ.11)ISUB(I)=1
1189 1210 CONTINUE
1190C
1191C               *****************************************
1192C               **  STEP 12--                          **
1193C               **  IF THERE WERE 2 OR MORE SUBSET     **
1194C               **  VARIABLES, GATHER INFORMATION      **
1195C               **  FOR A FINAL SUMMARY MESSAGE BY     **
1196C               **  DETERMINING THE FINAL NUMBER OF    **
1197C               **  ELEMENTS IN THE SUBSET             **
1198C               **  (AFTER ALL VARIABLES HAVE          **
1199C               **  BEEN INDIVIDUALLY ACCOUNTED FOR).  **
1200C               *****************************************
1201C
1202      ISTEPN='12'
1203      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1204C
1205      IF(NUMSV.GT.1)THEN
1206        NS=0
1207        DO1510I=1,NIOLD
1208          IF(ISUB(I).EQ.1)NS=NS+1
1209 1510   CONTINUE
1210      ENDIF
1211C
1212C               *************************************************
1213C               **  STEP 13--                                  **
1214C               **  IF THERE WERE 2 OR MORE SUBSET VARIABLES,  **
1215C               **  WRITE OUT A FINAL MESSAGE                  **
1216C               **  SUMMARIZING FOR ALL VARIABLES              **
1217C               **  THE NUMBER OF SUBSET VARIABLES             **
1218C               **  THE INPUT NUMBER OF OBSERVATIONS (LOCAL),  **
1219C               **  THE NUMBER OF OBSERVATIONS IGNORED         **
1220C               **  AND THE OUTPUT NUMBER OF OBSERVATIONS      **
1221C               **  (THAT IS, THE SUBSET SAMPLE SIZE).         **
1222C               **  ALSO, CHECK THAT NS IS POSITIVE.           **
1223C               *************************************************
1224C
1225      ISTEPN='13'
1226      IF(IBUGQ.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1227C
1228      IF(NUMSV.LE.1)GOTO1690
1229      ND=NIOLD-NS
1230C
1231      IF(IFEEDB.EQ.'ON')THEN
1232        WRITE(ICOUT,999)
1233        CALL DPWRST('XXX','BUG ')
1234        WRITE(ICOUT,1601)
1235 1601   FORMAT('***** SUBSET/EXCEPT SUMMARY--')
1236        CALL DPWRST('XXX','BUG ')
1237        WRITE(ICOUT,1602)NUMSV
1238 1602   FORMAT('      NUMBER OF SPECIFICATIONS       = ',I8)
1239        CALL DPWRST('XXX','BUG ')
1240        WRITE(ICOUT,1605)NIOLD
1241 1605   FORMAT('      INPUT  NUMBER OF OBSERVATIONS  = ',I8)
1242        CALL DPWRST('XXX','BUG ')
1243        WRITE(ICOUT,1606)ND
1244 1606   FORMAT('      NUMBER OF OBSERVATIONS IGNORED = ',I8)
1245        CALL DPWRST('XXX','BUG ')
1246        WRITE(ICOUT,1607)NS
1247 1607   FORMAT('      OUTPUT NUMBER OF OBSERVATIONS  = ',I8)
1248        CALL DPWRST('XXX','BUG ')
1249      ENDIF
1250C
1251      IF(NS.GE.1)GOTO1690
1252C
1253C     AUGUST, 1987: FOR EMPTY SUBSETS, DO NO PRINT ERROR MESSAGE
1254C                   UNLESS FEEDBACK SWITCH IS ON
1255C
1256C     SEPTEMBER 2018: DO NOT TREAT AN EMPTY SUBSET AS AN ERROR
1257C
1258CCCCC IF(IFEEDB.EQ.'ON')THEN
1259CCCCC   WRITE(ICOUT,999)
1260CCCCC   CALL DPWRST('XXX','BUG ')
1261CCCCC   WRITE(ICOUT,1611)
1262C1611   FORMAT('***** ERROR IN DPSUBS--')
1263CCCCC   CALL DPWRST('XXX','BUG ')
1264CCCCC   WRITE(ICOUT,1612)
1265C1612   FORMAT('      THE SUBSET IS EMPTY--IT HAS NO ELEMENTS IN IT.')
1266CCCCC   CALL DPWRST('XXX','BUG ')
1267CCCCC   IERROR='YES'
1268CCCCC   GOTO9000
1269CCCCC ENDIF
1270C
1271 1690 CONTINUE
1272C
1273C               *****************
1274C               **  STEP 90--  **
1275C               **  EXIT.      **
1276C               *****************
1277C
1278 9000 CONTINUE
1279      IF(IBUGQ.EQ.'ON')THEN
1280        WRITE(ICOUT,999)
1281        CALL DPWRST('XXX','BUG ')
1282        WRITE(ICOUT,9011)
1283 9011   FORMAT('***** AT THE END       OF DPSUBS--')
1284        CALL DPWRST('XXX','BUG ')
1285        WRITE(ICOUT,9014)IERROR,NUMSV,ND
1286 9014   FORMAT('IERROR,NUMSV,ND = ',A4,2X,2I8)
1287        CALL DPWRST('XXX','BUG ')
1288        WRITE(ICOUT,9018)ICASQU,ICASVA,ICASOP,ICASSC
1289 9018   FORMAT('ICASQU,ICASVA,ICASOP,ICASSC = ',3(A4,2X),A4)
1290        CALL DPWRST('XXX','BUG ')
1291        DO9020I=1,NIOLD
1292          WRITE(ICOUT,9021)I,ISUB(I)
1293 9021     FORMAT('I,ISUB(I) = ',2I8)
1294          CALL DPWRST('XXX','BUG ')
1295 9020   CONTINUE
1296      ENDIF
1297C
1298      RETURN
1299      END
1300      SUBROUTINE DPSUM2(Y,W,N,XTEMP1,XTEMP2,XTEMP3,
1301     1                  DTEMP1,MAXNXT,
1302     1                  ICAPSW,ICAPTY,IFORSW,ICASAN,
1303     1                  PID,IVARID,IVARI2,NREPL,
1304     1                  ISUBRO,IBUGA3,IERROR)
1305C
1306C     PURPOSE--THIS ROUTINE GENERATES A SUMMARY
1307C              OF THE DATA IN THE INPUT VECTOR Y.
1308C     NOTE--ASSUMPTION--MODEL IS   RESPONSE = CONSTANT + ERROR.
1309C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
1310C                                OF EQUALLY-SPACED OBSERVATIONS
1311C                                TO BE SMOOTHED.
1312C                       N      = THE INTEGER NUMBER OF
1313C                                OBSERVATIONS IN THE VECTOR Y.
1314C     WRITTEN BY--JAMES J. FILLIBEN
1315C                 STATISTICAL ENGINEERING DIVISION
1316C                 INFORMATION TECHNOLOGY LABORATORY
1317C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1318C                 GAITHERSBURG, MD 20899-8980
1319C                 PHONE--301-975-2899
1320C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1321C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1322C     LANGUAGE--ANSI FORTRAN (1977)
1323C     VERSION NUMBER--82/7
1324C     ORIGINAL VERSION--JULY      1981.
1325C     UPDATED         --NOVEMBER  1981.
1326C     UPDATED         --FEBRUARY  1982.
1327C     UPDATED         --MAY       1982.
1328C     UPDATED         --OCTOBER   2002.  SUPPORT FOR HTML OUTPUT
1329C                                        (ADD ICAPSW, ICAPTY TO CALL
1330C                                        LIST)
1331C     UPDATED         --OCTOBER   2003.  SUPPORT FOR LATEX OUTPUT
1332C     UPDATED         --MAY       2011.  SUPPORT FOR REPLICATION AND
1333C                                        MULTIPLE RESPONSE
1334C     UPDATED         --MAY       2011.  USE DPDTA1 AND DPDT5B TO PRINT
1335C                                        THE TABLES
1336C     UPDATED         --JUNE      2016.  CALL LIST TO NORPPC
1337C
1338C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1339C
1340      CHARACTER*4 IVARID(*)
1341      CHARACTER*4 IVARI2(*)
1342C
1343      CHARACTER*4 ICAPSW
1344      CHARACTER*4 ICAPTY
1345      CHARACTER*4 IFORSW
1346      CHARACTER*4 ICASAN
1347C
1348      CHARACTER*4 IBUGA3
1349      CHARACTER*4 ISUBRO
1350      CHARACTER*4 IERROR
1351      CHARACTER*4 IWRITE
1352      CHARACTER*20 IDIST
1353      CHARACTER*4 ISUBN1
1354      CHARACTER*4 ISUBN2
1355      CHARACTER*4 ISTEPN
1356      CHARACTER*4 IGEPDF
1357      CHARACTER*4 ICASE
1358C
1359C---------------------------------------------------------------------
1360C
1361      DIMENSION Y(*)
1362      DIMENSION W(*)
1363      DIMENSION XTEMP1(*)
1364      DIMENSION XTEMP2(*)
1365      DIMENSION XTEMP3(*)
1366      DIMENSION PID(*)
1367C
1368      DOUBLE PRECISION DTEMP1(*)
1369C
1370      PARAMETER(NUMCLI=5)
1371      PARAMETER(MAXLIN=1)
1372      PARAMETER (MAXROW=10)
1373      PARAMETER (MAXRO2=10)
1374      CHARACTER*60 ITITLE
1375      CHARACTER*60 ITITLZ
1376      CHARACTER*60 ITITL9
1377      CHARACTER*60 ITEXT(MAXRO2)
1378      CHARACTER*4  ALIGN(NUMCLI)
1379      CHARACTER*4  VALIGN(NUMCLI)
1380      REAL         AVALUE(MAXRO2)
1381      INTEGER      NCTEXT(MAXRO2)
1382      INTEGER      IDIGIT(MAXRO2)
1383      INTEGER      IDIGI2(MAXROW,NUMCLI)
1384      INTEGER      NTOT(MAXRO2)
1385      INTEGER      ROWSEP(MAXROW)
1386      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
1387      CHARACTER*21 IVALUE(MAXROW,NUMCLI)
1388      CHARACTER*4  ITYPCO(NUMCLI)
1389      INTEGER      NCTIT2(MAXLIN,NUMCLI)
1390      INTEGER      NCVALU(MAXROW,NUMCLI)
1391      INTEGER      NCOLSP(MAXLIN,NUMCLI)
1392      INTEGER      IWHTML(NUMCLI)
1393      INTEGER      IWRTF(NUMCLI)
1394      REAL         AMAT(MAXROW,NUMCLI)
1395      LOGICAL IFRST
1396      LOGICAL ILAST
1397      LOGICAL IFLAGS
1398      LOGICAL IFLAGE
1399C
1400C-----COMMON----------------------------------------------------------
1401C
1402      INCLUDE 'DPCOP2.INC'
1403C
1404C-----START POINT-----------------------------------------------------
1405C
1406      ISUBN1='DPSU'
1407      ISUBN2='M2  '
1408      IERROR='NO'
1409      IWRITE='OFF'
1410C
1411      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'SUM2')THEN
1412        WRITE(ICOUT,999)
1413  999   FORMAT(1X)
1414        CALL DPWRST('XXX','BUG ')
1415        WRITE(ICOUT,51)
1416   51   FORMAT('**** AT THE BEGINNING OF DPSUM2--')
1417        CALL DPWRST('XXX','BUG ')
1418        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASAN,N,MAXNXT
1419   52   FORMAT('IBUGA3,ISUBRO,ICASAN,N,MAXNXT = ',3(A4,2X),2I8)
1420        CALL DPWRST('XXX','BUG ')
1421        DO56I=1,N
1422          WRITE(ICOUT,57)I,Y(I),W(I)
1423   57     FORMAT('I,Y(I),W(I) = ',I8,2G15.7)
1424          CALL DPWRST('XXX','BUG ')
1425   56   CONTINUE
1426      ENDIF
1427C
1428C               ********************************************
1429C               **  STEP 1--                              **
1430C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
1431C               ********************************************
1432C
1433      ISTEPN='1'
1434      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SUM2')
1435     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1436C
1437      IF(N.LT.2)THEN
1438        WRITE(ICOUT,999)
1439        CALL DPWRST('XXX','BUG ')
1440        WRITE(ICOUT,111)
1441  111   FORMAT('***** ERROR IN SUMMARY--')
1442        CALL DPWRST('XXX','BUG ')
1443        WRITE(ICOUT,112)
1444  112   FORMAT('      THE NUMBER OF OBSERVATIONS IN THE RESPONSE ',
1445     1         'VARIABLE IS LESS THAN TWO.')
1446        CALL DPWRST('XXX','BUG ')
1447        WRITE(ICOUT,113)N
1448  113   FORMAT('SAMPLE SIZE = ',I8)
1449        CALL DPWRST('XXX','BUG ')
1450        IERROR='YES'
1451        GOTO9000
1452      ENDIF
1453C
1454      HOLD=Y(1)
1455      DO135I=2,N
1456      IF(Y(I).NE.HOLD)GOTO139
1457  135 CONTINUE
1458      WRITE(ICOUT,999)
1459      CALL DPWRST('XXX','BUG ')
1460      WRITE(ICOUT,111)
1461      CALL DPWRST('XXX','BUG ')
1462      WRITE(ICOUT,131)HOLD
1463  131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
1464      CALL DPWRST('XXX','BUG ')
1465      GOTO9000
1466  139 CONTINUE
1467C
1468C               **********************************************
1469C               **  STEP 3--                                **
1470C               **  COMPUTE VARIOUS MEASURES OF LOCATION--  **
1471C               **     1) MIDRANGE                          **
1472C               **     2) MEAN                              **
1473C               **     3) MIDMEAN                           **
1474C               **     4) MEDIAN                            **
1475C               **********************************************
1476C
1477      ISTEPN='3'
1478      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SUM2')
1479     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1480C
1481      CALL MIDRAN(Y,N,IWRITE,YMIDR,IBUGA3,IERROR)
1482      CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
1483      CALL MIDMEA(Y,N,IWRITE,XTEMP1,MAXNXT,YMIDM,IBUGA3,IERROR)
1484      CALL MEDIAN(Y,N,IWRITE,XTEMP1,MAXNXT,YMED,IBUGA3,IERROR)
1485C
1486C               **********************************************
1487C               **  STEP 4--                                **
1488C               **  COMPUTE VARIOUS MEASURES OF DISPERSION  **
1489C               **     1) RANGE                             **
1490C               **     2) STANDARD DEVIATION                **
1491C               **     3) AVERAGE ABSOLUTE DEVIATION        **
1492C               **     4) MINIMUM                           **
1493C               **     5) LOWER QUARTILE                    **
1494C               **     6) LOWER HINGE                       **
1495C               **     7) UPPER HINGE                       **
1496C               **     8) UPPER QUARTILE                    **
1497C               **     9) MAXIMUM                           **
1498C               **********************************************
1499C
1500      ISTEPN='4'
1501      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SUM2')
1502     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1503C
1504      CALL RANGDP(Y,N,IWRITE,YRANGE,IBUGA3,IERROR)
1505      CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
1506      ICASE='MEAN'
1507      CALL AAD(Y,N,IWRITE,XTEMP1,MAXNXT,YAAD,ICASE,IBUGA3,IERROR)
1508      CALL MINIM(Y,N,IWRITE,YMIN,IBUGA3,IERROR)
1509      CALL LOWQUA(Y,N,IWRITE,XTEMP1,MAXNXT,YLOWQ,IBUGA3,IERROR)
1510      CALL LOWHIN(Y,N,IWRITE,XTEMP1,MAXNXT,YLOWH,IBUGA3,IERROR)
1511      CALL UPPHIN(Y,N,IWRITE,XTEMP1,MAXNXT,YUPPH,IBUGA3,IERROR)
1512      CALL UPPQUA(Y,N,IWRITE,XTEMP1,MAXNXT,YUPPQ,IBUGA3,IERROR)
1513      CALL MAXIM(Y,N,IWRITE,YMAX,IBUGA3,IERROR)
1514C
1515C               ********************************************************
1516C               **  STEP 5--                                          **
1517C               **  COMPUTE VARIOUS DISTRIBUTIONAL MEASURES--         **
1518C               **     1) STANDARDIZED THIRD CENTRAL MOMENT           **
1519C               **     2) STANDARDIZED FOURTH CENTRAL MOMENT          **
1520C               **     3) STANDARDIZED WILK-SHAPIRO STATISTIC         **
1521C               **     4) UNIFORM PROBABILITY PLOT CORRELATION COEFF  **
1522C               **     5) NORMAL  PROBABILITY PLOT CORRELATION COEFF  **
1523C               **     6) TUKEY LAMBDA = -0.5 PROBABILITY PLOT        **
1524C               **                            CORRELATION COEFF       **
1525C               **     7) CAUCHY  PROBABILITY PLOT CORRELATION COEFF  **
1526C               *********************************************************
1527C
1528      ISTEPN='5'
1529      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SUM2')
1530     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1531C
1532      CALL STMOM3(Y,N,IWRITE,YST3MO,IBUGA3,IERROR)
1533      CALL STMOM4(Y,N,IWRITE,YST4MO,IBUGA3,IERROR)
1534      CALL STWS(Y,N,XTEMP1,IWRITE,YSTWS,MAXNXT,IBUGA3,IERROR)
1535C
1536      ALAMB=0.0
1537      ALAMB2=0.0
1538      MINMAX=1
1539      IGEPDF='NULL'
1540      IDIST='UNIFORM'
1541      CALL NORPPC(Y,N,IDIST,ALAMB,ALAMB2,
1542     1            IWRITE,XTEMP1,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
1543     1            MINMAX,IGEPDF,
1544     1            YUNIPP,SHAPE,SHAPE2,ALOC,SCALE,
1545     1            IBUGA3,ISUBRO,IERROR)
1546      IDIST='NORMAL'
1547      CALL NORPPC(Y,N,IDIST,ALAMB,ALAMB2,
1548     1            IWRITE,XTEMP1,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
1549     1            MINMAX,IGEPDF,
1550     1            YNORPP,SHAPE,SHAPE2,ALOC,SCALE,IBUGA3,ISUBRO,IERROR)
1551      IDIST='CAUCHY'
1552      CALL NORPPC(Y,N,IDIST,ALAMB,ALAMB2,
1553     1            IWRITE,XTEMP1,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
1554     1            MINMAX,IGEPDF,
1555     1            YCAUPP,SHAPE,SHAPE2,ALOC,SCALE,
1556     1            IBUGA3,ISUBRO,IERROR)
1557      ALAMB=-0.5
1558      IDIST='TUKEY-LAMBDA'
1559      CALL NORPPC(Y,N,IDIST,ALAMB,ALAMB2,
1560     1            IWRITE,XTEMP1,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
1561     1            MINMAX,IGEPDF,
1562     1            YLAMPP,SHAPE,SHAPE2,ALOC,SCALE,
1563     1            IBUGA3,ISUBRO,IERROR)
1564C
1565C               *******************************************************
1566C               **  STEP 6--                                         **
1567C               **  COMPUTE VARIOUS RANDOMNESS MEASURES              **
1568C               **     1) AUTOCORRELATION COEFFICIENT                **
1569C               **     2) STANDARDIZED LENGTH OF LONGEST RUN (UP OR  **
1570C               **        DOWN)                                      **
1571C               **     3) STANDARDIZED NUMBER OF RUNS (UP + DOWN)    **
1572C               ********************************************************
1573C
1574      ISTEPN='6'
1575      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SUM2')
1576     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1577C
1578      CALL AUTOCR(Y,N,IWRITE,YAUTOC,IBUGA3,IERROR)
1579CCCCC CALL STLLRU(Y,N,IWRITE,YSTLLR,IBUGA3,IERROR)
1580      YSTLLR=0.0
1581CCCCC CALL STNRUN(Y,N,IWRITE,YSTNRU,IBUGA3,IERROR)
1582      YSTNRU=0.0
1583C
1584C               ****************************
1585C               **  STEP 7--              **
1586C               **  WRITE EVERYTHING OUT  **
1587C               ****************************
1588C
1589      ISTEPN='7'
1590      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SUM2')
1591     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1592C
1593C     PRINT SUMMARY STATISTICS TABLE
1594C
1595      IF(IPRINT.EQ.'OFF')GOTO9000
1596C
1597      NUMDIG=7
1598      IF(IFORSW.EQ.'1')NUMDIG=1
1599      IF(IFORSW.EQ.'2')NUMDIG=2
1600      IF(IFORSW.EQ.'3')NUMDIG=3
1601      IF(IFORSW.EQ.'4')NUMDIG=4
1602      IF(IFORSW.EQ.'5')NUMDIG=5
1603      IF(IFORSW.EQ.'6')NUMDIG=6
1604      IF(IFORSW.EQ.'7')NUMDIG=7
1605      IF(IFORSW.EQ.'8')NUMDIG=8
1606      IF(IFORSW.EQ.'9')NUMDIG=9
1607      IF(IFORSW.EQ.'0')NUMDIG=0
1608      IF(IFORSW.EQ.'E')NUMDIG=-2
1609      IF(IFORSW.EQ.'-2')NUMDIG=-2
1610      IF(IFORSW.EQ.'-3')NUMDIG=-3
1611      IF(IFORSW.EQ.'-4')NUMDIG=-4
1612      IF(IFORSW.EQ.'-5')NUMDIG=-5
1613      IF(IFORSW.EQ.'-6')NUMDIG=-6
1614      IF(IFORSW.EQ.'-7')NUMDIG=-7
1615      IF(IFORSW.EQ.'-8')NUMDIG=-8
1616      IF(IFORSW.EQ.'-9')NUMDIG=-9
1617C
1618      ITITLE='Summary of xxxxxxxxxx Observations'
1619      WRITE(ITITLE(12:21),'(I10)')N
1620      NCTITL=34
1621      ITITLZ=' '
1622      NCTITZ=0
1623C
1624      ICNT=1
1625      ITEXT(ICNT)='Response Variable: '
1626      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
1627      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
1628      NCTEXT(ICNT)=27
1629      AVALUE(ICNT)=0.0
1630      IDIGIT(ICNT)=-1
1631C
1632      IF(NREPL.GT.0)THEN
1633        IADD=1
1634        DO2101I=1,NREPL
1635          ICNT=ICNT+1
1636          ITEMP=I+IADD
1637          ITEXT(ICNT)='Factor Variable  : '
1638          WRITE(ITEXT(ICNT)(17:17),'(I1)')I
1639          WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(ITEMP)(1:4)
1640          WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(ITEMP)(1:4)
1641          NCTEXT(ICNT)=27
1642          AVALUE(ICNT)=PID(ITEMP)
1643          IDIGIT(ICNT)=NUMDIG
1644 2101   CONTINUE
1645      ENDIF
1646C
1647      ICNT=ICNT+1
1648      ITEXT(ICNT)=' '
1649      NCTEXT(ICNT)=1
1650      AVALUE(ICNT)=0.0
1651      IDIGIT(ICNT)=-1
1652C
1653      NUMROW=ICNT
1654      DO2310I=1,NUMROW
1655        NTOT(I)=15
1656 2310 CONTINUE
1657C
1658      IFRST=.TRUE.
1659      ILAST=.TRUE.
1660      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
1661     1            NCTEXT,AVALUE,IDIGIT,
1662     1            NTOT,NUMROW,
1663     1            ICAPSW,ICAPTY,ILAST,IFRST,
1664     1            ISUBRO,IBUGA3,IERROR)
1665C
1666      ITITLE=' '
1667      NCTITL=-99
1668      ITITL9=' '
1669      NCTIT9=0
1670C
1671      NUMCOL=5
1672      NUMLIN=1
1673C
1674      ITITL2(1,1)='Location Measures'
1675      NCTIT2(1,1)=17
1676      NCOLSP(1,1)=2
1677      ITITL2(1,2)=' '
1678      NCTIT2(1,2)=0
1679      NCOLSP(1,2)=0
1680      ITITL2(1,3)=' | '
1681      NCTIT2(1,3)=3
1682      NCOLSP(1,3)=1
1683      ITITL2(1,4)='Dispersion Measures'
1684      NCTIT2(1,4)=19
1685      NCOLSP(1,4)=2
1686      ITITL2(1,5)=' '
1687      NCTIT2(1,5)=0
1688      NCOLSP(1,5)=0
1689C
1690      NMAX=0
1691      DO4210I=1,NUMCOL
1692        VALIGN(I)='b'
1693        ALIGN(I)='r'
1694        NTOT(I)=15
1695        IF(I.EQ.1)NTOT(I)=21
1696        IF(I.EQ.4)NTOT(I)=20
1697        IF(I.EQ.3)NTOT(I)=3
1698        NMAX=NMAX+NTOT(I)
1699        ITYPCO(I)='NUME'
1700        IF(I.EQ.1 .OR. I.EQ.3 .OR. I.EQ.4)ITYPCO(I)='ALPH'
1701        DO4213J=1,MAXROW
1702          IDIGI2(J,I)=NUMDIG
1703          IF(I.EQ.1 .OR. I.EQ.3 .OR. I.EQ.4)THEN
1704            IDIGI2(J,I)=-1
1705          ENDIF
1706 4213   CONTINUE
1707 4210 CONTINUE
1708C
1709      DO4289J=1,MAXROW
1710        IVALUE(J,1)=' '
1711        IVALUE(J,2)=' '
1712        IVALUE(J,3)=' '
1713        IVALUE(J,4)=' '
1714        IVALUE(J,5)=' '
1715        NCVALU(J,1)=0
1716        NCVALU(J,2)=0
1717        NCVALU(J,3)=0
1718        NCVALU(J,4)=0
1719        NCVALU(J,5)=0
1720        AMAT(J,1)=0.0
1721        AMAT(J,2)=0.0
1722        AMAT(J,3)=0.0
1723        AMAT(J,4)=0.0
1724        AMAT(J,5)=0.0
1725        ROWSEP(J)=0
1726 4289 CONTINUE
1727      AMAT(1,2)=YMIDR
1728      AMAT(1,5)=YRANGE
1729      AMAT(2,2)=YMEAN
1730      AMAT(2,5)=YSD
1731      AMAT(3,2)=YMIDM
1732      AMAT(3,5)=YAAD
1733      AMAT(4,2)=YMED
1734      AMAT(4,5)=YMIN
1735      AMAT(5,2)=0.0
1736      IDIGI2(5,2)=-1
1737      AMAT(5,5)=YLOWQ
1738      AMAT(6,2)=0.0
1739      IDIGI2(6,2)=-1
1740      AMAT(6,5)=YLOWH
1741      AMAT(7,2)=0.0
1742      IDIGI2(7,2)=-1
1743      AMAT(7,5)=YUPPH
1744      AMAT(8,2)=0.0
1745      IDIGI2(8,2)=-1
1746      AMAT(8,5)=YUPPQ
1747      AMAT(9,2)=0.0
1748      IDIGI2(9,2)=-1
1749      AMAT(9,5)=YMAX
1750CCCCC ROWSEP(9)=1
1751C
1752      IVALUE(1,1)='Midrange:'
1753      NCVALU(1,1)=9
1754      IVALUE(2,1)='Mean:'
1755      NCVALU(2,1)=5
1756      IVALUE(3,1)='Midmean:'
1757      NCVALU(3,1)=8
1758      IVALUE(4,1)='Median:'
1759      NCVALU(4,1)=7
1760C
1761      DO4330I=1,9
1762        IVALUE(I,3)=' | '
1763        NCVALU(I,3)=3
1764 4330 CONTINUE
1765C
1766      IVALUE(1,4)='Range:'
1767      NCVALU(1,4)=6
1768      IVALUE(2,4)='Standard Deviation:'
1769      NCVALU(2,4)=19
1770      IVALUE(3,4)='Average Abs. Dev.:'
1771      NCVALU(3,4)=18
1772      IVALUE(4,4)='Minimum:'
1773      NCVALU(4,4)=8
1774      IVALUE(5,4)='Lower Quartile:'
1775      NCVALU(5,4)=15
1776      IVALUE(6,4)='Lower Hinge:'
1777      NCVALU(6,4)=12
1778      IVALUE(7,4)='Upper Hinge:'
1779      NCVALU(7,4)=12
1780      IVALUE(8,4)='Upper Quartile:'
1781      NCVALU(8,4)=15
1782      IVALUE(9,4)='Maximum:'
1783      NCVALU(9,4)=8
1784C
1785      IWHTML(1)=150
1786      IWHTML(2)=150
1787      IWHTML(3)=25
1788      IWHTML(4)=150
1789      IWHTML(5)=150
1790      IINC=1800
1791      IINC2=200
1792      IWRTF(1)=IINC
1793      IWRTF(2)=IWRTF(1)+IINC
1794      IWRTF(3)=IWRTF(2)+IINC2
1795      IWRTF(4)=IWRTF(3)+IINC
1796      IWRTF(5)=IWRTF(4)+IINC
1797C
1798      ICNT=9
1799      IFRST=.TRUE.
1800      ILAST=.FALSE.
1801      IFLAGS=.TRUE.
1802      IFLAGE=.TRUE.
1803      CALL DPDT5B(ITITLE,NCTITL,
1804     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
1805     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
1806     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
1807     1            IDIGI2,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
1808     1            NCOLSP,ROWSEP,
1809     1            ICAPSW,ICAPTY,IFRST,ILAST,
1810     1            IFLAGS,IFLAGE,
1811     1            ISUBRO,IBUGA3,IERROR)
1812C
1813      ITITL2(1,1)='Randomness Measures'
1814      NCTIT2(1,1)=19
1815      ITITL2(1,4)='Distributional Measures'
1816      NCTIT2(1,4)=23
1817C
1818      DO4389J=1,MAXROW
1819        IVALUE(J,1)=' '
1820        IVALUE(J,2)=' '
1821        IVALUE(J,3)=' '
1822        IVALUE(J,4)=' '
1823        IVALUE(J,5)=' '
1824        NCVALU(J,1)=0
1825        NCVALU(J,2)=0
1826        NCVALU(J,3)=0
1827        NCVALU(J,4)=0
1828        NCVALU(J,5)=0
1829        AMAT(J,1)=0.0
1830        AMAT(J,2)=0.0
1831        AMAT(J,3)=0.0
1832        AMAT(J,4)=0.0
1833        AMAT(J,5)=0.0
1834        ROWSEP(J)=0
1835 4389 CONTINUE
1836      AMAT(1,2)=YAUTOC
1837      AMAT(1,5)=YST3MO
1838      AMAT(2,2)=0.0
1839      IDIGI2(2,2)=-1
1840      AMAT(2,5)=YST4MO
1841      AMAT(3,2)=0.0
1842      IDIGI2(3,2)=-1
1843      AMAT(3,5)=YSTWS
1844      AMAT(4,2)=0.0
1845      IDIGI2(4,2)=-1
1846      AMAT(4,5)=YUNIPP
1847      AMAT(5,2)=0.0
1848      IDIGI2(5,2)=-1
1849      AMAT(5,5)=YNORPP
1850      AMAT(6,2)=0.0
1851      IDIGI2(6,2)=-1
1852      AMAT(6,5)=YLAMPP
1853      AMAT(7,2)=0.0
1854      IDIGI2(7,2)=-1
1855      AMAT(7,5)=YCAUPP
1856      ROWSEP(7)=1
1857C
1858      IVALUE(1,1)='Autocorrelation Coef:'
1859      NCVALU(1,1)=21
1860C
1861      DO4350I=1,9
1862        IVALUE(I,3)=' | '
1863        NCVALU(I,3)=3
1864 4350 CONTINUE
1865C
1866      IVALUE(1,4)='St. Third Moment:'
1867      NCVALU(1,4)=17
1868      IVALUE(2,4)='St. Fourth Moment:'
1869      NCVALU(2,4)=18
1870      IVALUE(3,4)='St. Wilk-Shapiro:'
1871      NCVALU(3,4)=17
1872      IVALUE(4,4)='Uniform PPCC:'
1873      NCVALU(4,4)=13
1874      IVALUE(5,4)='Normal PPCC:'
1875      NCVALU(5,4)=12
1876      IVALUE(6,4)='Tukey-Lam -.5 PPCC:'
1877      NCVALU(6,4)=19
1878      IVALUE(7,4)='Cauchy PPCC:'
1879      NCVALU(7,4)=12
1880C
1881      ICNT=7
1882      IFRST=.TRUE.
1883      ILAST=.TRUE.
1884      IFLAGS=.TRUE.
1885      IFLAGE=.TRUE.
1886      CALL DPDT5B(ITITLE,NCTITL,
1887     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
1888     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
1889     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
1890     1            IDIGI2,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
1891     1            NCOLSP,ROWSEP,
1892     1            ICAPSW,ICAPTY,IFRST,ILAST,
1893     1            IFLAGS,IFLAGE,
1894     1            ISUBRO,IBUGA3,IERROR)
1895C
1896C               *****************
1897C               **  STEP 90--  **
1898C               **  EXIT       **
1899C               *****************
1900C
1901 9000 CONTINUE
1902      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'SUM2')THEN
1903        WRITE(ICOUT,999)
1904        CALL DPWRST('XXX','BUG ')
1905        WRITE(ICOUT,9011)
1906 9011   FORMAT('***** AT THE END       OF DPSUM2--')
1907        CALL DPWRST('XXX','BUG ')
1908        WRITE(ICOUT,9012)N,IBUGA3,IERROR
1909 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
1910        CALL DPWRST('XXX','BUG ')
1911      ENDIF
1912C
1913      RETURN
1914      END
1915      SUBROUTINE DPSUMM(XTEMP1,XTEMP2,MAXNXT,
1916     1                  ICASAN,ICAPSW,IFORSW,
1917     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
1918C
1919C     PURPOSE--GENERATE A BATTERY OF SUMMARY STATISTICS.
1920C     WRITTEN BY--JAMES J. FILLIBEN
1921C                 STATISTICAL ENGINEERING DIVISION
1922C                 INFORMATION TECHNOLOGY LABORATORY
1923C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1924C                 GAITHERSBURG, MD 20899-8980
1925C                 PHONE--301-975-2899
1926C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1927C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1928C     LANGUAGE--ANSI FORTRAN (1977)
1929C     VERSION NUMBER--82/7
1930C     ORIGINAL VERSION--JULY      1981.
1931C     UPDATED         --AUGUST    1981.
1932C     UPDATED         --SEPTEMBER 1981.
1933C     UPDATED         --MAY       1982.
1934C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
1935C     UPDATED         --OCTOBER   2002. SUPPORT FOR HTML OUTPUT
1936C                                       (ADD ICAPSW TO CALL LIST)
1937C     UPDATED         --MAY       2011. USE DPPARS
1938C     UPDATED         --MAY       2011. SUPPORT FOR "MULTIPLE" AND
1939C                                       "REPLICATION" OPTIONS
1940C     UPDATED         --JUNE      2016. CALL LIST TO DPSUM2
1941C     UPDATED         --JULY      2019. TWEAK SCRATCH SPACE
1942C
1943C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1944C
1945      CHARACTER*4 ICASAN
1946      CHARACTER*4 ICAPSW
1947      CHARACTER*4 IFORSW
1948      CHARACTER*4 IBUGA2
1949      CHARACTER*4 IBUGA3
1950      CHARACTER*4 IBUGQ
1951      CHARACTER*4 ISUBRO
1952      CHARACTER*4 IFOUND
1953      CHARACTER*4 IERROR
1954C
1955      CHARACTER*4 ISUBN1
1956      CHARACTER*4 ISUBN2
1957      CHARACTER*4 ISTEPN
1958      CHARACTER*4 IREPL
1959      CHARACTER*4 IMULT
1960      CHARACTER*4 ICTMP1
1961      CHARACTER*4 ICTMP2
1962      CHARACTER*4 ICTMP3
1963      CHARACTER*4 ICTMP4
1964      CHARACTER*4 ICASE
1965C
1966      CHARACTER*40 INAME
1967      PARAMETER (MAXSPN=30)
1968      CHARACTER*4 IVARN1(MAXSPN)
1969      CHARACTER*4 IVARN2(MAXSPN)
1970      CHARACTER*4 IVARTY(MAXSPN)
1971      CHARACTER*4 IVARID(1)
1972      CHARACTER*4 IVARI2(1)
1973      REAL PVAR(MAXSPN)
1974      REAL PID(MAXSPN)
1975      INTEGER ILIS(MAXSPN)
1976      INTEGER NRIGHT(MAXSPN)
1977      INTEGER ICOLR(MAXSPN)
1978C
1979C---------------------------------------------------------------------
1980C
1981      INCLUDE 'DPCOPA.INC'
1982C
1983      DIMENSION XTEMP1(*)
1984      DIMENSION XTEMP2(*)
1985      DIMENSION W(MAXOBV)
1986C
1987      DIMENSION XDESGN(MAXOBV,7)
1988      DIMENSION XIDTEM(MAXOBV)
1989      DIMENSION XIDTE2(MAXOBV)
1990      DIMENSION XIDTE3(MAXOBV)
1991      DIMENSION XIDTE4(MAXOBV)
1992      DIMENSION XIDTE5(MAXOBV)
1993      DIMENSION XIDTE6(MAXOBV)
1994C
1995      DIMENSION TEMP1(MAXOBV)
1996      DIMENSION TEMP2(MAXOBV)
1997      DIMENSION XTEMP3(MAXOBV)
1998C
1999      DOUBLE PRECISION DTEMP1(MAXOBV)
2000C
2001      INCLUDE 'DPCOZZ.INC'
2002      INCLUDE 'DPCOZD.INC'
2003C
2004      EQUIVALENCE (GARBAG(IGARB1),TEMP1(1))
2005      EQUIVALENCE (GARBAG(IGARB2),XIDTEM(1))
2006      EQUIVALENCE (GARBAG(IGARB3),XIDTE2(1))
2007      EQUIVALENCE (GARBAG(IGARB4),XIDTE3(1))
2008      EQUIVALENCE (GARBAG(IGARB5),XIDTE4(1))
2009      EQUIVALENCE (GARBAG(IGARB6),XIDTE5(1))
2010      EQUIVALENCE (GARBAG(IGARB7),XIDTE6(1))
2011      EQUIVALENCE (GARBAG(IGARB8),TEMP2(1))
2012      EQUIVALENCE (GARBAG(IGARB9),W(1))
2013      EQUIVALENCE (GARBAG(IGAR10),XTEMP3(1))
2014      EQUIVALENCE (GARBAG(JGAR11),XDESGN(1,1))
2015      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1))
2016C
2017C-----COMMON----------------------------------------------------------
2018C
2019      INCLUDE 'DPCOHK.INC'
2020      INCLUDE 'DPCODA.INC'
2021      INCLUDE 'DPCOSU.INC'
2022      INCLUDE 'DPCOST.INC'
2023      INCLUDE 'DPCOP2.INC'
2024C
2025C-----START POINT-----------------------------------------------------
2026C
2027      IERROR='NO'
2028      IFOUND='NO'
2029      ICASAN='SUMM'
2030      IREPL='OFF'
2031      IMULT='OFF'
2032      ISUBN1='DPSU'
2033      ISUBN2='MM  '
2034C
2035      MAXCP1=MAXCOL+1
2036      MAXCP2=MAXCOL+2
2037      MAXCP3=MAXCOL+3
2038      MAXCP4=MAXCOL+4
2039      MAXCP5=MAXCOL+5
2040      MAXCP6=MAXCOL+6
2041C
2042C               ***********************************************
2043C               **  TREAT THE SUMMARY                CASE    **
2044C               ***********************************************
2045C
2046      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'SUMM')THEN
2047        WRITE(ICOUT,999)
2048  999   FORMAT(1X)
2049        CALL DPWRST('XXX','BUG ')
2050        WRITE(ICOUT,51)
2051   51   FORMAT('***** AT THE BEGINNING OF DPSUMM--')
2052        CALL DPWRST('XXX','BUG ')
2053        WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ,ISUBRO
2054   53   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
2055        CALL DPWRST('XXX','BUG ')
2056      ENDIF
2057C
2058C               *****************************************************
2059C               **  STEP 1--                                       **
2060C               **  EXTRACT THE COMMAND                            **
2061C               **  LOOK FOR ONE OF THE FOLLOWING COMMANDS:        **
2062C               **    1) SUMMARY             Y                     **
2063C               **    2) MULTIPLE SUMMARY    Y1 ... YK             **
2064C               **    3) REPLICATED SUMMARY  Y X1 ... XK           **
2065C               *****************************************************
2066C
2067      ISTEPN='1'
2068      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')
2069     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2070C
2071      ILASTC=9999
2072      ILASTZ=9999
2073      ICASAN='SUMM'
2074C
2075      DO100I=0,NUMARG-1
2076C
2077        IF(I.EQ.0)THEN
2078          ICTMP1=ICOM
2079        ELSE
2080          ICTMP1=IHARG(I)
2081        ENDIF
2082        ICTMP2=IHARG(I+1)
2083        ICTMP3=IHARG(I+2)
2084        ICTMP4=IHARG(I+3)
2085C
2086        IF(ICTMP1.EQ.'=')THEN
2087          IFOUND='NO'
2088          GOTO9000
2089        ELSEIF(ICTMP1.EQ.'SUMM')THEN
2090          IFOUND='YES'
2091          ICASAN='SUMM'
2092          ILASTC=I
2093          ILASTZ=I
2094        ELSEIF(ICTMP1.EQ.'REPL')THEN
2095          IREPL='ON'
2096          ILASTC=MIN(ILASTC,I)
2097          ILASTZ=MAX(ILASTZ,I)
2098        ELSEIF(ICTMP1.EQ.'TOLE' .AND. ICTMP2.EQ.'LIMI')THEN
2099          IFOUND='NO'
2100          GOTO9000
2101        ELSEIF(ICTMP1.EQ.'TOLE' .AND. ICTMP2.EQ.'INTE')THEN
2102          IFOUND='NO'
2103          GOTO9000
2104        ELSEIF(ICTMP1.EQ.'MULT')THEN
2105          IMULT='ON'
2106          ILASTC=MIN(ILASTC,I)
2107          ILASTZ=MAX(ILASTZ,I)
2108        ENDIF
2109  100 CONTINUE
2110C
2111      IF(IFOUND.EQ.'NO')GOTO9000
2112C
2113      ISHIFT=ILASTZ
2114      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
2115     1            IBUGA2,IERROR)
2116C
2117      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')THEN
2118        WRITE(ICOUT,91)ICASAN,IMULT,IREPL,ISHIFT
2119   91   FORMAT('DPSUMM: ICASAN,IMULT,IREPL,ISHIFT = ',3(A4,2X),I5)
2120        CALL DPWRST('XXX','BUG ')
2121      ENDIF
2122C
2123      IF(IMULT.EQ.'ON')THEN
2124        IF(IREPL.EQ.'ON')THEN
2125          WRITE(ICOUT,999)
2126          CALL DPWRST('XXX','BUG ')
2127          WRITE(ICOUT,101)
2128  101     FORMAT('***** ERROR IN SUMMARY--')
2129          CALL DPWRST('XXX','BUG ')
2130          WRITE(ICOUT,103)
2131  103     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
2132     1           '"REPLICATION"')
2133          CALL DPWRST('XXX','BUG ')
2134          WRITE(ICOUT,104)
2135  104     FORMAT('      FOR THE SUMMARY COMMAND.')
2136          CALL DPWRST('XXX','BUG ')
2137          IERROR='YES'
2138          GOTO9000
2139        ENDIF
2140      ENDIF
2141C
2142C               *********************************
2143C               **  STEP 4--                   **
2144C               **  EXTRACT THE VARIABLE LIST  **
2145C               *********************************
2146C
2147      ISTEPN='4'
2148      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')
2149     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2150C
2151      INAME='SUMMARY'
2152      MINNA=1
2153      MAXNA=100
2154      MINN2=2
2155      IFLAGE=0
2156      IFLAGM=1
2157      IF(IREPL.EQ.'ON')THEN
2158        IFLAGM=0
2159        IFLAGE=1
2160      ENDIF
2161      IFLAGP=0
2162      JMIN=1
2163      JMAX=NUMARG
2164      MINNVA=1
2165      MAXNVA=MAXSPN
2166C
2167      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
2168     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
2169     1            JMIN,JMAX,
2170     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
2171     1            IVARN1,IVARN2,IVARTY,PVAR,
2172     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
2173     1            MINNVA,MAXNVA,
2174     1            IFLAGM,IFLAGP,
2175     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
2176      IF(IERROR.EQ.'YES')GOTO9000
2177C
2178      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')THEN
2179        WRITE(ICOUT,999)
2180        CALL DPWRST('XXX','BUG ')
2181        WRITE(ICOUT,281)
2182  281   FORMAT('***** AFTER CALL DPPARS--')
2183        CALL DPWRST('XXX','BUG ')
2184        WRITE(ICOUT,282)NQ,NUMVAR
2185  282   FORMAT('NQ,NUMVAR = ',2I8)
2186        CALL DPWRST('XXX','BUG ')
2187        IF(NUMVAR.GT.0)THEN
2188          DO285I=1,NUMVAR
2189            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
2190     1                      ICOLR(I)
2191  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
2192     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
2193            CALL DPWRST('XXX','BUG ')
2194  285     CONTINUE
2195        ENDIF
2196      ENDIF
2197C
2198C               ***********************************************
2199C               **  STEP 5--                                 **
2200C               **  DETERMINE:                               **
2201C               **  1) NUMBER OF REPLICATION VARIABLES (0-6) **
2202C               **  2) NUMBER OF RESPONSE    VARIABLES (>= 1)**
2203C               ***********************************************
2204C
2205      ISTEPN='5'
2206      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')
2207     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2208C
2209      NREPL=0
2210      NRESP=0
2211      IF(IREPL.EQ.'ON')THEN
2212        NRESP=1
2213        NREPL=NUMVAR-NRESP
2214        IF(NREPL.LT.1 .OR. NREPL.GT.6)THEN
2215          WRITE(ICOUT,999)
2216          CALL DPWRST('XXX','BUG ')
2217          WRITE(ICOUT,101)
2218          CALL DPWRST('XXX','BUG ')
2219          WRITE(ICOUT,511)
2220  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
2221     1           'REPLICATION VARIABLES')
2222          CALL DPWRST('XXX','BUG ')
2223          WRITE(ICOUT,512)
2224  512     FORMAT('      MUST BE BETWEEN ONE AND SIX.')
2225          CALL DPWRST('XXX','BUG ')
2226          WRITE(ICOUT,513)NREPL
2227  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
2228          CALL DPWRST('XXX','BUG ')
2229          IERROR='YES'
2230          GOTO9000
2231        ENDIF
2232      ELSE
2233        NRESP=NUMVAR
2234        IMULT='ON'
2235      ENDIF
2236C
2237      DO519I=1,MAXOBV
2238        W(I)=1.0
2239  519 CONTINUE
2240C
2241      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')THEN
2242        WRITE(ICOUT,521)NRESP,NREPL
2243  521   FORMAT('NRESP,NREPL = ',2I5)
2244        CALL DPWRST('XXX','BUG ')
2245      ENDIF
2246C
2247C               **************************************************
2248C               **  STEP 6--                                    **
2249C               **  GENERATE THE SUMMARY FOR VARIOUS CASES      **
2250C               ***************************************************
2251C
2252      ISTEPN='6'
2253      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')
2254     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2255C
2256C               ******************************************
2257C               **  STEP 8A--                           **
2258C               **  CASE 1: NO REPLICATION VARIABLES    **
2259C               ******************************************
2260C
2261      IF(NREPL.LT.1)THEN
2262        ISTEPN='8A'
2263        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')
2264     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2265C
2266C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
2267C
2268        NCURVE=0
2269        DO810IRESP=1,NRESP
2270          NCURVE=NCURVE+1
2271C
2272          IINDX=ICOLR(IRESP)
2273          PID(1)=CPUMIN
2274          IVARID(1)=IVARN1(IRESP)
2275          IVARI2(1)=IVARN2(IRESP)
2276C
2277          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')THEN
2278            WRITE(ICOUT,999)
2279            CALL DPWRST('XXX','BUG ')
2280            WRITE(ICOUT,811)IRESP,NCURVE
2281  811       FORMAT('IRESP,NCURVE = ',2I5)
2282            CALL DPWRST('XXX','BUG ')
2283          ENDIF
2284C
2285          ICOL=IRESP
2286          NUMVA2=1
2287          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
2288     1                INAME,IVARN1,IVARN2,IVARTY,
2289     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
2290     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
2291     1                MAXCP4,MAXCP5,MAXCP6,
2292     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
2293     1                Y,XTEMP1,XTEMP1,NS1,NLOCA2,NLOCA3,ICASE,
2294     1                IBUGA3,ISUBRO,IFOUND,IERROR)
2295          IF(IERROR.EQ.'YES')GOTO9000
2296C
2297C         *****************************************************
2298C         **  STEP 8B--                                      **
2299C         *****************************************************
2300C
2301          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'SUMM')THEN
2302            ISTEPN='8B'
2303            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2304            WRITE(ICOUT,999)
2305            CALL DPWRST('XXX','BUG ')
2306            WRITE(ICOUT,822)
2307  822       FORMAT('***** FROM THE MIDDLE  OF DPSUMM--')
2308            CALL DPWRST('XXX','BUG ')
2309            WRITE(ICOUT,823)ICASAN,NUMVAR,NS1
2310  823       FORMAT('ICASAN,NUMVAR,NS1 = ',A4,2I8)
2311            CALL DPWRST('XXX','BUG ')
2312            IF(NS1.GE.1)THEN
2313              DO825I=1,NS1
2314                WRITE(ICOUT,826)I,Y(I)
2315  826           FORMAT('I,Y(I) = ',I8,G15.7)
2316                CALL DPWRST('XXX','BUG ')
2317  825         CONTINUE
2318            ENDIF
2319          ENDIF
2320C
2321          CALL DPSUM2(Y,W,NS1,XTEMP1,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
2322     1                ICAPSW,ICAPTY,IFORSW,ICASAN,
2323     1                PID,IVARID,IVARI2,NREPL,
2324     1                ISUBRO,IBUGA3,IERROR)
2325C
2326  810   CONTINUE
2327C
2328C               ****************************************************
2329C               **  STEP 9A--                                     **
2330C               **  CASE 3: ONE OR MORE REPLICATION VARIABLES.    **
2331C               **          FOR THIS CASE, THE NUMBER OF RESPONSE **
2332C               **          VARIABLES MUST BE EXACTLY 1.          **
2333C               **          FOR THIS CASE, ALL VARIABLES MUST     **
2334C               **          HAVE THE SAME LENGTH.                 **
2335C               ****************************************************
2336C
2337      ELSEIF(NREPL.GE.1)THEN
2338        ISTEPN='9A'
2339        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SUMM')
2340     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2341C
2342        J=0
2343        IMAX=NRIGHT(1)
2344        IF(NQ.LT.NRIGHT(1))IMAX=NQ
2345        DO910I=1,IMAX
2346          IF(ISUB(I).EQ.0)GOTO910
2347          J=J+1
2348C
2349C         RESPONSE VARIABLE IN Y
2350C
2351          ICOLC=1
2352          IJ=MAXN*(ICOLR(ICOLC)-1)+I
2353          IF(ICOLR(ICOLC).LE.MAXCOL)Y(J)=V(IJ)
2354          IF(ICOLR(ICOLC).EQ.MAXCP1)Y(J)=PRED(I)
2355          IF(ICOLR(ICOLC).EQ.MAXCP2)Y(J)=RES(I)
2356          IF(ICOLR(ICOLC).EQ.MAXCP3)Y(J)=YPLOT(I)
2357          IF(ICOLR(ICOLC).EQ.MAXCP4)Y(J)=XPLOT(I)
2358          IF(ICOLR(ICOLC).EQ.MAXCP5)Y(J)=X2PLOT(I)
2359          IF(ICOLR(ICOLC).EQ.MAXCP6)Y(J)=TAGPLO(I)
2360C
2361          IF(NREPL.GE.1)THEN
2362            DO920IR=1,MIN(NREPL,6)
2363              ICOLC=ICOLC+1
2364              ICOLT=ICOLR(ICOLC)
2365              IJ=MAXN*(ICOLT-1)+I
2366              IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
2367              IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
2368              IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
2369              IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
2370              IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
2371              IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
2372              IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
2373  920       CONTINUE
2374          ENDIF
2375C
2376  910   CONTINUE
2377        NLOCAL=J
2378C
2379C       *****************************************************
2380C       **  STEP 9B--                                      **
2381C       **  CALL DPSUM2 TO PERFORM SUMMARY.                **
2382C       *****************************************************
2383C
2384C
2385        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'SUMM')THEN
2386          ISTEPN='9C'
2387          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2388          WRITE(ICOUT,999)
2389          CALL DPWRST('XXX','BUG ')
2390          WRITE(ICOUT,941)
2391  941     FORMAT('***** FROM THE MIDDLE  OF DPSUMM--')
2392          CALL DPWRST('XXX','BUG ')
2393          WRITE(ICOUT,942)ICASAN,NUMVAR,NLOCAL,NREPL
2394  942     FORMAT('ICASAN,NUMVAR,NLOCAL,NREPL = ',
2395     1           A4,3I8)
2396          CALL DPWRST('XXX','BUG ')
2397          IF(NLOCAL.GE.1)THEN
2398            DO945I=1,NLOCAL
2399              WRITE(ICOUT,946)I,Y(I),XDESGN(I,1),XDESGN(I,2)
2400  946         FORMAT('I,Y(I),XDESGN(I,1),XDESGN(I,2) = ',
2401     1               I8,4F12.5)
2402              CALL DPWRST('XXX','BUG ')
2403  945       CONTINUE
2404          ENDIF
2405        ENDIF
2406C
2407C       *****************************************************
2408C       **  STEP 9C--                                      **
2409C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
2410C       **  REPLICATION VARIABLES.                         **
2411C       *****************************************************
2412C
2413        CALL DPPP5(XDESGN(1,1),XDESGN(1,2),XDESGN(1,3),
2414     1             XDESGN(1,4),XDESGN(1,5),XDESGN(1,6),
2415     1             NREPL,NLOCAL,MAXOBV,
2416     1             XIDTEM,XIDTE2,XIDTE3,XIDTE4,XIDTE5,XIDTE6,
2417     1             XTEMP1,TEMP2,
2418     1             NUMSE1,NUMSE2,NUMSE3,NUMSE4,NUMSE5,NUMSE6,
2419     1             IBUGA3,ISUBRO,IERROR)
2420C
2421C       *****************************************************
2422C       **  STEP 9D--                                      **
2423C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
2424C       *****************************************************
2425C
2426        NCURVE=0
2427        IADD=1
2428C
2429        IF(NREPL.EQ.1)THEN
2430          J=0
2431          DO1110ISET1=1,NUMSE1
2432            K=0
2433            PID(IADD+1)=XIDTEM(ISET1)
2434            DO1130I=1,NLOCAL
2435              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
2436                K=K+1
2437                TEMP1(K)=Y(I)
2438              ENDIF
2439 1130       CONTINUE
2440            NTEMP=K
2441            NCURVE=NCURVE+1
2442            IF(NTEMP.GT.0)THEN
2443              CALL DPSUM2(TEMP1,W,NTEMP,XTEMP1,XTEMP2,XTEMP3,
2444     1                    DTEMP1,MAXNXT,
2445     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
2446     1                    PID,IVARN1,IVARN2,NREPL,
2447     1                    ISUBRO,IBUGA3,IERROR)
2448            ENDIF
2449 1110     CONTINUE
2450        ELSEIF(NREPL.EQ.2)THEN
2451          J=0
2452          NTOT=NUMSE1*NUMSE2
2453          DO1210ISET1=1,NUMSE1
2454          DO1220ISET2=1,NUMSE2
2455            K=0
2456            PID(1+IADD)=XIDTEM(ISET1)
2457            PID(2+IADD)=XIDTE2(ISET2)
2458            DO1290I=1,NLOCAL
2459              IF(
2460     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2461     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
2462     1          )THEN
2463                K=K+1
2464                TEMP1(K)=Y(I)
2465              ENDIF
2466 1290       CONTINUE
2467            NTEMP=K
2468            NCURVE=NCURVE+1
2469            IF(NTEMP.GT.0)THEN
2470              CALL DPSUM2(TEMP1,W,NTEMP,XTEMP1,XTEMP2,XTEMP3,
2471     1                    DTEMP1,MAXNXT,
2472     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
2473     1                    PID,IVARN1,IVARN2,NREPL,
2474     1                    ISUBRO,IBUGA3,IERROR)
2475            ENDIF
2476 1220     CONTINUE
2477 1210     CONTINUE
2478        ELSEIF(NREPL.EQ.3)THEN
2479          J=0
2480          NTOT=NUMSE1*NUMSE2*NUMSE3
2481          DO1310ISET1=1,NUMSE1
2482          DO1320ISET2=1,NUMSE2
2483          DO1330ISET3=1,NUMSE3
2484            K=0
2485            PID(1+IADD)=XIDTEM(ISET1)
2486            PID(2+IADD)=XIDTE2(ISET2)
2487            PID(3+IADD)=XIDTE3(ISET3)
2488            DO1390I=1,NLOCAL
2489              IF(
2490     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2491     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
2492     1           XIDTE3(ISET3).EQ.XDESGN(I,3)
2493     1          )THEN
2494                K=K+1
2495                TEMP1(K)=Y(I)
2496              ENDIF
2497 1390       CONTINUE
2498            NTEMP=K
2499            NCURVE=NCURVE+1
2500            NPLOT1=NPLOTP
2501            IF(NTEMP.GT.0)THEN
2502              CALL DPSUM2(TEMP1,W,NTEMP,XTEMP1,XTEMP2,XTEMP3,
2503     1                    DTEMP1,MAXNXT,
2504     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
2505     1                    PID,IVARN1,IVARN2,NREPL,
2506     1                    ISUBRO,IBUGA3,IERROR)
2507            ENDIF
2508 1330     CONTINUE
2509 1320     CONTINUE
2510 1310     CONTINUE
2511        ELSEIF(NREPL.EQ.4)THEN
2512          J=0
2513          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4
2514          DO1410ISET1=1,NUMSE1
2515          DO1420ISET2=1,NUMSE2
2516          DO1430ISET3=1,NUMSE3
2517          DO1440ISET4=1,NUMSE4
2518            K=0
2519            PID(1+IADD)=XIDTEM(ISET1)
2520            PID(2+IADD)=XIDTE2(ISET2)
2521            PID(3+IADD)=XIDTE3(ISET3)
2522            PID(4+IADD)=XIDTE4(ISET4)
2523            DO1490I=1,NLOCAL
2524              IF(
2525     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2526     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
2527     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
2528     1           XIDTE4(ISET4).EQ.XDESGN(I,4)
2529     1          )THEN
2530                K=K+1
2531                TEMP1(K)=Y(I)
2532              ENDIF
2533 1490       CONTINUE
2534            NTEMP=K
2535            NCURVE=NCURVE+1
2536            NPLOT1=NPLOTP
2537            IF(NTEMP.GT.0)THEN
2538              CALL DPSUM2(TEMP1,W,NTEMP,XTEMP1,XTEMP2,XTEMP3,
2539     1                    DTEMP1,MAXNXT,
2540     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
2541     1                    PID,IVARN1,IVARN2,NREPL,
2542     1                    ISUBRO,IBUGA3,IERROR)
2543            ENDIF
2544 1440     CONTINUE
2545 1430     CONTINUE
2546 1420     CONTINUE
2547 1410     CONTINUE
2548        ELSEIF(NREPL.EQ.5)THEN
2549          J=0
2550          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5
2551          DO1510ISET1=1,NUMSE1
2552          DO1520ISET2=1,NUMSE2
2553          DO1530ISET3=1,NUMSE3
2554          DO1540ISET4=1,NUMSE4
2555          DO1550ISET5=1,NUMSE5
2556            K=0
2557            PID(1+IADD)=XIDTEM(ISET1)
2558            PID(2+IADD)=XIDTE2(ISET2)
2559            PID(3+IADD)=XIDTE3(ISET3)
2560            PID(4+IADD)=XIDTE4(ISET4)
2561            PID(5+IADD)=XIDTE5(ISET4)
2562            DO1590I=1,NLOCAL
2563              IF(
2564     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2565     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
2566     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
2567     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
2568     1           XIDTE5(ISET5).EQ.XDESGN(I,5)
2569     1          )THEN
2570                K=K+1
2571                TEMP1(K)=Y(I)
2572              ENDIF
2573 1590       CONTINUE
2574            NTEMP=K
2575            NCURVE=NCURVE+1
2576            NPLOT1=NPLOTP
2577            IF(NTEMP.GT.0)THEN
2578              CALL DPSUM2(TEMP1,W,NTEMP,XTEMP1,XTEMP2,XTEMP3,
2579     1                    DTEMP1,MAXNXT,
2580     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
2581     1                    PID,IVARN1,IVARN2,NREPL,
2582     1                    ISUBRO,IBUGA3,IERROR)
2583            ENDIF
2584 1550     CONTINUE
2585 1540     CONTINUE
2586 1530     CONTINUE
2587 1520     CONTINUE
2588 1510     CONTINUE
2589        ELSEIF(NREPL.EQ.6)THEN
2590          J=0
2591          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5*NUMSE6
2592          DO1610ISET1=1,NUMSE1
2593          DO1620ISET2=1,NUMSE2
2594          DO1630ISET3=1,NUMSE3
2595          DO1640ISET4=1,NUMSE4
2596          DO1650ISET5=1,NUMSE5
2597          DO1660ISET6=1,NUMSE6
2598            K=0
2599            PID(1+IADD)=XIDTEM(ISET1)
2600            PID(2+IADD)=XIDTE2(ISET2)
2601            PID(3+IADD)=XIDTE3(ISET3)
2602            PID(4+IADD)=XIDTE4(ISET4)
2603            PID(5+IADD)=XIDTE5(ISET4)
2604            PID(6+IADD)=XIDTE6(ISET4)
2605            DO1690I=1,NLOCAL
2606              IF(
2607     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2608     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
2609     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
2610     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
2611     1           XIDTE5(ISET5).EQ.XDESGN(I,5) .AND.
2612     1           XIDTE6(ISET6).EQ.XDESGN(I,6)
2613     1          )THEN
2614                K=K+1
2615                TEMP1(K)=Y(I)
2616              ENDIF
2617 1690       CONTINUE
2618            NTEMP=K
2619            NCURVE=NCURVE+1
2620            NPLOT1=NPLOTP
2621            IF(NTEMP.GT.0)THEN
2622              CALL DPSUM2(TEMP1,W,NTEMP,XTEMP1,XTEMP2,XTEMP3,
2623     1                    DTEMP1,MAXNXT,
2624     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
2625     1                    PID,IVARN1,IVARN2,NREPL,
2626     1                    ISUBRO,IBUGA3,IERROR)
2627            ENDIF
2628 1660     CONTINUE
2629 1650     CONTINUE
2630 1640     CONTINUE
2631 1630     CONTINUE
2632 1620     CONTINUE
2633 1610     CONTINUE
2634        ENDIF
2635C
2636      ENDIF
2637C
2638C               *****************
2639C               **  STEP 90--  **
2640C               **  EXIT       **
2641C               *****************
2642C
2643 9000 CONTINUE
2644C
2645      IF(IERROR.EQ.'YES')THEN
2646        IF(IWIDTH.GE.1)THEN
2647          WRITE(ICOUT,9001)(IANS(I),I=1,MIN(100,IWIDTH))
2648 9001     FORMAT(100A1)
2649          CALL DPWRST('XXX','BUG ')
2650        ENDIF
2651      ENDIF
2652C
2653      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'SUMM')THEN
2654        WRITE(ICOUT,999)
2655        CALL DPWRST('XXX','BUG ')
2656        WRITE(ICOUT,9011)
2657 9011   FORMAT('***** AT THE END       OF DPSUMM--')
2658        CALL DPWRST('XXX','BUG ')
2659        WRITE(ICOUT,9012)IFOUND,IERROR,ICASAN
2660 9012   FORMAT('IFOUND,IERROR,ICASAN = ',2(A4,2X),A4)
2661        CALL DPWRST('XXX','BUG ')
2662      ENDIF
2663C
2664      RETURN
2665      END
2666      SUBROUTINE DPSWAP(IOP3,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
2667     1IVALUE,MAXN2,MAXCO2,MAXIJ2,IBUGS2,ISUBRO,IERROR)
2668CCCCC SUBROUTINE DPSWAP(IOP3,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
2669CCCCC1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGS2,ISUBRO,IERROR)
2670C
2671C     PURPOSE--SWAP (WRITE OUT OR READ IN) THE VECTOR V(.)
2672C              FROM MASS STORAGE.
2673C     WRITTEN BY--JAMES J. FILLIBEN
2674C                 STATISTICAL ENGINEERING DIVISION
2675C                 INFORMATION TECHNOLOGY LABORATORY
2676C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2677C                 GAITHERSBURG, MD 20899-8980
2678C                 PHONE--301-975-2899
2679C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2680C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2681C     LANGUAGE--ANSI FORTRAN (1977)
2682C     VERSION NUMBER--86/1
2683C     ORIGINAL VERSION--MARCH     1981.
2684C     UPDATED         --JULY      1981.
2685C     UPDATED         --AUGUST    1981.
2686C     UPDATED         --NOVEMBER  1981.
2687C     UPDATED         --MARCH     1982.
2688C     UPDATED         --MAY       1982.
2689C     UPDATED         --JANUARY   1986.
2690C     UPDATED         --OCTOBER   1991.  SUN HAS LIMIT ON NUMBER OF WORDS
2691C                                        THAT CAN BE WRITTEN (ALAN)
2692C
2693C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2694C
2695      CHARACTER*4 IOP3
2696      CHARACTER*4 IHNAME(*)
2697      CHARACTER*4 IHNAM2(*)
2698      CHARACTER*4 IUSE
2699      CHARACTER*4 IBUGS2
2700      CHARACTER*4 ISUBRO
2701      CHARACTER*4 IERROR
2702C
2703      INCLUDE 'DPCOPA.INC'
2704C
2705CCCCC CHARACTER*80 IFILE
2706      CHARACTER (LEN=MAXFNC) :: IFILE
2707      CHARACTER*12 ISTAT
2708      CHARACTER*12 IFORM
2709      CHARACTER*12 IACCES
2710      CHARACTER*12 IPROT
2711      CHARACTER*12 ICURST
2712      CHARACTER*4 IENDFI
2713      CHARACTER*4 IREWIN
2714      CHARACTER*4 ISUBN0
2715      CHARACTER*4 IERRFI
2716C
2717CCCCC CHARACTER*4 IFOUND
2718C
2719      CHARACTER*4 ISTEPN
2720      CHARACTER*4 ISUBN1
2721      CHARACTER*4 ISUBN2
2722C
2723      INCLUDE 'DPCODA.INC'
2724CCCCC DIMENSION V(*)
2725      DIMENSION IUSE(*)
2726      DIMENSION IN(*)
2727      DIMENSION IVALUE(*)
2728C
2729C-----COMMON----------------------------------------------------------
2730C
2731      INCLUDE 'DPCOFO.INC'
2732      INCLUDE 'DPCOF2.INC'
2733C  FOLLOWING LINE ADDED OCTOBER 1991.
2734      INCLUDE 'DPCOHO.INC'
2735      INCLUDE 'DPCOP2.INC'
2736C
2737C-----START POINT-----------------------------------------------------
2738C
2739      ISUBN1='DPSW'
2740      ISUBN2='AP  '
2741      ISUBN0='SWAP'
2742      IERROR='NO'
2743C
2744      IWIDTH=(-999)
2745C
2746      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWAP')GOTO90
2747      WRITE(ICOUT,999)
2748  999 FORMAT(1X)
2749      CALL DPWRST('XXX','BUG ')
2750      WRITE(ICOUT,51)
2751   51 FORMAT('***** AT THE BEGINNING OF DPSWAP--')
2752      CALL DPWRST('XXX','BUG ')
2753      WRITE(ICOUT,53)IBUGS2,IOP3
2754   53 FORMAT('IBUGS2,IOP3 = ',A4,2X,A4)
2755      CALL DPWRST('XXX','BUG ')
2756      WRITE(ICOUT,54)V(1),V(2),V(3)
2757   54 FORMAT('V(1),V(2),V(3) = ',3E15.7)
2758      CALL DPWRST('XXX','BUG ')
2759      WRITE(ICOUT,55)NUMNAM,MAXN,MAXCOL
2760   55 FORMAT('NUMNAM,MAXN,MAXCOL = ',3I8)
2761      CALL DPWRST('XXX','BUG ')
2762      WRITE(ICOUT,71)ISCRNU
2763   71 FORMAT('ISCRNU = ',I8)
2764      CALL DPWRST('XXX','BUG ')
2765      WRITE(ICOUT,72)ISCRNA(1:80)
2766   72 FORMAT('ISCRNA = ',A80)
2767      CALL DPWRST('XXX','BUG ')
2768      WRITE(ICOUT,73)ISCRST
2769   73 FORMAT('ISCRST = ',A12)
2770      CALL DPWRST('XXX','BUG ')
2771      WRITE(ICOUT,74)ISCRFO
2772   74 FORMAT('ISCRFO = ',A12)
2773      CALL DPWRST('XXX','BUG ')
2774      WRITE(ICOUT,75)ISCRAC
2775   75 FORMAT('ISCRAC = ',A12)
2776      CALL DPWRST('XXX','BUG ')
2777      WRITE(ICOUT,76)ISCRFO
2778   76 FORMAT('ISCRFO = ',A12)
2779      CALL DPWRST('XXX','BUG ')
2780      WRITE(ICOUT,77)ISCRCS
2781   77 FORMAT('ISCRCS = ',A12)
2782      CALL DPWRST('XXX','BUG ')
2783   90 CONTINUE
2784C
2785C               **************************
2786C               **  STEP 11--           **
2787C               **  COPY OVER VARIABLES **
2788C               **************************
2789C
2790      ISTEPN='11'
2791      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
2792     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2793C
2794      IOUNIT=ISCRNU
2795      IFILE=ISCRNA
2796      ISTAT=ISCRST
2797      IFORM=ISCRFO
2798      IACCES=ISCRAC
2799      IPROT=ISCRPR
2800      ICURST=ISCRCS
2801C
2802      ISUBN0='SWAP'
2803      IERRFI='NO'
2804C
2805      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWAP')GOTO1199
2806      WRITE(ICOUT,1193)IOUNIT
2807 1193 FORMAT('IOUNIT = ',I8)
2808      CALL DPWRST('XXX','BUG ')
2809      WRITE(ICOUT,1194)IFILE(1:80)
2810 1194 FORMAT('IFILE = ',A80)
2811      CALL DPWRST('XXX','BUG ')
2812      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
2813 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
2814     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
2815      CALL DPWRST('XXX','BUG ')
2816      WRITE(ICOUT,1196)ISUBN0,IERRFI
2817 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
2818      CALL DPWRST('XXX','BUG ')
2819 1199 CONTINUE
2820C
2821C               **********************************************
2822C               **  STEP 12--                               **
2823C               **  CHECK TO SEE IF SCRATCH FILE MAY EXIST  **
2824C               **********************************************
2825C
2826      ISTEPN='12'
2827      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
2828     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2829C
2830      IF(ISTAT.EQ.'NONE')GOTO1200
2831      GOTO1290
2832 1200 CONTINUE
2833      IERROR='YES'
2834      WRITE(ICOUT,999)
2835      CALL DPWRST('XXX','BUG ')
2836      WRITE(ICOUT,1211)
2837 1211 FORMAT('***** IMPLEMENTATION ERROR IN DPSWAP--')
2838      CALL DPWRST('XXX','BUG ')
2839      WRITE(ICOUT,1212)
2840 1212 FORMAT('      THE DESIRED FIT REQUIRES THE ')
2841      CALL DPWRST('XXX','BUG ')
2842      WRITE(ICOUT,1213)
2843 1213 FORMAT('      BEHIND-THE-SCENES USE OF A SCRATCH FILE;')
2844      CALL DPWRST('XXX','BUG ')
2845      WRITE(ICOUT,1214)
2846 1214 FORMAT('      BUT THE USE OF SUCH A SCRATCH FILE ')
2847      CALL DPWRST('XXX','BUG ')
2848      WRITE(ICOUT,1215)
2849 1215 FORMAT('      CANNOT BE DONE BECAUSE')
2850      CALL DPWRST('XXX','BUG ')
2851      WRITE(ICOUT,1216)
2852 1216 FORMAT('      THE INTERNAL VARIABLE    ISCRST ')
2853      CALL DPWRST('XXX','BUG ')
2854      WRITE(ICOUT,1217)
2855 1217 FORMAT('      WHICH ALLOWS SUCH SCRATCH FILE USE')
2856      CALL DPWRST('XXX','BUG ')
2857      WRITE(ICOUT,1218)
2858 1218 FORMAT('      HAS BEEN SET TO    NONE.')
2859      CALL DPWRST('XXX','BUG ')
2860      WRITE(ICOUT,1219)ISTAT,ISCRST
2861 1219 FORMAT('ISTAT,ISCRST = ',A12,2X,A12)
2862      CALL DPWRST('XXX','BUG ')
2863      WRITE(ICOUT,1220)
2864 1220 FORMAT('      PLEASE CONTACT THE DATAPLOT IMPLEMENTOR')
2865      CALL DPWRST('XXX','BUG ')
2866      WRITE(ICOUT,1221)
2867 1221 FORMAT('      AND HAVE THE ISCRST SETTING CHANGED')
2868      CALL DPWRST('XXX','BUG ')
2869      WRITE(ICOUT,1222)
2870 1222 FORMAT('      (FROM   NONE   TO   UNKNOWN)')
2871      CALL DPWRST('XXX','BUG ')
2872      WRITE(ICOUT,1223)
2873 1223 FORMAT('      IN SUBROUTINE INITFO.')
2874      CALL DPWRST('XXX','BUG ')
2875      GOTO9000
2876 1290 CONTINUE
2877C
2878C               *****************************************
2879C               **  STEP 20--                          **
2880C               **  BRANCH TO THE APPROPRIATE CASE--   **
2881C               **    1) WRITE OUT TO   MASS STORGE;   **
2882C               **    2) READ IN   FROM MASS STORAGE.  **
2883C               *****************************************
2884C
2885      ISTEPN='20'
2886      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
2887     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2888C
2889      IF(IOP3.EQ.'WRIT')GOTO2100
2890      GOTO2200
2891C
2892C               ******************************************
2893C               **  STEP 21--                           **
2894C               **  WRITE THE V(.) VECTOR               **
2895C               **  OUT TO THE MASS STORAGE FILE        **
2896C               **  WITH NUMERIC DESIGNATION    ISCRNU  **
2897C               ******************************************
2898C
2899 2100 CONTINUE
2900      ISTEPN='21'
2901      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
2902     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2903C
2904      MAXN2=0
2905      MAXCO2=0
2906      MAXIJ2=0
2907C
2908      IF(NUMNAM.LE.0)GOTO2129
2909      DO2110J=1,NUMNAM
2910      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWAP')GOTO2119
2911      WRITE(ICOUT,2111)J,IHNAME(J),IHNAM2(J),IUSE(J),IN(J),IVALUE(J)
2912 2111 FORMAT('J,IHNAME(J),IHNAM2(J),ISE(J),IN(J),IVALUE(J) = ',
2913     1I8,2X,A4,2X,A4,2X,A4,I8,I8)
2914      CALL DPWRST('XXX','BUG ')
2915 2119 CONTINUE
2916      IF(IHNAME(J).EQ.'PRED'.AND.IHNAM2(J).EQ.'    ')GOTO2110
2917      IF(IHNAME(J).EQ.'RES '.AND.IHNAM2(J).EQ.'    ')GOTO2110
2918      IF(IUSE(J).EQ.'V')GOTO2115
2919      GOTO2110
2920 2115 CONTINUE
2921      IROW=IN(J)
2922      ICOL=IVALUE(J)
2923      IF(ICOL.GT.MAXCOL)GOTO2110
2924      IF(IROW.GT.MAXN2)MAXN2=IROW
2925      IF(ICOL.GT.MAXCO2)MAXCO2=ICOL
2926 2110 CONTINUE
2927 2129 CONTINUE
2928C
2929      MAXIJ2=MAXN*(MAXCO2-1)+MAXN2
2930      IF(MAXIJ2.LE.0)GOTO9000
2931C
2932      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
2933     1WRITE(ICOUT,999)
2934      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
2935     1CALL DPWRST('XXX','BUG ')
2936      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
2937     1WRITE(ICOUT,2191)
2938 2191 FORMAT('***** A SWAP OUT IS ABOUT TO BE EXECUTED.')
2939      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
2940     1CALL DPWRST('XXX','BUG ')
2941C
2942      IDEV='SCRA'
2943C
2944      IREWIN='ON'
2945      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
2946     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
2947      IF(IERRFI.EQ.'YES')GOTO9000
2948C
2949CCCCC IF(MAXIJ2.GE.1)WRITE(IOUNIT)(V(IJ),IJ=1,MAXIJ2)
2950C
2951C  OCTOBER 1991.  SUN HAS LIMIT (SEEMS TO BE 2,046 WORDS) ON NUMBER OF
2952C  WORDS THAT CAN BE WRITTEN IN ONE RECORD.  ABOVE LINE REPLACED WITH
2953C  FOLLOWING BLOCK OF CODE.
2954C
2955C  MAY 2009.  ABOVE ISSUE IS NO LONGER A PROBLEM.  HOWEVER, WITH THE
2956C             LARGER DATA SET SIZE NOW SUPPORTED BY DATAPLOT, THIS ROUTINE
2957C             IS BECOMING A BIT OF A POTENTIAL BOTTLE NECK.  SPECIFICALLY,
2958C
2959C             1) IF WE USE
2960C
2961C                   WRITE(IOUNT)V
2962C
2963C                WE DECREASE THE CPU TIME USED.  HOWEVER, IT INCREASES
2964C                THE WALL CLOCK TIME (WRITING 10,0000,0000 VALUES AT
2965C                ONE TIME PROBABLY INCREASES "SWAPPING" ISSUES).
2966C
2967C             2) IF WE USE
2968C
2969C                   WRITE(IOUNT)(V(IJ),IJ=1,MAXIJ2)
2970C
2971C                 WE GREATLY INCREASE THE CPU TIME.
2972C
2973C             FOR NOW, I WILL WRITE OUT IN CHUNKS OF 10,000 (THIS WILL BE
2974C             SET IN MAXWRD).
2975C
2976      IF(MAXIJ2.GE.1)THEN
2977CCCCC   WRITE(IOUNIT)(V(IJ),IJ=1,MAXIJ2)
2978CCCCC   WRITE(IOUNIT)V
2979C
2980CCCCC   MAXWRD=100000
2981CCCCC   MAXWRD=1000000
2982CCCCC   IF(IHOST1.EQ.'SUN')MAXWRD=2046
2983        MAXWRD=10000
2984        IF(MAXWRD.EQ.MAXOBW)THEN
2985          WRITE(IOUNIT)V
2986          GOTO2199
2987        ENDIF
2988        NLOOPF=(MAXIJ2/MAXWRD)+1
2989        IF(NLOOPF.LT.1)GOTO2197
2990        DO2192IK=1,NLOOPF
2991          JSTART=(IK-1)*MAXWRD+1
2992          IF(JSTART.GT.MAXIJ2)GOTO2197
2993          JSTOP=IK*MAXWRD
2994          IF(JSTOP.GT.MAXIJ2)JSTOP=MAXIJ2
2995          WRITE(IOUNIT) (V(IJ),IJ=JSTART,JSTOP)
2996 2192   CONTINUE
2997 2197   CONTINUE
2998 2199   CONTINUE
2999C
3000      ENDIF
3001C  END CHANGE
3002C
3003      IENDFI='OFF'
3004      IREWIN='ON'
3005      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
3006     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
3007C
3008      GOTO9000
3009C
3010C               ******************************************
3011C               **  STEP 22--                           **
3012C               **  READ  THE V(.) VECTOR               **
3013C               **  IN FROM THE MASS STORAGE FILE       **
3014C               **  WITH NUMERIC DESIGNATION    ISCRNU  **
3015C               ******************************************
3016C
3017 2200 CONTINUE
3018      ISTEPN='22'
3019      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
3020     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3021C
3022      IF(MAXIJ2.LE.0)GOTO9000
3023C
3024      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
3025     1WRITE(ICOUT,999)
3026      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
3027     1CALL DPWRST('XXX','BUG ')
3028      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
3029     1WRITE(ICOUT,2291)
3030 2291 FORMAT('***** A SWAP IN  IS ABOUT TO BE EXECUTED.')
3031      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWAP')
3032     1CALL DPWRST('XXX','BUG ')
3033C
3034      IDEV='SCRA'
3035C
3036      IREWIN='ON'
3037      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
3038     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
3039      IF(IERRFI.EQ.'YES')GOTO9000
3040C
3041CCCCC IF(MAXIJ2.GE.1)READ(IOUNIT)(V(IJ),IJ=1,MAXIJ2)
3042C
3043C  OCTOBER 1991.  SUN HAS LIMIT (SEEMS TO BE 2,046 WORDS) ON NUMBER OF
3044C  WORDS THAT CAN BE WRITTEN IN ONE RECORD.  ABOVE LINE REPLACED WITH
3045C  FOLLOWING BLOCK OF CODE.
3046C
3047C  MAY 2009.  SEE COMMENTS ABOVE FOR WRITE CASE.
3048C
3049      IF(MAXIJ2.GE.1)THEN
3050CCCCC   READ(IOUNIT)(V(IJ),IJ=1,MAXIJ2)
3051CCCCC   READ(IOUNIT)V
3052CCCCC   MAXWRD=100000
3053CCCCC   MAXWRD=1000000
3054CCCCC   IF(IHOST1.EQ.'SUN')MAXWRD=2046
3055        MAXWRD=10000
3056        IF(MAXWRD.EQ.MAXOBW)THEN
3057          READ(IOUNIT)V
3058          GOTO2299
3059        ENDIF
3060        NLOOPF=(MAXIJ2/MAXWRD)+1
3061        IF(NLOOPF.LT.1)GOTO2297
3062        DO2292IK=1,NLOOPF
3063          JSTART=(IK-1)*MAXWRD+1
3064          IF(JSTART.GT.MAXIJ2)GOTO2297
3065          JSTOP=IK*MAXWRD
3066          IF(JSTOP.GT.MAXIJ2)JSTOP=MAXIJ2
3067          READ(IOUNIT) (V(IJ),IJ=JSTART,JSTOP)
3068 2292   CONTINUE
3069 2297   CONTINUE
3070 2299   CONTINUE
3071      ENDIF
3072C  END CHANGE
3073C
3074      IENDFI='OFF'
3075      IREWIN='ON'
3076      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
3077     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
3078C
3079      GOTO9000
3080C
3081C               *****************
3082C               **  STEP 90--  **
3083C               **  EXIT.      **
3084C               *****************
3085C
3086 9000 CONTINUE
3087      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWAP')GOTO9090
3088      WRITE(ICOUT,999)
3089      CALL DPWRST('XXX','BUG ')
3090      WRITE(ICOUT,9011)
3091 9011 FORMAT('***** AT THE END       OF DPSWAP--')
3092      CALL DPWRST('XXX','BUG ')
3093      WRITE(ICOUT,9013)IBUGS2,IOP3
3094 9013 FORMAT('IBUGS2,IOP3 = ',A4,2X,A4)
3095      CALL DPWRST('XXX','BUG ')
3096      WRITE(ICOUT,9014)MAXN2,MAXCO2,MAXIJ2
3097 9014 FORMAT('MAXN2,MAXCO2,MAXIJ2 = ',3I8)
3098      CALL DPWRST('XXX','BUG ')
3099      WRITE(ICOUT,9019)IBUGS2,ISUBRO,IERROR
3100 9019 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
3101      CALL DPWRST('XXX','BUG ')
3102      WRITE(ICOUT,9021)IOUNIT
3103 9021 FORMAT('IOUNIT = ',I8)
3104      CALL DPWRST('XXX','BUG ')
3105      WRITE(ICOUT,9022)IFILE
3106 9022 FORMAT('IFILE  = ',A80)
3107      CALL DPWRST('XXX','BUG ')
3108      WRITE(ICOUT,9023)ISTAT
3109 9023 FORMAT('ISTAT  = ',A12)
3110      CALL DPWRST('XXX','BUG ')
3111      WRITE(ICOUT,9024)IFORM
3112 9024 FORMAT('IFORM  = ',A12)
3113      CALL DPWRST('XXX','BUG ')
3114      WRITE(ICOUT,9025)IACCES
3115 9025 FORMAT('IACCES = ',A12)
3116      CALL DPWRST('XXX','BUG ')
3117      WRITE(ICOUT,9026)IPROT
3118 9026 FORMAT('IPROT  = ',A12)
3119      CALL DPWRST('XXX','BUG ')
3120      WRITE(ICOUT,9027)ICURST
3121 9027 FORMAT('ICURST = ',A12)
3122      CALL DPWRST('XXX','BUG ')
3123      WRITE(ICOUT,9028)IENDFI
3124 9028 FORMAT('IENDFI = ',A4)
3125      CALL DPWRST('XXX','BUG ')
3126      WRITE(ICOUT,9029)IREWIN
3127 9029 FORMAT('IREWIN = ',A4)
3128      CALL DPWRST('XXX','BUG ')
3129      WRITE(ICOUT,9031)ISUBN0
3130 9031 FORMAT('ISUBN0 = ',A12)
3131      CALL DPWRST('XXX','BUG ')
3132      WRITE(ICOUT,9032)IERRFI
3133 9032 FORMAT('IERRFI = ',A12)
3134      CALL DPWRST('XXX','BUG ')
3135 9090 CONTINUE
3136C
3137      RETURN
3138      END
3139      SUBROUTINE DPSWA2(IOP3,IFILE,V,MAXIJ2,IBUGS2,ISUBRO,IERROR)
3140C
3141C     PURPOSE--SWAP (WRITE OUT OR READ IN) THE VECTOR V(.)
3142C              FROM MASS STORAGE.
3143C              THIS IS A VARIATION OF DPSWAP.  THE DIFFERENCE
3144C              IS THAT THIS READS/WRITES AN ARBITRARY MATRIX,
3145C              NOT NECCESSARILY THE INTERNAL V MATRIX, WITH
3146C              MAXIJ2 DEFINING THE NUMBER OF VALUES TO READ/WRITE.
3147C     WRITTEN BY--JAMES J. FILLIBEN
3148C                 STATISTICAL ENGINEERING DIVISION
3149C                 INFORMATION TECHNOLOGY LABORATORY
3150C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3151C                 GAITHERSBURG, MD 20899-8980
3152C                 PHONE--301-975-2899
3153C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3154C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3155C     LANGUAGE--ANSI FORTRAN (1977)
3156C     VERSION NUMBER--97/8
3157C     ORIGINAL VERSION--AUGUST    1997.
3158C
3159C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3160C
3161      CHARACTER*4 IOP3
3162      CHARACTER*4 IBUGS2
3163      CHARACTER*4 ISUBRO
3164      CHARACTER*4 IERROR
3165C
3166      INCLUDE 'DPCOPA.INC'
3167C
3168CCCCC CHARACTER*80 IFILE
3169      CHARACTER (LEN=MAXFNC) :: IFILE
3170      CHARACTER*12 ISTAT
3171      CHARACTER*12 IFORM
3172      CHARACTER*12 IACCES
3173      CHARACTER*12 IPROT
3174      CHARACTER*12 ICURST
3175      CHARACTER*4 IENDFI
3176      CHARACTER*4 IREWIN
3177      CHARACTER*4 ISUBN0
3178      CHARACTER*4 IERRFI
3179C
3180      CHARACTER*4 ISTEPN
3181      CHARACTER*4 ISUBN1
3182      CHARACTER*4 ISUBN2
3183C
3184      DOUBLE PRECISION V(*)
3185C
3186C-----COMMON----------------------------------------------------------
3187C
3188      INCLUDE 'DPCOFO.INC'
3189      INCLUDE 'DPCOF2.INC'
3190      INCLUDE 'DPCOHO.INC'
3191      INCLUDE 'DPCOP2.INC'
3192C
3193C-----START POINT-----------------------------------------------------
3194C
3195      ISUBN1='DPSW'
3196      ISUBN2='A2  '
3197      ISUBN0='SWA2'
3198      IERROR='NO'
3199      IWIDTH=(-999)
3200C
3201      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWA2')GOTO90
3202      WRITE(ICOUT,999)
3203  999 FORMAT(1X)
3204      CALL DPWRST('XXX','BUG ')
3205      WRITE(ICOUT,51)
3206   51 FORMAT('***** AT THE BEGINNING OF DPSWA2--')
3207      CALL DPWRST('XXX','BUG ')
3208      WRITE(ICOUT,53)IBUGS2,IOP3
3209   53 FORMAT('IBUGS2,IOP3 = ',A4,2X,A4)
3210      CALL DPWRST('XXX','BUG ')
3211      WRITE(ICOUT,54)V(1),V(2),V(3)
3212   54 FORMAT('V(1),V(2),V(3) = ',3E15.7)
3213      CALL DPWRST('XXX','BUG ')
3214      WRITE(ICOUT,71)ISCRNU
3215   71 FORMAT('ISCRNU = ',I8)
3216      CALL DPWRST('XXX','BUG ')
3217      WRITE(ICOUT,72)ISCRNA(1:80)
3218   72 FORMAT('ISCRNA = ',A80)
3219      CALL DPWRST('XXX','BUG ')
3220      WRITE(ICOUT,73)ISCRST
3221   73 FORMAT('ISCRST = ',A12)
3222      CALL DPWRST('XXX','BUG ')
3223      WRITE(ICOUT,74)ISCRFO
3224   74 FORMAT('ISCRFO = ',A12)
3225      CALL DPWRST('XXX','BUG ')
3226      WRITE(ICOUT,75)ISCRAC
3227   75 FORMAT('ISCRAC = ',A12)
3228      CALL DPWRST('XXX','BUG ')
3229      WRITE(ICOUT,76)ISCRFO
3230   76 FORMAT('ISCRFO = ',A12)
3231      CALL DPWRST('XXX','BUG ')
3232      WRITE(ICOUT,77)ISCRCS
3233   77 FORMAT('ISCRCS = ',A12)
3234      CALL DPWRST('XXX','BUG ')
3235   90 CONTINUE
3236C
3237C               **************************
3238C               **  STEP 11--           **
3239C               **  COPY OVER VARIABLES **
3240C               **************************
3241C
3242      ISTEPN='11'
3243      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3244     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3245C
3246      IOUNIT=ISCRNU
3247CCCCC PASS IN FILE NAME, RECIPE CODE USES MULTIPLE SCRATCH FILES.
3248CCCCC IFILE=ISCRNA
3249      ISTAT=ISCRST
3250      IFORM=ISCRFO
3251      IACCES=ISCRAC
3252      IPROT=ISCRPR
3253      ICURST=ISCRCS
3254C
3255      ISUBN0='SWA2'
3256      IERRFI='NO'
3257C
3258      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWA2')GOTO1199
3259      WRITE(ICOUT,1193)IOUNIT
3260 1193 FORMAT('IOUNIT = ',I8)
3261      CALL DPWRST('XXX','BUG ')
3262      WRITE(ICOUT,1194)IFILE
3263 1194 FORMAT('IFILE = ',A80)
3264      CALL DPWRST('XXX','BUG ')
3265      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
3266 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
3267     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
3268      CALL DPWRST('XXX','BUG ')
3269      WRITE(ICOUT,1196)ISUBN0,IERRFI
3270 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
3271      CALL DPWRST('XXX','BUG ')
3272 1199 CONTINUE
3273C
3274C               **********************************************
3275C               **  STEP 12--                               **
3276C               **  CHECK TO SEE IF SCRATCH FILE MAY EXIST  **
3277C               **********************************************
3278C
3279      ISTEPN='12'
3280      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3281     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3282C
3283      IF(ISTAT.EQ.'NONE')GOTO1200
3284      GOTO1290
3285 1200 CONTINUE
3286      IERROR='YES'
3287      WRITE(ICOUT,999)
3288      CALL DPWRST('XXX','BUG ')
3289      WRITE(ICOUT,1211)
3290 1211 FORMAT('***** IMPLEMENTATION ERROR IN DPSWA2--')
3291      CALL DPWRST('XXX','BUG ')
3292      WRITE(ICOUT,1212)
3293 1212 FORMAT('      THE DESIRED RECIPE OPERATION REQUIRES THE ')
3294      CALL DPWRST('XXX','BUG ')
3295      WRITE(ICOUT,1213)
3296 1213 FORMAT('      BEHIND-THE-SCENES USE OF A SCRATCH FILE;')
3297      CALL DPWRST('XXX','BUG ')
3298      WRITE(ICOUT,1214)
3299 1214 FORMAT('      BUT THE USE OF SUCH A SCRATCH FILE ')
3300      CALL DPWRST('XXX','BUG ')
3301      WRITE(ICOUT,1215)
3302 1215 FORMAT('      CANNOT BE DONE BECAUSE')
3303      CALL DPWRST('XXX','BUG ')
3304      WRITE(ICOUT,1216)
3305 1216 FORMAT('      THE INTERNAL VARIABLE    ISCRST ')
3306      CALL DPWRST('XXX','BUG ')
3307      WRITE(ICOUT,1217)
3308 1217 FORMAT('      WHICH ALLOWS SUCH SCRATCH FILE USE')
3309      CALL DPWRST('XXX','BUG ')
3310      WRITE(ICOUT,1218)
3311 1218 FORMAT('      HAS BEEN SET TO    NONE.')
3312      CALL DPWRST('XXX','BUG ')
3313      WRITE(ICOUT,1219)ISTAT,ISCRST
3314 1219 FORMAT('ISTAT,ISCRST = ',A12,2X,A12)
3315      CALL DPWRST('XXX','BUG ')
3316      WRITE(ICOUT,1220)
3317 1220 FORMAT('      PLEASE CONTACT THE DATAPLOT IMPLEMENTOR')
3318      CALL DPWRST('XXX','BUG ')
3319      WRITE(ICOUT,1221)
3320 1221 FORMAT('      AND HAVE THE ISCRST SETTING CHANGED')
3321      CALL DPWRST('XXX','BUG ')
3322      WRITE(ICOUT,1222)
3323 1222 FORMAT('      (FROM   NONE   TO   UNKNOWN)')
3324      CALL DPWRST('XXX','BUG ')
3325      WRITE(ICOUT,1223)
3326 1223 FORMAT('      IN SUBROUTINE INITFO.')
3327      CALL DPWRST('XXX','BUG ')
3328      GOTO9000
3329 1290 CONTINUE
3330C
3331C               *****************************************
3332C               **  STEP 20--                          **
3333C               **  BRANCH TO THE APPROPRIATE CASE--   **
3334C               **    1) WRITE OUT TO   MASS STORGE;   **
3335C               **    2) READ IN   FROM MASS STORAGE.  **
3336C               *****************************************
3337C
3338      ISTEPN='20'
3339      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3340     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3341C
3342      IF(IOP3.EQ.'WRIT')GOTO2100
3343      GOTO2200
3344C
3345C               ******************************************
3346C               **  STEP 21--                           **
3347C               **  WRITE THE V(.) VECTOR               **
3348C               **  OUT TO THE MASS STORAGE FILE        **
3349C               **  WITH NUMERIC DESIGNATION    ISCRNU  **
3350C               ******************************************
3351C
3352 2100 CONTINUE
3353      ISTEPN='21'
3354      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3355     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3356C
3357C
3358      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3359     1WRITE(ICOUT,999)
3360      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3361     1CALL DPWRST('XXX','BUG ')
3362      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3363     1WRITE(ICOUT,2191)
3364 2191 FORMAT('***** A SWAP OUT IS ABOUT TO BE EXECUTED.')
3365      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3366     1CALL DPWRST('XXX','BUG ')
3367C
3368      IDEV='SCRA'
3369C
3370      IREWIN='ON'
3371      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
3372     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
3373      IF(IERRFI.EQ.'YES')GOTO9000
3374C
3375      IF(MAXIJ2.LT.1)GOTO2199
3376      MAXWRD=100000
3377      IF(IHOST1.EQ.'SUN')MAXWRD=2046
3378      NLOOPF=(MAXIJ2/MAXWRD)+1
3379      IF(NLOOPF.LT.1)GOTO2197
3380      DO2192IK=1,NLOOPF
3381      JSTART=(IK-1)*MAXWRD+1
3382      IF(JSTART.GT.MAXIJ2)GOTO2197
3383      JSTOP=IK*MAXWRD
3384      IF(JSTOP.GT.MAXIJ2)JSTOP=MAXIJ2
3385      WRITE(IOUNIT) (V(IJ),IJ=JSTART,JSTOP)
3386 2192 CONTINUE
3387 2197 CONTINUE
3388 2199 CONTINUE
3389C  END CHANGE
3390C
3391      IENDFI='OFF'
3392      IREWIN='ON'
3393      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
3394     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
3395C
3396      GOTO9000
3397C
3398C               ******************************************
3399C               **  STEP 22--                           **
3400C               **  READ  THE V(.) VECTOR               **
3401C               **  IN FROM THE MASS STORAGE FILE       **
3402C               **  WITH NUMERIC DESIGNATION    ISCRNU  **
3403C               ******************************************
3404C
3405 2200 CONTINUE
3406      ISTEPN='22'
3407      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3408     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3409C
3410      IF(MAXIJ2.LE.0)GOTO9000
3411C
3412      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3413     1WRITE(ICOUT,999)
3414      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3415     1CALL DPWRST('XXX','BUG ')
3416      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3417     1WRITE(ICOUT,2291)
3418 2291 FORMAT('***** A SWAP IN  IS ABOUT TO BE EXECUTED.')
3419      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SWA2')
3420     1CALL DPWRST('XXX','BUG ')
3421C
3422      IDEV='SCRA'
3423C
3424      IREWIN='ON'
3425      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
3426     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
3427      IF(IERRFI.EQ.'YES')GOTO9000
3428C
3429      IF(MAXIJ2.LT.1)GOTO2299
3430      MAXWRD=100000
3431      IF(IHOST1.EQ.'SUN')MAXWRD=2046
3432      NLOOPF=(MAXIJ2/MAXWRD)+1
3433      IF(NLOOPF.LT.1)GOTO2297
3434      DO2292IK=1,NLOOPF
3435      JSTART=(IK-1)*MAXWRD+1
3436      IF(JSTART.GT.MAXIJ2)GOTO2297
3437      JSTOP=IK*MAXWRD
3438      IF(JSTOP.GT.MAXIJ2)JSTOP=MAXIJ2
3439      READ(IOUNIT) (V(IJ),IJ=JSTART,JSTOP)
3440 2292 CONTINUE
3441 2297 CONTINUE
3442 2299 CONTINUE
3443C  END CHANGE
3444C
3445      IENDFI='OFF'
3446      IREWIN='ON'
3447      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
3448     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
3449C
3450      GOTO9000
3451C
3452C               *****************
3453C               **  STEP 90--  **
3454C               **  EXIT.      **
3455C               *****************
3456C
3457 9000 CONTINUE
3458      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SWA2')GOTO9090
3459      WRITE(ICOUT,999)
3460      CALL DPWRST('XXX','BUG ')
3461      WRITE(ICOUT,9011)
3462 9011 FORMAT('***** AT THE END       OF DPSWA2--')
3463      CALL DPWRST('XXX','BUG ')
3464      WRITE(ICOUT,9013)IBUGS2,IOP3
3465 9013 FORMAT('IBUGS2,IOP3 = ',A4,2X,A4)
3466      CALL DPWRST('XXX','BUG ')
3467      WRITE(ICOUT,9014)MAXIJ2
3468 9014 FORMAT('MAXIJ2 = ',I8)
3469      CALL DPWRST('XXX','BUG ')
3470      WRITE(ICOUT,9019)IBUGS2,ISUBRO,IERROR
3471 9019 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
3472      CALL DPWRST('XXX','BUG ')
3473      WRITE(ICOUT,9021)IOUNIT
3474 9021 FORMAT('IOUNIT = ',I8)
3475      CALL DPWRST('XXX','BUG ')
3476      WRITE(ICOUT,9022)IFILE(1:80)
3477 9022 FORMAT('IFILE  = ',A80)
3478      CALL DPWRST('XXX','BUG ')
3479      WRITE(ICOUT,9023)ISTAT
3480 9023 FORMAT('ISTAT  = ',A12)
3481      CALL DPWRST('XXX','BUG ')
3482      WRITE(ICOUT,9024)IFORM
3483 9024 FORMAT('IFORM  = ',A12)
3484      CALL DPWRST('XXX','BUG ')
3485      WRITE(ICOUT,9025)IACCES
3486 9025 FORMAT('IACCES = ',A12)
3487      CALL DPWRST('XXX','BUG ')
3488      WRITE(ICOUT,9026)IPROT
3489 9026 FORMAT('IPROT  = ',A12)
3490      CALL DPWRST('XXX','BUG ')
3491      WRITE(ICOUT,9027)ICURST
3492 9027 FORMAT('ICURST = ',A12)
3493      CALL DPWRST('XXX','BUG ')
3494      WRITE(ICOUT,9028)IENDFI
3495 9028 FORMAT('IENDFI = ',A4)
3496      CALL DPWRST('XXX','BUG ')
3497      WRITE(ICOUT,9029)IREWIN
3498 9029 FORMAT('IREWIN = ',A4)
3499      CALL DPWRST('XXX','BUG ')
3500      WRITE(ICOUT,9031)ISUBN0
3501 9031 FORMAT('ISUBN0 = ',A12)
3502      CALL DPWRST('XXX','BUG ')
3503      WRITE(ICOUT,9032)IERRFI
3504 9032 FORMAT('IERRFI = ',A12)
3505      CALL DPWRST('XXX','BUG ')
3506 9090 CONTINUE
3507C
3508      RETURN
3509      END
3510      SUBROUTINE DPSYMB(IHARG,NUMARG,IDEFSY,ITEXSY,
3511     1                  IBUGD2,ISUBRO,IFOUND,IERROR)
3512C
3513C     PURPOSE--DEFINE THE SYMBOL CHARACTER WHICH MAY
3514C              BE USED TO DENOTE IN-LINE TEXT SUB-COMMANDS.
3515C              WHEN A TEXT STRING IS PROCESSED,
3516C              IT IS SCANNED FOR THE SYMBOL CHARACTER;
3517C              IF IT IS FOUND, THE IN-LINE SUB-COMMAND
3518C              BEFORE THE SYMBOL CHARACTER IS EXECUTED
3519C              RATHER THAN THE LITERAL TEXT SUB-STRING BEING WRITTEN OUT.
3520C              ANY NUMBER OF SYMBOL CHARACTERS ARE ALLOWED PER LINE.
3521C              THE SYMBOL CHARACTER CAPABILITY ALLOWS THE ANALYST
3522C              TO WRITE GREEK, MATH, AND OTHER SPECIAL SYMBOLS.
3523C              THE SPECIFIED SYMBOL CHARACTER WILL BE PLACED
3524C              IN THE CHARACTER VARIABLE ITEXSY.
3525C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
3526C                     --NUMARG (AN INTEGER VARIABLE)
3527C                     --IDEFSY (A  CHARACTER VARIABLE)
3528C                     --IBUGD2 (A  CHARACTER VARIABLE)
3529C     OUTPUT ARGUMENTS--ITEXSY (A CHARACTER VARIABLE)
3530C                     --IFOUND ('YES' OR 'NO' )
3531C                     --IERROR ('YES' OR 'NO' )
3532C     WRITTEN BY--JAMES J. FILLIBEN
3533C                 STATISTICAL ENGINEERING DIVISION
3534C                 INFORMATION TECHNOLOGY LABORATORY
3535C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3536C                 GAITHERSBURG, MD 20899-8980
3537C                 PHONE--301-975-2899
3538C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3539C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3540C     LANGUAGE--ANSI FORTRAN (1977)
3541C     VERSION NUMBER--82/7
3542C     ORIGINAL VERSION--NOVEMBER 1980.
3543C     UPDATED         --MAY       1982.
3544C
3545C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3546C
3547      CHARACTER*4 IHARG
3548      CHARACTER*4 IDEFSY
3549      CHARACTER*4 ITEXSY
3550      CHARACTER*4 IBUGD2
3551      CHARACTER*4 ISUBRO
3552      CHARACTER*4 IFOUND
3553      CHARACTER*4 IERROR
3554C
3555      CHARACTER*4 IHOLD
3556C
3557C---------------------------------------------------------------------
3558C
3559      DIMENSION IHARG(*)
3560C
3561C-----COMMON----------------------------------------------------------
3562C
3563      INCLUDE 'DPCOP2.INC'
3564C
3565C-----START POINT-----------------------------------------------------
3566C
3567      IFOUND='NO'
3568      IERROR='NO'
3569C
3570      IF(IBUGD2.EQ.'OFF')GOTO90
3571      WRITE(ICOUT,999)
3572  999 FORMAT(1X)
3573      CALL DPWRST('XXX','BUG ')
3574      WRITE(ICOUT,51)
3575   51 FORMAT('***** AT THE BEGINNING OF DPSYMB--')
3576      CALL DPWRST('XXX','BUG ')
3577      WRITE(ICOUT,53)IDEFSY
3578   53 FORMAT('IDEFSY = ',A4)
3579      CALL DPWRST('XXX','BUG ')
3580      WRITE(ICOUT,54)NUMARG
3581   54 FORMAT('NUMARG = ',I8)
3582      CALL DPWRST('XXX','BUG ')
3583      DO55I=1,NUMARG
3584      WRITE(ICOUT,56)I,IHARG(I)
3585   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
3586      CALL DPWRST('XXX','BUG ')
3587   55 CONTINUE
3588   90 CONTINUE
3589C
3590      IF(NUMARG.LE.0)GOTO1150
3591      GOTO1110
3592C
3593 1110 CONTINUE
3594      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
3595      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
3596      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
3597      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
3598      GOTO1160
3599C
3600 1150 CONTINUE
3601      IHOLD=IDEFSY
3602      GOTO1180
3603C
3604 1160 CONTINUE
3605      IHOLD=IHARG(NUMARG)
3606      GOTO1180
3607C
3608 1180 CONTINUE
3609      IFOUND='YES'
3610      ITEXSY=IHOLD
3611C
3612      IF(IFEEDB.EQ.'OFF')GOTO1189
3613      WRITE(ICOUT,999)
3614      CALL DPWRST('XXX','BUG ')
3615      WRITE(ICOUT,1181)
3616 1181 FORMAT('THE SYMBOL CHARACTER (TO DENOTE')
3617      CALL DPWRST('XXX','BUG ')
3618      WRITE(ICOUT,1182)
3619 1182 FORMAT(' GREEK, MATH, AND OTHER SPECIAL SYMBOLS')
3620      CALL DPWRST('XXX','BUG ')
3621      WRITE(ICOUT,1183)
3622 1183 FORMAT('IN THE TEXT, TITLE, LABEL, AND LEGEND COMMANDS)')
3623      CALL DPWRST('XXX','BUG ')
3624      WRITE(ICOUT,1184)ITEXSY
3625 1184 FORMAT('HAS JUST BEEN SET TO ',A4)
3626      CALL DPWRST('XXX','BUG ')
3627 1189 CONTINUE
3628      GOTO9000
3629C
3630 9000 CONTINUE
3631      IF(IBUGD2.EQ.'OFF')GOTO9090
3632      WRITE(ICOUT,999)
3633      CALL DPWRST('XXX','BUG ')
3634      WRITE(ICOUT,9011)
3635 9011 FORMAT('***** AT THE END       OF DPSYMB--')
3636      CALL DPWRST('XXX','BUG ')
3637      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
3638 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
3639      CALL DPWRST('XXX','BUG ')
3640      WRITE(ICOUT,9013)IDEFSY,ITEXSY
3641 9013 FORMAT('IDEFSY,ITEXSY = ',A4,2X,A4)
3642      CALL DPWRST('XXX','BUG ')
3643 9090 CONTINUE
3644C
3645      RETURN
3646      END
3647      SUBROUTINE DPSYMM(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
3648     1                  IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
3649C
3650C     PURPOSE--GENERATE A SYMMETRY PLOT
3651C     WRITTEN BY--ALAN HECKERT
3652C                 STATISTICAL ENGINEERING DIVISION
3653C                 INFORMATION TECHNOLOGY LABORATORY
3654C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3655C                 GAITHERSBURG, MD 20899-8980
3656C                 PHONE--301-975-2899
3657C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3658C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3659C     LANGUAGE--ANSI FORTRAN (1977)
3660C     VERSION NUMBER--86/7
3661C     ORIGINAL VERSION--APRIL     1986.
3662C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
3663C     UPDATED         --NOVEMBER  2011. 1) USE DPPARS TO PERFORM
3664C                                          SOME OF THE PARSING
3665C                                       2) SUPPORT "REPLICATION" AND
3666C                                          "MULTIPLE" KEYWORDS
3667C                                       3) SUPPORT "HIGHLIGHT" OPTION
3668C
3669C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3670C
3671      CHARACTER*4 ICASPL
3672      CHARACTER*4 IAND1
3673      CHARACTER*4 IAND2
3674      CHARACTER*4 IBUGG2
3675      CHARACTER*4 IBUGG3
3676      CHARACTER*4 IBUGQ
3677      CHARACTER*4 ISUBRO
3678      CHARACTER*4 IFOUND
3679      CHARACTER*4 IERROR
3680C
3681      CHARACTER*4 IDATSW
3682      CHARACTER*4 IREPL
3683      CHARACTER*4 IHIGH
3684      CHARACTER*4 IWRITE
3685      CHARACTER*4 IMULT
3686      CHARACTER*4 IGROUP
3687      CHARACTER*4 ITERM1
3688      CHARACTER*4 ITERM2
3689      CHARACTER*4 ITERM3
3690      CHARACTER*4 ISUBN1
3691      CHARACTER*4 ISUBN2
3692      CHARACTER*4 ISTEPN
3693      CHARACTER*4 ICASE
3694C
3695      CHARACTER*40 INAME
3696      PARAMETER (MAXSPN=30)
3697      CHARACTER*4 IVARN1(MAXSPN)
3698      CHARACTER*4 IVARN2(MAXSPN)
3699      CHARACTER*4 IVARTY(MAXSPN)
3700      REAL PVAR(MAXSPN)
3701      INTEGER ILIS(MAXSPN)
3702      INTEGER NRIGHT(MAXSPN)
3703      INTEGER ICOLR(MAXSPN)
3704C
3705C---------------------------------------------------------------------
3706C
3707      INCLUDE 'DPCOPA.INC'
3708C
3709      DIMENSION Y1(MAXOBV)
3710      DIMENSION X1(MAXOBV)
3711      DIMENSION XTEMP1(MAXOBV)
3712      DIMENSION XTEMP2(MAXOBV)
3713      DIMENSION XTEMP3(MAXOBV)
3714      DIMENSION XTEMP4(MAXOBV)
3715      DIMENSION XDESGN(MAXOBV,6)
3716      DIMENSION XIDTEM(MAXOBV)
3717      DIMENSION XIDTE2(MAXOBV)
3718      DIMENSION ZY(MAXOBV)
3719      DIMENSION TAG1(MAXOBV)
3720CCCCC FOLLOWING LINES ADDED JUNE, 1990
3721      INCLUDE 'DPCOZZ.INC'
3722      EQUIVALENCE (GARBAG(IGARB1),X1(1))
3723      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
3724      EQUIVALENCE (GARBAG(IGARB3),XTEMP1(1))
3725      EQUIVALENCE (GARBAG(IGARB4),XTEMP2(1))
3726      EQUIVALENCE (GARBAG(IGARB5),XTEMP3(1))
3727      EQUIVALENCE (GARBAG(IGARB6),XTEMP4(1))
3728      EQUIVALENCE (GARBAG(IGARB7),XIDTEM(1))
3729      EQUIVALENCE (GARBAG(IGARB8),XIDTE2(1))
3730      EQUIVALENCE (GARBAG(IGARB9),ZY(1))
3731      EQUIVALENCE (GARBAG(JGAR11),TAG1(1))
3732      EQUIVALENCE (GARBAG(JGAR12),XDESGN(1,1))
3733CCCCC END CHANGE
3734C
3735C-----COMMON----------------------------------------------------------
3736C
3737      INCLUDE 'DPCOST.INC'
3738      INCLUDE 'DPCOHK.INC'
3739      INCLUDE 'DPCODA.INC'
3740      INCLUDE 'DPCOP2.INC'
3741C
3742C-----START POINT-----------------------------------------------------
3743C
3744      IERROR='NO'
3745      IFOUND='NO'
3746      ISUBN1='DPSY'
3747      ISUBN2='MM  '
3748C
3749      IHIGH='OFF'
3750      IMULT='OFF'
3751      IREPL='OFF'
3752      ICASE='NONE'
3753C
3754      MAXCP1=MAXCOL+1
3755      MAXCP2=MAXCOL+2
3756      MAXCP3=MAXCOL+3
3757      MAXCP4=MAXCOL+4
3758      MAXCP5=MAXCOL+5
3759      MAXCP6=MAXCOL+6
3760C
3761C               ***************************************
3762C               **  TREAT THE SYMMETRY    PLOT CASE  **
3763C               ***************************************
3764C
3765      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')THEN
3766        WRITE(ICOUT,999)
3767  999   FORMAT(1X)
3768        CALL DPWRST('XXX','BUG ')
3769        WRITE(ICOUT,51)
3770   51   FORMAT('***** AT THE BEGINNING OF DPSYMM--')
3771        CALL DPWRST('XXX','BUG ')
3772        WRITE(ICOUT,52)ICASPL,IAND1,IAND2
3773   52   FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
3774        CALL DPWRST('XXX','BUG ')
3775        WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ,ISUBRO
3776   53   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
3777        CALL DPWRST('XXX','BUG ')
3778      ENDIF
3779C
3780C               ***************************
3781C               **  STEP 1--             **
3782C               **  EXTRACT THE COMMAND  **
3783C               ***************************
3784C
3785C     LOOK FOR THE WORDS "SYMMETRY PLOT".  ALSO LOOK
3786C     FOR THE KEYWORDS "MULTIPLE", "REPLICATION", OR "HIGHLIGHT".
3787C
3788      ISTEPN='1'
3789      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
3790     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3791C
3792      ILASTC=-9999
3793      DO100I=0,NUMARG-1
3794C
3795        IF(I.EQ.0)THEN
3796          ITERM1=ICOM
3797          ITERM2=IHARG(I+1)
3798          ITERM3=IHARG(I+2)
3799        ELSE
3800          ITERM1=IHARG(I)
3801          ITERM2=IHARG(I+1)
3802          ITERM3=IHARG(I+2)
3803        ENDIF
3804C
3805        IF(ITERM1.EQ.'SYMM' .AND. ITERM2.EQ.'PLOT')THEN
3806          IFOUND='YES'
3807          ILASTC=MAX(ILASTC,I+1)
3808        ELSEIF(ITERM1.EQ.'REPL')THEN
3809          IREPL='ON'
3810          ILASTC=MAX(ILASTC,I)
3811        ELSEIF(ITERM1.EQ.'MULT')THEN
3812          IMULT='ON'
3813          ILASTC=MAX(ILASTC,I)
3814        ELSEIF(ITERM1.EQ.'HIGH')THEN
3815          IHIGH='ON'
3816          ILASTC=MAX(ILASTC,I)
3817        ELSEIF(ITERM1.EQ.'GROU' .OR. ITERM1.EQ.'BINN')THEN
3818          IGROUP='ON'
3819          ILASTC=MAX(ILASTC,I)
3820        ENDIF
3821  100 CONTINUE
3822C
3823      IF(IFOUND.EQ.'NO')GOTO9000
3824      IF(IMULT.EQ.'ON')THEN
3825        IF(IREPL.EQ.'ON')THEN
3826          WRITE(ICOUT,999)
3827          CALL DPWRST('XXX','BUG ')
3828          WRITE(ICOUT,101)
3829  101     FORMAT('***** ERROR IN SYMMETRY PLOT--')
3830          CALL DPWRST('XXX','BUG ')
3831          WRITE(ICOUT,102)
3832  102     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
3833     1           '"REPLICATION" FOR THE SYMMETRY PLOT.')
3834          CALL DPWRST('XXX','BUG ')
3835          IERROR='YES'
3836          GOTO9000
3837        ELSEIF(IHIGH.EQ.'ON')THEN
3838          WRITE(ICOUT,999)
3839          CALL DPWRST('XXX','BUG ')
3840          WRITE(ICOUT,101)
3841          CALL DPWRST('XXX','BUG ')
3842          WRITE(ICOUT,122)
3843  122     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
3844     1           '"HIGHTLIGHTED" FOR THE SYMMETRY PLOT.')
3845          CALL DPWRST('XXX','BUG ')
3846          IERROR='YES'
3847          GOTO9000
3848        ENDIF
3849      ENDIF
3850C
3851      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
3852      IFOUND='YES'
3853      ICASPL='SYMM'
3854C
3855C               *********************************
3856C               **  STEP 2--                   **
3857C               **  EXTRACT THE VARIABLE LIST  **
3858C               *********************************
3859C
3860      ISTEPN='4'
3861      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
3862     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3863C
3864      INAME='SYMMETRY PLOT'
3865      MINNA=1
3866      MAXNA=100
3867      MINN2=2
3868      IFLAGE=1
3869      IFLAGM=0
3870      IF(IMULT.EQ.'ON')THEN
3871        IFLAGE=0
3872        IFLAGM=1
3873      ELSE
3874         IF(IREPL.EQ.'OFF' .AND. IHIGH.EQ.'OFF')IFLAGM=1
3875      ENDIF
3876      IFLAGP=0
3877      JMIN=1
3878      JMAX=NUMARG
3879      IF(IMULT.EQ.'OFF' .AND. IHIGH.EQ.'OFF' .AND. IREPL.EQ.'OFF')THEN
3880        MINNVA=1
3881        MAXNVA=3
3882        IFLAGM=1
3883      ELSEIF(IHIGH.EQ.'ON')THEN
3884        MINNVA=2
3885        MAXNVA=3
3886        IFLAGM=0
3887      ELSE
3888        MINNVA=-99
3889        MAXNVA=-99
3890      ENDIF
3891C
3892      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
3893     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
3894     1            JMIN,JMAX,
3895     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
3896     1            IVARN1,IVARN2,IVARTY,PVAR,
3897     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
3898     1            MINNVA,MAXNVA,
3899     1            IFLAGM,IFLAGP,
3900     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
3901      IF(IERROR.EQ.'YES')GOTO9000
3902C
3903      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')THEN
3904        WRITE(ICOUT,999)
3905        CALL DPWRST('XXX','BUG ')
3906        WRITE(ICOUT,281)
3907  281   FORMAT('***** AFTER CALL DPPARS--')
3908        CALL DPWRST('XXX','BUG ')
3909        WRITE(ICOUT,282)NQ,NUMVAR
3910  282   FORMAT('NQ,NUMVAR = ',2I8)
3911        CALL DPWRST('XXX','BUG ')
3912        IF(NUMVAR.GT.0)THEN
3913          DO285I=1,NUMVAR
3914            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
3915     1                      ICOLR(I)
3916  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
3917     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
3918            CALL DPWRST('XXX','BUG ')
3919  285     CONTINUE
3920        ENDIF
3921      ENDIF
3922C
3923C               ***********************************************
3924C               **  STEP 3--                                 **
3925C               **  DETERMINE:                               **
3926C               **  1) NUMBER OF REPLICATION VARIABLES (0-2) **
3927C               **  2) NUMBER OF GROUPING    VARIABLES (0-2) **
3928C               **  3) NUMBER OF RESPONSE    VARIABLES (>= 1)**
3929C               **  4) NUMBER OF HIGHLIGHT   VARIABLES (0-2) **
3930C               ***********************************************
3931C
3932      ISTEPN='5'
3933      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
3934     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3935C
3936      NRESP=0
3937      NREPL=0
3938      NGROUP=0
3939      NHIGH=0
3940      IDATSW='RAW'
3941      IF(IMULT.EQ.'ON')THEN
3942        NRESP=NUMVAR
3943      ELSEIF(IHIGH.EQ.'ON')THEN
3944        NRESP=1
3945        NHIGH=NUMVAR-1
3946        IF(NHIGH.LT.1 .OR. NHIGH.GT.2)THEN
3947          WRITE(ICOUT,999)
3948          CALL DPWRST('XXX','BUG ')
3949          WRITE(ICOUT,101)
3950          CALL DPWRST('XXX','BUG ')
3951          WRITE(ICOUT,501)
3952  501     FORMAT('      FOR THE HIGHLIGHTED CASE, THE NUMBER OF ',
3953     1           'HIGHLIGHT VARIABLES')
3954          CALL DPWRST('XXX','BUG ')
3955          WRITE(ICOUT,502)
3956  502     FORMAT('      MUST BE ONE OR TWO;  SUCH WAS NOT THE ',
3957     1           'CASE HERE.')
3958          CALL DPWRST('XXX','BUG ')
3959          WRITE(ICOUT,503)NHIGH
3960  503     FORMAT('      THE NUMBER OF HIGHLIGHT VARIABLES = ',I5)
3961          CALL DPWRST('XXX','BUG ')
3962          IERROR='YES'
3963          GOTO9000
3964        ENDIF
3965      ELSEIF(IREPL.EQ.'ON')THEN
3966        NRESP=1
3967        NREPL=NUMVAR-NRESP
3968        IF(NREPL.LT.1 .OR. NREPL.GT.2)THEN
3969          WRITE(ICOUT,999)
3970          CALL DPWRST('XXX','BUG ')
3971          WRITE(ICOUT,101)
3972          CALL DPWRST('XXX','BUG ')
3973          WRITE(ICOUT,511)
3974  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
3975     1           'REPLICATION VARIABLES')
3976          CALL DPWRST('XXX','BUG ')
3977          WRITE(ICOUT,512)
3978  512     FORMAT('      MUST BE BETWEEN 1 AND 2;  SUCH WAS NOT THE ',
3979     1           'CASE HERE.')
3980          CALL DPWRST('XXX','BUG ')
3981          WRITE(ICOUT,513)NREPL
3982  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
3983          CALL DPWRST('XXX','BUG ')
3984          IERROR='YES'
3985          GOTO9000
3986        ENDIF
3987      ENDIF
3988C
3989C               *********************************************
3990C               **  STEP 7A--                              **
3991C               **  CASE 1: NO REPLICATION, NO MULTIPLE,   **
3992C               **          AND NO HIGHLIGHTING            **
3993C               *********************************************
3994C
3995C     FOR THIS CASE, CAN HAVE ONE TO TWO RESPONSE VARIABLES
3996C     (DEPDENDING ON WHETHER WE HAVE BINNED DATA OR RAW DATA).
3997C
3998C     FOR THIS CASE, ONLY SUPPORT MATRIX ARGUMENT FOR RAW DATA
3999C     NUMBER OF OBSERVATIONS MUST BE THE SAME FOR ALL VARIABLES.
4000C
4001      IF(IMULT.EQ.'OFF' .AND. NREPL.EQ.0 .AND. NHIGH.EQ.0)THEN
4002        ISTEPN='7A'
4003        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
4004     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4005C
4006        ICOL=1
4007        IF(NUMVAR.EQ.1)THEN
4008          IDATSW='RAW'
4009          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
4010     1                INAME,IVARN1,IVARN2,IVARTY,
4011     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
4012     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
4013     1                MAXCP4,MAXCP5,MAXCP6,
4014     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
4015     1                Y1,X1,XTEMP1,NLOCAL,NLOCA2,NLOCA3,ICASE,
4016     1                IBUGG3,ISUBRO,IFOUND,IERROR)
4017        ELSEIF(NUMVAR.EQ.2)THEN
4018          IDATSW='FREQ'
4019          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
4020     1                INAME,IVARN1,IVARN2,IVARTY,
4021     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
4022     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
4023     1                MAXCP4,MAXCP5,MAXCP6,
4024     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
4025     1                Y1,X1,XTEMP1,NLOCAL,NLOCA2,NLOCA3,ICASE,
4026     1                IBUGG3,ISUBRO,IFOUND,IERROR)
4027        ENDIF
4028        IF(ICASE.EQ.'MATR' .AND. NUMVAR.GT.1)THEN
4029          WRITE(ICOUT,999)
4030          CALL DPWRST('XXX','BUG ')
4031          WRITE(ICOUT,101)
4032          CALL DPWRST('XXX','BUG ')
4033          WRITE(ICOUT,701)
4034  701     FORMAT('      MATRIX ARGUMENTS ARE ONLY SUPPORTED FOR THE')
4035          CALL DPWRST('XXX','BUG ')
4036          WRITE(ICOUT,703)
4037  703     FORMAT('      RAW DATA CASE.')
4038          CALL DPWRST('XXX','BUG ')
4039          IERROR='YES'
4040          GOTO9000
4041        ELSEIF(NUMVAR.EQ.2 .AND. NLOCAL.NE.NLOCA2)THEN
4042          WRITE(ICOUT,999)
4043          CALL DPWRST('XXX','BUG ')
4044          WRITE(ICOUT,101)
4045          CALL DPWRST('XXX','BUG ')
4046          WRITE(ICOUT,711)
4047  711     FORMAT('      FOR THE FREQUENCY CASE, THE NUMBER OF ',
4048     1           'OBSERVATIONS FOR')
4049          CALL DPWRST('XXX','BUG ')
4050          WRITE(ICOUT,713)
4051  713     FORMAT('      THE TWO VARIABLES MUST BE EQUAL.')
4052          CALL DPWRST('XXX','BUG ')
4053          WRITE(ICOUT,715)IVARN1(1),IVARN2(1),NLOCAL
4054  715     FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
4055          CALL DPWRST('XXX','BUG ')
4056          WRITE(ICOUT,715)IVARN1(2),IVARN2(2),NLOCA2
4057          CALL DPWRST('XXX','BUG ')
4058          IERROR='YES'
4059          GOTO9000
4060        ENDIF
4061C
4062C       *****************************************************
4063C       **  STEP 7B--                                      **
4064C       **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
4065C       **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
4066C       **  RESET THE VECTOR D(.) TO ALL ONES.             **
4067C       **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
4068C       **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
4069C       *****************************************************
4070C
4071C
4072        IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'SYMM')THEN
4073          ISTEPN='7B'
4074          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4075          WRITE(ICOUT,999)
4076          CALL DPWRST('XXX','BUG ')
4077          WRITE(ICOUT,731)
4078  731     FORMAT('***** FROM THE MIDDLE  OF DPSYMM--')
4079          CALL DPWRST('XXX','BUG ')
4080          WRITE(ICOUT,732)ICASPL,NUMVAR,IDATSW,NLOCAL
4081  732     FORMAT('ICASPL,NUMVAR,IDATSW,NLOCAL = ',
4082     1           A4,I8,2X,A4,I8)
4083          CALL DPWRST('XXX','BUG ')
4084          IF(NLOCAL.GE.1)THEN
4085            DO735I=1,NLOCAL
4086              WRITE(ICOUT,736)I,Y1(I),X1(I)
4087  736         FORMAT('I,Y1(I),X1(I) = ',I8,2G15.7)
4088              CALL DPWRST('XXX','BUG ')
4089  735       CONTINUE
4090          ENDIF
4091        ENDIF
4092C
4093        NPLOTP=0
4094        NCURVE=1
4095        CALL DPSYM2(Y1,X1,NLOCAL,ICASPL,IDATSW,MAXOBV,
4096     1              NUMVAR,NCURVE,NHIGH,
4097     1              TAG1,XTEMP1,XTEMP2,
4098     1              Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
4099C
4100C               ******************************************
4101C               **  STEP 8A--                           **
4102C               **  CASE 2: MULTIPLE RESPONSE VARIABLES **
4103C               **          NOTE THAT HIGHLIGHTING AND  **
4104C               **          GROUPING ARE NOT SUPPORTED  **
4105C               **          FOR THIS CASE.              **
4106C               ******************************************
4107C
4108      ELSEIF(IMULT.EQ.'ON')THEN
4109        ISTEPN='8A'
4110        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
4111     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4112C
4113C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
4114C
4115        NPLOTP=0
4116        NCURVE=0
4117        DO810IRESP=1,NRESP
4118          NCURVE=NCURVE+1
4119C
4120          IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PERC')THEN
4121            WRITE(ICOUT,999)
4122            CALL DPWRST('XXX','BUG ')
4123            WRITE(ICOUT,811)IRESP,NCURVE
4124  811       FORMAT('IRESP,NCURVE = ',2I5)
4125            CALL DPWRST('XXX','BUG ')
4126          ENDIF
4127C
4128          ICOL=IRESP
4129          NUMVA2=1
4130          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
4131     1                INAME,IVARN1,IVARN2,IVARTY,
4132     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
4133     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
4134     1                MAXCP4,MAXCP5,MAXCP6,
4135     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
4136     1                Y1,XTEMP1,XTEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE,
4137     1                IBUGG3,ISUBRO,IFOUND,IERROR)
4138C
4139C         *****************************************************
4140C         **  STEP 8B--                                      **
4141C         **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
4142C         **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
4143C         **  RESET THE VECTOR D(.) TO ALL ONES.             **
4144C         **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
4145C         **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
4146C         *****************************************************
4147C
4148C
4149          IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'SYMM')THEN
4150            ISTEPN='8B'
4151            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4152            WRITE(ICOUT,999)
4153            CALL DPWRST('XXX','BUG ')
4154            WRITE(ICOUT,822)
4155  822       FORMAT('***** FROM THE MIDDLE  OF DPSYMM--')
4156            CALL DPWRST('XXX','BUG ')
4157            WRITE(ICOUT,823)ICASPL,NUMVAR,IDATSW,NLOCAL
4158  823       FORMAT('ICASPL,NUMVAR,IDATSW,NLOCAL = ',
4159     1             A4,I8,2X,A4,I8)
4160            CALL DPWRST('XXX','BUG ')
4161            IF(NLOCAL.GE.1)THEN
4162              DO825I=1,NLOCAL
4163                WRITE(ICOUT,826)I,Y1(I)
4164  826           FORMAT('I,X1(I) = ',I8,G15.7)
4165                CALL DPWRST('XXX','BUG ')
4166  825         CONTINUE
4167            ENDIF
4168          ENDIF
4169C
4170          CALL DPSYM2(Y1,X1,NLOCAL,ICASPL,IDATSW,MAXOBV,
4171     1                NUMVAR,NCURVE,NHIGH,
4172     1                TAG1,XTEMP1,XTEMP2,
4173     1                Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
4174  810   CONTINUE
4175C
4176C               ***************************************************
4177C               **  STEP 9A--                                    **
4178C               **  CASE 3: ONE OR MORE REPLICATION VARIABLES.   **
4179C               **          CURRENTLY, ONLY SUPPORT THIS OPTION  **
4180C               **          FOR UNBINNED DATA.                   **
4181C               ***************************************************
4182C
4183      ELSEIF(NRESP.GE.1 .AND. NREPL.GE.1)THEN
4184        ISTEPN='9A'
4185        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
4186     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4187C
4188        J=0
4189        IMAX=NRIGHT(1)
4190        IF(NQ.LT.NRIGHT(1))IMAX=NQ
4191        DO910I=1,IMAX
4192          IF(ISUB(I).EQ.0)GOTO910
4193          J=J+1
4194C
4195C         RESPONSE VARIABLE IN X1 (OR Y1 IF GROUPED DATA)
4196C
4197          IJ=MAXN*(ICOLR(1)-1)+I
4198          IF(ICOLR(1).LE.MAXCOL)Y1(J)=V(IJ)
4199          IF(ICOLR(1).EQ.MAXCP1)Y1(J)=PRED(I)
4200          IF(ICOLR(1).EQ.MAXCP2)Y1(J)=RES(I)
4201          IF(ICOLR(1).EQ.MAXCP3)Y1(J)=YPLOT(I)
4202          IF(ICOLR(1).EQ.MAXCP4)Y1(J)=XPLOT(I)
4203          IF(ICOLR(1).EQ.MAXCP5)Y1(J)=X2PLOT(I)
4204          IF(ICOLR(1).EQ.MAXCP6)Y1(J)=TAGPLO(I)
4205          ICOLC=1
4206C
4207          DO920IR=1,MIN(NREPL,2)
4208            ICOLC=ICOLC+1
4209            ICOLT=ICOLR(ICOLC)
4210            IJ=MAXN*(ICOLT-1)+I
4211            IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
4212            IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
4213            IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
4214            IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
4215            IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
4216            IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
4217            IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
4218  920     CONTINUE
4219C
4220  910   CONTINUE
4221        NLOCAL=J
4222C
4223C       *****************************************************
4224C       **  STEP 9B--                                      **
4225C       **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
4226C       **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
4227C       **                                                 **
4228C       **  FOR THIS CASE, WE NEED TO LOOP THROUGH THE     **
4229C       **  VARIOUS REPLICATIONS.                          **
4230C       *****************************************************
4231C
4232        IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'SYMM')THEN
4233          ISTEPN='9B'
4234          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4235          WRITE(ICOUT,999)
4236          CALL DPWRST('XXX','BUG ')
4237          WRITE(ICOUT,931)
4238  931     FORMAT('***** FROM THE MIDDLE  OF DPSYMM--')
4239          CALL DPWRST('XXX','BUG ')
4240          WRITE(ICOUT,932)ICASPL,NUMVAR,IDATSW,NLOCAL
4241  932     FORMAT('ICASPL,NUMVAR,IDATSW,NLOCAL = ',
4242     1           A4,I8,2X,A4,I8)
4243          CALL DPWRST('XXX','BUG ')
4244          IF(NLOCAL.GE.1)THEN
4245            DO935I=1,NLOCAL
4246              WRITE(ICOUT,936)I,Y1(I),XDESGN(I,1),XDESGN(I,2)
4247  936         FORMAT('I,Y1(I),XDESGN(I,1),XDESGN(I,2)=',I8,3G15.7)
4248              CALL DPWRST('XXX','BUG ')
4249  935       CONTINUE
4250          ENDIF
4251        ENDIF
4252C
4253C       *****************************************************
4254C       **  STEP 9C--                                      **
4255C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
4256C       **  REPLICATION VARIABLES.                         **
4257C       *****************************************************
4258C
4259        CALL DPPP5(XDESGN(1,1),XDESGN(1,2),XDESGN(1,3),
4260     1             XDESGN(1,4),XDESGN(1,5),XDESGN(1,6),
4261     1             NREPL,NLOCAL,MAXOBV,
4262     1             XIDTEM,XIDTE2,XIDTE2,XIDTE2,XIDTE2,XIDTE2,
4263     1             XTEMP1,XTEMP2,
4264     1             NUMSE1,NUMSE2,NUMSE3,NUMSE4,NUMSE5,NUMSE6,
4265     1             IBUGG3,ISUBRO,IERROR)
4266C
4267C       *****************************************************
4268C       **  STEP 9D--                                      **
4269C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
4270C       *****************************************************
4271C
4272        NPLOTP=0
4273        NCURVE=0
4274        IF(NREPL.EQ.1)THEN
4275          J=0
4276          DO1110ISET1=1,NUMSE1
4277            K=0
4278            DO1130I=1,NLOCAL
4279              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
4280                K=K+1
4281                ZY(K)=Y1(I)
4282              ENDIF
4283 1130       CONTINUE
4284            NTEMP=K
4285            NCURVE=NCURVE+1
4286            NUMVA2=1
4287            IF(NTEMP.GT.0)THEN
4288              CALL DPSYM2(ZY,X1,NTEMP,ICASPL,IDATSW,MAXOBV,
4289     1                    NUMVA2,NCURVE,NHIGH,
4290     1                    TAG1,XTEMP1,XTEMP2,
4291     1                    Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
4292            ENDIF
4293 1110     CONTINUE
4294        ELSEIF(NREPL.EQ.2)THEN
4295          J=0
4296          NTOT=NUMSE1*NUMSE2
4297          DO1210ISET1=1,NUMSE1
4298          DO1220ISET2=1,NUMSE2
4299            K=0
4300            DO1290I=1,NLOCAL
4301              IF(
4302     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
4303     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
4304     1          )THEN
4305                K=K+1
4306                ZY(K)=Y1(I)
4307              ENDIF
4308 1290       CONTINUE
4309            NTEMP=K
4310            NCURVE=NCURVE+1
4311            NUMVA2=1
4312            IF(NTEMP.GT.0)THEN
4313              CALL DPSYM2(ZY,X1,NTEMP,ICASPL,IDATSW,MAXOBV,
4314     1                    NUMVA2,NCURVE,NHIGH,
4315     1                    TAG1,XTEMP1,XTEMP2,
4316     1                    Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
4317            ENDIF
4318 1220     CONTINUE
4319 1210     CONTINUE
4320        ENDIF
4321C
4322C               ***************************************************
4323C               **  STEP 10A--                                   **
4324C               **  CASE 4: ONE OR TWO HIGHLIGHT VARIABLES.      **
4325C               **          THIS CASE DOES NOT SUPPORT GROUPED   **
4326C               **          DATA AND ALL VARIABLES MUST HAVE     **
4327C               **          SAME LENGTH.                         **
4328C               ***************************************************
4329C
4330      ELSEIF(NRESP.EQ.1 .AND. NHIGH.GE.1)THEN
4331        ISTEPN='10A'
4332        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')
4333     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4334C
4335          ICOL=1
4336          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
4337     1                INAME,IVARN1,IVARN2,IVARTY,
4338     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
4339     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
4340     1                MAXCP4,MAXCP5,MAXCP6,
4341     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
4342     1                Y1,X1,XTEMP1,NLOCAL,NLOCA2,NLOCA3,ICASE,
4343     1                IBUGG3,ISUBRO,IFOUND,IERROR)
4344C
4345        IF(NHIGH.EQ.1)THEN
4346          CALL CODE(X1,NLOCAL,IWRITE,TAG1,XTEMP1,MAXOBV,
4347     1              IBUGG3,IERROR)
4348        ELSE
4349          ICCTOF=0
4350          ICCTG1=0
4351          CALL CODCT2(X1,XTEMP1,NLOCAL,ICCTOF,ICCTG1,IWRITE,
4352     1                TAG1,XTEMP2,XTEMP3,
4353     1                IBUGG3,ISUBRO,IERROR)
4354        ENDIF
4355C
4356C       *****************************************************
4357C       **  STEP 10B--                                     **
4358C       **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
4359C       **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
4360C       **                                                 **
4361C       **  FOR THIS CASE, WE NEED TO LOOP THROUGH THE     **
4362C       **  VARIOUS REPLICATIONS.                          **
4363C       *****************************************************
4364C
4365        IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'SYMM')THEN
4366          ISTEPN='10B'
4367          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4368          WRITE(ICOUT,999)
4369          CALL DPWRST('XXX','BUG ')
4370          WRITE(ICOUT,1731)
4371 1731     FORMAT('***** FROM THE MIDDLE  OF DPSYMM--')
4372          CALL DPWRST('XXX','BUG ')
4373          WRITE(ICOUT,1732)ICASPL,NUMVAR,IDATSW,NLOCAL
4374 1732     FORMAT('ICASPL,NUMVAR,IDATSW,NQ = ',
4375     1           A4,I8,2X,A4,I8)
4376          CALL DPWRST('XXX','BUG ')
4377          IF(NLOCAL.GE.1)THEN
4378            DO1735I=1,NLOCAL
4379              WRITE(ICOUT,1736)I,Y1(I),TAG1(I)
4380 1736         FORMAT('I,Y1(I),TAG1(I) = ',I8,2G15.7)
4381              CALL DPWRST('XXX','BUG ')
4382 1735       CONTINUE
4383          ENDIF
4384        ENDIF
4385C
4386C       ************************************
4387C       **  STEP 10C--                    **
4388C       **  GENERATE THE SYMMETRY PLOT    **
4389C       ************************************
4390C
4391        NPLOTP=0
4392        NCURVE=1
4393        CALL DPSYM2(Y1,X1,NLOCAL,ICASPL,IDATSW,MAXOBV,
4394     1              NUMVAR,NCURVE,NHIGH,
4395     1              TAG1,XTEMP1,XTEMP2,
4396     1              Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
4397C
4398      ENDIF
4399C
4400C               *****************
4401C               **  STEP 90--  **
4402C               **  EXIT       **
4403C               *****************
4404C
4405 9000 CONTINUE
4406      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SYMM')THEN
4407        WRITE(ICOUT,999)
4408        CALL DPWRST('XXX','BUG ')
4409        WRITE(ICOUT,9011)
4410 9011   FORMAT('***** AT THE END       OF DPSYMM--')
4411        CALL DPWRST('XXX','BUG ')
4412        WRITE(ICOUT,9012)IFOUND,IERROR
4413 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
4414        CALL DPWRST('XXX','BUG ')
4415        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
4416 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',3I8,3(2X,A4))
4417        CALL DPWRST('XXX','BUG ')
4418        IF(NPLOTP.GT.0)THEN
4419          DO9020I=1,NPLOTP
4420           WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
4421 9021      FORMAT('I,Y(I),X(I),D(I) = ',I8,3G15.7)
4422           CALL DPWRST('XXX','BUG ')
4423 9020    CONTINUE
4424        ENDIF
4425      ENDIF
4426C
4427      RETURN
4428      END
4429      SUBROUTINE DPSYM2(Y,X,N,ICASPL,IDATSW,MAXOBV,
4430     1                  NUMVAR,NCURVE,NHIGH,
4431     1                  TAG1,XTEMP1,XTEMP2,
4432     1                  Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
4433C
4434C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
4435C              THAT WILL DEFINE A SYMMETRY PLOT.
4436C     WRITTEN BY--ALAN HECKERT
4437C                 STATISTICAL ENGINEERING DIVISION
4438C                 INFORMATION TECHNOLOGY LABORATORY
4439C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4440C                 GAITHERSBURG, MD 20899-8980
4441C                 PHONE--301-975-2899
4442C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4443C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4444C     LANGUAGE--ANSI FORTRAN (1977)
4445C     VERSION NUMBER--86/7
4446C     ORIGINAL VERSION--APRIL     1986.
4447C     UPDATED         --NOVEMBER  2011. SUPPORT FOR HIGHLIGHTED CASE
4448C
4449C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4450C
4451      CHARACTER*4 ICASPL
4452      CHARACTER*4 IDATSW
4453      CHARACTER*4 IBUGG3
4454      CHARACTER*4 ISUBRO
4455      CHARACTER*4 IERROR
4456C
4457      CHARACTER*4 IWRIT2
4458      CHARACTER*4 ISUBN1
4459      CHARACTER*4 ISUBN2
4460C
4461C---------------------------------------------------------------------
4462C
4463      DIMENSION Y(*)
4464      DIMENSION X(*)
4465      DIMENSION Y2(*)
4466      DIMENSION X2(*)
4467      DIMENSION D2(*)
4468      DIMENSION TAG1(*)
4469      DIMENSION XTEMP1(*)
4470      DIMENSION XTEMP2(*)
4471C
4472C-----COMMON----------------------------------------------------------
4473C
4474      INCLUDE 'DPCOP2.INC'
4475C
4476C-----START POINT-----------------------------------------------------
4477C
4478      ISUBN1='DPSY'
4479      ISUBN2='M2  '
4480      IERROR='NO'
4481C
4482      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'SYM2')THEN
4483        WRITE(ICOUT,999)
4484        CALL DPWRST('XXX','BUG ')
4485        WRITE(ICOUT,71)
4486   71   FORMAT('***** AT THE BEGINNING OF DPSYM2--')
4487        CALL DPWRST('XXX','BUG ')
4488        WRITE(ICOUT,72)ICASPL,IDATSW,N,NPLOTV,N2,NUMVAR
4489   72   FORMAT('ICASPL,IDATSW,N,NPLOTV,N2,NUMVAR = ',2(A4,2X),4I8)
4490        CALL DPWRST('XXX','BUG ')
4491        IF(N.GT.0)THEN
4492          DO85I=1,N
4493            WRITE(ICOUT,86)I,Y(I),X(I)
4494   86       FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
4495            CALL DPWRST('XXX','BUG ')
4496   85     CONTINUE
4497        ENDIF
4498      ENDIF
4499C
4500C               ********************************************
4501C               **  STEP 1--                              **
4502C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
4503C               ********************************************
4504C
4505      IF(N.LT.2)THEN
4506        WRITE(ICOUT,999)
4507  999   FORMAT(1X)
4508        CALL DPWRST('XXX','BUG ')
4509        WRITE(ICOUT,31)
4510   31   FORMAT('***** ERROR IN SYMMETRY PLOT--')
4511        CALL DPWRST('XXX','BUG ')
4512        WRITE(ICOUT,32)
4513   32   FORMAT('      THE NUMBER OF OBSERVATIONS WAS LESS THAN TWO.')
4514        CALL DPWRST('XXX','BUG ')
4515        WRITE(ICOUT,34)N
4516   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS      = ',I6)
4517        CALL DPWRST('XXX','BUG ')
4518        WRITE(ICOUT,999)
4519        CALL DPWRST('XXX','BUG ')
4520        IERROR='YES'
4521        GOTO9000
4522      ENDIF
4523C
4524      HOLD=Y(1)
4525      DO60I=1,N
4526        IF(Y(I).NE.HOLD)GOTO69
4527   60 CONTINUE
4528      WRITE(ICOUT,999)
4529      CALL DPWRST('XXX','BUG ')
4530      WRITE(ICOUT,31)
4531      CALL DPWRST('XXX','BUG ')
4532      WRITE(ICOUT,62)
4533   62 FORMAT('      ALL INPUT VERTICAL AXIS ELEMENTS')
4534      CALL DPWRST('XXX','BUG ')
4535      WRITE(ICOUT,63)HOLD
4536   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',G15.7)
4537      CALL DPWRST('XXX','BUG ')
4538      WRITE(ICOUT,999)
4539      CALL DPWRST('XXX','BUG ')
4540      IERROR='YES'
4541      GOTO9000
4542   69 CONTINUE
4543C
4544C               **************************************
4545C               **  STEP 4--                        **
4546C               **  BRANCH TO THE APPROPRIATE CASE  **
4547C               **  AND DETERMINE PLOT COORDINATES  **
4548C               **************************************
4549C
4550      IF(IDATSW.EQ.'RAW')THEN
4551C
4552C               ****************************************
4553C               **  STEP 4.1--                        **
4554C               **  DETERMINE PLOT COORDINATES        **
4555C               **  FOR THE 1-VARIABLE CASE           **
4556C               **  (THAT IS, FOR THE RAW DATA CASE)  **
4557C               ****************************************
4558C
4559        IWRIT2='OFF'
4560        CALL MEDIAN(Y,N,IWRIT2,XTEMP1,MAXOBV,XMED,IBUGG3,IERROR)
4561C
4562        IF(NHIGH.EQ.0)THEN
4563          CALL SORT(Y,N,XTEMP1)
4564          NHALFP=(N+1)/2
4565          DO1110I=1,NHALFP
4566            IREV=N-I+1
4567            Y2(N2+I)=XTEMP1(IREV)-XMED
4568            X2(N2+I)=XMED-XTEMP1(I)
4569            D2(N2+I)=REAL(NCURVE)
4570 1110     CONTINUE
4571          N2=N2+NHALFP
4572          NPLOTV=2
4573        ELSE
4574C
4575C         HIGHLIGHT CASE: BASE HIGHLIGHTING ON MAXIMUM OF
4576C                         THE TWO POINTS THAT GENERATE A SINGLE
4577C                         PLOT POINT.
4578C
4579          CALL SORTC(Y,TAG1,N,XTEMP1,XTEMP2)
4580          NHALFP=(N+1)/2
4581          DO1210I=1,NHALFP
4582            IREV=N-I+1
4583            Y2(N2+I)=XTEMP1(IREV)-XMED
4584            X2(N2+I)=XMED-XTEMP1(I)
4585            D2(N2+I)=MAX(XTEMP2(I),XTEMP2(IREV))
4586 1210     CONTINUE
4587          N2=N2+NHALFP
4588          NPLOTV=2
4589        ENDIF
4590      ELSEIF(IDATSW.EQ.'FREQ')THEN
4591C
4592C               ********************************************
4593C               **  STEP 4.2--                            **
4594C               **  DETERMINE PLOT COORDINATES            **
4595C               **  FOR THE 2-VARIABLE CASE               **
4596C               **  (THAT IS, FOR THE GROUPED DATA CASE)  **
4597C               ********************************************
4598C
4599        CALL SORTC(X,Y,N,D2,Y2)
4600C
4601        SUM=0.0
4602        DO2110I=1,N
4603         SUM=SUM+Y(I)
4604 2110   CONTINUE
4605        NTOT=INT(SUM+0.5)
4606C
4607        IF(NTOT.GT.1000)THEN
4608          IERROR='YES'
4609          WRITE(ICOUT,999)
4610          CALL DPWRST('XXX','BUG ')
4611          WRITE(ICOUT,2111)
4612 2111     FORMAT('***** ERROR IN DPSYM2--')
4613          CALL DPWRST('XXX','BUG ')
4614          WRITE(ICOUT,2113)
4615 2113     FORMAT('      FOR THE 2-VARIABLE (GROUPED) CASE, THE')
4616          CALL DPWRST('XXX','BUG ')
4617          WRITE(ICOUT,2114)
4618 2114     FORMAT('      UNGROUPED NUMBER OF OBSERVATIONS IS TOO ',
4619     1           'LARGE.')
4620          CALL DPWRST('XXX','BUG ')
4621          WRITE(ICOUT,2116)NTOT
4622 2116     FORMAT('      NTOT = ',I8)
4623          CALL DPWRST('XXX','BUG ')
4624          GOTO9000
4625        ENDIF
4626C
4627        K=0
4628        DO2121I=1,N
4629          NI=INT(Y2(I)+0.5)
4630          IF(NI.LE.0)GOTO2121
4631          DO2122J=1,NI
4632            K=K+1
4633            X2(K)=D2(I)
4634 2122     CONTINUE
4635 2121   CONTINUE
4636C
4637        IWRIT2='OFF'
4638        MAXND2=1000
4639        CALL MEDIAN(X2,K,IWRIT2,D2,MAXND2,XMED,IBUGG3,IERROR)
4640        CALL SORT(X2,K,D2)
4641C
4642        KHALFP=(K+1)/2
4643        DO2130I=1,KHALFP
4644          IREV=K-I+1
4645          Y2(I)=D2(IREV)-XMED
4646          X2(I)=XMED-D2(I)
4647 2130   CONTINUE
4648        DO2140I=1,KHALFP
4649          D2(I)=1.0
4650 2140   CONTINUE
4651        N2=KHALFP
4652        NPLOTV=2
4653      ELSE
4654        WRITE(ICOUT,999)
4655        CALL DPWRST('XXX','BUG ')
4656        WRITE(ICOUT,31)
4657        CALL DPWRST('XXX','BUG ')
4658        WRITE(ICOUT,1012)
4659 1012   FORMAT('      IDATSW SHOULD BE EITHER')
4660        CALL DPWRST('XXX','BUG ')
4661        WRITE(ICOUT,1013)
4662 1013   FORMAT('      RAW   OR    FREQ, BUT IS NEITHER.')
4663        CALL DPWRST('XXX','BUG ')
4664        WRITE(ICOUT,1014)IDATSW
4665 1014   FORMAT('      IDATSW = ',A4)
4666        CALL DPWRST('XXX','BUG ')
4667        IERROR='YES'
4668        GOTO9000
4669      ENDIF
4670      GOTO9000
4671C
4672C               *****************
4673C               **  STEP 90--  **
4674C               **  EXIT       **
4675C               *****************
4676C
4677 9000 CONTINUE
4678      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'SYM2')THEN
4679        WRITE(ICOUT,999)
4680        CALL DPWRST('XXX','BUG ')
4681        WRITE(ICOUT,9011)
4682 9011   FORMAT('***** AT THE END       OF DPSYM2--')
4683        CALL DPWRST('XXX','BUG ')
4684        WRITE(ICOUT,9012)ICASPL,IDATSW,N2,IERROR
4685 9012   FORMAT('ICASPL,IDATSW,N2,IERROR = ',A4,2X,A4,I8,2X,A4)
4686        CALL DPWRST('XXX','BUG ')
4687        WRITE(ICOUT,9013)N,NHALFP,NTOT,K,KHALFP
4688 9013   FORMAT('N,NHALFP,NTOT,K,KHALFP = ',5I8)
4689        CALL DPWRST('XXX','BUG ')
4690        WRITE(ICOUT,9014)N2,NPLOTV
4691 9014   FORMAT('N2,NPLOTV = ',2I8)
4692        CALL DPWRST('XXX','BUG ')
4693        DO9015I=1,N2
4694          WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
4695 9016     FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
4696          CALL DPWRST('XXX','BUG ')
4697 9015   CONTINUE
4698      ENDIF
4699C
4700      RETURN
4701      END
4702      SUBROUTINE DPSYST(IANS,IANSLC,IWIDTH,
4703     1                  IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
4704     1                  IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
4705     1                  IBUGD2,ISUBRO,IFOUND,IERROR)
4706C
4707C     PURPOSE--ENTER AN OPERATING SYSTEM COMMAND.  NOTE THAT THIS COMMAND
4708C              IS SITE AND HOST DEPENDENT.  IT IS PROVIODED TO ACCOMODATE
4709C              THOSE OPERATING SYSTEMS THAT ALLOW HOOKS INTO THE OPERATING
4710C              SYSTEM.  IT IS LEFT UP TO THE LOCAL IMPLEMENTOR AS TO HOW
4711C              THIS COMMAND WILL BE USED.
4712C
4713C              THE CALL TO THE OPERATING SYSTEM IS DONE BELOW IN
4714C                    CALL SCLCMD
4715C              IF YOUR COMPUTER DOES NOT ALLOW SUCH A HOOK, DO NOTHING.
4716C              IF YOUR COMPUTER DOES ALLOW SUCH A HOOK, THEN THE
4717C              IMPLEMENTER SHOULD REPLACE THE CALL TO SCLCMD
4718C              (WHICH IS APPROPRIATE ONLY FOR CDC CYBER NOS/VE)
4719C              WITH THE APPROPRIATE SYSTEM CALL;
4720C              THE LINE SHOULD ALSO BE UN-COMMENTED OUT.
4721C
4722C              NOTE THAT IF A COMMAND IS PASSED TO THE OPERATING SYSTEM,
4723C              DATAPLOT WILL DO NO ERROR CHECKING.  IT WILL SIMPLY PASS
4724C              THE COMMAND AS GIVEN.
4725C
4726C     WRITTEN BY--ALAN HECKERT
4727C                 STATISTICAL ENGINEERING DIVISION
4728C                 INFORMATION TECHNOLOGY LABORATORY
4729C                 NATIONAL INSTITTE OF STANDARDS AND TECHNOLOGY
4730C                 GAITHERSBURG, MD 20899
4731C                 PHONE--301-975-2899
4732C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4733C           OF THE NATIONAL BUREAU OF STANDARDS.
4734C     LANGUAGE--ANSI FORTRAN (1977)
4735C               HOST DEPENDENT
4736C     VERSION NUMBER--89.3
4737C     ORIGINAL VERSION--FEBRUARY   1989.
4738C     UPDATED         --MARCH      1990. USE "IANSLC" SINCE SOME SYSTEMS
4739C                                        ARE CASE SENSITIVE (E.G., UNIX)
4740C     UPDATED         --APRIL      1992. DO OPERATING SPECIFIC CALL IN DPSYS2
4741C     UPDATED         --APRIL      1992. ADD ISUBRO IN CALL TO DPSYS2
4742C     UPDATED         --APRIL      1992. ADD UNIX & DOS
4743C     UPDATED         --APRIL      1992. ADD OTG CHECK
4744C     UPDATED         --APRIL      1992. AUGMENT ERROR INFO
4745C     UPDATED         --APRIL      2018. SINCE THE PLATFORM DEPENDENT
4746C                                        CODE IS IN DPSYS2, RECODE THIS
4747C                                        ROUTINE AND MOVE IT OUT OF
4748C                                        dp1.F.
4749C
4750C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
4751C
4752      CHARACTER*4 IANS
4753      CHARACTER*4 IANSLC
4754C
4755      CHARACTER*4 ITEXTE
4756      CHARACTER*4 ITEXTF
4757      CHARACTER*4 IHNAME
4758      CHARACTER*4 IHNAM2
4759      CHARACTER*4 IUSE
4760      CHARACTER*4 IBUGD2
4761      CHARACTER*4 ISUBRO
4762      CHARACTER*4 IFOUND
4763      CHARACTER*4 IERROR
4764      CHARACTER*4 IFUNC
4765      CHARACTER*1 IREPCH
4766C
4767      DIMENSION IANS(*)
4768      DIMENSION IANSLC(*)
4769C
4770      PARAMETER(MAXCH=256)
4771      DIMENSION ITEXTE(MAXCH)
4772      DIMENSION ITEXTF(MAXCH)
4773      CHARACTER*256 ITEXT2
4774      CHARACTER*256 ITEXT3
4775C
4776      DIMENSION IHNAME(*)
4777      DIMENSION IHNAM2(*)
4778      DIMENSION IUSE(*)
4779      DIMENSION IVALUE(*)
4780      DIMENSION VALUE(*)
4781      DIMENSION IVSTAR(*)
4782      DIMENSION IVSTOP(*)
4783      DIMENSION IFUNC(*)
4784C
4785C-----COMMON----------------------------------------------------------
4786C
4787      INCLUDE 'DPCOHO.INC'
4788      INCLUDE 'DPCOBE.INC'
4789      INCLUDE 'DPCOP2.INC'
4790C
4791C-----START POINT-----------------------------------------------------
4792C
4793      IFOUND='NO'
4794      IERROR='NO'
4795C
4796      J2=0
4797C
4798      IF(IBUGD2.EQ.'ON'.OR.ISUBRO.EQ.'SYST')THEN
4799        WRITE(ICOUT,999)
4800  999   FORMAT(1X)
4801        CALL DPWRST('XXX','BUG ')
4802        WRITE(ICOUT,51)
4803   51   FORMAT('***** AT THE BEGINNING OF DPSYST--')
4804        CALL DPWRST('XXX','BUG ')
4805        WRITE(ICOUT,53)IBUGD2,ISUBRO,IWIDTH,NUMNAM
4806   53   FORMAT('IBUGD2,ISUBRO,IWIDTH,NUMNAM= ',2(A4,2X),2I8)
4807        CALL DPWRST('XXX','BUG ')
4808        WRITE(ICOUT,54)(IANS(I),I=1,MIN(255,IWIDTH))
4809   54   FORMAT('(IANS(I),I=1,IWIDTH) = ',255A4)
4810        CALL DPWRST('XXX','BUG ')
4811        DO76I=1,NUMNAM
4812          WRITE(ICOUT,77)I,IHNAME(I),IHNAM2(I),IUSE(I),
4813     1                   IVALUE(I),VALUE(I)
4814   77     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)= ',
4815     1           I8,3(2X,A4),I8,G15.7)
4816          CALL DPWRST('XXX','BUG ')
4817   76   CONTINUE
4818      ENDIF
4819C
4820C               *****************************************************
4821C               **  STEP 1--                                       **
4822C               **  EXTRACT THE TEXT STRING FROM THE COMMAND LINE  **
4823C               *****************************************************
4824C
4825C               *****************************************
4826C               **  STEP 1.1--                         **
4827C               **  DETERMINE THE COMMAND              **
4828C               **  (SYSTEM OR SYST) AND ITS LOCATION  **
4829C               **  ON THE LINE.                       **
4830C               **  DETERMINE THE START POSITION       **
4831C               **  (XSTART) OF THE FIRST CHARACTER    **
4832C               **  FOR THE STRING TO BE PRINTED.      **
4833C               *****************************************
4834C
4835C     CHECK FOR "SYSTEM" FIRST
4836C
4837      DO1115I=1,IWIDTH
4838        IP1=I+1
4839        IP2=I+2
4840        IP3=I+3
4841        IP4=I+4
4842        IP5=I+5
4843        IP6=I+6
4844C
4845        IF(IP6.GT.IWIDTH)GOTO1115
4846        ISTART=IP6+1
4847        IF(IANS(I).EQ.'S'.AND.IANS(IP1).EQ.'Y'.AND.
4848     1     IANS(IP2).EQ.'S'.AND.IANS(IP3).EQ.'T'.AND.
4849     1     IANS(IP4).EQ.'E'.AND.IANS(IP5).EQ.'M'.AND.
4850     1     IANS(IP6).EQ.' ')GOTO1190
4851 1115 CONTINUE
4852C
4853C     CHECK FOR "SYST"
4854C
4855      DO1125I=1,IWIDTH
4856        IP1=I+1
4857        IP2=I+2
4858        IP3=I+3
4859        IP4=I+4
4860        IP5=I+5
4861C
4862        IF(IP4.GT.IWIDTH)GOTO1125
4863        ISTART=IP5
4864        IF(IANS(I).EQ.'S'.AND.IANS(IP1).EQ.'Y'.AND.
4865     1     IANS(IP2).EQ.'S'.AND.IANS(IP3).EQ.'T'.AND.
4866     1     IANS(IP4).EQ.' ')GOTO1190
4867 1125 CONTINUE
4868C
4869CCCCC THE FOLLOWING SECTION WAS ADDED   APRIL 1992
4870C     CHECK FOR "UNIX"
4871C
4872      DO1135I=1,IWIDTH
4873        IP1=I+1
4874        IP2=I+2
4875        IP3=I+3
4876        IP4=I+4
4877        IP5=I+5
4878C
4879        IF(IP4.GT.IWIDTH)GOTO1135
4880        ISTART=IP5
4881        IF(IANS(I).EQ.'U'.AND.IANS(IP1).EQ.'N'.AND.
4882     1     IANS(IP2).EQ.'I'.AND.IANS(IP3).EQ.'X'.AND.
4883     1     IANS(IP4).EQ.' ')GOTO1190
4884 1135 CONTINUE
4885C
4886CCCCC THE FOLLOWING SECTION WAS ADDED   APRIL 1992
4887C     CHECK FOR "DOS"
4888C
4889      DO1145I=1,IWIDTH
4890        IP1=I+1
4891        IP2=I+2
4892        IP3=I+3
4893        IP4=I+4
4894C
4895        IF(IP3.GT.IWIDTH)GOTO1145
4896        ISTART=IP4
4897        IF(IANS(I).EQ.'D'.AND.IANS(IP1).EQ.'O'.AND.
4898     1     IANS(IP2).EQ.'S'.AND.IANS(IP3).EQ.' ')GOTO1190
4899 1145 CONTINUE
4900C
4901CCCCC THE FOLLOWING SECTION WAS ADDED   APRIL 2018
4902C     CHECK FOR "LUNIX"
4903C
4904      DO1155I=1,IWIDTH
4905        IP1=I+1
4906        IP2=I+2
4907        IP3=I+3
4908        IP4=I+4
4909        IP5=I+5
4910C
4911        IF(IP4.GT.IWIDTH)GOTO1155
4912        ISTART=IP5
4913        IF(IANS(I).EQ.'L'.AND.IANS(IP1).EQ.'I'.AND.
4914     1     IANS(IP2).EQ.'N'.AND.IANS(IP3).EQ.'U'.AND.
4915     1     IANS(IP4).EQ.'X'.AND.IANS(IP5).EQ.' ')GOTO1190
4916 1155 CONTINUE
4917C
4918C     NO MATCH
4919C
4920      WRITE(ICOUT,999)
4921      CALL DPWRST('XXX','BUG ')
4922      WRITE(ICOUT,1181)
4923 1181 FORMAT('***** ERROR IN SYSTEM COMMAND--')
4924      CALL DPWRST('XXX','BUG ')
4925      WRITE(ICOUT,1182)
4926 1182 FORMAT('      COMMAND NOT EQUAL TO:  SYSTEM, SYST, UNIX, LINUX ',
4927     1       'OR DOS.')
4928      CALL DPWRST('XXX','BUG ')
4929      IERROR='YES'
4930      GOTO9000
4931 1190 CONTINUE
4932C
4933C               **********************************************************
4934C               **  STEP 1.2--                                          **
4935C               **  DEFINE THE STOP  POSITION (ISTOP) FOR THE STRING.   **
4936C               **********************************************************
4937C
4938      IFOUND='YES'
4939C
4940      ISTOP=0
4941      IF(ISTART.LE.IWIDTH)THEN
4942        DO1220I=ISTART,IWIDTH
4943          IREV=IWIDTH-I+ISTART
4944          IF(IANS(IREV).NE.' ')THEN
4945            ISTOP=IREV
4946            GOTO1229
4947          ENDIF
4948 1220   CONTINUE
4949 1229   CONTINUE
4950      ENDIF
4951C
4952C               *****************************************
4953C               **  STEP 1.3--                         **
4954C               **  COPY OVER THE STRING OF INTEREST.  **
4955C               *****************************************
4956C
4957      IF(ISTART.GT.ISTOP .OR. ISTOP.EQ.0)THEN
4958        NCTEX=0
4959      ELSE
4960        ITEMP=ISTOP-ISTART+1
4961        IF(ITEMP.GT.MAXCH)ITEMP=MAXCH
4962        ISTOP=ISTART+ITEMP-1
4963C
4964        J=0
4965        DO1310I=ISTART,ISTOP
4966          J=J+1
4967          J2=J
4968          ITEXTE(J)=IANS(I)
4969          ITEXTF(J)=IANSLC(I)
4970 1310   CONTINUE
4971        NCTEX=J2
4972      ENDIF
4973C
4974C               ******************************************************
4975C               **  STEP 1.4--                                      **
4976C               **  CALL THE SUBROUTINE DPREPL                      **
4977C               **  WHICH WILL SCAN THE STRING FOR ALL OCCURRANCES  **
4978C               **  OF THE SUBSTRING VALU()                         **
4979C               **  AND REPLACE THEM BY THEIR LITERAL VALUES.       **
4980C               ******************************************************
4981C
4982      NCTEXT=NCTEX
4983      IF(NCTEXT.GE.1)THEN
4984        CALL DPREPL(ITEXTE,NCTEXT,
4985     1              IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
4986     1              IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
4987     1              IBUGD2,IERROR)
4988      ENDIF
4989C
4990      IF(NCTEXT.GE.1)THEN
4991        DO1510I=1,NCTEXT
4992          ITEXT2(I:I)=ITEXTE(I)(1:1)
4993 1510   CONTINUE
4994      ENDIF
4995C
4996      NCTEXT=NCTEX
4997      IF(NCTEXT.GE.1)THEN
4998        CALL DPREPL(ITEXTF,NCTEXT,
4999     1              IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
5000     1              IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
5001     1              IBUGD2,IERROR)
5002      ENDIF
5003      IF(NCTEXT.GE.1)THEN
5004        DO1610I=1,NCTEXT
5005          ITEXT3(I:I)=ITEXTF(I)(1:1)
5006 1610   CONTINUE
5007      ENDIF
5008C
5009C               *****************************************
5010C               **  STEP 2--                           **
5011C               **  CALL DPSYS2 TO EXECUTE THE COMMAND **
5012C               *****************************************
5013C
5014C     2018/04: ALTHOUGH WINDOWS COMMANDS ARE NOT CASE SENSITIVE,
5015C              ARGUMENTS MAY BE.  SO USE LOWER CASE VARIANT FOR
5016C              ALL SYSTEMS.
5017C
5018CCCCC IF(IOPSY1.EQ.'UNIX')THEN
5019        CALL DPSYS2(ITEXT3,NCTEXT,ISUBRO,IERROR)
5020CCCCC ELSE
5021CCCCC   CALL DPSYS2(ITEXT2,NCTEXT,ISUBRO,IERROR)
5022CCCCC ENDIF
5023C
5024C               *****************
5025C               **  STEP 90--  **
5026C               **  EXIT       **
5027C               *****************
5028C
5029 9000 CONTINUE
5030      IF(IBUGD2.EQ.'ON'.OR.ISUBRO.EQ.'SYST')THEN
5031        WRITE(ICOUT,999)
5032        CALL DPWRST('XXX','BUG ')
5033        WRITE(ICOUT,9011)
5034 9011   FORMAT('***** AT THE END       OF DPSYST--')
5035        CALL DPWRST('XXX','BUG ')
5036        WRITE(ICOUT,9016)(ITEXTE(I),I=1,NCTEX)
5037 9016   FORMAT('(ITEXTE(I),I =1,NCTEX) = ',25A4)
5038        CALL DPWRST('XXX','BUG ')
5039        WRITE(ICOUT,9017)IFOUND,IERROR,IREPCH,NCTEXT,NCTEX
5040 9017   FORMAT('IFOUND,IERROR,IREPCH,NCTEXT,NCTEX = ',
5041     1         2(A4,2X),A1,2X,2I8)
5042        CALL DPWRST('XXX','BUG ')
5043        WRITE(ICOUT,9018)(ITEXT2(J:J),J=1,NCTEXT)
5044 9018   FORMAT('(ITEXT2(I),I=1,NCTEXT) = ',25A4)
5045        CALL DPWRST('XXX','BUG ')
5046      ENDIF
5047C
5048      RETURN
5049      END
5050      SUBROUTINE DPTAB1(IHEAD,NHEAD,CAPTN,NCAP,IFLAG1)
5051C
5052C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
5053C              TABULAR OUTPUT IN ASCII FORMAT.  THIS ROUTINE IS USED
5054C              TO INITIATE THE TABULAR OUTPUT.  THE ONLY OPTIONAL ELEMENT
5055C              IS THE CAPTION.
5056C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
5057C                                THE TEXT FOR THE HEADER
5058C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
5059C                                THE NUMBER OF CHARACTERS IN THE
5060C                                HEADER.
5061C                     --CAPTN  = THE CHARACTER STRING CONTAINING
5062C                                THE CAPTION.
5063C                     --NCAP   = THE INTEGER NUMBER THAT SPECIFIES
5064C                                THE NUMBER OF CHARACTERS IN THE
5065C                                CAPTION.
5066C     WRITTEN BY--JAMES J. FILLIBEN
5067C                 STATISTICAL ENGINEERING DIVISION
5068C                 INFORMATION TECHNOLOGY LABOARATORY
5069C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5070C                 GAITHERSBURG, MD 20899-8980
5071C                 PHONE--301-975-2855
5072C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5073C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5074C     LANGUAGE--ANSI FORTRAN (1977)
5075C     VERSION NUMBER--2009/3
5076C     ORIGINAL VERSION--MARCH     2009.
5077C
5078C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5079C
5080      CHARACTER*(*) CAPTN
5081      CHARACTER*(*) IHEAD
5082C
5083      LOGICAL IFLAG1
5084      CHARACTER*10 IFORMT
5085C
5086C-----COMMON----------------------------------------------------------
5087C
5088      INCLUDE 'DPCOP2.INC'
5089C
5090C-----START POINT-----------------------------------------------------
5091C
5092C  STEP 1: WRITE A HEADER
5093C
5094  999 FORMAT(1X)
5095C
5096      IF(IFLAG1)THEN
5097        WRITE(ICOUT,999)
5098        CALL DPWRST('XXX','WRIT')
5099      ENDIF
5100C
5101      IF(NHEAD.GE.1)THEN
5102        IFORMT=' '
5103        IFORMT(1:9)='(12X,A  )'
5104        IF(NHEAD.GT.0 .AND. NHEAD.LE.99)THEN
5105          WRITE(IFORMT(7:8),'(I2)')NHEAD
5106          WRITE(ICOUT,IFORMT)IHEAD(1:NHEAD)
5107          CALL DPWRST('XXX','WRIT')
5108        ENDIF
5109        WRITE(ICOUT,999)
5110        CALL DPWRST('XXX','WRIT')
5111      ENDIF
5112C
5113C  STEP 2: START TABLE AND DEFINE A CAPTION
5114C
5115      IF(NCAP.GT.0 .AND. NCAP.LT.130)THEN
5116        IFORMT=' '
5117        IFORMT(1:6)='(A   )'
5118        WRITE(IFORMT(3:5),'(I3)')NCAP
5119        WRITE(ICOUT,IFORMT)CAPTN(1:NCAP)
5120        CALL DPWRST('XXX','WRIT')
5121      ENDIF
5122C
5123      RETURN
5124      END
5125      SUBROUTINE DPTABA(IHEAD,NHEAD,CAPTN,NCAP,IFLAG1)
5126C
5127C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
5128C              TABULAR OUTPUT IN ASCII FORMAT.  THIS ROUTINE IS USED
5129C              TO INITIATE THE TABULAR OUTPUT.  THE ONLY OPTIONAL ELEMENT
5130C              IS THE CAPTION.
5131C
5132C              NOTE: THIS IS A SLIGHT VARIANT OF DPTAB1.  DIFFERS
5133C                    IN POSITIONING OF "CAPTN" STRING.
5134C
5135C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
5136C                                THE TEXT FOR THE HEADER
5137C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
5138C                                THE NUMBER OF CHARACTERS IN THE
5139C                                HEADER.
5140C                     --CAPTN  = THE CHARACTER STRING CONTAINING
5141C                                THE CAPTION.
5142C                     --NCAP   = THE INTEGER NUMBER THAT SPECIFIES
5143C                                THE NUMBER OF CHARACTERS IN THE
5144C                                CAPTION.
5145C     WRITTEN BY--JAMES J. FILLIBEN
5146C                 STATISTICAL ENGINEERING DIVISION
5147C                 INFORMATION TECHNOLOGY LABOARATORY
5148C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5149C                 GAITHERSBURG, MD 20899-8980
5150C                 PHONE--301-975-2855
5151C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5152C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5153C     LANGUAGE--ANSI FORTRAN (1977)
5154C     VERSION NUMBER--2009/3
5155C     ORIGINAL VERSION--MARCH     2009.
5156C
5157C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5158C
5159      CHARACTER*(*) CAPTN
5160      CHARACTER*(*) IHEAD
5161C
5162      LOGICAL IFLAG1
5163      CHARACTER*10 IFORMT
5164C
5165C-----COMMON----------------------------------------------------------
5166C
5167      INCLUDE 'DPCOP2.INC'
5168C
5169C-----START POINT-----------------------------------------------------
5170C
5171C  STEP 1: WRITE A HEADER
5172C
5173  999 FORMAT(1X)
5174C
5175      IF(IFLAG1)THEN
5176        WRITE(ICOUT,999)
5177        CALL DPWRST('XXX','WRIT')
5178      ENDIF
5179C
5180      IF(NHEAD.GE.1)THEN
5181        IFORMT=' '
5182        IFORMT(1:9)='(12X,A  )'
5183        WRITE(IFORMT(7:8),'(I2)')NHEAD
5184        WRITE(ICOUT,IFORMT)IHEAD(1:NHEAD)
5185        CALL DPWRST('XXX','WRIT')
5186      ENDIF
5187C
5188C  STEP 2: START TABLE AND DEFINE A CAPTION
5189C
5190      NSTRT=12
5191      NDIFF=NHEAD-NCAP
5192      IF(NDIFF.GE.2)THEN
5193        NDIFF=NDIFF/2
5194        NSTRT=NSTRT+NDIFF
5195      ENDIF
5196      IF(NCAP.GT.0)THEN
5197        IFORMT=' '
5198        IFORMT(1:9)='(  X,A  )'
5199        WRITE(IFORMT(2:3),'(I2)')NSTRT
5200        WRITE(IFORMT(7:8),'(I2)')NCAP
5201        WRITE(ICOUT,IFORMT)CAPTN(1:NCAP)
5202        CALL DPWRST('XXX','WRIT')
5203        WRITE(ICOUT,999)
5204        CALL DPWRST('XXX','WRIT')
5205      ENDIF
5206C
5207      RETURN
5208      END
5209      SUBROUTINE DPTAB4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,NMAX)
5210C
5211C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
5212C              TABULAR OUTPUT IN ASCII FORMAT.  THIS ROUTINE IS USED TO
5213C              GENERATE A HEADER ROW FOR A TABLE.  YOU CAN ALSO OPTIONALLY
5214C              ADD A RULE LINE BEFORE OR AFTER THE HEADER.
5215C
5216C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING ARRAY
5217C                                 CONTAINING THE TEXT FOR THE
5218C                                 HEADER VALUES.
5219C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
5220C                                 THE NUMBER OF CHARACTERS IN THE
5221C                                 HEADER VALUES.
5222C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
5223C                                 THE NUMBER OF HEADER VALUES.
5224C                     --IFLAG1  = A LOGICAL VALUE THAT SPECIFIES
5225C                                 WHETHER A RULE LINE IS DRAWN BEFORE
5226C                                 THE HEADER.
5227C                     --IFLAG2  = A LOGICAL VALUE THAT SPECIFIES
5228C                                 WHETHER A RULE LINE IS DRAWN AFTER
5229C                                 THE HEADER.
5230C                     --NMAX    = NUMBER OF CHARACTERS FOR "RULE" LINE
5231C     WRITTEN BY--ALAN HECKERT
5232C                 STATISTICAL ENGINEERING DIVISION
5233C                 INFORMATION TECHNOLOGY LABOARATORY
5234C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5235C                 GAITHERSBURG, MD 20899-8980
5236C                 PHONE--301-975-2899
5237C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5238C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5239C     LANGUAGE--ANSI FORTRAN (1977)
5240C     VERSION NUMBER--2009/3
5241C     ORIGINAL VERSION--MARCH     2009.
5242C
5243C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5244C
5245      CHARACTER*(*) IVALUE(NHEAD)
5246      INTEGER NCHAR(NHEAD)
5247C
5248      PARAMETER (MAXHED=1024)
5249      INTEGER IWIDTH(MAXHED)
5250      INTEGER NUMDIG(MAXHED)
5251      CHARACTER*8 ALIGN(MAXHED)
5252      CHARACTER*8 VALIGN(MAXHED)
5253      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
5254C
5255      CHARACTER*255 IATEMP
5256C
5257      LOGICAL IFLAG1
5258      LOGICAL IFLAG2
5259C
5260      CHARACTER*20 IFORMT
5261      CHARACTER*160 ISTR
5262C
5263C-----COMMON----------------------------------------------------------
5264C
5265      INCLUDE 'DPCOP2.INC'
5266C
5267C-----START POINT-----------------------------------------------------
5268C
5269CC999 FORMAT(1X)
5270C
5271C  STEP 1: PRINT INITIAL RULE LINE
5272C
5273      IF(NHEAD.GE.1)THEN
5274        IF(IFLAG1 .AND. NMAX.GT.0)THEN
5275          IFORMT=' '
5276          DO8010I=1,MIN(NMAX,255)
5277            IATEMP(I:I)='-'
5278 8010     CONTINUE
5279          IFORMT(1:6)='(A   )'
5280          WRITE(IFORMT(3:5),'(I3)')NMAX
5281          WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
5282          CALL DPWRST('XXX','WRIT')
5283        ENDIF
5284C
5285C  STEP 2: PRINT TEXT FIELDS
5286C
5287        IFORMT=' '
5288        NCSTR=0
5289        DO8020I=1,NHEAD
5290          IF(NCHAR(I).GE.1)THEN
5291            NCSTR=NCSTR+1
5292            NCSTR2=NCSTR+NCHAR(I)-1
5293            IFORMT(1:5)='(A  )'
5294            WRITE(IFORMT(3:4),'(I2)')NCHAR(I)
5295            WRITE(ISTR(NCSTR:NCSTR2),IFORMT)IVALUE(I)(1:NCHAR(I))
5296            NCSTR=NCSTR2
5297          ENDIF
5298 8020   CONTINUE
5299        IFORMT=' '
5300        IFORMT(1:6)='(A   )'
5301        WRITE(IFORMT(3:5),'(I3)')NCSTR
5302        IF(NCSTR.GE.1)THEN
5303          WRITE(ICOUT,IFORMT)ISTR(1:NCSTR)
5304          CALL DPWRST('XXX','WRIT')
5305        ENDIF
5306C
5307C  STEP 3: PRINT TRAILING RULE LINE
5308C
5309        IF(IFLAG2 .AND. NMAX.GT.0)THEN
5310          IFORMT=' '
5311          DO8030I=1,NMAX
5312            IATEMP(I:I)='-'
5313 8030     CONTINUE
5314          IFORMT(1:6)='(A   )'
5315          WRITE(IFORMT(3:5),'(I3)')NMAX
5316          WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
5317          CALL DPWRST('XXX','WRIT')
5318        ENDIF
5319C
5320      ENDIF
5321C
5322      RETURN
5323      END
5324      SUBROUTINE DPTA44(IVALUE,NCHAR,NHEAD,NCOLSP,IFLAG1,IFLAG2,NMAX)
5325C
5326C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
5327C              TABULAR OUTPUT IN ASCII FORMAT.  THIS ROUTINE IS USED TO
5328C              GENERATE A HEADER ROW FOR A TABLE.  YOU CAN ALSO OPTIONALLY
5329C              ADD A RULE LINE BEFORE OR AFTER THE HEADER.
5330C
5331C              THIS IS A MODIFIED VERSION OF DPTAB4 THAT ALLOWS
5332C              HEADERS THAT SPAN MULTIPLE COLUMNS.
5333C
5334C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING ARRAY
5335C                                 CONTAINING THE TEXT FOR THE
5336C                                 HEADER VALUES.
5337C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
5338C                                 THE NUMBER OF CHARACTERS IN THE
5339C                                 HEADER VALUES.
5340C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
5341C                                 THE NUMBER OF HEADER VALUES.
5342C                     --NCOLSP  = THE INTEGER ARRAY THAT SPECIFIES
5343C                                 THE NUMBER OF SPANNING COLUMNS.
5344C                     --IFLAG1  = A LOGICAL VALUE THAT SPECIFIES
5345C                                 WHETHER A RULE LINE IS DRAWN BEFORE
5346C                                 THE HEADER.
5347C                     --IFLAG2  = A LOGICAL VALUE THAT SPECIFIES
5348C                                 WHETHER A RULE LINE IS DRAWN AFTER
5349C                                 THE HEADER.
5350C                     --NMAX    = NUMBER OF CHARACTERS FOR "RULE" LINE
5351C     WRITTEN BY--ALAN HECKERT
5352C                 STATISTICAL ENGINEERING DIVISION
5353C                 INFORMATION TECHNOLOGY LABOARATORY
5354C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5355C                 GAITHERSBURG, MD 20899-8980
5356C                 PHONE--301-975-2899
5357C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5358C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5359C     LANGUAGE--ANSI FORTRAN (1977)
5360C     VERSION NUMBER--2011/1
5361C     ORIGINAL VERSION--JANUARY   2011.
5362C
5363C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5364C
5365      CHARACTER*(*) IVALUE(NHEAD)
5366      INTEGER NCHAR(NHEAD)
5367      INTEGER NCOLSP(NHEAD)
5368C
5369      PARAMETER (MAXHED=1024)
5370      INTEGER IWIDTH(MAXHED)
5371      INTEGER NUMDIG(MAXHED)
5372      CHARACTER*8 ALIGN(MAXHED)
5373      CHARACTER*8 VALIGN(MAXHED)
5374      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
5375C
5376      CHARACTER*255 IATEMP
5377C
5378      LOGICAL IFLAG1
5379      LOGICAL IFLAG2
5380C
5381      CHARACTER*20 IFORMT
5382      CHARACTER*160 ISTR
5383C
5384C-----COMMON----------------------------------------------------------
5385C
5386      INCLUDE 'DPCOP2.INC'
5387C
5388C-----START POINT-----------------------------------------------------
5389C
5390CC999 FORMAT(1X)
5391C
5392C  STEP 1: PRINT INITIAL RULE LINE
5393C
5394      IF(NHEAD.GE.1)THEN
5395        IF(IFLAG1 .AND. NMAX.GT.0)THEN
5396          IFORMT=' '
5397          DO8010I=1,MIN(NMAX,255)
5398            IATEMP(I:I)='-'
5399 8010     CONTINUE
5400          IFORMT(1:6)='(A   )'
5401          WRITE(IFORMT(3:5),'(I3)')NMAX
5402          WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
5403          CALL DPWRST('XXX','WRIT')
5404        ENDIF
5405C
5406C  STEP 2: PRINT TEXT FIELDS
5407C
5408        IFORMT=' '
5409        NCSTR=0
5410        DO8020I=1,NHEAD
5411          IF(NCHAR(I).GE.1 .AND. NCOLSP(I).GT.0)THEN
5412            NCSTR=NCSTR+1
5413            NCSTR2=NCSTR+NCHAR(I)-1
5414            IFORMT(1:5)='(A  )'
5415            WRITE(IFORMT(3:4),'(I2)')NCHAR(I)
5416            WRITE(ISTR(NCSTR:NCSTR2),IFORMT)IVALUE(I)(1:NCHAR(I))
5417            NCSTR=NCSTR2
5418          ENDIF
5419 8020   CONTINUE
5420        IFORMT=' '
5421        IFORMT(1:6)='(A   )'
5422        WRITE(IFORMT(3:5),'(I3)')NCSTR
5423        IF(NCSTR.GE.1)THEN
5424          WRITE(ICOUT,IFORMT)ISTR(1:NCSTR)
5425          CALL DPWRST('XXX','WRIT')
5426        ENDIF
5427C
5428C  STEP 3: PRINT TRAILING RULE LINE
5429C
5430        IF(IFLAG2 .AND. NMAX.GT.0)THEN
5431          IFORMT=' '
5432          DO8030I=1,NMAX
5433            IATEMP(I:I)='-'
5434 8030     CONTINUE
5435          IFORMT(1:6)='(A   )'
5436          WRITE(IFORMT(3:5),'(I3)')NMAX
5437          WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
5438          CALL DPWRST('XXX','WRIT')
5439        ENDIF
5440C
5441      ENDIF
5442C
5443      RETURN
5444      END
5445      SUBROUTINE DPTAB5(IVALUE,NCHAR,AVALUE,NHEAD,IFLAG1,NMAX,NTOT,
5446     1                  ICSVWR)
5447C
5448C     PURPOSE--THIS ROUTINE IS A UTILITY ROUTINE FOR CREATING
5449C              TABULAR OUTPUT IN ASCII FORMAT.  THIS ROUTINE IS USED TO
5450C              GENERATE A DATA ROW FOR A TABLE.  THE FIRST FIELD CAN
5451C              BE A TEXT VALUE (FOR A ROW LABEL).
5452C
5453C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING CONTAINING
5454C                                 THE TEXT FOR THE FIRST COLUMN.
5455C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
5456C                                 THE NUMBER OF CHARACTERS IN THE
5457C                                 FIRST TEXT FIELD.
5458C                     --AVALUE  = A REAL ARRAY CONTAINING THE DATA
5459C                                 TO BE GENERATED.
5460C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
5461C                                 THE NUMBER OF NUMERIC VALUES.
5462C                     --IFLAG1  = A LOGICAL VALUE THAT SPECIFIES WHETHER
5463C                                 A RULE LINE WILL BE PRINTED AFTER THE
5464C                                 ROW
5465C                     --NMAX    = NUMBER OF CHARACTERS IN RULE LINE
5466C                     --NTOT    = AN INTEGER ARRAY CONTAINING THE TOTAL
5467C                                 NUMBER OF CHARACTERS IN EACH FIELD
5468C     WRITTEN BY--ALAN HECKERT
5469C                 STATISTICAL ENGINEERING DIVISION
5470C                 INFORMATION TECHNOLOGY LABOARATORY
5471C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5472C                 GAITHERSBURG, MD 20899-8980
5473C                 PHONE--301-975-2899
5474C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5475C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5476C     LANGUAGE--ANSI FORTRAN (1977)
5477C     VERSION NUMBER--2009/3
5478C     ORIGINAL VERSION--MARCH     2009.
5479C     UPDATED         --APRIL     2009. ADDITIONAL FORMATTING OPTIONS
5480C     UPDATED         --APRIL     2015. SUPPORT HORIZONTAL ALIGNMENT
5481C                                       (LEFT, CENTER, RIGHT)
5482C     UPDATED         --FEBRUARY  2020. OPTION FOR WRITING CVS FILES
5483C                                       (FOR IMPORTING INTO OTHER
5484C                                       PROGRAMS)
5485C
5486C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5487C
5488      CHARACTER*(*) IVALUE
5489      CHARACTER*4 ICSVWR
5490      REAL AVALUE(NHEAD)
5491      INTEGER NTOT(*)
5492      INTEGER NCHAR
5493C
5494      LOGICAL IFLAG1
5495C
5496      PARAMETER (MAXHED=1024)
5497      INTEGER IWIDTH(MAXHED)
5498      INTEGER NUMDIG(MAXHED)
5499      CHARACTER*8 ALIGN(MAXHED)
5500      CHARACTER*8 VALIGN(MAXHED)
5501      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
5502C
5503      CHARACTER*20  IFORMT
5504      CHARACTER*240 ISTR
5505      CHARACTER*255 IATEMP
5506C
5507C-----COMMON----------------------------------------------------------
5508C
5509      INCLUDE 'DPCOP2.INC'
5510C
5511C-----START POINT-----------------------------------------------------
5512C
5513C  STEP 1: PRINT ROW LABEL IF REQUESTED
5514C
5515      NCSTR=0
5516      ISTR=' '
5517      ICNT=0
5518      IF(NCHAR.GT.0)THEN
5519        ICNT=ICNT+1
5520        IF(ALIGN(ICNT).EQ.'l')THEN
5521          ISTR(NCSTR+1:NCSTR+NCHAR)=IVALUE(1:NCHAR)
5522          NCSTR=NCSTR+NCHAR
5523          IF(NTOT(ICNT).GT.NCHAR)THEN
5524            NCSTR=NCSTR+1
5525            NCSTR2=NCSTR+(NTOT(ICNT)-NCHAR)-1
5526            ISTR(NCSTR:NCSTR2)=' '
5527            NCSTR=NCSTR2
5528          ENDIF
5529        ELSEIF(ALIGN(ICNT).EQ.'r')THEN
5530          NSKIP=NTOT(ICNT) - NCHAR
5531          IF(NSKIP.GE.0)THEN
5532            ISTR(NSKIP+1:NSKIP+NCHAR)=IVALUE(1:NCHAR)
5533            NCSTR=NSKIP+NCHAR
5534          ELSE
5535            ISTR(1:NTOT(ICNT))=IVALUE(1:NTOT(ICNT))
5536            NCSTR=NTOT(ICNT)
5537          ENDIF
5538        ELSEIF(ALIGN(ICNT).EQ.'c')THEN
5539          NSKIP=NTOT(ICNT) - NCHAR
5540          NSKIP=NSKIP/2
5541          IF(NSKIP.GE.0)THEN
5542            ISTR(NSKIP+1:NSKIP+NCHAR)=IVALUE(1:NCHAR)
5543            NCSTR=NSKIP+NCHAR
5544          ELSE
5545            ISTR(1:NTOT(ICNT))=IVALUE(1:NTOT(ICNT))
5546            NCSTR=NTOT(ICNT)
5547          ENDIF
5548        ENDIF
5549        IF(ICSVWR.EQ.'ON')THEN
5550          NCSTR=NCSTR+1
5551          ISTR(NCSTR:NCSTR)=','
5552        ENDIF
5553      ENDIF
5554C
5555C     STEP 2: LOOP THROUGH THE NUMERIC FIELDS
5556C
5557C     APRIL 2009: SUPPORT THE FOLLOWING FORMATTING OPTIONS
5558C
5559C                  NUMDIG(I) > 0          => Fyy.xx FORMAT
5560C                  NUMDIG(I) = 0          => I12 FORMAT
5561C                  NUMDIG(I) = -1         => BLANK
5562C                  NUMDIG(I) = -2         => G15.7
5563C                  NUMDIG(I) = -3 to -20  => Eyy.xx
5564C                  NUMDIG(I) = -99        => '**'
5565C
5566      IF(NHEAD.GE.1)THEN
5567C
5568        DO8000I=1,NHEAD
5569          ICNT=ICNT+1
5570          IFORMT=' '
5571          ATEMP=AVALUE(I)
5572          IF(NUMDIG(I).GT.0)THEN
5573            NCHTOT=NTOT(ICNT)
5574            NCHDEC=NUMDIG(I)
5575            CALL GRTRR1(ATEMP,NCHTOT,NCHDEC,ISTR,NCSTR,ALIGN(ICNT))
5576          ELSEIF(NUMDIG(I).EQ.0)THEN
5577            IF(ATEMP.GE.0.0)THEN
5578              ITEMP=INT(ATEMP+0.5)
5579            ELSE
5580              ITEMP=INT(ATEMP-0.5)
5581            ENDIF
5582            NCHTOT=NTOT(ICNT)
5583            CALL GRTRI1(ITEMP,NCHTOT,ISTR,NCSTR,ALIGN(ICNT))
5584          ELSEIF(NUMDIG(I).EQ.-1)THEN
5585            NCSTR=NCSTR+1
5586            ISTR(NCSTR:NCSTR)=' '
5587          ELSEIF(NUMDIG(I).EQ.-2)THEN
5588            NCSTR=NCSTR+1
5589            NCSTR2=NCSTR+14
5590            WRITE(ISTR(NCSTR:NCSTR2),'(G15.7)')ATEMP
5591            NCSTR=NCSTR2
5592          ELSEIF(NUMDIG(I).LT.-2 .AND. NUMDIG(I).GT.-20)THEN
5593            IXX=ABS(NUMDIG(I))
5594            IYY=IXX+8
5595            NCSTR=NCSTR+1
5596            NCSTR2=NCSTR+IYY-1
5597            IFORMT='(E  .  )'
5598            WRITE(IFORMT(3:4),'(I2)')IYY
5599            WRITE(IFORMT(6:7),'(I2)')IXX
5600            WRITE(ISTR(NCSTR:NCSTR2),IFORMT)ATEMP
5601            NCSTR=NCSTR2
5602          ELSEIF(NUMDIG(I).EQ.-99)THEN
5603            NCHTOT=NTOT(ICNT)
5604            IF(NCHTOT.GT.2)THEN
5605              DO7010J=1,NCHTOT-2
5606                NCSTR=NCSTR+1
5607                ISTR(NCSTR:NCSTR)=' '
5608 7010         CONTINUE
5609            ENDIF
5610            NCSTR=NCSTR+1
5611            NCSTR2=NCSTR+1
5612            ISTR(NCSTR:NCSTR2)='**'
5613            NCSTR=NCSTR2
5614          ELSE
5615            NCSTR=NCSTR+1
5616            ISTR(NCSTR:NCSTR)=' '
5617          ENDIF
5618          IF(ICSVWR.EQ.'ON' .AND. I.LT.NHEAD)THEN
5619            NCSTR=NCSTR+1
5620            ISTR(NCSTR:NCSTR)=','
5621          ENDIF
5622 8000   CONTINUE
5623C
5624        IF(NCSTR.GE.1)THEN
5625          IFORMT='(A   )'
5626          WRITE(IFORMT(3:5),'(I3)')NCSTR
5627          WRITE(ICOUT,IFORMT)ISTR(1:NCSTR)
5628          CALL DPWRST('XXX','WRIT')
5629        ENDIF
5630C
5631C       STEP 3: WRITE RULE LINE IF REQUESTED
5632C
5633        IF(IFLAG1 .AND. NMAX.GT.0)THEN
5634          IFORMT=' '
5635          DO8030I=1,NMAX
5636            IATEMP(I:I)='-'
5637 8030     CONTINUE
5638          IFORMT(1:6)='(A   )'
5639          WRITE(IFORMT(3:5),'(I3)')NMAX
5640          WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
5641          CALL DPWRST('XXX','WRIT')
5642        ENDIF
5643C
5644      ENDIF
5645C
5646      RETURN
5647      END
5648      SUBROUTINE DPTAB6(IHEAD,NHEAD,CAPTN,NCAP,NMAX,IFLAG1,IFLAG2)
5649C
5650C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
5651C              TABULAR OUTPUT IN ASCII FORMAT.  THIS ROUTINE IS USED
5652C              TO INITIATE THE TABULAR OUTPUT.  IT WILL OPTIONALLY
5653C              DRAW A RULE LINE BEFORE AND/OR AFTER THE TITLE.
5654C              IS THE CAPTION.  THIS IS A VARIANT OF DPTAB1 (THIS
5655C              ROUTINE ALLOWS THE RULE LINES).
5656C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
5657C                                THE TEXT FOR THE HEADER
5658C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
5659C                                THE NUMBER OF CHARACTERS IN THE
5660C                                HEADER.
5661C                     --CAPTN  = THE CHARACTER STRING CONTAINING
5662C                                THE CAPTION.
5663C                     --NCAP   = THE INTEGER NUMBER THAT SPECIFIES
5664C                                THE NUMBER OF CHARACTERS IN THE
5665C                                CAPTION.
5666C                     --NMAX   = THE INTEGER NUMBER THAT SPECIFIES
5667C                                THE TOTAL NUMBER OF COLUMNS IN THE
5668C                                TABLE.
5669C                     --IFLAG1 = A LOGICAL PARAMETER THAT SPECIFIES
5670C                                WHETHER A RULE LINE IS DRAWN BEFORE
5671C                                THE TABLE HEADER.
5672C                     --IFLAG2 = A LOGICAL PARAMETER THAT SPECIFIES
5673C                                WHETHER A RULE LINE IS DRAWN AFTER
5674C                                THE TABLE HEADER.
5675C     WRITTEN BY--JAMES J. FILLIBEN
5676C                 STATISTICAL ENGINEERING DIVISION
5677C                 INFORMATION TECHNOLOGY LABOARATORY
5678C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5679C                 GAITHERSBURG, MD 20899-8980
5680C                 PHONE--301-975-2855
5681C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5682C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5683C     LANGUAGE--ANSI FORTRAN (1977)
5684C     VERSION NUMBER--2009/4
5685C     ORIGINAL VERSION--APRIL     2009.
5686C
5687C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5688C
5689      CHARACTER*(*) CAPTN
5690      CHARACTER*(*) IHEAD
5691C
5692      CHARACTER*132 IATEMP
5693C
5694      LOGICAL IFLAG1
5695      LOGICAL IFLAG2
5696      CHARACTER*10 IFORMT
5697C
5698C-----COMMON----------------------------------------------------------
5699C
5700      INCLUDE 'DPCOP2.INC'
5701C
5702C-----START POINT-----------------------------------------------------
5703C
5704C  STEP 1: WRITE A HEADER
5705C
5706  999 FORMAT(1X)
5707C
5708      IF(IFLAG1.AND.NMAX.GT.0)THEN
5709        WRITE(ICOUT,999)
5710        CALL DPWRST('XXX','WRIT')
5711        IFORMT=' '
5712        DO8010I=1,MIN(NMAX,132)
5713          IATEMP(I:I)='-'
5714 8010   CONTINUE
5715        IFORMT(1:6)='(A   )'
5716        WRITE(IFORMT(3:5),'(I3)')NMAX
5717        WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
5718        CALL DPWRST('XXX','WRIT')
5719      ENDIF
5720C
5721      IF(NHEAD.GE.1)THEN
5722        IFORMT=' '
5723        IFORMT(1:9)='(12X,A  )'
5724        WRITE(IFORMT(7:8),'(I2)')NHEAD
5725        WRITE(ICOUT,IFORMT)IHEAD(1:NHEAD)
5726        CALL DPWRST('XXX','WRIT')
5727        WRITE(ICOUT,999)
5728        CALL DPWRST('XXX','WRIT')
5729      ENDIF
5730C
5731C  STEP 2: START TABLE AND DEFINE A CAPTION
5732C
5733      IF(NCAP.GT.0)THEN
5734        IFORMT=' '
5735        IFORMT(1:5)='(A  )'
5736        WRITE(IFORMT(3:4),'(I2)')NCAP
5737        WRITE(ICOUT,IFORMT)CAPTN(1:NCAP)
5738        CALL DPWRST('XXX','WRIT')
5739      ENDIF
5740C
5741      IF(IFLAG2.AND.NMAX.GT.0)THEN
5742        WRITE(ICOUT,999)
5743        CALL DPWRST('XXX','WRIT')
5744        IFORMT=' '
5745        DO8090I=1,MIN(NMAX,132)
5746          IATEMP(I:I)='-'
5747 8090   CONTINUE
5748        IFORMT(1:6)='(A   )'
5749        WRITE(IFORMT(3:5),'(I3)')NMAX
5750        WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
5751        CALL DPWRST('XXX','WRIT')
5752      ENDIF
5753C
5754      RETURN
5755      END
5756      SUBROUTINE DPTABY(IVALUE,NCHAR,AVALUE,NHEAD,ITYPE,
5757     1                  IFLAGA,IFLAGB,NMAX,NTOT,ICSVWR,IOUNI1,
5758     1                  IBUGA3,ISUBRO)
5759C
5760C     PURPOSE--THIS ROUTINE IS A UTILITY ROUTINE FOR CREATING
5761C              TABULAR OUTPUT IN ASCII FORMAT.  THIS ROUTINE IS USED TO
5762C              GENERATE A DATA ROW FOR A TABLE WHERE THE FIELDS CAN
5763C              BE A MIX OF CHARACTER AND NUMERIC VALUES.
5764C
5765C     INPUT  ARGUMENTS--IVALUE  = AN ARRAY OF CHARACTER STRINGS.
5766C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
5767C                                 THE NUMBER OF CHARACTERS IN THE
5768C                                 CHARACTER FIELDS.
5769C                     --AVALUE  = A REAL ARRAY CONTAINING THE DATA
5770C                                 TO BE GENERATED.
5771C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
5772C                                 THE NUMBER OF NUMERIC VALUES.
5773C                     --ITYPE   = A CHARACTER ARRAY THAT SPECIFIES
5774C                                 WHICH FIELDS ARE NUMERIC AND
5775C                                 WHICH ARE CHARACTER.
5776C                     --IFLAGA  = GENERATE A SEPARATOR LINE AFTER THE
5777C                                 CURRENT LINE.
5778C                     --IFLAGB  = GENERATE A SEPARATOR LINE BEFORE THE
5779C                                 CURRENT LINE.
5780C                     --NMAX    = NUMBER OF CHARACTERS IN RULE LINE
5781C                     --NTOT    = AN INTEGER ARRAY CONTAINING THE TOTAL
5782C                                 NUMBER OF CHARACTERS IN EACH FIELD
5783C     WRITTEN BY--ALAN HECKERT
5784C                 STATISTICAL ENGINEERING DIVISION
5785C                 INFORMATION TECHNOLOGY LABOARATORY
5786C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5787C                 GAITHERSBURG, MD 20899-8980
5788C                 PHONE--301-975-2899
5789C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5790C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5791C     LANGUAGE--ANSI FORTRAN (1977)
5792C     VERSION NUMBER--2009/9
5793C     ORIGINAL VERSION--SEPTEMBER 2009.
5794C     UPDATED         --APRIL     2015. SUPPORT FOR HORIZONTAL ALIGNMENT
5795C                                       FOR Fx.x AND Ix FORMATS
5796C
5797C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5798C
5799      CHARACTER*(*) IVALUE(*)
5800      CHARACTER*4 ITYPE(*)
5801      CHARACTER*4 ICSVWR
5802      CHARACTER*4 IBUGA3
5803      CHARACTER*4 ISUBRO
5804      REAL AVALUE(NHEAD)
5805      INTEGER NCHAR(*)
5806      INTEGER NTOT(*)
5807C
5808      LOGICAL IFLAGA
5809      LOGICAL IFLAGB
5810C
5811      PARAMETER (MAXHED=1024)
5812      INTEGER IWIDTH(MAXHED)
5813      INTEGER NUMDIG(MAXHED)
5814      CHARACTER*8 ALIGN(MAXHED)
5815      CHARACTER*8 VALIGN(MAXHED)
5816      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
5817C
5818      CHARACTER*20  IFORMT
5819      CHARACTER*240 ISTR
5820      CHARACTER*132 IATEMP
5821C
5822C-----COMMON----------------------------------------------------------
5823C
5824      INCLUDE 'DPCOP2.INC'
5825C
5826C-----START POINT-----------------------------------------------------
5827C
5828C     STEP 1: LOOP THROUGH THE FIELDS
5829C
5830C     SUPPORT THE FOLLOWING FORMATTING OPTIONS FOR NUMERIC FIELDS
5831C
5832C           NUMDIG(I) > 0          => Fyy.xx FORMAT
5833C           NUMDIG(I) = 0          => I12 FORMAT
5834C           NUMDIG(I) = -1         => BLANK
5835C           NUMDIG(I) = -2         => G15.7
5836C           NUMDIG(I) = -3 to -20  => Eyy.xx
5837C           NUMDIG(I) = -99        => '**'
5838C
5839      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TABY')THEN
5840        WRITE(ICOUT,1001)NHEAD,NMAX
5841 1001   FORMAT('NHEAD,NMAX = ',2I8)
5842        CALL DPWRST('XXX','WRIT')
5843      ENDIF
5844C
5845      IF(NHEAD.GE.1)THEN
5846C
5847C       STEP 1: WRITE RULE LINE BEFORE CURRENT LINE IF REQUESTED
5848C
5849        IF(IFLAGB .AND. NMAX.GT.0)THEN
5850          IFORMT=' '
5851          DO7030I=1,NMAX
5852            IATEMP(I:I)='-'
5853 7030     CONTINUE
5854          IFORMT(1:6)='(A   )'
5855          WRITE(IFORMT(3:5),'(I3)')NMAX
5856          IF(IOUNI1.GT.0)THEN
5857            WRITE(IOUNI1,IFORMT)IATEMP(1:NMAX)
5858          ELSE
5859            WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
5860            CALL DPWRST('XXX','WRIT')
5861          ENDIF
5862C
5863          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TABY')THEN
5864            WRITE(ICOUT,7031)
5865 7031       FORMAT('AFTER WRITE BORDER LINE')
5866            CALL DPWRST('XXX','WRIT')
5867          ENDIF
5868C
5869        ENDIF
5870C
5871        ISTR=' '
5872        NCSTR=0
5873        ICNT=0
5874C
5875        DO8000I=1,NHEAD
5876          ICNT=ICNT+1
5877          IFORMT=' '
5878C
5879          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TABY')THEN
5880            WRITE(ICOUT,8001)I,ICNT,NCSTR,ITYPE(I)
5881 8001       FORMAT('I,ICNT,NCSTR,ITYPE(I) = ',3I8,2X,A4)
5882            CALL DPWRST('XXX','WRIT')
5883            WRITE(ICOUT,8002)I,AVALUE(I),NUMDIG(I)
5884 8002       FORMAT('I,AVALUE(I),NUMDIG(I) = ',I8,2X,G15.7,I8)
5885            CALL DPWRST('XXX','WRIT')
5886          ENDIF
5887C
5888          IF(ITYPE(I).NE.'ALPH')THEN
5889            ATEMP=AVALUE(I)
5890            IF(NUMDIG(I).GT.0)THEN
5891              NCHTOT=NTOT(ICNT)
5892              NCHDEC=NUMDIG(I)
5893              CALL GRTRR1(ATEMP,NCHTOT,NCHDEC,ISTR,NCSTR,ALIGN(ICNT))
5894            ELSEIF(NUMDIG(I).EQ.0)THEN
5895              IF(ATEMP.GE.0.0)THEN
5896                ITEMP=INT(ATEMP+0.5)
5897              ELSE
5898                ITEMP=INT(ATEMP-0.5)
5899              ENDIF
5900              NCHTOT=NTOT(ICNT)
5901              CALL GRTRI1(ITEMP,NCHTOT,ISTR,NCSTR,ALIGN(ICNT))
5902            ELSEIF(NUMDIG(I).EQ.-1)THEN
5903              NJUNK=NTOT(I)
5904              NCSTR=NCSTR+1
5905              NCSTR2=NCSTR+NJUNK-1
5906              ISTR(NCSTR:NCSTR2)=' '
5907              NCSTR=NCSTR2
5908            ELSEIF(NUMDIG(I).EQ.-2)THEN
5909              NCSTR=NCSTR+1
5910              NCSTR2=NCSTR+14
5911              WRITE(ISTR(NCSTR:NCSTR2),'(G15.7)')ATEMP
5912              NCSTR=NCSTR2
5913            ELSEIF(NUMDIG(I).LT.-2 .AND. NUMDIG(I).GT.-20)THEN
5914              IXX=ABS(NUMDIG(I))
5915              IYY=IXX+8
5916              NCSTR=NCSTR+1
5917              NCSTR2=NCSTR+IYY-1
5918              IFORMT='(E  .  )'
5919              WRITE(IFORMT(3:4),'(I2)')IYY
5920              WRITE(IFORMT(6:7),'(I2)')IXX
5921              WRITE(ISTR(NCSTR:NCSTR2),IFORMT)ATEMP
5922              NCSTR=NCSTR2
5923            ELSEIF(NUMDIG(I).EQ.-99)THEN
5924              NCHTOT=NTOT(ICNT)
5925              IF(NCHTOT.GT.2)THEN
5926                DO7010J=1,NCHTOT-2
5927                  NCSTR=NCSTR+1
5928                  ISTR(NCSTR:NCSTR)=' '
5929 7010         CONTINUE
5930              ENDIF
5931              NCSTR=NCSTR+1
5932              NCSTR2=NCSTR+1
5933              ISTR(NCSTR:NCSTR2)='**'
5934              NCSTR=NCSTR2
5935            ELSE
5936              NCSTR=NCSTR+1
5937              ISTR(NCSTR:NCSTR)=' '
5938            ENDIF
5939C
5940C         CHARACTER FIELDS
5941C
5942          ELSE
5943C
5944            NTEMP=NCHAR(I)
5945            IF(NTEMP.GT.NTOT(I))NTEMP=NTOT(I)
5946            NCSTR=NCSTR+1
5947            NCSTR3=NCSTR+NTOT(I)-1
5948            ISTR(NCSTR:NCSTR3)=' '
5949C
5950            IF(NTEMP.GT.0)THEN
5951              IF(ALIGN(I).EQ.'l')THEN
5952                NCSTR2=NCSTR+NTEMP-1
5953                ISTR(NCSTR:NCSTR2)=IVALUE(ICNT)(1:NTEMP)
5954              ELSEIF(ALIGN(I).EQ.'c')THEN
5955                NBLANK=(NTOT(I)-NTEMP)/2
5956                NCSTR=NCSTR+NBLANK
5957                NCSTR2=NCSTR+NTEMP-1
5958                ISTR(NCSTR:NCSTR2)=IVALUE(ICNT)(1:NTEMP)
5959              ELSEIF(ALIGN(I).EQ.'r')THEN
5960                NBLANK=NTOT(I)-NTEMP
5961                NCSTR=NCSTR+NBLANK
5962                NCSTR2=NCSTR+NTEMP-1
5963                ISTR(NCSTR:NCSTR2)=IVALUE(ICNT)(1:NTEMP)
5964              ENDIF
5965            ENDIF
5966            NCSTR=NCSTR3
5967          ENDIF
5968C
5969          IF(ICSVWR.EQ.'ON' .AND. I.LT.NHEAD)THEN
5970            NCSTR=NCSTR+1
5971            ISTR(NCSTR:NCSTR)=','
5972          ENDIF
5973C
5974 8000   CONTINUE
5975C
5976        IF(NCSTR.GE.1)THEN
5977          IFORMT='(A   )'
5978          WRITE(IFORMT(3:5),'(I3)')NCSTR
5979          IF(IOUNI1.GT.0)THEN
5980            WRITE(IOUNI1,IFORMT)ISTR(1:NCSTR)
5981          ELSE
5982            WRITE(ICOUT,IFORMT)ISTR(1:NCSTR)
5983            CALL DPWRST('XXX','WRIT')
5984          ENDIF
5985        ENDIF
5986C
5987C       STEP 3: WRITE RULE LINE AFTER CURRENT LINE IF REQUESTED
5988C
5989        IF(IFLAGA .AND. NMAX.GT.0)THEN
5990          IFORMT=' '
5991          DO8030I=1,NMAX
5992            IATEMP(I:I)='-'
5993 8030     CONTINUE
5994          IFORMT(1:6)='(A   )'
5995          WRITE(IFORMT(3:5),'(I3)')NMAX
5996          IF(IOUNI1.GT.0)THEN
5997            WRITE(IOUNI1,IFORMT)IATEMP(1:NMAX)
5998          ELSE
5999            WRITE(ICOUT,IFORMT)IATEMP(1:NMAX)
6000            CALL DPWRST('XXX','WRIT')
6001          ENDIF
6002        ENDIF
6003C
6004      ENDIF
6005C
6006      RETURN
6007      END
6008      SUBROUTINE DPTAC2(Y1,Y2,Y3,TAG1,TAG2,TAG3,TAG4,N,YLEVEL,NLEVEL,
6009     1                  NUMV2,ICASCT,ICTNAM,ISTANR,
6010     1                  XIDTEM,XIDTE2,XIDTE3,XIDTE4,
6011     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
6012     1                  TEMP6,TEMP7,TEMP8,TEMP9,TMP10,TMP11,
6013     1                  XACLOW,XACUPP,
6014     1                  ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
6015     1                  DTEMP1,DTEMP2,DTEMP3,
6016     1                  ISEED,ICTAMV,PSTAMV,PCTAMV,ALPHA,IQUASE,
6017     1                  NCRTV,MAXOBV,PTPLXI,PTPLYI,ITPLDI,ITPLUN,
6018     1                  ITPLNI,ITPLCD,ITPLSO,ITPLSR,ITPLSC,
6019     1                  ITPLRM,ITPLCM,
6020     1                  Y,X,D,X3D,
6021     1                  NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
6022C
6023C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
6024C              THAT WILL DEFINE AN TABULATION PLOT
6025C
6026C              THIS SUPPORTS THE "CHARACTER" VARIANT.  IN THIS VARIANT, WE PLOT
6027C              THE VALUE OF THE STATISTIC (FOR RAW DATA, WE CAN USE THE MEAN AS
6028C              THE DESIRED STATISTIC).
6029C
6030C     DESCRIPTION--IN THE TABULATION PLOT, WE CROSS-TABULATE OVER
6031C                  1 TO 4 GROUP-ID VARIABLES (ANALAGOUS TO A
6032C                  FLUCTUATION PLOT).  WE DEFINE A GRID BASED ON THE
6033C                  THESE GROUP-ID VARIABLES.  THEN FOR THE RESPONSE
6034C                  VALUES CORRESPONDING TO A GIVEN SET OF THESE
6035C                  GROUP-ID VARIABLES, WE COMPUTE A USER-SPECIFED
6036C                  STATISTIC (THE DEFAULT IS THE MEAN).  THE VALUE
6037C                  OF THE STATISTIC IS THEN COMPARED TO SOME
6038C                  USER-SPECIFIED LEVELS (THESE ARE DEFINED IN THE
6039C                  YLEVEL VARIABLE).  A RECTANGLE IS DRAWN AND THE
6040C                  ATTRIBUTES (PRIMARILY FILL COLOR) ARE BASED ON
6041C                  THE VALUE OF THE STATISTIC RELATIVE TO YLEVEL.
6042C
6043C                  THIS PLOT IS USEFUL FOR VISUALLY IDENTIFYING
6044C                  AREAS WITH "HIGH" AND "LOW" VALUES OF THE
6045C                  STATISTIC ACROSS GROUPS.
6046C     WRITTEN BY--ALAN HECKERT
6047C                 STATISTICAL ENGINEERING DIVISION
6048C                 INFORMATION TECHNOLOGY LABORATORY
6049C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6050C                 GAITHERSBURG, MD 20899-8980
6051C                 PHONE--301-975-2889
6052C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6053C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6054C     LANGUAGE--ANSI FORTRAN (1977)
6055C     VERSION NUMBER--2010/6
6056C     ORIGINAL VERSION--JUNE      2010. THIS VARIANT ADDED TO THE
6057C                                       TABULATION PLOT
6058C     UPDATED         --AUGUST    2010. ROW/COLUMN "MINMAX" OPTION
6059C                                       FOR TWO GROUP-ID VARIABLES CASE
6060C
6061C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6062C
6063      CHARACTER*4 ICASCT
6064      CHARACTER*60 ICTNAM
6065      CHARACTER*4 ICTAMV
6066      CHARACTER*4 IQUASE
6067      CHARACTER*4 ITPLDI
6068      CHARACTER*4 ITPLUN
6069      CHARACTER*4 ITPLCD
6070      CHARACTER*4 ITPLSO
6071      CHARACTER*4 ITPLSR
6072      CHARACTER*4 ITPLSC
6073      CHARACTER*4 ITPLCM
6074      CHARACTER*4 ITPLRM
6075      CHARACTER*4 ISUBRO
6076      CHARACTER*4 IBUGG3
6077      CHARACTER*4 IERROR
6078C
6079      CHARACTER*4 IWRITE
6080      CHARACTER*4 ISUBN1
6081      CHARACTER*4 ISUBN2
6082      CHARACTER*4 ISTEPN
6083C
6084C---------------------------------------------------------------------
6085C
6086      DIMENSION Y1(*)
6087      DIMENSION Y2(*)
6088      DIMENSION Y3(*)
6089      DIMENSION YLEVEL(*)
6090      DIMENSION TAG1(*)
6091      DIMENSION TAG2(*)
6092      DIMENSION TAG3(*)
6093      DIMENSION TAG4(*)
6094C
6095      DIMENSION XIDTEM(*)
6096      DIMENSION XIDTE2(*)
6097      DIMENSION XIDTE3(*)
6098      DIMENSION XIDTE4(*)
6099C
6100      DIMENSION TEMP1(*)
6101      DIMENSION TEMP2(*)
6102      DIMENSION TEMP3(*)
6103      DIMENSION TEMP4(*)
6104      DIMENSION TEMP5(*)
6105      DIMENSION TEMP6(*)
6106      DIMENSION TEMP7(*)
6107      DIMENSION TEMP8(*)
6108      DIMENSION TEMP9(*)
6109      DIMENSION TMP10(*)
6110      DIMENSION TMP11(*)
6111C
6112      DIMENSION ITEMP1(*)
6113      DIMENSION ITEMP2(*)
6114      DIMENSION ITEMP3(*)
6115      DIMENSION ITEMP4(*)
6116      DIMENSION ITEMP5(*)
6117      DIMENSION ITEMP6(*)
6118C
6119      DOUBLE PRECISION DTEMP1(*)
6120      DOUBLE PRECISION DTEMP2(*)
6121      DOUBLE PRECISION DTEMP3(*)
6122C
6123      DIMENSION Y(*)
6124      DIMENSION X(*)
6125      DIMENSION D(*)
6126      DIMENSION X3D(*)
6127C
6128      DIMENSION XACLOW(*)
6129      DIMENSION XACUPP(*)
6130C
6131      COMMON/ITABC2/IADD
6132C
6133C-----COMMON----------------------------------------------------------
6134C
6135      INCLUDE 'DPCOP2.INC'
6136C
6137C-----START POINT-----------------------------------------------------
6138C
6139      ISUBN1='DPTA'
6140      ISUBN2='C2  '
6141      IWRITE='OFF'
6142      IERROR='NO'
6143      IADD=0
6144C
6145C               ********************************************
6146C               **  STEP 1--                              **
6147C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
6148C               ********************************************
6149C
6150C
6151C     CHECK THE INPUT ARGUMENTS FOR ERRORS
6152C
6153      IF(N.LT.2)THEN
6154        WRITE(ICOUT,999)
6155  999   FORMAT(1X)
6156        CALL DPWRST('XXX','BUG ')
6157        WRITE(ICOUT,31)
6158   31   FORMAT('***** ERROR IN CHARACTER TABULATION PLOT--')
6159        CALL DPWRST('XXX','BUG ')
6160        WRITE(ICOUT,32)
6161   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
6162        CALL DPWRST('XXX','BUG ')
6163        WRITE(ICOUT,34)N
6164   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
6165        CALL DPWRST('XXX','BUG ')
6166        WRITE(ICOUT,999)
6167        CALL DPWRST('XXX','BUG ')
6168        IERROR='YES'
6169        GOTO9000
6170      ENDIF
6171C
6172      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAC2')THEN
6173        WRITE(ICOUT,70)
6174   70   FORMAT('AT THE BEGINNING OF DPTAC2--')
6175        CALL DPWRST('XXX','BUG ')
6176        WRITE(ICOUT,71)ICASCT,N,NUMV2,NCRTV,NLEVEL,ISTANR
6177   71   FORMAT('ICASCT,N,NUMV2,NCRTV,NLEVEL,ISTANR = ',A4,2X,5I8)
6178        CALL DPWRST('XXX','BUG ')
6179        WRITE(ICOUT,74)ICTNAM
6180   74   FORMAT('ICTNAM = ',A60)
6181        CALL DPWRST('XXX','BUG ')
6182        WRITE(ICOUT,78)ITPLUN,ITPLNI,PTPLXI,PTPLYI
6183   78   FORMAT('ITPLUN,ITPLNI,PTPLXI,PTPLYI = ',A4,2X,I8,2G15.7)
6184        CALL DPWRST('XXX','BUG ')
6185        DO72I=1,N
6186          WRITE(ICOUT,73)I,Y1(I),Y2(I),TAG1(I),TAG2(I),TAG3(I),
6187     1                   TAG4(I)
6188   73     FORMAT('I,Y(I),Y2(I),TAG1-6(I) = ',I8,9F10.3)
6189          CALL DPWRST('XXX','BUG ')
6190   72   CONTINUE
6191        IF(NLEVEL.GE.1)THEN
6192          DO82I=1,NLEVEL
6193            WRITE(ICOUT,83)I,YLEVEL(I)
6194   83       FORMAT('I,YLEVEL(I) = ',I8,G15.7)
6195            CALL DPWRST('XXX','BUG ')
6196   82     CONTINUE
6197        ENDIF
6198      ENDIF
6199C
6200      IF(NLEVEL.GE.1)THEN
6201        CALL DISTIN(YLEVEL,NLEVEL,IWRITE,TEMP1,NTEMP,IBUGG3,IERROR)
6202        DO110I=1,NTEMP
6203          YLEVEL(I)=TEMP1(I)
6204  110   CONTINUE
6205        NLEVEL=NTEMP
6206        CALL SORT(YLEVEL,NLEVEL,YLEVEL)
6207      ENDIF
6208C
6209C               ******************************************************
6210C               **  STEP 1--                                        **
6211C               **  DETERMINE THE NUMBER OF DISTINCT VALUES         **
6212C               **  FOR THE GROUP VARIABLES (TAG1, TAG2)            **
6213C               **  IF ALL VALUES ARE DISTINCT, THEN THIS           **
6214C               **  IMPLIES WE HAVE THE NO REPLICATION CASE         **
6215C               **  WHICH IS AN ERROR CONDITION FOR A PLOT.         **
6216C               ******************************************************
6217C
6218      ISTEPN='1'
6219      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAC2')
6220     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6221C
6222      IF(ITPLCD.EQ.'ON')THEN
6223        CALL CODE(TAG1,N,IWRITE,TEMP1,TEMP2,MAXOBV,IBUGG3,IERROR)
6224        DO910I=1,N
6225          TAG1(I)=TEMP1(I)
6226  910   CONTINUE
6227      ENDIF
6228      CALL DISTIN(TAG1,N,IWRITE,XIDTEM,NUMSE1,IBUGG3,IERROR)
6229      CALL SORT(XIDTEM,NUMSE1,XIDTEM)
6230C
6231      IF(NCRTV.GE.2)THEN
6232        IF(ITPLCD.EQ.'ON')THEN
6233          CALL CODE(TAG2,N,IWRITE,TEMP1,TEMP2,MAXOBV,IBUGG3,IERROR)
6234          DO920I=1,N
6235            TAG2(I)=TEMP1(I)
6236  920     CONTINUE
6237        ENDIF
6238        CALL DISTIN(TAG2,N,IWRITE,XIDTE2,NUMSE2,IBUGG3,IERROR)
6239        CALL SORT(XIDTE2,NUMSE2,XIDTE2)
6240      ENDIF
6241C
6242      IF(NCRTV.GE.3)THEN
6243        IF(ITPLCD.EQ.'ON')THEN
6244          CALL CODE(TAG3,N,IWRITE,TEMP1,TEMP2,MAXOBV,IBUGG3,IERROR)
6245          DO930I=1,N
6246            TAG3(I)=TEMP1(I)
6247  930     CONTINUE
6248        ENDIF
6249        CALL DISTIN(TAG3,N,IWRITE,XIDTE3,NUMSE3,IBUGG3,IERROR)
6250        CALL SORT(XIDTE3,NUMSE3,XIDTE3)
6251      ELSE
6252        NUMSE3=0
6253      ENDIF
6254C
6255      IF(NCRTV.GE.4)THEN
6256        IF(ITPLCD.EQ.'ON')THEN
6257          CALL CODE(TAG4,N,IWRITE,TEMP1,TEMP2,MAXOBV,IBUGG3,IERROR)
6258          DO940I=1,N
6259            TAG4(I)=TEMP1(I)
6260  940     CONTINUE
6261        ENDIF
6262        CALL DISTIN(TAG4,N,IWRITE,XIDTE4,NUMSE4,IBUGG3,IERROR)
6263        CALL SORT(XIDTE4,NUMSE4,XIDTE4)
6264      ELSE
6265        NUMSE4=0
6266      ENDIF
6267C
6268      IF(NUMSE1.LT.1 .OR. NUMSE1.GT.N)THEN
6269        WRITE(ICOUT,999)
6270        CALL DPWRST('XXX','BUG ')
6271        WRITE(ICOUT,31)
6272        CALL DPWRST('XXX','BUG ')
6273        ITEMP=1
6274        WRITE(ICOUT,111)ITEMP,NUMSE1
6275  111   FORMAT('      THE NUMBER OF SETS FOR THE GROUP ',I1,
6276     1         ' VARIABLE, ',I8,',')
6277        CALL DPWRST('XXX','BUG ')
6278        WRITE(ICOUT,113)
6279  113   FORMAT('      IS EITHER LESS THAN ONE OR GREATER THAN THE ',
6280     1         'NUMBER')
6281        CALL DPWRST('XXX','BUG ')
6282        WRITE(ICOUT,115)N
6283  115   FORMAT('      OF OBSERVATIONS, ',I8,'.')
6284        CALL DPWRST('XXX','BUG ')
6285        IERROR='YES'
6286        GOTO9000
6287      ENDIF
6288C
6289      IF(NCRTV.GE.2 .AND. (NUMSE2.LT.1 .OR. NUMSE2.GT.N))THEN
6290        WRITE(ICOUT,999)
6291        CALL DPWRST('XXX','BUG ')
6292        WRITE(ICOUT,31)
6293        CALL DPWRST('XXX','BUG ')
6294        ITEMP=2
6295        WRITE(ICOUT,111)ITEMP,NUMSE2
6296        CALL DPWRST('XXX','BUG ')
6297        WRITE(ICOUT,113)
6298        CALL DPWRST('XXX','BUG ')
6299        WRITE(ICOUT,115)N
6300        CALL DPWRST('XXX','BUG ')
6301        IERROR='YES'
6302        GOTO9000
6303      ENDIF
6304C
6305      IF(NCRTV.GE.3 .AND. (NUMSE3.LT.1 .OR. NUMSE3.GT.N))THEN
6306        WRITE(ICOUT,999)
6307        CALL DPWRST('XXX','BUG ')
6308        WRITE(ICOUT,31)
6309        CALL DPWRST('XXX','BUG ')
6310        ITEMP=3
6311        WRITE(ICOUT,111)ITEMP,NUMSE3
6312        CALL DPWRST('XXX','BUG ')
6313        WRITE(ICOUT,113)
6314        CALL DPWRST('XXX','BUG ')
6315        WRITE(ICOUT,115)N
6316        CALL DPWRST('XXX','BUG ')
6317        IERROR='YES'
6318        GOTO9000
6319      ENDIF
6320C
6321      IF(NCRTV.GE.4 .AND. (NUMSE4.LT.1 .OR. NUMSE4.GT.N))THEN
6322        WRITE(ICOUT,999)
6323        CALL DPWRST('XXX','BUG ')
6324        WRITE(ICOUT,31)
6325        CALL DPWRST('XXX','BUG ')
6326        ITEMP=4
6327        WRITE(ICOUT,111)ITEMP,NUMSE4
6328        CALL DPWRST('XXX','BUG ')
6329        WRITE(ICOUT,113)
6330        CALL DPWRST('XXX','BUG ')
6331        WRITE(ICOUT,115)N
6332        CALL DPWRST('XXX','BUG ')
6333        IERROR='YES'
6334        GOTO9000
6335      ENDIF
6336C
6337      AN=REAL(N)
6338      ANUMS1=REAL(NUMSE1)
6339      ANUMS2=REAL(NUMSE2)
6340      ANUMS3=REAL(NUMSE3)
6341      ANUMS4=REAL(NUMSE4)
6342C
6343C               ***********************************************
6344C               **  STEP 5--                                 **
6345C               **  COMPUTE THE VARIOUS CROSS-TAB STATISTICS **
6346C               ***********************************************
6347C
6348      ISTEPN='5.1'
6349      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAC2')THEN
6350        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6351        WRITE(ICOUT,201)NUMSE1,NUMSE2,NUMSE3,NUMSE4
6352  201   FORMAT('NUMSE1,NUMSE2,NUMSE3,NUMSE4 = ',4I8)
6353        CALL DPWRST('XXX','BUG ')
6354        IF(NUMSE1.GE.1)THEN
6355          DO210I=1,NUMSE1
6356            WRITE(ICOUT,211)I,XIDTEM(I)
6357  211       FORMAT('I,XIDTEM(I) = ',I8,G15.7)
6358            CALL DPWRST('XXX','BUG ')
6359  210     CONTINUE
6360        ENDIF
6361C
6362        IF(NUMSE2.GE.1)THEN
6363          DO220I=1,NUMSE2
6364            WRITE(ICOUT,221)I,XIDTE2(I)
6365  221       FORMAT('I,XIDTE2(I) = ',I8,G15.7)
6366            CALL DPWRST('XXX','BUG ')
6367  220     CONTINUE
6368        ENDIF
6369      ENDIF
6370C
6371      IWRITE='OFF'
6372C
6373      IF(NCRTV.EQ.1)THEN
6374        CALL DPTAP0(Y1,Y2,Y3,TAG1,N,
6375     1              NUMV2,ICASCT,ISTANR,
6376     1              XIDTEM,
6377     1              NUMSE1,
6378     1              TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
6379     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
6380     1              DTEMP1,DTEMP2,DTEMP3,
6381     1              ISEED,ALPHA,
6382     1              ICTAMV,PCTAMV,PSTAMV,IQUASE,
6383     1              TEMP6,TEMP7,XACLOW,XACUPP,N2,
6384     1              ISUBRO,IBUGG3,IERROR)
6385C
6386CCCCC   NOW GENERATE THE PLOT COORDINATES.  SET "X3D" TO VALUE
6387CCCCC   OF STATISTIC FOR EACH POINT.
6388C
6389        ICNT=0
6390C
6391        DO1001I=1,N2
6392          STAT=TEMP6(I)
6393          IF(ITPLDI.EQ.'X')THEN
6394            XVAL=TEMP7(I)
6395            YVAL=1.0
6396          ELSE
6397            YVAL=TEMP7(I)
6398            XVAL=1.0
6399          ENDIF
6400          XCOOR1=XVAL
6401          YCOOR1=YVAL
6402          IF(STAT.LT.YLEVEL(1))THEN
6403            ILEVEL=1
6404          ELSEIF(STAT.GE.YLEVEL(NLEVEL))THEN
6405            ILEVEL=NLEVEL+1
6406          ELSE
6407            DO1003J=2,NLEVEL
6408              IF(STAT.GE.YLEVEL(J-1) .AND. STAT.LT.YLEVEL(J))THEN
6409                ILEVEL=J
6410              ENDIF
6411 1003       CONTINUE
6412          ENDIF
6413C
6414          ICNT=ICNT+1
6415          X(ICNT)=XCOOR1
6416          Y(ICNT)=YCOOR1
6417          X3D(ICNT)=STAT
6418          D(ICNT)=REAL(ILEVEL)
6419C
6420 1001   CONTINUE
6421C
6422        NPLOTP=ICNT
6423        NPLOTV=2
6424C
6425C       WHEN THERE ARE EXACTLY TWO CROSS-TABULATION VARIABLES, THEN
6426C       SUPPORT A "SORT" OPTION.  FIRST NEED TO OBTAIN ROW AND COLUMN
6427C       VALUES FOR THE STATISTICS.  FROM THESE, CREATE "INDEX" VARIABLES.
6428C
6429      ELSEIF(NCRTV.EQ.2)THEN
6430C
6431C       SORT THE ROWS.  FOR THIS APPLICATION, NEED A RANK.  SINCE THE
6432C       RANK WILL SERVE AS AN ARRAY INDEX, NEED TO CHECK FOR TIES.
6433C
6434        IF(ITPLSO.EQ.'ON' .OR. ITPLSO.EQ.'ROW')THEN
6435          CALL DPTAP0(Y1,Y2,Y3,TAG1,N,
6436     1                NUMV2,ICASCT,ISTANR,
6437     1                XIDTEM,
6438     1                NUMSE1,
6439     1                TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
6440     1                ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
6441     1                DTEMP1,DTEMP2,DTEMP3,
6442     1                ISEED,ALPHA,
6443     1                ICTAMV,PCTAMV,PSTAMV,IQUASE,
6444     1                TEMP9,TEMP7,XACLOW,XACUPP,N2,
6445     1                ISUBRO,IBUGG3,IERROR)
6446          CALL RANKI(TEMP9,NUMSE1,IWRITE,XIDTE3,TEMP7,ITEMP1,MAXOBV,
6447     1              IBUGG3,IERROR)
6448          CALL DISTIN(XIDTE3,NUMSE1,IWRITE,TEMP7,NTEMP,IBUGG3,IERROR)
6449          IF(NTEMP.NE.NUMSE1)THEN
6450            DO1006II=1,NUMSE1
6451              XIDTE3(II)=XIDTEM(II)
6452 1006       CONTINUE
6453          ENDIF
6454          IF(ITPLSR.EQ.'DESC')THEN
6455            DO2006I=1,N
6456              IRANK=INT(XIDTE3(I)+0.1)
6457              IRANK2=NUMSE1 - IRANK + 1
6458              XIDTE3(I)=REAL(IRANK2)
6459 2006       CONTINUE
6460          ENDIF
6461        ELSE
6462          IF(ITPLSR.EQ.'DESC')THEN
6463            DO3007II=1,NUMSE1
6464              IVAL=NUMSE1 - II + 1
6465              XIDTE3(II)=XIDTEM(IVAL)
6466 3007       CONTINUE
6467          ELSE
6468            DO1007II=1,NUMSE1
6469              XIDTE3(II)=XIDTEM(II)
6470 1007       CONTINUE
6471          ENDIF
6472        ENDIF
6473C
6474C       SORT THE COLUMNS
6475C
6476        IF(ITPLSO.EQ.'ON' .OR. ITPLSO.EQ.'COLU')THEN
6477          CALL DPTAP0(Y1,Y2,Y3,TAG2,N,
6478     1                NUMV2,ICASCT,ISTANR,
6479     1                XIDTE2,
6480     1                NUMSE2,
6481     1                TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
6482     1                ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
6483     1                DTEMP1,DTEMP2,DTEMP3,
6484     1                ISEED,ALPHA,
6485     1                ICTAMV,PCTAMV,PSTAMV,IQUASE,
6486     1                TMP10,TEMP7,XACLOW,XACUPP,N2,
6487     1                ISUBRO,IBUGG3,IERROR)
6488          CALL RANKI(TMP10,NUMSE2,IWRITE,XIDTE4,TEMP7,ITEMP1,MAXOBV,
6489     1              IBUGG3,IERROR)
6490          CALL DISTIN(XIDTE4,NUMSE2,IWRITE,TEMP7,NTEMP,IBUGG3,IERROR)
6491          IF(NTEMP.NE.NUMSE2)THEN
6492            DO1008II=1,NUMSE2
6493              XIDTE4(II)=XIDTE2(II)
6494 1008       CONTINUE
6495          ENDIF
6496          IF(ITPLSC.EQ.'DESC')THEN
6497            DO2008I=1,N
6498              IRANK=INT(XIDTE4(I)+0.1)
6499              IRANK2=NUMSE2 - IRANK + 1
6500              XIDTE4(I)=REAL(IRANK2)
6501 2008       CONTINUE
6502          ENDIF
6503        ELSE
6504          IF(ITPLSR.EQ.'DESC')THEN
6505            DO3008II=1,NUMSE2
6506              IVAL=NUMSE2 - II + 1
6507              XIDTE4(II)=XIDTE2(IVAL)
6508 3008       CONTINUE
6509          ELSE
6510             DO1009II=1,NUMSE2
6511              XIDTE4(II)=XIDTE2(II)
6512 1009       CONTINUE
6513          ENDIF
6514        ENDIF
6515C
6516        CALL DPTAP3(Y1,Y2,Y3,TAG1,TAG2,N,
6517     1              NUMV2,ICASCT,ISTANR,
6518     1              XIDTEM,XIDTE2,
6519     1              NUMSE1,NUMSE2,
6520     1              TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
6521     1              TMP10,TMP11,ITPLCM,ITPLRM,
6522     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
6523     1              DTEMP1,DTEMP2,DTEMP3,
6524     1              ISEED,ALPHA,
6525     1              ICTAMV,PCTAMV,PSTAMV,IQUASE,
6526     1              TEMP6,TEMP7,TEMP8,XACLOW,XACUPP,N2,
6527     1              ISUBRO,IBUGG3,IERROR)
6528C
6529CCCCC   NOW GENERATE THE PLOT COORDINATES.
6530C
6531        ICNT=0
6532C
6533        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAC2')THEN
6534          WRITE(ICOUT,1011)N2,ITPLSO,ITPLDI
6535 1011     FORMAT('DPTAC2 AFTER CALL DPTAP3: N2,ITPLSO,ITPLDI = ',
6536     1           I8,A4,2X,A4)
6537          CALL DPWRST('XXX','BUG ')
6538          DO1012I=1,NUMSE1
6539            WRITE(ICOUT,1013)I,XIDTE3(I)
6540 1013       FORMAT('I,XIDTE3(I) = ',I8,G15.7)
6541            CALL DPWRST('XXX','BUG ')
6542 1012     CONTINUE
6543          DO1014I=1,NUMSE2
6544            WRITE(ICOUT,1015)I,XIDTE4(I)
6545 1015       FORMAT('I,XIDTE4(I) = ',I8,G15.7)
6546            CALL DPWRST('XXX','BUG ')
6547 1014     CONTINUE
6548        ENDIF
6549C
6550        DO1010I=1,N2
6551          STAT=TEMP6(I)
6552C
6553          IF(ITPLDI.EQ.'X')THEN
6554            INDEXX=INT(TEMP7(I)+0.1)
6555            INDEXY=INT(TEMP8(I)+0.1)
6556            XVAL=XIDTE3(INDEXX)
6557            YVAL=XIDTE4(INDEXY)
6558          ELSE
6559CCCCC       INDEXX=INT(TEMP8(I)+0.1)
6560CCCCC       INDEXY=INT(TEMP7(I)+0.1)
6561CCCCC       XVAL=XIDTE4(INDEXX)
6562CCCCC       YVAL=XIDTE3(INDEXY)
6563            INDEXX=INT(TEMP8(I)+0.1)
6564            INDEXY=INT(TEMP7(I)+0.1)
6565            XVAL=XIDTE4(INDEXX)
6566            YVAL=XIDTE3(INDEXY)
6567          ENDIF
6568C
6569          XCOOR1=XVAL
6570          YCOOR1=YVAL
6571          ILEVEL=-99
6572          IF(NLEVEL.GE.1)THEN
6573            IF(STAT.LT.YLEVEL(1))THEN
6574              ILEVEL=1
6575            ELSEIF(STAT.GE.YLEVEL(NLEVEL))THEN
6576              ILEVEL=NLEVEL+1
6577            ELSE
6578              DO1016J=2,NLEVEL
6579                IF(STAT.GE.YLEVEL(J-1) .AND. STAT.LT.YLEVEL(J))THEN
6580                  ILEVEL=J
6581                ENDIF
6582 1016         CONTINUE
6583            ENDIF
6584          ENDIF
6585C
6586          IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAC2')THEN
6587            WRITE(ICOUT,1017)I,STAT,INDEXX,XVAL,XCOOR1,
6588     1                       INDEXY,YVAL,YCOOR1
6589 1017       FORMAT('I,STAT,INDEXX,XVAL,XCOOR1,INDEXY,YVAL,YCOOR1 = ',
6590     1             I8,G15.7,2(I6,2F12.5))
6591            CALL DPWRST('XXX','BUG ')
6592          ENDIF
6593C
6594          ICNT=ICNT+1
6595          X(ICNT)=XCOOR1
6596          Y(ICNT)=YCOOR1
6597          X3D(ICNT)=STAT
6598          D(ICNT)=REAL(ILEVEL)
6599C
6600 1010   CONTINUE
6601C
6602C       IF REQUESTED, FLAG COLUMN/ROW MIN/MAX POINTS
6603C
6604        IF(ITPLCM.EQ.'OFF' .AND. ITPLRM.EQ.'OFF')GOTO5099
6605C
6606C       PERFORM DUPLICATION OF ARRAYS FIRST (ADD MIN/MAX PART
6607C       AT END)
6608C
6609        IF(ICNT.GT.0)THEN
6610          DO5010I=1,ICNT
6611            ICNT=ICNT+1
6612            X(ICNT)=X(I)
6613            Y(ICNT)=Y(I)
6614            X3D(ICNT)=X3D(I)
6615            D(ICNT)=D(I) + REAL(NLEVEL+1)
6616 5010     CONTINUE
6617        ENDIF
6618        CALL MAXIM(D,ICNT,IWRITE,DMAX,IBUGG3,IERROR)
6619C
6620        IF(ITPLDI.EQ.'Y')THEN
6621          IADD=0
6622C
6623          IF(ITPLCM.EQ.'ON')THEN
6624            IADD=IADD+1
6625            DO5020I=1,N2
6626              IF(TMP10(I).EQ.1.0)THEN
6627                ICNT=ICNT+1
6628                X(ICNT)=X(I)
6629                Y(ICNT)=Y(I)
6630                X3D(ICNT)=X3D(I)
6631                D(ICNT)=REAL(2*(NLEVEL+1)+IADD)
6632              ENDIF
6633              IF(TMP10(I).EQ.2.0)THEN
6634                ICNT=ICNT+1
6635                X(ICNT)=X(I)
6636                Y(ICNT)=Y(I)
6637                X3D(ICNT)=X3D(I)
6638                D(ICNT)=REAL(2*(NLEVEL+1)+IADD+1)
6639              ENDIF
6640 5020       CONTINUE
6641          ENDIF
6642C
6643          IF(ITPLRM.EQ.'ON')THEN
6644            IADD=IADD+1
6645            DO5030I=1,N2
6646              IF(TMP11(I).EQ.1.0)THEN
6647                ICNT=ICNT+1
6648                X(ICNT)=X(I)
6649                Y(ICNT)=Y(I)
6650                X3D(ICNT)=X3D(I)
6651                D(ICNT)=REAL(2*(NLEVEL+1)+IADD)
6652              ENDIF
6653              IF(TMP11(I).EQ.2.0)THEN
6654                ICNT=ICNT+1
6655                X(ICNT)=X(I)
6656                Y(ICNT)=Y(I)
6657                X3D(ICNT)=X3D(I)
6658                D(ICNT)=REAL(2*(NLEVEL+1)+IADD+1)
6659              ENDIF
6660 5030       CONTINUE
6661            IADD=IADD+1
6662          ENDIF
6663C
6664        ELSEIF(ITPLDI.EQ.'X')THEN
6665          IADD=0
6666C
6667          IF(ITPLRM.EQ.'ON')THEN
6668            IADD=IADD+1
6669            DO5040I=1,N2
6670              IF(TMP11(I).EQ.1.0)THEN
6671                ICNT=ICNT+1
6672                X(ICNT)=X(I)
6673                Y(ICNT)=Y(I)
6674                X3D(ICNT)=X3D(I)
6675                D(ICNT)=REAL(NLEVEL+1+IADD)
6676              ENDIF
6677              IF(TMP11(I).EQ.2.0)THEN
6678                ICNT=ICNT+1
6679                X(ICNT)=X(I)
6680                Y(ICNT)=Y(I)
6681                X3D(ICNT)=X3D(I)
6682                D(ICNT)=REAL(NLEVEL+1+IADD+1)
6683              ENDIF
6684 5040       CONTINUE
6685            IADD=IADD+1
6686          ENDIF
6687C
6688          IF(ITPLCM.EQ.'ON')THEN
6689            IADD=IADD+1
6690            DO5050I=1,N2
6691              IF(TMP10(I).EQ.1.0)THEN
6692                ICNT=ICNT+1
6693                X(ICNT)=X(I)
6694                Y(ICNT)=Y(I)
6695                X3D(ICNT)=X3D(I)
6696                D(ICNT)=REAL(NLEVEL+1+IADD)
6697              ENDIF
6698              IF(TMP10(I).EQ.2.0)THEN
6699                ICNT=ICNT+1
6700                X(ICNT)=X(I)
6701                Y(ICNT)=Y(I)
6702                X3D(ICNT)=X3D(I)
6703                D(ICNT)=REAL(NLEVEL+1+IADD+1)
6704              ENDIF
6705 5050       CONTINUE
6706            IADD=IADD+1
6707          ENDIF
6708C
6709          NPLOTP=ICNT
6710          NPLOTV=2
6711          GOTO9000
6712C
6713        ENDIF
6714C
6715        NPLOTP=ICNT
6716        NPLOTV=2
6717        GOTO9000
6718C
6719 5099   CONTINUE
6720        NPLOTP=ICNT
6721        NPLOTV=2
6722C
6723      ELSEIF(NCRTV.EQ.3)THEN
6724        CALL DPTAP4(Y1,Y2,Y3,TAG1,TAG2,TAG3,N,
6725     1              NUMV2,ICASCT,ISTANR,
6726     1              XIDTEM,XIDTE2,XIDTE3,
6727     1              NUMSE1,NUMSE2,NUMSE3,
6728     1              TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
6729     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
6730     1              DTEMP1,DTEMP2,DTEMP3,
6731     1              ISEED,ALPHA,
6732     1              ICTAMV,PCTAMV,PSTAMV,IQUASE,
6733     1              TEMP6,TEMP7,TEMP8,TEMP9,XACLOW,XACUPP,N2,
6734     1              ISUBRO,IBUGG3,IERROR)
6735C
6736CCCCC   NOW GENERATE THE PLOT COORDINATES.
6737C
6738        ICNT=0
6739C
6740        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAC2')THEN
6741          WRITE(ICOUT,1021)N2
6742 1021     FORMAT('DPTAC2: AFTER CALL DPTAP4--N2 = ',I8)
6743          CALL DPWRST('XXX','BUG ')
6744        ENDIF
6745C
6746        DO1020I=1,N2
6747          STAT=TEMP6(I)
6748          IF(ITPLDI.EQ.'X')THEN
6749            XVAL=TEMP7(I)
6750            YVAL=TEMP8(I)
6751            XVAL2=TEMP9(I)
6752            XCOOR1=XVAL + XVAL2/REAL(NUMSE3)
6753            YCOOR1=YVAL
6754          ELSE
6755            YVAL=TEMP7(I)
6756            XVAL=TEMP8(I)
6757            YVAL2=TEMP9(I)
6758            XCOOR1=XVAL
6759            YCOOR1=YVAL + YVAL2/REAL(NUMSE3)
6760          ENDIF
6761          IF(STAT.LT.YLEVEL(1))THEN
6762            ILEVEL=1
6763          ELSEIF(STAT.GE.YLEVEL(NLEVEL))THEN
6764            ILEVEL=NLEVEL+1
6765          ELSE
6766            DO1025J=2,NLEVEL
6767              IF(STAT.GE.YLEVEL(J-1) .AND. STAT.LT.YLEVEL(J))THEN
6768                ILEVEL=J
6769              ENDIF
6770 1025       CONTINUE
6771          ENDIF
6772C
6773          IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAC2')THEN
6774            WRITE(ICOUT,1026)I,STAT,YVAL,XVAL,YVAL2
6775 1026       FORMAT('I,STAT,YVAL,XVAL,YVAL2 = ',I8,4G15.7)
6776            CALL DPWRST('XXX','BUG ')
6777            WRITE(ICOUT,1027)XCOOR1,YCOOR1,ILEVEL
6778 1027       FORMAT('XCOOR1,YCOOR1,ILEVEL = ',2G15.7,I8)
6779            CALL DPWRST('XXX','BUG ')
6780            WRITE(ICOUT,1028)ILEVEL
6781 1028       FORMAT('ILEVEL = ',I8)
6782            CALL DPWRST('XXX','BUG ')
6783          ENDIF
6784C
6785          ICNT=ICNT+1
6786          X(ICNT)=XCOOR1
6787          Y(ICNT)=YCOOR1
6788          X3D(ICNT)=STAT
6789          D(ICNT)=REAL(ILEVEL)
6790C
6791 1020   CONTINUE
6792C
6793        NPLOTP=ICNT
6794        NPLOTV=2
6795C
6796      ELSEIF(NCRTV.EQ.4)THEN
6797        CALL DPTAP5(Y1,Y2,Y3,TAG1,TAG2,TAG3,TAG4,N,
6798     1              NUMV2,ICASCT,ISTANR,
6799     1              XIDTEM,XIDTE2,XIDTE3,XIDTE4,
6800     1              NUMSE1,NUMSE2,NUMSE3,NUMSE4,
6801     1              TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
6802     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
6803     1              DTEMP1,DTEMP2,DTEMP3,
6804     1              ISEED,ALPHA,
6805     1              ICTAMV,PCTAMV,PSTAMV,IQUASE,
6806     1              TEMP6,TEMP7,TEMP8,TEMP9,TMP10,XACLOW,XACUPP,N2,
6807     1              ISUBRO,IBUGG3,IERROR)
6808C
6809CCCCC   NOW GENERATE THE PLOT COORDINATES.
6810C
6811        ICNT=0
6812C
6813        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAC2')THEN
6814          WRITE(ICOUT,1031)N2
6815 1031     FORMAT('DPTAC2: AFTER CALL DPTAP5--N2 = ',I8)
6816          CALL DPWRST('XXX','BUG ')
6817        ENDIF
6818C
6819        DO1030I=1,N2
6820          STAT=TEMP6(I)
6821          IF(ITPLDI.EQ.'X')THEN
6822            XVAL=TEMP7(I)
6823            YVAL=TEMP8(I)
6824            XVAL2=TEMP9(I)
6825            YVAL2=TMP10(I)
6826          ELSE
6827            YVAL=TEMP7(I)
6828            XVAL=TEMP8(I)
6829            YVAL2=TEMP9(I)
6830            XVAL2=TMP10(I)
6831          ENDIF
6832          XCOOR1=XVAL + XVAL2/REAL(NUMSE3)
6833          YCOOR1=YVAL + YVAL2/REAL(NUMSE4)
6834          YCOOR2=YCOOR1 + YINC2
6835          IF(STAT.LT.YLEVEL(1))THEN
6836            ILEVEL=1
6837          ELSEIF(STAT.GE.YLEVEL(NLEVEL))THEN
6838            ILEVEL=NLEVEL+1
6839          ELSE
6840            DO1035J=2,NLEVEL
6841              IF(STAT.GE.YLEVEL(J-1) .AND. STAT.LT.YLEVEL(J))THEN
6842                ILEVEL=J
6843              ENDIF
6844 1035       CONTINUE
6845          ENDIF
6846C
6847          IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAC2')THEN
6848            WRITE(ICOUT,1036)I,STAT,YVAL,XVAL,YVAL2,XVAL2
6849 1036       FORMAT('I,STAT,YVAL,XVAL,YVAL2,XVAL2 = ',I8,5G15.7)
6850            CALL DPWRST('XXX','BUG ')
6851            WRITE(ICOUT,1037)XCOOR1,YCOOR1,ILEVEL
6852 1037       FORMAT('XCOOR1,YCOOR1,ILEVEL = ',2G15.7,I8)
6853            CALL DPWRST('XXX','BUG ')
6854          ENDIF
6855C
6856          ICNT=ICNT+1
6857          X(ICNT)=XCOOR1
6858          Y(ICNT)=YCOOR1
6859          X3D(ICNT)=STAT
6860          D(ICNT)=REAL(ILEVEL)
6861C
6862 1030   CONTINUE
6863C
6864        NPLOTP=ICNT
6865        NPLOTV=2
6866C
6867      ENDIF
6868C
6869C     NOW DUPLICATE ARRAYS
6870C
6871      IF(NPLOTP.GT.0)THEN
6872        DO2010I=1,NPLOTP
6873          NPLOTP=NPLOTP+1
6874          X(NPLOTP)=X(I)
6875          Y(NPLOTP)=Y(I)
6876          X3D(NPLOTP)=X3D(I)
6877CCCCC     D(NPLOTP)=D(I) + REAL(NLEVEL+1+IADD+1)
6878          D(NPLOTP)=D(I) + REAL(NLEVEL+1+IADD)
6879 2010   CONTINUE
6880      ENDIF
6881C
6882C               *****************
6883C               **  STEP 90--  **
6884C               **  EXIT       **
6885C               *****************
6886C
6887 9000 CONTINUE
6888      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAC2')THEN
6889        WRITE(ICOUT,999)
6890        CALL DPWRST('XXX','BUG ')
6891        WRITE(ICOUT,9011)
6892 9011   FORMAT('***** AT THE END       OF DPTAC2--')
6893        CALL DPWRST('XXX','BUG ')
6894        WRITE(ICOUT,9012)ICASCT,N,NPLOTP,NPLOTV,IERROR
6895 9012   FORMAT('ICASCT,N,NPLOTP,NPLOTV,IERROR = ',A4,3I8,2X,A4)
6896        CALL DPWRST('XXX','BUG ')
6897        DO9035I=1,NPLOTP
6898          WRITE(ICOUT,9036)I,Y(I),X(I),X3D(I),D(I)
6899 9036     FORMAT('I,Y(I),X(I),X3D(I),D(I) = ',I8,4G15.7)
6900          CALL DPWRST('XXX','BUG ')
6901 9035   CONTINUE
6902      ENDIF
6903C
6904      RETURN
6905      END
6906      SUBROUTINE DPTAIL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
6907     1                  IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
6908C
6909C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
6910C              THAT WILL DEFINE AN (EMPIRICAL) TAIL AREA PLOT
6911C              (A SYNONYM IS SURVIVAL PLOT)
6912C              VERTICAL AXIS   = 1-F(X)  (ON A LOG10 SCALE)
6913C              HORIZONTAL AXIS = SORTED DATA
6914C     WRITTEN BY--JAMES J. FILLIBEN
6915C                 STATISTICAL ENGINEERING DIVISION
6916C                 INFORMATION TECHNOLOGY LABORATORY
6917C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6918C                 GAITHERSBURG, MD 20899-8980
6919C                 PHONE--301-975-2899
6920C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6921C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6922C     LANGUAGE--ANSI FORTRAN (1977)
6923C     VERSION NUMBER--89/6
6924C     ORIGINAL VERSION--MAY       1989.
6925C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
6926C     UPDATED         --APRIL     1992. MAXCP31 TO MAXCP6
6927C     UPDATED         --JANUARY   2012. USE DPPARS
6928C     UPDATED         --JANUARY   2012. SUPPORT FOR MULTIPLE AND
6929C                                       REPLICATION OPTIONS
6930C
6931C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6932C
6933      CHARACTER*4 ICASPL
6934      CHARACTER*4 IAND1
6935      CHARACTER*4 IAND2
6936      CHARACTER*4 IBUGG2
6937      CHARACTER*4 IBUGG3
6938      CHARACTER*4 ISUBRO
6939      CHARACTER*4 IBUGQ
6940      CHARACTER*4 IFOUND
6941      CHARACTER*4 IERROR
6942C
6943      CHARACTER*4 ISUBN1
6944      CHARACTER*4 ISUBN2
6945      CHARACTER*4 ISTEPN
6946C
6947      CHARACTER*4 IREPL
6948      CHARACTER*4 IMULT
6949      CHARACTER*4 ICASE
6950      CHARACTER*40 INAME
6951      PARAMETER (MAXSPN=30)
6952      CHARACTER*4 IVARN1(MAXSPN)
6953      CHARACTER*4 IVARN2(MAXSPN)
6954      CHARACTER*4 IVARTY(MAXSPN)
6955      REAL PVAR(MAXSPN)
6956      INTEGER ILIS(MAXSPN)
6957      INTEGER NRIGHT(MAXSPN)
6958      INTEGER ICOLR(MAXSPN)
6959C
6960C---------------------------------------------------------------------
6961C
6962      INCLUDE 'DPCOPA.INC'
6963      INCLUDE 'DPCOZZ.INC'
6964C
6965      DIMENSION Y1(MAXOBV)
6966      DIMENSION XIDTEM(MAXOBV)
6967      DIMENSION XIDTE2(MAXOBV)
6968      DIMENSION XIDTE3(MAXOBV)
6969      DIMENSION XTEMP1(MAXOBV)
6970      DIMENSION XTEMP2(MAXOBV)
6971      DIMENSION ZY1(MAXOBV)
6972      DIMENSION XDESGN(MAXOBV,2)
6973C
6974      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
6975      EQUIVALENCE (GARBAG(IGARB2),XTEMP1(1))
6976      EQUIVALENCE (GARBAG(IGARB3),XTEMP2(1))
6977      EQUIVALENCE (GARBAG(IGARB4),XIDTEM(1))
6978      EQUIVALENCE (GARBAG(IGARB5),XIDTE2(1))
6979      EQUIVALENCE (GARBAG(IGARB6),XIDTE3(1))
6980      EQUIVALENCE (GARBAG(IGARB7),ZY1(1))
6981      EQUIVALENCE (GARBAG(IGARB8),XDESGN(1,1))
6982C
6983C-----COMMON----------------------------------------------------------
6984C
6985      INCLUDE 'DPCOHK.INC'
6986      INCLUDE 'DPCODA.INC'
6987      INCLUDE 'DPCOP2.INC'
6988C
6989C-----START POINT-----------------------------------------------------
6990C
6991      IFOUND='NO'
6992      IERROR='NO'
6993      IREPL='OFF'
6994      IMULT='OFF'
6995      ISUBN1='DPTA'
6996      ISUBN2='IL  '
6997C
6998      MAXCP1=MAXCOL+1
6999      MAXCP2=MAXCOL+2
7000      MAXCP3=MAXCOL+3
7001      MAXCP4=MAXCOL+4
7002      MAXCP5=MAXCOL+5
7003      MAXCP6=MAXCOL+6
7004C
7005      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')THEN
7006        WRITE(ICOUT,999)
7007  999   FORMAT(1X)
7008        CALL DPWRST('XXX','BUG ')
7009        WRITE(ICOUT,51)
7010   51   FORMAT('***** AT THE BEGINNING OF DPTAIL--')
7011        CALL DPWRST('XXX','BUG ')
7012        WRITE(ICOUT,52)ICASPL,IAND1,IAND2,MAXCOL
7013   52   FORMAT('ICASPL,IAND1,IAND2 = ',3(A4,2X),I8)
7014        CALL DPWRST('XXX','BUG ')
7015        WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ,ISUBRO
7016   53   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
7017        CALL DPWRST('XXX','BUG ')
7018      ENDIF
7019C
7020C
7021C               **********************************
7022C               **  TREAT THE TAIL AREA PLOT    **
7023C               **  =     THE SURVIVAL PLOT     **
7024C               **********************************
7025C
7026C               *******************************************
7027C               **  STEP 1--                             **
7028C               **  SEARCH FOR TAIL AREA PLOT            **
7029C               **  OR SURVIVAL PLOT                     **
7030C               *******************************************
7031C
7032      ISTEPN='11'
7033      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
7034     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7035C
7036      ICASPL='TAIL'
7037C
7038      IF(ICOM.EQ.'MULT')THEN
7039        IMULT='ON'
7040        IF((IHARG(1).EQ.'TAIL' .OR. IHARG(1).EQ.'SURV') .AND.
7041     1     IHARG(2).EQ.'PLOT')THEN
7042          ILASTC=2
7043        ELSEIF(IHARG(1).EQ.'TAIL' .AND. IHARG(2).EQ.'AREA' .AND.
7044     1     IHARG(3).EQ.'PLOT')THEN
7045          ILASTC=3
7046        ENDIF
7047      ELSEIF(ICOM.EQ.'REPL')THEN
7048        IREPL='ON'
7049        IF((IHARG(1).EQ.'TAIL' .OR. IHARG(1).EQ.'SURV') .AND.
7050     1     IHARG(2).EQ.'PLOT')THEN
7051          ILASTC=2
7052        ELSEIF(IHARG(1).EQ.'TAIL' .AND. IHARG(2).EQ.'AREA' .AND.
7053     1     IHARG(3).EQ.'PLOT')THEN
7054          ILASTC=3
7055        ENDIF
7056      ELSEIF((ICOM.EQ.'TAIL' .OR. ICOM.EQ.'SURV') .AND.
7057     1  IHARG(1).EQ.'PLOT')THEN
7058        ILASTC=1
7059      ELSEIF(ICOM.EQ.'TAIL' .AND. IHARG(1).EQ.'AREA' .AND.
7060     1  IHARG(2).EQ.'PLOT')THEN
7061        ILASTC=2
7062      ELSE
7063        GOTO9000
7064      ENDIF
7065C
7066      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
7067      IFOUND='YES'
7068C
7069C               ****************************************
7070C               **  STEP 2--                          **
7071C               **  EXTRACT THE VARIABLE LIST         **
7072C               ****************************************
7073C
7074      ISTEPN='2'
7075      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
7076     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7077C
7078      INAME='TAIL AREA PLOT'
7079      MINNA=1
7080      MAXNA=100
7081      MINN2=1
7082      IFLAGE=1
7083      IF(IMULT.EQ.'ON')IFLAGE=0
7084      IFLAGM=1
7085      IFLAGP=0
7086      JMIN=1
7087      JMAX=NUMARG
7088      MINNVA=1
7089      MAXNVA=1
7090      IF(IREPL.EQ.'ON')THEN
7091        MINNVA=MINNVA+1
7092        MAXNVA=MAXNVA+2
7093        IFLAGM=0
7094      ELSEIF(IMULT.EQ.'ON')THEN
7095        MINNVA=1
7096        MAXNVA=MAXSPN
7097      ENDIF
7098C
7099      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
7100     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
7101     1            JMIN,JMAX,
7102     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
7103     1            IVARN1,IVARN2,IVARTY,PVAR,
7104     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
7105     1            MINNVA,MAXNVA,
7106     1            IFLAGM,IFLAGP,
7107     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
7108      IF(IERROR.EQ.'YES')GOTO9000
7109C
7110      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')THEN
7111        WRITE(ICOUT,999)
7112        CALL DPWRST('XXX','BUG ')
7113        WRITE(ICOUT,281)
7114  281   FORMAT('***** AFTER CALL DPPARS--')
7115        CALL DPWRST('XXX','BUG ')
7116        WRITE(ICOUT,282)NQ,NUMVAR
7117  282   FORMAT('NQ,NUMVAR = ',2I8)
7118        CALL DPWRST('XXX','BUG ')
7119        IF(NUMVAR.GT.0)THEN
7120          DO285I=1,NUMVAR
7121            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
7122     1                      ICOLR(I)
7123  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
7124     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
7125            CALL DPWRST('XXX','BUG ')
7126  285     CONTINUE
7127        ENDIF
7128      ENDIF
7129C
7130      NRESP=0
7131      NREPL=0
7132      IF(IREPL.EQ.'OFF' .AND. NUMVAR.GT.1)IMULT='ON'
7133      IF(IMULT.EQ.'ON')THEN
7134        NRESP=NUMVAR
7135      ELSEIF(IREPL.EQ.'ON')THEN
7136        NRESP=1
7137        NREPL=NUMVAR-NRESP
7138        IF(NREPL.LT.1 .OR. NREPL.GT.2)THEN
7139          WRITE(ICOUT,999)
7140          CALL DPWRST('XXX','BUG ')
7141          WRITE(ICOUT,101)
7142  101     FORMAT('***** ERROR IN TAIL ERROR PLOT--')
7143          CALL DPWRST('XXX','BUG ')
7144          WRITE(ICOUT,511)
7145  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
7146     1           'REPLICATION VARIABLES')
7147          CALL DPWRST('XXX','BUG ')
7148          WRITE(ICOUT,512)
7149  512     FORMAT('      MUST BE BETWEEN 1 AND 2;  SUCH WAS NOT THE ',
7150     1           'CASE HERE.')
7151          CALL DPWRST('XXX','BUG ')
7152          WRITE(ICOUT,513)NREPL
7153  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
7154          CALL DPWRST('XXX','BUG ')
7155          IERROR='YES'
7156          GOTO9000
7157        ENDIF
7158      ELSE
7159        NRESP=1
7160      ENDIF
7161C
7162C               ********************************************
7163C               **  STEP 6--                              **
7164C               **  GENERATE THE TAIL AREA      PLOTS FOR **
7165C               **  THE VARIOUS CASES.                    **
7166C               ********************************************
7167C
7168      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')THEN
7169        ISTEPN='6'
7170        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7171        WRITE(ICOUT,601)NRESP,NREPL
7172  601   FORMAT('NRESP,NREPL = ',2I5)
7173        CALL DPWRST('XXX','BUG ')
7174      ENDIF
7175C
7176      IF(NREPL.EQ.0)THEN
7177        ISTEPN='8A'
7178        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
7179     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7180C
7181C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
7182C
7183        NPLOTP=0
7184        DO810IRESP=1,NRESP
7185          NCURVE=IRESP
7186C
7187          IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SPEC')THEN
7188            WRITE(ICOUT,999)
7189            CALL DPWRST('XXX','BUG ')
7190            WRITE(ICOUT,811)IRESP,NCURVE
7191  811       FORMAT('IRESP,NCURVE = ',2I5)
7192            CALL DPWRST('XXX','BUG ')
7193          ENDIF
7194C
7195          ICOL=IRESP
7196          NUMVA2=1
7197          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
7198     1                INAME,IVARN1,IVARN2,IVARTY,
7199     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
7200     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
7201     1                MAXCP4,MAXCP5,MAXCP6,
7202     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
7203     1                Y1,Y1,Y1,NS,NS,NS,ICASE,
7204     1                IBUGG3,ISUBRO,IFOUND,IERROR)
7205          IF(IERROR.EQ.'YES')GOTO9000
7206C
7207C               *****************************************************
7208C               **  STEP 8B--                                      **
7209C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
7210C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
7211C               *****************************************************
7212C
7213          CALL DPTAI2(Y1,NS,NCURVE,ICASPL,MAXN,
7214     1                Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
7215C
7216  810   CONTINUE
7217C
7218C               *****************************************************
7219C               **  STEP 9A--                                      **
7220C               **  CASE 3: ONE OR TWO  REPLICATION VARIABLES.     **
7221C               **          FOR THIS CASE, THE NUMBER OF RESPONSE  **
7222C               **          VARIABLES MUST BE EXACTLY 1.           **
7223C               *****************************************************
7224C
7225      ELSEIF(NREPL.GE.1)THEN
7226        ISTEPN='9A'
7227        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')
7228     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7229C
7230        J=0
7231        IMAX=NRIGHT(1)
7232        IF(NQ.LT.NRIGHT(1))IMAX=NQ
7233        DO910I=1,IMAX
7234          IF(ISUB(I).EQ.0)GOTO910
7235          J=J+1
7236C
7237C         RESPONSE VARIABLE IN Y1
7238C
7239          IJ=MAXN*(ICOLR(1)-1)+I
7240          IF(ICOLR(1).LE.MAXCOL)Y1(J)=V(IJ)
7241          IF(ICOLR(1).EQ.MAXCP1)Y1(J)=PRED(I)
7242          IF(ICOLR(1).EQ.MAXCP2)Y1(J)=RES(I)
7243          IF(ICOLR(1).EQ.MAXCP3)Y1(J)=YPLOT(I)
7244          IF(ICOLR(1).EQ.MAXCP4)Y1(J)=XPLOT(I)
7245          IF(ICOLR(1).EQ.MAXCP5)Y1(J)=X2PLOT(I)
7246          IF(ICOLR(1).EQ.MAXCP6)Y1(J)=TAGPLO(I)
7247          ICOLC=1
7248C
7249          DO920IR=1,MIN(NREPL,2)
7250            ICOLC=ICOLC+1
7251            ICOLT=ICOLR(ICOLC)
7252            IJ=MAXN*(ICOLT-1)+I
7253            IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
7254            IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
7255            IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
7256            IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
7257            IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
7258            IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
7259            IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
7260  920     CONTINUE
7261C
7262  910   CONTINUE
7263        NLOCAL=J
7264C
7265C       *****************************************************
7266C       **  STEP 9B--                                      **
7267C       **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
7268C       **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
7269C       **                                                 **
7270C       **  FOR THIS CASE, WE NEED TO LOOP THROUGH THE     **
7271C       **  VARIOUS REPLICATIONS.                          **
7272C       *****************************************************
7273C
7274        ISTEPN='9B'
7275        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')THEN
7276          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7277          WRITE(ICOUT,999)
7278          CALL DPWRST('XXX','BUG ')
7279          WRITE(ICOUT,931)
7280  931     FORMAT('***** FROM THE MIDDLE  OF DPSPEC--')
7281          CALL DPWRST('XXX','BUG ')
7282          WRITE(ICOUT,932)ICASPL,NUMVAR,NLOCAL
7283  932     FORMAT('ICASPL,NUMVAR,NQ = ',A4,2I8)
7284          CALL DPWRST('XXX','BUG ')
7285          IF(NLOCAL.GE.1)THEN
7286            DO935I=1,NLOCAL
7287              WRITE(ICOUT,936)I,Y1(I),XDESGN(I,1),XDESGN(I,2)
7288  936         FORMAT('I,Y1(I),XDESGN(I,1),XDESGN(I,2) = ',I8,3F12.5)
7289              CALL DPWRST('XXX','BUG ')
7290  935       CONTINUE
7291          ENDIF
7292        ENDIF
7293C
7294C       *****************************************************
7295C       **  STEP 9C--                                      **
7296C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
7297C       **  REPLICATION VARIABLES.                         **
7298C       *****************************************************
7299C
7300        CALL DPFRE5(XDESGN(1,1),XDESGN(1,2),
7301     1             NREPL,NLOCAL,MAXOBV,
7302     1             XIDTEM,XIDTE2,
7303     1             XTEMP1,XTEMP2,
7304     1             NUMSE1,NUMSE2,
7305     1             IBUGG3,ISUBRO,IERROR)
7306C
7307C       *****************************************************
7308C       **  STEP 9D--                                      **
7309C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
7310C       *****************************************************
7311C
7312        NPLOTP=0
7313        NCURVE=0
7314        IF(NREPL.EQ.1)THEN
7315          J=0
7316          DO1110ISET1=1,NUMSE1
7317            K=0
7318            DO1130I=1,NLOCAL
7319              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
7320                K=K+1
7321                ZY1(K)=Y1(I)
7322              ENDIF
7323 1130       CONTINUE
7324            NTEMP=K
7325            NCURVE=NCURVE+1
7326            IF(NTEMP.GT.0)THEN
7327              CALL DPTAI2(ZY1,NTEMP,NCURVE,ICASPL,MAXN,
7328     1                    Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
7329            ENDIF
7330 1110     CONTINUE
7331        ELSEIF(NREPL.EQ.2)THEN
7332          J=0
7333          NTOT=NUMSE1*NUMSE2
7334          DO1210ISET1=1,NUMSE1
7335          DO1220ISET2=1,NUMSE2
7336            K=0
7337            DO1290I=1,NLOCAL
7338              IF(
7339     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
7340     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
7341     1          )THEN
7342                K=K+1
7343                ZY1(K)=Y1(I)
7344              ENDIF
7345 1290       CONTINUE
7346            NTEMP=K
7347            NCURVE=NCURVE+1
7348            IF(NTEMP.GT.0)THEN
7349              CALL DPTAI2(ZY1,NTEMP,NCURVE,ICASPL,MAXN,
7350     1                    Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
7351            ENDIF
7352 1220     CONTINUE
7353 1210     CONTINUE
7354        ENDIF
7355      ENDIF
7356C
7357C               *****************
7358C               **  STEP 90--  **
7359C               **  EXIT       **
7360C               *****************
7361C
7362 9000 CONTINUE
7363      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAIL')THEN
7364        WRITE(ICOUT,999)
7365        CALL DPWRST('XXX','BUG ')
7366        WRITE(ICOUT,9011)
7367 9011   FORMAT('***** AT THE END       OF DPTAIL--')
7368        CALL DPWRST('XXX','BUG ')
7369        WRITE(ICOUT,9012)IFOUND,IERROR
7370 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
7371        CALL DPWRST('XXX','BUG ')
7372        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
7373 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',3I8,3(2X,A4))
7374        CALL DPWRST('XXX','BUG ')
7375        IF(NPLOTP.GT.0)THEN
7376          DO9015I=1,NPLOTP
7377            WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
7378 9016       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
7379            CALL DPWRST('XXX','BUG ')
7380 9015     CONTINUE
7381        ENDIF
7382      ENDIF
7383C
7384      RETURN
7385      END
7386      SUBROUTINE DPTAI2(Y1,N,NCURVE,ICASPL,MAXN,
7387     1                  Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
7388C
7389C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
7390C              THAT WILL DEFINE AN (EMPIRICAL) TAIL AREA PLOT
7391C              (A SYNONYM IS SURVIVAL PLOT)
7392C              VERTICAL AXIS   = 1-F(X)  (ON A LOG10 SCALE)
7393C              HORIZONTAL AXIS = SORTED DATA
7394C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
7395C                               (UNSORTED) OBSERVATIONS
7396C                               FOR THE FIRST  VARIABLE.
7397C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
7398C                               IN THE VECTOR X.
7399C     CAUTION--THE INPUT VARIABLE Y1(.) WILL BE CHANGED HEREIN
7400C              (IT WILL BE SORTED)
7401C     WRITTEN BY--JAMES J. FILLIBEN
7402C                 STATISTICAL ENGINEERING DIVISION
7403C                 INFORMATION TECHNOLOGY LABORATORY
7404C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7405C                 GAITHERSBURG, MD 20899-8980
7406C                 PHONE--301-975-2855
7407C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7408C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7409C     LANGUAGE--ANSI FORTRAN (1977)
7410C     VERSION NUMBER--89/6
7411C     ORIGINAL VERSION--MAY       1989.
7412C
7413C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
7414C
7415      CHARACTER*4 ICASPL
7416      CHARACTER*4 IBUGG3
7417      CHARACTER*4 ISUBRO
7418      CHARACTER*4 IERROR
7419C
7420      CHARACTER*4 ISUBN1
7421      CHARACTER*4 ISUBN2
7422C
7423C---------------------------------------------------------------------
7424C
7425      DIMENSION Y1(*)
7426      DIMENSION Y(*)
7427      DIMENSION X(*)
7428      DIMENSION D(*)
7429C
7430C-----COMMON----------------------------------------------------------
7431C
7432      INCLUDE 'DPCOP2.INC'
7433C
7434C-----START POINT-----------------------------------------------------
7435C
7436      ISUBN1='DPTA'
7437      ISUBN2='I2  '
7438      IERROR='NO'
7439C
7440      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAI2')THEN
7441        WRITE(ICOUT,999)
7442  999   FORMAT(1X)
7443        CALL DPWRST('XXX','BUG ')
7444        WRITE(ICOUT,51)
7445   51   FORMAT('***** AT THE BEGINNING OF DPTAI2--')
7446        CALL DPWRST('XXX','BUG ')
7447        WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
7448   52   FORMAT('IBUGG3,ISUBRO,IERROR = ',2(A4,2X),A4)
7449        CALL DPWRST('XXX','BUG ')
7450        WRITE(ICOUT,53)N,MAXN,NCURVE,ICASPL
7451   53   FORMAT('N,MAXN,NCURVE,ICASPL = ',3I8,2X,A4)
7452        CALL DPWRST('XXX','BUG ')
7453        DO55I=1,N
7454          WRITE(ICOUT,56)I,Y1(I)
7455   56     FORMAT('I,Y1(I) = ',I8,G15.7)
7456          CALL DPWRST('XXX','BUG ')
7457   55   CONTINUE
7458      ENDIF
7459C
7460C               ********************************************
7461C               **  STEP 1--                              **
7462C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
7463C               ********************************************
7464C
7465      IF(N.LE.1)THEN
7466        WRITE(ICOUT,999)
7467        CALL DPWRST('XXX','BUG ')
7468        WRITE(ICOUT,111)
7469  111   FORMAT('***** ERROR IN TAIL AREA PLOT--')
7470        CALL DPWRST('XXX','BUG ')
7471        WRITE(ICOUT,112)
7472  112   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
7473        CALL DPWRST('XXX','BUG ')
7474        WRITE(ICOUT,114)N
7475  114   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
7476        CALL DPWRST('XXX','BUG ')
7477        WRITE(ICOUT,999)
7478        CALL DPWRST('XXX','BUG ')
7479        IERROR='YES'
7480        GOTO9000
7481      ENDIF
7482C
7483      HOLD=Y1(1)
7484      DO120I=1,N
7485      IF(Y1(I).NE.HOLD)GOTO129
7486  120 CONTINUE
7487      WRITE(ICOUT,999)
7488      CALL DPWRST('XXX','BUG ')
7489      WRITE(ICOUT,111)
7490      CALL DPWRST('XXX','BUG ')
7491      WRITE(ICOUT,122)HOLD
7492  122 FORMAT('      ALL ELEMENTS IN THE RESPONSE VARIABLE ARE ',
7493     1       'IDENTICALLY EQUAL TO ',G15.7)
7494      CALL DPWRST('XXX','BUG ')
7495      WRITE(ICOUT,999)
7496      CALL DPWRST('XXX','BUG ')
7497      IERROR='YES'
7498      GOTO9000
7499  129 CONTINUE
7500C
7501C               ***********************************************
7502C               **  STEP 12--                                **
7503C               **  COMPUTE COORDINATES FOR TAIL AREA PLOT   **
7504C               **  (INCORPORATE STAIR-STEP APPEARANCE)      **
7505C               **  NOTE--THE LOGGING OF THE 1-F(X) WILL     **
7506C               **        NOTE BE DONE HEREIN BUT WILL       **
7507C               **        BE DONE IN THE UNDERLYING          **
7508C               **        GRAPHICS BY LOG SCALE              **
7509C               ***********************************************
7510C
7511C
7512      CALL SORT(Y1,N,Y1)
7513C
7514      ANP1=N+1
7515      J=0
7516      DO1100I=1,N
7517        ARG1=N-I+1
7518        ARG2=N-I
7519        J=J+1
7520        X(J+NPLOTP)=Y1(I)
7521        Y(J+NPLOTP)=ARG1/ANP1
7522        D(J+NPLOTP)=REAL(NCURVE)
7523        IF(I.GE.N)GOTO1100
7524        J=J+1
7525        X(J+NPLOTP)=Y1(I)
7526        Y(J+NPLOTP)=ARG2/ANP1
7527        D(J+NPLOTP)=REAL(NCURVE)
7528 1100 CONTINUE
7529      NPLOTP=NPLOTP+J
7530      NPLOTV=2
7531      GOTO9000
7532C
7533C               ******************
7534C               **   STEP 90--  **
7535C               **   EXIT       **
7536C               ******************
7537C
7538 9000 CONTINUE
7539      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAI2')THEN
7540        WRITE(ICOUT,999)
7541        CALL DPWRST('XXX','BUG ')
7542        WRITE(ICOUT,9011)
7543 9011   FORMAT('***** AT THE END       OF DPTAI2--')
7544        CALL DPWRST('XXX','BUG ')
7545        DO9015I=1,N
7546          WRITE(ICOUT,9016)I,Y1(I)
7547 9016     FORMAT('I,Y1(I) = ',I8,G15.7)
7548          CALL DPWRST('XXX','BUG ')
7549 9015   CONTINUE
7550        WRITE(ICOUT,9021)NPLOTP,NPLOTV,IERROR
7551 9021   FORMAT('NPLOTP,NPLOTV,IERROR = ',2I8,2X,A4)
7552        CALL DPWRST('XXX','BUG ')
7553        DO9022I=1,NPLOTP
7554          WRITE(ICOUT,9023)I,Y(I),X(I),D(I)
7555 9023     FORMAT('I,Y(I),X(I),D(I) = ',I8,3G15.7)
7556          CALL DPWRST('XXX','BUG ')
7557 9022   CONTINUE
7558      ENDIF
7559C
7560      RETURN
7561      END
7562      SUBROUTINE DPTAP0(Y,Z,Z2,TAG1,N,
7563     1                  NUMV2,ICASCT,ISTANR,
7564     1                  XIDTEM,
7565     1                  NUMSE1,
7566     1                  TEMP,TEMPZ,TEMPZ2,XTEMP1,XTEMP2,XTEMP3,
7567     1                  ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
7568     1                  DTEMP1,DTEMP2,DTEMP3,
7569     1                  ISEED,ALPHA,
7570     1                  ICTAMV,PCTAMV,PSTAMV,IQUASE,
7571     1                  Y2,X2,XACLOW,XACUPP,N2,
7572     1                  ISUBRO,IBUGG3,IERROR)
7573C
7574C     PURPOSE--GENERATE A ONE-WAY TABULATION PLOT.
7575C     WRITTEN BY--ALAN HECKERT
7576C                 STATISTICAL ENGINEERING DIVISION
7577C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7578C                 GAITHERSBURG, MD 20899-8980
7579C                 PHONE--301-975-2899
7580C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7581C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7582C     LANGUAGE--ANSI FORTRAN (1977)
7583C     VERSION NUMBER--2009/9
7584C     ORIGINAL VERSION--SEPTEMBER 2009.
7585C     UPDATED         --DECEMBER  2009. UNCERTAINTY OPTION FOR
7586C                                       BINOMIAL PROBABILITY, MEAN AND
7587C                                       MEDIAN CONFIDENCE INTERVAL
7588C     UPDATED         --JANUARY   2010. SUPPORT FOR UNCERTAINTY INTERVALS
7589C                                       FOR BINOMIAL RATIO
7590C
7591C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
7592C
7593      CHARACTER*4 ICASCT
7594      CHARACTER*4 ICTAMV
7595      CHARACTER*4 IQUASE
7596      CHARACTER*4 IBUGG3
7597      CHARACTER*4 ISUBRO
7598      CHARACTER*4 IERROR
7599C
7600      CHARACTER*4 ISUBN1
7601      CHARACTER*4 ISUBN2
7602      CHARACTER*4 ISTEPN
7603      CHARACTER*4 IWRITE
7604C
7605C---------------------------------------------------------------------
7606C
7607      DIMENSION Y(*)
7608      DIMENSION Z(*)
7609      DIMENSION Z2(*)
7610      DIMENSION XIDTEM(*)
7611      DIMENSION Y2(*)
7612      DIMENSION X2(*)
7613C
7614      DIMENSION TAG1(*)
7615      DIMENSION TEMP(*)
7616      DIMENSION TEMPZ(*)
7617      DIMENSION TEMPZ2(*)
7618      DIMENSION XTEMP1(*)
7619      DIMENSION XTEMP2(*)
7620      DIMENSION XTEMP3(*)
7621C
7622      DIMENSION XACLOW(*)
7623      DIMENSION XACUPP(*)
7624C
7625      INTEGER ITEMP1(*)
7626      INTEGER ITEMP2(*)
7627      INTEGER ITEMP3(*)
7628      INTEGER ITEMP4(*)
7629      INTEGER ITEMP5(*)
7630      INTEGER ITEMP6(*)
7631C
7632      DOUBLE PRECISION DTEMP1(*)
7633      DOUBLE PRECISION DTEMP2(*)
7634      DOUBLE PRECISION DTEMP3(*)
7635C
7636C-----COMMON----------------------------------------------------------
7637C
7638      INCLUDE 'DPCOP2.INC'
7639C
7640C-----START POINT-----------------------------------------------------
7641C
7642      ISUBN1='DPTA'
7643      ISUBN2='P0  '
7644      IWRITE='OFF'
7645C
7646      I2=0
7647C
7648      AN=INT(N+0.01)
7649C
7650C               ***********************************************
7651C               **  STEP 5--                                 **
7652C               **  COMPUTE THE VARIOUS CROSS-TAB STATISTICS **
7653C               ***********************************************
7654C
7655      ISTEPN='5.1'
7656      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAP0')
7657     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7658C
7659      J=0
7660      NRESP=NUMV2-1
7661      DO1110ISET1=1,NUMSE1
7662C
7663        K=0
7664        DO1130I=1,N
7665          IF(XIDTEM(ISET1).EQ.TAG1(I))GOTO1131
7666          GOTO1130
7667 1131     CONTINUE
7668C
7669          K=K+1
7670          TEMP(K)=0.0
7671          TEMPZ(K)=0.0
7672          TEMPZ2(K)=0.0
7673          IF(ISTANR.GE.1)TEMP(K)=Y(I)
7674          IF(ISTANR.GE.2)TEMPZ(K)=Z(I)
7675          IF(ISTANR.GE.3)TEMPZ2(K)=Z2(I)
7676 1130   CONTINUE
7677        NTEMP=K
7678C
7679        NTRIAL=0
7680        ALOWLM=0.0
7681        AUPPLM=0.0
7682        IF(NTEMP.EQ.0)THEN
7683          IF(ICTAMV.EQ.'ZERO')THEN
7684            STAT=0.0
7685            IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
7686     1         ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
7687              NTRIAL=0
7688              ALOWLM=0.0
7689              AUPPLM=0.0
7690            ENDIF
7691          ELSEIF(ICTAMV.EQ.'MV  ')THEN
7692            STAT=PCTAMV
7693            IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
7694     1         ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
7695              NTRIAL=0
7696              ALOWLM=PCTAMV
7697              AUPPLM=PCTAMV
7698            ENDIF
7699          ELSE
7700            GOTO1110
7701          ENDIF
7702        ELSE
7703          CALL CMPSTA(
7704     1              TEMP,TEMPZ,TEMPZ2,XTEMP1,XTEMP2,XTEMP3,
7705     1              MAXNXT,NTEMP,NTEMP,NTEMP,
7706     1              NRESP,ICASCT,
7707     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
7708     1              DTEMP1,DTEMP2,DTEMP3,
7709CCCCC1              IQUAME,IQUASE,PSTAMV,
7710     1              STAT,
7711     1              ISUBRO,IBUGG3,IERROR)
7712          IF(IERROR.EQ.'YES')GOTO9000
7713          IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'BRAT')THEN
7714            PTEMP=STAT
7715            NTRIAL=NTEMP
7716            IF(ICASCT.EQ.'BRAT')NTRIAL=ITEMP1(1)
7717            IF(STAT.EQ.PSTAMV)THEN
7718              ALOWLM=PSTAMV
7719              AUPPLM=PSTAMV
7720            ELSE
7721              ALPHAT=ALPHA
7722              IF(ALPHAT.LE.0.5)ALPHAT=1.0 - ALPHA
7723              CALL DPAGCO(PTEMP,NTRIAL,ALPHAT,IWRITE,
7724     1                    ALOWLM,AUPPLM,IBUGG3,IERROR)
7725            ENDIF
7726          ELSEIF(ICASCT.EQ.'MECL')THEN
7727            XMEAN=STAT
7728            NTRIAL=NTEMP
7729            IF(STAT.EQ.PSTAMV)THEN
7730              ALOWLM=PSTAMV
7731              AUPPLM=PSTAMV
7732            ELSE
7733              CALL SD(TEMP,NTEMP,IWRITE,XSD,IBUGG3,IERROR)
7734              ALPHAT=ALPHA
7735              CALL DPMECL(XMEAN,XSD,NTEMP,ALPHAT,IWRITE,
7736     1                    ALOWLM,AUPPLM,IBUGG3,IERROR)
7737            ENDIF
7738          ELSEIF(ICASCT.EQ.'MDCL')THEN
7739            XMED=STAT
7740            NTRIAL=NTEMP
7741            IF(STAT.EQ.PSTAMV)THEN
7742              ALOWLM=PSTAMV
7743              AUPPLM=PSTAMV
7744            ELSE
7745              XQ=0.5
7746              CALL QUANSE(XQ,TEMP,NTEMP,IWRITE,XTEMP1,MAXNXT,IQUASE,
7747     1                    QUASE,IBUGG3,IERROR)
7748              ALPHAT=ALPHA
7749              CALL DPMECL(XMED,QUASE,NTEMP,ALPHAT,IWRITE,
7750     1                    ALOWLM,AUPPLM,IBUGG3,IERROR)
7751            ENDIF
7752          ENDIF
7753        ENDIF
7754C
7755        J=J+1
7756        Y2(J)=STAT
7757        X2(J)=XIDTEM(ISET1)
7758        IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
7759     1     ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
7760          IF(AUPPLM.GT.STATMX)STATMX=AUPPLM
7761          IF(ALOWLM.LT.STATMN)STATMN=ALOWLM
7762          XACLOW(J)=ALOWLM
7763          XACUPP(J)=AUPPLM
7764        ENDIF
7765C
7766 1110 CONTINUE
7767      N2=J
7768C
7769C               ******************
7770C               **   STEP 90--  **
7771C               **   EXIT       **
7772C               ******************
7773C
7774 9000 CONTINUE
7775      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP0')THEN
7776        WRITE(ICOUT,999)
7777  999   FORMAT(1X)
7778        CALL DPWRST('XXX','BUG ')
7779        WRITE(ICOUT,9011)
7780 9011   FORMAT('***** AT THE END       OF DPTAP0--')
7781        CALL DPWRST('XXX','BUG ')
7782        WRITE(ICOUT,9012)ICASCT,N,NUMV2,IERROR
7783 9012   FORMAT('ICASCT,N,NUMV2,IERROR = ',A4,2I8,2X,A4)
7784        CALL DPWRST('XXX','BUG ')
7785        WRITE(ICOUT,9015)NUMSE1,N2
7786 9015   FORMAT('NUMSE1,N2 = ',2I8)
7787        CALL DPWRST('XXX','BUG ')
7788        DO9020I=1,N2
7789          WRITE(ICOUT,9021)I,Y2(I),X2(I)
7790 9021     FORMAT('I,Y2(I),X2(I) = ',I8,2G15.7)
7791          CALL DPWRST('XXX','BUG ')
7792 9020   CONTINUE
7793      ENDIF
7794C
7795      RETURN
7796      END
7797      SUBROUTINE DPTAPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
7798     1                  IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
7799C
7800C     PURPOSE--GENERATE A TABULATION PLOT.
7801C
7802C              THIS IS SOMEWHAT SIMILAR TO A FLUCTUATION PLOT.
7803C              HOWEVER, INSTEAD OF A FILLED BAR BASED ON THE
7804C              VALUE OF A STATISTIC, WE COLOR CODE BASED ON
7805C              THE LEVEL OF THE RESPONSE VARIABLE (I.E.,
7806C              LIKE SPECIFYING THE LEVELS IN A CONTOUR PLOT).
7807C              WE CURRENTLY SUPPORT THIS PLOT FOR ONE-WAY THROUGH
7808C              FOUR-WAY TABLES.
7809C
7810C                  X1  = CATEGORY LEVEL FOR VARIABLE 1
7811C                  X2  = CATEGORY LEVEL FOR VARIABLE 2
7812C                  X3  = CATEGORY LEVEL FOR VARIABLE 3
7813C                  X4  = CATEGORY LEVEL FOR VARIABLE 4
7814C
7815C              NOTE THAT WE EXTENED THE TABULATION PLOT TO ALLOW
7816C              ANY OF DATAPLOT'S SUPPORTED STATISTICS TO BE
7817C              PLOTTED (THE DEFAULT IS THE MEAN).
7818C
7819C     EXAMPLES--TABULATION PLOT Y X1 X2 ZLEVEL
7820C             --TABULATION PLOT Y X1 X2 X3 ZLEVEL
7821C             --TABULATION PLOT Y X1 X2 X3 X4 ZLEVEL
7822C             --TABULATION PLOT TABLE ZLEVEL
7823C             --MEAN TABULATION PLOT Y X1 X2 ZLEVEL
7824C             --SD TABULATION PLOT Y X1 X2 ZLEVEL
7825C     WRITTEN BY--ALAN HECKERT
7826C                 STATISTICAL ENGINEERING DIVISION
7827C                 INFORMATION TECHNOLOGY LABORATORY
7828C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7829C                 GAITHERSBURG, MD 20899-8980
7830C                 PHONE--301-975-2899
7831C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7832C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7833C     LANGUAGE--ANSI FORTRAN (1977)
7834C     VERSION NUMBER--2009/9
7835C     ORIGINAL VERSION--SEPTEMBER 2009.
7836C     UPDATED         --JUNE      2010. ADD "CHARACTER TABULATION PLOT"
7837C                                       CASE.  THIS IS A VARIANT THAT
7838C                                       PLOTS THE NUMERICAL VALUE OF THE
7839C                                       STATISTIC RATHER THAN A COLORED
7840C                                       RECTANGLE
7841C     UPDATED         --SEPTEMBER 2016. SUPPORT FOR MATRIX ARGUMENTS
7842C     UPDATED         --JULY      2019. TWEAK SCRATCH SPACE
7843C
7844C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
7845C
7846      CHARACTER*4 ICASPL
7847      CHARACTER*4 IAND1
7848      CHARACTER*4 IAND2
7849      CHARACTER*4 IBUGG2
7850      CHARACTER*4 IBUGG3
7851      CHARACTER*4 IBUGQ
7852      CHARACTER*4 ISUBRO
7853      CHARACTER*4 IFOUND
7854      CHARACTER*4 IERROR
7855C
7856      CHARACTER*4 ICASCT
7857      CHARACTER*4 IHP
7858      CHARACTER*4 IHP2
7859      CHARACTER*4 IHWUSE
7860      CHARACTER*4 MESSAG
7861      CHARACTER*4 ICASE
7862      CHARACTER*4 ISTADF
7863      CHARACTER*4 ISUBN1
7864      CHARACTER*4 ISUBN2
7865      CHARACTER*4 ISTEPN
7866C
7867      PARAMETER (MAXSPN=20)
7868      CHARACTER*4 IVARN1(MAXSPN)
7869      CHARACTER*4 IVARN2(MAXSPN)
7870      CHARACTER*4 IVARTY(MAXSPN)
7871      REAL PVAR(MAXSPN)
7872      INTEGER ILIS(MAXSPN)
7873      INTEGER NRIGHT(MAXSPN)
7874      INTEGER ICOLR(MAXSPN)
7875      CHARACTER*40 INAME
7876C
7877      CHARACTER*8 IYNAM
7878      CHARACTER*8 IXNAM
7879      CHARACTER*8 IX1NAM
7880      CHARACTER*8 IX2NAM
7881      CHARACTER*8 IX3NAM
7882      CHARACTER*8 IX4NAM
7883      CHARACTER*60 ICTNAM
7884C
7885C---------------------------------------------------------------------
7886C
7887      INCLUDE 'DPCOPA.INC'
7888      INCLUDE 'DPCOZZ.INC'
7889      INCLUDE 'DPCOZI.INC'
7890      INCLUDE 'DPCOZD.INC'
7891C
7892      DIMENSION Y1(MAXOBV)
7893      DIMENSION Y2(MAXOBV)
7894      DIMENSION Y3(MAXOBV)
7895      DIMENSION YLEVEL(MAXOBV)
7896C
7897      DIMENSION XH1DIS(MAXOBV)
7898      DIMENSION XH2DIS(MAXOBV)
7899      DIMENSION XH3DIS(MAXOBV)
7900      DIMENSION XH4DIS(MAXOBV)
7901C
7902      DIMENSION X1(MAXOBV)
7903      DIMENSION X2(MAXOBV)
7904      DIMENSION X3(MAXOBV)
7905      DIMENSION X4(MAXOBV)
7906C
7907      DIMENSION TEMP1(MAXOBV)
7908      DIMENSION TEMP2(MAXOBV)
7909      DIMENSION TEMP3(MAXOBV)
7910      DIMENSION TEMP4(MAXOBV)
7911      DIMENSION TEMP5(MAXOBV)
7912      DIMENSION TEMP6(MAXOBV)
7913      DIMENSION TEMP7(MAXOBV)
7914      DIMENSION TEMP8(MAXOBV)
7915      DIMENSION TEMP9(MAXOBV)
7916      DIMENSION TMP10(MAXOBV)
7917      DIMENSION TMP11(MAXOBV)
7918C
7919      DIMENSION XACLOW(MAXOBV)
7920      DIMENSION XACUPP(MAXOBV)
7921C
7922      DIMENSION ITEMP1(MAXOBV)
7923      DIMENSION ITEMP2(MAXOBV)
7924      DIMENSION ITEMP3(MAXOBV)
7925      DIMENSION ITEMP4(MAXOBV)
7926      DIMENSION ITEMP5(MAXOBV)
7927      DIMENSION ITEMP6(MAXOBV)
7928      DOUBLE PRECISION DTEMP1(MAXOBV)
7929      DOUBLE PRECISION DTEMP2(MAXOBV)
7930      DOUBLE PRECISION DTEMP3(MAXOBV)
7931C
7932      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
7933      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
7934      EQUIVALENCE (GARBAG(IGARB3),YLEVEL(1))
7935      EQUIVALENCE (GARBAG(IGARB4),X1(1))
7936      EQUIVALENCE (GARBAG(IGARB5),X2(1))
7937      EQUIVALENCE (GARBAG(IGARB6),X3(1))
7938      EQUIVALENCE (GARBAG(IGARB7),X4(1))
7939      EQUIVALENCE (GARBAG(IGARB8),XH1DIS(1))
7940      EQUIVALENCE (GARBAG(IGARB9),XH2DIS(1))
7941      EQUIVALENCE (GARBAG(IGAR10),XH3DIS(1))
7942      EQUIVALENCE (GARBAG(JGAR11),XH4DIS(1))
7943      EQUIVALENCE (GARBAG(JGAR12),TEMP1(1))
7944      EQUIVALENCE (GARBAG(JGAR13),TEMP2(1))
7945      EQUIVALENCE (GARBAG(JGAR14),TEMP3(1))
7946      EQUIVALENCE (GARBAG(JGAR15),TEMP4(1))
7947      EQUIVALENCE (GARBAG(JGAR16),TEMP5(1))
7948      EQUIVALENCE (GARBAG(JGAR17),TEMP6(1))
7949      EQUIVALENCE (GARBAG(JGAR18),TEMP7(1))
7950      EQUIVALENCE (GARBAG(JGAR19),TEMP8(1))
7951      EQUIVALENCE (GARBAG(JGAR20),TEMP9(1))
7952      EQUIVALENCE (GARBAG(IGAR11),TMP10(1))
7953      EQUIVALENCE (GARBAG(IGAR12),XACLOW(1))
7954      EQUIVALENCE (GARBAG(IGAR13),XACUPP(1))
7955      EQUIVALENCE (GARBAG(IGAR14),Y3(1))
7956      EQUIVALENCE (GARBAG(IGAR15),TMP11(1))
7957C
7958      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
7959      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
7960      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
7961      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
7962      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
7963      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
7964C
7965      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1))
7966      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2(1))
7967      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3(1))
7968C
7969C-----COMMON----------------------------------------------------------
7970C
7971      INCLUDE 'DPCOSU.INC'
7972      INCLUDE 'DPCOHK.INC'
7973      INCLUDE 'DPCODA.INC'
7974      INCLUDE 'DPCOST.INC'
7975      INCLUDE 'DPCOHO.INC'
7976      INCLUDE 'DPCOP2.INC'
7977C
7978C-----START POINT-----------------------------------------------------
7979C
7980      IERROR='NO'
7981      IFOUND='NO'
7982      ISUBN1='DPTA'
7983      ISUBN2='PL  '
7984C
7985      IYNAM=' '
7986      IXNAM=' '
7987      IX1NAM=' '
7988      IX2NAM=' '
7989      IX3NAM=' '
7990      IX4NAM=' '
7991C
7992      MAXCP1=MAXCOL+1
7993      MAXCP2=MAXCOL+2
7994      MAXCP3=MAXCOL+3
7995      MAXCP4=MAXCOL+4
7996      MAXCP5=MAXCOL+5
7997      MAXCP6=MAXCOL+6
7998C
7999      MAXV2=7
8000      MINN2=2
8001      J2=0
8002C
8003C               ****************************************
8004C               **  TREAT THE TABULATION PLOT CASE    **
8005C               ****************************************
8006C
8007      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAPL')THEN
8008        WRITE(ICOUT,999)
8009  999   FORMAT(1X)
8010        CALL DPWRST('XXX','BUG ')
8011        WRITE(ICOUT,51)
8012   51   FORMAT('***** AT THE BEGINNING OF DPTAPL--')
8013        CALL DPWRST('XXX','BUG ')
8014        WRITE(ICOUT,52)IBUGG2,IBUGG3,IBUGQ,ISUBRO
8015   52   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
8016        CALL DPWRST('XXX','BUG ')
8017        WRITE(ICOUT,53)ICASPL,IAND1,IAND2,MAXN,NS
8018   53   FORMAT('ICASPL,IAND1,IAND2,NS = ',3(A4,2X),2I8)
8019        CALL DPWRST('XXX','BUG ')
8020      ENDIF
8021C
8022C               ***************************
8023C               **  STEP 1--             **
8024C               **  EXTRACT THE COMMAND  **
8025C               ***************************
8026C
8027      ISTEPN='11'
8028      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAPL')
8029     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8030C
8031C               ****************************************************
8032C               **  STEP 1.5--                                    **
8033C               **  SEARCH FOR TABULATION <STAT> PLOT             **
8034C               **  SEARCH FOR CHARACTER TABULATION <STAT> PLOT   **
8035C               ****************************************************
8036C
8037      ICASCT=' '
8038C
8039      IF(NUMARG.LE.1)GOTO9000
8040      IF(ICOM.EQ.'TABU')THEN
8041        ICASPL='TABU'
8042        JMIN=1
8043      ELSEIF(ICOM.EQ.'CHAR' .AND. IHARG(1).EQ.'TABU')THEN
8044        ICASPL='TABC'
8045        JMIN=2
8046      ELSE
8047        GOTO9000
8048      ENDIF
8049C
8050CCCCC USE "EXTSTA" TO PARSE.  NOTE THAT IF NO STATISTIC IS GIVEN,
8051CCCCC  WE ASSUME THE "MEAN" CASE.
8052C
8053      JMAX=MIN(NUMARG,JMIN+6)
8054      DO200I=JMIN,JMAX
8055        IF(IHARG(I).EQ.'PLOT')THEN
8056          JMAX=I-1
8057          ILASTC=I
8058          GOTO209
8059        ENDIF
8060  200 CONTINUE
8061      IFOUND='NO'
8062      GOTO9000
8063  209 CONTINUE
8064C
8065      CALL EXTSTA(ICOM,ICOM2,IHARG,IHARG2,IARGT,ARG,NUMARG,JMIN,JMAX,
8066     1            ICASCT,ICTNAM,ISTANR,ISTADF,IFOUND,ILOCV,
8067     1            ISUBRO,IBUGG3,IERROR)
8068C
8069      IF(IFOUND.EQ.'NO')THEN
8070        ICTNAM='NUMBER'
8071        ILOCV=2
8072        IFOUND='YES'
8073      ENDIF
8074C
8075      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
8076C
8077C               *********************************
8078C               **  STEP 2--                   **
8079C               **  EXTRACT THE VARIABLE LIST  **
8080C               *********************************
8081C
8082      ISTEPN='2'
8083      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAPL')
8084     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8085C
8086C     2016/09: ALLOW MATRIX ARGUMENTS
8087C
8088      INAME='TABULATION PLOT'
8089      MINNA=1
8090      MAXNA=100
8091      MAXVAR=100
8092      MINN2=2
8093      IFLAGE=99
8094      IFLAGM=1
8095      IFLAGP=0
8096      JMIN=1
8097      JMAX=NUMARG
8098      MINNVA=1
8099      MAXNVA=7
8100C
8101      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
8102     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
8103     1            JMIN,JMAX,
8104     1            MINN2,MINNA,MAXNA,MAXVAR,IFLAGE,INAME,
8105     1            IVARN1,IVARN2,IVARTY,PVAR,
8106     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
8107     1            MINNVA,MAXNVA,
8108     1            IFLAGM,IFLAGP,
8109     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
8110      IF(IERROR.EQ.'YES')GOTO9000
8111C
8112      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAPL')THEN
8113        WRITE(ICOUT,999)
8114        CALL DPWRST('XXX','BUG ')
8115        WRITE(ICOUT,251)
8116  251   FORMAT('***** AFTER CALL DPPARS--')
8117        CALL DPWRST('XXX','BUG ')
8118        WRITE(ICOUT,252)NQ,NUMVAR
8119  252   FORMAT('NQ,NUMVAR = ',2I8)
8120        CALL DPWRST('XXX','BUG ')
8121        IF(NUMVAR.GT.0)THEN
8122          DO255I=1,NUMVAR
8123            WRITE(ICOUT,257)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
8124     1                      ICOLR(I)
8125  257       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
8126     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
8127            CALL DPWRST('XXX','BUG ')
8128  255     CONTINUE
8129        ENDIF
8130      ENDIF
8131C
8132C     IF MATRIX ARGUMENTS GIVEN, THEN ALL RESPONSES MUST BE MATRICES
8133C     AND ALL MATRICES MUST HAVE SAME DIMENSION.
8134C
8135      IFLAGM=0
8136      DO260I=1,NUMVAR
8137        IF(IVARTY(I).EQ.'MATR')IFLAGM=1
8138  260 CONTINUE
8139C
8140      IF(IFLAGM.EQ.1)THEN
8141C
8142        NRESP=ISTANR
8143        NLVARI=1
8144        IF(ICASPL.EQ.'TABC')NLVARI=0
8145        NCRTV=2
8146C
8147        DO291I=1,NRESP
8148          IF(IVARTY(I).NE.'MATR')THEN
8149            WRITE(ICOUT,999)
8150            CALL DPWRST('XXX','BUG ')
8151            WRITE(ICOUT,311)
8152            CALL DPWRST('XXX','BUG ')
8153            WRITE(ICOUT,292)
8154  292       FORMAT('      IF ONE RESPONSE VARIABLE IS A MATRIX, ',
8155     1             'THEN ALL MUST BE MATRICES.')
8156            CALL DPWRST('XXX','BUG ')
8157            WRITE(ICOUT,293)I
8158  293       FORMAT('      RESPONSE VARIABLE ',I5,' IS NOT A MATRIX.')
8159            CALL DPWRST('XXX','BUG ')
8160            IERROR='YES'
8161            GOTO9000
8162          ELSE
8163             ILISR=ILIS(I)
8164             NRTEMP=IN(ILISR)
8165             ICOL1=IVALUE(ILISR)
8166             ICOL2=IVALU2(ILISR)
8167             NCTEMP=(ICOL2 - ICOL1) + 1
8168             IF(I.EQ.1)THEN
8169               NROW=NRTEMP
8170               NCOL=NCTEMP
8171             ELSE
8172               IF(NRTEMP.NE.NROW .OR. NCTEMP.NE.NCOL)THEN
8173                 WRITE(ICOUT,999)
8174                 CALL DPWRST('XXX','BUG ')
8175                 WRITE(ICOUT,311)
8176                 CALL DPWRST('XXX','BUG ')
8177                 WRITE(ICOUT,296)
8178  296            FORMAT('      FOR MATRIX RESPONSE VARIABLES, THE ',
8179     1                  'ROW AND COLUMN DIMENSIONS MUST BE EQUAL.')
8180                 CALL DPWRST('XXX','BUG ')
8181                 WRITE(ICOUT,297)NROW,NCOL
8182  297            FORMAT('      THE FIRST MATRIX HAS ',I5,' ROWS AND ',
8183     1                  I5,' COLUMNS.')
8184                 CALL DPWRST('XXX','BUG ')
8185                 WRITE(ICOUT,298)I,NRTEMP,NCTEMP
8186  298            FORMAT('      MATRIX ',I2,' HAS ',I5,' ROWS AND ',
8187     1                  I5,' COLUMNS.')
8188                 CALL DPWRST('XXX','BUG ')
8189                 IERROR='YES'
8190                 GOTO9000
8191               ENDIF
8192             ENDIF
8193          ENDIF
8194  291   CONTINUE
8195C
8196        NTEMP=NRESP + NLVARI
8197        IF(NTEMP.NE.NUMVAR)THEN
8198          WRITE(ICOUT,999)
8199          CALL DPWRST('XXX','BUG ')
8200          WRITE(ICOUT,311)
8201          CALL DPWRST('XXX','BUG ')
8202          WRITE(ICOUT,272)
8203  272     FORMAT('      WHEN MATRIX ARGUMENTS ARE GIVEN, THE ',
8204     1           'NUMBER OF MATRICES')
8205          CALL DPWRST('XXX','BUG ')
8206          WRITE(ICOUT,274)
8207  274     FORMAT('      MUST BE THE SAME AS THE NUMBER OF RESPONSE ',
8208     1           'VARIABLES FOR THE SELECTED STATISTIC.')
8209          CALL DPWRST('XXX','BUG ')
8210          WRITE(ICOUT,276)NUMVAR-NLVARI
8211  276     FORMAT('      THE NUMBER OF MATRICES ENTERED = ',I5)
8212          CALL DPWRST('XXX','BUG ')
8213          WRITE(ICOUT,278)ISTANR
8214  278     FORMAT('      THE NUMBER OF MATRICES EXPECTED = ',I5)
8215          CALL DPWRST('XXX','BUG ')
8216          IERROR='YES'
8217          GOTO9000
8218        ENDIF
8219C
8220        GOTO400
8221C
8222      ENDIF
8223C
8224C               ******************************************************
8225C               **  STEP 3--                                        **
8226C               **  CHECK FOR ALLOWABLE NUMBER OF CROSS TABULATION  **
8227C               **  VARIABLES.                                      **
8228C               ******************************************************
8229C
8230      ISTEPN='3'
8231      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAPL')
8232     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8233C
8234C     FOR "CHARACTER TABULATION" CASE, THE "LEVELS" VARIABLE IS OPTIONAL.
8235C     IF LAST VARIABLE HAS SAME NUMBER OF OBSERVATIONS AS FIRST VARIABLE,
8236C     ASSUME NO "LEVEL" VARIABLE GIVEN.
8237C
8238      NRESP=ISTANR
8239      NLVARI=1
8240      IF(ICASPL.EQ.'TABC' .AND. NRIGHT(1).EQ.NRIGHT(NUMVAR)) NLVARI=0
8241      NCRTV=NUMVAR - NRESP - NLVARI
8242C
8243      IF(NCRTV.LT.1 .OR. NCRTV.GT.4)THEN
8244        WRITE(ICOUT,999)
8245        CALL DPWRST('XXX','BUG ')
8246        WRITE(ICOUT,311)
8247  311   FORMAT('***** ERROR IN TABULATION PLOT--')
8248        CALL DPWRST('XXX','BUG ')
8249        WRITE(ICOUT,312)
8250  312   FORMAT('      THE NUMBER OF CROSS TABULATION VARIABLES MUST')
8251        CALL DPWRST('XXX','BUG ')
8252        WRITE(ICOUT,313)
8253  313   FORMAT('      BE BETWEEN 1 AND 4.  SUCH WAS NOT THE CASE HERE;')
8254        CALL DPWRST('XXX','BUG ')
8255        WRITE(ICOUT,314)NCRTV
8256  314   FORMAT('      THE SPECIFIED NUMBER OF CROSS TABULATION ',
8257     1         'VARIABLES WAS ',I8)
8258        CALL DPWRST('XXX','BUG ')
8259        IF(IWIDTH.GE.1)THEN
8260          WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
8261  318     FORMAT(80A1)
8262          CALL DPWRST('XXX','BUG ')
8263        ENDIF
8264        IERROR='YES'
8265        GOTO9000
8266      ENDIF
8267C
8268C               ******************************************************
8269C               **  STEP 4--                                        **
8270C               **  CREATE THE VARIABLES                            **
8271C               ******************************************************
8272C
8273  400 CONTINUE
8274C
8275      ISTEPN='4'
8276      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAPL')
8277     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8278C
8279      IF(IFLAGM.EQ.1)THEN
8280        ICOL=1
8281        CALL DPPARZ(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
8282     1              INAME,IVARN1,IVARN2,IVARTY,
8283     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
8284     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
8285     1              MAXCP4,MAXCP5,MAXCP6,
8286     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
8287     1              Y1,X1,X2,NLOCAL,
8288     1              IBUGG2,ISUBRO,IFOUND,IERROR)
8289        IF(IERROR.EQ.'YES')GOTO9000
8290C
8291        IF(NRESP.GE.2)THEN
8292          ICOL=2
8293          CALL DPPARZ(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
8294     1                INAME,IVARN1,IVARN2,IVARTY,
8295     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
8296     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
8297     1                MAXCP4,MAXCP5,MAXCP6,
8298     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
8299     1                Y2,X3,X4,N2,
8300     1                IBUGG2,ISUBRO,IFOUND,IERROR)
8301          IF(IERROR.EQ.'YES')GOTO9000
8302        ENDIF
8303C
8304        IF(NRESP.GE.3)THEN
8305          ICOL=3
8306          CALL DPPARZ(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
8307     1                INAME,IVARN1,IVARN2,IVARTY,
8308     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
8309     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
8310     1                MAXCP4,MAXCP5,MAXCP6,
8311     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
8312     1                Y3,X3,X4,N3,
8313     1                IBUGG2,ISUBRO,IFOUND,IERROR)
8314          IF(IERROR.EQ.'YES')GOTO9000
8315        ENDIF
8316C
8317        GOTO499
8318      ENDIF
8319C
8320      J=0
8321      IMAX=NRIGHT(1)
8322      IF(NQ.LT.NRIGHT(1))IMAX=NQ
8323      DO410I=1,IMAX
8324        IF(ISUB(I).EQ.0)GOTO410
8325        J=J+1
8326C
8327        IJ=MAXN*(ICOLR(1)-1)+I
8328        IF(ISTANR.LT.1)THEN
8329          Y1(J)=0.0
8330        ELSE
8331          IF(ICOLR(1).LE.MAXCOL)Y1(J)=V(IJ)
8332          IF(ICOLR(1).EQ.MAXCP1)Y1(J)=PRED(I)
8333          IF(ICOLR(1).EQ.MAXCP2)Y1(J)=RES(I)
8334          IF(ICOLR(1).EQ.MAXCP3)Y1(J)=YPLOT(I)
8335          IF(ICOLR(1).EQ.MAXCP4)Y1(J)=XPLOT(I)
8336          IF(ICOLR(1).EQ.MAXCP5)Y1(J)=X2PLOT(I)
8337          IF(ICOLR(1).EQ.MAXCP6)Y1(J)=TAGPLO(I)
8338        ENDIF
8339C
8340        IJ=MAXN*(ICOLR(2)-1)+I
8341        IF(ISTANR.LT.2)THEN
8342          Y2(J)=0.0
8343        ELSE
8344          IF(ICOLR(2).LE.MAXCOL)Y2(J)=V(IJ)
8345          IF(ICOLR(2).EQ.MAXCP1)Y2(J)=PRED(I)
8346          IF(ICOLR(2).EQ.MAXCP2)Y2(J)=RES(I)
8347          IF(ICOLR(2).EQ.MAXCP3)Y2(J)=YPLOT(I)
8348          IF(ICOLR(2).EQ.MAXCP4)Y2(J)=XPLOT(I)
8349          IF(ICOLR(2).EQ.MAXCP5)Y2(J)=X2PLOT(I)
8350          IF(ICOLR(2).EQ.MAXCP6)Y2(J)=TAGPLO(I)
8351        ENDIF
8352C
8353        IJ=MAXN*(ICOLR(3)-1)+I
8354        IF(ISTANR.LT.3)THEN
8355          Y3(J)=0.0
8356        ELSE
8357          IF(ICOLR(3).LE.MAXCOL)Y3(J)=V(IJ)
8358          IF(ICOLR(3).EQ.MAXCP1)Y3(J)=PRED(I)
8359          IF(ICOLR(3).EQ.MAXCP2)Y3(J)=RES(I)
8360          IF(ICOLR(3).EQ.MAXCP3)Y3(J)=YPLOT(I)
8361          IF(ICOLR(3).EQ.MAXCP4)Y3(J)=XPLOT(I)
8362          IF(ICOLR(3).EQ.MAXCP5)Y3(J)=X2PLOT(I)
8363          IF(ICOLR(3).EQ.MAXCP6)Y3(J)=TAGPLO(I)
8364        ENDIF
8365C
8366        ICNT=ISTANR+1
8367        IF(NCRTV.GE.1)THEN
8368          IJ=MAXN*(ICOLR(ICNT)-1)+I
8369          IF(ICOLR(ICNT).LE.MAXCOL)X1(J)=V(IJ)
8370          IF(ICOLR(ICNT).EQ.MAXCP1)X1(J)=PRED(I)
8371          IF(ICOLR(ICNT).EQ.MAXCP2)X1(J)=RES(I)
8372          IF(ICOLR(ICNT).EQ.MAXCP3)X1(J)=YPLOT(I)
8373          IF(ICOLR(ICNT).EQ.MAXCP4)X1(J)=XPLOT(I)
8374          IF(ICOLR(ICNT).EQ.MAXCP5)X1(J)=X2PLOT(I)
8375          IF(ICOLR(ICNT).EQ.MAXCP6)X1(J)=TAGPLO(I)
8376        ELSE
8377          X1(J)=0.0
8378        ENDIF
8379C
8380        ICNT=ISTANR+2
8381        IF(NCRTV.GE.2)THEN
8382          IJ=MAXN*(ICOLR(ICNT)-1)+I
8383          IF(ICOLR(ICNT).LE.MAXCOL)X2(J)=V(IJ)
8384          IF(ICOLR(ICNT).EQ.MAXCP1)X2(J)=PRED(I)
8385          IF(ICOLR(ICNT).EQ.MAXCP2)X2(J)=RES(I)
8386          IF(ICOLR(ICNT).EQ.MAXCP3)X2(J)=YPLOT(I)
8387          IF(ICOLR(ICNT).EQ.MAXCP4)X2(J)=XPLOT(I)
8388          IF(ICOLR(ICNT).EQ.MAXCP5)X2(J)=X2PLOT(I)
8389          IF(ICOLR(ICNT).EQ.MAXCP6)X2(J)=TAGPLO(I)
8390        ELSE
8391          X2(J)=0.0
8392        ENDIF
8393C
8394        ICNT=ISTANR+3
8395        IF(NCRTV.GE.3)THEN
8396          IJ=MAXN*(ICOLR(ICNT)-1)+I
8397          IF(ICOLR(ICNT).LE.MAXCOL)X3(J)=V(IJ)
8398          IF(ICOLR(ICNT).EQ.MAXCP1)X3(J)=PRED(I)
8399          IF(ICOLR(ICNT).EQ.MAXCP2)X3(J)=RES(I)
8400          IF(ICOLR(ICNT).EQ.MAXCP3)X3(J)=YPLOT(I)
8401          IF(ICOLR(ICNT).EQ.MAXCP4)X3(J)=XPLOT(I)
8402          IF(ICOLR(ICNT).EQ.MAXCP5)X3(J)=X2PLOT(I)
8403          IF(ICOLR(ICNT).EQ.MAXCP6)X3(J)=TAGPLO(I)
8404        ELSE
8405          X3(J)=0.0
8406        ENDIF
8407C
8408        ICNT=ISTANR+4
8409        IF(NCRTV.GE.4)THEN
8410          IJ=MAXN*(ICOLR(ICNT)-1)+I
8411          IF(ICOLR(ICNT).LE.MAXCOL)X4(J)=V(IJ)
8412          IF(ICOLR(ICNT).EQ.MAXCP1)X4(J)=PRED(I)
8413          IF(ICOLR(ICNT).EQ.MAXCP2)X4(J)=RES(I)
8414          IF(ICOLR(ICNT).EQ.MAXCP3)X4(J)=YPLOT(I)
8415          IF(ICOLR(ICNT).EQ.MAXCP4)X4(J)=XPLOT(I)
8416          IF(ICOLR(ICNT).EQ.MAXCP5)X4(J)=X2PLOT(I)
8417          IF(ICOLR(ICNT).EQ.MAXCP6)X4(J)=TAGPLO(I)
8418        ELSE
8419          X4(J)=0.0
8420        ENDIF
8421C
8422  410 CONTINUE
8423      NLOCAL=J
8424C
8425  499 CONTINUE
8426C
8427      IF(NLVARI.GE.1)THEN
8428        J2=0
8429        IMAX=NRIGHT(NUMVAR)
8430        DO490I=1,IMAX
8431          J2=J2+1
8432C
8433          IJ=MAXN*(ICOLR(NUMVAR)-1)+I
8434          IF(ICOLR(NUMVAR).LE.MAXCOL)YLEVEL(J2)=V(IJ)
8435          IF(ICOLR(NUMVAR).EQ.MAXCP1)YLEVEL(J2)=PRED(I)
8436          IF(ICOLR(NUMVAR).EQ.MAXCP2)YLEVEL(J2)=RES(I)
8437          IF(ICOLR(NUMVAR).EQ.MAXCP3)YLEVEL(J2)=YPLOT(I)
8438          IF(ICOLR(NUMVAR).EQ.MAXCP4)YLEVEL(J2)=XPLOT(I)
8439          IF(ICOLR(NUMVAR).EQ.MAXCP5)YLEVEL(J2)=X2PLOT(I)
8440          IF(ICOLR(NUMVAR).EQ.MAXCP6)YLEVEL(J2)=TAGPLO(I)
8441  490   CONTINUE
8442        NLEVEL=J2
8443      ELSE
8444        YLEVEL(J2)=CPUMIN
8445        NLEVEL=-99
8446      ENDIF
8447C
8448C               *************************************
8449C               **  STEP 5--                       **
8450C               **  GENERATE THE TABULATION PLOT   **
8451C               *************************************
8452C
8453      ISTEPN='61'
8454      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAPL')THEN
8455        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8456        WRITE(ICOUT,6001)NLOCAL,NLEVEL,ICASPL
8457 6001   FORMAT('NLOCAL,NLEVEL,ICASPL=',2I8,1X,A4)
8458        CALL DPWRST('XXX','BUG ')
8459      ENDIF
8460C
8461      IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
8462     1   ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
8463        IHP='ALPH'
8464        IHP2='A   '
8465        IHWUSE='P'
8466        MESSAG='NO'
8467        CALL CHECKN(IHP,IHP2,IHWUSE,
8468     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
8469     1              NUMNAM,MAXNAM,
8470     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,
8471     1              ILOCP,IERROR)
8472        IF(IERROR.EQ.'YES')THEN
8473          ALPHA=0.05
8474        ELSE
8475          ALPHA=VALUE(ILOCP)
8476          IF(ALPHA.LE.0.0)ALPHA=0.05
8477          IF(ALPHA.GE.1.0)ALPHA=0.05
8478        ENDIF
8479      ELSE
8480        ALPHA=0.05
8481      ENDIF
8482C
8483      IF(ICASPL.EQ.'TABU')THEN
8484        CALL DPTAP2(Y1,Y2,Y3,X1,X2,X3,X4,NLOCAL,YLEVEL,NLEVEL,
8485     1              NUMVAR,ICASCT,ICTNAM,ISTANR,
8486     1              XH1DIS,XH2DIS,XH3DIS,XH4DIS,
8487     1              TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
8488     1              TEMP6,TEMP7,TEMP8,TEMP9,TMP10,TMP11,
8489     1              XACLOW,XACUPP,
8490     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
8491     1              DTEMP1,DTEMP2,DTEMP3,
8492     1              ISEED,ICTAMV,PSTAMV,PCTAMV,ALPHA,IQUASE,
8493     1              NCRTV,MAXOBV,PTPLXI,PTPLYI,ITPLDI,ITPLUN,
8494     1              ITPLNI,ITPLCD,
8495     1              ITPLSO,ITPLSR,ITPLSC,
8496     1              ITPLRM,ITPLCM,
8497     1              Y,X,D,DCOLOR,
8498     1              NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
8499      ELSE
8500        CALL DPTAC2(Y1,Y2,Y3,X1,X2,X3,X4,NLOCAL,YLEVEL,NLEVEL,
8501     1              NUMVAR,ICASCT,ICTNAM,ISTANR,
8502     1              XH1DIS,XH2DIS,XH3DIS,XH4DIS,
8503     1              TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
8504     1              TEMP6,TEMP7,TEMP8,TEMP9,TMP10,TMP11,
8505     1              XACLOW,XACUPP,
8506     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
8507     1              DTEMP1,DTEMP2,DTEMP3,
8508     1              ISEED,ICTAMV,PSTAMV,PCTAMV,ALPHA,IQUASE,
8509     1              NCRTV,MAXOBV,PTPLXI,PTPLYI,ITPLDI,ITPLUN,
8510     1              ITPLNI,ITPLCD,ITPLSO,ITPLSR,ITPLSC,
8511     1              ITPLRM,ITPLCM,
8512     1              Y,X,D,X3D,
8513     1              NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
8514      ENDIF
8515C
8516C               *****************
8517C               **  STEP 9--   **
8518C               **  EXIT       **
8519C               *****************
8520C
8521 9000 CONTINUE
8522      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TAPL')THEN
8523        WRITE(ICOUT,999)
8524        CALL DPWRST('XXX','BUG ')
8525        WRITE(ICOUT,9011)
8526 9011   FORMAT('***** AT THE END       OF DPTAPL--')
8527        CALL DPWRST('XXX','BUG ')
8528        WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO
8529 9012   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
8530        CALL DPWRST('XXX','BUG ')
8531        WRITE(ICOUT,9013)IFOUND,IERROR
8532 9013   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
8533        CALL DPWRST('XXX','BUG ')
8534        WRITE(ICOUT,9014)NPLOTV,NPLOTP,NLOCAL,ICASPL,IAND1,IAND2
8535 9014   FORMAT('NPLOTV,NPLOTP,NLOCAL,ICASPL,IAND1,IAND2 = ',
8536     1         I8,I8,I8,2X,A4,2X,A4,2X,A4)
8537        CALL DPWRST('XXX','BUG ')
8538        WRITE(ICOUT,9041)NLOCAL
8539 9041   FORMAT('NLOCAL = ',I8)
8540        CALL DPWRST('XXX','BUG ')
8541        IF(NLOCAL.GE.1 .AND. ICASE.EQ.'VARI')THEN
8542          DO9042I=1,NLOCAL
8543            WRITE(ICOUT,9043)I,Y1(I),Y2(I)
8544 9043       FORMAT('I,Y1(I),Y2(I) = ',I8,2E15.7)
8545            CALL DPWRST('XXX','BUG ')
8546 9042     CONTINUE
8547        ENDIF
8548        WRITE(ICOUT,9051)NPLOTP
8549 9051   FORMAT('NPLOTP = ',I8)
8550        CALL DPWRST('XXX','BUG ')
8551        IF(NPLOTP.GE.1)THEN
8552          DO9052I=1,NPLOTP
8553            WRITE(ICOUT,9053)I,Y(I),X(I),D(I),DCOLOR(I)
8554 9053       FORMAT('I,Y(I),X(I),D(I),DCOLOR(I),',I8,4F12.5)
8555            CALL DPWRST('XXX','BUG ')
8556 9052     CONTINUE
8557        ENDIF
8558      ENDIF
8559C
8560      RETURN
8561      END
8562      SUBROUTINE DPTAP2(Y1,Y2,Y3,TAG1,TAG2,TAG3,TAG4,N,YLEVEL,NLEVEL,
8563     1                  NUMV2,ICASCT,ICTNAM,ISTANR,
8564     1                  XIDTEM,XIDTE2,XIDTE3,XIDTE4,
8565     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
8566     1                  TEMP6,TEMP7,TEMP8,TEMP9,TMP10,TMP11,
8567     1                  XACLOW,XACUPP,
8568     1                  ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
8569     1                  DTEMP1,DTEMP2,DTEMP3,
8570     1                  ISEED,ICTAMV,PSTAMV,PCTAMV,ALPHA,IQUASE,
8571     1                  NCRTV,MAXOBV,PTPLXI,PTPLYI,ITPLDI,ITPLUN,
8572     1                  ITPLNI,ITPLCD,ITPLSO,ITPLSR,ITPLSC,
8573     1                  ITPLRM,ITPLCM,
8574     1                  Y,X,D,DCOLOR,
8575     1                  NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
8576C
8577C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
8578C              THAT WILL DEFINE AN TABULATION PLOT
8579C     DESCRIPTION--IN THE TABULATION PLOT, WE CROSS-TABULATE OVER
8580C                  1 TO 4 GROUP-ID VARIABLES (ANALAGOUS TO A
8581C                  FLUCTUATION PLOT).  WE DEFINE A GRID BASED ON THE
8582C                  THESE GROUP-ID VARIABLES.  THEN FOR THE RESPONSE
8583C                  VALUES CORRESPONDING TO A GIVEN SET OF THESE
8584C                  GROUP-ID VARIABLES, WE COMPUTE A USER-SPECIFED
8585C                  STATISTIC (THE DEFAULT IS THE MEAN).  THE VALUE
8586C                  OF THE STATISTIC IS THEN COMPARED TO SOME
8587C                  USER-SPECIFIED LEVELS (THESE ARE DEFINED IN THE
8588C                  YLEVEL VARIABLE).  A RECTANGLE IS DRAWN AND THE
8589C                  ATTRIBUTES (PRIMARILY FILL COLOR) ARE BASED ON
8590C                  THE VALUE OF THE STATISTIC RELATIVE TO YLEVEL.
8591C
8592C                  THIS PLOT IS USEFUL FOR VISUALLY IDENTIFYING
8593C                  AREAS WITH "HIGH" AND "LOW" VALUES OF THE
8594C                  STATISTIC ACROSS GROUPS.
8595C     WRITTEN BY--ALAN HECKERT
8596C                 STATISTICAL ENGINEERING DIVISION
8597C                 INFORMATION TECHNOLOGY LABORATORY
8598C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8599C                 GAITHERSBURG, MD 20899-8980
8600C                 PHONE--301-975-2889
8601C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8602C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8603C     LANGUAGE--ANSI FORTRAN (1977)
8604C     VERSION NUMBER--2009/9
8605C     ORIGINAL VERSION--SEPTEMBER 2009.
8606C     UPDATED         --DECEMBER  2009. SUPPORT FOR "UNCERTAINTY" OPTION
8607C                                       FOR BINOMIAL PROBABILITIES
8608C     UPDATED         --JANUARY   2010. SUPPORT FOR UNCERTAINTY INTERVALS
8609C                                       FOR BINOMIAL RATIO
8610C     UPDATED         --JANUARY   2010. OPTION TO LEAVE AXIS VARIABLES
8611C                                       UNCODED
8612C     UPDATED         --JUNE      2010. SUPPORT FOR "SORTED" OPTION FOR
8613C                                       THE TWO GROUP-ID VARIABLE CASE
8614C
8615C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8616C
8617      CHARACTER*4 ICASCT
8618      CHARACTER*60 ICTNAM
8619      CHARACTER*4 ICTAMV
8620      CHARACTER*4 IQUASE
8621      CHARACTER*4 ITPLDI
8622      CHARACTER*4 ITPLUN
8623      CHARACTER*4 ITPLCD
8624      CHARACTER*4 ITPLSO
8625      CHARACTER*4 ITPLSR
8626      CHARACTER*4 ITPLSC
8627      CHARACTER*4 ITPLRM
8628      CHARACTER*4 ITPLCM
8629      CHARACTER*4 IBUGG3
8630      CHARACTER*4 ISUBRO
8631      CHARACTER*4 IERROR
8632C
8633      CHARACTER*4 IWRITE
8634      CHARACTER*4 ISUBN1
8635      CHARACTER*4 ISUBN2
8636      CHARACTER*4 ISTEPN
8637C
8638C---------------------------------------------------------------------
8639C
8640      DIMENSION Y1(*)
8641      DIMENSION Y2(*)
8642      DIMENSION Y3(*)
8643      DIMENSION YLEVEL(*)
8644      DIMENSION TAG1(*)
8645      DIMENSION TAG2(*)
8646      DIMENSION TAG3(*)
8647      DIMENSION TAG4(*)
8648C
8649      DIMENSION XIDTEM(*)
8650      DIMENSION XIDTE2(*)
8651      DIMENSION XIDTE3(*)
8652      DIMENSION XIDTE4(*)
8653C
8654      DIMENSION TEMP1(*)
8655      DIMENSION TEMP2(*)
8656      DIMENSION TEMP3(*)
8657      DIMENSION TEMP4(*)
8658      DIMENSION TEMP5(*)
8659      DIMENSION TEMP6(*)
8660      DIMENSION TEMP7(*)
8661      DIMENSION TEMP8(*)
8662      DIMENSION TEMP9(*)
8663      DIMENSION TMP10(*)
8664      DIMENSION TMP11(*)
8665C
8666      DIMENSION ITEMP1(*)
8667      DIMENSION ITEMP2(*)
8668      DIMENSION ITEMP3(*)
8669      DIMENSION ITEMP4(*)
8670      DIMENSION ITEMP5(*)
8671      DIMENSION ITEMP6(*)
8672C
8673      DOUBLE PRECISION DTEMP1(*)
8674      DOUBLE PRECISION DTEMP2(*)
8675      DOUBLE PRECISION DTEMP3(*)
8676C
8677      DIMENSION Y(*)
8678      DIMENSION X(*)
8679      DIMENSION D(*)
8680      DIMENSION DCOLOR(*)
8681C
8682      DIMENSION XACLOW(*)
8683      DIMENSION XACUPP(*)
8684C
8685C-----COMMON----------------------------------------------------------
8686C
8687      INCLUDE 'DPCOP2.INC'
8688C
8689C-----START POINT-----------------------------------------------------
8690C
8691      ISUBN1='DPTA'
8692      ISUBN2='P2  '
8693      IWRITE='OFF'
8694      IERROR='NO'
8695C
8696C               ********************************************
8697C               **  STEP 1--                              **
8698C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
8699C               ********************************************
8700C
8701C
8702C     CHECK THE INPUT ARGUMENTS FOR ERRORS
8703C
8704      IF(N.LT.2)THEN
8705        WRITE(ICOUT,999)
8706  999   FORMAT(1X)
8707        CALL DPWRST('XXX','BUG ')
8708        WRITE(ICOUT,31)
8709   31   FORMAT('***** ERROR IN TABULATION PLOT--')
8710        CALL DPWRST('XXX','BUG ')
8711        WRITE(ICOUT,32)
8712   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
8713        CALL DPWRST('XXX','BUG ')
8714        WRITE(ICOUT,34)N
8715   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
8716        CALL DPWRST('XXX','BUG ')
8717        WRITE(ICOUT,999)
8718        CALL DPWRST('XXX','BUG ')
8719        IERROR='YES'
8720        GOTO9000
8721      ENDIF
8722C
8723      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
8724        WRITE(ICOUT,70)
8725   70   FORMAT('AT THE BEGINNING OF DPTAP2--')
8726        CALL DPWRST('XXX','BUG ')
8727        WRITE(ICOUT,71)ICASCT,N,NUMV2,NCRTV,NLEVEL,ISTANR
8728   71   FORMAT('ICASCT,N,NUMV2,NCRTV,NLEVEL,ISTANR = ',A4,2X,5I8)
8729        CALL DPWRST('XXX','BUG ')
8730        WRITE(ICOUT,74)ICTNAM
8731   74   FORMAT('ICTNAM = ',A60)
8732        CALL DPWRST('XXX','BUG ')
8733        DO72I=1,N
8734          WRITE(ICOUT,73)I,Y1(I),Y2(I),TAG1(I),TAG2(I),TAG3(I),
8735     1                   TAG4(I)
8736   73     FORMAT('I,Y(I),Y2(I),TAG1-6(I) = ',I8,9F10.3)
8737          CALL DPWRST('XXX','BUG ')
8738   72   CONTINUE
8739        DO82I=1,NLEVEL
8740          WRITE(ICOUT,83)I,YLEVEL(I)
8741   83     FORMAT('I,YLEVEL(I) = ',I8,G15.7)
8742          CALL DPWRST('XXX','BUG ')
8743   82   CONTINUE
8744      ENDIF
8745C
8746      CALL DISTIN(YLEVEL,NLEVEL,IWRITE,TEMP1,NTEMP,IBUGG3,IERROR)
8747      DO110I=1,NTEMP
8748        YLEVEL(I)=TEMP1(I)
8749  110 CONTINUE
8750      NLEVEL=NTEMP
8751      CALL SORT(YLEVEL,NLEVEL,YLEVEL)
8752C
8753C               ******************************************************
8754C               **  STEP 1--                                        **
8755C               **  DETERMINE THE NUMBER OF DISTINCT VALUES         **
8756C               **  FOR THE GROUP VARIABLES (TAG1, TAG2)            **
8757C               **  IF ALL VALUES ARE DISTINCT, THEN THIS           **
8758C               **  IMPLIES WE HAVE THE NO REPLICATION CASE         **
8759C               **  WHICH IS AN ERROR CONDITION FOR A PLOT.         **
8760C               ******************************************************
8761C
8762      ISTEPN='1'
8763      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAP2')
8764     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8765C
8766      IF(ITPLCD.EQ.'ON')THEN
8767        CALL CODE(TAG1,N,IWRITE,TEMP1,TEMP2,MAXOBV,IBUGG3,IERROR)
8768        DO910I=1,N
8769          TAG1(I)=TEMP1(I)
8770  910   CONTINUE
8771      ENDIF
8772      CALL DISTIN(TAG1,N,IWRITE,XIDTEM,NUMSE1,IBUGG3,IERROR)
8773      CALL SORT(XIDTEM,NUMSE1,XIDTEM)
8774C
8775      IF(NCRTV.GE.2)THEN
8776        IF(ITPLCD.EQ.'ON')THEN
8777          CALL CODE(TAG2,N,IWRITE,TEMP1,TEMP2,MAXOBV,IBUGG3,IERROR)
8778          DO920I=1,N
8779            TAG2(I)=TEMP1(I)
8780  920     CONTINUE
8781        ENDIF
8782        CALL DISTIN(TAG2,N,IWRITE,XIDTE2,NUMSE2,IBUGG3,IERROR)
8783        CALL SORT(XIDTE2,NUMSE2,XIDTE2)
8784      ENDIF
8785C
8786      IF(NCRTV.GE.3)THEN
8787        IF(ITPLCD.EQ.'ON')THEN
8788          CALL CODE(TAG3,N,IWRITE,TEMP1,TEMP2,MAXOBV,IBUGG3,IERROR)
8789          DO930I=1,N
8790            TAG3(I)=TEMP1(I)
8791  930     CONTINUE
8792        ENDIF
8793        CALL DISTIN(TAG3,N,IWRITE,XIDTE3,NUMSE3,IBUGG3,IERROR)
8794        CALL SORT(XIDTE3,NUMSE3,XIDTE3)
8795      ELSE
8796        NUMSE3=0
8797      ENDIF
8798C
8799      IF(NCRTV.GE.4)THEN
8800        IF(ITPLCD.EQ.'ON')THEN
8801          CALL CODE(TAG4,N,IWRITE,TEMP1,TEMP2,MAXOBV,IBUGG3,IERROR)
8802          DO940I=1,N
8803            TAG4(I)=TEMP1(I)
8804  940     CONTINUE
8805        ENDIF
8806        CALL DISTIN(TAG4,N,IWRITE,XIDTE4,NUMSE4,IBUGG3,IERROR)
8807        CALL SORT(XIDTE4,NUMSE4,XIDTE4)
8808      ELSE
8809        NUMSE4=0
8810      ENDIF
8811C
8812      IF(NUMSE1.LT.1 .OR. NUMSE1.GT.N)THEN
8813        WRITE(ICOUT,999)
8814        CALL DPWRST('XXX','BUG ')
8815        WRITE(ICOUT,31)
8816        CALL DPWRST('XXX','BUG ')
8817        ITEMP=1
8818        WRITE(ICOUT,111)ITEMP,NUMSE1
8819  111   FORMAT('      THE NUMBER OF SETS FOR THE GROUP ',I1,
8820     1         ' VARIABLE, ',I8,',')
8821        CALL DPWRST('XXX','BUG ')
8822        WRITE(ICOUT,113)
8823  113   FORMAT('      IS EITHER LESS THAN ONE OR GREATER THAN THE ',
8824     1         'NUMBER')
8825        CALL DPWRST('XXX','BUG ')
8826        WRITE(ICOUT,115)N
8827  115   FORMAT('      OF OBSERVATIONS, ',I8,'.')
8828        CALL DPWRST('XXX','BUG ')
8829        IERROR='YES'
8830        GOTO9000
8831      ENDIF
8832C
8833      IF(NCRTV.GE.2 .AND. (NUMSE2.LT.1 .OR. NUMSE2.GT.N))THEN
8834        WRITE(ICOUT,999)
8835        CALL DPWRST('XXX','BUG ')
8836        WRITE(ICOUT,31)
8837        CALL DPWRST('XXX','BUG ')
8838        ITEMP=2
8839        WRITE(ICOUT,111)ITEMP,NUMSE2
8840        CALL DPWRST('XXX','BUG ')
8841        WRITE(ICOUT,113)
8842        CALL DPWRST('XXX','BUG ')
8843        WRITE(ICOUT,115)N
8844        CALL DPWRST('XXX','BUG ')
8845        IERROR='YES'
8846        GOTO9000
8847      ENDIF
8848C
8849      IF(NCRTV.GE.3 .AND. (NUMSE3.LT.1 .OR. NUMSE3.GT.N))THEN
8850        WRITE(ICOUT,999)
8851        CALL DPWRST('XXX','BUG ')
8852        WRITE(ICOUT,31)
8853        CALL DPWRST('XXX','BUG ')
8854        ITEMP=3
8855        WRITE(ICOUT,111)ITEMP,NUMSE3
8856        CALL DPWRST('XXX','BUG ')
8857        WRITE(ICOUT,113)
8858        CALL DPWRST('XXX','BUG ')
8859        WRITE(ICOUT,115)N
8860        CALL DPWRST('XXX','BUG ')
8861        IERROR='YES'
8862        GOTO9000
8863      ENDIF
8864C
8865      IF(NCRTV.GE.4 .AND. (NUMSE4.LT.1 .OR. NUMSE4.GT.N))THEN
8866        WRITE(ICOUT,999)
8867        CALL DPWRST('XXX','BUG ')
8868        WRITE(ICOUT,31)
8869        CALL DPWRST('XXX','BUG ')
8870        ITEMP=4
8871        WRITE(ICOUT,111)ITEMP,NUMSE4
8872        CALL DPWRST('XXX','BUG ')
8873        WRITE(ICOUT,113)
8874        CALL DPWRST('XXX','BUG ')
8875        WRITE(ICOUT,115)N
8876        CALL DPWRST('XXX','BUG ')
8877        IERROR='YES'
8878        GOTO9000
8879      ENDIF
8880C
8881      AN=REAL(N)
8882      ANUMS1=REAL(NUMSE1)
8883      ANUMS2=REAL(NUMSE2)
8884      ANUMS3=REAL(NUMSE3)
8885      ANUMS4=REAL(NUMSE4)
8886C
8887C     FOR THE BINOMIAL PROPORTION, MEAN CONFIDENCE LIMIT, AND
8888C     MEDIAN CONFIDENCE LIMIT, INSTEAD OF A SINGLE SHADED RECTANGLE,
8889C     DEFINE "ITPLNI" INTERVALS THAT WILL BE SHADED FROM LOWEST
8890C     CONFIDENCE VALUE TO HIGHEST CONFIDENCE VALUE.
8891C
8892      IFLAGU=0
8893      IF((ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
8894     1    ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT') .AND.
8895     1    ITPLUN.EQ.'ON')THEN
8896        IFLAGU=1
8897      ENDIF
8898C
8899C               ***********************************************
8900C               **  STEP 5--                                 **
8901C               **  COMPUTE THE VARIOUS CROSS-TAB STATISTICS **
8902C               ***********************************************
8903C
8904      ISTEPN='5.1'
8905      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAP2')
8906     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8907C
8908      IWRITE='OFF'
8909C
8910      IF(NCRTV.EQ.1)THEN
8911        CALL DPTAP0(Y1,Y2,Y3,TAG1,N,
8912     1              NUMV2,ICASCT,ISTANR,
8913     1              XIDTEM,
8914     1              NUMSE1,
8915     1              TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
8916     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
8917     1              DTEMP1,DTEMP2,DTEMP3,
8918     1              ISEED,ALPHA,
8919     1              ICTAMV,PCTAMV,PSTAMV,IQUASE,
8920     1              TEMP6,TEMP7,XACLOW,XACUPP,N2,
8921     1              ISUBRO,IBUGG3,IERROR)
8922C
8923CCCCC   NOW GENERATE THE PLOT COORDINATES.  DEFINE A RECTANGLE
8924CCCCC   FOR EACH POINT.
8925CCCCC
8926C
8927        XINC=0.5 - PTPLXI
8928        YINC=0.5 - PTPLYI
8929        ICNT=0
8930        ICNT2=0
8931C
8932        IF(IFLAGU.EQ.1)THEN
8933          DO2000I=1,N2
8934            STAT=TEMP6(I)
8935            STATMN=XACLOW(I)
8936            STATMX=XACUPP(I)
8937            IF(ITPLDI.EQ.'X')THEN
8938              XVAL=TEMP7(I)
8939              YVAL=1.0
8940            ELSE
8941              YVAL=TEMP7(I)
8942              XVAL=1.0
8943            ENDIF
8944C
8945            XCOOR1=XVAL - XINC
8946            XCOOR2=XVAL + XINC
8947            YCOOR1=YVAL - YINC
8948            YCOOR2=YVAL + YINC
8949C
8950C           DIVIDE RECTANGLE INTO "ITPLNI" VERTICAL INCREMENTS AND
8951C           COMPUTE LEVEL-COLOR INDEPENDENTLY FOR EACH OF THESE
8952C           MINI-RECTANGLES.
8953C
8954            STATIN=(STATMX - STATMN)/REAL(ITPLNI)
8955            STATZ=STATMN - STATIN
8956            AINC=(YCOOR2 - YCOOR1)/REAL(ITPLNI)
8957            YCZ2=YCOOR1
8958C
8959            DO2009IROW=1,ITPLNI
8960C
8961              YCZ1=YCZ2
8962              YCZ2=YCZ1 + AINC
8963C
8964              STATZ=STATZ + STATIN
8965              IF(STATZ.LT.YLEVEL(1))THEN
8966                ILEVEL=1
8967              ELSEIF(STATZ.GE.YLEVEL(NLEVEL))THEN
8968                ILEVEL=NLEVEL+1
8969              ELSE
8970                DO2005J=2,NLEVEL
8971                  IF(STATZ.GE.YLEVEL(J-1) .AND. STATZ.LT.YLEVEL(J))THEN
8972                    ILEVEL=J
8973                  ENDIF
8974 2005           CONTINUE
8975              ENDIF
8976C
8977              IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
8978                WRITE(ICOUT,2006)I,IROW,STAT,STATZ,STATMN,STATMX,STATIN
8979 2006           FORMAT('I,IROW,STAT,STATZ,STATMN,STATMX,STATIN = ',
8980     1                 2I8,5G15.7)
8981                CALL DPWRST('XXX','BUG ')
8982                WRITE(ICOUT,2007)XCOOR1,XCOOR2,YCOOR1,YCOOR2,YCZ1,YCZ2
8983 2007           FORMAT('XCOOR1,XCOOR2,YCOOR1,YCOOR2,YCZ1,YCZ2 = ',
8984     1                 6G15.7)
8985                CALL DPWRST('XXX','BUG ')
8986                WRITE(ICOUT,2008)IROW,ILEVEL
8987 2008           FORMAT('IROW,ILEVEL = ',2I8)
8988                CALL DPWRST('XXX','BUG ')
8989              ENDIF
8990C
8991              ICNT2=ICNT2+1
8992              ICNT=ICNT+1
8993              X(ICNT)=XCOOR1
8994              Y(ICNT)=YCZ1
8995              D(ICNT)=REAL(ICNT2)
8996              DCOLOR(ICNT)=REAL(ILEVEL)
8997C
8998              ICNT=ICNT+1
8999              X(ICNT)=XCOOR2
9000              Y(ICNT)=YCZ1
9001              D(ICNT)=REAL(ICNT2)
9002              DCOLOR(ICNT)=REAL(ILEVEL)
9003C
9004              ICNT=ICNT+1
9005              X(ICNT)=XCOOR2
9006              Y(ICNT)=YCZ2
9007              D(ICNT)=REAL(ICNT2)
9008              DCOLOR(ICNT)=REAL(ILEVEL)
9009C
9010              ICNT=ICNT+1
9011              X(ICNT)=XCOOR1
9012              Y(ICNT)=YCZ2
9013              D(ICNT)=REAL(ICNT2)
9014              DCOLOR(ICNT)=REAL(ILEVEL)
9015C
9016              ICNT=ICNT+1
9017              X(ICNT)=XCOOR1
9018              Y(ICNT)=YCZ1
9019              D(ICNT)=REAL(ICNT2)
9020              DCOLOR(ICNT)=REAL(ILEVEL)
9021C
9022 2009       CONTINUE
9023C
9024 2000     CONTINUE
9025        ELSE
9026          DO1001I=1,N2
9027            STAT=TEMP6(I)
9028            IF(ITPLDI.EQ.'X')THEN
9029              XVAL=TEMP7(I)
9030              YVAL=1.0
9031            ELSE
9032              YVAL=TEMP7(I)
9033              XVAL=1.0
9034            ENDIF
9035            XCOOR1=XVAL - XINC
9036            XCOOR2=XVAL + XINC
9037            YCOOR1=YVAL - YINC
9038            YCOOR2=YVAL + YINC
9039            IF(STAT.LT.YLEVEL(1))THEN
9040              ILEVEL=1
9041            ELSEIF(STAT.GE.YLEVEL(NLEVEL))THEN
9042              ILEVEL=NLEVEL+1
9043            ELSE
9044              DO1005J=2,NLEVEL
9045                IF(STAT.GE.YLEVEL(J-1) .AND. STAT.LT.YLEVEL(J))THEN
9046                  ILEVEL=J
9047                ENDIF
9048 1005       CONTINUE
9049            ENDIF
9050C
9051            ICNT2=ICNT2+1
9052            ICNT=ICNT+1
9053            X(ICNT)=XCOOR1
9054            Y(ICNT)=YCOOR1
9055            D(ICNT)=REAL(ICNT2)
9056            DCOLOR(ICNT)=REAL(ILEVEL)
9057C
9058            ICNT=ICNT+1
9059            X(ICNT)=XCOOR2
9060            Y(ICNT)=YCOOR1
9061            D(ICNT)=REAL(ICNT2)
9062            DCOLOR(ICNT)=REAL(ILEVEL)
9063C
9064            ICNT=ICNT+1
9065            X(ICNT)=XCOOR2
9066            Y(ICNT)=YCOOR2
9067            D(ICNT)=REAL(ICNT2)
9068            DCOLOR(ICNT)=REAL(ILEVEL)
9069C
9070            ICNT=ICNT+1
9071            X(ICNT)=XCOOR1
9072            Y(ICNT)=YCOOR2
9073            D(ICNT)=REAL(ICNT2)
9074            DCOLOR(ICNT)=REAL(ILEVEL)
9075C
9076            ICNT=ICNT+1
9077            X(ICNT)=XCOOR1
9078            Y(ICNT)=YCOOR1
9079            D(ICNT)=REAL(ICNT2)
9080            DCOLOR(ICNT)=REAL(ILEVEL)
9081C
9082 1001     CONTINUE
9083       ENDIF
9084C
9085        NPLOTP=ICNT
9086        NPLOTV=2
9087C
9088C       WHEN THERE ARE EXACTLY TWO CROSS-TABULATION VARIABLES, THEN
9089C       SUPPORT A "SORT" OPTION.  FIRST NEED TO OBTAIN ROW AND COLUMN
9090C       VALUES FOR THE STATISTICS.  FROM THESE, CREATE "INDEX" VARIABLES.
9091C
9092      ELSEIF(NCRTV.EQ.2)THEN
9093C
9094C       SORT THE ROWS.  FOR THIS APPLICATION, NEED A RANK.  SINCE THE
9095C       RANK WILL SERVE AS AN ARRAY INDEX, NEED TO CHECK FOR TIES.
9096C
9097        IF(ITPLSO.EQ.'ON' .OR. ITPLSO.EQ.'ROW')THEN
9098          CALL DPTAP0(Y1,Y2,Y3,TAG1,N,
9099     1                NUMV2,ICASCT,ISTANR,
9100     1                XIDTEM,
9101     1                NUMSE1,
9102     1                TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
9103     1                ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
9104     1                DTEMP1,DTEMP2,DTEMP3,
9105     1                ISEED,ALPHA,
9106     1                ICTAMV,PCTAMV,PSTAMV,IQUASE,
9107     1                TEMP9,TEMP7,XACLOW,XACUPP,N2,
9108     1                ISUBRO,IBUGG3,IERROR)
9109          CALL RANKI(TEMP9,NUMSE1,IWRITE,XIDTE3,TEMP7,ITEMP1,MAXOBV,
9110     1              IBUGG3,IERROR)
9111          CALL DISTIN(XIDTE3,NUMSE1,IWRITE,TEMP7,NTEMP,IBUGG3,IERROR)
9112          IF(NTEMP.NE.NUMSE1)THEN
9113            DO1006II=1,NUMSE1
9114              XIDTE3(II)=XIDTEM(II)
9115 1006       CONTINUE
9116          ENDIF
9117          IF(ITPLSR.EQ.'DESC')THEN
9118            DO4006I=1,N
9119              IRANK=INT(XIDTE3(I)+0.1)
9120              IRANK2=NUMSE1 - IRANK + 1
9121              XIDTE3(I)=REAL(IRANK2)
9122 4006       CONTINUE
9123          ENDIF
9124        ELSE
9125          IF(ITPLSR.EQ.'DESC')THEN
9126            DO4007II=1,NUMSE1
9127              IVAL=NUMSE1 - II + 1
9128              XIDTE3(II)=XIDTEM(IVAL)
9129 4007       CONTINUE
9130          ELSE
9131            DO1007II=1,NUMSE1
9132              XIDTE3(II)=XIDTEM(II)
9133 1007       CONTINUE
9134          ENDIF
9135        ENDIF
9136C
9137C       SORT THE COLUMNS
9138C
9139        IF(ITPLSO.EQ.'ON' .OR. ITPLSO.EQ.'COLU')THEN
9140          CALL DPTAP0(Y1,Y2,Y3,TAG2,N,
9141     1                NUMV2,ICASCT,ISTANR,
9142     1                XIDTE2,
9143     1                NUMSE2,
9144     1                TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
9145     1                ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
9146     1                DTEMP1,DTEMP2,DTEMP3,
9147     1                ISEED,ALPHA,
9148     1                ICTAMV,PCTAMV,PSTAMV,IQUASE,
9149     1                TMP10,TEMP7,XACLOW,XACUPP,N2,
9150     1                ISUBRO,IBUGG3,IERROR)
9151          CALL RANKI(TMP10,NUMSE2,IWRITE,XIDTE4,TEMP7,ITEMP1,MAXOBV,
9152     1              IBUGG3,IERROR)
9153          CALL DISTIN(XIDTE4,NUMSE2,IWRITE,TEMP7,NTEMP,IBUGG3,IERROR)
9154          IF(NTEMP.NE.NUMSE2)THEN
9155            DO1008II=1,NUMSE2
9156              XIDTE4(II)=XIDTE2(II)
9157 1008       CONTINUE
9158          ENDIF
9159          IF(ITPLSC.EQ.'DESC')THEN
9160            DO4008I=1,N
9161              IRANK=INT(XIDTE4(I)+0.1)
9162              IRANK2=NUMSE2 - IRANK + 1
9163              XIDTE4(I)=REAL(IRANK2)
9164 4008       CONTINUE
9165          ENDIF
9166        ELSE
9167          IF(ITPLSR.EQ.'DESC')THEN
9168            DO5008II=1,NUMSE2
9169              IVAL=NUMSE2 - II + 1
9170              XIDTE4(II)=XIDTE2(IVAL)
9171 5008       CONTINUE
9172          ELSE
9173             DO1009II=1,NUMSE2
9174              XIDTE4(II)=XIDTE2(II)
9175 1009       CONTINUE
9176          ENDIF
9177        ENDIF
9178C
9179        CALL DPTAP3(Y1,Y2,Y3,TAG1,TAG2,N,
9180     1              NUMV2,ICASCT,ISTANR,
9181     1              XIDTEM,XIDTE2,
9182     1              NUMSE1,NUMSE2,
9183     1              TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
9184     1              TMP10,TMP11,ITPLRM,ITPLCM,
9185     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
9186     1              DTEMP1,DTEMP2,DTEMP3,
9187     1              ISEED,ALPHA,
9188     1              ICTAMV,PCTAMV,PSTAMV,IQUASE,
9189     1              TEMP6,TEMP7,TEMP8,XACLOW,XACUPP,N2,
9190     1              ISUBRO,IBUGG3,IERROR)
9191C
9192CCCCC   NOW GENERATE THE PLOT COORDINATES.  DEFINE A RECTANGLE
9193CCCCC   FOR EACH POINT.
9194C
9195        ICNT=0
9196        ICNT2=0
9197        XINC=0.5 - PTPLXI
9198        YINC=0.5 - PTPLYI
9199C
9200        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9201          WRITE(ICOUT,1011)N2
9202 1011     FORMAT('DPTAP2: AFTER CALL DPTAP3--N2 = ',I8)
9203          CALL DPWRST('XXX','BUG ')
9204          WRITE(ICOUT,1012)XINC,YINC
9205 1012     FORMAT('XINC,YINC = ',2G15.7)
9206          CALL DPWRST('XXX','BUG ')
9207        ENDIF
9208C
9209        IF(IFLAGU.EQ.1)THEN
9210          DO2010I=1,N2
9211            STAT=TEMP6(I)
9212            STATMN=XACLOW(I)
9213            STATMX=XACUPP(I)
9214CCCCC       JUNE 2010: MODIFIED TO ACCOUNT FOR SORTING
9215CCCCC       IF(ITPLDI.EQ.'X')THEN
9216CCCCC         XVAL=TEMP7(I)
9217CCCCC         YVAL=TEMP8(I)
9218CCCCC       ELSE
9219CCCCC         YVAL=TEMP7(I)
9220CCCCC         XVAL=TEMP8(I)
9221CCCCC       ENDIF
9222            IF(ITPLSO.EQ.'OFF' .AND. ITPLCD.EQ.'OFF')THEN
9223              IF(ITPLDI.EQ.'X')THEN
9224                XVAL=TEMP7(I)
9225                YVAL=TEMP8(I)
9226              ELSE
9227                XVAL=TEMP8(I)
9228                YVAL=TEMP7(I)
9229              ENDIF
9230            ELSE
9231              IF(ITPLDI.EQ.'X')THEN
9232                INDEXX=INT(TEMP7(I)+0.1)
9233                INDEXY=INT(TEMP8(I)+0.1)
9234                XVAL=XIDTE3(INDEXX)
9235                YVAL=XIDTE4(INDEXY)
9236              ELSE
9237                INDEXX=INT(TEMP8(I)+0.1)
9238                INDEXY=INT(TEMP7(I)+0.1)
9239                XVAL=XIDTE4(INDEXX)
9240                YVAL=XIDTE3(INDEXY)
9241              ENDIF
9242            ENDIF
9243C
9244            XCOOR1=XVAL - XINC
9245            XCOOR2=XVAL + XINC
9246            YCOOR1=YVAL - YINC
9247            YCOOR2=YVAL + YINC
9248C
9249C           DIVIDE RECTANGLE INTO "ITPLNI" VERTICAL INCREMENTS AND
9250C           COMPUTE LEVEL-COLOR INDEPENDENTLY FOR EACH OF THESE
9251C           MINI-RECTANGLES.
9252C
9253            STATIN=(STATMX - STATMN)/REAL(ITPLNI)
9254            STATZ=STATMN - STATIN
9255            AINC=(YCOOR2 - YCOOR1)/REAL(ITPLNI)
9256            YCZ2=YCOOR1
9257C
9258            DO2019IROW=1,ITPLNI
9259C
9260              YCZ1=YCZ2
9261              YCZ2=YCZ1 + AINC
9262C
9263              STATZ=STATZ + STATIN
9264              IF(STATZ.LT.YLEVEL(1))THEN
9265                ILEVEL=1
9266              ELSEIF(STATZ.GE.YLEVEL(NLEVEL))THEN
9267                ILEVEL=NLEVEL+1
9268              ELSE
9269                DO2015J=2,NLEVEL
9270                  IF(STATZ.GE.YLEVEL(J-1) .AND. STATZ.LT.YLEVEL(J))THEN
9271                    ILEVEL=J
9272                  ENDIF
9273 2015           CONTINUE
9274              ENDIF
9275C
9276              IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9277                WRITE(ICOUT,2016)I,IROW,STAT,STATZ,STATMN,STATMX,STATIN
9278 2016           FORMAT('I,IROW,STAT,STATZ,STATMN,STATMX,STATIN = ',
9279     1                 2I8,5G15.7)
9280                CALL DPWRST('XXX','BUG ')
9281                WRITE(ICOUT,2017)XCOOR1,XCOOR2,YCOOR1,YCOOR2,YCZ1,YCZ2
9282 2017           FORMAT('XCOOR1,XCOOR2,YCOOR1,YCOOR2,YCZ1,YCZ2 = ',
9283     1                 6G15.7)
9284                CALL DPWRST('XXX','BUG ')
9285                WRITE(ICOUT,2018)IROW,ILEVEL
9286 2018           FORMAT('IROW,ILEVEL = ',2I8)
9287                CALL DPWRST('XXX','BUG ')
9288              ENDIF
9289C
9290              ICNT2=ICNT2+1
9291              ICNT=ICNT+1
9292              X(ICNT)=XCOOR1
9293              Y(ICNT)=YCZ1
9294              D(ICNT)=REAL(ICNT2)
9295              DCOLOR(ICNT)=REAL(ILEVEL)
9296C
9297              ICNT=ICNT+1
9298              X(ICNT)=XCOOR2
9299              Y(ICNT)=YCZ1
9300              D(ICNT)=REAL(ICNT2)
9301              DCOLOR(ICNT)=REAL(ILEVEL)
9302C
9303              ICNT=ICNT+1
9304              X(ICNT)=XCOOR2
9305              Y(ICNT)=YCZ2
9306              D(ICNT)=REAL(ICNT2)
9307              DCOLOR(ICNT)=REAL(ILEVEL)
9308C
9309              ICNT=ICNT+1
9310              X(ICNT)=XCOOR1
9311              Y(ICNT)=YCZ2
9312              D(ICNT)=REAL(ICNT2)
9313              DCOLOR(ICNT)=REAL(ILEVEL)
9314C
9315              ICNT=ICNT+1
9316              X(ICNT)=XCOOR1
9317              Y(ICNT)=YCZ1
9318              D(ICNT)=REAL(ICNT2)
9319              DCOLOR(ICNT)=REAL(ILEVEL)
9320C
9321 2019       CONTINUE
9322C
9323 2010     CONTINUE
9324        ELSE
9325          DO1010I=1,N2
9326            STAT=TEMP6(I)
9327CCCCC       JUNE 2010: ACCOUNT FOR SORTING
9328CCCCC       IF(ITPLDI.EQ.'X')THEN
9329CCCCC         XVAL=TEMP7(I)
9330CCCCC         YVAL=TEMP8(I)
9331CCCCC       ELSE
9332CCCCC         YVAL=TEMP7(I)
9333CCCCC         XVAL=TEMP8(I)
9334CCCCC       ENDIF
9335            IF(ITPLSO.EQ.'OFF' .AND. ITPLCD.EQ.'OFF')THEN
9336              IF(ITPLDI.EQ.'X')THEN
9337                XVAL=TEMP7(I)
9338                YVAL=TEMP8(I)
9339              ELSE
9340                XVAL=TEMP8(I)
9341                YVAL=TEMP7(I)
9342              ENDIF
9343            ELSE
9344              IF(ITPLDI.EQ.'X')THEN
9345                INDEXX=INT(TEMP7(I)+0.1)
9346                INDEXY=INT(TEMP8(I)+0.1)
9347                XVAL=XIDTE3(INDEXX)
9348                YVAL=XIDTE4(INDEXY)
9349              ELSE
9350                INDEXX=INT(TEMP8(I)+0.1)
9351                INDEXY=INT(TEMP7(I)+0.1)
9352                XVAL=XIDTE4(INDEXX)
9353                YVAL=XIDTE3(INDEXY)
9354              ENDIF
9355            ENDIF
9356C
9357C
9358            XCOOR1=XVAL - XINC
9359            XCOOR2=XVAL + XINC
9360            YCOOR1=YVAL - YINC
9361            YCOOR2=YVAL + YINC
9362            IF(STAT.LT.YLEVEL(1))THEN
9363              ILEVEL=1
9364            ELSEIF(STAT.GE.YLEVEL(NLEVEL))THEN
9365              ILEVEL=NLEVEL+1
9366            ELSE
9367              DO1015J=2,NLEVEL
9368                IF(STAT.GE.YLEVEL(J-1) .AND. STAT.LT.YLEVEL(J))THEN
9369                  ILEVEL=J
9370                ENDIF
9371 1015         CONTINUE
9372            ENDIF
9373C
9374            IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9375              WRITE(ICOUT,1016)I,STAT,YVAL,XVAL
9376 1016         FORMAT('I,STAT,YVAL,XVAL = ',I8,3G15.7)
9377              CALL DPWRST('XXX','BUG ')
9378              WRITE(ICOUT,1017)XCOOR1,XCOOR2,YCOOR1,YCOOR2
9379 1017         FORMAT('XCOOR1,XCOOR2,YCOOR1,YCOOR2 = ',4G15.7)
9380              CALL DPWRST('XXX','BUG ')
9381              WRITE(ICOUT,1018)ILEVEL
9382 1018         FORMAT('ILEVEL = ',I8)
9383              CALL DPWRST('XXX','BUG ')
9384            ENDIF
9385C
9386            ICNT2=ICNT2+1
9387            ICNT=ICNT+1
9388            X(ICNT)=XCOOR1
9389            Y(ICNT)=YCOOR1
9390            D(ICNT)=REAL(ICNT2)
9391            DCOLOR(ICNT)=REAL(ILEVEL)
9392C
9393            ICNT=ICNT+1
9394            X(ICNT)=XCOOR2
9395            Y(ICNT)=YCOOR1
9396            D(ICNT)=REAL(ICNT2)
9397            DCOLOR(ICNT)=REAL(ILEVEL)
9398C
9399            ICNT=ICNT+1
9400            X(ICNT)=XCOOR2
9401            Y(ICNT)=YCOOR2
9402            D(ICNT)=REAL(ICNT2)
9403            DCOLOR(ICNT)=REAL(ILEVEL)
9404C
9405            ICNT=ICNT+1
9406            X(ICNT)=XCOOR1
9407            Y(ICNT)=YCOOR2
9408            D(ICNT)=REAL(ICNT2)
9409            DCOLOR(ICNT)=REAL(ILEVEL)
9410C
9411            ICNT=ICNT+1
9412            X(ICNT)=XCOOR1
9413            Y(ICNT)=YCOOR1
9414            D(ICNT)=REAL(ICNT2)
9415            DCOLOR(ICNT)=REAL(ILEVEL)
9416C
9417 1010     CONTINUE
9418        ENDIF
9419C
9420        NPLOTP=ICNT
9421        NPLOTV=2
9422C
9423      ELSEIF(NCRTV.EQ.3)THEN
9424        CALL DPTAP4(Y1,Y2,Y3,TAG1,TAG2,TAG3,N,
9425     1              NUMV2,ICASCT,ISTANR,
9426     1              XIDTEM,XIDTE2,XIDTE3,
9427     1              NUMSE1,NUMSE2,NUMSE3,
9428     1              TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
9429     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
9430     1              DTEMP1,DTEMP2,DTEMP3,
9431     1              ISEED,ALPHA,
9432     1              ICTAMV,PCTAMV,PSTAMV,IQUASE,
9433     1              TEMP6,TEMP7,TEMP8,TEMP9,XACLOW,XACUPP,N2,
9434     1              ISUBRO,IBUGG3,IERROR)
9435C
9436CCCCC   NOW GENERATE THE PLOT COORDINATES.  DEFINE A RECTANGLE
9437CCCCC   FOR EACH POINT.
9438C
9439        ICNT=0
9440        ICNT2=0
9441        XINC=0.5 - PTPLXI
9442        YINC=0.5 - PTPLYI
9443        YINC2=2.0*YINC/REAL(NUMSE3)
9444C
9445        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9446          WRITE(ICOUT,1021)N2
9447 1021     FORMAT('DPTAP2: AFTER CALL DPTAP2--N2 = ',I8)
9448          CALL DPWRST('XXX','BUG ')
9449          WRITE(ICOUT,1022)XINC,YINC,YINC2
9450 1022     FORMAT('XINC,YINC,YINC2 = ',3G15.7)
9451          CALL DPWRST('XXX','BUG ')
9452        ENDIF
9453C
9454        IF(IFLAGU.EQ.1)THEN
9455          DO2020I=1,N2
9456            STAT=TEMP6(I)
9457            STATMN=XACLOW(I)
9458            STATMX=XACUPP(I)
9459            IF(ITPLDI.EQ.'X')THEN
9460CCCCC         XVAL=TEMP7(I)
9461CCCCC         YVAL=TEMP8(I)
9462CCCCC         XVAL2=TEMP9(I)
9463              XVAL=TEMP8(I)
9464              YVAL=ANUMS1*(TEMP9(I)  - 1.0) + TEMP7(I)
9465              XCOOR1=XVAL - XINC
9466              XCOOR2=XVAL + XINC
9467              YCOOR1=YVAL - YINC
9468              YCOOR2=YVAL + YINC
9469            ELSE
9470CCCCC         YVAL=TEMP7(I)
9471CCCCC         XVAL=TEMP8(I)
9472CCCCC         YVAL2=TEMP9(I)
9473              XCOOR1=XVAL - XINC
9474              XCOOR2=XVAL + XINC
9475              YCOOR1=YVAL - YINC
9476              YCOOR2=YVAL + YINC
9477            ENDIF
9478C
9479C           DIVIDE RECTANGLE INTO "ITPLNI" VERTICAL INCREMENTS AND
9480C           COMPUTE LEVEL-COLOR INDEPENDENTLY FOR EACH OF THESE
9481C           MINI-RECTANGLES.
9482C
9483            STATIN=(STATMX - STATMN)/REAL(ITPLNI)
9484            STATZ=STATMN - STATIN
9485            AINC=(YCOOR2 - YCOOR1)/REAL(ITPLNI)
9486            YCZ2=YCOOR1
9487C
9488            DO2029IROW=1,ITPLNI
9489C
9490              YCZ1=YCZ2
9491              YCZ2=YCZ1 + AINC
9492C
9493              STATZ=STATZ + STATIN
9494              IF(STATZ.LT.YLEVEL(1))THEN
9495                ILEVEL=1
9496              ELSEIF(STATZ.GE.YLEVEL(NLEVEL))THEN
9497                ILEVEL=NLEVEL+1
9498              ELSE
9499                DO2025J=2,NLEVEL
9500                  IF(STATZ.GE.YLEVEL(J-1) .AND. STATZ.LT.YLEVEL(J))THEN
9501                    ILEVEL=J
9502                  ENDIF
9503 2025           CONTINUE
9504              ENDIF
9505C
9506              IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9507                WRITE(ICOUT,2026)I,IROW,STAT,STATZ,STATMN,STATMX,STATIN
9508 2026           FORMAT('I,IROW,STAT,STATZ,STATMN,STATMX,STATIN = ',
9509     1                 2I8,5G15.7)
9510                CALL DPWRST('XXX','BUG ')
9511                WRITE(ICOUT,2027)XCOOR1,XCOOR2,YCOOR1,YCOOR2,YCZ1,YCZ2
9512 2027           FORMAT('XCOOR1,XCOOR2,YCOOR1,YCOOR2,YCZ1,YCZ2 = ',
9513     1                 6G15.7)
9514                CALL DPWRST('XXX','BUG ')
9515                WRITE(ICOUT,2028)IROW,ILEVEL
9516 2028           FORMAT('IROW,ILEVEL = ',2I8)
9517                CALL DPWRST('XXX','BUG ')
9518              ENDIF
9519C
9520              ICNT2=ICNT2+1
9521              ICNT=ICNT+1
9522              X(ICNT)=XCOOR1
9523              Y(ICNT)=YCZ1
9524              D(ICNT)=REAL(ICNT2)
9525              DCOLOR(ICNT)=REAL(ILEVEL)
9526C
9527              ICNT=ICNT+1
9528              X(ICNT)=XCOOR2
9529              Y(ICNT)=YCZ1
9530              D(ICNT)=REAL(ICNT2)
9531              DCOLOR(ICNT)=REAL(ILEVEL)
9532C
9533              ICNT=ICNT+1
9534              X(ICNT)=XCOOR2
9535              Y(ICNT)=YCZ2
9536              D(ICNT)=REAL(ICNT2)
9537              DCOLOR(ICNT)=REAL(ILEVEL)
9538C
9539              ICNT=ICNT+1
9540              X(ICNT)=XCOOR1
9541              Y(ICNT)=YCZ2
9542              D(ICNT)=REAL(ICNT2)
9543              DCOLOR(ICNT)=REAL(ILEVEL)
9544C
9545              ICNT=ICNT+1
9546              X(ICNT)=XCOOR1
9547              Y(ICNT)=YCZ1
9548              D(ICNT)=REAL(ICNT2)
9549              DCOLOR(ICNT)=REAL(ILEVEL)
9550C
9551 2029       CONTINUE
9552C
9553 2020     CONTINUE
9554        ELSE
9555          DO1020I=1,N2
9556            STAT=TEMP6(I)
9557            IF(ITPLDI.EQ.'X')THEN
9558CCCCC         XVAL=TEMP7(I)
9559CCCCC         YVAL=TEMP8(I)
9560CCCCC         XVAL2=TEMP9(I)
9561              XVAL=TEMP8(I)
9562              YVAL=ANUMS1*(TEMP9(I)  - 1.0) + TEMP7(I)
9563              XCOOR1=XVAL - XINC
9564              XCOOR2=XVAL + XINC
9565              YCOOR1=YVAL - YINC
9566              YCOOR2=YVAL + YINC
9567            ELSE
9568CCCCC         YVAL=TEMP7(I)
9569CCCCC         XVAL=TEMP8(I)
9570CCCCC         YVAL2=TEMP9(I)
9571              XVAL=ANUMS1*(TEMP9(I)  - 1.0) + TEMP7(I)
9572              YVAL=TEMP8(I)
9573              XCOOR1=XVAL - XINC
9574              XCOOR2=XVAL + XINC
9575              YCOOR1=YVAL - YINC
9576              YCOOR2=YVAL + YINC
9577            ENDIF
9578            IF(STAT.LT.YLEVEL(1))THEN
9579              ILEVEL=1
9580            ELSEIF(STAT.GE.YLEVEL(NLEVEL))THEN
9581              ILEVEL=NLEVEL+1
9582            ELSE
9583              DO1025J=2,NLEVEL
9584                IF(STAT.GE.YLEVEL(J-1) .AND. STAT.LT.YLEVEL(J))THEN
9585                  ILEVEL=J
9586                ENDIF
9587 1025       CONTINUE
9588            ENDIF
9589C
9590            IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9591              WRITE(ICOUT,1026)I,STAT,YVAL,XVAL,YVAL2
9592 1026       FORMAT('I,STAT,YVAL,XVAL,YVAL2 = ',I8,4G15.7)
9593              CALL DPWRST('XXX','BUG ')
9594              WRITE(ICOUT,1027)XCOOR1,XCOOR2,YCOOR1,YCOOR2
9595 1027       FORMAT('XCOOR1,XCOOR2,YCOOR1,YCOOR2 = ',4G15.7)
9596              CALL DPWRST('XXX','BUG ')
9597              WRITE(ICOUT,1028)ILEVEL
9598 1028       FORMAT('ILEVEL = ',I8)
9599              CALL DPWRST('XXX','BUG ')
9600            ENDIF
9601C
9602            ICNT2=ICNT2+1
9603            ICNT=ICNT+1
9604            X(ICNT)=XCOOR1
9605            Y(ICNT)=YCOOR1
9606            D(ICNT)=REAL(ICNT2)
9607            DCOLOR(ICNT)=REAL(ILEVEL)
9608C
9609            ICNT=ICNT+1
9610            X(ICNT)=XCOOR2
9611            Y(ICNT)=YCOOR1
9612            D(ICNT)=REAL(ICNT2)
9613            DCOLOR(ICNT)=REAL(ILEVEL)
9614C
9615            ICNT=ICNT+1
9616            X(ICNT)=XCOOR2
9617            Y(ICNT)=YCOOR2
9618            D(ICNT)=REAL(ICNT2)
9619            DCOLOR(ICNT)=REAL(ILEVEL)
9620C
9621            ICNT=ICNT+1
9622            X(ICNT)=XCOOR1
9623            Y(ICNT)=YCOOR2
9624            D(ICNT)=REAL(ICNT2)
9625            DCOLOR(ICNT)=REAL(ILEVEL)
9626C
9627            ICNT=ICNT+1
9628            X(ICNT)=XCOOR1
9629            Y(ICNT)=YCOOR1
9630            D(ICNT)=REAL(ICNT2)
9631            DCOLOR(ICNT)=REAL(ILEVEL)
9632C
9633 1020     CONTINUE
9634        ENDIF
9635C
9636        NPLOTP=ICNT
9637        NPLOTV=2
9638C
9639      ELSEIF(NCRTV.EQ.4)THEN
9640        CALL DPTAP5(Y1,Y2,Y3,TAG1,TAG2,TAG3,TAG4,N,
9641     1              NUMV2,ICASCT,ISTANR,
9642     1              XIDTEM,XIDTE2,XIDTE3,XIDTE4,
9643     1              NUMSE1,NUMSE2,NUMSE3,NUMSE4,
9644     1              TEMP1,TEMP2,TMP11,TEMP3,TEMP4,TEMP5,
9645     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
9646     1              DTEMP1,DTEMP2,DTEMP3,
9647     1              ISEED,ALPHA,
9648     1              ICTAMV,PCTAMV,PSTAMV,IQUASE,
9649     1              TEMP6,TEMP7,TEMP8,TEMP9,TMP10,XACLOW,XACUPP,N2,
9650     1              ISUBRO,IBUGG3,IERROR)
9651C
9652CCCCC   NOW GENERATE THE PLOT COORDINATES.  DEFINE A RECTANGLE
9653CCCCC   FOR EACH POINT.
9654C
9655        ICNT=0
9656        ICNT2=0
9657        XINC=0.5 - PTPLXI
9658        YINC=0.5 - PTPLYI
9659        YINC2=2.0*YINC/REAL(NUMSE3)
9660        XINC2=2.0*XINC/REAL(NUMSE4)
9661C
9662        IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9663          WRITE(ICOUT,1031)N2
9664 1031     FORMAT('DPTAP2: AFTER CALL DPTAP5--N2 = ',I8)
9665          CALL DPWRST('XXX','BUG ')
9666          WRITE(ICOUT,1032)XINC,YINC,XINC2,YINC2
9667 1032     FORMAT('XINC,YINC,XINC2,YINC2 = ',4G15.7)
9668          CALL DPWRST('XXX','BUG ')
9669        ENDIF
9670C
9671        IF(IFLAGU.EQ.1)THEN
9672          DO2030I=1,N2
9673            STAT=TEMP6(I)
9674            STATMN=XACLOW(I)
9675            STATMX=XACUPP(I)
9676            IF(ITPLDI.EQ.'X')THEN
9677CCCCC         XVAL=TEMP7(I)
9678CCCCC         YVAL=TEMP8(I)
9679CCCCC         XVAL2=TEMP9(I)
9680CCCCC         YVAL2=TMP10(I)
9681              XVAL=ANUMS2*(TMP10(I) - 1.0) + TEMP8(I)
9682              YVAL=ANUMS1*(TEMP9(I)  - 1.0) + TEMP7(I)
9683            ELSE
9684CCCCC         YVAL=TEMP7(I)
9685CCCCC         XVAL=TEMP8(I)
9686CCCCC         YVAL2=TEMP9(I)
9687CCCCC         XVAL2=TMP10(I)
9688              XVAL=ANUMS1*(TEMP9(I)  - 1.0) + TEMP7(I)
9689              YVAL=ANUMS2*(TMP10(I) - 1.0) + TEMP8(I)
9690            ENDIF
9691            XCOOR1=XVAL - XINC
9692            XCOOR2=XVAL + XINC
9693            YCOOR1=YVAL - YINC
9694            YCOOR2=YVAL + YINC
9695C
9696C           DIVIDE RECTANGLE INTO "ITPLNI" VERTICAL INCREMENTS AND
9697C           COMPUTE LEVEL-COLOR INDEPENDENTLY FOR EACH OF THESE
9698C           MINI-RECTANGLES.
9699C
9700            STATIN=(STATMX - STATMN)/REAL(ITPLNI)
9701            STATZ=STATMN - STATIN
9702            AINC=(YCOOR2 - YCOOR1)/REAL(ITPLNI)
9703            YCZ2=YCOOR1
9704C
9705            DO2039IROW=1,ITPLNI
9706C
9707              YCZ1=YCZ2
9708              YCZ2=YCZ1 + AINC
9709C
9710              STATZ=STATZ + STATIN
9711              IF(STATZ.LT.YLEVEL(1))THEN
9712                ILEVEL=1
9713              ELSEIF(STATZ.GE.YLEVEL(NLEVEL))THEN
9714                ILEVEL=NLEVEL+1
9715              ELSE
9716                DO2035J=2,NLEVEL
9717                  IF(STATZ.GE.YLEVEL(J-1) .AND. STATZ.LT.YLEVEL(J))THEN
9718                    ILEVEL=J
9719                  ENDIF
9720 2035           CONTINUE
9721              ENDIF
9722C
9723              IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9724                WRITE(ICOUT,2036)I,IROW,STAT,STATZ,STATMN,STATMX,STATIN
9725 2036           FORMAT('I,IROW,STAT,STATZ,STATMN,STATMX,STATIN = ',
9726     1                 2I8,5G15.7)
9727                CALL DPWRST('XXX','BUG ')
9728                WRITE(ICOUT,2037)XCOOR1,XCOOR2,YCOOR1,YCOOR2,YCZ1,YCZ2
9729 2037           FORMAT('XCOOR1,XCOOR2,YCOOR1,YCOOR2,YCZ1,YCZ2 = ',
9730     1                 6G15.7)
9731                CALL DPWRST('XXX','BUG ')
9732                WRITE(ICOUT,2038)IROW,ILEVEL
9733 2038           FORMAT('IROW,ILEVEL = ',2I8)
9734                CALL DPWRST('XXX','BUG ')
9735              ENDIF
9736C
9737              ICNT2=ICNT2+1
9738              ICNT=ICNT+1
9739              X(ICNT)=XCOOR1
9740              Y(ICNT)=YCZ1
9741              D(ICNT)=REAL(ICNT2)
9742              DCOLOR(ICNT)=REAL(ILEVEL)
9743C
9744              ICNT=ICNT+1
9745              X(ICNT)=XCOOR2
9746              Y(ICNT)=YCZ1
9747              D(ICNT)=REAL(ICNT2)
9748              DCOLOR(ICNT)=REAL(ILEVEL)
9749C
9750              ICNT=ICNT+1
9751              X(ICNT)=XCOOR2
9752              Y(ICNT)=YCZ2
9753              D(ICNT)=REAL(ICNT2)
9754              DCOLOR(ICNT)=REAL(ILEVEL)
9755C
9756              ICNT=ICNT+1
9757              X(ICNT)=XCOOR1
9758              Y(ICNT)=YCZ2
9759              D(ICNT)=REAL(ICNT2)
9760              DCOLOR(ICNT)=REAL(ILEVEL)
9761C
9762              ICNT=ICNT+1
9763              X(ICNT)=XCOOR1
9764              Y(ICNT)=YCZ1
9765              D(ICNT)=REAL(ICNT2)
9766              DCOLOR(ICNT)=REAL(ILEVEL)
9767C
9768 2039       CONTINUE
9769C
9770 2030     CONTINUE
9771        ELSE
9772          DO1030I=1,N2
9773            STAT=TEMP6(I)
9774            IF(ITPLDI.EQ.'X')THEN
9775CCCCC         XVAL=TEMP7(I)
9776CCCCC         YVAL=TEMP8(I)
9777CCCCC         XVAL2=TEMP9(I)
9778CCCCC         YVAL2=TMP10(I)
9779              XVAL=ANUMS2*(TMP10(I) - 1.0) + TEMP8(I)
9780              YVAL=ANUMS1*(TEMP9(I)  - 1.0) + TEMP7(I)
9781            ELSE
9782CCCCC         YVAL=TEMP7(I)
9783CCCCC         XVAL=TEMP8(I)
9784CCCCC         YVAL2=TEMP9(I)
9785CCCCC         XVAL2=TMP10(I)
9786              XVAL=ANUMS1*(TEMP9(I)  - 1.0) + TEMP7(I)
9787              YVAL=ANUMS2*(TMP10(I) - 1.0) + TEMP8(I)
9788            ENDIF
9789CCCCC       XCOOR1=XVAL - XINC) + (XVAL2 - 1.0)*XINC2
9790            XCOOR1=XVAL - XINC
9791            XCOOR2=XVAL + XINC
9792CCCCCC      YCOOR1=(YVAL - YINC) + (YVAL2 - 1.0)*YINC2
9793            YCOOR1=YVAL - YINC
9794            YCOOR2=YVAL + YINC
9795            IF(STAT.LT.YLEVEL(1))THEN
9796              ILEVEL=1
9797            ELSEIF(STAT.GE.YLEVEL(NLEVEL))THEN
9798              ILEVEL=NLEVEL+1
9799            ELSE
9800              DO1035J=2,NLEVEL
9801                IF(STAT.GE.YLEVEL(J-1) .AND. STAT.LT.YLEVEL(J))THEN
9802                  ILEVEL=J
9803                ENDIF
9804 1035       CONTINUE
9805            ENDIF
9806C
9807            IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP2')THEN
9808              WRITE(ICOUT,1036)I,STAT,YVAL,XVAL,YVAL2,XVAL2
9809 1036       FORMAT('I,STAT,YVAL,XVAL,YVAL2,XVAL2 = ',I8,5G15.7)
9810              CALL DPWRST('XXX','BUG ')
9811              WRITE(ICOUT,1037)XCOOR1,XCOOR2,YCOOR1,YCOOR2
9812 1037       FORMAT('XCOOR1,XCOOR2,YCOOR1,YCOOR2 = ',4G15.7)
9813              CALL DPWRST('XXX','BUG ')
9814              WRITE(ICOUT,1038)ILEVEL
9815 1038       FORMAT('ILEVEL = ',I8)
9816              CALL DPWRST('XXX','BUG ')
9817            ENDIF
9818C
9819            ICNT2=ICNT2+1
9820            ICNT=ICNT+1
9821            X(ICNT)=XCOOR1
9822            Y(ICNT)=YCOOR1
9823            D(ICNT)=REAL(ICNT2)
9824            DCOLOR(ICNT)=REAL(ILEVEL)
9825C
9826            ICNT=ICNT+1
9827            X(ICNT)=XCOOR2
9828            Y(ICNT)=YCOOR1
9829            D(ICNT)=REAL(ICNT2)
9830            DCOLOR(ICNT)=REAL(ILEVEL)
9831C
9832            ICNT=ICNT+1
9833            X(ICNT)=XCOOR2
9834            Y(ICNT)=YCOOR2
9835            D(ICNT)=REAL(ICNT2)
9836            DCOLOR(ICNT)=REAL(ILEVEL)
9837C
9838            ICNT=ICNT+1
9839            X(ICNT)=XCOOR1
9840            Y(ICNT)=YCOOR2
9841            D(ICNT)=REAL(ICNT2)
9842            DCOLOR(ICNT)=REAL(ILEVEL)
9843C
9844            ICNT=ICNT+1
9845            X(ICNT)=XCOOR1
9846            Y(ICNT)=YCOOR1
9847            D(ICNT)=REAL(ICNT2)
9848            DCOLOR(ICNT)=REAL(ILEVEL)
9849C
9850 1030     CONTINUE
9851        ENDIF
9852C
9853        NPLOTP=ICNT
9854        NPLOTV=2
9855C
9856      ENDIF
9857C               *****************
9858C               **  STEP 90--  **
9859C               **  EXIT       **
9860C               *****************
9861C
9862 9000 CONTINUE
9863      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAP2')THEN
9864        WRITE(ICOUT,999)
9865        CALL DPWRST('XXX','BUG ')
9866        WRITE(ICOUT,9011)
9867 9011   FORMAT('***** AT THE END       OF DPTAP2--')
9868        CALL DPWRST('XXX','BUG ')
9869        WRITE(ICOUT,9012)ICASCT,N,NPLOTP,NPLOTV,IERROR
9870 9012   FORMAT('ICASCT,N,NPLOTP,NPLOTV,IERROR = ',A4,3I8,2X,A4)
9871        CALL DPWRST('XXX','BUG ')
9872        DO9035I=1,NPLOTP
9873          WRITE(ICOUT,9036)I,Y(I),X(I),D(I),DCOLOR(I)
9874 9036     FORMAT('I,Y(I),X(I),D(I),DCOLOR(I) = ',I8,4G15.7)
9875          CALL DPWRST('XXX','BUG ')
9876 9035   CONTINUE
9877      ENDIF
9878C
9879      RETURN
9880      END
9881      SUBROUTINE DPTAP3(Y,Z,Z2,TAG1,TAG2,N,
9882     1                  NUMV2,ICASCT,ISTANR,
9883     1                  XIDTEM,XIDTE2,
9884     1                  NUMSE1,NUMSE2,
9885     1                  TEMP,TEMPZ,TEMPZ2,XTEMP1,XTEMP2,XTEMP3,
9886     1                  YCMNMX,YRMNMX,ITPLCM,ITPLRM,
9887     1                  ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
9888     1                  DTEMP1,DTEMP2,DTEMP3,
9889     1                  ISEED,ALPHA,
9890     1                  ICTAMV,PCTAMV,PSTAMV,IQUASE,
9891     1                  Y2,X2,D2,XACLOW,XACUPP,N2,
9892     1                  ISUBRO,IBUGG3,IERROR)
9893C
9894C     PURPOSE--GENERATE A TWO-WAY TABULATION PLOT.
9895C     WRITTEN BY--ALAN HECKERT
9896C                 STATISTICAL ENGINEERING DIVISION
9897C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9898C                 GAITHERSBURG, MD 20899-8980
9899C                 PHONE--301-975-2899
9900C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9901C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9902C     LANGUAGE--ANSI FORTRAN (1977)
9903C     VERSION NUMBER--2009/9
9904C     ORIGINAL VERSION--SEPTEMBER 2009.
9905C     UPDATED         --DECEMBER  2009. UNCERTAINTY OPTION FOR
9906C                                       BINOMIAL PROBABILITY, MEAN AND
9907C                                       MEDIAN CONFIDENCE INTERVAL
9908C     UPDATED         --JANUARY   2010. SUPPORT FOR UNCERTAINTY INTERVALS
9909C                                       FOR BINOMIAL RATIO
9910C     UPDATED         --AUGUST    2010. FOR EACH VALUE, DETERMINE IF
9911C                                       IT A ROW COLUMN MINIMUM OR
9912C                                       MAXIMUM VALUE FOR THE STATISTIC
9913C
9914C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
9915C
9916      CHARACTER*4 ICASCT
9917      CHARACTER*4 ICTAMV
9918      CHARACTER*4 IQUASE
9919      CHARACTER*4 ITPLCM
9920      CHARACTER*4 ITPLRM
9921      CHARACTER*4 IBUGG3
9922      CHARACTER*4 ISUBRO
9923      CHARACTER*4 IERROR
9924C
9925      CHARACTER*4 IWRITE
9926      CHARACTER*4 ISUBN1
9927      CHARACTER*4 ISUBN2
9928      CHARACTER*4 ISTEPN
9929C
9930C---------------------------------------------------------------------
9931C
9932      DIMENSION Y(*)
9933      DIMENSION Z(*)
9934      DIMENSION Z2(*)
9935      DIMENSION XIDTEM(*)
9936      DIMENSION XIDTE2(*)
9937      DIMENSION Y2(*)
9938      DIMENSION X2(*)
9939      DIMENSION D2(*)
9940      DIMENSION XACLOW(*)
9941      DIMENSION XACUPP(*)
9942C
9943      DIMENSION TAG1(*)
9944      DIMENSION TAG2(*)
9945      DIMENSION TEMP(*)
9946      DIMENSION TEMPZ(*)
9947      DIMENSION TEMPZ2(*)
9948      DIMENSION XTEMP1(*)
9949      DIMENSION XTEMP2(*)
9950      DIMENSION XTEMP3(*)
9951      DIMENSION YCMNMX(*)
9952      DIMENSION YRMNMX(*)
9953C
9954      INTEGER ITEMP1(*)
9955      INTEGER ITEMP2(*)
9956      INTEGER ITEMP3(*)
9957      INTEGER ITEMP4(*)
9958      INTEGER ITEMP5(*)
9959      INTEGER ITEMP6(*)
9960C
9961      DOUBLE PRECISION DTEMP1(*)
9962      DOUBLE PRECISION DTEMP2(*)
9963      DOUBLE PRECISION DTEMP3(*)
9964C
9965C-----COMMON----------------------------------------------------------
9966C
9967      INCLUDE 'DPCOP2.INC'
9968C
9969C-----START POINT-----------------------------------------------------
9970C
9971      ISUBN1='DPTA'
9972      ISUBN2='P3  '
9973C
9974      I2=0
9975C
9976      AN=INT(N+0.01)
9977C
9978C               ***********************************************
9979C               **  STEP 5--                                 **
9980C               **  COMPUTE THE VARIOUS CROSS-TAB STATISTICS **
9981C               ***********************************************
9982C
9983      ISTEPN='5.1'
9984      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAP3')
9985     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9986C
9987      IWRITE='OFF'
9988C
9989C     FOR EACH ROW/COLUMN COMBINATION, DETERMINE IF IT IS A
9990C     ROW OR COLUMN MINIMUM OR MAXIMUM.
9991      J=0
9992      NRESP=NUMV2-2
9993      DO1110ISET1=1,NUMSE1
9994        DO1120ISET2=1,NUMSE2
9995C
9996          K=0
9997          DO1130I=1,N
9998            IF(XIDTEM(ISET1).EQ.TAG1(I).AND.XIDTE2(ISET2).EQ.TAG2(I))
9999     1        GOTO1131
10000            GOTO1130
10001 1131       CONTINUE
10002C
10003            K=K+1
10004            TEMP(K)=0.0
10005            TEMPZ(K)=0.0
10006            TEMPZ2(K)=0.0
10007            IF(ISTANR.GE.1)TEMP(K)=Y(I)
10008            IF(ISTANR.GE.2)TEMPZ(K)=Z(I)
10009            IF(ISTANR.GE.3)TEMPZ2(K)=Z2(I)
10010 1130     CONTINUE
10011          NTEMP=K
10012C
10013          NTRIAL=0
10014          ALOWLM=0.0
10015          AUPPLM=0.0
10016          IF(NTEMP.EQ.0)THEN
10017            IF(ICTAMV.EQ.'ZERO')THEN
10018              STAT=0.0
10019              IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10020     1           ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10021                NTRIAL=0
10022                ALOWLM=0.0
10023                AUPPLM=0.0
10024              ENDIF
10025            ELSEIF(ICTAMV.EQ.'MV  ')THEN
10026              STAT=PCTAMV
10027              IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10028     1           ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10029                NTRIAL=0
10030                ALOWLM=PCTAMV
10031                AUPPLM=PCTAMV
10032              ENDIF
10033            ELSE
10034              GOTO1120
10035            ENDIF
10036          ELSE
10037            CALL CMPSTA(
10038     1              TEMP,TEMPZ,TEMPZ2,XTEMP1,XTEMP2,XTEMP3,
10039     1              MAXNXT,NTEMP,NTEMP,NTEMP,
10040     1              NRESP,ICASCT,
10041     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
10042     1              DTEMP1,DTEMP2,DTEMP3,
10043CCCCC1              IQUAME,IQUASE,PSTAMV,
10044     1              STAT,
10045     1              ISUBRO,IBUGG3,IERROR)
10046            IF(IERROR.EQ.'YES')GOTO9000
10047            IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'BRAT')THEN
10048              PTEMP=STAT
10049              NTRIAL=NTEMP
10050              IF(ICASCT.EQ.'BRAT')NTRIAL=ITEMP1(1)
10051              IF(STAT.EQ.PSTAMV)THEN
10052                ALOWLM=PSTAMV
10053                AUPPLM=PSTAMV
10054              ELSE
10055                ALPHAT=ALPHA
10056                IF(ALPHAT.LE.0.5)ALPHAT=1.0 - ALPHA
10057                CALL DPAGCO(PTEMP,NTRAIL,ALPHAT,IWRITE,
10058     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10059              ENDIF
10060            ELSEIF(ICASCT.EQ.'MECL')THEN
10061              XMEAN=STAT
10062              NTRIAL=NTEMP
10063              IF(STAT.EQ.PSTAMV)THEN
10064                ALOWLM=PSTAMV
10065                AUPPLM=PSTAMV
10066              ELSE
10067                CALL SD(TEMP,NTEMP,IWRITE,XSD,IBUGG3,IERROR)
10068                ALPHAT=ALPHA
10069                CALL DPMECL(XMEAN,XSD,NTEMP,ALPHAT,IWRITE,
10070     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10071              ENDIF
10072            ELSEIF(ICASCT.EQ.'MDCL')THEN
10073              XMED=STAT
10074              NTRIAL=NTEMP
10075              IF(STAT.EQ.PSTAMV)THEN
10076                ALOWLM=PSTAMV
10077                AUPPLM=PSTAMV
10078              ELSE
10079                XQ=0.5
10080                CALL QUANSE(XQ,TEMP,NTEMP,IWRITE,XTEMP1,MAXNXT,IQUASE,
10081     1                      QUASE,IBUGG3,IERROR)
10082                ALPHAT=ALPHA
10083                CALL DPMECL(XMED,QUASE,NTEMP,ALPHAT,IWRITE,
10084     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10085              ENDIF
10086            ENDIF
10087          ENDIF
10088C
10089          J=J+1
10090          Y2(J)=STAT
10091          X2(J)=XIDTEM(ISET1)
10092          D2(J)=XIDTE2(ISET2)
10093          AMNMAX=0.0
10094          IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10095     1       ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10096            IF(AUPPLM.GT.STATMX)STATMX=AUPPLM
10097            IF(ALOWLM.LT.STATMN)STATMN=ALOWLM
10098            XACLOW(J)=ALOWLM
10099            XACUPP(J)=AUPPLM
10100          ENDIF
10101C
10102 1120   CONTINUE
10103 1110 CONTINUE
10104      N2=J
10105C
10106C     DETERMINE THE COLUMN MINIMUM AND MAXIMUM POINTS
10107C
10108      IF(ITPLCM.EQ.'OFF' .AND. ITPLRM.EQ.'OFF')GOTO9000
10109C
10110      DO3101I=1,N
10111        YCMNMX(I)=0.0
10112        YRMNMX(I)=0.0
10113 3101 CONTINUE
10114C
10115      DO3110ISET2=1,NUMSE2
10116        ACOLMN=CPUMIN
10117        ACOLMX=CPUMIN
10118C
10119C       DETERMINE COLUMN MIN/MAX
10120C
10121        DO3120I=1,N
10122          IF(XIDTE2(ISET2).EQ.D2(I))THEN
10123            IF(Y2(I).NE.PSTAMV .AND. Y2(I).NE.CPUMIN)THEN
10124              IF(ACOLMN.EQ.CPUMIN)THEN
10125                ACOLMN=Y2(I)
10126                ACOLMX=Y2(I)
10127              ELSE
10128                IF(Y2(I).LE.ACOLMN)ACOLMN=Y2(I)
10129                IF(Y2(I).GE.ACOLMX)ACOLMX=Y2(I)
10130              ENDIF
10131            ENDIF
10132          ENDIF
10133 3120   CONTINUE
10134C
10135C       NOW SET YCMNMX TO:
10136C
10137C           0 = NEITHER MIN NOR MAX
10138C           1 = EQUAL TO COLUMN MINIMUM
10139C           2 = EQUAL TO COLUMN MAXIMUM
10140C
10141        DO3130I=1,N
10142          IF(XIDTE2(ISET2).EQ.D2(I))THEN
10143            YCMNMX(I)=0.0
10144            IF(Y2(I).EQ.ACOLMN)YCMNMX(I)=1.0
10145            IF(Y2(I).EQ.ACOLMX)YCMNMX(I)=2.0
10146          ENDIF
10147 3130   CONTINUE
10148C
10149 3110 CONTINUE
10150C
10151C     DETERMINE THE ROW MINIMUM AND MAXIMUM POINTS
10152C
10153      DO4110ISET1=1,NUMSE1
10154        AROWMN=CPUMIN
10155        AROWMX=CPUMIN
10156C
10157C       DETERMINE ROW MIN/MAX
10158C
10159        DO4120I=1,N
10160          IF(XIDTEM(ISET1).EQ.X2(I))THEN
10161            IF(Y2(I).NE.PSTAMV .AND. Y2(I).NE.CPUMIN)THEN
10162              IF(AROWMN.EQ.CPUMIN)THEN
10163                AROWMN=Y2(I)
10164                AROWMX=Y2(I)
10165              ELSE
10166                IF(Y2(I).LE.AROWMN)AROWMN=Y2(I)
10167                IF(Y2(I).GE.AROWMX)AROWMX=Y2(I)
10168              ENDIF
10169            ENDIF
10170          ENDIF
10171 4120   CONTINUE
10172C
10173C       NOW SET YRMNMX TO:
10174C
10175C           0 = NEITHER MIN NOR MAX
10176C           1 = EQUAL TO ROW MINIMUM
10177C           2 = EQUAL TO ROW MAXIMUM
10178C
10179        DO4130I=1,N
10180          IF(XIDTEM(ISET1).EQ.X2(I))THEN
10181            YRMNMX(I)=0.0
10182            IF(Y2(I).EQ.AROWMN)YRMNMX(I)=1.0
10183            IF(Y2(I).EQ.AROWMX)YRMNMX(I)=2.0
10184          ENDIF
10185 4130   CONTINUE
10186C
10187 4110 CONTINUE
10188C               ******************
10189C               **   STEP 90--  **
10190C               **   EXIT       **
10191C               ******************
10192C
10193 9000 CONTINUE
10194      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP3')THEN
10195        WRITE(ICOUT,999)
10196  999   FORMAT(1X)
10197        CALL DPWRST('XXX','BUG ')
10198        WRITE(ICOUT,9011)
10199 9011   FORMAT('***** AT THE END       OF DPTAP3--')
10200        CALL DPWRST('XXX','BUG ')
10201        WRITE(ICOUT,9012)ICASCT,N,NUMV2,IERROR
10202 9012   FORMAT('ICASCT,N,NUMV2,IERROR = ',A4,2I8,2X,A4)
10203        CALL DPWRST('XXX','BUG ')
10204        WRITE(ICOUT,9015)NUMSE1,NUMSE2,N2
10205 9015   FORMAT('NUMSE1,NUMSE2,N2 = ',3I8)
10206        CALL DPWRST('XXX','BUG ')
10207        DO9020I=1,N2
10208          WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I),YCMNMX(I),YRMNMX(I)
10209 9021     FORMAT('I,Y2(I),X2(I),D2(I),YCMNMX(I),YRMNMX(I) = ',
10210     1           I8,5G15.7)
10211          CALL DPWRST('XXX','BUG ')
10212 9020   CONTINUE
10213      ENDIF
10214C
10215      RETURN
10216      END
10217      SUBROUTINE DPTAP4(Y,Z,Z2,TAG1,TAG2,TAG3,N,
10218     1                  NUMV2,ICASCT,ISTANR,
10219     1                  XIDTEM,XIDTE2,XIDTE3,
10220     1                  NUMSE1,NUMSE2,NUMSE3,
10221     1                  TEMP,TEMPZ,TEMPZ2,XTEMP1,XTEMP2,XTEMP3,
10222     1                  ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
10223     1                  DTEMP1,DTEMP2,DTEMP3,
10224     1                  ISEED,ALPHA,
10225     1                  ICTAMV,PCTAMV,PSTAMV,IQUASE,
10226     1                  Y2,X2,D2,D3,XACLOW,XACUPP,N2,
10227     1                  ISUBRO,IBUGG3,IERROR)
10228C
10229C     PURPOSE--GENERATE A TWO-WAY TABULATION PLOT.
10230C     WRITTEN BY--ALAN HECKERT
10231C                 STATISTICAL ENGINEERING DIVISION
10232C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10233C                 GAITHERSBURG, MD 20899-8980
10234C                 PHONE--301-975-2899
10235C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10236C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10237C     LANGUAGE--ANSI FORTRAN (1977)
10238C     VERSION NUMBER--2009/9
10239C     ORIGINAL VERSION--SEPTEMBER 2009.
10240C     UPDATED         --DECEMBER  2009. UNCERTAINTY OPTION FOR
10241C                                       BINOMIAL PROBABILITY, MEAN AND
10242C                                       MEDIAN CONFIDENCE INTERVAL
10243C     UPDATED         --JANUARY   2010. SUPPORT FOR UNCERTAINTY INTERVALS
10244C                                       FOR BINOMIAL RATIO
10245C
10246C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10247C
10248      CHARACTER*4 ICASCT
10249      CHARACTER*4 ICTAMV
10250      CHARACTER*4 IQUASE
10251      CHARACTER*4 IBUGG3
10252      CHARACTER*4 ISUBRO
10253      CHARACTER*4 IERROR
10254C
10255      CHARACTER*4 IWRITE
10256      CHARACTER*4 ISUBN1
10257      CHARACTER*4 ISUBN2
10258      CHARACTER*4 ISTEPN
10259C
10260C---------------------------------------------------------------------
10261C
10262      DIMENSION Y(*)
10263      DIMENSION Z(*)
10264      DIMENSION Z2(*)
10265      DIMENSION XIDTEM(*)
10266      DIMENSION XIDTE2(*)
10267      DIMENSION XIDTE3(*)
10268      DIMENSION Y2(*)
10269      DIMENSION X2(*)
10270      DIMENSION D2(*)
10271      DIMENSION D3(*)
10272C
10273      DIMENSION TAG1(*)
10274      DIMENSION TAG2(*)
10275      DIMENSION TAG3(*)
10276      DIMENSION TEMP(*)
10277      DIMENSION TEMPZ(*)
10278      DIMENSION TEMPZ2(*)
10279      DIMENSION XTEMP1(*)
10280      DIMENSION XTEMP2(*)
10281      DIMENSION XTEMP3(*)
10282C
10283      DIMENSION XACLOW(*)
10284      DIMENSION XACUPP(*)
10285C
10286      INTEGER ITEMP1(*)
10287      INTEGER ITEMP2(*)
10288      INTEGER ITEMP3(*)
10289      INTEGER ITEMP4(*)
10290      INTEGER ITEMP5(*)
10291      INTEGER ITEMP6(*)
10292C
10293      DOUBLE PRECISION DTEMP1(*)
10294      DOUBLE PRECISION DTEMP2(*)
10295      DOUBLE PRECISION DTEMP3(*)
10296C
10297C-----COMMON----------------------------------------------------------
10298C
10299      INCLUDE 'DPCOP2.INC'
10300C
10301C-----START POINT-----------------------------------------------------
10302C
10303      ISUBN1='DPTA'
10304      ISUBN2='P4  '
10305C
10306      I2=0
10307C
10308      AN=INT(N+0.01)
10309C
10310C               ***********************************************
10311C               **  STEP 5--                                 **
10312C               **  COMPUTE THE VARIOUS CROSS-TAB STATISTICS **
10313C               ***********************************************
10314C
10315      ISTEPN='5.1'
10316      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAP4')
10317     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10318C
10319      IWRITE='OFF'
10320C
10321      J=0
10322      NRESP=NUMV2-3
10323      DO1110ISET1=1,NUMSE1
10324        DO1120ISET2=1,NUMSE2
10325        DO1130ISET3=1,NUMSE3
10326C
10327          K=0
10328          DO1180I=1,N
10329            IF(XIDTEM(ISET1).EQ.TAG1(I).AND.
10330     1         XIDTE2(ISET2).EQ.TAG2(I).AND.
10331     1         XIDTE3(ISET3).EQ.TAG3(I)
10332     1       )GOTO1181
10333            GOTO1180
10334 1181       CONTINUE
10335C
10336            K=K+1
10337            TEMP(K)=0.0
10338            TEMPZ(K)=0.0
10339            TEMPZ2(K)=0.0
10340            IF(ISTANR.GE.1)TEMP(K)=Y(I)
10341            IF(ISTANR.GE.2)TEMPZ(K)=Z(I)
10342            IF(ISTANR.GE.3)TEMPZ2(K)=Z2(I)
10343 1180     CONTINUE
10344          NTEMP=K
10345C
10346          NTRIAL=0
10347          ALOWLM=0.0
10348          AUPPLM=0.0
10349          IF(NTEMP.EQ.0)THEN
10350            IF(ICTAMV.EQ.'ZERO')THEN
10351              STAT=0.0
10352              IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10353     1           ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10354                NTRIAL=0
10355                ALOWLM=0.0
10356                AUPPLM=0.0
10357              ENDIF
10358            ELSEIF(ICTAMV.EQ.'MV  ')THEN
10359              STAT=PCTAMV
10360              IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10361     1           ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10362                NTRIAL=0
10363                ALOWLM=PCTAMV
10364                AUPPLM=PCTAMV
10365              ENDIF
10366            ELSE
10367              GOTO1130
10368            ENDIF
10369          ELSE
10370            CALL CMPSTA(
10371     1              TEMP,TEMPZ,TEMPZ2,XTEMP1,XTEMP2,XTEMP3,
10372     1              MAXNXT,NTEMP,NTEMP,NTEMP,
10373     1              NRESP,ICASCT,
10374     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
10375     1              DTEMP1,DTEMP2,DTEMP3,
10376CCCCC1              IQUAME,IQUASE,PSTAMV,
10377     1              STAT,
10378     1              ISUBRO,IBUGG3,IERROR)
10379            IF(IERROR.EQ.'YES')GOTO9000
10380            IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'BRAT')THEN
10381              PTEMP=STAT
10382              NTRIAL=NTEMP
10383              IF(ICASCT.EQ.'BRAT')NTRIAL=ITEMP1(1)
10384              IF(STAT.EQ.PSTAMV)THEN
10385                ALOWLM=PSTAMV
10386                AUPPLM=PSTAMV
10387              ELSE
10388                ALPHAT=ALPHA
10389                IF(ALPHAT.LE.0.5)ALPHAT=1.0 - ALPHA
10390                CALL DPAGCO(PTEMP,NTRIAL,ALPHAT,IWRITE,
10391     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10392              ENDIF
10393            ELSEIF(ICASCT.EQ.'MECL')THEN
10394              XMEAN=STAT
10395              NTRIAL=NTEMP
10396              IF(STAT.EQ.PSTAMV)THEN
10397                ALOWLM=PSTAMV
10398                AUPPLM=PSTAMV
10399              ELSE
10400                CALL SD(TEMP,NTEMP,IWRITE,XSD,IBUGG3,IERROR)
10401                ALPHAT=ALPHA
10402                CALL DPMECL(XMEAN,XSD,NTEMP,ALPHAT,IWRITE,
10403     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10404              ENDIF
10405            ELSEIF(ICASCT.EQ.'MDCL')THEN
10406              XMED=STAT
10407              NTRIAL=NTEMP
10408              IF(STAT.EQ.PSTAMV)THEN
10409                ALOWLM=PSTAMV
10410                AUPPLM=PSTAMV
10411              ELSE
10412                XQ=0.5
10413                CALL QUANSE(XQ,TEMP,NTEMP,IWRITE,XTEMP1,MAXNXT,IQUASE,
10414     1                      QUASE,IBUGG3,IERROR)
10415                ALPHAT=ALPHA
10416                CALL DPMECL(XMED,QUASE,NTEMP,ALPHAT,IWRITE,
10417     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10418              ENDIF
10419            ENDIF
10420          ENDIF
10421C
10422          J=J+1
10423          Y2(J)=STAT
10424          X2(J)=XIDTEM(ISET1)
10425          D2(J)=XIDTE2(ISET2)
10426          D3(J)=XIDTE3(ISET3)
10427          IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10428     1       ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10429            IF(AUPPLM.GT.STATMX)STATMX=AUPPLM
10430            IF(ALOWLM.LT.STATMN)STATMN=ALOWLM
10431            XACLOW(J)=ALOWLM
10432            XACUPP(J)=AUPPLM
10433          ENDIF
10434C
10435 1130   CONTINUE
10436 1120   CONTINUE
10437 1110 CONTINUE
10438      N2=J
10439C
10440C               ******************
10441C               **   STEP 90--  **
10442C               **   EXIT       **
10443C               ******************
10444C
10445 9000 CONTINUE
10446      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP4')THEN
10447        WRITE(ICOUT,999)
10448  999   FORMAT(1X)
10449        CALL DPWRST('XXX','BUG ')
10450        WRITE(ICOUT,9011)
10451 9011   FORMAT('***** AT THE END       OF DPTAP4--')
10452        CALL DPWRST('XXX','BUG ')
10453        WRITE(ICOUT,9012)ICASCT,N,NUMV2,IERROR
10454 9012   FORMAT('ICASCT,N,NUMV2,IERROR = ',A4,2I8,2X,A4)
10455        CALL DPWRST('XXX','BUG ')
10456        WRITE(ICOUT,9015)NUMSE1,NUMSE2,NUMSE3,N2
10457 9015   FORMAT('NUMSE1,NUMSE2,NUMSE3,N2 = ',4I8)
10458        CALL DPWRST('XXX','BUG ')
10459        DO9020I=1,N2
10460          WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I),D3(I)
10461 9021     FORMAT('I,Y2(I),X2(I),D2(I),D3(I) = ',I8,4G15.7)
10462          CALL DPWRST('XXX','BUG ')
10463 9020   CONTINUE
10464      ENDIF
10465C
10466      RETURN
10467      END
10468      SUBROUTINE DPTAP5(Y,Z,Z2,TAG1,TAG2,TAG3,TAG4,N,
10469     1                  NUMV2,ICASCT,ISTANR,
10470     1                  XIDTEM,XIDTE2,XIDTE3,XIDTE4,
10471     1                  NUMSE1,NUMSE2,NUMSE3,NUMSE4,
10472     1                  TEMP,TEMPZ,TEMPZ2,XTEMP1,XTEMP2,XTEMP3,
10473     1                  ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
10474     1                  DTEMP1,DTEMP2,DTEMP3,
10475     1                  ISEED,ALPHA,
10476     1                  ICTAMV,PCTAMV,PSTAMV,IQUASE,
10477     1                  Y2,X2,D2,D3,D4,XACLOW,XACUPP,N2,
10478     1                  ISUBRO,IBUGG3,IERROR)
10479C
10480C     PURPOSE--GENERATE A TWO-WAY TABULATION PLOT.
10481C     WRITTEN BY--ALAN HECKERT
10482C                 STATISTICAL ENGINEERING DIVISION
10483C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10484C                 GAITHERSBURG, MD 20899-8980
10485C                 PHONE--301-975-2899
10486C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10487C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10488C     LANGUAGE--ANSI FORTRAN (1977)
10489C     VERSION NUMBER--2009/9
10490C     ORIGINAL VERSION--SEPTEMBER 2009.
10491C     UPDATED         --DECEMBER  2009. UNCERTAINTY OPTION FOR
10492C                                       BINOMIAL PROBABILITY, MEAN AND
10493C                                       MEDIAN CONFIDENCE INTERVAL
10494C     UPDATED         --JANUARY   2010. SUPPORT FOR UNCERTAINTY INTERVALS
10495C                                       FOR BINOMIAL RATIO
10496C
10497C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10498C
10499      CHARACTER*4 ICASCT
10500      CHARACTER*4 ICTAMV
10501      CHARACTER*4 IQUASE
10502      CHARACTER*4 IBUGG3
10503      CHARACTER*4 IERROR
10504      CHARACTER*4 ISUBRO
10505C
10506      CHARACTER*4 IWRITE
10507      CHARACTER*4 ISUBN1
10508      CHARACTER*4 ISUBN2
10509      CHARACTER*4 ISTEPN
10510C
10511C---------------------------------------------------------------------
10512C
10513      DIMENSION Y(*)
10514      DIMENSION Z(*)
10515      DIMENSION Z2(*)
10516      DIMENSION XIDTEM(*)
10517      DIMENSION XIDTE2(*)
10518      DIMENSION XIDTE3(*)
10519      DIMENSION XIDTE4(*)
10520      DIMENSION Y2(*)
10521      DIMENSION X2(*)
10522      DIMENSION D2(*)
10523      DIMENSION D3(*)
10524      DIMENSION D4(*)
10525C
10526      DIMENSION TAG1(*)
10527      DIMENSION TAG2(*)
10528      DIMENSION TAG3(*)
10529      DIMENSION TAG4(*)
10530      DIMENSION TEMP(*)
10531      DIMENSION TEMPZ(*)
10532      DIMENSION TEMPZ2(*)
10533      DIMENSION XTEMP1(*)
10534      DIMENSION XTEMP2(*)
10535      DIMENSION XTEMP3(*)
10536C
10537      DIMENSION XACLOW(*)
10538      DIMENSION XACUPP(*)
10539C
10540      INTEGER ITEMP1(*)
10541      INTEGER ITEMP2(*)
10542      INTEGER ITEMP3(*)
10543      INTEGER ITEMP4(*)
10544      INTEGER ITEMP5(*)
10545      INTEGER ITEMP6(*)
10546C
10547      DOUBLE PRECISION DTEMP1(*)
10548      DOUBLE PRECISION DTEMP2(*)
10549      DOUBLE PRECISION DTEMP3(*)
10550C
10551C-----COMMON----------------------------------------------------------
10552C
10553      INCLUDE 'DPCOP2.INC'
10554C
10555C-----START POINT-----------------------------------------------------
10556C
10557      ISUBN1='DPTA'
10558      ISUBN2='P5  '
10559C
10560      I2=0
10561C
10562      AN=INT(N+0.01)
10563C
10564C               ***********************************************
10565C               **  STEP 5--                                 **
10566C               **  COMPUTE THE VARIOUS CROSS-TAB STATISTICS **
10567C               ***********************************************
10568C
10569      ISTEPN='5.1'
10570      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TAP5')
10571     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10572C
10573      IWRITE='OFF'
10574C
10575      J=0
10576      NRESP=NUMV2-4
10577      DO1110ISET1=1,NUMSE1
10578        DO1120ISET2=1,NUMSE2
10579        DO1130ISET3=1,NUMSE3
10580        DO1140ISET4=1,NUMSE4
10581C
10582          K=0
10583          DO1180I=1,N
10584            IF(XIDTEM(ISET1).EQ.TAG1(I).AND.
10585     1         XIDTE2(ISET2).EQ.TAG2(I).AND.
10586     1         XIDTE3(ISET3).EQ.TAG3(I).AND.
10587     1         XIDTE4(ISET4).EQ.TAG4(I)
10588     1        )GOTO1181
10589            GOTO1180
10590 1181       CONTINUE
10591C
10592            K=K+1
10593            TEMP(K)=0.0
10594            TEMPZ(K)=0.0
10595            TEMPZ2(K)=0.0
10596            IF(ISTANR.GE.1)TEMP(K)=Y(I)
10597            IF(ISTANR.GE.2)TEMPZ(K)=Z(I)
10598            IF(ISTANR.GE.3)TEMPZ2(K)=Z2(I)
10599 1180     CONTINUE
10600          NTEMP=K
10601C
10602          NTRIAL=0
10603          ALOWLM=0.0
10604          AUPPLM=0.0
10605          IF(NTEMP.EQ.0)THEN
10606            IF(ICTAMV.EQ.'ZERO')THEN
10607              STAT=0.0
10608              IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10609     1           ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10610                NTRIAL=0
10611                ALOWLM=0.0
10612                AUPPLM=0.0
10613              ENDIF
10614            ELSEIF(ICTAMV.EQ.'MV  ')THEN
10615              STAT=PCTAMV
10616              IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10617     1           ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10618                NTRIAL=0
10619                ALOWLM=PCTAMV
10620                AUPPLM=PCTAMV
10621              ENDIF
10622            ELSE
10623              GOTO1140
10624            ENDIF
10625          ELSE
10626            CALL CMPSTA(
10627     1              TEMP,TEMPZ,TEMPZ2,XTEMP1,XTEMP2,XTEMP3,
10628     1              MAXNXT,NTEMP,NTEMP,NTEMP,
10629     1              NRESP,ICASCT,
10630     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
10631     1              DTEMP1,DTEMP2,DTEMP3,
10632CCCCC1              IQUAME,IQUASE,PSTAMV,
10633     1              STAT,
10634     1              ISUBRO,IBUGG3,IERROR)
10635            IF(IERROR.EQ.'YES')GOTO9000
10636            IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'BRAT')THEN
10637              PTEMP=STAT
10638              NTRIAL=NTEMP
10639              IF(ICASCT.EQ.'BRAT')NTRIAL=ITEMP1(1)
10640              IF(STAT.EQ.PSTAMV)THEN
10641                ALOWLM=PSTAMV
10642                AUPPLM=PSTAMV
10643              ELSE
10644                ALPHAT=ALPHA
10645                IF(ALPHAT.LE.0.5)ALPHAT=1.0 - ALPHA
10646                CALL DPAGCO(PTEMP,NTRIAL,ALPHAT,IWRITE,
10647     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10648              ENDIF
10649            ELSEIF(ICASCT.EQ.'MECL')THEN
10650              XMEAN=STAT
10651              NTRIAL=NTEMP
10652              IF(STAT.EQ.PSTAMV)THEN
10653                ALOWLM=PSTAMV
10654                AUPPLM=PSTAMV
10655              ELSE
10656                CALL SD(TEMP,NTEMP,IWRITE,XSD,IBUGG3,IERROR)
10657                ALPHAT=ALPHA
10658                CALL DPMECL(XMEAN,XSD,NTEMP,ALPHAT,IWRITE,
10659     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10660              ENDIF
10661            ELSEIF(ICASCT.EQ.'MDCL')THEN
10662              XMED=STAT
10663              NTRIAL=NTEMP
10664              IF(STAT.EQ.PSTAMV)THEN
10665                ALOWLM=PSTAMV
10666                AUPPLM=PSTAMV
10667              ELSE
10668                XQ=0.5
10669                CALL QUANSE(XQ,TEMP,NTEMP,IWRITE,XTEMP1,MAXNXT,IQUASE,
10670     1                      QUASE,IBUGG3,IERROR)
10671                ALPHAT=ALPHA
10672                CALL DPMECL(XMED,QUASE,NTEMP,ALPHAT,IWRITE,
10673     1                      ALOWLM,AUPPLM,IBUGG3,IERROR)
10674              ENDIF
10675            ENDIF
10676          ENDIF
10677C
10678          J=J+1
10679          Y2(J)=STAT
10680          X2(J)=XIDTEM(ISET1)
10681          D2(J)=XIDTE2(ISET2)
10682          D3(J)=XIDTE3(ISET3)
10683          D4(J)=XIDTE4(ISET4)
10684          IF(ICASCT.EQ.'BPRO' .OR. ICASCT.EQ.'MECL' .OR.
10685     1       ICASCT.EQ.'MDCL' .OR. ICASCT.EQ.'BRAT')THEN
10686            IF(AUPPLM.GT.STATMX)STATMX=AUPPLM
10687            IF(ALOWLM.LT.STATMN)STATMN=ALOWLM
10688            XACLOW(J)=ALOWLM
10689            XACUPP(J)=AUPPLM
10690          ENDIF
10691C
10692 1140   CONTINUE
10693 1130   CONTINUE
10694 1120   CONTINUE
10695 1110 CONTINUE
10696      N2=J
10697C
10698C               ******************
10699C               **   STEP 90--  **
10700C               **   EXIT       **
10701C               ******************
10702C
10703 9000 CONTINUE
10704      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'TAP5')THEN
10705        WRITE(ICOUT,999)
10706  999   FORMAT(1X)
10707        CALL DPWRST('XXX','BUG ')
10708        WRITE(ICOUT,9011)
10709 9011   FORMAT('***** AT THE END       OF DPTAP5--')
10710        CALL DPWRST('XXX','BUG ')
10711        WRITE(ICOUT,9012)ICASCT,N,NUMV2,IERROR
10712 9012   FORMAT('ICASCT,N,NUMV2,IERROR = ',A4,2I8,2X,A4)
10713        CALL DPWRST('XXX','BUG ')
10714        WRITE(ICOUT,9015)NUMSE1,NUMSE2,NUMSE3,NUMSE4,N2
10715 9015   FORMAT('NUMSE1,NUMSE2,NUMSE3,NUMSE4,N2 = ',5I8)
10716        CALL DPWRST('XXX','BUG ')
10717        DO9020I=1,N2
10718          WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I),D3(I),D4(I)
10719 9021     FORMAT('I,Y2(I),X2(I),D2(I),D3(I),D4(I) = ',I8,5G15.7)
10720          CALL DPWRST('XXX','BUG ')
10721 9020   CONTINUE
10722      ENDIF
10723C
10724      RETURN
10725      END
10726      SUBROUTINE DPTAWI(IFORWI,IFORWR,MAXNWI,
10727     1                  ISUBRO,IBUGS2,IFOUND,IERROR)
10728C
10729C     PURPOSE--IMPLEMENT THE COMMAND
10730C
10731C                  TABLE WIDTH  <SIGDIG>   <TOTWID>
10732C
10733C              THIS IS AN ALTERNATIVE TO "SET WRITE DECIMALS" AND
10734C              "SET WRITE FORMAT" FOR DEFINING HOW TO PRINT
10735C              VARIABLES WITH THE WRITE COMMAND.  THE LIMITATION
10736C              OF "SET WRITE DECIMALS" IS THAT IT ONLY ALLOWS YOU
10737C              TO SPECIFY THE NUMBER OF DIGITS TO THE RIGHT OF
10738C              THE DECIMAL POINT AND IT SETS ALL COLUMNS TO THE
10739C              SAME VALUE.  THE LIMITATION OF SET WRITE FORMAT
10740C              IS THAT IT CANNOT BE EASILY APPLIED TO HTML, LATEK,
10741C              OR RTF OUTPUT.
10742C
10743C              THE <SIGDIG> VARIABLE DEFINES THE NUMBER OF DIGITS
10744C              TO THE RIGHT OF THE DECIMAL POINT AND <TOTWID> DEFINES
10745C              THE TOTAL WIDTH OF THE FIELD (SO THIS SETS Fxx.yy
10746C              FORMAT WHERE WE ARE DEFINING "yy" AND "xx").
10747C
10748C              IF EITHER <SIGDIG> OR <TOTWID> IS NEGATIVE, THEN
10749C              WE USE   Exx.yy FORMAT.
10750C
10751C              IF <SIGDIG> OR <TOTWID> IS A SCALAR, THEN ALL ROWS
10752C              OF IFORWI AND IFORWR WILL BE SET.  IF ONLY <SIGDIG>
10753C              IS SPECIFIED, <TOTWID> WILL BE SET TO -99 (THIS IS
10754C              EQUIVALENT TO USING SET WRITE DECIMALS) FOR F FORMAT
10755C              AND TO <SIGDIG> + 8 FOR E FORMAT.
10756C
10757C     INPUT ARGUMENTS --MAXNWI      = MAXIMUM NUMBER OF FIELDS THAT
10758C                                     CAN BE SPECIFIED
10759C     OUTPUT ARGUMENTS--IFORWI      = INTEGER ARRAY THAT DEFINES THE
10760C                                     TOTAL WIDTH OF THE FIELDS
10761C                     --IFORWR      = INTEGER ARRAY THAT DEFINES THE
10762C                                     NUMBER OF DIGITS TO THE RIGHT OF
10763C                                     THE DECIMAL
10764C                     --IFOUND ('YES' OR 'NO' )
10765C                     --IERROR ('YES' OR 'NO' )
10766C     WRITTEN BY--JAMES J. FILLIBEN
10767C                 STATISTICAL ENGINEERING DIVISION
10768C                 INFORMATION TECHNOLOGY LABORATORY
10769C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10770C                 GAITHERSBURG, MD 20899-8980
10771C                 PHONE--301-975-2855
10772C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10773C           OF THE NATIONAL BUREAU OF STANDARDS.
10774C     LANGUAGE--ANSI FORTRAN (1977)
10775C     VERSION NUMBER--2009/3
10776C     ORIGINAL VERSION--MARCH     2009.
10777C
10778C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10779C
10780      CHARACTER*4 ISUBRO
10781      CHARACTER*4 IBUGS2
10782      CHARACTER*4 IFOUND
10783      CHARACTER*4 IERROR
10784C
10785      CHARACTER*4 IHWUSE
10786      CHARACTER*4 IH11
10787      CHARACTER*4 IH12
10788      CHARACTER*4 MESSAG
10789      CHARACTER*4 ISUBN1
10790      CHARACTER*4 ISUBN2
10791C
10792C---------------------------------------------------------------------
10793C
10794      INCLUDE 'DPCOPA.INC'
10795      INCLUDE 'DPCODA.INC'
10796      INCLUDE 'DPCOHK.INC'
10797      INCLUDE 'DPCOM2.INC'
10798C
10799      DIMENSION IFORWI(*)
10800      DIMENSION IFORWR(*)
10801C
10802C-----COMMON----------------------------------------------------------
10803C
10804      INCLUDE 'DPCOP2.INC'
10805C
10806C-----START POINT-----------------------------------------------------
10807C
10808      IFOUND='NO'
10809      IERROR='NO'
10810C
10811      IHOLD1=0
10812      IHOLD2=0
10813      I1=-99
10814      I2=-99
10815      I3=-99
10816      ICOL2=0
10817C
10818      IF(ISUBRO.EQ.'TAWI' .OR. IBUGS2.EQ.'ON')THEN
10819        WRITE(ICOUT,999)
10820  999   FORMAT(1X)
10821        CALL DPWRST('XXX','BUG ')
10822        WRITE(ICOUT,51)
10823   51   FORMAT('****AT THE BEGINNING OF DPTAWI')
10824        CALL DPWRST('XXX','BUG ')
10825        WRITE(ICOUT,53)MAXNWI
10826   53   FORMAT('MAXNWI = ',I5)
10827        CALL DPWRST('XXX','BUG ')
10828        DO55I=1,MAXNWI
10829          WRITE(ICOUT,57)I,IFORWI(I),IFORWR(I)
10830   57     FORMAT('I,IFORWI(I),IFORWR(I) = ',3I8)
10831          CALL DPWRST('XXX','BUG ')
10832   55   CONTINUE
10833      ENDIF
10834C
10835C               ****************************************************
10836C               **  TREAT THE CASE WHEN                           **
10837C               **  THE FORMAT WIDTHS ARE TO BE CHANGED           **
10838C               ****************************************************
10839C
10840      IF(NUMARG.LE.0)GOTO9000
10841      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'WIDT')GOTO1110
10842      GOTO1190
10843C
10844 1110 CONTINUE
10845      IF(NUMARG.EQ.1)GOTO1120
10846      IF(IHARG(NUMARG).EQ.'ON')GOTO1120
10847      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
10848      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1120
10849      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
10850      IF(IHARG(NUMARG).EQ.'?')GOTO8100
10851      IF(NUMARG.GE.3.AND.IARGT(2).EQ.'NUMB'.AND.
10852     1IARGT(3).EQ.'NUMB')GOTO1130
10853      IF(NUMARG.GE.2.AND.IARGT(2).EQ.'NUMB')GOTO1140
10854      GOTO3140
10855C
10856C     CASE 1: RESET DEFAULT
10857C
10858 1120 CONTINUE
10859      I1=-99
10860      I2=-99
10861      DO1122I=1,MAXNWI
10862        IFORWI(I)=I1
10863        IFORWR(I)=I2
10864 1122 CONTINUE
10865      GOTO1180
10866C
10867C     CASE 2: BOTH VALUES SCALARS
10868C
10869 1130 CONTINUE
10870      I1=IARG(2)
10871      I2=IARG(3)
10872      DO1132I=1,MAXNWI
10873        IFORWI(I)=I1
10874        IFORWR(I)=I2
10875 1132 CONTINUE
10876      GOTO1180
10877C
10878C     CASE 3: ONE SCALAR SPECIFIED
10879C
10880 1140 CONTINUE
10881      I1=-99
10882      I2=IARG(2)
10883      DO1142I=1,MAXNWI
10884        IFORWI(I)=I1
10885        IFORWR(I)=I2
10886 1142 CONTINUE
10887      GOTO1180
10888C
10889 1180 CONTINUE
10890      IFOUND='YES'
10891C
10892      IF(IFEEDB.EQ.'ON')THEN
10893        WRITE(ICOUT,999)
10894        CALL DPWRST('XXX','BUG ')
10895        WRITE(ICOUT,1185)I1
10896 1185   FORMAT('THE TABLE WIDTHS SET TO ',I8)
10897        CALL DPWRST('XXX','BUG ')
10898        WRITE(ICOUT,1188)I2
10899 1188   FORMAT('THE TABLE DIGITS SET TO ',I8)
10900        CALL DPWRST('XXX','BUG ')
10901      ENDIF
10902      GOTO9000
10903C
10904 1190 CONTINUE
10905C
10906C               ********************************************
10907C               **  STEP 81--                             **
10908C               **  TREAT THE    ?    CASE--              **
10909C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
10910C               ********************************************
10911C
10912 8100 CONTINUE
10913      IFOUND='YES'
10914      WRITE(ICOUT,999)
10915      CALL DPWRST('XXX','BUG ')
10916      WRITE(ICOUT,8109)
10917 8109 FORMAT('FIELD WIDTH     FIELD DIGITS')
10918      CALL DPWRST('XXX','BUG ')
10919      DO8110I=1,MAXNWI
10920        WRITE(ICOUT,8111)IFORWI(I),IFORWR(I)
10921 8111   FORMAT(I11,5X,I12)
10922        CALL DPWRST('XXX','BUG ')
10923 8110 CONTINUE
10924      GOTO9000
10925C
10926 3140 CONTINUE
10927C
10928      IF(IARGT(2).EQ.'NUMB')THEN
10929        I2=IARG(2)
10930        N1=-99
10931      ELSE
10932        IH11=IHARG(2)
10933        IH12=IHARG2(2)
10934        IHWUSE='V'
10935        MESSAG='YES'
10936        CALL CHECKN(IH11,IH12,IHWUSE,
10937     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
10938     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
10939        IF(IERROR.EQ.'NO')THEN
10940          ICOL1=IVALUE(ILOCV)
10941          N1=IN(ILOCV)
10942        ELSE
10943          GOTO9000
10944        ENDIF
10945      ENDIF
10946C
10947      IF(IARGT(3).EQ.'NUMB')THEN
10948        I3=IARG(3)
10949        N2=-99
10950      ELSE
10951        IH11=IHARG(3)
10952        IH12=IHARG2(3)
10953        IHWUSE='V'
10954        MESSAG='YES'
10955        CALL CHECKN(IH11,IH12,IHWUSE,
10956     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
10957     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
10958        IF(IERROR.EQ.'NO')THEN
10959          ICOL2=IVALUE(ILOCV)
10960          N2=IN(ILOCV)
10961        ELSE
10962          GOTO9000
10963        ENDIF
10964      ENDIF
10965C
10966      IF(N1.GT.0)THEN
10967        J=0
10968        IMAX=MIN(MAXNWI,N1)
10969        DO3160I=1,IMAX
10970C
10971          IF(I.GT.IMAX)GOTO3169
10972          J=J+1
10973          IFORWI(J)=-99
10974          IJ=MAXN*(ICOL1-1)+I
10975          IF(ICOL1.LE.MAXCOL)IFORWI(J)=INT(V(IJ))
10976          IF(ICOL1.EQ.MAXCP1)IFORWI(J)=INT(PRED(I))
10977          IF(ICOL1.EQ.MAXCP2)IFORWI(J)=INT(RES(I))
10978          IF(ICOL1.EQ.MAXCP3)IFORWI(J)=INT(YPLOT(I))
10979          IF(ICOL1.EQ.MAXCP4)IFORWI(J)=INT(XPLOT(I))
10980          IF(ICOL1.EQ.MAXCP5)IFORWI(J)=INT(X2PLOT(I))
10981          IF(ICOL1.EQ.MAXCP6)IFORWI(J)=INT(TAGPLO(I))
10982C
10983 3160   CONTINUE
10984 3169   CONTINUE
10985C
10986      ELSE
10987        DO3165J=1,MAXNWI
10988          IFORWI(J)=I2
10989 3165   CONTINUE
10990      ENDIF
10991C
10992      IF(N2.GT.0)THEN
10993        J=0
10994        IMAX=MIN(MAXNWI,N2)
10995        DO3170I=1,IMAX
10996C
10997          IF(I.GT.IMAX)GOTO3179
10998          J=J+1
10999          IFORWR(J)=-99
11000          IJ=MAXN*(ICOL2-1)+I
11001          IF(ICOL2.LE.MAXCOL)IFORWR(J)=INT(V(IJ))
11002          IF(ICOL2.EQ.MAXCP1)IFORWR(J)=INT(PRED(I))
11003          IF(ICOL2.EQ.MAXCP2)IFORWR(J)=INT(RES(I))
11004          IF(ICOL2.EQ.MAXCP3)IFORWR(J)=INT(YPLOT(I))
11005          IF(ICOL2.EQ.MAXCP4)IFORWR(J)=INT(XPLOT(I))
11006          IF(ICOL2.EQ.MAXCP5)IFORWR(J)=INT(X2PLOT(I))
11007          IF(ICOL2.EQ.MAXCP6)IFORWR(J)=INT(TAGPLO(I))
11008C
11009 3170   CONTINUE
11010 3179   CONTINUE
11011C
11012      ELSE
11013        DO3175J=1,MAXNWI
11014          IFORWR(J)=I3
11015 3175   CONTINUE
11016      ENDIF
11017C
11018      IF(IFEEDB.EQ.'ON')THEN
11019        WRITE(ICOUT,999)
11020        CALL DPWRST('XXX','BUG ')
11021        WRITE(ICOUT,8109)
11022        CALL DPWRST('XXX','BUG ')
11023        ILAST=MAX(N1,N2)
11024        ILAST=MIN(ILAST,MAXNWI)
11025        DO3190I=1,ILAST
11026          WRITE(ICOUT,8111)IFORWI(I),IFORWR(I)
11027          CALL DPWRST('XXX','BUG ')
11028 3190   CONTINUE
11029      ENDIF
11030C
11031      IFOUND='YES'
11032      GOTO9000
11033C
11034C               *****************
11035C               **  STEP 90--  **
11036C               **  EXIT       **
11037C               *****************
11038C
11039 9000 CONTINUE
11040C
11041      IF(ISUBRO.EQ.'TAWI' .OR. IBUGS2.EQ.'ON')THEN
11042        WRITE(ICOUT,999)
11043        CALL DPWRST('XXX','BUG ')
11044        WRITE(ICOUT,9051)
11045 9051   FORMAT('****AT THE END OF DPTAWI')
11046        CALL DPWRST('XXX','BUG ')
11047        DO9055I=1,MAXNWI
11048          WRITE(ICOUT,9057)I,IFORWI(I),IFORWR(I)
11049 9057     FORMAT('I,IFORWI(I),IFORWR(I) = ',3I8)
11050          CALL DPWRST('XXX','BUG ')
11051 9055   CONTINUE
11052      ENDIF
11053C
11054      RETURN
11055      END
11056      SUBROUTINE DPTBCO(IHARG,NUMARG,IDETBC,MAXTEX,ITEBCO,
11057     1IBUGP2,IFOUND,IERROR)
11058C
11059C     PURPOSE--DEFINE THE TEXT BORDER COLORS = THE COLORS
11060C              OF THE BORDER LINE AROUND THE TEXTS.
11061C              THESE ARE LOCATED IN THE VECTOR ITEBCO(.).
11062C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
11063C                     --NUMARG
11064C                     --IDETBC
11065C                     --MAXTEX
11066C                     --IBUGP2 ('ON' OR 'OFF' )
11067C     OUTPUT ARGUMENTS--ITEBCO (A CHARACTER VECTOR)
11068C                     --IFOUND ('YES' OR 'NO' )
11069C                     --IERROR ('YES' OR 'NO' )
11070C     WRITTEN BY--JAMES J. FILLIBEN
11071C                 STATISTICAL ENGINEERING DIVISION
11072C                 INFORMATION TECHNOLOGY LABORATORY
11073C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11074C                 GAITHERSBURG, MD 20899-8980
11075C                 PHONE--301-975-2899
11076C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11077C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11078C     LANGUAGE--ANSI FORTRAN (1977)
11079C     VERSION NUMBER--82/7
11080C     ORIGINAL VERSION--DECEMBER  1983.
11081C
11082C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11083C
11084      CHARACTER*4 IHARG
11085      CHARACTER*4 IDETBC
11086      CHARACTER*4 ITEBCO
11087C
11088      CHARACTER*4 IBUGP2
11089      CHARACTER*4 IFOUND
11090      CHARACTER*4 IERROR
11091C
11092      CHARACTER*4 IHOLD1
11093      CHARACTER*4 IHOLD2
11094C
11095      CHARACTER*4 ISUBN1
11096      CHARACTER*4 ISUBN2
11097      CHARACTER*4 ISTEPN
11098C
11099      DIMENSION IHARG(*)
11100      DIMENSION ITEBCO(*)
11101C
11102C-----COMMON----------------------------------------------------------
11103C
11104      INCLUDE 'DPCOP2.INC'
11105C
11106C-----START POINT-----------------------------------------------------
11107C
11108      IFOUND='NO'
11109      IERROR='NO'
11110      ISUBN1='DPTB'
11111      ISUBN2='CO  '
11112C
11113      NUMTEX=0
11114      IHOLD1='-999'
11115      IHOLD2='-999'
11116C
11117      IF(IBUGP2.EQ.'OFF')GOTO90
11118      WRITE(ICOUT,999)
11119  999 FORMAT(1X)
11120      CALL DPWRST('XXX','BUG ')
11121      WRITE(ICOUT,51)
11122   51 FORMAT('***** AT THE BEGINNING OF DPTBCO--')
11123      CALL DPWRST('XXX','BUG ')
11124      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
11125   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11126      CALL DPWRST('XXX','BUG ')
11127      WRITE(ICOUT,53)MAXTEX,NUMTEX
11128   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11129      CALL DPWRST('XXX','BUG ')
11130      WRITE(ICOUT,54)IHOLD1,IHOLD2
11131   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
11132      CALL DPWRST('XXX','BUG ')
11133      WRITE(ICOUT,55)IDETBC
11134   55 FORMAT('IDETBC = ',A4)
11135      CALL DPWRST('XXX','BUG ')
11136      WRITE(ICOUT,60)NUMARG
11137   60 FORMAT('NUMARG = ',I8)
11138      CALL DPWRST('XXX','BUG ')
11139      DO65I=1,NUMARG
11140      WRITE(ICOUT,66)IHARG(I)
11141   66 FORMAT('IHARG(I) = ',A4)
11142      CALL DPWRST('XXX','BUG ')
11143   65 CONTINUE
11144      WRITE(ICOUT,70)ITEBCO(1)
11145   70 FORMAT('ITEBCO(1) = ',A4)
11146      CALL DPWRST('XXX','BUG ')
11147      DO75I=1,10
11148      WRITE(ICOUT,76)I,ITEBCO(I)
11149   76 FORMAT('I,ITEBCO(I) = ',I8,2X,A4)
11150      CALL DPWRST('XXX','BUG ')
11151   75 CONTINUE
11152   90 CONTINUE
11153C
11154C               **************************************
11155C               **  STEP 1--                        **
11156C               **  BRANCH TO THE APPROPRIATE CASE  **
11157C               **************************************
11158C
11159      ISTEPN='1'
11160      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11161C
11162      IF(NUMARG.LE.1)GOTO9000
11163      IF(NUMARG.EQ.2)GOTO1120
11164      IF(NUMARG.EQ.3)GOTO1130
11165      IF(NUMARG.EQ.4)GOTO1140
11166      GOTO1150
11167C
11168 1120 CONTINUE
11169      GOTO1200
11170C
11171 1130 CONTINUE
11172      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
11173      IF(IHARG(3).EQ.'ALL')GOTO1300
11174      GOTO1200
11175C
11176 1140 CONTINUE
11177      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
11178      IF(IHARG(3).EQ.'ALL')GOTO1300
11179      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
11180      IF(IHARG(4).EQ.'ALL')GOTO1300
11181      GOTO1200
11182C
11183 1150 CONTINUE
11184      GOTO1200
11185C
11186C               *************************************************
11187C               **  STEP 2--                                   **
11188C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
11189C               *************************************************
11190C
11191 1200 CONTINUE
11192      ISTEPN='2'
11193      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11194C
11195      IF(NUMARG.LE.2)GOTO1210
11196      GOTO1220
11197C
11198 1210 CONTINUE
11199      NUMTEX=1
11200      ITEBCO(1)=IDETBC
11201      GOTO1270
11202C
11203 1220 CONTINUE
11204      NUMTEX=NUMARG-2
11205      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
11206      DO1225I=1,NUMTEX
11207      J=I+2
11208      IHOLD1=IHARG(J)
11209      IHOLD2=IHOLD1
11210      IF(IHOLD1.EQ.'ON')IHOLD2=IDETBC
11211      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETBC
11212      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETBC
11213      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETBC
11214      ITEBCO(I)=IHOLD2
11215 1225 CONTINUE
11216      GOTO1270
11217C
11218 1270 CONTINUE
11219      IF(IFEEDB.EQ.'OFF')GOTO1279
11220      WRITE(ICOUT,999)
11221      CALL DPWRST('XXX','BUG ')
11222      DO1278I=1,NUMTEX
11223      WRITE(ICOUT,1276)I,ITEBCO(I)
11224 1276 FORMAT('THE COLOR OF TEXT BORDER ',I6,
11225     1' HAS JUST BEEN SET TO ',A4)
11226      CALL DPWRST('XXX','BUG ')
11227 1278 CONTINUE
11228 1279 CONTINUE
11229      IFOUND='YES'
11230      GOTO9000
11231C
11232C               **************************
11233C               **  STEP 3--            **
11234C               **  TREAT THE ALL CASE  **
11235C               **************************
11236C
11237 1300 CONTINUE
11238      ISTEPN='3'
11239      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11240C
11241      NUMTEX=MAXTEX
11242      IHOLD2=IHOLD1
11243      IF(IHOLD1.EQ.'ON')IHOLD2=IDETBC
11244      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETBC
11245      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETBC
11246      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETBC
11247      DO1315I=1,NUMTEX
11248      ITEBCO(I)=IHOLD2
11249 1315 CONTINUE
11250      GOTO1370
11251C
11252 1370 CONTINUE
11253      IF(IFEEDB.EQ.'OFF')GOTO1319
11254      WRITE(ICOUT,999)
11255      CALL DPWRST('XXX','BUG ')
11256      I=1
11257      WRITE(ICOUT,1316)ITEBCO(I)
11258 1316 FORMAT('THE COLOR OF ALL TEXT BORDERS',
11259     1' HAS JUST BEEN SET TO ',A4)
11260      CALL DPWRST('XXX','BUG ')
11261 1319 CONTINUE
11262      IFOUND='YES'
11263      GOTO9000
11264C
11265C               *****************
11266C               **  STEP 90--  **
11267C               **  EXIT       **
11268C               *****************
11269C
11270 9000 CONTINUE
11271      IF(IBUGP2.EQ.'OFF')GOTO9090
11272      WRITE(ICOUT,9011)
11273 9011 FORMAT('***** AT THE END       OF DPTBCO--')
11274      CALL DPWRST('XXX','BUG ')
11275      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
11276 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11277      CALL DPWRST('XXX','BUG ')
11278      WRITE(ICOUT,9013)MAXTEX,NUMTEX
11279 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11280      CALL DPWRST('XXX','BUG ')
11281      WRITE(ICOUT,9014)IHOLD1,IHOLD2
11282 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
11283      CALL DPWRST('XXX','BUG ')
11284      WRITE(ICOUT,9015)IDETBC
11285 9015 FORMAT('IDETBC = ',A4)
11286      CALL DPWRST('XXX','BUG ')
11287      WRITE(ICOUT,9020)NUMARG
11288 9020 FORMAT('NUMARG = ',I8)
11289      CALL DPWRST('XXX','BUG ')
11290      DO9025I=1,NUMARG
11291      WRITE(ICOUT,9026)IHARG(I)
11292 9026 FORMAT('IHARG(I) = ',A4)
11293      CALL DPWRST('XXX','BUG ')
11294 9025 CONTINUE
11295      WRITE(ICOUT,9030)ITEBCO(1)
11296 9030 FORMAT('ITEBCO(1) = ',A4)
11297      CALL DPWRST('XXX','BUG ')
11298      DO9035I=1,10
11299      WRITE(ICOUT,9036)I,ITEBCO(I)
11300 9036 FORMAT('I,ITEBCO(I) = ',I8,2X,A4)
11301      CALL DPWRST('XXX','BUG ')
11302 9035 CONTINUE
11303 9090 CONTINUE
11304C
11305      RETURN
11306      END
11307      SUBROUTINE DPTBLI(IHARG,IHARG2,NUMARG,IDETBL,MAXTEX,ITEBLI,
11308CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
11309CCCCC SUBROUTINE DPTBLI(IHARG,NUMARG,IDETBL,MAXTEX,ITEBLI,
11310     1IBUGP2,IFOUND,IERROR)
11311C
11312C     PURPOSE--DEFINE THE BORDER LINES = THE LINES TYPES
11313C              OF THE BORDER AROUND THE TEXTS.
11314C              THESE ARE LOCATED IN THE VECTOR ITEBLI(.).
11315C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
11316C                     --NUMARG
11317C                     --IDETBL
11318C                     --MAXTEX
11319C                     --IBUGP2 ('ON' OR 'OFF' )
11320C     OUTPUT ARGUMENTS--ITEBLI (A CHARACTER VECTOR)
11321C                     --IFOUND ('YES' OR 'NO' )
11322C                     --IERROR ('YES' OR 'NO' )
11323C     WRITTEN BY--JAMES J. FILLIBEN
11324C                 STATISTICAL ENGINEERING DIVISION
11325C                 INFORMATION TECHNOLOGY LABORATORY
11326C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11327C                 GAITHERSBURG, MD 20899-8980
11328C                 PHONE--301-975-2899
11329C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11330C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11331C     LANGUAGE--ANSI FORTRAN (1977)
11332C     VERSION NUMBER--82/7
11333C     ORIGINAL VERSION--DECEMBER  1983.
11334C     UPDATED         --AUGUST    1995.  DASH2 BUG
11335C
11336C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11337C
11338      CHARACTER*4 IHARG
11339CCCCC AUGUST 1995.  ADD FOLLOWING LINE
11340      CHARACTER*4 IHARG2
11341      CHARACTER*4 IDETBL
11342      CHARACTER*4 ITEBLI
11343C
11344      CHARACTER*4 IBUGP2
11345      CHARACTER*4 IFOUND
11346      CHARACTER*4 IERROR
11347C
11348      CHARACTER*4 IHOLD1
11349      CHARACTER*4 IHOLD2
11350C
11351      CHARACTER*4 ISUBN1
11352      CHARACTER*4 ISUBN2
11353      CHARACTER*4 ISTEPN
11354C
11355      DIMENSION IHARG(*)
11356CCCCC AUGUST 1995.  ADD FOLLOWING LINE
11357      DIMENSION IHARG2(*)
11358      DIMENSION ITEBLI(*)
11359C
11360C-----COMMON----------------------------------------------------------
11361C
11362      INCLUDE 'DPCOP2.INC'
11363C
11364C-----START POINT-----------------------------------------------------
11365C
11366      IFOUND='NO'
11367      IERROR='NO'
11368      ISUBN1='DPTB'
11369      ISUBN2='LI  '
11370C
11371      NUMTEX=0
11372      IHOLD1='-999'
11373      IHOLD2='-999'
11374C
11375      IF(IBUGP2.EQ.'OFF')GOTO90
11376      WRITE(ICOUT,999)
11377  999 FORMAT(1X)
11378      CALL DPWRST('XXX','BUG ')
11379      WRITE(ICOUT,51)
11380   51 FORMAT('***** AT THE BEGINNING OF DPTBLI--')
11381      CALL DPWRST('XXX','BUG ')
11382      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
11383   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11384      CALL DPWRST('XXX','BUG ')
11385      WRITE(ICOUT,53)MAXTEX,NUMTEX
11386   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11387      CALL DPWRST('XXX','BUG ')
11388      WRITE(ICOUT,54)IHOLD1,IHOLD2
11389   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
11390      CALL DPWRST('XXX','BUG ')
11391      WRITE(ICOUT,55)IDETBL
11392   55 FORMAT('IDETBL = ',A4)
11393      CALL DPWRST('XXX','BUG ')
11394      WRITE(ICOUT,60)NUMARG
11395   60 FORMAT('NUMARG = ',I8)
11396      CALL DPWRST('XXX','BUG ')
11397      DO65I=1,NUMARG
11398      WRITE(ICOUT,66)IHARG(I)
11399   66 FORMAT('IHARG(I) = ',A4)
11400      CALL DPWRST('XXX','BUG ')
11401   65 CONTINUE
11402      WRITE(ICOUT,70)ITEBLI(1)
11403   70 FORMAT('ITEBLI(1) = ',A4)
11404      CALL DPWRST('XXX','BUG ')
11405      DO75I=1,10
11406      WRITE(ICOUT,76)I,ITEBLI(I)
11407   76 FORMAT('I,ITEBLI(I) = ',I8,2X,A4)
11408      CALL DPWRST('XXX','BUG ')
11409   75 CONTINUE
11410   90 CONTINUE
11411C
11412C               **************************************
11413C               **  STEP 1--                        **
11414C               **  BRANCH TO THE APPROPRIATE CASE  **
11415C               **************************************
11416C
11417      ISTEPN='1'
11418      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11419C
11420      IF(NUMARG.LE.2)GOTO9000
11421      IF(NUMARG.EQ.3)GOTO1130
11422      IF(NUMARG.EQ.4)GOTO1140
11423      IF(NUMARG.EQ.5)GOTO1150
11424      GOTO1160
11425C
11426 1130 CONTINUE
11427      GOTO1200
11428C
11429 1140 CONTINUE
11430      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
11431      IF(IHARG(5).EQ.'ALL')GOTO1300
11432      GOTO1200
11433C
11434 1150 CONTINUE
11435CCCCC IF(IHARG(5).EQ.'ALL')IHOLD1=IHARG(6)
11436CCCCC IF(IHARG(5).EQ.'ALL')GOTO1300
11437CCCCC IF(IHARG(6).EQ.'ALL')IHOLD1=IHARG(5)
11438CCCCC IF(IHARG(6).EQ.'ALL')GOTO1300
11439CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
11440      IF(IHARG(5).EQ.'ALL')THEN
11441        IHOLD1=IHARG(6)
11442        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
11443        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
11444        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
11445        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
11446        GOTO1300
11447      ENDIF
11448      IF(IHARG(6).EQ.'ALL')THEN
11449        IHOLD1=IHARG(5)
11450        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
11451        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
11452        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
11453        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
11454        GOTO1300
11455      ENDIF
11456      GOTO1200
11457C
11458 1160 CONTINUE
11459      GOTO1200
11460C
11461C               *************************************************
11462C               **  STEP 2--                                   **
11463C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
11464C               *************************************************
11465C
11466 1200 CONTINUE
11467      ISTEPN='2'
11468      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11469C
11470      IF(NUMARG.LE.3)GOTO1210
11471      GOTO1220
11472C
11473 1210 CONTINUE
11474      NUMTEX=1
11475      ITEBLI(1)='    '
11476      GOTO1270
11477C
11478 1220 CONTINUE
11479      NUMTEX=NUMARG-3
11480      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
11481      DO1225I=1,NUMTEX
11482      J=I+3
11483      IHOLD1=IHARG(J)
11484      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
11485      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
11486      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
11487      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
11488      IHOLD2=IHOLD1
11489      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
11490      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
11491      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETBL
11492      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETBL
11493      ITEBLI(I)=IHOLD2
11494 1225 CONTINUE
11495      GOTO1270
11496C
11497 1270 CONTINUE
11498      IF(IFEEDB.EQ.'OFF')GOTO1279
11499      WRITE(ICOUT,999)
11500      CALL DPWRST('XXX','BUG ')
11501      DO1278I=1,NUMTEX
11502      WRITE(ICOUT,1276)I,ITEBLI(I)
11503 1276 FORMAT('THE LINE TYPE FOR TEXT BORDER ',I6,
11504     1' HAS JUST BEEN SET TO ',A4)
11505      CALL DPWRST('XXX','BUG ')
11506 1278 CONTINUE
11507 1279 CONTINUE
11508      IFOUND='YES'
11509      GOTO9000
11510C
11511C               **************************
11512C               **  STEP 3--            **
11513C               **  TREAT THE ALL CASE  **
11514C               **************************
11515C
11516 1300 CONTINUE
11517      ISTEPN='3'
11518      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11519C
11520      NUMTEX=MAXTEX
11521      IHOLD2=IHOLD1
11522      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
11523      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
11524      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETBL
11525      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETBL
11526      DO1315I=1,NUMTEX
11527      ITEBLI(I)=IHOLD2
11528 1315 CONTINUE
11529      GOTO1370
11530C
11531 1370 CONTINUE
11532      IF(IFEEDB.EQ.'OFF')GOTO1319
11533      WRITE(ICOUT,999)
11534      CALL DPWRST('XXX','BUG ')
11535      I=1
11536      WRITE(ICOUT,1316)ITEBLI(I)
11537 1316 FORMAT('THE LINE TYPE FOR ALL TEXT BORDERS',
11538     1' HAS JUST BEEN SET TO ',A4)
11539      CALL DPWRST('XXX','BUG ')
11540 1319 CONTINUE
11541      IFOUND='YES'
11542      GOTO9000
11543C
11544C               *****************
11545C               **  STEP 90--  **
11546C               **  EXIT       **
11547C               *****************
11548C
11549 9000 CONTINUE
11550      IF(IBUGP2.EQ.'OFF')GOTO9090
11551      WRITE(ICOUT,9011)
11552 9011 FORMAT('***** AT THE END       OF DPTBLI--')
11553      CALL DPWRST('XXX','BUG ')
11554      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
11555 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11556      CALL DPWRST('XXX','BUG ')
11557      WRITE(ICOUT,9013)MAXTEX,NUMTEX
11558 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11559      CALL DPWRST('XXX','BUG ')
11560      WRITE(ICOUT,9014)IHOLD1,IHOLD2
11561 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
11562      CALL DPWRST('XXX','BUG ')
11563      WRITE(ICOUT,9015)IDETBL
11564 9015 FORMAT('IDETBL = ',A4)
11565      CALL DPWRST('XXX','BUG ')
11566      WRITE(ICOUT,9020)NUMARG
11567 9020 FORMAT('NUMARG = ',I8)
11568      CALL DPWRST('XXX','BUG ')
11569      DO9025I=1,NUMARG
11570      WRITE(ICOUT,9026)IHARG(I)
11571 9026 FORMAT('IHARG(I) = ',A4)
11572      CALL DPWRST('XXX','BUG ')
11573 9025 CONTINUE
11574      WRITE(ICOUT,9030)ITEBLI(1)
11575 9030 FORMAT('ITEBLI(1) = ',A4)
11576      CALL DPWRST('XXX','BUG ')
11577      DO9035I=1,10
11578      WRITE(ICOUT,9036)I,ITEBLI(I)
11579 9036 FORMAT('I,ITEBLI(I) = ',I8,2X,A4)
11580      CALL DPWRST('XXX','BUG ')
11581 9035 CONTINUE
11582 9090 CONTINUE
11583C
11584      RETURN
11585      END
11586      SUBROUTINE DPTBTH(IHARG,IARGT,ARG,NUMARG,PDETBT,MAXTEX,PTEBTH,
11587     1IBUGP2,IFOUND,IERROR)
11588C
11589C     PURPOSE--DEFINE THE TEXT (BORDER) LINE THICKNESSES = THE THICKNESSES
11590C              OF THE BORDER LINE AROUND THE TEXTS.
11591C              THESE ARE LOCATED IN THE VECTOR PTEBTH(.).
11592C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
11593C                     --IARGT  (A  CHARACTER VECTOR)
11594C                     --ARG
11595C                     --NUMARG
11596C                     --PDETBT
11597C                     --MAXTEX
11598C                     --IBUGP2 ('ON' OR 'OFF' )
11599C     OUTPUT ARGUMENTS--PTEBTH (A FLOATING POINT VECTOR)
11600C                     --IFOUND ('YES' OR 'NO' )
11601C                     --IERROR ('YES' OR 'NO' )
11602C     WRITTEN BY--JAMES J. FILLIBEN
11603C                 STATISTICAL ENGINEERING DIVISION
11604C                 INFORMATION TECHNOLOGY LABORATORY
11605C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11606C                 GAITHERSBURG, MD 20899-8980
11607C                 PHONE--301-975-2899
11608C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11609C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11610C     LANGUAGE--ANSI FORTRAN (1977)
11611C     VERSION NUMBER--82/7
11612C     ORIGINAL VERSION--DECEMBER  1983.
11613C
11614C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11615C
11616      CHARACTER*4 IHARG
11617      CHARACTER*4 IARGT
11618C
11619      CHARACTER*4 IBUGP2
11620      CHARACTER*4 IFOUND
11621      CHARACTER*4 IERROR
11622C
11623      CHARACTER*4 IHOLD1
11624C
11625      CHARACTER*4 ISUBN1
11626      CHARACTER*4 ISUBN2
11627      CHARACTER*4 ISTEPN
11628C
11629      DIMENSION IHARG(*)
11630      DIMENSION IARGT(*)
11631      DIMENSION ARG(*)
11632      DIMENSION PTEBTH(*)
11633C
11634C-----COMMON----------------------------------------------------------
11635C
11636      INCLUDE 'DPCOP2.INC'
11637C
11638C-----START POINT-----------------------------------------------------
11639C
11640      IFOUND='NO'
11641      IERROR='NO'
11642      ISUBN1='DPTB'
11643      ISUBN2='TH  '
11644C
11645      NUMTEX=0
11646      IHOLD1='-999'
11647      HOLD1=-999.0
11648      HOLD2=-999.0
11649C
11650      IF(IBUGP2.EQ.'OFF')GOTO90
11651      WRITE(ICOUT,999)
11652  999 FORMAT(1X)
11653      CALL DPWRST('XXX','BUG ')
11654      WRITE(ICOUT,51)
11655   51 FORMAT('***** AT THE BEGINNING OF DPTBTH--')
11656      CALL DPWRST('XXX','BUG ')
11657      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
11658   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11659      CALL DPWRST('XXX','BUG ')
11660      WRITE(ICOUT,53)MAXTEX,NUMTEX
11661   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11662      CALL DPWRST('XXX','BUG ')
11663      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
11664   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
11665      CALL DPWRST('XXX','BUG ')
11666      WRITE(ICOUT,55)PDETBT
11667   55 FORMAT('PDETBT = ',E15.7)
11668      CALL DPWRST('XXX','BUG ')
11669      WRITE(ICOUT,60)NUMARG
11670   60 FORMAT('NUMARG = ',I8)
11671      CALL DPWRST('XXX','BUG ')
11672      DO65I=1,NUMARG
11673      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
11674   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
11675      CALL DPWRST('XXX','BUG ')
11676   65 CONTINUE
11677      WRITE(ICOUT,70)PTEBTH(1)
11678   70 FORMAT('PTEBTH(1) = ',E15.7)
11679      CALL DPWRST('XXX','BUG ')
11680      DO75I=1,10
11681      WRITE(ICOUT,76)I,PTEBTH(I)
11682   76 FORMAT('I,PTEBTH(I) = ',I8,2X,E15.7)
11683      CALL DPWRST('XXX','BUG ')
11684   75 CONTINUE
11685   90 CONTINUE
11686C
11687C               **************************************
11688C               **  STEP 1--                        **
11689C               **  BRANCH TO THE APPROPRIATE CASE  **
11690C               **************************************
11691C
11692      ISTEPN='1'
11693      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11694C
11695      IF(NUMARG.LE.1)GOTO9000
11696      IF(NUMARG.EQ.2)GOTO1120
11697      IF(NUMARG.EQ.3)GOTO1130
11698      IF(NUMARG.EQ.4)GOTO1140
11699      GOTO1150
11700C
11701 1120 CONTINUE
11702      GOTO1200
11703C
11704 1130 CONTINUE
11705      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
11706      IF(IHARG(3).EQ.'ALL')HOLD1=PDETBT
11707      IF(IHARG(3).EQ.'ALL')GOTO1300
11708      GOTO1200
11709C
11710 1140 CONTINUE
11711      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
11712      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
11713      IF(IHARG(3).EQ.'ALL')GOTO1300
11714      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
11715      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
11716      IF(IHARG(4).EQ.'ALL')GOTO1300
11717      GOTO1200
11718C
11719 1150 CONTINUE
11720      GOTO1200
11721C
11722C               *************************************************
11723C               **  STEP 2--                                   **
11724C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
11725C               *************************************************
11726C
11727 1200 CONTINUE
11728      ISTEPN='2'
11729      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11730C
11731      IF(NUMARG.LE.2)GOTO1210
11732      GOTO1220
11733C
11734 1210 CONTINUE
11735      NUMTEX=1
11736      PTEBTH(1)=PDETBT
11737      GOTO1270
11738C
11739 1220 CONTINUE
11740      NUMTEX=NUMARG-2
11741      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
11742      DO1225I=1,NUMTEX
11743      J=I+2
11744      IHOLD1=IHARG(J)
11745      HOLD1=ARG(J)
11746      HOLD2=HOLD1
11747      IF(IHOLD1.EQ.'ON')HOLD2=PDETBT
11748      IF(IHOLD1.EQ.'OFF')HOLD2=PDETBT
11749      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETBT
11750      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETBT
11751      PTEBTH(I)=HOLD2
11752 1225 CONTINUE
11753      GOTO1270
11754C
11755 1270 CONTINUE
11756      IF(IFEEDB.EQ.'OFF')GOTO1279
11757      WRITE(ICOUT,999)
11758      CALL DPWRST('XXX','BUG ')
11759      DO1278I=1,NUMTEX
11760      WRITE(ICOUT,1276)I,PTEBTH(I)
11761 1276 FORMAT('THE THICKNESS OF TEXT BORDER ',I6,
11762     1' HAS JUST BEEN SET TO ',E15.7)
11763      CALL DPWRST('XXX','BUG ')
11764 1278 CONTINUE
11765 1279 CONTINUE
11766      IFOUND='YES'
11767      GOTO9000
11768C
11769C               **************************
11770C               **  STEP 3--            **
11771C               **  TREAT THE ALL CASE  **
11772C               **************************
11773C
11774 1300 CONTINUE
11775      ISTEPN='3'
11776      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11777C
11778      NUMTEX=MAXTEX
11779      HOLD2=HOLD1
11780      IF(IHOLD1.EQ.'ON')HOLD2=PDETBT
11781      IF(IHOLD1.EQ.'OFF')HOLD2=PDETBT
11782      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETBT
11783      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETBT
11784      DO1315I=1,NUMTEX
11785      PTEBTH(I)=HOLD2
11786 1315 CONTINUE
11787      GOTO1370
11788C
11789 1370 CONTINUE
11790      IF(IFEEDB.EQ.'OFF')GOTO1319
11791      WRITE(ICOUT,999)
11792      CALL DPWRST('XXX','BUG ')
11793      I=1
11794      WRITE(ICOUT,1316)PTEBTH(I)
11795 1316 FORMAT('THE THICKNESS OF ALL TEXT BORDERS',
11796     1' HAS JUST BEEN SET TO ',E15.7)
11797      CALL DPWRST('XXX','BUG ')
11798 1319 CONTINUE
11799      IFOUND='YES'
11800      GOTO9000
11801C
11802C               *****************
11803C               **  STEP 90--  **
11804C               **  EXIT       **
11805C               *****************
11806C
11807 9000 CONTINUE
11808      IF(IBUGP2.EQ.'OFF')GOTO9090
11809      WRITE(ICOUT,9011)
11810 9011 FORMAT('***** AT THE END       OF DPTBTH--')
11811      CALL DPWRST('XXX','BUG ')
11812      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
11813 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
11814      CALL DPWRST('XXX','BUG ')
11815      WRITE(ICOUT,9013)MAXTEX,NUMTEX
11816 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
11817      CALL DPWRST('XXX','BUG ')
11818      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
11819 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
11820      CALL DPWRST('XXX','BUG ')
11821      WRITE(ICOUT,9015)PDETBT
11822 9015 FORMAT('PDETBT = ',E15.7)
11823      CALL DPWRST('XXX','BUG ')
11824      WRITE(ICOUT,9020)NUMARG
11825 9020 FORMAT('NUMARG = ',I8)
11826      CALL DPWRST('XXX','BUG ')
11827      DO9025I=1,NUMARG
11828      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
11829 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
11830      CALL DPWRST('XXX','BUG ')
11831 9025 CONTINUE
11832      WRITE(ICOUT,9030)PTEBTH(1)
11833 9030 FORMAT('PTEBTH(1) = ',E15.7)
11834      CALL DPWRST('XXX','BUG ')
11835      DO9035I=1,10
11836      WRITE(ICOUT,9036)I,PTEBTH(I)
11837 9036 FORMAT('I,PTEBTH(I) = ',I8,2X,E15.7)
11838      CALL DPWRST('XXX','BUG ')
11839 9035 CONTINUE
11840 9090 CONTINUE
11841C
11842      RETURN
11843      END
11844      SUBROUTINE DPTCCL(ICOM,IHARG,NUMARG,
11845     1IDEFCO,
11846     1IX1TCO,IX2TCO,IY1TCO,IY2TCO,
11847     1IFOUND,IERROR)
11848C
11849C     PURPOSE--DEFINE THE TIC MARK COLOR SWITCHES
11850C              FOR ANY OF THE 4 FRAME LINES.
11851C              SUCH TIC MARK SWITCHES DESCRIBE
11852C              THE TIC MARK COLOR ON THE 4 FRAME LINES OF A PLOT.
11853C              THE CONTENTS OF A TIC MARK COLOR SWITCH ARE
11854C              A COLOR.
11855C              THE TIC MARK COLOR SWITCHES FOR THE 4 FRAME LINES
11856C              ARE CONTAINED IN THE 4 VARIABLES
11857C              IX1TCO,IX2TCO,IY1TCO,IY2TCO
11858C     INPUT  ARGUMENTS--ICOM
11859C                     --IHARG  (A  HOLLERITH VECTOR)
11860C                     --NUMARG
11861C                     --IDEFCO
11862C     OUTPUT ARGUMENTS--IX1TCO = COLOR FOR BOTTOM HORIZ. TICS
11863C                     --IX2TCO = COLOR FOR TOP    HORIZ. TICS
11864C                     --IY1TCO = COLOR FOR LEFT   VERT.  TICS
11865C                     --IY2TCO = COLOR FOR RIGHT  VERT.  TICS
11866C                     --IFOUND ('YES' OR 'NO' )
11867C                     --IERROR ('YES' OR 'NO' )
11868C     WRITTEN BY--JAMES J. FILLIBEN
11869C                 STATISTICAL ENGINEERING DIVISION
11870C                 INFORMATION TECHNOLOGY LABORATORY
11871C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11872C                 GAITHERSBURG, MD 20899-8980
11873C                 PHONE--301-975-2899
11874C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11875C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11876C     LANGUAGE--ANSI FORTRAN (1977)
11877C     VERSION NUMBER--82/7
11878C     ORIGINAL VERSION--OCTOBER   1980.
11879C     UPDATED         --MAY       1982.
11880C
11881C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
11882C
11883      CHARACTER*4 ICOM
11884      CHARACTER*4 IHARG
11885C
11886      CHARACTER*4 IDEFCO
11887C
11888      CHARACTER*4 IX1TCO
11889      CHARACTER*4 IX2TCO
11890      CHARACTER*4 IY1TCO
11891      CHARACTER*4 IY2TCO
11892C
11893      CHARACTER*4 IFOUND
11894      CHARACTER*4 IERROR
11895C
11896      CHARACTER*4 IHOLD
11897C
11898C---------------------------------------------------------------------
11899C
11900      DIMENSION IHARG(*)
11901C
11902C-----COMMON----------------------------------------------------------
11903C
11904      INCLUDE 'DPCOP2.INC'
11905C
11906C-----START POINT-----------------------------------------------------
11907C
11908      IFOUND='NO'
11909      IERROR='NO'
11910C
11911      IF(NUMARG.LE.0)GOTO1900
11912      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1090
11913      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
11914     1IHARG(2).EQ.'COLO')GOTO1090
11915      GOTO1900
11916 1090 CONTINUE
11917C
11918C               *****************************************************
11919C               **  TREAT THE CASE WHEN                            **
11920C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
11921C               *****************************************************
11922C
11923      IF(ICOM.EQ.'XTIC')GOTO1100
11924      GOTO1199
11925C
11926 1100 CONTINUE
11927      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
11928      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
11929      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
11930      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
11931      IF(IHARG(NUMARG).EQ.'COLO')GOTO1150
11932      GOTO1160
11933C
11934 1150 CONTINUE
11935      IHOLD=IDEFCO
11936      GOTO1180
11937C
11938 1160 CONTINUE
11939      IHOLD=IHARG(NUMARG)
11940      GOTO1180
11941C
11942 1180 CONTINUE
11943      IFOUND='YES'
11944      IX1TCO=IHOLD
11945      IX2TCO=IHOLD
11946C
11947      IF(IFEEDB.EQ.'OFF')GOTO1189
11948      WRITE(ICOUT,999)
11949  999 FORMAT(1X)
11950      CALL DPWRST('XXX','BUG ')
11951      WRITE(ICOUT,1181)
11952 1181 FORMAT('THE TIC MARK COLOR (FOR BOTH HORIZONTAL ',
11953     1'FRAME LINES)')
11954      CALL DPWRST('XXX','BUG ')
11955      WRITE(ICOUT,1182)IHOLD
11956 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
11957      CALL DPWRST('XXX','BUG ')
11958 1189 CONTINUE
11959      GOTO1900
11960C
11961 1199 CONTINUE
11962C
11963C               **************************************************************
11964C               **  TREAT THE CASE WHEN                                     **
11965C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
11966C               **************************************************************
11967C
11968      IF(ICOM.EQ.'X1TI')GOTO1200
11969      GOTO1299
11970C
11971 1200 CONTINUE
11972      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
11973      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
11974      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
11975      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
11976      IF(IHARG(NUMARG).EQ.'COLO')GOTO1250
11977      GOTO1260
11978C
11979 1250 CONTINUE
11980      IHOLD=IDEFCO
11981      GOTO1280
11982C
11983 1260 CONTINUE
11984      IHOLD=IHARG(NUMARG)
11985      GOTO1280
11986C
11987 1280 CONTINUE
11988      IFOUND='YES'
11989      IX1TCO=IHOLD
11990C
11991      IF(IFEEDB.EQ.'OFF')GOTO1289
11992      WRITE(ICOUT,999)
11993      CALL DPWRST('XXX','BUG ')
11994      WRITE(ICOUT,1281)
11995 1281 FORMAT('THE TIC MARK COLOR (FOR THE BOTTOM HORIZONTAL ',
11996     1'FRAME LINE)')
11997      CALL DPWRST('XXX','BUG ')
11998      WRITE(ICOUT,1282)IHOLD
11999 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
12000      CALL DPWRST('XXX','BUG ')
12001 1289 CONTINUE
12002      GOTO1900
12003C
12004 1299 CONTINUE
12005C
12006C               **************************************************************
12007C               **  TREAT THE CASE WHEN                                     **
12008C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
12009C               **************************************************************
12010C
12011      IF(ICOM.EQ.'X2TI')GOTO1300
12012      GOTO1399
12013C
12014 1300 CONTINUE
12015      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
12016      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
12017      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
12018      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
12019      IF(IHARG(NUMARG).EQ.'COLO')GOTO1350
12020      GOTO1360
12021C
12022 1350 CONTINUE
12023      IHOLD=IDEFCO
12024      GOTO1380
12025C
12026 1360 CONTINUE
12027      IHOLD=IHARG(NUMARG)
12028      GOTO1380
12029C
12030 1380 CONTINUE
12031      IFOUND='YES'
12032      IX2TCO=IHOLD
12033C
12034      IF(IFEEDB.EQ.'OFF')GOTO1389
12035      WRITE(ICOUT,999)
12036      CALL DPWRST('XXX','BUG ')
12037      WRITE(ICOUT,1381)
12038 1381 FORMAT('THE TIC MARK COLOR (FOR THE TOP HORIZONTAL ',
12039     1'FRAME LINE)')
12040      CALL DPWRST('XXX','BUG ')
12041      WRITE(ICOUT,1382)IHOLD
12042 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
12043      CALL DPWRST('XXX','BUG ')
12044 1389 CONTINUE
12045      GOTO1900
12046C
12047 1399 CONTINUE
12048C
12049C               *****************************************************
12050C               **  TREAT THE CASE WHEN                            **
12051C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
12052C               *****************************************************
12053C
12054      IF(ICOM.EQ.'YTIC')GOTO1400
12055      GOTO1499
12056C
12057 1400 CONTINUE
12058      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
12059      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
12060      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
12061      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
12062      IF(IHARG(NUMARG).EQ.'COLO')GOTO1450
12063      GOTO1460
12064C
12065 1450 CONTINUE
12066      IHOLD=IDEFCO
12067      GOTO1480
12068C
12069 1460 CONTINUE
12070      IHOLD=IHARG(NUMARG)
12071      GOTO1480
12072C
12073 1480 CONTINUE
12074      IFOUND='YES'
12075      IY1TCO=IHOLD
12076      IY2TCO=IHOLD
12077C
12078      IF(IFEEDB.EQ.'OFF')GOTO1489
12079      WRITE(ICOUT,999)
12080      CALL DPWRST('XXX','BUG ')
12081      WRITE(ICOUT,1481)
12082 1481 FORMAT('THE TIC MARK COLOR (FOR BOTH VERTICAL ',
12083     1'FRAME LINES)')
12084      CALL DPWRST('XXX','BUG ')
12085      WRITE(ICOUT,1482)IHOLD
12086 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
12087      CALL DPWRST('XXX','BUG ')
12088 1489 CONTINUE
12089      GOTO1900
12090C
12091 1499 CONTINUE
12092C
12093C               **************************************************************
12094C               **  TREAT THE CASE WHEN                                     **
12095C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
12096C               **************************************************************
12097C
12098      IF(ICOM.EQ.'Y1TI')GOTO1500
12099      GOTO1599
12100C
12101 1500 CONTINUE
12102      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
12103      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
12104      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
12105      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
12106      IF(IHARG(NUMARG).EQ.'COLO')GOTO1550
12107      GOTO1560
12108C
12109 1550 CONTINUE
12110      IHOLD=IDEFCO
12111      GOTO1580
12112C
12113 1560 CONTINUE
12114      IHOLD=IHARG(NUMARG)
12115      GOTO1580
12116C
12117 1580 CONTINUE
12118      IFOUND='YES'
12119      IY1TCO=IHOLD
12120C
12121      IF(IFEEDB.EQ.'OFF')GOTO1589
12122      WRITE(ICOUT,999)
12123      CALL DPWRST('XXX','BUG ')
12124      WRITE(ICOUT,1581)
12125 1581 FORMAT('THE TIC MARK COLOR (FOR THE LEFT VERTICAL ',
12126     1'FRAME LINE)')
12127      CALL DPWRST('XXX','BUG ')
12128      WRITE(ICOUT,1582)IHOLD
12129 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
12130      CALL DPWRST('XXX','BUG ')
12131 1589 CONTINUE
12132      GOTO1900
12133C
12134 1599 CONTINUE
12135C
12136C               **************************************************************
12137C               **  TREAT THE CASE WHEN                                     **
12138C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
12139C               **************************************************************
12140C
12141      IF(ICOM.EQ.'Y2TI')GOTO1600
12142      GOTO1699
12143C
12144 1600 CONTINUE
12145      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
12146      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
12147      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
12148      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
12149      IF(IHARG(NUMARG).EQ.'COLO')GOTO1650
12150      GOTO1660
12151C
12152 1650 CONTINUE
12153      IHOLD=IDEFCO
12154      GOTO1680
12155C
12156 1660 CONTINUE
12157      IHOLD=IHARG(NUMARG)
12158      GOTO1680
12159C
12160 1680 CONTINUE
12161      IFOUND='YES'
12162      IY2TCO=IHOLD
12163C
12164      IF(IFEEDB.EQ.'OFF')GOTO1689
12165      WRITE(ICOUT,999)
12166      CALL DPWRST('XXX','BUG ')
12167      WRITE(ICOUT,1681)
12168 1681 FORMAT('THE TIC MARK COLOR (FOR THE RIGHT VERTICAL ',
12169     1'FRAME LINE)')
12170      CALL DPWRST('XXX','BUG ')
12171      WRITE(ICOUT,1682)IHOLD
12172 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
12173      CALL DPWRST('XXX','BUG ')
12174 1689 CONTINUE
12175      GOTO1900
12176C
12177 1699 CONTINUE
12178C
12179C               *****************************************************
12180C               **  TREAT THE CASE WHEN                            **
12181C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
12182C               *****************************************************
12183C
12184      IF(ICOM.EQ.'TIC')GOTO1700
12185      IF(ICOM.EQ.'TICS')GOTO1700
12186      IF(ICOM.EQ.'XYTI')GOTO1700
12187      IF(ICOM.EQ.'YXTI')GOTO1700
12188      GOTO1799
12189C
12190 1700 CONTINUE
12191      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
12192      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
12193      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
12194      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
12195      IF(IHARG(NUMARG).EQ.'COLO')GOTO1750
12196      GOTO1760
12197C
12198 1750 CONTINUE
12199      IHOLD=IDEFCO
12200      GOTO1780
12201C
12202 1760 CONTINUE
12203      IHOLD=IHARG(NUMARG)
12204      GOTO1780
12205C
12206 1780 CONTINUE
12207      IFOUND='YES'
12208      IX1TCO=IHOLD
12209      IX2TCO=IHOLD
12210      IY1TCO=IHOLD
12211      IY2TCO=IHOLD
12212C
12213      IF(IFEEDB.EQ.'OFF')GOTO1789
12214      WRITE(ICOUT,999)
12215      CALL DPWRST('XXX','BUG ')
12216      WRITE(ICOUT,1781)
12217 1781 FORMAT('THE TIC MARK COLOR (FOR ALL 4 ',
12218     1'FRAME LINES)')
12219      CALL DPWRST('XXX','BUG ')
12220      WRITE(ICOUT,1782)IHOLD
12221 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
12222      CALL DPWRST('XXX','BUG ')
12223 1789 CONTINUE
12224      GOTO1900
12225C
12226 1799 CONTINUE
12227C
12228 1900 CONTINUE
12229      RETURN
12230      END
12231      SUBROUTINE DPTCDP(ICOM,IHARG,IARG,NUMARG,
12232     1                  IDEFDP,
12233     1                  IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP,
12234     1                  IFOUND,IERROR)
12235C
12236C     PURPOSE--DEFINE THE TIC MARK LABEL DECIMAL PLACES
12237C              FOR ANY OF THE 4 FRAME LINES.
12238C              SUCH TIC MARK LABEL SWITCHES DESCRIBE
12239C              THE NUMBER OF TIC MARK LABEL DECIMAL PLACES ON THE 4 FRAME LINES
12240C              THE CONTENTS OF A TIC MARK LABEL DECIMAL PLACE ARE
12241C              AN INTEGER NUMBER.
12242C              THE TIC MARK LABEL DECIMAL PLACES FOR THE 4 FRAME LINES
12243C              ARE CONTAINED IN THE 4 VARIABLES
12244C              IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP
12245C     INPUT  ARGUMENTS--ICOM
12246C                     --IHARG  (A  HOLLERITH VECTOR)
12247C                     --IARGT  (A  HOLLERITH VECTOR)
12248C                     --IARG  (AN INTEGER VECTOR)
12249C                     --NUMARG
12250C                     --IDEFDP
12251C     OUTPUT ARGUMENTS--IX1ZDP = NUM. DEC. FOR BOTTOM HORIZ. TIC LABELS
12252C                     --IX2ZDP = NUM. DEC. FOR TOP    HORIZ. TIC LABELS
12253C                     --IY1ZDP = NUM. DEC. FOR LEFT   VERT.  TIC LABELS
12254C                     --IY2ZDP = NUM. DEC. FOR RIGHT  VERT.  TIC LABELS
12255C                     --IFOUND ('YES' OR 'NO' )
12256C                     --IERROR ('YES' OR 'NO' )
12257C     WRITTEN BY--JAMES J. FILLIBEN
12258C                 STATISTICAL ENGINEERING DIVISION
12259C                 INFORMATION TECHNOLOGY LABORATORY
12260C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12261C                 GAITHERSBURG, MD 20899-8980
12262C                 PHONE--301-975-2899
12263C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12264C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12265C     LANGUAGE--ANSI FORTRAN (1977)
12266C     VERSION NUMBER--82/7
12267C     ORIGINAL VERSION--OCTOBER   1980.
12268C     UPDATED         --MAY       1982.
12269C
12270C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12271C
12272      CHARACTER*4 ICOM
12273      CHARACTER*4 IHARG
12274C
12275      CHARACTER*4 IFOUND
12276      CHARACTER*4 IERROR
12277C
12278C---------------------------------------------------------------------
12279C
12280      DIMENSION IHARG(*)
12281      DIMENSION IARG(*)
12282C
12283C-----COMMON----------------------------------------------------------
12284C
12285      INCLUDE 'DPCOP2.INC'
12286C
12287C-----START POINT-----------------------------------------------------
12288C
12289      IFOUND='NO'
12290      IERROR='NO'
12291C
12292      IF(IHARG(NUMARG).EQ.'?')GOTO8100
12293C
12294      IF(NUMARG.LE.0)GOTO9000
12295      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO1090
12296      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLAC')GOTO1090
12297      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DECI'.AND.
12298     1IHARG(2).EQ.'PLAC')GOTO1090
12299C
12300      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
12301     1IHARG(2).EQ.'DECI')GOTO1090
12302      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
12303     1IHARG(2).EQ.'PLAC')GOTO1090
12304C
12305      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
12306     1IHARG(2).EQ.'DECI')GOTO1090
12307      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
12308     1IHARG(2).EQ.'PLAC')GOTO1090
12309C
12310      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
12311     1IHARG(3).EQ.'PLAC')GOTO1090
12312CCCCC JUNE 1994.  FOLLOWING 3 LINES ADDED (FOR TIC MARK LABEL DECIMAL)
12313      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
12314     1IHARG(2).EQ.'LABE'.AND.
12315     1IHARG(3).EQ.'DECI')GOTO1090
12316      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'LABEL'.AND.
12317     1IHARG(3).EQ.'PLAC')GOTO1090
12318CCCCC JUNE 1994.  FOLLOWING 2 LINES ADDED (FOR TIC MARK LABEL DECIMAL)
12319      IF(NUMARG.GE.4.AND.IHARG(1).EQ.'MARK'.AND.
12320     1IHARG(4).EQ.'PLAC')GOTO1090
12321C
12322      GOTO9000
12323 1090 CONTINUE
12324C
12325C               *****************************************************
12326C               **  TREAT THE CASE WHEN                            **
12327C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
12328C               *****************************************************
12329C
12330      IF(ICOM.EQ.'XTIC')GOTO1100
12331      GOTO1199
12332C
12333 1100 CONTINUE
12334      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
12335      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
12336      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
12337      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
12338      IF(IHARG(NUMARG).EQ.'DECI')GOTO1150
12339      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1150
12340      GOTO1160
12341C
12342 1150 CONTINUE
12343      IHOLD=IDEFDP
12344      GOTO1180
12345C
12346 1160 CONTINUE
12347      IHOLD=IARG(NUMARG)
12348      GOTO1180
12349C
12350 1180 CONTINUE
12351      IFOUND='YES'
12352      IX1ZDP=IHOLD
12353      IX2ZDP=IHOLD
12354C
12355      IF(IFEEDB.EQ.'OFF')GOTO1189
12356      WRITE(ICOUT,999)
12357  999 FORMAT(1X)
12358      CALL DPWRST('XXX','BUG ')
12359      WRITE(ICOUT,1181)
12360 1181 FORMAT('THE TIC LABEL DECIMALS (FOR BOTH HORIZONTAL ',
12361     1'FRAME LINES)')
12362      CALL DPWRST('XXX','BUG ')
12363      WRITE(ICOUT,1182)IHOLD
12364 1182 FORMAT('HAVE JUST BEEN SET TO ',I8)
12365      CALL DPWRST('XXX','BUG ')
12366      IF(IHOLD.LT.0)WRITE(ICOUT,1183)
12367 1183 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
12368      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
12369 1189 CONTINUE
12370      GOTO9000
12371C
12372 1199 CONTINUE
12373C
12374C               **************************************************************
12375C               **  TREAT THE CASE WHEN                                     **
12376C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
12377C               **************************************************************
12378C
12379      IF(ICOM.EQ.'X1TI')GOTO1200
12380      GOTO1299
12381C
12382 1200 CONTINUE
12383      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
12384      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
12385      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
12386      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
12387      IF(IHARG(NUMARG).EQ.'DECI')GOTO1250
12388      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1250
12389      GOTO1260
12390C
12391 1250 CONTINUE
12392      IHOLD=IDEFDP
12393      GOTO1280
12394C
12395 1260 CONTINUE
12396      IHOLD=IARG(NUMARG)
12397      GOTO1280
12398C
12399 1280 CONTINUE
12400      IFOUND='YES'
12401      IX1ZDP=IHOLD
12402C
12403      IF(IFEEDB.EQ.'OFF')GOTO1289
12404      WRITE(ICOUT,999)
12405      CALL DPWRST('XXX','BUG ')
12406      WRITE(ICOUT,1281)
12407 1281 FORMAT('THE TIC LABEL DECIMALS (FOR THE BOTTOM HORIZONTAL ',
12408     1'FRAME LINE)')
12409      CALL DPWRST('XXX','BUG ')
12410      WRITE(ICOUT,1282)IHOLD
12411 1282 FORMAT('HAVE JUST BEEN SET TO ',I8)
12412      CALL DPWRST('XXX','BUG ')
12413      IF(IHOLD.LT.0)WRITE(ICOUT,1283)
12414 1283 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
12415      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
12416 1289 CONTINUE
12417      GOTO9000
12418C
12419 1299 CONTINUE
12420C
12421C               **************************************************************
12422C               **  TREAT THE CASE WHEN                                     **
12423C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
12424C               **************************************************************
12425C
12426      IF(ICOM.EQ.'X2TI')GOTO1300
12427      GOTO1399
12428C
12429 1300 CONTINUE
12430      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
12431      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
12432      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
12433      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
12434      IF(IHARG(NUMARG).EQ.'DECI')GOTO1350
12435      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1350
12436      GOTO1360
12437C
12438 1350 CONTINUE
12439      IHOLD=IDEFDP
12440      GOTO1380
12441C
12442 1360 CONTINUE
12443      IHOLD=IARG(NUMARG)
12444      GOTO1380
12445C
12446 1380 CONTINUE
12447      IFOUND='YES'
12448      IX2ZDP=IHOLD
12449C
12450      IF(IFEEDB.EQ.'OFF')GOTO1389
12451      WRITE(ICOUT,999)
12452      CALL DPWRST('XXX','BUG ')
12453      WRITE(ICOUT,1381)
12454 1381 FORMAT('THE TIC LABEL DECIMALS (FOR THE TOP HORIZONTAL ',
12455     1'FRAME LINE)')
12456      CALL DPWRST('XXX','BUG ')
12457      WRITE(ICOUT,1382)IHOLD
12458 1382 FORMAT('HAVE JUST BEEN SET TO ',I8)
12459      CALL DPWRST('XXX','BUG ')
12460      IF(IHOLD.LT.0)WRITE(ICOUT,1383)
12461 1383 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
12462      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
12463 1389 CONTINUE
12464      GOTO9000
12465C
12466 1399 CONTINUE
12467C
12468C               *****************************************************
12469C               **  TREAT THE CASE WHEN                            **
12470C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
12471C               *****************************************************
12472C
12473      IF(ICOM.EQ.'YTIC')GOTO1400
12474      GOTO1499
12475C
12476 1400 CONTINUE
12477      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
12478      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
12479      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
12480      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
12481      IF(IHARG(NUMARG).EQ.'DECI')GOTO1450
12482      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1450
12483      GOTO1460
12484C
12485 1450 CONTINUE
12486      IHOLD=IDEFDP
12487      GOTO1480
12488C
12489 1460 CONTINUE
12490      IHOLD=IARG(NUMARG)
12491      GOTO1480
12492C
12493 1480 CONTINUE
12494      IFOUND='YES'
12495      IY1ZDP=IHOLD
12496      IY2ZDP=IHOLD
12497C
12498      IF(IFEEDB.EQ.'OFF')GOTO1489
12499      WRITE(ICOUT,999)
12500      CALL DPWRST('XXX','BUG ')
12501      WRITE(ICOUT,1481)
12502 1481 FORMAT('THE TIC LABEL DECIMALS (FOR BOTH VERTICAL ',
12503     1'FRAME LINES)')
12504      CALL DPWRST('XXX','BUG ')
12505      WRITE(ICOUT,1482)IHOLD
12506 1482 FORMAT('HAVE JUST BEEN SET TO ',I8)
12507      CALL DPWRST('XXX','BUG ')
12508      IF(IHOLD.LT.0)WRITE(ICOUT,1483)
12509 1483 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
12510      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
12511 1489 CONTINUE
12512      GOTO9000
12513C
12514 1499 CONTINUE
12515C
12516C               **************************************************************
12517C               **  TREAT THE CASE WHEN                                     **
12518C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
12519C               **************************************************************
12520C
12521      IF(ICOM.EQ.'Y1TI')GOTO1500
12522      GOTO1599
12523C
12524 1500 CONTINUE
12525      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
12526      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
12527      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
12528      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
12529      IF(IHARG(NUMARG).EQ.'DECI')GOTO1550
12530      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1550
12531      GOTO1560
12532C
12533 1550 CONTINUE
12534      IHOLD=IDEFDP
12535      GOTO1580
12536C
12537 1560 CONTINUE
12538      IHOLD=IARG(NUMARG)
12539      GOTO1580
12540C
12541 1580 CONTINUE
12542      IFOUND='YES'
12543      IY1ZDP=IHOLD
12544C
12545      IF(IFEEDB.EQ.'OFF')GOTO1589
12546      WRITE(ICOUT,999)
12547      CALL DPWRST('XXX','BUG ')
12548      WRITE(ICOUT,1581)
12549 1581 FORMAT('THE TIC LABEL DECIMALS (FOR THE LEFT VERTICAL ',
12550     1'FRAME LINE)')
12551      CALL DPWRST('XXX','BUG ')
12552      WRITE(ICOUT,1582)IHOLD
12553 1582 FORMAT('HAVE JUST BEEN SET TO ',I8)
12554      CALL DPWRST('XXX','BUG ')
12555      IF(IHOLD.LT.0)WRITE(ICOUT,1583)
12556 1583 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
12557      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
12558 1589 CONTINUE
12559      GOTO9000
12560C
12561 1599 CONTINUE
12562C
12563C               **************************************************************
12564C               **  TREAT THE CASE WHEN                                     **
12565C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
12566C               **************************************************************
12567C
12568      IF(ICOM.EQ.'Y2TI')GOTO1600
12569      GOTO1699
12570C
12571 1600 CONTINUE
12572      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
12573      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
12574      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
12575      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
12576      IF(IHARG(NUMARG).EQ.'DECI')GOTO1650
12577      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1650
12578      GOTO1660
12579C
12580 1650 CONTINUE
12581      IHOLD=IDEFDP
12582      GOTO1680
12583C
12584 1660 CONTINUE
12585      IHOLD=IARG(NUMARG)
12586      GOTO1680
12587C
12588 1680 CONTINUE
12589      IFOUND='YES'
12590      IY2ZDP=IHOLD
12591C
12592      IF(IFEEDB.EQ.'OFF')GOTO1689
12593      WRITE(ICOUT,999)
12594      CALL DPWRST('XXX','BUG ')
12595      WRITE(ICOUT,1681)
12596 1681 FORMAT('THE TIC LABEL DECIMALS (FOR THE RIGHT VERTICAL ',
12597     1'FRAME LINE)')
12598      CALL DPWRST('XXX','BUG ')
12599      WRITE(ICOUT,1682)IHOLD
12600 1682 FORMAT('HAVE JUST BEEN SET TO ',I8)
12601      CALL DPWRST('XXX','BUG ')
12602      IF(IHOLD.LT.0)WRITE(ICOUT,1683)
12603 1683 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
12604      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
12605 1689 CONTINUE
12606      GOTO9000
12607C
12608 1699 CONTINUE
12609C
12610C               *****************************************************
12611C               **  TREAT THE CASE WHEN                            **
12612C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
12613C               *****************************************************
12614C
12615      IF(ICOM.EQ.'TIC')GOTO1700
12616      IF(ICOM.EQ.'TICS')GOTO1700
12617      IF(ICOM.EQ.'XYTI')GOTO1700
12618      IF(ICOM.EQ.'YXTI')GOTO1700
12619      GOTO1799
12620C
12621 1700 CONTINUE
12622      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
12623      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
12624      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
12625      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
12626      IF(IHARG(NUMARG).EQ.'DECI')GOTO1750
12627      IF(IHARG(NUMARG).EQ.'PLAC')GOTO1750
12628      GOTO1760
12629C
12630 1750 CONTINUE
12631      IHOLD=IDEFDP
12632      GOTO1780
12633C
12634 1760 CONTINUE
12635      IHOLD=IARG(NUMARG)
12636      GOTO1780
12637C
12638 1780 CONTINUE
12639      IFOUND='YES'
12640      IX1ZDP=IHOLD
12641      IX2ZDP=IHOLD
12642      IY1ZDP=IHOLD
12643      IY2ZDP=IHOLD
12644C
12645      IF(IFEEDB.EQ.'OFF')GOTO1789
12646      WRITE(ICOUT,999)
12647      CALL DPWRST('XXX','BUG ')
12648      WRITE(ICOUT,1781)
12649 1781 FORMAT('THE TIC LABEL DECIMALS (FOR ALL 4 ',
12650     1'FRAME LINES)')
12651      CALL DPWRST('XXX','BUG ')
12652      WRITE(ICOUT,1782)IHOLD
12653 1782 FORMAT('HAVE JUST BEEN SET TO ',I8)
12654      CALL DPWRST('XXX','BUG ')
12655      IF(IHOLD.LT.0)WRITE(ICOUT,1783)
12656 1783 FORMAT('THAT IS, THEY WILL FLOAT WITH THE VALUE AND BE NEAT.')
12657      IF(IHOLD.LT.0)CALL DPWRST('XXX','BUG ')
12658 1789 CONTINUE
12659      GOTO9000
12660C
12661 1799 CONTINUE
12662      GOTO9000
12663C
12664C               ********************************************
12665C               **  STEP 81--                             **
12666C               **  TREAT THE    ?    CASE--              **
12667C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
12668C               ********************************************
12669C
12670 8100 CONTINUE
12671      IFOUND='YES'
12672      WRITE(ICOUT,999)
12673      CALL DPWRST('XXX','BUG ')
12674      WRITE(ICOUT,8111)
12675 8111 FORMAT('THE CURRENT NUMBER OF TIC LABEL DECIMAL PLACES IS ')
12676      CALL DPWRST('XXX','BUG ')
12677      WRITE(ICOUT,8112)IX1ZDP
12678 8112 FORMAT('            --X1 (BOTTOM HORIZONTAL) = ',I8)
12679      CALL DPWRST('XXX','BUG ')
12680      WRITE(ICOUT,8113)IX2ZDP
12681 8113 FORMAT('            --X2 (TOP    HORIZONTAL) = ',I8)
12682      CALL DPWRST('XXX','BUG ')
12683      WRITE(ICOUT,8114)IY1ZDP
12684 8114 FORMAT('            --Y1 (LEFT   VERTICAL  ) = ',I8)
12685      CALL DPWRST('XXX','BUG ')
12686      WRITE(ICOUT,8115)IY2ZDP
12687 8115 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = ',I8)
12688      CALL DPWRST('XXX','BUG ')
12689      WRITE(ICOUT,999)
12690      CALL DPWRST('XXX','BUG ')
12691      WRITE(ICOUT,8116)
12692 8116 FORMAT('            --NEGATIVE VALUES INDICATE THE')
12693      CALL DPWRST('XXX','BUG ')
12694      WRITE(ICOUT,8117)
12695 8117 FORMAT('              NUMBER OF DECIMALS FLOAT AND NEAT')
12696      CALL DPWRST('XXX','BUG ')
12697      WRITE(ICOUT,999)
12698      CALL DPWRST('XXX','BUG ')
12699      WRITE(ICOUT,8121)
12700 8121 FORMAT('THE DEFAULT NUMBER OF TIC LABEL DECIMAL PLACES ARE ')
12701      CALL DPWRST('XXX','BUG ')
12702      WRITE(ICOUT,8122)
12703 8122 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
12704      CALL DPWRST('XXX','BUG ')
12705      WRITE(ICOUT,8123)
12706 8123 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
12707      CALL DPWRST('XXX','BUG ')
12708      WRITE(ICOUT,8124)
12709 8124 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
12710      CALL DPWRST('XXX','BUG ')
12711      WRITE(ICOUT,8125)
12712 8125 FORMAT('            --Y2 (BOTTOM VERTICAL  ) = FLOAT & NEAT')
12713      CALL DPWRST('XXX','BUG ')
12714      GOTO9000
12715C
12716C               *****************
12717C               **  STEP 90--  **
12718C               **  EXIT       **
12719C               *****************
12720C
12721 9000 CONTINUE
12722      RETURN
12723      END
12724      SUBROUTINE DPTCJU(ICOM,IHARG,NUMARG,
12725     1IX1TJU,IX2TJU,IY1TJU,IY2TJU,
12726     1IFOUND,IERROR)
12727C
12728C     PURPOSE--DEFINE THE TIC MARK JUSTIFICATION SWITCHES
12729C              FOR ANY OF THE 4 FRAME LINES.
12730C              SUCH TIC MARK SWITCHES DESCRIBE
12731C              THE TIC MARK JUSTIFICATION (THRU, IN, OR OUT) ON THE 4 FRAME LINE
12732C              THE CONTENTS OF A TIC MARK JUSTIFICATION SWITCH ARE
12733C              A JUSTIFICATION (THRU, IN, OR OUT).
12734C              THE TIC MARK JUSTIFICATION SWITCHES FOR THE 4 FRAME LINES
12735C              ARE CONTAINED IN THE 4 VARIABLES
12736C              IX1TJU,IX2TJU,IY1TJU,IY2TJU
12737C     INPUT  ARGUMENTS--ICOM
12738C                     --IHARG  (A  HOLLERITH VECTOR)
12739C                     --NUMARG
12740C     OUTPUT ARGUMENTS--IX1TJU = JUSTIFICATION FOR BOTTOM HORIZ. TICS
12741C                     --IX2TJU = JUSTIFICATION FOR TOP    HORIZ. TICS
12742C                     --IY1TJU = JUSTIFICATION FOR LEFT   VERT.  TICS
12743C                     --IY2TJU = JUSTIFICATION FOR RIGHT  VERT.  TICS
12744C                     --IFOUND ('YES' OR 'NO' )
12745C                     --IERROR ('YES' OR 'NO' )
12746C     WRITTEN BY--JAMES J. FILLIBEN
12747C                 STATISTICAL ENGINEERING DIVISION
12748C                 INFORMATION TECHNOLOGY LABORATORY
12749C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12750C                 GAITHERSBURG, MD 20899-8980
12751C                 PHONE--301-975-2899
12752C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12753C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12754C     LANGUAGE--ANSI FORTRAN (1977)
12755C     VERSION NUMBER--82/7
12756C     ORIGINAL VERSION--OCTOBER   1980.
12757C     UPDATED         --MAY       1982.
12758C
12759C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12760C
12761      CHARACTER*4 ICOM
12762      CHARACTER*4 IHARG
12763C
12764      CHARACTER*4 IX1TJU
12765      CHARACTER*4 IX2TJU
12766      CHARACTER*4 IY1TJU
12767      CHARACTER*4 IY2TJU
12768C
12769      CHARACTER*4 IFOUND
12770      CHARACTER*4 IERROR
12771C
12772C---------------------------------------------------------------------
12773C
12774      DIMENSION IHARG(*)
12775C
12776C-----COMMON----------------------------------------------------------
12777C
12778      INCLUDE 'DPCOP2.INC'
12779C
12780C-----START POINT-----------------------------------------------------
12781C
12782      IFOUND='NO'
12783      IERROR='NO'
12784C
12785      IF(NUMARG.LE.0)GOTO1900
12786      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'POSI')GOTO1090
12787      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
12788     1IHARG(2).EQ.'POSI')GOTO1090
12789      GOTO1900
12790 1090 CONTINUE
12791C
12792C               *****************************************************
12793C               **  TREAT THE CASE WHEN                            **
12794C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
12795C               *****************************************************
12796C
12797      IF(ICOM.EQ.'XTIC')GOTO1100
12798      GOTO1199
12799C
12800 1100 CONTINUE
12801      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
12802      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
12803      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
12804      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
12805      IF(IHARG(NUMARG).EQ.'POSI')GOTO1150
12806      IF(IHARG(NUMARG).EQ.'IN')GOTO1130
12807      IF(IHARG(NUMARG).EQ.'INSI')GOTO1130
12808      IF(IHARG(NUMARG).EQ.'OUT')GOTO1140
12809      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1140
12810      IF(IHARG(NUMARG).EQ.'THRO')GOTO1150
12811      IF(IHARG(NUMARG).EQ.'THRU')GOTO1150
12812      IF(IHARG(NUMARG).EQ.'CENT')GOTO1150
12813      IERROR='YES'
12814      GOTO1900
12815C
12816 1130 CONTINUE
12817      IFOUND='YES'
12818      IX1TJU='IN'
12819      IX2TJU='IN'
12820C
12821      IF(IFEEDB.EQ.'OFF')GOTO1139
12822      WRITE(ICOUT,999)
12823  999 FORMAT(1X)
12824      CALL DPWRST('XXX','BUG ')
12825      WRITE(ICOUT,1135)
12826 1135 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH HORIZONTAL ',
12827     1'FRAME LINES)')
12828      CALL DPWRST('XXX','BUG ')
12829      WRITE(ICOUT,1136)
12830 1136 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
12831      CALL DPWRST('XXX','BUG ')
12832 1139 CONTINUE
12833      GOTO1900
12834C
12835 1140 CONTINUE
12836      IFOUND='YES'
12837      IX1TJU='OUT'
12838      IX2TJU='OUT'
12839C
12840      IF(IFEEDB.EQ.'OFF')GOTO1149
12841      WRITE(ICOUT,999)
12842      CALL DPWRST('XXX','BUG ')
12843      WRITE(ICOUT,1145)
12844 1145 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH HORIZONTAL ',
12845     1'FRAME LINES)')
12846      CALL DPWRST('XXX','BUG ')
12847      WRITE(ICOUT,1146)
12848 1146 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
12849      CALL DPWRST('XXX','BUG ')
12850 1149 CONTINUE
12851      GOTO1900
12852C
12853 1150 CONTINUE
12854      IFOUND='YES'
12855      IX1TJU='THRU'
12856      IX2TJU='THRU'
12857C
12858      IF(IFEEDB.EQ.'OFF')GOTO1159
12859      WRITE(ICOUT,999)
12860      CALL DPWRST('XXX','BUG ')
12861      WRITE(ICOUT,1155)
12862 1155 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH HORIZONTAL ',
12863     1'FRAME LINES)')
12864      CALL DPWRST('XXX','BUG ')
12865      WRITE(ICOUT,1156)
12866 1156 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
12867      CALL DPWRST('XXX','BUG ')
12868 1159 CONTINUE
12869      GOTO1900
12870C
12871 1199 CONTINUE
12872C
12873C               **************************************************************
12874C               **  TREAT THE CASE WHEN                                     **
12875C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
12876C               **************************************************************
12877C
12878      IF(ICOM.EQ.'X1TI')GOTO1200
12879      GOTO1299
12880C
12881 1200 CONTINUE
12882      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
12883      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
12884      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
12885      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
12886      IF(IHARG(NUMARG).EQ.'POSI')GOTO1250
12887      IF(IHARG(NUMARG).EQ.'IN')GOTO1230
12888      IF(IHARG(NUMARG).EQ.'INSI')GOTO1230
12889      IF(IHARG(NUMARG).EQ.'OUT')GOTO1240
12890      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1240
12891      IF(IHARG(NUMARG).EQ.'THRO')GOTO1250
12892      IF(IHARG(NUMARG).EQ.'THRU')GOTO1250
12893      IF(IHARG(NUMARG).EQ.'CENT')GOTO1250
12894      IERROR='YES'
12895      GOTO1900
12896C
12897 1230 CONTINUE
12898      IFOUND='YES'
12899      IX1TJU='IN'
12900C
12901      IF(IFEEDB.EQ.'OFF')GOTO1239
12902      WRITE(ICOUT,999)
12903      CALL DPWRST('XXX','BUG ')
12904      WRITE(ICOUT,1235)
12905 1235 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE BOTTOM ',
12906     1'HORIZONTAL FRAME LINE)')
12907      CALL DPWRST('XXX','BUG ')
12908      WRITE(ICOUT,1236)
12909 1236 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
12910      CALL DPWRST('XXX','BUG ')
12911 1239 CONTINUE
12912      GOTO1900
12913C
12914 1240 CONTINUE
12915      IFOUND='YES'
12916      IX1TJU='OUT'
12917C
12918      IF(IFEEDB.EQ.'OFF')GOTO1249
12919      WRITE(ICOUT,999)
12920      CALL DPWRST('XXX','BUG ')
12921      WRITE(ICOUT,1245)
12922 1245 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE BOTTOM ',
12923     1'HORIZONTAL FRAME LINE)')
12924      CALL DPWRST('XXX','BUG ')
12925      WRITE(ICOUT,1246)
12926 1246 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
12927      CALL DPWRST('XXX','BUG ')
12928 1249 CONTINUE
12929      GOTO1900
12930C
12931 1250 CONTINUE
12932      IFOUND='YES'
12933      IX1TJU='THRU'
12934C
12935      IF(IFEEDB.EQ.'OFF')GOTO1259
12936      WRITE(ICOUT,999)
12937      CALL DPWRST('XXX','BUG ')
12938      WRITE(ICOUT,1255)
12939 1255 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE BOTTOM ',
12940     1'HORIZONTAL FRAME LINE)')
12941      CALL DPWRST('XXX','BUG ')
12942      WRITE(ICOUT,1256)
12943 1256 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
12944      CALL DPWRST('XXX','BUG ')
12945 1259 CONTINUE
12946      GOTO1900
12947C
12948 1299 CONTINUE
12949C
12950C               **************************************************************
12951C               **  TREAT THE CASE WHEN                                     **
12952C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
12953C               **************************************************************
12954C
12955      IF(ICOM.EQ.'X2TI')GOTO1300
12956      GOTO1399
12957C
12958 1300 CONTINUE
12959      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
12960      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
12961      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
12962      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
12963      IF(IHARG(NUMARG).EQ.'POSI')GOTO1350
12964      IF(IHARG(NUMARG).EQ.'IN')GOTO1330
12965      IF(IHARG(NUMARG).EQ.'INSI')GOTO1330
12966      IF(IHARG(NUMARG).EQ.'OUT')GOTO1340
12967      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1340
12968      IF(IHARG(NUMARG).EQ.'THRO')GOTO1350
12969      IF(IHARG(NUMARG).EQ.'THRU')GOTO1350
12970      IF(IHARG(NUMARG).EQ.'CENT')GOTO1350
12971      IERROR='YES'
12972      GOTO1900
12973C
12974 1330 CONTINUE
12975      IFOUND='YES'
12976      IX2TJU='IN'
12977C
12978      IF(IFEEDB.EQ.'OFF')GOTO1339
12979      WRITE(ICOUT,999)
12980      CALL DPWRST('XXX','BUG ')
12981      WRITE(ICOUT,1335)
12982 1335 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE TOP HORIZONTAL ',
12983     1'FRAME LINE)')
12984      CALL DPWRST('XXX','BUG ')
12985      WRITE(ICOUT,1336)
12986 1336 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
12987      CALL DPWRST('XXX','BUG ')
12988 1339 CONTINUE
12989      GOTO1900
12990C
12991 1340 CONTINUE
12992      IFOUND='YES'
12993      IX2TJU='OUT'
12994C
12995      IF(IFEEDB.EQ.'OFF')GOTO1349
12996      WRITE(ICOUT,999)
12997      CALL DPWRST('XXX','BUG ')
12998      WRITE(ICOUT,1345)
12999 1345 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE TOP HORIZONTAL ',
13000     1'FRAME LINE)')
13001      CALL DPWRST('XXX','BUG ')
13002      WRITE(ICOUT,1346)
13003 1346 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
13004      CALL DPWRST('XXX','BUG ')
13005 1349 CONTINUE
13006      GOTO1900
13007C
13008 1350 CONTINUE
13009      IFOUND='YES'
13010      IX2TJU='THRU'
13011C
13012      IF(IFEEDB.EQ.'OFF')GOTO1359
13013      WRITE(ICOUT,999)
13014      CALL DPWRST('XXX','BUG ')
13015      WRITE(ICOUT,1355)
13016 1355 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE TOP HORIZONTAL ',
13017     1'FRAME LINE)')
13018      CALL DPWRST('XXX','BUG ')
13019      WRITE(ICOUT,1356)
13020 1356 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
13021      CALL DPWRST('XXX','BUG ')
13022 1359 CONTINUE
13023      GOTO1900
13024C
13025 1399 CONTINUE
13026C
13027C               *****************************************************
13028C               **  TREAT THE CASE WHEN                            **
13029C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
13030C               *****************************************************
13031C
13032      IF(ICOM.EQ.'YTIC')GOTO1400
13033      GOTO1499
13034C
13035 1400 CONTINUE
13036      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
13037      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
13038      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
13039      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
13040      IF(IHARG(NUMARG).EQ.'POSI')GOTO1450
13041      IF(IHARG(NUMARG).EQ.'IN')GOTO1430
13042      IF(IHARG(NUMARG).EQ.'INSI')GOTO1430
13043      IF(IHARG(NUMARG).EQ.'OUT')GOTO1440
13044      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1440
13045      IF(IHARG(NUMARG).EQ.'THRO')GOTO1450
13046      IF(IHARG(NUMARG).EQ.'THRU')GOTO1450
13047      IF(IHARG(NUMARG).EQ.'CENT')GOTO1450
13048      IERROR='YES'
13049      GOTO1900
13050C
13051 1430 CONTINUE
13052      IFOUND='YES'
13053      IY1TJU='IN'
13054      IY2TJU='IN'
13055C
13056      IF(IFEEDB.EQ.'OFF')GOTO1439
13057      WRITE(ICOUT,999)
13058      CALL DPWRST('XXX','BUG ')
13059      WRITE(ICOUT,1435)
13060 1435 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH VERTICAL ',
13061     1'FRAME LINES)')
13062      CALL DPWRST('XXX','BUG ')
13063      WRITE(ICOUT,1436)
13064 1436 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
13065      CALL DPWRST('XXX','BUG ')
13066 1439 CONTINUE
13067      GOTO1900
13068C
13069 1440 CONTINUE
13070      IFOUND='YES'
13071      IY1TJU='OUT'
13072      IY2TJU='OUT'
13073C
13074      IF(IFEEDB.EQ.'OFF')GOTO1449
13075      WRITE(ICOUT,999)
13076      CALL DPWRST('XXX','BUG ')
13077      WRITE(ICOUT,1445)
13078 1445 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH VERTICAL ',
13079     1'FRAME LINES)')
13080      CALL DPWRST('XXX','BUG ')
13081      WRITE(ICOUT,1446)
13082 1446 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
13083      CALL DPWRST('XXX','BUG ')
13084 1449 CONTINUE
13085      GOTO1900
13086C
13087 1450 CONTINUE
13088      IFOUND='YES'
13089      IY1TJU='THRU'
13090      IY2TJU='THRU'
13091C
13092      IF(IFEEDB.EQ.'OFF')GOTO1459
13093      WRITE(ICOUT,999)
13094      CALL DPWRST('XXX','BUG ')
13095      WRITE(ICOUT,1455)
13096 1455 FORMAT('THE TIC MARK JUSTIFICATION (FOR BOTH VERTICAL ',
13097     1'FRAME LINES)')
13098      CALL DPWRST('XXX','BUG ')
13099      WRITE(ICOUT,1456)
13100 1456 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
13101      CALL DPWRST('XXX','BUG ')
13102 1459 CONTINUE
13103      GOTO1900
13104C
13105 1499 CONTINUE
13106C
13107C               **************************************************************
13108C               **  TREAT THE CASE WHEN                                     **
13109C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
13110C               **************************************************************
13111C
13112      IF(ICOM.EQ.'Y1TI')GOTO1500
13113      GOTO1599
13114C
13115 1500 CONTINUE
13116      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
13117      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
13118      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
13119      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
13120      IF(IHARG(NUMARG).EQ.'POSI')GOTO1550
13121      IF(IHARG(NUMARG).EQ.'IN')GOTO1530
13122      IF(IHARG(NUMARG).EQ.'INSI')GOTO1530
13123      IF(IHARG(NUMARG).EQ.'OUT')GOTO1540
13124      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1540
13125      IF(IHARG(NUMARG).EQ.'THRO')GOTO1550
13126      IF(IHARG(NUMARG).EQ.'THRU')GOTO1550
13127      IF(IHARG(NUMARG).EQ.'CENT')GOTO1550
13128      IERROR='YES'
13129      GOTO1900
13130C
13131 1530 CONTINUE
13132      IFOUND='YES'
13133      IY1TJU='IN'
13134C
13135      IF(IFEEDB.EQ.'OFF')GOTO1539
13136      WRITE(ICOUT,999)
13137      CALL DPWRST('XXX','BUG ')
13138      WRITE(ICOUT,1535)
13139 1535 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE LEFT VERTICAL ',
13140     1'FRAME LINE)')
13141      CALL DPWRST('XXX','BUG ')
13142      WRITE(ICOUT,1536)
13143 1536 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
13144      CALL DPWRST('XXX','BUG ')
13145 1539 CONTINUE
13146      GOTO1900
13147C
13148 1540 CONTINUE
13149      IFOUND='YES'
13150      IY1TJU='OUT'
13151C
13152      IF(IFEEDB.EQ.'OFF')GOTO1549
13153      WRITE(ICOUT,999)
13154      CALL DPWRST('XXX','BUG ')
13155      WRITE(ICOUT,1545)
13156 1545 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE LEFT VERTICAL ',
13157     1'FRAME LINE)')
13158      CALL DPWRST('XXX','BUG ')
13159      WRITE(ICOUT,1546)
13160 1546 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
13161      CALL DPWRST('XXX','BUG ')
13162 1549 CONTINUE
13163      GOTO1900
13164C
13165 1550 CONTINUE
13166      IFOUND='YES'
13167      IY1TJU='THRU'
13168C
13169      IF(IFEEDB.EQ.'OFF')GOTO1559
13170      WRITE(ICOUT,999)
13171      CALL DPWRST('XXX','BUG ')
13172      WRITE(ICOUT,1555)
13173 1555 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE LEFT VERTICAL ',
13174     1'FRAME LINE)')
13175      CALL DPWRST('XXX','BUG ')
13176      WRITE(ICOUT,1556)
13177 1556 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
13178      CALL DPWRST('XXX','BUG ')
13179 1559 CONTINUE
13180      GOTO1900
13181C
13182 1599 CONTINUE
13183C
13184C               **************************************************************
13185C               **  TREAT THE CASE WHEN                                     **
13186C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
13187C               **************************************************************
13188C
13189      IF(ICOM.EQ.'Y2TI')GOTO1600
13190      GOTO1699
13191C
13192 1600 CONTINUE
13193      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
13194      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
13195      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
13196      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
13197      IF(IHARG(NUMARG).EQ.'POSI')GOTO1650
13198      IF(IHARG(NUMARG).EQ.'IN')GOTO1630
13199      IF(IHARG(NUMARG).EQ.'INSI')GOTO1630
13200      IF(IHARG(NUMARG).EQ.'OUT')GOTO1640
13201      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1640
13202      IF(IHARG(NUMARG).EQ.'THRO')GOTO1650
13203      IF(IHARG(NUMARG).EQ.'THRU')GOTO1650
13204      IF(IHARG(NUMARG).EQ.'CENT')GOTO1650
13205      IERROR='YES'
13206      GOTO1900
13207C
13208 1630 CONTINUE
13209      IFOUND='YES'
13210      IY2TJU='IN'
13211C
13212      IF(IFEEDB.EQ.'OFF')GOTO1639
13213      WRITE(ICOUT,999)
13214      CALL DPWRST('XXX','BUG ')
13215      WRITE(ICOUT,1635)
13216 1635 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE RIGHT VERTICAL ',
13217     1'FRAME LINE)')
13218      CALL DPWRST('XXX','BUG ')
13219      WRITE(ICOUT,1636)
13220 1636 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
13221      CALL DPWRST('XXX','BUG ')
13222 1639 CONTINUE
13223      GOTO1900
13224C
13225 1640 CONTINUE
13226      IFOUND='YES'
13227      IY2TJU='OUT'
13228C
13229      IF(IFEEDB.EQ.'OFF')GOTO1649
13230      WRITE(ICOUT,999)
13231      CALL DPWRST('XXX','BUG ')
13232      WRITE(ICOUT,1645)
13233 1645 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE RIGHT VERTICAL ',
13234     1'FRAME LINE)')
13235      CALL DPWRST('XXX','BUG ')
13236      WRITE(ICOUT,1646)
13237 1646 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
13238      CALL DPWRST('XXX','BUG ')
13239 1649 CONTINUE
13240      GOTO1900
13241C
13242 1650 CONTINUE
13243      IFOUND='YES'
13244      IY2TJU='THRU'
13245C
13246      IF(IFEEDB.EQ.'OFF')GOTO1659
13247      WRITE(ICOUT,999)
13248      CALL DPWRST('XXX','BUG ')
13249      WRITE(ICOUT,1655)
13250 1655 FORMAT('THE TIC MARK JUSTIFICATION (FOR THE RIGHT VERTICAL ',
13251     1'FRAME LINE)')
13252      CALL DPWRST('XXX','BUG ')
13253      WRITE(ICOUT,1656)
13254 1656 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
13255      CALL DPWRST('XXX','BUG ')
13256 1659 CONTINUE
13257      GOTO1900
13258C
13259 1699 CONTINUE
13260C
13261C               *****************************************************
13262C               **  TREAT THE CASE WHEN                            **
13263C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
13264C               *****************************************************
13265C
13266      IF(ICOM.EQ.'TIC')GOTO1700
13267      IF(ICOM.EQ.'TICS')GOTO1700
13268      IF(ICOM.EQ.'XYTI')GOTO1700
13269      IF(ICOM.EQ.'YXTI')GOTO1700
13270      GOTO1799
13271C
13272 1700 CONTINUE
13273      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
13274      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
13275      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
13276      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
13277      IF(IHARG(NUMARG).EQ.'POSI')GOTO1750
13278      IF(IHARG(NUMARG).EQ.'IN')GOTO1730
13279      IF(IHARG(NUMARG).EQ.'INSI')GOTO1730
13280      IF(IHARG(NUMARG).EQ.'OUT')GOTO1740
13281      IF(IHARG(NUMARG).EQ.'OUTS')GOTO1740
13282      IF(IHARG(NUMARG).EQ.'THRO')GOTO1750
13283      IF(IHARG(NUMARG).EQ.'THRU')GOTO1750
13284      IF(IHARG(NUMARG).EQ.'CENT')GOTO1750
13285      IERROR='YES'
13286      GOTO1900
13287C
13288 1730 CONTINUE
13289      IFOUND='YES'
13290      IX1TJU='IN'
13291      IX2TJU='IN'
13292      IY1TJU='IN'
13293      IY2TJU='IN'
13294C
13295      IF(IFEEDB.EQ.'OFF')GOTO1739
13296      WRITE(ICOUT,999)
13297      CALL DPWRST('XXX','BUG ')
13298      WRITE(ICOUT,1735)
13299 1735 FORMAT('THE TIC MARKS (FOR ALL 4 ',
13300     1'FRAME LINES)')
13301      CALL DPWRST('XXX','BUG ')
13302      WRITE(ICOUT,1736)
13303 1736 FORMAT('HAS JUST BEEN SET TO      INSIDE ')
13304      CALL DPWRST('XXX','BUG ')
13305 1739 CONTINUE
13306      GOTO1900
13307C
13308 1740 CONTINUE
13309      IFOUND='YES'
13310      IX1TJU='OUT'
13311      IX2TJU='OUT'
13312      IY1TJU='OUT'
13313      IY2TJU='OUT'
13314C
13315      IF(IFEEDB.EQ.'OFF')GOTO1749
13316      WRITE(ICOUT,999)
13317      CALL DPWRST('XXX','BUG ')
13318      WRITE(ICOUT,1745)
13319 1745 FORMAT('THE TIC MARKS (FOR ALL 4 ',
13320     1'FRAME LINES)')
13321      CALL DPWRST('XXX','BUG ')
13322      WRITE(ICOUT,1746)
13323 1746 FORMAT('HAS JUST BEEN SET TO      OUTSIDE ')
13324      CALL DPWRST('XXX','BUG ')
13325 1749 CONTINUE
13326      GOTO1900
13327C
13328 1750 CONTINUE
13329      IFOUND='YES'
13330      IX1TJU='THRU'
13331      IX2TJU='THRU'
13332      IY1TJU='THRU'
13333      IY2TJU='THRU'
13334C
13335      IF(IFEEDB.EQ.'OFF')GOTO1759
13336      WRITE(ICOUT,999)
13337      CALL DPWRST('XXX','BUG ')
13338      WRITE(ICOUT,1755)
13339 1755 FORMAT('THE TIC MARKS (FOR ALL 4 ',
13340     1'FRAME LINES)')
13341      CALL DPWRST('XXX','BUG ')
13342      WRITE(ICOUT,1756)
13343 1756 FORMAT('HAS JUST BEEN SET TO      THROUGH ')
13344      CALL DPWRST('XXX','BUG ')
13345 1759 CONTINUE
13346      GOTO1900
13347C
13348 1799 CONTINUE
13349C
13350 1900 CONTINUE
13351      RETURN
13352      END
13353      SUBROUTINE DPTCOF(ICOM,IHARG,IARGT,ARG,NUMARG,
13354     1DEFTOF,IDEFTU,
13355     1ITICUN,
13356     1PX1TOL,PX2TOL,PY1TOB,PY2TOB,
13357     1PX1TOR,PX2TOR,PY1TOT,PY2TOT,
13358     1IFOUND,IERROR)
13359C
13360C     PURPOSE--DEFINE THE TIC MARK OFFSETS
13361C              FOR ANY OF THE 4 FRAME LINES.
13362C              SUCH TIC MARK OFFSETS DEFINE THE DISTANCE (IN EITHER
13363C              DATA UNITS OR DATAPLOT PERCENT UNITS) FROM THE FIRST OR
13364C              LAST TIC MARK TO THE FRAME LIMIT.  NOTE THAT THIS VALUE
13365C              WILL BE ADDED TO THE CURRENT DATA LIMITS (EITHER DEFINED
13366C              VIA THE LIMITS COMMAND OR AS AUTOMATICALLY DETERMINED
13367C              BY DATAPLOT).
13368C     INPUT  ARGUMENTS--ICOM
13369C                     --IHARG  (A  HOLLERITH VECTOR)
13370C                     --IARGT  (A  HOLLERITH VECTOR)
13371C                     --ARG    (A  FLOATING POINT VECTOR)
13372C                     --NUMARG
13373C                     --DEFTOF = DEFAULT OFFSET
13374C                     --IDEFTU = DEFAULT TIC UNITS
13375C     OUTPUT ARGUMENTS--
13376C                     --PX1TOL = BOTTOM HORIZONTAL TIC LEFT OFFSET
13377C                     --PX2TOL = TOP    HORIZONTAL TIC LEFT OFFSET
13378C                     --PY1TOB = LEFT   VERTICAL   TIC BOTTOM OFFSET
13379C                     --PY2TOB = RIGHT  VERTICAL   TIC BOTTOM OFFSET
13380C                     --PX1TOL = BOTTOM HORIZONTAL TIC LEFT OFFSET
13381C                     --PX2TOL = TOP    HORIZONTAL TIC LEFT OFFSET
13382C                     --PY1TOB = LEFT   VERTICAL   TIC BOTTOM OFFSET
13383C                     --PY2TOB = RIGHT  VERTICAL   TIC BOTTOM OFFSET
13384C                     --IFOUND ('YES' OR 'NO' )
13385C                     --IERROR ('YES' OR 'NO' )
13386C     WRITTEN BY--JAMES J. FILLIBEN
13387C                 STATISTICAL ENGINEERING DIVISION
13388C                 INFORMATION TECHNOLOGY LABORATORY
13389C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13390C                 GAITHERSBURG, MD 20899-8980
13391C                 PHONE--301-975-2899
13392C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13393C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13394C     LANGUAGE--ANSI FORTRAN (1977)
13395C     VERSION NUMBER--90/5
13396C     ORIGINAL VERSION--MAY       1990.
13397C     UPDATED         --OCTOBER    1991. INSERT FEEDBACK OFF JUMP
13398C
13399C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
13400C
13401      CHARACTER*4 ICOM
13402      CHARACTER*4 IHARG
13403      CHARACTER*4 IARGT
13404      CHARACTER*4 ITICUN
13405      CHARACTER*4 IDEFTU
13406      CHARACTER*4 IFOUND
13407      CHARACTER*4 IERROR
13408C
13409C---------------------------------------------------------------------
13410C
13411      DIMENSION IHARG(*)
13412      DIMENSION IARGT(*)
13413      DIMENSION ARG(*)
13414C
13415C-----COMMON----------------------------------------------------------
13416C
13417      INCLUDE 'DPCOP2.INC'
13418C
13419C-----START POINT-----------------------------------------------------
13420C
13421      IFOUND='NO'
13422      IERROR='NO'
13423C
13424      IF(NUMARG.LE.0)GOTO1900
13425      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'OFFS'.AND.
13426     1IHARG(2).EQ.'UNIT')GOTO2090
13427      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
13428     1IHARG(2).EQ.'OFFS'.AND.IHARG(3).EQ.'UNIT')GOTO2090
13429      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFFS')GOTO1090
13430      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
13431     1IHARG(2).EQ.'OFFS')GOTO1090
13432      GOTO1900
13433C
13434 1090 CONTINUE
13435      IFOUND='YES'
13436C
13437C               *****************************************************
13438C               **  TREAT THE CASE WHEN                            **
13439C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
13440C               *****************************************************
13441C
13442      IF(ICOM.EQ.'XTIC')GOTO1100
13443      GOTO1199
13444C
13445 1100 CONTINUE
13446      ILEFT=2
13447      IF(IHARG(2).EQ.'OFFS')ILEFT=3
13448      IRIGHT=ILEFT+1
13449      IF(ILEFT.GT.NUMARG)ILEFT=0
13450      IF(IRIGHT.GT.NUMARG)IRIGHT=0
13451C
13452C               *****************************************************
13453C               **  TREAT THE LEFT OFFSET                          **
13454C               **  NO ARGUMENT WILL SET THE DEFAULT               **
13455C               *****************************************************
13456C
13457      IF(ILEFT.EQ.0)GOTO1110
13458      IF(IHARG(ILEFT).EQ.'ON')GOTO1110
13459      IF(IHARG(ILEFT).EQ.'OFF')GOTO1110
13460      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1110
13461      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1110
13462      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1110
13463      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1120
13464      IERROR='YES'
13465      GOTO1900
13466C
13467 1110 CONTINUE
13468      HOLD=DEFTOF
13469      GOTO1140
13470C
13471 1120 CONTINUE
13472      HOLD=ARG(ILEFT)
13473      GOTO1140
13474C
13475 1140 CONTINUE
13476      IFOUND='YES'
13477      HOLD=ABS(HOLD)
13478      PX1TOL=HOLD
13479      PX2TOL=HOLD
13480C
13481      IF(IFEEDB.EQ.'OFF')GOTO1149
13482      WRITE(ICOUT,999)
13483  999 FORMAT(1X)
13484      CALL DPWRST('XXX','BUG ')
13485      WRITE(ICOUT,1141)
13486 1141 FORMAT('THE TIC MARK LEFT OFFSET (FOR BOTH HORIZONTAL ',
13487     1'FRAME LINES)')
13488      CALL DPWRST('XXX','BUG ')
13489      WRITE(ICOUT,1142)HOLD
13490 1142 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13491      CALL DPWRST('XXX','BUG ')
13492 1149 CONTINUE
13493C
13494C               *****************************************************
13495C               **  TREAT THE RIGHT OFFSET                         **
13496C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
13497C               *****************************************************
13498C
13499      IF(IRIGHT.EQ.0)GOTO1160
13500      IF(IHARG(IRIGHT).EQ.'ON')GOTO1170
13501      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1170
13502      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1170
13503      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1170
13504      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1170
13505      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1180
13506      IERROR='YES'
13507      GOTO1900
13508C
13509 1160 CONTINUE
13510      HOLD=PX1TOR
13511      GOTO1190
13512C
13513 1170 CONTINUE
13514      HOLD=DEFTOF
13515      GOTO1190
13516C
13517 1180 CONTINUE
13518      HOLD=ARG(IRIGHT)
13519      GOTO1190
13520C
13521 1190 CONTINUE
13522      IFOUND='YES'
13523      HOLD=ABS(HOLD)
13524      PX1TOR=HOLD
13525      PX2TOR=HOLD
13526C
13527      IF(IFEEDB.EQ.'OFF')GOTO1197
13528      WRITE(ICOUT,999)
13529      CALL DPWRST('XXX','BUG ')
13530      WRITE(ICOUT,1191)
13531 1191 FORMAT('THE TIC MARK RIGHT OFFSET (FOR BOTH HORIZONTAL ',
13532     1'FRAME LINES)')
13533      CALL DPWRST('XXX','BUG ')
13534      WRITE(ICOUT,1192)HOLD
13535 1192 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13536      CALL DPWRST('XXX','BUG ')
13537C
13538 1197 CONTINUE
13539C
13540      GOTO1900
13541C
13542 1199 CONTINUE
13543C
13544C               **************************************************************
13545C               **  TREAT THE CASE WHEN                                     **
13546C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
13547C               **************************************************************
13548C
13549      IF(ICOM.EQ.'X1TI')GOTO1200
13550      GOTO1299
13551C
13552 1200 CONTINUE
13553C
13554      ILEFT=2
13555      IF(IHARG(2).EQ.'OFFS')ILEFT=3
13556      IRIGHT=ILEFT+1
13557      IF(ILEFT.GT.NUMARG)ILEFT=0
13558      IF(IRIGHT.GT.NUMARG)IRIGHT=0
13559C
13560C               *****************************************************
13561C               **  TREAT THE LEFT OFFSET                          **
13562C               **  NO ARGUMENT WILL SET THE DEFAULT               **
13563C               *****************************************************
13564C
13565      IF(ILEFT.EQ.0)GOTO1210
13566      IF(IHARG(ILEFT).EQ.'ON')GOTO1210
13567      IF(IHARG(ILEFT).EQ.'OFF')GOTO1210
13568      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1210
13569      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1210
13570      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1210
13571      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1220
13572      IERROR='YES'
13573      GOTO1900
13574C
13575 1210 CONTINUE
13576      HOLD=DEFTOF
13577      GOTO1240
13578C
13579 1220 CONTINUE
13580      HOLD=ARG(ILEFT)
13581      GOTO1240
13582C
13583 1240 CONTINUE
13584      IFOUND='YES'
13585      HOLD=ABS(HOLD)
13586      PX1TOL=HOLD
13587C
13588      IF(IFEEDB.EQ.'OFF')GOTO1249
13589      WRITE(ICOUT,999)
13590      CALL DPWRST('XXX','BUG ')
13591      WRITE(ICOUT,1241)
13592 1241 FORMAT('THE TIC MARK LEFT OFFSET (FOR BOTTOM HORIZONTAL ',
13593     1'FRAME LINE)')
13594      CALL DPWRST('XXX','BUG ')
13595      WRITE(ICOUT,1242)HOLD
13596 1242 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13597      CALL DPWRST('XXX','BUG ')
13598 1249 CONTINUE
13599C
13600C               *****************************************************
13601C               **  TREAT THE RIGHT OFFSET                         **
13602C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
13603C               *****************************************************
13604C
13605      IF(IRIGHT.EQ.0)GOTO1260
13606      IF(IHARG(IRIGHT).EQ.'ON')GOTO1270
13607      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1270
13608      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1270
13609      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1270
13610      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1270
13611      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1280
13612      IERROR='YES'
13613      GOTO1900
13614C
13615 1260 CONTINUE
13616      HOLD=PX2TOR
13617      GOTO1290
13618C
13619 1270 CONTINUE
13620      HOLD=DEFTOF
13621      GOTO1290
13622C
13623 1280 CONTINUE
13624      HOLD=ARG(IRIGHT)
13625      GOTO1290
13626C
13627 1290 CONTINUE
13628      IFOUND='YES'
13629      HOLD=ABS(HOLD)
13630      PX1TOR=HOLD
13631C
13632      IF(IFEEDB.EQ.'OFF')GOTO1297
13633      WRITE(ICOUT,999)
13634      CALL DPWRST('XXX','BUG ')
13635      WRITE(ICOUT,1291)
13636 1291 FORMAT('THE TIC MARK RIGHT OFFSET (FOR BOTTOM HORIZONTAL ',
13637     1'FRAME LINES)')
13638      CALL DPWRST('XXX','BUG ')
13639      WRITE(ICOUT,1292)HOLD
13640 1292 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13641      CALL DPWRST('XXX','BUG ')
13642C
13643 1297 CONTINUE
13644C
13645      GOTO1900
13646C
13647 1299 CONTINUE
13648C
13649C               **************************************************************
13650C               **  TREAT THE CASE WHEN                                     **
13651C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
13652C               **************************************************************
13653C
13654      IF(ICOM.EQ.'X2TI')GOTO1300
13655      GOTO1399
13656C
13657 1300 CONTINUE
13658C
13659      ILEFT=2
13660      IF(IHARG(2).EQ.'OFFS')ILEFT=3
13661      IRIGHT=ILEFT+1
13662      IF(ILEFT.GT.NUMARG)ILEFT=0
13663      IF(IRIGHT.GT.NUMARG)IRIGHT=0
13664C
13665C               *****************************************************
13666C               **  TREAT THE LEFT OFFSET                          **
13667C               **  NO ARGUMENT WILL SET THE DEFAULT               **
13668C               *****************************************************
13669C
13670      IF(ILEFT.EQ.0)GOTO1310
13671      IF(IHARG(ILEFT).EQ.'ON')GOTO1310
13672      IF(IHARG(ILEFT).EQ.'OFF')GOTO1310
13673      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1310
13674      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1310
13675      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1310
13676      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1320
13677      IERROR='YES'
13678      GOTO1900
13679C
13680 1310 CONTINUE
13681      HOLD=DEFTOF
13682      GOTO1340
13683C
13684 1320 CONTINUE
13685      HOLD=ARG(ILEFT)
13686      GOTO1340
13687C
13688 1340 CONTINUE
13689      IFOUND='YES'
13690      HOLD=ABS(HOLD)
13691      PX2TOL=HOLD
13692C
13693      IF(IFEEDB.EQ.'OFF')GOTO1349
13694      WRITE(ICOUT,999)
13695      CALL DPWRST('XXX','BUG ')
13696      WRITE(ICOUT,1341)
13697 1341 FORMAT('THE TIC MARK LEFT OFFSET (FOR TOP HORIZONTAL ',
13698     1'FRAME LINE)')
13699      CALL DPWRST('XXX','BUG ')
13700      WRITE(ICOUT,1342)HOLD
13701 1342 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13702      CALL DPWRST('XXX','BUG ')
13703 1349 CONTINUE
13704C
13705C               *****************************************************
13706C               **  TREAT THE RIGHT OFFSET                         **
13707C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
13708C               *****************************************************
13709C
13710      IF(IRIGHT.EQ.0)GOTO1360
13711      IF(IHARG(IRIGHT).EQ.'ON')GOTO1370
13712      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1370
13713      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1370
13714      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1370
13715      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1370
13716      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1380
13717      IERROR='YES'
13718      GOTO1900
13719C
13720 1360 CONTINUE
13721      HOLD=PX2TOR
13722      GOTO1390
13723C
13724 1370 CONTINUE
13725      HOLD=DEFTOF
13726      GOTO1390
13727C
13728 1380 CONTINUE
13729      HOLD=ARG(IRIGHT)
13730      GOTO1390
13731C
13732 1390 CONTINUE
13733      IFOUND='YES'
13734      HOLD=ABS(HOLD)
13735      PX2TOR=HOLD
13736C
13737      IF(IFEEDB.EQ.'OFF')GOTO1397
13738      WRITE(ICOUT,999)
13739      CALL DPWRST('XXX','BUG ')
13740      WRITE(ICOUT,1391)
13741 1391 FORMAT('THE TIC MARK RIGHT OFFSET (FOR TOP HORIZONTAL ',
13742     1'FRAME LINES)')
13743      CALL DPWRST('XXX','BUG ')
13744      WRITE(ICOUT,1392)HOLD
13745 1392 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13746      CALL DPWRST('XXX','BUG ')
13747C
13748 1397 CONTINUE
13749C
13750      GOTO1900
13751C
13752 1399 CONTINUE
13753C
13754C               *****************************************************
13755C               **  TREAT THE CASE WHEN                            **
13756C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
13757C               *****************************************************
13758C
13759      IF(ICOM.EQ.'YTIC')GOTO1400
13760      GOTO1499
13761C
13762 1400 CONTINUE
13763C
13764      ILEFT=2
13765      IF(IHARG(2).EQ.'OFFS')ILEFT=3
13766      IRIGHT=ILEFT+1
13767      IF(ILEFT.GT.NUMARG)ILEFT=0
13768      IF(IRIGHT.GT.NUMARG)IRIGHT=0
13769C
13770C               *****************************************************
13771C               **  TREAT THE BOTTOM OFFSET                        **
13772C               **  NO ARGUMENT WILL SET THE DEFAULT               **
13773C               *****************************************************
13774C
13775      IF(ILEFT.EQ.0)GOTO1410
13776      IF(IHARG(ILEFT).EQ.'ON')GOTO1410
13777      IF(IHARG(ILEFT).EQ.'OFF')GOTO1410
13778      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1410
13779      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1410
13780      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1410
13781      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1420
13782      IERROR='YES'
13783      GOTO1900
13784C
13785 1410 CONTINUE
13786      HOLD=DEFTOF
13787      GOTO1440
13788C
13789 1420 CONTINUE
13790      HOLD=ARG(ILEFT)
13791      GOTO1440
13792C
13793 1440 CONTINUE
13794      IFOUND='YES'
13795      HOLD=ABS(HOLD)
13796      PY1TOB=HOLD
13797      PY2TOB=HOLD
13798C
13799      IF(IFEEDB.EQ.'OFF')GOTO1449
13800      WRITE(ICOUT,999)
13801      CALL DPWRST('XXX','BUG ')
13802      WRITE(ICOUT,1441)
13803 1441 FORMAT('THE TIC MARK BOTTOM OFFSET (FOR BOTH VERTICAL ',
13804     1'FRAME LINES)')
13805      CALL DPWRST('XXX','BUG ')
13806      WRITE(ICOUT,1442)HOLD
13807 1442 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13808      CALL DPWRST('XXX','BUG ')
13809 1449 CONTINUE
13810C
13811C               *****************************************************
13812C               **  TREAT THE TOP OFFSET                           **
13813C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
13814C               *****************************************************
13815C
13816      IF(IRIGHT.EQ.0)GOTO1460
13817      IF(IHARG(IRIGHT).EQ.'ON')GOTO1470
13818      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1470
13819      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1470
13820      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1470
13821      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1470
13822      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1480
13823      IERROR='YES'
13824      GOTO1900
13825C
13826 1460 CONTINUE
13827      HOLD=PY1TOT
13828      GOTO1490
13829C
13830 1470 CONTINUE
13831      HOLD=DEFTOF
13832      GOTO1490
13833C
13834 1480 CONTINUE
13835      HOLD=ARG(IRIGHT)
13836      GOTO1490
13837C
13838 1490 CONTINUE
13839      IFOUND='YES'
13840      HOLD=ABS(HOLD)
13841      PY1TOT=HOLD
13842      PY2TOT=HOLD
13843C
13844      IF(IFEEDB.EQ.'OFF')GOTO1497
13845      WRITE(ICOUT,999)
13846      CALL DPWRST('XXX','BUG ')
13847      WRITE(ICOUT,1491)
13848 1491 FORMAT('THE TIC MARK TOP OFFSET (FOR BOTH VERTICAL ',
13849     1'FRAME LINES)')
13850      CALL DPWRST('XXX','BUG ')
13851      WRITE(ICOUT,1492)HOLD
13852 1492 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13853      CALL DPWRST('XXX','BUG ')
13854C
13855 1497 CONTINUE
13856C
13857      GOTO1900
13858C
13859 1499 CONTINUE
13860C
13861C               **************************************************************
13862C               **  TREAT THE CASE WHEN                                     **
13863C               **  ONLY THE LEFT VERTICAL TIC OFFSETS ARE TO BE CHANGED    **
13864C               **************************************************************
13865C
13866      IF(ICOM.EQ.'Y1TI')GOTO1500
13867      GOTO1599
13868C
13869 1500 CONTINUE
13870C
13871      ILEFT=2
13872      IF(IHARG(2).EQ.'OFFS')ILEFT=3
13873      IRIGHT=ILEFT+1
13874      IF(ILEFT.GT.NUMARG)ILEFT=0
13875      IF(IRIGHT.GT.NUMARG)IRIGHT=0
13876C
13877C               *****************************************************
13878C               **  TREAT THE BOTTOM OFFSET                        **
13879C               **  NO ARGUMENT WILL SET THE DEFAULT               **
13880C               *****************************************************
13881C
13882      IF(ILEFT.EQ.0)GOTO1510
13883      IF(IHARG(ILEFT).EQ.'ON')GOTO1510
13884      IF(IHARG(ILEFT).EQ.'OFF')GOTO1510
13885      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1510
13886      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1510
13887      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1510
13888      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1520
13889      IERROR='YES'
13890      GOTO1900
13891C
13892 1510 CONTINUE
13893      HOLD=DEFTOF
13894      GOTO1540
13895C
13896 1520 CONTINUE
13897      HOLD=ARG(ILEFT)
13898      GOTO1540
13899C
13900 1540 CONTINUE
13901      IFOUND='YES'
13902      HOLD=ABS(HOLD)
13903      PY1TOB=HOLD
13904C
13905      IF(IFEEDB.EQ.'OFF')GOTO1549
13906      WRITE(ICOUT,999)
13907      CALL DPWRST('XXX','BUG ')
13908      WRITE(ICOUT,1541)
13909 1541 FORMAT('THE TIC MARK BOTTOM OFFSET (FOR LEFT VERTICAL ',
13910     1'FRAME LINE)')
13911      CALL DPWRST('XXX','BUG ')
13912      WRITE(ICOUT,1542)HOLD
13913 1542 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13914      CALL DPWRST('XXX','BUG ')
13915 1549 CONTINUE
13916C
13917C               *****************************************************
13918C               **  TREAT THE TOP OFFSET                           **
13919C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
13920C               *****************************************************
13921C
13922      IF(IRIGHT.EQ.0)GOTO1560
13923      IF(IHARG(IRIGHT).EQ.'ON')GOTO1570
13924      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1570
13925      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1570
13926      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1570
13927      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1570
13928      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1580
13929      IERROR='YES'
13930      GOTO1900
13931C
13932 1560 CONTINUE
13933      HOLD=PY1TOT
13934      GOTO1590
13935C
13936 1570 CONTINUE
13937      HOLD=DEFTOF
13938      GOTO1590
13939C
13940 1580 CONTINUE
13941      HOLD=ARG(IRIGHT)
13942      GOTO1590
13943C
13944 1590 CONTINUE
13945      IFOUND='YES'
13946      HOLD=ABS(HOLD)
13947      PY1TOT=HOLD
13948C
13949      IF(IFEEDB.EQ.'OFF')GOTO1597
13950      WRITE(ICOUT,999)
13951      CALL DPWRST('XXX','BUG ')
13952      WRITE(ICOUT,1591)
13953 1591 FORMAT('THE TIC MARK TOP OFFSET (FOR LEFT VERTICAL ',
13954     1'FRAME LINE)')
13955      CALL DPWRST('XXX','BUG ')
13956      WRITE(ICOUT,1592)HOLD
13957 1592 FORMAT('HAS JUST BEEN SET TO ',E15.7)
13958      CALL DPWRST('XXX','BUG ')
13959C
13960 1597 CONTINUE
13961C
13962      GOTO1900
13963C
13964 1599 CONTINUE
13965C
13966C               **************************************************************
13967C               **  TREAT THE CASE WHEN                                     **
13968C               **  ONLY THE RIGHT VERTICAL TIC OFFSETS ARE TO BE CHANGED   **
13969C               **************************************************************
13970C
13971      IF(ICOM.EQ.'Y2TI')GOTO1600
13972      GOTO1699
13973C
13974 1600 CONTINUE
13975C
13976      ILEFT=2
13977      IF(IHARG(2).EQ.'OFFS')ILEFT=3
13978      IRIGHT=ILEFT+1
13979      IF(ILEFT.GT.NUMARG)ILEFT=0
13980      IF(IRIGHT.GT.NUMARG)IRIGHT=0
13981C
13982C               *****************************************************
13983C               **  TREAT THE BOTTOM OFFSET                        **
13984C               **  NO ARGUMENT WILL SET THE DEFAULT               **
13985C               *****************************************************
13986C
13987      IF(ILEFT.EQ.0)GOTO1610
13988      IF(IHARG(ILEFT).EQ.'ON')GOTO1610
13989      IF(IHARG(ILEFT).EQ.'OFF')GOTO1610
13990      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1610
13991      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1610
13992      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1610
13993      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1620
13994      IERROR='YES'
13995      GOTO1900
13996C
13997 1610 CONTINUE
13998      HOLD=DEFTOF
13999      GOTO1640
14000C
14001 1620 CONTINUE
14002      HOLD=ARG(ILEFT)
14003      GOTO1640
14004C
14005 1640 CONTINUE
14006      IFOUND='YES'
14007      HOLD=ABS(HOLD)
14008      PY2TOB=HOLD
14009C
14010      IF(IFEEDB.EQ.'OFF')GOTO1649
14011      WRITE(ICOUT,999)
14012      CALL DPWRST('XXX','BUG ')
14013      WRITE(ICOUT,1641)
14014 1641 FORMAT('THE TIC MARK BOTTOM OFFSET (FOR RIGHT VERTICAL ',
14015     1'FRAME LINE)')
14016      CALL DPWRST('XXX','BUG ')
14017      WRITE(ICOUT,1642)HOLD
14018 1642 FORMAT('HAS JUST BEEN SET TO ',E16.7)
14019      CALL DPWRST('XXX','BUG ')
14020 1649 CONTINUE
14021C
14022C               *****************************************************
14023C               **  TREAT THE TOP OFFSET                           **
14024C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
14025C               *****************************************************
14026C
14027      IF(IRIGHT.EQ.0)GOTO1660
14028      IF(IHARG(IRIGHT).EQ.'ON')GOTO1670
14029      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1670
14030      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1670
14031      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1670
14032      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1670
14033      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1680
14034      IERROR='YES'
14035      GOTO1900
14036C
14037 1660 CONTINUE
14038      HOLD=PY2TOT
14039      GOTO1690
14040C
14041 1670 CONTINUE
14042      HOLD=DEFTOF
14043      GOTO1690
14044C
14045 1680 CONTINUE
14046      HOLD=ARG(IRIGHT)
14047      GOTO1690
14048C
14049 1690 CONTINUE
14050      IFOUND='YES'
14051      HOLD=ABS(HOLD)
14052      PY2TOT=HOLD
14053C
14054      IF(IFEEDB.EQ.'OFF')GOTO1697
14055      WRITE(ICOUT,999)
14056      CALL DPWRST('XXX','BUG ')
14057      WRITE(ICOUT,1691)
14058 1691 FORMAT('THE TIC MARK TOP OFFSET (FOR RIGHT VERTICAL ',
14059     1'FRAME LINE)')
14060      CALL DPWRST('XXX','BUG ')
14061      WRITE(ICOUT,1692)HOLD
14062 1692 FORMAT('HAS JUST BEEN SET TO ',E16.7)
14063      CALL DPWRST('XXX','BUG ')
14064C
14065 1697 CONTINUE
14066      GOTO1900
14067C
14068 1699 CONTINUE
14069C
14070C               *****************************************************
14071C               **  TREAT THE CASE WHEN                            **
14072C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
14073C               *****************************************************
14074C
14075      IF(ICOM.EQ.'TIC')GOTO1700
14076      IF(ICOM.EQ.'TICS')GOTO1700
14077      IF(ICOM.EQ.'XYTI')GOTO1700
14078      IF(ICOM.EQ.'YXTI')GOTO1700
14079      GOTO1799
14080C
14081 1700 CONTINUE
14082C
14083      ILEFT=2
14084      IF(IHARG(2).EQ.'OFFS')ILEFT=3
14085      IRIGHT=ILEFT+1
14086      IF(ILEFT.GT.NUMARG)ILEFT=0
14087      IF(IRIGHT.GT.NUMARG)IRIGHT=0
14088C
14089C               *****************************************************
14090C               **  TREAT THE BOTTOM OFFSET                        **
14091C               **  NO ARGUMENT WILL SET THE DEFAULT               **
14092C               *****************************************************
14093C
14094      IF(ILEFT.EQ.0)GOTO1710
14095      IF(IHARG(ILEFT).EQ.'ON')GOTO1710
14096      IF(IHARG(ILEFT).EQ.'OFF')GOTO1710
14097      IF(IHARG(ILEFT).EQ.'AUTO')GOTO1710
14098      IF(IHARG(ILEFT).EQ.'DEFA')GOTO1710
14099      IF(IHARG(ILEFT).EQ.'FLOA')GOTO1710
14100      IF(IARGT(ILEFT).EQ.'NUMB')GOTO1720
14101      IERROR='YES'
14102      GOTO1900
14103C
14104 1710 CONTINUE
14105      HOLD=DEFTOF
14106      GOTO1740
14107C
14108 1720 CONTINUE
14109      HOLD=ARG(ILEFT)
14110      GOTO1740
14111C
14112 1740 CONTINUE
14113      IFOUND='YES'
14114      HOLD=ABS(HOLD)
14115      PX1TOL=HOLD
14116      PX2TOL=HOLD
14117      PY1TOB=HOLD
14118      PY2TOB=HOLD
14119C
14120      IF(IFEEDB.EQ.'OFF')GOTO1749
14121      WRITE(ICOUT,999)
14122      CALL DPWRST('XXX','BUG ')
14123      WRITE(ICOUT,1741)
14124 1741 FORMAT('THE TIC MARK BOTTOM OFFSET (FOR BOTH VERTICAL ',
14125     1'FRAME LINES)')
14126      CALL DPWRST('XXX','BUG ')
14127      WRITE(ICOUT,1742)HOLD
14128 1742 FORMAT('HAS JUST BEEN SET TO ',E15.7)
14129      CALL DPWRST('XXX','BUG ')
14130      WRITE(ICOUT,1743)
14131 1743 FORMAT('THE TIC MARK LEFT OFFSET (FOR BOTH HORIZONTAL ',
14132     1'FRAME LINES)')
14133      CALL DPWRST('XXX','BUG ')
14134      WRITE(ICOUT,1742)HOLD
14135      CALL DPWRST('XXX','BUG ')
14136 1749 CONTINUE
14137C
14138C               *****************************************************
14139C               **  TREAT THE TOP OFFSET                           **
14140C               **  NO ARGUMENT WILL LEAVE THE CURRENT VALUE       **
14141C               *****************************************************
14142C
14143      IF(IRIGHT.EQ.0)GOTO1760
14144      IF(IHARG(IRIGHT).EQ.'ON')GOTO1770
14145      IF(IHARG(IRIGHT).EQ.'OFF')GOTO1770
14146      IF(IHARG(IRIGHT).EQ.'AUTO')GOTO1770
14147      IF(IHARG(IRIGHT).EQ.'DEFA')GOTO1770
14148      IF(IHARG(IRIGHT).EQ.'FLOA')GOTO1770
14149      IF(IARGT(IRIGHT).EQ.'NUMB')GOTO1780
14150      IERROR='YES'
14151      GOTO1900
14152C
14153 1760 CONTINUE
14154      GOTO1900
14155C
14156 1770 CONTINUE
14157      HOLD=DEFTOF
14158      GOTO1790
14159C
14160 1780 CONTINUE
14161      HOLD=ARG(IRIGHT)
14162      GOTO1790
14163C
14164 1790 CONTINUE
14165      IFOUND='YES'
14166      HOLD=ABS(HOLD)
14167      PX1TOR=HOLD
14168      PX2TOR=HOLD
14169      PY1TOT=HOLD
14170      PY2TOT=HOLD
14171C
14172      IF(IFEEDB.EQ.'OFF')GOTO1797
14173      WRITE(ICOUT,999)
14174      CALL DPWRST('XXX','BUG ')
14175      WRITE(ICOUT,1791)
14176 1791 FORMAT('THE TIC MARK TOP OFFSET (FOR BOTH VERTICAL ',
14177     1'FRAME LINES)')
14178      CALL DPWRST('XXX','BUG ')
14179      WRITE(ICOUT,1792)HOLD
14180 1792 FORMAT('HAS JUST BEEN SET TO ',E15.7)
14181      CALL DPWRST('XXX','BUG ')
14182      WRITE(ICOUT,1793)
14183 1793 FORMAT('THE TIC MARK RIGHT OFFSET (FOR BOTH HORIZONTAL ',
14184     1'FRAME LINES)')
14185      CALL DPWRST('XXX','BUG ')
14186      WRITE(ICOUT,1792)HOLD
14187      CALL DPWRST('XXX','BUG ')
14188C
14189 1797 CONTINUE
14190C
14191      GOTO1900
14192C
14193 1799 CONTINUE
14194      GOTO1900
14195C
14196C               *****************************************************
14197C               **  TREAT THE OFFSET UNITS CASE                    **
14198C               **  NOTE THAT CURRENTLY THERE IS ONLY ONE UNITS    **
14199C               **  SWITCH, I.E., ALL 4 FRAME LINES WILL USE THE   **
14200C               **  SAME UNITS.  THE CHOICES ARE "DATA", (OFFSETS  **
14201C               **  IN UNITS OF THE DATA) AND "ABSOLUTE" (OFFSETS  **
14202C               **  IN DATAPLOT 0. TO 100. PERCENT UNITS).         **
14203C               *****************************************************
14204C
14205 2090 CONTINUE
14206      IFOUND='YES'
14207C
14208      IF(IHARG(NUMARG).EQ.'ON')GOTO2150
14209      IF(IHARG(NUMARG).EQ.'OFF')GOTO2150
14210      IF(IHARG(NUMARG).EQ.'AUTO')GOTO2150
14211      IF(IHARG(NUMARG).EQ.'DEFA')GOTO2150
14212      IF(IHARG(NUMARG).EQ.'FLOA')GOTO2150
14213      IF(IHARG(NUMARG).EQ.'DATA')GOTO2160
14214      IF(IHARG(NUMARG).EQ.'SCRE')GOTO2170
14215      IF(IHARG(NUMARG).EQ.'ABSO')GOTO2170
14216      GOTO2150
14217C
14218 2150 CONTINUE
14219      ITICUN=IDEFTU
14220CCCCC THE FOLLOWING LINE (AND THE CONTINUE) WERE ADDED OCTOBER 1991
14221      IF(IFEEDB.EQ.'OFF')GOTO2159
14222      WRITE(ICOUT,2151)ITICUN
14223 2151 FORMAT('TIC MARK OFFSETS WILL BE CALCULATED IN ',A4,
14224     1' UNITS.')
14225      CALL DPWRST('XXX','BUG ')
14226 2159 CONTINUE
14227      GOTO1900
14228C
14229 2160 CONTINUE
14230      ITICUN='DATA'
14231CCCCC THE FOLLOWING LINE (AND THE CONTINUE) WERE ADDED OCTOBER 1991
14232      IF(IFEEDB.EQ.'OFF')GOTO2169
14233      WRITE(ICOUT,2161)
14234 2161 FORMAT('TIC MARK OFFSETS WILL BE CALCULATED IN DATA',
14235     1' UNITS.')
14236      CALL DPWRST('XXX','BUG ')
14237 2169 CONTINUE
14238      GOTO1900
14239C
14240 2170 CONTINUE
14241      ITICUN='ABSO'
14242CCCCC THE FOLLOWING LINE (AND THE CONTINUE) WERE ADDED OCTOBER 1991
14243      IF(IFEEDB.EQ.'OFF')GOTO2179
14244      WRITE(ICOUT,2171)
14245 2171 FORMAT('TIC MARK OFFSETS WILL BE CALCULATED IN',
14246     1' DATAPLOT SCREEN UNITS.')
14247      CALL DPWRST('XXX','BUG ')
14248 2179 CONTINUE
14249      GOTO1900
14250C
14251 1900 CONTINUE
14252      RETURN
14253      END
14254      SUBROUTINE DPTCPA(ICOM,IHARG,NUMARG,
14255     1IDEFPA,
14256     1IX1TPA,IX2TPA,IY1TPA,IY2TPA,
14257     1IFOUND,IERROR)
14258C
14259C     PURPOSE--DEFINE THE TIC MARK PATTERN SWITCHES
14260C              FOR ANY OF THE 4 FRAME LINES.
14261C              SUCH TIC MARK SWITCHES DESCRIBE
14262C              THE TIC MARK PATTERN ON THE 4 FRAME LINES OF A PLOT.
14263C              THE CONTENTS OF A TIC MARK PATTERN SWITCH ARE
14264C              A PATTERN.
14265C              THE TIC MARK PATTERN SWITCHES FOR THE 4 FRAME LINES
14266C              ARE CONTAINED IN THE 4 VARIABLES
14267C              IX1TPA,IX2TPA,IY1TPA,IY2TPA
14268C     INPUT  ARGUMENTS--ICOM
14269C                     --IHARG  (A  HOLLERITH VECTOR)
14270C                     --NUMARG
14271C                     --IDEFPA
14272C     OUTPUT ARGUMENTS--IX1TPA = PATTERN FOR BOTTOM HORIZ. TICS
14273C                     --IX2TPA = PATTERN FOR TOP    HORIZ. TICS
14274C                     --IY1TPA = PATTERN FOR LEFT   VERT.  TICS
14275C                     --IY2TPA = PATTERN FOR RIGHT  VERT.  TICS
14276C                     --IFOUND ('YES' OR 'NO' )
14277C                     --IERROR ('YES' OR 'NO' )
14278C     WRITTEN BY--ALAN HECKERT
14279C                 COMPUTER SERVICES DIVISION
14280C                 INFORMATION TECHNOLOGY LABORATORY
14281C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14282C                 GAITHERSBURG, MD 20899-8980
14283C                 PHONE--301-975-2899
14284C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14285C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14286C     LANGUAGE--ANSI FORTRAN (1977)
14287C     VERSION NUMBER--89/2
14288C     ORIGINAL VERSION--JANUARY   1989.
14289C
14290C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
14291C
14292      CHARACTER*4 ICOM
14293      CHARACTER*4 IHARG
14294C
14295      CHARACTER*4 IDEFPA
14296C
14297      CHARACTER*4 IX1TPA
14298      CHARACTER*4 IX2TPA
14299      CHARACTER*4 IY1TPA
14300      CHARACTER*4 IY2TPA
14301C
14302      CHARACTER*4 IFOUND
14303      CHARACTER*4 IERROR
14304C
14305      CHARACTER*4 IHOLD
14306C
14307C---------------------------------------------------------------------
14308C
14309      DIMENSION IHARG(*)
14310C
14311C-----COMMON----------------------------------------------------------
14312C
14313      INCLUDE 'DPCOP2.INC'
14314C
14315C-----START POINT-----------------------------------------------------
14316C
14317      IFOUND='NO'
14318      IERROR='NO'
14319C
14320      IF(NUMARG.LE.0)GOTO1900
14321      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO1090
14322      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
14323     1IHARG(2).EQ.'PATT')GOTO1090
14324      GOTO1900
14325 1090 CONTINUE
14326C
14327C               *****************************************************
14328C               **  TREAT THE CASE WHEN                            **
14329C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
14330C               *****************************************************
14331C
14332      IF(ICOM.EQ.'XTIC')GOTO1100
14333      GOTO1199
14334C
14335 1100 CONTINUE
14336      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
14337      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
14338      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
14339      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
14340      IF(IHARG(NUMARG).EQ.'PATT')GOTO1150
14341      GOTO1160
14342C
14343 1150 CONTINUE
14344      IHOLD=IDEFPA
14345      GOTO1180
14346C
14347 1160 CONTINUE
14348      IHOLD=IHARG(NUMARG)
14349      GOTO1180
14350C
14351 1180 CONTINUE
14352      IFOUND='YES'
14353      IX1TPA=IHOLD
14354      IX2TPA=IHOLD
14355C
14356      IF(IFEEDB.EQ.'OFF')GOTO1189
14357      WRITE(ICOUT,999)
14358  999 FORMAT(1X)
14359      CALL DPWRST('XXX','BUG ')
14360      WRITE(ICOUT,1181)
14361 1181 FORMAT('THE TIC MARK PATTERN (FOR BOTH HORIZONTAL ',
14362     1'FRAME LINES)')
14363      CALL DPWRST('XXX','BUG ')
14364      WRITE(ICOUT,1182)IHOLD
14365 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
14366      CALL DPWRST('XXX','BUG ')
14367 1189 CONTINUE
14368      GOTO1900
14369C
14370 1199 CONTINUE
14371C
14372C               **************************************************************
14373C               **  TREAT THE CASE WHEN                                     **
14374C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
14375C               **************************************************************
14376C
14377      IF(ICOM.EQ.'X1TI')GOTO1200
14378      GOTO1299
14379C
14380 1200 CONTINUE
14381      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
14382      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
14383      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
14384      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
14385      IF(IHARG(NUMARG).EQ.'PATT')GOTO1250
14386      GOTO1260
14387C
14388 1250 CONTINUE
14389      IHOLD=IDEFPA
14390      GOTO1280
14391C
14392 1260 CONTINUE
14393      IHOLD=IHARG(NUMARG)
14394      GOTO1280
14395C
14396 1280 CONTINUE
14397      IFOUND='YES'
14398      IX1TPA=IHOLD
14399C
14400      IF(IFEEDB.EQ.'OFF')GOTO1289
14401      WRITE(ICOUT,999)
14402      CALL DPWRST('XXX','BUG ')
14403      WRITE(ICOUT,1281)
14404 1281 FORMAT('THE TIC MARK PATTERN (FOR THE BOTTOM HORIZONTAL ',
14405     1'FRAME LINE)')
14406      CALL DPWRST('XXX','BUG ')
14407      WRITE(ICOUT,1282)IHOLD
14408 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
14409      CALL DPWRST('XXX','BUG ')
14410 1289 CONTINUE
14411      GOTO1900
14412C
14413 1299 CONTINUE
14414C
14415C               **************************************************************
14416C               **  TREAT THE CASE WHEN                                     **
14417C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
14418C               **************************************************************
14419C
14420      IF(ICOM.EQ.'X2TI')GOTO1300
14421      GOTO1399
14422C
14423 1300 CONTINUE
14424      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
14425      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
14426      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
14427      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
14428      IF(IHARG(NUMARG).EQ.'PATT')GOTO1350
14429      GOTO1360
14430C
14431 1350 CONTINUE
14432      IHOLD=IDEFPA
14433      GOTO1380
14434C
14435 1360 CONTINUE
14436      IHOLD=IHARG(NUMARG)
14437      GOTO1380
14438C
14439 1380 CONTINUE
14440      IFOUND='YES'
14441      IX2TPA=IHOLD
14442C
14443      IF(IFEEDB.EQ.'OFF')GOTO1389
14444      WRITE(ICOUT,999)
14445      CALL DPWRST('XXX','BUG ')
14446      WRITE(ICOUT,1381)
14447 1381 FORMAT('THE TIC MARK PATTERN (FOR THE TOP HORIZONTAL ',
14448     1'FRAME LINE)')
14449      CALL DPWRST('XXX','BUG ')
14450      WRITE(ICOUT,1382)IHOLD
14451 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
14452      CALL DPWRST('XXX','BUG ')
14453 1389 CONTINUE
14454      GOTO1900
14455C
14456 1399 CONTINUE
14457C
14458C               *****************************************************
14459C               **  TREAT THE CASE WHEN                            **
14460C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
14461C               *****************************************************
14462C
14463      IF(ICOM.EQ.'YTIC')GOTO1400
14464      GOTO1499
14465C
14466 1400 CONTINUE
14467      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
14468      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
14469      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
14470      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
14471      IF(IHARG(NUMARG).EQ.'PATT')GOTO1450
14472      GOTO1460
14473C
14474 1450 CONTINUE
14475      IHOLD=IDEFPA
14476      GOTO1480
14477C
14478 1460 CONTINUE
14479      IHOLD=IHARG(NUMARG)
14480      GOTO1480
14481C
14482 1480 CONTINUE
14483      IFOUND='YES'
14484      IY1TPA=IHOLD
14485      IY2TPA=IHOLD
14486C
14487      IF(IFEEDB.EQ.'OFF')GOTO1489
14488      WRITE(ICOUT,999)
14489      CALL DPWRST('XXX','BUG ')
14490      WRITE(ICOUT,1481)
14491 1481 FORMAT('THE TIC MARK PATTERN (FOR BOTH VERTICAL ',
14492     1'FRAME LINES)')
14493      CALL DPWRST('XXX','BUG ')
14494      WRITE(ICOUT,1482)IHOLD
14495 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
14496      CALL DPWRST('XXX','BUG ')
14497 1489 CONTINUE
14498      GOTO1900
14499C
14500 1499 CONTINUE
14501C
14502C               **************************************************************
14503C               **  TREAT THE CASE WHEN                                     **
14504C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
14505C               **************************************************************
14506C
14507      IF(ICOM.EQ.'Y1TI')GOTO1500
14508      GOTO1599
14509C
14510 1500 CONTINUE
14511      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
14512      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
14513      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
14514      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
14515      IF(IHARG(NUMARG).EQ.'PATT')GOTO1550
14516      GOTO1560
14517C
14518 1550 CONTINUE
14519      IHOLD=IDEFPA
14520      GOTO1580
14521C
14522 1560 CONTINUE
14523      IHOLD=IHARG(NUMARG)
14524      GOTO1580
14525C
14526 1580 CONTINUE
14527      IFOUND='YES'
14528      IY1TPA=IHOLD
14529C
14530      IF(IFEEDB.EQ.'OFF')GOTO1589
14531      WRITE(ICOUT,999)
14532      CALL DPWRST('XXX','BUG ')
14533      WRITE(ICOUT,1581)
14534 1581 FORMAT('THE TIC MARK PATTERN (FOR THE LEFT VERTICAL ',
14535     1'FRAME LINE)')
14536      CALL DPWRST('XXX','BUG ')
14537      WRITE(ICOUT,1582)IHOLD
14538 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
14539      CALL DPWRST('XXX','BUG ')
14540 1589 CONTINUE
14541      GOTO1900
14542C
14543 1599 CONTINUE
14544C
14545C               **************************************************************
14546C               **  TREAT THE CASE WHEN                                     **
14547C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
14548C               **************************************************************
14549C
14550      IF(ICOM.EQ.'Y2TI')GOTO1600
14551      GOTO1699
14552C
14553 1600 CONTINUE
14554      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
14555      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
14556      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
14557      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
14558      IF(IHARG(NUMARG).EQ.'PATT')GOTO1650
14559      GOTO1660
14560C
14561 1650 CONTINUE
14562      IHOLD=IDEFPA
14563      GOTO1680
14564C
14565 1660 CONTINUE
14566      IHOLD=IHARG(NUMARG)
14567      GOTO1680
14568C
14569 1680 CONTINUE
14570      IFOUND='YES'
14571      IY2TPA=IHOLD
14572C
14573      IF(IFEEDB.EQ.'OFF')GOTO1689
14574      WRITE(ICOUT,999)
14575      CALL DPWRST('XXX','BUG ')
14576      WRITE(ICOUT,1681)
14577 1681 FORMAT('THE TIC MARK PATTERN (FOR THE RIGHT VERTICAL ',
14578     1'FRAME LINE)')
14579      CALL DPWRST('XXX','BUG ')
14580      WRITE(ICOUT,1682)IHOLD
14581 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
14582      CALL DPWRST('XXX','BUG ')
14583 1689 CONTINUE
14584      GOTO1900
14585C
14586 1699 CONTINUE
14587C
14588C               *****************************************************
14589C               **  TREAT THE CASE WHEN                            **
14590C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
14591C               *****************************************************
14592C
14593      IF(ICOM.EQ.'TIC')GOTO1700
14594      IF(ICOM.EQ.'TICS')GOTO1700
14595      IF(ICOM.EQ.'XYTI')GOTO1700
14596      IF(ICOM.EQ.'YXTI')GOTO1700
14597      GOTO1799
14598C
14599 1700 CONTINUE
14600      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
14601      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
14602      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
14603      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
14604      IF(IHARG(NUMARG).EQ.'PATT')GOTO1750
14605      GOTO1760
14606C
14607 1750 CONTINUE
14608      IHOLD=IDEFPA
14609      GOTO1780
14610C
14611 1760 CONTINUE
14612      IHOLD=IHARG(NUMARG)
14613      GOTO1780
14614C
14615 1780 CONTINUE
14616      IFOUND='YES'
14617      IX1TPA=IHOLD
14618      IX2TPA=IHOLD
14619      IY1TPA=IHOLD
14620      IY2TPA=IHOLD
14621C
14622      IF(IFEEDB.EQ.'OFF')GOTO1789
14623      WRITE(ICOUT,999)
14624      CALL DPWRST('XXX','BUG ')
14625      WRITE(ICOUT,1781)
14626 1781 FORMAT('THE TIC MARK PATTERN (FOR ALL 4 ',
14627     1'FRAME LINES)')
14628      CALL DPWRST('XXX','BUG ')
14629      WRITE(ICOUT,1782)IHOLD
14630 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
14631      CALL DPWRST('XXX','BUG ')
14632 1789 CONTINUE
14633      GOTO1900
14634C
14635 1799 CONTINUE
14636C
14637 1900 CONTINUE
14638      RETURN
14639      END
14640      SUBROUTINE DPTCSZ(ICOM,IHARG,IARGT,ARG,NUMARG,
14641     1DEFTL,
14642     1PX1TLE,PX2TLE,PY1TLE,PY2TLE,
14643     1IFOUND,IERROR)
14644C
14645C     PURPOSE--DEFINE THE TIC MARK SIZES
14646C              FOR ANY OF THE 4 FRAME LINES.
14647C              SUCH TIC MARK SWITCHES DEFINE THE SIZE (LENGTH)
14648C              OF THE MAJOR TIC MARKS ON THE 4 FRAME LINES OF A PLOT.
14649C              (THE SIZE OF THE MINOR TIC MARKS IS ALWAYS
14650C              1/2 THE SIZE OF THE MAJOR TIC MARKS.)
14651C              THE TIC MARK SIZE SWITCHES FOR THE 4 FRAME LINES
14652C              ARE CONTAINED IN THE 4 VARIABLES
14653C              PX1TLE,PX2TLE,PY1TLE,PY2TLE,
14654C     INPUT  ARGUMENTS--ICOM
14655C                     --IHARG  (A  HOLLERITH VECTOR)
14656C                     --IARGT  (A  HOLLERITH VECTOR)
14657C                     --ARG    (A  FLOATING POINT VECTOR)
14658C                     --NUMARG
14659C                     --DEFTL
14660C     OUTPUT ARGUMENTS--
14661C                     --PX1TLE = BOTTOM HORIZONTAL TIC LENGTH
14662C                     --PX2TLE = TOP    HORIZONTAL TIC LENGTH
14663C                     --PY1TLE = LEFT   VERTICAL   TIC LENGTH
14664C                     --PY2TLE = RIGHT  VERTICAL   TIC LENGTH
14665C                     --IFOUND ('YES' OR 'NO' )
14666C                     --IERROR ('YES' OR 'NO' )
14667C     WRITTEN BY--JAMES J. FILLIBEN
14668C                 STATISTICAL ENGINEERING DIVISION
14669C                 INFORMATION TECHNOLOGY LABORATORY
14670C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14671C                 GAITHERSBURG, MD 20899-8980
14672C                 PHONE--301-975-2899
14673C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14674C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14675C     LANGUAGE--ANSI FORTRAN (1977)
14676C     VERSION NUMBER--82/7
14677C     ORIGINAL VERSION--OCTOBER   1980.
14678C     UPDATED         --MAY       1982.
14679C
14680C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
14681C
14682      CHARACTER*4 ICOM
14683      CHARACTER*4 IHARG
14684      CHARACTER*4 IARGT
14685      CHARACTER*4 IFOUND
14686      CHARACTER*4 IERROR
14687C
14688C---------------------------------------------------------------------
14689C
14690      DIMENSION IHARG(*)
14691      DIMENSION IARGT(*)
14692      DIMENSION ARG(*)
14693C
14694C-----COMMON----------------------------------------------------------
14695C
14696      INCLUDE 'DPCOP2.INC'
14697C
14698C-----START POINT-----------------------------------------------------
14699C
14700      IFOUND='NO'
14701      IERROR='NO'
14702C
14703      IF(NUMARG.LE.0)GOTO1900
14704      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO1090
14705      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
14706     1IHARG(2).EQ.'SIZE')GOTO1090
14707      GOTO1900
14708 1090 CONTINUE
14709C
14710C               *****************************************************
14711C               **  TREAT THE CASE WHEN                            **
14712C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
14713C               *****************************************************
14714C
14715      IF(ICOM.EQ.'XTIC')GOTO1100
14716      GOTO1199
14717C
14718 1100 CONTINUE
14719      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
14720      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
14721      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
14722      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
14723      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1150
14724      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
14725      IERROR='YES'
14726      GOTO1900
14727C
14728 1150 CONTINUE
14729      HOLD=DEFTL
14730      GOTO1180
14731C
14732 1160 CONTINUE
14733      HOLD=ARG(NUMARG)
14734      GOTO1180
14735C
14736 1180 CONTINUE
14737      IFOUND='YES'
14738      PX1TLE=HOLD
14739      PX2TLE=HOLD
14740C
14741      IF(IFEEDB.EQ.'OFF')GOTO1189
14742      WRITE(ICOUT,999)
14743  999 FORMAT(1X)
14744      CALL DPWRST('XXX','BUG ')
14745      WRITE(ICOUT,1181)
14746 1181 FORMAT('THE TIC MARK SIZE (FOR BOTH HORIZONTAL ',
14747     1'FRAME LINES)')
14748      CALL DPWRST('XXX','BUG ')
14749      WRITE(ICOUT,1182)HOLD
14750 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
14751      CALL DPWRST('XXX','BUG ')
14752 1189 CONTINUE
14753      GOTO1900
14754C
14755 1199 CONTINUE
14756C
14757C               **************************************************************
14758C               **  TREAT THE CASE WHEN                                     **
14759C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
14760C               **************************************************************
14761C
14762      IF(ICOM.EQ.'X1TI')GOTO1200
14763      GOTO1299
14764C
14765 1200 CONTINUE
14766      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
14767      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
14768      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
14769      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
14770      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1250
14771      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
14772      IERROR='YES'
14773      GOTO1900
14774C
14775 1250 CONTINUE
14776      HOLD=DEFTL
14777      GOTO1280
14778C
14779 1260 CONTINUE
14780      HOLD=ARG(NUMARG)
14781      GOTO1280
14782C
14783 1280 CONTINUE
14784      IFOUND='YES'
14785      PX1TLE=HOLD
14786C
14787      IF(IFEEDB.EQ.'OFF')GOTO1289
14788      WRITE(ICOUT,999)
14789      CALL DPWRST('XXX','BUG ')
14790      WRITE(ICOUT,1281)
14791 1281 FORMAT('THE TIC MARK SIZE (FOR THE BOTTOM HORIZONTAL ',
14792     1'FRAME LINE)')
14793      CALL DPWRST('XXX','BUG ')
14794      WRITE(ICOUT,1282)HOLD
14795 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
14796      CALL DPWRST('XXX','BUG ')
14797 1289 CONTINUE
14798      GOTO1900
14799C
14800 1299 CONTINUE
14801C
14802C               **************************************************************
14803C               **  TREAT THE CASE WHEN                                     **
14804C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
14805C               **************************************************************
14806C
14807      IF(ICOM.EQ.'X2TI')GOTO1300
14808      GOTO1399
14809C
14810 1300 CONTINUE
14811      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
14812      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
14813      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
14814      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
14815      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1350
14816      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
14817      IERROR='YES'
14818      GOTO1900
14819C
14820 1350 CONTINUE
14821      HOLD=DEFTL
14822      GOTO1380
14823C
14824 1360 CONTINUE
14825      HOLD=ARG(NUMARG)
14826      GOTO1380
14827C
14828 1380 CONTINUE
14829      IFOUND='YES'
14830      PX2TLE=HOLD
14831C
14832      IF(IFEEDB.EQ.'OFF')GOTO1389
14833      WRITE(ICOUT,999)
14834      CALL DPWRST('XXX','BUG ')
14835      WRITE(ICOUT,1381)
14836 1381 FORMAT('THE TIC MARK SIZE (FOR THE TOP HORIZONTAL ',
14837     1'FRAME LINE)')
14838      CALL DPWRST('XXX','BUG ')
14839      WRITE(ICOUT,1382)HOLD
14840 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
14841      CALL DPWRST('XXX','BUG ')
14842 1389 CONTINUE
14843      GOTO1900
14844C
14845 1399 CONTINUE
14846C
14847C               *****************************************************
14848C               **  TREAT THE CASE WHEN                            **
14849C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
14850C               *****************************************************
14851C
14852      IF(ICOM.EQ.'YTIC')GOTO1400
14853      GOTO1499
14854C
14855 1400 CONTINUE
14856      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
14857      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
14858      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
14859      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
14860      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1450
14861      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
14862      IERROR='YES'
14863      GOTO1900
14864C
14865 1450 CONTINUE
14866      HOLD=DEFTL
14867      GOTO1480
14868C
14869 1460 CONTINUE
14870      HOLD=ARG(NUMARG)
14871      GOTO1480
14872C
14873 1480 CONTINUE
14874      IFOUND='YES'
14875      PY1TLE=HOLD
14876      PY2TLE=HOLD
14877C
14878      IF(IFEEDB.EQ.'OFF')GOTO1489
14879      WRITE(ICOUT,999)
14880      CALL DPWRST('XXX','BUG ')
14881      WRITE(ICOUT,1481)
14882 1481 FORMAT('THE TIC MARK SIZE (FOR BOTH VERTICAL ',
14883     1'FRAME LINES)')
14884      CALL DPWRST('XXX','BUG ')
14885      WRITE(ICOUT,1482)HOLD
14886 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
14887      CALL DPWRST('XXX','BUG ')
14888 1489 CONTINUE
14889      GOTO1900
14890C
14891 1499 CONTINUE
14892C
14893C               **************************************************************
14894C               **  TREAT THE CASE WHEN                                     **
14895C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
14896C               **************************************************************
14897C
14898      IF(ICOM.EQ.'Y1TI')GOTO1500
14899      GOTO1599
14900C
14901 1500 CONTINUE
14902      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
14903      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
14904      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
14905      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
14906      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1550
14907      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
14908      IERROR='YES'
14909      GOTO1900
14910C
14911 1550 CONTINUE
14912      HOLD=DEFTL
14913      GOTO1580
14914C
14915 1560 CONTINUE
14916      HOLD=ARG(NUMARG)
14917      GOTO1580
14918C
14919 1580 CONTINUE
14920      IFOUND='YES'
14921      PY1TLE=HOLD
14922C
14923      IF(IFEEDB.EQ.'OFF')GOTO1589
14924      WRITE(ICOUT,999)
14925      CALL DPWRST('XXX','BUG ')
14926      WRITE(ICOUT,1581)
14927 1581 FORMAT('THE TIC MARK SIZE (FOR THE LEFT VERTICAL ',
14928     1'FRAME LINE)')
14929      CALL DPWRST('XXX','BUG ')
14930      WRITE(ICOUT,1582)HOLD
14931 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
14932      CALL DPWRST('XXX','BUG ')
14933 1589 CONTINUE
14934      GOTO1900
14935C
14936 1599 CONTINUE
14937C
14938C               **************************************************************
14939C               **  TREAT THE CASE WHEN                                     **
14940C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
14941C               **************************************************************
14942C
14943      IF(ICOM.EQ.'Y2TI')GOTO1600
14944      GOTO1699
14945C
14946 1600 CONTINUE
14947      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
14948      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
14949      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
14950      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
14951      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1650
14952      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
14953      IERROR='YES'
14954      GOTO1900
14955C
14956 1650 CONTINUE
14957      HOLD=DEFTL
14958      GOTO1680
14959C
14960 1660 CONTINUE
14961      HOLD=ARG(NUMARG)
14962      GOTO1680
14963C
14964 1680 CONTINUE
14965      IFOUND='YES'
14966      PY2TLE=HOLD
14967C
14968      IF(IFEEDB.EQ.'OFF')GOTO1689
14969      WRITE(ICOUT,999)
14970      CALL DPWRST('XXX','BUG ')
14971      WRITE(ICOUT,1681)
14972 1681 FORMAT('THE TIC MARK SIZE (FOR THE RIGHT VERTICAL ',
14973     1'FRAME LINE)')
14974      CALL DPWRST('XXX','BUG ')
14975      WRITE(ICOUT,1682)HOLD
14976 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
14977      CALL DPWRST('XXX','BUG ')
14978 1689 CONTINUE
14979      GOTO1900
14980C
14981 1699 CONTINUE
14982C
14983C               *****************************************************
14984C               **  TREAT THE CASE WHEN                            **
14985C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
14986C               *****************************************************
14987C
14988      IF(ICOM.EQ.'TIC')GOTO1700
14989      IF(ICOM.EQ.'TICS')GOTO1700
14990      IF(ICOM.EQ.'XYTI')GOTO1700
14991      IF(ICOM.EQ.'YXTI')GOTO1700
14992      GOTO1799
14993C
14994 1700 CONTINUE
14995      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
14996      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
14997      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
14998      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
14999      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1750
15000      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
15001      IERROR='YES'
15002      GOTO1900
15003C
15004 1750 CONTINUE
15005      HOLD=DEFTL
15006      GOTO1780
15007C
15008 1760 CONTINUE
15009      HOLD=ARG(NUMARG)
15010      GOTO1780
15011C
15012 1780 CONTINUE
15013      IFOUND='YES'
15014      PX1TLE=HOLD
15015      PX2TLE=HOLD
15016      PY1TLE=HOLD
15017      PY2TLE=HOLD
15018C
15019      IF(IFEEDB.EQ.'OFF')GOTO1789
15020      WRITE(ICOUT,999)
15021      CALL DPWRST('XXX','BUG ')
15022      WRITE(ICOUT,1781)
15023 1781 FORMAT('THE TIC MARK SIZE (FOR ALL 4 ',
15024     1'FRAME LINES)')
15025      CALL DPWRST('XXX','BUG ')
15026      WRITE(ICOUT,1782)HOLD
15027 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
15028      CALL DPWRST('XXX','BUG ')
15029 1789 CONTINUE
15030      GOTO1900
15031C
15032 1799 CONTINUE
15033C
15034 1900 CONTINUE
15035      RETURN
15036      END
15037      SUBROUTINE DPTCTH(ICOM,IHARG,ARG,NUMARG,
15038     1PDEFTH,
15039     1PTICTH,
15040     1IFOUND,IERROR)
15041C
15042C     PURPOSE--DEFINE THE TIC MARK THICKNESS SWITCHES
15043C              FOR ANY OF THE 4 FRAME LINES.
15044C              SUCH TIC MARK SWITCHES DESCRIBE
15045C              THE TIC MARK THICKNESS ON THE 4 FRAME LINES OF A PLOT.
15046C              THE CONTENTS OF A TIC MARK THICKNESS SWITCH ARE
15047C              A THICKNESS.
15048C              CURRENTLY, THE TIC MARK THICKNESS FOR ALL 4 SIDES
15049C              MUST BE THE SAME AND ARE CONTAINED IN THE VARIABLE
15050C              PTICTH
15051C     INPUT  ARGUMENTS--ICOM
15052C                     --IHARG  (A  HOLLERITH VECTOR)
15053C                     --ARG    (A REAL VECTOR)
15054C                     --NUMARG
15055C                     --PDEFTH
15056C     OUTPUT ARGUMENTS--PTICTH = THICKNESS FOR ALL 4 FRAME SIDE TICS
15057C                     --IFOUND ('YES' OR 'NO' )
15058C                     --IERROR ('YES' OR 'NO' )
15059C     WRITTEN BY--ALAN HECKERT
15060C                 COMPUTER SERVICES DIVISION
15061C                 INFORMATION TECHNOLOGY LABORATORY
15062C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15063C                 GAITHERSBURG, MD 20899-8980
15064C                 PHONE--301-975-2899
15065C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15066C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15067C     LANGUAGE--ANSI FORTRAN (1977)
15068C     VERSION NUMBER--89/2
15069C     ORIGINAL VERSION--JANUARY   1989.
15070C
15071C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15072C
15073      CHARACTER*4 ICOM
15074      CHARACTER*4 IHARG
15075C
15076      REAL        PDEFTH
15077C
15078C
15079      CHARACTER*4 IFOUND
15080      CHARACTER*4 IERROR
15081C
15082      REAL        PHOLD
15083C
15084C---------------------------------------------------------------------
15085C
15086      DIMENSION IHARG(*)
15087      DIMENSION ARG(*)
15088C
15089C-----COMMON----------------------------------------------------------
15090C
15091      INCLUDE 'DPCOP2.INC'
15092C
15093C-----START POINT-----------------------------------------------------
15094C
15095      IFOUND='NO'
15096      IERROR='NO'
15097C
15098      IF(NUMARG.LE.0)GOTO1900
15099      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1090
15100      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
15101     1IHARG(2).EQ.'THIC')GOTO1090
15102      GOTO1900
15103 1090 CONTINUE
15104C
15105C               *****************************************************
15106C               **  TREAT THE CASE WHEN                            **
15107C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
15108C               *****************************************************
15109C
15110      IF(ICOM.EQ.'XTIC')GOTO1100
15111      GOTO1199
15112C
15113 1100 CONTINUE
15114      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
15115      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
15116      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
15117      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
15118      IF(IHARG(NUMARG).EQ.'THIC')GOTO1150
15119      GOTO1160
15120C
15121 1150 CONTINUE
15122      PHOLD=PDEFTH
15123      GOTO1180
15124C
15125 1160 CONTINUE
15126      PHOLD=ARG(NUMARG)
15127      GOTO1180
15128C
15129 1180 CONTINUE
15130      IFOUND='YES'
15131      PTICTH=PHOLD
15132C
15133      IF(IFEEDB.EQ.'OFF')GOTO1189
15134      WRITE(ICOUT,999)
15135  999 FORMAT(1X)
15136      CALL DPWRST('XXX','BUG ')
15137      WRITE(ICOUT,1181)
15138 1181 FORMAT('THE TIC MARK THICKNESS (FOR ALL  ',
15139     1'FRAME LINES)')
15140      CALL DPWRST('XXX','BUG ')
15141      WRITE(ICOUT,1182)PHOLD
15142 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
15143      CALL DPWRST('XXX','BUG ')
15144 1189 CONTINUE
15145      GOTO1900
15146C
15147 1199 CONTINUE
15148C
15149C               **************************************************************
15150C               **  TREAT THE CASE WHEN                                     **
15151C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
15152C               **************************************************************
15153C
15154      IF(ICOM.EQ.'X1TI')GOTO1200
15155      GOTO1299
15156C
15157 1200 CONTINUE
15158      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
15159      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
15160      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
15161      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
15162      IF(IHARG(NUMARG).EQ.'THIC')GOTO1250
15163      GOTO1260
15164C
15165 1250 CONTINUE
15166      PHOLD=PDEFTH
15167      GOTO1280
15168C
15169 1260 CONTINUE
15170      PHOLD=ARG(NUMARG)
15171      GOTO1280
15172C
15173 1280 CONTINUE
15174      IFOUND='YES'
15175      PTICTH=PHOLD
15176C
15177      IF(IFEEDB.EQ.'OFF')GOTO1289
15178      WRITE(ICOUT,999)
15179      CALL DPWRST('XXX','BUG ')
15180      WRITE(ICOUT,1281)
15181 1281 FORMAT('THE TIC MARK THICKNESS (FOR ALL ',
15182     1'FRAME LINES)')
15183      CALL DPWRST('XXX','BUG ')
15184      WRITE(ICOUT,1282)PHOLD
15185 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
15186      CALL DPWRST('XXX','BUG ')
15187 1289 CONTINUE
15188      GOTO1900
15189C
15190 1299 CONTINUE
15191C
15192C               **************************************************************
15193C               **  TREAT THE CASE WHEN                                     **
15194C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
15195C               **************************************************************
15196C
15197      IF(ICOM.EQ.'X2TI')GOTO1300
15198      GOTO1399
15199C
15200 1300 CONTINUE
15201      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
15202      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
15203      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
15204      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
15205      IF(IHARG(NUMARG).EQ.'THIC')GOTO1350
15206      GOTO1360
15207C
15208 1350 CONTINUE
15209      PHOLD=PDEFTH
15210      GOTO1380
15211C
15212 1360 CONTINUE
15213      PHOLD=ARG(NUMARG)
15214      GOTO1380
15215C
15216 1380 CONTINUE
15217      IFOUND='YES'
15218      PTICTH=PHOLD
15219C
15220      IF(IFEEDB.EQ.'OFF')GOTO1389
15221      WRITE(ICOUT,999)
15222      CALL DPWRST('XXX','BUG ')
15223      WRITE(ICOUT,1381)
15224 1381 FORMAT('THE TIC MARK THICKNESS (FOR ALL ',
15225     1'FRAME LINES)')
15226      CALL DPWRST('XXX','BUG ')
15227      WRITE(ICOUT,1382)PHOLD
15228 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
15229      CALL DPWRST('XXX','BUG ')
15230 1389 CONTINUE
15231      GOTO1900
15232C
15233 1399 CONTINUE
15234C
15235C               *****************************************************
15236C               **  TREAT THE CASE WHEN                            **
15237C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
15238C               *****************************************************
15239C
15240      IF(ICOM.EQ.'YTIC')GOTO1400
15241      GOTO1499
15242C
15243 1400 CONTINUE
15244      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
15245      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
15246      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
15247      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
15248      IF(IHARG(NUMARG).EQ.'THIC')GOTO1450
15249      GOTO1460
15250C
15251 1450 CONTINUE
15252      PHOLD=PDEFTH
15253      GOTO1480
15254C
15255 1460 CONTINUE
15256      PHOLD=ARG(NUMARG)
15257      GOTO1480
15258C
15259 1480 CONTINUE
15260      IFOUND='YES'
15261      PTICTH=PHOLD
15262C
15263      IF(IFEEDB.EQ.'OFF')GOTO1489
15264      WRITE(ICOUT,999)
15265      CALL DPWRST('XXX','BUG ')
15266      WRITE(ICOUT,1481)
15267 1481 FORMAT('THE TIC MARK THICKNESS (FOR ALL',
15268     1'FRAME LINES)')
15269      CALL DPWRST('XXX','BUG ')
15270      WRITE(ICOUT,1482)PHOLD
15271 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
15272      CALL DPWRST('XXX','BUG ')
15273 1489 CONTINUE
15274      GOTO1900
15275C
15276 1499 CONTINUE
15277C
15278C               **************************************************************
15279C               **  TREAT THE CASE WHEN                                     **
15280C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
15281C               **************************************************************
15282C
15283      IF(ICOM.EQ.'Y1TI')GOTO1500
15284      GOTO1599
15285C
15286 1500 CONTINUE
15287      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
15288      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
15289      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
15290      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
15291      IF(IHARG(NUMARG).EQ.'THIC')GOTO1550
15292      GOTO1560
15293C
15294 1550 CONTINUE
15295      PHOLD=PDEFTH
15296      GOTO1580
15297C
15298 1560 CONTINUE
15299      PHOLD=ARG(NUMARG)
15300      GOTO1580
15301C
15302 1580 CONTINUE
15303      IFOUND='YES'
15304      PTICTH=PHOLD
15305C
15306      IF(IFEEDB.EQ.'OFF')GOTO1589
15307      WRITE(ICOUT,999)
15308      CALL DPWRST('XXX','BUG ')
15309      WRITE(ICOUT,1581)
15310 1581 FORMAT('THE TIC MARK THICKNESS (FOR ALL ',
15311     1'FRAME LINES)')
15312      CALL DPWRST('XXX','BUG ')
15313      WRITE(ICOUT,1582)PHOLD
15314 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
15315      CALL DPWRST('XXX','BUG ')
15316 1589 CONTINUE
15317      GOTO1900
15318C
15319 1599 CONTINUE
15320C
15321C               **************************************************************
15322C               **  TREAT THE CASE WHEN                                     **
15323C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
15324C               **************************************************************
15325C
15326      IF(ICOM.EQ.'Y2TI')GOTO1600
15327      GOTO1699
15328C
15329 1600 CONTINUE
15330      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
15331      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
15332      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
15333      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
15334      IF(IHARG(NUMARG).EQ.'THIC')GOTO1650
15335      GOTO1660
15336C
15337 1650 CONTINUE
15338      PHOLD=PDEFTH
15339      GOTO1680
15340C
15341 1660 CONTINUE
15342      PHOLD=ARG(NUMARG)
15343      GOTO1680
15344C
15345 1680 CONTINUE
15346      IFOUND='YES'
15347      PTICTH=PHOLD
15348C
15349      IF(IFEEDB.EQ.'OFF')GOTO1689
15350      WRITE(ICOUT,999)
15351      CALL DPWRST('XXX','BUG ')
15352      WRITE(ICOUT,1681)
15353 1681 FORMAT('THE TIC MARK THICKNESS (FOR ALL ',
15354     1'FRAME LINES)')
15355      CALL DPWRST('XXX','BUG ')
15356      WRITE(ICOUT,1682)PHOLD
15357 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
15358      CALL DPWRST('XXX','BUG ')
15359 1689 CONTINUE
15360      GOTO1900
15361C
15362 1699 CONTINUE
15363C
15364C               *****************************************************
15365C               **  TREAT THE CASE WHEN                            **
15366C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
15367C               *****************************************************
15368C
15369      IF(ICOM.EQ.'TIC')GOTO1700
15370      IF(ICOM.EQ.'TICS')GOTO1700
15371      IF(ICOM.EQ.'XYTI')GOTO1700
15372      IF(ICOM.EQ.'YXTI')GOTO1700
15373      GOTO1799
15374C
15375 1700 CONTINUE
15376      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
15377      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
15378      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
15379      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
15380      IF(IHARG(NUMARG).EQ.'THIC')GOTO1750
15381      GOTO1760
15382C
15383 1750 CONTINUE
15384      PHOLD=PDEFTH
15385      GOTO1780
15386C
15387 1760 CONTINUE
15388      PHOLD=ARG(NUMARG)
15389      GOTO1780
15390C
15391 1780 CONTINUE
15392      IFOUND='YES'
15393      PTICTH=PHOLD
15394C
15395      IF(IFEEDB.EQ.'OFF')GOTO1789
15396      WRITE(ICOUT,999)
15397      CALL DPWRST('XXX','BUG ')
15398      WRITE(ICOUT,1781)
15399 1781 FORMAT('THE TIC MARK THICKNESS (FOR ALL 4 ',
15400     1'FRAME LINES)')
15401      CALL DPWRST('XXX','BUG ')
15402      WRITE(ICOUT,1782)PHOLD
15403 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
15404      CALL DPWRST('XXX','BUG ')
15405 1789 CONTINUE
15406      GOTO1900
15407C
15408 1799 CONTINUE
15409C
15410 1900 CONTINUE
15411      RETURN
15412      END
15413      SUBROUTINE DPTEBA(IHARG,IARGT,ARG,NUMARG,ADETBA,MAXTEX,ATEXBA,
15414     1IBUGP2,IFOUND,IERROR)
15415C
15416C     PURPOSE--DEFINE THE TEXT BASES.
15417C              THESE ARE LOCATED IN THE VECTOR ATEXBA(.).
15418C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
15419C                     --IARGT  (A  CHARACTER VECTOR)
15420C                     --ARG
15421C                     --NUMARG
15422C                     --ADETBA
15423C                     --MAXTEX
15424C                     --IBUGP2 ('ON' OR 'OFF' )
15425C     OUTPUT ARGUMENTS--ATEXBA (A FLOATING POINT VECTOR)
15426C                     --IFOUND ('YES' OR 'NO' )
15427C                     --IERROR ('YES' OR 'NO' )
15428C     WRITTEN BY--JAMES J. FILLIBEN
15429C                 STATISTICAL ENGINEERING DIVISION
15430C                 INFORMATION TECHNOLOGY LABORATORY
15431C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15432C                 GAITHERSBURG, MD 20899-8980
15433C                 PHONE--301-975-2899
15434C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15435C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15436C     LANGUAGE--ANSI FORTRAN (1977)
15437C     VERSION NUMBER--82/7
15438C     ORIGINAL VERSION--DECEMBER  1983.
15439C
15440C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15441C
15442      CHARACTER*4 IHARG
15443      CHARACTER*4 IARGT
15444C
15445      CHARACTER*4 IBUGP2
15446      CHARACTER*4 IFOUND
15447      CHARACTER*4 IERROR
15448C
15449      CHARACTER*4 IHOLD1
15450C
15451      CHARACTER*4 ISUBN1
15452      CHARACTER*4 ISUBN2
15453      CHARACTER*4 ISTEPN
15454C
15455      DIMENSION IHARG(*)
15456      DIMENSION IARGT(*)
15457      DIMENSION ARG(*)
15458      DIMENSION ATEXBA(*)
15459C
15460C-----COMMON----------------------------------------------------------
15461C
15462      INCLUDE 'DPCOP2.INC'
15463C
15464C-----START POINT-----------------------------------------------------
15465C
15466      IFOUND='NO'
15467      IERROR='NO'
15468      ISUBN1='DPTE'
15469      ISUBN2='BA  '
15470C
15471      NUMTEX=0
15472      IHOLD1='-999'
15473      HOLD1=-999.0
15474      HOLD2=-999.0
15475C
15476      IF(IBUGP2.EQ.'OFF')GOTO90
15477      WRITE(ICOUT,999)
15478  999 FORMAT(1X)
15479      CALL DPWRST('XXX','BUG ')
15480      WRITE(ICOUT,51)
15481   51 FORMAT('***** AT THE BEGINNING OF DPTEBA--')
15482      CALL DPWRST('XXX','BUG ')
15483      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
15484   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
15485      CALL DPWRST('XXX','BUG ')
15486      WRITE(ICOUT,53)MAXTEX,NUMTEX
15487   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
15488      CALL DPWRST('XXX','BUG ')
15489      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
15490   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
15491      CALL DPWRST('XXX','BUG ')
15492      WRITE(ICOUT,55)ADETBA
15493   55 FORMAT('ADETBA = ',E15.7)
15494      CALL DPWRST('XXX','BUG ')
15495      WRITE(ICOUT,60)NUMARG
15496   60 FORMAT('NUMARG = ',I8)
15497      CALL DPWRST('XXX','BUG ')
15498      DO65I=1,NUMARG
15499      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
15500   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
15501      CALL DPWRST('XXX','BUG ')
15502   65 CONTINUE
15503      WRITE(ICOUT,70)ATEXBA(1)
15504   70 FORMAT('ATEXBA(1) = ',E15.7)
15505      CALL DPWRST('XXX','BUG ')
15506      DO75I=1,10
15507      WRITE(ICOUT,76)I,ATEXBA(I)
15508   76 FORMAT('I,ATEXBA(I) = ',I8,2X,E15.7)
15509      CALL DPWRST('XXX','BUG ')
15510   75 CONTINUE
15511   90 CONTINUE
15512C
15513C               **************************************
15514C               **  STEP 1--                        **
15515C               **  BRANCH TO THE APPROPRIATE CASE  **
15516C               **************************************
15517C
15518      ISTEPN='1'
15519      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15520C
15521      IF(NUMARG.LE.0)GOTO9000
15522      IF(NUMARG.EQ.1)GOTO1110
15523      IF(NUMARG.EQ.2)GOTO1120
15524      IF(NUMARG.EQ.3)GOTO1130
15525      GOTO1140
15526C
15527 1110 CONTINUE
15528      GOTO1200
15529C
15530 1120 CONTINUE
15531      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
15532      IF(IHARG(2).EQ.'ALL')HOLD1=ADETBA
15533      IF(IHARG(2).EQ.'ALL')GOTO1300
15534      GOTO1200
15535C
15536 1130 CONTINUE
15537      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
15538      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
15539      IF(IHARG(2).EQ.'ALL')GOTO1300
15540      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
15541      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
15542      IF(IHARG(3).EQ.'ALL')GOTO1300
15543      GOTO1200
15544C
15545 1140 CONTINUE
15546      GOTO1200
15547C
15548C               *************************************************
15549C               **  STEP 2--                                   **
15550C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
15551C               *************************************************
15552C
15553 1200 CONTINUE
15554      ISTEPN='2'
15555      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15556C
15557      IF(NUMARG.LE.1)GOTO1210
15558      GOTO1220
15559C
15560 1210 CONTINUE
15561      NUMTEX=1
15562      ATEXBA(1)=ADETBA
15563      GOTO1270
15564C
15565 1220 CONTINUE
15566      NUMTEX=NUMARG-1
15567      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
15568      DO1225I=1,NUMTEX
15569      J=I+1
15570      IHOLD1=IHARG(J)
15571      HOLD1=ARG(J)
15572      HOLD2=HOLD1
15573      IF(IHOLD1.EQ.'ON')HOLD2=ADETBA
15574      IF(IHOLD1.EQ.'OFF')HOLD2=ADETBA
15575      IF(IHOLD1.EQ.'AUTO')HOLD2=ADETBA
15576      IF(IHOLD1.EQ.'DEFA')HOLD2=ADETBA
15577      ATEXBA(I)=HOLD2
15578 1225 CONTINUE
15579      GOTO1270
15580C
15581 1270 CONTINUE
15582      IF(IFEEDB.EQ.'OFF')GOTO1279
15583      WRITE(ICOUT,999)
15584      CALL DPWRST('XXX','BUG ')
15585      DO1278I=1,NUMTEX
15586      WRITE(ICOUT,1276)I,ATEXBA(I)
15587 1276 FORMAT('THE BASE OF TEXT ',I6,
15588     1' HAS JUST BEEN SET TO ',E15.7)
15589      CALL DPWRST('XXX','BUG ')
15590 1278 CONTINUE
15591 1279 CONTINUE
15592      IFOUND='YES'
15593      GOTO9000
15594C
15595C               **************************
15596C               **  STEP 3--            **
15597C               **  TREAT THE ALL CASE  **
15598C               **************************
15599C
15600 1300 CONTINUE
15601      ISTEPN='3'
15602      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15603C
15604      NUMTEX=MAXTEX
15605      HOLD2=HOLD1
15606      IF(IHOLD1.EQ.'ON')HOLD2=ADETBA
15607      IF(IHOLD1.EQ.'OFF')HOLD2=ADETBA
15608      IF(IHOLD1.EQ.'AUTO')HOLD2=ADETBA
15609      IF(IHOLD1.EQ.'DEFA')HOLD2=ADETBA
15610      DO1315I=1,NUMTEX
15611      ATEXBA(I)=HOLD2
15612 1315 CONTINUE
15613      GOTO1370
15614C
15615 1370 CONTINUE
15616      IF(IFEEDB.EQ.'OFF')GOTO1319
15617      WRITE(ICOUT,999)
15618      CALL DPWRST('XXX','BUG ')
15619      I=1
15620      WRITE(ICOUT,1316)ATEXBA(I)
15621 1316 FORMAT('THE BASE OF ALL TEXTS',
15622     1' HAS JUST BEEN SET TO ',E15.7)
15623      CALL DPWRST('XXX','BUG ')
15624 1319 CONTINUE
15625      IFOUND='YES'
15626      GOTO9000
15627C
15628C               *****************
15629C               **  STEP 90--  **
15630C               **  EXIT       **
15631C               *****************
15632C
15633 9000 CONTINUE
15634      IF(IBUGP2.EQ.'OFF')GOTO9090
15635      WRITE(ICOUT,9011)
15636 9011 FORMAT('***** AT THE END       OF DPTEBA--')
15637      CALL DPWRST('XXX','BUG ')
15638      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
15639 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
15640      CALL DPWRST('XXX','BUG ')
15641      WRITE(ICOUT,9013)MAXTEX,NUMTEX
15642 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
15643      CALL DPWRST('XXX','BUG ')
15644      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
15645 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
15646      CALL DPWRST('XXX','BUG ')
15647      WRITE(ICOUT,9015)ADETBA
15648 9015 FORMAT('ADETBA = ',E15.7)
15649      CALL DPWRST('XXX','BUG ')
15650      WRITE(ICOUT,9020)NUMARG
15651 9020 FORMAT('NUMARG = ',I8)
15652      CALL DPWRST('XXX','BUG ')
15653      DO9025I=1,NUMARG
15654      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
15655 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
15656      CALL DPWRST('XXX','BUG ')
15657 9025 CONTINUE
15658      WRITE(ICOUT,9030)ATEXBA(1)
15659 9030 FORMAT('ATEXBA(1) = ',E15.7)
15660      CALL DPWRST('XXX','BUG ')
15661      DO9035I=1,10
15662      WRITE(ICOUT,9036)I,ATEXBA(I)
15663 9036 FORMAT('I,ATEXBA(I) = ',I8,2X,E15.7)
15664      CALL DPWRST('XXX','BUG ')
15665 9035 CONTINUE
15666 9090 CONTINUE
15667C
15668      RETURN
15669      END
15670      SUBROUTINE DPTECH(IHARG,NUMARG,
15671     1IDEFTC,
15672     1ITERCH,
15673     1IBUGS2,IFOUND,IERROR)
15674C
15675C     PURPOSE--DEFINE THE TERMINATOR CHARACTOR WHICH MAY
15676C              BE USED TO PUT MULTIPLE COMMAND STATEMENTS
15677C              ON A SINGLE COMMAND LINE.
15678C              WHEN A COMMAND LINE IS READ,
15679C              IT IS SEARCHED FOR THE TERMINATOR CHARACTER;
15680C              IF IT IS FOUND, THE COMMAND STATEMENT
15681C              BEFORE THE TERMINATOR CHARACTOR IS EXECUTED;
15682C              AFTER EXECUTION, THE COMMAND STAEMENT AFTER THE
15683C              TERMINATOR CHARACTOR IS EXECUTED.
15684C              ANY NUMBER OF TERMINATOR CHARACTORS ARE ALLOWED PER LINE.
15685C              THE COMMAND CHARACTER CAPABILITY ALLOWS THE ANALYST
15686C              TO PACK SEVERAL COMMANDS PER LINE.
15687C              THE SPECIFIED TERMINATOR CHARACTOR WILL BE PLACED
15688C              IN THE CHARACTER VARIABLE ITERCH.
15689C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
15690C                     --NUMARG (AN INTEGER VARIABLE)
15691C                     --IDEFTC (A  CHARACTER VARIABLE)
15692C                     --IBUGS2 (A  CHARACTER VARIABLE)
15693C     OUTPUT ARGUMENTS--ITERCH (A CHARACTER VARIABLE)
15694C                     --IFOUND ('YES' OR 'NO' )
15695C                     --IERROR ('YES' OR 'NO' )
15696C     WRITTEN BY--JAMES J. FILLIBEN
15697C                 STATISTICAL ENGINEERING DIVISION
15698C                 INFORMATION TECHNOLOGY LABORATORY
15699C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15700C                 GAITHERSBURG, MD 20899-8980
15701C                 PHONE--301-975-2899
15702C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15703C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15704C     LANGUAGE--ANSI FORTRAN (1977)
15705C     VERSION NUMBER--82/7
15706C     ORIGINAL VERSION--NOVEMBER 1980.
15707C     UPDATED         --MAY       1982.
15708C
15709C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15710C
15711      CHARACTER*4 IHARG
15712      CHARACTER*4 IDEFTC
15713      CHARACTER*4 ITERCH
15714      CHARACTER*4 IBUGS2
15715      CHARACTER*4 IFOUND
15716      CHARACTER*4 IERROR
15717C
15718      CHARACTER*4 IHOLD
15719C
15720C---------------------------------------------------------------------
15721C
15722      DIMENSION IHARG(*)
15723C
15724C-----COMMON----------------------------------------------------------
15725C
15726      INCLUDE 'DPCOP2.INC'
15727C
15728C-----START POINT-----------------------------------------------------
15729C
15730      IF(IBUGS2.EQ.'OFF')GOTO90
15731      WRITE(ICOUT,999)
15732  999 FORMAT(1X)
15733      CALL DPWRST('XXX','BUG ')
15734      WRITE(ICOUT,51)
15735   51 FORMAT('***** AT THE BEGINNING OF DPTECH--')
15736      CALL DPWRST('XXX','BUG ')
15737      WRITE(ICOUT,53)IDEFTC
15738   53 FORMAT('IDEFTC = ',A4)
15739      CALL DPWRST('XXX','BUG ')
15740      WRITE(ICOUT,54)NUMARG
15741   54 FORMAT('NUMARG = ',I8)
15742      CALL DPWRST('XXX','BUG ')
15743      DO55I=1,NUMARG
15744      WRITE(ICOUT,56)I,IHARG(I)
15745   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
15746      CALL DPWRST('XXX','BUG ')
15747   55 CONTINUE
15748   90 CONTINUE
15749C
15750      IFOUND='NO'
15751      IERROR='NO'
15752C
15753      IF(NUMARG.LE.0)GOTO1150
15754      GOTO1110
15755C
15756 1110 CONTINUE
15757      IF(NUMARG.LE.1)GOTO1150
15758      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
15759      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
15760      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
15761      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
15762      GOTO1160
15763C
15764 1150 CONTINUE
15765      IHOLD=IDEFTC
15766      GOTO1180
15767C
15768 1160 CONTINUE
15769      IHOLD=IHARG(NUMARG)
15770      GOTO1180
15771C
15772 1180 CONTINUE
15773      IFOUND='YES'
15774      ITERCH=IHOLD
15775C
15776      IF(IFEEDB.EQ.'OFF')GOTO1189
15777      WRITE(ICOUT,999)
15778      CALL DPWRST('XXX','BUG ')
15779      WRITE(ICOUT,1181)ITERCH
15780 1181 FORMAT('THE TERMINATOR CHARACTOR HAVE JUST BEEN SET TO ',
15781     1A4)
15782      CALL DPWRST('XXX','BUG ')
15783 1189 CONTINUE
15784      GOTO9000
15785C
15786 9000 CONTINUE
15787      IF(IBUGS2.EQ.'OFF')GOTO9090
15788      WRITE(ICOUT,999)
15789      CALL DPWRST('XXX','BUG ')
15790      WRITE(ICOUT,9011)
15791 9011 FORMAT('***** AT THE END       OF DPECH--')
15792      CALL DPWRST('XXX','BUG ')
15793      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
15794 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
15795      CALL DPWRST('XXX','BUG ')
15796      WRITE(ICOUT,9013)IDEFTC,ITERCH
15797 9013 FORMAT('IDEFTC,ITERCH = ',A4,2X,A4)
15798      CALL DPWRST('XXX','BUG ')
15799 9090 CONTINUE
15800C
15801      RETURN
15802      END
15803      SUBROUTINE DPTEXT(IANS,IANSLC,IWIDTH,
15804     1                  ITEXTE,NCTEX,
15805     1                  PXSTAR,PYSTAR,PXEND,PYEND,
15806     1                  IGRASW,IDIASW,PRV,PDIARV,
15807     1                  ILINPA,ILINCO,PLINTH,
15808     1                  ATEXBA,ITEBLI,ITEBCO,PTEBTH,
15809     1                  ITEFSW,ITEFCO,
15810     1                  ITEPTY,ITEPLI,ITEPCO,PTEPTH,PTEPSP,
15811     1                  PTEXMR,ITEXCV,ATEXAN,PTEXRV,
15812     1                  IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
15813     1                  IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
15814     1                  NUMDEV,IDMANU,IDMODE,IDMOD2,IDMOD3,
15815     1                  IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
15816     1                  IDNVOF,IDNHOF,IDFONT,PDSCAL,
15817     1                  IMPSW2,AMPSCH,AMPSCW,
15818     1                  IBUGD2,IFOUND,IERROR)
15819C
15820C     PURPOSE--WRITE OUT A TEXT STRING.
15821C
15822C     WRITTEN BY--JAMES J. FILLIBEN
15823C                 STATISTICAL ENGINEERING DIVISION
15824C                 INFORMATION TECHNOLOGY LABORATORY
15825C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15826C                 GAITHERSBURG, MD 20899-8980
15827C                 PHONE--301-975-2899
15828C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15829C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15830C     LANGUAGE--ANSI FORTRAN (1977)
15831C     VERSION NUMBER--83.6
15832C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
15833C     UPDATED         --DECEMBER    1986.
15834C     UPDATED         --JULY        1988.
15835C     UPDATED         --JANUARY     1989.  CALL LIST FOR OFFSET
15836C                                          VARIABLES (ALAN)
15837C     UPDATED         --MARCH       1993.
15838C     UPDATED         --SEPTEMBER   1993. ALLOW LOWER CASE
15839C     UPDATED         --MARCH       1997. DEVICE FONT SUPPORT
15840C     UPDATED         --DECEMBER    2018. SUPPORT FOR DEVICE ... SCALE
15841C                                         COMMAND (PDSCAL TO CALL LIST)
15842C
15843C-----NON-COMMON VARIABLES (GRAPHICS)-----------------------------------
15844C
15845      CHARACTER*4 IANS
15846CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
15847CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
15848      CHARACTER*4 IANSLC
15849C
15850      CHARACTER*4 IGRASW
15851      CHARACTER*4 IDIASW
15852C
15853      CHARACTER*4 ILINPA
15854      CHARACTER*4 ILINCO
15855C
15856      CHARACTER*4 ITEBLI
15857      CHARACTER*4 ITEBCO
15858      CHARACTER*4 ITEFSW
15859      CHARACTER*4 ITEFCO
15860      CHARACTER*4 ITEPTY
15861      CHARACTER*4 ITEPLI
15862      CHARACTER*4 ITEPCO
15863C
15864      CHARACTER*4 ITEXTE
15865      CHARACTER*4 ITEXFO
15866      CHARACTER*4 ITEXCA
15867      CHARACTER*4 ITEXJU
15868      CHARACTER*4 ITEXDI
15869      CHARACTER*4 ITEXFI
15870      CHARACTER*4 ITEXCO
15871C
15872      CHARACTER*4 ITEXCR
15873      CHARACTER*4 ITEXLF
15874C
15875      CHARACTER*4 ITEXSY
15876      CHARACTER*4 ITEXSP
15877C
15878      CHARACTER*4 IHNAME
15879      CHARACTER*4 IHNAM2
15880      CHARACTER*4 IUSE
15881      CHARACTER*4 IFUNC
15882C
15883      CHARACTER*1 IREPCH
15884C
15885      CHARACTER*4 IMPSW2
15886C
15887      CHARACTER*4 IDMANU
15888      CHARACTER*4 IDMODE
15889      CHARACTER*4 IDMOD2
15890      CHARACTER*4 IDMOD3
15891      CHARACTER*4 IDPOWE
15892      CHARACTER*4 IDCONT
15893      CHARACTER*4 IDCOLO
15894CCCCC ADD FOLLOWING LINE MARCH 1997.
15895      CHARACTER*4 IDFONT
15896C
15897      CHARACTER*4 IBUGD2
15898      CHARACTER*4 IFOUND
15899      CHARACTER*4 IERROR
15900C
15901      CHARACTER*4 IBELSW
15902      CHARACTER*4 IERASW
15903      CHARACTER*4 ICOPSW
15904      CHARACTER*4 IBACCO
15905C
15906      CHARACTER*4 ICTEXT
15907C
15908      CHARACTER*4 IFONT
15909      CHARACTER*4 ICASE
15910      CHARACTER*4 IJUST
15911      CHARACTER*4 IDIR
15912      CHARACTER*4 IFILL
15913      CHARACTER*4 ICOL
15914C
15915      CHARACTER*24 ISYMBL
15916      CHARACTER*4 ISPAC
15917C
15918      CHARACTER*4 ITEXCV
15919C
15920      DIMENSION PRV(6)
15921      DIMENSION PDIARV(4)
15922      DIMENSION ITEXCV(10)
15923      DIMENSION PTEXRV(5)
15924C
15925      DIMENSION IANS(*)
15926CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
15927CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
15928      DIMENSION IANSLC(*)
15929C
15930      DIMENSION ILINPA(*)
15931      DIMENSION ILINCO(*)
15932      DIMENSION PLINTH(*)
15933C
15934      DIMENSION ATEXBA(*)
15935      DIMENSION ITEBLI(*)
15936      DIMENSION ITEBCO(*)
15937      DIMENSION PTEBTH(*)
15938      DIMENSION ITEFSW(*)
15939      DIMENSION ITEFCO(*)
15940      DIMENSION ITEPTY(*)
15941      DIMENSION ITEPLI(*)
15942      DIMENSION ITEPCO(*)
15943      DIMENSION PTEPTH(*)
15944      DIMENSION PTEPSP(*)
15945      DIMENSION PDSCAL(*)
15946C
15947      DIMENSION ITEXTE(*)
15948C
15949      DIMENSION IHNAME(*)
15950      DIMENSION IHNAM2(*)
15951      DIMENSION IUSE(*)
15952      DIMENSION IVALUE(*)
15953      DIMENSION VALUE(*)
15954      DIMENSION IVSTAR(*)
15955      DIMENSION IVSTOP(*)
15956      DIMENSION IFUNC(*)
15957C
15958C
15959      DIMENSION IDMANU(*)
15960      DIMENSION IDMODE(*)
15961      DIMENSION IDMOD2(*)
15962      DIMENSION IDMOD3(*)
15963      DIMENSION IDPOWE(*)
15964      DIMENSION IDCONT(*)
15965      DIMENSION IDCOLO(*)
15966CCCCC ADD FOLLOWING LINE MARCH 1997.
15967      DIMENSION IDFONT(*)
15968      DIMENSION IDNVPP(*)
15969      DIMENSION IDNHPP(*)
15970      DIMENSION IDUNIT(*)
15971C
15972      DIMENSION IDNVOF(*)
15973      DIMENSION IDNHOF(*)
15974C
15975CCCCC DIMENSION ICTEXT(130)
15976      INCLUDE 'DPCOPA.INC'
15977      DIMENSION ICTEXT(MAXCH)
15978C
15979C-----COMMON----------------------------------------------------------
15980C
15981      INCLUDE 'DPCOGR.INC'
15982      INCLUDE 'DPCOBE.INC'
15983      INCLUDE 'DPCOP2.INC'
15984C
15985C-----START POINT-----------------------------------------------------
15986C
15987      PGRAXF=PRV(1)
15988      PGRAYF=PRV(2)
15989      PDIAXC=PRV(3)
15990      PDIAYC=PRV(4)
15991      PDIAX2=PRV(5)
15992      PDIAY2=PRV(6)
15993C
15994      PDIAHE=PDIARV(1)
15995      PDIAWI=PDIARV(2)
15996      PDIAVG=PDIARV(3)
15997      PDIAHG=PDIARV(4)
15998C
15999      ITEXFO=ITEXCV(1)
16000      ITEXCA=ITEXCV(2)
16001      ITEXJU=ITEXCV(3)
16002      ITEXDI=ITEXCV(4)
16003      ITEXCR=ITEXCV(5)
16004      ITEXLF=ITEXCV(6)
16005      ITEXSY=ITEXCV(7)
16006      ITEXSP=ITEXCV(8)
16007      ITEXFI=ITEXCV(9)
16008      ITEXCO=ITEXCV(10)
16009C
16010      PTEXHE=PTEXRV(1)
16011      PTEXWI=PTEXRV(2)
16012      PTEXVG=PTEXRV(3)
16013      PTEXHG=PTEXRV(4)
16014      PTEXTH=PTEXRV(5)
16015C
16016      IFOUND='NO'
16017      IERROR='NO'
16018C
16019      J2=0
16020C
16021      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TEXT')THEN
16022        WRITE(ICOUT,999)
16023  999   FORMAT(1X)
16024        CALL DPWRST('XXX','BUG ')
16025        WRITE(ICOUT,51)
16026   51   FORMAT('***** AT THE BEGINNING OF DPTEXT--')
16027        CALL DPWRST('XXX','BUG ')
16028        WRITE(ICOUT,53)IWIDTH,NUMNAM,NUMDEV
16029   53   FORMAT('IWIDTH,NUMNAM,NUMDEV= ',3I8)
16030        CALL DPWRST('XXX','BUG ')
16031        WRITE(ICOUT,54)(IANS(I),I=1,MIN(25,IWIDTH))
16032   54   FORMAT('(IANS(I),I=1,IWIDTH) = ',25A4)
16033        CALL DPWRST('XXX','BUG ')
16034        WRITE(ICOUT,58)IDIASW,PDIAXC,PDIAYC
16035   58   FORMAT('IDIASW,PDIAXC,PDIAYC = ',A4,2X,2G15.7)
16036        CALL DPWRST('XXX','BUG ')
16037        WRITE(ICOUT,60)PXSTAR,PYSTAR,PXEND,PYEND
16038   60   FORMAT('PXSTAR,PYSTAR,PXEND,PYEND = ',4G15.7)
16039        CALL DPWRST('XXX','BUG ')
16040        WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
16041   61   FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',2(A4,2X),G15.7)
16042        CALL DPWRST('XXX','BUG ')
16043        WRITE(ICOUT,62)ATEXBA(1),PTEBTH(1)
16044   62   FORMAT('ATEXBA(1),PTEBTH(1) = ',2G15.7)
16045        CALL DPWRST('XXX','BUG ')
16046        WRITE(ICOUT,63)ITEBLI(1),ITEBCO(1),ITEFSW(1),ITEFCO(1)
16047   63   FORMAT('ITEBLI(1),ITEBCO(1),ITEFSW(1),ITEFCO = ',3(A4,2X),A4)
16048        CALL DPWRST('XXX','BUG ')
16049        WRITE(ICOUT,65)ITEPTY(1),ITEPLI(1),ITEPCO(1),PTEPTH(1),PTEPSP(1)
16050   65   FORMAT('ITEPTY(1),ITEPLI(1),ITEPCO(1),PTEPTH(1),PTEPSP(1) = ',
16051     1         3(A4,2X),2G15.7)
16052        CALL DPWRST('XXX','BUG ')
16053        WRITE(ICOUT,66)ITEXCR,ITEXLF,PTEXMR
16054   66   FORMAT('ITEXCR,ITEXLF,PTEXMR = ',2(A4,2X),G15.7)
16055        CALL DPWRST('XXX','BUG ')
16056        WRITE(ICOUT,67)ITEXSY,ITEXSP,ITEXFO,ITEXCA,ITEXJU
16057   67   FORMAT('ITEXSY,ITEXSP,ITEXFO,ITEXCA,ITEXJU = ',4(A4,2X),A4)
16058        CALL DPWRST('XXX','BUG ')
16059        WRITE(ICOUT,68)ITEXDI,ATEXAN,ITEXFI,ITEXCO
16060   68   FORMAT('ITEXDI,ATEXAN,ITEXFI,ITEXCO = ',3(A4,2X),A4)
16061        CALL DPWRST('XXX','BUG ')
16062        WRITE(ICOUT,70)PTEXHE,PTEXWI,PTEXVG,PTEXHG,PTEXTH
16063   70   FORMAT('PTEXHE,PTEXWI,PTEXVG,PTEXHG,PTEXTH= ',5G15.7)
16064        CALL DPWRST('XXX','BUG ')
16065        DO76I=1,NUMNAM
16066          WRITE(ICOUT,77)I,IHNAME(I),IHNAM2(I),IUSE(I),
16067     1                   IVALUE(I),VALUE(I)
16068   77     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)= ',
16069     1           I8,3(2X,A4),I8,G15.7)
16070          CALL DPWRST('XXX','BUG ')
16071   76   CONTINUE
16072        DO81I=1,NUMDEV
16073          WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
16074   82     FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
16075     1           3(A4,2X),A4)
16076          CALL DPWRST('XXX','BUG ')
16077          WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
16078   83     FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',2(A4,2X),A4)
16079          CALL DPWRST('XXX','BUG ')
16080          WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
16081   84     FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',3I8)
16082          CALL DPWRST('XXX','BUG ')
16083   81   CONTINUE
16084        WRITE(ICOUT,87)ISUBG4,IERRG4,IBUGD2,IFOUND,IERROR,IREPCH
16085   87   FORMAT('ISUBG4,IERRG4,IBUGD2,IFOUND,IERROR,IREPCH = ',
16086     1         5(A4,2X),A1)
16087        CALL DPWRST('XXX','BUG ')
16088      ENDIF
16089C
16090C               *****************************************************
16091C               **  STEP 1--                                       **
16092C               **  EXTRACT THE TEXT STRING FROM THE COMMAND LINE  **
16093C               *****************************************************
16094C
16095C               *****************************************
16096C               **  STEP 1.1--                         **
16097C               **  DETERMINE THE COMMAND              **
16098C               **  (TEXT) AND ITS LOCATION            **
16099C               **  ON THE LINE.                       **
16100C               **  DETERMINE THE START POSITION       **
16101C               **  (XSTART) OF THE FIRST CHARACTER    **
16102C               **  FOR THE STRING TO BE PRINTED.      **
16103C               *****************************************
16104C
16105      DO1115I=1,IWIDTH
16106        IP1=I+1
16107        IP2=I+2
16108        IP3=I+3
16109        IP4=I+4
16110        IP5=I+5
16111C
16112        IF(IP3.EQ.IWIDTH)GOTO1190
16113        IF(IP4.EQ.IWIDTH)GOTO1190
16114        IF(IANS(I).EQ.'T'.AND.IANS(IP1).EQ.'E'.AND.
16115     1     IANS(IP2).EQ.'X'.AND.IANS(IP3).EQ.'T'.AND.
16116     1     IANS(IP4).EQ.' ')GOTO1190
16117 1115 CONTINUE
16118C
16119      WRITE(ICOUT,1131)
16120 1131 FORMAT('***** ERROR IN DPTEXT--')
16121      CALL DPWRST('XXX','BUG ')
16122      WRITE(ICOUT,1132)
16123 1132 FORMAT('      NO MATCH FOR COMMAND.')
16124      CALL DPWRST('XXX','BUG ')
16125      IERROR='YES'
16126      GOTO9000
16127C
16128 1190 CONTINUE
16129C
16130C               ********************************************************
16131C               **  STEP 1.2--                                        **
16132C               **  DEFINE THE STOP  POSITION (ISTOP) FOR THE STRING. **
16133C               ********************************************************
16134C
16135      IFOUND='YES'
16136C
16137      ISTART=IP5
16138      ISTOP=0
16139      IF(ISTART.LE.IWIDTH)THEN
16140        DO1220I=ISTART,IWIDTH
16141          IREV=IWIDTH-I+ISTART
16142          IF(IANS(IREV).NE.' ')THEN
16143            ISTOP=IREV
16144            GOTO1225
16145          ENDIF
16146 1220   CONTINUE
16147 1225   CONTINUE
16148      ENDIF
16149C
16150C               *****************************************
16151C               **  STEP 1.3--                         **
16152C               **  COPY OVER THE STRING OF INTEREST.  **
16153C               *****************************************
16154C
16155      IF(ISTART.GT.ISTOP .OR. ISTOP.EQ.0)THEN
16156        NCTEX=0
16157      ELSE
16158C       SEPTEMBER, 1987 (CHECK IF MAXIMUM SIZE STRING EXCEEDED)
16159        ITEMP=ISTOP-ISTART+1
16160        IF(ITEMP.GT.MAXCH)ITEMP=MAXCH
16161        ISTOP=ISTART+ITEMP-1
16162C
16163        J=0
16164        DO1310I=ISTART,ISTOP
16165          J=J+1
16166          J2=J
16167CCCCC     THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
16168CCCCC     TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
16169CCCCC     CHECK FOR CASE "ASIS"              OCTOBER   1993
16170CCCCC     ITEXTE(J)=IANS(I)
16171          IF(ITEXCA.EQ.'ASIS')THEN
16172            ITEXTE(J)=IANSLC(I)
16173          ELSE
16174            ITEXTE(J)=IANS(I)
16175          ENDIF
16176 1310   CONTINUE
16177        NCTEX=J2
16178      ENDIF
16179C
16180C               ******************************************
16181C               **  STEP 1.4--                          **
16182C               **  COPY OVER THE ORIGINAL TEXT STRING  **
16183C               **  SO AS TO PRESERVE IT IN COMMON.     **
16184C               ******************************************
16185C
16186      NCTEXT=NCTEX
16187      IF(NCTEX.GT.0)THEN
16188        DO1410I=1,NCTEX
16189          ICTEXT(I)=ITEXTE(I)
16190 1410   CONTINUE
16191      ENDIF
16192C
16193C               ******************************************************
16194C               **  STEP 1.4--                                      **
16195C               **  CALL THE SUBROUTINE DPREPL                      **
16196C               **  WHICH WILL SCAN THE STRING FOR ALL OCCURRANCES  **
16197C               **  OF THE SUBSTRING VALU()                         **
16198C               **  AND REPLACE THEM BY THEIR LITERAL VALUES.       **
16199C               ******************************************************
16200C
16201      IF(NCTEXT.GE.1)CALL DPREPL(ICTEXT,NCTEXT,
16202     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
16203     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
16204     1IBUGD2,IERROR)
16205C
16206C               ********************************
16207C               **  STEP 2--                  **
16208C               **  STEP THROUGH EACH DEVICE  **
16209C               ********************************
16210C
16211      IF(NUMDEV.LE.0)GOTO9000
16212C  JULY, 1988.  BUG: IF DEVICE 1 OFF AND DEVICE 2 ON,
16213C  STARTING COORDINATES PX1 AND PY1 WERE NOT GETTING SET.
16214C  MOVE FROM INSIDE LOOP TO HERE.
16215      PX1=PXSTAR
16216      PY1=PYSTAR
16217C  END BUG FIX
16218      DO8000IDEVIC=1,NUMDEV
16219C
16220        IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
16221        IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
16222        IF(IDMANU(IDEVIC).EQ.'OFF')GOTO8000
16223        IF(IDMANU(IDEVIC).EQ.'NULL')GOTO8000
16224        IF(IDMANU(IDEVIC).EQ.'NONE')GOTO8000
16225        IF(IDMANU(IDEVIC).EQ.'DISC')GOTO8000
16226C
16227        IMANUF=IDMANU(IDEVIC)
16228        IMODEL=IDMODE(IDEVIC)
16229        IMODE2=IDMOD2(IDEVIC)
16230        IMODE3=IDMOD3(IDEVIC)
16231        IGCOLO=IDCOLO(IDEVIC)
16232        IGFONT=IDFONT(IDEVIC)
16233        NUMVPP=IDNVPP(IDEVIC)
16234        NUMHPP=IDNHPP(IDEVIC)
16235        ANUMVP=NUMVPP
16236        ANUMHP=NUMHPP
16237        IOFFSV=IDNVOF(IDEVIC)
16238        IOFFSH=IDNHOF(IDEVIC)
16239        IGUNIT=IDUNIT(IDEVIC)
16240        PCHSCA=PDSCAL(IDEVIC)
16241C
16242C               ************************************
16243C               **  STEP 3--                      **
16244C               **  CARRY OUT OPENING OPERATIONS  **
16245C               **  ON THE GRAPHICS DEVICES       **
16246C               ************************************
16247C
16248        CALL DPOPDE()
16249C
16250        IBELSW='OFF'
16251        NUMRIN=0
16252        IERASW='OFF'
16253        IBACCO='JUNK'
16254C
16255        CALL DPOPPL(IGRASW,IBELSW,NUMRIN,IERASW,IBACCO)
16256C
16257C               *****************************
16258C               **  STEP 4--               **
16259C               **  WRITE OUT THE TEXT     **
16260C               *****************************
16261C
16262        IFONT=ITEXFO
16263        ICASE=ITEXCA
16264        IJUST=ITEXJU
16265        IDIR=ITEXDI
16266        ANGLE=ATEXAN
16267        IFILL=ITEXFI
16268        ICOL=ITEXCO
16269        PHEIGH=PTEXHE
16270        PWIDTH=PTEXWI
16271        PHOGAP=PTEXHG
16272        PVEGAP=PTEXVG
16273        PTHICK=PTEXTH
16274        ISYMBL=ITEXSY
16275        ISPAC=ITEXSP
16276C
16277C      JULY, 1988.  MOVE FOLLOWING 4 LINES TO BEFORE LOOP.
16278CCCCC   IF(IDEVIC.GE.2)GOTO1610
16279CCCCC   PX1=PXSTAR
16280CCCCC   PY1=PYSTAR
16281C1610   CONTINUE
16282C
16283        IF(NCTEXT.GE.1)CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
16284     1     IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
16285     1     PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
16286     1     ISYMBL,ISPAC,
16287     1     IMPSW2,AMPSCH,AMPSCW,
16288     1     PX99,PY99)
16289C
16290CCCCC   MARCH 1993.  MOVE FOLLOWING SECTION OUTSIDE LOOP.
16291CCCCC   IF(IDEVIC.GE.2)GOTO1690
16292CCCCC   PXEND=PX99
16293CCCCC   PYEND=PY99
16294CCCCC   IF(ITEXCR.EQ.'ON')PXEND=PTEXMR
16295CCCCC   IF(ITEXLF.EQ.'ON')PYEND=PYSTAR-PTEXHE-PTEXVG
16296C
16297CCCCC   PXSTAR=PXEND
16298CCCCC   PYSTAR=PYEND
16299C
16300C               ************************************
16301C               **  STEP 5--                      **
16302C               **  CARRY OUT CLOSING OPERATIONS  **
16303C               **  ON THE GRAPHICS DEVICES       **
16304C               ************************************
16305C
16306        ICOPSW='OFF'
16307        NUMCOP=0
16308        CALL DPCLPL(ICOPSW,NUMCOP,
16309     1              PGRAXF,PGRAYF,
16310     1              IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
16311     1              PDIAHE,PDIAWI,PDIAVG,PDIAHG)
16312C
16313        CALL DPCLDE
16314C
16315 8000 CONTINUE
16316C
16317C  MARCH, 1993.  BUG: IF DEVICE 1 OFF AND DEVICE 2 ON,
16318C  NEW VALUES OF PXSTAR AND PYSTAR NOT SET.
16319C  MOVE FROM INSIDE LOOP TO HERE.
16320C
16321      PXEND=PX99
16322      PYEND=PY99
16323      IF(ITEXCR.EQ.'ON')PXEND=PTEXMR
16324      IF(ITEXLF.EQ.'ON')PYEND=PYSTAR-PTEXHE-PTEXVG
16325C
16326      PXSTAR=PXEND
16327      PYSTAR=PYEND
16328C  END CHANGE
16329C
16330C               *****************
16331C               **  STEP 90--  **
16332C               **  EXIT       **
16333C               *****************
16334C
16335 9000 CONTINUE
16336      IERROR=IERRG4
16337      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TEXT')THEN
16338        WRITE(ICOUT,999)
16339        CALL DPWRST('XXX','BUG ')
16340        WRITE(ICOUT,9011)
16341 9011   FORMAT('***** AT THE END       OF DPTEXT--')
16342        CALL DPWRST('XXX','BUG ')
16343        WRITE(ICOUT,9015)NCTEX,NCTEXT
16344 9015   FORMAT('NCTEX,NCTEXT  = ',2I8)
16345        CALL DPWRST('XXX','BUG ')
16346        WRITE(ICOUT,9016)(ITEXTE(I),I=1,MIN(25,NCTEX))
16347 9016   FORMAT('(ITEXTE(I),I =1,NCTEX) = ',25A4)
16348        CALL DPWRST('XXX','BUG ')
16349        WRITE(ICOUT,9018)(ICTEXT(I),I=1,MIN(25,NCTEXT))
16350 9018   FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
16351        CALL DPWRST('XXX','BUG ')
16352        WRITE(ICOUT,9019)PXSTAR,PYSTAR,PXEND,PYEND
16353 9019   FORMAT('PXSTAR,PYSTAR,PXEND,PYEND = ',4G15.7)
16354        CALL DPWRST('XXX','BUG ')
16355        WRITE(ICOUT,9033)PX1,PY1,PX99,PY99
16356 9033   FORMAT('PX1,PY1,PX99,PY99  = ',4G15.7)
16357        CALL DPWRST('XXX','BUG ')
16358        WRITE(ICOUT,9035)IMANUF,IMODEL,IFOUND
16359 9035   FORMAT('IMANUF,IMODEL,IFOUND = ',2(A4,2X),A4)
16360        CALL DPWRST('XXX','BUG ')
16361      ENDIF
16362C
16363      RETURN
16364      END
16365      SUBROUTINE DPTFCO(IHARG,NUMARG,IDETFC,MAXTEX,ITEFCO,
16366     1IBUGP2,IFOUND,IERROR)
16367C
16368C     PURPOSE--DEFINE THE TEXT FILL COLORS = THE COLORS
16369C              OF THE (BACKGROUND) FILL WITHIN THE TEXTS.
16370C              THESE ARE LOCATED IN THE VECTOR ITEFCO(.).
16371C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
16372C                     --NUMARG
16373C                     --IDETFC
16374C                     --MAXTEX
16375C                     --IBUGP2 ('ON' OR 'OFF' )
16376C     OUTPUT ARGUMENTS--ITEFCO (A CHARACTER VECTOR)
16377C                     --IFOUND ('YES' OR 'NO' )
16378C                     --IERROR ('YES' OR 'NO' )
16379C     WRITTEN BY--JAMES J. FILLIBEN
16380C                 STATISTICAL ENGINEERING DIVISION
16381C                 INFORMATION TECHNOLOGY LABORATORY
16382C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16383C                 GAITHERSBURG, MD 20899-8980
16384C                 PHONE--301-975-2899
16385C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16386C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16387C     LANGUAGE--ANSI FORTRAN (1977)
16388C     VERSION NUMBER--82/7
16389C     ORIGINAL VERSION--DECEMBER  1983.
16390C
16391C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16392C
16393      CHARACTER*4 IHARG
16394      CHARACTER*4 IDETFC
16395      CHARACTER*4 ITEFCO
16396C
16397      CHARACTER*4 IBUGP2
16398      CHARACTER*4 IFOUND
16399      CHARACTER*4 IERROR
16400C
16401      CHARACTER*4 IHOLD1
16402      CHARACTER*4 IHOLD2
16403C
16404      CHARACTER*4 ISUBN1
16405      CHARACTER*4 ISUBN2
16406      CHARACTER*4 ISTEPN
16407C
16408      DIMENSION IHARG(*)
16409      DIMENSION ITEFCO(*)
16410C
16411C-----COMMON----------------------------------------------------------
16412C
16413      INCLUDE 'DPCOP2.INC'
16414C
16415C-----START POINT-----------------------------------------------------
16416C
16417      IFOUND='NO'
16418      IERROR='NO'
16419      ISUBN1='DPTF'
16420      ISUBN2='CO  '
16421C
16422      NUMTEX=0
16423      IHOLD1='-999'
16424      IHOLD2='-999'
16425C
16426      IF(IBUGP2.EQ.'OFF')GOTO90
16427      WRITE(ICOUT,999)
16428  999 FORMAT(1X)
16429      CALL DPWRST('XXX','BUG ')
16430      WRITE(ICOUT,51)
16431   51 FORMAT('***** AT THE BEGINNING OF DPTFCO--')
16432      CALL DPWRST('XXX','BUG ')
16433      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
16434   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
16435      CALL DPWRST('XXX','BUG ')
16436      WRITE(ICOUT,53)MAXTEX,NUMTEX
16437   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
16438      CALL DPWRST('XXX','BUG ')
16439      WRITE(ICOUT,54)IHOLD1,IHOLD2
16440   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
16441      CALL DPWRST('XXX','BUG ')
16442      WRITE(ICOUT,55)IDETFC
16443   55 FORMAT('IDETFC = ',A4)
16444      CALL DPWRST('XXX','BUG ')
16445      WRITE(ICOUT,60)NUMARG
16446   60 FORMAT('NUMARG = ',I8)
16447      CALL DPWRST('XXX','BUG ')
16448      DO65I=1,NUMARG
16449      WRITE(ICOUT,66)IHARG(I)
16450   66 FORMAT('IHARG(I) = ',A4)
16451      CALL DPWRST('XXX','BUG ')
16452   65 CONTINUE
16453      WRITE(ICOUT,70)ITEFCO(1)
16454   70 FORMAT('ITEFCO(1) = ',A4)
16455      CALL DPWRST('XXX','BUG ')
16456      DO75I=1,10
16457      WRITE(ICOUT,76)I,ITEFCO(I)
16458   76 FORMAT('I,ITEFCO(I) = ',I8,2X,A4)
16459      CALL DPWRST('XXX','BUG ')
16460   75 CONTINUE
16461   90 CONTINUE
16462C
16463C               **************************************
16464C               **  STEP 1--                        **
16465C               **  BRANCH TO THE APPROPRIATE CASE  **
16466C               **************************************
16467C
16468      ISTEPN='1'
16469      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16470C
16471      IF(NUMARG.LE.1)GOTO9000
16472      IF(NUMARG.EQ.2)GOTO1120
16473      IF(NUMARG.EQ.3)GOTO1130
16474      IF(NUMARG.EQ.4)GOTO1140
16475      GOTO1150
16476C
16477 1120 CONTINUE
16478      GOTO1200
16479C
16480 1130 CONTINUE
16481      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
16482      IF(IHARG(3).EQ.'ALL')GOTO1300
16483      GOTO1200
16484C
16485 1140 CONTINUE
16486      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
16487      IF(IHARG(3).EQ.'ALL')GOTO1300
16488      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
16489      IF(IHARG(4).EQ.'ALL')GOTO1300
16490      GOTO1200
16491C
16492 1150 CONTINUE
16493      GOTO1200
16494C
16495C               *************************************************
16496C               **  STEP 2--                                   **
16497C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
16498C               *************************************************
16499C
16500 1200 CONTINUE
16501      ISTEPN='2'
16502      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16503C
16504      IF(NUMARG.LE.2)GOTO1210
16505      GOTO1220
16506C
16507 1210 CONTINUE
16508      NUMTEX=1
16509      ITEFCO(1)=IDETFC
16510      GOTO1270
16511C
16512 1220 CONTINUE
16513      NUMTEX=NUMARG-2
16514      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
16515      DO1225I=1,NUMTEX
16516      J=I+2
16517      IHOLD1=IHARG(J)
16518      IHOLD2=IHOLD1
16519      IF(IHOLD1.EQ.'ON')IHOLD2=IDETFC
16520      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETFC
16521      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETFC
16522      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETFC
16523      ITEFCO(I)=IHOLD2
16524 1225 CONTINUE
16525      GOTO1270
16526C
16527 1270 CONTINUE
16528      IF(IFEEDB.EQ.'OFF')GOTO1279
16529      WRITE(ICOUT,999)
16530      CALL DPWRST('XXX','BUG ')
16531      DO1278I=1,NUMTEX
16532      WRITE(ICOUT,1276)I,ITEFCO(I)
16533 1276 FORMAT('THE FILL COLOR OF TEXT ',I6,
16534     1' HAS JUST BEEN SET TO ',A4)
16535      CALL DPWRST('XXX','BUG ')
16536 1278 CONTINUE
16537 1279 CONTINUE
16538      IFOUND='YES'
16539      GOTO9000
16540C
16541C               **************************
16542C               **  STEP 3--            **
16543C               **  TREAT THE ALL CASE  **
16544C               **************************
16545C
16546 1300 CONTINUE
16547      ISTEPN='3'
16548      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16549C
16550      NUMTEX=MAXTEX
16551      IHOLD2=IHOLD1
16552      IF(IHOLD1.EQ.'ON')IHOLD2=IDETFC
16553      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETFC
16554      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETFC
16555      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETFC
16556      DO1315I=1,NUMTEX
16557      ITEFCO(I)=IHOLD2
16558 1315 CONTINUE
16559      GOTO1370
16560C
16561 1370 CONTINUE
16562      IF(IFEEDB.EQ.'OFF')GOTO1319
16563      WRITE(ICOUT,999)
16564      CALL DPWRST('XXX','BUG ')
16565      I=1
16566      WRITE(ICOUT,1316)ITEFCO(I)
16567 1316 FORMAT('THE FILL COLOR OF ALL TEXTS',
16568     1' HAS JUST BEEN SET TO ',A4)
16569      CALL DPWRST('XXX','BUG ')
16570 1319 CONTINUE
16571      IFOUND='YES'
16572      GOTO9000
16573C
16574C               *****************
16575C               **  STEP 90--  **
16576C               **  EXIT       **
16577C               *****************
16578C
16579 9000 CONTINUE
16580      IF(IBUGP2.EQ.'OFF')GOTO9090
16581      WRITE(ICOUT,9011)
16582 9011 FORMAT('***** AT THE END       OF DPTFCO--')
16583      CALL DPWRST('XXX','BUG ')
16584      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
16585 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
16586      CALL DPWRST('XXX','BUG ')
16587      WRITE(ICOUT,9013)MAXTEX,NUMTEX,NUMARG
16588 9013 FORMAT('MAXTEX,NUMTEX,NUMARG = ',3I8)
16589      CALL DPWRST('XXX','BUG ')
16590      WRITE(ICOUT,9014)IHOLD1,IHOLD2,IDETFC
16591 9014 FORMAT('IHOLD1,IHOLD2,IDETFC = ',2(A4,2X),A4)
16592      CALL DPWRST('XXX','BUG ')
16593      DO9025I=1,NUMARG
16594        WRITE(ICOUT,9026)IHARG(I)
16595 9026   FORMAT('IHARG(I) = ',A4)
16596        CALL DPWRST('XXX','BUG ')
16597 9025 CONTINUE
16598      DO9035I=1,10
16599        WRITE(ICOUT,9036)I,ITEFCO(I)
16600 9036   FORMAT('I,ITEFCO(I) = ',I8,2X,A4)
16601        CALL DPWRST('XXX','BUG ')
16602 9035 CONTINUE
16603 9090 CONTINUE
16604C
16605      RETURN
16606      END
16607      SUBROUTINE DPTFSW(IHARG,NUMARG,IDETFS,MAXTEX,ITEFSW,
16608     1IBUGP2,IFOUND,IERROR)
16609C
16610C     PURPOSE--DEFINE THE TEXT FILL SWITCHES = THE ON/OFF SWITCHES
16611C              OF THE (BACKGROUND) FILL WITHIN THE TEXTS.
16612C              THESE ARE LOCATED IN THE VECTOR ITEFSW(.).
16613C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
16614C                     --NUMARG
16615C                     --IDETFS
16616C                     --MAXTEX
16617C                     --IBUGP2 ('ON' OR 'OFF' )
16618C     OUTPUT ARGUMENTS--ITEFSW (A CHARACTER VECTOR)
16619C                     --IFOUND ('YES' OR 'NO' )
16620C                     --IERROR ('YES' OR 'NO' )
16621C     WRITTEN BY--JAMES J. FILLIBEN
16622C                 STATISTICAL ENGINEERING DIVISION
16623C                 INFORMATION TECHNOLOGY LABORATORY
16624C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16625C                 GAITHERSBURG, MD 20899-8980
16626C                 PHONE--301-975-2899
16627C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16628C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16629C     LANGUAGE--ANSI FORTRAN (1977)
16630C     VERSION NUMBER--82/7
16631C     ORIGINAL VERSION--DECEMBER  1983.
16632C
16633C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16634C
16635      CHARACTER*4 IHARG
16636      CHARACTER*4 IDETFS
16637      CHARACTER*4 ITEFSW
16638C
16639      CHARACTER*4 IBUGP2
16640      CHARACTER*4 IFOUND
16641      CHARACTER*4 IERROR
16642C
16643      CHARACTER*4 IHOLD1
16644      CHARACTER*4 IHOLD2
16645C
16646      CHARACTER*4 ISUBN1
16647      CHARACTER*4 ISUBN2
16648      CHARACTER*4 ISTEPN
16649C
16650      DIMENSION IHARG(*)
16651      DIMENSION ITEFSW(*)
16652C
16653C-----COMMON----------------------------------------------------------
16654C
16655      INCLUDE 'DPCOP2.INC'
16656C
16657C-----START POINT-----------------------------------------------------
16658C
16659      IFOUND='NO'
16660      IERROR='NO'
16661      ISUBN1='DPTF'
16662      ISUBN2='SW  '
16663C
16664      NUMTEX=0
16665      IHOLD1='-999'
16666      IHOLD2='-999'
16667C
16668      IF(IBUGP2.EQ.'OFF')GOTO90
16669      WRITE(ICOUT,999)
16670  999 FORMAT(1X)
16671      CALL DPWRST('XXX','BUG ')
16672      WRITE(ICOUT,51)
16673   51 FORMAT('***** AT THE BEGINNING OF DPTFSW--')
16674      CALL DPWRST('XXX','BUG ')
16675      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
16676   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
16677      CALL DPWRST('XXX','BUG ')
16678      WRITE(ICOUT,53)MAXTEX,NUMTEX
16679   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
16680      CALL DPWRST('XXX','BUG ')
16681      WRITE(ICOUT,54)IHOLD1,IHOLD2
16682   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
16683      CALL DPWRST('XXX','BUG ')
16684      WRITE(ICOUT,55)IDETFS
16685   55 FORMAT('IDETFS = ',A4)
16686      CALL DPWRST('XXX','BUG ')
16687      WRITE(ICOUT,60)NUMARG
16688   60 FORMAT('NUMARG = ',I8)
16689      CALL DPWRST('XXX','BUG ')
16690      DO65I=1,NUMARG
16691      WRITE(ICOUT,66)IHARG(I)
16692   66 FORMAT('IHARG(I) = ',A4)
16693      CALL DPWRST('XXX','BUG ')
16694   65 CONTINUE
16695      WRITE(ICOUT,70)ITEFSW(1)
16696   70 FORMAT('ITEFSW(1) = ',A4)
16697      CALL DPWRST('XXX','BUG ')
16698      DO75I=1,10
16699      WRITE(ICOUT,76)I,ITEFSW(I)
16700   76 FORMAT('I,ITEFSW(I) = ',I8,2X,A4)
16701      CALL DPWRST('XXX','BUG ')
16702   75 CONTINUE
16703   90 CONTINUE
16704C
16705C               **************************************
16706C               **  STEP 1--                        **
16707C               **  BRANCH TO THE APPROPRIATE CASE  **
16708C               **************************************
16709C
16710      ISTEPN='1'
16711      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16712C
16713      IF(NUMARG.LE.1)GOTO9000
16714      IF(NUMARG.EQ.2)GOTO1120
16715      IF(NUMARG.EQ.3)GOTO1130
16716      IF(NUMARG.EQ.4)GOTO1140
16717      GOTO1150
16718C
16719 1120 CONTINUE
16720      GOTO1200
16721C
16722 1130 CONTINUE
16723      IF(IHARG(3).EQ.'ALL')IHOLD1='ON'
16724      IF(IHARG(3).EQ.'ALL')GOTO1300
16725      GOTO1200
16726C
16727 1140 CONTINUE
16728      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
16729      IF(IHARG(3).EQ.'ALL')GOTO1300
16730      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
16731      IF(IHARG(4).EQ.'ALL')GOTO1300
16732      GOTO1200
16733C
16734 1150 CONTINUE
16735      GOTO1200
16736C
16737C               *************************************************
16738C               **  STEP 2--                                   **
16739C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
16740C               *************************************************
16741C
16742 1200 CONTINUE
16743      ISTEPN='2'
16744      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16745C
16746      IF(NUMARG.LE.2)GOTO1210
16747      GOTO1220
16748C
16749 1210 CONTINUE
16750      NUMTEX=1
16751      ITEFSW(1)='ON'
16752      GOTO1270
16753C
16754 1220 CONTINUE
16755      NUMTEX=NUMARG-2
16756      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
16757      DO1225I=1,NUMTEX
16758      J=I+2
16759      IHOLD1=IHARG(J)
16760      IHOLD2=IHOLD1
16761      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
16762      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
16763      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETFS
16764      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETFS
16765      ITEFSW(I)=IHOLD2
16766 1225 CONTINUE
16767      GOTO1270
16768C
16769 1270 CONTINUE
16770      IF(IFEEDB.EQ.'OFF')GOTO1279
16771      WRITE(ICOUT,999)
16772      CALL DPWRST('XXX','BUG ')
16773      DO1278I=1,NUMTEX
16774      WRITE(ICOUT,1276)I,ITEFSW(I)
16775 1276 FORMAT('THE FILL SWITCH FOR TEXT ',I6,
16776     1' HAS JUST BEEN SET TO ',A4)
16777      CALL DPWRST('XXX','BUG ')
16778 1278 CONTINUE
16779 1279 CONTINUE
16780      IFOUND='YES'
16781      GOTO9000
16782C
16783C               **************************
16784C               **  STEP 3--            **
16785C               **  TREAT THE ALL CASE  **
16786C               **************************
16787C
16788 1300 CONTINUE
16789      ISTEPN='3'
16790      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16791C
16792      NUMTEX=MAXTEX
16793      IHOLD2=IHOLD1
16794      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
16795      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
16796      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETFS
16797      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETFS
16798      DO1315I=1,NUMTEX
16799      ITEFSW(I)=IHOLD2
16800 1315 CONTINUE
16801      GOTO1370
16802C
16803 1370 CONTINUE
16804      IF(IFEEDB.EQ.'OFF')GOTO1319
16805      WRITE(ICOUT,999)
16806      CALL DPWRST('XXX','BUG ')
16807      I=1
16808      WRITE(ICOUT,1316)ITEFSW(I)
16809 1316 FORMAT('THE FILL SWITCH FOR ALL TEXTS',
16810     1' HAS JUST BEEN SET TO ',A4)
16811      CALL DPWRST('XXX','BUG ')
16812 1319 CONTINUE
16813      IFOUND='YES'
16814      GOTO9000
16815C
16816C               *****************
16817C               **  STEP 90--  **
16818C               **  EXIT       **
16819C               *****************
16820C
16821 9000 CONTINUE
16822      IF(IBUGP2.EQ.'OFF')GOTO9090
16823      WRITE(ICOUT,9011)
16824 9011 FORMAT('***** AT THE END       OF DPTFSW--')
16825      CALL DPWRST('XXX','BUG ')
16826      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
16827 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
16828      CALL DPWRST('XXX','BUG ')
16829      WRITE(ICOUT,9013)MAXTEX,NUMTEX
16830 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
16831      CALL DPWRST('XXX','BUG ')
16832      WRITE(ICOUT,9014)IHOLD1,IHOLD2
16833 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
16834      CALL DPWRST('XXX','BUG ')
16835      WRITE(ICOUT,9015)IDETFS
16836 9015 FORMAT('IDETFS = ',A4)
16837      CALL DPWRST('XXX','BUG ')
16838      WRITE(ICOUT,9020)NUMARG
16839 9020 FORMAT('NUMARG = ',I8)
16840      CALL DPWRST('XXX','BUG ')
16841      DO9025I=1,NUMARG
16842      WRITE(ICOUT,9026)IHARG(I)
16843 9026 FORMAT('IHARG(I) = ',A4)
16844      CALL DPWRST('XXX','BUG ')
16845 9025 CONTINUE
16846      WRITE(ICOUT,9030)ITEFSW(1)
16847 9030 FORMAT('ITEFSW(1) = ',A4)
16848      CALL DPWRST('XXX','BUG ')
16849      DO9035I=1,10
16850      WRITE(ICOUT,9036)I,ITEFSW(I)
16851 9036 FORMAT('I,ITEFSW(I) = ',I8,2X,A4)
16852      CALL DPWRST('XXX','BUG ')
16853 9035 CONTINUE
16854 9090 CONTINUE
16855C
16856      RETURN
16857      END
16858      SUBROUTINE DPTHIC(IHARG,IARGT,ARG,NUMARG,
16859     1PDEFTH,
16860     1PTEXTH,
16861C  DECEMBER 1987: SET ALL THICKNESS (CAN THEN
16862C  OVERRIDE ANY INDIVIDUALLY)
16863     1PFRATH,PTICTH,PTIZTH,PVGRTH,PHGRTH,PTITTH,PX1LTH,PX2LTH,PY1LTH,
16864     1PY2LTH,PLEGTH,MAXLG,PBOPTH,PBOFTH,MAXBX,PARRTH,MAXAR,
16865     1PSEGTH,MAXSG,PLINTH,MAXLN,PCHATH,MAXCH2,PFILTH,MAXFL,
16866     1PPATTH,MAXPT,PSPITH,MAXSP,PBABTH,PBAPTH,MAXBA,PREPTH,MAXRG,
16867     1PMABTH,PMAPTH,MAXMR,PTEBTH,PTEPTH,MAXTX,
16868C  END CHANGE
16869     1IBUGD2,ISUBRO,IFOUND,IERROR)
16870C
16871C     PURPOSE--DEFINE THE THICKNESS FOR TEXT CHARACTERS.
16872C              THE THICKNESS FOR TEXT CHARACTERS WILL BE PLACED
16873C              IN THE FLOATING POINT VARIABLE PTEXTH.
16874C     NOTE--THE THICKNESS IS IN STANDARDIZED UNITS (0.0 TO 100.0).
16875C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
16876C                     --IARGT
16877C                     --ARG
16878C                     --NUMARG
16879C                     --PDEFTH
16880C                     --IBUGD2
16881C     OUTPUT ARGUMENTS--PTEXTH
16882C                     --IFOUND ('YES' OR 'NO' )
16883C                     --IERROR ('YES' OR 'NO' )
16884C     WRITTEN BY--JAMES J. FILLIBEN
16885C                 STATISTICAL ENGINEERING DIVISION
16886C                 INFORMATION TECHNOLOGY LABORATORY
16887C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16888C                 GAITHERSBURG, MD 20899-8980
16889C                 PHONE--301-975-2899
16890C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16891C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16892C     LANGUAGE--ANSI FORTRAN (1977)
16893C     VERSION NUMBER--82/7
16894C     ORIGINAL VERSION--APRIL     1981.
16895C     UPDATED         --MAY       1982.
16896C     UPDATED         --JANUARY   1989.  SET ALL THICKNESS PARAMETERS (ALAN)
16897C     UPDATED         --SEPTEMBER 1993.  FIX BUG FORMAT STATEMENT
16898C
16899C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16900C
16901      CHARACTER*4 IHARG
16902      CHARACTER*4 IARGT
16903      CHARACTER*4 IBUGD2
16904      CHARACTER*4 ISUBRO
16905      CHARACTER*4 IFOUND
16906      CHARACTER*4 IERROR
16907C
16908C---------------------------------------------------------------------
16909C
16910C  DECEMBER 1987
16911      DIMENSION PLEGTH(*)
16912      DIMENSION PBOPTH(*)
16913      DIMENSION PBOFTH(*)
16914      DIMENSION PARRTH(*)
16915      DIMENSION PSEGTH(*)
16916      DIMENSION PLINTH(*)
16917      DIMENSION PCHATH(*)
16918      DIMENSION PFILTH(*)
16919      DIMENSION PPATTH(*)
16920      DIMENSION PSPITH(*)
16921      DIMENSION PBABTH(*)
16922      DIMENSION PBAPTH(*)
16923      DIMENSION PREPTH(*)
16924      DIMENSION PMABTH(*)
16925      DIMENSION PMAPTH(*)
16926      DIMENSION PTEBTH(*)
16927      DIMENSION PTEPTH(*)
16928C  END CHANGE
16929      DIMENSION IHARG(*)
16930      DIMENSION IARGT(*)
16931      DIMENSION ARG(*)
16932C
16933C-----COMMON----------------------------------------------------------
16934C
16935      INCLUDE 'DPCOP2.INC'
16936C
16937C-----START POINT-----------------------------------------------------
16938C
16939      IFOUND='NO'
16940      IERROR='NO'
16941C
16942      IF(IBUGD2.EQ.'OFF')GOTO90
16943      WRITE(ICOUT,999)
16944  999 FORMAT(1X)
16945      CALL DPWRST('XXX','BUG ')
16946      WRITE(ICOUT,51)
16947   51 FORMAT('***** AT THE BEGINNING OF DPTHIC--')
16948      CALL DPWRST('XXX','BUG ')
16949      WRITE(ICOUT,53)PDEFTH
16950   53 FORMAT('PDEFTH = ',E15.7)
16951      CALL DPWRST('XXX','BUG ')
16952      WRITE(ICOUT,54)NUMARG
16953   54 FORMAT('NUMARG = ',I8)
16954      CALL DPWRST('XXX','BUG ')
16955      DO55I=1,NUMARG
16956      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
16957   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
16958      CALL DPWRST('XXX','BUG ')
16959   55 CONTINUE
16960   90 CONTINUE
16961C
16962C               *****************************
16963C               **  TREAT THE THICKNESS CASE  **
16964C               *****************************
16965C
16966      IF(NUMARG.LE.0)GOTO1150
16967      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
16968      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
16969      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
16970      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
16971      IF(IHARG(NUMARG).EQ.'?')GOTO8100
16972C
16973      IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')
16974     1GOTO1160
16975C
16976      IERROR='YES'
16977      WRITE(ICOUT,1121)
16978 1121 FORMAT('***** ERROR IN DPTHIC--')
16979      CALL DPWRST('XXX','BUG ')
16980      WRITE(ICOUT,1122)
16981 1122 FORMAT('      ILLEGAL FORM FOR THICKNESS COMMAND.')
16982      CALL DPWRST('XXX','BUG ')
16983      WRITE(ICOUT,1124)
16984 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
16985     1'PROPER FORM--')
16986      CALL DPWRST('XXX','BUG ')
16987      WRITE(ICOUT,1125)
16988 1125 FORMAT('      SUPPOSE IT IS DESIRED THAT ')
16989      CALL DPWRST('XXX','BUG ')
16990      WRITE(ICOUT,1126)
16991 1126 FORMAT('      THE TEXT CHARACTERS HAVE A THICKNESS OF 1')
16992      CALL DPWRST('XXX','BUG ')
16993      WRITE(ICOUT,1127)
16994 1127 FORMAT('      (WHERE THE VERTICAL SCREEN UNITS RANGE')
16995      CALL DPWRST('XXX','BUG ')
16996      WRITE(ICOUT,1128)
16997 1128 FORMAT('      FROM 0 TO 100, ')
16998      CALL DPWRST('XXX','BUG ')
16999      WRITE(ICOUT,1130)
17000 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
17001      CALL DPWRST('XXX','BUG ')
17002      WRITE(ICOUT,1131)
17003 1131 FORMAT('           THICKNESS 1 ')
17004      CALL DPWRST('XXX','BUG ')
17005      GOTO9000
17006C
17007 1150 CONTINUE
17008      PTEXTH=PDEFTH
17009      GOTO1180
17010C
17011 1160 CONTINUE
17012      PTEXTH=ARG(NUMARG)
17013      GOTO1180
17014C
17015 1180 CONTINUE
17016      IFOUND='YES'
17017C
17018C  DECEMBER 1987: SET ALL THICKNESSES TO THE SET VALUE
17019      PFRATH=PTEXTH
17020      PTICTH=PTEXTH
17021      PTIZTH=PTEXTH
17022      PVGRTH=PTEXTH
17023      PHGRTH=PTEXTH
17024      PTITTH=PTEXTH
17025      PX1LTH=PTEXTH
17026      PX2LTH=PTEXTH
17027      PY1LTH=PTEXTH
17028      PY2LTH=PTEXTH
17029      DO2010I=1,MAXLG
17030      PLEGTH(I)=PTEXTH
17031 2010 CONTINUE
17032      DO2020I=1,MAXBX
17033      PBOPTH(I)=PTEXTH
17034      PBOFTH(I)=PTEXTH
17035 2020 CONTINUE
17036      DO2030I=1,MAXAR
17037      PARRTH(I)=PTEXTH
17038 2030 CONTINUE
17039      DO2040I=1,MAXSG
17040      PSEGTH(I)=PTEXTH
17041 2040 CONTINUE
17042      DO2050I=1,MAXLN
17043      PLINTH(I)=PTEXTH
17044 2050 CONTINUE
17045      DO2060I=1,MAXCH2
17046      PCHATH(I)=PTEXTH
17047 2060 CONTINUE
17048      DO2070I=1,MAXFL
17049      PFILTH(I)=PTEXTH
17050 2070 CONTINUE
17051      DO2080I=1,MAXPT
17052      PPATTH(I)=PTEXTH
17053 2080 CONTINUE
17054      DO2090I=1,MAXSP
17055      PSPITH(I)=PTEXTH
17056 2090 CONTINUE
17057      DO2100I=1,MAXBA
17058      PBABTH(I)=PTEXTH
17059      PBAPTH(I)=PTEXTH
17060 2100 CONTINUE
17061      DO2110I=1,MAXRG
17062      PREPTH(I)=PTEXTH
17063 2110 CONTINUE
17064      DO2120I=1,MAXMR
17065      PMABTH(I)=PTEXTH
17066      PMAPTH(I)=PTEXTH
17067 2120 CONTINUE
17068      DO2130I=1,MAXTX
17069      PTEBTH(I)=PTEXTH
17070      PTEPTH(I)=PTEXTH
17071 2130 CONTINUE
17072C  END CHANGE
17073      IF(IFEEDB.EQ.'OFF')GOTO1189
17074      WRITE(ICOUT,999)
17075      CALL DPWRST('XXX','BUG ')
17076      WRITE(ICOUT,1181)
17077 1181 FORMAT('THE THICKNESS (FOR TEXT CHARACTERS)  ')
17078      CALL DPWRST('XXX','BUG ')
17079      WRITE(ICOUT,1182)PTEXTH
17080 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
17081      CALL DPWRST('XXX','BUG ')
17082 1189 CONTINUE
17083      GOTO9000
17084C
17085C               ********************************************
17086C               **  STEP 81--                             **
17087C               **  TREAT THE    ?    CASE--              **
17088C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
17089C               ********************************************
17090C
17091 8100 CONTINUE
17092      IFOUND='YES'
17093      WRITE(ICOUT,999)
17094      CALL DPWRST('XXX','BUG ')
17095      WRITE(ICOUT,8111)PTEXTH
17096 8111 FORMAT('THE CURRENT (TEXT) THICKNESS IS ',E15.7)
17097      CALL DPWRST('XXX','BUG ')
17098      WRITE(ICOUT,8112)PDEFTH
17099 8112 FORMAT('THE DEFAULT (TEXT) THICKNESS IS ',E15.7)
17100      CALL DPWRST('XXX','BUG ')
17101      GOTO9000
17102C
17103C               *****************
17104C               **  STEP 90--  **
17105C               **  EXIT       **
17106C               *****************
17107C
17108 9000 CONTINUE
17109      IF(IBUGD2.EQ.'OFF')GOTO9090
17110      WRITE(ICOUT,999)
17111      CALL DPWRST('XXX','BUG ')
17112      WRITE(ICOUT,9011)
17113 9011 FORMAT('***** AT THE END       OF DPTHIC--')
17114      CALL DPWRST('XXX','BUG ')
17115      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
17116CCCCC THE FOLLOWING LINE WAS FIXED    SEPTEMBER 1993
17117C9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',,A4,2X,A4,2X,A4)
17118 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
17119      CALL DPWRST('XXX','BUG ')
17120      WRITE(ICOUT,9013)PTEXTH
17121 9013 FORMAT('PTEXTH = ',E15.7)
17122      CALL DPWRST('XXX','BUG ')
17123 9090 CONTINUE
17124C
17125      RETURN
17126      END
17127      SUBROUTINE DPTIC(ICOM,IHARG,NUMARG,
17128     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
17129     1IFOUND,IERROR)
17130C
17131C     PURPOSE--DEFINE THE 4 TIC MARK SWITCHES CONTAINED IN THE
17132C              4 VARIABLES IX1TSW,IX2TSW,IY1TSW,IY2TSW
17133C              SUCH TIC MARK SWITCHES TURN ON OR OFF
17134C              THE TIC MARKS ON THE 4 FRAME LINES OF A PLOT.
17135C     INPUT  ARGUMENTS--ICOM
17136C                     --IHARG  (A  HOLLERITH VECTOR)
17137C                     --NUMARG
17138C     OUTPUT ARGUMENTS--
17139C                     --IX1TSW = LOWER HORIZONTAL FRAME TIC MARKS
17140C                     --IX2TSW = UPPER HORIZONTAL FRAME TIC MARKS
17141C                     --IY1TSW = LEFT  VERTICAL   FRAME TIC MARKS
17142C                     --IY2TSW = RIGHT VERTICAL   FRAME TIC MARKS
17143C                     --IFOUND ('YES' OR 'NO' )
17144C                     --IERROR ('YES' OR 'NO' )
17145C     WRITTEN BY--JAMES J. FILLIBEN
17146C                 STATISTICAL ENGINEERING DIVISION
17147C                 INFORMATION TECHNOLOGY LABORATORY
17148C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17149C                 GAITHERSBURG, MD 20899-8980
17150C                 PHONE--301-975-2899
17151C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17152C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17153C     LANGUAGE--ANSI FORTRAN (1977)
17154C     VERSION NUMBER--82/7
17155C     ORIGINAL VERSION--SEPTEMBER 1980.
17156C     UPDATED         --MARCH     1981.
17157C     UPDATED         --MAY       1982.
17158C     UPDATED         --JANUARY   1988. (ALLOW FOR TIC NUMBER COMMAND)
17159C
17160C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17161C
17162      CHARACTER*4 ICOM
17163      CHARACTER*4 IHARG
17164C
17165      CHARACTER*4 IX1TSW
17166      CHARACTER*4 IX2TSW
17167      CHARACTER*4 IY1TSW
17168      CHARACTER*4 IY2TSW
17169C
17170      CHARACTER*4 IFOUND
17171      CHARACTER*4 IERROR
17172C
17173      CHARACTER*4 IHOLD
17174C
17175C---------------------------------------------------------------------
17176C
17177      DIMENSION IHARG(*)
17178C
17179C-----COMMON----------------------------------------------------------
17180C
17181      INCLUDE 'DPCOP2.INC'
17182C
17183C-----START POINT-----------------------------------------------------
17184C
17185      IFOUND='NO'
17186      IERROR='NO'
17187C
17188      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
17189      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')GOTO1900
17190      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'POSI')GOTO1900
17191      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO1900
17192      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'HW')GOTO1900
17193      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'LABE')GOTO1900
17194      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO1900
17195      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLAC')GOTO1900
17196      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1900
17197      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFFS')GOTO1900
17198C
17199      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17200     1IHARG(2).EQ.'COLO')GOTO1900
17201      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17202     1IHARG(2).EQ.'COOR')GOTO1900
17203      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17204     1IHARG(2).EQ.'POSI')GOTO1900
17205      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17206     1IHARG(2).EQ.'SIZE')GOTO1900
17207      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17208     1IHARG(2).EQ.'HW')GOTO1900
17209      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17210     1IHARG(2).EQ.'LABE')GOTO1900
17211      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17212     1IHARG(2).EQ.'DECI')GOTO1900
17213      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17214     1IHARG(2).EQ.'PLAC')GOTO1900
17215      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17216     1IHARG(2).EQ.'NUMB')GOTO1900
17217      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
17218     1IHARG(2).EQ.'OFFS')GOTO1900
17219C
17220C               *****************************************************
17221C               **  TREAT THE CASE WHEN                            **
17222C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
17223C               *****************************************************
17224C
17225      IF(ICOM.EQ.'XTIC')GOTO1100
17226      GOTO1199
17227C
17228 1100 CONTINUE
17229      IF(NUMARG.LE.0)GOTO1160
17230      IF(IHARG(NUMARG).EQ.'MARK')GOTO1160
17231      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
17232      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
17233      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
17234      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
17235      GOTO1150
17236C
17237 1150 CONTINUE
17238      IHOLD='ON'
17239      GOTO1180
17240C
17241 1160 CONTINUE
17242      IHOLD='OFF'
17243      GOTO1180
17244C
17245 1180 CONTINUE
17246      IFOUND='YES'
17247      IX1TSW=IHOLD
17248      IX2TSW=IHOLD
17249C
17250      IF(IFEEDB.EQ.'OFF')GOTO1189
17251      WRITE(ICOUT,999)
17252  999 FORMAT(1X)
17253      CALL DPWRST('XXX','BUG ')
17254      WRITE(ICOUT,1181)
17255 1181 FORMAT('THE TIC MARKS (FOR BOTH HORIZONTAL ',
17256     1'FRAME LINES)')
17257      CALL DPWRST('XXX','BUG ')
17258      WRITE(ICOUT,1182)IHOLD
17259 1182 FORMAT('HAVE JUST BEEN TURNED ',A4)
17260      CALL DPWRST('XXX','BUG ')
17261 1189 CONTINUE
17262      GOTO1900
17263C
17264 1199 CONTINUE
17265C
17266C               **************************************************************
17267C               **  TREAT THE CASE WHEN                                     **
17268C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
17269C               **************************************************************
17270C
17271      IF(ICOM.EQ.'X1TI')GOTO1200
17272      GOTO1299
17273C
17274 1200 CONTINUE
17275      IF(NUMARG.LE.0)GOTO1260
17276      IF(IHARG(NUMARG).EQ.'MARK')GOTO1260
17277      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
17278      IF(IHARG(NUMARG).EQ.'OFF')GOTO1260
17279      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
17280      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
17281      GOTO1250
17282C
17283 1250 CONTINUE
17284      IHOLD='ON'
17285      GOTO1280
17286C
17287 1260 CONTINUE
17288      IHOLD='OFF'
17289      GOTO1280
17290C
17291 1280 CONTINUE
17292      IFOUND='YES'
17293      IX1TSW=IHOLD
17294C
17295      IF(IFEEDB.EQ.'OFF')GOTO1289
17296      WRITE(ICOUT,999)
17297      CALL DPWRST('XXX','BUG ')
17298      WRITE(ICOUT,1281)
17299 1281 FORMAT('THE TIC MARKS (FOR THE BOTTOM ',
17300     1'HORIZONTAL FRAME LINE)')
17301      CALL DPWRST('XXX','BUG ')
17302      WRITE(ICOUT,1282)IHOLD
17303 1282 FORMAT('HAVE JUST BEEN TURNED ',A4)
17304      CALL DPWRST('XXX','BUG ')
17305 1289 CONTINUE
17306      GOTO1900
17307C
17308 1299 CONTINUE
17309C
17310C               **************************************************************
17311C               **  TREAT THE CASE WHEN                                     **
17312C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
17313C               **************************************************************
17314C
17315      IF(ICOM.EQ.'X2TI')GOTO1300
17316      GOTO1399
17317C
17318 1300 CONTINUE
17319      IF(NUMARG.LE.0)GOTO1360
17320      IF(IHARG(NUMARG).EQ.'MARK')GOTO1360
17321      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
17322      IF(IHARG(NUMARG).EQ.'OFF')GOTO1360
17323      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
17324      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
17325      GOTO1350
17326C
17327 1350 CONTINUE
17328      IHOLD='ON'
17329      GOTO1380
17330C
17331 1360 CONTINUE
17332      IHOLD='OFF'
17333      GOTO1380
17334C
17335 1380 CONTINUE
17336      IFOUND='YES'
17337      IX2TSW=IHOLD
17338C
17339      IF(IFEEDB.EQ.'OFF')GOTO1389
17340      WRITE(ICOUT,999)
17341      CALL DPWRST('XXX','BUG ')
17342      WRITE(ICOUT,1381)
17343 1381 FORMAT('THE TIC MARKS (FOR THE TOP HORIZONTAL ',
17344     1'FRAME LINE)')
17345      CALL DPWRST('XXX','BUG ')
17346      WRITE(ICOUT,1382)IHOLD
17347 1382 FORMAT('HAVE JUST BEEN TURNED ',A4)
17348      CALL DPWRST('XXX','BUG ')
17349 1389 CONTINUE
17350      GOTO1900
17351C
17352 1399 CONTINUE
17353C
17354C               *****************************************************
17355C               **  TREAT THE CASE WHEN                            **
17356C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
17357C               *****************************************************
17358C
17359      IF(ICOM.EQ.'YTIC')GOTO1400
17360      GOTO1499
17361C
17362 1400 CONTINUE
17363      IF(NUMARG.LE.0)GOTO1460
17364      IF(IHARG(NUMARG).EQ.'MARK')GOTO1460
17365      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
17366      IF(IHARG(NUMARG).EQ.'OFF')GOTO1460
17367      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
17368      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
17369      GOTO1450
17370C
17371 1450 CONTINUE
17372      IHOLD='ON'
17373      GOTO1480
17374C
17375 1460 CONTINUE
17376      IHOLD='OFF'
17377      GOTO1480
17378C
17379 1480 CONTINUE
17380      IFOUND='YES'
17381      IY1TSW=IHOLD
17382      IY2TSW=IHOLD
17383C
17384      IF(IFEEDB.EQ.'OFF')GOTO1489
17385      WRITE(ICOUT,999)
17386      CALL DPWRST('XXX','BUG ')
17387      WRITE(ICOUT,1481)
17388 1481 FORMAT('THE TIC MARKS (FOR BOTH VERTICAL ',
17389     1'FRAME LINES)')
17390      CALL DPWRST('XXX','BUG ')
17391      WRITE(ICOUT,1482)IHOLD
17392 1482 FORMAT('HAVE JUST BEEN TURNED ',A4)
17393      CALL DPWRST('XXX','BUG ')
17394 1489 CONTINUE
17395      GOTO1900
17396C
17397 1499 CONTINUE
17398C
17399C               **************************************************************
17400C               **  TREAT THE CASE WHEN                                     **
17401C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
17402C               **************************************************************
17403C
17404      IF(ICOM.EQ.'Y1TI')GOTO1500
17405      GOTO1599
17406C
17407 1500 CONTINUE
17408      IF(NUMARG.LE.0)GOTO1560
17409      IF(IHARG(NUMARG).EQ.'MARK')GOTO1560
17410      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
17411      IF(IHARG(NUMARG).EQ.'OFF')GOTO1560
17412      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
17413      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
17414      GOTO1550
17415C
17416 1550 CONTINUE
17417      IHOLD='ON'
17418      GOTO1580
17419C
17420 1560 CONTINUE
17421      IHOLD='OFF'
17422      GOTO1580
17423C
17424 1580 CONTINUE
17425      IFOUND='YES'
17426      IY1TSW=IHOLD
17427C
17428      IF(IFEEDB.EQ.'OFF')GOTO1589
17429      WRITE(ICOUT,999)
17430      CALL DPWRST('XXX','BUG ')
17431      WRITE(ICOUT,1581)
17432 1581 FORMAT('THE TIC MARKS (FOR THE LEFT VERTICAL ',
17433     1'FRAME LINE)')
17434      CALL DPWRST('XXX','BUG ')
17435      WRITE(ICOUT,1582)IHOLD
17436 1582 FORMAT('HAVE JUST BEEN TURNED ',A4)
17437      CALL DPWRST('XXX','BUG ')
17438 1589 CONTINUE
17439      GOTO1900
17440C
17441 1599 CONTINUE
17442C
17443C               **************************************************************
17444C               **  TREAT THE CASE WHEN                                     **
17445C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
17446C               **************************************************************
17447C
17448      IF(ICOM.EQ.'Y2TI')GOTO1600
17449      GOTO1699
17450C
17451 1600 CONTINUE
17452      IF(NUMARG.LE.0)GOTO1660
17453      IF(IHARG(NUMARG).EQ.'MARK')GOTO1660
17454      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
17455      IF(IHARG(NUMARG).EQ.'OFF')GOTO1660
17456      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
17457      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
17458      GOTO1650
17459C
17460 1650 CONTINUE
17461      IHOLD='ON'
17462      GOTO1680
17463C
17464 1660 CONTINUE
17465      IHOLD='OFF'
17466      GOTO1680
17467C
17468 1680 CONTINUE
17469      IFOUND='YES'
17470      IY2TSW=IHOLD
17471C
17472      IF(IFEEDB.EQ.'OFF')GOTO1689
17473      WRITE(ICOUT,999)
17474      CALL DPWRST('XXX','BUG ')
17475      WRITE(ICOUT,1681)
17476 1681 FORMAT('THE TIC MARKS (FOR THE RIGHT VERTICAL ',
17477     1'FRAME LINE)')
17478      CALL DPWRST('XXX','BUG ')
17479      WRITE(ICOUT,1682)IHOLD
17480 1682 FORMAT('HAVE JUST BEEN TURNED ',A4)
17481      CALL DPWRST('XXX','BUG ')
17482 1689 CONTINUE
17483      GOTO1900
17484C
17485 1699 CONTINUE
17486C
17487C               *****************************************************
17488C               **  TREAT THE CASE WHEN                            **
17489C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
17490C               *****************************************************
17491C
17492      IF(ICOM.EQ.'TIC')GOTO1700
17493      IF(ICOM.EQ.'TICS')GOTO1700
17494      IF(ICOM.EQ.'XYTI')GOTO1700
17495      IF(ICOM.EQ.'YXTI')GOTO1700
17496      GOTO1799
17497C
17498 1700 CONTINUE
17499      IF(NUMARG.LE.0)GOTO1760
17500      IF(IHARG(NUMARG).EQ.'MARK')GOTO1760
17501      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
17502      IF(IHARG(NUMARG).EQ.'OFF')GOTO1760
17503      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
17504      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
17505      GOTO1750
17506C
17507 1750 CONTINUE
17508      IHOLD='ON'
17509      GOTO1780
17510C
17511 1760 CONTINUE
17512      IHOLD='OFF'
17513      GOTO1780
17514C
17515 1780 CONTINUE
17516      IFOUND='YES'
17517      IX1TSW=IHOLD
17518      IX2TSW=IHOLD
17519      IY1TSW=IHOLD
17520      IY2TSW=IHOLD
17521C
17522      IF(IFEEDB.EQ.'OFF')GOTO1789
17523      WRITE(ICOUT,999)
17524      CALL DPWRST('XXX','BUG ')
17525      WRITE(ICOUT,1781)
17526 1781 FORMAT('THE TIC MARKS (FOR ALL 4 ',
17527     1'FRAME LINES)')
17528      CALL DPWRST('XXX','BUG ')
17529      WRITE(ICOUT,1782)IHOLD
17530 1782 FORMAT('HAVE JUST BEEN TURNED ',A4)
17531      CALL DPWRST('XXX','BUG ')
17532 1789 CONTINUE
17533      GOTO1900
17534C
17535 1799 CONTINUE
17536C
17537 1900 CONTINUE
17538      RETURN
17539      END
17540      SUBROUTINE DPTICA(IHARG,NUMARG,IDEFCA,ITITCA,IFOUND,IERROR)
17541C
17542C     PURPOSE--DEFINE THE CASE FOR THE TITLE
17543C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
17544C              THE CASE FOR THE TITLE WILL BE PLACED
17545C              IN THE HOLLERITH VARIABLE ITITCA.
17546C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
17547C                     --NUMARG
17548C                     --IDEFCA
17549C     OUTPUT ARGUMENTS--ITITCA
17550C                     --IFOUND ('YES' OR 'NO' )
17551C                     --IERROR ('YES' OR 'NO' )
17552C     WRITTEN BY--ALAN HECKERT
17553C                 COMPUTER SERVICES DIVISION
17554C                 INFORMATION TECHNOLOGY LABORATORY
17555C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17556C                 GAITHERSBURG, MD 20899-8980
17557C                 PHONE--301-975-2899
17558C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17559C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17560C     LANGUAGE--ANSI FORTRAN (1977)
17561C     VERSION NUMBER--89/2
17562C     ORIGINAL VERSION--JANUARY   1989.
17563C
17564C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17565C
17566      CHARACTER*4 IHARG
17567      CHARACTER*4 IDEFCA
17568      CHARACTER*4 ITITCA
17569      CHARACTER*4 IFOUND
17570      CHARACTER*4 IERROR
17571C
17572C---------------------------------------------------------------------
17573C
17574      DIMENSION IHARG(*)
17575C
17576C-----COMMON----------------------------------------------------------
17577C
17578      INCLUDE 'DPCOP2.INC'
17579C
17580C-----START POINT-----------------------------------------------------
17581C
17582      IFOUND='NO'
17583      IERROR='NO'
17584C
17585      IF(NUMARG.LE.0)GOTO1199
17586      IF(IHARG(1).EQ.'CASE')GOTO1110
17587      GOTO1199
17588C
17589 1110 CONTINUE
17590      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
17591      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
17592      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
17593      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
17594      IF(NUMARG.EQ.1)GOTO1150
17595      GOTO1160
17596C
17597 1150 CONTINUE
17598      ITITCA=IDEFCA
17599      GOTO1180
17600C
17601 1160 CONTINUE
17602      ITITCA=IHARG(NUMARG)
17603      GOTO1180
17604C
17605 1180 CONTINUE
17606      IFOUND='YES'
17607C
17608      IF(IFEEDB.EQ.'OFF')GOTO1189
17609      WRITE(ICOUT,999)
17610  999 FORMAT(1X)
17611      CALL DPWRST('XXX','BUG ')
17612      WRITE(ICOUT,1181)ITITCA
17613 1181 FORMAT('THE TITLE CASE HAS JUST BEEN SET TO ',
17614     1A4)
17615      CALL DPWRST('XXX','BUG ')
17616 1189 CONTINUE
17617      GOTO1199
17618C
17619 1199 CONTINUE
17620      RETURN
17621      END
17622      SUBROUTINE DPTICL(IHARG,NUMARG,IDEFCO,ITITCO,IFOUND,IERROR)
17623C
17624C     PURPOSE--DEFINE THE COLOR FOR THE TITLE
17625C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
17626C              THE COLOR FOR THE TITLE WILL BE PLACED
17627C              IN THE HOLLERITH VARIABLE ITITCO.
17628C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
17629C                     --NUMARG
17630C                     --IDEFCO
17631C     OUTPUT ARGUMENTS--ITITCO
17632C                     --IFOUND ('YES' OR 'NO' )
17633C                     --IERROR ('YES' OR 'NO' )
17634C     WRITTEN BY--JAMES J. FILLIBEN
17635C                 STATISTICAL ENGINEERING DIVISION
17636C                 INFORMATION TECHNOLOGY LABORATORY
17637C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17638C                 GAITHERSBURG, MD 20899-8980
17639C                 PHONE--301-975-2899
17640C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17641C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17642C     LANGUAGE--ANSI FORTRAN (1977)
17643C     VERSION NUMBER--82/7
17644C     ORIGINAL VERSION--SEPTEMBER 1980.
17645C     UPDATED         --MAY       1982.
17646C
17647C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17648C
17649      CHARACTER*4 IHARG
17650      CHARACTER*4 IDEFCO
17651      CHARACTER*4 ITITCO
17652      CHARACTER*4 IFOUND
17653      CHARACTER*4 IERROR
17654C
17655C---------------------------------------------------------------------
17656C
17657      DIMENSION IHARG(*)
17658C
17659C-----COMMON----------------------------------------------------------
17660C
17661      INCLUDE 'DPCOP2.INC'
17662C
17663C-----START POINT-----------------------------------------------------
17664C
17665      IFOUND='NO'
17666      IERROR='NO'
17667C
17668      IF(NUMARG.LE.0)GOTO1199
17669      IF(IHARG(1).EQ.'COLO')GOTO1110
17670      GOTO1199
17671C
17672 1110 CONTINUE
17673      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
17674      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
17675      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
17676      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
17677      IF(NUMARG.EQ.1)GOTO1150
17678      GOTO1160
17679C
17680 1150 CONTINUE
17681      ITITCO=IDEFCO
17682      GOTO1180
17683C
17684 1160 CONTINUE
17685      ITITCO=IHARG(NUMARG)
17686      GOTO1180
17687C
17688 1180 CONTINUE
17689      IFOUND='YES'
17690C
17691      IF(IFEEDB.EQ.'OFF')GOTO1189
17692      WRITE(ICOUT,999)
17693  999 FORMAT(1X)
17694      CALL DPWRST('XXX','BUG ')
17695      WRITE(ICOUT,1181)ITITCO
17696 1181 FORMAT('THE TITLE COLOR HAS JUST BEEN SET TO ',
17697     1A4)
17698      CALL DPWRST('XXX','BUG ')
17699 1189 CONTINUE
17700      GOTO1199
17701C
17702 1199 CONTINUE
17703      RETURN
17704      END
17705      SUBROUTINE DPTIET(XTEMP1,MAXNXT,
17706     1                  ICAPSW,ICASAN,IFORSW,ISEED,
17707     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
17708C
17709C     PURPOSE--PERFORM TIETJEN-MOORE TEST FOR UNIVARIATE OUTLIERS.
17710C              THIS IS A GENERALIZATION OF THE GRUBB TEST (WHICH
17711C              LOOKS FOR A SINGLE OUTLIER) TO LOOK FOR "K" OUTLIERS.
17712C              LIKE GRUBBS TEST, THIS TEST ASSUMES THE DATA FOLLOWS AN
17713C              APPROXIMATELY NORMAL DISRIBUTION).
17714C     WRITTEN BY--ALAN HECKERT
17715C                 STATISTICAL ENGINEERING DIVISION
17716C                 INFORMATION TECHNOLOGY LABORAOTRY
17717C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
17718C                 GAITHERSBURG, MD 20899-8980
17719C                 PHONE--301-975-2855
17720C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17721C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
17722C     LANGUAGE--ANSI FORTRAN (1977)
17723C     VERSION NUMBER--2009/11
17724C     ORIGINAL VERSION--NOVEMBER  2009.
17725C     UPDATED         --JANUARY   2009. PRINT VALUES OF POTENTIAL
17726C                                       OUTLIERS
17727C     UPDATED         --AUGUST    2010. FOR TWO-SIDED CASE, POTENTIAL
17728C                                       OUTLIERS PRINTED WERE CORRECT
17729C     UPDATED         --JULY      2019. TWEAK SCRATCH SPACE
17730C
17731C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17732C
17733      CHARACTER*4 ICASAN
17734      CHARACTER*4 ICAPSW
17735      CHARACTER*4 IFORSW
17736      CHARACTER*4 IBUGA2
17737      CHARACTER*4 IBUGA3
17738      CHARACTER*4 IBUGQ
17739      CHARACTER*4 ISUBRO
17740      CHARACTER*4 IFOUND
17741      CHARACTER*4 IERROR
17742C
17743      CHARACTER*4 IWRITE
17744      CHARACTER*4 ICASP2
17745      CHARACTER*4 IHWUSE
17746      CHARACTER*4 MESSAG
17747      CHARACTER*4 IDATSW
17748      CHARACTER*4 IHP
17749      CHARACTER*4 IHP2
17750      CHARACTER*4 ISUBN1
17751      CHARACTER*4 ISUBN2
17752      CHARACTER*4 ISTEPN
17753      CHARACTER*4 IOP
17754C
17755      CHARACTER*4 IFLAGU
17756      LOGICAL IFRST
17757      LOGICAL ILAST
17758C
17759      CHARACTER*4 IREPL
17760      CHARACTER*4 IMULT
17761      CHARACTER*4 ICASE
17762      CHARACTER*4 IRANSV
17763      CHARACTER*4 ICTMP1
17764      CHARACTER*4 ICTMP2
17765      CHARACTER*4 ICTMP3
17766C
17767      CHARACTER*40 INAME
17768      PARAMETER (MAXSPN=30)
17769      CHARACTER*4 IVARN1(MAXSPN)
17770      CHARACTER*4 IVARN2(MAXSPN)
17771      CHARACTER*4 IVARTY(MAXSPN)
17772      CHARACTER*4 IVARID(MAXSPN)
17773      CHARACTER*4 IVARI2(MAXSPN)
17774      REAL PVAR(MAXSPN)
17775      REAL PID(MAXSPN)
17776      INTEGER ILIS(MAXSPN)
17777      INTEGER NRIGHT(MAXSPN)
17778      INTEGER ICOLR(MAXSPN)
17779C
17780C---------------------------------------------------------------------
17781C
17782      INCLUDE 'DPCOPA.INC'
17783C
17784      DIMENSION Y1(MAXOBV)
17785      DIMENSION X1(MAXOBV)
17786      DIMENSION TEMP1(MAXOBV)
17787      DIMENSION TEMP2(MAXOBV)
17788      DIMENSION XTEMP1(MAXOBV)
17789      DIMENSION XTEMP2(MAXOBV)
17790      DIMENSION XTEMP3(MAXOBV)
17791      DIMENSION XTEMP4(MAXOBV)
17792      DIMENSION YSTAT(MAXOBV)
17793C
17794      DIMENSION XDESGN(MAXOBV,7)
17795      DIMENSION XIDTEM(MAXOBV)
17796      DIMENSION XIDTE2(MAXOBV)
17797      DIMENSION XIDTE3(MAXOBV)
17798      DIMENSION XIDTE4(MAXOBV)
17799      DIMENSION XIDTE5(MAXOBV)
17800      DIMENSION XIDTE6(MAXOBV)
17801C
17802      INTEGER ITEMP1(MAXOBV)
17803      INTEGER ITEMP2(MAXOBV)
17804      INTEGER ITEMP3(MAXOBV)
17805C
17806      INCLUDE 'DPCOZZ.INC'
17807      INCLUDE 'DPCOZI.INC'
17808C
17809      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
17810      EQUIVALENCE (GARBAG(IGARB2),X1(1))
17811      EQUIVALENCE (GARBAG(IGARB4),XTEMP2(1))
17812      EQUIVALENCE (GARBAG(IGARB5),XTEMP3(1))
17813      EQUIVALENCE (GARBAG(IGARB6),XTEMP4(1))
17814      EQUIVALENCE (GARBAG(IGARB7),TEMP1(1))
17815      EQUIVALENCE (GARBAG(IGARB8),TEMP2(1))
17816      EQUIVALENCE (GARBAG(IGARB9),YSTAT(1))
17817      EQUIVALENCE (GARBAG(IGAR10),XIDTEM(1))
17818      EQUIVALENCE (GARBAG(JGAR11),XIDTE2(1))
17819      EQUIVALENCE (GARBAG(JGAR12),XIDTE3(1))
17820      EQUIVALENCE (GARBAG(JGAR13),XIDTE4(1))
17821      EQUIVALENCE (GARBAG(JGAR14),XIDTE5(1))
17822      EQUIVALENCE (GARBAG(JGAR15),XIDTE6(1))
17823      EQUIVALENCE (GARBAG(IGAR11),XDESGN(1,1))
17824      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
17825      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
17826      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
17827C
17828C-----COMMON----------------------------------------------------------
17829C
17830      INCLUDE 'DPCOHK.INC'
17831      INCLUDE 'DPCODA.INC'
17832      INCLUDE 'DPCOSU.INC'
17833      INCLUDE 'DPCOS2.INC'
17834      INCLUDE 'DPCOHO.INC'
17835      INCLUDE 'DPCOMC.INC'
17836      INCLUDE 'DPCOST.INC'
17837      INCLUDE 'DPCOF2.INC'
17838C
17839      COMMON/ISED/ISED1,ISED2,ISED3,ISED4,ISED5,ISED6,
17840     1            ISED7,ISED8,ISED9,ISED10,ISED11
17841C
17842C-----COMMON VARIABLES (GENERAL)--------------------------------------
17843C
17844      INCLUDE 'DPCOP2.INC'
17845C
17846C-----START POINT-----------------------------------------------------
17847C
17848      IERROR='NO'
17849      ICASAN='    '
17850      IREPL='OFF'
17851      IMULT='OFF'
17852      IRANSV=IRANAL
17853      IRANAL='FINC'
17854      ISEESV=ISEED
17855      ISEED=2503
17856      ISUBN1='DPTI'
17857      ISUBN2='ET  '
17858C
17859      MAXCP1=MAXCOL+1
17860      MAXCP2=MAXCOL+2
17861      MAXCP3=MAXCOL+3
17862      MAXCP4=MAXCOL+4
17863      MAXCP5=MAXCOL+5
17864      MAXCP6=MAXCOL+6
17865C
17866      MINN2=3
17867C
17868C               ***************************************************
17869C               **  TREAT THE TIETJEN MOORE             CASE     **
17870C               ***************************************************
17871C
17872      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIET')THEN
17873        WRITE(ICOUT,999)
17874  999   FORMAT(1X)
17875        CALL DPWRST('XXX','BUG ')
17876        WRITE(ICOUT,51)
17877   51   FORMAT('***** AT THE BEGINNING OF DPTIET--')
17878        CALL DPWRST('XXX','BUG ')
17879        WRITE(ICOUT,52)ICASAN
17880   52   FORMAT('ICASAN = ',A4)
17881        CALL DPWRST('XXX','BUG ')
17882        WRITE(ICOUT,53)ICASAN,IBUGA2,IBUGA3,IBUGQ,MAXNXT
17883   53   FORMAT('ICASAN,IBUGA2,IBUGA3,IBUGQ,MAXNXT = ',4(A4,2X),I8)
17884        CALL DPWRST('XXX','BUG ')
17885      ENDIF
17886C
17887C               *********************************************************
17888C               **  STEP 1--                                           **
17889C               **  EXTRACT THE COMMAND                                **
17890C               **  LOOK FOR ONE OF THE FOLLOWING COMMANDS:            **
17891C               **    1) TIETJEN MOORE TEST Y                          **
17892C               **    2) TIETJEN MOORE TEST Y LABID                    **
17893C               **    3) TIETJEN MOORE TEST Y1 ... YK                  **
17894C               **    4) REPLICATED TIETJEN MOORE TEST Y X1 ... XK     **
17895C               **    5) REPLICATED TIETJEN MOORE TEST Y LABID X1 ... XK *
17896C               *********************************************************
17897C
17898      ISTEPN='1'
17899      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
17900     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17901C
17902      ILASTC=9999
17903      ILASTZ=9999
17904      IFOUND='NO'
17905      ICASAN='TWOS'
17906C
17907      DO100I=0,NUMARG-1
17908C
17909        IF(I.EQ.0)THEN
17910          ICTMP1=ICOM
17911          ICTMP2=IHARG(I+1)
17912          ICTMP3=IHARG(I+2)
17913        ELSE
17914          ICTMP1=IHARG(I)
17915          ICTMP2=IHARG(I+1)
17916          ICTMP3=IHARG(I+2)
17917        ENDIF
17918C
17919        IF(ICTMP1.EQ.'TIET' .AND. ICTMP2.EQ.'MOOR' .AND.
17920     1     ICTMP3.EQ.'TEST')THEN
17921          IFOUND='YES'
17922          ILASTC=I
17923          ILASTZ=I+2
17924        ELSEIF(ICTMP1.EQ.'TIET' .AND. ICTMP2.EQ.'MOOR')THEN
17925          IFOUND='YES'
17926          ILASTC=I
17927          ILASTZ=I+1
17928        ELSEIF(ICTMP1.EQ.'MINI')THEN
17929          ICASAN='MINI'
17930          ILASTC=MIN(ILASTC,I)
17931          ILASTZ=MAX(ILASTZ,I)
17932        ELSEIF(ICTMP1.EQ.'MAXI')THEN
17933          ICASAN='MAXI'
17934          ILASTC=MIN(ILASTC,I)
17935          ILASTZ=MAX(ILASTZ,I)
17936        ELSEIF(ICTMP1.EQ.'REPL')THEN
17937          IREPL='ON'
17938          ILASTC=MIN(ILASTC,I)
17939          ILASTZ=MAX(ILASTZ,I)
17940        ELSEIF(ICTMP1.EQ.'MULT')THEN
17941          IMULT='ON'
17942          ILASTC=MIN(ILASTC,I)
17943          ILASTZ=MAX(ILASTZ,I)
17944        ELSEIF(ICTMP1.EQ.'TEST')THEN
17945          ILASTC=MIN(ILASTC,I)
17946          ILASTZ=MAX(ILASTZ,I)
17947        ENDIF
17948  100 CONTINUE
17949C
17950      ISHIFT=ILASTZ
17951      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
17952     1            IBUGA2,IERROR)
17953C
17954      IF(IFOUND.EQ.'NO')GOTO9000
17955      IF(IMULT.EQ.'ON')THEN
17956        IF(IREPL.EQ.'ON')THEN
17957          WRITE(ICOUT,999)
17958          CALL DPWRST('XXX','BUG ')
17959          WRITE(ICOUT,101)
17960  101     FORMAT('***** ERROR IN TIETJEN-MOORE TEST--')
17961          CALL DPWRST('XXX','BUG ')
17962          WRITE(ICOUT,102)
17963  102     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
17964     1           '"REPLICATION" FOR')
17965          CALL DPWRST('XXX','BUG ')
17966          WRITE(ICOUT,103)
17967  103     FORMAT('      THE TIETJEN-MOORE TEST COMMAND.')
17968          CALL DPWRST('XXX','BUG ')
17969          IERROR='YES'
17970          GOTO9000
17971        ENDIF
17972      ENDIF
17973C
17974C               *********************************
17975C               **  STEP 4--                   **
17976C               **  EXTRACT THE VARIABLE LIST  **
17977C               *********************************
17978C
17979      ISTEPN='4'
17980      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
17981     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17982C
17983      INAME='TIETJEN-MOORE TEST FOR OUTLIERS'
17984      MINNA=1
17985      MAXNA=100
17986      MINN2=2
17987      IFLAGE=1
17988      IF(IMULT.EQ.'ON')IFLAGE=0
17989      IFLAGM=1
17990      IF(IREPL.EQ.'ON')IFLAGM=0
17991      IFLAGP=0
17992      JMIN=1
17993      JMAX=NUMARG
17994      MINNVA=-99
17995      MAXNVA=-99
17996C
17997      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
17998     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
17999     1            JMIN,JMAX,
18000     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
18001     1            IVARN1,IVARN2,IVARTY,PVAR,
18002     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
18003     1            MINNVA,MAXNVA,
18004     1            IFLAGM,IFLAGP,
18005     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
18006      IF(IERROR.EQ.'YES')GOTO9000
18007C
18008      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')THEN
18009        WRITE(ICOUT,999)
18010        CALL DPWRST('XXX','BUG ')
18011        WRITE(ICOUT,281)
18012  281   FORMAT('***** AFTER CALL DPPARS--')
18013        CALL DPWRST('XXX','BUG ')
18014        WRITE(ICOUT,282)NQ,NUMVAR
18015  282   FORMAT('NQ,NUMVAR = ',2I8)
18016        CALL DPWRST('XXX','BUG ')
18017        IF(NUMVAR.GT.0)THEN
18018          DO285I=1,NUMVAR
18019            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
18020     1                      ICOLR(I)
18021  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
18022     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
18023            CALL DPWRST('XXX','BUG ')
18024  285     CONTINUE
18025        ENDIF
18026      ENDIF
18027C
18028C               ***********************************************
18029C               **  STEP 5--                                 **
18030C               **  DETERMINE:                               **
18031C               **  1) NUMBER OF REPLICATION VARIABLES (0-6) **
18032C               **  2) NUMBER OF RESPONSE    VARIABLES (>= 1)**
18033C               ***********************************************
18034C
18035      ISTEPN='5'
18036      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
18037     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18038C
18039      NRESP=0
18040      NREPL=0
18041      NLABID=0
18042      IF(IMULT.EQ.'ON')THEN
18043        NRESP=NUMVAR
18044      ELSEIF(IREPL.EQ.'ON')THEN
18045        NRESP=1
18046        IF(NUMVAR.EQ.2)THEN
18047          NLABID=0
18048          NREPL=1
18049        ELSE
18050          NLABID=1
18051          NREPL=NUMVAR-NRESP-NLABID
18052        ENDIF
18053        IF(NREPL.LT.1 .OR. NREPL.GT.6)THEN
18054          WRITE(ICOUT,999)
18055          CALL DPWRST('XXX','BUG ')
18056          WRITE(ICOUT,101)
18057          CALL DPWRST('XXX','BUG ')
18058          WRITE(ICOUT,511)
18059  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
18060     1           'REPLICATION VARIABLES')
18061          CALL DPWRST('XXX','BUG ')
18062          WRITE(ICOUT,513)NREPL
18063  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
18064          CALL DPWRST('XXX','BUG ')
18065          IERROR='YES'
18066          GOTO9000
18067        ENDIF
18068      ELSE
18069        NRESP=1
18070        NLABID=NUMVAR-NRESP
18071        IF(NLABID.GT.1)NLABID=1
18072      ENDIF
18073C
18074      IHP='NOUT'
18075      IHP2='LIER'
18076      IHWUSE='P'
18077      MESSAG='NO'
18078      CALL CHECKN(IHP,IHP2,IHWUSE,
18079     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
18080     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
18081      IF(IERROR.EQ.'YES')THEN
18082        IR=1
18083      ELSE
18084        AR=VALUE(ILOCV)
18085        IR=INT(AR+0.1)
18086        IF(IR.LT.1)IR=1
18087      ENDIF
18088C
18089      IOP='OPEN'
18090      IFLAG1=0
18091      IFLAG2=1
18092      IFLAG3=0
18093      IFLAG4=0
18094      IFLAG5=0
18095      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
18096     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
18097     1            IBUGA3,ISUBRO,IERROR)
18098      IF(IERROR.EQ.'YES')GOTO9000
18099C
18100      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')THEN
18101        WRITE(ICOUT,521)NRESP,NLABID,NREPL,IR
18102  521   FORMAT('NRESP,NLABID,NREPL,IR = ',4I5)
18103        CALL DPWRST('XXX','BUG ')
18104      ENDIF
18105C
18106C               ******************************************************
18107C               **  STEP 6--                                        **
18108C               **  GENERATE THE TIETJEN-MOORE TEST FOR THE VARIOUS **
18109C               **  CASES                                           **
18110C               ******************************************************
18111C
18112      ISTEPN='6'
18113      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
18114     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18115C
18116C               *****************************************
18117C               **  STEP 7A--                          **
18118C               **  CASE 1: SINGLE RESPONSE VARIABLE   **
18119C               **          WITH NO REPLICATION        **
18120C               *****************************************
18121C
18122      IF(NRESP.EQ.1 .AND. NREPL.EQ.0)THEN
18123        ISTEPN='7A'
18124        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
18125     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18126C
18127        PID(1)=CPUMIN
18128        IVARID(1)=IVARN1(1)
18129        IVARI2(1)=IVARN2(1)
18130C
18131        ICOL=1
18132        NUMVA2=1
18133        IF(NLABID.GE.1)NUMVA2=2
18134        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
18135     1              INAME,IVARN1,IVARN2,IVARTY,
18136     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
18137     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
18138     1              MAXCP4,MAXCP5,MAXCP6,
18139     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
18140     1              Y1,X1,XTEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE,
18141     1              IBUGA3,ISUBRO,IFOUND,IERROR)
18142        IF(IERROR.EQ.'YES')GOTO9000
18143C
18144C       *****************************************************
18145C       **  STEP 7B--                                      **
18146C       **  CALL DPTIE2 TO PERFORM THE OUTLIER TEST.       **
18147C       *****************************************************
18148C
18149C
18150        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIET')THEN
18151          ISTEPN='7B'
18152          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18153          WRITE(ICOUT,999)
18154          CALL DPWRST('XXX','BUG ')
18155          WRITE(ICOUT,711)
18156  711     FORMAT('***** FROM THE MIDDLE  OF DPTIET--')
18157          CALL DPWRST('XXX','BUG ')
18158          WRITE(ICOUT,712)ICASAN,NUMVAR,IDATSW,NLOCAL
18159  712     FORMAT('ICASAN,NUMVAR,IDATSW,NQ = ',
18160     1           A4,I8,2X,A4,I8)
18161          CALL DPWRST('XXX','BUG ')
18162          IF(NLOCAL.GE.1)THEN
18163            DO715I=1,NLOCAL
18164              WRITE(ICOUT,716)I,Y1(I),X1(I)
18165  716         FORMAT('I,Y1(I),X1(I) = ',I8,2F12.5)
18166              CALL DPWRST('XXX','BUG ')
18167  715       CONTINUE
18168          ENDIF
18169        ENDIF
18170C
18171        NREPL=0
18172        NCURVE=1
18173        CALL DPTIE2(Y1,X1,NLOCAL,ICASAN,IOUNI2,ISEED,
18174     1              YSTAT,XTEMP1,XTEMP2,XTEMP3,XTEMP4,
18175     1              ITEMP1,ITEMP2,ITEMP3,
18176     1              PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18177     1              ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18178     1              STATVA,STATCD,PVAL,
18179     1              CUT0,CUT01,CUT025,CUT05,CUT10,
18180     1              CUT25,CUT50,CUT100,
18181     1              ISUBRO,IBUGA3,IERROR)
18182C
18183C               ***************************************
18184C               **  STEP 7C--                        **
18185C               **  UPDATE INTERNAL DATAPLOT TABLES  **
18186C               ***************************************
18187C
18188        ISTEPN='7C'
18189        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
18190     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18191C
18192        IFLAGU='ON'
18193        IFRST=.FALSE.
18194        ILAST=.FALSE.
18195        CALL DPTIE4(STATVA,STATCD,PVAL,
18196     1              CUT0,CUT01,CUT025,CUT05,CUT10,
18197     1              CUT25,CUT50,CUT100,
18198     1              IFLAGU,IFRST,ILAST,ICASP2,
18199     1              IBUGA2,IBUGA3,ISUBRO,IERROR)
18200C
18201C               ******************************************
18202C               **  STEP 8A--                           **
18203C               **  CASE 2: MULTIPLE RESPONSE VARIABLES **
18204C               **          NOTE THAT A LABID VARIABLE  **
18205C               **          IS NOT SUPPORTED FOR THIS   **
18206C               **          CASE.                       **
18207C               ******************************************
18208C
18209      ELSEIF(NRESP.GT.1)THEN
18210        ISTEPN='8A'
18211        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
18212     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18213C
18214C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
18215C
18216        NCURVE=0
18217        DO810IRESP=1,NRESP
18218          NCURVE=NCURVE+1
18219C
18220          IINDX=ICOLR(IRESP)
18221          PID(1)=CPUMIN
18222          IVARID(1)=IVARN1(IRESP)
18223          IVARI2(1)=IVARN2(IRESP)
18224C
18225          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')THEN
18226            WRITE(ICOUT,999)
18227            CALL DPWRST('XXX','BUG ')
18228            WRITE(ICOUT,811)IRESP,NCURVE
18229  811       FORMAT('IRESP,NCURVE = ',2I5)
18230            CALL DPWRST('XXX','BUG ')
18231          ENDIF
18232C
18233          ICOL=IRESP
18234          NUMVA2=1
18235          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
18236     1                INAME,IVARN1,IVARN2,IVARTY,
18237     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
18238     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
18239     1                MAXCP4,MAXCP5,MAXCP6,
18240     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
18241     1                Y1,XTEMP1,XTEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE,
18242     1                IBUGA3,ISUBRO,IFOUND,IERROR)
18243          IF(IERROR.EQ.'YES')GOTO9000
18244          DO820I=1,NLOCAL
18245            X1(I)=REAL(I)
18246  820     CONTINUE
18247C
18248C         *****************************************************
18249C         **  STEP 8B--                                      **
18250C         **  CALL DPTIE2 TO PERFORM THE OUTLIER TEST.       **
18251C         *****************************************************
18252C
18253          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIET')THEN
18254            ISTEPN='8B'
18255            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18256            WRITE(ICOUT,999)
18257            CALL DPWRST('XXX','BUG ')
18258            WRITE(ICOUT,822)
18259  822       FORMAT('***** FROM THE MIDDLE  OF DPTIET--')
18260            CALL DPWRST('XXX','BUG ')
18261            WRITE(ICOUT,823)ICASAN,NUMVAR,IDATSW,NLOCAL
18262  823       FORMAT('ICASAN,NUMVAR,IDATSW,NQ = ',
18263     1             A4,I8,2X,A4,I8)
18264            CALL DPWRST('XXX','BUG ')
18265            IF(NLOCAL.GE.1)THEN
18266              DO825I=1,NLOCAL
18267                WRITE(ICOUT,826)I,Y1(I),X1(I)
18268  826           FORMAT('I,Y1(I),X1(I) = ',I8,2F12.5)
18269                CALL DPWRST('XXX','BUG ')
18270  825         CONTINUE
18271            ENDIF
18272          ENDIF
18273C
18274          CALL DPTIE2(Y1,X1,NLOCAL,ICASAN,IOUNI2,ISEED,
18275     1                YSTAT,XTEMP1,XTEMP2,XTEMP3,XTEMP4,
18276     1                ITEMP1,ITEMP2,ITEMP3,
18277     1                PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18278     1                ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18279     1                STATVA,STATCD,PVAL,
18280     1                CUT0,CUT01,CUT025,CUT05,CUT10,
18281     1                CUT25,CUT50,CUT100,
18282     1                ISUBRO,IBUGA3,IERROR)
18283C
18284C               ***************************************
18285C               **  STEP 8C--                        **
18286C               **  COMPUTE GRUBB     STAT           **
18287C               **  UPDATE INTERNAL DATAPLOT TABLES  **
18288C               ***************************************
18289C
18290          ISTEPN='8C'
18291          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
18292     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18293C
18294          IFLAGU='FILE'
18295          IFRST=.FALSE.
18296          ILAST=.FALSE.
18297          IF(IRESP.EQ.1)IFRST=.TRUE.
18298          IF(IRESP.EQ.NRESP)ILAST=.TRUE.
18299          IFLAGU='ON'
18300          IFRST=.FALSE.
18301          ILAST=.FALSE.
18302          CALL DPTIE4(STATVA,STATCD,PVAL,
18303     1                CUT0,CUT01,CUT025,CUT05,CUT10,
18304     1                CUT25,CUT50,CUT100,
18305     1                IFLAGU,IFRST,ILAST,ICASP2,
18306     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
18307C
18308  810   CONTINUE
18309C
18310C               ****************************************************
18311C               **  STEP 9A--                                     **
18312C               **  CASE 3: ONE OR MORE REPLICATION VARIABLES.    **
18313C               **          FOR THIS CASE, THE NUMBER OF RESPONSE **
18314C               **          VARIABLES MUST BE EXACTLY 1.          **
18315C               **          FOR THIS CASE, ALL VARIABLES MUST     **
18316C               **          HAVE THE SAME LENGTH.                 **
18317C               ****************************************************
18318C
18319      ELSEIF(IREPL.EQ.'ON')THEN
18320        ISTEPN='9A'
18321        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
18322     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18323C
18324        J=0
18325        IMAX=NRIGHT(1)
18326        IF(NQ.LT.NRIGHT(1))IMAX=NQ
18327        DO910I=1,IMAX
18328          IF(ISUB(I).EQ.0)GOTO910
18329          J=J+1
18330C
18331C         RESPONSE VARIABLE IN Y1
18332C
18333          ICOLC=1
18334          IJ=MAXN*(ICOLR(ICOLC)-1)+I
18335          IF(ICOLR(ICOLC).LE.MAXCOL)Y1(J)=V(IJ)
18336          IF(ICOLR(ICOLC).EQ.MAXCP1)Y1(J)=PRED(I)
18337          IF(ICOLR(ICOLC).EQ.MAXCP2)Y1(J)=RES(I)
18338          IF(ICOLR(ICOLC).EQ.MAXCP3)Y1(J)=YPLOT(I)
18339          IF(ICOLR(ICOLC).EQ.MAXCP4)Y1(J)=XPLOT(I)
18340          IF(ICOLR(ICOLC).EQ.MAXCP5)Y1(J)=X2PLOT(I)
18341          IF(ICOLR(ICOLC).EQ.MAXCP6)Y1(J)=TAGPLO(I)
18342C
18343C         LABID VARIABLE IN X1
18344C
18345          IF(NLABID.GE.1)THEN
18346            ICOLC=ICOLC+1
18347            ICOLT=ICOLR(ICOLC)
18348            IJ=MAXN*(ICOLT-1)+I
18349            IF(ICOLT.LE.MAXCOL)X1(J)=V(IJ)
18350            IF(ICOLT.EQ.MAXCP1)X1(J)=PRED(I)
18351            IF(ICOLT.EQ.MAXCP2)X1(J)=RES(I)
18352            IF(ICOLT.EQ.MAXCP3)X1(J)=YPLOT(I)
18353            IF(ICOLT.EQ.MAXCP4)X1(J)=XPLOT(I)
18354            IF(ICOLT.EQ.MAXCP5)X1(J)=X2PLOT(I)
18355            IF(ICOLT.EQ.MAXCP6)X1(J)=TAGPLO(I)
18356          ELSE
18357            X1(J)=REAL(I)
18358          ENDIF
18359C
18360          IF(NREPL.GE.1)THEN
18361            DO920IR=1,MIN(NREPL,6)
18362              ICOLC=ICOLC+1
18363              ICOLT=ICOLR(ICOLC)
18364              IJ=MAXN*(ICOLT-1)+I
18365              IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
18366              IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
18367              IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
18368              IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
18369              IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
18370              IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
18371              IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
18372  920       CONTINUE
18373          ENDIF
18374C
18375  910   CONTINUE
18376        NLOCAL=J
18377C
18378        ISTEPN='9B'
18379        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TIET')
18380     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18381C
18382C       NOTE: CHECK TO SEE IF X1 HAS ALL UNIQUE ELEMENTS.  IF NOT,
18383C             THEN INTERPRET THIS AS A REPLICATION VARIABLE.
18384C
18385        CALL DISTIN(X1,NLOCAL,IWRITE,XTEMP2,NDIST,IBUGA3,IERROR)
18386        IF(NLOCAL.NE.NDIST)THEN
18387          NLABID=0
18388          IF(NREPL.GT.6)NREPL=6
18389          IF(NREPL.GE.1)THEN
18390            DO930J=1,NREPL-1
18391              DO935I=1,NLOCAL
18392                XDESGN(I,J+1)=XDESGN(I,J)
18393  935         CONTINUE
18394  930       CONTINUE
18395          ENDIF
18396          NREPL=NREPL+1
18397          DO938I=1,NLOCAL
18398            XDESGN(I,1)=X1(I)
18399            X1(I)=REAL(I)
18400  938     CONTINUE
18401        ENDIF
18402C
18403        PID(1)=CPUMIN
18404        IVARID(1)=IVARN1(1)
18405        IVARI2(1)=IVARN2(1)
18406        IF(NLABID.EQ.1)THEN
18407          PID(2)=CPUMIN
18408          IVARID(2)=IVARN1(2)
18409          IVARI2(2)=IVARN2(2)
18410        ENDIF
18411        IADD=NRESP+NLABID
18412        DO940II=1,NREPL
18413          IVARID(II+IADD)=IVARN1(II+IADD)
18414          IVARI2(II+IADD)=IVARN2(II+IADD)
18415  940   CONTINUE
18416C
18417C       *****************************************************
18418C       **  STEP 9B--                                      **
18419C       **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
18420C       **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
18421C       **                                                 **
18422C       **  FOR THIS CASE, WE NEED TO LOOP THROUGH THE     **
18423C       **  VARIOUS REPLICATIONS.                          **
18424C       *****************************************************
18425C
18426C
18427        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIET')THEN
18428          ISTEPN='9C'
18429          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18430          WRITE(ICOUT,999)
18431          CALL DPWRST('XXX','BUG ')
18432          WRITE(ICOUT,941)
18433  941     FORMAT('***** FROM THE MIDDLE  OF DPTIET--')
18434          CALL DPWRST('XXX','BUG ')
18435          WRITE(ICOUT,942)ICASAN,NUMVAR,IDATSW,NLOCAL,NREPL
18436  942     FORMAT('ICASAN,NUMVAR,IDATSW,NLOCAL,NREPL = ',
18437     1           A4,I8,2X,A4,2I8)
18438          CALL DPWRST('XXX','BUG ')
18439          IF(NLOCAL.GE.1)THEN
18440            DO945I=1,NLOCAL
18441              WRITE(ICOUT,946)I,Y1(I),X1(I),XDESGN(I,1),XDESGN(I,2)
18442  946         FORMAT('I,Y1(I),X1(I),XDESGN(I,1),XDESGN(I,2) = ',
18443     1               I8,4F12.5)
18444              CALL DPWRST('XXX','BUG ')
18445  945       CONTINUE
18446          ENDIF
18447        ENDIF
18448C
18449C       *****************************************************
18450C       **  STEP 9C--                                      **
18451C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
18452C       **  REPLICATION VARIABLES.                         **
18453C       *****************************************************
18454C
18455        CALL DPPP5(XDESGN(1,1),XDESGN(1,2),XDESGN(1,3),
18456     1             XDESGN(1,4),XDESGN(1,5),XDESGN(1,6),
18457     1             NREPL,NLOCAL,MAXOBV,
18458     1             XIDTEM,XIDTE2,XIDTE3,XIDTE4,XIDTE5,XIDTE6,
18459     1             XTEMP1,XTEMP2,
18460     1             NUMSE1,NUMSE2,NUMSE3,NUMSE4,NUMSE5,NUMSE6,
18461     1             IBUGA3,ISUBRO,IERROR)
18462C
18463C       *****************************************************
18464C       **  STEP 9D--                                      **
18465C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
18466C       *****************************************************
18467C
18468        NPLOTP=0
18469        NCURVE=0
18470        IF(NREPL.EQ.1)THEN
18471          J=0
18472          DO1110ISET1=1,NUMSE1
18473            K=0
18474            PID(IADD+1)=XIDTEM(ISET1)
18475            DO1130I=1,NLOCAL
18476              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
18477                K=K+1
18478                TEMP1(K)=Y1(I)
18479                TEMP2(K)=X1(I)
18480              ENDIF
18481 1130       CONTINUE
18482            NTEMP=K
18483            NCURVE=NCURVE+1
18484            NPLOT1=NPLOTP
18485            IF(NTEMP.GT.0)THEN
18486              CALL DPTIE2(TEMP1,TEMP2,NTEMP,ICASAN,IOUNI2,ISEED,
18487     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,XTEMP4,
18488     1                    ITEMP1,ITEMP2,ITEMP3,
18489     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18490     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18491     1                    STATVA,STATCD,PVAL,
18492     1                    CUT0,CUT01,CUT025,CUT05,CUT10,
18493     1                    CUT25,CUT50,CUT100,
18494     1                    ISUBRO,IBUGA3,IERROR)
18495            ENDIF
18496            NPLOT2=NPLOTP
18497            IFLAGU='FILE'
18498            IFRST=.FALSE.
18499            ILAST=.FALSE.
18500            IF(NCURVE.EQ.1)IFRST=.TRUE.
18501            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
18502            NPTEMP=NPLOT2-NPLOT1
18503            CALL DPTIE4(STATVA,STATCD,PVAL,
18504     1                  CUT0,CUT01,CUT025,CUT05,CUT10,
18505     1                  CUT25,CUT50,CUT100,
18506     1                  IFLAGU,IFRST,ILAST,ICASP2,
18507     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
18508 1110     CONTINUE
18509        ELSEIF(NREPL.EQ.2)THEN
18510          J=0
18511          NTOT=NUMSE1*NUMSE2
18512          DO1210ISET1=1,NUMSE1
18513          DO1220ISET2=1,NUMSE2
18514            K=0
18515            PID(1+IADD)=XIDTEM(ISET1)
18516            PID(2+IADD)=XIDTE2(ISET2)
18517            DO1290I=1,NLOCAL
18518              IF(
18519     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
18520     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
18521     1          )THEN
18522                K=K+1
18523                TEMP1(K)=Y1(I)
18524                TEMP2(K)=X1(I)
18525              ENDIF
18526 1290       CONTINUE
18527            NTEMP=K
18528            NCURVE=NCURVE+1
18529            NPLOT1=NPLOTP
18530            IF(NTEMP.GT.0)THEN
18531              CALL DPTIE2(TEMP1,TEMP2,NTEMP,ICASAN,IOUNI2,ISEED,
18532     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,XTEMP4,
18533     1                    ITEMP1,ITEMP2,ITEMP3,
18534     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18535     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18536     1                    STATVA,STATCD,PVAL,
18537     1                    CUT0,CUT01,CUT025,CUT05,CUT10,
18538     1                    CUT25,CUT50,CUT100,
18539     1                    ISUBRO,IBUGA3,IERROR)
18540            ENDIF
18541            NPLOT2=NPLOTP
18542            IFLAGU='FILE'
18543            IFRST=.FALSE.
18544            ILAST=.FALSE.
18545            IF(NCURVE.EQ.1)IFRST=.TRUE.
18546            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
18547            NPTEMP=NPLOT2-NPLOT1
18548            CALL DPTIE4(STATVA,STATCD,PVAL,
18549     1                  CUT0,CUT01,CUT025,CUT05,CUT10,
18550     1                  CUT25,CUT50,CUT100,
18551     1                  IFLAGU,IFRST,ILAST,ICASP2,
18552     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
18553 1220     CONTINUE
18554 1210     CONTINUE
18555        ELSEIF(NREPL.EQ.3)THEN
18556          J=0
18557          NTOT=NUMSE1*NUMSE2*NUMSE3
18558          DO1310ISET1=1,NUMSE1
18559          DO1320ISET2=1,NUMSE2
18560          DO1330ISET3=1,NUMSE3
18561            K=0
18562            PID(1+IADD)=XIDTEM(ISET1)
18563            PID(2+IADD)=XIDTE2(ISET2)
18564            PID(3+IADD)=XIDTE3(ISET3)
18565            DO1390I=1,NLOCAL
18566              IF(
18567     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
18568     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
18569     1           XIDTE3(ISET3).EQ.XDESGN(I,3)
18570     1          )THEN
18571                K=K+1
18572                TEMP1(K)=Y1(I)
18573                TEMP2(K)=X1(I)
18574              ENDIF
18575 1390       CONTINUE
18576            NTEMP=K
18577            NCURVE=NCURVE+1
18578            NPLOT1=NPLOTP
18579            IF(NTEMP.GT.0)THEN
18580              CALL DPTIE2(TEMP1,TEMP2,NTEMP,ICASAN,IOUNI2,ISEED,
18581     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,XTEMP4,
18582     1                    ITEMP1,ITEMP2,ITEMP3,
18583     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18584     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18585     1                    STATVA,STATCD,PVAL,
18586     1                    CUT0,CUT01,CUT025,CUT05,CUT10,
18587     1                    CUT25,CUT50,CUT100,
18588     1                    ISUBRO,IBUGA3,IERROR)
18589            ENDIF
18590            NPLOT2=NPLOTP
18591            IFLAGU='FILE'
18592            IFRST=.FALSE.
18593            ILAST=.FALSE.
18594            IF(NCURVE.EQ.1)IFRST=.TRUE.
18595            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
18596            NPTEMP=NPLOT2-NPLOT1
18597            CALL DPTIE4(STATVA,STATCD,PVAL,
18598     1                  CUT0,CUT01,CUT025,CUT05,CUT10,
18599     1                  CUT25,CUT50,CUT100,
18600     1                  IFLAGU,IFRST,ILAST,ICASP2,
18601     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
18602 1330     CONTINUE
18603 1320     CONTINUE
18604 1310     CONTINUE
18605        ELSEIF(NREPL.EQ.4)THEN
18606          J=0
18607          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4
18608          DO1410ISET1=1,NUMSE1
18609          DO1420ISET2=1,NUMSE2
18610          DO1430ISET3=1,NUMSE3
18611          DO1440ISET4=1,NUMSE4
18612            K=0
18613            PID(1+IADD)=XIDTEM(ISET1)
18614            PID(2+IADD)=XIDTE2(ISET2)
18615            PID(3+IADD)=XIDTE3(ISET3)
18616            PID(4+IADD)=XIDTE4(ISET4)
18617            DO1490I=1,NLOCAL
18618              IF(
18619     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
18620     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
18621     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
18622     1           XIDTE4(ISET4).EQ.XDESGN(I,4)
18623     1          )THEN
18624                K=K+1
18625                TEMP1(K)=Y1(I)
18626                TEMP2(K)=X1(I)
18627              ENDIF
18628 1490       CONTINUE
18629            NTEMP=K
18630            NCURVE=NCURVE+1
18631            NPLOT1=NPLOTP
18632            IF(NTEMP.GT.0)THEN
18633              CALL DPTIE2(TEMP1,TEMP2,NTEMP,ICASAN,IOUNI2,ISEED,
18634     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,XTEMP4,
18635     1                    ITEMP1,ITEMP2,ITEMP3,
18636     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18637     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18638     1                    STATVA,STATCD,PVAL,
18639     1                    CUT0,CUT01,CUT025,CUT05,CUT10,
18640     1                    CUT25,CUT50,CUT100,
18641     1                    ISUBRO,IBUGA3,IERROR)
18642            ENDIF
18643            NPLOT2=NPLOTP
18644            IFLAGU='FILE'
18645            IFRST=.FALSE.
18646            ILAST=.FALSE.
18647            IF(NCURVE.EQ.1)IFRST=.TRUE.
18648            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
18649            NPTEMP=NPLOT2-NPLOT1
18650            CALL DPTIE4(STATVA,STATCD,PVAL,
18651     1                  CUT0,CUT01,CUT025,CUT05,CUT10,
18652     1                  CUT25,CUT50,CUT100,
18653     1                  IFLAGU,IFRST,ILAST,ICASP2,
18654     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
18655 1440     CONTINUE
18656 1430     CONTINUE
18657 1420     CONTINUE
18658 1410     CONTINUE
18659        ELSEIF(NREPL.EQ.5)THEN
18660          J=0
18661          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5
18662          DO1510ISET1=1,NUMSE1
18663          DO1520ISET2=1,NUMSE2
18664          DO1530ISET3=1,NUMSE3
18665          DO1540ISET4=1,NUMSE4
18666          DO1550ISET5=1,NUMSE5
18667            K=0
18668            PID(1+IADD)=XIDTEM(ISET1)
18669            PID(2+IADD)=XIDTE2(ISET2)
18670            PID(3+IADD)=XIDTE3(ISET3)
18671            PID(4+IADD)=XIDTE4(ISET4)
18672            PID(5+IADD)=XIDTE5(ISET4)
18673            DO1590I=1,NLOCAL
18674              IF(
18675     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
18676     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
18677     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
18678     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
18679     1           XIDTE5(ISET5).EQ.XDESGN(I,5)
18680     1          )THEN
18681                K=K+1
18682                TEMP1(K)=Y1(I)
18683                TEMP2(K)=X1(I)
18684              ENDIF
18685 1590       CONTINUE
18686            NTEMP=K
18687            NCURVE=NCURVE+1
18688            NPLOT1=NPLOTP
18689            IF(NTEMP.GT.0)THEN
18690              CALL DPTIE2(TEMP1,TEMP2,NTEMP,ICASAN,IOUNI2,ISEED,
18691     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,XTEMP4,
18692     1                    ITEMP1,ITEMP2,ITEMP3,
18693     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18694     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18695     1                    STATVA,STATCD,PVAL,
18696     1                    CUT0,CUT01,CUT025,CUT05,CUT10,
18697     1                    CUT25,CUT50,CUT100,
18698     1                    ISUBRO,IBUGA3,IERROR)
18699            ENDIF
18700            NPLOT2=NPLOTP
18701            IFLAGU='FILE'
18702            IFRST=.FALSE.
18703            ILAST=.FALSE.
18704            IF(NCURVE.EQ.1)IFRST=.TRUE.
18705            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
18706            NPTEMP=NPLOT2-NPLOT1
18707            CALL DPTIE4(STATVA,STATCD,PVAL,
18708     1                  CUT0,CUT01,CUT025,CUT05,CUT10,
18709     1                  CUT25,CUT50,CUT100,
18710     1                  IFLAGU,IFRST,ILAST,ICASP2,
18711     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
18712 1550     CONTINUE
18713 1540     CONTINUE
18714 1530     CONTINUE
18715 1520     CONTINUE
18716 1510     CONTINUE
18717        ELSEIF(NREPL.EQ.6)THEN
18718          J=0
18719          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5*NUMSE6
18720          DO1610ISET1=1,NUMSE1
18721          DO1620ISET2=1,NUMSE2
18722          DO1630ISET3=1,NUMSE3
18723          DO1640ISET4=1,NUMSE4
18724          DO1650ISET5=1,NUMSE5
18725          DO1660ISET6=1,NUMSE6
18726            K=0
18727            PID(1+IADD)=XIDTEM(ISET1)
18728            PID(2+IADD)=XIDTE2(ISET2)
18729            PID(3+IADD)=XIDTE3(ISET3)
18730            PID(4+IADD)=XIDTE4(ISET4)
18731            PID(5+IADD)=XIDTE5(ISET4)
18732            PID(6+IADD)=XIDTE6(ISET4)
18733            DO1690I=1,NLOCAL
18734              IF(
18735     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
18736     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
18737     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
18738     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
18739     1           XIDTE5(ISET5).EQ.XDESGN(I,5) .AND.
18740     1           XIDTE6(ISET6).EQ.XDESGN(I,6)
18741     1          )THEN
18742                K=K+1
18743                TEMP1(K)=Y1(I)
18744                TEMP2(K)=X1(I)
18745              ENDIF
18746 1690       CONTINUE
18747            NTEMP=K
18748            NCURVE=NCURVE+1
18749            NPLOT1=NPLOTP
18750            IF(NTEMP.GT.0)THEN
18751              CALL DPTIE2(TEMP1,TEMP2,NTEMP,ICASAN,IOUNI2,ISEED,
18752     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,XTEMP4,
18753     1                    ITEMP1,ITEMP2,ITEMP3,
18754     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18755     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18756     1                    STATVA,STATCD,PVAL,
18757     1                    CUT0,CUT01,CUT025,CUT05,CUT10,
18758     1                    CUT25,CUT50,CUT100,
18759     1                    ISUBRO,IBUGA3,IERROR)
18760            ENDIF
18761            NPLOT2=NPLOTP
18762            IFLAGU='FILE'
18763            IFRST=.FALSE.
18764            ILAST=.FALSE.
18765            IF(NCURVE.EQ.1)IFRST=.TRUE.
18766            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
18767            NPTEMP=NPLOT2-NPLOT1
18768            CALL DPTIE4(STATVA,STATCD,PVAL,
18769     1                  CUT0,CUT01,CUT025,CUT05,CUT10,
18770     1                  CUT25,CUT50,CUT100,
18771     1                  IFLAGU,IFRST,ILAST,ICASP2,
18772     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
18773 1660     CONTINUE
18774 1650     CONTINUE
18775 1640     CONTINUE
18776 1630     CONTINUE
18777 1620     CONTINUE
18778 1610     CONTINUE
18779        ENDIF
18780C
18781      ENDIF
18782C
18783C               *****************
18784C               **  STEP 90--  **
18785C               **  EXIT       **
18786C               *****************
18787C
18788 9000 CONTINUE
18789C
18790      IRANAL=IRANSV
18791      ISEED=ISEESV
18792C
18793      IOP='CLOS'
18794      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
18795     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
18796     1            IBUGA3,ISUBRO,IERROR)
18797C
18798      IF(IERROR.EQ.'YES')THEN
18799        IF(IWIDTH.GE.1)THEN
18800          WRITE(ICOUT,9001)(IANS(I),I=1,MIN(100,IWIDTH))
18801 9001     FORMAT(100A1)
18802          CALL DPWRST('XXX','BUG ')
18803        ENDIF
18804      ENDIF
18805C
18806      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIET')THEN
18807        WRITE(ICOUT,999)
18808        CALL DPWRST('XXX','BUG ')
18809        WRITE(ICOUT,9011)
18810 9011   FORMAT('***** AT THE END       OF DPTIET--')
18811        CALL DPWRST('XXX','BUG ')
18812        WRITE(ICOUT,9012)IFOUND,IERROR
18813 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
18814        CALL DPWRST('XXX','BUG ')
18815        WRITE(ICOUT,9013)NPLOTP,NS,ICASAN
18816 9013   FORMAT('NPLOTP,NS,ICASAN = ',I8,I8,2X,A4)
18817        CALL DPWRST('XXX','BUG ')
18818      ENDIF
18819C
18820      RETURN
18821      END
18822      SUBROUTINE DPTIE2(Y,X,N,ICASAN,IOUNI2,ISEED,
18823     1                  YSTAT,TEMP1,TEMP2,TEMP3,TEMP4,
18824     1                  ITEMP1,ITEMP2,ITEMP3,
18825     1                  PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,IR,
18826     1                  ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
18827     1                  STATVA,STATCD,PVAL,
18828     1                  CUT0,CUT01,CUT025,CUT05,CUT10,
18829     1                  CUT25,CUT50,CUT100,
18830     1                  ISUBRO,IBUGA3,IERROR)
18831C
18832C     PURPOSE--THIS ROUTINE CARRIES OUT THE TIETJEN-MOORE TEST FOR
18833C              UNIVARIATE OUTLIERS (DATA ASSUMED TO FOLLOW AN
18834C              APPROXIMATELY NORMAL DISTRIBUTION).  THE NUMBER OF
18835C              SUSPECTED OUTLIERS MUST BE SPECIFIED IN ADVANCE.
18836C     EXAMPLE--TIETJEN-MOORE TEST Y
18837C     REFERENCE--GARY TIETJEN AND ROGER MOORE (AUGUST 1972), "SOME
18838C                GRUBBS-TYPE STATISTICS FOR THE DETECTION OF SEVERAL
18839C                OUTLIERS", TECHNOMETRICS, VOL. 14, NO. 3, PP. 583-597.
18840C     WRITTEN BY--ALAN HECKERT
18841C                 STATISTICAL ENGINEERING DIVISION
18842C                 INFORMATION TECHNOLOGY LABORATORY
18843C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
18844C                 GAITHERSBURG, MD 20899-8980
18845C                 PHONE--301-975-2899
18846C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18847C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
18848C     LANGUAGE--ANSI FORTRAN (1977)
18849C     VERSION NUMBER--2009/11
18850C     ORIGINAL VERSION--NOVEMBER  2009.
18851C     UPDATED         --JULY      2014. ADD SKEWNESS AND KURTOSIS TO
18852C                                       SUMMARY STATISTICS
18853C
18854C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18855C
18856      CHARACTER*4 ISUBRO
18857      CHARACTER*4 IBUGA3
18858      CHARACTER*4 IERROR
18859      CHARACTER*4 IVARID(*)
18860      CHARACTER*4 IVARI2(*)
18861      CHARACTER*4 ICAPSW
18862      CHARACTER*4 ICAPTY
18863      CHARACTER*4 IFORSW
18864      CHARACTER*4 ICASAN
18865C
18866      CHARACTER*40 IRTFFF
18867      CHARACTER*40 IRTFFP
18868C
18869      CHARACTER*4 IWRITE
18870      CHARACTER*4 IDIR
18871C
18872      CHARACTER*4 ISUBN1
18873      CHARACTER*4 ISUBN2
18874      CHARACTER*4 ISTEPN
18875C
18876      CHARACTER*4 IRTFMD
18877      COMMON/COMRTF/IRTFMD
18878C
18879      PARAMETER (NUMALP=8)
18880      REAL ALPHA(NUMALP)
18881C
18882      CHARACTER*1  IBASLC
18883      PARAMETER(NUMCLI=4)
18884      PARAMETER(MAXLIN=2)
18885      PARAMETER (MAXROW=50)
18886      CHARACTER*60 ITITLE
18887      CHARACTER*60 ITITLZ
18888      CHARACTER*1  ITITL9
18889      CHARACTER*60 ITEXT(MAXROW)
18890      CHARACTER*4  ALIGN(NUMCLI)
18891      CHARACTER*4  VALIGN(NUMCLI)
18892      REAL         AVALUE(MAXROW)
18893      INTEGER      NCTEXT(MAXROW)
18894      INTEGER      IDIGIT(MAXROW)
18895      INTEGER      NTOT(MAXROW)
18896      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
18897      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
18898      CHARACTER*4  ITYPCO(NUMCLI)
18899      INTEGER      NCTIT2(MAXLIN,NUMCLI)
18900      INTEGER      NCVALU(MAXROW,NUMCLI)
18901      INTEGER      IWHTML(NUMCLI)
18902      INTEGER      IWRTF(NUMCLI)
18903      REAL         AMAT(MAXROW,NUMCLI)
18904      LOGICAL IFRST
18905      LOGICAL ILAST
18906      LOGICAL IFLAG1
18907      LOGICAL IFLAG2
18908      LOGICAL IFLAG3
18909C
18910C---------------------------------------------------------------------
18911C
18912      DIMENSION Y(*)
18913      DIMENSION X(*)
18914      DIMENSION YSTAT(*)
18915      DIMENSION TEMP1(*)
18916      DIMENSION TEMP2(*)
18917      DIMENSION TEMP3(*)
18918      DIMENSION TEMP4(*)
18919      DIMENSION PID(*)
18920C
18921      INTEGER ITEMP1(*)
18922      INTEGER ITEMP2(*)
18923      INTEGER ITEMP3(*)
18924C
18925C-----COMMON----------------------------------------------------------
18926C
18927      INCLUDE 'DPCOP2.INC'
18928C
18929      DATA ALPHA/
18930     1 0.0, 1.0, 2.5, 5.0, 10.0, 25.0, 50.0, 100.0/
18931C
18932C-----START POINT-----------------------------------------------------
18933C
18934      ISUBN1='DPTI'
18935      ISUBN2='E2  '
18936      IERROR='NO'
18937      STATVA=CPUMIN
18938      STATCD=CPUMIN
18939      PVAL=CPUMIN
18940      CUT0=CPUMIN
18941      CUT01=CPUMIN
18942      CUT025=CPUMIN
18943      CUT05=CPUMIN
18944      CUT10=CPUMIN
18945      CUT25=CPUMIN
18946      CUT50=CPUMIN
18947      CUT100=CPUMIN
18948C
18949      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')THEN
18950        WRITE(ICOUT,999)
18951  999   FORMAT(1X)
18952        CALL DPWRST('XXX','WRIT')
18953        WRITE(ICOUT,51)
18954   51   FORMAT('**** AT THE BEGINNING OF DPTIE2--')
18955        CALL DPWRST('XXX','WRIT')
18956        WRITE(ICOUT,52)ISUBRO,IBUGA3,ICASAN
18957   52   FORMAT('ISUBRO,IBUGA3,ICASAN = ',3(A4,2X))
18958        CALL DPWRST('XXX','WRIT')
18959        WRITE(ICOUT,55)N
18960   55   FORMAT('N = ',I8)
18961        CALL DPWRST('XXX','WRIT')
18962        DO56I=1,N
18963          WRITE(ICOUT,57)I,Y(I),X(I)
18964   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
18965          CALL DPWRST('XXX','WRIT')
18966   56   CONTINUE
18967      ENDIF
18968C
18969C               ********************************************
18970C               **  STEP 11--                             **
18971C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
18972C               ********************************************
18973C
18974      ISTEPN='11'
18975      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
18976     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
18977C
18978      IF(N.LT.3)THEN
18979        WRITE(ICOUT,999)
18980        CALL DPWRST('XXX','WRIT')
18981        WRITE(ICOUT,1111)
18982 1111   FORMAT('***** ERROR IN TIETJEN-MOORE TEST--')
18983        CALL DPWRST('XXX','WRIT')
18984        WRITE(ICOUT,1113)
18985 1113   FORMAT('      THE NUMBER OF OBSERVATIONS IS LESS THAN 3.')
18986        CALL DPWRST('XXX','WRIT')
18987        WRITE(ICOUT,1114)N
18988 1114   FORMAT('SAMPLE SIZE = ',I8)
18989        CALL DPWRST('XXX','WRIT')
18990        IERROR='YES'
18991        GOTO9000
18992      ENDIF
18993C
18994      IF(IR.GE.N/2)THEN
18995        WRITE(ICOUT,999)
18996        CALL DPWRST('XXX','WRIT')
18997        WRITE(ICOUT,1111)
18998        CALL DPWRST('XXX','WRIT')
18999        WRITE(ICOUT,1121)
19000 1121   FORMAT('      THE SPECIFIED NUMBER OF SUSPECTED OUTLIERS IS ',
19001     1         'GREATER THAN N/2')
19002        CALL DPWRST('XXX','WRIT')
19003        WRITE(ICOUT,1123)IR
19004 1123   FORMAT('THE SUSPECTED NUMBER OF OUTLIERS = ',I8)
19005        CALL DPWRST('XXX','WRIT')
19006        WRITE(ICOUT,1125)N
19007 1125   FORMAT('THE SAMPLE SIZE                  = ',I8)
19008        CALL DPWRST('XXX','WRIT')
19009        IERROR='YES'
19010        GOTO9000
19011      ENDIF
19012C
19013      HOLD=Y(1)
19014      DO1135I=2,N
19015        IF(Y(I).NE.HOLD)GOTO1139
19016 1135 CONTINUE
19017      WRITE(ICOUT,999)
19018      CALL DPWRST('XXX','WRIT')
19019      WRITE(ICOUT,1111)
19020      CALL DPWRST('XXX','WRIT')
19021      WRITE(ICOUT,1131)HOLD
19022 1131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
19023      CALL DPWRST('XXX','WRIT')
19024      IERROR='YES'
19025      GOTO9000
19026 1139 CONTINUE
19027C
19028C               ************************************
19029C               **  STEP 21--                     **
19030C               **  CARRY OUT CALCULATIONS        **
19031C               **  FOR    TIETJEN-MOORE    TEST  **
19032C               ************************************
19033C
19034      ISTEPN='21'
19035      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
19036     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19037C
19038      CALL DPTIE3(Y,N,ICASAN,IR,
19039     1            TEMP1,TEMP2,TEMP3,ITEMP1,ITEMP3,
19040     1            STATVA,YMEAN,YSD,YMIN,YMAX,
19041     1            ISUBRO,IBUGA3,IERROR)
19042C
19043      CALL STMOM3(Y,N,IWRITE,YSKEW,IBUGA3,IERROR)
19044      CALL STMOM4(Y,N,IWRITE,YKURT,IBUGA3,IERROR)
19045C
19046      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')THEN
19047        WRITE(ICOUT,2131)YMEAN,YSD,YMIN,YMAX,STATVA
19048 2131   FORMAT('YMEAN,YSD,YMIN,YMAX,STATVA = ',5G15.7)
19049        CALL DPWRST('XXX','WRIT')
19050      ENDIF
19051C
19052C               ************************************
19053C               **  STEP 22--                     **
19054C               **  COMPUTE CRITICAL VALUES VIA   **
19055C               **  MONTE-CARLO SIMULATION        **
19056C               ************************************
19057C
19058      ISTEPN='22'
19059      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
19060     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19061C
19062      NMCSAM=10000
19063      NTEMP=N
19064      DO2210I=1,NMCSAM
19065        CALL NORRAN(NTEMP,ISEED,TEMP4)
19066        CALL DPTIE3(TEMP4,NTEMP,ICASAN,IR,
19067     1              TEMP1,TEMP2,TEMP3,ITEMP1,ITEMP2,
19068     1              STATV2,YMEAN2,YSD2,YMIN2,YMAX2,
19069     1              ISUBRO,IBUGA3,IERROR)
19070        YSTAT(I)=STATV2
19071        WRITE(IOUNI2,'(3I8,2X,E15.7)')NCURVE,NREPL,I,YSTAT(I)
19072 2210 CONTINUE
19073      IDIR='LOWE'
19074      CALL DPGOF8(YSTAT,NMCSAM,STATVA,PVAL,IDIR,
19075     1            IBUGA3,ISUBRO,IERROR)
19076      STATCD=1.0 - PVAL
19077      CUT0=YSTAT(1)
19078      CUT100=YSTAT(NMCSAM)
19079      IWRITE='OFF'
19080      DO2220I=2,7
19081        P100=ALPHA(I)
19082        CALL PERCEN(P100,YSTAT,NMCSAM,IWRITE,TEMP1,NMCSAM,
19083     1              XSTAT,IBUGA3,IERROR)
19084        IF(I.EQ.2)CUT01=XSTAT
19085        IF(I.EQ.3)CUT025=XSTAT
19086        IF(I.EQ.4)CUT05=XSTAT
19087        IF(I.EQ.5)CUT10=XSTAT
19088        IF(I.EQ.6)CUT25=XSTAT
19089        IF(I.EQ.7)CUT50=XSTAT
19090 2220 CONTINUE
19091C
19092      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')THEN
19093        WRITE(ICOUT,2231)PVAL,STATCD,CUT0,CUT01,CUT025
19094 2231   FORMAT('PVAL,STATCD,CUT0,CUT01,CUT025 = ',5G15.7)
19095        CALL DPWRST('XXX','WRIT')
19096        WRITE(ICOUT,2233)CUT05,CUT10,CUT25,CUT50,CUT100
19097 2233   FORMAT('CUT05,CUT10,CUT25,CUT50,CUT100 = ',5G15.7)
19098        CALL DPWRST('XXX','WRIT')
19099      ENDIF
19100C
19101C
19102C               *********************************
19103C               **   STEP 42--                 **
19104C               **   WRITE OUT EVERYTHING      **
19105C               **   FOR TIETJEN-MOORE TEST    **
19106C               *********************************
19107C
19108      ISTEPN='42'
19109      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
19110     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19111C
19112      IF(IPRINT.EQ.'OFF')GOTO9000
19113C
19114      NUMDIG=7
19115      IF(IFORSW.EQ.'1')NUMDIG=1
19116      IF(IFORSW.EQ.'2')NUMDIG=2
19117      IF(IFORSW.EQ.'3')NUMDIG=3
19118      IF(IFORSW.EQ.'4')NUMDIG=4
19119      IF(IFORSW.EQ.'5')NUMDIG=5
19120      IF(IFORSW.EQ.'6')NUMDIG=6
19121      IF(IFORSW.EQ.'7')NUMDIG=7
19122      IF(IFORSW.EQ.'8')NUMDIG=8
19123      IF(IFORSW.EQ.'9')NUMDIG=9
19124      IF(IFORSW.EQ.'0')NUMDIG=0
19125      IF(IFORSW.EQ.'E')NUMDIG=-2
19126      IF(IFORSW.EQ.'-2')NUMDIG=-2
19127      IF(IFORSW.EQ.'-3')NUMDIG=-3
19128      IF(IFORSW.EQ.'-4')NUMDIG=-4
19129      IF(IFORSW.EQ.'-5')NUMDIG=-5
19130      IF(IFORSW.EQ.'-6')NUMDIG=-6
19131      IF(IFORSW.EQ.'-7')NUMDIG=-7
19132      IF(IFORSW.EQ.'-8')NUMDIG=-8
19133      IF(IFORSW.EQ.'-9')NUMDIG=-9
19134C
19135      IF(ICASAN.EQ.'TWOS')THEN
19136        ITITLE=
19137     1  'Tietjen-Moore Test for Multiple Outliers: Two-Sided Case'
19138        NCTITL=56
19139        ITITLZ='(Assumption: Normality)'
19140        NCTITZ=23
19141      ELSEIF(ICASAN.EQ.'MINI')THEN
19142        ITITLE='Tietjen-Moore Test for Multiple Outliers: Minimum Case'
19143        NCTITL=54
19144        ITITLZ='(Assumption: Normality)'
19145        NCTITZ=23
19146      ELSEIF(ICASAN.EQ.'MAXI')THEN
19147        ITITLE='Tietjen-Moore Test for Multiple Outliers: Maximum Case'
19148        NCTITL=54
19149        ITITLZ='(Assumption: Normality)'
19150        NCTITZ=23
19151      ENDIF
19152C
19153      ICNT=1
19154      ITEXT(ICNT)=' '
19155      NCTEXT(ICNT)=0
19156      AVALUE(ICNT)=0.0
19157      IDIGIT(ICNT)=-1
19158      ICNT=ICNT+1
19159      ITEXT(ICNT)='Response Variable: '
19160      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
19161      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
19162      NCTEXT(ICNT)=27
19163      AVALUE(ICNT)=0.0
19164      IDIGIT(ICNT)=-1
19165C
19166      IF(NREPL.GT.0)THEN
19167        NRESP=1
19168        IADD=NLABID+NRESP
19169        DO4101I=1,NREPL
19170          ICNT=ICNT+1
19171          ITEMP=I+IADD
19172          ITEXT(ICNT)='Factor Variable  : '
19173          WRITE(ITEXT(ICNT)(17:17),'(I1)')I
19174          WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(ITEMP)(1:4)
19175          WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(ITEMP)(1:4)
19176          NCTEXT(ICNT)=27
19177          AVALUE(ICNT)=PID(ITEMP)
19178          IDIGIT(ICNT)=NUMDIG
19179 4101   CONTINUE
19180      ENDIF
19181C
19182      ICNT=ICNT+1
19183      ITEXT(ICNT)=' '
19184      NCTEXT(ICNT)=1
19185      AVALUE(ICNT)=0.0
19186      IDIGIT(ICNT)=-1
19187C
19188      ICNT=ICNT+1
19189      ITEXT(ICNT)='H0: There are no outliers'
19190      NCTEXT(ICNT)=25
19191      AVALUE(ICNT)=0.0
19192      IDIGIT(ICNT)=-1
19193      ICNT=ICNT+1
19194C
19195      ITEXT(ICNT)(1:8)='Ha: The '
19196      WRITE(ITEXT(ICNT)(9:13),'(I5)')IR
19197      ISTRT=N-IR+1
19198      IF(ICASAN.EQ.'TWOS')THEN
19199        ITEXT(ICNT)(14:46)=' most extreme points are outliers'
19200        NCTEXT(ICNT)=46
19201        AVALUE(ICNT)=0.0
19202        IDIGIT(ICNT)=-1
19203        DO4111I=ISTRT,N
19204          ICNT=ICNT+1
19205          ITEXT(ICNT)='Potential Outlier Value Tested:'
19206          NCTEXT(ICNT)=31
19207CCCCC     DPTIE3 SORTS Y APPROPRIATELY, SO ITEMP3 RETURNS WRONG
19208CCCCC     VALUE, JUST PRINT THE Y
19209CCCCC     INDOUT=ITEMP3(I)
19210CCCCC     AVALUE(ICNT)=Y(INDOUT)
19211          AVALUE(ICNT)=Y(I)
19212          IDIGIT(ICNT)=NUMDIG
19213 4111   CONTINUE
19214      ELSEIF(ICASAN.EQ.'MINI')THEN
19215        ITEXT(ICNT)(14:41)=' minimum points are outliers'
19216        NCTEXT(ICNT)=41
19217        AVALUE(ICNT)=0.0
19218        IDIGIT(ICNT)=-1
19219        DO4113I=ISTRT,N
19220          ICNT=ICNT+1
19221          ITEXT(ICNT)='Potential Outlier Value Tested:'
19222          NCTEXT(ICNT)=31
19223          AVALUE(ICNT)=Y(I)
19224          IDIGIT(ICNT)=NUMDIG
19225 4113   CONTINUE
19226      ELSEIF(ICASAN.EQ.'MAXI')THEN
19227        ITEXT(ICNT)(14:41)=' maximum points are outliers'
19228        NCTEXT(ICNT)=41
19229        AVALUE(ICNT)=0.0
19230        IDIGIT(ICNT)=-1
19231        DO4115I=ISTRT,N
19232          ICNT=ICNT+1
19233          ITEXT(ICNT)='Potential Outlier Value Tested:'
19234          NCTEXT(ICNT)=31
19235          AVALUE(ICNT)=Y(I)
19236          IDIGIT(ICNT)=NUMDIG
19237 4115   CONTINUE
19238      ENDIF
19239C
19240      ICNT=ICNT+1
19241      ITEXT(ICNT)=' '
19242      NCTEXT(ICNT)=1
19243      AVALUE(ICNT)=0.0
19244      IDIGIT(ICNT)=-1
19245      ICNT=ICNT+1
19246      ITEXT(ICNT)='Summary Statistics:'
19247      NCTEXT(ICNT)=19
19248      AVALUE(ICNT)=0.0
19249      IDIGIT(ICNT)=-1
19250      ICNT=ICNT+1
19251      ITEXT(ICNT)='Number of Observations:'
19252      NCTEXT(ICNT)=23
19253      AVALUE(ICNT)=REAL(N)
19254      IDIGIT(ICNT)=0
19255      ICNT=ICNT+1
19256      ITEXT(ICNT)='Sample Minimum:'
19257      NCTEXT(ICNT)=15
19258      AVALUE(ICNT)=YMIN
19259      IDIGIT(ICNT)=NUMDIG
19260CCCCC ICNT=ICNT+1
19261CCCCC ITEXT(ICNT)='ID for Sample Minimum:'
19262CCCCC NCTEXT(ICNT)=22
19263CCCCC AVALUE(ICNT)=X(INDMIN)
19264CCCCC IDIGIT(ICNT)=0
19265      ICNT=ICNT+1
19266      ITEXT(ICNT)='Sample Maximum:'
19267      NCTEXT(ICNT)=15
19268      AVALUE(ICNT)=YMAX
19269      IDIGIT(ICNT)=NUMDIG
19270CCCCC ICNT=ICNT+1
19271CCCCC ITEXT(ICNT)='ID for Sample Maximum:'
19272CCCCC NCTEXT(ICNT)=22
19273CCCCC AVALUE(ICNT)=X(INDMAX)
19274CCCCC IDIGIT(ICNT)=0
19275      ICNT=ICNT+1
19276      ITEXT(ICNT)='Sample Mean:'
19277      NCTEXT(ICNT)=12
19278      AVALUE(ICNT)=YMEAN
19279      IDIGIT(ICNT)=NUMDIG
19280      ICNT=ICNT+1
19281      ITEXT(ICNT)='Sample SD:'
19282      NCTEXT(ICNT)=10
19283      AVALUE(ICNT)=YSD
19284      IDIGIT(ICNT)=NUMDIG
19285      ICNT=ICNT+1
19286      ITEXT(ICNT)='Sample Skewness:'
19287      NCTEXT(ICNT)=16
19288      AVALUE(ICNT)=YSKEW
19289      IDIGIT(ICNT)=NUMDIG
19290      ICNT=ICNT+1
19291      ITEXT(ICNT)='Sample Kurtosis:'
19292      NCTEXT(ICNT)=16
19293      AVALUE(ICNT)=YKURT
19294      IDIGIT(ICNT)=NUMDIG
19295      ICNT=ICNT+1
19296      ITEXT(ICNT)=' '
19297      NCTEXT(ICNT)=1
19298      AVALUE(ICNT)=0.0
19299      IDIGIT(ICNT)=-1
19300      ICNT=ICNT+1
19301      ITEXT(ICNT)='Tietjen-Moore Test Statistic Value:'
19302      NCTEXT(ICNT)=35
19303      AVALUE(ICNT)=STATVA
19304      IDIGIT(ICNT)=NUMDIG
19305C
19306      ICNT=ICNT+1
19307      ITEXT(ICNT)='CDF Value:'
19308      NCTEXT(ICNT)=10
19309      AVALUE(ICNT)=STATCD
19310      IDIGIT(ICNT)=NUMDIG
19311      ICNT=ICNT+1
19312      ITEXT(ICNT)='P-Value:'
19313      NCTEXT(ICNT)=7
19314      AVALUE(ICNT)=PVAL
19315      IDIGIT(ICNT)=NUMDIG
19316      ICNT=ICNT+1
19317      ITEXT(ICNT)=' '
19318      NCTEXT(ICNT)=1
19319      AVALUE(ICNT)=0.0
19320      IDIGIT(ICNT)=-1
19321C
19322      NUMROW=ICNT
19323      DO4210I=1,NUMROW
19324        NTOT(I)=15
19325 4210 CONTINUE
19326C
19327      IFRST=.TRUE.
19328      ILAST=.TRUE.
19329C
19330      ISTEPN='42A'
19331      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
19332     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19333C
19334      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
19335     1            AVALUE,IDIGIT,
19336     1            NTOT,NUMROW,
19337     1            ICAPSW,ICAPTY,ILAST,IFRST,
19338     1            ISUBRO,IBUGA3,IERROR)
19339C
19340      ISTEPN='42B'
19341      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
19342     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19343C
19344      ITITLE=' '
19345      NCTITL=0
19346C
19347      ITITL9=' '
19348      NCTIT9=0
19349      ITITLE(1:44)='Percent Points of the Reference Distribution'
19350      NCTITL=44
19351      NUMLIN=1
19352      NUMROW=8
19353      NUMCOL=3
19354      ITITL2(1,1)='Percent Point'
19355      ITITL2(1,2)=' '
19356      ITITL2(1,3)='Value'
19357      NCTIT2(1,1)=13
19358      NCTIT2(1,2)=1
19359      NCTIT2(1,3)=5
19360C
19361      NMAX=0
19362      DO4221I=1,NUMCOL
19363        VALIGN(I)='b'
19364        ALIGN(I)='r'
19365        NTOT(I)=15
19366        IF(I.EQ.2)NTOT(I)=5
19367        NMAX=NMAX+NTOT(I)
19368        IDIGIT(I)=NUMDIG
19369        ITYPCO(I)='NUME'
19370 4221 CONTINUE
19371      ITYPCO(2)='ALPH'
19372      IDIGIT(1)=1
19373      IDIGIT(3)=3
19374      DO4223I=1,NUMROW
19375        DO4225J=1,NUMCOL
19376          NCVALU(I,J)=0
19377          IVALUE(I,J)=' '
19378          NCVALU(I,J)=0
19379          AMAT(I,J)=0.0
19380          IF(J.EQ.1)THEN
19381            AMAT(I,J)=ALPHA(I)
19382          ELSEIF(J.EQ.2)THEN
19383            IVALUE(I,J)='='
19384            NCVALU(I,J)=1
19385          ELSEIF(J.EQ.3)THEN
19386            IF(I.EQ.1)THEN
19387              AMAT(I,J)=RND(CUT0,IDIGIT(J))
19388            ELSEIF(I.EQ.2)THEN
19389              AMAT(I,J)=RND(CUT01,IDIGIT(J))
19390            ELSEIF(I.EQ.3)THEN
19391              AMAT(I,J)=RND(CUT025,IDIGIT(J))
19392            ELSEIF(I.EQ.4)THEN
19393              AMAT(I,J)=RND(CUT05,IDIGIT(J))
19394            ELSEIF(I.EQ.5)THEN
19395              AMAT(I,J)=RND(CUT10,IDIGIT(J))
19396            ELSEIF(I.EQ.6)THEN
19397              AMAT(I,J)=RND(CUT25,IDIGIT(J))
19398            ELSEIF(I.EQ.7)THEN
19399              AMAT(I,J)=RND(CUT50,IDIGIT(J))
19400            ELSEIF(I.EQ.8)THEN
19401              AMAT(I,J)=RND(CUT100,IDIGIT(J))
19402            ENDIF
19403          ENDIF
19404 4225   CONTINUE
19405 4223 CONTINUE
19406C
19407      IWHTML(1)=150
19408      IWHTML(2)=50
19409      IWHTML(3)=150
19410      IWRTF(1)=2000
19411      IWRTF(2)=IWRTF(1)+500
19412      IWRTF(3)=IWRTF(2)+2000
19413      IFRST=.TRUE.
19414      ILAST=.FALSE.
19415C
19416      ISTEPN='42C'
19417      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
19418     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19419C
19420      CALL DPDTA4(ITITL9,NCTIT9,
19421     1            ITITLE,NCTITL,ITITL2,NCTIT2,
19422     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
19423     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
19424     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
19425     1            ICAPSW,ICAPTY,IFRST,ILAST,
19426     1            ISUBRO,IBUGA3,IERROR)
19427C
19428      ISTEPN='42D'
19429      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
19430     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19431C
19432      CDF1=CUT10
19433      CDF2=CUT05
19434      CDF3=CUT025
19435      CDF4=CUT01
19436C
19437      ITITL9=' '
19438      NCTIT9=0
19439      ITITLE='Conclusions (Lower 1-Tailed Test)'
19440      NCTITL=33
19441      NUMLIN=1
19442      NUMROW=4
19443      NUMCOL=4
19444      ITITL2(1,1)='Alpha'
19445      ITITL2(1,2)='CDF'
19446      ITITL2(1,3)='Critical Value'
19447      ITITL2(1,4)='Conclusion'
19448      NCTIT2(1,1)=5
19449      NCTIT2(1,2)=3
19450      NCTIT2(1,3)=14
19451      NCTIT2(1,4)=10
19452C
19453      NMAX=0
19454      DO4321I=1,NUMCOL
19455        VALIGN(I)='b'
19456        ALIGN(I)='r'
19457        NTOT(I)=15
19458        IF(I.EQ.1 .OR. I.EQ.2)NTOT(I)=7
19459        IF(I.EQ.3)NTOT(I)=17
19460        NMAX=NMAX+NTOT(I)
19461        IDIGIT(I)=3
19462        ITYPCO(I)='ALPH'
19463 4321 CONTINUE
19464      ITYPCO(3)='NUME'
19465      IDIGIT(1)=0
19466      IDIGIT(2)=0
19467      DO4323I=1,NUMROW
19468        DO4325J=1,NUMCOL
19469          NCVALU(I,J)=0
19470          IVALUE(I,J)=' '
19471          NCVALU(I,J)=0
19472          AMAT(I,J)=0.0
19473 4325   CONTINUE
19474 4323 CONTINUE
19475      IVALUE(1,1)='10%'
19476      IVALUE(2,1)='5%'
19477      IVALUE(3,1)='2.5%'
19478      IVALUE(4,1)='1%'
19479      IVALUE(1,2)='10%'
19480      IVALUE(2,2)='5%'
19481      IVALUE(3,2)='2.5%'
19482      IVALUE(4,2)='1%'
19483      NCVALU(1,1)=3
19484      NCVALU(2,1)=2
19485      NCVALU(3,1)=4
19486      NCVALU(4,1)=2
19487      NCVALU(1,2)=3
19488      NCVALU(2,2)=2
19489      NCVALU(3,2)=4
19490      NCVALU(4,2)=2
19491      IVALUE(1,4)='Accept H0'
19492      IVALUE(2,4)='Accept H0'
19493      IVALUE(3,4)='Accept H0'
19494      IVALUE(4,4)='Accept H0'
19495      NCVALU(1,4)=9
19496      NCVALU(2,4)=9
19497      NCVALU(3,4)=9
19498      NCVALU(4,4)=9
19499      IF(STATVA.LT.CDF1)IVALUE(1,4)='Reject H0'
19500      IF(STATVA.LT.CDF2)IVALUE(2,4)='Reject H0'
19501      IF(STATVA.LT.CDF3)IVALUE(3,4)='Reject H0'
19502      IF(STATVA.LT.CDF4)IVALUE(4,4)='Reject H0'
19503      AMAT(1,3)=RND(CDF1,IDIGIT(3))
19504      AMAT(2,3)=RND(CDF2,IDIGIT(3))
19505      AMAT(3,3)=RND(CDF3,IDIGIT(3))
19506      AMAT(4,3)=RND(CDF4,IDIGIT(3))
19507C
19508      IWHTML(1)=150
19509      IWHTML(2)=150
19510      IWHTML(3)=150
19511      IWHTML(4)=150
19512      IWRTF(1)=1500
19513      IWRTF(2)=IWRTF(1)+1500
19514      IWRTF(3)=IWRTF(2)+2000
19515      IWRTF(4)=IWRTF(3)+2000
19516      IFRST=.FALSE.
19517C
19518C     FOR LATEX, WE WANT TO ENSURE THAT TRAILING LINE IS PART
19519C     OF THE TABLE SO THAT IT WILL BE PRINTED IN THE PROPER PLACE.
19520C
19521      IF(ICAPTY.EQ.'LATE')THEN
19522        ILAST=.FALSE.
19523      ELSE
19524        ILAST=.TRUE.
19525      ENDIF
19526C
19527      ISTEPN='42E'
19528      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')
19529     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19530C
19531      CALL DPDTA4(ITITL9,NCTIT9,
19532     1            ITITLE,NCTITL,ITITL2,NCTIT2,
19533     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
19534     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
19535     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
19536     1            ICAPSW,ICAPTY,IFRST,ILAST,
19537     1            ISUBRO,IBUGA3,IERROR)
19538C
19539      ITITLE(1:26)='*Critical Values Based on '
19540      WRITE(ITITLE(27:34),'(I8)')NMCSAM
19541      ITITLE(35:58)=' Monte Carlo Simulations'
19542      NCTITL=58
19543C
19544      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
19545        CALL DPHTMV(ITITLE,NCTITL,CPUMIN,NUMDIG)
19546      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
19547        CALL DPLATV(ITITLE,NCTITL,CPUMIN,NUMDIG)
19548        IFLAG1=.FALSE.
19549        IFLAG2=.TRUE.
19550        IFLAG3=.TRUE.
19551        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
19552      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
19553C
19554        CALL DPCONA(92,IBASLC)
19555        IRTFMD='OFF'
19556        IPTSZ=14
19557        WRITE(ICOUT,8199)IBASLC,IPTSZ
19558 8199   FORMAT(A1,'fs',I2)
19559        CALL DPWRST(ICOUT,'WRIT')
19560        IF(IRTFFF.EQ.'Courier New')THEN
19561          ITEMP=1
19562        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
19563          ITEMP=8
19564        ENDIF
19565        WRITE(ICOUT,8301)IBASLC,ITEMP
19566        CALL DPWRST(ICOUT,'WRIT')
19567        CALL DPRTFZ(ITITLE,NCTITL,CPUMIN,NUMDIG)
19568        IF(IRTFFP.EQ.'Times New Roman')THEN
19569          ITEMP=0
19570        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
19571          ITEMP=6
19572        ELSEIF(IRTFFP.EQ.'Arial')THEN
19573          ITEMP=2
19574        ELSEIF(IRTFFP.EQ.'Bookman')THEN
19575          ITEMP=3
19576        ELSEIF(IRTFFP.EQ.'Georgia')THEN
19577          ITEMP=4
19578        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
19579          ITEMP=5
19580        ELSEIF(IRTFFP.EQ.'Verdana')THEN
19581          ITEMP=7
19582        ENDIF
19583        WRITE(ICOUT,8301)IBASLC,ITEMP
19584 8301   FORMAT(A1,'f',I1)
19585        CALL DPWRST(ICOUT,'WRIT')
19586C
19587C       END TABLE AND RESET "ASIS" MODE
19588C
19589        IF(IRTFFF.EQ.'Courier New')THEN
19590          ITEMP=1
19591        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
19592          ITEMP=8
19593        ENDIF
19594        WRITE(ICOUT,8091)IBASLC,ITEMP
19595 8091   FORMAT(A1,'f',I1)
19596        CALL DPWRST(ICOUT,'WRIT')
19597C
19598        CALL DPRTF6(NHEAD)
19599        CALL DPRTF6(NHEAD)
19600        IRTFMD='VERB'
19601      ELSE
19602        WRITE(ICOUT,2589)ITITLE(1:58)
19603 2589   FORMAT(A60)
19604        CALL DPWRST('XXX','BUG ')
19605      ENDIF
19606C
19607C               *****************
19608C               **  STEP 90--  **
19609C               **  EXIT       **
19610C               *****************
19611C
19612 9000 CONTINUE
19613      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE2')THEN
19614        WRITE(ICOUT,999)
19615        CALL DPWRST('XXX','WRIT')
19616        WRITE(ICOUT,9011)
19617 9011   FORMAT('***** AT THE END       OF DPTIE2--')
19618        CALL DPWRST('XXX','WRIT')
19619        WRITE(ICOUT,9012)N,IERROR
19620 9012   FORMAT('N,IERROR = ',I8,2X,A4)
19621        CALL DPWRST('XXX','WRIT')
19622        WRITE(ICOUT,9013)STATVA,STATCD,PVAL
19623 9013   FORMAT('STATVA,STATCD,PVAL = ',3G15.7)
19624        CALL DPWRST('XXX','WRIT')
19625      ENDIF
19626C
19627      RETURN
19628      END
19629      SUBROUTINE DPTIE3(Y,N,ICASAN,IR,
19630     1                  TEMP1,TEMP2,TEMP3,ITEMP1,ITEMP2,
19631     1                  STATVA,YMEAN,YSD,YMIN,YMAX,
19632     1                  ISUBRO,IBUGA3,IERROR)
19633C
19634C     PURPOSE--THIS ROUTINE IS SPLIT OFF FROM DPTIE2 TO COMPUTE
19635C              TIETJEN-MOORE STATISTIC.  THIS ROUTINE JUST RETURNS
19636C              THE VALUE OF THE TEST STATISTIC (I.E., NO CRITICAL
19637C              VALUES OR PRINTING).  THIS SIMPLIFIES THE SIMULATION
19638C              STEP USED TO OBTAIN THE CRITICAL VALUES.
19639C     REFERENCE--GARY TIETJEN AND ROGER MOORE (AUGUST 1972), "SOME
19640C                GRUBBS-TYPE STATISTICS FOR THE DETECTION OF SEVERAL
19641C                OUTLIERS", TECHNOMETRICS, VOL. 14, NO. 3, PP. 583-597.
19642C     WRITTEN BY--ALAN HECKERT
19643C                 STATISTICAL ENGINEERING DIVISION
19644C                 INFORMATION TECHNOLOGY LABORATORY
19645C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
19646C                 GAITHERSBURG, MD 20899-8980
19647C                 PHONE--301-975-2899
19648C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19649C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
19650C     LANGUAGE--ANSI FORTRAN (1977)
19651C     VERSION NUMBER--2009/11
19652C     ORIGINAL VERSION--NOVEMBER  2009.
19653C     UPDATED         --JANUARY   2009. SAVE INDICES FOR VALUES TO
19654C                                       BE TESTED AS OUTLIERS
19655C     UPDATED         --JULY      2014. ADD SKEWNESS AND KURTOSIS TO
19656C                                       SUMMARY STATISTICS
19657C
19658C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19659C
19660      CHARACTER*4 ISUBRO
19661      CHARACTER*4 IBUGA3
19662      CHARACTER*4 IERROR
19663      CHARACTER*4 ICASAN
19664C
19665      CHARACTER*4 IWRITE
19666C
19667      CHARACTER*4 ISUBN1
19668      CHARACTER*4 ISUBN2
19669      CHARACTER*4 ISTEPN
19670C
19671      DOUBLE PRECISION DSUMN
19672      DOUBLE PRECISION DSUMD
19673      DOUBLE PRECISION DTERM1
19674C
19675C---------------------------------------------------------------------
19676C
19677      DIMENSION Y(*)
19678      DIMENSION TEMP1(*)
19679      DIMENSION TEMP2(*)
19680      DIMENSION TEMP3(*)
19681C
19682      INTEGER ITEMP1(*)
19683      INTEGER ITEMP2(*)
19684C
19685C-----COMMON----------------------------------------------------------
19686C
19687      INCLUDE 'DPCOP2.INC'
19688C
19689C-----START POINT-----------------------------------------------------
19690C
19691      ISUBN1='DPTI'
19692      ISUBN2='E3  '
19693      IERROR='NO'
19694      STATVA=CPUMIN
19695C
19696      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE3')THEN
19697        WRITE(ICOUT,999)
19698  999   FORMAT(1X)
19699        CALL DPWRST('XXX','WRIT')
19700        WRITE(ICOUT,51)
19701   51   FORMAT('**** AT THE BEGINNING OF DPTIE3--')
19702        CALL DPWRST('XXX','WRIT')
19703        WRITE(ICOUT,52)ISUBRO,IBUGA3,ICASAN
19704   52   FORMAT('ISUBRO,IBUGA3,ICASAN = ',3(A4,2X))
19705        CALL DPWRST('XXX','WRIT')
19706        WRITE(ICOUT,55)N
19707   55   FORMAT('N = ',I8)
19708        CALL DPWRST('XXX','WRIT')
19709        DO56I=1,N
19710          WRITE(ICOUT,57)I,Y(I)
19711   57     FORMAT('I,Y(I) = ',I8,G15.7)
19712          CALL DPWRST('XXX','WRIT')
19713   56   CONTINUE
19714      ENDIF
19715C
19716C               ********************************************
19717C               **  STEP 11--                             **
19718C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
19719C               ********************************************
19720C
19721      ISTEPN='11'
19722      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE3')
19723     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19724C
19725      IF(N.LT.3)THEN
19726        WRITE(ICOUT,999)
19727        CALL DPWRST('XXX','WRIT')
19728        WRITE(ICOUT,1111)
19729 1111   FORMAT('***** ERROR IN TIETJEN-MOORE TEST--')
19730        CALL DPWRST('XXX','WRIT')
19731        WRITE(ICOUT,1113)
19732 1113   FORMAT('      THE NUMBER OF OBSERVATIONS IS LESS THAN 3.')
19733        CALL DPWRST('XXX','WRIT')
19734        WRITE(ICOUT,1114)N
19735 1114   FORMAT('SAMPLE SIZE = ',I8)
19736        CALL DPWRST('XXX','WRIT')
19737        IERROR='YES'
19738        GOTO9000
19739      ENDIF
19740C
19741      IF(IR.GE.N/2)THEN
19742        WRITE(ICOUT,999)
19743        CALL DPWRST('XXX','WRIT')
19744        WRITE(ICOUT,1111)
19745        CALL DPWRST('XXX','WRIT')
19746        WRITE(ICOUT,1121)
19747 1121   FORMAT('      THE SPECIFIED NUMBER OF SUSPECTED OUTLIERS IS ',
19748     1         'GREATER THAN N/2')
19749        CALL DPWRST('XXX','WRIT')
19750        WRITE(ICOUT,1123)IR
19751 1123   FORMAT('THE SUSPECTED NUMBER OF OUTLIERS = ',I8)
19752        CALL DPWRST('XXX','WRIT')
19753        WRITE(ICOUT,1125)N
19754 1125   FORMAT('THE SAMPLE SIZE                  = ',I8)
19755        CALL DPWRST('XXX','WRIT')
19756        IERROR='YES'
19757        GOTO9000
19758      ENDIF
19759C
19760      HOLD=Y(1)
19761      DO1135I=2,N
19762        IF(Y(I).NE.HOLD)GOTO1139
19763 1135 CONTINUE
19764      WRITE(ICOUT,999)
19765      CALL DPWRST('XXX','WRIT')
19766      WRITE(ICOUT,1111)
19767      CALL DPWRST('XXX','WRIT')
19768      WRITE(ICOUT,1131)HOLD
19769 1131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
19770      CALL DPWRST('XXX','WRIT')
19771      IERROR='YES'
19772      GOTO9000
19773 1139 CONTINUE
19774C
19775C               ************************************
19776C               **  STEP 21--                     **
19777C               **  CARRY OUT CALCULATIONS        **
19778C               **  FOR    TIETJEN-MOORE    TEST  **
19779C               ************************************
19780C
19781      ISTEPN='21'
19782      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE3')
19783     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19784C
19785      IWRITE='OFF'
19786      CALL SORT(Y,N,Y)
19787      YMIN=Y(1)
19788      YMAX=Y(N)
19789      CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
19790      CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
19791      DO2101I=1,N
19792        ITEMP1(I)=I
19793 2101 CONTINUE
19794C
19795      IF(ICASAN.EQ.'TWOS')THEN
19796        DO2110I=1,N
19797          TEMP1(I)=ABS(Y(I)-YMEAN)
19798 2110   CONTINUE
19799CCCCC   CALL SORTC3(TEMP1,ITEMP1,N,TEMP2,ITEMP2)
19800        CALL SORTC(TEMP1,Y,N,TEMP2,TEMP3)
19801        DO2115I=1,N
19802          Y(I)=TEMP3(I)
19803 2115   CONTINUE
19804      ELSEIF(ICASAN.EQ.'MINI')THEN
19805         CALL REVERS(Y,N,IWRITE,TEMP1,TEMP2,IBUGA3,IERROR)
19806         DO2117I=1,N
19807           Y(I)=TEMP1(I)
19808 2117    CONTINUE
19809      ENDIF
19810      NLAST=N-IR
19811      CALL MEAN(Y,NLAST,IWRITE,YMEANN,IBUGA3,IERROR)
19812C
19813      DSUMN=0.0D0
19814      DSUMD=0.0D0
19815      DO2120I=1,N
19816        DTERM1=DBLE(Y(I) - YMEAN)
19817        DSUMD=DSUMD + DTERM1**2
19818 2120 CONTINUE
19819C
19820      DO2125I=1,NLAST
19821        DTERM1=DBLE(Y(I) - YMEANN)
19822        DSUMN=DSUMN + DTERM1**2
19823 2125 CONTINUE
19824C
19825      DTERM1=DSUMN/DSUMD
19826      STATVA=REAL(DTERM1)
19827C
19828C               *****************
19829C               **  STEP 90--  **
19830C               **  EXIT       **
19831C               *****************
19832C
19833 9000 CONTINUE
19834      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TIE3')THEN
19835        WRITE(ICOUT,999)
19836        CALL DPWRST('XXX','WRIT')
19837        WRITE(ICOUT,9011)
19838 9011   FORMAT('***** AT THE END       OF DPTIE3--')
19839        CALL DPWRST('XXX','WRIT')
19840        WRITE(ICOUT,9013)YMEAN,YSD,YMIN,YMAX
19841 9013   FORMAT('YMEAN,YSD,YMIN,YMAX = ',4G15.7)
19842        CALL DPWRST('XXX','WRIT')
19843        WRITE(ICOUT,9015)YMEANN,YSDN,ITEMP2(1)
19844 9015   FORMAT('YMEANN,YSDN,YMIN,YMAX,ITEMP2(1) = ',4G15.7,I8)
19845        CALL DPWRST('XXX','WRIT')
19846        WRITE(ICOUT,9017)DSUM1,DSUM2,STATVA
19847 9017   FORMAT('DSUM1,DSUM2,STATVA = ',3G15.7)
19848        CALL DPWRST('XXX','WRIT')
19849      ENDIF
19850C
19851      RETURN
19852      END
19853      SUBROUTINE DPTIE4(STATVA,STATCD,PVAL,
19854     1                  CUT0,CUT01,CUT025,CUT05,CUT10,
19855     1                  CUT25,CUT50,CUT100,
19856     1                  IFLAGU,IFRST,ILAST,ICASPL,
19857     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
19858C
19859C     PURPOSE--UTILITY ROUTINE USED BY DPTIET.  THIS ROUTINE
19860C              UPDATES THE PARAMETERS "STATVAL", "STATCDF", AND
19861C              "PVALUE" AFTER A TIETJEN-MOORE TEST.
19862C     WRITTEN BY--JAMES J. FILLIBEN
19863C                 STATISTICAL ENGINEERING DIVISION
19864C                 INFORMATION TECHNOLOGY LABORAOTRY
19865C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
19866C                 GAITHERSBURG, MD 20899-8980
19867C                 PHONE--301-975-2855
19868C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19869C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
19870C     LANGUAGE--ANSI FORTRAN (1977)
19871C     VERSION NUMBER--2009/11
19872C     ORIGINAL VERSION--NOVEMBER  2009.
19873C
19874C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19875C
19876      CHARACTER*4 IFLAGU
19877      CHARACTER*4 ICASPL
19878      CHARACTER*4 IBUGA2
19879      CHARACTER*4 IBUGA3
19880      CHARACTER*4 ISUBRO
19881      CHARACTER*4 IERROR
19882C
19883      LOGICAL IFRST
19884      LOGICAL ILAST
19885C
19886      CHARACTER*4 IH
19887      CHARACTER*4 IH2
19888      CHARACTER*4 ISUBN0
19889      CHARACTER*4 ISUBN1
19890      CHARACTER*4 ISUBN2
19891      CHARACTER*4 ISTEPN
19892      CHARACTER*4 IOP
19893C
19894      SAVE IOUNI1
19895C
19896C---------------------------------------------------------------------
19897C
19898      INCLUDE 'DPCOPA.INC'
19899      INCLUDE 'DPCOHK.INC'
19900      INCLUDE 'DPCOHO.INC'
19901      INCLUDE 'DPCOF2.INC'
19902C
19903C-----COMMON----------------------------------------------------------
19904C
19905      INCLUDE 'DPCOP2.INC'
19906C
19907C-----START POINT-----------------------------------------------------
19908C
19909      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIE4')THEN
19910        ISTEPN='1'
19911        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19912        WRITE(ICOUT,999)
19913  999   FORMAT(1X)
19914        CALL DPWRST('XXX','BUG ')
19915        WRITE(ICOUT,51)
19916   51   FORMAT('***** AT THE BEGINNING OF DPTIE4--')
19917        CALL DPWRST('XXX','BUG ')
19918        WRITE(ICOUT,53)ICASPL,STATVA,STATCD,PVAL
19919   53   FORMAT('ICASPL,STATVA,STATCD,PVAL = ',A4,2X,3G15.7)
19920        CALL DPWRST('XXX','BUG ')
19921        WRITE(ICOUT,54)CUT0,CUT01,CUT025,CUT05
19922   54   FORMAT('CUT0,CUT01,CUT025,CUT05 = ',4G15.7)
19923        CALL DPWRST('XXX','BUG ')
19924        WRITE(ICOUT,55)CUT10,CUT25,CUT50,CUT100
19925   55   FORMAT('CUT10,CUT25,CUT50,CUT100 = ',4G15.7)
19926        CALL DPWRST('XXX','BUG ')
19927      ENDIF
19928C
19929      IF(IFLAGU.EQ.'FILE')THEN
19930        IF(IFRST)THEN
19931          IOP='OPEN'
19932          IFLAG1=1
19933          IFLAG2=0
19934          IFLAG3=0
19935          IFLAG4=0
19936          IFLAG5=0
19937          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
19938     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
19939     1                IBUGA3,ISUBRO,IERROR)
19940C
19941          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIE4')THEN
19942            ISTEPN='2A'
19943            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19944            WRITE(ICOUT,999)
19945            CALL DPWRST('XXX','BUG ')
19946            WRITE(ICOUT,201)
19947  201       FORMAT('AFTER CALL DPOPFI, IERRF1 = ',A4)
19948            CALL DPWRST('XXX','BUG ')
19949            WRITE(ICOUT,203)IOUNI1,IFILE1
19950  203       FORMAT('IOUNI1,IFILE1 = ',I5,A80)
19951            CALL DPWRST('XXX','BUG ')
19952          ENDIF
19953C
19954          IF(IERROR.EQ.'YES')GOTO9000
19955C
19956          WRITE(IOUNI1,295)
19957  295     FORMAT(11X,'STATVAL',8X,'STATCDF',8X,'PVALUE',
19958     1           7X,'CUTOFF0',7X,'CUTOFF01',6X,'CUTOFF025',
19959     1           7X,'CUTOFF05',7X,'CUTOFF10',7X,'CUTOF25',
19960     1           7X,'CUTOFF50',7X,'CUTOF100')
19961          WRITE(IOUNI1,299)STATVA,STATCD,PVAL,CUT0,CUT01,CUT025,
19962     1                     CUT05,CUT10,CUT25,CUT50,CUT100
19963  299     FORMAT(11E15.7)
19964        ENDIF
19965      ELSEIF(IFLAGU.EQ.'ON')THEN
19966        IF(STATCD.NE.CPUMIN)THEN
19967          IH='STAT'
19968          IH2='VAL '
19969          VALUE0=STATVA
19970          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19971     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19972     1                IANS,IWIDTH,IBUGA3,IERROR)
19973        ENDIF
19974C
19975        IF(STATCD.NE.CPUMIN)THEN
19976          IH='STAT'
19977          IH2='CDF '
19978          VALUE0=STATCD
19979          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19980     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19981     1                IANS,IWIDTH,IBUGA3,IERROR)
19982        ENDIF
19983C
19984        IF(PVAL.NE.CPUMIN)THEN
19985          IH='PVAL'
19986          IH2='UE  '
19987          VALUE0=PVAL
19988          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19989     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19990     1                IANS,IWIDTH,IBUGA3,IERROR)
19991        ENDIF
19992C
19993        IF(CUT0.NE.CPUMIN)THEN
19994          IH='CUTO'
19995          IH2='FF0'
19996          VALUE0=CUT0
19997          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19998     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19999     1                IANS,IWIDTH,IBUGA3,IERROR)
20000        ENDIF
20001C
20002        IF(CUT01.NE.CPUMIN)THEN
20003          IH='CUTO'
20004          IH2='FF01'
20005          VALUE0=CUT01
20006          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
20007     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
20008     1                IANS,IWIDTH,IBUGA3,IERROR)
20009        ENDIF
20010C
20011        IF(CUT025.NE.CPUMIN)THEN
20012          IH='CUTO'
20013          IH2='F025'
20014          VALUE0=CUT025
20015          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
20016     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
20017     1                IANS,IWIDTH,IBUGA3,IERROR)
20018        ENDIF
20019C
20020        IF(CUT05.NE.CPUMIN)THEN
20021          IH='CUTO'
20022          IH2='FF05'
20023          VALUE0=CUT05
20024          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
20025     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
20026     1                IANS,IWIDTH,IBUGA3,IERROR)
20027        ENDIF
20028C
20029        IF(CUT10.NE.CPUMIN)THEN
20030          IH='CUTO'
20031          IH2='FF10'
20032          VALUE0=CUT10
20033          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
20034     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
20035     1                IANS,IWIDTH,IBUGA3,IERROR)
20036        ENDIF
20037C
20038        IF(CUT25.NE.CPUMIN)THEN
20039          IH='CUTO'
20040          IH2='FF25'
20041          VALUE0=CUT25
20042          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
20043     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
20044     1                IANS,IWIDTH,IBUGA3,IERROR)
20045        ENDIF
20046C
20047        IF(CUT50.NE.CPUMIN)THEN
20048          IH='CUTO'
20049          IH2='FF50'
20050          VALUE0=CUT50
20051          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
20052     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
20053     1                IANS,IWIDTH,IBUGA3,IERROR)
20054        ENDIF
20055C
20056        IF(CUT100.NE.CPUMIN)THEN
20057          IH='CUTO'
20058          IH2='F100'
20059          VALUE0=CUT100
20060          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
20061     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
20062     1                IANS,IWIDTH,IBUGA3,IERROR)
20063        ENDIF
20064C
20065      ENDIF
20066C
20067      IF(IFLAGU.EQ.'FILE')THEN
20068        IF(ILAST)THEN
20069          IOP='CLOS'
20070          IFLAG1=1
20071          IFLAG2=0
20072          IFLAG3=0
20073          IFLAG4=0
20074          IFLAG5=0
20075          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
20076     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
20077     1                IBUGA3,ISUBRO,IERROR)
20078C
20079          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIE4')THEN
20080            ISTEPN='3A'
20081            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20082            WRITE(ICOUT,999)
20083            CALL DPWRST('XXX','BUG ')
20084            WRITE(ICOUT,301)
20085  301       FORMAT('AFTER CALL DPCLFI, IERRF1 = ',A4)
20086            CALL DPWRST('XXX','BUG ')
20087            WRITE(ICOUT,303)IOUNI1,IFILE1
20088  303       FORMAT('IOUNI1,IFILE1 = ',I5,A80)
20089            CALL DPWRST('XXX','BUG ')
20090          ENDIF
20091C
20092          IF(IERROR.EQ.'YES')GOTO9000
20093        ENDIF
20094      ENDIF
20095C
20096C               *****************
20097C               **  STEP 90--  **
20098C               **  EXIT       **
20099C               *****************
20100C
20101 9000 CONTINUE
20102C
20103      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TIE4')THEN
20104        WRITE(ICOUT,999)
20105        CALL DPWRST('XXX','BUG ')
20106        WRITE(ICOUT,9011)
20107 9011   FORMAT('***** AT THE END OF DPTIE4--')
20108        CALL DPWRST('XXX','BUG ')
20109      ENDIF
20110C
20111      RETURN
20112      END
20113      SUBROUTINE DPTIFO(IHARG,NUMARG,IDEFFO,ITITFO,IFOUND,IERROR)
20114C
20115C     PURPOSE--DEFINE THE FONT FOR THE TITLE
20116C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
20117C              THE FONT FOR THE TITLE WILL BE PLACED
20118C              IN THE HOLLERITH VARIABLE ITITFO.
20119C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
20120C                     --NUMARG
20121C                     --IDEFFO
20122C     OUTPUT ARGUMENTS--ITITFO
20123C                     --IFOUND ('YES' OR 'NO' )
20124C                     --IERROR ('YES' OR 'NO' )
20125C     WRITTEN BY--ALAN HECKERT
20126C                 COMPUTER SERVICES DIVISION
20127C                 INFORMATION TECHNOLOGY LABORATORY
20128C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20129C                 GAITHERSBURG, MD 20899-8980
20130C                 PHONE--301-975-2899
20131C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20132C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20133C     LANGUAGE--ANSI FORTRAN (1977)
20134C     VERSION NUMBER--89/2
20135C     ORIGINAL VERSION--JANUARY   1989.
20136C
20137C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20138C
20139      CHARACTER*4 IHARG
20140      CHARACTER*4 IDEFFO
20141      CHARACTER*4 ITITFO
20142      CHARACTER*4 IFOUND
20143      CHARACTER*4 IERROR
20144C
20145C---------------------------------------------------------------------
20146C
20147      DIMENSION IHARG(*)
20148C
20149C-----COMMON----------------------------------------------------------
20150C
20151      INCLUDE 'DPCOP2.INC'
20152C
20153C-----START POINT-----------------------------------------------------
20154C
20155      IFOUND='NO'
20156      IERROR='NO'
20157C
20158      IF(NUMARG.LE.0)GOTO1199
20159      IF(IHARG(1).EQ.'FONT')GOTO1110
20160      GOTO1199
20161C
20162 1110 CONTINUE
20163      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
20164      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
20165      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
20166      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
20167      IF(NUMARG.EQ.1)GOTO1150
20168      GOTO1160
20169C
20170 1150 CONTINUE
20171      ITITFO=IDEFFO
20172      GOTO1180
20173C
20174 1160 CONTINUE
20175      ITITFO=IHARG(NUMARG)
20176      GOTO1180
20177C
20178 1180 CONTINUE
20179      IFOUND='YES'
20180C
20181      IF(IFEEDB.EQ.'OFF')GOTO1189
20182      WRITE(ICOUT,999)
20183  999 FORMAT(1X)
20184      CALL DPWRST('XXX','BUG ')
20185      WRITE(ICOUT,1181)ITITFO
20186 1181 FORMAT('THE TITLE FONT HAS JUST BEEN SET TO ',
20187     1A4)
20188      CALL DPWRST('XXX','BUG ')
20189 1189 CONTINUE
20190      GOTO1199
20191C
20192 1199 CONTINUE
20193      RETURN
20194      END
20195