1      SUBROUTINE DPDIA2(X1,Y1,X2,Y2,X3,Y3,
2     1                  IFIG,ILINPA,ILINCO,PLINTH,
3     1                  AREGBA,IREBLI,IREBCO,PREBTH,
4     1                  IREFSW,IREFCO,
5     1                  IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
6     1                  PTEXHE,PTEXWI,PTEXVG,PTEXHG)
7C
8C     PURPOSE--DRAW A DIAMOND WITH ONE END OF THE MAJOR AXIS AT
9C              (X1,Y1) WITH ONE END OF THE MINOR AXIS AT (X2,Y2)
10C              AND THE OTHER END OF MAJOR AXIS AT (X3,Y3).
11C     WRITTEN BY--JAMES J. FILLIBEN
12C                 STATISTICAL ENGINEERING DIVISION
13C                 INFORMATION TECHNOLOGY LABORATORY
14C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15C                 GAITHERSBURG, MD 20899-8980
16C                 PHONE--301-975-2855
17C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19C     LANGUAGE--ANSI FORTRAN (1977)
20C     VERSION NUMBER--82/7
21C     ORIGINAL VERSION--APRIL     1981.
22C     UPDATED         --MAY       1982.
23C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
24C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
25C
26C-----NON-COMMON VARIABLES-------------------------------------
27C
28      CHARACTER*4 IFIG
29      CHARACTER*4 IPATT2
30C
31      CHARACTER*4 ILINPA
32      CHARACTER*4 ILINCO
33C
34      CHARACTER*4 IREBLI
35      CHARACTER*4 IREBCO
36      CHARACTER*4 IREFSW
37      CHARACTER*4 IREFCO
38      CHARACTER*4 IREPTY
39      CHARACTER*4 IREPLI
40      CHARACTER*4 IREPCO
41C
42      CHARACTER*4 IPATT
43      CHARACTER*4 ICOLF
44      CHARACTER*4 ICOLP
45      CHARACTER*4 ICOL
46      CHARACTER*4 IFLAG
47C
48      DIMENSION PX(10)
49      DIMENSION PY(10)
50CCCCC DIMENSION PX3(10)
51CCCCC DIMENSION PY3(10)
52C
53      DIMENSION ILINPA(*)
54      DIMENSION ILINCO(*)
55      DIMENSION PLINTH(*)
56C
57      DIMENSION AREGBA(*)
58      DIMENSION IREBLI(*)
59      DIMENSION IREBCO(*)
60      DIMENSION PREBTH(*)
61      DIMENSION IREFSW(*)
62      DIMENSION IREFCO(*)
63      DIMENSION IREPTY(*)
64      DIMENSION IREPLI(*)
65      DIMENSION IREPCO(*)
66      DIMENSION PREPTH(*)
67      DIMENSION PREPSP(*)
68C
69C-----COMMON----------------------------------------------------------
70C
71      INCLUDE 'DPCOGR.INC'
72      INCLUDE 'DPCOBE.INC'
73      INCLUDE 'DPCOP2.INC'
74C
75C-----START POINT-----------------------------------------------------
76C
77      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DIA2')THEN
78        WRITE(ICOUT,999)
79  999   FORMAT(1X)
80        CALL DPWRST('XXX','BUG ')
81        WRITE(ICOUT,51)
82   51   FORMAT('***** AT THE BEGINNING OF DPDIA2--')
83        CALL DPWRST('XXX','BUG ')
84        WRITE(ICOUT,53)X1,Y1,X2,Y2
85   53   FORMAT('X1,Y1,X2,Y2 = ',4G15.7)
86        CALL DPWRST('XXX','BUG ')
87        WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
88   61   FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,G15.7)
89        CALL DPWRST('XXX','BUG ')
90        WRITE(ICOUT,62)IFIG,AREGBA(1)
91   62   FORMAT('IFIG,AREGBA(1) = ',A4,2X,G15.7)
92        CALL DPWRST('XXX','BUG ')
93        WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
94   63   FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',2(A4,2X),G15.7)
95        CALL DPWRST('XXX','BUG ')
96        WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
97   64   FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
98        CALL DPWRST('XXX','BUG ')
99        WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
100   65   FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
101     1         3(A4,2X),2G15.7)
102        CALL DPWRST('XXX','BUG ')
103        WRITE(ICOUT,69)PTEXHE,PTEXWI,PTEXHG,PTEXVG
104   69   FORMAT('PTEXHE,PTEXWI,PTEXHG,PTEXVG = ',4G15.7)
105        CALL DPWRST('XXX','BUG ')
106        WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
107   79   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
108        CALL DPWRST('XXX','BUG ')
109      ENDIF
110C
111C               *********************************
112C               **  STEP 1--                   **
113C               **  DETERMINE THE COORDINATES  **
114C               **  FOR THE DIAMOND            **
115C               *********************************
116C
117      XC=(X1+X3)/2.0
118      YC=(Y1+Y3)/2.0
119C
120      XDEL=XC-X2
121      YDEL=YC-Y2
122C
123      X4=XC+XDEL
124      Y4=YC+YDEL
125C
126      PX(1)=X1
127      PY(1)=Y1
128C
129      PX(2)=X2
130      PY(2)=Y2
131C
132      PX(3)=X3
133      PY(3)=Y3
134C
135      PX(4)=X4
136      PY(4)=Y4
137C
138      PX(5)=X1
139      PY(5)=Y1
140C
141      NP=5
142C
143C
144C               ***********************
145C               **  STEP 2--         **
146C               **  FILL THE FIGURE  **
147C               **  (IF CALLED FOR)  **
148C               ***********************
149C
150      IF(IREFSW(1).EQ.'OFF')GOTO2190
151      IPATT=IREPTY(1)
152      IPATT2='SOLI'
153      PTHICK=PREPTH(1)
154      PXGAP=PREPSP(1)
155      PYGAP=PREPSP(1)
156      ICOLF=IREFCO(1)
157      ICOLP=IREPCO(1)
158      CALL DPFIRE(PX,PY,NP,
159     1            IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
160 2190 CONTINUE
161C
162C               ***************************
163C               **  STEP 3--             **
164C               **  DRAW OUT THE FIGURE  **
165C               ***************************
166C
167      IPATT=ILINPA(1)
168      PTHICK=PLINTH(1)
169      ICOL=ILINCO(1)
170      IFLAG='ON'
171      CALL DPDRPL(PX,PY,NP,
172     1            IFIG,IPATT,PTHICK,ICOL,
173     1            JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
174C
175C               *****************
176C               **  STEP 90--  **
177C               **  EXIT       **
178C               *****************
179C
180      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DIA2')THEN
181        WRITE(ICOUT,999)
182        CALL DPWRST('XXX','BUG ')
183        WRITE(ICOUT,9011)
184 9011   FORMAT('***** AT THE END       OF DPDIA2--')
185        CALL DPWRST('XXX','BUG ')
186        WRITE(ICOUT,9012)XC,YC,XDEL,YDEL,IERRG4
187 9012   FORMAT('XC,YC,XDEL,YDEL,IERRG4 = ',4G15.7,2X,A4)
188        CALL DPWRST('XXX','BUG ')
189        DO9015I=1,NP
190          WRITE(ICOUT,9016)I,PX(I),PY(I)
191 9016     FORMAT('I,PX(I),PY(I) = ',I8,2G15.7)
192          CALL DPWRST('XXX','BUG ')
193 9015   CONTINUE
194      ENDIF
195C
196      RETURN
197      END
198      SUBROUTINE DPDIAM(IHARG,IARGT,ARG,NUMARG,
199     1                  PXSTAR,PYSTAR,PXEND,PYEND,
200     1                  ILINPA,ILINCO,PLINTH,
201     1                  AREGBA,IREBLI,IREBCO,PREBTH,
202     1                  IREFSW,IREFCO,
203     1                  IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
204     1                  PTEXHE,PTEXWI,PTEXVG,PTEXHG,
205     1                  IGRASW,
206     1                  PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
207     1                  PDIAHE,PDIAWI,PDIAVG,PDIAHG,
208     1                  NUMDEV,IDMANU,IDMODE,IDMOD2,IDMOD3,
209     1                  IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
210     1                  IDNVOF,IDNHOF,IDFONT,UNITSW,PDSCAL,
211     1                  IBUGD2,IFOUND,IERROR)
212C
213C     PURPOSE--DRAW ONE OR MORE DIAMONDS (DEPENDING ON HOW MANY NUMBERS
214C              ARE PROVIDED).  THE COORDINATES ARE IN STANDARDIZED
215C              UNITS OF 0 TO 100.
216C     NOTE--THE INPUT COORDINATES DEFINE 3 SUCCESSIVE POINTS
217C           AROUND THE DIAMOND.
218C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 3
219C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*3 = 6.
220C     NOTE--IF 4 NUMBERS ARE PROVIDED, THEN THE DRAWN DIAMOND WILL GO FROM THE
221C           LAST CURSOR POSITION (ASSUMED TO BE AT ONE END OF MAJOR AXIS)
222C           THROUGH THE (X,Y) POINT (EITHER ABSOLUTE OR RELATIVE) AS DEFINED BY
223C           THE FIRST AND SECOND NUMBERS (ASSUMED TO BE AT ONE END OF MINOR
224C           AXIS), TO THE (X,Y) POINT (EITHER ABSOLUTE OR RELATIVE) AS DEFINED
225C           BY THE THIRD AND FOURTH NUMBERS (ASSUMED TO BE AT THE OTHER END OF
226C           MAJOR AXIS), AND THEN BACK TO THE OTHER END OF THE MINOR AXIS,
227C           AND CONTINUING BACK THE START POINT TO CLOSE THE DIAMOND.
228C     NOTE--IF 6 NUMBERS ARE PROVIDED, THEN THE DRAWN DIAMOND WILL GO FROM THE
229C           ABSOLUTE (X,Y) POSITION AS RESULTING FORM THE FIRST AND SECOND
230C           NUMBERS (ASSUMED TO BE AT ONE END OF MAJOR AXIS), THROUGH THE (X,Y)
231C           POINT (EITHER ABSOLUTE OR RELATIVE) AS DEFINED BY THE THIRD AND
232C           FOURTH NUMBERS (ASSUMED TO BE AT ONE END OF MINOR AXIS), TO THE
233C           (X,Y) POINT (EITHER ABSOLUTE OR RELATIVE) AS DEFINED BY THE FIFTH
234C           AND SIXTH NUMBERS (ASSUMED TO BE AT THE OTHER END OF MAJOR AXIS),
235C           AND THEN BACK TO THE OTHER END OF THE MINOR AXIS,
236C           AND CONTINUING BACK THE START POINT TO CLOSE THE DIAMOND.
237C     NOTE--AND SO FORTH FOR 10, 14, 18, ... NUMBERS.
238C     INPUT  ARGUMENTS--IHARG
239C                     --IARGT
240C                     --ARG
241C                     --NUMARG
242C                     --PXSTAR
243C                     --PYSTAR
244C     OUTPUT ARGUMENTS--PXEND
245C                     --PYEND
246C                     --IFOUND ('YES' OR 'NO' )
247C                     --IERROR ('YES' OR 'NO' )
248C     WRITTEN BY--JAMES J. FILLIBEN
249C                 STATISTICAL ENGINEERING DIVISION
250C                 INFORMATION TECHNOLOGY LABORATORY
251C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
252C                 GAITHERSBURG, MD 20899-8980
253C                 PHONE--301-975-2855
254C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
255C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
256C     LANGUAGE--ANSI FORTRAN (1977)
257C     VERSION NUMBER--82/7
258C     ORIGINAL VERSION--APRIL     1981.
259C     UPDATED         --MARCH     1982.
260C     UPDATED         --MAY       1982.
261C     UPDATED         --NOVEMBER  1982.
262C     UPDATED         --JANUARY   1989. CALL LIST FOR OFFSET VAR (ALAN)
263C     UPDATED         --JANUARY   1989. SEP. UNITS FOR GR & ALPHA I/O (ALAN)
264C     UPDATED         --MARCH     1997. SUPPORT FOR DEVICE FONT (ALAN)
265C     UPDATED         --JULY      1997. SUPPORT FOR "DATA" UNITS (ALAN)
266C     UPDATED         --DECEMBER  2018. CHECK FOR DISCRETE, NULL, OR
267C                                       NONE DEVICE
268C     UPDATED         --DECEMBER  2018. SUPPORT FOR "DEVICE ... SCALE"
269C                                       COMMAND
270C
271C-----NON-COMMON VARIABLES-----------------------------------------
272C
273      CHARACTER*4 IHARG
274      CHARACTER*4 IARGT
275C
276      CHARACTER*4 ILINPA
277      CHARACTER*4 ILINCO
278C
279      CHARACTER*4 IREBLI
280      CHARACTER*4 IREBCO
281      CHARACTER*4 IREFSW
282      CHARACTER*4 IREFCO
283      CHARACTER*4 IREPTY
284      CHARACTER*4 IREPLI
285      CHARACTER*4 IREPCO
286C
287      CHARACTER*4 IGRASW
288      CHARACTER*4 IDMANU
289      CHARACTER*4 IDMODE
290      CHARACTER*4 IDMOD2
291      CHARACTER*4 IDMOD3
292      CHARACTER*4 IDPOWE
293      CHARACTER*4 IDCONT
294      CHARACTER*4 IDCOLO
295      CHARACTER*4 IDFONT
296      CHARACTER*4 UNITSW
297C
298      CHARACTER*4 IFOUND
299      CHARACTER*4 IBUGD2
300      CHARACTER*4 IERROR
301      CHARACTER*4 ISUBRO
302C
303      CHARACTER*4 IFIG
304      CHARACTER*4 IBELSW
305      CHARACTER*4 IERASW
306      CHARACTER*4 IBACCO
307      CHARACTER*4 ICOPSW
308      CHARACTER*4 ITYPEO
309C
310      DIMENSION IHARG(*)
311      DIMENSION IARGT(*)
312      DIMENSION ARG(*)
313C
314      DIMENSION ILINPA(*)
315      DIMENSION ILINCO(*)
316      DIMENSION PLINTH(*)
317C
318      DIMENSION AREGBA(*)
319      DIMENSION IREBLI(*)
320      DIMENSION IREBCO(*)
321      DIMENSION PREBTH(*)
322      DIMENSION IREFSW(*)
323      DIMENSION IREFCO(*)
324      DIMENSION IREPTY(*)
325      DIMENSION IREPLI(*)
326      DIMENSION IREPCO(*)
327      DIMENSION PREPTH(*)
328      DIMENSION PREPSP(*)
329      DIMENSION PDSCAL(*)
330C
331      DIMENSION IDMANU(*)
332      DIMENSION IDMODE(*)
333      DIMENSION IDMOD2(*)
334      DIMENSION IDMOD3(*)
335      DIMENSION IDPOWE(*)
336      DIMENSION IDCONT(*)
337      DIMENSION IDCOLO(*)
338      DIMENSION IDFONT(*)
339      DIMENSION IDNVPP(*)
340      DIMENSION IDNHPP(*)
341      DIMENSION IDUNIT(*)
342      DIMENSION IDNVOF(*)
343      DIMENSION IDNHOF(*)
344C
345C-----COMMON----------------------------------------------------------
346C
347      INCLUDE 'DPCOGR.INC'
348      INCLUDE 'DPCOBE.INC'
349      INCLUDE 'DPCOP2.INC'
350C
351C-----START POINT-----------------------------------------------------
352C
353      IFOUND='NO'
354      IERROR='NO'
355      IERRG4=IERROR
356C
357      ILOCFN=0
358      NUMNUM=0
359C
360      X1=0.0
361      Y1=0.0
362      X2=0.0
363      Y2=0.0
364C
365      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DIAM')THEN
366        WRITE(ICOUT,999)
367  999   FORMAT(1X)
368        CALL DPWRST('XXX','BUG ')
369        WRITE(ICOUT,51)
370   51   FORMAT('***** AT THE BEGINNING OF DPDIAM--')
371        CALL DPWRST('XXX','BUG ')
372      ENDIF
373C
374      IFIG='DIAM'
375      NUMPT=3
376      NUMPT2=2*NUMPT
377C
378C               ********************************
379C               **  STEP 0--                  **
380C               **  STEP THROUGH EACH DEVICE  **
381C               ********************************
382C
383      IF(NUMDEV.LE.0)GOTO9000
384      DO8000IDEVIC=1,NUMDEV
385C
386        IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
387        IF(IDMANU(IDEVIC).EQ.'OFF')GOTO8000
388        IF(IDMANU(IDEVIC).EQ.'NULL')GOTO8000
389        IF(IDMANU(IDEVIC).EQ.'NONE')GOTO8000
390        IF(IDMANU(IDEVIC).EQ.'DISC')GOTO8000
391C
392        IMANUF=IDMANU(IDEVIC)
393        IMODEL=IDMODE(IDEVIC)
394        IMODE2=IDMOD2(IDEVIC)
395        IMODE3=IDMOD3(IDEVIC)
396        IGCONT=IDCONT(IDEVIC)
397        IGCOLO=IDCOLO(IDEVIC)
398        IGFONT=IDFONT(IDEVIC)
399        NUMVPP=IDNVPP(IDEVIC)
400        NUMHPP=IDNHPP(IDEVIC)
401        ANUMVP=NUMVPP
402        ANUMHP=NUMHPP
403        IOFFSV=IDNVOF(IDEVIC)
404        IOFFSH=IDNHOF(IDEVIC)
405        IGUNIT=IDUNIT(IDEVIC)
406        PCHSCA=PDSCAL(IDEVIC)
407C
408C               ************************************
409C               **  STEP 1--                      **
410C               **  CARRY OUT OPENING OPERATIONS  **
411C               **  ON THE GRAPHICS DEVICES       **
412C               ************************************
413C
414        CALL DPOPDE
415C
416        IBELSW='OFF'
417        NUMRIN=0
418        IERASW='OFF'
419        IBACCO='JUNK'
420C
421        CALL DPOPPL(IGRASW,IBELSW,NUMRIN,IERASW,IBACCO)
422C
423C               *****************************************
424C               **  STEP 2--                           **
425C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
426C               *****************************************
427C
428        IF(NUMARG.GE.2.AND.
429     1     IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')THEN
430          ITYPEO='ABSO'
431          ILOCFN=1
432        ELSEIF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
433     1         IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')THEN
434          ITYPEO='ABSO'
435          ILOCFN=2
436        ELSEIF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
437     1         IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')THEN
438          ITYPEO='RELA'
439          ILOCFN=2
440        ELSE
441          GOTO1130
442        ENDIF
443C
444        IF(ILOCFN.GT.NUMARG)GOTO1130
445        DO1120I=ILOCFN,NUMARG
446          IF(IARGT(I).NE.'NUMB')GOTO1130
447 1120   CONTINUE
448        IFOUND='YES'
449C
450C               ****************************
451C               **  STEP 3--              **
452C               **  DRAW OUT THE LINE(S)  **
453C               ****************************
454C
455        NUMNUM=NUMARG-ILOCFN+1
456        IF(NUMNUM.LT.NUMPT2)THEN
457          J=ILOCFN-1
458          X1=PXSTAR
459          Y1=PYSTAR
460        ELSE
461          J=ILOCFN
462          IF(J.GT.NUMARG)GOTO1190
463          X1=ARG(J)
464          IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,
465     1       IBUGD2,ISUBRO,IERROR)
466          J=J+1
467          IF(J.GT.NUMARG)GOTO1190
468          Y1=ARG(J)
469          IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,
470     1       IBUGD2,ISUBRO,IERROR)
471        ENDIF
472C
473 1160   CONTINUE
474        J=J+1
475        IF(J.GT.NUMARG)GOTO1190
476        X2=ARG(J)
477        IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
478        IF(ITYPEO.EQ.'RELA')X2=X1+X2
479        J=J+1
480        IF(J.GT.NUMARG)GOTO1190
481        Y2=ARG(J)
482        IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
483        IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
484C
485        J=J+1
486        IF(J.GT.NUMARG)GOTO1190
487        X3=ARG(J)
488        IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X3,X3,IBUGD2,ISUBRO,IERROR)
489        IF(ITYPEO.EQ.'RELA')X3=X2+X3
490        J=J+1
491        IF(J.GT.NUMARG)GOTO1190
492        Y3=ARG(J)
493        IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y3,Y3,IBUGD2,ISUBRO,IERROR)
494        IF(ITYPEO.EQ.'RELA')Y3=Y2+Y3
495C
496      CALL DPDIA2(X1,Y1,X2,Y2,X3,Y3,
497     1            IFIG,ILINPA,ILINCO,PLINTH,
498     1            AREGBA,IREBLI,IREBCO,PREBTH,
499     1            IREFSW,IREFCO,
500     1            IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
501     1            PTEXHE,PTEXWI,PTEXVG,PTEXHG)
502C
503        X1=X3
504        Y1=Y3
505C
506        GOTO1160
507 1190   CONTINUE
508C
509        PXEND=X3
510        PYEND=Y3
511C
512C               ************************************
513C               **  STEP 4--                      **
514C               **  CARRY OUT CLOSING OPERATIONS  **
515C               **  ON THE GRAPHICS DEVICES       **
516C               ************************************
517C
518        ICOPSW='OFF'
519        NUMCOP=0
520        CALL DPCLPL(ICOPSW,NUMCOP,
521     1              PGRAXF,PGRAYF,
522     1              IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
523     1              PDIAHE,PDIAWI,PDIAVG,PDIAHG)
524C
525        CALL DPCLDE
526C
527 8000 CONTINUE
528      GOTO9000
529C
530 1130 CONTINUE
531      IERRG4='YES'
532      WRITE(ICOUT,1131)
533 1131 FORMAT('***** ERROR IN DIAMOND (DPDIAM)--')
534      CALL DPWRST('XXX','BUG ')
535      WRITE(ICOUT,1132)
536 1132 FORMAT('      ILLEGAL FORM FOR THE DIAMOND COMMAND.')
537      CALL DPWRST('XXX','BUG ')
538      WRITE(ICOUT,1134)
539 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE PROPER FORM--')
540      CALL DPWRST('XXX','BUG ')
541      WRITE(ICOUT,1135)
542 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A DIAMOND ')
543      CALL DPWRST('XXX','BUG ')
544      WRITE(ICOUT,1136)
545 1136 FORMAT('      WITH ONE END OF MAJOR AXIS AT THE POINT 20 20 ')
546      CALL DPWRST('XXX','BUG ')
547      WRITE(ICOUT,1137)
548 1137 FORMAT('      ONE END OF THE MINOR AXIS AT THE POINT 30 10')
549      CALL DPWRST('XXX','BUG ')
550      WRITE(ICOUT,1138)
551 1138 FORMAT('      AND WITH THE OTHER END OF THE MAJOR AXIS')
552      CALL DPWRST('XXX','BUG ')
553      WRITE(ICOUT,1139)
554 1139 FORMAT('      AT THE POINT 40 20')
555      CALL DPWRST('XXX','BUG ')
556      WRITE(ICOUT,1141)
557 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
558      CALL DPWRST('XXX','BUG ')
559      WRITE(ICOUT,1142)
560 1142 FORMAT('      DIAMOND 20 20 30 10 40 20 ')
561      CALL DPWRST('XXX','BUG ')
562      WRITE(ICOUT,1143)
563 1143 FORMAT('      DIAMOND ABSOLUTE 20 20 30 10 40 20 ')
564      CALL DPWRST('XXX','BUG ')
565      WRITE(ICOUT,1145)
566 1145 FORMAT('      DIAMOND RELATIVE 20 20 30 10 40 20 ')
567      CALL DPWRST('XXX','BUG ')
568      GOTO9000
569C               *****************
570C               **  STEP 90--  **
571C               **  EXIT       **
572C               *****************
573C
574 9000 CONTINUE
575      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DIAM')THEN
576        WRITE(ICOUT,999)
577        CALL DPWRST('XXX','BUG ')
578        WRITE(ICOUT,9011)
579 9011   FORMAT('***** AT THE END       OF DPDIAM--')
580        CALL DPWRST('XXX','BUG ')
581        WRITE(ICOUT,9012)IFOUND,IERROR,ILOCFN,NUMNUM
582 9012   FORMAT('IFOUND,IERROR,ILOCFN,NUMNUM = ',2(A4,2X),2I8)
583        CALL DPWRST('XXX','BUG ')
584        WRITE(ICOUT,9013)X1,Y1,X2,Y2,X3,Y3
585 9013   FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6G15.7)
586        CALL DPWRST('XXX','BUG ')
587        WRITE(ICOUT,9015)PXSTAR,PYSTAR,PXEND,PYEND
588 9015   FORMAT('PXSTAR,PYSTAR,PXEND,PYEND = ',4G15.7)
589        CALL DPWRST('XXX','BUG ')
590      ENDIF
591C
592      RETURN
593      END
594      SUBROUTINE DPDIME(IANS,IHARG,IARGT,IARG,NUMARG,IDEMXN,IDEMXC,
595     1IHNAME,IHNAM2,IUSE,IN,IVSTAR,IVSTOP,IVALUE,VALUE,NUMNAM,MAXNAM,
596     1V,MAXNK,NUMN,MAXN,MAXNXT,
597CCCCC JANUARY 1998.  ADD FOLLOWING LINE.
598     1MAXTOM,MAXROM,MAXCOM,MAXOBV,
599     1NUMCOL,MAXCOL,IFOUND,IERROR,IBUGS2)
600C
601C     PURPOSE--DEFINE THE MAXIMUM NUMBER OF ROWS (MAXN)
602C              AND COLUMNS (MAXCOL) IN THE INTERNAL DATAPLOT
603C              DATA ARRAY.
604C              THE MAXIMUM NUMBER OF ROWS WILL BE PLACED
605C              IN THE VARIABLE MAXN.
606C              THE MAXIMUM NUMBER OF COLUMNS WILL BE PLACED
607C              IN THE VARIABLE MAXCOL.
608C              NOTE THAT THE PRODUCT OF MAXN AND MAXCOL SHOULD
609C              NOT EXCEED THE VALUE OF MAXNK.
610C              MAXNK DIFFERS AT DIFFERENT COMPUTER
611C              INSTALLATIONS DEPENDENDING ON AVAILABLE MEMORY.
612C              A TYPICAL VALUE FOR MAXNK IS 10000    .
613C              MAXNK IS DEFINED IN THE SUBROUTINE INITDA.
614C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
615C                     --IARGT  (A  HOLLERITH VECTOR)
616C                     --IARG   (A  HOLLERITH VECTOR)
617C                     --NUMARG (AN INTEGER VARIABLE)
618C                     --IDEMXN (AN INTEGER VARIABLE)
619C                     --IDEMXC (AN INTEGER VARIABLE)
620C                     --IHNAME (A  HOLLERITH VECTOR)
621C                     --IHNAM2 (A  HOLLERITH VECTOR)
622C                     --IUSE   (A  HOLLERITH VECTOR)
623C                     --IN     (AN INTEGER VECTOR)
624C                     --IVSTAR (AN INTEGER VECTOR)
625C                     --IVSTOP (AN INTEGER VECTOR)
626C                     --IVALUE (AN INTEGER VECTOR)
627C                     --VALUE  (A  FLOATING POINT VECTOR)
628C                     --NUMNAM (AN INTEGER VARIABLE)
629C                     --MAXNAM (AN INTEGER VARIABLE)
630C                     --V      (A  FLOATING POINT VECTOR)
631C                     --MAXNK  (AN INTEGER VARIABLE)
632C                     --NUMN   (AN INTEGER VARIABLE)
633C                     --NUMCOL (AN INTEGER VARIABLE)
634C     OUTPUT ARGUMENTS--MAXN   (AN INTEGER VARIABLE
635C                              WHICH SPECIFIES THE MAXIMUM
636C                              NUMBER OF ROWS FOR A GIVEN COLUMN
637C                              (THAT IS, THE MAXIMUM NUMBER OF
638C                              OBSERVATIONS FOR A GIVEN VARIABLE).
639C                     --MAXCOL (AN INTEGER VARIABLE
640C                              WHICH SPECIFIES THE MAXIMUM
641C                              NUMBER OF COLUMNS
642C                              (THAT IS, THE MAXIMUM NUMBER OF
643C                              VARIABLES)
644C                     --IFOUND ('YES' OR 'NO' )
645C                     --IERROR ('YES' OR 'NO' )
646C     WRITTEN BY--JAMES J. FILLIBEN
647C                 STATISTICAL ENGINEERING DIVISION
648C                 INFORMATION TECHNOLOGY LABORATORY
649C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
650C                 GAITHERSBURG, MD 20899-8980
651C                 PHONE--301-975-2855
652C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
653C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
654C     LANGUAGE--ANSI FORTRAN (1977)
655C     VERSION NUMBER--82/7
656C     ORIGINAL VERSION--OCTOBER   1980.
657C     UPDATED         --FEBRUARY  1982.
658C     UPDATED         --MAY       1982.
659C     UPDATED         --APRIL     1985.
660C     UPDATED         --JUNE      1989.  ALLOW   FACTOR
661C     UPDATED         --JULY      1989.  MAXCP1/2/3/4/5/6
662C     UPDATED         --OCTOBER   1991.  MOVE COMMENT LINE
663C     UPDATED         --JANUARY   1998.  ADD DIMENSION MATRIX
664C                                        <ROWS/COLUMNS> <VALUE>
665C     UPDATED         --JULY      1998.  SAVE AS INTERNAL PARAMETERS:
666C                                          MAXROWS, MAXCOLS
667C                                          MAXROWMT, MAXCOLMT
668C
669C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
670C
671      CHARACTER*4 IANS
672      CHARACTER*4 IHARG
673      CHARACTER*4 IARGT
674      CHARACTER*4 IHNAME
675      CHARACTER*4 IHNAM2
676      CHARACTER*4 IUSE
677      CHARACTER*4 IFOUND
678      CHARACTER*4 IERROR
679      CHARACTER*4 IBUGS2
680C
681      CHARACTER*4 ITRUND
682      CHARACTER*4 ITRUNV
683      CHARACTER*4 IDONE
684C
685      CHARACTER*4 IH
686      CHARACTER*4 IH2
687      CHARACTER*4 ISUBN0
688C
689C---------------------------------------------------------------------
690C
691      DIMENSION IHARG(*)
692      DIMENSION IARGT(*)
693      DIMENSION IARG(*)
694C
695      DIMENSION IANS(*)
696      DIMENSION IHNAME(*)
697      DIMENSION IHNAM2(*)
698      DIMENSION IUSE(*)
699      DIMENSION IN(*)
700      DIMENSION IVSTAR(*)
701      DIMENSION IVSTOP(*)
702      DIMENSION IVALUE(*)
703      DIMENSION VALUE(*)
704C
705      DIMENSION V(*)
706C
707CCCCC THE FOLLOWING LINE WAS ADDED JULY 1989
708      INCLUDE 'DPCOM2.INC'
709CCCCC THE FOLLOWING LINE WAS ADDED JULY 1998
710      INCLUDE 'DPCOHO.INC'
711      INCLUDE 'DPCOP2.INC'
712C
713C-----START POINT-----------------------------------------------------
714C
715      IFOUND='YES'
716      IERROR='NO'
717C
718      ISUBN0='DIME'
719      IANS(1)=' '
720      IWIDTH=1
721C
722      ITEMPR=(-999)
723      ITEMPC=(-999)
724      ITEMRC=(-999)
725C
726      MINR=MAXNK/MAXNAM
727      MAXR=MAXNXT
728C
729      MINC=MAXNK/MAXNXT
730      MAXC=MAXNAM
731C
732      MINRC=1
733      MAXRC=MAXNK
734C
735      NNEW=0
736      IV1NEW=0
737      IV2NEW=0
738C
739      IF(IBUGS2.EQ.'ON')THEN
740        WRITE(ICOUT,999)
741  999   FORMAT(1X)
742        CALL DPWRST('XXX','BUG ')
743        WRITE(ICOUT,51)
744   51   FORMAT('AT THE BEGINNING OF DPDIME--')
745        CALL DPWRST('XXX','BUG ')
746        WRITE(ICOUT,53)NUMNAM,MAXNAM,MAXNK,IBUGS2
747   53   FORMAT('NUMNAM,MAXNAM,MAXNK,IBUGS2 = ',3I8,2X,A4)
748        CALL DPWRST('XXX','BUG ')
749        WRITE(ICOUT,55)NUMN,MAXN,MAXNXT,NUMCOL,MAXCOL
750   55   FORMAT('NUMN,MAXN,MAXNXT,NUMCOL,MAXCOL = ',5I8)
751        CALL DPWRST('XXX','BUG ')
752        WRITE(ICOUT,57)MINR,MAXR,MINC,MAXC,MINRC,MAXRC
753   57   FORMAT('MINR,MAXR,MINC,MAXC,MINRC,MAXRC = ',6I8)
754        CALL DPWRST('XXX','BUG ')
755        WRITE(ICOUT,61)
756   61   FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),',
757     1         'IVSTAR(I),IVSTOP(I),IVALUE(I),VALUE(I)')
758        CALL DPWRST('XXX','BUG ')
759        IF(NUMNAM.GE.1)THEN
760          DO62I=1,NUMNAM
761            WRITE(ICOUT,63)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),
762     1                     IVSTAR(I),IVSTOP(I),IVALUE(I),VALUE(I)
763   63       FORMAT(I8,2X,A4,2X,A4,2X,A4,4I8,E15.7)
764            CALL DPWRST('XXX','BUG ')
765   62     CONTINUE
766        ENDIF
767      ENDIF
768C
769C               ****************************************
770C               **  STEP 11--                         **
771C               **  DETERMINE THE DESIRED DIMENSIONS  **
772C               ****************************************
773C
774      IF(NUMARG.LE.1)GOTO1130
775C
776CCCCC JANUARY 1998.  ADD FOLLOWING FOR MATRIX DIMENSIONS
777C
778      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MATR')THEN
779        IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COLU')THEN
780          IF(NUMARG.GE.3.AND.IARGT(3).EQ.'NUMB')THEN
781            MAXCOM=IARG(3)
782            IF(MAXCOM.GT.SQRT(REAL(MAXTOM)))
783     1         MAXCOM=INT(SQRT(REAL(MAXTOM)))
784            IF(MAXCOM.LT.MAXTOM/MAXOBV)MAXCOM=MAXTOM/MAXOBV
785            MAXROM=MAXTOM/MAXCOM
786            IF(MAXROM.GT.MAXN)MAXROM=MAXN
787            WRITE(ICOUT,999)
788            CALL DPWRST('XXX','BUG ')
789            WRITE(ICOUT,901)MAXROM
790            CALL DPWRST('XXX','BUG ')
791            WRITE(ICOUT,902)MAXCOM
792            CALL DPWRST('XXX','BUG ')
793            GOTO950
794          ELSE
795            GOTO990
796          ENDIF
797        ELSEIF(NUMARG.GE.3.AND.IHARG(3).EQ.'COLU')THEN
798          IF(IARGT(2).EQ.'NUMB')THEN
799            MAXCOM=IARG(2)
800            IF(MAXCOM.GT.INT(SQRT(REAL(MAXTOM))))
801     1         MAXCOM=INT(SQRT(REAL(MAXTOM)))
802            IF(MAXCOM.LT.MAXTOM/MAXOBV)MAXCOM=MAXTOM/MAXOBV
803            MAXROM=MAXTOM/MAXCOM
804            IF(MAXROM.GT.MAXN)MAXROM=MAXN
805            WRITE(ICOUT,999)
806            CALL DPWRST('XXX','BUG ')
807            WRITE(ICOUT,901)MAXROM
808            CALL DPWRST('XXX','BUG ')
809            WRITE(ICOUT,902)MAXCOM
810            CALL DPWRST('XXX','BUG ')
811            GOTO950
812          ELSE
813            GOTO990
814          ENDIF
815        ELSEIF(NUMARG.GE.2.AND.IHARG(2)(1:3).EQ.'ROW')THEN
816          IF(NUMARG.GE.3.AND.IARGT(3).EQ.'NUMB')THEN
817            MAXROM=IARG(3)
818            IF(MAXROM.GT.MAXOBV)MAXROM=MAXOBV
819            IF(MAXROM.LT.INT(SQRT(REAL(MAXTOM))))
820     1         MAXROM=INT(SQRT(REAL(MAXTOM)))
821            IF(MAXROM.GT.MAXN)MAXROM=MAXN
822            MAXCOM=MAXTOM/MAXROM
823            WRITE(ICOUT,999)
824            CALL DPWRST('XXX','BUG ')
825            WRITE(ICOUT,901)MAXROM
826            CALL DPWRST('XXX','BUG ')
827            WRITE(ICOUT,902)MAXCOM
828            CALL DPWRST('XXX','BUG ')
829            GOTO950
830          ELSE
831            GOTO990
832          ENDIF
833        ELSEIF(NUMARG.GE.3.AND.IHARG(3)(1:3).EQ.'ROW')THEN
834          IF(IARGT(2).EQ.'NUMB')THEN
835            MAXROM=IARG(2)
836            IF(MAXROM.GT.MAXOBV)MAXROM=MAXOBV
837            IF(MAXROM.LT.SQRT(REAL(MAXTOM)))
838     1         MAXROM=INT(SQRT(REAL(MAXTOM)))
839            IF(MAXROM.GT.MAXN)MAXROM=MAXN
840            MAXCOM=MAXTOM/MAXROM
841            WRITE(ICOUT,999)
842            CALL DPWRST('XXX','BUG ')
843            WRITE(ICOUT,901)MAXROM
844            CALL DPWRST('XXX','BUG ')
845            WRITE(ICOUT,902)MAXCOM
846            CALL DPWRST('XXX','BUG ')
847            GOTO950
848          ELSE
849            GOTO990
850          ENDIF
851        ELSE
852          GOTO990
853        ENDIF
854      ENDIF
855      GOTO980
856C
857  950 CONTINUE
858      IH='MAXR'
859      IH2='OWMT'
860      VALUE0=MAXROM
861      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
862     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
863     1IANS,IWIDTH,IBUGS2,IERROR)
864C
865      IH='MAXC'
866      IH2='OLMT'
867      VALUE0=MAXCOM
868      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
869     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
870     1IANS,IWIDTH,IBUGS2,IERROR)
871C
872      GOTO9000
873C
874  901 FORMAT('THE MAXIMUM NUMBER OF MAXTRIX ROWS    SET TO ',I8)
875  902 FORMAT('THE MAXIMUM NUMBER OF MAXTRIX COLUMNS SET TO ',I8)
876C
877  980 CONTINUE
878      IF(NUMARG.LE.2.AND.IARGT(1).EQ.'NUMB'.AND.
879     1IARGT(2).EQ.'NUMB')GOTO1140
880      IF(NUMARG.LE.2.AND.IARGT(1).EQ.'NUMB'.AND.
881     1IARGT(2).NE.'NUMB')GOTO1150
882C
883      IF(NUMARG.LE.4.AND.IARGT(1).EQ.'NUMB'.AND.
884     1IARGT(2).NE.'NUMB'.AND.IARGT(3).EQ.'NUMB'.AND.
885     1IARGT(4).NE.'NUMB')GOTO1160
886C
887  990 CONTINUE
888      WRITE(ICOUT,999)
889      CALL DPWRST('XXX','BUG ')
890      WRITE(ICOUT,1111)
891 1111 FORMAT('***** ERROR IN DPDIME--')
892      CALL DPWRST('XXX','BUG ')
893      WRITE(ICOUT,1112)
894 1112 FORMAT('      ILLEGAL FORM FOR THE DIMENSION COMMAND.')
895      CALL DPWRST('XXX','BUG ')
896      WRITE(ICOUT,1113)
897 1113 FORMAT('      RECOMMENDED FORMS--')
898      CALL DPWRST('XXX','BUG ')
899      WRITE(ICOUT,1114)
900 1114 FORMAT('         DIMENSION 1000 OBSERVATIONS')
901      CALL DPWRST('XXX','BUG ')
902      WRITE(ICOUT,1115)
903 1115 FORMAT('         DIMENSION 10 VARIABLES')
904      CALL DPWRST('XXX','BUG ')
905      WRITE(ICOUT,1121)
906 1121 FORMAT('      OTHER ALLOWABLE FORMS--')
907      CALL DPWRST('XXX','BUG ')
908      WRITE(ICOUT,1122)
909 1122 FORMAT('         DIMENSION 1000 ROWS')
910      CALL DPWRST('XXX','BUG ')
911      WRITE(ICOUT,1123)
912 1123 FORMAT('         DIMENSION 10 COLUMNS')
913      CALL DPWRST('XXX','BUG ')
914      WRITE(ICOUT,1124)
915 1124 FORMAT('         DIMENSION 1000 OBSERVATIONS 10 VARIABLES')
916      CALL DPWRST('XXX','BUG ')
917      WRITE(ICOUT,1125)
918 1125 FORMAT('         DIMENSION 10 VARIABLES 1000 OBSERVATIONS')
919      CALL DPWRST('XXX','BUG ')
920      WRITE(ICOUT,1126)
921 1126 FORMAT('         DIMENSION 1000 ROWS 10 COLUMNS')
922      CALL DPWRST('XXX','BUG ')
923      WRITE(ICOUT,1127)
924 1127 FORMAT('         DIMENSION 10 COLUMNS 1000 ROWS')
925      CALL DPWRST('XXX','BUG ')
926      WRITE(ICOUT,1128)
927 1128 FORMAT('         DIMENSION 1000 10')
928      CALL DPWRST('XXX','BUG ')
929      IERROR='YES'
930      GOTO9000
931C
932 1130 CONTINUE
933      ITEMPR=IDEMXN
934      ITEMPC=IDEMXC
935      GOTO1190
936C
937 1140 CONTINUE
938      ITEMPR=IARG(1)
939      ITEMPC=IARG(2)
940      GOTO1190
941C
942 1150 CONTINUE
943      IF(IHARG(2).EQ.'ROW')GOTO1151
944      IF(IHARG(2).EQ.'ROWS')GOTO1151
945      IF(IHARG(2).EQ.'LINE')GOTO1151
946      IF(IHARG(2).EQ.'OBSE')GOTO1151
947      IF(IHARG(2).EQ.'COLU')GOTO1152
948      IF(IHARG(2).EQ.'VARI')GOTO1152
949      GOTO1151
950 1151 CONTINUE
951      ITEMPR=IARG(1)
952      IF(ITEMPR.LE.1)ITEMPR=1
953      ITEMPC=MAXNK/ITEMPR
954      GOTO1190
955 1152 CONTINUE
956      ITEMPC=IARG(1)
957      IF(ITEMPC.LE.1)ITEMPC=1
958      ITEMPR=MAXNK/ITEMPC
959      GOTO1190
960C
961 1160 CONTINUE
962      IF(IHARG(2).EQ.'ROW')GOTO1161
963      IF(IHARG(2).EQ.'ROWS')GOTO1161
964      IF(IHARG(2).EQ.'LINE')GOTO1161
965      IF(IHARG(2).EQ.'OBSE')GOTO1161
966      IF(IHARG(2).EQ.'COLU')GOTO1162
967      IF(IHARG(2).EQ.'VARI')GOTO1162
968CCCCC THE FOLLOWING LINE WAS ADDED JULY 1989
969      IF(IHARG(2).EQ.'FACT')GOTO1162
970      GOTO1161
971 1161 CONTINUE
972      ITEMPR=IARG(1)
973      ITEMPC=IARG(3)
974      GOTO1190
975 1162 CONTINUE
976      ITEMPC=IARG(1)
977      ITEMPR=IARG(3)
978      GOTO1190
979C
980 1190 CONTINUE
981      ITEMRC=ITEMPR*ITEMPC
982C
983C               *************************************
984C               **  STEP 12--                      **
985C               **  DETERMINE IF THE SPECIFIED     **
986C               **  OBSERVATIONS(= ROW) DIMENSION  **
987C               **  IS TOO SMALL OR LARGE.         **
988C               *************************************
989C
990      IF(MINR.LE.ITEMPR.AND.ITEMPR.LE.MAXR)GOTO1290
991      WRITE(ICOUT,999)
992      CALL DPWRST('XXX','BUG ')
993      WRITE(ICOUT,1211)
994 1211 FORMAT('***** ERROR IN DPDIME--')
995      CALL DPWRST('XXX','BUG ')
996      WRITE(ICOUT,1212)
997 1212 FORMAT('      THE OBSERVATIONS (= ROW) DIMENSION')
998      CALL DPWRST('XXX','BUG ')
999      IF(ITEMPR.LT.MINR)
1000     1WRITE(ICOUT,1213)
1001 1213 FORMAT('      IS TOO SMALL.')
1002      IF(ITEMPR.LT.MINR)
1003     1CALL DPWRST('XXX','BUG ')
1004      IF(ITEMPR.GT.MAXR)
1005     1WRITE(ICOUT,1214)
1006 1214 FORMAT('      IS TOO LARGE.')
1007      IF(ITEMPR.GT.MAXR)
1008     1CALL DPWRST('XXX','BUG ')
1009      WRITE(ICOUT,1215)MINR,MAXR
1010 1215 FORMAT('      IT MUST BE BETWEEN ',I8,' & ',I8,' (INCLUSIVE)')
1011      CALL DPWRST('XXX','BUG ')
1012      WRITE(ICOUT,1216)ITEMPR
1013 1216 FORMAT('      THE SPECIFIED VALUE IS ',I8)
1014      CALL DPWRST('XXX','BUG ')
1015      WRITE(ICOUT,1217)
1016 1217 FORMAT('      NO REDIMENSIONING WAS CARRIED OUT.')
1017      CALL DPWRST('XXX','BUG ')
1018      IERROR='YES'
1019      GOTO9000
1020 1290 CONTINUE
1021C
1022C               *************************************
1023C               **  STEP 13--                      **
1024C               **  DETERMINE IF THE SPECIFIED     **
1025C               **  VARIABLES(= COLUMN) DIMENSION  **
1026C               **  IS TOO LARGE.                  **
1027C               *************************************
1028C
1029      IF(MINC.LE.ITEMPC.AND.ITEMPC.LE.MAXC)GOTO1390
1030      WRITE(ICOUT,999)
1031      CALL DPWRST('XXX','BUG ')
1032      WRITE(ICOUT,1311)
1033 1311 FORMAT('***** ERROR IN DPDIME--')
1034      CALL DPWRST('XXX','BUG ')
1035      WRITE(ICOUT,1312)
1036 1312 FORMAT('      THE VARIABLES (= COLUMN) DIMENSION')
1037      CALL DPWRST('XXX','BUG ')
1038      IF(ITEMPC.LT.MINC)
1039     1WRITE(ICOUT,1313)
1040 1313 FORMAT('      IS TOO SMALL.')
1041      IF(ITEMPC.LT.MINC)
1042     1CALL DPWRST('XXX','BUG ')
1043      IF(ITEMPC.GT.MAXC)
1044     1WRITE(ICOUT,1314)
1045 1314 FORMAT('      IS TOO LARGE.')
1046      IF(ITEMPC.GT.MAXC)
1047     1CALL DPWRST('XXX','BUG ')
1048      WRITE(ICOUT,1315)MINC,MAXC
1049 1315 FORMAT('      IT MUST BE BETWEEN ',I8,' & ',I8,' (INCLUSIVE)')
1050      CALL DPWRST('XXX','BUG ')
1051      WRITE(ICOUT,1316)ITEMPC
1052 1316 FORMAT('      THE SPECIFIED VALUE IS ',I8)
1053      CALL DPWRST('XXX','BUG ')
1054      WRITE(ICOUT,1317)
1055 1317 FORMAT('      NO REDIMENSIONING WAS CARRIED OUT.')
1056      CALL DPWRST('XXX','BUG ')
1057      IERROR='YES'
1058      GOTO9000
1059 1390 CONTINUE
1060C
1061C               *************************************
1062C               **  STEP 14--                      **
1063C               **  DETERMINE IF THE COMBINED     **
1064C               **  DIMENSION (= ROW X COLUMN)    **
1065C               **  IS TOO LARGE.                  **
1066C               *************************************
1067C
1068      IF(MINRC.LE.ITEMRC.AND.ITEMRC.LE.MAXRC)GOTO1490
1069      WRITE(ICOUT,999)
1070      CALL DPWRST('XXX','BUG ')
1071      WRITE(ICOUT,1411)
1072 1411 FORMAT('***** ERROR IN DPDIME--')
1073      CALL DPWRST('XXX','BUG ')
1074      WRITE(ICOUT,1412)
1075 1412 FORMAT('      THE JOINT ROW AND COLUMN DIMENSIONS')
1076      CALL DPWRST('XXX','BUG ')
1077      IF(ITEMRC.LT.MINRC)
1078     1WRITE(ICOUT,1413)
1079 1413 FORMAT('      IS TOO SMALL.')
1080      IF(ITEMRC.LT.MINRC)
1081     1CALL DPWRST('XXX','BUG ')
1082      IF(ITEMRC.GT.MAXRC)
1083     1WRITE(ICOUT,1414)
1084 1414 FORMAT('      IS TOO LARGE.')
1085      IF(ITEMRC.GT.MAXRC)
1086     1CALL DPWRST('XXX','BUG ')
1087      WRITE(ICOUT,1415)
1088 1415 FORMAT('      THEIR PRODUCT MUST')
1089      CALL DPWRST('XXX','BUG ')
1090      WRITE(ICOUT,1416)MINRC,MAXRC
1091 1416 FORMAT('      BE BETWEEN ',I8,' & ',I8,' (INCLUSIVE)')
1092      CALL DPWRST('XXX','BUG ')
1093      WRITE(ICOUT,1417)ITEMRC
1094 1417 FORMAT('      THEIR PRODUCT IS ',I8)
1095      CALL DPWRST('XXX','BUG ')
1096      WRITE(ICOUT,1418)
1097 1418 FORMAT('      NO REDIMENSIONING WAS CARRIED OUT.')
1098      CALL DPWRST('XXX','BUG ')
1099      IERROR='YES'
1100      GOTO9000
1101 1490 CONTINUE
1102C
1103C               *****************************
1104C               **  STEP 15--              **
1105C               **  SET THE DIMENSIONS     **
1106C               **  TO THE DESIRED VALUES  **
1107C               *****************************
1108C
1109      MAXNOL=MAXN
1110      MAXN=ITEMPR
1111      MAXCOL=ITEMPC
1112      MAXNNE=MAXN
1113C
1114CCCCC THE FOLLOWING 6 LINES WERE ADDED JULY 1989
1115      MAXCP1=MAXCOL+1
1116      MAXCP2=MAXCOL+2
1117      MAXCP3=MAXCOL+3
1118      MAXCP4=MAXCOL+4
1119      MAXCP5=MAXCOL+5
1120      MAXCP6=MAXCOL+6
1121C
1122C               ********************************
1123C               **  STEP 16--                 **
1124C               **  PRINT OUT THE DIMENSIONS  **
1125C               ********************************
1126C
1127      IF(IFEEDB.EQ.'OFF')GOTO1619
1128      WRITE(ICOUT,999)
1129      CALL DPWRST('XXX','BUG ')
1130      WRITE(ICOUT,1613)
1131 1613 FORMAT('DIMENSION INFORMATION--')
1132      CALL DPWRST('XXX','BUG ')
1133      WRITE(ICOUT,1614)MAXNK
1134 1614 FORMAT('          MAXIMUM DATA ARRAY SIZE            = ',I8)
1135      CALL DPWRST('XXX','BUG ')
1136      WRITE(ICOUT,1615)MAXN
1137 1615 FORMAT('          MAXIMUM NUMBER OBS/VARIABLE (ROWS) = ',I8)
1138      CALL DPWRST('XXX','BUG ')
1139      WRITE(ICOUT,1616)MAXCOL
1140 1616 FORMAT('          MAXIMUM NUMBER VARIABLES (COLUMNS) = ',I8)
1141      CALL DPWRST('XXX','BUG ')
1142 1619 CONTINUE
1143C
1144      IH='MAXR'
1145      IH2='OWS '
1146      VALUE0=MAXN
1147      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
1148     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
1149     1IANS,IWIDTH,IBUGS2,IERROR)
1150C
1151      IH='MAXC'
1152      IH2='OLS '
1153      VALUE0=MAXCOL
1154      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
1155     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
1156     1IANS,IWIDTH,IBUGS2,IERROR)
1157C
1158C
1159C               *************************************
1160C               **  STEP 13--                      **
1161C               **  DETERMINE IF ANY OBSERVATIONS  **
1162C               **  NEED TO BE TRUNCATED           **
1163C               *************************************
1164C
1165      ITRUND='NO'
1166C
1167CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   OCTOBER 1991
1168CCCCC WRITE(ICOUT,999)
1169CCCCC CALL DPWRST('XXX','BUG ')
1170      IF(IBUGS2.EQ.'OFF')GOTO2009
1171CCCCC THE FOLLOWING LINE WAS ADDED   OCTOBER 1991
1172      WRITE(ICOUT,999)
1173      CALL DPWRST('XXX','BUG ')
1174      WRITE(ICOUT,2001)
1175 2001 FORMAT('FROM THE MIDDLE OF DPDIME--')
1176      CALL DPWRST('XXX','BUG ')
1177      WRITE(ICOUT,2002)NUMCOL,NUMNAM,IBUGS2
1178 2002 FORMAT('NUMCOL,NUMNAM,IBUGS2 = ',I8,I8,2X,A4)
1179      CALL DPWRST('XXX','BUG ')
1180 2009 CONTINUE
1181C
1182      IF(NUMCOL.LE.0)GOTO2190
1183      DO2100ICOL=1,NUMCOL
1184      ICOLTG=ICOL
1185      IF(MAXNNE.GT.MAXNOL)ICOLTG=NUMCOL-ICOL+1
1186      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,999)
1187      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
1188      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,2101)MAXNNE,MAXNOL,ICOL,ICOLTG
1189 2101 FORMAT('MAXNNE,MAXNOL,ICOL,ICOLTG               = ',4I8)
1190      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
1191C
1192      IDONE='NO'
1193      IF(NUMNAM.LE.0)GOTO2190
1194      DO2200INAM=1,NUMNAM
1195      IF(IVALUE(INAM).EQ.ICOLTG.AND.IUSE(INAM).EQ.'V')GOTO2210
1196      GOTO2200
1197 2210 CONTINUE
1198C
1199      IF(IDONE.EQ.'YES')GOTO2390
1200      NOLD=IN(INAM)
1201      IV1OLD=IVSTAR(INAM)
1202      IV2OLD=IVSTOP(INAM)
1203C
1204      IF(NOLD.LE.MAXNNE)NNEW=NOLD
1205      IF(NOLD.GT.MAXNNE)NNEW=MAXNNE
1206      IF(NOLD.LE.MAXNNE)GOTO2219
1207      IF(IFEEDB.EQ.'OFF')GOTO2218
1208      WRITE(ICOUT,2211)IHNAME(INAM),IHNAM2(INAM),ICOLTG
1209 2211 FORMAT('    NOTE--VARIABLE ',A4,A4,'  (COLUMN ',I8,')')
1210      CALL DPWRST('XXX','BUG ')
1211      WRITE(ICOUT,2212)NOLD,MAXNNE
1212 2212 FORMAT('          TRUNCATED FROM ',I8,' TO ',I8,
1213     1' OBSERVATIONS')
1214      CALL DPWRST('XXX','BUG ')
1215      WRITE(ICOUT,2213)
1216 2213 FORMAT('          IN THE PROCESS OF  REDIMENSIONING')
1217      CALL DPWRST('XXX','BUG ')
1218 2218 CONTINUE
1219      ITRUND='YES'
1220 2219 CONTINUE
1221C
1222      IV1NEW=MAXNNE*(ICOLTG-1)+1
1223      IV2NEW=MAXNNE*(ICOLTG-1)+NNEW
1224      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,2221)NOLD,MAXNNE,NNEW
1225 2221 FORMAT('NOLD,MAXNNE,NNEW                        = ',3I8)
1226      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
1227      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,2222)IV1OLD,IV2OLD,IV1NEW,IV2NEW
1228 2222 FORMAT('IV1OLD,IV2OLD,IV1NEW,IV2NEW             = ',4I8)
1229      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
1230C
1231      J=IV1OLD-1
1232      IF(IV1NEW.GT.IV1OLD)GOTO2390
1233      DO2300I=IV1NEW,IV2NEW
1234      J=J+1
1235      V(I)=V(J)
1236 2300 CONTINUE
1237      IDONE='YES'
1238 2390 CONTINUE
1239C
1240      IVSTAR(INAM)=IV1NEW
1241      IVSTOP(INAM)=IV2NEW
1242      IN(INAM)=NNEW
1243      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,2391)INAM,IVSTAR(INAM),IVSTOP(INAM),
1244     1IN(INAM)
1245 2391 FORMAT('INAM,IVSTAR(INAM),IVSTOP(INAM),IN(INAM) = ',4I8)
1246      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
1247 2200 CONTINUE
1248C
1249 2100 CONTINUE
1250 2190 CONTINUE
1251C
1252      IF(ITRUND.EQ.'YES')GOTO2199
1253      IF(IFEEDB.EQ.'OFF')GOTO2199
1254      WRITE(ICOUT,2191)
1255 2191 FORMAT('    NOTE--NO DATA TRUNCATION OCCURRED FOR ANY ',
1256     1'VARIABLES')
1257      CALL DPWRST('XXX','BUG ')
1258      WRITE(ICOUT,2192)
1259 2192 FORMAT('          (COLUMNS) IN THE PROCESS OF REDIMENSIONING')
1260      CALL DPWRST('XXX','BUG ')
1261 2199 CONTINUE
1262C
1263C               **********************************
1264C               **  STEP 14--                   **
1265C               **  DETERMINE IF ANY VARIABLES  **
1266C               **  NEED TO BE TRUNCRATED       **
1267C               **********************************
1268C
1269      ITRUNV='NO'
1270C
1271      IF(NUMCOL.LE.MAXCOL)GOTO3190
1272      NUMCOL=MAXCOL
1273      IDONE='NO'
1274C
1275      IF(NUMNAM.LE.0)GOTO3190
1276      INAM=0
1277      INAM=INAM+1
1278      IF(INAM.GT.NUMNAM)GOTO3200
1279      IF(IUSE(INAM).EQ.'V'.AND.IVALUE(INAM).GT.MAXCOL)GOTO3210
1280      GOTO3200
1281C
1282 3210 CONTINUE
1283      NUMNAM=NUMNAM-1
1284      ICOLV=IVALUE(INAM)
1285      IF(IFEEDB.EQ.'OFF')GOTO3219
1286      WRITE(ICOUT,3211)IHNAME(INAM),IHNAM2(INAM),ICOLV
1287 3211 FORMAT('    NOTE--VARIABLE ',A4,A4,'  (COLUMN ',I8,')')
1288      CALL DPWRST('XXX','BUG ')
1289      WRITE(ICOUT,3212)
1290 3212 FORMAT('          DELETED IN THE PROCESS OF  REDIMENSIONING')
1291      CALL DPWRST('XXX','BUG ')
1292 3219 CONTINUE
1293      ITRUNV='YES'
1294C
1295      NUMNM1=NUMNAM-1
1296      IF(INAM.GT.NUMNM1)GOTO3229
1297      DO3220I=INAM,NUMNM1
1298      IP1=I+1
1299      IHNAME(I)=IHNAME(IP1)
1300      IHNAM2(I)=IHNAM2(IP1)
1301      IUSE(I)=IUSE(IP1)
1302      IN(I)=IN(IP1)
1303      IVSTAR(I)=IVSTAR(IP1)
1304      IVSTOP(I)=IVSTOP(IP1)
1305      IVALUE(I)=IVALUE(IP1)
1306      VALUE(I)=VALUE(IP1)
1307 3220 CONTINUE
1308 3229 CONTINUE
1309      NUMNAM=NUMNAM-1
1310C
1311 3200 CONTINUE
1312C
1313 3190 CONTINUE
1314C
1315      IF(ITRUNV.EQ.'YES')GOTO3199
1316      IF(IFEEDB.EQ.'OFF')GOTO3199
1317      WRITE(ICOUT,3191)
1318 3191 FORMAT('    NOTE--NO VARIABLES WERE DELETED')
1319      CALL DPWRST('XXX','BUG ')
1320      WRITE(ICOUT,3192)
1321 3192 FORMAT('          IN THE PROCESS OF REDIMENSIONING')
1322      CALL DPWRST('XXX','BUG ')
1323 3199 CONTINUE
1324C
1325C               ***************************************
1326C               **  STEP 15--                        **
1327C               **  REDEFINE THE COLUMN DESIGNATION  **
1328C               **  FOR PRED (PREDICTED VALUE)       **
1329C               **      RES (RESIDUALS)              **
1330C               **      YPLOT                        **
1331C               **      XPLOT                        **
1332C               **      X2PLOT                       **
1333C               **      TAGPLOT                      **
1334C               ***************************************
1335C
1336      IF(NUMNAM.LE.0)GOTO4900
1337C
1338      DO4100I=1,NUMNAM
1339      I2=I
1340      IF(IHNAME(I).EQ.'PRED'.AND.IHNAM2(I).EQ.'    ')GOTO4150
1341 4100 CONTINUE
1342      GOTO4190
1343 4150 CONTINUE
1344      IVALUE(I2)=MAXCOL+1
1345      VALUE(I2)=IVALUE(I2)
1346      GOTO4190
1347 4190 CONTINUE
1348C
1349      DO4200I=1,NUMNAM
1350      I2=I
1351      IF(IHNAME(I).EQ.'RES '.AND.IHNAM2(I).EQ.'    ')GOTO4250
1352 4200 CONTINUE
1353      GOTO4290
1354 4250 CONTINUE
1355      IVALUE(I2)=MAXCOL+2
1356      VALUE(I2)=IVALUE(I2)
1357      GOTO4290
1358 4290 CONTINUE
1359C
1360      DO4300I=1,NUMNAM
1361      I2=I
1362      IF(IHNAME(I).EQ.'YPLO'.AND.IHNAM2(I).EQ.'T   ')GOTO4350
1363 4300 CONTINUE
1364      GOTO4390
1365 4350 CONTINUE
1366      IVALUE(I2)=MAXCOL+3
1367      VALUE(I2)=IVALUE(I2)
1368      GOTO4390
1369 4390 CONTINUE
1370C
1371      DO4400I=1,NUMNAM
1372      I2=I
1373      IF(IHNAME(I).EQ.'XPLO'.AND.IHNAM2(I).EQ.'T   ')GOTO4450
1374 4400 CONTINUE
1375      GOTO4490
1376 4450 CONTINUE
1377      IVALUE(I2)=MAXCOL+4
1378      VALUE(I2)=IVALUE(I2)
1379      GOTO4490
1380 4490 CONTINUE
1381C
1382      DO4500I=1,NUMNAM
1383      I2=I
1384      IF(IHNAME(I).EQ.'X2PL'.AND.IHNAM2(I).EQ.'OT  ')GOTO4550
1385 4500 CONTINUE
1386      GOTO4590
1387 4550 CONTINUE
1388      IVALUE(I2)=MAXCOL+5
1389      VALUE(I2)=IVALUE(I2)
1390      GOTO4590
1391 4590 CONTINUE
1392C
1393      DO4600I=1,NUMNAM
1394      I2=I
1395      IF(IHNAME(I).EQ.'TAGP'.AND.IHNAM2(I).EQ.'LOT ')GOTO4650
1396 4600 CONTINUE
1397      GOTO4690
1398 4650 CONTINUE
1399      IVALUE(I2)=MAXCOL+6
1400      VALUE(I2)=IVALUE(I2)
1401      GOTO4690
1402 4690 CONTINUE
1403C
1404 4900 CONTINUE
1405C
1406C               *****************
1407C               **  STEP 90--  **
1408C               **  EXIT.      **
1409C               *****************
1410C
1411 9000 CONTINUE
1412      IF(IBUGS2.EQ.'OFF')GOTO9090
1413      WRITE(ICOUT,999)
1414      CALL DPWRST('XXX','BUG ')
1415      WRITE(ICOUT,9011)
1416 9011 FORMAT('AT THE END       OF DPDIME--')
1417      CALL DPWRST('XXX','BUG ')
1418      WRITE(ICOUT,9012)IBUGS2
1419 9012 FORMAT('IBUGS2 = ',A4)
1420      CALL DPWRST('XXX','BUG ')
1421      WRITE(ICOUT,9013)NUMNAM,MAXNAM
1422 9013 FORMAT('NUMNAM,MAXNAM = ',2I8)
1423      CALL DPWRST('XXX','BUG ')
1424      WRITE(ICOUT,9014)MAXNK
1425 9014 FORMAT('MAXNK = ',I8)
1426      CALL DPWRST('XXX','BUG ')
1427      WRITE(ICOUT,9015)NUMN,MAXN,MAXNXT
1428 9015 FORMAT('NUMN,MAXN,MAXNXT = ',3I8)
1429      CALL DPWRST('XXX','BUG ')
1430      WRITE(ICOUT,9016)NUMCOL,MAXCOL
1431 9016 FORMAT('NUMCOL,MAXCOL = ',2I8)
1432      CALL DPWRST('XXX','BUG ')
1433      WRITE(ICOUT,9017)MINR,MAXR,MINC,MAXC,MINRC,MAXRC
1434 9017 FORMAT('MINR,MAXR,MINC,MAXC,MINRC,MAXRC = ',6I8)
1435      CALL DPWRST('XXX','BUG ')
1436      WRITE(ICOUT,9018)ITEMPR,ITEMPC,ITEMRC
1437 9018 FORMAT('ITEMPR,ITEMPC,ITEMRC = ',3I8)
1438      CALL DPWRST('XXX','BUG ')
1439      WRITE(ICOUT,9021)
1440 9021 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),',
1441     1'IVSTAR(I),IVSTOP(I),IVALUE(I),VALUE(I)')
1442      CALL DPWRST('XXX','BUG ')
1443      IF(NUMNAM.LE.0)GOTO9024
1444      DO9022I=1,NUMNAM
1445      WRITE(ICOUT,9023)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),
1446     1IVSTAR(I),IVSTOP(I),IVALUE(I),VALUE(I)
1447 9023 FORMAT(I8,2X,A4,2X,A4,2X,A4,4I8,E15.7)
1448      CALL DPWRST('XXX','BUG ')
1449 9022 CONTINUE
1450 9024 CONTINUE
1451 9090 CONTINUE
1452C
1453      RETURN
1454      END
1455      SUBROUTINE DPDIRE(ICOM,IHARG,NUMARG,IDEFDI,ITEXDI,
1456     1                  IBUGD2,ISUBRO,IFOUND,IERROR)
1457C
1458C     PURPOSE--DEFINE THE DIRECTION (HORIZONTAL OR VERTICAL) TYPE FOR
1459C              THE TEXT COMMAND.  THE DIRECTION (HORIZONTAL OR VERTICAL)
1460C              FOR THE SCRIPT WILL BE PLACED IN THE CHARACTER VARIABLE
1461C              ITEXDI.
1462C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
1463C                     --NUMARG
1464C                     --IDEFDI
1465C                     --IBUGD2
1466C     OUTPUT ARGUMENTS--ITEXDI
1467C                     --IFOUND ('YES' OR 'NO' )
1468C                     --IERROR ('YES' OR 'NO' )
1469C     WRITTEN BY--JAMES J. FILLIBEN
1470C                 STATISTICAL ENGINEERING DIVISION
1471C                 INFORMATION TECHNOLOGY LABORATORY
1472C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1473C                 GAITHERSBURG, MD 20899-8980
1474C                 PHONE--301-975-2899
1475C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1476C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1477C     LANGUAGE--ANSI FORTRAN (1977)
1478C     VERSION NUMBER--2009/4
1479C     ORIGINAL VERSION--APRIL     2009.
1480C
1481C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1482C
1483      CHARACTER*4 ICOM
1484      CHARACTER*4 IHARG
1485      CHARACTER*4 IDEFDI
1486      CHARACTER*4 ITEXDI
1487      CHARACTER*4 IBUGD2
1488      CHARACTER*4 ISUBRO
1489      CHARACTER*4 IFOUND
1490      CHARACTER*4 IERROR
1491C
1492C---------------------------------------------------------------------
1493C
1494      DIMENSION IHARG(*)
1495C
1496C---------------------------------------------------------------------
1497C
1498      INCLUDE 'DPCOP2.INC'
1499C
1500C-----START POINT-----------------------------------------------------
1501C
1502      IFOUND='NO'
1503      IERROR='NO'
1504C
1505      IF(IBUGD2.EQ.'ON' .OR. ISUBRO.EQ.'DIRE')THEN
1506        WRITE(ICOUT,999)
1507  999   FORMAT(1X)
1508        CALL DPWRST('XXX','BUG ')
1509        WRITE(ICOUT,51)
1510   51   FORMAT('***** AT THE BEGINNING OF DPDIRE--')
1511        CALL DPWRST('XXX','BUG ')
1512        WRITE(ICOUT,53)ICOM,NUMARG,IDEFDI
1513   53   FORMAT('ICOM,NUMARG,IDEFDI = ',A4,2X,I8,2X,A4)
1514        CALL DPWRST('XXX','BUG ')
1515        DO55I=1,NUMARG
1516          WRITE(ICOUT,56)I,IHARG(I)
1517   56     FORMAT('I,IHARG(I) = ',I8,2X,A4)
1518          CALL DPWRST('XXX','BUG ')
1519   55   CONTINUE
1520      ENDIF
1521C
1522C               ************************************************
1523C               **  TREAT THE CASE (UPPER VERSUS LOWER) CASE  **
1524C               ************************************************
1525C
1526      IF(ICOM.EQ.'DIRE')THEN
1527        IF(NUMARG.LE.0)GOTO1161
1528        IF(IHARG(NUMARG).EQ.'ON')GOTO1161
1529        IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
1530        IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
1531        IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
1532        IF(IHARG(NUMARG).EQ.'HORI')GOTO1161
1533        IF(IHARG(NUMARG).EQ.'VERT')GOTO1162
1534        IF(IHARG(NUMARG).EQ.'?')GOTO8100
1535        IF(IHARG(NUMARG).EQ.'HELP')GOTO8100
1536        GOTO1170
1537      ELSEIF(ICOM.EQ.'HORI')THEN
1538        IF(NUMARG.LE.0)GOTO9000
1539        IF(NUMARG.LE.0)GOTO1161
1540        IF(IHARG(NUMARG).EQ.'DIRE')GOTO1161
1541        IF(IHARG(NUMARG).EQ.'ON')GOTO1161
1542        IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
1543        IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
1544        IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
1545      ELSEIF(ICOM.EQ.'VERT')THEN
1546        IF(NUMARG.LE.0)GOTO9000
1547        IF(IHARG(1).NE.'CASE')GOTO9000
1548        IF(NUMARG.LE.1)GOTO1162
1549        IF(IHARG(NUMARG).EQ.'ON')GOTO1162
1550        IF(IHARG(NUMARG).EQ.'OFF')GOTO1161
1551        IF(IHARG(NUMARG).EQ.'AUTO')GOTO1162
1552        IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
1553      ENDIF
1554      GOTO9000
1555C
1556 1161 CONTINUE
1557      ITEXDI='HORI'
1558      GOTO1180
1559C
1560 1162 CONTINUE
1561      ITEXDI='VERT'
1562      GOTO1180
1563C
1564 1165 CONTINUE
1565      ITEXDI=IDEFDI
1566      GOTO1180
1567C
1568 1170 CONTINUE
1569      IERROR='YES'
1570      WRITE(ICOUT,1171)
1571 1171 FORMAT('***** ERROR IN DIRECTION COMMAND--')
1572      CALL DPWRST('XXX','BUG ')
1573      WRITE(ICOUT,1172)
1574 1172 FORMAT('      UNKNOWN ENTRY FOR DIRECTION COMMAND. THE DIRECTION')
1575      CALL DPWRST('XXX','BUG ')
1576      WRITE(ICOUT,1173)
1577 1173 FORMAT('      SHOULD BE EITHER HORIZONTAL OR VERTICAL.  FOR ',
1578     1       'EXAMPLE:')
1579      CALL DPWRST('XXX','BUG ')
1580      WRITE(ICOUT,1177)
1581 1177 FORMAT('           DIRECTION HORIZONTAL')
1582      CALL DPWRST('XXX','BUG ')
1583      WRITE(ICOUT,1178)
1584 1178 FORMAT('           DIRECTION VERTICAL')
1585      CALL DPWRST('XXX','BUG ')
1586      GOTO9000
1587C
1588 1180 CONTINUE
1589      IFOUND='YES'
1590C
1591      IF(IFEEDB.EQ.'ON')THEN
1592        WRITE(ICOUT,999)
1593        CALL DPWRST('XXX','BUG ')
1594        WRITE(ICOUT,1181)
1595 1181   FORMAT('THE CASE (FOR PLOT SCRIPT AND TEXT) ')
1596        CALL DPWRST('XXX','BUG ')
1597        WRITE(ICOUT,1182)ITEXDI
1598 1182   FORMAT('HAS JUST BEEN SET TO ',A4)
1599        CALL DPWRST('XXX','BUG ')
1600      ENDIF
1601      GOTO9000
1602C
1603C               ********************************************
1604C               **  STEP 81--                             **
1605C               **  TREAT THE    ?    CASE--              **
1606C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
1607C               ********************************************
1608C
1609 8100 CONTINUE
1610      IFOUND='YES'
1611      WRITE(ICOUT,999)
1612      CALL DPWRST('XXX','BUG ')
1613      WRITE(ICOUT,8111)ITEXDI
1614 8111 FORMAT('THE CURRENT DIRECTION IS ',A4)
1615      CALL DPWRST('XXX','BUG ')
1616      WRITE(ICOUT,8112)IDEFDI
1617 8112 FORMAT('THE DEFAULT DIRECTION IS ',A4)
1618      CALL DPWRST('XXX','BUG ')
1619      GOTO9000
1620C
1621C               *****************
1622C               **  STEP 90--  **
1623C               **  EXIT       **
1624C               *****************
1625C
1626 9000 CONTINUE
1627      IF(IBUGD2.EQ.'ON' .OR. ISUBRO.EQ.'DIRE')THEN
1628        WRITE(ICOUT,999)
1629        CALL DPWRST('XXX','BUG ')
1630        WRITE(ICOUT,9011)
1631 9011   FORMAT('***** AT THE END       OF DPDIRE--')
1632        CALL DPWRST('XXX','BUG ')
1633        WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
1634 9012   FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
1635        CALL DPWRST('XXX','BUG ')
1636        WRITE(ICOUT,9013)ITEXDI,IDEFDI
1637 9013   FORMAT('ITEXDI,IDEFDI = ',A4,2X,A4)
1638        CALL DPWRST('XXX','BUG ')
1639      ENDIF
1640C
1641      RETURN
1642      END
1643      SUBROUTINE DPDIXO(XTEMP1,MAXNXT,
1644     1                  ICAPSW,ICASAN,IFORSW,ISEED,
1645     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
1646C
1647C     PURPOSE--PERFORM DIXON TEST FOR UNIVARIATE OUTLIERS (DIXON
1648C              TEST LOOKS FOR A SINGLE OUTLIER AND ASSUMES THE
1649C              DATA FOLLOWS AN APPROXIMATELY NORMAL DISRIBUTION).
1650C     WRITTEN BY--ALAN HECKERT
1651C                 STATISTICAL ENGINEERING DIVISION
1652C                 INFORMATION TECHNOLOGY LABORAOTRY
1653C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
1654C                 GAITHERSBURG, MD 20899-8980
1655C                 PHONE--301-975-2899
1656C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1657C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
1658C     LANGUAGE--ANSI FORTRAN (1977)
1659C     VERSION NUMBER--2009/11
1660C     ORIGINAL VERSION--NOVEMBER  2009.
1661C     UPDATED         --JULY      2019. TWEAK SCRATCH STORAGE
1662C
1663C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1664C
1665      CHARACTER*4 ICASAN
1666      CHARACTER*4 ICAPSW
1667      CHARACTER*4 IFORSW
1668      CHARACTER*4 IBUGA2
1669      CHARACTER*4 IBUGA3
1670      CHARACTER*4 IBUGQ
1671      CHARACTER*4 ISUBRO
1672      CHARACTER*4 IFOUND
1673      CHARACTER*4 IERROR
1674C
1675      CHARACTER*4 IWRITE
1676      CHARACTER*4 ICASP2
1677      CHARACTER*4 IRANSV
1678      CHARACTER*4 IDATSW
1679      CHARACTER*4 ISUBN1
1680      CHARACTER*4 ISUBN2
1681      CHARACTER*4 ISTEPN
1682C
1683      CHARACTER*4 IFLAGU
1684      LOGICAL IFRST
1685      LOGICAL ILAST
1686C
1687      CHARACTER*4 IREPL
1688      CHARACTER*4 IMULT
1689      CHARACTER*4 ICTMP1
1690      CHARACTER*4 ICTMP2
1691      CHARACTER*4 ICASE
1692      CHARACTER*4 IOP
1693C
1694      CHARACTER*40 INAME
1695      PARAMETER (MAXSPN=30)
1696      CHARACTER*4 IVARN1(MAXSPN)
1697      CHARACTER*4 IVARN2(MAXSPN)
1698      CHARACTER*4 IVARTY(MAXSPN)
1699      CHARACTER*4 IVARID(MAXSPN)
1700      CHARACTER*4 IVARI2(MAXSPN)
1701      REAL PVAR(MAXSPN)
1702      REAL PID(MAXSPN)
1703      INTEGER ILIS(MAXSPN)
1704      INTEGER NRIGHT(MAXSPN)
1705      INTEGER ICOLR(MAXSPN)
1706C
1707C---------------------------------------------------------------------
1708C
1709      INCLUDE 'DPCOPA.INC'
1710      INCLUDE 'DPCOZZ.INC'
1711C
1712      DIMENSION Y1(MAXOBV)
1713      DIMENSION X1(MAXOBV)
1714      DIMENSION XTEMP1(MAXOBV)
1715      DIMENSION XTEMP2(MAXOBV)
1716      DIMENSION XTEMP3(MAXOBV)
1717      DIMENSION YSTAT(MAXOBV)
1718      DIMENSION XIDTEM(MAXOBV)
1719      DIMENSION XIDTE2(MAXOBV)
1720      DIMENSION XIDTE3(MAXOBV)
1721      DIMENSION XIDTE4(MAXOBV)
1722      DIMENSION XIDTE5(MAXOBV)
1723      DIMENSION XIDTE6(MAXOBV)
1724      DIMENSION TEMP1(MAXOBV)
1725      DIMENSION TEMP2(MAXOBV)
1726      DIMENSION XDESGN(MAXOBV,7)
1727C
1728      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
1729      EQUIVALENCE (GARBAG(IGARB2),X1(1))
1730      EQUIVALENCE (GARBAG(IGARB4),XTEMP2(1))
1731      EQUIVALENCE (GARBAG(IGARB5),XTEMP3(1))
1732      EQUIVALENCE (GARBAG(IGARB6),TEMP1(1))
1733      EQUIVALENCE (GARBAG(IGARB7),TEMP2(1))
1734      EQUIVALENCE (GARBAG(IGARB8),XIDTEM(1))
1735      EQUIVALENCE (GARBAG(IGARB9),XIDTE2(1))
1736      EQUIVALENCE (GARBAG(IGAR10),XIDTE3(1))
1737      EQUIVALENCE (GARBAG(IGAR11),XIDTE4(1))
1738      EQUIVALENCE (GARBAG(JGAR12),XIDTE5(1))
1739      EQUIVALENCE (GARBAG(JGAR13),XIDTE6(1))
1740      EQUIVALENCE (GARBAG(JGAR14),YSTAT(1))
1741      EQUIVALENCE (GARBAG(JGAR15),XDESGN(1,1))
1742C
1743C-----COMMON----------------------------------------------------------
1744C
1745      INCLUDE 'DPCOHK.INC'
1746      INCLUDE 'DPCODA.INC'
1747      INCLUDE 'DPCOSU.INC'
1748      INCLUDE 'DPCOS2.INC'
1749      INCLUDE 'DPCOHO.INC'
1750      INCLUDE 'DPCOMC.INC'
1751      INCLUDE 'DPCOST.INC'
1752      INCLUDE 'DPCOF2.INC'
1753C
1754      COMMON/ISED/ISED1,ISED2,ISED3,ISED4,ISED5,ISED6,
1755     1            ISED7,ISED8,ISED9,ISED10,ISED11
1756C
1757C-----COMMON VARIABLES (GENERAL)--------------------------------------
1758C
1759      INCLUDE 'DPCOP2.INC'
1760C
1761C-----START POINT-----------------------------------------------------
1762C
1763      IERROR='NO'
1764      ICASAN='    '
1765      IREPL='OFF'
1766      IMULT='OFF'
1767      IRANSV=IRANAL
1768      IRANAL='FINC'
1769      ISEESV=ISEED
1770      ISEED=2503
1771      ISUBN1='DPDI'
1772      ISUBN2='XO  '
1773C
1774      MAXCP1=MAXCOL+1
1775      MAXCP2=MAXCOL+2
1776      MAXCP3=MAXCOL+3
1777      MAXCP4=MAXCOL+4
1778      MAXCP5=MAXCOL+5
1779      MAXCP6=MAXCOL+6
1780C
1781      MINN2=3
1782C
1783C               ***************************************************
1784C               **  TREAT THE GRUBB TEST                CASE     **
1785C               ***************************************************
1786C
1787      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DIXO')THEN
1788        WRITE(ICOUT,999)
1789  999   FORMAT(1X)
1790        CALL DPWRST('XXX','BUG ')
1791        WRITE(ICOUT,51)
1792   51   FORMAT('***** AT THE BEGINNING OF DPDIXO--')
1793        CALL DPWRST('XXX','BUG ')
1794        WRITE(ICOUT,52)ICASAN,MAXNXT
1795   52   FORMAT('ICASAN,MAXNXT = ',A4,2X,I8)
1796        CALL DPWRST('XXX','BUG ')
1797        WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ
1798   53   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',2(A4,2X),A4)
1799        CALL DPWRST('XXX','BUG ')
1800      ENDIF
1801C
1802C               *********************************************************
1803C               **  STEP 1--                                           **
1804C               **  EXTRACT THE COMMAND                                **
1805C               **  LOOK FOR ONE OF THE FOLLOWING COMMANDS:            **
1806C               **    1) DIXON TEST Y                                  **
1807C               **    2) DIXON TEST Y LABID                            **
1808C               **    3) MULTIPLE DIXON TEST Y1 ... YK                 **
1809C               **    4) REPLICATED DIXON TEST Y X1 ... XK             **
1810C               **    5) REPLICATED DIXON TEST Y LABID X1 ... XK       **
1811C               **       REPLICATED DIXON TEST Y X1 ... XK LABID       **
1812C               *********************************************************
1813C
1814      ISTEPN='1'
1815      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
1816     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1817C
1818      ILASTC=9999
1819      ILASTZ=9999
1820      IFOUND='NO'
1821      ICASAN='DI2S'
1822C
1823      DO100I=0,NUMARG-1
1824C
1825        IF(I.EQ.0)THEN
1826          ICTMP1=ICOM
1827          ICTMP2=IHARG(I+1)
1828        ELSE
1829          ICTMP1=IHARG(I)
1830          ICTMP2=IHARG(I+1)
1831        ENDIF
1832C
1833        IF(ICTMP1.EQ.'DIXO' .AND. ICTMP2.EQ.'TEST')THEN
1834          IFOUND='YES'
1835          ILASTC=I
1836          ILASTZ=I+1
1837        ELSEIF(ICTMP1.EQ.'DIXO')THEN
1838          IFOUND='YES'
1839          ILASTC=I
1840          ILASTZ=I
1841        ELSEIF(ICTMP1.EQ.'TEST')THEN
1842          ILASTC=I
1843          ILASTZ=MAX(ILASTZ,I)
1844        ELSEIF(ICTMP1.EQ.'MINI')THEN
1845          ICASAN='MINI'
1846          ILASTC=MIN(ILASTC,I)
1847          ILASTZ=MAX(ILASTZ,I)
1848        ELSEIF(ICTMP1.EQ.'MAXI')THEN
1849          ICASAN='MAXI'
1850          ILASTC=MIN(ILASTC,I)
1851          ILASTZ=MAX(ILASTZ,I)
1852        ELSEIF(ICTMP1.EQ.'REPL')THEN
1853          IREPL='ON'
1854          ILASTC=MIN(ILASTC,I)
1855          ILASTZ=MAX(ILASTZ,I)
1856        ELSEIF(ICTMP1.EQ.'MULT')THEN
1857          IMULT='ON'
1858          ILASTC=MIN(ILASTC,I)
1859          ILASTZ=MAX(ILASTZ,I)
1860        ENDIF
1861  100 CONTINUE
1862C
1863      ISHIFT=ILASTZ
1864      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
1865     1            IBUGA2,IERROR)
1866C
1867      IF(IFOUND.EQ.'NO')GOTO9000
1868      IF(IMULT.EQ.'ON')THEN
1869        IF(IREPL.EQ.'ON')THEN
1870          WRITE(ICOUT,999)
1871          CALL DPWRST('XXX','BUG ')
1872          WRITE(ICOUT,101)
1873  101     FORMAT('***** ERROR IN DIXON TEST--')
1874          CALL DPWRST('XXX','BUG ')
1875          WRITE(ICOUT,102)
1876  102     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
1877     1           '"REPLICATION" FOR THE DIXON TEST COMMAND.')
1878          CALL DPWRST('XXX','BUG ')
1879          IERROR='YES'
1880          GOTO9000
1881        ENDIF
1882      ENDIF
1883C
1884C               *********************************
1885C               **  STEP 4--                   **
1886C               **  EXTRACT THE VARIABLE LIST  **
1887C               *********************************
1888C
1889      ISTEPN='4'
1890      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
1891     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1892C
1893      INAME='DIXON TEST FOR OUTLIERS'
1894      MINNA=1
1895      MAXNA=100
1896      MINN2=2
1897      IFLAGE=1
1898      IF(IMULT.EQ.'ON')IFLAGE=0
1899      IFLAGM=1
1900      IF(IREPL.EQ.'ON')IFLAGM=0
1901      IFLAGP=0
1902      JMIN=1
1903      JMAX=NUMARG
1904      MINNVA=-99
1905      MAXNVA=-99
1906C
1907      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
1908     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
1909     1            JMIN,JMAX,
1910     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
1911     1            IVARN1,IVARN2,IVARTY,PVAR,
1912     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
1913     1            MINNVA,MAXNVA,
1914     1            IFLAGM,IFLAGP,
1915     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
1916      IF(IERROR.EQ.'YES')GOTO9000
1917C
1918      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')THEN
1919        WRITE(ICOUT,999)
1920        CALL DPWRST('XXX','BUG ')
1921        WRITE(ICOUT,281)
1922  281   FORMAT('***** AFTER CALL DPPARS--')
1923        CALL DPWRST('XXX','BUG ')
1924        WRITE(ICOUT,282)NQ,NUMVAR
1925  282   FORMAT('NQ,NUMVAR = ',2I8)
1926        CALL DPWRST('XXX','BUG ')
1927        IF(NUMVAR.GT.0)THEN
1928          DO285I=1,NUMVAR
1929            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
1930     1                      ICOLR(I)
1931  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
1932     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
1933            CALL DPWRST('XXX','BUG ')
1934  285     CONTINUE
1935        ENDIF
1936      ENDIF
1937C
1938C               ***********************************************
1939C               **  STEP 5--                                 **
1940C               **  DETERMINE:                               **
1941C               **  1) NUMBER OF REPLICATION VARIABLES (0-6) **
1942C               **  2) NUMBER OF RESPONSE    VARIABLES (>= 1)**
1943C               ***********************************************
1944C
1945      ISTEPN='5'
1946      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
1947     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1948C
1949      NRESP=0
1950      NREPL=0
1951      NLABID=0
1952      IF(IMULT.EQ.'ON')THEN
1953        NRESP=NUMVAR
1954      ELSEIF(IREPL.EQ.'ON')THEN
1955        NRESP=1
1956        IF(NUMVAR.EQ.2)THEN
1957          NLABID=0
1958          NREPL=1
1959        ELSE
1960          NLABID=1
1961          NREPL=NUMVAR-NRESP-NLABID
1962        ENDIF
1963        IF(NREPL.LT.1 .OR. NREPL.GT.6)THEN
1964          WRITE(ICOUT,999)
1965          CALL DPWRST('XXX','BUG ')
1966          WRITE(ICOUT,101)
1967          CALL DPWRST('XXX','BUG ')
1968          WRITE(ICOUT,511)
1969  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
1970     1           'REPLICATION VARIABLES')
1971          CALL DPWRST('XXX','BUG ')
1972          WRITE(ICOUT,513)NREPL
1973  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
1974          CALL DPWRST('XXX','BUG ')
1975          IERROR='YES'
1976          GOTO9000
1977        ENDIF
1978      ELSE
1979        NRESP=1
1980        NLABID=NUMVAR-NRESP
1981        IF(NLABID.GT.1)NLABID=1
1982      ENDIF
1983C
1984      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')THEN
1985        WRITE(ICOUT,521)NRESP,NLABID,NREPL
1986  521   FORMAT('NRESP,NLABID,NREPL = ',3I5)
1987        CALL DPWRST('XXX','BUG ')
1988      ENDIF
1989C
1990      IOP='OPEN'
1991      IFLAG1=0
1992      IFLAG2=1
1993      IFLAG3=0
1994      IFLAG4=0
1995      IFLAG5=0
1996      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
1997     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
1998     1            IBUGA3,ISUBRO,IERROR)
1999      IF(IERROR.EQ.'YES')GOTO9000
2000C
2001C
2002C               ******************************************************
2003C               **  STEP 6--                                        **
2004C               **  GENERATE THE DIXON TEST FOR THE VARIOUS CASES  **
2005C               ******************************************************
2006C
2007      ISTEPN='6'
2008      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
2009     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2010C
2011C               *****************************************
2012C               **  STEP 7A--                          **
2013C               **  CASE 1: SINGLE RESPONSE VARIABLE   **
2014C               **          WITH NO REPLICATION        **
2015C               *****************************************
2016C
2017      IF(NRESP.EQ.1 .AND. NREPL.EQ.0)THEN
2018        ISTEPN='7A'
2019        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
2020     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2021C
2022        PID(1)=CPUMIN
2023        IVARID(1)=IVARN1(1)
2024        IVARI2(1)=IVARN2(1)
2025C
2026        ICOL=1
2027        NUMVA2=1
2028        IF(NLABID.GE.1)NUMVA2=2
2029        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
2030     1              INAME,IVARN1,IVARN2,IVARTY,
2031     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
2032     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
2033     1              MAXCP4,MAXCP5,MAXCP6,
2034     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
2035     1              Y1,X1,XTEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE,
2036     1              IBUGA3,ISUBRO,IFOUND,IERROR)
2037        IF(IERROR.EQ.'YES')GOTO9000
2038C
2039C       *****************************************************
2040C       **  STEP 7B--                                      **
2041C       **  CALL DPDIX2 TO PERFORM THE DIXON TEST.         **
2042C       *****************************************************
2043C
2044C
2045        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DIXO')THEN
2046          ISTEPN='7B'
2047          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2048          WRITE(ICOUT,999)
2049          CALL DPWRST('XXX','BUG ')
2050          WRITE(ICOUT,711)
2051  711     FORMAT('***** FROM THE MIDDLE OF DPDIXO--')
2052          CALL DPWRST('XXX','BUG ')
2053          WRITE(ICOUT,712)ICASAN,NUMVAR,IDATSW,NLOCAL
2054  712     FORMAT('ICASAN,NUMVAR,IDATSW,NLOCAL = ',
2055     1           A4,I8,2X,A4,I8)
2056          CALL DPWRST('XXX','BUG ')
2057          IF(NLOCAL.GE.1)THEN
2058            DO715I=1,NLOCAL
2059              WRITE(ICOUT,716)I,Y1(I),X1(I)
2060  716         FORMAT('I,Y1(I),X1(I) = ',I8,2F12.5)
2061              CALL DPWRST('XXX','BUG ')
2062  715       CONTINUE
2063          ENDIF
2064        ENDIF
2065C
2066        NCURVE=1
2067        CALL DPDIX2(Y1,X1,NLOCAL,ICASAN,MAXOBV,
2068     1              YSTAT,XTEMP1,XTEMP2,XTEMP3,
2069     1              PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2070     1              IOUNI2,ISEED,
2071     1              ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2072     1              STATVA,STATCD,PVAL,
2073     1              CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2074     1              CUT95,CUT975,CUT99,CUT995,CUT100,
2075     1              ISUBRO,IBUGA3,IERROR)
2076C
2077C               ***************************************
2078C               **  STEP 7C--                        **
2079C               **  COMPUTE DIXON     STAT           **
2080C               **  UPDATE INTERNAL DATAPLOT TABLES  **
2081C               ***************************************
2082C
2083        ISTEPN='7C'
2084        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
2085     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2086C
2087        IFLAGU='ON'
2088        IFRST=.FALSE.
2089        ILAST=.FALSE.
2090        CALL DPGRU4(STATVA,STATCD,PVAL,
2091     1              CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,CUT99,CUT100,
2092     1              IFLAGU,IFRST,ILAST,ICASP2,
2093     1              IBUGA2,IBUGA3,ISUBRO,IERROR)
2094C
2095C               ******************************************
2096C               **  STEP 8A--                           **
2097C               **  CASE 2: MULTIPLE RESPONSE VARIABLES **
2098C               **          NOTE THAT A LABID VARIABLE  **
2099C               **          IS NOT SUPPORTED FOR THIS   **
2100C               **          CASE.                       **
2101C               ******************************************
2102C
2103      ELSEIF(NRESP.GT.1)THEN
2104        ISTEPN='8A'
2105        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
2106     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2107C
2108C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
2109C
2110        NCURVE=0
2111        DO810IRESP=1,NRESP
2112          NCURVE=NCURVE+1
2113C
2114          IINDX=ICOLR(IRESP)
2115          PID(1)=CPUMIN
2116          IVARID(1)=IVARN1(IRESP)
2117          IVARI2(1)=IVARN2(IRESP)
2118C
2119          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')THEN
2120            WRITE(ICOUT,999)
2121            CALL DPWRST('XXX','BUG ')
2122            WRITE(ICOUT,811)IRESP,NCURVE
2123  811       FORMAT('IRESP,NCURVE = ',2I5)
2124            CALL DPWRST('XXX','BUG ')
2125          ENDIF
2126C
2127          ICOL=IRESP
2128          NUMVA2=1
2129          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
2130     1                INAME,IVARN1,IVARN2,IVARTY,
2131     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
2132     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
2133     1                MAXCP4,MAXCP5,MAXCP6,
2134     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
2135     1                Y1,XTEMP1,XTEMP2,NLOCAL,NLOCA2,NLOCA3,ICASE,
2136     1                IBUGA3,ISUBRO,IFOUND,IERROR)
2137          IF(IERROR.EQ.'YES')GOTO9000
2138          DO820I=1,NLOCAL
2139            X1(I)=REAL(I)
2140  820     CONTINUE
2141C
2142C         *****************************************************
2143C         **  STEP 8B--                                      **
2144C         **  CALL DPDIX2 TO PERFORM THE DIXON TEST          **
2145C         *****************************************************
2146C
2147          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DIXO')THEN
2148            ISTEPN='8B'
2149            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2150            WRITE(ICOUT,999)
2151            CALL DPWRST('XXX','BUG ')
2152            WRITE(ICOUT,822)
2153  822       FORMAT('***** FROM THE MIDDLE  OF DPDIXO--')
2154            CALL DPWRST('XXX','BUG ')
2155            WRITE(ICOUT,823)ICASAN,NUMVAR,IDATSW,NLOCAL
2156  823       FORMAT('ICASAN,NUMVAR,IDATSW,NQ = ',
2157     1             A4,I8,2X,A4,I8)
2158            CALL DPWRST('XXX','BUG ')
2159            IF(NLOCAL.GE.1)THEN
2160              DO825I=1,NLOCAL
2161                WRITE(ICOUT,826)I,Y1(I),X1(I)
2162  826           FORMAT('I,Y1(I),X1(I) = ',I8,2F12.5)
2163                CALL DPWRST('XXX','BUG ')
2164  825         CONTINUE
2165            ENDIF
2166          ENDIF
2167C
2168          CALL DPDIX2(Y1,X1,NLOCAL,ICASAN,MAXOBV,
2169     1                YSTAT,XTEMP1,XTEMP2,XTEMP3,
2170     1                PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2171     1                IOUNI2,ISEED,
2172     1                ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2173     1                STATVA,STATCD,PVAL,
2174     1                CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2175     1                CUT95,CUT975,CUT99,CUT995,CUT100,
2176     1                ISUBRO,IBUGA3,IERROR)
2177C
2178C               ***************************************
2179C               **  STEP 8C--                        **
2180C               **  COMPUTE GRUBB     STAT           **
2181C               **  UPDATE INTERNAL DATAPLOT TABLES  **
2182C               ***************************************
2183C
2184          ISTEPN='8C'
2185          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
2186     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2187C
2188          IFLAGU='FILE'
2189          IFRST=.FALSE.
2190          ILAST=.FALSE.
2191          IF(IRESP.EQ.1)IFRST=.TRUE.
2192          IF(IRESP.EQ.NRESP)ILAST=.TRUE.
2193          IFLAGU='ON'
2194          IFRST=.FALSE.
2195          ILAST=.FALSE.
2196          CALL DPGRU4(STATVA,STATCD,PVAL,
2197     1                CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,CUT99,CUT100,
2198     1                IFLAGU,IFRST,ILAST,ICASP2,
2199     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
2200C
2201  810   CONTINUE
2202C
2203C               ****************************************************
2204C               **  STEP 9A--                                     **
2205C               **  CASE 3: ONE OR MORE REPLICATION VARIABLES.    **
2206C               **          FOR THIS CASE, THE NUMBER OF RESPONSE **
2207C               **          VARIABLES MUST BE EXACTLY 1.          **
2208C               **          FOR THIS CASE, ALL VARIABLES MUST     **
2209C               **          HAVE THE SAME LENGTH.                 **
2210C               ****************************************************
2211C
2212      ELSEIF(IREPL.EQ.'ON')THEN
2213        ISTEPN='9A'
2214        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
2215     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2216C
2217        J=0
2218        IMAX=NRIGHT(1)
2219        IF(NQ.LT.NRIGHT(1))IMAX=NQ
2220        DO910I=1,IMAX
2221          IF(ISUB(I).EQ.0)GOTO910
2222          J=J+1
2223C
2224C         RESPONSE VARIABLE IN Y1
2225C
2226          ICOLC=1
2227          IJ=MAXN*(ICOLR(ICOLC)-1)+I
2228          IF(ICOLR(ICOLC).LE.MAXCOL)Y1(J)=V(IJ)
2229          IF(ICOLR(ICOLC).EQ.MAXCP1)Y1(J)=PRED(I)
2230          IF(ICOLR(ICOLC).EQ.MAXCP2)Y1(J)=RES(I)
2231          IF(ICOLR(ICOLC).EQ.MAXCP3)Y1(J)=YPLOT(I)
2232          IF(ICOLR(ICOLC).EQ.MAXCP4)Y1(J)=XPLOT(I)
2233          IF(ICOLR(ICOLC).EQ.MAXCP5)Y1(J)=X2PLOT(I)
2234          IF(ICOLR(ICOLC).EQ.MAXCP6)Y1(J)=TAGPLO(I)
2235C
2236C         LABID VARIABLE IN X1
2237C
2238          IF(NLABID.GE.1)THEN
2239            ICOLC=ICOLC+1
2240            ICOLT=ICOLR(ICOLC)
2241            IJ=MAXN*(ICOLT-1)+I
2242            IF(ICOLT.LE.MAXCOL)X1(J)=V(IJ)
2243            IF(ICOLT.EQ.MAXCP1)X1(J)=PRED(I)
2244            IF(ICOLT.EQ.MAXCP2)X1(J)=RES(I)
2245            IF(ICOLT.EQ.MAXCP3)X1(J)=YPLOT(I)
2246            IF(ICOLT.EQ.MAXCP4)X1(J)=XPLOT(I)
2247            IF(ICOLT.EQ.MAXCP5)X1(J)=X2PLOT(I)
2248            IF(ICOLT.EQ.MAXCP6)X1(J)=TAGPLO(I)
2249          ELSE
2250            X1(J)=REAL(I)
2251          ENDIF
2252C
2253          IF(NREPL.GE.1)THEN
2254            DO920IR=1,MIN(NREPL,6)
2255              ICOLC=ICOLC+1
2256              ICOLT=ICOLR(ICOLC)
2257              IJ=MAXN*(ICOLT-1)+I
2258              IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
2259              IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
2260              IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
2261              IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
2262              IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
2263              IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
2264              IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
2265  920       CONTINUE
2266          ENDIF
2267C
2268  910   CONTINUE
2269        NLOCAL=J
2270C
2271        ISTEPN='9B'
2272        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DIXO')
2273     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2274C
2275C       NOTE: CHECK TO SEE IF X1 HAS ALL UNIQUE ELEMENTS.  IF NOT,
2276C             THEN INTERPRET THIS AS A REPLICATION VARIABLE.
2277C
2278        CALL DISTIN(X1,NLOCAL,IWRITE,XTEMP2,NDIST,IBUGA3,IERROR)
2279        IF(NLOCAL.NE.NDIST)THEN
2280          NLABID=0
2281          IF(NREPL.GT.6)NREPL=6
2282          IF(NREPL.GE.1)THEN
2283            DO930J=1,NREPL-1
2284              DO935I=1,NLOCAL
2285                XDESGN(I,J+1)=XDESGN(I,J)
2286  935         CONTINUE
2287  930       CONTINUE
2288          ENDIF
2289          NREPL=NREPL+1
2290          DO938I=1,NLOCAL
2291            XDESGN(I,1)=X1(I)
2292            X1(I)=REAL(I)
2293  938     CONTINUE
2294        ENDIF
2295C
2296        PID(1)=CPUMIN
2297        IVARID(1)=IVARN1(1)
2298        IVARI2(1)=IVARN2(1)
2299        IF(NLABID.EQ.1)THEN
2300          PID(2)=CPUMIN
2301          IVARID(2)=IVARN1(2)
2302          IVARI2(2)=IVARN2(2)
2303        ENDIF
2304        IADD=NRESP+NLABID
2305        DO940II=1,NREPL
2306          IVARID(II+IADD)=IVARN1(II+IADD)
2307          IVARI2(II+IADD)=IVARN2(II+IADD)
2308  940   CONTINUE
2309C
2310C       *****************************************************
2311C       **  STEP 9B--                                      **
2312C       **  CALL DPDIX2 TO PERFORM THE DIXON TEST.         **
2313C       *****************************************************
2314C
2315C
2316        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DIXO')THEN
2317          ISTEPN='9C'
2318          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2319          WRITE(ICOUT,999)
2320          CALL DPWRST('XXX','BUG ')
2321          WRITE(ICOUT,941)
2322  941     FORMAT('***** FROM THE MIDDLE  OF DPDIXO--')
2323          CALL DPWRST('XXX','BUG ')
2324          WRITE(ICOUT,942)ICASAN,NUMVAR,IDATSW,NLOCAL,NREPL
2325  942     FORMAT('ICASAN,NUMVAR,IDATSW,NLOCAL,NREPL = ',
2326     1           A4,I8,2X,A4,2I8)
2327          CALL DPWRST('XXX','BUG ')
2328          IF(NLOCAL.GE.1)THEN
2329            DO945I=1,NLOCAL
2330              WRITE(ICOUT,946)I,Y1(I),X1(I),XDESGN(I,1),XDESGN(I,2)
2331  946         FORMAT('I,Y1(I),X1(I),XDESGN(I,1),XDESGN(I,2) = ',
2332     1               I8,4F12.5)
2333              CALL DPWRST('XXX','BUG ')
2334  945       CONTINUE
2335          ENDIF
2336        ENDIF
2337C
2338C       *****************************************************
2339C       **  STEP 9C--                                      **
2340C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
2341C       **  REPLICATION VARIABLES.                         **
2342C       *****************************************************
2343C
2344        CALL DPPP5(XDESGN(1,1),XDESGN(1,2),XDESGN(1,3),
2345     1             XDESGN(1,4),XDESGN(1,5),XDESGN(1,6),
2346     1             NREPL,NLOCAL,MAXOBV,
2347     1             XIDTEM,XIDTE2,XIDTE3,XIDTE4,XIDTE5,XIDTE6,
2348     1             XTEMP1,XTEMP2,
2349     1             NUMSE1,NUMSE2,NUMSE3,NUMSE4,NUMSE5,NUMSE6,
2350     1             IBUGA3,ISUBRO,IERROR)
2351C
2352C       *****************************************************
2353C       **  STEP 9D--                                      **
2354C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
2355C       *****************************************************
2356C
2357        NPLOTP=0
2358        NCURVE=0
2359        IF(NREPL.EQ.1)THEN
2360          J=0
2361          DO1110ISET1=1,NUMSE1
2362            K=0
2363            PID(IADD+1)=XIDTEM(ISET1)
2364            DO1130I=1,NLOCAL
2365              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
2366                K=K+1
2367                TEMP1(K)=Y1(I)
2368                TEMP2(K)=X1(I)
2369              ENDIF
2370 1130       CONTINUE
2371            NTEMP=K
2372            NCURVE=NCURVE+1
2373            NPLOT1=NPLOTP
2374            IF(NTEMP.GT.0)THEN
2375              CALL DPDIX2(TEMP1,TEMP2,NTEMP,ICASAN,MAXOBV,
2376     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,
2377     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2378     1                    IOUNI2,ISEED,
2379     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2380     1                    STATVA,STATCD,PVAL,
2381     1                    CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2382     1                    CUT95,CUT975,CUT99,CUT995,CUT100,
2383     1                    ISUBRO,IBUGA3,IERROR)
2384            ENDIF
2385            NPLOT2=NPLOTP
2386            IFLAGU='FILE'
2387            IFRST=.FALSE.
2388            ILAST=.FALSE.
2389            IF(NCURVE.EQ.1)IFRST=.TRUE.
2390            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
2391            NPTEMP=NPLOT2-NPLOT1
2392            CALL DPGRU4(STATVA,STATCD,PVAL,
2393     1                  CUT0,CUT50,CUT75,CUT90,CUT95,
2394     1                  CUT975,CUT99,CUT100,
2395     1                  IFLAGU,IFRST,ILAST,ICASP2,
2396     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
2397 1110     CONTINUE
2398        ELSEIF(NREPL.EQ.2)THEN
2399          J=0
2400          NTOT=NUMSE1*NUMSE2
2401          DO1210ISET1=1,NUMSE1
2402          DO1220ISET2=1,NUMSE2
2403            K=0
2404            PID(1+IADD)=XIDTEM(ISET1)
2405            PID(2+IADD)=XIDTE2(ISET2)
2406            DO1290I=1,NLOCAL
2407              IF(
2408     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2409     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
2410     1          )THEN
2411                K=K+1
2412                TEMP1(K)=Y1(I)
2413                TEMP2(K)=X1(I)
2414              ENDIF
2415 1290       CONTINUE
2416            NTEMP=K
2417            NCURVE=NCURVE+1
2418            NPLOT1=NPLOTP
2419            IF(NTEMP.GT.0)THEN
2420              CALL DPDIX2(TEMP1,TEMP2,NTEMP,ICASAN,MAXOBV,
2421     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,
2422     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2423     1                    IOUNI2,ISEED,
2424     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2425     1                    STATVA,STATCD,PVAL,
2426     1                    CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2427     1                    CUT95,CUT975,CUT99,CUT995,CUT100,
2428     1                    ISUBRO,IBUGA3,IERROR)
2429            ENDIF
2430            NPLOT2=NPLOTP
2431            IFLAGU='FILE'
2432            IFRST=.FALSE.
2433            ILAST=.FALSE.
2434            IF(NCURVE.EQ.1)IFRST=.TRUE.
2435            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
2436            NPTEMP=NPLOT2-NPLOT1
2437            CALL DPGRU4(STATVA,STATCD,PVAL,
2438     1                  CUT0,CUT50,CUT75,CUT90,CUT95,
2439     1                  CUT975,CUT99,CUT100,
2440     1                  IFLAGU,IFRST,ILAST,ICASP2,
2441     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
2442 1220     CONTINUE
2443 1210     CONTINUE
2444        ELSEIF(NREPL.EQ.3)THEN
2445          J=0
2446          NTOT=NUMSE1*NUMSE2*NUMSE3
2447          DO1310ISET1=1,NUMSE1
2448          DO1320ISET2=1,NUMSE2
2449          DO1330ISET3=1,NUMSE3
2450            K=0
2451            PID(1+IADD)=XIDTEM(ISET1)
2452            PID(2+IADD)=XIDTE2(ISET2)
2453            PID(3+IADD)=XIDTE3(ISET3)
2454            DO1390I=1,NLOCAL
2455              IF(
2456     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2457     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
2458     1           XIDTE3(ISET3).EQ.XDESGN(I,3)
2459     1          )THEN
2460                K=K+1
2461                TEMP1(K)=Y1(I)
2462                TEMP2(K)=X1(I)
2463              ENDIF
2464 1390       CONTINUE
2465            NTEMP=K
2466            NCURVE=NCURVE+1
2467            NPLOT1=NPLOTP
2468            IF(NTEMP.GT.0)THEN
2469              CALL DPDIX2(TEMP1,TEMP2,NTEMP,ICASAN,MAXOBV,
2470     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,
2471     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2472     1                    IOUNI2,ISEED,
2473     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2474     1                    STATVA,STATCD,PVAL,
2475     1                    CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2476     1                    CUT95,CUT975,CUT99,CUT995,CUT100,
2477     1                    ISUBRO,IBUGA3,IERROR)
2478            ENDIF
2479            NPLOT2=NPLOTP
2480            IFLAGU='FILE'
2481            IFRST=.FALSE.
2482            ILAST=.FALSE.
2483            IF(NCURVE.EQ.1)IFRST=.TRUE.
2484            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
2485            NPTEMP=NPLOT2-NPLOT1
2486            CALL DPGRU4(STATVA,STATCD,PVAL,
2487     1                  CUT0,CUT50,CUT75,CUT90,CUT95,
2488     1                  CUT975,CUT99,CUT100,
2489     1                  IFLAGU,IFRST,ILAST,ICASP2,
2490     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
2491 1330     CONTINUE
2492 1320     CONTINUE
2493 1310     CONTINUE
2494        ELSEIF(NREPL.EQ.4)THEN
2495          J=0
2496          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4
2497          DO1410ISET1=1,NUMSE1
2498          DO1420ISET2=1,NUMSE2
2499          DO1430ISET3=1,NUMSE3
2500          DO1440ISET4=1,NUMSE4
2501            K=0
2502            PID(1+IADD)=XIDTEM(ISET1)
2503            PID(2+IADD)=XIDTE2(ISET2)
2504            PID(3+IADD)=XIDTE3(ISET3)
2505            PID(4+IADD)=XIDTE4(ISET4)
2506            DO1490I=1,NLOCAL
2507              IF(
2508     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2509     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
2510     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
2511     1           XIDTE4(ISET4).EQ.XDESGN(I,4)
2512     1          )THEN
2513                K=K+1
2514                TEMP1(K)=Y1(I)
2515                TEMP2(K)=X1(I)
2516              ENDIF
2517 1490       CONTINUE
2518            NTEMP=K
2519            NCURVE=NCURVE+1
2520            NPLOT1=NPLOTP
2521            IF(NTEMP.GT.0)THEN
2522              CALL DPDIX2(TEMP1,TEMP2,NTEMP,ICASAN,MAXOBV,
2523     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,
2524     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2525     1                    IOUNI2,ISEED,
2526     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2527     1                    STATVA,STATCD,PVAL,
2528     1                    CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2529     1                    CUT95,CUT975,CUT99,CUT995,CUT100,
2530     1                    ISUBRO,IBUGA3,IERROR)
2531            ENDIF
2532            NPLOT2=NPLOTP
2533            IFLAGU='FILE'
2534            IFRST=.FALSE.
2535            ILAST=.FALSE.
2536            IF(NCURVE.EQ.1)IFRST=.TRUE.
2537            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
2538            NPTEMP=NPLOT2-NPLOT1
2539            CALL DPGRU4(STATVA,STATCD,PVAL,
2540     1                  CUT0,CUT50,CUT75,CUT90,CUT95,
2541     1                  CUT975,CUT99,CUT100,
2542     1                  IFLAGU,IFRST,ILAST,ICASP2,
2543     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
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)=Y1(I)
2572                TEMP2(K)=X1(I)
2573              ENDIF
2574 1590       CONTINUE
2575            NTEMP=K
2576            NCURVE=NCURVE+1
2577            NPLOT1=NPLOTP
2578            IF(NTEMP.GT.0)THEN
2579              CALL DPDIX2(TEMP1,TEMP2,NTEMP,ICASAN,MAXOBV,
2580     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,
2581     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2582     1                    IOUNI2,ISEED,
2583     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2584     1                    STATVA,STATCD,PVAL,
2585     1                    CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2586     1                    CUT95,CUT975,CUT99,CUT995,CUT100,
2587     1                    ISUBRO,IBUGA3,IERROR)
2588            ENDIF
2589            NPLOT2=NPLOTP
2590            IFLAGU='FILE'
2591            IFRST=.FALSE.
2592            ILAST=.FALSE.
2593            IF(NCURVE.EQ.1)IFRST=.TRUE.
2594            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
2595            NPTEMP=NPLOT2-NPLOT1
2596            CALL DPGRU4(STATVA,STATCD,PVAL,
2597     1                  CUT0,CUT50,CUT75,CUT90,CUT95,
2598     1                  CUT975,CUT99,CUT100,
2599     1                  IFLAGU,IFRST,ILAST,ICASP2,
2600     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
2601 1550     CONTINUE
2602 1540     CONTINUE
2603 1530     CONTINUE
2604 1520     CONTINUE
2605 1510     CONTINUE
2606        ELSEIF(NREPL.EQ.6)THEN
2607          J=0
2608          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5*NUMSE6
2609          DO1610ISET1=1,NUMSE1
2610          DO1620ISET2=1,NUMSE2
2611          DO1630ISET3=1,NUMSE3
2612          DO1640ISET4=1,NUMSE4
2613          DO1650ISET5=1,NUMSE5
2614          DO1660ISET6=1,NUMSE6
2615            K=0
2616            PID(1+IADD)=XIDTEM(ISET1)
2617            PID(2+IADD)=XIDTE2(ISET2)
2618            PID(3+IADD)=XIDTE3(ISET3)
2619            PID(4+IADD)=XIDTE4(ISET4)
2620            PID(5+IADD)=XIDTE5(ISET4)
2621            PID(6+IADD)=XIDTE6(ISET4)
2622            DO1690I=1,NLOCAL
2623              IF(
2624     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
2625     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
2626     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
2627     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
2628     1           XIDTE5(ISET5).EQ.XDESGN(I,5) .AND.
2629     1           XIDTE6(ISET6).EQ.XDESGN(I,6)
2630     1          )THEN
2631                K=K+1
2632                TEMP1(K)=Y1(I)
2633                TEMP2(K)=X1(I)
2634              ENDIF
2635 1690       CONTINUE
2636            NTEMP=K
2637            NCURVE=NCURVE+1
2638            NPLOT1=NPLOTP
2639            IF(NTEMP.GT.0)THEN
2640              CALL DPDIX2(TEMP1,TEMP2,NTEMP,ICASAN,MAXOBV,
2641     1                    YSTAT,XTEMP1,XTEMP2,XTEMP3,
2642     1                    PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2643     1                    IOUNI2,ISEED,
2644     1                    ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2645     1                    STATVA,STATCD,PVAL,
2646     1                    CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2647     1                    CUT95,CUT975,CUT99,CUT995,CUT100,
2648     1                    ISUBRO,IBUGA3,IERROR)
2649            ENDIF
2650            NPLOT2=NPLOTP
2651            IFLAGU='FILE'
2652            IFRST=.FALSE.
2653            ILAST=.FALSE.
2654            IF(NCURVE.EQ.1)IFRST=.TRUE.
2655            IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
2656            NPTEMP=NPLOT2-NPLOT1
2657            CALL DPGRU4(STATVA,STATCD,PVAL,
2658     1                  CUT0,CUT50,CUT75,CUT90,CUT95,
2659     1                  CUT975,CUT99,CUT100,
2660     1                  IFLAGU,IFRST,ILAST,ICASP2,
2661     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
2662 1660     CONTINUE
2663 1650     CONTINUE
2664 1640     CONTINUE
2665 1630     CONTINUE
2666 1620     CONTINUE
2667 1610     CONTINUE
2668        ENDIF
2669C
2670      ENDIF
2671C
2672C               *****************
2673C               **  STEP 90--  **
2674C               **  EXIT       **
2675C               *****************
2676C
2677 9000 CONTINUE
2678C
2679      IRANAL=IRANSV
2680      ISEED=ISEESV
2681C
2682      IOP='CLOS'
2683      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
2684     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
2685     1            IBUGA3,ISUBRO,IERROR)
2686C
2687      IF(IERROR.EQ.'YES')THEN
2688        IF(IWIDTH.GE.1)THEN
2689          WRITE(ICOUT,9001)(IANS(I),I=1,MIN(100,IWIDTH))
2690 9001     FORMAT(100A1)
2691          CALL DPWRST('XXX','BUG ')
2692        ENDIF
2693      ENDIF
2694C
2695      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DIXO')THEN
2696        WRITE(ICOUT,999)
2697        CALL DPWRST('XXX','BUG ')
2698        WRITE(ICOUT,9011)
2699 9011   FORMAT('***** AT THE END       OF DPDIXO--')
2700        CALL DPWRST('XXX','BUG ')
2701        WRITE(ICOUT,9012)IFOUND,IERROR
2702 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
2703        CALL DPWRST('XXX','BUG ')
2704        WRITE(ICOUT,9013)NPLOTP,NS,ICASAN
2705 9013   FORMAT('NPLOTP,NS,ICASAN = ',I8,I8,2X,A4)
2706        CALL DPWRST('XXX','BUG ')
2707      ENDIF
2708C
2709      RETURN
2710      END
2711      SUBROUTINE DPDIX2(Y,X,N,ICASAN,MAXNXT,
2712     1                  YSTAT,TEMP1,TEMP2,TEMP3,
2713     1                  PID,IVARID,IVARI2,NCURVE,NREPL,NLABID,
2714     1                  IOUNI2,ISEED,
2715     1                  ICAPSW,ICAPTY,IFORSW,IRTFFF,IRTFFP,
2716     1                  STATVA,STATCD,PVAL,
2717     1                  CUT0,CUT25,CUT50,CUT75,CUT80,CUT90,
2718     1                  CUT95,CUT975,CUT99,CUT995,CUT100,
2719     1                  ISUBRO,IBUGA3,IERROR)
2720C
2721C     PURPOSE--THIS ROUTINE CARRIES OUT THE DIXON TEST FOR UNIVARIATE
2722C              OUTLIERS (DATA ASSUMED TO FOLLOW AN APPROXIMATELY NORMAL
2723C              DISTRIBUTION).
2724C     EXAMPLE--DIXON TEST Y
2725C     REFERENCES--DIXON (1953), "PROCESSING DATA FOR OUTLIERS",
2726C                 BIOMETRICS, VOL. 9, NO. 1, PP. 74-89.
2727C     WRITTEN BY--ALAN HECKERT
2728C                 STATISTICAL ENGINEERING DIVISION
2729C                 INFORMATION TECHNOLOGY LABORATORY
2730C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY
2731C                 GAITHERSBURG, MD 20899-8980
2732C                 PHONE--301-975-2899
2733C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2734C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOOGY.
2735C     LANGUAGE--ANSI FORTRAN (1977)
2736C     VERSION NUMBER--2009/11
2737C     ORIGINAL VERSION--NOVEMBER  2009.
2738C     UPDATED         --JULY      2014. ADD SKEWNESS AND KURTOSIS TO
2739C                                       SUMMARY STATISTICS
2740C
2741C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2742C
2743      CHARACTER*4 ISUBRO
2744      CHARACTER*4 IBUGA3
2745      CHARACTER*4 IERROR
2746      CHARACTER*4 IVARID(*)
2747      CHARACTER*4 IVARI2(*)
2748      CHARACTER*4 ICAPSW
2749      CHARACTER*4 ICAPTY
2750      CHARACTER*4 IFORSW
2751      CHARACTER*4 IDIR
2752      CHARACTER*4 ICASAN
2753C
2754      CHARACTER*40 IRTFFF
2755      CHARACTER*40 IRTFFP
2756C
2757      CHARACTER*4 IWRITE
2758      CHARACTER*1 IBASLC
2759C
2760      CHARACTER*4 ISUBN1
2761      CHARACTER*4 ISUBN2
2762      CHARACTER*4 ISTEPN
2763C
2764      CHARACTER*4 IRTFMD
2765      COMMON/COMRTF/IRTFMD
2766C
2767      PARAMETER (NUMALP=11)
2768      REAL ALPHA(NUMALP)
2769C
2770      PARAMETER(NUMCLI=4)
2771      PARAMETER(MAXLIN=2)
2772      PARAMETER (MAXROW=50)
2773      CHARACTER*60 ITITLE
2774      CHARACTER*60 ITITLZ
2775      CHARACTER*1  ITITL9
2776      CHARACTER*60 ITEXT(MAXROW)
2777      CHARACTER*4  ALIGN(NUMCLI)
2778      CHARACTER*4  VALIGN(NUMCLI)
2779      REAL         AVALUE(MAXROW)
2780      INTEGER      NCTEXT(MAXROW)
2781      INTEGER      IDIGIT(MAXROW)
2782      INTEGER      NTOT(MAXROW)
2783      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
2784      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
2785      CHARACTER*4  ITYPCO(NUMCLI)
2786      INTEGER      NCTIT2(MAXLIN,NUMCLI)
2787      INTEGER      NCVALU(MAXROW,NUMCLI)
2788      INTEGER      IWHTML(NUMCLI)
2789      INTEGER      IWRTF(NUMCLI)
2790      REAL         AMAT(MAXROW,NUMCLI)
2791      LOGICAL IFRST
2792      LOGICAL ILAST
2793      LOGICAL IFLAG1
2794      LOGICAL IFLAG2
2795      LOGICAL IFLAG3
2796C
2797C---------------------------------------------------------------------
2798C
2799      DIMENSION Y(*)
2800      DIMENSION X(*)
2801      DIMENSION YSTAT(*)
2802      DIMENSION TEMP1(*)
2803      DIMENSION TEMP2(*)
2804      DIMENSION TEMP3(*)
2805      DIMENSION PID(*)
2806C
2807C---------------------------------------------------------------------
2808C
2809      INCLUDE 'DPCOP2.INC'
2810C
2811      DATA ALPHA/
2812     1 0.0, 25.0, 50.0, 75.0, 80.0, 90.0, 95.0,
2813     1 97.5, 99.0, 99.5, 100.0/
2814C
2815C-----START POINT-----------------------------------------------------
2816C
2817      ISUBN1='DPDI'
2818      ISUBN2='X2  '
2819      IERROR='NO'
2820      STATVA=CPUMIN
2821      STATCD=CPUMIN
2822      PVAL=CPUMIN
2823      CUT0=CPUMIN
2824      CUT25=CPUMIN
2825      CUT50=CPUMIN
2826      CUT75=CPUMIN
2827      CUT80=CPUMIN
2828      CUT90=CPUMIN
2829      CUT95=CPUMIN
2830      CUT975=CPUMIN
2831      CUT99=CPUMIN
2832      CUT995=CPUMIN
2833      CUT100=CPUMIN
2834C
2835      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')THEN
2836        WRITE(ICOUT,999)
2837  999   FORMAT(1X)
2838        CALL DPWRST('XXX','WRIT')
2839        WRITE(ICOUT,51)
2840   51   FORMAT('**** AT THE BEGINNING OF DPDIX2--')
2841        CALL DPWRST('XXX','WRIT')
2842        WRITE(ICOUT,52)ISUBRO,IBUGA3,ICASAN
2843   52   FORMAT('ISUBRO,IBUGA3,ICASAN = ',3(A4,2X))
2844        CALL DPWRST('XXX','WRIT')
2845        WRITE(ICOUT,55)N,MAXNXT
2846   55   FORMAT('N,MAXNXT = ',2I8)
2847        CALL DPWRST('XXX','WRIT')
2848        DO56I=1,MIN(N,100)
2849          WRITE(ICOUT,57)I,Y(I),X(I)
2850   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
2851          CALL DPWRST('XXX','WRIT')
2852   56   CONTINUE
2853      ENDIF
2854C
2855C               ********************************************
2856C               **  STEP 11--                             **
2857C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
2858C               ********************************************
2859C
2860      ISTEPN='11'
2861      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
2862     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2863C
2864      IF(N.LT.3)THEN
2865        WRITE(ICOUT,999)
2866        CALL DPWRST('XXX','WRIT')
2867        WRITE(ICOUT,1111)
2868 1111   FORMAT('***** ERROR IN DIXON OUTLIER TEST--')
2869        CALL DPWRST('XXX','WRIT')
2870        WRITE(ICOUT,1113)
2871 1113   FORMAT('      THE NUMBER OF OBSERVATIONS IS LESS THAN 3.')
2872        CALL DPWRST('XXX','WRIT')
2873        WRITE(ICOUT,1114)N
2874 1114   FORMAT('SAMPLE SIZE = ',I8)
2875        CALL DPWRST('XXX','WRIT')
2876        IERROR='YES'
2877        GOTO9000
2878      ENDIF
2879C
2880      HOLD=Y(1)
2881      DO1135I=2,N
2882        IF(Y(I).NE.HOLD)GOTO1139
2883 1135 CONTINUE
2884      WRITE(ICOUT,999)
2885      CALL DPWRST('XXX','WRIT')
2886      WRITE(ICOUT,1111)
2887      CALL DPWRST('XXX','WRIT')
2888      WRITE(ICOUT,1131)HOLD
2889 1131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
2890      CALL DPWRST('XXX','WRIT')
2891      IERROR='YES'
2892      GOTO9000
2893 1139 CONTINUE
2894C
2895C               ******************************
2896C               **  STEP 21--               **
2897C               **  CARRY OUT CALCULATIONS  **
2898C               **  FOR DIXON OUTLIER TEST  **
2899C               ******************************
2900C
2901      ISTEPN='21'
2902      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
2903     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2904C
2905      IWRITE='OFF'
2906      CALL MINIM(Y,N,IWRITE,YMIN,IBUGA3,IERROR)
2907      CALL MAXIM(Y,N,IWRITE,YMAX,IBUGA3,IERROR)
2908      CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
2909      CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
2910      CALL RANGDP(Y,N,IWRITE,YRANGE,IBUGA3,IERROR)
2911      CALL STMOM3(Y,N,IWRITE,YSKEW,IBUGA3,IERROR)
2912      CALL STMOM4(Y,N,IWRITE,YKURT,IBUGA3,IERROR)
2913C
2914      INDMIN=-99
2915      INDMAX=99
2916      DO2105I=1,N
2917        IF(Y(I).EQ.YMIN)INDMIN=I
2918        IF(Y(I).EQ.YMAX)INDMAX=I
2919 2105 CONTINUE
2920C
2921      CALL DPDIX3(Y,X,N,TEMP1,IWRITE,ICASAN,
2922     1            STATVA,
2923     1            ISUBRO,IBUGA3,IERROR)
2924C
2925      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')THEN
2926        WRITE(ICOUT,2211)STATVA
2927 2211   FORMAT('STATVA = ',G15.7)
2928        CALL DPWRST('XXX','BUG ')
2929        WRITE(ICOUT,2213)YMIN,YMAX,YMEAN,YSD
2930 2213   FORMAT('YMIN,YMAX,YMEAN,YSD = ',4G15.7)
2931        CALL DPWRST('XXX','BUG ')
2932      ENDIF
2933C
2934C               ************************************
2935C               **  STEP 22--                     **
2936C               **  COMPUTE CRITICAL VALUES VIA   **
2937C               **  MONTE-CARLO SIMULATION        **
2938C               ************************************
2939C
2940      ISTEPN='22'
2941      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
2942     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2943C
2944CCCCC NMCSAM=10000
2945      NMCSAM=25000
2946      NTEMP=N
2947      DO2210I=1,NMCSAM
2948C
2949        DO2212J=1,NTEMP
2950          TEMP3(J)=REAL(J)
2951 2212   CONTINUE
2952C
2953        CALL NORRAN(NTEMP,ISEED,TEMP2)
2954        CALL DPDIX3(TEMP2,TEMP3,NTEMP,TEMP1,IWRITE,ICASAN,
2955     1              STATV2,
2956     1              ISUBRO,IBUGA3,IERROR)
2957        YSTAT(I)=STATV2
2958        WRITE(IOUNI2,'(3I8,2X,E15.7)')NCURVE,NREPL,I,YSTAT(I)
2959 2210 CONTINUE
2960      IDIR='LOWE'
2961      CALL DPGOF8(YSTAT,NMCSAM,STATVA,PVAL,IDIR,
2962     1            IBUGA3,ISUBRO,IERROR)
2963      STATCD=PVAL
2964      PVAL=1.0 - STATCD
2965      CUT0=YSTAT(1)
2966      CUT100=YSTAT(NMCSAM)
2967      IWRITE='OFF'
2968      DO2220I=2,NUMALP-1
2969        P100=ALPHA(I)
2970        CALL PERCEN(P100,YSTAT,NMCSAM,IWRITE,TEMP1,NMCSAM,
2971     1              XSTAT,IBUGA3,IERROR)
2972        IF(I.EQ.2)CUT25=XSTAT
2973        IF(I.EQ.3)CUT50=XSTAT
2974        IF(I.EQ.4)CUT75=XSTAT
2975        IF(I.EQ.5)CUT80=XSTAT
2976        IF(I.EQ.6)CUT90=XSTAT
2977        IF(I.EQ.7)CUT95=XSTAT
2978        IF(I.EQ.8)CUT975=XSTAT
2979        IF(I.EQ.9)CUT99=XSTAT
2980        IF(I.EQ.10)CUT995=XSTAT
2981 2220 CONTINUE
2982C
2983      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')THEN
2984        WRITE(ICOUT,2231)PVAL,STATCD,CUT0,CUT25,CUT50,CUT75
2985 2231   FORMAT('PVAL,STATCD,CUT0,CUT25,CUT50,CUT75 = ',6G15.7)
2986        CALL DPWRST('XXX','WRIT')
2987        WRITE(ICOUT,2233)CUT80,CUT90,CUT95,CUT975,CUT99,CUT995,CUT100
2988 2233   FORMAT('CUT80,CUT90,CUT95,CUT975,CUT99,CUT995,CUT100 = ',7G15.7)
2989        CALL DPWRST('XXX','WRIT')
2990      ENDIF
2991C
2992C               *********************************
2993C               **   STEP 42--                 **
2994C               **   WRITE OUT EVERYTHING      **
2995C               **   FOR DIXON TEST            **
2996C               *********************************
2997C
2998      ISTEPN='42'
2999      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
3000     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3001C
3002      IF(IPRINT.EQ.'OFF')GOTO9000
3003C
3004      NUMDIG=7
3005      IF(IFORSW.EQ.'1')NUMDIG=1
3006      IF(IFORSW.EQ.'2')NUMDIG=2
3007      IF(IFORSW.EQ.'3')NUMDIG=3
3008      IF(IFORSW.EQ.'4')NUMDIG=4
3009      IF(IFORSW.EQ.'5')NUMDIG=5
3010      IF(IFORSW.EQ.'6')NUMDIG=6
3011      IF(IFORSW.EQ.'7')NUMDIG=7
3012      IF(IFORSW.EQ.'8')NUMDIG=8
3013      IF(IFORSW.EQ.'9')NUMDIG=9
3014      IF(IFORSW.EQ.'0')NUMDIG=0
3015      IF(IFORSW.EQ.'E')NUMDIG=-2
3016      IF(IFORSW.EQ.'-2')NUMDIG=-2
3017      IF(IFORSW.EQ.'-3')NUMDIG=-3
3018      IF(IFORSW.EQ.'-4')NUMDIG=-4
3019      IF(IFORSW.EQ.'-5')NUMDIG=-5
3020      IF(IFORSW.EQ.'-6')NUMDIG=-6
3021      IF(IFORSW.EQ.'-7')NUMDIG=-7
3022      IF(IFORSW.EQ.'-8')NUMDIG=-8
3023      IF(IFORSW.EQ.'-9')NUMDIG=-9
3024C
3025      IF(ICASAN.EQ.'DI2S')THEN
3026        ITITLE=
3027     1  'Dixon Test for a Single Outlier: Two-Sided Case'
3028        NCTITL=47
3029      ELSEIF(ICASAN.EQ.'MINI')THEN
3030        ITITLE='Dixon Test for a Single Outlier: Minimum Case'
3031        NCTITL=52
3032      ELSEIF(ICASAN.EQ.'MAXI')THEN
3033        ITITLE='Dixon Test for a Single Outlier: Maximum Case'
3034        NCTITL=52
3035      ENDIF
3036      ITITLZ='(Assumption: Normality)'
3037      NCTITZ=23
3038C
3039      ICNT=1
3040      ITEXT(ICNT)=' '
3041      NCTEXT(ICNT)=0
3042      AVALUE(ICNT)=0.0
3043      IDIGIT(ICNT)=-1
3044      ICNT=ICNT+1
3045      ITEXT(ICNT)='Response Variable: '
3046      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
3047      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
3048      NCTEXT(ICNT)=27
3049      AVALUE(ICNT)=0.0
3050      IDIGIT(ICNT)=-1
3051C
3052      IF(NREPL.GT.0)THEN
3053        NRESP=1
3054        IADD=NLABID+NRESP
3055        DO4101I=1,NREPL
3056          ICNT=ICNT+1
3057          ITEMP=I+IADD
3058          ITEXT(ICNT)='Factor Variable  : '
3059          WRITE(ITEXT(ICNT)(17:17),'(I1)')I
3060          WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(ITEMP)(1:4)
3061          WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(ITEMP)(1:4)
3062          NCTEXT(ICNT)=27
3063          AVALUE(ICNT)=PID(ITEMP)
3064          IDIGIT(ICNT)=NUMDIG
3065 4101   CONTINUE
3066      ENDIF
3067C
3068      ICNT=ICNT+1
3069      ITEXT(ICNT)=' '
3070      NCTEXT(ICNT)=1
3071      AVALUE(ICNT)=0.0
3072      IDIGIT(ICNT)=-1
3073C
3074      ICNT=ICNT+1
3075      ITEXT(ICNT)='H0: There are no outliers'
3076      NCTEXT(ICNT)=25
3077      AVALUE(ICNT)=0.0
3078      IDIGIT(ICNT)=-1
3079      ICNT=ICNT+1
3080C
3081      ITEXT(ICNT)=' '
3082      IF(ICASAN.EQ.'DI2S')THEN
3083        ITEXT(ICNT)(1:40)='Ha: The most extreme point is an outlier'
3084        NCTEXT(ICNT)=40
3085      ELSEIF(ICASAN.EQ.'MINI')THEN
3086        ITEXT(ICNT)(1:35)='Ha: The minimum point is an outlier'
3087        NCTEXT(ICNT)=35
3088      ELSEIF(ICASAN.EQ.'MAXI')THEN
3089        ITEXT(ICNT)(1:35)='Ha: The maximum point is an outlier'
3090        NCTEXT(ICNT)=35
3091      ENDIF
3092      AVALUE(ICNT)=0.0
3093      IDIGIT(ICNT)=-1
3094C
3095      ICNT=ICNT+1
3096      ITEXT(ICNT)=' '
3097      NCTEXT(ICNT)=1
3098      AVALUE(ICNT)=0.0
3099      IDIGIT(ICNT)=-1
3100      ICNT=ICNT+1
3101      ITEXT(ICNT)='Summary Statistics:'
3102      NCTEXT(ICNT)=19
3103      AVALUE(ICNT)=0.0
3104      IDIGIT(ICNT)=-1
3105      ICNT=ICNT+1
3106      ITEXT(ICNT)='Number of Observations:'
3107      NCTEXT(ICNT)=23
3108      AVALUE(ICNT)=REAL(N)
3109      IDIGIT(ICNT)=0
3110      ICNT=ICNT+1
3111      ITEXT(ICNT)='Sample Minimum:'
3112      NCTEXT(ICNT)=15
3113      AVALUE(ICNT)=YMIN
3114      IDIGIT(ICNT)=NUMDIG
3115      ICNT=ICNT+1
3116      ITEXT(ICNT)='ID for Sample Minimum:'
3117      NCTEXT(ICNT)=22
3118      AVALUE(ICNT)=X(INDMIN)
3119      IDIGIT(ICNT)=0
3120      ICNT=ICNT+1
3121      ITEXT(ICNT)='Sample Maximum:'
3122      NCTEXT(ICNT)=15
3123      AVALUE(ICNT)=YMAX
3124      IDIGIT(ICNT)=NUMDIG
3125      ICNT=ICNT+1
3126      ITEXT(ICNT)='ID for Sample Maximum:'
3127      NCTEXT(ICNT)=22
3128      AVALUE(ICNT)=X(INDMAX)
3129      IDIGIT(ICNT)=0
3130      ICNT=ICNT+1
3131      ITEXT(ICNT)='Sample Mean:'
3132      NCTEXT(ICNT)=12
3133      AVALUE(ICNT)=YMEAN
3134      IDIGIT(ICNT)=NUMDIG
3135      ICNT=ICNT+1
3136      ITEXT(ICNT)='Sample SD:'
3137      NCTEXT(ICNT)=10
3138      AVALUE(ICNT)=YSD
3139      IDIGIT(ICNT)=NUMDIG
3140      ICNT=ICNT+1
3141      ITEXT(ICNT)='Sample Range:'
3142      NCTEXT(ICNT)=13
3143      AVALUE(ICNT)=YRANGE
3144      IDIGIT(ICNT)=NUMDIG
3145      ICNT=ICNT+1
3146      ITEXT(ICNT)='Sample Skewness:'
3147      NCTEXT(ICNT)=16
3148      AVALUE(ICNT)=YSKEW
3149      IDIGIT(ICNT)=NUMDIG
3150      ICNT=ICNT+1
3151      ITEXT(ICNT)='Sample Kurtosis:'
3152      NCTEXT(ICNT)=16
3153      AVALUE(ICNT)=YKURT
3154      IDIGIT(ICNT)=NUMDIG
3155      ICNT=ICNT+1
3156      ITEXT(ICNT)=' '
3157      NCTEXT(ICNT)=1
3158      AVALUE(ICNT)=0.0
3159      IDIGIT(ICNT)=-1
3160      ICNT=ICNT+1
3161      ITEXT(ICNT)='Dixon Test Statistic Value:'
3162      NCTEXT(ICNT)=27
3163      AVALUE(ICNT)=STATVA
3164      IDIGIT(ICNT)=NUMDIG
3165C
3166      ICNT=ICNT+1
3167      ITEXT(ICNT)='CDF Value:'
3168      NCTEXT(ICNT)=10
3169      AVALUE(ICNT)=STATCD
3170      IDIGIT(ICNT)=NUMDIG
3171      ICNT=ICNT+1
3172      ITEXT(ICNT)='P-Value:'
3173      NCTEXT(ICNT)=7
3174      AVALUE(ICNT)=PVAL
3175      IDIGIT(ICNT)=NUMDIG
3176      ICNT=ICNT+1
3177      ITEXT(ICNT)=' '
3178      NCTEXT(ICNT)=1
3179      AVALUE(ICNT)=0.0
3180      IDIGIT(ICNT)=-1
3181C
3182      NUMROW=ICNT
3183      DO4210I=1,NUMROW
3184        NTOT(I)=15
3185 4210 CONTINUE
3186C
3187      IFRST=.TRUE.
3188      ILAST=.TRUE.
3189C
3190      ISTEPN='42A'
3191      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
3192     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3193C
3194      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
3195     1            AVALUE,IDIGIT,
3196     1            NTOT,NUMROW,
3197     1            ICAPSW,ICAPTY,ILAST,IFRST,
3198     1            ISUBRO,IBUGA3,IERROR)
3199C
3200      ISTEPN='42B'
3201      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
3202     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3203C
3204      ITITLE=' '
3205      NCTITL=0
3206C
3207      ITITL9=' '
3208      NCTIT9=0
3209      ITITLE(1:44)='Percent Points of the Reference Distribution'
3210      NCTITL=44
3211      NUMLIN=1
3212      NUMROW=NUMALP
3213      NUMCOL=3
3214      ITITL2(1,1)='Percent Point'
3215      ITITL2(1,2)=' '
3216      ITITL2(1,3)='Value'
3217      NCTIT2(1,1)=13
3218      NCTIT2(1,2)=1
3219      NCTIT2(1,3)=5
3220C
3221      NMAX=0
3222      DO4221I=1,NUMCOL
3223        VALIGN(I)='b'
3224        ALIGN(I)='r'
3225        NTOT(I)=15
3226        IF(I.EQ.2)NTOT(I)=5
3227        NMAX=NMAX+NTOT(I)
3228        IDIGIT(I)=NUMDIG
3229        ITYPCO(I)='NUME'
3230 4221 CONTINUE
3231      ITYPCO(2)='ALPH'
3232      IDIGIT(1)=1
3233      IDIGIT(3)=3
3234      DO4223I=1,NUMROW
3235        DO4225J=1,NUMCOL
3236          NCVALU(I,J)=0
3237          IVALUE(I,J)=' '
3238          NCVALU(I,J)=0
3239          AMAT(I,J)=0.0
3240          IF(J.EQ.1)THEN
3241            AMAT(I,J)=ALPHA(I)
3242          ELSEIF(J.EQ.2)THEN
3243            IVALUE(I,J)='='
3244            NCVALU(I,J)=1
3245          ELSEIF(J.EQ.3)THEN
3246            IF(I.EQ.1)THEN
3247              AMAT(I,J)=RND(CUT0,IDIGIT(J))
3248            ELSEIF(I.EQ.2)THEN
3249              AMAT(I,J)=RND(CUT25,IDIGIT(J))
3250            ELSEIF(I.EQ.3)THEN
3251              AMAT(I,J)=RND(CUT50,IDIGIT(J))
3252            ELSEIF(I.EQ.4)THEN
3253              AMAT(I,J)=RND(CUT75,IDIGIT(J))
3254            ELSEIF(I.EQ.5)THEN
3255              AMAT(I,J)=RND(CUT80,IDIGIT(J))
3256            ELSEIF(I.EQ.6)THEN
3257              AMAT(I,J)=RND(CUT90,IDIGIT(J))
3258            ELSEIF(I.EQ.7)THEN
3259              AMAT(I,J)=RND(CUT95,IDIGIT(J))
3260            ELSEIF(I.EQ.8)THEN
3261              AMAT(I,J)=RND(CUT975,IDIGIT(J))
3262            ELSEIF(I.EQ.9)THEN
3263              AMAT(I,J)=RND(CUT99,IDIGIT(J))
3264            ELSEIF(I.EQ.10)THEN
3265              AMAT(I,J)=RND(CUT995,IDIGIT(J))
3266            ELSEIF(I.EQ.11)THEN
3267              AMAT(I,J)=RND(CUT100,IDIGIT(J))
3268            ENDIF
3269          ENDIF
3270 4225   CONTINUE
3271 4223 CONTINUE
3272C
3273      IWHTML(1)=150
3274      IWHTML(2)=50
3275      IWHTML(3)=150
3276      IWRTF(1)=2000
3277      IWRTF(2)=IWRTF(1)+500
3278      IWRTF(3)=IWRTF(2)+2000
3279      IFRST=.TRUE.
3280      ILAST=.FALSE.
3281C
3282      ISTEPN='42C'
3283      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
3284     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3285C
3286      CALL DPDTA4(ITITL9,NCTIT9,
3287     1            ITITLE,NCTITL,ITITL2,NCTIT2,
3288     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
3289     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
3290     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
3291     1            ICAPSW,ICAPTY,IFRST,ILAST,
3292     1            ISUBRO,IBUGA3,IERROR)
3293C
3294      ISTEPN='42D'
3295      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
3296     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3297C
3298      CDF1=CUT90
3299      CDF2=CUT95
3300      CDF3=CUT975
3301      CDF4=CUT99
3302C
3303      ITITL9=' '
3304      NCTIT9=0
3305      ITITLE='Conclusions (Upper 1-Tailed Test)'
3306      NCTITL=33
3307      NUMLIN=1
3308      NUMROW=4
3309      NUMCOL=4
3310      ITITL2(1,1)='Alpha'
3311      ITITL2(1,2)='CDF'
3312      ITITL2(1,3)='Critical Value'
3313      ITITL2(1,4)='Conclusion'
3314      NCTIT2(1,1)=5
3315      NCTIT2(1,2)=3
3316      NCTIT2(1,3)=14
3317      NCTIT2(1,4)=10
3318C
3319      NMAX=0
3320      DO4321I=1,NUMCOL
3321        VALIGN(I)='b'
3322        ALIGN(I)='r'
3323        NTOT(I)=15
3324        IF(I.EQ.1 .OR. I.EQ.2)NTOT(I)=7
3325        IF(I.EQ.3)NTOT(I)=17
3326        NMAX=NMAX+NTOT(I)
3327        IDIGIT(I)=3
3328        ITYPCO(I)='ALPH'
3329 4321 CONTINUE
3330      ITYPCO(3)='NUME'
3331      IDIGIT(1)=0
3332      IDIGIT(2)=0
3333      DO4323I=1,NUMROW
3334        DO4325J=1,NUMCOL
3335          NCVALU(I,J)=0
3336          IVALUE(I,J)=' '
3337          NCVALU(I,J)=0
3338          AMAT(I,J)=0.0
3339 4325   CONTINUE
3340 4323 CONTINUE
3341      IVALUE(1,1)='10%'
3342      IVALUE(2,1)='5%'
3343      IVALUE(3,1)='2.5%'
3344      IVALUE(4,1)='1%'
3345      NCVALU(1,1)=3
3346      NCVALU(2,1)=2
3347      NCVALU(3,1)=4
3348      NCVALU(4,1)=2
3349      IVALUE(1,2)='90%'
3350      IVALUE(2,2)='95%'
3351      IVALUE(3,2)='97.5%'
3352      IVALUE(4,2)='99%'
3353      NCVALU(1,2)=3
3354      NCVALU(2,2)=3
3355      NCVALU(3,2)=4
3356      NCVALU(4,2)=3
3357      IVALUE(1,4)='Accept H0'
3358      IVALUE(2,4)='Accept H0'
3359      IVALUE(3,4)='Accept H0'
3360      IVALUE(4,4)='Accept H0'
3361      NCVALU(1,4)=9
3362      NCVALU(2,4)=9
3363      NCVALU(3,4)=9
3364      NCVALU(4,4)=9
3365      IF(STATVA.GT.CDF1)IVALUE(1,4)='Reject H0'
3366      IF(STATVA.GT.CDF2)IVALUE(2,4)='Reject H0'
3367      IF(STATVA.GT.CDF3)IVALUE(3,4)='Reject H0'
3368      IF(STATVA.GT.CDF4)IVALUE(4,4)='Reject H0'
3369      AMAT(1,3)=RND(CDF1,IDIGIT(3))
3370      AMAT(2,3)=RND(CDF2,IDIGIT(3))
3371      AMAT(3,3)=RND(CDF3,IDIGIT(3))
3372      AMAT(4,3)=RND(CDF4,IDIGIT(3))
3373C
3374      IWHTML(1)=150
3375      IWHTML(2)=150
3376      IWHTML(3)=150
3377      IWHTML(4)=150
3378      IWRTF(1)=1500
3379      IWRTF(2)=IWRTF(1)+1500
3380      IWRTF(3)=IWRTF(2)+2000
3381      IWRTF(4)=IWRTF(3)+2000
3382      IFRST=.FALSE.
3383C
3384C     FOR LATEX, WE WANT TO ENSURE THAT TRAILING LINE IS PART
3385C     OF THE TABLE SO THAT IT WILL BE PRINTED IN THE PROPER PLACE.
3386C
3387      IF(ICAPTY.EQ.'LATE')THEN
3388        ILAST=.FALSE.
3389      ELSE
3390        ILAST=.TRUE.
3391      ENDIF
3392C
3393      ISTEPN='42E'
3394      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')
3395     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3396C
3397      CALL DPDTA4(ITITL9,NCTIT9,
3398     1            ITITLE,NCTITL,ITITL2,NCTIT2,
3399     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
3400     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
3401     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
3402     1            ICAPSW,ICAPTY,IFRST,ILAST,
3403     1            ISUBRO,IBUGA3,IERROR)
3404C
3405      ITITLE(1:26)='*Critical Values Based on '
3406      WRITE(ITITLE(27:34),'(I8)')NMCSAM
3407      ITITLE(35:58)=' Monte Carlo Simulations'
3408      NCTITL=58
3409C
3410      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
3411        CALL DPHTMV(ITITLE,NCTITL,CPUMIN,NUMDIG)
3412      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
3413        CALL DPLATV(ITITLE,NCTITL,CPUMIN,NUMDIG)
3414        IFLAG1=.FALSE.
3415        IFLAG2=.TRUE.
3416        IFLAG3=.TRUE.
3417        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
3418      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
3419C
3420        CALL DPCONA(92,IBASLC)
3421        IRTFMD='OFF'
3422        IPTSZ=14
3423        WRITE(ICOUT,8199)IBASLC,IPTSZ
3424 8199   FORMAT(A1,'fs',I2)
3425        CALL DPWRST(ICOUT,'WRIT')
3426        IF(IRTFFF.EQ.'Courier New')THEN
3427          ITEMP=1
3428        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
3429          ITEMP=8
3430        ENDIF
3431        WRITE(ICOUT,8301)IBASLC,ITEMP
3432        CALL DPWRST(ICOUT,'WRIT')
3433        CALL DPRTFZ(ITITLE,NCTITL,CPUMIN,NUMDIG)
3434        IF(IRTFFP.EQ.'Times New Roman')THEN
3435          ITEMP=0
3436        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
3437          ITEMP=6
3438        ELSEIF(IRTFFP.EQ.'Arial')THEN
3439          ITEMP=2
3440        ELSEIF(IRTFFP.EQ.'Bookman')THEN
3441          ITEMP=3
3442        ELSEIF(IRTFFP.EQ.'Georgia')THEN
3443          ITEMP=4
3444        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
3445          ITEMP=5
3446        ELSEIF(IRTFFP.EQ.'Verdana')THEN
3447          ITEMP=7
3448        ENDIF
3449        WRITE(ICOUT,8301)IBASLC,ITEMP
3450 8301   FORMAT(A1,'f',I1)
3451        CALL DPWRST(ICOUT,'WRIT')
3452C
3453C       END TABLE AND RESET "ASIS" MODE
3454C
3455        IF(IRTFFF.EQ.'Courier New')THEN
3456          ITEMP=1
3457        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
3458          ITEMP=8
3459        ENDIF
3460        WRITE(ICOUT,8091)IBASLC,ITEMP
3461 8091   FORMAT(A1,'f',I1)
3462        CALL DPWRST(ICOUT,'WRIT')
3463C
3464        CALL DPRTF6(NHEAD)
3465        CALL DPRTF6(NHEAD)
3466        IRTFMD='VERB'
3467      ELSE
3468        WRITE(ICOUT,2589)ITITLE(1:58)
3469 2589   FORMAT(A60)
3470        CALL DPWRST('XXX','BUG ')
3471      ENDIF
3472C
3473C               *****************
3474C               **  STEP 90--  **
3475C               **  EXIT       **
3476C               *****************
3477C
3478 9000 CONTINUE
3479      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DIX2')THEN
3480        WRITE(ICOUT,999)
3481        CALL DPWRST('XXX','WRIT')
3482        WRITE(ICOUT,9011)
3483 9011   FORMAT('***** AT THE END       OF DPDIX2--')
3484        CALL DPWRST('XXX','WRIT')
3485        WRITE(ICOUT,9012)N,IERROR
3486 9012   FORMAT('N,IERROR = ',I8,2X,A4)
3487        CALL DPWRST('XXX','WRIT')
3488        WRITE(ICOUT,9013)STATVA,STATCD,PVAL
3489 9013   FORMAT('STATVA,STATCD,PVAL = ',3G15.7)
3490        CALL DPWRST('XXX','WRIT')
3491      ENDIF
3492C
3493      RETURN
3494      END
3495      SUBROUTINE DPDIX3(Y,X,N,TEMP1,IWRITE,ICASAN,
3496     1                  XDIXON,
3497     1                  ISUBRO,IBUGA3,IERROR)
3498C
3499C     PURPOSE--THIS SUBROUTINE COMPUTES THE DIXON STATISTIC.
3500C              THE DIXON STATISTIC DETERMINES WHETHER THE
3501C              MINIMUM (OR MAXIMUM) IS AN OUTLIER.  IT IS ASSUMMED
3502C              THE UNDERLYING DATA IS APPROXIMATELY NORMAL.  THIS
3503C              TEST IS PRIMARILY RECOMMNEDED FOR SMALL SAMPLES
3504C              (SAY N <= 30).
3505C     REFERENCES--DIXON (1953), "PROCESSING DATA FOR OUTLIERS",
3506C                 BIOMETRICS, VOL. 9, NO. 1, PP. 74-89.
3507C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
3508C                                (UNSORTED OR SORTED) OBSERVATIONS.
3509C                     --X      = THE LAB-ID VARIABLE
3510C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
3511C                                IN THE VECTOR Y.
3512C                     --ICASAN = SPECIFIES WHETHER MINIMUM OR MAXIMUM
3513C                                CASE IS DESIRED.
3514C     OUTPUT ARGUMENTS--XDIXON = THE SINGLE PRECISION VALUE OF THE
3515C                                COMPUTED DIXON STATISTIC.
3516C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
3517C             DIXON STATISTIC.
3518C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
3519C                   OF N FOR THIS SUBROUTINE.
3520C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
3521C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
3522C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
3523C     LANGUAGE--ANSI FORTRAN (1977)
3524C     WRITTEN BY--ALAN HECKERT
3525C                 STATISTICAL ENGINEERING DIVISION
3526C                 INFORMATION TECHNOLOGY LABORATORY
3527C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3528C                 GAITHERSBURG, MD 20899-8980
3529C                 PHONE--301-975-2899
3530C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3531C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
3532C     LANGUAGE--ANSI FORTRAN (1977)
3533C     VERSION NUMBER--2009.11
3534C     ORIGINAL VERSION--NOVEMBER  2009.
3535C
3536C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3537C
3538      CHARACTER*4 IWRITE
3539      CHARACTER*4 ICASAN
3540      CHARACTER*4 IWRTSV
3541      CHARACTER*4 ISUBRO
3542      CHARACTER*4 IBUGA3
3543      CHARACTER*4 IERROR
3544C
3545      CHARACTER*4 ISUBN1
3546      CHARACTER*4 ISUBN2
3547C
3548C---------------------------------------------------------------------
3549C
3550      DIMENSION Y(*)
3551      DIMENSION X(*)
3552      DIMENSION TEMP1(*)
3553C
3554C---------------------------------------------------------------------
3555C
3556      INCLUDE 'DPCOP2.INC'
3557C
3558C-----START POINT-----------------------------------------------------
3559C
3560      ISUBN1='DPDI'
3561      ISUBN2='X3  '
3562      IWRTSV=IWRITE
3563      XDIXON=CPUMIN
3564C
3565      IERROR='NO'
3566C
3567      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DIX3')THEN
3568        WRITE(ICOUT,999)
3569  999   FORMAT(1X)
3570        CALL DPWRST('XXX','BUG ')
3571        WRITE(ICOUT,51)
3572   51   FORMAT('***** AT THE BEGINNING OF DPDIX3--')
3573        CALL DPWRST('XXX','BUG ')
3574        WRITE(ICOUT,52)IBUGA3,ICASAN
3575   52   FORMAT('IBUGA3,ICASAN = ',A4,2X,A4)
3576        CALL DPWRST('XXX','BUG ')
3577        WRITE(ICOUT,53)N
3578   53   FORMAT('N = ',I8)
3579        CALL DPWRST('XXX','BUG ')
3580        DO55I=1,N
3581          WRITE(ICOUT,56)I,Y(I),X(I)
3582   56     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
3583          CALL DPWRST('XXX','BUG ')
3584   55   CONTINUE
3585      ENDIF
3586C
3587C               *******************************
3588C               **  COMPUTE DIXON STATISTIC  **
3589C               *******************************
3590C
3591C               ********************************************
3592C               **  STEP 1--                              **
3593C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
3594C               ********************************************
3595C
3596      IF(N.LT.3)THEN
3597        IERROR='YES'
3598        WRITE(ICOUT,999)
3599        CALL DPWRST('XXX','BUG ')
3600        WRITE(ICOUT,111)
3601  111   FORMAT('***** ERROR IN DIXON STATISTIC--')
3602        CALL DPWRST('XXX','BUG ')
3603        WRITE(ICOUT,112)
3604  112   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR THE ',
3605     1         'RESPONSE VARIABLE')
3606        CALL DPWRST('XXX','BUG ')
3607        WRITE(ICOUT,113)
3608  113   FORMAT('      MUST BE 3 OR LARGER.  SUCH WAS NOT THE CASE ',
3609     1         'HERE.')
3610        CALL DPWRST('XXX','BUG ')
3611        WRITE(ICOUT,117)N
3612  117   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS = ',I8,
3613     1         '.')
3614        CALL DPWRST('XXX','BUG ')
3615        GOTO9000
3616      ENDIF
3617C
3618      IF(N.GT.30)THEN
3619        IERROR='YES'
3620        WRITE(ICOUT,999)
3621        CALL DPWRST('XXX','BUG ')
3622        WRITE(ICOUT,111)
3623        CALL DPWRST('XXX','BUG ')
3624        WRITE(ICOUT,122)
3625  122   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR THE ',
3626     1         'RESPONSE VARIABLE')
3627        CALL DPWRST('XXX','BUG ')
3628        WRITE(ICOUT,123)
3629  123   FORMAT('      MUST BE LESS THAN OR EQUAL TO 30.  SUCH WAS ',
3630     1         'NOT THE CASE HERE.')
3631        CALL DPWRST('XXX','BUG ')
3632        WRITE(ICOUT,127)N
3633  127   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS = ',I8,
3634     1         '.')
3635        CALL DPWRST('XXX','BUG ')
3636        GOTO9000
3637      ENDIF
3638C               *****************************************
3639C               **  STEP 2--                           **
3640C               **  COMPUTE THE DIXON STATISTIC.       **
3641C               *****************************************
3642C
3643      CALL SORTC(Y,X,N,Y,TEMP1)
3644      DO130I=1,N
3645        X(I)=TEMP1(I)
3646  130 CONTINUE
3647C
3648      IF(N.GE.3 .AND. N.LE.7)THEN
3649C
3650C       CASE 1: 3 <= N <= 7
3651C
3652C               MINIMUM: R = (Y(2) - Y(1))/(Y(N) - Y(1))
3653C               MAXIMUM: R = (Y(N) - Y(N-1))/(Y(N) - Y(1))
3654C
3655        IF(ICASAN.EQ.'MINI')THEN
3656          ANUM=Y(2) - Y(1)
3657          ADEN=Y(N) - Y(1)
3658          IF(ADEN.LE.0.0)GOTO8000
3659          XDIXON=ANUM/ADEN
3660        ELSEIF(ICASAN.EQ.'MAXI')THEN
3661          ANUM=Y(N) - Y(N-1)
3662          ADEN=Y(N) - Y(1)
3663          IF(ADEN.LE.0.0)GOTO8000
3664          XDIXON=ANUM/ADEN
3665        ELSE
3666          ANUM=Y(2) - Y(1)
3667          ADEN=Y(N) - Y(1)
3668          IF(ADEN.LE.0.0)THEN
3669            XDIX1=CPUMIN
3670          ELSE
3671            XDIX1=ANUM/ADEN
3672          ENDIF
3673          ANUM=Y(N) - Y(N-1)
3674          ADEN=Y(N) - Y(1)
3675          IF(ADEN.LE.0.0)THEN
3676            XDIX2=CPUMIN
3677          ELSE
3678            XDIX2=ANUM/ADEN
3679          ENDIF
3680          XDIXON=MAX(XDIX1,XDIX2)
3681          IF(XDIXON.EQ.CPUMIN)GOTO8000
3682        ENDIF
3683C
3684      ELSEIF(N.GE.8 .AND. N.LE.10)THEN
3685C
3686C       CASE 2: 8 <= N <= 10
3687C
3688C               MINIMUM: R = (Y(2) - Y(1))/(Y(N-1) - Y(1))
3689C               MAXIMUM: R = (Y(N) - Y(N-1))/(Y(N) - Y(2))
3690C
3691        IF(ICASAN.EQ.'MINI')THEN
3692          ANUM=Y(2) - Y(1)
3693          ADEN=Y(N-1) - Y(1)
3694          IF(ADEN.LE.0.0)GOTO8000
3695          XDIXON=ANUM/ADEN
3696        ELSEIF(ICASAN.EQ.'MAXI')THEN
3697          ANUM=Y(N) - Y(N-1)
3698          ADEN=Y(N) - Y(2)
3699          IF(ADEN.LE.0.0)GOTO8000
3700          XDIXON=ANUM/ADEN
3701        ELSE
3702          ANUM=Y(2) - Y(1)
3703          ADEN=Y(N) - Y(1)
3704          IF(ADEN.LE.0.0)THEN
3705            XDIX1=CPUMIN
3706          ELSE
3707            XDIX1=ANUM/ADEN
3708          ENDIF
3709          ANUM=Y(N) - Y(N-1)
3710          ADEN=Y(N) - Y(1)
3711          IF(ADEN.LE.0.0)THEN
3712            XDIX2=CPUMIN
3713          ELSE
3714            XDIX2=ANUM/ADEN
3715          ENDIF
3716          XDIXON=MAX(XDIX1,XDIX2)
3717          IF(XDIXON.EQ.CPUMIN)GOTO8000
3718        ENDIF
3719C
3720      ELSEIF(N.GE.11 .AND. N.LE.13)THEN
3721C
3722C       CASE 3: 11 <= N <= 13
3723C
3724C               MINIMUM: R = (Y(3) - Y(1))/(Y(N-1) - Y(1))
3725C               MAXIMUM: R = (Y(N) - Y(N-2))/(Y(N) - Y(2))
3726C
3727        IF(ICASAN.EQ.'MINI')THEN
3728          ANUM=Y(3) - Y(1)
3729          ADEN=Y(N-1) - Y(1)
3730          IF(ADEN.LE.0.0)GOTO8000
3731          XDIXON=ANUM/ADEN
3732        ELSEIF(ICASAN.EQ.'MAXI')THEN
3733          ANUM=Y(N) - Y(N-2)
3734          ADEN=Y(N) - Y(2)
3735          IF(ADEN.LE.0.0)GOTO8000
3736          XDIXON=ANUM/ADEN
3737        ELSE
3738          ANUM=Y(3) - Y(1)
3739          ADEN=Y(N-1) - Y(1)
3740          IF(ADEN.LE.0.0)THEN
3741            XDIX1=CPUMIN
3742          ELSE
3743            XDIX1=ANUM/ADEN
3744          ENDIF
3745          ANUM=Y(N) - Y(N-2)
3746          ADEN=Y(N) - Y(2)
3747          IF(ADEN.LE.0.0)THEN
3748            XDIX2=CPUMIN
3749          ELSE
3750            XDIX2=ANUM/ADEN
3751          ENDIF
3752          XDIXON=MAX(XDIX1,XDIX2)
3753        ENDIF
3754C
3755      ELSEIF(N.GE.14 .AND. N.LE.30)THEN
3756C
3757C       CASE 4: 14 <= N <= 30
3758C
3759C               MINIMUM: R = (X(3) - X(1))/(X(N-2) - X(1))
3760C               MAXIMUM: R = (X(N) - X(N-2))/(X(N) - X(3))
3761C
3762        IF(ICASAN.EQ.'MINI')THEN
3763          ANUM=Y(3) - Y(1)
3764          ADEN=Y(N-2) - Y(1)
3765          IF(ADEN.LE.0.0)GOTO8000
3766          XDIXON=ANUM/ADEN
3767        ELSEIF(ICASAN.EQ.'MAXI')THEN
3768          ANUM=Y(N) - Y(N-2)
3769          ADEN=Y(N) - Y(3)
3770          IF(ADEN.LE.0.0)GOTO8000
3771          XDIXON=ANUM/ADEN
3772        ELSE
3773          ANUM=Y(3) - Y(1)
3774          ADEN=Y(N-2) - Y(1)
3775          IF(ADEN.LE.0.0)THEN
3776            XDIX1=CPUMIN
3777          ELSE
3778            XDIX1=ANUM/ADEN
3779          ENDIF
3780          ANUM=Y(N) - Y(N-2)
3781          ADEN=Y(N) - Y(3)
3782          IF(ADEN.LE.0.0)THEN
3783            XDIX2=CPUMIN
3784          ELSE
3785            XDIX2=ANUM/ADEN
3786          ENDIF
3787          XDIXON=MAX(XDIX1,XDIX2)
3788        ENDIF
3789C
3790      ENDIF
3791C
3792      GOTO9000
3793C
3794 8000 CONTINUE
3795      IERROR='YES'
3796      WRITE(ICOUT,999)
3797      CALL DPWRST('XXX','BUG ')
3798      WRITE(ICOUT,111)
3799      CALL DPWRST('XXX','BUG ')
3800      WRITE(ICOUT,8011)
3801 8011 FORMAT('      THE DENOMINATOR FOR THE DIXON TEST IS ZERO.  ',
3802     1       'UNABLE TO')
3803      CALL DPWRST('XXX','BUG ')
3804      WRITE(ICOUT,8013)
3805 8013 FORMAT('      TO COMPUTE THE DIXON STATISTIC.')
3806      CALL DPWRST('XXX','BUG ')
3807      GOTO9000
3808C
3809C               *****************
3810C               **  STEP 90--  **
3811C               **  EXIT.      **
3812C               *****************
3813C
3814 9000 CONTINUE
3815C
3816      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DIX3')THEN
3817        WRITE(ICOUT,999)
3818        CALL DPWRST('XXX','BUG ')
3819        WRITE(ICOUT,9011)
3820 9011   FORMAT('***** AT THE END       OF DPDIX3--')
3821        CALL DPWRST('XXX','BUG ')
3822        WRITE(ICOUT,9012)IBUGA3,IERROR
3823 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
3824        CALL DPWRST('XXX','BUG ')
3825        WRITE(ICOUT,9013)N
3826 9013   FORMAT('N = ',I8)
3827        CALL DPWRST('XXX','BUG ')
3828        WRITE(ICOUT,9015)ANUM,ADEN,XDIXON
3829 9015   FORMAT('ANUM,ADEN,XDIXON = ',3G15.7)
3830        CALL DPWRST('XXX','BUG ')
3831        WRITE(ICOUT,9016)Y(1),Y(2),Y(3)
3832 9016   FORMAT('Y(1),Y(2),Y(3) = ',3G15.7)
3833        CALL DPWRST('XXX','BUG ')
3834        WRITE(ICOUT,9017)Y(N),Y(N-1),Y(N-2)
3835 9017   FORMAT('Y(N),Y(N-1),Y(N-2) = ',3G15.7)
3836        CALL DPWRST('XXX','BUG ')
3837      ENDIF
3838C
3839      RETURN
3840      END
3841      SUBROUTINE DPDLPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,ISEED,
3842     1ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
3843C
3844C     PURPOSE--GENERATE A DETECTION LIMIT PLOT
3845C     EXAMPLE--DETECTION LIMIT PLOT IMS MASS VAL1
3846C              DETECTION LIMIT PLOT IMS MASS VAL1  VAL2
3847C              NOTE THAT VAL1 AND VAL2 DENOTE VALUES OF THE
3848C              MASS VARIABLE.  THERE MUST BE AT LEAST ONE VALUE
3849C              GIVEN AND CURRENTLY UP TO 5 VALUES MAY BE SPECIFIED.
3850C     REFERENCE--IMPLEMENTS A METHOD SUGGESTED BY
3851C                MICHAEL VERKOUTEREN OF THE NIST SURFACE AND
3852C                MICROANALYSIS SCIENCE DIVISION
3853C     WRITTEN BY--JAMES J. FILLIBEN
3854C                 STATISTICAL ENGINEERING DIVISION
3855C                 INFORMATION TECHNOLOGY LABORATROY
3856C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
3857C                 GAITHERSBURG, MD 20899-8980
3858C                 PHONE--301-975-2855
3859C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3860C           OF THE NATIONAL BUREAU OF STANDARDS.
3861C     LANGUAGE--ANSI FORTRAN (1977)
3862C     VERSION NUMBER--2008/12
3863C     ORIGINAL VERSION--DECEMBER  2008.
3864C
3865C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3866C
3867      CHARACTER*4 ICASPL
3868      CHARACTER*4 IAND1
3869      CHARACTER*4 IAND2
3870      CHARACTER*4 ISUBRO
3871      CHARACTER*4 IBUGG2
3872      CHARACTER*4 IBUGG3
3873      CHARACTER*4 IBUGQ
3874      CHARACTER*4 IFOUND
3875      CHARACTER*4 IERROR
3876C
3877      CHARACTER*4 IHWUSE
3878      CHARACTER*4 MESSAG
3879      CHARACTER*4 ICASEQ
3880      CHARACTER*4 IHLEFT
3881      CHARACTER*4 IHLEF2
3882      CHARACTER*4 IHRIGH
3883      CHARACTER*4 IHRIG2
3884      CHARACTER*4 IHBATC
3885      CHARACTER*4 IHBAT2
3886      CHARACTER*4 IERRO4
3887      CHARACTER*4 ISUBN1
3888      CHARACTER*4 ISUBN2
3889      CHARACTER*4 ISTEPN
3890      CHARACTER*4 IH41
3891      CHARACTER*4 IH42
3892      CHARACTER*4 IH
3893      CHARACTER*4 IH2
3894      CHARACTER*4 IHP
3895      CHARACTER*4 IHP2
3896      CHARACTER*4 ISUBN0
3897C
3898      REAL MUML
3899      REAL SDML
3900      REAL MUMLSE
3901      REAL SDMLSE
3902      REAL LOW05
3903C
3904C---------------------------------------------------------------------
3905C
3906      INCLUDE 'DPCOPA.INC'
3907C
3908      DIMENSION Y1(MAXOBV)
3909      DIMENSION X1(MAXOBV)
3910      DIMENSION TAG1(MAXOBV)
3911      DIMENSION XMATCH(MAXOBV)
3912      DIMENSION TEMP1(MAXOBV)
3913      DIMENSION TEMP2(MAXOBV)
3914      DIMENSION TEMP3(MAXOBV)
3915      DIMENSION TEMP4(MAXOBV)
3916      DIMENSION TEMP5(MAXOBV)
3917      DIMENSION QP(MAXOBV)
3918      DIMENSION XQPHAT(MAXOBV)
3919      DIMENSION XQPLCL(MAXOBV)
3920      DIMENSION XQPUCL(MAXOBV)
3921      INCLUDE 'DPCOZZ.INC'
3922      EQUIVALENCE (GARBAG(IGARB1),X1(1))
3923      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
3924      EQUIVALENCE (GARBAG(IGARB3),TAG1(1))
3925      EQUIVALENCE (GARBAG(IGARB4),XMATCH(1))
3926      EQUIVALENCE (GARBAG(IGARB5),TEMP1(1))
3927      EQUIVALENCE (GARBAG(IGARB6),TEMP2(1))
3928      EQUIVALENCE (GARBAG(IGARB7),TEMP3(1))
3929      EQUIVALENCE (GARBAG(IGARB8),TEMP4(1))
3930      EQUIVALENCE (GARBAG(IGARB9),TEMP5(1))
3931      EQUIVALENCE (GARBAG(IGAR10),QP(1))
3932      EQUIVALENCE (GARBAG(JGAR11),XQPHAT(1))
3933      EQUIVALENCE (GARBAG(JGAR12),XQPLCL(1))
3934      EQUIVALENCE (GARBAG(JGAR13),XQPUCL(1))
3935C
3936C-----COMMON----------------------------------------------------------
3937C
3938      INCLUDE 'DPCOST.INC'
3939      INCLUDE 'DPCOHK.INC'
3940      INCLUDE 'DPCODA.INC'
3941      INCLUDE 'DPCOHO.INC'
3942      INCLUDE 'DPCOP2.INC'
3943C
3944C-----START POINT-----------------------------------------------------
3945C
3946      IFOUND='NO'
3947      IERROR='NO'
3948      ISUBN1='DPDL'
3949      ISUBN2='PL  '
3950C
3951      MAXCP1=MAXCOL+1
3952      MAXCP2=MAXCOL+2
3953      MAXCP3=MAXCOL+3
3954      MAXCP4=MAXCOL+4
3955      MAXCP5=MAXCOL+5
3956      MAXCP6=MAXCOL+6
3957C
3958      MAXV2=2
3959      IF(ICASPL.EQ.'BSPL')MAXV2=3
3960      MINN2=2
3961      ICOLR=0
3962C
3963C               **********************************************
3964C               **  TREAT THE DETECTION LIMIT PLOT          **
3965C               **********************************************
3966C
3967      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DLPL')THEN
3968        WRITE(ICOUT,999)
3969        CALL DPWRST('XXX','BUG ')
3970        WRITE(ICOUT,51)
3971   51   FORMAT('***** AT THE BEGINNING OF DPDLPL--')
3972        CALL DPWRST('XXX','BUG ')
3973        WRITE(ICOUT,52)ICASPL,IAND1,IAND2,ISEED
3974   52   FORMAT('ICASPL,IAND1,IAND2,ISEED = ',3(A4,2X),I8)
3975        CALL DPWRST('XXX','BUG ')
3976        WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
3977   53   FORMAT('IBUGG2,IBUGG3,IBUGQ = ',2(A4,2X),A4)
3978        CALL DPWRST('XXX','BUG ')
3979      ENDIF
3980C
3981C               ***************************
3982C               **  STEP 1--             **
3983C               **  EXTRACT THE COMMAND  **
3984C               ***************************
3985C
3986      ISTEPN='1'
3987      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')
3988     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3989C
3990      IF(ICOM.EQ.'DETE'.AND.IHARG(1).EQ.'LIMI'.AND.
3991     1   IHARG(2).EQ.'PLOT')THEN
3992        ICASPL='DLPL'
3993        ILASTC=2
3994        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
3995        IFOUND='YES'
3996      ELSEIF(ICOM.EQ.'NORM'.AND.IHARG(1).EQ.'DETE'.AND.
3997     1   IHARG(2).EQ.'LIMI'.AND.IHARG(3).EQ.'PLOT')THEN
3998        ICASPL='DLPL'
3999        ILASTC=3
4000        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
4001        IFOUND='YES'
4002      ELSE
4003        IFOUND='NO'
4004        GOTO9000
4005      ENDIF
4006C
4007C               *******************************************************
4008C               **  STEP 2--                                         **
4009C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
4010C               *******************************************************
4011C
4012      ISTEPN='1'
4013      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')
4014     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4015C
4016      MINNA=3
4017      MAXNA=100
4018      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
4019      IF(IERROR.EQ.'YES')GOTO9000
4020C
4021C               ********************************************
4022C               **  STEP 2--                              **
4023C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
4024C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
4025C               ********************************************
4026C
4027      ISTEPN='2'
4028      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')
4029     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4030C
4031      IHLEFT=IHARG(1)
4032      IHLEF2=IHARG2(1)
4033      IHWUSE='V'
4034      MESSAG='YES'
4035      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
4036     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
4037     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
4038      IF(IERROR.EQ.'YES')GOTO9000
4039      ICOLL=IVALUE(ILOCV)
4040      NLEFT=IN(ILOCV)
4041C
4042      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')THEN
4043        WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
4044  211   FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
4045        CALL DPWRST('XXX','BUG ')
4046      ENDIF
4047C
4048C               ******************************************************
4049C               **  STEP 3--                                        **
4050C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
4051C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS POSITIVE.  **
4052C               ******************************************************
4053C
4054      ISTEPN='3'
4055      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')
4056     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4057C
4058      IF(NLEFT.LT.MINN2)THEN
4059        WRITE(ICOUT,999)
4060  999   FORMAT(1X)
4061        CALL DPWRST('XXX','BUG ')
4062        WRITE(ICOUT,311)
4063  311   FORMAT('***** ERROR IN DETECTION LIMIT PLOT--')
4064        CALL DPWRST('XXX','BUG ')
4065        WRITE(ICOUT,312)
4066  312   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
4067        CALL DPWRST('XXX','BUG ')
4068        WRITE(ICOUT,314)MINN2
4069  314   FORMAT('      DETECTION LIMIT PLOT WAS TO HAVE BEEN FORMED ',
4070     1         'MUST BE ',I8)
4071        CALL DPWRST('XXX','BUG ')
4072        WRITE(ICOUT,316)
4073  316   FORMAT('      OR LARGER;  SUCH WAS NOT THE CASE HERE.')
4074        CALL DPWRST('XXX','BUG ')
4075        WRITE(ICOUT,317)
4076  317   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
4077        CALL DPWRST('XXX','BUG ')
4078        IF(IWIDTH.GE.1)THEN
4079          WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
4080  318     FORMAT(80A1)
4081          CALL DPWRST('XXX','BUG ')
4082        ENDIF
4083        IERROR='YES'
4084        GOTO9000
4085      ENDIF
4086C
4087C               *****************************************
4088C               **  STEP 4--                           **
4089C               **  CHECK TO SEE THE TYPE SUBCASE      **
4090C               **  (BASED ON THE QUALIFIER)--         **
4091C               **    1) UNQUALIFIED (THAT IS, FULL);  **
4092C               **    2) SUBSET/EXCEPT; OR             **
4093C               **    3) FOR.                          **
4094C               *****************************************
4095C
4096      ISTEPN='4'
4097      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')
4098     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4099C
4100      ICASEQ='FULL'
4101      ILOCQ=NUMARG+1
4102      IF(NUMARG.LT.1)GOTO480
4103      DO400J=1,NUMARG
4104      J1=J
4105      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
4106      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
4107      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
4108  400 CONTINUE
4109      GOTO490
4110  410 CONTINUE
4111      ICASEQ='SUBS'
4112      ILOCQ=J1
4113      GOTO490
4114  420 CONTINUE
4115      ICASEQ='FOR'
4116      ILOCQ=J1
4117      GOTO490
4118C
4119  480 CONTINUE
4120      WRITE(ICOUT,999)
4121      CALL DPWRST('XXX','BUG ')
4122      WRITE(ICOUT,481)
4123  481 FORMAT('***** INTERNAL ERROR IN DPDLPL')
4124      CALL DPWRST('XXX','BUG ')
4125      WRITE(ICOUT,482)
4126  482 FORMAT('      AT BRANCH POINT 481--')
4127      CALL DPWRST('XXX','BUG ')
4128      WRITE(ICOUT,483)
4129  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
4130      CALL DPWRST('XXX','BUG ')
4131      WRITE(ICOUT,484)
4132  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
4133      CALL DPWRST('XXX','BUG ')
4134      WRITE(ICOUT,485)NUMARG
4135  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
4136      CALL DPWRST('XXX','BUG ')
4137      WRITE(ICOUT,317)
4138      CALL DPWRST('XXX','BUG ')
4139      IF(IWIDTH.GE.1)THEN
4140        WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
4141        CALL DPWRST('XXX','BUG ')
4142      ENDIF
4143      IERROR='YES'
4144      GOTO9000
4145C
4146  490 CONTINUE
4147      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DLPL')THEN
4148        WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
4149  491   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
4150        CALL DPWRST('XXX','BUG ')
4151      ENDIF
4152C
4153C               ******************************************************
4154C               **  STEP 5--                                        **
4155C               **  DETERMINE HOW MANY ARGUMENTS THERE ARE          **
4156C               **  NOT INCLUDING <SUBSET/EXCEPT/FOR>.  THE         **
4157C               **  SECOND ARGUMENT MUST BE A VARIABLE WHILE        **
4158C               **  ARGUMENTS THREE AND ABOVE SHOULD BE             **
4159C               **  SCALARS.  VARIABLE TWO SHOULD BE THE SAME       **
4160C               **  SIZE AS VARIABLE ONE.                           **
4161C               ******************************************************
4162C
4163      ISTEPN='5'
4164      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')
4165     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4166C
4167      NUMV2=ILOCQ-1
4168      IF(NUMV2.LT.3)THEN
4169        WRITE(ICOUT,311)
4170        CALL DPWRST('XXX','BUG ')
4171        WRITE(ICOUT,501)
4172  501   FORMAT('      THE NUMBER OF INPUT ARGUMENTS MUST BE AT LEAST')
4173        CALL DPWRST('XXX','BUG ')
4174        WRITE(ICOUT,502)NUMV2
4175  502   FORMAT('      THREE.  ONLY ',I5,' ARGUMENTS GIVEN HERE.')
4176        CALL DPWRST('XXX','BUG ')
4177        WRITE(ICOUT,317)
4178        CALL DPWRST('XXX','BUG ')
4179        IF(IWIDTH.GE.1)THEN
4180          WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
4181          CALL DPWRST('XXX','BUG ')
4182        ENDIF
4183        IERROR='YES'
4184        GOTO9000
4185      ENDIF
4186C
4187      IHRIGH=IHARG(2)
4188      IHRIG2=IHARG2(2)
4189      IHWUSE='V'
4190      MESSAG='YES'
4191      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
4192     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
4193     1            NUMNAM,MAXNAM,
4194     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
4195      IF(IERROR.EQ.'YES')GOTO9000
4196      ICOLR=IVALUE(ILOCV)
4197      NRIGHT=IN(ILOCV)
4198C
4199      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')THEN
4200        WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
4201  511   FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,2I8)
4202        CALL DPWRST('XXX','BUG ')
4203      ENDIF
4204C
4205      IF(NRIGHT.NE.NLEFT)THEN
4206        WRITE(ICOUT,999)
4207        CALL DPWRST('XXX','BUG ')
4208        WRITE(ICOUT,311)
4209        CALL DPWRST('XXX','BUG ')
4210        WRITE(ICOUT,572)
4211  572   FORMAT('      FOR A DETECTION LIMIT PLOT, WHEN WE HAVE TWO ',
4212     1         'VARIABLES')
4213        CALL DPWRST('XXX','BUG ')
4214        WRITE(ICOUT,579)
4215  579   FORMAT('      SPECIFIED, THE NUMBER OF ELEMENTS IN THE TWO')
4216        CALL DPWRST('XXX','BUG ')
4217        WRITE(ICOUT,581)
4218  581   FORMAT('      VARIABLES MUST BE THE SAME;  SUCH WAS NOT ',
4219     1         'THE CASE HERE.')
4220        CALL DPWRST('XXX','BUG ')
4221        WRITE(ICOUT,999)
4222        CALL DPWRST('XXX','BUG ')
4223        WRITE(ICOUT,583)
4224  583   FORMAT('      THE FIRST  VARIABLE  (FREQUENCIES)--')
4225        CALL DPWRST('XXX','BUG ')
4226        WRITE(ICOUT,584)IHLEFT,IHLEF2,NLEFT
4227  584   FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
4228        CALL DPWRST('XXX','BUG ')
4229        WRITE(ICOUT,585)
4230  585   FORMAT('      THE SECOND VARIABLE  (HORIZ. AXIS VALUES)--')
4231        CALL DPWRST('XXX','BUG ')
4232        WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT
4233  586   FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
4234        CALL DPWRST('XXX','BUG ')
4235        WRITE(ICOUT,999)
4236        CALL DPWRST('XXX','BUG ')
4237        WRITE(ICOUT,317)
4238        CALL DPWRST('XXX','BUG ')
4239        IF(IWIDTH.GE.1)THEN
4240          WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
4241          CALL DPWRST('XXX','BUG ')
4242        ENDIF
4243        IERROR='YES'
4244        GOTO9000
4245      ENDIF
4246C
4247C               ******************************************************
4248C               **  STEP 6--                                        **
4249C               **  EXTRACT THE ARGUMENTS 3 AND ABOVE AS SCALARS.   **
4250C               ******************************************************
4251C
4252      NPAR=0
4253      DO610I=3,NUMV2
4254        IHWUSE='P'
4255        MESSAG='YES'
4256        IHBATC=IHARG(I)
4257        IHBAT2=IHARG2(I)
4258        CALL CHECKN(IHBATC,IHBAT2,IHWUSE,
4259     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
4260     1              NUMNAM,MAXNAM,
4261     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
4262        IF(IERROR.EQ.'YES')GOTO9000
4263        NPAR=NPAR+1
4264        XMATCH(NPAR)=VALUE(ILOCV)
4265C
4266        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')THEN
4267          WRITE(ICOUT,611)IHBATC,IHBAT2,NPAR,XMATCH(NPAR)
4268  611     FORMAT('IHBATCH,IHBAT2,NPAR,XMATCH(NPAR) = ',A4,A4,I8,G15.7)
4269          CALL DPWRST('XXX','BUG ')
4270        ENDIF
4271C
4272  610 CONTINUE
4273C
4274C               *****************************************
4275C               **  STEP 7--                           **
4276C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
4277C               **  (BASED ON THE QUALIFIER)           **
4278C               **  THEN FORM THE RESPONSE VARIABLE    **
4279C               **  AND THE FACTORS                    **
4280C               **  AND CARRY OUT THE PLOTS.           **
4281C               *****************************************
4282C
4283      ISTEPN='7'
4284      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')
4285     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4286C
4287      IF(ICASEQ.EQ.'FULL')GOTO710
4288      IF(ICASEQ.EQ.'SUBS')GOTO720
4289      IF(ICASEQ.EQ.'FOR')GOTO730
4290C
4291  710 CONTINUE
4292      DO715I=1,NLEFT
4293      ISUB(I)=1
4294  715 CONTINUE
4295      NQ=NLEFT
4296      GOTO750
4297C
4298  720 CONTINUE
4299      NIOLD=NLEFT
4300      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
4301      NQ=NIOLD
4302      GOTO750
4303C
4304  730 CONTINUE
4305      NIOLD=NLEFT
4306      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
4307     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
4308      NQ=NFOR
4309      GOTO750
4310C
4311  750 CONTINUE
4312C
4313      J=0
4314      IMAX=NLEFT
4315      IF(NQ.LT.NLEFT)IMAX=NQ
4316      DO810I=1,IMAX
4317        IF(ISUB(I).EQ.0)GOTO810
4318        J=J+1
4319        IJ=MAXN*(ICOLL-1)+I
4320        IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
4321        IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
4322        IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
4323        IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
4324        IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
4325        IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
4326        IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
4327C
4328        IJ=MAXN*(ICOLR-1)+I
4329        IF(ICOLR.LE.MAXCOL)X1(J)=V(IJ)
4330        IF(ICOLR.EQ.MAXCP1)X1(J)=PRED(I)
4331        IF(ICOLR.EQ.MAXCP2)X1(J)=RES(I)
4332        IF(ICOLR.EQ.MAXCP3)X1(J)=YPLOT(I)
4333        IF(ICOLR.EQ.MAXCP4)X1(J)=XPLOT(I)
4334        IF(ICOLR.EQ.MAXCP5)X1(J)=X2PLOT(I)
4335        IF(ICOLR.EQ.MAXCP6)X1(J)=TAGPLO(I)
4336C
4337  810 CONTINUE
4338      NLOCAL=J
4339C
4340C               ******************************************************
4341C               **  STEP 8B--                                       **
4342C               **  CHECK TO SEE IF A "PERCENTILES" VARIABLE HAS    **
4343C               **  BEEN SPECIFIED (VIA THE SET MAXIMIM LIKELIHOOD  **
4344C               **  PERCENTILES COMMAND).  IF SO, EXTRACT THE NAME. **
4345C               ******************************************************
4346C
4347      ISTEPN='8B'
4348      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DLPL')
4349     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4350C
4351      IF(IQUAVR.EQ.'NONE')THEN
4352        NPERC=0
4353      ELSEIF(IQUAVR.EQ.'DEFAULT')THEN
4354        QP(1)=0.5
4355        QP(2)=1.0
4356        QP(3)=5.0
4357        QP(4)=10.0
4358        QP(5)=20.0
4359        QP(6)=30.0
4360        QP(7)=40.0
4361        QP(8)=50.0
4362        QP(9)=60.0
4363        QP(10)=70.0
4364        QP(11)=80.0
4365        QP(12)=90.0
4366        QP(13)=95.0
4367        QP(14)=97.5
4368        QP(15)=99.0
4369        QP(16)=99.5
4370        NPERC=16
4371      ELSE
4372        IH41=IQUAVR(1:4)
4373        IH42=IQUAVR(5:8)
4374        IHWUSE='V'
4375        MESSAG='NO'
4376        CALL CHECKN(IH41,IH42,IHWUSE,
4377     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
4378     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
4379C
4380        IF(IERROR.EQ.'YES')THEN
4381          NPERC=0
4382        ELSE
4383          ICOLQP=IVALUE(ILOCV)
4384          NPERC=IN(ILOCV)
4385          ICNT=0
4386          DO860I=1,NPERC
4387            IJ=MAXN*(ICOLQP-1)+I
4388            ICNT=ICNT+1
4389            IF(ICOLQP.LE.MAXCOL)QP(ICNT)=V(IJ)
4390            IF(ICOLQP.EQ.MAXCP1)QP(ICNT)=PRED(I)
4391            IF(ICOLQP.EQ.MAXCP2)QP(ICNT)=RES(I)
4392            IF(ICOLQP.EQ.MAXCP3)QP(ICNT)=YPLOT(I)
4393            IF(ICOLQP.EQ.MAXCP4)QP(ICNT)=XPLOT(I)
4394            IF(ICOLQP.EQ.MAXCP5)QP(ICNT)=X2PLOT(I)
4395            IF(ICOLQP.EQ.MAXCP6)QP(ICNT)=TAGPLO(I)
4396            IF(QP(ICNT).LE.0.0 .OR. QP(ICNT).GE.100.0)THEN
4397              ICNT=ICNT-1
4398            ENDIF
4399  860     CONTINUE
4400          NPERC=ICNT
4401C
4402        ENDIF
4403      ENDIF
4404C
4405      IHP='ALPH'
4406      IHP2='A   '
4407      IHWUSE='P'
4408      MESSAG='NO'
4409      CALL CHECKN(IHP,IHP2,IHWUSE,
4410     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
4411     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
4412      ALPHA=0.05
4413      IF(IERROR.EQ.'NO')ALPHA=VALUE(ILOCP)
4414      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
4415        ALPHA=0.05
4416      ELSEIF(ALPHA.GT.0.50)THEN
4417        ALPHA=1.0-ALPHA
4418      ENDIF
4419C
4420      IHP='THRE'
4421      IHP2='SHHO'
4422      IHWUSE='P'
4423      MESSAG='NO'
4424      CALL CHECKN(IHP,IHP2,IHWUSE,
4425     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
4426     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
4427      THRESH=CPUMIN
4428      IF(IERROR.EQ.'NO')THRESH=VALUE(ILOCP)
4429C
4430C               *****************************************************
4431C               **  STEP 9--                                       **
4432C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
4433C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
4434C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
4435C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
4436C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
4437C               *****************************************************
4438C
4439      ISTEPN='9'
4440      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DLPL')
4441     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4442C
4443      CALL DPDLP2(Y1,X1,NLOCAL,XMATCH,NPAR,
4444     1            ICASPL,IHLEFT,IHLEF2,IHRIGH,IHRIG2,ALPHA,
4445     1            TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
4446     1            QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
4447     1            UPP95,LOW05,CDFTHR,
4448     1            MUML,SDML,
4449     1            MUMLSE,SDMLSE,COVSE,ACORR,
4450     1            NPOS,NZERO,
4451     1            YMEAN1,YSD1,YMIN1,THRESH,PRZERO,
4452     1            Y,X,D,NPLOTP,NPLOTV,ISUBRO,IBUGG3,IERROR)
4453C
4454C               ***************************************
4455C               **  STEP 10--                        **
4456C               **  UPDATE INTERNAL DATAPLOT TABLES  **
4457C               ***************************************
4458C
4459      IH='MUML'
4460      IH2='    '
4461      VALUE0=MUML
4462      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4463     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4464     1IANS,IWIDTH,IBUGG3,IERROR)
4465C
4466      IH='MUML'
4467      IH2='SE  '
4468      VALUE0=MUMLSE
4469      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4470     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4471     1IANS,IWIDTH,IBUGG3,IERROR)
4472C
4473      IH='SDML'
4474      IH2='    '
4475      VALUE0=SDML
4476      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4477     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4478     1IANS,IWIDTH,IBUGG3,IERROR)
4479C
4480      IH='SDML'
4481      IH2='SE  '
4482      VALUE0=SDMLSE
4483      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4484     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4485     1IANS,IWIDTH,IBUGG3,IERROR)
4486C
4487      IH='COVS'
4488      IH2='E   '
4489      VALUE0=COVSE
4490      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4491     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4492     1IANS,IWIDTH,IBUGG3,IERROR)
4493C
4494      IH='CORR'
4495      IH2='SE  '
4496      VALUE0=ACORR
4497      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4498     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4499     1IANS,IWIDTH,IBUGG3,IERROR)
4500C
4501      IH='TRUN'
4502      IH2='MEAN'
4503      VALUE0=YMEAN1
4504      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4505     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4506     1IANS,IWIDTH,IBUGG3,IERROR)
4507C
4508      IH='TRUN'
4509      IH2='SD  '
4510      VALUE0=YSD1
4511      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4512     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4513     1IANS,IWIDTH,IBUGG3,IERROR)
4514C
4515      IH='TRUN'
4516      IH2='MINI'
4517      VALUE0=YMIN1
4518      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4519     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4520     1IANS,IWIDTH,IBUGG3,IERROR)
4521C
4522      IH='PZER'
4523      IH2='O   '
4524      VALUE0=PRZERO
4525      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4526     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4527     1IANS,IWIDTH,IBUGG3,IERROR)
4528C
4529      IH='NUMB'
4530      IH2='TRUN'
4531      VALUE0=NZERO
4532      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4533     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4534     1IANS,IWIDTH,IBUGG3,IERROR)
4535C
4536      IH='NUMB'
4537      IH2='POSI'
4538      VALUE0=NPOS
4539      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4540     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4541     1IANS,IWIDTH,IBUGG3,IERROR)
4542C
4543      IH='THRE'
4544      IH2='SHOU'
4545      VALUE0=THRESH
4546      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4547     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4548     1IANS,IWIDTH,IBUGG3,IERROR)
4549C
4550      IH='UPP9'
4551      IH2='5CV '
4552      VALUE0=UPP95
4553      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4554     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4555     1IANS,IWIDTH,IBUGG3,IERROR)
4556C
4557      IH='LOW0'
4558      IH2='5CV '
4559      VALUE0=LOW05
4560      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4561     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4562     1IANS,IWIDTH,IBUGG3,IERROR)
4563C
4564      IH='CDFT'
4565      IH2='HRES'
4566      VALUE0=CDFTHR
4567      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
4568     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
4569     1IANS,IWIDTH,IBUGG3,IERROR)
4570C
4571C               *****************
4572C               **  STEP 90--  **
4573C               **  EXIT       **
4574C               *****************
4575C
4576 9000 CONTINUE
4577      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DLPL')THEN
4578        WRITE(ICOUT,999)
4579        CALL DPWRST('XXX','BUG ')
4580        WRITE(ICOUT,9011)
4581 9011   FORMAT('***** AT THE END       OF DPDLPL--')
4582        CALL DPWRST('XXX','BUG ')
4583        WRITE(ICOUT,9012)IFOUND,IERROR
4584 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
4585        CALL DPWRST('XXX','BUG ')
4586        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
4587 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
4588     1         I8,I8,I8,2X,A4,2X,A4,2X,A4)
4589        CALL DPWRST('XXX','BUG ')
4590        IF(NPLOTP.GE.1)THEN
4591          DO9015I=1,NPLOTP
4592            WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
4593 9016       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
4594            CALL DPWRST('XXX','BUG ')
4595 9015     CONTINUE
4596        ENDIF
4597      ENDIF
4598C
4599      RETURN
4600      END
4601      SUBROUTINE DPDLP2(Y,X,N,XMATCH,NPAR,
4602     1                  ICASPL,
4603     1                  IHLEFT,IHLEF2,IHRIGH,IHRIG2,ALPCV,
4604     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
4605     1                  QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
4606     1                  UPP95,LOW05,CDFTHR,
4607     1                  MUML,SDML,
4608     1                  MUMLSE,SDMLSE,COVSE,ACORR,
4609     1                  NPOS,NZERO,
4610     1                  YMEAN1,YSD1,YMIN1,THRESH,PRZERO,
4611     1                  Y2,X2,D2,N2,NPLOTV,ISUBRO,IBUGG3,IERROR)
4612C
4613C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
4614C              THAT WILL DEFINE A DETECTION LIMIT PLOT.
4615C     REFERENCE--CLIFFORD COHEN (1991), "TRUNCATED AND CENSORED
4616C                SAMPLES", MARCEL DEKKER INC., CHAPTER 2.
4617C     WRITTEN BY--JAMES J. FILLIBEN
4618C                 STATISTICAL ENGINEERING DIVISION
4619C                 INFORMATION TECHNOLOGY LABORATORY
4620C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4621C                 GAITHERSBURG, MD 20899-8980
4622C                 PHONE--301-975-2855
4623C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4624C           OF THE NATIONAL BUREAU OF STANDARDS.
4625C     LANGUAGE--ANSI FORTRAN (1977)
4626C     VERSION NUMBER--2008/12
4627C     ORIGINAL VERSION--DECEMBER  2008.
4628C
4629C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4630C
4631      CHARACTER*4 ICASPL
4632      CHARACTER*4 IHLEFT
4633      CHARACTER*4 IHLEF2
4634      CHARACTER*4 IHRIGH
4635      CHARACTER*4 IHRIG2
4636      CHARACTER*4 ISUBRO
4637      CHARACTER*4 IBUGG3
4638      CHARACTER*4 IERROR
4639C
4640      CHARACTER*4 IWRITE
4641      CHARACTER*4 ISUBN1
4642      CHARACTER*4 ISUBN2
4643      CHARACTER*4 IOP
4644C
4645C---------------------------------------------------------------------
4646C
4647      DIMENSION Y(*)
4648      DIMENSION X(*)
4649      DIMENSION XMATCH(*)
4650      DIMENSION TEMP1(*)
4651      DIMENSION TEMP2(*)
4652      DIMENSION TEMP3(*)
4653      DIMENSION TEMP4(*)
4654      DIMENSION TEMP5(*)
4655      DIMENSION QP(*)
4656      DIMENSION XQPHAT(*)
4657      DIMENSION XQPLCL(*)
4658      DIMENSION XQPUCL(*)
4659      DIMENSION Y2(*)
4660      DIMENSION X2(*)
4661      DIMENSION D2(*)
4662C
4663      PARAMETER (NUMALP=6)
4664      DIMENSION ALPHA(NUMALP)
4665      DIMENSION ALOWSC(NUMALP)
4666      DIMENSION AUPPSC(NUMALP)
4667      DIMENSION ALOWLO(NUMALP)
4668      DIMENSION AUPPLO(NUMALP)
4669      DIMENSION COV(2,2)
4670      DIMENSION D(2)
4671C
4672      DOUBLE PRECISION DPDF
4673      DOUBLE PRECISION DPPF
4674      DOUBLE PRECISION DP
4675      DOUBLE PRECISION DMU
4676      DOUBLE PRECISION DSD
4677      DOUBLE PRECISION DARG1
4678C
4679      REAL MUML
4680      REAL SDML
4681      REAL MUMLSE
4682      REAL SDMLSE
4683      REAL COVSE
4684      REAL ACORR
4685      REAL THRESH
4686      REAL ALPHA
4687      REAL LOW05
4688C
4689      INCLUDE 'DPCOPA.INC'
4690      INCLUDE 'DPCOF2.INC'
4691      INCLUDE 'DPCOP2.INC'
4692C
4693C-----START POINT-----------------------------------------------------
4694C
4695      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
4696C
4697      ISUBN1='DPDL'
4698      ISUBN2='P2  '
4699      IERROR='NO'
4700      IWRITE='OFF'
4701C
4702C               ********************************************
4703C               **  STEP 1--                              **
4704C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
4705C               ********************************************
4706C
4707      IF(N.LE.2)THEN
4708        WRITE(ICOUT,999)
4709  999   FORMAT(1X)
4710        CALL DPWRST('XXX','BUG ')
4711        WRITE(ICOUT,31)
4712   31   FORMAT('***** ERROR IN DETECTION LIMIT PLOT--')
4713        CALL DPWRST('XXX','BUG ')
4714        WRITE(ICOUT,32)
4715   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
4716        CALL DPWRST('XXX','BUG ')
4717        WRITE(ICOUT,33)
4718   33   FORMAT('      MUST BE AT LEAST 1;')
4719        CALL DPWRST('XXX','BUG ')
4720        WRITE(ICOUT,34)N
4721   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
4722        CALL DPWRST('XXX','BUG ')
4723        WRITE(ICOUT,999)
4724        CALL DPWRST('XXX','BUG ')
4725        IERROR='YES'
4726        GOTO9000
4727      ENDIF
4728C
4729C     CHECK FOR NEGATIVE VALUES IN THE RESPONSE VARIABLE AND
4730C     DEFINE VALUE OF TEMP1:
4731C
4732C       1 - POSITIVE VALUE FOR AN INCLUDED GROUP
4733C       2 - ZERO VALUE FOR AN INCLUDED GROUP
4734C       3 - POSITIVE VALUE FOR MEMBER OF EXCLUDED GROUP (USE TO COMPUTE
4735C           MAXIMUM VALUE FOR THRESHOLD)
4736C       4 - ZERO VALUE FOR MEMBER OF EXCLUDED GROUP
4737C
4738      EPS=0.000001
4739      DO40I=1,N
4740        IF(Y(I).LT.0.0)THEN
4741          WRITE(ICOUT,999)
4742          CALL DPWRST('XXX','BUG ')
4743          WRITE(ICOUT,31)
4744          CALL DPWRST('XXX','BUG ')
4745          WRITE(ICOUT,41)
4746   41     FORMAT('      A NEGATIVE VALUE WAS ENCOUNTERED IN THE ',
4747     1           'RESPONSE VARIABLE.')
4748          CALL DPWRST('XXX','BUG ')
4749          WRITE(ICOUT,999)
4750          WRITE(ICOUT,43)I,Y(I)
4751   43     FORMAT('      A NEGATIVE VALUE WAS ENCOUNTERED IN THE ',
4752     1           'RESPONSE VARIABLE.')
4753          CALL DPWRST('XXX','BUG ')
4754          IERROR='YES'
4755          GOTO9000
4756        ELSE
4757          TEMP1(I)=1.0
4758          AINC=0.0
4759          IF(ABS(Y(I)).LE.EPS)AINC=1.0
4760          IFLAG=0
4761          DO50J=1,NPAR
4762            IF(X(I).EQ.XMATCH(J))IFLAG=1
4763   50     CONTINUE
4764          IF(IFLAG.EQ.0)TEMP1(I)=3.0
4765          TEMP1(I)=TEMP1(I)+AINC
4766        ENDIF
4767   40 CONTINUE
4768C
4769      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'DLP2')THEN
4770        WRITE(ICOUT,999)
4771        CALL DPWRST('XXX','BUG ')
4772        WRITE(ICOUT,70)
4773   70   FORMAT('***** AT THE BEGINNING OF DPDLP2--')
4774        CALL DPWRST('XXX','BUG ')
4775        WRITE(ICOUT,71)ICASPL,N,NPAR
4776   71   FORMAT('ICASPL,N,NPAR = ',A4,2X,2X,2I8)
4777        CALL DPWRST('XXX','BUG ')
4778        DO73I=1,N
4779          WRITE(ICOUT,74)I,Y(I),X(I),TEMP1(I)
4780   74     FORMAT('I,Y(I),X(I),TEMP1(I) = ',I8,3G15.7)
4781          CALL DPWRST('XXX','BUG ')
4782   73   CONTINUE
4783        DO83I=1,NPAR
4784          WRITE(ICOUT,84)I,XMATCH(I)
4785   84     FORMAT('I,XMATCH(I) = ',I8,G15.7)
4786          CALL DPWRST('XXX','BUG ')
4787   83   CONTINUE
4788        WRITE(ICOUT,85)IHLEFT,IHLEF2,IHRIGH,IHRIG2
4789   85   FORMAT('IHLEFT,IHLEF2,IHRIGH,IHRIG2 = ',3(A4,2X),A4)
4790        CALL DPWRST('XXX','BUG ')
4791      ENDIF
4792C
4793C               **********************************************
4794C               **  STEP 2--                                **
4795C               **  COMPUTE SUMMARY STATISTICS              **
4796C               **********************************************
4797C
4798C      1 - MEAN OF DATA IN INCLUDED GROUP THAT IS > 0
4799C      2 - SD OF DATA IN INCLUDED GROUP THAT IS > 0
4800C      3 - NUMBER OF NON-ZERO VALUES IN INCLUDED GROUP
4801C      4 - NUMBER OF ZERO VALUES IN INCLUDED GROUP
4802C      5 - MINIMUM OF NON-ZERO DATA FOR ALL GROUPS
4803C      6 - ESTIMATED THRESHOLD
4804C
4805      NZERO=0
4806      NPOS=0
4807      YMIN1=CPUMAX
4808C
4809      ICNT=0
4810      DO1010I=1,N
4811        IF(TEMP1(I).EQ.1.0)THEN
4812          NPOS=NPOS+1
4813          TEMP2(NPOS)=Y(I)
4814          ICNT=ICNT+1
4815          TEMP3(ICNT)=Y(I)
4816          TEMP4(ICNT)=1.0
4817        ELSEIF(TEMP1(I).EQ.2.0)THEN
4818          NZERO=NZERO+1
4819          ICNT=ICNT+1
4820          TEMP3(ICNT)=Y(I)
4821          TEMP4(ICNT)=0.0
4822        ENDIF
4823        IF(Y(I).GT.0.0 .AND. Y(I).LT.YMIN1)YMIN1=Y(I)
4824        IF(Y(I).GT.YMIN1 .AND. Y(I).LT.YMIN2)YMIN2=Y(I)
4825 1010 CONTINUE
4826      NSAMP=ICNT
4827C
4828      YMIN2=CPUMAX
4829      DO1015I=1,N
4830        IF(Y(I).GT.YMIN1 .AND. Y(I).LT.YMIN2)YMIN2=Y(I)
4831 1015 CONTINUE
4832C
4833      IF(NPOS.LT.1)THEN
4834        WRITE(ICOUT,999)
4835        CALL DPWRST('XXX','BUG ')
4836        WRITE(ICOUT,31)
4837        CALL DPWRST('XXX','BUG ')
4838        WRITE(ICOUT,1021)
4839 1021   FORMAT('      NO POSITVE VALUES WERE FOUND IN THE ')
4840        CALL DPWRST('XXX','BUG ')
4841        WRITE(ICOUT,1023)
4842 1023   FORMAT('      INCLUDED GROUP.  NOTHING DONE.')
4843        CALL DPWRST('XXX','BUG ')
4844        WRITE(ICOUT,999)
4845        CALL DPWRST('XXX','BUG ')
4846        IERROR='YES'
4847        GOTO9000
4848      ENDIF
4849C
4850      NTOT=NPOS+NZERO
4851      PRZERO=100.0*REAL(NZERO)/REAL(NTOT)
4852      CALL MEAN(TEMP2,NPOS,IWRITE,YMEAN1,IBUGG3,IERROR)
4853      CALL SD(TEMP2,NPOS,IWRITE,YSD1,IBUGG3,IERROR)
4854      IF(THRESH.EQ.CPUMIN .OR. THRESH.GT.YMIN1)THEN
4855        THRESH=YMIN1 - (YMIN2-YMIN1)
4856      ENDIF
4857C
4858C               **********************************************
4859C               **  STEP 3--                                **
4860C               **  COMPUTE PARAMETER ESTIMATES             **
4861C               **********************************************
4862C
4863      CALL DPDLP3(TEMP3,TEMP4,NSAMP,THRESH,
4864     1            TEMP5,
4865     1            MUML,SDML,
4866     1            MUMLSE,SDMLSE,COVSE,ACORR,
4867     1            ISUBRO,IBUGG3,IERROR)
4868C
4869C               **********************************************
4870C               **  STEP 4--                                **
4871C               **  COMPUTE SELECT PERCENTILES              **
4872C               **********************************************
4873C
4874      DP=0.95D0
4875      DMU=DBLE(MUML)
4876      DSD=DBLE(SDML)
4877CCCCC CALL TNRPPF(DP,DA,DB,DMU,DSD,DPPF)
4878      CALL NODPPF(DP,DPPF)
4879      DPPF=DMU + DSD*DPPF
4880      UPP95=REAL(DPPF)
4881      DP=0.05D0
4882      CALL NODPPF(DP,DPPF)
4883      DPPF=DMU + DSD*DPPF
4884      LOW05=REAL(DPPF)
4885      DP=DBLE(THRESH)
4886      CALL NODPPF(DP,DPPF)
4887      DPPF=DMU + DSD*DPPF
4888      CDFTHR=REAL(DPPF)
4889C
4890      IF(NPERC.GT.0)THEN
4891        IOP='OPEN'
4892        IFLAG1=1
4893        IFLAG2=0
4894        IFLAG3=0
4895        IFLAG4=0
4896        IFLAG5=0
4897        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
4898     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
4899     1              IBUGG3,ISUBRO,IERROR)
4900        IF(IERROR.EQ.'YES')GOTO9000
4901C
4902        DO1050I=1,NPERC
4903          DP=DBLE(QP(I)/100.0)
4904CCCCC     CALL TNRPPF(DP,DA,DB,DMU,DSD,DPPF)
4905          CALL NODPPF(DP,DPPF)
4906          DPPF=DMU + DSD*DPPF
4907          XQPHAT(I)=REAL(DPPF)
4908          WRITE(IOUNI1,'(2E15.7)')QP(I),XQPHAT(I)
4909 1050   CONTINUE
4910C
4911        IOP='CLOS'
4912        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
4913     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
4914     1              IBUGG3,ISUBRO,IERROR)
4915        IF(IERROR.EQ.'YES')GOTO9000
4916      ENDIF
4917C
4918C               **********************************************
4919C               **  STEP 5--                                **
4920C               **  GENERATE PLOT OF THE TRUNCATED NORMAL   **
4921C               **  CURVE BASED ON ESTIMATED PARAMETERS.    **
4922C               **********************************************
4923C
4924      XSTRT=THRESH
4925      XSTOP=MUML + 3.5*SDML
4926      DMU=DBLE(MUML)
4927      DSD=DBLE(SDML)
4928      ICNT=1
4929      X2(ICNT)=0.0
4930      Y2(ICNT)=0.0
4931      D2(ICNT)=1.0
4932      ICNT=ICNT+1
4933      X2(ICNT)=XSTRT
4934      Y2(ICNT)=0.0
4935      D2(ICNT)=1.0
4936      ICNT=ICNT+1
4937      AUPP=CPUMIN
4938CCCCC CALL TNRPDF(DBLE(XSTRT),DBLE(THRESH),DBLE(AUPP),DBLE(MUML),
4939CCCCC1            DBLE(SDML),DPDF)
4940      DARG1=(DBLE(XSTRT)-DMU)/DSD
4941      CALL NODPDF(DARG1,DPDF)
4942      DPDF=DPDF/DSD
4943      Y2(ICNT)=REAL(DPDF)
4944      D2(ICNT)=1.0
4945C
4946      NP=200
4947      XINC=(XSTOP-XSTRT)/REAL(NP)
4948      XVAL=XSTRT
4949      DO2000I=1,NP
4950        XVAL=XVAL+XINC
4951CCCCC   CALL TNRPDF(DBLE(XVAL),DBLE(THRESH),DBLE(AUPP),DBLE(MUML),
4952CCCCC1            DBLE(SDML),DPDF)
4953        DARG1=(DBLE(XVAL)-DMU)/DSD
4954        CALL NODPDF(DARG1,DPDF)
4955        DPDF=DPDF/DSD
4956        ICNT=ICNT+1
4957        X2(ICNT)=XVAL
4958        Y2(ICNT)=REAL(DPDF)
4959        D2(ICNT)=1.0
4960 2000 CONTINUE
4961C
4962      ICNT=ICNT+1
4963      X2(ICNT)=0.0
4964      Y2(ICNT)=0.0
4965      D2(ICNT)=2.0
4966      NP=20
4967      XINC=XSTRT/REAL(NP)
4968      XVAL=0.0
4969      DO2010I=1,NP
4970        XVAL=XVAL+XINC
4971CCCCC   CALL TNRPDF(DBLE(XVAL),DBLE(THRESH),DBLE(AUPP),DBLE(MUML),
4972CCCCC1            DBLE(SDML),DPDF)
4973        DARG1=(DBLE(XVAL)-DMU)/DSD
4974        CALL NODPDF(DARG1,DPDF)
4975        DPDF=DPDF/DSD
4976        ICNT=ICNT+1
4977        X2(ICNT)=XVAL
4978        Y2(ICNT)=REAL(DPDF)
4979        D2(ICNT)=2.0
4980 2010 CONTINUE
4981C
4982      DO2060I=1,NUMALP
4983C
4984        ALP=ALPHA(I)
4985        P1=ALP/2.0
4986        P2=1.0-(ALP/2.0)
4987        CALL NORPPF(P1,APPF1)
4988        CALL NORPPF(P2,APPF2)
4989        ALOWLO(I)=0.0
4990        AUPPLO(I)=0.0
4991        ALOWSC(I)=0.0
4992        AUPPSC(I)=0.0
4993C
4994        ALOWLO(I)=MUML + APPF1*MUMLSE
4995        AUPPLO(I)=MUML + APPF2*MUMLSE
4996        ALOWSC(I)=SDML + APPF1*SDMLSE
4997        AUPPSC(I)=SDML + APPF2*SDMLSE
4998 2060 CONTINUE
4999C
5000        D(1)=1.0
5001        ALPHL=ALPCV/2.0
5002        ALPHU=1.0 - ALPCV/2.0
5003        CALL NORPPF(ALPHU,ZALPU)
5004C
5005        COV(1,1)=MUMLSE**2
5006        COV(2,2)=SDMLSE**2
5007        COV(1,2)=COVSE
5008        COV(2,1)=COV(1,2)
5009C
5010        DO2160I=1,NPERC
5011          QPTEMP=QP(I)/100.0
5012          CALL NORPPF(QPTEMP,D(2))
5013          XQPHAT(I)=MUML + SDML*D(2)
5014          DSUM1=0.0D0
5015          DO2170II=1,2
5016            DO2180JJ=1,2
5017              DSUM1=DSUM1 + D(II)*D(JJ)*COV(II,JJ)
5018 2180       CONTINUE
5019 2170     CONTINUE
5020          XQPSE=SQRT(REAL(DSUM1))
5021          ATEMP1=XQPHAT(I) - ZALPU*XQPSE
5022          ATEMP2=XQPHAT(I) + ZALPU*XQPSE
5023          XQPLCL(I)=MIN(ATEMP1,ATEMP2)
5024          XQPUCL(I)=MAX(ATEMP1,ATEMP2)
5025 2160   CONTINUE
5026C
5027      N2=ICNT
5028      NPLOTV=2
5029C
5030      IF(IFEEDB.EQ.'ON' .AND. IPRINT.EQ.'ON')THEN
5031        WRITE(ICOUT,999)
5032        CALL DPWRST('XXX','BUG ')
5033        WRITE(ICOUT,4001)
5034 4001   FORMAT(12X,'PROBABILITY OF DETECTION - VERKOUTEREN NORMAL ',
5035     1          'DATA METHOD')
5036        CALL DPWRST('XXX','BUG ')
5037        WRITE(ICOUT,999)
5038        CALL DPWRST('XXX','BUG ')
5039C
5040        WRITE(ICOUT,4011)
5041 4011   FORMAT('INCLUDED GROUPS:')
5042        CALL DPWRST('XXX','BUG ')
5043        DO4012I=1,NPAR
5044          WRITE(ICOUT,4015)IHRIGH,IHRIG2,XMATCH(I)
5045 4015     FORMAT(A4,A4,'                                      = ',
5046     1           G15.7)
5047          CALL DPWRST('XXX','BUG ')
5048 4012   CONTINUE
5049        WRITE(ICOUT,999)
5050        CALL DPWRST('XXX','BUG ')
5051C
5052        WRITE(ICOUT,4021)
5053 4021   FORMAT('SUMMARY STATISTICS:')
5054        CALL DPWRST('XXX','BUG ')
5055        WRITE(ICOUT,4022)NPOS
5056 4022   FORMAT('NUMBER OF POSITIVE VALUES IN INCLUDED GROUPS  = ',I8)
5057        CALL DPWRST('XXX','BUG ')
5058        WRITE(ICOUT,4023)NZERO
5059 4023   FORMAT('NUMBER OF ZERO     VALUES IN INCLUDED GROUPS  = ',I8)
5060        CALL DPWRST('XXX','BUG ')
5061        WRITE(ICOUT,4024)YMEAN1
5062 4024   FORMAT('MEAN OF TRUNCATED DATA                        = ',G15.7)
5063        CALL DPWRST('XXX','BUG ')
5064        WRITE(ICOUT,4025)YSD1
5065 4025   FORMAT('SD OF TRUNCATED DATA                          = ',G15.7)
5066        CALL DPWRST('XXX','BUG ')
5067        WRITE(ICOUT,999)
5068        CALL DPWRST('XXX','BUG ')
5069        WRITE(ICOUT,4026)YMIN1
5070 4026   FORMAT('MINIMUM FOR NON-ZERO DATA                     = ',G15.7)
5071        CALL DPWRST('XXX','BUG ')
5072        WRITE(ICOUT,4027)THRESH
5073 4027   FORMAT('THRESHOLD VALUE                               = ',G15.7)
5074        CALL DPWRST('XXX','BUG ')
5075        WRITE(ICOUT,4029)PRZERO
5076 4029   FORMAT('PERCENTAGE OF ZERO DATA                       = ',G15.7)
5077        CALL DPWRST('XXX','BUG ')
5078C
5079CCCCC   WRITE(ICOUT,999)
5080CCCCC   CALL DPWRST('XXX','BUG ')
5081CCCCC   WRITE(ICOUT,4031)
5082C4031   FORMAT('MOMENT ESTIMATES (BASED ON THREE MOMENTS):')
5083CCCCC   CALL DPWRST('XXX','BUG ')
5084CCCCC   WRITE(ICOUT,4032)MUMOME
5085C4032   FORMAT('ESTIMATE OF MU                                = ',G15.7)
5086CCCCC   CALL DPWRST('XXX','BUG ')
5087CCCCC   WRITE(ICOUT,4034)SDMOME
5088C4034   FORMAT('ESTIMATE OF SIGMA                             = ',G15.7)
5089CCCCC   CALL DPWRST('XXX','BUG ')
5090C
5091        WRITE(ICOUT,999)
5092        CALL DPWRST('XXX','BUG ')
5093        WRITE(ICOUT,4041)
5094 4041   FORMAT('MAXIMUM LIKELIHOOD ESTIMATES:')
5095        CALL DPWRST('XXX','BUG ')
5096        WRITE(ICOUT,4042)MUML
5097 4042   FORMAT('ESTIMATE OF MU                                = ',G15.7)
5098        CALL DPWRST('XXX','BUG ')
5099        WRITE(ICOUT,4044)SDML
5100 4044   FORMAT('ESTIMATE OF SIGMA                             = ',G15.7)
5101        CALL DPWRST('XXX','BUG ')
5102        WRITE(ICOUT,4046)MUMLSE
5103 4046   FORMAT('STANDARD ERROR OF MU                          = ',G15.7)
5104        CALL DPWRST('XXX','BUG ')
5105        WRITE(ICOUT,4048)SDMLSE
5106 4048   FORMAT('STANDARD ERROR OF SIGMA                       = ',G15.7)
5107        CALL DPWRST('XXX','BUG ')
5108        WRITE(ICOUT,4049)COVSE
5109 4049   FORMAT('COVARIANCE OF MU AND SIGMA                    = ',G15.7)
5110        CALL DPWRST('XXX','BUG ')
5111        WRITE(ICOUT,4050)ACORR
5112 4050   FORMAT('CORRELATION BETWEEN MU AND SIGMA              = ',G15.7)
5113        CALL DPWRST('XXX','BUG ')
5114C
5115        WRITE(ICOUT,999)
5116        CALL DPWRST('XXX','WRIT')
5117        WRITE(ICOUT,4640)
5118 4640   FORMAT('CONFIDENCE INTERVAL FOR LOCATION PARAMETER')
5119        CALL DPWRST('XXX','WRIT')
5120        WRITE(ICOUT,999)
5121        CALL DPWRST('XXX','WRIT')
5122        WRITE(ICOUT,4643)
5123 4643   FORMAT('   CONFIDENCE           LOWER         UPPER')
5124        CALL DPWRST('XXX','WRIT')
5125        WRITE(ICOUT,4645)
5126 4645   FORMAT('   VALUE (%)            LIMIT         LIMIT')
5127        CALL DPWRST('XXX','WRIT')
5128        WRITE(ICOUT,4646)
5129 4646   FORMAT('-------------------------------------------')
5130        CALL DPWRST('XXX','WRIT')
5131C
5132        DO4649I=1,NUMALP
5133          ATEMP=100.0*(1.0 - ALPHA(I))
5134          WRITE(ICOUT,4647)ATEMP,ALOWLO(I),AUPPLO(I)
5135 4647     FORMAT('   ',F8.3,9X,G13.6,1X,G13.6)
5136          CALL DPWRST('XXX','WRIT')
5137 4649   CONTINUE
5138        WRITE(ICOUT,999)
5139        CALL DPWRST('XXX','WRIT')
5140C
5141        WRITE(ICOUT,4680)
5142 4680   FORMAT('CONFIDENCE INTERVAL FOR SCALE PARAMETER')
5143        CALL DPWRST('XXX','WRIT')
5144        WRITE(ICOUT,999)
5145        CALL DPWRST('XXX','WRIT')
5146        WRITE(ICOUT,4643)
5147        CALL DPWRST('XXX','WRIT')
5148        WRITE(ICOUT,4645)
5149        CALL DPWRST('XXX','WRIT')
5150        WRITE(ICOUT,4646)
5151        CALL DPWRST('XXX','WRIT')
5152C
5153        DO4689I=1,NUMALP
5154          ATEMP=100.0*(1.0 - ALPHA(I))
5155          WRITE(ICOUT,4647)ATEMP,ALOWSC(I),AUPPSC(I)
5156          CALL DPWRST('XXX','WRIT')
5157 4689   CONTINUE
5158        WRITE(ICOUT,999)
5159        CALL DPWRST('XXX','WRIT')
5160C
5161        IF(NPERC.GT.0)THEN
5162          WRITE(ICOUT,4911)
5163 4911     FORMAT('CONFIDENCE LIMITS FOR SELECTED PERCENTILES:')
5164          CALL DPWRST('XXX','WRIT')
5165          WRITE(ICOUT,4914)
5166 4914     FORMAT('CENSORED CASE (BASED ON NORMAL APPROXIMATION)')
5167          CALL DPWRST('XXX','WRIT')
5168          WRITE(ICOUT,4915)ALPCV
5169 4915     FORMAT('ALPHA = ',F7.4)
5170          CALL DPWRST('XXX','WRIT')
5171          WRITE(ICOUT,4921)
5172 4921     FORMAT(15X,'         POINT     ','          LOWER     ',
5173     1          '         UPPER')
5174          CALL DPWRST('XXX','WRIT')
5175          WRITE(ICOUT,4922)
5176 4922     FORMAT('     PERCENTILE','      ESTIMATE    ',
5177     1           'CONFIDENCE LIMIT ','  CONFIDENCE LIMIT')
5178          CALL DPWRST('XXX','WRIT')
5179          WRITE(ICOUT,4924)
5180 4924     FORMAT('---------------','------------------',
5181     1           '-----------------','------------------')
5182          CALL DPWRST('XXX','WRIT')
5183C
5184          DO4930I=1,NPERC
5185            WRITE(ICOUT,4932)QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
5186 4932       FORMAT(F15.3,2X,G15.7,6X,G15.7,4X,G15.7)
5187            CALL DPWRST('XXX','WRIT')
5188 4930     CONTINUE
5189        ENDIF
5190C
5191        WRITE(ICOUT,999)
5192        CALL DPWRST('XXX','BUG ')
5193      ENDIF
5194C
5195C               ******************
5196C               **   STEP 90--  **
5197C               **   EXIT       **
5198C               ******************
5199C
5200 9000 CONTINUE
5201      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'DLP2')THEN
5202        WRITE(ICOUT,999)
5203        CALL DPWRST('XXX','BUG ')
5204        WRITE(ICOUT,9011)
5205 9011   FORMAT('***** AT THE END       OF DPDLP2--')
5206        CALL DPWRST('XXX','BUG ')
5207        WRITE(ICOUT,9012)ICASPL,IDATSW,PSTRIN,IERROR,N2
5208 9012   FORMAT('ICASPL,IDATSW,PSTRIN,IERROR,N2 = ',
5209     1         A4,2X,A4,2X,G15.7,2X,A4,2X,I8)
5210        CALL DPWRST('XXX','BUG ')
5211        DO9015I=1,N2
5212          WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
5213 9016     FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
5214          CALL DPWRST('XXX','BUG ')
5215 9015   CONTINUE
5216      ENDIF
5217C
5218      RETURN
5219      END
5220      SUBROUTINE DPDLP3(Y,X,N,T,
5221     1                  TEMP1,
5222     1                  MUML,SDML,
5223     1                  MUMLSE,SDMLSE,COVSE,ACORR,
5224     1                  ISUBRO,IBUGA3,IERROR)
5225C
5226C     PURPOSE--THIS ROUTINE ESTIMATES THE PARAMETERS FOR THE
5227C              "DETECTION LIMIT PLOT" COMMAND.  NOTE THAT THIS
5228C              IS ACTUALLY A SINGLY LEFT CENSORED PROBLEM (THE
5229C              DISTINCTION BETWEEN CENSORING AND TRUNCATION IS
5230C              THAT FOR THE CENSORED CASE WE KNOW HOW MANY
5231C              MEASUREMENTS ARE RESTRICTED WHILE FOR THE TRUNCATED
5232C              CASE WE DO NOT).
5233C
5234C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
5235C
5236C                  SIGMAHAT = SQRT{S**2 + lambda(h,alphahat)*(XBAR - T)**2}
5237C                  MUHAT    = XBAR - lambda(h,alphahat)*(XBAR - T)
5238C
5239C              WHERE
5240C
5241C                   alphahat = S**2/(XBAR - T)**2
5242C                   h        = c/N
5243C                   N        = TOTAL NUMBER OF OBSERVATIONS
5244C                   n        = NUMBER OF NON-TRUNCATED OBSERVATIONS
5245C                   c        = NUMBER OF TRUNCATED OBSERVATIONS
5246C
5247C               XBAR AND S ARE THE MEAN AND SD OF THE NON-TRUNCATED
5248C               OBSERVATIONS.
5249C
5250C               LAMBDA(H,ALPHAHAT) IS A TABULATED VALUE IN THE
5251C               COHEN REFERENCE.  HOWEVER, WE DETERMINE IT BY
5252C               SOLVING THE FUNCTION
5253C
5254C                  ((1 - OMEGA(h,XI)*(OMEGA(h,XI) - XI))/
5255C                  (OMEGA(h,XI) - XI)**2) - S**2/(MU - T)**2
5256C
5257C               FOR XI WHERE
5258C
5259C                  OMEGA(h,XI) = (h/(1-h))*NORPDF(XI)/NORCDF(XI)
5260C
5261C               NOTE THAT XI IS THE STANDARDIZED TRUNCATION
5262C               POINT.  ONCE WE SOLVE FOR XI, WE PLUG IT INTO
5263C               THE FUNCTION
5264C
5265C                   LAMBDA = OMEGA(h,XI)/(OMEGA(h,XI) - XI)
5266C
5267C               NOTE THAT THERE MAY BE TWO SOLUTIONS TO THIS
5268C               EQUATION.  WE PICK THE ONE THAT RESULTS IN A
5269C               POSITIVE LAMBDA.
5270C
5271C     REFERENCE--CLIFFORD COHEN (1991), "TRUNCATED AND CENSORED
5272C                SAMPLES", MARCEL DEKKER INC., CHAPTER 2.
5273C     WRITTEN BY--JAMES J. FILLIBEN
5274C                 STATISTICAL ENGINEERING DIVISION
5275C                 INFORMATION TECHNOLOGY LABORATORY
5276C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5277C                 GAITHERSBURG, MD 20899-8980
5278C                 PHONE--301-975-2855
5279C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5280C           OF THE NATIONAL BUREAU OF STANDARDS.
5281C     LANGUAGE--ANSI FORTRAN (1977)
5282C     VERSION NUMBER--2008/12
5283C     ORIGINAL VERSION--DECEMBER  2008.
5284C
5285C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5286C
5287      CHARACTER*4 ISUBRO
5288      CHARACTER*4 IBUGA3
5289      CHARACTER*4 IERROR
5290C
5291      CHARACTER*4 IWRITE
5292      CHARACTER*4 ISUBN1
5293      CHARACTER*4 ISUBN2
5294C
5295C---------------------------------------------------------------------
5296C
5297      DIMENSION Y(*)
5298      DIMENSION X(*)
5299      DIMENSION TEMP1(*)
5300C
5301      DOUBLE PRECISION DSUM1
5302      DOUBLE PRECISION DMEAN
5303      DOUBLE PRECISION DVARI
5304      DOUBLE PRECISION DT
5305      DOUBLE PRECISION DNTOT
5306      DOUBLE PRECISION DNFULL
5307      DOUBLE PRECISION DPDF
5308      DOUBLE PRECISION DCDF
5309      DOUBLE PRECISION DPDF2
5310      DOUBLE PRECISION DCDF2
5311      DOUBLE PRECISION DTERM1
5312      DOUBLE PRECISION DTERM2
5313      DOUBLE PRECISION DDENOM
5314      DOUBLE PRECISION DOMEGA
5315      DOUBLE PRECISION DLAMB
5316      DOUBLE PRECISION DQ
5317      DOUBLE PRECISION DQ2
5318      DOUBLE PRECISION DPHI11
5319      DOUBLE PRECISION DPHI12
5320      DOUBLE PRECISION DPHI22
5321      DOUBLE PRECISION DU11
5322      DOUBLE PRECISION DU12
5323      DOUBLE PRECISION DU22
5324C
5325      REAL MUML
5326      REAL SDML
5327      REAL MUMLSE
5328      REAL SDMLSE
5329C
5330      DOUBLE PRECISION AE
5331      DOUBLE PRECISION RE
5332      DOUBLE PRECISION XLOW
5333      DOUBLE PRECISION XUP
5334      DOUBLE PRECISION XMID
5335      DOUBLE PRECISION XI
5336C
5337      DOUBLE PRECISION TNRFUN
5338      EXTERNAL TNRFUN
5339C
5340      DOUBLE PRECISION DC1
5341      DOUBLE PRECISION DH
5342      COMMON/TNRCOM/DC1,DH
5343C---------------------------------------------------------------------
5344C
5345      INCLUDE 'DPCOP2.INC'
5346C
5347C-----START POINT-----------------------------------------------------
5348C
5349      ISUBN1='DPTN'
5350      ISUBN2='S1  '
5351C
5352      IERROR='NO'
5353      IWRITE='OFF'
5354C
5355C               ********************************************
5356C               **  STEP 1--                              **
5357C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
5358C               ********************************************
5359C
5360      IF(N.LE.2)THEN
5361        WRITE(ICOUT,999)
5362  999   FORMAT(1X)
5363        CALL DPWRST('XXX','BUG ')
5364        WRITE(ICOUT,31)
5365   31   FORMAT('***** ERROR IN NORMAL SINGLY LEFT CENSORED ',
5366     1         'PARAMETER ESTIMATION--')
5367        CALL DPWRST('XXX','BUG ')
5368        WRITE(ICOUT,32)
5369   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
5370        CALL DPWRST('XXX','BUG ')
5371        WRITE(ICOUT,34)N
5372   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
5373        CALL DPWRST('XXX','BUG ')
5374        WRITE(ICOUT,999)
5375        CALL DPWRST('XXX','BUG ')
5376        IERROR='YES'
5377        GOTO9000
5378      ENDIF
5379C
5380      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DLP3')THEN
5381        WRITE(ICOUT,999)
5382        CALL DPWRST('XXX','BUG ')
5383        WRITE(ICOUT,70)
5384   70   FORMAT('***** AT THE BEGINNING OF DPDLP3--')
5385        CALL DPWRST('XXX','BUG ')
5386        WRITE(ICOUT,71)N
5387   71   FORMAT('N = ',I8)
5388        CALL DPWRST('XXX','BUG ')
5389        DO73I=1,N
5390          WRITE(ICOUT,74)I,Y(I),X(I)
5391   74     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
5392          CALL DPWRST('XXX','BUG ')
5393   73   CONTINUE
5394      ENDIF
5395C
5396C               **********************************************
5397C               **  STEP 2--                                **
5398C               **  COMPUTE SUMMARY STATISTICS              **
5399C               **********************************************
5400C
5401      MUML=0.0
5402      SDML=0.0
5403C
5404      NC=0
5405      NFULL=0
5406      YMIN=CPUMAX
5407      DSUM1=0.0D0
5408C
5409      DO1010I=1,N
5410        IF(X(I).GT.0.0)THEN
5411          NFULL=NFULL+1
5412          TEMP1(NFULL)=Y(I)
5413          DSUM1=DSUM1 + DBLE(Y(I))
5414          IF(Y(I).LT.YMIN)YMIN=Y(I)
5415        ELSE
5416          NC=NC+1
5417        ENDIF
5418 1010 CONTINUE
5419      DNFULL=DBLE(NFULL)
5420      DNC=DBLE(NC)
5421      DNTOT=DBLE(N)
5422      DMEAN=DSUM1/DNFULL
5423      IF(T.GT.CPUMIN .AND. T.LE.YMIN)THEN
5424        DT=DBLE(T)
5425      ELSE
5426        DT=DBLE(YMIN)
5427      ENDIF
5428C
5429      IF(NFULL.LT.2)THEN
5430        WRITE(ICOUT,999)
5431        CALL DPWRST('XXX','BUG ')
5432        WRITE(ICOUT,31)
5433        CALL DPWRST('XXX','BUG ')
5434        WRITE(ICOUT,1012)
5435 1012   FORMAT('      THE NUMBER OF UNCENSORED OBSERVATIONS MUST BE ',
5436     1         'AT LEAST 2.')
5437        CALL DPWRST('XXX','BUG ')
5438        WRITE(ICOUT,1014)NFULL
5439 1014   FORMAT('      THE NUMBER OF UNCENSORED OBSERVATIONS HERE = ',
5440     1         I8)
5441        CALL DPWRST('XXX','BUG ')
5442        WRITE(ICOUT,999)
5443        CALL DPWRST('XXX','BUG ')
5444        IERROR='YES'
5445        GOTO9000
5446      ENDIF
5447C
5448      DVARI=0.0D0
5449      DO1020I=1,NFULL
5450        DVARI=DVARI + (DBLE(TEMP1(I)) - DMEAN)**2/DNFULL
5451 1020 CONTINUE
5452C
5453      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DLP3')THEN
5454        WRITE(ICOUT,999)
5455        CALL DPWRST('XXX','BUG ')
5456        WRITE(ICOUT,1031)
5457 1031   FORMAT('***** DPDLP3: AFTER COMPUTE SUMMARY STATISTICS')
5458        CALL DPWRST('XXX','BUG ')
5459        WRITE(ICOUT,1032)N,NFULL,NC
5460 1032   FORMAT('N,NFULL,NC = ',3I8)
5461        CALL DPWRST('XXX','BUG ')
5462        WRITE(ICOUT,1033)DMEAN,DVARI,DT
5463 1033   FORMAT('DMEAN,DVARI,DT = ',3G15.7)
5464        CALL DPWRST('XXX','BUG ')
5465      ENDIF
5466C
5467C               **********************************************
5468C               **  STEP 3--                                **
5469C               **  COMPUTE MAXIMUM LIKELIHOOD ESTIMATES    **
5470C               **********************************************
5471C
5472C     DEFINE SOME CONSTANTS FOR THE FUNCTION SOLVER
5473C
5474      DH=DNC/DNTOT
5475      DC1=DVARI/(DMEAN - DT)**2
5476C
5477C     USE DFZERO TO SOLVE THE LAMBDAHAT FUNCTION
5478C
5479      AE=1.D-7
5480      RE=1.D-7
5481      XLOW=-10.0D0
5482      XUP=10.0D0
5483      IF(DMEAN.GT.DT)THEN
5484        XMID=-1.0D0
5485      ELSE
5486        XMID=1.0D0
5487      ENDIF
5488      ITER=0
5489C
5490 1410 CONTINUE
5491      CALL DFZERO(TNRFUN,XLOW,XUP,XMID,RE,AE,IFLAG)
5492      XI=XLOW
5493C
5494C     NOW EVALUATE - CHECK FOR POSITIVE RESULT
5495C
5496      CALL NODPDF(XI,DPDF)
5497      CALL NODCDF(XI,DCDF)
5498      CALL NODPDF(-XI,DPDF2)
5499      CALL NODCDF(-XI,DCDF2)
5500      DOMEGA=(DH/(1.0D0-DH))*DPDF/DCDF
5501      DLAMB=DOMEGA/(DOMEGA - XI)
5502      IF(DLAMB.LT.0.0D0)THEN
5503        IF(ITER.EQ.0)THEN
5504          ITER=1
5505          XLOW=-10.0D0
5506          XUP=XI-0.1D0
5507          XMID=(XLOW+XUP)/2.0D0
5508          GOTO1410
5509        ELSEIF(ITER.EQ.1)THEN
5510          ITER=2
5511          XLOW=XI+0.1D0
5512          XUP=10.0D0
5513          XMID=(XLOW+XUP)/2.0D0
5514          GOTO1410
5515        ELSE
5516          WRITE(ICOUT,999)
5517          CALL DPWRST('XXX','BUG ')
5518          WRITE(ICOUT,31)
5519          CALL DPWRST('XXX','BUG ')
5520          WRITE(ICOUT,1413)
5521 1413     FORMAT('      UNABLE TO DETERMINE MAXIMUM LIKELIHOOD ',
5522     1           'ESTIMATES.')
5523          CALL DPWRST('XXX','BUG ')
5524          GOTO1499
5525        ENDIF
5526      ENDIF
5527C
5528      SDML=REAL(DSQRT(DVARI + DLAMB*(DMEAN - DT)**2))
5529      MUML=REAL(DMEAN - DLAMB*(DMEAN - DT))
5530C
5531C     NOW COMPUTE STANDARD ERRORS
5532C
5533      IF(DCDF.GE.1.0D0 .OR. DCDF2.GE.1.0D0)THEN
5534        WRITE(ICOUT,999)
5535        CALL DPWRST('XXX','BUG ')
5536        WRITE(ICOUT,1431)
5537 1431   FORMAT('***** WARNING IN NORMAL SINGLY LEFT CENSORED ',
5538     1         'PARAMETER ESTIMATION--')
5539        CALL DPWRST('XXX','BUG ')
5540        WRITE(ICOUT,1433)
5541 1433   FORMAT('      UNABLE TO COMPUTE STANDARD ERRORS OF THE ',
5542     1         'MAXIMUM LIKELIHOOD ESTIMATES.')
5543        CALL DPWRST('XXX','BUG ')
5544        GOTO1499
5545      ENDIF
5546C
5547      DQ=DPDF/(1.0D0 - DCDF)
5548      DQ2=DPDF2/(1.0D0 - DCDF2)
5549      DPHI11=1.0D0 + DQ*(DQ2 + XI)
5550      DPHI12=DQ*(1.0D0 + XI*(DQ2 + XI))
5551      DPHI22=2.0D0 + XI*DPHI12
5552      DDENOM=DPHI11*DPHI22 - DPHI12**2
5553      DTERM1=1.0D0/(1.0D0 - DCDF)
5554      DU11=DTERM1*DPHI22/DDENOM
5555      DU22=DTERM1*DPHI11/DDENOM
5556      DU12=-DTERM1*DPHI12/DDENOM
5557      DTERM2=DBLE(SDML)**2/DNTOT
5558      MUMLSE=REAL(DSQRT(DTERM2*DU11))
5559      SDMLSE=REAL(DSQRT(DTERM2*DU22))
5560      COVSE=REAL(DTERM2*DU12)
5561      ACORR=REAL(DU12/DSQRT(DU11*DU22))
5562C
5563 1499 CONTINUE
5564C
5565      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DLP3')THEN
5566        WRITE(ICOUT,999)
5567        CALL DPWRST('XXX','BUG ')
5568        WRITE(ICOUT,1111)
5569 1111   FORMAT('***** DPDLP3: AFTER COMPUTE ML ESTIMATES')
5570        CALL DPWRST('XXX','BUG ')
5571        WRITE(ICOUT,1112)DH,XI,DPDF,DCDF,DPDF2,DCDF2
5572 1112   FORMAT('DH,XI,DPDF,DCDF,DPDF2,DCDF2 = ',6G15.7)
5573        CALL DPWRST('XXX','BUG ')
5574        WRITE(ICOUT,1113)DTERM1,DTERM2,DOMEGA,DLAMB
5575 1113   FORMAT('DTERM1,DTERM2,DOMEGA,DLAMB = ',4G15.7)
5576        CALL DPWRST('XXX','BUG ')
5577        WRITE(ICOUT,1114)MUML,SDML
5578 1114   FORMAT('MUML,SDML = ',2G15.7)
5579        CALL DPWRST('XXX','BUG ')
5580        WRITE(ICOUT,1115)DQ,DQ2,DPHI11,DPHI12,DPHI22
5581 1115   FORMAT('DQ,DQ2,DPHI11,DPHI12,DPHI22 = ',4G15.7)
5582        CALL DPWRST('XXX','BUG ')
5583        WRITE(ICOUT,1116)DDENOM,DU11,DU22,DU12
5584 1116   FORMAT('DDENOM,DU11,DU22,DU12 = ',4G15.7)
5585        CALL DPWRST('XXX','BUG ')
5586      ENDIF
5587C
5588C               ******************
5589C               **   STEP 90--  **
5590C               **   EXIT       **
5591C               ******************
5592C
5593 9000 CONTINUE
5594      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DLP3')THEN
5595        WRITE(ICOUT,999)
5596        CALL DPWRST('XXX','BUG ')
5597        WRITE(ICOUT,9011)
5598 9011   FORMAT('***** AT THE END       OF DPDLP3--')
5599        CALL DPWRST('XXX','BUG ')
5600      ENDIF
5601C
5602      RETURN
5603      END
5604      SUBROUTINE DPDOT(IFOUND,IERROR)
5605C
5606C     PURPOSE--THIS IS A SUBROUTINE FOR THE
5607C              . COMMAND (A NULL COMMAND).
5608C              THIS CAPABILITY IS USEFUL FOR PROVIDING A VISUAL
5609C              SEPARATOR BETWEEN SECTIONS OF STORED DATAPLOT
5610C              CODE ON MASS STORAGE, OR FOR    COMMENTING OUT
5611C              A GIVEN LINE OF DATAPLOT CODE.
5612C     INPUT  ARGUMENTS--NONE
5613C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
5614C                     --IERROR ('YES' OR 'NO' )
5615C     WRITTEN BY--JAMES J. FILLIBEN
5616C                 STATISTICAL ENGINEERING DIVISION
5617C                 INFORMATION TECHNOLOGY LABORATORY
5618C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5619C                 GAITHERSBURG, MD 20899-8980
5620C                 PHONE--301-975-2855
5621C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5622C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5623C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
5624C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
5625C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
5626C     LANGUAGE--ANSI FORTRAN (1977)
5627C     VERSION NUMBER--82/7
5628C     ORIGINAL VERSION--NOVEMBER  1978.
5629C     UPDATED         --MARCH     1982.
5630C     UPDATED         --MAY       1982.
5631C                     --NOVEMBER  1980.
5632C
5633C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5634C
5635      CHARACTER*4 IFOUND
5636      CHARACTER*4 IERROR
5637C
5638C---------------------------------------------------------------------
5639C
5640      INCLUDE 'DPCOP2.INC'
5641C
5642C-----START POINT-----------------------------------------------------
5643C
5644      IFOUND='NO'
5645      IERROR='NO'
5646      IFOUND='YES'
5647      GOTO1199
5648C
5649 1199 CONTINUE
5650      RETURN
5651      END
5652      SUBROUTINE DPDOUB(IHARG,NUMARG,IDEFPR,IHMXPR,
5653     1IPREC,IFOUND,IERROR)
5654C
5655C     PURPOSE--DEFINE THE PREICSION SWITCH
5656C              AS DOUBLE PRECISION.
5657C              THIS IN TURN SPECIFIES THAT SUBSEQUENT
5658C              CALCULATIONS WILL ALL BE CARRIED OUT
5659C              IN DOUBLE PRECISION.
5660C              THE SPECIFIED PRECISION SWITCH SPECIFICATION
5661C              WILL BE PLACED IN THE HOLLERITH VARIABLE IPREC.
5662C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
5663C                     --NUMARG (AN INTEGER VARIABLE)
5664C                     --IDEFPR (A  HOLLERITH VARIABLE)
5665C                     --IHMXPR (A  HOLLERITH VARIABLE)
5666C     OUTPUT ARGUMENTS--IPREC  (A HOLLERITH VARIABLE)
5667C                     --IFOUND ('YES' OR 'NO' )
5668C                     --IERROR ('YES' OR 'NO' )
5669C     WRITTEN BY--JAMES J. FILLIBEN
5670C                 STATISTICAL ENGINEERING DIVISION
5671C                 INFORMATION TECHNOLOGY LABORATORY
5672C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5673C                 GAITHERSBURG, MD 20899-8980
5674C                 PHONE--301-975-2855
5675C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5676C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5677C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
5678C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
5679C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
5680C     LANGUAGE--ANSI FORTRAN (1977)
5681C     VERSION NUMBER--82/7
5682C     ORIGINAL VERSION--NOVEMBER  1980.
5683C     UPDATED         --SEPTEMBER 1981.
5684C     UPDATED         --MAY       1982.
5685C
5686C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5687C
5688      CHARACTER*4 IHARG
5689      CHARACTER*4 IDEFPR
5690      CHARACTER*4 IHMXPR
5691      CHARACTER*4 IPREC
5692      CHARACTER*4 IFOUND
5693      CHARACTER*4 IERROR
5694C
5695      CHARACTER*4 IHOLD
5696C
5697C---------------------------------------------------------------------
5698C
5699      DIMENSION IHARG(*)
5700C
5701C---------------------------------------------------------------------
5702C
5703      INCLUDE 'DPCOP2.INC'
5704C
5705C-----START POINT-----------------------------------------------------
5706C
5707      IERROR='NO'
5708      IFOUND='YES'
5709C
5710      IF(NUMARG.LE.0)GOTO1120
5711      IF(IHARG(NUMARG).EQ.'ON')GOTO1130
5712      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
5713      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1130
5714      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
5715      GOTO1130
5716C
5717 1120 CONTINUE
5718      IHOLD=IDEFPR
5719      GOTO1160
5720C
5721 1130 CONTINUE
5722      IHOLD='DOUB'
5723      GOTO1160
5724C
5725 1160 CONTINUE
5726      IF(IHOLD.EQ.'DOUB'.AND.IHMXPR.EQ.'SING')GOTO1170
5727      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'SING')GOTO1170
5728      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'DOUB')GOTO1170
5729      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'SING')GOTO1170
5730      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'DOUB')GOTO1170
5731      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'TRIP')GOTO1170
5732      GOTO1180
5733C
5734 1170 CONTINUE
5735      IERROR='YES'
5736      WRITE(ICOUT,999)
5737  999 FORMAT(1X)
5738      CALL DPWRST('XXX','BUG ')
5739      WRITE(ICOUT,1172)
5740 1172 FORMAT('***** ERROR IN DPDOUB--')
5741      CALL DPWRST('XXX','BUG ')
5742      WRITE(ICOUT,1173)
5743 1173 FORMAT('      THE DESIRED PRECISION IS HIGHER')
5744      CALL DPWRST('XXX','BUG ')
5745      WRITE(ICOUT,1174)
5746 1174 FORMAT('      THAN PERMITTED ON THIS COMPUTER.')
5747      CALL DPWRST('XXX','BUG ')
5748      WRITE(ICOUT,1175)IHOLD
5749 1175 FORMAT('      DESIRED PRECISION           = ',A4)
5750      CALL DPWRST('XXX','BUG ')
5751      WRITE(ICOUT,1176)IHMXPR
5752 1176 FORMAT('      MAXIMUM ALLOWABLE PRECISION = ',A4)
5753      CALL DPWRST('XXX','BUG ')
5754      GOTO1199
5755C
5756 1180 CONTINUE
5757      IPREC=IHOLD
5758C
5759      IF(IFEEDB.EQ.'OFF')GOTO1189
5760      WRITE(ICOUT,999)
5761      CALL DPWRST('XXX','BUG ')
5762      WRITE(ICOUT,1188)IPREC
5763 1188 FORMAT('THE PRECISION SWITCH HAS JUST BEEN SET TO ',
5764     1A4)
5765      CALL DPWRST('XXX','BUG ')
5766 1189 CONTINUE
5767      GOTO1199
5768C
5769 1199 CONTINUE
5770      RETURN
5771      END
5772      SUBROUTINE DPDPCL(P1,N1,P2,N2,ALPHA,IWRITE,PDIFF,ALOWLM,AUPPLM,
5773     1                  IBUGA3,IERROR)
5774C
5775C     PURPOSE--FOR A GIVEN P1, N1, P2, N2, AND ALPHA, COMPUTE THE
5776C              DIFFERENCE OF PROPORTIONS LOWER AND UPPER CONFIDENCE
5777C              LIMITS.
5778C     WRITTEN BY--JAMES J. FILLIBEN
5779C                 STATISTICAL ENGINEERING DIVISION
5780C                 INFORMATION TECHNOLOGY LABORATORY
5781C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5782C                 GAITHERSBURG, MD 20899-8980
5783C                 PHONE--301-975-2855
5784C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5785C           OF THE NATIONAL BUREAU OF STANDARDS.
5786C     LANGUAGE--ANSI FORTRAN (1977)
5787C     VERSION NUMBER--2008/8
5788C     ORIGINAL VERSION--AUGUST    2008.
5789C     UPDATED         --OCTOBER   2009. USE "BAYESIAN" CORRECTION
5790C                                       (THIS PRODUCES MEANINGFUL
5791C                                       INTERVALS FOR "0" AND "1"
5792C                                       PROBABILITIES)
5793C
5794C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5795C
5796      CHARACTER*4 IWRITE
5797      CHARACTER*4 IBUGA3
5798      CHARACTER*4 IERROR
5799C
5800      CHARACTER*4 ISUBN1
5801      CHARACTER*4 ISUBN2
5802C
5803C---------------------------------------------------------------------
5804C
5805      REAL P1
5806      REAL P2
5807      REAL ALPHA
5808      REAL ALOWLM
5809      REAL AUPPLM
5810      INTEGER N1
5811      INTEGER N2
5812C
5813C---------------------------------------------------------------------
5814C
5815      INCLUDE 'DPCOP2.INC'
5816C
5817C-----START POINT-----------------------------------------------------
5818C
5819      ISUBN1='DPDP'
5820      ISUBN2='CL  '
5821      IERROR='NO'
5822C
5823      IF(IBUGA3.EQ.'ON')THEN
5824        WRITE(ICOUT,999)
5825  999   FORMAT(1X)
5826        CALL DPWRST('XXX','BUG ')
5827        WRITE(ICOUT,51)
5828   51   FORMAT('***** AT THE BEGINNING OF DPDPCL--')
5829        CALL DPWRST('XXX','BUG ')
5830        WRITE(ICOUT,52)IBUGA3,IWRITE
5831   52   FORMAT('IBUGA3,IWRITE = ',A4,2X,A4)
5832        CALL DPWRST('XXX','BUG ')
5833        WRITE(ICOUT,53)P1,N1,P2,N2,ALPHA
5834   53   FORMAT('P1,N1,P2,N2,ALPHA = ',2(G15.7,I8),G15.7)
5835        CALL DPWRST('XXX','BUG ')
5836        WRITE(ICOUT,999)
5837        CALL DPWRST('XXX','BUG ')
5838      ENDIF
5839C
5840C               ********************************
5841C               **  STEP 1--                  **
5842C               **  CHECK FOR INPUT ERRORS    **
5843C               ********************************
5844C
5845      ALOWLM=0.0
5846      AUPPLM=1.0
5847C
5848      IF(N1.LT.1)THEN
5849        WRITE(ICOUT,999)
5850        CALL DPWRST('XXX','WRIT')
5851        WRITE(ICOUT,111)
5852  111   FORMAT('****** ERROR IN DIFFERENCE OF PROPORTION ',
5853     1         'CONFIDENCE LIMITS--')
5854        CALL DPWRST('XXX','BUG ')
5855        WRITE(ICOUT,113)
5856  113   FORMAT('         THE NUMBER OF OBSERVATIONS FOR THE FIRST ',
5857     1         'RESPONSE VARIABLE IS LESS THAN 2.')
5858        CALL DPWRST('XXX','WRIT')
5859        WRITE(ICOUT,114)N1
5860  114   FORMAT('SAMPLE SIZE = ',I8)
5861        CALL DPWRST('XXX','WRIT')
5862        IERROR='YES'
5863        GOTO9000
5864      ENDIF
5865C
5866      IF(N2.LT.2)THEN
5867        WRITE(ICOUT,999)
5868        CALL DPWRST('XXX','WRIT')
5869        WRITE(ICOUT,111)
5870        CALL DPWRST('XXX','BUG ')
5871        WRITE(ICOUT,123)
5872  123   FORMAT('         THE NUMBER OF OBSERVATIONS FOR THE ',
5873     1         'SECOND RESPONSE VARIABLE IS LESS THAN 2.')
5874        CALL DPWRST('XXX','WRIT')
5875        WRITE(ICOUT,124)N2
5876  124   FORMAT('SAMPLE SIZE = ',I8)
5877        CALL DPWRST('XXX','WRIT')
5878        IERROR='YES'
5879        GOTO9000
5880      ENDIF
5881C
5882      IF(P1.LT.0.0 .OR. P1.GT.1.0)THEN
5883        IERROR='YES'
5884        WRITE(ICOUT,999)
5885        CALL DPWRST('XXX','BUG ')
5886        WRITE(ICOUT,111)
5887        CALL DPWRST('XXX','BUG ')
5888        WRITE(ICOUT,162)
5889  162   FORMAT('      THE BINOMIAL PROBABILITY OF SUCCESS PARAMETER ',
5890     1         'FOR THE')
5891        CALL DPWRST('XXX','BUG ')
5892        WRITE(ICOUT,164)
5893  164   FORMAT('      FIRST RESPONSE VARIABLE IS OUTSIDE THE ',
5894     1         '(0,1) INTERVAL.')
5895        CALL DPWRST('XXX','BUG ')
5896        WRITE(ICOUT,167)P1
5897  167   FORMAT('      THE PROBABILITY OF SUCCESS PARAMETER = ',G15.7)
5898        CALL DPWRST('XXX','BUG ')
5899        GOTO9000
5900      ENDIF
5901C
5902      IF(P2.LT.0.0 .OR. P2.GT.1.0)THEN
5903        IERROR='YES'
5904        WRITE(ICOUT,999)
5905        CALL DPWRST('XXX','BUG ')
5906        WRITE(ICOUT,111)
5907        CALL DPWRST('XXX','BUG ')
5908        WRITE(ICOUT,162)
5909        CALL DPWRST('XXX','BUG ')
5910        WRITE(ICOUT,174)
5911  174   FORMAT('      SECOND RESPONSE VARIABLE IS OUTSIDE THE ',
5912     1         '(0,1) INTERVAL.')
5913        CALL DPWRST('XXX','BUG ')
5914        WRITE(ICOUT,167)P2
5915        CALL DPWRST('XXX','BUG ')
5916        GOTO9000
5917      ENDIF
5918C
5919      ALPHSV=ALPHA
5920      IF(ALPHA.GT.1.0 .AND. ALPHA.LE.100.0)ALPHA=ALPHA/100.0
5921      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
5922        IERROR='YES'
5923        WRITE(ICOUT,999)
5924        CALL DPWRST('XXX','BUG ')
5925        WRITE(ICOUT,111)
5926        CALL DPWRST('XXX','BUG ')
5927        WRITE(ICOUT,182)
5928  182   FORMAT('      THE VALUE OF ALPHA IS OUTSIDE THE (0,1) ',
5929     1         'INTERVAL.')
5930        CALL DPWRST('XXX','BUG ')
5931        WRITE(ICOUT,187)ALPHA
5932  187   FORMAT('      THE VALUE OF ALPHA = ',G15.7)
5933        CALL DPWRST('XXX','BUG ')
5934        GOTO9000
5935      ENDIF
5936C
5937C     NOTE: IF VALUE OF ALPHA IS < 0.5, THEN ASSUME 1 - ALPHA
5938C           (I.E., 0.05 SHOULD BE 0.95).
5939C
5940      IF(ALPHA.LT.0.5)ALPHA=1.0 - ALPHA
5941C
5942C               ********************************************
5943C               **  STEP 2--                              **
5944C               **  COMPUTE THE DIFFERENCE OF PROPORTIONS **
5945C               **  CONFIDENCE INTERVAL.                  **
5946C               ********************************************
5947C
5948C       NOTE: USE   PHAT = (V+0.5)/(N+1) WHERE V IS THE
5949C             NUMBER OF SUCCESSES.  THIS IS THE BAYES ESTIMATOR
5950C             OF P CORRESPONDING TO THE NON-INFORMATIVE
5951C             (REFERENCE) JEFFREY'S PRIOR DISTRIBUTION.  THIS IS
5952C             DONE TO BETTER HANDLE THE CASES WHERE P1 OR P2 ARE
5953C             ZERO OR ONE (WHICH RESULTS IN A STANDARD ERROR OF
5954C             ZERO).
5955C
5956        AN1=REAL(N1)
5957        AN2=REAL(N2)
5958        IX1=INT(AN1*P1 + 0.01)
5959        IX2=INT(AN2*P2 + 0.01)
5960        AX1=REAL(IX1) + 0.5
5961        AX2=REAL(IX2) + 0.5
5962        P1NEW=AX1/REAL(N1+1)
5963        P2NEW=AX2/REAL(N2+1)
5964        PDIFF=P1NEW-P2NEW
5965        PSE=SQRT(P1NEW*(1.0-P1NEW)/REAL(N1)+P2NEW*(1.0-P2NEW)/REAL(N2))
5966        PCONF=1.0 - ALPHA
5967        PCONF=PCONF/2.0
5968        CDF=1.0-PCONF
5969        CALL NORPPF(CDF,TI)
5970        AUPPLM=PDIFF+PSE*TI
5971CCCCC   IF(AUPPLM.GT.1.0)AUPPLM=1.0
5972        ALOWLM=PDIFF-PSE*TI
5973CCCCC   IF(ALOWLM.LT.0.0)ALOWLM=0.0
5974C
5975C               *****************
5976C               **  STEP 90--  **
5977C               **  EXIT.      **
5978C               *****************
5979C
5980 9000 CONTINUE
5981C
5982      IF(IBUGA3.EQ.'ON')THEN
5983        WRITE(ICOUT,999)
5984        CALL DPWRST('XXX','BUG ')
5985        WRITE(ICOUT,9011)
5986 9011   FORMAT('***** AT THE END       OF DPDPCL--')
5987        CALL DPWRST('XXX','BUG ')
5988        WRITE(ICOUT,9012)IBUGA3,IERROR
5989 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
5990        CALL DPWRST('XXX','BUG ')
5991        WRITE(ICOUT,9013)PDIFF,PSE,PCONF,TI
5992 9013   FORMAT('PDIFF,PSE,PCONF,TI = ',4(G15.7,2X))
5993        CALL DPWRST('XXX','BUG ')
5994        WRITE(ICOUT,9014)ALOWLM,AUPPLM
5995 9014   FORMAT('ALOWLM,AUPPLM = ',G15.7,2X,G15.7)
5996        CALL DPWRST('XXX','BUG ')
5997        WRITE(ICOUT,9015)P1NEW,P2NEW
5998 9015   FORMAT('P1NEW,P2NEW = ',2(G15.7,2X))
5999        CALL DPWRST('XXX','BUG ')
6000        WRITE(ICOUT,9016)IX1,IX2,AX1,AX2
6001 9016   FORMAT('IX1,IX2,AX1,AX2 = ',2I8,2(G15.7,2X))
6002        CALL DPWRST('XXX','BUG ')
6003      ENDIF
6004C
6005      RETURN
6006      END
6007      SUBROUTINE DPDRA2(X1,Y1,X2,Y2,
6008     1                  IFIG,ILINPA,ILINCO,PLINTH,
6009     1                  AREGBA,IREBLI,IREBCO,PREBTH,
6010     1                  IREFSW,IREFCO,
6011     1                  IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
6012     1                  PTEXHE,PTEXWI,PTEXVG,PTEXHG)
6013C
6014C     PURPOSE--DRAW A LINE WITH ONE END OF THE LINE AT (X1,Y1)
6015C              AND THE OTHER END AT (X2,Y2).
6016C     WRITTEN BY--JAMES J. FILLIBEN
6017C                 STATISTICAL ENGINEERING DIVISION
6018C                 INFORMATION TECHNOLOGY LABORATORY
6019C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6020C                 GAITHERSBURG, MD 20899-8980
6021C                 PHONE--301-975-2855
6022C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6023C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6024C     LANGUAGE--ANSI FORTRAN (1977)
6025C     VERSION NUMBER--82/7
6026C     ORIGINAL VERSION--APRIL     1981.
6027C     UPDATED         --MAY       1982.
6028C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
6029C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
6030C
6031C-----NON-COMMON VARIABLES-------------------------------------
6032C
6033      CHARACTER*4 IFIG
6034      CHARACTER*4 IPATT2
6035C
6036      CHARACTER*4 ILINPA
6037      CHARACTER*4 ILINCO
6038C
6039      CHARACTER*4 IREBLI
6040      CHARACTER*4 IREBCO
6041      CHARACTER*4 IREFSW
6042      CHARACTER*4 IREFCO
6043      CHARACTER*4 IREPTY
6044      CHARACTER*4 IREPLI
6045      CHARACTER*4 IREPCO
6046C
6047      CHARACTER*4 IPATT
6048      CHARACTER*4 ICOLF
6049      CHARACTER*4 ICOLP
6050      CHARACTER*4 ICOL
6051      CHARACTER*4 IFLAG
6052C
6053      DIMENSION PX(10)
6054      DIMENSION PY(10)
6055C
6056      DIMENSION ILINPA(*)
6057      DIMENSION ILINCO(*)
6058      DIMENSION PLINTH(*)
6059C
6060      DIMENSION AREGBA(*)
6061      DIMENSION IREBLI(*)
6062      DIMENSION IREBCO(*)
6063      DIMENSION PREBTH(*)
6064      DIMENSION IREFSW(*)
6065      DIMENSION IREFCO(*)
6066      DIMENSION IREPTY(*)
6067      DIMENSION IREPLI(*)
6068      DIMENSION IREPCO(*)
6069      DIMENSION PREPTH(*)
6070      DIMENSION PREPSP(*)
6071C
6072C-----COMMON----------------------------------------------------------
6073C
6074      INCLUDE 'DPCOGR.INC'
6075      INCLUDE 'DPCOBE.INC'
6076      INCLUDE 'DPCOP2.INC'
6077C
6078C-----START POINT-----------------------------------------------------
6079C
6080      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRA2')THEN
6081        WRITE(ICOUT,999)
6082  999   FORMAT(1X)
6083        CALL DPWRST('XXX','BUG ')
6084        WRITE(ICOUT,51)
6085   51   FORMAT('***** AT THE BEGINNING OF DPDRA2--')
6086        CALL DPWRST('XXX','BUG ')
6087        WRITE(ICOUT,53)X1,Y1,X2,Y2
6088   53   FORMAT('X1,Y1,X2,Y2 = ',4G15.7)
6089        CALL DPWRST('XXX','BUG ')
6090        WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
6091   61   FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
6092        CALL DPWRST('XXX','BUG ')
6093        WRITE(ICOUT,62)IFIG,AREGBA(1)
6094   62   FORMAT('IFIG,AREGBA(1) = ',A4,2X,G15.7)
6095        CALL DPWRST('XXX','BUG ')
6096        WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
6097   63   FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
6098        CALL DPWRST('XXX','BUG ')
6099        WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
6100   64   FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
6101        CALL DPWRST('XXX','BUG ')
6102        WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
6103   65   FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
6104     1         3(A4,2X),2G15.7)
6105        CALL DPWRST('XXX','BUG ')
6106        WRITE(ICOUT,67)PTEXHE,PTEXWI,PTEXVG,PTEXHG
6107   67   FORMAT('PTEXHE,PTEXWI,PTEXVG,PTEXHG = ',4G15.7)
6108        CALL DPWRST('XXX','BUG ')
6109        WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
6110   79   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
6111        CALL DPWRST('XXX','BUG ')
6112      ENDIF
6113C
6114C               *********************************
6115C               **  STEP 1--                   **
6116C               **  DETERMINE THE COORDINATES  **
6117C               **  FOR THE LINE               **
6118C               *********************************
6119C
6120      PX(1)=X1
6121      PY(1)=Y1
6122C
6123      PX(2)=X2
6124      PY(2)=Y2
6125C
6126      NP=2
6127C
6128C
6129C               ***********************
6130C               **  STEP 2--         **
6131C               **  FILL THE FIGURE  **
6132C               **  (IF CALLED FOR)  **
6133C               ***********************
6134C
6135      IF(IREFSW(1).EQ.'ON')THEN
6136        IPATT=IREPTY(1)
6137        IPATT2='SOLI'
6138        PTHICK=PREPTH(1)
6139        PXGAP=PREPSP(1)
6140        PYGAP=PREPSP(1)
6141        ICOLF=IREFCO(1)
6142        ICOLP=IREPCO(1)
6143        CALL DPFIRE(PX,PY,NP,
6144     1              IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
6145      ENDIF
6146C
6147C               ***************************
6148C               **  STEP 3--             **
6149C               **  DRAW OUT THE FIGURE  **
6150C               ***************************
6151C
6152      IPATT=ILINPA(1)
6153      PTHICK=PLINTH(1)
6154      ICOL=ILINCO(1)
6155      IFLAG='ON'
6156      CALL DPDRPL(PX,PY,NP,
6157     1            IFIG,IPATT,PTHICK,ICOL,
6158     1            JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
6159C
6160C               *****************
6161C               **  STEP 90--  **
6162C               **  EXIT       **
6163C               *****************
6164C
6165      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRA2')THEN
6166        WRITE(ICOUT,999)
6167        CALL DPWRST('XXX','BUG ')
6168        WRITE(ICOUT,9011)
6169 9011   FORMAT('***** AT THE END       OF DPDRA2--')
6170        CALL DPWRST('XXX','BUG ')
6171        WRITE(ICOUT,9013)IERRG4,NP
6172 9013   FORMAT('IERRG4,NP = ',A4,2X,I8)
6173        CALL DPWRST('XXX','BUG ')
6174        DO9015I=1,NP
6175          WRITE(ICOUT,9016)I,PX(I),PY(I)
6176 9016     FORMAT('I,PX(I),PY(I) = ',I8,2G15.7)
6177          CALL DPWRST('XXX','BUG ')
6178 9015   CONTINUE
6179      ENDIF
6180C
6181      RETURN
6182      END
6183      SUBROUTINE DPDRAW(PXSTAR,PYSTAR,PXEND,PYEND,
6184     1                  ILINPA,ILINCO,PLINTH,
6185     1                  AREGBA,IREBLI,IREBCO,PREBTH,IREFSW,IREFCO,
6186     1                  IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
6187     1                  PTEXHE,PTEXWI,PTEXVG,PTEXHG,
6188     1                  ICHAPA,ICHAFO,ICHACA,ICHAJU,ICHADI,ICHAFI,
6189     1                  ICHACO,
6190     1                  PCHAHE,PCHAWI,PCHAVG,PCHAHG,PCHATH,ACHAAN,
6191     1                  IGRASW,
6192     1                  PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
6193     1                  PDIAHE,PDIAWI,PDIAVG,PDIAHG,
6194     1                  NUMDEV,IDMANU,IDMODE,IDMOD2,IDMOD3,
6195     1                  IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
6196     1                  IDNVOF,IDNHOF,IDFONT,PDSCAL,
6197     1                  X1UNIT,Y1UNIT,X2UNIT,Y2UNIT,
6198     1                  IMPSW2,AMPSCH,AMPSCW,ITEXSP,ITEXSY,
6199     1                  IBUGD2,IFOUND,IERROR)
6200C
6201C     PURPOSE--DRAW ONE OR MORE LINES (DEPENDING ON HOW MANY NUMBERS ARE
6202C              PROVIDED).  THE COORDINATES ARE IN STANDARDIZED UNITS
6203C              OF 0 TO 100.
6204C     NOTE--THE INPUT COORDINATES DEFINE THE ENDS OF THE LINE SEGMENTS.
6205C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2 AND THEREFORE THE
6206C           USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
6207C     NOTE--IF 2 NUMBERS ARE PROVIDED, THEN THE DRAWN LINE WILL GO FROM
6208C           THE LAST CURSOR POSITION TO THE (X,Y) POINT (EITHER ABSOLUTE
6209C           OR RELATIVE) AS DEFINED BY THE 2 NUMBERS.
6210C     NOTE--IF 4 NUMBERS ARE PROVIDED, THEN THE DRAWN LINE WILL GO
6211C           FROM THE ABSOLUTE (X,Y) POSITION AS DEFINED BY THE FIRST 2
6212C           NUMBERS TO THE (X,Y) POINT (EITHER ABSOLUTE OR RELATIVE)
6213C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
6214C     NOTE--IF 6 NUMBERS ARE PROVIDED, THEN THE DRAWN LINE WILL GO
6215C           FROM THE (X,Y) POSITION AS RESULTING FROM THE THIRD AND
6216C           FOURTH NUMBERS TO THE (X,Y) POINT (EITHER ABSOLUTE OR
6217C           RELATIVE) AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
6218C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
6219C     INPUT  ARGUMENTS--IHARG
6220C                     --IARGT
6221C                     --ARG
6222C                     --NUMARG
6223C                     --PXSTAR
6224C                     --PYSTAR
6225C     OUTPUT ARGUMENTS--PXEND
6226C                     --PYEND
6227C                     --IFOUND ('YES' OR 'NO' )
6228C                     --IERROR ('YES' OR 'NO' )
6229C     WRITTEN BY--JAMES J. FILLIBEN
6230C                 STATISTICAL ENGINEERING DIVISION
6231C                 INFORMATION TECHNOLOGY LABORATORY
6232C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6233C                 GAITHERSBURG, MD 20899-8980
6234C                 PHONE--301-975-2855
6235C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6236C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6237C     LANGUAGE--ANSI FORTRAN (1977)
6238C     VERSION NUMBER--82/7
6239C     ORIGINAL VERSION--APRIL     1981.
6240C     UPDATED         --MARCH     1982.
6241C     UPDATED         --MAY       1982.
6242C     UPDATED         --NOVEMBER  1982.
6243C     UPDATED         --JANUARY   1989. CALL LIST FOR OFFSET VAR (ALAN)
6244C     UPDATED         --SEPTEMBER 1994. UNITS SWITCH (DATA OR SCREEN)
6245C     UPDATED         --FEBRUARY  1995. GENERALIZED DRAW.... COMMAND
6246C     UPDATED         --MARCH     1997. SUPPORT FOR DEVICE FONT (ALAN)
6247C     UPDATED         --FEBRUARY  2018. SUPPORT FOR VARIABLE ARGUMENTS
6248C     UPDATED         --FEBRUARY  2018. SUPPORT FOR "DRAW SYMBOL"
6249C     UPDATED         --DECEMBER  2018. CHECK FOR DISCRETE, NULL, OR
6250C                                       NONE DEVICE
6251C     UPDATED         --DECEMBER  2018. SUPPORT FOR "DEVICE ... SCALE"
6252C                                       COMMAND
6253C
6254C-----NON-COMMON VARIABLES-----------------------------------------
6255C
6256      CHARACTER*4 ILINPA
6257      CHARACTER*4 ILINCO
6258C
6259      CHARACTER*4 IREBLI
6260      CHARACTER*4 IREBCO
6261      CHARACTER*4 IREFSW
6262      CHARACTER*4 IREFCO
6263      CHARACTER*4 IREPTY
6264      CHARACTER*4 IREPLI
6265      CHARACTER*4 IREPCO
6266C
6267      CHARACTER*4 IGRASW
6268      CHARACTER*4 IDIASW
6269C
6270      CHARACTER*4 IDMANU
6271      CHARACTER*4 IDMODE
6272      CHARACTER*4 IDMOD2
6273      CHARACTER*4 IDMOD3
6274      CHARACTER*4 IDPOWE
6275      CHARACTER*4 IDCONT
6276      CHARACTER*4 IDCOLO
6277      CHARACTER*4 IDFONT
6278C
6279      CHARACTER*4 IMPSW2
6280      CHARACTER*4 IFOUND
6281      CHARACTER*4 IBUGD2
6282      CHARACTER*4 IERROR
6283C
6284      CHARACTER*4 IFIG
6285      CHARACTER*4 IBELSW
6286      CHARACTER*4 IERASW
6287      CHARACTER*4 IBACCO
6288      CHARACTER*4 ICOPSW
6289      CHARACTER*4 ITYPEO
6290      CHARACTER*4 ITEXSY
6291      CHARACTER*4 ITEXSP
6292      CHARACTER*24 ITEXZZ
6293C
6294      CHARACTER*4 X1UNIT
6295      CHARACTER*4 Y1UNIT
6296      CHARACTER*4 X2UNIT
6297      CHARACTER*4 Y2UNIT
6298C
6299      DIMENSION ILINPA(*)
6300      DIMENSION ILINCO(*)
6301      DIMENSION PLINTH(*)
6302C
6303      CHARACTER*24 ICHAPA(*)
6304      CHARACTER*4  ICHAFO(*)
6305      CHARACTER*4  ICHACA(*)
6306      CHARACTER*4  ICHAJU(*)
6307      CHARACTER*4  ICHADI(*)
6308      CHARACTER*4  ICHAFI(*)
6309      CHARACTER*4  ICHACO(*)
6310      DIMENSION    PCHAHE(*)
6311      DIMENSION    PCHAWI(*)
6312      DIMENSION    PCHAVG(*)
6313      DIMENSION    PCHAHG(*)
6314      DIMENSION    PCHATH(*)
6315      DIMENSION    ACHAAN(*)
6316C
6317      DIMENSION AREGBA(*)
6318      DIMENSION IREBLI(*)
6319      DIMENSION IREBCO(*)
6320      DIMENSION PREBTH(*)
6321      DIMENSION IREFSW(*)
6322      DIMENSION IREFCO(*)
6323      DIMENSION IREPTY(*)
6324      DIMENSION IREPLI(*)
6325      DIMENSION IREPCO(*)
6326      DIMENSION PREPTH(*)
6327      DIMENSION PREPSP(*)
6328      DIMENSION PDSCAL(*)
6329C
6330      DIMENSION IDMANU(*)
6331      DIMENSION IDMODE(*)
6332      DIMENSION IDMOD2(*)
6333      DIMENSION IDMOD3(*)
6334      DIMENSION IDPOWE(*)
6335      DIMENSION IDCONT(*)
6336      DIMENSION IDCOLO(*)
6337      DIMENSION IDFONT(*)
6338      DIMENSION IDNVPP(*)
6339      DIMENSION IDNHPP(*)
6340      DIMENSION IDUNIT(*)
6341C
6342      DIMENSION IDNVOF(*)
6343      DIMENSION IDNHOF(*)
6344C
6345      INCLUDE 'DPCOPA.INC'
6346C
6347      DIMENSION X1TEMP(MAXOBV)
6348      DIMENSION Y1TEMP(MAXOBV)
6349      DIMENSION X2TEMP(MAXOBV)
6350      DIMENSION Y2TEMP(MAXOBV)
6351C
6352      PARAMETER (MAXSPN=30)
6353      CHARACTER*4 IVARN1(MAXSPN)
6354      CHARACTER*4 IVARN2(MAXSPN)
6355      CHARACTER*4 IVARTY(MAXSPN)
6356      REAL PVAR(MAXSPN)
6357      INTEGER ILIS(MAXSPN)
6358      INTEGER NRIGHT(MAXSPN)
6359      INTEGER ICOLR(MAXSPN)
6360      CHARACTER*40 INAME
6361C
6362      CHARACTER*4 ICASE
6363      CHARACTER*4 ISYMB
6364C
6365      CHARACTER*4 ICH2PA(24)
6366      CHARACTER*4 IFONT
6367      CHARACTER*4 IJUST
6368      CHARACTER*4 IDIR
6369      CHARACTER*4 IFILL
6370      CHARACTER*4 ICOLCH
6371C
6372C-----COMMON----------------------------------------------------------
6373C
6374      INCLUDE 'DPCOZZ.INC'
6375      INCLUDE 'DPCOGR.INC'
6376      INCLUDE 'DPCOBE.INC'
6377      INCLUDE 'DPCOHK.INC'
6378      INCLUDE 'DPCODA.INC'
6379C
6380      EQUIVALENCE (GARBAG(IGARB1),X1TEMP(1))
6381      EQUIVALENCE (GARBAG(IGARB2),Y1TEMP(1))
6382      EQUIVALENCE (GARBAG(IGARB3),X2TEMP(1))
6383      EQUIVALENCE (GARBAG(IGARB4),Y2TEMP(1))
6384C
6385C-----COMMON VARIABLES (GENERAL)--------------------------------------
6386C
6387      INCLUDE 'DPCOP2.INC'
6388C
6389C-----START POINT-----------------------------------------------------
6390C
6391      IFOUND='NO'
6392      IF(ICOM.EQ.'DRAW')IFOUND='YES'
6393      IERROR='NO'
6394      IERRG4=IERROR
6395      ISYMB='OFF'
6396      IFIG='LINE'
6397C
6398      X1=0.0
6399      Y1=0.0
6400      X2=0.0
6401      Y2=0.0
6402C
6403      MAXCP1=MAXCOL+1
6404      MAXCP2=MAXCOL+2
6405      MAXCP3=MAXCOL+3
6406      MAXCP4=MAXCOL+4
6407      MAXCP5=MAXCOL+5
6408      MAXCP6=MAXCOL+6
6409C
6410C
6411      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRAW')THEN
6412        WRITE(ICOUT,999)
6413  999   FORMAT(1X)
6414        CALL DPWRST('XXX','BUG ')
6415        WRITE(ICOUT,51)
6416   51   FORMAT('***** AT THE BEGINNING OF DPDRAW--')
6417        CALL DPWRST('XXX','BUG ')
6418        WRITE(ICOUT,53)NUMARG,NUMDEV
6419   53   FORMAT('NUMARG,NUMDEV = ',2I8)
6420        CALL DPWRST('XXX','BUG ')
6421        DO55I=1,NUMARG
6422          WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
6423   56     FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,G15.7)
6424          CALL DPWRST('XXX','BUG ')
6425   55   CONTINUE
6426        WRITE(ICOUT,57)PXSTAR,PYSTAR,PXEND,PYEND
6427   57   FORMAT('PXSTAR,PYSTAR,PXEND,PYEND = ',4G15.7)
6428        CALL DPWRST('XXX','BUG ')
6429        WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
6430   61   FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,G15.7)
6431        CALL DPWRST('XXX','BUG ')
6432        WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1),AREGBA(1)
6433   63   FORMAT('IREBLI(1),IREBCO(1),PREBTH(1),AREGBA(1) = ',
6434     1         A4,2X,A4,2G15.7)
6435        CALL DPWRST('XXX','BUG ')
6436        WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
6437   64   FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
6438        CALL DPWRST('XXX','BUG ')
6439        WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
6440   65   FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
6441     1         3(A4,2X),2G15.7)
6442        CALL DPWRST('XXX','BUG ')
6443        WRITE(ICOUT,69)PTEXHE,PTEXWI,PTEXVG,PTEXHG
6444   69   FORMAT('PTEXHE,PTEXWI,PTEXVG,PTEXHG= ',4G15.7)
6445        CALL DPWRST('XXX','BUG ')
6446        WRITE(ICOUT,76)IGRASW,IDIASW
6447   76   FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
6448        CALL DPWRST('XXX','BUG ')
6449        WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
6450   77   FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4G15.7)
6451        CALL DPWRST('XXX','BUG ')
6452        WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
6453   78   FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4G15.7)
6454        CALL DPWRST('XXX','BUG ')
6455        DO81I=1,NUMDEV
6456          WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
6457   82     FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
6458     1           3(A4,2X),A4)
6459          CALL DPWRST('XXX','BUG ')
6460          WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
6461   83     FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',2(A4,2X),A4)
6462          CALL DPWRST('XXX','BUG ')
6463          WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
6464   84     FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',3I8)
6465          CALL DPWRST('XXX','BUG ')
6466   81   CONTINUE
6467        WRITE(ICOUT,85)X1UNIT,Y1UNIT,X2UNIT,Y2UNIT
6468   85   FORMAT('X1UNIT,Y1UNIT,X2UNIT,Y2UNIT= ',4A4)
6469        CALL DPWRST('XXX','BUG ')
6470        WRITE(ICOUT,88)IFOUND,IBUGG4,ISUBG4,IERRG4
6471   88   FORMAT('IFOUND,IBUGG4,ISUBG4,IERRG4 = ',3(A4,2X),A4)
6472        CALL DPWRST('XXX','BUG ')
6473        WRITE(ICOUT,89)IBUGD2,IERROR
6474   89   FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
6475        CALL DPWRST('XXX','BUG ')
6476      ENDIF
6477C
6478C               *****************************************
6479C               **  STEP 1--                           **
6480C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
6481C               *****************************************
6482C
6483      ISHIFT=0
6484      ITYPEO='ABSO'
6485      ISYMB='OFF'
6486      IF(IHARG(1).EQ.'ABSO')THEN
6487        ITYPEO='ABSO'
6488        ISHIFT=1
6489        IF(IHARG(2).EQ.'SYMB')THEN
6490          ISHIFT=2
6491          ISYMB='ON'
6492        ENDIF
6493      ELSEIF(IHARG(1).EQ.'RELA')THEN
6494        ITYPEO='RELA'
6495        ISHIFT=1
6496        IF(IHARG(2).EQ.'SYMB')THEN
6497          ISHIFT=2
6498          ISYMB='ON'
6499        ENDIF
6500      ELSEIF(IHARG(1).EQ.'SYMB')THEN
6501        ISHIFT=1
6502        ISYMB='ON'
6503      ENDIF
6504C
6505      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRAW')THEN
6506        WRITE(ICOUT,91)IYPEO,ISYMB,ISHIFT
6507   91   FORMAT('ITYPEO,ISYMB,ISHIFT = ',2(A4,2X),I3)
6508        CALL DPWRST('XXX','BUG ')
6509      ENDIF
6510C
6511      IF(ISHIFT.GE.1)THEN
6512        CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
6513      ENDIF
6514C
6515C               *****************************************************
6516C               **  STEP 2--                                       **
6517C               **  EXTRACT ARGUMENTS.  NOTE THAT THE DRAW COMMAND **
6518C               **  CAN NOW ACCEPT EITHER PARAMETER OR VARIABLE    **
6519C               **  ARGUMENTS.  ALTHOUGH A MIX OF PARAMETER NAMES  **
6520C               **  AND VARIABLE NAMES CAN BE GIVEN, ALL VARIABLES **
6521C               **  MUST BE OF THE SAME LENGTH.                    **
6522C               *****************************************************
6523C
6524      INAME='DRAW'
6525      MINNA=2
6526      MAXNA=100
6527      MINN2=1
6528      IFLAGE=0
6529      IFLAGM=0
6530      IFLAGP=1
6531      JMIN=1
6532      JMAX=NUMARG
6533      MINNVA=2
6534      MAXNVA=30
6535      IF(ISYMB.EQ.'ON')THEN
6536        MINNA=3
6537        MINNVA=3
6538        MAXNVA=3
6539      ENDIF
6540C
6541      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
6542     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
6543     1            JMIN,JMAX,
6544     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
6545     1            IVARN1,IVARN2,IVARTY,PVAR,
6546     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
6547     1            MINNVA,MAXNVA,
6548     1            IFLAGM,IFLAGP,
6549     1            IBUGG4,IBUGD2,ISUBG4,IFOUND,IERROR)
6550      IF(IERROR.EQ.'YES')GOTO9000
6551C
6552C     EVEN NUMBER OF ARGUMENTS REQUIRED
6553C
6554      IEVEN=MOD(NUMVAR,2)
6555      IF(IEVEN.EQ.1 .AND. ISYMB.EQ.'OFF')THEN
6556        WRITE(ICOUT,999)
6557        CALL DPWRST('XXX','BUG ')
6558        WRITE(ICOUT,211)
6559        CALL DPWRST('XXX','BUG ')
6560        WRITE(ICOUT,203)
6561  203   FORMAT('      AN EVEN NUMBER OF PARAMETER/VARIABLE NAMES ',
6562     1         'REQUIRED.')
6563        CALL DPWRST('XXX','BUG ')
6564        WRITE(ICOUT,205)NUMVAR
6565  205   FORMAT('      THE NUMBER OF NAMES ENTERED IS ',I5)
6566        CALL DPWRST('XXX','BUG ')
6567        IERROR='YES'
6568        GOTO9000
6569      ENDIF
6570C
6571      IF(NUMVAR.GE.5 .AND. ISYMB.EQ.'OFF')THEN
6572        DO210II=5,NUMVAR
6573          IF(IVARTY(II).EQ.'VARI')THEN
6574            WRITE(ICOUT,999)
6575            CALL DPWRST('XXX','BUG ')
6576            WRITE(ICOUT,211)
6577  211       FORMAT('***** ERROR IN DRAW--')
6578            CALL DPWRST('XXX','BUG ')
6579            WRITE(ICOUT,213)
6580  213       FORMAT('      ONLY THE FIRST FOUR ARGUMENTS TO DRAW MAY ',
6581     1             'BE VARIABLE NAMES.')
6582            CALL DPWRST('XXX','BUG ')
6583            WRITE(ICOUT,215)II,IVARN1(II),IVARN2(II)
6584  215       FORMAT('      ARGUMENT ',I3,'(',A4,A4,') IS A VARIABLE ',
6585     1             'NAME.')
6586            CALL DPWRST('XXX','BUG ')
6587            IERROR='YES'
6588            GOTO9000
6589          ENDIF
6590  210   CONTINUE
6591      ENDIF
6592C
6593      IF(IBUGD2.EQ.'ON'.OR.ISUBG4.EQ.'DRAW')THEN
6594        WRITE(ICOUT,999)
6595        CALL DPWRST('XXX','BUG ')
6596        WRITE(ICOUT,281)
6597  281   FORMAT('***** AFTER CALL DPPARS--')
6598        CALL DPWRST('XXX','BUG ')
6599        WRITE(ICOUT,282)NQ,NUMVAR,NLINE
6600  282   FORMAT('NQ,NUMVAR,NLINE = ',3I8)
6601        CALL DPWRST('XXX','BUG ')
6602        IF(NUMVAR.GT.0)THEN
6603          DO285I=1,NUMVAR
6604            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
6605     1                      ICOLR(I),IVARTY(I)
6606  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
6607     1             'ICOLR(I),IVARTY(I) = ',I8,2X,A4,A4,2X,3I8,2X,A4)
6608            CALL DPWRST('XXX','BUG ')
6609  285     CONTINUE
6610        ENDIF
6611      ENDIF
6612C
6613C               *****************************************************
6614C               **  STEP 3--                                       **
6615C               **  IF ANY OF ARGUMENTS 1 TO 4 ARE VARIABLES,      **
6616C               **  EXTRACT THE DATA.                              **
6617C               *****************************************************
6618C
6619      NUMVA2=1
6620      NS1=0
6621      NS2=0
6622      NS3=0
6623      NS4=0
6624      IF(NUMVAR.GE.1 .AND. IVARTY(1).EQ.'VARI')THEN
6625        ICOL=1
6626        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
6627     1              INAME,IVARN1,IVARN2,IVARTY,
6628     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
6629     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
6630     1              MAXCP4,MAXCP5,MAXCP6,
6631     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
6632     1              X1TEMP,X1TEMP,X1TEMP,NS1,NTEMP,NTEMP,ICASE,
6633     1              IBUGD2,ISUBG4,IFOUND,IERROR)
6634        IF(IERROR.EQ.'YES')GOTO9000
6635      ENDIF
6636C
6637      IF(NUMVAR.GE.2 .AND. IVARTY(2).EQ.'VARI')THEN
6638        ICOL=2
6639        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
6640     1              INAME,IVARN1,IVARN2,IVARTY,
6641     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
6642     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
6643     1              MAXCP4,MAXCP5,MAXCP6,
6644     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
6645     1              Y1TEMP,Y1TEMP,Y1TEMP,NS2,NTEMP,NTEMP,ICASE,
6646     1              IBUGD2,ISUBG4,IFOUND,IERROR)
6647        IF(IERROR.EQ.'YES')GOTO9000
6648      ENDIF
6649C
6650      IF(NUMVAR.GE.3 .AND. IVARTY(3).EQ.'VARI')THEN
6651        ICOL=3
6652        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
6653     1              INAME,IVARN1,IVARN2,IVARTY,
6654     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
6655     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
6656     1              MAXCP4,MAXCP5,MAXCP6,
6657     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
6658     1              X2TEMP,X2TEMP,X2TEMP,NS3,NTEMP,NTEMP,ICASE,
6659     1              IBUGD2,ISUBG4,IFOUND,IERROR)
6660        IF(IERROR.EQ.'YES')GOTO9000
6661      ENDIF
6662C
6663      IF(NUMVAR.GE.4 .AND. IVARTY(4).EQ.'VARI')THEN
6664        ICOL=4
6665        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
6666     1              INAME,IVARN1,IVARN2,IVARTY,
6667     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
6668     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
6669     1              MAXCP4,MAXCP5,MAXCP6,
6670     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
6671     1              Y2TEMP,Y2TEMP,Y2TEMP,NS4,NTEMP,NTEMP,ICASE,
6672     1              IBUGD2,ISUBG4,IFOUND,IERROR)
6673        IF(IERROR.EQ.'YES')GOTO9000
6674      ENDIF
6675C
6676      IF(IVARTY(1).EQ.'VARI')THEN
6677        NLINE=NRIGHT(1)
6678      ELSEIF(IVARTY(2).EQ.'VARI')THEN
6679        NLINE=NRIGHT(2)
6680      ELSEIF(IVARTY(3).EQ.'VARI')THEN
6681        NLINE=NRIGHT(3)
6682      ELSEIF(IVARTY(4).EQ.'VARI')THEN
6683        NLINE=NRIGHT(4)
6684      ELSE
6685        NLINE=1
6686      ENDIF
6687C
6688      IFLAG=0
6689      IF(IVARTY(1).EQ.'VARI' .AND. NS1.NE.NLINE)IFLAG=1
6690      IF(IVARTY(2).EQ.'VARI' .AND. NS2.NE.NLINE)IFLAG=1
6691      IF(IVARTY(3).EQ.'VARI' .AND. NS3.NE.NLINE)IFLAG=1
6692      IF(IVARTY(4).EQ.'VARI' .AND. NS4.NE.NLINE .AND.
6693     1   ISYMB.EQ.'OFF')IFLAG=1
6694C
6695      IF(IFLAG.EQ.1)THEN
6696        WRITE(ICOUT,999)
6697        CALL DPWRST('XXX','BUG ')
6698        WRITE(ICOUT,211)
6699        CALL DPWRST('XXX','BUG ')
6700        WRITE(ICOUT,231)
6701  231   FORMAT('      ARGUMENTS THAT ARE VARIABLE NAMES MUST BE OF ',
6702     1         'THE SAME LENGTH.')
6703        CALL DPWRST('XXX','BUG ')
6704        IF(IVARTY(1).EQ.'VARI')THEN
6705          WRITE(ICOUT,232)NS1
6706  232     FORMAT('      ARGUMENT 1 HAS ',I8,' ELEMENTS.')
6707          CALL DPWRST('XXX','BUG ')
6708        ENDIF
6709        IF(IVARTY(2).EQ.'VARI')THEN
6710          WRITE(ICOUT,233)NS2
6711  233     FORMAT('      ARGUMENT 2 HAS ',I8,' ELEMENTS.')
6712          CALL DPWRST('XXX','BUG ')
6713        ENDIF
6714        IF(IVARTY(3).EQ.'VARI')THEN
6715          WRITE(ICOUT,234)NS3
6716  234     FORMAT('      ARGUMENT 3 HAS ',I8,' ELEMENTS.')
6717          CALL DPWRST('XXX','BUG ')
6718        ENDIF
6719        IF(IVARTY(4).EQ.'VARI')THEN
6720          WRITE(ICOUT,235)NS4
6721  235     FORMAT('      ARGUMENT 4 HAS ',I8,' ELEMENTS.')
6722          CALL DPWRST('XXX','BUG ')
6723        ENDIF
6724        IERROR='YES'
6725        GOTO9000
6726      ENDIF
6727C
6728C               ********************************
6729C               **  STEP 2--                  **
6730C               **  STEP THROUGH EACH DEVICE  **
6731C               ********************************
6732C
6733      IF(NUMDEV.LE.0)GOTO9000
6734      DO8000IDEVIC=1,NUMDEV
6735C
6736        IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
6737        IF(IDMANU(IDEVIC).EQ.'OFF')GOTO8000
6738        IF(IDMANU(IDEVIC).EQ.'NULL')GOTO8000
6739        IF(IDMANU(IDEVIC).EQ.'NONE')GOTO8000
6740        IF(IDMANU(IDEVIC).EQ.'DISC')GOTO8000
6741C
6742        IMANUF=IDMANU(IDEVIC)
6743        IMODEL=IDMODE(IDEVIC)
6744        IMODE2=IDMOD2(IDEVIC)
6745        IMODE3=IDMOD3(IDEVIC)
6746        IGCONT=IDCONT(IDEVIC)
6747        IGCOLO=IDCOLO(IDEVIC)
6748        IGFONT=IDFONT(IDEVIC)
6749        NUMVPP=IDNVPP(IDEVIC)
6750        NUMHPP=IDNHPP(IDEVIC)
6751        ANUMVP=NUMVPP
6752        ANUMHP=NUMHPP
6753        IOFFSV=IDNVOF(IDEVIC)
6754        IOFFSH=IDNHOF(IDEVIC)
6755        IGUNIT=IDUNIT(IDEVIC)
6756        PCHSCA=PDSCAL(IDEVIC)
6757C
6758C               ************************************
6759C               **  STEP 1--                      **
6760C               **  CARRY OUT OPENING OPERATIONS  **
6761C               **  ON THE GRAPHICS DEVICES       **
6762C               ************************************
6763C
6764        CALL DPOPDE
6765C
6766        IBELSW='OFF'
6767        NUMRIN=0
6768        IERASW='OFF'
6769        IBACCO='JUNK'
6770C
6771        CALL DPOPPL(IGRASW,IBELSW,NUMRIN,IERASW,IBACCO)
6772C
6773C               ****************************
6774C               **  STEP 3--              **
6775C               **  DRAW OUT THE LINE(S)  **
6776C               ****************************
6777C
6778C       2018/02: ACCOMODATE VARIABLE ARGUMENTS, LOOP THROUGH
6779C                MORE THAN ONE SET OF POINTS.
6780C
6781C       EXTRACT THE COORDINATES FOR THE FIRST 4 SET OF POINTS
6782C
6783        IF(ISYMB.EQ.'OFF')THEN
6784          DO8100ILINE=1,NLINE
6785            IF(NUMVAR.EQ.2)THEN
6786              X1=PXSTAR
6787              Y1=PYSTAR
6788              J=0
6789            ELSE
6790              IF(IVARTY(1).EQ.'VARI')THEN
6791                X1=X1TEMP(ILINE)
6792              ELSE
6793                X1=PVAR(1)
6794              ENDIF
6795              IF(IVARTY(2).EQ.'VARI')THEN
6796                Y1=Y1TEMP(ILINE)
6797              ELSE
6798                Y1=PVAR(2)
6799              ENDIF
6800              J=2
6801            ENDIF
6802C
6803            IF(X1UNIT.EQ.'DATA')
6804     1         CALL DPCODS('X',X1,X1,IBUGD2,ISUBG4,IERROR)
6805            IF(Y1UNIT.EQ.'DATA')
6806     1        CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBG4,IERROR)
6807C
6808 1160       CONTINUE
6809C
6810            J=J+1
6811            IF(J.GT.NUMARG)GOTO1190
6812            IF(J.EQ.1 .AND. NUMVAR.EQ.2)THEN
6813              IF(IVARTY(1).EQ.'VARI')THEN
6814                X2=X1TEMP(ILINE)
6815              ELSE
6816                X2=PVAR(1)
6817              ENDIF
6818              IF(IVARTY(2).EQ.'VARI')THEN
6819                Y2=Y1TEMP(ILINE)
6820              ELSE
6821                Y2=PVAR(2)
6822              ENDIF
6823            ELSEIF(J.EQ.3 .AND. NUMVAR.EQ.4)THEN
6824              IF(IVARTY(3).EQ.'VARI')THEN
6825                X2=X2TEMP(ILINE)
6826              ELSE
6827                X2=PVAR(3)
6828              ENDIF
6829              IF(IVARTY(4).EQ.'VARI')THEN
6830                Y2=Y2TEMP(ILINE)
6831              ELSE
6832                Y2=PVAR(4)
6833              ENDIF
6834            ELSE
6835              X2=ARG(J)
6836              J=J+1
6837              IF(J.GT.NUMARG)GOTO1190
6838              Y2=ARG(J)
6839            ENDIF
6840            IF(X2UNIT.EQ.'DATA')
6841     1         CALL DPCODS('X',X2,X2,IBUGD2,ISUBG4,IERROR)
6842            IF(ITYPEO.EQ.'RELA')X2=X1+X2
6843            IF(Y2UNIT.EQ.'DATA')
6844     1         CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBG4,IERROR)
6845            IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
6846C
6847            CALL DPDRA2(X1,Y1,X2,Y2,
6848     1                  IFIG,ILINPA,ILINCO,PLINTH,
6849     1                  AREGBA,IREBLI,IREBCO,PREBTH,
6850     1                  IREFSW,IREFCO,
6851     1                  IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
6852     1                  PTEXHE,PTEXWI,PTEXVG,PTEXHG)
6853C
6854            X1=X2
6855            Y1=Y2
6856C
6857            GOTO1160
6858C
6859 1190       CONTINUE
6860C
6861 8100     CONTINUE
6862C
6863          PXEND=X2
6864          PYEND=Y2
6865C
6866        ELSE
6867C
6868C               ****************************
6869C               **  STEP 4--              **
6870C               **  DRAW SYMBOL CASE      **
6871C               ****************************
6872C
6873C       2018/02: ADD "DRAW SYMBOL" SYNTAX.  THIS SYNTAX EXPECTS THREE
6874C                ARGUMENTS OF VARIABLE NAMES:
6875C
6876C                   VARIABLE 1 => X-COORDINATE   (X1TEMP)
6877C                   VARIABLE 2 => Y-COORDINATE   (Y1TEMP)
6878C                   VARIABLE 3 => INDEX INTO CHARACTER SETTINGS (X2TEMP)
6879C
6880          IF(NUMVAR.NE.3)THEN
6881            IERROR='YES'
6882            GOTO9000
6883          ENDIF
6884C
6885          DO8200ILINE=1,NLINE
6886C
6887            IF(IVARTY(3).EQ.'VARI')THEN
6888              INDX=INT(X2TEMP(ILINE)+0.1)
6889            ELSE
6890              INDX=INT(PVAR(3)+0.1)
6891            ENDIF
6892            IF(INDX.LT.1)INDX=1
6893            IF(INDX.GT.100)INDX=100
6894C
6895            IF(IBUGD2.EQ.'ON'.OR.ISUBG4.EQ.'DRAW')THEN
6896              WRITE(ICOUT,8301)ILINE,INDX,ICHAPA(ILINE)
6897 8301         FORMAT('ILINE,INDX,ICHAPA(ILINE) = ',2I8,2X,A24)
6898              CALL DPWRST('XXX','BUG ')
6899            ENDIF
6900C
6901            IF(ICHAPA(INDX)(1:3).EQ.'BL ')GOTO8200
6902            IF(ICHAPA(INDX)(1:6).EQ.'BLANK ')GOTO8200
6903            IF(ICHAPA(INDX)(1:5).EQ.'BLAN ')GOTO8200
6904            NCTEXT=0
6905            DO8201JJ=24,1,-1
6906              IF(ICHAPA(INDX)(JJ:JJ).NE.' ')THEN
6907                NCTEXT=JJ
6908                GOTO8203
6909              ENDIF
6910 8201       CONTINUE
6911 8203       CONTINUE
6912            DO8205JJ=1,NCTEXT
6913              ICH2PA(JJ)='    '
6914              ICH2PA(JJ)(1:1)=ICHAPA(INDX)(JJ:JJ)
6915 8205       CONTINUE
6916C
6917            IF(IBUGD2.EQ.'ON'.OR.ISUBG4.EQ.'DRAW')THEN
6918              WRITE(ICOUT,8303)NCTEXT
6919 8303         FORMAT('NCTEXT = ',I5)
6920              CALL DPWRST('XXX','BUG ')
6921              DO8305JJ=1,NCTEXT
6922                WRITE(ICOUT,8307)JJ,ICH2PA(JJ)
6923 8307           FORMAT('JJ,ICH2PA(JJ) = ',I5,2X,A4)
6924                CALL DPWRST('XXX','BUG ')
6925 8305         CONTINUE
6926            ENDIF
6927C
6928            IF(NCTEXT.LE.0)GOTO8200
6929            IFONT=ICHAFO(INDX)
6930            ICASE=ICHACA(INDX)
6931            IJUST=ICHAJU(INDX)
6932            IDIR=ICHADI(INDX)
6933            IFILL=ICHAFI(INDX)
6934            ICOLCH=ICHACO(INDX)
6935            ANGLE=ACHAAN(INDX)
6936            PHEIGH=PCHAHE(INDX)
6937            PWIDTH=PCHAWI(INDX)
6938            PHOGAP=PCHAHG(INDX)
6939            PVEGAP=PCHAVG(INDX)
6940            PTHICK=PCHATH(INDX)
6941C
6942            IF(IVARTY(1).EQ.'VARI')THEN
6943              X1=X1TEMP(ILINE)
6944            ELSE
6945              X1=PVAR(1)
6946            ENDIF
6947            IF(IVARTY(2).EQ.'VARI')THEN
6948              Y1=Y1TEMP(ILINE)
6949            ELSE
6950              Y1=PVAR(2)
6951            ENDIF
6952C
6953            IF(X1UNIT.EQ.'DATA')
6954     1         CALL DPCODS('X',X1,X1,IBUGD2,ISUBG4,IERROR)
6955            IF(Y1UNIT.EQ.'DATA')
6956     1        CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBG4,IERROR)
6957C
6958            IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRAW')THEN
6959              WRITE(ICOUT,8220)
6960 8220         FORMAT('BEFORE CALL DPWRTE')
6961              CALL DPWRST('XXX','BUG ')
6962              WRITE(ICOUT,8221)ILINE,INDX,X1,Y1
6963 8221         FORMAT('ILINE,INDX,X1,Y1 = ',2I5,2G15.7)
6964              CALL DPWRST('XXX','BUG ')
6965            ENDIF
6966C
6967            ITEXZZ=' '
6968            ITEXZZ(1:4)=ITEXSY
6969            CALL DPWRTE(X1,Y1,ICH2PA,NCTEXT,
6970     1                  IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOLCH,
6971     1                  PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
6972     1                  ITEXZZ,ITEXSP,
6973     1                  IMPSW2,AMPSCH,AMPSCW,
6974     1                  PXEND,PYEND)
6975C
6976 8200     CONTINUE
6977C
6978        ENDIF
6979C
6980C               ************************************
6981C               **  STEP 4--                      **
6982C               **  CARRY OUT CLOSING OPERATIONS  **
6983C               **  ON THE GRAPHICS DEVICES       **
6984C               ************************************
6985C
6986        ICOPSW='OFF'
6987        NUMCOP=0
6988        CALL DPCLPL(ICOPSW,NUMCOP,
6989     1              PGRAXF,PGRAYF,
6990     1              IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
6991     1              PDIAHE,PDIAWI,PDIAVG,PDIAHG)
6992C
6993        CALL DPCLDE
6994C
6995 8000 CONTINUE
6996C
6997C               *****************
6998C               **  STEP 90--  **
6999C               **  EXIT       **
7000C               *****************
7001C
7002 9000 CONTINUE
7003      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRAW')THEN
7004        WRITE(ICOUT,999)
7005        CALL DPWRST('XXX','BUG ')
7006        WRITE(ICOUT,9011)
7007 9011   FORMAT('***** AT THE END       OF DPDRAW--')
7008        CALL DPWRST('XXX','BUG ')
7009        WRITE(ICOUT,9013)X1,Y1,X2,Y2,NLINE
7010 9013   FORMAT('X1,Y1,X2,Y2,NLINE = ',4G15.7,I8)
7011        CALL DPWRST('XXX','BUG ')
7012        WRITE(ICOUT,9015)PXSTAR,PYSTAR,PXEND,PYEND
7013 9015   FORMAT('PXSTAR,PYSTAR,PXEND,PYEND = ',4G15.7)
7014        CALL DPWRST('XXX','BUG ')
7015        WRITE(ICOUT,9017)IFIG,IFOUND,IERRG4,IERROR
7016 9017   FORMAT('IFIG,IFOUND,IERRG4,IERROR = ',3(A4,2X),A4)
7017        CALL DPWRST('XXX','BUG ')
7018        IF(NLINE.GT.0)THEN
7019          DO9020I=1,NLINE
7020            WRITE(ICOUT,9022)I,X1TEMP(I),Y1TEMP(I),X2TEMP(I),Y2TEMP(I)
7021 9022       FORMAT('I,X1TEMP(I),Y1TEMP(I),X2TEMP(I),Y2TEMP(I)=',
7022     1             I5,4G15.7)
7023            CALL DPWRST('XXX','BUG ')
7024 9020     CONTINUE
7025        ENDIF
7026      ENDIF
7027C
7028      RETURN
7029      END
7030      SUBROUTINE DPDRBA(Y,X,XHIGH,PY,PX,PZ,NP,
7031CCCCC SUBROUTINE DPDRBA(Y,X,PY,PX,NP,
7032     1ICASPL,ICAS3D,
7033     1ISORSW,
7034     1IBA2SW,ABA2WI,ABA2BA,
7035     1IBA2BL,IBA2BC,PBA2BT,
7036     1IBA2FS,IBA2FC,
7037     1IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT,
7038     1XDELMN,
7039     1PXMIN,PXMAX,PYMIN,PYMAX,
7040     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
7041     1IX1TSC,IY1TSC)
7042C
7043C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
7044C              AND FOR EACH VALUE IN X(.), DRAW A BAR
7045C              (= VERTICAL OR HORIZONTAL BAR)
7046C              FROM THE BASE POINT ABA2BA
7047C              TO THE POINT Y(.).
7048C              DO SO FOR A SPECIFIED BAR LINE TYPE,
7049C              LINES COLOR, AND LINE THICKNESS.
7050C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
7051C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
7052C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
7053C           BACK IN THE MAIN ROUTINE.
7054C
7055C     WRITTEN BY--JAMES J. FILLIBEN
7056C                 STATISTICAL ENGINEERING DIVISION
7057C                 INFORMATION TECHNOLOGY LABORATORY
7058C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7059C                 GAITHERSBURG, MD 20899-8980
7060C                 PHONE--301-975-2855
7061C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7062C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7063C     LANGUAGE--ANSI FORTRAN (1977)
7064C     VERSION NUMBER--87.5
7065C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
7066C     UPDATED--MAY        1987.
7067C            --JANUARY    1989.  GLOBAL REPLACE ABA2BA WITH ABA2BA (ALAN)
7068C     UPDATED--FEBRUARY   1989.  GRDRPL TO DPDRPL (ALAN)
7069C     UPDATED--FEBRUARY   1989.  EXTRA ARGUMENT IN CALL TO DPFIRE (ALAN)
7070C     UPDATED--FEBRUARY   1989.  BUG WITH PATTERN ON 1ST BAR ONLY (ALAN)
7071C     UPDATED--FEBRUARY   1989.  NO SORT IF ICASPL='CONT'
7072C     UPDATED--FEBRUARY   1989.  RENUMBER
7073C     UPDATED--JANUARY    2010.  FOR HISTOGRAM, ALLOW FOR UNEQUI-SPACED
7074C                                CASE (STORE IN XHIGH)
7075C
7076C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
7077C
7078      CHARACTER*4 ICASPL
7079      CHARACTER*4 ICAS3D
7080C
7081      CHARACTER*4 ISORSW
7082C
7083      CHARACTER*4 IBA2SW
7084      CHARACTER*4 IBA2BL
7085      CHARACTER*4 IBA2BC
7086      CHARACTER*4 IBA2FS
7087      CHARACTER*4 IBA2FC
7088      CHARACTER*4 IBA2PT
7089      CHARACTER*4 IBA2PL
7090      CHARACTER*4 IBA2PC
7091      CHARACTER*4 IBA2TY
7092      CHARACTER*4 IBA2DI
7093C
7094      CHARACTER*4 IX1TSC
7095      CHARACTER*4 IY1TSC
7096C
7097      CHARACTER*4 ITYPE
7098C
7099      CHARACTER*4 IFIG
7100      CHARACTER*4 IPATT
7101      CHARACTER*4 ICOL
7102      CHARACTER*4 ICOLF
7103      CHARACTER*4 ICOLP
7104      CHARACTER*4 IDIR
7105C
7106CCCCC CHARACTER*4 IHORPA
7107CCCCC CHARACTER*4 IVERPA
7108CCCCC CHARACTER*4 IDUPPA
7109CCCCC CHARACTER*4 IDDOPA
7110C
7111      CHARACTER*4 IFIGSV
7112      CHARACTER*4 IFLAG
7113      CHARACTER*4 IPATT2
7114C
7115      DIMENSION Y(*)
7116      DIMENSION X(*)
7117      DIMENSION XHIGH(*)
7118      DIMENSION PY(*)
7119      DIMENSION PX(*)
7120      DIMENSION PZ(*)
7121C
7122      DIMENSION PY2(20)
7123      DIMENSION PX2(20)
7124C
7125C-----COMMON----------------------------------------------------------
7126C
7127      INCLUDE 'DPCOGR.INC'
7128      INCLUDE 'DPCOBE.INC'
7129      INCLUDE 'DPCOP2.INC'
7130C
7131C-----START POINT-----------------------------------------------------
7132C
7133      HOLD=1.0
7134      ABASE=0.0
7135      PBASE=0.0
7136      PBASE2=0.0
7137      PLEFT=0.0
7138      PRIGHT=0.0
7139      AWIDTH=0.0
7140      PWIDTH=0.0
7141      IFLAGH=0
7142      J=0
7143      IF(ICASPL.EQ.'HIST' .OR. ICASPL.EQ.'CUMH' .OR.
7144     1   ICASPL.EQ.'CUMR')THEN
7145        IF(XHIGH(1).NE.CPUMIN)IFLAGH=1
7146      ENDIF
7147C
7148      FXMIN=FX1MIN
7149      FXMAX=FX1MAX
7150      FYMIN=FY1MIN
7151      FYMAX=FY1MAX
7152C
7153      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7154        WRITE(ICOUT,999)
7155  999   FORMAT(1X)
7156        CALL DPWRST('XXX','BUG ')
7157        WRITE(ICOUT,51)
7158   51   FORMAT('***** AT THE BEGINNING OF DPDRBA--')
7159        CALL DPWRST('XXX','BUG ')
7160        WRITE(ICOUT,53)NP,ICASPL,ICAS3D,ISORSW,XDELM
7161   53   FORMAT('NP,ICASPL,ICAS3D,ISORSW,XDELM = ',
7162     1         I8,2X,A4,2X,A4,2X,A4,2X,G15.7)
7163        CALL DPWRST('XXX','BUG ')
7164        IF(NP.GT.1)THEN
7165          DO65I=1,NP
7166            WRITE(ICOUT,66)I,X(I),Y(I),XHIGH(I)
7167   66       FORMAT('I,X(I),Y(I),XHIGH(I) = ',I8,3G15.7)
7168            CALL DPWRST('XXX','BUG ')
7169   65     CONTINUE
7170        ENDIF
7171        WRITE(ICOUT,71)IBA2SW,ABA2WI,ABA2BA
7172   71   FORMAT('IBA2SW,ABA2WI,ABA2BA = ',A4,2X,2E15.7)
7173        CALL DPWRST('XXX','BUG ')
7174        WRITE(ICOUT,72)IBA2BL,IBA2BC,PBA2BT
7175   72   FORMAT('IBA2BL,IBA2BC,PBA2BT = ',A4,2X,A4,2X,E15.7)
7176        CALL DPWRST('XXX','BUG ')
7177        WRITE(ICOUT,73)IBA2FS,IBA2FC,IFLAGH
7178   73   FORMAT('IBA2FS,IBA2FC,IFLAGH = ',A4,2X,A4,2X,I5)
7179        CALL DPWRST('XXX','BUG ')
7180        WRITE(ICOUT,74)IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT
7181   74   FORMAT('IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT = ',
7182     1         A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,2E15.7)
7183        CALL DPWRST('XXX','BUG ')
7184        WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
7185   84   FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
7186        CALL DPWRST('XXX','BUG ')
7187        WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
7188   85   FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
7189        CALL DPWRST('XXX','BUG ')
7190        WRITE(ICOUT,86)IX1TSC,IY1TSC
7191   86   FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
7192        CALL DPWRST('XXX','BUG ')
7193        WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
7194   89   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
7195        CALL DPWRST('XXX','BUG ')
7196      ENDIF
7197C
7198C               *************************************************
7199C               **  STEP 11--                                  **
7200C               **  IF CALLED FOR, SORT THE DATA               **
7201C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
7202C               *************************************************
7203C
7204      IDIR=IBA2DI
7205C
7206      IF(ICASPL.EQ.'TRPL')GOTO9000
7207C
7208      IF(ISORSW.EQ.'OFF'  .OR. ICASPL.EQ.'PIEC' .OR.
7209     1   ICASPL.EQ.'ROSE' .OR. ICASPL.EQ.'ON'   .OR.
7210     1   ICASPL.EQ.'HIST' .OR. ICASPL.EQ.'CUMH' .OR.
7211     1   ICASPL.EQ.'CUMR' .OR.
7212     1   ICASPL.EQ.'CONT')THEN
7213        DO1160I=1,NP
7214          PX(I)=X(I)
7215          PY(I)=Y(I)
7216 1160   CONTINUE
7217C
7218        IF(IFLAGH.EQ.1)THEN
7219          DO1161I=1,NP
7220            PZ(I)=XHIGH(I)
7221            IF(PZ(I).LE.PX(I))THEN
7222              WRITE(ICOUT,999)
7223              CALL DPWRST('XXX','BUG ')
7224              WRITE(ICOUT,1251)
7225              CALL DPWRST('XXX','BUG ')
7226              WRITE(ICOUT,1171)I
7227 1171         FORMAT('      FOR UNEQUI-SPACED HISTOGRAMS, FOR ROW ',I8)
7228              CALL DPWRST('XXX','BUG ')
7229              WRITE(ICOUT,1172)
7230 1172         FORMAT('      THE UPPER INTERVAL IS LESS THAN OR EQUAL ',
7231     1               'TO THE LOWER INTERVAL.')
7232              CALL DPWRST('XXX','BUG ')
7233              WRITE(ICOUT,1173)PX(I)
7234 1173         FORMAT('      THE VALUE FOR THE LOWER INTERVAL IS ',G15.7)
7235              CALL DPWRST('XXX','BUG ')
7236              WRITE(ICOUT,1174)PZ(I)
7237 1174         FORMAT('      THE VALUE FOR THE UPPER INTERVAL IS ',G15.7)
7238              CALL DPWRST('XXX','BUG ')
7239              GOTO9000
7240            ENDIF
7241 1161     CONTINUE
7242        ENDIF
7243      ELSE
7244        CALL SORTC(X,Y,NP,PX,PY)
7245      ENDIF
7246C
7247      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7248        WRITE(ICOUT,1194)IPR
7249 1194   FORMAT('IPR=',I4)
7250        CALL DPWRST('XXX','BUG ')
7251        IF(IFLAGH.EQ.1)THEN
7252          DO1198I=1,10
7253            WRITE(ICOUT,1199) I,PX(I),PY(I),PZ(I)
7254 1199       FORMAT('I,PX(I),PY(I),PZ(I) =',I8,2X,3G15.7)
7255            CALL DPWRST('XXX','BUG ')
7256 1198     CONTINUE
7257        ELSE
7258          DO1192I=1,10
7259            WRITE(ICOUT,1196) I,PX(I),PY(I)
7260 1196       FORMAT('I,PX(I),PY(I) =',I8,2X,2G15.7)
7261            CALL DPWRST('XXX','BUG ')
7262 1192     CONTINUE
7263        ENDIF
7264      ENDIF
7265C
7266C               ************************************************
7267C               **  STEP 12--                                 **
7268C               **  IF A LOG SCALE PLOT IS CALLED FOR,        **
7269C               **  CHECK THAT ALL DATA POINTS ARE POSITIVE.  **
7270C               ************************************************
7271C
7272      IF(IX1TSC.EQ.'LOG')THEN
7273        IFLAGN=0
7274        IF(IDIR.EQ.'H')THEN
7275          IF(ABA2BA.LE.0.0)HOLD=ABA2BA
7276          IF(ABA2BA.LE.0.0)IFLAGN=1
7277          GOTO1239
7278        ENDIF
7279C
7280        IF(ISORSW.EQ.'ON')THEN
7281          J=1
7282          IF(PX(J).LE.0.0)IFLAGN=1
7283        ELSE
7284          DO1235I=1,NP
7285            J=I
7286            IF(PX(J).LE.0.0)THEN
7287              IFLAGN=1
7288              GOTO1239
7289            ELSEIF(IFLAGH.EQ.1 .AND. PZ(J).LE.0.0)THEN
7290              IFLAGN=1
7291              GOTO1239
7292            ENDIF
7293 1235     CONTINUE
7294        ENDIF
7295C
7296 1239   CONTINUE
7297        IF(IFLAGN.EQ.1)THEN
7298          WRITE(ICOUT,999)
7299          CALL DPWRST('XXX','BUG ')
7300          WRITE(ICOUT,1251)
7301 1251     FORMAT('***** ERROR IN DPDRBA--')
7302          CALL DPWRST('XXX','BUG ')
7303          WRITE(ICOUT,1252)
7304 1252     FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE WAS')
7305          CALL DPWRST('XXX','BUG ')
7306          WRITE(ICOUT,1253)
7307 1253     FORMAT('      ENCOUNTERED IN FORMING A PLOT.  DATA MAY NOT')
7308          CALL DPWRST('XXX','BUG ')
7309          WRITE(ICOUT,1255)
7310 1255     FORMAT('      BE ZERO OR NEGATIVE WHEN A LOG SCALE PLOT ',
7311     1           'IS USED.')
7312          CALL DPWRST('XXX','BUG ')
7313          WRITE(ICOUT,1256)PX(J)
7314 1256     FORMAT('      THE VALUE = ',G15.7)
7315          CALL DPWRST('XXX','BUG ')
7316          WRITE(ICOUT,1257)
7317 1257     FORMAT('      THIS VALUE CAME FROM THE HORIZONTAL AXIS ',
7318     1           'VARIABLE.')
7319          CALL DPWRST('XXX','BUG ')
7320          WRITE(ICOUT,1259)
7321 1259     FORMAT('      CORRECTIVE ACTION--')
7322          CALL DPWRST('XXX','BUG ')
7323          WRITE(ICOUT,1260)
7324 1260     FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
7325          CALL DPWRST('XXX','BUG ')
7326          IERRG4='YES'
7327          GOTO9000
7328        ENDIF
7329      ENDIF
7330C
7331      IF(IY1TSC.EQ.'LOG')THEN
7332        IFLAGN=0
7333        IF(IDIR.EQ.'V')THEN
7334          IF(ABA2BA.LE.0.0)HOLD=ABA2BA
7335          IF(ABA2BA.LE.0.0)IFLAGN=1
7336          GOTO1339
7337        ENDIF
7338C
7339        IF(ISORSW.EQ.'ON')THEN
7340          J=1
7341          IF(PY(J).LE.0.0)HOLD=PY(J)
7342          IF(PY(J).LE.0.0)IFLAGN=1
7343        ELSE
7344          DO1335I=1,NP
7345            J=I
7346            IF(PY(J).LE.0.0)HOLD=PY(J)
7347            IF(PY(J).LE.0.0)THEN
7348              IFLAGN=1
7349              GOTO1339
7350            ENDIF
7351 1335     CONTINUE
7352        ENDIF
7353C
7354 1339   CONTINUE
7355        IF(IFLAGN.EQ.1)THEN
7356          WRITE(ICOUT,999)
7357          CALL DPWRST('XXX','BUG ')
7358          WRITE(ICOUT,1351)
7359 1351     FORMAT('***** ERROR IN DPDRBA--')
7360          CALL DPWRST('XXX','BUG ')
7361          WRITE(ICOUT,1352)
7362 1352     FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE WAS')
7363          CALL DPWRST('XXX','BUG ')
7364          WRITE(ICOUT,1353)
7365 1353     FORMAT('      ENCOUNTERED IN FORMING A PLOT.  DATA MAY NOT')
7366          CALL DPWRST('XXX','BUG ')
7367          WRITE(ICOUT,1355)
7368 1355     FORMAT('      BE ZERO OR NEGATIVE.  WHEN A LOG SCALE PLOT ',
7369     1           'IS USED.')
7370          CALL DPWRST('XXX','BUG ')
7371          WRITE(ICOUT,1356)HOLD
7372 1356     FORMAT('      THE VALUE = ',E15.7)
7373          CALL DPWRST('XXX','BUG ')
7374          WRITE(ICOUT,1357)
7375 1357     FORMAT('      THIS VALUE CAME FROM THE VERTICAL AXIS ',
7376     1           'VARIABLE.')
7377          CALL DPWRST('XXX','BUG ')
7378          WRITE(ICOUT,1259)
7379          CALL DPWRST('XXX','BUG ')
7380          WRITE(ICOUT,1260)
7381          CALL DPWRST('XXX','BUG ')
7382          IERRG4='YES'
7383          GOTO9000
7384        ENDIF
7385      ENDIF
7386C
7387      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7388        WRITE(ICOUT,1391)
7389 1391   FORMAT('AT BRANCH POINT 1390')
7390        CALL DPWRST('XXX','BUG ')
7391      ENDIF
7392C
7393C               ******************************************
7394C               **  STEP 40--                           **
7395C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
7396C               **  TRANSFORM THE DATA                  **
7397C               ******************************************
7398C
7399      ABASE=ABA2BA
7400      AWIDTH=ABA2WI
7401C
7402      IF(IDIR.EQ.'V')THEN
7403        IF(AWIDTH.EQ.CPUMIN.AND.XDELMN.LE.0.0)AWIDTH=1.0
7404        IF(AWIDTH.EQ.CPUMIN.AND.XDELMN.GT.0.0)AWIDTH=XDELMN
7405      ELSEIF(IDIR.EQ.'H')THEN
7406        IF(AWIDTH.EQ.CPUMIN.AND.XDELMN.LE.0.0)AWIDTH=1.0
7407        IF(AWIDTH.EQ.CPUMIN.AND.XDELMN.GT.0.0)AWIDTH=XDELMN
7408      ENDIF
7409C
7410      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7411        WRITE(ICOUT,4008) ABASE,AWIDTH
7412 4008   FORMAT('ABASE,AWIDTH =',2G15.7)
7413        CALL DPWRST('XXX','BUG ')
7414      ENDIF
7415C
7416      IF(IX1TSC.EQ.'LOG')THEN
7417        IF(IDIR.EQ.'H')ABASE=LOG10(ABASE)
7418        DO4015I=1,NP
7419          PX(I)=LOG10(PX(I))
7420 4015   CONTINUE
7421        IF(IFLAGH.EQ.1)THEN
7422          DO4016I=1,NP
7423            PZ(I)=LOG10(PZ(I))
7424 4016     CONTINUE
7425        ENDIF
7426      ENDIF
7427C
7428      IF(IY1TSC.EQ.'LOG')THEN
7429        IF(IDIR.EQ.'V')ABASE=LOG10(ABASE)
7430        DO4025I=1,NP
7431          PY(I)=LOG10(PY(I))
7432 4025   CONTINUE
7433      ENDIF
7434C
7435C               *****************************************************
7436C               **  STEP 50--                                      **
7437C               **  TRANSLATE THE DATA POINTS                      **
7438C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
7439C               *****************************************************
7440C
7441      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7442        WRITE(ICOUT,4999)
7443 4999   FORMAT( 'AT 5001 BREAKPOINT')
7444        CALL DPWRST('XXX','BUG ')
7445      ENDIF
7446C
7447      FXMIN=FX1MIN
7448      FXMAX=FX1MAX
7449      IF(IX1TSC.EQ.'LOG')THEN
7450        FXMIN=LOG10(FX1MIN)
7451        FXMAX=LOG10(FX1MAX)
7452      ENDIF
7453C
7454      FYMIN=FY1MIN
7455      FYMAX=FY1MAX
7456      IF(IY1TSC.EQ.'LOG')THEN
7457        FYMIN=LOG10(FY1MIN)
7458        FYMAX=LOG10(FY1MAX)
7459      ENDIF
7460C
7461      FXRANG=FXMAX-FXMIN
7462      FYRANG=FYMAX-FYMIN
7463      PXRANG=PXMAX-PXMIN
7464      PYRANG=PYMAX-PYMIN
7465C
7466      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7467        WRITE(ICOUT,4993) FXMIN,FXMAX,FYMIN,FYMAX
7468 4993   FORMAT('FXMIN,FXMAX,FYMIN,FYMAX=',4(E15.7,1X))
7469        CALL DPWRST('XXX','BUG ')
7470        WRITE(ICOUT,4994) FXRANG,FYRANG,PXRANG,PYRANG
7471 4994   FORMAT('FXRANG,FYRANG,PXRANG,PYRANG=',6(E15.7,1X))
7472        CALL DPWRST('XXX','BUG ')
7473      ENDIF
7474C
7475      DO5000I=1,NP
7476        FXRATI=(PX(I)-FXMIN)/FXRANG
7477        FYRATI=(PY(I)-FYMIN)/FYRANG
7478        PX(I)=PXMIN+FXRATI*PXRANG
7479        PY(I)=PYMIN+FYRATI*PYRANG
7480 5000 CONTINUE
7481C
7482      IF(IFLAGH.EQ.1)THEN
7483        DO5002I=1,NP
7484          FXRAT2=(PZ(I)-FXMIN)/FXRANG
7485          PZ(I)=PXMIN+FXRAT2*PXRANG
7486 5002   CONTINUE
7487      ENDIF
7488C
7489      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7490        DO5004I=1,NP
7491          WRITE(ICOUT,5006) PX(I),PY(I),PZ(I)
7492 5006     FORMAT('PX(I),PY(I),PZ(I)=',3(E15.7,1X))
7493          CALL DPWRST('XXX','BUG ')
7494 5004   CONTINUE
7495      ENDIF
7496C
7497      IF(IDIR.EQ.'V')THEN
7498        FYRATI=(ABASE-FYMIN)/FYRANG
7499        PBASE=PYMIN+FYRATI*PYRANG
7500        PWIDTH=AWIDTH*(PXRANG/FXRANG)
7501      ELSEIF(IDIR.EQ.'H')THEN
7502        FXRATI=(ABASE-FXMIN)/FXRANG
7503        PBASE=PXMIN+FXRATI*PXRANG
7504        PWIDTH=AWIDTH*(PYRANG/FYRANG)
7505      ENDIF
7506C
7507      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7508        WRITE(ICOUT,5038) FXRATI,PBASE,PWIDTH
7509 5038   FORMAT('FXRATI,PBASE,PWIDTH=',3(E15.7,1X))
7510        CALL DPWRST('XXX','BUG ')
7511      ENDIF
7512C
7513C               *******************************
7514C               **  STEP 70--                **
7515C               **  PREPARE TO MAKE VARIOUS  **
7516C               **  LINE SETTINGS            **
7517C               *******************************
7518C
7519      ITYPE='LINE'
7520C
7521      IFIG='BOX'
7522      IF(IBA2TY.EQ.'3')IFIG='CUBE'
7523      IFIGSV=IFIG
7524      PBASE2=PBASE
7525C
7526      CALL DPSQUE(PX,PY,NP,PXMIN,PXMAX,PYMIN,PYMAX)
7527C
7528      IF(IFLAGH.EQ.1)THEN
7529        CALL DPSQUE(PX,PZ,NP,PXMIN,PXMAX,PYMIN,PYMAX)
7530      ENDIF
7531C
7532C               ***************************************
7533C               **  STEP 81--                        **
7534C               **  DRAW OUT ALL VERTICAL BARS       **
7535C               **  (BUT FILL FIRST, IF CALLED FOR)  **
7536C               ***************************************
7537C
7538      IF(IDIR.EQ.'V')GOTO8100
7539      GOTO8190
7540C
7541 8100 CONTINUE
7542C  SEPTEMBER, 1987 - MOVE SETTINGS INSIDE THE LOOP
7543CCCCC IPATT=IBA2PT
7544CCCCC PTHICK=PBA2PT
7545CCCCC PXGAP=PBA2PS
7546CCCCC PYGAP=PBA2PS
7547CCCCC ICOLF=IBA2FC
7548CCCCC ICOLP=IBA2PC
7549C
7550      IF(PBASE2.LT.PYMIN.AND.(PYMIN-PBASE2).LE.0.0001)PBASE2=PYMIN
7551      IF(PBASE2.GT.PYMAX.AND.(PBASE2-PYMAX).LE.0.0001)PBASE2=PYMAX
7552C
7553      DO8105I=1,NP
7554C
7555        IPATT=IBA2PT
7556        IPATT2=IBA2PL
7557        PTHICK=PBA2PT
7558        PXGAP=PBA2PS
7559        PYGAP=PBA2PS
7560        ICOLF=IBA2FC
7561        ICOLP=IBA2PC
7562C
7563        IF(IFLAGH.EQ.1)THEN
7564          PLEFT=PX(I)
7565          PRIGHT=PZ(I)
7566        ELSE
7567          PLEFT=PX(I)-PWIDTH/2.0
7568          PRIGHT=PX(I)+PWIDTH/2.0
7569        ENDIF
7570        IF(PLEFT.LT.PXMIN.AND.(PXMIN-PLEFT).LE.0.0001)PLEFT=PXMIN
7571        IF(PRIGHT.GT.PXMAX.AND.(PRIGHT-PXMAX).LE.0.0001)PRIGHT=PXMAX
7572C
7573        IF(PRIGHT.LT.PXMIN)GOTO8105
7574        IF(PLEFT.GT.PXMAX)GOTO8105
7575        IF(PY(I).LT.PYMIN.AND.PBASE2.LT.PYMIN)GOTO8105
7576        IF(PY(I).GT.PYMAX.AND.PBASE2.GT.PYMAX)GOTO8105
7577C
7578        X1=PLEFT
7579        Y1=PBASE2
7580        X2=PRIGHT
7581        Y2=PY(I)
7582C
7583        DELX=ABS(X2-X1)
7584        DELY=ABS(Y2-Y1)
7585        DELMIN=DELX
7586CCCCC   IF(DELY.LT.DELX)DELMIN=DELY
7587        P3D=0.3
7588        DEL3D=P3D*DELMIN
7589C
7590        IF(IBA2FS.EQ.'OFF')GOTO8150
7591C
7592        IF(IBA2FS.EQ.'ONS')GOTO8120
7593        IF(IBA2FS.EQ.'ONST')GOTO8120
7594        IF(IBA2FS.EQ.'ONTS')GOTO8120
7595        IF(IBA2FS.EQ.'ONT')GOTO8130
7596C
7597        IF(IBA2FS.EQ.'ON'   .OR. IBA2FS.EQ.'ONF'  .OR.
7598     1     IBA2FS.EQ.'ONFS' .OR. IBA2FS.EQ.'ONSF' .OR.
7599     1     IBA2FS.EQ.'ONFT' .OR. IBA2FS.EQ.'ONTF')THEN
7600C
7601C         FRONT FACE
7602C
7603          PX2(1)=X1
7604          PY2(1)=Y1
7605C
7606          PX2(2)=X2
7607          PY2(2)=Y1
7608C
7609          PX2(3)=X2
7610          PY2(3)=Y2
7611C
7612          PX2(4)=X1
7613          PY2(4)=Y2
7614C
7615          PX2(5)=X1
7616          PY2(5)=Y1
7617C
7618          NP2=5
7619C
7620          DO8115J=1,NP2
7621            IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7622            IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7623            IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7624            IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7625 8115     CONTINUE
7626          CALL DPFIRE(PX2,PY2,NP2,
7627     1                IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
7628     1                IPATT2)
7629C
7630        ENDIF
7631 8120   CONTINUE
7632C
7633        IF(IBA2TY.EQ.'2')GOTO8150
7634        IF(IBA2FS.EQ.'ONF')GOTO8150
7635        IF(IBA2FS.EQ.'ONT')GOTO8130
7636        IF(IBA2FS.EQ.'ONFT')GOTO8130
7637        IF(IBA2FS.EQ.'ONTF')GOTO8130
7638C
7639        IF(IBA2FS.EQ.'ON'   .OR. IBA2FS.EQ.'ONS'  .OR.
7640     1     IBA2FS.EQ.'ONFS' .OR. IBA2FS.EQ.'ONSF' .OR.
7641     1     IBA2FS.EQ.'ONST' .OR. IBA2FS.EQ.'ONTS')THEN
7642C
7643C         SIDE (= RIGHT) FACE
7644C
7645          PX2(1)=X2
7646          PY2(1)=Y2
7647C
7648          PX2(2)=X2+DEL3D
7649          PY2(2)=Y2+DEL3D
7650C
7651          PX2(3)=X2+DEL3D
7652          PY2(3)=Y1+DEL3D
7653C
7654          PX2(4)=X2
7655          PY2(4)=Y1
7656C
7657          PX2(5)=X2
7658          PY2(5)=Y2
7659C
7660          NP2=5
7661C
7662          DO8125J=1,NP2
7663            IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7664            IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7665            IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7666            IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7667 8125     CONTINUE
7668          CALL DPFIRE(PX2,PY2,NP2,
7669     1                IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
7670     1                IPATT2)
7671        ENDIF
7672C
7673 8130   CONTINUE
7674C
7675        IF(IBA2FS.EQ.'ONF')GOTO8150
7676        IF(IBA2FS.EQ.'ONS')GOTO8150
7677        IF(IBA2FS.EQ.'ONFS')GOTO8150
7678        IF(IBA2FS.EQ.'ONSF')GOTO8150
7679C
7680        IF(IBA2FS.EQ.'ON'   .OR. IBA2FS.EQ.'ONT'  .OR.
7681     1     IBA2FS.EQ.'ONFT' .OR. IBA2FS.EQ.'ONTF' .OR.
7682     1     IBA2FS.EQ.'ONST' .OR. IBA2FS.EQ.'ONTS')THEN
7683C
7684C         TOP FACE
7685C
7686          PX2(1)=X1
7687          PY2(1)=Y2
7688C
7689          PX2(2)=X1+DEL3D
7690          PY2(2)=Y2+DEL3D
7691C
7692          PX2(3)=X2+DEL3D
7693          PY2(3)=Y2+DEL3D
7694C
7695          PX2(4)=X2
7696          PY2(4)=Y2
7697C
7698          PX2(5)=X1
7699          PY2(5)=Y2
7700C
7701          NP2=5
7702C
7703          DO8135J=1,NP2
7704            IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7705            IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7706            IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7707            IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7708 8135     CONTINUE
7709          CALL DPFIRE(PX2,PY2,NP2,
7710     1                IFIG,IPATT,PTHICK,PX2GAP,PYGAP,ICOLF,ICOLP,
7711     1                IPATT2)
7712        ENDIF
7713C
7714 8150   CONTINUE
7715C
7716C       DRAW OUT THE EDGES OF THE BAR
7717C
7718        IPATT=IBA2BL
7719        PTHICK=PBA2BT
7720        ICOL=IBA2BC
7721C
7722        PX2(1)=X1
7723        PY2(1)=Y1
7724C
7725        PX2(2)=X2
7726        PY2(2)=Y1
7727C
7728        PX2(3)=X2
7729        PY2(3)=Y2
7730C
7731        PX2(4)=X1
7732        PY2(4)=Y2
7733C
7734        PX2(5)=X1
7735        PY2(5)=Y1
7736C
7737        NP2=5
7738C
7739        DO8151J=1,NP2
7740          IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7741          IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7742          IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7743          IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7744 8151   CONTINUE
7745        IFLAG='ON'
7746        CALL DPDRPL(PX2,PY2,NP2,
7747     1              IFIG,IPATT,PTHICK,ICOL,
7748     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
7749C
7750        IF(IBA2TY.EQ.'2')GOTO8105
7751C
7752        PX2(1)=X1
7753        PY2(1)=Y2
7754C
7755        PX2(2)=X1+DEL3D
7756        PY2(2)=Y2+DEL3D
7757C
7758        PX2(3)=X2+DEL3D
7759        PY2(3)=Y2+DEL3D
7760C
7761        PX2(4)=X2
7762        PY2(4)=Y2
7763C
7764        NP2=4
7765C
7766        DO8152J=1,NP2
7767          IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7768          IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7769          IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7770          IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7771 8152   CONTINUE
7772        IFLAG='OFF'
7773        CALL DPDRPL(PX2,PY2,NP2,
7774     1              IFIG,IPATT,PTHICK,ICOL,
7775     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
7776C
7777        PX2(1)=X2+DEL3D
7778        PY2(1)=Y2+DEL3D
7779C
7780        PX2(2)=X2+DEL3D
7781        PY2(2)=Y1+DEL3D
7782C
7783        PX2(3)=X2
7784        PY2(3)=Y1
7785C
7786        NP2=3
7787C
7788        DO8153J=1,NP2
7789          IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7790          IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7791          IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7792          IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7793 8153   CONTINUE
7794        IFLAG='OFF'
7795        CALL DPDRPL(PX2,PY2,NP2,
7796     1              IFIG,IPATT,PTHICK,ICOL,
7797     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
7798C
7799 8105 CONTINUE
7800C
7801 8190 CONTINUE
7802C
7803C               ***************************************
7804C               **  STEP 82--                        **
7805C               **  DRAW OUT ALL HORIZONTAL BARS     **
7806C               **  (BUT FILL FIRST, IF CALLED FOR)  **
7807C               ***************************************
7808C
7809      IF(IDIR.EQ.'H')GOTO8200
7810      GOTO8290
7811C
7812 8200 CONTINUE
7813C SEPTEMBER, 1987: MOVE INSIDE LOOP
7814CCCCC IPATT=IBA2PT
7815CCCCC PTHICK=PBA2PT
7816CCCCC PXGAP=PBA2PS
7817CCCCC PYGAP=PBA2PS
7818CCCCC ICOLF=IBA2FC
7819CCCCC ICOLP=IBA2PC
7820C
7821      IF(PBASE2.LT.PXMIN.AND.(PXMIN-PBASE2).LE.0.0001)PBASE2=PXMIN
7822      IF(PBASE2.GT.PXMAX.AND.(PBASE2-PXMAX).LE.0.0001)PBASE2=PXMAX
7823C
7824      DO8205I=1,NP
7825C
7826        IPATT=IBA2PT
7827        IPATT2=IBA2PL
7828        PTHICK=PBA2PT
7829        PXGAP=PBA2PS
7830        PYGAP=PBA2PS
7831        ICOLF=IBA2FC
7832        ICOLP=IBA2PC
7833C
7834        IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7835          WRITE(ICOUT,8203)
7836 8203     FORMAT('IN 8200 LOOP')
7837          CALL DPWRST('XXX','BUG ')
7838        ENDIF
7839C
7840        IF(IFLAGH.EQ.1)THEN
7841          PBOT=PY(I)
7842          PTOP=PZ(I)
7843        ELSE
7844          PBOT=PY(I)-PWIDTH/2.0
7845          PTOP=PY(I)+PWIDTH/2.0
7846        ENDIF
7847        IF(PBOT.LT.PYMIN.AND.(PYMIN-PBOT).LE.0.0001)PBOT=PYMIN
7848        IF(PTOP.GT.PYMAX.AND.(PTOP-PYMAX).LE.0.0001)PTOP=PYMAX
7849C
7850        IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
7851          WRITE(ICOUT,8204) PBOT,PTOP
7852 8204     FORMAT('PBOT,PTOP=',2(E15.7,1X))
7853          CALL DPWRST('XXX','BUG ')
7854        ENDIF
7855C
7856        IF(PTOP.LT.PYMIN)GOTO8205
7857        IF(PBOT.GT.PYMAX)GOTO8205
7858        IF(PX(I).LT.PXMIN.AND.PBASE2.LT.PXMIN)GOTO8205
7859        IF(PX(I).GT.PXMAX.AND.PBASE2.GT.PXMAX)GOTO8205
7860C
7861        X1=PBASE2
7862        Y1=PBOT
7863        X2=PX(I)
7864        Y2=PTOP
7865C
7866        DELX=ABS(X2-X1)
7867        DELY=ABS(Y2-Y1)
7868        DELMIN=DELY
7869CCCCC   IF(DELX.LT.DELY)DELMIN=DELX
7870        P3D=0.3
7871        DEL3D=P3D*DELMIN
7872C
7873        IF(IBA2FS.EQ.'OFF')GOTO8250
7874        IF(IBA2FS.EQ.'ONS')GOTO8220
7875        IF(IBA2FS.EQ.'ONST')GOTO8220
7876        IF(IBA2FS.EQ.'ONTS')GOTO8220
7877        IF(IBA2FS.EQ.'ONT')GOTO8230
7878C
7879        IF(IBA2FS.EQ.'ON'   .OR. IBA2FS.EQ.'ONF'  .OR.
7880     1     IBA2FS.EQ.'ONFS' .OR. IBA2FS.EQ.'ONSF' .OR.
7881     1     IBA2FS.EQ.'ONFT' .OR. IBA2FS.EQ.'ONTF')THEN
7882C
7883C         FRONT FACE
7884C
7885          PX2(1)=X1
7886          PY2(1)=Y1
7887C
7888          PX2(2)=X2
7889          PY2(2)=Y1
7890C
7891          PX2(3)=X2
7892          PY2(3)=Y2
7893C
7894          PX2(4)=X1
7895          PY2(4)=Y2
7896C
7897          PX2(5)=X1
7898          PY2(5)=Y1
7899C
7900          NP2=5
7901C
7902          DO8215J=1,NP2
7903            IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7904            IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7905            IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7906            IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7907 8215     CONTINUE
7908          CALL DPFIRE(PX2,PY2,NP2,
7909     1                IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
7910     1                IPATT2)
7911        ENDIF
7912C
7913 8220   CONTINUE
7914C
7915        IF(IBA2TY.EQ.'2')GOTO8250
7916        IF(IBA2FS.EQ.'ONF')GOTO8250
7917        IF(IBA2FS.EQ.'ONT')GOTO8230
7918        IF(IBA2FS.EQ.'ONFT')GOTO8230
7919        IF(IBA2FS.EQ.'ONTF')GOTO8230
7920C
7921        IF(IBA2FS.EQ.'ON'   .OR. IBA2FS.EQ.'ONS'  .OR.
7922     1     IBA2FS.EQ.'ONFS' .OR. IBA2FS.EQ.'ONSF' .OR.
7923     1     IBA2FS.EQ.'ONST' .OR. IBA2FS.EQ.'ONTS')THEN
7924C
7925C         SIDE (= RIGHT) FACE
7926C
7927          PX2(1)=X2
7928          PY2(1)=Y2
7929C
7930          PX2(2)=X2+DEL3D
7931          PY2(2)=Y2+DEL3D
7932C
7933          PX2(3)=X2+DEL3D
7934          PY2(3)=Y1+DEL3D
7935C
7936          PX2(4)=X2
7937          PY2(4)=Y1
7938C
7939          PX2(5)=X2
7940          PY2(5)=Y2
7941C
7942          NP2=5
7943C
7944          DO8225J=1,NP2
7945            IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7946            IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7947            IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7948            IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7949 8225     CONTINUE
7950          CALL DPFIRE(PX2,PY2,NP2,
7951     1                IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
7952     1                IPATT2)
7953        ENDIF
7954C
7955 8230   CONTINUE
7956C
7957        IF(IBA2FS.EQ.'ONF')GOTO8250
7958        IF(IBA2FS.EQ.'ONS')GOTO8250
7959        IF(IBA2FS.EQ.'ONFS')GOTO8250
7960        IF(IBA2FS.EQ.'ONSF')GOTO8250
7961C
7962        IF(IBA2FS.EQ.'ON'  .OR. IBA2FS.EQ.'ONT'  .OR.
7963     1    IBA2FS.EQ.'ONFT' .OR. IBA2FS.EQ.'ONTF' .OR.
7964     1    IBA2FS.EQ.'ONST' .OR. IBA2FS.EQ.'ONTS')THEN
7965C
7966C         TOP FACE
7967C
7968          PX2(1)=X1
7969          PY2(1)=Y2
7970C
7971          PX2(2)=X1+DEL3D
7972          PY2(2)=Y2+DEL3D
7973C
7974          PX2(3)=X2+DEL3D
7975          PY2(3)=Y2+DEL3D
7976C
7977          PX2(4)=X2
7978          PY2(4)=Y2
7979C
7980          PX2(5)=X1
7981          PY2(5)=Y2
7982C
7983          NP2=5
7984C
7985          DO8235J=1,NP2
7986            IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
7987            IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
7988            IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
7989            IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
7990 8235     CONTINUE
7991          CALL DPFIRE(PX2,PY2,NP2,
7992     1                IFIG,IPATT,PTHICK,PX2GAP,PYGAP,ICOLF,ICOLP,
7993     1                IPATT2)
7994        ENDIF
7995C
7996 8250   CONTINUE
7997C
7998C       DRAW OUT THE EDGES OF THE BAR
7999C
8000        IPATT=IBA2BL
8001        PTHICK=PBA2BT
8002        ICOL=IBA2BC
8003C
8004        PX2(1)=X1
8005        PY2(1)=Y1
8006C
8007        PX2(2)=X2
8008        PY2(2)=Y1
8009C
8010        PX2(3)=X2
8011        PY2(3)=Y2
8012C
8013        PX2(4)=X1
8014        PY2(4)=Y2
8015C
8016        PX2(5)=X1
8017        PY2(5)=Y1
8018C
8019        NP2=5
8020C
8021        DO8251J=1,NP2
8022          IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
8023          IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
8024          IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
8025          IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
8026 8251   CONTINUE
8027        IFLAG='ON'
8028        CALL DPDRPL(PX2,PY2,NP2,
8029     1              IFIG,IPATT,PTHICK,ICOL,
8030     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8031C
8032        IF(IBA2TY.EQ.'2')GOTO8205
8033C
8034        PX2(1)=X1
8035        PY2(1)=Y2
8036C
8037        PX2(2)=X1+DEL3D
8038        PY2(2)=Y2+DEL3D
8039C
8040        PX2(3)=X2+DEL3D
8041        PY2(3)=Y2+DEL3D
8042C
8043        PX2(4)=X2
8044        PY2(4)=Y2
8045C
8046        NP2=4
8047C
8048        DO8252J=1,NP2
8049          IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
8050          IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
8051          IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
8052          IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
8053 8252   CONTINUE
8054        IFLAG='OFF'
8055        CALL DPDRPL(PX2,PY2,NP2,
8056     1              IFIG,IPATT,PTHICK,ICOL,
8057     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8058C
8059        PX2(1)=X2+DEL3D
8060        PY2(1)=Y2+DEL3D
8061C
8062        PX2(2)=X2+DEL3D
8063        PY2(2)=Y1+DEL3D
8064C
8065        PX2(3)=X2
8066        PY2(3)=Y1
8067C
8068        NP2=3
8069C
8070        DO8253J=1,NP2
8071          IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
8072          IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
8073          IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
8074          IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
8075 8253   CONTINUE
8076        IFLAG='OFF'
8077        CALL DPDRPL(PX2,PY2,NP2,
8078     1              IFIG,IPATT,PTHICK,ICOL,
8079     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8080C
8081 8205 CONTINUE
8082C
8083 8290 CONTINUE
8084C
8085C               *****************
8086C               **  STEP 90--  **
8087C               **  EXIT       **
8088C               *****************
8089C
8090 9000 CONTINUE
8091      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRBA')THEN
8092        WRITE(ICOUT,999)
8093        CALL DPWRST('XXX','BUG ')
8094        WRITE(ICOUT,9011)
8095 9011   FORMAT('***** AT THE END       OF DPDRBA--')
8096        CALL DPWRST('XXX','BUG ')
8097        WRITE(ICOUT,9013)NP,ICASPL,ICAS3D,ISORSW
8098 9013   FORMAT('NP,ICASPL,ICAS3D,ISORSW = ',I8,3(2X,A4))
8099        CALL DPWRST('XXX','BUG ')
8100        WRITE(ICOUT,9014)ABASE,HOLD,PBASE,PBASE2,PLEFT,PRIGHT
8101 9014   FORMAT('ABASE,HOLD,PBASE,PBASE2,PLEFT,PRIGHT = ',6E15.7)
8102        CALL DPWRST('XXX','BUG ')
8103        WRITE(ICOUT,9015)XDELMN,AWIDTH,PWIDTH
8104 9015   FORMAT('XDELMN,AWIDTH,PWIDTH = ',3G15.7)
8105        CALL DPWRST('XXX','BUG ')
8106        IF(NP.GT.3)THEN
8107          DO9025I=1,3
8108            WRITE(ICOUT,9026)I,X(I),Y(I)
8109 9026       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
8110            CALL DPWRST('XXX','BUG ')
8111 9025     CONTINUE
8112          NPM2=NP-2
8113          DO9027I=NPM2,NP
8114            WRITE(ICOUT,9028)I,X(I),Y(I)
8115 9028       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
8116            CALL DPWRST('XXX','BUG ')
8117 9027     CONTINUE
8118        ENDIF
8119        WRITE(ICOUT,9031)IBA2SW,ABA2WI,ABA2BA
8120 9031   FORMAT('IBA2SW,ABA2WI,ABA2BA = ',A4,2X,2G15.7)
8121        CALL DPWRST('XXX','BUG ')
8122        WRITE(ICOUT,9032)IBA2BL,IBA2BC,PBA2BT
8123 9032   FORMAT('IBA2BL,IBA2BC,PBA2BT = ',A4,2X,A4,2X,G15.7)
8124        CALL DPWRST('XXX','BUG ')
8125        WRITE(ICOUT,9033)IBA2FS,IBA2FC,IBA2PT
8126 9033   FORMAT('IBA2FS,IBA2FC,IBA2PT = ',A4,2X,A4,2X,A4)
8127        CALL DPWRST('XXX','BUG ')
8128        WRITE(ICOUT,9034)IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT
8129 9034   FORMAT('IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT = ',
8130     1         A4,2X,A4,2X,A4,2X,A4,2X,2E15.7)
8131        CALL DPWRST('XXX','BUG ')
8132        WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
8133 9044   FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4G15.7)
8134        CALL DPWRST('XXX','BUG ')
8135        WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
8136 9045   FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4G15.7)
8137        CALL DPWRST('XXX','BUG ')
8138        WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
8139 9046   FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4G15.7)
8140        CALL DPWRST('XXX','BUG ')
8141        WRITE(ICOUT,9047)IX1TSC,IY1TSC
8142 9047   FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
8143        CALL DPWRST('XXX','BUG ')
8144        WRITE(ICOUT,9052)IFIG,IPATT,JPATT
8145 9052   FORMAT('IFIG,IPATT,JPATT = ',A4,2X,A4,I8)
8146        CALL DPWRST('XXX','BUG ')
8147        WRITE(ICOUT,9053)PTHICK,JTHICK,PTHIC2
8148 9053   FORMAT('PTHICK,JTHICK,PTHIC2 = ',G15.7,I8,G15.7)
8149        CALL DPWRST('XXX','BUG ')
8150        WRITE(ICOUT,9054)ICOL,JCOL,IDIR,ITYPE
8151 9054   FORMAT('ICOL,JCOL,IDIR,ITYPE = ',A4,I8,2X,A4,2X,A4)
8152        CALL DPWRST('XXX','BUG ')
8153        WRITE(ICOUT,9069)IBUGG4,ISUBG4,IERRG4
8154 9069   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8155        CALL DPWRST('XXX','BUG ')
8156      ENDIF
8157C
8158      RETURN
8159      END
8160      SUBROUTINE DPDRCH(Y,X,PY,PX,NP,PY2,PX2,NP2,X3D,
8161     1                  ICASPL,ICAS3D,ISORSW,ARE2BA,
8162     1                  ICH2PA,ICH2FO,ICH2CA,ICH2JU,ICH2DI,
8163     1                  ACH2AN,ICH2FI,ICH2CO,ICH2TY,
8164     1                  PCH2HE,PCH2WI,PCH2TH,PCH2HO,PCH2VO,
8165     1                  ITEXSP,
8166     1                  PXMIN,PXMAX,PYMIN,PYMAX,
8167     1                  FX1MIN,FX1MAX,FY1MIN,FY1MAX,
8168     1                  IX1TSC,IY1TSC,
8169     1                  IMPSW2,AMPSCH,AMPSCW)
8170C
8171C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE, DRAW A CHARACTER TRACE OF
8172C              Y(.) VERSUS X(.), THAT IS, DRAW A SPECIFIED MARKER
8173C              (= CHARACTER) TYPE AT EACH OF THE PLOT POINTS.
8174C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES WHICH ARE
8175C           USED IN THE INTERMEDIATE CALCULATIONS AND WHOSE DIMENSIONS
8176C           ARE DEFINED (FOR EASY OF CHANGE) BACK IN THE MAIN ROUTINE.
8177C
8178C     WRITTEN BY--JAMES J. FILLIBEN
8179C                 STATISTICAL ENGINEERING DIVISION
8180C                 INFORMATION TECHNOLOGY LABORATORY
8181C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8182C                 GAITHERSBURG, MD 20899-8980
8183C                 PHONE--301-975-2855
8184C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8185C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8186C     LANGUAGE--ANSI FORTRAN (1977)
8187C     VERSION NUMBER--83.6
8188C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
8189C     UPDATED         --DECEMBER  1987.  INDEPENDENT CONTROL OF CHAR WIDTH.
8190C     UPDATED         --SEPTEMBER 1988.  LOG/WEIBULL CHECK AS A SUBROUTINE
8191C     UPDATED         --SEPTEMBER 1988.  RENUMBER
8192C     UPDATED         --SEPTEMBER 1988.  IBUGG4 FOR IBUGPL
8193C     UPDATED         --JUNE      1990.  NORMAL PLOT
8194C     UPDATED         --MAY       1992.  ADD ARE2BA AS INPUT ARGUMENT
8195C     UPDATED         --DECEMBER  1996.  SIMPLIFY NORMAL PLOT
8196C     UPDATED         --SEPTEMBER 1999.  ARGUMENT LIST TO DPCLCH
8197C     UPDATED         --JANUARY   2000.  ADD X3D TO ARGUEMNT LIST
8198C     UPDATED         --DECEMBER  2006.  SUPPORT FOR TRILINEAR PLOTS
8199C     UPDATED         --JANUARY   2018.  ICH2TY - SPECIFY WHETHER
8200C                                        CHARACTER COORDINATES ARE IN
8201C                                        SCREEN UNITS OR DATA UNITS
8202C
8203C-----NON-COMMON VARIABLES (GRAPHICS)-----------------------------------
8204C
8205      CHARACTER*4 ICASPL
8206      CHARACTER*4 ICAS3D
8207      CHARACTER*4 ISORSW
8208C
8209CCCCC CHARACTER*4 ICH2PA
8210      CHARACTER*24 ICH2PA
8211      CHARACTER*4 ICH2FO
8212      CHARACTER*4 ICH2CA
8213      CHARACTER*4 ICH2JU
8214      CHARACTER*4 ICH2DI
8215      CHARACTER*4 ICH2FI
8216      CHARACTER*4 ICH2CO
8217      CHARACTER*4 ICH2TY
8218C
8219      CHARACTER*4 ITEXSP
8220      CHARACTER*4 IX1TSC
8221      CHARACTER*4 IY1TSC
8222C
8223      CHARACTER*4 IFIG
8224      CHARACTER*24 IPATT
8225      CHARACTER*4 IFONT
8226      CHARACTER*4 ICASE
8227      CHARACTER*4 IJUST
8228      CHARACTER*4 IDIR
8229      CHARACTER*4 IFILL
8230      CHARACTER*4 ICOL
8231C
8232      CHARACTER*24 ISYMBL
8233      CHARACTER*4 ISPAC
8234      CHARACTER*4 IMPSW2
8235C
8236      CHARACTER*4 ICASAX
8237C
8238      DIMENSION Y(*)
8239      DIMENSION X(*)
8240      DIMENSION X3D(*)
8241      DIMENSION PY(*)
8242      DIMENSION PX(*)
8243      DIMENSION PY2(*)
8244      DIMENSION PX2(*)
8245C
8246C-----COMMON----------------------------------------------------------
8247C
8248      INCLUDE 'DPCOGR.INC'
8249      INCLUDE 'DPCOBE.INC'
8250      INCLUDE 'DPCOP2.INC'
8251C
8252C-----START POINT-----------------------------------------------------
8253C
8254      FXMIN=FX1MIN
8255      FXMAX=FX1MAX
8256      FYMIN=FY1MIN
8257      FYMAX=FY1MAX
8258C
8259      PXMINS=PXMIN
8260      PXMAXS=PXMAX
8261      PYMINS=PYMIN
8262      PYMAXS=PYMAX
8263C
8264      AHUNDR=100.0
8265C
8266      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRCH')THEN
8267        WRITE(ICOUT,999)
8268  999   FORMAT(1X)
8269        CALL DPWRST('XXX','BUG ')
8270        WRITE(ICOUT,51)
8271   51   FORMAT('***** AT THE BEGINNING OF DPDRCH--')
8272        CALL DPWRST('XXX','BUG ')
8273        WRITE(ICOUT,53)ICASPL,ICAS3D,NP
8274   53   FORMAT('ICASPL,ICAS3D,NP = ',2(A4,2X),I8)
8275        CALL DPWRST('XXX','BUG ')
8276        IF(NP.GT.3)THEN
8277          DO65I=1,3
8278            WRITE(ICOUT,66)I,X(I),Y(I),X3D(I)
8279   66       FORMAT('I,X(I),Y(I),X3D(I) = ',I8,3G15.7)
8280            CALL DPWRST('XXX','BUG ')
8281   65     CONTINUE
8282          NPM2=NP-2
8283          DO67I=NPM2,NP
8284            WRITE(ICOUT,68)I,X(I),Y(I),X3D(I)
8285   68       FORMAT('I,X(I),Y(I) = ',I8,3G15.7)
8286            CALL DPWRST('XXX','BUG ')
8287   67     CONTINUE
8288        ENDIF
8289        WRITE(ICOUT,70)ISORSW,ARE2BA
8290   70   FORMAT('ISORSW,ARE2BA = ',A4,2X,G15.7)
8291        CALL DPWRST('XXX','BUG ')
8292        WRITE(ICOUT,74)ICH2PA,ICH2FO,ICH2JU,ICH2DI,ICH2TY
8293   74   FORMAT('ICH2PA,ICH2FO,ICH2JU,ICH2DI,ICH2TY = ',A24,4(A4,1X))
8294        CALL DPWRST('XXX','BUG ')
8295        WRITE(ICOUT,79)ICH2FI,ICH2CO,ITEXSP,IX1TSC,IY1TSC
8296   79   FORMAT('ICH2FI,ICH2CO,ITEXSP,IX1TSC,IY1TSC = ',4(A4,2X),A4)
8297        CALL DPWRST('XXX','BUG ')
8298        WRITE(ICOUT,78)ACH2AN,PCH2HE,PCH2WI
8299   78   FORMAT('ACH2AN,PCH2HE,PCH2WI = ',3G15.7)
8300        CALL DPWRST('XXX','BUG ')
8301        WRITE(ICOUT,83)PCH2TH,PCH2VO,PCH2HO
8302   83   FORMAT('PCH2TH,PCH2VO,PCH2HO= ',3G15.7)
8303        CALL DPWRST('XXX','BUG ')
8304        WRITE(ICOUT,85)PXMIN,PXMAX,PYMIN,PYMAX
8305   85   FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4G15.7)
8306        CALL DPWRST('XXX','BUG ')
8307        WRITE(ICOUT,86)FX1MIN,FX1MAX,FY1MIN,FY1MAX
8308   86   FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4G15.7)
8309        CALL DPWRST('XXX','BUG ')
8310        WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
8311   89   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
8312        CALL DPWRST('XXX','BUG ')
8313      ENDIF
8314C
8315C               *************************************************
8316C               **  STEP 10--                                  **
8317C               **  IF CALLED FOR, SORT THE DATA               **
8318C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
8319C               *************************************************
8320C
8321      IF(ISORSW.EQ.'OFF'  .OR. ICASPL.EQ.'PIEC' .OR.
8322     1   ICASPL.EQ.'ROSE' .OR. ICAS3D.EQ.'ON'   .OR.
8323     1   ICASPL.EQ.'TRPL')THEN
8324        DO1160I=1,NP
8325          PX(I)=X(I)
8326          PY(I)=Y(I)
8327 1160   CONTINUE
8328      ELSE
8329        CALL SORTC(X,Y,NP,PX,PY)
8330      ENDIF
8331C
8332C               ******************************************************
8333C               **  STEP 21--                                       **
8334C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,       **
8335C               **  CHECK THAT ALL   HORIZONTAL AXIS DATA POINTS    **
8336C               **  ARE IN VALID RANGE.                             **
8337C               **  IF A LOG SCALE PLOT IS CALLED FOR, CHECK THAT   **
8338C               **  ALL HORIZONTAL  AXIS DATA POINTS ARE > 0.  IF A **
8339C               **  WEIBULL SCALE PLOT IS CALLED FOR, OR IF A       **
8340C               **  NORMAL SCALE PLOT IS CALLED FOR,  (JUNE 1990)   **
8341C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS ARE    **
8342C               **  STRICTLY > 0 AND STRICTLY < 100                 **
8343C               ******************************************************
8344C
8345      IF(IX1TSC.EQ.'LOG')THEN
8346        ICASAX='2DHO'
8347        CALL CKLOSC(PX,NP,ISORSW,ICASAX,ISUBG4,IBUGG4,IERRG4)
8348        IF(IERRG4.EQ.'YES')GOTO9000
8349      ELSEIF(IX1TSC.EQ.'WEIB' .OR. IX1TSC.EQ.'NORM')THEN
8350        ICASAX='2DHO'
8351        CALL CKPRSC(PX,NP,ISORSW,ICASAX,ISUBG4,IBUGG4,IERRG4)
8352        IF(IERRG4.EQ.'YES')GOTO9000
8353      ENDIF
8354C
8355C               ******************************************************
8356C               **  STEP 22--                                       **
8357C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR, CHECK **
8358C               **  THAT ALL VERTICAL AXIS DATA POINTS ARE IN A     **
8359C               **  VALID RANGE.  IF A LOG SCALE PLOT IS CALLED     **
8360C               **  FOR, CHECK THAT ALL VERTICAL AXIS DATA POINTS   **
8361C               **  ARE > 0.  IF A WEIBULL SCALE PLOT IS CALLED     **
8362C               **  FOR, OR IF A NORMAL SCALE PLOT IS CALLED FOR,   **
8363C               **  (JUNE 1990)                                     **
8364C               **  CHECK THAT ALL VERTICAL AXIS DATA POINTS ARE    **
8365C               **  STRICTLY > 0 AND STRICTLY < 100                 **
8366C               ******************************************************
8367C
8368      IF(IY1TSC.EQ.'LOG')THEN
8369        ICASAX='2DVE'
8370        CALL CKLOSC(PY,NP,ISORSW,ICASAX,ISUBG4,IBUGG4,IERRG4)
8371        IF(IERRG4.EQ.'YES')GOTO9000
8372      ELSEIF(IY1TSC.EQ.'WEIB' .OR. IY1TSC.EQ.'NORM')THEN
8373        ICASAX='2DVE'
8374        CALL CKPRSC(PY,NP,ISORSW,ICASAX,ISUBG4,IBUGG4,IERRG4)
8375        IF(IERRG4.EQ.'YES')GOTO9000
8376      ENDIF
8377C
8378C               ******************************************
8379C               **  STEP 41--                           **
8380C               **  IF A LOG/WEIBULL/NORMAL SCALE PLOT  **
8381C               **  IS CALLED FOR, TRANSFORM THE DATA   **
8382C               ******************************************
8383C
8384      IF(IX1TSC.EQ.'LOG')THEN
8385        DO4115I=1,NP
8386          PX(I)=LOG10(PX(I))
8387 4115   CONTINUE
8388      ELSEIF(IX1TSC.EQ.'WEIB')THEN
8389        DO4215I=1,NP
8390          PX(I)=LOG(LOG(AHUNDR/(AHUNDR-PX(I))))
8391 4215   CONTINUE
8392      ELSEIF(IX1TSC.EQ.'NORM')THEN
8393        DO4315I=1,NP
8394          ARG=PX(I)/AHUNDR
8395          CALL NORPPF(ARG,PX(I))
8396 4315   CONTINUE
8397      ENDIF
8398C
8399      ABASE=ARE2BA
8400      IF(IY1TSC.EQ.'LOG')THEN
8401        DO4125I=1,NP
8402          PY(I)=LOG10(PY(I))
8403 4125   CONTINUE
8404      ELSEIF(IY1TSC.EQ.'WEIB')THEN
8405        DO4225I=1,NP
8406          PY(I)=LOG(LOG(AHUNDR/(AHUNDR-PY(I))))
8407 4225   CONTINUE
8408      ELSEIF(IY1TSC.EQ.'NORM')THEN
8409        IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)THEN
8410          ARG=ABASE/AHUNDR
8411          CALL NORPPF(ARG,ABASE2)
8412        ENDIF
8413        IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE2=0.1
8414        IF(ABASE.NE.CPUMAX.AND.ABASE.GE.AHUNDR)ABASE2=0.1
8415        ABASE=ABASE2
8416        DO4365I=1,NP
8417          ARG=PY(I)/AHUNDR
8418          CALL NORPPF(ARG,PY(I))
8419 4365   CONTINUE
8420      ENDIF
8421C
8422C               *****************************************************
8423C               **  STEP 50--                                      **
8424C               **  TRANSLATE THE DATA POINTS                      **
8425C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
8426C               *****************************************************
8427C
8428C     2018/01: USER HAS OPTION TO SPECIFY COORDINATES ARE ALREADY
8429C              IN SCREEN UNITS.  NOTE THAT SCREEN UNITS ONLY
8430C              APPLY TO LINEAR SCALES.
8431C
8432      FXMIN=FX1MIN
8433      FXMAX=FX1MAX
8434      IF(IX1TSC.EQ.'LOG'  .OR. IX1TSC.EQ.'WEIB' .OR.
8435     1   IX1TSC.EQ.'NORM')ICH2TY(1:1)='D'
8436      IF(IX1TSC.EQ.'LOG')THEN
8437        FXMIN=LOG10(FX1MIN)
8438        FXMAX=LOG10(FX1MAX)
8439      ELSEIF(IX1TSC.EQ.'WEIB')THEN
8440        FXMIN=LOG(LOG(AHUNDR/(AHUNDR-FX1MIN)))
8441        FXMAX=LOG(LOG(AHUNDR/(AHUNDR-FX1MAX)))
8442      ELSEIF(IX1TSC.EQ.'NORM')THEN
8443         ARG=FX1MIN/AHUNDR
8444         CALL NORPPF(ARG,FXMIN)
8445         ARG=FX1MAX/AHUNDR
8446         CALL NORPPF(ARG,FXMAX)
8447      ENDIF
8448C
8449      FYMIN=FY1MIN
8450      FYMAX=FY1MAX
8451      IF(IY1TSC.EQ.'LOG'  .OR. IY1TSC.EQ.'WEIB' .OR.
8452     1   IY1TSC.EQ.'NORM')ICH2TY(2:2)='D'
8453      IF(IY1TSC.EQ.'LOG')THEN
8454        FYMIN=LOG10(FY1MIN)
8455        FYMAX=LOG10(FY1MAX)
8456      ELSEIF(IY1TSC.EQ.'WEIB')THEN
8457        FYMIN=LOG(LOG(AHUNDR/(AHUNDR-FY1MIN)))
8458        FYMAX=LOG(LOG(AHUNDR/(AHUNDR-FY1MAX)))
8459      ELSEIF(IY1TSC.EQ.'NORM')THEN
8460        ARG=FY1MIN/AHUNDR
8461        CALL NORPPF(ARG,FYMIN)
8462        ARG=FY1MAX/AHUNDR
8463        CALL NORPPF(ARG,FYMAX)
8464      ENDIF
8465C
8466      FXRANG=FXMAX-FXMIN
8467      FYRANG=FYMAX-FYMIN
8468      PXRANG=PXMAX-PXMIN
8469      PYRANG=PYMAX-PYMIN
8470C
8471      IF(ICASPL.EQ.'TRPL')THEN
8472        AK2=SQRT(2.0)
8473        AK6=SQRT(6.0)
8474        PXHALF=(PXMIN+PXMAX)/2.0
8475        PYTHRD=PYMIN + (PYMAX-PYMIN)/3.0
8476C
8477        ASUM=X(1) + Y(1) + X3D(1)
8478C
8479        DO5160I=1,NP
8480          X1K=X(I)/ASUM
8481          X2K=Y(I)/ASUM
8482          X3K=X3D(I)/ASUM
8483          AH=(1.0/AK2)*(X3K-X2K)
8484          AV=(1.0/AK6)*(2.0 - 3.0*X2K - 3.0*X3K)
8485          PX(I)=PXHALF + (PXRANG/(2.0/AK2))*AH
8486          PY(I)=PYTHRD + (PYRANG/(3.0/AK6))*AV
8487 5160   CONTINUE
8488      ELSEIF(ICH2TY(1:1).EQ.'S' .OR. ICH2TY(2:2).EQ.'S')THEN
8489C
8490C       FOR SCREEN COORDINATES, CLIP AT (0,100) INSTEAD OF TO
8491C       FRAME COORDINATES
8492C
8493        IF(ICH2TY(1:1).EQ.'S')THEN
8494          DO5120I=1,NP
8495            IF(PX(I).LT.0.0)PX(I)=0.0
8496            IF(PX(I).GT.100.0)PX(I)=100.0
8497 5120     CONTINUE
8498          PXMIN=0.0
8499          PXMAX=100.0
8500        ELSE
8501          DO5123I=1,NP
8502            FXRATI=(PX(I)-FXMIN)/FXRANG
8503            PX(I)=PXMIN+FXRATI*PXRANG+PCH2HO
8504 5123     CONTINUE
8505        ENDIF
8506C
8507        IF(ICH2TY(2:2).EQ.'S')THEN
8508          DO5125I=1,NP
8509            IF(PY(I).LT.0.0)PY(I)=0.0
8510            IF(PY(I).GT.100.0)PY(I)=100.0
8511 5125     CONTINUE
8512          PYMIN=0.0
8513          PYMAX=100.0
8514        ELSE
8515          DO5128I=1,NP
8516            FYRATI=(PY(I)-FYMIN)/FYRANG
8517            PY(I)=PYMIN+FYRATI*PYRANG+PCH2VO
8518 5128     CONTINUE
8519        ENDIF
8520      ELSE
8521        DO5100I=1,NP
8522          FXRATI=(PX(I)-FXMIN)/FXRANG
8523          FYRATI=(PY(I)-FYMIN)/FYRANG
8524          PX(I)=PXMIN+FXRATI*PXRANG+PCH2HO
8525          PY(I)=PYMIN+FYRATI*PYRANG+PCH2VO
8526 5100   CONTINUE
8527      ENDIF
8528C
8529C               ***********************************************
8530C               **  STEP 60--                                **
8531C               **  WRITE OUT THE MARKERS (PLOT CHARACTERS)  **
8532C               **  AT THE PLOT POINTS                       **
8533C               ***********************************************
8534C
8535      IFIG='GENE'
8536      IPATT=ICH2PA
8537      IFONT=ICH2FO
8538      ICASE=ICH2CA
8539      IJUST=ICH2JU
8540      IDIR=ICH2DI
8541      ANGLE=ACH2AN
8542      IFILL=ICH2FI
8543      ICOL=ICH2CO
8544      PHEIGH=PCH2HE
8545CCCCC PWIDTH=0.5*PHEIGH
8546CCCCC PWIDTH=PHEIGH*(ANUMVP/ANUMHP)      DECEMBER 1987  TEST
8547      PWIDTH=PCH2WI
8548      PVEGAP=PHEIGH/2.0
8549      PHOGAP=PWIDTH/2.0
8550      PTHICK=PCH2TH
8551      ISYMBL=ICH2PA
8552      ISPAC=ITEXSP
8553C
8554CCCCC ADD X3D TO CALL LIST.  JANUARY 2000.
8555      CALL DPCLCH(PX,PY,NP,PX2,PY2,NP2,X3D,
8556     1PXMIN,PXMAX,PYMIN,PYMAX,
8557     1ISORSW,
8558     1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
8559     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
8560     1IMPSW2,AMPSCH,AMPSCW,
8561     1ISYMBL,ISPAC)
8562C
8563C               *****************
8564C               **  STEP 90--  **
8565C               **  EXIT       **
8566C               *****************
8567C
8568 9000 CONTINUE
8569C
8570      PXMIN=PXMINS
8571      PXMAX=PXMAXS
8572      PYMIN=PYMINS
8573      PYMAX=PYMAXS
8574C
8575      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRCH')THEN
8576        WRITE(ICOUT,999)
8577        CALL DPWRST('XXX','BUG ')
8578        WRITE(ICOUT,9011)
8579 9011   FORMAT('***** AT THE END       OF DPDRCH--')
8580        CALL DPWRST('XXX','BUG ')
8581        WRITE(ICOUT,9012)NP
8582 9012   FORMAT('NP = ',I8)
8583        CALL DPWRST('XXX','BUG ')
8584        WRITE(ICOUT,9013)ICASPL,ICAS3D
8585 9013   FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
8586        CALL DPWRST('XXX','BUG ')
8587        IF(NP.GE.1)THEN
8588          DO9025I=1,NP
8589            WRITE(ICOUT,9026)I,PX(I),PY(I)
8590 9026       FORMAT('I,PX(I),PY(I) = ',I8,2G15.7)
8591            CALL DPWRST('XXX','BUG ')
8592 9025     CONTINUE
8593        ENDIF
8594      ENDIF
8595C
8596      RETURN
8597      END
8598      SUBROUTINE DPDRFL(PXMIN,PYMIN,PXMAX,PYMAX,
8599     1ICASPL,ICAS3D,
8600     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
8601     1IX1FPA,IX2FPA,IY1FPA,IY2FPA,
8602     1IX1FCO,IX2FCO,IY1FCO,IY2FCO,
8603     1PFRATH)
8604C     PURPOSE--DRAW THE 4 (IF CALLED FOR) FRAME LINES ON THE SCREEN.
8605C     WRITTEN BY--JAMES J. FILLIBEN
8606C                 STATISTICAL ENGINEERING DIVISION
8607C                 INFORMATION TECHNOLOGY LABORATORY
8608C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8609C                 GAITHERSBURG, MD 20899-8980
8610C                 PHONE--301-975-2855
8611C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8612C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8613C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
8614C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
8615C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
8616C     LANGUAGE--ANSI FORTRAN (1977)
8617C     VERSION NUMBER--83.6
8618C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
8619C     UPDATED         --SEPTEMBER 1987.  CALLS TO GRDRPL TO DPDRPL
8620C     UPDATED         --FEBRUARY  1988.  STAR PLOT
8621C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
8622C     UPDATED         --DECEMBER  2006.  TRILINEAR SCALES
8623C
8624C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
8625C
8626      CHARACTER*4 ICASPL
8627      CHARACTER*4 ICAS3D
8628C
8629      CHARACTER*4 IX1FSW
8630      CHARACTER*4 IX2FSW
8631      CHARACTER*4 IY1FSW
8632      CHARACTER*4 IY2FSW
8633C
8634      CHARACTER*4 IX1FPA
8635      CHARACTER*4 IX2FPA
8636      CHARACTER*4 IY1FPA
8637      CHARACTER*4 IY2FPA
8638C
8639      CHARACTER*4 IX1FCO
8640      CHARACTER*4 IX2FCO
8641      CHARACTER*4 IY1FCO
8642      CHARACTER*4 IY2FCO
8643C
8644      CHARACTER*4 IFIG
8645      CHARACTER*4 IPATT
8646      CHARACTER*4 ICOL
8647      CHARACTER*4 IFLAG
8648C
8649      DIMENSION PX(10)
8650      DIMENSION PY(10)
8651CCCCC DIMENSION PX3(10)
8652CCCCC DIMENSION PY3(10)
8653C
8654C-----COMMON----------------------------------------------------------
8655C
8656      INCLUDE 'DPCOGR.INC'
8657      INCLUDE 'DPCOBE.INC'
8658      INCLUDE 'DPCOP2.INC'
8659C
8660C
8661C-----START POINT-----------------------------------------------------
8662C
8663      NP=2
8664C
8665      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFL')GOTO90
8666      WRITE(ICOUT,999)
8667  999 FORMAT(1X)
8668      CALL DPWRST('XXX','BUG ')
8669      WRITE(ICOUT,51)
8670   51 FORMAT('***** AT THE BEGINNING OF DPDRFL--')
8671      CALL DPWRST('XXX','BUG ')
8672      WRITE(ICOUT,52)PXMIN,PYMIN,PXMAX,PYMAX
8673   52 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
8674      CALL DPWRST('XXX','BUG ')
8675      WRITE(ICOUT,53)ICASPL,ICAS3D
8676   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
8677      CALL DPWRST('XXX','BUG ')
8678      WRITE(ICOUT,55)IX1FSW,IX2FSW,IY1FSW,IY2FSW
8679   55 FORMAT('IX1FSW,IX2FSW,IY1FSW,IY2FSW = ',A4,2X,A4,2X,A4,2X,A4)
8680      CALL DPWRST('XXX','BUG ')
8681      WRITE(ICOUT,56)IX1FPA,IX2FPA,IY1FPA,IY2FPA
8682   56 FORMAT('IX1FPA,IX2FPA,IY1FPA,IY2FPA = ',A4,2X,A4,2X,A4,2X,A4)
8683      CALL DPWRST('XXX','BUG ')
8684      WRITE(ICOUT,57)IX1FCO,IX2FCO,IY1FCO,IY2FCO
8685   57 FORMAT('IX1FCO,IX2FCO,IY1FCO,IY2FCO = ',A4,2X,A4,2X,A4,2X,A4)
8686      CALL DPWRST('XXX','BUG ')
8687      WRITE(ICOUT,58)PFRATH
8688   58 FORMAT('PFRATH = ',E15.7)
8689      CALL DPWRST('XXX','BUG ')
8690      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
8691   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8692      CALL DPWRST('XXX','BUG ')
8693   90 CONTINUE
8694C
8695      IF(ICASPL.EQ.'PIEC')GOTO9000
8696      IF(ICASPL.EQ.'ROSE')GOTO9000
8697      IF(ICASPL.EQ.'STAR')GOTO9000
8698      IF(ICAS3D.EQ.'ON')GOTO9000
8699C
8700      IFIG='LINE'
8701      PTHICK=PFRATH
8702C
8703C               **************************************
8704C               **  STEP 1--                        **
8705C               **  DRAW OUT THE BOTTOM FRAME LINE  **
8706C               **  (IF CALLED FOR)                 **
8707C               **************************************
8708C
8709      IF(IX1FSW.EQ.'ON')GOTO1100
8710      GOTO1190
8711 1100 CONTINUE
8712      PX(1)=PXMIN
8713      PY(1)=PYMIN
8714      PX(2)=PXMAX
8715      PY(2)=PYMIN
8716      NP=2
8717      IPATT=IX1FPA
8718      ICOL=IX1FCO
8719      IFLAG='ON'
8720CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
8721CCCCC1IFIG,IPATT,PTHICK,ICOL)
8722      CALL DPDRPL(PX,PY,NP,
8723     1IFIG,IPATT,PTHICK,ICOL,
8724     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8725 1190 CONTINUE
8726C
8727C               *************************************
8728C               **  STEP 2--                       **
8729C               **  DRAW OUT THE RIGHT FRAME LINE  **
8730C               **  (IF CALLED FOR)                **
8731C               *************************************
8732C
8733      IF(IY2FSW.EQ.'ON')GOTO1200
8734      GOTO1290
8735 1200 CONTINUE
8736      IF(ICASPL.EQ.'TRPL')THEN
8737        PX(1)=PXMAX
8738        PY(1)=PYMIN
8739        PX(2)=(PXMIN+PXMAX)/2.0
8740        PY(2)=PYMAX
8741      ELSE
8742        PX(1)=PXMAX
8743        PY(1)=PYMIN
8744        PX(2)=PXMAX
8745        PY(2)=PYMAX
8746      ENDIF
8747      NP=2
8748      IPATT=IY2FPA
8749      ICOL=IY2FCO
8750      IFLAG='ON'
8751CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
8752CCCCC1IFIG,IPATT,PTHICK,ICOL)
8753      CALL DPDRPL(PX,PY,NP,
8754     1IFIG,IPATT,PTHICK,ICOL,
8755     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8756 1290 CONTINUE
8757C
8758C               ***********************************
8759C               **  STEP 3--                     **
8760C               **  DRAW OUT THE TOP FRAME LINE  **
8761C               **  (IF CALLED FOR)              **
8762C               ***********************************
8763C
8764      IF(IX2FSW.EQ.'ON')GOTO1300
8765      GOTO1390
8766 1300 CONTINUE
8767      IF(ICASPL.EQ.'TRPL')GOTO1390
8768      PX(1)=PXMAX
8769      PY(1)=PYMAX
8770      PX(2)=PXMIN
8771      PY(2)=PYMAX
8772      NP=2
8773      IPATT=IX2FPA
8774      ICOL=IX2FCO
8775      IFLAG='ON'
8776CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
8777CCCCC1IFIG,IPATT,PTHICK,ICOL)
8778      CALL DPDRPL(PX,PY,NP,
8779     1IFIG,IPATT,PTHICK,ICOL,
8780     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8781 1390 CONTINUE
8782C
8783C               *************************************
8784C               **  STEP 4--                       **
8785C               **  DRAW OUT THE LEFT  FRAME LINE  **
8786C               **  (IF CALLED FOR)                **
8787C               *************************************
8788C
8789      IF(IY1FSW.EQ.'ON')GOTO1400
8790      GOTO1490
8791 1400 CONTINUE
8792      IF(ICASPL.EQ.'TRPL')THEN
8793        PX(1)=PXMIN
8794        PY(1)=PYMIN
8795        PX(2)=(PXMAX+PXMIN)/2.0
8796        PY(2)=PYMAX
8797      ELSE
8798        PX(1)=PXMIN
8799        PY(1)=PYMAX
8800        PX(2)=PXMIN
8801        PY(2)=PYMIN
8802      ENDIF
8803      NP=2
8804      IPATT=IY1FPA
8805      ICOL=IY1FCO
8806      IFLAG='ON'
8807CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
8808CCCCC1IFIG,IPATT,PTHICK,ICOL)
8809      CALL DPDRPL(PX,PY,NP,
8810     1IFIG,IPATT,PTHICK,ICOL,
8811     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
8812 1490 CONTINUE
8813C
8814C               *****************
8815C               **  STEP 90--  **
8816C               **  EXIT       **
8817C               *****************
8818C
8819 9000 CONTINUE
8820      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFL')GOTO9090
8821      WRITE(ICOUT,999)
8822      CALL DPWRST('XXX','BUG ')
8823      WRITE(ICOUT,9011)
8824 9011 FORMAT('***** AT THE END       OF DPDRFL--')
8825      CALL DPWRST('XXX','BUG ')
8826      WRITE(ICOUT,9012)PXMIN,PYMIN,PXMAX,PYMAX
8827 9012 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
8828      CALL DPWRST('XXX','BUG ')
8829      WRITE(ICOUT,9013)ICASPL,ICAS3D
8830 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
8831      CALL DPWRST('XXX','BUG ')
8832      WRITE(ICOUT,9015)IX1FSW,IX2FSW,IY1FSW,IY2FSW
8833 9015 FORMAT('IX1FSW,IX2FSW,IY1FSW,IY2FSW = ',A4,2X,A4,2X,A4,2X,A4)
8834      CALL DPWRST('XXX','BUG ')
8835      WRITE(ICOUT,9016)IX1FPA,IX2FPA,IY1FPA,IY2FPA
8836 9016 FORMAT('IX1FPA,IX2FPA,IY1FPA,IY2FPA = ',A4,2X,A4,2X,A4,2X,A4)
8837      CALL DPWRST('XXX','BUG ')
8838      WRITE(ICOUT,9017)IX1FCO,IX2FCO,IY1FCO,IY2FCO
8839 9017 FORMAT('IX1FCO,IX2FCO,IY1FCO,IY2FCO = ',A4,2X,A4,2X,A4,2X,A4)
8840      CALL DPWRST('XXX','BUG ')
8841      WRITE(ICOUT,9018)PFRATH
8842 9018 FORMAT('PFRATH = ',E15.7)
8843      CALL DPWRST('XXX','BUG ')
8844      WRITE(ICOUT,9025)NP
8845 9025 FORMAT('NP = ',I8)
8846      CALL DPWRST('XXX','BUG ')
8847      DO9026I=1,NP
8848      WRITE(ICOUT,9027)PX(I),PY(I)
8849 9027 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
8850      CALL DPWRST('XXX','BUG ')
8851 9026 CONTINUE
8852      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
8853 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8854      CALL DPWRST('XXX','BUG ')
8855 9090 CONTINUE
8856C
8857      RETURN
8858      END
8859      SUBROUTINE DPDRFR(ICASPL,ICAS3D,
8860     1IVGMSW,IHGMSW)
8861C
8862C     PURPOSE--DRAW FRAME LINES (ALONG WITH TIC MARKS,
8863C              TIC MARK LABELS, AND GRID LINES
8864C              FOR A PLOT.
8865C
8866C     WRITTEN BY--JAMES J. FILLIBEN
8867C                 STATISTICAL ENGINEERING DIVISION
8868C                 INFORMATION TECHNOLOGY LABORATORY
8869C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8870C                 GAITHERSBURG, MD 20899-8980
8871C                 PHONE--301-975-2855
8872C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8873C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8874C     LANGUAGE--ANSI FORTRAN (1977)
8875C     VERSION NUMBER--83.6
8876C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
8877C     MODIFIED      --MAY         1990. ADD OFFSET ARGUMENTS TO DPDRGL
8878C     MODIFIED      --DECEMBER    2006. SUPPORT FOR TRI-LINEAR SCALES
8879C
8880C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
8881C
8882      CHARACTER*4 ICASPL
8883      CHARACTER*4 ICAS3D
8884C
8885      CHARACTER*4 IVGMSW
8886      CHARACTER*4 IHGMSW
8887C
8888C-----COMMON----------------------------------------------------------
8889C
8890      INCLUDE 'DPCOPA.INC'
8891      INCLUDE 'DPCOPC.INC'
8892      INCLUDE 'DPCOGR.INC'
8893      INCLUDE 'DPCOBE.INC'
8894      INCLUDE 'DPCOP2.INC'
8895C
8896C-----START POINT-----------------------------------------------------
8897C
8898C
8899      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFR')GOTO90
8900      WRITE(ICOUT,999)
8901  999 FORMAT(1X)
8902      CALL DPWRST('XXX','BUG ')
8903      WRITE(ICOUT,51)
8904   51 FORMAT('***** AT THE BEGINNING OF DPDRFR--')
8905      CALL DPWRST('XXX','BUG ')
8906      WRITE(ICOUT,52)IMANUF,IMODEL
8907   52 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
8908      CALL DPWRST('XXX','BUG ')
8909      WRITE(ICOUT,53)ICASPL,ICAS3D
8910   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
8911      CALL DPWRST('XXX','BUG ')
8912      WRITE(ICOUT,55)IBUGG4,ISUBG4,IERRG4
8913   55 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
8914      CALL DPWRST('XXX','BUG ')
8915   90 CONTINUE
8916C
8917C               *******************************
8918C               **  STEP 1--                 **
8919C               **  FILL  THE MARGIN REGION  **
8920C               *******************************
8921C
8922      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRFR')THEN
8923        WRITE(ICOUT,8001)
8924 8001   FORMAT('BEFORE CALL DPFIMA')
8925        CALL DPWRST('XXX','BUG ')
8926      ENDIF
8927C
8928      IF(IERASW.EQ.'ON'.AND.IMARCO.NE.IBACCO)
8929     1CALL DPFIMA(PXMIN,PYMIN,PXMAX,PYMAX,
8930     1ICASPL,ICAS3D,
8931     1IMARCO)
8932C
8933C               ****************************
8934C               **  STEP 2--              **
8935C               **  DRAW THE FRAME LINES  **
8936C               ****************************
8937C
8938      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRFR')THEN
8939        WRITE(ICOUT,8002)
8940 8002   FORMAT('BEFORE CALL DPDRFL')
8941        CALL DPWRST('XXX','BUG ')
8942      ENDIF
8943C
8944      CALL DPDRFL(PXMIN,PYMIN,PXMAX,PYMAX,
8945     1ICASPL,ICAS3D,
8946     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
8947     1IX1FPA,IX2FPA,IY1FPA,IY2FPA,
8948     1IX1FCO,IX2FCO,IY1FCO,IY2FCO,
8949     1PFRATH)
8950C
8951C               **************************
8952C               **  STEP 3--            **
8953C               **  DRAW THE TIC MARKS  **
8954C               **************************
8955C
8956      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRFR')THEN
8957        WRITE(ICOUT,8003)
8958 8003   FORMAT('BEFORE CALL DPDRTM')
8959        CALL DPWRST('XXX','BUG ')
8960      ENDIF
8961C
8962      CALL DPDRTM(PXMIN,PYMIN,PXMAX,PYMAX,
8963     1FX1MIN,FY1MIN,FX1MAX,FY1MAX,
8964     1ICASPL,ICAS3D,
8965     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
8966     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
8967     1PX1COO,PX2COO,PY1COO,PY2COO,
8968     1NX1COO,NX2COO,NY1COO,NY2COO,
8969     1PX1CMN,PX2CMN,PY1CMN,PY2CMN,
8970     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
8971     1PX1TLE,PX2TLE,PY1TLE,PY2TLE,
8972     1PTICTH,PMNTFA,
8973     1IX1TJU,IX2TJU,IY1TJU,IY2TJU,
8974     1IX1TCO,IX2TCO,IY1TCO,IY2TCO)
8975C
8976C               *************************************
8977C               **  STEP 4--                       **
8978C               **  WRITE OUT THE TIC MARK LABELS  **
8979C               *************************************
8980C
8981      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRFR')THEN
8982        WRITE(ICOUT,8004)
8983 8004   FORMAT('BEFORE CALL DPWRTL')
8984        CALL DPWRST('XXX','BUG ')
8985      ENDIF
8986C
8987      CALL DPWRTL(ICASPL,ICAS3D)
8988C
8989C               ***************************
8990C               **  STEP 5--             **
8991C               **  DRAW THE GRID LINES  **
8992C               ***************************
8993C
8994      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRFR')THEN
8995        WRITE(ICOUT,8005)
8996 8005   FORMAT('BEFORE CALL DPDRGL')
8997        CALL DPWRST('XXX','BUG ')
8998      ENDIF
8999C
9000      CALL DPDRGL(PXMIN,PYMIN,PXMAX,PYMAX,
9001     1FX1MIN,FY1MIN,FX1MAX,FY1MAX,
9002     1ICASPL,ICAS3D,
9003     1IVGRSW,IHGRSW,
9004     1IVGMSW,IHGMSW,
9005     1PX1COO,PX2COO,PY1COO,PY2COO,
9006     1X1COOR,X2COOR,Y1COOR,Y2COOR,
9007     1NX1COO,NX2COO,NY1COO,NY2COO,
9008     1PX1CMN,PX2CMN,PY1CMN,PY2CMN,
9009     1X1COMN,X2COMN,Y1COMN,Y2COMN,
9010     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
9011     1IVGRPA,IHGRPA,IVGRCO,IHGRCO,
9012     1PVGRTH,PHGRTH,
9013     1PX1TOL,PX1TOR,PY1TOB,PY1TOT)
9014CCCC ABOVE LINE ADDED MAY, 1990 (FOR TIC OFFSETS)
9015C
9016C               *****************
9017C               **  STEP 90--  **
9018C               **  EXIT       **
9019C               *****************
9020C
9021      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFR')GOTO9090
9022      WRITE(ICOUT,999)
9023      CALL DPWRST('XXX','BUG ')
9024      WRITE(ICOUT,9011)
9025 9011 FORMAT('***** AT THE END       OF DPDRFR--')
9026      CALL DPWRST('XXX','BUG ')
9027      WRITE(ICOUT,9012)IMANUF,IMODEL
9028 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
9029      CALL DPWRST('XXX','BUG ')
9030      WRITE(ICOUT,9013)ICASPL,ICAS3D
9031 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
9032      CALL DPWRST('XXX','BUG ')
9033      WRITE(ICOUT,9015)IBUGG4,ISUBG4,IERRG4
9034 9015 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
9035      CALL DPWRST('XXX','BUG ')
9036 9090 CONTINUE
9037C
9038      RETURN
9039      END
9040      SUBROUTINE DPDRGL(PXMIN,PYMIN,PXMAX,PYMAX,
9041     1                  FXMIN,FYMIN,FXMAX,FYMAX,
9042     1                  ICASPL,ICAS3D,
9043     1                  IVGRSW,IHGRSW,
9044     1                  IVGMSW,IHGMSW,
9045     1                  PX1COO,PX2COO,PY1COO,PY2COO,
9046     1                  X1COOR,X2COOR,Y1COOR,Y2COOR,
9047     1                  NX1COO,NX2COO,NY1COO,NY2COO,
9048     1                  PX1CMN,PX2CMN,PY1CMN,PY2CMN,
9049     1                  X1COMN,X2COMN,Y1COMN,Y2COMN,
9050     1                  NX1CMN,NX2CMN,NY1CMN,NY2CMN,
9051     1                  IVGRPA,IHGRPA,IVGRCO,IHGRCO,
9052     1                  PVGRTH,PHGRTH,
9053     1                  PX1TOL,PX1TOR,PY1TOB,PY1TOT)
9054C
9055C     PURPOSE--DRAW GRID LINES ON A PLOT
9056C              FOR A GENERAL GRAPHICS DEVICE.
9057C
9058C     WRITTEN BY--JAMES J. FILLIBEN
9059C                 STATISTICAL ENGINEERING DIVISION
9060C                 INFORMATION TECHNOLOGY LABORATORY
9061C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9062C                 GAITHERSBURG, MD 20899-8980
9063C                 PHONE--301-975-2855
9064C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9065C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9066C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
9067C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
9068C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
9069C     LANGUAGE--ANSI FORTRAN (1977)
9070C     VERSION NUMBER--83.6
9071C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
9072C     UPDATED         --SEPTEMBER 1987. GRDRPL TO DPDRPL
9073C     UPDATED         --FEBRUARY  1988. STAR PLOT
9074C     UPDATED         --MAY       1990. TIC OFFSETS
9075C     UPDATED         --SEPTEMBER 1990. MISSING HORIZ. GRID LINES
9076C     UPDATED         --DECEMBER  2006. SUPPORT FOR TRILINEAR PLOTS
9077C
9078C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
9079C
9080      CHARACTER*4 ICASPL
9081      CHARACTER*4 ICAS3D
9082C
9083      CHARACTER*4 IVGRSW
9084      CHARACTER*4 IHGRSW
9085      CHARACTER*4 IVGMSW
9086      CHARACTER*4 IHGMSW
9087      CHARACTER*4 IVGRPA
9088      CHARACTER*4 IHGRPA
9089      CHARACTER*4 IVGRCO
9090      CHARACTER*4 IHGRCO
9091C
9092      CHARACTER*4 ITYPE
9093      CHARACTER*4 IFIG
9094      CHARACTER*4 IPATT
9095      CHARACTER*4 ICOL
9096CCCCC CHARACTER*4 IHORPA
9097CCCCC CHARACTER*4 IVERPA
9098CCCCC CHARACTER*4 IDUPPA
9099CCCCC CHARACTER*4 IDDOPA
9100      CHARACTER*4 IFLAG
9101C
9102      DIMENSION PX1COO(*)
9103      DIMENSION PX2COO(*)
9104      DIMENSION PY1COO(*)
9105      DIMENSION PY2COO(*)
9106C
9107      DIMENSION X1COOR(*)
9108      DIMENSION X2COOR(*)
9109      DIMENSION Y1COOR(*)
9110      DIMENSION Y2COOR(*)
9111C
9112      DIMENSION PX1CMN(*)
9113      DIMENSION PX2CMN(*)
9114      DIMENSION PY1CMN(*)
9115      DIMENSION PY2CMN(*)
9116C
9117      DIMENSION X1COMN(*)
9118      DIMENSION X2COMN(*)
9119      DIMENSION Y1COMN(*)
9120      DIMENSION Y2COMN(*)
9121C
9122      DIMENSION PX(100)
9123      DIMENSION PY(100)
9124C
9125C-----COMMON----------------------------------------------------------
9126C
9127      INCLUDE 'DPCOGR.INC'
9128      INCLUDE 'DPCOBE.INC'
9129      INCLUDE 'DPCOP2.INC'
9130C
9131C-----START POINT-----------------------------------------------------
9132C
9133      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRGL')THEN
9134        WRITE(ICOUT,999)
9135  999   FORMAT(1X)
9136        CALL DPWRST('XXX','BUG ')
9137        WRITE(ICOUT,51)
9138   51   FORMAT('***** AT THE BEGINNING OF DPDRGL--')
9139        CALL DPWRST('XXX','BUG ')
9140        WRITE(ICOUT,52)PXMIN,PYMIN,PXMAX,PYMAX
9141   52   FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
9142        CALL DPWRST('XXX','BUG ')
9143        WRITE(ICOUT,42)FXMIN,FYMIN,FXMAX,FYMAX
9144   42   FORMAT('FXMIN,FYMIN,FXMAX,FYMAX = ',4F10.5)
9145        CALL DPWRST('XXX','BUG ')
9146        DO43I=1,100
9147          WRITE(ICOUT,44)I,PX1CMN(I),PX2CMN(I),PY1CMN(I),PY2CMN(I)
9148   44     FORMAT('I,PX1CMN(I),PX2CMN(I),PY1CMN(I),PY2CMN(I) = ',4F10.5)
9149          CALL DPWRST('XXX','BUG ')
9150   43   CONTINUE
9151        DO45I=1,100
9152          WRITE(ICOUT,46)I,X1COMN(I),X2COMN(I),Y1COMN(I),Y2COMN(I)
9153   46     FORMAT('X1COMN(I),X2COMN(I),Y1COMN(I),Y2COMNI) = ',
9154     1           3(A4,2X),A4)
9155          CALL DPWRST('XXX','BUG ')
9156   45   CONTINUE
9157        WRITE(ICOUT,53)ICASPL,ICAS3D,IBUGG4,ISUBG4,IERRG4
9158   53   FORMAT('ICASPL,ICAS3D,IBUGG4,ISUBG4,IERRG4 = ',4(A4,2X),A4)
9159        CALL DPWRST('XXX','BUG ')
9160        WRITE(ICOUT,54)IVGRSW,IHGRSW,IVGMSW,IHGMSW
9161   54   FORMAT('IVGRSW,IHGRSW,IVGMSW,IHGMSW = ',3(A4,2X),A4)
9162        CALL DPWRST('XXX','BUG ')
9163        WRITE(ICOUT,55)IVGRPA,IHGRPA,PVGRTH,PHGRTH
9164   55   FORMAT('IVGRPA,IHGRPA,PVGRTH,PHGRTH = ',2(A4,2X),2G15.7)
9165        CALL DPWRST('XXX','BUG ')
9166        WRITE(ICOUT,57)IVGRCO,IHGRCO
9167   57   FORMAT('IVGRCO,IHGRCO = ',A4,2X,A4)
9168        CALL DPWRST('XXX','BUG ')
9169        WRITE(ICOUT,58)NX1CMN,NX2CMN,NY1CMN,NY2CMN
9170   58   FORMAT('NX1CMN,NX2CMN,NY1CMN,NY2CMN = ',4I8)
9171        CALL DPWRST('XXX','BUG ')
9172        WRITE(ICOUT,60)NX1COO,NX2COO,NY1COO,NY2COO
9173   60   FORMAT('NX1COO,NX2COO,NY1COO,NY2COO = ',4I8)
9174        CALL DPWRST('XXX','BUG ')
9175C
9176        IF(NX1COO.GT.0)THEN
9177          WRITE(ICOUT,999)
9178          CALL DPWRST('XXX','BUG ')
9179          DO61I=1,NX1COO
9180            WRITE(ICOUT,62)I,PX1COO(I),X1COOR(I)
9181   62       FORMAT('I,PX1COO(I),X1COOR(I) = ',I8,2E15.7)
9182            CALL DPWRST('XXX','BUG ')
9183   61     CONTINUE
9184        ENDIF
9185C
9186        IF(NX2COO.GT.0)THEN
9187          WRITE(ICOUT,999)
9188          CALL DPWRST('XXX','BUG ')
9189          DO71I=1,NX2COO
9190            WRITE(ICOUT,72)I,PX2COO(I),X2COOR(I)
9191   72       FORMAT('I,PX2COO(I),X2COOR(I) = ',I8,2E15.7)
9192            CALL DPWRST('XXX','BUG ')
9193   71     CONTINUE
9194        ENDIF
9195C
9196        IF(NY1COO.GT.0)THEN
9197          WRITE(ICOUT,999)
9198          CALL DPWRST('XXX','BUG ')
9199          DO81I=1,NY1COO
9200            WRITE(ICOUT,82)I,PY1COO(I),Y1COOR(I)
9201   82       FORMAT('I,PY1COO(I),Y1COOR(I) = ',I8,2E15.7)
9202            CALL DPWRST('XXX','BUG ')
9203   81     CONTINUE
9204        ENDIF
9205C
9206        IF(NY2COO.GT.0)THEN
9207          WRITE(ICOUT,999)
9208          CALL DPWRST('XXX','BUG ')
9209          DO91I=1,NY2COO
9210            WRITE(ICOUT,92)I,PY2COO(I),Y2COOR(I)
9211   92       FORMAT('I,PY2COO(I),Y2COOR(I) = ',I8,2E15.7)
9212            CALL DPWRST('XXX','BUG ')
9213   91     CONTINUE
9214        ENDIF
9215C
9216      ENDIF
9217C
9218      IF(ICASPL.EQ.'PIEC')GOTO9000
9219      IF(ICASPL.EQ.'ROSE')GOTO9000
9220      IF(ICASPL.EQ.'STAR')GOTO9000
9221      IF(ICAS3D.EQ.'ON')GOTO9000
9222      IF(ICASPL.EQ.'TRPL')GOTO2000
9223C
9224      ITYPE='LINE'
9225C
9226C               ***************************************************
9227C               **  STEP 1--                                     **
9228C               **  TRANSLATE THE VERTICAL GRID LINE LINE PATTERN            **
9229C               **  INTO A NUMBER WHICH CAN BE UNDERSTOOD        **
9230C               **  BY THE GRAPHICS DEVICE.                      **
9231C               ***************************************************
9232C
9233      IPATT=IVGRPA
9234CCCCC CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
9235CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
9236C
9237C               **********************************
9238C               **  STEP 2--                    **
9239C               **  SET THE LINE PATTERN TO SOLID  **
9240C               **  ON THE GRAPHICS DEVICE.     **
9241C               **********************************
9242C
9243CCCCC CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
9244CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
9245C
9246C               **********************************************
9247C               **  STEP 3--                                  **
9248C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9249C               **  OF THE VERTICAL GRID LINE   COLOR
9250C               **  INTO A NUMERIC REPRESENTATION           **
9251C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9252C               **  GRAPHICS DEVICE.                        **
9253C               **********************************************
9254C
9255      ICOL=IVGRCO
9256CCCCC CALL GRTRCO(ITYPE,ICOL,JCOL)
9257C
9258C               *******************************
9259C               **  STEP 4--                 **
9260C               **  SET THE  COLOR       **
9261C               **  ON THE GRAPHICS DEVICE.  **
9262C               *******************************
9263C
9264CCCCC CALL GRSECO(ITYPE,ICOL,JCOL)
9265C
9266C               **********************************************
9267C               **  STEP 5--                                **
9268C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9269C               **  OF THE VERTICAL GRID LINE THICKNESS                   **
9270C               **  INTO A NUMERIC REPRESENTATION           **
9271C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9272C               **  GRAPHICS DEVICE.                        **
9273C               **********************************************
9274C
9275      PTHICK=PVGRTH
9276CCCCC CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
9277C
9278C               *******************************
9279C               **  STEP 6--                 **
9280C               **  SET THE LINE THICKNESS   **
9281C               **  ON THE GRAPHICS DEVICE.  **
9282C               *******************************
9283C
9284CCCCC CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
9285C
9286C               **********************************
9287C               **  STEP 7--                    **
9288C               **  DRAW VERTICAL   GRID LINES  **
9289C               **********************************
9290C
9291      IFIG='LINE'
9292      PY(1)=PYMIN
9293      PY(2)=PYMAX
9294C
9295      IF(IVGRSW.EQ.'OFF')GOTO1140
9296      IF(NX1COO.LE.2)GOTO1140
9297CCCCC MAY, 1990.  IF TIC OFFSETS ARE NON-ZER0, DRAW THE FIRST AND
9298CCCCC LAST GRID LINES (WHICH PREVIOUSLY WOULD ALWAYS BE ON THE FRAME.
9299      EPS=0.000001
9300      IMIN=2
9301      IF(ABS(PX1TOL).GE.EPS)IMIN=1
9302      IMAX=NX1COO-1
9303      IF(ABS(PX1TOR).GE.EPS)IMAX=NX1COO
9304      NP=2
9305CCCCC IMAX=NX1COO-1
9306      IFLAG='ON'
9307CCCCC DO1110I=2,IMAX
9308      DO1110I=IMIN,IMAX
9309      PX(1)=PX1COO(I)
9310      PX(2)=PX1COO(I)
9311CCCCC CALL GRDRPL(PX,PY,NP,
9312CCCCC1IFIG,IPATT,PTHICK,ICOL,
9313CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
9314      CALL DPDRPL(PX,PY,NP,
9315     1IFIG,IPATT,PTHICK,ICOL,
9316     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
9317      IFLAG='OFF'
9318 1110 CONTINUE
9319 1140 CONTINUE
9320C
9321      IF(IVGMSW.EQ.'OFF')GOTO1180
9322      IF(NX1CMN.LE.2)GOTO1180
9323      NP=2
9324      IMAX=NX1CMN
9325      IFLAG='ON'
9326      DO1150I=1,IMAX
9327      PX(1)=PX1CMN(I)
9328      PX(2)=PX1CMN(I)
9329CCCCC CALL GRDRPL(PX,PY,NP,
9330CCCCC1IFIG,IPATT,PTHICK,ICOL,
9331CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
9332      CALL DPDRPL(PX,PY,NP,
9333     1IFIG,IPATT,PTHICK,ICOL,
9334     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
9335      IFLAG='OFF'
9336 1150 CONTINUE
9337 1180 CONTINUE
9338C
9339C               ***************************************************
9340C               **  STEP 11--                                    **
9341C               **  TRANSLATE THE HORIZONTAL GRID LINE LINE PATTERN            *
9342C               **  INTO A NUMBER WHICH CAN BE UNDERSTOOD        **
9343C               **  BY THE GRAPHICS DEVICE.                      **
9344C               ***************************************************
9345C
9346      IPATT=IHGRPA
9347CCCCC CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
9348CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
9349C
9350C               **********************************
9351C               **  STEP 12--                    **
9352C               **  SET THE LINE PATTERN TO SOLID  **
9353C               **  ON THE GRAPHICS DEVICE.     **
9354C               **********************************
9355C
9356CCCCC CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
9357CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
9358C
9359C               **********************************************
9360C               **  STEP 13--                                  **
9361C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9362C               **  OF THE HORIZONTAL GRID LINE   COLOR
9363C               **  INTO A NUMERIC REPRESENTATION           **
9364C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9365C               **  GRAPHICS DEVICE.                        **
9366C               **********************************************
9367C
9368      ICOL=IHGRCO
9369CCCCC CALL GRTRCO(ITYPE,ICOL,JCOL)
9370C
9371C               *******************************
9372C               **  STEP 14--                **
9373C               **  SET THE  COLOR       **
9374C               **  ON THE GRAPHICS DEVICE.  **
9375C               *******************************
9376C
9377CCCCC CALL GRSECO(ITYPE,ICOL,JCOL)
9378C
9379C               **********************************************
9380C               **  STEP 15--                               **
9381C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9382C               **  OF THE HORIZONAL GRID LINE THICKNESS                   **
9383C               **  INTO A NUMERIC REPRESENTATION           **
9384C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9385C               **  GRAPHICS DEVICE.                        **
9386C               **********************************************
9387C
9388      PTHICK=PHGRTH
9389CCCCC CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
9390C
9391C               *******************************
9392C               **  STEP 16--                 **
9393C               **  SET THE LINE THICKNESS   **
9394C               **  ON THE GRAPHICS DEVICE.  **
9395C               *******************************
9396C
9397CCCCC CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
9398C
9399C               **********************************
9400C               **  STEP 17--                   **
9401C               **  DRAW HORIZONTAL GRID LINES  **
9402C               **********************************
9403C
9404      IFIG='LINE'
9405      PX(1)=PXMIN
9406      PX(2)=PXMAX
9407C
9408      IF(IHGRSW.EQ.'OFF')GOTO1240
9409      IF(NY1COO.LE.2)GOTO1240
9410      NP=2
9411CCCCC MAY, 1990.  IF TIC OFFSETS ARE NON-ZER0, DRAW THE FIRST AND
9412CCCCC LAST GRID LINES (WHICH PREVIOUSLY WOULD ALWAYS BE ON THE FRAME.
9413      EPS=0.000001
9414      IMIN=2
9415      IF(ABS(PY1TOB).GE.EPS)IMIN=1
9416CCCCC THE FOLLOWING LINE WAS FIXED SEPTEMBER 1990
9417CCCCC IMAX=NX1COO-1
9418      IMAX=NY1COO-1
9419      IF(ABS(PY1TOT).GE.EPS)IMAX=NY1COO
9420CCCCC IMAX=NY1COO-1
9421      IFLAG='ON'
9422CCCCC DO1210I=2,IMAX
9423      DO1210I=IMIN,IMAX
9424      PY(1)=PY1COO(I)
9425      PY(2)=PY1COO(I)
9426CCCCC CALL GRDRPL(PX,PY,NP,
9427CCCCC1IFIG,IPATT,PTHICK,ICOL,
9428CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
9429      CALL DPDRPL(PX,PY,NP,
9430     1IFIG,IPATT,PTHICK,ICOL,
9431     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
9432      IFLAG='OFF'
9433 1210 CONTINUE
9434 1240 CONTINUE
9435C
9436      IF(IHGMSW.EQ.'OFF')GOTO1280
9437      IF(NY1CMN.LE.2)GOTO1280
9438      NP=2
9439      IMAX=NY1CMN
9440      IFLAG='ON'
9441      DO1250I=1,IMAX
9442      PY(1)=PY1CMN(I)
9443      PY(2)=PY1CMN(I)
9444CCCCC CALL GRDRPL(PX,PY,NP,
9445CCCCC1IFIG,IPATT,PTHICK,ICOL,
9446CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
9447      CALL DPDRPL(PX,PY,NP,
9448     1IFIG,IPATT,PTHICK,ICOL,
9449     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
9450      IFLAG='OFF'
9451 1250 CONTINUE
9452 1280 CONTINUE
9453      GOTO9000
9454C
9455 2000 CONTINUE
9456C
9457C               *****************************************
9458C               **  STEP 20--                          **
9459C               **  DRAW GRID LINES FOR TRILINEAR PLOT **
9460C               *****************************************
9461C
9462      IF(IVGRSW.EQ.'OFF' .OR. IHGRSW.EQ.'OFF')GOTO9000
9463C
9464      ITYPE='LINE'
9465      IPATT=IHGRPA
9466      ICOL=IHGRCO
9467      PTHICK=PHGRTH
9468C
9469      IFIG='LINE'
9470C
9471      AMIN=0.0
9472CCCCC AMAX=FXMAX
9473CCCCC GRDINC=(AMAX-AMIN)/REAL(NX1COO-1)
9474      AMAX=1.0
9475      GRDINC=(1.0-0.0)/REAL(NX1COO-1)
9476      PXRANG=PXMAX - PXMIN
9477      PYRANG=PYMAX - PYMIN
9478C
9479C               *****************************************
9480C               **  STEP 20.A--                        **
9481C               **  DRAW GRID LINES FOR X1 AXIS        **
9482C               *****************************************
9483C
9484C
9485      NP2=2
9486      IFLAG='ON'
9487      DO2010I=2,NX1COO-1
9488        XDUMMY=AMIN + (I-1)*GRDINC
9489        PXSTRT=PXMIN + 0.5*PXRANG*XDUMMY
9490        PYSTRT=PYMIN + PYRANG*XDUMMY
9491        PXSTOP=PXMAX - (PXSTRT-PXMIN)
9492        PYSTOP=PYSTRT
9493        PX(1)=PXSTRT
9494        PX(2)=PXSTOP
9495        PY(1)=PYSTRT
9496        PY(2)=PYSTOP
9497        CALL DPDRPL(PX,PY,NP2,
9498     1              IFIG,IPATT,PTHICK,ICOL,
9499     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
9500        IFLAG='OFF'
9501 2010 CONTINUE
9502C
9503C               *****************************************
9504C               **  STEP 20.B--                        **
9505C               **  DRAW GRID LINES FOR X2 AXIS        **
9506C               *****************************************
9507C
9508C
9509      NP2=2
9510      DO2020I=2,NX1COO-1
9511        XDUMMY=AMIN + (I-1)*GRDINC
9512        PXSTRT=PXMAX - PXRANG*XDUMMY
9513        PYSTRT=PYMIN
9514        PXSTOP=PXSTRT - 0.5*PXRANG*(AMAX-XDUMMY)
9515        PYSTOP=PYSTRT + PYRANG*(AMAX-XDUMMY)
9516        PX(1)=PXSTRT
9517        PX(2)=PXSTOP
9518        PY(1)=PYSTRT
9519        PY(2)=PYSTOP
9520        CALL DPDRPL(PX,PY,NP2,
9521     1              IFIG,IPATT,PTHICK,ICOL,
9522     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
9523 2020 CONTINUE
9524C
9525C               *****************************************
9526C               **  STEP 20.C--                        **
9527C               **  DRAW GRID LINES FOR X3 AXIS        **
9528C               *****************************************
9529C
9530      NP2=2
9531      DO2030I=2,NX1COO-1
9532        XDUMMY=AMIN + (I-1)*GRDINC
9533        PXSTRT=PXMIN + PXRANG*XDUMMY
9534        PYSTRT=PYMIN
9535        PXSTOP=PXSTRT + 0.5*PXRANG*(AMAX-XDUMMY)
9536        PYSTOP=PYSTRT + PYRANG*(AMAX-XDUMMY)
9537        PX(1)=PXSTRT
9538        PX(2)=PXSTOP
9539        PY(1)=PYSTRT
9540        PY(2)=PYSTOP
9541        CALL DPDRPL(PX,PY,NP2,
9542     1              IFIG,IPATT,PTHICK,ICOL,
9543     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
9544 2030 CONTINUE
9545      IFLAG='ON'
9546C
9547C
9548C               *****************
9549C               **  STEP 90--  **
9550C               **  EXIT       **
9551C               *****************
9552C
9553 9000 CONTINUE
9554      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRGL')THEN
9555        WRITE(ICOUT,999)
9556        CALL DPWRST('XXX','BUG ')
9557        WRITE(ICOUT,9011)
9558 9011   FORMAT('***** AT THE END       OF DPDRGL--')
9559        CALL DPWRST('XXX','BUG ')
9560        WRITE(ICOUT,9019)IPATT,ICOL,JPATT,JCOL
9561 9019   FORMAT('IPATT,ICOL,JPATT,JCOL = ',2(A4,2X),2I8)
9562        CALL DPWRST('XXX','BUG ')
9563        WRITE(ICOUT,9020)PTHICK,JTHICK,PTHIC2
9564 9020   FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,2X,A4,2X,E15.7)
9565        CALL DPWRST('XXX','BUG ')
9566        WRITE(ICOUT,9022)ITYPE,IERRG4
9567 9022   FORMAT('ITYPE,IERRG4 = ',A4,2X,A4)
9568        CALL DPWRST('XXX','BUG ')
9569      ENDIF
9570C
9571      RETURN
9572      END
9573      SUBROUTINE DPDRIM(PX,PY,YRED,YBLUE,YGREEN,YALPHA,NP,
9574     1                  ICASCO,PHEIGH)
9575C
9576C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE, DRAW AN IMAGE.  THE
9577C              ARRAYS PX AND PY CONTAIN THE ROW-ID AND COLUMN-ID
9578C              OF THE IMAGE, RESPECTIVELY.  THE ARRAYS YRED, YBLUE,
9579C              AND YGREEN CONTAIN THE RED, BLUE, AND GREEN COMPONENTS,
9580C              RESPECTIVELY, ON A (0,1) SCALE.  THE YALPHA ARRAY IS
9581C              RESERVED FOR FUTURE DEVELOPMENT (FOR AN ALPHA CHANNEL).
9582C              THE SCALING FROM (0,1) TO AN APPROPRIATE 8-BIT
9583C              (I.E., 0 TO 255) OR 16-BIT (I.E., 0 TO 16535) SCALE
9584C              WILL BE HANDLED FOR SPECIFIC DEVICES IN THE GRDRIM
9585C              ROUTINE.
9586C     WRITTEN BY--JAMES J. FILLIBEN
9587C                 STATISTICAL ENGINEERING DIVISION
9588C                 INFORMATION TECHNOLOGY LABORATORY
9589C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9590C                 GAITHERSBURG, MD 20899-8980
9591C                 PHONE--301-975-2899
9592C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9593C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9594C     LANGUAGE--ANSI FORTRAN (1977)
9595C     VERSION NUMBER--2008.3
9596C     ORIGINAL VERSION--MARCH    2008.
9597C
9598C-----NON-COMMON VARIABLES (GRAPHICS)-----------------------------------
9599C
9600      CHARACTER*4 ICASCO
9601      CHARACTER*4 IERROR
9602C
9603      DIMENSION PX(*)
9604      DIMENSION PY(*)
9605      DIMENSION YRED(*)
9606      DIMENSION YBLUE(*)
9607      DIMENSION YGREEN(*)
9608      DIMENSION YALPHA(*)
9609C
9610      CHARACTER*4 IJUST
9611C
9612C-----COMMON----------------------------------------------------------
9613C
9614      INCLUDE 'DPCOPA.INC'
9615      INCLUDE 'DPCOPC.INC'
9616      INCLUDE 'DPCOGR.INC'
9617      INCLUDE 'DPCOBE.INC'
9618      INCLUDE 'DPCOP2.INC'
9619C
9620C-----START POINT-----------------------------------------------------
9621C
9622      IERROR='OFF'
9623      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRIM')THEN
9624        WRITE(ICOUT,999)
9625  999   FORMAT(1X)
9626        CALL DPWRST('XXX','BUG ')
9627        WRITE(ICOUT,51)
9628   51   FORMAT('***** AT THE BEGINNING OF DPDRIM--')
9629        CALL DPWRST('XXX','BUG ')
9630        WRITE(ICOUT,54)NP
9631   54   FORMAT('NP = ',I8)
9632        CALL DPWRST('XXX','BUG ')
9633        DO55I=1,MAX(NP,1000)
9634          WRITE(ICOUT,56)I,PX(I),PY(I),YRED(I),YGREEN(I),YBLUE(I)
9635   56     FORMAT('I,PX(I),PY(I),YRED(I),YGREEN(I),YBLUE(I) = ',
9636     1           I8,5F10.5)
9637          CALL DPWRST('XXX','BUG ')
9638   55   CONTINUE
9639        WRITE(ICOUT,57)PHEIGH
9640   57   FORMAT('PHEIGH = ',G15.7)
9641        CALL DPWRST('XXX','BUG ')
9642        WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
9643   59   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
9644        CALL DPWRST('XXX','BUG ')
9645      ENDIF
9646C
9647C               **********************************************
9648C               **  STEP 7--                                **
9649C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9650C               **  OF THE MARKER JUSTIFICATION             **
9651C               **  INTO A NUMERIC REPRESENTATION           **
9652C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9653C               **  GRAPHICS DEVICE.                        **
9654C               **********************************************
9655C
9656      CALL GRTRJU(ITEXJU,IJUST,JJUST)
9657C
9658C               *******************************
9659C               **  STEP 19--                **
9660C               **  DRAW OUT THE POLYMARKER  **
9661C               *******************************
9662C
9663      CALL GRDRIM(PX,PY,NP,
9664     1            ICASCO,IJUST,PHEIGH,
9665     1            YRED,YBLUE,YGREEN,YALPHA,
9666     1            PXMIN,PYMIN,PXMAX,PYMAX)
9667C
9668C               *****************
9669C               **  STEP 90--  **
9670C               **  EXIT       **
9671C               *****************
9672C
9673      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRIM')THEN
9674        WRITE(ICOUT,999)
9675        CALL DPWRST('XXX','BUG ')
9676        WRITE(ICOUT,9011)
9677 9011   FORMAT('***** AT THE END       OF DPDRIM--')
9678        CALL DPWRST('XXX','BUG ')
9679      ENDIF
9680C
9681      RETURN
9682      END
9683      SUBROUTINE DPDRPL(PX,PY,NP,
9684     1                  IFIG,IPATT,PTHICK,ICOL,
9685     1                  JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
9686C
9687C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
9688C              DRAW THE POLYLINE WHOSE COORDINATES
9689C              ARE GIVEN IN (PX(.),PY(.)) ,
9690C              AND WHICH HAS SPECIFIED
9691C              PATTERN, THICKNESS, AND COLOR.
9692C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
9693C           STANDARDIZED (0.0 TO 100.0) UNITS.
9694C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
9695C
9696C     WRITTEN BY--JAMES J. FILLIBEN
9697C                 STATISTICAL ENGINEERING DIVISION
9698C                 INFORMATION TECHNOLOGY LABORATORY
9699C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9700C                 GAITHERSBURG, MD 20899-8980
9701C                 PHONE--301-921-369011
9702C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9703C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9704C     LANGUAGE--ANSI FORTRAN (1977)
9705C     VERSION NUMBER--83.6
9706C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
9707C     UPDATED         --JANUARY   1989. MODIFED CALL LIST (ALAN)
9708C     UPDATED         --JANUARY   1989. MODIFIED LINE THICKNESS ALGOR. (ALAN)
9709C     UPDATED         --MAY       1989. DEBUG FOR IFLAG
9710C     UPDATED         --MAY       1995. USE EQUIVALENCE
9711C     UPDATED         --JUNE      2019. EQUIVALENCE FOR SCRATCH STORAGE
9712C
9713C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
9714C
9715      CHARACTER*4 IFIG
9716      CHARACTER*4 IPATT
9717      CHARACTER*4 ICOL
9718C
9719      CHARACTER*4 ITYPE
9720      CHARACTER*4 IHORPA
9721      CHARACTER*4 IVERPA
9722      CHARACTER*4 IDUPPA
9723      CHARACTER*4 IDDOPA
9724C
9725      CHARACTER*4 IFLAG
9726C
9727      DIMENSION PX(*)
9728      DIMENSION PY(*)
9729CCCCC DIMENSION PX3(*)
9730CCCCC DIMENSION PY3(*)
9731      INCLUDE 'DPCOPA.INC'
9732      INCLUDE 'DPCOZZ.INC'
9733      DIMENSION PX3(MAXPOP)
9734      DIMENSION PY3(MAXPOP)
9735      EQUIVALENCE (GARBAG(IGAR10),PX3(1))
9736      EQUIVALENCE (GARBAG(JGAR16),PY3(1))
9737C
9738C-----COMMON----------------------------------------------------------
9739C
9740      INCLUDE 'DPCOGR.INC'
9741      INCLUDE 'DPCOBE.INC'
9742      INCLUDE 'DPCOP2.INC'
9743C
9744C-----START POINT-----------------------------------------------------
9745C
9746      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')THEN
9747        WRITE(ICOUT,999)
9748  999   FORMAT(1X)
9749        CALL DPWRST('XXX','BUG ')
9750        WRITE(ICOUT,51)
9751   51   FORMAT('***** AT THE BEGINNING OF DPDRPL--')
9752        CALL DPWRST('XXX','BUG ')
9753        WRITE(ICOUT,54)MAX(10,NP),IFLAG,ISUBG4,IERRG4
9754   54   FORMAT('NP,IFLAG,ISUBG4,IERRG4 = ',I8,3(2X,A4))
9755        CALL DPWRST('XXX','BUG ')
9756        DO55I=1,NP
9757          WRITE(ICOUT,56)PX(I),PY(I)
9758   56     FORMAT('PX(I),PY(I) = ',2G15.7)
9759          CALL DPWRST('XXX','BUG ')
9760   55   CONTINUE
9761        WRITE(ICOUT,58)IFIG,IPATT,ICOL,PTHICK
9762   58   FORMAT('IFIG,IPATT,ICOL,PTHICK = ',3(A4,2X),G15.7)
9763        CALL DPWRST('XXX','BUG ')
9764        WRITE(ICOUT,59)JTHICK,PTHICK,PTHIC2
9765   59   FORMAT('JTHICK,PTHIC,PTHIC2 = ',I8,2G15.7)
9766        CALL DPWRST('XXX','BUG ')
9767      ENDIF
9768C
9769C  SEPTEMMBER, 1987 - SET ATTRIBUTES ACCORDING TO FLAG
9770      NP3=NP
9771      IF(IFLAG.EQ.'OFF')GOTO700
9772C
9773      ITYPE='LINE'
9774C
9775C               **********************************************
9776C               **  STEP 1--                                **
9777C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9778C               **  OF THE LINE PATTERN                     **
9779C               **  INTO A NUMERIC REPRESENTATION           **
9780C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9781C               **  GRAPHICS DEVICE.                        **
9782C               **********************************************
9783C
9784      CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
9785     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
9786C
9787C               *******************************
9788C               **  STEP 2--                 **
9789C               **  SET THE LINE PATTERN     **
9790C               **  ON THE GRAPHICS DEVICE.  **
9791C               *******************************
9792C
9793      CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
9794     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
9795C
9796C               **********************************************
9797C               **  STEP 3--                                **
9798C               **  TRANSLATE THE  DESIRED                  **
9799C               **  LINE THICKNESS                          **
9800C               **  INTO A NUMERIC REPRESENTATION           **
9801C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9802C               **  GRAPHICS DEVICE.                        **
9803C               **********************************************
9804C
9805      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
9806C
9807C               *******************************
9808C               **  STEP 4--                 **
9809C               **  SET THE LINE THICKNESS   **
9810C               **  ON THE GRAPHICS DEVICE.  **
9811C               *******************************
9812C
9813      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
9814C
9815C               **********************************************
9816C               **  STEP 901--                                **
9817C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
9818C               **  OF THE LINE COLOR                       **
9819C               **  INTO A NUMERIC REPRESENTATION           **
9820C               **  WHICH CAN BE UNDERSTOOD BY THE          **
9821C               **  GRAPHICS DEVICE.                        **
9822C               **********************************************
9823C
9824      CALL GRTRCO(ITYPE,ICOL,JCOL)
9825C
9826C               *******************************
9827C               **  STEP 6--                 **
9828C               **  SET THE LINE COLOR       **
9829C               **  ON THE GRAPHICS DEVICE.  **
9830C               *******************************
9831C
9832      CALL GRSECO(ITYPE,ICOL,JCOL)
9833C
9834C               *****************************
9835C               **  STEP 7--               **
9836C               **  DRAW OUT THE POLYLINE  **
9837C               *****************************
9838C
9839  700 CONTINUE
9840      IF(IFLAG.EQ.'LOOP')GOTO800
9841      CALL GRDRPL(PX,PY,NP,
9842     1IFIG,IPATT,PTHICK,ICOL,
9843     1JPATT,JTHICK,PTHIC2,JCOL)
9844C
9845CCCCC PPENTH=0.1
9846CCCCC NLOOP=((PTHICK/(2.0*PPENTH))-1.0)+0.1
9847C
9848CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')
9849CCCCC1WRITE(ICOUT,1510)PPENTH,NLOOP
9850C1510 FORMAT('PPENTH,NLOOP = ',E15.7,I8)
9851CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')
9852CCCCC1CALL DPWRST('XXX','BUG ')
9853C
9854      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')THEN
9855        WRITE(ICOUT,1510)PTHIC2,JTHICK
9856 1510   FORMAT('PTHIC2,JTICK = ',E15.7,I8)
9857        CALL DPWRST('XXX','BUG ')
9858      ENDIF
9859C
9860  800 CONTINUE
9861      NLOOP=JTHICK
9862      PPENTH=PTHIC2
9863C
9864      IF(NLOOP.LE.0)GOTO1590
9865      DO1520I=1,NLOOP
9866      AI=I
9867C
9868      DEL=PPENTH*AI
9869      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')THEN
9870        WRITE(ICOUT,1522)I,NLOOP,DEL
9871 1522   FORMAT('I,NLOOP,DEL = ',2I8,G15.7)
9872        CALL DPWRST('XXX','BUG ')
9873      ENDIF
9874      CALL GRDEPL(PX,PY,NP,DEL,PX3,PY3,NP3)
9875      CALL GRDRPL(PX3,PY3,NP3,
9876     1IFIG,IPATT,PTHICK,ICOL,
9877     1JPATT,JTHICK,PTHIC2,JCOL)
9878C
9879      DEL=(-PPENTH*AI)
9880      CALL GRDEPL(PX,PY,NP,DEL,PX3,PY3,NP3)
9881      CALL GRDRPL(PX3,PY3,NP3,
9882     1IFIG,IPATT,PTHICK,ICOL,
9883     1JPATT,JTHICK,PTHIC2,JCOL)
9884C
9885 1520 CONTINUE
9886C
9887 1590 CONTINUE
9888C
9889C               *****************
9890C               **  STEP 90--  **
9891C               **  EXIT       **
9892C               *****************
9893C
9894      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')THEN
9895        WRITE(ICOUT,999)
9896        CALL DPWRST('XXX','BUG ')
9897        WRITE(ICOUT,9011)
9898 9011   FORMAT('***** AT THE END       OF DPDRPL--')
9899        CALL DPWRST('XXX','BUG ')
9900        WRITE(ICOUT,9024)IERRG4,ITYPE,PPENTH,DEL,NLOOP
9901 9024   FORMAT('IERRG4,ITYPE,PPENTH,DEL,NLOOP = ',2(A4,2X),2G15.7,I8)
9902        CALL DPWRST('XXX','BUG ')
9903      ENDIF
9904C
9905      RETURN
9906      END
9907      SUBROUTINE DPDRPM(PX,PY,NP,X3D2,IJUNK2,IROWID,IROWLB,
9908     1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
9909     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
9910     1IMPSW2,AMPSCH,AMPSCW,
9911     1ISYMBL,ISPAC)
9912C
9913C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
9914C              DRAW THE POLYMARKERS WHOSE COORDINATES
9915C              ARE GIVEN IN (PX(.),PY(.)) ,
9916C              AND WHICH HAS SPECIFIED
9917C              MARKER TYPE, SIZE, FONT, JUSTIFICATION, COLOR, ANGLE,
9918C              AND LINE THICKNESS.
9919C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
9920C           STANDARDIZED (0.0 TO 100.0) UNITS.
9921C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
9922C
9923C     WRITTEN BY--JAMES J. FILLIBEN
9924C                 STATISTICAL ENGINEERING DIVISION
9925C                 INFORMATION TECHNOLOGY LABORATORY
9926C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9927C                 GAITHERSBURG, MD 20899-8980
9928C                 PHONE--301-975-2899
9929C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9930C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9931C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
9932C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
9933C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
9934C     LANGUAGE--ANSI FORTRAN (1977)
9935C     VERSION NUMBER--83.6
9936C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
9937C     UPDATED       --NOVEMBER   1995.  SUPPORT FOR CASE ASIS
9938C     UPDATED       --SEPTEMBER  1999.  GRDRPM ARGUMENT LIST
9939C     UPDATED       --DECEMBER   1999.  SUPPORT SPECIAL PLOTTING
9940C                                       (FOR VALUE OF POINT,ETC.)
9941C
9942C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
9943C
9944      CHARACTER*4 ITYPE
9945C
9946      CHARACTER*4 IFIG
9947      CHARACTER*24 IPATT
9948      CHARACTER*4 IFONT
9949      CHARACTER*4 ICASE
9950      CHARACTER*4 IJUST
9951      CHARACTER*4 IDIR
9952      CHARACTER*4 IFILL
9953      CHARACTER*4 ICOL
9954C
9955      CHARACTER*24 ISYMBL
9956      CHARACTER*4 ISPAC
9957      CHARACTER*4 IMPSW2
9958C
9959      CHARACTER*4 IHORPA
9960      CHARACTER*4 IVERPA
9961      CHARACTER*4 IDUPPA
9962      CHARACTER*4 IDDOPA
9963C
9964      CHARACTER*4 ITYPSV
9965C
9966      CHARACTER*4 ICTEMP
9967      CHARACTER*4 ICTEXT
9968      CHARACTER*4 IERROR
9969C
9970      CHARACTER*24 IROWLB
9971C
9972      DIMENSION ICTEXT(50)
9973C
9974      DIMENSION IROWID(*)
9975      DIMENSION IROWLB(*)
9976      DIMENSION IJUNK2(*)
9977      DIMENSION PX(*)
9978      DIMENSION PY(*)
9979      DIMENSION X3D2(*)
9980C
9981C-----COMMON----------------------------------------------------------
9982C
9983      INCLUDE 'DPCOPA.INC'
9984      INCLUDE 'DPCODA.INC'
9985      INCLUDE 'DPCOGR.INC'
9986      INCLUDE 'DPCOBE.INC'
9987      INCLUDE 'DPCOP2.INC'
9988C
9989C-----START POINT-----------------------------------------------------
9990C
9991      IERROR='OFF'
9992      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPM')GOTO90
9993      WRITE(ICOUT,999)
9994  999 FORMAT(1X)
9995      CALL DPWRST('XXX','BUG ')
9996      WRITE(ICOUT,51)
9997   51 FORMAT('***** AT THE BEGINNING OF DPDRPM--')
9998      CALL DPWRST('XXX','BUG ')
9999      WRITE(ICOUT,54)NP
10000   54 FORMAT('NP = ',I8)
10001      CALL DPWRST('XXX','BUG ')
10002      DO55I=1,NP
10003      WRITE(ICOUT,56)PX(I),PY(I)
10004   56 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
10005      CALL DPWRST('XXX','BUG ')
10006   55 CONTINUE
10007      WRITE(ICOUT,58)IFIG,IFONT,IJUST,IFILL,ICOL,IPATT
10008   58 FORMAT('IFIG,IFONT,IJUST,IFILL,ICOL,IPATT = ',5(A4,1X),A16)
10009      CALL DPWRST('XXX','BUG ')
10010      WRITE(ICOUT,64)IDIR,ANGLE,PTHICK
10011   64 FORMAT('IDIR,ANGLE,PTHICK = ',A4,2X,2G15.7)
10012      CALL DPWRST('XXX','BUG ')
10013      WRITE(ICOUT,67)PHEIGH,PWIDTH,PVEGAP,PHOGAP
10014   67 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4G15.7)
10015      CALL DPWRST('XXX','BUG ')
10016      WRITE(ICOUT,71)ISYMBL,ISPAC
10017   71 FORMAT('ISYMBL,ISPAC = ',A24,2X,A4)
10018      CALL DPWRST('XXX','BUG ')
10019      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
10020   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
10021      CALL DPWRST('XXX','BUG ')
10022   90 CONTINUE
10023C
10024CCCCC DECEMBER 1999.  SUPPORT SPECIAL CASES:
10025CCCCC 1) XVAL  = X-COORDINATE OF VARIABLE
10026CCCCC 2) YVAL  = Y-COORDINATE OF VARIABLE
10027CCCCC 3) XYVA  = (X,Y) OF VARIABLE
10028CCCCC 4) ROWI  = ROW-ID
10029CCCCC 5) ROWL  = ROW-LABEL
10030CCCCC 6) TVAL  = TAG-VALUE (SPECIAL CASE FOR CROSS-TABULATE PLOT,
10031CCCCC            BUT MAY HAVE OTHER USES AS WELL)
10032CCCCC 7) ZVAL  = USE VALUE IN X3D2
10033C
10034      IF(
10035     1(ISYMBL(1:1).EQ.'R'.OR.ISYMBL(1:1).EQ.'r').AND.
10036     1(ISYMBL(2:2).EQ.'O'.OR.ISYMBL(2:2).EQ.'o').AND.
10037     1(ISYMBL(3:3).EQ.'W'.OR.ISYMBL(3:3).EQ.'w').AND.
10038     1(ISYMBL(4:4).EQ.'I'.OR.ISYMBL(4:4).EQ.'i')
10039     1)THEN
10040        DO1010I=1,NP
10041          IROW=IROWID(I)
10042          AROW=REAL(IROW)
10043          NCTEXT=0
10044          DO1015J=1,50
10045            ICTEXT(J)=' '
10046 1015     CONTINUE
10047          CALL DPCONH(IROW,AROW,ICTEXT,NH,IBUGG4,IERROR)
10048          NCTEXT=NH
10049          PX1=PX(I)
10050          PY1=PY(I)
10051          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
10052     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
10053     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
10054     1                ISYMBL,ISPAC,
10055     1                IMPSW2,AMPSCH,AMPSCW,
10056     1                PX99,PY99)
10057 1010   CONTINUE
10058        GOTO9000
10059      ELSEIF(
10060     1(ISYMBL(1:1).EQ.'R'.OR.ISYMBL(1:1).EQ.'r').AND.
10061     1(ISYMBL(2:2).EQ.'O'.OR.ISYMBL(2:2).EQ.'o').AND.
10062     1(ISYMBL(3:3).EQ.'W'.OR.ISYMBL(3:3).EQ.'w').AND.
10063     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
10064     1)THEN
10065        DO1020I=1,NP
10066          ITEMP=IROWID(I)
10067C
10068C         2012/08: FOR BLANK ROW LABEL, JUST LEAVE BLANK
10069C
10070          IF(IROWLB(ITEMP).EQ.' ')THEN
10071            GOTO9000
10072CCCCC       IROW=IROWID(I)
10073CCCCC       AROW=REAL(IROW)
10074CCCCC       NCTEXT=0
10075CCCCC       DO1025J=1,50
10076CCCCC         ICTEXT(J)=' '
10077C1025       CONTINUE
10078CCCCC       CALL DPCONH(IROW,AROW,ICTEXT,NH,IBUGG4,IERROR)
10079CCCCC       NCTEXT=NH
10080          ELSE
10081            NCTEXT=1
10082            DO1026J=24,1,-1
10083              IF(IROWLB(ITEMP)(J:J).NE.' ')THEN
10084                NCTEXT=J
10085                GOTO1027
10086              ENDIF
10087 1026       CONTINUE
10088 1027       CONTINUE
10089            DO1028J=1,NCTEXT
10090              ICTEXT(J)=' '
10091              ICTEXT(J)(1:1)=IROWLB(ITEMP)(J:J)
10092 1028       CONTINUE
10093          ENDIF
10094          PX1=PX(I)
10095          PY1=PY(I)
10096          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
10097     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
10098     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
10099     1                ISYMBL,ISPAC,
10100     1                IMPSW2,AMPSCH,AMPSCW,
10101     1                PX99,PY99)
10102 1020   CONTINUE
10103        GOTO9000
10104      ELSEIF(
10105     1(ISYMBL(1:1).EQ.'X'.OR.ISYMBL(1:1).EQ.'x').AND.
10106     1(ISYMBL(2:2).EQ.'V'.OR.ISYMBL(2:2).EQ.'v').AND.
10107     1(ISYMBL(3:3).EQ.'A'.OR.ISYMBL(3:3).EQ.'a').AND.
10108     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
10109     1)THEN
10110        DO1030I=1,NP
10111          PX1=PX(I)
10112          PY1=PY(I)
10113          AVAL=X(I)
10114          CONST=0.5
10115          IF(AVAL.LT.0.0)CONST=-0.5
10116          IVAL=INT(AVAL+CONST)
10117          NCTEXT=0
10118          DO1035J=1,50
10119            ICTEXT(J)=' '
10120 1035     CONTINUE
10121          CALL DPCONH(IVAL,AVAL,ICTEXT,NH,IBUGG4,IERROR)
10122          NCTEXT=NH
10123          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
10124     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
10125     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
10126     1                ISYMBL,ISPAC,
10127     1                IMPSW2,AMPSCH,AMPSCW,
10128     1                PX99,PY99)
10129 1030   CONTINUE
10130        GOTO9000
10131      ELSEIF(
10132     1(ISYMBL(1:1).EQ.'Y'.OR.ISYMBL(1:1).EQ.'y').AND.
10133     1(ISYMBL(2:2).EQ.'V'.OR.ISYMBL(2:2).EQ.'v').AND.
10134     1(ISYMBL(3:3).EQ.'A'.OR.ISYMBL(3:3).EQ.'a').AND.
10135     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
10136     1)THEN
10137        DO1040I=1,NP
10138          PX1=PX(I)
10139          PY1=PY(I)
10140          AVAL=Y(I)
10141          CONST=0.5
10142          IF(AVAL.LT.0.0)CONST=-0.5
10143          IVAL=INT(AVAL+CONST)
10144          NCTEXT=0
10145          DO1045J=1,50
10146            ICTEXT(J)=' '
10147 1045     CONTINUE
10148          CALL DPCONH(IVAL,AVAL,ICTEXT,NH,IBUGG4,IERROR)
10149          NCTEXT=NH
10150          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
10151     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
10152     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
10153     1                ISYMBL,ISPAC,
10154     1                IMPSW2,AMPSCH,AMPSCW,
10155     1                PX99,PY99)
10156 1040   CONTINUE
10157        GOTO9000
10158      ELSEIF(
10159     1(ISYMBL(1:1).EQ.'X'.OR.ISYMBL(1:1).EQ.'x').AND.
10160     1(ISYMBL(2:2).EQ.'Y'.OR.ISYMBL(2:2).EQ.'y').AND.
10161     1(ISYMBL(3:3).EQ.'V'.OR.ISYMBL(3:3).EQ.'v').AND.
10162     1(ISYMBL(4:4).EQ.'A'.OR.ISYMBL(4:4).EQ.'a')
10163     1)THEN
10164        DO1050I=1,NP
10165          DO1055J=1,50
10166            ICTEXT(J)=' '
10167 1055     CONTINUE
10168          PX1=PX(I)
10169          PY1=PY(I)
10170          AVAL=X(I)
10171          CONST=0.5
10172          IF(AVAL.LT.0.0)CONST=-0.5
10173          IVAL=INT(AVAL+CONST)
10174          NCTEXT=1
10175          ICTEXT(NCTEXT)(1:1)='('
10176          NCTEXT=NCTEXT+1
10177          CALL DPCONH(IVAL,AVAL,ICTEXT(NCTEXT),NH,IBUGG4,IERROR)
10178          NCTEXT=NCTEXT+NH
10179          NCTEXT=NCTEXT+1
10180          ICTEXT(NCTEXT)(1:1)=','
10181          NCTEXT=NCTEXT+1
10182          AVAL=Y(I)
10183          IF(AVAL.LT.0.0)CONST=-0.5
10184          IVAL=INT(AVAL+CONST)
10185          CALL DPCONH(IVAL,AVAL,ICTEXT(NCTEXT),NH,IBUGG4,IERROR)
10186          NCTEXT=NCTEXT+NH
10187          ICTEXT(NCTEXT)(1:1)=')'
10188          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
10189     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
10190     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
10191     1                ISYMBL,ISPAC,
10192     1                IMPSW2,AMPSCH,AMPSCW,
10193     1                PX99,PY99)
10194 1050   CONTINUE
10195        GOTO9000
10196      ELSEIF(
10197     1(ISYMBL(1:1).EQ.'T'.OR.ISYMBL(1:1).EQ.'t').AND.
10198     1(ISYMBL(2:2).EQ.'V'.OR.ISYMBL(2:2).EQ.'v').AND.
10199     1(ISYMBL(3:3).EQ.'A'.OR.ISYMBL(3:3).EQ.'a').AND.
10200     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
10201     1)THEN
10202        DO1060I=1,NP
10203          PX1=PX(I)
10204          PY1=PY(I)
10205          AVAL=D(I)
10206          CONST=0.5
10207          IF(AVAL.LT.0.0)CONST=-0.5
10208          IVAL=INT(AVAL+CONST)
10209          NCTEXT=0
10210          DO1065J=1,50
10211            ICTEXT(J)=' '
10212 1065     CONTINUE
10213          CALL DPCONH(IVAL,AVAL,ICTEXT,NH,IBUGG4,IERROR)
10214          NCTEXT=NH
10215          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
10216     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
10217     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
10218     1                ISYMBL,ISPAC,
10219     1                IMPSW2,AMPSCH,AMPSCW,
10220     1                PX99,PY99)
10221 1060   CONTINUE
10222        GOTO9000
10223      ELSEIF(
10224     1(ISYMBL(1:1).EQ.'Z'.OR.ISYMBL(1:1).EQ.'z').AND.
10225     1(ISYMBL(2:2).EQ.'V'.OR.ISYMBL(2:2).EQ.'v').AND.
10226     1(ISYMBL(3:3).EQ.'A'.OR.ISYMBL(3:3).EQ.'a').AND.
10227     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
10228     1)THEN
10229        J=0
10230        DO1070I=1,MAXPOP
10231          IF(IJUNK2(I).EQ.0)GOTO1070
10232          J=J+1
10233          PX1=PX(J)
10234          PY1=PY(J)
10235          AVAL=X3D2(I)
10236          CONST=0.5
10237          IF(AVAL.LT.0.0)CONST=-0.5
10238          IVAL=INT(AVAL+CONST)
10239          NCTEXT=0
10240          DO1075JJ=1,50
10241            ICTEXT(JJ)=' '
10242 1075     CONTINUE
10243          CALL DPCONH(IVAL,AVAL,ICTEXT,NH,IBUGG4,IERROR)
10244          NCTEXT=NH
10245          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
10246     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
10247     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
10248     1                ISYMBL,ISPAC,
10249     1                IMPSW2,AMPSCH,AMPSCW,
10250     1                PX99,PY99)
10251          IF(J.GE.NP)GOTO1079
10252 1070   CONTINUE
10253 1079   CONTINUE
10254        GOTO9000
10255      ENDIF
10256CCCCC NOVEMBER 1995. DO CASE CONVERSION HERE.
10257CCCCC IF "ASIS" NO ACTION REQUIRED.
10258CCCCC BE SURE TO TRANSLATE IPATT TO UPPER CASE.
10259      IF(ICASE.EQ.'LOWE')THEN
10260        DO100I=1,24
10261        ICTEMP=ISYMBL(I:I)
10262        CALL DPCOAN(ICTEMP,IVALT)
10263        IF(IVALT.GE.65.AND.IVALT.LE.90)IVALT=IVALT+32
10264        CALL DPCONA(IVALT,ICTEMP)
10265        ISYMBL(I:I)=ICTEMP
10266  100   CONTINUE
10267      ELSEIF(ICASE.EQ.'UPPE')THEN
10268        DO110I=1,24
10269        ICTEMP=ISYMBL(I:I)
10270        CALL DPCOAN(ICTEMP,IVALT)
10271        IF(IVALT.GE.97.AND.IVALT.LE.122)IVALT=IVALT-32
10272        CALL DPCONA(IVALT,ICTEMP)
10273        ISYMBL(I:I)=ICTEMP
10274  110   CONTINUE
10275      ELSEIF(ICASE.EQ.'ASIS')THEN
10276        CONTINUE
10277      END IF
10278      DO130I=1,24
10279      ICTEMP=IPATT(I:I)
10280      CALL DPCOAN(ICTEMP,IVALT)
10281      IF(IVALT.GE.97.AND.IVALT.LE.122)IVALT=IVALT-32
10282      CALL DPCONA(IVALT,ICTEMP)
10283      IPATT(I:I)=ICTEMP
10284  130 CONTINUE
10285C
10286      ITYPE='MARK'
10287C
10288C               **********************************************
10289C               **  STEP 1--                                **
10290C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
10291C               **  OF THE MARKER PATTERN (TYPE)            **
10292C               **  INTO A NUMERIC REPRESENTATION           **
10293C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10294C               **  GRAPHICS DEVICE.                        **
10295C               **********************************************
10296C
10297      CALL GRTRPA(ITYPE,IPATT(1:4),PXSPA,PYSPA,
10298     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
10299C
10300C               *******************************
10301C               **  STEP 2--                 **
10302C               **  SET THE MARKER PATTERN   **
10303C               **  ON THE GRAPHICS DEVICE.  **
10304C               *******************************
10305C
10306      CALL GRSEPA(ITYPE,IPATT(1:4),PXSPA,PYSPA,
10307     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
10308C
10309C               **********************************************
10310C               **  STEP 3--                                **
10311C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
10312C               **  OF THE MARKER FONT                      **
10313C               **  INTO A NUMERIC REPRESENTATION           **
10314C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10315C               **  GRAPHICS DEVICE.                        **
10316C               **********************************************
10317C
10318      CALL GRTRFO(ITYPE,IFONT,JFONT)
10319C
10320C               ************************************
10321C               **  STEP 4--                      **
10322C               **  SET THE MARKER FONT           **
10323C               **  ON THE GRAPHICS DEVICE.       **
10324C               ************************************
10325C
10326      CALL GRSEFO(ITYPE,IFONT,JFONT)
10327C
10328C               **********************************************
10329C               **  STEP 5--                                **
10330C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
10331C               **  OF THE MARKER CASE (UPPER OR LOWER)     **
10332C               **  INTO A NUMERIC REPRESENTATION           **
10333C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10334C               **  GRAPHICS DEVICE.                        **
10335C               **********************************************
10336C
10337      CALL GRTRCA(ITYPE,ICASE,JCASE)
10338C
10339C               ************************************
10340C               **  STEP 6--                      **
10341C               **  SET THE MARKER CASE           **
10342C               **  ON THE GRAPHICS DEVICE.       **
10343C               ************************************
10344C
10345      CALL GRSECA(ITYPE,ICASE,JCASE)
10346C
10347C               **********************************************
10348C               **  STEP 7--                                **
10349C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
10350C               **  OF THE MARKER JUSTIFICATION             **
10351C               **  INTO A NUMERIC REPRESENTATION           **
10352C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10353C               **  GRAPHICS DEVICE.                        **
10354C               **********************************************
10355C
10356      CALL GRTRJU(ITYPE,IJUST,JJUST)
10357C
10358C               ************************************
10359C               **  STEP 8--                      **
10360C               **  SET THE MARKER JUSTIFICATION  **
10361C               **  ON THE GRAPHICS DEVICE.       **
10362C               ************************************
10363C
10364      CALL GRSEJU(ITYPE,IJUST,JJUST)
10365C
10366C               **********************************************
10367C               **  STEP 9--                               **
10368C               **  TRANSLATE THE CHARACTER REPRESENTATION **
10369C               **  OF THE MARKER DIRECTION (ANGLE)         **
10370C               **  INTO A NUMERIC REPRESENTATION           **
10371C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10372C               **  GRAPHICS DEVICE.                        **
10373C               **********************************************
10374C
10375      CALL GRTRDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
10376C
10377C               ************************************
10378C               **  STEP 10--                    **
10379C               **  SET THE MARKER DIRECTION     **
10380C               **  ON THE GRAPHICS DEVICE.       **
10381C               ************************************
10382C
10383      CALL GRSEDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
10384C
10385C               **********************************************
10386C               **  STEP 11--                              **
10387C               **  TRANSLATE THE CHARACTER REPRESENTATION **
10388C               **  OF THE MARKER FILL (ON/OFF)                     **
10389C               **  INTO A NUMERIC REPRESENTATION           **
10390C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10391C               **  GRAPHICS DEVICE.                        **
10392C               **********************************************
10393C
10394      CALL GRTRFI(ITYPE,IFILL,JFILL)
10395C
10396C               *******************************
10397C               **  STEP 12--                **
10398C               **  SET THE MARKER FILL      **
10399C               **  ON THE GRAPHICS DEVICE.  **
10400C               *******************************
10401C
10402      CALL GRSEFI(ITYPE,IFILL,JFILL)
10403C
10404C               **********************************************
10405C               **  STEP 13--                               **
10406C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
10407C               **  OF THE MARKER COLOR                     **
10408C               **  INTO A NUMERIC REPRESENTATION           **
10409C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10410C               **  GRAPHICS DEVICE.                        **
10411C               **********************************************
10412C
10413      ITYPSV=ITYPE
10414      IF(IFONT.EQ.'TEKT')ITYPE='TEXT'
10415      CALL GRTRCO(ITYPE,ICOL,JCOL)
10416      ITYPE=ITYPSV
10417C
10418C               *******************************
10419C               **  STEP 14--                **
10420C               **  SET THE MARKER COLOR     **
10421C               **  ON THE GRAPHICS DEVICE.  **
10422C               *******************************
10423C
10424      ITYPSV=ITYPE
10425      IF(IFONT.EQ.'TEKT')ITYPE='TEXT'
10426      CALL GRSECO(ITYPE,ICOL,JCOL)
10427      ITYPE=ITYPSV
10428C
10429C               **********************************************
10430C               **  STEP 15--                                **
10431C               **  TRANSLATE THE CHARACTER REPRESENTATION   **
10432C               **  OF THE MARKER SIZE                      **
10433C               **  INTO A NUMERIC REPRESENTATION           **
10434C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10435C               **  GRAPHICS DEVICE.                        **
10436C               **********************************************
10437C
10438      CALL GRTRSI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
10439     1JSIZE,
10440     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
10441     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
10442C
10443C               ************************************
10444C               **  STEP 16--                      **
10445C               **  SET THE MARKER SIZE            **
10446C               **  ON THE GRAPHICS DEVICE.       **
10447C               ************************************
10448C
10449      CALL GRSESI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
10450     1JSIZE,
10451     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
10452     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
10453C
10454C               **********************************************
10455C               **  STEP 17--                                **
10456C               **  TRANSLATE THE CHARACTER REPRESENTATION   **
10457C               **  OF THE MARKER LINE THICKNESS            **
10458C               **  INTO A NUMERIC REPRESENTATION           **
10459C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10460C               **  GRAPHICS DEVICE.                        **
10461C               **********************************************
10462C
10463      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
10464C
10465C               ************************************
10466C               **  STEP 18--                      **
10467C               **  SET THE MARKER LINE THICKNESS  **
10468C               **  ON THE GRAPHICS DEVICE.       **
10469C               ************************************
10470C
10471      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
10472C
10473C               *******************************
10474C               **  STEP 19--                **
10475C               **  DRAW OUT THE POLYMARKER  **
10476C               *******************************
10477C
10478      CALL GRDRPM(PX,PY,NP,
10479     1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
10480     1JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
10481     1PTHICK,JTHICK,PTHIC2,
10482     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
10483     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
10484     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
10485     1IMPSW2,AMPSCH,AMPSCW,
10486     1ISYMBL,ISPAC)
10487C
10488C               *****************
10489C               **  STEP 90--  **
10490C               **  EXIT       **
10491C               *****************
10492C
10493 9000 CONTINUE
10494      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPM')GOTO9090
10495      WRITE(ICOUT,999)
10496      CALL DPWRST('XXX','BUG ')
10497      WRITE(ICOUT,9011)
10498 9011 FORMAT('***** AT THE END       OF DPDRPM--')
10499      CALL DPWRST('XXX','BUG ')
10500      WRITE(ICOUT,9014)NP
10501 9014 FORMAT('NP = ',I8)
10502      CALL DPWRST('XXX','BUG ')
10503      DO9015I=1,NP
10504      WRITE(ICOUT,9016)PX(I),PY(I)
10505 9016 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
10506      CALL DPWRST('XXX','BUG ')
10507 9015 CONTINUE
10508      WRITE(ICOUT,9018)IFIG
10509 9018 FORMAT('IFIG = ',A4)
10510      CALL DPWRST('XXX','BUG ')
10511      WRITE(ICOUT,9019)IPATT,JPATT
10512 9019 FORMAT('IPATT,JPATT = ',A4,I8)
10513      CALL DPWRST('XXX','BUG ')
10514      WRITE(ICOUT,9022)IFONT,JFONT
10515 9022 FORMAT('IFONT,JFONT = ',A4,I8)
10516      CALL DPWRST('XXX','BUG ')
10517      WRITE(ICOUT,9023)IJUST,JJUST
10518 9023 FORMAT('IJUST,JJUST = ',A4,I8)
10519      CALL DPWRST('XXX','BUG ')
10520      WRITE(ICOUT,9024)IDIR,ANGLE,JDIR,ANGLE2
10521 9024 FORMAT('IDIR,ANGLE,JDIR,ANGLE2 = ',A4,2X,E15.7,A4,2X,E15.7)
10522      CALL DPWRST('XXX','BUG ')
10523      WRITE(ICOUT,9025)IFILL,JFILL
10524 9025 FORMAT('IFILL,JFILL = ',A4,I8)
10525      CALL DPWRST('XXX','BUG ')
10526      WRITE(ICOUT,9026)ICOL,JCOL
10527 9026 FORMAT('ICOL,JCOL = ',A4,I8)
10528      CALL DPWRST('XXX','BUG ')
10529      WRITE(ICOUT,9027)PHEIGH,PWIDTH,PVEGAP,PHOGAP
10530 9027 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
10531      CALL DPWRST('XXX','BUG ')
10532      WRITE(ICOUT,9028)PHEIG2,PWIDT2,PVEGA2,PHOGA2
10533 9028 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
10534      CALL DPWRST('XXX','BUG ')
10535      WRITE(ICOUT,9029)PTHICK,PTHIC2
10536 9029 FORMAT('PTHICK,PTHIC2 = ',2E15.7)
10537      CALL DPWRST('XXX','BUG ')
10538      WRITE(ICOUT,9031)ISYMBL,ISPAC
10539 9031 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
10540      CALL DPWRST('XXX','BUG ')
10541      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
10542 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
10543      CALL DPWRST('XXX','BUG ')
10544 9090 CONTINUE
10545C
10546      RETURN
10547      END
10548      SUBROUTINE DPDRSP(Y,X,PY,PX,NP,
10549     1ICASPL,ICAS3D,
10550     1ISORSW,
10551     1ISP2LI,ISP2CO,ISP2DI,PSP2TH,ASP2BA,
10552     1PXMIN,PXMAX,PYMIN,PYMAX,
10553     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
10554     1IX1TSC,IY1TSC)
10555C
10556C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
10557C              AND FOR EACH VALUE IN X(.), DRAW A SPIKE
10558C              (= A VERTICAL OR HORIZONTAL LINE SEGMENT)
10559C              FROM THE BASE POINT ASP2BA
10560C              TO THE POINT Y(.).
10561C              DO SO FOR A SPECIFIED SPIKE LINE TYPE,
10562C              LINES COLOR, LINE DIRECTION, AND LINE THICKNESS.
10563C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
10564C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
10565C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
10566C           BACK IN THE MAIN ROUTINE.
10567C
10568C     WRITTEN BY--JAMES J. FILLIBEN
10569C                 STATISTICAL ENGINEERING DIVISION
10570C                 INFORMATION TECHNOLOGY LABORATORY
10571C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10572C                 GAITHERSBURG, MD 20899-8980
10573C                 PHONE--301-975-2855
10574C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10575C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10576C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
10577C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
10578C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
10579C     LANGUAGE--ANSI FORTRAN (1977)
10580C     VERSION NUMBER--87.6
10581C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
10582C     UPDATED--APRIL     1987.
10583C     UPDATED         --SEPTEMBER 1988.  RENUMBER
10584C     UPDATED         --FEBRUARY  1989.  CHANGE CALLS FROM GRDRPL TO DPDRPL (ALA
10585C     UPDATED         --JULY      1990.  CHARACTER*4 IPATT TO FIX BOMB
10586C
10587C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
10588C
10589      CHARACTER*4 ICASPL
10590      CHARACTER*4 ICAS3D
10591C
10592      CHARACTER*4 ISORSW
10593C
10594      CHARACTER*4 ISP2LI
10595      CHARACTER*4 ISP2CO
10596      CHARACTER*4 ISP2DI
10597C
10598      CHARACTER*4 IX1TSC
10599      CHARACTER*4 IY1TSC
10600C
10601      CHARACTER*4 ITYPE
10602C
10603      CHARACTER*4 IFIG
10604      CHARACTER*4 IPATTT
10605CCCCC THE FOLLOWING LINE WAS ADDED TO FIX SPIKE BOMB   JULY 1990
10606      CHARACTER*4 IPATT
10607      CHARACTER*4 ICOL
10608      CHARACTER*4 IDIR
10609C
10610C     6/23/86
10611C     HOW COME THE FOLLOWING 4 VARIABLES ARE NOT CARRIED
10612C     AS INPUT TO THIS SUBROUTINE--NOT NEEDED???
10613C     CHECK ON THIS.
10614C
10615      CHARACTER*4 IHORPA
10616      CHARACTER*4 IVERPA
10617      CHARACTER*4 IDUPPA
10618      CHARACTER*4 IDDOPA
10619CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1989
10620      CHARACTER*4 IFLAG
10621C
10622      DIMENSION Y(*)
10623      DIMENSION X(*)
10624      DIMENSION PY(*)
10625      DIMENSION PX(*)
10626C
10627      DIMENSION PY2(10)
10628      DIMENSION PX2(10)
10629C
10630C-----COMMON----------------------------------------------------------
10631C
10632      INCLUDE 'DPCOGR.INC'
10633      INCLUDE 'DPCOBE.INC'
10634      INCLUDE 'DPCOP2.INC'
10635C
10636C-----START POINT-----------------------------------------------------
10637C
10638      HOLD=1.0
10639      ABASE=0.0
10640      PBASE=0.0
10641      PBASE2=0.0
10642C
10643      FXMIN=FX1MIN
10644      FXMAX=FX1MAX
10645      FYMIN=FY1MIN
10646      FYMAX=FY1MAX
10647C
10648CCCCC THE FOLLOWING 2 LINES WERE ADDED TO FIX SPIKE BOMB JULY 1990
10649      IPATT='JUNK'
10650      JPATT=(-888)
10651      J=0
10652C
10653      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRSP')GOTO90
10654      WRITE(ICOUT,999)
10655  999 FORMAT(1X)
10656      CALL DPWRST('XXX','BUG ')
10657      WRITE(ICOUT,51)
10658   51 FORMAT('***** AT THE BEGINNING OF DPDRSP--')
10659      CALL DPWRST('XXX','BUG ')
10660      WRITE(ICOUT,52)NP
10661   52 FORMAT('NP = ',I8)
10662      CALL DPWRST('XXX','BUG ')
10663      WRITE(ICOUT,53)ICASPL,ICAS3D
10664   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
10665      CALL DPWRST('XXX','BUG ')
10666      IF(NP.LE.3)GOTO69
10667      DO65I=1,3
10668      WRITE(ICOUT,66)I,X(I),Y(I)
10669   66 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
10670      CALL DPWRST('XXX','BUG ')
10671   65 CONTINUE
10672      NPM2=NP-2
10673      DO67I=NPM2,NP
10674      WRITE(ICOUT,68)I,X(I),Y(I)
10675   68 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
10676      CALL DPWRST('XXX','BUG ')
10677   67 CONTINUE
10678   69 CONTINUE
10679      WRITE(ICOUT,70)ISORSW
10680   70 FORMAT('ISORSW = ',A4)
10681      CALL DPWRST('XXX','BUG ')
10682      WRITE(ICOUT,71)ISP2LI
10683   71 FORMAT('ISP2LI= ',A4)
10684      CALL DPWRST('XXX','BUG ')
10685      WRITE(ICOUT,72)ISP2CO,ISP2DI
10686   72 FORMAT('ISP2CO,ISP2DI= ',A4,2X,A4)
10687      CALL DPWRST('XXX','BUG ')
10688      WRITE(ICOUT,73)PSP2TH
10689   73 FORMAT('PSP2TH= ',E15.7)
10690      CALL DPWRST('XXX','BUG ')
10691      WRITE(ICOUT,74)ASP2BA
10692   74 FORMAT('ASP2BA= ',E15.7)
10693      CALL DPWRST('XXX','BUG ')
10694      WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
10695   84 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
10696      CALL DPWRST('XXX','BUG ')
10697      WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
10698   85 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
10699      CALL DPWRST('XXX','BUG ')
10700      WRITE(ICOUT,86)IX1TSC,IY1TSC
10701   86 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
10702      CALL DPWRST('XXX','BUG ')
10703      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
10704   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
10705      CALL DPWRST('XXX','BUG ')
10706   90 CONTINUE
10707C
10708C               *************************************************
10709C               **  STEP 11--                                  **
10710C               **  IF CALLED FOR, SORT THE DATA               **
10711C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
10712C               *************************************************
10713C
10714      IDIR=ISP2DI
10715C
10716      IF(ICASPL.EQ.'TRPL')GOTO9000
10717      IF(ISORSW.EQ.'OFF')GOTO1150
10718      IF(ICASPL.EQ.'PIEC')GOTO1150
10719      IF(ICASPL.EQ.'ROSE')GOTO1150
10720      IF(ICAS3D.EQ.'ON')GOTO1150
10721      IF(ICASPL.EQ.'CONT')GOTO1150
10722C
10723      CALL SORTC(X,Y,NP,PX,PY)
10724      GOTO1190
10725C
10726 1150 CONTINUE
10727      DO1160I=1,NP
10728      PX(I)=X(I)
10729      PY(I)=Y(I)
10730 1160 CONTINUE
10731      GOTO1190
10732C
10733 1190 CONTINUE
10734C
10735C               ************************************************
10736C               **  STEP 12--                                 **
10737C               **  IF A LOG SCALE PLOT IS CALLED FOR,        **
10738C               **  CHECK THAT ALL DATA POINTS ARE POSITIVE.  **
10739C               ************************************************
10740C
10741      IF(IX1TSC.EQ.'LOG')GOTO1210
10742      GOTO1290
10743C
10744 1210 CONTINUE
10745      IF(IDIR.EQ.'H')GOTO1215
10746      GOTO1219
10747 1215 CONTINUE
10748      IF(ASP2BA.LE.0.0)HOLD=ASP2BA
10749      IF(ASP2BA.LE.0.0)GOTO1250
10750 1219 CONTINUE
10751C
10752      IF(ISORSW.EQ.'ON')GOTO1220
10753      GOTO1230
10754C
10755 1220 CONTINUE
10756      J=1
10757      IF(PX(J).LE.0.0)GOTO1250
10758      GOTO1290
10759C
10760 1230 CONTINUE
10761      DO1235I=1,NP
10762      J=I
10763      IF(PX(J).LE.0.0)GOTO1250
10764 1235 CONTINUE
10765      GOTO1290
10766C
10767 1250 CONTINUE
10768      WRITE(ICOUT,999)
10769      CALL DPWRST('XXX','BUG ')
10770      WRITE(ICOUT,1251)
10771 1251 FORMAT('***** ERROR IN DPDRSP--')
10772      CALL DPWRST('XXX','BUG ')
10773      WRITE(ICOUT,1252)
10774 1252 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
10775      CALL DPWRST('XXX','BUG ')
10776      WRITE(ICOUT,1253)
10777 1253 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
10778      CALL DPWRST('XXX','BUG ')
10779      WRITE(ICOUT,1254)
10780 1254 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
10781      CALL DPWRST('XXX','BUG ')
10782      WRITE(ICOUT,1255)
10783 1255 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
10784      CALL DPWRST('XXX','BUG ')
10785      WRITE(ICOUT,1256)PX(J)
10786 1256 FORMAT('      THE VALUE = ',E15.7)
10787      CALL DPWRST('XXX','BUG ')
10788      WRITE(ICOUT,1257)
10789 1257 FORMAT('      THIS VALUE CAME FROM THE ')
10790      CALL DPWRST('XXX','BUG ')
10791      WRITE(ICOUT,1258)
10792 1258 FORMAT('      HORIZONTAL AXIS VARIABLE.')
10793      CALL DPWRST('XXX','BUG ')
10794      WRITE(ICOUT,1259)
10795 1259 FORMAT('      CORRECTIVE ACTION--')
10796      CALL DPWRST('XXX','BUG ')
10797      WRITE(ICOUT,1260)
10798 1260 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
10799      CALL DPWRST('XXX','BUG ')
10800      IERRG4='YES'
10801      GOTO9000
10802C
10803 1290 CONTINUE
10804C
10805      IF(IY1TSC.EQ.'LOG')GOTO1310
10806      GOTO1390
10807C
10808 1310 CONTINUE
10809      IF(IDIR.EQ.'V')GOTO1315
10810      GOTO1319
10811 1315 CONTINUE
10812      IF(ASP2BA.LE.0.0)HOLD=ASP2BA
10813      IF(ASP2BA.LE.0.0)GOTO1350
10814 1319 CONTINUE
10815C
10816      IF(ISORSW.EQ.'ON')GOTO1320
10817      GOTO1330
10818C
10819 1320 CONTINUE
10820      J=1
10821      IF(PY(J).LE.0.0)HOLD=PY(J)
10822      IF(PY(J).LE.0.0)GOTO1350
10823      GOTO1390
10824C
10825 1330 CONTINUE
10826      DO1335I=1,NP
10827      J=I
10828      IF(PY(J).LE.0.0)HOLD=PY(J)
10829      IF(PY(J).LE.0.0)GOTO1350
10830 1335 CONTINUE
10831      GOTO1390
10832C
10833 1350 CONTINUE
10834      WRITE(ICOUT,999)
10835      CALL DPWRST('XXX','BUG ')
10836      WRITE(ICOUT,1351)
10837 1351 FORMAT('***** ERROR IN DPDRSP--')
10838      CALL DPWRST('XXX','BUG ')
10839      WRITE(ICOUT,1352)
10840 1352 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
10841      CALL DPWRST('XXX','BUG ')
10842      WRITE(ICOUT,1353)
10843 1353 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
10844      CALL DPWRST('XXX','BUG ')
10845      WRITE(ICOUT,1354)
10846 1354 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
10847      CALL DPWRST('XXX','BUG ')
10848      WRITE(ICOUT,1355)
10849 1355 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
10850      CALL DPWRST('XXX','BUG ')
10851      WRITE(ICOUT,1356)HOLD
10852 1356 FORMAT('      THE VALUE = ',E15.7)
10853      CALL DPWRST('XXX','BUG ')
10854      WRITE(ICOUT,1357)
10855 1357 FORMAT('      THIS VALUE CAME FROM THE ')
10856      CALL DPWRST('XXX','BUG ')
10857      WRITE(ICOUT,1358)
10858 1358 FORMAT('      VERTICAL AXIS VARIABLE.')
10859      CALL DPWRST('XXX','BUG ')
10860      WRITE(ICOUT,1359)
10861 1359 FORMAT('      CORRECTIVE ACTION--')
10862      CALL DPWRST('XXX','BUG ')
10863      WRITE(ICOUT,1360)
10864 1360 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
10865      CALL DPWRST('XXX','BUG ')
10866      IERRG4='YES'
10867      GOTO9000
10868C
10869 1390 CONTINUE
10870C
10871C               ******************************************
10872C               **  STEP 40--                           **
10873C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
10874C               **  TRANSFORM THE DATA                  **
10875C               ******************************************
10876C
10877      ABASE=ASP2BA
10878C
10879      IF(IX1TSC.EQ.'LOG')GOTO4010
10880      GOTO4019
10881 4010 CONTINUE
10882      IF(IDIR.EQ.'H')ABASE=LOG10(ABASE)
10883      DO4015I=1,NP
10884      PX(I)=LOG10(PX(I))
10885 4015 CONTINUE
10886 4019 CONTINUE
10887C
10888      IF(IY1TSC.EQ.'LOG')GOTO4020
10889      GOTO4029
10890 4020 CONTINUE
10891      IF(IDIR.EQ.'V')ABASE=LOG10(ABASE)
10892      DO4025I=1,NP
10893      PY(I)=LOG10(PY(I))
10894 4025 CONTINUE
10895 4029 CONTINUE
10896C
10897C               *****************************************************
10898C               **  STEP 50--                                      **
10899C               **  TRANSLATE THE DATA POINTS                      **
10900C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
10901C               *****************************************************
10902C
10903      FXMIN=FX1MIN
10904      FXMAX=FX1MAX
10905      IF(IX1TSC.EQ.'LOG')FXMIN=LOG10(FX1MIN)
10906      IF(IX1TSC.EQ.'LOG')FXMAX=LOG10(FX1MAX)
10907C
10908      FYMIN=FY1MIN
10909      FYMAX=FY1MAX
10910      IF(IY1TSC.EQ.'LOG')FYMIN=LOG10(FY1MIN)
10911      IF(IY1TSC.EQ.'LOG')FYMAX=LOG10(FY1MAX)
10912C
10913      FXRANG=FXMAX-FXMIN
10914      FYRANG=FYMAX-FYMIN
10915      PXRANG=PXMAX-PXMIN
10916      PYRANG=PYMAX-PYMIN
10917C
10918      DO5000I=1,NP
10919      FXRATI=(PX(I)-FXMIN)/FXRANG
10920      FYRATI=(PY(I)-FYMIN)/FYRANG
10921      PX(I)=PXMIN+FXRATI*PXRANG
10922      PY(I)=PYMIN+FYRATI*PYRANG
10923 5000 CONTINUE
10924C
10925      IF(IDIR.EQ.'V')GOTO5010
10926      GOTO5019
10927 5010 CONTINUE
10928      FYRATI=(ABASE-FYMIN)/FYRANG
10929      PBASE=PYMIN+FYRATI*PYRANG
10930 5019 CONTINUE
10931C
10932      IF(IDIR.EQ.'H')GOTO5020
10933      GOTO5029
10934 5020 CONTINUE
10935      FXRATI=(ABASE-FXMIN)/FXRANG
10936      PBASE=PXMIN+FXRATI*PXRANG
10937 5029 CONTINUE
10938C
10939C               *******************************
10940C               **  STEP 70--                **
10941C               **  PREPARE TO MAKE VARIOUS  **
10942C               **  LINE SETTINGS            **
10943C               *******************************
10944C
10945      ITYPE='LINE'
10946C
10947C               **********************************************
10948C               **  STEP 71--                               **
10949C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
10950C               **  OF THE LINE PATTERN                     **
10951C               **  INTO A NUMERIC REPRESENTATION           **
10952C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10953C               **  GRAPHICS DEVICE.                        **
10954C               **********************************************
10955C
10956      IPATTT=ISP2LI
10957      CALL GRTRPA(ITYPE,IPATTT,PXSPA,PYSPA,
10958     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
10959C
10960C               *******************************
10961C               **  STEP 72--                **
10962C               **  SET THE LINE PATTERN     **
10963C               **  ON THE GRAPHICS DEVICE.  **
10964C               *******************************
10965C
10966      CALL GRSEPA(ITYPE,IPATTT,PXSPA,PYSPA,
10967     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
10968C
10969C               **********************************************
10970C               **  STEP 73--                               **
10971C               **  TRANSLATE THE  DESIRED                  **
10972C               **  LINE THICKNESS                          **
10973C               **  INTO A NUMERIC REPRESENTATION           **
10974C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10975C               **  GRAPHICS DEVICE.                        **
10976C               **********************************************
10977C
10978      PTHICK=PSP2TH
10979      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
10980C
10981C               *******************************
10982C               **  STEP 74--                **
10983C               **  SET THE LINE THICKNESS   **
10984C               **  ON THE GRAPHICS DEVICE.  **
10985C               *******************************
10986C
10987      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
10988C
10989C               **********************************************
10990C               **  STEP 75--                               **
10991C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
10992C               **  OF THE LINE COLOR                       **
10993C               **  INTO A NUMERIC REPRESENTATION           **
10994C               **  WHICH CAN BE UNDERSTOOD BY THE          **
10995C               **  GRAPHICS DEVICE.                        **
10996C               **********************************************
10997C
10998      ICOL=ISP2CO
10999      CALL GRTRCO(ITYPE,ICOL,JCOL)
11000C
11001C               *******************************
11002C               **  STEP 76--                **
11003C               **  SET THE LINE COLOR       **
11004C               **  ON THE GRAPHICS DEVICE.  **
11005C               *******************************
11006C
11007      CALL GRSECO(ITYPE,ICOL,JCOL)
11008C
11009C               **************************************
11010C               **  STEP 81--                       **
11011C               **  DRAW OUT ALL SPIKES             **
11012C               **  (BUT CLIP FIRST, IF NECESSARY)  **
11013C               **************************************
11014C
11015      IFIG='GENE'
11016C
11017      CALL DPSQUE(PX,PY,NP,
11018     1PXMIN,PXMAX,PYMIN,PYMAX)
11019C
11020      IF(IDIR.EQ.'V')GOTO7100
11021      GOTO7190
11022 7100 CONTINUE
11023      PBASE2=PBASE
11024      IF(PBASE2.LT.PYMIN.AND.(PYMIN-PBASE2).LE.0.0001)PBASE2=PYMIN
11025      IF(PBASE2.GT.PYMAX.AND.(PBASE2-PYMAX).LE.0.0001)PBASE2=PYMAX
11026C
11027CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1989
11028      IFLAG='OFF'
11029      NP2=2
11030      DO7110I=1,NP
11031C
11032      IF(PX(I).LT.PXMIN)GOTO7110
11033      IF(PX(I).GT.PXMAX)GOTO7110
11034      IF(PY(I).LT.PYMIN.AND.PBASE2.LT.PYMIN)GOTO7110
11035      IF(PY(I).GT.PYMAX.AND.PBASE2.GT.PYMAX)GOTO7110
11036C
11037      PX2(1)=PX(I)
11038      PX2(2)=PX(I)
11039C
11040      PY2(1)=PBASE2
11041      PY2(2)=PY(I)
11042C
11043      DO7150J=1,NP2
11044      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
11045      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
11046 7150 CONTINUE
11047C
11048CCCCC THE FOLLOWING 3 LINES WERE COMMENTED OUT FEBRUARY 1989
11049CCCCC AND REPLACED BY THE SUBSEQUENT 3 LINES (ALAN) FEBRUARY 1989
11050CCCCC CALL GRDRPL(PX2,PY2,NP2,
11051CCCCC1IFIG,IPATTT,PTHICK,ICOL,
11052CCCCC1JPATTT,JTHICK,PTHIC2,JCOL)
11053      CALL DPDRPL(PX2,PY2,NP2,
11054     1IFIG,IPATT,PTHICK,ICOL,
11055CCCCC THE FOLLOWING LINE WAS TEMPORARILY FIXED JULY 9, 1990
11056CCCCC1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11057     1JPATTT,JTHICK,PTHIC2,JCOL,IFLAG)
11058C
11059C
11060 7110 CONTINUE
11061 7190 CONTINUE
11062C
11063      IF(IDIR.EQ.'H')GOTO7200
11064      GOTO7290
11065 7200 CONTINUE
11066CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1989
11067      IFLAG='OFF'
11068      PBASE2=PBASE
11069      IF(PBASE2.LT.PXMIN.AND.(PXMIN-PBASE2).LE.0.0001)PBASE2=PXMIN
11070      IF(PBASE2.GT.PXMAX.AND.(PBASE2-PXMAX).LE.0.0001)PBASE2=PXMAX
11071C
11072      NP2=2
11073      DO7210I=1,NP
11074C
11075      IF(PY(I).LT.PYMIN)GOTO7210
11076      IF(PY(I).GT.PYMAX)GOTO7210
11077      IF(PX(I).LT.PXMIN.AND.PBASE2.LT.PXMIN)GOTO7210
11078      IF(PX(I).GT.PXMAX.AND.PBASE2.GT.PXMAX)GOTO7210
11079C
11080      PX2(1)=PBASE2
11081      PX2(2)=PX(I)
11082C
11083      PY2(1)=PY(I)
11084      PY2(2)=PY(I)
11085C
11086      DO7250J=1,NP2
11087      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
11088      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
11089 7250 CONTINUE
11090C
11091CCCCC THE FOLLOWING 3 LINES WERE COMMENTED OUT FEBRUARY 1989
11092CCCCC AND REPLACED BY THE SUBSEQUENT 3 LINES (ALAN) FEBRUARY 1989
11093CCCCC CALL GRDRPL(PX2,PY2,NP2,
11094CCCCC1IFIG,IPATTT,PTHICK,ICOL,
11095CCCCC1JPATTT,JTHICK,PTHIC2,JCOL)
11096      CALL DPDRPL(PX2,PY2,NP2,
11097     1IFIG,IPATT,PTHICK,ICOL,
11098CCCCC THE FOLLOWING LINE WAS TEMPORARILY FIXED JULY 9, 1990
11099CCCCC1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11100     1JPATTT,JTHICK,PTHIC2,JCOL,IFLAG)
11101C
11102 7210 CONTINUE
11103 7290 CONTINUE
11104C
11105C               *****************
11106C               **  STEP 90--  **
11107C               **  EXIT       **
11108C               *****************
11109C
11110 9000 CONTINUE
11111      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRSP')GOTO9090
11112      WRITE(ICOUT,999)
11113      CALL DPWRST('XXX','BUG ')
11114      WRITE(ICOUT,9011)
11115 9011 FORMAT('***** AT THE END       OF DPDRSP--')
11116      CALL DPWRST('XXX','BUG ')
11117      WRITE(ICOUT,9012)NP
11118 9012 FORMAT('NP = ',I8)
11119      CALL DPWRST('XXX','BUG ')
11120      WRITE(ICOUT,9013)ICASPL,ICAS3D
11121 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
11122      CALL DPWRST('XXX','BUG ')
11123      WRITE(ICOUT,9014)HOLD
11124 9014 FORMAT('HOLD = ',E15.7)
11125      CALL DPWRST('XXX','BUG ')
11126      WRITE(ICOUT,9015)ABASE,PBASE,PBASE2
11127 9015 FORMAT('ABASE,PBASE,PBASE2 = ',3E15.7)
11128      CALL DPWRST('XXX','BUG ')
11129      IF(NP.LE.3)GOTO9029
11130      DO9025I=1,3
11131      WRITE(ICOUT,9026)I,X(I),Y(I)
11132 9026 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
11133      CALL DPWRST('XXX','BUG ')
11134 9025 CONTINUE
11135      NPM2=NP-2
11136      DO9027I=NPM2,NP
11137      WRITE(ICOUT,9028)I,X(I),Y(I)
11138 9028 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
11139      CALL DPWRST('XXX','BUG ')
11140 9027 CONTINUE
11141 9029 CONTINUE
11142      WRITE(ICOUT,9030)ISORSW
11143 9030 FORMAT('ISORSW = ',A4)
11144      CALL DPWRST('XXX','BUG ')
11145      WRITE(ICOUT,9031)ISP2LI
11146 9031 FORMAT('ISP2LI= ',A4)
11147      CALL DPWRST('XXX','BUG ')
11148      WRITE(ICOUT,9032)PSP2TH
11149 9032 FORMAT('PSP2TH= ',E15.7)
11150      CALL DPWRST('XXX','BUG ')
11151      WRITE(ICOUT,9033)ISP2CO,ISP2DI
11152 9033 FORMAT('ISP2CO,ISP2DI= ',A4,2X,A4)
11153      CALL DPWRST('XXX','BUG ')
11154      WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
11155 9044 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
11156      CALL DPWRST('XXX','BUG ')
11157      WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
11158 9045 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
11159      CALL DPWRST('XXX','BUG ')
11160      WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
11161 9046 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
11162      CALL DPWRST('XXX','BUG ')
11163      WRITE(ICOUT,9047)IX1TSC,IY1TSC
11164 9047 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
11165      CALL DPWRST('XXX','BUG ')
11166      WRITE(ICOUT,9051)IFIG
11167 9051 FORMAT('IFIG = ',A4)
11168      CALL DPWRST('XXX','BUG ')
11169CCCCC THE FOLLOWING 2 LINES WERE AUGMENTED JULY 1990
11170CCCCC WRITE(ICOUT,9052)IPATTT,JPATTT
11171C9052 FORMAT('IPATTT,JPATTT = ',A4,I8)
11172CCCCC CALL DPWRST('XXX','BUG ')
11173      WRITE(ICOUT,9052)IPATT,IPATTT,JPATTT
11174 9052 FORMAT('IPATT,IPATTT,JPATTT = ',A4,2X,A4,I8)
11175      CALL DPWRST('XXX','BUG ')
11176      WRITE(ICOUT,9053)PTHICK,JTHICK,PTHIC2
11177 9053 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
11178      CALL DPWRST('XXX','BUG ')
11179      WRITE(ICOUT,9054)ICOL,JCOL,IDIR
11180 9054 FORMAT('ICOL,JCOL,IDIR = ',A4,I8,2X,A4)
11181      CALL DPWRST('XXX','BUG ')
11182      WRITE(ICOUT,9055)ITYPE
11183 9055 FORMAT('ITYPE = ',A4)
11184      CALL DPWRST('XXX','BUG ')
11185      WRITE(ICOUT,9069)IBUGG4,ISUBG4,IERRG4
11186 9069 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
11187      CALL DPWRST('XXX','BUG ')
11188 9090 CONTINUE
11189C
11190      RETURN
11191      END
11192      SUBROUTINE DPDRTM(PXMIN,PYMIN,PXMAX,PYMAX,
11193     1                  FXMIN,FYMIN,FXMAX,FYMAX,
11194     1                  ICASPL,ICAS3D,
11195     1                  IX1FSW,IX2FSW,IY1FSW,IY2FSW,
11196     1                  IX1TSW,IX2TSW,IY1TSW,IY2TSW,
11197     1                  PX1COO,PX2COO,PY1COO,PY2COO,
11198     1                  NX1COO,NX2COO,NY1COO,NY2COO,
11199     1                  PX1CMN,PX2CMN,PY1CMN,PY2CMN,
11200     1                  NX1CMN,NX2CMN,NY1CMN,NY2CMN,
11201     1                  PX1TLE,PX2TLE,PY1TLE,PY2TLE,
11202     1                  PTICTH,PMNTFA,
11203     1                  IX1TJU,IX2TJU,IY1TJU,IY2TJU,
11204     1                  IX1TCO,IX2TCO,IY1TCO,IY2TCO)
11205C
11206C     PURPOSE--DRAW TIC MARKS ON THE FRAME LINES.
11207C     WRITTEN BY--JAMES J. FILLIBEN
11208C                 STATISTICAL ENGINEERING DIVISION
11209C                 INFORMATION TECHNOLOGY LABORATORY
11210C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11211C                 GAITHERSBURG, MD 20899-8980
11212C                 PHONE--301-975-2855
11213C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11214C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11215C     LANGUAGE--ANSI FORTRAN (1977)
11216C     VERSION NUMBER--83.6
11217C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
11218C     UPDATED         --FEBRUARY  1988.  STAR PLOT
11219C     UPDATED         --JANUARY   1989.  CALL DPDRPL RATHER THAN GRDRPL (ALAN)
11220C
11221C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
11222C
11223      CHARACTER*4 ICASPL
11224      CHARACTER*4 ICAS3D
11225C
11226      CHARACTER*4 IX1FSW
11227      CHARACTER*4 IX2FSW
11228      CHARACTER*4 IY1FSW
11229      CHARACTER*4 IY2FSW
11230C
11231      CHARACTER*4 IX1TSW
11232      CHARACTER*4 IX2TSW
11233      CHARACTER*4 IY1TSW
11234      CHARACTER*4 IY2TSW
11235C
11236      CHARACTER*4 IX1TJU
11237      CHARACTER*4 IX2TJU
11238      CHARACTER*4 IY1TJU
11239      CHARACTER*4 IY2TJU
11240C
11241      CHARACTER*4 IX1TCO
11242      CHARACTER*4 IX2TCO
11243      CHARACTER*4 IY1TCO
11244      CHARACTER*4 IY2TCO
11245C
11246      CHARACTER*4 ITYPE
11247      CHARACTER*4 IFIG
11248      CHARACTER*4 IPATT
11249      CHARACTER*4 ICOL
11250      CHARACTER*4 IHORPA
11251      CHARACTER*4 IVERPA
11252      CHARACTER*4 IDUPPA
11253      CHARACTER*4 IDDOPA
11254C
11255      CHARACTER*4 IFLAG
11256C
11257      DIMENSION PX1COO(*)
11258      DIMENSION PX2COO(*)
11259      DIMENSION PY1COO(*)
11260      DIMENSION PY2COO(*)
11261C
11262      DIMENSION PX1CMN(*)
11263      DIMENSION PX2CMN(*)
11264      DIMENSION PY1CMN(*)
11265      DIMENSION PY2CMN(*)
11266C
11267      DIMENSION PX(100)
11268      DIMENSION PY(100)
11269C
11270C-----COMMON----------------------------------------------------------
11271C
11272      INCLUDE 'DPCOGR.INC'
11273      INCLUDE 'DPCOBE.INC'
11274      INCLUDE 'DPCOP2.INC'
11275C
11276C-----START POINT-----------------------------------------------------
11277C
11278      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRTM')THEN
11279        WRITE(ICOUT,999)
11280  999   FORMAT(1X)
11281        CALL DPWRST('XXX','BUG ')
11282        WRITE(ICOUT,51)
11283   51   FORMAT('***** AT THE BEGINNING OF DPDRTM--')
11284        CALL DPWRST('XXX','BUG ')
11285        WRITE(ICOUT,52)PXMIN,PYMIN,PXMAX,PYMAX
11286   52   FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
11287        CALL DPWRST('XXX','BUG ')
11288        WRITE(ICOUT,42)FXMIN,FYMIN,FXMAX,FYMAX
11289   42   FORMAT('FXMIN,FYMIN,FXMAX,FYMAX = ',4F10.5)
11290        CALL DPWRST('XXX','BUG ')
11291        WRITE(ICOUT,53)IBUGG4,ISUBG4,IERRG4,ICASPL,ICAS3D
11292   53   FORMAT('IBUGG4,ISUBG4,IERRG4,ICASPL,ICAS3D = ',4(A4,2X),A4)
11293        CALL DPWRST('XXX','BUG ')
11294        WRITE(ICOUT,54)IX1FSW,IX2FSW,IY1FSW,IY2FSW
11295   54   FORMAT('IX1FSW,IX2FSW,IY1FSW,IY2FSW = ',3(A4,2X),A4)
11296        CALL DPWRST('XXX','BUG ')
11297        WRITE(ICOUT,55)IX1TSW,IX2TSW,IY1TSW,IY2TSW
11298   55   FORMAT('IX1TSW,IX2TSW,IY1TSW,IY2TSW = ',3(A4,2X),A4)
11299        CALL DPWRST('XXX','BUG ')
11300        WRITE(ICOUT,56)PTICTH,PMNTFA
11301   56   FORMAT('PTICTH,PMNTFA = ',2E15.7)
11302        CALL DPWRST('XXX','BUG ')
11303        WRITE(ICOUT,57)IX1TJU,IX2TJU,IY1TJU,IY2TJU
11304   57   FORMAT('IX1TJU,IX2TJU,IY1TJU,IY2TJU = ',3(A4,2X),A4)
11305        CALL DPWRST('XXX','BUG ')
11306        WRITE(ICOUT,58)IX1TCO,IX2TCO,IY1TCO,IY2TCO
11307   58   FORMAT('IX1TCO,IX2TCO,IY1TCO,IY2TCO = ',3(A4,2X),A4)
11308        CALL DPWRST('XXX','BUG ')
11309        WRITE(ICOUT,59)NX1COO,NX2COO,NY1COO,NY2COO
11310   59   FORMAT('NX1COO,NX2COO,NY1COO,NY2COO = ',4I8)
11311        CALL DPWRST('XXX','BUG ')
11312        WRITE(ICOUT,60)NX1CMN,NX2CMN,NY1CMN,NY2CMN
11313   60   FORMAT('NX1CMN,NX2CMN,NY1CMN,NY2CMN = ',4I8)
11314        CALL DPWRST('XXX','BUG ')
11315C
11316        IF(NX1COO.GT.0)THEN
11317          WRITE(ICOUT,999)
11318          CALL DPWRST('XXX','BUG ')
11319          DO61I=1,NX1COO
11320            WRITE(ICOUT,62)I,PX1COO(I)
11321   62       FORMAT('I,PX1COO(I) = ',I8,E15.7)
11322            CALL DPWRST('XXX','BUG ')
11323   61     CONTINUE
11324        ENDIF
11325C
11326        IF(NX2COO.GT.0)THEN
11327          WRITE(ICOUT,999)
11328          CALL DPWRST('XXX','BUG ')
11329          DO71I=1,NX2COO
11330            WRITE(ICOUT,72)I,PX2COO(I)
11331   72       FORMAT('I,PX2COO(I) = ',I8,E15.7)
11332            CALL DPWRST('XXX','BUG ')
11333   71     CONTINUE
11334        ENDIF
11335C
11336        IF(NY1COO.GT.0)THEN
11337          WRITE(ICOUT,999)
11338          CALL DPWRST('XXX','BUG ')
11339          DO81I=1,NY1COO
11340            WRITE(ICOUT,82)I,PY1COO(I)
11341   82       FORMAT('I,PY1COO(I) = ',I8,E15.7)
11342            CALL DPWRST('XXX','BUG ')
11343   81     CONTINUE
11344        ENDIF
11345C
11346        IF(NY2COO.GT.0)THEN
11347          WRITE(ICOUT,999)
11348          CALL DPWRST('XXX','BUG ')
11349          DO91I=1,NY2COO
11350            WRITE(ICOUT,92)I,PY2COO(I)
11351   92       FORMAT('I,PY2COO(I) = ',I8,E15.7)
11352            CALL DPWRST('XXX','BUG ')
11353   91     CONTINUE
11354        ENDIF
11355C
11356      ENDIF
11357C
11358      IF(ICASPL.EQ.'PIEC')GOTO9000
11359      IF(ICASPL.EQ.'ROSE')GOTO9000
11360      IF(ICASPL.EQ.'STAR')GOTO9000
11361      IF(ICAS3D.EQ.'ON')GOTO9000
11362      IF(ICASPL.EQ.'TRPL')GOTO2000
11363C
11364      ITYPE='LINE'
11365C
11366C               ***************************************************
11367C               **  STEP 1--                                     **
11368C               **  THE TIC MARKS WILL HAVE SOLID LINE PATTERN.  **
11369C               **  TRANSLATE THIS SOLID LINE PATTERN            **
11370C               **  INTO A NUMBER WHICH CAN BE UNDERSTOOD        **
11371C               **  BY THE GRAPHICS DEVICE.                      **
11372C               ***************************************************
11373C
11374      IFIG='LINE'
11375      IPATT='SOLI'
11376      CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
11377     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
11378C
11379C               **********************************
11380C               **  STEP 2--                    **
11381C               **  SET THE LINE TYPE TO SOLID  **
11382C               **  ON THE GRAPHICS DEVICE.     **
11383C               **********************************
11384C
11385      CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
11386     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
11387C
11388C               **********************************************
11389C               **  STEP 3--                                **
11390C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
11391C               **  OF THE TIC  THICKNESS                   **
11392C               **  INTO A NUMERIC REPRESENTATION           **
11393C               **  WHICH CAN BE UNDERSTOOD BY THE          **
11394C               **  GRAPHICS DEVICE.                        **
11395C               **********************************************
11396C
11397      PTHICK=PTICTH
11398      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
11399C
11400C               *******************************
11401C               **  STEP 4--                 **
11402C               **  SET THE LINE THICKNESS   **
11403C               **  ON THE GRAPHICS DEVICE.  **
11404C               *******************************
11405C
11406      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
11407C
11408C               ******************************************************
11409C               **  STEP 7--                                        **
11410C               **  DRAW MAJOR TIC MARKS ON BOTTOM HORIZONTAL AXIS  **
11411C               **  DRAW MINOR TIC MARKS ON BOTTOM HORIZONTAL AXIS  **
11412C               ******************************************************
11413C
11414      IF(IX1FSW.EQ.'OFF')GOTO1190
11415      IF(IX1TSW.EQ.'OFF')GOTO1190
11416C
11417      ICOL=IX1TCO
11418      CALL GRTRCO(ITYPE,ICOL,JCOL)
11419      CALL GRSECO(ITYPE,ICOL,JCOL)
11420C
11421      PMJTLE=PX1TLE
11422C
11423      PY(1)=PYMIN
11424      PY(2)=PYMIN
11425      IF(IX1TJU.EQ.'THRU')PY(1)=PYMIN+PMJTLE/2.0
11426      IF(IX1TJU.EQ.'THRU')PY(2)=PYMIN-PMJTLE/2.0
11427      IF(IX1TJU.EQ.'IN')PY(1)=PYMIN+PMJTLE
11428      IF(IX1TJU.EQ.'INSI')PY(1)=PYMIN+PMJTLE
11429      IF(IX1TJU.EQ.'OUT')PY(1)=PYMIN-PMJTLE
11430      IF(IX1TJU.EQ.'OUTS')PY(1)=PYMIN-PMJTLE
11431C
11432      IF(NX1COO.LE.0)GOTO1190
11433      NP=2
11434      IFLAG='OFF'
11435      DO1110I=1,NX1COO
11436      PX(1)=PX1COO(I)
11437      PX(2)=PX1COO(I)
11438CCCCC CALL GRDRPL(PX,PY,NP,
11439CCCCC1IFIG,IPATT,PTHICK,ICOL,
11440CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
11441      CALL DPDRPL(PX,PY,NP,
11442     1IFIG,IPATT,PTHICK,ICOL,
11443     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11444 1110 CONTINUE
11445C
11446      PMNTLE=PMJTLE*PMNTFA
11447C
11448      PY(1)=PYMIN
11449      PY(2)=PYMIN
11450      IF(IX1TJU.EQ.'THRU')PY(1)=PYMIN+PMNTLE/2.0
11451      IF(IX1TJU.EQ.'THRU')PY(2)=PYMIN-PMNTLE/2.0
11452      IF(IX1TJU.EQ.'IN')PY(1)=PYMIN+PMNTLE
11453      IF(IX1TJU.EQ.'INSI')PY(1)=PYMIN+PMNTLE
11454      IF(IX1TJU.EQ.'OUT')PY(1)=PYMIN-PMNTLE
11455      IF(IX1TJU.EQ.'OUTS')PY(1)=PYMIN-PMNTLE
11456C
11457      IF(NX1CMN.LE.0)GOTO1190
11458      NP=2
11459      IFLAG='OFF'
11460      DO1120I=1,NX1CMN
11461      PX(1)=PX1CMN(I)
11462      PX(2)=PX1CMN(I)
11463CCCCC CALL GRDRPL(PX,PY,NP,
11464CCCCC1IFIG,IPATT,PTHICK,ICOL,
11465CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
11466      CALL DPDRPL(PX,PY,NP,
11467     1IFIG,IPATT,PTHICK,ICOL,
11468     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11469 1120 CONTINUE
11470C
11471 1190 CONTINUE
11472C
11473C               ******************************************************
11474C               **  STEP 8--                                        **
11475C               **  DRAW MAJOR TIC MARKS ON TOP    HORIZONTAL AXIS  **
11476C               **  DRAW MINOR TIC MARKS ON TOP    HORIZONTAL AXIS  **
11477C               ******************************************************
11478C
11479      IF(IX2FSW.EQ.'OFF')GOTO1290
11480      IF(IX2TSW.EQ.'OFF')GOTO1290
11481C
11482      ICOL=IX2TCO
11483      CALL GRTRCO(ITYPE,ICOL,JCOL)
11484      CALL GRSECO(ITYPE,ICOL,JCOL)
11485C
11486      PMJTLE=PX2TLE
11487C
11488      PY(1)=PYMAX
11489      PY(2)=PYMAX
11490      IF(IX2TJU.EQ.'THRU')PY(1)=PYMAX+PMJTLE/2.0
11491      IF(IX2TJU.EQ.'THRU')PY(2)=PYMAX-PMJTLE/2.0
11492      IF(IX2TJU.EQ.'IN')PY(1)=PYMAX-PMJTLE
11493      IF(IX2TJU.EQ.'INSI')PY(1)=PYMAX-PMJTLE
11494      IF(IX2TJU.EQ.'OUT')PY(1)=PYMAX+PMJTLE
11495      IF(IX2TJU.EQ.'OUTS')PY(1)=PYMAX+PMJTLE
11496C
11497      IF(NX2COO.LE.0)GOTO1290
11498      NP=2
11499      IFLAG='OFF'
11500      DO1210I=1,NX2COO
11501      PX(1)=PX2COO(I)
11502      PX(2)=PX2COO(I)
11503CCCCC CALL GRDRPL(PX,PY,NP,
11504CCCCC1IFIG,IPATT,PTHICK,ICOL,
11505CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
11506      CALL DPDRPL(PX,PY,NP,
11507     1IFIG,IPATT,PTHICK,ICOL,
11508     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11509 1210 CONTINUE
11510C
11511      PMNTLE=PMJTLE*PMNTFA
11512C
11513      PY(1)=PYMAX
11514      PY(2)=PYMAX
11515      IF(IX2TJU.EQ.'THRU')PY(1)=PYMAX+PMNTLE/2.0
11516      IF(IX2TJU.EQ.'THRU')PY(2)=PYMAX-PMNTLE/2.0
11517      IF(IX2TJU.EQ.'IN')PY(1)=PYMAX-PMNTLE
11518      IF(IX2TJU.EQ.'INSI')PY(1)=PYMAX-PMNTLE
11519      IF(IX2TJU.EQ.'OUT')PY(1)=PYMAX+PMNTLE
11520      IF(IX2TJU.EQ.'OUTS')PY(1)=PYMAX+PMNTLE
11521C
11522      IF(NX2CMN.LE.0)GOTO1290
11523      NP=2
11524      IFLAG='OFF'
11525      DO1220I=1,NX2CMN
11526      PX(1)=PX2CMN(I)
11527      PX(2)=PX2CMN(I)
11528CCCCC CALL GRDRPL(PX,PY,NP,
11529CCCCC1IFIG,IPATT,PTHICK,ICOL,
11530CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
11531      CALL DPDRPL(PX,PY,NP,
11532     1IFIG,IPATT,PTHICK,ICOL,
11533     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11534 1220 CONTINUE
11535C
11536 1290 CONTINUE
11537C
11538C               ******************************************************
11539C               **  STEP 9--                                        **
11540C               **  DRAW MAJOR TIC MARKS ON LEFT   VERTICAL   AXIS  **
11541C               **  DRAW MINOR TIC MARKS ON LEFT   VERTICAL   AXIS  **
11542C               ******************************************************
11543C
11544      IF(IY1FSW.EQ.'OFF')GOTO1390
11545      IF(IY1TSW.EQ.'OFF')GOTO1390
11546C
11547      ICOL=IY1TCO
11548      CALL GRTRCO(ITYPE,ICOL,JCOL)
11549      CALL GRSECO(ITYPE,ICOL,JCOL)
11550C
11551      PMJTLE=PY1TLE*(ANUMVP/ANUMHP)
11552C
11553      PX(1)=PXMIN
11554      PX(2)=PXMIN
11555      IF(IY1TJU.EQ.'THRU')PX(1)=PXMIN-PMJTLE/2.0
11556      IF(IY1TJU.EQ.'THRU')PX(2)=PXMIN+PMJTLE/2.0
11557      IF(IY1TJU.EQ.'IN')PX(1)=PXMIN+PMJTLE
11558      IF(IY1TJU.EQ.'INSI')PX(1)=PXMIN+PMJTLE
11559      IF(IY1TJU.EQ.'OUT')PX(1)=PXMIN-PMJTLE
11560      IF(IY1TJU.EQ.'OUTS')PX(1)=PXMIN-PMJTLE
11561C
11562      IF(NY1COO.LE.0)GOTO1390
11563      NP=2
11564      IFLAG='OFF'
11565      DO1310I=1,NY1COO
11566      PY(1)=PY1COO(I)
11567      PY(2)=PY1COO(I)
11568CCCCC CALL GRDRPL(PX,PY,NP,
11569CCCCC1IFIG,IPATT,PTHICK,ICOL,
11570CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
11571      CALL DPDRPL(PX,PY,NP,
11572     1IFIG,IPATT,PTHICK,ICOL,
11573     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11574 1310 CONTINUE
11575C
11576      PMNTLE=PMJTLE*PMNTFA
11577C
11578      PX(1)=PXMIN
11579      PX(2)=PXMIN
11580      IF(IY1TJU.EQ.'THRU')PX(1)=PXMIN-PMNTLE/2.0
11581      IF(IY1TJU.EQ.'THRU')PX(2)=PXMIN+PMNTLE/2.0
11582      IF(IY1TJU.EQ.'IN')PX(1)=PXMIN+PMNTLE
11583      IF(IY1TJU.EQ.'INSI')PX(1)=PXMIN+PMNTLE
11584      IF(IY1TJU.EQ.'OUT')PX(1)=PXMIN-PMNTLE
11585      IF(IY1TJU.EQ.'OUTS')PX(1)=PXMIN-PMNTLE
11586C
11587      IF(NY1CMN.LE.0)GOTO1390
11588      NP=2
11589      IFLAG='OFF'
11590      DO1320I=1,NY1CMN
11591      PY(1)=PY1CMN(I)
11592      PY(2)=PY1CMN(I)
11593CCCCC CALL GRDRPL(PX,PY,NP,
11594CCCCC1IFIG,IPATT,PTHICK,ICOL,
11595CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
11596      CALL DPDRPL(PX,PY,NP,
11597     1IFIG,IPATT,PTHICK,ICOL,
11598     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11599 1320 CONTINUE
11600C
11601 1390 CONTINUE
11602C
11603C               ******************************************************
11604C               **  STEP 10--                                       **
11605C               **  DRAW MAJOR TIC MARKS ON RIGHT  VERTICAL   AXIS  **
11606C               **  DRAW MINOR TIC MARKS ON RIGHT  VERTICAL   AXIS  **
11607C               ******************************************************
11608C
11609      IF(IY2FSW.EQ.'OFF')GOTO1490
11610      IF(IY2TSW.EQ.'OFF')GOTO1490
11611C
11612      ICOL=IY2TCO
11613      CALL GRTRCO(ITYPE,ICOL,JCOL)
11614      CALL GRSECO(ITYPE,ICOL,JCOL)
11615C
11616      PMJTLE=PY2TLE*(ANUMVP/ANUMHP)
11617C
11618      PX(1)=PXMAX
11619      PX(2)=PXMAX
11620      IF(IY2TJU.EQ.'THRU')PX(1)=PXMAX-PMJTLE/2.0
11621      IF(IY2TJU.EQ.'THRU')PX(2)=PXMAX+PMJTLE/2.0
11622      IF(IY2TJU.EQ.'IN')PX(1)=PXMAX-PMJTLE
11623      IF(IY2TJU.EQ.'INSI')PX(1)=PXMAX-PMJTLE
11624      IF(IY2TJU.EQ.'OUT')PX(1)=PXMAX+PMJTLE
11625      IF(IY2TJU.EQ.'OUTS')PX(1)=PXMAX+PMJTLE
11626C
11627      IF(NY2COO.LE.0)GOTO1490
11628      NP=2
11629      IFLAG='OFF'
11630      DO1410I=1,NY2COO
11631      PY(1)=PY2COO(I)
11632      PY(2)=PY2COO(I)
11633CCCCC CALL GRDRPL(PX,PY,NP,
11634CCCCC1IFIG,IPATT,PTHICK,ICOL,
11635CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
11636      CALL DPDRPL(PX,PY,NP,
11637     1IFIG,IPATT,PTHICK,ICOL,
11638     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11639 1410 CONTINUE
11640C
11641      PMNTLE=PMJTLE*PMNTFA
11642C
11643      PX(1)=PXMAX
11644      PX(2)=PXMAX
11645      IF(IY2TJU.EQ.'THRU')PX(1)=PXMAX-PMNTLE/2.0
11646      IF(IY2TJU.EQ.'THRU')PX(2)=PXMAX+PMNTLE/2.0
11647      IF(IY2TJU.EQ.'IN')PX(1)=PXMAX-PMNTLE
11648      IF(IY2TJU.EQ.'INSI')PX(1)=PXMAX-PMNTLE
11649      IF(IY2TJU.EQ.'OUT')PX(1)=PXMAX+PMNTLE
11650      IF(IY2TJU.EQ.'OUTS')PX(1)=PXMAX+PMNTLE
11651C
11652      IF(NY2CMN.LE.0)GOTO1490
11653      NP=2
11654      IFLAG='OFF'
11655      DO1420I=1,NY2CMN
11656      PY(1)=PY2CMN(I)
11657      PY(2)=PY2CMN(I)
11658CCCCC CALL GRDRPL(PX,PY,NP,
11659CCCCC1IFIG,IPATT,PTHICK,ICOL,
11660CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
11661      CALL DPDRPL(PX,PY,NP,
11662     1IFIG,IPATT,PTHICK,ICOL,
11663     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11664 1420 CONTINUE
11665C
11666 1490 CONTINUE
11667C
11668      GOTO9000
11669C
11670 2000 CONTINUE
11671C
11672C               *****************************************
11673C               **  STEP 20--                          **
11674C               **  DRAW TIC MARKS  FOR TRILINEAR PLOT **
11675C               *****************************************
11676C
11677C  NOTE: FOR NOW, SUPPRESS TIC MARKS FOR TRILINEAR SCALES.
11678C        THE FOLLOWING ISN'T REALLY THE RIGHT WAY TO DO IT.
11679C
11680      GOTO9000
11681C
11682      IF(IX1FSW.EQ.'OFF')GOTO9000
11683      IF(IX1TSW.EQ.'OFF')GOTO9000
11684      IF(NX1COO.LE.0)GOTO9000
11685C
11686      ITYPE='LINE'
11687      IPATT='SOLI'
11688      ICOL=IX1TCO
11689      PTHICK=PTICTH
11690C
11691      IFIG='LINE'
11692C
11693      PMJTLE=PX1TLE
11694      AMIN=0.0
11695      AMAX=FXMAX
11696      GRDINC=(AMAX-AMIN)/REAL(NX1COO-1)
11697      PXRANG=PXMAX - PXMIN
11698      PYRANG=PYMAX - PYMIN
11699C
11700C               *****************************************
11701C               **  STEP 20.A--                        **
11702C               **  DRAW TIC MARKS  FOR X1 AXIS        **
11703C               *****************************************
11704C
11705C
11706      NP2=2
11707      IFLAG='ON'
11708      DO2010I=1,NX1COO
11709        XDUMMY=AMIN + (I-1)*GRDINC
11710        PXSTRT=PXMIN + 0.5*PXRANG*XDUMMY
11711        PYSTRT=PYMIN + PYRANG*XDUMMY
11712        PX(1)=PXSTRT
11713        PY(1)=PYSTRT
11714        PY(2)=PYSTRT
11715C
11716        IF(IX1TJU.EQ.'THRU')THEN
11717          PX(2)=PX(1)+PMJTLE/2.0
11718          PX(1)=PX(1)-PMJTLE/2.0
11719        ELSEIF(IX1TJU.EQ.'IN'.OR.IX1TJU.EQ.'INSI')THEN
11720          PX(2)=PX(1)+PMJTLE
11721          IF(I.EQ.1 .OR. I.EQ.NX1COO)GOTO2010
11722        ELSEIF(IX1TJU.EQ.'OUT'.OR.IX1TJU.EQ.'OUTS')THEN
11723          PX(2)=PX(1)-PMJTLE
11724        ENDIF
11725C
11726        CALL DPDRPL(PX,PY,NP2,
11727     1              IFIG,IPATT,PTHICK,ICOL,
11728     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11729        IFLAG='OFF'
11730 2010 CONTINUE
11731C
11732C               *****************************************
11733C               **  STEP 20.B--                        **
11734C               **  DRAW TIC MARKS  FOR X2 AXIS        **
11735C               *****************************************
11736C
11737C
11738      NP2=2
11739      DO2020I=1,NX1COO
11740        XDUMMY=AMIN + (I-1)*GRDINC
11741        PXSTRT=PXMAX - PXRANG*XDUMMY
11742        PYSTRT=PYMIN
11743        PX(1)=PXSTRT
11744        PY(1)=PYSTRT
11745        PX(2)=PX(1)
11746C
11747        IF(IX1TJU.EQ.'THRU')THEN
11748          PY(2)=PY(1)+PMJTLE/2.0
11749          PY(1)=PY(1)-PMJTLE/2.0
11750        ELSEIF(IX1TJU.EQ.'IN'.OR.IX1TJU.EQ.'INSI')THEN
11751          PY(2)=PY(1)+PMJTLE
11752          IF(I.EQ.1 .OR. I.EQ.NX1COO)GOTO2020
11753        ELSEIF(IX1TJU.EQ.'OUT'.OR.IX1TJU.EQ.'OUTS')THEN
11754          PY(2)=PY(1)-PMJTLE
11755        ENDIF
11756C
11757        CALL DPDRPL(PX,PY,NP2,
11758     1              IFIG,IPATT,PTHICK,ICOL,
11759     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11760 2020 CONTINUE
11761C
11762C               *****************************************
11763C               **  STEP 20.C--                        **
11764C               **  DRAW TIC MARKS  FOR X3 AXIS        **
11765C               *****************************************
11766C
11767      NP2=2
11768      DO2030I=1,NX1COO
11769        XDUMMY=AMIN + (I-1)*GRDINC
11770        PXSTRT=PXMIN + PXRANG*XDUMMY
11771        PXSTRT=PXSTRT + 0.5*PXRANG*(AMAX-XDUMMY)
11772        PYSTRT=PYMIN + PYRANG*(AMAX-XDUMMY)
11773        PX(1)=PXSTRT
11774        PY(1)=PYSTRT
11775        PY(2)=PY(1)
11776C
11777        IF(IX1TJU.EQ.'THRU')THEN
11778          PX(2)=PX(1)-PMJTLE/2.0
11779          PX(1)=PX(1)+PMJTLE/2.0
11780        ELSEIF(IX1TJU.EQ.'IN'.OR.IX1TJU.EQ.'INSI')THEN
11781          PX(2)=PX(1)-PMJTLE
11782          IF(I.EQ.1 .OR. I.EQ.NX1COO)GOTO2030
11783        ELSEIF(IX1TJU.EQ.'OUT'.OR.IX1TJU.EQ.'OUTS')THEN
11784          PX(2)=PX(1)+PMJTLE
11785        ENDIF
11786C
11787        CALL DPDRPL(PX,PY,NP2,
11788     1              IFIG,IPATT,PTHICK,ICOL,
11789     1              JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
11790 2030 CONTINUE
11791      IFLAG='ON'
11792C
11793C
11794C               *****************
11795C               **  STEP 90--  **
11796C               **  EXIT       **
11797C               *****************
11798C
11799 9000 CONTINUE
11800      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRTM')THEN
11801        WRITE(ICOUT,999)
11802        CALL DPWRST('XXX','BUG ')
11803        WRITE(ICOUT,9011)
11804 9011   FORMAT('***** AT THE END       OF DPDRTM--')
11805        CALL DPWRST('XXX','BUG ')
11806        WRITE(ICOUT,9016)IFIG,IPATT,PTICTH,JPATT
11807 9016   FORMAT('IFIG,IPATT,JPATT,PTICTH = ',2(A4,2X),I8,G15.7)
11808        CALL DPWRST('XXX','BUG ')
11809        WRITE(ICOUT,9020)PTHICK,JTHICK,PTHIC2
11810 9020   FORMAT('PTHICK,JTHICK,PTHIC2 = ',G15.7,2X,A4,2X,G15.7)
11811        CALL DPWRST('XXX','BUG ')
11812        WRITE(ICOUT,9021)IERRG4,ITYPE,ICOL,JCOL
11813 9021   FORMAT('IERRG4,ITYPE,ICOL,JCOL = ',3(A4,2X),I8)
11814        CALL DPWRST('XXX','BUG ')
11815      ENDIF
11816C
11817      RETURN
11818      END
11819      SUBROUTINE DPDRTR(Y,X,PY,PX,NP,PY2,PX2,NP2,PY3,PX3,NP3,X3D,
11820     1                  ICASPL,ICAS3D,ISORSW,
11821     1                  ILI2PA,ILI2CO,ILI2TY,PLI2TH,
11822     1                  ARE2BA,ARE3BA,
11823     1                  IRE2FS,IRE2FC,
11824     1                  IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS,IREBPL,
11825     1                  PXMIN,PXMAX,PYMIN,PYMAX,
11826     1                  FX1MIN,FX1MAX,FY1MIN,FY1MAX,
11827     1                  IX1TSC,IY1TSC)
11828C
11829C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
11830C              DRAW A SINGLE TRACE OF Y(.) VERSUS X(.)
11831C              FOR A SPECIFIED LINE TYPE, COLOR, AND THICKNESS.
11832C              AND (IF CALLED FOR) FILL IN BELOW/ABOVE THE TRACE
11833C              TO THE BASE LINE ARE2BA.
11834C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
11835C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
11836C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
11837C           BACK IN THE MAIN ROUTINE.
11838C
11839C     WRITTEN BY--JAMES J. FILLIBEN
11840C                 STATISTICAL ENGINEERING DIVISION
11841C                 INFORMATION TECHNOLOGY LABORATORY
11842C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
11843C                 GAITHERSBURG, MD 20899-8980
11844C                 PHONE--301-975-2855
11845C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
11846C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
11847C     LANGUAGE--ANSI FORTRAN (1977)
11848C     VERSION NUMBER--83.6
11849C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
11850C     UPDATED         --FEBRUARY 1988.   STAR PLOT
11851C     UPDATED         --JUNE     1988.   CALLS TO DPFIRE
11852C     UPDATED         --SEPTEMBER 1988.  LOG/WEIBULL CHECK AS A SUBROUTINE
11853C     UPDATED         --SEPTEMBER 1988.  RENUMBER
11854C     UPDATED         --DECEMBER  1988.  IBUGG4 FOR IBUGPL
11855C     UPDATED         --JUNE      1990.  NORMAL PLOT
11856C     UPDATED         --OCTOBER   1993.  BAR BASE AUTOMATIC
11857C     UPDATED         --OCTOBER   1993.  REGION BASE AUTOMATIC
11858C     UPDATED         --NOVEMBER  1993.  FILL PIE CHART AS "POLYGON"
11859C     UPDATED         --MARCH     1994   REGION BASE POLYGON
11860C     UPDATED         --DECEMBER  1996   FIX NORMAL PLOT
11861C     UPDATED         --DECEMBER  2006   SUPPORT FOR TRILINEAR PLOT
11862C     UPDATED         --JANUARY   2018.  ILI2TY - SPECIFY WHETHER
11863C                                        CHARACTER COORDINATES ARE IN
11864C                                        SCREEN UNITS OR DATA UNITS
11865C
11866C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
11867C
11868      CHARACTER*4 ICASPL
11869      CHARACTER*4 ICAS3D
11870C
11871      CHARACTER*4 ISORSW
11872C
11873      CHARACTER*4 ILI2PA
11874      CHARACTER*4 ILI2CO
11875      CHARACTER*4 ILI2TY
11876C
11877      CHARACTER*4 IRE2FS
11878      CHARACTER*4 IRE2FC
11879      CHARACTER*4 IRE2PT
11880      CHARACTER*4 IRE2PL
11881      CHARACTER*4 IRE2PC
11882      CHARACTER*4 IREBPL
11883C
11884      CHARACTER*4 IX1TSC
11885      CHARACTER*4 IY1TSC
11886C
11887      CHARACTER*4 IFIG
11888      CHARACTER*4 IPATT
11889      CHARACTER*4 ICOL
11890      CHARACTER*4 IPATT2
11891C
11892      CHARACTER*4 ICOLF
11893      CHARACTER*4 ICOLP
11894C
11895      CHARACTER*4 ICASAX
11896C
11897      DIMENSION Y(*)
11898      DIMENSION X(*)
11899      DIMENSION X3D(*)
11900      DIMENSION PY(*)
11901      DIMENSION PX(*)
11902      DIMENSION PY2(*)
11903      DIMENSION PX2(*)
11904      DIMENSION PY3(*)
11905      DIMENSION PX3(*)
11906C
11907C-----COMMON----------------------------------------------------------
11908C
11909      INCLUDE 'DPCOGR.INC'
11910      INCLUDE 'DPCOBE.INC'
11911      INCLUDE 'DPCOP2.INC'
11912C
11913C-----START POINT-----------------------------------------------------
11914C
11915      HOLD=1.0
11916      ABASE=0.0
11917      PBASE=0.0
11918      PBASE2=0.0
11919      PLEFT=0.0
11920      PRIGHT=0.0
11921      AWIDTH=0.0
11922      PWIDTH=0.0
11923      FYRATI=0.0
11924C
11925      FXMIN=FX1MIN
11926      FXMAX=FX1MAX
11927      FYMIN=FY1MIN
11928      FYMAX=FY1MAX
11929C
11930      PXMINS=PXMIN
11931      PXMAXS=PXMAX
11932      PYMINS=PYMIN
11933      PYMAXS=PYMAX
11934C
11935      AHUNDR=100.0
11936      ABASE2=0.0
11937      PBASE9=0.0
11938C
11939      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRTR')THEN
11940        WRITE(ICOUT,999)
11941  999   FORMAT(1X)
11942        CALL DPWRST('XXX','BUG ')
11943        WRITE(ICOUT,51)
11944   51   FORMAT('***** AT THE BEGINNING OF DPDRTR--')
11945        CALL DPWRST('XXX','BUG ')
11946        WRITE(ICOUT,53)ICASPL,ICAS3D,ISORSW,NP,NP3
11947   53   FORMAT('ICASPL,ICAS3D,ISORSW,NP,NP3 = ',3(A4,2X),2I8)
11948        CALL DPWRST('XXX','BUG ')
11949        IF(NP.GE.1)THEN
11950          DO65I=1,NP
11951            WRITE(ICOUT,66)I,X(I),Y(I),X3D(I)
11952   66       FORMAT('I,X(I),Y(I),X3D(I) = ',I8,3G15.7)
11953            CALL DPWRST('XXX','BUG ')
11954   65     CONTINUE
11955        ENDIF
11956        WRITE(ICOUT,68)PX3(1),PY3(1)
11957   68   FORMAT('PX3(1),PY3(1) = ',2G15.7)
11958        CALL DPWRST('XXX','BUG ')
11959        WRITE(ICOUT,71)ILI2PA,ILI2CO,ILI2TY,PLI2TH
11960   71   FORMAT('ILI2PA,ILI2CO,ILI2TY,PLI2TH = ',3(A4,2X),G15.7)
11961        CALL DPWRST('XXX','BUG ')
11962        WRITE(ICOUT,73)IRE2FS,IRE2FC,ARE2BA
11963   73   FORMAT('IRE2FS,IRE2FC,ARE2BA = ',2(A4,2X),G15.7)
11964        CALL DPWRST('XXX','BUG ')
11965        WRITE(ICOUT,74)IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS
11966   74   FORMAT('IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS = ',
11967     1         3(A4,2X),2G15.7)
11968        CALL DPWRST('XXX','BUG ')
11969        WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
11970   84   FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4G15.7)
11971        CALL DPWRST('XXX','BUG ')
11972        WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
11973   85   FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4G15.7)
11974        CALL DPWRST('XXX','BUG ')
11975        WRITE(ICOUT,86)IX1TSC,IY1TSC
11976   86   FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
11977        CALL DPWRST('XXX','BUG ')
11978        WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
11979   89   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
11980        CALL DPWRST('XXX','BUG ')
11981      ENDIF
11982C
11983C               *************************************************
11984C               **  STEP 1--                                   **
11985C               **  IF CALLED FOR, SORT THE DATA               **
11986C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
11987C               *************************************************
11988C
11989      IF(ISORSW.EQ.'OFF'  .OR. ICASPL.EQ.'PIEC' .OR.
11990     1   ICASPL.EQ.'ROSE' .OR. ICASPL.EQ.'STAR' .OR.
11991     1   ICAS3D.EQ.'ON'   .OR. ICASPL.EQ.'CONT' .OR.
11992     1   IREBPL.EQ.'ON'   .OR. ICASPL.EQ.'TRPL')THEN
11993        DO1160I=1,NP
11994          PX(I)=X(I)
11995          PY(I)=Y(I)
11996 1160   CONTINUE
11997      ELSE
11998        CALL SORTC(X,Y,NP,PX,PY)
11999      ENDIF
12000C
12001C               ******************************************************
12002C               **  STEP 21--                                       **
12003C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR, CHECK **
12004C               **  THAT ALL HORIZONTAL AXIS DATA POINTS            **
12005C               **  ARE IN VALID RANGE.                             **
12006C               **  IF A LOG SCALE PLOT IS CALLED FOR, CHECK THAT   **
12007C               **  ALL HORIZONTAL AXIS DATA POINTS ARE > 0.        **
12008C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,          **
12009C               **  CHECK THAT ALL HORIZONTAL AXIS DATA POINTS ARE  **
12010C               **  STRICTLY > 0 AND STRICTLY < 100                 **
12011C               ******************************************************
12012C
12013      IF(IX1TSC.EQ.'LOG')THEN
12014        ICASAX='2DHO'
12015        CALL CKLOSC(PX,NP,ISORSW,ICASAX,ISUBG4,IBUGG4,IERRG4)
12016        IF(IERRG4.EQ.'YES')GOTO9000
12017      ELSEIF(IX1TSC.EQ.'WEIB' .OR. IX1TSC.EQ.'NORM')THEN
12018        ICASAX='2DHO'
12019CCCCC   CALL CKPRSC(PX,NP,ISORSW,ICASAX,ISUBG4,IBUGG4,IERRG4)
12020CCCCC   IF(IERRG4.EQ.'YES')GOTO9000
12021      ENDIF
12022C
12023C               ******************************************************
12024C               **  STEP 22--                                       **
12025C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR, CHECK **
12026C               **  THAT ALL VERTICAL AXIS DATA POINTS              **
12027C               **  ARE IN VALID RANGE.                             **
12028C               **  IF A LOG SCALE PLOT IS CALLED FOR, CHECK THAT   **
12029C               **  ALL VERTICAL AXIS DATA POINTS ARE > 0.          **
12030C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR, CHECK    **
12031C               **  THAT ALL VERTICAL AXIS DATA POINTS ARE          **
12032C               **  STRICTLY > 0 AND STRICTLY < 100                 **
12033C               ******************************************************
12034C
12035      IF(IY1TSC.EQ.'LOG')THEN
12036        ICASAX='2DVE'
12037        CALL CKLOSC(PY,NP,ISORSW,ICASAX,ISUBG4,IBUGG4,IERRG4)
12038        IF(IERRG4.EQ.'YES')GOTO9000
12039      ELSEIF(IY1TSC.EQ.'WEIB' .OR. IY1TSC.EQ.'NORM')THEN
12040        ICASAX='2DVE'
12041CCCCC   CALL CKPRSC(PY,NP,ISORSW,ICASAX,ISUBG4,IBUGG4,IERRG4)
12042CCCCC   IF(IERRG4.EQ.'YES')GOTO9000
12043      ENDIF
12044C
12045C               *************************************************
12046C               **  STEP 4--                                   **
12047C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,  **
12048C               **  TRANSFORM THE DATA                         **
12049C               *************************************************
12050C
12051C               *********************************************
12052C               **  STEP 4.1--                             **
12053C               **  IF A LOG/WEIBULL/NORMAL SCALE PLOT     **
12054C               **  IS CALLED FOR  TRANSFORM THE DATA      **
12055C               *********************************************
12056C
12057      IF(IX1TSC.EQ.'LOG')THEN
12058        DO4115I=1,NP
12059          PX(I)=LOG10(PX(I))
12060 4115   CONTINUE
12061      ELSEIF(IX1TSC.EQ.'WEIB')THEN
12062        DO4215I=1,NP
12063          PX(I)=LOG(LOG(AHUNDR/(AHUNDR-PX(I))))
12064 4215   CONTINUE
12065      ELSEIF(IX1TSC.EQ.'NORM')THEN
12066        DO4315I=1,NP
12067          ARG=PX(I)/AHUNDR
12068          CALL NORPPF(ARG,PX(I))
12069 4315   CONTINUE
12070      ENDIF
12071C
12072C
12073      ABASE=ARE2BA
12074CCCCC OCTOBER 1993.  ADD FOLLOWING
12075      ABAS2=ARE3BA
12076      IF(IY1TSC.EQ.'LOG')THEN
12077        IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0)ABASE=LOG10(ABASE)
12078        IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE=1.0
12079CCCCC OCTOBER 1993.  ADD FOLLOWING
12080        IF(ABAS2.NE.CPUMAX.AND.ABAS2.GT.0.0)ABAS2=LOG10(ABAS2)
12081        IF(ABAS2.NE.CPUMAX.AND.ABAS2.LE.0.0)ABAS2=1.0
12082        DO4165I=1,NP
12083          PY(I)=LOG10(PY(I))
12084 4165   CONTINUE
12085      ELSEIF(IY1TSC.EQ.'WEIB')THEN
12086        IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
12087     1    ABASE2=LOG(LOG(AHUNDR/(AHUNDR-ABASE)))
12088        IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE2=0.1
12089        IF(ABASE.NE.CPUMAX.AND.ABASE.GE.AHUNDR)ABASE2=0.1
12090        ABASE=ABASE2
12091CCCCC OCTOBER 1993.  ADD FOLLOWING
12092        IF(ABAS2.NE.CPUMAX.AND.ABAS2.GT.0.0.AND.ABAS2.LT.AHUNDR)
12093     1    ABASE2=LOG(LOG(AHUNDR/(AHUNDR-ABAS2)))
12094        IF(ABAS2.NE.CPUMAX.AND.ABAS2.LE.0.0)ABASE2=0.1
12095        IF(ABAS2.NE.CPUMAX.AND.ABAS2.GE.AHUNDR)ABASE2=0.1
12096        ABAS2=ABASE2
12097        DO4265I=1,NP
12098          PY(I)=LOG(LOG(AHUNDR/(AHUNDR-PY(I))))
12099 4265   CONTINUE
12100      ELSEIF(IY1TSC.EQ.'NORM')THEN
12101        IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)THEN
12102          ARG=ABASE/AHUNDR
12103          CALL NORPPF(ARG,ABASE2)
12104        ENDIF
12105        IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE2=0.1
12106        IF(ABASE.NE.CPUMAX.AND.ABASE.GE.AHUNDR)ABASE2=0.1
12107        ABASE=ABASE2
12108CCCCC   OCTOBER 1993.  ADD FOLLOWING
12109        IF(ABAS2.NE.CPUMAX.AND.ABAS2.GT.0.0.AND.ABAS2.LT.AHUNDR)THEN
12110          ARG=ABAS2/AHUNDR
12111          CALL NORPPF(ARG,ABASE2)
12112        ENDIF
12113        IF(ABAS2.NE.CPUMAX.AND.ABAS2.LE.0.0)ABASE2=0.1
12114        IF(ABAS2.NE.CPUMAX.AND.ABAS2.GE.AHUNDR)ABASE2=0.1
12115        ABAS2=ABASE2
12116        DO4365I=1,NP
12117          ARG=PY(I)/AHUNDR
12118          CALL NORPPF(ARG,PY(I))
12119 4365   CONTINUE
12120      ENDIF
12121C
12122C               *****************************************************
12123C               **  STEP 5--                                       **
12124C               **  TRANSLATE THE DATA POINTS                      **
12125C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
12126C               *****************************************************
12127C
12128C     2018/01: USER HAS OPTION TO SPECIFY COORDINATES ARE ALREADY
12129C              IN SCREEN UNITS.  NOTE THAT SCREEN UNITS ONLY
12130C              APPLY TO LINEAR SCALES.
12131C
12132      FXMIN=FX1MIN
12133      FXMAX=FX1MAX
12134      IF(IX1TSC.EQ.'LOG'  .OR. IX1TSC.EQ.'WEIB' .OR.
12135     1   IX1TSC.EQ.'NORM')ILI2TY(1:1)='D'
12136      IF(IX1TSC.EQ.'LOG')THEN
12137        FXMIN=LOG10(FX1MIN)
12138        FXMAX=LOG10(FX1MAX)
12139      ELSEIF(IX1TSC.EQ.'WEIB')THEN
12140        FXMIN=LOG(LOG(AHUNDR/(AHUNDR-FX1MIN)))
12141        FXMAX=LOG(LOG(AHUNDR/(AHUNDR-FX1MAX)))
12142      ELSEIF(IX1TSC.EQ.'NORM')THEN
12143         ARG=FX1MIN/AHUNDR
12144         CALL NORPPF(ARG,FXMIN)
12145         ARG=FX1MAX/AHUNDR
12146         CALL NORPPF(ARG,FXMAX)
12147      END IF
12148C
12149      FYMIN=FY1MIN
12150      FYMAX=FY1MAX
12151      IF(IY1TSC.EQ.'LOG'  .OR. IY1TSC.EQ.'WEIB' .OR.
12152     1   IY1TSC.EQ.'NORM')ILI2TY(2:2)='D'
12153      IF(IY1TSC.EQ.'LOG')THEN
12154        FYMIN=LOG10(FY1MIN)
12155        FYMAX=LOG10(FY1MAX)
12156      ELSEIF(IY1TSC.EQ.'WEIB')THEN
12157        FYMIN=LOG(LOG(AHUNDR/(AHUNDR-FY1MIN)))
12158        FYMAX=LOG(LOG(AHUNDR/(AHUNDR-FY1MAX)))
12159      ELSEIF(IY1TSC.EQ.'NORM')THEN
12160         ARG=FY1MIN/AHUNDR
12161         CALL NORPPF(ARG,FYMIN)
12162         ARG=FY1MAX/AHUNDR
12163         CALL NORPPF(ARG,FYMAX)
12164      ENDIF
12165C
12166      FXRANG=FXMAX-FXMIN
12167      FYRANG=FYMAX-FYMIN
12168      PXRANG=PXMAX-PXMIN
12169      PYRANG=PYMAX-PYMIN
12170C
12171      IF(ICASPL.EQ.'TRPL')THEN
12172        AK2=SQRT(2.0)
12173        AK6=SQRT(6.0)
12174        PXHALF=(PXMIN+PXMAX)/2.0
12175        PYTHRD=PYMIN + (PYMAX-PYMIN)/3.0
12176        ASUM=X(1) + Y(1) + X3D(1)
12177        DO5160I=1,NP
12178          X1K=X(I)/ASUM
12179          X2K=Y(I)/ASUM
12180          X3K=X3D(I)/ASUM
12181          AH=(1.0/AK2)*(X3K-X2K)
12182          AV=(1.0/AK6)*(2.0 - 3.0*X2K - 3.0*X3K)
12183          PX(I)=PXHALF + (PXRANG/(2.0/AK2))*AH
12184          PY(I)=PYTHRD + (PYRANG/(3.0/AK6))*AV
12185 5160   CONTINUE
12186      ELSEIF(ILI2TY(1:1).EQ.'S' .OR. ILI2TY(2:2).EQ.'S')THEN
12187C
12188C       FOR SCREEN COORDINATES, CLIP AT (0,100) INSTEAD OF TO
12189C       FRAME COORDINATES
12190C
12191        IF(ILI2TY(1:1).EQ.'S')THEN
12192          DO5120I=1,NP
12193            IF(PX(I).LT.0.0)PX(I)=0.0
12194            IF(PX(I).GT.100.0)PX(I)=100.0
12195 5120     CONTINUE
12196          PXMIN=0.0
12197          PXMAX=100.0
12198        ELSE
12199          DO5123I=1,NP
12200            FXRATI=(PX(I)-FXMIN)/FXRANG
12201            FYRATI=(PY(I)-FYMIN)/FYRANG
12202            PX(I)=PXMIN+FXRATI*PXRANG
12203 5123     CONTINUE
12204          IF(ABASE.NE.CPUMAX)THEN
12205            FYRATI=(ABASE-FYMIN)/FYRANG
12206            PBASE=PYMIN+FYRATI*PYRANG
12207          ENDIF
12208CCCCC     OCTOBER 1993.  ADD FOLLOWING
12209          IF(ABAS2.NE.CPUMAX)THEN
12210            FYRAT2=(ABAS2-FYMIN)/FYRANG
12211            PBASE9=PYMIN+FYRAT2*PYRANG
12212          ENDIF
12213        ENDIF
12214C
12215        IF(ILI2TY(2:2).EQ.'S')THEN
12216          DO5125I=1,NP
12217            IF(PY(I).LT.0.0)PY(I)=0.0
12218            IF(PY(I).GT.100.0)PY(I)=100.0
12219 5125     CONTINUE
12220          PYMIN=0.0
12221          PYMAX=100.0
12222        ELSE
12223          DO5128I=1,NP
12224            FXRATI=(PX(I)-FXMIN)/FXRANG
12225            FYRATI=(PY(I)-FYMIN)/FYRANG
12226            PY(I)=PYMIN+FYRATI*PYRANG
12227 5128     CONTINUE
12228          IF(ABASE.NE.CPUMAX)THEN
12229            FYRATI=(ABASE-FYMIN)/FYRANG
12230            PBASE=PYMIN+FYRATI*PYRANG
12231          ENDIF
12232CCCCC     OCTOBER 1993.  ADD FOLLOWING
12233          IF(ABAS2.NE.CPUMAX)THEN
12234            FYRAT2=(ABAS2-FYMIN)/FYRANG
12235            PBASE9=PYMIN+FYRAT2*PYRANG
12236          ENDIF
12237        ENDIF
12238      ELSE
12239        DO5100I=1,NP
12240          FXRATI=(PX(I)-FXMIN)/FXRANG
12241          FYRATI=(PY(I)-FYMIN)/FYRANG
12242          PX(I)=PXMIN+FXRATI*PXRANG
12243          PY(I)=PYMIN+FYRATI*PYRANG
12244 5100   CONTINUE
12245        IF(ABASE.NE.CPUMAX)THEN
12246          FYRATI=(ABASE-FYMIN)/FYRANG
12247          PBASE=PYMIN+FYRATI*PYRANG
12248        ENDIF
12249CCCCC OCTOBER 1993.  ADD FOLLOWING
12250        IF(ABAS2.NE.CPUMAX)THEN
12251          FYRAT2=(ABAS2-FYMIN)/FYRANG
12252          PBASE9=PYMIN+FYRAT2*PYRANG
12253        ENDIF
12254      ENDIF
12255C
12256C               **************************************
12257C               **  STEP 6--                        **
12258C               **  IF CALLED FOR,                  **
12259C               **  FILL OVER/UNDER THE TRACE       **
12260C               **  (BUT CLIP FIRST, IF NECESSARY)  **
12261C               **************************************
12262C
12263      IF(ICASPL.EQ.'TRPL')GOTO6190
12264C
12265      IFIG='GENE'
12266      IF(ICASPL.EQ.'PIEC')IFIG='POLY'
12267      IF(ICASPL.EQ.'ROSE')IFIG='POLY'
12268CCCCC MARCH 1994.  ADD FOLLOWING LINE
12269      IF(IREBPL.EQ.'ON')IFIG='POLY'
12270C
12271      IF(IRE2FS.EQ.'OFF')GOTO6190
12272      IPATT=IRE2PT
12273      PTHICK=PRE2PT
12274      PXGAP=PRE2PS
12275      PYGAP=PRE2PS
12276      ICOLF=IRE2FC
12277      ICOLP=IRE2PC
12278C
12279      CALL DPSQUE(PX,PY,NP,
12280     1PXMIN,PXMAX,PYMIN,PYMAX)
12281C
12282CCCCC MARCH 1994.  ADD FOLLOWING LINE
12283      IF(IREBPL.EQ.'ON')GOTO6110
12284      IF(ABASE.EQ.CPUMAX)GOTO6110
12285      GOTO6120
12286C
12287 6110 CONTINUE
12288      DO6115I=1,NP
12289      PX2(I)=PX(I)
12290      PY2(I)=PY(I)
12291 6115 CONTINUE
12292      NP2=NP+1
12293      PX2(NP2)=PX(1)
12294      PY2(NP2)=PY(1)
12295C
12296      DO6116J=1,NP2
12297      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
12298      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
12299      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
12300      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
12301 6116 CONTINUE
12302C
12303CCCCC CALL DPFIRE(PX2,PY2,NP2,
12304CCCCC1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP)
12305C JUNE, 1988
12306      IPATT2=IRE2PL
12307      CALL DPFIRE(PX2,PY2,NP2,
12308     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
12309C
12310      GOTO6190
12311C
12312 6120 CONTINUE
12313      PBASE2=PBASE
12314      IF(PBASE2.LT.PYMIN.AND.(PYMIN-PBASE2).LE.0.0001)PBASE2=PYMIN
12315      IF(PBASE2.GT.PYMAX.AND.(PBASE2-PYMAX).LE.0.0001)PBASE2=PYMAX
12316CCCCC OCTOBER 1993.  ADD FOLLOWING
12317      PBASE8=PBASE9
12318      IF(PBASE9.LT.PYMIN.AND.(PYMIN-PBASE9).LE.0.0001)PBASE8=PYMIN
12319      IF(PBASE9.GT.PYMAX.AND.(PBASE9-PYMAX).LE.0.0001)PBASE8=PYMAX
12320CCCCC OCTOBER 1993.
12321      IF(NP.GT.2)GOTO6130
12322C
12323      NP2=5
12324      NPM1=NP-1
12325      IF(NPM1.LE.0)GOTO6190
12326      DO6125I=1,NPM1
12327      IP1=I+1
12328C
12329      PLEFT=PX(I)
12330      PRIGHT=PX(IP1)
12331      IF(PLEFT.LT.PXMIN.AND.(PXMIN-PLEFT).LE.0.0001)PLEFT=PXMIN
12332      IF(PRIGHT.GT.PXMAX.AND.(PRIGHT-PXMAX).LE.0.0001)PRIGHT=PXMAX
12333C
12334      IF(PRIGHT.LT.PXMIN)GOTO6125
12335      IF(PLEFT.GT.PXMAX)GOTO6125
12336      IF(PY(I).LT.PYMIN.AND.PBASE2.LT.PYMIN)GOTO6125
12337      IF(PY(I).GT.PYMAX.AND.PBASE2.GT.PYMAX)GOTO6125
12338C
12339      PX2(1)=PLEFT
12340      PX2(2)=PRIGHT
12341      PX2(3)=PRIGHT
12342      PX2(4)=PLEFT
12343      PX2(5)=PLEFT
12344C
12345      PY2(1)=PBASE2
12346CCCCC OCTOBER 1993.  ADD FOLLOWING
12347CCCCC PY2(2)=PBASE2
12348      PY2(2)=PBASE8
12349CCCCC END CHANGE
12350      PY2(3)=PY(IP1)
12351      PY2(4)=PY(I)
12352      PY2(5)=PBASE2
12353C
12354      DO6126J=1,NP2
12355      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
12356      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
12357      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
12358      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
12359 6126 CONTINUE
12360C
12361CCCCC CALL DPFIRE(PX2,PY2,NP2,
12362CCCCC1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP)
12363CCCCC JUNE, 1988.
12364      IPATT2=IRE2PL
12365      CALL DPFIRE(PX2,PY2,NP2,
12366     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
12367 6125 CONTINUE
12368C
12369      GOTO6190
12370CCCCC OCTOBER 1993.  TREAT REGION AS SINGLE POLYGON
12371 6130 CONTINUE
12372C
12373      DO6135I=1,NP
12374C
12375      PX2(I)=PX(I)
12376      PY2(I)=PY(I)
12377      IF(PX2(I).LT.PXMIN)PX2(I)=PXMIN
12378      IF(PX2(I).GT.PXMAX)PX2(I)=PXMAX
12379      IF(PY2(I).LT.PYMIN)PY2(I)=PYMIN
12380      IF(PY2(I).GT.PYMAX)PY2(I)=PYMAX
12381 6135 CONTINUE
12382C
12383      NP2=NP+1
12384      PX2(NP2)=PX2(NP)
12385      PY2(NP2)=PBASE2
12386      NP2=NP2+1
12387      PX2(NP2)=PX2(1)
12388      PY2(NP2)=PBASE2
12389      NP2=NP2+1
12390      PX2(NP2)=PX2(1)
12391      PY2(NP2)=PY2(1)
12392C
12393      IPATT2=IRE2PL
12394      CALL DPFIRE(PX2,PY2,NP2,
12395     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
12396C
12397      GOTO6190
12398C
12399 6190 CONTINUE
12400C
12401C               *****************************************
12402C               **  STEP 7--                           **
12403C               **  DRAW OUT THE TRACE                 **
12404C               **  (BUT CLIP IT FIRST, IF NECESSARY)  **
12405C               *****************************************
12406C
12407      IFIG='GENE'
12408      IPATT=ILI2PA
12409      PTHICK=PLI2TH
12410      ICOL=ILI2CO
12411C
12412CCCCC CALL DPCLTR(PX,PY,NP,PX2,PY2,NP2,PY3,PX3,NP3,
12413      CALL DPCLTR(PX,PY,NP,PX2,PY2,NP2,
12414     1            PXMIN,PXMAX,PYMIN,PYMAX,
12415     1            ISORSW,
12416     1            IFIG,IPATT,PTHICK,ICOL)
12417C
12418C               *****************
12419C               **  STEP 90--  **
12420C               **  EXIT       **
12421C               *****************
12422C
12423 9000 CONTINUE
12424C
12425      PXMIN=PXMINS
12426      PXMAX=PXMAXS
12427      PYMIN=PYMINS
12428      PYMAX=PYMAXS
12429C
12430      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRTR')THEN
12431        WRITE(ICOUT,999)
12432        CALL DPWRST('XXX','BUG ')
12433        WRITE(ICOUT,9011)
12434 9011   FORMAT('***** AT THE END       OF DPDRTR--')
12435        CALL DPWRST('XXX','BUG ')
12436        WRITE(ICOUT,9012)NP
12437 9012   FORMAT('NP = ',I8)
12438        CALL DPWRST('XXX','BUG ')
12439        WRITE(ICOUT,9013)ICASPL,ICAS3D
12440 9013   FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
12441        CALL DPWRST('XXX','BUG ')
12442        IF(NP.GE.1)THEN
12443          DO9025I=1,NP
12444            WRITE(ICOUT,9026)I,PX(I),PY(I)
12445 9026       FORMAT('I,PX(I),PY(I) = ',I8,2G15.7)
12446            CALL DPWRST('XXX','BUG ')
12447 9025     CONTINUE
12448        ENDIF
12449        WRITE(ICOUT,9030)ISORSW
12450 9030   FORMAT('ISORSW = ',A4)
12451        CALL DPWRST('XXX','BUG ')
12452        WRITE(ICOUT,9031)ILI2PA,ILI2CO,PLI2TH
12453 9031   FORMAT('ILI2PA,ILI2CO,PLI2TH = ',A4,2X,A4,E15.7)
12454        CALL DPWRST('XXX','BUG ')
12455        WRITE(ICOUT,9032)ARE2BA
12456 9032   FORMAT('ARE2BA = ',E15.7)
12457        CALL DPWRST('XXX','BUG ')
12458        WRITE(ICOUT,9033)IRE2FS,IRE2FC
12459 9033   FORMAT('IRE2FS,IRE2FC = ',A4,2X,A4)
12460        CALL DPWRST('XXX','BUG ')
12461        WRITE(ICOUT,9034)IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS
12462 9034   FORMAT('IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS = ',
12463     1         A4,2X,A4,2X,A4,2E15.7)
12464        CALL DPWRST('XXX','BUG ')
12465        WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
12466 9044   FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
12467        CALL DPWRST('XXX','BUG ')
12468        WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
12469 9045   FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
12470        CALL DPWRST('XXX','BUG ')
12471        WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
12472 9046   FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
12473        CALL DPWRST('XXX','BUG ')
12474        WRITE(ICOUT,9047)IX1TSC,IY1TSC
12475 9047   FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
12476        CALL DPWRST('XXX','BUG ')
12477        WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
12478 9049   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
12479        CALL DPWRST('XXX','BUG ')
12480      ENDIF
12481C
12482      RETURN
12483      END
12484      SUBROUTINE DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
12485     1                  AVALUE,IDIGIT,
12486     1                  NTOT,NUMROW,
12487     1                  ICAPSW,ICAPTY,ILAST,IFIRST,
12488     1                  ISUBRO,IBUGA3,IERROR)
12489C
12490C     PURPOSE--THIS ROUTINE PRINTS A TWO-COLUMN TABLE, WHERE THE
12491C              FIRST COLUMN IS TEXT AND THE SECOND COLUMN IS
12492C              NUMERIC, IN HTML/LATEX/RTF/ASCII FORMATS.
12493C
12494C              1) ITITLE CONTAINS AN OVERALL TITLE (TO SKIP,
12495C                 SET NCTITL = 0)
12496C                 AN OPTIONAL SECOND LINE FOR THE TITLE MAY BE
12497C                 GIVEN IN ITITLZ
12498C              2) THE FIRST ROW OF ITEXT CONTAINS A HEADER
12499C                 ROW (SET NCTEXT(1) = 0 TO SKIP)
12500C              3) THE REMAINING ROWS CONTAIN TWO COLUMNS
12501C                 OF DATA - COLUMN 1 IS A TEXT FIELD AND
12502C                 COLUMN 2 IS A NUMERIC FIELD.
12503C
12504C     WRITTEN BY--ALAN HECKERT
12505C                 STATISTICAL ENGINEERING DIVISION
12506C                 INFORMATION TECHNOLOGY LABORATORY
12507C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12508C                 GAITHERSBURG, MD 20899-8980
12509C                 PHONE--301-975-2899
12510C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12511C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12512C     LANGUAGE--ANSI FORTRAN (1977)
12513C     VERSION NUMBER--2009/3
12514C     ORIGINAL VERSION--MARCH     2009.
12515C     UPDATED         --OCTOBER   2009. ADD ITITLZ FOR SECOND LINE
12516C                                       OF TITLE
12517C     UPDATED         --JANUARY   2011. USE DPDTLA TO CHECK FOR
12518C                                       CERTAIN CHARACTERS THAT NEED
12519C                                       TO BE ESCAPED FOR LATEX
12520C     UPDATED         --FEBRUARY  2020. CALL LIST TO DPTAB5
12521C
12522C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12523C
12524      CHARACTER*(*) ITITLE
12525      CHARACTER*(*) ITITLZ
12526      CHARACTER*(*) ITEXT(*)
12527      REAL          AVALUE(*)
12528      INTEGER       IDIGIT(*)
12529      INTEGER       NCTEXT(*)
12530      INTEGER       NTOT(*)
12531C
12532      CHARACTER*4 ICAPSW
12533      CHARACTER*4 ICAPTY
12534      CHARACTER*4 ISUBRO
12535      CHARACTER*4 IBUGA3
12536      CHARACTER*4 IERROR
12537C
12538      CHARACTER*4 ISUBN1
12539      CHARACTER*4 ISUBN2
12540      CHARACTER*4 ISTEPN
12541      CHARACTER*4 ICSVWZ
12542      CHARACTER*1 IBASLC
12543C
12544      LOGICAL IFLAG1
12545      LOGICAL IFLAG2
12546      LOGICAL IFLAG3
12547      LOGICAL ILAST
12548      LOGICAL IFIRST
12549      LOGICAL IBOLD
12550C
12551C---------------------------------------------------------------------
12552C
12553      INCLUDE 'DPCOST.INC'
12554C
12555      PARAMETER (MAXHED=1024)
12556      INTEGER IWIDTH(MAXHED)
12557      INTEGER NUMDIG(MAXHED)
12558      CHARACTER*8 ALIGN(MAXHED)
12559      CHARACTER*8 VALIGN(MAXHED)
12560      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
12561      CHARACTER*132 IVALUE(2)
12562      INTEGER NCTEMP(2)
12563      REAL    AVAL(2)
12564C
12565      INTEGER NTOT2(2)
12566C
12567      CHARACTER*132 IHEAD
12568      CHARACTER*132 ITEMPC
12569C
12570      CHARACTER*4 IRTFMD
12571      COMMON/COMRTF/IRTFMD
12572C
12573C---------------------------------------------------------------------
12574C
12575      INCLUDE 'DPCOP2.INC'
12576C
12577C-----START POINT-----------------------------------------------------
12578C
12579      ISUBN1='DPDT'
12580      ISUBN2='A1  '
12581      IERROR='NO'
12582C
12583      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA1')THEN
12584        WRITE(ICOUT,999)
12585  999   FORMAT(1X)
12586        CALL DPWRST('XXX','WRIT')
12587        WRITE(ICOUT,51)
12588   51   FORMAT('**** AT THE BEGINNING OF DPDTA1--')
12589        CALL DPWRST('XXX','WRIT')
12590        WRITE(ICOUT,52)IBUGA3,ISUBRO,NCTITL,NUMROW
12591   52   FORMAT('IBUGA3,ISUBRO,NCTITL,NUMROW = ',2(A4,2X),2I8)
12592        CALL DPWRST('XXX','WRIT')
12593        IF(NCTITL.GT.0)THEN
12594          NTEMP=MIN(80,NCTITL)
12595          WRITE(ICOUT,54)ITITLE(1:NTEMP)
12596   54     FORMAT('ITITL(1:NCTITL) = ',A80)
12597          CALL DPWRST('XXX','WRIT')
12598        ENDIF
12599        IF(NUMROW.GT.0)THEN
12600          DO56I=1,NUMROW
12601            IF(NCTEXT(I).GT.0)THEN
12602              WRITE(ICOUT,57)I,ITEXT(I)(1:NCTEXT(I))
12603   57         FORMAT('I,ITEXT(I) = ',I8,A80)
12604              CALL DPWRST('XXX','WRIT')
12605            ENDIF
12606   56     CONTINUE
12607          DO66I=1,NUMROW
12608            WRITE(ICOUT,67)I,IDIGIT(I),AVALUE(I)
12609   67       FORMAT('I,IDIGIT(I),AVALUE(I) = ',2I8,G15.7)
12610            CALL DPWRST('XXX','WRIT')
12611   66     CONTINUE
12612        ENDIF
12613      ENDIF
12614C
12615C               *******************************************
12616C               **   STEP 1--                            **
12617C               **   WRITE OUT THE TITLE AND HEADER LINE **
12618C               *******************************************
12619C
12620      ISTEPN='1'
12621      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA1')
12622     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12623C
12624      IF(IPRINT.EQ.'ON')THEN
12625C
12626        CALL DPCONA(92,IBASLC)
12627C
12628        IHEAD=' '
12629        NCHEAD=0
12630        IF(NCTITZ.GT.0)THEN
12631          IHEAD(1:NCTITZ)=ITITLZ(1:NCTITZ)
12632          NCHEAD=NCTITZ
12633        ENDIF
12634        NHEAD=2
12635        IFLAG1=.TRUE.
12636        IFLAG2=.TRUE.
12637C
12638        IVALUE(1)=' '
12639        IVALUE(1)(1:NCTEXT(1))=ITEXT(1)(1:NCTEXT(1))
12640        NCTEMP(1)=NCTEXT(1)
12641        NCTEMP(2)=0
12642        IWIDTH(1)=0
12643        VALIGN(1)=' '
12644        NUMDIG(1)=0
12645        ALIGN(1) =' '
12646        IWIDTH(2)=0
12647        VALIGN(2)=' '
12648        NUMDIG(2)=0
12649        ALIGN(2) =' '
12650C
12651        IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
12652          IF(NCTITZ.GT.0)THEN
12653            ITEMPC(1:NCTITL)=ITITLE(1:NCTITL)
12654            NSTRT=NCTITL+1
12655            ITEMPC(NSTRT:NSTRT+3)='<BR>'
12656            NSTRT=NSTRT+4
12657            NSTRT2=NSTRT+NCTITZ-1
12658            ITEMPC(NSTRT:NSTRT2)=ITITLZ(1:NCTITZ)
12659            NSTRT=NSTRT2
12660            CALL DPHTM1(ITEMPC,NSTRT,IFLAG1,IFLAG2)
12661          ELSE
12662            CALL DPHTM1(ITITLE,NCTITL,IFLAG1,IFLAG2)
12663          ENDIF
12664          IWIDTH(1)=400
12665          VALIGN(1)='BOTTOM'
12666          ALIGN(1) ='LEFT'
12667          IVALUE(2)='&nbsp;'
12668          NCTEMP(2)=6
12669          IWIDTH(2)=150
12670          VALIGN(2)='BOTTOM'
12671          ALIGN(2) ='RIGHT'
12672          IFLAG1=.FALSE.
12673          IFLAG2=.FALSE.
12674          IF(NCTEXT(1).GT.0)THEN
12675            CALL DPHTM4(IVALUE,NCTEMP,NHEAD,IFLAG1,IFLAG2)
12676          ENDIF
12677C
12678        ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
12679          IF(IFIRST)THEN
12680            IFLAG1=.FALSE.
12681            IFLAG2=.FALSE.
12682            IFLAG3=.TRUE.
12683            CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
12684          ENDIF
12685          IFLAG1=.FALSE.
12686          IF(IFIRST)IFLAG1=.TRUE.
12687          IFLAG2=.TRUE.
12688          CALL DPDTLA(ITITLE,NCTITL,NCT,ISUBRO,IBUGA3,IERROR)
12689          NCTITL=NCT
12690          CALL DPLAT1(ITITLE,NCTITL,IHEAD,NCHEAD,IFLAG1)
12691          NHEAD=2
12692          VALIGN(1)='b'
12693          ALIGN(1) ='l'
12694          VALIGN(2)='b'
12695          ALIGN(2) ='r'
12696          IFLAG1=.FALSE.
12697          IFLAG2=.FALSE.
12698          IFLAG3=.TRUE.
12699          CALL DPDTLA(IVALUE(1),NCTEMP(1),NCT,ISUBRO,IBUGA3,IERROR)
12700          NCTEMP(1)=NCT
12701          CALL DPLAT4(IVALUE,NCTEMP,NHEAD,IFLAG1,IFLAG2,IFLAG3)
12702C
12703        ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
12704C
12705 8091     FORMAT(A1,'f',I1)
12706          IF(IRTFFP.EQ.'Times New Roman')THEN
12707            ITEMP=0
12708          ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
12709            ITEMP=6
12710          ELSEIF(IRTFFP.EQ.'Arial')THEN
12711            ITEMP=2
12712          ELSEIF(IRTFFP.EQ.'Bookman')THEN
12713            ITEMP=3
12714          ELSEIF(IRTFFP.EQ.'Georgia')THEN
12715            ITEMP=4
12716          ELSEIF(IRTFFP.EQ.'Tahoma')THEN
12717            ITEMP=5
12718          ELSEIF(IRTFFP.EQ.'Verdana')THEN
12719            ITEMP=7
12720          ELSE
12721            ITEMP=0
12722          ENDIF
12723C
12724          IRTFMD='OFF'
12725C
12726          NCHAR=NCTITL+3
12727          ITEMPC(4:NCHAR)=ITITLE(1:NCTITL)
12728          ITEMPC(1:3)=' b '
12729          ITEMPC(1:1)=IBASLC
12730          IF(NCTITZ.GT.0)THEN
12731            NCHAR2=NCTITZ+3
12732            IHEAD(4:NCHAR2)=ITITLZ(1:NCTITZ)
12733            IHEAD(1:3)=' b '
12734            IHEAD(1:1)=IBASLC
12735          ELSE
12736            NCHAR2=0
12737          ENDIF
12738          CALL DPRTF1(ITEMPC,NCHAR,IHEAD,NCHAR2)
12739C
12740          NCHAR=NCTEXT(1)+3
12741          NTEMP=NCTEXT(1)
12742          IVALUE(1)(4:NCHAR)=ITEXT(1)(1:NTEMP)
12743          IVALUE(1)(1:3)=' b '
12744          IVALUE(1)(1:1)=IBASLC
12745          NCTEMP(1)=NCHAR
12746          IDEFPS=20
12747          IFRST=IRTFPS*5500/IDEFPS
12748          IINC=IRTFPS*1400/IDEFPS
12749          IWIDTH(1)=IFRST
12750          VALIGN(1)='b'
12751          ALIGN(1) ='l'
12752          IWIDTH(2)=IWIDTH(1) + IINC
12753          VALIGN(2)='b'
12754          ALIGN(2) ='r'
12755          IFLAG1=.FALSE.
12756          IFLAG2=.FALSE.
12757          CALL DPRTF4(IVALUE,NCTEMP,NHEAD,IFLAG1,IFLAG2)
12758C
12759        ELSE
12760          IF(NCTITZ.LE.0)THEN
12761            CALL DPTAB1(ITITLE,NCTITL,IHEAD,NCHEAD,IFLAG1)
12762          ELSE
12763            CALL DPTABA(ITITLE,NCTITL,IHEAD,NCHEAD,IFLAG1)
12764          ENDIF
12765          IFLAG1=.FALSE.
12766          IFLAG2=.FALSE.
12767          NMAX=0
12768          CALL DPTAB4(IVALUE,NCTEMP,NHEAD,IFLAG1,IFLAG2,NMAX)
12769C
12770        ENDIF
12771C
12772C               *******************************************
12773C               **   STEP 2--                            **
12774C               **   WRITE OUT THE ROWS                  **
12775C               *******************************************
12776C
12777        ISTEPN='2'
12778        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA1')
12779     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12780C
12781C       COMPUTE MAXIMUM SIZE FOR COLUMN 1
12782C
12783        NTOTMX=40
12784        DO210I=2,NUMROW
12785          NTOTMX=MAX(NTOTMX,NCTEXT(I))
12786 210    CONTINUE
12787C
12788        IF(NUMROW.GE.2)THEN
12789          NHEAD=1
12790          DO200I=2,NUMROW
12791C
12792            IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA1')THEN
12793              WRITE(ICOUT,999)
12794              CALL DPWRST('XXX','WRIT')
12795              WRITE(ICOUT,251)
12796  251         FORMAT('**** DPDTA1--WRITING ROWS OF TABLE')
12797              CALL DPWRST('XXX','WRIT')
12798              WRITE(ICOUT,252)I,IDIGIT(I),AVALUE(I),NCTEXT(I)
12799  252         FORMAT('I,IDIGIT(I),AVALUE(I),NCTEXT(I),',2I5,G15.7,I5)
12800              CALL DPWRST('XXX','WRIT')
12801              NTEMP=NCTEXT(I)
12802              WRITE(ICOUT,253)ITEXT(I)(1:NTEMP)
12803  253         FORMAT('ITEXT(I) = ',A80)
12804              CALL DPWRST('XXX','WRIT')
12805            ENDIF
12806C
12807            IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
12808              IBOLD=.FALSE.
12809              IWIDTH(1)=300
12810              VALIGN(1)='BOTTOM'
12811              ALIGN(1) ='LEFT'
12812              NUMDIG(1)=IDIGIT(I)
12813              IWIDTH(2)=150
12814              VALIGN(2)='BOTTOM'
12815              ALIGN(2) ='RIGHT'
12816              IFLAG1=.FALSE.
12817              IFLAG2=.FALSE.
12818              CALL DPHTM5(ITEXT(I),NCTEXT(I),AVALUE(I),NHEAD,IBOLD)
12819C
12820            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
12821              IFLAG1=.FALSE.
12822              NUMDIG(1)=IDIGIT(I)
12823              NUMDIG(2)=IDIGIT(I)
12824              CALL DPDTLA(ITEXT(I),NCTEXT(I),NCT,ISUBRO,IBUGA3,IERROR)
12825              NCTEXT(I)=NCT
12826              CALL DPLAT5(ITEXT(I),NCTEXT(I),AVALUE(I),NHEAD,
12827     1                    IFLAG1)
12828            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
12829              IFLAG1=.FALSE.
12830              VALIGN(1)='b'
12831              ALIGN(1) ='l'
12832              NUMDIG(1)=-1
12833              VALIGN(2)='b'
12834              ALIGN(2) ='r'
12835              NUMDIG(2)=IDIGIT(I)
12836              AVAL(1)=0.0
12837              AVAL(2)=AVALUE(I)
12838              NCHAR=NCTEXT(I)+3
12839              NTEMP=NCTEXT(I)
12840              ITEMPC(4:NCHAR)=ITEXT(I)(1:NTEMP)
12841              ITEMPC(1:3)=' b '
12842              ITEMPC(1:1)=IBASLC
12843              CALL DPRTF5(ITEMPC,NCHAR,AVAL,NHEAD,IFLAG1)
12844            ELSE
12845              IFLAG1=.FALSE.
12846              VALIGN(1)='b'
12847              ALIGN(1) ='l'
12848              VALIGN(2)='b'
12849              ALIGN(2) ='r'
12850              NMAX=0
12851              NUMDIG(1)=IDIGIT(I)
12852              NTOT2(1)=NTOTMX
12853              NTOT2(2)=NTOT(I)
12854              ICSVWZ='OFF'
12855              IVALT=-99
12856              CALL DPTAB5(ITEXT(I),NCTEXT(I),AVALUE(I),NHEAD,
12857     1                    IFLAG1,NMAX,NTOT2,ICSVWZ)
12858            ENDIF
12859  200     CONTINUE
12860        ENDIF
12861C
12862C               *******************************************
12863C               **   STEP 3--                            **
12864C               **   TERMINATE THE TABLE                 **
12865C               *******************************************
12866C
12867        ISTEPN='2'
12868        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA1')
12869     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12870C
12871        IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
12872          IFLAG1=.TRUE.
12873          IFLAG2=.TRUE.
12874          IFLAG2=.FALSE.
12875          IF(ILAST)IFLAG2=.TRUE.
12876          CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
12877        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
12878          IFLAG1=.TRUE.
12879          IFLAG2=.FALSE.
12880          IFLAG3=.FALSE.
12881          IF(ILAST)THEN
12882            IFLAG2=.TRUE.
12883            IFLAG3=.TRUE.
12884          ENDIF
12885          CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
12886        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
12887          IF(IRTFFF.EQ.'Courier New')THEN
12888            ITEMP=1
12889          ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
12890            ITEMP=8
12891          ENDIF
12892          WRITE(ICOUT,8091)IBASLC,ITEMP
12893          CALL DPWRST(ICOUT,'WRIT')
12894          CALL DPRTF6(NHEAD)
12895          CALL DPRTF6(NHEAD)
12896          IF(ILAST)THEN
12897            IRTFMD='VERB'
12898          ENDIF
12899        ELSE
12900          IF(ILAST)THEN
12901            WRITE(ICOUT,999)
12902            CALL DPWRST('XXX','WRIT')
12903          ENDIF
12904        ENDIF
12905C
12906      ENDIF
12907C
12908      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA1')THEN
12909        WRITE(ICOUT,999)
12910        CALL DPWRST('XXX','WRIT')
12911        WRITE(ICOUT,9011)
12912 9011   FORMAT('**** AT THE END OF DPDTA1--')
12913        CALL DPWRST('XXX','WRIT')
12914      ENDIF
12915C
12916      RETURN
12917      END
12918      SUBROUTINE DPDTA2(ITITL9,NCTIT9,
12919     1                  IHEAD,NCHEAD,ITITLE,NCTITL,
12920     1                  MAXLIN,NUMLIN,MAXCOL,NUMCOL,
12921     1                  ITEXT,NCTEXT,AVAL,MAXROW,NUMROW,
12922     1                  IDIGIT,NTOT,IWHTML,IWRTF,VALIGZ,ALIGNZ,NMAX,
12923     1                  ICAPSW,ICAPTY,IFIRST,ILAST,
12924     1                  ISUBRO,IBUGA3,IERROR)
12925C
12926C     PURPOSE--THIS ROUTINE PRINTS A MULTI-COLUMN TABLE CONSISTING OF:
12927C
12928C              1) AN OPTIONAL OVERALL TITLE
12929C              2) HEADERS FOR EACH OF THE COLUMNS (THESE HEADERS MAY
12930C                 CONTAIN MULTIPLE LINES).
12931C              3) A TABLE OF NUMERIC VALUES.  IT MAY ALSO OPTIONALLY
12932C                 CONTAIN A CHARACTER FIELD FOR COLUMN ONE.
12933C
12934C              ITITL9     => THE OVERALL TITLE
12935C              IHEAD      => TABLE CAPTION
12936C              ITITLE     => LINES FOR THE COLUMN HEADERS
12937C              ITEXT      => CHARACTER ARRAY FOR COLUMN 1
12938C              AVAL       => MATRIX OF NUMERIC VALUES FOR THE TABLE
12939C
12940C     WRITTEN BY--ALAN HECKERT
12941C                 STATISTICAL ENGINEERING DIVISION
12942C                 INFORMATION TECHNOLOGY LABORATORY
12943C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12944C                 GAITHERSBURG, MD 20899-8980
12945C                 PHONE--301-975-2899
12946C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12947C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12948C     LANGUAGE--ANSI FORTRAN (1977)
12949C     VERSION NUMBER--2009/3
12950C     ORIGINAL VERSION--MARCH     2009.
12951C     UPDATED         --APRIL     2009. ADD THE OPTIONAL OVERALL TITLE
12952C     UPDATED         --APRIL     2009. FOR LATEX, CHECK FOR "%" AND
12953C                                       REPLACE WITH "\%"
12954C     UPDATED         --APRIL     2009. IF NUMERIC VALUE IS EQUAL TO
12955C                                       CPUMIN, SET DIGITS TO -99 AND
12956C                                       (THIS WILL THEN BE PRINTED
12957C                                       AS "**")
12958C     UPDATED         --APRIL     2009. ALLOW CALLING ROUTINE TO
12959C                                       SPECIFY THE POINT SIZE FOR
12960C                                       RTF
12961C     UPDATED         --JANUARY   2011. USE DPDTLA TO CHECK FOR
12962C                                       CERTAIN CHARACTERS THAT NEED
12963C                                       TO BE ESCAPED FOR LATEX
12964C     UPDATED         --FEBRUARY  2020. CALL LIST TO DPTAB5
12965C
12966C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
12967C
12968      CHARACTER*(*) IHEAD
12969      CHARACTER*(*) ITITL9
12970      CHARACTER*(*) ITITLE(MAXLIN,MAXCOL)
12971      CHARACTER*(*) ITEXT(MAXROW)
12972      CHARACTER*4   VALIGZ(*)
12973      CHARACTER*4   ALIGNZ(*)
12974      INTEGER       NCTITL(MAXLIN,MAXCOL)
12975      INTEGER       NCTEXT(MAXROW)
12976      INTEGER       IDIGIT(*)
12977      INTEGER       NTOT(*)
12978      INTEGER       IWHTML(*)
12979      INTEGER       IWRTF(*)
12980      REAL          AVAL(MAXROW,MAXCOL)
12981C
12982      CHARACTER*4 ICAPSW
12983      CHARACTER*4 ICAPTY
12984      CHARACTER*4 ISUBRO
12985      CHARACTER*4 IBUGA3
12986      CHARACTER*4 IERROR
12987C
12988      CHARACTER*4 ISUBN1
12989      CHARACTER*4 ISUBN2
12990      CHARACTER*4 ISTEPN
12991      CHARACTER*4 ICSVWZ
12992      CHARACTER*1 IBASLC
12993C
12994      LOGICAL IFLAG1
12995      LOGICAL IFLAG2
12996      LOGICAL IFLAG3
12997      LOGICAL IBOLD
12998      LOGICAL IFIRST
12999      LOGICAL ILAST
13000C
13001C---------------------------------------------------------------------
13002C
13003      INCLUDE 'DPCOST.INC'
13004C
13005      PARAMETER (MAXHED=1024)
13006      INTEGER IWIDTH(MAXHED)
13007      INTEGER NUMDIG(MAXHED)
13008      CHARACTER*8 ALIGN(MAXHED)
13009      CHARACTER*8 VALIGN(MAXHED)
13010      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
13011      CHARACTER*60 IVALUE(MAXHED)
13012      INTEGER      NCTEMP(MAXHED)
13013      REAL         AVALUE(MAXHED)
13014C
13015      CHARACTER*132 ITEMPC
13016C
13017      CHARACTER*4 IRTFMD
13018      COMMON/COMRTF/IRTFMD
13019C
13020C---------------------------------------------------------------------
13021C
13022      INCLUDE 'DPCOP2.INC'
13023C
13024C-----START POINT-----------------------------------------------------
13025C
13026      ISUBN1='DPDT'
13027      ISUBN2='A2  '
13028      IERROR='NO'
13029C
13030      DO40I=1,MAXHED
13031        IVAlUE(I)=' '
13032        AVALUE(I)=0.0
13033        NCTEMP(I)=0
13034   40 CONTINUE
13035C
13036      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA2')THEN
13037        WRITE(ICOUT,999)
13038  999   FORMAT(1X)
13039        CALL DPWRST('XXX','WRIT')
13040        WRITE(ICOUT,51)
13041   51   FORMAT('**** AT THE BEGINNING OF DPDTA2--')
13042        CALL DPWRST('XXX','WRIT')
13043        WRITE(ICOUT,52)IBUGA3,ISUBRO
13044   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
13045        CALL DPWRST('XXX','WRIT')
13046        WRITE(ICOUT,53)MAXLIN,NUMLIN,MAXCOL,NUMCOL,MAXROW,NUMROW
13047   53   FORMAT('MAXLIN,NUMLIN,MAXCOL,NUMCOL,MAXROW,NUMROW = ',6I8)
13048        CALL DPWRST('XXX','WRIT')
13049        IF(NUMLIN.GT.0)THEN
13050          DO54I=1,NUMLIN
13051            DO55J=1,NUMCOL
13052              IF(I.EQ.1)THEN
13053                WRITE(ICOUT,58)J,NTOT(J),IDIGIT(J)
13054   58           FORMAT('J,NTOT(J),IDIGIT(J) = ',3I8)
13055                CALL DPWRST('XXX','WRIT')
13056              ENDIF
13057              IF(NCTITL(I,J).GT.0)THEN
13058                NTEMP=MIN(80,NCTITL(I,J))
13059                WRITE(ICOUT,56)I,J,NCTITL(I,J),ITITLE(I,J)(1:NTEMP)
13060   56           FORMAT('I,J,NCTITL(I,J),ITITL(I,J)(1:NCTITL) = ',
13061     1                 3I5,2X,A80)
13062                CALL DPWRST('XXX','WRIT')
13063              ENDIF
13064   55       CONTINUE
13065   54     CONTINUE
13066        ENDIF
13067        IF(NUMROW.GT.0)THEN
13068          DO57I=1,NUMROW
13069            IF(NCTEXT(I).GT.0)THEN
13070              WRITE(ICOUT,59)I,ITEXT(I)(1:NCTEXT(I))
13071   59         FORMAT('I,ITEXT(I) = ',I8,A80)
13072              CALL DPWRST('XXX','WRIT')
13073            ENDIF
13074            WRITE(ICOUT,60)I,(AVAL(I,J),J=1,MIN(5,NUMCOL))
13075   60       FORMAT('I,(AVAL(I,J),J=1,NUMCOL) = ',I8,5G15.7)
13076            CALL DPWRST('XXX','WRIT')
13077   57     CONTINUE
13078        ENDIF
13079        WRITE(ICOUT,62)NCHEAD
13080   62   FORMAT('NCHEAD = ',I5)
13081        CALL DPWRST('XXX','WRIT')
13082        IF(NCHEAD.GT.0)THEN
13083          WRITE(ICOUT,63)IHEAD(1:NCHEAD)
13084   63     FORMAT('NCHEAD,IHEAD = ',A80)
13085          CALL DPWRST('XXX','WRIT')
13086        ENDIF
13087      ENDIF
13088C
13089C               ******************************************
13090C               **   STEP 1--                           **
13091C               **   WRITE OUT THE TABLE HEADER.        **
13092C               **   NOTE THAT THIS MAY CONSIST OF      **
13093C               **   MULTIPLE LINES.                    **
13094C               ******************************************
13095C
13096      ISTEPN='1'
13097      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA2')
13098     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13099C
13100      IF(IPRINT.EQ.'ON')THEN
13101C
13102        CALL DPCONA(92,IBASLC)
13103C
13104        NHEAD=NUMCOL
13105        IF(NCTEXT(1).GT.0)NHEAD=NUMCOL+1
13106C
13107        DO100I=1,NHEAD
13108          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
13109            IWIDTH(I)=IWHTML(I)
13110            IF(VALIGZ(I).EQ.'b')THEN
13111              VALIGN(I)='BOTTOM'
13112            ELSEIF(VALIGZ(I).EQ.'c')THEN
13113              VALIGN(I)='CENTER'
13114            ELSEIF(VALIGZ(I).EQ.'t')THEN
13115              VALIGN(I)='TOP'
13116            ENDIF
13117            IF(ALIGNZ(I).EQ.'l')THEN
13118              ALIGN(I) ='LEFT'
13119            ELSEIF(ALIGNZ(I).EQ.'c')THEN
13120              ALIGN(I) ='CENTER'
13121            ELSEIF(ALIGNZ(I).EQ.'r')THEN
13122              ALIGN(I) ='RIGHT'
13123            ENDIF
13124C
13125          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
13126            IF(VALIGZ(I).EQ.'b')THEN
13127              VALIGN(I)='b'
13128            ELSEIF(VALIGZ(I).EQ.'c')THEN
13129              VALIGN(I)='c'
13130            ELSEIF(VALIGZ(I).EQ.'t')THEN
13131              VALIGN(I)='t'
13132            ENDIF
13133            IF(ALIGNZ(I).EQ.'l')THEN
13134              ALIGN(I) ='l'
13135            ELSEIF(ALIGNZ(I).EQ.'c')THEN
13136              ALIGN(I) ='c'
13137            ELSEIF(ALIGNZ(I).EQ.'r')THEN
13138              ALIGN(I) ='r'
13139            ENDIF
13140          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
13141            IWIDTH(I)=IWRTF(I)
13142            IF(VALIGZ(I).EQ.'b')THEN
13143              VALIGN(I)='b'
13144            ELSEIF(VALIGZ(I).EQ.'c')THEN
13145              VALIGN(I)='c'
13146            ELSEIF(VALIGZ(I).EQ.'t')THEN
13147              VALIGN(I)='t'
13148            ENDIF
13149            IF(ALIGNZ(I).EQ.'l')THEN
13150              ALIGN(I) ='l'
13151            ELSEIF(ALIGNZ(I).EQ.'c')THEN
13152              ALIGN(I) ='c'
13153            ELSEIF(ALIGNZ(I).EQ.'r')THEN
13154              ALIGN(I) ='r'
13155            ENDIF
13156          ELSE
13157            IF(VALIGZ(I).EQ.'b')THEN
13158              VALIGN(I)='b'
13159            ELSEIF(VALIGZ(I).EQ.'c')THEN
13160              VALIGN(I)='c'
13161            ELSEIF(VALIGZ(I).EQ.'t')THEN
13162              VALIGN(I)='t'
13163            ENDIF
13164            IF(ALIGNZ(I).EQ.'l')THEN
13165              ALIGN(I) ='l'
13166            ELSEIF(ALIGNZ(I).EQ.'c')THEN
13167              ALIGN(I) ='c'
13168            ELSEIF(ALIGNZ(I).EQ.'r')THEN
13169              ALIGN(I) ='r'
13170            ENDIF
13171          ENDIF
13172  100   CONTINUE
13173C
13174C       LOOP THROUGH THE LINES OF THE HEADER
13175C
13176        IF(NUMLIN.GE.1)THEN
13177          DO110I=1,NUMLIN
13178C
13179            DO120J=1,NHEAD
13180              IVALUE(J)=' '
13181              NCTEMP(J)=0
13182              IF(NCTITL(I,J).GT.0)THEN
13183                NCTEMP(J)=NCTITL(I,J)
13184                IVALUE(J)(1:NCTEMP(J))=ITITLE(I,J)(1:NCTEMP(J))
13185              ENDIF
13186C
13187              IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA2')THEN
13188                WRITE(ICOUT,106)I,J,NCTEMP(J),IVALUE(J)
13189  106           FORMAT('I,J,NCTEMP(J),IVALUE(J) = ',3I8,A80)
13190                CALL DPWRST('XXX','WRIT')
13191              ENDIF
13192C
13193  120       CONTINUE
13194C
13195            IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
13196              IF(I.EQ.1)THEN
13197                IFLAG1=.FALSE.
13198                IF(IFIRST)IFLAG1=.TRUE.
13199                IFLAG2=.TRUE.
13200                IF(NCTIT9.LE.0)THEN
13201                  IF(IFIRST)THEN
13202                    CALL DPHTM1(IHEAD,NCHEAD,IFLAG1,IFLAG2)
13203                  ELSE
13204                    CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,
13205     1                          IFLAG1,IFLAG2)
13206                  ENDIF
13207                ELSE
13208                  CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1,IFLAG2)
13209                ENDIF
13210              ENDIF
13211              IFLAG1=.FALSE.
13212              IFLAG2=.FALSE.
13213              IF(I.EQ.1)IFLAG1=.TRUE.
13214              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
13215              CALL DPHTM4(IVALUE,NCTEMP,NHEAD,IFLAG1,IFLAG2)
13216C
13217            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
13218C
13219              IF(I.EQ.1)THEN
13220                IF(IFIRST)THEN
13221                  IFLAG1=.FALSE.
13222                  IFLAG2=.FALSE.
13223                  IFLAG3=.TRUE.
13224                  CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
13225                ENDIF
13226                IFLAG1=.FALSE.
13227                IF(IFIRST)IFLAG1=.TRUE.
13228                IFLAG2=.TRUE.
13229C
13230                CALL DPDTLA(IHEAD,NCHEAD,NCT,ISUBRO,IBUGA3,IERROR)
13231                NCHEAD=NCT
13232C
13233                IF(NCTIT9.LE.0)THEN
13234                  ITEMPC=' '
13235                  NCHEA2=0
13236                  CALL DPLAT1(IHEAD,NCHEAD,ITEMPC,NCHEA2,IFLAG1)
13237                ELSE
13238C
13239                  CALL DPDTLA(ITITL9,NCTIT9,NCT,ISUBRO,IBUGA3,IERROR)
13240                  NCTIT9=NCT
13241C
13242                  CALL DPLAT1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
13243                ENDIF
13244              ENDIF
13245              IFLAG1=.FALSE.
13246              IFLAG2=.FALSE.
13247              IFLAG3=.FALSE.
13248              IF(I.EQ.1)IFLAG1=.TRUE.
13249              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
13250              IF(I.EQ.1)IFLAG3=.TRUE.
13251C
13252              DO6110JJ=1,NHEAD
13253                NCT=NCTEMP(JJ)
13254                DO6130II=NCTEMP(JJ),1,-1
13255                  IF(IVALUE(JJ)(II:II).EQ.'%')THEN
13256                    DO6140J=NCT,II,-1
13257                      IVALUE(JJ)(J+1:J+1)=IVALUE(JJ)(J:J)
13258 6140               CONTINUE
13259                    NCT=NCT+1
13260                    IVALUE(JJ)(II:II)=IBASLC
13261                  ENDIF
13262 6130           CONTINUE
13263                NCTEMP(JJ)=NCT
13264 6110         CONTINUE
13265C
13266              CALL DPLAT4(IVALUE,NCTEMP,NHEAD,IFLAG1,IFLAG2,IFLAG3)
13267C
13268            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
13269C
13270 8091         FORMAT(A1,'f',I1)
13271              IF(I.EQ.1)THEN
13272                IF(IRTFFP.EQ.'Times New Roman')THEN
13273                  ITEMP=0
13274                ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
13275                  ITEMP=6
13276                ELSEIF(IRTFFP.EQ.'Arial')THEN
13277                  ITEMP=2
13278                ELSEIF(IRTFFP.EQ.'Bookman')THEN
13279                  ITEMP=3
13280                ELSEIF(IRTFFP.EQ.'Georgia')THEN
13281                  ITEMP=4
13282                ELSEIF(IRTFFP.EQ.'Tahoma')THEN
13283                  ITEMP=5
13284                ELSEIF(IRTFFP.EQ.'Verdana')THEN
13285                  ITEMP=7
13286                ELSE
13287                  ITEMP=0
13288                ENDIF
13289C
13290                IRTFMD='OFF'
13291C
13292                IF(NCHEAD.GE.1.AND.I.EQ.1)THEN
13293                  NCTEM2=NCHEAD+3
13294                  IHEAD(4:NCTEM2)=IHEAD(1:NCHEAD)
13295                  IHEAD(1:3)=' b '
13296                  IHEAD(1:1)=IBASLC
13297                  IF(NCTIT9.LE.0)THEN
13298                    ITEMPC=' '
13299                    NCHEA2=0
13300                  ELSE
13301                    NCHEA2=NCTIT9+3
13302                    ITEMPC(4:NCHEA2)=ITITL9(1:NCTIT9)
13303                    ITEMPC(1:3)=' b '
13304                    ITEMPC(1:1)=IBASLC
13305                  ENDIF
13306                  CALL DPRTF1(ITEMPC,NCHEA2,IHEAD,NCTEM2)
13307                ENDIF
13308              ENDIF
13309C
13310              DO130J=1,NHEAD
13311                NCHAR=NCTEMP(J)+3
13312                IVALUE(J)(4:NCHAR)=IVALUE(J)(1:NCTEMP(J))
13313                IVALUE(J)(1:3)=' b '
13314                IVALUE(J)(1:1)=IBASLC
13315                NCTEMP(J)=NCHAR
13316  130         CONTINUE
13317              IFLAG1=.FALSE.
13318              IFLAG2=.FALSE.
13319              IF(I.EQ.1)IFLAG1=.TRUE.
13320              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
13321              CALL DPRTF4(IVALUE,NCTEMP,NHEAD,IFLAG1,IFLAG2)
13322            ELSE
13323              IF(I.EQ.1)THEN
13324                IFLAG1=.TRUE.
13325                CALL DPTAB1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
13326              ENDIF
13327              IFLAG1=.FALSE.
13328              IFLAG2=.FALSE.
13329              IF(I.EQ.1)IFLAG1=.TRUE.
13330              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
13331C
13332              DO 141 KK=1,NHEAD
13333                IF(ALIGN(KK).EQ.'l' .AND. NCTEMP(KK).LT.NTOT(KK))THEN
13334                  DO146JJ=NCTEMP(KK)+1,NTOT(KK)
13335                    IVALUE(KK)(JJ:JJ)=' '
13336  146             CONTINUE
13337                  NCTEMP(KK)=NTOT(KK)
13338                ELSEIF(ALIGN(KK).EQ.'c'.AND.NCTEMP(KK).LT.NTOT(KK))THEN
13339                  IVALUE(KK)(NCTEMP(KK)+1:NTOT(KK))=' '
13340                  IDIFF=(NTOT(KK)-NCTEMP(KK))/2
13341                  IF(IDIFF.GT.0)THEN
13342                    ISTRT=IDIFF+1
13343                    IF(MOD(NTOT(KK)-NCTEMP(KK),2).EQ.1)IDIFF=IDIFF-1
13344                    DO147JJ=NTOT(KK),IDIFF+1,-1
13345                      IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
13346  147               CONTINUE
13347                    IVALUE(KK)(1:IDIFF)=' '
13348                  ENDIF
13349                  NCTEMP(KK)=NTOT(KK)
13350                ELSEIF(ALIGN(KK).EQ.'r'.AND.NCTEMP(KK).LT.NTOT(KK))THEN
13351C
13352                  IF(ISUBRO.EQ.'DTA2' .OR. IBUGA3.EQ.'ON')THEN
13353                    WRITE(ICOUT,157)KK,NCTEMP(KK),NTOT(KK)
13354  157               FORMAT('BEFORE 148: KK,NCTEMP(KK),NTOT(KK) =',
13355     1                     3I8)
13356                    CALL DPWRST('XXX','WRIT')
13357                    WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
13358                    CALL DPWRST('XXX','WRIT')
13359                  ENDIF
13360C
13361                  IDIFF=NTOT(KK)-NCTEMP(KK)
13362                  DO148JJ=NTOT(KK),IDIFF+1,-1
13363                    IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
13364  148             CONTINUE
13365                  IVALUE(KK)(1:IDIFF)=' '
13366                  NCTEMP(KK)=NTOT(KK)
13367                ENDIF
13368C
13369                IF(ISUBRO.EQ.'DTA2' .OR. IBUGA3.EQ.'ON')THEN
13370                  WRITE(ICOUT,151)KK,IDIFF,NCTEMP(KK),NUMCOL,NMAX
13371  151             FORMAT('BEFORE CALL DPTAB4: KK,IDIFF,NCTEMP(KK),',
13372     1                   'NUMCOL,NMAX=',5I8)
13373                  CALL DPWRST('XXX','WRIT')
13374                  WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
13375  153             FORMAT('IVALUE(KK) = ',A80)
13376                  CALL DPWRST('XXX','WRIT')
13377                ENDIF
13378C
13379  141         CONTINUE
13380C
13381              CALL DPTAB4(IVALUE,NCTEMP,NHEAD,IFLAG1,IFLAG2,NMAX)
13382C
13383            ENDIF
13384  110     CONTINUE
13385        ENDIF
13386C
13387C               ******************************************
13388C               **   STEP 2--                           **
13389C               **   WRITE OUT THE TABLE ROWS           **
13390C               ******************************************
13391C
13392        MAXLTA=35
13393        ILINE=0
13394        IF(NUMROW.GE.1)THEN
13395          DO200I=1,NUMROW
13396C
13397            IFLAG1=.FALSE.
13398            IF(I.EQ.NUMROW)IFLAG1=.TRUE.
13399            ISTRT=0
13400CCCCC       IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')ISTRT=1
13401            IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF'.AND.
13402     1        NCTEXT(I).GT.0)ISTRT=1
13403            DO210J=1,NUMCOL
13404              AVALUE(ISTRT+J)=AVAL(I,J)
13405              IF(AVALUE(ISTRT+J).EQ.CPUMIN)THEN
13406                NUMDIG(ISTRT+J)=-99
13407              ELSE
13408                NUMDIG(ISTRT+J)=IDIGIT(J)
13409              ENDIF
13410  210       CONTINUE
13411C
13412C           FOR HTML, SHIFT DEPENDING ON WHETHER HEADER COLUMN
13413C           IS GIVEN.
13414C
13415            IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
13416              IBOLD=.FALSE.
13417              IF(I.EQ.1)THEN
13418                IF(NCTEXT(1).GT.0)THEN
13419                  DO211J=1,NUMCOL
13420                    ALIGN(J)=ALIGN(J)
13421                    VALIGN(J)=VALIGN(J)
13422                    IWIDTH(J)=IWIDTH(J)
13423  211             CONTINUE
13424                ELSE
13425                  DO212J=NUMCOL+1,2,-1
13426                    ALIGN(J)=ALIGN(J-1)
13427                    VALIGN(J)=VALIGN(J-1)
13428                    IWIDTH(J)=IWIDTH(J-1)
13429  212             CONTINUE
13430                ENDIF
13431              ENDIF
13432              CALL DPHTM5(ITEXT(I),NCTEXT(I),AVALUE,NUMCOL,IBOLD)
13433C
13434C           FOR LATEX, WE CANNOT EXTEND TABLES BEYOND A SINGLE
13435C           PAGE, SO PUT A CHECK IN.
13436C
13437            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
13438              CALL DPDTLA(ITEXT(I),NCTEXT(I),NCT,ISUBRO,IBUGA3,IERROR)
13439              NCTEXT(I)=NCT
13440              CALL DPLAT5(ITEXT(I),NCTEXT(I),AVALUE,NUMCOL,IFLAG1)
13441              ILINE=ILINE+1
13442              IF(ILINE.EQ.MAXLTA .AND. I.NE.NUMROW)THEN
13443                ILINE=0
13444                IFLAG1=.TRUE.
13445                IFLAG2=.FALSE.
13446                IFLAG3=.TRUE.
13447                CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
13448                IFLAG1=.FALSE.
13449                IFLAG2=.FALSE.
13450                IFLAG3=.TRUE.
13451                CALL DPLATY(NHEAD)
13452              ENDIF
13453            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
13454              IF(NCTEXT(I).GT.0)THEN
13455                NCHAR=NCTEXT(I)+3
13456                ITEXT(I)(4:NCHAR)=ITEXT(I)(1:NCTEXT(I))
13457                ITEXT(I)(1:3)=' b '
13458                ITEXT(I)(1:1)=IBASLC
13459                NCTEXT(I)=NCHAR
13460              ELSE
13461                NCHAR=0
13462              ENDIF
13463              IFLAG1=.FALSE.
13464              CALL DPRTF5(ITEXT(I),NCHAR,AVALUE,NUMCOL,IFLAG1)
13465            ELSE
13466              IF(NCTEXT(I).EQ.0)ITEXT(I)=' '
13467C
13468              IF(ISUBRO.EQ.'DTA2' .OR. IBUGA3.EQ.'ON')THEN
13469                WRITE(ICOUT,251)I,NUMCOL,NMAX
13470  251           FORMAT('BEFORE CALL DPTAB5: I,NUMCOL,NMAX = ',3I5)
13471                CALL DPWRST('XXX','WRIT')
13472                WRITE(ICOUT,252)NCTEXT(I),ITEXT(I)(1:40)
13473  252           FORMAT('NCTEXT(I),ITEXT(I)(1:40) = ',I8,A40)
13474                CALL DPWRST('XXX','WRIT')
13475                WRITE(ICOUT,253)(AVALUE(JJ),JJ=1,MIN(6,NUMCOL))
13476  253           FORMAT('AVALUE(J),J=1,...,6 = ',6G15.7)
13477                CALL DPWRST('XXX','WRIT')
13478              ENDIF
13479C
13480              ICSVWZ='OFF'
13481              IVALT=-99
13482              CALL DPTAB5(ITEXT(I),NCTEXT(I),AVALUE,NUMCOL,IFLAG1,
13483     1                    NMAX,NTOT,ICSVWZ)
13484            ENDIF
13485  200     CONTINUE
13486        ENDIF
13487C
13488C               *******************************************
13489C               **   STEP 3--                            **
13490C               **   TERMINATE THE TABLE                 **
13491C               *******************************************
13492C
13493        ISTEPN='2'
13494        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA2')
13495     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13496C
13497        IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
13498          IFLAG1=.TRUE.
13499          IFLAG2=.FALSE.
13500          IF(ILAST)IFLAG2=.TRUE.
13501          CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
13502        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
13503          IFLAG1=.TRUE.
13504          IFLAG2=.FALSE.
13505          IFLAG3=.FALSE.
13506          IF(ILAST)THEN
13507            IFLAG2=.TRUE.
13508            IFLAG3=.TRUE.
13509          ENDIF
13510          CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
13511        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
13512          IF(IRTFFF.EQ.'Courier New')THEN
13513            ITEMP=1
13514          ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
13515            ITEMP=8
13516          ENDIF
13517          WRITE(ICOUT,8091)IBASLC,ITEMP
13518          CALL DPWRST(ICOUT,'WRIT')
13519          CALL DPRTF6(NHEAD)
13520          CALL DPRTF6(NHEAD)
13521          IF(ILAST)THEN
13522            IRTFMD='VERB'
13523          ENDIF
13524        ELSE
13525          IF(ILAST)THEN
13526            WRITE(ICOUT,999)
13527            CALL DPWRST('XXX','WRIT')
13528          ENDIF
13529        ENDIF
13530C
13531      ENDIF
13532C
13533      RETURN
13534      END
13535      SUBROUTINE DPDTA4(ITITL9,NCTIT9,
13536     1                  IHEAD,NCHEAD,ITITLE,NCTITL,
13537     1                  MAXLIN,NUMLIN,MAXCOL,NUMCOL,
13538     1                  ITEXT,NCTEXT,AVAL,ITYPCO,MAXROW,NUMROW,
13539     1                  IDIGIT,NTOT,IWHTML,IWRTF,VALIGZ,ALIGNZ,NMAX,
13540     1                  ICAPSW,ICAPTY,IFIRST,ILAST,
13541     1                  ISUBRO,IBUGA3,IERROR)
13542C
13543C     PURPOSE--THIS ROUTINE PRINTS A MULTI-COLUMN TABLE CONSISTING OF:
13544C
13545C              1) AN OPTIONAL OVERALL TITLE
13546C              2) HEADERS FOR EACH OF THE COLUMNS (THESE HEADERS MAY
13547C                 CONTAIN MULTIPLE LINES).
13548C              3) A TABLE OF NUMERIC/CHARACTER VALUES.  THIS IS A
13549C                 VARIANT OF TABLE 2 (WHICH ONLY ALLOWS TEXT FIELDS
13550C                 FOR THE FIRST COLUMN).
13551C
13552C              ITITL9     => THE OVERALL TITLE
13553C              IHEAD      => TABLE CAPTION
13554C              ITITLE     => LINES FOR THE COLUMN HEADERS
13555C              AVAL       => MATRIX OF NUMERIC VALUES FOR THE TABLE
13556C              ITEXT      => MATRIX OF CHARACTER VALUES FOR THE TABLE
13557C
13558C     WRITTEN BY--ALAN HECKERT
13559C                 STATISTICAL ENGINEERING DIVISION
13560C                 INFORMATION TECHNOLOGY LABORATORY
13561C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13562C                 GAITHERSBURG, MD 20899-8980
13563C                 PHONE--301-975-2899
13564C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13565C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13566C     LANGUAGE--ANSI FORTRAN (1977)
13567C     VERSION NUMBER--2009/9
13568C     ORIGINAL VERSION--SEPTEMBER 2009.
13569C     UPDATED         --JANUARY   2011. USE DPDTLA TO CHECK FOR
13570C                                       CERTAIN CHARACTERS THAT NEED
13571C                                       TO BE ESCAPED FOR LATEX
13572C
13573C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
13574C
13575      CHARACTER*(*) IHEAD
13576      CHARACTER*(*) ITITL9
13577      CHARACTER*(*) ITITLE(MAXLIN,MAXCOL)
13578      CHARACTER*4   VALIGZ(*)
13579      CHARACTER*4   ALIGNZ(*)
13580      INTEGER       NCTITL(MAXLIN,MAXCOL)
13581      INTEGER       NCTEXT(MAXROW,MAXCOL)
13582      INTEGER       IDIGIT(*)
13583      INTEGER       NTOT(*)
13584      INTEGER       IWHTML(*)
13585      INTEGER       IWRTF(*)
13586      REAL          AVAL(MAXROW,MAXCOL)
13587      CHARACTER*(*) ITEXT(MAXROW,MAXCOL)
13588      CHARACTER*4   ITYPCO(MAXCOL)
13589C
13590      CHARACTER*4 ICAPSW
13591      CHARACTER*4 ICAPTY
13592      CHARACTER*4 ISUBRO
13593      CHARACTER*4 IBUGA3
13594      CHARACTER*4 IERROR
13595C
13596      CHARACTER*4 ISUBN1
13597      CHARACTER*4 ISUBN2
13598      CHARACTER*4 ISTEPN
13599      CHARACTER*4 ICSVWZ
13600      CHARACTER*1 IBASLC
13601C
13602      LOGICAL IFLAG1
13603      LOGICAL IFLAG2
13604      LOGICAL IFLAG3
13605      LOGICAL IFLAGA
13606      LOGICAL IFLAGB
13607      LOGICAL IFIRST
13608      LOGICAL ILAST
13609C
13610C---------------------------------------------------------------------
13611C
13612      INCLUDE 'DPCOST.INC'
13613C
13614      PARAMETER (MAXHED=1024)
13615      INTEGER IWIDTH(MAXHED)
13616      INTEGER NUMDIG(MAXHED)
13617      CHARACTER*8 ALIGN(MAXHED)
13618      CHARACTER*8 VALIGN(MAXHED)
13619      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
13620      CHARACTER*60 IVALUE(MAXHED)
13621      INTEGER      NCTEMP(MAXHED)
13622      REAL         AVALUE(MAXHED)
13623C
13624      CHARACTER*132 ITEMPC
13625C
13626      CHARACTER*4 IRTFMD
13627      COMMON/COMRTF/IRTFMD
13628C
13629C---------------------------------------------------------------------
13630C
13631      INCLUDE 'DPCOP2.INC'
13632C
13633C-----START POINT-----------------------------------------------------
13634C
13635      ISUBN1='DPDT'
13636      ISUBN2='A4  '
13637C
13638      IERROR='NO'
13639C
13640      DO40I=1,MAXHED
13641        IVALUE(I)=' '
13642        AVALUE(I)=0.0
13643        NCTEMP(I)=0
13644   40 CONTINUE
13645C
13646      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA4')THEN
13647        WRITE(ICOUT,999)
13648  999   FORMAT(1X)
13649        CALL DPWRST('XXX','WRIT')
13650        WRITE(ICOUT,51)
13651   51   FORMAT('**** AT THE BEGINNING OF DPDTA4--')
13652        CALL DPWRST('XXX','WRIT')
13653        WRITE(ICOUT,52)IBUGA3,ISUBRO
13654   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
13655        CALL DPWRST('XXX','WRIT')
13656        WRITE(ICOUT,53)MAXLIN,MAXROW,NUMROW,NUMCOL,NUMLIN
13657   53   FORMAT('MAXLIN,MAXROW,NUMROW,NUMCOL,NUMLIN = ',5I8)
13658        CALL DPWRST('XXX','WRIT')
13659        IF(NUMLIN.GT.0)THEN
13660          DO54I=1,NUMLIN
13661            DO55J=1,NUMCOL
13662              IF(NCTITL(I,J).GT.0)THEN
13663                NTEMP=MIN(80,NCTITL(I,J))
13664                WRITE(ICOUT,56)I,J,NCTITL(I,J),ITITLE(I,J)(1:NTEMP)
13665   56           FORMAT('I,J,NCTITL(I,J),ITITL(I,J)(1:NCTITL) = ',
13666     1                 3I8,2X,A80)
13667                CALL DPWRST('XXX','WRIT')
13668              ELSE
13669                WRITE(ICOUT,47)I,J,NCTITL(I,J)
13670   47           FORMAT('I,J,NCTITL(I,J) = ',3I8)
13671                CALL DPWRST('XXX','WRIT')
13672              ENDIF
13673   55       CONTINUE
13674   54     CONTINUE
13675        ENDIF
13676        IF(NUMROW.GT.0)THEN
13677          DO57I=1,NUMROW
13678            WRITE(ICOUT,60)I,(AVAL(I,J),J=1,MIN(5,NUMCOL))
13679   60       FORMAT('I,(AVAL(I,J),J=1,NUMCOL) = ',I8,5G15.7)
13680            CALL DPWRST('XXX','WRIT')
13681   57     CONTINUE
13682          DO77I=1,NUMROW
13683          DO79J=1,NUMCOL
13684            WRITE(ICOUT,80)I,J,ITEXT(I,J)
13685   80       FORMAT('I,J,ITEXT(I,J) = ',2I5,2X,A60)
13686            CALL DPWRST('XXX','WRIT')
13687   79     CONTINUE
13688   77     CONTINUE
13689        ENDIF
13690        WRITE(ICOUT,62)NCHEAD
13691   62   FORMAT('NCHEAD = ',I5)
13692        CALL DPWRST('XXX','WRIT')
13693        IF(NCHEAD.GT.0)THEN
13694          WRITE(ICOUT,63)IHEAD(1:NCHEAD)
13695   63     FORMAT('NCHEAD,IHEAD = ',A80)
13696          CALL DPWRST('XXX','WRIT')
13697        ENDIF
13698        DO65I=1,NUMCOL
13699          WRITE(ICOUT,67)I,IWRTF(I)
13700   67     FORMAT('I,IWRTF(I) = ',I5,I8)
13701          CALL DPWRST('XXX','WRIT')
13702   65   CONTINUE
13703      ENDIF
13704C
13705C               ******************************************
13706C               **   STEP 1--                           **
13707C               **   WRITE OUT THE TABLE HEADER.        **
13708C               **   NOTE THAT THIS MAY CONSIST OF      **
13709C               **   MULTIPLE LINES.                    **
13710C               ******************************************
13711C
13712      ISTEPN='1'
13713      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA4')
13714     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13715C
13716      IF(IPRINT.EQ.'ON')THEN
13717C
13718        CALL DPCONA(92,IBASLC)
13719C
13720        NHEAD=NUMCOL
13721C
13722        DO100I=1,NUMCOL
13723          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
13724            IWIDTH(I)=IWHTML(I)
13725            IF(VALIGZ(I).EQ.'b')THEN
13726              VALIGN(I)='BOTTOM'
13727            ELSEIF(VALIGZ(I).EQ.'c')THEN
13728              VALIGN(I)='CENTER'
13729            ELSEIF(VALIGZ(I).EQ.'t')THEN
13730              VALIGN(I)='TOP'
13731            ENDIF
13732            IF(ALIGNZ(I).EQ.'l')THEN
13733              ALIGN(I) ='LEFT'
13734            ELSEIF(ALIGNZ(I).EQ.'c')THEN
13735              ALIGN(I) ='CENTER'
13736            ELSEIF(ALIGNZ(I).EQ.'r')THEN
13737              ALIGN(I) ='RIGHT'
13738            ENDIF
13739C
13740          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
13741            IF(VALIGZ(I).EQ.'b')THEN
13742              VALIGN(I)='b'
13743            ELSEIF(VALIGZ(I).EQ.'c')THEN
13744              VALIGN(I)='c'
13745            ELSEIF(VALIGZ(I).EQ.'t')THEN
13746              VALIGN(I)='t'
13747            ENDIF
13748            IF(ALIGNZ(I).EQ.'l')THEN
13749              ALIGN(I) ='l'
13750            ELSEIF(ALIGNZ(I).EQ.'c')THEN
13751              ALIGN(I) ='c'
13752            ELSEIF(ALIGNZ(I).EQ.'r')THEN
13753              ALIGN(I) ='r'
13754            ENDIF
13755          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
13756            IWIDTH(I)=IWRTF(I)
13757            IF(VALIGZ(I).EQ.'b')THEN
13758              VALIGN(I)='b'
13759            ELSEIF(VALIGZ(I).EQ.'c')THEN
13760              VALIGN(I)='c'
13761            ELSEIF(VALIGZ(I).EQ.'t')THEN
13762              VALIGN(I)='t'
13763            ENDIF
13764            IF(ALIGNZ(I).EQ.'l')THEN
13765              ALIGN(I) ='l'
13766            ELSEIF(ALIGNZ(I).EQ.'c')THEN
13767              ALIGN(I) ='c'
13768            ELSEIF(ALIGNZ(I).EQ.'r')THEN
13769              ALIGN(I) ='r'
13770            ENDIF
13771          ELSE
13772            IF(VALIGZ(I).EQ.'b')THEN
13773              VALIGN(I)='b'
13774            ELSEIF(VALIGZ(I).EQ.'c')THEN
13775              VALIGN(I)='c'
13776            ELSEIF(VALIGZ(I).EQ.'t')THEN
13777              VALIGN(I)='t'
13778            ENDIF
13779            IF(ALIGNZ(I).EQ.'l')THEN
13780              ALIGN(I) ='l'
13781            ELSEIF(ALIGNZ(I).EQ.'c')THEN
13782              ALIGN(I) ='c'
13783            ELSEIF(ALIGNZ(I).EQ.'r')THEN
13784              ALIGN(I) ='r'
13785            ENDIF
13786          ENDIF
13787  100   CONTINUE
13788C
13789C       LOOP THROUGH THE LINES OF THE HEADER
13790C
13791        IF(NUMLIN.GE.1)THEN
13792          DO110I=1,NUMLIN
13793C
13794            DO120J=1,NUMCOL
13795              IVALUE(J)=' '
13796              NCTEMP(J)=0
13797              IF(NCTITL(I,J).GT.0)THEN
13798                NCTEMP(J)=NCTITL(I,J)
13799                IVALUE(J)(1:NCTEMP(J))=ITITLE(I,J)(1:NCTEMP(J))
13800              ENDIF
13801C
13802              IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA4')THEN
13803                WRITE(ICOUT,106)I,J,NCTEMP(J),IVALUE(J)
13804  106           FORMAT('I,J,NCTEMP(J),IVALUE(J) = ',3I8,A80)
13805                CALL DPWRST('XXX','WRIT')
13806              ENDIF
13807C
13808  120       CONTINUE
13809C
13810            IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
13811              IF(I.EQ.1)THEN
13812                IFLAG1=.FALSE.
13813                IF(IFIRST)IFLAG1=.TRUE.
13814                IFLAG2=.TRUE.
13815                IF(NCTIT9.LE.0)THEN
13816                  IF(IFIRST)THEN
13817                    CALL DPHTM1(IHEAD,NCHEAD,IFLAG1,IFLAG2)
13818                  ELSE
13819                    CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,
13820     1                          IFLAG1,IFLAG2)
13821                  ENDIF
13822                ELSE
13823                  CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1,IFLAG2)
13824                ENDIF
13825              ENDIF
13826              IFLAG1=.FALSE.
13827              IFLAG2=.FALSE.
13828              IF(I.EQ.1)IFLAG1=.TRUE.
13829              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
13830              CALL DPHTM4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2)
13831C
13832            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
13833C
13834              IF(I.EQ.1)THEN
13835                IF(IFIRST)THEN
13836                  IFLAG1=.FALSE.
13837                  IFLAG2=.FALSE.
13838                  IFLAG3=.TRUE.
13839                  CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
13840                ENDIF
13841                IFLAG1=.FALSE.
13842                IF(IFIRST)IFLAG1=.TRUE.
13843                IFLAG2=.TRUE.
13844C
13845                CALL DPDTLA(IHEAD,NCHEAD,NCT,ISUBRO,IBUGA3,IERROR)
13846                NCHEAD=NCT
13847C
13848                IF(NCTIT9.LE.0)THEN
13849                  ITEMPC=' '
13850                  NCHEA2=0
13851                  CALL DPLAT1(IHEAD,NCHEAD,ITEMPC,NCHEA2,IFLAG1)
13852                ELSE
13853C
13854                NCT=NCTIT9
13855                DO6030II=NCTIT9,1,-1
13856                  IF(ITITL9(II:II).EQ.'%')THEN
13857                    DO6040J=NCT,II,-1
13858                      ITITL9(J+1:J+1)=ITITL9(J:J)
13859 6040               CONTINUE
13860                    NCT=NCT+1
13861                    ITITL9(II:II)=IBASLC
13862                  ENDIF
13863 6030           CONTINUE
13864                NCTIT9=NCT
13865C
13866                  CALL DPLAT1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
13867                ENDIF
13868              ENDIF
13869              IFLAG1=.FALSE.
13870              IFLAG2=.FALSE.
13871              IFLAG3=.FALSE.
13872              IF(I.EQ.1)IFLAG1=.TRUE.
13873              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
13874              IF(I.EQ.1)IFLAG3=.TRUE.
13875C
13876              DO6110JJ=1,NUMCOL
13877                CALL DPDTLA(IVALUE(JJ),NCTEMP(JJ),NCT,
13878     1                      ISUBRO,IBUGA3,IERROR)
13879                NCTEMP(JJ)=NCT
13880 6110         CONTINUE
13881C
13882              CALL DPLAT4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2,IFLAG3)
13883C
13884            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
13885C
13886 8091         FORMAT(A1,'f',I1)
13887              IF(I.EQ.1)THEN
13888                IF(IRTFFP.EQ.'Times New Roman')THEN
13889                  ITEMP=0
13890                ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
13891                  ITEMP=6
13892                ELSEIF(IRTFFP.EQ.'Arial')THEN
13893                  ITEMP=2
13894                ELSEIF(IRTFFP.EQ.'Bookman')THEN
13895                  ITEMP=3
13896                ELSEIF(IRTFFP.EQ.'Georgia')THEN
13897                  ITEMP=4
13898                ELSEIF(IRTFFP.EQ.'Tahoma')THEN
13899                  ITEMP=5
13900                ELSEIF(IRTFFP.EQ.'Verdana')THEN
13901                  ITEMP=7
13902                ELSE
13903                  ITEMP=0
13904                ENDIF
13905C
13906                IRTFMD='OFF'
13907C
13908                IF(NCHEAD.GE.1.AND.I.EQ.1)THEN
13909                  NCTEM2=NCHEAD+3
13910                  IHEAD(4:NCTEM2)=IHEAD(1:NCHEAD)
13911                  IHEAD(1:3)=' b '
13912                  IHEAD(1:1)=IBASLC
13913                  IF(NCTIT9.LE.0)THEN
13914                    ITEMPC=' '
13915                    NCHEA2=0
13916                  ELSE
13917                    NCHEA2=NCTIT9+3
13918                    ITEMPC(4:NCHEA2)=ITITL9(1:NCTIT9)
13919                    ITEMPC(1:3)=' b '
13920                    ITEMPC(1:1)=IBASLC
13921                  ENDIF
13922                  CALL DPRTF1(ITEMPC,NCHEA2,IHEAD,NCTEM2)
13923                ENDIF
13924              ENDIF
13925C
13926              DO130J=1,NUMCOL
13927                NCHAR=NCTEMP(J)+3
13928                IVALUE(J)(4:NCHAR)=IVALUE(J)(1:NCTEMP(J))
13929                IVALUE(J)(1:3)=' b '
13930                IVALUE(J)(1:1)=IBASLC
13931                NCTEMP(J)=NCHAR
13932  130         CONTINUE
13933              IFLAG1=.FALSE.
13934              IFLAG2=.FALSE.
13935              IF(I.EQ.1)IFLAG1=.TRUE.
13936              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
13937              CALL DPRTF4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2)
13938            ELSE
13939              IF(I.EQ.1)THEN
13940                IFLAG1=.TRUE.
13941                CALL DPTAB1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
13942              ENDIF
13943              IFLAG1=.FALSE.
13944              IFLAG2=.FALSE.
13945              IF(I.EQ.1)IFLAG1=.TRUE.
13946              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
13947C
13948              DO 141 KK=1,NUMCOL
13949                IF(ALIGN(KK).EQ.'l' .AND. NCTEMP(KK).LT.NTOT(KK))THEN
13950                  DO146JJ=NCTEMP(KK)+1,NTOT(KK)
13951                    IVALUE(KK)(JJ:JJ)=' '
13952  146             CONTINUE
13953                  NCTEMP(KK)=NTOT(KK)
13954                ELSEIF(ALIGN(KK).EQ.'c'.AND.NCTEMP(KK).LT.NTOT(KK))THEN
13955                  IVALUE(KK)(NCTEMP(KK):NTOT(KK))=' '
13956                  IDIFF=(NTOT(KK)-NCTEMP(KK))/2
13957                  IF(IDIFF.GT.0)THEN
13958                    DO147JJ=NTOT(KK),IDIFF+1,-1
13959                      IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
13960  147               CONTINUE
13961                    IVALUE(KK)(1:IDIFF)=' '
13962                  ENDIF
13963                  NCTEMP(KK)=NTOT(KK)
13964                ELSEIF(ALIGN(KK).EQ.'r'.AND.NCTEMP(KK).LT.NTOT(KK))THEN
13965C
13966                  IF(ISUBRO.EQ.'DTA4' .OR. IBUGA3.EQ.'ON')THEN
13967                    WRITE(ICOUT,157)KK,NCTEMP(KK),NTOT(KK)
13968  157               FORMAT('BEFORE 148: KK,NCTEMP(KK),NTOT(KK) =',
13969     1                     3I8)
13970                    CALL DPWRST('XXX','WRIT')
13971                    WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
13972                    CALL DPWRST('XXX','WRIT')
13973                  ENDIF
13974C
13975                  IDIFF=NTOT(KK)-NCTEMP(KK)
13976                  DO148JJ=NTOT(KK),IDIFF+1,-1
13977                    IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
13978  148             CONTINUE
13979                  IVALUE(KK)(1:IDIFF)=' '
13980                  NCTEMP(KK)=NTOT(KK)
13981                ENDIF
13982C
13983                IF(ISUBRO.EQ.'DTA4' .OR. IBUGA3.EQ.'ON')THEN
13984                  WRITE(ICOUT,151)KK,IDIFF,NCTEMP(KK),NUMCOL,NMAX
13985  151             FORMAT('BEFORE CALL DPTAB4: KK,IDIFF,NCTEMP(KK),',
13986     1                   'NUMCOL,NMAX=',5I8)
13987                  CALL DPWRST('XXX','WRIT')
13988                  WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
13989  153             FORMAT('IVALUE(KK) = ',A80)
13990                  CALL DPWRST('XXX','WRIT')
13991                ENDIF
13992C
13993  141         CONTINUE
13994C
13995              CALL DPTAB4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2,NMAX)
13996C
13997            ENDIF
13998  110     CONTINUE
13999        ENDIF
14000C
14001C               ******************************************
14002C               **   STEP 2--                           **
14003C               **   WRITE OUT THE TABLE ROWS           **
14004C               ******************************************
14005C
14006        IFLAGA=.FALSE.
14007        IFLAGB=.FALSE.
14008        MAXLTA=35
14009        ILINE=0
14010        IF(NUMROW.GE.1)THEN
14011          DO200I=1,NUMROW
14012C
14013            IFLAG1=.FALSE.
14014            IF(I.EQ.NUMROW)IFLAG1=.TRUE.
14015            DO210J=1,NUMCOL
14016              AVALUE(J)=AVAL(I,J)
14017              IF(AVALUE(J).EQ.CPUMIN)THEN
14018                NUMDIG(J)=-99
14019              ELSE
14020                NUMDIG(J)=IDIGIT(J)
14021              ENDIF
14022              IVALUE(J)=' '
14023              NTEMP=NCTEXT(I,J)
14024              NCTEMP(J)=NTEMP
14025              IF(NTEMP.GT.0)THEN
14026                IVALUE(J)(1:NTEMP)=ITEXT(I,J)(1:NTEMP)
14027C
14028                IF(ICAPTY.EQ.'LATE')THEN
14029                  CALL DPDTLA(IVALUE(J),NTEMP,NCT,ISUBRO,IBUGA3,IERROR)
14030                  NTEMP=NCT
14031                ENDIF
14032C
14033              ENDIF
14034C
14035              IF(ISUBRO.EQ.'DTA4' .OR. IBUGA3.EQ.'ON')THEN
14036                WRITE(ICOUT,211)I,J,ITYPCO(J),AVALUE(J),IVALUE(J)
14037  211           FORMAT('I,J,ITYPCO(J),AVALUE(J),IVALUE(J) = ',
14038     1                 2I8,2X,A4,2X,G15.7,2X,A60)
14039                CALL DPWRST('XXX','WRIT')
14040              ENDIF
14041C
14042  210       CONTINUE
14043C
14044            IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
14045              CALL DPHTMY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
14046     1                    IFLAGA,IFLAGB)
14047C
14048C           FOR LATEX, WE CANNOT EXTEND TABLES BEYOND A SINGLE
14049C           PAGE, SO PUT A CHECK IN.
14050C
14051            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
14052              CALL DPLATW(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
14053     1                    IFLAGA,IFLAGB)
14054              ILINE=ILINE+1
14055              IF(ILINE.EQ.MAXLTA .AND. I.NE.NUMROW)THEN
14056                ILINE=0
14057                IFLAG1=.TRUE.
14058                IFLAG2=.FALSE.
14059                IFLAG3=.TRUE.
14060                CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
14061                IFLAG1=.FALSE.
14062                IFLAG2=.FALSE.
14063                IFLAG3=.TRUE.
14064                CALL DPLATY(NHEAD)
14065              ENDIF
14066            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
14067              CALL DPRTFY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
14068     1                    IFLAGA,IFLAGB)
14069            ELSE
14070C
14071              IF(ISUBRO.EQ.'DTA4' .OR. IBUGA3.EQ.'ON')THEN
14072                WRITE(ICOUT,251)I,NUMCOL,NMAX
14073  251           FORMAT('BEFORE CALL DPTAB8: I,NUMCOL,NMAX = ',
14074     1                 3I5)
14075                CALL DPWRST('XXX','WRIT')
14076              ENDIF
14077C
14078              ICSVWZ='OFF'
14079              IVALT=-99
14080              CALL DPTABY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
14081     1                    IFLAGA,IFLAGB,NMAX,NTOT,ICSVWZ,IVALT,
14082     1                    IBUGA3,ISUBRO)
14083            ENDIF
14084  200     CONTINUE
14085        ENDIF
14086C
14087C               *******************************************
14088C               **   STEP 3--                            **
14089C               **   TERMINATE THE TABLE                 **
14090C               *******************************************
14091C
14092        ISTEPN='2'
14093        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA4')
14094     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14095C
14096        IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
14097          IFLAG1=.TRUE.
14098          IFLAG2=.FALSE.
14099          IF(ILAST)IFLAG2=.TRUE.
14100          CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
14101        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
14102          IFLAG1=.TRUE.
14103          IFLAG2=.FALSE.
14104          IFLAG3=.FALSE.
14105          IF(ILAST)THEN
14106            IFLAG2=.TRUE.
14107            IFLAG3=.TRUE.
14108          ENDIF
14109          CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
14110        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
14111          IF(IRTFFF.EQ.'Courier New')THEN
14112            ITEMP=1
14113          ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
14114            ITEMP=8
14115          ENDIF
14116          WRITE(ICOUT,8091)IBASLC,ITEMP
14117          CALL DPWRST(ICOUT,'WRIT')
14118          CALL DPRTF6(NHEAD)
14119          CALL DPRTF6(NHEAD)
14120          IF(ILAST)THEN
14121            IRTFMD='VERB'
14122          ENDIF
14123        ELSE
14124          IF(ILAST)THEN
14125            WRITE(ICOUT,999)
14126            CALL DPWRST('XXX','WRIT')
14127          ENDIF
14128        ENDIF
14129C
14130      ENDIF
14131C
14132      RETURN
14133      END
14134      SUBROUTINE DPDTA5(ITITL9,NCTIT9,
14135     1                  IHEAD,NCHEAD,ITITLE,NCTITL,
14136     1                  MAXLIN,NUMLIN,MAXCOL,NUMCOL,
14137     1                  ITEXT,NCTEXT,AVAL,ITYPCO,MAXROW,NUMROW,
14138     1                  IDIGIT,NTOT,IWHTML,IWRTF,VALIGZ,ALIGNZ,NMAX,
14139     1                  ICAPSW,ICAPTY,IFIRST,ILAST,
14140     1                  IFLAGS,IFLAGE,
14141     1                  ISUBRO,IBUGA3,IERROR)
14142C
14143C     PURPOSE--THIS ROUTINE PRINTS A MULTI-COLUMN TABLE CONSISTING OF:
14144C
14145C              1) AN OPTIONAL OVERALL TITLE
14146C              2) HEADERS FOR EACH OF THE COLUMNS (THESE HEADERS MAY
14147C                 CONTAIN MULTIPLE LINES).
14148C              3) A TABLE OF NUMERIC/CHARACTER VALUES.  THIS IS A
14149C                 VARIANT OF TABLE 2 (WHICH ONLY ALLOWS TEXT FIELDS
14150C                 FOR THE FIRST COLUMN).
14151C
14152C              ITITL9     => THE OVERALL TITLE
14153C              IHEAD      => TABLE CAPTION
14154C              ITITLE     => LINES FOR THE COLUMN HEADERS
14155C              AVAL       => MATRIX OF NUMERIC VALUES FOR THE TABLE
14156C              ITEXT      => MATRIX OF CHARACTER VALUES FOR THE TABLE
14157C
14158C              NOTE THAT THIS IS A SLIGHTLY MODIFIED VERSION OF
14159C              DPDTA4.  IN SOME CASES, THE NUMBER OF ROWS IN THE
14160C              TABLE MAY NOT BE FIXED (AND IN FACT MAY BE RATHER
14161C              LARGE).  DPDTA5 ALLOWS THE ROWS OF THE TABLE TO BE
14162C              SENT IN INCREMENTS.  THE IFLAGS AND IFLAGE SPECIFY
14163C              WHETHER THE TABLE HEADERS OR TRAILERS ARE TO BE
14164C              PRINTED, RESPECTIVELY.
14165C
14166C     WRITTEN BY--ALAN HECKERT
14167C                 STATISTICAL ENGINEERING DIVISION
14168C                 INFORMATION TECHNOLOGY LABORATORY
14169C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14170C                 GAITHERSBURG, MD 20899-8980
14171C                 PHONE--301-975-2899
14172C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14173C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14174C     LANGUAGE--ANSI FORTRAN (1977)
14175C     VERSION NUMBER--2009/9
14176C     ORIGINAL VERSION--SEPTEMBER 2009.
14177C     UPDATED         --JANUARY   2011. USE DPDTLA TO CHECK FOR
14178C                                       CERTAIN CHARACTERS THAT NEED
14179C                                       TO BE ESCAPED FOR LATEX
14180C     UPDATED         --FEBRUARY  2020. CALL LIST TO DPTABY
14181C
14182C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
14183C
14184      CHARACTER*(*) IHEAD
14185      CHARACTER*(*) ITITL9
14186      CHARACTER*(*) ITITLE(MAXLIN,MAXCOL)
14187      CHARACTER*4   VALIGZ(*)
14188      CHARACTER*4   ALIGNZ(*)
14189      INTEGER       NCTITL(MAXLIN,MAXCOL)
14190      INTEGER       NCTEXT(MAXROW,MAXCOL)
14191      INTEGER       IDIGIT(*)
14192      INTEGER       NTOT(*)
14193      INTEGER       IWHTML(*)
14194      INTEGER       IWRTF(*)
14195      REAL          AVAL(MAXROW,MAXCOL)
14196      CHARACTER*(*) ITEXT(MAXROW,MAXCOL)
14197      CHARACTER*4   ITYPCO(MAXCOL)
14198C
14199      CHARACTER*4 ICAPSW
14200      CHARACTER*4 ICAPTY
14201      CHARACTER*4 ISUBRO
14202      CHARACTER*4 IBUGA3
14203      CHARACTER*4 IERROR
14204C
14205      CHARACTER*4 ISUBN1
14206      CHARACTER*4 ISUBN2
14207      CHARACTER*4 ISTEPN
14208      CHARACTER*4 ICSVWZ
14209      CHARACTER*1 IBASLC
14210C
14211      LOGICAL IFLAG1
14212      LOGICAL IFLAG2
14213      LOGICAL IFLAG3
14214      LOGICAL IFLAGA
14215      LOGICAL IFLAGB
14216      LOGICAL IFLAGS
14217      LOGICAL IFLAGE
14218      LOGICAL IFIRST
14219      LOGICAL ILAST
14220C
14221C---------------------------------------------------------------------
14222C
14223      INCLUDE 'DPCOST.INC'
14224C
14225      PARAMETER (MAXHED=1024)
14226      INTEGER IWIDTH(MAXHED)
14227      INTEGER NUMDIG(MAXHED)
14228      CHARACTER*8 ALIGN(MAXHED)
14229      CHARACTER*8 VALIGN(MAXHED)
14230      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
14231      CHARACTER*60 IVALUE(MAXHED)
14232      INTEGER      NCTEMP(MAXHED)
14233      REAL         AVALUE(MAXHED)
14234C
14235      CHARACTER*132 ITEMPC
14236C
14237      CHARACTER*4 IRTFMD
14238      COMMON/COMRTF/IRTFMD
14239C
14240C---------------------------------------------------------------------
14241C
14242      INCLUDE 'DPCOP2.INC'
14243C
14244C-----START POINT-----------------------------------------------------
14245C
14246      ISUBN1='DPDT'
14247      ISUBN2='A5  '
14248C
14249      IERROR='NO'
14250C
14251      DO40I=1,MAXHED
14252        IVALUE(I)=' '
14253        AVALUE(I)=0.0
14254        NCTEMP(I)=0
14255   40 CONTINUE
14256C
14257      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA5')THEN
14258        WRITE(ICOUT,999)
14259  999   FORMAT(1X)
14260        CALL DPWRST('XXX','WRIT')
14261        WRITE(ICOUT,51)
14262   51   FORMAT('**** AT THE BEGINNING OF DPDTA5--')
14263        CALL DPWRST('XXX','WRIT')
14264        WRITE(ICOUT,52)IBUGA3,ISUBRO
14265   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
14266        CALL DPWRST('XXX','WRIT')
14267        WRITE(ICOUT,53)MAXLIN,MAXROW,NUMROW,NUMCOL,NUMLIN
14268   53   FORMAT('MAXLIN,MAXROW,NUMROW,NUMCOL,NUMLIN = ',5I8)
14269        CALL DPWRST('XXX','WRIT')
14270        IF(NUMLIN.GT.0)THEN
14271          DO54I=1,NUMLIN
14272            DO55J=1,NUMCOL
14273              IF(NCTITL(I,J).GT.0)THEN
14274                NTEMP=MIN(80,NCTITL(I,J))
14275                WRITE(ICOUT,56)I,J,NCTITL(I,J),ITITLE(I,J)(1:NTEMP)
14276   56           FORMAT('I,J,NCTITL(I,J),ITITL(I,J)(1:NCTITL) = ',
14277     1                 3I5,2X,A80)
14278                CALL DPWRST('XXX','WRIT')
14279              ENDIF
14280   55       CONTINUE
14281   54     CONTINUE
14282        ENDIF
14283        IF(NUMROW.GT.0)THEN
14284          DO57I=1,NUMROW
14285            WRITE(ICOUT,60)I,(AVAL(I,J),J=1,MIN(5,NUMCOL))
14286   60       FORMAT('I,(AVAL(I,J),J=1,NUMCOL) = ',I8,5G15.7)
14287            CALL DPWRST('XXX','WRIT')
14288   57     CONTINUE
14289          DO77I=1,NUMROW
14290          DO79J=1,NUMCOL
14291            WRITE(ICOUT,80)I,J,ITEXT(I,J)
14292   80       FORMAT('I,J,ITEXT(I,J) = ',2I5,2X,A60)
14293            CALL DPWRST('XXX','WRIT')
14294   79     CONTINUE
14295   77     CONTINUE
14296        ENDIF
14297        WRITE(ICOUT,62)NCHEAD
14298   62   FORMAT('NCHEAD = ',I5)
14299        CALL DPWRST('XXX','WRIT')
14300        IF(NCHEAD.GT.0)THEN
14301          WRITE(ICOUT,63)IHEAD(1:NCHEAD)
14302   63     FORMAT('NCHEAD,IHEAD = ',A80)
14303          CALL DPWRST('XXX','WRIT')
14304        ENDIF
14305      ENDIF
14306C
14307C               ******************************************
14308C               **   STEP 1--                           **
14309C               **   WRITE OUT THE TABLE HEADER.        **
14310C               **   NOTE THAT THIS MAY CONSIST OF      **
14311C               **   MULTIPLE LINES.                    **
14312C               ******************************************
14313C
14314      ISTEPN='1'
14315      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA5')
14316     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14317C
14318      IF(IPRINT.EQ.'ON')THEN
14319C
14320        CALL DPCONA(92,IBASLC)
14321C
14322C       SKIP HEADER IF REQUESTED
14323C
14324        IF(.NOT.IFLAGS)GOTO199
14325C
14326        NHEAD=NUMCOL
14327C
14328        DO100I=1,NUMCOL
14329          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
14330            IWIDTH(I)=IWHTML(I)
14331            IF(VALIGZ(I).EQ.'b')THEN
14332              VALIGN(I)='BOTTOM'
14333            ELSEIF(VALIGZ(I).EQ.'c')THEN
14334              VALIGN(I)='CENTER'
14335            ELSEIF(VALIGZ(I).EQ.'t')THEN
14336              VALIGN(I)='TOP'
14337            ENDIF
14338            IF(ALIGNZ(I).EQ.'l')THEN
14339              ALIGN(I) ='LEFT'
14340            ELSEIF(ALIGNZ(I).EQ.'c')THEN
14341              ALIGN(I) ='CENTER'
14342            ELSEIF(ALIGNZ(I).EQ.'r')THEN
14343              ALIGN(I) ='RIGHT'
14344            ENDIF
14345C
14346          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
14347            IF(VALIGZ(I).EQ.'b')THEN
14348              VALIGN(I)='b'
14349            ELSEIF(VALIGZ(I).EQ.'c')THEN
14350              VALIGN(I)='c'
14351            ELSEIF(VALIGZ(I).EQ.'t')THEN
14352              VALIGN(I)='t'
14353            ENDIF
14354            IF(ALIGNZ(I).EQ.'l')THEN
14355              ALIGN(I) ='l'
14356            ELSEIF(ALIGNZ(I).EQ.'c')THEN
14357              ALIGN(I) ='c'
14358            ELSEIF(ALIGNZ(I).EQ.'r')THEN
14359              ALIGN(I) ='r'
14360            ENDIF
14361          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
14362            IWIDTH(I)=IWRTF(I)
14363            IF(VALIGZ(I).EQ.'b')THEN
14364              VALIGN(I)='b'
14365            ELSEIF(VALIGZ(I).EQ.'c')THEN
14366              VALIGN(I)='c'
14367            ELSEIF(VALIGZ(I).EQ.'t')THEN
14368              VALIGN(I)='t'
14369            ENDIF
14370            IF(ALIGNZ(I).EQ.'l')THEN
14371              ALIGN(I) ='l'
14372            ELSEIF(ALIGNZ(I).EQ.'c')THEN
14373              ALIGN(I) ='c'
14374            ELSEIF(ALIGNZ(I).EQ.'r')THEN
14375              ALIGN(I) ='r'
14376            ENDIF
14377          ELSE
14378            IF(VALIGZ(I).EQ.'b')THEN
14379              VALIGN(I)='b'
14380            ELSEIF(VALIGZ(I).EQ.'c')THEN
14381              VALIGN(I)='c'
14382            ELSEIF(VALIGZ(I).EQ.'t')THEN
14383              VALIGN(I)='t'
14384            ENDIF
14385            IF(ALIGNZ(I).EQ.'l')THEN
14386              ALIGN(I) ='l'
14387            ELSEIF(ALIGNZ(I).EQ.'c')THEN
14388              ALIGN(I) ='c'
14389            ELSEIF(ALIGNZ(I).EQ.'r')THEN
14390              ALIGN(I) ='r'
14391            ENDIF
14392          ENDIF
14393  100   CONTINUE
14394C
14395C       LOOP THROUGH THE LINES OF THE HEADER
14396C
14397        IF(NUMLIN.GE.1)THEN
14398          DO110I=1,NUMLIN
14399C
14400            DO120J=1,NUMCOL
14401              IVALUE(J)=' '
14402              NCTEMP(J)=0
14403              IF(NCTITL(I,J).GT.0)THEN
14404                NCTEMP(J)=NCTITL(I,J)
14405                IVALUE(J)(1:NCTEMP(J))=ITITLE(I,J)(1:NCTEMP(J))
14406              ENDIF
14407C
14408              IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA5')THEN
14409                WRITE(ICOUT,106)I,J,NCTEMP(J),IVALUE(J)
14410  106           FORMAT('I,J,NCTEMP(J),IVALUE(J) = ',3I8,A80)
14411                CALL DPWRST('XXX','WRIT')
14412              ENDIF
14413C
14414  120       CONTINUE
14415C
14416            IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
14417              IF(I.EQ.1)THEN
14418                IFLAG1=.FALSE.
14419                IF(IFIRST)IFLAG1=.TRUE.
14420                IFLAG2=.TRUE.
14421                IF(NCTIT9.LE.0)THEN
14422                  IF(IFIRST)THEN
14423                    CALL DPHTM1(IHEAD,NCHEAD,IFLAG1,IFLAG2)
14424                  ELSE
14425                    CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,
14426     1                          IFLAG1,IFLAG2)
14427                  ENDIF
14428                ELSE
14429                  CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1,IFLAG2)
14430                ENDIF
14431              ENDIF
14432              IFLAG1=.FALSE.
14433              IFLAG2=.FALSE.
14434              IF(I.EQ.1)IFLAG1=.TRUE.
14435              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
14436              CALL DPHTM4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2)
14437C
14438            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
14439C
14440              IF(I.EQ.1)THEN
14441                IF(IFIRST)THEN
14442                  IFLAG1=.FALSE.
14443                  IFLAG2=.FALSE.
14444                  IFLAG3=.TRUE.
14445                  CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
14446                ENDIF
14447                IFLAG1=.FALSE.
14448                IF(IFIRST)IFLAG1=.TRUE.
14449                IFLAG2=.TRUE.
14450C
14451                CALL DPDTLA(IHEAD,NCHEAD,NCT,ISUBRO,IBUGA3,IERROR)
14452                NCHEAD=NCT
14453C
14454                IF(NCTIT9.LE.0)THEN
14455                  ITEMPC=' '
14456                  NCHEA2=0
14457                  CALL DPLAT1(IHEAD,NCHEAD,ITEMPC,NCHEA2,IFLAG1)
14458                ELSE
14459                  CALL DPDTLA(ITITL9,NCTIT9,NCT,ISUBRO,IBUGA3,IERROR)
14460                  NCTIT9=NCT
14461                  CALL DPLAT1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
14462                ENDIF
14463              ENDIF
14464              IFLAG1=.FALSE.
14465              IFLAG2=.FALSE.
14466              IFLAG3=.FALSE.
14467              IF(I.EQ.1)IFLAG1=.TRUE.
14468              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
14469              IF(I.EQ.1)IFLAG3=.TRUE.
14470C
14471              DO6110JJ=1,NUMCOL
14472                CALL DPDTLA(IVALUE(JJ),NCTEMP(JJ),NCT,
14473     1                      ISUBRO,IBUGA3,IERROR)
14474                NCTEMP(JJ)=NCT
14475 6110         CONTINUE
14476C
14477              CALL DPLAT4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2,IFLAG3)
14478C
14479            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
14480C
14481 8091         FORMAT(A1,'f',I1)
14482              IF(I.EQ.1)THEN
14483                IF(IRTFFP.EQ.'Times New Roman')THEN
14484                  ITEMP=0
14485                ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
14486                  ITEMP=6
14487                ELSEIF(IRTFFP.EQ.'Arial')THEN
14488                  ITEMP=2
14489                ELSEIF(IRTFFP.EQ.'Bookman')THEN
14490                  ITEMP=3
14491                ELSEIF(IRTFFP.EQ.'Georgia')THEN
14492                  ITEMP=4
14493                ELSEIF(IRTFFP.EQ.'Tahoma')THEN
14494                  ITEMP=5
14495                ELSEIF(IRTFFP.EQ.'Verdana')THEN
14496                  ITEMP=7
14497                ELSE
14498                  ITEMP=0
14499                ENDIF
14500C
14501                IRTFMD='OFF'
14502C
14503                IF(NCTIT9.GE.1.AND.I.EQ.1)THEN
14504                  IF(NCTIT9.LE.0)THEN
14505                    ITEMPC=' '
14506                    NCHEA2=0
14507                  ELSE
14508                    NCHEA2=NCTIT9+3
14509                    ITEMPC(4:NCHEA2)=ITITL9(1:NCTIT9)
14510                    ITEMPC(1:3)=' b '
14511                    ITEMPC(1:1)=IBASLC
14512                  ENDIF
14513                  IF(NCHEAD.GE.1)THEN
14514                    NCTEM2=NCHEAD+3
14515                    IHEAD(4:NCTEM2)=IHEAD(1:NCHEAD)
14516                    IHEAD(1:3)=' b '
14517                    IHEAD(1:1)=IBASLC
14518                  ELSE
14519                    NCTEM2=0
14520                  ENDIF
14521                  CALL DPRTF1(ITEMPC,NCHEA2,IHEAD,NCTEM2)
14522                ENDIF
14523              ENDIF
14524C
14525              DO130J=1,NUMCOL
14526                NCHAR=NCTEMP(J)+3
14527                IVALUE(J)(4:NCHAR)=IVALUE(J)(1:NCTEMP(J))
14528                IVALUE(J)(1:3)=' b '
14529                IVALUE(J)(1:1)=IBASLC
14530                NCTEMP(J)=NCHAR
14531  130         CONTINUE
14532              IFLAG1=.FALSE.
14533              IFLAG2=.FALSE.
14534              IF(I.EQ.1)IFLAG1=.TRUE.
14535              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
14536              CALL DPRTF4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2)
14537            ELSE
14538              IF(I.EQ.1)THEN
14539                IFLAG1=.TRUE.
14540                CALL DPTAB1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
14541              ENDIF
14542              IFLAG1=.FALSE.
14543              IFLAG2=.FALSE.
14544              IF(I.EQ.1)IFLAG1=.TRUE.
14545              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
14546C
14547              DO 141 KK=1,NUMCOL
14548                IF(ALIGN(KK).EQ.'l' .AND. NCTEMP(KK).LT.NTOT(KK))THEN
14549                  DO146JJ=NCTEMP(KK)+1,NTOT(KK)
14550                    IVALUE(KK)(JJ:JJ)=' '
14551  146             CONTINUE
14552                  NCTEMP(KK)=NTOT(KK)
14553                ELSEIF(ALIGN(KK).EQ.'c'.AND.NCTEMP(KK).LT.NTOT(KK))THEN
14554                  IVALUE(KK)(NCTEMP(KK):NTOT(KK))=' '
14555                  IDIFF=(NTOT(KK)-NCTEMP(KK))/2
14556                  IF(IDIFF.GT.0)THEN
14557                    DO147JJ=NTOT(KK),IDIFF+1,-1
14558                      IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
14559  147               CONTINUE
14560                    IVALUE(KK)(1:IDIFF)=' '
14561                  ENDIF
14562                  NCTEMP(KK)=NTOT(KK)
14563                ELSEIF(ALIGN(KK).EQ.'r'.AND.NCTEMP(KK).LT.NTOT(KK))THEN
14564C
14565                  IF(ISUBRO.EQ.'DTA5' .OR. IBUGA3.EQ.'ON')THEN
14566                    WRITE(ICOUT,157)KK,NCTEMP(KK),NTOT(KK)
14567  157               FORMAT('BEFORE 148: KK,NCTEMP(KK),NTOT(KK) =',
14568     1                     3I8)
14569                    CALL DPWRST('XXX','WRIT')
14570                    WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
14571                    CALL DPWRST('XXX','WRIT')
14572                  ENDIF
14573C
14574                  IDIFF=NTOT(KK)-NCTEMP(KK)
14575                  DO148JJ=NTOT(KK),IDIFF+1,-1
14576                    IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
14577  148             CONTINUE
14578                  IVALUE(KK)(1:IDIFF)=' '
14579                  NCTEMP(KK)=NTOT(KK)
14580                ENDIF
14581C
14582                IF(ISUBRO.EQ.'DTA5' .OR. IBUGA3.EQ.'ON')THEN
14583                  WRITE(ICOUT,151)KK,IDIFF,NCTEMP(KK),NUMCOL,NMAX
14584  151             FORMAT('BEFORE CALL DPTAB4: KK,IDIFF,NCTEMP(KK),',
14585     1                   'NUMCOL,NMAX=',5I8)
14586                  CALL DPWRST('XXX','WRIT')
14587                  WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
14588  153             FORMAT('IVALUE(KK) = ',A80)
14589                  CALL DPWRST('XXX','WRIT')
14590                ENDIF
14591C
14592  141         CONTINUE
14593C
14594              CALL DPTAB4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2,NMAX)
14595C
14596            ENDIF
14597  110     CONTINUE
14598        ENDIF
14599C
14600  199   CONTINUE
14601C
14602C               ******************************************
14603C               **   STEP 2--                           **
14604C               **   WRITE OUT THE TABLE ROWS           **
14605C               ******************************************
14606C
14607        IFLAGA=.FALSE.
14608        IFLAGB=.FALSE.
14609        MAXLTA=35
14610        ILINE=0
14611        IF(NUMROW.GE.1)THEN
14612          DO200I=1,NUMROW
14613C
14614            IFLAG1=.FALSE.
14615            IF(I.EQ.NUMROW)IFLAG1=.TRUE.
14616            DO210J=1,NUMCOL
14617              AVALUE(J)=AVAL(I,J)
14618              IF(AVALUE(J).EQ.CPUMIN)THEN
14619                NUMDIG(J)=-99
14620              ELSE
14621                NUMDIG(J)=IDIGIT(J)
14622              ENDIF
14623              IVALUE(J)=' '
14624              NTEMP=NCTEXT(I,J)
14625              NCTEMP(J)=NTEMP
14626              IF(NTEMP.GT.0 .AND. ITYPCO(J).EQ.'ALPH')THEN
14627                IVALUE(J)(1:NTEMP)=ITEXT(I,J)(1:NTEMP)
14628C
14629                IF(ICAPTY.EQ.'LATE')THEN
14630                  CALL DPDTLA(IVALUE(J),NTEMP,NCT,ISUBRO,IBUGA3,IERROR)
14631                  NTEMP=NCT
14632                  NCTEMP(J)=NTEMP
14633                ENDIF
14634C
14635              ENDIF
14636C
14637              IF(ISUBRO.EQ.'DTA5' .OR. IBUGA3.EQ.'ON')THEN
14638                WRITE(ICOUT,211)I,J,ITYPCO(J),AVALUE(J),IVALUE(J)
14639  211           FORMAT('I,J,ITYPCO(J),AVALUE(J),IVALUE(J) = ',
14640     1                 2I8,2X,A4,2X,G15.7,2X,A60)
14641                CALL DPWRST('XXX','WRIT')
14642              ENDIF
14643C
14644  210       CONTINUE
14645C
14646            IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
14647              CALL DPHTMY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
14648     1                    IFLAGA,IFLAGB)
14649C
14650C           FOR LATEX, WE CANNOT EXTEND TABLES BEYOND A SINGLE
14651C           PAGE, SO PUT A CHECK IN.
14652C
14653            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
14654              CALL DPLATW(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
14655     1                    IFLAGA,IFLAGB)
14656              ILINE=ILINE+1
14657              IF(ILINE.EQ.MAXLTA .AND. I.NE.NUMROW)THEN
14658                ILINE=0
14659                IFLAG1=.TRUE.
14660                IFLAG2=.FALSE.
14661                IFLAG3=.TRUE.
14662                CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
14663                IFLAG1=.FALSE.
14664                IFLAG2=.FALSE.
14665                IFLAG3=.TRUE.
14666                CALL DPLATY(NHEAD)
14667              ENDIF
14668            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
14669              CALL DPRTFY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
14670     1                    IFLAGA,IFLAGB)
14671            ELSE
14672C
14673              IF(ISUBRO.EQ.'DTA5' .OR. IBUGA3.EQ.'ON')THEN
14674                WRITE(ICOUT,251)I,NUMCOL,NMAX
14675  251           FORMAT('BEFORE CALL DPTABY: I,NUMCOL,NMAX = ',
14676     1                 3I5)
14677                CALL DPWRST('XXX','WRIT')
14678              ENDIF
14679C
14680              ICSVWZ='OFF'
14681              IVALT=-99
14682              CALL DPTABY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
14683     1                    IFLAGA,IFLAGB,NMAX,NTOT,ICSVWZ,IVALT,
14684     1                    IBUGA3,ISUBRO)
14685            ENDIF
14686  200     CONTINUE
14687        ENDIF
14688C
14689C               *******************************************
14690C               **   STEP 3--                            **
14691C               **   TERMINATE THE TABLE                 **
14692C               *******************************************
14693C
14694        ISTEPN='2'
14695        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTA5')
14696     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14697C
14698        IF(.NOT.IFLAGE)GOTO399
14699C
14700        IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
14701          IFLAG1=.TRUE.
14702          IFLAG2=.FALSE.
14703          IF(ILAST)IFLAG2=.TRUE.
14704          CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
14705        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
14706          IFLAG1=.TRUE.
14707          IFLAG2=.FALSE.
14708          IFLAG3=.FALSE.
14709          IF(ILAST)THEN
14710            IFLAG2=.TRUE.
14711            IFLAG3=.TRUE.
14712          ENDIF
14713          CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
14714        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
14715          IF(IRTFFF.EQ.'Courier New')THEN
14716            ITEMP=1
14717          ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
14718            ITEMP=8
14719          ENDIF
14720          WRITE(ICOUT,8091)IBASLC,ITEMP
14721          CALL DPWRST(ICOUT,'WRIT')
14722          CALL DPRTF6(NHEAD)
14723          CALL DPRTF6(NHEAD)
14724          IF(ILAST)THEN
14725            IRTFMD='VERB'
14726          ENDIF
14727        ELSE
14728          IF(ILAST)THEN
14729            WRITE(ICOUT,999)
14730            CALL DPWRST('XXX','WRIT')
14731          ENDIF
14732        ENDIF
14733C
14734  399   CONTINUE
14735C
14736      ENDIF
14737C
14738      RETURN
14739      END
14740      SUBROUTINE DPDT5B(ITITL9,NCTIT9,
14741     1                  IHEAD,NCHEAD,ITITLE,NCTITL,
14742     1                  MAXLIN,NUMLIN,MAXCOL,NUMCOL,
14743     1                  ITEXT,NCTEXT,AVAL,ITYPCO,MAXROW,NUMROW,
14744     1                  IDIGIT,NTOT,IWHTML,IWRTF,VALIGZ,ALIGNZ,NMAX,
14745     1                  ICOLSP,ROWSEP,
14746     1                  ICAPSW,ICAPTY,IFIRST,ILAST,
14747     1                  IFLAGS,IFLAGE,
14748     1                  ISUBRO,IBUGA3,IERROR)
14749C
14750C     PURPOSE--THIS ROUTINE PRINTS A MULTI-COLUMN TABLE CONSISTING OF:
14751C
14752C              1) AN OPTIONAL OVERALL TITLE
14753C              2) HEADERS FOR EACH OF THE COLUMNS (THESE HEADERS MAY
14754C                 CONTAIN MULTIPLE LINES).
14755C              3) A TABLE OF NUMERIC/CHARACTER VALUES.  THIS IS A
14756C                 VARIANT OF TABLE 2 (WHICH ONLY ALLOWS TEXT FIELDS
14757C                 FOR THE FIRST COLUMN).
14758C
14759C              ITITL9     => THE OVERALL TITLE
14760C              IHEAD      => TABLE CAPTION
14761C              ITITLE     => LINES FOR THE COLUMN HEADERS
14762C              AVAL       => MATRIX OF NUMERIC VALUES FOR THE TABLE
14763C              ITEXT      => MATRIX OF CHARACTER VALUES FOR THE TABLE
14764C              ICOLSP     => MATRIX OF COLUMN SPANS FOR THE HEADER
14765C                            LINES OF THE TABLE.
14766C
14767C              IN SOME CASES, THE NUMBER OF ROWS IN THE
14768C              TABLE MAY NOT BE FIXED (AND IN FACT MAY BE RATHER
14769C              LARGE).  DPDT5B ALLOWS THE ROWS OF THE TABLE TO BE
14770C              SENT IN INCREMENTS.  THE IFLAGS AND IFLAGE SPECIFY
14771C              WHETHER THE TABLE HEADERS OR TRAILERS ARE TO BE
14772C              PRINTED, RESPECTIVELY.
14773C
14774C              THIS IS A VARIATION OF DPDTA5 THAT ALLOWS THE FOLLOWING:
14775C
14776C                 1) HEADER TEXT TO SPAN MULTIPLE COLUMNS (COLSPN ARRAY
14777C                    SPECIFIES NUMBER OF COLUMNS THAT A SPECIFIC COLUMN
14778C                    COVERS).  NOTE THAT MULTIPLE COLUMN HEADERS WILL
14779C                    AUTOMATICALLY BE CENTER JUSTIFIED.
14780C
14781C                 2) ALLOWS FOR EMPTY CELLS.  TO ACCOMODATE THIS, THE
14782C                    IDIGIT FIELD IS A MATRIX INSTEAD OF AN ARRAY (I.E.,
14783C                    NEED TO SET INDIVIDUALLY).
14784C
14785C                 3) ALLOW A SEPARATOR LINE TO BE DRAWN AFTER SELECT
14786C                    ROWS.  FOR EXAMPLE, WE MAY WANT A BORDER FOR A
14787C                    "ROW TOTALS" ROW.  THE ROWSEP VARIABLE WILL BE
14788C                    USED TO INDICATE THIS (A VALUE OF 1 SPECIFIES
14789C                    THAT THE ROW SEPARATOR WILL BE GENERATED).
14790C
14791C     WRITTEN BY--ALAN HECKERT
14792C                 STATISTICAL ENGINEERING DIVISION
14793C                 INFORMATION TECHNOLOGY LABORATORY
14794C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14795C                 GAITHERSBURG, MD 20899-8980
14796C                 PHONE--301-975-2899
14797C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14798C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14799C     LANGUAGE--ANSI FORTRAN (1977)
14800C     VERSION NUMBER--2011/1
14801C     ORIGINAL VERSION--JANUARY   2011.
14802C     UPDATED         --JANUARY   2011. USE DPDTLA, DPDTRT TO CHECK FOR
14803C                                       CERTAIN CHARACTERS THAT NEED
14804C                                       TO BE ESCAPED FOR LATEX, RTF
14805C     UPDATED         --FEBRUARY  2020. CALL LIST TO DPTABY
14806C
14807C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
14808C
14809      CHARACTER*(*) IHEAD
14810      CHARACTER*(*) ITITL9
14811      CHARACTER*(*) ITITLE(MAXLIN,MAXCOL)
14812      CHARACTER*4   VALIGZ(*)
14813      CHARACTER*4   ALIGNZ(*)
14814      INTEGER       NCTITL(MAXLIN,MAXCOL)
14815      INTEGER       NCTEXT(MAXROW,MAXCOL)
14816      INTEGER       ICOLSP(MAXLIN,MAXCOL)
14817      INTEGER       IDIGIT(MAXROW,MAXCOL)
14818      INTEGER       NTOT(*)
14819      INTEGER       ROWSEP(*)
14820      INTEGER       IWHTML(*)
14821      INTEGER       IWRTF(*)
14822      REAL          AVAL(MAXROW,MAXCOL)
14823      CHARACTER*(*) ITEXT(MAXROW,MAXCOL)
14824      CHARACTER*4   ITYPCO(MAXCOL)
14825C
14826      CHARACTER*4 ICAPSW
14827      CHARACTER*4 ICAPTY
14828      CHARACTER*4 ISUBRO
14829      CHARACTER*4 IBUGA3
14830      CHARACTER*4 IERROR
14831C
14832      CHARACTER*4 ISUBN1
14833      CHARACTER*4 ISUBN2
14834      CHARACTER*4 ISTEPN
14835      CHARACTER*4 ICSVWZ
14836      CHARACTER*1 IBASLC
14837C
14838      LOGICAL IFLAG1
14839      LOGICAL IFLAG2
14840      LOGICAL IFLAG3
14841      LOGICAL IFLAGA
14842      LOGICAL IFLAGB
14843      LOGICAL IFLAGS
14844      LOGICAL IFLAGE
14845      LOGICAL IFIRST
14846      LOGICAL ILAST
14847C
14848C---------------------------------------------------------------------
14849C
14850      INCLUDE 'DPCOST.INC'
14851C
14852      PARAMETER (MAXHED=1024)
14853      INTEGER IWIDTH(MAXHED)
14854      INTEGER NUMDIG(MAXHED)
14855      CHARACTER*8 ALIGN(MAXHED)
14856      CHARACTER*8 VALIGN(MAXHED)
14857      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
14858      CHARACTER*60 IVALUE(MAXHED)
14859      INTEGER      NCTEMP(MAXHED)
14860      INTEGER      NCOLSP(MAXHED)
14861      REAL         AVALUE(MAXHED)
14862C
14863      CHARACTER*8 ALIGNT
14864      CHARACTER*132 ITEMPC
14865C
14866      CHARACTER*4 IRTFMD
14867      COMMON/COMRTF/IRTFMD
14868C
14869C---------------------------------------------------------------------
14870C
14871      INCLUDE 'DPCOP2.INC'
14872C
14873C-----START POINT-----------------------------------------------------
14874C
14875      ISUBN1='DPDT'
14876      ISUBN2='5B  '
14877C
14878      IERROR='NO'
14879C
14880      DO40I=1,MAXHED
14881        IVALUE(I)=' '
14882        AVALUE(I)=0.0
14883        NCTEMP(I)=0
14884        NCOLSP(I)=0
14885   40 CONTINUE
14886C
14887      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT5B')THEN
14888        WRITE(ICOUT,999)
14889  999   FORMAT(1X)
14890        CALL DPWRST('XXX','WRIT')
14891        WRITE(ICOUT,51)
14892   51   FORMAT('**** AT THE BEGINNING OF DPDT5B--')
14893        CALL DPWRST('XXX','WRIT')
14894        WRITE(ICOUT,52)IBUGA3,ISUBRO,IFLAGS,IFLAGE,IFIRST,ILAST
14895   52   FORMAT('IBUGA3,ISUBRO,IFLAGS,IFLAGE,IFIRST,ILAST = ',
14896     1         2(A4,2X),4L4)
14897        CALL DPWRST('XXX','WRIT')
14898        WRITE(ICOUT,53)MAXLIN,MAXROW,NUMROW,NUMCOL,NUMLIN
14899   53   FORMAT('MAXLIN,MAXROW,NUMROW,NUMCOL,NUMLIN = ',5I8)
14900        CALL DPWRST('XXX','WRIT')
14901        IF(NUMLIN.GT.0)THEN
14902          DO54I=1,NUMLIN
14903            DO55J=1,NUMCOL
14904              NTEMP=MIN(80,NCTITL(I,J))
14905              IF(NTEMP.GT.0)THEN
14906                WRITE(ICOUT,56)I,J,NCTITL(I,J),ITITLE(I,J)(1:NTEMP)
14907   56           FORMAT('I,J,NCTITL(I,J),ITITL(I,J)(1:NCTITL) = ',
14908     1                 3I5,2X,A80)
14909                CALL DPWRST('XXX','WRIT')
14910              ELSE
14911                WRITE(ICOUT,56)I,J,NCTITL(I,J)
14912                CALL DPWRST('XXX','WRIT')
14913              ENDIF
14914   55       CONTINUE
14915   54     CONTINUE
14916        ENDIF
14917        IF(NUMROW.GT.0)THEN
14918          DO57I=1,NUMROW
14919            WRITE(ICOUT,60)I,(AVAL(I,J),J=1,MIN(5,NUMCOL))
14920   60       FORMAT('I,(AVAL(I,J),J=1,NUMCOL) = ',I8,5G15.7)
14921            CALL DPWRST('XXX','WRIT')
14922   57     CONTINUE
14923          DO77I=1,NUMROW
14924          DO79J=1,NUMCOL
14925            WRITE(ICOUT,80)I,J,ITEXT(I,J)
14926   80       FORMAT('I,J,ITEXT(I,J) = ',2I5,2X,A60)
14927            CALL DPWRST('XXX','WRIT')
14928   79     CONTINUE
14929   77     CONTINUE
14930        ENDIF
14931        WRITE(ICOUT,62)NCHEAD
14932   62   FORMAT('NCHEAD = ',I5)
14933        CALL DPWRST('XXX','WRIT')
14934        IF(NCHEAD.GT.0)THEN
14935          WRITE(ICOUT,63)IHEAD(1:NCHEAD)
14936   63     FORMAT('NCHEAD,IHEAD = ',A80)
14937          CALL DPWRST('XXX','WRIT')
14938        ENDIF
14939        DO91J=1,NUMCOL
14940          WRITE(ICOUT,93)J,ALIGNZ(J),VALIGZ(J),NTOT(J)
14941   93     FORMAT('J,ALIGNZ(J),VALIGZ(J),NTOT(J) = ',I5,2(2X,A4),2X,I5)
14942          CALL DPWRST('XXX','WRIT')
14943   91   CONTINUE
14944      ENDIF
14945C
14946C               ******************************************
14947C               **   STEP 1--                           **
14948C               **   WRITE OUT THE TABLE HEADER.        **
14949C               **   NOTE THAT THIS MAY CONSIST OF      **
14950C               **   MULTIPLE LINES.                    **
14951C               ******************************************
14952C
14953      ISTEPN='1'
14954      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DT5B')
14955     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
14956C
14957      IF(IPRINT.EQ.'ON')THEN
14958C
14959        CALL DPCONA(92,IBASLC)
14960C
14961C       SKIP HEADER IF REQUESTED
14962C
14963        IF(.NOT.IFLAGS)GOTO199
14964C
14965        NHEAD=NUMCOL
14966C
14967        DO100I=1,NUMCOL
14968          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
14969            IWIDTH(I)=IWHTML(I)
14970            IF(VALIGZ(I).EQ.'b')THEN
14971              VALIGN(I)='BOTTOM'
14972            ELSEIF(VALIGZ(I).EQ.'c')THEN
14973              VALIGN(I)='CENTER'
14974            ELSEIF(VALIGZ(I).EQ.'t')THEN
14975              VALIGN(I)='TOP'
14976            ENDIF
14977            IF(ALIGNZ(I).EQ.'l')THEN
14978              ALIGN(I) ='LEFT'
14979            ELSEIF(ALIGNZ(I).EQ.'c')THEN
14980              ALIGN(I) ='CENTER'
14981            ELSEIF(ALIGNZ(I).EQ.'r')THEN
14982              ALIGN(I) ='RIGHT'
14983            ENDIF
14984C
14985          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
14986            IF(VALIGZ(I).EQ.'b')THEN
14987              VALIGN(I)='b'
14988            ELSEIF(VALIGZ(I).EQ.'c')THEN
14989              VALIGN(I)='c'
14990            ELSEIF(VALIGZ(I).EQ.'t')THEN
14991              VALIGN(I)='t'
14992            ENDIF
14993            IF(ALIGNZ(I).EQ.'l')THEN
14994              ALIGN(I) ='l'
14995            ELSEIF(ALIGNZ(I).EQ.'c')THEN
14996              ALIGN(I) ='c'
14997            ELSEIF(ALIGNZ(I).EQ.'r')THEN
14998              ALIGN(I) ='r'
14999            ENDIF
15000          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
15001            IWIDTH(I)=IWRTF(I)
15002            IF(VALIGZ(I).EQ.'b')THEN
15003              VALIGN(I)='b'
15004            ELSEIF(VALIGZ(I).EQ.'c')THEN
15005              VALIGN(I)='c'
15006            ELSEIF(VALIGZ(I).EQ.'t')THEN
15007              VALIGN(I)='t'
15008            ENDIF
15009            IF(ALIGNZ(I).EQ.'l')THEN
15010              ALIGN(I) ='l'
15011            ELSEIF(ALIGNZ(I).EQ.'c')THEN
15012              ALIGN(I) ='c'
15013            ELSEIF(ALIGNZ(I).EQ.'r')THEN
15014              ALIGN(I) ='r'
15015            ENDIF
15016          ELSE
15017            IF(VALIGZ(I).EQ.'b')THEN
15018              VALIGN(I)='b'
15019            ELSEIF(VALIGZ(I).EQ.'c')THEN
15020              VALIGN(I)='c'
15021            ELSEIF(VALIGZ(I).EQ.'t')THEN
15022              VALIGN(I)='t'
15023            ENDIF
15024            IF(ALIGNZ(I).EQ.'l')THEN
15025              ALIGN(I) ='l'
15026            ELSEIF(ALIGNZ(I).EQ.'c')THEN
15027              ALIGN(I) ='c'
15028            ELSEIF(ALIGNZ(I).EQ.'r')THEN
15029              ALIGN(I) ='r'
15030            ENDIF
15031          ENDIF
15032  100   CONTINUE
15033C
15034C       LOOP THROUGH THE LINES OF THE HEADER
15035C
15036        IF(NUMLIN.GE.1)THEN
15037          DO110I=1,NUMLIN
15038C
15039            DO120J=1,NUMCOL
15040              IVALUE(J)=' '
15041              NCTEMP(J)=0
15042              NCOLSP(J)=ICOLSP(I,J)
15043              IF(NCTITL(I,J).GT.0)THEN
15044                NCTEMP(J)=NCTITL(I,J)
15045                IVALUE(J)(1:NCTEMP(J))=ITITLE(I,J)(1:NCTEMP(J))
15046              ENDIF
15047C
15048              IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT5B')THEN
15049                WRITE(ICOUT,106)I,J,NCTEMP(J),IVALUE(J)
15050  106           FORMAT('I,J,NCTEMP(J),IVALUE(J) = ',3I8,A80)
15051                CALL DPWRST('XXX','WRIT')
15052              ENDIF
15053C
15054  120       CONTINUE
15055C
15056            IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
15057              IF(NCTIT9.LT.0)NCTIT9=0
15058              IF(I.EQ.1)THEN
15059                IFLAG1=.FALSE.
15060                IF(IFIRST)IFLAG1=.TRUE.
15061                IFLAG2=.TRUE.
15062                IF(NCTIT9.LE.0)THEN
15063                  IF(IFIRST)THEN
15064                    CALL DPHTM1(IHEAD,NCHEAD,IFLAG1,IFLAG2)
15065                  ELSE
15066                    CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,
15067     1                          IFLAG1,IFLAG2)
15068                  ENDIF
15069                ELSE
15070                  CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1,IFLAG2)
15071                ENDIF
15072              ENDIF
15073              IFLAG1=.FALSE.
15074              IFLAG2=.FALSE.
15075              IF(I.EQ.1)IFLAG1=.TRUE.
15076              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
15077              CALL DPHT4B(IVALUE,NCTEMP,NUMCOL,NCOLSP,IFLAG1,IFLAG2)
15078C
15079            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
15080C
15081              IF(I.EQ.1)THEN
15082                IF(IFIRST)THEN
15083                  IFLAG1=.FALSE.
15084                  IFLAG2=.FALSE.
15085                  IFLAG3=.TRUE.
15086                  CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
15087                ENDIF
15088                IFLAG1=.FALSE.
15089                IF(IFIRST)IFLAG1=.TRUE.
15090                IFLAG2=.TRUE.
15091C
15092                IF(NCTIT9.LT.0)NCTIT9=0
15093                CALL DPDTLA(IHEAD,NCHEAD,NCT,ISUBRO,IBUGA3,IERROR)
15094                NCHEAD=NCT
15095C
15096                IF(NCTIT9.LE.0)THEN
15097                  ITEMPC=' '
15098                  NCHEA2=0
15099                  CALL DPLAT1(IHEAD,NCHEAD,ITEMPC,NCHEA2,IFLAG1)
15100                ELSE
15101                  CALL DPDTLA(ITITL9,NCTIT9,NCT,ISUBRO,IBUGA3,IERROR)
15102                  NCTIT9=NCT
15103                  CALL DPLAT1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
15104                ENDIF
15105              ENDIF
15106C
15107              IFLAG1=.FALSE.
15108              IFLAG2=.FALSE.
15109              IFLAG3=.FALSE.
15110              IF(I.EQ.1)IFLAG1=.TRUE.
15111              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
15112              IF(I.EQ.1)IFLAG3=.TRUE.
15113C
15114              DO6110JJ=1,NUMCOL
15115                CALL DPDTLA(IVALUE(JJ),NCTEMP(JJ),NCT,
15116     1                      ISUBRO,IBUGA3,IERROR)
15117                NCTEMP(JJ)=NCT
15118 6110         CONTINUE
15119C
15120              CALL DPLA4B(IVALUE,NCTEMP,NUMCOL,NCOLSP,
15121     1                    IFLAG1,IFLAG2,IFLAG3)
15122C
15123            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
15124C
15125 8091         FORMAT(A1,'f',I1)
15126              IF(I.EQ.1)THEN
15127                IF(IRTFFP.EQ.'Times New Roman')THEN
15128                  ITEMP=0
15129                ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
15130                  ITEMP=6
15131                ELSEIF(IRTFFP.EQ.'Arial')THEN
15132                  ITEMP=2
15133                ELSEIF(IRTFFP.EQ.'Bookman')THEN
15134                  ITEMP=3
15135                ELSEIF(IRTFFP.EQ.'Georgia')THEN
15136                  ITEMP=4
15137                ELSEIF(IRTFFP.EQ.'Tahoma')THEN
15138                  ITEMP=5
15139                ELSEIF(IRTFFP.EQ.'Verdana')THEN
15140                  ITEMP=7
15141                ELSE
15142                  ITEMP=0
15143                ENDIF
15144C
15145                IRTFMD='OFF'
15146C
15147                IF(NCTIT9.LT.0)NCTIT9=0
15148                IF(NCTIT9.GE.1.AND.I.EQ.1)THEN
15149                  CALL DPDTRT(ITITL9,NCTIT9,NCT,ISUBRO,IBUGA3,IERROR)
15150                  NCTIT9=NCT
15151                  IF(NCTIT9.LE.0)THEN
15152                    ITEMPC=' '
15153                    NCHEA2=0
15154                  ELSE
15155                    NCHEA2=NCTIT9+3
15156                    ITEMPC(4:NCHEA2)=ITITL9(1:NCTIT9)
15157                    ITEMPC(1:3)=' b '
15158                    ITEMPC(1:1)=IBASLC
15159                  ENDIF
15160                  IF(NCHEAD.GE.1)THEN
15161                    CALL DPDTRT(IHEAD,NCHEAD,NCT,ISUBRO,IBUGA3,IERROR)
15162                    NCHEAD=NCT
15163                    NCTEM2=NCHEAD+3
15164                    IHEAD(4:NCTEM2)=IHEAD(1:NCHEAD)
15165                    IHEAD(1:3)=' b '
15166                    IHEAD(1:1)=IBASLC
15167                  ELSE
15168                    NCTEM2=0
15169                  ENDIF
15170                  CALL DPRTF1(ITEMPC,NCHEA2,IHEAD,NCTEM2)
15171                ENDIF
15172              ENDIF
15173C
15174              DO130J=1,NUMCOL
15175                CALL DPDTRT(IVALUE(J),NCTEMP(J),NCT,
15176     1                      ISUBRO,IBUGA3,IERROR)
15177                NCTEMP(J)=NCT
15178                NCHAR=NCTEMP(J)+3
15179                IVALUE(J)(4:NCHAR)=IVALUE(J)(1:NCTEMP(J))
15180                IVALUE(J)(1:3)=' b '
15181                IVALUE(J)(1:1)=IBASLC
15182                NCTEMP(J)=NCHAR
15183  130         CONTINUE
15184              IFLAG1=.FALSE.
15185              IFLAG2=.FALSE.
15186              IF(I.EQ.1)IFLAG1=.TRUE.
15187              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
15188              CALL DPRT4B(IVALUE,NCTEMP,NUMCOL,NCOLSP,IFLAG1,IFLAG2)
15189            ELSE
15190              IF(I.EQ.1 .AND. NCTIT9.GE.0)THEN
15191                IFLAG1=.TRUE.
15192                CALL DPTAB1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
15193              ENDIF
15194              IFLAG1=.FALSE.
15195              IFLAG2=.FALSE.
15196              IF(I.EQ.1)IFLAG1=.TRUE.
15197              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
15198C
15199              DO 141 KK=1,NUMCOL
15200C
15201                IF(ISUBRO.EQ.'DT5B' .OR. IBUGA3.EQ.'ON')THEN
15202                  WRITE(ICOUT,142)KK,NCOLSP(KK)
15203  142             FORMAT('KK,NCOLSP(KK) = ',2I8)
15204                  CALL DPWRST('XXX','WRIT')
15205                ENDIF
15206C
15207                IF(NCOLSP(KK).LE.0)GOTO141
15208                NTOTZZ=NTOT(KK)
15209                ALIGNT=ALIGN(KK)
15210                IF(NCOLSP(KK).GT.1)THEN
15211                  DO1141IICOL=KK+1,KK+NCOLSP(KK)-1
15212                    NTOTZZ=NTOTZZ + NTOT(IICOL)
15213 1141             CONTINUE
15214                  ALIGNT='c'
15215                ENDIF
15216C
15217                IF(ISUBRO.EQ.'DT5B' .OR. IBUGA3.EQ.'ON')THEN
15218                  WRITE(ICOUT,157)KK,NCTEMP(KK),NTOTZZ,ALIGNT
15219  157             FORMAT('BEFORE 148: KK,NCTEMP(KK),NTOTZZ,ALIGNT =',
15220     1                   3I8,2X,A4)
15221                  CALL DPWRST('XXX','WRIT')
15222                ENDIF
15223C
15224                IF(ALIGNT.EQ.'l' .AND. NCTEMP(KK).LT.NTOTZZ)THEN
15225                  IF(NCTEMP(KK).GT.0)THEN
15226                    DO146JJ=NCTEMP(KK)+1,NTOTZZ
15227                      IVALUE(KK)(JJ:JJ)=' '
15228  146               CONTINUE
15229                    NCTEMP(KK)=NTOTZZ
15230                  ELSE
15231                    IVALUE(KK)(1:NTOTZZ)=' '
15232                    NCTEMP(KK)=NTOTZZ
15233                  ENDIF
15234                ELSEIF(ALIGNT.EQ.'c'.AND.NCTEMP(KK).LT.NTOTZZ)THEN
15235                  IF(NCTEMP(KK).GT.0)THEN
15236                    IVALUE(KK)(NCTEMP(KK)+1:NTOTZZ)=' '
15237                    IDIFF=(NTOTZZ-NCTEMP(KK))/2
15238                    IF(IDIFF.GT.0)THEN
15239                      DO147JJ=NTOTZZ,IDIFF+1,-1
15240                        IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
15241  147                 CONTINUE
15242                      IVALUE(KK)(1:IDIFF)=' '
15243                    ENDIF
15244                    NCTEMP(KK)=NTOTZZ
15245                  ELSE
15246                    IVALUE(KK)(1:NTOTZZ)=' '
15247                    NCTEMP(KK)=NTOTZZ
15248                  ENDIF
15249                ELSEIF(ALIGNT.EQ.'r'.AND.NCTEMP(KK).LT.NTOTZZ)THEN
15250                  IF(NCTEMP(KK).GT.0)THEN
15251                    IDIFF=NTOTZZ-NCTEMP(KK)
15252                    DO148JJ=NTOTZZ,IDIFF+1,-1
15253                      IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
15254  148               CONTINUE
15255                    IVALUE(KK)(1:IDIFF)=' '
15256                    NCTEMP(KK)=NTOTZZ
15257                  ELSE
15258                    IVALUE(KK)(1:NTOTZZ)=' '
15259                    NCTEMP(KK)=NTOTZZ
15260                  ENDIF
15261                ENDIF
15262C
15263                IF(ISUBRO.EQ.'DT5B' .OR. IBUGA3.EQ.'ON')THEN
15264                  WRITE(ICOUT,1151)NTOTZZ,NCTEMP(KK),IDIFF
15265 1151             FORMAT('BEFORE CALL DPTA44: NTOTZZ,NCTEMP(KK),',
15266     1                   'IDIFF = ',3I8)
15267                  CALL DPWRST('XXX','WRIT')
15268                  WRITE(ICOUT,151)KK,IDIFF,NCTEMP(KK),NUMCOL,NMAX
15269  151             FORMAT('KK,IDIFF,NCTEMP(KK),NUMCOL,NMAX=',5I8)
15270                  CALL DPWRST('XXX','WRIT')
15271                  WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
15272  153             FORMAT('IVALUE(KK) = ',A80)
15273                  CALL DPWRST('XXX','WRIT')
15274                ENDIF
15275C
15276  141         CONTINUE
15277C
15278              CALL DPTA44(IVALUE,NCTEMP,NUMCOL,NCOLSP,
15279     1                    IFLAG1,IFLAG2,NMAX)
15280C
15281            ENDIF
15282  110     CONTINUE
15283        ENDIF
15284C
15285  199   CONTINUE
15286C
15287C               ******************************************
15288C               **   STEP 2--                           **
15289C               **   WRITE OUT THE TABLE ROWS           **
15290C               ******************************************
15291C
15292        IFLAGA=.FALSE.
15293        IFLAGB=.FALSE.
15294        MAXLTA=35
15295        ILINE=0
15296        IF(NUMROW.GE.1)THEN
15297          DO200I=1,NUMROW
15298C
15299            IFLAG1=.FALSE.
15300            IF(I.EQ.NUMROW)IFLAG1=.TRUE.
15301            IFLAGA=.FALSE.
15302            IFLAGB=.FALSE.
15303            IF(ROWSEP(I).EQ.1)THEN
15304              IFLAGA=.TRUE.
15305            ELSEIF(ROWSEP(I).EQ.2)THEN
15306              IFLAGB=.TRUE.
15307            ELSEIF(ROWSEP(I).EQ.3)THEN
15308              IFLAGB=.TRUE.
15309              IFLAGA=.TRUE.
15310            ENDIF
15311            DO210J=1,NUMCOL
15312              AVALUE(J)=AVAL(I,J)
15313              IF(AVALUE(J).EQ.CPUMIN)THEN
15314                IF(IDIGIT(I,J).EQ.-1)THEN
15315                  NUMDIG(J)=-1
15316                ELSE
15317                  NUMDIG(J)=-99
15318                ENDIF
15319              ELSE
15320                NUMDIG(J)=IDIGIT(I,J)
15321              ENDIF
15322              IVALUE(J)=' '
15323              NTEMP=NCTEXT(I,J)
15324              NCTEMP(J)=NTEMP
15325              IF(NTEMP.GT.0)THEN
15326                IVALUE(J)(1:NTEMP)=ITEXT(I,J)(1:NTEMP)
15327C
15328                IF(ICAPTY.EQ.'LATE')THEN
15329                  CALL DPDTLA(IVALUE(J),NTEMP,NCT,ISUBRO,IBUGA3,IERROR)
15330                  NTEMP=NCT
15331                  NCTEMP(J)=NTEMP
15332                ELSEIF(ICAPTY.EQ.'RTF')THEN
15333                  CALL DPDTRT(IVALUE(J),NTEMP,NCT,ISUBRO,IBUGA3,IERROR)
15334                  NTEMP=NCT
15335                  NCTEMP(J)=NTEMP
15336                ENDIF
15337C
15338              ENDIF
15339C
15340              IF(ISUBRO.EQ.'DT5B' .OR. IBUGA3.EQ.'ON')THEN
15341                WRITE(ICOUT,211)I,J,ITYPCO(J),AVALUE(J),
15342     1                          NCTEMP(J),IVALUE(J)
15343  211           FORMAT('I,J,ITYPCO(J),AVALUE(J),NCTEMP(J),IVALUE(J) = ',
15344     1                 2I8,2X,A4,2X,G15.7,2X,I5,2X,A60)
15345                CALL DPWRST('XXX','WRIT')
15346              ENDIF
15347C
15348  210       CONTINUE
15349C
15350            IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
15351              CALL DPHTMY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
15352     1                    IFLAGA,IFLAGB)
15353C
15354C           FOR LATEX, WE CANNOT EXTEND TABLES BEYOND A SINGLE
15355C           PAGE, SO PUT A CHECK IN.
15356C
15357            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
15358              CALL DPLATW(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
15359     1                    IFLAGA,IFLAGB)
15360              ILINE=ILINE+1
15361              IF(ILINE.EQ.MAXLTA .AND. I.NE.NUMROW)THEN
15362                ILINE=0
15363                IFLAG1=.TRUE.
15364                IFLAG2=.FALSE.
15365                IFLAG3=.TRUE.
15366                CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
15367                IFLAG1=.FALSE.
15368                IFLAG2=.FALSE.
15369                IFLAG3=.TRUE.
15370                CALL DPLATY(NHEAD)
15371              ENDIF
15372            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
15373              CALL DPRTFY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
15374     1                    IFLAGA,IFLAGB)
15375            ELSE
15376C
15377              IF(ISUBRO.EQ.'DT5B' .OR. IBUGA3.EQ.'ON')THEN
15378                WRITE(ICOUT,251)I,NUMCOL,NMAX
15379  251           FORMAT('BEFORE CALL DPTABY: I,NUMCOL,NMAX = ',
15380     1                 3I5)
15381                CALL DPWRST('XXX','WRIT')
15382              ENDIF
15383C
15384              ICSVWZ='OFF'
15385              IVALT=-99
15386              CALL DPTABY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPCO,
15387     1                    IFLAGA,IFLAGB,NMAX,NTOT,ICSVWZ,IVALT,
15388     1                    IBUGA3,ISUBRO)
15389            ENDIF
15390  200     CONTINUE
15391        ENDIF
15392C
15393C               *******************************************
15394C               **   STEP 3--                            **
15395C               **   TERMINATE THE TABLE                 **
15396C               *******************************************
15397C
15398        ISTEPN='2'
15399        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DT5B')
15400     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15401C
15402        IF(.NOT.IFLAGE)GOTO399
15403C
15404        IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
15405          IFLAG1=.TRUE.
15406          IFLAG2=.FALSE.
15407          IF(ILAST)IFLAG2=.TRUE.
15408          CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
15409        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
15410          IFLAG1=.TRUE.
15411          IFLAG2=.FALSE.
15412          IFLAG3=.FALSE.
15413          IF(ILAST)THEN
15414            IFLAG2=.TRUE.
15415            IFLAG3=.TRUE.
15416          ENDIF
15417          CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
15418        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
15419          IF(IRTFFF.EQ.'Courier New')THEN
15420            ITEMP=1
15421          ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
15422            ITEMP=8
15423          ENDIF
15424          WRITE(ICOUT,8091)IBASLC,ITEMP
15425          CALL DPWRST(ICOUT,'WRIT')
15426          CALL DPRTF6(NHEAD)
15427          CALL DPRTF6(NHEAD)
15428          IF(ILAST)THEN
15429            IRTFMD='VERB'
15430          ENDIF
15431        ELSE
15432          IF(ILAST)THEN
15433            WRITE(ICOUT,999)
15434            CALL DPWRST('XXX','WRIT')
15435          ENDIF
15436        ENDIF
15437C
15438  399   CONTINUE
15439C
15440      ENDIF
15441C
15442      RETURN
15443      END
15444      SUBROUTINE DPDT5C(ITITL9,NCTIT9,
15445     1                  IHEAD,NCHEAD,ITITLE,NCTITL,
15446     1                  MAXLIN,NUMLIN,MAXCOL,NUMCOL,
15447     1                  ITEXT,NCTEXT,AVAL,ITYPCO,MAXROW,NUMROW,
15448     1                  IDIGIT,NTOT,IWHTML,IWRTF,VALIGZ,ALIGNZ,NMAX,
15449     1                  ICAPSW,ICAPTY,IFIRST,ILAST,
15450     1                  IFLAGS,IFLAGE,
15451     1                  ISUBRO,IBUGA3,IERROR)
15452C
15453C     PURPOSE--THIS ROUTINE PRINTS A MULTI-COLUMN TABLE CONSISTING OF:
15454C
15455C              1) AN OPTIONAL OVERALL TITLE
15456C              2) HEADERS FOR EACH OF THE COLUMNS (THESE HEADERS MAY
15457C                 CONTAIN MULTIPLE LINES).
15458C              3) A TABLE OF NUMERIC/CHARACTER VALUES.  THIS IS A
15459C                 VARIANT OF TABLE 2 (WHICH ONLY ALLOWS TEXT FIELDS
15460C                 FOR THE FIRST COLUMN).
15461C
15462C              ITITL9     => THE OVERALL TITLE
15463C              IHEAD      => TABLE CAPTION
15464C              ITITLE     => LINES FOR THE COLUMN HEADERS
15465C              AVAL       => MATRIX OF NUMERIC VALUES FOR THE TABLE
15466C              ITEXT      => MATRIX OF CHARACTER VALUES FOR THE TABLE
15467C
15468C              NOTE: THIS IS A VARIANT OF DPDTA5 THAT ALLOWS THE
15469C                    THE TYPE FOR A COLUMN TO VARY BETWEEN ALPHABETIC
15470C                    AND NUMERIC FOR DIFFERENT ROWS.
15471C
15472C     WRITTEN BY--ALAN HECKERT
15473C                 STATISTICAL ENGINEERING DIVISION
15474C                 INFORMATION TECHNOLOGY LABORATORY
15475C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15476C                 GAITHERSBURG, MD 20899-8980
15477C                 PHONE--301-975-2899
15478C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15479C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15480C     LANGUAGE--ANSI FORTRAN (1977)
15481C     VERSION NUMBER--2012/3
15482C     ORIGINAL VERSION--MARCH     2012.
15483C     UPATED          --FEBRUARY  2020. CALL LIST TO DPTABY
15484C
15485C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
15486C
15487      CHARACTER*(*) IHEAD
15488      CHARACTER*(*) ITITL9
15489      CHARACTER*(*) ITITLE(MAXLIN,MAXCOL)
15490      CHARACTER*4   VALIGZ(*)
15491      CHARACTER*4   ALIGNZ(*)
15492      INTEGER       NCTITL(MAXLIN,MAXCOL)
15493      INTEGER       NCTEXT(MAXROW,MAXCOL)
15494      INTEGER       IDIGIT(*)
15495      INTEGER       NTOT(*)
15496      INTEGER       IWHTML(*)
15497      INTEGER       IWRTF(*)
15498      REAL          AVAL(MAXROW,MAXCOL)
15499      CHARACTER*(*) ITEXT(MAXROW,MAXCOL)
15500      CHARACTER*4   ITYPCO(MAXROW,MAXCOL)
15501      CHARACTER*4   ITYPC2(20)
15502C
15503      CHARACTER*4 ICAPSW
15504      CHARACTER*4 ICAPTY
15505      CHARACTER*4 ISUBRO
15506      CHARACTER*4 IBUGA3
15507      CHARACTER*4 IERROR
15508C
15509      CHARACTER*4 ISUBN1
15510      CHARACTER*4 ISUBN2
15511      CHARACTER*4 ISTEPN
15512      CHARACTER*4 ICSVWZ
15513      CHARACTER*1 IBASLC
15514C
15515      LOGICAL IFLAG1
15516      LOGICAL IFLAG2
15517      LOGICAL IFLAG3
15518      LOGICAL IFLAGA
15519      LOGICAL IFLAGB
15520      LOGICAL IFLAGS
15521      LOGICAL IFLAGE
15522      LOGICAL IFIRST
15523      LOGICAL ILAST
15524C
15525C---------------------------------------------------------------------
15526C
15527      INCLUDE 'DPCOST.INC'
15528C
15529      PARAMETER (MAXHED=1024)
15530      INTEGER IWIDTH(MAXHED)
15531      INTEGER NUMDIG(MAXHED)
15532      CHARACTER*8 ALIGN(MAXHED)
15533      CHARACTER*8 VALIGN(MAXHED)
15534      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
15535      CHARACTER*60 IVALUE(MAXHED)
15536      INTEGER      NCTEMP(MAXHED)
15537      REAL         AVALUE(MAXHED)
15538C
15539      CHARACTER*132 ITEMPC
15540C
15541      CHARACTER*4 IRTFMD
15542      COMMON/COMRTF/IRTFMD
15543C
15544C---------------------------------------------------------------------
15545C
15546      INCLUDE 'DPCOP2.INC'
15547C
15548C-----START POINT-----------------------------------------------------
15549C
15550      ISUBN1='DPDT'
15551      ISUBN2='A5  '
15552      IERROR='NO'
15553C
15554      DO40I=1,MAXHED
15555        IVALUE(I)=' '
15556        AVALUE(I)=0.0
15557        NCTEMP(I)=0
15558   40 CONTINUE
15559C
15560      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT5C')THEN
15561        WRITE(ICOUT,999)
15562  999   FORMAT(1X)
15563        CALL DPWRST('XXX','WRIT')
15564        WRITE(ICOUT,51)
15565   51   FORMAT('**** AT THE BEGINNING OF DPDT5C--')
15566        CALL DPWRST('XXX','WRIT')
15567        WRITE(ICOUT,52)IBUGA3,ISUBRO
15568   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
15569        CALL DPWRST('XXX','WRIT')
15570        WRITE(ICOUT,53)MAXLIN,MAXROW,NUMROW,NUMCOL,NUMLIN
15571   53   FORMAT('MAXLIN,MAXROW,NUMROW,NUMCOL,NUMLIN = ',5I8)
15572        CALL DPWRST('XXX','WRIT')
15573        IF(NUMLIN.GT.0)THEN
15574          DO54I=1,NUMLIN
15575            DO55J=1,NUMCOL
15576              IF(NCTITL(I,J).GT.0)THEN
15577                NTEMP=MIN(80,NCTITL(I,J))
15578                WRITE(ICOUT,56)I,J,NCTITL(I,J),ITITLE(I,J)(1:NTEMP)
15579   56           FORMAT('I,J,NCTITL(I,J),ITITL(I,J)(1:NCTITL) = ',
15580     1                 3I5,2X,A80)
15581                CALL DPWRST('XXX','WRIT')
15582              ENDIF
15583   55       CONTINUE
15584   54     CONTINUE
15585        ENDIF
15586        IF(NUMROW.GT.0)THEN
15587          DO57I=1,NUMROW
15588            WRITE(ICOUT,60)I,(AVAL(I,J),J=1,MIN(5,NUMCOL))
15589   60       FORMAT('I,(AVAL(I,J),J=1,NUMCOL) = ',I8,5G15.7)
15590            CALL DPWRST('XXX','WRIT')
15591   57     CONTINUE
15592          DO77I=1,NUMROW
15593          DO79J=1,NUMCOL
15594            WRITE(ICOUT,80)I,J,ITEXT(I,J)
15595   80       FORMAT('I,J,ITEXT(I,J) = ',2I5,2X,A60)
15596            CALL DPWRST('XXX','WRIT')
15597   79     CONTINUE
15598   77     CONTINUE
15599        ENDIF
15600        WRITE(ICOUT,62)NCHEAD
15601   62   FORMAT('NCHEAD = ',I5)
15602        CALL DPWRST('XXX','WRIT')
15603        IF(NCHEAD.GT.0)THEN
15604          WRITE(ICOUT,63)IHEAD(1:NCHEAD)
15605   63     FORMAT('NCHEAD,IHEAD = ',A80)
15606          CALL DPWRST('XXX','WRIT')
15607        ENDIF
15608      ENDIF
15609C
15610C               ******************************************
15611C               **   STEP 1--                           **
15612C               **   WRITE OUT THE TABLE HEADER.        **
15613C               **   NOTE THAT THIS MAY CONSIST OF      **
15614C               **   MULTIPLE LINES.                    **
15615C               ******************************************
15616C
15617      ISTEPN='1'
15618      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DT5C')
15619     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
15620C
15621      IF(IPRINT.EQ.'ON')THEN
15622C
15623        CALL DPCONA(92,IBASLC)
15624C
15625C       SKIP HEADER IF REQUESTED
15626C
15627        IF(.NOT.IFLAGS)GOTO199
15628C
15629        NHEAD=NUMCOL
15630C
15631        DO100I=1,NUMCOL
15632          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
15633            IWIDTH(I)=IWHTML(I)
15634            IF(VALIGZ(I).EQ.'b')THEN
15635              VALIGN(I)='BOTTOM'
15636            ELSEIF(VALIGZ(I).EQ.'c')THEN
15637              VALIGN(I)='CENTER'
15638            ELSEIF(VALIGZ(I).EQ.'t')THEN
15639              VALIGN(I)='TOP'
15640            ENDIF
15641            IF(ALIGNZ(I).EQ.'l')THEN
15642              ALIGN(I) ='LEFT'
15643            ELSEIF(ALIGNZ(I).EQ.'c')THEN
15644              ALIGN(I) ='CENTER'
15645            ELSEIF(ALIGNZ(I).EQ.'r')THEN
15646              ALIGN(I) ='RIGHT'
15647            ENDIF
15648C
15649          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
15650            IF(VALIGZ(I).EQ.'b')THEN
15651              VALIGN(I)='b'
15652            ELSEIF(VALIGZ(I).EQ.'c')THEN
15653              VALIGN(I)='c'
15654            ELSEIF(VALIGZ(I).EQ.'t')THEN
15655              VALIGN(I)='t'
15656            ENDIF
15657            IF(ALIGNZ(I).EQ.'l')THEN
15658              ALIGN(I) ='l'
15659            ELSEIF(ALIGNZ(I).EQ.'c')THEN
15660              ALIGN(I) ='c'
15661            ELSEIF(ALIGNZ(I).EQ.'r')THEN
15662              ALIGN(I) ='r'
15663            ENDIF
15664          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
15665            IWIDTH(I)=IWRTF(I)
15666            IF(VALIGZ(I).EQ.'b')THEN
15667              VALIGN(I)='b'
15668            ELSEIF(VALIGZ(I).EQ.'c')THEN
15669              VALIGN(I)='c'
15670            ELSEIF(VALIGZ(I).EQ.'t')THEN
15671              VALIGN(I)='t'
15672            ENDIF
15673            IF(ALIGNZ(I).EQ.'l')THEN
15674              ALIGN(I) ='l'
15675            ELSEIF(ALIGNZ(I).EQ.'c')THEN
15676              ALIGN(I) ='c'
15677            ELSEIF(ALIGNZ(I).EQ.'r')THEN
15678              ALIGN(I) ='r'
15679            ENDIF
15680          ELSE
15681            IF(VALIGZ(I).EQ.'b')THEN
15682              VALIGN(I)='b'
15683            ELSEIF(VALIGZ(I).EQ.'c')THEN
15684              VALIGN(I)='c'
15685            ELSEIF(VALIGZ(I).EQ.'t')THEN
15686              VALIGN(I)='t'
15687            ENDIF
15688            IF(ALIGNZ(I).EQ.'l')THEN
15689              ALIGN(I) ='l'
15690            ELSEIF(ALIGNZ(I).EQ.'c')THEN
15691              ALIGN(I) ='c'
15692            ELSEIF(ALIGNZ(I).EQ.'r')THEN
15693              ALIGN(I) ='r'
15694            ENDIF
15695          ENDIF
15696  100   CONTINUE
15697C
15698C       LOOP THROUGH THE LINES OF THE HEADER
15699C
15700        IF(NUMLIN.GE.1)THEN
15701          DO110I=1,NUMLIN
15702C
15703            DO120J=1,NUMCOL
15704              IVALUE(J)=' '
15705              NCTEMP(J)=0
15706              IF(NCTITL(I,J).GT.0)THEN
15707                NCTEMP(J)=NCTITL(I,J)
15708                IVALUE(J)(1:NCTEMP(J))=ITITLE(I,J)(1:NCTEMP(J))
15709              ENDIF
15710C
15711              IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT5C')THEN
15712                WRITE(ICOUT,106)I,J,NCTEMP(J),IVALUE(J)
15713  106           FORMAT('I,J,NCTEMP(J),IVALUE(J) = ',3I8,A80)
15714                CALL DPWRST('XXX','WRIT')
15715              ENDIF
15716C
15717  120       CONTINUE
15718C
15719            IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
15720              IF(I.EQ.1)THEN
15721                IFLAG1=.FALSE.
15722                IF(IFIRST)IFLAG1=.TRUE.
15723                IFLAG2=.TRUE.
15724                IF(NCTIT9.LE.0)THEN
15725                  IF(IFIRST)THEN
15726                    CALL DPHTM1(IHEAD,NCHEAD,IFLAG1,IFLAG2)
15727                  ELSE
15728                    CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,
15729     1                          IFLAG1,IFLAG2)
15730                  ENDIF
15731                ELSE
15732                  CALL DPHTMA(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1,IFLAG2)
15733                ENDIF
15734              ENDIF
15735              IFLAG1=.FALSE.
15736              IFLAG2=.FALSE.
15737              IF(I.EQ.1)IFLAG1=.TRUE.
15738              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
15739              CALL DPHTM4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2)
15740C
15741            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
15742C
15743              IF(I.EQ.1)THEN
15744                IF(IFIRST)THEN
15745                  IFLAG1=.FALSE.
15746                  IFLAG2=.FALSE.
15747                  IFLAG3=.TRUE.
15748                  CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
15749                ENDIF
15750                IFLAG1=.FALSE.
15751                IF(IFIRST)IFLAG1=.TRUE.
15752                IFLAG2=.TRUE.
15753C
15754                CALL DPDTLA(IHEAD,NCHEAD,NCT,ISUBRO,IBUGA3,IERROR)
15755                NCHEAD=NCT
15756C
15757                IF(NCTIT9.LE.0)THEN
15758                  ITEMPC=' '
15759                  NCHEA2=0
15760                  CALL DPLAT1(IHEAD,NCHEAD,ITEMPC,NCHEA2,IFLAG1)
15761                ELSE
15762                  CALL DPDTLA(ITITL9,NCTIT9,NCT,ISUBRO,IBUGA3,IERROR)
15763                  NCTIT9=NCT
15764                  CALL DPLAT1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
15765                ENDIF
15766              ENDIF
15767              IFLAG1=.FALSE.
15768              IFLAG2=.FALSE.
15769              IFLAG3=.FALSE.
15770              IF(I.EQ.1)IFLAG1=.TRUE.
15771              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
15772              IF(I.EQ.1)IFLAG3=.TRUE.
15773C
15774              DO6110JJ=1,NUMCOL
15775                CALL DPDTLA(IVALUE(JJ),NCTEMP(JJ),NCT,
15776     1                      ISUBRO,IBUGA3,IERROR)
15777                NCTEMP(JJ)=NCT
15778 6110         CONTINUE
15779C
15780              CALL DPLAT4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2,IFLAG3)
15781C
15782            ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
15783C
15784 8091         FORMAT(A1,'f',I1)
15785              IF(I.EQ.1)THEN
15786                IF(IRTFFP.EQ.'Times New Roman')THEN
15787                  ITEMP=0
15788                ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
15789                  ITEMP=6
15790                ELSEIF(IRTFFP.EQ.'Arial')THEN
15791                  ITEMP=2
15792                ELSEIF(IRTFFP.EQ.'Bookman')THEN
15793                  ITEMP=3
15794                ELSEIF(IRTFFP.EQ.'Georgia')THEN
15795                  ITEMP=4
15796                ELSEIF(IRTFFP.EQ.'Tahoma')THEN
15797                  ITEMP=5
15798                ELSEIF(IRTFFP.EQ.'Verdana')THEN
15799                  ITEMP=7
15800                ELSE
15801                  ITEMP=0
15802                ENDIF
15803C
15804                IRTFMD='OFF'
15805C
15806                IF(NCTIT9.GE.1.AND.I.EQ.1)THEN
15807                  IF(NCTIT9.LE.0)THEN
15808                    ITEMPC=' '
15809                    NCHEA2=0
15810                  ELSE
15811                    NCHEA2=NCTIT9+3
15812                    ITEMPC(4:NCHEA2)=ITITL9(1:NCTIT9)
15813                    ITEMPC(1:3)=' b '
15814                    ITEMPC(1:1)=IBASLC
15815                  ENDIF
15816                  IF(NCHEAD.GE.1)THEN
15817                    NCTEM2=NCHEAD+3
15818                    IHEAD(4:NCTEM2)=IHEAD(1:NCHEAD)
15819                    IHEAD(1:3)=' b '
15820                    IHEAD(1:1)=IBASLC
15821                  ELSE
15822                    NCTEM2=0
15823                  ENDIF
15824                  CALL DPRTF1(ITEMPC,NCHEA2,IHEAD,NCTEM2)
15825                ENDIF
15826              ENDIF
15827C
15828              DO130J=1,NUMCOL
15829                NCHAR=NCTEMP(J)+3
15830                IVALUE(J)(4:NCHAR)=IVALUE(J)(1:NCTEMP(J))
15831                IVALUE(J)(1:3)=' b '
15832                IVALUE(J)(1:1)=IBASLC
15833                NCTEMP(J)=NCHAR
15834  130         CONTINUE
15835              IFLAG1=.FALSE.
15836              IFLAG2=.FALSE.
15837              IF(I.EQ.1)IFLAG1=.TRUE.
15838              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
15839              CALL DPRTF4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2)
15840            ELSE
15841              IF(I.EQ.1)THEN
15842                IFLAG1=.TRUE.
15843                CALL DPTAB1(ITITL9,NCTIT9,IHEAD,NCHEAD,IFLAG1)
15844              ENDIF
15845              IFLAG1=.FALSE.
15846              IFLAG2=.FALSE.
15847              IF(I.EQ.1)IFLAG1=.TRUE.
15848              IF(I.EQ.NUMLIN)IFLAG2=.TRUE.
15849C
15850              DO 141 KK=1,NUMCOL
15851                IF(ALIGN(KK).EQ.'l' .AND. NCTEMP(KK).LT.NTOT(KK))THEN
15852                  DO146JJ=NCTEMP(KK)+1,NTOT(KK)
15853                    IVALUE(KK)(JJ:JJ)=' '
15854  146             CONTINUE
15855                  NCTEMP(KK)=NTOT(KK)
15856                ELSEIF(ALIGN(KK).EQ.'c'.AND.NCTEMP(KK).LT.NTOT(KK))THEN
15857                  IVALUE(KK)(NCTEMP(KK):NTOT(KK))=' '
15858                  IDIFF=(NTOT(KK)-NCTEMP(KK))/2
15859                  IF(IDIFF.GT.0)THEN
15860                    DO147JJ=NTOT(KK),IDIFF+1,-1
15861                      IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
15862  147               CONTINUE
15863                    IVALUE(KK)(1:IDIFF)=' '
15864                  ENDIF
15865                  NCTEMP(KK)=NTOT(KK)
15866                ELSEIF(ALIGN(KK).EQ.'r'.AND.NCTEMP(KK).LT.NTOT(KK))THEN
15867C
15868                  IF(ISUBRO.EQ.'DT5C' .OR. IBUGA3.EQ.'ON')THEN
15869                    WRITE(ICOUT,157)KK,NCTEMP(KK),NTOT(KK)
15870  157               FORMAT('BEFORE 148: KK,NCTEMP(KK),NTOT(KK) =',
15871     1                     3I8)
15872                    CALL DPWRST('XXX','WRIT')
15873                    WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
15874                    CALL DPWRST('XXX','WRIT')
15875                  ENDIF
15876C
15877                  IDIFF=NTOT(KK)-NCTEMP(KK)
15878                  DO148JJ=NTOT(KK),IDIFF+1,-1
15879                    IVALUE(KK)(JJ:JJ)=IVALUE(KK)(JJ-IDIFF:JJ-IDIFF)
15880  148             CONTINUE
15881                  IVALUE(KK)(1:IDIFF)=' '
15882                  NCTEMP(KK)=NTOT(KK)
15883                ENDIF
15884C
15885                IF(ISUBRO.EQ.'DT5C' .OR. IBUGA3.EQ.'ON')THEN
15886                  WRITE(ICOUT,151)KK,IDIFF,NCTEMP(KK),NUMCOL,NMAX
15887  151             FORMAT('BEFORE CALL DPTAB4: KK,IDIFF,NCTEMP(KK),',
15888     1                   'NUMCOL,NMAX=',5I8)
15889                  CALL DPWRST('XXX','WRIT')
15890                  WRITE(ICOUT,153)IVALUE(KK)(1:NCTEMP(KK))
15891  153             FORMAT('IVALUE(KK) = ',A80)
15892                  CALL DPWRST('XXX','WRIT')
15893                ENDIF
15894C
15895  141         CONTINUE
15896C
15897              CALL DPTAB4(IVALUE,NCTEMP,NUMCOL,IFLAG1,IFLAG2,NMAX)
15898C
15899            ENDIF
15900  110     CONTINUE
15901        ENDIF
15902C
15903  199   CONTINUE
15904C
15905C               ******************************************
15906C               **   STEP 2--                           **
15907C               **   WRITE OUT THE TABLE ROWS           **
15908C               ******************************************
15909C
15910        IFLAGA=.FALSE.
15911        IFLAGB=.FALSE.
15912        MAXLTA=35
15913        ILINE=0
15914        IF(NUMROW.GE.1)THEN
15915          DO200I=1,NUMROW
15916C
15917            DO201JJ=1,NUMCOL
15918              ITYPC2(JJ)=ITYPCO(I,JJ)
15919  201       CONTINUE
15920C
15921            IFLAG1=.FALSE.
15922            IF(I.EQ.NUMROW)IFLAG1=.TRUE.
15923            DO210J=1,NUMCOL
15924              AVALUE(J)=AVAL(I,J)
15925              IF(AVALUE(J).EQ.CPUMIN)THEN
15926                NUMDIG(J)=-99
15927              ELSE
15928                NUMDIG(J)=IDIGIT(J)
15929              ENDIF
15930              IVALUE(J)=' '
15931              NTEMP=NCTEXT(I,J)
15932              NCTEMP(J)=NTEMP
15933              IF(NTEMP.GT.0 .AND. ITYPC2(J).EQ.'ALPH')THEN
15934                IVALUE(J)(1:NTEMP)=ITEXT(I,J)(1:NTEMP)
15935C
15936                IF(ICAPTY.EQ.'LATE')THEN
15937                  CALL DPDTLA(IVALUE(J),NTEMP,NCT,ISUBRO,IBUGA3,IERROR)
15938                  NTEMP=NCT
15939                  NCTEMP(J)=NTEMP
15940                ENDIF
15941C
15942              ENDIF
15943C
15944              IF(ISUBRO.EQ.'DT5C' .OR. IBUGA3.EQ.'ON')THEN
15945                WRITE(ICOUT,211)I,J,ITYPC2(J),AVALUE(J),IVALUE(J)
15946  211           FORMAT('I,J,ITYPC2(J),AVALUE(J),IVALUE(J) = ',
15947     1                 2I8,2X,A4,2X,G15.7,2X,A60)
15948                CALL DPWRST('XXX','WRIT')
15949              ENDIF
15950C
15951  210       CONTINUE
15952C
15953            IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
15954              CALL DPHTMY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPC2,
15955     1                    IFLAGA,IFLAGB)
15956C
15957C           FOR LATEX, WE CANNOT EXTEND TABLES BEYOND A SINGLE
15958C           PAGE, SO PUT A CHECK IN.
15959C
15960            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
15961              CALL DPLATW(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPC2,
15962     1                    IFLAGA,IFLAGB)
15963              ILINE=ILINE+1
15964              IF(ILINE.EQ.MAXLTA .AND. I.NE.NUMROW)THEN
15965                ILINE=0
15966                IFLAG1=.TRUE.
15967                IFLAG2=.FALSE.
15968                IFLAG3=.TRUE.
15969                CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
15970                IFLAG1=.FALSE.
15971                IFLAG2=.FALSE.
15972                IFLAG3=.TRUE.
15973                CALL DPLATY(NHEAD)
15974              ENDIF
15975            ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
15976              CALL DPRTFY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPC2,
15977     1                    IFLAGA,IFLAGB)
15978            ELSE
15979C
15980              IF(ISUBRO.EQ.'DT5C' .OR. IBUGA3.EQ.'ON')THEN
15981                WRITE(ICOUT,251)I,NUMCOL,NMAX
15982  251           FORMAT('BEFORE CALL DPTABY: I,NUMCOL,NMAX = ',
15983     1                 3I5)
15984                CALL DPWRST('XXX','WRIT')
15985              ENDIF
15986C
15987              ICSVWZ='OFF'
15988              IVALT=-99
15989              CALL DPTABY(IVALUE,NCTEMP,AVALUE,NUMCOL,ITYPC2,
15990     1                    IFLAGA,IFLAGB,NMAX,NTOT,ICSVWZ,IVALT,
15991     1                    IBUGA3,ISUBRO)
15992            ENDIF
15993  200     CONTINUE
15994        ENDIF
15995C
15996C               *******************************************
15997C               **   STEP 3--                            **
15998C               **   TERMINATE THE TABLE                 **
15999C               *******************************************
16000C
16001        ISTEPN='2'
16002        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DT5C')
16003     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
16004C
16005        IF(.NOT.IFLAGE)GOTO399
16006C
16007        IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
16008          IFLAG1=.TRUE.
16009          IFLAG2=.FALSE.
16010          IF(ILAST)IFLAG2=.TRUE.
16011          CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
16012        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
16013          IFLAG1=.TRUE.
16014          IFLAG2=.FALSE.
16015          IFLAG3=.FALSE.
16016          IF(ILAST)THEN
16017            IFLAG2=.TRUE.
16018            IFLAG3=.TRUE.
16019          ENDIF
16020          CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
16021        ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
16022          IF(IRTFFF.EQ.'Courier New')THEN
16023            ITEMP=1
16024          ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
16025            ITEMP=8
16026          ENDIF
16027          WRITE(ICOUT,8091)IBASLC,ITEMP
16028          CALL DPWRST(ICOUT,'WRIT')
16029          CALL DPRTF6(NHEAD)
16030          CALL DPRTF6(NHEAD)
16031          IF(ILAST)THEN
16032            IRTFMD='VERB'
16033          ENDIF
16034        ELSE
16035          IF(ILAST)THEN
16036            WRITE(ICOUT,999)
16037            CALL DPWRST('XXX','WRIT')
16038          ENDIF
16039        ENDIF
16040C
16041  399   CONTINUE
16042C
16043      ENDIF
16044C
16045      RETURN
16046      END
16047      SUBROUTINE DPDTA6(COV,ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALOWSH,AUPPSH,
16048     1                  ALPHA,NUMALP,
16049     1                  ICAPSW,ICAPTY,NUMDIG,
16050     1                  ISUBRO,IBUGA3,IERROR)
16051C
16052C     PURPOSE--FOR VARIOUS 3-PARAMETER PROBABILITY DISTRIBUTIONS,
16053C              THIS SUBROUTINE PRINTS THE CONFIDENCE INTERVAL
16054C              TABLES FOR THE LOCATION, SCALE AND THE SHAPE PARAMETERS.
16055C              THIS IS CURRENTLY LIMITED TO THE NORMAL APPROXIMATION
16056C              METHOD.  IN ADDITION, IT WILL PRINT THE PARAMETER
16057C              VARIANCE-COVARIANCE MATRIX.
16058C
16059C     WRITTEN BY--ALAN HECKERT
16060C                 STATISTICAL ENGINEERING DIVISION
16061C                 INFORMATION TECHNOLOGY LABORATORY
16062C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16063C                 GAITHERSBURG, MD 20899-8980
16064C                 PHONE--301-975-2899
16065C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16066C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16067C     LANGUAGE--ANSI FORTRAN (1977)
16068C     VERSION NUMBER--2010/05
16069C     ORIGINAL VERSION--APRIL     2010
16070C
16071C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16072C
16073      CHARACTER*4 ICAPSW
16074      CHARACTER*4 ICAPTY
16075C
16076      CHARACTER*4 ISUBRO
16077      CHARACTER*4 IBUGA3
16078      CHARACTER*4 IERROR
16079      CHARACTER*4 ISUBN1
16080      CHARACTER*4 ISUBN2
16081C
16082C---------------------------------------------------------------------
16083C
16084      DIMENSION COV(3,3)
16085      DIMENSION ALPHA(*)
16086      DIMENSION ALOWLO(*)
16087      DIMENSION AUPPLO(*)
16088      DIMENSION ALOWSC(*)
16089      DIMENSION AUPPSC(*)
16090      DIMENSION ALOWSH(*)
16091      DIMENSION AUPPSH(*)
16092C
16093      INCLUDE 'DPCOST.INC'
16094C
16095      PARAMETER (MAXROW=10)
16096      CHARACTER*60 ITITLE
16097      CHARACTER*1  ITITL9
16098      CHARACTER*40 ITEXT(NUMALP)
16099      CHARACTER*4  ALIGN(NUMALP)
16100      CHARACTER*4  VALIGN(NUMALP)
16101      INTEGER      NCTEXT(MAXROW)
16102      INTEGER      IDIGIT(MAXROW)
16103      INTEGER      NTOT(MAXROW)
16104C
16105      PARAMETER(NUMCLI=5)
16106      PARAMETER(MAXLIN=3)
16107      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
16108      INTEGER      NCTIT2(MAXLIN,NUMCLI)
16109      INTEGER      IWHTML(NUMALP)
16110      INTEGER      IWRTF(NUMALP)
16111      REAL         AMAT(MAXROW,NUMCLI)
16112      LOGICAL IFRST
16113      LOGICAL ILAST
16114C
16115C---------------------------------------------------------------------
16116C
16117      INCLUDE 'DPCOP2.INC'
16118C
16119C-----START POINT-----------------------------------------------------
16120C
16121      ISUBN1='DPDT'
16122      ISUBN2='A6  '
16123      IERROR='NO'
16124C
16125      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA6')THEN
16126        WRITE(ICOUT,999)
16127  999   FORMAT(1X)
16128        CALL DPWRST('XXX','WRIT')
16129        WRITE(ICOUT,51)
16130   51   FORMAT('**** AT THE BEGINNING OF DPDTA6--')
16131        CALL DPWRST('XXX','WRIT')
16132        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMALP
16133   52   FORMAT('IBUGA3,ISUBRO,NUMALP = ',A4,2X,A4,2X,I8)
16134        CALL DPWRST('XXX','WRIT')
16135        DO56I=1,NUMALP
16136          WRITE(ICOUT,57)I,ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I),
16137     1                   ALOWSH(I),AUPPSH(I)
16138   57     FORMAT('I,ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I),',
16139     1           'ALOWSH(I),AUPPSH(I) = ',I8,6G15.7)
16140          CALL DPWRST('XXX','WRIT')
16141   56   CONTINUE
16142      ENDIF
16143C
16144      ITITLE(1:42)='Parameter Variance-Covariance Matrix'
16145      NCTITL=36
16146      NUMLIN=2
16147      NUMCOL=3
16148      NUMROW=3
16149      ITITL2(1,1)='Location'
16150      ITITL2(2,1)='Parameter'
16151      NCTIT2(1,1)=8
16152      NCTIT2(2,1)=9
16153      ITITL2(1,2)='Scale'
16154      ITITL2(2,2)='Parameter'
16155      NCTIT2(1,2)=5
16156      NCTIT2(2,2)=9
16157      ITITL2(1,3)='Shape'
16158      ITITL2(2,3)='Parameter'
16159      NCTIT2(1,3)=5
16160      NCTIT2(2,3)=9
16161C
16162      NMAX=0
16163      DO1121I=1,NUMCOL
16164        VALIGN(I)='b'
16165        ALIGN(I)='r'
16166        NTOT(I)=15
16167        NMAX=NMAX+NTOT(I)
16168        IDIGIT(I)=NUMDIG
16169 1121 CONTINUE
16170      DO1123I=1,NUMROW
16171        NCTEXT(I)=0
16172        AMAT(I,1)=COV(I,1)
16173        AMAT(I,2)=COV(I,2)
16174        AMAT(I,3)=COV(I,3)
16175 1123 CONTINUE
16176      IWHTML(1)=150
16177      IWHTML(2)=150
16178      IWHTML(3)=150
16179      IWHTML(4)=150
16180      IWRTF(1)=2000
16181      IWRTF(2)=IWRTF(1)+2000
16182      IWRTF(3)=IWRTF(2)+2000
16183      ITITL9=' '
16184      NCTIT9=0
16185      IFRST=.TRUE.
16186      ILAST=.TRUE.
16187C
16188      CALL DPDTA2(ITITLE,NCTITL,
16189     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
16190     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
16191     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMROW,
16192     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16193     1            ICAPSW,ICAPTY,IFRST,ILAST,
16194     1            ISUBRO,IBUGA3,IERROR)
16195C
16196      ITITLE(1:42)='Confidence Interval for Location Parameter'
16197      NCTITL=42
16198      NUMLIN=3
16199      NUMCOL=3
16200      ITITL2(1,1)=' '
16201      ITITL2(2,1)='Confidence'
16202      ITITL2(3,1)='Coefficient'
16203      NCTIT2(1,1)=0
16204      NCTIT2(2,1)=10
16205      NCTIT2(3,1)=11
16206      ITITL2(1,2)='Normal'
16207      ITITL2(2,2)='Lower'
16208      ITITL2(3,2)='Limit'
16209      NCTIT2(1,2)=6
16210      NCTIT2(2,2)=5
16211      NCTIT2(3,2)=5
16212      ITITL2(1,3)='Approximation'
16213      ITITL2(2,3)='Upper'
16214      ITITL2(3,3)='Limit'
16215      NCTIT2(1,3)=13
16216      NCTIT2(2,3)=5
16217      NCTIT2(3,3)=5
16218C
16219      NMAX=0
16220      DO1521I=1,NUMCOL
16221        VALIGN(I)='b'
16222        ALIGN(I)='r'
16223        NTOT(I)=15
16224        NMAX=NMAX+NTOT(I)
16225        IDIGIT(I)=NUMDIG
16226 1521 CONTINUE
16227      NTOT(1)=12
16228      IDIGIT(1)=2
16229      DO1523I=1,NUMALP
16230        NCTEXT(I)=0
16231        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
16232        AMAT(I,2)=ALOWLO(I)
16233        AMAT(I,3)=AUPPLO(I)
16234 1523 CONTINUE
16235      IWHTML(1)=150
16236      IWHTML(2)=150
16237      IWHTML(3)=150
16238      IWHTML(4)=150
16239      IWRTF(1)=2000
16240      IWRTF(2)=IWRTF(1)+2000
16241      IWRTF(3)=IWRTF(2)+2000
16242      ITITL9=' '
16243      NCTIT9=0
16244      IFRST=.TRUE.
16245      ILAST=.TRUE.
16246C
16247      CALL DPDTA2(ITITLE,NCTITL,
16248     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
16249     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
16250     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
16251     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16252     1            ICAPSW,ICAPTY,IFRST,ILAST,
16253     1            ISUBRO,IBUGA3,IERROR)
16254C
16255      ITITLE(1:39)='Confidence Interval for Scale Parameter'
16256      NCTITL=39
16257      NUMLIN=3
16258      NUMCOL=3
16259      ITITL2(1,1)=' '
16260      ITITL2(2,1)='Confidence'
16261      ITITL2(3,1)='Coefficient'
16262      NCTIT2(1,1)=0
16263      NCTIT2(2,1)=10
16264      NCTIT2(3,1)=11
16265      ITITL2(1,2)='Normal'
16266      ITITL2(2,2)='Lower'
16267      ITITL2(3,2)='Limit'
16268      NCTIT2(1,2)=6
16269      NCTIT2(2,2)=5
16270      NCTIT2(3,2)=5
16271      ITITL2(1,3)='Approximation'
16272      ITITL2(2,3)='Upper'
16273      ITITL2(3,3)='Limit'
16274      NCTIT2(1,3)=13
16275      NCTIT2(2,3)=5
16276      NCTIT2(3,3)=5
16277C
16278      NMAX=0
16279      DO2521I=1,NUMCOL
16280        VALIGN(I)='b'
16281        ALIGN(I)='r'
16282        NTOT(I)=15
16283        NMAX=NMAX+NTOT(I)
16284        IDIGIT(I)=NUMDIG
16285 2521 CONTINUE
16286      NTOT(1)=12
16287      IDIGIT(1)=2
16288      DO2523I=1,NUMALP
16289        NCTEXT(I)=0
16290        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
16291        AMAT(I,2)=ALOWSC(I)
16292        AMAT(I,3)=AUPPSC(I)
16293 2523 CONTINUE
16294      IWHTML(1)=150
16295      IWHTML(2)=150
16296      IWHTML(3)=150
16297      IWHTML(4)=150
16298      IWRTF(1)=2000
16299      IWRTF(2)=IWRTF(1)+2000
16300      IWRTF(3)=IWRTF(2)+2000
16301      ITITL9=' '
16302      NCTIT9=0
16303      IFRST=.TRUE.
16304      ILAST=.TRUE.
16305C
16306      CALL DPDTA2(ITITLE,NCTITL,
16307     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
16308     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
16309     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
16310     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16311     1            ICAPSW,ICAPTY,IFRST,ILAST,
16312     1            ISUBRO,IBUGA3,IERROR)
16313C
16314      ITITLE(1:39)='Confidence Interval for Shape Parameter'
16315      NCTITL=39
16316      DO2533I=1,NUMALP
16317        NCTEXT(I)=0
16318        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
16319        AMAT(I,2)=ALOWSH(I)
16320        AMAT(I,3)=AUPPSH(I)
16321 2533 CONTINUE
16322      IFRST=.TRUE.
16323      ILAST=.TRUE.
16324C
16325      CALL DPDTA2(ITITLE,NCTITL,
16326     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
16327     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
16328     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
16329     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16330     1            ICAPSW,ICAPTY,IFRST,ILAST,
16331     1            ISUBRO,IBUGA3,IERROR)
16332C
16333C               *****************
16334C               **  STEP 90--  **
16335C               **  EXIT       **
16336C               *****************
16337C
16338      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA6')THEN
16339        WRITE(ICOUT,999)
16340        CALL DPWRST('XXX','WRIT')
16341        WRITE(ICOUT,9011)
16342 9011   FORMAT('***** AT THE END       OF DPDTA6--')
16343        CALL DPWRST('XXX','WRIT')
16344      ENDIF
16345C
16346      RETURN
16347      END
16348      SUBROUTINE DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
16349     1                  ICAPSW,ICAPTY,NUMDIG,INORM,
16350     1                  ISUBRO,IBUGA3,IERROR)
16351C
16352C     PURPOSE--THIS ROUTINE PRINTS THE CONFIDENCE INTERVAL TABLES
16353C              FOR THE LOCATION AND SCALE PARAMETERS FOR
16354C              LOCATION/SCALE PROBABILITY DISTRIBUTIONS.
16355C     WRITTEN BY--ALAN HECKERT
16356C                 STATISTICAL ENGINEERING DIVISION
16357C                 INFORMATION TECHNOLOGY LABORATORY
16358C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16359C                 GAITHERSBURG, MD 20899-8980
16360C                 PHONE--301-975-2899
16361C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16362C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16363C     LANGUAGE--ANSI FORTRAN (1977)
16364C     VERSION NUMBER--2010/02
16365C     ORIGINAL VERSION--FEBRUARY  2010. EXTRACTED AS DISTINCT SUBROUTINE
16366C     UPDATED         --JUNE      2010. ADD "NORMAL APPROXIMATION"
16367C                                       TO TITLE LINE
16368C
16369C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16370C
16371      CHARACTER*4 ICAPSW
16372      CHARACTER*4 ICAPTY
16373      CHARACTER*4 INORM
16374      CHARACTER*4 ISUBRO
16375      CHARACTER*4 IBUGA3
16376      CHARACTER*4 IERROR
16377C
16378      CHARACTER*4 ISUBN1
16379      CHARACTER*4 ISUBN2
16380C
16381C---------------------------------------------------------------------
16382C
16383      DIMENSION ALPHA(*)
16384      DIMENSION ALOWSC(*)
16385      DIMENSION AUPPSC(*)
16386      DIMENSION ALOWLO(*)
16387      DIMENSION AUPPLO(*)
16388C
16389      INCLUDE 'DPCOST.INC'
16390C
16391      PARAMETER (MAXROW=10)
16392      CHARACTER*70 ITITLE
16393      CHARACTER*1  ITITL9
16394      CHARACTER*40 ITEXT(MAXROW)
16395      CHARACTER*4  ALIGN(NUMALP)
16396      CHARACTER*4  VALIGN(NUMALP)
16397      INTEGER      NCTEXT(MAXROW)
16398      INTEGER      IDIGIT(MAXROW)
16399      INTEGER      NTOT(MAXROW)
16400C
16401      PARAMETER(NUMCLI=3)
16402      PARAMETER(MAXLIN=2)
16403      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
16404      INTEGER      NCTIT2(MAXLIN,NUMCLI)
16405      INTEGER      IWHTML(NUMALP)
16406      INTEGER      IWRTF(NUMALP)
16407      REAL         AMAT(MAXROW,NUMCLI)
16408      LOGICAL IFRST
16409      LOGICAL ILAST
16410C
16411C---------------------------------------------------------------------
16412C
16413      INCLUDE 'DPCOP2.INC'
16414C
16415C-----START POINT-----------------------------------------------------
16416C
16417      ISUBN1='DPDT'
16418      ISUBN2='A7  '
16419      IERROR='NO'
16420C
16421      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA7')THEN
16422        WRITE(ICOUT,999)
16423  999   FORMAT(1X)
16424        CALL DPWRST('XXX','WRIT')
16425        WRITE(ICOUT,51)
16426   51   FORMAT('**** AT THE BEGINNING OF DPDTA7--')
16427        CALL DPWRST('XXX','WRIT')
16428        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMALP
16429   52   FORMAT('IBUGA3,ISUBRO,NUMALP = ',A4,2X,A4,2X,I5)
16430        CALL DPWRST('XXX','WRIT')
16431        DO56I=1,NUMALP
16432          WRITE(ICOUT,57)I,ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I)
16433   57     FORMAT('I,ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I) = ',
16434     1           I8,4G15.7)
16435          CALL DPWRST('XXX','WRIT')
16436   56   CONTINUE
16437      ENDIF
16438C
16439      ITITL9=' '
16440      NCTIT9=0
16441      ITITLE(1:42)='Confidence Interval for Location Parameter'
16442      IF(INORM.EQ.'YES')THEN
16443        ITITLE(43:65)=' (Normal Approximation)'
16444        NCTITL=65
16445      ELSE
16446        NCTITL=42
16447      ENDIF
16448      NUMLIN=2
16449      NUMCOL=3
16450      ITITL2(1,1)='Confidence'
16451      ITITL2(2,1)='Coefficient'
16452      ITITL2(1,2)='Lower'
16453      ITITL2(2,2)='Limit'
16454      ITITL2(1,3)='Upper'
16455      ITITL2(2,3)='Limit'
16456      NCTIT2(1,1)=10
16457      NCTIT2(2,1)=11
16458      NCTIT2(1,2)=5
16459      NCTIT2(2,2)=5
16460      NCTIT2(1,3)=5
16461      NCTIT2(2,3)=5
16462      NMAX=0
16463      DO2420I=1,NUMCOL
16464        VALIGN(I)=' '
16465        ALIGN(I)=' '
16466        NTOT(I)=0
16467        IDIGIT(I)=0
16468 2420 CONTINUE
16469      DO2421I=1,NUMCOL
16470        VALIGN(I)='b'
16471        ALIGN(I)='r'
16472        NTOT(I)=15
16473        NMAX=NMAX+NTOT(I)
16474        IDIGIT(I)=NUMDIG
16475 2421 CONTINUE
16476      IDIGIT(1)=2
16477      DO2423I=1,NUMALP
16478        NCTEXT(I)=0
16479        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
16480        AMAT(I,2)=ALOWLO(I)
16481        AMAT(I,3)=AUPPLO(I)
16482 2423 CONTINUE
16483      IWHTML(1)=150
16484      IWHTML(2)=150
16485      IWHTML(3)=150
16486      IWHTML(4)=150
16487      IWRTF(1)=2000
16488      IWRTF(2)=IWRTF(1)+2000
16489      IWRTF(3)=IWRTF(2)+2000
16490      IFRST=.TRUE.
16491      ILAST=.TRUE.
16492C
16493      IF(ALOWLO(1).EQ.CPUMIN)GOTO2999
16494C
16495      CALL DPDTA2(ITITL9,NCTIT9,
16496     1            ITITLE,NCTITL,ITITL2,NCTIT2,
16497     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
16498     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
16499     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16500     1            ICAPSW,ICAPTY,IFRST,ILAST,
16501     1            ISUBRO,IBUGA3,IERROR)
16502C
16503 2999 CONTINUE
16504C
16505      ITITLE(1:39)='Confidence Interval for Scale Parameter'
16506      IF(INORM.EQ.'YES')THEN
16507        ITITLE(40:62)=' (Normal Approximation)'
16508        NCTITL=62
16509      ELSE
16510        NCTITL=39
16511      ENDIF
16512      NMAX=0
16513      DO2521I=1,NUMCOL
16514        VALIGN(I)='b'
16515        ALIGN(I)='r'
16516        NTOT(I)=15
16517        NMAX=NMAX+NTOT(I)
16518        IDIGIT(I)=NUMDIG
16519 2521 CONTINUE
16520      IDIGIT(1)=2
16521      DO2523I=1,NUMALP
16522        NCTEXT(I)=0
16523        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
16524        AMAT(I,2)=ALOWSC(I)
16525        AMAT(I,3)=AUPPSC(I)
16526 2523 CONTINUE
16527      IWHTML(1)=150
16528      IWHTML(2)=150
16529      IWHTML(3)=150
16530      IWHTML(4)=150
16531      IWRTF(1)=2000
16532      IWRTF(2)=IWRTF(1)+2000
16533      IWRTF(3)=IWRTF(2)+2000
16534      IFRST=.TRUE.
16535      ILAST=.TRUE.
16536C
16537      CALL DPDTA2(ITITL9,NCTIT9,
16538     1            ITITLE,NCTITL,ITITL2,NCTIT2,
16539     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
16540     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
16541     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16542     1            ICAPSW,ICAPTY,IFRST,ILAST,
16543     1            ISUBRO,IBUGA3,IERROR)
16544C
16545C               *****************
16546C               **  STEP 90--  **
16547C               **  EXIT       **
16548C               *****************
16549C
16550      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA7')THEN
16551        WRITE(ICOUT,999)
16552        CALL DPWRST('XXX','WRIT')
16553        WRITE(ICOUT,9011)
16554 9011   FORMAT('***** AT THE END       OF DPDTA7--')
16555        CALL DPWRST('XXX','WRIT')
16556      ENDIF
16557C
16558      RETURN
16559      END
16560      SUBROUTINE DPDT77(ALOWLO,AUPPLO,ALOWSC,AUPPSC,
16561     1                  ALOWL2,AUPPL2,ALOWS2,AUPPS2,
16562     1                  ALPHA,NUMALP,
16563     1                  ICAPSW,ICAPTY,NUMDIG,
16564     1                  ISUBRO,IBUGA3,IERROR)
16565C
16566C     PURPOSE--THIS ROUTINE PRINTS THE CONFIDENCE INTERVAL TABLES
16567C              FOR THE LOCATION AND SCALE PARAMETERS FOR
16568C              LOCATION/SCALE PROBABILITY DISTRIBUTIONS.
16569C
16570C              THIS IS A VARIANT OF DPDTA7 THAT ALLOWS FOR BOTH
16571C              NORMAL APPROXIMATION AND FOR LIKELIHOOD RATIO
16572C              METHODS FOR COMPUTING CONFIDENCE INTERVALS.
16573C
16574C              IF ALOWLO(1) = CPUMIN, THEN SKIP LOCATION PARAMETER
16575C              (FOR 1-PARAMETER EXPONENTIAL, ETC.).
16576C
16577C     WRITTEN BY--JAMES J. FILLIBEN
16578C                 STATISTICAL ENGINEERING DIVISION
16579C                 INFORMATION TECHNOLOGY LABORATORY
16580C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16581C                 GAITHERSBURG, MD 20899-8980
16582C                 PHONE--301-975-2855
16583C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16584C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16585C     LANGUAGE--ANSI FORTRAN (1977)
16586C     VERSION NUMBER--2010/06
16587C     ORIGINAL VERSION--JUNE      2010. EXTRACTED AS DISTINCT SUBROUTINE
16588C
16589C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16590C
16591      CHARACTER*4 ICAPSW
16592      CHARACTER*4 ICAPTY
16593      CHARACTER*4 ISUBRO
16594      CHARACTER*4 IBUGA3
16595      CHARACTER*4 IERROR
16596C
16597      CHARACTER*4 ISUBN1
16598      CHARACTER*4 ISUBN2
16599C
16600C---------------------------------------------------------------------
16601C
16602      DIMENSION ALPHA(*)
16603      DIMENSION ALOWSC(*)
16604      DIMENSION AUPPSC(*)
16605      DIMENSION ALOWLO(*)
16606      DIMENSION AUPPLO(*)
16607      DIMENSION ALOWS2(*)
16608      DIMENSION AUPPS2(*)
16609      DIMENSION ALOWL2(*)
16610      DIMENSION AUPPL2(*)
16611C
16612      INCLUDE 'DPCOST.INC'
16613C
16614      PARAMETER (MAXROW=10)
16615      CHARACTER*60 ITITLE
16616      CHARACTER*1  ITITL9
16617      CHARACTER*40 ITEXT(MAXROW)
16618      CHARACTER*4  ALIGN(NUMALP)
16619      CHARACTER*4  VALIGN(NUMALP)
16620      INTEGER      NCTEXT(MAXROW)
16621      INTEGER      IDIGIT(MAXROW)
16622      INTEGER      NTOT(MAXROW)
16623C
16624      PARAMETER(NUMCLI=5)
16625      PARAMETER(MAXLIN=3)
16626      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
16627      INTEGER      NCTIT2(MAXLIN,NUMCLI)
16628      INTEGER      IWHTML(NUMALP)
16629      INTEGER      IWRTF(NUMALP)
16630      REAL         AMAT(MAXROW,NUMCLI)
16631      LOGICAL IFRST
16632      LOGICAL ILAST
16633C
16634C---------------------------------------------------------------------
16635C
16636      INCLUDE 'DPCOP2.INC'
16637C
16638C-----START POINT-----------------------------------------------------
16639C
16640      ISUBN1='DPDT'
16641      ISUBN2='A7  '
16642      IERROR='NO'
16643C
16644      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT77')THEN
16645        WRITE(ICOUT,999)
16646  999   FORMAT(1X)
16647        CALL DPWRST('XXX','WRIT')
16648        WRITE(ICOUT,51)
16649   51   FORMAT('**** AT THE BEGINNING OF DPDT77--')
16650        CALL DPWRST('XXX','WRIT')
16651        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMALP
16652   52   FORMAT('IBUGA3,ISUBRO,NUMALP = ',A4,2X,A4,2X,I5)
16653        CALL DPWRST('XXX','WRIT')
16654        DO56I=1,NUMALP
16655          WRITE(ICOUT,57)I,ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I)
16656   57     FORMAT('I,ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I) = ',
16657     1           I8,4G15.7)
16658          CALL DPWRST('XXX','WRIT')
16659          WRITE(ICOUT,58)I,ALOWL2(I),AUPPL2(I),ALOWS2(I),AUPPS2(I)
16660   58     FORMAT('I,ALOWL2(I),AUPPL2(I),ALOWS2(I),AUPPS2(I) = ',
16661     1           I8,4G15.7)
16662          CALL DPWRST('XXX','WRIT')
16663   56   CONTINUE
16664      ENDIF
16665C
16666      ITITL9=' '
16667      NCTIT9=0
16668      ITITLE(1:42)='Confidence Interval for Location Parameter'
16669      NCTITL=42
16670      NUMLIN=3
16671      NUMCOL=5
16672C
16673      ITITL2(1,1)=' '
16674      ITITL2(2,1)='Confidence'
16675      ITITL2(3,1)='Coefficient'
16676      NCTIT2(1,1)=0
16677      NCTIT2(2,1)=10
16678      NCTIT2(3,1)=11
16679      ITITL2(1,2)='Normal'
16680      ITITL2(2,2)='Lower'
16681      ITITL2(3,2)='Limit'
16682      NCTIT2(1,2)=6
16683      NCTIT2(2,2)=5
16684      NCTIT2(3,2)=5
16685      ITITL2(1,3)='Approximation'
16686      ITITL2(2,3)='Upper'
16687      ITITL2(3,3)='Limit'
16688      NCTIT2(1,3)=13
16689      NCTIT2(2,3)=5
16690      NCTIT2(3,3)=5
16691      ITITL2(1,4)='Likelihood Ratio'
16692      ITITL2(2,4)='Lower'
16693      ITITL2(3,4)='Limit'
16694      NCTIT2(1,4)=16
16695      NCTIT2(2,4)=5
16696      NCTIT2(3,4)=5
16697      ITITL2(1,5)='Approximation'
16698      ITITL2(2,5)='Upper'
16699      ITITL2(3,5)='Limit'
16700      NCTIT2(1,5)=13
16701      NCTIT2(2,5)=5
16702      NCTIT2(3,5)=5
16703C
16704      NMAX=0
16705      DO2521I=1,NUMCOL
16706        VALIGN(I)='b'
16707        ALIGN(I)='r'
16708        NTOT(I)=15
16709        IF(I.EQ.1)NTOT(I)=12
16710        IF(I.EQ.4)NTOT(I)=18
16711        NMAX=NMAX+NTOT(I)
16712        IDIGIT(I)=NUMDIG
16713 2521 CONTINUE
16714      IDIGIT(1)=2
16715      DO2523I=1,NUMALP
16716        NCTEXT(I)=0
16717        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
16718        AMAT(I,2)=ALOWLO(I)
16719        AMAT(I,3)=AUPPLO(I)
16720        AMAT(I,4)=ALOWL2(I)
16721        AMAT(I,5)=AUPPL2(I)
16722 2523 CONTINUE
16723      IWHTML(1)=150
16724      IWHTML(2)=150
16725      IWHTML(3)=150
16726      IWHTML(4)=150
16727      IWHTML(5)=150
16728      IWHTML(6)=150
16729      IWRTF(1)=2000
16730      IWRTF(2)=IWRTF(1)+2000
16731      IWRTF(3)=IWRTF(2)+2000
16732      IWRTF(4)=IWRTF(3)+2000
16733      IWRTF(5)=IWRTF(4)+2000
16734C
16735      IF(ALOWLO(1).EQ.CPUMIN)GOTO2999
16736C
16737      ITITL9=' '
16738      NCTIT9=0
16739      IFRST=.TRUE.
16740      ILAST=.TRUE.
16741      CALL DPDTA2(ITITL9,NCTIT9,
16742     1            ITITLE,NCTITL,ITITL2,NCTIT2,
16743     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
16744     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
16745     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16746     1            ICAPSW,ICAPTY,IFRST,ILAST,
16747     1            ISUBRO,IBUGA3,IERROR)
16748C
16749 2999 CONTINUE
16750C
16751      IF(ALOWSC(1).EQ.CPUMIN)GOTO3999
16752C
16753      ITITLE(1:39)='Confidence Interval for Scale Parameter'
16754      NCTITL=39
16755      NMAX=0
16756      DO3521I=1,NUMCOL
16757        VALIGN(I)='b'
16758        ALIGN(I)='r'
16759        NTOT(I)=15
16760        IF(I.EQ.1)NTOT(I)=12
16761        IF(I.EQ.4)NTOT(I)=18
16762        NMAX=NMAX+NTOT(I)
16763        IDIGIT(I)=NUMDIG
16764 3521 CONTINUE
16765      IDIGIT(1)=2
16766      DO3523I=1,NUMALP
16767        NCTEXT(I)=0
16768        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
16769        AMAT(I,2)=ALOWSC(I)
16770        AMAT(I,3)=AUPPSC(I)
16771        AMAT(I,4)=ALOWS2(I)
16772        AMAT(I,5)=AUPPS2(I)
16773 3523 CONTINUE
16774      IWHTML(1)=150
16775      IWHTML(2)=150
16776      IWHTML(3)=150
16777      IWHTML(4)=150
16778      IWHTML(5)=150
16779      IWHTML(6)=150
16780      IWRTF(1)=2000
16781      IWRTF(2)=IWRTF(1)+2000
16782      IWRTF(3)=IWRTF(2)+2000
16783      IWRTF(4)=IWRTF(3)+2000
16784      IWRTF(5)=IWRTF(4)+2000
16785C
16786      IFRST=.TRUE.
16787      ILAST=.TRUE.
16788      CALL DPDTA2(ITITL9,NCTIT9,
16789     1            ITITLE,NCTITL,ITITL2,NCTIT2,
16790     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
16791     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
16792     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16793     1            ICAPSW,ICAPTY,IFRST,ILAST,
16794     1            ISUBRO,IBUGA3,IERROR)
16795C
16796 3999 CONTINUE
16797C
16798C               *****************
16799C               **  STEP 90--  **
16800C               **  EXIT       **
16801C               *****************
16802C
16803      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT77')THEN
16804        WRITE(ICOUT,999)
16805        CALL DPWRST('XXX','WRIT')
16806        WRITE(ICOUT,9011)
16807 9011   FORMAT('***** AT THE END       OF DPDT77--')
16808        CALL DPWRST('XXX','WRIT')
16809      ENDIF
16810C
16811      RETURN
16812      END
16813      SUBROUTINE DPDTA8(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
16814     1                  ALOWSH,AUPPSH,ALOSH2,AUPSH2,ALPHA,NUMALP,
16815     1                  ICAPSW,ICAPTY,NUMDIG,ILIKFL,
16816     1                  ISUBRO,IBUGA3,IERROR)
16817C
16818C     PURPOSE--FOR VARIOUS 2-PARAMETER PROBABILITY DISTRIBUTIONS,
16819C              THIS SUBROUTINE PRINTS THE CONFIDENCE INTERVAL
16820C              TABLES FOR BOTH THE SCALE AND THE SHAPE PARAMETERS.
16821C              FOR SOME DISTRIBUTIONS, WE HAVE ONLY THE NORMAL
16822C              APPROXIMATION WHILE FOR OTHER DISTRIBUTIONS WE HAVE
16823C              BOTH THE NORMAL APPROXIMATION AND THE LIKELIHOOD
16824C              RATIO APPROXIMATION.
16825C
16826C              FOR THE LOGNORMAL, SLIGHTY DIFFERENT TABLE
16827C              HEADER FOR SCALE PARAMETER.  ALSO DIFFERENT
16828C              HEADER FOR PARETO.
16829C
16830C              MAKE SCALE PARAMETER OPTIONAL (E.G., FOR THE
16831C              POWER AND REFLECTED POWER DISTRIBUTIONS).
16832C
16833C              FOR THE 2-PARAMETER WEIBULL WHERE WE ARE ESTIMATING
16834C              A COMMON SHAPE PARAMETER, 1) DO NOT PRINT THE SCALE
16835C              TABLE AND 2) USE A SLIGHTLY DIFFERENT TITLE FOR
16836C              THE SHAPE PARAMETER.
16837C
16838C     WRITTEN BY--ALAN HECKERT
16839C                 STATISTICAL ENGINEERING DIVISION
16840C                 INFORMATION TECHNOLOGY LABORATORY
16841C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16842C                 GAITHERSBURG, MD 20899-8980
16843C                 PHONE--301-975-2899
16844C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16845C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16846C     LANGUAGE--ANSI FORTRAN (1977)
16847C     VERSION NUMBER--2010/02
16848C     ORIGINAL VERSION--FEBRUARY  2010. EXTRACTED AS A DISTINCT
16849C                                       SUBROUTINE
16850C     UPDATED         --APRIL     2010. HEADINGS FOR SCALE PARAMETER
16851C                                       FOR LOGNORMAL CASE
16852C     UPDATED         --JULY      2010. SLIGHT CORRECTION FOR
16853C                                       LOGNORMAL CASE
16854C     UPDATED         --JULY      2010. HEADINGS FOR CENSORED LOGNORMAL
16855C     UPDATED         --APRIL     2014. COMMON SHAPE FOR 2-PARAMETER
16856C                                       WEIBULL
16857C
16858C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
16859C
16860      CHARACTER*4 ICAPSW
16861      CHARACTER*4 ICAPTY
16862      CHARACTER*4 ILIKFL
16863C
16864      CHARACTER*4 ISUBRO
16865      CHARACTER*4 IBUGA3
16866      CHARACTER*4 IERROR
16867      CHARACTER*4 ISUBN1
16868      CHARACTER*4 ISUBN2
16869C
16870C---------------------------------------------------------------------
16871C
16872      DIMENSION ALPHA(*)
16873      DIMENSION ALOWSC(*)
16874      DIMENSION AUPPSC(*)
16875      DIMENSION ALOWS2(*)
16876      DIMENSION AUPPS2(*)
16877      DIMENSION ALOWSH(*)
16878      DIMENSION AUPPSH(*)
16879      DIMENSION ALOSH2(*)
16880      DIMENSION AUPSH2(*)
16881C
16882      INCLUDE 'DPCOST.INC'
16883C
16884      PARAMETER (MAXROW=10)
16885      CHARACTER*60 ITITLE
16886      CHARACTER*1  ITITL9
16887      CHARACTER*40 ITEXT(NUMALP)
16888      INTEGER      NCTEXT(MAXROW)
16889C
16890      PARAMETER(NUMCLI=5)
16891      PARAMETER(MAXLIN=3)
16892      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
16893      INTEGER      NCTIT2(MAXLIN,NUMCLI)
16894      INTEGER      IWHTML(NUMCLI+1)
16895      INTEGER      IWRTF(NUMCLI)
16896      INTEGER      IDIGIT(NUMCLI)
16897      INTEGER      NTOT(NUMCLI)
16898      CHARACTER*4  ALIGN(NUMCLI)
16899      CHARACTER*4  VALIGN(NUMCLI)
16900      REAL         AMAT(MAXROW,NUMCLI)
16901      LOGICAL IFRST
16902      LOGICAL ILAST
16903C
16904C---------------------------------------------------------------------
16905C
16906      INCLUDE 'DPCOP2.INC'
16907C
16908C-----START POINT-----------------------------------------------------
16909C
16910      ISUBN1='DPDT'
16911      ISUBN2='A8  '
16912      IERROR='NO'
16913C
16914      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA8')THEN
16915        WRITE(ICOUT,999)
16916  999   FORMAT(1X)
16917        CALL DPWRST('XXX','WRIT')
16918        WRITE(ICOUT,51)
16919   51   FORMAT('**** AT THE BEGINNING OF DPDTA8--')
16920        CALL DPWRST('XXX','WRIT')
16921        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMALP
16922   52   FORMAT('IBUGA3,ISUBRO,NUMALP = ',A4,2X,A4,2X,I8)
16923        CALL DPWRST('XXX','WRIT')
16924        DO56I=1,NUMALP
16925          WRITE(ICOUT,57)I,ALOWSC(I),AUPPSC(I),ALOWSH(I),AUPPSH(I)
16926   57     FORMAT('I,ALOWSC(I),AUPPSC(I),ALOWSH(I),AUPPSH(I) = ',
16927     1            I8,4G15.7)
16928          CALL DPWRST('XXX','WRIT')
16929          IF(ILIKFL.EQ.'ON')THEN
16930            WRITE(ICOUT,58)I,ALOWS2(I),AUPPS2(I),ALOSH2(I),AUPSH2(I)
16931   58       FORMAT('I,ALOWS2(I),AUPPS2(I),ALOSH2(I),AUPSH2(I) = ',
16932     1             I8,4G15.7)
16933            CALL DPWRST('XXX','WRIT')
16934          ENDIF
16935   56   CONTINUE
16936      ENDIF
16937C
16938      ITITLE(1:39)='Confidence Interval for Scale Parameter'
16939      NCTITL=39
16940      NUMLIN=3
16941      NUMCOL=5
16942      ITITL2(1,1)=' '
16943      ITITL2(2,1)='Confidence'
16944      ITITL2(3,1)='Coefficient'
16945      NCTIT2(1,1)=0
16946      NCTIT2(2,1)=10
16947      NCTIT2(3,1)=11
16948      IF(ILIKFL.EQ.'LOGN')THEN
16949        ITITL2(1,2)='Scale'
16950        ITITL2(2,2)='Lower'
16951        ITITL2(3,2)='Limit'
16952        NCTIT2(1,2)=5
16953        NCTIT2(2,2)=5
16954        NCTIT2(3,2)=5
16955        ITITL2(1,3)='Parameter'
16956        ITITL2(2,3)='Upper'
16957        ITITL2(3,3)='Limit'
16958        NCTIT2(1,3)=9
16959        NCTIT2(2,3)=5
16960        NCTIT2(3,3)=5
16961        ITITL2(1,4)='MU'
16962        ITITL2(2,4)='Lower'
16963        ITITL2(3,4)='Limit'
16964        NCTIT2(1,4)=2
16965        NCTIT2(2,4)=5
16966        NCTIT2(3,4)=5
16967        ITITL2(1,5)='Parameter'
16968        ITITL2(2,5)='Upper'
16969        ITITL2(3,5)='Limit'
16970        NCTIT2(1,5)=9
16971        NCTIT2(2,5)=5
16972        NCTIT2(3,5)=5
16973      ELSE
16974        ITITL2(1,2)='Normal'
16975        ITITL2(2,2)='Lower'
16976        ITITL2(3,2)='Limit'
16977        NCTIT2(1,2)=6
16978        NCTIT2(2,2)=5
16979        NCTIT2(3,2)=5
16980        ITITL2(1,3)='Approximation'
16981        ITITL2(2,3)='Upper'
16982        ITITL2(3,3)='Limit'
16983        NCTIT2(1,3)=13
16984        NCTIT2(2,3)=5
16985        NCTIT2(3,3)=5
16986        ITITL2(1,4)='Likelihood Ratio'
16987        ITITL2(2,4)='Lower'
16988        ITITL2(3,4)='Limit'
16989        NCTIT2(1,4)=16
16990        NCTIT2(2,4)=5
16991        NCTIT2(3,4)=5
16992        ITITL2(1,5)='Approximation'
16993        ITITL2(2,5)='Upper'
16994        ITITL2(3,5)='Limit'
16995        NCTIT2(1,5)=13
16996        NCTIT2(2,5)=5
16997        NCTIT2(3,5)=5
16998      ENDIF
16999C
17000      IF(ILIKFL.EQ.'OFF')NUMCOL=3
17001      IF(ILIKFL.EQ.'WCSH')NUMCOL=3
17002C
17003      NMAX=0
17004      DO2521I=1,NUMCOL
17005        VALIGN(I)='b'
17006        ALIGN(I)='r'
17007        NTOT(I)=15
17008        IF(I.EQ.1)NTOT(I)=12
17009        IF(I.EQ.4)NTOT(I)=18
17010        NMAX=NMAX+NTOT(I)
17011        IDIGIT(I)=NUMDIG
17012 2521 CONTINUE
17013      IDIGIT(1)=2
17014      DO2523I=1,NUMALP
17015        NCTEXT(I)=0
17016        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17017        AMAT(I,2)=ALOWSC(I)
17018        AMAT(I,3)=AUPPSC(I)
17019        AMAT(I,4)=ALOWS2(I)
17020        AMAT(I,5)=AUPPS2(I)
17021 2523 CONTINUE
17022      IWHTML(1)=150
17023      IWHTML(2)=150
17024      IWHTML(3)=150
17025      IWHTML(4)=150
17026      IWHTML(5)=150
17027      IWHTML(6)=150
17028      IWRTF(1)=2000
17029      IWRTF(2)=IWRTF(1)+2000
17030      IWRTF(3)=IWRTF(2)+2000
17031      IWRTF(4)=IWRTF(3)+2000
17032      IWRTF(5)=IWRTF(4)+2000
17033C
17034      ITITL9=' '
17035      NCTIT9=0
17036C
17037      IF(ILIKFL.EQ.'WCSH')GOTO2599
17038C
17039      IFRST=.TRUE.
17040      ILAST=.TRUE.
17041      IF(ALOWSC(1).NE.CPUMIN)THEN
17042        CALL DPDTA2(ITITLE,NCTITL,
17043     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
17044     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17045     1              ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
17046     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17047     1              ICAPSW,ICAPTY,IFRST,ILAST,
17048     1              ISUBRO,IBUGA3,IERROR)
17049      ENDIF
17050C
17051 2599 CONTINUE
17052C
17053      IF(ILIKFL.EQ.'LOGN')NUMCOL=3
17054      IF(ILIKFL.EQ.'WCSH')THEN
17055        ITITLE(1:46)='Confidence Interval for Common Shape Parameter'
17056        NCTITL=46
17057        NUMCOL=3
17058      ELSE
17059        ITITLE(1:39)='Confidence Interval for Shape Parameter'
17060        NCTITL=39
17061      ENDIF
17062C
17063C     ADJUST HEADERS FOR LOGNORMAL
17064C
17065      IF(ILIKFL.EQ.'LOGN')THEN
17066        NUMLIN=2
17067        NUMCOL=3
17068        ITITL2(1,1)='Confidence'
17069        ITITL2(2,1)='Coefficient'
17070        NCTIT2(1,1)=10
17071        NCTIT2(2,1)=11
17072        ITITL2(1,2)='Lower'
17073        ITITL2(1,2)='Limit'
17074        NCTIT2(1,2)=5
17075        NCTIT2(2,2)=5
17076        ITITL2(1,3)='Upper'
17077        ITITL2(2,3)='Limit'
17078        NCTIT2(1,3)=5
17079        NCTIT2(2,3)=5
17080      ELSEIF(ILIKFL.EQ.'WCSH')THEN
17081        NUMLIN=2
17082        NUMCOL=3
17083        ITITL2(1,1)='Confidence'
17084        ITITL2(2,1)='Coefficient'
17085        NCTIT2(1,1)=10
17086        NCTIT2(2,1)=11
17087        ITITL2(1,2)='Lower'
17088        ITITL2(2,2)='Limit'
17089        NCTIT2(1,2)=5
17090        NCTIT2(2,2)=5
17091        ITITL2(1,3)='Upper'
17092        ITITL2(2,3)='Limit'
17093        NCTIT2(1,3)=5
17094        NCTIT2(2,3)=5
17095      ENDIF
17096C
17097      DO2533I=1,NUMALP
17098        NCTEXT(I)=0
17099        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17100        AMAT(I,2)=ALOWSH(I)
17101        AMAT(I,3)=AUPPSH(I)
17102        AMAT(I,4)=ALOSH2(I)
17103        AMAT(I,5)=AUPSH2(I)
17104 2533 CONTINUE
17105      IFRST=.TRUE.
17106      ILAST=.TRUE.
17107C
17108      CALL DPDTA2(ITITLE,NCTITL,
17109     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
17110     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17111     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
17112     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17113     1            ICAPSW,ICAPTY,IFRST,ILAST,
17114     1            ISUBRO,IBUGA3,IERROR)
17115C
17116C               *****************
17117C               **  STEP 90--  **
17118C               **  EXIT       **
17119C               *****************
17120C
17121      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA8')THEN
17122        WRITE(ICOUT,999)
17123        CALL DPWRST('XXX','WRIT')
17124        WRITE(ICOUT,9011)
17125 9011   FORMAT('***** AT THE END       OF DPDTA8--')
17126        CALL DPWRST('XXX','WRIT')
17127      ENDIF
17128C
17129      RETURN
17130      END
17131      SUBROUTINE DPDT8A(ALOWLO,AUPPLO,ALOWSC,AUPPSC,
17132     1                  ALO1SH,AUP1SH,AL1SH2,AU1SH2,
17133     1                  ALO2SH,AUP2SH,AL2SH2,AU2SH2,
17134     1                  ALPHA,NUMALP,
17135     1                  ICAPSW,ICAPTY,NUMDIG,
17136     1                  ILOCFL,ISCAFL,ILIKFL,
17137     1                  ISHAP1,NCSHA1,ISHAP2,NCSHA2,
17138     1                  ISUBRO,IBUGA3,IERROR)
17139C
17140C     PURPOSE--FOR TWO SHAPE PARAMETER DISTRIBUTIONS, PRINT
17141C              CONFIDENCE INTERVALS FOR:
17142C
17143C                 1) LOCATION OR LOWER LIMIT PARAMETER
17144C                 2) SCALE OR UPPER LIMIT PARAMETER
17145C                 3) SHAPE ONE PARAMETER
17146C                 4) SHAPE TWO PARAMETER
17147C
17148C              THE LOCATION/SCALE PARAMETERS ARE OPTIONAL.
17149C              THE SHAPE PARAMETERS CAN OPTIONALLY PRINT
17150C              NORMAL APPROXIMATIONS AND LIKELIHOOD RATIO
17151C              APPROXIMATIONS.
17152C
17153C     WRITTEN BY--ALAN HECKERT
17154C                 STATISTICAL ENGINEERING DIVISION
17155C                 INFORMATION TECHNOLOGY LABORATORY
17156C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17157C                 GAITHERSBURG, MD 20899-8980
17158C                 PHONE--301-975-2855
17159C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17160C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17161C     LANGUAGE--ANSI FORTRAN (1977)
17162C     VERSION NUMBER--2010/07
17163C     ORIGINAL VERSION--JULY      2010. EXTRACTED AS A DISTINCT
17164C                                       SUBROUTINE
17165C
17166C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17167C
17168      CHARACTER*4 ICAPSW
17169      CHARACTER*4 ICAPTY
17170      CHARACTER*4 ILIKFL
17171      CHARACTER*4 ILOCFL
17172      CHARACTER*4 ISCAFL
17173      CHARACTER*8 ISHAP1
17174      CHARACTER*8 ISHAP2
17175C
17176      CHARACTER*4 ISUBRO
17177      CHARACTER*4 IBUGA3
17178      CHARACTER*4 IERROR
17179      CHARACTER*4 ISUBN1
17180      CHARACTER*4 ISUBN2
17181C
17182C---------------------------------------------------------------------
17183C
17184      DIMENSION ALPHA(*)
17185      DIMENSION ALOWLO(*)
17186      DIMENSION AUPPLO(*)
17187      DIMENSION ALOWSC(*)
17188      DIMENSION AUPPSC(*)
17189      DIMENSION ALO1SH(*)
17190      DIMENSION AUP1SH(*)
17191      DIMENSION AL1SH2(*)
17192      DIMENSION AU1SH2(*)
17193      DIMENSION ALO2SH(*)
17194      DIMENSION AUP2SH(*)
17195      DIMENSION AL2SH2(*)
17196      DIMENSION AU2SH2(*)
17197C
17198      INCLUDE 'DPCOST.INC'
17199C
17200      PARAMETER (MAXROW=10)
17201      CHARACTER*60 ITITLE
17202      CHARACTER*1  ITITL9
17203      CHARACTER*40 ITEXT(NUMALP)
17204      CHARACTER*4  ALIGN(NUMALP)
17205      CHARACTER*4  VALIGN(NUMALP)
17206      INTEGER      NCTEXT(MAXROW)
17207      INTEGER      IDIGIT(MAXROW)
17208      INTEGER      NTOT(MAXROW)
17209C
17210      PARAMETER(NUMCLI=5)
17211      PARAMETER(MAXLIN=3)
17212      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
17213      INTEGER      NCTIT2(MAXLIN,NUMCLI)
17214      INTEGER      IWHTML(NUMALP)
17215      INTEGER      IWRTF(NUMALP)
17216      REAL         AMAT(MAXROW,NUMCLI)
17217      LOGICAL IFRST
17218      LOGICAL ILAST
17219C
17220C---------------------------------------------------------------------
17221C
17222      INCLUDE 'DPCOP2.INC'
17223C
17224C-----START POINT-----------------------------------------------------
17225C
17226      ISUBN1='DPDT'
17227      ISUBN2='8A  '
17228      IERROR='NO'
17229C
17230      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT8A')THEN
17231        WRITE(ICOUT,999)
17232  999   FORMAT(1X)
17233        CALL DPWRST('XXX','WRIT')
17234        WRITE(ICOUT,51)
17235   51   FORMAT('**** AT THE BEGINNING OF DPDT8A--')
17236        CALL DPWRST('XXX','WRIT')
17237        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMALP
17238   52   FORMAT('IBUGA3,ISUBRO,NUMALP = ',A4,2X,A4,2X,I8)
17239        CALL DPWRST('XXX','WRIT')
17240        WRITE(ICOUT,53)ILIKFL,ILOCFL,ISCAFL,ISHAP1,ISHAP2
17241   53   FORMAT('ILIKFL,ILOCFL,ISCAFL,ISHAP1,ISHAP2 = ',3(A4,2X),
17242     1         A8,2X,A8)
17243        CALL DPWRST('XXX','WRIT')
17244        DO56I=1,NUMALP
17245          WRITE(ICOUT,57)I,ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I)
17246   57     FORMAT('I,ALOWLO(I),AUPPLO(I),ALOWSC(I),AUPPSC(I) = ',
17247     1            I8,4G15.7)
17248          CALL DPWRST('XXX','WRIT')
17249          WRITE(ICOUT,58)I,ALO1SH(I),AUP1SH(I),AL1SH2(I),AU1SH2(I)
17250   58     FORMAT('I,ALO1SH(I),AU1PSH(I),AL1SH2(I),AU1SH2(I) = ',
17251     1           I8,4G15.7)
17252          CALL DPWRST('XXX','WRIT')
17253          WRITE(ICOUT,59)I,ALO2SH(I),AUP2SH(I),AL2SH2(I),AU2SH2(I)
17254   59     FORMAT('I,ALO2SH(I),AU2PSH(I),AL2SH2(I),AU2SH2(I) = ',
17255     1           I8,4G15.7)
17256   56   CONTINUE
17257      ENDIF
17258C
17259      ITITL9=' '
17260      NCTIT9=0
17261C
17262      IF(ILOCFL.NE.'OFF')THEN
17263        ITITLE(1:42)='Confidence Interval for Location Parameter'
17264        NCTITL=42
17265        NUMLIN=3
17266        NUMCOL=3
17267        ITITL2(1,1)=' '
17268        ITITL2(2,1)='Confidence'
17269        ITITL2(3,1)='Coefficient'
17270        NCTIT2(1,1)=0
17271        NCTIT2(2,1)=10
17272        NCTIT2(3,1)=11
17273        ITITL2(1,2)='Normal'
17274        IF(ILOCFL.NE.'ON')ITITL2(1,2)=' '
17275        ITITL2(2,2)='Lower'
17276        ITITL2(3,2)='Limit'
17277        NCTIT2(1,2)=6
17278        IF(ILOCFL.NE.'ON')NCTIT2(1,2)=0
17279        NCTIT2(2,2)=5
17280        NCTIT2(3,2)=5
17281        ITITL2(1,3)='Approximation'
17282        IF(ILOCFL.NE.'ON')ITITL2(1,3)=' '
17283        ITITL2(2,3)='Upper'
17284        ITITL2(3,3)='Limit'
17285        NCTIT2(1,3)=13
17286        IF(ILOCFL.NE.'ON')NCTIT2(1,3)=0
17287        NCTIT2(2,3)=5
17288        NCTIT2(3,3)=5
17289C
17290        NMAX=0
17291        DO1521I=1,NUMCOL
17292          VALIGN(I)='b'
17293          ALIGN(I)='r'
17294          NTOT(I)=15
17295          IF(I.EQ.1)NTOT(I)=12
17296          NMAX=NMAX+NTOT(I)
17297          IDIGIT(I)=NUMDIG
17298 1521   CONTINUE
17299        IDIGIT(1)=2
17300        DO1523I=1,NUMALP
17301          NCTEXT(I)=0
17302          AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17303          AMAT(I,2)=ALOWLO(I)
17304          AMAT(I,3)=AUPPLO(I)
17305 1523   CONTINUE
17306        IWHTML(1)=150
17307        IWHTML(2)=150
17308        IWHTML(3)=150
17309        IWHTML(4)=150
17310        IWRTF(1)=2000
17311        IWRTF(2)=IWRTF(1)+2000
17312        IWRTF(3)=IWRTF(2)+2000
17313C
17314        IFRST=.TRUE.
17315        ILAST=.TRUE.
17316        CALL DPDTA2(ITITLE,NCTITL,
17317     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
17318     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17319     1              ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
17320     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17321     1              ICAPSW,ICAPTY,IFRST,ILAST,
17322     1              ISUBRO,IBUGA3,IERROR)
17323      ENDIF
17324C
17325      IF(ISCAFL.NE.'OFF')THEN
17326        ITITLE(1:39)='Confidence Interval for Scale Parameter'
17327        NCTITL=39
17328        NUMLIN=3
17329        NUMCOL=3
17330        ITITL2(1,1)=' '
17331        ITITL2(2,1)='Confidence'
17332        ITITL2(3,1)='Coefficient'
17333        NCTIT2(1,1)=0
17334        NCTIT2(2,1)=10
17335        NCTIT2(3,1)=11
17336        ITITL2(1,2)='Normal'
17337        IF(ISCAFL.NE.'ON')ITITL2(1,2)=' '
17338        ITITL2(2,2)='Lower'
17339        ITITL2(3,2)='Limit'
17340        NCTIT2(1,2)=6
17341        IF(ISCAFL.NE.'ON')NCTIT2(1,2)=0
17342        NCTIT2(2,2)=5
17343        NCTIT2(3,2)=5
17344        ITITL2(1,3)='Approximation'
17345        IF(ISCAFL.NE.'ON')ITITL2(1,3)=' '
17346        ITITL2(2,3)='Upper'
17347        ITITL2(3,3)='Limit'
17348        NCTIT2(1,3)=13
17349        IF(ISCAFL.NE.'ON')NCTIT2(1,3)=0
17350        NCTIT2(2,3)=5
17351        NCTIT2(3,3)=5
17352C
17353        NMAX=0
17354        DO2521I=1,NUMCOL
17355          VALIGN(I)='b'
17356          ALIGN(I)='r'
17357          NTOT(I)=15
17358          IF(I.EQ.1)NTOT(I)=12
17359          NMAX=NMAX+NTOT(I)
17360          IDIGIT(I)=NUMDIG
17361 2521   CONTINUE
17362        IDIGIT(1)=2
17363        DO2523I=1,NUMALP
17364          NCTEXT(I)=0
17365          AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17366          AMAT(I,2)=ALOWSC(I)
17367          AMAT(I,3)=AUPPSC(I)
17368 2523   CONTINUE
17369        IWHTML(1)=150
17370        IWHTML(2)=150
17371        IWHTML(3)=150
17372        IWHTML(4)=150
17373        IWRTF(1)=2000
17374        IWRTF(2)=IWRTF(1)+2000
17375        IWRTF(3)=IWRTF(2)+2000
17376C
17377        IFRST=.TRUE.
17378        ILAST=.TRUE.
17379        CALL DPDTA2(ITITLE,NCTITL,
17380     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
17381     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17382     1              ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
17383     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17384     1              ICAPSW,ICAPTY,IFRST,ILAST,
17385     1              ISUBRO,IBUGA3,IERROR)
17386      ENDIF
17387C
17388      ITITLE(1:40)='Confidence Interval for Shape Parameter '
17389      ITITLE(41:41+NCSHA1-1)=ISHAP1(1:NCSHA1)
17390      NCTITL=41+NCSHA1-1
17391      NUMLIN=3
17392      NUMCOL=5
17393      IF(ILIKFL.NE.'ON')NUMCOL=3
17394C
17395C     IF ILIKFL SET TO 'EXAC', THEN THIS IMPLIES WE HAVE
17396C     AN "EXACT" (AS OPPOSSED TO A NORMAL APPROXIMATION).
17397C     IN THIS CASE, WE ONLY USE A 2-LINE HEADER.
17398C
17399      ICNT=0
17400      IF(ILIKFL.NE.'EXAC')THEN
17401        ICNT=ICNT+1
17402        ITITL2(ICNT,1)=' '
17403        NCTIT2(ICNT,1)=0
17404        ITITL2(ICNT,2)='Normal'
17405        NCTIT2(ICNT,2)=6
17406        ITITL2(ICNT,3)='Approximation'
17407        NCTIT2(ICNT,3)=13
17408        ITITL2(ICNT,4)='Likelihood Ratio'
17409        NCTIT2(ICNT,4)=16
17410        ITITL2(ICNT,5)='Approximation'
17411        NCTIT2(ICNT,5)=13
17412      ELSE
17413        NUMLIN=2
17414      ENDIF
17415      ICNT=ICNT+1
17416      ITITL2(ICNT,1)='Confidence'
17417      NCTIT2(ICNT,1)=10
17418      ITITL2(ICNT,2)='Lower'
17419      NCTIT2(ICNT,2)=5
17420      ITITL2(ICNT,3)='Upper'
17421      NCTIT2(ICNT,3)=5
17422      ITITL2(ICNT,4)='Lower'
17423      NCTIT2(ICNT,4)=5
17424      ITITL2(ICNT,5)='Upper'
17425      NCTIT2(ICNT,5)=5
17426      ICNT=ICNT+1
17427      ITITL2(ICNT,1)='Coefficient'
17428      NCTIT2(ICNT,1)=11
17429      ITITL2(ICNT,2)='Limit'
17430      NCTIT2(ICNT,2)=5
17431      ITITL2(ICNT,3)='Limit'
17432      NCTIT2(ICNT,3)=5
17433      ITITL2(ICNT,4)='Limit'
17434      NCTIT2(ICNT,4)=5
17435      ITITL2(ICNT,5)='Limit'
17436      NCTIT2(ICNT,5)=5
17437C
17438      NMAX=0
17439      DO2621I=1,NUMCOL
17440        VALIGN(I)='b'
17441        ALIGN(I)='r'
17442        NTOT(I)=15
17443        IF(I.EQ.1)NTOT(I)=12
17444        NMAX=NMAX+NTOT(I)
17445        IDIGIT(I)=NUMDIG
17446 2621 CONTINUE
17447      IDIGIT(1)=2
17448C
17449      DO2533I=1,NUMALP
17450        NCTEXT(I)=0
17451        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17452        AMAT(I,2)=ALO1SH(I)
17453        AMAT(I,3)=AUP1SH(I)
17454        IF(ILIKFL.EQ.'ON')THEN
17455          AMAT(I,4)=AL1SH2(I)
17456          AMAT(I,5)=AU1SH2(I)
17457        ENDIF
17458 2533 CONTINUE
17459      IWHTML(1)=150
17460      IWHTML(2)=150
17461      IWHTML(3)=150
17462      IWHTML(4)=150
17463      IWHTML(5)=150
17464      IWHTML(6)=150
17465      IWRTF(1)=2000
17466      IWRTF(2)=IWRTF(1)+2000
17467      IWRTF(3)=IWRTF(2)+2000
17468      IWRTF(4)=IWRTF(3)+2000
17469      IWRTF(5)=IWRTF(4)+2000
17470C
17471      IFRST=.TRUE.
17472      ILAST=.TRUE.
17473C
17474      CALL DPDTA2(ITITLE,NCTITL,
17475     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
17476     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17477     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
17478     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17479     1            ICAPSW,ICAPTY,IFRST,ILAST,
17480     1            ISUBRO,IBUGA3,IERROR)
17481C
17482      ITITLE(1:40)='Confidence Interval for Shape Parameter '
17483      ITITLE(41:41+NCSHA2-1)=ISHAP2(1:NCSHA2)
17484      NCTITL=41+NCSHA2-1
17485C
17486      DO2543I=1,NUMALP
17487        NCTEXT(I)=0
17488        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17489        AMAT(I,2)=ALO2SH(I)
17490        AMAT(I,3)=AUP2SH(I)
17491        IF(ILIKFL.EQ.'ON')THEN
17492          AMAT(I,4)=AL2SH2(I)
17493          AMAT(I,5)=AU2SH2(I)
17494        ENDIF
17495 2543 CONTINUE
17496      IFRST=.TRUE.
17497      ILAST=.TRUE.
17498C
17499      CALL DPDTA2(ITITLE,NCTITL,
17500     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
17501     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17502     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
17503     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17504     1            ICAPSW,ICAPTY,IFRST,ILAST,
17505     1            ISUBRO,IBUGA3,IERROR)
17506C
17507C               *****************
17508C               **  STEP 90--  **
17509C               **  EXIT       **
17510C               *****************
17511C
17512      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT8A')THEN
17513        WRITE(ICOUT,999)
17514        CALL DPWRST('XXX','WRIT')
17515        WRITE(ICOUT,9011)
17516 9011   FORMAT('***** AT THE END       OF DPDT88--')
17517        CALL DPWRST('XXX','WRIT')
17518      ENDIF
17519C
17520      RETURN
17521      END
17522      SUBROUTINE DPDT8B(ALOWPA,AUPPPA,ALPHA,NUMALP,
17523     1                  ICAPSW,ICAPTY,NUMDIG,
17524     1                  ISUBRO,IBUGA3,IERROR)
17525C
17526C     PURPOSE--PRINT A PERCENTILE CONFIDENCE LIMIT BASED ON THE
17527C              BOOTSTRAP SAMPLES.  THIS HANDLES THE CASE WHEN WE
17528C              ARE A BOOTSTRAPPING A STATISTIC.  A DIFFERENT ROUTINE
17529C              HANDLES THE CASE WHEN WE ARE BOOTSTRAPPING A
17530C              DISTRIBUTIONAL MODEL.
17531C     WRITTEN BY--ALAN HECKERT
17532C                 STATISTICAL ENGINEERING DIVISION
17533C                 INFORMATION TECHNOLOGY LABORATORY
17534C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17535C                 GAITHERSBURG, MD 20899-8980
17536C                 PHONE--301-975-2899
17537C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17538C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17539C     LANGUAGE--ANSI FORTRAN (1977)
17540C     VERSION NUMBER--2010/07
17541C     ORIGINAL VERSION--JULY      2010.
17542C
17543C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17544C
17545      CHARACTER*4 ICAPSW
17546      CHARACTER*4 ICAPTY
17547C
17548      CHARACTER*4 ISUBRO
17549      CHARACTER*4 IBUGA3
17550      CHARACTER*4 IERROR
17551      CHARACTER*4 ISUBN1
17552      CHARACTER*4 ISUBN2
17553C
17554C---------------------------------------------------------------------
17555C
17556      DIMENSION ALPHA(*)
17557      DIMENSION ALOWPA(*)
17558      DIMENSION AUPPPA(*)
17559C
17560      INCLUDE 'DPCOST.INC'
17561C
17562      PARAMETER (MAXROW=10)
17563      CHARACTER*50 ITITLE
17564      CHARACTER*1  ITITL9
17565      CHARACTER*40 ITEXT(MAXROW)
17566      INTEGER      NCTEXT(MAXROW)
17567C
17568      PARAMETER(NUMCLI=3)
17569      PARAMETER(MAXLIN=2)
17570      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
17571      INTEGER      NCTIT2(MAXLIN,NUMCLI)
17572      INTEGER      IWHTML(NUMCLI+1)
17573      INTEGER      IWRTF(NUMCLI)
17574      INTEGER      IDIGIT(NUMCLI)
17575      INTEGER      NTOT(NUMCLI)
17576      CHARACTER*4  ALIGN(NUMCLI)
17577      CHARACTER*4  VALIGN(NUMCLI)
17578      REAL         AMAT(MAXROW,NUMCLI)
17579      LOGICAL IFRST
17580      LOGICAL ILAST
17581C
17582C---------------------------------------------------------------------
17583C
17584      INCLUDE 'DPCOP2.INC'
17585C
17586C-----START POINT-----------------------------------------------------
17587C
17588      ISUBN1='DPDT'
17589      ISUBN2='8B  '
17590      IERROR='NO'
17591C
17592      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT8B')THEN
17593        WRITE(ICOUT,999)
17594  999   FORMAT(1X)
17595        CALL DPWRST('XXX','WRIT')
17596        WRITE(ICOUT,51)
17597   51   FORMAT('**** AT THE BEGINNING OF DPDT8B--')
17598        CALL DPWRST('XXX','WRIT')
17599        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMALP
17600   52   FORMAT('IBUGA3,ISUBRO,NUMALP = ',A4,2X,A4,2X,I8)
17601        CALL DPWRST('XXX','WRIT')
17602        DO56I=1,NUMALP
17603          WRITE(ICOUT,57)I,ALOWPA(I),AUPPPA(I)
17604   57     FORMAT('I,ALOWSC(I),AUPPSC(I) = ',I8,2G15.7)
17605          CALL DPWRST('XXX','WRIT')
17606   56   CONTINUE
17607      ENDIF
17608C
17609      ITITLE(1:44)='Percentile Confidence Interval for Statistic'
17610      NCTITL=44
17611      NUMLIN=2
17612      NUMCOL=3
17613      ITITL2(1,1)='Confidence'
17614      ITITL2(2,1)='Coefficient'
17615      NCTIT2(1,1)=10
17616      NCTIT2(2,1)=11
17617      ITITL2(1,2)='Lower'
17618      ITITL2(2,2)='Limit'
17619      NCTIT2(1,2)=5
17620      NCTIT2(2,2)=5
17621      ITITL2(1,3)='Upper'
17622      ITITL2(2,3)='Limit'
17623      NCTIT2(1,3)=5
17624      NCTIT2(2,3)=5
17625C
17626      NMAX=0
17627      DO2521I=1,NUMCLI
17628        VALIGN(I)='b'
17629        ALIGN(I)='r'
17630        NTOT(I)=15
17631        IF(I.EQ.1)NTOT(1)=12
17632        NMAX=NMAX+NTOT(I)
17633        IDIGIT(I)=NUMDIG
17634 2521 CONTINUE
17635      IDIGIT(1)=2
17636      DO2523I=1,NUMALP
17637        NCTEXT(I)=0
17638        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17639        AMAT(I,2)=ALOWPA(I)
17640        AMAT(I,3)=AUPPPA(I)
17641 2523 CONTINUE
17642      IWHTML(1)=150
17643      IWHTML(2)=150
17644      IWHTML(3)=150
17645      IWHTML(4)=150
17646      IWRTF(1)=2000
17647      IWRTF(2)=IWRTF(1)+2000
17648      IWRTF(3)=IWRTF(2)+2000
17649C
17650      ITITL9=' '
17651      NCTIT9=0
17652      IFRST=.TRUE.
17653      ILAST=.TRUE.
17654      CALL DPDTA2(ITITLE,NCTITL,
17655     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
17656     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17657     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
17658     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17659     1            ICAPSW,ICAPTY,IFRST,ILAST,
17660     1            ISUBRO,IBUGA3,IERROR)
17661C
17662C               *****************
17663C               **  STEP 90--  **
17664C               **  EXIT       **
17665C               *****************
17666C
17667      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT8B')THEN
17668        WRITE(ICOUT,999)
17669        CALL DPWRST('XXX','WRIT')
17670        WRITE(ICOUT,9011)
17671 9011   FORMAT('***** AT THE END       OF DPDT8B--')
17672        CALL DPWRST('XXX','WRIT')
17673      ENDIF
17674C
17675      RETURN
17676      END
17677      SUBROUTINE DPDT8C(ALOWPA,AUPPPA,ALPHA,NUMALP,
17678     1                  ICAPSW,ICAPTY,NUMDIG,IPAR,NCPAR,
17679     1                  ISUBRO,IBUGA3,IERROR)
17680C
17681C     PURPOSE--PRINT A PERCENTILE CONFIDENCE LIMIT BASED ON THE
17682C              BOOTSTRAP SAMPLES.  THIS HANDLES THE CASE WHEN WE
17683C              ARE A BOOTSTRAPPING A DISTRIBUTIONAL MODEL.  A DIFFERENT
17684C              ROUTINE HANDLES THE CASE WHEN WE ARE BOOTSTRAPPING A
17685C              STATISTIC.
17686C     WRITTEN BY--ALAN HECKERT
17687C                 STATISTICAL ENGINEERING DIVISION
17688C                 INFORMATION TECHNOLOGY LABORATORY
17689C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17690C                 GAITHERSBURG, MD 20899-8980
17691C                 PHONE--301-975-2899
17692C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17693C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17694C     LANGUAGE--ANSI FORTRAN (1977)
17695C     VERSION NUMBER--2010/07
17696C     ORIGINAL VERSION--JULY      2010.
17697C
17698C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17699C
17700      CHARACTER*4 ICAPSW
17701      CHARACTER*4 ICAPTY
17702      CHARACTER*(*) IPAR
17703C
17704      CHARACTER*4 ISUBRO
17705      CHARACTER*4 IBUGA3
17706      CHARACTER*4 IERROR
17707      CHARACTER*4 ISUBN1
17708      CHARACTER*4 ISUBN2
17709C
17710C---------------------------------------------------------------------
17711C
17712      DIMENSION ALPHA(*)
17713      DIMENSION ALOWPA(*)
17714      DIMENSION AUPPPA(*)
17715C
17716      INCLUDE 'DPCOST.INC'
17717C
17718      PARAMETER (MAXROW=10)
17719      CHARACTER*60 ITITLE
17720      CHARACTER*1  ITITL9
17721      CHARACTER*40 ITEXT(MAXROW)
17722      INTEGER      NCTEXT(MAXROW)
17723C
17724      PARAMETER(NUMCLI=3)
17725      PARAMETER(MAXLIN=2)
17726      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
17727      INTEGER      NCTIT2(MAXLIN,NUMCLI)
17728      INTEGER      IWHTML(NUMCLI+1)
17729      INTEGER      IWRTF(NUMCLI)
17730      INTEGER      IDIGIT(NUMCLI)
17731      INTEGER      NTOT(NUMCLI)
17732      CHARACTER*4  ALIGN(NUMCLI)
17733      CHARACTER*4  VALIGN(NUMCLI)
17734      REAL         AMAT(MAXROW,NUMCLI)
17735      LOGICAL IFRST
17736      LOGICAL ILAST
17737C
17738C---------------------------------------------------------------------
17739C
17740      INCLUDE 'DPCOP2.INC'
17741C
17742C-----START POINT-----------------------------------------------------
17743C
17744      ISUBN1='DPDT'
17745      ISUBN2='8C  '
17746      IERROR='NO'
17747C
17748      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT8C')THEN
17749        WRITE(ICOUT,999)
17750  999   FORMAT(1X)
17751        CALL DPWRST('XXX','WRIT')
17752        WRITE(ICOUT,51)
17753   51   FORMAT('**** AT THE BEGINNING OF DPDT8C--')
17754        CALL DPWRST('XXX','WRIT')
17755        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMALP
17756   52   FORMAT('IBUGA3,ISUBRO,NUMALP = ',A4,2X,A4,2X,I8)
17757        CALL DPWRST('XXX','WRIT')
17758        DO56I=1,NUMALP
17759          WRITE(ICOUT,57)I,ALOWPA(I),AUPPPA(I)
17760   57     FORMAT('I,ALOWSC(I),AUPPSC(I) = ',I8,2G15.7)
17761          CALL DPWRST('XXX','WRIT')
17762   56   CONTINUE
17763      ENDIF
17764C
17765      ITITLE(1:35)='Percentile Confidence Interval for '
17766      NSTRT=36
17767      NCTITL=NSTRT+NCPAR-1
17768      ITITLE(NSTRT:NCTITL)=IPAR(1:NCPAR)
17769C
17770      NUMLIN=2
17771      NUMCOL=3
17772      ITITL2(1,1)='Confidence'
17773      ITITL2(2,1)='Coefficient'
17774      NCTIT2(1,1)=10
17775      NCTIT2(2,1)=11
17776      ITITL2(1,2)='Lower'
17777      ITITL2(2,2)='Limit'
17778      NCTIT2(1,2)=5
17779      NCTIT2(2,2)=5
17780      ITITL2(1,3)='Upper'
17781      ITITL2(2,3)='Limit'
17782      NCTIT2(1,3)=5
17783      NCTIT2(2,3)=5
17784C
17785      NMAX=0
17786      DO2521I=1,NUMCLI
17787        VALIGN(I)='b'
17788        ALIGN(I)='r'
17789        NTOT(I)=15
17790        IF(I.EQ.1)NTOT(I)=12
17791        NMAX=NMAX+NTOT(I)
17792        IDIGIT(I)=NUMDIG
17793 2521 CONTINUE
17794      IDIGIT(1)=2
17795      DO2523I=1,NUMALP
17796        NCTEXT(I)=0
17797        ITEXT(I)=' '
17798        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17799        AMAT(I,2)=ALOWPA(I)
17800        AMAT(I,3)=AUPPPA(I)
17801 2523 CONTINUE
17802      IWHTML(1)=150
17803      IWHTML(2)=150
17804      IWHTML(3)=150
17805      IWHTML(4)=150
17806      IWRTF(1)=2000
17807      IWRTF(2)=IWRTF(1)+2000
17808      IWRTF(3)=IWRTF(2)+2000
17809C
17810      ITITL9=' '
17811      NCTIT9=0
17812      IFRST=.TRUE.
17813      ILAST=.TRUE.
17814      CALL DPDTA2(ITITLE,NCTITL,
17815     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
17816     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
17817     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
17818     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17819     1            ICAPSW,ICAPTY,IFRST,ILAST,
17820     1            ISUBRO,IBUGA3,IERROR)
17821C
17822C               *****************
17823C               **  STEP 90--  **
17824C               **  EXIT       **
17825C               *****************
17826C
17827      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT8C')THEN
17828        WRITE(ICOUT,999)
17829        CALL DPWRST('XXX','WRIT')
17830        WRITE(ICOUT,9011)
17831 9011   FORMAT('***** AT THE END       OF DPDT8C--')
17832        CALL DPWRST('XXX','WRIT')
17833      ENDIF
17834C
17835      RETURN
17836      END
17837      SUBROUTINE DPDT8D(ALOWSC,AUPPSC,ALOWS2,AUPPS2,
17838     1                  ALOWMU,AUPPMU,ALOWM2,AUPPM2,
17839     1                  ALOWSH,AUPPSH,ALOSH2,AUPSH2,ALPHA,NUMALP,
17840     1                  ICAPSW,ICAPTY,NUMDIG,ILIKFL,
17841     1                  ISUBRO,IBUGA3,IERROR)
17842C
17843C     PURPOSE--THIS IS A VARIANT OF "DPDTA8" USED FOR THE CENSORED
17844C              2-PARAMETER LOGNORMAL CASE.  THIS SUBROUTINE PRINTS
17845C              THE CONFIDENCE INTERVAL TABLES FOR BOTH THE SCALE AND
17846C              THE SHAPE PARAMETERS.  FOR THE SCALE, WE ALSO GENERATE
17847C              THE CONFIDENCE INTERVAL FOR MU (=LOG(SCALE)) USING BOTH
17848C              THE NORMAL APPROXIMATION AND THE LIKELIHOOD RATIO METHOD.
17849C
17850C     WRITTEN BY--ALAN HECKERT
17851C                 STATISTICAL ENGINEERING DIVISION
17852C                 INFORMATION TECHNOLOGY LABORATORY
17853C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17854C                 GAITHERSBURG, MD 20899-8980
17855C                 PHONE--301-975-2899
17856C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17857C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17858C     LANGUAGE--ANSI FORTRAN (1977)
17859C     VERSION NUMBER--2010/07
17860C     ORIGINAL VERSION--JULY      2010.
17861C
17862C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17863C
17864      CHARACTER*4 ICAPSW
17865      CHARACTER*4 ICAPTY
17866      CHARACTER*4 ILIKFL
17867C
17868      CHARACTER*4 ISUBRO
17869      CHARACTER*4 IBUGA3
17870      CHARACTER*4 IERROR
17871      CHARACTER*4 ISUBN1
17872      CHARACTER*4 ISUBN2
17873C
17874C---------------------------------------------------------------------
17875C
17876      DIMENSION ALPHA(*)
17877      DIMENSION ALOWSC(*)
17878      DIMENSION AUPPSC(*)
17879      DIMENSION ALOWS2(*)
17880      DIMENSION AUPPS2(*)
17881      DIMENSION ALOWMU(*)
17882      DIMENSION AUPPMU(*)
17883      DIMENSION ALOWM2(*)
17884      DIMENSION AUPPM2(*)
17885      DIMENSION ALOWSH(*)
17886      DIMENSION AUPPSH(*)
17887      DIMENSION ALOSH2(*)
17888      DIMENSION AUPSH2(*)
17889C
17890      INCLUDE 'DPCOST.INC'
17891C
17892      PARAMETER (MAXROW=10)
17893      CHARACTER*60 ITITLE
17894      CHARACTER*40 ITITL9
17895      CHARACTER*40 ITEXT(NUMALP)
17896      INTEGER      NCTEXT(MAXROW)
17897C
17898      PARAMETER(NUMCLI=5)
17899      PARAMETER(MAXLIN=3)
17900      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
17901      INTEGER      NCTIT2(MAXLIN,NUMCLI)
17902      INTEGER      IWHTML(NUMCLI+1)
17903      INTEGER      IWRTF(NUMCLI)
17904      INTEGER      IDIGIT(NUMCLI)
17905      INTEGER      NTOT(NUMCLI)
17906      CHARACTER*4  ALIGN(NUMCLI)
17907      CHARACTER*4  VALIGN(NUMCLI)
17908      REAL         AMAT(MAXROW,NUMCLI)
17909      LOGICAL IFRST
17910      LOGICAL ILAST
17911C---------------------------------------------------------------------
17912C
17913      INCLUDE 'DPCOP2.INC'
17914C
17915C-----START POINT-----------------------------------------------------
17916C
17917      ISUBN1='DPDT'
17918      ISUBN2='A8  '
17919      IERROR='NO'
17920C
17921      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT8D')THEN
17922        WRITE(ICOUT,999)
17923  999   FORMAT(1X)
17924        CALL DPWRST('XXX','WRIT')
17925        WRITE(ICOUT,51)
17926   51   FORMAT('**** AT THE BEGINNING OF DPDT8D--')
17927        CALL DPWRST('XXX','WRIT')
17928        WRITE(ICOUT,52)IBUGA3,ISUBRO,NUMALP
17929   52   FORMAT('IBUGA3,ISUBRO,NUMALP = ',A4,2X,A4,2X,I8)
17930        CALL DPWRST('XXX','WRIT')
17931        DO56I=1,NUMALP
17932          WRITE(ICOUT,57)I,ALOWSC(I),AUPPSC(I),ALOWS2(I),AUPPS2(I)
17933   57     FORMAT('I,ALOWSC(I),AUPPSC(I),ALOWSH(I),AUPPSH(I) = ',
17934     1            I8,4G15.7)
17935          CALL DPWRST('XXX','WRIT')
17936          WRITE(ICOUT,58)I,ALOWMU(I),AUPPMU(I),ALOWM2(I),AUPPM2(I)
17937   58     FORMAT('I,ALOWMU(I),AUPPMU(I),ALOWM2(I),AUPPM2(I) = ',
17938     1            I8,4G15.7)
17939          CALL DPWRST('XXX','WRIT')
17940          WRITE(ICOUT,59)I,ALOWSH(I),AUPPSH(I),ALOSH2(I),AUPSH2(I)
17941   59     FORMAT('I,ALOWSH(I),AUPPSH(I),ALOSH2(I),AUPSH2(I) = ',
17942     1           I8,4G15.7)
17943          CALL DPWRST('XXX','WRIT')
17944   56   CONTINUE
17945      ENDIF
17946C
17947      ITITLE(1:39)='Confidence Interval for Scale Parameter'
17948      NCTITL=39
17949      ITITL9(1:20)='Normal Approximation'
17950      NCTIT9=20
17951      NUMLIN=3
17952      NUMCOL=5
17953      ITITL2(1,1)=' '
17954      ITITL2(2,1)='Confidence'
17955      ITITL2(3,1)='Coefficient'
17956      NCTIT2(1,1)=0
17957      NCTIT2(2,1)=10
17958      NCTIT2(3,1)=11
17959      ITITL2(1,2)='Scale'
17960      ITITL2(2,2)='Lower'
17961      ITITL2(3,2)='Limit'
17962      NCTIT2(1,2)=5
17963      NCTIT2(2,2)=5
17964      NCTIT2(3,2)=5
17965      ITITL2(1,3)='Parameter'
17966      ITITL2(2,3)='Upper'
17967      ITITL2(3,3)='Limit'
17968      NCTIT2(1,3)=9
17969      NCTIT2(2,3)=5
17970      NCTIT2(3,3)=5
17971      ITITL2(1,4)='MU'
17972      ITITL2(2,4)='Lower'
17973      ITITL2(3,4)='Limit'
17974      NCTIT2(1,4)=2
17975      NCTIT2(2,4)=5
17976      NCTIT2(3,4)=5
17977      ITITL2(1,5)='Parameter'
17978      ITITL2(2,5)='Upper'
17979      ITITL2(3,5)='Limit'
17980      NCTIT2(1,5)=9
17981      NCTIT2(2,5)=5
17982      NCTIT2(3,5)=5
17983C
17984      NMAX=0
17985      DO2521I=1,NUMCOL
17986        VALIGN(I)='b'
17987        ALIGN(I)='r'
17988        NTOT(I)=15
17989        IF(I.EQ.1)NTOT(I)=12
17990        NMAX=NMAX+NTOT(I)
17991        IDIGIT(I)=NUMDIG
17992 2521 CONTINUE
17993      IDIGIT(1)=2
17994      DO2523I=1,NUMALP
17995        NCTEXT(I)=0
17996        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
17997        AMAT(I,2)=ALOWSC(I)
17998        AMAT(I,3)=AUPPSC(I)
17999        AMAT(I,4)=ALOWMU(I)
18000        AMAT(I,5)=AUPPMU(I)
18001 2523 CONTINUE
18002      IWHTML(1)=150
18003      IWHTML(2)=150
18004      IWHTML(3)=150
18005      IWHTML(4)=150
18006      IWHTML(5)=150
18007      IWHTML(6)=150
18008      IWRTF(1)=2000
18009      IWRTF(2)=IWRTF(1)+2000
18010      IWRTF(3)=IWRTF(2)+2000
18011      IWRTF(4)=IWRTF(3)+2000
18012      IWRTF(5)=IWRTF(4)+2000
18013C
18014      IFRST=.TRUE.
18015      ILAST=.TRUE.
18016      CALL DPDTA2(ITITLE,NCTITL,
18017     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
18018     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18019     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
18020     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18021     1            ICAPSW,ICAPTY,IFRST,ILAST,
18022     1            ISUBRO,IBUGA3,IERROR)
18023C
18024      ITITL9(1:20)='Likelihood Ratio'
18025      NCTIT9=16
18026      DO2533I=1,NUMALP
18027        NCTEXT(I)=0
18028        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
18029        AMAT(I,2)=ALOWS2(I)
18030        AMAT(I,3)=AUPPS2(I)
18031        AMAT(I,4)=ALOWM2(I)
18032        AMAT(I,5)=AUPPM2(I)
18033 2533 CONTINUE
18034C
18035      IFRST=.FALSE.
18036      ILAST=.FALSE.
18037      CALL DPDTA2(ITITLE,NCTITL,
18038     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
18039     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18040     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
18041     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18042     1            ICAPSW,ICAPTY,IFRST,ILAST,
18043     1            ISUBRO,IBUGA3,IERROR)
18044C
18045      ITITLE(1:39)='Confidence Interval for Shape Parameter'
18046      NCTITL=39
18047      ITITL9=' '
18048      NCTIT9=0
18049C
18050      ITITL2(1,2)='Normal'
18051      ITITL2(2,2)='Lower'
18052      ITITL2(3,2)='Limit'
18053      NCTIT2(1,2)=6
18054      NCTIT2(2,2)=5
18055      NCTIT2(3,2)=5
18056      ITITL2(1,3)='Approximation'
18057      ITITL2(2,3)='Upper'
18058      ITITL2(3,3)='Limit'
18059      NCTIT2(1,3)=13
18060      NCTIT2(2,3)=5
18061      NCTIT2(3,3)=5
18062      ITITL2(1,4)='Likelihood Ratio'
18063      ITITL2(2,4)='Lower'
18064      ITITL2(3,4)='Limit'
18065      NCTIT2(1,4)=16
18066      NCTIT2(2,4)=5
18067      NCTIT2(3,4)=5
18068      ITITL2(1,5)='Approximation'
18069      ITITL2(2,5)='Upper'
18070      ITITL2(3,5)='Limit'
18071      NCTIT2(1,5)=13
18072      NCTIT2(2,5)=5
18073      NCTIT2(3,5)=5
18074      IF(ILIKFL.EQ.'OFF')NUMCOL=3
18075C
18076      NMAX=0
18077      DO2541I=1,NUMCOL
18078        VALIGN(I)='b'
18079        ALIGN(I)='r'
18080        NTOT(I)=15
18081        IF(I.EQ.1)NTOT(I)=12
18082        IF(I.EQ.4)NTOT(I)=18
18083        NMAX=NMAX+NTOT(I)
18084        IDIGIT(I)=NUMDIG
18085 2541 CONTINUE
18086      IDIGIT(1)=2
18087C
18088      DO2543I=1,NUMALP
18089        NCTEXT(I)=0
18090        AMAT(I,1)=100.0*(1.0 - ALPHA(I))
18091        AMAT(I,2)=ALOWSH(I)
18092        AMAT(I,3)=AUPPSH(I)
18093        AMAT(I,4)=ALOSH2(I)
18094        AMAT(I,5)=AUPSH2(I)
18095 2543 CONTINUE
18096      IFRST=.TRUE.
18097      ILAST=.TRUE.
18098C
18099      CALL DPDTA2(ITITLE,NCTITL,
18100     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
18101     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18102     1            ITEXT,NCTEXT,AMAT,MAXROW,NUMALP,
18103     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18104     1            ICAPSW,ICAPTY,IFRST,ILAST,
18105     1            ISUBRO,IBUGA3,IERROR)
18106C
18107C               *****************
18108C               **  STEP 90--  **
18109C               **  EXIT       **
18110C               *****************
18111C
18112      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT8D')THEN
18113        WRITE(ICOUT,999)
18114        CALL DPWRST('XXX','WRIT')
18115        WRITE(ICOUT,9011)
18116 9011   FORMAT('***** AT THE END       OF DPDT8D--')
18117        CALL DPWRST('XXX','WRIT')
18118      ENDIF
18119C
18120      RETURN
18121      END
18122      SUBROUTINE DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
18123     1                  ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
18124     1                  ISUBRO,IBUGA3,IERROR)
18125C
18126C     PURPOSE--FOR MAXIMUM LIKELIHOOD FOR DISTRIBUTIONS, PRINT
18127C              THE QUANTILE CONFIDENCE INTERVAL TABLE.
18128C     WRITTEN BY--ALAN HECKERT
18129C                 STATISTICAL ENGINEERING DIVISION
18130C                 INFORMATION TECHNOLOGY LABORATORY
18131C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18132C                 GAITHERSBURG, MD 20899-8980
18133C                 PHONE--301-975-2899
18134C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18135C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18136C     LANGUAGE--ANSI FORTRAN (1977)
18137C     VERSION NUMBER--2010/02
18138C     ORIGINAL VERSION--FEBRUARY  2010 EXTRACT AS DISTINCT SUBROUTINE
18139C     UPDATED         --JUNE      2010 ADD ILIKFL TO SPECIFY WHEHTER
18140C                                      BASED ON NORMAL APPROXIMAITON
18141C                                      OR LIKELIHOOD RATIO
18142C     UPDATED         --JUNE      2010 2-PAR EXPONENTIAL ONLY DOES
18143C                                      LOWER LIMIT.  CHECK TO SEE
18144C                                      IF UPPER LIMIT SET TO CPUMIN
18145C     UPDATED         --MARCH     2014 SUPPORT USER OPTION FOR "LOWER"
18146C                                      OR "UPPER" CASES.  ONE-SIDED
18147C                                      PERCENTILES ARE EQUIVALENT TO
18148C                                      ONE-SIDED TOLERANCE INTERVALS
18149C                                      (WHICH IS THE MOTIVATION FOR THIS
18150C                                      OPTION).
18151C     UPDATED         --NOVEMBER  2015 CHECK FOR SMALL VALUES OF ALPHA
18152C     UPDATED         --NOVEMBER  2015 USER SETTABLE DIGITS FOR
18153C                                      PERCENTILE COLUMN
18154C
18155C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18156C
18157      CHARACTER*4 ICAPSW
18158      CHARACTER*4 ICAPTY
18159      CHARACTER*4 ILIKFL
18160C
18161      CHARACTER*4 ISUBRO
18162      CHARACTER*4 IBUGA3
18163      CHARACTER*4 IERROR
18164C
18165      CHARACTER*4 ISUBN1
18166      CHARACTER*4 ISUBN2
18167C
18168      LOGICAL IFLAGU
18169      LOGICAL IFLAGL
18170C
18171C---------------------------------------------------------------------
18172C
18173      DIMENSION QP(*)
18174      DIMENSION XQPHAT(*)
18175      DIMENSION XQPSE(*)
18176      DIMENSION XQPLCL(*)
18177      DIMENSION XQPUCL(*)
18178C
18179      INCLUDE 'DPCOST.INC'
18180C
18181      PARAMETER (MAXROW=50)
18182      CHARACTER*60 ITITLE
18183      CHARACTER*60 ITITL9
18184      CHARACTER*40 ITEXT(MAXROW)
18185      CHARACTER*4  ALIGN(MAXROW)
18186      CHARACTER*4  VALIGN(MAXROW)
18187      INTEGER      NCTEXT(MAXROW)
18188      INTEGER      IDIGIT(MAXROW)
18189      INTEGER      NTOT(MAXROW)
18190C
18191      PARAMETER(NUMCLI=5)
18192      PARAMETER(MAXLIN=3)
18193      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
18194      INTEGER      NCTIT2(MAXLIN,NUMCLI)
18195      INTEGER      IWHTML(MAXROW)
18196      INTEGER      IWRTF(MAXROW)
18197      REAL         AMAT(MAXROW,NUMCLI)
18198      LOGICAL IFRST
18199      LOGICAL ILAST
18200C
18201C---------------------------------------------------------------------
18202C
18203      INCLUDE 'DPCOP2.INC'
18204C
18205C-----START POINT-----------------------------------------------------
18206C
18207      ISUBN1='DPDT'
18208      ISUBN2='A9  '
18209      IERROR='NO'
18210      IFLAGU=.TRUE.
18211      IFLAGL=.TRUE.
18212      IF(XQPUCL(1).EQ.CPUMIN)IFLAGU=.FALSE.
18213      IF(XQPLCL(1).EQ.CPUMIN)IFLAGL=.FALSE.
18214C
18215      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA9')THEN
18216        WRITE(ICOUT,999)
18217  999   FORMAT(1X)
18218        CALL DPWRST('XXX','WRIT')
18219        WRITE(ICOUT,51)
18220   51   FORMAT('**** AT THE BEGINNING OF DPDTA9--')
18221        CALL DPWRST('XXX','WRIT')
18222        WRITE(ICOUT,52)IBUGA3,ISUBRO,NPERC,NUMDIG
18223   52   FORMAT('IBUGA3,ISUBRO,NPERC,NUMDIT = ',A4,2X,A4,2X,2I5)
18224        CALL DPWRST('XXX','WRIT')
18225        DO56I=1,NPERC
18226          WRITE(ICOUT,57)I,QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),XQPSE(I)
18227   57     FORMAT('I,QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I),XQPSE(I) = ',
18228     1           I8,5G15.7)
18229          CALL DPWRST('XXX','WRIT')
18230   56   CONTINUE
18231      ENDIF
18232C
18233      IF(NPERC.GT.1)THEN
18234C
18235C       CHECK FOR VERY SMALL VALUES FOR ALPHA
18236C
18237        ITITL9=' '
18238        ITITL9(1:40)='Select Percentiles Confidence Intervals '
18239        ITITL9(41:59)='(alpha =      )'
18240        IF(ALPHAP.GE.0.001)THEN
18241          ITITL9(41:55)='(alpha =      )'
18242          WRITE(ITITL9(50:54),'(F5.3)')ALPHAP
18243          NCTIT9=55
18244        ELSEIF(ALPHAP.GE.0.0001)THEN
18245          ITITL9(41:56)='(alpha =       )'
18246          WRITE(ITITL9(50:55),'(F6.4)')ALPHAP
18247          NCTIT9=56
18248        ELSEIF(ALPHAP.GE.0.00001)THEN
18249          ITITL9(41:57)='(alpha =        )'
18250          WRITE(ITITL9(50:56),'(F7.5)')ALPHAP
18251          NCTIT9=57
18252        ELSEIF(ALPHAP.GE.0.000001)THEN
18253          ITITL9(41:58)='(alpha =         )'
18254          WRITE(ITITL9(50:57),'(F8.6)')ALPHAP
18255          NCTIT9=58
18256        ELSE
18257          ITITL9(41:60)='(alpha =           )'
18258          WRITE(ITITL9(50:59),'(E10.4)')ALPHAP
18259          NCTIT9=60
18260        ENDIF
18261C
18262        IF(ILIKFL.EQ.'ON')THEN
18263          ITITLE='(Based on Likelihood Ratio)'
18264          NCTITL=27
18265        ELSEIF(ILIKFL.EQ.'EXAC')THEN
18266          ITITLE=' '
18267          NCTITL=0
18268        ELSEIF(ILIKFL.EQ.'PARE')THEN
18269          ITITLE='(Based on Astrabadi Approximation)'
18270          NCTITL=34
18271        ELSE
18272          ITITLE='(Based on Normal Approximation)'
18273          NCTITL=31
18274        ENDIF
18275        NUMLIN=2
18276        IF(XQPSE(1).NE.CPUMIN)THEN
18277          NUMCOL=5
18278          IFLAGS=1
18279        ELSE
18280          NUMCOL=4
18281          IFLAGS=0
18282        ENDIF
18283        IF(.NOT.IFLAGL)NUMCOL=NUMCOL-1
18284        IF(.NOT.IFLAGU)NUMCOL=NUMCOL-1
18285        ITITL2(1,1)=' '
18286        ITITL2(2,1)='Percentile'
18287        ITITL2(1,2)='Point'
18288        ITITL2(2,2)='Estimate'
18289        NCTIT2(1,1)=0
18290        NCTIT2(2,1)=10
18291        NCTIT2(1,2)=5
18292        NCTIT2(2,2)=8
18293C
18294        ICNT2=2
18295        IF(IFLAGS.EQ.1)THEN
18296          ICNT2=ICNT2+1
18297          ITITL2(1,ICNT2)='Standard'
18298          ITITL2(2,ICNT2)='Error'
18299          NCTIT2(1,ICNT2)=8
18300          NCTIT2(2,ICNT2)=5
18301        ENDIF
18302C
18303        IF(IFLAGL)THEN
18304          ICNT2=ICNT2+1
18305          ITITL2(1,ICNT2)='Lower'
18306          ITITL2(2,ICNT2)='Limit'
18307          NCTIT2(1,ICNT2)=5
18308          NCTIT2(2,ICNT2)=5
18309        ENDIF
18310C
18311        IF(IFLAGU)THEN
18312          ICNT2=ICNT2+1
18313          ITITL2(1,ICNT2)='Upper'
18314          ITITL2(2,ICNT2)='Limit'
18315          NCTIT2(1,ICNT2)=5
18316          NCTIT2(2,ICNT2)=5
18317        ENDIF
18318C
18319        NMAX=0
18320        DO2621I=1,NUMCOL
18321          VALIGN(I)='b'
18322          ALIGN(I)='r'
18323          NTOT(I)=15
18324          NMAX=NMAX+NTOT(I)
18325          IDIGIT(I)=NUMDIG
18326 2621   CONTINUE
18327CCCCC   IDIGIT(1)=3
18328        IDIGIT(1)=IPCIDI
18329        DO2623I=1,NPERC
18330          NCTEXT(I)=0
18331          AMAT(I,1)=QP(I)
18332          AMAT(I,2)=XQPHAT(I)
18333          ICNT2=2
18334          IF(IFLAGS.EQ.1)THEN
18335            ICNT2=ICNT2+1
18336            AMAT(I,ICNT2)=XQPSE(I)
18337          ENDIF
18338          IF(IFLAGL)THEN
18339            ICNT2=ICNT2+1
18340            AMAT(I,ICNT2)=XQPLCL(I)
18341          ENDIF
18342          IF(IFLAGU)THEN
18343            ICNT2=ICNT2+1
18344            AMAT(I,ICNT2)=XQPUCL(I)
18345          ENDIF
18346 2623   CONTINUE
18347        IWHTML(1)=150
18348        IWHTML(2)=150
18349        IWHTML(3)=150
18350        IWHTML(4)=150
18351        IWHTML(5)=150
18352        IWHTML(6)=150
18353        IINC=2000
18354        IF(IFLAGS.EQ.1)AINC=1800
18355        IWRTF(1)=IINC
18356        IWRTF(2)=IWRTF(1)+IINC
18357        IWRTF(3)=IWRTF(2)+IINC
18358        IWRTF(4)=IWRTF(3)+IINC
18359        IWRTF(4)=IWRTF(4)+IINC
18360        IFRST=.TRUE.
18361        ILAST=.TRUE.
18362C
18363        CALL DPDTA2(ITITL9,NCTIT9,
18364     1              ITITLE,NCTITL,ITITL2,NCTIT2,
18365     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18366     1              ITEXT,NCTEXT,AMAT,MAXROW,NPERC,
18367     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18368     1              ICAPSW,ICAPTY,IFRST,ILAST,
18369     1              ISUBRO,IBUGA3,IERROR)
18370      ENDIF
18371C
18372C               *****************
18373C               **  STEP 90--  **
18374C               **  EXIT       **
18375C               *****************
18376C
18377      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTA9')THEN
18378        WRITE(ICOUT,999)
18379        CALL DPWRST('XXX','WRIT')
18380        WRITE(ICOUT,9011)
18381 9011   FORMAT('***** AT THE END       OF DPDTA9--')
18382        CALL DPWRST('XXX','WRIT')
18383      ENDIF
18384C
18385      RETURN
18386      END
18387      SUBROUTINE DPDT9B(QP,XQPHAT,XQPLCL,XQPUCL,NPERC,
18388     1                  ICAPSW,ICAPTY,NUMDIG,ALPHAP,
18389     1                  ISUBRO,IBUGA3,IERROR)
18390C
18391C     PURPOSE--FOR BOOTSTRAP DISTRIBUTIONAL MODELING, PRINT THE
18392C              QUANTILE CONFIDENCE INTERVAL TABLE.
18393C     WRITTEN BY--ALAN HECKERT
18394C                 STATISTICAL ENGINEERING DIVISION
18395C                 INFORMATION TECHNOLOGY LABORATORY
18396C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18397C                 GAITHERSBURG, MD 20899-8980
18398C                 PHONE--301-975-2899
18399C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18400C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18401C     LANGUAGE--ANSI FORTRAN (1977)
18402C     VERSION NUMBER--2010/07
18403C     ORIGINAL VERSION--JULY      2010
18404C     UPDATED         --AUGUST    2011 SUPPORT FOR ONE-SIDED INTERVALS
18405C                                      (NOTE THESE ARE EQUIVALENT TO
18406C                                      ONE-SIDED TOLERANCE INTERVALS)
18407C     UPDATED         --NOVEMBER  2015 CHECK FOR SMALL VALUES OF ALPHA
18408C     UPDATED         --NOVEMBER  2015 USER SETTABLE DIGITS FOR
18409C                                      PERCENTILE COLUMN
18410C
18411C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18412C
18413      CHARACTER*4 ICAPSW
18414      CHARACTER*4 ICAPTY
18415C
18416      CHARACTER*4 ISUBRO
18417      CHARACTER*4 IBUGA3
18418      CHARACTER*4 IERROR
18419C
18420      CHARACTER*4 ICASE
18421      CHARACTER*4 ISUBN1
18422      CHARACTER*4 ISUBN2
18423C
18424C---------------------------------------------------------------------
18425C
18426      DIMENSION QP(*)
18427      DIMENSION XQPHAT(*)
18428      DIMENSION XQPLCL(*)
18429      DIMENSION XQPUCL(*)
18430C
18431      INCLUDE 'DPCOST.INC'
18432C
18433      PARAMETER (MAXROW=30)
18434      CHARACTER*60 ITITLE
18435      CHARACTER*60 ITITL9
18436      CHARACTER*40 ITEXT(MAXROW)
18437      CHARACTER*4  ALIGN(MAXROW)
18438      CHARACTER*4  VALIGN(MAXROW)
18439      INTEGER      NCTEXT(MAXROW)
18440      INTEGER      IDIGIT(MAXROW)
18441      INTEGER      NTOT(MAXROW)
18442C
18443      PARAMETER(NUMCLI=4)
18444      PARAMETER(MAXLIN=3)
18445      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
18446      INTEGER      NCTIT2(MAXLIN,NUMCLI)
18447      INTEGER      IWHTML(MAXROW)
18448      INTEGER      IWRTF(MAXROW)
18449      REAL         AMAT(MAXROW,NUMCLI)
18450      LOGICAL IFRST
18451      LOGICAL ILAST
18452C
18453C---------------------------------------------------------------------
18454C
18455      INCLUDE 'DPCOP2.INC'
18456C
18457C-----START POINT-----------------------------------------------------
18458C
18459      ISUBN1='DPDT'
18460      ISUBN2='9B  '
18461      IERROR='NO'
18462      ICASE='TWOS'
18463      IF(XQPLCL(1).EQ.CPUMIN)THEN
18464        ICASE='UPPE'
18465      ELSEIF(XQPUCL(1).EQ.CPUMIN)THEN
18466        ICASE='LOWE'
18467      ENDIF
18468C
18469      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT9B')THEN
18470        WRITE(ICOUT,999)
18471  999   FORMAT(1X)
18472        CALL DPWRST('XXX','WRIT')
18473        WRITE(ICOUT,51)
18474   51   FORMAT('**** AT THE BEGINNING OF DPDT9B--')
18475        CALL DPWRST('XXX','WRIT')
18476        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASE,NPERC,NUMDIG
18477   52   FORMAT('IBUGA3,ISUBRO,ICASE,NPERC,NUMDIG = ',3(A4,2X),2I5)
18478        CALL DPWRST('XXX','WRIT')
18479        DO56I=1,NPERC
18480          WRITE(ICOUT,57)I,QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I)
18481   57     FORMAT('I,QP(I),XQPHAT(I),XQPLCL(I),XQPUCL(I) = ',
18482     1           I8,4G15.7)
18483          CALL DPWRST('XXX','WRIT')
18484   56   CONTINUE
18485      ENDIF
18486C
18487      IF(NPERC.GT.1)THEN
18488C
18489C       CHECK FOR VERY SMALL VALUES FOR ALPHA
18490C
18491        ITITL9=' '
18492        ITITL9(1:40)='Select Percentiles Confidence Intervals '
18493        ITITL9(41:59)='(alpha =      )'
18494        IF(ALPHAP.GE.0.001)THEN
18495          ITITL9(41:55)='(alpha =      )'
18496          WRITE(ITITL9(50:54),'(F5.3)')ALPHAP
18497          NCTIT9=55
18498        ELSEIF(ALPHAP.GE.0.0001)THEN
18499          ITITL9(41:56)='(alpha =       )'
18500          WRITE(ITITL9(50:55),'(F6.4)')ALPHAP
18501          NCTIT9=56
18502        ELSEIF(ALPHAP.GE.0.00001)THEN
18503          ITITL9(41:57)='(alpha =        )'
18504          WRITE(ITITL9(50:56),'(F7.5)')ALPHAP
18505          NCTIT9=57
18506        ELSEIF(ALPHAP.GE.0.000001)THEN
18507          ITITL9(41:58)='(alpha =         )'
18508          WRITE(ITITL9(50:57),'(F8.6)')ALPHAP
18509          NCTIT9=58
18510        ELSE
18511          ITITL9(41:60)='(alpha =           )'
18512          WRITE(ITITL9(50:59),'(E10.4)')ALPHAP
18513          NCTIT9=60
18514        ENDIF
18515C
18516        ITITLE='(Based on Bootstrap Samples)'
18517        NCTITL=28
18518        NUMLIN=3
18519        NUMCOL=4
18520        IF(ICASE.EQ.'LOWE')NUMCOL=3
18521        IF(ICASE.EQ.'UPPE')NUMCOL=3
18522        ITITL2(1,1)=' '
18523        ITITL2(2,1)=' '
18524        ITITL2(3,1)='Percentile'
18525        NCTIT2(1,1)=0
18526        NCTIT2(2,1)=0
18527        NCTIT2(3,1)=10
18528        ITITL2(1,2)='Median'
18529        ITITL2(2,2)='Point'
18530        ITITL2(3,2)='Estimate'
18531        NCTIT2(1,2)=6
18532        NCTIT2(2,2)=5
18533        NCTIT2(3,2)=8
18534        IF(ICASE.EQ.'TWOS')THEN
18535          ITITL2(1,3)=' '
18536          ITITL2(2,3)='Lower'
18537          ITITL2(3,3)='Limit'
18538          NCTIT2(1,3)=0
18539          NCTIT2(2,3)=5
18540          NCTIT2(3,3)=5
18541          ITITL2(1,4)=' '
18542          ITITL2(2,4)='Upper'
18543          ITITL2(3,4)='Limit'
18544          NCTIT2(1,4)=0
18545          NCTIT2(2,4)=5
18546          NCTIT2(3,4)=5
18547        ELSEIF(ICASE.EQ.'LOWE')THEN
18548          ITITL2(1,3)=' '
18549          ITITL2(2,3)='Lower'
18550          ITITL2(3,3)='Limit'
18551          NCTIT2(1,3)=0
18552          NCTIT2(2,3)=5
18553          NCTIT2(3,3)=5
18554        ELSEIF(ICASE.EQ.'UPPE')THEN
18555          ITITL2(1,3)=' '
18556          ITITL2(2,3)='Upper'
18557          ITITL2(3,3)='Limit'
18558          NCTIT2(1,3)=0
18559          NCTIT2(2,3)=5
18560          NCTIT2(3,3)=5
18561        ENDIF
18562        NMAX=0
18563        DO2621I=1,NUMCOL
18564          VALIGN(I)='b'
18565          ALIGN(I)='r'
18566          NTOT(I)=15
18567          NMAX=NMAX+NTOT(I)
18568          IDIGIT(I)=NUMDIG
18569 2621   CONTINUE
18570CCCCC   IDIGIT(1)=3
18571        IDIGIT(1)=IPCIDI
18572        DO2623I=1,NPERC
18573          NCTEXT(I)=0
18574          AMAT(I,1)=100.0*QP(I)
18575          AMAT(I,2)=XQPHAT(I)
18576          IF(ICASE.EQ.'TWOS')THEN
18577            AMAT(I,3)=XQPLCL(I)
18578            AMAT(I,4)=XQPUCL(I)
18579          ELSEIF(ICASE.EQ.'LOWE')THEN
18580            AMAT(I,3)=XQPLCL(I)
18581          ELSEIF(ICASE.EQ.'UPPE')THEN
18582            AMAT(I,3)=XQPUCL(I)
18583          ENDIF
18584 2623   CONTINUE
18585        IWHTML(1)=150
18586        IWHTML(2)=150
18587        IWHTML(3)=150
18588        IWHTML(4)=150
18589        IWHTML(5)=150
18590        IWRTF(1)=2000
18591        IWRTF(2)=IWRTF(1)+2000
18592        IWRTF(3)=IWRTF(2)+2000
18593        IWRTF(4)=IWRTF(3)+2000
18594        IFRST=.TRUE.
18595        ILAST=.TRUE.
18596C
18597        CALL DPDTA2(ITITL9,NCTIT9,
18598     1              ITITLE,NCTITL,ITITL2,NCTIT2,
18599     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18600     1              ITEXT,NCTEXT,AMAT,MAXROW,NPERC,
18601     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18602     1              ICAPSW,ICAPTY,IFRST,ILAST,
18603     1              ISUBRO,IBUGA3,IERROR)
18604      ENDIF
18605C
18606C               *****************
18607C               **  STEP 90--  **
18608C               **  EXIT       **
18609C               *****************
18610C
18611      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT9B')THEN
18612        WRITE(ICOUT,999)
18613        CALL DPWRST('XXX','WRIT')
18614        WRITE(ICOUT,9011)
18615 9011   FORMAT('***** AT THE END       OF DPDT9B--')
18616        CALL DPWRST('XXX','WRIT')
18617      ENDIF
18618C
18619      RETURN
18620      END
18621      SUBROUTINE DPDTAP(R,NRET,
18622     1                  ALOC,ASCALE,ALAMB,DG,XR,
18623     1                  ICAPSW,ICAPTY,NUMDIG,
18624     1                  ISUBRO,IBUGA3,IERROR)
18625C
18626C     PURPOSE--GENERATE THE MEAN RECURRENCE INTERVAL TABLE FOR
18627C              THE PEAKS OVER THRESHOLD PLOT.
18628C     WRITTEN BY--ALAN HECKERT
18629C                 STATISTICAL ENGINEERING DIVISION
18630C                 INFORMATION TECHNOLOGY LABORATORY
18631C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18632C                 GAITHERSBURG, MD 20899-8980
18633C                 PHONE--301-975-2899
18634C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18635C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18636C     LANGUAGE--ANSI FORTRAN (1977)
18637C     VERSION NUMBER--2010/07
18638C     ORIGINAL VERSION--JULY      2010. EXTRACTED AS A DISTINCT
18639C                                       SUBROUTINE FROM DPPOT2
18640C
18641C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18642C
18643      CHARACTER*4 ICAPSW
18644      CHARACTER*4 ICAPTY
18645C
18646      CHARACTER*4 ISUBRO
18647      CHARACTER*4 IBUGA3
18648      CHARACTER*4 IERROR
18649      CHARACTER*4 ISUBN1
18650      CHARACTER*4 ISUBN2
18651C
18652      DOUBLE PRECISION DG
18653      DOUBLE PRECISION DXR
18654C
18655C---------------------------------------------------------------------
18656C
18657      DIMENSION R(*)
18658C
18659      INCLUDE 'DPCOST.INC'
18660C
18661      PARAMETER (MAXROW=30)
18662      CHARACTER*1 ITITLE
18663      CHARACTER*1 ITITLZ
18664      CHARACTER*1 ITEXT(MAXROW)
18665C
18666      PARAMETER(NUMCLI=2)
18667      PARAMETER(MAXLIN=2)
18668      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
18669      INTEGER      NCTIT2(MAXLIN,NUMCLI)
18670      INTEGER      IWHTML(NUMCLI+1)
18671      INTEGER      IWRTF(NUMCLI)
18672      INTEGER      IDIGIT(NUMCLI)
18673      INTEGER      NTOT(NUMCLI)
18674      INTEGER      NCTEXT(MAXROW)
18675      REAL         AMAT(MAXROW,NUMCLI)
18676      CHARACTER*4 ALIGN(NUMCLI)
18677      CHARACTER*4 VALIGN(NUMCLI)
18678      LOGICAL IFRST
18679      LOGICAL ILAST
18680C
18681C---------------------------------------------------------------------
18682C
18683      INCLUDE 'DPCOP2.INC'
18684C
18685C-----START POINT-----------------------------------------------------
18686C
18687      ISUBN1='DPDT'
18688      ISUBN2='AP  '
18689      IERROR='NO'
18690C
18691      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTAP')THEN
18692        WRITE(ICOUT,999)
18693  999   FORMAT(1X)
18694        CALL DPWRST('XXX','WRIT')
18695        WRITE(ICOUT,51)
18696   51   FORMAT('**** AT THE BEGINNING OF DPDTAP--')
18697        CALL DPWRST('XXX','WRIT')
18698        WRITE(ICOUT,52)IBUGA3,ISUBRO,NRET
18699   52   FORMAT('IBUGA3,ISUBRO,NRET = ',A4,2X,A4,2X,I8)
18700        CALL DPWRST('XXX','WRIT')
18701        WRITE(ICOUT,53)ALOC,ASCALE,DG,XR,ALAMB
18702   53   FORMAT('ALOC,ASCALE,DG,XR,ALAMB = ',5G15.7)
18703        CALL DPWRST('XXX','WRIT')
18704        DO56I=1,NRET
18705          WRITE(ICOUT,57)I,R(I)
18706   57     FORMAT('I,R(I) = ',I8,G15.7)
18707          CALL DPWRST('XXX','WRIT')
18708   56   CONTINUE
18709      ENDIF
18710C
18711      NUMLIN=2
18712      NUMCOL=2
18713      ITITL2(1,1)='Mean Recurrence'
18714      ITITL2(2,1)='Interval (R)'
18715      NCTIT2(1,1)=15
18716      NCTIT2(2,1)=12
18717      ITITL2(1,2)=' '
18718      ITITL2(2,2)='XR'
18719      NCTIT2(1,2)=0
18720      NCTIT2(2,2)=2
18721C
18722      NMAX=0
18723      DO2521I=1,NUMCOL
18724        VALIGN(I)='b'
18725        ALIGN(I)='r'
18726        NTOT(I)=15
18727        NMAX=NMAX+NTOT(I)
18728        IDIGIT(I)=NUMDIG
18729 2521 CONTINUE
18730      IDIGIT(1)=2
18731      DO2523I=1,NRET
18732        NCTEXT(I)=0
18733        AMAT(I,1)=R(I)
18734        DXR=DBLE(ALOC) - DBLE(ASCALE)*
18735     1      (1.0D0 - (DBLE(ALAMB*R(I)))**DG)/DG
18736        XR=REAL(DXR)
18737        AMAT(I,2)=REAL(DXR)
18738 2523 CONTINUE
18739      IWHTML(1)=200
18740      IWHTML(2)=200
18741      IWHTML(3)=200
18742      IWRTF(1)=2000
18743      IWRTF(2)=IWRTF(1)+2000
18744C
18745      ITITLE=' '
18746      NCTITL=0
18747      ITITLZ=' '
18748      NCTITZ=0
18749      IFRST=.TRUE.
18750      ILAST=.TRUE.
18751      CALL DPDTA2(ITITLE,NCTITL,
18752     1            ITITLZ,NCTITZ,ITITL2,NCTIT2,
18753     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
18754     1            ITEXT,NCTEXT,AMAT,MAXROW,NRET,
18755     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
18756     1            ICAPSW,ICAPTY,IFRST,ILAST,
18757     1            ISUBRO,IBUGA3,IERROR)
18758C
18759C               *****************
18760C               **  STEP 90--  **
18761C               **  EXIT       **
18762C               *****************
18763C
18764      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTAP')THEN
18765        WRITE(ICOUT,999)
18766        CALL DPWRST('XXX','WRIT')
18767        WRITE(ICOUT,9011)
18768 9011   FORMAT('***** AT THE END       OF DPDTAP--')
18769        CALL DPWRST('XXX','WRIT')
18770      ENDIF
18771C
18772      RETURN
18773      END
18774      SUBROUTINE DPDT11(CONF,T,TSDM,ALOWER,AUPPER,
18775     1                  ICASAN,ICAPSW,ICAPTY,NUMDIG,
18776     1                  ISUBRO,IBUGA3,IERROR)
18777C
18778C     PURPOSE--THIS ROUTINE PRINTS THE CONFIDENCE INTERVAL TABLES
18779C              FOR THE FOLLOWING COMMANDS:
18780C
18781C                 1) CONFIDENCE LIMITS FOR THE MEAN
18782C                 2) CONFIDENCE LIMITS FOR THE DIFFERENCE OF THE MEANS
18783C                 3) CONFIDENCE LIMITS FOR BIWEIGHT LOCATION
18784C                 4) CONFIDENCE LIMITS FOR TRIMMED MEAN
18785C                 5) CONFIDENCE LIMITS FOR MEDIAN/QUANTILES
18786C                 6) CONFIDENCE LIMITS FOR CORRELATION COEFFICIENT
18787C                 7) CONFIDENCE LIMITS FOR HEDGES G
18788C                 8) CONFIDENCE LIMITS FOR THE RATIO OF THE MEANS
18789C
18790C     WRITTEN BY--ALAN HECKERT
18791C                 STATISTICAL ENGINEERING DIVISION
18792C                 INFORMATION TECHNOLOGY LABORATORY
18793C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
18794C                 GAITHERSBURG, MD 20899-8980
18795C                 PHONE--301-975-2899
18796C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
18797C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
18798C     LANGUAGE--ANSI FORTRAN (1977)
18799C     VERSION NUMBER--2010/03
18800C     ORIGINAL VERSION--MARCH     2010. EXTRACTED AS DISTINCT SUBROUTINE
18801C     UPDATED         --JUNE      2012. SUPPORT FOR CORRELATION COEFFICIENT
18802C     UPDATED         --APRIL     2013. SUPPORT FOR LOWER/UPPER INTERVALS
18803C     UPDATED         --AUGUST    2018. HEDGES G
18804C     UPDATED         --OCTOBER   2019. RATIO OF MEANS
18805C
18806C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
18807C
18808      CHARACTER*4 ICASAN
18809      CHARACTER*4 ICAPSW
18810      CHARACTER*4 ICAPTY
18811      CHARACTER*4 ISUBRO
18812      CHARACTER*4 IBUGA3
18813      CHARACTER*4 IERROR
18814C
18815      CHARACTER*4 ISUBN1
18816      CHARACTER*4 ISUBN2
18817      CHARACTER*4 ISTEPN
18818      CHARACTER*4 ICASA2
18819C
18820C---------------------------------------------------------------------
18821C
18822      DIMENSION CONF(*)
18823      DIMENSION T(*)
18824      DIMENSION TSDM(*)
18825      DIMENSION ALOWER(*)
18826      DIMENSION AUPPER(*)
18827C
18828      INCLUDE 'DPCOST.INC'
18829C
18830      PARAMETER (MAXCNF=8)
18831      PARAMETER (MAXROW=10)
18832      CHARACTER*60 ITITLE
18833      CHARACTER*60 ITITL9
18834      CHARACTER*4  ALIGN(MAXCNF)
18835      CHARACTER*4  VALIGN(MAXCNF)
18836      INTEGER      IDIGIT(MAXROW)
18837      INTEGER      NTOT(MAXROW)
18838C
18839      PARAMETER(NUMCLI=5)
18840      PARAMETER(MAXLIN=2)
18841      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
18842      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
18843      CHARACTER*4  ITYPCO(NUMCLI)
18844      INTEGER      NCTIT2(MAXLIN,NUMCLI)
18845      INTEGER      NCVALU(MAXROW,NUMCLI)
18846      INTEGER      IWHTML(NUMCLI)
18847      INTEGER      IWRTF(NUMCLI)
18848      REAL         AMAT(MAXROW,NUMCLI)
18849C
18850      LOGICAL IFRST
18851      LOGICAL ILAST
18852C
18853C---------------------------------------------------------------------
18854C
18855      INCLUDE 'DPCOP2.INC'
18856C
18857C-----START POINT-----------------------------------------------------
18858C
18859      ISUBN1='DPDT'
18860      ISUBN2='11  '
18861      IERROR='NO'
18862C
18863      ICASA2='TWOS'
18864      IF(ALOWER(1).EQ.CPUMIN)ICASA2='UPPE'
18865      IF(AUPPER(1).EQ.CPUMIN)ICASA2='LOWE'
18866      IF(ICASAN.EQ.'MRC2')ICASA2='TWOS'
18867C
18868      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT11')THEN
18869        WRITE(ICOUT,999)
18870  999   FORMAT(1X)
18871        CALL DPWRST('XXX','WRIT')
18872        WRITE(ICOUT,51)
18873   51   FORMAT('**** AT THE BEGINNING OF DPDT11--')
18874        CALL DPWRST('XXX','WRIT')
18875        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASA2
18876   52   FORMAT('IBUGA3,ISUBRO,ICASA2 = ',3(A4,2X),I5)
18877        CALL DPWRST('XXX','WRIT')
18878        DO56I=1,8
18879          WRITE(ICOUT,57)I,CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I)
18880   57     FORMAT('I,CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I) = ',
18881     1           I8,5G15.7)
18882          CALL DPWRST('XXX','WRIT')
18883   56   CONTINUE
18884      ENDIF
18885C
18886      ITITLE=' '
18887      NCTITL=0
18888      ITITL9=' '
18889      NCTIT9=0
18890      NUMLIN=2
18891      NUMROW=8
18892      NUMCOL=5
18893C
18894      IF(ICASAN.EQ.'QUC2')THEN
18895        ITITL9='Hettmansperger-Sheater Median Confidence Limits'
18896        NCTIT9=47
18897        NUMCOL=3
18898      ELSEIF(ICASAN.EQ.'CORR')THEN
18899        NUMCOL=4
18900        NUMROW=7
18901      ELSEIF(ICASAN.EQ.'HEDG')THEN
18902        NUMCOL=5
18903        NUMROW=7
18904      ELSEIF(ICASAN.EQ.'MRC2')THEN
18905        NUMCOL=4
18906      ENDIF
18907      IF(ICASA2.EQ.'LOWE' .OR. ICASA2.EQ.'UPPE')NUMCOL=NUMCOL-1
18908C
18909      ICNT=1
18910      ITITL2(1,ICNT)='Confidence'
18911      NCTIT2(1,ICNT)=10
18912      ITITL2(2,ICNT)='Value (%)'
18913      NCTIT2(2,ICNT)=9
18914      IF(ICASAN.EQ.'QUCI' .OR. ICASAN.EQ.'MECI')THEN
18915        ICNT=ICNT+1
18916        ITITL2(1,ICNT)='Z'
18917        NCTIT2(1,ICNT)=1
18918        ITITL2(2,ICNT)='Value'
18919        NCTIT2(2,ICNT)=5
18920        ICNT=ICNT+1
18921        ITITL2(1,ICNT)='Z-Value X'
18922        NCTIT2(1,ICNT)=9
18923        ITITL2(2,ICNT)='StdErr'
18924        NCTIT2(2,ICNT)=6
18925      ELSEIF(ICASAN.EQ.'CONF' .OR. ICASAN.EQ.'BWCO' .OR.
18926     1       ICASAN.EQ.'TMCO' .OR. ICASAN.EQ.'CON2')THEN
18927        ICNT=ICNT+1
18928        ITITL2(1,ICNT)='t'
18929        NCTIT2(1,ICNT)=1
18930        ITITL2(2,ICNT)='Value'
18931        NCTIT2(2,ICNT)=5
18932        ICNT=ICNT+1
18933        ITITL2(1,ICNT)='t-Value X'
18934        NCTIT2(1,ICNT)=9
18935        IF(ICASAN.EQ.'CONF')THEN
18936          ITITL2(2,ICNT)='SD(Mean)'
18937          NCTIT2(2,ICNT)=8
18938        ELSE
18939          ITITL2(2,3)='StdErr'
18940          NCTIT2(2,3)=6
18941        ENDIF
18942      ELSEIF(ICASAN.EQ.'HEDG')THEN
18943        ICNT=ICNT+1
18944        ITITL2(1,ICNT)='Z'
18945        NCTIT2(1,ICNT)=1
18946        ITITL2(2,ICNT)='Value'
18947        NCTIT2(2,ICNT)=5
18948        ICNT=ICNT+1
18949        ITITL2(1,ICNT)='Z-Value X'
18950        NCTIT2(1,ICNT)=9
18951        ITITL2(2,ICNT)='StdErr'
18952        NCTIT2(2,ICNT)=6
18953      ELSEIF(ICASAN.EQ.'CORR')THEN
18954        ICNT=ICNT+1
18955        ITITL2(1,ICNT)='Normal'
18956        NCTIT2(1,ICNT)=6
18957        ITITL2(2,ICNT)='Value'
18958        NCTIT2(2,ICNT)=5
18959      ELSEIF(ICASAN.EQ.'MRC2')THEN
18960        ICNT=ICNT+1
18961        ITITL2(1,ICNT)=' '
18962        NCTIT2(1,ICNT)=1
18963        ITITL2(2,ICNT)='Ratio'
18964        NCTIT2(2,ICNT)=5
18965      ENDIF
18966      IF(ICASA2.EQ.'TWOS' .OR. ICASA2.EQ.'LOWE')THEN
18967        ICNT=ICNT+1
18968        ITITL2(1,ICNT)='Lower'
18969        NCTIT2(1,ICNT)=5
18970        ITITL2(2,ICNT)='Limit'
18971        NCTIT2(2,ICNT)=5
18972      ENDIF
18973      IF(ICASA2.EQ.'TWOS' .OR. ICASA2.EQ.'UPPE')THEN
18974        ICNT=ICNT+1
18975        ITITL2(1,ICNT)='Upper'
18976        NCTIT2(1,ICNT)=5
18977        ITITL2(2,ICNT)='Limit'
18978        NCTIT2(2,ICNT)=5
18979      ENDIF
18980C
18981      NMAX=0
18982      DO4221I=1,NUMCOL
18983        VALIGN(I)='b'
18984        ALIGN(I)='r'
18985        NTOT(I)=15
18986        IDIGIT(I)=NUMDIG
18987        ITYPCO(I)='NUME'
18988        IWHTML(I)=150
18989        IF(I.EQ.1)THEN
18990          NTOT(I)=12
18991          IDIGIT(I)=3
18992          IWHTML(1)=75
18993        ELSEIF(I.EQ.2 .AND. ICASAN.NE.'MRC2')THEN
18994          NTOT(I)=8
18995          IDIGIT(I)=3
18996          IWHTML(I)=75
18997        ENDIF
18998        NMAX=NMAX+NTOT(I)
18999 4221 CONTINUE
19000      DO4223I=1,NUMROW
19001        DO4225J=1,NUMCOL
19002          NCVALU(I,J)=0
19003          IVALUE(I,J)=' '
19004          AMAT(I,J)=0.0
19005 4225   CONTINUE
19006        JCNT=1
19007        AMAT(I,JCNT)=CONF(I)
19008        IF(ICASAN.EQ.'CORR')THEN
19009          JCNT=JCNT+1
19010          AMAT(I,JCNT)=T(I)
19011        ELSEIF(ICASAN.EQ.'MRC2')THEN
19012          JCNT=JCNT+1
19013          AMAT(I,JCNT)=TSDM(I)
19014        ELSEIF(ICASAN.NE.'QUC2')THEN
19015          JCNT=JCNT+1
19016          AMAT(I,JCNT)=T(I)
19017          JCNT=JCNT+1
19018          AMAT(I,JCNT)=TSDM(I)
19019        ENDIF
19020        IF(ICASA2.EQ.'TWOS' .OR. ICASA2.EQ.'LOWE')THEN
19021          JCNT=JCNT+1
19022          AMAT(I,JCNT)=ALOWER(I)
19023        ENDIF
19024        IF(ICASA2.EQ.'TWOS' .OR. ICASA2.EQ.'UPPE')THEN
19025          JCNT=JCNT+1
19026          AMAT(I,JCNT)=AUPPER(I)
19027        ENDIF
19028 4223 CONTINUE
19029C
19030      IWRTF(1)=800
19031      IWRTF(2)=IWRTF(1)+800
19032      IWRTF(3)=IWRTF(2)+2000
19033      IWRTF(4)=IWRTF(2)+2000
19034      IWRTF(5)=IWRTF(2)+2000
19035      IFRST=.TRUE.
19036      ILAST=.TRUE.
19037C
19038      ISTEPN='5C'
19039      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CNF2')
19040     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19041C
19042      CALL DPDTA4(ITITL9,NCTIT9,
19043     1            ITITLE,NCTITL,ITITL2,NCTIT2,
19044     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
19045     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
19046     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
19047     1            ICAPSW,ICAPTY,IFRST,ILAST,
19048     1            ISUBRO,IBUGA3,IERROR)
19049C
19050C               *****************
19051C               **  STEP 90--  **
19052C               **  EXIT       **
19053C               *****************
19054C
19055      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DT11')THEN
19056        WRITE(ICOUT,999)
19057        CALL DPWRST('XXX','WRIT')
19058        WRITE(ICOUT,9011)
19059 9011   FORMAT('***** AT THE END       OF DPDT11--')
19060        CALL DPWRST('XXX','WRIT')
19061      ENDIF
19062C
19063      RETURN
19064      END
19065      SUBROUTINE DPDTLA(ISTRIN,NCIN,NCT,
19066     1                  ISUBRO,IBUGA3,IERROR)
19067C
19068C     PURPOSE--UTILITY ROUTINE USED BY THE TABLE PRINTING ROUTINES
19069C              (DPDTA1, DPDTA2, DPDTA4, DPDTA5, DPDT5B).  FOR LATEX
19070C              OUTPUT, IT CHECKS FOR CERTAIN CHARACTERS AND ADDS
19071C              APPROPRIATE ESCAPE SEQUENCES.  CURRENTLY, THE
19072C              CHARACTERS CHECKED ARE:
19073C
19074C                 1) %
19075C                 2) <
19076C                 3) >
19077C                 4) !
19078C                 5) *
19079C
19080C              ISTRIN     => INPUT STRING, MAY BE MODIFIED ON OUTPUT
19081C              NCIN       => NUMBER OF CHARACTERS FOR ISTRIN
19082C              NCT        => NUMBER OF CHARACTERS ON OUTPUT
19083C
19084C     WRITTEN BY--ALAN HECKERT
19085C                 STATISTICAL ENGINEERING DIVISION
19086C                 INFORMATION TECHNOLOGY LABORATORY
19087C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19088C                 GAITHERSBURG, MD 20899-8980
19089C                 PHONE--301-975-2899
19090C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19091C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19092C     LANGUAGE--ANSI FORTRAN (1977)
19093C     VERSION NUMBER--2011/1
19094C     ORIGINAL VERSION--JANUARY   2011.
19095C
19096C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19097C
19098      CHARACTER*(*) ISTRIN
19099      CHARACTER*4 IBUGA3
19100      CHARACTER*4 ISUBRO
19101      CHARACTER*4 IERROR
19102C
19103      CHARACTER*1 IBASLC
19104C
19105C---------------------------------------------------------------------
19106C
19107      INCLUDE 'DPCOP2.INC'
19108C
19109C-----START POINT-----------------------------------------------------
19110C
19111      IERROR='NO'
19112C
19113      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTLA')THEN
19114        WRITE(ICOUT,999)
19115  999   FORMAT(1X)
19116        CALL DPWRST('XXX','WRIT')
19117        WRITE(ICOUT,51)
19118   51   FORMAT('**** AT THE BEGINNING OF DPDTLA--')
19119        CALL DPWRST('XXX','WRIT')
19120        WRITE(ICOUT,52)IBUGA3,ISUBRO
19121   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
19122        CALL DPWRST('XXX','WRIT')
19123        WRITE(ICOUT,53)NCIN,ISTRIN(1:NCIN)
19124   53   FORMAT('NCIN,ISTRIN = ',I8,2X,A)
19125      ENDIF
19126C
19127C     FOR LATEX, NEED TO CHECK FOR ANY CHARACTERS THAT
19128C     NEED TO BE "ESCAPED".
19129C
19130C     CHECK FOR <= OR >= AND CONVERT TO LATEX
19131C     FORMAT (\le or \ge)
19132C
19133      CALL DPCONA(92,IBASLC)
19134      NCT=NCIN
19135      DO1010II=NCIN,1,-1
19136        IF(ISTRIN(II:II).EQ.'%')THEN
19137          DO1020J=NCT,II,-1
19138            ISTRIN(J+1:J+1)=ISTRIN(J:J)
19139 1020     CONTINUE
19140          NCT=NCT+1
19141          ISTRIN(II:II)=IBASLC
19142        ELSEIF(ISTRIN(II:II).EQ.'|' .OR.
19143     1         ISTRIN(II:II).EQ.'*')THEN
19144          DO1030J=NCT,II+1,-1
19145            ISTRIN(J+2:J+2)=ISTRIN(J:J)
19146 1030     CONTINUE
19147          ISTRIN(II+1:II+1)=ISTRIN(II:II)
19148          NCT=NCT+2
19149          ISTRIN(II:II)='$'
19150          ISTRIN(II+2:II+2)='$'
19151        ELSEIF(ISTRIN(II:II).EQ.'<' .OR.
19152     1         ISTRIN(II:II).EQ.'>')THEN
19153          IF(ISTRIN(II+1:II+1).EQ.'=')THEN
19154            DO1040J=NCT,II+2,-1
19155              ISTRIN(J+4:J+4)=ISTRIN(J:J)
19156 1040       CONTINUE
19157            IF(ISTRIN(II:II).EQ.'<')THEN
19158              ISTRIN(II:II+5)='$ le$ '
19159              ISTRIN(II+1:II+1)=IBASLC
19160            ELSEIF(ISTRIN(II:II).EQ.'>')THEN
19161              ISTRIN(II:II+5)='$ ge$ '
19162              ISTRIN(II+1:II+1)=IBASLC
19163            ENDIF
19164            NCT=NCT+4
19165          ELSE
19166            DO1050J=NCT,II+1,-1
19167              ISTRIN(J+2:J+2)=ISTRIN(J:J)
19168 1050       CONTINUE
19169            ISTRIN(II+1:II+1)=ISTRIN(II:II)
19170            NCT=NCT+2
19171            ISTRIN(II:II)='$'
19172            ISTRIN(II+2:II+2)='$'
19173          ENDIF
19174        ENDIF
19175 1010 CONTINUE
19176C
19177      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTLA')THEN
19178        WRITE(ICOUT,999)
19179        CALL DPWRST('XXX','WRIT')
19180        WRITE(ICOUT,9051)
19181 9051   FORMAT('**** AT THE END OF DPDTLA--')
19182        CALL DPWRST('XXX','WRIT')
19183        WRITE(ICOUT,9053)NCT,ISTRIN(1:NCT)
19184 9053   FORMAT('NCT,ISTRIN = ',I8,2X,A)
19185      ENDIF
19186C
19187      RETURN
19188      END
19189      SUBROUTINE DPDTRT(ISTRIN,NCIN,NCT,
19190     1                  ISUBRO,IBUGA3,IERROR)
19191C
19192C     PURPOSE--UTILITY ROUTINE USED BY THE TABLE PRINTING ROUTINES
19193C              (DPDTA1, DPDTA2, DPDTA4, DPDTA5, DPDT5B).  FOR RTF
19194C              OUTPUT, IT CHECKS FOR CERTAIN CHARACTERS AND ADDS
19195C              APPROPRIATE ESCAPE SEQUENCES.  CURRENTLY, THE
19196C              CHARACTERS CHECKED ARE:
19197C
19198C                 1) |
19199C
19200C              ISTRIN     => INPUT STRING, MAY BE MODIFIED ON OUTPUT
19201C              NCIN       => NUMBER OF CHARACTERS FOR ISTRIN
19202C              NCT        => NUMBER OF CHARACTERS ON OUTPUT
19203C
19204C     WRITTEN BY--ALAN HECKERT
19205C                 STATISTICAL ENGINEERING DIVISION
19206C                 INFORMATION TECHNOLOGY LABORATORY
19207C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19208C                 GAITHERSBURG, MD 20899-8980
19209C                 PHONE--301-975-2899
19210C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19211C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19212C     LANGUAGE--ANSI FORTRAN (1977)
19213C     VERSION NUMBER--2011/1
19214C     ORIGINAL VERSION--JANUARY   2011.
19215C
19216C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19217C
19218      CHARACTER*(*) ISTRIN
19219      CHARACTER*4 IBUGA3
19220      CHARACTER*4 ISUBRO
19221      CHARACTER*4 IERROR
19222C
19223      CHARACTER*1 IBASLC
19224      CHARACTER*1 IQUOTE
19225C
19226C---------------------------------------------------------------------
19227C
19228      INCLUDE 'DPCOP2.INC'
19229C
19230C-----START POINT-----------------------------------------------------
19231C
19232      IERROR='NO'
19233C
19234      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTRT')THEN
19235        WRITE(ICOUT,999)
19236  999   FORMAT(1X)
19237        CALL DPWRST('XXX','WRIT')
19238        WRITE(ICOUT,51)
19239   51   FORMAT('**** AT THE BEGINNING OF DPDTRT--')
19240        CALL DPWRST('XXX','WRIT')
19241        WRITE(ICOUT,52)IBUGA3,ISUBRO
19242   52   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
19243        CALL DPWRST('XXX','WRIT')
19244        WRITE(ICOUT,53)NCIN,ISTRIN(1:NCIN)
19245   53   FORMAT('NCIN,ISTRIN = ',I8,2X,A)
19246      ENDIF
19247C
19248C     FOR RTF, NEED TO CHECK FOR ANY CHARACTERS THAT
19249C     NEED TO BE "ESCAPED".
19250C
19251C     CURRENTLY, REPLACE "|" WITH "\'7C" (7C IS THE HEXADECIMAL
19252C     REPRESENTATION FOR A VERTICAL LINE).
19253C
19254      CALL DPCONA(92,IBASLC)
19255      CALL DPCONA(39,IQUOTE)
19256      NCT=NCIN
19257      DO1010II=NCIN,1,-1
19258        IF(ISTRIN(II:II).EQ.'|')THEN
19259          DO1030J=NCT,II+1,-1
19260            ISTRIN(J+3:J+3)=ISTRIN(J:J)
19261 1030     CONTINUE
19262          NCT=NCT+3
19263          ISTRIN(II:II)=IBASLC
19264          ISTRIN(II+1:II+1)=IQUOTE
19265          ISTRIN(II+2:II+3)='7C'
19266        ENDIF
19267 1010 CONTINUE
19268C
19269      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTRT')THEN
19270        WRITE(ICOUT,999)
19271        CALL DPWRST('XXX','WRIT')
19272        WRITE(ICOUT,9051)
19273 9051   FORMAT('**** AT THE END OF DPDTRT--')
19274        CALL DPWRST('XXX','WRIT')
19275        WRITE(ICOUT,9053)NCT,ISTRIN(1:NCT)
19276 9053   FORMAT('NCT,ISTRIN = ',I8,2X,A)
19277      ENDIF
19278C
19279      RETURN
19280      END
19281      SUBROUTINE DPDTXT(ITEXT,NCTEXT,AVALUE,IDIGIT,
19282     1                  NTOTAL,NBLNK1,NBLNK2,IFLAG1,IFLAG2,ISIZE,
19283     1                  ICAPSW,ICAPTY,ITYPE,
19284     1                  ISUBRO,IBUGA3,IERROR)
19285C
19286C     PURPOSE--THIS ROUTINE PRINTS A TEXT LINE IN HTML/LATEX/RTF/ASCII
19287C              FORMATS.
19288C
19289C              THIS IS USED TO PRINT INDIVIDUAL TEXT LINES (E.G.,
19290C              A HEADER LINE OR SOME LINES OF TEXT AFTER A TABLE).
19291C
19292C              FOR MULTI-LINE CASE, SPECIFY IFLAG1 = TRUE IF FIRST LINE
19293C              IFLAG2 = TRUE IF LAST LINE.
19294C
19295C     WRITTEN BY--ALAN HECKERT
19296C                 STATISTICAL ENGINEERING DIVISION
19297C                 INFORMATION TECHNOLOGY LABORATORY
19298C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19299C                 GAITHERSBURG, MD 20899-8980
19300C                 PHONE--301-975-2899
19301C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19302C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19303C     LANGUAGE--ANSI FORTRAN (1977)
19304C     VERSION NUMBER--2012/1
19305C     ORIGINAL VERSION--JANUARY   2012.
19306C     UPDATED         --JUNE      2015. ADD ITYPE = 3.  THIS IS
19307C                                       EQUIVALENT TO ITYPE = 2, BUT
19308C                                       FOR LATEX IT WILL NOT ENCLOSE
19309C                                       THE TEXT WITHIN A "TABLE"
19310C                                       STRUCTURE
19311C
19312C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19313C
19314      CHARACTER*(*) ITEXT
19315      REAL          AVALUE
19316      INTEGER       IDIGIT
19317C
19318      CHARACTER*4 ICAPSW
19319      CHARACTER*4 ICAPTY
19320      CHARACTER*4 ISUBRO
19321      CHARACTER*4 IBUGA3
19322      CHARACTER*4 IERROR
19323C
19324      CHARACTER*4 ISUBN1
19325      CHARACTER*4 ISUBN2
19326      CHARACTER*4 ISTEPN
19327      CHARACTER*20 IFORMT
19328      CHARACTER*1 IBASLC
19329C
19330      LOGICAL IFLAG1
19331      LOGICAL IFLAG2
19332      LOGICAL IFLAGA
19333      LOGICAL IFLAGB
19334C
19335C---------------------------------------------------------------------
19336C
19337      INCLUDE 'DPCOST.INC'
19338C
19339      PARAMETER (MAXHED=1024)
19340      INTEGER IWIDTH(MAXHED)
19341      INTEGER NUMDIG(MAXHED)
19342      CHARACTER*8 ALIGN(MAXHED)
19343      CHARACTER*8 VALIGN(MAXHED)
19344      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
19345      CHARACTER*132 IHEAD
19346C
19347      CHARACTER*4 IRTFMD
19348      COMMON/COMRTF/IRTFMD
19349C
19350C---------------------------------------------------------------------
19351C
19352      INCLUDE 'DPCOP2.INC'
19353C
19354C-----START POINT-----------------------------------------------------
19355C
19356      ISUBN1='DPDT'
19357      ISUBN2='XT  '
19358      IERROR='NO'
19359C
19360      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTXT')THEN
19361        WRITE(ICOUT,999)
19362  999   FORMAT(1X)
19363        CALL DPWRST('XXX','WRIT')
19364        WRITE(ICOUT,51)
19365   51   FORMAT('**** AT THE BEGINNING OF DPDTXT--')
19366        CALL DPWRST('XXX','WRIT')
19367        WRITE(ICOUT,52)IBUGA3,ISUBRO,AVALUE
19368   52   FORMAT('IBUGA3,ISUBRO,AVALUE = ',2(A4,2X),G15.7)
19369        CALL DPWRST('XXX','WRIT')
19370        IF(NCTEXT.GT.0)THEN
19371          WRITE(ICOUT,57)ITEXT(1:NCTEXT)
19372   57     FORMAT('ITEXT = ',A80)
19373          CALL DPWRST('XXX','WRIT')
19374        ENDIF
19375      ENDIF
19376C
19377C               *******************************************
19378C               **   STEP 1--                            **
19379C               **   WRITE OUT THE TITLE AND HEADER LINE **
19380C               *******************************************
19381C
19382      ISTEPN='1'
19383      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DTXT')
19384     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19385C
19386      IF(IPRINT.EQ.'ON')THEN
19387C
19388C       PRELIMINARY CODE IF FIRST LINE
19389C
19390        IF(IFLAG1)THEN
19391          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
19392            WRITE(ICOUT,2116)
19393 2116       FORMAT('</PRE>')
19394            CALL DPWRST('XXX','WRIT')
19395          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
19396            IJUNK=92
19397            CALL DPCONA(IJUNK,IBASLC)
19398            WRITE(ICOUT,2126)IBASLC
19399 2126       FORMAT(A1,'end{verbatim}')
19400            CALL DPWRST('XXX','WRIT')
19401            IF(ISIZE.EQ.-1)THEN
19402              WRITE(ICOUT,2127)IBASLC
19403 2127         FORMAT(A1,'small')
19404              CALL DPWRST('XXX','WRIT')
19405            ELSEIF(ISIZE.EQ.-2)THEN
19406              WRITE(ICOUT,2128)IBASLC
19407 2128         FORMAT(A1,'tiny')
19408              CALL DPWRST('XXX','WRIT')
19409            ELSEIF(ISIZE.EQ.0)THEN
19410              WRITE(ICOUT,2130)IBASLC
19411 2130         FORMAT(A1,'normalsize')
19412              CALL DPWRST('XXX','WRIT')
19413            ENDIF
19414            IF(ITYPE.NE.3)THEN
19415              WRITE(ICOUT,2129)IBASLC
19416 2129         FORMAT(A1,'begin{table}')
19417              CALL DPWRST('XXX','WRIT')
19418            ENDIF
19419          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
19420          ELSE
19421          ENDIF
19422        ENDIF
19423C
19424C       CASE 1: A HEADER LINE
19425C
19426        IF(ITYPE.EQ.1 .AND. NCTEXT.GT.0)THEN
19427          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
19428            WRITE(ICOUT,1001)
19429 1001       FORMAT('<CENTER><H2>')
19430            CALL DPWRST('XXX','WRIT')
19431            IFORMT=' '
19432            IFORMT='(A  )'
19433            WRITE(IFORMT(3:4),'(I2)')NCTEXT
19434            WRITE(ICOUT,IFORMT)ITEXT(1:NCTEXT)
19435            CALL DPWRST('XXX','WRIT')
19436            WRITE(ICOUT,1004)
19437 1004       FORMAT('</H2></CENTER><BR><BR>')
19438            CALL DPWRST('XXX','WRIT')
19439          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
19440            IFLAGA=.FALSE.
19441            IFLAGB=.TRUE.
19442            CALL DPLAT8(ITEXT,NCTEXT,IFLAGA,IFLAGB)
19443          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
19444            IF(IRTFFP.EQ.'Times New Roman')THEN
19445              ITEMP=0
19446            ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
19447              ITEMP=6
19448            ELSEIF(IRTFFP.EQ.'Arial')THEN
19449              ITEMP=2
19450            ELSEIF(IRTFFP.EQ.'Bookman')THEN
19451              ITEMP=3
19452            ELSEIF(IRTFFP.EQ.'Georgia')THEN
19453              ITEMP=4
19454            ELSEIF(IRTFFP.EQ.'Tahoma')THEN
19455              ITEMP=5
19456            ELSEIF(IRTFFP.EQ.'Verdana')THEN
19457              ITEMP=7
19458            ELSE
19459              ITEMP=0
19460            ENDIF
19461C
19462            IRTFMD='OFF'
19463            IFLAG1=.TRUE.
19464            CALL DPRTF8(ITEXT,NCTEXT,ITEMP,IFLAG1)
19465            NHEAD=0
19466          ELSE
19467            IF(NBLNK1.GT.0)THEN
19468              DO1010I=1,NBLNK1
19469                WRITE(ICOUT,999)
19470                CALL DPWRST('XXX','WRIT')
19471 1010         CONTINUE
19472            ENDIF
19473            IFORMT=' '
19474            IFORMT='(6X,A  )'
19475            WRITE(IFORMT(6:7),'(I2)')NCTEXT
19476            WRITE(ICOUT,IFORMT)ITEXT(1:NCTEXT)
19477            CALL DPWRST('XXX','WRIT')
19478            WRITE(ICOUT,999)
19479            CALL DPWRST('XXX','WRIT')
19480            WRITE(ICOUT,999)
19481            CALL DPWRST('XXX','WRIT')
19482            IF(NBLNK2.GT.0)THEN
19483              DO1020I=1,NBLNK2
19484                WRITE(ICOUT,999)
19485                CALL DPWRST('XXX','WRIT')
19486 1020         CONTINUE
19487            ENDIF
19488          ENDIF
19489C
19490C       CASE 2: SOME TEXT WITH AN OPTIONAL NUMERIC VALUE AT END
19491C
19492        ELSEIF((ITYPE.EQ.2 .OR. ITYPE.EQ.3) .AND. NCTEXT.GT.0)THEN
19493          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
19494            IF(NBLNK1.GT.0)THEN
19495              IHEAD=' '
19496              NCHAR=1
19497              DO2110I=1,NBLNK1
19498                CALL DPHTMW(IHEAD,NCHAR,CPUMIN,IDIGIT)
19499 2110         CONTINUE
19500            ENDIF
19501            CALL DPHTMW(ITEXT,NCTEXT,AVALUE,IDIGIT)
19502            IF(NBLNK2.GT.0)THEN
19503              IHEAD=' '
19504              NCHAR=1
19505              DO2120I=1,NBLNK2
19506                CALL DPHTMW(IHEAD,NCHAR,CPUMIN,IDIGIT)
19507 2120         CONTINUE
19508            ENDIF
19509          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
19510            IF(NBLNK1.GT.0)THEN
19511              IHEAD=' '
19512              NCHAR=1
19513              DO2210I=1,NBLNK1
19514                CALL DPLAT7(IHEAD,NCHAR,CPUMIN,IDIGIT)
19515 2210         CONTINUE
19516            ENDIF
19517            CALL DPLAT7(ITEXT,NCTEXT,AVALUE,IDIGIT)
19518            IF(NBLNK2.GT.0)THEN
19519              IHEAD=' '
19520              NCHAR=1
19521              DO2220I=1,NBLNK2
19522                CALL DPLAT7(IHEAD,NCHAR,CPUMIN,IDIGIT)
19523 2220         CONTINUE
19524            ENDIF
19525          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
19526            IF(NBLNK1.GT.0)THEN
19527              IHEAD=' '
19528              NCHAR=1
19529              DO2310I=1,NBLNK1
19530                CALL DPRTF7(IHEAD,NCHAR,CPUMIN,IDIGIT)
19531 2310         CONTINUE
19532            ENDIF
19533            CALL DPRTF7(ITEXT,NCTEXT,AVALUE,IDIGIT)
19534            IF(NBLNK2.GT.0)THEN
19535              IHEAD=' '
19536              NCHAR=1
19537              DO2320I=1,NBLNK2
19538                CALL DPRTF7(IHEAD,NCHAR,CPUMIN,IDIGIT)
19539 2320         CONTINUE
19540            ENDIF
19541          ELSE
19542            IF(NBLNK1.GT.0)THEN
19543              DO2410I=1,NBLNK1
19544                WRITE(ICOUT,999)
19545                CALL DPWRST('XXX','WRIT')
19546 2410         CONTINUE
19547            ENDIF
19548C
19549            IF(AVALUE.EQ.CPUMIN)THEN
19550              IFORMT=' '
19551              IFORMT='(A  )'
19552              WRITE(IFORMT(3:4),'(I2)')NCTEXT
19553              WRITE(ICOUT,IFORMT)ITEXT(1:NCTEXT)
19554              CALL DPWRST('XXX','WRIT')
19555            ELSE
19556              NBLANK=NTOTAL-NCTEXT
19557              IFORMT=' '
19558              IF(IDIGIT.GT.0)THEN
19559                AVALT=RND(AVALUE,IDIGIT)
19560                IXX=IDIGIT
19561                IYY=IXX+8
19562                IF(NBLANK.GT.0)THEN
19563                  IFORMT='(A  ,  X,F  .  )'
19564                  WRITE(IFORMT(3:4),'(I2)')NCTEXT
19565                  WRITE(IFORMT(6:7),'(I2)')NBLANK
19566                  WRITE(IFORMT(11:12),'(I2)')IYY
19567                  WRITE(IFORMT(14:15),'(I2)')IXX
19568                ELSE
19569                  IFORMT='(A  ,F  .  )'
19570                  WRITE(IFORMT(3:4),'(I2)')NCTEXT
19571                  WRITE(IFORMT(7:8),'(I2)')IYY
19572                  WRITE(IFORMT(10:11),'(I2)')IXX
19573                ENDIF
19574                WRITE(ICOUT,IFORMT)ITEXT(1:NCTEXT),AVALT
19575                CALL DPWRST('XXX','WRIT')
19576              ELSEIF(IDIGIT.LT.0)THEN
19577                NUMDI2=-IDIGIT
19578                AVALT=RND(AVALUE,NUMDI2)
19579                IXX=NUMDI2
19580                IYY=IXX+8
19581                IF(NBLANK.GT.0)THEN
19582                  IFORMT='(A  ,  X,EXX.YY)'
19583                  WRITE(IFORMT(3:4),'(I2)')NCTEXT
19584                  WRITE(IFORMT(6:7),'(I2)')NBLANK
19585                  WRITE(IFORMT(11:12),'(I2)')IYY
19586                  WRITE(IFORMT(14:15),'(I2)')IXX
19587                ELSE
19588                  IFORMT='(A  ,GXX.YY)'
19589                  WRITE(IFORMT(3:4),'(I2)')NCTEXT
19590                  WRITE(IFORMT(7:8),'(I2)')IYY
19591                  WRITE(IFORMT(10:11),'(I2)')IXX
19592                ENDIF
19593                WRITE(ICOUT,IFORMT)ITEXT(1:NCTEXT),AVALT
19594                CALL DPWRST('XXX','WRIT')
19595              ELSEIF(IDIGIT.EQ.0)THEN
19596                IVALT=INT(AVALUE + 0.5)
19597                IF(NBLANK.GT.0)THEN
19598                  IFORMT='(A  ,  X,I10)'
19599                  WRITE(IFORMT(3:4),'(I2)')NCTEXT
19600                  WRITE(IFORMT(6:7),'(I2)')NBLANK
19601                ELSE
19602                  IFORMT='(A  ,I10)'
19603                  WRITE(IFORMT(3:4),'(I2)')NCTEXT
19604                ENDIF
19605                WRITE(ICOUT,IFORMT)ITEXT(1:NCTEXT),IVALT
19606                CALL DPWRST('XXX','WRIT')
19607              ENDIF
19608            ENDIF
19609C
19610            IF(NBLNK2.GT.0)THEN
19611              DO2420I=1,NBLNK2
19612                WRITE(ICOUT,999)
19613                CALL DPWRST('XXX','WRIT')
19614 2420         CONTINUE
19615            ENDIF
19616          ENDIF
19617        ENDIF
19618C
19619C       ENDING CODE IF LAST LINE
19620C
19621        IF(IFLAG2)THEN
19622          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
19623            WRITE(ICOUT,2516)
19624 2516       FORMAT('<PRE>')
19625            CALL DPWRST('XXX','WRIT')
19626          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
19627            IJUNK=92
19628            CALL DPCONA(IJUNK,IBASLC)
19629            IF(ITYPE.NE.3)THEN
19630              WRITE(ICOUT,2518)IBASLC
19631 2518         FORMAT(A1,'end{table}')
19632              CALL DPWRST('XXX','WRIT')
19633            ENDIF
19634C
19635C           ONLY RESTORE NORMAL SIZE IF THIS NOT A SINGLE LINE
19636C
19637            IF(.NOT.IFLAG1)THEN
19638              IF(ISIZE.EQ.0)THEN
19639                WRITE(ICOUT,2526)IBASLC
19640 2526           FORMAT(A1,'normalsize')
19641                CALL DPWRST('XXX','WRIT')
19642              ELSEIF(ISIZE.EQ.-1)THEN
19643                WRITE(ICOUT,2527)IBASLC
19644 2527           FORMAT(A1,'small')
19645                CALL DPWRST('XXX','WRIT')
19646              ELSEIF(ISIZE.EQ.-2)THEN
19647                WRITE(ICOUT,2528)IBASLC
19648 2528           FORMAT(A1,'tiny')
19649                CALL DPWRST('XXX','WRIT')
19650              ENDIF
19651            ENDIF
19652            WRITE(ICOUT,2529)IBASLC
19653 2529       FORMAT(A1,'begin{verbatim}')
19654            CALL DPWRST('XXX','WRIT')
19655          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
19656          ELSE
19657          ENDIF
19658        ENDIF
19659C
19660      ENDIF
19661C
19662      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DTXT')THEN
19663        WRITE(ICOUT,999)
19664        CALL DPWRST('XXX','WRIT')
19665        WRITE(ICOUT,9011)
19666 9011   FORMAT('**** AT THE END OF DPDTXT--')
19667        CALL DPWRST('XXX','WRIT')
19668      ENDIF
19669C
19670      RETURN
19671      END
19672      SUBROUTINE DPDUAN(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
19673     1                  IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
19674C
19675C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS THAT WILL
19676C              WILL DEFINE A DUANE PLOT (USED IN RELIABILITY)
19677C              VERTICAL AXIS   = Ti /I
19678C              HORIZONTAL AXIS = Ti
19679C              WHERE Ti ARE SORTED FAILURE TIMES
19680C     WRITTEN BY--ALAN HECKERT
19681C                 STATISTICAL ENGINEERING DIVISION
19682C                 INFORMATION TECHNOLOGY LABORATORY
19683C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19684C                 GAITHERSBURG, MD 20899-8980
19685C                 PHONE--301-975-2899
19686C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19687C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19688C     LANGUAGE--ANSI FORTRAN (1977)
19689C     VERSION NUMBER--98/5
19690C     ORIGINAL VERSION--MAY        1998.
19691C     UPDATED         --APRIL      2011. USE DPPAR AND DPPAR3
19692C
19693C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19694C
19695      CHARACTER*4 ICASPL
19696      CHARACTER*4 IAND1
19697      CHARACTER*4 IAND2
19698      CHARACTER*4 IBUGG2
19699      CHARACTER*4 IBUGG3
19700      CHARACTER*4 ISUBRO
19701      CHARACTER*4 IBUGQ
19702      CHARACTER*4 IFOUND
19703      CHARACTER*4 IERROR
19704C
19705      CHARACTER*4 IH
19706      CHARACTER*4 IH2
19707      CHARACTER*4 ISUBN0
19708      CHARACTER*4 ISUBN1
19709      CHARACTER*4 ISUBN2
19710      CHARACTER*4 ISTEPN
19711C
19712      CHARACTER*4 ICASE
19713      PARAMETER (MAXSPN=10)
19714      CHARACTER*40 INAME
19715      CHARACTER*4 IVARN1(MAXSPN)
19716      CHARACTER*4 IVARN2(MAXSPN)
19717      CHARACTER*4 IVARTY(MAXSPN)
19718      REAL PVAR(MAXSPN)
19719      INTEGER ILIS(MAXSPN)
19720      INTEGER NRIGHT(MAXSPN)
19721      INTEGER ICOLR(MAXSPN)
19722C
19723C---------------------------------------------------------------------
19724C
19725      INCLUDE 'DPCOPA.INC'
19726C
19727      DIMENSION Y1(MAXOBV)
19728      INCLUDE 'DPCOZZ.INC'
19729      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
19730C
19731C-----COMMON----------------------------------------------------------
19732C
19733      INCLUDE 'DPCOHO.INC'
19734      INCLUDE 'DPCOHK.INC'
19735      INCLUDE 'DPCODA.INC'
19736      INCLUDE 'DPCOP2.INC'
19737C
19738C-----START POINT-----------------------------------------------------
19739C
19740      IFOUND='NO'
19741      IERROR='NO'
19742      ISUBN1='DPDU'
19743      ISUBN2='AN  '
19744C
19745      MAXCP1=MAXCOL+1
19746      MAXCP2=MAXCOL+2
19747      MAXCP3=MAXCOL+3
19748      MAXCP4=MAXCOL+4
19749      MAXCP5=MAXCOL+5
19750      MAXCP6=MAXCOL+6
19751C
19752      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'DUAN')THEN
19753        WRITE(ICOUT,999)
19754  999   FORMAT(1X)
19755        CALL DPWRST('XXX','BUG ')
19756        WRITE(ICOUT,51)
19757   51   FORMAT('***** AT THE BEGINNING OF DPDUAN--')
19758        CALL DPWRST('XXX','BUG ')
19759        WRITE(ICOUT,52)ICASPL,IAND1,IAND2,MAXCOL
19760   52   FORMAT('ICASPL,IAND1,IAND2,MAXCOL = ',3(A4,2X),I8)
19761        CALL DPWRST('XXX','BUG ')
19762        WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ,ISUBRO
19763   53   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
19764        CALL DPWRST('XXX','BUG ')
19765      ENDIF
19766C
19767C
19768C               **********************************
19769C               **  TREAT THE DUANE PLOT    **
19770C               **********************************
19771C
19772C               *******************************************
19773C               **  STEP 1--                             **
19774C               **  SEARCH FOR DUANE PLOT                **
19775C               *******************************************
19776C
19777      ISTEPN='11'
19778      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
19779     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19780C
19781      IF(NUMARG.GE.1.AND.
19782     1   ICOM.EQ.'DUAN'.AND.IHARG(1).EQ.'PLOT')THEN
19783        ICASPL='DUAN'
19784        ILASTC=1
19785      ELSE
19786        IFOUND='NO'
19787        GOTO9000
19788      ENDIF
19789C
19790      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
19791      IFOUND='YES'
19792C
19793C               ****************************************
19794C               **  STEP 2--                          **
19795C               **  EXTRACT THE VARIABLE LIST         **
19796C               ****************************************
19797C
19798      ISTEPN='2'
19799      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
19800     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19801C
19802      INAME='DUANE PLOT'
19803      MINNA=1
19804      MAXNA=100
19805      MINN2=2
19806      IFLAGE=1
19807      IFLAGM=1
19808      IFLAGP=0
19809      JMIN=1
19810      JMAX=NUMARG
19811      MINNVA=1
19812      MAXNVA=1
19813C
19814      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
19815     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
19816     1            JMIN,JMAX,
19817     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
19818     1            IVARN1,IVARN2,IVARTY,PVAR,
19819     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
19820     1            MINNVA,MAXNVA,
19821     1            IFLAGM,IFLAGP,
19822     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
19823      IF(IERROR.EQ.'YES')GOTO9000
19824C
19825      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')THEN
19826        WRITE(ICOUT,999)
19827        CALL DPWRST('XXX','BUG ')
19828        WRITE(ICOUT,281)
19829  281   FORMAT('***** AFTER CALL DPPARS--')
19830        CALL DPWRST('XXX','BUG ')
19831        WRITE(ICOUT,282)NQ,NUMVAR
19832  282   FORMAT('NQ,NUMVAR = ',2I8)
19833        CALL DPWRST('XXX','BUG ')
19834        IF(NUMVAR.GT.0)THEN
19835          DO285I=1,NUMVAR
19836            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
19837     1                      ICOLR(I)
19838  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
19839     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
19840            CALL DPWRST('XXX','BUG ')
19841  285     CONTINUE
19842        ENDIF
19843      ENDIF
19844C
19845C     EXTRACT THE VARIABLE.
19846C
19847      ICOL=1
19848      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
19849     1            INAME,IVARN1,IVARN2,IVARTY,
19850     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
19851     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
19852     1            MAXCP4,MAXCP5,MAXCP6,
19853     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
19854     1            Y1,Y1,Y1,NS,NS,NS,ICASE,
19855     1            IBUGG3,ISUBRO,IFOUND,IERROR)
19856      IF(IERROR.EQ.'YES')GOTO9000
19857C
19858C               ********************************************************
19859C               **  STEP 41--                                         **
19860C               **  FORM THE VERTICAL AND HORIZONTALAXIS              **
19861C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY)FOR THE    **
19862C               **  PLOT.   FORM THE CURVE DESIGNATION VARIABLED(.) . **
19863C               **  THIS WILL BE ALL ONES.                            **
19864C               **  DEFINE THE NUMBER OF PLOT POINTS   (NPLOTP).      **
19865C               **  DEFINE THE NUMBER OF PLOT VARIABLES(NPLOTV).      **
19866C               ********************************************************
19867C
19868      ISTEPN='41'
19869      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
19870     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19871C
19872      CALL DPDUA2(Y1,NS,ICASPL,MAXN,
19873     1            Y,X,D,NPLOTP,NPLOTV,
19874     1            ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
19875     1            IBUGG3,ISUBRO,IERROR)
19876C
19877C               ***************************************
19878C               **  STEP 61--                        **
19879C               **  COMPUTE DUANE PLOT STAT          **
19880C               **  UPDATE INTERNAL DATAPLOT TABLES  **
19881C               ***************************************
19882C
19883      ISTEPN='61'
19884      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
19885     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
19886C
19887      IH='DPCC'
19888      IH2='    '
19889      VALUE0=CCXY
19890      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19891     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19892     1IANS,IWIDTH,IBUGG3,IERROR)
19893C
19894      IH='DPA0'
19895      IH2='    '
19896      VALUE0=ALPHA
19897      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19898     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19899     1IANS,IWIDTH,IBUGG3,IERROR)
19900C
19901      IH='DPA1'
19902      IH2='    '
19903      VALUE0=BETA
19904      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19905     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19906     1IANS,IWIDTH,IBUGG3,IERROR)
19907C
19908      IH='SDDP'
19909      IH2='A0  '
19910      VALUE0=SDALPH
19911      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19912     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19913     1IANS,IWIDTH,IBUGG3,IERROR)
19914C
19915      IH='SDDP'
19916      IH2='A1  '
19917      VALUE0=SDBETA
19918      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19919     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19920     1IANS,IWIDTH,IBUGG3,IERROR)
19921C
19922      IH='DPRE'
19923      IH2='SSD '
19924      VALUE0=XRESSD
19925      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19926     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19927     1IANS,IWIDTH,IBUGG3,IERROR)
19928C
19929      IH='DPRE'
19930      IH2='SDF '
19931      VALUE0=XRESDF
19932      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
19933     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
19934     1IANS,IWIDTH,IBUGG3,IERROR)
19935C
19936C               *****************
19937C               **  STEP 90--  **
19938C               **  EXIT       **
19939C               *****************
19940C
19941 9000 CONTINUE
19942      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')THEN
19943        WRITE(ICOUT,999)
19944        CALL DPWRST('XXX','BUG ')
19945        WRITE(ICOUT,9011)
19946 9011   FORMAT('***** AT THE END       OF DPDUAN--')
19947        CALL DPWRST('XXX','BUG ')
19948        WRITE(ICOUT,9012)IFOUND,IERROR
19949 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
19950        CALL DPWRST('XXX','BUG ')
19951        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
19952 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
19953     1         3I8,2X,2(A4,2X),A4)
19954        CALL DPWRST('XXX','BUG ')
19955        IF(NPLOTP.GT.0)THEN
19956          DO9015I=1,NPLOTP
19957            WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
19958 9016       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
19959            CALL DPWRST('XXX','BUG ')
19960 9015     CONTINUE
19961        ENDIF
19962      ENDIF
19963C
19964      RETURN
19965      END
19966      SUBROUTINE DPDUA2(Y1,N,ICASPL,MAXN,
19967     1                  Y,X,D,NPLOTP,NPLOTV,
19968     1                  ALPHA,BETA,XRESSD,XRESDF,CCXY,
19969     1                  SDALPH,SDBETA,CCALBE,
19970     1                  IBUGG3,ISUBRO,IERROR)
19971C
19972C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
19973C              THAT WILL DEFINE A DUANE PLOT
19974C              VERTICAL AXIS   = Ti/I
19975C              HORIZONTAL AXIS = Ti
19976C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
19977C                               (UNSORTED) OBSERVATIONS
19978C                               FOR THE FIRST  VARIABLE.
19979C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
19980C                               IN THE VECTOR X.
19981C     CAUTION--THE INPUT VARIABLE Y1(.) WILL BE CHANGED HEREIN
19982C              (IT WILL BE SORTED)
19983C     WRITTEN BY--ALAN HECKERT
19984C                 STATISTICAL ENGINEERING DIVISION
19985C                 INFORMATION TECHNOLOGY LABORATORY
19986C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19987C                 GAITHERSBURG, MD 20899-8980
19988C                 PHONE--301-975-2899
19989C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19990C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19991C     LANGUAGE--ANSI FORTRAN (1977)
19992C     VERSION NUMBER--98/5
19993C     ORIGINAL VERSION--MAY       1998.
19994C
19995C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
19996C
19997      CHARACTER*4 ICASPL
19998      CHARACTER*4 IBUGG3
19999      CHARACTER*4 ISUBRO
20000      CHARACTER*4 IERROR
20001C
20002      CHARACTER*4 ISUBN0
20003      CHARACTER*4 ISUBN1
20004      CHARACTER*4 ISUBN2
20005C
20006C---------------------------------------------------------------------
20007C
20008      DIMENSION Y1(*)
20009C
20010      DIMENSION Y(*)
20011      DIMENSION X(*)
20012      DIMENSION D(*)
20013C
20014C---------------------------------------------------------------------
20015C
20016      INCLUDE 'DPCOP2.INC'
20017C
20018C-----START POINT-----------------------------------------------------
20019C
20020      ISUBN1='DPDU'
20021      ISUBN2='A2  '
20022      IERROR='NO'
20023C
20024      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'DUA2')THEN
20025        WRITE(ICOUT,999)
20026  999   FORMAT(1X)
20027        CALL DPWRST('XXX','BUG ')
20028        WRITE(ICOUT,51)
20029   51   FORMAT('***** AT THE BEGINNING OF DPDUA2--')
20030        CALL DPWRST('XXX','BUG ')
20031        WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
20032   52   FORMAT('IBUGG3,ISUBRO,IERROR = ',2(A4,2X),A4)
20033        CALL DPWRST('XXX','BUG ')
20034        WRITE(ICOUT,53)N,ICASPL,MAXN
20035   53   FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
20036        CALL DPWRST('XXX','BUG ')
20037        DO55I=1,N
20038          WRITE(ICOUT,56)I,Y1(I)
20039   56     FORMAT('I, Y1(I), = ',I8,G15.7)
20040          CALL DPWRST('XXX','BUG ')
20041   55   CONTINUE
20042      ENDIF
20043C
20044C               ********************************************
20045C               **  STEP 1--                              **
20046C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
20047C               ********************************************
20048C
20049      IF(N.LT.2)THEN
20050        WRITE(ICOUT,999)
20051        CALL DPWRST('XXX','BUG ')
20052        WRITE(ICOUT,111)
20053  111   FORMAT('***** ERROR IN DUANE PLOT--')
20054        CALL DPWRST('XXX','BUG ')
20055        WRITE(ICOUT,112)
20056  112   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST TWO;')
20057        CALL DPWRST('XXX','BUG ')
20058        WRITE(ICOUT,114)N
20059  114   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
20060        CALL DPWRST('XXX','BUG ')
20061        WRITE(ICOUT,999)
20062        CALL DPWRST('XXX','BUG ')
20063        IERROR='YES'
20064        GOTO9000
20065      ENDIF
20066C
20067      HOLD=Y1(1)
20068      DO120I=1,N
20069      IF(Y1(I).NE.HOLD)GOTO129
20070  120 CONTINUE
20071      WRITE(ICOUT,999)
20072      CALL DPWRST('XXX','BUG ')
20073      WRITE(ICOUT,111)
20074      CALL DPWRST('XXX','BUG ')
20075      WRITE(ICOUT,122)
20076  122 FORMAT('      ALL ELEMENTS IN THE THE RESPONSE VARIABLE')
20077      CALL DPWRST('XXX','BUG ')
20078      WRITE(ICOUT,123)HOLD
20079  123 FORMAT('      ARE IDENTICALLY EQUAL TO ',G15.7)
20080      CALL DPWRST('XXX','BUG ')
20081      WRITE(ICOUT,999)
20082      CALL DPWRST('XXX','BUG ')
20083      IERROR='YES'
20084      GOTO9000
20085  129 CONTINUE
20086C
20087C               ***********************************************
20088C               **  STEP 12--                                **
20089C               **  COMPUTE COORDINATES FOR DUANE     PLOT   **
20090C               **  NOTE--THE LOGGING OF THE 1-F(X) WILL     **
20091C               **        NOTE BE DONE HEREIN BUT WILL       **
20092C               **        BE DONE IN THE UNDERLYING          **
20093C               **        GRAPHICS BY LOG SCALE              **
20094C               ***********************************************
20095C
20096C
20097      CALL SORT(Y1,N,Y1)
20098C
20099      AN=N
20100      J=0
20101      DO1100I=1,N
20102        J=J+1
20103        X(J)=Y1(I)
20104        Y(J)=Y1(J)/REAL(J)
20105        D(J)=1.0
20106 1100 CONTINUE
20107      NPLOTP=J
20108C
20109C  NOTE: FOR FITTED LINE, NEED TO FIT THE LOGS OF Y AND X
20110C
20111      ISUBN0='DPDU'
20112      DO200I=1,NPLOTP
20113       Y(I)=LOG(Y(I))
20114       X(I)=LOG(X(I))
20115 200  CONTINUE
20116      CALL LINFIT(Y,X,NPLOTP,
20117     1            ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
20118     1            ISUBRO,IBUGG3,IERROR)
20119      DO300I=1,NPLOTP
20120       Y(I)=EXP(Y(I))
20121       X(I)=EXP(X(I))
20122 300  CONTINUE
20123      NPLOTP=NPLOTP+1
20124      X(NPLOTP)=X(1)
20125      Y(NPLOTP)=EXP(ALPHA+BETA*LOG(X(1)))
20126      D(NPLOTP)=2.0
20127      NPLOTP=NPLOTP+1
20128      X(NPLOTP)=X(N)
20129      Y(NPLOTP)=EXP(ALPHA+BETA*LOG(X(N)))
20130      D(NPLOTP)=2.0
20131C
20132      NPLOTV=2
20133      GOTO9000
20134C
20135C               ******************
20136C               **   STEP 90--  **
20137C               **   EXIT       **
20138C               ******************
20139C
20140 9000 CONTINUE
20141      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'DUA2')THEN
20142        WRITE(ICOUT,999)
20143        CALL DPWRST('XXX','BUG ')
20144        WRITE(ICOUT,9011)
20145 9011   FORMAT('***** AT THE END       OF DPDUA2--')
20146        CALL DPWRST('XXX','BUG ')
20147        WRITE(ICOUT,9021)NPLOTP,NPLOTV
20148 9021   FORMAT('NPLOTP,NPLOTV = ',2I8)
20149        CALL DPWRST('XXX','BUG ')
20150        DO9022I=1,NPLOTP
20151          WRITE(ICOUT,9023)I,Y(I),X(I),D(I)
20152 9023     FORMAT('I,Y(I),X(I),D(I) = ',I8,3G15.7)
20153          CALL DPWRST('XXX','BUG ')
20154 9022   CONTINUE
20155      ENDIF
20156C
20157      RETURN
20158      END
20159      SUBROUTINE DPDURB(YTEMP,XTEMP,MAXNXT,
20160     1                  ICAPSW,IFORSW,
20161     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
20162C
20163C     PURPOSE--CARRY OUT DURBIN TEST NON-PARAMETRIC TWO-WAY ANOVA
20164C              OF INCOMPLETE BLOCK DESIGNS
20165C     EXAMPLE--DURBIN TEST Y X1 X2
20166C     REFERENCE--W. J. CONOVER (1999).  "PRACTICAL NONPARAMETRIC
20167C                STATISTICS", THIRD EDITION, WILEY, PP. 388-395.
20168C     WRITTEN BY--ALAN HECKERT
20169C                 STATISTICAL ENGINEERING DIVISION
20170C                 INFORMATION TECHNOLOGY LABORATORY
20171C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20172C                 GAITHERSBURG, MD 20899-8980
20173C                 PHONE--301-975-2899
20174C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20175C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20176C     LANGUAGE--ANSI FORTRAN (1977)
20177C     VERSION NUMBER--2006/1
20178C     ORIGINAL VERSION--JANUARY   2006.
20179C     UPDATED         --JANUARY   2007. CALL LIST TO DPDUR2
20180C     UPDATED         --APRIL     2011. USE DPPARS AND DPPARS3
20181C
20182C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20183C
20184      CHARACTER*4 ICAPSW
20185      CHARACTER*4 IFORSW
20186      CHARACTER*4 IBUGA2
20187      CHARACTER*4 IBUGA3
20188      CHARACTER*4 IBUGQ
20189      CHARACTER*4 ISUBRO
20190      CHARACTER*4 IFOUND
20191      CHARACTER*4 IERROR
20192C
20193      CHARACTER*4 ISUBN1
20194      CHARACTER*4 ISUBN2
20195      CHARACTER*4 ISTEPN
20196C
20197      LOGICAL IFRST
20198      LOGICAL ILAST
20199      CHARACTER*4 IFLAGU
20200      CHARACTER*4 ICASE
20201      CHARACTER*40 INAME
20202      PARAMETER (MAXSPN=30)
20203      CHARACTER*4 IVARN1(MAXSPN)
20204      CHARACTER*4 IVARN2(MAXSPN)
20205      CHARACTER*4 IVARTY(MAXSPN)
20206      REAL PVAR(MAXSPN)
20207      INTEGER ILIS(MAXSPN)
20208      INTEGER NRIGHT(MAXSPN)
20209      INTEGER ICOLR(MAXSPN)
20210C
20211C---------------------------------------------------------------------
20212C
20213      DIMENSION YTEMP(*)
20214      DIMENSION XTEMP(*)
20215C
20216C-----COMMON----------------------------------------------------------
20217C
20218      INCLUDE 'DPCOPA.INC'
20219C
20220      DIMENSION XTEMP2(MAXOBV)
20221      DIMENSION DBLOCK(MAXOBV)
20222      DIMENSION DTREAT(MAXOBV)
20223      DIMENSION YRANK(MAXOBV)
20224      DIMENSION RJ(MAXOBV)
20225      DIMENSION XTEMP3(MAXOBV)
20226C
20227      INCLUDE 'DPCOZZ.INC'
20228      EQUIVALENCE(GARBAG(IGARB1),XTEMP2(1))
20229      EQUIVALENCE(GARBAG(IGARB2),DBLOCK(1))
20230      EQUIVALENCE(GARBAG(IGARB3),DTREAT(1))
20231      EQUIVALENCE(GARBAG(IGARB4),YRANK(1))
20232      EQUIVALENCE(GARBAG(IGARB5),RJ(1))
20233      EQUIVALENCE(GARBAG(IGARB6),XTEMP3(1))
20234C
20235      INCLUDE 'DPCOHK.INC'
20236      INCLUDE 'DPCOSU.INC'
20237      INCLUDE 'DPCODA.INC'
20238C
20239C-----COMMON VARIABLES (GENERAL)--------------------------------------
20240C
20241      INCLUDE 'DPCOP2.INC'
20242C
20243C-----START POINT-----------------------------------------------------
20244C
20245      ISUBN1='DPDU'
20246      ISUBN2='RB  '
20247      IFOUND='YES'
20248      IERROR='NO'
20249C
20250      MAXCP1=MAXCOL+1
20251      MAXCP2=MAXCOL+2
20252      MAXCP3=MAXCOL+3
20253      MAXCP4=MAXCOL+4
20254      MAXCP5=MAXCOL+5
20255      MAXCP6=MAXCOL+6
20256C
20257C               ******************************************
20258C               **  TREAT THE DURBIN TEST CASE          **
20259C               ******************************************
20260C
20261      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')THEN
20262        WRITE(ICOUT,999)
20263  999   FORMAT(1X)
20264        CALL DPWRST('XXX','BUG ')
20265        WRITE(ICOUT,51)
20266   51   FORMAT('***** AT THE BEGINNING OF DPDURB--')
20267        CALL DPWRST('XXX','BUG ')
20268        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO,MAXNXT
20269   52   FORMAT('IBUGA2,IBUGA3,IBUBQ,ISUBRO,MAXNXT = ',4(A4,2X),I8)
20270        CALL DPWRST('XXX','BUG ')
20271        WRITE(ICOUT,53)ICAPSW,ICAPTY,IFORSW
20272   53   FORMAT('ICAPSW,ICAPTY,IFORSW = ',2(A4,2X),A4)
20273        CALL DPWRST('XXX','BUG ')
20274      ENDIF
20275C
20276C               *********************************
20277C               **  STEP 1--                   **
20278C               **  EXTRACT THE VARIABLE LIST  **
20279C               *********************************
20280C
20281      ISTEPN='1'
20282      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
20283     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20284C
20285      INAME='DURBIN TEST'
20286      MAXNA=100
20287      MINNVA=1
20288      MAXNVA=3
20289      MINNA=1
20290      IFLAGE=1
20291      IFLAGM=0
20292      MINN2=2
20293      IFLAGP=0
20294      JMIN=1
20295      JMAX=NUMARG
20296C
20297      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
20298     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
20299     1            JMIN,JMAX,
20300     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
20301     1            IVARN1,IVARN2,IVARTY,PVAR,
20302     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
20303     1            MINNVA,MAXNVA,
20304     1            IFLAGM,IFLAGP,
20305     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
20306      IF(IERROR.EQ.'YES')GOTO9000
20307C
20308      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')THEN
20309        WRITE(ICOUT,999)
20310        CALL DPWRST('XXX','BUG ')
20311        WRITE(ICOUT,181)
20312  181   FORMAT('***** AFTER CALL DPPARS--')
20313        CALL DPWRST('XXX','BUG ')
20314        WRITE(ICOUT,182)NQ,NUMVAR,IMULT
20315  182   FORMAT('NQ,NUMVAR,IMULT = ',2I8,2X,A4)
20316        CALL DPWRST('XXX','BUG ')
20317        IF(NUMVAR.GT.0)THEN
20318          DO185I=1,NUMVAR
20319            WRITE(ICOUT,187)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
20320     1                      ICOLR(I)
20321  187       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
20322     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
20323            CALL DPWRST('XXX','BUG ')
20324  185     CONTINUE
20325        ENDIF
20326      ENDIF
20327C
20328C               **********************************
20329C               **  STEP 52--                   **
20330C               **  CARRY OUT THE DURBIN TEST   **
20331C               **********************************
20332C
20333      ISTEPN='52'
20334      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
20335     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20336C
20337      ICOL=1
20338      NUMVA2=3
20339      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
20340     1            INAME,IVARN1,IVARN2,IVARTY,
20341     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
20342     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
20343     1            MAXCP4,MAXCP5,MAXCP6,
20344     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
20345     1            Y,X,XTEMP2,NS1,NS1,NS1,ICASE,
20346     1            IBUGA3,ISUBRO,IFOUND,IERROR)
20347      IF(IERROR.EQ.'YES')GOTO9000
20348C
20349      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DURB')THEN
20350        WRITE(ICOUT,999)
20351        CALL DPWRST('XXX','BUG ')
20352        WRITE(ICOUT,5211)
20353 5211   FORMAT('***** FROM DPDURB, AS WE ARE ABOUT TO CALL DPDUR2--')
20354        CALL DPWRST('XXX','BUG ')
20355        WRITE(ICOUT,5212)NS1
20356 5212   FORMAT('NS1 = ',I8)
20357        CALL DPWRST('XXX','BUG ')
20358        DO5215I=1,NS1
20359          WRITE(ICOUT,5216)I,Y(I),X(I),XTEMP2(I)
20360 5216     FORMAT('I,Y(I),X(I),XTEMP2(I) = ',I8,3G15.7)
20361          CALL DPWRST('XXX','BUG ')
20362 5215   CONTINUE
20363      ENDIF
20364C
20365      CALL DPDUR2(Y,X,XTEMP2,NS1,IVARN1,IVARN2,
20366     1            YTEMP,XTEMP,YRANK,RJ,DBLOCK,DTREAT,
20367     1            XTEMP3,MAXNXT,
20368     1            STATVA,STATCD,PVAL,
20369     1            CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,CUT99,CUT999,
20370     1            ICAPSW,ICAPTY,IFORSW,
20371     1            IBUGA3,ISUBRO,IERROR)
20372C
20373      IFLAGU='ON'
20374      IFRST=.TRUE.
20375      ILAST=.TRUE.
20376      CALL DPFRT5(STATVA,STATCD,PVAL,
20377     1            CUT0,CUT50,CUT75,CUT90,CUT95,
20378     1            CUT975,CUT99,CUT999,
20379     1            IFLAGU,IFRST,ILAST,
20380     1            IBUGA2,IBUGA3,ISUBRO,IERROR)
20381C
20382C               *****************
20383C               **  STEP 90--  **
20384C               **  EXIT       **
20385C               *****************
20386C
20387 9000 CONTINUE
20388      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
20389        WRITE(ICOUT,999)
20390        CALL DPWRST('XXX','BUG ')
20391        WRITE(ICOUT,9011)
20392 9011   FORMAT('***** AT THE END       OF DPDURB--')
20393        CALL DPWRST('XXX','BUG ')
20394        WRITE(ICOUT,9016)IFOUND,IERROR
20395 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
20396        CALL DPWRST('XXX','BUG ')
20397      ENDIF
20398C
20399      RETURN
20400      END
20401      SUBROUTINE DPDUR2(Y,BLOCK,TREAT,N,IVARID,IVARI2,
20402     1                  YTEMP,XTEMP,YRANK,RJ,DBLOCK,DTREAT,
20403     1                  XTEMP2,MAXNXT,
20404     1                  STATVA,STATCD,PVAL,
20405     1                  CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,
20406     1                  CUT99,CUT999,
20407     1                  ICAPSW,ICAPTY,IFORSW,
20408     1                  IBUGA3,ISUBRO,IERROR)
20409C
20410C     PURPOSE--THIS ROUTINE CARRIES OUT DURBIN'S TEST
20411C              NON-PARAMETRIC TWO-WAY ANOVA FOR BALANCED,
20412C              INCOMPLETE BLOCK DESIGNS
20413C     EXAMPLE--DURBIN TEST Y BLOCK TREAT
20414C     REFERENCE--W. J. CONOVER (1999).  "PRACTICAL NONPARAMETRIC
20415C                STATISTICS", THIRD EDITION, WILEY, PP. 388-395.
20416c     WRITTEN BY--ALAN HECKERT
20417C                 STATISTICAL ENGINEERING DIVISION
20418C                 INFORMATION TECHNOLOGY LABORATORY
20419C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20420C                 GAITHERSBURG, MD 20899-8980
20421C                 PHONE--301-975-2899
20422C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20423C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20424C     LANGUAGE--ANSI FORTRAN (1977)
20425C     VERSION NUMBER--2006/1
20426C     ORIGINAL VERSION--JANUARY   2006.
20427C     UPDATED         --OCTOBER   2006. CALL LIST TO TPPF
20428C     UPDATED         --JANUARY   2007. CALL LIST TO RANK
20429C     UPDATED         --APRIL     2011. USE DPDTA1 AND DPDTA4 TO
20430C                                       PRINT TABLES.  THIS ADDS RTF
20431C                                       SUPPORT AND SPECIFICATION OF
20432C                                       THE NUMBER OF DIGITS.
20433C
20434C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20435C
20436      CHARACTER*4 ICAPSW
20437      CHARACTER*4 ICAPTY
20438      CHARACTER*4 IFORSW
20439      CHARACTER*4 IBUGA3
20440      CHARACTER*4 ISUBRO
20441      CHARACTER*4 IERROR
20442      CHARACTER*4 IVARID(*)
20443      CHARACTER*4 IVARI2(*)
20444C
20445      CHARACTER*4 IWRITE
20446      CHARACTER*4 ISUBN1
20447      CHARACTER*4 ISUBN2
20448      CHARACTER*4 ISTEPN
20449      CHARACTER*4 IOP
20450      CHARACTER*3 IATEMP
20451C
20452      DOUBLE PRECISION DSUM1
20453      DOUBLE PRECISION DSUM2
20454C
20455C---------------------------------------------------------------------
20456C
20457      DIMENSION Y(*)
20458      DIMENSION BLOCK(*)
20459      DIMENSION TREAT(*)
20460      DIMENSION YRANK(*)
20461      DIMENSION RJ(*)
20462      DIMENSION DBLOCK(*)
20463      DIMENSION DTREAT(*)
20464      DIMENSION YTEMP(*)
20465      DIMENSION XTEMP(*)
20466      DIMENSION XTEMP2(*)
20467C
20468      PARAMETER (NUMALP=8)
20469      REAL ALPHA(NUMALP)
20470C
20471      PARAMETER(NUMCLI=6)
20472      PARAMETER(MAXLIN=2)
20473      PARAMETER (MAXROW=50)
20474      CHARACTER*60 ITITLE
20475      CHARACTER*60 ITITLZ
20476      CHARACTER*1  ITITL9
20477      CHARACTER*60 ITEXT(MAXROW)
20478      CHARACTER*4  ALIGN(NUMCLI)
20479      CHARACTER*4  VALIGN(NUMCLI)
20480      REAL         AVALUE(MAXROW)
20481      INTEGER      NCTEXT(MAXROW)
20482      INTEGER      IDIGIT(MAXROW)
20483      INTEGER      NTOT(MAXROW)
20484      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
20485      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
20486      CHARACTER*4  ITYPCO(NUMCLI)
20487      INTEGER      NCTIT2(MAXLIN,NUMCLI)
20488      INTEGER      NCVALU(MAXROW,NUMCLI)
20489      INTEGER      IWHTML(NUMCLI)
20490      INTEGER      IWRTF(NUMCLI)
20491      REAL         AMAT(MAXROW,NUMCLI)
20492      LOGICAL IFRST
20493      LOGICAL ILAST
20494C
20495C---------------------------------------------------------------------
20496C
20497      INCLUDE 'DPCOP2.INC'
20498C
20499C-----START POINT-----------------------------------------------------
20500C
20501      DATA ALPHA/
20502     1 0.0, 50.0, 75.0, 90.0, 95.0, 97.5, 99.0, 99.9/
20503C
20504      ISUBN1='DPDU'
20505      ISUBN2='R2  '
20506C
20507      IERROR='NO'
20508C
20509      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
20510        WRITE(ICOUT,999)
20511  999   FORMAT(1X)
20512        CALL DPWRST('XXX','WRIT')
20513        WRITE(ICOUT,51)
20514   51   FORMAT('**** AT THE BEGINNING OF DPDUR2--')
20515        CALL DPWRST('XXX','WRIT')
20516        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
20517   52   FORMAT('IBUGA3,ISUBRO,N = ',2(A4,2X),I8)
20518        CALL DPWRST('XXX','WRIT')
20519        DO56I=1,N
20520          WRITE(ICOUT,57)I,Y(I),BLOCK(I),TREAT(I)
20521   57     FORMAT('I,Y(I),BLOCK(I),TREAT(I) = ',I8,3G15.7)
20522          CALL DPWRST('XXX','WRIT')
20523   56   CONTINUE
20524      ENDIF
20525C
20526C               ********************************************
20527C               **  STEP 11--                             **
20528C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
20529C               ********************************************
20530C
20531      ISTEPN='11'
20532      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DUR2')
20533     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20534C
20535      HOLD=Y(1)
20536      DO1135I=2,N
20537      IF(Y(I).NE.HOLD)GOTO1139
20538 1135 CONTINUE
20539      WRITE(ICOUT,999)
20540      CALL DPWRST('XXX','WRIT')
20541      WRITE(ICOUT,1131)
20542 1131 FORMAT('***** ERROR FROM DURBIN TEST--')
20543      CALL DPWRST('XXX','WRIT')
20544      WRITE(ICOUT,1133)HOLD
20545 1133 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
20546      CALL DPWRST('XXX','WRIT')
20547      IERROR='YES'
20548      GOTO9000
20549 1139 CONTINUE
20550C
20551      HOLD=BLOCK(1)
20552      DO1235I=2,N
20553      IF(BLOCK(I).NE.HOLD)GOTO1239
20554 1235 CONTINUE
20555      WRITE(ICOUT,999)
20556      CALL DPWRST('XXX','WRIT')
20557      WRITE(ICOUT,1131)
20558      CALL DPWRST('XXX','WRIT')
20559      WRITE(ICOUT,1231)HOLD
20560 1231 FORMAT('      THE FIRST FACTOR VARIABLE HAS ALL ELEMENTS = ',
20561     1       G15.7)
20562      CALL DPWRST('XXX','WRIT')
20563      IERROR='YES'
20564      GOTO9000
20565 1239 CONTINUE
20566C
20567      HOLD=TREAT(1)
20568      DO1335I=2,N
20569      IF(TREAT(I).NE.HOLD)GOTO1339
20570 1335 CONTINUE
20571      WRITE(ICOUT,999)
20572      CALL DPWRST('XXX','WRIT')
20573      WRITE(ICOUT,1131)
20574      CALL DPWRST('XXX','WRIT')
20575      WRITE(ICOUT,1331)HOLD
20576 1331 FORMAT('      THE SECOND FACTOR VARIABLE HAS ALL ELEMENTS = ',
20577     1       G15.7)
20578      CALL DPWRST('XXX','WRIT')
20579      GOTO9000
20580 1339 CONTINUE
20581C
20582C               ********************************************
20583C               **  STEP 12--                             **
20584C               **  CHECK TO SEE IF A BALANCED DESIGN     **
20585C               **  WAS ENTERED.                          **
20586C               **  1) EVERY BLOCK CONTAINS K EXPERIMENTAL**
20587C               **     UNITS.                             **
20588C               **  2) EVERY TREATMENT APPEARS IN R       **
20589C               **     BLOCKS.                            **
20590C               ********************************************
20591C
20592      ISTEPN='12'
20593      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DUR2')
20594     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20595C
20596C  STEP 1: COMPUTE NUMBER OF DISTINCT BLOCKS AND TREATMENTS
20597C
20598      CALL DISTIN(BLOCK,N,IWRITE,DBLOCK,NBLOCK,IBUGA3,IERROR)
20599      IF(IERROR.EQ.'YES' .OR. NBLOCK.LE.0)GOTO9000
20600      CALL DISTIN(TREAT,N,IWRITE,DTREAT,NTREAT,IBUGA3,IERROR)
20601      IF(IERROR.EQ.'YES' .OR. NTREAT.LE.0)GOTO9000
20602C
20603C  STEP 2: DETERMINE IF EVERY BLOCK CONTAINS K EXPERIMENTAL
20604C          TREATMENTS
20605C
20606      KHOLD=0
20607      DO1410I=1,NBLOCK
20608        ABLOCK=BLOCK(I)
20609        NK=0
20610        DO1420J=1,N
20611          IF(BLOCK(J).EQ.ABLOCK)NK=NK+1
20612 1420   CONTINUE
20613        IF(KHOLD.EQ.0)THEN
20614          KHOLD=NK
20615        ELSE
20616          IF(NK.NE.KHOLD)THEN
20617            WRITE(ICOUT,999)
20618            CALL DPWRST('XXX','WRIT')
20619            WRITE(ICOUT,1131)
20620            CALL DPWRST('XXX','WRIT')
20621            WRITE(ICOUT,1432)
20622            CALL DPWRST('XXX','WRIT')
20623            WRITE(ICOUT,1433)I,NK,KHOLD
20624            CALL DPWRST('XXX','WRIT')
20625            IERROR='YES'
20626            GOTO9000
20627          ENDIF
20628        ENDIF
20629 1410 CONTINUE
20630 1432 FORMAT('      UNEQUAL BLOCK SIZES DETECTED:')
20631 1433 FORMAT('      BLOCK ',I8,' HAD ',I8,' TREATMENTS WHEN ',
20632     1       I8,' TREATMENTS WERE EXPECTED.')
20633C
20634C  STEP 3: DETERMINE IF EVERY TREATMENT APPEARS IN R BLOCKS
20635C          (FOR NOW JUST CHECK THAT IT APPEARS R TIMES)
20636C
20637      IRHOLD=0
20638      DO1510I=1,NTREAT
20639        ATREAT=TREAT(I)
20640        NR=0
20641        DO1520J=1,N
20642          IF(TREAT(J).EQ.ATREAT)NR=NR+1
20643 1520   CONTINUE
20644        IF(IRHOLD.EQ.0)THEN
20645          IRHOLD=NR
20646        ELSE
20647          IF(NR.NE.IRHOLD)THEN
20648            WRITE(ICOUT,999)
20649            CALL DPWRST('XXX','WRIT')
20650            WRITE(ICOUT,1131)
20651            CALL DPWRST('XXX','WRIT')
20652            WRITE(ICOUT,1532)
20653            CALL DPWRST('XXX','WRIT')
20654            WRITE(ICOUT,1533)I,NR,IRHOLD
20655            CALL DPWRST('XXX','WRIT')
20656            IERROR='YES'
20657            GOTO9000
20658          ENDIF
20659        ENDIF
20660 1510 CONTINUE
20661 1532 FORMAT('      UNEQUAL TREATMENT SIZES DETECTED:')
20662 1533 FORMAT('      TREATMENT ',I8,' APPEARED ',I8,' TIMES ',
20663     1       'WHEN ',I8,' OCCURENCES WERE EXPECTED.')
20664C
20665C               ******************************
20666C               **  STEP 21--               **
20667C               **  CARRY OUT CALCULATIONS  **
20668C               **  FOR DURBIN TEST         **
20669C               ******************************
20670C
20671      ISTEPN='21'
20672      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')
20673     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20674C
20675      IWRITE='OFF'
20676C
20677C  COMPUTATIONAL ALGORITHM:
20678C
20679C  1. X(IJ)     = RESPONSE FOR BLOCK I, TREATMENT J
20680C  2. R(X(IJ))  = RANK OF X(IJ) WITHIN EACH BLOCK
20681C  3. R(J)      = SUM[I=1 TO K][R(X(IJ))]
20682C  4. A         = SUM[I=1 TO B][J=1 TO T][(R(X(IJ)]**2
20683C  5. C         = B*K(K+1)**2/4
20684C  6. T1        = (T-1)*{SUM[J=1 TO T][R(J)**2] - R*C]/(A-C)
20685C
20686      DSUM1=0.0D0
20687      DSUM2=0.0D0
20688      DO4010I=1,MAXNXT
20689        XTEMP(I)=0.0
20690        YTEMP(I)=0.0
20691        YRANK(I)=0.0
20692        RJ(I)=0.0
20693 4010 CONTINUE
20694C
20695C  EXTRACT THE X(IJ) FOR EACH BLOCK
20696C
20697      DO2110I=1,NBLOCK
20698        HOLD=DBLOCK(I)
20699        ICOUNT=0
20700        DO2120J=1,N
20701          IF(BLOCK(J).EQ.HOLD)THEN
20702            ICOUNT=ICOUNT+1
20703            YTEMP(ICOUNT)=Y(J)
20704          ENDIF
20705 2120   CONTINUE
20706        CALL RANK(YTEMP,ICOUNT,IWRITE,XTEMP,XTEMP2,MAXNXT,
20707     1            IBUGA3,IERROR)
20708        IF(IERROR.EQ.'YES')GOTO9000
20709        ICOUNT=0
20710        DO2130J=1,N
20711          IF(BLOCK(J).EQ.HOLD)THEN
20712            ICOUNT=ICOUNT+1
20713            YRANK(J)=XTEMP(ICOUNT)
20714          ENDIF
20715 2130   CONTINUE
20716 2110 CONTINUE
20717C
20718      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
20719        DO2140I=1,N
20720          WRITE(ICOUT,2142)I,Y(I),YRANK(I)
20721 2142     FORMAT('I,Y(I),YRANK(I) = ',I8,G15.7,F12.2)
20722          CALL DPWRST('XXX','BUG ')
20723 2140   CONTINUE
20724      ENDIF
20725C
20726C  STEP 3: NOW COMPUTE RANK SUMS FOR EACH TREATMENT
20727C
20728      DO2210I=1,NTREAT
20729        HOLD=DTREAT(I)
20730        DSUM1=0.0D0
20731        DO2220J=1,N
20732          IF(TREAT(J).EQ.HOLD)THEN
20733            DSUM1=DSUM1 + DBLE(YRANK(J))
20734          ENDIF
20735 2220   CONTINUE
20736        RJ(I)=REAL(DSUM1)
20737 2210 CONTINUE
20738C
20739      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
20740        DO2240I=1,NTREAT
20741          WRITE(ICOUT,2242)I,RJ(I)
20742 2242     FORMAT('I,RJ(I) = ',I8,G15.7)
20743          CALL DPWRST('XXX','BUG ')
20744 2240   CONTINUE
20745      ENDIF
20746C
20747C  STEP 4: NOW COMPUTE VARIOUS QUANTITIES BASED ON RJ
20748C
20749      DSUM2=0.0D0
20750      DO2310I=1,N
20751        DSUM2=DSUM2 + DBLE(YRANK(I))**2
20752 2310 CONTINUE
20753      A=REAL(DSUM2)
20754      B=REAL(NBLOCK)
20755      T=REAL(NTREAT)
20756      R=REAL(NR)
20757      AK=REAL(NK)
20758      C=B*AK*(AK+1)**2/4.0
20759      DENOM=A-C
20760      C1=(T-1.0)
20761      C2=R*C
20762C
20763      DSUM1=0.0D0
20764      DO2320I=1,NTREAT
20765        DSUM1=DSUM1 + RJ(I)**2
20766 2320 CONTINUE
20767      T1=C1*(REAL(DSUM1)-C2)/DENOM
20768      T2=(T1/C1)/((B*(AK-1.0) - T1)/(B*AK - B - T + 1.0))
20769C
20770      STATVA=T2
20771      NUMDF1=NTREAT-1
20772      NUMDF2=INT(B*AK - B - T +1)
20773      CALL FCDF(STATVA,NUMDF1,NUMDF2,STATCD)
20774      PVAL=1.0 - STATCD
20775C
20776      CUT0=0.0
20777      CALL FPPF(.50,NUMDF1,NUMDF2,CUT50)
20778      CALL FPPF(.75,NUMDF1,NUMDF2,CUT75)
20779      CALL FPPF(.90,NUMDF1,NUMDF2,CUT90)
20780      CALL FPPF(.95,NUMDF1,NUMDF2,CUT95)
20781      CALL FPPF(.975,NUMDF1,NUMDF2,CUT975)
20782      CALL FPPF(.99,NUMDF1,NUMDF2,CUT99)
20783      CALL FPPF(.999,NUMDF1,NUMDF2,CUT999)
20784C
20785      IDF=INT(B*AK - B - T + 1.0)
20786      CALL TPPF(0.95,REAL(IDF),T95)
20787      CALL TPPF(0.975,REAL(IDF),T975)
20788      CALL TPPF(0.995,REAL(IDF),T995)
20789      TERM1=(A-C)*2.0*R/(B*AK - B - T + 1.0)
20790      TERM2=1.0 - (T1/(B*(AK - 1.0)))
20791      CONTRA=SQRT(TERM1*TERM2)
20792      CONTR1=T95*CONTRA
20793      CONTR2=T975*CONTRA
20794      CONTR3=T995*CONTRA
20795C
20796      IOP='OPEN'
20797      IFLG1=1
20798      IFLG2=1
20799      IFLG3=0
20800      IFLG4=0
20801      IFLG5=0
20802      CALL DPAUFI(IOP,IFLG1,IFLG2,IFLG3,IFLG4,IFLG5,
20803     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
20804     1            IBUGA3,ISUBRO,IERROR)
20805      IF(IERROR.EQ.'YES')GOTO9000
20806C
20807      WRITE(IOUNI1,2405)
20808 2405 FORMAT(4X,'RESPONSE',13X,'RANK',11X,'BLOCK',8X,'TREATMENT')
20809      DO2410I=1,N
20810        WRITE(IOUNI1,2411)Y(I),YRANK(I),BLOCK(I),TREAT(I)
20811 2411   FORMAT(1X,E15.7,F15.2,F15.2,F15.2)
20812 2410 CONTINUE
20813C
20814      WRITE(IOUNI2,2421)CONTRA
20815 2421 FORMAT(1X,'Contrast term:          ',E15.7)
20816      WRITE(IOUNI2,2422)CONTR1
20817 2422 FORMAT(1X,'Contrast term*t(0.95):  ',E15.7)
20818      WRITE(IOUNI2,2423)CONTR2
20819 2423 FORMAT(1X,'Contrast term*t(0.975): ',E15.7)
20820      WRITE(IOUNI2,2424)CONTR3
20821 2424 FORMAT(1X,'Contrast term*t(0.995): ',E15.7)
20822      WRITE(IOUNI2,2425)
20823 2425 FORMAT(10X,'I',10X,'J',8X,'|R(I)-R(J)|')
20824C
20825      DO2430I=1,NTREAT
20826        DO2439J=1,NTREAT
20827          IF(I.LT.J)THEN
20828            ADIFF=ABS(RJ(I)-RJ(J))
20829            IATEMP='   '
20830            IF(ABS(ADIFF).GE.CONTR1)IATEMP(1:1)='*'
20831            IF(ABS(ADIFF).GE.CONTR2)IATEMP(2:2)='*'
20832            IF(ABS(ADIFF).GE.CONTR3)IATEMP(3:3)='*'
20833            WRITE(IOUNI2,2437)I,J,ADIFF,IATEMP
20834 2437       FORMAT(3X,I8,3X,I8,5X,E15.7,A3)
20835          ENDIF
20836 2439   CONTINUE
20837 2430 CONTINUE
20838C
20839      IOP='CLOS'
20840      CALL DPAUFI(IOP,IFLG1,IFLG2,IFLG3,IFLG4,IFLG5,
20841     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
20842     1            IBUGA3,ISUBRO,IERROR)
20843C
20844C               ******************************
20845C               **   STEP 43--              **
20846C               **   WRITE OUT EVERYTHING   **
20847C               **   FOR DURBIN TEST        **
20848C               ******************************
20849C
20850      ISTEPN='43'
20851      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')
20852     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20853C
20854      IF(IPRINT.EQ.'OFF')GOTO9000
20855C
20856      NUMDIG=7
20857      IF(IFORSW.EQ.'1')NUMDIG=1
20858      IF(IFORSW.EQ.'2')NUMDIG=2
20859      IF(IFORSW.EQ.'3')NUMDIG=3
20860      IF(IFORSW.EQ.'4')NUMDIG=4
20861      IF(IFORSW.EQ.'5')NUMDIG=5
20862      IF(IFORSW.EQ.'6')NUMDIG=6
20863      IF(IFORSW.EQ.'7')NUMDIG=7
20864      IF(IFORSW.EQ.'8')NUMDIG=8
20865      IF(IFORSW.EQ.'9')NUMDIG=9
20866      IF(IFORSW.EQ.'0')NUMDIG=0
20867      IF(IFORSW.EQ.'E')NUMDIG=-2
20868      IF(IFORSW.EQ.'-2')NUMDIG=-2
20869      IF(IFORSW.EQ.'-3')NUMDIG=-3
20870      IF(IFORSW.EQ.'-4')NUMDIG=-4
20871      IF(IFORSW.EQ.'-5')NUMDIG=-5
20872      IF(IFORSW.EQ.'-6')NUMDIG=-6
20873      IF(IFORSW.EQ.'-7')NUMDIG=-7
20874      IF(IFORSW.EQ.'-8')NUMDIG=-8
20875      IF(IFORSW.EQ.'-9')NUMDIG=-9
20876C
20877      ITITLE='Durbin Test for Two-Way Balanced Incomplete Block Designs'
20878      NCTITL=57
20879      ITITLZ=' '
20880      NCTITZ=0
20881C
20882      ICNT=1
20883      ITEXT(ICNT)=' '
20884      NCTEXT(ICNT)=0
20885      AVALUE(ICNT)=0.0
20886      IDIGIT(ICNT)=-1
20887      ICNT=ICNT+1
20888      ITEXT(ICNT)='Response Variable: '
20889      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
20890      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
20891      NCTEXT(ICNT)=27
20892      AVALUE(ICNT)=0.0
20893      IDIGIT(ICNT)=-1
20894C
20895      ICNT=ICNT+1
20896      ITEXT(ICNT)='First Group-ID Variable: '
20897      WRITE(ITEXT(ICNT)(26:29),'(A4)')IVARID(2)(1:4)
20898      WRITE(ITEXT(ICNT)(30:33),'(A4)')IVARI2(2)(1:4)
20899      NCTEXT(ICNT)=33
20900      AVALUE(ICNT)=0.0
20901      IDIGIT(ICNT)=-1
20902C
20903      ICNT=ICNT+1
20904      ITEXT(ICNT)='Second Group-ID Variable: '
20905      WRITE(ITEXT(ICNT)(27:30),'(A4)')IVARID(3)(1:4)
20906      WRITE(ITEXT(ICNT)(31:34),'(A4)')IVARI2(3)(1:4)
20907      NCTEXT(ICNT)=34
20908      AVALUE(ICNT)=0.0
20909      IDIGIT(ICNT)=-1
20910C
20911      ICNT=ICNT+1
20912      ITEXT(ICNT)=' '
20913      NCTEXT(ICNT)=1
20914      AVALUE(ICNT)=0.0
20915      IDIGIT(ICNT)=-1
20916C
20917      ICNT=ICNT+1
20918      ITEXT(ICNT)='H0: Treatments Have Identical Effects'
20919      NCTEXT(ICNT)=37
20920      AVALUE(ICNT)=0.0
20921      IDIGIT(ICNT)=-1
20922      ICNT=ICNT+1
20923      ITEXT(ICNT)='Ha: Treatments Do Not Have Identical Effects'
20924      NCTEXT(ICNT)=44
20925      AVALUE(ICNT)=0.0
20926      IDIGIT(ICNT)=-1
20927C
20928      ICNT=ICNT+1
20929      ITEXT(ICNT)=' '
20930      NCTEXT(ICNT)=1
20931      AVALUE(ICNT)=0.0
20932      IDIGIT(ICNT)=-1
20933C
20934      ICNT=ICNT+1
20935      ITEXT(ICNT)='Summary Statistics:'
20936      NCTEXT(ICNT)=19
20937      AVALUE(ICNT)=0.0
20938      IDIGIT(ICNT)=-1
20939      ICNT=ICNT+1
20940      ITEXT(ICNT)='Total Number of Observations:'
20941      NCTEXT(ICNT)=29
20942      AVALUE(ICNT)=REAL(N)
20943      IDIGIT(ICNT)=0
20944      ICNT=ICNT+1
20945      ITEXT(ICNT)='Number of Blocks:'
20946      NCTEXT(ICNT)=17
20947      AVALUE(ICNT)=REAL(NBLOCK)
20948      IDIGIT(ICNT)=0
20949      ICNT=ICNT+1
20950      ITEXT(ICNT)='Number of Treatments:'
20951      NCTEXT(ICNT)=21
20952      AVALUE(ICNT)=REAL(NTREAT)
20953      IDIGIT(ICNT)=0
20954      ICNT=ICNT+1
20955      ITEXT(ICNT)='Number of Blocks for Each Treatment:'
20956      NCTEXT(ICNT)=36
20957      AVALUE(ICNT)=REAL(NR)
20958      IDIGIT(ICNT)=0
20959      ICNT=ICNT+1
20960      ITEXT(ICNT)=' '
20961      NCTEXT(ICNT)=1
20962      AVALUE(ICNT)=0.0
20963      IDIGIT(ICNT)=-1
20964C
20965      ICNT=ICNT+1
20966      ITEXT(ICNT)='Test:'
20967      NCTEXT(ICNT)=5
20968      AVALUE(ICNT)=0.0
20969      IDIGIT(ICNT)=-1
20970      ICNT=ICNT+1
20971      ITEXT(ICNT)='Sum of Squares of Ranks (A):'
20972      NCTEXT(ICNT)=28
20973      AVALUE(ICNT)=A
20974      IDIGIT(ICNT)=NUMDIG
20975      ICNT=ICNT+1
20976      ITEXT(ICNT)='Correction Factor (C):'
20977      NCTEXT(ICNT)=28
20978      AVALUE(ICNT)=C
20979      IDIGIT(ICNT)=NUMDIG
20980      ICNT=ICNT+1
20981      ITEXT(ICNT)='Durbin Test Statistic (Uncorrected):'
20982      NCTEXT(ICNT)=36
20983      AVALUE(ICNT)=T1
20984      IDIGIT(ICNT)=NUMDIG
20985      ICNT=ICNT+1
20986      ITEXT(ICNT)='Durbin Test Statistic (Corrected):'
20987      NCTEXT(ICNT)=34
20988      AVALUE(ICNT)=STATVA
20989      IDIGIT(ICNT)=NUMDIG
20990      ICNT=ICNT+1
20991      ITEXT(ICNT)='CDF of Test Statistic:'
20992      NCTEXT(ICNT)=22
20993      AVALUE(ICNT)=STATCD
20994      IDIGIT(ICNT)=NUMDIG
20995      ICNT=ICNT+1
20996      ITEXT(ICNT)='P-Value:'
20997      NCTEXT(ICNT)=8
20998      AVALUE(ICNT)=PVAL
20999      IDIGIT(ICNT)=NUMDIG
21000C
21001      NUMROW=ICNT
21002      DO4210I=1,NUMROW
21003        NTOT(I)=15
21004 4210 CONTINUE
21005C
21006      IFRST=.TRUE.
21007      ILAST=.TRUE.
21008C
21009      ISTEPN='42A'
21010      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DUR2')
21011     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21012C
21013      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
21014     1            AVALUE,IDIGIT,
21015     1            NTOT,NUMROW,
21016     1            ICAPSW,ICAPTY,ILAST,IFRST,
21017     1            ISUBRO,IBUGA3,IERROR)
21018C
21019      ITITLE=' '
21020      NCTITL=0
21021      ITITL9=' '
21022      NCTIT9=0
21023      ITITLE='Percent Points of the F Reference Distribution'
21024      NCTITL=46
21025      NUMLIN=1
21026      NUMROW=8
21027      NUMCOL=3
21028      ITITL2(1,1)='Percent Point'
21029      ITITL2(1,2)=' '
21030      ITITL2(1,3)='Value'
21031      NCTIT2(1,1)=13
21032      NCTIT2(1,2)=1
21033      NCTIT2(1,3)=5
21034C
21035      NMAX=0
21036      DO4221I=1,NUMCOL
21037        VALIGN(I)='b'
21038        ALIGN(I)='r'
21039        NTOT(I)=15
21040        IF(I.EQ.2)NTOT(I)=5
21041        NMAX=NMAX+NTOT(I)
21042        IDIGIT(I)=NUMDIG
21043        ITYPCO(I)='NUME'
21044 4221 CONTINUE
21045      ITYPCO(2)='ALPH'
21046      IDIGIT(1)=1
21047      IDIGIT(3)=3
21048      DO4223I=1,NUMROW
21049        DO4225J=1,NUMCOL
21050          NCVALU(I,J)=0
21051          IVALUE(I,J)=' '
21052          NCVALU(I,J)=0
21053          AMAT(I,J)=0.0
21054          IF(J.EQ.1)THEN
21055            AMAT(I,J)=ALPHA(I)
21056          ELSEIF(J.EQ.2)THEN
21057            IVALUE(I,J)='='
21058            NCVALU(I,J)=1
21059          ELSEIF(J.EQ.3)THEN
21060            IF(I.EQ.1)THEN
21061              AMAT(I,J)=RND(CUT0,IDIGIT(J))
21062            ELSEIF(I.EQ.2)THEN
21063              AMAT(I,J)=RND(CUT50,IDIGIT(J))
21064            ELSEIF(I.EQ.3)THEN
21065              AMAT(I,J)=RND(CUT75,IDIGIT(J))
21066            ELSEIF(I.EQ.4)THEN
21067              AMAT(I,J)=RND(CUT90,IDIGIT(J))
21068            ELSEIF(I.EQ.5)THEN
21069              AMAT(I,J)=RND(CUT95,IDIGIT(J))
21070            ELSEIF(I.EQ.6)THEN
21071              AMAT(I,J)=RND(CUT975,IDIGIT(J))
21072            ELSEIF(I.EQ.7)THEN
21073              AMAT(I,J)=RND(CUT99,IDIGIT(J))
21074            ELSEIF(I.EQ.8)THEN
21075              AMAT(I,J)=RND(CUT999,IDIGIT(J))
21076            ENDIF
21077          ENDIF
21078 4225   CONTINUE
21079 4223 CONTINUE
21080C
21081      IWHTML(1)=150
21082      IWHTML(2)=50
21083      IWHTML(3)=150
21084      IWRTF(1)=2000
21085      IWRTF(2)=IWRTF(1)+500
21086      IWRTF(3)=IWRTF(2)+2000
21087      IFRST=.TRUE.
21088      ILAST=.TRUE.
21089C
21090      ISTEPN='42C'
21091      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DUR2')
21092     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21093C
21094      CALL DPDTA4(ITITL9,NCTIT9,
21095     1            ITITLE,NCTITL,ITITL2,NCTIT2,
21096     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
21097     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
21098     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
21099     1            ICAPSW,ICAPTY,IFRST,ILAST,
21100     1            ISUBRO,IBUGA3,IERROR)
21101C
21102      CDF1=CUT90
21103      CDF2=CUT95
21104      CDF3=CUT975
21105      CDF4=CUT99
21106C
21107      ITITL9=' '
21108      NCTIT9=0
21109      ITITLE='Conclusions (Upper 1-Tailed Test)'
21110      NCTITL=33
21111      NUMLIN=1
21112      NUMROW=4
21113      NUMCOL=4
21114      ITITL2(1,1)='Alpha'
21115      ITITL2(1,2)='CDF'
21116      ITITL2(1,3)='Critical Value'
21117      ITITL2(1,4)='Conclusion'
21118      NCTIT2(1,1)=5
21119      NCTIT2(1,2)=3
21120      NCTIT2(1,3)=14
21121      NCTIT2(1,4)=10
21122C
21123      NMAX=0
21124      DO4321I=1,NUMCOL
21125        VALIGN(I)='b'
21126        ALIGN(I)='r'
21127        NTOT(I)=15
21128        IF(I.EQ.1 .OR. I.EQ.2)NTOT(I)=7
21129        IF(I.EQ.3)NTOT(I)=17
21130        NMAX=NMAX+NTOT(I)
21131        IDIGIT(I)=3
21132        ITYPCO(I)='ALPH'
21133 4321 CONTINUE
21134      ITYPCO(3)='NUME'
21135      IDIGIT(1)=0
21136      IDIGIT(2)=0
21137      DO4323I=1,NUMROW
21138        DO4325J=1,NUMCOL
21139          NCVALU(I,J)=0
21140          IVALUE(I,J)=' '
21141          NCVALU(I,J)=0
21142          AMAT(I,J)=0.0
21143 4325   CONTINUE
21144 4323 CONTINUE
21145      IVALUE(1,1)='10%'
21146      IVALUE(2,1)='5%'
21147      IVALUE(3,1)='2.5%'
21148      IVALUE(4,1)='1%'
21149      IVALUE(1,2)='90%'
21150      IVALUE(2,2)='95%'
21151      IVALUE(3,2)='97.5%'
21152      IVALUE(4,2)='99%'
21153      NCVALU(1,1)=3
21154      NCVALU(2,1)=2
21155      NCVALU(3,1)=4
21156      NCVALU(4,1)=2
21157      NCVALU(1,2)=3
21158      NCVALU(2,2)=3
21159      NCVALU(3,2)=5
21160      NCVALU(4,2)=3
21161      IVALUE(1,4)='Accept H0'
21162      IVALUE(2,4)='Accept H0'
21163      IVALUE(3,4)='Accept H0'
21164      IVALUE(4,4)='Accept H0'
21165      NCVALU(1,4)=9
21166      NCVALU(2,4)=9
21167      NCVALU(3,4)=9
21168      NCVALU(4,4)=9
21169      IF(STATVA.GT.CUT90)IVALUE(1,4)='Reject H0'
21170      IF(STATVA.GT.CUT95)IVALUE(2,4)='Reject H0'
21171      IF(STATVA.GT.CUT975)IVALUE(3,4)='Reject H0'
21172      IF(STATVA.GT.CUT99)IVALUE(4,4)='Reject H0'
21173      AMAT(1,3)=RND(CUT90,IDIGIT(3))
21174      AMAT(2,3)=RND(CUT95,IDIGIT(3))
21175      AMAT(3,3)=RND(CUT975,IDIGIT(3))
21176      AMAT(4,3)=RND(CUT99,IDIGIT(3))
21177C
21178      IWHTML(1)=150
21179      IWHTML(2)=150
21180      IWHTML(3)=150
21181      IWHTML(4)=150
21182      IWRTF(1)=1500
21183      IWRTF(2)=IWRTF(1)+1500
21184      IWRTF(3)=IWRTF(2)+2000
21185      IWRTF(4)=IWRTF(3)+2000
21186      IFRST=.FALSE.
21187      ILAST=.TRUE.
21188C
21189      ISTEPN='42E'
21190      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'KRU2')
21191     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21192C
21193      CALL DPDTA4(ITITL9,NCTIT9,
21194     1            ITITLE,NCTITL,ITITL2,NCTIT2,
21195     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
21196     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
21197     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
21198     1            ICAPSW,ICAPTY,IFRST,ILAST,
21199     1            ISUBRO,IBUGA3,IERROR)
21200C
21201C
21202C               *****************
21203C               **  STEP 90--  **
21204C               **  EXIT       **
21205C               *****************
21206C
21207 9000 CONTINUE
21208      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
21209        WRITE(ICOUT,999)
21210        CALL DPWRST('XXX','WRIT')
21211        WRITE(ICOUT,9011)
21212 9011   FORMAT('***** AT THE END       OF DPDUR2--')
21213        CALL DPWRST('XXX','WRIT')
21214        WRITE(ICOUT,9012)STATVA,STATCD,PVAL
21215 9012   FORMAT('STATVA,STATCD,PVAL = ',3G15.7)
21216        CALL DPWRST('XXX','WRIT')
21217        WRITE(ICOUT,9015)N
21218 9015   FORMAT('N = ',I8)
21219        CALL DPWRST('XXX','WRIT')
21220      ENDIF
21221C
21222      RETURN
21223      END
21224      SUBROUTINE DPEBLL(P,N,ALPHA,IWRITE,ALOWLM,ICASE,IBUGA3,IERROR)
21225C
21226C     PURPOSE--FOR A GIVEN P, N, AND ALPHA, COMPUTE THE
21227C              EXACT BINOMIAL LOWER BINOMIAL CONFIDENCE
21228C              LIMIT.  THIS IS USEFUL FOR GENERATING BINOMIAL
21229C              CONFIDENCE LIMITS WHEN ONLY SUMMARY INFORMATION
21230C              IS AVAILABLE.
21231C     WRITTEN BY--JAMES J. FILLIBEN
21232C                 STATISTICAL ENGINEERING DIVISION
21233C                 INFORMATION TECHNOLOGY LABORATORY
21234C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21235C                 GAITHERSBURG, MD 20899-8980
21236C                 PHONE--301-975-2855
21237C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21238C           OF THE NATIONAL BUREAU OF STANDARDS.
21239C     LANGUAGE--ANSI FORTRAN (1977)
21240C     VERSION NUMBER--2007/2
21241C     ORIGINAL VERSION--FEBRUARY  2007.
21242C     UPDATED         --MARCH     2007. NEED TO SUBTRACT 1 FROM
21243C                                       NUMBER OF SUCCESSES FOR
21244C                                       LOWER BOUND
21245C
21246C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21247C
21248      CHARACTER*4 IWRITE
21249      CHARACTER*4 ICASE
21250      CHARACTER*4 IBUGA3
21251      CHARACTER*4 IERROR
21252C
21253      CHARACTER*4 ISUBN1
21254      CHARACTER*4 ISUBN2
21255C
21256C---------------------------------------------------------------------
21257C
21258      REAL P
21259      REAL ALPHA
21260      REAL ALOWLM
21261      INTEGER N
21262C
21263      EXTERNAL BINFUN
21264      COMMON/BINCOM/XSUCC,CONST,NTEMP
21265C
21266C---------------------------------------------------------------------
21267C
21268      INCLUDE 'DPCOP2.INC'
21269C
21270C-----START POINT-----------------------------------------------------
21271C
21272      ISUBN1='DPEB'
21273      ISUBN2='LL  '
21274C
21275      IERROR='NO'
21276C
21277      IF(IBUGA3.EQ.'ON')THEN
21278        WRITE(ICOUT,999)
21279  999   FORMAT(1X)
21280        CALL DPWRST('XXX','BUG ')
21281        WRITE(ICOUT,51)
21282   51   FORMAT('***** AT THE BEGINNING OF DPEBLL--')
21283        CALL DPWRST('XXX','BUG ')
21284        WRITE(ICOUT,52)IBUGA3,IWRITE
21285   52   FORMAT('IBUGA3,IWRITE = ',A4,2X,A4)
21286        CALL DPWRST('XXX','BUG ')
21287        WRITE(ICOUT,53)P,N,ALPHA
21288   53   FORMAT('P,N,ALPHA = ',G15.7,I8,G15.7)
21289        CALL DPWRST('XXX','BUG ')
21290        WRITE(ICOUT,999)
21291        CALL DPWRST('XXX','BUG ')
21292      ENDIF
21293C
21294C               ********************************
21295C               **  STEP 1--                  **
21296C               **  CHECK FOR INPUT ERRORS    **
21297C               ********************************
21298C
21299      IF(N.LT.1)THEN
21300        IERROR='YES'
21301        WRITE(ICOUT,999)
21302        CALL DPWRST('XXX','BUG ')
21303        WRITE(ICOUT,151)
21304  151   FORMAT('***** ERROR IN DPEBLL--')
21305        CALL DPWRST('XXX','BUG ')
21306        WRITE(ICOUT,152)
21307  152   FORMAT('      THE INPUT SAMPLE SIZE FOR THE EXACT LOWER')
21308        CALL DPWRST('XXX','BUG ')
21309        WRITE(ICOUT,154)
21310  154   FORMAT('      BINOMIAL CONFIDENCE LIMIT IS LESS THAN 1.')
21311        CALL DPWRST('XXX','BUG ')
21312        WRITE(ICOUT,157)N
21313  157   FORMAT('      THE INPUT SAMPLE SIZE            = ',I8)
21314        CALL DPWRST('XXX','BUG ')
21315        GOTO9000
21316      ENDIF
21317C
21318      IF(P.LT.0.0 .OR. P.GT.1.0)THEN
21319        IERROR='YES'
21320        WRITE(ICOUT,999)
21321        CALL DPWRST('XXX','BUG ')
21322        WRITE(ICOUT,161)
21323  161   FORMAT('***** ERROR IN DPEBLL--')
21324        CALL DPWRST('XXX','BUG ')
21325        WRITE(ICOUT,162)
21326  162   FORMAT('      THE BINOMIAL PROBABILITY OF SUCCESS PARAMETER')
21327        CALL DPWRST('XXX','BUG ')
21328        WRITE(ICOUT,164)
21329  164   FORMAT('      IS OUTSIDE THE (0,1) INTERVAL.')
21330        CALL DPWRST('XXX','BUG ')
21331        WRITE(ICOUT,167)P
21332  167   FORMAT('      THE PROBABILITY OF SUCCESS PARAMETER = ',G15.7)
21333        CALL DPWRST('XXX','BUG ')
21334        GOTO9000
21335      ENDIF
21336C
21337      ALPHSV=ALPHA
21338      IF(ALPHA.GT.1.0 .AND. ALPHA.LE.100.0)ALPHA=ALPHA/100.0
21339      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
21340        IERROR='YES'
21341        WRITE(ICOUT,999)
21342        CALL DPWRST('XXX','BUG ')
21343        WRITE(ICOUT,171)
21344  171   FORMAT('***** ERROR IN DPEBLL--')
21345        CALL DPWRST('XXX','BUG ')
21346        WRITE(ICOUT,172)
21347  172   FORMAT('      THE VALUE OF ALPHA IS OUTSIDE THE (0,1) ',
21348     1         'INTERVAL.')
21349        CALL DPWRST('XXX','BUG ')
21350        WRITE(ICOUT,177)ALPHSV
21351  177   FORMAT('      THE VALUE OF ALPHA = ',G15.7)
21352        CALL DPWRST('XXX','BUG ')
21353        GOTO9000
21354      ENDIF
21355C
21356C               ******************************************
21357C               **  STEP 2--                            **
21358C               **  COMPUTE THE EXACT LOWER BINOMIAL    **
21359C               **  CONFIDENCE LIMIT                    **
21360C               ******************************************
21361C
21362      ALP=ALPHA
21363      IF(ALP.LT.0.5)THEN
21364        IF(ICASE.EQ.'TWOS')THEN
21365          P2=ALP/2.0
21366          P1=1.0-(ALP/2.0)
21367        ELSE
21368          P2=ALP
21369          P1=1.0-ALP
21370        ENDIF
21371      ELSE
21372        IF(ICASE.EQ.'TWOS')THEN
21373          ALP=1.0 - ALPHA
21374          P2=ALP/2.0
21375          P1=1.0-(ALP/2.0)
21376        ELSE
21377          ALP=1.0 - ALPHA
21378          P2=ALP
21379          P1=1.0-ALP
21380        ENDIF
21381      ENDIF
21382C
21383      AN=REAL(N)
21384      Q=1.0-P
21385C
21386      CALL NORPPF(P1,ZALPHA)
21387      CONST=P1
21388      PHAT=P
21389      PLOWLI=0.0
21390      PUPPLI=PHAT
21391      IF(PHAT.LE.0.0)THEN
21392        ALOWLM=0.0
21393      ELSE
21394        NTEMP=N
21395CCCCC   XSUCC=AN*P
21396        XSUCC=AN*P - 1.0
21397        AE=1.E-6
21398        RE=1.E-6
21399        CALL FZERO(BINFUN,PLOWLI,PUPPLI,PHAT,RE,AE,IFLAG)
21400        IF(PLOWLI.GT.PHAT)THEN
21401          ALOWLM=0.0
21402        ELSE
21403          ALOWLM=PLOWLI
21404        ENDIF
21405        IF(ALOWLM.LT.0.0)ALOWLM=0.0
21406C
21407        IF(IFLAG.EQ.2)THEN
21408C
21409          WRITE(ICOUT,999)
21410          CALL DPWRST('XXX','BUG ')
21411          WRITE(ICOUT,2211)
21412 2211     FORMAT('***** WARNING FROM DPEBLL--')
21413          CALL DPWRST('XXX','BUG ')
21414          WRITE(ICOUT,2213)
21415 2213     FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR P ',
21416     1           'MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
21417          CALL DPWRST('XXX','BUG ')
21418        ELSEIF(IFLAG.EQ.3)THEN
21419          WRITE(ICOUT,999)
21420          CALL DPWRST('XXX','BUG ')
21421          WRITE(ICOUT,2211)
21422          CALL DPWRST('XXX','BUG ')
21423          WRITE(ICOUT,2223)
21424 2223     FORMAT('      ESTIMATE OF LOWER CONFIDENCE VALUE FOR P ',
21425     1           'MAY BE NEAR A SINGULAR POINT.')
21426          CALL DPWRST('XXX','BUG ')
21427        ELSEIF(IFLAG.EQ.4)THEN
21428CCCCC     WRITE(ICOUT,999)
21429CCCCC     CALL DPWRST('XXX','BUG ')
21430CCCCC     WRITE(ICOUT,2211)
21431CCCCC     CALL DPWRST('XXX','BUG ')
21432CCCCC     WRITE(ICOUT,2233)
21433C2233     FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
21434CCCCC     CALL DPWRST('XXX','BUG ')
21435        ELSEIF(IFLAG.EQ.5)THEN
21436          WRITE(ICOUT,999)
21437          CALL DPWRST('XXX','BUG ')
21438          WRITE(ICOUT,2211)
21439          CALL DPWRST('XXX','BUG ')
21440          WRITE(ICOUT,2243)
21441 2243     FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
21442          CALL DPWRST('XXX','BUG ')
21443        ENDIF
21444      ENDIF
21445C
21446C               *****************
21447C               **  STEP 90--  **
21448C               **  EXIT.      **
21449C               *****************
21450C
21451 9000 CONTINUE
21452C
21453      IF(IBUGA3.EQ.'ON')THEN
21454        WRITE(ICOUT,999)
21455        CALL DPWRST('XXX','BUG ')
21456        WRITE(ICOUT,9011)
21457 9011   FORMAT('***** AT THE END       OF DPEBLL--')
21458        CALL DPWRST('XXX','BUG ')
21459        WRITE(ICOUT,9012)IBUGA3,IERROR,ALOWLM
21460 9012   FORMAT('IBUGA3,IERROR,ALOWLM = ',A4,2X,A4,2X,G15.7)
21461        CALL DPWRST('XXX','BUG ')
21462      ENDIF
21463C
21464      RETURN
21465      END
21466      SUBROUTINE DPEBUL(P,N,ALPHA,IWRITE,AUPPLM,ICASE,IBUGA3,IERROR)
21467C
21468C     PURPOSE--FOR A GIVEN P, N, AND ALPHA, COMPUTE THE
21469C              EXACT BINOMIAL UPPER BINOMIAL CONFIDENCE
21470C              LIMIT.  THIS IS USEFUL FOR GENERATING BINOMIAL
21471C              CONFIDENCE LIMITS WHEN ONLY SUMMARY INFORMATION
21472C              IS AVAILABLE.
21473C     WRITTEN BY--JAMES J. FILLIBEN
21474C                 STATISTICAL ENGINEERING DIVISION
21475C                 INFORMATION TECHNOLOGY LABORATORY
21476C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21477C                 GAITHERSBURG, MD 20899-8980
21478C                 PHONE--301-975-2855
21479C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21480C           OF THE NATIONAL BUREAU OF STANDARDS.
21481C     LANGUAGE--ANSI FORTRAN (1977)
21482C     VERSION NUMBER--2007/2
21483C     ORIGINAL VERSION--FEBRUARY  2007.
21484C
21485C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21486C
21487      CHARACTER*4 IWRITE
21488      CHARACTER*4 ICASE
21489      CHARACTER*4 IBUGA3
21490      CHARACTER*4 IERROR
21491C
21492      CHARACTER*4 ISUBN1
21493      CHARACTER*4 ISUBN2
21494C
21495C---------------------------------------------------------------------
21496C
21497      REAL P
21498      REAL ALPHA
21499      REAL AUPPLM
21500      INTEGER N
21501C
21502      EXTERNAL BINFUN
21503      COMMON/BINCOM/XSUCC,CONST,NTEMP
21504C
21505C---------------------------------------------------------------------
21506C
21507      INCLUDE 'DPCOP2.INC'
21508C
21509C-----START POINT-----------------------------------------------------
21510C
21511      ISUBN1='DPEB'
21512      ISUBN2='UL  '
21513      IERROR='NO'
21514C
21515      IF(IBUGA3.EQ.'ON')THEN
21516        WRITE(ICOUT,999)
21517  999   FORMAT(1X)
21518        CALL DPWRST('XXX','BUG ')
21519        WRITE(ICOUT,51)
21520   51   FORMAT('***** AT THE BEGINNING OF DPEBUL--')
21521        CALL DPWRST('XXX','BUG ')
21522        WRITE(ICOUT,52)IBUGA3,IWRITE
21523   52   FORMAT('IBUGA3,IWRITE = ',A4,2X,A4)
21524        CALL DPWRST('XXX','BUG ')
21525        WRITE(ICOUT,53)P,N,ALPHA
21526   53   FORMAT('P,N,ALPHA = ',G15.7,I8,G15.7)
21527        CALL DPWRST('XXX','BUG ')
21528        WRITE(ICOUT,999)
21529        CALL DPWRST('XXX','BUG ')
21530      ENDIF
21531C
21532C               ********************************
21533C               **  STEP 1--                  **
21534C               **  CHECK FOR INPUT ERRORS    **
21535C               ********************************
21536C
21537      IF(N.LT.1)THEN
21538        IERROR='YES'
21539        WRITE(ICOUT,999)
21540        CALL DPWRST('XXX','BUG ')
21541        WRITE(ICOUT,151)
21542  151   FORMAT('***** ERROR IN DPEBUL--')
21543        CALL DPWRST('XXX','BUG ')
21544        WRITE(ICOUT,152)
21545  152   FORMAT('      THE INPUT SAMPLE SIZE FOR THE EXACT UPPER')
21546        CALL DPWRST('XXX','BUG ')
21547        WRITE(ICOUT,154)
21548  154   FORMAT('      BINOMIAL CONFIDENCE LIMIT IS LESS THAN 1.')
21549        CALL DPWRST('XXX','BUG ')
21550        WRITE(ICOUT,157)N
21551  157   FORMAT('      THE INPUT SAMPLE SIZE            = ',I8)
21552        CALL DPWRST('XXX','BUG ')
21553        GOTO9000
21554      ENDIF
21555C
21556      IF(P.LT.0.0 .OR. P.GT.1.0)THEN
21557        IERROR='YES'
21558        WRITE(ICOUT,999)
21559        CALL DPWRST('XXX','BUG ')
21560        WRITE(ICOUT,161)
21561  161   FORMAT('***** ERROR IN DPEBUL--')
21562        CALL DPWRST('XXX','BUG ')
21563        WRITE(ICOUT,162)
21564  162   FORMAT('      THE BINOMIAL PROBABILITY OF SUCCESS PARAMETER')
21565        CALL DPWRST('XXX','BUG ')
21566        WRITE(ICOUT,164)
21567  164   FORMAT('      IS OUTSIDE THE (0,1) INTERVAL.')
21568        CALL DPWRST('XXX','BUG ')
21569        WRITE(ICOUT,167)P
21570  167   FORMAT('      THE PROBABILITY OF SUCCESS PARAMETER = ',G15.7)
21571        CALL DPWRST('XXX','BUG ')
21572        GOTO9000
21573      ENDIF
21574C
21575      ALPHSV=ALPHA
21576      IF(ALPHA.GT.1.0 .AND. ALPHA.LE.100.0)ALPHA=ALPHA/100.0
21577      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
21578        IERROR='YES'
21579        WRITE(ICOUT,999)
21580        CALL DPWRST('XXX','BUG ')
21581        WRITE(ICOUT,171)
21582  171   FORMAT('***** ERROR IN DPEBUL--')
21583        CALL DPWRST('XXX','BUG ')
21584        WRITE(ICOUT,172)
21585  172   FORMAT('      THE VALUE OF ALPHA IS OUTSIDE THE (0,1) ',
21586     1         'INTERVAL.')
21587        CALL DPWRST('XXX','BUG ')
21588        WRITE(ICOUT,177)ALPHSV
21589  177   FORMAT('      THE VALUE OF ALPHA = ',G15.7)
21590        CALL DPWRST('XXX','BUG ')
21591        GOTO9000
21592      ENDIF
21593C
21594C               ******************************************
21595C               **  STEP 2--                            **
21596C               **  COMPUTE THE EXACT UPPER BINOMIAL    **
21597C               **  CONFIDENCE LIMIT                    **
21598C               ******************************************
21599C
21600      ALP=ALPHA
21601      IF(ALP.LT.0.5)THEN
21602        IF(ICASE.EQ.'TWOS')THEN
21603          P2=ALP/2.0
21604          P1=1.0-(ALP/2.0)
21605        ELSE
21606          P2=ALP
21607          P1=1.0-ALP
21608        ENDIF
21609      ELSE
21610        IF(ICASE.EQ.'TWOS')THEN
21611          ALP=1.0 - ALPHA
21612          P2=ALP/2.0
21613          P1=1.0-(ALP/2.0)
21614        ELSE
21615          ALP=1.0 - ALPHA
21616          P2=ALP
21617          P1=1.0-ALP
21618        ENDIF
21619      ENDIF
21620C
21621      AN=REAL(N)
21622      Q=1.0-P
21623C
21624      CALL NORPPF(P2,ZALPHA)
21625      CONST=P2
21626      PHAT=P
21627      PLOWLI=PHAT
21628      PUPPLI=1.0
21629      IF(PHAT.GE.1.0)THEN
21630        AUPPLM=1.0
21631      ELSE
21632        NTEMP=N
21633        XSUCC=AN*P
21634        AE=1.E-6
21635        RE=1.E-6
21636        CALL FZERO(BINFUN,PLOWLI,PUPPLI,PHAT,RE,AE,IFLAG)
21637        IF(PLOWLI.LT.PHAT)THEN
21638          AUPPLM=PUPPLI
21639        ELSE
21640          AUPPLM=PLOWLI
21641        ENDIF
21642        IF(AUPPLM.GT.1.0)AUPPLM=1.0
21643C
21644        IF(IFLAG.EQ.2)THEN
21645C
21646          WRITE(ICOUT,999)
21647          CALL DPWRST('XXX','BUG ')
21648          WRITE(ICOUT,2211)
21649 2211     FORMAT('***** WARNING FROM DPEBUL--')
21650          CALL DPWRST('XXX','BUG ')
21651          WRITE(ICOUT,2213)
21652 2213     FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
21653     1           'MAY NOT BE COMPUTED TO DESIRED TOLERANCE.')
21654          CALL DPWRST('XXX','BUG ')
21655        ELSEIF(IFLAG.EQ.3)THEN
21656          WRITE(ICOUT,999)
21657          CALL DPWRST('XXX','BUG ')
21658          WRITE(ICOUT,2211)
21659          CALL DPWRST('XXX','BUG ')
21660          WRITE(ICOUT,2223)
21661 2223     FORMAT('      ESTIMATE OF UPPER CONFIDENCE VALUE FOR P ',
21662     1           'MAY BE NEAR A SINGULAR POINT.')
21663          CALL DPWRST('XXX','BUG ')
21664        ELSEIF(IFLAG.EQ.4)THEN
21665CCCCC     WRITE(ICOUT,999)
21666CCCCC     CALL DPWRST('XXX','BUG ')
21667CCCCC     WRITE(ICOUT,2211)
21668CCCCC     CALL DPWRST('XXX','BUG ')
21669CCCCC     WRITE(ICOUT,2233)
21670C2233     FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
21671CCCCC     CALL DPWRST('XXX','BUG ')
21672        ELSEIF(IFLAG.EQ.5)THEN
21673          WRITE(ICOUT,999)
21674          CALL DPWRST('XXX','BUG ')
21675          WRITE(ICOUT,2211)
21676          CALL DPWRST('XXX','BUG ')
21677          WRITE(ICOUT,2243)
21678 2243     FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
21679          CALL DPWRST('XXX','BUG ')
21680        ENDIF
21681      ENDIF
21682C
21683C               *****************
21684C               **  STEP 90--  **
21685C               **  EXIT.      **
21686C               *****************
21687C
21688 9000 CONTINUE
21689C
21690      IF(IBUGA3.EQ.'ON')THEN
21691        WRITE(ICOUT,999)
21692        CALL DPWRST('XXX','BUG ')
21693        WRITE(ICOUT,9011)
21694 9011   FORMAT('***** AT THE END       OF DPEBUL--')
21695        CALL DPWRST('XXX','BUG ')
21696        WRITE(ICOUT,9012)IBUGA3,IERROR,AUPPLM
21697 9012   FORMAT('IBUGA3,IERROR,AUPPLM = ',A4,2X,A4,2X,G15.7)
21698        CALL DPWRST('XXX','BUG ')
21699      ENDIF
21700C
21701      RETURN
21702      END
21703      SUBROUTINE DPECDF(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
21704     1                  IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
21705C
21706C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
21707C              THAT WILL DEFINE AN EMPIRICAL CDF PLOT
21708C     WRITTEN BY--JAMES J. FILLIBEN
21709C                 STATISTICAL ENGINEERING DIVISION
21710C                 INFORMATION TECHNOLOGY LABORATORY
21711C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21712C                 GAITHERSBURG, MD 20899-8980
21713C                 PHONE--301-975-2899
21714C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21715C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21716C     LANGUAGE--ANSI FORTRAN (1977)
21717C     VERSION NUMBER--98/5
21718C     ORIGINAL VERSION--MAY       1998.
21719C     UPDATED         --JANUARY   2012. USE DPPARS
21720C
21721C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21722C
21723      CHARACTER*4 ICASPL
21724      CHARACTER*4 IAND1
21725      CHARACTER*4 IAND2
21726      CHARACTER*4 IBUGG2
21727      CHARACTER*4 IBUGG3
21728      CHARACTER*4 ISUBRO
21729      CHARACTER*4 IBUGQ
21730      CHARACTER*4 IFOUND
21731      CHARACTER*4 IERROR
21732C
21733      CHARACTER*4 ISUBN1
21734      CHARACTER*4 ISUBN2
21735      CHARACTER*4 ISTEPN
21736C
21737      CHARACTER*4 ICASE
21738      CHARACTER*40 INAME
21739      PARAMETER (MAXSPN=10)
21740      CHARACTER*4 IVARN1(MAXSPN)
21741      CHARACTER*4 IVARN2(MAXSPN)
21742      CHARACTER*4 IVARTY(MAXSPN)
21743      REAL PVAR(MAXSPN)
21744      INTEGER ILIS(MAXSPN)
21745      INTEGER NRIGHT(MAXSPN)
21746      INTEGER ICOLR(MAXSPN)
21747C
21748C---------------------------------------------------------------------
21749C
21750      INCLUDE 'DPCOPA.INC'
21751      INCLUDE 'DPCOZZ.INC'
21752C
21753      DIMENSION Y1(MAXOBV)
21754      DIMENSION X1(MAXOBV)
21755      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
21756      EQUIVALENCE (GARBAG(IGARB2),X1(1))
21757C
21758C-----COMMON----------------------------------------------------------
21759C
21760      INCLUDE 'DPCOHK.INC'
21761      INCLUDE 'DPCODA.INC'
21762      INCLUDE 'DPCOP2.INC'
21763C
21764C-----START POINT-----------------------------------------------------
21765C
21766      IFOUND='NO'
21767      IERROR='NO'
21768      ISUBN1='DPEC'
21769      ISUBN2='DF  '
21770C
21771      MAXCP1=MAXCOL+1
21772      MAXCP2=MAXCOL+2
21773      MAXCP3=MAXCOL+3
21774      MAXCP4=MAXCOL+4
21775      MAXCP5=MAXCOL+5
21776      MAXCP6=MAXCOL+6
21777C
21778      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')THEN
21779        WRITE(ICOUT,999)
21780  999   FORMAT(1X)
21781        CALL DPWRST('XXX','BUG ')
21782        WRITE(ICOUT,51)
21783   51   FORMAT('***** AT THE BEGINNING OF DPECDF--')
21784        CALL DPWRST('XXX','BUG ')
21785        WRITE(ICOUT,52)ICASPL,IAND1,IAND2,MAXCOL
21786   52   FORMAT('ICASPL,IAND1,IAND2,MAXCOL = ',3(A4,2X),I8)
21787        CALL DPWRST('XXX','BUG ')
21788        WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ,ISUBRO
21789   53   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
21790        CALL DPWRST('XXX','BUG ')
21791      ENDIF
21792C
21793C
21794C               ***********************************
21795C               **  TREAT THE EMPIRICAL CDF PLOT **
21796C               ***********************************
21797C
21798C               *******************************************
21799C               **  STEP 1--                             **
21800C               **  SEARCH FOR EMPIRICAL CDF, ECDF       **
21801C               *******************************************
21802C
21803      ISTEPN='11'
21804      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
21805     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21806C
21807      ICASPL='ECDF'
21808      IF(NUMARG.GE.1.AND.ICOM.EQ.'ECDF'.AND.IHARG(1).EQ.'PLOT')THEN
21809        ILASTC=1
21810      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'EMPI'.AND.
21811     1       IHARG(1).EQ.'CDF '.AND.IHARG(2).EQ.'PLOT')THEN
21812        ILASTC=2
21813      ELSE
21814        ICASPL='    '
21815        IFOUND='NO'
21816        GOTO9000
21817      ENDIF
21818C
21819      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
21820      IFOUND='YES'
21821C
21822C               ****************************************
21823C               **  STEP 2--                          **
21824C               **  EXTRACT THE VARIABLE LIST         **
21825C               ****************************************
21826C
21827      ISTEPN='2'
21828      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
21829     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21830C
21831      INAME='EMPIRICAL CDF PLOT'
21832      MINNA=1
21833      MAXNA=100
21834      MINN2=1
21835      IFLAGE=1
21836      IFLAGM=0
21837      IFLAGP=0
21838      JMIN=1
21839      JMAX=NUMARG
21840      MINNVA=1
21841      MAXNVA=2
21842C
21843      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
21844     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
21845     1            JMIN,JMAX,
21846     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
21847     1            IVARN1,IVARN2,IVARTY,PVAR,
21848     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
21849     1            MINNVA,MAXNVA,
21850     1            IFLAGM,IFLAGP,
21851     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
21852      IF(IERROR.EQ.'YES')GOTO9000
21853C
21854      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')THEN
21855        WRITE(ICOUT,999)
21856        CALL DPWRST('XXX','BUG ')
21857        WRITE(ICOUT,281)
21858  281   FORMAT('***** AFTER CALL DPPARS--')
21859        CALL DPWRST('XXX','BUG ')
21860        WRITE(ICOUT,282)NQ,NUMVAR
21861  282   FORMAT('NQ,NUMVAR = ',2I8)
21862        CALL DPWRST('XXX','BUG ')
21863        IF(NUMVAR.GT.0)THEN
21864          DO285I=1,NUMVAR
21865            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
21866     1                      ICOLR(I)
21867  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
21868     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
21869            CALL DPWRST('XXX','BUG ')
21870  285     CONTINUE
21871        ENDIF
21872      ENDIF
21873C
21874C               *******************************************************
21875C               **  STEP 41--                                        **
21876C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            **
21877C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY)FOR THE   **
21878C               **  PLOT FORM THE CURVE DESIGNATION VARIABLED(.)  .  **
21879C               **  THIS WILL BE ALL ONES.                           **
21880C               **  DEFINE THE NUMBER OF PLOT POINTS   (NPLOTP).     **
21881C               **  DEFINE THE NUMBER OF PLOT VARIABLES(NPLOTV).     **
21882C               *******************************************************
21883C
21884      ISTEPN='41'
21885      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
21886     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21887C
21888      ICOL=1
21889      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
21890     1            INAME,IVARN1,IVARN2,IVARTY,
21891     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
21892     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
21893     1            MAXCP4,MAXCP5,MAXCP6,
21894     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
21895     1            Y1,X1,Y1,NS,NS,NS,ICASE,
21896     1            IBUGG3,ISUBRO,IFOUND,IERROR)
21897      IF(IERROR.EQ.'YES')GOTO9000
21898C
21899      CALL DPECD2(Y1,X1,NS,NUMVAR,ICASPL,MAXN,
21900     1            Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
21901C
21902C               *****************
21903C               **  STEP 90--  **
21904C               **  EXIT       **
21905C               *****************
21906C
21907 9000 CONTINUE
21908      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')THEN
21909        WRITE(ICOUT,999)
21910        CALL DPWRST('XXX','BUG ')
21911        WRITE(ICOUT,9011)
21912 9011   FORMAT('***** AT THE END       OF DPECDF--')
21913        CALL DPWRST('XXX','BUG ')
21914        WRITE(ICOUT,9012)IFOUND,IERROR
21915 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
21916        CALL DPWRST('XXX','BUG ')
21917        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
21918 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',3I8,3(2X,A4))
21919        CALL DPWRST('XXX','BUG ')
21920        IF(NPLOTP.GT.0)THEN
21921          DO9015I=1,NPLOTP
21922            WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
21923 9016       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
21924            CALL DPWRST('XXX','BUG ')
21925 9015     CONTINUE
21926        ENDIF
21927      ENDIF
21928C
21929      RETURN
21930      END
21931      SUBROUTINE DPECD2(Y1,X1,N,NUMV,ICASPL,MAXN,
21932     1                  Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
21933C
21934C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
21935C              THAT WILL DEFINE AN EMPIRICAL CDF PLOT
21936C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
21937C                               (UNSORTED) OBSERVATIONS
21938C                               FOR THE FIRST  VARIABLE.
21939C                               IF X1 IS SPECIFIED, THEN Y1 BECOMES
21940C                               A FREQUENCY VARIABLE
21941C                      X1   = IF SPECIFIED, IT REPRESENTS THE
21942C                             OBSERVATION POINTS (AND Y1 IS THE
21943C                             FREQUENCY)
21944C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
21945C                               IN THE VECTOR X.
21946C     WRITTEN BY--JAMES J. FILLIBEN
21947C                 STATISTICAL ENGINEERING DIVISION
21948C                 INFORMATION TECHNOLOGY LABORATORY
21949C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21950C                 GAITHERSBURG, MD 20899-8980
21951C                 PHONE--301-975-2899
21952C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21953C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21954C     LANGUAGE--ANSI FORTRAN (1977)
21955C     VERSION NUMBER--98/5
21956C     ORIGINAL VERSION--MAY       1998.
21957C
21958C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21959C
21960      CHARACTER*4 ICASPL
21961      CHARACTER*4 IBUGG3
21962      CHARACTER*4 ISUBRO
21963      CHARACTER*4 IERROR
21964C
21965      CHARACTER*4 IWRITE
21966      CHARACTER*4 ISUBN1
21967      CHARACTER*4 ISUBN2
21968C
21969C---------------------------------------------------------------------
21970C
21971      DIMENSION Y1(*)
21972      DIMENSION X1(*)
21973C
21974      DIMENSION Y(*)
21975      DIMENSION X(*)
21976      DIMENSION D(*)
21977C
21978C---------------------------------------------------------------------
21979C
21980      INCLUDE 'DPCOP2.INC'
21981C
21982C-----START POINT-----------------------------------------------------
21983C
21984      ISUBN1='DPEC'
21985      ISUBN2='D2  '
21986      IERROR='NO'
21987C
21988      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'ECD2')THEN
21989        WRITE(ICOUT,999)
21990  999   FORMAT(1X)
21991        CALL DPWRST('XXX','BUG ')
21992        WRITE(ICOUT,51)
21993   51   FORMAT('***** AT THE BEGINNING OF DPECD2--')
21994        CALL DPWRST('XXX','BUG ')
21995        WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
21996   52   FORMAT('IBUGG3,ISUBRO,IERROR = ',2(A4,2X),A4)
21997        CALL DPWRST('XXX','BUG ')
21998        WRITE(ICOUT,53)ICASPL,N,NUMV,MAXN
21999   53   FORMAT('ICASPL,N,NUMV,MAXN = ',A4,2X,3I8)
22000        CALL DPWRST('XXX','BUG ')
22001        DO55I=1,N
22002          WRITE(ICOUT,56)I,Y1(I),X1(I)
22003   56     FORMAT('I, Y1(I), X1(I), = ',I8,2G15.7)
22004          CALL DPWRST('XXX','BUG ')
22005   55   CONTINUE
22006      ENDIF
22007C
22008C               ********************************************
22009C               **  STEP 1--                              **
22010C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
22011C               ********************************************
22012C
22013      IF(N.LT.2)THEN
22014        WRITE(ICOUT,999)
22015        CALL DPWRST('XXX','BUG ')
22016        WRITE(ICOUT,111)
22017  111   FORMAT('***** ERROR IN EMPIRICAL CDF PLOT--')
22018        CALL DPWRST('XXX','BUG ')
22019        WRITE(ICOUT,112)
22020  112   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
22021        CALL DPWRST('XXX','BUG ')
22022        WRITE(ICOUT,114)N
22023  114   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
22024        CALL DPWRST('XXX','BUG ')
22025        WRITE(ICOUT,999)
22026        CALL DPWRST('XXX','BUG ')
22027        IERROR='YES'
22028        GOTO9000
22029      ENDIF
22030C
22031      HOLD=Y1(1)
22032      DO120I=1,N
22033        IF(Y1(I).NE.HOLD)GOTO129
22034  120 CONTINUE
22035      WRITE(ICOUT,999)
22036      CALL DPWRST('XXX','BUG ')
22037      WRITE(ICOUT,111)
22038      CALL DPWRST('XXX','BUG ')
22039      WRITE(ICOUT,122)HOLD
22040  122 FORMAT('      ALL ELEMENTS IN THE RESPONSE VARIABLE ARE ',
22041     1       'IDENTICALLY EQUAL TO ',G15.7)
22042      CALL DPWRST('XXX','BUG ')
22043      WRITE(ICOUT,999)
22044      CALL DPWRST('XXX','BUG ')
22045      IERROR='YES'
22046      GOTO9000
22047  129 CONTINUE
22048C
22049C               *************************************************
22050C               **  STEP 12--                                  **
22051C               **  COMPUTE COORDINATES FOR EMPIRICAL CDF PLOT **
22052C               **  (INCORPORATE STAIR-STEP APPEARANCE)        **
22053C               *************************************************
22054C
22055      IF(NUMV.EQ.1)THEN
22056        CALL SORT(Y1,N,Y1)
22057        J=1
22058        X(J)=Y1(1)
22059        Y(J)=0.0
22060        D(J)=1.0
22061        J=2
22062        X(J)=Y1(1)
22063        Y(J)=1.0/REAL(N)
22064        D(J)=1.0
22065        DO200I=2,N
22066          J=J+1
22067          X(J)=Y1(I)
22068          Y(J)=REAL(I-1)/REAL(N)
22069          D(J)=1.0
22070          J=J+1
22071          X(J)=Y1(I)
22072          Y(J)=REAL(I)/REAL(N)
22073          D(J)=1.0
22074  200   CONTINUE
22075      ELSE
22076C
22077C       NOTE: THIS SECTION NEEDS TO BE FIXED.
22078C
22079        DO300I=1,N
22080          X1(I)=HOLD
22081          X1(I)=Y1(I)
22082          Y1(I)=HOLD
22083  300   CONTINUE
22084C
22085        CALL SORTC(X1,Y1,N,X1,Y1)
22086        IWRITE='OFF'
22087        CALL SUMDP(Y1,N,IWRITE,YSUM,IBUGG3,IERROR)
22088        CALL CUMSUM(Y1,N,IWRITE,Y1,IBUGG3,IERROR)
22089        J=1
22090        X(J)=X1(1)
22091        Y(J)=0.0
22092        D(J)=1.0
22093        J=2
22094        X(J)=X1(1)
22095        Y(J)=Y1(1)/REAL(YSUM)
22096        D(J)=1.0
22097        DO310I=2,N
22098          J=J+1
22099          X(J)=X1(I)
22100          Y(J)=Y1(I-1)/YSUM
22101          D(J)=1.0
22102          J=J+1
22103          X(J)=X1(I)
22104          Y(J)=Y1(I)/YSUM
22105          D(J)=1.0
22106  310   CONTINUE
22107      ENDIF
22108C
22109      NPLOTP=J
22110      NPLOTV=2
22111      GOTO9000
22112C
22113C               ******************
22114C               **   STEP 90--  **
22115C               **   EXIT       **
22116C               ******************
22117C
22118 9000 CONTINUE
22119      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'ECD2')THEN
22120        WRITE(ICOUT,999)
22121        CALL DPWRST('XXX','BUG ')
22122        WRITE(ICOUT,9011)
22123 9011   FORMAT('***** AT THE END       OF DPECD2--')
22124        CALL DPWRST('XXX','BUG ')
22125        WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
22126 9012   FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
22127        CALL DPWRST('XXX','BUG ')
22128        WRITE(ICOUT,9021)NPLOTP,NPLOTV
22129 9021   FORMAT('NPLOTP,NPLOTV = ',2I8)
22130        CALL DPWRST('XXX','BUG ')
22131        DO9022I=1,NPLOTP
22132          WRITE(ICOUT,9023)I,Y(I),X(I),D(I)
22133 9023     FORMAT('I,Y(I),X(I),D(I) = ',I8,3G15.7)
22134          CALL DPWRST('XXX','BUG ')
22135 9022   CONTINUE
22136      ENDIF
22137C
22138      RETURN
22139      END
22140