1      SUBROUTINE DPLOEX(ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE,MAXLOO,
2     1                  IHPNV,IHPNV2,ILOCPN,ASTARV,AINCV,ASTOPV,
3     1                  NUMLOI,ILOOIT,ILOOIF,
4     1                  ILOOSP,ILOOEP,IANSLO,IWIDLL,MAXLIL,MAXCIL,
5     1                  IANS,IANSLC,IWIDTH,
6     1                  ICOM,ICOM2,ICOMT,ICOMI,ACOM,ICOMLC,ICOML2,
7     1                  IHARG,IHARG2,IARGT,IARG,ARG,IHARLC,IHARL2,
8     1                  NUMARG,
9     1                  IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,
10     1                  IN,IIFSW,NUMIF,IHOST1,IHOST2,
11     1                  IBUGLO,IBUGTY,ISUBRO,IERROR)
12C
13C     PURPOSE--EXECUTE THE COMMANDS IN A LOOP
14C              (THESE COMMANDS HAVE BEEN AUTOMATICALLY STORED).
15C     WRITTEN BY--JAMES J. FILLIBEN
16C                 STATISTICAL ENGINEERING DIVISION
17C                 INFORMATION TECHNOLOGY LABORATORY
18C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19C                 GAITHERSBURG, MD 20899-8980
20C                 PHONE--301-975-2855
21C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23C     LANGUAGE--ANSI FORTRAN (1977)
24C     VERSION NUMBER--82/7
25C     ORIGINAL VERSION--DECEMBER 1982
26C     UPDATED         --APRIL    1989   ADD ISUBRO AS AN ARGUMENT
27C     UPDATED         --FEBRUARY 1994 FIX BUG THAT DELETE IN LOOP WIPED
28C                                     OUT LOOP INDEX PARAMETER
29C     UPDATED         --FEBRUARY 1994 ADD BREAK LOOP COMMAND
30C     UPDATED         --JANUARY  2005 FOR LOOPS OF TYPE
31C                                         LOOP FOR K = 3 1 2
32C                                     MODIFY SO THAT LOOP NOT EXECUTED
33C                                     AND SET INDEX VALUE TO START
34C                                     VALUE
35C     UPDATED         --FEBRUARY 2006 USE MAXCIL (RATHER THAN 80) AS
36C                                     THE MAXIMUM NUMBER OF
37C                                     CHARACTERS PER LINE IN LOOP
38C     UPDATED         --FEBRUARY 2006 BUG IN BREAK LOOP WHEN BREAK
39C                                     OCCURS IN FIRST ITERATION OF
40C                                     THE LOOP
41C     UPDATED         --AUGUST   2007 FIX BUG WHEN THERE IS A DELETE
42C                                     IN THE LOOP COMMAND
43C     UPDATED         --MAY      2011 ADD MAXLOO TO SPECIFY MAXIMUM
44C                                     NUMBER OF NESTED LOOPS
45C     UPDATED         --OCTOBER  2018 ILOOIF TO KEEP TRACK OF IF LEVEL
46C                                     WHEN INITIATE LOOP
47C     UPDATED         --OCTOBER  2018 "CONTINUE LOOP"
48C
49C---------------------------------------------------------------------
50C
51      CHARACTER*4 ILOOST
52      CHARACTER*4 IHPNV
53      CHARACTER*4 IHPNV2
54      CHARACTER*4 IANSLO
55      CHARACTER*4 IANS
56      CHARACTER*4 IANSLC
57      CHARACTER*4 ICOM
58      CHARACTER*4 ICOM2
59      CHARACTER*4 ICOMT
60      CHARACTER*4 ICOMLC
61      CHARACTER*4 ICOML2
62      CHARACTER*4 IHARG
63      CHARACTER*4 IHARG2
64      CHARACTER*4 IARGT
65      CHARACTER*4 IHARLC
66      CHARACTER*4 IHARL2
67      CHARACTER*4 IHNAME
68      CHARACTER*4 IHNAM2
69      CHARACTER*4 IUSE
70      CHARACTER*4 IHOST1
71      CHARACTER*4 IHOST2
72      CHARACTER*4 IBUGLO
73      CHARACTER*4 IBUGTY
74      CHARACTER*4 ISUBRO
75      CHARACTER*4 IERROR
76C
77      CHARACTER*4 IH
78      CHARACTER*4 IH2
79      CHARACTER*4 IHPN
80      CHARACTER*4 IHPN2
81      CHARACTER*4 ISUBN1
82      CHARACTER*4 ISUBN2
83      CHARACTER*4 ISTEPN
84      CHARACTER*4 IFOUNF
85      CHARACTER*4 IIFSW
86C
87      DIMENSION IHPNV(*)
88      DIMENSION IHPNV2(*)
89      DIMENSION ILOCPN(*)
90      DIMENSION ASTARV(*)
91      DIMENSION AINCV(*)
92      DIMENSION ASTOPV(*)
93      DIMENSION NUMLOI(*)
94      DIMENSION ILOOIT(*)
95      DIMENSION ILOOSP(*)
96      DIMENSION ILOOEP(*)
97      DIMENSION ILOOIF(*)
98      DIMENSION IANSLO(MAXLIL,MAXCIL)
99      DIMENSION IWIDLL(*)
100C
101      DIMENSION IANS(*)
102      DIMENSION IANSLC(*)
103      DIMENSION IHARG(*)
104      DIMENSION IHARG2(*)
105      DIMENSION IARGT(*)
106      DIMENSION IARG(*)
107      DIMENSION ARG(*)
108      DIMENSION IHARLC(*)
109      DIMENSION IHARL2(*)
110C
111      DIMENSION IHNAME(*)
112      DIMENSION IHNAM2(*)
113      DIMENSION IUSE(*)
114      DIMENSION IVALUE(*)
115      DIMENSION VALUE(*)
116      DIMENSION IN(*)
117C
118C---------------------------------------------------------------------
119C
120      INCLUDE 'DPCOP2.INC'
121C
122C-----START POINT-----------------------------------------------------
123C
124      ISUBN1='DPLO'
125      ISUBN2='EX  '
126      J12=0
127C
128      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
129        WRITE(ICOUT,999)
130  999   FORMAT(1X)
131        CALL DPWRST('XXX','BUG ')
132        WRITE(ICOUT,51)
133   51   FORMAT('***** AT THE BEGINNING OF DPLOEX--')
134        CALL DPWRST('XXX','BUG ')
135        WRITE(ICOUT,52)IBUGLO,IBUGTY,IERROR
136   52   FORMAT('IBUGLO,IBUGTY,IERROR = ',A4,2X,A4,2X,A4)
137        CALL DPWRST('XXX','BUG ')
138        WRITE(ICOUT,53)ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE
139   53   FORMAT('ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE = ',A4,4I8)
140        CALL DPWRST('XXX','BUG ')
141        WRITE(ICOUT,54)NUMLOE,NUMENE,NUMLIL,MAXCIL
142   54   FORMAT('NUMLOE,NUMENE,NUMLIL,MAXCIL = ',4I8)
143        DO55I=1,10
144          WRITE(ICOUT,56)I,IHPNV(I),IHPNV2(I),ILOCPN(I),ILOOSP(I),
145     1                   ILOOEP(I)
146   56     FORMAT('I,IHPNV(I),IHPNV2(I),ILOCPN(I),ILOOSP(I),',
147     1           'ILOOEP(I) =',I8,2(2X,A4),3I8)
148          CALL DPWRST('XXX','BUG ')
149   55   CONTINUE
150        WRITE(ICOUT,999)
151        CALL DPWRST('XXX','BUG ')
152        DO60I=1,10
153          WRITE(ICOUT,61)I,ASTARV(I),AINCV(I),ASTOPV(I),
154     1                   NUMLOI(I),ILOOIT(I)
155   61     FORMAT('I,ASTARV(I),AINCV(I),ASTOPV(I),NUMLOI(I),',
156     1           'ILOOIT(I) =',I8,3E15.7,2I8)
157          CALL DPWRST('XXX','BUG ')
158   60   CONTINUE
159        WRITE(ICOUT,999)
160        CALL DPWRST('XXX','BUG ')
161        DO65I=1,NUMLIL
162          WRITE(ICOUT,66)I,IWIDLL(I)
163   66     FORMAT('I,IWIDLL(I) = ',I8,I8)
164          CALL DPWRST('XXX','BUG ')
165          JMAX=IWIDLL(I)
166          WRITE(ICOUT,67)(IANSLO(I,J),J=1,MIN(80,JMAX))
167   67     FORMAT('(IANSLO(I,J),J=1,JMAX) = ',80A1)
168          CALL DPWRST('XXX','BUG ')
169   65   CONTINUE
170        WRITE(ICOUT,999)
171        CALL DPWRST('XXX','BUG ')
172        WRITE(ICOUT,71)IWIDTH,NUMARG,ICOM,ICOM2
173   71   FORMAT('IWIDTH,NUMARG,ICOM,ICOM2 = ',2I8,2(2X,A4))
174        CALL DPWRST('XXX','BUG ')
175        WRITE(ICOUT,72)ICOMLC,ICOML2
176   72   FORMAT('ICOMLC,ICOML2 = ',A4,2X,A4)
177        CALL DPWRST('XXX','BUG ')
178        WRITE(ICOUT,73)(IANS(I),I=1,MIN(80,IWIDTH))
179   73   FORMAT('(IANS(I),I=1,IWIDTH) = ',80A1)
180        CALL DPWRST('XXX','BUG ')
181        WRITE(ICOUT,74)(IANSLC(I),I=1,MIN(80,IWIDTH))
182   74   FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
183        CALL DPWRST('XXX','BUG ')
184        DO75I=1,NUMNAM
185          WRITE(ICOUT,76)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
186   76     FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
187     1           I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
188          CALL DPWRST('XXX','BUG ')
189          WRITE(ICOUT,77)I,IHARLC(I),IHARL2(I)
190   77     FORMAT('I,IHARLC(I),IHARL2(I) = ',I8,2X,A4,2X,A4)
191          CALL DPWRST('XXX','BUG ')
192   75   CONTINUE
193        WRITE(ICOUT,999)
194        CALL DPWRST('XXX','BUG ')
195        DO80I=1,NUMNAM
196          WRITE(ICOUT,81)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),
197     1                   VALUE(I)
198   81     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),',
199     1           'VALUE(I) = ',I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
200          CALL DPWRST('XXX','BUG ')
201   80   CONTINUE
202C
203      ENDIF
204C
205C               *************************************************
206C               **  STEP 1--                                   **
207C               **  IF ENTRY IS FROM OUTSIDE THIS SUBROUTINE,  **
208C               **  THEN INCREMENT THE LOOP LINE NUMBER        **
209C               **  WHICH SPECIFIES WHICH LINE OF THE LOOP     **
210C               **  WILL BE EXAMINED AND EXECUTED.             **
211C               *************************************************
212C
213      ILOOLI=ILOOLI+1
214C
215C               **********************************************
216C               **  STEP 2--                                **
217C               **  COPY THE STORED LINE BACK INTO IANS(.)  **
218C               **********************************************
219C
220 1200 CONTINUE
221C
222      ISTEPN='2'
223      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
224     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
225C
226      DO1230J=1,MAXCIL
227        IANS(J)='    '
228        IANSLC(J)='    '
229 1230 CONTINUE
230C
231      IWIDTH=IWIDLL(ILOOLI)
232      DO1250J=1,IWIDTH
233        IANSLC(J)=IANSLO(ILOOLI,J)
234 1250 CONTINUE
235      CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGLO,IERROR)
236C
237      IF(IBUGLO.EQ.'ON' .OR. ISUBRO.EQ.'LOEX')THEN
238        WRITE(ICOUT,999)
239        CALL DPWRST('XXX','BUG ')
240        WRITE(ICOUT,999)
241        CALL DPWRST('XXX','BUG ')
242        WRITE(ICOUT,1261)
243 1261   FORMAT('--------------------')
244        CALL DPWRST('XXX','BUG ')
245        WRITE(ICOUT,999)
246        CALL DPWRST('XXX','BUG ')
247        WRITE(ICOUT,1262)ILOOLI
248 1262   FORMAT('CURRENT LINE NUMBER ILOOLI = ',I8)
249        CALL DPWRST('XXX','BUG ')
250        WRITE(ICOUT,1263)(IANSLC(I),I=1,MIN(IWIDTH,80))
251 1263   FORMAT('(IANSLC(I),I=1,80) = ',80A1)
252        CALL DPWRST('XXX','BUG ')
253      ENDIF
254C
255C               ******************************************
256C               **  STEP 3--                            **
257C               **  EXTRACT THE COMMAND NAME AND        **
258C               **  SEPARATE OUT THE VARIOUS ARGUMENTS  **
259C               ******************************************
260C
261      ISTEPN='3'
262      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
263     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
264C
265      CALL DPTYPE(IANSLC,IWIDTH,IBUGTY,
266     1            ICOM,ICOM2,ICOMT,ICOMI,ACOM,ICOMLC,ICOML2,
267     1            IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
268     1            IHARG,IHARG2,IARGT,IARG,ARG,IHARLC,IHARL2,NUMARG,
269     1            IHOST1,IHOST2)
270C
271C               ******************************************
272C               **  STEP 4--                            **
273C               **  SEARCH FOR LOOP COMMAND             **
274C               **  AND BRANCH ACCORDINGLY;             **
275C               **  SEARCH FOR END OF LOOP COMMAND      **
276C               **  AND BRANCH ACCORDINGLY;             **
277C               **  IF NEITHER, THEN JUMP TO EXIT       **
278C               **              FOR NORMAL PROCESSING.  **
279C               ******************************************
280C
281C
282      ISTEPN='4'
283      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
284        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
285        WRITE(ICOUT,1401)ICOM,ILOOLI
286 1401   FORMAT('ICOM,ILOOLI = ',A4,I8)
287        CALL DPWRST('XXX','BUG ')
288      ENDIF
289C
290C  BUG FIX: ALLOW IF COMMANDS TO BE NESTED WITHIN LOOP (AUGUST, 1987)
291C           SO SPECIFICALLY CHECK FOR "END LOOP" TO AVOID CONFLICT
292C           WITH "END IF"
293C  FEBRUARY 1994.  BREAK LOOP COMMAND.
294C
295      IF(ICOM.EQ.'LOOP')THEN
296        GOTO1400
297C
298C               *************************************************
299C               **  STEP 6--                                   **
300C               **  TREAT THE CASE WHEN COMMAND = END OF LOOP  **
301C               **  NUMENE = NUMBER OF    END OF LOOP          **
302C               **  COMMANDS ENCOUNTERED                       **
303C               *************************************************
304C
305      ELSEIF(
306     1  (ICOM.EQ.'END'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP') .OR.
307     1  (ICOM.EQ.'END'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'LOOP'))THEN
308        ISTEPN='6'
309        IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
310     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
311C
312        NUMENE=NUMENE+1
313        ILOOEP(NUMLOE)=ILOOLI
314        GOTO1700
315      ELSEIF(ICOM.EQ.'BREA'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP')THEN
316        IF(IIFSW.EQ.'TRUE')THEN
317          IF(NUMIF.GT.0)NUMIF=NUMIF-1
318          GOTO1700
319        ELSE
320          GOTO9000
321        ENDIF
322      ELSEIF(ICOM.EQ.'CONT'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP')THEN
323C
324C       TREAT "CONTINUE LOOOP" AS ESSENTIALLY EQUIVALENT TO "END LOOP".
325C       HOWEVER, HAVE TO TWEAK VARIOUS SETTINGS APPROPRIATELY.
326C
327C       CONTINUE LOOP JUST GOES TO THE NEXT ITERATION OF THE LOOP
328C
329        IF(IIFSW.EQ.'TRUE')THEN
330          ILOOLI=ILOOSP(NUMENE)
331          GOTO1700
332        ELSE
333          GOTO9000
334        ENDIF
335      ELSEIF(ICOM.EQ.'CONT'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP')THEN
336      ENDIF
337      GOTO9000
338C
339C               **********************************************
340C               **  STEP 4.1--                              **
341C               **  TREAT THE CASE WHEN THE COMMAND = LOOP  **
342C               **  NUMLOE = NUMBER OF    LOOP   COMMANDS   **
343C               **  ENCOUNTERED                             **
344C               **********************************************
345C
346 1400 CONTINUE
347      ISTEPN='4.1'
348      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
349     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
350C
351      NUMLOE=NUMLOE+1
352      IF(NUMLOE.GT.MAXLOO)THEN
353        WRITE(ICOUT,999)
354        CALL DPWRST('XXX','BUG ')
355        WRITE(ICOUT,1301)
356 1301   FORMAT('****** ERROR IN LOOP COMMAND--')
357        CALL DPWRST('XXX','BUG ')
358        WRITE(ICOUT,1302)MAXLOO
359 1302   FORMAT('       MAXIMUM NUMBER OF NESTED LOOPS (',I3,
360     1         ') EXCEEDED.')
361        CALL DPWRST('XXX','BUG ')
362        NUMLOE=NUMLOE-1
363        IERROR='YES'
364        GOTO9000
365      ENDIF
366C
367C     OCTOBER 2018: SAVE THE CURRENT "IF LEVEL" FOR THIS NESTING
368C                   LEVEL OF THE LOOP
369C
370      ILOOIF(NUMLOE)=NUMIF
371C
372C     DECEMBER 2006: WHEN IF SWITCH IS FALSE, DO NOT
373C                    PROCESS LOOP COMMAND.
374C
375      IF(IIFSW.EQ.'FALS')GOTO9000
376C
377C               *********************************************
378C               **  STEP 4.2--                             **
379C               **  SEARCH FOR FIRST OCCURRANCE OF    FOR  **
380C               *********************************************
381C
382      ISTEPN='4.2'
383      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
384        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
385        WRITE(ICOUT,1413)ILOOLI,NUMLOE,ILOOIF(NUMLOE)
386        CALL DPWRST('XXX','BUG ')
387      ENDIF
388C
389      JMAX=NUMARG-1
390      DO1405J=1,JMAX
391        J2=J
392        JP1=J+1
393        IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    '.AND.
394     1     IHARG(JP1).EQ.'I   '.AND.IHARG2(JP1).EQ.'   ')GOTO1430
395        IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1450
396 1405 CONTINUE
397      GOTO1410
398C
399C               **********************************************
400C               **  STEP 4.3A--                             **
401C               **  TREAT THE CASE WHERE   FOR   NOT FOUND  **
402C               **********************************************
403C
404 1410 CONTINUE
405      ISTEPN='4.3A'
406      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
407     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
408C
409      KMIN=1
410      ASTART=KMIN
411      KDEL=1
412      AINC=KDEL
413      KMAX=1
414      ASTOP=KMAX
415      NUMINC=1
416C
417      IHPN='I   '
418      IHPN2='    '
419      IHPNV(NUMLOE)=IHPN
420      IHPNV2(NUMLOE)=IHPN2
421      ASTARV(NUMLOE)=ASTART
422      AINCV(NUMLOE)=AINC
423      ASTOPV(NUMLOE)=ASTOP
424      ILOOSP(NUMLOE)=ILOOLI
425      NUMLOI(NUMLOE)=NUMINC
426C
427      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
428        WRITE(ICOUT,999)
429        CALL DPWRST('XXX','BUG ')
430        WRITE(ICOUT,1412)
431 1412   FORMAT('THIS IS THE    NO FOR    CASE')
432        CALL DPWRST('XXX','BUG ')
433        WRITE(ICOUT,1413)ILOOLI,NUMLOE,ILOOIF(NUMLOE)
434 1413   FORMAT('ILOOLI,NUMLOE,ILOOIF(NUMLOE) = ',3I8)
435        CALL DPWRST('XXX','BUG ')
436        WRITE(ICOUT,1414)IHPNV(NUMLOE),IHPNV2(NUMLOE)
437 1414   FORMAT('IHPNV(NUMLOE),IHPNV2(NUMLOE) = ',A4,2X,A4)
438        CALL DPWRST('XXX','BUG ')
439        WRITE(ICOUT,1415)ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE)
440 1415   FORMAT('ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) = ',
441     1         3E15.7)
442        CALL DPWRST('XXX','BUG ')
443        WRITE(ICOUT,1416)ILOOSP(NUMLOE),ILOOEP(NUMLOE)
444 1416   FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8)
445        CALL DPWRST('XXX','BUG ')
446        WRITE(ICOUT,1417)NUMLOI(NUMLOE),ILOOIT(NUMLOE)
447 1417   FORMAT('NUMLOI(NUMLOE),ILOOIT(NUMLOE) = ',2I8)
448        CALL DPWRST('XXX','BUG ')
449      ENDIF
450C
451      GOTO1490
452C
453C               **********************************
454C               **  STEP 4.3B--                 **
455C               **  TREAT THE    FOR I    CASE  **
456C               **********************************
457C
458 1430 CONTINUE
459      ISTEPN='4.3B'
460      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
461     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
462C
463      JP3=JP1+2
464      JP4=JP1+3
465      JP5=JP1+4
466      KMIN=1
467      IF(JP3.LE.NUMARG)KMIN=IARG(JP3)
468      ASTART=KMIN
469      KDEL=1
470      IF(JP4.LE.NUMARG)KDEL=IARG(JP4)
471      AINC=KDEL
472      KMAX=KMIN
473      IF(JP5.LE.NUMARG)KMAX=IARG(JP5)
474      ASTOP=KMAX
475      NUMINC=((KMAX-KMIN)/KDEL)+1
476C
477      IHPN='I   '
478      IHPN2='    '
479      IHPNV(NUMLOE)=IHPN
480      IHPNV2(NUMLOE)=IHPN2
481      ASTARV(NUMLOE)=ASTART
482      AINCV(NUMLOE)=AINC
483      ASTOPV(NUMLOE)=ASTOP
484      ILOOSP(NUMLOE)=ILOOLI
485      NUMLOI(NUMLOE)=NUMINC
486C
487      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
488        WRITE(ICOUT,999)
489        CALL DPWRST('XXX','BUG ')
490        WRITE(ICOUT,1432)
491 1432   FORMAT('THIS IS THE    FOR I    CASE')
492        CALL DPWRST('XXX','BUG ')
493        WRITE(ICOUT,1433)ILOOLI
494 1433   FORMAT('ILOOLI = ',I8)
495        CALL DPWRST('XXX','BUG ')
496        WRITE(ICOUT,1434)IHPNV(NUMLOE),IHPNV2(NUMLOE)
497 1434   FORMAT('IHPNV(NUMLOE),IHPNV2(NUMLOE) = ',A4,2X,A4)
498        CALL DPWRST('XXX','BUG ')
499        WRITE(ICOUT,1435)ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE)
500 1435   FORMAT('ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) = ',
501     1         3E15.7)
502        CALL DPWRST('XXX','BUG ')
503        WRITE(ICOUT,1436)ILOOSP(NUMLOE),ILOOEP(NUMLOE)
504 1436   FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8)
505        CALL DPWRST('XXX','BUG ')
506        WRITE(ICOUT,1437)NUMLOI(NUMLOE),ILOOIT(NUMLOE)
507 1437   FORMAT('NUMLOI(NUMLOE),ILOOIT(NUMLOE) = ',2I8)
508        CALL DPWRST('XXX','BUG ')
509      ENDIF
510C
511      GOTO1490
512C
513C               *******************************************
514C               **  STEP 4.3C--                          **
515C               **  TREAT THE     GENERAL FOR      CASE  **
516C               *******************************************
517C
518 1450 CONTINUE
519      ISTEPN='4.3C'
520      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
521     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
522      IFOLOC=J2
523      ILALOC=IFOLOC-1
524C
525      IF(IPRINT.EQ.'ON')THEN
526        WRITE(ICOUT,999)
527        CALL DPWRST('XXX','BUG ')
528      ENDIF
529      DO1460ITER=1,1000
530        IFOLOC=ILALOC+1
531        J=IFOLOC
532        JP1=J+1
533        IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    '.AND.
534     1     IHARG(JP1).EQ.'I   '.AND.IHARG2(JP1).EQ.'   ')GOTO1480
535        IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1470
536        GOTO1490
537 1470 CONTINUE
538C
539      CALL DPEXS2(IFOLOC,IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
540     1IANS,IWIDTH,
541     1IHPN,IHPN2,ASTART,AINC,ASTOP,NUMINC,ILALOC,IBUGLO,IFOUNF,IERROR)
542      IF(IERROR.EQ.'YES')THEN
543        IFOUNF='YES'
544        GOTO9000
545      ENDIF
546C
547      IF(IFOUNF.EQ.'NO')GOTO1490
548      IHPNV(NUMLOE)=IHPN
549      IHPNV2(NUMLOE)=IHPN2
550      ASTARV(NUMLOE)=ASTART
551      AINCV(NUMLOE)=AINC
552      ASTOPV(NUMLOE)=ASTOP
553      ILOOSP(NUMLOE)=ILOOLI
554      NUMLOI(NUMLOE)=NUMINC
555      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
556        WRITE(ICOUT,999)
557        CALL DPWRST('XXX','BUG ')
558        WRITE(ICOUT,1472)
559 1472   FORMAT('THIS IS THE    GENERAL FOR    CASE')
560        CALL DPWRST('XXX','BUG ')
561        WRITE(ICOUT,1473)ILOOLI
562 1473   FORMAT('ILOOLI = ',I8)
563        CALL DPWRST('XXX','BUG ')
564        WRITE(ICOUT,1474)IHPNV(NUMLOE),IHPNV2(NUMLOE)
565 1474   FORMAT('IHPNV(NUMLOE),IHPNV2(NUMLOE) = ',A4,2X,A4)
566        CALL DPWRST('XXX','BUG ')
567        WRITE(ICOUT,1475)ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE)
568 1475   FORMAT('ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) = ',
569     1         3E15.7)
570        CALL DPWRST('XXX','BUG ')
571        WRITE(ICOUT,1476)ILOOSP(NUMLOE),ILOOEP(NUMLOE)
572 1476   FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8)
573        CALL DPWRST('XXX','BUG ')
574        WRITE(ICOUT,1477)NUMLOI(NUMLOE),ILOOIT(NUMLOE)
575 1477   FORMAT('NUMLOI(NUMLOE),ILOOIT(NUMLOE) = ',2I8)
576        CALL DPWRST('XXX','BUG ')
577      ENDIF
578 1460 CONTINUE
579C
580 1480 CONTINUE
581C
582C               ***************************************
583C               **  STEP 4.4--                       **
584C               **  WRITE OUT A MESSAGE INDICATING   **
585C               **  THE TOTAL NUMBER OF ITERATIONS.  **
586C               ***************************************
587C
588 1490 CONTINUE
589      ISTEPN='4.4'
590      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
591     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
592C
593      IPROD=1
594      IF(NUMLOE.GT.0)THEN
595        DO1491I=1,NUMLOE
596          IPROD=IPROD*NUMLOI(I)
597 1491   CONTINUE
598      ENDIF
599C
600      NUMLAP=IPROD
601      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
602        WRITE(ICOUT,1496)NUMLOI(NUMLOE),IPROD
603 1496   FORMAT('NUMLOI(NUMLOE),IPROD = ',2I8)
604        CALL DPWRST('XXX','BUG ')
605      ENDIF
606C
607      ILOOIT(NUMLOE)=0
608      GOTO1700
609C
610C               *************************************************
611C               **  STEP 7.1--                                 **
612C               **  FOR BOTH THE    LOOP   COMMAND,            **
613C               **  AND THE   END OF LOOP   COMMAND,           **
614C               **  COMPUTE THE NEXT VALUE FOR THIS PARAMETER  **
615C               *************************************************
616C
617 1700 CONTINUE
618      ISTEPN='7.1'
619      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
620     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
621C
622      ILOOIT(NUMLOE)=ILOOIT(NUMLOE)+1
623      ITER=ILOOIT(NUMLOE)
624      AITER=ITER
625      PV=ASTARV(NUMLOE)+(AITER-1.0)*AINCV(NUMLOE)
626      N1=NUMLOI(NUMLOE)
627CCCCC IF(ITER.EQ.N1)PV=ASTOPV(NUMLOE)       APRIL 27, 1987
628C  FIX AUGUST, 1987
629C  LOOP GETS INCREMENTED ONCE PAST LAST VALUE. ADJUST STOP VALUE
630C  SO THAT WHEN EXIT LOOP, HAS LAST "GOOD" VALUE
631      IF(ITER.GT.N1)PV=PV-AINCV(NUMLOE)
632C  END FIX
633CCCCC ADD FOLLOWING BLOCK FOR BREAK LOOP COMMAND.  FEBRUARY 1994.
634      IF(ICOM.EQ.'BREA'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP')THEN
635        ITER=N1+1
636        PV=PV-AINCV(NUMLOE)
637      END IF
638CCCCC JANUARY 2005: IF HAVE SOMETHING LIKE
639CCCCC
640CCCCC                   LOOP FOR K = 3 1 2
641CCCCC
642CCCCC               THEN WE WANT TO TERMINATE LOOP WITHOUT
643CCCCC               EXECUTING IT.
644C
645      IF(AINCV(NUMLOE).GT.0)THEN
646        IF(ASTOPV(NUMLOE).LT.ASTARV(NUMLOE))THEN
647          ITER=N1+1
648          PV=ASTARV(NUMLOE)
649        ENDIF
650      ELSEIF(AINCV(NUMLOE).LT.0)THEN
651        IF(ASTOPV(NUMLOE).GT.ASTARV(NUMLOE))THEN
652          ITER=N1+1
653          PV=ASTARV(NUMLOE)
654        ENDIF
655      ENDIF
656C
657      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
658        WRITE(ICOUT,999)
659        CALL DPWRST('XXX','BUG ')
660        IF(ICOM.EQ.'END')THEN
661          WRITE(ICOUT,1712)
662 1712     FORMAT('AN    END OF LOOP   LINE HAS BEEN ENCOUNTERED')
663          CALL DPWRST('XXX','BUG ')
664        ENDIF
665        WRITE(ICOUT,1713)NUMLOE,ILOOLI,ICOM
666 1713   FORMAT('NUMLOE,ILOOLI,ICOM = ',2I8,2X,A4)
667        CALL DPWRST('XXX','BUG ')
668        WRITE(ICOUT,1714)IHPNV(NUMLOE),IHPNV2(NUMLOE)
669 1714   FORMAT('IHPNV(NUMLOE),IHPNV2(NUMLOE) = ',A4,2X,A4)
670        CALL DPWRST('XXX','BUG ')
671        WRITE(ICOUT,1715)ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE)
672 1715   FORMAT('ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) = ',
673     1         3E15.7)
674        CALL DPWRST('XXX','BUG ')
675        WRITE(ICOUT,1716)ILOOSP(NUMLOE),ILOOEP(NUMLOE)
676 1716   FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8)
677        CALL DPWRST('XXX','BUG ')
678        WRITE(ICOUT,1717)NUMLOI(NUMLOE),ILOOIT(NUMLOE)
679 1717   FORMAT('NUMLOI(NUMLOE),ILOOIT(NUMLOE) = ',2I8)
680        CALL DPWRST('XXX','BUG ')
681        WRITE(ICOUT,1718)ITER,N1,PV
682 1718   FORMAT('ITER,N1,PV = ',I8,I8,E15.7)
683        CALL DPWRST('XXX','BUG ')
684      ENDIF
685C
686C               ****************************************
687C               **  STEP 7.2--                        **
688C               **  FOR BOTH THE    LOOP   COMMAND,   **
689C               **  AND THE   END OF LOOP   COMMAND,  **
690C               **  DEFINE THE NEXT LINE OF THE LOOP  **
691C               **  TO BE EXAMINED                    **
692C               ****************************************
693C
694      ISTEPN='7.2'
695      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
696        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
697C
698        WRITE(ICOUT,1705)ILOOLI,ITER,N1,NUMLOE
699 1705   FORMAT('ILOOLI,ITER,N1,NUMLOE = ',4I8)
700        CALL DPWRST('XXX','BUG ')
701        WRITE(ICOUT,1706)ILOOSP(NUMLOE),ILOOEP(NUMLOE)
702 1706   FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8)
703        CALL DPWRST('XXX','BUG ')
704      ENDIF
705C
706      ILOOLI=ILOOSP(NUMLOE)+1
707      IF(ITER.GT.N1)ILOOLI=ILOOEP(NUMLOE)+1
708C
709CCCCC ADD FOLLOWING BLOCK FOR BREAK LOOP COMMAND.  FEBRUARY 1994.
710CCCCC BUG.  BREAK LOOP NORMALLY IN IF BLOCK, WHEN THERE IS ERROR
711CCCCC IN IF STATEMENT (OR THERE IS NO IF), THEN GET SEG FAULT
712CCCCC BECAUSE ILOOEP NOT YET DEFINED (I.E., BREAK LOOP ENCOUNTERED
713CCCCC BEFORE END OF LOOP, NEED AT LEAST ONE ITERATION THROUGH LOOP).
714C
715CCCCC IF(ILOOEP(NUMLOE).GT.0)THEN
716        IF(ICOM.EQ.'BREA'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP')THEN
717          ILOOLI=ILOOEP(NUMLOE)+1
718        END IF
719CCCCC ELSE
720CCCCC ENDIF
721C  BUG FIX: AUGUST, 1987 FOLLOWING 2 LINES MOVED TO CORRECT PROBLEM
722C  WITH NESTED LOOPS.  FOR NESTED LOOPS, VALUE OF INNER LOOP IS ASSIGNED
723C  TO OUTER LOOP
724C  DR. FILLIBEN CORRECTED PROBLEM ELSEWHERE.  UNCOMMENT THIS FIX
725C
726CCCCC IF(ITER.GT.N1)NUMLOE=NUMLOE-1
727CCCCC IF(ITER.GT.N1)NUMENE=NUMENE-1
728C
729C               *******************************************
730C               **  STEP 7.3--                           **
731C               **  FOR BOTH THE    LOOP   COMMAND,      **
732C               **  AND THE   END OF LOOP   COMMAND,     **
733C               **  IF THE NEXT LINE TO BE EXAMINED IS   **
734C               **  BEYOND THE LOOP TABLE, THEN          **
735C               **  THE LOOPING IS COMPLETED--           **
736C               **  BRANCH TO RESET ALL LOOP VARIABLES.  **
737C               *******************************************
738C
739      ISTEPN='7.3'
740      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
741     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
742C
743CCCCC BUG FIX.  ADD FOLLOWING LINE.     JANUARY 1999.
744CCCCC BUG IS IF NO IF AROUND BREAK LOOP (WHICH ALSO OCCURS
745CCCCC IF THERE IS AN ERROR IN THE IF)
746      IF(ILOOLI.LT.0)GOTO1800
747      IF(ILOOLI.GT.NUMLIL)GOTO1800
748C
749C               ********************************************
750C               **  STEP 7.4--                            **
751C               **  FOR BOTH THE    LOOP   COMMAND,       **
752C               **  AND THE   END OF LOOP   COMMAND,      **
753C               **  ENTER THE TERMPORARY VALUE FOR        **
754C               **  FOR THE LOOP PARAMETER                **
755C               **  INTO THE PERMANENT INTERNAL DATAPLOT  **
756C               **  NAME TABLE.                           **
757C               ********************************************
758C
759C
760      ISTEPN='7.4'
761      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
762     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
763C
764C               ****************************************************
765C               **  STEP 7.5--                                    **
766C               **  IS THIS A LOOP COMMAND?                       **
767C               **  IF SO, SEARCH THE INTERNAL DATAPLOT           **
768C               **  NAME TABLE FOR THE PARAMETER NAME.            **
769C               **  IF NOT, THEN THE NAME SHOULD ALREADY HAVE     **
770C               **  BEEN ENTERED                                  **
771C               **  INTO THE INTERNAL DATAPLOT NAME TABLE.        **
772C               ****************************************************
773C
774      ISTEPN='7.5'
775      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')
776     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
777C
778CCCCC IF(ITER.LE.1)GOTO1720
779      IF(ICOM.EQ.'LOOP')GOTO1720
780      GOTO1760
781C
782 1720 CONTINUE
783C
784      IH=IHPNV(NUMLOE)
785      IH2=IHPNV2(NUMLOE)
786      IF(NUMNAM.LE.0)GOTO1729
787      DO1725J1=1,NUMNAM
788        J12=J1
789        IF(IH.EQ.IHNAME(J1).AND.IH2.EQ.IHNAM2(J1))THEN
790          ILOCPN(NUMLOE)=J12
791          GOTO1760
792        ENDIF
793 1725 CONTINUE
794 1729 CONTINUE
795      IF(NUMNAM.GE.MAXNAM)THEN
796C
797        WRITE(ICOUT,1731)
798 1731   FORMAT('***** ERROR IN LOOP EXECUTION--')
799        CALL DPWRST('XXX','BUG ')
800        WRITE(ICOUT,1732)
801 1732   FORMAT('      THE NUMBER OF DATAPLOT NAMES HAS JUST')
802        CALL DPWRST('XXX','BUG ')
803        WRITE(ICOUT,1734)MAXNAM
804 1734   FORMAT('      EXCEEDED THE ALLOWABLE MAXIMUM OF ',I8)
805        CALL DPWRST('XXX','BUG ')
806        WRITE(ICOUT,1735)
807 1735   FORMAT('      THIS OCCURRED IN ATTEMPTING TO ENTER ')
808        CALL DPWRST('XXX','BUG ')
809        WRITE(ICOUT,1736)IH,IH2
810 1736   FORMAT('      THE PARAMETER NAME ',A4,A4)
811        CALL DPWRST('XXX','BUG ')
812        WRITE(ICOUT,1737)
813 1737   FORMAT('      INTO THE INTERNAL DATAPLOT NAME LIST.')
814        CALL DPWRST('XXX','BUG ')
815        WRITE(ICOUT,1738)
816 1738   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
817        CALL DPWRST('XXX','BUG ')
818        WRITE(ICOUT,1739)(IANS(I),I=1,MIN(100,IWIDTH))
819 1739   FORMAT('      ',100A1)
820        CALL DPWRST('XXX','BUG ')
821        IERROR='YES'
822        GOTO9000
823      ENDIF
824C
825C               ********************************************
826C               **  STEP 7.6--                            **
827C               **  ENTER LOOP PARAMETER VALUE            **
828C               **  INTO PERMANENT INTERNAL DATAPLOT      **
829C               **  NAME TABLE.                           **
830C               **  TREAT THE CASE WHERE COMMAND = LOOP   **
831C               **  AND PARAMETER NAME NOT YET EXIST      **
832C               **  IN GENERAL DATAPLOT NAME TABLE.       **
833C               ********************************************
834C
835      ISTEPN='7.6'
836      IF(ISUBRO.EQ.'LOEX')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
837C
838      NUMNAM=NUMNAM+1
839      J12=NUMNAM
840      ILOCPN(NUMLOE)=J12
841      IHNAME(J12)=IH
842      IHNAM2(J12)=IH2
843      IUSE(J12)='P'
844C
845      VALUE(J12)=PV
846      IVALUE(J12)=INT(PV+0.5)
847CCCCC ADD FOLLOWING LINE FOR DELETE IN LOOP BUG.  FEBRUARY 1994.
848      IN(J12)=1
849      GOTO1780
850C
851C               ****************************************
852C               **  STEP 7.7--                        **
853C               **  ENTER LOOP PARAMETER VALUE        **
854C               **  INTO PERMANENT INTERNAL DATAPLOT  **
855C               **  NAME TABLE.                       **
856C               **  TREAT THE CASE WHERE COMMAND = LOOP*
857C               **  OR COMMAND = END OF LOOP, AND     **
858C               **  PARAMETER NAME ALREADY IN TABLE.  **
859C               ****************************************
860C
861 1760 CONTINUE
862      ISTEPN='7.7'
863      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
864        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
865        WRITE(ICOUT,1761)J12,PV
866 1761   FORMAT('J12,PV = ',I8,E15.7)
867        CALL DPWRST('XXX','BUG ')
868      ENDIF
869C
870CCCCC IF(ITER.GT.N1)GOTO1780
871C
872CCCCC AUGUST 2007: NOTE THAT IF THERE IS A DELETE IN THE
873CCCCC              LOOP, THIS CHANGES THE LOCATION OF THE
874CCCCC              LOOP INDEX PARAMETER IN THE NAME TABLE.
875CCCCC              SO OBTAIN CURRENT POSITION JUST TO BE SURE.
876C
877
878      IH=IHPNV(NUMLOE)
879      IH2=IHPNV2(NUMLOE)
880      DO1775J1=1,NUMNAM
881        J12=J1
882        IF(IH.EQ.IHNAME(J1).AND.IH2.EQ.IHNAM2(J1))THEN
883          ILOCPN(NUMLOE)=J12
884          GOTO1779
885        ENDIF
886 1775 CONTINUE
887      J12=ILOCPN(NUMLOE)
888 1779 CONTINUE
889C
890      VALUE(J12)=PV
891      IVALUE(J12)=INT(PV+0.5)
892CCCCC ADD FOLLOWING LINE FOR DELETE IN LOOP BUG.  FEBRUARY 1994.
893      IN(J12)=1
894C
895C     BUG FIX: WRONG LOOP PARAMETER WAS SET
896C     FOLLOWING 2 LINES MOVED FROM ELSEWHERE IN THE ROUTINE
897C     DR. FILLIBEN FIXED PROBLEM ELSEWHERE 9/87, COMMENT OUT MY
898C     CHANGE.
899C
900      IF(ITER.GT.N1)THEN
901        IF(NUMLOE.GE.1)ILOOIF(NUMLOE)=0
902        NUMLOE=NUMLOE-1
903        NUMENE=NUMENE-1
904      ENDIF
905C  END FIX
906      GOTO1780
907C
908 1780 CONTINUE
909      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
910        WRITE(ICOUT,1781)ITER,N1,J12,PV
911 1781   FORMAT('ITER,N1,J12,PV = ',3I8,E15.7)
912        CALL DPWRST('XXX','BUG ')
913        WRITE(ICOUT,1782)J12,IVALUE(J12),VALUE(J12)
914 1782   FORMAT('J12,IVALUE(J12),VALUE(J12) = ',I8,I8,E15.7)
915        CALL DPWRST('XXX','BUG ')
916        WRITE(ICOUT,1783)NUMLOE
917 1783   FORMAT('NUMLOE = ',I8)
918        CALL DPWRST('XXX','BUG ')
919        WRITE(ICOUT,1784)NUMLOI(1)
920 1784   FORMAT('NUMLOI(1) = ',I8)
921        CALL DPWRST('XXX','BUG ')
922        WRITE(ICOUT,1785)ASTARV(1),AINCV(1),ASTOPV(1)
923 1785   FORMAT('ASTARV(1),AINCV(1),ASTOPV(1) = ',3E15.7)
924        CALL DPWRST('XXX','BUG ')
925      ENDIF
926C
927      GOTO1200
928C
929C               ***********************************************
930C               **  STEP 7.10--                              **
931C               **  THE EXECUTION OF ALL LOOPS IS COMPLETED; **
932C               **  RESET LOOPING VARIABLES.                 **
933C               ***********************************************
934C
935 1800 CONTINUE
936      ILOOST='OFF'
937      ILOOLI=0
938      NUMLIL=0
939      NUMLOE=0
940      NUMENE=0
941C
942      DO1810I=1,10
943        IHPNV(I)='    '
944        IHPNV2(I)='    '
945        ILOCPN(I)=-99
946        ASTARV(I)=-99.0
947        AINCV(I)=-99.0
948        ASTOPV(I)=-99.0
949        NUMLOI(I)=0
950        ILOOIT(I)=0
951        ILOOSP(I)=-99
952        ILOOEP(I)=-99
953 1810 CONTINUE
954C
955      DO1820I=1,25
956        IWIDLL(I)=0
957        DO1830J=1,MAXCIL
958          IANSLO(I,J)='    '
959 1830   CONTINUE
960 1820 CONTINUE
961C
962      GOTO9000
963C
964C
965C               *****************
966C               **  STEP 90--  **
967C               **  EXIT       **
968C               *****************
969C
970 9000 CONTINUE
971      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN
972        WRITE(ICOUT,999)
973        CALL DPWRST('XXX','BUG ')
974        WRITE(ICOUT,9011)
975 9011   FORMAT('***** AT THE END       OF DPLOEX--')
976        CALL DPWRST('XXX','BUG ')
977        WRITE(ICOUT,9012)IBUGLO,IBUGTY,IERROR
978 9012   FORMAT('IBUGLO,IBUGTY,IERROR = ',A4,2X,A4,2X,A4)
979        CALL DPWRST('XXX','BUG ')
980        WRITE(ICOUT,9013)ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE
981 9013   FORMAT('ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE = ',A4,4I8)
982        CALL DPWRST('XXX','BUG ')
983        DO9015I=1,10
984          WRITE(ICOUT,9016)I,IHPNV(I),IHPNV2(I),ILOCPN(I),ILOOSP(I),
985     1                     ILOOEP(I)
986 9016     FORMAT('I,IHPNV(I),IHPNV2(I),ILOCPN(I),ILOOSP(I),',
987     1           'ILOOEP(I) =',I8,2X,A4,2X,A4,I8,I8,I8)
988          CALL DPWRST('XXX','BUG ')
989 9015   CONTINUE
990        WRITE(ICOUT,999)
991        CALL DPWRST('XXX','BUG ')
992        DO9020I=1,10
993          WRITE(ICOUT,9021)I,ASTARV(I),AINCV(I),ASTOPV(I),NUMLOI(I),
994     1                     ILOOIT(I)
995 9021     FORMAT('I,ASTARV(I),AINCV(I),ASTOPV(I),NUMLOI(I),',
996     1           'ILOOIT(I) =',I8,3E15.7,2I8)
997          CALL DPWRST('XXX','BUG ')
998 9020   CONTINUE
999        WRITE(ICOUT,999)
1000        CALL DPWRST('XXX','BUG ')
1001        DO9025I=1,NUMLIL
1002          WRITE(ICOUT,9026)I,IWIDLL(I)
1003 9026     FORMAT('I,IWIDLL(I) = ',I8,I8)
1004          CALL DPWRST('XXX','BUG ')
1005          JMAX=IWIDLL(I)
1006          WRITE(ICOUT,9027)(IANSLO(I,J),J=1,MIN(80,JMAX))
1007 9027     FORMAT('(IANSLO(I,J),J=1,JMAX) = ',80A1)
1008          CALL DPWRST('XXX','BUG ')
1009 9025   CONTINUE
1010        WRITE(ICOUT,999)
1011        CALL DPWRST('XXX','BUG ')
1012        DO9040I=1,NUMNAM
1013          WRITE(ICOUT,9041)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),
1014     1                     VALUE(I)
1015 9041     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),',
1016     1           'VALUE(I) = ',I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
1017          CALL DPWRST('XXX','BUG ')
1018 9040   CONTINUE
1019      ENDIF
1020C
1021      RETURN
1022      END
1023      SUBROUTINE DPLODG(IHARG,IARGT,ARG,NUMARG,
1024     1ALOWDG,IFOUND,IERROR)
1025C
1026C     PURPOSE--DEFINE THE DEGREE (1 FOR LINEAR, 2 FOR QUADRATIC)
1027C              TO BE USED FOR THE LOWESS SMOOTHER.
1028C              THE SPECIFIED LOWESS DEGREE VALUE WILL BE PLACED
1029C              IN THE FLOATING POINT VARIABLE ALOWDG.
1030C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
1031C                     --IARGT  (A  HOLLERITH VECTOR)
1032C                     --ARG    (A  FLOATING POINT VECTOR)
1033C                     --NUMARG (AN INTEGER VARIABLE)
1034C     OUTPUT ARGUMENTS--ALOWDG  (A  FLOATING POINT VARIABLE)
1035C                     --IFOUND ('YES' OR 'NO' )
1036C                     --IERROR ('YES' OR 'NO' )
1037C     WRITTEN BY--JAMES J. FILLIBEN
1038C                 STATISTICAL ENGINEERING DIVISION
1039C                 INFORMATION TECHNOLOGY LABORATORY
1040C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1041C                 Gaithersburg, MD 20899-8980
1042C                 PHONE--301-975-2855
1043C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1044C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1045C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
1046C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
1047C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
1048C     LANGUAGE--ANSI FORTRAN (1977)
1049C     VERSION NUMBER--94/3
1050C     ORIGINAL VERSION--MARCH     1994.
1051C
1052C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1053C
1054      CHARACTER*4 IHARG
1055      CHARACTER*4 IARGT
1056      CHARACTER*4 IFOUND
1057      CHARACTER*4 IERROR
1058C
1059C---------------------------------------------------------------------
1060C
1061      DIMENSION IHARG(*)
1062      DIMENSION IARGT(*)
1063      DIMENSION ARG(*)
1064C
1065C---------------------------------------------------------------------
1066C
1067      INCLUDE 'DPCOP2.INC'
1068C
1069C-----START POINT-----------------------------------------------------
1070C
1071      IFOUND='NO'
1072      IERROR='NO'
1073C
1074      IF(NUMARG.EQ.0)GOTO9000
1075      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO9000
1076      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DEGR')GOTO1110
1077      IF(IHARG(NUMARG).EQ.'?')GOTO8100
1078      GOTO9000
1079C
1080 1110 CONTINUE
1081      IF(IHARG(NUMARG).EQ.'DEGR')GOTO1150
1082      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
1083      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
1084      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
1085      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
1086      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
1087      GOTO1120
1088C
1089 1120 CONTINUE
1090      IERROR='YES'
1091      WRITE(ICOUT,1121)
1092 1121 FORMAT('***** ERROR IN DPLODG--')
1093      CALL DPWRST('XXX','BUG ')
1094      WRITE(ICOUT,1122)
1095 1122 FORMAT('      ILLEGAL FORM FOR LOWESS DEGREE COMMAND.')
1096      CALL DPWRST('XXX','BUG ')
1097      WRITE(ICOUT,1130)
1098 1130 FORMAT('      THE ALLOWABLE FORMS ARE--')
1099      CALL DPWRST('XXX','BUG ')
1100      WRITE(ICOUT,1131)
1101 1131 FORMAT('          LOWESS DEGREE 1 ')
1102      CALL DPWRST('XXX','BUG ')
1103      WRITE(ICOUT,1132)
1104 1132 FORMAT('          LOWESS DEGREE 2 ')
1105      CALL DPWRST('XXX','BUG ')
1106      WRITE(ICOUT,1135)
1107 1135 FORMAT('      THE DEFAULT DEGREE IS 1 (= LINEAR LOWESS)')
1108      CALL DPWRST('XXX','BUG ')
1109      GOTO9000
1110C
1111 1150 CONTINUE
1112      HOLD=1.0
1113      GOTO1180
1114C
1115 1160 CONTINUE
1116      HOLD=ARG(NUMARG)
1117      IF(HOLD.LE.1.5)HOLD=1.0
1118      IF(HOLD.GT.1.5)HOLD=2.0
1119      GOTO1180
1120C
1121 1180 CONTINUE
1122      IFOUND='YES'
1123      ALOWDG=HOLD
1124C
1125      IF(IFEEDB.EQ.'OFF')GOTO1289
1126      WRITE(ICOUT,999)
1127  999 FORMAT(1X)
1128      CALL DPWRST('XXX','BUG ')
1129      WRITE(ICOUT,1281)ALOWDG
1130 1281 FORMAT('THE LOWESS DEGREE HAS JUST BEEN SET ',
1131     1'TO ',F10.4)
1132 1289 CONTINUE
1133      GOTO9000
1134C
1135C               ********************************************
1136C               **  STEP 81--                             **
1137C               **  TREAT THE    ?    CASE--              **
1138C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
1139C               ********************************************
1140C
1141 8100 CONTINUE
1142      IFOUND='YES'
1143      WRITE(ICOUT,999)
1144      CALL DPWRST('XXX','BUG ')
1145      WRITE(ICOUT,8111)ALOWDG
1146 8111 FORMAT('THE CURRENT LOWESS DEGREE    IS ',F10.4)
1147      CALL DPWRST('XXX','BUG ')
1148      WRITE(ICOUT,999)
1149      CALL DPWRST('XXX','BUG ')
1150      WRITE(ICOUT,8121)
1151 8121 FORMAT('THE DEFAULT LOWESS DEGREE    IS 1.0')
1152      CALL DPWRST('XXX','BUG ')
1153      GOTO9000
1154C
1155 9000 CONTINUE
1156      RETURN
1157      END
1158      SUBROUTINE DPLOFR(IHARG,IARGT,ARG,NUMARG,
1159     1ALOWFR,IFOUND,IERROR)
1160C
1161C     PURPOSE--DEFINE THE FRACTION (0.0 TO 1.0).
1162C              TO BE USED FOR THE LOWESS SMOOTHER.
1163C              THE SPECIFIED LOWESS FRACTION VALUE WILL BE PLACED
1164C              IN THE FLOATING POINT VARIABLE ALOWFR.
1165C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
1166C                     --IARGT  (A  HOLLERITH VECTOR)
1167C                     --ARG    (A  FLOATING POINT VECTOR)
1168C                     --NUMARG (AN INTEGER VARIABLE)
1169C     OUTPUT ARGUMENTS--ALOWFR  (A  FLOATING POINT VARIABLE)
1170C                     --IFOUND ('YES' OR 'NO' )
1171C                     --IERROR ('YES' OR 'NO' )
1172C     WRITTEN BY--JAMES J. FILLIBEN
1173C                 STATISTICAL ENGINEERING DIVISION
1174C                 INFORMATION TECHNOLOGY LABORATORY
1175C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1176C                 Gaithersburg, MD 20899-8980
1177C                 PHONE--301-975-2855
1178C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1179C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1180C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
1181C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
1182C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
1183C     LANGUAGE--ANSI FORTRAN (1977)
1184C     VERSION NUMBER--89/1
1185C     ORIGINAL VERSION--DECEMBER 1988.
1186C     UPDATED         --NOVEMBER  1989.  CHECK LOWESS FRACTION 0 TO 1
1187C     UPDATED         --NOVEMBER  1989.  LOWESS FRACTION DEFAULT TO .1
1188C
1189C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1190C
1191      CHARACTER*4 IHARG
1192      CHARACTER*4 IARGT
1193      CHARACTER*4 IFOUND
1194      CHARACTER*4 IERROR
1195C
1196C---------------------------------------------------------------------
1197C
1198      DIMENSION IHARG(*)
1199      DIMENSION IARGT(*)
1200      DIMENSION ARG(*)
1201C
1202C---------------------------------------------------------------------
1203C
1204      INCLUDE 'DPCOP2.INC'
1205C
1206C-----START POINT-----------------------------------------------------
1207C
1208      IFOUND='NO'
1209      IERROR='NO'
1210C
1211      IF(NUMARG.EQ.0)GOTO9000
1212      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO9000
1213      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FRAC')GOTO1110
1214      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO1110
1215      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PROP')GOTO1110
1216      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PERC')GOTO1110
1217      IF(IHARG(NUMARG).EQ.'?')GOTO8100
1218      GOTO9000
1219C
1220 1110 CONTINUE
1221      IF(IHARG(NUMARG).EQ.'FRAC')GOTO1150
1222      IF(IHARG(NUMARG).EQ.'DECI')GOTO1150
1223      IF(IHARG(NUMARG).EQ.'PROP')GOTO1150
1224      IF(IHARG(NUMARG).EQ.'PERC')GOTO1150
1225      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
1226      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
1227      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
1228      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
1229      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
1230      GOTO1120
1231C
1232 1120 CONTINUE
1233      IERROR='YES'
1234      WRITE(ICOUT,1121)
1235 1121 FORMAT('***** ERROR IN DPLOFR--')
1236      CALL DPWRST('XXX','BUG ')
1237      WRITE(ICOUT,1122)
1238 1122 FORMAT('      ILLEGAL FORM FOR LOWESS FRACTION/',
1239     1'DECIMAL/PROPORTION/PERCENTAGE COMMAND.')
1240      CALL DPWRST('XXX','BUG ')
1241      WRITE(ICOUT,1124)
1242 1124 FORMAT('      EXAMPLE TO DEMONSTRATE THE ',
1243     1'PROPER FORM--')
1244      CALL DPWRST('XXX','BUG ')
1245      WRITE(ICOUT,1125)
1246 1125 FORMAT('      SUPPOSE THE THE ANALYST IS CARRYING OUT  ')
1247      CALL DPWRST('XXX','BUG ')
1248      WRITE(ICOUT,1126)
1249 1126 FORMAT('      A LOWESS SMOOTH, ')
1250      CALL DPWRST('XXX','BUG ')
1251      WRITE(ICOUT,1127)
1252 1127 FORMAT('      AND SUPPOSE THE ANALYST WISHES THE')
1253      CALL DPWRST('XXX','BUG ')
1254      WRITE(ICOUT,1128)
1255 1128 FORMAT('      SMOOTHING WINDOW TO BE 20% OF THE X-WIDTH')
1256      CALL DPWRST('XXX','BUG ')
1257      WRITE(ICOUT,1130)
1258 1130 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
1259      CALL DPWRST('XXX','BUG ')
1260      WRITE(ICOUT,1131)
1261 1131 FORMAT('          LOWESS FRACTION .2 ')
1262      CALL DPWRST('XXX','BUG ')
1263      WRITE(ICOUT,1132)
1264 1132 FORMAT('          LOWESS DECIMAL .2 ')
1265      CALL DPWRST('XXX','BUG ')
1266      WRITE(ICOUT,1133)
1267 1133 FORMAT('          LOWESS PROPORTION 20 ')
1268      CALL DPWRST('XXX','BUG ')
1269      WRITE(ICOUT,1134)
1270 1134 FORMAT('          LOWESS PERCENTAGE 20 ')
1271      CALL DPWRST('XXX','BUG ')
1272      WRITE(ICOUT,1135)
1273 1135 FORMAT('      THE DEFAULT FRACTION IS .5 (= 50%)')
1274      CALL DPWRST('XXX','BUG ')
1275      GOTO9000
1276C
1277 1150 CONTINUE
1278CCCCC THE FOLLOWING LINE WAS CHANGED NOVEMBER 1989
1279CCCCC HOLD=.5
1280      HOLD=.1
1281      GOTO1180
1282C
1283 1160 CONTINUE
1284      HOLD=ARG(NUMARG)
1285      IF(IHARG(1).EQ.'PROP')HOLD=HOLD/100.0
1286      IF(IHARG(1).EQ.'PERC')HOLD=HOLD/100.0
1287      GOTO1180
1288C
1289 1180 CONTINUE
1290      IFOUND='YES'
1291      ALOWFR=HOLD
1292CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
1293      ALOWPR=100.0*ALOWFR
1294C
1295CCCCC THE FOLLOWING SECTION WAS INSERTED NOVEMBER 1989
1296C               **************************************************
1297C               **  CHECK THAT THE LOWESS FRACTION              **
1298C               **  IS BETWEEN 0 AND 1 (EXCLUSIVELY)            **
1299C               **************************************************
1300C
1301      IF(IHARG(1).EQ.'FRAC')GOTO1210
1302      IF(IHARG(1).EQ.'DECI')GOTO1210
1303      GOTO1229
1304 1210 CONTINUE
1305      IF(ALOWFR.GT.0.0.AND.ALOWFR.LE.1.0)GOTO1229
1306      WRITE(ICOUT,999)
1307      CALL DPWRST('XXX','BUG ')
1308      WRITE(ICOUT,1211)
1309 1211 FORMAT('***** ERROR IN DPLOFR--')
1310      CALL DPWRST('XXX','BUG ')
1311      WRITE(ICOUT,1212)
1312 1212 FORMAT('      ILLEGAL INPUT VALUE FOR THE LOWESS FRACTION.')
1313      CALL DPWRST('XXX','BUG ')
1314      WRITE(ICOUT,1213)
1315 1213 FORMAT('      THE LOWESS FRACTION (INDICATING THE SIZE')
1316      CALL DPWRST('XXX','BUG ')
1317      WRITE(ICOUT,1214)
1318 1214 FORMAT('      OF THE LOWESS NEIGHBORHOOD)')
1319      CALL DPWRST('XXX','BUG ')
1320      WRITE(ICOUT,1215)
1321 1215 FORMAT('      MUST BE LARGER THAN 0.0 AND SMALLER THAN 1.0.')
1322      CALL DPWRST('XXX','BUG ')
1323      WRITE(ICOUT,1216)
1324 1216 FORMAT('      SUCH WAS NOT THE CASE HERE.')
1325      CALL DPWRST('XXX','BUG ')
1326      WRITE(ICOUT,1217)ALOWFR
1327 1217 FORMAT('      THE VALUE OF THE LOWESS FRACTION = ',E15.7)
1328      CALL DPWRST('XXX','BUG ')
1329      WRITE(ICOUT,1218)
1330 1218 FORMAT('      CORRECT THIS VALUE VIA THE    LOWESS FRACTION ')
1331      CALL DPWRST('XXX','BUG ')
1332      WRITE(ICOUT,1219)
1333 1219 FORMAT('      COMMAND, AS IN      LOWESS FRACTION .5')
1334      CALL DPWRST('XXX','BUG ')
1335      IERROR='YES'
1336      GOTO9000
1337 1229 CONTINUE
1338C
1339      IF(IHARG(1).EQ.'PROP')GOTO1230
1340      IF(IHARG(1).EQ.'PERC')GOTO1230
1341      GOTO1249
1342 1230 CONTINUE
1343      IF(ALOWPR.GT.0.0.AND.ALOWPR.LE.100.0)GOTO1249
1344      WRITE(ICOUT,999)
1345      CALL DPWRST('XXX','BUG ')
1346      WRITE(ICOUT,1231)
1347 1231 FORMAT('***** ERROR IN DPLOFR--')
1348      CALL DPWRST('XXX','BUG ')
1349      WRITE(ICOUT,1232)
1350 1232 FORMAT('      ILLEGAL INPUT VALUE FOR THE LOWESS PROPORTION.')
1351      CALL DPWRST('XXX','BUG ')
1352      WRITE(ICOUT,1233)
1353 1233 FORMAT('      THE LOWESS PROPORTION (INDICATING THE SIZE')
1354      CALL DPWRST('XXX','BUG ')
1355      WRITE(ICOUT,1234)
1356 1234 FORMAT('      OF THE LOWESS NEIGHBORHOOD)')
1357      CALL DPWRST('XXX','BUG ')
1358      WRITE(ICOUT,1235)
1359 1235 FORMAT('      MUST BE LARGER THAN 0 AND SMALLER THAN 100.')
1360      CALL DPWRST('XXX','BUG ')
1361      WRITE(ICOUT,1236)
1362 1236 FORMAT('      SUCH WAS NOT THE CASE HERE.')
1363      CALL DPWRST('XXX','BUG ')
1364      WRITE(ICOUT,1237)ALOWPR
1365 1237 FORMAT('      THE VALUE OF THE LOWESS PROPORTION = ',E15.7)
1366      CALL DPWRST('XXX','BUG ')
1367      WRITE(ICOUT,1238)
1368 1238 FORMAT('      CORRECT THIS VALUE VIA THE  LOWESS PROPORTION ')
1369      CALL DPWRST('XXX','BUG ')
1370      WRITE(ICOUT,1239)
1371 1239 FORMAT('      COMMAND, AS IN      LOWESS PROPORTION 50')
1372      CALL DPWRST('XXX','BUG ')
1373      IERROR='YES'
1374      GOTO9000
1375 1249 CONTINUE
1376C
1377      IF(IFEEDB.EQ.'OFF')GOTO1289
1378      WRITE(ICOUT,999)
1379  999 FORMAT(1X)
1380      CALL DPWRST('XXX','BUG ')
1381      IF(IHARG(1).EQ.'FRAC'.OR.IHARG(1).EQ.'DECI')
1382     1WRITE(ICOUT,1281)ALOWFR
1383 1281 FORMAT('THE LOWESS FRACTION (0.0 TO 1.0) HAS JUST BEEN SET ',
1384     1'TO ',F10.4)
1385      IF(IHARG(1).EQ.'FRAC'.OR.IHARG(1).EQ.'DECI')
1386     1CALL DPWRST('XXX','BUG ')
1387CCCCC THE FOLLOWING 4 LINES WERE INSERTED NOVEMBER 1989
1388      IF(IHARG(1).EQ.'PROP'.OR.IHARG(1).EQ.'PERC')
1389     1WRITE(ICOUT,1282)ALOWPR
1390 1282 FORMAT('THE LOWESS PROPORTION (0 TO 100) HAS JUST BEEN SET ',
1391     1'TO ',F10.4)
1392      IF(IHARG(1).EQ.'PROP'.OR.IHARG(1).EQ.'PERC')
1393     1CALL DPWRST('XXX','BUG ')
1394 1289 CONTINUE
1395      GOTO9000
1396C
1397C               ********************************************
1398C               **  STEP 81--                             **
1399C               **  TREAT THE    ?    CASE--              **
1400C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
1401C               ********************************************
1402C
1403 8100 CONTINUE
1404      IFOUND='YES'
1405      WRITE(ICOUT,999)
1406      CALL DPWRST('XXX','BUG ')
1407      WRITE(ICOUT,8111)ALOWFR
1408 8111 FORMAT('THE CURRENT LOWESS FRACTION    IS ',F10.4)
1409      CALL DPWRST('XXX','BUG ')
1410      ALOWPR=100.0*ALOWFR
1411      WRITE(ICOUT,8112)ALOWPR
1412 8112 FORMAT('THE CURRENT LOWESS PROPORTION  IS ',F10.4,' %')
1413      WRITE(ICOUT,999)
1414      CALL DPWRST('XXX','BUG ')
1415      WRITE(ICOUT,8121)
1416 8121 FORMAT('THE DEFAULT LOWESS FRACTION    IS 0.1')
1417      CALL DPWRST('XXX','BUG ')
1418      WRITE(ICOUT,8122)
1419 8122 FORMAT('THE DEFAULT LOWESS PROPORTION  IS 10 %')
1420      GOTO9000
1421C
1422 9000 CONTINUE
1423      RETURN
1424      END
1425      SUBROUTINE DPLORE(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
1426     1                  ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
1427C
1428C     PURPOSE--GENERATE A LORENZ PLOT.
1429C     WRITTEN BY--ALAN HECKERT
1430C                 STATISTICAL ENGINEERING DIVISION
1431C                 INFORMATION TECHNOLOGY LABORATORY
1432C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1433C                 GAITHERSBURG, MD 20899-8980
1434C                 PHONE--301-975-2899
1435C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1436C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1437C     LANGUAGE--ANSI FORTRAN (1977)
1438C     VERSION NUMBER--2015/2
1439C     ORIGINAL VERSION--FEBRUARY  2015.
1440C
1441C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
1442C
1443      CHARACTER*4 ICASPL
1444      CHARACTER*4 IAND1
1445      CHARACTER*4 IAND2
1446      CHARACTER*4 ISUBRO
1447      CHARACTER*4 IBUGG2
1448      CHARACTER*4 IBUGG3
1449      CHARACTER*4 IBUGQ
1450      CHARACTER*4 IFOUND
1451      CHARACTER*4 IFOUN1
1452      CHARACTER*4 IFOUN2
1453      CHARACTER*4 IERROR
1454C
1455      CHARACTER*4 ICASE
1456      CHARACTER*4 IH
1457      CHARACTER*4 IH2
1458      CHARACTER*4 ISUBN1
1459      CHARACTER*4 ISUBN2
1460      CHARACTER*4 ISTEPN
1461      CHARACTER*4 ISUBN0
1462C
1463C---------------------------------------------------------------------
1464C
1465      INCLUDE 'DPCOPA.INC'
1466C
1467      DIMENSION Y1(MAXOBV)
1468      DIMENSION ZY(MAXOBV)
1469      DIMENSION XIDTEM(MAXOBV)
1470      DIMENSION XIDTE2(MAXOBV)
1471      DIMENSION XIDTE3(MAXOBV)
1472      DIMENSION XTEMP1(MAXOBV)
1473      DIMENSION XTEMP2(MAXOBV)
1474      DIMENSION XDESGN(MAXOBV,2)
1475C
1476      INCLUDE 'DPCOZZ.INC'
1477C
1478      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
1479      EQUIVALENCE (GARBAG(IGARB2),ZY(1))
1480      EQUIVALENCE (GARBAG(IGARB3),XTEMP1(1))
1481      EQUIVALENCE (GARBAG(IGARB4),XTEMP2(1))
1482      EQUIVALENCE (GARBAG(IGARB5),XIDTEM(1))
1483      EQUIVALENCE (GARBAG(IGARB6),XIDTE2(1))
1484      EQUIVALENCE (GARBAG(IGARB7),XIDTE3(1))
1485      EQUIVALENCE (GARBAG(IGARB8),XDESGN(1,1))
1486C
1487      CHARACTER*4 IREPL
1488      CHARACTER*4 IMULT
1489C
1490      CHARACTER*40 INAME
1491      PARAMETER (MAXSPN=30)
1492      CHARACTER*4 IVARN1(MAXSPN)
1493      CHARACTER*4 IVARN2(MAXSPN)
1494      CHARACTER*4 IVARTY(MAXSPN)
1495      REAL PVAR(MAXSPN)
1496      INTEGER ILIS(MAXSPN)
1497      INTEGER NRIGHT(MAXSPN)
1498      INTEGER ICOLR(MAXSPN)
1499C
1500C-----COMMON----------------------------------------------------------
1501C
1502      INCLUDE 'DPCOHK.INC'
1503      INCLUDE 'DPCOHO.INC'
1504      INCLUDE 'DPCODA.INC'
1505      INCLUDE 'DPCOP2.INC'
1506C
1507C-----START POINT-----------------------------------------------------
1508C
1509      IFOUND='NO'
1510      IERROR='NO'
1511      ISUBN1='DPLO'
1512      ISUBN2='RE  '
1513C
1514      MAXCP1=MAXCOL+1
1515      MAXCP2=MAXCOL+2
1516      MAXCP3=MAXCOL+3
1517      MAXCP4=MAXCOL+4
1518      MAXCP5=MAXCOL+5
1519      MAXCP6=MAXCOL+6
1520      MAXV2=1
1521      MINN2=5
1522C
1523C               ***************************************************
1524C               **  TREAT THE LORENZ PLOT                        **
1525C               ***************************************************
1526C
1527      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')THEN
1528        WRITE(ICOUT,999)
1529  999   FORMAT(1X)
1530        CALL DPWRST('XXX','BUG ')
1531        WRITE(ICOUT,51)
1532   51   FORMAT('***** AT THE BEGINNING OF DPLORE--')
1533        CALL DPWRST('XXX','BUG ')
1534        WRITE(ICOUT,52)ICASPL,IAND1,IAND2
1535   52   FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
1536        CALL DPWRST('XXX','BUG ')
1537        WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
1538   53   FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
1539        CALL DPWRST('XXX','BUG ')
1540      ENDIF
1541C
1542C               ******************************************************
1543C               **  STEP 1--                                        **
1544C               **  EXTRACT THE COMMAND                             **
1545C               **  LOOK FOR ONE OF THE FOLLOWING COMMANDS:         **
1546C               **    1) LORENZ PLOT Y                              **
1547C               **    2) MULTIPLE LORENZ PLOT Y1 ... YK             **
1548C               **    3) REPLICATED LORENZ PLOT Y X1  X2            **
1549C               ******************************************************
1550C
1551      ISTEPN='1'
1552      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')
1553     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1554C
1555      IF(ICOM.EQ.'LORE')GOTO89
1556      IF(ICOM.EQ.'MULT')GOTO89
1557      IF(ICOM.EQ.'REPL')GOTO89
1558      GOTO9000
1559C
1560   89 CONTINUE
1561      ICASPL='LORE'
1562      IMULT='OFF'
1563      IREPL='OFF'
1564      ILASTC=-9999
1565C
1566      IF(ICOM.EQ.'LORE')THEN
1567        IFOUN1='YES'
1568      ELSEIF(ICOM.EQ.'MULT')THEN
1569        IMULT='ON'
1570      ELSEIF(ICOM.EQ.'REPL')THEN
1571        IREPL='ON'
1572      ENDIF
1573C
1574      ISTOP=NUMARG-1
1575      DO90I=1,NUMARG
1576        IF(IHARG(I).EQ.'PLOT' .OR. IHARG(I).EQ.'CURV')THEN
1577          ISTOP=I
1578          GOTO99
1579        ENDIF
1580   90 CONTINUE
1581   99 CONTINUE
1582C
1583      IFOUND='NO'
1584      DO100I=1,ISTOP
1585        IF(IHARG(I).EQ.'=')THEN
1586          IFOUND='NO'
1587          GOTO9000
1588        ELSEIF(IHARG(I).EQ.'LORE')THEN
1589          IFOUN1='YES'
1590          IFOUN2='YES'
1591          ILASTC=MAX(ILASTC,I)
1592        ELSEIF(IHARG(I).EQ.'PLOT' .OR. IHARG(I).EQ.'CURV')THEN
1593          IFOUN2='YES'
1594          ILASTC=MAX(ILASTC,I)
1595        ELSEIF(IHARG(I).EQ.'REPL')THEN
1596          IREPL='ON'
1597        ELSEIF(IHARG(I).EQ.'MULT')THEN
1598          IMULT='ON'
1599        ENDIF
1600  100 CONTINUE
1601C
1602      IF(IFOUN1.EQ.'YES' .AND. IFOUN2.EQ.'YES')IFOUND='YES'
1603      IF(IFOUND.EQ.'NO')GOTO9000
1604C
1605      IF(IMULT.EQ.'ON')THEN
1606        IF(IREPL.EQ.'ON')THEN
1607          WRITE(ICOUT,999)
1608          CALL DPWRST('XXX','BUG ')
1609          WRITE(ICOUT,101)
1610  101     FORMAT('***** ERROR IN LORENZ PLOT--')
1611          CALL DPWRST('XXX','BUG ')
1612          WRITE(ICOUT,102)
1613  102     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
1614     1           '"REPLICATION" FOR THE LORENZ PLOT.')
1615          CALL DPWRST('XXX','BUG ')
1616          IERROR='YES'
1617          GOTO9000
1618        ENDIF
1619      ENDIF
1620C
1621      IF(ILASTC.GE.1)THEN
1622        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
1623        ILASTC=0
1624      ENDIF
1625C
1626      IF(IBUGG2.EQ.'ON' .OR. ISUBRO.EQ.'LORE')THEN
1627        WRITE(ICOUT,112)ICASPL,IMULT,IREPL
1628  112   FORMAT('ICASPL,IMULT,IREPL = ',2(A4,2X),A4)
1629        CALL DPWRST('XXX','BUG ')
1630      ENDIF
1631C
1632C               ****************************************
1633C               **  STEP 2--                          **
1634C               **  EXTRACT THE VARIABLE LIST         **
1635C               ****************************************
1636C
1637      ISTEPN='2'
1638      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')
1639     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1640C
1641      INAME='LORENZ PLOT'
1642      MINNA=1
1643      MAXNA=100
1644      MINN2=1
1645      IFLAGE=1
1646      IF(IMULT.EQ.'ON')IFLAGE=0
1647      IFLAGM=1
1648      IFLAGP=0
1649      JMIN=1
1650      JMAX=NUMARG
1651      MINNVA=1
1652      MAXNVA=3
1653      IF(IREPL.EQ.'ON')THEN
1654        MINNVA=2
1655        MAXNVA=3
1656        IFLAGM=0
1657      ELSEIF(IMULT.EQ.'ON')THEN
1658        MINNVA=1
1659        MAXNVA=30
1660      ENDIF
1661C
1662      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
1663     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
1664     1            JMIN,JMAX,
1665     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
1666     1            IVARN1,IVARN2,IVARTY,PVAR,
1667     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
1668     1            MINNVA,MAXNVA,
1669     1            IFLAGM,IFLAGP,
1670     1            IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
1671      IF(IERROR.EQ.'YES')GOTO9000
1672C
1673      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')THEN
1674        WRITE(ICOUT,999)
1675        CALL DPWRST('XXX','BUG ')
1676        WRITE(ICOUT,281)
1677  281   FORMAT('***** AFTER CALL DPPARS--')
1678        CALL DPWRST('XXX','BUG ')
1679        WRITE(ICOUT,282)NQ,NUMVAR
1680  282   FORMAT('NQ,NUMVAR = ',2I8)
1681        CALL DPWRST('XXX','BUG ')
1682        IF(NUMVAR.GT.0)THEN
1683          DO285I=1,NUMVAR
1684            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
1685     1                      ICOLR(I)
1686  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
1687     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
1688            CALL DPWRST('XXX','BUG ')
1689  285     CONTINUE
1690        ENDIF
1691      ENDIF
1692C
1693      NRESP=0
1694      NREPL=0
1695      IF(IREPL.EQ.'OFF' .AND. NUMVAR.GT.1)IMULT='ON'
1696      IF(IMULT.EQ.'ON')THEN
1697        NRESP=NUMVAR
1698      ELSEIF(IREPL.EQ.'ON')THEN
1699        NRESP=1
1700        NREPL=NUMVAR-NRESP
1701        IF(NREPL.LT.1 .OR. NREPL.GT.2)THEN
1702          WRITE(ICOUT,999)
1703          CALL DPWRST('XXX','BUG ')
1704          WRITE(ICOUT,101)
1705          CALL DPWRST('XXX','BUG ')
1706          WRITE(ICOUT,511)
1707  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
1708     1           'REPLICATION VARIABLES')
1709          CALL DPWRST('XXX','BUG ')
1710          WRITE(ICOUT,512)
1711  512     FORMAT('      MUST BE BETWEEN 1 AND 2;  SUCH WAS NOT THE ',
1712     1           'CASE HERE.')
1713          CALL DPWRST('XXX','BUG ')
1714          WRITE(ICOUT,513)NREPL
1715  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
1716          CALL DPWRST('XXX','BUG ')
1717          IERROR='YES'
1718          GOTO9000
1719        ENDIF
1720      ELSE
1721        NRESP=1
1722      ENDIF
1723C
1724C               ********************************************
1725C               **  STEP 6--                              **
1726C               **  GENERATE THE LORENZ PLOTS FOR         **
1727C               **  THE VARIOUS CASES.                    **
1728C               ********************************************
1729C
1730      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')THEN
1731        ISTEPN='6'
1732        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1733        WRITE(ICOUT,601)NRESP,NREPL
1734  601   FORMAT('NRESP,NREPL = ',2I5)
1735        CALL DPWRST('XXX','BUG ')
1736      ENDIF
1737C
1738C     INCLUDE A LINE BETWEEN (0,0) AND (1,1) FOR ALL CASES
1739C
1740      Y(1)=0.0
1741      X(1)=0.0
1742      D(1)=1.0
1743      Y(2)=1.0
1744      X(2)=1.0
1745      D(2)=1.0
1746      NCURVE=1
1747      NPLOTP=2
1748C
1749C               *************************************************
1750C               **  STEP 7A--                                  **
1751C               **  CASE 1: NO REPLICATION CASE                **
1752C               *************************************************
1753C
1754      IF(NREPL.EQ.0)THEN
1755C
1756        ISTEPN='7A'
1757        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')
1758     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1759C
1760C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
1761C
1762        DO810IRESP=1,NRESP
1763          NCURVE=NCURVE+1
1764C
1765          IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')THEN
1766            WRITE(ICOUT,999)
1767            CALL DPWRST('XXX','BUG ')
1768            WRITE(ICOUT,811)IRESP,NCURVE
1769  811       FORMAT('IRESP,NCURVE = ',2I5)
1770            CALL DPWRST('XXX','BUG ')
1771          ENDIF
1772C
1773          ICOL=IRESP
1774          NUMVA2=1
1775          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
1776     1                INAME,IVARN1,IVARN2,IVARTY,
1777     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
1778     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
1779     1                MAXCP4,MAXCP5,MAXCP6,
1780     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
1781     1                Y1,Y1,Y1,NLOCAL,NLOCA2,NLOCA3,ICASE,
1782     1                IBUGG3,ISUBRO,IFOUND,IERROR)
1783          IF(IERROR.EQ.'YES')GOTO9000
1784C
1785C               *****************************************************
1786C               **  STEP 8B--                                      **
1787C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
1788C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
1789C               *****************************************************
1790C
1791          CALL DPLOR2(Y1,NLOCAL,NCURVE,ICASPL,MINN2,GINI,
1792     1                Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
1793C
1794          IH='GINI'
1795          IF(NRESP.EQ.1)THEN
1796            IH2='    '
1797          ELSE
1798            IF(IRESP.LE.9)THEN
1799              IH2='    '
1800              WRITE(IH2(1:1),'(I1)')IRESP
1801            ELSE
1802              WRITE(IH2(1:2),'(I2)')IRESP
1803            ENDIF
1804          ENDIF
1805          VALUE0=GINI
1806          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
1807     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
1808     1                IANS,IWIDTH,IBUGG3,IERROR)
1809C
1810  810   CONTINUE
1811C
1812C               *****************************************************
1813C               **  STEP 9A--                                      **
1814C               **  CASE 3: ONE OR TWO  REPLICATION VARIABLES.     **
1815C               **          FOR THIS CASE, THE NUMBER OF RESPONSE  **
1816C               **          VARIABLES MUST BE EXACTLY 1.           **
1817C               *****************************************************
1818C
1819      ELSEIF(NRESP.EQ.1 .AND. NREPL.GE.1)THEN
1820        ISTEPN='9A'
1821        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')
1822     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1823C
1824        J=0
1825        IMAX=NRIGHT(1)
1826        IF(NQ.LT.NRIGHT(1))IMAX=NQ
1827        DO910I=1,IMAX
1828          IF(ISUB(I).EQ.0)GOTO910
1829          J=J+1
1830C
1831C         RESPONSE VARIABLE IN Y1
1832C
1833          IJ=MAXN*(ICOLR(1)-1)+I
1834          IF(ICOLR(1).LE.MAXCOL)Y1(J)=V(IJ)
1835          IF(ICOLR(1).EQ.MAXCP1)Y1(J)=PRED(I)
1836          IF(ICOLR(1).EQ.MAXCP2)Y1(J)=RES(I)
1837          IF(ICOLR(1).EQ.MAXCP3)Y1(J)=YPLOT(I)
1838          IF(ICOLR(1).EQ.MAXCP4)Y1(J)=XPLOT(I)
1839          IF(ICOLR(1).EQ.MAXCP5)Y1(J)=X2PLOT(I)
1840          IF(ICOLR(1).EQ.MAXCP6)Y1(J)=TAGPLO(I)
1841C
1842          ICOLC=1
1843          DO920IR=1,MIN(NREPL,2)
1844            ICOLC=ICOLC+1
1845            ICOLT=ICOLR(ICOLC)
1846            IJ=MAXN*(ICOLT-1)+I
1847            IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
1848            IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
1849            IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
1850            IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
1851            IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
1852            IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
1853            IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
1854  920     CONTINUE
1855C
1856  910   CONTINUE
1857        NLOCAL=J
1858C
1859C       *****************************************************
1860C       **  STEP 9B--                                      **
1861C       **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
1862C       **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
1863C       **                                                 **
1864C       **  FOR THIS CASE, WE NEED TO LOOP THROUGH THE     **
1865C       **  VARIOUS REPLICATIONS.                          **
1866C       *****************************************************
1867C
1868        ISTEPN='9B'
1869        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')THEN
1870          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1871          WRITE(ICOUT,999)
1872          CALL DPWRST('XXX','BUG ')
1873          WRITE(ICOUT,931)
1874  931     FORMAT('***** FROM THE MIDDLE  OF FREQ--')
1875          CALL DPWRST('XXX','BUG ')
1876          WRITE(ICOUT,932)ICASPL,NUMVAR,NLOCAL
1877  932     FORMAT('ICASPL,NUMVAR,NQ = ',A4,2I8)
1878          CALL DPWRST('XXX','BUG ')
1879          IF(NLOCAL.GE.1)THEN
1880            DO935I=1,NLOCAL
1881              WRITE(ICOUT,936)I,Y1(I),XDESGN(I,1),XDESGN(I,2)
1882  936         FORMAT('I,Y1(I),XDESGN(I,1),XDESGN(I,2) = ',I8,3F12.5)
1883              CALL DPWRST('XXX','BUG ')
1884  935       CONTINUE
1885          ENDIF
1886        ENDIF
1887C
1888C       *****************************************************
1889C       **  STEP 9C--                                      **
1890C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
1891C       **  REPLICATION VARIABLES.                         **
1892C       *****************************************************
1893C
1894        CALL DPFRE5(XDESGN(1,1),XDESGN(1,2),
1895     1             NREPL,NLOCAL,MAXOBV,
1896     1             XIDTEM,XIDTE2,
1897     1             XTEMP1,XTEMP2,
1898     1             NUMSE1,NUMSE2,
1899     1             IBUGG3,ISUBRO,IERROR)
1900C
1901C       *****************************************************
1902C       **  STEP 9D--                                      **
1903C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
1904C       *****************************************************
1905C
1906        IF(NREPL.EQ.1)THEN
1907          J=0
1908          DO1110ISET1=1,NUMSE1
1909            K=0
1910            DO1130I=1,NLOCAL
1911              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
1912                K=K+1
1913                ZY(K)=Y1(I)
1914              ENDIF
1915 1130       CONTINUE
1916            NTEMP=K
1917            NCURVE=NCURVE+1
1918            IF(NTEMP.GT.0)THEN
1919              CALL DPLOR2(ZY,NTEMP,NCURVE,ICASPL,MINN2,GINI,
1920     1                    Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
1921              IH='GINI'
1922              IF(NCURVE.LE.10)THEN
1923                IH2='    '
1924                WRITE(IH2(1:1),'(I1)')NCURVE-1
1925              ELSE
1926                WRITE(IH2(1:2),'(I2)')NCURVE-1
1927              ENDIF
1928              VALUE0=GINI
1929              CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
1930     1                    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
1931     1                    IANS,IWIDTH,IBUGG3,IERROR)
1932C
1933            ENDIF
1934 1110     CONTINUE
1935        ELSEIF(NREPL.EQ.2)THEN
1936          J=0
1937          NTOT=NUMSE1*NUMSE2
1938          DO1210ISET1=1,NUMSE1
1939          DO1220ISET2=1,NUMSE2
1940            K=0
1941            DO1290I=1,NLOCAL
1942              IF(
1943     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
1944     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
1945     1          )THEN
1946                K=K+1
1947                ZY(K)=Y1(I)
1948              ENDIF
1949 1290       CONTINUE
1950            NTEMP=K
1951            NCURVE=NCURVE+1
1952            IF(NTEMP.GT.0)THEN
1953              CALL DPLOR2(ZY,NTEMP,NCURVE,ICASPL,MINN2,GINI,
1954     1                    Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
1955C
1956              IH='GINI'
1957              IF(NCURVE.LE.10)THEN
1958                IH2='    '
1959                WRITE(IH2(1:1),'(I1)')NCURVE-1
1960              ELSE
1961                WRITE(IH2(1:2),'(I2)')NCURVE-1
1962              ENDIF
1963              VALUE0=GINI
1964              CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
1965     1                    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
1966     1                    IANS,IWIDTH,IBUGG3,IERROR)
1967C
1968            ENDIF
1969 1220     CONTINUE
1970 1210     CONTINUE
1971        ENDIF
1972      ENDIF
1973C
1974C               *****************
1975C               **  STEP 90--  **
1976C               **  EXIT       **
1977C               *****************
1978C
1979 9000 CONTINUE
1980      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'LORE')THEN
1981        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
1982        WRITE(ICOUT,999)
1983        CALL DPWRST('XXX','BUG ')
1984        WRITE(ICOUT,9011)
1985 9011   FORMAT('***** AT THE END       OF DPLORE--')
1986        CALL DPWRST('XXX','BUG ')
1987        WRITE(ICOUT,9012)IFOUND,IERROR
1988 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
1989        CALL DPWRST('XXX','BUG ')
1990        WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
1991 9013   FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
1992     1         I8,I8,I8,2X,A4,2X,A4,2X,A4)
1993        CALL DPWRST('XXX','BUG ')
1994        IF(NPLOTP.GT.0)THEN
1995          DO9015I=1,NPLOTP
1996            WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
1997 9016       FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
1998            CALL DPWRST('XXX','BUG ')
1999 9015     CONTINUE
2000        ENDIF
2001      ENDIF
2002C
2003      RETURN
2004      END
2005      SUBROUTINE DPLOR2(Y,N,NCURVE,ICASPL,MINN2,GINI,
2006     1                  Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
2007C
2008C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
2009C              THAT WILL DEFINE A LORENZ PLOT.
2010C     WRITTEN BY--ALAN HECKERT
2011C                 STATISTICAL ENGINEERING DIVISION
2012C                 INFORMATION TECHNOLOGY LABORATORY
2013C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2014C                 GAITHERSBURG, MD 20899-8980
2015C                 PHONE--301-975-2899
2016C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2017C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2018C     LANGUAGE--ANSI FORTRAN (1977)
2019C     REFERENCES--COBHAM AND SUMNER (2014), "IS INEQUALITY ALL ABOUT THE
2020C                 TAILS", SIGNIFICANCE, PP. 10-13.
2021C     VERSION NUMBER--2015/2
2022C     ORIGINAL VERSION--FEBRUARY  2015.
2023C
2024C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2025C
2026      CHARACTER*4 ICASPL
2027      CHARACTER*4 IBUGG3
2028      CHARACTER*4 ISUBRO
2029      CHARACTER*4 IERROR
2030C
2031      CHARACTER*4 ISUBN1
2032      CHARACTER*4 ISUBN2
2033      CHARACTER*4 IWRITE
2034C
2035C---------------------------------------------------------------------
2036C
2037      DIMENSION Y(*)
2038      DIMENSION Y2(*)
2039      DIMENSION X2(*)
2040      DIMENSION D2(*)
2041C
2042      DOUBLE PRECISION DSUM1
2043      DOUBLE PRECISION DSUM2
2044C
2045C---------------------------------------------------------------------
2046C
2047      INCLUDE 'DPCOP2.INC'
2048C
2049C-----START POINT-----------------------------------------------------
2050C
2051      ISUBN1='DPLO'
2052      ISUBN2='R2  '
2053      IERROR='NO'
2054      IWRITE='OFF'
2055C
2056      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'LOR2')THEN
2057        WRITE(ICOUT,999)
2058        CALL DPWRST('XXX','BUG ')
2059        WRITE(ICOUT,70)
2060   70   FORMAT('***** AT THE BEGINNING OF DPLOR2--')
2061        CALL DPWRST('XXX','BUG ')
2062        WRITE(ICOUT,72)N,N2,NCURVE
2063   72   FORMAT('N,N2,NCURVE = ',3I8)
2064        CALL DPWRST('XXX','BUG ')
2065        DO73I=1,N
2066          WRITE(ICOUT,74)I,Y(I)
2067   74     FORMAT('I, Y(I) = ',I8,G15.7)
2068          CALL DPWRST('XXX','BUG ')
2069   73   CONTINUE
2070      ENDIF
2071C
2072C               ********************************************
2073C               **  STEP 1--                              **
2074C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
2075C               ********************************************
2076C
2077      IF(N.LT.MINN2)THEN
2078        WRITE(ICOUT,999)
2079  999   FORMAT(1X)
2080        CALL DPWRST('XXX','BUG ')
2081        WRITE(ICOUT,31)
2082   31   FORMAT('***** ERROR IN LORENZ PLOT--')
2083        CALL DPWRST('XXX','BUG ')
2084        WRITE(ICOUT,32)MINN2
2085   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST ',
2086     1         I8,'.')
2087        CALL DPWRST('XXX','BUG ')
2088        WRITE(ICOUT,34)N
2089   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
2090        CALL DPWRST('XXX','BUG ')
2091        WRITE(ICOUT,999)
2092        CALL DPWRST('XXX','BUG ')
2093        IERROR='YES'
2094        GOTO9000
2095      ENDIF
2096C
2097      HOLD=Y(1)
2098      DO60I=1,N
2099      IF(Y(I).NE.HOLD)GOTO69
2100   60 CONTINUE
2101      WRITE(ICOUT,999)
2102      CALL DPWRST('XXX','BUG ')
2103      WRITE(ICOUT,31)
2104      CALL DPWRST('XXX','BUG ')
2105      WRITE(ICOUT,62)HOLD
2106   62 FORMAT('      ALL RESPONSE VALUES ARE IDENTICALLY EQUAL TO ',
2107     1       G15.7)
2108      CALL DPWRST('XXX','BUG ')
2109      WRITE(ICOUT,999)
2110      CALL DPWRST('XXX','BUG ')
2111      IERROR='YES'
2112      GOTO9000
2113   69 CONTINUE
2114C
2115C               **********************************************
2116C               **  STEP 2--                                **
2117C               **  ALGORITHM FOR LORENZ CURVE:             **
2118C               **     1) SORT THE DATA IN Y                **
2119C               **     2) X AXIS COORDINATE = i/N           **
2120C               **     3) Y AXIS COORDINATE = CUSUM/TOTSUM  **
2121C               **        WHERE:                            **
2122C               **        CUMSUM=CUMULATIVE SUM OF Y        **
2123C               **        TOTSUM=SUM OF Y                   **
2124C               **********************************************
2125C
2126      CALL SORT(Y,N,Y)
2127C
2128      IF(Y(1).LT.0.0)THEN
2129        WRITE(ICOUT,999)
2130        CALL DPWRST('XXX','BUG ')
2131        WRITE(ICOUT,31)
2132        CALL DPWRST('XXX','BUG ')
2133        WRITE(ICOUT,203)
2134  203   FORMAT('      THE RESPONSE VARIABLE CONTAINS NEGATIVE ',
2135     1         'NUMBERS AND THE')
2136        CALL DPWRST('XXX','BUG ')
2137        WRITE(ICOUT,205)
2138  205   FORMAT('      LORENZ CURVE IS NOT CURRENTLY SUPPORTED FOR ',
2139     1         'NEGATIVE NUMBERS.')
2140        CALL DPWRST('XXX','BUG ')
2141        IERROR='YES'
2142        GOTO9000
2143      ENDIF
2144C
2145      DSUM1=0.0D0
2146      DO210I=1,N
2147        DSUM1=DSUM1 + DBLE(Y(I))
2148  210 CONTINUE
2149C
2150      NTEMP=0
2151      N2=N2+1
2152      NSTART=N2
2153      Y2(N2)=0.0
2154      X2(N2)=0.0
2155      D2(N2)=REAL(NCURVE)
2156      DSUM2=0.0D0
2157      DO220I=1,N
2158        DSUM2=DSUM2 + DBLE(Y(I))
2159        N2=N2+1
2160        NTEMP=NTEMP+1
2161        Y2(N2)=REAL(DSUM2/DSUM1)
2162        X2(N2)=REAL(I)/REAL(N)
2163        D2(N2)=REAL(NCURVE)
2164  220 CONTINUE
2165      N2=N2+1
2166      NTEMP=NTEMP+1
2167      Y2(N2)=1.0
2168      X2(N2)=1.0
2169      D2(N2)=REAL(NCURVE)
2170C
2171      NUMVAR=2
2172      CALL INTVEC(Y2(NSTART),X2(NSTART),NTEMP,NUMVAR,IWRITE,XYINT,
2173     1            IBUGG3,IERROR)
2174      GINI=0.5 - XYINT
2175C
2176      NPLOTV=2
2177      GOTO9000
2178C
2179C               ******************
2180C               **   STEP 90--  **
2181C               **   EXIT       **
2182C               ******************
2183C
2184 9000 CONTINUE
2185      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'LOR2')THEN
2186        WRITE(ICOUT,999)
2187        CALL DPWRST('XXX','BUG ')
2188        WRITE(ICOUT,9011)
2189 9011   FORMAT('***** AT THE END       OF DPLOR2--')
2190        CALL DPWRST('XXX','BUG ')
2191        WRITE(ICOUT,9012)ICASPL,IERROR,N2,DSUM1,GINI
2192 9012   FORMAT('ICASPL,IERROR,N2,DSUM1,GINI = ',2(A4,2X),I8,2G15.7)
2193        CALL DPWRST('XXX','BUG ')
2194        DO9015I=1,N2
2195          WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
2196 9016     FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2G15.7,F9.2)
2197          CALL DPWRST('XXX','BUG ')
2198 9015   CONTINUE
2199      ENDIF
2200C
2201      RETURN
2202      END
2203      SUBROUTINE DPLOST(ILOOST,ILOOLI,NUMLIL,NUMLOS,NUMENS,
2204     1                  IANSLC,IWIDTH,ICOM,IHARG,IHARG2,NUMARG,IANSLO,
2205     1                  IWIDLL,MAXCIL,MAXLIL,IERRFA,IGUIFL,
2206     1                  IBUGLO,ISUBRO,IERROR)
2207C
2208C     PURPOSE--STORE A COMMAND LINE IN A LOOP FOR FUTURE EXECUTION.
2209C     ORIGINAL VERSION--DECEMBER  1982
2210C     UPDATED         --DECEMBER  1988. NO STORAGE OF COMMENT LINES
2211C     UPDATED         --DECEMBER  1988. RESTORE CONTROL IF MAX LINES
2212C     UPDATED         --FEBRUARY  1989. FIX IF > 80 COLUMNS (ALAN)
2213C     UPDATED         --SEPTEMBER 2012. FATAL ERROR LOGIC IF TOO MANY
2214C                                       LINES
2215C     UPDATED         --APRIL     2018. SUPPORT "LOOP WHILE"
2216C
2217C---------------------------------------------------------------------
2218C
2219      CHARACTER*4 ILOOST
2220      CHARACTER*4 IANSLC
2221      CHARACTER*4 ICOM
2222      CHARACTER*4 IHARG
2223      CHARACTER*4 IHARG2
2224      CHARACTER*4 IANSLO
2225      CHARACTER*4 IERRFA
2226      CHARACTER*4 IGUIFL
2227      CHARACTER*4 ICASE
2228      CHARACTER*4 IBUGLO
2229      CHARACTER*4 ISUBRO
2230      CHARACTER*4 IERROR
2231C
2232      CHARACTER*4 ISUBN1
2233      CHARACTER*4 ISUBN2
2234      CHARACTER*4 ISTEPN
2235C
2236C---------------------------------------------------------------------
2237C
2238      DIMENSION IANSLC(*)
2239      DIMENSION IHARG(*)
2240      DIMENSION IHARG2(*)
2241C
2242      DIMENSION IANSLO(MAXLIL,MAXCIL)
2243      DIMENSION IWIDLL(*)
2244C
2245C---------------------------------------------------------------------
2246C
2247      INCLUDE 'DPCOP2.INC'
2248C
2249C-----START POINT-----------------------------------------------------
2250C
2251      ISUBN1='DPLO'
2252      ISUBN2='ST  '
2253C
2254      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOST')THEN
2255        WRITE(ICOUT,999)
2256  999   FORMAT(1X)
2257        CALL DPWRST('XXX','BUG ')
2258        WRITE(ICOUT,51)
2259   51   FORMAT('***** AT THE BEGINNING OF DPLOST--')
2260        CALL DPWRST('XXX','BUG ')
2261        WRITE(ICOUT,52)IBUGLO,ISUBRO,IERROR,ILOOST,ICOM
2262   52   FORMAT('IBUGLO,ISUBRO,IERROR,ILOOST,ICOM = ',4(A4,2X),A4)
2263        CALL DPWRST('XXX','BUG ')
2264        WRITE(ICOUT,54)NUMLOS,NUMENS,IWIDTH
2265   54   FORMAT('NUMLOS,NUMENS,IWIDTH = ',3I8)
2266        CALL DPWRST('XXX','BUG ')
2267        WRITE(ICOUT,55)ILOOLI,NUMLIL,MAXLIL,MAXCIL
2268   55   FORMAT('ILOOLI,NUMLIL,MAXLIL,MAXCIL = ',4I8)
2269        CALL DPWRST('XXX','BUG ')
2270        WRITE(ICOUT,59)(IANSLC(J),J=1,MIN(80,IWIDTH))
2271   59   FORMAT('(IANSLC(J),J=1,IWIDTH) = ',80A1)
2272        CALL DPWRST('XXX','BUG ')
2273        DO65I=1,NUMLIL
2274          WRITE(ICOUT,66)I,IWIDLL(I)
2275   66     FORMAT('I,IWIDLL(I) = ',I8,I8)
2276          CALL DPWRST('XXX','BUG ')
2277          JMAX=IWIDLL(I)
2278          WRITE(ICOUT,67)(IANSLO(I,J),J=1,MIN(100,JMAX))
2279   67     FORMAT('(IANSLO(I,J),J=1,JMAX) = ',100A1)
2280          CALL DPWRST('XXX','BUG ')
2281   65   CONTINUE
2282        DO75I=1,NUMLIL
2283          WRITE(ICOUT,76)I,IHARG(I),IHARG2(I)
2284   76     FORMAT('I,IHARG(I),IHARG2(I)) = ',I8,2X,2A4)
2285          CALL DPWRST('XXX','BUG ')
2286   75   CONTINUE
2287        WRITE(ICOUT,999)
2288        CALL DPWRST('XXX','BUG ')
2289      ENDIF
2290C
2291C               **************************************
2292C               **  STEP 0--                        **
2293C               **  CHECK LOOP STATUS FOR    STORE  **
2294C               **  CHECK COMMAND FOR        LOOP   **
2295C               **  BRANCH ACCORDINGLY.             **
2296C               **************************************
2297C
2298      IF(ICOM.EQ.'LOOP')THEN
2299C
2300C               *******************************
2301C               **  STEP 1--                 **
2302C               **  TREAT THE CASE WHEN THE  **
2303C               **  CURRENT COMMAND = LOOP   **
2304C               *******************************
2305C
2306        ISTEPN='1'
2307        IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOST')
2308     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2309C
2310        ILOOST='STOR'
2311        ILOOLI=ILOOLI+1
2312        IF(ILOOLI.GT.MAXLIL)GOTO4000
2313        NUMLIL=ILOOLI
2314        NUMLOS=NUMLOS+1
2315        IWIDLL(ILOOLI)=IWIDTH
2316        JMAX=IWIDTH
2317        IF(JMAX.GT.MAXCIL)JMAX=MAXCIL
2318        DO1050J=1,JMAX
2319          IANSLO(ILOOLI,J)=IANSLC(J)
2320 1050   CONTINUE
2321        GOTO9000
2322C
2323      ELSEIF(ILOOST.EQ.'STOR')THEN
2324C
2325C               *******************************
2326C               **  STEP 2--                 **
2327C               **  TREAT THE CASE WHEN THE  **
2328C               **  LOOP STATUS = STORE      **
2329C               *******************************
2330C
2331        ISTEPN='2'
2332        IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOST')
2333     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2334C
2335CCCCC   THE FOLLOWING LINE WAS ADDED IN DECEMBER 1988
2336CCCCC   TO AVOID STORING COMMENT LINES IN A LOOP   (DECEMBER 1988)
2337CCCCC   AND THEREBY SAVE SOME STORAGE              (DECEMBER 1988)
2338C
2339        IF(IWIDTH.GE.1.AND.IANSLC(1).EQ.'.')GOTO9000
2340        ILOOLI=ILOOLI+1
2341        IF(ILOOLI.GT.MAXLIL)GOTO4000
2342        NUMLIL=ILOOLI
2343        IWIDLL(ILOOLI)=IWIDTH
2344CCCCC   THE FOLLOWING 3 LINES WERE ADDED (FEBRUARY 1989)
2345CCCCC   TO AVOID PROBLEMS WHEN > 80 COLUMNS  (FEBRUARY 1989)
2346        JMAX=IWIDTH
2347        IF(JMAX.GT.MAXCIL)JMAX=MAXCIL
2348        DO2050J=1,JMAX
2349          IANSLO(ILOOLI,J)=IANSLC(J)
2350 2050   CONTINUE
2351C
2352C               ************************************
2353C               **  STEP 3--                      **
2354C               **  TREAT THE CASE WHEN THE       **
2355C               **  CURRENT COMMAND = END OF LOOP **
2356C               ************************************
2357C
2358        IF(ICOM.EQ.'END')THEN
2359          IF((NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP') .OR.
2360     1       (NUMARG.GE.2.AND.IHARG(2).EQ.'LOOP'))THEN
2361            NUMENS=NUMENS+1
2362            IF(NUMENS.EQ.NUMLOS)THEN
2363              ILOOST='EXEC'
2364              ILOOLI=0
2365            ELSE
2366              ILOOST='STOR'
2367            ENDIF
2368          ENDIF
2369          GOTO9000
2370        ELSE
2371          GOTO9000
2372        ENDIF
2373      ELSE
2374        GOTO9000
2375      ENDIF
2376C
2377C               ****************************
2378C               **  STEP 4--              **
2379C               **  TREAT THE ERROR CASE  **
2380C               ****************************
2381C
2382 4000 CONTINUE
2383      WRITE(ICOUT,999)
2384      CALL DPWRST('XXX','WRIT')
2385      WRITE(ICOUT,4011)
2386 4011 FORMAT('***** ERROR IN LOOP STORE--')
2387      CALL DPWRST('XXX','WRIT')
2388      WRITE(ICOUT,4012)
2389 4012 FORMAT('      THE TOTAL NUMBER OF LINES IN ALL NESTED LOOPS')
2390      CALL DPWRST('XXX','WRIT')
2391      WRITE(ICOUT,4014)MAXLIL
2392 4014 FORMAT('      HAS JUST EXCEEDED THE ALLOWABLE MAXIMUM (',I8,')')
2393      CALL DPWRST('XXX','WRIT')
2394      IF(IWIDTH.GE.1)THEN
2395        WRITE(ICOUT,4015)
2396 4015   FORMAT('      THE CURRENT LINE BEING PROCESSED IS')
2397        CALL DPWRST('XXX','WRIT')
2398        WRITE(ICOUT,4016)(IANSLC(J),J=1,MIN(80,IWIDTH))
2399 4016   FORMAT(6X,80A1)
2400        CALL DPWRST('XXX','WRIT')
2401      ENDIF
2402      IERROR='YES'
2403C
2404C     2012/09: AT JIM's REQUEST, PROMPT IF YOU WANT TO
2405C              CONTINUE IF THIS ERROR ENCOUNTERED.
2406C
2407      IF(IERROR.EQ.'YES')THEN
2408        ICASE='LOOP'
2409        CALL DPERRO(IERRFA,IANSLC,IWIDTH,IGUIFL,
2410     1              ISUBN1,ISUBN2,ICASE,
2411     1              IBUGLO,ISUBRO,IERROR)
2412      ENDIF
2413C
2414CCCCC THE FOLLOWING 5 LINES WERE ADDED DECEMBER 1988
2415CCCCC TO GIVE CONTROL BACK TO THE USER (DECEMBER 1988)
2416CCCCC IN CASE HAVE EXCEEDED MAX NUMBER OF LOOP LINES (DECEMBER 1988)
2417C
2418      ILOOST='OFF'
2419      ILOOLI=0
2420      NUMLIL=0
2421      NUMLOS=0
2422      NUMENS=0
2423C
2424      GOTO9000
2425C
2426C               *****************
2427C               **  STEP 90--  **
2428C               **  EXIT       **
2429C               *****************
2430C
2431 9000 CONTINUE
2432      IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOST')THEN
2433        WRITE(ICOUT,999)
2434        CALL DPWRST('XXX','BUG ')
2435        WRITE(ICOUT,9011)
2436 9011   FORMAT('***** AT THE END       OF DPLOST--')
2437        CALL DPWRST('XXX','BUG ')
2438        WRITE(ICOUT,9014)IERROR,NUMLOS,NUMENS,IWIDTH
2439 9014   FORMAT('IERROR,NUMLOS,NUMENS,IWIDTH = ',A4,2X,3I8)
2440        CALL DPWRST('XXX','BUG ')
2441        WRITE(ICOUT,9015)ILOOLI,NUMLIL,MAXLIL,MAXCIL
2442 9015   FORMAT('ILOOLI,NUMLIL,MAXLIL,MAXCIL = ',4I8)
2443        CALL DPWRST('XXX','BUG ')
2444        WRITE(ICOUT,9019)(IANSLC(J),J=1,MIN(80,IWIDTH))
2445 9019   FORMAT('(IANSLC(J),J=1,IWIDTH) = ',80A1)
2446        CALL DPWRST('XXX','BUG ')
2447        DO9025I=1,NUMLIL
2448          WRITE(ICOUT,9026)I,IWIDLL(I)
2449 9026     FORMAT('I,IWIDLL(I) = ',I8,I8)
2450          CALL DPWRST('XXX','BUG ')
2451          JMAX=IWIDLL(I)
2452          WRITE(ICOUT,9027)(IANSLO(I,J),J=1,MIN(80,JMAX))
2453 9027     FORMAT('(IANSLO(I,J),J=1,JMAX) = ',80A1)
2454          CALL DPWRST('XXX','BUG ')
2455 9025   CONTINUE
2456        WRITE(ICOUT,999)
2457        CALL DPWRST('XXX','BUG ')
2458      ENDIF
2459C
2460      RETURN
2461      END
2462      SUBROUTINE DPLOW(ALOWFR,ALOWDG,ICAPSW,IFORSW,
2463CCCCC ADD ARGUMENT FOR LOWESS DEGREE.  MARCH 1994.
2464CCCCC SUBROUTINE DPLOW(ALOWFR,
2465     1                 XTEMP3,XTEMP4,XTEMP1,XTEMP2,MAXNXT,
2466     1                 IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
2467C
2468C     PURPOSE--CARRY OUT A LOWESS FIT OF Y ON X.  (USEFUL FOR ADDING A
2469C              ROBUST SMOOTH LINE TO A SCATTER PLOT)
2470C     NOTE--ALOWFR IS A NUMBER BETWEEN 0.0 AND 1.0
2471C     WRITTEN BY--JAMES J. FILLIBEN
2472C                 STATISTICAL ENGINEERING DIVISION
2473C                 INFORMATION TECHNOLOGY LABORATORY
2474C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2475C                 GAITHERSBURG, MD 20899-8980
2476C                 PHONE--301-975-2855
2477C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2478C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2479C     LANGUAGE--ANSI FORTRAN (1977)
2480C     VERSION NUMBER--88/2
2481C     ORIGINAL VERSION--FEBRUARY  1988.
2482C     UPDATED         --MARCH     1988. ADD LOFCDF
2483C     UPDATED         --JANUARY   1988. DECLARE ICTAR1&2 AS CHARACTER
2484C     UPDATED         --NOVEMBER  1989. ALLOW SINGLE VARIABLE
2485C     UPDATED         --NOVEMBER  1989. CHECK LOWESS FRACTION 0 TO 1
2486C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
2487C     UPDATED         --APRIL     1992. COMMENT OUT 2 DEBUG LINES
2488C     UPDATED         --APRIL     1992. NPLOTP TO NS IN DEBUG SECTION
2489C     UPDATED         --MARCH     1994. ADD ARGUMENT
2490C     UPDATED         --FEBRUARY  1999. ADD SEASONAL LOESS
2491C     UPDATED         --FEBRUARY  2012. USE DPPARS
2492C
2493C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2494C
2495      CHARACTER*4 ICASAN
2496      CHARACTER*4 ICAPSW
2497      CHARACTER*4 IFORSW
2498      CHARACTER*4 IBUGA2
2499      CHARACTER*4 IBUGA3
2500      CHARACTER*4 IBUGQ
2501      CHARACTER*4 ISUBRO
2502      CHARACTER*4 IFOUND
2503      CHARACTER*4 IERROR
2504C
2505      CHARACTER*4 IREP
2506      CHARACTER*4 IREPU
2507      CHARACTER*4 IRESU
2508      CHARACTER*4 ISUBN1
2509      CHARACTER*4 ISUBN2
2510      CHARACTER*4 ISTEPN
2511      CHARACTER*4 IOP
2512      CHARACTER*4 IHP
2513      CHARACTER*4 IHP2
2514      CHARACTER*4 IHWUSE
2515      CHARACTER*4 MESSAG
2516C
2517      LOGICAL ROBUST
2518C
2519      CHARACTER*4 ICASE
2520      CHARACTER*40 INAME
2521      PARAMETER (MAXSPN=10)
2522      CHARACTER*4 IVARN1(MAXSPN)
2523      CHARACTER*4 IVARN2(MAXSPN)
2524      CHARACTER*4 IVARTY(MAXSPN)
2525      REAL PVAR(MAXSPN)
2526      INTEGER ILIS(MAXSPN)
2527      INTEGER NRIGHT(MAXSPN)
2528      INTEGER ICOLR(MAXSPN)
2529C
2530C---------------------------------------------------------------------
2531C
2532      INCLUDE 'DPCOPA.INC'
2533      INCLUDE 'DPCOZZ.INC'
2534C
2535      DIMENSION XTEMP1(*)
2536      DIMENSION XTEMP2(*)
2537      DIMENSION XTEMP3(*)
2538      DIMENSION XTEMP4(*)
2539      DIMENSION Y1(MAXOBV)
2540      DIMENSION Y2(MAXOBV)
2541      DIMENSION W(MAXOBV)
2542      DIMENSION XTEMP5(MAXOBV)
2543      DIMENSION XTEMP6(MAXOBV)
2544      DIMENSION XTEMP7(MAXOBV)
2545      DIMENSION XWORK(10*MAXOBV)
2546      DIMENSION PRED2(MAXOBV)
2547      DIMENSION RES2(MAXOBV)
2548C
2549      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
2550      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
2551      EQUIVALENCE (GARBAG(IGARB3),W(1))
2552      EQUIVALENCE (GARBAG(IGARB4),PRED2(1))
2553      EQUIVALENCE (GARBAG(IGARB5),RES2(1))
2554      EQUIVALENCE (GARBAG(IGARB6),XTEMP5(1))
2555      EQUIVALENCE (GARBAG(IGARB7),XTEMP6(1))
2556      EQUIVALENCE (GARBAG(IGARB8),XTEMP7(1))
2557      EQUIVALENCE (GARBAG(IGARB9),XWORK(1))
2558CCCCC END CHANGE
2559C
2560C-----COMMON----------------------------------------------------------
2561C
2562      INCLUDE 'DPCOHK.INC'
2563      INCLUDE 'DPCODA.INC'
2564      INCLUDE 'DPCOST.INC'
2565      INCLUDE 'DPCOSU.INC'
2566      INCLUDE 'DPCOP2.INC'
2567C
2568C-----START POINT-----------------------------------------------------
2569C
2570      ISUBN1='DPLO'
2571      ISUBN2='W   '
2572C
2573      IFOUND='NO'
2574      IERROR='NO'
2575C
2576      MAXCP1=MAXCOL+1
2577      MAXCP2=MAXCOL+2
2578      MAXCP3=MAXCOL+3
2579      MAXCP4=MAXCOL+4
2580      MAXCP5=MAXCOL+5
2581      MAXCP6=MAXCOL+6
2582C
2583      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW')THEN
2584        WRITE(ICOUT,999)
2585  999   FORMAT(1X)
2586        CALL DPWRST('XXX','BUG ')
2587        WRITE(ICOUT,51)
2588   51   FORMAT('***** AT THE BEGINNING OF DPLOW--')
2589        CALL DPWRST('XXX','BUG ')
2590        WRITE(ICOUT,54)IBUGA2,IBUGA3,IBUGQ,ISUBRO
2591   54   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
2592        CALL DPWRST('XXX','BUG ')
2593        WRITE(ICOUT,57)IFOUND,IERROR,MAXN,MAXNXT,ALOWFR
2594   57   FORMAT('IFOUND,IERROR,MAXN,MAXNXT,ALOWFR = ',2(A4,2X),2I8,G15.7)
2595        CALL DPWRST('XXX','BUG ')
2596      ENDIF
2597C
2598C               ***********************************
2599C               **  TREAT THE LOWESS    FIT CASE **
2600C               ***********************************
2601C
2602C               ***************************
2603C               **  STEP 11--            **
2604C               **  EXTRACT THE COMMAND  **
2605C               ***************************
2606C
2607CCCCC FEBRUARY 1999.  ADD SUPPORT FOR SEASONAL LOWESS COMMAND.
2608C
2609      ISTEPN='11'
2610      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW')
2611     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2612C
2613      ICASAN='PLOW'
2614      ILASTC=0
2615      IF(ICOM.EQ.'LOWE'.OR.ICOM.EQ.'LOES')THEN
2616        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FIT')THEN
2617          ILASTC=1
2618        ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'SMOO')THEN
2619          ILASTC=1
2620        ENDIF
2621      ELSEIF(ICOM.EQ.'SEAS')THEN
2622        IF(NUMARG.GE.1.AND.
2623     1    (IHARG(1).EQ.'LOWE'.OR.IHARG(1).EQ.'LOES'))THEN
2624          ILASTC=1
2625        ELSEIF(NUMARG.GE.2.AND.IHARG(2).EQ.'FIT')THEN
2626          ILASTC=ILASTC+1
2627        ELSEIF(NUMARG.GE.2.AND.IHARG(2).EQ.'SMOO')THEN
2628          ILASTC=ILASTC+1
2629          ICASAN='SLOW'
2630        ELSE
2631          IFOUND='NO'
2632          GOTO9000
2633        ENDIF
2634      ELSE
2635        IFOUND='NO'
2636        GOTO9000
2637      ENDIF
2638C
2639      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
2640      IFOUND='YES'
2641C
2642C               *********************************
2643C               **  STEP 2--                   **
2644C               **  EXTRACT THE VARIABLE LIST  **
2645C               *********************************
2646C
2647      ISTEPN='2'
2648      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW')
2649     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2650C
2651      INAME='LOWESS'
2652      MINN2=2
2653      MINNA=1
2654      MAXNA=100
2655      MINNVA=1
2656      MAXNVA=2
2657      IFLAGE=1
2658      IFLAGM=1
2659      IFLAGP=0
2660      JMIN=1
2661      JMAX=NUMARG
2662      IF(ICASAN.EQ.'SLOW')THEN
2663        INAME='SEASONAL LOWESS'
2664        MAXNVA=1
2665      ENDIF
2666C
2667      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
2668     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
2669     1            JMIN,JMAX,
2670     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
2671     1            IVARN1,IVARN2,IVARTY,PVAR,
2672     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
2673     1            MINNVA,MAXNVA,
2674     1            IFLAGM,IFLAGP,
2675     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
2676      IF(IERROR.EQ.'YES')GOTO9000
2677C
2678      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW')THEN
2679        WRITE(ICOUT,999)
2680        CALL DPWRST('XXX','BUG ')
2681        WRITE(ICOUT,181)
2682  181   FORMAT('***** AFTER CALL DPPARS--')
2683        CALL DPWRST('XXX','BUG ')
2684        WRITE(ICOUT,182)NQ,NUMVAR,IMULT
2685  182   FORMAT('NQ,NUMVAR,IMULT = ',2I8,2X,A4)
2686        CALL DPWRST('XXX','BUG ')
2687        IF(NUMVAR.GT.0)THEN
2688          DO185I=1,NUMVAR
2689            WRITE(ICOUT,187)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
2690     1                      ICOLR(I)
2691  187       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
2692     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
2693            CALL DPWRST('XXX','BUG ')
2694  185     CONTINUE
2695        ENDIF
2696      ENDIF
2697C
2698CCCCC THE FOLLOWING SECTION WAS INSERTED NOVEMBER 1989
2699C               **************************************************
2700C               **  STEP 10--                                   **
2701C               **  CHECK THAT THE LOWESS FRACTION              **
2702C               **  IS BETWEEN 0 AND 1 (EXCLUSIVELY)            **
2703C               **************************************************
2704C
2705      IF(ALOWFR.LE.0.0.OR.ALOWFR.GT.1.0)THEN
2706        WRITE(ICOUT,999)
2707        CALL DPWRST('XXX','BUG ')
2708        WRITE(ICOUT,1011)
2709 1011   FORMAT('***** ERROR IN LOWESS--')
2710        CALL DPWRST('XXX','BUG ')
2711        WRITE(ICOUT,1012)
2712 1012   FORMAT('      THE VALUE OF THE LOWESS FRACTION IS OUTSIDE THE')
2713        CALL DPWRST('XXX','BUG ')
2714        WRITE(ICOUT,1013)
2715 1013   FORMAT('     (0,1) INTERVAL (THIS VALUE SPECIFIES THE SIZE OF')
2716        CALL DPWRST('XXX','BUG ')
2717        WRITE(ICOUT,1014)
2718 1014   FORMAT('      OF THE LOWESS NEIGHBORHOOD)')
2719        CALL DPWRST('XXX','BUG ')
2720        WRITE(ICOUT,1017)ALOWFR
2721 1017   FORMAT('      THE VALUE OF THE LOWESS FRACTION = ',G15.7)
2722        CALL DPWRST('XXX','BUG ')
2723        WRITE(ICOUT,1018)
2724 1018   FORMAT('      CORRECT THIS VALUE VIA THE    LOWESS FRACTION ')
2725        CALL DPWRST('XXX','BUG ')
2726        WRITE(ICOUT,1019)
2727 1019   FORMAT('      COMMAND, AS IN      LOWESS FRACTION .5')
2728        CALL DPWRST('XXX','BUG ')
2729        IERROR='YES'
2730        GOTO9000
2731      ENDIF
2732C
2733C               **********************************************
2734C               **  STEP 33--                               **
2735C               **  FORM THE SUBSETTED VARIABLES            **
2736C               **       Y1(.)                              **
2737C               **       Y2(.)                              **
2738C               **  CONTAINING                              **
2739C               **       THE VERTICAL AXIS VARIABLE         **
2740C               **       THE HORIZONTAL AXIS VARIABLE       **
2741C               **  RESPECTIVELY.                           **
2742C               **********************************************
2743C
2744      ISTEPN='33'
2745      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW')
2746     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2747C
2748      ICOL=1
2749      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
2750     1            INAME,IVARN1,IVARN2,IVARTY,
2751     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
2752     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
2753     1            MAXCP4,MAXCP5,MAXCP6,
2754     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
2755     1            Y1,Y2,Y1,NS,NS,NS,ICASE,
2756     1            IBUGA3,ISUBRO,IFOUND,IERROR)
2757      IF(IERROR.EQ.'YES')GOTO9000
2758C
2759      IF(NUMVAR.EQ.1)THEN
2760        DO3310I=1,NS
2761          Y2(I)=REAL(I)
2762 3310   CONTINUE
2763      ENDIF
2764C
2765C               ******************************************************
2766C               **  STEP 41--                                       **
2767C               **  CARRY OUT THE LOWESS FIT                        **
2768C               ******************************************************
2769C
2770      ISTEPN='41'
2771      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW')
2772     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2773C
2774CCCCC MARCH 1994.  ADD ARGUMENT.
2775CCCCC CALL DPLOW2(Y1,Y2,W,NS,ALOWFR,ALOWDG,
2776      IF(ICASAN.EQ.'PLOW')THEN
2777        CALL DPLOW2(Y1,Y2,W,NS,ALOWFR,ALOWDG,ICAPSW,ICAPTY,IFORSW,
2778     1              XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,
2779     1              XTEMP6,XTEMP7,MAXNXT,
2780     1              IREP,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
2781     1              IBUGA3,ISUBRO,IERROR)
2782      ELSEIF(ICASAN.EQ.'SLOW')THEN
2783C
2784        IHP='PERI'
2785        IHP2='OD  '
2786        IHWUSE='P'
2787        MESSAG='NO'
2788        CALL CHECKN(IHP,IHP2,IHWUSE,
2789     1    IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
2790     1    ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
2791        IF(IERROR.EQ.'YES')THEN
2792          PERIOD=12.0
2793        ELSE
2794          PERIOD=VALUE(ILOCP)
2795        ENDIF
2796        NP=INT(PERIOD+0.5)
2797C
2798        IHP='STLW'
2799        IHP2='IDTH'
2800        IHWUSE='P'
2801        MESSAG='NO'
2802        CALL CHECKN(IHP,IHP2,IHWUSE,
2803     1    IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
2804     1    ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
2805        IF(IERROR.EQ.'YES')THEN
2806          NWIDTH=NS/10
2807        ELSE
2808          NWIDTH=INT(VALUE(ILOCP)+0.5)
2809        ENDIF
2810C
2811        IHP='STLS'
2812        IHP2='DEG '
2813        IHWUSE='P'
2814        MESSAG='NO'
2815        CALL CHECKN(IHP,IHP2,IHWUSE,
2816     1    IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
2817     1    ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
2818        IF(IERROR.EQ.'YES')THEN
2819          ISDEG=0
2820        ELSE
2821          ISDEG=INT(VALUE(ILOCP)+0.5)
2822        ENDIF
2823C
2824        IHP='STLT'
2825        IHP2='DEG '
2826        IHWUSE='P'
2827        MESSAG='NO'
2828        CALL CHECKN(IHP,IHP2,IHWUSE,
2829     1    IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
2830     1    ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
2831        IF(IERROR.EQ.'YES')THEN
2832          ITDEG=0
2833        ELSE
2834          ITDEG=INT(VALUE(ILOCP)+0.5)
2835        ENDIF
2836C
2837        IHP='STLT'
2838        IHP2='DEG '
2839        IHWUSE='P'
2840        MESSAG='NO'
2841        CALL CHECKN(IHP,IHP2,IHWUSE,
2842     1    IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
2843     1    ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
2844        IF(IERROR.EQ.'YES')THEN
2845          ROBUST=.TRUE.
2846        ELSE
2847          ROBUST=.TRUE.
2848          IF(INT(VALUE(ILOCP)+0.5).EQ.1)ROBUST=.FALSE.
2849        ENDIF
2850C
2851        CALL STLEZ(Y1,NS,NP,NWIDTH,ISDEG,ITDEG,ROBUST,NO,
2852     1             W,XTEMP1,XTEMP2,XWORK)
2853        DO5010I=1,NS
2854          PRED2(I)=XTEMP1(I)+XTEMP2(I)
2855          RES2(I)=Y1(I)-PRED2(I)
2856 5010   CONTINUE
2857C
2858C               ***************************************
2859C               **  STEP 51--                        **
2860C               **  WRITE SEASONAL, TREND TO FILE    **
2861C               ***************************************
2862C
2863        IOP='OPEN'
2864        IFLG1=1
2865        IFLG2=0
2866        IFLG3=0
2867        IFLG4=0
2868        IFLG5=0
2869        CALL DPAUFI(IOP,IFLG1,IFLG2,IFLG3,IFLG4,IFLG5,
2870     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
2871     1              IBUGA3,ISUBRO,IERROR)
2872        IF(IERROR.EQ.'YES')GOTO9000
2873C
2874        DO5110I=1,NS
2875          WRITE(IOUNI1,5111)XTEMP1(I),XTEMP2(I)
2876 5111     FORMAT(E15.7,E15.7)
2877 5110   CONTINUE
2878C
2879        IF(IFEEDB.EQ.'ON')THEN
2880          WRITE(ICOUT,999)
2881          CALL DPWRST('XXX','WRIT')
2882          WRITE(ICOUT,5192)
2883 5192     FORMAT(6X,'SEASONAL AND TREND COMPONENTS WRITTEN TO FILE ',
2884     1           'DPST1F.DAT')
2885          CALL DPWRST('XXX','WRIT')
2886        ENDIF
2887C
2888        IOP='CLOS'
2889        CALL DPAUFI(IOP,IFLG1,IFLG2,IFLG3,IFLG4,IFLG5,
2890     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
2891     1              IBUGA3,ISUBRO,IERROR)
2892      ENDIF
2893C
2894C               ***************************************
2895C               **  STEP 52--                        **
2896C               **  UPDATE INTERNAL DATAPLOT TABLES  **
2897C               ***************************************
2898C
2899      ISTEPN='42'
2900      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW')
2901     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
2902C
2903      ICOLPR=MAXCP1
2904      ICOLRE=MAXCP2
2905      IREPU='ON'
2906      IRESU='ON'
2907      CALL UPDAPR(ICOLPR,ICOLRE,PRED2,RES2,PRED,RES,ISUB,NRIGHT(1),
2908     1            IREPU,REPSD,REPDF,IRESU,RESSD,RESDF,ALFCDF,
2909     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
2910     1            IANS,IWIDTH,ILOCN,IBUGA3,IERROR)
2911C
2912C               *****************
2913C               **  STEP 90--  **
2914C               **  EXIT       **
2915C               *****************
2916C
2917 9000 CONTINUE
2918      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW')THEN
2919        WRITE(ICOUT,999)
2920        CALL DPWRST('XXX','BUG ')
2921        WRITE(ICOUT,9011)
2922 9011   FORMAT('***** AT THE END       OF DPLOW--')
2923        CALL DPWRST('XXX','BUG ')
2924        WRITE(ICOUT,9012)IFOUND,IERROR
2925 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
2926        CALL DPWRST('XXX','BUG ')
2927        WRITE(ICOUT,9014)ICASAN,NS,MAXN,MAXNXT,NUMVAR
2928 9014   FORMAT('ICASAN,NS,MAXN,MAXNXT,NUMVAR = ',A4,2X,5I8)
2929        CALL DPWRST('XXX','BUG ')
2930        IF(NS.GT.0)THEN
2931          DO9020I=1,NS
2932            WRITE(ICOUT,9021)I,Y1(I),Y2(I),PRED2(I),RES2(I),ISUB(I)
2933 9021       FORMAT('I,Y1(I),Y2(I),PRED2(I),RES2(I),ISUB(I) = ',
2934     1             I8,4G15.7,I8)
2935            CALL DPWRST('XXX','BUG ')
2936 9020     CONTINUE
2937        ENDIF
2938      ENDIF
2939C
2940      RETURN
2941      END
2942      SUBROUTINE DPLOW2(Y,X,W,N,ALOWFR,ALOWDG,ICAPSW,ICAPTY,IFORSW,
2943CCCCC MARCH 1994.  ADD ARGUMENT
2944CCCCC SUBROUTINE DPLOW2(Y,X,W,N,ALOWFR,
2945     1                  XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,
2946     1                  XTEMP6,XTEMP7,MAXNXT,
2947     1                  IREP,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
2948     1                  IBUGA3,ISUBRO,IERROR)
2949C
2950C     WRITTEN BY--JAMES J. FILLIBEN
2951C                 STATISTICAL ENGINEERING DIVISION
2952C                 INFORMATION TECHNOLOGY LABORATORY
2953C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2954C                 GAITHERSBURG, MD 20899-8980
2955C                 PHONE--301-975-2855
2956C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2957C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2958C     LANGUAGE--ANSI FORTRAN (1977)
2959C     VERSION NUMBER--88/2
2960C     ORIGINAL VERSION--FEBRUARY  1988.
2961C     UPDATED         --MARCH     1988. ADD LOFCDF
2962C     UPDATED         --NOVEMBER  1989. RESIDUAL SD
2963C     UPDATED         --FEBRUARY  2012. USE DPDTA1 TO PRINT OUTPUT
2964C     UPDATED         --JULY      2019. CALL LIST TO DPREPS
2965C
2966C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
2967C
2968      CHARACTER*4 IREP
2969      CHARACTER*4 ICAPSW
2970      CHARACTER*4 ICAPTY
2971      CHARACTER*4 IFORSW
2972      CHARACTER*4 IBUGA3
2973      CHARACTER*4 ISUBRO
2974      CHARACTER*4 IERROR
2975C
2976      CHARACTER*4 ISUBN1
2977      CHARACTER*4 ISUBN2
2978      CHARACTER*4 ISTEPN
2979C
2980C---------------------------------------------------------------------
2981C
2982      DIMENSION Y(*)
2983      DIMENSION X(*)
2984      DIMENSION W(*)
2985C
2986      DIMENSION XTEMP1(*)
2987      DIMENSION XTEMP2(*)
2988      DIMENSION XTEMP3(*)
2989      DIMENSION XTEMP4(*)
2990      DIMENSION XTEMP5(*)
2991      DIMENSION XTEMP6(*)
2992      DIMENSION XTEMP7(*)
2993C
2994      DIMENSION PRED2(*)
2995      DIMENSION RES2(*)
2996C
2997      PARAMETER(NUMCLI=10)
2998      PARAMETER(MAXLIN=3)
2999      PARAMETER (MAXROW=30)
3000      CHARACTER*40 ITITLE
3001      CHARACTER*40 ITITLZ
3002      CHARACTER*40 ITEXT(MAXROW)
3003      REAL         AVALUE(MAXROW)
3004      INTEGER      NCTEXT(MAXROW)
3005      INTEGER      IDIGIT(MAXROW)
3006      INTEGER      NTOT(MAXROW)
3007      LOGICAL IFRST
3008      LOGICAL ILAST
3009C
3010C---------------------------------------------------------------------
3011C
3012      INCLUDE 'DPCOP2.INC'
3013C
3014C-----START POINT-----------------------------------------------------
3015C
3016      ISUBN1='DPLO'
3017      ISUBN2='W2  '
3018      IERROR='NO'
3019C
3020      RESSD=0.0
3021      RESDF=0.0
3022      REPSD=0.0
3023      REPDF=0.0
3024      ALFCDF=(-999.99)
3025      CDF2=-999.99
3026C
3027      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2')THEN
3028        WRITE(ICOUT,999)
3029  999   FORMAT(1X)
3030        CALL DPWRST('XXX','BUG ')
3031        WRITE(ICOUT,51)
3032   51   FORMAT('***** AT THE BEGINNING OF DPLOW2--')
3033        CALL DPWRST('XXX','BUG ')
3034        WRITE(ICOUT,52)N,IBUGA3
3035   52   FORMAT('N,IBUGA3 = ',I8,2X,A4)
3036        CALL DPWRST('XXX','BUG ')
3037        DO55I=1,N
3038          WRITE(ICOUT,56)I,Y(I),X(I),W(I)
3039   56     FORMAT('I,Y(I),X(I),W(I) = ',I8,3G15.7)
3040          CALL DPWRST('XXX','BUG ')
3041   55   CONTINUE
3042      ENDIF
3043C
3044      NUMDIG=7
3045      IF(IFORSW.EQ.'1')NUMDIG=1
3046      IF(IFORSW.EQ.'2')NUMDIG=2
3047      IF(IFORSW.EQ.'3')NUMDIG=3
3048      IF(IFORSW.EQ.'4')NUMDIG=4
3049      IF(IFORSW.EQ.'5')NUMDIG=5
3050      IF(IFORSW.EQ.'6')NUMDIG=6
3051      IF(IFORSW.EQ.'7')NUMDIG=7
3052      IF(IFORSW.EQ.'8')NUMDIG=8
3053      IF(IFORSW.EQ.'9')NUMDIG=9
3054      IF(IFORSW.EQ.'0')NUMDIG=0
3055      IF(IFORSW.EQ.'E')NUMDIG=-2
3056      IF(IFORSW.EQ.'-2')NUMDIG=-2
3057      IF(IFORSW.EQ.'-3')NUMDIG=-3
3058      IF(IFORSW.EQ.'-4')NUMDIG=-4
3059      IF(IFORSW.EQ.'-5')NUMDIG=-5
3060      IF(IFORSW.EQ.'-6')NUMDIG=-6
3061      IF(IFORSW.EQ.'-7')NUMDIG=-7
3062      IF(IFORSW.EQ.'-8')NUMDIG=-8
3063      IF(IFORSW.EQ.'-9')NUMDIG=-9
3064C
3065C               ********************************************************
3066C               **  STEP 11--                                         **
3067C               **  PRINT OUT THE HEADER AND PRELIMINARY INFORMATION  **
3068C               **  FOR THE FIT                                       **
3069C               ********************************************************
3070C
3071      ISTEPN='11'
3072      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2')
3073     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3074C
3075      AN=N
3076      NN=INT(ALOWFR*AN+0.5)
3077C
3078      IF(IPRINT.EQ.'ON')THEN
3079        ITITLE='Lowess Fit'
3080        NCTITL=10
3081        ITITLZ=' '
3082        NCTITZ=0
3083C
3084        ICNT=1
3085        ITEXT(ICNT)=' '
3086        NCTEXT(ICNT)=0
3087        AVALUE(ICNT)=0.0
3088        IDIGIT(ICNT)=-1
3089        ICNT=ICNT+1
3090        ITEXT(ICNT)='Sample Size:'
3091        NCTEXT(ICNT)=12
3092        AVALUE(ICNT)=REAL(N)
3093        IDIGIT(ICNT)=0
3094        ICNT=ICNT+1
3095        ITEXT(ICNT)='Lowess Fraction (0 to 1):'
3096        NCTEXT(ICNT)=25
3097        AVALUE(ICNT)=ALOWFR
3098        IDIGIT(ICNT)=NUMDIG
3099        ICNT=ICNT+1
3100        ITEXT(ICNT)='Lowess Degree (1 or 2):'
3101        NCTEXT(ICNT)=23
3102        IJUNK=INT(ALOWDG+0.1)
3103        AVALUE(ICNT)=REAL(IJUNK)
3104        IDIGIT(ICNT)=0
3105        ICNT=ICNT+1
3106        ITEXT(ICNT)='Neighborhood Size:'
3107        NCTEXT(ICNT)=18
3108        AVALUE(ICNT)=REAL(NN)
3109        IDIGIT(ICNT)=0
3110      ENDIF
3111C
3112C               ********************************************************
3113C               **  STEP 12--                                         **
3114C               **  CHECK FOR REPLICATION AND IF EXISTENT COMPUTE     **
3115C               **  A (MODEL-FREE) REPLICATION STANDARD DEVIATION.    **
3116C               ********************************************************
3117C
3118      ISTEPN='12'
3119      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2')
3120     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3121C
3122      NUMVAR=1
3123      CALL DPREPS(Y,X,N,N,NUMVAR,
3124     1            XTEMP6,XTEMP7,
3125     1            IREP,REPSS,REPMS,REPSD,REPDF,NUMSET,IBUGA3,IERROR)
3126      IREPDF=INT(REPDF+0.5)
3127C
3128      IF(IPRINT.EQ.'ON')THEN
3129        ICNT=ICNT+1
3130        ITEXT(ICNT)=' '
3131        NCTEXT(ICNT)=0
3132        AVALUE(ICNT)=0.0
3133        IDIGIT(ICNT)=-1
3134        IF(IREP.EQ.'NO')THEN
3135          ICNT=ICNT+1
3136          ITEXT(ICNT)='No Replication Case'
3137          NCTEXT(ICNT)=19
3138          AVALUE(ICNT)=0.0
3139          IDIGIT(ICNT)=-1
3140        ELSE
3141          ICNT=ICNT+1
3142          ITEXT(ICNT)='Replication Case'
3143          NCTEXT(ICNT)=16
3144          AVALUE(ICNT)=0.0
3145          IDIGIT(ICNT)=-1
3146        ENDIF
3147        ICNT=ICNT+1
3148        ITEXT(ICNT)='Number of Distinct Subsets:'
3149        NCTEXT(ICNT)=27
3150        AVALUE(ICNT)=REAL(NUMSET)
3151        IDIGIT(ICNT)=0
3152        ICNT=ICNT+1
3153        ITEXT(ICNT)=' '
3154        NCTEXT(ICNT)=0
3155        AVALUE(ICNT)=0.0
3156        IDIGIT(ICNT)=-1
3157      ENDIF
3158C
3159C               *************************************************
3160C               **  STEP 21--                                  **
3161C               **  CARRY OUT THE LOWESS FIT                   **
3162C               *************************************************
3163C
3164      ISTEPN='21'
3165      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2')
3166     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3167C
3168C
3169CCCCC MARCH 1994.  ADD ARGUMENT.
3170CCCCC CALL LOWESS(Y,X,N,ALOWFR,
3171      CALL LOWESS(Y,X,N,ALOWFR,ALOWDG,
3172     1            XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,
3173     1            XTEMP6,XTEMP7,MAXNXT,
3174     1            PRED2,RES2,ISUBRO,IBUGA3,IERROR)
3175C
3176      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2')THEN
3177        WRITE(ICOUT,2111)N
3178 2111   FORMAT('N = ',I8)
3179        CALL DPWRST('XXX','BUG ')
3180        DO2112I=1,N
3181          WRITE(ICOUT,2113)I,Y(I),PRED2(I),RES2(I)
3182 2113     FORMAT('I,Y(I),PRED2(I),RES2(I) = ',I8,3G15.7)
3183          CALL DPWRST('XXX','BUG ')
3184 2112   CONTINUE
3185      ENDIF
3186C
3187CCCCC THE FOLLOWING SECTION WAS COMMENTED OUT NOVEMBER 1989
3188CCCCC RESSD=SD
3189CCCCC RESDF=NDF
3190CCCCC RESMS=RESSD*RESSD
3191CCCCC RESSS=RESMS*RESDF
3192C
3193CCCCC THE FOLLOWING SECTION WAS INSERTED NOVEMBER 1989
3194      DENOM=N-1
3195      RESSS=0.0
3196      DO2120I=1,N
3197        RESSS=RESSS+RES2(I)**2
3198 2120 CONTINUE
3199      RESMS=RESSS/DENOM
3200      S=0.0
3201      IF(RESMS.GT.0.0)S=SQRT(RESMS)
3202      RESDF=DENOM
3203      IRESDF=INT(RESDF+0.5)
3204      RESSD=S
3205CCCCC RESAAR=SUMAB/AN
3206C
3207      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2')THEN
3208        WRITE(ICOUT,2121)RESSD,RESDF,RESMS,RESSS
3209 2121   FORMAT('RESSD,RESDF,RESMS,RESSS = ',4G15.7)
3210        CALL DPWRST('XXX','BUG ')
3211      ENDIF
3212C
3213C               *******************************************************
3214C               **  STEP 31--                                        **
3215C               **  PRINT OUT THE PARAMETER ESTIMATES AND THEIR      **
3216C               **  STANDARD DEVIATIONS.  ALSO PRINT OUT THE         **
3217C               **  RESIDUAL STANDARD DEVIATION AND THE GOODNESS OF  **
3218C               **  FIT INFORMATION.                                 **
3219C               *******************************************************
3220C
3221      IFITDF=IRESDF-IREPDF
3222      IF(IREP.EQ.'YES' .AND. IFITDF.GE.1)THEN
3223        FITDF=IFITDF
3224        FITSS=RESSS-REPSS
3225        FITMS=100000.0
3226        IF(FITDF.GT.0.0)FITMS=FITSS/FITDF
3227        FSTAT=100000.0
3228        IF(REPMS.GT.0.0)FSTAT=FITMS/REPMS
3229        CALL FCDF(FSTAT,IFITDF,IREPDF,CDF)
3230        CDF2=100.0*CDF
3231        ALFCDF=CDF
3232      ENDIF
3233C
3234      IF(IPRINT.EQ.'ON')THEN
3235        ICNT=ICNT+1
3236        ITEXT(ICNT)='Residual Standard Deviation:'
3237        NCTEXT(ICNT)=28
3238        AVALUE(ICNT)=RESSD
3239        IDIGIT(ICNT)=NUMDIG
3240        ICNT=ICNT+1
3241        ITEXT(ICNT)='Residual Degrees of Freedom:'
3242        NCTEXT(ICNT)=28
3243        AVALUE(ICNT)=REAL(IRESDF)
3244        IDIGIT(ICNT)=0
3245C
3246        IF(IREP.EQ.'YES')THEN
3247          ICNT=ICNT+1
3248          ITEXT(ICNT)='Replication Standard Deviation:'
3249          NCTEXT(ICNT)=31
3250          AVALUE(ICNT)=REPSD
3251          IDIGIT(ICNT)=NUMDIG
3252          ICNT=ICNT+1
3253          ITEXT(ICNT)='Replication Degrees of Freedom:'
3254          NCTEXT(ICNT)=31
3255          AVALUE(ICNT)=REAL(IREPDF)
3256          IDIGIT(ICNT)=0
3257C
3258          IFITDF=IRESDF-IREPDF
3259          IF(IFITDF.LT.1)THEN
3260            ICNT=ICNT+1
3261            ITEXT(ICNT)='The Lack of Fit F Test cannot be done'
3262            NCTEXT(ICNT)=37
3263            AVALUE(ICNT)=0.0
3264            IDIGIT(ICNT)=-1
3265            ICNT=ICNT+1
3266            ITEXT(ICNT)='because there are 0 degrees of freedom'
3267            NCTEXT(ICNT)=38
3268            AVALUE(ICNT)=0.0
3269            IDIGIT(ICNT)=-1
3270            ICNT=ICNT+1
3271            ITEXT(ICNT)='in the numerator of the F ratio.  This'
3272            NCTEXT(ICNT)=38
3273            AVALUE(ICNT)=0.0
3274            IDIGIT(ICNT)=-1
3275            ICNT=ICNT+1
3276            ITEXT(ICNT)='This happens when the number of'
3277            NCTEXT(ICNT)=31
3278            AVALUE(ICNT)=0.0
3279            IDIGIT(ICNT)=-1
3280            ICNT=ICNT+1
3281            ITEXT(ICNT)='parameters fitted is identical to the'
3282            NCTEXT(ICNT)=37
3283            AVALUE(ICNT)=0.0
3284            IDIGIT(ICNT)=-1
3285            ICNT=ICNT+1
3286            ITEXT(ICNT)='number of distinct subsets.'
3287            NCTEXT(ICNT)=27
3288            AVALUE(ICNT)=0.0
3289            IDIGIT(ICNT)=-1
3290          ELSE
3291            ICNT=ICNT+1
3292            ITEXT(ICNT)='Lack of Fit F Ratio:'
3293            NCTEXT(ICNT)=20
3294            AVALUE(ICNT)=FSTAT
3295            IDIGIT(ICNT)=NUMDIG
3296            ICNT=ICNT+1
3297            ITEXT(ICNT)='Lack of Fit F CDF (%):'
3298            NCTEXT(ICNT)=22
3299            AVALUE(ICNT)=CDF2
3300            IDIGIT(ICNT)=NUMDIG
3301            ICNT=ICNT+1
3302            ITEXT(ICNT)='Lack of Fit Degrees of Freedom 1:'
3303            NCTEXT(ICNT)=33
3304            AVALUE(ICNT)=REAL(IFITDF)
3305            IDIGIT(ICNT)=0
3306            ICNT=ICNT+1
3307            ITEXT(ICNT)='Lack of Fit Degrees of Freedom 2:'
3308            NCTEXT(ICNT)=33
3309            AVALUE(ICNT)=REAL(IREPDF)
3310            IDIGIT(ICNT)=0
3311          ENDIF
3312        ENDIF
3313C
3314        NUMROW=ICNT
3315        DO2410I=1,NUMROW
3316          NTOT(I)=15
3317 2410   CONTINUE
3318C
3319        IFRST=.TRUE.
3320        ILAST=.TRUE.
3321        CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
3322     1              NCTEXT,AVALUE,IDIGIT,
3323     1              NTOT,NUMROW,
3324     1              ICAPSW,ICAPTY,ILAST,IFRST,
3325     1              ISUBRO,IBUGA3,IERROR)
3326C
3327      ENDIF
3328C
3329C               *****************
3330C               **  STEP 90--  **
3331C               **  EXIT       **
3332C               *****************
3333C
3334      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2')THEN
3335        WRITE(ICOUT,999)
3336        CALL DPWRST('XXX','BUG ')
3337        WRITE(ICOUT,9011)
3338 9011   FORMAT('***** AT THE END       OF DPLOW2--')
3339        CALL DPWRST('XXX','BUG ')
3340        WRITE(ICOUT,9013)IERROR,N,NUMVAR
3341 9013   FORMAT('IERROR,N,NUMVAR = ',A4,2X,2I8)
3342        CALL DPWRST('XXX','BUG ')
3343        DO9020I=1,N
3344          WRITE(ICOUT,9021)I,PRED2(I),RES2(I)
3345 9021     FORMAT('I,PRED2(I),RES2(I) = ',I8,2G15.7)
3346          CALL DPWRST('XXX','BUG ')
3347 9020   CONTINUE
3348      ENDIF
3349C
3350      RETURN
3351      END
3352      SUBROUTINE DPLRDI(MAXNXT,ICAPSW,IFORSW,ISEED,
3353     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
3354C
3355C     PURPOSE--DISTINGUISH BETWEEN TWO DISTRIBUTIONS BASED ON THE
3356C              RATIO OF THE LIKELIHOOD FUNCTIONS.  IN MANY CASES,
3357C              SEVERAL DISTRIBUTIONS MAY BOTH FIT A GIVEN DATASET.
3358C              THE LIKELIHOOD RATIO TEST PROVIDES A METHOD FOR
3359C              CHOOSING BETWEEN THE TWO.  THIS IS GENERALLY MORE
3360C              POWERFUL THAN K-S OR ANDERSON-DARLING TEST BEACAUSE
3361C              WE ARE TESTING A SPECIFIC ALTERNATIVE RATHER THAN
3362C              ANY ALTERNATIVE DISTRIBUTION.
3363C
3364C     WRITTEN BY--ALAN HECKERT
3365C                 STATISTICAL ENGINEERING DIVISION
3366C                 INFORMATION TECHNOLOGY LABORAOTRY
3367C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
3368C                 GAITHERSBURG, MD 20899-8980
3369C                 PHONE--301-975-2899
3370C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
3371C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
3372C     LANGUAGE--ANSI FORTRAN (1977)
3373C     VERSION NUMBER--2014/5
3374C     ORIGINAL VERSION--MAY       2014.
3375C     UPDATED         --JULY      2019. TWEAK SCRATCH STORAGE
3376C
3377C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
3378C
3379      CHARACTER*4 ICAPSW
3380      CHARACTER*4 IFORSW
3381      CHARACTER*4 IBUGA2
3382      CHARACTER*4 IBUGA3
3383      CHARACTER*4 IBUGQ
3384      CHARACTER*4 ISUBRO
3385      CHARACTER*4 IFOUND
3386      CHARACTER*4 IERROR
3387C
3388      CHARACTER*4 ICASAN
3389      CHARACTER*4 ICASPL
3390      CHARACTER*4 ICASP2
3391      CHARACTER*4 ISUBN1
3392      CHARACTER*4 ISUBN2
3393      CHARACTER*4 ISTEPN
3394      CHARACTER*4 ICASE
3395      CHARACTER*4 IFLAGU
3396      CHARACTER*4 IMULT
3397C
3398      LOGICAL IFRST
3399      LOGICAL ILAST
3400C
3401      CHARACTER*4 IREPL
3402      CHARACTER*4 IRANSV
3403      CHARACTER*4 IRELAT
3404C
3405      CHARACTER*60 IDIST1
3406      CHARACTER*60 IDIST2
3407      CHARACTER*40 INAME
3408C
3409      PARAMETER (MAXSPN=30)
3410      CHARACTER*4 IVARN1(MAXSPN)
3411      CHARACTER*4 IVARN2(MAXSPN)
3412      CHARACTER*4 IVARTY(MAXSPN)
3413      CHARACTER*4 IVARID(7)
3414      CHARACTER*4 IVARI2(7)
3415      REAL PVAR(MAXSPN)
3416      REAL PID(7)
3417      INTEGER ILIS(MAXSPN)
3418      INTEGER NRIGHT(MAXSPN)
3419      INTEGER ICOLR(MAXSPN)
3420C
3421C---------------------------------------------------------------------
3422C
3423      INCLUDE 'DPCOPA.INC'
3424C
3425      DIMENSION Y1(MAXOBV)
3426      DIMENSION TEMP1(MAXOBV)
3427      DIMENSION TEMP2(MAXOBV)
3428      DIMENSION TEMP3(MAXOBV)
3429      DIMENSION TEMP4(MAXOBV)
3430      DIMENSION TEMP5(MAXOBV)
3431      DIMENSION TEMP6(MAXOBV)
3432      DIMENSION TEMP7(MAXOBV)
3433      DIMENSION YTEMP(MAXOBV)
3434      DIMENSION YSTAT(MAXOBV)
3435C
3436      DIMENSION XDESGN(MAXOBV,6)
3437      DIMENSION XIDTEM(MAXOBV)
3438      DIMENSION XIDTE2(MAXOBV)
3439      DIMENSION XIDTE3(MAXOBV)
3440      DIMENSION XIDTE4(MAXOBV)
3441      DIMENSION XIDTE5(MAXOBV)
3442      DIMENSION XIDTE6(MAXOBV)
3443      DIMENSION ZY(MAXOBV)
3444C
3445      DOUBLE PRECISION DTEMP1(MAXOBV)
3446      DOUBLE PRECISION DTEMP2(MAXOBV)
3447      DOUBLE PRECISION DTEMP3(MAXOBV)
3448C
3449      DIMENSION ITEMP1(MAXOBV)
3450C
3451      INCLUDE 'DPCOZZ.INC'
3452      INCLUDE 'DPCOZD.INC'
3453      INCLUDE 'DPCOZI.INC'
3454C
3455      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
3456      EQUIVALENCE (GARBAG(IGARB2),TEMP1(1))
3457      EQUIVALENCE (GARBAG(IGARB3),TEMP2(1))
3458      EQUIVALENCE (GARBAG(IGARB4),TEMP3(1))
3459      EQUIVALENCE (GARBAG(IGARB5),TEMP4(1))
3460      EQUIVALENCE (GARBAG(IGARB6),TEMP5(1))
3461      EQUIVALENCE (GARBAG(IGARB7),TEMP6(1))
3462      EQUIVALENCE (GARBAG(IGARB8),TEMP7(1))
3463      EQUIVALENCE (GARBAG(IGARB9),YTEMP(1))
3464      EQUIVALENCE (GARBAG(IGAR10),XIDTEM(1))
3465      EQUIVALENCE (GARBAG(JGAR11),XIDTE2(1))
3466      EQUIVALENCE (GARBAG(JGAR12),XIDTE3(1))
3467      EQUIVALENCE (GARBAG(JGAR13),XIDTE4(1))
3468      EQUIVALENCE (GARBAG(JGAR14),XIDTE5(1))
3469      EQUIVALENCE (GARBAG(JGAR15),XIDTE6(1))
3470      EQUIVALENCE (GARBAG(JGAR16),ZY(1))
3471      EQUIVALENCE (GARBAG(JGAR17),YSTAT(1))
3472      EQUIVALENCE (GARBAG(JGAR18),XDESGN(1,1))
3473      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1))
3474      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2(1))
3475      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3(1))
3476      EQUIVALENCE (IGARBG(IDGAR1),ITEMP1(1))
3477C
3478C-----COMMON----------------------------------------------------------
3479C
3480      COMMON/ISED/ISED1,ISED2,ISED3,ISED4,ISED5,ISED6,
3481     1            ISED7,ISED8,ISED9,ISED10,ISED11
3482C
3483      INCLUDE 'DPCOHK.INC'
3484      INCLUDE 'DPCODA.INC'
3485      INCLUDE 'DPCOSU.INC'
3486      INCLUDE 'DPCOS2.INC'
3487      INCLUDE 'DPCOHO.INC'
3488      INCLUDE 'DPCOMC.INC'
3489      INCLUDE 'DPCOST.INC'
3490      INCLUDE 'DPCOP2.INC'
3491C
3492C-----START POINT-----------------------------------------------------
3493C
3494      IERROR='NO'
3495      ICASAN='    '
3496      ICASPL='    '
3497      ICASP2='    '
3498      IRELAT='OFF'
3499      IREPL='OFF'
3500      IMULT='OFF'
3501      IRANSV=IRANAL
3502      IRANAL='FIBC'
3503      ISEESV=ISEED
3504      ISEED=16411
3505      NSAVE=-9999
3506C
3507      ISUBN1='DPLR'
3508      ISUBN2='DI  '
3509C
3510      MAXCP1=MAXCOL+1
3511      MAXCP2=MAXCOL+2
3512      MAXCP3=MAXCOL+3
3513      MAXCP4=MAXCOL+4
3514      MAXCP5=MAXCOL+5
3515      MAXCP6=MAXCOL+6
3516C
3517      MINN2=5
3518C
3519C               ***************************************************
3520C               **  TREAT THE <DIST1>  <DIST2>  DISTRIBUTIONAL   **
3521C               **            LIKELIHOOD RATIO TEST     CASE     **
3522C               ***************************************************
3523C
3524      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LRDI')THEN
3525        WRITE(ICOUT,999)
3526  999   FORMAT(1X)
3527        CALL DPWRST('XXX','BUG ')
3528        WRITE(ICOUT,51)
3529   51   FORMAT('***** AT THE BEGINNING OF DPLRDI--')
3530        CALL DPWRST('XXX','BUG ')
3531        WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ,MAXNXT
3532   53   FORMAT('IBUGA2,IBUGA3,IBUGQ,MAXNXT = ',3(A4,2X),I8)
3533        CALL DPWRST('XXX','BUG ')
3534      ENDIF
3535C
3536C               *****************************
3537C               **  STEP 1--               **
3538C               **  EXTRACT THE COMMAND    **
3539C               *****************************
3540C
3541C     LOOK FOR THE WORDS "DISTRIBUTIONAL LIKELIHOOD RATIO".  ALSO LOOK
3542C     ALSO LOOK FOR OPTIONAL KEYWORDS "REPLICATION",
3543C     AND "MULTIPLE". AND "TEST"
3544C
3545C     ALSO LOOK FOR THE WORD "AND".  THIS IS USED TO SEPARATE THE
3546C     TWO DISTRIBUTIONAL NAMES.  NOTE THAT IF BOTH DISTRIBUTIONS ARE
3547C     A SINGLE NAME, THEN THIS KEYWORD MAY BE OMITTED.  HOWEVER, IF
3548C     THIS IS NOT THE CASE AND THE "AND" KEYWORD IS NOT FOUND, REPORT
3549C     AN ERROR.
3550C
3551      ISTEPN='1'
3552      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')
3553     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3554C
3555      ILASTC=9999
3556      ILASTZ=9999
3557      ILASTA=9999
3558      IFOUND='NO'
3559      DO100I=1,NUMARG-1
3560        IF(IHARG(I).EQ.'DIST' .AND. IHARG(I+1).EQ.'LIKE' .AND.
3561     1     IHARG(I+2).EQ.'RATI')THEN
3562          IFOUND='YES'
3563          ICASAN='DLKR'
3564          ILASTC=MIN(ILASTC,I-1)
3565          ILASTZ=I+3
3566        ELSEIF(IHARG(I).EQ.'REPL')THEN
3567          IREPL='ON'
3568          ILASTC=MIN(ILASTC,I-1)
3569        ELSEIF(IHARG(I).EQ.'MULT')THEN
3570          IMULT='ON'
3571          ILASTC=MIN(ILASTC,I-1)
3572C
3573        ELSEIF(IHARG(I).EQ.'TEST')THEN
3574          IF(IHARG(I-3).EQ.'DIST' .AND. IHARG(I-2).EQ.'LIKE' .AND.
3575     1           IHARG(I-1).EQ.'RATI')THEN
3576            ILASTZ=I+1
3577          ENDIF
3578        ELSEIF(IHARG(I).EQ.'AND ')THEN
3579          ILASTA=I
3580        ENDIF
3581  100 CONTINUE
3582C
3583      IF(IFOUND.EQ.'NO')GOTO9000
3584      IF(IMULT.EQ.'ON')THEN
3585        IF(IREPL.EQ.'ON')THEN
3586          WRITE(ICOUT,999)
3587          CALL DPWRST('XXX','BUG ')
3588          WRITE(ICOUT,101)
3589  101     FORMAT('***** ERROR IN DISTRIBUTIONAL LIKELIHOOD RATIO TEST')
3590          CALL DPWRST('XXX','BUG ')
3591          WRITE(ICOUT,102)
3592  102     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
3593     1           '"REPLICATION" FOR THIS COMMAND.')
3594          CALL DPWRST('XXX','BUG ')
3595          IERROR='YES'
3596          GOTO9000
3597        ENDIF
3598      ENDIF
3599C
3600      IF(ILASTA.EQ.9999 .AND. ILASTC.NE.1)THEN
3601        WRITE(ICOUT,999)
3602        CALL DPWRST('XXX','BUG ')
3603        WRITE(ICOUT,101)
3604        CALL DPWRST('XXX','BUG ')
3605        WRITE(ICOUT,112)
3606  112   FORMAT('      AND KEYWORD TO SEPARATE DISTRIBUTION NAMES ',
3607     1         'NOT FOUND.')
3608        IERROR='YES'
3609        GOTO9000
3610      ENDIF
3611C
3612C               ***************************************************
3613C               **  STEP 2--EXTRACT THE FIRST DISTRIBUTION NAME  **
3614C               ***************************************************
3615C
3616      ISTEPN='2'
3617      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')THEN
3618        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3619        WRITE(ICOUT,211)IMULT,IREPL,ILASTC,ILASTZ
3620  211   FORMAT('IMULT,IREPL,ILASTC,ILASTZ = ',2(A4,2X),2I5)
3621        CALL DPWRST('XXX','BUG ')
3622      ENDIF
3623C
3624      JMIN=0
3625      IF(ILASTA.NE.9999)THEN
3626        JMAX=ILASTA-1
3627      ELSE
3628        JMAX=0
3629      ENDIF
3630C
3631      IDIST1=' '
3632      CALL EXTDIS(ICOM,ICOM2,IHARG,IHARG2,NUMARG,JMIN,JMAX,
3633     1            ICASPL,IDIST1,NUMSHA,IFOUND,ILOCV,
3634     1            ISUBRO,IBUGA3,IERROR)
3635C
3636      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')THEN
3637        WRITE(ICOUT,252)ICASPL,NUMSHA,IDIST1
3638  252   FORMAT('AFTER EXTDIS: ICASPL,NUMSHA,IDIST1 = ',A4,2X,I8,2X,A60)
3639        CALL DPWRST('XXX','BUG ')
3640      ENDIF
3641C
3642      IF(IFOUND.EQ.'NO')THEN
3643        WRITE(ICOUT,999)
3644        CALL DPWRST('XXX','BUG ')
3645        WRITE(ICOUT,101)
3646        CALL DPWRST('XXX','BUG ')
3647        WRITE(ICOUT,262)
3648  262   FORMAT('      NO MATCH FOUND FOR THE FIRST DISTRIBUTION NAME.')
3649        CALL DPWRST('XXX','BUG ')
3650        IERROR='YES'
3651        GOTO9000
3652      ENDIF
3653C
3654C               ***************************************************
3655C               **  STEP 3--EXTRACT THE SECOND DISTRIBUTION NAME **
3656C               ***************************************************
3657C
3658      ISTEPN='2'
3659      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')THEN
3660        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3661        WRITE(ICOUT,271)IMULT,IREPL,ILASTC,ILASTZ,ILASTA
3662  271   FORMAT('IMULT,IREPL,ILASTC,ILASTZ,ILASTA = ',2(A4,2X),3I5)
3663        CALL DPWRST('XXX','BUG ')
3664      ENDIF
3665C
3666      IF(ILASTA.NE.9999)THEN
3667        JMIN=ILASTA+1
3668      ELSE
3669        JMIN=1
3670      ENDIF
3671      JMAX=ILASTC
3672C
3673      IDIST2=' '
3674      CALL EXTDIS(ICOM,ICOM2,IHARG,IHARG2,NUMARG,JMIN,JMAX,
3675     1            ICASP2,IDIST2,NUMSHA,IFOUND,ILOCV,
3676     1            ISUBRO,IBUGA3,IERROR)
3677C
3678      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')THEN
3679        WRITE(ICOUT,254)ICASP2,NUMSHA,IDIST2
3680  254   FORMAT('AFTER EXTDIS: ICASP2,NUMSHA,IDIST2 = ',A4,2X,I8,2X,A60)
3681        CALL DPWRST('XXX','BUG ')
3682      ENDIF
3683C
3684      IF(IFOUND.EQ.'NO')THEN
3685        WRITE(ICOUT,999)
3686        CALL DPWRST('XXX','BUG ')
3687        WRITE(ICOUT,101)
3688        CALL DPWRST('XXX','BUG ')
3689        WRITE(ICOUT,264)
3690  264   FORMAT('      NO MATCH FOUND FOR SECOND DISTRIBUTION NAME.')
3691        CALL DPWRST('XXX','BUG ')
3692        IERROR='YES'
3693        GOTO9000
3694      ELSE
3695        ISHIFT=ILASTZ-1
3696        IF(ISHIFT.GT.0)THEN
3697          CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
3698        ENDIF
3699      ENDIF
3700C
3701C               *********************************
3702C               **  STEP 4--                   **
3703C               **  EXTRACT THE VARIABLE LIST  **
3704C               *********************************
3705C
3706      ISTEPN='4'
3707      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')
3708     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3709C
3710      INAME='DISTRIBUTIONAL LIKELIHOOD RATIO TEST'
3711      MINNA=1
3712      MAXNA=100
3713      MINN2=2
3714      IFLAGE=1
3715      IF(IMULT.EQ.'ON')IFLAGE=0
3716      IFLAGM=1
3717      IF(IREPL.EQ.'ON')IFLAGM=0
3718      IFLAGP=0
3719      JMIN=1
3720      JMAX=NUMARG
3721      MINNVA=-99
3722      MAXNVA=-99
3723C
3724      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
3725     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
3726     1            JMIN,JMAX,
3727     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
3728     1            IVARN1,IVARN2,IVARTY,PVAR,
3729     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
3730     1            MINNVA,MAXNVA,
3731     1            IFLAGM,IFLAGP,
3732     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
3733      IF(IERROR.EQ.'YES')GOTO9000
3734C
3735      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')THEN
3736        WRITE(ICOUT,999)
3737        CALL DPWRST('XXX','BUG ')
3738        WRITE(ICOUT,281)
3739  281   FORMAT('***** AFTER CALL DPPARS--')
3740        CALL DPWRST('XXX','BUG ')
3741        WRITE(ICOUT,282)NQ,NUMVAR
3742  282   FORMAT('NQ,NUMVAR = ',2I8)
3743        CALL DPWRST('XXX','BUG ')
3744        IF(NUMVAR.GT.0)THEN
3745          DO285I=1,NUMVAR
3746            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
3747     1                      ICOLR(I)
3748  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
3749     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
3750            CALL DPWRST('XXX','BUG ')
3751  285     CONTINUE
3752        ENDIF
3753      ENDIF
3754C
3755C               ***********************************************
3756C               **  STEP 5--                                 **
3757C               **  DETERMINE:                               **
3758C               **  1) NUMBER OF REPLICATION VARIABLES (0-6) **
3759C               **  2) NUMBER OF CENSORING   VARIABLES (0-1) **
3760C               **  3) NUMBER OF GROUPING    VARIABLES (0-2) **
3761C               **  4) NUMBER OF RESPONSE    VARIABLES (>= 1)**
3762C               ***********************************************
3763C
3764      ISTEPN='5'
3765      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')
3766     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3767C
3768      NRESP=0
3769      NREPL=0
3770      NRESP=NUMVAR
3771      IF(IREPL.EQ.'ON')THEN
3772        NRESP=1
3773        NREPL=NUMVAR-NRESP
3774        IF(NREPL.LT.1 .OR. NREPL.GT.6)THEN
3775          WRITE(ICOUT,999)
3776          CALL DPWRST('XXX','BUG ')
3777          WRITE(ICOUT,101)
3778          CALL DPWRST('XXX','BUG ')
3779          WRITE(ICOUT,511)
3780  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
3781     1           'REPLICATION VARIABLES')
3782          CALL DPWRST('XXX','BUG ')
3783          WRITE(ICOUT,513)NREPL
3784  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
3785          CALL DPWRST('XXX','BUG ')
3786          IERROR='YES'
3787          GOTO9000
3788        ENDIF
3789      ENDIF
3790C
3791C               ***********************************************
3792C               **  STEP 6--                                 **
3793C               **  GENERATE THE DISTRIBUTIONAL LIKELIHOOD   **
3794C               **  RATIO TEST       FOR THE VARIOUS CASES.  **
3795C               ***********************************************
3796C
3797      ISTEPN='6'
3798      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')
3799     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3800C
3801C               ******************************************
3802C               **  STEP 7A--                           **
3803C               **  CASE 1: NO REPLICATION CASE         **
3804C               ******************************************
3805C
3806      IF(NRESP.GE.1 .AND. IREPL.EQ.'OFF')THEN
3807        ISTEPN='7A'
3808        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')
3809     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3810C
3811C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
3812C
3813        NCURVE=0
3814        DO710IRESP=1,NRESP
3815          NCURVE=NCURVE+1
3816C
3817          IINDX=ICOLR(IRESP)
3818          PID(1)=CPUMIN
3819          IVARID(1)=IVARN1(IRESP)
3820          IVARI2(1)=IVARN2(IRESP)
3821C
3822          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')THEN
3823            WRITE(ICOUT,999)
3824            CALL DPWRST('XXX','BUG ')
3825            WRITE(ICOUT,711)IRESP,NCURVE
3826  711       FORMAT('IRESP,NCURVE = ',2I5)
3827            CALL DPWRST('XXX','BUG ')
3828          ENDIF
3829C
3830          ICOL=IRESP
3831          NUMVA2=1
3832          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
3833     1                INAME,IVARN1,IVARN2,IVARTY,
3834     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
3835     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
3836     1                MAXCP4,MAXCP5,MAXCP6,
3837     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
3838     1                Y1,TEMP1,TEMP1,NS1,NS2,NS3,ICASE,
3839     1                IBUGA3,ISUBRO,IFOUND,IERROR)
3840          IF(IERROR.EQ.'YES')GOTO9000
3841C
3842          ISTEPN='7B'
3843          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')
3844     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3845C
3846          CALL DPLRD2(Y1,NS1,ICASPL,IDIST1,ICASP2,IDIST2,MAXOBV,
3847     1                PID,IVARID,IVARI2,NREPL,MINMAX,
3848     1                TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
3849     1                YTEMP,YSTAT,
3850     1                DTEMP1,DTEMP2,DTEMP3,ITEMP1,
3851     1                IADEDF,IGEPDF,IMAKDF,IBEIDF,
3852     1                ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
3853     1                IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
3854     1                IEXPBC,IWEIBC,ICENTY,IDFTTY,
3855     1                IFLAGL,AL,
3856     1                IFORSW,ICAPSW,ICAPTY,ISEED,
3857     1                CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
3858     1                STATVA,STATCD,PVAL,CV90,CV95,CV99,
3859     1                APOW90,APOW95,APOW99,
3860     1                IBUGA3,ISUBRO,IERROR)
3861C
3862C               ***************************************
3863C               **  UPDATE INTERNAL DATAPLOT TABLES  **
3864C               ***************************************
3865C
3866          ISTEPN='7C'
3867          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')
3868     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3869C
3870          IFLAGU='FILE'
3871          IF(NRESP.EQ.1)IFLAGU='ON'
3872          IFRST=.FALSE.
3873          ILAST=.FALSE.
3874          IF(IRESP.EQ.1)IFRST=.TRUE.
3875          IF(IRESP.EQ.NRESP)ILAST=.TRUE.
3876          CALL DPLRD4(STATVA,STATCD,PVAL,CV90,CV95,CV99,
3877     1                APOW90,APOW95,APOW99,
3878     1                IFLAGU,IFRST,ILAST,ICASAN,
3879     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
3880C
3881  710   CONTINUE
3882C
3883C               ***************************************************
3884C               **  STEP 8A--                                    **
3885C               **  CASE 3: ONE OR MORE REPLICATION VARIABLES.   **
3886C               ***************************************************
3887C
3888      ELSEIF(NRESP.EQ.1 .AND. NREPL.GE.1)THEN
3889        ISTEPN='8A'
3890        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LRDI')
3891     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
3892C
3893        PID(1)=CPUMIN
3894        IVARID(1)=IVARN1(1)
3895        IVARI2(1)=IVARN2(1)
3896        IADD=1
3897        DO903II=1,NREPL
3898          IVARID(II+1)=IVARN1(II+IADD)
3899          IVARI2(II+1)=IVARN2(II+IADD)
3900  903   CONTINUE
3901C
3902        ICOL=1
3903        NUMVA2=1
3904        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
3905     1              INAME,IVARN1,IVARN2,IVARTY,
3906     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
3907     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
3908     1              MAXCP4,MAXCP5,MAXCP6,
3909     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
3910     1              Y1,TEMP1,TEMP1,NS1,NS2,NS3,ICASE,
3911     1              IBUGA3,ISUBRO,IFOUND,IERROR)
3912        IF(IERROR.EQ.'YES')GOTO9000
3913C
3914C       *****************************************************
3915C       **  STEP 9C--                                      **
3916C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
3917C       **  REPLICATION VARIABLES.                         **
3918C       *****************************************************
3919C
3920        CALL DPPP5(XDESGN(1,1),XDESGN(1,2),XDESGN(1,3),
3921     1             XDESGN(1,4),XDESGN(1,5),XDESGN(1,6),
3922     1             NREPL,NLOCAL,MAXOBV,
3923     1             XIDTEM,XIDTE2,XIDTE3,XIDTE4,XIDTE5,XIDTE6,
3924     1             TEMP1,TEMP2,
3925     1             NUMSE1,NUMSE2,NUMSE3,NUMSE4,NUMSE5,NUMSE6,
3926     1             IBUGA3,ISUBRO,IERROR)
3927C
3928C       *****************************************************
3929C       **  STEP 9D--                                      **
3930C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
3931C       *****************************************************
3932C
3933        NPLOTP=0
3934        NCURVE=0
3935        IF(NREPL.EQ.1)THEN
3936          J=0
3937          DO1110ISET1=1,NUMSE1
3938            K=0
3939            PID(2)=XIDTEM(ISET1)
3940            DO1130I=1,NLOCAL
3941              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
3942                K=K+1
3943                ZY(K)=Y1(I)
3944              ENDIF
3945 1130       CONTINUE
3946            NTEMP=K
3947            NCURVE=NCURVE+1
3948            NPLOT1=NPLOTP
3949            IF(NTEMP.GT.0)THEN
3950              CALL DPLRD2(ZY,NTEMP,ICASPL,IDIST1,ICASP2,IDIST2,MAXOBV,
3951     1                    PID,IVARID,IVARI2,NREPL,MINMAX,
3952     1                    TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
3953     1                    YTEMP,YSTAT,
3954     1                    DTEMP1,DTEMP2,DTEMP3,ITEMP1,
3955     1                    IADEDF,IGEPDF,IMAKDF,IBEIDF,
3956     1                    ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
3957     1                    IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
3958     1                    IEXPBC,IWEIBC,ICENTY,IDFTTY,
3959     1                    IFLAGL,AL,
3960     1                    IFORSW,ICAPSW,ICAPTY,ISEED,
3961     1                    CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
3962     1                    STATVA,STATCD,PVAL,CV90,CV95,CV99,
3963     1                    APOW90,APOW95,APOW99,
3964     1                    IBUGA3,ISUBRO,IERROR)
3965C
3966            ENDIF
3967            NPLOT2=NPLOTP
3968            IFLAGU='FILE'
3969            IFRST=.FALSE.
3970            ILAST=.FALSE.
3971            IF(NCURVE.EQ.1)IFRST=.TRUE.
3972            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
3973            NPTEMP=NPLOT2-NPLOT1
3974            CALL DPLRD4(STATVA,STATCD,PVAL,CV90,CV95,CV99,
3975     1                  APOW90,APOW95,APOW99,
3976     1                  IFLAGU,IFRST,ILAST,ICASAN,
3977     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
3978 1110     CONTINUE
3979        ELSEIF(NREPL.EQ.2)THEN
3980          J=0
3981          NTOT=NUMSE1*NUMSE2
3982          DO1210ISET1=1,NUMSE1
3983          DO1220ISET2=1,NUMSE2
3984            K=0
3985            PID(2)=XIDTEM(ISET1)
3986            PID(3)=XIDTE2(ISET2)
3987            DO1290I=1,NLOCAL
3988              IF(
3989     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
3990     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
3991     1          )THEN
3992                K=K+1
3993                ZY(K)=Y1(I)
3994              ENDIF
3995 1290       CONTINUE
3996            NTEMP=K
3997            NCURVE=NCURVE+1
3998            NPLOT1=NPLOTP
3999            IF(NTEMP.GT.0)THEN
4000              CALL DPLRD2(ZY,NTEMP,ICASPL,IDIST1,ICASP2,IDIST2,MAXOBV,
4001     1                    PID,IVARID,IVARI2,NREPL,MINMAX,
4002     1                    TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4003     1                    YTEMP,YSTAT,
4004     1                    DTEMP1,DTEMP2,DTEMP3,ITEMP1,
4005     1                    IADEDF,IGEPDF,IMAKDF,IBEIDF,
4006     1                    ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
4007     1                    IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
4008     1                    IEXPBC,IWEIBC,ICENTY,IDFTTY,
4009     1                    IFLAGL,AL,
4010     1                    IFORSW,ICAPSW,ICAPTY,ISEED,
4011     1                    CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4012     1                    STATVA,STATCD,PVAL,CV90,CV95,CV99,
4013     1                    APOW90,APOW95,APOW99,
4014     1                    IBUGA3,ISUBRO,IERROR)
4015C
4016            ENDIF
4017            NPLOT2=NPLOTP
4018            IFLAGU='FILE'
4019            IFRST=.FALSE.
4020            ILAST=.FALSE.
4021            IF(NCURVE.EQ.1)IFRST=.TRUE.
4022            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
4023            NPTEMP=NPLOT2-NPLOT1
4024            CALL DPLRD4(STATVA,STATCD,PVAL,CV90,CV95,CV99,
4025     1                  APOW90,APOW95,APOW99,
4026     1                  IFLAGU,IFRST,ILAST,ICASAN,
4027     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
4028 1220     CONTINUE
4029 1210     CONTINUE
4030        ELSEIF(NREPL.EQ.3)THEN
4031          J=0
4032          NTOT=NUMSE1*NUMSE2*NUMSE3
4033          DO1310ISET1=1,NUMSE1
4034          DO1320ISET2=1,NUMSE2
4035          DO1330ISET3=1,NUMSE3
4036            K=0
4037            PID(2)=XIDTEM(ISET1)
4038            PID(3)=XIDTE2(ISET2)
4039            PID(4)=XIDTE3(ISET3)
4040            DO1390I=1,NLOCAL
4041              IF(
4042     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
4043     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
4044     1           XIDTE3(ISET3).EQ.XDESGN(I,3)
4045     1          )THEN
4046                K=K+1
4047                ZY(K)=Y1(I)
4048              ENDIF
4049 1390       CONTINUE
4050            NTEMP=K
4051            NCURVE=NCURVE+1
4052            NPLOT1=NPLOTP
4053            IF(NTEMP.GT.0)THEN
4054              CALL DPLRD2(ZY,NTEMP,ICASPL,IDIST1,ICASP2,IDIST2,MAXOBV,
4055     1                    PID,IVARID,IVARI2,NREPL,MINMAX,
4056     1                    TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4057     1                    YTEMP,YSTAT,
4058     1                    DTEMP1,DTEMP2,DTEMP3,ITEMP1,
4059     1                    IADEDF,IGEPDF,IMAKDF,IBEIDF,
4060     1                    ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
4061     1                    IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
4062     1                    IEXPBC,IWEIBC,ICENTY,IDFTTY,
4063     1                    IFLAGL,AL,
4064     1                    IFORSW,ICAPSW,ICAPTY,ISEED,
4065     1                    CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4066     1                    STATVA,STATCD,PVAL,CV90,CV95,CV99,
4067     1                    APOW90,APOW95,APOW99,
4068     1                    IBUGA3,ISUBRO,IERROR)
4069C
4070            ENDIF
4071            NPLOT2=NPLOTP
4072            IFLAGU='FILE'
4073            IFRST=.FALSE.
4074            ILAST=.FALSE.
4075            IF(NCURVE.EQ.1)IFRST=.TRUE.
4076            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
4077            NPTEMP=NPLOT2-NPLOT1
4078            CALL DPLRD4(STATVA,STATCD,PVAL,CV90,CV95,CV99,
4079     1                  APOW90,APOW95,APOW99,
4080     1                  IFLAGU,IFRST,ILAST,ICASAN,
4081     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
4082 1330     CONTINUE
4083 1320     CONTINUE
4084 1310     CONTINUE
4085        ELSEIF(NREPL.EQ.4)THEN
4086          J=0
4087          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4
4088          DO1410ISET1=1,NUMSE1
4089          DO1420ISET2=1,NUMSE2
4090          DO1430ISET3=1,NUMSE3
4091          DO1440ISET4=1,NUMSE4
4092            K=0
4093            PID(2)=XIDTEM(ISET1)
4094            PID(3)=XIDTE2(ISET2)
4095            PID(4)=XIDTE3(ISET3)
4096            PID(5)=XIDTE4(ISET4)
4097            DO1490I=1,NLOCAL
4098              IF(
4099     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
4100     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
4101     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
4102     1           XIDTE4(ISET4).EQ.XDESGN(I,4)
4103     1          )THEN
4104                K=K+1
4105                ZY(K)=Y1(I)
4106              ENDIF
4107 1490       CONTINUE
4108            NTEMP=K
4109            NCURVE=NCURVE+1
4110            NPLOT1=NPLOTP
4111            IF(NTEMP.GT.0)THEN
4112              CALL DPLRD2(ZY,NTEMP,ICASPL,IDIST1,ICASP2,IDIST2,MAXOBV,
4113     1                    PID,IVARID,IVARI2,NREPL,MINMAX,
4114     1                    TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4115     1                    YTEMP,YSTAT,
4116     1                    DTEMP1,DTEMP2,DTEMP3,ITEMP1,
4117     1                    IADEDF,IGEPDF,IMAKDF,IBEIDF,
4118     1                    ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
4119     1                    IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
4120     1                    IEXPBC,IWEIBC,ICENTY,IDFTTY,
4121     1                    IFLAGL,AL,
4122     1                    IFORSW,ICAPSW,ICAPTY,ISEED,
4123     1                    CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4124     1                    STATVA,STATCD,PVAL,CV90,CV95,CV99,
4125     1                    APOW90,APOW95,APOW99,
4126     1                    IBUGA3,ISUBRO,IERROR)
4127C
4128            ENDIF
4129            NPLOT2=NPLOTP
4130            IFLAGU='FILE'
4131            IFRST=.FALSE.
4132            ILAST=.FALSE.
4133            IF(NCURVE.EQ.1)IFRST=.TRUE.
4134            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
4135            NPTEMP=NPLOT2-NPLOT1
4136            CALL DPLRD4(STATVA,STATCD,PVAL,CV90,CV95,CV99,
4137     1                  APOW90,APOW95,APOW99,
4138     1                  IFLAGU,IFRST,ILAST,ICASAN,
4139     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
4140 1440     CONTINUE
4141 1430     CONTINUE
4142 1420     CONTINUE
4143 1410     CONTINUE
4144        ELSEIF(NREPL.EQ.5)THEN
4145          J=0
4146          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5
4147          DO1510ISET1=1,NUMSE1
4148          DO1520ISET2=1,NUMSE2
4149          DO1530ISET3=1,NUMSE3
4150          DO1540ISET4=1,NUMSE4
4151          DO1550ISET5=1,NUMSE5
4152            K=0
4153            PID(2)=XIDTEM(ISET1)
4154            PID(3)=XIDTE2(ISET2)
4155            PID(4)=XIDTE3(ISET3)
4156            PID(5)=XIDTE4(ISET4)
4157            PID(6)=XIDTE5(ISET5)
4158            DO1590I=1,NLOCAL
4159              IF(
4160     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
4161     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
4162     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
4163     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
4164     1           XIDTE5(ISET5).EQ.XDESGN(I,5)
4165     1          )THEN
4166                K=K+1
4167                ZY(K)=Y1(I)
4168              ENDIF
4169 1590       CONTINUE
4170            NTEMP=K
4171            NCURVE=NCURVE+1
4172            NPLOT1=NPLOTP
4173            IF(NTEMP.GT.0)THEN
4174              CALL DPLRD2(ZY,NTEMP,ICASPL,IDIST1,ICASP2,IDIST2,MAXOBV,
4175     1                    PID,IVARID,IVARI2,NREPL,MINMAX,
4176     1                    TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4177     1                    YTEMP,YSTAT,
4178     1                    DTEMP1,DTEMP2,DTEMP3,ITEMP1,
4179     1                    IADEDF,IGEPDF,IMAKDF,IBEIDF,
4180     1                    ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
4181     1                    IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
4182     1                    IEXPBC,IWEIBC,ICENTY,IDFTTY,
4183     1                    IFLAGL,AL,
4184     1                    IFORSW,ICAPSW,ICAPTY,ISEED,
4185     1                    CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4186     1                    STATVA,STATCD,PVAL,CV90,CV95,CV99,
4187     1                    APOW90,APOW95,APOW99,
4188     1                    IBUGA3,ISUBRO,IERROR)
4189C
4190            ENDIF
4191            NPLOT2=NPLOTP
4192            IFLAGU='FILE'
4193            IFRST=.FALSE.
4194            ILAST=.FALSE.
4195            IF(NCURVE.EQ.1)IFRST=.TRUE.
4196            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
4197            NPTEMP=NPLOT2-NPLOT1
4198            CALL DPLRD4(STATVA,STATCD,PVAL,CV90,CV95,CV99,
4199     1                  APOW90,APOW95,APOW99,
4200     1                  IFLAGU,IFRST,ILAST,ICASAN,
4201     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
4202 1550     CONTINUE
4203 1540     CONTINUE
4204 1530     CONTINUE
4205 1520     CONTINUE
4206 1510     CONTINUE
4207        ELSEIF(NREPL.EQ.6)THEN
4208          J=0
4209          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5*NUMSE6
4210          DO1610ISET1=1,NUMSE1
4211          DO1620ISET2=1,NUMSE2
4212          DO1630ISET3=1,NUMSE3
4213          DO1640ISET4=1,NUMSE4
4214          DO1650ISET5=1,NUMSE5
4215          DO1660ISET6=1,NUMSE6
4216            K=0
4217            PID(2)=XIDTEM(ISET1)
4218            PID(3)=XIDTE2(ISET2)
4219            PID(4)=XIDTE3(ISET3)
4220            PID(5)=XIDTE4(ISET4)
4221            PID(6)=XIDTE5(ISET5)
4222            PID(7)=XIDTE6(ISET6)
4223            DO1690I=1,NLOCAL
4224              IF(
4225     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
4226     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
4227     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
4228     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
4229     1           XIDTE5(ISET5).EQ.XDESGN(I,5) .AND.
4230     1           XIDTE6(ISET6).EQ.XDESGN(I,6)
4231     1          )THEN
4232                K=K+1
4233                ZY(K)=Y1(I)
4234              ENDIF
4235 1690       CONTINUE
4236            NTEMP=K
4237            NCURVE=NCURVE+1
4238            NPLOT1=NPLOTP
4239            IF(NTEMP.GT.0)THEN
4240              CALL DPLRD2(ZY,NTEMP,ICASPL,IDIST1,ICASP2,IDIST2,MAXOBV,
4241     1                    PID,IVARID,IVARI2,NREPL,MINMAX,
4242     1                    TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4243     1                    YTEMP,YSTAT,
4244     1                    DTEMP1,DTEMP2,DTEMP3,ITEMP1,
4245     1                    IADEDF,IGEPDF,IMAKDF,IBEIDF,
4246     1                    ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
4247     1                    IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
4248     1                    IEXPBC,IWEIBC,ICENTY,IDFTTY,
4249     1                    IFLAGL,AL,
4250     1                    IFORSW,ICAPSW,ICAPTY,ISEED,
4251     1                    CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4252     1                    STATVA,STATCD,PVAL,CV90,CV95,CV99,
4253     1                    APOW90,APOW95,APOW99,
4254     1                    IBUGA3,ISUBRO,IERROR)
4255C
4256            ENDIF
4257            NPLOT2=NPLOTP
4258            IFLAGU='FILE'
4259            IFRST=.FALSE.
4260            ILAST=.FALSE.
4261            IF(NCURVE.EQ.1)IFRST=.TRUE.
4262            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
4263            NPTEMP=NPLOT2-NPLOT1
4264            CALL DPLRD4(STATVA,STATCD,PVAL,CV90,CV95,CV99,
4265     1                  APOW90,APOW95,APOW99,
4266     1                  IFLAGU,IFRST,ILAST,ICASAN,
4267     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
4268 1660     CONTINUE
4269 1650     CONTINUE
4270 1640     CONTINUE
4271 1630     CONTINUE
4272 1620     CONTINUE
4273 1610     CONTINUE
4274        ENDIF
4275C
4276      ENDIF
4277C
4278C               *****************
4279C               **  STEP 90--  **
4280C               **  EXIT       **
4281C               *****************
4282C
4283 9000 CONTINUE
4284C
4285      IRANAL=IRANSV
4286      ISEED=ISEESV
4287C
4288      IF(IERROR.EQ.'YES')THEN
4289        IF(IWIDTH.GE.1)THEN
4290          WRITE(ICOUT,9001)(IANS(I),I=1,MIN(100,IWIDTH))
4291 9001     FORMAT(100A1)
4292          CALL DPWRST('XXX','BUG ')
4293        ENDIF
4294      ENDIF
4295C
4296      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LRDI')THEN
4297        WRITE(ICOUT,999)
4298        CALL DPWRST('XXX','BUG ')
4299        WRITE(ICOUT,9011)
4300 9011   FORMAT('***** AT THE END       OF DPLRDI--')
4301        CALL DPWRST('XXX','BUG ')
4302        WRITE(ICOUT,9012)IFOUND,IERROR
4303 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
4304        CALL DPWRST('XXX','BUG ')
4305      ENDIF
4306C
4307      RETURN
4308      END
4309      SUBROUTINE DPLRD2(Y,N,ICASPL,IDIST1,ICASP2,IDIST2,MAXOBV,
4310     1                  PID,IVARID,IVARI2,NREPL,MINMAX,
4311     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4312     1                  YTEMP,YSTAT,
4313     1                  DTEMP1,DTEMP2,DTEMP3,ITEMP1,
4314     1                  IADEDF,IGEPDF,IMAKDF,IBEIDF,
4315     1                  ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
4316     1                  IGOMDF,IKATDF,IGIGDF,IGEODF,IGAUDF,
4317     1                  IEXPBC,IWEIBC,ICENTY,IDFTTY,
4318     1                  IFLAGL,AL,
4319     1                  IFORSW,ICAPSW,ICAPTY,ISEED,
4320     1                  CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4321     1                  STATVA,STATCD,PVAL,CV90,CV95,CV99,
4322     1                  APOW90,APOW95,APOW99,
4323     1                  IBUGA3,ISUBRO,IERROR)
4324C
4325C     PURPOSE--DISTINGUISH BETWEEN TWO DISTRIBUTIONS BASED ON THE
4326C              RATIO OF THE LIKELIHOOD FUNCTIONS.  IN MANY CASES,
4327C              SEVERAL DISTRIBUTIONS MAY BOTH FIT A GIVEN DATASET.
4328C              THE LIKELIHOOD RATIO TEST PROVIDES A METHOD FOR
4329C              CHOOSING BETWEEN THE TWO.  THIS IS GENERALLY MORE
4330C              POWERFUL THAN K-S OR ANDERSON-DARLING TEST BEACAUSE
4331C              WE ARE TESTING A SPECIFIC ALTERNATIVE RATHER THAN
4332C              ANY ALTERNATIVE DISTRIBUTION.
4333C
4334C              THE BASIC ALGORITHM IS:
4335C
4336C                1. FIT THE DATA  TO BOTH DISTRIBUTIONS USING
4337C                   MAXIMIMUM LIKELIHOOD.
4338C
4339C                2. COMPUTE THE LIKELIHOOD FUNCTION FOR BOTH
4340C                   DISTRIBUTIONS AND COMPUTE THE RATIO OF THE
4341C                   LIKELIHOODS (THE NULL HYPOTHESIS DISTRIBUTION
4342C                   IS USED FOR THE DENONIMATOR, THE ALTERNATIVE
4343C                   HYPOTHESIS DISTRIBUTION IS USED FOR THE
4344C                   NUMERATOR).  THIS IS THE TEST STATISTIC.
4345C
4346C                3. TO DETERMINE CRITICAL VALUES, SIMULATE 10,000
4347C                   RUNS FROM THE NULL HYPOTHESIS DISTRIBUTION
4348C                   AND COMPUTE THE ABOVE TEST STATISTIC.
4349C
4350C              NOTE THAT CURRENTLY ONLY UNGROUPED AND UNCENSORED DATA
4351C              IS SUPPORTED.
4352C
4353C     REFERENCES--DUMONCEAUX, ANTLE AND HAAS (1973), "LIKELIHOOD RATIO
4354C                 TEST FOR DISCRMINATION BETWEEN TWO MODELS WITH UNKNOWN
4355C                 AND LOCATION AND SCALE PARAMETERS", TECHNOMETRICS,
4356C                 VOL. 15, NO. 1, PP. 19-27.
4357C               --DUMONCEAUX AND ANTLE (1973), "DISCRIMINATION BETWEEN
4358C                 THE LOG-NORMAL AND THE WEIBULL DISTRIBUTIONS",
4359C                 TECHNOMETRICS, VOL. 15, NO. 4, PP. 923-926.
4360C     WRITTEN BY--ALAN HECKERT
4361C                 STATISTICAL ENGINEERING DIVISION
4362C                 INFORMATION TECHNOLOGY LABORATORY
4363C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4364C                 GAITHERSBURG, MD 20899-8980
4365C                 PHONE--301-975-2899
4366C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4367C           OF THE NATIONAL BUREAU OF STANDARDS.
4368C     LANGUAGE--ANSI FORTRAN (1977)
4369C     VERSION NUMBER--2014/5
4370C     ORIGINAL VERSION--MAY       2014.
4371C
4372C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
4373C
4374      CHARACTER*4 ICASPL
4375      CHARACTER*4 ICASP2
4376      CHARACTER*4 IVARID(*)
4377      CHARACTER*4 IVARI2(*)
4378      CHARACTER*4 ICAPSW
4379      CHARACTER*4 ICAPTY
4380      CHARACTER*4 IFORSW
4381      CHARACTER*4 IBUGA3
4382      CHARACTER*4 ISUBRO
4383      CHARACTER*4 IWRITE
4384      CHARACTER*4 IADEDF
4385      CHARACTER*4 IGEPDF
4386      CHARACTER*4 IMAKDF
4387      CHARACTER*4 IBEIDF
4388      CHARACTER*4 ILGADF
4389      CHARACTER*4 ISKNDF
4390      CHARACTER*4 IGLDDF
4391      CHARACTER*4 IBGEDF
4392      CHARACTER*4 IGETDF
4393      CHARACTER*4 ICONDF
4394      CHARACTER*4 IGOMDF
4395      CHARACTER*4 IKATDF
4396      CHARACTER*4 IGIGDF
4397      CHARACTER*4 IGEODF
4398      CHARACTER*4 IGAUDF
4399      CHARACTER*4 IEXPBC
4400      CHARACTER*4 IWEIBC
4401      CHARACTER*4 ICENTY
4402      CHARACTER*4 IDFTTY
4403C
4404      CHARACTER*4 IHSTCW
4405      CHARACTER*4 IHSTOU
4406      CHARACTER*4 IRELAT
4407      CHARACTER*4 IRHSTG
4408C
4409      CHARACTER*4 IFOUND
4410      CHARACTER*4 IERROR
4411C
4412      CHARACTER*60 IDIST1
4413      CHARACTER*60 IDIST2
4414C
4415      CHARACTER*4 IDIR
4416      CHARACTER*4 ICENSO
4417      CHARACTER*4 ISUBN1
4418      CHARACTER*4 ISUBN2
4419      CHARACTER*4 ISTEPN
4420C
4421C---------------------------------------------------------------------
4422C
4423      DIMENSION Y(*)
4424      DIMENSION YTEMP(*)
4425      DIMENSION YSTAT(*)
4426      DIMENSION PID(*)
4427C
4428      DIMENSION TEMP1(*)
4429      DIMENSION TEMP2(*)
4430      DIMENSION TEMP3(*)
4431      DIMENSION TEMP4(*)
4432      DIMENSION TEMP5(*)
4433      DIMENSION TEMP6(*)
4434      DIMENSION TEMP7(*)
4435C
4436      DIMENSION CLWIDT(*)
4437      DIMENSION CLLIMI(*)
4438C
4439      DOUBLE PRECISION DTEMP1(*)
4440      DOUBLE PRECISION DTEMP2(*)
4441      DOUBLE PRECISION DTEMP3(*)
4442      INTEGER ITEMP1(*)
4443C
4444      DOUBLE PRECISION DSTAT
4445      DOUBLE PRECISION DN
4446C
4447      PARAMETER (NUMALP=7)
4448      REAL ALPHA(NUMALP)
4449C
4450      PARAMETER(NUMCLI=5)
4451      PARAMETER(MAXLIN=2)
4452      PARAMETER (MAXROW=40)
4453      CHARACTER*60 ITITLE
4454      CHARACTER*60 ITITLZ
4455      CHARACTER*1  ITITL9
4456      CHARACTER*60 ITEXT(MAXROW)
4457      CHARACTER*4  ALIGN(NUMCLI)
4458      CHARACTER*4  VALIGN(NUMCLI)
4459      REAL         AVALUE(MAXROW)
4460      INTEGER      NCTEXT(MAXROW)
4461      INTEGER      IDIGIT(MAXROW)
4462      INTEGER      NTOT(MAXROW)
4463      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
4464      CHARACTER*15 IVALUE(MAXROw,NUMCLI)
4465      CHARACTER*4  ITYPCO(NUMCLI)
4466      INTEGER      NCTIT2(MAXLIN,NUMCLI)
4467      INTEGER      NCVALU(MAXROW,NUMCLI)
4468      INTEGER      IWHTML(NUMCLI)
4469      INTEGER      IWRTF(NUMCLI)
4470      REAL         AMAT(MAXROW,NUMCLI)
4471      LOGICAL IFRST
4472      LOGICAL ILAST
4473      LOGICAL ISNANZ
4474C
4475C---------------------------------------------------------------------
4476C
4477      INCLUDE 'DPCOP2.INC'
4478C
4479      DATA ALPHA/
4480     1 50.0, 75.0, 80.0, 90.0, 95.0, 99.0, 99.9/
4481C
4482C-----START POINT-----------------------------------------------------
4483C
4484C
4485      ISUBN1='DPLR'
4486      ISUBN2='D2  '
4487      IERROR='NO'
4488      ICENSO='OFF'
4489      STATVA=CPUMIN
4490      STATCD=CPUMIN
4491      PVAL=CPUMIN
4492      CV50=CPUMIN
4493      CV75=CPUMIN
4494      CV90=CPUMIN
4495      CV95=CPUMIN
4496      CV99=CPUMIN
4497      APOW90=CPUMIN
4498      APOW95=CPUMIN
4499      APOW99=CPUMIN
4500      IFLGL1=1
4501      IFLGL2=1
4502      IFLGS1=1
4503      IFLGS2=1
4504C
4505      DO10I=1,100000
4506        YSTAT(I)=0.0
4507   10 CONTINUE
4508C
4509      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
4510        WRITE(ICOUT,999)
4511        CALL DPWRST('XXX','BUG ')
4512        WRITE(ICOUT,71)
4513   71   FORMAT('***** AT THE BEGINNING OF DPLRD2--')
4514        CALL DPWRST('XXX','BUG ')
4515        WRITE(ICOUT,72)ICASPL,ICASP2,N,MINMAX,IFLAGL,AL
4516   72   FORMAT('ICASPL,ICASP2,N,MINMAX,IFLAGL,AL = ',2(A4,2X),3I8,G15.7)
4517        CALL DPWRST('XXX','BUG ')
4518        IF(N.GE.1)THEN
4519          DO85I=1,N
4520            WRITE(ICOUT,86)I,Y(I)
4521   86       FORMAT('I,Y(I) = ',I8,G15.7)
4522            CALL DPWRST('XXX','BUG ')
4523   85     CONTINUE
4524        ENDIF
4525        WRITE(ICOUT,87)PID(1),NREPL
4526   87   FORMAT('PID(1),NREPL = ',G15.7,I8)
4527        CALL DPWRST('XXX','BUG ')
4528      ENDIF
4529C
4530C               ********************************************
4531C               **  STEP 1--                              **
4532C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
4533C               ********************************************
4534C
4535      ISTEPN='1'
4536      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4537     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4538C
4539      IF(N.LT.5)THEN
4540        WRITE(ICOUT,999)
4541  999   FORMAT(1X)
4542        CALL DPWRST('XXX','BUG ')
4543        WRITE(ICOUT,31)
4544   31   FORMAT('***** ERROR IN DISTRIBUTIONAL LIKELIHOOD RATIO TEST--')
4545        CALL DPWRST('XXX','BUG ')
4546        WRITE(ICOUT,32)
4547   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 5.')
4548        CALL DPWRST('XXX','BUG ')
4549        WRITE(ICOUT,34)N
4550   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
4551        CALL DPWRST('XXX','BUG ')
4552        WRITE(ICOUT,999)
4553        CALL DPWRST('XXX','BUG ')
4554        IERROR='YES'
4555        GOTO9000
4556      ENDIF
4557C
4558      HOLD=Y(1)
4559      DO60I=1,N
4560        IF(Y(I).NE.HOLD)GOTO69
4561   60 CONTINUE
4562      WRITE(ICOUT,999)
4563      CALL DPWRST('XXX','BUG ')
4564      WRITE(ICOUT,31)
4565      CALL DPWRST('XXX','BUG ')
4566      WRITE(ICOUT,62)HOLD
4567   62 FORMAT('      ALL ELEMENTS OF THE RESPONSE VARIABLE ARE ',
4568     1       'IDENTICALLY EQUAL TO ',G15.7)
4569
4570      CALL DPWRST('XXX','BUG ')
4571      WRITE(ICOUT,999)
4572      CALL DPWRST('XXX','BUG ')
4573      IERROR='YES'
4574      GOTO9000
4575   69 CONTINUE
4576C
4577C               *****************************************
4578C               **  STEP 2--                           **
4579C               **  COMPUTE THE BASIC TEST STATISTIC   **
4580C               *****************************************
4581C
4582      ISTEPN='2'
4583      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4584     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4585C
4586      DN=DBLE(N)
4587      IFLAG=0
4588      CALL SUMRAW(Y,N,IDIST1,IFLAG,
4589     1            XMEAN,XVAR,XSD,XMIN,XMAX,
4590     1            ISUBRO,IBUGA3,IERROR)
4591C
4592C     IDENTIFY SPECIAL CASES:
4593C
4594C       1. NORMAL-EXPONENTIAL
4595C       2. EXPONENTIAL-NORMAL
4596C       3. NORMAL-DOUBLE EXPONENTIAL
4597C       4. DOUBLE EXPONENTIAL-NORMAL
4598C
4599      ICASET=0
4600      IF(ICASPL.EQ.'NORM' .AND. ICASP2.EQ.'EXPO')ICASET=1
4601      IF(ICASPL.EQ.'EXPO' .AND. ICASP2.EQ.'NORM')ICASET=2
4602      IF(ICASPL.EQ.'NORM' .AND. ICASP2.EQ.'DEXP')ICASET=3
4603      IF(ICASPL.EQ.'DEXP' .AND. ICASP2.EQ.'NORM')ICASET=4
4604C
4605C               ***************************************************
4606C               **  STEP 3A-                                     **
4607C               **  COMPUTE ML ESTIMATES FOR FIRST DISTRIBUTION  **
4608C               ***************************************************
4609C
4610      ISTEPN='3A'
4611      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4612     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4613C
4614      CALL DPML1(Y,TEMP1,N,ICASPL,IFLAGD,IFLAG9,
4615     1           TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4616     1           DTEMP1,DTEMP2,DTEMP3,ITEMP1,MAXOBV,
4617     1           ALOCS1,SCALS1,ALOWLI,AUPPLI,
4618     1           SH1S1,SH2S1,SH3S1,SH4S1,
4619     1           SH5S1,SH6S1,S7S1,
4620     1           YLOWLM,YUPPLM,A,B,MINMAX,ISEED,
4621     1           IADEDF,IGEPDF,IMAKDF,IBEIDF,
4622     1           ILGADF,ISKNDF,IGLDDF,IGOMDF,IGIGDF,
4623     1           IGEODF,IBGEDF,IGAUDF,
4624     1           ICENSO,IEXPBC,IWEIBC,ICENTY,IDFTTY,
4625     1           CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4626     1           IBUGA3,ISUBRO,IERROR)
4627C
4628      IF(IERROR.EQ.'YES')THEN
4629        WRITE(ICOUT,999)
4630        CALL DPWRST('XXX','BUG ')
4631        WRITE(ICOUT,31)
4632        CALL DPWRST('XXX','BUG ')
4633        WRITE(ICOUT,121)
4634  121   FORMAT('      UNABLE TO OBTAIN MAXIMUM LIKELIHOOD ESTIMATE ',
4635     1         'FOR FIRST DISTRIBUTION')
4636
4637        IERROR='YES'
4638        GOTO9000
4639      ENDIF
4640C
4641      IF(ALOCS1.EQ.CPUMIN)THEN
4642        ALOCS1=0.0
4643        IFLGL1=0
4644      ENDIF
4645      IF(SCALS1.EQ.CPUMIN)THEN
4646        SCALS1=1.0
4647        IFLGS1=0
4648      ENDIF
4649C
4650      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
4651        WRITE(ICOUT,101)ALOCS1,SCALS1,SH1S1,SH2S1
4652  101   FORMAT('ML ESTIMATES FOR H0 DIST: ALOCS1,SCALS1,SH1S1,SH2S1 = ',
4653     1         4G15.7)
4654        CALL DPWRST('XXX','BUG ')
4655      ENDIF
4656C
4657C               ********************************************************
4658C               **  STEP 3B-                                         **
4659C               **  COMPUTE LIKELIHOOD VALUE FOR FIRST DISTRIBUTION  **
4660C               *******************************************************
4661C
4662      ISTEPN='3B'
4663      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4664     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4665C
4666      CALL DPLIK1(Y,TEMP1,N,ICASPL,
4667     1            SH1S1,SH2S1,SH3S1,SH4S1,
4668     1            SH5S1,SH6S1,SH7S1,
4669     1            YLOWLM,YUPPLM,A,B,MINMAX,
4670     1            IADEDF,IGEPDF,IMAKDF,IBEIDF,
4671     1            ILGADF,ISKNDF,IGLDDF,IBGEDF,
4672     1            IGETDF,ICONDF,IGOMDF,IKATDF,
4673     1            IGIGDF,IGEODF,
4674     1            ALOCS1,SCALS1,
4675     1            ALIKE1,AIC1,AICC1,BIC1,
4676     1            IBUGA3,ISUBRO,IERROR)
4677C
4678C               ***************************************************
4679C               **  STEP 4A-                                     **
4680C               **  COMPUTE ML ESTIMATES FOR SECOND DISTRIBUTION **
4681C               ***************************************************
4682C
4683      ISTEPN='4A'
4684      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4685     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4686C
4687      CALL DPML1(Y,TEMP1,N,ICASP2,IFLAGD,IFLAG9,
4688     1           TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4689     1           DTEMP1,DTEMP2,DTEMP3,ITEMP1,MAXOBV,
4690     1           ALOCS2,SCALS2,ALOWLI,AUPPLI,
4691     1           SH1S2,SH2S2,SH3S2,SH4S2,
4692     1           SH5S2,SH6S2,SH7S2,
4693     1           YLOWLM,YUPPLM,A,B,MINMAX,ISEED,
4694     1           IADEDF,IGEPDF,IMAKDF,IBEIDF,
4695     1           ILGADF,ISKNDF,IGLDDF,IGOMDF,IGIGDF,
4696     1           IGEODF,IBGEDF,IGAUDF,
4697     1           ICENSO,IEXPBC,IWEIBC,ICENTY,IDFTTY,
4698     1           CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4699     1           IBUGA3,ISUBRO,IERROR)
4700C
4701      IF(IERROR.EQ.'YES')THEN
4702        WRITE(ICOUT,999)
4703        CALL DPWRST('XXX','BUG ')
4704        WRITE(ICOUT,31)
4705        CALL DPWRST('XXX','BUG ')
4706        WRITE(ICOUT,131)
4707  131   FORMAT('      UNABLE TO OBTAIN MAXIMUM LIKELIHOOD ESTIMATE ',
4708     1         'FOR SECOND DISTRIBUTION')
4709
4710        IERROR='YES'
4711        GOTO9000
4712      ENDIF
4713C
4714      IF(ALOCS2.EQ.CPUMIN)THEN
4715        ALOCS2=0.0
4716        IFLGL2=0
4717      ENDIF
4718      IF(SCALS2.EQ.CPUMIN)THEN
4719        SCALS2=1.0
4720        IFLGS2=0
4721      ENDIF
4722C
4723C
4724      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
4725        WRITE(ICOUT,103)ALOCS2,SCALS2,SH1S2,SH2S2
4726  103   FORMAT('ML ESTIMATES FOR HA DIST: ALOCS2,SCALS2,SH1S2,SH2S2 = ',
4727     1         4G15.7)
4728        CALL DPWRST('XXX','BUG ')
4729      ENDIF
4730C
4731C               *******************************************************
4732C               **  STEP 4B-                                         **
4733C               **  COMPUTE LIKELIHOOD VALUE FOR SECOND DISTRIBUTION **
4734C               *******************************************************
4735C
4736      ISTEPN='4B'
4737      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4738     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4739C
4740      CALL DPLIK1(Y,TEMP1,N,ICASP2,
4741     1            SH1S2,SH2S2,SH3S2,SH4S2,
4742     1            SH5S2,SH6S2,SH7S2,
4743     1            YLOWLM,YUPPLM,A,B,MINMAX,
4744     1            IADEDF,IGEPDF,IMAKDF,IBEIDF,
4745     1            ILGADF,ISKNDF,IGLDDF,IBGEDF,
4746     1            IGETDF,ICONDF,IGOMDF,IKATDF,
4747     1            IGIGDF,IGEODF,
4748     1            ALOCS2,SCALS2,
4749     1            ALIKE2,AIC2,AICC2,BIC2,
4750     1            IBUGA3,ISUBRO,IERROR)
4751C
4752      IF(ICASET.EQ.1)THEN
4753        STATVA=SCALS1/SCALS2
4754      ELSEIF(ICASET.EQ.2)THEN
4755        STATVA=SCALS1/SCALS2
4756      ELSEIF(ICASET.EQ.3)THEN
4757        STATVA=SCALS1/SCALS2
4758      ELSEIF(ICASET.EQ.4)THEN
4759        STATVA=SCALS1/SCALS2
4760      ELSE
4761        DSTAT=(DEXP(DBLE(ALIKE2))/DEXP(DBLE(ALIKE1)))**(1.0D0/DN)
4762        STATVA=REAL(DSTAT)
4763      ENDIF
4764C
4765      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
4766        WRITE(ICOUT,111)ALIKE1,ALIKE2,STATVA
4767  111   FORMAT('ALIKE1,ALIKE2,STATVA = ',3G15.7)
4768        CALL DPWRST('XXX','BUG ')
4769      ENDIF
4770C
4771C               ********************************************
4772C               **  STEP 5--                              **
4773C               **  SIMULATION TO OBTAIN CRITICAL VALUES  **
4774C               ********************************************
4775C
4776C     GENERATE SAMPLES FROM THE H0 DISTRIBUTION.  LOCATION AND
4777C     SCALE PARAMETERS WILL BE SET TO 0 AND 1.  IF THERE IS A SHAPE
4778C     PARAMETER, USE THE ESTIMATED VALUE FROM ABOVE.
4779C
4780      ISTEPN='5'
4781      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4782     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4783C
4784CCCCC NMCSAM=100
4785      NMCSAM=10000
4786      NCNT=0
4787      NTEMP=N
4788C
4789      DO2110I=1,NMCSAM
4790C
4791        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
4792          WRITE(ICOUT,999)
4793          CALL DPWRST('XXX','BUG ')
4794          WRITE(ICOUT,311)I
4795  311     FORMAT('MONTE CARLO ITERATION ',I8)
4796          CALL DPWRST('XXX','BUG ')
4797        ENDIF
4798C
4799        CALL DPRAN2(ICASPL,ISEED,YTEMP,NTEMP,TEMP1,
4800     1              A,B,MINMAX,
4801     1              SH1S1,SH2S1,SH3S1,SH4S1,
4802     1              SH5S1,SH6S1,SH7S1,
4803     1              IADEDF,IGEPDF,IMAKDF,IBEIDF,
4804     1              ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
4805     1              IGOMDF,IKATDF,IGIGDF,IGEODF,
4806     1              IBUGA3,ISUBRO,IFOUND,IERROR)
4807C
4808C               ***************************************************
4809C               **  STEP 5A-                                     **
4810C               **  COMPUTE ML ESTIMATES FOR FIRST DISTRIBUTION  **
4811C               ***************************************************
4812C
4813        ISTEPN='5A'
4814        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4815     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4816C
4817        CALL DPML1(YTEMP,TEMP1,NTEMP,ICASPL,IFLAGD,IFLAG9,
4818     1             TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4819     1             DTEMP1,DTEMP2,DTEMP3,ITEMP1,MAXOBV,
4820     1             ALOCT1,SCALT1,ALOWLI,AUPPLI,
4821     1             SH1T1,SH2T1,SH3T1,SH4T1,
4822     1             SH5T1,SH6T1,S7T1,
4823     1             YLOWLM,YUPPLM,A,B,MINMAX,ISEED,
4824     1             IADEDF,IGEPDF,IMAKDF,IBEIDF,
4825     1             ILGADF,ISKNDF,IGLDDF,IGOMDF,IGIGDF,
4826     1             IGEODF,IBGEDF,IGAUDF,
4827     1             ICENSO,IEXPBC,IWEIBC,ICENTY,IDFTTY,
4828     1             CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4829     1             IBUGA3,ISUBRO,IERROR)
4830        IF(IERROR.EQ.'YES')GOTO2110
4831C
4832        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
4833          WRITE(ICOUT,2111)ALOCT1,SCALT1,SH1T1,SH2T1
4834 2111     FORMAT('ML ESTIMATES FOR H0 DIST: ALOCT1,SCALT1,SH1T1,',
4835     1           'SH2T1 = ',4G15.7)
4836          CALL DPWRST('XXX','BUG ')
4837        ENDIF
4838C
4839      IF(ALOCT1.EQ.CPUMIN)ALOCT1=0.0
4840C
4841C               ********************************************************
4842C               **  STEP 5B-                                         **
4843C               **  COMPUTE LIKELIHOOD VALUE FOR FIRST DISTRIBUTION  **
4844C               *******************************************************
4845C
4846        ISTEPN='5B'
4847        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4848     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4849C
4850        CALL DPLIK1(YTEMP,TEMP1,NTEMP,ICASPL,
4851     1              SH1T1,SH2T1,SH3T1,SH4T1,
4852     1              SH5T1,SH6T1,SH7T1,
4853     1              YLOWLM,YUPPLM,A,B,MINMAX,
4854     1              IADEDF,IGEPDF,IMAKDF,IBEIDF,
4855     1              ILGADF,ISKNDF,IGLDDF,IBGEDF,
4856     1              IGETDF,ICONDF,IGOMDF,IKATDF,
4857     1              IGIGDF,IGEODF,
4858     1              ALOCT1,SCALT1,
4859     1              ALIKE1,AIC1,AICC1,BIC1,
4860     1              IBUGA3,ISUBRO,IERROR)
4861C
4862C               ***************************************************
4863C               **  STEP 5C-                                     **
4864C               **  COMPUTE ML ESTIMATES FOR SECOND DISTRIBUTION **
4865C               ***************************************************
4866C
4867        ISTEPN='4A'
4868        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4869     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4870C
4871        CALL DPML1(YTEMP,TEMP1,NTEMP,ICASP2,IFLAGD,IFLAG9,
4872     1             TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
4873     1             DTEMP1,DTEMP2,DTEMP3,ITEMP1,MAXOBV,
4874     1             ALOCT2,SCALT2,ALOWLI,AUPPLI,
4875     1             SH1T2,SH2T2,SH3T2,SH4T2,
4876     1             SH5T2,SH6T2,S7T2,
4877     1             YLOWLM,YUPPLM,A,B,MINMAX,ISEED,
4878     1             IADEDF,IGEPDF,IMAKDF,IBEIDF,
4879     1             ILGADF,ISKNDF,IGLDDF,IGOMDF,IGIGDF,
4880     1             IGEODF,IBGEDF,IGAUDF,
4881     1             ICENSO,IEXPBC,IWEIBC,ICENTY,IDFTTY,
4882     1             CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
4883     1             IBUGA3,ISUBRO,IERROR)
4884        IF(IERROR.EQ.'YES')GOTO2110
4885C
4886        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
4887          WRITE(ICOUT,2213)ALOCT2,SCALT2,SH1T2,SH2T2
4888 2213     FORMAT('ML ESTIMATES FOR HA DIST: ALOCT2,SCALT2,',
4889     1           'SH1T2,SH2T2 = ',4G15.7)
4890          CALL DPWRST('XXX','BUG ')
4891        ENDIF
4892C
4893      IF(ALOCT2.EQ.CPUMIN)ALOCT2=0.0
4894C
4895C               *******************************************************
4896C               **  STEP 5D-                                         **
4897C               **  COMPUTE LIKELIHOOD VALUE FOR SECOND DISTRIBUTION **
4898C               *******************************************************
4899C
4900        ISTEPN='5D'
4901        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
4902     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
4903C
4904        CALL DPLIK1(YTEMP,TEMP1,NTEMP,ICASP2,
4905     1              SH1T2,SH2T2,SH3T2,SH4T2,
4906     1              SH5T2,SH6T2,SH7T2,
4907     1              YLOWLM,YUPPLM,A,B,MINMAX,
4908     1              IADEDF,IGEPDF,IMAKDF,IBEIDF,
4909     1              ILGADF,ISKNDF,IGLDDF,IBGEDF,
4910     1              IGETDF,ICONDF,IGOMDF,IKATDF,
4911     1              IGIGDF,IGEODF,
4912     1              ALOCT2,SCALT2,
4913     1              ALIKE2,AIC2,AICC2,BIC2,
4914     1              IBUGA3,ISUBRO,IERROR)
4915C
4916        NCNT=NCNT+1
4917        IF(ICASET.EQ.1)THEN
4918          YSTAT(NCNT)=SCALT1/SCALT2
4919        ELSEIF(ICASET.EQ.2)THEN
4920          YSTAT(NCNT)=SCALT1/SCALT2
4921        ELSEIF(ICASET.EQ.3)THEN
4922          YSTAT(NCNT)=SCALT1/SCALT2
4923        ELSEIF(ICASET.EQ.4)THEN
4924          YSTAT(NCNT)=SCALT1/SCALT2
4925        ELSE
4926          DSTAT=(DEXP(DBLE(ALIKE2))/DEXP(DBLE(ALIKE1)))**(1.0D0/DN)
4927          STATT=REAL(DSTAT)
4928          IF(ISNANZ(STATT))THEN
4929            NCNT=NCNT-1
4930          ELSE
4931            YSTAT(NCNT)=REAL(DSTAT)
4932          ENDIF
4933        ENDIF
4934C
4935C
4936        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
4937          WRITE(ICOUT,2119)I,ALIKE1,ALIKE2,YSTAT(NCNT)
4938 2119     FORMAT('I,ALIKE1,ALIKE2,YSTAT(NCNT) = ',I8,3G15.7)
4939          CALL DPWRST('XXX','BUG ')
4940        ENDIF
4941C
4942 2110 CONTINUE
4943C
4944      IDIR='UPPE'
4945      CALL DPGOF8(YSTAT,NCNT,STATVA,PVAL,IDIR,
4946     1            IBUGA3,ISUBRO,IERROR)
4947      STATCD=1.0 - PVAL
4948      IF(NCNT.EQ.NMCSAM)THEN
4949        CV50=YSTAT(5000)
4950        CV75=YSTAT(7500)
4951        CV80=YSTAT(8000)
4952        CV90=YSTAT(9000)
4953        CV95=YSTAT(9500)
4954        CV99=YSTAT(9900)
4955        CV999=YSTAT(9990)
4956      ELSEIF(NCNT.LT.1000)THEN
4957        WRITE(ICOUT,999)
4958        CALL DPWRST('XXX','BUG ')
4959        WRITE(ICOUT,31)
4960        CALL DPWRST('XXX','BUG ')
4961        WRITE(ICOUT,2311)
4962 2311   FORMAT('      LESS THAN 1,000 (OF 10,000) OF THE CRITICAL ',
4963     1         'VALUE SIMULATIONS GENERATED A VALID STATISTIC.')
4964
4965        IERROR='YES'
4966        GOTO9000
4967      ELSE
4968        IWRITE='OFF'
4969        P100=50.0
4970        CALL PERCEN(P100,YSTAT,NCNT,IWRITE,TEMP1,MAXOBV,
4971     1              CV50,IBUGA3,IERROR)
4972        P100=75.0
4973        CALL PERCEN(P100,YSTAT,NCNT,IWRITE,TEMP1,MAXOBV,
4974     1              CV75,IBUGA3,IERROR)
4975        P100=80.0
4976        CALL PERCEN(P100,YSTAT,NCNT,IWRITE,TEMP1,MAXOBV,
4977     1              CV80,IBUGA3,IERROR)
4978        P100=90.0
4979        CALL PERCEN(P100,YSTAT,NCNT,IWRITE,TEMP1,MAXOBV,
4980     1              CV90,IBUGA3,IERROR)
4981        P100=95.0
4982        CALL PERCEN(P100,YSTAT,NCNT,IWRITE,TEMP1,MAXOBV,
4983     1              CV95,IBUGA3,IERROR)
4984        P100=99.0
4985        CALL PERCEN(P100,YSTAT,NCNT,IWRITE,TEMP1,MAXOBV,
4986     1              CV99,IBUGA3,IERROR)
4987        P100=99.9
4988        CALL PERCEN(P100,YSTAT,NCNT,IWRITE,TEMP1,MAXOBV,
4989     1              CV999,IBUGA3,IERROR)
4990      ENDIF
4991C
4992C               ********************************************
4993C               **  STEP 6--                              **
4994C               **  SIMULATION TO OBTAIN CRITICAL VALUES  **
4995C               ********************************************
4996C
4997C     GENERATE SAMPLES FROM THE H1 DISTRIBUTION.  LOCATION AND
4998C     SCALE PARAMETERS WILL BE SET TO 0 AND 1.  IF THERE IS A SHAPE
4999C     PARAMETER, USE THE ESTIMATED VALUE FROM ABOVE.
5000C
5001C     FOR POWER, GENERATE SIMULATIONS FROM THE H1 DISTRIBUTION
5002C     RATHER THAN THE H0 DISTRIBUTION AND THEN COUNT HOW MANY
5003C     TIMES EACH DISTRIBUTION IS SELECTED BASED ON THE CUT-OFF
5004C     FOR ALPHA = 0.90, 0.95, AND 0.99.
5005C
5006      ISTEPN='6'
5007      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
5008     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5009C
5010CCCCC NMCSAM=100
5011      NMCSA2=5000
5012      NCNT2=0
5013      NTEMP=N
5014      I90COR=0
5015      I95COR=0
5016      I99COR=0
5017      I90INC=0
5018      I95INC=0
5019      I99INC=0
5020C
5021      DO6110I=1,NMCSA2
5022C
5023        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
5024          WRITE(ICOUT,6111)I
5025 6111     FORMAT('POWER SIMULATIONS: MONTE CARLO ITERATION ',I8)
5026          CALL DPWRST('XXX','BUG ')
5027        ENDIF
5028C
5029        CALL DPRAN2(ICASP2,ISEED,YTEMP,NTEMP,TEMP1,
5030     1              A,B,MINMAX,
5031     1              SH1S2,SH2S2,SH3S2,SH4S2,
5032     1              SH5S2,SH6S2,SH7S2,
5033     1              IADEDF,IGEPDF,IMAKDF,IBEIDF,
5034     1              ILGADF,ISKNDF,IGLDDF,IBGEDF,IGETDF,ICONDF,
5035     1              IGOMDF,IKATDF,IGIGDF,IGEODF,
5036     1              IBUGA3,ISUBRO,IFOUND,IERROR)
5037C
5038C               ***************************************************
5039C               **  STEP 6A-                                     **
5040C               **  COMPUTE ML ESTIMATES FOR FIRST DISTRIBUTION  **
5041C               ***************************************************
5042C
5043        ISTEPN='6A'
5044        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
5045     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5046C
5047        CALL DPML1(YTEMP,TEMP1,NTEMP,ICASPL,IFLAGD,IFLAG9,
5048     1             TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
5049     1             DTEMP1,DTEMP2,DTEMP3,ITEMP1,MAXOBV,
5050     1             ALOCT1,SCALT1,ALOWLI,AUPPLI,
5051     1             SH1T1,SH2T1,SH3T1,SH4T1,
5052     1             SH5T1,SH6T1,S7T1,
5053     1             YLOWLM,YUPPLM,A,B,MINMAX,ISEED,
5054     1             IADEDF,IGEPDF,IMAKDF,IBEIDF,
5055     1             ILGADF,ISKNDF,IGLDDF,IGOMDF,IGIGDF,
5056     1             IGEODF,IBGEDF,IGAUDF,
5057     1             ICENSO,IEXPBC,IWEIBC,ICENTY,IDFTTY,
5058     1             CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
5059     1             IBUGA3,ISUBRO,IERROR)
5060        IF(IERROR.EQ.'YES')GOTO6110
5061C
5062        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
5063          WRITE(ICOUT,6121)ALOCT1,SCALT1,SH1T1,SH2T1
5064 6121     FORMAT('ML ESTIMATES FOR H0 DIST: ALOCT1,SCALT1,SH1T1,',
5065     1           'SH2T1 = ',4G15.7)
5066          CALL DPWRST('XXX','BUG ')
5067        ENDIF
5068C
5069      IF(ALOCT1.EQ.CPUMIN)ALOCT1=0.0
5070C
5071C               ********************************************************
5072C               **  STEP 6B-                                         **
5073C               **  COMPUTE LIKELIHOOD VALUE FOR FIRST DISTRIBUTION  **
5074C               *******************************************************
5075C
5076        ISTEPN='6B'
5077        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
5078     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5079C
5080        CALL DPLIK1(YTEMP,TEMP1,NTEMP,ICASPL,
5081     1              SH1T1,SH2T1,SH3T1,SH4T1,
5082     1              SH5T1,SH6T1,SH7T1,
5083     1              YLOWLM,YUPPLM,A,B,MINMAX,
5084     1              IADEDF,IGEPDF,IMAKDF,IBEIDF,
5085     1              ILGADF,ISKNDF,IGLDDF,IBGEDF,
5086     1              IGETDF,ICONDF,IGOMDF,IKATDF,
5087     1              IGIGDF,IGEODF,
5088     1              ALOCT1,SCALT1,
5089     1              ALIKE1,AIC1,AICC1,BIC1,
5090     1              IBUGA3,ISUBRO,IERROR)
5091C
5092C               ***************************************************
5093C               **  STEP 6C-                                     **
5094C               **  COMPUTE ML ESTIMATES FOR SECOND DISTRIBUTION **
5095C               ***************************************************
5096C
5097        ISTEPN='6C'
5098        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
5099     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5100C
5101        CALL DPML1(YTEMP,TEMP1,NTEMP,ICASP2,IFLAGD,IFLAG9,
5102     1             TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,
5103     1             DTEMP1,DTEMP2,DTEMP3,ITEMP1,MAXOBV,
5104     1             ALOCT2,SCALT2,ALOWLI,AUPPLI,
5105     1             SH1T2,SH2T2,SH3T2,SH4T2,
5106     1             SH5T2,SH6T2,S7T2,
5107     1             YLOWLM,YUPPLM,A,B,MINMAX,ISEED,
5108     1             IADEDF,IGEPDF,IMAKDF,IBEIDF,
5109     1             ILGADF,ISKNDF,IGLDDF,IGOMDF,IGIGDF,
5110     1             IGEODF,IBGEDF,IGAUDF,
5111     1             ICENSO,IEXPBC,IWEIBC,ICENTY,IDFTTY,
5112     1             CLLIMI,CLWIDT,IHSTCW,IHSTOU,IRELAT,IRHSTG,
5113     1             IBUGA3,ISUBRO,IERROR)
5114        IF(IERROR.EQ.'YES')GOTO6110
5115C
5116        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
5117          WRITE(ICOUT,6131)ALOCT2,SCALT2,SH1T2,SH2T2
5118 6131     FORMAT('ML ESTIMATES FOR HA DIST: ALOCT2,SCALT2,',
5119     1           'SH1T2,SH2T2 = ',4G15.7)
5120          CALL DPWRST('XXX','BUG ')
5121        ENDIF
5122C
5123      IF(ALOCT2.EQ.CPUMIN)ALOCT2=0.0
5124C
5125C               *******************************************************
5126C               **  STEP 6D-                                         **
5127C               **  COMPUTE LIKELIHOOD VALUE FOR SECOND DISTRIBUTION **
5128C               *******************************************************
5129C
5130        ISTEPN='6D'
5131        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')
5132     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5133C
5134        CALL DPLIK1(YTEMP,TEMP1,NTEMP,ICASP2,
5135     1              SH1T2,SH2T2,SH3T2,SH4T2,
5136     1              SH5T2,SH6T2,SH7T2,
5137     1              YLOWLM,YUPPLM,A,B,MINMAX,
5138     1              IADEDF,IGEPDF,IMAKDF,IBEIDF,
5139     1              ILGADF,ISKNDF,IGLDDF,IBGEDF,
5140     1              IGETDF,ICONDF,IGOMDF,IKATDF,
5141     1              IGIGDF,IGEODF,
5142     1              ALOCT2,SCALT2,
5143     1              ALIKE2,AIC2,AICC2,BIC2,
5144     1              IBUGA3,ISUBRO,IERROR)
5145C
5146        NCNT2=NCNT2+1
5147        IF(ICASET.EQ.1)THEN
5148          STATT=SCALT1/SCALT2
5149        ELSEIF(ICASET.EQ.2)THEN
5150          STATT=SCALT1/SCALT2
5151        ELSEIF(ICASET.EQ.3)THEN
5152          STATT=SCALT1/SCALT2
5153        ELSEIF(ICASET.EQ.4)THEN
5154          STATT=SCALT1/SCALT2
5155        ELSE
5156          DSTAT=(DEXP(DBLE(ALIKE2))/DEXP(DBLE(ALIKE1)))**(1.0D0/DN)
5157          STATT=REAL(DSTAT)
5158          IF(ISNANZ(STATT))GOTO6110
5159        ENDIF
5160C
5161C       NOW DETERMINE IF DISTRIBUTION CORRECTLY CLASSIFIED.
5162C
5163        IF(STATT.GT.CV90)THEN
5164          I90COR=I90COR+1
5165        ELSE
5166          I90INC=I90INC+1
5167        ENDIF
5168C
5169        IF(STATT.GT.CV95)THEN
5170          I95COR=I95COR+1
5171        ELSE
5172          I95INC=I95INC+1
5173        ENDIF
5174C
5175        IF(STATT.GT.CV99)THEN
5176          I99COR=I99COR+1
5177        ELSE
5178          I99INC=I99INC+1
5179        ENDIF
5180C
5181        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
5182          WRITE(ICOUT,6141)I,ALIKE1,ALIKE2,STATT
5183 6141     FORMAT('I,ALIKE1,ALIKE2,STATT = ',I8,3G15.7)
5184          CALL DPWRST('XXX','BUG ')
5185        ENDIF
5186C
5187 6110 CONTINUE
5188C
5189      APOW90=REAL(I90COR)/REAL(I90COR + I90INC)
5190      APOW95=REAL(I95COR)/REAL(I95COR + I95INC)
5191      APOW99=REAL(I99COR)/REAL(I99COR + I99INC)
5192C
5193C               ******************************
5194C               **   STEP 7--               **
5195C               **   WRITE OUT EVERYTHING   **
5196C               ******************************
5197C
5198      ISTEPN='7'
5199      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LRD2')
5200     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5201C
5202      IF(IPRINT.EQ.'OFF')GOTO9000
5203C
5204      NUMDIG=7
5205      IF(IFORSW.EQ.'1')NUMDIG=1
5206      IF(IFORSW.EQ.'2')NUMDIG=2
5207      IF(IFORSW.EQ.'3')NUMDIG=3
5208      IF(IFORSW.EQ.'4')NUMDIG=4
5209      IF(IFORSW.EQ.'5')NUMDIG=5
5210      IF(IFORSW.EQ.'6')NUMDIG=6
5211      IF(IFORSW.EQ.'7')NUMDIG=7
5212      IF(IFORSW.EQ.'8')NUMDIG=8
5213      IF(IFORSW.EQ.'9')NUMDIG=9
5214      IF(IFORSW.EQ.'0')NUMDIG=0
5215      IF(IFORSW.EQ.'E')NUMDIG=-2
5216      IF(IFORSW.EQ.'-2')NUMDIG=-2
5217      IF(IFORSW.EQ.'-3')NUMDIG=-3
5218      IF(IFORSW.EQ.'-4')NUMDIG=-4
5219      IF(IFORSW.EQ.'-5')NUMDIG=-5
5220      IF(IFORSW.EQ.'-6')NUMDIG=-6
5221      IF(IFORSW.EQ.'-7')NUMDIG=-7
5222      IF(IFORSW.EQ.'-8')NUMDIG=-8
5223      IF(IFORSW.EQ.'-9')NUMDIG=-9
5224C
5225      ITITLE='Distributional Likelihood Ratio Test'
5226      NCTITL=36
5227      ITITLZ=' '
5228      NCTITZ=0
5229C
5230      ICNT=1
5231      ITEXT(ICNT)=' '
5232      NCTEXT(ICNT)=0
5233      AVALUE(ICNT)=0.0
5234      IDIGIT(ICNT)=-1
5235      ICNT=ICNT+1
5236      ITEXT(ICNT)='Response Variable: '
5237      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
5238      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
5239      NCTEXT(ICNT)=27
5240      AVALUE(ICNT)=0.0
5241      IDIGIT(ICNT)=-1
5242C
5243      ICNT=ICNT+1
5244      ITEXT(ICNT)=' '
5245      NCTEXT(ICNT)=1
5246      AVALUE(ICNT)=0.0
5247      IDIGIT(ICNT)=-1
5248C
5249      ICNT=ICNT+1
5250      ITEXT(ICNT)='H0: Data are from distribution -'
5251      NCTEXT(ICNT)=32
5252      AVALUE(ICNT)=0.0
5253      IDIGIT(ICNT)=-1
5254      ICNT=ICNT+1
5255      ITEXT(ICNT)(1:40)=IDIST1(1:40)
5256      NCTEXT(ICNT)=40
5257      AVALUE(ICNT)=0.0
5258      IDIGIT(ICNT)=-1
5259      ICNT=ICNT+1
5260      ITEXT(ICNT)='Ha: Data are from distribution -'
5261      NCTEXT(ICNT)=32
5262      AVALUE(ICNT)=0.0
5263      IDIGIT(ICNT)=-1
5264      ICNT=ICNT+1
5265      ITEXT(ICNT)(1:40)=IDIST2(1:40)
5266      NCTEXT(ICNT)=40
5267      AVALUE(ICNT)=0.0
5268      IDIGIT(ICNT)=-1
5269C
5270      ICNT=ICNT+1
5271      ITEXT(ICNT)=' '
5272      NCTEXT(ICNT)=1
5273      AVALUE(ICNT)=0.0
5274      IDIGIT(ICNT)=-1
5275      ICNT=ICNT+1
5276      ITEXT(ICNT)='Summary Statistics:'
5277      NCTEXT(ICNT)=19
5278      AVALUE(ICNT)=0.0
5279      IDIGIT(ICNT)=-1
5280      ICNT=ICNT+1
5281      ITEXT(ICNT)='Total Number of Observations:'
5282      NCTEXT(ICNT)=29
5283      AVALUE(ICNT)=REAL(N)
5284      IDIGIT(ICNT)=0
5285      ICNT=ICNT+1
5286      ITEXT(ICNT)='Sample Mean:'
5287      NCTEXT(ICNT)=12
5288      AVALUE(ICNT)=XMEAN
5289      IDIGIT(ICNT)=NUMDIG
5290      ICNT=ICNT+1
5291      ITEXT(ICNT)='Sample Standard Deviation:'
5292      NCTEXT(ICNT)=26
5293      AVALUE(ICNT)=XSD
5294      IDIGIT(ICNT)=NUMDIG
5295      ICNT=ICNT+1
5296      ITEXT(ICNT)='Sample Minimum:'
5297      NCTEXT(ICNT)=15
5298      AVALUE(ICNT)=XMIN
5299      IDIGIT(ICNT)=NUMDIG
5300      ICNT=ICNT+1
5301      ITEXT(ICNT)='Sample Maximum:'
5302      NCTEXT(ICNT)=15
5303      AVALUE(ICNT)=XMAX
5304      IDIGIT(ICNT)=NUMDIG
5305C
5306      ICNT=ICNT+1
5307      ITEXT(ICNT)=' '
5308      NCTEXT(ICNT)=1
5309      AVALUE(ICNT)=0.0
5310      IDIGIT(ICNT)=-1
5311      ICNT=ICNT+1
5312      ITEXT(ICNT)='H0 Distribution:'
5313      NCTEXT(ICNT)=16
5314      AVALUE(ICNT)=0.0
5315      IDIGIT(ICNT)=-1
5316      IF(ALOCS1.NE.CPUMIN .AND. IFLGL1.EQ.1)THEN
5317        ICNT=ICNT+1
5318        ITEXT(ICNT)='Estimate of Location Parameter:'
5319        NCTEXT(ICNT)=31
5320        AVALUE(ICNT)=ALOCS1
5321        IDIGIT(ICNT)=NUMDIG
5322      ENDIF
5323      IF(SCALS1.NE.CPUMIN .AND. IFLGS1.EQ.1)THEN
5324        ICNT=ICNT+1
5325        ITEXT(ICNT)='Estimate of Scale Parameter:'
5326        NCTEXT(ICNT)=28
5327        AVALUE(ICNT)=SCALS1
5328        IDIGIT(ICNT)=NUMDIG
5329      ENDIF
5330      IF(SH1S1.NE.CPUMIN)THEN
5331        ICNT=ICNT+1
5332        ITEXT(ICNT)='Estimate of Shape Parameter 1:'
5333        NCTEXT(ICNT)=30
5334        AVALUE(ICNT)=SH1S1
5335        IDIGIT(ICNT)=NUMDIG
5336      ENDIF
5337      IF(SH2S1.NE.CPUMIN)THEN
5338        ICNT=ICNT+1
5339        ITEXT(ICNT)='Estimate of Shape Parameter 2:'
5340        NCTEXT(ICNT)=30
5341        AVALUE(ICNT)=SH2S1
5342        IDIGIT(ICNT)=NUMDIG
5343      ENDIF
5344C
5345      ICNT=ICNT+1
5346      ITEXT(ICNT)=' '
5347      NCTEXT(ICNT)=1
5348      AVALUE(ICNT)=0.0
5349      IDIGIT(ICNT)=-1
5350      ICNT=ICNT+1
5351      ITEXT(ICNT)='Ha Distribution:'
5352      NCTEXT(ICNT)=16
5353      AVALUE(ICNT)=0.0
5354      IDIGIT(ICNT)=-1
5355      IF(ALOCS2.NE.CPUMIN .AND. IFLGL2.EQ.1)THEN
5356        ICNT=ICNT+1
5357        ITEXT(ICNT)='Estimate of Location Parameter:'
5358        NCTEXT(ICNT)=31
5359        AVALUE(ICNT)=ALOCS2
5360        IDIGIT(ICNT)=NUMDIG
5361      ENDIF
5362      IF(SCALS2.NE.CPUMIN .AND. IFLGS2.EQ.1)THEN
5363        ICNT=ICNT+1
5364        ITEXT(ICNT)='Estimate of Scale Parameter:'
5365        NCTEXT(ICNT)=28
5366        AVALUE(ICNT)=SCALS2
5367        IDIGIT(ICNT)=NUMDIG
5368      ENDIF
5369      IF(SH1S2.NE.CPUMIN)THEN
5370        ICNT=ICNT+1
5371        ITEXT(ICNT)='Estimate of Shape Parameter 1:'
5372        NCTEXT(ICNT)=30
5373        AVALUE(ICNT)=SH1S2
5374        IDIGIT(ICNT)=NUMDIG
5375      ENDIF
5376      IF(SH2S2.NE.CPUMIN)THEN
5377        ICNT=ICNT+1
5378        ITEXT(ICNT)='Estimate of Shape Parameter 2:'
5379        NCTEXT(ICNT)=30
5380        AVALUE(ICNT)=SH2S2
5381        IDIGIT(ICNT)=NUMDIG
5382      ENDIF
5383C
5384      ICNT=ICNT+1
5385      ITEXT(ICNT)=' '
5386      NCTEXT(ICNT)=1
5387      AVALUE(ICNT)=0.0
5388      IDIGIT(ICNT)=-1
5389      ICNT=ICNT+1
5390      ITEXT(ICNT)='Test:'
5391      NCTEXT(ICNT)=5
5392      AVALUE(ICNT)=0.0
5393      IDIGIT(ICNT)=-1
5394      ICNT=ICNT+1
5395      ITEXT(ICNT)='Test Statistic Value:'
5396      NCTEXT(ICNT)=21
5397      AVALUE(ICNT)=STATVA
5398      IDIGIT(ICNT)=NUMDIG
5399      ICNT=ICNT+1
5400      ITEXT(ICNT)='CDF of Test Statistic:'
5401      NCTEXT(ICNT)=22
5402      AVALUE(ICNT)=STATCD
5403      IDIGIT(ICNT)=NUMDIG
5404      ICNT=ICNT+1
5405      ITEXT(ICNT)='P-Value:'
5406      NCTEXT(ICNT)=8
5407      AVALUE(ICNT)=PVAL
5408      IDIGIT(ICNT)=NUMDIG
5409      ICNT=ICNT+1
5410      ITEXT(ICNT)='Number of Simulations for CV:'
5411      NCTEXT(ICNT)=29
5412      AVALUE(ICNT)=NCNT
5413      IDIGIT(ICNT)=0
5414      ICNT=ICNT+1
5415      ITEXT(ICNT)='Number of Simulations for Power:'
5416      NCTEXT(ICNT)=32
5417      AVALUE(ICNT)=NCNT2
5418      IDIGIT(ICNT)=0
5419C
5420      NUMROW=ICNT
5421      DO7210I=1,NUMROW
5422        NTOT(I)=15
5423 7210 CONTINUE
5424C
5425      IFRST=.TRUE.
5426      ILAST=.TRUE.
5427C
5428      ISTEPN='7A'
5429      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LRD2')
5430     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5431C
5432      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
5433     1            AVALUE,IDIGIT,
5434     1            NTOT,NUMROW,
5435     1            ICAPSW,ICAPTY,ILAST,IFRST,
5436     1            ISUBRO,IBUGA3,IERROR)
5437C
5438      ISTEPN='7B'
5439      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LRD2')
5440     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5441C
5442      ITITLE=' '
5443      NCTITL=0
5444C
5445      ITITL9=' '
5446      NCTIT9=0
5447      ITITLE(1:44)='Percent Points of the Reference Distribution'
5448      NCTITL=44
5449      NUMLIN=1
5450      NUMROW=NUMALP
5451      NUMCOL=3
5452      ITITL2(1,1)='Percent Point'
5453      ITITL2(1,2)=' '
5454      ITITL2(1,3)='Value'
5455      NCTIT2(1,1)=13
5456      NCTIT2(1,2)=1
5457      NCTIT2(1,3)=5
5458C
5459      NMAX=0
5460      DO7221I=1,NUMCOL
5461        VALIGN(I)='b'
5462        ALIGN(I)='r'
5463        NTOT(I)=15
5464        IF(I.EQ.2)NTOT(I)=5
5465        NMAX=NMAX+NTOT(I)
5466        IDIGIT(I)=NUMDIG
5467        ITYPCO(I)='NUME'
5468 7221 CONTINUE
5469      ITYPCO(2)='ALPH'
5470      IDIGIT(1)=1
5471      IDIGIT(3)=3
5472      DO7223I=1,NUMROW
5473        DO7225J=1,NUMCOL
5474          NCVALU(I,J)=0
5475          IVALUE(I,J)=' '
5476          NCVALU(I,J)=0
5477          AMAT(I,J)=0.0
5478          IF(J.EQ.1)THEN
5479            AMAT(I,J)=ALPHA(I)
5480          ELSEIF(J.EQ.2)THEN
5481            IVALUE(I,J)='='
5482            NCVALU(I,J)=1
5483          ELSEIF(J.EQ.3)THEN
5484            IF(I.EQ.1)THEN
5485              AMAT(I,J)=RND(CV50,IDIGIT(J))
5486            ELSEIF(I.EQ.2)THEN
5487              AMAT(I,J)=RND(CV75,IDIGIT(J))
5488            ELSEIF(I.EQ.3)THEN
5489              AMAT(I,J)=RND(CV80,IDIGIT(J))
5490            ELSEIF(I.EQ.4)THEN
5491              AMAT(I,J)=RND(CV90,IDIGIT(J))
5492            ELSEIF(I.EQ.5)THEN
5493              AMAT(I,J)=RND(CV95,IDIGIT(J))
5494            ELSEIF(I.EQ.6)THEN
5495              AMAT(I,J)=RND(CV99,IDIGIT(J))
5496            ELSEIF(I.EQ.7)THEN
5497              AMAT(I,J)=RND(CV999,IDIGIT(J))
5498            ENDIF
5499          ENDIF
5500 7225   CONTINUE
5501 7223 CONTINUE
5502C
5503      IWHTML(1)=150
5504      IWHTML(2)=50
5505      IWHTML(3)=150
5506      IWRTF(1)=2000
5507      IWRTF(2)=IWRTF(1)+500
5508      IWRTF(3)=IWRTF(2)+2000
5509      IFRST=.TRUE.
5510      ILAST=.FALSE.
5511C
5512      ISTEPN='42C'
5513      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LRD2')
5514     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5515C
5516      CALL DPDTA4(ITITL9,NCTIT9,
5517     1            ITITLE,NCTITL,ITITL2,NCTIT2,
5518     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
5519     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
5520     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
5521     1            ICAPSW,ICAPTY,IFRST,ILAST,
5522     1            ISUBRO,IBUGA3,IERROR)
5523C
5524      ISTEPN='7D'
5525      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LRD2')
5526     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5527C
5528      ITITL9=' '
5529      NCTIT9=0
5530      ITITLE='Conclusions (Upper 1-Tailed Test)'
5531      NCTITL=33
5532      NUMLIN=2
5533      NUMROW=3
5534      NUMCOL=5
5535C
5536      ITITL2(1,1)=' '
5537      NCTIT2(1,1)=1
5538      ITITL2(2,1)='Alpha'
5539      NCTIT2(2,1)=5
5540C
5541      ITITL2(1,2)=' '
5542      NCTIT2(1,2)=1
5543      ITITL2(2,2)='CDF'
5544      NCTIT2(2,2)=3
5545C
5546      ITITL2(1,3)='Power'
5547      NCTIT2(1,3)=5
5548      ITITL2(2,3)='(1-Beta)'
5549      NCTIT2(2,3)=8
5550C
5551      ITITL2(1,4)='Critical'
5552      NCTIT2(1,4)=8
5553      ITITL2(2,4)='Value'
5554      NCTIT2(2,4)=5
5555C
5556      ITITL2(1,5)=' '
5557      NCTIT2(1,5)=1
5558      ITITL2(2,5)='Conclusion'
5559      NCTIT2(2,5)=10
5560C
5561      NMAX=0
5562      DO7321I=1,NUMCOL
5563        VALIGN(I)='b'
5564        ALIGN(I)='r'
5565        NTOT(I)=15
5566        IF(I.EQ.1 .OR. I.EQ.2)NTOT(I)=7
5567        IF(I.EQ.3)NTOT(I)=10
5568        IF(I.EQ.4)NTOT(I)=10
5569        NMAX=NMAX+NTOT(I)
5570        IDIGIT(I)=3
5571        ITYPCO(I)='ALPH'
5572 7321 CONTINUE
5573      ITYPCO(3)='NUME'
5574      ITYPCO(4)='NUME'
5575      IDIGIT(1)=0
5576      IDIGIT(2)=0
5577      IDIGIT(3)=2
5578      IDIGIT(4)=3
5579      DO7323I=1,NUMROW
5580        DO7325J=1,NUMCOL
5581          NCVALU(I,J)=0
5582          IVALUE(I,J)=' '
5583          NCVALU(I,J)=0
5584          AMAT(I,J)=0.0
5585 7325   CONTINUE
5586 7323 CONTINUE
5587      IVALUE(1,1)='10%'
5588      IVALUE(2,1)='5%'
5589      IVALUE(3,1)='1%'
5590      IVALUE(1,2)='90%'
5591      IVALUE(2,2)='95%'
5592      IVALUE(3,2)='99%'
5593      NCVALU(1,1)=3
5594      NCVALU(2,1)=2
5595      NCVALU(3,1)=2
5596      NCVALU(1,2)=3
5597      NCVALU(2,2)=3
5598      NCVALU(3,2)=3
5599      IF(STATVA.GT.CV90)IVALUE(1,5)='Reject H0'
5600      IF(STATVA.GT.CV95)IVALUE(2,5)='Reject H0'
5601      IF(STATVA.GT.CV99)IVALUE(3,5)='Reject H0'
5602      AMAT(1,3)=RND(APOW90,IDIGIT(3))
5603      AMAT(2,3)=RND(APOW95,IDIGIT(3))
5604      AMAT(3,3)=RND(APOW99,IDIGIT(3))
5605      AMAT(1,4)=RND(CV90,IDIGIT(4))
5606      AMAT(2,4)=RND(CV95,IDIGIT(4))
5607      AMAT(3,4)=RND(CV99,IDIGIT(4))
5608      IVALUE(1,5)='Accept H0'
5609      IVALUE(2,5)='Accept H0'
5610      IVALUE(3,5)='Accept H0'
5611      NCVALU(1,5)=9
5612      NCVALU(2,5)=9
5613      NCVALU(3,5)=9
5614C
5615      IWHTML(1)=125
5616      IWHTML(2)=125
5617      IWHTML(3)=125
5618      IWHTML(4)=150
5619      IWHTML(5)=150
5620      IWRTF(1)=1200
5621      IWRTF(2)=IWRTF(1)+1200
5622      IWRTF(3)=IWRTF(2)+1200
5623      IWRTF(4)=IWRTF(3)+2000
5624      IWRTF(5)=IWRTF(4)+2000
5625      IFRST=.FALSE.
5626      ILAST=.TRUE.
5627C
5628      ISTEPN='7E'
5629      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LRD2')
5630     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5631C
5632      CALL DPDTA4(ITITL9,NCTIT9,
5633     1            ITITLE,NCTITL,ITITL2,NCTIT2,
5634     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
5635     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
5636     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
5637     1            ICAPSW,ICAPTY,IFRST,ILAST,
5638     1            ISUBRO,IBUGA3,IERROR)
5639C
5640C               *****************
5641C               **  STEP 90--  **
5642C               **  EXIT       **
5643C               *****************
5644C
5645 9000 CONTINUE
5646      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LRD2')THEN
5647        WRITE(ICOUT,999)
5648        CALL DPWRST('XXX','BUG ')
5649        WRITE(ICOUT,9011)
5650 9011   FORMAT('***** AT THE END       OF DPLRD2--')
5651        CALL DPWRST('XXX','BUG ')
5652        WRITE(ICOUT,9012)STATVA,NMCSAM,PVAL,STATCD
5653 9012   FORMAT('STATVA,NMCSAM,PVAL,STATCD ',G15.7,I8,2G15.7)
5654        CALL DPWRST('XXX','BUG ')
5655        WRITE(ICOUT,9014)CV50,CV75,CV90,CV95,CV99
5656 9014   FORMAT('CV50,CV75,CV90,CV95,CV99 = ',5G15.7)
5657        CALL DPWRST('XXX','BUG ')
5658        IF(NMCSAM.GT.1)THEN
5659          DO9020I=1,MIN(NMCSAM,100)
5660            WRITE(ICOUT,9021)I,YSTAT(I)
5661 9021       FORMAT('I,YSTAT(I) = ',I8,G15.7)
5662            CALL DPWRST('XXX','BUG ')
5663 9020     CONTINUE
5664        ENDIF
5665      ENDIF
5666C
5667      RETURN
5668      END
5669      SUBROUTINE DPLRD4(STATVA,STATCD,PVAL,CV90,CV95,CV99,
5670     1                  APOW90,APOW95,APOW99,
5671     1                  IFLAGU,IFRST,ILAST,ICASPL,
5672     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
5673C
5674C     PURPOSE--UTILITY ROUTINE USED BY DPLRDI.  THIS ROUTINE
5675C              UPDATES THE PARAMETERS "STATVAL", "STATCDF", AND
5676C              "PVALUE" AFTER A DISTRIBUTIONAL LIKELIHOOD RATIO
5677C              COMPUTATION.
5678C     WRITTEN BY--ALAN HECKERT
5679C                 STATISTICAL ENGINEERING DIVISION
5680C                 INFORMATION TECHNOLOGY LABORAOTRY
5681C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
5682C                 GAITHERSBURG, MD 20899-8980
5683C                 PHONE--301-975-2899
5684C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5685C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
5686C     LANGUAGE--ANSI FORTRAN (1977)
5687C     VERSION NUMBER--2014/05
5688C     ORIGINAL VERSION--MAY       2014.
5689C
5690C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5691C
5692      CHARACTER*4 IFLAGU
5693      CHARACTER*4 ICASPL
5694      CHARACTER*4 IBUGA2
5695      CHARACTER*4 IBUGA3
5696      CHARACTER*4 ISUBRO
5697      CHARACTER*4 IERROR
5698C
5699      LOGICAL IFRST
5700      LOGICAL ILAST
5701C
5702      CHARACTER*4 IH
5703      CHARACTER*4 IH2
5704      CHARACTER*4 ISUBN0
5705      CHARACTER*4 ISUBN1
5706      CHARACTER*4 ISUBN2
5707      CHARACTER*4 ISTEPN
5708      CHARACTER*4 IST1CS
5709      CHARACTER*4 IOP
5710C
5711      SAVE IOUNI1
5712      SAVE IST1CS
5713C
5714C-----COMMON----------------------------------------------------------
5715C
5716      INCLUDE 'DPCOPA.INC'
5717      INCLUDE 'DPCOHK.INC'
5718      INCLUDE 'DPCOHO.INC'
5719      INCLUDE 'DPCOP2.INC'
5720C
5721C-----START POINT-----------------------------------------------------
5722C
5723      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LRD4')THEN
5724        ISTEPN='1'
5725        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
5726        WRITE(ICOUT,999)
5727  999   FORMAT(1X)
5728        CALL DPWRST('XXX','BUG ')
5729        WRITE(ICOUT,51)
5730   51   FORMAT('***** AT THE BEGINNING OF DPLRD4--')
5731        CALL DPWRST('XXX','BUG ')
5732        WRITE(ICOUT,53)ICASPL,STATVA,STATCD,PVAL
5733   53   FORMAT('ICASPL,STATVA,STATCD,PVAL = ',A4,2X,3G15.7)
5734        CALL DPWRST('XXX','BUG ')
5735      ENDIF
5736C
5737      IF(IFLAGU.EQ.'FILE')THEN
5738C
5739        IF(IFRST)THEN
5740          IOP='OPEN'
5741          IFLAG1=1
5742          IFLAG2=0
5743          IFLAG3=0
5744          IFLAG4=0
5745          IFLAG5=0
5746          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
5747     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
5748     1                IBUGA3,ISUBRO,IERROR)
5749          IF(IERROR.EQ.'YES')THEN
5750            IST1CS='CLOS'
5751            GOTO9000
5752          ELSE
5753            IST1CS='OPEN'
5754          ENDIF
5755C
5756          WRITE(IOUNI1,295)
5757  295     FORMAT(11X,'STATVAL',8X,'STATCDF',8X,'PVALUE',
5758     1           7X,'CV90',11X,'CV95',11X,'CV99',11X,
5759     1           'POW90',10X,'POW95',10X,'POW99')
5760  299     FORMAT(6E15.7)
5761        ENDIF
5762        IF(IST1CS.EQ.'OPEN')THEN
5763          WRITE(IOUNI1,299)STATVA,STATCD,PVAL,CV90,CV95,CV99,
5764     1                     APOW90,APOW95,APOW99
5765        ENDIF
5766      ELSEIF(IFLAGU.EQ.'ON')THEN
5767        IH='STAT'
5768        IH2='VAL '
5769        VALUE0=STATVA
5770        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5771     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5772     1              IANS,IWIDTH,IBUGA3,IERROR)
5773C
5774        IF(STATCD.NE.CPUMIN)THEN
5775          IH='STAT'
5776          IH2='CDF '
5777          VALUE0=STATCD
5778          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5779     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5780     1                IANS,IWIDTH,IBUGA3,IERROR)
5781        ENDIF
5782C
5783        IF(PVAL.NE.CPUMIN)THEN
5784          IH='PVAL'
5785          IH2='UE  '
5786          VALUE0=PVAL
5787          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5788     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5789     1                IANS,IWIDTH,IBUGA3,IERROR)
5790        ENDIF
5791C
5792        IF(CV90.NE.CPUMIN)THEN
5793          IH='CUTO'
5794          IH2='FF90'
5795          VALUE0=CV90
5796          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5797     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5798     1                IANS,IWIDTH,IBUGA3,IERROR)
5799        ENDIF
5800C
5801        IF(CV95.NE.CPUMIN)THEN
5802          IH='CUTO'
5803          IH2='FF95'
5804          VALUE0=CV95
5805          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5806     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5807     1                IANS,IWIDTH,IBUGA3,IERROR)
5808        ENDIF
5809C
5810        IF(CV99.NE.CPUMIN)THEN
5811          IH='CUTO'
5812          IH2='FF99'
5813          VALUE0=CV99
5814          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5815     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5816     1                IANS,IWIDTH,IBUGA3,IERROR)
5817        ENDIF
5818C
5819        IF(APOW90.NE.CPUMIN)THEN
5820          IH='POWE'
5821          IH2='R90 '
5822          VALUE0=APOW90
5823          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5824     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5825     1                IANS,IWIDTH,IBUGA3,IERROR)
5826        ENDIF
5827C
5828        IF(APOW95.NE.CPUMIN)THEN
5829          IH='POWE'
5830          IH2='R95 '
5831          VALUE0=APOW95
5832          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5833     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5834     1                IANS,IWIDTH,IBUGA3,IERROR)
5835        ENDIF
5836C
5837        IF(APOW99.NE.CPUMIN)THEN
5838          IH='POWE'
5839          IH2='R99 '
5840          VALUE0=APOW99
5841          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
5842     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
5843     1                IANS,IWIDTH,IBUGA3,IERROR)
5844        ENDIF
5845C
5846      ENDIF
5847C
5848      IF(ILAST .AND. IFLAGU.EQ.'FILE' .AND. IST1CS.EQ.'OPEN')THEN
5849        IOP='CLOS'
5850        IFLAG1=1
5851        IFLAG2=0
5852        IFLAG3=0
5853        IFLAG4=0
5854        IFLAG5=0
5855        CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
5856     1              IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
5857     1              IBUGA3,ISUBRO,IERROR)
5858        IST1CS='CLOS'
5859      ENDIF
5860C
5861C               *****************
5862C               **  STEP 90--  **
5863C               **  EXIT       **
5864C               *****************
5865C
5866 9000 CONTINUE
5867C
5868      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LRD4')THEN
5869        WRITE(ICOUT,999)
5870        CALL DPWRST('XXX','BUG ')
5871        WRITE(ICOUT,9011)
5872 9011   FORMAT('***** AT THE END OF DPLRD4--')
5873        CALL DPWRST('XXX','BUG ')
5874      ENDIF
5875C
5876      RETURN
5877      END
5878      SUBROUTINE DPLTES(YTEMP,XTEMP,MAXNXT,ICASAN,
5879     1                  ICAPSW,IFORSW,IMULT,
5880     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
5881C
5882C     PURPOSE--CARRY OUT LEVENE TEST
5883C              (K-SAMPLE HOMOGENEITY OF VARIANCES)
5884C     EXAMPLE--LEVENE TEST Y X
5885C     REFERENCE--Levene, H. (1960). In Contributions to Probability
5886C                and Statistics: Essays in Honor of Harold Hotelling,
5887C                I. Olkin et al. eds., Stanford University Press,
5888C                pp. 278-292.
5889C              --Brown, M. B. and Forsythe, A. B. (1974), Journal
5890C                of the American Statistical Association, 69, 364-367.
5891C     WRITTEN BY--JAMES J. FILLIBEN
5892C                 STATISTICAL ENGINEERING DIVISION
5893C                 INFORMATION TECHNOLOGY LABORATORY
5894C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5895C                 Gaithersburg, MD 20899-8980
5896C                 PHONE--301-975-2855
5897C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5898C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5899C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
5900C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
5901C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
5902C     LANGUAGE--ANSI FORTRAN (1977)
5903C     VERSION NUMBER--97/9
5904C     ORIGINAL VERSION--SEPTEMBER 1997.
5905C     UPDATED         --AUGIST    1999. BUG FIX IN CALCULATION,
5906C                                       ADD OPTION OF MEDIAN,
5907C                                       MEAN, OR TRIMMED MEAN
5908C     UPDATED         --JANUARY   2004. SUPPORT FOR HTML, LATEX OUTPUT
5909C     UPDATED         --FEBRUARY  2011. USE DPPARS
5910C     UPDATED         --FEBRUARY  2011. SUPPORT FOR "MULTIPLE" CASE
5911C
5912C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
5913C
5914      CHARACTER*4 ICASAN
5915      CHARACTER*4 IFORSW
5916      CHARACTER*4 IMULT
5917      CHARACTER*4 IBUGA2
5918      CHARACTER*4 IBUGA3
5919      CHARACTER*4 IBUGQ
5920      CHARACTER*4 ISUBRO
5921      CHARACTER*4 IFOUND
5922      CHARACTER*4 IERROR
5923      CHARACTER*4 ICAPSW
5924C
5925      CHARACTER*4 ICASE
5926      CHARACTER*4 ISUBN1
5927      CHARACTER*4 ISUBN2
5928      CHARACTER*4 ISTEPN
5929      CHARACTER*4 IH
5930      CHARACTER*4 IH2
5931      CHARACTER*4 IHOST1
5932      CHARACTER*4 ISUBN0
5933C
5934      CHARACTER*40 INAME
5935      PARAMETER (MAXSPN=30)
5936      CHARACTER*4 IVARN1(MAXSPN)
5937      CHARACTER*4 IVARN2(MAXSPN)
5938      CHARACTER*4 IVARTY(MAXSPN)
5939      REAL PVAR(MAXSPN)
5940      INTEGER ILIS(MAXSPN)
5941      INTEGER NRIGHT(MAXSPN)
5942      INTEGER ICOLR(MAXSPN)
5943C
5944C---------------------------------------------------------------------
5945C
5946      DIMENSION YTEMP(*)
5947      DIMENSION XTEMP(*)
5948C
5949C-----COMMON----------------------------------------------------------
5950C
5951      INCLUDE 'DPCOPA.INC'
5952C
5953      DIMENSION YMEDIA(MAXOBV)
5954      DIMENSION YMEAN(MAXOBV)
5955      DIMENSION T(MAXOBV)
5956      DIMENSION TBARIV(MAXOBV)
5957      DIMENSION DTAG(MAXOBV)
5958      DIMENSION TEMP1(MAXOBV)
5959      DIMENSION TEMP2(MAXOBV)
5960      DIMENSION TEMP3(MAXOBV)
5961      DIMENSION TEMP4(MAXOBV)
5962C
5963      INCLUDE 'DPCOZZ.INC'
5964      EQUIVALENCE(GARBAG(IGARB1),YMEDIA(1))
5965      EQUIVALENCE(GARBAG(IGARB2),T(1))
5966      EQUIVALENCE(GARBAG(IGARB3),TBARIV(1))
5967      EQUIVALENCE(GARBAG(IGARB4),DTAG(1))
5968      EQUIVALENCE(GARBAG(IGARB5),YMEAN(1))
5969      EQUIVALENCE(GARBAG(IGARB6),TEMP1(1))
5970      EQUIVALENCE(GARBAG(IGARB7),TEMP2(1))
5971      EQUIVALENCE(GARBAG(IGARB8),TEMP3(1))
5972      EQUIVALENCE(GARBAG(IGARB9),TEMP4(1))
5973C
5974C-----COMMON VARIABLES (GENERAL)--------------------------------------
5975C
5976      INCLUDE 'DPCOHK.INC'
5977      INCLUDE 'DPCOSU.INC'
5978      INCLUDE 'DPCODA.INC'
5979      INCLUDE 'DPCOST.INC'
5980      INCLUDE 'DPCOP2.INC'
5981C
5982C-----START POINT-----------------------------------------------------
5983C
5984      ISUBN1='DPLT'
5985      ISUBN2='ES  '
5986C
5987      MAXCP1=MAXCOL+1
5988      MAXCP2=MAXCOL+2
5989      MAXCP3=MAXCOL+3
5990      MAXCP4=MAXCOL+4
5991      MAXCP5=MAXCOL+5
5992      MAXCP6=MAXCOL+6
5993C
5994      IERROR='NO'
5995      IFOUND='YES'
5996C
5997C               **************************************
5998C               **  TREAT THE LEVENE TEST CASE  **
5999C               **************************************
6000C
6001      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LTES')THEN
6002        WRITE(ICOUT,999)
6003  999   FORMAT(1X)
6004        CALL DPWRST('XXX','BUG ')
6005        WRITE(ICOUT,51)
6006   51   FORMAT('***** AT THE BEGINNING OF DPLTES--')
6007        CALL DPWRST('XXX','BUG ')
6008        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO
6009   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
6010        CALL DPWRST('XXX','BUG ')
6011        WRITE(ICOUT,55)MAXNXT,IMULT,IFORSW
6012   55   FORMAT('MAXNXT,IMULT,IFORSW = ',I8,2X,A4,2X,A4)
6013        CALL DPWRST('XXX','BUG ')
6014      ENDIF
6015C
6016C               *********************************
6017C               **  STEP 1--                   **
6018C               **  EXTRACT THE VARIABLE LIST  **
6019C               *********************************
6020C
6021      ISTEPN='1'
6022      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LTES')
6023     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6024C
6025      INAME='LEVENE TEST'
6026      MINNA=1
6027      MAXNA=100
6028      MINNVA=2
6029      MAXNVA=2
6030      IFLAGE=1
6031      IFLAGM=0
6032      IF(IMULT.EQ.'ON')THEN
6033        IFLAGE=0
6034        IFLAGM=1
6035        MINNVA=2
6036        MAXNVA=30
6037      ENDIF
6038      MINN2=2
6039      IFLAGP=0
6040      JMIN=1
6041      JMAX=NUMARG
6042C
6043      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
6044     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
6045     1            JMIN,JMAX,
6046     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
6047     1            IVARN1,IVARN2,IVARTY,PVAR,
6048     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
6049     1            MINNVA,MAXNVA,
6050     1            IFLAGM,IFLAGP,
6051     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
6052      IF(IERROR.EQ.'YES')GOTO9000
6053C
6054      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LTES')THEN
6055        WRITE(ICOUT,999)
6056        CALL DPWRST('XXX','BUG ')
6057        WRITE(ICOUT,181)
6058  181   FORMAT('***** AFTER CALL DPPARS--')
6059        CALL DPWRST('XXX','BUG ')
6060        WRITE(ICOUT,182)NQ,NUMVAR,IMULT
6061  182   FORMAT('NQ,NUMVAR,IMULT = ',2I8,2X,A4)
6062        CALL DPWRST('XXX','BUG ')
6063        IF(NUMVAR.GT.0)THEN
6064          DO185I=1,NUMVAR
6065            WRITE(ICOUT,187)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
6066     1                      ICOLR(I)
6067  187       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
6068     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
6069            CALL DPWRST('XXX','BUG ')
6070  185     CONTINUE
6071        ENDIF
6072      ENDIF
6073C
6074C               ******************************************************
6075C               **  STEP 3--                                        **
6076C               **  GENERATE THE LEVENE TEST       FOR THE VARIOUS  **
6077C               **  CASES                                           **
6078C               ******************************************************
6079C
6080      ISTEPN='3'
6081      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
6082     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6083C
6084C               *****************************************
6085C               **  STEP 3A--                          **
6086C               **  CASE 1: TWO RESPONSE VARIABLES     **
6087C               **          WITH NO REPLICATION        **
6088C               *****************************************
6089C
6090C     NOTE: ONLY ALLOW MATRIX ARGUMENTS FOR "MULTIPLE" CASE.
6091C           FOR CASE WHERE SECOND VARIABLE IS A GROUP-ID VARIABLE,
6092C           MATRIX ARGUMENTS DON'T MAKE SENSE.
6093C
6094      IF(IMULT.EQ.'OFF')THEN
6095        ISTEPN='3A'
6096        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LTES')
6097     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6098C
6099        ICOL=1
6100        NUMVA2=2
6101        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
6102     1              INAME,IVARN1,IVARN2,IVARTY,
6103     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
6104     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
6105     1              MAXCP4,MAXCP5,MAXCP6,
6106     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
6107     1              Y,X,YTEMP,NLOCAL,NLOCA2,NLOCA3,ICASE,
6108     1              IBUGA3,ISUBRO,IFOUND,IERROR)
6109        IF(IERROR.EQ.'YES')GOTO9000
6110C
6111C               ******************************************************
6112C               **  STEP 3B--
6113C               **  PREPARE FOR ENTRANCE INTO DPLTE2--
6114C               ******************************************************
6115C
6116        ISTEPN='3B'
6117        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')THEN
6118          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6119          WRITE(ICOUT,999)
6120          CALL DPWRST('XXX','BUG ')
6121          WRITE(ICOUT,331)
6122  331     FORMAT('***** FROM DPLTES, AS WE ARE ABOUT TO CALL DPLTE2--')
6123          CALL DPWRST('XXX','BUG ')
6124          WRITE(ICOUT,332)NLOCAL
6125  332     FORMAT('NLOCAL = ',I8)
6126          CALL DPWRST('XXX','BUG ')
6127          DO335I=1,NLOCAL
6128            WRITE(ICOUT,336)I,Y(I),X(I)
6129  336       FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
6130            CALL DPWRST('XXX','BUG ')
6131  335     CONTINUE
6132        ENDIF
6133C
6134        CALL DPLTE2(Y,X,NLOCAL,ICASAN,MAXOBV,IVARN1,IVARN2,
6135     1              YTEMP,XTEMP,YMEAN,YMEDIA,T,TBARIV,DTAG,MAXNXT,
6136     1              TEMP1,TEMP2,TEMP3,TEMP4,
6137     1              ICAPSW,ICAPTY,IFORSW,IMULT,ILEVGS,
6138     1              STATVA,STATCD,
6139     1              CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
6140     1              IBUGA3,ISUBRO,IERROR)
6141C
6142C               *******************************************************
6143C               **  STEP 4A--                                        **
6144C               **  CASE 2: MULTIPLE RESPONSE VARIABLES.  NOTE THAT  **
6145C               **          LEVENE TEST, THE MULTIPLE LABS ARE       **
6146C               **          CONVERTED INTO A "Y X" STACKED PAIR      **
6147C               **          WHERE "X" IS THE LAB-ID VARIABLE.        **
6148C               *******************************************************
6149C
6150      ELSEIF(IMULT.EQ.'ON')THEN
6151        ISTEPN='4A'
6152        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LTES')
6153     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6154C
6155        ICOL=1
6156        NUMVA2=NUMVAR
6157        CALL DPPAR8(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
6158     1              INAME,IVARN1,IVARN2,IVARTY,
6159     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
6160     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
6161     1              MAXCP4,MAXCP5,MAXCP6,
6162     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
6163     1              XTEMP,Y,X,NLOCAL,ICASE,
6164     1              IBUGA3,ISUBRO,IFOUND,IERROR)
6165        IF(IERROR.EQ.'YES')GOTO9000
6166        NUMVAR=2
6167C
6168        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LTES')THEN
6169          ISTEPN='4B'
6170          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6171          WRITE(ICOUT,999)
6172          CALL DPWRST('XXX','BUG ')
6173          WRITE(ICOUT,442)
6174  442     FORMAT('***** FROM THE MIDDLE  OF DPLTES--')
6175          CALL DPWRST('XXX','BUG ')
6176          WRITE(ICOUT,443)ICASAN,NUMVAR,NLOCAL
6177  443     FORMAT('ICASAN,NUMVAR,NLOCAL = ',A4,2I8)
6178          CALL DPWRST('XXX','BUG ')
6179          IF(NLOCAL.GE.1)THEN
6180            DO445I=1,NLOCAL
6181              WRITE(ICOUT,446)I,Y(I),X(I)
6182  446         FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
6183              CALL DPWRST('XXX','BUG ')
6184  445       CONTINUE
6185          ENDIF
6186        ENDIF
6187C
6188        CALL DPLTE2(Y,X,NLOCAL,ICASAN,MAXOBV,IVARN1,IVARN2,
6189     1              YTEMP,XTEMP,YMEAN,YMEDIA,T,TBARIV,DTAG,MAXNXT,
6190     1              TEMP1,TEMP2,TEMP3,TEMP4,
6191     1              ICAPSW,ICAPTY,IFORSW,IMULT,ILEVGS,
6192     1              STATVA,STATCD,
6193     1              CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
6194     1              IBUGA3,ISUBRO,IERROR)
6195C
6196      ENDIF
6197C
6198C               ***************************************
6199C               **  STEP 61--                        **
6200C               **  UPDATE INTERNAL DATAPLOT TABLES  **
6201C               ***************************************
6202C
6203      ISTEPN='61'
6204      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LTES')
6205     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6206C
6207      ISUBN0='DPLT'
6208C
6209      IH='STAT'
6210      IH2='VAL '
6211      VALUE0=STATVA
6212      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6213     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6214     1IANS,IWIDTH,IBUGA3,IERROR)
6215C
6216      IH='STAT'
6217      IH2='CDF '
6218      VALUE0=STATCD
6219      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6220     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6221     1IANS,IWIDTH,IBUGA3,IERROR)
6222C
6223      IH='CUTO'
6224      IH2='FF0 '
6225      VALUE0=CUT0
6226      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6227     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6228     1IANS,IWIDTH,IBUGA3,IERROR)
6229C
6230      IH='CUTO'
6231      IH2='FF50'
6232      VALUE0=CUT50
6233      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6234     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6235     1IANS,IWIDTH,IBUGA3,IERROR)
6236C
6237      IH='CUTO'
6238      IH2='FF75'
6239      VALUE0=CUT75
6240      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6241     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6242     1IANS,IWIDTH,IBUGA3,IERROR)
6243C
6244      IH='CUTO'
6245      IH2='FF90'
6246      VALUE0=CUT90
6247      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6248     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6249     1IANS,IWIDTH,IBUGA3,IERROR)
6250C
6251      IH='CUTO'
6252      IH2='FF95'
6253      VALUE0=CUT95
6254      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6255     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6256     1IANS,IWIDTH,IBUGA3,IERROR)
6257C
6258      IH='CUTO'
6259      IH2='FF99'
6260      VALUE0=CUT99
6261      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6262     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6263     1IANS,IWIDTH,IBUGA3,IERROR)
6264C
6265      IH='CUTO'
6266      IH2='F999'
6267      VALUE0=CUT99
6268      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
6269     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
6270     1IANS,IWIDTH,IBUGA3,IERROR)
6271C
6272C               *****************
6273C               **  STEP 90--  **
6274C               **  EXIT       **
6275C               *****************
6276C
6277 9000 CONTINUE
6278      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LTES')THEN
6279        WRITE(ICOUT,999)
6280        CALL DPWRST('XXX','BUG ')
6281        WRITE(ICOUT,9011)
6282 9011   FORMAT('***** AT THE END       OF DPLTES--')
6283        CALL DPWRST('XXX','BUG ')
6284        WRITE(ICOUT,9014)NLOCAL,STATVA,STATCD
6285 9014   FORMAT('NLOCAL,STATVA,STATCD = ',I8,2G15.7)
6286        CALL DPWRST('XXX','BUG ')
6287        WRITE(ICOUT,9016)IFOUND,IERROR
6288 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
6289        CALL DPWRST('XXX','BUG ')
6290      ENDIF
6291C
6292      RETURN
6293      END
6294      SUBROUTINE DPLTE2(Y,TAG,N,ICASAN,MAXOBV,IVARID,IVARI2,
6295     1                  YTEMP,XTEMP,YMEAN,YMEDIA,T,TBARIV,DTAG,MAXNXT,
6296     1                  TEMP1,TEMP2,TEMP3,TEMP4,
6297     1                  ICAPSW,ICAPTY,IFORSW,IMULT,ILEVGS,
6298     1                  STATVA,STATCD,
6299     1                  CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
6300     1                  IBUGA3,ISUBRO,IERROR)
6301C
6302C     PURPOSE--THIS ROUTINE CARRIES OUT LEVENE'S TEST
6303C              (K-SAMPLE HOMOSCEDASTICITY TEST)
6304C     EXAMPLE--LEVENE'S TEST Y TAG
6305C     REFERENCE--Levene, H. (1960). In Contributions to Probability
6306C                and Statistics: Essays in Honor of Harold Hotelling,
6307C                I. Olkin et al. eds., Stanford University Press,
6308C                pp. 278-292.
6309C              --Brown, M. B. and Forsythe, A. B. (1974), Journal
6310C                of the American Statistical Association, 69, 364-367.
6311C     WRITTEN BY--JAMES J. FILLIBEN
6312C                 STATISTICAL ENGINEERING DIVISION
6313C                 INFORMATION TECHNOLOGY LABORATORY
6314C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
6315C                 Gaithersburg, MD 20899-8980
6316C                 PHONE--301-975-2855
6317C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
6318C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
6319C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
6320C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
6321C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
6322C     LANGUAGE--ANSI FORTRAN (1977)
6323C     VERSION NUMBER--97/9
6324C     ORIGINAL VERSION--SEPTEMBER 1997.
6325C     UPDATED         --AUGUST    1999. BUG FIX IN CALCULATION,
6326C                                       SUPPORT FOR MEDIAN, MEAN,
6327C                                       OR TRIMMED MEAN VERSION
6328C     UPDATED         --JANUARY   2004. SUPPORT FOR HTML, LATEX OUTPUT
6329C     UPDATED         --JULY      2005. ADD SOME TEXT TO THE OUTPUT
6330C                                       TO MAKE IT MORE EXPLICIT
6331C                                       WHICH VARIANT OF THE TEST
6332C                                       IS BEING USED.
6333C     UPDATED         --FEBRUARY  2011. USE DPDTA1 AND DPDTA4 TO PRINT
6334C                                       OUTPUT TABLES.  THIS ADDS RTF
6335C                                       SUPPORT AND SPECIFICATION OF
6336C                                       THE NUMBER OF DIGITS.
6337C     UPDATED         --FEBRUARY  2011. OPTION TO PRINT GROUP
6338C                                       STATISITCS.
6339C
6340C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
6341C
6342      CHARACTER*4 ICASAN
6343      CHARACTER*4 IBUGA3
6344      CHARACTER*4 ISUBRO
6345      CHARACTER*4 IERROR
6346      CHARACTER*4 ICAPSW
6347      CHARACTER*4 ICAPTY
6348      CHARACTER*4 IFORSW
6349      CHARACTER*4 IMULT
6350      CHARACTER*4 ILEVGS
6351      CHARACTER*4 IVARID(*)
6352      CHARACTER*4 IVARI2(*)
6353C
6354      CHARACTER*4 IWRITE
6355C
6356      CHARACTER*4 ISUBN1
6357      CHARACTER*4 ISUBN2
6358      CHARACTER*4 ISTEPN
6359C
6360      DOUBLE PRECISION DSUM1
6361C
6362C---------------------------------------------------------------------
6363C
6364      DIMENSION Y(*)
6365      DIMENSION TAG(*)
6366      DIMENSION DTAG(*)
6367      DIMENSION YTEMP(*)
6368      DIMENSION XTEMP(*)
6369      DIMENSION YMEDIA(*)
6370      DIMENSION YMEAN(*)
6371      DIMENSION T(*)
6372      DIMENSION TBARIV(*)
6373      DIMENSION TEMP1(*)
6374      DIMENSION TEMP2(*)
6375      DIMENSION TEMP3(*)
6376      DIMENSION TEMP4(*)
6377C
6378      PARAMETER (NUMALP=8)
6379      REAL ALPHA(NUMALP)
6380C
6381      PARAMETER(NUMCLI=4)
6382      PARAMETER(MAXLIN=2)
6383      PARAMETER (MAXROW=20)
6384      CHARACTER*60 ITITLE
6385      CHARACTER*60 ITITLZ
6386      CHARACTER*1  ITITL9
6387      CHARACTER*60 ITEXT(MAXROW)
6388      CHARACTER*4  ALIGN(NUMCLI)
6389      CHARACTER*4  VALIGN(NUMCLI)
6390      REAL         AVALUE(MAXROW)
6391      INTEGER      NCTEXT(MAXROW)
6392      INTEGER      IDIGIT(MAXROW)
6393      INTEGER      NTOT(MAXROW)
6394      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
6395      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
6396      CHARACTER*4  ITYPCO(NUMCLI)
6397      INTEGER      NCTIT2(MAXLIN,NUMCLI)
6398      INTEGER      NCVALU(MAXROW,NUMCLI)
6399      INTEGER      IWHTML(NUMCLI)
6400      INTEGER      IWRTF(NUMCLI)
6401      REAL         AMAT(MAXROW,NUMCLI)
6402      LOGICAL IFRST
6403      LOGICAL ILAST
6404C
6405C---------------------------------------------------------------------
6406C
6407      INCLUDE 'DPCOP2.INC'
6408C
6409      DATA ALPHA/
6410     1 0.0, 50.0, 75.0, 90.0, 95.0, 97.5, 99.0, 99.9/
6411C
6412C-----START POINT-----------------------------------------------------
6413C
6414      ISUBN1='DPLT'
6415      ISUBN2='E2  '
6416      IERROR='NO'
6417C
6418      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LTE2')THEN
6419        WRITE(ICOUT,999)
6420  999   FORMAT(1X)
6421        CALL DPWRST('XXX','WRIT')
6422        WRITE(ICOUT,51)
6423   51   FORMAT('**** AT THE BEGINNING OF DPLTE2--')
6424        CALL DPWRST('XXX','WRIT')
6425        WRITE(ICOUT,52)IBUGA3,ISUBRO,IMULT,ILEVGS,N
6426   52   FORMAT('IBUGA3,ISUBRO,IMULT,ILEVGS,N = ',4(A4,2X),I8)
6427        CALL DPWRST('XXX','WRIT')
6428        DO56I=1,N
6429          WRITE(ICOUT,57)I,Y(I),TAG(I)
6430   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
6431          CALL DPWRST('XXX','WRIT')
6432   56   CONTINUE
6433      ENDIF
6434C
6435C               ********************************************
6436C               **  STEP 11--                             **
6437C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
6438C               ********************************************
6439C
6440      ISTEPN='11'
6441      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
6442     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6443C
6444      IF(N.LT.2)THEN
6445        WRITE(ICOUT,999)
6446        CALL DPWRST('XXX','WRIT')
6447        WRITE(ICOUT,1111)
6448 1111   FORMAT('***** ERROR IN LEVENE TEST--')
6449        CALL DPWRST('XXX','WRIT')
6450        WRITE(ICOUT,1112)
6451 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE ',
6452     1         'VARIABLE IS LESS THAN TWO.')
6453        CALL DPWRST('XXX','WRIT')
6454        WRITE(ICOUT,1114)N
6455 1114   FORMAT('SAMPLE SIZE = ',I8)
6456        CALL DPWRST('XXX','WRIT')
6457        IERROR='YES'
6458        GOTO9000
6459      ENDIF
6460C
6461      HOLD=Y(1)
6462      DO1135I=2,N
6463        IF(Y(I).NE.HOLD)GOTO1139
6464 1135 CONTINUE
6465      WRITE(ICOUT,999)
6466      CALL DPWRST('XXX','WRIT')
6467      WRITE(ICOUT,1111)
6468      CALL DPWRST('XXX','WRIT')
6469      WRITE(ICOUT,1131)HOLD
6470 1131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
6471      CALL DPWRST('XXX','WRIT')
6472      GOTO9000
6473 1139 CONTINUE
6474C
6475      HOLD=TAG(1)
6476      DO1235I=2,N
6477      IF(TAG(I).NE.HOLD)GOTO1239
6478 1235 CONTINUE
6479      WRITE(ICOUT,999)
6480      CALL DPWRST('XXX','WRIT')
6481      WRITE(ICOUT,1111)
6482      CALL DPWRST('XXX','WRIT')
6483      WRITE(ICOUT,1231)HOLD
6484 1231 FORMAT('      THE GROUP-ID VARIABLE HAS ALL ELEMENTS = ',G15.7)
6485      CALL DPWRST('XXX','WRIT')
6486      GOTO9000
6487 1239 CONTINUE
6488C
6489C               ******************************
6490C               **  STEP 41--               **
6491C               **  CARRY OUT CALCULATIONS  **
6492C               **  FOR    LEVENE'S TEST    **
6493C               ******************************
6494C
6495      ISTEPN='41'
6496      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
6497     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6498C
6499      IWRITE='OFF'
6500      CALL DISTIN(TAG,N,IWRITE,DTAG,NUMDIS,IBUGA3,IERROR)
6501C
6502      DO4200IDIS=1,NUMDIS
6503         J=0
6504         DO4300I=1,N
6505            IF(TAG(I).EQ.DTAG(IDIS))THEN
6506               J=J+1
6507               YTEMP(J)=Y(I)
6508            ENDIF
6509 4300    CONTINUE
6510         CALL MEDIAN(YTEMP,J,IWRITE,XTEMP,MAXNXT,YMED,
6511     1               IBUGA3,IERROR)
6512         CALL MEAN(YTEMP,J,IWRITE,YMEANT,IBUGA3,IERROR)
6513         CALL SD(YTEMP,J,IWRITE,YSD,IBUGA3,IERROR)
6514         TEMP1(IDIS)=REAL(J)
6515         TEMP2(IDIS)=YMEANT
6516         TEMP3(IDIS)=YMED
6517         TEMP4(IDIS)=YSD
6518         IF(ICASAN.EQ.'LMED')THEN
6519           YMEDIA(IDIS)=YMED
6520         ELSEIF(ICASAN.EQ.'LMEA')THEN
6521           YMEDIA(IDIS)=YMEANT
6522         ELSEIF(ICASAN.EQ.'LTRI')THEN
6523           NTRIM1=-1
6524           NTRIM2=-1
6525           PROP1=10.0
6526           PROP2=10.0
6527           IUPPER=MAXOBV
6528           CALL TRIMME(YTEMP,J,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,XTEMP,
6529     1                 IUPPER,YMEDIA(IDIS),
6530     1                 IBUGA3,ISUBRO,IERROR)
6531           TEMP3(IDIS)=YMEDIA(IDIS)
6532         ELSE
6533           CALL MEDIAN(YTEMP,J,IWRITE,XTEMP,MAXNXT,YMEDIA(IDIS),
6534     1                 IBUGA3,IERROR)
6535         ENDIF
6536         DO4400I=1,N
6537           IF(TAG(I).EQ.DTAG(IDIS))T(I)=ABS(Y(I)-YMEDIA(IDIS))
6538 4400    CONTINUE
6539 4200 CONTINUE
6540C
6541CCCCC BUG FIX IN FOLLOWING LINE.  AUGUST 1999.
6542CCCCC CALL MEAN(Y,N,IWRITE,TBAR,IBUGA3,IERROR)
6543      CALL MEAN(T,N,IWRITE,TBAR,IBUGA3,IERROR)
6544C
6545      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LTE2')THEN
6546        WRITE(ICOUT,4901)TBAR
6547 4901   FORMAT('TBAR = ',G15.7)
6548        CALL DPWRST('XXX','BUG ')
6549        DO4905I=1,N
6550          WRITE(ICOUT,4906)I,TAG(I),DTAG(I),Y(I),T(I)
6551 4906     FORMAT('I,TAG(I),DTAG(I),Y(I),T(I)=',I8,4G15.7)
6552          CALL DPWRST('XXX','BUG ')
6553 4905   CONTINUE
6554      ENDIF
6555C
6556      DO5200IDIS=1,NUMDIS
6557         J=0
6558         DO5300I=1,N
6559            IF(TAG(I).EQ.DTAG(IDIS))THEN
6560               J=J+1
6561CCCCC BUG FIS: AUGUST 1999
6562CCCCC          YTEMP(J)=Y(I)
6563               YTEMP(J)=T(I)
6564            ENDIF
6565 5300    CONTINUE
6566         CALL MEAN(YTEMP,J,IWRITE,YMEAN(IDIS),IBUGA3,IERROR)
6567         DO5400I=1,N
6568           IF(TAG(I).EQ.DTAG(IDIS))TBARIV(I)=YMEAN(IDIS)
6569 5400    CONTINUE
6570 5200 CONTINUE
6571C
6572      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LTE2')THEN
6573        DO5205I=1,N
6574          WRITE(ICOUT,5206)I,TAG(I),DTAG(I),TBARIV(I)
6575 5206     FORMAT('I,TAG(I),DTAG(I),TBARIV(I)=',I8,3G15.7)
6576          CALL DPWRST('XXX','BUG ')
6577 5205   CONTINUE
6578      ENDIF
6579C
6580      DSUM1=0.D0
6581      DO6100I=1,N
6582        DSUM1=DSUM1 + (TBARIV(I)-TBAR)**2
6583 6100 CONTINUE
6584      SSQ=REAL(DSUM1)
6585      NUMDF=NUMDIS-1
6586      ANUMMS=SSQ/REAL(NUMDF)
6587C
6588      DSUM1=0.D0
6589      DO6200I=1,N
6590        DSUM1=DSUM1 + (T(I)-TBARIV(I))**2
6591 6200 CONTINUE
6592      SSQ=REAL(DSUM1)
6593      IDENDF=N-NUMDIS
6594      DENMS=SSQ/REAL(IDENDF)
6595C
6596      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LTE2')THEN
6597        WRITE(ICOUT,6201)ANUMMS,DENMS
6598 6201   FORMAT('ANUMMS,DENMS=',2G15.7)
6599        CALL DPWRST('XXX','BUG ')
6600      ENDIF
6601C
6602      STATVA=ANUMMS/DENMS
6603      CALL FCDF(STATVA,NUMDF,IDENDF,STATCD)
6604      PVAL=1.0-STATCD
6605C
6606      KM1=NUMDIS-1
6607      NMK=N-NUMDIS
6608C
6609      CUT0=0.0
6610      CALL FPPF(.50,KM1,NMK,CUT50)
6611      CALL FPPF(.75,KM1,NMK,CUT75)
6612      CALL FPPF(.90,KM1,NMK,CUT90)
6613      CALL FPPF(.95,KM1,NMK,CUT95)
6614      CALL FPPF(.99,KM1,NMK,CUT975)
6615      CALL FPPF(.99,KM1,NMK,CUT99)
6616      CALL FPPF(.999,KM1,NMK,CUT999)
6617C
6618C               ******************************
6619C               **   STEP 42--              **
6620C               **   WRITE OUT EVERYTHING   **
6621C               **   FOR   LEVENE'S TEST    **
6622C               ******************************
6623C
6624      ISTEPN='42'
6625      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
6626     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6627C
6628      IF(IPRINT.EQ.'OFF')GOTO9000
6629C
6630      NUMDIG=7
6631      IF(IFORSW.EQ.'1')NUMDIG=1
6632      IF(IFORSW.EQ.'2')NUMDIG=2
6633      IF(IFORSW.EQ.'3')NUMDIG=3
6634      IF(IFORSW.EQ.'4')NUMDIG=4
6635      IF(IFORSW.EQ.'5')NUMDIG=5
6636      IF(IFORSW.EQ.'6')NUMDIG=6
6637      IF(IFORSW.EQ.'7')NUMDIG=7
6638      IF(IFORSW.EQ.'8')NUMDIG=8
6639      IF(IFORSW.EQ.'9')NUMDIG=9
6640      IF(IFORSW.EQ.'0')NUMDIG=0
6641      IF(IFORSW.EQ.'E')NUMDIG=-2
6642      IF(IFORSW.EQ.'-2')NUMDIG=-2
6643      IF(IFORSW.EQ.'-3')NUMDIG=-3
6644      IF(IFORSW.EQ.'-4')NUMDIG=-4
6645      IF(IFORSW.EQ.'-5')NUMDIG=-5
6646      IF(IFORSW.EQ.'-6')NUMDIG=-6
6647      IF(IFORSW.EQ.'-7')NUMDIG=-7
6648      IF(IFORSW.EQ.'-8')NUMDIG=-8
6649      IF(IFORSW.EQ.'-9')NUMDIG=-9
6650C
6651      ITITLE='Levene F-Test for Shift in Variation'
6652      NCTITL=36
6653      IF(ICASAN.EQ.'LMED')THEN
6654        ITITLZ='(Case: Test Based on Medians)'
6655        NCTITZ=29
6656      ELSEIF(ICASAN.EQ.'LMEA')THEN
6657        ITITLZ='(Case: Test Based on Means)'
6658        NCTITZ=27
6659      ELSEIF(ICASAN.EQ.'LTRI')THEN
6660        ITITLZ='(Case: Test Based on Trimmed Means)'
6661        NCTITZ=35
6662      ENDIF
6663C
6664      ICNT=1
6665      ITEXT(ICNT)=' '
6666      NCTEXT(ICNT)=0
6667      AVALUE(ICNT)=0.0
6668      IDIGIT(ICNT)=-1
6669      IF(IMULT.EQ.'OFF')THEN
6670        ICNT=ICNT+1
6671        ITEXT(ICNT)='Response Variable: '
6672        WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
6673        WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
6674        NCTEXT(ICNT)=27
6675        AVALUE(ICNT)=0.0
6676        IDIGIT(ICNT)=-1
6677C
6678        ICNT=ICNT+1
6679        ITEXT(ICNT)='Group-ID Variable: '
6680        WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(2)(1:4)
6681        WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(2)(1:4)
6682        NCTEXT(ICNT)=27
6683        AVALUE(ICNT)=0.0
6684        IDIGIT(ICNT)=-1
6685      ENDIF
6686C
6687C     IF REQUESTED, PRINT OUT GROUP INFORMATION.  SINCE NUMBER
6688C     OF GROUPS IS UNKNOWN (AND POTENTIALLY LARGE, PRINT EACH
6689C     GROUP AS A SEPARATE TABLE.
6690C
6691      IF(ILEVGS.EQ.'ON')THEN
6692C
6693        DO2160I=1,NUMDIS
6694C
6695          NUMROW=ICNT
6696          DO2165II=1,NUMROW
6697            NTOT(II)=15
6698 2165     CONTINUE
6699C
6700          IFRST=.TRUE.
6701          ILAST=.TRUE.
6702C
6703          CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
6704     1                AVALUE,IDIGIT,
6705     1                NTOT,NUMROW,
6706     1                ICAPSW,ICAPTY,ILAST,IFRST,
6707     1                ISUBRO,IBUGA3,IERROR)
6708          ICNT=0
6709          ITITLE=' '
6710          NCTITL=0
6711          ITITLZ=' '
6712          NCTITZ=0
6713C
6714          ICNT=ICNT+1
6715          ITEXT(ICNT)=' '
6716          NCTEXT(ICNT)=1
6717          AVALUE(ICNT)=0.0
6718          IDIGIT(ICNT)=-1
6719C
6720          IF(IMULT.EQ.'ON')THEN
6721            ICNT=ICNT+1
6722            ITEXT(ICNT)='Group Variable: '
6723            WRITE(ITEXT(ICNT)(17:20),'(A4)')IVARID(I)(1:4)
6724            WRITE(ITEXT(ICNT)(21:24),'(A4)')IVARI2(I)(1:4)
6725            NCTEXT(ICNT)=24
6726            AVALUE(ICNT)=0.0
6727            IDIGIT(ICNT)=-1
6728          ELSE
6729            ICNT=ICNT+1
6730            ITEXT(ICNT)='Group    '
6731            WRITE(ITEXT(ICNT)(7:9),'(I3)')I
6732            NCTEXT(ICNT)=9
6733            AVALUE(ICNT)=0.0
6734            IDIGIT(ICNT)=-1
6735          ENDIF
6736          ICNT=ICNT+1
6737          ITEXT(ICNT)='Number of Observations:'
6738          NCTEXT(ICNT)=23
6739          AVALUE(ICNT)=TEMP1(I)
6740          IDIGIT(ICNT)=0
6741          ICNT=ICNT+1
6742          ITEXT(ICNT)='Mean:'
6743          NCTEXT(ICNT)=5
6744          AVALUE(ICNT)=TEMP2(I)
6745          IDIGIT(ICNT)=NUMDIG
6746          IF(ICASAN.EQ.'LTRI')THEN
6747            ICNT=ICNT+1
6748            ITEXT(ICNT)='Trimmed Mean:'
6749            NCTEXT(ICNT)=13
6750            AVALUE(ICNT)=TEMP3(I)
6751            IDIGIT(ICNT)=NUMDIG
6752          ELSE
6753            ICNT=ICNT+1
6754            ITEXT(ICNT)='Median:'
6755            NCTEXT(ICNT)=7
6756            AVALUE(ICNT)=TEMP3(I)
6757            IDIGIT(ICNT)=NUMDIG
6758          ENDIF
6759          ICNT=ICNT+1
6760          ITEXT(ICNT)='SD:'
6761          NCTEXT(ICNT)=3
6762          AVALUE(ICNT)=TEMP4(I)
6763          IDIGIT(ICNT)=NUMDIG
6764 2160   CONTINUE
6765C
6766        IF(ICNT.GT.0)THEN
6767          NUMROW=ICNT
6768          DO2168II=1,NUMROW
6769            NTOT(II)=15
6770 2168     CONTINUE
6771C
6772          IFRST=.TRUE.
6773          ILAST=.TRUE.
6774C
6775          CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
6776     1                AVALUE,IDIGIT,
6777     1                NTOT,NUMROW,
6778     1                ICAPSW,ICAPTY,ILAST,IFRST,
6779     1                ISUBRO,IBUGA3,IERROR)
6780          ICNT=0
6781        ENDIF
6782C
6783      ENDIF
6784C
6785      ICNT=ICNT+1
6786      ITEXT(ICNT)=' '
6787      NCTEXT(ICNT)=1
6788      AVALUE(ICNT)=0.0
6789      IDIGIT(ICNT)=-1
6790C
6791      ICNT=ICNT+1
6792      ITEXT(ICNT)='H0: Homogeneous Variances'
6793      NCTEXT(ICNT)=25
6794      AVALUE(ICNT)=0.0
6795      IDIGIT(ICNT)=-1
6796      ICNT=ICNT+1
6797      ITEXT(ICNT)='Ha: Variances Are Not Homogeneous'
6798      NCTEXT(ICNT)=33
6799      AVALUE(ICNT)=0.0
6800      IDIGIT(ICNT)=-1
6801C
6802      ICNT=ICNT+1
6803      ITEXT(ICNT)=' '
6804      NCTEXT(ICNT)=1
6805      AVALUE(ICNT)=0.0
6806      IDIGIT(ICNT)=-1
6807      ICNT=ICNT+1
6808      ITEXT(ICNT)='Summary Statistics:'
6809      NCTEXT(ICNT)=19
6810      AVALUE(ICNT)=0.0
6811      IDIGIT(ICNT)=-1
6812      ICNT=ICNT+1
6813      ITEXT(ICNT)='Total Number of Observations:'
6814      NCTEXT(ICNT)=29
6815      AVALUE(ICNT)=REAL(N)
6816      IDIGIT(ICNT)=0
6817      ICNT=ICNT+1
6818      ITEXT(ICNT)='Number of Groups:'
6819      NCTEXT(ICNT)=17
6820      AVALUE(ICNT)=REAL(NUMDIS)
6821      IDIGIT(ICNT)=0
6822      ICNT=ICNT+1
6823      ITEXT(ICNT)=' '
6824      NCTEXT(ICNT)=1
6825      AVALUE(ICNT)=0.0
6826      IDIGIT(ICNT)=-1
6827C
6828      ICNT=ICNT+1
6829      ITEXT(ICNT)='Levene Test Statistic Value:'
6830      NCTEXT(ICNT)=28
6831      AVALUE(ICNT)=STATVA
6832      IDIGIT(ICNT)=NUMDIG
6833      ICNT=ICNT+1
6834      ITEXT(ICNT)='CDF of Test Statistic:'
6835      NCTEXT(ICNT)=22
6836      AVALUE(ICNT)=STATCD
6837      IDIGIT(ICNT)=NUMDIG
6838      ICNT=ICNT+1
6839      ITEXT(ICNT)='P-Value:'
6840      NCTEXT(ICNT)=8
6841      AVALUE(ICNT)=1.0 - STATCD
6842      IDIGIT(ICNT)=NUMDIG
6843C
6844      NUMROW=ICNT
6845      DO4210I=1,NUMROW
6846        NTOT(I)=15
6847 4210 CONTINUE
6848C
6849      IFRST=.TRUE.
6850      ILAST=.TRUE.
6851C
6852      ISTEPN='42A'
6853      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
6854     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6855C
6856      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
6857     1            AVALUE,IDIGIT,
6858     1            NTOT,NUMROW,
6859     1            ICAPSW,ICAPTY,ILAST,IFRST,
6860     1            ISUBRO,IBUGA3,IERROR)
6861C
6862      ISTEPN='42B'
6863      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
6864     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6865C
6866      ITITLE=' '
6867      NCTITL=0
6868C
6869      ITITL9=' '
6870      NCTIT9=0
6871      ITITLE(1:44)='Percent Points of the Reference Distribution'
6872      NCTITL=44
6873      NUMLIN=1
6874      NUMROW=8
6875      NUMCOL=3
6876      ITITL2(1,1)='Percent Point'
6877      ITITL2(1,2)=' '
6878      ITITL2(1,3)='Value'
6879      NCTIT2(1,1)=13
6880      NCTIT2(1,2)=1
6881      NCTIT2(1,3)=5
6882C
6883      NMAX=0
6884      DO4221I=1,NUMCOL
6885        VALIGN(I)='b'
6886        ALIGN(I)='r'
6887        NTOT(I)=15
6888        IF(I.EQ.2)NTOT(I)=5
6889        NMAX=NMAX+NTOT(I)
6890        IDIGIT(I)=NUMDIG
6891        ITYPCO(I)='NUME'
6892 4221 CONTINUE
6893      ITYPCO(2)='ALPH'
6894      IDIGIT(1)=1
6895      IDIGIT(3)=3
6896      DO4223I=1,NUMROW
6897        DO4225J=1,NUMCOL
6898          NCVALU(I,J)=0
6899          IVALUE(I,J)=' '
6900          NCVALU(I,J)=0
6901          AMAT(I,J)=0.0
6902          IF(J.EQ.1)THEN
6903            AMAT(I,J)=ALPHA(I)
6904          ELSEIF(J.EQ.2)THEN
6905            IVALUE(I,J)='='
6906            NCVALU(I,J)=1
6907          ELSEIF(J.EQ.3)THEN
6908            IF(I.EQ.1)THEN
6909              AMAT(I,J)=RND(CUT0,IDIGIT(J))
6910            ELSEIF(I.EQ.2)THEN
6911              AMAT(I,J)=RND(CUT50,IDIGIT(J))
6912            ELSEIF(I.EQ.3)THEN
6913              AMAT(I,J)=RND(CUT75,IDIGIT(J))
6914            ELSEIF(I.EQ.4)THEN
6915              AMAT(I,J)=RND(CUT90,IDIGIT(J))
6916            ELSEIF(I.EQ.5)THEN
6917              AMAT(I,J)=RND(CUT95,IDIGIT(J))
6918            ELSEIF(I.EQ.6)THEN
6919              AMAT(I,J)=RND(CUT975,IDIGIT(J))
6920            ELSEIF(I.EQ.7)THEN
6921              AMAT(I,J)=RND(CUT99,IDIGIT(J))
6922            ELSEIF(I.EQ.8)THEN
6923              AMAT(I,J)=RND(CUT999,IDIGIT(J))
6924            ENDIF
6925          ENDIF
6926 4225   CONTINUE
6927 4223 CONTINUE
6928C
6929      IWHTML(1)=150
6930      IWHTML(2)=50
6931      IWHTML(3)=150
6932      IWRTF(1)=2000
6933      IWRTF(2)=IWRTF(1)+500
6934      IWRTF(3)=IWRTF(2)+2000
6935      IFRST=.TRUE.
6936      ILAST=.FALSE.
6937C
6938      ISTEPN='42C'
6939      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
6940     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6941C
6942      CALL DPDTA4(ITITL9,NCTIT9,
6943     1            ITITLE,NCTITL,ITITL2,NCTIT2,
6944     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
6945     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
6946     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
6947     1            ICAPSW,ICAPTY,IFRST,ILAST,
6948     1            ISUBRO,IBUGA3,IERROR)
6949C
6950      ISTEPN='42D'
6951      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
6952     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
6953C
6954      CDF1=CUT90
6955      CDF2=CUT95
6956      CDF3=CUT975
6957      CDF4=CUT99
6958C
6959      ITITL9=' '
6960      NCTIT9=0
6961      ITITLE='Conclusions (Upper 1-Tailed Test)'
6962      NCTITL=33
6963      NUMLIN=1
6964      NUMROW=4
6965      NUMCOL=4
6966      ITITL2(1,1)='Alpha'
6967      ITITL2(1,2)='CDF'
6968      ITITL2(1,3)='Critical Value'
6969      ITITL2(1,4)='Conclusion'
6970      NCTIT2(1,1)=5
6971      NCTIT2(1,2)=3
6972      NCTIT2(1,3)=14
6973      NCTIT2(1,4)=10
6974C
6975      NMAX=0
6976      DO4321I=1,NUMCOL
6977        VALIGN(I)='b'
6978        ALIGN(I)='r'
6979        NTOT(I)=15
6980        IF(I.EQ.1 .OR. I.EQ.2)NTOT(I)=7
6981        IF(I.EQ.3)NTOT(I)=17
6982        NMAX=NMAX+NTOT(I)
6983        IDIGIT(I)=3
6984        ITYPCO(I)='ALPH'
6985 4321 CONTINUE
6986      ITYPCO(3)='NUME'
6987      IDIGIT(1)=0
6988      IDIGIT(2)=0
6989      DO4323I=1,NUMROW
6990        DO4325J=1,NUMCOL
6991          NCVALU(I,J)=0
6992          IVALUE(I,J)=' '
6993          NCVALU(I,J)=0
6994          AMAT(I,J)=0.0
6995 4325   CONTINUE
6996 4323 CONTINUE
6997      IVALUE(1,1)='10%'
6998      IVALUE(2,1)='5%'
6999      IVALUE(3,1)='2.5%'
7000      IVALUE(4,1)='1%'
7001      IVALUE(1,2)='90%'
7002      IVALUE(2,2)='95%'
7003      IVALUE(3,2)='97.5%'
7004      IVALUE(4,2)='99%'
7005      NCVALU(1,1)=3
7006      NCVALU(2,1)=2
7007      NCVALU(3,1)=4
7008      NCVALU(4,1)=2
7009      NCVALU(1,2)=3
7010      NCVALU(2,2)=3
7011      NCVALU(3,2)=5
7012      NCVALU(4,2)=3
7013      IVALUE(1,4)='Accept H0'
7014      IVALUE(2,4)='Accept H0'
7015      IVALUE(3,4)='Accept H0'
7016      IVALUE(4,4)='Accept H0'
7017      NCVALU(1,4)=9
7018      NCVALU(2,4)=9
7019      NCVALU(3,4)=9
7020      NCVALU(4,4)=9
7021      IF(STATVA.GT.CUT90)IVALUE(1,4)='Reject H0'
7022      IF(STATVA.GT.CUT95)IVALUE(2,4)='Reject H0'
7023      IF(STATVA.GT.CUT975)IVALUE(3,4)='Reject H0'
7024      IF(STATVA.GT.CUT99)IVALUE(4,4)='Reject H0'
7025      AMAT(1,3)=RND(CUT90,IDIGIT(3))
7026      AMAT(2,3)=RND(CUT95,IDIGIT(3))
7027      AMAT(3,3)=RND(CUT975,IDIGIT(3))
7028      AMAT(4,3)=RND(CUT99,IDIGIT(3))
7029C
7030      IWHTML(1)=150
7031      IWHTML(2)=150
7032      IWHTML(3)=150
7033      IWHTML(4)=150
7034      IWRTF(1)=1500
7035      IWRTF(2)=IWRTF(1)+1500
7036      IWRTF(3)=IWRTF(2)+2000
7037      IWRTF(4)=IWRTF(3)+2000
7038      IFRST=.FALSE.
7039      ILAST=.TRUE.
7040C
7041      ISTEPN='42E'
7042      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LTE2')
7043     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7044C
7045      CALL DPDTA4(ITITL9,NCTIT9,
7046     1            ITITLE,NCTITL,ITITL2,NCTIT2,
7047     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
7048     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
7049     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
7050     1            ICAPSW,ICAPTY,IFRST,ILAST,
7051     1            ISUBRO,IBUGA3,IERROR)
7052C
7053C               *****************
7054C               **  STEP 90--  **
7055C               **  EXIT       **
7056C               *****************
7057C
7058 9000 CONTINUE
7059      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'LTE2')THEN
7060        WRITE(ICOUT,999)
7061        CALL DPWRST('XXX','WRIT')
7062        WRITE(ICOUT,9011)
7063 9011   FORMAT('***** AT THE END       OF DPLTE2--')
7064        CALL DPWRST('XXX','WRIT')
7065        WRITE(ICOUT,9012)N,IBUGA3,IERROR
7066 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
7067        CALL DPWRST('XXX','WRIT')
7068        WRITE(ICOUT,9014)STATVA,STATCD,PVAL
7069 9014   FORMAT('STATVA,STATCD,PVAL = ',3G15.7)
7070        CALL DPWRST('XXX','WRIT')
7071      ENDIF
7072C
7073      RETURN
7074      END
7075      SUBROUTINE DPLUJA(XTEMP1,MAXNXT,
7076     1                  ICASAN,ICAPSW,IFORSW,
7077     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
7078C
7079C     PURPOSE--CARRY OUT LJUNG BOX TEST FOR RANDOMNESS
7080C     EXAMPLE--LJUNG BOX TEST Y
7081C     REFERENCE--PETER BROCKWELL AND RICHARD DAVIS (2002).
7082C                "INTRODUCTION TO TIME SERIES AND FORECASTING",
7083C                SECOND EDITION, SPRINGER.
7084C     TEST--  Q=N*(N+2_SUM[J=1 TO H][RHOHAT**2/(N-J)
7085C             REJECT RANDOMNESS IF Q > CHI-SQUARE PPF(H,1-ALPHA)
7086C             WHERE RHOHAT IS THE SAMPLE AUTOCORRELATION
7087C     WRITTEN BY--ALAN HECKERT
7088C                 STATISTICAL ENGINEERING DIVISION
7089C                 INFORMATION TECHNOLOGY LABORATORY
7090C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
7091C                 Gaithersburg, MD 20899-8980
7092C                 PHONE--301-975-2899
7093C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
7094C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
7095C     LANGUAGE--ANSI FORTRAN (1977)
7096C     VERSION NUMBER--2003/3
7097C     ORIGINAL VERSION--FEBRUARY  2003.
7098C     UPDATED         --MARCH     2011. USE DPPARS ROUTINE
7099C     UPATED          --MARCH     2011. REWRITTEN TO HANDLE MULTIPLE
7100C                                       RESPONSE VARIABLES, GROUP-ID
7101C                                       VARIABLES, OR A LAB-ID VARIABLE
7102C     UPATED          --JULY      2019. TWEAK TO SCRATCH STORAGE
7103C
7104C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
7105C
7106      CHARACTER*4 ICASAN
7107      CHARACTER*4 ICAPSW
7108      CHARACTER*4 IFORSW
7109      CHARACTER*4 IBUGA2
7110      CHARACTER*4 IBUGA3
7111      CHARACTER*4 IBUGQ
7112      CHARACTER*4 ISUBRO
7113      CHARACTER*4 IFOUND
7114      CHARACTER*4 IERROR
7115C
7116      CHARACTER*4 MESSAG
7117      CHARACTER*4 IHWUSE
7118      CHARACTER*4 ISUBN1
7119      CHARACTER*4 ISUBN2
7120      CHARACTER*4 ISTEPN
7121      CHARACTER*4 IH
7122      CHARACTER*4 IH2
7123      CHARACTER*4 IFLAGU
7124C
7125      LOGICAL IFRST
7126      LOGICAL ILAST
7127C
7128      CHARACTER*4 IREPL
7129      CHARACTER*4 IMULT
7130      CHARACTER*4 ICTMP1
7131      CHARACTER*4 ICTMP2
7132      CHARACTER*4 ICTMP3
7133      CHARACTER*4 ICTMP4
7134      CHARACTER*4 ICASE
7135C
7136      CHARACTER*40 INAME
7137      PARAMETER (MAXSPN=30)
7138      CHARACTER*4 IVARN1(MAXSPN)
7139      CHARACTER*4 IVARN2(MAXSPN)
7140      CHARACTER*4 IVARTY(MAXSPN)
7141      CHARACTER*4 IVARID(1)
7142      CHARACTER*4 IVARI2(1)
7143      REAL PVAR(MAXSPN)
7144      REAL PID(MAXSPN)
7145      INTEGER ILIS(MAXSPN)
7146      INTEGER NRIGHT(MAXSPN)
7147      INTEGER ICOLR(MAXSPN)
7148C
7149C---------------------------------------------------------------------
7150C
7151      DIMENSION XTEMP1(*)
7152C
7153C-----COMMON----------------------------------------------------------
7154C
7155      INCLUDE 'DPCOPA.INC'
7156      INCLUDE 'DPCOZZ.INC'
7157C
7158      DIMENSION YTEMP1(MAXOBV)
7159      DIMENSION XDESGN(MAXOBV,7)
7160      DIMENSION XIDTEM(MAXOBV)
7161      DIMENSION XIDTE2(MAXOBV)
7162      DIMENSION XIDTE3(MAXOBV)
7163      DIMENSION XIDTE4(MAXOBV)
7164      DIMENSION XIDTE5(MAXOBV)
7165      DIMENSION XIDTE6(MAXOBV)
7166      DIMENSION TEMP1(MAXOBV)
7167      DIMENSION TEMP2(MAXOBV)
7168C
7169      EQUIVALENCE (GARBAG(IGARB1),YTEMP1(1))
7170      EQUIVALENCE (GARBAG(IGARB2),TEMP1(1))
7171      EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
7172      EQUIVALENCE (GARBAG(IGARB4),XIDTE2(1))
7173      EQUIVALENCE (GARBAG(IGARB5),XIDTE3(1))
7174      EQUIVALENCE (GARBAG(IGARB6),XIDTE4(1))
7175      EQUIVALENCE (GARBAG(IGARB7),XIDTE5(1))
7176      EQUIVALENCE (GARBAG(IGARB8),XIDTE6(1))
7177      EQUIVALENCE (GARBAG(IGARB9),TEMP2(1))
7178      EQUIVALENCE (GARBAG(IGAR10),XDESGN(1,1))
7179C
7180C-----COMMON VARIABLES (GENERAL)--------------------------------------
7181C
7182      INCLUDE 'DPCOHK.INC'
7183      INCLUDE 'DPCOSU.INC'
7184      INCLUDE 'DPCODA.INC'
7185      INCLUDE 'DPCOST.INC'
7186      INCLUDE 'DPCOP2.INC'
7187C
7188C-----START POINT-----------------------------------------------------
7189C
7190      ISUBN1='DPLU'
7191      ISUBN2='JA  '
7192      ICASAN='LUJA'
7193      IREPL='NO'
7194      IMULT='NO'
7195      IFOUND='NO'
7196      IERROR='NO'
7197C
7198      MAXCP1=MAXCOL+1
7199      MAXCP2=MAXCOL+2
7200      MAXCP3=MAXCOL+3
7201      MAXCP4=MAXCOL+4
7202      MAXCP5=MAXCOL+5
7203      MAXCP6=MAXCOL+6
7204C
7205C               ********************************************
7206C               **  TREAT THE LJUNG-BOX        TEST CASE  **
7207C               ********************************************
7208C
7209      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')THEN
7210        WRITE(ICOUT,999)
7211  999   FORMAT(1X)
7212        CALL DPWRST('XXX','BUG ')
7213        WRITE(ICOUT,51)
7214   51   FORMAT('***** AT THE BEGINNING OF DPLUJA--')
7215        CALL DPWRST('XXX','BUG ')
7216        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO,MAXNXT
7217   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO,MAXNXT = ',3(A4,2X),I8)
7218        CALL DPWRST('XXX','BUG ')
7219      ENDIF
7220C
7221C               *****************************************************
7222C               **  STEP 1--                                       **
7223C               **  EXTRACT THE COMMAND                            **
7224C               **  LOOK FOR ONE OF THE FOLLOWING COMMANDS:        **
7225C               **    1) LJUNG-BOX TEST   Y                        **
7226C               **    2) MULTIPLE LJUNG-BOX TEST   Y1 ... YK       **
7227C               **    3) REPLICATED LJUNG-BOX TEST   Y X1 ... XK   **
7228C               *****************************************************
7229C
7230      ISTEPN='1'
7231      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
7232     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7233C
7234      ILASTC=9999
7235      ILASTZ=9999
7236C
7237      DO100I=0,NUMARG-1
7238C
7239        IF(I.EQ.0)THEN
7240          ICTMP1=ICOM
7241        ELSE
7242          ICTMP1=IHARG(I)
7243        ENDIF
7244        ICTMP2=IHARG(I+1)
7245        ICTMP3=IHARG(I+2)
7246        ICTMP4=IHARG(I+3)
7247C
7248        IF(ICTMP1.EQ.'=')THEN
7249          IFOUND='NO'
7250          GOTO9000
7251        ELSEIF(ICTMP1.EQ.'LJUN' .AND. ICTMP2.EQ.'BOX' .AND.
7252     1         ICTMP3.EQ.'TEST')THEN
7253          IFOUND='YES'
7254          ILASTC=I
7255          ILASTZ=I+2
7256        ELSEIF(ICTMP1.EQ.'LJUN' .AND. ICTMP2.EQ.'BOX')THEN
7257          IFOUND='YES'
7258          ILASTC=I
7259          ILASTZ=I+1
7260        ELSEIF(ICTMP1.EQ.'REPL')THEN
7261          IREPL='ON'
7262          ILASTC=MIN(ILASTC,I)
7263          ILASTZ=MAX(ILASTZ,I)
7264        ELSEIF(ICTMP1.EQ.'MULT')THEN
7265          IMULT='ON'
7266          ILASTC=MIN(ILASTC,I)
7267          ILASTZ=MAX(ILASTZ,I)
7268        ENDIF
7269  100 CONTINUE
7270C
7271      IF(IFOUND.EQ.'NO')GOTO9000
7272C
7273      ISHIFT=ILASTZ
7274      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
7275     1            IBUGA2,IERROR)
7276C
7277      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')THEN
7278        WRITE(ICOUT,91)ICASAN,IMULT,IREPL,ISHIFT
7279   91   FORMAT('DPFRTE: ICASAN,IMULT,IREPL,ISHIFT = ',3(A4,2X),I5)
7280        CALL DPWRST('XXX','BUG ')
7281      ENDIF
7282C
7283      IF(IMULT.EQ.'ON')THEN
7284        IF(IREPL.EQ.'ON')THEN
7285          WRITE(ICOUT,999)
7286          CALL DPWRST('XXX','BUG ')
7287          WRITE(ICOUT,101)
7288  101     FORMAT('***** ERROR IN LJUNG-BOX TEST--')
7289          CALL DPWRST('XXX','BUG ')
7290          WRITE(ICOUT,103)
7291  103     FORMAT('      YOU CANNOT SPECIFY BOTH "MULTIPLE" AND ',
7292     1           '"REPLICATION"')
7293          CALL DPWRST('XXX','BUG ')
7294          WRITE(ICOUT,104)
7295  104     FORMAT('      FOR THE LJUNG-BOX TEST COMMAND.')
7296          CALL DPWRST('XXX','BUG ')
7297          IERROR='YES'
7298          GOTO9000
7299        ENDIF
7300      ENDIF
7301C
7302C               *********************************
7303C               **  STEP 4--                   **
7304C               **  EXTRACT THE VARIABLE LIST  **
7305C               *********************************
7306C
7307      ISTEPN='4'
7308      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
7309     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7310C
7311      INAME='LJUNG-BOX TEST'
7312      MINNA=1
7313      MAXNA=100
7314      MINN2=2
7315      IFLAGE=0
7316      IFLAGM=1
7317      IF(IREPL.EQ.'ON')THEN
7318        IFLAGM=0
7319        IFLAGE=1
7320      ENDIF
7321      IFLAGP=0
7322      JMIN=1
7323      JMAX=NUMARG
7324      MINNVA=1
7325      MAXNVA=MAXSPN
7326C
7327      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
7328     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
7329     1            JMIN,JMAX,
7330     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
7331     1            IVARN1,IVARN2,IVARTY,PVAR,
7332     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
7333     1            MINNVA,MAXNVA,
7334     1            IFLAGM,IFLAGP,
7335     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
7336      IF(IERROR.EQ.'YES')GOTO9000
7337C
7338      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')THEN
7339        WRITE(ICOUT,999)
7340        CALL DPWRST('XXX','BUG ')
7341        WRITE(ICOUT,281)
7342  281   FORMAT('***** AFTER CALL DPPARS--')
7343        CALL DPWRST('XXX','BUG ')
7344        WRITE(ICOUT,282)NQ,NUMVAR
7345  282   FORMAT('NQ,NUMVAR = ',2I8)
7346        CALL DPWRST('XXX','BUG ')
7347        IF(NUMVAR.GT.0)THEN
7348          DO285I=1,NUMVAR
7349            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
7350     1                      ICOLR(I)
7351  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
7352     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
7353            CALL DPWRST('XXX','BUG ')
7354  285     CONTINUE
7355        ENDIF
7356      ENDIF
7357C
7358C               ***********************************************
7359C               **  STEP 5--                                 **
7360C               **  DETERMINE:                               **
7361C               **  1) NUMBER OF REPLICATION VARIABLES (0-6) **
7362C               **  2) NUMBER OF RESPONSE    VARIABLES (>= 1)**
7363C               ***********************************************
7364C
7365      ISTEPN='5'
7366      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
7367     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7368C
7369      NRESP=0
7370      NREPL=0
7371      IF(IMULT.EQ.'ON')THEN
7372        NRESP=NUMVAR
7373      ELSEIF(IREPL.EQ.'ON')THEN
7374        NRESP=1
7375        NREPL=NUMVAR-NRESP
7376        IF(NREPL.LT.1 .OR. NREPL.GT.6)THEN
7377          WRITE(ICOUT,999)
7378          CALL DPWRST('XXX','BUG ')
7379          WRITE(ICOUT,101)
7380          CALL DPWRST('XXX','BUG ')
7381          WRITE(ICOUT,511)
7382  511     FORMAT('      FOR THE REPLICATION CASE, THE NUMBER OF ',
7383     1           'REPLICATION VARIABLES')
7384          CALL DPWRST('XXX','BUG ')
7385          WRITE(ICOUT,512)
7386  512     FORMAT('      MUST BE BETWEEN ONE AND SIX.')
7387          CALL DPWRST('XXX','BUG ')
7388          WRITE(ICOUT,513)NREPL
7389  513     FORMAT('      THE NUMBER OF REPLICATION VARIABLES = ',I5)
7390          CALL DPWRST('XXX','BUG ')
7391          IERROR='YES'
7392          GOTO9000
7393        ENDIF
7394      ELSE
7395        NRESP=NUMVAR
7396        IMULT='ON'
7397      ENDIF
7398C
7399      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')THEN
7400        WRITE(ICOUT,521)NRESP,NREPL
7401  521   FORMAT('NRESP,NREPL = ',2I5)
7402        CALL DPWRST('XXX','BUG ')
7403      ENDIF
7404C
7405C               *****************************************************
7406C               **  STEP 53--                                      **
7407C               **  DETERMINE IF THE ANALYST HAS SPECIFIED THE     **
7408C               **  NUMBER OF LAGS DESIRED FOR THE LJUNG-BOX TEST. **
7409C               **  SEARCH FOR ONE OF THE FOLLOWING PREVIOUSLY     **
7410C               **  DEFINED PARAMETER NAMES:                       **
7411C               **       LAGS, LAG, OR NUMLAG                      **
7412C               **  IF FOUND, USE THE SPECIFIED VALUE              **
7413C               **  (WHICH MUST BE BETWEEN 1 AND 1000, INCLUSIVE); **
7414C               **  IF NOT FOUND, USE THE DEFAULT VALUE            **
7415C               **  (USUALLY NS/4) WHICH WILL BE DEFINED           **
7416C               **  IN THE SUBROUTINE DPLJU2.                      **
7417C               *****************************************************
7418C
7419      ISTEPN='53'
7420      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
7421     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7422C
7423      NUMLAG=0
7424C
7425      IH='LAGS'
7426      IH2='    '
7427      IHWUSE='P'
7428      MESSAG='NO'
7429      CALL CHECKN(IH,IH2,IHWUSE,
7430     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
7431     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
7432      IF(IERROR.EQ.'NO')THEN
7433        NUMLAG=INT(VALUE(ILOCV)+0.5)
7434        GOTO590
7435      ENDIF
7436C
7437      IH='LAG '
7438      IH2='    '
7439      IHWUSE='P'
7440      MESSAG='NO'
7441      CALL CHECKN(IH,IH2,IHWUSE,
7442     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
7443     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
7444      IF(IERROR.EQ.'NO')THEN
7445        NUMLAG=INT(VALUE(ILOCV)+0.5)
7446        GOTO590
7447      ENDIF
7448C
7449      IH='NUML'
7450      IH2='AG  '
7451      IHWUSE='P'
7452      MESSAG='NO'
7453      CALL CHECKN(IH,IH2,IHWUSE,
7454     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
7455     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
7456      IF(IERROR.EQ.'NO')THEN
7457        NUMLAG=INT(VALUE(ILOCV)+0.5)
7458        GOTO590
7459      ENDIF
7460C
7461  590 CONTINUE
7462C
7463C               ******************************************************
7464C               **  STEP 6--                                        **
7465C               **  GENERATE THE LJUNG-BOX        TEST FOR THE      **
7466C               **  VARIOUS CASES                                   **
7467C               ******************************************************
7468C
7469      ISTEPN='6'
7470      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
7471     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7472C
7473C               ******************************************
7474C               **  STEP 8A--                           **
7475C               **  CASE 1: NO REPLICATION VARIABLES    **
7476C               ******************************************
7477C
7478      IF(NREPL.LT.1)THEN
7479        ISTEPN='8A'
7480        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
7481     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7482C
7483C       LOOP THROUGH EACH OF THE RESPONSE VARIABLES
7484C
7485        NCURVE=0
7486        DO810IRESP=1,NRESP
7487          NCURVE=NCURVE+1
7488C
7489          IINDX=ICOLR(IRESP)
7490          PID(1)=CPUMIN
7491          IVARID(1)=IVARN1(IRESP)
7492          IVARI2(1)=IVARN2(IRESP)
7493C
7494          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')THEN
7495            WRITE(ICOUT,999)
7496            CALL DPWRST('XXX','BUG ')
7497            WRITE(ICOUT,811)IRESP,NCURVE
7498  811       FORMAT('IRESP,NCURVE = ',2I5)
7499            CALL DPWRST('XXX','BUG ')
7500          ENDIF
7501C
7502          ICOL=IRESP
7503          NUMVA2=1
7504          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
7505     1                INAME,IVARN1,IVARN2,IVARTY,
7506     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
7507     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
7508     1                MAXCP4,MAXCP5,MAXCP6,
7509     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
7510     1                Y,XTEMP1,XTEMP1,NS1,NLOCA2,NLOCA3,ICASE,
7511     1                IBUGA3,ISUBRO,IFOUND,IERROR)
7512          IF(IERROR.EQ.'YES')GOTO9000
7513C
7514C         *****************************************************
7515C         **  STEP 8B--                                      **
7516C         *****************************************************
7517C
7518          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LUJA')THEN
7519            ISTEPN='8B'
7520            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7521            WRITE(ICOUT,999)
7522            CALL DPWRST('XXX','BUG ')
7523            WRITE(ICOUT,822)
7524  822       FORMAT('***** FROM THE MIDDLE  OF DPLUJA--')
7525            CALL DPWRST('XXX','BUG ')
7526            WRITE(ICOUT,823)ICASAN,NUMVAR,NLOCAL
7527  823       FORMAT('ICASAN,NUMVAR,NQ = ',A4,2I8)
7528            CALL DPWRST('XXX','BUG ')
7529            IF(NLOCAL.GE.1)THEN
7530              DO825I=1,NLOCAL
7531                WRITE(ICOUT,826)I,Y(I)
7532  826           FORMAT('I,Y(I) = ',I8,G15.7)
7533                CALL DPWRST('XXX','BUG ')
7534  825         CONTINUE
7535            ENDIF
7536          ENDIF
7537C
7538          CALL DPLUJ2(Y,NS1,MAXNXT,
7539     1                ICAPSW,ICAPTY,IFORSW,ICASAN,
7540     1                PID,IVARID,IVARI2,NREPL,
7541     1                STATVA,STATCD,PVAL,
7542     1                CUT0,CUT50,CUT75,CUT90,CUT95,
7543     1                CUT975,CUT99,CUT999,
7544     1                YTEMP1,NUMLAG,
7545     1                ISUBRO,IBUGA3,IERROR)
7546C
7547C               ***************************************
7548C               **  STEP 8C--                        **
7549C               **  UPDATE INTERNAL DATAPLOT TABLES  **
7550C               ***************************************
7551C
7552          ISTEPN='8C'
7553          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
7554     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7555C
7556          IF(NRESP.GT.1)THEN
7557            IFLAGU='FILE'
7558          ELSE
7559            IFLAGU='ON'
7560          ENDIF
7561          IFRST=.FALSE.
7562          ILAST=.FALSE.
7563          IF(IRESP.EQ.1)IFRST=.TRUE.
7564          IF(IRESP.EQ.NRESP)ILAST=.TRUE.
7565          CALL DPFRT5(STATVA,STATCD,PVAL,
7566     1                CUT0,CUT50,CUT75,CUT90,CUT95,
7567     1                CUT975,CUT99,CUT999,
7568     1                IFLAGU,IFRST,ILAST,
7569     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
7570  810   CONTINUE
7571C
7572C               ****************************************************
7573C               **  STEP 9A--                                     **
7574C               **  CASE 3: ONE OR MORE REPLICATION VARIABLES.    **
7575C               **          FOR THIS CASE, THE NUMBER OF RESPONSE **
7576C               **          VARIABLES MUST BE EXACTLY 1.          **
7577C               **          FOR THIS CASE, ALL VARIABLES MUST     **
7578C               **          HAVE THE SAME LENGTH.                 **
7579C               ****************************************************
7580C
7581      ELSEIF(NREPL.GE.1)THEN
7582        ISTEPN='9A'
7583        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
7584     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7585C
7586        J=0
7587        IMAX=NRIGHT(1)
7588        IF(NQ.LT.NRIGHT(1))IMAX=NQ
7589        DO910I=1,IMAX
7590          IF(ISUB(I).EQ.0)GOTO910
7591          J=J+1
7592C
7593C         RESPONSE VARIABLE IN Y
7594C
7595          ICOLC=1
7596          IJ=MAXN*(ICOLR(ICOLC)-1)+I
7597          IF(ICOLR(ICOLC).LE.MAXCOL)Y(J)=V(IJ)
7598          IF(ICOLR(ICOLC).EQ.MAXCP1)Y(J)=PRED(I)
7599          IF(ICOLR(ICOLC).EQ.MAXCP2)Y(J)=RES(I)
7600          IF(ICOLR(ICOLC).EQ.MAXCP3)Y(J)=YPLOT(I)
7601          IF(ICOLR(ICOLC).EQ.MAXCP4)Y(J)=XPLOT(I)
7602          IF(ICOLR(ICOLC).EQ.MAXCP5)Y(J)=X2PLOT(I)
7603          IF(ICOLR(ICOLC).EQ.MAXCP6)Y(J)=TAGPLO(I)
7604C
7605          IF(NREPL.GE.1)THEN
7606            DO920IR=1,MIN(NREPL,6)
7607              ICOLC=ICOLC+1
7608              ICOLT=ICOLR(ICOLC)
7609              IJ=MAXN*(ICOLT-1)+I
7610              IF(ICOLT.LE.MAXCOL)XDESGN(J,IR)=V(IJ)
7611              IF(ICOLT.EQ.MAXCP1)XDESGN(J,IR)=PRED(I)
7612              IF(ICOLT.EQ.MAXCP2)XDESGN(J,IR)=RES(I)
7613              IF(ICOLT.EQ.MAXCP3)XDESGN(J,IR)=YPLOT(I)
7614              IF(ICOLT.EQ.MAXCP4)XDESGN(J,IR)=XPLOT(I)
7615              IF(ICOLT.EQ.MAXCP5)XDESGN(J,IR)=X2PLOT(I)
7616              IF(ICOLT.EQ.MAXCP6)XDESGN(J,IR)=TAGPLO(I)
7617  920       CONTINUE
7618          ENDIF
7619C
7620  910   CONTINUE
7621        NLOCAL=J
7622C
7623C       *****************************************************
7624C       **  STEP 9B--                                      **
7625C       **  CALL DPLUJ2 TO PERFORM LJUNG-BOX        TEST.  **
7626C       *****************************************************
7627C
7628C
7629        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'LUJA')THEN
7630          ISTEPN='9C'
7631          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
7632          WRITE(ICOUT,999)
7633          CALL DPWRST('XXX','BUG ')
7634          WRITE(ICOUT,941)
7635  941     FORMAT('***** FROM THE MIDDLE  OF DPLUJA--')
7636          CALL DPWRST('XXX','BUG ')
7637          WRITE(ICOUT,942)ICASAN,NUMVAR,NLOCAL,NREPL
7638  942     FORMAT('ICASAN,NUMVAR,NLOCAL,NREPL = ',
7639     1           A4,3I8)
7640          CALL DPWRST('XXX','BUG ')
7641          IF(NLOCAL.GE.1)THEN
7642            DO945I=1,NLOCAL
7643              WRITE(ICOUT,946)I,Y(I),XDESGN(I,1),XDESGN(I,2)
7644  946         FORMAT('I,Y(I),XDESGN(I,1),XDESGN(I,2) = ',
7645     1               I8,4F12.5)
7646              CALL DPWRST('XXX','BUG ')
7647  945       CONTINUE
7648          ENDIF
7649        ENDIF
7650C
7651C       *****************************************************
7652C       **  STEP 9C--                                      **
7653C       **  FIND THE DISTINCT VALUES IN EACH OF THE        **
7654C       **  REPLICATION VARIABLES.                         **
7655C       *****************************************************
7656C
7657        CALL DPPP5(XDESGN(1,1),XDESGN(1,2),XDESGN(1,3),
7658     1             XDESGN(1,4),XDESGN(1,5),XDESGN(1,6),
7659     1             NREPL,NLOCAL,MAXOBV,
7660     1             XIDTEM,XIDTE2,XIDTE3,XIDTE4,XIDTE5,XIDTE6,
7661     1             XTEMP1,TEMP2,
7662     1             NUMSE1,NUMSE2,NUMSE3,NUMSE4,NUMSE5,NUMSE6,
7663     1             IBUGA3,ISUBRO,IERROR)
7664C
7665C       *****************************************************
7666C       **  STEP 9D--                                      **
7667C       **  NOW LOOP THROUGH THE VARIOUS REPLICATIONS      **
7668C       *****************************************************
7669C
7670        NCURVE=0
7671        IADD=1
7672C
7673        IF(NREPL.EQ.1)THEN
7674          J=0
7675          DO1110ISET1=1,NUMSE1
7676            K=0
7677            PID(IADD+1)=XIDTEM(ISET1)
7678            DO1130I=1,NLOCAL
7679              IF(XIDTEM(ISET1).EQ.XDESGN(I,1))THEN
7680                K=K+1
7681                TEMP1(K)=Y(I)
7682              ENDIF
7683 1130       CONTINUE
7684            NTEMP=K
7685            NCURVE=NCURVE+1
7686            IF(NTEMP.GT.0)THEN
7687              CALL DPLUJ2(TEMP1,NTEMP,MAXNXT,
7688     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
7689     1                    PID,IVARID,IVARI2,NREPL,
7690     1                    STATVA,STATCD,PVAL,
7691     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7692     1                    CUT975,CUT99,CUT999,
7693     1                    YTEMP1,NUMLAG,
7694     1                    ISUBRO,IBUGA3,IERROR)
7695            ENDIF
7696            IFLAGU='FILE'
7697            IFRST=.FALSE.
7698            ILAST=.FALSE.
7699            IF(NCURVE.EQ.1)IFRST=.TRUE.
7700            IF(NCURVE.EQ.NUMSE1)ILAST=.TRUE.
7701            CALL DPFRT5(STATVA,STATCD,PVAL,
7702     1                  CUT0,CUT50,CUT75,CUT90,CUT95,
7703     1                  CUT975,CUT99,CUT999,
7704     1                  IFLAGU,IFRST,ILAST,
7705     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
7706 1110     CONTINUE
7707        ELSEIF(NREPL.EQ.2)THEN
7708          J=0
7709          NTOT=NUMSE1*NUMSE2
7710          DO1210ISET1=1,NUMSE1
7711          DO1220ISET2=1,NUMSE2
7712            K=0
7713            PID(1+IADD)=XIDTEM(ISET1)
7714            PID(2+IADD)=XIDTE2(ISET2)
7715            DO1290I=1,NLOCAL
7716              IF(
7717     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
7718     1           XIDTE2(ISET2).EQ.XDESGN(I,2)
7719     1          )THEN
7720                K=K+1
7721                TEMP1(K)=Y(I)
7722              ENDIF
7723 1290       CONTINUE
7724            NTEMP=K
7725            NCURVE=NCURVE+1
7726            IF(NTEMP.GT.0)THEN
7727              CALL DPLUJ2(TEMP1,NTEMP,MAXNXT,
7728     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
7729     1                    PID,IVARID,IVARI2,NREPL,
7730     1                    STATVA,STATCD,PVAL,
7731     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7732     1                    CUT975,CUT99,CUT999,
7733     1                    YTEMP1,NUMLAG,
7734     1                    ISUBRO,IBUGA3,IERROR)
7735              IFLAGU='FILE'
7736              IFRST=.FALSE.
7737              ILAST=.FALSE.
7738              IF(NCURVE.EQ.1)IFRST=.TRUE.
7739              IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
7740              CALL DPFRT5(STATVA,STATCD,PVAL,
7741     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7742     1                    CUT975,CUT99,CUT999,
7743     1                    IFLAGU,IFRST,ILAST,
7744     1                    IBUGA2,IBUGA3,ISUBRO,IERROR)
7745            ENDIF
7746 1220     CONTINUE
7747 1210     CONTINUE
7748        ELSEIF(NREPL.EQ.3)THEN
7749          J=0
7750          NTOT=NUMSE1*NUMSE2*NUMSE3
7751          DO1310ISET1=1,NUMSE1
7752          DO1320ISET2=1,NUMSE2
7753          DO1330ISET3=1,NUMSE3
7754            K=0
7755            PID(1+IADD)=XIDTEM(ISET1)
7756            PID(2+IADD)=XIDTE2(ISET2)
7757            PID(3+IADD)=XIDTE3(ISET3)
7758            DO1390I=1,NLOCAL
7759              IF(
7760     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
7761     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
7762     1           XIDTE3(ISET3).EQ.XDESGN(I,3)
7763     1          )THEN
7764                K=K+1
7765                TEMP1(K)=Y(I)
7766              ENDIF
7767 1390       CONTINUE
7768            NTEMP=K
7769            NCURVE=NCURVE+1
7770            NPLOT1=NPLOTP
7771            IF(NTEMP.GT.0)THEN
7772              CALL DPLUJ2(TEMP1,NTEMP,MAXNXT,
7773     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
7774     1                    PID,IVARID,IVARI2,NREPL,
7775     1                    STATVA,STATCD,PVAL,
7776     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7777     1                    CUT975,CUT99,CUT999,
7778     1                    YTEMP1,NUMLAG,
7779     1                    ISUBRO,IBUGA3,IERROR)
7780              IFLAGU='FILE'
7781              IFRST=.FALSE.
7782              ILAST=.FALSE.
7783              IF(NCURVE.EQ.1)IFRST=.TRUE.
7784              IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
7785              CALL DPFRT5(STATVA,STATCD,PVAL,
7786     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7787     1                    CUT975,CUT99,CUT999,
7788     1                    IFLAGU,IFRST,ILAST,
7789     1                    IBUGA2,IBUGA3,ISUBRO,IERROR)
7790            ENDIF
7791 1330     CONTINUE
7792 1320     CONTINUE
7793 1310     CONTINUE
7794        ELSEIF(NREPL.EQ.4)THEN
7795          J=0
7796          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4
7797          DO1410ISET1=1,NUMSE1
7798          DO1420ISET2=1,NUMSE2
7799          DO1430ISET3=1,NUMSE3
7800          DO1440ISET4=1,NUMSE4
7801            K=0
7802            PID(1+IADD)=XIDTEM(ISET1)
7803            PID(2+IADD)=XIDTE2(ISET2)
7804            PID(3+IADD)=XIDTE3(ISET3)
7805            PID(4+IADD)=XIDTE4(ISET4)
7806            DO1490I=1,NLOCAL
7807              IF(
7808     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
7809     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
7810     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
7811     1           XIDTE4(ISET4).EQ.XDESGN(I,4)
7812     1          )THEN
7813                K=K+1
7814                TEMP1(K)=Y(I)
7815              ENDIF
7816 1490       CONTINUE
7817            NTEMP=K
7818            NCURVE=NCURVE+1
7819            NPLOT1=NPLOTP
7820            IF(NTEMP.GT.0)THEN
7821              CALL DPLUJ2(TEMP1,NTEMP,MAXNXT,
7822     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
7823     1                    PID,IVARID,IVARI2,NREPL,
7824     1                    STATVA,STATCD,PVAL,
7825     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7826     1                    CUT975,CUT99,CUT999,
7827     1                    YTEMP1,NUMLAG,
7828     1                    ISUBRO,IBUGA3,IERROR)
7829              IFLAGU='FILE'
7830              IFRST=.FALSE.
7831              ILAST=.FALSE.
7832              IF(NCURVE.EQ.1)IFRST=.TRUE.
7833              IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
7834              CALL DPFRT5(STATVA,STATCD,PVAL,
7835     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7836     1                    CUT975,CUT99,CUT999,
7837     1                    IFLAGU,IFRST,ILAST,
7838     1                    IBUGA2,IBUGA3,ISUBRO,IERROR)
7839            ENDIF
7840 1440     CONTINUE
7841 1430     CONTINUE
7842 1420     CONTINUE
7843 1410     CONTINUE
7844        ELSEIF(NREPL.EQ.5)THEN
7845          J=0
7846          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5
7847          DO1510ISET1=1,NUMSE1
7848          DO1520ISET2=1,NUMSE2
7849          DO1530ISET3=1,NUMSE3
7850          DO1540ISET4=1,NUMSE4
7851          DO1550ISET5=1,NUMSE5
7852            K=0
7853            PID(1+IADD)=XIDTEM(ISET1)
7854            PID(2+IADD)=XIDTE2(ISET2)
7855            PID(3+IADD)=XIDTE3(ISET3)
7856            PID(4+IADD)=XIDTE4(ISET4)
7857            PID(5+IADD)=XIDTE5(ISET4)
7858            DO1590I=1,NLOCAL
7859              IF(
7860     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
7861     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
7862     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
7863     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
7864     1           XIDTE5(ISET5).EQ.XDESGN(I,5)
7865     1          )THEN
7866                K=K+1
7867                TEMP1(K)=Y(I)
7868              ENDIF
7869 1590       CONTINUE
7870            NTEMP=K
7871            NCURVE=NCURVE+1
7872            NPLOT1=NPLOTP
7873            IF(NTEMP.GT.0)THEN
7874              CALL DPLUJ2(TEMP1,NTEMP,MAXNXT,
7875     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
7876     1                    PID,IVARID,IVARI2,NREPL,
7877     1                    STATVA,STATCD,PVAL,
7878     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7879     1                    CUT975,CUT99,CUT999,
7880     1                    YTEMP1,NUMLAG,
7881     1                    ISUBRO,IBUGA3,IERROR)
7882              IFLAGU='FILE'
7883              IFRST=.FALSE.
7884              ILAST=.FALSE.
7885              IF(NCURVE.EQ.1)IFRST=.TRUE.
7886              IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
7887              CALL DPFRT5(STATVA,STATCD,PVAL,
7888     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7889     1                    CUT975,CUT99,CUT999,
7890     1                    IFLAGU,IFRST,ILAST,
7891     1                    IBUGA2,IBUGA3,ISUBRO,IERROR)
7892            ENDIF
7893 1550     CONTINUE
7894 1540     CONTINUE
7895 1530     CONTINUE
7896 1520     CONTINUE
7897 1510     CONTINUE
7898        ELSEIF(NREPL.EQ.6)THEN
7899          J=0
7900          NTOT=NUMSE1*NUMSE2*NUMSE3*NUMSE4*NUMSE5*NUMSE6
7901          DO1610ISET1=1,NUMSE1
7902          DO1620ISET2=1,NUMSE2
7903          DO1630ISET3=1,NUMSE3
7904          DO1640ISET4=1,NUMSE4
7905          DO1650ISET5=1,NUMSE5
7906          DO1660ISET6=1,NUMSE6
7907            K=0
7908            PID(1+IADD)=XIDTEM(ISET1)
7909            PID(2+IADD)=XIDTE2(ISET2)
7910            PID(3+IADD)=XIDTE3(ISET3)
7911            PID(4+IADD)=XIDTE4(ISET4)
7912            PID(5+IADD)=XIDTE5(ISET4)
7913            PID(6+IADD)=XIDTE6(ISET4)
7914            DO1690I=1,NLOCAL
7915              IF(
7916     1           XIDTEM(ISET1).EQ.XDESGN(I,1) .AND.
7917     1           XIDTE2(ISET2).EQ.XDESGN(I,2) .AND.
7918     1           XIDTE3(ISET3).EQ.XDESGN(I,3) .AND.
7919     1           XIDTE4(ISET4).EQ.XDESGN(I,4) .AND.
7920     1           XIDTE5(ISET5).EQ.XDESGN(I,5) .AND.
7921     1           XIDTE6(ISET6).EQ.XDESGN(I,6)
7922     1          )THEN
7923                K=K+1
7924                TEMP1(K)=Y(I)
7925              ENDIF
7926 1690       CONTINUE
7927            NTEMP=K
7928            NCURVE=NCURVE+1
7929            NPLOT1=NPLOTP
7930            IF(NTEMP.GT.0)THEN
7931              CALL DPLUJ2(TEMP1,NTEMP,MAXNXT,
7932     1                    ICAPSW,ICAPTY,IFORSW,ICASAN,
7933     1                    PID,IVARID,IVARI2,NREPL,
7934     1                    STATVA,STATCD,PVAL,
7935     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7936     1                    CUT975,CUT99,CUT999,
7937     1                    YTEMP1,NUMLAG,
7938     1                    ISUBRO,IBUGA3,IERROR)
7939              IFLAGU='FILE'
7940              IFRST=.FALSE.
7941              ILAST=.FALSE.
7942              IF(NCURVE.EQ.1)IFRST=.TRUE.
7943              IF(NCURVE.EQ.NTOT)ILAST=.TRUE.
7944              CALL DPFRT5(STATVA,STATCD,PVAL,
7945     1                    CUT0,CUT50,CUT75,CUT90,CUT95,
7946     1                    CUT975,CUT99,CUT999,
7947     1                    IFLAGU,IFRST,ILAST,
7948     1                    IBUGA2,IBUGA3,ISUBRO,IERROR)
7949            ENDIF
7950 1660     CONTINUE
7951 1650     CONTINUE
7952 1640     CONTINUE
7953 1630     CONTINUE
7954 1620     CONTINUE
7955 1610     CONTINUE
7956        ENDIF
7957C
7958      ENDIF
7959C
7960C               *****************
7961C               **  STEP 90--  **
7962C               **  EXIT       **
7963C               *****************
7964C
7965 9000 CONTINUE
7966      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')THEN
7967        WRITE(ICOUT,999)
7968        CALL DPWRST('XXX','BUG ')
7969        WRITE(ICOUT,9011)
7970 9011   FORMAT('***** AT THE END       OF DPLUJA--')
7971        CALL DPWRST('XXX','BUG ')
7972        WRITE(ICOUT,9016)IFOUND,IERROR
7973 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
7974        CALL DPWRST('XXX','BUG ')
7975      ENDIF
7976C
7977      RETURN
7978      END
7979      SUBROUTINE DPLUJ2(Y,N,MAXNXT,
7980     1                  ICAPSW,ICAPTY,IFORSW,ICASAN,
7981     1                  PID,IVARID,IVARI2,NREPL,
7982     1                  STATVA,STATCD,PVAL,
7983     1                  CUT0,CUT50,CUT75,CUT90,CUT95,
7984     1                  CUT975,CUT99,CUT999,
7985     1                  YTEMP1,NUMLAG,
7986     1                  ISUBRO,IBUGA3,IERROR)
7987C
7988C     PURPOSE--THIS ROUTINE CARRIES OUT THE LJUNG-BOX TEST
7989C              FOR RANDOMNESS.
7990C     EXAMPLE--LJUNG-BOX TEST Y
7991C     REFERENCE--PETER BROCKWELL AND RICHARD DAVIS (2002).
7992C                "INTRODUCTION TO TIME SERIES AND FORECASTING",
7993C                SECOND EDITION, SPRINGER.
7994C     TEST--  Q=N*(N+2_SUM[J=1 TO H][RHOHAT**2/(N-J)
7995C             REJECT RANDOMNESS IF Q > CHI-SQUARE PPF(H,1-ALPHA)
7996C             WHERE RHOHAT IS THE SAMPLE AUTOCORRELATION
7997C     WRITTEN BY--ALAN HECKERT
7998C                 STATISTICAL ENGINEERING DIVISION
7999C                 INFORMATION TECHNOLOGY LABORATORY
8000C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8001C                 GAITHERSBURG, MD 20899-8980
8002C                 PHONE--301-975-2899
8003C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8004C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8005C     LANGUAGE--ANSI FORTRAN (1977)
8006C     VERSION NUMBER--2003/3
8007C     ORIGINAL VERSION--FEBRUARY  2003.
8008C     UPDATED         --MARCH     2011. USE DPDTA1 AND DPDTA5 TO PRINT
8009C                                       TABLES
8010C
8011C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8012C
8013      CHARACTER*4 IVARID(*)
8014      CHARACTER*4 IVARI2(*)
8015C
8016      CHARACTER*4 ICAPSW
8017      CHARACTER*4 ICAPTY
8018      CHARACTER*4 IFORSW
8019      CHARACTER*4 ICASAN
8020C
8021      CHARACTER*4 ISUBRO
8022      CHARACTER*4 IBUGA3
8023      CHARACTER*4 IERROR
8024C
8025      CHARACTER*4 IWRITE
8026C
8027      CHARACTER*4 ISUBN1
8028      CHARACTER*4 ISUBN2
8029      CHARACTER*4 ISTEPN
8030C
8031C---------------------------------------------------------------------
8032C
8033      DIMENSION Y(*)
8034      DIMENSION YTEMP1(*)
8035      DIMENSION PID(*)
8036C
8037      PARAMETER (NUMALP=8)
8038C
8039      PARAMETER(NUMCLI=5)
8040      PARAMETER(MAXLIN=3)
8041      PARAMETER (MAXROW=NUMALP)
8042      PARAMETER (MAXRO2=20)
8043      CHARACTER*60 ITITLE
8044      CHARACTER*60 ITITLZ
8045      CHARACTER*1  ITITL9
8046      CHARACTER*60 ITEXT(MAXRO2)
8047      CHARACTER*4  ALIGN(NUMCLI)
8048      CHARACTER*4  VALIGN(NUMCLI)
8049      REAL         AVALUE(MAXRO2)
8050      INTEGER      NCTEXT(MAXRO2)
8051      INTEGER      IDIGIT(MAXRO2)
8052      INTEGER      NTOT(MAXRO2)
8053      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
8054      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
8055      CHARACTER*4  ITYPCO(NUMCLI)
8056      INTEGER      NCTIT2(MAXLIN,NUMCLI)
8057      INTEGER      NCVALU(MAXROW,NUMCLI)
8058      INTEGER      IWHTML(NUMCLI)
8059      INTEGER      IWRTF(NUMCLI)
8060      REAL         AMAT(MAXROW,NUMCLI)
8061      LOGICAL IFRST
8062      LOGICAL ILAST
8063      LOGICAL IFLAGS
8064      LOGICAL IFLAGE
8065C
8066C---------------------------------------------------------------------
8067C
8068      INCLUDE 'DPCOP2.INC'
8069C
8070C-----START POINT-----------------------------------------------------
8071C
8072      ISUBN1='DPLU'
8073      ISUBN2='J2  '
8074      IERROR='NO'
8075C
8076      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')THEN
8077        WRITE(ICOUT,999)
8078  999   FORMAT(1X)
8079        CALL DPWRST('XXX','WRIT')
8080        WRITE(ICOUT,51)
8081   51   FORMAT('**** AT THE BEGINNING OF DPLUJ2--')
8082        CALL DPWRST('XXX','WRIT')
8083        WRITE(ICOUT,52)ICASAN,IBUGA3,ISUBRO,N
8084   52   FORMAT('ICASAN,IBUGA3,ISUBRO,N = ',3(A4,2X),I8)
8085        CALL DPWRST('XXX','WRIT')
8086        DO56I=1,N
8087          WRITE(ICOUT,57)I,Y(I)
8088   57     FORMAT('I,Y(I), = ',I8,G15.7)
8089          CALL DPWRST('XXX','WRIT')
8090   56   CONTINUE
8091      ENDIF
8092C
8093C               ********************************************
8094C               **  STEP 11--                             **
8095C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
8096C               ********************************************
8097C
8098      ISTEPN='11'
8099      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
8100     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8101C
8102      IF(N.LE.5)THEN
8103        WRITE(ICOUT,999)
8104        CALL DPWRST('XXX','WRIT')
8105        WRITE(ICOUT,1111)
8106 1111   FORMAT('***** ERROR IN LJUNG-BOX TEST.')
8107        CALL DPWRST('XXX','WRIT')
8108        WRITE(ICOUT,1113)
8109 1113   FORMAT('      AT LEAST SIX OBSERVATIONS REQUIRED.')
8110        CALL DPWRST('XXX','WRIT')
8111        WRITE(ICOUT,1115)N
8112 1115   FORMAT('SAMPLE SIZE = ',I8)
8113        CALL DPWRST('XXX','WRIT')
8114        IERROR='YES'
8115        GOTO9000
8116      ENDIF
8117C
8118      HOLD=Y(1)
8119      DO1135I=2,N
8120      IF(Y(I).NE.HOLD)GOTO1139
8121 1135 CONTINUE
8122      WRITE(ICOUT,999)
8123      CALL DPWRST('XXX','WRIT')
8124      WRITE(ICOUT,1111)
8125      CALL DPWRST('XXX','WRIT')
8126      WRITE(ICOUT,1131)HOLD
8127 1131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
8128      CALL DPWRST('XXX','WRIT')
8129      IERROR='YES'
8130      GOTO9000
8131 1139 CONTINUE
8132C
8133C               *******************************
8134C               **  STEP 2--                 **
8135C               **  IF NECESSARY,            **
8136C               **  COMPUTE THE MAXIMUM LAG  **
8137C               *******************************
8138C
8139      ISTEPN='2'
8140      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
8141     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8142C
8143      MAXLAG=MAXNXT
8144      IF(NUMLAG.GE.1)KMAX=NUMLAG
8145      IF(NUMLAG.LE.0)KMAX=N/4
8146      IF(NUMLAG.LE.0.AND.N.LE.32)KMAX=N/2
8147      IF(NUMLAG.LE.0.AND.N.LE.16)KMAX=N
8148      IF(KMAX.GT.MAXLAG)KMAX=MAXLAG
8149      NM1=N-1
8150      IF(KMAX.GT.NM1)KMAX=NM1
8151      IF(N.LE.16)THEN
8152         NM2=N-2
8153         IF(KMAX.GT.NM2)KMAX=NM2
8154      ENDIF
8155      KMAXM1=KMAX-1
8156      AKMAXM=KMAXM1
8157C
8158C               ******************************************************
8159C               **  STEP 2.1--                                      **
8160C               **  COMPUTE THE AUTOCORRELATIONS FOR THE Y  DATA    **
8161C               **  DO SO IN 3 STEPS--                              **
8162C               **     1) COMPUTE THE SAMPLE MEAN;                  **
8163C               **     2) COMPUTE THE SAMPLE VARIANCE;              **
8164C               **     3) COMPUTE THE AUTOCORRELATIONS;             **
8165C               **  REFERENCE--JENKINS AND WATTS, PAGE 382 (9.3.1)  **
8166C               ******************************************************
8167C
8168      ISTEPN='2.1'
8169      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
8170     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8171C
8172C     COMPUTE AUTOCORRELATIONS FOR N <= 20
8173C
8174      IF(N.LE.16)THEN
8175        AN=N
8176C
8177        DO2110K=1,KMAXM1
8178          NMK=N-K
8179          ANMK=NMK
8180          SUM1=0.0
8181          SUM2=0.0
8182          DO2120I=1,NMK
8183            J=I+K
8184            SUM1=SUM1+Y(I)
8185            SUM2=SUM2+Y(J)
8186 2120     CONTINUE
8187          Y1BAR=SUM1/ANMK
8188          Y2BAR=SUM2/ANMK
8189C
8190          SUM1=0.0
8191          SUM2=0.0
8192          DO2130I=1,NMK
8193            J=I+K
8194            SUM1=SUM1+(Y(I)-Y1BAR)**2
8195            SUM2=SUM2+(Y(J)-Y2BAR)**2
8196 2130     CONTINUE
8197          SSQ1=SUM1
8198          SSQ2=SUM2
8199C
8200          SUM1=0.0
8201          DO2140I=1,NMK
8202            J=I+K
8203            SUM1=SUM1+(Y(I)-Y1BAR)*(Y(J)-Y2BAR)
8204 2140     CONTINUE
8205          ANUM=SUM1
8206C
8207          SQRT1=0.0
8208          IF(SSQ1.GT.0.0)SQRT1=SQRT(SSQ1)
8209          SQRT2=0.0
8210          IF(SSQ2.GT.0.0)SQRT2=SQRT(SSQ2)
8211          DENOM=SQRT1*SQRT2
8212          AC=0.0
8213          IF(DENOM.GT.0.0)AC=ANUM/DENOM
8214          YTEMP1(K)=AC
8215 2110   CONTINUE
8216      ELSE
8217C
8218C     COMPUTE AUTOCORRELATIONS FOR N >= 21
8219C
8220        AN=N
8221C
8222        SUM1=0.0
8223        DO2210I=1,N
8224          SUM1=SUM1+Y(I)
8225 2210   CONTINUE
8226        Y1BAR=SUM1/AN
8227C
8228        SUM1=0.0
8229        DO2220I=1,N
8230          SUM1=SUM1+(Y(I)-Y1BAR)*(Y(I)-Y1BAR)
8231 2220   CONTINUE
8232        VARB1=SUM1/AN
8233        VAR1=SUM1/(AN-1.0)
8234C
8235        DO2230K=1,KMAXM1
8236          SUM1=0.0
8237          NMK=N-K
8238          DO2240I=1,NMK
8239            J=I+K
8240            SUM1=SUM1+(Y(I)-Y1BAR)*(Y(J)-Y1BAR)
8241 2240     CONTINUE
8242          YTEMP1(K)=SUM1/AN
8243          YTEMP1(K)=YTEMP1(K)/VARB1
8244 2230   CONTINUE
8245      ENDIF
8246C
8247C               ******************************
8248C               **  STEP 23--               **
8249C               **  CARRY OUT CALCULATIONS  **
8250C               **  FOR LJUNG-BOX     TEST  **
8251C               ******************************
8252C
8253      ISTEPN='23'
8254      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
8255     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8256C
8257      IWRITE='OFF'
8258C
8259      SUM1=0.0
8260      DO2310I=1,KMAXM1
8261        SUM1=SUM1 + YTEMP1(I)*YTEMP1(I)/REAL(N-I)
8262 2310 CONTINUE
8263C
8264      Q=AN*(AN+2.0)*SUM1
8265      STATVA=Q
8266      CALL CHSCDF(Q,KMAXM1,STATCD)
8267      PVAL=1.0-STATCD
8268C
8269      CUT0=0.
8270C
8271      ALPHA=.5
8272      P2=1.0-ALPHA
8273      CALL CHSPPF(P2,KMAXM1,CUT50)
8274C
8275      ALPHA=.25
8276      P2=1.0-ALPHA
8277      CALL CHSPPF(P2,KMAXM1,CUT75)
8278C
8279      ALPHA=.10
8280      P2=1.0-ALPHA
8281      CALL CHSPPF(P2,KMAXM1,CUT90)
8282C
8283      ALPHA=.05
8284      P2=1.0-ALPHA
8285      CALL CHSPPF(P2,KMAXM1,CUT95)
8286C
8287      ALPHA=.025
8288      P2=1.0-ALPHA
8289      CALL CHSPPF(P2,KMAXM1,CUT975)
8290C
8291      ALPHA=.01
8292      P2=1.0-ALPHA
8293      CALL CHSPPF(P2,KMAXM1,CUT99)
8294C
8295      ALPHA=.001
8296      P2=1.0-ALPHA
8297      CALL CHSPPF(P2,KMAXM1,CUT999)
8298C
8299C               *********************************
8300C               **   STEP 41--                 **
8301C               **   WRITE OUT EVERYTHING      **
8302C               **   FOR LJUNG-BOX TEST        **
8303C               *********************************
8304C
8305      ISTEPN='41'
8306      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
8307     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8308C
8309      IF(IPRINT.EQ.'OFF')GOTO9000
8310C
8311      NUMDIG=7
8312      IF(IFORSW.EQ.'1')NUMDIG=1
8313      IF(IFORSW.EQ.'2')NUMDIG=2
8314      IF(IFORSW.EQ.'3')NUMDIG=3
8315      IF(IFORSW.EQ.'4')NUMDIG=4
8316      IF(IFORSW.EQ.'5')NUMDIG=5
8317      IF(IFORSW.EQ.'6')NUMDIG=6
8318      IF(IFORSW.EQ.'7')NUMDIG=7
8319      IF(IFORSW.EQ.'8')NUMDIG=8
8320      IF(IFORSW.EQ.'9')NUMDIG=9
8321      IF(IFORSW.EQ.'0')NUMDIG=0
8322      IF(IFORSW.EQ.'E')NUMDIG=-2
8323      IF(IFORSW.EQ.'-2')NUMDIG=-2
8324      IF(IFORSW.EQ.'-3')NUMDIG=-3
8325      IF(IFORSW.EQ.'-4')NUMDIG=-4
8326      IF(IFORSW.EQ.'-5')NUMDIG=-5
8327      IF(IFORSW.EQ.'-6')NUMDIG=-6
8328      IF(IFORSW.EQ.'-7')NUMDIG=-7
8329      IF(IFORSW.EQ.'-8')NUMDIG=-8
8330      IF(IFORSW.EQ.'-9')NUMDIG=-9
8331C
8332      ITITLE='Ljung-Box Test for Randomness'
8333      NCTITL=29
8334      ITITLZ=' '
8335      NCTITZ=0
8336C
8337      ICNT=1
8338      ITEXT(ICNT)=' '
8339      NCTEXT(ICNT)=0
8340      AVALUE(ICNT)=0.0
8341      IDIGIT(ICNT)=-1
8342C
8343      ICNT=ICNT+1
8344      ITEXT(ICNT)='Response Variable: '
8345      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
8346      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
8347      NCTEXT(ICNT)=27
8348      AVALUE(ICNT)=0.0
8349      IDIGIT(ICNT)=-1
8350C
8351      IF(NREPL.GT.0)THEN
8352        IADD=1
8353        DO2101I=1,NREPL
8354          ICNT=ICNT+1
8355          ITEMP=I+IADD
8356          ITEXT(ICNT)='Factor Variable  : '
8357          WRITE(ITEXT(ICNT)(17:17),'(I1)')I
8358          WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(ITEMP)(1:4)
8359          WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(ITEMP)(1:4)
8360          NCTEXT(ICNT)=27
8361          AVALUE(ICNT)=PID(ITEMP)
8362          IDIGIT(ICNT)=NUMDIG
8363 2101   CONTINUE
8364      ENDIF
8365C
8366      ICNT=ICNT+1
8367      ITEXT(ICNT)=' '
8368      NCTEXT(ICNT)=1
8369      AVALUE(ICNT)=0.0
8370      IDIGIT(ICNT)=-1
8371C
8372      ICNT=ICNT+1
8373      ITEXT(ICNT)='H0: The Data Are Random'
8374      NCTEXT(ICNT)=23
8375      AVALUE(ICNT)=0.0
8376      IDIGIT(ICNT)=-1
8377      ICNT=ICNT+1
8378      ITEXT(ICNT)='Ha: The Data Are Not Random'
8379      NCTEXT(ICNT)=27
8380      AVALUE(ICNT)=0.0
8381      IDIGIT(ICNT)=-1
8382C
8383      ICNT=ICNT+1
8384      ITEXT(ICNT)=' '
8385      NCTEXT(ICNT)=1
8386      AVALUE(ICNT)=0.0
8387      IDIGIT(ICNT)=-1
8388      ICNT=ICNT+1
8389      ITEXT(ICNT)='Summary Statistics:'
8390      NCTEXT(ICNT)=19
8391      AVALUE(ICNT)=0.0
8392      IDIGIT(ICNT)=-1
8393      ICNT=ICNT+1
8394      ITEXT(ICNT)='Number of Observations:'
8395      NCTEXT(ICNT)=23
8396      AVALUE(ICNT)=REAL(N)
8397      IDIGIT(ICNT)=0
8398      ICNT=ICNT+1
8399      ITEXT(ICNT)='Lag Tested:'
8400      NCTEXT(ICNT)=11
8401      AVALUE(ICNT)=REAL(KMAXM1)
8402      IDIGIT(ICNT)=0
8403C
8404      ICNT=ICNT+1
8405      ITEXT(ICNT)='Lag 1 Autocorrelation:'
8406      NCTEXT(ICNT)=22
8407      AVALUE(ICNT)=YTEMP1(1)
8408      IDIGIT(ICNT)=NUMDIG
8409      ICNT=ICNT+1
8410      ITEXT(ICNT)='Lag 2 Autocorrelation:'
8411      NCTEXT(ICNT)=22
8412      AVALUE(ICNT)=YTEMP1(2)
8413      IDIGIT(ICNT)=NUMDIG
8414      ICNT=ICNT+1
8415      ITEXT(ICNT)='Lag 3 Autocorrelation:'
8416      NCTEXT(ICNT)=22
8417      AVALUE(ICNT)=YTEMP1(3)
8418      IDIGIT(ICNT)=NUMDIG
8419      ICNT=ICNT+1
8420      ITEXT(ICNT)=' '
8421      NCTEXT(ICNT)=1
8422      AVALUE(ICNT)=0.0
8423      IDIGIT(ICNT)=-1
8424C
8425      ICNT=ICNT+1
8426      ITEXT(ICNT)='Ljung-Box Test Statistic:'
8427      NCTEXT(ICNT)=25
8428      AVALUE(ICNT)=STATVA
8429      IDIGIT(ICNT)=NUMDIG
8430      ICNT=ICNT+1
8431      ITEXT(ICNT)='CDF Value:'
8432      NCTEXT(ICNT)=10
8433      AVALUE(ICNT)=STATCD
8434      IDIGIT(ICNT)=NUMDIG
8435      ICNT=ICNT+1
8436      ITEXT(ICNT)='P-Value:'
8437      NCTEXT(ICNT)=8
8438      AVALUE(ICNT)=PVAL
8439      IDIGIT(ICNT)=NUMDIG
8440      ICNT=ICNT+1
8441      ITEXT(ICNT)=' '
8442      NCTEXT(ICNT)=1
8443      AVALUE(ICNT)=0.0
8444      IDIGIT(ICNT)=-1
8445C
8446      NUMROW=ICNT
8447      DO4110I=1,NUMROW
8448        NTOT(I)=15
8449 4110 CONTINUE
8450C
8451      IFRST=.TRUE.
8452      ILAST=.TRUE.
8453C
8454      ISTEPN='42A'
8455      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
8456     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8457C
8458      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
8459     1            AVALUE,IDIGIT,
8460     1            NTOT,NUMROW,
8461     1            ICAPSW,ICAPTY,ILAST,IFRST,
8462     1            ISUBRO,IBUGA3,IERROR)
8463C
8464      ISTEPN='42D'
8465      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
8466     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8467C
8468      ITITL9=' '
8469      NCTIT9=0
8470      ITITLE='Conclusions (Upper One-Tailed Test)'
8471      NCTITL=35
8472C
8473      DO5030J=1,5
8474        DO5040I=1,3
8475          ITITL2(I,J)=' '
8476          NCTIT2(I,J)=0
8477 5040   CONTINUE
8478 5030 CONTINUE
8479C
8480      ITITL2(2,1)='Null'
8481      NCTIT2(2,1)=4
8482      ITITL2(3,1)='Hypothesis'
8483      NCTIT2(3,1)=10
8484C
8485      ITITL2(2,2)='Confidence'
8486      NCTIT2(2,2)=10
8487      ITITL2(3,2)='Level'
8488      NCTIT2(3,2)=5
8489C
8490      ITITL2(2,3)='Test'
8491      NCTIT2(2,3)=4
8492      ITITL2(3,3)='Statistic'
8493      NCTIT2(3,3)=9
8494C
8495      ITITL2(2,4)='Critical'
8496      NCTIT2(2,4)=8
8497      ITITL2(3,4)='Value (>)'
8498      NCTIT2(3,4)=9
8499C
8500      ITITL2(1,5)='Null'
8501      NCTIT2(1,5)=4
8502      ITITL2(2,5)='Hypothesis'
8503      NCTIT2(2,5)=10
8504      ITITL2(3,5)='Conclusion'
8505      NCTIT2(3,5)=10
8506C
8507      NMAX=0
8508      NUMCOL=5
8509      DO2050I=1,NUMCOL
8510        VALIGN(I)='b'
8511        ALIGN(I)='r'
8512        NTOT(I)=15
8513        IF(I.EQ.1)NTOT(I)=12
8514        NMAX=NMAX+NTOT(I)
8515        ITYPCO(I)='ALPH'
8516        IF(I.EQ.3 .OR. I.EQ.4)ITYPCO(I)='NUME'
8517        IDIGIT(I)=NUMDIG
8518        IWHTML(1)=150
8519        IWHTML(2)=125
8520        IWHTML(3)=150
8521        IWHTML(4)=150
8522        IWHTML(5)=150
8523        IINC=1600
8524        IINC2=1400
8525        IINC3=2200
8526        IWRTF(1)=IINC
8527        IWRTF(2)=IWRTF(1)+IINC
8528        IWRTF(3)=IWRTF(2)+IINC3
8529        IWRTF(4)=IWRTF(3)+IINC3
8530        IWRTF(5)=IWRTF(4)+IINC3
8531C
8532        DO2060J=1,NUMALP
8533C
8534          AMAT(J,I)=0.0
8535          AMAT(J,3)=STATVA
8536          IVALUE(J,1)='Random'
8537          NCVALU(J,1)=6
8538          IVALUE(J,5)(1:6)='REJECT'
8539          IF(J.EQ.1)THEN
8540            IVALUE(J,2)(1:5)='0.0%'
8541            AMAT(J,4)=CUT0
8542            IF(STATVA.LT.CUT0)IVALUE(J,5)(1:6)='ACCEPT'
8543          ELSEIF(J.EQ.2)THEN
8544            IVALUE(J,2)(1:5)='50.0%'
8545            AMAT(J,4)=CUT50
8546            IF(STATVA.LT.CUT50)IVALUE(J,5)(1:6)='ACCEPT'
8547          ELSEIF(J.EQ.3)THEN
8548            IVALUE(J,2)(1:5)='75.0%'
8549            AMAT(J,4)=CUT75
8550            IF(STATVA.LT.CUT75)IVALUE(J,5)(1:6)='ACCEPT'
8551          ELSEIF(J.EQ.4)THEN
8552            IVALUE(J,2)(1:5)='90.0%'
8553            AMAT(J,4)=CUT90
8554            IF(STATVA.LT.CUT90)IVALUE(J,5)(1:6)='ACCEPT'
8555          ELSEIF(J.EQ.5)THEN
8556            IVALUE(J,2)(1:5)='95.0%'
8557            AMAT(J,4)=CUT95
8558            IF(STATVA.LT.CUT95)IVALUE(J,5)(1:6)='ACCEPT'
8559          ELSEIF(J.EQ.6)THEN
8560            IVALUE(J,2)(1:5)='97.5%'
8561            AMAT(J,4)=CUT975
8562            IF(STATVA.LT.CUT975)IVALUE(J,5)(1:6)='ACCEPT'
8563          ELSEIF(J.EQ.7)THEN
8564            IVALUE(J,2)(1:5)='99.0%'
8565            AMAT(J,4)=CUT99
8566            IF(STATVA.LT.CUT99)IVALUE(J,5)(1:6)='ACCEPT'
8567          ELSEIF(J.EQ.8)THEN
8568            IVALUE(J,2)(1:5)='99.9%'
8569            AMAT(J,4)=CUT999
8570            IF(STATVA.LT.CUT999)IVALUE(J,5)(1:6)='ACCEPT'
8571          ENDIF
8572          NCVALU(J,2)=5
8573          NCVALU(J,5)=6
8574C
8575 2060   CONTINUE
8576 2050 CONTINUE
8577C
8578      ICNT=NUMALP
8579      NUMLIN=3
8580      NUMCOL=5
8581      IFRST=.TRUE.
8582      ILAST=.TRUE.
8583      IFLAGS=.TRUE.
8584      IFLAGE=.TRUE.
8585      CALL DPDTA5(ITITLE,NCTITL,
8586     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
8587     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
8588     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
8589     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
8590     1            ICAPSW,ICAPTY,IFRST,ILAST,
8591     1            IFLAGS,IFLAGE,
8592     1            ISUBRO,IBUGA3,IERROR)
8593C
8594C               *****************
8595C               **  STEP 90--  **
8596C               **  EXIT       **
8597C               *****************
8598C
8599 9000 CONTINUE
8600      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')THEN
8601        WRITE(ICOUT,999)
8602        CALL DPWRST('XXX','WRIT')
8603        WRITE(ICOUT,9011)
8604 9011   FORMAT('***** AT THE END       OF DPLUJ2--')
8605        CALL DPWRST('XXX','WRIT')
8606        WRITE(ICOUT,9012)IERROR,STATVA,STATCD,PVAL
8607 9012   FORMAT('IERROR,STATVA,STATCD,PVAL = ',A4,2X,3G15.7)
8608        CALL DPWRST('XXX','WRIT')
8609      ENDIF
8610C
8611      RETURN
8612      END
8613      SUBROUTINE DPMABA(IHARG,IARGT,ARG,NUMARG,ADEMBA,MAXMAR,AMARBA,
8614     1IBUGP2,IFOUND,IERROR)
8615C
8616C     PURPOSE--DEFINE THE MARKER BASES.
8617C              THESE ARE LOCATED IN THE VECTOR AMARBA(.).
8618C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
8619C                     --IARGT  (A  CHARACTER VECTOR)
8620C                     --ARG
8621C                     --NUMARG
8622C                     --ADEMBA
8623C                     --MAXMAR
8624C                     --IBUGP2 ('ON' OR 'OFF' )
8625C     OUTPUT ARGUMENTS--AMARBA (A FLOATING POINT VECTOR)
8626C                     --IFOUND ('YES' OR 'NO' )
8627C                     --IERROR ('YES' OR 'NO' )
8628C     WRITTEN BY--JAMES J. FILLIBEN
8629C                 STATISTICAL ENGINEERING DIVISION
8630C                 INFORMATION TECHNOLOGY LABORATORY
8631C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8632C                 Gaithersburg, MD 20899-8980
8633C                 PHONE--301-975-2855
8634C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8635C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8636C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
8637C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
8638C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
8639C     LANGUAGE--ANSI FORTRAN (1977)
8640C     VERSION NUMBER--82/7
8641C     ORIGINAL VERSION--DECEMBER  1983.
8642C
8643C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8644C
8645      CHARACTER*4 IHARG
8646      CHARACTER*4 IARGT
8647C
8648      CHARACTER*4 IBUGP2
8649      CHARACTER*4 IFOUND
8650      CHARACTER*4 IERROR
8651C
8652      CHARACTER*4 IHOLD1
8653C
8654      CHARACTER*4 ISUBN1
8655      CHARACTER*4 ISUBN2
8656      CHARACTER*4 ISTEPN
8657C
8658      DIMENSION IHARG(*)
8659      DIMENSION IARGT(*)
8660      DIMENSION ARG(*)
8661      DIMENSION AMARBA(*)
8662C
8663C---------------------------------------------------------------------
8664C
8665      INCLUDE 'DPCOP2.INC'
8666C
8667C-----START POINT-----------------------------------------------------
8668C
8669      IFOUND='NO'
8670      IERROR='NO'
8671      ISUBN1='DPMA'
8672      ISUBN2='BA  '
8673C
8674      NUMMAR=0
8675      IHOLD1='-999'
8676      HOLD1=-999.0
8677      HOLD2=-999.0
8678C
8679      IF(IBUGP2.EQ.'OFF')GOTO90
8680      WRITE(ICOUT,999)
8681  999 FORMAT(1X)
8682      CALL DPWRST('XXX','BUG ')
8683      WRITE(ICOUT,51)
8684   51 FORMAT('***** AT THE BEGINNING OF DPMABA--')
8685      CALL DPWRST('XXX','BUG ')
8686      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
8687   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
8688      CALL DPWRST('XXX','BUG ')
8689      WRITE(ICOUT,53)MAXMAR,NUMMAR
8690   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
8691      CALL DPWRST('XXX','BUG ')
8692      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
8693   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
8694      CALL DPWRST('XXX','BUG ')
8695      WRITE(ICOUT,55)ADEMBA
8696   55 FORMAT('ADEMBA = ',E15.7)
8697      CALL DPWRST('XXX','BUG ')
8698      WRITE(ICOUT,60)NUMARG
8699   60 FORMAT('NUMARG = ',I8)
8700      CALL DPWRST('XXX','BUG ')
8701      DO65I=1,NUMARG
8702      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
8703   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',2(A4,2X),G15.7)
8704      CALL DPWRST('XXX','BUG ')
8705   65 CONTINUE
8706      WRITE(ICOUT,70)AMARBA(1)
8707   70 FORMAT('AMARBA(1) = ',E15.7)
8708      CALL DPWRST('XXX','BUG ')
8709      DO75I=1,10
8710      WRITE(ICOUT,76)I,AMARBA(I)
8711   76 FORMAT('I,AMARBA(I) = ',I8,2X,E15.7)
8712      CALL DPWRST('XXX','BUG ')
8713   75 CONTINUE
8714   90 CONTINUE
8715C
8716C               **************************************
8717C               **  STEP 1--                        **
8718C               **  BRANCH TO THE APPROPRIATE CASE  **
8719C               **************************************
8720C
8721      ISTEPN='1'
8722      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8723C
8724      IF(NUMARG.LE.0)GOTO9000
8725      IF(NUMARG.EQ.1)GOTO1110
8726      IF(NUMARG.EQ.2)GOTO1120
8727      IF(NUMARG.EQ.3)GOTO1130
8728      GOTO1140
8729C
8730 1110 CONTINUE
8731      GOTO1200
8732C
8733 1120 CONTINUE
8734      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
8735      IF(IHARG(2).EQ.'ALL')HOLD1=ADEMBA
8736      IF(IHARG(2).EQ.'ALL')GOTO1300
8737      GOTO1200
8738C
8739 1130 CONTINUE
8740      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
8741      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
8742      IF(IHARG(2).EQ.'ALL')GOTO1300
8743      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
8744      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
8745      IF(IHARG(3).EQ.'ALL')GOTO1300
8746      GOTO1200
8747C
8748 1140 CONTINUE
8749      GOTO1200
8750C
8751C               *************************************************
8752C               **  STEP 2--                                   **
8753C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
8754C               *************************************************
8755C
8756 1200 CONTINUE
8757      ISTEPN='2'
8758      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8759C
8760      IF(NUMARG.LE.1)GOTO1210
8761      GOTO1220
8762C
8763 1210 CONTINUE
8764      NUMMAR=1
8765      AMARBA(1)=ADEMBA
8766      GOTO1270
8767C
8768 1220 CONTINUE
8769      NUMMAR=NUMARG-1
8770      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
8771      DO1225I=1,NUMMAR
8772      J=I+1
8773      IHOLD1=IHARG(J)
8774      HOLD1=ARG(J)
8775      HOLD2=HOLD1
8776      IF(IHOLD1.EQ.'ON')HOLD2=ADEMBA
8777      IF(IHOLD1.EQ.'OFF')HOLD2=ADEMBA
8778      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEMBA
8779      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEMBA
8780      AMARBA(I)=HOLD2
8781 1225 CONTINUE
8782      GOTO1270
8783C
8784 1270 CONTINUE
8785      IF(IFEEDB.EQ.'OFF')GOTO1279
8786      WRITE(ICOUT,999)
8787      CALL DPWRST('XXX','BUG ')
8788      DO1278I=1,NUMMAR
8789      WRITE(ICOUT,1276)I,AMARBA(I)
8790 1276 FORMAT('THE BASE OF MARKER ',I6,
8791     1' HAS JUST BEEN SET TO ',E15.7)
8792      CALL DPWRST('XXX','BUG ')
8793 1278 CONTINUE
8794 1279 CONTINUE
8795      IFOUND='YES'
8796      GOTO9000
8797C
8798C               **************************
8799C               **  STEP 3--            **
8800C               **  TREAT THE ALL CASE  **
8801C               **************************
8802C
8803 1300 CONTINUE
8804      ISTEPN='3'
8805      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
8806C
8807      NUMMAR=MAXMAR
8808      HOLD2=HOLD1
8809      IF(IHOLD1.EQ.'ON')HOLD2=ADEMBA
8810      IF(IHOLD1.EQ.'OFF')HOLD2=ADEMBA
8811      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEMBA
8812      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEMBA
8813      DO1315I=1,NUMMAR
8814      AMARBA(I)=HOLD2
8815 1315 CONTINUE
8816      GOTO1370
8817C
8818 1370 CONTINUE
8819      IF(IFEEDB.EQ.'OFF')GOTO1319
8820      WRITE(ICOUT,999)
8821      CALL DPWRST('XXX','BUG ')
8822      I=1
8823      WRITE(ICOUT,1316)AMARBA(I)
8824 1316 FORMAT('THE BASE OF ALL MARKERS',
8825     1' HAS JUST BEEN SET TO ',E15.7)
8826      CALL DPWRST('XXX','BUG ')
8827 1319 CONTINUE
8828      IFOUND='YES'
8829      GOTO9000
8830C
8831C               *****************
8832C               **  STEP 90--  **
8833C               **  EXIT       **
8834C               *****************
8835C
8836 9000 CONTINUE
8837      IF(IBUGP2.EQ.'OFF')GOTO9090
8838      WRITE(ICOUT,9011)
8839 9011 FORMAT('***** AT THE END       OF DPMABA--')
8840      CALL DPWRST('XXX','BUG ')
8841      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
8842 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
8843      CALL DPWRST('XXX','BUG ')
8844      WRITE(ICOUT,9013)MAXMAR,NUMMAR
8845 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
8846      CALL DPWRST('XXX','BUG ')
8847      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
8848 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
8849      CALL DPWRST('XXX','BUG ')
8850      WRITE(ICOUT,9015)ADEMBA
8851 9015 FORMAT('ADEMBA = ',E15.7)
8852      CALL DPWRST('XXX','BUG ')
8853      WRITE(ICOUT,9030)AMARBA(1)
8854 9030 FORMAT('AMARBA(1) = ',E15.7)
8855      CALL DPWRST('XXX','BUG ')
8856      DO9035I=1,10
8857      WRITE(ICOUT,9036)I,AMARBA(I)
8858 9036 FORMAT('I,AMARBA(I) = ',I8,2X,E15.7)
8859      CALL DPWRST('XXX','BUG ')
8860 9035 CONTINUE
8861 9090 CONTINUE
8862C
8863      RETURN
8864      END
8865      SUBROUTINE DPMACL(IHARG,NUMARG,IDEFMC,IMARCO,IFOUND,IERROR)
8866C
8867C     PURPOSE--DEFINE THE COLOR FOR THE MARGIN
8868C              (THE REGION OUTSIDE THE FRAME LINES).
8869C              THE COLOR FOR THE MARGIN WILL BE PLACED
8870C              IN THE HOLLERITH VARIABLE IMARCO.
8871C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
8872C                     --NUMARG
8873C                     --IDEFMC
8874C     OUTPUT ARGUMENTS--IMARCO
8875C                     --IFOUND ('YES' OR 'NO' )
8876C                     --IERROR ('YES' OR 'NO' )
8877C     WRITTEN BY--JAMES J. FILLIBEN
8878C                 STATISTICAL ENGINEERING DIVISION
8879C                 INFORMATION TECHNOLOGY LABORATORY
8880C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8881C                 Gaithersburg, MD 20899-8980
8882C                 PHONE--301-975-2855
8883C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8884C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8885C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
8886C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
8887C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
8888C     LANGUAGE--ANSI FORTRAN (1977)
8889C     VERSION NUMBER--82/7
8890C     ORIGINAL VERSION--SEPTEMBER 1980.
8891C     UPDATED         --MAY       1982.
8892C
8893C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
8894C
8895      CHARACTER*4 IHARG
8896      CHARACTER*4 IDEFMC
8897      CHARACTER*4 IMARCO
8898      CHARACTER*4 IFOUND
8899      CHARACTER*4 IERROR
8900C
8901C---------------------------------------------------------------------
8902C
8903      DIMENSION IHARG(*)
8904C
8905C---------------------------------------------------------------------
8906C
8907      INCLUDE 'DPCOP2.INC'
8908C
8909C-----START POINT-----------------------------------------------------
8910C
8911      IFOUND='NO'
8912      IERROR='NO'
8913C
8914      IF(NUMARG.EQ.0)GOTO1150
8915      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COLO')GOTO1150
8916      GOTO1110
8917C
8918 1110 CONTINUE
8919      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
8920      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
8921      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
8922      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
8923      GOTO1160
8924C
8925 1150 CONTINUE
8926      IMARCO=IDEFMC
8927      GOTO1180
8928C
8929 1160 CONTINUE
8930      IMARCO=IHARG(NUMARG)
8931      GOTO1180
8932C
8933 1180 CONTINUE
8934      IFOUND='YES'
8935C
8936      IF(IFEEDB.EQ.'OFF')GOTO1189
8937      WRITE(ICOUT,999)
8938  999 FORMAT(1X)
8939      CALL DPWRST('XXX','BUG ')
8940      WRITE(ICOUT,1181)IMARCO
8941 1181 FORMAT('THE MARGIN COLOR HAS JUST BEEN SET TO ',
8942     1A4)
8943      CALL DPWRST('XXX','BUG ')
8944 1189 CONTINUE
8945      GOTO1199
8946C
8947 1199 CONTINUE
8948      RETURN
8949      END
8950      SUBROUTINE DPMACR(ICOM,ICOM2,
8951     1                  IMACRO,IMACNU,IMACCS,
8952     1                  IMACL1,IMACL2,IMACLR,IMALEV,
8953     1                  IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,
8954     1                  IANSLC,IWIDTH,
8955     1                  IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
8956     1                  IOFILE,
8957     1                  ILOOST,ILOOLI,NUMLIL,NUMLOS,
8958     1                  IANSLO,IWIDLL,MAXCI2,MAXLI2,
8959     1                  IBUGS2,ISUBRO,IFOUND,IERROR)
8960C
8961C     PURPOSE--OPERATE ON MACROS (= SUB-PROGRAMS).
8962C              THERE ARE 3 CAPABILITITES IN THIS REGARD--
8963C                 1) TURN THE MACRO SWITCH 'ON' WHICH WILL
8964C                    ALLOW A MACRO TO BE CREATED.
8965C                 2) TURN THE MACRO SWITCH 'OFF' WHICH WILL
8966C                    TERMINATE THE CREATION OF A MACRO.
8967C                 3) ADD THE CONTENTS OF A MACRO TO THE INPUT RUNSTTREAM
8968C                    WHICH (IN EFFECT) WILL ALLOW A MACRO
8969C                    TO BE EXECUTED.
8970C
8971C     CALLED BY--MAIN, MAINSU
8972C
8973C     NOTE--THESE CAPABILITITIES WILL ALLOW MACROS TO BE DYNAMICALLY
8974C           CONSTRUCTED AND USED FROM WITHIN A DATAPLOT PROGRAM.
8975C           WHEN THE MACRO SWITCH IS ON, ALL ENTERED DATAPLOT
8976C           INSTRUCTIONS ARE AUTOMATICALLY COPIED INTO A SPECIFIED
8977C           SYSTEM FILE OR SUBFILE.  WHEN THE MACRO SWITCH IS OFF,
8978C           NO SUCH COPYING IS DONE.  THE SPECIFIED STATUS (ON/OFF)
8979C           OF THE MACRO WILL BE PLACED IN THE HOLLERITH VARIABLE IMACRO.
8980C           IMACL1 = FIRST LINE OF THE MACRO TO BE EXECUTED
8981C           IMACL2 = LAST  LINE OF THE MACRO TO BE EXECUTED
8982C           IMACLR = NUMBER OF LINES OF MACRO ALREADY READ
8983C     INPUT  ARGUMENTS--ICOM
8984C                     --ICOM2
8985C     INPUT  ARGUMENTS--IMACNU (AN INTEGER VALUE
8986C                              BY WHICH THE MACRO FILE/SUBFILE MAY BE
8987C                              REFERENCED IN A FORTRAN I/O STATEMENT.
8988C                     --IMACCS (A HOLLERITH VARIABLE CONTAINING STATUS
8989C                              INFORMATION FOR THE MACRO FILE/SUBFILE
8990C                     --IANSLC (A  HOLLERITH VECTOR WHOSE I-TH ELEMENT
8991C                              CONTAINS THE I-TH CHARACTER OF THE
8992C                              ORIGINAL INPUT COMMAND LINE.
8993C                     --IWIDTH (AN INTEGER VARIABLE WHICH CONTAINS THE
8994C                              NUMBER OF CHARACTERS IN THE ORIGINAL
8995C                              COMMAND LINE.
8996C                     --IHARG  (A  HOLLERITH VECTOR)
8997C                     --NUMARG (AN INTEGER VARIABLE)
8998C                     --IBUG   (A HOLLERITH VARIABLE FOR DEBUGGING
8999C     OUTPUT ARGUMENTS--IMACRO (AN INTEGER VARIABLE WHICH IF 'ON'
9000C                              INDICATES THAT CURRENT COMMANDS ARE ALSO
9001C                              BEING DIVERTED SO AS TO CONSTRUCT A MACRO;
9002C                              AND IF OFF INDICATES THAT A MACRO IS NOT
9003C                              BEING CONSTRUCTED.
9004C                     --IFOUND ('YES' OR 'NO' )
9005C                     --IERROR ('YES' OR 'NO' )
9006C     WRITTEN BY--JAMES J. FILLIBEN
9007C                 STATISTICAL ENGINEERING DIVISION
9008C                 INFORMATION TECHNOLOGY LABORATORY
9009C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
9010C                 Gaithersburg, MD 20899-8980
9011C                 PHONE--301-975-2855
9012C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
9013C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
9014C     LANGUAGE--ANSI FORTRAN (1977)
9015C     VERSION NUMBER--86/1
9016C     ORIGINAL VERSION--NOVEMBER  1980.
9017C     UPDATED         --JANUARY   1981.
9018C     UPDATED         --JUNE      1981.
9019C     UPDATED         --NOVEMBER  1981.
9020C     UPDATED         --JANUARY   1982.
9021C     UPDATED         --MARCH     1982.
9022C     UPDATED         --MAY       1982.
9023C     UPDATED         --JANUARY   1983.
9024C     UPDATED         --SEPTEMBER 1983.
9025C     UPDATED         --JANUARY   1986.
9026C     UPDATED         --MAY       1990. FOR CALL CASE, SET FILE STATUS='OLD'
9027C     UPDATED         --AUGUST    1994. SIMPLIFY CODE THROUGHOUT
9028C     UPDATED         --AUGUST    1994. EXECUTE A SUBSET OF A FILE
9029C     UPDATED         --APRIL     1997. DIFFERENT UNIT FOR "CREATE
9030C                                       FILE." CASE TO FIX BUG IF
9031C                                       "CALL FILE." ENCOUNTERED WHILE
9032C                                       CREATE IS ON.
9033C     UPDATED         --JULY      2003. BUG: FILE NAME < 80
9034C                                       CHARACTERS, BUT COMMAND LINE
9035C                                       > 80 CHARACTERS
9036C     UPDATED         --SEPTEMBER 2005. SUPPORT FOR ARGUMENTS TO
9037C                                       MACROS.  THIS ROUTINE STORES
9038C                                       THE ARGUMENTS.
9039C     UPDATED         --OCTOBER   2014. MAXIMUM NUMBER OF COMMAND LINE
9040C                                       ARGUMENTS RAISED FROM 10 TO 50
9041C     UPDATED         --OCTOBER   2014. SET FILE NAME QUOTE TO "ON" WHEN
9042C                                       PARSING COMMAND LINE ARGUMENTS
9043C     UPDATED         --MARCH     2015. ADD "CALL EXIT" "CALL EXIT ALL"
9044C                                       COMMANDS
9045C     UPDATED         --NOVEMBER  2015. LOOP STORE DOES NOT DO COMMAND
9046C                                       SUBSTITUTION (I.E., "^").  CHECK
9047C                                       IF FILE NAME STARTS WITH "^"
9048C                                       (NOTE THAT THIS DOES NOT FIX
9049C                                       PROBLEM IF "^" STRING DEPENDS
9050C                                       ON THE LOOP INDEX).
9051C     UPDATED         --MAY       2016. OPTION ON WHETHER TO STRIP
9052C                                       QUOTES FROM MACROS
9053C     UPDATED         --SEPTEMBER 2016. IF FIRST ARGUMENT IS "NULL",
9054C                                       RE-INITIALIZE ARGUMENT LIST
9055C     UPDATED         --JANUARY   2017. COMMAND LINE ARGUMENTS THAT
9056C                                       START WITH "-" (DPEXWO TREATS
9057C                                       AS WORD SEPARATOR)
9058C     UPDATED         --JULY      2017. WHEN CALL ENTERED WITHIN A LOOP,
9059C                                       INSERT A "INSERT CALL LINE
9060C                                       ARGUMENTS" COMMAND IN SAVED LOOP
9061C                                       LINES.
9062C     UPDATED         --MAY       2018. SUPPORT VARIOUS NEW FORMS FOR
9063C                                       PASSING COMMAND LINE ARGUMENTS
9064C
9065C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
9066C
9067      INCLUDE 'DPCOPA.INC'
9068C
9069      CHARACTER*4 ICOM
9070      CHARACTER*4 ICOM2
9071      CHARACTER*4 IMACRO
9072      CHARACTER*12 IMACCS
9073      CHARACTER*4 IHNAME(*)
9074      CHARACTER*4 IHNAM2(*)
9075      CHARACTER*4 IUSE
9076      CHARACTER*4 IANSLC(*)
9077      CHARACTER*4 IHARG(*)
9078      CHARACTER*4 IHARG2(*)
9079      CHARACTER*4 IARGT(*)
9080      CHARACTER*4 IOFILE
9081      CHARACTER*4 ILOOST
9082      CHARACTER*4 IANSLO
9083      CHARACTER*4 IBUGS2
9084      CHARACTER*4 ISUBRO
9085      CHARACTER*4 IFOUND
9086      CHARACTER*4 IERROR
9087C
9088CCCCC CHARACTER*80 IFILE
9089      CHARACTER (LEN=MAXFNC) :: IFILE
9090      CHARACTER*12 ISTAT
9091      CHARACTER*12 IFORM
9092      CHARACTER*12 IACCES
9093      CHARACTER*12 IPROT
9094      CHARACTER*12 ICURST
9095      CHARACTER*4 IENDFI
9096      CHARACTER*4 IREWIN
9097      CHARACTER*4 ISUBN0
9098      CHARACTER*4 IERRFI
9099C
9100      CHARACTER*4 IANSI
9101CCCCC CHARACTER*80 ICANS
9102CCCCC CHARACTER*255 ICANS
9103      CHARACTER (LEN=MAXSTR) :: ICANS
9104C
9105      CHARACTER*4 IH
9106      CHARACTER*4 IH2
9107      CHARACTER*4 ISUBN1
9108      CHARACTER*4 ISUBN2
9109      CHARACTER*4 ISTEPN
9110      CHARACTER*4 IFILQZ
9111      CHARACTER*4 IHYPS2
9112      CHARACTER*4 ICOMC2
9113C
9114CCCCC THE FOLLOWING 3 LINES WERE ADDED     AUGUST 1994
9115CCCCC CHARACTER*4 ICASEQ
9116CCCCC CHARACTER*4 IBUGQ
9117      CHARACTER*1 ICJUNK
9118C
9119CCCCC CHARACTER*255 ISTR
9120CCCCC CHARACTER*255 ISTR2
9121      CHARACTER (LEN=MAXSTR) :: ISTR
9122      CHARACTER (LEN=MAXSTR) :: ISTR2
9123C
9124C ---------------------------------------------------------------------
9125C
9126      DIMENSION IARG(*)
9127      DIMENSION ARG(*)
9128C
9129      DIMENSION IUSE(*)
9130      DIMENSION IVALUE(*)
9131      DIMENSION VALUE(*)
9132C
9133      DIMENSION IANSLO(MAXLI2,MAXCI2)
9134      DIMENSION IWIDLL(*)
9135C
9136C-----COMMON----------------------------------------------------------
9137C
9138      CHARACTER (LEN=MAXFNC) :: IMANAM(10)
9139      COMMON/IMAC/IMACN2,IMALE2,IMANAM
9140C
9141C-----COMMON VARIABLES (GENERAL)--------------------------------------
9142C
9143CCCCC THE FOLLOWING LINE WAS ADDED        AUGUST 1994
9144CCCCC INCLUDE 'DPCODA.INC' BOMBS
9145      INCLUDE 'DPCOSU.INC'
9146      INCLUDE 'DPCOST.INC'
9147      INCLUDE 'DPCOFO.INC'
9148      INCLUDE 'DPCOF2.INC'
9149      INCLUDE 'DPCOP2.INC'
9150C
9151C-----START POINT-----------------------------------------------------
9152C
9153      IFOUND='YES'
9154      IERROR='NO'
9155      ISUBN1='DPMA'
9156      ISUBN2='CR  '
9157      ICOMC2=ICOMCL
9158C
9159      IF(ICOM.EQ.'MACR' .AND. IHARG(1).EQ.'SUBS' .AND.
9160     1   IHARG(2).EQ.'CHAR')GOTO9000
9161C
9162CCCCC THE FOLLOWING LINE WAS ADDED    AUGUST 1994
9163      MINN2=1
9164C
9165      KMIN=0
9166      KDEL=0
9167      KMAX=0
9168      JP3=0
9169      JP4=0
9170      JP5=0
9171      IH='UNKN'
9172      IH2='UNKN'
9173      J12=0
9174      J22=0
9175      J32=0
9176      J42=0
9177      J52=0
9178      J62=0
9179      J72=0
9180      J82=0
9181      J92=0
9182      J102=0
9183      IPAR2=0
9184      IPAR3=0
9185      IPAR4=0
9186      IPAR5=0
9187      IPAR6=0
9188      IPAR7=0
9189      IPAR8=0
9190      IPAR9=0
9191      IPAR10=0
9192C
9193      P2=0.0
9194C
9195      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9196         WRITE(ICOUT,999)
9197  999    FORMAT(1X)
9198         CALL DPWRST('XXX','BUG ')
9199         WRITE(ICOUT,51)
9200   51    FORMAT('***** AT THE BEGINNING OF DPMACR--')
9201         CALL DPWRST('XXX','BUG ')
9202         WRITE(ICOUT,52)IMACRO,IMACNU,IMACCS,IMACL1,IMACL2
9203   52    FORMAT('IMACRO,IMACNU,IMACCS,IMACL1,IMACL2 = ',
9204     1   A4,I8,2X,A12,I8,I8)
9205         CALL DPWRST('XXX','BUG ')
9206         WRITE(ICOUT,53)IBUGS2,IERROR,ICOM,ICOM2,MAXOBV,IWIDTH
9207   53    FORMAT('IBUGS2,IERROR,ICOM,ICOM2,MAXOBV,IWIDTH = ',
9208     1          4(A4,2X),2I8)
9209         CALL DPWRST('XXX','BUG ')
9210         WRITE(ICOUT,56)(IANSLC(I),I=1,MIN(120,IWIDTH))
9211   56    FORMAT('IANSLC(.) = ',120A1)
9212         CALL DPWRST('XXX','BUG ')
9213C
9214         WRITE(ICOUT,57)NUMARG
9215   57    FORMAT('NUMARG = ',I8)
9216         CALL DPWRST('XXX','BUG ')
9217         IF(NUMARG.GE.1)THEN
9218            DO58I=1,NUMARG
9219               WRITE(ICOUT,59)I,IHARG(I),IHARG2(I),IARGT(I),ARG(I)
9220   59          FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),ARG(I) = ',
9221     1                I8,2X,3(A4,2X),G15.7)
9222               CALL DPWRST('XXX','BUG ')
9223   58       CONTINUE
9224         ENDIF
9225C
9226         WRITE(ICOUT,62)MAXNAM,NUMNAM,NUMCHA,ICRENU,NUMLOS
9227   62    FORMAT('MAXNAM,NUMNAM,NUMCHA,ICRENU,NUMLOS = ',5I8)
9228         CALL DPWRST('XXX','BUG ')
9229         IF(NUMNAM.GE.1)THEN
9230            DO65I=1,NUMNAM
9231               WRITE(ICOUT,66)I,IHNAME(I),IHNAM2(I),IUSE(I),
9232     1         IVALUE(I),VALUE(I)
9233   66          FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),',
9234     1         'IVALUE(I),VALUE(I) = ',I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
9235               CALL DPWRST('XXX','BUG ')
9236   65       CONTINUE
9237         ENDIF
9238         WRITE(ICOUT,73)(IA(I),I=1,MIN(100,NUMCHA))
9239   73    FORMAT('(IA(I),I=1,NUMCHA) = ',100A1)
9240         CALL DPWRST('XXX','BUG ')
9241         WRITE(ICOUT,82)ICRENA
9242   82    FORMAT('ICRENA = ',A80)
9243         CALL DPWRST('XXX','BUG ')
9244         WRITE(ICOUT,83)ICREST,ICREFO,ICREAC,ICREFO,ICRECS
9245   83    FORMAT('ICREST,ICREFO,ICREAC,ICREFO,ICRECS = ',4(A12,2X),A12)
9246         CALL DPWRST('XXX','BUG ')
9247      ENDIF
9248C
9249C               ****************************************************
9250C               **  STEP 11--                                     **
9251C               **  FOR THE SPECIAL CASE WHEN THE                 **
9252C               **  EXECUTION OF A MACRO HAS JUST BEEN FINISHED,  **
9253C               **  JUMP TO CLOSING THE FILE                      **
9254C               ****************************************************
9255C
9256      ISTEPN='11'
9257      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9258     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9259C
9260C     2015/03: CHECK FOR "CALL EXIT" AND "CALL EXIT ALL" COMMANDS
9261C
9262      IF(IMACCS.EQ.'CLO2        ')GOTO5000
9263      IF(ICOM.EQ.'CALL' .AND. IHARG(1).EQ.'EXIT')THEN
9264        IF(IHARG(2).EQ.'ALL ')GOTO5500
9265CCCCC   GOTO5000
9266        GOTO5500
9267      ENDIF
9268C
9269C               ***********************************************
9270C               **  STEP 12--                                **
9271C               **  FOR THE SPECIAL CASE WHEN HAVE THE       **
9272C               **  END CREATE     COMMAND, OR THE           **
9273C               **  END MACRO      COMMAND, OR THE           **
9274C               **  END OF CREATE      COMMAND,              **
9275C               **  END OF MACRO       COMMAND,              **
9276C               **  JUMP IMMEDIATELY TO THE SECTION OF CODE  **
9277C               **  WHICH PUTS ON AN END OF FILE AND         **
9278C               **  CLOSES THE FILE/SUBFILE.                 **
9279C               ***********************************************
9280C
9281      ISTEPN='12'
9282      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9283     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9284C
9285      IF(ICOM.EQ.'END ')THEN
9286        IF(NUMARG.EQ.1 .AND. (IHARG(1).EQ.'CREA' .OR.
9287     1    IHARG(1).EQ.'MACR'))GOTO4000
9288        IF(NUMARG.EQ.2 .AND. IHARG(1).EQ.'OF  ' .AND.
9289     1    (IHARG(2).EQ.'CREA' .OR. IHARG(2).EQ.'MACR'))GOTO4000
9290CCCCC   IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'CALL')GOTOxxxx
9291CCCCC   IF(NUMARG.EQ.2 .AND. IHARG(1).EQ.'OF  ' .AND.
9292CCCCC1    IHARG(2).EQ.'CALL')GOTOxxxx
9293      ENDIF
9294C
9295C               ***************************************************************
9296C               **  STEP 13--
9297C               **  DETERMINE THE TYPE CASE--
9298C               **       1) OPERATE ON A MACRO RESIDING IN A FILE;
9299C               **       2) OPERATE ON A MACRO FROM THE TERMINAL (ILLEGAL).
9300C               **  NOTE--IOFILE  WILL EQUAL 'YES' ONLY IN FILE CASE.
9301C               **  IN OTHER WORDS, THIS STEP MAKES SURE
9302C               **  THAT A FILE NAME IS EXISTENT AFTER THE
9303C               **  CREATE   AND   CALL   COMMANDS.
9304C               ***************************************************************
9305C
9306      ISTEPN='13'
9307      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9308     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9309C
9310      IWORD=2
9311      CALL DPFILE(IANSLC,IWIDTH,IWORD,
9312     1IOFILE,IBUGS2,ISUBRO,IERROR)
9313C
9314C               **********************************************
9315C               **  STEP 14--                               **
9316C               **  IF NO FILE NAME GIVEN,                  **
9317C               **  THEN GENERATE AN ERROR MESSAGE.         **
9318C               **********************************************
9319C
9320      ISTEPN='14'
9321      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9322     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9323C
9324      IF(IOFILE.NE.'YES')THEN
9325         IERROR='YES'
9326         WRITE(ICOUT,999)
9327         CALL DPWRST('XXX','BUG ')
9328         WRITE(ICOUT,1411)
9329 1411    FORMAT('***** ERROR IN DPMACR--')
9330         CALL DPWRST('XXX','BUG ')
9331         WRITE(ICOUT,1412)
9332 1412    FORMAT('      THE DESIRED MACRO OPERATION CANNOT BE CARRIED')
9333         CALL DPWRST('XXX','BUG ')
9334         WRITE(ICOUT,1414)
9335 1414    FORMAT('      BECAUSE NO USER FILE NAME WAS GIVEN.')
9336         CALL DPWRST('XXX','BUG ')
9337         WRITE(ICOUT,1415)
9338 1415    FORMAT('      ILLUSTRATIVE EXAMPLE TO DEMONSTRATE THE ',
9339     1          'PROPER FORM--')
9340         CALL DPWRST('XXX','BUG ')
9341         WRITE(ICOUT,1417)
9342 1417    FORMAT('      SUPPOSE THE ANALYST WISHES TO EXECUTE A MACRO ')
9343         CALL DPWRST('XXX','BUG ')
9344         WRITE(ICOUT,1419)
9345 1419    FORMAT('      RESIDING IN THE MASS STORAGE FILE    MAC3.  ,')
9346         CALL DPWRST('XXX','BUG ')
9347         WRITE(ICOUT,1420)
9348 1420    FORMAT('      THEN THE FOLLOWING COMMAND LINE IS ENTERED--')
9349         CALL DPWRST('XXX','BUG ')
9350         WRITE(ICOUT,1421)
9351 1421    FORMAT('         CALL MAC3.')
9352         CALL DPWRST('XXX','BUG ')
9353         GOTO9000
9354      ENDIF
9355C
9356C               *************************************
9357C               **  STEP 15--                      **
9358C               **  IF HAVE THE FILE INPUT CASE    **
9359C               **  (WHICH WE MUST HAVE)--         **
9360C               **  COPY OVER VARIABLES            **
9361C               *************************************
9362C
9363      ISTEPN='15'
9364      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9365     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9366C
9367      IOUNIT=ICRENU
9368      IFILE=ICRENA
9369      ISTAT=ICREST
9370      IF(IFILE.EQ.ISYSNA)ISTAT=ISYSST
9371      IF(IFILE.EQ.ILOGNA)ISTAT=ILOGST
9372      IFORM=ICREFO
9373      IACCES=ICREAC
9374      IPROT=ICREPR
9375C     (SEE ADDITIONAL RESETTING OF   IPROT   BELOW
9376C     IF HAVE THE SYSTEM LOGIN AND/OR THE LOCAL LOGIN MACRO FILES)
9377      ICURST=ICRECS
9378C
9379      ISUBN0='MACR'
9380      IERRFI='NO'
9381C
9382      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9383         WRITE(ICOUT,1513)ISUBN0,IERRFI,IOUNIT
9384 1513    FORMAT('ISUBN0,IERRFI,IOUNIT = ',2(A4,2X),I8)
9385         CALL DPWRST('XXX','BUG ')
9386         WRITE(ICOUT,1514)IFILE
9387 1514    FORMAT('IFILE = ',A80)
9388         CALL DPWRST('XXX','BUG ')
9389         WRITE(ICOUT,1515)ISTAT,IFORM,IACCES,IPROT,ICURST
9390 1515    FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',4(A12,2X),A12)
9391         CALL DPWRST('XXX','BUG ')
9392      ENDIF
9393C
9394C               ***********************************************
9395C               **  STEP 16--                                **
9396C               **  IF HAVE THE FILE INPUT CASE--            **
9397C               **  (WHICH WE MUST HAVE)--                   **
9398C               **  CHECK TO SEE IF THE MACRO FILE MAY EXIST **
9399C               ***********************************************
9400C
9401      ISTEPN='16'
9402      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9403     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9404C
9405      IF(ISTAT.EQ.'NONE')THEN
9406         IERROR='YES'
9407         WRITE(ICOUT,999)
9408         CALL DPWRST('XXX','BUG ')
9409         WRITE(ICOUT,1611)
9410 1611    FORMAT('***** IMPLEMENTATION ERROR IN DPMACR--')
9411         CALL DPWRST('XXX','BUG ')
9412         WRITE(ICOUT,1612)
9413 1612    FORMAT('      THE DESIRED MACRO CREATE/CALL CANNOT BE CARRIED')
9414         CALL DPWRST('XXX','BUG ')
9415         WRITE(ICOUT,1614)
9416 1614    FORMAT('      OUT BECAUSE THE INTERNAL VARIABLE    ICREST ')
9417         CALL DPWRST('XXX','BUG ')
9418         WRITE(ICOUT,1615)
9419 1615    FORMAT('      WHICH ALLOWS SUCH MACRO OPERATIONS HAS BEEN ',
9420     1          'SET TO    NONE.')
9421         CALL DPWRST('XXX','BUG ')
9422         WRITE(ICOUT,1617)ISTAT,ICREST
9423 1617    FORMAT('ISTAT,ICREST = ',A12,2X,A12)
9424         CALL DPWRST('XXX','BUG ')
9425         WRITE(ICOUT,1618)
9426 1618    FORMAT('      PLEASE CONTACT YOUR DATAPLOT IMPLEMENTOR')
9427         CALL DPWRST('XXX','BUG ')
9428         WRITE(ICOUT,1619)
9429 1619    FORMAT('      TO CORRECT THE SETTING IN SUBROUTINE INITFO.')
9430         CALL DPWRST('XXX','BUG ')
9431         GOTO9000
9432      ENDIF
9433C
9434C               ********************************
9435C               **  STEP 17--                 **
9436C               **  EXTRACT THE FILE NAME.    **
9437C               **  THIS IS NEEDED FOR MOST   **
9438C               **  (BUT NOT ALL) VARIATIONS  **
9439C               **  OF THE MACRO COMMAND.     **
9440C               ********************************
9441C
9442      ISTEPN='17'
9443      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9444     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9445C
9446      DO1710I=1,MAXSTR
9447         IANSI=IANSLC(I)
9448         ICANS(I:I)=IANSI(1:1)
9449 1710 CONTINUE
9450C
9451      ISTART=1
9452      ISTOP=IWIDTH
9453      IWORD=2
9454      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
9455     1            ICOL1,ICOL2,IFILE,NCFILE,
9456     1            IBUGS2,ISUBRO,IERROR)
9457C
9458      IF(NCFILE.LE.0)THEN
9459         IERROR='YES'
9460         WRITE(ICOUT,999)
9461         CALL DPWRST('XXX','BUG ')
9462         WRITE(ICOUT,1411)
9463         CALL DPWRST('XXX','BUG ')
9464         WRITE(ICOUT,1742)
9465 1742    FORMAT('      A USER FILE NAME IS REQUIRED IN THE CREATE AND ',
9466     1          'CALL COMMANDS')
9467         CALL DPWRST('XXX','BUG ')
9468         WRITE(ICOUT,1744)
9469 1744    FORMAT('      (FOR EXAMPLE,    CALL PROG7.DP) BUT NONE WAS ',
9470     1          'GIVEN HERE.')
9471         CALL DPWRST('XXX','BUG ')
9472         WRITE(ICOUT,1746)
9473 1746    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
9474         CALL DPWRST('XXX','BUG ')
9475         IF(IWIDTH.GE.1)THEN
9476           WRITE(ICOUT,1747)(IANSLC(I),I=1,MIN(100,IWIDTH))
9477 1747      FORMAT('      ',100A1)
9478           CALL DPWRST('XXX','BUG ')
9479         ELSE
9480           WRITE(ICOUT,999)
9481           CALL DPWRST('XXX','BUG ')
9482         ENDIF
9483         GOTO9000
9484      ENDIF
9485C
9486      IF(IERROR.EQ.'YES')GOTO9000
9487      IF(IFILE.EQ.ISYSNA)IPROT=ISYSPR
9488      IF(IFILE.EQ.ILOGNA)IPROT=ILOGPR
9489C
9490C               *****************************************
9491C               **  STEP 25--                          **
9492C               **  CHECK THE DESIRED MACRO OPERATION  **
9493C               **  (ON, OFF, OR EXECUTE).             **
9494C               *****************************************
9495C
9496      ISTEPN='25'
9497      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9498     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9499C
9500      IF(ICOM.EQ.'MACR'.AND.ICOM2.EQ.'O   ')THEN
9501        IF(NUMARG.LE.0)GOTO2900
9502        IF(NUMARG.EQ.1 .OR. IHARG(2).EQ.'ON' .OR.
9503     1     IHARG(2).EQ.'AUTO')GOTO3000
9504        IF(IHARG(2).EQ.'OFF' .OR. IHARG(2).EQ.'DEFA')GOTO4000
9505        IF(IHARG(2).EQ.'CLOS')GOTO5000
9506C
9507        IF(IHARG(2).EQ.'EXEC')THEN
9508          NSARG=3
9509          GOTO6000
9510        ELSEIF(IHARG(2).EQ.'ADD')THEN
9511          NSARG=3
9512          GOTO6000
9513        ELSEIF(IHARG(2).EQ.'CALL')THEN
9514          NSARG=3
9515          GOTO6000
9516        ELSEIF(IHARG(2).EQ.'RUN')THEN
9517          NSARG=3
9518          GOTO6000
9519        ENDIF
9520      ELSEIF(ICOM.EQ.'END '.AND.ICOM2.EQ.'    ')THEN
9521        IF(NUMARG.EQ.1 .AND. IHARG(1).EQ.'CREA')GOTO4000
9522        IF(NUMARG.GE.2 .AND. IHARG(1).EQ.'OF  ' .AND.
9523     1    IHARG(2).EQ.'CREA')GOTO4000
9524      ELSEIF(ICOM.EQ.'CREA'.AND.ICOM2.EQ.'TE  ')THEN
9525        IF(NUMARG.GE.1)GOTO3000
9526      ELSEIF(
9527     1  (ICOM.EQ.'CALL' .AND. ICOM2.EQ.'    ') .OR.
9528     1  (ICOM.EQ.'ADD ' .AND. ICOM2.EQ.'    ') .OR.
9529     1  (ICOM.EQ.'RUN ' .AND. ICOM2.EQ.'    ') .OR.
9530     1  (ICOM.EQ.'EXEC' .AND. ICOM2.EQ.'UTE '))THEN
9531        NSARG=2
9532        IF(NUMARG.GE.1)GOTO6000
9533      ENDIF
9534C
9535 2900 CONTINUE
9536C
9537      IERROR='YES'
9538      WRITE(ICOUT,999)
9539      CALL DPWRST('XXX','BUG ')
9540      WRITE(ICOUT,1411)
9541      CALL DPWRST('XXX','BUG ')
9542      WRITE(ICOUT,2912)
9543 2912 FORMAT('      THE DESIRED MACRO OPERATION CANNOT BE CARRIED OUT')
9544      CALL DPWRST('XXX','BUG ')
9545      WRITE(ICOUT,2914)
9546 2914 FORMAT('      BECAUSE THE SPECIFIED OPERATION WAS ILLEGAL.')
9547      CALL DPWRST('XXX','BUG ')
9548      WRITE(ICOUT,1415)
9549      CALL DPWRST('XXX','BUG ')
9550      WRITE(ICOUT,1417)
9551      CALL DPWRST('XXX','BUG ')
9552      WRITE(ICOUT,1419)
9553      CALL DPWRST('XXX','BUG ')
9554      WRITE(ICOUT,1420)
9555      CALL DPWRST('XXX','BUG ')
9556      WRITE(ICOUT,1421)
9557      CALL DPWRST('XXX','BUG ')
9558      GOTO9000
9559C
9560C               ********************************************************
9561C               **  STEP 30--                                         **
9562C               **  TREAT THE MACRO ON (= CREATE) CASE.  CARRY OUT    **
9563C               **  WHATEVER SYSTEM OPERATIONS ARE NEEDED IN ORDER TO **
9564C               **  OPERATE ON THE FILE OR SUBFILE.  FOR MOST         **
9565C               **  INSTALLATIONS, THIS REQUIRES                      **
9566C               **      1) AN OPENING OF THE FILE OR SUBFILE;         **
9567C               **      2) AN EQUIVALENCING OF THE FILE OR SUBFILE;   **
9568C               **      3) A  REWINDING OF THE FILE OR SUBFILE.       **
9569C               **  THE CODE BELOW OPENS THE FILE OR SUBFILE.  THE    **
9570C               **  CODE ALSO EQUIVALENCES THE FILES OR SUBFILES      **
9571C               **  TO THE FORTRAN LOGICAL UNIT NUMBER DESIGNATED IN  **
9572C               **  THE VARIABLE IMACNU (IN THE SUBROUTINE INITFO;    **
9573C               **  THE CODE ALSO REWINDS THE FILE OR SUBFILE.        **
9574C               ********************************************************
9575C
9576 3000 CONTINUE
9577      ISTEPN='30'
9578      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9579     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9580C
9581      IMACRO='ON'
9582CCCCC IOUNIT=IMACNU       OCTOBER 8, 1986
9583CCCCC APRIL 1997.  SEPARATE UNIT FOR CREATE AND CALL TO AVOID INFINITE
9584CCCCC LOOP
9585CCCCC IOUNIT=ICRENU
9586      IOUNIT=ICREN2
9587C
9588      IREWIN='ON'
9589      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
9590     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
9591      IF(IERRFI.EQ.'YES')THEN
9592        IERROR='YES'
9593        GOTO9000
9594      ENDIF
9595      IMACCS=ICURST
9596C
9597      IF(IFEEDB.EQ.'ON')THEN
9598         WRITE(ICOUT,999)
9599         CALL DPWRST('XXX','BUG ')
9600         WRITE(ICOUT,3011)
9601 3011    FORMAT('THE CREATE (MACRO) SWITCH HAS JUST BEEN TURNED ON.')
9602         CALL DPWRST('XXX','BUG ')
9603      ENDIF
9604      GOTO9000
9605C
9606C               ****************************************************************
9607C               **  STEP 40--
9608C               **  TREAT THE MACRO OFF (= END OF CREATE) CASE.
9609C               **  CARRY OUT WHATEVER SYSTEM OPERATIONS ARE NEEDED
9610C               **  IN ORDER TO OPERATE ON THE FILE OR SUBFILE.
9611C               **  FOR MOST INSTALLATIONS, THIS REQUIRES
9612C               **      1) A PLACING OF AN END MARK OF THE FILE OR SUBFILE;
9613C               **      2) A FREEING (DEASSIGNING) OF THE FILE OR SUBFILE;
9614C               ****************************************************************
9615C
9616 4000 CONTINUE
9617      ISTEPN='40'
9618      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9619     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9620C
9621      IMACRO='OFF'
9622CCCCC IOUNIT=IMACNU       OCTOBER 8, 1986
9623CCCCC APRIL 1997.  SEPARATE UNIT FOR CREATE AND CALL
9624CCCCC IOUNIT=ICRENU
9625      IOUNIT=ICREN2
9626C
9627      IENDFI='ON'
9628      IREWIN='ON'
9629      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
9630     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
9631      IF(IERRFI.EQ.'YES')GOTO9000
9632C
9633      IF(IFEEDB.EQ.'ON')THEN
9634         WRITE(ICOUT,999)
9635         CALL DPWRST('XXX','BUG ')
9636         WRITE(ICOUT,4011)
9637 4011    FORMAT('THE CREATE (MACRO) SWITCH HAS JUST BEEN TURNED OFF.')
9638         CALL DPWRST('XXX','BUG ')
9639      ENDIF
9640      GOTO9000
9641C
9642C               ************************************
9643C               **  STEP 50--                     **
9644C               **  TREAT THE MACRO CLOSE CASE.   **
9645C               ************************************
9646C
9647C     NOTE 10/14/2008: WHEN MACROS ARE NESTED, ICURST GETS SET
9648C                      TO CLOSED WHEN THE INNER-MOST MACRO IS
9649C                      CLOSED.  THIS RESULTS IN SUBSEQUENT MACROS
9650C                      NOT GETTING CLOSED.  SINCE WE DO NOT KEEP
9651C                      A SEPARATE STATUS FLAG FOR EACH FILE IN
9652C                      THE NEST, NEED TO BE SURE THAT WE CLOSE
9653C                      THE FILE REGARDLESS OF VALUE OF "ICURST".
9654C
9655 5000 CONTINUE
9656      ISTEPN='50'
9657      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9658     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9659C
9660      IOUNIT=IMACNU
9661      IENDFI='OFF'
9662      IREWIN='ON'
9663      ICURST='OPEN'
9664      CALL DPCLFI(IOUNIT,IMANAM(IMALEV),ISTAT,IFORM,IACCES,IPROT,ICURST,
9665     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
9666      IF(IERRFI.EQ.'YES')GOTO9000
9667C
9668C     NOW RESET MACRO LEVEL
9669C
9670      IMACCS='JUNK'
9671      IF(IMALEV.GE.1)IMANAM(IMALEV)='NO'
9672      IMALEV=IMALEV-1
9673      IF(IMALEV.LE.0)THEN
9674        IMACNU=IRD
9675        IMALEV=0
9676        IMACRO='OFF'
9677      ELSE
9678        IMACNU=IMACNU-1
9679        IF(IMALEV.EQ.1)IMACNU=ICRENU
9680      ENDIF
9681C
9682      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9683         WRITE(ICOUT,999)
9684         CALL DPWRST('XXX','BUG ')
9685         WRITE(ICOUT,5011)IMACNU
9686 5011    FORMAT('MACRO FILE NUMBER ',I8,' HAS JUST BEEN CLOSED')
9687         CALL DPWRST('XXX','BUG ')
9688      ENDIF
9689      GOTO9000
9690C
9691C               ************************************
9692C               **  STEP 55--                     **
9693C               **  TREAT THE CALL EXIT   CASE.   **
9694C               ************************************
9695C
9696C     NOTE 2015/03: ADD SUPPORT FOR A "CALL EXIT" CASE.  FOR EXAMPLE,
9697C                   THIS CAN BE USED TO EXIT A MACRO IF AN ERROR
9698C                   CONDITION IS ENCOUNTERED.
9699C
9700C                   THERE ARE 2 CASES:
9701C
9702C                      1. EXIT THE CURRENT MACRO ONLY
9703C
9704C                      2. EXIT ALL MACROS (I.E., RETURN CONTROL
9705C                         TO THE TERMINAL).
9706C
9707C                   THE EXIT CURRENT CASE IS HANDLED BY THE STEP 50 CODE.
9708C                   THIS BLOCK HANDLES THE EXIT ALL CASE.
9709C
9710 5500 CONTINUE
9711      ISTEPN='55'
9712      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9713     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9714C
9715      IF(IMALEV.GE.1)THEN
9716        DO5510II=1,IMALEV
9717          IOUNIT=IMACNU
9718          IENDFI='OFF'
9719          IREWIN='ON'
9720          ICURST='OPEN'
9721          CALL DPCLFI(IOUNIT,IMANAM(IMALEV),ISTAT,IFORM,IACCES,IPROT,
9722     1                ICURST,IENDFI,IREWIN,ISUBN0,IERRFI,
9723     1                IBUGS2,ISUBRO,IERROR)
9724          IF(IERRFI.EQ.'YES')GOTO9000
9725C
9726C         NOW RESET MACRO LEVEL
9727C
9728          IF(IMALEV.GE.1)IMANAM(IMALEV)='NO'
9729          IMALEV=IMALEV-1
9730          IF(IMALEV.LE.0)THEN
9731            IMACNU=IRD
9732            IMALEV=0
9733            IMACRO='OFF'
9734          ELSEIF(IMALEV.EQ.1)THEN
9735            IMACNU=ICRENU
9736          ELSEIF(IMALEV.GE.2)THEN
9737            IMACNU=IMACNU-1
9738          ENDIF
9739 5510   CONTINUE
9740      ENDIF
9741C
9742      IMACCS='JUNK'
9743C
9744      IF(IFEEDB.EQ.'ON')THEN
9745         WRITE(ICOUT,999)
9746         CALL DPWRST('XXX','BUG ')
9747         WRITE(ICOUT,5511)
9748 5511    FORMAT('ALL MACRO FILES HAVE BEEN CLOSED.')
9749         CALL DPWRST('XXX','BUG ')
9750      ENDIF
9751      GOTO9000
9752C
9753C               ********************************************************
9754C               **  STEP 60--                                         **
9755C               **  TREAT THE MACRO (= CALL) CASE.                    **
9756C               **  CARRY OUT WHATEVER SYSTEM OPERATIONS ARE NEEDED   **
9757C               **  IN ORDER TO OPERATE ON THE FILE OR SUBFILE.       **
9758C               **  FOR MOST INSTALLATIONS, THIS REQUIRES             **
9759C               **      1) AN OPENING OF THE FILE OR SUBFILE;         **
9760C               **      2) AN EQUIVALENCING OF THE FILE OR SUBFILE;   **
9761C               **      3) A  REWINDING OF THE FILE OR SUBFILE.       **
9762C               **      4) SKIPPING OVER ANY FRONT LINES              **
9763C               ********************************************************
9764C
9765 6000 CONTINUE
9766      ISTEPN='60'
9767      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9768     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9769C
9770CCCCC THE FOLLOWING SECTION WAS ADDED   AUGUST 1994
9771CCCCC TO ALLOW FOR FOR/SUBSET           AUGUST 1994
9772C               *****************************************
9773C               **  STEP 61--                          **
9774C               **  CHECK TO SEE THE TYPE CASE--       **
9775C               **    1) UNQUALIFIED (THAT IS, FULL);  **
9776C               **    2) SUBSET/EXCEPT; OR             **
9777C               **    3) FOR.                          **
9778C               *****************************************
9779C
9780      ISTEPN='61'
9781      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9782     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9783C
9784CCCCC THE FOLLOWING SECTION WAS ADDED   AUGUST 1994
9785CCCCC TO ALLOW FOR FOR/SUBSET           AUGUST 1994
9786C               *********************************************
9787C               **  STEP 62--                              **
9788C               **  BRANCH    TO THE APPROPRIATE SUBCASE   **
9789C               **  (FULL, SUBSET, OR FOR).                **
9790C               *********************************************
9791C
9792      ISTEPN='62'
9793      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
9794     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9795C
9796C               **************************************************
9797C               **  STEP 63--                                   **
9798C               **  FIND THE FIRST AND LAST ROW OF THE SUB-CHUNK**
9799C               **  OF THE FILE BEING EXECUTED                  **
9800C               **  IMACL1 = FIRST LINE TO BE EXECUTED          **
9801C               **  IMACL2 = LAST  LINE TO BE EXECUTED          **
9802C               **  IMACLR = NUMBER OF LINES ALREADY EXECUTED   **
9803C               **************************************************
9804C
9805      ISTEPN='63'
9806      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9807        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
9808        WRITE(ICOUT,6001)IMALEV,NUMARG,NSARG
9809 6001   FORMAT('IMALEV,NUMARG,NSARG = ',3I5)
9810        CALL DPWRST('XXX','BUG ')
9811      ENDIF
9812C
9813CCCCC THE FOLLOWING IS A PATCH                          AUGUST 1994
9814CCCCC TO MAKE    CALL <FILE> FOR I = ... ... ... WORK   AUGUST 1994
9815C
9816CCCCC SEPTEMBER 2005.  IF NO FOR CLAUSE, THEN INTERPRET ANY
9817CCCCC                  ARGUMENTS AFTER "CALL FILE." AS COMMAND
9818CCCCC                  LINE ARGUMENTS.
9819CCCCC
9820CCCCC                  IF THIS IS THE FIRST LEVEL CALL, CLEAR THE
9821CCCCC                  COMMAND LINE ARGUMENTS IF NO ARGUMENTS ARE
9822CCCCC                  GIVEN.
9823CCCCC
9824CCCCC MAY 2016.        OPTION TO ALLOW USER TO SPECIFY WHETHER QUOTES
9825CCCCC                  SHOULD BE STRIPPED OFF OF COMMAND LINE ARGUMENTS.
9826CCCCC
9827CCCCC SEPTEMBER 2016.  IF FIRST ARGUMENT IS "NULL", CLEAR ARGUMENT LIST.
9828CCCCC
9829CCCCC OCTOBER 2016.    UPDATE MAXIMUM NUMBER OF CHARACTERS FOR ARGUMENT
9830CCCCC                  TO 80.  ALSO ALLOW NAMED ARGUMENTS, E.G.
9831CCCCC
9832CCCCC                      CALL TEST.DP  Y=Y3  X=X2
9833CCCCC
9834CCCCC JANUARY   2017.  IF ARGUMENT STARTS WITH "-", DPEXWO TREATS AS
9835CCCCC                  WORD SEPARATOR AND REMOVES IT.  ADD OPTION TO
9836CCCCC                  NOT TREAT LEADING "-" AS WORD SEPARATOR.
9837CCCCC
9838CCCCC JULY      2017.  IF THE CALL COMMAND IS GIVEN WITHIN A LOOP,
9839CCCCC                  DATAPLOT SAVES THE CONTENTS OF THE CALL FILE
9840CCCCC                  RATHER THAN CALL COMMAND.  THIS MEANS THAT
9841CCCCC                  ARGUMENTS ARE LOST AFTER THE FIRST ITERATION
9842CCCCC                  OF THE LOOP.  THE COMMAND
9843CCCCC
9844CCCCC                     INSERT CALL LINE ARGUMENTS <string>
9845CCCCC
9846CCCCC                  WAS ADDED TO ADDRESS THIS PROBLEM.  THIS ROUTINE
9847CCCCC                  WILL INSERT THE COMMAND INTO THE SAVED LOOP
9848CCCCC                  COMMANDS.  WHEN THE LOOP IS EXECUTED, THAT
9849CCCCC                  COMMAND WILL RESTORE THE COMMAND LINE ARGUMENTS.
9850CCCCC
9851CCCCC MAY       2018.  IF NO COMMAND LINE ARGUMENTS GIVEN, THEN
9852CCCCC                  DON'T CLEAR PREVIOUS LIST.
9853C
9854      IF(NUMARG.LT.NSARG)GOTO6399
9855C
9856      IBLANK=0
9857      ICNT=0
9858      DO6290I=1,MIN(IWIDTH,255)
9859        IF(IBLANK.EQ.0 .AND. IANSLC(I)(1:1).EQ.' ')GOTO6290
9860        IBLANK=1
9861        ICNT=ICNT+1
9862        IMACCL(ICNT:ICNT)=IANSLC(I)(1:1)
9863 6290 CONTINUE
9864      NMACCL=IWIDTH
9865C
9866      IMACL1=1
9867      IMACL2=100000
9868      IHYPS2=IHYPSW
9869      ICOMCL='ON'
9870C
9871      IF(IMALEV.EQ.1)THEN
9872        DO6380II=1,50
9873          IMACAR(II)=' '
9874          IMACLA(II)=' '
9875          IMACLL(II)=0
9876 6380   CONTINUE
9877        NMACAG=0
9878        NMACLA=0
9879      ENDIF
9880C
9881      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9882        WRITE(ICOUT,6381)NUMARG,NSARG,ILOOLI,ILOOST
9883 6381   FORMAT('NUMARG,NSARG,ILOOLI,ILOOST = ',3I8,2X,A4)
9884        CALL DPWRST('XXX','BUG ')
9885      ENDIF
9886C
9887      IF(IHARG(2).EQ.'FOR ')THEN
9888         IF(NUMARG.GE.7)THEN
9889            IMACL1=IARG(5)
9890            IMACL2=IARG(7)
9891         ENDIF
9892      ELSE IF(NUMARG.GE.NSARG)THEN
9893        NMACAG=0
9894        NMACLA=0
9895        DO6390II=1,50
9896          IMACAR(II)=' '
9897          IMACLA(II)=' '
9898          IMACLL(II)=0
9899 6390   CONTINUE
9900        IFILQZ=IFILQU
9901C
9902C       ENTER THE CALL ARGUMENTS IN THE SAVED LOOP COMMANDS
9903C
9904        IF(ILOOST.EQ.'STOR' .AND. ILOOLI.LT.MAXLIL)THEN
9905          NCSTR=22
9906          ISTR(1:NCSTR)='INSERT CALL ARGUMENTS '
9907C
9908          DO6391I=1,MAXSTR
9909            ICANS(I:I)=IANSLC(I)(1:1)
9910 6391     CONTINUE
9911C
9912          ISTART=1
9913          ISTOP=IWIDTH
9914          IWORD=3
9915C
9916          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9917            WRITE(ICOUT,6382)ISTART,ISTOP
9918 6382       FORMAT('BEFORE DPEXW3: ISTART,ISTOP = ',2I8)
9919            CALL DPWRST('XXX','BUG ')
9920            DO6383JJ=1,IWIDTH
9921              WRITE(ICOUT,6384)JJ,ICANS(JJ:JJ)
9922 6384         FORMAT('JJ,ICANS(JJ:JJ) = ',I5,2X,A1)
9923              CALL DPWRST('XXX','BUG ')
9924 6383       CONTINUE
9925          ENDIF
9926C
9927          CALL DPEXW3(ICANS,ISTART,ISTOP,IWORD,
9928     1                ICOL1,ICOL2,ISTR2,NCTEMP,
9929     1                IBUGS2,ISUBRO,IERROR)
9930C
9931          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9932            WRITE(ICOUT,6386)ICOL1,ICOL2,NCTEMP
9933 6386       FORMAT('AFTER DPEXW3: ICOL1,ICOL2,NCTEMP = ',3I8)
9934            CALL DPWRST('XXX','BUG ')
9935            DO6387JJ=1,NCTEMP
9936              WRITE(ICOUT,6388)JJ,ISTR2(JJ:JJ)
9937 6388         FORMAT('JJ,ISTR2(JJ:JJ) = ',I5,2X,A1)
9938              CALL DPWRST('XXX','BUG ')
9939 6387       CONTINUE
9940          ENDIF
9941C
9942          IF(ICOL1.LE.ICOL2)THEN
9943            DO6392JJ=1,NCTEMP
9944              NCSTR=NCSTR+1
9945              ISTR(NCSTR:NCSTR)=ISTR2(JJ:JJ)
9946 6392       CONTINUE
9947C
9948            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9949              WRITE(ICOUT,16387)
995016387         FORMAT('AFTER INSERTING COMMAND LINE ARGUMENTS')
9951              CALL DPWRST('XXX','BUG ')
9952              DO16388JJ=1,NCSTR
9953                WRITE(ICOUT,16389)JJ,ISTR(JJ:JJ)
995416389           FORMAT('JJ,ISTR(JJ:JJ) = ',I5,2X,A1)
9955                CALL DPWRST('XXX','BUG ')
995616388         CONTINUE
9957            ENDIF
9958C
9959          ENDIF
9960C
9961          ILOOLI=ILOOLI+1
9962          NUMLIL=ILOOLI
9963          IWIDLL(ILOOLI)=NCSTR
9964          IF(NCSTR.GT.MAXCIL)NCSTR=MAXCIL
9965          DO6393JJ=1,NCSTR
9966            IANSLO(ILOOLI,JJ)(1:1)=ISTR(JJ:JJ)
9967 6393     CONTINUE
9968C
9969        ENDIF
9970C
9971C       DPTYPE DOES NOT SPLIT WORDS IN THE WAY NEEDED IN PARSING
9972C       COMMAND LINE ARGUMENTS.  CALL DPNUWO TO DETERMINE THE
9973C       NUMBER OF WORDS ON THE COMMAND LINE.
9974C
9975        ISTR=' '
9976        DO16381II=1,IWIDTH
9977          ISTR(II:II)=IANSLC(II)(1:1)
997816381   CONTINUE
9979        ISTART=1
9980        CALL DPNUWO(ISTR,ISTART,IWIDTH,NWORD,
9981     1              IBUGS2,ISUBRO,IERROR)
9982C
9983        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
9984          WRITE(ICOUT,16382)NWORD,IERROR
998516382     FORMAT('AFTER DPNUWO: NWORD,IERROR = ',I5,2X,A4)
9986          CALL DPWRST('XXX','BUG ')
9987        ENDIF
9988C
9989        IFILQU='ON'
9990        DO6370J=NSARG+1,NWORD
9991          NMACAG=NMACAG+1
9992          IF(NMACAG.GT.50)GOTO6379
9993          ISTART=1
9994          ISTOP=IWIDTH
9995          IWORD=J
9996          IHYPSW='OFF'
9997          CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
9998     1                ICOL1,ICOL2,IMACAR(NMACAG),NCTEMP,
9999     1                IBUGS2,ISUBRO,IERROR)
10000          IHYPSW=IHYPS2
10001C
10002          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10003            ISTEPN='637'
10004            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10005            WRITE(ICOUT,6394)J,IWORD,NMACAG,NCTEMP,IMACAR(NMACAG)
10006 6394       FORMAT('6370: J,IWORD,NMACAG,NCTEMP,IMACAR(NMACAG) = ',
10007     1             4I5,2X,A80)
10008            CALL DPWRST('XXX','BUG ')
10009          ENDIF
10010C
10011C         CHECK IF 80 CHARACTERS EXCEEDED (BE SURE TO MAKE LAST
10012C         CHARACTER A QUOTE IF FIRST CHARACTER IS A QUOTE).
10013C
10014          IF(NCTEMP.GT.80)THEN
10015            NCTEMP=80
10016            IF(IMACAR(NMACAG)(1:1).EQ.'"')
10017     1         IMACAR(NMACAG)(NCTEMP:NCTEMP)='"'
10018          ENDIF
10019C
10020C         REMOVE LEADING/TRAILING QUOTES IF NEEEDED
10021C
10022          IF(IMACAR(NMACAG)(1:1).EQ.'"' .AND.
10023     1       IMACAR(NMACAG)(NCTEMP:NCTEMP).EQ.'"')THEN
10024            IF(IQUOST.EQ.'ON')THEN
10025              IMACAR(NMACAG)(1:NCTEMP-2)=IMACAR(NMACAG)(2:NCTEMP-1)
10026              NCTEMP=NCTEMP-2
10027              IMACAR(NMACAG)(NCTEMP+1:NCTEMP+2)='  '
10028            ENDIF
10029          ENDIF
10030C
10031          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10032            WRITE(ICOUT,17394)
1003317394       FORMAT('AFTER STRIP QUOTES: NMACAG,IMACAR(NMACAG) =',
10034     1             I5,2X,A80)
10035            CALL DPWRST('XXX','BUG ')
10036          ENDIF
10037C
10038C         2016/09: IF FIRST ARGUMENT IS "NULL", THEN BLANK OUT
10039C                  ARGUMENT LIST AND SET NUMBER OF ARGUMENTS TO 0.
10040C
10041          IF(NMACAG.EQ.1)THEN
10042            IF(IMACAR(1).EQ.'NULL' .OR. IMACAR(1).EQ.'null')THEN
10043              IMACAR(1)=' '
10044              NMACAG=0
10045              GOTO6379
10046            ENDIF
10047          ENDIF
10048C
10049C         2018/05: ALLOW "EMPTY" ARGUMENTS, DO NOT SET TO ZZZZNULL
10050C
10051          IF(NCTEMP.EQ.1 .AND. IMACAR(NMACAG)(1:1).EQ.' ')THEN
10052            IMACAR(NMACAG)=' '
10053            NCTEMP=1
10054          ELSEIF(NCTEMP.EQ.0)THEN
10055            IMACAR(NMACAG)=' '
10056            NCTEMP=1
10057          ENDIF
10058C
10059C         2016/10: CHECK FOR NAMED ARGUMENTS
10060C
10061C         2018/04: CHECK FOR FOLLOWING 2 CASES
10062C
10063C                  1.  "FRAME=FOR I = 1 1 50"
10064C                  2.   FRAME="FOR I = 1 1 50"
10065C
10066C                  AS FIRST STEP, CHECK FOR FIRST OCCURENCE OF QUOTE
10067C                  (IF ANY) AND FIRST OCCURRENCE OF EQUAL SIGN.
10068C
10069C                  NOTE THAT CODE WAS ADDED IN MAIN AND DPTYPE ROUTINES
10070C                  SO THAT EQUAL SIGN WILL NOT BE A DELIMITER ON A CALL
10071C                  COMMAND.
10072C
10073          IPOSQU=0
10074          IPOSEQ=0
10075C
10076C         CHECK FOR FIRST EQUAL CHARACTER.  HOWEVER, IF THE EQUAL
10077C         CHARACTER IS PRECEEDED BY AN ESCAPE CHARACTER ("\"), THEN
10078C         REMOVE THE ESCAPE CHARACTER BUT TREAT AS NO EQUAL CHARACTER
10079C         CASE.  START WITH CHARACTER POSITION 2 AS THERE NEEDS TO BE
10080C         AT LEAST ONE CHARACTER FOR THE ARGUMENT NAME.
10081C
10082C         2019/11: ONLY TRIGGER "NAMED" ARGUMENT IF THERE IS A SINGLE
10083C                  WORD TO LEFT OF EQUAL SIGN.
10084C
10085          DO36311II=2,NCTEMP-1
10086            IF(IMACAR(NMACAG)(II:II).EQ.'=')THEN
10087              IF(II.GT.1 .AND. IMACAR(NMACAG)(II-1:II-1).EQ.'\')THEN
10088                IMACAR(NMACAG)(II-1:NCTEMP-1)=IMACAR(NMACAG)(II:NCTEMP)
10089                IMACAR(NMACAG)(NCTEMP:NCTEMP)=' '
10090                NCTEMP=NCTEMP-1
10091                GOTO36319
10092              ENDIF
10093              DO36113LL=1,II-1
10094                IF(IMACAR(NMACAG)(LL:LL).NE.' ')THEN
10095                  IFRST=LL
10096                  GOTO36114
10097                ENDIF
1009836113         CONTINUE
10099              GOTO36319
1010036114         CONTINUE
10101              DO36115LL=II-1,IFRST,-1
10102                IF(IMACAR(NMACAG)(LL:LL).NE.' ')THEN
10103                  ILAST=LL
10104                  GOTO36116
10105                ENDIF
1010636115         CONTINUE
10107              GOTO36319
1010836116         CONTINUE
10109              DO36117LL=IFRST,ILAST
10110                IF(IMACAR(NMACAG)(LL:LL).EQ.' ')THEN
10111                  GOTO36319
10112                ENDIF
1011336117         CONTINUE
10114C
10115              IPOSEQ=II
10116              GOTO36319
10117            ENDIF
1011836311     CONTINUE
1011936319     CONTINUE
10120C
10121C         NOW CHECK FOR OCCURENCE OF QUOTE.  NOTE THAT QUOTE IS ONLY
10122C         TREATED AS AN ARGUMENT DELIMITER IF IT IS THE FIRST CHARACTER
10123C         IN THE STRING OR THE FIRST CHARACTER AFTER THE EQUAL SIGN.  IN
10124C         ADDITION, IF A QUOTE DELIMITER IS FOUND, CHECK FOR A QUOTE AS
10125C         THE LAST CHARACTER.  IF NOT FOUND, THEN ADD IT.
10126C
10127          IF(IMACAR(NMACAG)(1:1).EQ.'"')THEN
10128            IPOSQU=1
10129          ELSEIF(IMACAR(NMACAG)(IPOSEQ+1:IPOSEQ+1).EQ.'"')THEN
10130            IPOSQU=IPOSEQ+1
10131          ENDIF
10132C
10133          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10134            WRITE(ICOUT,36394)IPOSEQ,IPOSQU,NCTEMP
1013536394       FORMAT('IPOSEQ,IPOSQU,NCTEMP = ',3I8)
10136            CALL DPWRST('XXX','BUG ')
10137          ENDIF
10138C
10139C         IF ENDING QUOTE NOT PRESENT, ADD IT.
10140C
10141          IF(IPOSQU.GT.0)THEN
10142            IF(IMACAR(NMACAG)(NCTEMP:NCTEMP).EQ.')')THEN
10143              IF(IMACAR(NMACAG)(NCTEMP-1:NCTEMP-1).NE.'"')THEN
10144                NCTEMP=NCTEMP+1
10145                IMACAR(NMACAG)(NCTEMP-1:NCTEMP)='")'
10146              ENDIF
10147            ELSE
10148              IF(IMACAR(NMACAG)(NCTEMP:NCTEMP).NE.'"')THEN
10149                NCTEMP=NCTEMP+1
10150                IMACAR(NMACAG)(NCTEMP:NCTEMP)='"'
10151              ENDIF
10152            ENDIF
10153          ENDIF
10154C
10155C         PROCESS STRING BASED ON WHETHER QUOTES/EQUAL SIGNS ARE
10156C         PRESENT.
10157C
10158          IF(IPOSEQ.EQ.0 .AND. IPOSQU.EQ.0)THEN
10159C
10160C           CASE WITH NO EQUAL AND NO QUOTE.  IN THIS CASE, WE HAVE
10161C           A POSITIONAL ARGUMENT AND DO NOT NEED TO PROCESS QUOTES.
10162C
10163C           IN THIS CASE, NO ADDITIONAL PROCESSING IS REQUIRED.
10164C
10165            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10166              WRITE(ICOUT,46351)
1016746351         FORMAT('NO EQUAL, NO QUOTE CASE: NOTHING DONE')
10168              CALL DPWRST('XXX','BUG ')
10169            ENDIF
10170C
10171          ELSEIF(IPOSEQ.EQ.0 .AND. IPOSQU.GE.1)THEN
10172C
10173C           CASE WITH NO EQUAL BUT WITH QUOTE.  IN THIS CASE, WE HAVE
10174C           A POSITIONAL ARGUMENT AND WE NEED TO PROCESS QUOTES.
10175C
10176C           ONLY PROCESSING REQUIRED IS TO STRIP OFF LEADING/TRAILING
10177C           QUOTE IF THAT OPTION SET.
10178C
10179            IF(IQUOST.EQ.'ON')THEN
10180              IF(IMACAR(NMACAG)(NCTEMP:NCTEMP).EQ.')')THEN
10181                IMACAR(NMACAG)(1:NCTEMP-3)=IMACAR(NMACAG)(2:NCTEMP-2)
10182                NCTEMP=NCTEMP-2
10183                IMACAR(NMACAG)(NCTEMP:NCTEMP+2)=')  '
10184              ELSE
10185                IMACAR(NMACAG)(1:NCTEMP-2)=IMACAR(NMACAG)(2:NCTEMP-1)
10186                IMACAR(NMACAG)(NCTEMP+1:NCTEMP+2)='  '
10187                NCTEMP=NCTEMP-2
10188              ENDIF
10189            ENDIF
10190C
10191            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10192              WRITE(ICOUT,46361)
1019346361         FORMAT('NO EQUAL, QUOTE CASE:')
10194              CALL DPWRST('XXX','BUG ')
10195              WRITE(ICOUT,46363)NMACAG,NCTEMP,IMACAR(NMACAG)
1019646363         FORMAT('NMACAG,NCTEMP,IMACAR(NMACAG) = ',2I8,A80)
10197              CALL DPWRST('XXX','BUG ')
10198            ENDIF
10199C
10200          ELSEIF(IPOSEQ.GE.1 .AND. IPOSQU.EQ.0)THEN
10201C
10202C           CASE WITH EQUAL AND NO QUOTE.  IN THIS CASE, WE HAVE
10203C           A NAMED ARGUMENT AND DO NOT NEED TO PROCESS QUOTES.
10204C
10205C           IN THIS CASE, NEED TO MODIFY THE MACRO NAME TABLE AND
10206C           ALSO ADJUST THE ARGUMENT STRING.
10207C
10208            NMACLA=NMACLA+1
10209            IMACLL(NMACLA)=NMACAG
10210            IMACLA(NMACLA)(1:IPOSEQ-1)=IMACAR(NMACAG)(1:IPOSEQ-1)
10211            IMACNC(NMACLA)=IPOSEQ-1
10212            ICNT2=NCTEMP-IPOSEQ
10213            IF(ICNT2.GE.1)THEN
10214              IMACAR(NMACAG)(1:ICNT2)=IMACAR(NMACAG)(IPOSEQ+1:NCTEMP)
10215              IMACAR(NMACAG)(ICNT2+1:NCTEMP)=' '
10216              NCTEMP=ICNT2
10217            ELSE
10218              IMACAR(NMACAG)=' '
10219              NCTEMP=1
10220            ENDIF
10221C
10222            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10223              WRITE(ICOUT,46371)
1022446371         FORMAT('EQUAL, NO QUOTE CASE:')
10225              CALL DPWRST('XXX','BUG ')
10226              WRITE(ICOUT,46373)NMACAG,NCTEMP,IMACAR(NMACAG)
1022746373         FORMAT('NMACAG,NCTEMP,IMACAR(NMACAG) = ',2I8,2X,A80)
10228              CALL DPWRST('XXX','BUG ')
10229              WRITE(ICOUT,46375)NMACLA,IMACLL(NMACLA),IMACNC(NMACLA),
10230     1                          IMACLA(NMACLA)
1023146375         FORMAT('NMACLA,IMACLL(NMACLA),IMACNC(NMACLA),'
10232     1               'IMACLA(NMACLA) = ',3I8,A80)
10233              CALL DPWRST('XXX','BUG ')
10234            ENDIF
10235C
10236          ELSEIF(IPOSEQ.GE.1 .AND. IPOSQU.GE.1)THEN
10237C
10238C           CASE WITH EQUAL AND QUOTE.  IN THIS CASE, WE HAVE
10239C           A NAMED ARGUMENT AND WE NEED TO PROCESS QUOTES.
10240C
10241C           TREAT CASE WHERE QUOTE IS FOR THE FULL STRING SEPARATELY
10242C           FROM CASE WHERE QUOTE IS FOR THE VALUE ONLY.
10243C
10244            IF(IPOSQU.EQ.1)THEN
10245              NMACLA=NMACLA+1
10246              IMACLL(NMACLA)=NMACAG
10247              ICNT=IPOSEQ-2
10248              IMACLA(NMACLA)(1:ICNT)=IMACAR(NMACAG)(2:IPOSEQ-1)
10249              IMACNC(NMACLA)=ICNT
10250              ICNT2=NCTEMP-IPOSEQ-1
10251              IF(ICNT2.GE.1)THEN
10252                IMACAR(NMACAG)(1:ICNT2)=
10253     1            IMACAR(NMACAG)(IPOSEQ+1:NCTEMP-1)
10254                IMACAR(NMACAG)(ICNT2+1:80)=' '
10255                NCTEMP=ICNT2
10256              ELSE
10257                IMACAR(NMACAG)=' '
10258                NCTEMP=1
10259              ENDIF
10260            ELSE
10261              NMACLA=NMACLA+1
10262              IMACLL(NMACLA)=NMACAG
10263              ICNT=IPOSEQ-1
10264              IMACLA(NMACLA)(1:ICNT)=IMACAR(NMACAG)(1:IPOSEQ-1)
10265              IMACNC(NMACLA)=ICNT
10266              ICNT2=NCTEMP-IPOSEQ
10267              IF(ICNT2.GE.1)THEN
10268                IMACAR(NMACAG)(1:ICNT2)=IMACAR(NMACAG)(IPOSEQ+1:NCTEMP)
10269                IMACAR(NMACAG)(ICNT2+1:80)=' '
10270                NCTEMP=ICNT2
10271              ELSE
10272                IMACAR(NMACAG)=' '
10273                NCTEMP=1
10274              ENDIF
10275              IF(IQUOST.EQ.'ON' .AND. NCTEMP.GE.2)THEN
10276                IF(IMACAR(NMACAG)(NCTEMP:NCTEMP).EQ.')')THEN
10277                  IMACAR(NMACAG)(1:NCTEMP-3)=IMACAR(NMACAG)(2:NCTEMP-2)
10278                  NCTEMP=NCTEMP-2
10279                  IMACAR(NMACAG)(NCTEMP:NCTEMP+2)=')  '
10280                ELSE
10281                  IMACAR(NMACAG)(1:NCTEMP-2)=IMACAR(NMACAG)(2:NCTEMP-1)
10282                  NCTEMP=NCTEMP-2
10283                  IMACAR(NMACAG)(NCTEMP+1:NCTEMP+2)='  '
10284                ENDIF
10285                IF(NCTEMP.LE.0)THEN
10286                  IMACAR(NMACAG)=' '
10287                  NCTEMP=1
10288                ENDIF
10289              ENDIF
10290            ENDIF
10291C
10292            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10293              WRITE(ICOUT,46381)
1029446381         FORMAT('EQUAL, QUOTE CASE:')
10295              CALL DPWRST('XXX','BUG ')
10296              WRITE(ICOUT,46373)NMACAG,NCTEMP,IMACAR(NMACAG)
10297              CALL DPWRST('XXX','BUG ')
10298              WRITE(ICOUT,46375)NMACLA,IMACLL(NMACLA),IMACNC(NMACLA),
10299     1                          IMACLA(NMACLA)
10300              CALL DPWRST('XXX','BUG ')
10301            ENDIF
10302C
10303          ENDIF
10304C
10305          IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'MACR')THEN
10306            WRITE(ICOUT,6373)NMACAG,NCTEMP,IMACAR(NMACAG)
10307 6373       FORMAT('NMACAG,NCTEMP,IMACAR(NMACAG) = ',2I5,2X,A80)
10308            CALL DPWRST('XXX','BUG ')
10309          ENDIF
10310C
10311 6370   CONTINUE
10312 6379   CONTINUE
10313        IFILQU=IFILQZ
10314C
10315C       2018/04: CHECK FOR OPENING AND CLOSING PARENTHEIS AROUND FULL
10316C                ARGUMENT LIST (E.G., CALL (Y=Y,X=X)).
10317C
10318C                NOTE THAT THE LEFT PARENTHESIS MAY BE PART OF THE
10319C                ARGUMENT LABEL (IF GIVEN) OR THE ARGUMENT VALUE
10320C                (IF ARGUMENTS ENTERED BY POSITION).  THE RIGHT
10321C                PARENTHESIS WILL ALWAYS BE PART OF THE ARGUMENT
10322C                VALUE.
10323C
10324C                AS A FURTHER COMPLICATION, NEED TO CHECK IF THE
10325C                LEFT PARENTHESIS IS FOLLOWED BY A SPACE AND LIKEWISE
10326C                IF THE RIGHT PARENTHESIS IS PRECEEDED BY A SPACE.
10327C
10328        IF(NMACAG.GE.1)THEN
10329C
10330C         STEP 1: CHECK IF EITHER FIRST LABEL OR FIRST ARGUMENT IS
10331C                 STARTS WITH A PARENTHESIS.  CHECK LABEL FIRST.
10332C
10333          IFLAG=0
10334          IF(IMACLA(1)(1:1).EQ.'(')THEN
10335            IFLAG=1
10336            DO16392KK=1,7
10337              IMACLA(1)(KK:KK)=IMACLA(1)(KK+1:KK+1)
1033816392       CONTINUE
10339            IMACLA(1)(8:8)=' '
10340            IMACNC(1)=IMACNC(1)-1
10341C
10342C           NOW REMOVE ANY LEADING SPACES FROM LABEL
10343C
10344            DO16394KK=1,IMACNC(1)
10345              IF(IMACLA(1)(KK:KK).NE.' ')THEN
10346                IF(KK.GT.1)THEN
10347                  NCTEMP=IMACNC(1) - KK + 1
10348                  IMACLA(1)(1:NCTEMP)=IMACLA(1)(KK:IMACNC(1))
10349                  IMACLA(1)(NCTEMP+1:8)=' '
10350                  IMACNC(1)=NCTEMP
10351                ENDIF
10352                GOTO16396
10353              ENDIF
1035416394       CONTINUE
1035516396       CONTINUE
10356          ELSEIF(IMACAR(1)(1:1).EQ.'(')THEN
10357            IFLAG=2
10358            DO16393KK=1,79
10359              IMACAR(1)(KK:KK)=IMACAR(1)(KK+1:KK+1)
1036016393       CONTINUE
10361            IMACAR(1)(80:80)=' '
10362          ENDIF
10363C
10364          IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'MACR')THEN
10365            WRITE(ICOUT,46661)IFLAG
1036646661       FORMAT('IFLAG = ',I5)
10367            CALL DPWRST('XXX','BUG ')
10368          ENDIF
10369C
10370C         STEP 2: CHECK IF LAST ARGUMENT VALUE ENDS WITH RIGHT
10371C                 PARENTHESIS
10372C
10373          DO16391JJ=80,1,-1
10374            IF(IMACAR(NMACAG)(JJ:JJ).EQ.')')THEN
10375              IMACAR(NMACAG)(JJ:JJ)=' '
10376            ENDIF
1037716391     CONTINUE
10378C
10379          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10380            WRITE(ICOUT,46391)
1038146391       FORMAT('AFTER REMOVE LEADING/TRAILING PARENTHESIS')
10382            CALL DPWRST('XXX','BUG ')
10383            WRITE(ICOUT,46392)NMACLA,IMACLL(1),IMACNC(1),
10384     1                        IMACLA(1)
1038546392       FORMAT('NMACLA,IMACLL(1),IMACNC(1),IMACLA(1) = ',
10386     1             3I8,2X,A80)
10387            CALL DPWRST('XXX','BUG ')
10388            WRITE(ICOUT,46375)NMACLA,IMACLL(NMACLA),
10389     1                        IMACNC(NMACCL),IMACLA(NMACLA)
10390            CALL DPWRST('XXX','BUG ')
10391          ENDIF
10392        ENDIF
10393      ENDIF
10394C
10395 6399 CONTINUE
10396C
10397      IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'MACR')THEN
10398        WRITE(ICOUT,6375)NMACLA,NMACAG
10399 6375   FORMAT('NMACLA,NMACAG = ',2I5)
10400        CALL DPWRST('XXX','BUG ')
10401        IF(NMACLA.GE.1)THEN
10402          DO6376JJ=1,NMACLA
10403            WRITE(ICOUT,6377)JJ,IMACLL(JJ),IMACNC(JJ),IMACLA(JJ)
10404 6377       FORMAT('JJ,IMACLL(JJ),IMACNC(JJ),IMACLA(JJ) = ',3I5,2X,A8)
10405            CALL DPWRST('XXX','BUG ')
10406 6376     CONTINUE
10407        ENDIF
10408C
10409        IF(NMACAG.GE.1)THEN
10410          DO26386JJ=1,NMACAG
10411            WRITE(ICOUT,26387)JJ,IMACAR(JJ)
1041226387       FORMAT('JJ,IMACAR(JJ) = ',I5,2X,A80)
10413            CALL DPWRST('XXX','BUG ')
1041426386     CONTINUE
10415        ENDIF
10416      ENDIF
10417C
10418C               ********************************************************
10419C               **  STEP 64--                                         **
10420C               **  THE CODE BELOW OPENS THE FILE OR SUBFILE. THE     **
10421C               **  CODE ALSO EQUIVALENCES THE FILES OR SUBFILES TO   **
10422C               **  THE FORTRAN LOGICAL UNIT NUMBER DESIGNATED        **
10423C               **  IN THE VARIABLE IMACNU (IN THE MAIN PROGRAM);     **
10424C               **  THE RECOMMENDED VALUE FOR IMACNU IS 34; IF THIS   **
10425C               **  IS INAPPROPRIATE, MAKE CHANGES IN INITHK AND DPSYOP.
10426C               **  THE CODE ALSO REWINDS THE FILE OR SUBFILE.        **
10427C               ********************************************************
10428C
10429      ISTEPN='64'
10430      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
10431     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10432C
10433CCCCC IMACRO='EXEC'
10434CCCCC IOUNIT=IMACN2
10435      IOUNIT=IMACNU
10436C
10437      IREWIN='ON'
10438CCCCC MAY,1990.  SET ISTAT TO "OLD" FOR CALL CASE.  DO THIS SO WILL
10439CCCCC SEARCH THE SYSTEM DIRECTORY IF NOT FOUND AS REQUESTED. (ALAN)
10440      ISTAT='OLD'
10441      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
10442     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
10443      IF(IERRFI.EQ.'YES')THEN
10444        IERROR='YES'
10445        GOTO9000
10446      ENDIF
10447      IMACRO='EXEC'
10448      IMACCS=ICURST
10449C
10450C     2014/02: SAVE NAME OF MACRO.
10451C
10452CCCCC ICRENA=IFILE
10453      IMANAM(IMALEV)=' '
10454      IMANAM(IMALEV)=IFILE
10455C
10456      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10457         WRITE(ICOUT,999)
10458         CALL DPWRST('XXX','BUG ')
10459         WRITE(ICOUT,6411)
10460 6411    FORMAT('A MACRO FILE HAS JUST BEEN OPENED FOR EXECUTION')
10461         CALL DPWRST('XXX','BUG ')
10462      ENDIF
10463C
10464CCCCC THE FOLLOWING SECTION WAS ADDED    AUGUST 1994
10465C               **************************************************
10466C               **  STEP 65--                                   **
10467C               **  IF THE CALL COMMAND IS EXECUTING ONLY A     **
10468C               **  (NECESSARILY CONTIGUOUS) PART OF A FILE,    **
10469C               **  THEN SKIP OVER ANY NON-EXECUTING FRONT LINES**
10470C               **  OF THE FILE (THAT IS, READ THE FILE         **
10471C               **  FROM LINE 1 TO LINE (IMACL1-1)).            **
10472C               **************************************************
10473C
10474      ISTEPN='65'
10475      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
10476     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10477C
10478      IMACLR=0
10479      IF(IMACL1.GE.2)THEN
10480         IMAX=IMACL1-1
10481         DO6500I=1,IMAX
10482CCCCC       CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
10483CCCCC1      IA,NUMCHA,
10484CCCCC1      ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
10485CCCCC       IF(IERROR.EQ.'YES')GOTO9000
10486CCCCC THE FOLLOWING IS ALSO A PATCH   FOR   CALL <FILE> FOR ETC.
10487            IMACLR=IMACLR+1
10488            READ(IOUNIT,6511)ICJUNK
10489 6511       FORMAT(A1)
10490 6500    CONTINUE
10491      ENDIF
10492      GOTO9000
10493C
10494C               ****************
10495C               **  STEP 90-- **
10496C               **  EXIT.     **
10497C               ****************
10498C
10499 9000 CONTINUE
10500C
10501      ICOMCL=ICOMC2
10502C
10503      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
10504         WRITE(ICOUT,999)
10505         CALL DPWRST('XXX','BUG ')
10506         WRITE(ICOUT,9011)
10507 9011    FORMAT('***** AT THE END       OF DPMACR--')
10508         CALL DPWRST('XXX','BUG ')
10509         WRITE(ICOUT,9012)IMACRO,IMACNU,IMACCS,IMACL1,IMACL2
10510 9012    FORMAT('IMACRO,IMACNU,IMACCS,IMACL1,IMACL2 = ',
10511     1   A4,I8,2X,A12,I8,I8)
10512         CALL DPWRST('XXX','BUG ')
10513         WRITE(ICOUT,9013)IBUGS2,IFOUND,IERROR,IOUNIT,NUMCHA
10514 9013    FORMAT('IBUGS2,IFOUND,IERROR,IOUNIT,NUMCHA = ',3(A4,2X),2I8)
10515         CALL DPWRST('XXX','BUG ')
10516         WRITE(ICOUT,9015)ICOM,ICOM2,IOFILE,IWIDTH,NUMARG,NMACAG
10517 9015    FORMAT('ICOM,ICOM2,IOFILE,IWIDTH,NUMARG,NMACAG = ',
10518     1          3(A4,2X),3I8)
10519         CALL DPWRST('XXX','BUG ')
10520         WRITE(ICOUT,9017)(IANSLC(I),I=1,MIN(120,IWIDTH))
10521 9017    FORMAT('IANSLC(.) = ',120A1)
10522         CALL DPWRST('XXX','BUG ')
10523C
10524         IF(NUMARG.GE.1)THEN
10525            DO9019I=1,NUMARG
10526               WRITE(ICOUT,9020)I,IHARG(I),IHARG2(I)
10527 9020          FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2(2X,A4))
10528               CALL DPWRST('XXX','BUG ')
10529 9019       CONTINUE
10530         ENDIF
10531C
10532         WRITE(ICOUT,9031)JP3,JP4,JP5,KMIN,KDEL,KMAX
10533 9031    FORMAT('JP2,JP3,JP4,KMIN,KDEL,KMAX = ',6I8)
10534         CALL DPWRST('XXX','BUG ')
10535C
10536         WRITE(ICOUT,9032)NUMNAM
10537 9032    FORMAT('NUMNAM = ',I8)
10538         CALL DPWRST('XXX','BUG ')
10539         IF(NUMNAM.GE.1)THEN
10540            DO9035I=1,NUMNAM
10541               WRITE(ICOUT,9036)I,IHNAME(I),IHNAM2(I),IUSE(I),
10542     1         IVALUE(I),VALUE(I)
10543 9036          FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),',
10544     1         'IVALUE(I),VALUE(I) = ',I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
10545               CALL DPWRST('XXX','BUG ')
10546 9035       CONTINUE
10547         ENDIF
10548C
10549         WRITE(ICOUT,9043)(IA(I),I=1,MIN(120,NUMCHA))
10550 9043    FORMAT('(IA(I),I=1,IMAX) = ',120A1)
10551         CALL DPWRST('XXX','BUG ')
10552         WRITE(ICOUT,9052)IFILE
10553 9052    FORMAT('IFILE  = ',A80)
10554         CALL DPWRST('XXX','BUG ')
10555         WRITE(ICOUT,9053)ISTAT,IFORM,IACCES,IPROT,ICURST
10556 9053    FORMAT('ISTAT,IFORM,IACCES,IPROT  = ',4(A12,2X),A12)
10557         CALL DPWRST('XXX','BUG ')
10558         WRITE(ICOUT,9058)IENDFI,IREWIN,IERRFI,ISUBN0
10559 9058    FORMAT('IENDFI,IREWIN,IERRFI,ISUBN0 = ',3(A4,2X),A12)
10560         CALL DPWRST('XXX','BUG ')
10561      ENDIF
10562C
10563      RETURN
10564      END
10565      SUBROUTINE DPMAHA(MAXNXT,ICASAN,ICAPSW,IFORSW,
10566     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
10567C
10568C     PURPOSE--COMPUTE MANTEL-HAENSZEL TEST.
10569C     EXAMPLE--MANTEL-HAENSZEL TEST Y1 Y2
10570C            --MANTEL-HAENSZEL TEST Y1 Y2 GROUPID
10571C            --MANTEL-HAENSZEL TEST Y1 GROUPID1 Y2 GROUPID2
10572C     REFERENCE--FLEISS, LEVIN, AND PAIK (2003), "STATISTICAL
10573C                METHODS FOR RATES AND PROPORTIONS", THIRD
10574C                EDITION, WILEY, PP. 250-253.
10575C              --CONOVER (1999), "PRACTICAL NONPARAMETRIC
10576C                STATISTICS", THIRD EDITION, WILEY, PP. 192-195.
10577C     WRITTEN BY--ALAN HECKERT
10578C                 STATISTICAL ENGINEERING DIVISION
10579C                 INFORMATION TECHNOLOGY LABORATORY
10580C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10581C                 GAITHERSBURG, MD 20899-8980
10582C                 PHONE--301-975-2899
10583C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10584C           OF THE NATIONAL BUREAU OF STANDARDS.
10585C     LANGUAGE--ANSI FORTRAN (1977)
10586C     VERSION NUMBER--2007/5
10587C     ORIGINAL VERSION--MAY       2007.
10588C     UPDATED         --JANUARY   2011. USE DPPARS, DPPAR3
10589C
10590C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10591C
10592      CHARACTER*4 ICASAN
10593      CHARACTER*4 ICAPSW
10594      CHARACTER*4 IFORSW
10595C
10596      CHARACTER*4 IBUGA2
10597      CHARACTER*4 IBUGA3
10598      CHARACTER*4 IBUGQ
10599      CHARACTER*4 ISUBRO
10600      CHARACTER*4 IFOUND
10601      CHARACTER*4 IERROR
10602C
10603      CHARACTER*4 ICASEQ
10604      CHARACTER*4 ISUBN1
10605      CHARACTER*4 ISUBN2
10606      CHARACTER*4 ISTEPN
10607      CHARACTER*4 IH
10608      CHARACTER*4 IH2
10609      CHARACTER*4 IHOST1
10610      CHARACTER*4 ISUBN0
10611      CHARACTER*4 ICASE
10612      CHARACTER*40 INAME
10613C
10614      PARAMETER (MAXSPN=20)
10615      CHARACTER*4 IVARN1(MAXSPN)
10616      CHARACTER*4 IVARN2(MAXSPN)
10617      CHARACTER*4 IVARTY(MAXSPN)
10618      REAL PVAR(MAXSPN)
10619      INTEGER ILIS(MAXSPN)
10620      INTEGER NRIGHT(MAXSPN)
10621      INTEGER ICOLR(MAXSPN)
10622C
10623C-----COMMON----------------------------------------------------------
10624C
10625      INCLUDE 'DPCOPA.INC'
10626      INCLUDE 'DPCOZZ.INC'
10627C
10628      REAL TEMP1(MAXOBV)
10629      REAL TEMP2(MAXOBV)
10630      REAL TEMP3(MAXOBV)
10631      REAL TEMP4(MAXOBV)
10632      REAL TEMP5(MAXOBV)
10633      REAL XIDTEM(MAXOBV)
10634      REAL XIDTE2(MAXOBV)
10635      REAL Y1(MAXOBV)
10636      REAL Y2(MAXOBV)
10637      REAL XGROU1(MAXOBV)
10638      REAL XGROU2(MAXOBV)
10639C
10640      EQUIVALENCE (GARBAG(IGARB1),TEMP1(1))
10641      EQUIVALENCE (GARBAG(IGARB2),TEMP2(1))
10642      EQUIVALENCE (GARBAG(IGARB3),TEMP3(1))
10643      EQUIVALENCE (GARBAG(IGARB4),XIDTEM(1))
10644      EQUIVALENCE (GARBAG(IGARB5),XIDTE2(1))
10645      EQUIVALENCE (GARBAG(IGARB6),Y1(1))
10646      EQUIVALENCE (GARBAG(IGARB7),Y2(1))
10647      EQUIVALENCE (GARBAG(IGARB8),XGROU1(1))
10648      EQUIVALENCE (GARBAG(IGARB9),XGROU2(1))
10649      EQUIVALENCE (GARBAG(IGAR10),TEMP4(1))
10650      EQUIVALENCE (GARBAG(JGAR11),TEMP5(1))
10651C
10652C-----COMMON VARIABLES (GENERAL)--------------------------------------
10653C
10654      INCLUDE 'DPCOHK.INC'
10655      INCLUDE 'DPCOSU.INC'
10656      INCLUDE 'DPCOST.INC'
10657      INCLUDE 'DPCODA.INC'
10658      INCLUDE 'DPCOP2.INC'
10659C
10660C-----START POINT-----------------------------------------------------
10661C
10662      ISUBN1='DPMA'
10663      ISUBN2='HA  '
10664      IFOUND='YES'
10665      IERROR='NO'
10666      ICASE='RAW '
10667      ICASEQ='UNKN'
10668C
10669      MAXCP1=MAXCOL+1
10670      MAXCP2=MAXCOL+2
10671      MAXCP3=MAXCOL+3
10672      MAXCP4=MAXCOL+4
10673      MAXCP5=MAXCOL+5
10674      MAXCP6=MAXCOL+6
10675C
10676      MINN2=2
10677C
10678C
10679C               *********************************************
10680C               **  TREAT THE MANTEL-HAENSZEL TEST CASE    **
10681C               *********************************************
10682C
10683      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MAHA')THEN
10684        WRITE(ICOUT,999)
10685  999   FORMAT(1X)
10686        CALL DPWRST('XXX','BUG ')
10687        WRITE(ICOUT,51)
10688   51   FORMAT('***** AT THE BEGINNING OF DPMAHA--')
10689        CALL DPWRST('XXX','BUG ')
10690        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ
10691   52   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',2(A4,2X),A4)
10692        CALL DPWRST('XXX','BUG ')
10693        WRITE(ICOUT,56)MAXNXT,NUMARG
10694   56   FORMAT('MAXNXT,NUMARG = ',2I8)
10695        CALL DPWRST('XXX','BUG ')
10696        DO59I=1,NUMARG
10697          WRITE(ICOUT,57)I,IHARG(I),IHARG2(I),ARG(I)
10698   57     FORMAT('I,IHARG(I),IHARG2(I),ARG(I) = ',I5,A4,A4,G15.7)
10699   59   CONTINUE
10700      ENDIF
10701C
10702C               *********************************
10703C               **  STEP 4--                   **
10704C               **  EXTRACT THE VARIABLE LIST  **
10705C               *********************************
10706C
10707      ISTEPN='4'
10708      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MAHA')
10709     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10710C
10711      INAME='MANTEL-HAENSZEL TEST'
10712      MINNA=2
10713      MAXNA=100
10714      MINN2=2
10715      IFLAGE=19
10716      IFLAGM=0
10717      IFLAGP=0
10718      JMIN=1
10719      JMAX=NUMARG
10720      MINNVA=2
10721      MAXNVA=4
10722C
10723      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
10724     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
10725     1            JMIN,JMAX,
10726     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
10727     1            IVARN1,IVARN2,IVARTY,PVAR,
10728     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
10729     1            MINNVA,MAXNVA,
10730     1            IFLAGM,IFLAGP,
10731     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
10732      IF(IERROR.EQ.'YES')GOTO9000
10733C
10734      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MAHA')THEN
10735        WRITE(ICOUT,999)
10736        CALL DPWRST('XXX','BUG ')
10737        WRITE(ICOUT,281)
10738  281   FORMAT('***** AFTER CALL DPPARS--')
10739        CALL DPWRST('XXX','BUG ')
10740        WRITE(ICOUT,282)NQ,NUMVAR
10741  282   FORMAT('NQ,NUMVAR = ',2I8)
10742        CALL DPWRST('XXX','BUG ')
10743        IF(NUMVAR.GT.0)THEN
10744          DO285I=1,NUMVAR
10745            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
10746     1                      ICOLR(I),PVAR(I)
10747  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
10748     1             'ICOLR(I),PVAR(I) = ',I8,2X,A4,A4,2X,3I8,G15.7)
10749            CALL DPWRST('XXX','BUG ')
10750  285     CONTINUE
10751        ENDIF
10752      ENDIF
10753C
10754C     NOTE: THE NUMBER OF VARIABLES DETERMINES HOW THE
10755C           ARGUMENTS ARE DETERMINED:
10756C
10757C           NUMVAR = 2: BOTH VARIABLES ARE RESPONSE VARIABLES
10758C                       (Y1 AND Y2)
10759C           NUMVAR = 3: VARIABLES 1 AND 2 ARE THE RESPONSE
10760C                       VARIABLES (Y1 AND Y2) AND VARIABLE 3
10761C                       IS THE GROUP ID VARIABLE (XGROU1).
10762C           NUMVAR = 4: VARIABLE 1 = FIRST RESPONSE VARIABLE
10763C                       VARIABLE 2 = FIRST GROUP ID VARIABLE
10764C                       VARIABLE 3 = SECOND RESPONSE VARIABLE
10765C                       VARIABLE 2 = SECOND GROUP ID VARIABLE
10766C
10767      IF(NUMVAR.EQ.2)THEN
10768        ICASE='VARI'
10769        ICOL=1
10770        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
10771     1              INAME,IVARN1,IVARN2,IVARTY,
10772     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
10773     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
10774     1              MAXCP4,MAXCP5,MAXCP6,
10775     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
10776     1              Y1,Y2,TEMP1,NLOCAL,NLOCA2,NLOCA3,ICASE,
10777     1              IBUGA3,ISUBRO,IFOUND,IERROR)
10778        IF(IERROR.EQ.'YES')GOTO9000
10779        NS1=NLOCAL
10780        NS2=0
10781      ELSEIF(NUMVAR.EQ.3)THEN
10782        ICASE='VARI'
10783        ICOL=1
10784        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
10785     1              INAME,IVARN1,IVARN2,IVARTY,
10786     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
10787     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
10788     1              MAXCP4,MAXCP5,MAXCP6,
10789     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
10790     1              Y1,Y2,XGROU1,NLOCAL,NLOCA2,NLOCA3,ICASE,
10791     1              IBUGA3,ISUBRO,IFOUND,IERROR)
10792        IF(IERROR.EQ.'YES')GOTO9000
10793        NS1=NLOCAL
10794        NS2=0
10795      ELSEIF(NUMVAR.EQ.4)THEN
10796        ICOL=1
10797        CALL DPPAR7(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
10798     1              INAME,IVARN1,IVARN2,IVARTY,
10799     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
10800     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
10801     1              MAXCP4,MAXCP5,MAXCP6,
10802     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
10803     1              Y1,XGROU1,Y2,XGROU2,NLOCAL,NLOCA2,NLOCA3,NLOCA4,
10804     1              IBUGA3,ISUBRO,IFOUND,IERROR)
10805        IF(IERROR.EQ.'YES')GOTO9000
10806        NS1=NLOCAL
10807        NS2=NLOCA3
10808      ENDIF
10809C
10810C               *****************************************
10811C               **  STEP 61--                         **
10812C               **  COMPUTE THE MANTEL-HAENSZEL TEST  **
10813C               ****************************************
10814C
10815      ISTEPN='61'
10816      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MAHA')
10817     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10818C
10819      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MAHA')THEN
10820        WRITE(ICOUT,999)
10821        CALL DPWRST('XXX','BUG ')
10822        WRITE(ICOUT,6111)
10823 6111   FORMAT('***** FROM DPMAHA--READY TO COMPUTE TEST')
10824        CALL DPWRST('XXX','BUG ')
10825        WRITE(ICOUT,6112)NS1
10826 6112   FORMAT('NS1 = ',G15.7)
10827        CALL DPWRST('XXX','BUG ')
10828        DO6120I=1,MIN(100,NS1)
10829          WRITE(ICOUT,6122)I,Y1(I),Y2(I),XGROU1(I),XGROU2(I)
10830 6122     FORMAT('I,Y1(I),Y2(I),XGROU1(I),XGROU2(I) = ',I8,4G15.7)
10831          CALL DPWRST('XXX','BUG ')
10832 6120   CONTINUE
10833      ENDIF
10834C
10835      CALL DPMAH2(Y1,XGROU1,NS1,Y2,XGROU2,NS2,NUMVAR,
10836     1            XIDTEM,XIDTE2,
10837     1            TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
10838     1            ICASE,ICASAN,
10839     1            ICAPSW,ICAPTY,IFORSW,
10840     1            STATVA,CDF,
10841     1            ISUBRO,IBUGA3,IERROR)
10842C
10843C               ***************************************
10844C               **  STEP 62--                        **
10845C               **  UPDATE INTERNAL DATAPLOT TABLES  **
10846C               ***************************************
10847C
10848      ISTEPN='62'
10849      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MAHA')
10850     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
10851C
10852      ISUBN0='MAHA'
10853C
10854      IH='STAT'
10855      IH2='VAL '
10856      VALUE0=STATVA
10857      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
10858     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
10859     1IANS,IWIDTH,IBUGA3,IERROR)
10860C
10861      IH='STAT'
10862      IH2='CDF '
10863      VALUE0=CDF
10864      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
10865     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
10866     1IANS,IWIDTH,IBUGA3,IERROR)
10867C
10868C               *****************
10869C               **  STEP 90--  **
10870C               **  EXIT       **
10871C               *****************
10872C
10873 9000 CONTINUE
10874      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MAHA')THEN
10875        WRITE(ICOUT,999)
10876        CALL DPWRST('XXX','BUG ')
10877        WRITE(ICOUT,9011)
10878 9011   FORMAT('***** AT THE END       OF DPMAHA--')
10879        CALL DPWRST('XXX','BUG ')
10880        WRITE(ICOUT,9012)IBUGA2,IBUGA3
10881 9012   FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
10882        CALL DPWRST('XXX','BUG ')
10883        WRITE(ICOUT,9016)IERROR
10884 9016   FORMAT('IERROR = ',A4,2X,A4)
10885        CALL DPWRST('XXX','BUG ')
10886      ENDIF
10887C
10888      RETURN
10889      END
10890      SUBROUTINE DPMAH2(Y1,X1,N1,Y2,X2,N2,NUMVAR,
10891     1                  XIDTEM,XIDTE2,
10892     1                  TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
10893     1                  ICASE,ICASAN,
10894     1                  ICAPSW,ICAPTY,IFORSW,
10895     1                  STATVA,CDF,
10896     1                  ISUBRO,IBUGA3,IERROR)
10897C
10898C     PURPOSE--PERFORM AN MANTEL-HAENSZEL TEST
10899C              THE INPUT CAN EITHER BE RAW DATA OR SUMMARY DATA:
10900C
10901C                  1) RAW DATA - EQUAL SAMPLE SIZES
10902C
10903C                     IN THIS CASE, THERE ARE THREE VARIABLES.
10904C                     THE FIRST TWO OF THESE VARIABLES SHOULD CONTAIN
10905C                     1'S (FOR SUCCESS) OR 0'S (FAILURES).  THE THIRD
10906C                     VARIABLE IS A GROUP-ID VARIABLE.
10907C
10908C                     IN THIS CASE, THE FIRST TASK IS TO
10909C                     CROSS TABULATE THE FIRST TWO VARIABLES
10910C                     INTO THE K TABLES.
10911C
10912C                     THIS CASE CAN HANDLE UNEQUAL SAMPLE SIZES
10913C                     BY SPECIFYING MISSING VALUES (USING THE
10914C                     SET STATISTIC MISSING VALUE COMMAND TO
10915C                     SPECIFY WHAT VALUE IS INTERPRETED AS THE
10916C                     MISSING VALUE).
10917C
10918C                  2) RAW DATA - UNEQUAL SAMPLE SIZES
10919C
10920C                     IN THIS CASE, THERE ARE FOUR VARIABLES.
10921C
10922C                     VARIABLE 1 = RESPONSE VARIABLE FOR SAMPLE 1
10923C                                  (SHOULD CONTAIN 1's TO DENOTE
10924C                                  SUCCESS AND 0's TO DENOTE
10925C                                  FAILURE).
10926C                     VARIABLE 2 = GROUP ID VARIABLE FOR SAMPLE 1.
10927C                     VARIABLE 3 = RESPONSE VARIABLE FOR SAMPLE 2
10928C                                  (SHOULD CONTAIN 1's TO DENOTE
10929C                                  SUCCESS AND 0's TO DENOTE
10930C                                  FAILURE).
10931C                     VARIABLE 4 = GROUP ID VARIABLE FOR SAMPLE 2.
10932C
10933C                     IN THIS CASE, THE FIRST TASK IS TO
10934C                     CROSS TABULATE THE FIRST TWO VARIABLES
10935C                     INTO THE K TABLES.
10936C
10937C                  3) SUMMARY DATA
10938C
10939C                     IN THIS CASE, THERE ARE TWO VARIABLES.
10940C                     THE VARIABLES CONTAIN A SERIES 2X2 TABLES.
10941C                     THAT IS, ROWS 1 AND 2 DEFINE TABLE 1,
10942C                     ROWS 3 AND 4 DEFINE TABLE 2, AND SO ON.
10943C
10944C              ULTIMATELY, WE SHOULD END UP WITH K TABLES WHERE
10945C              THE ITH TABLE LOOKS LIKE:
10946C
10947C                  X(I)         R(I)-X(I)             | R(I)
10948C                  C(I)-X(i)    N(I)-R(I)-C(I)+X(I)   | N(I)-R(I)
10949C                  ==============================================
10950C                  C(I)         N(I)-C(I)             | N(I)
10951C
10952C              THIS ROUTINE IMPLEMENTS THE MANTEL-HAENSZEL TEST
10953C              DOCUMENTED IN SECTION 5 CHAPTER 10 OF THE
10954C              FLEIS, LEVIN, AND PAIK BOOK CITED BELOW.  SEE THIS
10955C              REFERENCE FOR THE DETAILS OF THE METHOD.
10956C
10957C     EXAMPLE--MANTEL-HAENSZEL TEST Y1 Y2
10958C            --MANTEL-HAENSZEL TEST Y1 Y2 GROUPID
10959C            --MANTEL-HAENSZEL TEST Y1 GROUPID1 Y2 GROUPID2
10960C     REFERENCE--FLEISS, LEVIN, AND PAIK (2003), "STATISTICAL
10961C                METHODS FOR RATES AND PROPORTIONS", THIRD
10962C                EDITION, WILEY, PP. 250-253.
10963C     WRITTEN BY--ALAN HECKERT
10964C                 STATISTICAL ENGINEERING DIVISION
10965C                 INFORMATION TECHNOLOGYU LABORATORY
10966C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10967C                 GAITHERSBURG, MD 20899-8980
10968C                 PHONE--301-975-2899
10969C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10970C           OF THE NATIONAL BUREAU OF STANDARDS.
10971C     LANGUAGE--ANSI FORTRAN (1977)
10972C     VERSION NUMBER--2007/5
10973C     ORIGINAL VERSION--MAY       2007.
10974C     UPDATED         --FEBRUARY  2011. USE DPAUFI TO OPEN/CLOSE
10975C                                       AUXILLARY FILES
10976C     UPDATED         --FEBRUARY  2011. USE DPDTA1, DPDT5B TO PRINT
10977C                                       TABLES
10978C
10979C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
10980C
10981      CHARACTER*4 ISUBRO
10982      CHARACTER*4 IBUGA3
10983      CHARACTER*4 IERROR
10984      CHARACTER*4 ICASE
10985      CHARACTER*4 ICASAN
10986      CHARACTER*4 ICAPSW
10987      CHARACTER*4 ICAPTY
10988      CHARACTER*4 IFORSW
10989C
10990      CHARACTER*6 ICONC1
10991      CHARACTER*6 ICONC2
10992      CHARACTER*6 ICONC3
10993      CHARACTER*6 ICONC4
10994      CHARACTER*6 ICONC5
10995      CHARACTER*6 ICONC6
10996C
10997      CHARACTER*4 IWRITE
10998      CHARACTER*4 ISUBN1
10999      CHARACTER*4 ISUBN2
11000      CHARACTER*4 ISTEPN
11001      CHARACTER*4 IOP
11002C
11003C---------------------------------------------------------------------
11004C
11005      DOUBLE PRECISION DSUM1
11006      DOUBLE PRECISION DSUM2
11007      DOUBLE PRECISION DSUM3
11008      DOUBLE PRECISION DSUM4
11009      DOUBLE PRECISION DSUM5
11010      DOUBLE PRECISION DSUM6
11011      DOUBLE PRECISION DSUM7
11012      DOUBLE PRECISION DSUM8
11013      DOUBLE PRECISION DSUM9
11014      DOUBLE PRECISION DTERM1
11015C
11016      DIMENSION Y1(*)
11017      DIMENSION Y2(*)
11018      DIMENSION X1(*)
11019      DIMENSION X2(*)
11020      DIMENSION TEMP1(*)
11021      DIMENSION TEMP2(*)
11022      DIMENSION TEMP3(*)
11023      DIMENSION TEMP4(*)
11024      DIMENSION TEMP5(*)
11025      DIMENSION XIDTEM(*)
11026      DIMENSION XIDTE2(*)
11027C
11028      PARAMETER (NUMALP=6)
11029      DIMENSION SIGVAL(NUMALP)
11030      DIMENSION ALOWCL(NUMALP)
11031      DIMENSION AUPPCL(NUMALP)
11032      DIMENSION ALOWC2(NUMALP)
11033      DIMENSION AUPPC2(NUMALP)
11034C
11035      PARAMETER(NUMCLI=5)
11036      PARAMETER(MAXLIN=4)
11037      PARAMETER (MAXROW=NUMALP)
11038      PARAMETER (MAXRO2=30)
11039      CHARACTER*60 ITITLE
11040      CHARACTER*60 ITITLZ
11041      CHARACTER*60 ITITL9
11042      CHARACTER*60 ITEXT(MAXRO2)
11043      CHARACTER*4  ALIGN(NUMCLI)
11044      CHARACTER*4  VALIGN(NUMCLI)
11045      REAL         AVALUE(MAXRO2)
11046      INTEGER      NCTEXT(MAXRO2)
11047      INTEGER      IDIGIT(MAXRO2)
11048      INTEGER      IDIGI2(MAXRO2,NUMCLI)
11049      INTEGER      NTOT(MAXRO2)
11050      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
11051      CHARACTER*15 IVALUE(MAXRO2,NUMCLI)
11052      CHARACTER*4  ITYPCO(NUMCLI)
11053      INTEGER      NCTIT2(MAXLIN,NUMCLI)
11054      INTEGER      NCVALU(MAXRO2,NUMCLI)
11055      INTEGER      NCOLSP(MAXLIN,NUMCLI)
11056      INTEGER      ROWSEP(MAXRO2)
11057      INTEGER      IWHTML(NUMCLI)
11058      INTEGER      IWRTF(NUMCLI)
11059      REAL         AMAT(MAXRO2,NUMCLI)
11060      LOGICAL IFRST
11061      LOGICAL ILAST
11062      LOGICAL IFLAGS
11063      LOGICAL IFLAGE
11064C
11065C---------------------------------------------------------------------
11066C
11067      INCLUDE 'DPCOST.INC'
11068      INCLUDE 'DPCOP2.INC'
11069C
11070      DATA SIGVAL /0.50, 0.80, 0.90, 0.95, 0.975, 0.99/
11071C
11072C-----START POINT-----------------------------------------------------
11073C
11074      ISUBN1='DPMA'
11075      ISUBN2='H2  '
11076      IERROR='NO'
11077      IWRITE='NO'
11078C
11079      ICONC1='ACCEPT'
11080      ICONC2='ACCEPT'
11081      ICONC3='ACCEPT'
11082      ICONC4='ACCEPT'
11083      ICONC5='ACCEPT'
11084      ICONC6='ACCEPT'
11085C
11086      NSUMM=0
11087C
11088      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
11089        WRITE(ICOUT,999)
11090  999   FORMAT(1X)
11091        CALL DPWRST('XXX','WRIT')
11092        WRITE(ICOUT,51)
11093   51   FORMAT('**** AT THE BEGINNING OF DPMAH2--')
11094        CALL DPWRST('XXX','WRIT')
11095        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASE
11096   52   FORMAT('IBUGA3,ISUBRO,ICASE = ',2(A4,2X),A4)
11097        CALL DPWRST('XXX','WRIT')
11098        WRITE(ICOUT,55)N1,N2,NUMVAR,PSTAMV
11099   55   FORMAT('N1,N2,NUMVAR = ',3I8,G15.7)
11100        CALL DPWRST('XXX','WRIT')
11101        DO56I=1,N1
11102          WRITE(ICOUT,57)I,Y1(I),Y2(I),X1(I),X2(I)
11103   57     FORMAT('I,Y1(I),Y2(I),X1(I),X2(I) = ',I8,4G15.7)
11104          CALL DPWRST('XXX','WRIT')
11105   56   CONTINUE
11106      ENDIF
11107C
11108C               ********************************************
11109C               **  STEP 0--                              **
11110C               **  IF ONLY TWO VARIABLES GIVEN, CREATE   **
11111C               **  THE GROUP-ID VARIABLE.  FOR THREE     **
11112C               **  VARIABLES, CHECK WHETHER WE HAVE RAW  **
11113C               **  DATA OR SUMMARY DATA.                 **
11114C               ********************************************
11115C
11116      ISTEPN='0'
11117      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAH2')
11118     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11119C
11120      IF(NUMVAR.EQ.2)THEN
11121        ICASE='SUMM'
11122        NGROUP=0
11123        DO100I=1,N1
11124          ITEMP=MOD(I,2)
11125          IF(ITEMP.EQ.1)THEN
11126            NGROUP=NGROUP+1
11127          ENDIF
11128          X1(I)=REAL(NGROUP)
11129          X2(I)=REAL(NGROUP)
11130  100   CONTINUE
11131C
11132        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAH2')THEN
11133          WRITE(ICOUT,151)NGROUP
11134  151     FORMAT('TWO-VARIABLE CASE: NGROUPS = ',I8)
11135          CALL DPWRST('XXX','WRIT')
11136        ENDIF
11137C
11138      ELSEIF(NUMVAR.EQ.3)THEN
11139        ICASE='SUMM'
11140        CALL DISTIN(X1,N1,IWRITE,XIDTEM,NGROUP,IBUGA3,IERROR)
11141        CALL SORT(XIDTEM,NGROUP,XIDTEM)
11142        DO200K=1,NGROUP
11143          HOLD=XIDTEM(K)
11144          L=0
11145          DO210I=1,N1
11146            IF(X1(I).EQ.HOLD)THEN
11147              L=L+1
11148            ENDIF
11149  210     CONTINUE
11150          IF(L.NE.2)THEN
11151            ICASE='RAW'
11152            GOTO299
11153          ENDIF
11154  200   CONTINUE
11155C
11156      ELSEIF(NUMVAR.EQ.4)THEN
11157        ICASE='SUMM'
11158        CALL DISTIN(X1,N1,IWRITE,XIDTEM,NGROU1,IBUGA3,IERROR)
11159        CALL SORT(XIDTEM,NGROU2,XIDTEM)
11160        CALL DISTIN(X2,N2,IWRITE,XIDTE2,NGROU2,IBUGA3,IERROR)
11161        CALL SORT(XIDTE2,NGROU2,XIDTE2)
11162C
11163        IF(NGROU1.NE.NGROU2)THEN
11164          WRITE(ICOUT,999)
11165          CALL DPWRST('XXX','WRIT')
11166          WRITE(ICOUT,1101)
11167          CALL DPWRST('XXX','WRIT')
11168          WRITE(ICOUT,231)
11169  231     FORMAT('     THE NUMBER OF GROUPS IS DIFFERENT FOR ',
11170     1           'SAMPLE ONE AND SAMPLE TWO.')
11171          CALL DPWRST('XXX','WRIT')
11172          WRITE(ICOUT,233)NGROU1
11173  233     FORMAT('     SAMPLE ONE HAS ',I8,' GROUPS.')
11174          CALL DPWRST('XXX','WRIT')
11175          WRITE(ICOUT,235)NGROU2
11176  235     FORMAT('     SAMPLE TWO HAS ',I8,' GROUPS.')
11177          CALL DPWRST('XXX','WRIT')
11178          IERROR='YES'
11179          GOTO9000
11180        ENDIF
11181C
11182        EPS=0.01
11183        DO240K=1,NGROU1
11184          DIFF=ABS(XIDTEM(K) - XIDTE2(K))
11185          IF(DIFF.GT.EPS)THEN
11186             WRITE(ICOUT,999)
11187             CALL DPWRST('XXX','WRIT')
11188             WRITE(ICOUT,1101)
11189             CALL DPWRST('XXX','WRIT')
11190             WRITE(ICOUT,241)
11191  241        FORMAT('     THE GROUP IDs DIFFER FOR THE TWO ',
11192     1              'SAMPLES.')
11193             CALL DPWRST('XXX','WRIT')
11194             IERROR='YES'
11195             GOTO9000
11196          ENDIF
11197  240   CONTINUE
11198C
11199C       CHECK BOTH GROUP-ID VARIABLES.  CURRENTLY, BOTH SAMPLES
11200C       SHOULD BE THE SAME (I.E., EITHER BOTH SUMMARY DATA OR
11201C       BOTH RAW DATA, BUT NOT ONE RAW AND THE OTHER SUMMARY).
11202C
11203        DO250K=1,NGROU1
11204          HOLD=XIDTEM(K)
11205          L=0
11206          DO260I=1,N1
11207            IF(X1(I).EQ.HOLD)THEN
11208              L=L+1
11209            ENDIF
11210  260     CONTINUE
11211          IF(L.NE.2)THEN
11212            ICASE='RAW'
11213            GOTO299
11214          ENDIF
11215  250   CONTINUE
11216C
11217        DO270K=1,NGROU2
11218          HOLD=XIDTE2(K)
11219          L=0
11220          DO280I=1,N1
11221            IF(X2(I).EQ.HOLD)THEN
11222              L=L+1
11223            ENDIF
11224  280     CONTINUE
11225          IF(L.NE.2)THEN
11226            ICASE='RAW'
11227            GOTO299
11228          ENDIF
11229  270   CONTINUE
11230C
11231      ENDIF
11232C
11233  299 CONTINUE
11234C
11235C               ********************************************
11236C               **  STEP 1--                              **
11237C               **  FOR RAW DATA CASE, CROSS TABULATE     **
11238C               **  THE DATA.  PUT SUMMARY DATA IN TEMP1  **
11239C               **  AND TEMP2.                            **
11240C               ********************************************
11241C
11242C
11243C
11244C               ********************************************
11245C               **  STEP 11--                             **
11246C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
11247C               ********************************************
11248C
11249      ISTEPN='11'
11250      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAH2')THEN
11251        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11252        WRITE(ICOUT,251)ICASAN,ICASE
11253  251   FORMAT('THREE-VARIABLE CASE: ICASAN, ICASE = ',A4,2X,A4)
11254        CALL DPWRST('XXX','WRIT')
11255      ENDIF
11256C
11257      IF(N1.LT.2)THEN
11258        WRITE(ICOUT,999)
11259        CALL DPWRST('XXX','WRIT')
11260        WRITE(ICOUT,1101)
11261 1101   FORMAT('***** ERROR IN MANTEL-HAENSZEL TEST--')
11262        CALL DPWRST('XXX','WRIT')
11263        WRITE(ICOUT,1103)
11264 1103   FORMAT('      THE NUMBER OF OBSERVATIONS  IS < 2.')
11265        CALL DPWRST('XXX','WRIT')
11266        WRITE(ICOUT,1105)N1
11267 1105   FORMAT('SAMPLE SIZE = ',I8)
11268        CALL DPWRST('XXX','WRIT')
11269        IERROR='YES'
11270        GOTO9000
11271      ENDIF
11272C
11273      IF(ICASE.EQ.'SUMM')THEN
11274        DO300I=1,N1
11275          TEMP1(I)=Y1(I)
11276          TEMP2(I)=Y2(I)
11277  300   CONTINUE
11278        NSUMM=N1
11279        NGROUP=N1/2
11280C
11281C       CASE WHERE SAMPLES HAVE EQUAL SIZES FOR EACH GROUP
11282C
11283      ELSEIF(NUMVAR.EQ.3)THEN
11284C
11285        EPS=0.01
11286        ICNT2=0
11287        DO400K=1,NGROUP
11288          HOLD=XIDTEM(K)
11289          ICNT=0
11290          DO410I=1,N1
11291            DIFF=ABS(HOLD-X1(I))
11292            IF(DIFF.LE.EPS)THEN
11293              ICNT=ICNT+1
11294              TEMP3(ICNT)=Y1(I)
11295              TEMP4(ICNT)=Y2(I)
11296            ENDIF
11297  410     CONTINUE
11298C
11299          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
11300            WRITE(ICOUT,401)K,ICNT,HOLD
11301  401       FORMAT('K,ICNT,HOLD = ',2I8,G15.7)
11302            CALL DPWRST('XXX','WRIT')
11303          ENDIF
11304C
11305          CALL ODDDIS(TEMP3,ICNT,PSTAMV,IWRITE,TEMP5,N11,N21,NOUT,
11306     1                IBUGA3,IERROR)
11307          IF(IERROR.EQ.'YES')GOTO9000
11308          CALL ODDDIS(TEMP4,ICNT,PSTAMV,IWRITE,TEMP5,N12,N22,NOUT,
11309     1                IBUGA3,IERROR)
11310          IF(IERROR.EQ.'YES')GOTO9000
11311C
11312          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
11313            WRITE(ICOUT,411)N11,N21,N12,N22
11314  411       FORMAT('N11,N21,N12,N22 = ',4I8)
11315            CALL DPWRST('XXX','WRIT')
11316          ENDIF
11317C
11318          ICNT2=ICNT2+1
11319          TEMP1(ICNT2)=REAL(N11)
11320          TEMP2(ICNT2)=REAL(N12)
11321C
11322          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
11323            WRITE(ICOUT,413)ICNT2,TEMP1(ICNT2),TEMP2(ICNT2)
11324  413       FORMAT('ICNT2,TEMP1(ICNT2),TEMP2(ICNT2) = ',I8,2G15.7)
11325            CALL DPWRST('XXX','WRIT')
11326          ENDIF
11327C
11328          ICNT2=ICNT2+1
11329          TEMP1(ICNT2)=REAL(N21)
11330          TEMP2(ICNT2)=REAL(N22)
11331C
11332          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
11333            WRITE(ICOUT,413)ICNT2,TEMP1(ICNT2),TEMP2(ICNT2)
11334            CALL DPWRST('XXX','WRIT')
11335          ENDIF
11336C
11337  400   CONTINUE
11338        NSUMM=ICNT2
11339C
11340      ELSEIF(NUMVAR.EQ.4)THEN
11341C
11342        EPS=0.01
11343        ICNT2=0
11344        DO500K=1,NGROU1
11345          HOLD=XIDTEM(K)
11346          ICNT=0
11347          DO510I=1,N1
11348            DIFF=ABS(HOLD-X1(I))
11349            IF(DIFF.LE.EPS)THEN
11350              ICNT=ICNT+1
11351              TEMP3(ICNT)=Y1(I)
11352            ENDIF
11353  510     CONTINUE
11354C
11355          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
11356            WRITE(ICOUT,501)K,ICNT,HOLD
11357  501       FORMAT('K,ICNT,HOLD = ',2I8,G15.7)
11358            CALL DPWRST('XXX','WRIT')
11359          ENDIF
11360C
11361          CALL ODDDIS(TEMP3,ICNT,PSTAMV,IWRITE,TEMP5,N11,N21,NOUT,
11362     1                IBUGA3,IERROR)
11363          IF(IERROR.EQ.'YES')GOTO9000
11364          ICNT2=ICNT2+1
11365          TEMP1(ICNT2)=REAL(N11)
11366          ICNT2=ICNT2+1
11367          TEMP1(ICNT2)=REAL(N21)
11368  500   CONTINUE
11369C
11370        ICNT2=0
11371        DO550K=1,NGROU2
11372          HOLD=XIDTE2(K)
11373          ICNT=0
11374          DO560I=1,N2
11375            DIFF=ABS(HOLD-X2(I))
11376            IF(DIFF.LE.EPS)THEN
11377              ICNT=ICNT+1
11378              TEMP4(ICNT)=Y2(I)
11379            ENDIF
11380  560     CONTINUE
11381C
11382          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
11383            WRITE(ICOUT,561)K,ICNT,HOLD
11384  561       FORMAT('K,ICNT,HOLD = ',2I8,G15.7)
11385            CALL DPWRST('XXX','WRIT')
11386          ENDIF
11387C
11388          CALL ODDDIS(TEMP4,ICNT,PSTAMV,IWRITE,TEMP5,N12,N22,NOUT,
11389     1                IBUGA3,IERROR)
11390          IF(IERROR.EQ.'YES')GOTO9000
11391          ICNT2=ICNT2+1
11392          TEMP2(ICNT2)=REAL(N12)
11393          ICNT2=ICNT2+1
11394          TEMP2(ICNT2)=REAL(N22)
11395  550   CONTINUE
11396C
11397        NSUMM=ICNT2
11398        NGROUP=NGROU1
11399C
11400      ENDIF
11401C
11402C               ********************************************
11403C               **  STEP 14--                             **
11404C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
11405C               **  ALL TABLE ENTRIES SHOULD BE           **
11406C               **  NON-NEGATIVE INTEGERS.  NEGATIVE      **
11407C               **  VALUES WILL BE FLAGGED AS ERRORS      **
11408C               **  WHILE NON-INTEGER VALUES WILL BE      **
11409C               **  ROUNDED TO NEAREST INTEGER.           **
11410C               ********************************************
11411C
11412      ISTEPN='14'
11413      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAH2')
11414     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11415C
11416      IERROR='NO'
11417C
11418      NTEMP=MOD(NSUMM,2)
11419      IF(NTEMP.EQ.1)THEN
11420        WRITE(ICOUT,999)
11421        CALL DPWRST('XXX','WRIT')
11422        WRITE(ICOUT,1101)
11423        CALL DPWRST('XXX','WRIT')
11424        WRITE(ICOUT,1411)
11425 1411   FORMAT('      FOR THE SUMMARY DATA, THE NUMBER OF ROWS')
11426        CALL DPWRST('XXX','WRIT')
11427        WRITE(ICOUT,1413)
11428 1413   FORMAT('      SHOULD BE EVEN;  SUCH WAS NOT THE CASE HERE.')
11429        CALL DPWRST('XXX','WRIT')
11430        WRITE(ICOUT,1415)NSUMM
11431 1415   FORMAT('      THE NUMBER OF ROWS = ',I8)
11432        CALL DPWRST('XXX','WRIT')
11433        IERROR='YES'
11434        GOTO9000
11435      ENDIF
11436C
11437      DO1420I=1,NSUMM
11438C
11439        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
11440          WRITE(ICOUT,1401)I,TEMP1(I),TEMP2(I)
11441 1401     FORMAT('I,TEMP1(I),TEMP2(I) = ',I8,2G15.7)
11442          CALL DPWRST('XXX','WRIT')
11443        ENDIF
11444C
11445        ITEMP=INT(TEMP1(I)+0.5)
11446        IF(ITEMP.LT.0)THEN
11447          WRITE(ICOUT,999)
11448          CALL DPWRST('XXX','WRIT')
11449          WRITE(ICOUT,1101)
11450          CALL DPWRST('XXX','WRIT')
11451          WRITE(ICOUT,1421)
11452 1421     FORMAT('      FOR THE SUMMARY DATA, THE DATA VALUES ',
11453     1          'DENOTE COUNTS.')
11454          CALL DPWRST('XXX','WRIT')
11455          WRITE(ICOUT,1423)I
11456 1423     FORMAT('      A NEGATIVE COUNT WAS ENCOUNTERED FOR ',
11457     1           'RESPONSE VARIABLE ONE FOR ROW ',I8)
11458          CALL DPWRST('XXX','WRIT')
11459          IERROR='YES'
11460          GOTO9000
11461        ENDIF
11462        TEMP1(I)=REAL(ITEMP)
11463C
11464        ITEMP=INT(TEMP2(I)+0.5)
11465        IF(ITEMP.LT.0)THEN
11466          WRITE(ICOUT,999)
11467          CALL DPWRST('XXX','WRIT')
11468          WRITE(ICOUT,1101)
11469          CALL DPWRST('XXX','WRIT')
11470          WRITE(ICOUT,1431)
11471 1431     FORMAT('      FOR THE SUMMARY DATA CASE, THE DATA VALUES ',
11472     1          'DENOTE COUNTS.')
11473          CALL DPWRST('XXX','WRIT')
11474          WRITE(ICOUT,1433)I
11475 1433     FORMAT('      A NEGATIVE COUNT WAS ENCOUNTERED FOR ',
11476     1           'RESPONSE VARIABLE TWO FOR ROW ',I8)
11477          CALL DPWRST('XXX','WRIT')
11478          IERROR='YES'
11479          GOTO9000
11480        ENDIF
11481        TEMP2(I)=REAL(ITEMP)
11482 1420 CONTINUE
11483C
11484C               ********************************************
11485C               **  STEP 20--                             **
11486C               **  GENERATE THE LOG ODDS RATIO TABLE     **
11487C               **  AND COMPUTE THE CHI-SQUARE ANALYSIS   **
11488C               **  OF THE LOG ODDS RATIO.                **
11489C               ********************************************
11490C
11491      ISTEPN='20'
11492      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAH2')
11493     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11494C
11495C     FLEISS AND HIS CO-AUTHORS DEFINE THE TABLE:
11496C
11497C                 |  SAMPLE 1     SAMPLE 2      |
11498C        =====================================================
11499C        PRESENT  |  X(i)         m(i) - X(i)   | m(i)
11500C        ABSENT   |  N(i1)-X(i)   X(i) - l(i)   | N(i.) - m(i)
11501C        =================================================
11502C                 |  N(i1)        N(i2)         | N(i.)
11503C
11504C     IN OUR CODING:
11505C
11506C         N11 = X(i)
11507C         N21 = N(i1)
11508C         N12 = m(i) - X(i)
11509C         N22 = X(i) - L(i)
11510C
11511C     FLEISS THEN DENOTES
11512C
11513C         R(i) = X(i)*(X(i) - l(i))/N(i.)
11514C              = N11*N22/NTOT
11515C         S(i) = (m(i) - X(i))*(N(i1) - X(i))/N(i.)
11516C              = N12*N21/NTOT
11517C         P(i) = (X(i) + X(i) - l(i))/N(i.)
11518C              = (N11 + N22)/NTOT
11519C         Q(i) = (m(i) - X(i) + N(i1) - X(i))/N(i.)
11520C              = 1 - P(i)
11521C              = (N12 +  N21)/NTOT
11522C
11523C     R, S, P, AND Q ARE THE SUMS OVER ALL GROUPS FOR EACH
11524C     OF THESE.
11525C
11526C     THEN THE MANTEL-HAENSZEL ESTIMATE IS:
11527C
11528C        COMMON ODDS RATIO = OMEGAHAT(MH)
11529C                          = R/S
11530C
11531C     AND THE VARIANCE OF THE LOG OF THE COMMON ODDS RATIO IS
11532C
11533C         VAR(LN(OMEGAHAT(MH))) = 0.5*{SUM[P(i)*R(i)]/R**2 +
11534C                                 SUM[P(i)*S(i) + Q(i)*R(i)]/R*S +
11535C                                 SUM[Q(i)*S(i)]/S**2}
11536C
11537C         WHERE ALL SUMMATIONS ARE OVER THE GROUPS.
11538C
11539C     THE MANTEL-HAENSZEL CHI-SQUARE TEST STATISTIC IS THEN
11540C
11541C         {|SUM[i=1 to NGROUP][(N(i1)*N(i2)/N(i.))*
11542C                              (P(i1)-P(i2)| - 0.5}**2/
11543C         SUM[i=1 to NGROUP][N(i1)*N(i2)*pbar(i)*qbar(i)/(N(i.)]
11544C
11545C     WHERE
11546C
11547C         P(i1) = N11/Ni1
11548C         P(i2) = N12/Ni2
11549C
11550C         pbar(i) = (N(i1)*P(i1) + N(i2)*P(i2))/NTOT
11551C         qbar(i) = 1 - pbar(i)
11552C
11553      IOP='OPEN'
11554      IFLAG1=1
11555      IFLAG2=1
11556      IFLAG3=0
11557      IFLAG4=0
11558      IFLAG5=0
11559      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
11560     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
11561     1            IBUGA3,ISUBRO,IERROR)
11562      IF(IERROR.EQ.'YES')GOTO9000
11563C
11564      NTEMP=2
11565      MAXGRP=10000
11566      DSUM1=0.0D0
11567      DSUM2=0.0D0
11568      DSUM3=0.0D0
11569      DSUM4=0.0D0
11570      DSUM5=0.0D0
11571      DSUM6=0.0D0
11572      DSUM7=0.0D0
11573      DSUM8=0.0D0
11574      DSUM9=0.0D0
11575C
11576      DO2010K=1,NGROUP
11577        ISTRT=(K-1)*2+1
11578C
11579        AN11=TEMP1(ISTRT)
11580        AN21=TEMP1(ISTRT+1)
11581        AN12=TEMP2(ISTRT)
11582        AN22=TEMP2(ISTRT+1)
11583        ANTOT=AN11 + AN21 + AN12 + AN22
11584        RI=AN11*AN22/ANTOT
11585        SI=AN12*AN21/ANTOT
11586        PI=(AN11 + AN22)/ANTOT
11587        QI=1.0 - PI
11588        AN1=AN11+AN21
11589        AN2=AN12+AN22
11590        PI1=AN11/AN1
11591        PI2=AN12/AN2
11592        PIBAR=(AN1*PI1 + AN2*PI2)/ANTOT
11593C
11594        DSUM1=DSUM1 + DBLE(RI)
11595        DSUM2=DSUM2 + DBLE(SI)
11596        DSUM3=DSUM3 + DBLE(PI)
11597        DSUM4=DSUM4 + DBLE(QI)
11598        DSUM5=DSUM5 + DBLE(PI*RI)
11599        DSUM6=DSUM6 + DBLE(PI*SI + QI*RI)
11600        DSUM7=DSUM7 + DBLE(QI*SI)
11601        DSUM8=DSUM8 + DBLE(PI1-PI2)*DBLE(AN1)*DBLE(AN2)/DBLE(ANTOT)
11602        DSUM9=DSUM9 + DBLE(PIBAR)*(1.0D0-DBLE(PIBAR))*DBLE(AN1)*
11603     1                DBLE(AN2)/(DBLE(ANTOT)-1.0D0)
11604C
11605        CALL ODDRAT(TEMP1(ISTRT),NTEMP,TEMP2(ISTRT),NTEMP,PSTAMV,
11606     1              IWRITE,TEMP5,STAT,
11607     1              IBUGA3,IERROR)
11608        TEMP3(K)=STAT
11609        CALL LOGIT(TEMP1(ISTRT),NTEMP,TEMP2(ISTRT),NTEMP,PSTAMV,
11610     1              IWRITE,TEMP5,STAT,
11611     1              IBUGA3,IERROR)
11612        TEMP3(MAXGRP+K)=STAT
11613        CALL LOGISE(TEMP1(ISTRT),NTEMP,TEMP2(ISTRT),NTEMP,PSTAMV,
11614     1              IWRITE,TEMP5,STAT,
11615     1              IBUGA3,IERROR)
11616        TEMP3(2*MAXGRP+K)=STAT
11617        TEMP3(3*MAXGRP+K)=RI
11618        TEMP3(4*MAXGRP+K)=SI
11619        TEMP3(5*MAXGRP+K)=PI
11620        TEMP3(6*MAXGRP+K)=QI
11621C
11622        WRITE(IOUNI2,2004)RI,SI,PI,QI,PIBAR
11623 2004   FORMAT(5E15.7)
11624C
11625 2010 CONTINUE
11626      R=REAL(DSUM1)
11627      S=REAL(DSUM2)
11628      P=REAL(DSUM3)
11629      Q=REAL(DSUM4)
11630C
11631      ODDRCO=REAL(DSUM1/DSUM2)
11632      DTERM1=(DSUM5/DSUM1**2) + (DSUM6/(DSUM1*DSUM2)) +
11633     1       (DSUM7/DSUM2**2)
11634      DTERM1=DTERM1/2.0D0
11635      ODDRSE=SQRT(DTERM1)
11636C
11637      DTERM1=(DABS(DSUM8) - 0.5D0)**2/DSUM9
11638      STATVA=REAL(DTERM1)
11639C
11640      IOP='CLOS'
11641      IFLAG1=0
11642      IFLAG2=1
11643      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
11644     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
11645     1            IBUGA3,ISUBRO,IERROR)
11646      IF(IERROR.EQ.'YES')GOTO9000
11647C
11648C     PRINT SUMMARY OF LOG(ODDS RATIO) TABLE
11649C
11650      IF(IPRINT.EQ.'OFF')GOTO9000
11651C
11652      NUMDIG=7
11653      IF(IFORSW.EQ.'1')NUMDIG=1
11654      IF(IFORSW.EQ.'2')NUMDIG=2
11655      IF(IFORSW.EQ.'3')NUMDIG=3
11656      IF(IFORSW.EQ.'4')NUMDIG=4
11657      IF(IFORSW.EQ.'5')NUMDIG=5
11658      IF(IFORSW.EQ.'6')NUMDIG=6
11659      IF(IFORSW.EQ.'7')NUMDIG=7
11660      IF(IFORSW.EQ.'8')NUMDIG=8
11661      IF(IFORSW.EQ.'9')NUMDIG=9
11662      IF(IFORSW.EQ.'0')NUMDIG=0
11663      IF(IFORSW.EQ.'E')NUMDIG=-2
11664      IF(IFORSW.EQ.'-2')NUMDIG=-2
11665      IF(IFORSW.EQ.'-3')NUMDIG=-3
11666      IF(IFORSW.EQ.'-4')NUMDIG=-4
11667      IF(IFORSW.EQ.'-5')NUMDIG=-5
11668      IF(IFORSW.EQ.'-6')NUMDIG=-6
11669      IF(IFORSW.EQ.'-7')NUMDIG=-7
11670      IF(IFORSW.EQ.'-8')NUMDIG=-8
11671      IF(IFORSW.EQ.'-9')NUMDIG=-9
11672C
11673      ITITLE(1:26)='Summary of Log(Odds Ratio)'
11674      NCTITL=26
11675      ITITL9=' '
11676      NCTIT9=0
11677C
11678      ITITL2(1,1)=' '
11679      NCTIT2(1,1)=0
11680      ITITL2(2,1)=' '
11681      NCTIT2(2,1)=0
11682      ITITL2(3,1)='Group'
11683      NCTIT2(3,1)=5
11684C
11685      ITITL2(1,2)=' | '
11686      NCTIT2(1,2)=3
11687      ITITL2(2,2)=' | '
11688      NCTIT2(2,2)=3
11689      ITITL2(3,2)=' | '
11690      NCTIT2(3,2)=3
11691C
11692      ITITL2(1,3)=' '
11693      NCTIT2(1,3)=0
11694      ITITL2(2,3)='Odds Ratio'
11695      NCTIT2(2,3)=10
11696      ITITL2(3,3)='O(i)'
11697      NCTIT2(3,3)=4
11698C
11699      ITITL2(1,4)='Log of'
11700      NCTIT2(1,4)=6
11701      ITITL2(2,4)='Odds Ratio'
11702      NCTIT2(2,4)=10
11703      ITITL2(3,4)='L(i)'
11704      NCTIT2(3,4)=4
11705C
11706      ITITL2(1,5)='Standard'
11707      NCTIT2(1,5)=8
11708      ITITL2(2,5)='Error'
11709      NCTIT2(2,5)=5
11710      ITITL2(3,5)='SE(L(i))'
11711      NCTIT2(3,5)=8
11712C
11713      NMAX=0
11714      NUMCOL=5
11715      DO4010I=1,NUMCOL
11716        VALIGN(I)='b'
11717        ALIGN(I)='r'
11718        ITYPCO(I)='NUME'
11719        NTOT(I)=15
11720        NCOLSP(1,I)=1
11721        NCOLSP(2,I)=1
11722        NCOLSP(3,I)=1
11723        IF(I.EQ.2)THEN
11724          ITYPCO(I)='ALPH'
11725          NTOT(I)=3
11726        ENDIF
11727        NMAX=NMAX+NTOT(I)
11728 4010 CONTINUE
11729      IWHTML(1)=125
11730      IWHTML(2)=50
11731      IWHTML(3)=150
11732      IWHTML(4)=150
11733      IWHTML(5)=150
11734      IINC=1600
11735      IINC2=200
11736      IINC3=1000
11737      IWRTF(1)=IINC3
11738      IWRTF(2)=IWRTF(1)+IINC2
11739      IWRTF(3)=IWRTF(2)+IINC
11740      IWRTF(4)=IWRTF(3)+IINC
11741      IWRTF(5)=IWRTF(4)+IINC
11742C
11743      DO4081J=1,NGROUP
11744        DO4083I=1,NUMCOL
11745          IVALUE(J,I)=' '
11746          NCVALU(J,I)=0
11747          AMAT(J,I)=0.0
11748          IF(I.EQ.1)THEN
11749            IDIGIT(I)=0
11750          ELSE
11751            IDIGIT(I)=NUMDIG
11752          ENDIF
11753 4083   CONTINUE
11754        IVALUE(J,2)=' | '
11755        NCVALU(J,2)=3
11756        IJUNK=INT(XIDTEM(J)+0.5)
11757        AMAT(J,1)=REAL(IJUNK)
11758        AMAT(J,3)=TEMP3(J)
11759        AMAT(J,4)=TEMP3(MAXGRP+J)
11760        AMAT(J,5)=TEMP3(2*MAXGRP+J)
11761 4081 CONTINUE
11762C
11763      ICNT=NGROUP
11764      NUMLIN=3
11765      IFRST=.TRUE.
11766      ILAST=.TRUE.
11767      IFLAGS=.TRUE.
11768      IFLAGE=.TRUE.
11769      CALL DPDTA5(ITITLE,NCTITL,
11770     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
11771     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
11772     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXRO2,ICNT,
11773     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
11774     1            ICAPSW,ICAPTY,IFRST,ILAST,
11775     1            IFLAGS,IFLAGE,
11776     1            ISUBRO,IBUGA3,IERROR)
11777C
11778      IDFAS=1
11779      CALL CHSCDF(STATVA,IDFAS,CDFASS)
11780      CDF=CDFASS
11781C
11782      ITITLE='Mantel-Haenszel Test'
11783      NCTITL=20
11784      ITITLZ=' '
11785      NCTITZ=0
11786C
11787      ICNT=0
11788      ICNT=ICNT+1
11789      ITEXT(ICNT)=' '
11790      NCTEXT(ICNT)=0
11791      AVALUE(ICNT)=0.0
11792      IDIGIT(ICNT)=-1
11793      ICNT=ICNT+1
11794      ITEXT(ICNT)='Number of Groups:'
11795      NCTEXT(ICNT)=17
11796      AVALUE(ICNT)=REAL(NGROUP)
11797      IDIGIT(ICNT)=0
11798      ICNT=ICNT+1
11799      ITEXT(ICNT)='M-H Estimate of Combined Log(Odds Ratio):'
11800      NCTEXT(ICNT)=41
11801      AVALUE(ICNT)=ODDRCO
11802      IDIGIT(ICNT)=NUMDIG
11803      ICNT=ICNT+1
11804      ITEXT(ICNT)='M-H Standard Error of Combined Log(Odds Ratio):'
11805      NCTEXT(ICNT)=47
11806      AVALUE(ICNT)=ODDRSE
11807      IDIGIT(ICNT)=NUMDIG
11808      ICNT=ICNT+1
11809      ITEXT(ICNT)=' '
11810      NCTEXT(ICNT)=0
11811      AVALUE(ICNT)=0.0
11812      IDIGIT(ICNT)=-1
11813C
11814      ICNT=ICNT+1
11815      ITEXT(ICNT)='Mantel-Haenszel Test Statistic (Association):'
11816      NCTEXT(ICNT)=45
11817      AVALUE(ICNT)=STATVA
11818      IDIGIT(ICNT)=NUMDIG
11819      ICNT=ICNT+1
11820      ITEXT(ICNT)='Chi-Square Degrees of Freedom:'
11821      NCTEXT(ICNT)=30
11822      AVALUE(ICNT)=REAL(IDFAS)
11823      IDIGIT(ICNT)=0
11824      ICNT=ICNT+1
11825      ITEXT(ICNT)='Chi-Square CDF of Test Statistic:'
11826      NCTEXT(ICNT)=33
11827      AVALUE(ICNT)=CDF
11828      IDIGIT(ICNT)=NUMDIG
11829      ICNT=ICNT+1
11830      ITEXT(ICNT)=' '
11831      NCTEXT(ICNT)=0
11832      AVALUE(ICNT)=0.0
11833      IDIGIT(ICNT)=-1
11834C
11835      NUMROW=ICNT
11836      DO4090I=1,NUMROW
11837        NTOT(I)=15
11838 4090 CONTINUE
11839C
11840      IFRST=.TRUE.
11841      ILAST=.TRUE.
11842      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
11843     1            NCTEXT,AVALUE,IDIGIT,
11844     1            NTOT,NUMROW,
11845     1            ICAPSW,ICAPTY,ILAST,IFRST,
11846     1            ISUBRO,IBUGA3,IERROR)
11847C
11848C               ************************************************
11849C               **  STEP 22--                                 **
11850C               **  PRINT TABLE FOR OVERALL ASSOCIATION TEST  **
11851C               ************************************************
11852C
11853      ISTEPN='22'
11854      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ODC2')
11855     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
11856C
11857      ICONC1='REJECT'
11858      ICONC2='REJECT'
11859      ICONC3='REJECT'
11860      ICONC4='REJECT'
11861      ICONC5='REJECT'
11862      ICONC6='REJECT'
11863C
11864      CALL CHSPPF(SIGVAL(1),IDFAS,CV1)
11865      CALL CHSPPF(SIGVAL(2),IDFAS,CV2)
11866      CALL CHSPPF(SIGVAL(3),IDFAS,CV3)
11867      CALL CHSPPF(SIGVAL(4),IDFAS,CV4)
11868      CALL CHSPPF(SIGVAL(5),IDFAS,CV5)
11869      CALL CHSPPF(SIGVAL(6),IDFAS,CV6)
11870C
11871      IF(0.000.LE.CDFASS.AND.CDFASS.LE.SIGVAL(1))ICONC1='ACCEPT'
11872      IF(0.000.LE.CDFASS.AND.CDFASS.LE.SIGVAL(2))ICONC2='ACCEPT'
11873      IF(0.000.LE.CDFASS.AND.CDFASS.LE.SIGVAL(3))ICONC3='ACCEPT'
11874      IF(0.000.LE.CDFASS.AND.CDFASS.LE.SIGVAL(4))ICONC4='ACCEPT'
11875      IF(0.000.LE.CDFASS.AND.CDFASS.LE.SIGVAL(5))ICONC5='ACCEPT'
11876      IF(0.000.LE.CDFASS.AND.CDFASS.LE.SIGVAL(6))ICONC6='ACCEPT'
11877C
11878      ITITLE(1:39)='Mantel-Haenszel Test for Overall Degree'
11879      ITITLE(40:54)=' of Association'
11880      NCTITL=54
11881      ITITL9=' '
11882      NCTIT9=0
11883C
11884      ITITL2(1,1)=' '
11885      NCTIT2(1,1)=0
11886      ITITL2(2,1)='Null'
11887      NCTIT2(2,1)=4
11888      ITITL2(3,1)='Hypothesis'
11889      NCTIT2(3,1)=10
11890C
11891      ITITL2(1,2)=' '
11892      NCTIT2(1,2)=0
11893      ITITL2(2,2)='Confidence'
11894      NCTIT2(2,2)=10
11895      ITITL2(3,2)='Level'
11896      NCTIT2(3,2)=5
11897C
11898      ITITL2(1,3)=' '
11899      NCTIT2(1,3)=0
11900      ITITL2(2,3)='Critical'
11901      NCTIT2(2,3)=8
11902      ITITL2(3,3)='Value'
11903      NCTIT2(3,3)=5
11904C
11905      ITITL2(1,4)='Null Hypothesis'
11906      NCTIT2(1,4)=15
11907      ITITL2(2,4)='Acceptance'
11908      NCTIT2(2,4)=10
11909      ITITL2(3,4)='Interval'
11910      NCTIT2(3,4)=8
11911C
11912      ITITL2(1,5)='Null'
11913      NCTIT2(1,5)=4
11914      ITITL2(2,5)='Hypothesis'
11915      NCTIT2(2,5)=10
11916      ITITL2(3,5)='Conclusion'
11917      NCTIT2(3,5)=10
11918C
11919      NMAX=0
11920      NUMCOL=5
11921      DO4110I=1,NUMCOL
11922        VALIGN(I)='b'
11923        ALIGN(I)='r'
11924        NTOT(I)=15
11925        NMAX=NMAX+NTOT(I)
11926        IF(I.EQ.3)THEN
11927          ITYPCO(I)='NUME'
11928        ELSE
11929          ITYPCO(I)='ALPH'
11930        ENDIF
11931        IF(I.EQ.2)THEN
11932          IDIGIT(I)=1
11933        ELSEIF(I.EQ.3)THEN
11934          IDIGIT(I)=2
11935        ELSE
11936          IDIGIT(I)=NUMDIG
11937        ENDIF
11938        DO4111J=1,NUMALP
11939          NCVALU(J,I)=0
11940 4111   CONTINUE
11941 4110 CONTINUE
11942C
11943      IWHTML(1)=150
11944      IWHTML(2)=125
11945      IWHTML(3)=125
11946      IWHTML(4)=150
11947      IWHTML(5)=150
11948      IINC=1600
11949      IINC2=1400
11950      IINC3=2200
11951      IWRTF(1)=IINC
11952      IWRTF(2)=IWRTF(1)+IINC
11953      IWRTF(3)=IWRTF(2)+IINC2
11954      IWRTF(4)=IWRTF(3)+IINC3
11955      IWRTF(5)=IWRTF(4)+IINC2
11956C
11957      IVALUE(1,2)='50.0%'
11958      NCVALU(1,2)=5
11959      AMAT(1,3)=CV1
11960      IVALUE(1,4)='(0,0.500)'
11961      NCVALU(1,4)=9
11962      IVALUE(1,5)(1:6)=ICONC1(1:6)
11963      NCVALU(1,5)=6
11964C
11965      IVALUE(2,2)='80.0%'
11966      NCVALU(2,2)=5
11967      AMAT(2,3)=CV2
11968      IVALUE(2,4)='(0,0.800)'
11969      NCVALU(2,4)=9
11970      IVALUE(2,5)(1:6)=ICONC2(1:6)
11971      NCVALU(2,5)=6
11972C
11973      IVALUE(3,2)='90.0%'
11974      NCVALU(3,2)=5
11975      AMAT(3,3)=CV3
11976      IVALUE(3,4)='(0,0.900)'
11977      NCVALU(3,4)=9
11978      IVALUE(3,5)(1:6)=ICONC3(1:6)
11979      NCVALU(3,5)=6
11980C
11981      IVALUE(4,2)='95.0%'
11982      NCVALU(4,2)=5
11983      AMAT(4,3)=CV4
11984      IVALUE(4,4)='(0,0.950)'
11985      NCVALU(4,4)=9
11986      IVALUE(4,5)(1:6)=ICONC4(1:6)
11987      NCVALU(4,5)=6
11988C
11989      IVALUE(5,2)='97.5%'
11990      NCVALU(5,2)=5
11991      AMAT(5,3)=CV5
11992      IVALUE(5,4)='(0,0.975)'
11993      NCVALU(5,4)=9
11994      IVALUE(5,5)(1:6)=ICONC5(1:6)
11995      NCVALU(5,5)=6
11996C
11997      IVALUE(6,2)='99.0%'
11998      NCVALU(6,2)=5
11999      AMAT(6,3)=CV6
12000      IVALUE(6,4)='(0,0.990)'
12001      NCVALU(6,4)=9
12002      IVALUE(6,5)(1:6)=ICONC6(1:6)
12003      NCVALU(6,5)=6
12004C
12005      DO4120J=1,NUMALP
12006        AMAT(J,1)=0.0
12007        AMAT(J,2)=0.0
12008        AMAT(J,4)=0.0
12009        AMAT(J,5)=0.0
12010        IVALUE(J,1)='No Association'
12011        NCVALU(J,1)=14
12012 4120 CONTINUE
12013C
12014      ICNT=NUMALP
12015      NUMLIN=3
12016      NUMCOL=5
12017      IFRST=.TRUE.
12018      ILAST=.TRUE.
12019      IFLAGS=.TRUE.
12020      IFLAGE=.TRUE.
12021C
12022      CALL DPDTA5(ITITLE,NCTITL,
12023     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
12024     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
12025     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXRO2,ICNT,
12026     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
12027     1            ICAPSW,ICAPTY,IFRST,ILAST,
12028     1            IFLAGS,IFLAGE,
12029     1            ISUBRO,IBUGA3,IERROR)
12030C
12031C               ************************************************
12032C               **  STEP 24--                                 **
12033C               **  PRINT TABLE FOR CONFIDENCE INTERVAL FOR   **
12034C               **  COMMON LOG(ODDS RATIO)                    **
12035C               ************************************************
12036C
12037      ISTEPN='24'
12038      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAH2')
12039     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12040C
12041      DO4270I=1,NUMALP
12042        ALPHA=(1.0 - SIGVAL(I))/2.0
12043        CALL NORPPF(ALPHA,CV)
12044        ALOWCL(I)=ODDRCO + CV*ODDRSE
12045        AUPPCL(I)=ODDRCO - CV*ODDRSE
12046        ALOWC2(I)=EXP(ALOWCL(I))
12047        AUPPC2(I)=EXP(AUPPCL(I))
12048        WRITE(IOUNI1,4271)ALPHA,ALOWCL(I),AUPPCL(I),
12049     1                    ALOWC2(I),AUPPC2(I)
12050 4271   FORMAT(F10.5,1X,4E15.7)
12051 4270 CONTINUE
12052C
12053      IOP='CLOS'
12054      IFLAG1=1
12055      IFLAG2=0
12056      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
12057     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
12058     1            IBUGA3,ISUBRO,IERROR)
12059      IF(IERROR.EQ.'YES')GOTO9000
12060C
12061      ITITLE(1:33)='Large Sample Confidence Interval '
12062      ITITLE(34:52)='for Log(Odds Ratio)'
12063      NCTITL=52
12064      ITITL9=' '
12065      NCTIT9=0
12066C
12067      ITITL2(1,1)=' '
12068      NCTIT2(1,1)=0
12069      NCOLSP(1,1)=1
12070      ITITL2(2,1)=' '
12071      NCTIT2(2,1)=0
12072      NCOLSP(2,1)=1
12073      ITITL2(3,1)='Confidence'
12074      NCTIT2(3,1)=10
12075      NCOLSP(3,1)=1
12076      ITITL2(4,1)='Value (%)'
12077      NCTIT2(4,1)=9
12078      NCOLSP(4,1)=1
12079C
12080      ITITL2(1,2)='Log(Odds Ratio)'
12081      NCTIT2(1,2)=15
12082      NCOLSP(1,2)=2
12083      ITITL2(2,2)='(               )'
12084      WRITE(ITITL2(2,2)(2:16),'(G15.7)')ODDRCO
12085      NCTIT2(2,2)=17
12086      NCOLSP(2,2)=2
12087      ITITL2(3,2)='Lower'
12088      NCTIT2(3,2)=5
12089      NCOLSP(3,2)=1
12090      ITITL2(4,2)='Limit'
12091      NCTIT2(4,2)=5
12092      NCOLSP(4,2)=1
12093C
12094      ITITL2(1,3)=' '
12095      NCTIT2(1,3)=0
12096      NCOLSP(1,3)=0
12097      ITITL2(2,3)=' '
12098      NCTIT2(2,3)=0
12099      NCOLSP(2,3)=0
12100      ITITL2(3,3)='Upper'
12101      NCTIT2(3,3)=5
12102      NCOLSP(3,3)=1
12103      ITITL2(4,3)='Limit'
12104      NCTIT2(4,3)=5
12105      NCOLSP(4,3)=1
12106C
12107      ITITL2(1,4)='Odds Ratio'
12108      NCTIT2(1,4)=10
12109      NCOLSP(1,4)=2
12110      ITITL2(2,4)='(               )'
12111      WRITE(ITITL2(2,4)(2:16),'(G15.7)')EXP(ODDRCO)
12112      NCTIT2(2,4)=17
12113      NCOLSP(2,4)=2
12114      ITITL2(3,4)='Lower'
12115      NCTIT2(3,4)=5
12116      NCOLSP(3,4)=1
12117      ITITL2(4,4)='Limit'
12118      NCTIT2(4,4)=5
12119      NCOLSP(4,4)=1
12120C
12121      ITITL2(1,5)=' '
12122      NCTIT2(1,5)=0
12123      NCOLSP(1,5)=0
12124      ITITL2(2,5)=' '
12125      NCTIT2(2,5)=0
12126      NCOLSP(2,5)=0
12127      ITITL2(3,5)='Upper'
12128      NCTIT2(3,5)=5
12129      NCOLSP(3,5)=1
12130      ITITL2(4,5)='Limit'
12131      NCTIT2(4,5)=5
12132      NCOLSP(4,5)=1
12133C
12134      NMAX=0
12135      DO4410I=1,NUMCLI
12136        VALIGN(I)='b'
12137        ALIGN(I)='r'
12138        NTOT(I)=15
12139        NMAX=NMAX+NTOT(I)
12140        ITYPCO(I)='NUME'
12141        DO4420J=1,MAXROW
12142          IF(I.EQ.1)THEN
12143            IDIGI2(J,I)=2
12144          ELSE
12145            IDIGI2(J,I)=NUMDIG
12146          ENDIF
12147 4420   CONTINUE
12148        IWHTML(1)=75
12149        IWHTML(2)=150
12150        IWHTML(3)=150
12151        IWHTML(4)=150
12152        IWHTML(5)=150
12153        IINC=1400
12154        IWRTF(1)=IINC
12155        IWRTF(2)=IWRTF(1)+IINC
12156        IWRTF(3)=IWRTF(2)+IINC
12157        IWRTF(4)=IWRTF(3)+IINC
12158        IWRTF(5)=IWRTF(4)+IINC
12159        IFRST=.TRUE.
12160        ILAST=.TRUE.
12161C
12162        DO4430J=1,NUMALP
12163          ATEMP=100.0*SIGVAL(J)
12164          AMAT(J,1)=ATEMP
12165          AMAT(J,2)=ALOWCL(J)
12166          AMAT(J,3)=AUPPCL(J)
12167          AMAT(J,4)=ALOWC2(J)
12168          AMAT(J,5)=AUPPC2(J)
12169          IVALUE(J,1)=' '
12170          IVALUE(J,2)=' '
12171          IVALUE(J,3)=' '
12172          IVALUE(J,4)=' '
12173          IVALUE(J,5)=' '
12174          NCVALU(J,1)=0
12175          NCVALU(J,2)=0
12176          NCVALU(J,3)=0
12177          NCVALU(J,4)=0
12178          NCVALU(J,5)=0
12179          ROWSEP(J)=0
12180 4430   CONTINUE
12181C
12182 4410 CONTINUE
12183C
12184      NUMLIN=4
12185      NUMCOL=5
12186      ICNT=NUMALP
12187      IFLAGS=.TRUE.
12188      IFLAGE=.TRUE.
12189      CALL DPDT5B(ITITLE,NCTITL,
12190     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
12191     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
12192     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXRO2,ICNT,
12193     1            IDIGI2,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
12194     1            NCOLSP,ROWSEP,
12195     1            ICAPSW,ICAPTY,IFRST,ILAST,
12196     1            IFLAGS,IFLAGE,
12197     1            ISUBRO,IBUGA3,IERROR)
12198C
12199C               *****************
12200C               **  STEP 90--  **
12201C               **  EXIT       **
12202C               *****************
12203C
12204 9000 CONTINUE
12205      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAH2')THEN
12206        WRITE(ICOUT,999)
12207        CALL DPWRST('XXX','WRIT')
12208        WRITE(ICOUT,9011)
12209 9011   FORMAT('***** AT THE END       OF DPMAH2--')
12210        CALL DPWRST('XXX','WRIT')
12211        WRITE(ICOUT,9013)AN11,AN21,AN12,AN22
12212 9013   FORMAT('AN11,AN21,AN12,AN22=',4G15.7)
12213        CALL DPWRST('XXX','WRIT')
12214        WRITE(ICOUT,9015)AN1,AN2
12215 9015   FORMAT('AN1,AN2=',2G15.7)
12216        CALL DPWRST('XXX','WRIT')
12217        WRITE(ICOUT,9017)N11,N21,N12,N22
12218 9017   FORMAT('N11,N21,N12,N22=',4I8)
12219        CALL DPWRST('XXX','WRIT')
12220      ENDIF
12221C
12222      RETURN
12223      END
12224      SUBROUTINE DPMAND(ICAPSW,IFORSW,ISEED,IBOOSS,
12225     1                  ISUBRO,IBUGA2,IBUGA3,IBUGQ,
12226     1                  IFOUND,IERROR)
12227C
12228C     PURPOSE--COMPUTE CONSENSUS MEANS USING FOLLOWING APPROACHES:
12229C              1) MANDEL-PAULE
12230C              2) MODIFIED MANDEL-PAULE
12231C              3) MAXIMUM LIKELIHOOD (VANGEL-RUHKIN)
12232C              4) DERSIMONIAN LARID
12233C                 (3 VARIANCE METHODS)
12234C              5) GRAYBILL-DEAL
12235C                 (4 VARIANCE METHODS)
12236C              6) FAIRWEATHER
12237C                 (3 VARIANCE METHODS)
12238C              7) GENERALIZED CONFIDENCE INTERVAL
12239C              8) MEAN OF MEANS (t-METHOD)
12240C              9) GRAND MEAN
12241C             10) BOB (ONLY IF NUMBER OF LABS = 2 - 5
12242C             11) SCHILLER-EBERHARDT
12243C             12) BAYESIAN CONSENSUS MEAN
12244C             13) MEDIAN OF MEANS
12245C             14) HUBER MEAN OF MEANS
12246C     WRITTEN BY--ALAN HECKERT
12247C                 STATISTICAL ENGINEERING DIVISION
12248C                 INFORMATION TECHNOLOGY LABORATORY
12249C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12250C                 GAITHERSBURG, MD 20899-8980
12251C                 PHONE--301-975-2899
12252C                 CODE FOR MANDEL-PAULE, VANGEL-RUKHIN
12253C                 PROVIDED BY MARK VANGEL, BOB BASED ON MACROS
12254C                 PROVIDED BY STEFAN LEIGH.  GENERALIZED CONFIDENCE
12255C                 INTERVAL CODE PROVIDED BY JACK WANG.
12256C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12257C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12258C     LANGUAGE--ANSI FORTRAN (1977)
12259C     VERSION NUMBER--2000/10
12260C     ORIGINAL VERSION--OCTOBER   2000.
12261C     UPDATED         --AUGUST    2001. IWRITE VARIABLE
12262C     UPDATED         --OCTOBER   2002. SUPPORT FOR "CAPTURE HTML"
12263C                                       (ADD ICAPSW TO CALL LIST)
12264C     UPDATED         --MARCH     2006. ADD IFORSW TO CALL LIST
12265C                                       DPMAN2 COMPLETELY REWRITTEN:
12266C                                       1) CODE MODULARIZED INTO
12267C                                          DISTINCT SUBROUTINES
12268C                                       2) FORMATTING REVISED FOR
12269C                                          CONSISTENCY AND CLARITY
12270C                                       3) NEW METHODS ADDED
12271C     UPDATED         --FEBRUARY  2010. USE DPPARS
12272C     UPDATED         --JUNE      2010. FIVE METHODS CAN USE LABS WITH
12273C                                       ZERO STANDARD DEVIATION
12274C     UPDATED         --OCTOBER   2011. FOR SUMMARY CASE, ADD OPTIONAL
12275C                                       LABID COLUMN
12276C     UPDATED         --JUNE      2012. ADD ISEED AND IBOOSS (FOR
12277C                                       BOOTSTRAP COMPUTATIONS)
12278C     UPDATED         --OCTOBER   2014. FOR SUMMARY DATA, OPTION TO
12279C                                       INPUT MEAN AND UNCERTAINTY
12280C                                       (I.E., S/SQRT(N) INSTEAD OF
12281C                                       S AND N).  IN SOME CASES, DATA
12282C                                       IS AVAILABLE IN THIS FORM.
12283C     UPDATED         --MARCH     2017. MEDIAN OF MEANS
12284C     UPDATED         --MARCH     2017. HUBER MEAN OF MEANS
12285C     UPDATED         --JULY      2019. TWEAK SCRATCH STORAGE
12286C
12287C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES----------------
12288C
12289      CHARACTER*4 ICAPSW
12290      CHARACTER*4 IFORSW
12291      CHARACTER*4 ISUBRO
12292      CHARACTER*4 IWRITE
12293      CHARACTER*4 IBUGA2
12294      CHARACTER*4 IBUGA3
12295      CHARACTER*4 IBUGQ
12296      CHARACTER*4 IFOUND
12297      CHARACTER*4 IERROR
12298C
12299      CHARACTER*4 IH
12300      CHARACTER*4 IH2
12301      CHARACTER*4 IHWUSE
12302      CHARACTER*4 MESSAG
12303      CHARACTER*4 ICASEQ
12304C
12305      CHARACTER*4 ISUBN0
12306      CHARACTER*4 ISUBN1
12307      CHARACTER*4 ISUBN2
12308      CHARACTER*4 ISTEPN
12309      CHARACTER*4 ICASE
12310C
12311      DOUBLE PRECISION YDL
12312      DOUBLE PRECISION DLOWD2
12313      DOUBLE PRECISION DHIGD2
12314      DOUBLE PRECISION DLOWD3
12315      DOUBLE PRECISION DHIGD3
12316      DOUBLE PRECISION DLOWD4
12317      DOUBLE PRECISION DHIGD4
12318      DOUBLE PRECISION DLOWD5
12319      DOUBLE PRECISION DHIGD5
12320      DOUBLE PRECISION DLOWD6
12321      DOUBLE PRECISION DHIGD6
12322      DOUBLE PRECISION SEBOK1
12323      DOUBLE PRECISION SEBOK2
12324C
12325      CHARACTER*40 INAME
12326      PARAMETER (MAXSPN=10)
12327      CHARACTER*4 IVARN1(MAXSPN)
12328      CHARACTER*4 IVARN2(MAXSPN)
12329      CHARACTER*4 IVARTY(MAXSPN)
12330      REAL PVAR(MAXSPN)
12331      INTEGER ILIS(MAXSPN)
12332      INTEGER NRIGHT(MAXSPN)
12333      INTEGER ICOLR(MAXSPN)
12334C
12335C----------------------------------------------------------------
12336C
12337      INCLUDE 'DPCOPA.INC'
12338C
12339      DIMENSION Y1(MAXOBV)
12340      DIMENSION Y2(MAXOBV)
12341      DIMENSION Y3(MAXOBV)
12342C
12343      INTEGER IZ(MAXOBV)
12344      INTEGER IZ2(MAXOBV)
12345      INTEGER ITEMP1(MAXOBV)
12346C
12347      DOUBLE PRECISION Z2(MAXOBV)
12348      DOUBLE PRECISION Z3(MAXOBV)
12349      DOUBLE PRECISION Z4(MAXOBV)
12350      DOUBLE PRECISION DTEMP1(MAXOBV)
12351      DOUBLE PRECISION DTEMP2(MAXOBV)
12352      DOUBLE PRECISION DTEMP3(MAXOBV)
12353C
12354      DIMENSION Z1(MAXOBV)
12355      DIMENSION Z6(MAXOBV)
12356      DIMENSION Z7(MAXOBV)
12357      DIMENSION Z8(MAXOBV)
12358      DIMENSION Z9(MAXOBV)
12359      DIMENSION PLABID(MAXOBV)
12360      DIMENSION XTEMP1(MAXOBV)
12361      DIMENSION XTEMP2(MAXOBV)
12362      DIMENSION XTEMP3(MAXOBV)
12363      DIMENSION XTEMP4(MAXOBV)
12364      DIMENSION XPLOTZ(MAXOBV)
12365      DIMENSION YPLOTZ(MAXOBV)
12366C
12367      INCLUDE 'DPCOZZ.INC'
12368      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
12369      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
12370      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
12371      EQUIVALENCE (GARBAG(IGARB4),Z1(1))
12372      EQUIVALENCE (GARBAG(IGARB5),Z6(1))
12373      EQUIVALENCE (GARBAG(IGARB4),Z7(1))
12374      EQUIVALENCE (GARBAG(IGARB8),Z8(1))
12375      EQUIVALENCE (GARBAG(IGARB9),Z9(1))
12376      EQUIVALENCE (GARBAG(IGAR10),PLABID(1))
12377      EQUIVALENCE (GARBAG(JGAR11),XTEMP1(1))
12378      EQUIVALENCE (GARBAG(JGAR12),XTEMP2(1))
12379      EQUIVALENCE (GARBAG(JGAR13),XTEMP3(1))
12380      EQUIVALENCE (GARBAG(JGAR14),XTEMP4(1))
12381      EQUIVALENCE (GARBAG(JGAR15),XPLOTZ(1))
12382      EQUIVALENCE (GARBAG(JGAR16),YPLOTZ(1))
12383C
12384      INCLUDE 'DPCOZD.INC'
12385      EQUIVALENCE (DGARBG(IDGAR1),Z2(1))
12386      EQUIVALENCE (DGARBG(IDGAR2),Z3(1))
12387      EQUIVALENCE (DGARBG(IDGAR3),Z4(1))
12388      EQUIVALENCE (DGARBG(IDGAR4),DTEMP1(1))
12389      EQUIVALENCE (DGARBG(IDGAR5),DTEMP2(1))
12390      EQUIVALENCE (DGARBG(IDGAR6),DTEMP3(1))
12391C
12392      INCLUDE 'DPCOZI.INC'
12393      EQUIVALENCE (IGARBG(IIGAR1),IZ(1))
12394      EQUIVALENCE (IGARBG(IIGAR2),IZ2(1))
12395      EQUIVALENCE (IGARBG(IIGAR3),ITEMP1(1))
12396C
12397C-----COMMON----------------------------------------------------
12398C
12399      INCLUDE 'DPCOSU.INC'
12400      INCLUDE 'DPCOHO.INC'
12401      INCLUDE 'DPCOHK.INC'
12402      INCLUDE 'DPCODA.INC'
12403      INCLUDE 'DPCOP2.INC'
12404C
12405C-----START POINT------------------------------------------------
12406C
12407      ISUBN1='DPMA'
12408      ISUBN2='ND  '
12409      IERROR='NO'
12410      ICASEQ='UNKN'
12411C
12412      MAXCP1=MAXCOL+1
12413      MAXCP2=MAXCOL+2
12414      MAXCP3=MAXCOL+3
12415      MAXCP4=MAXCOL+4
12416      MAXCP5=MAXCOL+5
12417      MAXCP6=MAXCOL+6
12418C
12419C               **************************************
12420C               **  TREAT THE MANDEL ANALYSIS CASE  **
12421C               **************************************
12422C
12423      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MAND')THEN
12424        WRITE(ICOUT,999)
12425  999   FORMAT(1X)
12426        CALL DPWRST('XXX','BUG ')
12427        WRITE(ICOUT,51)
12428   51   FORMAT('***** AT THE BEGINNING OF DPMAND--')
12429        CALL DPWRST('XXX','BUG ')
12430        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO
12431   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
12432        CALL DPWRST('XXX','BUG ')
12433      ENDIF
12434C
12435C               ***************************
12436C               **  STEP 1--             **
12437C               **  EXTRACT THE COMMAND  **
12438C               ***************************
12439C
12440      ISTEPN='1'
12441      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MAND')
12442     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12443C
12444      ILASTC=0
12445      IF(NUMARG.GE.1.AND.ICOM.EQ.'MAND'.AND.
12446     1  IHARG(1).EQ.'PAUL')THEN
12447        ILASTC=1
12448      ELSEIF(NUMARG.GE.1.AND.ICOM.EQ.'MAND'.AND.
12449     1  IHARG(1).EQ.'ANAL')THEN
12450        ILASTC=1
12451      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'MAND'.AND.
12452     1  IHARG(1).EQ.'PAUL'.AND.IHARG(2).EQ.'ANAL')THEN
12453        ILASTC=2
12454      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'CONS'.AND.
12455     1  IHARG(1).EQ.'MEAN'.AND.IHARG(2).EQ.'ANAL')THEN
12456        ILASTC=2
12457      ELSEIF(NUMARG.GE.1.AND.ICOM.EQ.'CONS'.AND.
12458     1  IHARG(1).EQ.'MEAN')THEN
12459        ILASTC=1
12460      ELSEIF(NUMARG.GE.1.AND.ICOM.EQ.'BOB '.AND.
12461     1  IHARG(1).EQ.'ANAL')THEN
12462        ILASTC=1
12463      ELSEIF(ICOM.EQ.'MAND')THEN
12464        ILASTC=0
12465      ELSEIF(ICOM.EQ.'BOB ')THEN
12466        ILASTC=0
12467      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'SUMM'.AND.
12468     1  IHARG(1).EQ.'MAND'.AND.IHARG(2).EQ.'PAUL')THEN
12469        ILASTC=2
12470      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'SUMM'.AND.
12471     1  IHARG(1).EQ.'MAND'.AND.IHARG(2).EQ.'ANAL')THEN
12472        ILASTC=2
12473      ELSEIF(NUMARG.GE.3.AND.ICOM.EQ.'SUMM'.AND.
12474     1  IHARG(1).EQ.'MAND'.AND.IHARG(2).EQ.'PAUL'.AND.
12475     1  IHARG(3).EQ.'ANAL')THEN
12476        ILASTC=3
12477      ELSEIF(NUMARG.GE.3.AND.ICOM.EQ.'SUMM'.AND.
12478     1  IHARG(1).EQ.'CONS'.AND.IHARG(2).EQ.'MEAN'.AND.
12479     1  IHARG(3).EQ.'ANAL')THEN
12480        ILASTC=3
12481      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'SUMM'.AND.
12482     1  IHARG(1).EQ.'CONS'.AND.IHARG(2).EQ.'MEAN')THEN
12483        ILASTC=2
12484      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'SUMM'.AND.
12485     1  IHARG(1).EQ.'BOB '.AND.IHARG(2).EQ.'ANAL')THEN
12486        ILASTC=2
12487      ELSEIF(NUMARG.GE.1.AND.ICOM.EQ.'SUMM'.AND.
12488     1  IHARG(1).EQ.'MAND')THEN
12489        ILASTC=1
12490      ELSEIF(NUMARG.GE.1.AND.ICOM.EQ.'SUMM'.AND.
12491     1  IHARG(1).EQ.'BOB ')THEN
12492        ILASTC=1
12493      ELSE
12494        IFOUND='NO'
12495        GOTO9000
12496      ENDIF
12497C
12498      IFOUND='YES'
12499      IF(ILASTC.GT.0)THEN
12500        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
12501      ENDIF
12502C
12503C               ****************************************
12504C               **  STEP 2--                          **
12505C               **  EXTRACT THE VARIABLE LIST         **
12506C               ****************************************
12507C
12508      ISTEPN='2'
12509      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MAND')
12510     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12511C
12512      INAME='CONSENSUS MEAN'
12513      MINNA=2
12514      MAXNA=100
12515      MINN2=2
12516      IFLAGE=1
12517      IFLAGM=0
12518      IFLAGP=0
12519      JMIN=1
12520      JMAX=NUMARG
12521      MINNVA=2
12522      MAXNVA=4
12523      DO210I=1,MAXSPN
12524        IVARTY(I)='XXXX'
12525  210 CONTINUE
12526C
12527      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
12528     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
12529     1            JMIN,JMAX,
12530     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
12531     1            IVARN1,IVARN2,IVARTY,PVAR,
12532     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
12533     1            MINNVA,MAXNVA,
12534     1            IFLAGM,IFLAGP,
12535     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
12536      IF(IERROR.EQ.'YES')GOTO9000
12537C
12538      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MAND')THEN
12539        WRITE(ICOUT,999)
12540        CALL DPWRST('XXX','BUG ')
12541        WRITE(ICOUT,281)
12542  281   FORMAT('***** AFTER CALL DPPARS--')
12543        CALL DPWRST('XXX','BUG ')
12544        WRITE(ICOUT,282)NQ,NUMVAR
12545  282   FORMAT('NQ,NUMVAR = ',2I8)
12546        CALL DPWRST('XXX','BUG ')
12547        IF(NUMVAR.GT.0)THEN
12548          DO285I=1,NUMVAR
12549            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
12550     1                      ICOLR(I)
12551  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
12552     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
12553            CALL DPWRST('XXX','BUG ')
12554  285     CONTINUE
12555        ENDIF
12556      ENDIF
12557C
12558C               ****************************************
12559C               **  STEP 3--                          **
12560C               **  EXTRACT THE DATA                  **
12561C               ****************************************
12562C
12563C     THE FOLLOWING CASES ARE SUPPORTED:
12564C
12565C       1) NUMVAR = 2
12566C
12567C          RAW DATA CASE, THE "X" VARIABLE IS ALSO THE LAB-ID
12568C
12569C       2) NUMVAR = 3
12570C
12571C          SUMMARY DATA CASE, NO LAB-ID VARIABLE GIVEN
12572C
12573C       2) NUMVAR = 4
12574C
12575C          SUMMARY DATA CASE, LAB-ID VARIABLE GIVEN
12576C
12577      ICASE='VARI'
12578      ICOL=1
12579      CALL DPPAR5(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
12580     1            INAME,IVARN1,IVARN2,IVARTY,
12581     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
12582     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
12583     1            MAXCP4,MAXCP5,MAXCP6,
12584     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
12585     1            Y1,Y2,Y3,PLABID,Z9,Z9,Z9,NS,
12586     1            IBUGA3,ISUBRO,IFOUND,IERROR)
12587      IF(IERROR.EQ.'YES')GOTO9000
12588C
12589      IF(NUMVAR.EQ.3)THEN
12590        DO310I=1,NS
12591          PLABID(I)=REAL(I)
12592  310   CONTINUE
12593      ENDIF
12594C
12595C               **************************************************
12596C               **  STEP 8--                                    **
12597C               **  PREPARE FOR ENTRANCE INTO DPMAN2--          **
12598C               **************************************************
12599C
12600      ISTEPN='8'
12601      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MAND')
12602     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12603C
12604      IH='SIGM'
12605      IH2='AH  '
12606      IHWUSE='P'
12607      MESSAG='NO'
12608      CALL CHECKN(IH,IH2,IHWUSE,
12609     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
12610     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
12611      IF(IERROR.EQ.'YES')THEN
12612        SIGMAH=0.0
12613      ELSE
12614        SIGMAH=VALUE(ILOCP)
12615        IF(SIGMAH.LT.0.0)SIGMAH=0.0
12616      ENDIF
12617      IH='DFH '
12618      IH2='    '
12619      IHWUSE='P'
12620      MESSAG='NO'
12621      CALL CHECKN(IH,IH2,IHWUSE,
12622     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
12623     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
12624      IF(IERROR.EQ.'YES')THEN
12625        IDFH=1
12626      ELSE
12627        IDFH=INT(VALUE(ILOCP)+ 0.5)
12628      ENDIF
12629      IF(IDFH.LE.0)IDFH=1
12630C
12631C               ***********************************************
12632C               **  STEP 9--                                 **
12633C               **  CARRY OUT THE CONSENSUS MEANS ANALYSIS   **
12634C               ***********************************************
12635C
12636      ISTEPN='9'
12637      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MAND')THEN
12638        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12639        WRITE(ICOUT,999)
12640        CALL DPWRST('XXX','BUG ')
12641        WRITE(ICOUT,711)
12642  711   FORMAT('***** FROM DPMAND, AS WE ARE ABOUT TO CALL DPMAN2--')
12643        CALL DPWRST('XXX','BUG ')
12644        WRITE(ICOUT,712)NLEFT,MAXN,NS,NUMVAR
12645  712   FORMAT('NLEFT,MAXN,NS,NUMVAR = ',4I8)
12646        CALL DPWRST('XXX','BUG ')
12647        DO715I=1,NS
12648          WRITE(ICOUT,716)I,Y(I),Y2(I),Y3(I),PLABID(I)
12649  716     FORMAT('I,Y1(I),Y2(I),Y3(I),PLABID(I) = ',
12650     1           I6,2X,4G15.7)
12651          CALL DPWRST('XXX','BUG ')
12652  715   CONTINUE
12653      ENDIF
12654C
12655      NPLOT=0
12656      IWRITE='OFF'
12657      CALL DPMAN2(Y1,Y2,Y3,PLABID,NS,NUMVAR,MAXOBV,
12658     1            Z1,Z2,Z3,Z4,
12659     1            Z6,Z7,IZ,
12660     1            Z8,Z9,IZ2,
12661     1            XTEMP1,XTEMP2,XTEMP3,XTEMP4,ITEMP1,
12662     1            DTEMP1,DTEMP2,DTEMP3,
12663     1            XPLOTZ,YPLOTZ,NPLOT,
12664     1            IVARN1(1),IVARN2(1),IVARN1(2),IVARN2(2),
12665     1            IVARN1(3),IVARN2(3),
12666     1            SIGMAH,IDFH,
12667     1            XGRAND,S2WPOO,SW,ASD2,ASD3,
12668     1            SET1,SET2,
12669     1            XMPS,S2BMPS,SEMP,
12670     1            XMMPS,S2BMMP,SEMMP,
12671     1            XMLS,S2BMLS,SEML,
12672     1            XSE,XSES2,ABIAS,ISEDF,
12673     1            ASM,ASB,AKU,
12674CCCCC             MARCH   2006.  ADD FOLLOWING 2 LINES TO CALL LIST
12675     1            XGD,XGDS2,
12676     1            XGCI,XDL,XDLS2,YDL,SEDLK1,SEHDK1,SERUK1,
12677     1            XDLK2,XDLK3,DLOWD2,DHIGD2,DLOWD3,DHIGD3,
12678     1            SEBOK1,SEBOK2,DLOWD4,DHIGD4,
12679     1            DLOWD5,DHIGD5,DLOWD6,DHIGD6,
12680     1            SEGCI,XFW,SEFWK1,SEFWK2,
12681     1            XBCP,XBCPSE,XBCPK1,XBCPK2,XMEDME,SEMEK1,
12682     1            XH15,SEHMK1,SEHMK2,H15LCL,H15UCL,
12683     1            IWRITE,
12684CCCCC             OCTOBER 2002.  ADD ICAPSW, ICAPTY TO CALL LIST
12685CCCCC             MARCH   2006.  ADD IFORSW TO CALL LIST
12686     1            ICAPSW,ICAPTY,IFORSW,ISEED,IBOOSS,
12687     1            ISUBRO,IBUGA3,IERROR)
12688C
12689C               ***************************************
12690C               **  STEP 10--                        **
12691C               **  UPDATE INTERNAL DATAPLOT TABLES  **
12692C               ***************************************
12693C
12694      ISTEPN='10'
12695      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
12696C
12697      IF(NPLOT.GT.0)THEN
12698        NPLOTP=NPLOT
12699        DO810I=1,NPLOT
12700          XPLOT(I)=XPLOTZ(I)
12701          YPLOT(I)=YPLOTZ(I)
12702  810   CONTINUE
12703      ENDIF
12704C
12705      IH='XGRA'
12706      IH2='ND  '
12707      VALUE0=XGRAND
12708      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12709     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12710     1IANS,IWIDTH,IBUGA3,IERROR)
12711C
12712      IH='S2PO'
12713      IH2='OOL '
12714      VALUE0=S2WPOO
12715      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12716     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12717     1IANS,IWIDTH,IBUGA3,IERROR)
12718C
12719      IH='YBAR'
12720      IH2='SD1 '
12721      VALUE0=ASD2
12722      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12723     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12724     1IANS,IWIDTH,IBUGA3,IERROR)
12725C
12726      IH='YBAR'
12727      IH2='SD2 '
12728      VALUE0=ASD3
12729      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12730     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12731     1IANS,IWIDTH,IBUGA3,IERROR)
12732C
12733      IH='T1ST'
12734      IH2='DERR'
12735      VALUE0=SET1
12736      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12737     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12738     1IANS,IWIDTH,IBUGA3,IERROR)
12739C
12740      IH='T2ST'
12741      IH2='DERR'
12742      VALUE0=SET2
12743      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12744     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12745     1IANS,IWIDTH,IBUGA3,IERROR)
12746C
12747      IH='SEME'
12748      IH2='AN  '
12749      VALUE0=XSE
12750      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12751     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12752     1IANS,IWIDTH,IBUGA3,IERROR)
12753C
12754      IH='SES2'
12755      IH2='    '
12756      VALUE0=XSES2
12757      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12758     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12759     1IANS,IWIDTH,IBUGA3,IERROR)
12760C
12761      IH='BIAS'
12762      IH2='ALLO'
12763      VALUE0=ABIAS
12764      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12765     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12766     1IANS,IWIDTH,IBUGA3,IERROR)
12767C
12768      IH='SEDF'
12769      IH2='    '
12770      VALUE0=REAL(ISEDF)
12771      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12772     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12773     1IANS,IWIDTH,IBUGA3,IERROR)
12774C
12775      IH='MPME'
12776      IH2='AN  '
12777      VALUE0=XMPS
12778      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12779     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12780     1IANS,IWIDTH,IBUGA3,IERROR)
12781C
12782      IH='MPS2'
12783      IH2='    '
12784      VALUE0=S2BMPS
12785      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12786     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12787     1IANS,IWIDTH,IBUGA3,IERROR)
12788C
12789      IH='SEMP'
12790      IH2='    '
12791      VALUE0=SEMP
12792      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12793     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12794     1IANS,IWIDTH,IBUGA3,IERROR)
12795C
12796      IH='MMPM'
12797      IH2='EAN '
12798      VALUE0=XMMPS
12799      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12800     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12801     1IANS,IWIDTH,IBUGA3,IERROR)
12802C
12803      IH='MMPS'
12804      IH2='2   '
12805      VALUE0=S2BMMP
12806      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12807     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12808     1IANS,IWIDTH,IBUGA3,IERROR)
12809C
12810      IH='SEMM'
12811      IH2='P   '
12812      VALUE0=SEMMP
12813      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12814     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12815     1IANS,IWIDTH,IBUGA3,IERROR)
12816C
12817      IH='MLME'
12818      IH2='AN  '
12819      VALUE0=XMLS
12820      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12821     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12822     1IANS,IWIDTH,IBUGA3,IERROR)
12823C
12824      IH='MLS2'
12825      IH2='    '
12826      VALUE0=S2BMLS
12827      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12828     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12829     1IANS,IWIDTH,IBUGA3,IERROR)
12830C
12831      IH='SEML'
12832      IH2='    '
12833      VALUE0=SEML
12834      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12835     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12836     1IANS,IWIDTH,IBUGA3,IERROR)
12837C
12838      IH='BOBM'
12839      IH2='EAN '
12840      VALUE0=ASM
12841      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12842     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12843     1IANS,IWIDTH,IBUGA3,IERROR)
12844C
12845      IH='BOBS'
12846      IH2='2   '
12847      VALUE0=ASB
12848      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12849     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12850     1IANS,IWIDTH,IBUGA3,IERROR)
12851C
12852      IH='BOBS'
12853      IH2='2W  '
12854      VALUE0=SW
12855      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12856     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12857     1IANS,IWIDTH,IBUGA3,IERROR)
12858C
12859      IH='BOBK'
12860      IH2='U   '
12861      VALUE0=AKU
12862      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12863     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12864     1IANS,IWIDTH,IBUGA3,IERROR)
12865C
12866      IH='GDME'
12867      IH2='AN  '
12868      VALUE0=XGD
12869      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12870     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12871     1IANS,IWIDTH,IBUGA3,IERROR)
12872C
12873      IH='GDS2'
12874      IH2='    '
12875      VALUE0=XGDS2
12876      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12877     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12878     1IANS,IWIDTH,IBUGA3,IERROR)
12879C
12880      IH='GCIM'
12881      IH2='EAN '
12882      VALUE0=XGCI
12883      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12884     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12885     1IANS,IWIDTH,IBUGA3,IERROR)
12886C
12887      IH='GCIS'
12888      IH2='E   '
12889      VALUE0=SEGCI
12890      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12891     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12892     1IANS,IWIDTH,IBUGA3,IERROR)
12893C
12894      IH='DERS'
12895      IH2='MEAN'
12896      VALUE0=XDL
12897      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12898     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12899     1IANS,IWIDTH,IBUGA3,IERROR)
12900C
12901      IH='YDL '
12902      IH2='    '
12903      VALUE0=YDL
12904      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12905     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12906     1IANS,IWIDTH,IBUGA3,IERROR)
12907C
12908      IH='DERS'
12909      IH2='VARI'
12910      VALUE0=XDLS2
12911      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12912     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12913     1IANS,IWIDTH,IBUGA3,IERROR)
12914C
12915      IH='DERS'
12916      IH2='SE  '
12917      VALUE0=SEDLK1
12918      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12919     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12920     1IANS,IWIDTH,IBUGA3,IERROR)
12921C
12922      IH='DERS'
12923      IH2='95LL'
12924      VALUE0=DLOWD2
12925      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12926     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12927     1IANS,IWIDTH,IBUGA3,IERROR)
12928C
12929      IH='DERS'
12930      IH2='95UL'
12931      VALUE0=DHIGD2
12932      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12933     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12934     1IANS,IWIDTH,IBUGA3,IERROR)
12935C
12936      IH='DHHD'
12937      IH2='95LL'
12938      VALUE0=DLOWD3
12939      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12940     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12941     1IANS,IWIDTH,IBUGA3,IERROR)
12942C
12943      IH='DHHD'
12944      IH2='95UL'
12945      VALUE0=DHIGD3
12946      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12947     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12948     1IANS,IWIDTH,IBUGA3,IERROR)
12949C
12950      IH='DERS'
12951      IH2='SEHD'
12952      VALUE0=SEHDK1
12953      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12954     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12955     1IANS,IWIDTH,IBUGA3,IERROR)
12956C
12957      IH='DERS'
12958      IH2='SERU'
12959      VALUE0=SERUK1
12960      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12961     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12962     1IANS,IWIDTH,IBUGA3,IERROR)
12963C
12964      IH='DERS'
12965      IH2='SEBS'
12966      VALUE0=SEBOK1
12967      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12968     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12969     1IANS,IWIDTH,IBUGA3,IERROR)
12970C
12971      IH='DERS'
12972      IH2='BOK2'
12973      VALUE0=XDLK2
12974      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12975     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12976     1IANS,IWIDTH,IBUGA3,IERROR)
12977C
12978      IH='DERS'
12979      IH2='BOK3'
12980      VALUE0=XDLK3
12981      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12982     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12983     1IANS,IWIDTH,IBUGA3,IERROR)
12984C
12985      IH='FAIR'
12986      IH2='MEAN'
12987      VALUE0=XFW
12988      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12989     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12990     1IANS,IWIDTH,IBUGA3,IERROR)
12991C
12992      IH='FAIR'
12993      IH2='SE  '
12994      VALUE0=SEFWK1
12995      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
12996     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
12997     1IANS,IWIDTH,IBUGA3,IERROR)
12998C
12999      IH='BCPM'
13000      IH2='EAN '
13001      VALUE0=XBCP
13002      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
13003     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
13004     1IANS,IWIDTH,IBUGA3,IERROR)
13005C
13006      IH='BCPS'
13007      IH2='E   '
13008      VALUE0=XBCPSE
13009      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
13010     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
13011     1IANS,IWIDTH,IBUGA3,IERROR)
13012C
13013      IH='MEDO'
13014      IH2='FMEA'
13015      VALUE0=XMEDME
13016      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
13017     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
13018     1IANS,IWIDTH,IBUGA3,IERROR)
13019C
13020      IH='MEDM'
13021      IH2='EASE'
13022      VALUE0=SEMEK1
13023      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
13024     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
13025     1IANS,IWIDTH,IBUGA3,IERROR)
13026C
13027      IH='H15O'
13028      IH2='FMEA'
13029      VALUE0=XH15
13030      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
13031     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
13032     1IANS,IWIDTH,IBUGA3,IERROR)
13033C
13034      IH='H15M'
13035      IH2='EASE'
13036      VALUE0=SEHMK1
13037      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
13038     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
13039     1IANS,IWIDTH,IBUGA3,IERROR)
13040C
13041C               *****************
13042C               **  STEP 90--  **
13043C               **  EXIT       **
13044C               *****************
13045C
13046 9000 CONTINUE
13047      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MAN2')THEN
13048        WRITE(ICOUT,999)
13049        CALL DPWRST('XXX','BUG ')
13050        WRITE(ICOUT,9011)
13051 9011   FORMAT('***** AT THE END       OF DPMAND--')
13052        CALL DPWRST('XXX','BUG ')
13053        WRITE(ICOUT,9014)NS,NUMVAR,ABIAS,ICASEQ
13054 9014   FORMAT('NS,NUMVAR,ABIAS,ICASEQ = ',2I8,G15.7,2X,A4)
13055        CALL DPWRST('XXX','BUG ')
13056        WRITE(ICOUT,9016)IFOUND,IERROR
13057 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
13058        CALL DPWRST('XXX','BUG ')
13059      ENDIF
13060C
13061      RETURN
13062      END
13063      SUBROUTINE DPMAN2(Y1,Y2,Y3,PLABID,NPTS,NUMVAR,MAXNXT,
13064     1                  DAT,X,T,W,
13065     1                  AMEAN,ASD,N,
13066     1                  AMEANF,ASDF,NFULL,
13067     1                  XTEMP1,XTEMP2,XTEMP3,XTEMP4,ITEMP1,
13068     1                  DTEMP1,DTEMP2,DTEMP3,
13069     1                  XPLOT,YPLOT,NPLOT,
13070     1                  IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
13071     1                  SIGMAH,IDFH,
13072     1                  XGRAND,S2WPOO,SW,ASD2,ASD3,
13073     1                  SET1,SET2,
13074     1                  XMPS,S2BMPS,SEMP,
13075     1                  XMMPS,S2BMMP,SEMMP,
13076     1                  XMLS,S2BMLS,SEML,
13077     1                  XSE,XSES2,ABIAS,ISEDF,
13078     1                  ASM,ASB,AKU,
13079     1                  XGD,XGDS2,
13080     1                  XGCI,XDL,XDLS2,YDL,SEDLK1,SEHDK1,SERUK1,
13081     1                  XDLK2,XDLK3,DLOWD2,DHIGD2,DLOWD3,DHIGD3,
13082     1                  SEBOK1,SEBOK2,DLOWD4,DHIGD4,
13083     1                  DLOWD5,DHIGD5,DLOWD6,DHIGD6,
13084     1                  SEGCI,XFW,SEFWK1,SEFWK2,
13085     1                  XBCP,XBCPSE,XBCPK1,XBCPK2,XMEDME,SEMEK1,
13086     1                  XH15,SEHMK1,SEHMK2,H15LCL,H15UCL,
13087     1                  IWRITE,
13088CCCCC                   OCTOBER 2002.  ADD ICAPSW, ICAPTY TO CALL LIST
13089     1                  ICAPSW,ICAPTY,IFORSW,ISEED,IBOOSS,
13090     1                  ISUBRO,IBUGA3,IERROR)
13091C
13092C     PURPOSE--PERFORM A CONSENSUS MEAN ANALYSIS USING FOLLOWING
13093C              APPROACHES
13094C              1) MANDEL-PAULE
13095C              2) MODIFIED MANDEL-PAULE
13096C              3) VANGEL-RUKHIN MAXIMUM LIKELIHOOD
13097C              4) BOB
13098C              5) SCHILLER-EBERHARDT
13099C              6) MEAN OF MEANS
13100C              7) GRAYBILL-DEAL
13101C              8) GRAND MEAN
13102C              9) GENERALIZED TOLERANCE INTERVALS
13103C             10) DERSIMONIAN AND LARID
13104C             11) FAIRWEATHER
13105C             12) BAYESIAN CONSENSUS PROCEDURE OF GUTHRIE AND HAGWOOD
13106C             13) MEDIAN OF MEANS
13107C             14) HUBER MEAN OF MEANS
13108C     WRITTEN BY--CODE FOR MANDEL-PAULE, MAXIMUM LIKELIHOOD
13109C                 PROVIDED BY MARK VANGEL, BOB BASED ON MACROS
13110C                 PROVIDED BY STEFAN LEIGH.
13111C     PRINTING--YES
13112C     SUBROUTINES NEEDED--FCDF
13113C     WRITTEN BY--ALAN HECKERT
13114C                 STATISTICAL ENGINEERING DIVISION
13115C                 INFORMATION TECHNOLOGY LABORATORY
13116C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13117C                 GAITHERSBURG, MD 20899-8980
13118C                 PHONE--301-975-2899
13119C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13120C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13121C     LANGUAGE--ANSI FORTRAN (1977)
13122C     VERSION NUMBER--2000/10
13123C     ORIGINAL VERSION--OCTOBER   2000.
13124C     UPDATED  VERSION--FEBRUARY  2001. FROM JAMES YEN, A FEW
13125C                                       TERMINOLOGY CHANGES,
13126C                                       FIX TO BOB COMPUTATION
13127C     UPDATED  VERSION--AUGUST    2001. ADD IWRITE
13128C     UPDATED  VERSION--APRIL     2002. PRINTING OF GRAND MEAN
13129C     UPDATED  VERSION--OCTOBER   2002. SUPPORT FOR "CAPTURE HTML"
13130C     UPDATED  VERSION--OCTOBER   2003. SUPPORT FOR "CAPTURE LATEX"
13131C     UPDATED  VERSION--APRIL     2004. SOME MODIFICATIONS TO THE
13132C                                       FORMATTING OF THE OUTPUT
13133C     UPDATED  VERSION--MARCH     2006. SPLIT ROUTINE INTO MULTIPLE
13134C                                       SUBROUTINES
13135C     UPDATED  VERSION--MARCH     2006. IFORSW FOR SIGNIFICANT DIGITS
13136C     UPDATED  VERSION--MARCH     2006. REVISE OUTPUT FORMAT
13137C     UPDATED  VERSION--JUNE      2006. SET COMMANDS TO INDIVIDUALLY
13138C                                       CONTROL WHETHER A PARTICULAR
13139C                                       METHOD IS APPLIED
13140C     UPDATED  VERSION--JUNE      2006. OMIT LABS WITH ONLY ONE
13141C                                       OBSERVATION
13142C     UPDATED  VERSION--JUNE      2006. ADD THE BAYESIAN CONSENSUS
13143C                                       PROCEDURE METHOD OF HAGWOOD
13144C                                       AND GUTHRIE (A REFINEMENT OF
13145C                                       BOB)
13146C     UPDATED  VERSION--FEBRUARY  2007. FOR THE BAYESIAN CONSENSUS
13147C                                       AND BOB METHODS,
13148C                                       AUTOMATICALLY SUPPRESS IF
13149C                                       TOO MANY LABS
13150C     UPDATED  VERSION--FEBRUARY  2010. USE DPDTA1, DPDTA2 FOR TABLES
13151C     UPDATED  VERSION--JUNE      2010. FIVE METHODS CAN HANDLE CASE
13152C                                       WHERE SOME LABS HAVE 0 STANDARD
13153C                                       DEVIATION
13154C     UPDATED  VERSION--OCTOBER   2011. OPTIONAL LABID VARIABLE FOR
13155C                                       SUMMARY DATA CASE
13156C     UPDATED         --OCTOBER   2014. FOR SUMMARY DATA, OPTION TO
13157C                                       INPUT MEAN AND UNCERTAINTY
13158C                                       (I.E., S/SQRT(N) INSTEAD OF
13159C                                       S AND N) (IN SOME CASES, DATA
13160C                                       IS ONLY AVAILABLE IN THIS FORM).
13161C     UPDATED         --AUGUST    2015. DON'T RESTART VERBATIM MODE
13162C                                       HERE AS THIS IS ALREADY DONE
13163C                                       BY THE LAST TABLE ROUTINE
13164C     UPDATED         --MARCH     2017. MEDIAN OF MEANS
13165C     UPDATED         --MARCH     2017. HUBER MEAN OF MEANS
13166C
13167C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
13168C
13169      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
13170C
13171      CHARACTER*4 ICAPSW
13172      CHARACTER*4 ICAPTY
13173      CHARACTER*4 IFORSW
13174      CHARACTER*4 ISUBRO
13175      CHARACTER*4 IBUGA3
13176      CHARACTER*4 IERROR
13177C
13178      CHARACTER*4 IWRITE
13179      CHARACTER*4 IPTEMP
13180      CHARACTER*4 IPRISV
13181C
13182      CHARACTER*4 ISUBN1
13183      CHARACTER*4 ISUBN2
13184      CHARACTER*4 ISTEPN
13185C
13186      CHARACTER*4 IHLEFT
13187      CHARACTER*4 IHLEF2
13188      CHARACTER*4 IHRIGH
13189      CHARACTER*4 IHRIG2
13190      CHARACTER*4 IHRI21
13191      CHARACTER*4 IHRI22
13192C
13193      LOGICAL IFLAG9
13194C
13195      REAL SIGMAH
13196      REAL XMPS
13197      REAL XMMPS
13198      REAL S2BMPS
13199      REAL S2BMMP
13200      REAL XMLS
13201      REAL S2BMLS
13202      REAL AMNX
13203      REAL AMXX
13204      REAL ASM
13205      REAL ASB
13206      REAL AKU
13207      REAL AKUK1
13208      REAL AKUK2
13209      REAL XGRAND
13210      REAL SW
13211      REAL S2WPOO
13212      REAL SEMP
13213      REAL SEMPK1
13214      REAL SEMPK2
13215      REAL SEML
13216      REAL SEMLK1
13217      REAL SEMLK2
13218      REAL SEMLBO
13219      REAL SEMLB2
13220      REAL SEMMP
13221      REAL SEMMP1
13222      REAL SEMMP2
13223      REAL SDGRAN
13224      REAL ASD2
13225      REAL ASD3
13226      REAL ABIAS
13227      REAL XGD
13228      REAL XGDS2
13229      REAL XGCI
13230      REAL SET1
13231      REAL SET1K1
13232      REAL SET1K2
13233      REAL SET2
13234      REAL SET2K1
13235      REAL SET2K2
13236      REAL XSE
13237      REAL XSES2
13238      REAL SEGDK1
13239      REAL SEGDK2
13240      REAL SESUK1
13241      REAL SESUK2
13242      REAL XDL
13243      REAL XDLS2
13244      REAL SEDLK1
13245      REAL SEDLK2
13246      REAL SERUK1
13247      REAL SERUK2
13248      REAL SEHDK1
13249      REAL SEHDK2
13250      REAL XDLK2
13251      REAL XDLK3
13252      REAL SEGCI
13253      REAL XFW
13254      REAL XFWS2
13255      REAL SEFWK1
13256      REAL SEFWK2
13257      REAL XBCP
13258      REAL XBCPSE
13259      REAL XBCPK1
13260      REAL XBCPK2
13261      REAL YDL2
13262      REAL XMEDME
13263      REAL SEMED
13264      REAL SEMED2
13265      REAL SEMEDB
13266      REAL SEMDB2
13267      REAL STS2B
13268      REAL STXMU
13269      REAL SEMEK1
13270      REAL SEMEK2
13271      REAL ALOWCL
13272      REAL AUPPCL
13273      REAL XH15
13274      REAL SEHMK1
13275      REAL SEHMK2
13276      REAL H15LCL
13277      REAL H15UCL
13278C
13279      CHARACTER*4 IOP
13280C
13281C----------------------------------------------------------------
13282C
13283      REAL Y1(*)
13284      REAL Y2(*)
13285      REAL Y3(*)
13286      REAL PLABID(*)
13287      REAL AMEAN(*)
13288      REAL ASD(*)
13289      REAL AMEANF(*)
13290      REAL ASDF(*)
13291      REAL XTEMP1(*)
13292      REAL XTEMP2(*)
13293      REAL XTEMP3(*)
13294      REAL XTEMP4(*)
13295      REAL XPLOT(*)
13296      REAL YPLOT(*)
13297C
13298      INTEGER N(*)
13299      INTEGER NFULL(*)
13300      INTEGER ITEMP1(*)
13301C
13302      REAL DAT(*)
13303      DOUBLE PRECISION X(*)
13304      DOUBLE PRECISION T(*)
13305      DOUBLE PRECISION W(*)
13306      DOUBLE PRECISION DTEMP1(*)
13307      DOUBLE PRECISION DTEMP2(*)
13308      DOUBLE PRECISION DTEMP3(*)
13309C
13310      COMMON /MPCOM/ T0, T1
13311C
13312      INCLUDE 'DPCOST.INC'
13313C
13314      CHARACTER*4 IBOBSV
13315      CHARACTER*4 IBCPSV
13316      CHARACTER*4 IUNCFL
13317      CHARACTER*4 IDFFL
13318C
13319      INTEGER NUMDIG
13320C
13321      INCLUDE 'DPCOP2.INC'
13322C
13323C-----START POINT------------------------------------------------
13324C
13325      IERROR='NO'
13326      IPTEMP=IPRINT
13327      IFLAG9=.TRUE.
13328      IUNCFL='OFF'
13329      IDFFL='OFF'
13330      ISUBN1='DPMA'
13331      ISUBN2='N2  '
13332C
13333      IBOBSV=IBOBCM
13334      IBCPSV=IBCPCM
13335C
13336      XMPS=CPUMIN
13337      XMMPS=CPUMIN
13338      XMLS=CPUMIN
13339      XDL=CPUMIN
13340      XGD=CPUMIN
13341      XFW=CPUMIN
13342      XGCI=CPUMIN
13343      XGRAND=CPUMIN
13344      ASM=CPUMIN
13345      XSE=CPUMIN
13346      XBCP=CPUMIN
13347C
13348      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN2')THEN
13349        WRITE(ICOUT,999)
13350  999   FORMAT(1X)
13351        CALL DPWRST('XXX','BUG ')
13352        WRITE(ICOUT,51)
13353   51   FORMAT('***** AT THE BEGINNING OF DPMAN2--')
13354        CALL DPWRST('XXX','BUG ')
13355        WRITE(ICOUT,52)NPTS,NUMVAR,IFORSW
13356   52   FORMAT('NPTS,NUMVAR,IFORSW = ',2I8,2X,A4)
13357        CALL DPWRST('XXX','BUG ')
13358        DO55I=1,NPTS
13359          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I),PLABID(I)
13360   56     FORMAT('I,Y1(I),Y2(I),Y3(I),PLABID(I) = ',I8,4G15.7)
13361          CALL DPWRST('XXX','BUG ')
13362   55   CONTINUE
13363      ENDIF
13364C
13365C               ********************************************
13366C               **  STEP 1--                              **
13367C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
13368C               ********************************************
13369C
13370      IF(NPTS.LT.2)THEN
13371        WRITE(ICOUT,999)
13372        CALL DPWRST('XXX','WRIT')
13373        WRITE(ICOUT,101)
13374  101   FORMAT('***** ERROR IN CONSENSUS MEANS--')
13375        CALL DPWRST('XXX','WRIT')
13376        WRITE(ICOUT,102)
13377  102   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE CONSENSUS',
13378     1         'MEANS ANALYSIS')
13379        CALL DPWRST('XXX','WRIT')
13380        WRITE(ICOUT,103)
13381  103   FORMAT('      MUST BE AT LEAST 2; THE ENTERED NUMBER OF')
13382        CALL DPWRST('XXX','WRIT')
13383        WRITE(ICOUT,104)NPTS
13384  104   FORMAT('      OF OBSERVATIONS HERE = ',I6)
13385        CALL DPWRST('XXX','WRIT')
13386        WRITE(ICOUT,999)
13387        CALL DPWRST('XXX','WRIT')
13388        IERROR='YES'
13389        GOTO9000
13390      ENDIF
13391C
13392C               **************************************************
13393C               **  STEP 1.1--                                  **
13394C               **   OPEN THE STORAGE FILES                     **
13395C               **************************************************
13396C
13397      ISTEPN='1.1'
13398      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAN2')
13399     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
13400C
13401      IOP='OPEN'
13402      IFLAG1=1
13403      IFLAG2=1
13404      IFLAG3=1
13405      IFLAG4=1
13406      IFLAG5=1
13407      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
13408     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
13409     1            IBUGA3,ISUBRO,IERROR)
13410      IF(IERROR.EQ.'YES')GOTO9000
13411C
13412      NUMDIG=7
13413      IF(IFORSW.EQ.'1')NUMDIG=1
13414      IF(IFORSW.EQ.'2')NUMDIG=2
13415      IF(IFORSW.EQ.'3')NUMDIG=3
13416      IF(IFORSW.EQ.'4')NUMDIG=4
13417      IF(IFORSW.EQ.'5')NUMDIG=5
13418      IF(IFORSW.EQ.'6')NUMDIG=6
13419      IF(IFORSW.EQ.'7')NUMDIG=7
13420      IF(IFORSW.EQ.'8')NUMDIG=8
13421      IF(IFORSW.EQ.'9')NUMDIG=9
13422      IF(IFORSW.EQ.'0')NUMDIG=0
13423      IF(IFORSW.EQ.'E')NUMDIG=-7
13424      IF(IFORSW.EQ.'-2')NUMDIG=-2
13425      IF(IFORSW.EQ.'-3')NUMDIG=-3
13426      IF(IFORSW.EQ.'-4')NUMDIG=-4
13427      IF(IFORSW.EQ.'-5')NUMDIG=-5
13428      IF(IFORSW.EQ.'-6')NUMDIG=-6
13429      IF(IFORSW.EQ.'-7')NUMDIG=-7
13430      IF(IFORSW.EQ.'-8')NUMDIG=-8
13431      IF(IFORSW.EQ.'-9')NUMDIG=-9
13432C
13433C               ***********************************************
13434C               **  STEP 2.1--                               **
13435C               **  IF TWO VARIABLES ENTERED, THEN           **
13436C               **     Y1 = RESPONSE VARIABLE                **
13437C               **     Y2 = LAB ID VARIABLE                  **
13438C               **  1) COPY RESPONSE DATA TO "DAT"           **
13439C               **  2) DETERMINE NUMBER OF DISTINCT LABS     **
13440C               **  3) SORT RESPONSE (DAT) BY LAB ID         **
13441C               **  4) DETERMINE NUMER OF POINTS IN EACH LAB **
13442C               ***********************************************
13443C
13444      IF(NUMVAR.GE.3)GOTO6100
13445C
13446      CALL DPMAN3(Y1,Y2,Y3,NPTS,NUMVAR,NLAB,
13447     1            DAT,X,T,
13448     1            AMEAN,ASD,N,
13449     1            AMEANF,ASDF,NFULL,NLABF,NPTSF,
13450     1            IHLEFT,IHLEF2,IHRIGH,IHRIG2,
13451     1            ASM,ASD2,ASD3,
13452     1            XGRAND,S2WPOO,SW,
13453     1            AMNX,AMXX,
13454     1            IWRITE,IOUNI1,
13455     1            ICAPSW,ICAPTY,NUMDIG,
13456     1            ISUBRO,IBUGA3,IERROR)
13457      IF(IERROR.EQ.'YES')GOTO9000
13458C
13459C     FEBRUARY 2007: FOR BOB, SUPPRESS IF NLAB > 5.  FOR
13460C                    BAYESIAN CONSENSUS PROCEDURE, SUPPRESS
13461C                    IF NLAB > 6.
13462C
13463      IF(NLAB.GT.6)IBCPCM='OFF'
13464      IF(NLAB.GT.5)IBOBCM='OFF'
13465C
13466      IF(IERROR.EQ.'YES')GOTO9000
13467C
13468C     FOLLOWING CALL NEEDED TO INITIALIZE MANDEL-PAULE
13469C     AND VANGEL-RUKHIN METHODS
13470C
13471      CALL MPPREP (NLAB, X, T, T0, T1)
13472C
13473C     MANDEL-PAULE
13474C
13475      IF(IMPACM.EQ.'ON' .OR. IVRUCM.EQ.'ON' .OR. ISCECM.EQ.'ON')THEN
13476        IFLAGZ=0
13477        IF(IMPACM.EQ.'OFF' .AND. IVRUCM.EQ.'OFF')IFLAGZ=1
13478        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13479        IF(IFLAGZ.EQ.1)THEN
13480          IPRISV=IPRINT
13481          IPRINT='OFF'
13482        ENDIF
13483        CALL DPMNPL(Y1,Y2,Y3,NPTS,NLAB,
13484     1              X,T,N,
13485     1              XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
13486     1              DLOWMP,DHIGMP,STXMU,STS2B,
13487     1              IWRITE,
13488     1              ICAPSW,ICAPTY,NUMDIG,
13489     1              ISUBRO,IBUGA3,IERROR)
13490        IF(IFLAGZ.EQ.1)THEN
13491          IPRINT=IPRISV
13492        ENDIF
13493C
13494        WRITE(IOUNI5,1122)
13495 1122   FORMAT('WEIGHTS FOR MANDEL-PAULE')
13496        DO1123I=1,NLAB
13497          DTERM1=DBLE(ASD(I))**2/DBLE(N(I))
13498          WITEMP=1.0D0/(S2BMPS + DTERM1)
13499          WRITE(IOUNI5,'(E15.7)')WITEMP
13500 1123   CONTINUE
13501C
13502      ENDIF
13503C
13504C     MODIFIED MANDEL-PAULE
13505C
13506      IF(IMMPCM.EQ.'ON')THEN
13507        IFLAGZ=0
13508        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13509        IF(IFLAGZ.EQ.1)THEN
13510          IPRISV=IPRINT
13511          IPRINT='OFF'
13512        ENDIF
13513        CALL DPMMPL(Y1,Y2,Y3,NPTS,NLAB,
13514     1              X,T,N,
13515     1              XMMPS,S2BMMP,SEMMP,SEMMP1,SEMMP2,
13516     1              DLOWMM,DHIGMM,
13517     1              IWRITE,
13518     1              ICAPSW,ICAPTY,NUMDIG,
13519     1              ISUBRO,IBUGA3,IERROR)
13520        IF(IFLAGZ.EQ.1)THEN
13521          IPRINT=IPRISV
13522        ENDIF
13523C
13524        WRITE(IOUNI5,1132)
13525 1132   FORMAT('WEIGHTS FOR MODIFIED MANDEL-PAULE')
13526        DO1133I=1,NLAB
13527          DTERM1=DBLE(ASD(I))**2/DBLE(N(I))
13528          WITEMP=1.0D0/(S2BMMP + DTERM1)
13529          WRITE(IOUNI5,'(E15.7)')WITEMP
13530 1133   CONTINUE
13531C
13532      ENDIF
13533C
13534C     VANGEL-RUKHIN MAXIMUM LIKELIHOOD
13535C
13536      IF(IVRUCM.EQ.'ON')THEN
13537        IFLAGZ=0
13538        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13539        IF(IFLAGZ.EQ.1)THEN
13540          IPRISV=IPRINT
13541          IPRINT='OFF'
13542        ENDIF
13543        CALL DPVRML(NPTS,NLAB,
13544     1              AMEAN,ASD,N,
13545     1              XTEMP3(1),XTEMP3(MAXNXT/2),ITEMP1,XTEMP1,XTEMP2,
13546     1              X,T,W,DTEMP1,DTEMP2,
13547     1              XMLS,S2BMLS,SEML,SEMLK1,SEMLK2,
13548     1              DLOWML,DHIGML,STXMU,STS2B,
13549     1              SEMLBO,DLOWM2,DHIGM2,
13550     1              IWRITE,
13551     1              ICAPSW,ICAPTY,IOUNI5,NUMDIG,ISEED,
13552     1              ISUBRO,IBUGA3,IERROR)
13553        IF(IFLAGZ.EQ.1)THEN
13554          IPRINT=IPRISV
13555        ENDIF
13556      ENDIF
13557C
13558C  DERSIMONIAN LAIRD
13559C
13560      IF(IDSLCM.EQ.'ON' .OR. IDS2CM.EQ.'ON' .OR.
13561     1   IDS3CM.EQ.'ON' .OR. IDS4CM.EQ.'ON')THEN
13562        IFLAGZ=0
13563        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13564        IF(IFLAGZ.EQ.1)THEN
13565          IPRISV=IPRINT
13566          IPRINT='OFF'
13567        ENDIF
13568        CALL DPDERS(NPTS,NLAB,
13569     1              AMEAN,ASD,N,
13570     1              XTEMP3(1),XTEMP3(MAXNXT/2),ITEMP1,XTEMP1,XTEMP2,
13571     1              XTEMP4,DTEMP1,DTEMP2,DTEMP3,
13572     1              YPLOT,XPLOT,NPLOT,
13573     1              XDL,XDLS2,YDL,SEDLK1,SEDLK2,DLOWDL,DHIGDL,
13574     1              SERUK1,SERUK2,DLOWD2,DHIGD2,
13575     1              SEHDK1,SEHDK2,DLOWD3,DHIGD3,
13576     1              SEBOK1,SEBOK2,DLOWD4,DHIGD4,
13577     1              DLOWD5,DHIGD5,DLOWD6,DHIGD6,
13578     1              XDLK2,XDLK3,
13579     1              IWRITE,IOUNI5,
13580     1              ICAPSW,ICAPTY,NUMDIG,ISEED,IBOOSS,
13581     1              ISUBRO,IBUGA3,IERROR)
13582        YDL2=REAL(YDL)
13583        IF(IFLAGZ.EQ.1)THEN
13584          IPRINT=IPRISV
13585        ENDIF
13586      ENDIF
13587C
13588C  GRAYBILL-DEAL
13589C
13590      IF(IGRDCM.EQ.'ON')THEN
13591        IFLAGZ=0
13592        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13593        IF(IFLAGZ.EQ.1)THEN
13594          IPRISV=IPRINT
13595          IPRINT='OFF'
13596        ENDIF
13597        CALL DPGRAY(NPTS,NLAB,
13598     1              AMEAN,ASD,N,
13599     1              XGD,XGDS2,SEGDK1,SEGDK2,
13600     1              XGDS20,XGDSZ1,XGDSZ2,
13601     1              DLOWGD,DHIGGD,
13602     1              IWRITE,IOUNI5,
13603     1              ICAPSW,ICAPTY,NUMDIG,
13604     1              ISUBRO,IBUGA3,IERROR)
13605        IF(IFLAGZ.EQ.1)THEN
13606          IPRINT=IPRISV
13607        ENDIF
13608      ENDIF
13609C
13610C  FAIRWEATHER
13611C
13612      IF(IFAICM.EQ.'ON')THEN
13613        IFLAGZ=0
13614        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13615        IF(IFLAGZ.EQ.1)THEN
13616          IPRISV=IPRINT
13617          IPRINT='OFF'
13618        ENDIF
13619        CALL DPFAIR(NPTS,NLAB,
13620     1              AMEAN,ASD,N,
13621     1              XFW,XFWS2,SEFWK1,SEFWK2,
13622     1              DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
13623     1              IWRITE,
13624     1              ICAPSW,ICAPTY,IFLAG9,NUMDIG,
13625     1              ISUBRO,IBUGA3,IERROR)
13626        IF(IFLAGZ.EQ.1)THEN
13627          IPRINT=IPRISV
13628        ENDIF
13629      ENDIF
13630C
13631C  IYER-WANG GENERALIZED CONFIDENCE INTERVAL
13632C
13633      IF(IGCICM.EQ.'ON')THEN
13634        IFLAGZ=0
13635        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13636        IF(IFLAGZ.EQ.1)THEN
13637          IPRISV=IPRINT
13638          IPRINT='OFF'
13639        ENDIF
13640        CALL DPGCI(NPTS,NLAB,
13641     1             AMEAN,ASD,N,
13642     1             T,W,
13643     1             XGCI,SEGCI,
13644     1             DLOWGC,DHIGGC,
13645     1             IWRITE,IOUNI5,
13646     1             ICAPSW,ICAPTY,NUMDIG,
13647     1             ISUBRO,IBUGA3,IERROR)
13648        IF(IFLAGZ.EQ.1)THEN
13649          IPRINT=IPRISV
13650        ENDIF
13651      ENDIF
13652C
13653C     GRAND MEAN
13654C
13655      IF(IGMECM.EQ.'ON')THEN
13656        IFLAGZ=0
13657        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13658        IF(IFLAGZ.EQ.1)THEN
13659          IPRISV=IPRINT
13660          IPRINT='OFF'
13661        ENDIF
13662        CALL DPGMEA(NPTSF,NLABF,
13663     1              XGRAND,ASD2,SET1,SET1K1,SET1K2,
13664     1              DLOWT2,DHIGT2,
13665     1              IWRITE,
13666     1              ICAPSW,ICAPTY,NUMDIG,
13667     1              ISUBRO,IBUGA3,IERROR)
13668        IF(IFLAGZ.EQ.1)THEN
13669          IPRINT=IPRISV
13670        ENDIF
13671      ENDIF
13672C
13673C     MEAN OF MEANS
13674C
13675      IF(IMOMCM.EQ.'ON')THEN
13676        IFLAGZ=0
13677        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13678        IF(IFLAGZ.EQ.1)THEN
13679          IPRISV=IPRINT
13680          IPRINT='OFF'
13681        ENDIF
13682        CALL DPMMEA(NPTSF,NLABF,
13683     1              ASM,ASD2,SET2,SET2K1,SET2K2,
13684     1              DLOWT1,DHIGT1,
13685     1              IWRITE,
13686     1              ICAPSW,ICAPTY,NUMDIG,
13687     1              ISUBRO,IBUGA3,IERROR)
13688        IF(IFLAGZ.EQ.1)THEN
13689          IPRINT=IPRISV
13690        ENDIF
13691      ENDIF
13692C
13693C     BOB (BOUND ON BIAS)
13694C
13695      IF(IBOBCM.EQ.'ON')THEN
13696        IFLAGZ=0
13697        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13698        IF(IFLAGZ.EQ.1)THEN
13699          IPRISV=IPRINT
13700          IPRINT='OFF'
13701        ENDIF
13702        CALL DPBOB(NPTSF,NLABF,
13703     1             AMEANF,ASDF,AMNX,AMXX,SW,
13704     1             ASM,ASB,AKU,AKUK1,AKUK2,
13705     1             DLOWBO,DHIGBO,
13706     1             IWRITE,
13707     1             ICAPSW,ICAPTY,NUMDIG,
13708     1             ISUBRO,IBUGA3,IERROR)
13709        IF(IFLAGZ.EQ.1)THEN
13710          IPRINT=IPRISV
13711        ENDIF
13712      ENDIF
13713C
13714C     SCHILLER-EBERHARDT
13715C
13716      IF(ISCECM.EQ.'ON')THEN
13717        IFLAGZ=0
13718        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13719        IF(IFLAGZ.EQ.1)THEN
13720          IPRISV=IPRINT
13721          IPRINT='OFF'
13722        ENDIF
13723        CALL DPSCEB(NPTS,NLAB,
13724     1              W,N,
13725     1              AMEAN,ASD,S2BMPS,
13726     1              XSE,XSES2,IDFH,SIGMAH,
13727     1              SESUK1,SESUK2,
13728     1              DLOWSE,DHIGSE,
13729     1              IWRITE,
13730     1              ICAPSW,ICAPTY,NUMDIG,
13731     1              ISUBRO,IBUGA3,IERROR)
13732        IF(IFLAGZ.EQ.1)THEN
13733          IPRINT=IPRISV
13734        ENDIF
13735      ENDIF
13736C
13737      IF(IBCPCM.EQ.'ON')THEN
13738        IFLAGZ=0
13739        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13740        IF(IFLAGZ.EQ.1)THEN
13741          IPRISV=IPRINT
13742          IPRINT='OFF'
13743        ENDIF
13744        CALL DPBCP(NPTS,NLAB,
13745     1             AMEAN,ASD,N,AMNX,AMXX,
13746     1             XBCP,XBCPSE,XBCPK1,XBCPK2,
13747     1             DLOWBC,DHIGBC,
13748     1             IWRITE,
13749     1             ICAPSW,ICAPTY,NUMDIG,
13750     1             ISUBRO,IBUGA3,IERROR)
13751        IF(IFLAGZ.EQ.1)THEN
13752          IPRINT=IPRISV
13753        ENDIF
13754      ENDIF
13755C
13756C     MEDIAN OF MEANS
13757C
13758      IF(IMEMCM.EQ.'ON')THEN
13759        IFLAGZ=0
13760        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13761        IF(IFLAGZ.EQ.1)THEN
13762          IPRISV=IPRINT
13763          IPRINT='OFF'
13764        ENDIF
13765        CALL DPMEDM(NLAB,AMEANF,ASDF,XTEMP1,XTEMP2,
13766     1              IWRITE,ICAPSW,ICAPTY,NUMDIG,MAXNXT,
13767     1              XMEDME,SEMEK1,SEMEK2,ALOWCL,AUPPCL,
13768     1              ISUBRO,IBUGA3,IERROR)
13769        IF(IFLAGZ.EQ.1)THEN
13770          IPRINT=IPRISV
13771        ENDIF
13772      ENDIF
13773C
13774C     HUBER H15 MEAN OF MEANS
13775C
13776      IF(IHUBCM.EQ.'ON')THEN
13777        IFLAGZ=0
13778        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13779        IF(IFLAGZ.EQ.1)THEN
13780          IPRISV=IPRINT
13781          IPRINT='OFF'
13782        ENDIF
13783        CALL DPHMEA(NLAB,AMEANF,ASDF,XTEMP1,XTEMP2,
13784     1              IWRITE,ICAPSW,ICAPTY,NUMDIG,MAXNXT,
13785     1              XH15,SEHMK1,SEHMK2,H15LCL,H15UCL,
13786     1              ISUBRO,IBUGA3,IERROR)
13787        IF(IFLAGZ.EQ.1)THEN
13788          IPRINT=IPRISV
13789        ENDIF
13790      ENDIF
13791C
13792C     MEDIAN OF MEANS
13793C
13794CCCCC IF(IMEMCM.EQ.'ON')THEN
13795CCCCC   IFLAGZ=0
13796CCCCC   IF(ICMET5.EQ.'OFF')IFLAGZ=1
13797CCCCC   IF(IFLAGZ.EQ.1)THEN
13798CCCCC     IPRISV=IPRINT
13799CCCCC     IPRINT='OFF'
13800CCCCC   ENDIF
13801CCCCC   CALL DPMMED(NPTSF,NLABF,AMEANF,ASDF,
13802CCCCC1              XTEMP1,XTEMP2,XTEMP3,XTEMP4,ITEMP1,
13803CCCCC1              DTEMP1,DTEMP2,DTEMP3,
13804CCCCC1              XMEDME,SEMED,SEMEDB,
13805CCCCC1              DLWME0,DHGME0,DLWME1,DHGME1,
13806CCCCC1              DLWME2,DHGME2,DLWME3,DHGME3,
13807CCCCC1              IWRITE,IOUNI5,MAXNXT,
13808CCCCC1              ICAPSW,ICAPTY,NUMDIG,ISEED,IBOOSS,
13809CCCCC1              ISUBRO,IBUGA3,IERROR)
13810CCCCC   IF(IFLAGZ.EQ.1)THEN
13811CCCCC     IPRINT=IPRISV
13812CCCCC   ENDIF
13813CCCCC ENDIF
13814C
13815C     CONFIDENCE LIMITS TABLE
13816C
13817      CALL DPMAN5(NPTS,NLAB,
13818     1XGRAND,XMPS,XMMPS,XMLS,XSE,
13819     1ASM,XGD,XGCI,XDL,XFW,XBCP,
13820     1DLOWMP,DHIGMP,DLOWMM,DHIGMM,DLOWML,DHIGML,DLOWM2,DHIGM2,
13821     1DLOWBO,DHIGBO,DLOWSE,DHIGSE,DLOWT1,DHIGT1,
13822     1DLOWT2,DHIGT2,DLOWGD,DHIGGD,DLOWGC,DHIGGC,
13823     1DLOWDL,DHIGDL,DLOWD2,DHIGD2,DLOWD3,DHIGD3,DLOWD4,DHIGD4,
13824     1DLOWD5,DHIGD5,DLOWD6,DHIGD6,
13825     1DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
13826     1DLOWBC,DHIGBC,
13827     1XMEDME,SEMED,
13828     1DLWME0,DHGME0,DLWME1,DHGME1,
13829     1DLWME2,DHGME2,DLWME3,DHGME3,
13830     1SEMPK1,SEMMP1,SEMLK1,SEMLBO,AKUK1,SESUK1,SET2K1,
13831     1SET1K1,SEGDK1,SEDLK1,SEHDK1,SERUK1,SEBOK1,SEGCI,
13832     1SEFWK1,XBCPK1,SEMEDB,ALOWCL,AUPPCL,SEMEK1,
13833     1XH15,SEHMK1,
13834     1IWRITE,IOUNI2,
13835     1ICAPSW,ICAPTY,NUMDIG,IFLAG9,
13836     1ISUBRO,IBUGA3,IERROR)
13837C
13838C     STANDARD AND EXPANDED UNCERTAINTIES TABLE
13839C
13840      IK=1
13841      CALL DPMAN6(NPTS,NLAB,
13842     1XGRAND,XMPS,XMMPS,XMLS,XSE,
13843     1ASM,XGD,XDL,XGCI,XFW,XBCP,
13844     1SEMPK1,SEMMP1,SEMLK1,SEMLBO,AKUK1,SESUK1,SET1K1,
13845     1SET2K1,SEGDK1,SEDLK1,SEHDK1,SERUK1,SEBOK1,SEGCI,SEFWK1,XBCPK1,
13846     1XMEDME,SEMED,SEMEDB,SEMEK1,XH15,SEHMK1,
13847     1IWRITE,
13848     1ICAPSW,ICAPTY,IK,IOUNI3,NUMDIG,IFLAG9,
13849     1ISUBRO,IBUGA3,IERROR)
13850C
13851      IK=2
13852      SEMLB2=2.0*SEMLBO
13853      SEMED2=2.0*SEMED
13854      SEMDB2=2.0*SEMEDB
13855      CALL DPMAN6(NPTS,NLAB,
13856     1XGRAND,XMPS,XMMPS,XMLS,XSE,
13857     1ASM,XGD,XDL,XGCI,XFW,XBCP,
13858     1SEMPK2,SEMMP2,SEMLK2,SEMLB2,AKUK2,SESUK2,SET1K2,
13859     1SET2K2,SEGDK2,SEDLK2,SEHDK2,SERUK2,SEBOK2,
13860     12.0*SEGCI,SEFWK2,XBCPK2,
13861     1XMEDME,SEMED2,SEMDB2,SEMEK2,XH15,SEHMK2,
13862     1IWRITE,
13863     1ICAPSW,ICAPTY,IK,IOUNI4,NUMDIG,IFLAG9,
13864     1ISUBRO,IBUGA3,IERROR)
13865C
13866      GOTO8000
13867C
13868C               ***********************************************
13869C               **  STEP 2.1--                               **
13870C               **  IF THREE VARIABLES ENTERED, THEN FIRST   **
13871C               **  VARIABLE IS LAB MEANS, SECOND VARIABLE IS**
13872C               **  LAB SD, AND THIRD VARIABLE IS NUMBER OF  **
13873C               **  OBSERVATIONS FOR LAB.                    **
13874C               ***********************************************
13875C
13876C     2014/10: SUPPORT FOR CASE WHERE DATA GIVEN IN THE FORM OF
13877C              LAB MEAN AND LAB UNCERTAINTY (I.E., S/SQRT(N)).
13878C              DATA FROM EXTERNAL LABS IS OFTEN REPORTED IN THIS
13879C              FORM.
13880C
13881C              FOR THIS TYPE OF DATA, THE "SAMPLE SIZE" FIELD
13882C              CAN BE ENTERED IN ONE OF THE FOLLOWING TWO WAYS:
13883C
13884C                  1) IF THE SAMPLE SIZE IS GIVEN AS A NEGATIVE
13885C                     VALUE, THEN THE ABSOLUTE VALUE OF THE
13886C                     SAMPLE SIZE WILL BE INTERPRETED AS THE
13887C                     "EFFECTIVE DEGREES OF FREEDOM".  NOTE THAT
13888C                     IN MANY OF THE FORMULAS, THERE WILL BE
13889C
13890C                         S(i)/N(i)
13891C
13892C                     TERMS.  FOR NEGATIVE SAMPLE SIZE, THE S(i)
13893C                     ENTERED WILL BE INTERPRETED AS S(i)/N(i) FOR
13894C                     THESE FORMULAS.  SOME FORMULAS WILL HAVE AN
13895C                     "N(i) - C" TERM.  THESE FORMULAS WILL USE THE
13896C                     ABSOLUTE VALUE OF THE SAMPLE SIZE FOR N(i).
13897C
13898C                  1) IF THE SAMPLE SIZE IS GIVEN AS 0, THEN THIS MEANS
13899C                     NO EFFECTIVE DEGREES OF FREEDOM ARE AVAILABLE.
13900C                     FOR THIS CASE, FORMULAS THAT REQUIRE "N(i) - C"
13901C                     TERMS WILL NOT BE SUPPORTED.
13902C
13903 6100 CONTINUE
13904C
13905      WRITE(ICOUT,999)
13906      CALL DPWRST('XXX','WRIT')
13907C
13908      NLAB=NPTS
13909      IF(NLAB.LT.2)THEN
13910        WRITE(ICOUT,999)
13911        CALL DPWRST('XXX','WRIT')
13912        WRITE(ICOUT,6211)
13913 6211   FORMAT('***** ERROR IN CONSENSUS MEANS ANALYSIS--')
13914        CALL DPWRST('XXX','WRIT')
13915        WRITE(ICOUT,6212)
13916 6212   FORMAT('      FOR THE SUMMARY CASE OF THE CONSENSUS MEANS')
13917        CALL DPWRST('XXX','WRIT')
13918        WRITE(ICOUT,6214)
13919 6214   FORMAT('      COMMAND, THERE MUST BE AT LEAST TWO LABS.')
13920        CALL DPWRST('XXX','WRIT')
13921        WRITE(ICOUT,6220)
13922 6220   FORMAT('      SUCH WAS NOT THE CASE HERE.')
13923        CALL DPWRST('XXX','WRIT')
13924        IERROR='YES'
13925        GOTO9000
13926      ENDIF
13927C
13928      NTOT=0
13929      IF(NUMVAR.GE.3)THEN
13930        DO6110I=1,NLAB
13931          IF(Y3(I).GE.0.0)THEN
13932            IVAL=INT(Y3(I)+0.5)
13933          ELSE
13934            AVAL=ABS(Y3(I))
13935            IVAL=INT(AVAL+0.5)
13936          ENDIF
13937          N(I)=IVAL
13938          NTOT=NTOT+N(I)
13939 6110   CONTINUE
13940      ENDIF
13941C
13942      CALL DPMAN4(Y1,Y2,Y3,PLABID,NLAB,NTOT,NUMVAR,
13943     1            DAT,X,T,
13944     1            AMEAN,ASD,N,
13945     1            AMEANF,ASDF,NFULL,NLABF,NTOTF,
13946     1            IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
13947     1            ASM,ASD2,ASD3,SDGRAN,
13948     1            XGRAND,S2WPOO,SW,
13949     1            AMNX,AMXX,
13950     1            IWRITE,IOUNI1,
13951     1            ICAPSW,ICAPTY,NUMDIG,IUNCFL,IDFFL,
13952     1            ISUBRO,IBUGA3,IERROR)
13953C
13954      IF(IERROR.EQ.'YES')GOTO9000
13955C
13956CCCCC CALL MPPREP (NLAB, X, T, T0, T1)
13957C
13958      EPS=0.00001
13959      T0=AMNX - EPS
13960      T1=AMXX
13961      DO6120I=1,NLAB
13962        X(I)=(X(I)-T0)/(T1-T0)
13963        T(I)=T(I)/((T1-T0)**2)
13964 6120 CONTINUE
13965C
13966C
13967C     MANDEL-PAULE
13968C
13969      IF(IMPACM.EQ.'ON' .OR. IVRUCM.EQ.'ON' .OR. ISCECM.EQ.'ON')THEN
13970        IFLAGZ=0
13971        IF(IMPACM.EQ.'OFF' .AND. IVRUCM.EQ.'OFF')IFLAGZ=1
13972        IF(ICMET5.EQ.'OFF')IFLAGZ=1
13973        IF(IFLAGZ.EQ.1)THEN
13974          IPRISV=IPRINT
13975          IPRINT='OFF'
13976        ENDIF
13977        CALL DPMNPL(Y1,Y2,Y3,NTOT,NLAB,
13978     1              X,T,N,
13979     1              XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
13980     1              DLOWMP,DHIGMP,STXMU,STS2B,
13981     1              IWRITE,
13982     1              ICAPSW,ICAPTY,NUMDIG,
13983     1              ISUBRO,IBUGA3,IERROR)
13984        IF(IFLAGZ.EQ.1)THEN
13985          IPRINT=IPRISV
13986        ENDIF
13987C
13988        WRITE(IOUNI5,6122)
13989 6122   FORMAT('WEIGHTS FOR MANDEL-PAULE')
13990        DO6123I=1,NLAB
13991          DTERM1=DBLE(Y2(I))**2/DBLE(N(I))
13992          WITEMP=1.0D0/(S2BMPS + DTERM1)
13993          WRITE(IOUNI5,'(E15.7)')WITEMP
13994 6123   CONTINUE
13995C
13996      ENDIF
13997C
13998C     MODIFIED MANDEL-PAULE
13999C
14000      IF(IMMPCM.EQ.'ON')THEN
14001        IFLAGZ=0
14002        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14003        IF(IFLAGZ.EQ.1)THEN
14004          IPRISV=IPRINT
14005          IPRINT='OFF'
14006        ENDIF
14007        CALL DPMMPL(Y1,Y2,Y3,NTOT,NLAB,
14008     1              X,T,N,
14009     1              XMMPS,S2BMMP,SEMMP,SEMMP1,SEMMP2,
14010     1              DLOWMM,DHIGMM,
14011     1              IWRITE,
14012     1              ICAPSW,ICAPTY,NUMDIG,
14013     1              ISUBRO,IBUGA3,IERROR)
14014        IF(IFLAGZ.EQ.1)THEN
14015          IPRINT=IPRISV
14016        ENDIF
14017C
14018        WRITE(IOUNI5,6132)
14019 6132   FORMAT('WEIGHTS FOR MODIFIED MANDEL-PAULE')
14020        DO6133I=1,NLAB
14021          DTERM1=DBLE(Y2(I))**2/DBLE(N(I))
14022          WITEMP=1.0D0/(S2BMMP + DTERM1)
14023          WRITE(IOUNI5,'(E15.7)')WITEMP
14024 6133   CONTINUE
14025C
14026      ENDIF
14027C
14028C     VANGEL-RUKHIN MAXIMUM LIKELIHOOD
14029C
14030      IF(IVRUCM.EQ.'ON' .AND. IDFFL.EQ.'OFF')THEN
14031        IFLAGZ=0
14032        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14033        IF(IFLAGZ.EQ.1)THEN
14034          IPRISV=IPRINT
14035          IPRINT='OFF'
14036        ENDIF
14037        CALL DPVRML(NTOT,NLAB,
14038     1              AMEAN,ASD,N,
14039     1              XTEMP3(1),XTEMP3(MAXNXT/2),ITEMP1,XTEMP1,XTEMP2,
14040     1              X,T,W,DTEMP1,DTEMP2,
14041     1              XMLS,S2BMLS,SEML,SEMLK1,SEMLK2,
14042     1              DLOWML,DHIGML,STXMU,STS2B,
14043     1              SEMLBO,DLOWM2,DHIGM2,
14044     1              IWRITE,
14045     1              ICAPSW,ICAPTY,IOUNI5,NUMDIG,ISEED,
14046     1              ISUBRO,IBUGA3,IERROR)
14047        IF(IFLAGZ.EQ.1)THEN
14048          IPRINT=IPRISV
14049        ENDIF
14050      ENDIF
14051C
14052C  DERSIMONIAN LAIRD
14053C
14054      IF(IDSLCM.EQ.'ON' .OR. IDS2CM.EQ.'ON' .OR.
14055     1   IDS3CM.EQ.'ON' .OR. IDS4CM.EQ.'ON')THEN
14056        IFLAGZ=0
14057        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14058        IF(IFLAGZ.EQ.1)THEN
14059          IPRISV=IPRINT
14060          IPRINT='OFF'
14061        ENDIF
14062        CALL DPDERS(NTOT,NLAB,
14063     1              AMEAN,ASD,N,
14064     1              XTEMP3(1),XTEMP3(MAXNXT/2),ITEMP1,
14065     1              XTEMP1,XTEMP2,XTEMP4,
14066     1              DTEMP1,DTEMP2,DTEMP3,
14067     1              YPLOT,XPLOT,NPLOT,
14068     1              XDL,XDLS2,YDL,SEDLK1,SEDLK2,DLOWDL,DHIGDL,
14069     1              SERUK1,SERUK2,DLOWD2,DHIGD2,
14070     1              SEHDK1,SEHDK2,DLOWD3,DHIGD3,
14071     1              SEBOK1,SEBOK2,DLOWD4,DHIGD4,
14072     1              DLOWD5,DHIGD5,DLOWD6,DHIGD6,
14073     1              XDLK2,XDLK3,
14074     1              IWRITE,IOUNI5,
14075     1              ICAPSW,ICAPTY,NUMDIG,ISEED,IBOOSS,
14076     1              ISUBRO,IBUGA3,IERROR)
14077        YDL2=REAL(YDL)
14078        IF(IFLAGZ.EQ.1)THEN
14079          IPRINT=IPRISV
14080        ENDIF
14081      ENDIF
14082C
14083C  GRAYBILL-DEAL
14084C
14085      IF(IGRDCM.EQ.'ON')THEN
14086        IFLAGZ=0
14087        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14088        IF(IFLAGZ.EQ.1)THEN
14089          IPRISV=IPRINT
14090          IPRINT='OFF'
14091        ENDIF
14092        CALL DPGRAY(NTOT,NLAB,
14093     1              AMEAN,ASD,N,
14094     1              XGD,XGDS2,SEGDK1,SEGDK2,
14095     1              XGDS20,XGDSZ1,XGDSZ2,
14096     1              DLOWGD,DHIGGD,
14097     1              IWRITE,IOUNI5,
14098     1              ICAPSW,ICAPTY,NUMDIG,
14099     1              ISUBRO,IBUGA3,IERROR)
14100        IF(IFLAGZ.EQ.1)THEN
14101          IPRINT=IPRISV
14102        ENDIF
14103      ENDIF
14104C
14105C  FAIRWEATHER
14106C
14107      IF(IFAICM.EQ.'ON' .AND. IUNCFL.EQ.'OFF')THEN
14108        IFLAGZ=0
14109        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14110        IF(IFLAGZ.EQ.1)THEN
14111          IPRISV=IPRINT
14112          IPRINT='OFF'
14113        ENDIF
14114        CALL DPFAIR(NTOT,NLAB,
14115     1              AMEAN,ASD,N,
14116     1              XFW,XFWS2,SEFWK1,SEFWK2,
14117     1              DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
14118     1              IWRITE,
14119     1              ICAPSW,ICAPTY,IFLAG9,NUMDIG,
14120     1              ISUBRO,IBUGA3,IERROR)
14121        IF(IFLAGZ.EQ.1)THEN
14122          IPRINT=IPRISV
14123        ENDIF
14124      ENDIF
14125C
14126C  IYER-WANG GENERALIZED CONFIDENCE INTERVAL
14127C
14128      IF(IGCICM.EQ.'ON' .AND. IDFFL.EQ.'OFF')THEN
14129        IFLAGZ=0
14130        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14131        IF(IFLAGZ.EQ.1)THEN
14132          IPRISV=IPRINT
14133          IPRINT='OFF'
14134        ENDIF
14135        CALL DPGCI(NTOT,NLAB,
14136     1             AMEAN,ASD,N,
14137     1             T,W,
14138     1             XGCI,SEGCI,
14139     1             DLOWGC,DHIGGC,
14140     1             IWRITE,IOUNI5,
14141     1             ICAPSW,ICAPTY,NUMDIG,
14142     1             ISUBRO,IBUGA3,IERROR)
14143        IF(IFLAGZ.EQ.1)THEN
14144          IPRINT=IPRISV
14145        ENDIF
14146      ENDIF
14147C
14148C     GRAND MEAN
14149C
14150      IF(IGMECM.EQ.'ON' .AND. IUNCFL.EQ.'OFF')THEN
14151        IFLAGZ=0
14152        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14153        IF(IFLAGZ.EQ.1)THEN
14154          IPRISV=IPRINT
14155          IPRINT='OFF'
14156        ENDIF
14157        CALL DPGMEA(NTOTF,NLABF,
14158     1              XGRAND,SDGRAN,SET1,SET1K1,SET1K2,
14159     1              DLOWT2,DHIGT2,
14160     1              IWRITE,
14161     1              ICAPSW,ICAPTY,NUMDIG,
14162     1              ISUBRO,IBUGA3,IERROR)
14163        IF(IFLAGZ.EQ.1)THEN
14164          IPRINT=IPRISV
14165        ENDIF
14166      ENDIF
14167C
14168C     MEAN OF MEANS
14169C
14170      IF(IMOMCM.EQ.'ON')THEN
14171        IFLAGZ=0
14172        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14173        IF(IFLAGZ.EQ.1)THEN
14174          IPRISV=IPRINT
14175          IPRINT='OFF'
14176        ENDIF
14177        CALL DPMMEA(NTOTF,NLABF,
14178     1              ASM,ASD2,SET2,SET2K1,SET2K2,
14179     1              DLOWT1,DHIGT1,
14180     1              IWRITE,
14181     1              ICAPSW,ICAPTY,NUMDIG,
14182     1              ISUBRO,IBUGA3,IERROR)
14183        IF(IFLAGZ.EQ.1)THEN
14184          IPRINT=IPRISV
14185        ENDIF
14186      ENDIF
14187C
14188C     BOB (BOUND ON BIAS)
14189C
14190      IF(IBOBCM.EQ.'ON')THEN
14191        IFLAGZ=0
14192        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14193        IF(IFLAGZ.EQ.1)THEN
14194          IPRISV=IPRINT
14195          IPRINT='OFF'
14196        ENDIF
14197        CALL DPBOB(NTOTF,NLABF,
14198     1             AMEANF,ASDF,AMNX,AMXX,SW,
14199     1             ASM,ASB,AKU,AKUK1,AKUK2,
14200     1             DLOWBO,DHIGBO,
14201     1             IWRITE,
14202     1             ICAPSW,ICAPTY,NUMDIG,
14203     1             ISUBRO,IBUGA3,IERROR)
14204        IF(IFLAGZ.EQ.1)THEN
14205          IPRINT=IPRISV
14206        ENDIF
14207      ENDIF
14208C
14209C     SCHILLER-EBERHARDT
14210C
14211      IF(ISCECM.EQ.'ON' .AND. IDFFL.EQ.'OFF')THEN
14212        IFLAGZ=0
14213        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14214        IF(IFLAGZ.EQ.1)THEN
14215          IPRISV=IPRINT
14216          IPRINT='OFF'
14217        ENDIF
14218        CALL DPSCEB(NTOT,NLAB,
14219     1              W,N,
14220     1              AMEAN,ASD,S2BMPS,
14221     1              XSE,XSES2,IDFH,SIGMAH,
14222     1              SESUK1,SESUK2,
14223     1              DLOWSE,DHIGSE,
14224     1              IWRITE,
14225     1              ICAPSW,ICAPTY,NUMDIG,
14226     1              ISUBRO,IBUGA3,IERROR)
14227        IF(IFLAGZ.EQ.1)THEN
14228          IPRINT=IPRISV
14229        ENDIF
14230      ENDIF
14231C
14232      IF(IBCPCM.EQ.'ON' .AND. IDFFL.EQ.'OFF')THEN
14233        IFLAGZ=0
14234        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14235        IF(IFLAGZ.EQ.1)THEN
14236          IPRISV=IPRINT
14237          IPRINT='OFF'
14238        ENDIF
14239        CALL DPBCP(NTOT,NLAB,
14240     1             AMEAN,ASD,N,AMNX,AMXX,
14241     1             XBCP,XBCPSE,XBCPK1,XBCPK2,
14242     1             DLOWBC,DHIGBC,
14243     1             IWRITE,
14244     1             ICAPSW,ICAPTY,NUMDIG,
14245     1             ISUBRO,IBUGA3,IERROR)
14246        IF(IFLAGZ.EQ.1)THEN
14247          IPRINT=IPRISV
14248        ENDIF
14249      ENDIF
14250C
14251C     MEDIAN OF MEANS
14252C
14253      IF(IMEMCM.EQ.'ON')THEN
14254        IFLAGZ=0
14255        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14256        IF(IFLAGZ.EQ.1)THEN
14257          IPRISV=IPRINT
14258          IPRINT='OFF'
14259        ENDIF
14260        CALL DPMEDM(NLAB,AMEANF,ASDF,XTEMP1,XTEMP2,
14261     1              IWRITE,ICAPSW,ICAPTY,NUMDIG,MAXNXT,
14262     1              XMEDME,SEMEK1,SEMEK2,ALOWCL,AUPPCL,
14263     1              ISUBRO,IBUGA3,IERROR)
14264        IF(IFLAGZ.EQ.1)THEN
14265          IPRINT=IPRISV
14266        ENDIF
14267      ENDIF
14268CCCCC IF(IMEMCM.EQ.'ON')THEN
14269CCCCC   IFLAGZ=0
14270CCCCC   IF(ICMET5.EQ.'OFF')IFLAGZ=1
14271CCCCC   IF(IFLAGZ.EQ.1)THEN
14272CCCCC     IPRISV=IPRINT
14273CCCCC     IPRINT='OFF'
14274CCCCC   ENDIF
14275CCCCC   CALL DPMMED(NTOTF,NLABF,AMEANF,ASDF,
14276CCCCC1              XTEMP1,XTEMP2,XTEMP3,XTEMP4,ITEMP1,
14277CCCCC1              DTEMP1,DTEMP2,DTEMP3,
14278CCCCC1              XMEDME,SEMED,SEMEDB,
14279CCCCC1              DLWME0,DHGME0,DLWME1,DHGME1,
14280CCCCC1              DLWME2,DHGME2,DLWME3,DHGME3,
14281CCCCC1              IWRITE,IOUNI5,MAXNXT,
14282CCCCC1              ICAPSW,ICAPTY,NUMDIG,ISEED,IBOOSS,
14283CCCCC1              ISUBRO,IBUGA3,IERROR)
14284CCCCC   IF(IFLAGZ.EQ.1)THEN
14285CCCCC     IPRINT=IPRISV
14286CCCCC   ENDIF
14287CCCCC ENDIF
14288C
14289C     HUBER H15 MEAN OF MEANS
14290C
14291      IF(IHUBCM.EQ.'ON')THEN
14292        IFLAGZ=0
14293        IF(ICMET5.EQ.'OFF')IFLAGZ=1
14294        IF(IFLAGZ.EQ.1)THEN
14295          IPRISV=IPRINT
14296          IPRINT='OFF'
14297        ENDIF
14298        CALL DPHMEA(NLAB,AMEANF,ASDF,XTEMP1,XTEMP2,
14299     1              IWRITE,ICAPSW,ICAPTY,NUMDIG,MAXNXT,
14300     1              XH15,SEHMK1,SEHMK2,H15LCL,H15UCL,
14301     1              ISUBRO,IBUGA3,IERROR)
14302        IF(IFLAGZ.EQ.1)THEN
14303          IPRINT=IPRISV
14304        ENDIF
14305      ENDIF
14306C
14307C     CONFIDENCE LIMITS TABLE
14308C
14309      CALL DPMAN5(NPTS,NLAB,
14310     1XGRAND,XMPS,XMMPS,XMLS,XSE,
14311     1ASM,XGD,XGCI,XDL,XFW,XBCP,
14312     1DLOWMP,DHIGMP,DLOWMM,DHIGMM,DLOWML,DHIGML,DLOWM2,DHIGM2,
14313     1DLOWBO,DHIGBO,DLOWSE,DHIGSE,DLOWT1,DHIGT1,
14314     1DLOWT2,DHIGT2,DLOWGD,DHIGGD,DLOWGC,DHIGGC,
14315     1DLOWDL,DHIGDL,DLOWD2,DHIGD2,DLOWD3,DHIGD3,DLOWD4,DHIGD4,
14316     1DLOWD5,DHIGD5,DLOWD6,DHIGD6,
14317     1DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
14318     1DLOWBC,DHIGBC,
14319     1XMEDME,SEMED,
14320     1DLWME0,DHGME0,DLWME1,DHGME1,
14321     1DLWME2,DHGME2,DLWME3,DHGME3,
14322     1SEMPK1,SEMMP1,SEMLK1,SEMLBO,AKUK1,SESUK1,SET2K1,
14323     1SET1K1,SEGDK1,SEDLK1,SEHDK1,SERUK1,SEBOK1,SEGCI,
14324     1SEFWK1,XBCPK1,SEMEDB,ALOWCL,AUPPCL,SEMEK1,
14325     1XH15,SEHMK1,
14326     1IWRITE,IOUNI2,
14327     1ICAPSW,ICAPTY,NUMDIG,IFLAG9,
14328     1ISUBRO,IBUGA3,IERROR)
14329C
14330      IK=1
14331      CALL DPMAN6(NPTS,NLAB,
14332     1XGRAND,XMPS,XMMPS,XMLS,XSE,
14333     1ASM,XGD,XDL,XGCI,XFW,XBCP,
14334     1SEMPK1,SEMMP1,SEMLK1,SEMLBO,AKUK1,SESUK1,SET1K1,
14335     1SET2K1,SEGDK1,SEDLK1,SEHDK1,SERUK1,SEBOK1,SEGCI,SEFWK1,XBCPK1,
14336     1XMEDME,SEMED,SEMEDB,SEMEK1,XH15,SEHMK1,
14337     1IWRITE,
14338     1ICAPSW,ICAPTY,IK,IOUNI3,NUMDIG,IFLAG9,
14339     1ISUBRO,IBUGA3,IERROR)
14340C
14341      IK=2
14342      SEMLB2=2.0*SEMLBO
14343      SEMED2=2.0*SEMED
14344      SEMDB2=2.0*SEMEDB
14345      CALL DPMAN6(NPTS,NLAB,
14346     1XGRAND,XMPS,XMMPS,XMLS,XSE,
14347     1ASM,XGD,XDL,XGCI,XFW,XBCP,
14348     1SEMPK2,SEMMP2,SEMLK2,SEMLB2,AKUK2,SESUK2,SET1K2,
14349     1SET2K2,SEGDK2,SEDLK2,SEHDK2,SERUK2,SEBOK2,
14350     12.0*SEGCI,SEFWK2,XBCPK2,
14351     1XMEDME,SEMED2,SEMDB2,SEMEK2,XH15,SEHMK2,
14352     1IWRITE,
14353     1ICAPSW,ICAPTY,IK,IOUNI4,NUMDIG,IFLAG9,
14354     1ISUBRO,IBUGA3,IERROR)
14355C
14356      GOTO8000
14357C
14358 8000 CONTINUE
14359C
14360C     RESET "ASIS" MODE
14361C
14362      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
14363 5195   FORMAT('<PRE>')
14364        WRITE(ICOUT,5195)
14365        CALL DPWRST('XXX','WRIT')
14366C
14367C     2015/08: NOTE THAT TABLE ROUTINES ALREADY RESET
14368C              "VERBATIM" MODE, SO THIS IS REDUNDANT
14369C              HERE.
14370C
14371      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
14372CCCCC   CALL DPCONA(92,IBASLC)
14373C8190   FORMAT(A1,'begin{verbatim}')
14374CCCCC   WRITE(ICOUT,8190)IBASLC
14375CCCCC   CALL DPWRST('XXX','WRIT')
14376CCCCC   WRITE(ICOUT,999)
14377CCCCC   CALL DPWRST('XXX','WRIT')
14378      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
14379      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
14380      ENDIF
14381C
14382C     CLOSE OUTPUT FILES
14383C
14384      IOP='CLOS'
14385      CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
14386     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
14387     1            IBUGA3,ISUBRO,IERROR)
14388      IF(IERROR.EQ.'YES')GOTO9000
14389C
14390C     DESCRIBE OUTPUT TO TEMPORARY OUTPUT FILES
14391C
14392      IF(IFEEDB.EQ.'OFF')GOTO8099
14393      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')GOTO8099
14394      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')GOTO8099
14395      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')GOTO8099
14396      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')GOTO8099
14397      WRITE(ICOUT,999)
14398      CALL DPWRST('XXX','BUG ')
14399      WRITE(ICOUT,8002)
14400 8002 FORMAT('Automatic Output:')
14401      CALL DPWRST('XXX','BUG ')
14402      WRITE(ICOUT,999)
14403      CALL DPWRST('XXX','BUG ')
14404C
14405      WRITE(ICOUT,8005)
14406 8005 FORMAT('The following variables were written to the file ',
14407     1       'dpst1f.dat:')
14408      CALL DPWRST('XXX','BUG ')
14409      WRITE(ICOUT,8011)
14410 8011 FORMAT('   1. Lab ID')
14411      CALL DPWRST('XXX','BUG ')
14412      WRITE(ICOUT,8021)
14413 8021 FORMAT('   2. Number of Observations for Lab')
14414      CALL DPWRST('XXX','BUG ')
14415      WRITE(ICOUT,8031)
14416 8031 FORMAT('   3. Mean of Lab')
14417      CALL DPWRST('XXX','BUG ')
14418      WRITE(ICOUT,8041)
14419 8041 FORMAT('   4. Variance of Lab')
14420      CALL DPWRST('XXX','BUG ')
14421      WRITE(ICOUT,8051)
14422 8051 FORMAT('   5. Standard Deviation of Lab')
14423      CALL DPWRST('XXX','BUG ')
14424      WRITE(ICOUT,8054)
14425 8054 FORMAT('   6. Standard Deviation of Mean of Lab')
14426      CALL DPWRST('XXX','BUG ')
14427      WRITE(ICOUT,999)
14428      CALL DPWRST('XXX','BUG ')
14429C
14430      WRITE(ICOUT,8056)
14431 8056 FORMAT('The following variables were written to the file ',
14432     1       'dpst2f.dat:')
14433      CALL DPWRST('XXX','BUG ')
14434      WRITE(ICOUT,8058)
14435 8058 FORMAT('   1. Consensus Means from the Various Methods')
14436      CALL DPWRST('XXX','BUG ')
14437      WRITE(ICOUT,8060)
14438 8060 FORMAT('   2. Lower 95% Confidence Limit from the ',
14439     1       'Various Methods')
14440      CALL DPWRST('XXX','BUG ')
14441      WRITE(ICOUT,8062)
14442 8062 FORMAT('   3. Upper 95% Confidence Limit from the ',
14443     1       'Various Methods')
14444      CALL DPWRST('XXX','BUG ')
14445      WRITE(ICOUT,999)
14446      CALL DPWRST('XXX','BUG ')
14447C
14448      WRITE(ICOUT,8064)
14449 8064 FORMAT('The following variables were written to the file ',
14450     1       'dpst3f.dat:')
14451      CALL DPWRST('XXX','BUG ')
14452      WRITE(ICOUT,8058)
14453      CALL DPWRST('XXX','BUG ')
14454      WRITE(ICOUT,8066)
14455 8066 FORMAT('   2. Standard Uncertainty (k=1) for the Various ',
14456     1       'Methods')
14457      CALL DPWRST('XXX','BUG ')
14458      WRITE(ICOUT,8068)
14459 8068 FORMAT('   3. Relative Standard (k=1) Uncertainty ',
14460     1       '(100*Consensus Mean/Standard Uncertainty)')
14461      CALL DPWRST('XXX','BUG ')
14462      WRITE(ICOUT,999)
14463      CALL DPWRST('XXX','BUG ')
14464C
14465      WRITE(ICOUT,8070)
14466 8070 FORMAT('The following variables were written to the file ',
14467     1       'dpst4f.dat:')
14468      CALL DPWRST('XXX','BUG ')
14469      WRITE(ICOUT,8058)
14470      CALL DPWRST('XXX','BUG ')
14471      WRITE(ICOUT,8072)
14472 8072 FORMAT('   2. Expanded Uncertainty (k=2) for the Various ',
14473     1       'Methods')
14474      CALL DPWRST('XXX','BUG ')
14475      WRITE(ICOUT,8074)
14476 8074 FORMAT('   3. Relative Expanded (k=2) Uncertainty ',
14477     1       '(100*Consensus Mean/Expanded Uncertainty)')
14478      CALL DPWRST('XXX','BUG ')
14479      WRITE(ICOUT,999)
14480      CALL DPWRST('XXX','BUG ')
14481C
14482      WRITE(ICOUT,8075)
14483 8075 FORMAT('The following variables were written to the file ',
14484     1       'dpst5f.dat:')
14485      CALL DPWRST('XXX','BUG ')
14486      WRITE(ICOUT,8081)
14487C8081 FORMAT('   1. Maximum Likelihood Weights')
14488 8081 FORMAT('   1. Consensus Means from Generalized Confidence ',
14489     1       'Interval Simulations')
14490      CALL DPWRST('XXX','BUG ')
14491CCCCC WRITE(ICOUT,8083)
14492C8083 FORMAT('   2. Estimate of Tau for Maximum Likelihood')
14493CCCCC CALL DPWRST('XXX','BUG ')
14494C
14495 8099 CONTINUE
14496      GOTO9000
14497C
14498C               *****************
14499C               **  STEP 90--  **
14500C               **  EXIT       **
14501C               *****************
14502C
14503 9000 CONTINUE
14504C
14505      IBOBCM=IBOBSV
14506      IBCPCM=IBCPSV
14507C
14508      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN2')THEN
14509        WRITE(ICOUT,999)
14510        CALL DPWRST('XXX','BUG ')
14511        WRITE(ICOUT,9011)
14512 9011   FORMAT('***** AT THE END       OF DPMAN2--')
14513        CALL DPWRST('XXX','BUG ')
14514        WRITE(ICOUT,9012)IERROR,ISEDF,ABIAS
14515 9012   FORMAT('IERROR,ISEDF,ABIAS = ',A4,2X,I8,G15.7)
14516        CALL DPWRST('XXX','BUG ')
14517        WRITE(ICOUT,9013)NPTS,NUMVAR,NLAB,NUMDIG
14518 9013   FORMAT('NPTS,NUMVAR,NLAB,NUMDIG = ',4I8)
14519        CALL DPWRST('XXX','BUG ')
14520      ENDIF
14521C
14522      RETURN
14523      END
14524      SUBROUTINE DPMAN3(Y1,Y2,Y3,NPTS,NUMVAR,NLAB,
14525     1                  DAT,X,T,
14526     1                  AMEAN,ASD,N,
14527     1                  AMEANF,ASDF,NFULL,NLABF,NPTSF,
14528     1                  IHLEFT,IHLEF2,IHRIGH,IHRIG2,
14529     1                  ASM,ASD2,ASD3,
14530     1                  XGRAND,S2WPOO,SW,
14531     1                  AMNX,AMXX,
14532     1                  IWRITE,IOUNI1,
14533     1                  ICAPSW,ICAPTY,NUMDIG,
14534     1                  ISUBRO,IBUGA3,IERROR)
14535C
14536C     PURPOSE--GENERATE INITIAL SUMMARY TABLES FOR CONSENSUS MEANS
14537C              COMMAND (FULL DATA CASE).
14538C     PRINTING--YES
14539C     SUBROUTINES NEEDED--NONE
14540C     WRITTEN BY--JAMES J. FILLIBEN
14541C                 STATISTICAL ENGINEERING DIVISION
14542C                 INFORMATION TECHNOLOGY LABORATORY
14543C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14544C                 GAITHERSBURG, MD 20899-8980
14545C                 PHONE--301-975-2899
14546C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14547C           OF THE NATIONAL BUREAU OF STANDARDS.
14548C     LANGUAGE--ANSI FORTRAN (1977)
14549C     VERSION NUMBER--2006/3
14550C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2.
14551C     UPDATED         --FEBRUARY  2010. USE DPDTA1 AND DPDTA4
14552C     UPDATED         --JUNE      2010. RETURN VERSIONS OF LAB MEAN AND
14553C                                       STANDARD DEVIATIONS THAT INCLUDE
14554C                                       CASES WITH ZERO STANDARD
14555C                                       DEVIATIONS
14556C     UPDATED         --OCTOBER   2011. USE "LABID" TO LABEL OUTPUT
14557C     UPDATED         --JANUARY   2017. OPTION TO SUPPRESS PRINTING
14558C                                       TABLE (ICMET1)
14559C
14560C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
14561C
14562      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
14563C
14564      CHARACTER*4 ICAPSW
14565      CHARACTER*4 ICAPTY
14566      CHARACTER*4 ISUBRO
14567      CHARACTER*4 IBUGA3
14568      CHARACTER*4 IERROR
14569C
14570      CHARACTER*4 IWRITE
14571      CHARACTER*4 ISUBN1
14572      CHARACTER*4 ISUBN2
14573      CHARACTER*4 IHLEFT
14574      CHARACTER*4 IHLEF2
14575      CHARACTER*4 IHRIGH
14576      CHARACTER*4 IHRIG2
14577C
14578      REAL ATEMP
14579      REAL RIGHT
14580      REAL XGRAND
14581      REAL SW
14582      REAL S2WPOO
14583      REAL SDGRAN
14584      REAL AMNX
14585      REAL AMXX
14586      REAL ASM
14587      REAL ASD2
14588      REAL ASD3
14589C
14590C----------------------------------------------------------------
14591C
14592      REAL Y1(*)
14593      REAL Y2(*)
14594      REAL Y3(*)
14595      REAL AMEAN(*)
14596      REAL ASD(*)
14597      REAL AMEANF(*)
14598      REAL ASDF(*)
14599C
14600      INTEGER N(*)
14601      INTEGER NFULL(*)
14602C
14603      REAL DAT(*)
14604      DOUBLE PRECISION X(*)
14605      DOUBLE PRECISION T(*)
14606C
14607      COMMON /MPCOM/ T0, T1
14608C
14609      INCLUDE 'DPCOST.INC'
14610C
14611      CHARACTER*1 IBASLC
14612      CHARACTER*4 IRTFMD
14613      COMMON/COMRTF/IRTFMD
14614C
14615      PARAMETER(NUMCLI=6)
14616      PARAMETER(MAXLIN=3)
14617      PARAMETER (MAXROW=50)
14618      CHARACTER*60 ITITLE
14619      CHARACTER*60 ITITLZ
14620      CHARACTER*60 ITITL9
14621      CHARACTER*60 ITEXT(MAXROW)
14622      CHARACTER*4  ALIGN(NUMCLI)
14623      CHARACTER*4  VALIGN(NUMCLI)
14624      REAL         AVALUE(MAXROW)
14625      INTEGER      NCTEXT(MAXROW)
14626      INTEGER      IDIGIT(MAXROW)
14627      INTEGER      NTOT(MAXROW)
14628      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
14629      CHARACTER*4  ITYPCO(NUMCLI)
14630      INTEGER      NCTIT2(MAXLIN,NUMCLI)
14631      INTEGER      NCVALU(MAXROW,NUMCLI)
14632      INTEGER      IWHTML(NUMCLI)
14633      INTEGER      IWRTF(NUMCLI)
14634      REAL         AMAT(MAXROW,NUMCLI)
14635      LOGICAL IFRST
14636      LOGICAL ILAST
14637C
14638      INCLUDE 'DPCOP2.INC'
14639C
14640C-----START POINT------------------------------------------------
14641C
14642      CALL DPCONA(92,IBASLC)
14643C
14644      IERROR='NO'
14645      ISUBN1='DPMA'
14646      ISUBN2='N3  '
14647C
14648      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN3')THEN
14649        WRITE(ICOUT,999)
14650  999   FORMAT(1X)
14651        CALL DPWRST('XXX','BUG ')
14652        WRITE(ICOUT,51)
14653   51   FORMAT('***** AT THE BEGINNING OF DPMAN3--')
14654        CALL DPWRST('XXX','BUG ')
14655        WRITE(ICOUT,52)NPTS,NUMVAR
14656   52   FORMAT('NPTS,NUMVAR = ',2I8)
14657        CALL DPWRST('XXX','BUG ')
14658        DO55I=1,NPTS
14659          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I)
14660   56     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
14661          CALL DPWRST('XXX','BUG ')
14662   55   CONTINUE
14663      ENDIF
14664C
14665C               ***********************************************
14666C               **  STEP 2.1--                               **
14667C               **  COMPUTE OVERALL STATISTICS AND COMPUTE   **
14668C               **  NUMBER OF DISTINCT LABS.                 **
14669C               **  IF TWO VARIABLES ENTERED, THEN           **
14670C               **     Y1 = RESPONSE VARIABLE                **
14671C               **     Y2 = LAB ID VARIABLE                  **
14672C               **  1) COPY RESPONSE DATA TO "DAT"           **
14673C               **  2) DETERMINE NUMBER OF DISTINCT LABS     **
14674C               **  3) SORT RESPONSE (DAT) BY LAB ID         **
14675C               ***********************************************
14676C
14677      CALL MEAN(Y1,NPTS,IWRITE,XGRAND,IBUGA3,IERROR)
14678      CALL SD(Y1,NPTS,IWRITE,SDGRAN,IBUGA3,IERROR)
14679      CALL SORTC(Y2,Y1,NPTS,Y2,DAT)
14680      CALL DISTIN(Y2,NPTS,IWRITE,Y3,NLAB,IBUGA3,IERROR)
14681C
14682      IF(IERROR.EQ.'YES')GOTO9000
14683      IF(NLAB.LT.2 .OR. NLAB.GE.NPTS)THEN
14684        WRITE(ICOUT,999)
14685        CALL DPWRST('XXX','WRIT')
14686        WRITE(ICOUT,211)
14687  211   FORMAT('***** ERROR IN CONSENSUS MEANS ANALYSIS--')
14688        CALL DPWRST('XXX','WRIT')
14689        WRITE(ICOUT,212)
14690  212   FORMAT('      FOR THE TWO VARIABLE SYNTAX OF THE CONSENSUS')
14691        CALL DPWRST('XXX','WRIT')
14692        WRITE(ICOUT,214)
14693  214   FORMAT('      MEANS COMMAND, THE SECOND VARIABLE IS THE')
14694        CALL DPWRST('XXX','WRIT')
14695        WRITE(ICOUT,216)
14696  216   FORMAT('      LAB ID VARIABLE.  THE NUMBER OF LABS SHOULD')
14697        CALL DPWRST('XXX','WRIT')
14698        WRITE(ICOUT,218)
14699  218   FORMAT('      BE AT LEAST 2 AND LESS THAN THE NUMBER OF')
14700        CALL DPWRST('XXX','WRIT')
14701        WRITE(ICOUT,220)
14702  220   FORMAT('      POINTS.  SUCH WAS NOT THE CASE HERE.')
14703        CALL DPWRST('XXX','WRIT')
14704        WRITE(ICOUT,222)NLAB
14705  222   FORMAT('      NUMBER OF UNIQUE LAB IDS = ',I8)
14706        CALL DPWRST('XXX','WRIT')
14707        WRITE(ICOUT,224)NPTS
14708  224   FORMAT('      TOTAL NUMBER OF POINTS   = ',I8)
14709        CALL DPWRST('XXX','WRIT')
14710        IERROR='YES'
14711        GOTO9000
14712      ENDIF
14713C
14714C               ***********************************************
14715C               **  STEP 2.2--                               **
14716C               **  COMPUTE THE SUMMARY STATISTICS BY LAB    **
14717C               **  1) DETERMINE NUMER OF POINTS IN EACH LAB **
14718C               **  2) MEAN FOR EACH LAB                     **
14719C               **  3) SD FOR EACH LAB                       **
14720C               ***********************************************
14721C
14722      AMNX=CPUMAX
14723      AMXX=CPUMIN
14724      AMNSD=CPUMAX
14725      AMXSD=CPUMIN
14726C
14727      DO250I=1,NLAB
14728        ATEMP=Y3(I)
14729        N(I)=0
14730        DO259J=1,NPTS
14731          IF(Y2(J).EQ.ATEMP)THEN
14732            N(I)=N(I)+1
14733            Y1(N(I))=DAT(J)
14734          ENDIF
14735  259   CONTINUE
14736C
14737        IF(N(I).LE.0)THEN
14738          WRITE(ICOUT,999)
14739          CALL DPWRST('XXX','WRIT')
14740          WRITE(ICOUT,211)
14741          CALL DPWRST('XXX','WRIT')
14742          WRITE(ICOUT,254)Y3(I)
14743  254     FORMAT('      LAB ',F10.5,' HAS NO DATA')
14744          CALL DPWRST('XXX','WRIT')
14745          IERROR='YES'
14746          GOTO9000
14747        ELSE
14748          CALL MEAN(Y1,N(I),IWRITE,RIGHT,IBUGA3,IERROR)
14749          X(I)=DBLE(RIGHT)
14750          AMEAN(I)=RIGHT
14751          IF(AMEAN(I).LT.AMNX)AMNX=AMEAN(I)
14752          IF(AMEAN(I).GT.AMXX)AMXX=AMEAN(I)
14753          CALL SD(Y1,N(I),IWRITE,ASD(I),IBUGA3,IERROR)
14754C
14755          IF(ASD(I).GT.0.0)THEN
14756            IF(ASD(I).LT.AMNSD)AMNSD=ASD(I)
14757            IF(ASD(I).GT.AMXSD)AMXSD=ASD(I)
14758          ENDIF
14759C
14760          CALL SDMEAN(Y1,N(I),IWRITE,RIGHT,IBUGA3,IERROR)
14761          T(I)=DBLE(RIGHT**2)
14762C
14763      ENDIF
14764C
14765  250 CONTINUE
14766C
14767      CALL MEAN(AMEAN,NLAB,IWRITE,ASM,IBUGA3,IERROR)
14768      CALL SD(AMEAN,NLAB,IWRITE,ASD2,IBUGA3,IERROR)
14769C
14770C     COMPUTE:  SQRT{SUM[(YBAR(I) - YGRAND)**2/(N-1)]}
14771C
14772      DSUM1=0.0D0
14773      DO260I=1,NLAB
14774        DTERM1=DBLE(AMEAN(I)) - DBLE(XGRAND)
14775        DSUM1=DSUM1 + DTERM1**2
14776  260 CONTINUE
14777      DTERM1=DSQRT(DSUM1/DBLE(NLAB-1))
14778      ASD3=REAL(DTERM1)
14779C
14780      DSUM1=0.0D0
14781      DSUM2=0.0D0
14782      DSUM3=0.0D0
14783C
14784      DO270J=1,NLAB
14785        DTERM1=DBLE(N(J)-1.0D0)
14786        DSUM2=DSUM2 + DTERM1*(DBLE(ASD(J))**2)
14787        DSUM3=DSUM3 + DTERM1
14788        DTERM1=DBLE(N(J))
14789        IF(DTERM1.NE.0.0D0)THEN
14790          DSUM1=DSUM1 + DBLE(ASD(J))**2/DTERM1
14791        ENDIF
14792  270 CONTINUE
14793C
14794      DTEMP=DSQRT(DSUM1)/DBLE(NLAB)
14795      S2WPOO=DSUM2/DSUM3
14796      SW=REAL(DTEMP)
14797C
14798      IF(IPRINT.EQ.'OFF' .OR. ICMET1.EQ.'OFF')GOTO8000
14799C
14800      ITITLE='Consensus Means Analysis'
14801      NCTITL=24
14802      ITITLZ='(Full Sample Case)'
14803      NCTITZ=18
14804C
14805      ICNT=1
14806      ITEXT(ICNT)='Data Summary:'
14807      NCTEXT(ICNT)=13
14808      AVALUE(ICNT)=0.0
14809      IDIGIT(ICNT)=-1
14810      ICNT=ICNT+1
14811      ITEXT(ICNT)='Response Variable: '
14812      WRITE(ITEXT(ICNT)(20:23),'(A4)')IHLEFT
14813      WRITE(ITEXT(ICNT)(24:27),'(A4)')IHLEF2
14814      NCTEXT(ICNT)=27
14815      AVALUE(ICNT)=0.0
14816      IDIGIT(ICNT)=-1
14817      ICNT=ICNT+1
14818      ITEXT(ICNT)='Lab-ID Variable: '
14819      WRITE(ITEXT(ICNT)(18:21),'(A4)')IHRIGH
14820      WRITE(ITEXT(ICNT)(22:25),'(A4)')IHRIG2
14821      NCTEXT(ICNT)=25
14822      AVALUE(ICNT)=0.0
14823      IDIGIT(ICNT)=-1
14824C
14825      ICNT=ICNT+1
14826      ITEXT(ICNT)='Number of Observations:'
14827      NCTEXT(ICNT)=23
14828      AVALUE(ICNT)=REAL(NPTS)
14829      IDIGIT(ICNT)=0
14830      ICNT=ICNT+1
14831      ITEXT(ICNT)='Grand Mean:'
14832      NCTEXT(ICNT)=11
14833      AVALUE(ICNT)=XGRAND
14834      IDIGIT(ICNT)=NUMDIG
14835      ICNT=ICNT+1
14836      ITEXT(ICNT)='Grand Standard Deviation:'
14837      NCTEXT(ICNT)=25
14838      AVALUE(ICNT)=SDGRAN
14839      IDIGIT(ICNT)=NUMDIG
14840      ICNT=ICNT+1
14841      ITEXT(ICNT)='Total Number of Labs:'
14842      NCTEXT(ICNT)=21
14843      AVALUE(ICNT)=NLAB
14844      IDIGIT(ICNT)=0
14845      ICNT=ICNT+1
14846      ITEXT(ICNT)='Minimum Lab Mean:'
14847      NCTEXT(ICNT)=17
14848      AVALUE(ICNT)=AMNX
14849      IDIGIT(ICNT)=NUMDIG
14850      ICNT=ICNT+1
14851      ITEXT(ICNT)='Maximum Lab Mean:'
14852      NCTEXT(ICNT)=17
14853      AVALUE(ICNT)=AMXX
14854      IDIGIT(ICNT)=NUMDIG
14855      ICNT=ICNT+1
14856      ITEXT(ICNT)='Minimum Lab SD:'
14857      NCTEXT(ICNT)=15
14858      AVALUE(ICNT)=AMNSD
14859      IDIGIT(ICNT)=NUMDIG
14860      ICNT=ICNT+1
14861      ITEXT(ICNT)='Maximum Lab SD:'
14862      NCTEXT(ICNT)=15
14863      AVALUE(ICNT)=AMXSD
14864      IDIGIT(ICNT)=NUMDIG
14865      ICNT=ICNT+1
14866      ITEXT(ICNT)='Mean of Lab Means:'
14867      NCTEXT(ICNT)=18
14868      AVALUE(ICNT)=ASM
14869      IDIGIT(ICNT)=NUMDIG
14870      ICNT=ICNT+1
14871      ITEXT(ICNT)='SD of Lab Means:'
14872      NCTEXT(ICNT)=16
14873      AVALUE(ICNT)=ASD2
14874      IDIGIT(ICNT)=NUMDIG
14875      ICNT=ICNT+1
14876      ITEXT(ICNT)='SD of Lab Means (wrt to grand mean):'
14877      NCTEXT(ICNT)=36
14878      AVALUE(ICNT)=ASD3
14879      IDIGIT(ICNT)=NUMDIG
14880      ICNT=ICNT+1
14881      ITEXT(ICNT)='Within Lab (pooled) SD:'
14882      NCTEXT(ICNT)=23
14883      AVALUE(ICNT)=SQRT(S2WPOO)
14884      IDIGIT(ICNT)=NUMDIG
14885      ICNT=ICNT+1
14886      ITEXT(ICNT)='Within Lab (pooled) Variance:'
14887      NCTEXT(ICNT)=29
14888      AVALUE(ICNT)=S2WPOO
14889      IDIGIT(ICNT)=NUMDIG
14890C
14891      NUMROW=ICNT
14892      DO310I=1,NUMROW
14893        NTOT(I)=15
14894  310 CONTINUE
14895C
14896      IFRST=.TRUE.
14897      ILAST=.FALSE.
14898      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
14899     1            AVALUE,IDIGIT,
14900     1            NTOT,NUMROW,
14901     1            ICAPSW,ICAPTY,ILAST,IFRST,
14902     1            ISUBRO,IBUGA3,IERROR)
14903      ITITLE=' '
14904      NCTITL=0
14905      ITITLZ=' '
14906      NCTITZ=0
14907      ITITL9=' '
14908      NCTIT9=0
14909C
14910      ITITL9=' '
14911      NCTIT9=0
14912      ITITLE(1:42)='Table 1: Summary Statistics by Lab'
14913      NCTITL=34
14914      NUMLIN=3
14915      NUMCOL=6
14916      ITITL2(1,1)=' '
14917      ITITL2(2,1)='Lab'
14918      ITITL2(3,1)='ID'
14919      NCTIT2(1,1)=0
14920      NCTIT2(2,1)=3
14921      NCTIT2(3,1)=2
14922      ITITL2(1,2)=' '
14923      ITITL2(2,2)=' '
14924      ITITL2(3,2)='n(i)'
14925      NCTIT2(1,2)=0
14926      NCTIT2(2,2)=0
14927      NCTIT2(3,2)=4
14928      ITITL2(1,3)=' '
14929      ITITL2(2,3)=' '
14930      ITITL2(3,3)='Mean'
14931      NCTIT2(1,3)=0
14932      NCTIT2(2,3)=0
14933      NCTIT2(3,3)=4
14934      ITITL2(1,4)=' '
14935      ITITL2(2,4)=' '
14936      ITITL2(3,4)='Variance'
14937      NCTIT2(1,4)=0
14938      NCTIT2(2,4)=0
14939      NCTIT2(3,4)=8
14940      ITITL2(1,5)=' '
14941      ITITL2(2,5)='Standard'
14942      ITITL2(3,5)='Deviation'
14943      NCTIT2(1,5)=0
14944      NCTIT2(2,5)=8
14945      NCTIT2(3,5)=9
14946      ITITL2(1,6)='Standard'
14947      ITITL2(2,6)='Deviation'
14948      ITITL2(3,6)='of the Mean'
14949      NCTIT2(1,6)=8
14950      NCTIT2(2,6)=9
14951      NCTIT2(3,6)=11
14952      NMAX=0
14953      DO2421I=1,NUMCOL
14954        VALIGN(I)='b'
14955        ALIGN(I)='r'
14956        NTOT(I)=15
14957        IF(I.EQ.1 .OR. I.EQ.2)NTOT(I)=8
14958        NMAX=NMAX+NTOT(I)
14959        IDIGIT(I)=NUMDIG
14960        ITYPCO(I)='NUME'
14961 2421 CONTINUE
14962C
14963      IWHTML(1)=75
14964      IWHTML(2)=75
14965      IWHTML(3)=125
14966      IWHTML(4)=125
14967      IWHTML(5)=125
14968      IWHTML(6)=125
14969      IWRTF(1)=800
14970      IWRTF(2)=IWRTF(1)+800
14971      IWRTF(3)=IWRTF(2)+1440
14972      IWRTF(4)=IWRTF(3)+1440
14973      IWRTF(5)=IWRTF(4)+1440
14974      IWRTF(6)=IWRTF(5)+1440
14975      IFRST=.FALSE.
14976      ILAST=.TRUE.
14977C
14978C     PRINT OUT 50 LINES AT A TIME
14979C
14980      NSTRT=1
14981      NSTOP=MIN(NLAB,50)
14982C
14983 2420 CONTINUE
14984      IDIGIT(1)=0
14985      IDIGIT(2)=0
14986      ICNT=0
14987      DO2423I=NSTRT,NSTOP
14988        ICNT=ICNT+1
14989        NCTEXT(ICNT)=0
14990        AMAT(ICNT,1)=Y3(I)
14991        AMAT(ICNT,2)=REAL(N(I))
14992        AMAT(ICNT,3)=X(I)
14993        AMAT(ICNT,4)=ASD(I)**2
14994        AMAT(ICNT,5)=ASD(I)
14995        AMAT(ICNT,6)=SQRT(T(I))
14996        DO2425J=1,NUMCOL
14997          NCVALU(ICNT,J)=0
14998 2425   CONTINUE
14999 2423 CONTINUE
15000C
15001      NLABT=NSTOP-NSTRT+1
15002      CALL DPDTA4(ITITLE,NCTITL,
15003     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
15004     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
15005     1            ITEXT,NCVALU,AMAT,ITYPCO,MAXROW,NLABT,
15006     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
15007     1            ICAPSW,ICAPTY,IFRST,ILAST,
15008     1            ISUBRO,IBUGA3,IERROR)
15009C
15010       IF(NSTOP.LT.NLAB)THEN
15011         NSTRT=NSTOP+1
15012         NSTOP=NSTRT+50
15013         IF(NSTOP.GT.NLAB)NSTOP=NLAB
15014         GOTO2420
15015       ENDIF
15016C
15017      DO4190I=1,NLAB
15018CCCCC   WRITE(IOUNI1,4196)REAL(I),REAL(N(I)),X(I),ASD(I)**2,
15019        WRITE(IOUNI1,4196)Y3(I),REAL(N(I)),X(I),ASD(I)**2,
15020     1                    ASD(I),SQRT(T(I))
15021 4196   FORMAT(F6.0,2X,F6.0,2X,4E15.7)
15022 4190 CONTINUE
15023C
15024C               *************************************
15025C               **  STEP 80--                      **
15026C               **  REMOVE ANY LABS WITH LESS THAN **
15027C               **  TWO OBSERVATIONS               **
15028C               *************************************
15029C
15030 8000 CONTINUE
15031      ICNT=0
15032      ICNT2=0
15033      NLABF=NLAB
15034      NPTSF=NPTS
15035      DO9100I=1,NLAB
15036        AMEANF(I)=AMEAN(I)
15037        ASDF(I)=ASD(I)
15038        NFULL(I)=N(I)
15039        IF(ASD(I).GT.0.0)THEN
15040          ICNT=ICNT+1
15041          AMEAN(ICNT)=AMEAN(I)
15042          ASD(ICNT)=ASD(I)
15043          N(ICNT)=N(I)
15044          Y3(ICNT)=Y3(I)
15045          X(ICNT)=X(I)
15046          T(ICNT)=T(I)
15047          ICNT2=ICNT2+N(ICNT)
15048        ELSE
15049          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
15050            WRITE(ICOUT,9201)
15051 9201       FORMAT('<PRE>')
15052            CALL DPWRST('XXX','WRIT')
15053          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
15054            WRITE(ICOUT,9301)IBASLC
15055 9301       FORMAT(A1,'begin{verbatim}')
15056            CALL DPWRST('XXX','WRIT')
15057          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
15058            IRTFMD='VERB'
15059          ELSE
15060            WRITE(ICOUT,999)
15061            CALL DPWRST('XXX','BUG ')
15062          ENDIF
15063C
15064          WRITE(ICOUT,9103)I
15065 9103     FORMAT('LAB ',I8,' HAS A NON-POSITIVE STANDARD DEVIATION.')
15066          CALL DPWRST('XXX','WRIT')
15067          WRITE(ICOUT,9105)
15068 9105     FORMAT('THIS LAB WILL BE OMITTED FROM THE ANALYSIS EXCEPT ',
15069     1           'FOR')
15070          CALL DPWRST('XXX','WRIT')
15071          WRITE(ICOUT,9107)
15072 9107     FORMAT('GRAND MEAN, MEAN/MEDIAN OF MEANS, BOB, AND BCP ',
15073     1           'METHODS.')
15074          CALL DPWRST('XXX','WRIT')
15075C
15076          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
15077            WRITE(ICOUT,9211)
15078 9211       FORMAT('</PRE>')
15079            CALL DPWRST('XXX','WRIT')
15080          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
15081            WRITE(ICOUT,9311)IBASLC
15082 9311       FORMAT(A1,'end{verbatim}')
15083            CALL DPWRST('XXX','WRIT')
15084          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
15085            IRTFMD='OFF'
15086          ELSE
15087            WRITE(ICOUT,999)
15088            CALL DPWRST('XXX','BUG ')
15089          ENDIF
15090        ENDIF
15091 9100 CONTINUE
15092      NLAB=ICNT
15093      NPTS=ICNT2
15094C
15095C               *****************
15096C               **  STEP 90--  **
15097C               **  EXIT       **
15098C               *****************
15099C
15100 9000 CONTINUE
15101      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN3')THEN
15102        WRITE(ICOUT,999)
15103        CALL DPWRST('XXX','BUG ')
15104        WRITE(ICOUT,9011)
15105 9011   FORMAT('***** AT THE END       OF DPMAN3--')
15106        CALL DPWRST('XXX','BUG ')
15107        WRITE(ICOUT,9012)IERROR
15108 9012   FORMAT('IERROR = ',A4)
15109        CALL DPWRST('XXX','BUG ')
15110        WRITE(ICOUT,9013)NPTS,NUMVAR,NLAB
15111 9013   FORMAT('NPTS,NUMVAR,NLAB = ',3I8)
15112        CALL DPWRST('XXX','BUG ')
15113        DO9020I=1,NLAB
15114          WRITE(ICOUT,9023)I,AMEAN(I),ASD(I)
15115 9023     FORMAT('I,AMEAN(I),ASD(I) = ',I8,2G15.7)
15116          CALL DPWRST('XXX','BUG ')
15117 9020   CONTINUE
15118      ENDIF
15119C
15120      RETURN
15121      END
15122      SUBROUTINE DPMAN4(Y1,Y2,Y3,PLABID,NLAB,NTOT,NUMVAR,
15123     1                  DAT,X,T,
15124     1                  AMEAN,ASD,N,
15125     1                  AMEANF,ASDF,NFULL,NLABF,NTOTF,
15126     1                  IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
15127     1                  ASM,ASD2,ASD3,SDGRAN,
15128     1                  XGRAND,S2WPOO,SW,
15129     1                  AMNX,AMXX,
15130     1                  IWRITE,IOUNI1,
15131     1                  ICAPSW,ICAPTY,NUMDIG,IUNCFL,IDFFL,
15132     1                  ISUBRO,IBUGA3,IERROR)
15133C
15134C     PURPOSE--GENERATE INITIAL SUMMARY TABLES FOR CONSENSUS MEANS
15135C              COMMAND (SUMMARY DATA CASE).
15136C     PRINTING--YES
15137C     SUBROUTINES NEEDED--NONE
15138C     WRITTEN BY--ALAN HECKERT
15139C                 STATISTICAL ENGINEERING DIVISION
15140C                 INFORMATION TECHNOLOGY LABORATORY
15141C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15142C                 GAITHERSBURG, MD 20899-8980
15143C                 PHONE--301-975-2899
15144C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15145C           OF THE NATIONAL BUREAU OF STANDARDS.
15146C     LANGUAGE--ANSI FORTRAN (1977)
15147C     VERSION NUMBER--2006/3
15148C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2.
15149C     UPDATED         --FEBRUARY  2010. USE DPDTA1 AND DPDTA4
15150C     UPDATED         --JUNE      2010. SOME METHODS CAN ACCOMODATE
15151C                                       ZERO STANDARD DEVIATIONS
15152C     UPDATED         --OCTOBER   2011. SUPPORT FOR OPTIONAL LAB-ID
15153C                                       VARIABLE
15154C     UPDATED         --OCTOBER   2014. SUPPORT FOR CASE WHERE
15155C                                       UNCERTAINTY REPORTED RATHER
15156C                                       THAN SD AND SAMPLE SIZE
15157C     UPDATED         --JANUARY   2017. OPTION TO SUPPRESS PRINTING
15158C                                       TABLE (ICMET1)
15159C
15160C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
15161C
15162      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
15163C
15164      CHARACTER*4 ICAPSW
15165      CHARACTER*4 ICAPTY
15166      CHARACTER*4 IUNCFL
15167      CHARACTER*4 IDFFL
15168      CHARACTER*4 ISUBRO
15169      CHARACTER*4 IBUGA3
15170      CHARACTER*4 IERROR
15171C
15172      CHARACTER*4 IWRITE
15173      CHARACTER*4 ISUBN1
15174      CHARACTER*4 ISUBN2
15175      CHARACTER*4 IHLEFT
15176      CHARACTER*4 IHLEF2
15177      CHARACTER*4 IHRIGH
15178      CHARACTER*4 IHRIG2
15179      CHARACTER*4 IHRI21
15180      CHARACTER*4 IHRI22
15181C
15182      REAL XGRAND
15183      REAL SW
15184      REAL S2WPOO
15185      REAL SDGRAN
15186      REAL AMNX
15187      REAL AMXX
15188      REAL ASM
15189      REAL ASD2
15190      REAL ASD3
15191C
15192C----------------------------------------------------------------
15193C
15194      REAL Y1(*)
15195      REAL Y2(*)
15196      REAL Y3(*)
15197      REAL PLABID(*)
15198      REAL AMEAN(*)
15199      REAL ASD(*)
15200      REAL AMEANF(*)
15201      REAL ASDF(*)
15202C
15203      INTEGER N(*)
15204      INTEGER NFULL(*)
15205C
15206      REAL DAT(*)
15207      DOUBLE PRECISION X(*)
15208      DOUBLE PRECISION T(*)
15209C
15210      COMMON /MPCOM/ T0, T1
15211C
15212      CHARACTER*4 IRTFMD
15213      COMMON/COMRTF/IRTFMD
15214C
15215      PARAMETER(NUMCLI=6)
15216      PARAMETER(MAXLIN=3)
15217      PARAMETER (MAXROW=50)
15218      CHARACTER*60 ITITLE
15219      CHARACTER*60 ITITLZ
15220      CHARACTER*60 ITITL9
15221      CHARACTER*60 ITEXT(MAXROW)
15222      CHARACTER*4  ALIGN(NUMCLI)
15223      CHARACTER*4  VALIGN(NUMCLI)
15224      REAL         AVALUE(MAXROW)
15225      INTEGER      NCTEXT(MAXROW)
15226      INTEGER      IDIGIT(MAXROW)
15227      INTEGER      NTOT9(MAXROW)
15228      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
15229      CHARACTER*4  ITYPCO(NUMCLI)
15230      INTEGER      NCTIT2(MAXLIN,NUMCLI)
15231      INTEGER      NCVALU(MAXROW,NUMCLI)
15232      INTEGER      IWHTML(NUMCLI)
15233      INTEGER      IWRTF(NUMCLI)
15234      REAL         AMAT(MAXROW,NUMCLI)
15235      LOGICAL IFRST
15236      LOGICAL ILAST
15237C
15238      INCLUDE 'DPCOST.INC'
15239      INCLUDE 'DPCOP2.INC'
15240C
15241C-----START POINT------------------------------------------------
15242C
15243      IERROR='NO'
15244      IUNCFL='OFF'
15245      IDFFL='OFF'
15246      ISUBN1='DPMA'
15247      ISUBN2='N4  '
15248C
15249      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN4')THEN
15250        WRITE(ICOUT,999)
15251  999   FORMAT(1X)
15252        CALL DPWRST('XXX','BUG ')
15253        WRITE(ICOUT,51)
15254   51   FORMAT('***** AT THE BEGINNING OF DPMAN4--')
15255        CALL DPWRST('XXX','BUG ')
15256        WRITE(ICOUT,52)NLAB,NTOT,IOUNI1
15257   52   FORMAT('NPTS,NTOT,IOUNI1 = ',3I8)
15258        CALL DPWRST('XXX','BUG ')
15259        DO55I=1,NLAB
15260          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I),DAT(I)
15261   56     FORMAT('I,Y1(I),Y2(I),Y3(I),DAT(I) = ',I8,4G15.7)
15262          CALL DPWRST('XXX','BUG ')
15263   55   CONTINUE
15264      ENDIF
15265C
15266C               ***********************************************
15267C               **  STEP 2.2--                               **
15268C               **  COMPUTE THE SUMMARY STATISTICS BY LAB    **
15269C               **  1) DETERMINE NUMER OF POINTS IN EACH LAB **
15270C               **  2) MEAN FOR EACH LAB                     **
15271C               **  3) SD FOR EACH LAB                       **
15272C               ***********************************************
15273C
15274C     2014/10: SOME LABS MAY REPORT AN UNCERTAINTY VALUE RATHER THAN
15275C              A STANDARD DEVIATION.  SPECIFICALLY, IF THE SAMPLE SIZE
15276C              IS NON-POSITIVE, THEN IT IS ASSUMED THAT THE STANDARD
15277C              DEVIATION IS AN "UNCERTAINTY" VALUE.  THIS APPROACH
15278C              ALLOWS A MIX OF "SD/SAMPLE SIZE" AND "UNCERTAINTY".
15279C              THIS IS USEFUL BECAUSE INTERNAL LABS TYPICALLY HAVE
15280C              THE RAW STANDARD DEVIATION AND SAMPLE SIZE WHILE
15281C              EXTERNAL LABS SOMETIMES ONLY REPORT AN UNCERTAINTY
15282C              VALUE.
15283C
15284C              NOTE THAT IN THIS CASE, A NEGATIVE VALUE FOR THE SAMPLE
15285C              SIZE WILL BE INTERPRETED AS AN "EFFECTIVE DEGREES OF
15286C              FREEDOM" WHILE A VALUE OF ZERO INDICATES NO EFFECTIVE
15287C              DEGREES OF FREEDOM ARE AVAILABLE.
15288C
15289C              NOTE THAT IF ONE OR MORE LABS ONLY REPORT AN UNCERTATINY
15290C              VALUE, THEN CERTAIN SUMMARY STATISTICS CANNOT BE COMPUTED.
15291C
15292      T0=10000000.D0
15293      T1=-T0
15294C
15295      AMNX=CPUMAX
15296      AMXX=CPUMIN
15297      AMNSD=CPUMAX
15298      AMXSD=CPUMIN
15299C
15300      DO250I=1,NLAB
15301C
15302        X(I)=DBLE(Y1(I))
15303        IF(X(I).LT.T0) T0=X(I)
15304        IF(X(I).GT.T1) T1=X(I)
15305        AMEAN(I)=Y1(I)
15306        ASD(I)=Y2(I)
15307        IF(Y3(I).GE.0)THEN
15308          N(I)=INT(Y3(I)+0.5)
15309        ELSE
15310          N(I)=INT(Y3(I)-0.5)
15311        ENDIF
15312        IF(NUMVAR.EQ.3)PLABID(I)=REAL(I)
15313        IF(N(I).LE.0)THEN
15314CCCCC     WRITE(ICOUT,999)
15315CCCCC     CALL DPWRST('XXX','WRIT')
15316CCCCC     WRITE(ICOUT,211)
15317  211     FORMAT('***** ERROR IN CONSENSUS MEANS ANALYSIS--')
15318CCCCC     CALL DPWRST('XXX','WRIT')
15319CCCCC     WRITE(ICOUT,254)I
15320CC254     FORMAT('      LAB ',I8,' HAS NO DATA')
15321CCCCC     CALL DPWRST('XXX','WRIT')
15322CCCCC     IERROR='YES'
15323CCCCC     GOTO9000
15324          IUNCFL='ON'
15325CCCCC     N(I)=0
15326        ENDIF
15327C
15328        IF(ASD(I).LT.0.0)THEN
15329          WRITE(ICOUT,999)
15330          CALL DPWRST('XXX','WRIT')
15331          WRITE(ICOUT,211)
15332          CALL DPWRST('XXX','WRIT')
15333          WRITE(ICOUT,256)I,ASD(I)
15334  256     FORMAT('      LAB ',I8,' HAS NEGATIVE STANDARD DEVIATION (',
15335     1           G15.7,')')
15336          CALL DPWRST('XXX','WRIT')
15337          IERROR='YES'
15338          GOTO9000
15339        ENDIF
15340C
15341        IF(N(I).EQ.0)THEN
15342          T(I)=DBLE(ASD(I))**2
15343          IDFFL='NONE'
15344        ELSEIF(N(I).LT.0)THEN
15345          T(I)=DBLE(ASD(I))**2
15346          IF(IDFFL.NE.'NONE')IDFFL='ON'
15347        ELSE
15348          T(I)=DBLE(ASD(I))**2/DBLE(N(I))
15349        ENDIF
15350        IF(AMEAN(I).LT.AMNX)AMNX=AMEAN(I)
15351        IF(AMEAN(I).GT.AMXX)AMXX=AMEAN(I)
15352C
15353        IF(ASD(I).GT.0.0)THEN
15354          IF(ASD(I).LT.AMNSD)AMNSD=ASD(I)
15355          IF(ASD(I).GT.AMXSD)AMXSD=ASD(I)
15356        ENDIF
15357C
15358  250 CONTINUE
15359C
15360      CALL MEAN(AMEAN,NLAB,IWRITE,ASM,IBUGA3,IERROR)
15361      CALL SD(AMEAN,NLAB,IWRITE,ASD2,IBUGA3,IERROR)
15362C
15363C     FOLLOWING COMPUTATIONS ONLY AVAILABLE IF A POSITIVE SAMPLE SIZE
15364C     IS GIVEN FOR EACH LAB.
15365C
15366      IF(IUNCFL.EQ.'OFF')THEN
15367        DSUM1=0.0D0
15368        DO255I=1,NLAB
15369          DSUM1=DSUM1 + (DBLE(N(I))/DBLE(NTOT))*DBLE(AMEAN(I))
15370  255   CONTINUE
15371        XGRAND=DSUM1
15372C
15373        DSUM1=0.0D0
15374        DO258I=1,NLAB
15375          DSUM1=DSUM1 + DBLE(N(I))*DBLE(ASD(I))
15376  258   CONTINUE
15377        SDGRAN=REAL(DSUM1/DBLE(NTOT-NLAB))
15378C
15379C       COMPUTE:  SQRT{SUM[(YBAR(I) - YGRAND)**2/(N-1)]}
15380C
15381        DSUM1=0.0D0
15382        DO260I=1,NLAB
15383          DTERM1=DBLE(AMEAN(I)) - DBLE(XGRAND)
15384          DSUM1=DSUM1 + DTERM1**2
15385  260   CONTINUE
15386        DTERM1=DSQRT(DSUM1/DBLE(NLAB-1))
15387        ASD3=REAL(DTERM1)
15388C
15389        DSUM1=0.0D0
15390        DSUM2=0.0D0
15391        DSUM3=0.0D0
15392        DO270J=1,NLAB
15393          DTERM1=DBLE(N(J)-1.0D0)
15394          DSUM2=DSUM2 + DTERM1*(DBLE(ASD(J))**2)
15395          DSUM3=DSUM3 + DTERM1
15396          DSUM1=DSUM1 + DBLE(ASD(J))**2/DBLE(N(J))
15397  270   CONTINUE
15398        XJUNK=XGRAND
15399        DTEMP=DSQRT(DSUM1)/DBLE(NLAB)
15400        S2WPOO=DSUM2/DSUM3
15401        SW=REAL(DTEMP)
15402      ENDIF
15403C
15404      IF(IPRINT.EQ.'OFF')GOTO8000
15405C
15406      ITITLE='Consensus Means Analysis'
15407      NCTITL=24
15408      ITITLZ='(Summary Statistics Case)'
15409      NCTITZ=25
15410C
15411      ICNT=1
15412      ITEXT(ICNT)='Data Summary:'
15413      NCTEXT(ICNT)=13
15414      AVALUE(ICNT)=0.0
15415      IDIGIT(ICNT)=-1
15416      ICNT=ICNT+1
15417      ITEXT(ICNT)='Mean Variable: '
15418      WRITE(ITEXT(ICNT)(16:19),'(A4)')IHLEFT
15419      WRITE(ITEXT(ICNT)(20:23),'(A4)')IHLEF2
15420      NCTEXT(ICNT)=23
15421      AVALUE(ICNT)=0.0
15422      IDIGIT(ICNT)=-1
15423      ICNT=ICNT+1
15424      ITEXT(ICNT)='SD Variable: '
15425      WRITE(ITEXT(ICNT)(14:17),'(A4)')IHRIGH
15426      WRITE(ITEXT(ICNT)(18:21),'(A4)')IHRIG2
15427      NCTEXT(ICNT)=21
15428      AVALUE(ICNT)=0.0
15429      IDIGIT(ICNT)=-1
15430      ICNT=ICNT+1
15431      ITEXT(ICNT)='Sample Size Variable: '
15432      WRITE(ITEXT(ICNT)(23:26),'(A4)')IHRI21
15433      WRITE(ITEXT(ICNT)(27:30),'(A4)')IHRI22
15434      NCTEXT(ICNT)=30
15435      AVALUE(ICNT)=0.0
15436      IDIGIT(ICNT)=-1
15437C
15438      IF(IUNCFL.EQ.'OFF')THEN
15439        ICNT=ICNT+1
15440        ITEXT(ICNT)='Total Number of Observations:'
15441        NCTEXT(ICNT)=29
15442        AVALUE(ICNT)=REAL(NTOT)
15443        IDIGIT(ICNT)=0
15444        ICNT=ICNT+1
15445        ITEXT(ICNT)='Grand Mean:'
15446        NCTEXT(ICNT)=11
15447        AVALUE(ICNT)=XGRAND
15448        IDIGIT(ICNT)=NUMDIG
15449        ICNT=ICNT+1
15450        ITEXT(ICNT)='Grand Standard Deviation:'
15451        NCTEXT(ICNT)=25
15452        AVALUE(ICNT)=SDGRAN
15453        IDIGIT(ICNT)=NUMDIG
15454      ENDIF
15455      ICNT=ICNT+1
15456      ITEXT(ICNT)='Total Number of Labs:'
15457      NCTEXT(ICNT)=21
15458      AVALUE(ICNT)=NLAB
15459      IDIGIT(ICNT)=0
15460      ICNT=ICNT+1
15461      ITEXT(ICNT)='Minimum Lab Mean:'
15462      NCTEXT(ICNT)=17
15463      AVALUE(ICNT)=AMNX
15464      IDIGIT(ICNT)=NUMDIG
15465      ICNT=ICNT+1
15466      ITEXT(ICNT)='Maximum Lab Mean:'
15467      NCTEXT(ICNT)=17
15468      AVALUE(ICNT)=AMXX
15469      IDIGIT(ICNT)=NUMDIG
15470      ICNT=ICNT+1
15471      ITEXT(ICNT)='Minimum Lab SD:'
15472      NCTEXT(ICNT)=15
15473      AVALUE(ICNT)=AMNSD
15474      IDIGIT(ICNT)=NUMDIG
15475      ICNT=ICNT+1
15476      ITEXT(ICNT)='Maximum Lab SD:'
15477      NCTEXT(ICNT)=15
15478      AVALUE(ICNT)=AMXSD
15479      IDIGIT(ICNT)=NUMDIG
15480      IF(IUNCFL.EQ.'OFF')THEN
15481        ICNT=ICNT+1
15482        ITEXT(ICNT)='Within Lab (pooled) SD:'
15483        NCTEXT(ICNT)=23
15484        AVALUE(ICNT)=SQRT(S2WPOO)
15485        IDIGIT(ICNT)=NUMDIG
15486        ICNT=ICNT+1
15487        ITEXT(ICNT)='Within Lab (pooled) Variance:'
15488        NCTEXT(ICNT)=29
15489        AVALUE(ICNT)=S2WPOO
15490        IDIGIT(ICNT)=NUMDIG
15491        ICNT=ICNT+1
15492        ITEXT(ICNT)='Mean of Lab Means:'
15493        NCTEXT(ICNT)=18
15494        AVALUE(ICNT)=ASM
15495        IDIGIT(ICNT)=NUMDIG
15496        ICNT=ICNT+1
15497        ITEXT(ICNT)='SD of Lab Means:'
15498        NCTEXT(ICNT)=16
15499        AVALUE(ICNT)=ASD2
15500        IDIGIT(ICNT)=NUMDIG
15501      ENDIF
15502C
15503      NUMROW=ICNT
15504      DO310I=1,NUMROW
15505        NTOT9(I)=15
15506  310 CONTINUE
15507C
15508      IFRST=.TRUE.
15509      ILAST=.FALSE.
15510      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
15511     1            AVALUE,IDIGIT,
15512     1            NTOT9,NUMROW,
15513     1            ICAPSW,ICAPTY,ILAST,IFRST,
15514     1            ISUBRO,IBUGA3,IERROR)
15515      ITITLE=' '
15516      NCTITL=0
15517      ITITLZ=' '
15518      NCTITZ=0
15519      ITITL9=' '
15520      NCTIT9=0
15521C
15522      IF(IUNCFL.EQ.'OFF')THEN
15523        ITITL9=' '
15524        NCTIT9=0
15525        ITITLE(1:42)='Table 1: Summary Statistics by Lab'
15526        NCTITL=34
15527        NUMLIN=3
15528        NUMCOL=6
15529        ITITL2(1,1)=' '
15530        ITITL2(2,1)='Lab'
15531        ITITL2(3,1)='ID'
15532        NCTIT2(1,1)=0
15533        NCTIT2(2,1)=3
15534        NCTIT2(3,1)=2
15535        ITITL2(1,2)=' '
15536        ITITL2(2,2)=' '
15537        ITITL2(3,2)='n(i)'
15538        NCTIT2(1,2)=0
15539        NCTIT2(2,2)=0
15540        NCTIT2(3,2)=4
15541        ITITL2(1,3)=' '
15542        ITITL2(2,3)=' '
15543        ITITL2(3,3)='Mean'
15544        NCTIT2(1,3)=0
15545        NCTIT2(2,3)=0
15546        NCTIT2(3,3)=4
15547        ITITL2(1,4)=' '
15548        ITITL2(2,4)=' '
15549        ITITL2(3,4)='Variance'
15550        NCTIT2(1,4)=0
15551        NCTIT2(2,4)=0
15552        NCTIT2(3,4)=8
15553        ITITL2(1,5)=' '
15554        ITITL2(2,5)='Standard'
15555        ITITL2(3,5)='Deviation'
15556        NCTIT2(1,5)=0
15557        NCTIT2(2,5)=8
15558        NCTIT2(3,5)=9
15559        ITITL2(1,6)='Standard'
15560        ITITL2(2,6)='Deviation'
15561        ITITL2(3,6)='of the Mean'
15562        NCTIT2(1,6)=8
15563        NCTIT2(2,6)=9
15564        NCTIT2(3,6)=11
15565        NMAX=0
15566        DO2401I=1,NUMCOL
15567          VALIGN(I)='b'
15568          ALIGN(I)='r'
15569          NTOT9(I)=15
15570          IF(I.EQ.1 .OR. I.EQ.2)NTOT9(I)=8
15571          NMAX=NMAX+NTOT9(I)
15572          IDIGIT(I)=NUMDIG
15573          ITYPCO(I)='NUME'
15574 2401   CONTINUE
15575C
15576        IWHTML(1)=75
15577        IWHTML(2)=75
15578        IWHTML(3)=125
15579        IWHTML(4)=125
15580        IWHTML(5)=125
15581        IWHTML(6)=125
15582        IWRTF(1)=800
15583        IWRTF(2)=IWRTF(1)+800
15584        IWRTF(3)=IWRTF(2)+1440
15585        IWRTF(4)=IWRTF(3)+1440
15586        IWRTF(5)=IWRTF(4)+1440
15587        IWRTF(6)=IWRTF(5)+1440
15588        IFRST=.TRUE.
15589        ILAST=.TRUE.
15590C
15591C       PRINT OUT 50 LINES AT A TIME
15592C
15593        NSTRT=1
15594        NSTOP=MIN(NLAB,50)
15595C
15596 2420   CONTINUE
15597        IDIGIT(1)=0
15598        IDIGIT(2)=0
15599        ICNT=0
15600        DO2423I=NSTRT,NSTOP
15601          ICNT=ICNT+1
15602          NCTEXT(ICNT)=0
15603          AMAT(ICNT,1)=PLABID(I)
15604          AMAT(ICNT,2)=REAL(N(I))
15605          AMAT(ICNT,3)=X(I)
15606          AMAT(ICNT,4)=ASD(I)**2
15607          AMAT(ICNT,5)=ASD(I)
15608          AMAT(ICNT,6)=SQRT(T(I))
15609          DO2425J=1,NUMCOL
15610            NCVALU(ICNT,J)=0
15611 2425     CONTINUE
15612 2423   CONTINUE
15613C
15614        NLABT=NSTOP-NSTRT+1
15615        IF(ICMET1.EQ.'ON')THEN
15616          CALL DPDTA4(ITITLE,NCTITL,
15617     1                ITITL9,NCTIT9,ITITL2,NCTIT2,
15618     1                MAXLIN,NUMLIN,NUMCLI,NUMCOL,
15619     1                ITEXT,NCVALU,AMAT,ITYPCO,MAXROW,NLABT,
15620     1                IDIGIT,NTOT9,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
15621     1                ICAPSW,ICAPTY,IFRST,ILAST,
15622     1                ISUBRO,IBUGA3,IERROR)
15623        ENDIF
15624C
15625        IF(NSTOP.LT.NLAB)THEN
15626          NSTRT=NSTOP+1
15627          NSTOP=NSTRT+50
15628          IF(NSTOP.GT.NLAB)NSTOP=NLAB
15629          GOTO2420
15630        ENDIF
15631      ELSE
15632        ITITL9=' '
15633        NCTIT9=0
15634        ITITLE(1:42)='Table 1: Summary Statistics by Lab'
15635        NCTITL=34
15636        NUMLIN=2
15637        NUMCOL=4
15638        ITITL2(1,1)='Lab'
15639        ITITL2(2,1)='ID'
15640        NCTIT2(1,1)=3
15641        NCTIT2(2,1)=2
15642        ITITL2(1,2)=' '
15643        ITITL2(2,2)='Mean'
15644        NCTIT2(1,2)=0
15645        NCTIT2(2,2)=4
15646        ITITL2(1,3)=' '
15647        ITITL2(2,3)='Uncertainty'
15648        NCTIT2(1,3)=0
15649        NCTIT2(2,3)=11
15650        ITITL2(1,4)='Effective'
15651        ITITL2(2,4)='Deg of Freedom'
15652        NCTIT2(1,4)=9
15653        NCTIT2(2,4)=14
15654        NMAX=0
15655        DO2501I=1,NUMCOL
15656          VALIGN(I)='b'
15657          ALIGN(I)='r'
15658          NTOT9(I)=15
15659          IF(I.EQ.1)NTOT9(I)=8
15660          NMAX=NMAX+NTOT9(I)
15661          IDIGIT(I)=NUMDIG
15662          ITYPCO(I)='NUME'
15663 2501   CONTINUE
15664C
15665        IWHTML(1)=75
15666        IWHTML(2)=125
15667        IWHTML(3)=125
15668        IWRTF(1)=800
15669        IWRTF(2)=IWRTF(1)+1440
15670        IWRTF(3)=IWRTF(2)+1440
15671        IFRST=.TRUE.
15672        ILAST=.TRUE.
15673C
15674C       PRINT OUT 50 LINES AT A TIME
15675C
15676        NSTRT=1
15677        NSTOP=MIN(NLAB,50)
15678C
15679 2520   CONTINUE
15680        IDIGIT(1)=0
15681        IDIGIT(4)=0
15682        ICNT=0
15683        DO2523I=NSTRT,NSTOP
15684          ICNT=ICNT+1
15685          NCTEXT(ICNT)=0
15686          AMAT(ICNT,1)=PLABID(I)
15687          AMAT(ICNT,2)=X(I)
15688          AMAT(ICNT,3)=SQRT(T(I))
15689          IF(N(I).GE.0)THEN
15690            AMAT(ICNT,4)=REAL(N(I)+0.1)
15691          ELSE
15692            AVAL=REAL(N(I))
15693            AVAL=ABS(AVAL)
15694            AMAT(ICNT,4)=AVAL+0.1
15695          ENDIF
15696          DO2525J=1,NUMCOL
15697            NCVALU(ICNT,J)=0
15698 2525    CONTINUE
15699 2523  CONTINUE
15700C
15701        NLABT=NSTOP-NSTRT+1
15702        IF(ICMET1.EQ.'ON')THEN
15703          CALL DPDTA4(ITITLE,NCTITL,
15704     1               ITITL9,NCTIT9,ITITL2,NCTIT2,
15705     1               MAXLIN,NUMLIN,NUMCLI,NUMCOL,
15706     1               ITEXT,NCVALU,AMAT,ITYPCO,MAXROW,NLABT,
15707     1               IDIGIT,NTOT9,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
15708     1               ICAPSW,ICAPTY,IFRST,ILAST,
15709     1               ISUBRO,IBUGA3,IERROR)
15710        ENDIF
15711C
15712        IF(NSTOP.LT.NLAB)THEN
15713          NSTRT=NSTOP+1
15714          NSTOP=NSTRT+50
15715          IF(NSTOP.GT.NLAB)NSTOP=NLAB
15716          GOTO2520
15717        ENDIF
15718      ENDIF
15719C
15720      DO4190I=1,NLAB
15721CCCCC   WRITE(IOUNI1,4196)REAL(I),REAL(N(I)),X(I),ASD(I)**2,
15722        WRITE(IOUNI1,4196)PLABID(I),REAL(N(I)),X(I),ASD(I)**2,
15723     1                    ASD(I),SQRT(T(I))
15724 4196   FORMAT(F6.0,2X,F6.0,2X,4E15.7)
15725 4190 CONTINUE
15726C
15727C               *****************************************
15728C               **  STEP 80--                          **
15729C               **  REMOVE ANY LABS WITH NON-POSITIVE  **
15730C               **  UNCERTAINTY                        **
15731C               *****************************************
15732C
15733 8000 CONTINUE
15734      ICNT=0
15735      ICNT2=0
15736      NLABF=NLAB
15737      NTOTF=NTOT
15738      DO9100I=1,NLAB
15739        AMEANF(I)=AMEAN(I)
15740        ASDF(I)=ASD(I)
15741        NFULL(I)=N(I)
15742        IF(ASD(I).GT.0.0)THEN
15743          ICNT=ICNT+1
15744          AMEAN(ICNT)=AMEAN(I)
15745          ASD(ICNT)=ASD(I)
15746          N(ICNT)=N(I)
15747          PLABID(ICNT)=PLABID(I)
15748          T(ICNT)=T(I)
15749          X(ICNT)=X(I)
15750          ICNT2=ICNT2+N(I)
15751        ELSE
15752          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
15753            WRITE(ICOUT,9201)
15754 9201       FORMAT('<PRE>')
15755            CALL DPWRST('XXX','WRIT')
15756          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
15757            WRITE(ICOUT,9301)IBASLC
15758 9301       FORMAT(A1,'begin{verbatim}')
15759            CALL DPWRST('XXX','WRIT')
15760          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
15761            IRTFMD='VERB'
15762          ELSE
15763            WRITE(ICOUT,999)
15764            CALL DPWRST('XXX','BUG ')
15765          ENDIF
15766C
15767          WRITE(ICOUT,9103)I
15768 9103     FORMAT('LAB ',I8,' HAS A NON-POSITIVE STANDARD DEVIATION.')
15769          CALL DPWRST('XXX','WRIT')
15770          WRITE(ICOUT,9105)
15771 9105     FORMAT('THIS LAB WILL BE OMITTED FROM THE ANALYSIS EXCEPT ',
15772     1           'FOR')
15773          CALL DPWRST('XXX','WRIT')
15774          WRITE(ICOUT,9107)
15775 9107     FORMAT('METHODS GRAND MEAN, MEAN/MEDIAN OF MEANS, BOB, AND ',
15776     1           'BCP.')
15777          CALL DPWRST('XXX','WRIT')
15778C
15779          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
15780            WRITE(ICOUT,9211)
15781 9211       FORMAT('</PRE>')
15782            CALL DPWRST('XXX','WRIT')
15783          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
15784            WRITE(ICOUT,9311)IBASLC
15785 9311       FORMAT(A1,'end{verbatim}')
15786            CALL DPWRST('XXX','WRIT')
15787          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
15788            IRTFMD='OFF'
15789          ELSE
15790            WRITE(ICOUT,999)
15791            CALL DPWRST('XXX','BUG ')
15792          ENDIF
15793        ENDIF
15794 9100 CONTINUE
15795      NLAB=ICNT
15796      NTOT=ICNT2
15797C
15798C               *****************
15799C               **  STEP 90--  **
15800C               **  EXIT       **
15801C               *****************
15802C
15803 9000 CONTINUE
15804      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN4')THEN
15805        WRITE(ICOUT,999)
15806        CALL DPWRST('XXX','BUG ')
15807        WRITE(ICOUT,9011)
15808 9011   FORMAT('***** AT THE END       OF DPMAN4--')
15809        CALL DPWRST('XXX','BUG ')
15810        WRITE(ICOUT,9012)IERROR
15811 9012   FORMAT('IERROR = ',A4)
15812        CALL DPWRST('XXX','BUG ')
15813        WRITE(ICOUT,9013)NTOT
15814 9013   FORMAT('NTOT = ',I8)
15815        CALL DPWRST('XXX','BUG ')
15816        WRITE(ICOUT,9014)IBUGA3
15817 9014   FORMAT('IBUGA3 = ',A4)
15818        CALL DPWRST('XXX','BUG ')
15819      ENDIF
15820C
15821      RETURN
15822      END
15823      SUBROUTINE DPMAN5(NPTS,NLAB,
15824     1                  XGRAND,XMPS,XMMPS,XMLS,XSE,
15825     1                  ASM,XGD,XGCI,XDL,XFAIR,XBCP,
15826     1                  DLOWMP,DHIGMP,DLOWMM,DHIGMM,DLOWML,DHIGML,
15827     1                  DLOWM2,DHIGM2,
15828     1                  DLOWBO,DHIGBO,DLOWSE,DHIGSE,DLOWT1,DHIGT1,
15829     1                  DLOWT2,DHIGT2,DLOWGD,DHIGGD,DLOWGC,DHIGGC,
15830     1                  DLOWDL,DHIGDL,DLOWD2,DHIGD2,DLOWD3,DHIGD3,
15831     1                  DLOWD4,DHIGD4,DLOWD5,DHIGD5,DLOWD6,DHIGD6,
15832     1                  DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
15833     1                  DLOWBC,DHIGBC,
15834     1                  XMEDME,SEMED,
15835     1                  DLWME0,DHGME0,DLWME1,DHGME1,
15836     1                  DLWME2,DHGME2,DLWME3,DHGME3,
15837     1                  SEMPK1,SEMMP1,SEMLK1,SEMLBO,AKUK1,SESUK1,SET2K1,
15838     1                  SET1K1,SEGDK1,SEDLK1,SEHDK1,SERUK1,SEBOK1,SEGCI,
15839     1                  SEFWK1,XBCPK1,SEMEDB,ALOWCL,AUPPCL,SEMEK1,
15840     1                  XH15,SEHMK1,
15841     1                  IWRITE,IOUNI2,
15842     1                  ICAPSW,ICAPTY,NUMDIG,IFLAG9,
15843     1                  ISUBRO,IBUGA3,IERROR)
15844C
15845C     PURPOSE--GENERATE THE CONFIDENCE INTERVAL TABLE FOR THE
15846C              CONSENSUS MEANS COMMAND
15847C     PRINTING--YES
15848C     SUBROUTINES NEEDED--NONE
15849C     WRITTEN BY--ALAN HECKERT
15850C                 STATISTICAL ENGINEERING DIVISION
15851C                 INFORMATION TECHNOLOGY LABORATORY
15852C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
15853C                 GAITHERSBURG, MD 20899-8980
15854C                 PHONE--301-975-2899
15855C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
15856C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
15857C     LANGUAGE--ANSI FORTRAN (1977)
15858C     VERSION NUMBER--2006/3
15859C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2
15860C                                       ROUTINE
15861C     UPDATED  VERSION--JUNE      2006. ADD FAIRWEATHER, BCP
15862C     UPDATED  VERSION--FEBRUARY  2010. USE DPDTA4 TO PRINT TABLE
15863C     UPDATED  VERSION--MAY       2010. MODIFICATIONS TO DERSIMONIAN-LARID
15864C     UPDATED  VERSION--OCTOBER   2011. DERSIMONIAN-LARID BOOTSTRAP
15865C     UPDATED  VERSION--OCTOBER   2011. VANGEL-RUKHIN BOOTSTRAP
15866C     UPDATED  VERSION--OCTOBER   2012. DERSIMONIAN-LARID BOOTSTRAP UPDATES
15867C     UPDATED  VERSION--OCTOBER   2012. MEDIAN OF MEANS UPDATE
15868C     UPDATED  VERSION--JUNE      2013. ADD "UNCERTAINTY INTERVAL" TO
15869C                                       TABLE
15870C     UPDATED  VERSION--AUGUST    2014. FOR DSL, K FACTOR WAS COMPUTED
15871C                                       USING MANDEL-PAULE CONSENSUS
15872C                                       VALUE.  CORRECTED TO USE DSL
15873C                                       CONSENSUS VALUE.
15874C     UPDATED  VERSION--JANUARY   2017. OPTION TO SUPPRESS PRINTING
15875C                                       TABLE (ICMET3)
15876C     UPDATED  VERSION--MARCH     2017. MEDIAN OF MEANS UPDATE
15877C     UPDATED  VERSION--MARCH     2017. HUBER H15 MEAN OF MEANS UPDATE
15878C
15879C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
15880C
15881      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
15882C
15883      CHARACTER*4 ICAPSW
15884      CHARACTER*4 ICAPTY
15885      CHARACTER*4 ISUBRO
15886      CHARACTER*4 IBUGA3
15887      CHARACTER*4 IERROR
15888C
15889      CHARACTER*4 IWRITE
15890      CHARACTER*4 ISUBN1
15891      CHARACTER*4 ISUBN2
15892C
15893      CHARACTER*45 IMETH
15894C
15895      REAL XMPS
15896      REAL XMMPS
15897      REAL XMLS
15898      REAL ASM
15899      REAL XGRAND
15900      REAL XGD
15901      REAL XSE
15902      REAL XGCI
15903      REAL XDL
15904      REAL XFAIR
15905      REAL XBCP
15906      REAL XMEDME
15907      REAL SEMED
15908      REAL SEMPK1
15909      REAL SEMMP1
15910      REAL SEMLK1
15911      REAL SEMLBO
15912      REAL SEHDK1
15913      REAL SEGCI
15914      REAL AKUK1
15915      REAL SESUK1
15916      REAL SET2K1
15917      REAL SET1K1
15918      REAL SEGDK1
15919      REAL SEDLK1
15920      REAL SEFWK1
15921      REAL XBCPK1
15922      REAL SEMEDB
15923      REAL SERUK1
15924      REAL ALOWCL
15925      REAL AUPPCL
15926      REAL SEMEK1
15927      REAL XH15
15928      REAL SEHMK1
15929C
15930C----------------------------------------------------------------
15931C
15932      INCLUDE 'DPCOST.INC'
15933C
15934      PARAMETER(MAXLIN=2)
15935      PARAMETER(MAXROW=20)
15936      PARAMETER(MAXCOL=5)
15937      CHARACTER*4  ALIGN(MAXCOL)
15938      CHARACTER*4  VALIGN(MAXCOL)
15939      INTEGER      IDIGIT(MAXCOL)
15940      INTEGER      NTOT(MAXCOL)
15941      INTEGER      IWHTML(MAXCOL)
15942      INTEGER      IWRTF(MAXCOL)
15943      INTEGER      NCTEXT(MAXROW,MAXCOL)
15944      INTEGER      NCTIT2(MAXLIN,MAXCOL)
15945      CHARACTER*40 ITITL9
15946      CHARACTER*40 ITITLE
15947      CHARACTER*20 ITITL2(MAXLIN,MAXCOL)
15948      CHARACTER*40 ITEXT(MAXROW,MAXCOL)
15949      CHARACTER*4  ITYPCO(MAXCOL)
15950      REAL         AMAT(MAXROW,MAXCOL)
15951      LOGICAL      IFRST
15952      LOGICAL      ILAST
15953      LOGICAL      IFLAG9
15954C
15955      INCLUDE 'DPCOP2.INC'
15956C
15957C-----START POINT------------------------------------------------
15958C
15959      IERROR='NO'
15960      ISUBN1='DPMA'
15961      ISUBN2='N5  '
15962C
15963      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN5')THEN
15964        WRITE(ICOUT,999)
15965  999   FORMAT(1X)
15966        CALL DPWRST('XXX','BUG ')
15967        WRITE(ICOUT,51)
15968   51   FORMAT('***** AT THE BEGINNING OF DPMAN5--')
15969        CALL DPWRST('XXX','BUG ')
15970        WRITE(ICOUT,52)NPTS,NLAB,IWRITE
15971   52   FORMAT('NPTS,NLAB,IWRITE = ',2I8,2X,A4)
15972        CALL DPWRST('XXX','BUG ')
15973        WRITE(ICOUT,54)AKUK1,DHGME0,DHGME1,DHGME2,DHGME3
15974   54   FORMAT('AKUK1,DHGME0,DHGME1,DHGME2,DHGME3 = ',5G15.7)
15975        CALL DPWRST('XXX','BUG ')
15976        WRITE(ICOUT,56)DLWME0,DLWME1,DLWME2,DLWME3
15977   56   FORMAT('DLWME0,DLWME1,DLWME2,DLWME3 = ',4G15.7)
15978        CALL DPWRST('XXX','BUG ')
15979        WRITE(ICOUT,58)SEBOK1,SEDLK1,SEFWK1,SEGCI,SEGDK1
15980   58   FORMAT('SEBOK1,SEDLK1,SEFWK1,SEGCI,SEGDK1 = ',5G15.7)
15981        CALL DPWRST('XXX','BUG ')
15982        WRITE(ICOUT,59)SEMED,SEMEDB,SEMEK1,SEMLBO,SEMLK1
15983   59   FORMAT('SEMED,SEMEDB,SEMEK1,SEMLBO,SEMKL1 = ',5G15.7)
15984        CALL DPWRST('XXX','BUG ')
15985        WRITE(ICOUT,61)SEMMP1,SEMPK1,SERUK1,SESUK1
15986   61   FORMAT('SEMMP1,SEMPK1,SERUK1,SESUK1 = ',4G15.7)
15987        CALL DPWRST('XXX','BUG ')
15988        WRITE(ICOUT,63)SET1K1,SET2K1,XBCPK1,SEHDK1
15989   63   FORMAT('SET1K1,SET2K1,XBCPK1,SEHDK1 = ',4G15.7)
15990        CALL DPWRST('XXX','BUG ')
15991      ENDIF
15992C
15993      NCTIT9=0
15994      ITITL9=' '
15995      NCTITL=34
15996      ITITLE(1:NCTITL)='Table 2:  95% Confidence Limits'
15997      NUMLIN=2
15998      NUMCOL=5
15999      ITITL2(1,1)=' '
16000      ITITL2(2,1)='Method'
16001      ITITL2(1,2)='Consensus'
16002      ITITL2(2,2)='Mean'
16003      ITITL2(1,3)='Lower'
16004      ITITL2(2,3)='Limit'
16005      ITITL2(1,4)='Upper'
16006      ITITL2(2,4)='Limit'
16007      ITITL2(1,5)='Uncertainty'
16008      ITITL2(2,5)='(k*SE)'
16009      NCTIT2(1,1)=0
16010      NCTIT2(2,1)=6
16011      NCTIT2(1,2)=9
16012      NCTIT2(2,2)=4
16013      NCTIT2(1,3)=5
16014      NCTIT2(2,3)=5
16015      NCTIT2(1,4)=5
16016      NCTIT2(2,4)=5
16017      NCTIT2(1,5)=11
16018      NCTIT2(2,5)=6
16019      NMAX=0
16020      NTOT(1)=40
16021      NTOT(2)=15
16022      NTOT(3)=15
16023      NTOT(4)=15
16024      NTOT(5)=15
16025      DO4010J=1,MAXCOL
16026        VALIGN(J)='b'
16027        ALIGN(J)='r'
16028        NMAX=NMAX+NTOT(J)
16029        IDIGIT(J)=NUMDIG
16030        IWHTML(J)=125
16031        ITYPCO(J)='NUME'
16032 4010 CONTINUE
16033      ITYPCO(1)='ALPH'
16034      ALIGN(1)='l'
16035      IWHTML(1)=225
16036      IWRTF(1)=3800
16037      IWRTF(2)=IWRTF(1)+1700
16038      IWRTF(3)=IWRTF(2)+1700
16039      IWRTF(4)=IWRTF(3)+1700
16040      IWRTF(5)=IWRTF(4)+1700
16041C
16042C     POPULATE ROWS OF ARRAY.  NOTE THAT SPECIFIC METHODS ARE
16043C     CONDITIONAL.
16044C
16045      ICNT=0
16046C
16047      DO4020I=1,MAXROW
16048        DO4030J=1,MAXCOL
16049          AMAT(I,J)=0.0
16050          NCTEXT(I,J)=0
16051          ITEXT(I,J)=' '
16052 4030   CONTINUE
16053 4020 CONTINUE
16054C
16055C     2013/06: ADD THE "UNCERTAINTY INTERVAL" TO THE TABLE.  THIS IS
16056C     "K*STANDARD ERROR".  PRINT THIS IN THE TABLE BECAUSE THIS IS THE
16057C     VALUE THAT WILL BE EXTRACTED FOR THE CERTIFICATE.
16058C
16059      ISTRT=0
16060      IF(IMPACM.EQ.'ON' .AND. XMPS.NE.CPUMIN)THEN
16061        ICNT=ICNT+1
16062        ITEXT(ICNT,1)='  1. Mandel-Paule'
16063        NCTEXT(ICNT,1)=17
16064        AMAT(ICNT,ISTRT+1)=0.0
16065        AMAT(ICNT,ISTRT+2)=XMPS
16066        AMAT(ICNT,ISTRT+3)=DLOWMP
16067        AMAT(ICNT,ISTRT+4)=DHIGMP
16068        AKL=XMPS - DLOWMP
16069        AKU=DHIGMP - XMPS
16070CCCCC   AK=0.0
16071CCCCC   IF(SEMPK1.NE.0.0)AK=MAX(AKL,AKU)/SEMPK1
16072        AK=MAX(AKL,AKU)
16073        AMAT(ICNT,ISTRT+5)=AK
16074        IMETH='Mandel-Paule'
16075        WRITE(IOUNI2,4001)XMPS,DLOWMP,DHIGMP,AK,IMETH
16076 4001   FORMAT(4E15.7,15X,A45)
16077      ENDIF
16078C
16079      IF(IMMPCM.EQ.'ON' .AND. XMMPS.NE.CPUMIN)THEN
16080        ICNT=ICNT+1
16081        ITEXT(ICNT,1)='  2. Modified Mandel-Paule'
16082        NCTEXT(ICNT,1)=26
16083        AMAT(ICNT,ISTRT+1)=0.0
16084        AMAT(ICNT,ISTRT+2)=XMMPS
16085        AMAT(ICNT,ISTRT+3)=DLOWMM
16086        AMAT(ICNT,ISTRT+4)=DHIGMM
16087        AKL=XMMPS - DLOWMM
16088        AKU=DHIGMM - XMMPS
16089CCCCC   AK=0.0
16090CCCCC   IF(SEMMP1.NE.0.0)AK=MAX(AKL,AKU)/SEMMP1
16091        AK=MAX(AKL,AKU)
16092        AMAT(ICNT,ISTRT+5)=AK
16093        IMETH='Modified Mandel-Paule'
16094        WRITE(IOUNI2,4001)XMMPS,DLOWMM,DHIGMM,AK,IMETH
16095      ENDIF
16096C
16097      IF(IVRUCM.EQ.'ON' .AND. XMLS.NE.CPUMIN)THEN
16098        ICNT=ICNT+1
16099        ITEXT(ICNT,1)=' 3a. Vangel-Rukhin ML'
16100        NCTEXT(ICNT,1)=21
16101        AMAT(ICNT,ISTRT+1)=0.0
16102        AMAT(ICNT,ISTRT+2)=XMLS
16103        AMAT(ICNT,ISTRT+3)=DLOWML
16104        AMAT(ICNT,ISTRT+4)=DHIGML
16105        AKL=XMLS - DLOWML
16106        AKU=DHIGML - XMLS
16107CCCCC   AK=0.0
16108CCCCC   IF(SEMLK1.NE.0.0)AK=MAX(AKL,AKU)/SEMLK1
16109        AK=MAX(AKL,AKU)
16110        AMAT(ICNT,ISTRT+5)=AK
16111        IMETH='Vangel-Rukhin ML'
16112        WRITE(IOUNI2,4001)XMLS,DLOWML,DHIGML,AK,IMETH
16113      ENDIF
16114C
16115      IF(IVRBCM.EQ.'ON' .AND. XMLS.NE.CPUMIN)THEN
16116        ICNT=ICNT+1
16117        ITEXT(ICNT,1)=' 3b. Vangel-Rukhin (bootstrap)'
16118        NCTEXT(ICNT,1)=30
16119        AMAT(ICNT,ISTRT+1)=0.0
16120        AMAT(ICNT,ISTRT+2)=XMLS
16121        AMAT(ICNT,ISTRT+3)=DLOWM2
16122        AMAT(ICNT,ISTRT+4)=DHIGM2
16123        AKL=XMLS - DLOWM2
16124        AKU=DHIGM2 - XMLS
16125CCCCC   AK=0.0
16126CCCCC   IF(SEMLBO.NE.0.0)AK=MAX(AKL,AKU)/SEMLBO
16127        AK=MAX(AKL,AKU)
16128        AMAT(ICNT,ISTRT+5)=AK
16129        IMETH='Vangel-Rukhin Bootstrap'
16130        WRITE(IOUNI2,4001)XMLS,DLOWM2,DHIGM2,AK,IMETH
16131      ENDIF
16132C
16133      IF(IDSLCM.EQ.'ON' .AND. XDL.NE.CPUMIN)THEN
16134        ICNT=ICNT+1
16135        ITEXT(ICNT,1)=' 4a. DerSimonian-Laird (original)'
16136        NCTEXT(ICNT,1)=33
16137        AMAT(ICNT,ISTRT+1)=0.0
16138        AMAT(ICNT,ISTRT+2)=XDL
16139        AMAT(ICNT,ISTRT+3)=DLOWDL
16140        AMAT(ICNT,ISTRT+4)=DHIGDL
16141        AKL=XDL - DLOWDL
16142        AKU=DHIGDL - XDL
16143CCCCC   AK=0.0
16144CCCCC   IF(SEDLK1.NE.0.0)AK=MAX(AKL,AKU)/SEDLK1
16145        AK=MAX(AKL,AKU)
16146        AMAT(ICNT,ISTRT+5)=AK
16147        IMETH='DerSimonian-Laird (original)'
16148        WRITE(IOUNI2,4001)XDL,DLOWDL,DHIGDL,AK,IMETH
16149      ENDIF
16150C
16151      IF(IDS2CM.EQ.'ON' .AND. XDL.NE.CPUMIN)THEN
16152        ICNT=ICNT+1
16153        ITEXT(ICNT,1)=' 4b. DerSimonian-Laird (H-H-D)'
16154        NCTEXT(ICNT,1)=30
16155        AMAT(ICNT,ISTRT+1)=0.0
16156        AMAT(ICNT,ISTRT+2)=XDL
16157        AMAT(ICNT,ISTRT+3)=DLOWD3
16158        AMAT(ICNT,ISTRT+4)=DHIGD3
16159        AKL=XDL - DLOWD3
16160        AKU=DHIGD3 - XDL
16161CCCCC   AK=0.0
16162CCCCC   IF(SEHDK1.NE.0.0)AK=MAX(AKL,AKU)/SEHDK1
16163        AK=MAX(AKL,AKU)
16164        AMAT(ICNT,ISTRT+5)=AK
16165        IMETH='DerSimonian-Laird (HHD)'
16166        WRITE(IOUNI2,4001)XDL,DLOWD3,DHIGD3,AK,IMETH
16167      ENDIF
16168C
16169      IF(IDS3CM.EQ.'ON' .AND. XDL.NE.CPUMIN)THEN
16170        ICNT=ICNT+1
16171        ITEXT(ICNT,1)=' 4c. DerSimonian-Laird (minmax)'
16172        NCTEXT(ICNT,1)=31
16173        AMAT(ICNT,ISTRT+1)=0.0
16174        AMAT(ICNT,ISTRT+2)=XDL
16175        AMAT(ICNT,ISTRT+3)=DLOWD2
16176        AMAT(ICNT,ISTRT+4)=DHIGD2
16177        AKL=XDL - DLOWD2
16178        AKU=DHIGD2 - XDL
16179CCCCC   AK=0.0
16180CCCCC   IF(SERUK1.NE.0.0)AK=MAX(AKL,AKU)/SERUK1
16181        AK=MAX(AKL,AKU)
16182        AMAT(ICNT,ISTRT+5)=AK
16183        IMETH='DerSimonian-Laird (Minmax)'
16184        WRITE(IOUNI2,4001)XDL,DLOWD2,DHIGD2,AK,IMETH
16185      ENDIF
16186C
16187      IF(IDS4CM.EQ.'ON' .AND. XDL.NE.CPUMIN)THEN
16188        ICNT=ICNT+1
16189        ITEXT(ICNT,1)=' 4d. DerSimonian-Laird (perc. bootstrap)'
16190        NCTEXT(ICNT,1)=41
16191        AMAT(ICNT,ISTRT+1)=0.0
16192        AMAT(ICNT,ISTRT+2)=XDL
16193        AMAT(ICNT,ISTRT+3)=DLOWD4
16194        AMAT(ICNT,ISTRT+4)=DHIGD4
16195        AKL=XDL - DLOWD4
16196        AKU=DHIGD4 - XDL
16197CCCCC   AK=0.0
16198CCCCC   IF(SEBOK1.NE.0.0)AK=MAX(AKL,AKU)/SEBOK1
16199        AK=MAX(AKL,AKU)
16200        AMAT(ICNT,ISTRT+5)=AK
16201        IMETH='DSL (Percentile Bootstrap)'
16202        WRITE(IOUNI2,4001)XDL,DLOWD4,DHIGD4,AK,IMETH
16203CC
16204        ICNT=ICNT+1
16205        ITEXT(ICNT,1)=' 4d. DerSimonian-Laird (symm. bootstrap)'
16206        NCTEXT(ICNT,1)=40
16207        AMAT(ICNT,ISTRT+1)=0.0
16208        AMAT(ICNT,ISTRT+2)=XDL
16209        AMAT(ICNT,ISTRT+3)=DLOWD5
16210        AMAT(ICNT,ISTRT+4)=DHIGD5
16211        AKL=XDL - DLOWD5
16212        AKU=DHIGD5 - XDL
16213CCCCC   AK=0.0
16214CCCCC   IF(SEBOK1.NE.0.0)AK=MAX(AKL,AKU)/SEBOK1
16215        AK=MAX(AKL,AKU)
16216        AMAT(ICNT,ISTRT+5)=AK
16217        IMETH='DerSimonian-Laird (Symmetric Bootstrap)'
16218        WRITE(IOUNI2,4001)XDL,DLOWD5,DHIGD5,AK,IMETH
16219CC
16220        ICNT=ICNT+1
16221        ITEXT(ICNT,1)=' 4d. DerSimonian-Laird (kern bootstrap)'
16222        NCTEXT(ICNT,1)=39
16223        AMAT(ICNT,ISTRT+1)=0.0
16224        AMAT(ICNT,ISTRT+2)=XDL
16225        AMAT(ICNT,ISTRT+3)=DLOWD6
16226        AMAT(ICNT,ISTRT+4)=DHIGD6
16227        AKL=XDL - DLOWD6
16228        AKU=DHIGD6 - XDL
16229CCCCC   AK=0.0
16230CCCCC   IF(SEBOK1.NE.0.0)AK=MAX(AKL,AKU)/SEBOK1
16231        AK=MAX(AKL,AKU)
16232        AMAT(ICNT,ISTRT+5)=AK
16233        IMETH='DerSimonian-Laird (Kernel Bootstrap)'
16234        WRITE(IOUNI2,4001)XDL,DLOWD6,DHIGD6,AK,IMETH
16235      ENDIF
16236C
16237      IF(IGRDCM.EQ.'ON' .AND. XGD.NE.CPUMIN)THEN
16238        ICNT=ICNT+1
16239        ITEXT(ICNT,1)='  5. Graybill-Deal'
16240        NCTEXT(ICNT,1)=18
16241        AMAT(ICNT,ISTRT+1)=0.0
16242        AMAT(ICNT,ISTRT+2)=XGD
16243        AMAT(ICNT,ISTRT+3)=DLOWGD
16244        AMAT(ICNT,ISTRT+4)=DHIGGD
16245        AKL=XGD - DLOWGD
16246        AKU=DHIGGD - XGD
16247CCCCC   AK=0.0
16248CCCCC   IF(SEGDK1.NE.0.0)AK=MAX(AKL,AKU)/SEGDK1
16249        AK=MAX(AKL,AKU)
16250        AMAT(ICNT,ISTRT+5)=AK
16251        IMETH='Graybill-Deal'
16252        WRITE(IOUNI2,4001)XGD,DLOWGD,DHIGGD,AK,IMETH
16253      ENDIF
16254C
16255      IF(IFAICM.EQ.'ON' .AND. IFLAG9 .AND. XFAIR.NE.CPUMIN)THEN
16256        ICNT=ICNT+1
16257        ITEXT(ICNT,1)=' 6a. Fairweather (Fairweather)'
16258        NCTEXT(ICNT,1)=31
16259        AMAT(ICNT,ISTRT+1)=0.0
16260        AMAT(ICNT,ISTRT+2)=XFAIR
16261        AMAT(ICNT,ISTRT+3)=DLOWF2
16262        AMAT(ICNT,ISTRT+4)=DHIGF2
16263        AKL=XFAIR - DLOWF2
16264        AKU=DHIGF2 - XFAIR
16265CCCCC   AK=0.0
16266CCCCC   IF(SEFWK1.NE.0.0)AK=MAX(AKL,AKU)/SEFWK1
16267        AK=MAX(AKL,AKU)
16268        AMAT(ICNT,ISTRT+5)=AK
16269        IMETH='Fairweather (Fairweather)'
16270        WRITE(IOUNI2,4001)XFAIR,DLOWF2,DHIGF2,AK,IMETH
16271        ICNT=ICNT+1
16272        ITEXT(ICNT,1)=' 6b. Fairweather (Cox)'
16273        NCTEXT(ICNT,1)=23
16274        AMAT(ICNT,ISTRT+1)=0.0
16275        AMAT(ICNT,ISTRT+2)=XFAIR
16276        AMAT(ICNT,ISTRT+3)=DLOWF3
16277        AMAT(ICNT,ISTRT+4)=DHIGF3
16278        AKL=XFAIR - DLOWF3
16279        AKU=DHIGF3 - XFAIR
16280CCCCC   AK=0.0
16281CCCCC   IF(SEFWK1.NE.0.0)AK=MAX(AKL,AKU)/SEFWK1
16282        AK=MAX(AKL,AKU)
16283        AMAT(ICNT,ISTRT+5)=AK
16284        IMETH='Fairweather (Cox)'
16285        WRITE(IOUNI2,4001)XFAIR,DLOWF3,DHIGF3,AK,IMETH
16286        ICNT=ICNT+1
16287        ITEXT(ICNT,1)=' 6c. Fairweather (Minmax)'
16288        NCTEXT(ICNT,1)=26
16289        AMAT(ICNT,ISTRT+1)=0.0
16290        AMAT(ICNT,ISTRT+2)=XFAIR
16291        AMAT(ICNT,ISTRT+3)=DLOWFW
16292        AMAT(ICNT,ISTRT+4)=DHIGFW
16293        AKL=XFAIR - DLOWFW
16294        AKU=DHIGFW - XFAIR
16295CCCCC   AK=0.0
16296CCCCC   IF(SEFWK1.NE.0.0)AK=MAX(AKL,AKU)/SEFWK1
16297        AK=MAX(AKL,AKU)
16298        AMAT(ICNT,ISTRT+5)=AK
16299        IMETH='Fairweather (Minmax)'
16300        WRITE(IOUNI2,4001)XFAIR,DLOWFW,DHIGFW,AK,IMETH
16301      ENDIF
16302C
16303      IF(IGCICM.EQ.'ON' .AND. XGCI.NE.CPUMIN)THEN
16304        ICNT=ICNT+1
16305        ITEXT(ICNT,1)='  7. Generalized CI'
16306        NCTEXT(ICNT,1)=20
16307        AMAT(ICNT,ISTRT+1)=0.0
16308        AMAT(ICNT,ISTRT+2)=XGCI
16309        AMAT(ICNT,ISTRT+3)=DLOWGC
16310        AMAT(ICNT,ISTRT+4)=DHIGGC
16311        AKL=XGCI - DLOWGC
16312        AKU=DHIGGC - XGCI
16313CCCCC   AK=0.0
16314CCCCC   IF(SEGCI.NE.0.0)AK=MAX(AKL,AKU)/SEGCI
16315        AK=MAX(AKL,AKU)
16316        AMAT(ICNT,ISTRT+5)=AK
16317        IMETH='Generalized CI'
16318        WRITE(IOUNI2,4001)XGCI,DLOWGC,DHIGGC,AK,IMETH
16319      ENDIF
16320C
16321      IF(IGMECM.EQ.'ON' .AND. XGRAND.NE.CPUMIN)THEN
16322        ICNT=ICNT+1
16323        ITEXT(ICNT,1)='  8. Grand Mean'
16324        NCTEXT(ICNT,1)=16
16325        AMAT(ICNT,ISTRT+1)=0.0
16326        AMAT(ICNT,ISTRT+2)=XGRAND
16327        AMAT(ICNT,ISTRT+3)=DLOWT2
16328        AMAT(ICNT,ISTRT+4)=DHIGT2
16329        AKL=XGRAND - DLOWT2
16330        AKU=DHIGT2 - XGRAND
16331CCCCC   AK=0.0
16332CCCCC   IF(SET1K1.NE.0.0)AK=MAX(AKL,AKU)/SET1K1
16333        AK=MAX(AKL,AKU)
16334        AMAT(ICNT,ISTRT+5)=AK
16335        IMETH='Grand Mean'
16336        WRITE(IOUNI2,4001)XGRAND,DLOWT2,DHIGT2,AK,IMETH
16337      ENDIF
16338C
16339      IF(IMOMCM.EQ.'ON' .AND. ASM.NE.CPUMIN)THEN
16340        ICNT=ICNT+1
16341        ITEXT(ICNT,1)='  9. Mean of Means'
16342        NCTEXT(ICNT,1)=18
16343        AMAT(ICNT,ISTRT+1)=0.0
16344        AMAT(ICNT,ISTRT+2)=ASM
16345        AMAT(ICNT,ISTRT+3)=DLOWT1
16346        AMAT(ICNT,ISTRT+4)=DHIGT1
16347        AKL=ASM - DLOWT1
16348        AKU=DHIGT1 - ASM
16349CCCCC   AK=0.0
16350CCCCC   IF(SET2K1.NE.0.0)AK=MAX(AKL,AKU)/SET2K1
16351        AK=MAX(AKL,AKU)
16352        AMAT(ICNT,ISTRT+5)=AK
16353        IMETH='Mean of Means'
16354        WRITE(IOUNI2,4001)ASM,DLOWT1,DHIGT1,AK,IMETH
16355      ENDIF
16356C
16357      IF(IBOBCM.EQ.'ON' .AND. ASM.NE.CPUMIN)THEN
16358        ICNT=ICNT+1
16359        ITEXT(ICNT,1)=' 11. BOB'
16360        NCTEXT(ICNT,1)=8
16361        AMAT(ICNT,ISTRT+1)=0.0
16362        AMAT(ICNT,ISTRT+2)=ASM
16363        AMAT(ICNT,ISTRT+3)=DLOWBO
16364        AMAT(ICNT,ISTRT+4)=DHIGBO
16365        AKL=ASM - DLOWBO
16366        AKU=DHIGBO - ASM
16367CCCCC   AK=0.0
16368CCCCC   IF(AKUK1.NE.0.0)AK=MAX(AKL,AKU)/AKUK1
16369        AK=MAX(AKL,AKU)
16370        AMAT(ICNT,ISTRT+5)=AK
16371        IMETH='Bob'
16372        WRITE(IOUNI2,4001)ASM,DLOWBO,DHIGBO,AK,IMETH
16373      ENDIF
16374C
16375      IF(ISCECM.EQ.'ON' .AND. XSE.NE.CPUMIN)THEN
16376        ICNT=ICNT+1
16377        ITEXT(ICNT,1)=' 12. Schiller-Eberhardt'
16378        NCTEXT(ICNT,1)=23
16379        AMAT(ICNT,ISTRT+1)=0.0
16380        AMAT(ICNT,ISTRT+2)=XSE
16381        AMAT(ICNT,ISTRT+3)=DLOWSE
16382        AMAT(ICNT,ISTRT+4)=DHIGSE
16383        AKL=XSE - DLOWSE
16384        AKU=DHIGSE - XSE
16385CCCCC   AK=0.0
16386CCCCC   IF(SESUK1.NE.0.0)AK=MAX(AKL,AKU)/SESUK1
16387        AK=MAX(AKL,AKU)
16388        AMAT(ICNT,ISTRT+5)=AK
16389        IMETH='Schiller-Eberhardt'
16390        WRITE(IOUNI2,4001)XSE,DLOWSE,DHIGSE,AK,IMETH
16391      ENDIF
16392C
16393      IF(IBCPCM.EQ.'ON' .AND. XBCP.NE.CPUMIN)THEN
16394        ICNT=ICNT+1
16395        ITEXT(ICNT,1)=' 13. BCP'
16396        NCTEXT(ICNT,1)=9
16397        AMAT(ICNT,ISTRT+1)=0.0
16398        AMAT(ICNT,ISTRT+2)=XBCP
16399        AMAT(ICNT,ISTRT+3)=DLOWBC
16400        AMAT(ICNT,ISTRT+4)=DHIGBC
16401        AKL=XBCP - DLOWBC
16402        AKU=DHIGBC - XBCP
16403CCCCC   AK=0.0
16404CCCCC   IF(XBCPK1.NE.0.0)AK=MAX(AKL,AKU)/XBCPK1
16405        AK=MAX(AKL,AKU)
16406        AMAT(ICNT,ISTRT+5)=AK
16407        IMETH='BCP'
16408        WRITE(IOUNI2,4001)XBCP,DLOWBC,DHIGBC,AK,IMETH
16409      ENDIF
16410C
16411      IF(IMEMCM.EQ.'ON' .AND. XMEDME.NE.CPUMIN)THEN
16412C
16413C       FOR ANAYLTIC, USE 1.96*SE, COMMENT OUT THE
16414C       HETTMANSPERGER-SHEATER INTERVALS FOR NOW.
16415C
16416C       2017/03: UPDATED ANALYTICAL METHOD FROM CCQM GUIDANCE NOTE
16417C                (COMPUTED IN DPMEDM).
16418C
16419        ICNT=ICNT+1
16420        ITEXT(ICNT,1)=' 14. Median of Means'
16421        NCTEXT(ICNT,1)=20
16422        AMAT(ICNT,ISTRT+1)=0.0
16423        AMAT(ICNT,ISTRT+2)=XMEDME
16424        AMAT(ICNT,ISTRT+3)=ALOWCL
16425        AMAT(ICNT,ISTRT+4)=AUPPCL
16426        AK=XMEDME - ALOWCL
16427        AMAT(ICNT,ISTRT+5)=AK
16428        IMETH='Median of Means'
16429        WRITE(IOUNI2,4001)XMEDME,ALOWCL,AUPPCL,AK,IMETH
16430C
16431CCCCC   ICNT=ICNT+1
16432CCCCC   ITEXT(ICNT,1)='14a. Median of Means (Analytic)'
16433CCCCC   NCTEXT(ICNT,1)=31
16434CCCCC   AMAT(ICNT,ISTRT+1)=0.0
16435CCCCC   AMAT(ICNT,ISTRT+2)=XMEDME
16436CCCCC   AMAT(ICNT,ISTRT+3)=DLWME0
16437CCCCC   AMAT(ICNT,ISTRT+4)=DHGME0
16438CCCCC   IMETH='Median of Means (Analytic)'
16439CCCCC   WRITE(IOUNI2,4001)XMEDME,DLWME0,DHGME0,AK,IMETH
16440C
16441CCCCC   ICNT=ICNT+1
16442CCCCC   ITEXT(ICNT,1)='14b. Median of Means (perc. bootstrap)'
16443CCCCC   NCTEXT(ICNT,1)=38
16444CCCCC   AMAT(ICNT,ISTRT+1)=0.0
16445CCCCC   AMAT(ICNT,ISTRT+2)=XMEDME
16446CCCCC   AMAT(ICNT,ISTRT+3)=DLWME1
16447CCCCC   AMAT(ICNT,ISTRT+4)=DHGME1
16448CCCCC   AKL=XMEDME - DLWME1
16449CCCCC   AKU=DHGME1 - XMEDME
16450CCCCC   AK=0.0
16451CCCCC   IF(SEMEDB.NE.0.0)AK=MAX(AKL,AKU)/SEMEDB
16452CCCCC   AK=MAX(AKL,AKU)
16453CCCCC   AMAT(ICNT,ISTRT+5)=AK
16454CCCCC   IMETH='Median of Means (Percentile Bootstrap)'
16455CCCCC   WRITE(IOUNI2,4001)XMEDME,DLWME1,DHGME1,AK,IMETH
16456C
16457CCCCC   ICNT=ICNT+1
16458CCCCC   ITEXT(ICNT,1)='14c. Median of Means (symm. bootstrap)'
16459CCCCC   NCTEXT(ICNT,1)=38
16460CCCCC   AMAT(ICNT,ISTRT+1)=0.0
16461CCCCC   AMAT(ICNT,ISTRT+2)=XMEDME
16462CCCCC   AMAT(ICNT,ISTRT+3)=DLWME2
16463CCCCC   AMAT(ICNT,ISTRT+4)=DHGME2
16464CCCCC   AKL=XMEDME - DLWME2
16465CCCCC   AKU=DHGME2 - XMEDME
16466CCCCC   AK=0.0
16467CCCCC   IF(SEMEDB.NE.0.0)AK=MAX(AKL,AKU)/SEMEDB
16468CCCCC   AK=MAX(AKL,AKU)
16469CCCCC   AMAT(ICNT,ISTRT+5)=AK
16470CCCCC   IMETH='Median of Means (Symmetric Bootstrap)'
16471CCCCC   WRITE(IOUNI2,4001)XMEDME,DLWME2,DHGME2,AK,IMETH
16472C
16473CCCCC   ICNT=ICNT+1
16474CCCCC   ITEXT(ICNT,1)='14d. Median of Means (kernel bootstrap)'
16475CCCCC   NCTEXT(ICNT,1)=39
16476CCCCC   AMAT(ICNT,ISTRT+1)=0.0
16477CCCCC   AMAT(ICNT,ISTRT+2)=XMEDME
16478CCCCC   AMAT(ICNT,ISTRT+3)=DLWME3
16479CCCCC   AMAT(ICNT,ISTRT+4)=DHGME3
16480CCCCC   AKL=XMEDME - DLWME3
16481CCCCC   AKU=DHGME3 - XMEDME
16482CCCCC   AK=0.0
16483CCCCC   IF(SEMEDB.NE.0.0)AK=MAX(AKL,AKU)/SEMEDB
16484CCCCC   AK=MAX(AKL,AKU)
16485CCCCC   AMAT(ICNT,ISTRT+5)=AK
16486CCCCC   IMETH='Median of Means (Kernel Bootstrap)'
16487CCCCC   WRITE(IOUNI2,4001)XMEDME,DLWME3,DHGME3,AK,IMETH
16488C
16489      ENDIF
16490C
16491      IF(IHUBCM.EQ.'ON' .AND. XH15.NE.CPUMIN)THEN
16492C
16493        ICNT=ICNT+1
16494        ITEXT(ICNT,1)=' 15. Huber H15 Mean of Means'
16495        NCTEXT(ICNT,1)=27
16496        AMAT(ICNT,ISTRT+1)=0.0
16497        AMAT(ICNT,ISTRT+2)=XH15
16498        H15LCL=XH15 - 1.96*SEHMK1
16499        H15UCL=XH15 + 1.96*SEHMK1
16500        AMAT(ICNT,ISTRT+3)=H15LCL
16501        AMAT(ICNT,ISTRT+4)=H15UCL
16502        AK=XH15 - H15LCL
16503        AMAT(ICNT,ISTRT+5)=AK
16504        IMETH='Huber H15 Mean of Means'
16505        WRITE(IOUNI2,4001)XH15,H15LCL,H15UCL,AK,IMETH
16506      ENDIF
16507C
16508      NUMCOL=5
16509      NUMLIN=2
16510      NUMROW=ICNT
16511      IFRST=.TRUE.
16512      ILAST=.TRUE.
16513C
16514      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN5')THEN
16515        WRITE(ICOUT,999)
16516        CALL DPWRST('XXX','BUG ')
16517        WRITE(ICOUT,4091)
16518 4091   FORMAT('IN DPMAN5 BEFORE CALL DPDTA4:')
16519        CALL DPWRST('XXX','BUG ')
16520        WRITE(ICOUT,4093)MAXCOL,MAXLIN,NUMCOL,NUMLIN,NUMROW
16521 4093   FORMAT('MAXCOL,MAXLIN,NUMCOL,NUMLIN,NUMROW=',5I5)
16522        CALL DPWRST('XXX','BUG ')
16523        WRITE(ICOUT,4095)NMAX,NUMDIG
16524 4095   FORMAT('NMAX,NUMDIG = ',2I5)
16525        CALL DPWRST('XXX','BUG ')
16526      ENDIF
16527C
16528      IF(IPRINT.EQ.'OFF' .OR. ICMET3.EQ.'OFF')GOTO9000
16529C
16530      CALL DPDTA4(ITITLE,NCTITL,
16531     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
16532     1            MAXLIN,NUMLIN,MAXCOL,NUMCOL,
16533     1            ITEXT,NCTEXT,AMAT,ITYPCO,MAXROW,NUMROW,
16534     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
16535     1            ICAPSW,ICAPTY,IFRST,ILAST,
16536     1            ISUBRO,IBUGA3,IERROR)
16537C
16538C               *****************
16539C               **  STEP 90--  **
16540C               **  EXIT       **
16541C               *****************
16542C
16543 9000 CONTINUE
16544      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN5')THEN
16545        WRITE(ICOUT,999)
16546        CALL DPWRST('XXX','BUG ')
16547        WRITE(ICOUT,9011)
16548 9011   FORMAT('***** AT THE END       OF DPMAN5--')
16549        CALL DPWRST('XXX','BUG ')
16550      ENDIF
16551C
16552      RETURN
16553      END
16554      SUBROUTINE DPMAN6(NPTS,NLAB,
16555     1XGRAND,XMPS,XMMPS,XMLS,XSE,
16556     1ASM,XGD,XDL,XGCI,XFAIR,XBCP,
16557     1SEMPK1,SEMMP1,SEMLK1,SEMLBO,AKUK1,SESUK1,SET1K1,
16558     1SET2K1,SEGDK1,SEDLK1,SEHDK1,SERUK1,SEBOK1,SEGCI,SEFWK1,XBCPK1,
16559     1XMEDME,SEMED,SEMEDB,SEMEK1,XH15,SEHMK1,
16560     1IWRITE,
16561     1ICAPSW,ICAPTY,IK,IOUNIT,NUMDIG,IFLAG9,
16562     1ISUBRO,IBUGA3,IERROR)
16563C
16564C     PURPOSE--GENERATE THE STANDARD AND EXPANDED UNCERTAINTY
16565C              TABLE FOR THE CONSENSUS MEANS COMMAND
16566C              (CALLED TWICE: ONCE FOR K = 1 AND ONCE FOR K = 2)
16567C     PRINTING--YES
16568C     SUBROUTINES NEEDED--NONE
16569C     WRITTEN BY--ALAN HECKERT
16570C                 STATISTICAL ENGINEERING DIVISION
16571C                 INFORMATION TECHNOLOGY LABORATORY
16572C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
16573C                 GAITHERSBURG, MD 20899-8980
16574C                 PHONE--301-975-2899
16575C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
16576C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
16577C     LANGUAGE--ANSI FORTRAN (1977)
16578C     VERSION NUMBER--2006/3
16579C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2
16580C                                       ROUTINE
16581C     UPDATED         --JUNE      2006. USER CAN SELECT WHICH
16582C                                       METHODS ARE APPLIED
16583C     UPDATED         --JUNE      2006. ADD FAIRWEATHER AND BCP
16584C     UPDATED         --FEBRUARY  2010. USE DPDTA4 TO PRINT TABLE
16585C     UPDATED         --OCTOBER   2012. DERSIMONIAN-LAIRD BOOTSTRAP
16586C     UPDATED         --OCTOBER   2012. MEDIAN OF MEANS
16587C     UPDATED         --JANUARY   2017. OPTION TO SUPPRESS PRINTING
16588C                                       TABLE (ICMET3)
16589C     UPDATED         --MARCH     2017. UPDATE TO MEDIAN OF MEANS
16590C     UPDATED         --MARCH     2017. HUBER H15 MEAN OF MEANS
16591C
16592C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
16593C
16594      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
16595C
16596      CHARACTER*4 ICAPSW
16597      CHARACTER*4 ICAPTY
16598      CHARACTER*4 ISUBRO
16599      CHARACTER*4 IBUGA3
16600      CHARACTER*4 IERROR
16601C
16602      CHARACTER*4 IWRITE
16603      CHARACTER*4 ICMETZ
16604      CHARACTER*4 ISUBN1
16605      CHARACTER*4 ISUBN2
16606C
16607      CHARACTER*8  IUNCT
16608      CHARACTER*30 IMETH
16609C
16610      LOGICAL IFLAG9
16611C
16612      REAL XMPS
16613      REAL XMMPS
16614      REAL XMLS
16615      REAL ASM
16616      REAL XGRAND
16617      REAL XGD
16618      REAL XDL
16619      REAL XGCI
16620      REAL XSE
16621      REAL SEMPK1
16622      REAL SEMMP1
16623      REAL SEMLK1
16624      REAL SEMLBO
16625      REAL SEHDK1
16626      REAL SEGCI
16627      REAL AKUK1
16628      REAL SESUK1
16629      REAL SET2K1
16630      REAL SET1K1
16631      REAL SEGDK1
16632      REAL SEDLK1
16633      REAL XFAIR
16634      REAL SEFWK1
16635      REAL XBCP
16636      REAL XBCPK1
16637      REAL XMEDME
16638      REAL SEMED
16639      REAL SEMEDB
16640      REAL SERUK1
16641      REAL SEMEK1
16642      REAL XH15
16643      REAL SEHMK1
16644C
16645C----------------------------------------------------------------
16646C
16647      INCLUDE 'DPCOST.INC'
16648C
16649      CHARACTER*4 IRTFMD
16650      COMMON/COMRTF/IRTFMD
16651C
16652      PARAMETER(MAXLIN=3)
16653      PARAMETER(MAXROW=20)
16654      PARAMETER(MAXCOL=4)
16655      CHARACTER*4  ALIGN(MAXCOL)
16656      CHARACTER*4  VALIGN(MAXCOL)
16657      INTEGER      IDIGIT(MAXCOL)
16658      INTEGER      NTOT(MAXCOL)
16659      INTEGER      IWHTML(MAXCOL)
16660      INTEGER      IWRTF(MAXCOL)
16661      INTEGER      NCTEXT(MAXROW,MAXCOL)
16662      INTEGER      NCTIT2(MAXLIN,MAXCOL)
16663      CHARACTER*40 ITITL9
16664      CHARACTER*40 ITITLE
16665      CHARACTER*20 ITITL2(MAXLIN,MAXCOL)
16666      CHARACTER*40 ITEXT(MAXROW,MAXCOL)
16667      CHARACTER*4  ITYPCO(MAXCOL)
16668      REAL         AMAT(MAXROW,MAXCOL)
16669      LOGICAL      IFRST
16670      LOGICAL      ILAST
16671C
16672      INCLUDE 'DPCOP2.INC'
16673C
16674C-----START POINT------------------------------------------------
16675C
16676      IERROR='NO'
16677      ISUBN1='DPMA'
16678      ISUBN2='N6  '
16679C
16680      IF(IK.EQ.1)THEN
16681        ICMETZ=ICMET3
16682      ELSE
16683        ICMETZ=ICMET4
16684      ENDIF
16685C
16686      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN6')THEN
16687        WRITE(ICOUT,999)
16688  999   FORMAT(1X)
16689        CALL DPWRST('XXX','BUG ')
16690        WRITE(ICOUT,51)
16691   51   FORMAT('***** AT THE BEGINNING OF DPMAN6--')
16692        CALL DPWRST('XXX','BUG ')
16693        WRITE(ICOUT,52)IWRITE,NPTS,NLAB,IOUNIT
16694   52   FORMAT('IWRITE,NPTS,NLAB,IOUNIT = ',A4,2X,3I8)
16695        CALL DPWRST('XXX','BUG ')
16696        WRITE(ICOUT,54)SEMED,SEMEDB
16697   54   FORMAT('SEMED,SEMEDB = ',2G15.7)
16698        CALL DPWRST('XXX','BUG ')
16699      ENDIF
16700C
16701      IF(IK.EQ.1)THEN
16702        IUNCT='Standard'
16703      ELSE
16704        IUNCT='Expanded'
16705      ENDIF
16706C
16707      NCTIT9=0
16708      ITITL9=' '
16709      NCTITL=40
16710      ITITLE(1:NCTITL)='Table x:  xxxxxxxx Uncertainties (k = x)'
16711      WRITE(ITITLE(7:7),'(I1)')IK+2
16712      WRITE(ITITLE(11:18),'(A8)')IUNCT
16713      WRITE(ITITLE(39:39),'(I1)')IK
16714      NUMLIN=3
16715      NUMCOL=4
16716C
16717      ITITL2(1,1)=' '
16718      ITITL2(2,1)=' '
16719      ITITL2(3,1)='Method'
16720      NCTIT2(1,1)=0
16721      NCTIT2(2,1)=0
16722      NCTIT2(3,1)=6
16723C
16724      ITITL2(1,2)=' '
16725      ITITL2(2,2)='Consensus'
16726      ITITL2(3,2)='Mean'
16727      NCTIT2(1,2)=0
16728      NCTIT2(2,2)=9
16729      NCTIT2(3,2)=4
16730C
16731      WRITE(ITITL2(1,3)(1:8),'(A8)')IUNCT
16732      ITITL2(2,3)='Uncertainty'
16733      ITITL2(3,3)='(k = x)'
16734      WRITE(ITITL2(3,3)(6:6),'(I1)')IK
16735      NCTIT2(1,3)=8
16736      NCTIT2(2,3)=11
16737      NCTIT2(3,3)=7
16738C
16739      ITITL2(1,4)='Relative'
16740      WRITE(ITITL2(2,4)(1:8),'(A8)')IUNCT
16741      ITITL2(3,4)='Uncertainty (%)'
16742      NCTIT2(1,4)=8
16743      NCTIT2(2,4)=8
16744      NCTIT2(3,4)=15
16745C
16746      NMAX=0
16747      NTOT(1)=35
16748      NTOT(2)=15
16749      NTOT(3)=15
16750      NTOT(4)=18
16751      DO4010J=1,MAXCOL
16752        VALIGN(J)='b'
16753        ALIGN(J)='r'
16754        NMAX=NMAX+NTOT(J)
16755        IDIGIT(J)=NUMDIG
16756        IWHTML(J)=125
16757        ITYPCO(J)='NUME'
16758 4010 CONTINUE
16759      ITYPCO(1)='ALPH'
16760      ALIGN(1)='l'
16761      IWHTML(1)=225
16762      IWRTF(1)=3800
16763      IWRTF(2)=IWRTF(1)+1700
16764      IWRTF(3)=IWRTF(2)+1700
16765      IWRTF(4)=IWRTF(3)+1700
16766      IFRST=.TRUE.
16767      ILAST=.TRUE.
16768C
16769C     POPULATE ROWS OF ARRAY.  NOTE THAT SPECIFIC METHODS ARE
16770C     CONDITIONAL.
16771C
16772      ICNT=0
16773C
16774      DO4020I=1,MAXROW
16775        DO4030J=1,MAXCOL
16776          AMAT(I,J)=0.0
16777          NCTEXT(I,J)=0
16778          ITEXT(I,J)=' '
16779 4030   CONTINUE
16780 4020 CONTINUE
16781C
16782      IF(IMPACM.EQ.'ON' .AND. XMPS.NE.CPUMIN)THEN
16783        ICNT=ICNT+1
16784        ITEXT(ICNT,1)='  1. Mandel-Paule'
16785        NCTEXT(ICNT,1)=17
16786        AMAT(ICNT,1)=0.0
16787        AMAT(ICNT,2)=XMPS
16788        AMAT(ICNT,3)=SEMPK1
16789        AMAT(ICNT,4)=100.0*SEMPK1/XMPS
16790        ATEMP1=100.0*SEMPK1/XMPS
16791        IMETH='Mandel-Paule'
16792        WRITE(IOUNIT,4001)XMPS,SEMPK1,ATEMP1,IMETH
16793 4001   FORMAT(3E15.7,15X,A30)
16794      ENDIF
16795C
16796      IF(IMMPCM.EQ.'ON' .AND. XMMPS.NE.CPUMIN)THEN
16797        ICNT=ICNT+1
16798        ITEXT(ICNT,1)='  2. Modified Mandel-Paule'
16799        NCTEXT(ICNT,1)=27
16800        AMAT(ICNT,1)=0.0
16801        AMAT(ICNT,2)=XMMPS
16802        AMAT(ICNT,3)=SEMMP1
16803        AMAT(ICNT,4)=100.0*SEMMP1/XMMPS
16804        ATEMP1=100.0*SEMMP1/XMMPS
16805        IMETH='Modified Mandel-Paule'
16806        WRITE(IOUNIT,4001)XMMPS,SEMMP1,ATEMP1,IMETH
16807      ENDIF
16808C
16809      IF(IVRUCM.EQ.'ON' .AND. XMLS.NE.CPUMIN)THEN
16810        ICNT=ICNT+1
16811        ITEXT(ICNT,1)=' 3a. Vangel-Rukhin ML'
16812        NCTEXT(ICNT,1)=21
16813        AMAT(ICNT,1)=0.0
16814        AMAT(ICNT,2)=XMLS
16815        AMAT(ICNT,3)=SEMLK1
16816        AMAT(ICNT,4)=100.0*SEMLK1/XMLS
16817        ATEMP1=100.0*SEMLK1/XMLS
16818        IMETH='Vangel-Rukhin ML'
16819        WRITE(IOUNIT,4001)XMLS,SEMLK1,ATEMP1,IMETH
16820      ENDIF
16821C
16822      IF(IVRBCM.EQ.'ON' .AND. XMLS.NE.CPUMIN)THEN
16823        ICNT=ICNT+1
16824        ITEXT(ICNT,1)=' 3b. Vangel-Rukhin (bootstrap)'
16825        NCTEXT(ICNT,1)=30
16826        AMAT(ICNT,1)=0.0
16827        AMAT(ICNT,2)=XMLS
16828        AMAT(ICNT,3)=SEMLBO
16829        AMAT(ICNT,4)=100.0*SEMLBO/XMLS
16830        ATEMP1=100.0*SEMLBO/XMLS
16831        IMETH='Vangel-Rukhin Bootstrap'
16832        WRITE(IOUNIT,4001)XMLS,SEMLBO,ATEMP1,IMETH
16833      ENDIF
16834C
16835      IF(IDSLCM.EQ.'ON' .AND. XDL.NE.CPUMIN)THEN
16836        ICNT=ICNT+1
16837        ITEXT(ICNT,1)=' 4a. DerSimonian-Laird (original)'
16838        NCTEXT(ICNT,1)=33
16839        AMAT(ICNT,1)=0.0
16840        AMAT(ICNT,2)=XDL
16841        AMAT(ICNT,3)=SEDLK1
16842        AMAT(ICNT,4)=100.0*SEDLK1/XDL
16843        ATEMP1=100.0*SEDLK1/XDL
16844        IMETH='DerSimonian-Laird (Original)'
16845        WRITE(IOUNIT,4001)XDL,SEDLK1,ATEMP1,IMETH
16846      ENDIF
16847C
16848      IF(IDS2CM.EQ.'ON' .AND. XDL.NE.CPUMIN)THEN
16849        ICNT=ICNT+1
16850        ITEXT(ICNT,1)=' 4b. DerSimonian-Laird (H-H-D)'
16851        NCTEXT(ICNT,1)=30
16852        AMAT(ICNT,1)=0.0
16853        AMAT(ICNT,2)=XDL
16854        AMAT(ICNT,3)=SEHDK1
16855        AMAT(ICNT,4)=100.0*SEHDK1/XDL
16856        ATEMP1=100.0*SEHDK1/XDL
16857        IMETH='DerSimonian-Laird (HHD)'
16858        WRITE(IOUNIT,4001)XDL,SEHDK1,ATEMP1,IMETH
16859      ENDIF
16860C
16861      IF(IDS3CM.EQ.'ON' .AND. XDL.NE.CPUMIN)THEN
16862        ICNT=ICNT+1
16863        ITEXT(ICNT,1)=' 4c. DerSimonian-Laird (minmax)'
16864        NCTEXT(ICNT,1)=31
16865        AMAT(ICNT,1)=0.0
16866        AMAT(ICNT,2)=XDL
16867        AMAT(ICNT,3)=SERUK1
16868        AMAT(ICNT,4)=100.0*SERUK1/XDL
16869        ATEMP1=100.0*SERUK1/XDL
16870        IMETH='DerSimonian-Laird (Minmax)'
16871        WRITE(IOUNIT,4001)XDL,SERUK1,ATEMP1,IMETH
16872      ENDIF
16873C
16874      IF(IDS4CM.EQ.'ON' .AND. XDL.NE.CPUMIN)THEN
16875        ICNT=ICNT+1
16876        ITEXT(ICNT,1)=' 4d. DerSimonian-Laird (bootstrap)'
16877        NCTEXT(ICNT,1)=34
16878        AMAT(ICNT,1)=0.0
16879        AMAT(ICNT,2)=XDL
16880        AMAT(ICNT,3)=SEBOK1
16881        AMAT(ICNT,4)=100.0*SEBOK1/XDL
16882        ATEMP1=100.0*SEBOK1/XDL
16883        IMETH='DerSimonian-Laird (Bootstrap)'
16884        WRITE(IOUNIT,4001)XDL,SEBOK1,ATEMP1,IMETH
16885      ENDIF
16886C
16887      IF(IGRDCM.EQ.'ON' .AND. XGD.NE.CPUMIN)THEN
16888        ICNT=ICNT+1
16889        ITEXT(ICNT,1)='  5. Graybill-Deal'
16890        NCTEXT(ICNT,1)=20
16891        AMAT(ICNT,1)=0.0
16892        AMAT(ICNT,2)=XGD
16893        AMAT(ICNT,3)=SEGDK1
16894        AMAT(ICNT,4)=100.0*SEGDK1/XGD
16895        ATEMP1=100.0*SEGDK1/XGD
16896        IMETH='Graybill-Deal'
16897        WRITE(IOUNIT,4001)XGD,SEGDK1,ATEMP1,IMETH
16898      ENDIF
16899C
16900      IF(IFAICM.EQ.'ON' .AND. IFLAG9 .AND. XFAIR.NE.CPUMIN)THEN
16901        ICNT=ICNT+1
16902        ITEXT(ICNT,1)='  6. Fairweather (Minmax)'
16903        NCTEXT(ICNT,1)=25
16904        AMAT(ICNT,1)=0.0
16905        AMAT(ICNT,2)=XFAIR
16906        AMAT(ICNT,3)=SEFWK1
16907        AMAT(ICNT,4)=100.0*SEFWK1/XFAIR
16908        ATEMP1=100.0*SEFWK1/XFAIR
16909        IMETH='Fairweather'
16910        WRITE(IOUNIT,4001)XFAIR,SEFWK1,ATEMP1,IMETH
16911      ENDIF
16912C
16913      IF(IGCICM.EQ.'ON' .AND. XGCI.NE.CPUMIN)THEN
16914        ICNT=ICNT+1
16915        ITEXT(ICNT,1)='  7. Generalized CI'
16916        NCTEXT(ICNT,1)=19
16917        AMAT(ICNT,1)=0.0
16918        AMAT(ICNT,2)=XGCI
16919        AMAT(ICNT,3)=SEGCI
16920        AMAT(ICNT,4)=100.0*SEGCI/XGCI
16921        ATEMP1=100.0*SEGCI/XGCI
16922        IMETH='Generalized CI'
16923        WRITE(IOUNIT,4001)XGCI,SEGCI,ATEMP1,IMETH
16924      ENDIF
16925C
16926      IF(IGMECM.EQ.'ON' .AND. XGRAND.NE.CPUMIN)THEN
16927        ICNT=ICNT+1
16928        ITEXT(ICNT,1)='  8. Grand Mean'
16929        NCTEXT(ICNT,1)=15
16930        AMAT(ICNT,1)=0.0
16931        AMAT(ICNT,2)=XGRAND
16932        AMAT(ICNT,3)=SET1K1
16933        AMAT(ICNT,4)=100.0*SET1K1/XGRAND
16934        ATEMP1=100.0*SET1K1/XGRAND
16935        IMETH='Grand Mean'
16936        WRITE(IOUNIT,4001)XGRAND,SET1K1,ATEMP1,IMETH
16937      ENDIF
16938C
16939      IF(IMOMCM.EQ.'ON' .AND. ASM.NE.CPUMIN)THEN
16940        ICNT=ICNT+1
16941        ITEXT(ICNT,1)='  9. Mean of Means'
16942        NCTEXT(ICNT,1)=18
16943        AMAT(ICNT,1)=0.0
16944        AMAT(ICNT,2)=ASM
16945        AMAT(ICNT,3)=SET2K1
16946        AMAT(ICNT,4)=100.0*SET2K1/ASM
16947        ATEMP1=100.0*SET2K1/ASM
16948        IMETH='Mean of Means'
16949        WRITE(IOUNIT,4001)ASM,SET2K1,ATEMP1,IMETH
16950      ENDIF
16951C
16952      IF(IBOBCM.EQ.'ON' .AND. ASM.NE.CPUMIN)THEN
16953        ICNT=ICNT+1
16954        ITEXT(ICNT,1)=' 11. BOB'
16955        NCTEXT(ICNT,1)=8
16956        AMAT(ICNT,1)=0.0
16957        AMAT(ICNT,2)=ASM
16958        AMAT(ICNT,3)=AKUK1
16959        AMAT(ICNT,4)=100.0*AKUK1/ASM
16960        ATEMP1=100.0*AKUK1/ASM
16961        IMETH='Bob'
16962        WRITE(IOUNIT,4001)ASM,AKUK1,ATEMP1,IMETH
16963      ENDIF
16964C
16965      IF(ISCECM.EQ.'ON' .AND. XSE.NE.CPUMIN)THEN
16966        ICNT=ICNT+1
16967        ITEXT(ICNT,1)=' 12. Schiller-Eberhardt'
16968        NCTEXT(ICNT,1)=23
16969        AMAT(ICNT,1)=0.0
16970        AMAT(ICNT,2)=XSE
16971        AMAT(ICNT,3)=SESUK1
16972        AMAT(ICNT,4)=100.0*SESUK1/XSE
16973        ATEMP1=100.0*SESUK1/XSE
16974        IMETH='Schiller-Eberhardt'
16975        WRITE(IOUNIT,4001)XSE,SESUK1,ATEMP1,IMETH
16976      ENDIF
16977C
16978      IF(IBCPCM.EQ.'ON' .AND. XBCP.NE.CPUMIN)THEN
16979        ICNT=ICNT+1
16980        ITEXT(ICNT,1)=' 13. BCP'
16981        NCTEXT(ICNT,1)=8
16982        AMAT(ICNT,1)=0.0
16983        AMAT(ICNT,2)=XBCP
16984        AMAT(ICNT,3)=XBCPK1
16985        AMAT(ICNT,4)=100.0*XBCPK1/XBCP
16986        ATEMP1=100.0*XBCPK1/XBCP
16987        IMETH='BCP'
16988        WRITE(IOUNIT,4001)XBCP,XBCPK1,ATEMP1,IMETH
16989      ENDIF
16990C
16991      IF(IMEMCM.EQ.'ON' .AND. XMEDME.NE.CPUMIN)THEN
16992        ICNT=ICNT+1
16993        ITEXT(ICNT,1)=' 14. Median of Means'
16994        NCTEXT(ICNT,1)=20
16995        AMAT(ICNT,1)=0.0
16996        AMAT(ICNT,2)=XMEDME
16997        AMAT(ICNT,3)=SEMEK1
16998        AMAT(ICNT,4)=100.0*SEMEK1/XMEDME
16999        ATEMP1=100.0*SEMEK1/XMEDME
17000        IMETH='Median of Means'
17001        WRITE(IOUNIT,4001)XMEDME,SEMEK1,ATEMP1,IMETH
17002C
17003CCCCC   ICNT=ICNT+1
17004CCCCC   ITEXT(ICNT,1)='14b. Median of Means (bootstrap)'
17005CCCCC   NCTEXT(ICNT,1)=32
17006CCCCC   AMAT(ICNT,1)=0.0
17007CCCCC   AMAT(ICNT,2)=XMEDME
17008CCCCC   AMAT(ICNT,3)=SEMEDB
17009CCCCC   AMAT(ICNT,4)=100.0*SEMEDB/XMEDME
17010CCCCC   ATEMP1=100.0*SEMEDB/XMEDME
17011CCCCC   IMETH='Meidan of Means (Bootstrap)'
17012CCCCC   WRITE(IOUNIT,4001)XMEDME,SEMEDB,ATEMP1,IMETH
17013      ENDIF
17014C
17015      IF(IHUBCM.EQ.'ON' .AND. XH15.NE.CPUMIN)THEN
17016        ICNT=ICNT+1
17017        ITEXT(ICNT,1)=' 15. Huber H15 Mean of Means'
17018        NCTEXT(ICNT,1)=28
17019        AMAT(ICNT,1)=0.0
17020        AMAT(ICNT,2)=XH15
17021        AMAT(ICNT,3)=SEHMK1
17022        AMAT(ICNT,4)=100.0*SEHMK1/XH15
17023        ATEMP1=100.0*SEMEK1/XMEDME
17024        IMETH='Huber H15 Mean of Means'
17025        WRITE(IOUNIT,4001)XH15,SEHMK1,ATEMP1,IMETH
17026      ENDIF
17027C
17028      NUMCOL=4
17029      NUMLIN=3
17030      NUMROW=ICNT
17031      IFRST=.TRUE.
17032      ILAST=.TRUE.
17033C
17034      IF(IPRINT.EQ.'OFF' .OR. ICMETZ.EQ.'OFF')GOTO9000
17035C
17036      CALL DPDTA4(ITITLE,NCTITL,
17037     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
17038     1            MAXLIN,NUMLIN,MAXCOL,NUMCOL,
17039     1            ITEXT,NCTEXT,AMAT,ITYPCO,MAXROW,NUMROW,
17040     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
17041     1            ICAPSW,ICAPTY,IFRST,ILAST,
17042     1            ISUBRO,IBUGA3,IERROR)
17043C
17044C               *****************
17045C               **  STEP 90--  **
17046C               **  EXIT       **
17047C               *****************
17048C
17049 9000 CONTINUE
17050      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN6')THEN
17051        WRITE(ICOUT,999)
17052        CALL DPWRST('XXX','BUG ')
17053        WRITE(ICOUT,9011)
17054 9011   FORMAT('***** AT THE END       OF DPMAN6--')
17055        CALL DPWRST('XXX','BUG ')
17056      ENDIF
17057C
17058      RETURN
17059      END
17060      SUBROUTINE DPMANN(MAXNXT,ICAPSW,IFORSW,
17061     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
17062C
17063C     PURPOSE--CARRY OUT A 2-SAMPLE MANN-WHITNEY RANK SUM TEST
17064C     EXAMPLE--MANN-WHITNEY RANK SUM TEST Y1 Y2
17065C              RANK SUM TEST Y1 Y2
17066C              MANN-WHITNEY RANK SUM TEST Y1 Y2 Y3 Y4
17067C              MANN-WHITNEY RANK SUM TEST Y1 TO Y10
17068C     WRITTEN BY--ALAN HECKERT
17069C                 STATISTICAL ENGINEERING DIVISION
17070C                 INFORMATION TECHNOLOGY LABORATORY
17071C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17072C                 GAITHERSBURG, MD 20899-8980
17073C                 PHONE--301-975-2899
17074C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17075C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17076C     LANGUAGE--ANSI FORTRAN (1977)
17077C     VERSION NUMBER--99/7
17078C     ORIGINAL VERSION--JULY      1999.
17079C     UPDATED         --JANUARY   2007.  CALL LIST TO RANK
17080C     UPDATED         --MAY       2011.  USE DPPARS AND DPPAR3
17081C
17082C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17083C
17084      CHARACTER*4 ICAPSW
17085      CHARACTER*4 IFORSW
17086      CHARACTER*4 IBUGA2
17087      CHARACTER*4 IBUGA3
17088      CHARACTER*4 IBUGQ
17089      CHARACTER*4 ISUBRO
17090      CHARACTER*4 IFOUND
17091      CHARACTER*4 IERROR
17092C
17093      CHARACTER*4 ICASAN
17094      CHARACTER*4 ICASA2
17095      CHARACTER*4 ICTMP1
17096      CHARACTER*4 ICTMP2
17097      CHARACTER*4 ICTMP3
17098      CHARACTER*4 ICTMP4
17099      CHARACTER*4 ICTMP5
17100      CHARACTER*4 ISUBN1
17101      CHARACTER*4 ISUBN2
17102      CHARACTER*4 ISTEPN
17103C
17104      CHARACTER*4 ICASE
17105      CHARACTER*4 IVARID
17106      CHARACTER*4 IVARI2
17107      CHARACTER*4 IVARI3
17108      CHARACTER*4 IVARI4
17109      CHARACTER*40 INAME
17110      PARAMETER (MAXSPN=30)
17111      CHARACTER*4 IVARN1(MAXSPN)
17112      CHARACTER*4 IVARN2(MAXSPN)
17113      CHARACTER*4 IVARTY(MAXSPN)
17114      REAL PVAR(MAXSPN)
17115      INTEGER ILIS(MAXSPN)
17116      INTEGER NRIGHT(MAXSPN)
17117      INTEGER ICOLR(MAXSPN)
17118C
17119      CHARACTER*4 IFLAGU
17120      LOGICAL IFRST
17121      LOGICAL ILAST
17122C
17123C---------------------------------------------------------------------
17124C
17125C-----COMMON----------------------------------------------------------
17126C
17127      INCLUDE 'DPCOPA.INC'
17128      INCLUDE 'DPCOZZ.INC'
17129      INCLUDE 'DPCOHK.INC'
17130      INCLUDE 'DPCOSU.INC'
17131      INCLUDE 'DPCODA.INC'
17132      INCLUDE 'DPCOHO.INC'
17133      INCLUDE 'DPCOST.INC'
17134C
17135      DIMENSION YRANK(2*MAXOBV)
17136      DIMENSION YTEMP(2*MAXOBV)
17137      DIMENSION XTEMP3(2*MAXOBV)
17138      EQUIVALENCE(GARBAG(IGARB1),YRANK(1))
17139      EQUIVALENCE(GARBAG(IGARB3),YTEMP(1))
17140      EQUIVALENCE(GARBAG(IGARB5),XTEMP3(1))
17141C
17142C-----COMMON VARIABLES (GENERAL)--------------------------------------
17143C
17144      INCLUDE 'DPCOP2.INC'
17145C
17146C-----START POINT-----------------------------------------------------
17147C
17148      ISUBN1='DPMA'
17149      ISUBN2='NN  '
17150      IFOUND='NO'
17151      IERROR='NO'
17152C
17153      MAXCP1=MAXCOL+1
17154      MAXCP2=MAXCOL+2
17155      MAXCP3=MAXCOL+3
17156      MAXCP4=MAXCOL+4
17157      MAXCP5=MAXCOL+5
17158      MAXCP6=MAXCOL+6
17159C
17160C               ************************************************
17161C               **  TREAT THE MANN-WHITNEY RANK SUM TEST CASE  **
17162C               ************************************************
17163C
17164      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MANN')THEN
17165        WRITE(ICOUT,999)
17166  999   FORMAT(1X)
17167        CALL DPWRST('XXX','BUG ')
17168        WRITE(ICOUT,51)
17169   51   FORMAT('***** AT THE BEGINNING OF DPMANN--')
17170        CALL DPWRST('XXX','BUG ')
17171        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO,MAXNXT
17172   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',4(A4,2X),I8)
17173        CALL DPWRST('XXX','BUG ')
17174      ENDIF
17175C
17176C               *********************************************************
17177C               **  STEP 1--                                           **
17178C               **  EXTRACT THE COMMAND                                **
17179C               *********************************************************
17180C
17181      ISTEPN='1'
17182      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
17183     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17184C
17185      ILASTZ=9999
17186      ICASAN='MTES'
17187      ICASA2='TWOT'
17188C
17189C     LOOK FOR:
17190C
17191C          RANK SUM TEST/MANN-WHITNEY RANK SUM TEST
17192C          LOWER TAILED
17193C          UPPER TAILED
17194C
17195      DO100I=0,NUMARG-1
17196C
17197        IF(I.EQ.0)THEN
17198          ICTMP1=ICOM
17199        ELSE
17200          ICTMP1=IHARG(I)
17201        ENDIF
17202        ICTMP2=IHARG(I+1)
17203        ICTMP3=IHARG(I+2)
17204        ICTMP4=IHARG(I+3)
17205        ICTMP5=IHARG(I+4)
17206C
17207        IF(ICTMP1.EQ.'=')THEN
17208          IFOUND='NO'
17209          GOTO9000
17210        ELSEIF(ICTMP1.EQ.'MANN' .AND. ICTMP2.EQ.'WHIT' .AND.
17211     1         ICTMP3.EQ.'RANK' .AND. ICTMP4.EQ.'SUM ' .AND.
17212     1         ICTMP4.EQ.'TEST')THEN
17213          IFOUND='YES'
17214          ICASAN='MTES'
17215          ILASTZ=I+4
17216        ELSEIF(ICTMP1.EQ.'MANN' .AND. ICTMP2.EQ.'WHIT' .AND.
17217     1         ICTMP3.EQ.'RANK' .AND. ICTMP4.EQ.'SUM ')THEN
17218          IFOUND='YES'
17219          ICASAN='MTES'
17220          ILASTZ=I+3
17221        ELSEIF(ICTMP1.EQ.'MANN' .AND. ICTMP2.EQ.'WHIT' .AND.
17222     1         ICTMP3.EQ.'TEST')THEN
17223          IFOUND='YES'
17224          ICASAN='MTES'
17225          ILASTZ=I+2
17226        ELSEIF(ICTMP1.EQ.'MANN' .AND. ICTMP2.EQ.'WHIT')THEN
17227          IFOUND='YES'
17228          ICASAN='MTES'
17229          ILASTZ=I+1
17230        ELSEIF(ICTMP1.EQ.'RANK' .AND. ICTMP2.EQ.'SUM ' .AND.
17231     1         ICTMP3.EQ.'TEST')THEN
17232          IFOUND='YES'
17233          ICASAN='MTES'
17234          ILASTZ=I+2
17235        ELSEIF(ICTMP1.EQ.'RANK' .AND. ICTMP2.EQ.'SUM ')THEN
17236          IFOUND='YES'
17237          ICASAN='MTES'
17238          ILASTZ=I+1
17239        ELSEIF(ICTMP1.EQ.'LOWE' .AND. ICTMP2.EQ.'TAIL')THEN
17240          ICASA2='LOWE'
17241          ILASTZ=MAX(ILASTZ,I+1)
17242        ELSEIF(ICTMP1.EQ.'UPPE' .AND. ICTMP2.EQ.'TAIL')THEN
17243          ICASA2='UPPE'
17244          ILASTZ=MAX(ILASTZ,I+1)
17245        ENDIF
17246  100 CONTINUE
17247C
17248      IF(IFOUND.EQ.'NO')GOTO9000
17249C
17250      ISHIFT=ILASTZ
17251      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
17252     1            IBUGA2,IERROR)
17253C
17254      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')THEN
17255        WRITE(ICOUT,91)ICASAN,ICASA2,ISHIFT
17256   91   FORMAT('DPMANN: ICASAN,ICASA2,ISHIFT = ',
17257     1         2(A4,2X),I5)
17258        CALL DPWRST('XXX','BUG ')
17259      ENDIF
17260C
17261C               ****************************************
17262C               **  STEP 2--                          **
17263C               **  EXTRACT THE VARIABLE LIST         **
17264C               ****************************************
17265C
17266      ISTEPN='2'
17267      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
17268     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17269C
17270      INAME='MANN-WHITNEY RANK SUM TEST'
17271      MINNA=1
17272      MAXNA=100
17273      MINN2=2
17274      IFLAGE=0
17275      IFLAGM=1
17276      MINNVA=2
17277      MAXNVA=MAXSPN
17278      IFLAGP=0
17279      JMIN=1
17280      JMAX=NUMARG
17281C
17282      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
17283     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
17284     1            JMIN,JMAX,
17285     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
17286     1            IVARN1,IVARN2,IVARTY,PVAR,
17287     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
17288     1            MINNVA,MAXNVA,
17289     1            IFLAGM,IFLAGP,
17290     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
17291      IF(IERROR.EQ.'YES')GOTO9000
17292C
17293      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')THEN
17294        WRITE(ICOUT,999)
17295        CALL DPWRST('XXX','BUG ')
17296        WRITE(ICOUT,281)
17297  281   FORMAT('***** AFTER CALL DPPARS--')
17298        CALL DPWRST('XXX','BUG ')
17299        WRITE(ICOUT,282)NQ,NUMVAR
17300  282   FORMAT('NQ,NUMVAR = ',2I8)
17301        CALL DPWRST('XXX','BUG ')
17302        IF(NUMVAR.GT.0)THEN
17303          DO285I=1,NUMVAR
17304            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
17305     1                      ICOLR(I)
17306  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
17307     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
17308            CALL DPWRST('XXX','BUG ')
17309  285     CONTINUE
17310        ENDIF
17311      ENDIF
17312C
17313C               ******************************************************
17314C               **  STEP 3A--                                       **
17315C               **  CASE 1: TWO RESPONSE VARIABLES, NO REPLICATION  **
17316C               **          HANDLE MULTIPLE RESPONSE VARIABLES      **
17317C               **          DIFFERENTLY FOR ONE SAMPLE AND TWO      **
17318C               **          SAMPLE TESTS.                           **
17319C               ******************************************************
17320C
17321      ISTEPN='3A'
17322      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
17323     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17324C
17325      NUMVA2=1
17326      DO5210I=1,NUMVAR
17327        ICOL=I
17328        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
17329     1              INAME,IVARN1,IVARN2,IVARTY,
17330     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
17331     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
17332     1              MAXCP4,MAXCP5,MAXCP6,
17333     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
17334     1              Y,Y,Y,NS1,NLOCA2,NLOCA3,ICASE,
17335     1              IBUGA3,ISUBRO,IFOUND,IERROR)
17336        IF(IERROR.EQ.'YES')GOTO9000
17337C
17338        ISTRT2=I+1
17339        ISTOP2=NUMVAR
17340C
17341        DO5220J=ISTRT2,ISTOP2
17342C
17343          ICOL=J
17344          CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
17345     1                INAME,IVARN1,IVARN2,IVARTY,
17346     1                ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
17347     1                MAXCOL,MAXCP1,MAXCP2,MAXCP3,
17348     1                MAXCP4,MAXCP5,MAXCP6,
17349     1                V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
17350     1                X,X,X,NS2,NLOCA2,NLOCA3,ICASE,
17351     1                IBUGA3,ISUBRO,IFOUND,IERROR)
17352          IF(IERROR.EQ.'YES')GOTO9000
17353C
17354C               *******************************************
17355C               **  STEP 52--                            **
17356C               **  PERFORM A MANN-WHITNEY RANK SUM TEST **
17357C               *******************************************
17358C
17359          ISTEPN='52'
17360          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MANN')THEN
17361            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17362            WRITE(ICOUT,999)
17363            CALL DPWRST('XXX','BUG ')
17364            WRITE(ICOUT,5211)
17365 5211       FORMAT('***** FROM DPMANN, BEFORE CALL DPMNN2--')
17366            CALL DPWRST('XXX','BUG ')
17367            WRITE(ICOUT,5212)I,J,NS1,NS2,MAXN
17368 5212       FORMAT('I,J,NS1,NS2,MAXN = ',5I8)
17369            CALL DPWRST('XXX','BUG ')
17370            DO5215II=1,MAX(NS1,NS2)
17371              WRITE(ICOUT,5216)II,Y(II),X(II)
17372 5216         FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
17373              CALL DPWRST('XXX','BUG ')
17374 5215       CONTINUE
17375          ENDIF
17376C
17377          IVARID=IVARN1(I)
17378          IVARI2=IVARN2(I)
17379          IVARI3=IVARN1(J)
17380          IVARI4=IVARN2(J)
17381          CALL DPMNN2(Y,NS1,X,NS2,ICASA2,
17382     1               YRANK,YTEMP,XTEMP3,MAXNXT,
17383     1               ICAPSW,ICAPTY,IFORSW,
17384     1               IVARID,IVARI2,IVARI3,IVARI4,
17385     1               STATVA,STATCD,ITAB,
17386     1               PVAL2T,PVALLT,PVALUT,
17387     1               CTL001,CTL005,CTL010,CTL025,CTL050,CTL100,
17388     1               CTU999,CTU995,CTU990,CT975,CTU950,CTU900,
17389     1               CVL001,CVL005,CVL010,CVL025,CVL050,CVL100,
17390     1               CVU999,CVU995,CVU990,CVU975,CVU950,CVU900,
17391     1               IBUGA3,ISUBRO,IERROR)
17392          IF(IERROR.EQ.'YES')GOTO9000
17393C
17394C               ***************************************
17395C               **  STEP 8C--                        **
17396C               **  UPDATE INTERNAL DATAPLOT TABLES  **
17397C               ***************************************
17398C
17399          ISTEPN='8C'
17400          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
17401     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17402C
17403          IF(NUMVAR.GT.2)THEN
17404            IFLAGU='FILE'
17405          ELSE
17406            IFLAGU='ON'
17407          ENDIF
17408          IFRST=.FALSE.
17409          ILAST=.FALSE.
17410          IF(I.EQ.1 .AND. J.EQ.2)IFRST=.TRUE.
17411          IF(I.EQ.NUMVAR .AND. J.EQ.NUMVAR)ILAST=.TRUE.
17412          IF(ITAB.EQ.1)THEN
17413            CTL001=CVL001
17414            CTL005=CVL005
17415            CTL010=CVL010
17416            CTL025=CVL025
17417            CTL050=CVL050
17418            CTL100=CVL100
17419            CTU999=CVU999
17420            CTU995=CVU995
17421            CTU990=CVU990
17422            CTU975=CVU975
17423            CTU950=CVU950
17424            CTU900=CVU900
17425          ENDIF
17426          CALL DPMNN5(ICASA2,
17427     1                STATVA,STATCD,
17428     1                PVAL2T,PVALLT,PVALUT,
17429     1                CTL001,CTL005,CTL010,CTL025,CTL050,CTL100,
17430     1                CTU999,CTU995,CTU990,CT975,CTU950,CTU900,
17431     1                IFLAGU,IFRST,ILAST,
17432     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
17433C
17434 5220   CONTINUE
17435 5210 CONTINUE
17436C
17437C               *****************
17438C               **  STEP 90--  **
17439C               **  EXIT       **
17440C               *****************
17441C
17442 9000 CONTINUE
17443      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MANN')THEN
17444        WRITE(ICOUT,999)
17445        CALL DPWRST('XXX','BUG ')
17446        WRITE(ICOUT,9011)
17447 9011   FORMAT('***** AT THE END       OF DPMANN--')
17448        CALL DPWRST('XXX','BUG ')
17449        WRITE(ICOUT,9016)IFOUND,IERROR
17450 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
17451        CALL DPWRST('XXX','BUG ')
17452      ENDIF
17453C
17454      RETURN
17455      END
17456      SUBROUTINE DPMNN2(Y1,N1,Y2,N2,ICASAN,
17457     1                  TEMP1,TEMP2,TEMP3,MAXNXT,
17458     1                  ICAPSW,ICAPTY,IFORSW,
17459     1                  IVARID,IVARI2,IVARI3,IVARI4,
17460     1                  STATVA,STATCD,ITAB,
17461     1                  PVAL2T,PVALLT,PVALUT,
17462     1                  CTL001,CTL005,CTL010,CTL025,CTL050,CTL100,
17463     1                  CTU999,CTU995,CTU990,CTU975,CTU950,CTU900,
17464     1                  CVL001,CVL005,CVL010,CVL025,CVL050,CVL100,
17465     1                  CVU999,CVU995,CVU990,CVU975,CVU950,CVU900,
17466     1                  IBUGA3,ISUBRO,IERROR)
17467C
17468C     PURPOSE--THIS ROUTINE CARRIES OUT A 2-SAMPLE MANN WHITNEY RANK SUM
17469C              TEST
17470C
17471C              NOTE THAT THIS COMPUTES THE W (RANK STATISTIC), NOT THE
17472C              U STATISTIC THAT SOME PREFER.
17473C
17474C     EXAMPLE--RANK SUM TEST Y1 Y2
17475C              MANN WHITNEY RANK SUM TEST Y1 Y2
17476C     SAMPLE 1 IS IN INPUT VECTOR Y1
17477C              (WITH N1 OBSERVATIONS).
17478C     SAMPLE 2 IS IN INPUT VECTOR Y2
17479C              (WITH N1 OBSERVATIONS).
17480C     WRITTEN BY--ALAN HECKERT
17481C                 STATISTICAL ENGINEERING DIVISION
17482C                 INFORMATION TECHNOLOGY LABORATORY
17483C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
17484C                 GAITHERSBURG, MD 20899-8980
17485C                 PHONE--301-975-2899
17486C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
17487C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
17488C     LANGUAGE--ANSI FORTRAN (1977)
17489C     VERSION NUMBER--99/6
17490C     ORIGINAL VERSION--JUNE      1999.
17491C     UPDATED         --AUGUST    2002.
17492C     UPDATED         --JANUARY   2007. CALL LIST TO RANK
17493C     UPDATED         --MAY       2011. SWITCH FROM WALPOLE/MEYERS
17494C                                       FORMULATION TO CONOVER
17495C                                       IMPLEMENTATION SINCE CONOVER HAS
17496C                                       A MORE COMPLETE SET OF TABLES FOR
17497C                                       SMALL SAMPLES
17498C     UPDATED         --MAY       2011. USE DPDTA1, DPDTA5 TO PRINT
17499C                                       OUTPUT.  REFORMAT OUTPUT
17500C                                       SOMEWHAT AS WELL.
17501C
17502C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
17503C
17504      CHARACTER*4 IVARID
17505      CHARACTER*4 IVARI2
17506      CHARACTER*4 IVARI3
17507      CHARACTER*4 IVARI4
17508      CHARACTER*4 ICAPSW
17509      CHARACTER*4 ICAPTY
17510      CHARACTER*4 IFORSW
17511      CHARACTER*4 ICASAN
17512      CHARACTER*4 IBUGA3
17513      CHARACTER*4 ISUBRO
17514      CHARACTER*4 IERROR
17515C
17516      CHARACTER*4 IWRITE
17517C
17518      CHARACTER*4 ISUBN1
17519      CHARACTER*4 ISUBN2
17520      CHARACTER*4 ISTEPN
17521C
17522C---------------------------------------------------------------------
17523C
17524      DIMENSION Y1(*)
17525      DIMENSION Y2(*)
17526      DIMENSION TEMP1(*)
17527      DIMENSION TEMP2(*)
17528      DIMENSION TEMP3(*)
17529C
17530      PARAMETER (NUMALP=6)
17531      REAL ALPHA(NUMALP)
17532      PARAMETER (NUMAL2=4)
17533      REAL ALPHA2(NUMAL2)
17534C
17535      PARAMETER(NUMCLI=5)
17536      PARAMETER(MAXLIN=3)
17537      PARAMETER (MAXROW=40)
17538      CHARACTER*60 ITITLE
17539      CHARACTER*60 ITITLZ
17540      CHARACTER*60 ITITL9
17541      CHARACTER*60 ITEXT(MAXROW)
17542      CHARACTER*4  ALIGN(NUMCLI)
17543      CHARACTER*4  VALIGN(NUMCLI)
17544      REAL         AVALUE(MAXROW)
17545      INTEGER      NCTEXT(MAXROW)
17546      INTEGER      IDIGIT(MAXROW)
17547      INTEGER      NTOT(MAXROW)
17548      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
17549      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
17550      CHARACTER*4  ITYPCO(NUMCLI)
17551      INTEGER      NCTIT2(MAXLIN,NUMCLI)
17552      INTEGER      NCVALU(MAXROW,NUMCLI)
17553      INTEGER      IWHTML(NUMCLI)
17554      INTEGER      IWRTF(NUMCLI)
17555      REAL         AMAT(MAXROW,NUMCLI)
17556      LOGICAL IFRST
17557      LOGICAL ILAST
17558      LOGICAL IFLAGS
17559      LOGICAL IFLAGE
17560C
17561C---------------------------------------------------------------------
17562C
17563      INCLUDE 'DPCOP2.INC'
17564C
17565      DATA ALPHA/0.90, 0.95, 0.975, 0.99, 0.995, 0.999/
17566      DATA ALPHA2/0.80, 0.90, 0.95, 0.99/
17567C
17568C-----START POINT-----------------------------------------------------
17569C
17570      ISUBN1='DPMN'
17571      ISUBN2='N2  '
17572      IERROR='NO'
17573      IWRITE='OFF'
17574C
17575      CTL001=0.0
17576      CTL005=0.0
17577      CTL010=0.0
17578      CTL025=0.0
17579      CTL050=0.0
17580      CTL100=0.0
17581      CTU999=0.0
17582      CTU995=0.0
17583      CTU990=0.0
17584      CTU975=0.0
17585      CTU950=0.0
17586      CTU900=0.0
17587      CVL001=0.0
17588      CVL005=0.0
17589      CVL010=0.0
17590      CVL025=0.0
17591      CVL050=0.0
17592      CVL100=0.0
17593      CVL999=0.0
17594      CVL995=0.0
17595      CVL990=0.0
17596      CVL975=0.0
17597      CVL950=0.0
17598      CVL900=0.0
17599C
17600      NUMDIG=7
17601      IF(IFORSW.EQ.'1')NUMDIG=1
17602      IF(IFORSW.EQ.'2')NUMDIG=2
17603      IF(IFORSW.EQ.'3')NUMDIG=3
17604      IF(IFORSW.EQ.'4')NUMDIG=4
17605      IF(IFORSW.EQ.'5')NUMDIG=5
17606      IF(IFORSW.EQ.'6')NUMDIG=6
17607      IF(IFORSW.EQ.'7')NUMDIG=7
17608      IF(IFORSW.EQ.'8')NUMDIG=8
17609      IF(IFORSW.EQ.'9')NUMDIG=9
17610      IF(IFORSW.EQ.'0')NUMDIG=0
17611      IF(IFORSW.EQ.'E')NUMDIG=-2
17612      IF(IFORSW.EQ.'-2')NUMDIG=-2
17613      IF(IFORSW.EQ.'-3')NUMDIG=-3
17614      IF(IFORSW.EQ.'-4')NUMDIG=-4
17615      IF(IFORSW.EQ.'-5')NUMDIG=-5
17616      IF(IFORSW.EQ.'-6')NUMDIG=-6
17617      IF(IFORSW.EQ.'-7')NUMDIG=-7
17618      IF(IFORSW.EQ.'-8')NUMDIG=-8
17619      IF(IFORSW.EQ.'-9')NUMDIG=-9
17620C
17621      CTL001=CPUMIN
17622      CTL005=CPUMIN
17623      CTL010=CPUMIN
17624      CTL025=CPUMIN
17625      CTL050=CPUMIN
17626      CTL100=CPUMIN
17627      CTU900=CPUMIN
17628      CTU950=CPUMIN
17629      CTU975=CPUMIN
17630      CTU990=CPUMIN
17631      CTU995=CPUMIN
17632      CTU999=CPUMIN
17633C
17634      CVL001=CPUMIN
17635      CVL005=CPUMIN
17636      CVL010=CPUMIN
17637      CVL025=CPUMIN
17638      CVL050=CPUMIN
17639      CVL100=CPUMIN
17640      CVU900=CPUMIN
17641      CVU950=CPUMIN
17642      CVU975=CPUMIN
17643      CVU990=CPUMIN
17644      CVU995=CPUMIN
17645      CVU999=CPUMIN
17646C
17647      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MNN2')THEN
17648        WRITE(ICOUT,999)
17649  999   FORMAT(1X)
17650        CALL DPWRST('XXX','WRIT')
17651        WRITE(ICOUT,51)
17652   51   FORMAT('**** AT THE BEGINNING OF DPMNN2--')
17653        CALL DPWRST('XXX','WRIT')
17654        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASAN
17655   52   FORMAT('IBUGA3,ISUBRO,ICASAN = ',2(A4,2X),A4)
17656        CALL DPWRST('XXX','WRIT')
17657        WRITE(ICOUT,53)IVARID,IVARI2,IVARI3,IVARI4
17658   53   FORMAT('IVARID,IVARI2,IVARI3,IVARI4 = ',3(A4,2X),A4)
17659        CALL DPWRST('XXX','WRIT')
17660        WRITE(ICOUT,55)N1,NUMDIG,D0
17661   55   FORMAT('N1,NUMDIG,D0 = ',2I8,G15.7)
17662        CALL DPWRST('XXX','WRIT')
17663        IF(N1.GE.1)THEN
17664          DO56I=1,N1
17665            WRITE(ICOUT,57)I,Y1(I),Y2(I)
17666   57       FORMAT('I,Y1(I),Y2(I) = ',I8,2G15.7)
17667            CALL DPWRST('XXX','WRIT')
17668   56     CONTINUE
17669        ENDIF
17670      ENDIF
17671C
17672C               ************************************
17673C               **   STEP 1--                     **
17674C               **   CALL DPMNN3 TO COMPUTE THE   **
17675C               **   BASIC TEST STATISTIC (FOR    **
17676C               **   EITHER 1-SAMPLE OR 2-SAMPLE  **
17677C               **   CASE).                       **
17678C               ************************************
17679C
17680      ISTEPN='1'
17681      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN2')
17682     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17683C
17684      CALL DPMNN3(Y1,N1,Y2,N2,
17685     1            TEMP1,TEMP2,TEMP3,MAXNXT,
17686     1            STATVA,STATV1,STATV2,STATV3,STATCD,NTIES,
17687     1            PVAL2T,PVALLT,PVALUT,
17688     1            IBUGA3,ISUBRO,IERROR)
17689      CALL MEAN(Y1,N1,IWRITE,YMEAN1,IBUGA3,IERROR)
17690      CALL MEDIAN(Y1,N1,IWRITE,TEMP1,MAXNXT,YMED1,IBUGA3,IERROR)
17691      CALL MEAN(Y2,N2,IWRITE,YMEAN2,IBUGA3,IERROR)
17692      CALL MEDIAN(Y2,N2,IWRITE,TEMP1,MAXNXT,YMED2,IBUGA3,IERROR)
17693C
17694C               ***************************************
17695C               **  STEP 21--                        **
17696C               **  COMPUTE THE CRITICAL VALUES FOR  **
17697C               **  VARIOUS VALUES OF ALPHA          **
17698C               ***************************************
17699C
17700      ISTEPN='21'
17701      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN2')
17702     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
17703C
17704C     LARGE SAMPLE NORMAL APPROXIMATION VALUES FIRST
17705C
17706      CALL NORPPF(.005,CTL005)
17707      CALL NORPPF(.010,CTL010)
17708      CALL NORPPF(.025,CTL025)
17709      CALL NORPPF(.050,CTL050)
17710      CALL NORPPF(.100,CTL100)
17711      CALL NORPPF(.200,CTL200)
17712      CALL NORPPF(.500,CTL500)
17713      CALL NORPPF(.500,CTU500)
17714      CALL NORPPF(.800,CTU800)
17715      CALL NORPPF(.900,CTU900)
17716      CALL NORPPF(.950,CTU950)
17717      CALL NORPPF(.975,CTU975)
17718      CALL NORPPF(.990,CTU990)
17719      CALL NORPPF(.995,CTU995)
17720C
17721C     NOW GENERATE EXACT CRITICAL VALUES FROM CONOVER TABLES
17722C     IF THERE ARE NO TIES AND N1 AND N2 ARE BOTH <= 20.
17723C
17724      ITAB=0
17725      IF(NTIES.EQ.0 .AND. N1.LE.20 .AND. N2.LE.20)THEN
17726        ITAB=1
17727        IF(N1.EQ.2)THEN
17728          IF(N2.EQ.2)THEN
17729            CVL001=3
17730            CVL005=3
17731            CVL010=3
17732            CVL025=3
17733            CVL050=3
17734            CVL100=3
17735          ELSEIF(N2.EQ.3)THEN
17736            CVL001=3
17737            CVL005=3
17738            CVL010=3
17739            CVL025=3
17740            CVL050=3
17741            CVL100=4
17742          ELSEIF(N2.EQ.4)THEN
17743            CVL001=3
17744            CVL005=3
17745            CVL010=3
17746            CVL025=3
17747            CVL050=3
17748            CVL100=4
17749          ELSEIF(N2.EQ.5)THEN
17750            CVL001=3
17751            CVL005=3
17752            CVL010=3
17753            CVL025=3
17754            CVL050=4
17755            CVL100=5
17756          ELSEIF(N2.EQ.6)THEN
17757            CVL001=3
17758            CVL005=3
17759            CVL010=3
17760            CVL025=3
17761            CVL050=4
17762            CVL100=5
17763          ELSEIF(N2.EQ.7)THEN
17764            CVL001=3
17765            CVL005=3
17766            CVL010=3
17767            CVL025=3
17768            CVL050=4
17769            CVL100=5
17770          ELSEIF(N2.EQ.8)THEN
17771            CVL001=3
17772            CVL005=3
17773            CVL010=3
17774            CVL025=4
17775            CVL050=5
17776            CVL100=6
17777          ELSEIF(N2.EQ.9)THEN
17778            CVL001=3
17779            CVL005=3
17780            CVL010=3
17781            CVL025=4
17782            CVL050=5
17783            CVL100=6
17784          ELSEIF(N2.EQ.10)THEN
17785            CVL001=3
17786            CVL005=3
17787            CVL010=3
17788            CVL025=4
17789            CVL050=5
17790            CVL100=7
17791          ELSEIF(N2.EQ.11)THEN
17792            CVL001=3
17793            CVL005=3
17794            CVL010=3
17795            CVL025=5
17796            CVL050=5
17797            CVL100=7
17798          ELSEIF(N2.EQ.12)THEN
17799            CVL001=3
17800            CVL005=3
17801            CVL010=3
17802            CVL025=5
17803            CVL050=6
17804            CVL100=8
17805          ELSEIF(N2.EQ.13)THEN
17806            CVL001=3
17807            CVL005=3
17808            CVL010=4
17809            CVL025=5
17810            CVL050=6
17811            CVL100=8
17812          ELSEIF(N2.EQ.14)THEN
17813            CVL001=3
17814            CVL005=3
17815            CVL010=4
17816            CVL025=5
17817            CVL050=7
17818            CVL100=8
17819          ELSEIF(N2.EQ.15)THEN
17820            CVL001=3
17821            CVL005=3
17822            CVL010=4
17823            CVL025=5
17824            CVL050=7
17825            CVL100=9
17826          ELSEIF(N2.EQ.16)THEN
17827            CVL001=3
17828            CVL005=3
17829            CVL010=4
17830            CVL025=5
17831            CVL050=7
17832            CVL100=9
17833          ELSEIF(N2.EQ.17)THEN
17834            CVL001=3
17835            CVL005=3
17836            CVL010=4
17837            CVL025=6
17838            CVL050=7
17839            CVL100=10
17840          ELSEIF(N2.EQ.18)THEN
17841            CVL001=3
17842            CVL005=3
17843            CVL010=4
17844            CVL025=6
17845            CVL050=8
17846            CVL100=10
17847          ELSEIF(N2.EQ.19)THEN
17848            CVL001=3
17849            CVL005=3
17850            CVL010=5
17851            CVL025=6
17852            CVL050=8
17853            CVL100=11
17854          ELSEIF(N2.EQ.20)THEN
17855            CVL001=3
17856            CVL005=4
17857            CVL010=5
17858            CVL025=6
17859            CVL050=8
17860            CVL100=11
17861          ENDIF
17862        ELSEIF(N1.EQ.3)THEN
17863          IF(N2.EQ.2)THEN
17864            CVL001=6
17865            CVL005=6
17866            CVL010=6
17867            CVL025=6
17868            CVL050=6
17869            CVL100=7
17870          ELSEIF(N2.EQ.3)THEN
17871            CVL001=6
17872            CVL005=6
17873            CVL010=6
17874            CVL025=6
17875            CVL050=7
17876            CVL100=8
17877          ELSEIF(N2.EQ.4)THEN
17878            CVL001=6
17879            CVL005=6
17880            CVL010=6
17881            CVL025=6
17882            CVL050=7
17883            CVL100=8
17884          ELSEIF(N2.EQ.5)THEN
17885            CVL001=6
17886            CVL005=6
17887            CVL010=6
17888            CVL025=7
17889            CVL050=8
17890            CVL100=9
17891          ELSEIF(N2.EQ.6)THEN
17892            CVL001=6
17893            CVL005=6
17894            CVL010=6
17895            CVL025=8
17896            CVL050=9
17897            CVL100=10
17898          ELSEIF(N2.EQ.7)THEN
17899            CVL001=6
17900            CVL005=6
17901            CVL010=7
17902            CVL025=8
17903            CVL050=9
17904            CVL100=11
17905          ELSEIF(N2.EQ.8)THEN
17906            CVL001=6
17907            CVL005=6
17908            CVL010=7
17909            CVL025=9
17910            CVL050=10
17911            CVL100=12
17912          ELSEIF(N2.EQ.9)THEN
17913            CVL001=6
17914            CVL005=7
17915            CVL010=8
17916            CVL025=9
17917            CVL050=11
17918            CVL100=12
17919          ELSEIF(N2.EQ.10)THEN
17920            CVL001=6
17921            CVL005=7
17922            CVL010=8
17923            CVL025=10
17924            CVL050=11
17925            CVL100=13
17926          ELSEIF(N2.EQ.11)THEN
17927            CVL001=6
17928            CVL005=7
17929            CVL010=8
17930            CVL025=10
17931            CVL050=12
17932            CVL100=14
17933          ELSEIF(N2.EQ.12)THEN
17934            CVL001=6
17935            CVL005=8
17936            CVL010=9
17937            CVL025=11
17938            CVL050=12
17939            CVL100=15
17940          ELSEIF(N2.EQ.13)THEN
17941            CVL001=6
17942            CVL005=8
17943            CVL010=9
17944            CVL025=11
17945            CVL050=13
17946            CVL100=16
17947          ELSEIF(N2.EQ.14)THEN
17948            CVL001=6
17949            CVL005=8
17950            CVL010=9
17951            CVL025=12
17952            CVL050=14
17953            CVL100=17
17954          ELSEIF(N2.EQ.15)THEN
17955            CVL001=6
17956            CVL005=9
17957            CVL010=10
17958            CVL025=12
17959            CVL050=14
17960            CVL100=17
17961          ELSEIF(N2.EQ.16)THEN
17962            CVL001=6
17963            CVL005=9
17964            CVL010=10
17965            CVL025=13
17966            CVL050=15
17967            CVL100=18
17968          ELSEIF(N2.EQ.17)THEN
17969            CVL001=7
17970            CVL005=9
17971            CVL010=11
17972            CVL025=13
17973            CVL050=16
17974            CVL100=19
17975          ELSEIF(N2.EQ.18)THEN
17976            CVL001=7
17977            CVL005=9
17978            CVL010=11
17979            CVL025=14
17980            CVL050=16
17981            CVL100=20
17982          ELSEIF(N2.EQ.19)THEN
17983            CVL001=7
17984            CVL005=10
17985            CVL010=11
17986            CVL025=14
17987            CVL050=17
17988            CVL100=21
17989          ELSEIF(N2.EQ.20)THEN
17990            CVL001=7
17991            CVL005=10
17992            CVL010=12
17993            CVL025=15
17994            CVL050=18
17995            CVL100=22
17996          ENDIF
17997        ELSEIF(N1.EQ.4)THEN
17998          IF(N2.EQ.2)THEN
17999            CVL001=10
18000            CVL005=10
18001            CVL010=10
18002            CVL025=10
18003            CVL050=10
18004            CVL100=11
18005          ELSEIF(N2.EQ.3)THEN
18006            CVL001=10
18007            CVL005=10
18008            CVL010=10
18009            CVL025=10
18010            CVL050=11
18011            CVL100=12
18012          ELSEIF(N2.EQ.4)THEN
18013            CVL001=10
18014            CVL005=10
18015            CVL010=10
18016            CVL025=11
18017            CVL050=12
18018            CVL100=14
18019          ELSEIF(N2.EQ.5)THEN
18020            CVL001=10
18021            CVL005=10
18022            CVL010=11
18023            CVL025=12
18024            CVL050=13
18025            CVL100=15
18026          ELSEIF(N2.EQ.6)THEN
18027            CVL001=10
18028            CVL005=11
18029            CVL010=12
18030            CVL025=13
18031            CVL050=14
18032            CVL100=16
18033          ELSEIF(N2.EQ.7)THEN
18034            CVL001=10
18035            CVL005=11
18036            CVL010=12
18037            CVL025=14
18038            CVL050=15
18039            CVL100=17
18040          ELSEIF(N2.EQ.8)THEN
18041            CVL001=10
18042            CVL005=12
18043            CVL010=13
18044            CVL025=15
18045            CVL050=16
18046            CVL100=18
18047          ELSEIF(N2.EQ.9)THEN
18048            CVL001=10
18049            CVL005=12
18050            CVL010=14
18051            CVL025=15
18052            CVL050=17
18053            CVL100=20
18054          ELSEIF(N2.EQ.10)THEN
18055            CVL001=11
18056            CVL005=13
18057            CVL010=14
18058            CVL025=16
18059            CVL050=18
18060            CVL100=21
18061          ELSEIF(N2.EQ.11)THEN
18062            CVL001=11
18063            CVL005=13
18064            CVL010=15
18065            CVL025=17
18066            CVL050=19
18067            CVL100=22
18068          ELSEIF(N2.EQ.12)THEN
18069            CVL001=11
18070            CVL005=14
18071            CVL010=16
18072            CVL025=18
18073            CVL050=20
18074            CVL100=23
18075          ELSEIF(N2.EQ.13)THEN
18076            CVL001=12
18077            CVL005=14
18078            CVL010=16
18079            CVL025=19
18080            CVL050=21
18081            CVL100=24
18082          ELSEIF(N2.EQ.14)THEN
18083            CVL001=12
18084            CVL005=15
18085            CVL010=17
18086            CVL025=20
18087            CVL050=22
18088            CVL100=26
18089          ELSEIF(N2.EQ.15)THEN
18090            CVL001=12
18091            CVL005=16
18092            CVL010=18
18093            CVL025=21
18094            CVL050=23
18095            CVL100=27
18096          ELSEIF(N2.EQ.16)THEN
18097            CVL001=13
18098            CVL005=16
18099            CVL010=18
18100            CVL025=22
18101            CVL050=25
18102            CVL100=28
18103          ELSEIF(N2.EQ.17)THEN
18104            CVL001=13
18105            CVL005=17
18106            CVL010=19
18107            CVL025=22
18108            CVL050=26
18109            CVL100=29
18110          ELSEIF(N2.EQ.18)THEN
18111            CVL001=14
18112            CVL005=17
18113            CVL010=20
18114            CVL025=23
18115            CVL050=27
18116            CVL100=31
18117          ELSEIF(N2.EQ.19)THEN
18118            CVL001=14
18119            CVL005=18
18120            CVL010=20
18121            CVL025=24
18122            CVL050=28
18123            CVL100=32
18124          ELSEIF(N2.EQ.20)THEN
18125            CVL001=14
18126            CVL005=19
18127            CVL010=21
18128            CVL025=25
18129            CVL050=29
18130            CVL100=33
18131          ENDIF
18132        ELSEIF(N1.EQ.5)THEN
18133          IF(N2.EQ.2)THEN
18134            CVL001=15
18135            CVL005=15
18136            CVL010=15
18137            CVL025=15
18138            CVL050=16
18139            CVL100=17
18140          ELSEIF(N2.EQ.3)THEN
18141            CVL001=15
18142            CVL005=15
18143            CVL010=15
18144            CVL025=16
18145            CVL050=17
18146            CVL100=18
18147          ELSEIF(N2.EQ.4)THEN
18148            CVL001=15
18149            CVL005=15
18150            CVL010=16
18151            CVL025=17
18152            CVL050=18
18153            CVL100=20
18154          ELSEIF(N2.EQ.5)THEN
18155            CVL001=15
18156            CVL005=16
18157            CVL010=17
18158            CVL025=18
18159            CVL050=20
18160            CVL100=21
18161          ELSEIF(N2.EQ.6)THEN
18162            CVL001=15
18163            CVL005=17
18164            CVL010=18
18165            CVL025=19
18166            CVL050=21
18167            CVL100=23
18168          ELSEIF(N2.EQ.7)THEN
18169            CVL001=15
18170            CVL005=17
18171            CVL010=19
18172            CVL025=21
18173            CVL050=22
18174            CVL100=24
18175          ELSEIF(N2.EQ.8)THEN
18176            CVL001=16
18177            CVL005=18
18178            CVL010=20
18179            CVL025=22
18180            CVL050=24
18181            CVL100=26
18182          ELSEIF(N2.EQ.9)THEN
18183            CVL001=17
18184            CVL005=19
18185            CVL010=21
18186            CVL025=23
18187            CVL050=25
18188            CVL100=28
18189          ELSEIF(N2.EQ.10)THEN
18190            CVL001=17
18191            CVL005=20
18192            CVL010=22
18193            CVL025=24
18194            CVL050=27
18195            CVL100=29
18196          ELSEIF(N2.EQ.11)THEN
18197            CVL001=18
18198            CVL005=21
18199            CVL010=23
18200            CVL025=25
18201            CVL050=28
18202            CVL100=31
18203          ELSEIF(N2.EQ.12)THEN
18204            CVL001=18
18205            CVL005=22
18206            CVL010=24
18207            CVL025=27
18208            CVL050=29
18209            CVL100=33
18210          ELSEIF(N2.EQ.13)THEN
18211            CVL001=19
18212            CVL005=23
18213            CVL010=25
18214            CVL025=28
18215            CVL050=31
18216            CVL100=34
18217          ELSEIF(N2.EQ.14)THEN
18218            CVL001=19
18219            CVL005=23
18220            CVL010=26
18221            CVL025=29
18222            CVL050=32
18223            CVL100=36
18224          ELSEIF(N2.EQ.15)THEN
18225            CVL001=20
18226            CVL005=24
18227            CVL010=27
18228            CVL025=30
18229            CVL050=34
18230            CVL100=38
18231          ELSEIF(N2.EQ.16)THEN
18232            CVL001=21
18233            CVL005=25
18234            CVL010=28
18235            CVL025=31
18236            CVL050=35
18237            CVL100=39
18238          ELSEIF(N2.EQ.17)THEN
18239            CVL001=21
18240            CVL005=26
18241            CVL010=29
18242            CVL025=33
18243            CVL050=36
18244            CVL100=41
18245          ELSEIF(N2.EQ.18)THEN
18246            CVL001=22
18247            CVL005=27
18248            CVL010=30
18249            CVL025=34
18250            CVL050=38
18251            CVL100=43
18252          ELSEIF(N2.EQ.19)THEN
18253            CVL001=23
18254            CVL005=28
18255            CVL010=31
18256            CVL025=35
18257            CVL050=39
18258            CVL100=44
18259          ELSEIF(N2.EQ.20)THEN
18260            CVL001=23
18261            CVL005=29
18262            CVL010=32
18263            CVL025=36
18264            CVL050=41
18265            CVL100=46
18266          ENDIF
18267        ELSEIF(N1.EQ.6)THEN
18268          IF(N2.EQ.2)THEN
18269            CVL001=21
18270            CVL005=21
18271            CVL010=21
18272            CVL025=21
18273            CVL050=22
18274            CVL100=23
18275          ELSEIF(N2.EQ.3)THEN
18276            CVL001=21
18277            CVL005=21
18278            CVL010=21
18279            CVL025=23
18280            CVL050=24
18281            CVL100=25
18282          ELSEIF(N2.EQ.4)THEN
18283            CVL001=21
18284            CVL005=22
18285            CVL010=23
18286            CVL025=24
18287            CVL050=25
18288            CVL100=27
18289          ELSEIF(N2.EQ.5)THEN
18290            CVL001=21
18291            CVL005=23
18292            CVL010=24
18293            CVL025=25
18294            CVL050=27
18295            CVL100=29
18296          ELSEIF(N2.EQ.6)THEN
18297            CVL001=21
18298            CVL005=24
18299            CVL010=25
18300            CVL025=27
18301            CVL050=29
18302            CVL100=31
18303          ELSEIF(N2.EQ.7)THEN
18304            CVL001=21
18305            CVL005=25
18306            CVL010=26
18307            CVL025=28
18308            CVL050=30
18309            CVL100=33
18310          ELSEIF(N2.EQ.8)THEN
18311            CVL001=23
18312            CVL005=26
18313            CVL010=28
18314            CVL025=30
18315            CVL050=32
18316            CVL100=35
18317          ELSEIF(N2.EQ.9)THEN
18318            CVL001=24
18319            CVL005=27
18320            CVL010=29
18321            CVL025=32
18322            CVL050=34
18323            CVL100=37
18324          ELSEIF(N2.EQ.10)THEN
18325            CVL001=25
18326            CVL005=28
18327            CVL010=30
18328            CVL025=33
18329            CVL050=36
18330            CVL100=39
18331          ELSEIF(N2.EQ.11)THEN
18332            CVL001=26
18333            CVL005=29
18334            CVL010=31
18335            CVL025=35
18336            CVL050=38
18337            CVL100=41
18338          ELSEIF(N2.EQ.12)THEN
18339            CVL001=26
18340            CVL005=31
18341            CVL010=33
18342            CVL025=36
18343            CVL050=39
18344            CVL100=43
18345          ELSEIF(N2.EQ.13)THEN
18346            CVL001=27
18347            CVL005=32
18348            CVL010=34
18349            CVL025=38
18350            CVL050=41
18351            CVL100=45
18352          ELSEIF(N2.EQ.14)THEN
18353            CVL001=28
18354            CVL005=33
18355            CVL010=35
18356            CVL025=39
18357            CVL050=43
18358            CVL100=47
18359          ELSEIF(N2.EQ.15)THEN
18360            CVL001=29
18361            CVL005=34
18362            CVL010=37
18363            CVL025=41
18364            CVL050=45
18365            CVL100=49
18366          ELSEIF(N2.EQ.16)THEN
18367            CVL001=30
18368            CVL005=35
18369            CVL010=38
18370            CVL025=43
18371            CVL050=47
18372            CVL100=51
18373          ELSEIF(N2.EQ.17)THEN
18374            CVL001=31
18375            CVL005=37
18376            CVL010=40
18377            CVL025=44
18378            CVL050=48
18379            CVL100=53
18380          ELSEIF(N2.EQ.18)THEN
18381            CVL001=32
18382            CVL005=38
18383            CVL010=41
18384            CVL025=46
18385            CVL050=50
18386            CVL100=56
18387          ELSEIF(N2.EQ.19)THEN
18388            CVL001=33
18389            CVL005=39
18390            CVL010=42
18391            CVL025=47
18392            CVL050=52
18393            CVL100=58
18394          ELSEIF(N2.EQ.20)THEN
18395            CVL001=34
18396            CVL005=40
18397            CVL010=44
18398            CVL025=49
18399            CVL050=54
18400            CVL100=60
18401          ENDIF
18402        ELSEIF(N1.EQ.7)THEN
18403          IF(N2.EQ.2)THEN
18404            CVL001=28
18405            CVL005=28
18406            CVL010=28
18407            CVL025=28
18408            CVL050=29
18409            CVL100=30
18410          ELSEIF(N2.EQ.3)THEN
18411            CVL001=28
18412            CVL005=28
18413            CVL010=29
18414            CVL025=30
18415            CVL050=31
18416            CVL100=33
18417          ELSEIF(N2.EQ.4)THEN
18418            CVL001=28
18419            CVL005=29
18420            CVL010=30
18421            CVL025=32
18422            CVL050=33
18423            CVL100=35
18424          ELSEIF(N2.EQ.5)THEN
18425            CVL001=28
18426            CVL005=30
18427            CVL010=32
18428            CVL025=34
18429            CVL050=35
18430            CVL100=37
18431          ELSEIF(N2.EQ.6)THEN
18432            CVL001=29
18433            CVL005=32
18434            CVL010=33
18435            CVL025=35
18436            CVL050=37
18437            CVL100=40
18438          ELSEIF(N2.EQ.7)THEN
18439            CVL001=30
18440            CVL005=33
18441            CVL010=35
18442            CVL025=37
18443            CVL050=40
18444            CVL100=42
18445          ELSEIF(N2.EQ.8)THEN
18446            CVL001=31
18447            CVL005=35
18448            CVL010=36
18449            CVL025=39
18450            CVL050=42
18451            CVL100=45
18452          ELSEIF(N2.EQ.9)THEN
18453            CVL001=32
18454            CVL005=36
18455            CVL010=38
18456            CVL025=41
18457            CVL050=44
18458            CVL100=47
18459          ELSEIF(N2.EQ.10)THEN
18460            CVL001=34
18461            CVL005=38
18462            CVL010=40
18463            CVL025=43
18464            CVL050=46
18465            CVL100=50
18466          ELSEIF(N2.EQ.11)THEN
18467            CVL001=35
18468            CVL005=39
18469            CVL010=41
18470            CVL025=45
18471            CVL050=48
18472            CVL100=52
18473          ELSEIF(N2.EQ.12)THEN
18474            CVL001=36
18475            CVL005=41
18476            CVL010=43
18477            CVL025=47
18478            CVL050=50
18479            CVL100=55
18480          ELSEIF(N2.EQ.13)THEN
18481            CVL001=37
18482            CVL005=42
18483            CVL010=45
18484            CVL025=49
18485            CVL050=53
18486            CVL100=57
18487          ELSEIF(N2.EQ.14)THEN
18488            CVL001=38
18489            CVL005=44
18490            CVL010=46
18491            CVL025=51
18492            CVL050=55
18493            CVL100=60
18494          ELSEIF(N2.EQ.15)THEN
18495            CVL001=39
18496            CVL005=45
18497            CVL010=48
18498            CVL025=53
18499            CVL050=57
18500            CVL100=62
18501          ELSEIF(N2.EQ.16)THEN
18502            CVL001=40
18503            CVL005=47
18504            CVL010=50
18505            CVL025=55
18506            CVL050=59
18507            CVL100=65
18508          ELSEIF(N2.EQ.17)THEN
18509            CVL001=42
18510            CVL005=48
18511            CVL010=52
18512            CVL025=57
18513            CVL050=62
18514            CVL100=67
18515          ELSEIF(N2.EQ.18)THEN
18516            CVL001=43
18517            CVL005=50
18518            CVL010=53
18519            CVL025=59
18520            CVL050=64
18521            CVL100=70
18522          ELSEIF(N2.EQ.19)THEN
18523            CVL001=44
18524            CVL005=51
18525            CVL010=55
18526            CVL025=61
18527            CVL050=66
18528            CVL100=72
18529          ELSEIF(N2.EQ.20)THEN
18530            CVL001=45
18531            CVL005=53
18532            CVL010=57
18533            CVL025=63
18534            CVL050=68
18535            CVL100=75
18536          ENDIF
18537        ELSEIF(N1.EQ.8)THEN
18538          IF(N2.EQ.2)THEN
18539            CVL001=36
18540            CVL005=36
18541            CVL010=36
18542            CVL025=37
18543            CVL050=38
18544            CVL100=39
18545          ELSEIF(N2.EQ.3)THEN
18546            CVL001=36
18547            CVL005=36
18548            CVL010=37
18549            CVL025=39
18550            CVL050=40
18551            CVL100=42
18552          ELSEIF(N2.EQ.4)THEN
18553            CVL001=36
18554            CVL005=38
18555            CVL010=39
18556            CVL025=41
18557            CVL050=42
18558            CVL100=44
18559          ELSEIF(N2.EQ.5)THEN
18560            CVL001=37
18561            CVL005=39
18562            CVL010=41
18563            CVL025=43
18564            CVL050=45
18565            CVL100=47
18566          ELSEIF(N2.EQ.6)THEN
18567            CVL001=38
18568            CVL005=41
18569            CVL010=43
18570            CVL025=45
18571            CVL050=47
18572            CVL100=50
18573          ELSEIF(N2.EQ.7)THEN
18574            CVL001=39
18575            CVL005=43
18576            CVL010=44
18577            CVL025=47
18578            CVL050=50
18579            CVL100=53
18580          ELSEIF(N2.EQ.8)THEN
18581            CVL001=41
18582            CVL005=44
18583            CVL010=46
18584            CVL025=50
18585            CVL050=52
18586            CVL100=56
18587          ELSEIF(N2.EQ.9)THEN
18588            CVL001=42
18589            CVL005=46
18590            CVL010=48
18591            CVL025=52
18592            CVL050=55
18593            CVL100=59
18594          ELSEIF(N2.EQ.10)THEN
18595            CVL001=43
18596            CVL005=48
18597            CVL010=50
18598            CVL025=54
18599            CVL050=57
18600            CVL100=61
18601          ELSEIF(N2.EQ.11)THEN
18602            CVL001=45
18603            CVL005=50
18604            CVL010=52
18605            CVL025=56
18606            CVL050=60
18607            CVL100=64
18608          ELSEIF(N2.EQ.12)THEN
18609            CVL001=46
18610            CVL005=52
18611            CVL010=54
18612            CVL025=59
18613            CVL050=63
18614            CVL100=67
18615          ELSEIF(N2.EQ.13)THEN
18616            CVL001=48
18617            CVL005=54
18618            CVL010=56
18619            CVL025=61
18620            CVL050=65
18621            CVL100=70
18622          ELSEIF(N2.EQ.14)THEN
18623            CVL001=49
18624            CVL005=55
18625            CVL010=59
18626            CVL025=63
18627            CVL050=68
18628            CVL100=73
18629          ELSEIF(N2.EQ.15)THEN
18630            CVL001=51
18631            CVL005=57
18632            CVL010=61
18633            CVL025=66
18634            CVL050=70
18635            CVL100=76
18636          ELSEIF(N2.EQ.16)THEN
18637            CVL001=52
18638            CVL005=59
18639            CVL010=63
18640            CVL025=68
18641            CVL050=73
18642            CVL100=79
18643          ELSEIF(N2.EQ.17)THEN
18644            CVL001=54
18645            CVL005=61
18646            CVL010=65
18647            CVL025=71
18648            CVL050=76
18649            CVL100=82
18650          ELSEIF(N2.EQ.18)THEN
18651            CVL001=55
18652            CVL005=63
18653            CVL010=67
18654            CVL025=73
18655            CVL050=78
18656            CVL100=85
18657          ELSEIF(N2.EQ.19)THEN
18658            CVL001=57
18659            CVL005=65
18660            CVL010=69
18661            CVL025=75
18662            CVL050=81
18663            CVL100=88
18664          ELSEIF(N2.EQ.20)THEN
18665            CVL001=58
18666            CVL005=67
18667            CVL010=71
18668            CVL025=78
18669            CVL050=84
18670            CVL100=91
18671          ENDIF
18672        ELSEIF(N1.EQ.9)THEN
18673          IF(N2.EQ.2)THEN
18674            CVL001=45
18675            CVL005=45
18676            CVL010=45
18677            CVL025=46
18678            CVL050=47
18679            CVL100=48
18680          ELSEIF(N2.EQ.3)THEN
18681            CVL001=45
18682            CVL005=46
18683            CVL010=47
18684            CVL025=48
18685            CVL050=50
18686            CVL100=51
18687          ELSEIF(N2.EQ.4)THEN
18688            CVL001=45
18689            CVL005=47
18690            CVL010=49
18691            CVL025=50
18692            CVL050=52
18693            CVL100=55
18694          ELSEIF(N2.EQ.5)THEN
18695            CVL001=47
18696            CVL005=49
18697            CVL010=51
18698            CVL025=53
18699            CVL050=55
18700            CVL100=58
18701          ELSEIF(N2.EQ.6)THEN
18702            CVL001=48
18703            CVL005=51
18704            CVL010=53
18705            CVL025=56
18706            CVL050=58
18707            CVL100=61
18708          ELSEIF(N2.EQ.7)THEN
18709            CVL001=49
18710            CVL005=53
18711            CVL010=55
18712            CVL025=58
18713            CVL050=61
18714            CVL100=64
18715          ELSEIF(N2.EQ.8)THEN
18716            CVL001=51
18717            CVL005=55
18718            CVL010=57
18719            CVL025=61
18720            CVL050=64
18721            CVL100=68
18722          ELSEIF(N2.EQ.9)THEN
18723            CVL001=53
18724            CVL005=57
18725            CVL010=60
18726            CVL025=63
18727            CVL050=67
18728            CVL100=71
18729          ELSEIF(N2.EQ.10)THEN
18730            CVL001=54
18731            CVL005=59
18732            CVL010=62
18733            CVL025=66
18734            CVL050=70
18735            CVL100=74
18736          ELSEIF(N2.EQ.11)THEN
18737            CVL001=56
18738            CVL005=62
18739            CVL010=64
18740            CVL025=69
18741            CVL050=73
18742            CVL100=77
18743          ELSEIF(N2.EQ.12)THEN
18744            CVL001=58
18745            CVL005=64
18746            CVL010=67
18747            CVL025=72
18748            CVL050=76
18749            CVL100=81
18750          ELSEIF(N2.EQ.13)THEN
18751            CVL001=60
18752            CVL005=66
18753            CVL010=69
18754            CVL025=74
18755            CVL050=79
18756            CVL100=84
18757          ELSEIF(N2.EQ.14)THEN
18758            CVL001=61
18759            CVL005=68
18760            CVL010=72
18761            CVL025=77
18762            CVL050=82
18763            CVL100=87
18764          ELSEIF(N2.EQ.15)THEN
18765            CVL001=63
18766            CVL005=70
18767            CVL010=74
18768            CVL025=80
18769            CVL050=85
18770            CVL100=91
18771          ELSEIF(N2.EQ.16)THEN
18772            CVL001=65
18773            CVL005=73
18774            CVL010=77
18775            CVL025=83
18776            CVL050=88
18777            CVL100=94
18778          ELSEIF(N2.EQ.17)THEN
18779            CVL001=67
18780            CVL005=75
18781            CVL010=79
18782            CVL025=85
18783            CVL050=91
18784            CVL100=98
18785          ELSEIF(N2.EQ.18)THEN
18786            CVL001=69
18787            CVL005=77
18788            CVL010=82
18789            CVL025=88
18790            CVL050=94
18791            CVL100=101
18792          ELSEIF(N2.EQ.19)THEN
18793            CVL001=71
18794            CVL005=79
18795            CVL010=84
18796            CVL025=91
18797            CVL050=97
18798            CVL100=104
18799          ELSEIF(N2.EQ.20)THEN
18800            CVL001=72
18801            CVL005=82
18802            CVL010=86
18803            CVL025=94
18804            CVL050=100
18805            CVL100=108
18806          ENDIF
18807        ELSEIF(N1.EQ.10)THEN
18808          IF(N2.EQ.2)THEN
18809            CVL001=55
18810            CVL005=55
18811            CVL010=55
18812            CVL025=56
18813            CVL050=57
18814            CVL100=59
18815          ELSEIF(N2.EQ.3)THEN
18816            CVL001=55
18817            CVL005=56
18818            CVL010=57
18819            CVL025=59
18820            CVL050=60
18821            CVL100=62
18822          ELSEIF(N2.EQ.4)THEN
18823            CVL001=56
18824            CVL005=58
18825            CVL010=59
18826            CVL025=61
18827            CVL050=63
18828            CVL100=66
18829          ELSEIF(N2.EQ.5)THEN
18830            CVL001=57
18831            CVL005=60
18832            CVL010=62
18833            CVL025=64
18834            CVL050=67
18835            CVL100=69
18836          ELSEIF(N2.EQ.6)THEN
18837            CVL001=59
18838            CVL005=62
18839            CVL010=64
18840            CVL025=67
18841            CVL050=70
18842            CVL100=73
18843          ELSEIF(N2.EQ.7)THEN
18844            CVL001=61
18845            CVL005=65
18846            CVL010=67
18847            CVL025=70
18848            CVL050=73
18849            CVL100=77
18850          ELSEIF(N2.EQ.8)THEN
18851            CVL001=62
18852            CVL005=67
18853            CVL010=69
18854            CVL025=73
18855            CVL050=76
18856            CVL100=80
18857          ELSEIF(N2.EQ.9)THEN
18858            CVL001=64
18859            CVL005=69
18860            CVL010=72
18861            CVL025=76
18862            CVL050=80
18863            CVL100=84
18864          ELSEIF(N2.EQ.10)THEN
18865            CVL001=66
18866            CVL005=72
18867            CVL010=75
18868            CVL025=79
18869            CVL050=83
18870            CVL100=88
18871          ELSEIF(N2.EQ.11)THEN
18872            CVL001=68
18873            CVL005=74
18874            CVL010=78
18875            CVL025=82
18876            CVL050=87
18877            CVL100=92
18878          ELSEIF(N2.EQ.12)THEN
18879            CVL001=70
18880            CVL005=77
18881            CVL010=80
18882            CVL025=85
18883            CVL050=90
18884            CVL100=95
18885          ELSEIF(N2.EQ.13)THEN
18886            CVL001=73
18887            CVL005=80
18888            CVL010=83
18889            CVL025=89
18890            CVL050=93
18891            CVL100=99
18892          ELSEIF(N2.EQ.14)THEN
18893            CVL001=75
18894            CVL005=82
18895            CVL010=86
18896            CVL025=92
18897            CVL050=97
18898            CVL100=103
18899          ELSEIF(N2.EQ.15)THEN
18900            CVL001=77
18901            CVL005=85
18902            CVL010=89
18903            CVL025=95
18904            CVL050=100
18905            CVL100=107
18906          ELSEIF(N2.EQ.16)THEN
18907            CVL001=79
18908            CVL005=87
18909            CVL010=92
18910            CVL025=98
18911            CVL050=105
18912            CVL100=110
18913          ELSEIF(N2.EQ.17)THEN
18914            CVL001=81
18915            CVL005=90
18916            CVL010=94
18917            CVL025=101
18918            CVL050=107
18919            CVL100=114
18920          ELSEIF(N2.EQ.18)THEN
18921            CVL001=83
18922            CVL005=93
18923            CVL010=97
18924            CVL025=104
18925            CVL050=111
18926            CVL100=118
18927          ELSEIF(N2.EQ.19)THEN
18928            CVL001=85
18929            CVL005=95
18930            CVL010=100
18931            CVL025=108
18932            CVL050=114
18933            CVL100=122
18934          ELSEIF(N2.EQ.20)THEN
18935            CVL001=88
18936            CVL005=98
18937            CVL010=103
18938            CVL025=111
18939            CVL050=118
18940            CVL100=126
18941          ENDIF
18942        ELSEIF(N1.EQ.11)THEN
18943          IF(N2.EQ.2)THEN
18944            CVL001=66
18945            CVL005=66
18946            CVL010=66
18947            CVL025=67
18948            CVL050=68
18949            CVL100=70
18950          ELSEIF(N2.EQ.3)THEN
18951            CVL001=66
18952            CVL005=67
18953            CVL010=68
18954            CVL025=70
18955            CVL050=72
18956            CVL100=74
18957          ELSEIF(N2.EQ.4)THEN
18958            CVL001=67
18959            CVL005=69
18960            CVL010=71
18961            CVL025=73
18962            CVL050=75
18963            CVL100=78
18964          ELSEIF(N2.EQ.5)THEN
18965            CVL001=69
18966            CVL005=72
18967            CVL010=74
18968            CVL025=76
18969            CVL050=79
18970            CVL100=82
18971          ELSEIF(N2.EQ.6)THEN
18972            CVL001=71
18973            CVL005=74
18974            CVL010=76
18975            CVL025=80
18976            CVL050=83
18977            CVL100=86
18978          ELSEIF(N2.EQ.7)THEN
18979            CVL001=73
18980            CVL005=77
18981            CVL010=79
18982            CVL025=83
18983            CVL050=86
18984            CVL100=90
18985          ELSEIF(N2.EQ.8)THEN
18986            CVL001=75
18987            CVL005=80
18988            CVL010=82
18989            CVL025=86
18990            CVL050=90
18991            CVL100=94
18992          ELSEIF(N2.EQ.9)THEN
18993            CVL001=77
18994            CVL005=83
18995            CVL010=85
18996            CVL025=90
18997            CVL050=94
18998            CVL100=98
18999          ELSEIF(N2.EQ.10)THEN
19000            CVL001=79
19001            CVL005=85
19002            CVL010=89
19003            CVL025=93
19004            CVL050=98
19005            CVL100=103
19006          ELSEIF(N2.EQ.11)THEN
19007            CVL001=82
19008            CVL005=88
19009            CVL010=92
19010            CVL025=97
19011            CVL050=101
19012            CVL100=107
19013          ELSEIF(N2.EQ.12)THEN
19014            CVL001=84
19015            CVL005=91
19016            CVL010=95
19017            CVL025=100
19018            CVL050=105
19019            CVL100=111
19020          ELSEIF(N2.EQ.13)THEN
19021            CVL001=87
19022            CVL005=94
19023            CVL010=98
19024            CVL025=104
19025            CVL050=109
19026            CVL100=115
19027          ELSEIF(N2.EQ.14)THEN
19028            CVL001=89
19029            CVL005=97
19030            CVL010=101
19031            CVL025=107
19032            CVL050=113
19033            CVL100=119
19034          ELSEIF(N2.EQ.15)THEN
19035            CVL001=91
19036            CVL005=100
19037            CVL010=104
19038            CVL025=111
19039            CVL050=117
19040            CVL100=124
19041          ELSEIF(N2.EQ.16)THEN
19042            CVL001=94
19043            CVL005=103
19044            CVL010=108
19045            CVL025=114
19046            CVL050=121
19047            CVL100=128
19048          ELSEIF(N2.EQ.17)THEN
19049            CVL001=96
19050            CVL005=106
19051            CVL010=111
19052            CVL025=118
19053            CVL050=124
19054            CVL100=132
19055          ELSEIF(N2.EQ.18)THEN
19056            CVL001=99
19057            CVL005=109
19058            CVL010=114
19059            CVL025=122
19060            CVL050=128
19061            CVL100=136
19062          ELSEIF(N2.EQ.19)THEN
19063            CVL001=101
19064            CVL005=112
19065            CVL010=117
19066            CVL025=125
19067            CVL050=132
19068            CVL100=140
19069          ELSEIF(N2.EQ.20)THEN
19070            CVL001=104
19071            CVL005=115
19072            CVL010=120
19073            CVL025=129
19074            CVL050=136
19075            CVL100=145
19076          ENDIF
19077        ELSEIF(N1.EQ.12)THEN
19078          IF(N2.EQ.2)THEN
19079            CVL001=78
19080            CVL005=78
19081            CVL010=78
19082            CVL025=80
19083            CVL050=81
19084            CVL100=83
19085          ELSEIF(N2.EQ.3)THEN
19086            CVL001=78
19087            CVL005=80
19088            CVL010=81
19089            CVL025=83
19090            CVL050=84
19091            CVL100=87
19092          ELSEIF(N2.EQ.4)THEN
19093            CVL001=79
19094            CVL005=82
19095            CVL010=84
19096            CVL025=86
19097            CVL050=88
19098            CVL100=91
19099          ELSEIF(N2.EQ.5)THEN
19100            CVL001=81
19101            CVL005=85
19102            CVL010=87
19103            CVL025=90
19104            CVL050=92
19105            CVL100=96
19106          ELSEIF(N2.EQ.6)THEN
19107            CVL001=83
19108            CVL005=88
19109            CVL010=90
19110            CVL025=93
19111            CVL050=96
19112            CVL100=100
19113          ELSEIF(N2.EQ.7)THEN
19114            CVL001=86
19115            CVL005=91
19116            CVL010=93
19117            CVL025=97
19118            CVL050=100
19119            CVL100=105
19120          ELSEIF(N2.EQ.8)THEN
19121            CVL001=88
19122            CVL005=94
19123            CVL010=96
19124            CVL025=101
19125            CVL050=105
19126            CVL100=109
19127          ELSEIF(N2.EQ.9)THEN
19128            CVL001=91
19129            CVL005=97
19130            CVL010=100
19131            CVL025=105
19132            CVL050=109
19133            CVL100=114
19134          ELSEIF(N2.EQ.10)THEN
19135            CVL001=93
19136            CVL005=100
19137            CVL010=103
19138            CVL025=108
19139            CVL050=111
19140            CVL100=118
19141          ELSEIF(N2.EQ.11)THEN
19142            CVL001=96
19143            CVL005=103
19144            CVL010=107
19145            CVL025=112
19146            CVL050=117
19147            CVL100=123
19148          ELSEIF(N2.EQ.12)THEN
19149            CVL001=98
19150            CVL005=106
19151            CVL010=110
19152            CVL025=116
19153            CVL050=121
19154            CVL100=128
19155          ELSEIF(N2.EQ.13)THEN
19156            CVL001=102
19157            CVL005=110
19158            CVL010=114
19159            CVL025=120
19160            CVL050=126
19161            CVL100=132
19162          ELSEIF(N2.EQ.14)THEN
19163            CVL001=104
19164            CVL005=113
19165            CVL010=117
19166            CVL025=124
19167            CVL050=130
19168            CVL100=137
19169          ELSEIF(N2.EQ.15)THEN
19170            CVL001=106
19171            CVL005=116
19172            CVL010=121
19173            CVL025=128
19174            CVL050=134
19175            CVL100=142
19176          ELSEIF(N2.EQ.16)THEN
19177            CVL001=110
19178            CVL005=120
19179            CVL010=125
19180            CVL025=132
19181            CVL050=139
19182            CVL100=146
19183          ELSEIF(N2.EQ.17)THEN
19184            CVL001=113
19185            CVL005=123
19186            CVL010=128
19187            CVL025=136
19188            CVL050=143
19189            CVL100=151
19190          ELSEIF(N2.EQ.18)THEN
19191            CVL001=116
19192            CVL005=126
19193            CVL010=132
19194            CVL025=140
19195            CVL050=147
19196            CVL100=156
19197          ELSEIF(N2.EQ.19)THEN
19198            CVL001=118
19199            CVL005=130
19200            CVL010=135
19201            CVL025=144
19202            CVL050=151
19203            CVL100=160
19204          ELSEIF(N2.EQ.20)THEN
19205            CVL001=131
19206            CVL005=133
19207            CVL010=139
19208            CVL025=148
19209            CVL050=156
19210            CVL100=165
19211          ENDIF
19212        ELSEIF(N1.EQ.13)THEN
19213          IF(N2.EQ.2)THEN
19214            CVL001=91
19215            CVL005=91
19216            CVL010=92
19217            CVL025=93
19218            CVL050=94
19219            CVL100=96
19220          ELSEIF(N2.EQ.3)THEN
19221            CVL001=91
19222            CVL005=93
19223            CVL010=94
19224            CVL025=96
19225            CVL050=98
19226            CVL100=101
19227          ELSEIF(N2.EQ.4)THEN
19228            CVL001=93
19229            CVL005=95
19230            CVL010=97
19231            CVL025=100
19232            CVL050=102
19233            CVL100=105
19234          ELSEIF(N2.EQ.5)THEN
19235            CVL001=95
19236            CVL005=99
19237            CVL010=101
19238            CVL025=104
19239            CVL050=107
19240            CVL100=110
19241          ELSEIF(N2.EQ.6)THEN
19242            CVL001=97
19243            CVL005=102
19244            CVL010=104
19245            CVL025=108
19246            CVL050=111
19247            CVL100=115
19248          ELSEIF(N2.EQ.7)THEN
19249            CVL001=100
19250            CVL005=105
19251            CVL010=110
19252            CVL025=112
19253            CVL050=116
19254            CVL100=120
19255          ELSEIF(N2.EQ.8)THEN
19256            CVL001=103
19257            CVL005=109
19258            CVL010=112
19259            CVL025=116
19260            CVL050=120
19261            CVL100=125
19262          ELSEIF(N2.EQ.9)THEN
19263            CVL001=106
19264            CVL005=112
19265            CVL010=115
19266            CVL025=120
19267            CVL050=125
19268            CVL100=130
19269          ELSEIF(N2.EQ.10)THEN
19270            CVL001=109
19271            CVL005=116
19272            CVL010=119
19273            CVL025=125
19274            CVL050=129
19275            CVL100=135
19276          ELSEIF(N2.EQ.11)THEN
19277            CVL001=112
19278            CVL005=119
19279            CVL010=123
19280            CVL025=129
19281            CVL050=134
19282            CVL100=140
19283          ELSEIF(N2.EQ.12)THEN
19284            CVL001=115
19285            CVL005=123
19286            CVL010=127
19287            CVL025=133
19288            CVL050=139
19289            CVL100=145
19290          ELSEIF(N2.EQ.13)THEN
19291            CVL001=118
19292            CVL005=126
19293            CVL010=131
19294            CVL025=137
19295            CVL050=143
19296            CVL100=150
19297          ELSEIF(N2.EQ.14)THEN
19298            CVL001=121
19299            CVL005=130
19300            CVL010=135
19301            CVL025=142
19302            CVL050=148
19303            CVL100=155
19304          ELSEIF(N2.EQ.15)THEN
19305            CVL001=124
19306            CVL005=134
19307            CVL010=139
19308            CVL025=146
19309            CVL050=153
19310            CVL100=160
19311          ELSEIF(N2.EQ.16)THEN
19312            CVL001=127
19313            CVL005=137
19314            CVL010=143
19315            CVL025=151
19316            CVL050=157
19317            CVL100=166
19318          ELSEIF(N2.EQ.17)THEN
19319            CVL001=130
19320            CVL005=141
19321            CVL010=147
19322            CVL025=155
19323            CVL050=162
19324            CVL100=171
19325          ELSEIF(N2.EQ.18)THEN
19326            CVL001=134
19327            CVL005=145
19328            CVL010=151
19329            CVL025=159
19330            CVL050=167
19331            CVL100=176
19332          ELSEIF(N2.EQ.19)THEN
19333            CVL001=137
19334            CVL005=149
19335            CVL010=155
19336            CVL025=164
19337            CVL050=172
19338            CVL100=181
19339          ELSEIF(N2.EQ.20)THEN
19340            CVL001=140
19341            CVL005=152
19342            CVL010=159
19343            CVL025=168
19344            CVL050=176
19345            CVL100=186
19346          ENDIF
19347        ELSEIF(N1.EQ.14)THEN
19348          IF(N2.EQ.2)THEN
19349            CVL001=105
19350            CVL005=105
19351            CVL010=106
19352            CVL025=107
19353            CVL050=109
19354            CVL100=110
19355          ELSEIF(N2.EQ.3)THEN
19356            CVL001=105
19357            CVL005=107
19358            CVL010=108
19359            CVL025=111
19360            CVL050=113
19361            CVL100=116
19362          ELSEIF(N2.EQ.4)THEN
19363            CVL001=107
19364            CVL005=110
19365            CVL010=112
19366            CVL025=115
19367            CVL050=117
19368            CVL100=121
19369          ELSEIF(N2.EQ.5)THEN
19370            CVL001=109
19371            CVL005=113
19372            CVL010=116
19373            CVL025=119
19374            CVL050=122
19375            CVL100=126
19376          ELSEIF(N2.EQ.6)THEN
19377            CVL001=112
19378            CVL005=117
19379            CVL010=119
19380            CVL025=123
19381            CVL050=127
19382            CVL100=131
19383          ELSEIF(N2.EQ.7)THEN
19384            CVL001=115
19385            CVL005=121
19386            CVL010=123
19387            CVL025=128
19388            CVL050=132
19389            CVL100=137
19390          ELSEIF(N2.EQ.8)THEN
19391            CVL001=118
19392            CVL005=124
19393            CVL010=128
19394            CVL025=132
19395            CVL050=137
19396            CVL100=142
19397          ELSEIF(N2.EQ.9)THEN
19398            CVL001=121
19399            CVL005=128
19400            CVL010=132
19401            CVL025=137
19402            CVL050=142
19403            CVL100=147
19404          ELSEIF(N2.EQ.10)THEN
19405            CVL001=125
19406            CVL005=132
19407            CVL010=136
19408            CVL025=142
19409            CVL050=147
19410            CVL100=153
19411          ELSEIF(N2.EQ.11)THEN
19412            CVL001=128
19413            CVL005=136
19414            CVL010=140
19415            CVL025=146
19416            CVL050=152
19417            CVL100=158
19418          ELSEIF(N2.EQ.12)THEN
19419            CVL001=131
19420            CVL005=140
19421            CVL010=144
19422            CVL025=151
19423            CVL050=157
19424            CVL100=164
19425          ELSEIF(N2.EQ.13)THEN
19426            CVL001=135
19427            CVL005=144
19428            CVL010=149
19429            CVL025=156
19430            CVL050=162
19431            CVL100=169
19432          ELSEIF(N2.EQ.14)THEN
19433            CVL001=138
19434            CVL005=148
19435            CVL010=153
19436            CVL025=161
19437            CVL050=167
19438            CVL100=175
19439          ELSEIF(N2.EQ.15)THEN
19440            CVL001=142
19441            CVL005=152
19442            CVL010=157
19443            CVL025=165
19444            CVL050=172
19445            CVL100=180
19446          ELSEIF(N2.EQ.16)THEN
19447            CVL001=145
19448            CVL005=156
19449            CVL010=162
19450            CVL025=170
19451            CVL050=177
19452            CVL100=186
19453          ELSEIF(N2.EQ.17)THEN
19454            CVL001=149
19455            CVL005=160
19456            CVL010=166
19457            CVL025=175
19458            CVL050=183
19459            CVL100=191
19460          ELSEIF(N2.EQ.18)THEN
19461            CVL001=152
19462            CVL005=164
19463            CVL010=171
19464            CVL025=180
19465            CVL050=188
19466            CVL100=197
19467          ELSEIF(N2.EQ.19)THEN
19468            CVL001=156
19469            CVL005=169
19470            CVL010=175
19471            CVL025=184
19472            CVL050=193
19473            CVL100=203
19474          ELSEIF(N2.EQ.20)THEN
19475            CVL001=160
19476            CVL005=173
19477            CVL010=179
19478            CVL025=189
19479            CVL050=198
19480            CVL100=208
19481          ENDIF
19482        ELSEIF(N1.EQ.15)THEN
19483          IF(N2.EQ.2)THEN
19484            CVL001=120
19485            CVL005=120
19486            CVL010=121
19487            CVL025=122
19488            CVL050=124
19489            CVL100=126
19490          ELSEIF(N2.EQ.3)THEN
19491            CVL001=120
19492            CVL005=123
19493            CVL010=124
19494            CVL025=126
19495            CVL050=128
19496            CVL100=131
19497          ELSEIF(N2.EQ.4)THEN
19498            CVL001=122
19499            CVL005=126
19500            CVL010=128
19501            CVL025=131
19502            CVL050=133
19503            CVL100=137
19504          ELSEIF(N2.EQ.5)THEN
19505            CVL001=125
19506            CVL005=129
19507            CVL010=132
19508            CVL025=135
19509            CVL050=139
19510            CVL100=143
19511          ELSEIF(N2.EQ.6)THEN
19512            CVL001=128
19513            CVL005=133
19514            CVL010=136
19515            CVL025=140
19516            CVL050=144
19517            CVL100=148
19518          ELSEIF(N2.EQ.7)THEN
19519            CVL001=133
19520            CVL005=137
19521            CVL010=140
19522            CVL025=145
19523            CVL050=149
19524            CVL100=154
19525          ELSEIF(N2.EQ.8)THEN
19526            CVL001=135
19527            CVL005=141
19528            CVL010=145
19529            CVL025=150
19530            CVL050=154
19531            CVL100=160
19532          ELSEIF(N2.EQ.9)THEN
19533            CVL001=138
19534            CVL005=145
19535            CVL010=149
19536            CVL025=155
19537            CVL050=160
19538            CVL100=166
19539          ELSEIF(N2.EQ.10)THEN
19540            CVL001=142
19541            CVL005=150
19542            CVL010=154
19543            CVL025=160
19544            CVL050=165
19545            CVL100=172
19546          ELSEIF(N2.EQ.11)THEN
19547            CVL001=145
19548            CVL005=154
19549            CVL010=158
19550            CVL025=165
19551            CVL050=171
19552            CVL100=178
19553          ELSEIF(N2.EQ.12)THEN
19554            CVL001=149
19555            CVL005=158
19556            CVL010=163
19557            CVL025=170
19558            CVL050=176
19559            CVL100=184
19560          ELSEIF(N2.EQ.13)THEN
19561            CVL001=153
19562            CVL005=163
19563            CVL010=168
19564            CVL025=175
19565            CVL050=182
19566            CVL100=189
19567          ELSEIF(N2.EQ.14)THEN
19568            CVL001=157
19569            CVL005=167
19570            CVL010=172
19571            CVL025=180
19572            CVL050=187
19573            CVL100=195
19574          ELSEIF(N2.EQ.15)THEN
19575            CVL001=161
19576            CVL005=172
19577            CVL010=177
19578            CVL025=185
19579            CVL050=193
19580            CVL100=201
19581          ELSEIF(N2.EQ.16)THEN
19582            CVL001=164
19583            CVL005=176
19584            CVL010=182
19585            CVL025=191
19586            CVL050=198
19587            CVL100=207
19588          ELSEIF(N2.EQ.17)THEN
19589            CVL001=168
19590            CVL005=181
19591            CVL010=187
19592            CVL025=196
19593            CVL050=204
19594            CVL100=213
19595          ELSEIF(N2.EQ.18)THEN
19596            CVL001=172
19597            CVL005=185
19598            CVL010=191
19599            CVL025=201
19600            CVL050=209
19601            CVL100=219
19602          ELSEIF(N2.EQ.19)THEN
19603            CVL001=176
19604            CVL005=190
19605            CVL010=196
19606            CVL025=206
19607            CVL050=215
19608            CVL100=225
19609          ELSEIF(N2.EQ.20)THEN
19610            CVL001=180
19611            CVL005=194
19612            CVL010=201
19613            CVL025=211
19614            CVL050=221
19615            CVL100=231
19616          ENDIF
19617        ELSEIF(N1.EQ.16)THEN
19618          IF(N2.EQ.2)THEN
19619            CVL001=136
19620            CVL005=136
19621            CVL010=137
19622            CVL025=138
19623            CVL050=140
19624            CVL100=142
19625          ELSEIF(N2.EQ.3)THEN
19626            CVL001=136
19627            CVL005=139
19628            CVL010=140
19629            CVL025=143
19630            CVL050=145
19631            CVL100=148
19632          ELSEIF(N2.EQ.4)THEN
19633            CVL001=139
19634            CVL005=142
19635            CVL010=144
19636            CVL025=148
19637            CVL050=151
19638            CVL100=154
19639          ELSEIF(N2.EQ.5)THEN
19640            CVL001=142
19641            CVL005=146
19642            CVL010=149
19643            CVL025=152
19644            CVL050=156
19645            CVL100=160
19646          ELSEIF(N2.EQ.6)THEN
19647            CVL001=145
19648            CVL005=150
19649            CVL010=153
19650            CVL025=156
19651            CVL050=162
19652            CVL100=166
19653          ELSEIF(N2.EQ.7)THEN
19654            CVL001=148
19655            CVL005=155
19656            CVL010=158
19657            CVL025=163
19658            CVL050=167
19659            CVL100=173
19660          ELSEIF(N2.EQ.8)THEN
19661            CVL001=152
19662            CVL005=159
19663            CVL010=163
19664            CVL025=168
19665            CVL050=173
19666            CVL100=179
19667          ELSEIF(N2.EQ.9)THEN
19668            CVL001=156
19669            CVL005=164
19670            CVL010=168
19671            CVL025=174
19672            CVL050=179
19673            CVL100=185
19674          ELSEIF(N2.EQ.10)THEN
19675            CVL001=160
19676            CVL005=168
19677            CVL010=173
19678            CVL025=179
19679            CVL050=185
19680            CVL100=191
19681          ELSEIF(N2.EQ.11)THEN
19682            CVL001=164
19683            CVL005=173
19684            CVL010=178
19685            CVL025=184
19686            CVL050=191
19687            CVL100=198
19688          ELSEIF(N2.EQ.12)THEN
19689            CVL001=168
19690            CVL005=178
19691            CVL010=183
19692            CVL025=190
19693            CVL050=197
19694            CVL100=204
19695          ELSEIF(N2.EQ.13)THEN
19696            CVL001=172
19697            CVL005=182
19698            CVL010=188
19699            CVL025=196
19700            CVL050=202
19701            CVL100=211
19702          ELSEIF(N2.EQ.14)THEN
19703            CVL001=176
19704            CVL005=187
19705            CVL010=193
19706            CVL025=201
19707            CVL050=208
19708            CVL100=217
19709          ELSEIF(N2.EQ.15)THEN
19710            CVL001=180
19711            CVL005=192
19712            CVL010=198
19713            CVL025=207
19714            CVL050=214
19715            CVL100=223
19716          ELSEIF(N2.EQ.16)THEN
19717            CVL001=185
19718            CVL005=197
19719            CVL010=203
19720            CVL025=212
19721            CVL050=220
19722            CVL100=230
19723          ELSEIF(N2.EQ.17)THEN
19724            CVL001=189
19725            CVL005=202
19726            CVL010=208
19727            CVL025=218
19728            CVL050=226
19729            CVL100=236
19730          ELSEIF(N2.EQ.18)THEN
19731            CVL001=193
19732            CVL005=207
19733            CVL010=213
19734            CVL025=223
19735            CVL050=232
19736            CVL100=243
19737          ELSEIF(N2.EQ.19)THEN
19738            CVL001=197
19739            CVL005=211
19740            CVL010=219
19741            CVL025=229
19742            CVL050=238
19743            CVL100=249
19744          ELSEIF(N2.EQ.20)THEN
19745            CVL001=202
19746            CVL005=216
19747            CVL010=224
19748            CVL025=235
19749            CVL050=244
19750            CVL100=256
19751          ENDIF
19752        ELSEIF(N1.EQ.17)THEN
19753          IF(N2.EQ.2)THEN
19754            CVL001=153
19755            CVL005=153
19756            CVL010=154
19757            CVL025=156
19758            CVL050=157
19759            CVL100=160
19760          ELSEIF(N2.EQ.3)THEN
19761            CVL001=154
19762            CVL005=156
19763            CVL010=158
19764            CVL025=160
19765            CVL050=163
19766            CVL100=166
19767          ELSEIF(N2.EQ.4)THEN
19768            CVL001=156
19769            CVL005=160
19770            CVL010=162
19771            CVL025=165
19772            CVL050=169
19773            CVL100=172
19774          ELSEIF(N2.EQ.5)THEN
19775            CVL001=159
19776            CVL005=164
19777            CVL010=167
19778            CVL025=171
19779            CVL050=174
19780            CVL100=179
19781          ELSEIF(N2.EQ.6)THEN
19782            CVL001=163
19783            CVL005=169
19784            CVL010=172
19785            CVL025=176
19786            CVL050=180
19787            CVL100=185
19788          ELSEIF(N2.EQ.7)THEN
19789            CVL001=167
19790            CVL005=173
19791            CVL010=177
19792            CVL025=182
19793            CVL050=187
19794            CVL100=192
19795          ELSEIF(N2.EQ.8)THEN
19796            CVL001=171
19797            CVL005=178
19798            CVL010=182
19799            CVL025=188
19800            CVL050=193
19801            CVL100=199
19802          ELSEIF(N2.EQ.9)THEN
19803            CVL001=175
19804            CVL005=183
19805            CVL010=187
19806            CVL025=193
19807            CVL050=199
19808            CVL100=206
19809          ELSEIF(N2.EQ.10)THEN
19810            CVL001=179
19811            CVL005=188
19812            CVL010=192
19813            CVL025=199
19814            CVL050=205
19815            CVL100=212
19816          ELSEIF(N2.EQ.11)THEN
19817            CVL001=183
19818            CVL005=193
19819            CVL010=198
19820            CVL025=205
19821            CVL050=211
19822            CVL100=219
19823          ELSEIF(N2.EQ.12)THEN
19824            CVL001=188
19825            CVL005=198
19826            CVL010=203
19827            CVL025=211
19828            CVL050=218
19829            CVL100=226
19830          ELSEIF(N2.EQ.13)THEN
19831            CVL001=192
19832            CVL005=203
19833            CVL010=209
19834            CVL025=217
19835            CVL050=224
19836            CVL100=233
19837          ELSEIF(N2.EQ.14)THEN
19838            CVL001=197
19839            CVL005=208
19840            CVL010=214
19841            CVL025=223
19842            CVL050=231
19843            CVL100=239
19844          ELSEIF(N2.EQ.15)THEN
19845            CVL001=201
19846            CVL005=214
19847            CVL010=220
19848            CVL025=229
19849            CVL050=237
19850            CVL100=246
19851          ELSEIF(N2.EQ.16)THEN
19852            CVL001=206
19853            CVL005=219
19854            CVL010=225
19855            CVL025=235
19856            CVL050=243
19857            CVL100=253
19858          ELSEIF(N2.EQ.17)THEN
19859            CVL001=211
19860            CVL005=224
19861            CVL010=231
19862            CVL025=241
19863            CVL050=250
19864            CVL100=260
19865          ELSEIF(N2.EQ.18)THEN
19866            CVL001=215
19867            CVL005=229
19868            CVL010=236
19869            CVL025=247
19870            CVL050=256
19871            CVL100=267
19872          ELSEIF(N2.EQ.19)THEN
19873            CVL001=220
19874            CVL005=235
19875            CVL010=242
19876            CVL025=253
19877            CVL050=263
19878            CVL100=274
19879          ELSEIF(N2.EQ.20)THEN
19880            CVL001=224
19881            CVL005=240
19882            CVL010=247
19883            CVL025=259
19884            CVL050=269
19885            CVL100=281
19886          ENDIF
19887        ELSEIF(N1.EQ.18)THEN
19888          IF(N2.EQ.2)THEN
19889            CVL001=171
19890            CVL005=171
19891            CVL010=172
19892            CVL025=174
19893            CVL050=176
19894            CVL100=178
19895          ELSEIF(N2.EQ.3)THEN
19896            CVL001=172
19897            CVL005=174
19898            CVL010=176
19899            CVL025=179
19900            CVL050=181
19901            CVL100=185
19902          ELSEIF(N2.EQ.4)THEN
19903            CVL001=175
19904            CVL005=178
19905            CVL010=181
19906            CVL025=184
19907            CVL050=188
19908            CVL100=192
19909          ELSEIF(N2.EQ.5)THEN
19910            CVL001=178
19911            CVL005=183
19912            CVL010=186
19913            CVL025=190
19914            CVL050=194
19915            CVL100=199
19916          ELSEIF(N2.EQ.6)THEN
19917            CVL001=182
19918            CVL005=188
19919            CVL010=191
19920            CVL025=196
19921            CVL050=200
19922            CVL100=206
19923          ELSEIF(N2.EQ.7)THEN
19924            CVL001=186
19925            CVL005=193
19926            CVL010=196
19927            CVL025=202
19928            CVL050=207
19929            CVL100=213
19930          ELSEIF(N2.EQ.8)THEN
19931            CVL001=190
19932            CVL005=198
19933            CVL010=202
19934            CVL025=208
19935            CVL050=213
19936            CVL100=220
19937          ELSEIF(N2.EQ.9)THEN
19938            CVL001=195
19939            CVL005=203
19940            CVL010=208
19941            CVL025=214
19942            CVL050=220
19943            CVL100=227
19944          ELSEIF(N2.EQ.10)THEN
19945            CVL001=199
19946            CVL005=209
19947            CVL010=213
19948            CVL025=220
19949            CVL050=227
19950            CVL100=234
19951          ELSEIF(N2.EQ.11)THEN
19952            CVL001=204
19953            CVL005=214
19954            CVL010=219
19955            CVL025=227
19956            CVL050=233
19957            CVL100=241
19958          ELSEIF(N2.EQ.12)THEN
19959            CVL001=209
19960            CVL005=219
19961            CVL010=225
19962            CVL025=233
19963            CVL050=240
19964            CVL100=249
19965          ELSEIF(N2.EQ.13)THEN
19966            CVL001=214
19967            CVL005=225
19968            CVL010=231
19969            CVL025=239
19970            CVL050=247
19971            CVL100=256
19972          ELSEIF(N2.EQ.14)THEN
19973            CVL001=218
19974            CVL005=230
19975            CVL010=237
19976            CVL025=246
19977            CVL050=254
19978            CVL100=263
19979          ELSEIF(N2.EQ.15)THEN
19980            CVL001=223
19981            CVL005=236
19982            CVL010=242
19983            CVL025=252
19984            CVL050=260
19985            CVL100=270
19986          ELSEIF(N2.EQ.16)THEN
19987            CVL001=228
19988            CVL005=242
19989            CVL010=248
19990            CVL025=258
19991            CVL050=267
19992            CVL100=278
19993          ELSEIF(N2.EQ.17)THEN
19994            CVL001=233
19995            CVL005=247
19996            CVL010=254
19997            CVL025=265
19998            CVL050=274
19999            CVL100=285
20000          ELSEIF(N2.EQ.18)THEN
20001            CVL001=238
20002            CVL005=253
20003            CVL010=260
20004            CVL025=271
20005            CVL050=281
20006            CVL100=292
20007          ELSEIF(N2.EQ.19)THEN
20008            CVL001=243
20009            CVL005=259
20010            CVL010=266
20011            CVL025=278
20012            CVL050=288
20013            CVL100=300
20014          ELSEIF(N2.EQ.20)THEN
20015            CVL001=248
20016            CVL005=264
20017            CVL010=272
20018            CVL025=284
20019            CVL050=295
20020            CVL100=307
20021          ENDIF
20022        ELSEIF(N1.EQ.19)THEN
20023          IF(N2.EQ.2)THEN
20024            CVL001=190
20025            CVL005=191
20026            CVL010=192
20027            CVL025=193
20028            CVL050=195
20029            CVL100=198
20030          ELSEIF(N2.EQ.3)THEN
20031            CVL001=191
20032            CVL005=194
20033            CVL010=195
20034            CVL025=198
20035            CVL050=201
20036            CVL100=205
20037          ELSEIF(N2.EQ.4)THEN
20038            CVL001=194
20039            CVL005=198
20040            CVL010=200
20041            CVL025=204
20042            CVL050=208
20043            CVL100=212
20044          ELSEIF(N2.EQ.5)THEN
20045            CVL001=198
20046            CVL005=203
20047            CVL010=206
20048            CVL025=210
20049            CVL050=214
20050            CVL100=219
20051          ELSEIF(N2.EQ.6)THEN
20052            CVL001=202
20053            CVL005=208
20054            CVL010=211
20055            CVL025=216
20056            CVL050=221
20057            CVL100=227
20058          ELSEIF(N2.EQ.7)THEN
20059            CVL001=206
20060            CVL005=213
20061            CVL010=217
20062            CVL025=223
20063            CVL050=228
20064            CVL100=234
20065          ELSEIF(N2.EQ.8)THEN
20066            CVL001=211
20067            CVL005=219
20068            CVL010=223
20069            CVL025=229
20070            CVL050=235
20071            CVL100=242
20072          ELSEIF(N2.EQ.9)THEN
20073            CVL001=216
20074            CVL005=224
20075            CVL010=229
20076            CVL025=236
20077            CVL050=242
20078            CVL100=249
20079          ELSEIF(N2.EQ.10)THEN
20080            CVL001=220
20081            CVL005=230
20082            CVL010=235
20083            CVL025=243
20084            CVL050=249
20085            CVL100=257
20086          ELSEIF(N2.EQ.11)THEN
20087            CVL001=225
20088            CVL005=236
20089            CVL010=241
20090            CVL025=249
20091            CVL050=256
20092            CVL100=264
20093          ELSEIF(N2.EQ.12)THEN
20094            CVL001=231
20095            CVL005=242
20096            CVL010=247
20097            CVL025=256
20098            CVL050=263
20099            CVL100=272
20100          ELSEIF(N2.EQ.13)THEN
20101            CVL001=236
20102            CVL005=248
20103            CVL010=254
20104            CVL025=263
20105            CVL050=271
20106            CVL100=280
20107          ELSEIF(N2.EQ.14)THEN
20108            CVL001=241
20109            CVL005=254
20110            CVL010=260
20111            CVL025=269
20112            CVL050=278
20113            CVL100=288
20114          ELSEIF(N2.EQ.15)THEN
20115            CVL001=246
20116            CVL005=260
20117            CVL010=266
20118            CVL025=276
20119            CVL050=285
20120            CVL100=295
20121          ELSEIF(N2.EQ.16)THEN
20122            CVL001=251
20123            CVL005=265
20124            CVL010=273
20125            CVL025=283
20126            CVL050=292
20127            CVL100=303
20128          ELSEIF(N2.EQ.17)THEN
20129            CVL001=257
20130            CVL005=272
20131            CVL010=279
20132            CVL025=290
20133            CVL050=300
20134            CVL100=311
20135          ELSEIF(N2.EQ.18)THEN
20136            CVL001=262
20137            CVL005=278
20138            CVL010=285
20139            CVL025=297
20140            CVL050=307
20141            CVL100=319
20142          ELSEIF(N2.EQ.19)THEN
20143            CVL001=268
20144            CVL005=284
20145            CVL010=292
20146            CVL025=304
20147            CVL050=314
20148            CVL100=326
20149          ELSEIF(N2.EQ.20)THEN
20150            CVL001=273
20151            CVL005=290
20152            CVL010=298
20153            CVL025=310
20154            CVL050=321
20155            CVL100=334
20156          ENDIF
20157        ELSEIF(N1.EQ.20)THEN
20158          IF(N2.EQ.2)THEN
20159            CVL001=210
20160            CVL005=211
20161            CVL010=212
20162            CVL025=213
20163            CVL050=215
20164            CVL100=218
20165          ELSEIF(N2.EQ.3)THEN
20166            CVL001=211
20167            CVL005=214
20168            CVL010=216
20169            CVL025=219
20170            CVL050=222
20171            CVL100=226
20172          ELSEIF(N2.EQ.4)THEN
20173            CVL001=214
20174            CVL005=219
20175            CVL010=221
20176            CVL025=225
20177            CVL050=229
20178            CVL100=233
20179          ELSEIF(N2.EQ.5)THEN
20180            CVL001=218
20181            CVL005=224
20182            CVL010=227
20183            CVL025=231
20184            CVL050=236
20185            CVL100=241
20186          ELSEIF(N2.EQ.6)THEN
20187            CVL001=223
20188            CVL005=229
20189            CVL010=233
20190            CVL025=238
20191            CVL050=243
20192            CVL100=249
20193          ELSEIF(N2.EQ.7)THEN
20194            CVL001=227
20195            CVL005=235
20196            CVL010=239
20197            CVL025=245
20198            CVL050=250
20199            CVL100=257
20200          ELSEIF(N2.EQ.8)THEN
20201            CVL001=232
20202            CVL005=241
20203            CVL010=245
20204            CVL025=251
20205            CVL050=258
20206            CVL100=265
20207          ELSEIF(N2.EQ.9)THEN
20208            CVL001=237
20209            CVL005=247
20210            CVL010=251
20211            CVL025=259
20212            CVL050=265
20213            CVL100=273
20214          ELSEIF(N2.EQ.10)THEN
20215            CVL001=243
20216            CVL005=253
20217            CVL010=258
20218            CVL025=266
20219            CVL050=273
20220            CVL100=281
20221          ELSEIF(N2.EQ.11)THEN
20222            CVL001=248
20223            CVL005=259
20224            CVL010=264
20225            CVL025=273
20226            CVL050=280
20227            CVL100=289
20228          ELSEIF(N2.EQ.12)THEN
20229            CVL001=253
20230            CVL005=265
20231            CVL010=271
20232            CVL025=280
20233            CVL050=288
20234            CVL100=293
20235          ELSEIF(N2.EQ.13)THEN
20236            CVL001=259
20237            CVL005=271
20238            CVL010=278
20239            CVL025=287
20240            CVL050=295
20241            CVL100=305
20242          ELSEIF(N2.EQ.14)THEN
20243            CVL001=265
20244            CVL005=278
20245            CVL010=284
20246            CVL025=294
20247            CVL050=303
20248            CVL100=313
20249          ELSEIF(N2.EQ.15)THEN
20250            CVL001=270
20251            CVL005=284
20252            CVL010=291
20253            CVL025=301
20254            CVL050=311
20255            CVL100=321
20256          ELSEIF(N2.EQ.16)THEN
20257            CVL001=276
20258            CVL005=290
20259            CVL010=298
20260            CVL025=309
20261            CVL050=318
20262            CVL100=330
20263          ELSEIF(N2.EQ.17)THEN
20264            CVL001=281
20265            CVL005=297
20266            CVL010=304
20267            CVL025=316
20268            CVL050=326
20269            CVL100=338
20270          ELSEIF(N2.EQ.18)THEN
20271            CVL001=287
20272            CVL005=303
20273            CVL010=311
20274            CVL025=323
20275            CVL050=334
20276            CVL100=346
20277          ELSEIF(N2.EQ.19)THEN
20278            CVL001=293
20279            CVL005=310
20280            CVL010=318
20281            CVL025=330
20282            CVL050=341
20283            CVL100=354
20284          ELSEIF(N2.EQ.20)THEN
20285            CVL001=299
20286            CVL005=316
20287            CVL010=325
20288            CVL025=338
20289            CVL050=349
20290            CVL100=362
20291          ENDIF
20292        ENDIF
20293C
20294        AN1=REAL(N1)
20295        AN2=REAL(N2)
20296        CONST=AN1*(AN1+AN2+1.0)
20297        CVU999=CONST - CVL001
20298        CVU995=CONST - CVL005
20299        CVU990=CONST - CVL010
20300        CVU975=CONST - CVL025
20301        CVU950=CONST - CVL050
20302        CVU900=CONST - CVL100
20303      ENDIF
20304C
20305C               *************************************************
20306C               **   STEP 22--                                 **
20307C               **   WRITE OUT EVERYTHING                      **
20308C               **   FOR A MANN WHITNEY RANK SUM TEST          **
20309C               *************************************************
20310C
20311      ISTEPN='22'
20312      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN2')
20313     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20314C
20315      IF(IPRINT.EQ.'OFF')GOTO9000
20316C
20317      IF(ICASAN.EQ.'LOWE')THEN
20318        ITITLE='Two Sample Lower-Tailed Mann Whitney Rank Sum Test'
20319        NCTITL=50
20320      ELSEIF(ICASAN.EQ.'UPPE')THEN
20321        ITITLE='Two Sample Upper-Tailed Mann Whitney Rank Sum Test'
20322        NCTITL=50
20323      ELSE
20324        ITITLE='Two Sample Two-Sided Mann Whitney Rank Sum Test'
20325        NCTITL=47
20326      ENDIF
20327      ITITLZ='(Conover Formulation)'
20328      NCTITZ=21
20329C
20330      ICNT=1
20331      ITEXT(ICNT)=' '
20332      NCTEXT(ICNT)=0
20333      AVALUE(ICNT)=0.0
20334      IDIGIT(ICNT)=-1
20335C
20336      ICNT=ICNT+1
20337      ITEXT(ICNT)='First Response Variable: '
20338      WRITE(ITEXT(ICNT)(26:29),'(A4)')IVARID(1:4)
20339      WRITE(ITEXT(ICNT)(30:33),'(A4)')IVARI2(1:4)
20340      NCTEXT(ICNT)=33
20341      AVALUE(ICNT)=0.0
20342      IDIGIT(ICNT)=-1
20343      ICNT=ICNT+1
20344      ITEXT(ICNT)='Second Response Variable: '
20345      WRITE(ITEXT(ICNT)(27:30),'(A4)')IVARI3(1:4)
20346      WRITE(ITEXT(ICNT)(31:34),'(A4)')IVARI4(1:4)
20347      NCTEXT(ICNT)=34
20348      AVALUE(ICNT)=0.0
20349      IDIGIT(ICNT)=-1
20350C
20351      ICNT=ICNT+1
20352      ITEXT(ICNT)=' '
20353      NCTEXT(ICNT)=1
20354      AVALUE(ICNT)=0.0
20355      IDIGIT(ICNT)=-1
20356C
20357      ICNT=ICNT+1
20358      ITEXT(ICNT)='H0: F(x) = G(x)   for all x'
20359      NCTEXT(ICNT)=27
20360      AVALUE(ICNT)=0.0
20361      IDIGIT(ICNT)=-1
20362      ICNT=ICNT+1
20363      ITEXT(ICNT)='Ha: F(x) <> G(x)  for some x'
20364      NCTEXT(ICNT)=28
20365      AVALUE(ICNT)=0.0
20366      IDIGIT(ICNT)=-1
20367C
20368      ICNT=ICNT+1
20369      ITEXT(ICNT)=' '
20370      NCTEXT(ICNT)=1
20371      AVALUE(ICNT)=0.0
20372      IDIGIT(ICNT)=-1
20373      ICNT=ICNT+1
20374      ITEXT(ICNT)='Summary Statistics:'
20375      NCTEXT(ICNT)=19
20376      AVALUE(ICNT)=0.0
20377      IDIGIT(ICNT)=-1
20378      ICNT=ICNT+1
20379      ITEXT(ICNT)='Number of Observations for Sample 1:'
20380      NCTEXT(ICNT)=36
20381      AVALUE(ICNT)=REAL(N1)
20382      IDIGIT(ICNT)=0
20383      ICNT=ICNT+1
20384      ITEXT(ICNT)='Mean for Sample 1:'
20385      NCTEXT(ICNT)=18
20386      AVALUE(ICNT)=YMEAN1
20387      IDIGIT(ICNT)=NUMDIG
20388      ICNT=ICNT+1
20389      ITEXT(ICNT)='Median for Sample 1:'
20390      NCTEXT(ICNT)=20
20391      AVALUE(ICNT)=YMED1
20392      IDIGIT(ICNT)=NUMDIG
20393      ICNT=ICNT+1
20394      ITEXT(ICNT)='Number of Observations for Sample 2:'
20395      NCTEXT(ICNT)=36
20396      AVALUE(ICNT)=REAL(N2)
20397      IDIGIT(ICNT)=0
20398      ICNT=ICNT+1
20399      ITEXT(ICNT)='Mean for Sample 2:'
20400      NCTEXT(ICNT)=18
20401      AVALUE(ICNT)=YMEAN2
20402      IDIGIT(ICNT)=NUMDIG
20403      ICNT=ICNT+1
20404      ITEXT(ICNT)='Median for Sample 2:'
20405      NCTEXT(ICNT)=20
20406      AVALUE(ICNT)=YMED2
20407      IDIGIT(ICNT)=NUMDIG
20408      ICNT=ICNT+1
20409      ITEXT(ICNT)='Number of Tied Ranks:'
20410      NCTEXT(ICNT)=21
20411      AVALUE(ICNT)=REAL(NTIES)
20412      IDIGIT(ICNT)=0
20413      ICNT=ICNT+1
20414      ITEXT(ICNT)=' '
20415      NCTEXT(ICNT)=1
20416      AVALUE(ICNT)=0.0
20417      IDIGIT(ICNT)=-1
20418C
20419      IF(ITAB.EQ.1)THEN
20420        ICNT=ICNT+1
20421        ITEXT(ICNT)='Test (Small Sample, No Ties, Exact):'
20422        NCTEXT(ICNT)=38
20423        AVALUE(ICNT)=0.0
20424        IDIGIT(ICNT)=-1
20425      ELSE
20426        ICNT=ICNT+1
20427        ITEXT(ICNT)='Test (Normal Approximation):'
20428        NCTEXT(ICNT)=30
20429        AVALUE(ICNT)=0.0
20430        IDIGIT(ICNT)=-1
20431      ENDIF
20432C
20433      ICNT=ICNT+1
20434      ITEXT(ICNT)='Test Statistic Value (W):'
20435      NCTEXT(ICNT)=25
20436      AVALUE(ICNT)=STATVA
20437      IDIGIT(ICNT)=NUMDIG
20438      ICNT=ICNT+1
20439      ITEXT(ICNT)='CDF Value:'
20440      NCTEXT(ICNT)=10
20441      AVALUE(ICNT)=STATCD
20442      IDIGIT(ICNT)=NUMDIG
20443      ICNT=ICNT+1
20444      ITEXT(ICNT)='P-Value (2-tailed test):'
20445      NCTEXT(ICNT)=24
20446      AVALUE(ICNT)=PVAL2T
20447      IDIGIT(ICNT)=NUMDIG
20448      ICNT=ICNT+1
20449      ITEXT(ICNT)='P-Value (lower-tailed test):'
20450      NCTEXT(ICNT)=28
20451      AVALUE(ICNT)=PVALLT
20452      IDIGIT(ICNT)=NUMDIG
20453      ICNT=ICNT+1
20454      ITEXT(ICNT)='P-Value (upper-tailed test):'
20455      NCTEXT(ICNT)=28
20456      AVALUE(ICNT)=PVALUT
20457      IDIGIT(ICNT)=NUMDIG
20458C
20459      NUMROW=ICNT
20460      DO2110I=1,NUMROW
20461        NTOT(I)=15
20462 2110 CONTINUE
20463C
20464      IFRST=.TRUE.
20465      ILAST=.TRUE.
20466C
20467      ISTEPN='21A'
20468      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN2')
20469     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20470C
20471      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
20472     1            AVALUE,IDIGIT,
20473     1            NTOT,NUMROW,
20474     1            ICAPSW,ICAPTY,ILAST,IFRST,
20475     1            ISUBRO,IBUGA3,IERROR)
20476C
20477      ISTEPN='21B'
20478      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN2')
20479     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20480C
20481      IF(ITAB.EQ.0)THEN
20482        ITITLE='Two-Tailed Test: Normal Approximation'
20483        NCTITL=37
20484      ELSE
20485        ITITLE='Two-Tailed Test: Exact - Small Sample, No Ties'
20486        NCTITL=46
20487      ENDIF
20488      ITITL9='H0: F(x) = G(x); Ha: F(x) <> G(x)  for some x'
20489      NCTIT9=45
20490C
20491      DO2130J=1,NUMCLI
20492        DO2140I=1,MAXLIN
20493          ITITL2(I,J)=' '
20494          NCTIT2(I,J)=0
20495 2140   CONTINUE
20496 2130 CONTINUE
20497C
20498      IF(ITAB.EQ.0)THEN
20499        NUMCOL=4
20500        ITITL2(2,1)='Significance'
20501        NCTIT2(2,1)=12
20502        ITITL2(3,1)='Level'
20503        NCTIT2(3,1)=5
20504C
20505        ITITL2(2,2)='Test '
20506        NCTIT2(2,2)=4
20507        ITITL2(3,2)='Statistic'
20508        NCTIT2(3,2)=9
20509C
20510        ITITL2(2,3)='Critical'
20511        NCTIT2(2,3)=8
20512        ITITL2(3,3)='Value (+/-)'
20513        NCTIT2(3,3)=11
20514C
20515        ITITL2(1,4)='Null'
20516        NCTIT2(1,4)=4
20517        ITITL2(2,4)='Hypothesis'
20518        NCTIT2(2,4)=10
20519        ITITL2(3,4)='Conclusion'
20520        NCTIT2(3,4)=10
20521C
20522      ELSE
20523        NUMCOL=5
20524        ITITL2(2,1)='Significance'
20525        NCTIT2(2,1)=12
20526        ITITL2(3,1)='Level'
20527        NCTIT2(3,1)=5
20528C
20529        ITITL2(2,2)='Test '
20530        NCTIT2(2,2)=4
20531        ITITL2(3,2)='Statistic'
20532        NCTIT2(3,2)=9
20533C
20534        ITITL2(1,3)='Lower'
20535        NCTIT2(1,3)=5
20536        ITITL2(2,3)='Critical'
20537        NCTIT2(2,3)=8
20538        ITITL2(3,3)='Value (<)'
20539        NCTIT2(3,3)=9
20540C
20541        ITITL2(1,4)='Upper'
20542        NCTIT2(1,4)=5
20543        ITITL2(2,4)='Critical'
20544        NCTIT2(2,4)=8
20545        ITITL2(3,4)='Value (>)'
20546        NCTIT2(3,4)=9
20547C
20548        ITITL2(1,5)='Null'
20549        NCTIT2(1,5)=4
20550        ITITL2(2,5)='Hypothesis'
20551        NCTIT2(2,5)=10
20552        ITITL2(3,5)='Conclusion'
20553        NCTIT2(3,5)=10
20554C
20555      ENDIF
20556C
20557      NMAX=0
20558      DO2150I=1,NUMCOL
20559        VALIGN(I)='b'
20560        ALIGN(I)='r'
20561        NTOT(I)=15
20562        NMAX=NMAX+NTOT(I)
20563        ITYPCO(I)='NUME'
20564        IDIGIT(I)=NUMDIG
20565        IF(ITAB.EQ.0)THEN
20566          IF(I.EQ.1 .OR. I.EQ.4)THEN
20567            ITYPCO(I)='ALPH'
20568          ENDIF
20569        ELSE
20570          IF(I.EQ.1 .OR. I.EQ.5)THEN
20571            ITYPCO(I)='ALPH'
20572          ENDIF
20573        ENDIF
20574 2150 CONTINUE
20575C
20576      IWHTML(1)=125
20577      IWHTML(2)=175
20578      IWHTML(3)=175
20579      IWHTML(4)=175
20580      IWHTML(5)=175
20581      IINC=1800
20582      IINC2=1400
20583      IWRTF(1)=IINC
20584      IWRTF(2)=IWRTF(1)+IINC
20585      IWRTF(3)=IWRTF(2)+IINC
20586      IWRTF(4)=IWRTF(3)+IINC
20587      IWRTF(5)=IWRTF(4)+IINC
20588C
20589      IF(ITAB.EQ.0)THEN
20590        ICNT=NUMAL2
20591        DO2160J=1,NUMAL2
20592C
20593          AMAT(J,2)=STATVA
20594          ALPHAT=ALPHA2(J)
20595          ATEMP=(1.0 - ALPHAT)/2.0
20596          ATEMP=1.0 - ATEMP
20597          CALL NORPPF(ATEMP,CUTTMP)
20598          AMAT(J,3)=CUTTMP
20599          IVALUE(J,4)(1:6)='REJECT'
20600          IF(ABS(STATVA).LT.AMAT(J,3))THEN
20601            IVALUE(J,4)(1:6)='ACCEPT'
20602          ENDIF
20603          NCVALU(J,4)=6
20604C
20605          WRITE(IVALUE(J,1)(1:4),'(F4.1)')100.0*ALPHAT
20606          IVALUE(J,1)(5:5)='%'
20607          NCVALU(J,1)=5
20608 2160   CONTINUE
20609      ELSE
20610        ICNT=NUMAL2
20611        DO3160J=1,ICNT
20612C
20613          AMAT(J,2)=STATVA
20614          ALPHAT=ALPHA2(J)
20615          IF(J.EQ.1)THEN
20616            AMAT(J,3)=CVL100
20617            AMAT(J,4)=CVU900
20618          ELSEIF(J.EQ.2)THEN
20619            AMAT(J,3)=CVL050
20620            AMAT(J,4)=CVU950
20621          ELSEIF(J.EQ.3)THEN
20622            AMAT(J,3)=CVL025
20623            AMAT(J,4)=CVU975
20624          ELSEIF(J.EQ.4)THEN
20625            AMAT(J,3)=CVL005
20626            AMAT(J,4)=CVU995
20627          ENDIF
20628          IVALUE(J,5)(1:6)='ACCEPT'
20629          IF(STATVA.LT.AMAT(J,3))THEN
20630            IVALUE(J,5)(1:6)='REJECT'
20631          ELSEIF(STATVA.GT.AMAT(J,4))THEN
20632            IVALUE(J,5)(1:6)='REJECT'
20633          ENDIF
20634          NCVALU(J,5)=6
20635C
20636          WRITE(IVALUE(J,1)(1:4),'(F4.1)')100.0*ALPHAT
20637          IVALUE(J,1)(5:5)='%'
20638          NCVALU(J,1)=5
20639 3160   CONTINUE
20640      ENDIF
20641C
20642      NUMLIN=3
20643      IFRST=.TRUE.
20644      ILAST=.TRUE.
20645      IFLAGS=.TRUE.
20646      IFLAGE=.TRUE.
20647C
20648      IF(ICASAN.EQ.'TWOT')THEN
20649        CALL DPDTA5(ITITLE,NCTITL,
20650     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
20651     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
20652     1              IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
20653     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
20654     1              ICAPSW,ICAPTY,IFRST,ILAST,
20655     1              IFLAGS,IFLAGE,
20656     1              ISUBRO,IBUGA3,IERROR)
20657      ENDIF
20658C
20659      IF(ICASAN.EQ.'LOWE')THEN
20660C
20661        IF(ITAB.EQ.0)THEN
20662          ITITLE='Lower-Tailed Test: Normal Approximation'
20663          NCTITL=39
20664        ELSE
20665          ITITLE='Lower-Tailed Test: Exact - Small Sample, No Ties'
20666          NCTITL=48
20667        ENDIF
20668        ITITL9='H0: F(x) = G(x); Ha: F(x) < G(x)  for some x'
20669        NCTIT9=44
20670C
20671        IF(ITAB.EQ.0)THEN
20672          ITITL2(2,3)='Critical'
20673          NCTIT2(2,3)=8
20674          ITITL2(3,3)='Value (<)'
20675          NCTIT2(3,3)=9
20676          NUMCOL=4
20677        ELSE
20678          NUMCOL=4
20679          ITITL2(1,3)='Lower'
20680          NCTIT2(1,3)=5
20681          ITITL2(2,3)='Critical'
20682          NCTIT2(2,3)=8
20683          ITITL2(3,3)='Value (<)'
20684          NCTIT2(3,3)=9
20685C
20686          ITITL2(1,4)='Null'
20687          NCTIT2(1,4)=4
20688          ITITL2(2,4)='Hypothesis'
20689          NCTIT2(2,4)=10
20690          ITITL2(3,4)='Conclusion'
20691          NCTIT2(3,4)=10
20692        ENDIF
20693C
20694        NMAX=0
20695        DO2250I=1,NUMCOL
20696          NTOT(I)=15
20697          NMAX=NMAX+NTOT(I)
20698 2250   CONTINUE
20699C
20700        IF(ITAB.EQ.0)THEN
20701          ICNT=NUMALP
20702          DO2260J=1,NUMALP
20703C
20704            AMAT(J,2)=STATVA
20705            ALPHAT=ALPHA(J)
20706            ATEMP=(1.0 - ALPHAT)
20707            CALL NORPPF(ATEMP,CUTTMP)
20708            AMAT(J,3)=CUTTMP
20709            IVALUE(J,4)(1:6)='ACCEPT'
20710            IF(ABS(STATVA).LT.AMAT(J,3))THEN
20711              IVALUE(J,4)(1:6)='REJECT'
20712            ENDIF
20713            NCVALU(J,4)=6
20714            WRITE(IVALUE(J,1)(1:4),'(F4.1)')100.0*ALPHAT
20715            IVALUE(J,1)(5:5)='%'
20716            NCVALU(J,1)=5
20717 2260     CONTINUE
20718        ELSE
20719          ICNT=NUMALP
20720          DO3260J=1,ICNT
20721C
20722            AMAT(J,2)=STATVA
20723            ALPHAT=ALPHA(J)
20724            IF(J.EQ.1)THEN
20725              AMAT(J,3)=CVL100
20726            ELSEIF(J.EQ.2)THEN
20727              AMAT(J,3)=CVL050
20728            ELSEIF(J.EQ.3)THEN
20729              AMAT(J,3)=CVL025
20730            ELSEIF(J.EQ.4)THEN
20731              AMAT(J,3)=CVL010
20732            ELSEIF(J.EQ.5)THEN
20733              AMAT(J,3)=CVL005
20734            ELSEIF(J.EQ.6)THEN
20735              AMAT(J,3)=CVL001
20736            ENDIF
20737            IVALUE(J,4)(1:6)='ACCEPT'
20738            IF(STATVA.LT.AMAT(J,3))THEN
20739              IVALUE(J,5)(1:6)='REJECT'
20740            ENDIF
20741            NCVALU(J,4)=6
20742C
20743            WRITE(IVALUE(J,1)(1:4),'(F4.1)')100.0*ALPHAT
20744            IVALUE(J,1)(5:5)='%'
20745            NCVALU(J,1)=5
20746 3260     CONTINUE
20747        ENDIF
20748C
20749        NUMLIN=3
20750        IFRST=.TRUE.
20751        ILAST=.TRUE.
20752        IFLAGS=.TRUE.
20753        IFLAGE=.TRUE.
20754        CALL DPDTA5(ITITLE,NCTITL,
20755     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
20756     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
20757     1              IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
20758     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
20759     1              ICAPSW,ICAPTY,IFRST,ILAST,
20760     1              IFLAGS,IFLAGE,
20761     1              ISUBRO,IBUGA3,IERROR)
20762      ENDIF
20763C
20764      IF(ICASAN.EQ.'UPPE')THEN
20765C
20766        IF(ITAB.EQ.0)THEN
20767          ITITLE='Upper-Tailed Test: Normal Approximation'
20768          NCTITL=39
20769        ELSE
20770          ITITLE='Upper-Tailed Test: Exact - Small Sample, No Ties'
20771          NCTITL=48
20772        ENDIF
20773        ITITL9='H0: F(x) = G(x); Ha: F(x) > G(x)  for some x'
20774        NCTIT9=44
20775C
20776        IF(ITAB.EQ.0)THEN
20777          ITITL2(2,3)='Critical'
20778          NCTIT2(2,3)=8
20779          ITITL2(3,3)='Value (>)'
20780          NCTIT2(3,3)=9
20781          NUMCOL=4
20782        ELSE
20783          NUMCOL=4
20784          ITITL2(1,3)='Upper'
20785          NCTIT2(1,3)=5
20786          ITITL2(2,3)='Critical'
20787          NCTIT2(2,3)=8
20788          ITITL2(3,3)='Value (>)'
20789          NCTIT2(3,3)=9
20790C
20791          ITITL2(1,4)='Null'
20792          NCTIT2(1,4)=4
20793          ITITL2(2,4)='Hypothesis'
20794          NCTIT2(2,4)=10
20795          ITITL2(3,4)='Conclusion'
20796          NCTIT2(3,4)=10
20797        ENDIF
20798C
20799        NMAX=0
20800        DO2350I=1,NUMCOL
20801          NTOT(I)=15
20802          NMAX=NMAX+NTOT(I)
20803 2350   CONTINUE
20804C
20805        IF(ITAB.EQ.0)THEN
20806          ICNT=NUMALP
20807          DO2360J=1,NUMALP
20808C
20809            AMAT(J,2)=STATVA
20810            ALPHAT=ALPHA(J)
20811            ATEMP=ALPHAT
20812            CALL NORPPF(ATEMP,CUTTMP)
20813            AMAT(J,3)=CUTTMP
20814            IVALUE(J,4)(1:6)='ACCEPT'
20815            IF(ABS(STATVA).GT.AMAT(J,3))THEN
20816              IVALUE(J,4)(1:6)='REJECT'
20817            ENDIF
20818            NCVALU(J,4)=6
20819            WRITE(IVALUE(J,1)(1:4),'(F4.1)')100.0*ALPHAT
20820            IVALUE(J,1)(5:5)='%'
20821            NCVALU(J,1)=5
20822 2360     CONTINUE
20823        ELSE
20824          ICNT=NUMALP
20825          DO3360J=1,ICNT
20826C
20827            AMAT(J,2)=STATVA
20828            ALPHAT=ALPHA(J)
20829            IF(J.EQ.1)THEN
20830              AMAT(J,3)=CVL900
20831            ELSEIF(J.EQ.2)THEN
20832              AMAT(J,3)=CVL950
20833            ELSEIF(J.EQ.3)THEN
20834              AMAT(J,3)=CVL975
20835            ELSEIF(J.EQ.4)THEN
20836              AMAT(J,3)=CVL990
20837            ELSEIF(J.EQ.5)THEN
20838              AMAT(J,3)=CVL995
20839            ELSEIF(J.EQ.6)THEN
20840              AMAT(J,3)=CVL999
20841            ENDIF
20842            IVALUE(J,4)(1:6)='ACCEPT'
20843            IF(STATVA.GT.AMAT(J,3))THEN
20844              IVALUE(J,5)(1:6)='REJECT'
20845            ENDIF
20846            NCVALU(J,4)=6
20847C
20848            WRITE(IVALUE(J,1)(1:4),'(F4.1)')100.0*ALPHAT
20849            IVALUE(J,1)(5:5)='%'
20850            NCVALU(J,1)=5
20851 3360     CONTINUE
20852        ENDIF
20853C
20854        NUMLIN=3
20855        IFRST=.TRUE.
20856        ILAST=.TRUE.
20857        IFLAGS=.TRUE.
20858        IFLAGE=.TRUE.
20859        CALL DPDTA5(ITITLE,NCTITL,
20860     1              ITITL9,NCTIT9,ITITL2,NCTIT2,
20861     1              MAXLIN,NUMLIN,NUMCLI,NUMCOL,
20862     1              IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
20863     1              IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
20864     1              ICAPSW,ICAPTY,IFRST,ILAST,
20865     1              IFLAGS,IFLAGE,
20866     1              ISUBRO,IBUGA3,IERROR)
20867      ENDIF
20868C               *****************
20869C               **  STEP 90--  **
20870C               **  EXIT       **
20871C               *****************
20872C
20873 9000 CONTINUE
20874      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MNN2')THEN
20875        WRITE(ICOUT,999)
20876        CALL DPWRST('XXX','WRIT')
20877        WRITE(ICOUT,9011)
20878 9011   FORMAT('***** AT THE END       OF DPMNN2--')
20879        CALL DPWRST('XXX','WRIT')
20880        WRITE(ICOUT,9013)STATVA,STATV2,STATCD,PVAL2T,PVALLT,PVALUT
20881 9013   FORMAT('STATVA,STATV2,STATCD,PVAL2T,PVALLT,PVALUT = ',6G15.7)
20882        CALL DPWRST('XXX','WRIT')
20883      ENDIF
20884C
20885      RETURN
20886      END
20887      SUBROUTINE DPMNN3(Y1,N1,Y2,N2,
20888     1                  TEMP1,TEMP2,YRANK,MAXNXT,
20889     1                  STATVA,STATV1,STATV2,STATV3,STATCD,NTIES,
20890     1                  PVAL2T,PVALLT,PVALUT,
20891     1                  IBUGA3,ISUBRO,IERROR)
20892C
20893C     PURPOSE--THIS ROUTINE COMPUTES THE MANN-WHITNEY 2-SAMPLE RANK
20894C              SUM TEST STATISTIC AND ASSOCIATED CDF AND P-VALUES.
20895C
20896C              THIS PART IS EXTRACTED FROM DPMNN2 IN ORDER TO
20897C              ALLOW IT TO BE COMPUTED FROM THE "STATISTICS" ROUTINES
20898C              (E.G., STATISTIC PLOT, BOOTSTRAP).
20899C
20900C     EXAMPLE--MANN WHITNEY RANK SUM TEST Y1 Y2
20901C              SAMPLE 1 IS IN INPUT VECTOR Y1 (WITH N1 OBSERVATIONS)
20902C              SAMPLE 2 IS IN INPUT VECTOR Y2 (WITH N2 OBSERVATIONS).
20903C     REFERENCE--CONOVER (1999), "PRACTICAL NONPARAMETRIC STATISTICS",
20904C                THIRD EDITION, WILEY, PP. 272 - 281.
20905C              --WALPOLE AND MEYERS (19xx), "ENGINEERING STATISTICS",
20906C                XX, PP. XX.
20907C     WRITTEN BY--ALAN HECKERT
20908C                 STATISTICAL ENGINEERING DIVISION
20909C                 INFORMATION TECHNOLOGY LABORATORY
20910C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20911C                 GAITHERSBURG, MD 20899-8980
20912C                 PHONE--301-975-2855
20913C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20914C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20915C     LANGUAGE--ANSI FORTRAN (1977)
20916C     VERSION NUMBER--2011/5
20917C     ORIGINAL VERSION--MAY       2011. EXTRACTED FROM DPMNN2
20918C
20919C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
20920C
20921      CHARACTER*4 IBUGA3
20922      CHARACTER*4 ISUBRO
20923      CHARACTER*4 IERROR
20924C
20925      CHARACTER*4 IWRITE
20926      CHARACTER*4 ISUBN1
20927      CHARACTER*4 ISUBN2
20928      CHARACTER*4 ISTEPN
20929C
20930C---------------------------------------------------------------------
20931C
20932      DIMENSION Y1(*)
20933      DIMENSION Y2(*)
20934      DIMENSION TEMP1(*)
20935      DIMENSION TEMP2(*)
20936      DIMENSION YRANK(*)
20937C
20938C---------------------------------------------------------------------
20939C
20940      INCLUDE 'DPCOP2.INC'
20941C
20942C-----START POINT-----------------------------------------------------
20943C
20944      ISUBN1='DPMN'
20945      ISUBN2='N3  '
20946      IERROR='NO'
20947      IWRITE='OFF'
20948C
20949      STATVA=CPUMIN
20950      STATV1=CPUMIN
20951      STATV2=CPUMIN
20952      STATV3=CPUMIN
20953      STATCD=CPUMIN
20954      PVAL2T=CPUMIN
20955      PVALLT=CPUMIN
20956      PVALUT=CPUMIN
20957C
20958      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN3')THEN
20959        WRITE(ICOUT,999)
20960  999   FORMAT(1X)
20961        CALL DPWRST('XXX','WRIT')
20962        WRITE(ICOUT,51)
20963   51   FORMAT('**** AT THE BEGINNING OF DPMNN3--')
20964        CALL DPWRST('XXX','WRIT')
20965        WRITE(ICOUT,52)IBUGA3,ISUBRO,N1,N2
20966   52   FORMAT('IBUGA3,ISUBRO,N1,N2 = ',2(A4,2X),2I8)
20967        CALL DPWRST('XXX','WRIT')
20968        DO56I=1,MAX(N1,N2)
20969          WRITE(ICOUT,57)I,Y1(I),Y2(I)
20970   57     FORMAT('I,Y1(I),Y2(I) = ',I8,2G15.7)
20971          CALL DPWRST('XXX','WRIT')
20972   56   CONTINUE
20973      ENDIF
20974C
20975C               ********************************************
20976C               **  STEP 01--                             **
20977C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
20978C               ********************************************
20979C
20980      ISTEPN='01'
20981      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN3')
20982     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
20983C
20984      IF(N1.LE.1)THEN
20985        WRITE(ICOUT,999)
20986        CALL DPWRST('XXX','BUG ')
20987        WRITE(ICOUT,101)
20988  101   FORMAT('***** ERROR IN MANN-WHITNEY RANK SUM TEST--')
20989        CALL DPWRST('XXX','BUG ')
20990        WRITE(ICOUT,112)
20991  112   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR THE ',
20992     1         'FIRST RESPONSE')
20993        CALL DPWRST('XXX','BUG ')
20994        WRITE(ICOUT,113)
20995  113   FORMAT('      VARIABLE MUST BE 2 OR LARGER.  SUCH WAS NOT THE ',
20996     1         'CASE HERE.')
20997        CALL DPWRST('XXX','BUG ')
20998        WRITE(ICOUT,117)N1
20999  117   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS   = ',I8,'.')
21000        CALL DPWRST('XXX','BUG ')
21001        IERROR='YES'
21002        GOTO9000
21003      ENDIF
21004C
21005      IF(N2.LE.1)THEN
21006        WRITE(ICOUT,999)
21007        CALL DPWRST('XXX','BUG ')
21008        WRITE(ICOUT,101)
21009        CALL DPWRST('XXX','BUG ')
21010        WRITE(ICOUT,122)
21011  122   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR THE ',
21012     1         'SECOND RESPONSE')
21013        CALL DPWRST('XXX','BUG ')
21014        WRITE(ICOUT,113)
21015        CALL DPWRST('XXX','BUG ')
21016        WRITE(ICOUT,117)N2
21017        CALL DPWRST('XXX','BUG ')
21018        IERROR='YES'
21019        GOTO9000
21020      ENDIF
21021C
21022      HOLD=Y1(1)
21023      DO135I=2,N1
21024        IF(Y1(I).NE.HOLD)GOTO139
21025  135 CONTINUE
21026      WRITE(ICOUT,999)
21027      CALL DPWRST('XXX','WRIT')
21028      WRITE(ICOUT,101)
21029      CALL DPWRST('XXX','WRIT')
21030      WRITE(ICOUT,131)HOLD
21031  131 FORMAT('      THE FIRST RESPONSE VARIABLE HAS ALL ELEMENTS = ',
21032     1       G15.7)
21033      CALL DPWRST('XXX','WRIT')
21034      IERROR='YES'
21035      GOTO9000
21036  139 CONTINUE
21037C
21038      HOLD=Y2(1)
21039      DO145I=2,N1
21040        IF(Y2(I).NE.HOLD)GOTO149
21041  145 CONTINUE
21042      WRITE(ICOUT,999)
21043      CALL DPWRST('XXX','WRIT')
21044      WRITE(ICOUT,101)
21045      CALL DPWRST('XXX','WRIT')
21046      WRITE(ICOUT,141)HOLD
21047  141 FORMAT('      THE SECOND RESPONSE VARIABLE HAS ALL ELEMENTS = ',
21048     1       G15.7)
21049      CALL DPWRST('XXX','WRIT')
21050      IERROR='YES'
21051      GOTO9000
21052  149 CONTINUE
21053C
21054C               ************************************
21055C               **   STEP 11--                    **
21056C               **   COMPUTE RANK SUM TEST.       **
21057C               ************************************
21058C
21059      ISTEPN='11'
21060      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN3')
21061     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21062C
21063      DO1100I=1,N1
21064        TEMP1(I)=Y1(I)
21065 1100 CONTINUE
21066      NTOT=N1
21067      DO1110I=1,N2
21068        NTOT=NTOT+1
21069        TEMP1(NTOT)=Y2(I)
21070 1110 CONTINUE
21071      CALL RANK(TEMP1,NTOT,IWRITE,YRANK,TEMP2,MAXNXT,IBUGA3,IERROR)
21072C
21073C     THE COMPUTED TEST STATISTIC DEPENDS ON WHETHER OR NOT THERE ARE
21074C     NO TIES IN THE RANKS.
21075C
21076C        1) CASE WHERE THERE ARE NO TIES:
21077C
21078C               T = SUM[i=1 to N1][R(Y1(i))]
21079C
21080C            WHERE R() IS THE RANK FROM THE COMBINED SAMPLE
21081C
21082C        2) CASE WHERE THERE ARE MANY TIES IN THE DATA:
21083C
21084C               T1 = (T - N1*(N1+N2+1)/2)/
21085C                    SQRT((N1*N2/((N1+N2)*N1+N2-1))*SUM[i=1 to N1+N2][R(i)**2] -
21086C                    (N1*N2*(N1+N2+1)**2/(4*(N1+N2-1))
21087C
21088C     SO CHECK FOR NUMBER OF TIED RANKS.  BASICALLY, IF THE RANK IS
21089C     A NON-INTEGER VALUE, THIS IMPLIES THAT IT IS A TIED RANK.
21090C
21091      ISTEPN='12'
21092      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN3')
21093     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21094C
21095      NTIES=0
21096      RSUM=0.0
21097      DO1210I=1,NTOT
21098        ARANK=YRANK(I)
21099        RSUM=RSUM + ARANK**2
21100        ITEMP=INT(ARANK)
21101        ATEMP=ARANK - REAL(ITEMP)
21102        IF(ABS(ATEMP).GE.0.1)THEN
21103          NTIES=NTIES+1
21104        ENDIF
21105 1210 CONTINUE
21106C
21107      T=0.0
21108      DO1230I=1,N1
21109        T=T+YRANK(I)
21110 1230 CONTINUE
21111      STATV1=T
21112      AN1=REAL(N1)
21113      AN2=REAL(N2)
21114      AN=REAL(N1 + N2)
21115      C1=AN1*(AN+1.0)/2.0
21116      C2=AN1*AN2/(AN*(AN-1.0))
21117      C3=AN1*AN2*(AN+1.0)**2/(4.0*(AN-1.0))
21118      T1=(T - C1)/SQRT(C2*RSUM - C3)
21119      STATV2=T1
21120      STATV3=AN1*AN2 + 0.5*AN1*(AN1 + 1.0) - T
21121C
21122      IF(NTIES.EQ.0 .AND. N1.LE.20 .AND. N2.LE.20)THEN
21123        STATVA=STATV1
21124        TP=AN1*(AN + 1.0)*T
21125        TVAL=MIN(T,TP)
21126        ANUM=TVAL + 0.5 -AN1*(AN+1.0)/2.0
21127        ADEN=SQRT(AN1*AN2*(AN+1.0)/12.0)
21128        AVAL=ANUM/ADEN
21129        CALL NORCDF(AVAL,CDF)
21130        PVAL2T=2.0*CDF
21131        ANUM=T + 0.5 -AN1*(AN+1.0)/2.0
21132        ADEN=SQRT(AN1*AN2*(AN+1.0)/12.0)
21133        AVAL=ANUM/ADEN
21134        CALL NORCDF(AVAL,CDF)
21135        PVALLT=CDF
21136        ANUM=TP + 0.5 -AN1*(AN+1.0)/2.0
21137        ADEN=SQRT(AN1*AN2*(AN+1.0)/12.0)
21138        AVAL=ANUM/ADEN
21139        CALL NORCDF(AVAL,CDF)
21140        PVALUT=CDF
21141        STATCD=PVALLT
21142      ELSE
21143        STATVA=STATV2
21144        CALL NORCDF(T1,VAL1)
21145        VAL2=1.0 - VAL1
21146        VAL=MIN(VAL1,VAL2)
21147        PVAL2T=2.0*VAL
21148        PVALLT=VAL1
21149        PVALUT=VAL2
21150        STATCD=VAL1
21151      ENDIF
21152C
21153C               *****************
21154C               **  STEP 90--  **
21155C               **  EXIT       **
21156C               *****************
21157C
21158 9000 CONTINUE
21159      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MNN3')THEN
21160        WRITE(ICOUT,999)
21161        CALL DPWRST('XXX','WRIT')
21162        WRITE(ICOUT,9011)
21163 9011   FORMAT('***** AT THE END       OF DPMNN3--')
21164        CALL DPWRST('XXX','WRIT')
21165        WRITE(ICOUT,9013)STATVA,STATV1,STATV2,STATV3,STATCD
21166 9013   FORMAT('STATVA,STATV1,STATV2,STATV3,STATCD = ',5G15.7)
21167        CALL DPWRST('XXX','WRIT')
21168        WRITE(ICOUT,9014)PVALLT,PVALUT,PVAL2T
21169 9014   FORMAT('PVALLT,PVALUT,PVAL2T = ',3G15.7)
21170        CALL DPWRST('XXX','WRIT')
21171        WRITE(ICOUT,9015)NTIES,RSUM,C1,C2,C3
21172 9015   FORMAT('NTIES,RSUM,C1,C2,C3 = ',I8,4G15.7)
21173        CALL DPWRST('XXX','WRIT')
21174      ENDIF
21175C
21176      RETURN
21177      END
21178      SUBROUTINE DPMNN5(ICASAN,
21179     1                  STATVA,STATCD,
21180     1                  PVAL2T,PVALLT,PVALUT,
21181     1                  CTL001,CTL005,CTL010,CTL025,CTL050,CTL100,
21182     1                  CTU999,CTU995,CTU990,CTU975,CTU950,CTU900,
21183     1                  IFLAGU,IFRST,ILAST,
21184     1                  IBUGA2,IBUGA3,ISUBRO,IERROR)
21185C
21186C     PURPOSE--UTILITY ROUTINE USED BY DPMANN TO UPDATE VARIOUS
21187C              INTERNAL PARAMETERS AFTER A MANN WHITNEY RANK SUM TEST.
21188C
21189C     WRITTEN BY--ALAN HECKERT
21190C                 STATISTICAL ENGINEERING DIVISION
21191C                 INFORMATION TECHNOLOGY LABORAOTRY
21192C                 NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY
21193C                 GAITHERSBURG, MD 20899-8980
21194C                 PHONE--301-975-2899
21195C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21196C           OF THE NATIONAL INSTITUTE OF STANDARDS OF TECHNOLOGY.
21197C     LANGUAGE--ANSI FORTRAN (1977)
21198C     VERSION NUMBER--2011/5
21199C     ORIGINAL VERSION--MAY       2011.
21200C
21201C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
21202C
21203      CHARACTER*4 ICASAN
21204      CHARACTER*4 IFLAGU
21205      CHARACTER*4 IBUGA2
21206      CHARACTER*4 IBUGA3
21207      CHARACTER*4 ISUBRO
21208      CHARACTER*4 IERROR
21209C
21210      LOGICAL IFRST
21211      LOGICAL ILAST
21212C
21213      CHARACTER*4 IH
21214      CHARACTER*4 IH2
21215      CHARACTER*4 ISUBN0
21216      CHARACTER*4 ISUBN1
21217      CHARACTER*4 ISUBN2
21218      CHARACTER*4 ISTEPN
21219      CHARACTER*4 IOP
21220C
21221      SAVE IOUNI1
21222C
21223C-----COMMON VARIABLES (GENERAL)--------------------------------------
21224C
21225      INCLUDE 'DPCOPA.INC'
21226      INCLUDE 'DPCOHK.INC'
21227      INCLUDE 'DPCOHO.INC'
21228      INCLUDE 'DPCOP2.INC'
21229C
21230C-----START POINT-----------------------------------------------------
21231C
21232      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MNN5')THEN
21233        ISTEPN='1'
21234        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21235        WRITE(ICOUT,999)
21236  999   FORMAT(1X)
21237        CALL DPWRST('XXX','BUG ')
21238        WRITE(ICOUT,51)
21239   51   FORMAT('***** AT THE BEGINNING OF DPMNN5--')
21240        CALL DPWRST('XXX','BUG ')
21241        WRITE(ICOUT,53)STATVA,STATCD,PVAL2T,PVALLT,PVALUT
21242   53   FORMAT('STATVA,STATCD,PVAL2T,PVALLT,PVALUT = ',5G15.7)
21243        CALL DPWRST('XXX','BUG ')
21244        WRITE(ICOUT,55)ICASAN
21245   55   FORMAT('ICASAN = ',A4)
21246        CALL DPWRST('XXX','BUG ')
21247      ENDIF
21248C
21249      IF(IFLAGU.EQ.'FILE')THEN
21250C
21251        IF(IFRST)THEN
21252          IOP='OPEN'
21253          IFLAG1=1
21254          IFLAG2=0
21255          IFLAG3=0
21256          IFLAG4=0
21257          IFLAG5=0
21258          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
21259     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
21260     1                IBUGA3,ISUBRO,IERROR)
21261          IF(IERROR.EQ.'YES')GOTO9000
21262C
21263          WRITE(IOUNI1,295)
21264  295     FORMAT(10X,'STATVAL',8X,'STATCDF',
21265     1            9X,'PVAL2T',9X,'PVALLT',9X,'PVALUT',
21266     1            7X,'CUTLO001',7X,'CUTLO005',7X,'CUTLOW01',
21267     1            7X,'CUTLO025',7X,'CUTLOW05',7X,'CUTLOW10',
21268     1            7X,'CUTUPP90',7X,'CUTUPP95',7X,'CUTUP975',
21269     1            7X,'CUTUPP99',7X,'CUTUP995',7X,'CUTUP999')
21270        ENDIF
21271        WRITE(IOUNI1,298)STATVA,STATCD,PVAL2T,PVALLT,PVALUT,
21272     1                   CTL001,CTL005,CTL010,CTL025,CTL050,CTL100,
21273     1                   CTU900,CTU950,CTU975,CTU990,CTU995,CTU999
21274  298   FORMAT(17E15.7)
21275      ELSEIF(IFLAGU.EQ.'ON')THEN
21276        IH='STAT'
21277        IH2='VALU'
21278        VALUE0=STATVA
21279        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21280     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21281     1              IANS,IWIDTH,IBUGA3,IERROR)
21282C
21283        IH='STAT'
21284        IH2='CDF '
21285        VALUE0=STATCD
21286        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21287     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21288     1              IANS,IWIDTH,IBUGA3,IERROR)
21289C
21290        IH='PVAL'
21291        IH2='UE  '
21292        VALUE0=PVAL2T
21293        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21294     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21295     1              IANS,IWIDTH,IBUGA3,IERROR)
21296C
21297        IH='PVAL'
21298        IH2='UELT'
21299        VALUE0=PVALLT
21300        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21301     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21302     1              IANS,IWIDTH,IBUGA3,IERROR)
21303C
21304        IH='PVAL'
21305        IH2='UEUT'
21306        VALUE0=PVALUT
21307        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21308     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21309     1              IANS,IWIDTH,IBUGA3,IERROR)
21310C
21311        IH='CUTU'
21312        IH2='PP90'
21313        VALUE0=CTU900
21314        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21315     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21316     1              IANS,IWIDTH,IBUGA3,IERROR)
21317C
21318        IH='CUTL'
21319        IH2='OW10'
21320        VALUE0=CTL100
21321        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21322     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21323     1              IANS,IWIDTH,IBUGA3,IERROR)
21324C
21325        IH='CUTU'
21326        IH2='PP95'
21327        VALUE0=CTU950
21328        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21329     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21330     1              IANS,IWIDTH,IBUGA3,IERROR)
21331C
21332        IH='CUTL'
21333        IH2='OW05'
21334        VALUE0=CTL050
21335        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21336     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21337     1              IANS,IWIDTH,IBUGA3,IERROR)
21338C
21339        IH='CUTU'
21340        IH2='P975'
21341        VALUE0=CTU975
21342        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21343     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21344     1              IANS,IWIDTH,IBUGA3,IERROR)
21345C
21346        IH='CUTL'
21347        IH2='O025'
21348        VALUE0=CTL025
21349        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21350     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21351     1              IANS,IWIDTH,IBUGA3,IERROR)
21352C
21353        IH='CUTU'
21354        IH2='PP99'
21355        VALUE0=CTU990
21356        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21357     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21358     1              IANS,IWIDTH,IBUGA3,IERROR)
21359C
21360        IH='CUTL'
21361        IH2='OW01'
21362        VALUE0=CTL010
21363        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21364     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21365     1              IANS,IWIDTH,IBUGA3,IERROR)
21366C
21367        IH='CUTU'
21368        IH2='P995'
21369        VALUE0=CTU995
21370        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21371     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21372     1              IANS,IWIDTH,IBUGA3,IERROR)
21373C
21374        IH='CUTL'
21375        IH2='O005'
21376        VALUE0=CTL005
21377        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21378     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21379     1              IANS,IWIDTH,IBUGA3,IERROR)
21380C
21381        IH='CUTU'
21382        IH2='P999'
21383        VALUE0=CTU999
21384        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21385     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21386     1              IANS,IWIDTH,IBUGA3,IERROR)
21387C
21388        IH='CUTL'
21389        IH2='O001'
21390        VALUE0=CTL001
21391        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
21392     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
21393     1              IANS,IWIDTH,IBUGA3,IERROR)
21394C
21395      ENDIF
21396C
21397      IF(IFLAGU.EQ.'FILE')THEN
21398        IF(ILAST)THEN
21399          IOP='CLOS'
21400          IFLAG1=1
21401          IFLAG2=0
21402          IFLAG3=0
21403          IFLAG4=0
21404          IFLAG5=0
21405          CALL DPAUFI(IOP,IFLAG1,IFLAG2,IFLAG3,IFLAG4,IFLAG5,
21406     1                IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
21407     1                IBUGA3,ISUBRO,IERROR)
21408C
21409          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MNN5')THEN
21410            ISTEPN='3A'
21411            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
21412            WRITE(ICOUT,999)
21413            CALL DPWRST('XXX','BUG ')
21414            WRITE(ICOUT,301)IERROR
21415  301       FORMAT('AFTER CALL DPCLFI, IERROR = ',A4)
21416            CALL DPWRST('XXX','BUG ')
21417          ENDIF
21418C
21419          IF(IERROR.EQ.'YES')GOTO9000
21420        ENDIF
21421      ENDIF
21422C
21423C               *****************
21424C               **  STEP 90--  **
21425C               **  EXIT       **
21426C               *****************
21427C
21428 9000 CONTINUE
21429C
21430      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MNN5')THEN
21431        WRITE(ICOUT,999)
21432        CALL DPWRST('XXX','BUG ')
21433        WRITE(ICOUT,9011)
21434 9011   FORMAT('***** AT THE END OF DPMNN5--')
21435        CALL DPWRST('XXX','BUG ')
21436      ENDIF
21437C
21438      RETURN
21439      END
21440      SUBROUTINE DPMMEA(NPTS,NLAB,
21441     1                  ASM,ASD2,SET2,SET2K1,SET2K2,
21442     1                  DLOWT1,DHIGT1,
21443     1                  IWRITE,
21444     1                  ICAPSW,ICAPTY,NUMDIG,
21445     1                  ISUBRO,IBUGA3,IERROR)
21446C
21447C     PURPOSE--IMPLEMENT MEAN OF MEANS APPROACH TO CONSENSUS MEANS
21448C     PRINTING--YES
21449C     SUBROUTINES NEEDED--TPPF
21450C     WRITTEN BY--ALAN HECKERT
21451C                 STATISTICAL ENGINEERING DIVISION
21452C                 INFORMATION TECHNOLOGY LABORATORY
21453C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21454C                 GAITHERSBURG, MD 20899-8980
21455C                 PHONE--301-975-2899
21456C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21457C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21458C     LANGUAGE--ANSI FORTRAN (1977)
21459C     VERSION NUMBER--2006/3
21460C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
21461C     UPDATED         --OCTOBER   2006. CALL LIST TO TPPF
21462C     UPDATED         --FEBRUARY  2010. USE DPDTA1 TO PRINT
21463C
21464C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
21465C
21466      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
21467C
21468      CHARACTER*4 ICAPSW
21469      CHARACTER*4 ICAPTY
21470      CHARACTER*4 ISUBRO
21471      CHARACTER*4 IBUGA3
21472      CHARACTER*4 IERROR
21473C
21474      CHARACTER*4 IWRITE
21475      CHARACTER*4 ISUBN1
21476      CHARACTER*4 ISUBN2
21477C
21478      REAL APPF
21479      REAL ASM
21480      REAL ASD2
21481      REAL SET2
21482      REAL SET2K1
21483      REAL SET2K2
21484C
21485C----------------------------------------------------------------
21486C
21487      INCLUDE 'DPCOST.INC'
21488C
21489      PARAMETER (MAXROW=20)
21490      CHARACTER*60 ITITLE
21491      CHARACTER*60 ITITLZ
21492      CHARACTER*60 ITITL9
21493      CHARACTER*60 ITEXT(MAXROW)
21494      REAL         AVALUE(MAXROW)
21495      INTEGER      NCTEXT(MAXROW)
21496      INTEGER      IDIGIT(MAXROW)
21497      INTEGER      NTOT(MAXROW)
21498      LOGICAL IFRST
21499      LOGICAL ILAST
21500C
21501      INCLUDE 'DPCOP2.INC'
21502C
21503C-----START POINT------------------------------------------------
21504C
21505      IERROR='NO'
21506      ISUBN1='DPMM'
21507      ISUBN2='EA  '
21508C
21509      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMEA')THEN
21510        WRITE(ICOUT,999)
21511  999   FORMAT(1X)
21512        CALL DPWRST('XXX','BUG ')
21513        WRITE(ICOUT,51)
21514   51   FORMAT('***** AT THE BEGINNING OF DPMMEA--')
21515        CALL DPWRST('XXX','BUG ')
21516        WRITE(ICOUT,52)NPTS,NLAB,ASM,ASD2
21517   52   FORMAT('NPTS,NLAB,ASM,ASD2 = ',2I8,2G15.7)
21518        CALL DPWRST('XXX','BUG ')
21519        WRITE(ICOUT,54)IWRITE
21520   54   FORMAT('IWRITE = ',A4)
21521        CALL DPWRST('XXX','BUG ')
21522      ENDIF
21523C
21524      SET2=ASD2/SQRT(REAL(NLAB))
21525      SET2K1=SET2
21526      SET2K2=2.0*SET2
21527      IDF=NLAB-1
21528      CALL TPPF(0.975,REAL(IDF),APPF)
21529      DLOWT1=DBLE(ASM - APPF*SET2)
21530      DHIGT1=DBLE(ASM + APPF*SET2)
21531C
21532      IF(IPRINT.EQ.'OFF')GOTO9000
21533C
21534      ITITLE=' '
21535      NCTITL=0
21536      ITITLZ=' '
21537      NCTITZ=0
21538C
21539      ICNT=1
21540      ITEXT(ICNT)=' 9. Method: Mean of Means'
21541      NCTEXT(ICNT)=25
21542      AVALUE(ICNT)=0.0
21543      IDIGIT(ICNT)=-1
21544C
21545      ICNT=ICNT+1
21546      ITEXT(ICNT)='    Mean of Lab Means:'
21547      NCTEXT(ICNT)=22
21548      AVALUE(ICNT)=ASM
21549      IDIGIT(ICNT)=NUMDIG
21550      ICNT=ICNT+1
21551      ITEXT(ICNT)='    Standard Deviation of Lab Means:'
21552      NCTEXT(ICNT)=36
21553      AVALUE(ICNT)=ASD2
21554      IDIGIT(ICNT)=NUMDIG
21555      ICNT=ICNT+1
21556      ITEXT(ICNT)='    Standard Uncertainty (sd/sqrt(n)):'
21557      NCTEXT(ICNT)=38
21558      AVALUE(ICNT)=SET2
21559      IDIGIT(ICNT)=NUMDIG
21560      ICNT=ICNT+1
21561      ITEXT(ICNT)='    SD of Consensus Mean (sd/sqrt(n)):'
21562      NCTEXT(ICNT)=38
21563      AVALUE(ICNT)=SET2
21564      IDIGIT(ICNT)=NUMDIG
21565      ICNT=ICNT+1
21566      ITEXT(ICNT)='    Standard Uncertainty (k = 1):'
21567      NCTEXT(ICNT)=33
21568      AVALUE(ICNT)=SET2
21569      IDIGIT(ICNT)=NUMDIG
21570      ICNT=ICNT+1
21571      ITEXT(ICNT)='    Expanded Uncertainty (k = 2):'
21572      NCTEXT(ICNT)=33
21573      AVALUE(ICNT)=2.0*SET2
21574      IDIGIT(ICNT)=NUMDIG
21575      ICNT=ICNT+1
21576      ITEXT(ICNT)='    Expanded Uncertainty (k =           ):'
21577      WRITE(ITEXT(ICNT)(31:40),'(F10.7)')APPF
21578      NCTEXT(ICNT)=42
21579      AVALUE(ICNT)=APPF*SET2
21580      IDIGIT(ICNT)=NUMDIG
21581      ICNT=ICNT+1
21582      ITEXT(ICNT)='    Degrees of Freedom:'
21583      NCTEXT(ICNT)=23
21584      AVALUE(ICNT)=REAL(IDF)
21585      IDIGIT(ICNT)=0
21586      ICNT=ICNT+1
21587      ITEXT(ICNT)='    t Percent Point Value (alpha = 0.05):'
21588      NCTEXT(ICNT)=41
21589      AVALUE(ICNT)=APPF
21590      IDIGIT(ICNT)=NUMDIG
21591      ICNT=ICNT+1
21592      ITEXT(ICNT)='    Lower 95% (normal) Confidence Limit:'
21593      NCTEXT(ICNT)=40
21594      AVALUE(ICNT)=DLOWT1
21595      IDIGIT(ICNT)=NUMDIG
21596      ICNT=ICNT+1
21597      ITEXT(ICNT)='    Upper 95% (normal) Confidence Limit:'
21598      NCTEXT(ICNT)=40
21599      AVALUE(ICNT)=DHIGT1
21600      IDIGIT(ICNT)=NUMDIG
21601      ICNT=ICNT+1
21602      ITEXT(ICNT)='    Note: Mean of Means Best Usage:'
21603      NCTEXT(ICNT)=35
21604      AVALUE(ICNT)=0.0
21605      IDIGIT(ICNT)=-1
21606      ICNT=ICNT+1
21607      ITEXT(ICNT)='          Any Number of Labs:'
21608      NCTEXT(ICNT)=29
21609      AVALUE(ICNT)=0.0
21610      IDIGIT(ICNT)=-1
21611C
21612      NUMROW=ICNT
21613      DO310I=1,NUMROW
21614        NTOT(I)=15
21615  310 CONTINUE
21616C
21617      IFRST=.TRUE.
21618      ILAST=.TRUE.
21619      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
21620     1            AVALUE,IDIGIT,
21621     1            NTOT,NUMROW,
21622     1            ICAPSW,ICAPTY,ILAST,IFRST,
21623     1            ISUBRO,IBUGA3,IERROR)
21624      ITITLE=' '
21625      NCTITL=0
21626      ITITLZ=' '
21627      NCTITZ=0
21628      ITITL9=' '
21629      NCTIT9=0
21630C
21631C               *****************
21632C               **  STEP 90--  **
21633C               **  EXIT       **
21634C               *****************
21635C
21636 9000 CONTINUE
21637      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMEA')THEN
21638        WRITE(ICOUT,999)
21639        CALL DPWRST('XXX','BUG ')
21640        WRITE(ICOUT,9011)
21641 9011   FORMAT('***** AT THE END       OF DPMMEA--')
21642        CALL DPWRST('XXX','BUG ')
21643        WRITE(ICOUT,9013)IERRO,NPTS,NLAB
21644 9013   FORMAT('IERROR,NPTS,NLAB = ',A4,2X,2I8)
21645        CALL DPWRST('XXX','BUG ')
21646        WRITE(ICOUT,9015)SET1,SET2,DLOWT1,DHIGT1
21647 9015   FORMAT('SET1,SET2,DLOWT1,DHIGT1 = ',4G15.7)
21648        CALL DPWRST('XXX','BUG ')
21649      ENDIF
21650C
21651      RETURN
21652      END
21653      SUBROUTINE DPMMED(NPTS,NLAB,AMEAN,ASD,
21654     1                  TEMP1,TEMP2,TEMP3,AINDEX,IINDEX,
21655     1                  SMOOTH,FT,DTEMP1,
21656     1                  XMEDME,SEMED,SEMEK1,
21657     1                  DLOWM0,DHIGM0,DLOWM1,DHIGM1,
21658     1                  DLOWM2,DHIGM2,DLOWM3,DHIGM3,
21659     1                  IWRITE,IOUNI5,MAXNXT,
21660     1                  ICAPSW,ICAPTY,NUMDIG,ISEED,IBOOSS,
21661     1                  ISUBRO,IBUGA3,IERROR)
21662C
21663C     PURPOSE--IMPLEMENT:
21664C
21665C              1) MEDIAN OF MEANS
21666C
21667C              STANDARD ERRORS ARE OBTAINED VIA A BOOTSTRAP METHOD
21668C     PRINTING--YES
21669C     SUBROUTINES NEEDED--TPPF
21670C     WRITTEN BY--ALAN HECKERT
21671C                 STATISTICAL ENGINEERING DIVISION
21672C                 INFORMATION TECHNOLOGY LABORATORY
21673C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21674C                 GAITHERSBURG, MD 20899-8980
21675C                 PHONE--301-975-2899
21676C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21677C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21678C     LANGUAGE--ANSI FORTRAN (1977)
21679C     VERSION NUMBER--2012/10
21680C     ORIGINAL VERSION--OCTOBER   2012.
21681C
21682C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
21683C
21684      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
21685C
21686      REAL AMEAN(*)
21687      REAL ASD(*)
21688      REAL TEMP1(*)
21689      REAL TEMP2(*)
21690      REAL TEMP3(*)
21691      REAL AINDEX(*)
21692C
21693      DOUBLE PRECISION SMOOTH(*)
21694      DOUBLE PRECISION FT(*)
21695      DOUBLE PRECISION DTEMP1(*)
21696C
21697      INTEGER IINDEX(*)
21698C
21699      CHARACTER*4 ICAPSW
21700      CHARACTER*4 ICAPTY
21701      CHARACTER*4 ISUBRO
21702      CHARACTER*4 IBUGA3
21703      CHARACTER*4 IERROR
21704      CHARACTER*4 IWRITE
21705      CHARACTER*4 ICASJB
21706      CHARACTER*4 ISUBN1
21707      CHARACTER*4 ISUBN2
21708C
21709      REAL XMEDME
21710      REAL XMED
21711      REAL XSD
21712      REAL SEMED
21713      REAL SEMEK1
21714      REAL SEMEK2
21715      REAL ALPHAL
21716      REAL ALPHAU
21717      REAL XPERC
21718      REAL XPERCL
21719      REAL XPERCU
21720      REAL XPERC1
21721      REAL XPERC2
21722      REAL WIDTH
21723      REAL P
21724      REAL ANI
21725      REAL AN
21726      REAL A2NI
21727      REAL REM
21728      REAL AIQ
21729      REAL DIFF
21730      REAL DIFFT
21731      REAL ALOW
21732      REAL AUPP
21733      REAL AK3
21734      REAL AIVAR
21735      REAL ALAMB
21736      REAL ALPHA
21737      REAL AK
21738      REAL CDF1
21739      REAL CDF2
21740      REAL GK
21741      REAL GKP1
21742      REAL AKP
21743      REAL ANMK
21744      REAL ANMKP
21745      REAL P100
21746C
21747C----------------------------------------------------------------
21748C
21749      INCLUDE 'DPCOST.INC'
21750C
21751      PARAMETER (MAXROW=30)
21752      CHARACTER*60 ITITLE
21753      CHARACTER*60 ITITLZ
21754      CHARACTER*60 ITITL9
21755      CHARACTER*60 ITEXT(MAXROW)
21756      REAL         AVALUE(MAXROW)
21757      INTEGER      NCTEXT(MAXROW)
21758      INTEGER      IDIGIT(MAXROW)
21759      INTEGER      NTOT(MAXROW)
21760      LOGICAL IFRST
21761      LOGICAL ILAST
21762C
21763      INCLUDE 'DPCOP2.INC'
21764C
21765C-----START POINT------------------------------------------------
21766C
21767      IERROR='NO'
21768      ISUBN1='DPMM'
21769      ISUBN2='ED  '
21770C
21771      IINDX=0
21772      ICNT=0
21773C
21774      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMED')THEN
21775        WRITE(ICOUT,999)
21776  999   FORMAT(1X)
21777        CALL DPWRST('XXX','BUG ')
21778        WRITE(ICOUT,51)
21779   51   FORMAT('***** AT THE BEGINNING OF DPMMED--')
21780        CALL DPWRST('XXX','BUG ')
21781        WRITE(ICOUT,52)NPTS,NLAB,ASM,ASD2
21782   52   FORMAT('NPTS,NLAB,ASM,ASD2 = ',2I8,2G15.7)
21783        CALL DPWRST('XXX','BUG ')
21784        DO60I=1,NLAB
21785          WRITE(ICOUT,62)I,AMEAN(I),ASD(I)
21786   62     FORMAT('I,AMEAN(I),ASD(I) = ',I8,2G15.7)
21787          CALL DPWRST('XXX','BUG ')
21788   60   CONTINUE
21789      ENDIF
21790C
21791C     STEP 1: COMPUTE THE MEDIAN OF THE MEANS, THE STANDARD ERROR,
21792C             AND THE HETTMANSPERGER-SHEATHER 95% CONFIDENCE INTERVAL.
21793C
21794      CALL MEDIAN(AMEAN,NLAB,IWRITE,TEMP1,MAXNXT,XMEDME,IBUGA3,IERROR)
21795      P100=0.5
21796      CALL QUANSE(P100,AMEAN,NLAB,IWRITE,TEMP1,MAXNXT,IQUASE,SEMED,
21797     1            IBUGA3,IERROR)
21798C
21799      DP=0.5D0
21800      AN=REAL(NLAB)
21801      CALL SORT(AMEAN,NLAB,TEMP1)
21802      ALPHA=(100.0-95.0)/100.
21803      CALL BINPPF(DBLE(ALPHA/2.0),DP,NLAB,DPPF)
21804      AK=REAL(DPPF)
21805      CALL BINCDF(DBLE(AN-AK),DP,NLAB,DCDF)
21806      CDF1=REAL(DCDF)
21807      CALL BINCDF(DBLE(AK-1.0),DP,NLAB,DCDF)
21808      CDF2=REAL(DCDF)
21809      GK=CDF1-CDF2
21810      IF(GK.GE.1.0-ALPHA)THEN
21811        CALL BINCDF(DBLE(AN-AK-1.0),DP,NLAB,DCDF)
21812        CDF1=REAL(DCDF)
21813        CALL BINCDF(DBLE(AK-1.0),DP,NLAB,DCDF)
21814        CDF2=REAL(DCDF)
21815        GKP1=CDF1-CDF2
21816        AKP=AK+1.0
21817      ELSE
21818        AK=AK-1.0
21819        CALL BINCDF(DBLE(AN-AK),DP,NLAB,DCDF)
21820        CDF1=REAL(DCDF)
21821        CALL BINCDF(DBLE(AK-1.0),DP,NLAB,DCDF)
21822        CDF2=REAL(DCDF)
21823        GKP1=CDF1-CDF2
21824        AKP=AK+1.0
21825      ENDIF
21826      ANMK=AN-AK
21827      ANMKP=ANMK+1.0
21828      AIVAR=(GK-1.0+ALPHA)/(GK-GKP1)
21829      ALAMB=((AN-AK)*AIVAR)/(AK+(AN-2.0*AK)*AIVAR)
21830      DLOWM0=ALAMB*TEMP1(INT(AKP)) + (1.0-ALAMB)*TEMP1(INT(AK))
21831      DHIGM0=ALAMB*TEMP1(INT(ANMK)) + (1.0-ALAMB)*TEMP1(INT(ANMKP))
21832C
21833C     STEP 2: NOW COMPUTE THE STANDARD ERROR BASED ON A NON-PARAMETRIC
21834C             BOOTSTRAP.
21835C
21836      ICASJB='BOOT'
21837      NRESAM=IBOOSS
21838C
21839      IF(IOUNI5.GT.0)THEN
21840        WRITE(IOUNI5,1009)
21841 1009   FORMAT('CONSENSUS MEAN ESTIMATES FROM MEDIAN OF MEANS ',
21842     1         'BOOTSTRAP SAMPLES')
21843      ENDIF
21844C
21845      DO1100IRESAM=1,NRESAM
21846        CALL DPJBS3(AMEAN,NLAB,ICASJB,IJACIN,ISEED,TEMP2,NTEMP,
21847     1              IINDEX,AINDEX,
21848     1              IBUGA3,IERROR)
21849        CALL MEDIAN(TEMP2,NTEMP,IWRITE,TEMP1,MAXNXT,XMED,
21850     1              IBUGA3,IERROR)
21851        TEMP3(IRESAM)=XMED
21852        DTEMP1(IRESAM)=XMED
21853        IF(IOUNI5.GT.0)WRITE(IOUNI5,'(E15.7)')XMED
21854C
21855 1100 CONTINUE
21856C
21857C     STEP 3: COMPUTE BOOTSTRAP BASED STANDARD ERRORS
21858C
21859C             3 METHODS FOR COMPUTING 95% CONFIDENCE INTERVAL:
21860C
21861C             1) PERCENTILE (THESE ARE NOT NECESSARILY SYMMETRIC
21862C
21863C             2) SYMMETRIC INTERVALS EASY WAY - TAKE LARGER OF
21864C                (MEAN - 0.025 PERCENTILE) AND (0.975 PERCENTILE - MEAN)
21865C
21866C             3) COMPUTE KERNEL DENSITY ESTIMATE, MOVE OUT FROM MEAN
21867C                IN EQUAL INCREMENTS UNTIL APPROPRIATE COVERAGE REACHED
21868C
21869C     PERCENTILE METHOD
21870C
21871      CALL SD(TEMP3,NRESAM,IWRITE,XSD,IBUGA3,IERROR)
21872      SEMEK1=XSD
21873      SEMEK2=2.0*XSD
21874      ALPHAL=100.0*0.025
21875      ALPHAU=100.0*0.975
21876C
21877      CALL PERCEN(ALPHAL,TEMP3,NRESAM,IWRITE,TEMP1,NRESAM,
21878     1            XPERC,IBUGA3,IERROR)
21879      XPERCL=XPERC
21880      CALL PERCEN(ALPHAU,TEMP3,NRESAM,IWRITE,TEMP1,NRESAM,
21881     1            XPERC,IBUGA3,IERROR)
21882      XPERCU=XPERC
21883C
21884      DLOWM1=DBLE(XPERCL)
21885      DHIGM1=DBLE(XPERCU)
21886C
21887C     SIMPLE SYMMETRIC INTERVAL
21888C
21889      WIDTH=MAX(ABS(XMEDME - XPERCL),ABS(XPERCU  - XMEDME))
21890      DLOWM2=DBLE(XMEDME - WIDTH)
21891      DHIGM2=DBLE(XMEDME + WIDTH)
21892      AK2=WIDTH/SEMEK1
21893C
21894C     NOW GENERATE THE KERNEL DENSITY TRACE
21895C
21896      KFLAG=1
21897      CALL DSORT(DTEMP1,DTEMP1,NRESAM,KFLAG,IERROR)
21898      DN=REAL(NRESAM)
21899      DSUM=0.0D0
21900      DO11410I=1,NRESAM
21901        DSUM=DSUM + DTEMP1(I)
2190211410 CONTINUE
21903      DMEAN=DSUM/DN
21904      DSUM=0.0D0
21905      DO11420I=1,NRESAM
21906        DX=DTEMP1(I)
21907        DSUM=DSUM+(DX-DMEAN)**2
2190811420 CONTINUE
21909      DVAR=DSUM/(DN-1.0D0)
21910      DSD=0.0D0
21911      IF(DVAR.GT.0.0D0)DSD=DSQRT(DVAR)
21912C
21913      P=0.25
21914      AN=REAL(DN)
21915      ANI=P*(AN+1.0)
21916      NI=INT(ANI)
21917      A2NI=REAL(NI)
21918      REM=ANI-A2NI
21919      NIP1=NI+1
21920      IF(NI.LE.1)NI=1
21921      IF(NI.GE.NRESAM)NI=NRESAM
21922      IF(NIP1.LE.1)NIP1=1
21923      IF(NIP1.GE.NRESAM)NIP1=NRESAM
21924      XPERC1=(1.0-REM)*DTEMP1(NI)+REM*DTEMP1(NIP1)
21925C
21926      P=0.75
21927      ANI=P*(AN+1.0)
21928      NI=INT(ANI)
21929      A2NI=REAL(ANI)
21930      REM=ANI-A2NI
21931      NIP1=NI+1
21932      IF(NI.LE.1)NI=1
21933      IF(NI.GE.NRESAM)NI=NRESAM
21934      IF(NIP1.LE.1)NIP1=1
21935      IF(NIP1.GE.NRESAM)NIP1=NRESAM
21936      XPERC2=(1.0-REM)*DTEMP1(NI)+REM*DTEMP1(NIP1)
21937      AIQ=(XPERC2-XPERC1)/1.34
21938      AIQ=ABS(AIQ)
21939C
21940      DH=0.9D0*MIN(DSD,DBLE(AIQ))*DN**(-1.0D0/5.0D0)
21941      DLO=DTEMP1(1) - 3.0D0*DH
21942      DHI=DTEMP1(NRESAM) + 3.0D0*DH
21943C
21944      ICAL=0
21945      IKENDP=2048
21946      IERROR='NO'
21947      CALL DENEST(DTEMP1,NRESAM,DLO,DHI,DH,FT,SMOOTH,IKENDP,ICAL,
21948     1            IERROR)
21949      DIFF=CPUMAX
21950      DO11430I=1,IKENDP
21951        TEMP1(I)=REAL(SMOOTH(I))
21952        TEMP3(I)=REAL(DLO + (DBLE(I) - 0.5D0)*(DHI-DLO)/DBLE(IKENDP))
21953CCCCC   XPLOT(I)=TEMP3(I)
21954CCCCC   YPLOT(I)=TEMP1(I)
21955        DIFFT=ABS(TEMP3(I) - XMEDME)
21956        IF(DIFFT.LT.DIFF)THEN
21957          IINDX=I
21958          DIFF=DIFFT
21959        ENDIF
2196011430 CONTINUE
21961      NPLOT=IKENDP
21962      NUMVAR=2
21963      CALL CUMINT(TEMP1,TEMP3,IKENDP,NUMVAR,IWRITE,TEMP2,
21964     1            IBUGA3,IERROR)
21965C
21966C     THE CUMULATIVE INTEGRAL IS NOW IN TEMP2 (AND TEMP4 IS THE
21967C     X-COORDINATE).  START FROM XMEDME VALUE AND MOVE IN EQUAL
21968C     INCREMENTS UNTIL SUFFICENT COVERAGE IS OBTAINED.
21969C
21970      ICNT=0
21971      DHIGM3=TEMP3(IKENDP)
21972      DLOWM3=TEMP3(1)
21973      DO11500I=IINDX,IKENDP
21974        ICNT=ICNT+1
21975        IUPP=IINDX+ICNT
21976        ILOW=IINDX-ICNT
21977        IF(ILOW.LT.1)GOTO11509
21978        AUPP=1.0 - TEMP2(IUPP)
21979        ALOW=TEMP2(ILOW)
21980        IF(ALOW+AUPP.LT.0.05)THEN
21981          DHIGM3=TEMP3(IUPP)
21982          DLOWM3=TEMP3(ILOW)
21983          GOTO11509
21984        ENDIF
2198511500 CONTINUE
2198611509 CONTINUE
21987C
21988      WIDTH=REAL(DHIGM3 - DBLE(XMEDME))
21989      AK3=WIDTH/SEMEK1
21990C
21991      IF(IPRINT.EQ.'OFF')GOTO9000
21992C
21993      ITITLE=' '
21994      NCTITL=0
21995      ITITLZ=' '
21996      NCTITZ=0
21997C
21998      ICNT=1
21999      ITEXT(ICNT)='14. Method: Median of Means'
22000      NCTEXT(ICNT)=27
22001      AVALUE(ICNT)=0.0
22002      IDIGIT(ICNT)=-1
22003C
22004      ICNT=ICNT+1
22005      ITEXT(ICNT)='    Median of Lab Means:'
22006      NCTEXT(ICNT)=24
22007      AVALUE(ICNT)=XMEDME
22008      IDIGIT(ICNT)=NUMDIG
22009      ICNT=ICNT+1
22010      ITEXT(ICNT)='    Variance of Median of Means:'
22011      NCTEXT(ICNT)=32
22012      AVALUE(ICNT)=SQRT(SEMED)
22013      IDIGIT(ICNT)=NUMDIG
22014      ICNT=ICNT+1
22015      ITEXT(ICNT)='    Standard Uncertainty (k = 1):'
22016      NCTEXT(ICNT)=33
22017      AVALUE(ICNT)=SEMED
22018      IDIGIT(ICNT)=NUMDIG
22019      ICNT=ICNT+1
22020      ITEXT(ICNT)='    Expanded Uncertainty (k = 2):'
22021      NCTEXT(ICNT)=33
22022      AVALUE(ICNT)=2.0*SEMED
22023      IDIGIT(ICNT)=NUMDIG
22024      ICNT=ICNT+1
22025      ITEXT(ICNT)='    Lower 95% Confidence Interval:'
22026      NCTEXT(ICNT)=34
22027CCCCC AVALUE(ICNT)=DLOWM0
22028      AVALUE(ICNT)=XMEDME - 1.96*SEMED
22029      IDIGIT(ICNT)=NUMDIG
22030      ICNT=ICNT+1
22031      ITEXT(ICNT)='    Upper 95% Confidence Interval:'
22032      NCTEXT(ICNT)=34
22033CCCCC AVALUE(ICNT)=DHIGM0
22034      AVALUE(ICNT)=XMEDME + 1.96*SEMED
22035      IDIGIT(ICNT)=NUMDIG
22036      ICNT=ICNT+1
22037      ITEXT(ICNT)=' '
22038      NCTEXT(ICNT)=0
22039      AVALUE(ICNT)=0.0
22040      IDIGIT(ICNT)=-1
22041C
22042      ICNT=ICNT+1
22043      ITEXT(ICNT)='    Bootstrap Uncertainties:'
22044      NCTEXT(ICNT)=28
22045      AVALUE(ICNT)=0.0
22046      IDIGIT(ICNT)=-1
22047      ICNT=ICNT+1
22048      ITEXT(ICNT)='    Number of Bootstrap Samples:'
22049      NCTEXT(ICNT)=31
22050      AVALUE(ICNT)=REAL(NRESAM)
22051      IDIGIT(ICNT)=0
22052      ICNT=ICNT+1
22053      ITEXT(ICNT)='    Variance of Consensus Mean:'
22054      NCTEXT(ICNT)=31
22055      AVALUE(ICNT)=SEMEK1**2
22056      IDIGIT(ICNT)=NUMDIG
22057      ICNT=ICNT+1
22058      ITEXT(ICNT)='    Standard Uncertainty (k = 1):'
22059      NCTEXT(ICNT)=33
22060      AVALUE(ICNT)=SEMEK1
22061      IDIGIT(ICNT)=NUMDIG
22062      ICNT=ICNT+1
22063      ITEXT(ICNT)='    Expanded Uncertainty (k = 2):'
22064      NCTEXT(ICNT)=33
22065      AVALUE(ICNT)=SEMEK2
22066      IDIGIT(ICNT)=NUMDIG
22067      ICNT=ICNT+1
22068      ITEXT(ICNT)=
22069     1 '    Lower 95% (percentile bootstrap) Confidence Limit:'
22070      NCTEXT(ICNT)=54
22071      AVALUE(ICNT)=DLOWM1
22072      IDIGIT(ICNT)=NUMDIG
22073      ICNT=ICNT+1
22074      ITEXT(ICNT)=
22075     1 '    Upper 95% (percentile bootstrap) Confidence Limit:'
22076      NCTEXT(ICNT)=54
22077      AVALUE(ICNT)=DHIGM1
22078      IDIGIT(ICNT)=NUMDIG
22079      ICNT=ICNT+1
22080      ITEXT(ICNT)=
22081     1 '    Lower 95% (symmetric bootstrap) Confidence Limit:'
22082      NCTEXT(ICNT)=53
22083      AVALUE(ICNT)=DLOWM2
22084      IDIGIT(ICNT)=NUMDIG
22085      ICNT=ICNT+1
22086      ITEXT(ICNT)=
22087     1 '    Upper 95% (symmetric bootstrap) Confidence Limit:'
22088      NCTEXT(ICNT)=53
22089      AVALUE(ICNT)=DHIGM2
22090      IDIGIT(ICNT)=NUMDIG
22091      ICNT=ICNT+1
22092      ITEXT(ICNT)='    K (symmetric bootstrap) Coverage Factor:'
22093      NCTEXT(ICNT)=44
22094      AVALUE(ICNT)=AK2
22095      IDIGIT(ICNT)=NUMDIG
22096      ICNT=ICNT+1
22097      ITEXT(ICNT)=
22098     1 '    Lower 95% (kernel bootstrap) Confidence Limit:'
22099      NCTEXT(ICNT)=50
22100      AVALUE(ICNT)=DLOWM3
22101      IDIGIT(ICNT)=NUMDIG
22102      ICNT=ICNT+1
22103      ITEXT(ICNT)=
22104     1 '    Upper 95% (kernel bootstrap) Confidence Limit:'
22105      NCTEXT(ICNT)=50
22106      AVALUE(ICNT)=DHIGM3
22107      IDIGIT(ICNT)=NUMDIG
22108      ICNT=ICNT+1
22109      ITEXT(ICNT)='    K (kernel bootstrap) Coverage Factor:'
22110      NCTEXT(ICNT)=41
22111      AVALUE(ICNT)=AK3
22112      IDIGIT(ICNT)=NUMDIG
22113      ICNT=ICNT+1
22114      ITEXT(ICNT)=' '
22115      NCTEXT(ICNT)=0
22116      AVALUE(ICNT)=0.0
22117      IDIGIT(ICNT)=-1
22118      ICNT=ICNT+1
22119      ITEXT(ICNT)='    Note: Median of Means Best Usage:'
22120      NCTEXT(ICNT)=37
22121      AVALUE(ICNT)=0.0
22122      IDIGIT(ICNT)=-1
22123      ICNT=ICNT+1
22124      ITEXT(ICNT)='          Any Number of Labs:'
22125      NCTEXT(ICNT)=29
22126      AVALUE(ICNT)=0.0
22127      IDIGIT(ICNT)=-1
22128C
22129      NUMROW=ICNT
22130      DO310I=1,NUMROW
22131        NTOT(I)=15
22132  310 CONTINUE
22133C
22134      IFRST=.TRUE.
22135      ILAST=.TRUE.
22136      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
22137     1            AVALUE,IDIGIT,
22138     1            NTOT,NUMROW,
22139     1            ICAPSW,ICAPTY,ILAST,IFRST,
22140     1            ISUBRO,IBUGA3,IERROR)
22141      ITITLE=' '
22142      NCTITL=0
22143      ITITLZ=' '
22144      NCTITZ=0
22145      ITITL9=' '
22146      NCTIT9=0
22147C
22148C               *****************
22149C               **  STEP 90--  **
22150C               **  EXIT       **
22151C               *****************
22152C
22153 9000 CONTINUE
22154      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMED')THEN
22155        WRITE(ICOUT,999)
22156        CALL DPWRST('XXX','BUG ')
22157        WRITE(ICOUT,9011)
22158 9011   FORMAT('***** AT THE END       OF DPMMED--')
22159        CALL DPWRST('XXX','BUG ')
22160        WRITE(ICOUT,9013)IERRO,NPTS,NLAB
22161 9013   FORMAT('IERROR,NPTS,NLAB = ',A4,2X,2I8)
22162        CALL DPWRST('XXX','BUG ')
22163        WRITE(ICOUT,9015)SET1,SET2,DLOWT1,DHIGT1
22164 9015   FORMAT('SET1,SET2,DLOWT1,DHIGT1 = ',4G15.7)
22165        CALL DPWRST('XXX','BUG ')
22166      ENDIF
22167C
22168      RETURN
22169      END
22170      SUBROUTINE DPMMPL(Y1,Y2,Y3,NPTS,NLAB,
22171     1X,T,N,
22172     1XMMPS,S2BMMP,SEMMP,SEMMP1,SEMMP2,
22173     1DLOWMM,DHIGMM,
22174     1IWRITE,
22175     1ICAPSW,ICAPTY,NUMDIG,
22176     1ISUBRO,IBUGA3,IERROR)
22177C
22178C     PURPOSE--IMPLEMENT MODIFIED MANDEL-PAULE APPROACH TO
22179C              CONSENSUS MEANS
22180C     WRITTEN BY--CODE FOR MODIFIED MANDEL-PAULE PROVIDED BY
22181C                 MARK VANGEL.
22182C     PRINTING--YES
22183C     SUBROUTINES NEEDED--MPSUB
22184C     WRITTEN BY--JAMES J. FILLIBEN
22185C                 STATISTICAL ENGINEERING DIVISION
22186C                 INFORMATION TECHNOLOGY LABORATORY
22187C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22188C                 GAITHERSBURG, MD 20899-8980
22189C                 PHONE--301-975-2899
22190C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22191C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22192C     LANGUAGE--ANSI FORTRAN (1977)
22193C     VERSION NUMBER--2006/3
22194C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
22195C     UPDATED         --FEBRUARY  2010. USE DPDTA1 TO PRINT
22196C
22197C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
22198C
22199      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
22200      CHARACTER*4 ICAPSW
22201      CHARACTER*4 ICAPTY
22202      CHARACTER*4 ISUBRO
22203      CHARACTER*4 IBUGA3
22204      CHARACTER*4 IERROR
22205C
22206      CHARACTER*4 IWRITE
22207      CHARACTER*4 ISUBN1
22208      CHARACTER*4 ISUBN2
22209C
22210      REAL APPF
22211      REAL XMP
22212      REAL XMMPS
22213      REAL S2BMP
22214      REAL S2BMMP
22215      REAL SEMMP
22216      REAL SEMP
22217      REAL SEMMP1
22218      REAL SEMMP2
22219C
22220C----------------------------------------------------------------
22221C
22222      REAL Y1(*)
22223      REAL Y2(*)
22224      REAL Y3(*)
22225C
22226      INTEGER N(*)
22227C
22228      DOUBLE PRECISION X(*)
22229      DOUBLE PRECISION T(*)
22230C
22231      COMMON /MPCOM/ T0, T1
22232C
22233      INCLUDE 'DPCOST.INC'
22234C
22235      PARAMETER (MAXROW=20)
22236      CHARACTER*60 ITITLE
22237      CHARACTER*60 ITITLZ
22238      CHARACTER*60 ITITL9
22239      CHARACTER*60 ITEXT(MAXROW)
22240      REAL         AVALUE(MAXROW)
22241      INTEGER      NCTEXT(MAXROW)
22242      INTEGER      IDIGIT(MAXROW)
22243      INTEGER      NTOT(MAXROW)
22244      LOGICAL IFRST
22245      LOGICAL ILAST
22246C
22247      INCLUDE 'DPCOP2.INC'
22248C
22249C-----START POINT------------------------------------------------
22250C
22251      IERROR='NO'
22252      ISUBN1='DPMM'
22253      ISUBN2='PL  '
22254C
22255      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMPL')THEN
22256        WRITE(ICOUT,999)
22257  999   FORMAT(1X)
22258        CALL DPWRST('XXX','BUG ')
22259        WRITE(ICOUT,51)
22260   51   FORMAT('***** AT THE BEGINNING OF DPMMPL--')
22261        CALL DPWRST('XXX','BUG ')
22262        WRITE(ICOUT,52)NPTS,NLAB,T0,T1
22263   52   FORMAT('NPTS,NLAB,T0,T1 = ',2I8,2G15.7)
22264        CALL DPWRST('XXX','BUG ')
22265        DO55I=1,NLAB
22266          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I),X(I),T(I),N(I)
22267   56     FORMAT('I,Y1(I),Y2(I),Y3(I),X(I),T(I),N(I) = ',
22268     1           I8,5G15.7,I8)
22269          CALL DPWRST('XXX','BUG ')
22270   55   CONTINUE
22271        WRITE(ICOUT,59)IWRITE
22272   59   FORMAT('IWRITE = ',A4)
22273        CALL DPWRST('XXX','BUG ')
22274      ENDIF
22275C
22276      IMANPA='MODI'
22277      CALL MPSUB  (NLAB, N, X, T, DXMP, DS2BMP, IMANPA,IBUGA3)
22278C
22279      IF(IBUGA3.EQ.'ON')THEN
22280        WRITE(ICOUT,999)
22281        CALL DPWRST('XXX','WRIT')
22282        DO102J=1,NLAB
22283        WRITE(ICOUT,101)J,T(J)
22284  101   FORMAT('AFTER MPSUB: J,T(J)=',I8,G15.7)
22285        CALL DPWRST('XXX','WRIT')
22286  102   CONTINUE
22287      ENDIF
22288C
22289      XMP=REAL(DXMP)
22290      S2BMP=REAL(DS2BMP)
22291C
22292      CALL NORPPF(0.975,APPF)
22293      XMPS=(T1-T0)*XMP + T0
22294      S2BMPS=REAL(((T1-T0)**2)*S2BMP)
22295      DSUM1=0.0D0
22296      DSUM2=0.0D0
22297      DO340J=1,NLAB
22298        TI=DBLE(S2BMPS) + ((T1-T0)**2)*T(J)
22299        XJ=(T1-T0)*X(J) + T0
22300        DSUM1=DSUM1 +  (XJ-DBLE(XMPS))**2/(TI**2)
22301        DSUM2=DSUM2 + 1.0D0/TI
22302  340 CONTINUE
22303      STDERR=SQRT(DSUM1)/DSUM2
22304      SEMP=REAL(STDERR)
22305      SEMMP1=SEMP
22306      SEMMP2=2.0*SEMP
22307      DLOWER=XMPS - DBLE(APPF)*STDERR
22308      DUPPER=XMPS + DBLE(APPF)*STDERR
22309      DLOWMM=DLOWER
22310      DHIGMM=DUPPER
22311C
22312      IF(IPRINT.EQ.'OFF')GOTO8000
22313C
22314      ITITLE=' '
22315      NCTITL=0
22316      ITITLZ=' '
22317      NCTITZ=0
22318C
22319      ICNT=1
22320      ITEXT(ICNT)=' 2. Method: Modified Mandel-Paule'
22321      NCTEXT(ICNT)=33
22322      AVALUE(ICNT)=0.0
22323      IDIGIT(ICNT)=-1
22324C
22325      ICNT=ICNT+1
22326      ITEXT(ICNT)='    Estimate of (unscaled) Consensus Mean:'
22327      NCTEXT(ICNT)=42
22328      AVALUE(ICNT)=XMPS
22329      IDIGIT(ICNT)=NUMDIG
22330      ICNT=ICNT+1
22331      ITEXT(ICNT)='    Estimate of (scaled) Consensus Mean:'
22332      NCTEXT(ICNT)=40
22333      AVALUE(ICNT)=XMP
22334      IDIGIT(ICNT)=NUMDIG
22335      ICNT=ICNT+1
22336      ITEXT(ICNT)='    Between Lab Variance (unscaled):'
22337      NCTEXT(ICNT)=36
22338      AVALUE(ICNT)=S2BMPS
22339      IDIGIT(ICNT)=NUMDIG
22340      ICNT=ICNT+1
22341      ITEXT(ICNT)='    Between Lab SD (unscaled):'
22342      NCTEXT(ICNT)=30
22343      AVALUE(ICNT)=SQRT(S2BMPS)
22344      IDIGIT(ICNT)=NUMDIG
22345      ICNT=ICNT+1
22346      ITEXT(ICNT)='    Between Lab Variance (scaled):'
22347      NCTEXT(ICNT)=34
22348      AVALUE(ICNT)=S2BMP
22349      IDIGIT(ICNT)=NUMDIG
22350      ICNT=ICNT+1
22351      ITEXT(ICNT)='    Standard Deviation of Consensus Mean:'
22352      NCTEXT(ICNT)=41
22353      AVALUE(ICNT)=SEMP
22354      IDIGIT(ICNT)=NUMDIG
22355      ICNT=ICNT+1
22356      ITEXT(ICNT)='    Standard Uncertainty (k = 1):'
22357      NCTEXT(ICNT)=33
22358      AVALUE(ICNT)=SEMP
22359      IDIGIT(ICNT)=NUMDIG
22360      ICNT=ICNT+1
22361      ITEXT(ICNT)='    Expanded Uncertainty (k = 2):'
22362      NCTEXT(ICNT)=33
22363      AVALUE(ICNT)=2.0*SEMP
22364      IDIGIT(ICNT)=NUMDIG
22365      ICNT=ICNT+1
22366      ITEXT(ICNT)='    Expanded Uncertainty (k =           ):'
22367      WRITE(ITEXT(ICNT)(31:40),'(F10.7)')APPF
22368      NCTEXT(ICNT)=42
22369      AVALUE(ICNT)=APPF*SEMP
22370      IDIGIT(ICNT)=NUMDIG
22371      ICNT=ICNT+1
22372      ITEXT(ICNT)='    Normal PPF of 0.975:'
22373      NCTEXT(ICNT)=24
22374      AVALUE(ICNT)=APPF
22375      IDIGIT(ICNT)=NUMDIG
22376      ICNT=ICNT+1
22377      ITEXT(ICNT)='    Lower 95% (normal) Confidence Limit:'
22378      NCTEXT(ICNT)=40
22379      AVALUE(ICNT)=DLOWER
22380      IDIGIT(ICNT)=NUMDIG
22381      ICNT=ICNT+1
22382      ITEXT(ICNT)='    Upper 95% (normal) Confidence Limit:'
22383      NCTEXT(ICNT)=40
22384      AVALUE(ICNT)=DUPPER
22385      IDIGIT(ICNT)=NUMDIG
22386      ICNT=ICNT+1
22387      ITEXT(ICNT)='    Note: Modified Mandel-Paule Best Usage:'
22388      NCTEXT(ICNT)=43
22389      AVALUE(ICNT)=0.0
22390      IDIGIT(ICNT)=-1
22391      ICNT=ICNT+1
22392      ITEXT(ICNT)='          6 or More Labs:'
22393      NCTEXT(ICNT)=25
22394      AVALUE(ICNT)=0.0
22395      IDIGIT(ICNT)=-1
22396C
22397      NUMROW=ICNT
22398      DO310I=1,NUMROW
22399        NTOT(I)=15
22400  310 CONTINUE
22401C
22402      IFRST=.TRUE.
22403      ILAST=.TRUE.
22404      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
22405     1            AVALUE,IDIGIT,
22406     1            NTOT,NUMROW,
22407     1            ICAPSW,ICAPTY,ILAST,IFRST,
22408     1            ISUBRO,IBUGA3,IERROR)
22409      ITITLE=' '
22410      NCTITL=0
22411      ITITLZ=' '
22412      NCTITZ=0
22413      ITITL9=' '
22414      NCTIT9=0
22415C
22416 8000 CONTINUE
22417      XMMPS=REAL(XMPS)
22418      S2BMMP=REAL(S2BMPS)
22419      SEMMP=REAL(STDERR)
22420C
22421C               *****************
22422C               **  STEP 90--  **
22423C               **  EXIT       **
22424C               *****************
22425C
22426      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMPL')THEN
22427        WRITE(ICOUT,999)
22428        CALL DPWRST('XXX','BUG ')
22429        WRITE(ICOUT,9011)
22430 9011   FORMAT('***** AT THE END       OF DPMMPL--')
22431        CALL DPWRST('XXX','BUG ')
22432        WRITE(ICOUT,9012)IERROR
22433 9012   FORMAT('IERROR = ',A4)
22434        CALL DPWRST('XXX','BUG ')
22435        WRITE(ICOUT,9013)NPTS,NLAB
22436 9013   FORMAT('NPTS,NLAB = ',2I8)
22437        CALL DPWRST('XXX','BUG ')
22438        WRITE(ICOUT,9014)XMMPS,S2BMMP,SEMMP
22439 9014   FORMAT('XMMPS,S2BMMP,SEMMP = ',3G15.7)
22440        CALL DPWRST('XXX','BUG ')
22441        WRITE(ICOUT,9015)DLOWER,DUPPER
22442 9015   FORMAT('DLOWER,DUPPER = ',2G15.7)
22443        CALL DPWRST('XXX','BUG ')
22444      ENDIF
22445C
22446      RETURN
22447      END
22448      SUBROUTINE DPMNPL(Y1,Y2,Y3,NPTS,NLAB,
22449     1                  X,T,N,
22450     1                  XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
22451     1                  DLOWMP,DHIGMP,STXMU,ST2SB,
22452     1                  IWRITE,
22453     1                  ICAPSW,ICAPTY,NUMDIG,
22454     1                  ISUBRO,IBUGA3,IERROR)
22455C
22456C     PURPOSE--IMPLEMENT MANDEL-PAULE APPROACH TO CONSENSUS MEANS
22457C     WRITTEN BY--CODE FOR MANDEL-PAULE PROVIDED BY MARK VANGEL.
22458C     PRINTING--YES
22459C     SUBROUTINES NEEDED--MPSUB
22460C     WRITTEN BY--ALAN HECKERT
22461C                 STATISTICAL ENGINEERING DIVISION
22462C                 INFORMATION TECHNOLOGY LABORATORY
22463C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22464C                 GAITHERSBURG, MD 20899-8980
22465C                 PHONE--301-975-2899
22466C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22467C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22468C     LANGUAGE--ANSI FORTRAN (1977)
22469C     VERSION NUMBER--2006/3
22470C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
22471C     UPDATED         --FEBRUARY  2010. USE DPDTA1 TO PRINT
22472C
22473C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
22474C
22475      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
22476      CHARACTER*4 ICAPSW
22477      CHARACTER*4 ICAPTY
22478      CHARACTER*4 ISUBRO
22479      CHARACTER*4 IBUGA3
22480      CHARACTER*4 IERROR
22481C
22482      CHARACTER*4 IWRITE
22483      CHARACTER*4 ISUBN1
22484      CHARACTER*4 ISUBN2
22485C
22486      REAL APPF
22487      REAL XMP
22488      REAL XMPS
22489      REAL S2BMP
22490      REAL S2BMPS
22491      REAL STXMU
22492      REAL ST2SB
22493      REAL SEMP
22494      REAL SEMPK1
22495      REAL SEMPK2
22496C
22497C----------------------------------------------------------------
22498C
22499      REAL Y1(*)
22500      REAL Y2(*)
22501      REAL Y3(*)
22502C
22503      INTEGER N(*)
22504C
22505      DOUBLE PRECISION X(*)
22506      DOUBLE PRECISION T(*)
22507C
22508      COMMON /MPCOM/ T0, T1
22509C
22510      INCLUDE 'DPCOST.INC'
22511C
22512      PARAMETER (MAXROW=20)
22513      CHARACTER*60 ITITLE
22514      CHARACTER*60 ITITLZ
22515      CHARACTER*60 ITITL9
22516      CHARACTER*60 ITEXT(MAXROW)
22517      REAL         AVALUE(MAXROW)
22518      INTEGER      NCTEXT(MAXROW)
22519      INTEGER      IDIGIT(MAXROW)
22520      INTEGER      NTOT(MAXROW)
22521      LOGICAL IFRST
22522      LOGICAL ILAST
22523C
22524      INCLUDE 'DPCOP2.INC'
22525C
22526C-----START POINT------------------------------------------------
22527C
22528      IERROR='NO'
22529      ISUBN1='DPMN'
22530      ISUBN2='PL  '
22531C
22532      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MNPL')THEN
22533        WRITE(ICOUT,999)
22534  999   FORMAT(1X)
22535        CALL DPWRST('XXX','BUG ')
22536        WRITE(ICOUT,51)
22537   51   FORMAT('***** AT THE BEGINNING OF DPMNPL--')
22538        CALL DPWRST('XXX','BUG ')
22539        WRITE(ICOUT,52)NPTS,NLAB,IWRITE
22540   52   FORMAT('NPTS,NLAB,IWRITE = ',2I8,2X,A4)
22541        CALL DPWRST('XXX','BUG ')
22542        DO55I=1,NPTS
22543          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I)
22544   56     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
22545          CALL DPWRST('XXX','BUG ')
22546   55   CONTINUE
22547      ENDIF
22548C
22549      IMANPA='REGU'
22550      CALL MPSUB  (NLAB, N, X, T, DXMP, DS2BMP, IMANPA,IBUGA3)
22551C
22552      IF(IBUGA3.EQ.'ON')THEN
22553        WRITE(ICOUT,999)
22554        CALL DPWRST('XXX','WRIT')
22555        DO102J=1,NLAB
22556        WRITE(ICOUT,101)J,T(J)
22557  101   FORMAT('AFTER MPSUB: J,T(J)=',I8,G15.7)
22558        CALL DPWRST('XXX','WRIT')
22559  102   CONTINUE
22560      ENDIF
22561C
22562      XMP=REAL(DXMP)
22563      S2BMP=REAL(DS2BMP)
22564C
22565      CALL NORPPF(0.975,APPF)
22566      XMPS=REAL((T1-T0)*XMP + T0)
22567      S2BMPS=REAL(((T1-T0)**2)*S2BMP)
22568      DSUM1=0.0D0
22569      DSUM2=0.0D0
22570      DO109J=1,NLAB
22571        TI=DBLE(S2BMPS) + ((T1-T0)**2)*T(J)
22572        XJ=(T1-T0)*X(J) + T0
22573        DSUM1=DSUM1 +  (XJ-DBLE(XMPS))**2/(TI**2)
22574        DSUM2=DSUM2 + 1.0D0/TI
22575  109 CONTINUE
22576C
22577      STDERR=SQRT(DSUM1)/DSUM2
22578      SEMP=REAL(STDERR)
22579      SEMPK1=SEMP
22580      SEMPK2=2.0*SEMP
22581      DLOWER=XMPS - DBLE(APPF)*STDERR
22582      DUPPER=XMPS + DBLE(APPF)*STDERR
22583      DLOWMP=DLOWER
22584      DHIGMP=DUPPER
22585C
22586      IF(IPRINT.EQ.'OFF')GOTO8000
22587C
22588      ITITLE=' '
22589      NCTITL=0
22590      ITITLZ=' '
22591      NCTITZ=0
22592C
22593      ICNT=1
22594      ITEXT(ICNT)=' 1. Method: Mandel-Paule'
22595      NCTEXT(ICNT)=24
22596      AVALUE(ICNT)=0.0
22597      IDIGIT(ICNT)=-1
22598C
22599      ICNT=ICNT+1
22600      ITEXT(ICNT)='    Estimate of (unscaled) Consensus Mean:'
22601      NCTEXT(ICNT)=42
22602      AVALUE(ICNT)=XMPS
22603      IDIGIT(ICNT)=NUMDIG
22604      ICNT=ICNT+1
22605      ITEXT(ICNT)='    Estimate of (scaled) Consensus Mean:'
22606      NCTEXT(ICNT)=40
22607      AVALUE(ICNT)=XMP
22608      IDIGIT(ICNT)=NUMDIG
22609      ICNT=ICNT+1
22610      ITEXT(ICNT)='    Between Lab Variance (unscaled):'
22611      NCTEXT(ICNT)=36
22612      AVALUE(ICNT)=S2BMPS
22613      IDIGIT(ICNT)=NUMDIG
22614      ICNT=ICNT+1
22615      ITEXT(ICNT)='    Between Lab SD (unscaled):'
22616      NCTEXT(ICNT)=30
22617      AVALUE(ICNT)=SQRT(S2BMPS)
22618      IDIGIT(ICNT)=NUMDIG
22619      ICNT=ICNT+1
22620      ITEXT(ICNT)='    Between Lab Variance (scaled):'
22621      NCTEXT(ICNT)=34
22622      AVALUE(ICNT)=S2BMP
22623      IDIGIT(ICNT)=NUMDIG
22624      ICNT=ICNT+1
22625      ITEXT(ICNT)='    Standard Deviation of Consensus Mean:'
22626      NCTEXT(ICNT)=41
22627      AVALUE(ICNT)=SEMP
22628      IDIGIT(ICNT)=NUMDIG
22629      ICNT=ICNT+1
22630      ITEXT(ICNT)='    Standard Uncertainty (k = 1):'
22631      NCTEXT(ICNT)=33
22632      AVALUE(ICNT)=SEMP
22633      IDIGIT(ICNT)=NUMDIG
22634      ICNT=ICNT+1
22635      ITEXT(ICNT)='    Expanded Uncertainty (k = 2):'
22636      NCTEXT(ICNT)=33
22637      AVALUE(ICNT)=2.0*SEMP
22638      IDIGIT(ICNT)=NUMDIG
22639      ICNT=ICNT+1
22640      ITEXT(ICNT)='    Expanded Uncertainty (k =           ):'
22641      WRITE(ITEXT(ICNT)(31:40),'(F10.7)')APPF
22642      NCTEXT(ICNT)=42
22643      AVALUE(ICNT)=APPF*SEMP
22644      IDIGIT(ICNT)=NUMDIG
22645      ICNT=ICNT+1
22646      ITEXT(ICNT)='    Normal PPF of 0.975:'
22647      NCTEXT(ICNT)=24
22648      AVALUE(ICNT)=APPF
22649      IDIGIT(ICNT)=NUMDIG
22650      ICNT=ICNT+1
22651      ITEXT(ICNT)='    Lower 95% (normal) Confidence Limit:'
22652      NCTEXT(ICNT)=40
22653      AVALUE(ICNT)=DLOWER
22654      IDIGIT(ICNT)=NUMDIG
22655      ICNT=ICNT+1
22656      ITEXT(ICNT)='    Upper 95% (normal) Confidence Limit:'
22657      NCTEXT(ICNT)=40
22658      AVALUE(ICNT)=DUPPER
22659      IDIGIT(ICNT)=NUMDIG
22660      ICNT=ICNT+1
22661      ITEXT(ICNT)='    Note: Mandel-Paule Best Usage:'
22662      NCTEXT(ICNT)=34
22663      AVALUE(ICNT)=0.0
22664      IDIGIT(ICNT)=-1
22665      ICNT=ICNT+1
22666      ITEXT(ICNT)='          6 or More Labs:'
22667      NCTEXT(ICNT)=25
22668      AVALUE(ICNT)=0.0
22669      IDIGIT(ICNT)=-1
22670C
22671      NUMROW=ICNT
22672      DO310I=1,NUMROW
22673        NTOT(I)=15
22674  310 CONTINUE
22675C
22676      IFRST=.TRUE.
22677      ILAST=.TRUE.
22678      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
22679     1            AVALUE,IDIGIT,
22680     1            NTOT,NUMROW,
22681     1            ICAPSW,ICAPTY,ILAST,IFRST,
22682     1            ISUBRO,IBUGA3,IERROR)
22683      ITITLE=' '
22684      NCTITL=0
22685      ITITLZ=' '
22686      NCTITZ=0
22687      ITITL9=' '
22688      NCTIT9=0
22689C
22690 8000 CONTINUE
22691      STXMU = DXMP
22692      ST2SB = DS2BMP
22693C
22694C               *****************
22695C               **  STEP 90--  **
22696C               **  EXIT       **
22697C               *****************
22698C
22699      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MNPL')THEN
22700        WRITE(ICOUT,999)
22701        CALL DPWRST('XXX','BUG ')
22702        WRITE(ICOUT,9011)
22703 9011   FORMAT('***** AT THE END       OF DPMNPL--')
22704        CALL DPWRST('XXX','BUG ')
22705        WRITE(ICOUT,9012)IERROR
22706 9012   FORMAT('IERROR = ',A4)
22707        CALL DPWRST('XXX','BUG ')
22708        WRITE(ICOUT,9013)NPTS,NLAB
22709 9013   FORMAT('NPTS,NLAB = ',2I8)
22710        CALL DPWRST('XXX','BUG ')
22711        WRITE(ICOUT,9014)XMPS,S2BMPS,SEMP
22712 9014   FORMAT('XMPS,S2BMPs,SEMP = ',3G15.7)
22713        CALL DPWRST('XXX','BUG ')
22714        WRITE(ICOUT,9015)DLOWER,DUPPER
22715 9015   FORMAT('DLOWER,DUPPER = ',2G15.7)
22716        CALL DPWRST('XXX','BUG ')
22717      ENDIF
22718C
22719      RETURN
22720      END
22721      SUBROUTINE DPMARG(IHARG,IARGT,ARG,NUMARG,PDEFMR,PTEXMR,
22722     1                  IBUGD2,ISUBRO,IFOUND,IERROR)
22723C
22724C     PURPOSE--DEFINE THE MARGIN FOR TEXT CHARACTERS.
22725C              THE MARGIN FOR TEXT CHARACTERS WILL BE PLACED
22726C              IN THE FLOATING POINT VARIABLE PTEXMR.
22727C     NOTE--THE MARGIN IS IN STANDARDIZED UNITS (0.0 TO 100.0).
22728C     NOTE--THE MARGIN DOES NOT INCLUDE BETWEEN-LINE GAP.
22729C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
22730C                     --IARGT
22731C                     --ARG
22732C                     --NUMARG
22733C                     --PDEFMR
22734C                     --IBUGD2
22735C     OUTPUT ARGUMENTS--PTEXMR
22736C                     --IFOUND ('YES' OR 'NO' )
22737C                     --IERROR ('YES' OR 'NO' )
22738C     WRITTEN BY--JAMES J. FILLIBEN
22739C                 STATISTICAL ENGINEERING DIVISION
22740C                 INFORMATION TECHNOLOGY LABORATORY
22741C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22742C                 Gaithersburg, MD 20899-8980
22743C                 PHONE--301-975-2855
22744C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22745C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22746C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
22747C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
22748C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
22749C     LANGUAGE--ANSI FORTRAN (1977)
22750C     VERSION NUMBER--82/7
22751C     ORIGINAL VERSION--APRIL     1981.
22752C     UPDATED         --MAY       1982.
22753C
22754C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
22755C
22756      CHARACTER*4 IHARG
22757      CHARACTER*4 IARGT
22758      CHARACTER*4 IBUGD2
22759      CHARACTER*4 ISUBRO
22760      CHARACTER*4 IFOUND
22761      CHARACTER*4 IERROR
22762C
22763C---------------------------------------------------------------------
22764C
22765      DIMENSION IHARG(*)
22766      DIMENSION IARGT(*)
22767      DIMENSION ARG(*)
22768C
22769C---------------------------------------------------------------------
22770C
22771      INCLUDE 'DPCOP2.INC'
22772C
22773C-----START POINT-----------------------------------------------------
22774C
22775      IFOUND='NO'
22776      IERROR='NO'
22777C
22778      IF(IBUGD2.EQ.'OFF')GOTO90
22779      WRITE(ICOUT,999)
22780  999 FORMAT(1X)
22781      CALL DPWRST('XXX','BUG ')
22782      WRITE(ICOUT,51)
22783   51 FORMAT('***** AT THE BEGINNING OF DPMARG--')
22784      CALL DPWRST('XXX','BUG ')
22785      WRITE(ICOUT,53)PDEFMR
22786   53 FORMAT('PDEFMR = ',E15.7)
22787      CALL DPWRST('XXX','BUG ')
22788      WRITE(ICOUT,54)NUMARG
22789   54 FORMAT('NUMARG = ',I8)
22790      CALL DPWRST('XXX','BUG ')
22791      DO55I=1,NUMARG
22792      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
22793   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
22794      CALL DPWRST('XXX','BUG ')
22795   55 CONTINUE
22796   90 CONTINUE
22797C
22798C               *****************************
22799C               **  TREAT THE MARGIN CASE  **
22800C               *****************************
22801C
22802      IF(NUMARG.LE.0)GOTO1150
22803      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
22804      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
22805      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
22806      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
22807      IF(IHARG(NUMARG).EQ.'?')GOTO8100
22808C
22809      IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')
22810     1GOTO1160
22811C
22812      IERROR='YES'
22813      WRITE(ICOUT,1121)
22814 1121 FORMAT('***** ERROR IN DPMARG--')
22815      CALL DPWRST('XXX','BUG ')
22816      WRITE(ICOUT,1122)
22817 1122 FORMAT('      ILLEGAL FORM FOR MARGIN ',
22818     1'COMMAND.')
22819      CALL DPWRST('XXX','BUG ')
22820      WRITE(ICOUT,1124)
22821 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
22822     1'PROPER FORM--')
22823      CALL DPWRST('XXX','BUG ')
22824      WRITE(ICOUT,1125)
22825 1125 FORMAT('      SUPPOSE IT IS DESIRED (AFTER THE TEXT COMMAND)')
22826      CALL DPWRST('XXX','BUG ')
22827      WRITE(ICOUT,1126)
22828 1126 FORMAT('      THAT THE CURSOR RETURN TO X = 5')
22829      CALL DPWRST('XXX','BUG ')
22830      WRITE(ICOUT,1127)
22831 1127 FORMAT('      (WHERE THE HORIZONTAL SCREEN UNITS RANGE')
22832      CALL DPWRST('XXX','BUG ')
22833      WRITE(ICOUT,1128)
22834 1128 FORMAT('      FROM 0 TO 100,')
22835      CALL DPWRST('XXX','BUG ')
22836      WRITE(ICOUT,1130)
22837 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
22838      CALL DPWRST('XXX','BUG ')
22839      WRITE(ICOUT,1131)
22840 1131 FORMAT('           MARGIN 5 ')
22841      CALL DPWRST('XXX','BUG ')
22842      GOTO9000
22843C
22844 1150 CONTINUE
22845      PTEXMR=PDEFMR
22846      GOTO1180
22847C
22848 1160 CONTINUE
22849      PTEXMR=ARG(NUMARG)
22850      GOTO1180
22851C
22852 1180 CONTINUE
22853      IFOUND='YES'
22854C
22855      IF(IFEEDB.EQ.'OFF')GOTO1189
22856      WRITE(ICOUT,999)
22857      CALL DPWRST('XXX','BUG ')
22858      WRITE(ICOUT,1181)
22859 1181 FORMAT('THE MARGIN (AFTER TEXT IS WRITTEN OUT)')
22860      CALL DPWRST('XXX','BUG ')
22861      WRITE(ICOUT,1182)PTEXMR
22862 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
22863      CALL DPWRST('XXX','BUG ')
22864 1189 CONTINUE
22865      GOTO9000
22866C
22867C               ********************************************
22868C               **  STEP 81--                             **
22869C               **  TREAT THE    ?    CASE--              **
22870C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
22871C               ********************************************
22872C
22873 8100 CONTINUE
22874      IFOUND='YES'
22875      WRITE(ICOUT,999)
22876      CALL DPWRST('XXX','BUG ')
22877      WRITE(ICOUT,8111)PTEXMR
22878 8111 FORMAT('THE CURRENT (TEXT) MARGIN IS ',E15.7)
22879      CALL DPWRST('XXX','BUG ')
22880      WRITE(ICOUT,8112)PDEFMR
22881 8112 FORMAT('THE DEFAULT (TEXT) MARGIN IS ',E15.7)
22882      CALL DPWRST('XXX','BUG ')
22883      GOTO9000
22884C
22885C               *****************
22886C               **  STEP 90--  **
22887C               **  EXIT       **
22888C               *****************
22889C
22890 9000 CONTINUE
22891      IF(IBUGD2.EQ.'OFF')GOTO9090
22892      WRITE(ICOUT,999)
22893      CALL DPWRST('XXX','BUG ')
22894      WRITE(ICOUT,9011)
22895 9011 FORMAT('***** AT THE END       OF DPMARG--')
22896      CALL DPWRST('XXX','BUG ')
22897      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
22898 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
22899      CALL DPWRST('XXX','BUG ')
22900      WRITE(ICOUT,9013)PTEXMR
22901 9013 FORMAT('PTEXMR = ',E15.7)
22902      CALL DPWRST('XXX','BUG ')
22903 9090 CONTINUE
22904C
22905      RETURN
22906      END
22907CCCCC SUBROUTINE DPMATC(ICASL7,ILOCV,IFTEXP,
22908      SUBROUTINE DPMATC(ICASL7,ICASS7,ISTANR,ILOCV,IFTEXP,IFTORD,ISEED,
22909     1                  IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
22910CCCCC OCTOBER 1998.  SPLIT INTO 2 FILES (LAHEY COMPILER
22911CCCCC SEEMS TO HAVE MEMORY TROUBLES WITH THE FULL ROUTINE).
22912CCCCC ESSENTIALLY, SPLIT OUT THE MATRIX AND NON-MATRIX COMMANDS.
22913C
22914C     PURPOSE--TREAT THE TYPE 7 LET CASE--
22915C            --NOTE: MATRIX COMMANDS NOW IMPLEMENTED IN DPMAT2
22916C              (THESE COMMANDS WILL SIMPLY DO A RETURN FROM THIS
22917C              ROUTINE)
22918C                      LET Y = SORT X
22919C                      LET Y1 Y2 = SORT2 X1 X2
22920C                      LET Y1 Y2 Y3 = SORT3 X1 X2 X3
22921C                      LET Y1 Y2 Y3 Y4 = SORT3 X1 X2 X3 X4
22922C                      LET Y = SORTC X X2
22923C                      LET Y = COCODE X XREF
22924C                      LET Y = COCOPY X XREF YREF
22925C                      LET Y = RANK X
22926C                      LET Y = RANK INDEX  X
22927C                      LET Y = PERCENTAGE RANK X
22928C                      LET Y1 Y2 = RANK2 X1 X2
22929C                      LET Y1 Y2 Y3 = RANK2 X1 X2 X3
22930C                      LET Y = CODE  X
22931C                      LET Y = CODEH  X
22932C                      LET Y = CODE2  X
22933C                      LET Y = CODE4  X
22934C                      LET Y = CODE4  X
22935C                      LET Y = CODE8  X
22936C                      LET Y = CODE10  X
22937C                      LET Y = CODEZ  X
22938C                      LET Y = CODEX  X
22939C                      LET Y = CODEDEX X
22940C                      LET Y = CODE DEX X
22941C                      LET Y = CODE DEX 2-LEVEL X
22942C                      LET Y = EXPAND  XLAB XVAL
22943C                      LET Y = CODE CROSS TABULATE X1 X2
22944C                      LET Y = CODE CROSS TABULATE X1 X2 X3
22945C                      LET Y = CODE CROSS TABULATE X1 X2 X3 X4
22946C                      LET Y = CODE CROSS TABULATE X1 X2 X3 X4 X5
22947C                      LET Y = CODE CROSS TABULATE X1 X2 X3 X4 X5 X6
22948C                      LET Y = BIWEIGHT X
22949C                      LET Y = TRICUBE X
22950C                      LET Y = BOOTSTRAP SAMPLE X1 X2
22951C                      LET Y = SUBSAMPLE X1 X2
22952C                      LET Y = JACKNIFE INDEX I N
22953C                      LET Y TAG = SAMPLE RANDOM PERMUTATION N NKEEP P NITER
22954C                      LET Y = GATHER X INDEX
22955C                      LET Y = SCATTER X INDEX
22956C                      LET Y = SHIFT X NSHIFT
22957C                      LET Y = COMBINE Y1 Y2 .... YK
22958C                      LET TAG = KEEP GROUPID XREF
22959C                      LET TAG = OMIT GROUPID XREF
22960C                      LET Y2 TAG = THRESHOLD MINIMUM Y TVAL
22961C                      LET Y2 TAG = THRESHOLD MAXIMUM Y TVAL
22962C                      LET Y = DIGITS X
22963C                      LET Y = LARGEST X NVALUES
22964C                      LET Y = SMALLEST X NVALUES
22965C                      LET Y = BREAK LOCATIONS X
22966C                      LET Y = FRAGMENT LOCATIONS X
22967C                      LET Y = FRAGMENT LENGTHS X
22968C                      LET Y1 Y2 = 2D GRID X1 X2
22969C                      LET Y1 Y2 Y3 = 3D GRID X1 X2 X3
22970C                      LET Y1 Y2 Y3 Y4 = 4D GRID X1 X2 X3 X4
22971C
22972C                      LET Y = FREQUENCY X XD
22973C                      LET Y = DISTINCT X
22974C                      LET Y = DIFFERENCE X
22975C                      LET Y = SEQUENTIAL DIFFERENCE X
22976C                      LET Y = SEQUENTIAL SUM X
22977C                      LET Y = SEQUENTIAL MEAN X
22978C                      LET Y = SEQUENTIAL MINIMUM X
22979C                      LET Y = SEQUENTIAL MAXIMUM X
22980C                      LET Y = SEQUENTIAL PRODUCT X
22981C                      LET Y = SEQUENTIAL LOWER X
22982C                      LET Y = SEQUENTIAL UPPER X
22983C                      LET Y = INTERARRIVAL TIMES X
22984C                      LET Y = CUMULATIVE DIFFERENCE X
22985C                      LET Y = CUMULATIVE SUM X
22986C                      LET Y = CUMULATIVE INTEGRAL X
22987C                      LET Y = CUMULATIVE PRODUCT X
22988C                      LET Y = CUMULATIVE MEAN X
22989C                      LET Y = CUMULATIVE MINIMUM X
22990C                      LET Y = CUMULATIVE MAXIMUM X
22991C                      LET Y = CUMULATIVE <STAT> X
22992C                      LET Z = CONVOLUTION X Y
22993C                      LET Z = DECONVOLUTION X Y
22994C                      LET Y = SUMD X XD  (NOT IMPLEMENTED)
22995C                      LET Y2 = INTERPOLATION Y X X2
22996C                      LET Y2 = LINEAR INTERPOLATION Y X X2
22997C                      LET Z2 = 2D INTERPOLATION Z Y X Y2 X2
22998C                      LET Z2 = BILINEAR INTERPOLATION Z Y X Y2 X2
22999C                      LET Z2 = BIVARIATE INTERPOLATION Z Y X Y2 X2
23000C                      LET Y2 = HERMITE INTERPOLATION Y X X2
23001C                      LET Y2 = HERMITE DERIVATIVE Y X X2
23002C                      LET Y2 = HERMITE INTERGRATION Y X LOWLIM UPPLIM
23003C
23004C                      LET T = SINE TRANSFORM Y
23005C                      LET T = COSINE TRANSFORM Y
23006C                      LET T1 T2 = FOURIER TRANSFORM Y1 Y2 (OR JUST Y1)
23007C                      LET T1 T2 = INVERSE FOURIER TRANSFORM Y1 Y2 (OR JUST Y1)
23008C                      LET T1 T2 = FFT Y1 Y2
23009C                      LET T1 T2 = INVERSE FFT Y1 Y2
23010C                      LET T = LAPLACE TRANSFORM Y  (NOT IMPLEMENTED)
23011C                      LET T = INVERSE LAPLACE TRANSFORM Y (NOT IMPLENETED)
23012C                      LET Y2 = LOW  PASS FILTER Y
23013C                      LET Y2 = HIGH PASS FILTER Y
23014C
23015C                      LET Y5 Y6 = COMPLEX ADDITION Y1 Y2 Y3 Y4
23016C                      LET Y5 Y6 = COMPLEX SUBTRACTION Y1 Y2 Y3 Y4
23017C                      LET Y5 Y6 = COMPLEX MULTIPLICATION Y1 Y2 Y3 Y4
23018C                      LET Y5 Y6 = COMPLEX DIVISION Y1 Y2 Y3 Y4
23019C                      LET Y5 Y6 = COMPLEX EXPONENTIATION Y1 Y2
23020C                      LET Y5 Y6 = COMPLEX SQUARE ROOT Y1 Y2
23021C                      LET Y5 Y6 = COMPLEX ROOTS Y1 Y2 (OR JUST Y1)
23022C                      LET Y5 Y6 = COMPLEX CONJUGATE Y1 Y2
23023C
23024C                      LET C3 = POLYNOMIAL ADDITION C1 C2
23025C                      LET C3 = POLYNOMIAL SUBTRACTION C1 C2
23026C                      LET C3 = POLYNOMIAL MULTIPLICATION C1 C2
23027C                      LET C3 = POLYNOMIAL DIVISION C1 C2
23028C                      LET C3 = POLYNOMIAL SQUARE C1
23029C                      LET C3 = POLYNOMIAL SQUARE ROOT C1  (FUTURE--NOT YET IMP)
23030C                      LET C3 = POLYNOMIAL GCD C1 C2       (FUTURE--NOT YET IMP)
23031C                      LET C3 = POLYNOMIAL LCM C1 C2       (FUTURE--NOT YET IMP)
23032C                      LET Y  = POLYNOMIAL EVALUATION C X
23033C
23034C                      LET V3 = VECTOR ADDITION V1 V2
23035C                      LET V3 = VECTOR SUBTRACTION V1 V2
23036C                      LET V3 = VECTOR DOT PRODUCT V1 V2 (INNER PRODUCT)
23037C                      LET V3 = VECTOR CROSS PRODUCT V1 V2 (FUTURE--NOT YET IMP)
23038C                      LET V3 = VECTOR LENGTH V1
23039C                      LET V3 = VECTOR DISTANCE V1 V2
23040C                      LET V3 = VECTOR ANGLE V1 V2
23041C
23042C                      LET S3 = SET UNION S1 S2
23043C                      LET S3 = SET INTERSECTION S1 S2
23044C                      LET S3 = SET COMPLEMENT S1 S2
23045C                      LET S3 = SET CARDINALITY S1
23046C                      LET S3 S4 = SET CARTESIAN PRODUCT S1 S2
23047C                      LET S3 = SET ELEMENTS S1    (DISTINCT)
23048C
23049C                      LET L3 = LOGICAL AND L1 L2 (CONJUNCTION)
23050C                      LET L3 = LOGICAL OR L1 L2 (DISJUNCTION)
23051C                      LET L3 = LOGICAL NAND L1 L2
23052C                      LET L3 = LOGICAL NOR L1 L2
23053C                      LET L3 = LOGICAL IFTHEN L1 L2 (IMPLICATION)
23054C                      LET L3 = LOGICAL IFF L1 L2 (EQUIVALENCE)
23055C                      LET L3 = LOGICAL NOT L1  (NEGATION OR COMPLEMENT)
23056C                      LET L3 = LOGICAL XOR L1 L2 (EXCLUS. OR OR EXCL. DISJ.)
23057C
23058C                      (FOR A FULL OR PARTIAL DATA SET)
23059C
23060C                      LET X2 Y2 = FRACTAL X1 Y1
23061C
23062C                      LET C3 = GENERATOR MULTIPLICATION C1 C2
23063C
23064C                      LET Y2 = CUSUM ARL Y
23065C                      LET Y2 = ONE-SIDED CUSUM ARL Y
23066C
23067C                      LET Y2 = STANDARDIZE Y  (OR ZSCORE, ZSCORE STAN)
23068C                      LET Y2 = STANDARDIZE Y GROUP1
23069C                      LET Y2 = STANDARDIZE Y GROUP1 GROUP2
23070C                      LET Y2 = LOCATION STANDARDIZE Y
23071C                      LET Y2 = LOCATION STANDARDIZE Y GROUP1
23072C                      LET Y2 = LOCATION STANDARDIZE Y GROUP1 GROUP2
23073C                      LET Y2 = SCALE STANDARDIZE Y
23074C                      LET Y2 = SCALE STANDARDIZE Y GROUP1
23075C                      LET Y2 = SCALE STANDARDIZE Y GROUP1 GROUP2
23076C                      LET Y2 = ZSCORE Y
23077C                      LET Y2 = ZSCORE Y GROUP1
23078C                      LET Y2 = ZSCORE Y GROUP1 GROUP2
23079C                      LET Y2 = USCORE Y
23080C                      LET Y2 = USCORE Y GROUP1
23081C                      LET Y2 = USCORE Y GROUP1 GROUP2
23082C                      LET Y2 = JSCORE Z ROUNDID
23083C                      LET Y2 ROUND2 MAT2 = JSCORE Z ROUNDID MATID
23084C                      LET Y2 = ISO 13528 EN  Y ULAB XREF UREF
23085C                      LET Y2 = ISO 13528 ZSCORE  Y XREF SIGMA
23086C                      LET Y2 = ISO 13528 ZPRIME SCORE Y XREF SIGMA UREF
23087C                      LET Y2 = ISO 13528 ZETA SCORE Y ULAB XREF UREF
23088C                      LET Y2 = ISO 13528 EZMINUS SCORE Y ULAB XREF UREF
23089C                      LET Y2 = ISO 13528 EZPLUS SCORE Y ULAB XREF UREF
23090C                      LET Y2 = ISO 13528 PA Y XREF DELTAE
23091C                      LET Y2 = ISO 13528 DIPERC Y XREF
23092C                      LET Y2 = RANDOM ERROR QUANTITY X Y
23093C                      LET Y2 = CROSS TABULATE <STAT> Y
23094C                      LET Y2 = CROSS TABULATE <STAT> Y GROUP1
23095C                      LET Y2 = CROSS TABULATE <STAT> Y GROUP1 GROUP2
23096C                      LET Y2 = CROSS TABULATE <STAT> Y GROUP1 GROUP2 GROUP3
23097C                      LET Y2 = CROSS TABULATE <STAT> Y GROUP1 GROUP2 GROUP3 GROUP4
23098C                      LET Y2 = CROSS TABULATE CUMULATIVE <STAT> Y
23099C                      LET Y2 = CROSS TABULATE CUMULATIVE <STAT> Y GROUP1
23100C                      LET Y2 = CROSS TABULATE CUMULATIVE <STAT> Y GROUP1 GROUP2
23101C                      LET Y2 = CROSS TABULATE CUMULATIVE <STAT> Y GROUP1 GROUP2 GROUP3
23102C                      LET Y2 = CROSS TABULATE CUMULATIVE <STAT> Y GROUP1 GROUP2 GROUP3 GROUP4
23103C                      LET Y = MOVING <STAT> Y1 ... Y3
23104C                      LET Y = WINDOW <STAT> Y1 ... Y3
23105C                      LET INDX = MATCH Y X
23106C                      LET Y2 = MATCH X X2 Y
23107C                      LET Y2 = CELL MATCH X VALUE
23108C                      LET Y2 = REPLACE X X2
23109C                      LET Y2 = REPLACE X X2 Y
23110C                      LET Y2 = WINSORIZED Y
23111C                      LET Y2 = SORT BY <STAT> Y GROUP1
23112C
23113C                      LET Y X = STACK X1 ... XK
23114C                      LET Y X1 X2 = REPLICATED STACK X1 ... XK LAB
23115C                      LET Y2 = SHUFFLE GROUPS Y X INDEX
23116C                      LET Z  = UNSTACK Y X
23117C                      LET Y3 = INSERT Y1 Y2 NLOC
23118C
23119C                      LET Y2 X2 = BINNED Y  (OR FREQUENCY TABLE)
23120C                      LET Y2 X2 CODE = CODED BINNED Y
23121C                      LET Y2 X2 = ASH BINNED Y
23122C                      LET Y2 X2 = COUNTS ASH BINNED Y
23123C                      LET Y = FREQUENCY TO RAW X FREQ
23124C                      LET Y2 X1 X2 = COMBINE FREQUENCY TABLE Y X
23125C                      LET Y2 X1 X2 = INTEGER FREQUENCY TABLE Y
23126C                      LET Y2 X2 = PEAKS OF FREQUENCY TABLE Y
23127C                      LET X FREQ CDF = MANN WHITNEY U STATISTIC FREQUENCY N1 N2
23128C                      LET Y2 X2 = EMPIRICAL QUANTILE FUNCTION Y
23129C                      LET Y2 X2 = INFORMATIVE QUANTILE FUNCTION Y
23130C                      LET Y2 X2 = TRUNCATED INFORMATIVE QUANTILE FUNCTION Y
23131C                      LET Y2 X2 = PEAKS Y X
23132C                      LET AREA = PEAKS TRIANGLE AREAS Y X
23133C
23134C                      LET Y = BRITTLE FIBER WEIBULL PDF
23135C                              X L P GAMMA LOC SCALE
23136C                      LET Y = BRITTLE FIBER WEIBULL CDF
23137C                              X L P GAMMA LOC SCALE
23138C                      LET Y = BRITTLE FIBER WEIBULL PPF
23139C                              X L P GAMMA LOC SCALE
23140C
23141C                      LET Y = END EFFECTS WEIBULL PDF
23142C                              X L P GAMMA1 SCALE1 GAMMA2 SCALE2 LOC
23143C                      LET Y = END EFFECTS WEIBULL CDF
23144C                              X L P GAMMA1 SCALE1 GAMMA2 SCALE2 LOC
23145C                      LET Y = END EFFECTS WEIBULL PPF
23146C                              X L P GAMMA1 SCALE1 GAMMA2 SCALE2 LOC
23147C
23148C                      LET Y X = NORMAL KERNEL DENSITY MIXTURE YMEAN YSD
23149C
23150C                      LET Y = H CONSISTENCY STATISTIC Y X
23151C                      LET Y = K CONSISTENCY STATISTIC Y X
23152C
23153C                      LET Y = L MOMENTS X NMOM
23154C                      LET Y = PROBABILITY WEIGHTED MOMENTS X NMOM
23155C                      LET Y = BETA PROBABILITY WEIGHTED MOMENTS X NMOM
23156C                      LET Y = WEIBULL MOMENT ESTIMATES X
23157C                      LET Y = LOGNORMAL MOMENT ESTIMATES X
23158C                      LET Y = GAMMA MOMENT ESTIMATES X
23159C                      LET Y = INVERSE GAUSSIAN MOMENT ESTIMATES X
23160C
23161C                      LET Y = JITTER X DELTA
23162C
23163C                      LET AL AU = AGRESTI COULL LIMITS P N ALPHA
23164C                      LET AL = EXACT BINOMIAL LOWER LIMIT P N ALPHA
23165C                      LET AU = EXACT BINOMIAL UPPER LIMIT P N ALPHA
23166C                      LET AL AU = EXACT BINOMIAL CONFIDENCE LIMIT P N ALPHA
23167C                      LET AL AU = DIFFERENCE OF PROPORTION CONFIDENCE
23168C                                  LIMITS P1 N1 P2 N2 ALPHA
23169C                      LET PVAL = DIFFERENCE OF PROPORTION HYPOTHESIS
23170C                                 TEST P1 N1 P2 N2 ALPHA
23171C                      LET PVAL = DIFFERENCE OF PROPORTION LOWER TAIL
23172C                                 HYPOTHESIS TEST P1 N1 P2 N2 ALPHA
23173C                      LET PVAL = DIFFERENCE OF PROPORTION UPPER TAIL
23174C                                 HYPOTHESIS TEST P1 N1 P2 N2 ALPHA
23175C                      LET PVAL ALOWLM AUPPLM = RUHKIN 1 TEST
23176C                                 P1 N1 P2 N2 P3 N3 ALPHA
23177C                      LET PVAL ALOWLM AUPPLM = RUHKIN 1 LOWER TAIL TEST
23178C                                 P1 N1 P2 N2 P3 N3 ALPHA
23179C                      LET PVAL ALOWLM AUPPLM = RUHKIN 1 UPPER TAIL TEST
23180C                                 P1 N1 P2 N2 P3 N3 ALPHA
23181C                      LET PVAL ALOWLM AUPPLM = RUHKIN 2 TEST
23182C                                 P1 N1 P2 N2 ALPHA
23183C                      LET PVAL ALOWLM AUPPLM = RUHKIN 2 LOWER TAIL TEST
23184C                                 P1 N1 P2 N2 ALPHA
23185C                      LET PVAL ALOWLM AUPPLM = RUHKIN 2 UPPER TAIL TEST
23186C                                 P1 N1 P2 N2 ALPHA
23187C                      LET PVAL ALOWLM AUPPLM = RUHKIN 3 TEST
23188C                                 P1 N1 P2 N2 P3 N3 P4 N4 ALPHA
23189C                      LET PVAL ALOWLM AUPPLM = RUHKIN 3 LOWER TAIL TEST
23190C                                 P1 N1 P2 N2 P3 N3 P4 N4 ALPHA
23191C                      LET PVAL ALOWLM AUPPLM = RUHKIN 3 UPPER TAIL TEST
23192C                                 P1 N1 P2 N2 P3 N3 P4 N4 ALPHA
23193C                      LET ALOWLM AUPPLM = BINOMIAL RATIO CONFIDENCE LIMITS
23194C                                          P1 N1 P2 N2 ALPHA
23195C                      LET SE ALOWLM AUPPLM = BINOMIAL PRODUCT CONFIDENCE LIMITS
23196C                                          P1 N1 P2 N2 ALPHA
23197C
23198C                      LET ZY ZX = 2D CONVEX HULL Y X
23199C                      LET Y = POINT IN POLYGON XVAL YVAL XPOLY YPOLY
23200C                      LET ZY ZX = TRANSFORM POINTS Y X  TX TY SX SY THETA
23201C                      LET ZY ZX = EXTREME POINTS Y X
23202C                      LET ZY ZX = ENCLOSING RECTANGLE Y X
23203C                      LET ZY ZX = LINE INTERSECTIONS  X1 Y1 X2 Y2
23204C                                                      X3 Y3 X4 Y4
23205C                      LET ZY ZX = PARALLEL LINE X1 Y1 X2 Y2 X3 Y3
23206C                      LET ZY ZX = PERPINDICULAR LINE X1 Y1 X2 Y2 X3 Y3
23207C
23208C                      LET Y2 X2 TAG = EDGES TO VERTICES EDGE1 EDGE2 Y X
23209C                      LET Y2 X2 TAG = SPANNING FOREST EDGE1 EDGE2 Y X
23210C                      LET EDGE1 EDGE2 TAG NV = SPANNING FOREST
23211C                                               EDGE1 EDGE2 NVERT
23212C                      LET YINDEX = NEAREST NEIGHBOR INDEX Y1 X1
23213C                      LET YDIST  = NEAREST NEIGHBOR DISTANCE Y1 X1
23214C                      LET YINDEX YDIST = NEAREST NEIGHBOR Y1 X1
23215C                      LET YINDEX = NEAREST NEIGHBOR Y1 X1
23216C                      LET Y3 X3 TAG3 = NEAREST NEIGHBOR JOIN Y1 X1 YINDEX
23217C                      LET Y3 X3 YDIST  = FIRST NEAREST NEIGHBOR
23218C                                         Y1 X1 Y2 X2
23219C                      LET Y3 X3 YDIST TAG1 TAG2 = ALL NEAREST NEIGHBORS
23220C                                         Y1 X1 Y2 X2
23221C
23222C                      LET Y = NEXT SUBSET N YPREV
23223C                      LET Y = NEXT PERMUTATION N YPREV
23224C                      LET Y = NEXT K-SET OF N-SET N K YPREV
23225C                      LET Y = NEXT COMPOSITION N K YPREV
23226C                      LET Y YREP = NEXT PARTITION N YPREV YREPPREV
23227C                      LET Y1 Y2 = NEXT EQUIVALENCE RELATION N YPREV YREPPREV
23228C                      LET Y = NEXT YOUNG TABLEAUX N LAMBDA Y
23229C                      LET VAL ROWID = CONVERT YOUNG TABLEAUX Y
23230C                      LET HOOK = YOUNG TABLEAUX HOOK LENGTH VAL ROWID
23231C
23232C                      LET YMIN YMAX = YFRAME Y
23233C                      LET XMIN XMAX = XFRAME X
23234C                      LET YOUT = YTIC SCREEN COORDINATES
23235C                      LET YOUT = YTIC DATA COORDINATES
23236C                      LET YOUT = XTIC SCREEN COORDINATES
23237C                      LET YOUT = XTIC DATA COORDINATES
23238C
23239C                      LET Y = VECTOR PERCENTILE X NPERC
23240C
23241C                      LET WSDF POOLSD = VARIANCES WELCH SATTERTHWAITE YVAR YDF
23242C                      LET WSDF        = GUM       WELCH SATTERTHWAITE YSD  YDF YSENS
23243C
23244C     NOTE--THIS SUBROUTINE OPERATES ON A VECTOR AND PRODUCES A VECTOR;
23245C           THIS IS TO BE CONTRASTED WITH DPLET8 WHICH OPERATES ON A
23246C           VECTOR BUT PRODUCES A PARAMETER (= A SCALAR).
23247C     WRITTEN BY--JAMES J. FILLIBEN
23248C                 STATISTICAL ENGINEERING DIVISION
23249C                 INFORMATION TECHNOLOGY LABORATORY
23250C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23251C                 GAITHERSBURG, MD 20899-8980
23252C                 PHONE--301-975-2855
23253C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23254C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23255C     LANGUAGE--ANSI FORTRAN (1977)
23256C     VERSION NUMBER--87/10
23257C     ORIGINAL VERSION--MARCH 1978.
23258C     UPDATED         --JULY      1978.
23259C     UPDATED         --NOVEMBER  1978.
23260C     UPDATED         --FEBRUARY  1979.
23261C     UPDATED         --MARCH     1979.
23262C     UPDATED         --APRIL     1979.
23263C     UPDATED         --JULY      1979.
23264C     UPDATED         --JUNE      1981.
23265C     UPDATED         --JULY      1981.
23266C     UPDATED         --SEPTEMBER 1981.
23267C     UPDATED         --OCTOBER   1981.
23268C     UPDATED         --NOVEMBER  1981.
23269C     UPDATED         --DECEMBER  1981.
23270C     UPDATED         --MAY       1982.
23271C     UPDATED         --JANUARY   1987.
23272C     UPDATED         --APRIL     1987.
23273C     UPDATED         --AUGUST    1987.  COMPLEX SQUARE ROOT
23274C     UPDATED         --AUGUST    1987.  COMPLEX ROOTS (POLYNOMIAL)
23275C     UPDATED         --AUGUST    1987.  ARITHMETIC
23276C     UPDATED         --AUGUST    1987.  VECTOR ARITHMETIC
23277C     UPDATED         --AUGUST    1987.  SET ARITHMETIC
23278C     UPDATED         --AUGUST    1987.  LOGICAL ARITHMETIC
23279C     UPDATED         --SEPTEMBER 1987.  FFT AND INVERSE FFT
23280C     UPDATED         --SEPTEMBER 1987.  MATRIX OPERATIONS
23281C     UPDATED         --SEPTEMBER 1987.  COMPLEX CONJUGATE
23282C     UPDATED         --NOVEMBER  1987.  (EXIT OUT IF ERROR)
23283C     UPDATED         --FEBRUARY  1988.  (BIWEIGHT AND TRICUBE)
23284C     UPDATED         --JULY      1988.  FRACTAL
23285C     UPDATED         --AUGUST    1988.  LENGTH TRAP FOR FRACTAL
23286C     UPDATED         --JANAURY   1988.  BOOTSTRAP SAMPLE
23287C     UPDATED         --AUGUST    1988.  (VARIANCE-COVARIANCE MATRIX)
23288C     UPDATED         --AUGUST    1988.  (CORRELATION MATRIX)
23289C     UPDATED         --AUGUST    1988.  (PRINCIPLE COMPONENTS)
23290C     UPDATED         --AUGUST    1988.  (... PRINCIPLE COMPONENTS)
23291C     UPDATED         --JANUARY   1989.  FIX A FORMAT STATEMENT (ALAN)
23292C     UPDATED         --NOVEMBER  1989.  FIX INTERPOLATION
23293C     UPDATED         --DECEMBER  1989.  (DEX) GENERATOR MULTIPLICATION
23294C     UPDATED         --JANUARY   1990.  SUBSAMPLE
23295C     UPDATED         --JULY      1991.  COCODE ('COCD')
23296C     UPDATED         --JULY      1991.  COCOPY ('COCP')
23297C     UPDATED         --FEBRUARY  1992.  FIX COCOPY ('COCP')
23298C     UPDATED         --MARCH     1992. EXT. SORT&CARRY TO MULTI ARGS
23299C     UPDATED         --MARCH     1992. ID IN ALL ERROR STATEMENTS
23300C     UPDATED         --APRIL     1992. SPLIT LONG FORMAT STATEMENTS
23301C     UPDATED         --MAY       1992. FIX IF .AND. IF
23302C     UPDATED         --MAY       1992. FIX COMPLEX ARITH./SUBSET BUG
23303C     UPDATED         --MAY       1992. FIX COMPLEX ARITH./SUBSET BUG
23304C                     --MAY       1992.(SHOULD FOR POLARI,LOGARI,..?)
23305C     UPDATED         --JULY      1993. UPDATES FOR MATRIX CODE
23306C     UPDATED         --AUGUST    1993. UPDATES FOR MATRIX CODE
23307C     UPDATED         --SEPTEMBER 1993. UPDATES FOR MATRIX CODE
23308C     UPDATED         --SEPTEMBER 1993. FIX BUG FOR COMPLEX ROOTS
23309C     UPDATED         --OCTOBER   1993. JACNIFE INDEX
23310C     UPDATED         --OCTOBER   1993. ADDITIONAL MATRIX COMMANDS
23311C     UPDATED         --MAY       1994. LINEAR INTERPOLATE, 2D INTERPOL
23312C                                       BILINEAR INTERPOLATE, BIVARIATE
23313C                                       INTERPOLATE
23314C     UPDATED         --JUNE      1995. BUG IN MATRIX REPLACE ELEMENT
23315C     UPDATED         --AUGUST    1995. ZERO PADDING NO LONGER REQUIRED
23316C                                       FOR FFT.
23317C     UPDATED         --JANUARY   1998. RECODE MATRIX CODE TO USE FEWER
23318C                                       MATRICES (AND THUS CAN HANDLE
23319C                                       LARGER MATRICES).
23320C     UPDATED         --JANUARY   1998. RECODE MATRIX CODE TO USE
23321C                                       1-DIMENSIONAL SCRATCH ARRAYS
23322C                                       (WILL BE 2-D IN MATARI, MATAR2)
23323C     UPDATED         --MAY       1998. INTERARRIVAL TIMES CASE
23324C     UPDATED         --MAY       1998. CUMULATIVE AVERAGE CASE
23325C     UPDATED         --MAY       1998. REVERSE CASE
23326C     UPDATED         --MAY       1998. CUMULATIVE HAZARD CASE
23327C     UPDATED         --MAY       1998. HAZARD CASE
23328C     UPDATED         --SEPTEMBER 1998. EXPONENTIAL SMOOTHING
23329C     UPDATED         --JUNE      1998. SOME NEW MATRIX COMMANDS
23330C     UPDATED         --AUGUST    1998. MATRIX MEAN
23331C     UPDATED         --AUGUST    1998. MATRIX ADD ROW, MATRIX DELE ROW
23332C     UPDATED         --AUGUST    1998. DISTANCE FROM MEAN
23333C     UPDATED         --AUGUST    1998. FOR MATRIX COMMANDS, FIX HOW
23334C                                       SUBSETTING HANDLED WHEN OUTPUT
23335C                                       IS SAVED.  THE IUPFLG USED TO
23336C                                       CONTROL WHETHER OUTPUT IS SAVED
23337C                                       WITH SUBSETTING OR IS SAVED
23338C                                       AS A "FULL" MATRIX.  E.G.,
23339C                                       MATRIX ADDITION MAINTAINS THE
23340C                                       SUBSET WHEN SAVING THE OUTPUT,
23341C                                       WHILE CORRELATION MATRIX IS
23342C                                       SAVED AS A "FULL" MATRIX.
23343C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP MEANS
23344C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP SD
23345C     UPDATED         --SEPTEMBER 1998. POOLED VARIANCE-COVARIANCE
23346C                                       MATRIX (MORE THAN 2 GROUPS)
23347C     UPDATED         --OCTOBER   1998. SPLIT INTO 2 ROUTINES
23348C     UPDATED         --NOVEMBER  1998. BINNED COMMAND
23349C     UPDATED         --MARCH     2001. STANDARDIZE, LOCATION STAND
23350C     UPDATED         --SEPTEMBER 2001. CROSS TABULATE
23351C     UPDATED         --OCTOBER   2001. MATCH (A 2-VARIABLE AND
23352C                                       3-VARIABLE SYNTAX SUPPORTED)
23353C     UPDATED         --JULY      2002. WINSORIZE
23354C     UPDATED         --APRIL     2003. ARGUMENT LIST TO GRPSTA, GRPST2
23355C     UPDATED         --MAY       2003. STACK COMMAND
23356C     UPDATED         --SEPTEMBER 2004. ASH BIN
23357C     UPDATED         --SEPTEMBER 2004. COUNTS ASH BIN
23358C     UPDATED         --OCTOBER   2004. COMBINE FREQUENCY TABLE
23359C     UPDATED         --FEBRUARY  2005. H CONSISTENCY STATISTIC
23360C     UPDATED         --FEBRUARY  2005. K CONSISTENCY STATISTIC
23361C     UPDATED         --JUNE      2005. L MOMENTS
23362C     UPDATED         --JUNE      2005. PROBABILITY WEIGHTED MOMENTS
23363C     UPDATED         --DECEMBER  2005. BETA PROBABILITY WEIGHTED
23364C                                       MOMENTS
23365C     UPDATED         --DECEMBER  2005. SORT BY <STAT>
23366C     UPDATED         --DECEMBER  2005. SUBSTANTIAL REWRITE FOR
23367C                                       BETTER CLARITY (SIMILAR TO
23368C                                       CHANGES IN DPMAT2)
23369C     UPDATED         --FEBRUARY  2006. CALL LIST TO BIVAR FIXED
23370C     UPDATED         --FEBRUARY  2006. REPLACE
23371C     UPDATED         --MARCH     2006. CALL LIST TO DPBIN
23372C     UPDATED         --MAY       2006. INTEGER FREQUENCY TABLE
23373C     UPDATED         --JANUARY   2007. CALL LIST TO RANK, HAZARD,
23374C                                       CUMHAZ, RANKCM, RANKCR,
23375C                                       RANKCV
23376C     UPDATED         --JANUARY   2007. JITTER
23377C     UPDATED         --FEBRUARY  2007. AGRESTI-COULL LIMITS
23378C     UPDATED         --FEBRUARY  2007. EXACT BINOMIAL LOWER LIMIT
23379C     UPDATED         --FEBRUARY  2007. EXACT BINOMIAL UPPER LIMIT
23380C     UPDATED         --APRIL     2008. 2D CONVEX HULL
23381C     UPDATED         --APRIL     2008. EDGES TO VERTICES
23382C     UPDATED         --APRIL     2008. NEXT SUBSET
23383C     UPDATED         --APRIL     2008. NEXT PERMUTATION
23384C     UPDATED         --APRIL     2008. NEXT K-SET OF N-SET
23385C     UPDATED         --APRIL     2008. NEXT COMPOSITION
23386C     UPDATED         --MAY       2008. LET Y = X WHERE X IS VARIABLE
23387C     UPDATED         --MAY       2008. NEXT PARTITION
23388C     UPDATED         --JUNE      2008. NEXT EQUIVALENCE RELATION
23389C     UPDATED         --JUNE      2008. SPANNING FOREST
23390C     UPDATED         --AUGUST    2008. NEXT YOUNG TABLEAUX
23391C     UPDATED         --AUGUST    2008. CONVERT YOUNG TABLEAUX
23392C     UPDATED         --AUGUST    2008. YOUNG TABLEAUX HOOK LENGTH
23393C     UPDATED         --AUGUST    2008. DIFFERENCE OF PROPORTION
23394C                                       CONFIDENCE LIMITS AND
23395C                                       P-VALUES
23396C     UPDATED         --SEPTEMBER 2008. RUHKIN 1 TEST
23397C     UPDATED         --SEPTEMBER 2008. RUHKIN 2 TEST
23398C     UPDATED         --OCTOBER   2008. SORT2, SORT3, SORT4
23399C     UPDATED         --NOVEMBER  2008. GATHER
23400C     UPDATED         --NOVEMBER  2008. SCATTER
23401C     UPDATED         --DECEMBER  2008. RANK2
23402C     UPDATED         --JANUARY   2009. FOR "NEXT ... ", CREATE A
23403C                                       INTERNAL PARAMETER THAT
23404C                                       IDENTIFIES WHETHER OR NOT
23405C                                       CURRENT SEQUENCE IS LAST
23406C                                       SEQUENCE IN THE SET
23407C     UPDATED         --FEBRUARY  2009. SHIFT, CIRCULAR SHIFT
23408C     UPDATED         --JUNE      2009. CODE CROSS TABULATE
23409C     UPDATED         --OCTOBER   2009. BINOMIAL RATIO CONF LIMITS
23410C     UPDATED         --JUNE      2010. RANK INDEX
23411C     UPDATED         --JUNE      2010. RUHKIN 3 TEST
23412C     UPDATED         --SEPTEMBER 2010. COMBINE
23413C     UPDATED         --OCTOBER   2010. MOVING <STAT>
23414C     UPDATED         --OCTOBER   2010. BRITTLE FIBER WEIBULL PDF/CDF/PPF
23415C     UPDATED         --OCTOBER   2010. EXACT BINOMIAL CONFIDENCE LIMITS
23416C     UPDATED         --NOVEMBER  2010. END EFFECTS WEIBULL PDF/CDF/PPF
23417C     UPDATED         --APRIL     2011. KEEP/OMIT
23418C     UPDATED         --MAY       2011. MANN WHITNEY U STATISTIC FREQUENCY
23419C     UPDATED         --JULY      2011. THRESHOLD MINIMUM
23420C     UPDATED         --JULY      2011. THRESHOLD MAXIMUM
23421C     UPDATED         --SEPTEMBER 2011. POINTS IN POLYGON
23422C     UPDATED         --JANUARY   2012. PERCENTAGE RANK
23423C     UPDATED         --JANUARY   2012. EXPAND
23424C     UPDATED         --JANUARY   2012. EN
23425C     UPDATED         --JANUARY   2012. ISO 13528 ZSCORE
23426C     UPDATED         --JANUARY   2012. ISO 13528 ZPRIME SCORE
23427C     UPDATED         --JANUARY   2012. ISO 13528 ZETA SCORE
23428C     UPDATED         --JANUARY   2012. ISO 13528 EZMINUS SCORE
23429C     UPDATED         --JANUARY   2012. ISO 13528 EZPLUS SCORE
23430C     UPDATED         --FEBRUARY  2012. JSCORE
23431C     UPDATED         --JUNE      2012. WEIBULL MOMENT ESTIMATES
23432C     UPDATED         --JUNE      2012. PARTIAL CORRELATION MATRIX
23433C     UPDATED         --AUGUST    2012. LOW  PASS FILTER
23434C     UPDATED         --AUGUST    2012. HIGH PASS FILTER
23435C     UPDATED         --OCTOBER   2012. TRANSFORM POINTS
23436C     UPDATED         --OCTOBER   2012. EXTREME POINTS
23437C     UPDATED         --OCTOBER   2012. ENCLOSING RECTANGLE
23438C     UPDATED         --OCTOBER   2012. LINE INTERSECTIONS
23439C     UPDATED         --OCTOBER   2012. PARALLEL LINES
23440C     UPDATED         --OCTOBER   2012. PERPINDICULAR LINES
23441C     UPDATED         --DECEMBER  2012. CUMULATIVE MINIMUM
23442C     UPDATED         --DECEMBER  2012. CUMULATIVE MAXIMUM
23443C     UPDATED         --JANUARY   2013. CUMULATIVE <STAT>
23444C     UPDATED         --JANUARY   2013. CROSS TABULATE CUMULATIVE <STAT>
23445C     UPDATED         --JANUARY   2013. CODED BINNED
23446C     UPDATED         --JANUARY   2013. CODED RELATIVE BINNED
23447C     UPDATED         --AUGUST    2013. JOIN
23448C     UPDATED         --AUGUST    2013. NEAREST NEIGHBOR
23449C     UPDATED         --AUGUST    2013. NEAREST NEIGHBOR INDEX
23450C     UPDATED         --AUGUST    2013. NEAREST NEIGHBOR DISTANCE
23451C     UPDATED         --AUGUST    2013. PEAKS
23452C     UPDATED         --AUGUST    2013. PEAKS TRIANGLE AREAS
23453C     UPDATED         --SEPTEMBER 2013. FIRST NEAREST NEIGHBOR
23454C     UPDATED         --SEPTEMBER 2013. ALL NEAREST NEIGHBORS
23455C     UPDATED         --JANUARY   2014. FOR LET ... = CROSS TABULATE,
23456C                                       SUPPORT 6 (UP FROM 4) FACTOR
23457C                                       VARIABLES
23458C     UPDATED         --APRIL     2014. LOGNORMAL MOMENT ESTIMATES
23459C     UPDATED         --APRIL     2014. GAMMA MOMENT ESTIMATES
23460C     UPDATED         --APRIL     2014. INVERSE GAUSSIAN MOMENT ESTIMATES
23461C     UPDATED         --JULY      2014. SHUFFLE GROUPS
23462C     UPDATED         --DECEMBER  2014. RANDOM ERROR QUANTITY
23463C     UPDATED         --OCTOBER   2015. JSCORE TABLE
23464C     UPDATED         --DECEMBER  2015. YFRAME, XFRAME
23465C     UPDATED         --FEBRUARY  2016. ISO 13528 PA SCORE
23466C     UPDATED         --FEBRUARY  2016. ISO 13528 DI PERCENT SCORE
23467C     UPDATED         --FEBRUARY  2016. SEQUENTIAL SUM
23468C     UPDATED         --FEBRUARY  2016. SEQUENTIAL MEAN
23469C     UPDATED         --FEBRUARY  2016. SEQUENTIAL MINIMUM
23470C     UPDATED         --FEBRUARY  2016. SEQUENTIAL MAXIMUM
23471C     UPDATED         --FEBRUARY  2016. SEQUENTIAL PRODUCT
23472C     UPDATED         --FEBRUARY  2016. SEQUENTIAL LOWER
23473C     UPDATED         --FEBRUARY  2016. SEQUENTIAL UPPER
23474C     UPDATED         --FEBRUARY  2016. SEQUENTIAL <STAT> WITH GROUP-ID
23475C                                       VARIABLE
23476C     UPDATED         --JUNE      2016. WINDOW <STAT>
23477C     UPDATED         --JUNE      2016. VECTOR PERCENTILE
23478C     UPDATED         --JUNE      2016. CODEZ
23479C     UPDATED         --AUGUST    2016. UNSTACK
23480C     UPDATED         --JANUARY   2017. VARIANCES WELCH SATTERTHWAITE
23481C     UPDATED         --JANUARY   2017. GUM       WELCH SATTERTHWAITE
23482C     UPDATED         --FEBRUARY  2017. NORMAL KERNEL DENSITY MIXTURE
23483C     UPDATED         --FEBRUARY  2017. EMPIRICAL QUANTILE FUNCTION
23484C     UPDATED         --MARCH     2017. INFORMATVE QUANTILE FUNCTION
23485C     UPDATED         --MARCH     2017. TRUNCATED INFORMATVE QUANTILE FUNCTION
23486C     UPDATED         --JULY      2017. CODEX
23487C     UPDATED         --JULY      2017. CORRECTIONS TO WELCH
23488C                                       SATTERTHWAITE
23489C     UPDATED         --AUGUST    2017. SAMPLE RANDOM PERMUTATION
23490C     UPDATED         --AUGUST    2017. HERMITE INTERPOLATION
23491C     UPDATED         --AUGUST    2017. HERMITE INTERGRATION
23492C     UPDATED         --NOVEMBER  2017. HERMITE DERIVATIVE
23493C     UPDATED         --JANUARY   2018. CODE DEX
23494C     UPDATED         --JULY      2018. MEAN RANK
23495C     UPDATED         --OCTOBER   2018. LARGEST
23496C     UPDATED         --OCTOBER   2018. SMALLEST
23497C     UPDATED         --OCTOBER   2018. <YTIC/XTIC> <SCREEN/DATA>
23498C                                       COORDINATES
23499C     UPDATED         --OCTOBER   2018. CODE DEX 2-LEVEL
23500C     UPDATED         --JUNE      2019. CALL LIST TO COMARI, BOOTSS,
23501C                                       BILINR
23502C     UPDATED         --JULY      2019. CALL LIST TO SETARI, LININT,
23503C                                       INT2D, INTERP
23504C     UPDATED         --JULY      2019. TWEAK SCRATCH STORAGE
23505C     UPDATED         --JULY      2019. BREAK LOCATIONS
23506C     UPDATED         --JULY      2019. FRAGMENT LOCATIONS
23507C     UPDATED         --JULY      2019. FRAGMENT LENGTHS
23508C     UPDATED         --AUGUST    2019. 2D GRID, 3D GRID, 4D GRID
23509C     UPDATED         --FEBRUARY  2020. INSERT
23510C
23511C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
23512C
23513      CHARACTER*4 ICASL7
23514      CHARACTER*4 ICASS7
23515      CHARACTER*4 ICASE
23516      CHARACTER*4 ICASE2
23517      CHARACTER*4 ICASMT
23518      CHARACTER*4 ICASAN
23519      CHARACTER*4 IFTEXP
23520      CHARACTER*4 IFTORD
23521      CHARACTER*4 IBUGA3
23522      CHARACTER*4 IBUGQ
23523      CHARACTER*4 ISUBRO
23524      CHARACTER*4 IFOUND
23525      CHARACTER*4 IERROR
23526C
23527      PARAMETER(MAXCAS=30)
23528      PARAMETER(MAXCA2=5)
23529C
23530      CHARACTER*4 ICASEQ
23531      CHARACTER*4 ICASPL
23532      CHARACTER*4 ICASP2
23533      CHARACTER*4 IH
23534      CHARACTER*4 IH1
23535      CHARACTER*4 IH2
23536      CHARACTER*4 IHWUSE
23537      CHARACTER*4 MESSAG
23538      CHARACTER*4 IWRITE
23539      CHARACTER*4 ITCASE
23540      CHARACTER*4 IACASE
23541      CHARACTER*4 ISTAT
23542      CHARACTER*4 IHREPL
23543      CHARACTER*4 IHREP2
23544C
23545      CHARACTER*4 NEWNAM(MAXCA2)
23546      CHARACTER*4 ILEFT(MAXCA2)
23547      CHARACTER*4 ILEF2(MAXCA2)
23548      CHARACTER*4 IHSET
23549      CHARACTER*4 IHSET2
23550C
23551      CHARACTER*4 ISUBN1
23552      CHARACTER*4 ISUBN2
23553      CHARACTER*4 ISTEPN
23554C
23555      CHARACTER*4 IMATSW
23556      CHARACTER*4 ITYP91
23557      CHARACTER*4 ITYP92
23558      CHARACTER*4 ITYP93
23559C
23560      CHARACTER*4 ITYPA(MAXCAS)
23561C
23562      CHARACTER*4 IUPFLG
23563      CHARACTER*4 IRELAT
23564      CHARACTER*4 IOP
23565C
23566      CHARACTER*4 IHP
23567      CHARACTER*4 IHP2
23568      CHARACTER*4 ISUBN0
23569C
23570      CHARACTER*4 IHRIGH(MAXCAS)
23571      CHARACTER*4 IHRIG2(MAXCAS)
23572C
23573      INTEGER ILISL(MAXCA2)
23574      INTEGER ICOLL(MAXCA2)
23575      INTEGER ILOCR(MAXCAS)
23576      INTEGER ILISR(MAXCAS)
23577      INTEGER ICOLR(MAXCAS)
23578      INTEGER NIRIGH(MAXCAS)
23579      REAL TEMPS(MAXCAS)
23580C
23581      DOUBLE PRECISION ATEMP
23582      DOUBLE PRECISION BTEMP
23583      DOUBLE PRECISION FC
23584C
23585      LOGICAL ISPLINE
23586C
23587C---------------------------------------------------------------------
23588C
23589      INCLUDE 'DPCOPA.INC'
23590      INCLUDE 'DPCOZZ.INC'
23591      INCLUDE 'DPCOZI.INC'
23592      INCLUDE 'DPCOZD.INC'
23593C
23594      DIMENSION TEMP1(MAXOBV)
23595      DIMENSION TEMP2(MAXOBV)
23596      DIMENSION TEMP3(MAXOBV)
23597      DIMENSION TEMP4(MAXOBV)
23598      DIMENSION TEMP5(MAXOBV)
23599      DIMENSION TEMP12(2*MAXOBV)
23600      DIMENSION TEMP91(MAXOBV)
23601      DIMENSION TEMP92(MAXOBV)
23602      DIMENSION TEMPC1(2*MAXOBV)
23603      DIMENSION TEMP6(5*MAXOBV)
23604      DIMENSION TEMP7(MAXOBV)
23605      DIMENSION TEMP8(MAXOBV)
23606      DIMENSION TEMP9(MAXOBV)
23607      DIMENSION TEMP21(MAXOBV)
23608      DIMENSION TEMP22(MAXOBV)
23609      DIMENSION TEMP23(MAXOBV)
23610      DIMENSION TEMP24(MAXOBV)
23611      DIMENSION TEMP25(MAXOBV)
23612      DIMENSION TEMP26(MAXOBV)
23613C
23614      DIMENSION ITEMP1(MAXOBV)
23615      DIMENSION ITEMP2(MAXOBV)
23616      DIMENSION ITEMP3(MAXOBV)
23617      DIMENSION ITEMP4(MAXOBV)
23618      DIMENSION ITEMP5(MAXOBV)
23619      DIMENSION ITEMP6(MAXOBV)
23620      DIMENSION ITEMP7(MAXOBV)
23621C
23622      DOUBLE PRECISION DTEMP1(MAXOBV)
23623      DOUBLE PRECISION DTEMP2(MAXOBV)
23624      DOUBLE PRECISION DTEMP3(MAXOBV)
23625C
23626      EQUIVALENCE (GARBAG(IGARB1),TEMP1)
23627      EQUIVALENCE (GARBAG(IGARB2),TEMP2)
23628      EQUIVALENCE (GARBAG(IGARB3),TEMP3)
23629      EQUIVALENCE (GARBAG(IGARB4),TEMP4)
23630      EQUIVALENCE (GARBAG(IGARB5),TEMP12)
23631      EQUIVALENCE (GARBAG(IGARB7),TEMP91)
23632      EQUIVALENCE (GARBAG(IGARB8),TEMP92)
23633      EQUIVALENCE (GARBAG(IGARB9),TEMP5)
23634      EQUIVALENCE (GARBAG(IGAR10),TEMPC1)
23635      EQUIVALENCE (GARBAG(JGAR12),TEMP7)
23636      EQUIVALENCE (GARBAG(JGAR13),TEMP8)
23637      EQUIVALENCE (GARBAG(JGAR14),TEMP9)
23638      EQUIVALENCE (GARBAG(JGAR15),TEMP21)
23639      EQUIVALENCE (GARBAG(JGAR16),TEMP22)
23640      EQUIVALENCE (GARBAG(JGAR17),TEMP23)
23641      EQUIVALENCE (GARBAG(JGAR18),TEMP24)
23642      EQUIVALENCE (GARBAG(JGAR19),TEMP25)
23643      EQUIVALENCE (GARBAG(IGAR11),TEMP26)
23644      EQUIVALENCE (GARBAG(IGAR12),TEMP6)
23645C
23646      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1)
23647      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2)
23648      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3)
23649      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4)
23650      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5)
23651      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6)
23652      EQUIVALENCE (IGARBG(IIGAR7),ITEMP7)
23653C
23654      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1(1))
23655      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2(1))
23656      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3(1))
23657C
23658C-----COMMON----------------------------------------------------------
23659C
23660      INCLUDE 'DPCOSU.INC'
23661      INCLUDE 'DPCOST.INC'
23662C
23663      INCLUDE 'DPCOHO.INC'
23664      INCLUDE 'DPCOHK.INC'
23665      INCLUDE 'DPCODA.INC'
23666      INCLUDE 'DPCOPC.INC'
23667C
23668      COMMON/NIJWIL/NLAST,KLAST
23669      LOGICAL MTC
23670      SAVE MTC
23671C
23672C-----COMMON VARIABLES (GENERAL)--------------------------------------
23673C
23674      INCLUDE 'DPCOP2.INC'
23675C
23676C-----START POINT-----------------------------------------------------
23677C
23678CCCCC DON'T PROCESS MATRIX COMMANDS.
23679C
23680      IF(ICASL7.EQ.'MAAD')GOTO19090
23681      IF(ICASL7.EQ.'MASU')GOTO19090
23682      IF(ICASL7.EQ.'MAMU')GOTO19090
23683      IF(ICASL7.EQ.'MASO')GOTO19090
23684      IF(ICASL7.EQ.'MAIN')GOTO19090
23685      IF(ICASL7.EQ.'MATR')GOTO19090
23686      IF(ICASL7.EQ.'MAAJ')GOTO19090
23687      IF(ICASL7.EQ.'MACE')GOTO19090
23688      IF(ICASL7.EQ.'MAEA')GOTO19090
23689      IF(ICASL7.EQ.'MAEE')GOTO19090
23690      IF(ICASL7.EQ.'MARA'.AND.NUMARG.EQ.5)GOTO19090
23691      IF(ICASL7.EQ.'MARA'.AND.NUMARG.EQ.6)GOTO19090
23692      IF(ICASL7.EQ.'MADE')GOTO19090
23693      IF(ICASL7.EQ.'MAPE')GOTO19090
23694      IF(ICASL7.EQ.'MASN')GOTO19090
23695      IF(ICASL7.EQ.'MASR')GOTO19090
23696      IF(ICASL7.EQ.'MANR')GOTO19090
23697      IF(ICASL7.EQ.'MANC')GOTO19090
23698      IF(ICASL7.EQ.'MASS')GOTO19090
23699      IF(ICASL7.EQ.'MATC')GOTO19090
23700      IF(ICASL7.EQ.'MASM')GOTO19090
23701      IF(ICASL7.EQ.'MAMI')GOTO19090
23702      IF(ICASL7.EQ.'MACF')GOTO19090
23703      IF(ICASL7.EQ.'MADF'.AND.NUMARG.EQ.7)GOTO19090
23704      IF(ICASL7.EQ.'MADF'.AND.NUMARG.EQ.8)GOTO19090
23705      IF(ICASL7.EQ.'MAEN')GOTO19090
23706      IF(ICASL7.EQ.'MARW')GOTO19090
23707      IF(ICASL7.EQ.'MAEL')GOTO19090
23708C
23709      IF(ICASL7.EQ.'MAVC')GOTO19090
23710      IF(ICASL7.EQ.'MACO')GOTO19090
23711      IF(ICASL7.EQ.'MACC')GOTO19090
23712      IF(ICASL7.EQ.'MACP')GOTO19090
23713      IF(ICASL7.EQ.'MACM')GOTO19090
23714      IF(ICASL7.EQ.'MAPC')GOTO19090
23715      IF(ICASL7.EQ.'MAP1')GOTO19090
23716      IF(ICASL7.EQ.'MAP2')GOTO19090
23717      IF(ICASL7.EQ.'MAP3')GOTO19090
23718      IF(ICASL7.EQ.'MAP4')GOTO19090
23719      IF(ICASL7.EQ.'MAP5')GOTO19090
23720      IF(ICASL7.EQ.'MAP6')GOTO19090
23721      IF(ICASL7.EQ.'MAP7')GOTO19090
23722      IF(ICASL7.EQ.'MAP8')GOTO19090
23723      IF(ICASL7.EQ.'MAP9')GOTO19090
23724      IF(ICASL7.EQ.'MA10')GOTO19090
23725      IF(ICASL7.EQ.'MASV')GOTO19090
23726      IF(ICASL7.EQ.'MASD')GOTO19090
23727      IF(ICASL7.EQ.'MASF')GOTO19090
23728      IF(ICASL7.EQ.'MACH')GOTO19090
23729      IF(ICASL7.EQ.'MAAU')GOTO19090
23730      IF(ICASL7.EQ.'MADI')GOTO19090
23731      IF(ICASL7.EQ.'MARR')GOTO19090
23732      IF(ICASL7.EQ.'MAAR')GOTO19090
23733      IF(ICASL7.EQ.'MADR')GOTO19090
23734      IF(ICASL7.EQ.'MAMM')GOTO19090
23735      IF(ICASL7.EQ.'MADM')GOTO19090
23736      IF(ICASL7.EQ.'DIMA')GOTO19090
23737      IF(ICASL7.EQ.'MAVT')GOTO19090
23738      IF(ICASL7.EQ.'MARE')GOTO19090
23739      IF(ICASL7.EQ.'MATD')GOTO19090
23740      IF(ICASL7.EQ.'MATS')GOTO19090
23741      IF(ICASL7.EQ.'MATI')GOTO19090
23742      IF(ICASL7.EQ.'MAIS')GOTO19090
23743      IF(ICASL7.EQ.'MQFO')GOTO19090
23744      IF(ICASL7.EQ.'MALC')GOTO19090
23745      IF(ICASL7.EQ.'MAGM')GOTO19090
23746      IF(ICASL7.EQ.'MAGS')GOTO19090
23747      IF(ICASL7.EQ.'MPIN')GOTO19090
23748      IF(ICASL7.EQ.'MHT1')GOTO19090
23749      IF(ICASL7.EQ.'MHT2')GOTO19090
23750      IF(ICASL7.EQ.'MPVC')GOTO19090
23751      IF(ICASL7.EQ.'MDER')GOTO19090
23752      IF(ICASL7.EQ.'MDEC')GOTO19090
23753      IF(ICASL7.EQ.'MDMR')GOTO19090
23754      IF(ICASL7.EQ.'MDMC')GOTO19090
23755      IF(ICASL7.EQ.'MDBR')GOTO19090
23756      IF(ICASL7.EQ.'MDBC')GOTO19090
23757      IF(ICASL7.EQ.'MDKR')GOTO19090
23758      IF(ICASL7.EQ.'MDKC')GOTO19090
23759      IF(ICASL7.EQ.'MDCR')GOTO19090
23760      IF(ICASL7.EQ.'MDCC')GOTO19090
23761      IF(ICASL7.EQ.'MCSR')GOTO19090
23762      IF(ICASL7.EQ.'MCSC')GOTO19090
23763      IF(ICASL7.EQ.'MCDR')GOTO19090
23764      IF(ICASL7.EQ.'MCDC')GOTO19090
23765      IF(ICASL7.EQ.'MZSR')GOTO19090
23766      IF(ICASL7.EQ.'MASC')GOTO19090
23767      IF(ICASL7.EQ.'MZDR')GOTO19090
23768      IF(ICASL7.EQ.'MADC')GOTO19090
23769      IF(ICASL7.EQ.'MJSR')GOTO19090
23770      IF(ICASL7.EQ.'MJSC')GOTO19090
23771      IF(ICASL7.EQ.'MJDR')GOTO19090
23772      IF(ICASL7.EQ.'MJDC')GOTO19090
23773      IF(ICASL7.EQ.'MPDR')GOTO19090
23774      IF(ICASL7.EQ.'MPDC')GOTO19090
23775      IF(ICASL7.EQ.'MHDR')GOTO19090
23776      IF(ICASL7.EQ.'MPSC')GOTO19090
23777      IF(ICASL7.EQ.'MHSR')GOTO19090
23778      IF(ICASL7.EQ.'MHDC')GOTO19090
23779      IF(ICASL7.EQ.'MXDR')GOTO19090
23780      IF(ICASL7.EQ.'MXDC')GOTO19090
23781      IF(ICASL7.EQ.'MRSC')GOTO19090
23782      IF(ICASL7.EQ.'MCSC')GOTO19090
23783      IF(ICASL7.EQ.'MDIP')GOTO19090
23784      IF(ICASL7.EQ.'MQRD')GOTO19090
23785      IF(ICASL7.EQ.'MROW')GOTO19090
23786      IF(ICASL7.EQ.'MCOL')GOTO19090
23787      IF(ICASL7.EQ.'MACA')GOTO19090
23788      IF(ICASL7.EQ.'MVRN')GOTO19090
23789      IF(ICASL7.EQ.'MURN')GOTO19090
23790      IF(ICASL7.EQ.'MPDF')GOTO19090
23791      IF(ICASL7.EQ.'WIRN')GOTO19090
23792      IF(ICASL7.EQ.'MTRN')GOTO19090
23793      IF(ICASL7.EQ.'IURN')GOTO19090
23794      IF(ICASL7.EQ.'DIRN')GOTO19090
23795      IF(ICASL7.EQ.'DPDF')GOTO19090
23796      IF(ICASL7.EQ.'DLPD')GOTO19090
23797      IF(ICASL7.EQ.'NCDF')GOTO19090
23798      IF(ICASL7.EQ.'TCDF')GOTO19090
23799      IF(ICASL7.EQ.'VINF')GOTO19090
23800      IF(ICASL7.EQ.'CIND')GOTO19090
23801      IF(ICASL7.EQ.'XTXI')GOTO19090
23802      IF(ICASL7.EQ.'CRMA')GOTO19090
23803      IF(ICASL7.EQ.'INRN')GOTO19090
23804      IF(ICASL7.EQ.'MSUM')GOTO19090
23805      IF(ICASL7.EQ.'MPAR')GOTO19090
23806      IF(ICASL7.EQ.'MGRA')GOTO19090
23807      IF(ICASL7.EQ.'MATB')GOTO19090
23808      IF(ICASL7.EQ.'MARB')GOTO19090
23809      IF(ICASL7.EQ.'MATZ')GOTO19090
23810      IF(ICASL7.EQ.'MAUZ')GOTO19090
23811      IF(ICASL7.EQ.'MSPT')GOTO19090
23812      IF(ICASL7.EQ.'MSP2')GOTO19090
23813      IF(ICASL7.EQ.'MARN')GOTO19090
23814      IF(ICASL7.EQ.'ADMA')GOTO19090
23815      IF(ICASL7.EQ.'ADMD')GOTO19090
23816      IF(ICASL7.EQ.'BIPL')GOTO19090
23817      IF(ICASL7.EQ.'MFTR')GOTO19090
23818      IF(ICASL7.EQ.'MFTC')GOTO19090
23819      IF(ICASL7.EQ.'VMAT')GOTO19090
23820      IF(ICASL7.EQ.'MVAR')GOTO19090
23821      IF(ICASL7.EQ.'MCRO')GOTO19090
23822      IF(ICASL7.EQ.'MCCO')GOTO19090
23823      IF(ICASL7.EQ.'MACN')GOTO19090
23824      IF(ICASL7.EQ.'MARC')GOTO19090
23825      IF(ICASL7.EQ.'MPCO')GOTO19090
23826      IF(ICASL7.EQ.'MPCC')GOTO19090
23827      IF(ICASL7.EQ.'MPCP')GOTO19090
23828      IF(ICASL7.EQ.'GMST')GOTO19090
23829      IF(ICASL7.EQ.'CORE')GOTO19090
23830      IF(ICASL7.EQ.'CONF')GOTO19090
23831      IF(ICASL7.EQ.'CKCL')GOTO19090
23832      IF(ICASL7.EQ.'CKCP')GOTO19090
23833C
23834      IUPFLG='SUBS'
23835      ISUBN1='DPMA'
23836      ISUBN2='TC  '
23837      IFOUND='NO'
23838      IERROR='NO'
23839C
23840      MAXCP1=MAXCOL+1
23841      MAXCP2=MAXCOL+2
23842      MAXCP3=MAXCOL+3
23843      MAXCP4=MAXCOL+4
23844      MAXCP5=MAXCOL+5
23845      MAXCP6=MAXCOL+6
23846C
23847      ILOCR(1)=ILOCV
23848      DO10I=2,MAXCAS
23849        ILOCR(I)=ILOCR(I-1)+1
23850        ITYPA(I)='VARI'
23851        TEMPS(I)=(-999.0)
23852        ILISR(I)=(-999)
23853        ICOLR(I)=(-999)
23854        NIRIGH(I)=(-999)
23855   10 CONTINUE
23856      DO15I=2,MAXCA2
23857        NEWNAM(I)='NO'
23858        ILISL(I)=(-999)
23859        ICOLL(I)=(-999)
23860   15 CONTINUE
23861C
23862      DO20I=1,MAXOBV
23863        ISUB(I)=1
23864   20 CONTINUE
23865C
23866C
23867      NUMVAL=1
23868      SCAL91=(-999.0)
23869      NITEM2=0
23870      NITEM3=0
23871      NITEM4=0
23872      NITEM5=0
23873      NITEM5=0
23874      NS99=-99
23875      NREPL=-99
23876      NIFOR=-99
23877      ICOLRP=-99
23878      IJUNK1=-99
23879      NILEF1=-99
23880C
23881      IMATSW='NO'
23882      ICASMT='INDE'
23883      ITYP91='VECT'
23884      ITYP92='VECT'
23885      ITYP93='VECT'
23886C
23887C               ******************************************************
23888C               **  TREAT THE SUBCASE OF PERFORMING CERTAIN SPECIAL **
23889C               **  DATA MANIPULATIONS (SORT, RANK, CODE)           **
23890C               **       1) FOR A FULL VARIABLE, OR                 **
23891C               **       2) FOR PART OF A VARIABLE.                 **
23892C               ******************************************************
23893C
23894      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
23895        WRITE(ICOUT,999)
23896  999   FORMAT(1X)
23897        CALL DPWRST('XXX','BUG ')
23898        WRITE(ICOUT,51)
23899   51   FORMAT('***** AT THE BEGINNING OF DPMATC--')
23900        CALL DPWRST('XXX','BUG ')
23901        WRITE(ICOUT,52)IBUGA3,IBUGQ,ISUBRO
23902   52   FORMAT('IBUGA3,IBUGQ,ISUBRO = ',2(A4,2X),A4)
23903        CALL DPWRST('XXX','BUG ')
23904        WRITE(ICOUT,53)ICASL7,ICASS7,IFTEXP,ILOCV,NUMARG
23905   53   FORMAT('ICASL7,ICASS7,IFTEXP,ILOCV,NUMARG = ',3(A4,2X),2I8)
23906        CALL DPWRST('XXX','BUG ')
23907        ISTEPN='1'
23908        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
23909      ENDIF
23910C
23911C     ***************************************************************
23912C     **  STEP 2A--                                                 *
23913C     **  EXAMINE THE LEFT-HAND SIDE--                              *
23914C     **  IS THE VARIABLE NAME TO LEFT OF = SIGN                    *
23915C     **  ALREADY IN THE NAME LIST?    AS A VARIABLE?               *
23916C     **  NOTE THAT     ILEFT(I)   IS THE NAME OF THE VARIABLE      *
23917C     **  ON THE LEFT.                                              *
23918C     **  NOTE THAT     ILISL(I)  IS THE LINE IN THE TABLE          *
23919C     **  OF THE NAME ON THE LEFT.                                  *
23920C     **  NOTE THAT     ICOLL(I)  IS THE DATA COLUMN (1 TO 12)      *
23921C     **  FOR THE NAME OF THE LEFT.                                 *
23922C     ***************************************************************
23923C
23924      ICASEZ=1
23925      CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
23926     1            ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
23927     1            NUMVAL,NIOLD,
23928     1            IBUGA3,ISUBRO,IFOUND,IERROR)
23929      IF(IERROR.EQ.'YES')GOTO9000
23930C
23931C     FEBRUARY 2006: THE REPLACE COMMAND REQUIRES THAT THE
23932C                    LEFT-HAND SIDE VARIABLE ALREADY EXISTS.
23933C
23934C     AUGUST   2016: THE UNSTACK COMMAND USES THE LEFT-HAND SIDE
23935C                    VARIABLE AS A "BASE NAME".
23936C
23937      IF(ICASL7.EQ.'REPL')THEN
23938        IF(NEWNAM(ICASEZ).EQ.'YES')THEN
23939          WRITE(ICOUT,999)
23940          CALL DPWRST('XXX','BUG ')
23941          WRITE(ICOUT,101)
23942  101     FORMAT('***** ERROR IN DPMATC--')
23943          CALL DPWRST('XXX','BUG ')
23944          WRITE(ICOUT,103)
23945  103     FORMAT('      THE FIRST VARIABLE ON THE LEFT-HAND SIDE OF')
23946          CALL DPWRST('XXX','BUG ')
23947          WRITE(ICOUT,105)ILEFT(ICASEZ),ILEF2(ICASEZ)
23948  105     FORMAT('      THE EQUAL SIGN, (',A4,A4,'), MUST ALREADY ',
23949     1           'EXIST.')
23950          CALL DPWRST('XXX','BUG ')
23951          WRITE(ICOUT,107)
23952  107     FORMAT('      SUCH WAS NOT THE CASE HERE.')
23953          CALL DPWRST('XXX','BUG ')
23954          IERROR='YES'
23955          GOTO9000
23956        ELSE
23957          NILEF1=NIOLD
23958        ENDIF
23959      ENDIF
23960C
23961      IF(ICASL7.EQ.'FOUT'.OR.ICASL7.EQ.'FOU1'.OR.
23962     1   ICASL7.EQ.'IFOU'.OR.ICASL7.EQ.'IFO1'.OR.
23963     1   ICASL7.EQ.'FFT' .OR.ICASL7.EQ.'BINN'.OR.
23964     1   ICASL7.EQ.'BINR'.OR.ICASL7.EQ.'CUMH'.OR.
23965     1   ICASL7.EQ.'BINP'.OR.ICASL7.EQ.'BIRP'.OR.
23966     1   ICASL7.EQ.'ASHR'.OR.ICASL7.EQ.'ASHC'.OR.
23967CCCCC1   ICASL7.EQ.'MTCH'.OR.ICASL7.EQ.'HAZA'.OR.
23968CCCCC1   ICASL7.EQ.'FRAW'.OR.ICASL7.EQ.'FFT1'.OR.
23969     1   ICASL7.EQ.'FFT1'.OR.ICASL7.EQ.'NKDM'.OR.
23970     1   ICASL7.EQ.'IFFT'.OR.ICASL7.EQ.'IFF1'.OR.
23971     1   ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
23972     1   ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI'.OR.
23973     1   ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
23974     1   ICASL7.EQ.'CORO'.OR.ICASL7.EQ.'COR1'.OR.
23975     1   ICASL7.EQ.'COCO'.OR.ICASL7.EQ.'PODI'.OR.
23976     1   ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'FRAC'.OR.
23977     1   ICASL7.EQ.'STAC'.OR.ICASL7.EQ.'RSTA'.OR.
23978     1   ICASL7.EQ.'CFRT'.OR.ICASL7.EQ.'HCO2'.OR.
23979     1   ICASL7.EQ.'MWUF'.OR.ICASL7.EQ.'JOIN'.OR.
23980     1   ICASL7.EQ.'IFRT'.OR.ICASL7.EQ.'AGCO'.OR.
23981     1   ICASL7.EQ.'EBLL'.OR.ICASL7.EQ.'EBUL'.OR.
23982     1   ICASL7.EQ.'BRAT'.OR.ICASL7.EQ.'EBCL'.OR.
23983     1   ICASL7.EQ.'R1TS'.OR.ICASL7.EQ.'R1LT'.OR.
23984     1   ICASL7.EQ.'R1UT'.OR.ICASL7.EQ.'EQUF'.OR.
23985     1   ICASL7.EQ.'IQUF'.OR.ICASL7.EQ.'TIQF'.OR.
23986     1   ICASL7.EQ.'R2TS'.OR.ICASL7.EQ.'R2LT'.OR.
23987     1   ICASL7.EQ.'R2UT'.OR.ICASL7.EQ.'NNE3'.OR.
23988     1   ICASL7.EQ.'FNNE'.OR.ICASL7.EQ.'ANNE'.OR.
23989     1   ICASL7.EQ.'TPOI'.OR.ICASL7.EQ.'EXTP'.OR.
23990     1   ICASL7.EQ.'ENCB'.OR.ICASL7.EQ.'INTL'.OR.
23991     1   ICASL7.EQ.'PARL'.OR.ICASL7.EQ.'PERL'.OR.
23992     1   ICASL7.EQ.'R3TS'.OR.ICASL7.EQ.'R3LT'.OR.
23993     1   ICASL7.EQ.'R3UT'.OR.ICASL7.EQ.'BPSE'.OR.
23994     1   ICASL7.EQ.'2DCH'.OR.ICASL7.EQ.'EDGV'.OR.
23995     1   ICASL7.EQ.'2DCH'.OR.ICASL7.EQ.'EDGV'.OR.
23996     1   ICASL7.EQ.'SPF1'.OR.ICASL7.EQ.'SPF2'.OR.
23997     1   ICASL7.EQ.'KCO2'.OR.ICASL7.EQ.'SRTB'.OR.
23998     1   ICASL7.EQ.'CYTB'.OR.ICASL7.EQ.'DPCL'.OR.
23999     1   ICASL7.EQ.'SOR2'.OR.ICASL7.EQ.'SOR3'.OR.
24000     1   ICASL7.EQ.'TMIN'.OR.ICASL7.EQ.'TMAX'.OR.
24001     1   ICASL7.EQ.'SOR4'.OR.ICASL7.EQ.'PEAK'.OR.
24002     1   ICASL7.EQ.'2DGR'.OR.ICASL7.EQ.'3DGR'.OR.
24003     1   ICASL7.EQ.'4DGR'.OR.
24004     1   ICASL7.EQ.'CBIN'.OR.ICASL7.EQ.'CBIR'.OR.
24005     1   ICASL7.EQ.'JSCT'.OR.ICASL7.EQ.'WSAT'.OR.
24006CCCCC1   ICASL7.EQ.'GATH'.OR.ICASL7.EQ.'SCAT'.OR.
24007     1   ICASL7.EQ.'YFRA'.OR.ICASL7.EQ.'XFRA'.OR.
24008     1   ICASL7.EQ.'GSQD'.OR.ICASL7.EQ.'GSQS'.OR.
24009     1   ICASL7.EQ.'GSQP'.OR.ICASL7.EQ.'GSQM'.OR.
24010     1   ICASL7.EQ.'GQMN'.OR.ICASL7.EQ.'GQMX'.OR.
24011     1   ICASL7.EQ.'GSQL'.OR.ICASL7.EQ.'GSQU'.OR.
24012     1   ICASL7.EQ.'SRNP'.OR.
24013     1   ICASL7.EQ.'NEPA'.OR.ICASL7.EQ.'NEXE')THEN
24014C
24015        ICASEZ=2
24016        CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
24017     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
24018     1              NUMVAL,NIOLD,
24019     1              IBUGA3,ISUBRO,IFOUND,IERROR)
24020        IF(IERROR.EQ.'YES')GOTO9000
24021      ENDIF
24022C
24023      IF(ICASL7.EQ.'CFRT' .OR. ICASL7.EQ.'RSTA' .OR.
24024     1   ICASL7.EQ.'IFRT' .OR. ICASL7.EQ.'EDGV' .OR.
24025     1   ICASL7.EQ.'R1TS' .OR. ICASL7.EQ.'R1LT' .OR.
24026     1   ICASL7.EQ.'R1UT' .OR. ICASL7.EQ.'MWUF' .OR.
24027     1   ICASL7.EQ.'R2TS' .OR. ICASL7.EQ.'R2LT' .OR.
24028     1   ICASL7.EQ.'R2UT' .OR. ICASL7.EQ.'BRAT' .OR.
24029     1   ICASL7.EQ.'R3TS' .OR. ICASL7.EQ.'R3LT' .OR.
24030     1   ICASL7.EQ.'R3UT' .OR. ICASL7.EQ.'BPSE' .OR.
24031     1   ICASL7.EQ.'SOR3' .OR. ICASL7.EQ.'SOR4' .OR.
24032     1   ICASL7.EQ.'3DGR' .OR. ICASL7.EQ.'4DGR'.OR.
24033     1   ICASL7.EQ.'RAN3' .OR. ICASL7.EQ.'DPCL' .OR.
24034     1   ICASL7.EQ.'HCO2' .OR. ICASL7.EQ.'KCO2' .OR.
24035     1   ICASL7.EQ.'CBIN' .OR. ICASL7.EQ.'CBIR' .OR.
24036     1   ICASL7.EQ.'JOIN' .OR. ICASL7.EQ.'JSCT' .OR.
24037     1   ICASL7.EQ.'FNNE' .OR. ICASL7.EQ.'ANNE' .OR.
24038     1   ICASL7.EQ.'SPF1' .OR. ICASL7.EQ.'SPF2')THEN
24039        ICASEZ=3
24040        CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
24041     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
24042     1              NUMVAL,NIOLD,
24043     1              IBUGA3,ISUBRO,IFOUND,IERROR)
24044        IF(IERROR.EQ.'YES')GOTO9000
24045      ENDIF
24046C
24047      IF(ICASL7.EQ.'SPF2'.OR.ICASL7.EQ.'SOR4'.OR.
24048     1   ICASL7.EQ.'4DGR'.OR. ICASL7.EQ.'ANNE')THEN
24049        ICASEZ=4
24050        CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
24051     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
24052     1              NUMVAL,NIOLD,
24053     1              IBUGA3,ISUBRO,IFOUND,IERROR)
24054        IF(IERROR.EQ.'YES')GOTO9000
24055      ENDIF
24056C
24057      IF(ICASL7.EQ.'ANNE')THEN
24058        ICASEZ=5
24059        CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
24060     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
24061     1              NUMVAL,NIOLD,
24062     1              IBUGA3,ISUBRO,IFOUND,IERROR)
24063        IF(IERROR.EQ.'YES')GOTO9000
24064      ENDIF
24065C
24066      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAT2')THEN
24067        WRITE(ICOUT,491)NUMVAL
24068  491   FORMAT('AT THE END OF STEP 2--NUMVAL=',I8)
24069        CALL DPWRST('XXX','BUG ')
24070        DO494I=1,MAXCA2
24071        WRITE(ICOUT,492)ILEFT(I),ILEF2(I),NEWNAM(I),NUMNAM,
24072     1                  ILISL(I),NUMCOL,ICOLL(I),NIOLD
24073        CALL DPWRST('XXX','BUG ')
24074  492   FORMAT('ILEFT(I),ILEFT(I),NEWNAM(I),NUMNAM,ILISL(I),',
24075     1         'NUMCOL,ICOLL(I),NIOLD = ',A4,A4,2X,A4,2X,5I8)
24076  494   CONTINUE
24077      ENDIF
24078C
24079C     ****************************************************************
24080C     **  STEP 4--                                                   *
24081C     **  EXAMINE THE RIGHT-HAND SIDE--                              *
24082C     **  HAS EACH VARIABLE ON THE RIGHT                             *
24083C     **  ALREADY BEEN DEFINED?                                      *
24084C     **  NOTE THAT     ILISR(1), ILISR(2), ILISR(3), ILISR(4)       *
24085C     **  IS THE LINE IN THE TABLE                                   *
24086C     **  OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, *
24087C     **  RESPECTIVELY.                                              *
24088C     **  NOTE THAT     ICOLR(1), ICOLR(2), ICOLR(3), ICOLR(4)       *
24089C     **  IS THE DATA COLUMN (1 TO 10+6)                             *
24090C     **  OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, *
24091C     **  RESPECTIVELY.                                              *
24092C     ****************************************************************
24093C
24094      ISTEPN='4'
24095      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
24096     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24097C
24098C               ********************************************
24099C               **  STEP 4.1--                            **
24100C               **  DETERMINE THE NUMBER OF VARIABLES     **
24101C               **  ON THE RIGHT--1, 2, 3, OR 4           **
24102C               ********************************************
24103C
24104      ISTEPN='4.1'
24105C
24106      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
24107     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24108C
24109      IMATSW='NO'
24110      NUMVAR=1
24111C
24112      IF(ICASL7.EQ.'Y1TS'.OR.ICASL7.EQ.'Y1TD'.OR.
24113     1   ICASL7.EQ.'Y2TS'.OR.ICASL7.EQ.'Y2TD'.OR.
24114     1   ICASL7.EQ.'X1TS'.OR.ICASL7.EQ.'X1TD'.OR.
24115     1   ICASL7.EQ.'X2TS'.OR.ICASL7.EQ.'X2TD')THEN
24116        NUMVAR=0
24117      ENDIF
24118      IF(ICASL7.EQ.'FOU1'.OR.ICASL7.EQ.'IFO1'.OR.
24119     1   ICASL7.EQ.'BINN'.OR.ICASL7.EQ.'BINR'.OR.
24120     1   ICASL7.EQ.'BINP'.OR.ICASL7.EQ.'BIRP'.OR.
24121     1   ICASL7.EQ.'ASHR'.OR.ICASL7.EQ.'ASHC'.OR.
24122     1   ICASL7.EQ.'FFT1'.OR.ICASL7.EQ.'IFF1'.OR.
24123     1   ICASL7.EQ.'COR1'.OR.ICASL7.EQ.'POSQ'.OR.
24124     1   ICASL7.EQ.'POSR'.OR.ICASL7.EQ.'VELE'.OR.
24125     1   ICASL7.EQ.'SECA'.OR.ICASL7.EQ.'SEEL'.OR.
24126     1   ICASL7.EQ.'IFRT'.OR.ICASL7.EQ.'COPV'.OR.
24127     1   ICASL7.EQ.'RANS'.OR.ICASL7.EQ.'RANP'.OR.
24128     1   ICASL7.EQ.'WMOM'.OR.ICASL7.EQ.'WMOM'.OR.
24129     1   ICASL7.EQ.'CBIN'.OR.ICASL7.EQ.'CBIR'.OR.
24130     1   ICASL7.EQ.'LPFI'.OR.ICASL7.EQ.'HPFI'.OR.
24131     1   ICASL7.EQ.'DIGI'.OR.ICASL7.EQ.'EQUF'.OR.
24132     1   ICASL7.EQ.'IQUF'.OR.ICASL7.EQ.'TIQF'.OR.
24133     1   ICASL7.EQ.'LONT'.OR.ICASL7.EQ.'WINS')THEN
24134        NUMVAR=1
24135      ELSEIF(ICASL7.EQ.'CONV'.OR.ICASL7.EQ.'DECO'.OR.
24136     1       ICASL7.EQ.'BOOT'.OR.ICASL7.EQ.'FREQ'.OR.
24137     1       ICASL7.EQ.'SUMD'.OR.ICASL7.EQ.'SUBS'.OR.
24138     1       ICASL7.EQ.'FOUT'.OR.ICASL7.EQ.'IFOU'.OR.
24139     1       ICASL7.EQ.'FFT' .OR.ICASL7.EQ.'CUMH'.OR.
24140     1       ICASL7.EQ.'HAZA'.OR.ICASL7.EQ.'FRAW'.OR.
24141     1       ICASL7.EQ.'EXPS'.OR.ICASL7.EQ.'IFFT'.OR.
24142     1       ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
24143     1       ICASL7.EQ.'CORO'.OR.ICASL7.EQ.'COCO'.OR.
24144     1       ICASL7.EQ.'POAD'.OR.ICASL7.EQ.'POSU'.OR.
24145     1       ICASL7.EQ.'POMU'.OR.ICASL7.EQ.'PODI'.OR.
24146     1       ICASL7.EQ.'POGC'.OR.ICASL7.EQ.'POLC'.OR.
24147     1       ICASL7.EQ.'POEV'.OR.ICASL7.EQ.'VEAD'.OR.
24148     1       ICASL7.EQ.'VESU'.OR.ICASL7.EQ.'VEDP'.OR.
24149     1       ICASL7.EQ.'VECP'.OR.ICASL7.EQ.'VEDI'.OR.
24150     1       ICASL7.EQ.'2DCH'.OR.ICASL7.EQ.'YTHL'.OR.
24151     1       ICASL7.EQ.'NEXS'.OR.ICASL7.EQ.'NEXP'.OR.
24152     1       ICASL7.EQ.'SOR2'.OR.ICASL7.EQ.'RAN2'.OR.
24153     1       ICASL7.EQ.'MWUF'.OR.ICASL7.EQ.'EXTP'.OR.
24154     1       ICASL7.EQ.'ENCB'.OR.ICASL7.EQ.'NNE1'.OR.
24155     1       ICASL7.EQ.'NNE2'.OR.ICASL7.EQ.'NNE3'.OR.
24156     1       ICASL7.EQ.'NNE4'.OR.ICASL7.EQ.'RAEQ'.OR.
24157     1       ICASL7.EQ.'GSQD'.OR.ICASL7.EQ.'GSQS'.OR.
24158     1       ICASL7.EQ.'GSQP'.OR.ICASL7.EQ.'GSQM'.OR.
24159     1       ICASL7.EQ.'GQMN'.OR.ICASL7.EQ.'GQMX'.OR.
24160     1       ICASL7.EQ.'GSQL'.OR.ICASL7.EQ.'GSQU'.OR.
24161     1       ICASL7.EQ.'UNST'.OR.ICASL7.EQ.'WSAT'.OR.
24162     1       ICASL7.EQ.'NKDM'.OR.ICASL7.EQ.'2DGR'.OR.
24163     1       ICASL7.EQ.'VEAN'.OR.ICASL7.EQ.'SEUN')THEN
24164        NUMVAR=2
24165      ELSEIF(ICASL7.EQ.'SEIN'.OR.ICASL7.EQ.'SECO'.OR.
24166     1       ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'LOAN'.OR.
24167     1       ICASL7.EQ.'LOOR'.OR.ICASL7.EQ.'LONA'.OR.
24168     1       ICASL7.EQ.'LONO'.OR.ICASL7.EQ.'LOIM'.OR.
24169     1       ICASL7.EQ.'LOEQ'.OR.ICASL7.EQ.'LOXO'.OR.
24170     1       ICASL7.EQ.'FRAC'.OR.ICASL7.EQ.'GEMU'.OR.
24171     1       ICASL7.EQ.'JAIN'.OR.ICASL7.EQ.'CFRT'.OR.
24172     1       ICASL7.EQ.'HCON'.OR.ICASL7.EQ.'KCON'.OR.
24173     1       ICASL7.EQ.'LMOM'.OR.ICASL7.EQ.'PWMO'.OR.
24174     1       ICASL7.EQ.'BPWM'.OR.ICASL7.EQ.'SRTB'.OR.
24175     1       ICASL7.EQ.'GATH'.OR.ICASL7.EQ.'SCAT'.OR.
24176     1       ICASL7.EQ.'SHIF'.OR.ICASL7.EQ.'CSHI'.OR.
24177     1       ICASL7.EQ.'LARG'.OR.ICASL7.EQ.'SMAL'.OR.
24178     1       ICASL7.EQ.'VPER'.OR.
24179     1       ICASL7.EQ.'KEEP'.OR.ICASL7.EQ.'OMIT'.OR.
24180     1       ICASL7.EQ.'TMIN'.OR.ICASL7.EQ.'TMAX'.OR.
24181     1       ICASL7.EQ.'EXPA'.OR.ICASL7.EQ.'JSCO'.OR.
24182     1       ICASL7.EQ.'PEAK'.OR.ICASL7.EQ.'PEAR'.OR.
24183     1       ICASL7.EQ.'DIPE'.OR.ICASL7.EQ.'MTC2'.OR.
24184     1       ICASL7.EQ.'COCD'.OR.ICASL7.EQ.'JITT')THEN
24185        NUMVAR=2
24186      ELSEIF(ICASL7.EQ.'INTR'.OR.ICASL7.EQ.'LINT'.OR.
24187     1       ICASL7.EQ.'HCO2'.OR.ICASL7.EQ.'KCO2'.OR.
24188     1       ICASL7.EQ.'COCP'.OR.ICASL7.EQ.'AGCO'.OR.
24189     1       ICASL7.EQ.'KNSE'.OR.ICASL7.EQ.'NEXC'.OR.
24190     1       ICASL7.EQ.'NEPA'.OR.ICASL7.EQ.'NEXE'.OR.
24191     1       ICASL7.EQ.'SPF2'.OR.ICASL7.EQ.'NEYT'.OR.
24192     1       ICASL7.EQ.'SOR3'.OR.ICASL7.EQ.'RAN3'.OR.
24193     1       ICASL7.EQ.'EBCL'.OR.ICASL7.EQ.'IZSC'.OR.
24194     1       ICASL7.EQ.'JOIN'.OR.ICASL7.EQ.'GRPS'.OR.
24195     1       ICASL7.EQ.'JSCT'.OR.ICASL7.EQ.'PA  '.OR.
24196     1       ICASL7.EQ.'GWSA'.OR.ICASL7.EQ.'3DGR'.OR.
24197     1       ICASL7.EQ.'HERI'.OR.ICASL7.EQ.'HERD'.OR.
24198     1       ICASL7.EQ.'INSE'.OR.
24199     1       ICASL7.EQ.'EBLL'.OR.ICASL7.EQ.'EBUL')THEN
24200        NUMVAR=3
24201      ELSEIF(ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
24202     1       ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI'.OR.
24203     1       ICASL7.EQ.'SOR4'.OR.ICASL7.EQ.'POPL'.OR.
24204     1       ICASL7.EQ.'EN  '.OR.ICASL7.EQ.'ZPRI'.OR.
24205     1       ICASL7.EQ.'EZPL'.OR.ICASL7.EQ.'EZMI'.OR.
24206     1       ICASL7.EQ.'IZET'.OR.ICASL7.EQ.'SRNP'.OR.
24207     1       ICASL7.EQ.'FNNE'.OR.ICASL7.EQ.'ANNE'.OR.
24208     1       ICASL7.EQ.'HERG'.OR.ICASL7.EQ.'4DGR'.OR.
24209     1       ICASL7.EQ.'EDGV'.OR.ICASL7.EQ.'SPF1')THEN
24210        NUMVAR=4
24211      ELSEIF(ICASL7.EQ.'2DIN'.OR.ICASL7.EQ.'BILI'.OR.
24212     1       ICASL7.EQ.'DPCL'.OR.ICASL7.EQ.'DPTS'.OR.
24213     1       ICASL7.EQ.'DPLT'.OR.ICASL7.EQ.'DPUT'.OR.
24214     1       ICASL7.EQ.'BRAT'.OR.ICASL7.EQ.'BPSE'.OR.
24215     1       ICASL7.EQ.'R2TS'.OR.ICASL7.EQ.'R2LT'.OR.
24216     1       ICASL7.EQ.'R2UT'.OR.ICASL7.EQ.'BIVA')THEN
24217        NUMVAR=5
24218      ELSEIF(ICASL7.EQ.'BFPD'.OR.ICASL7.EQ.'BFCD'.OR.
24219     1       ICASL7.EQ.'BFPP'.OR.ICASL7.EQ.'PARL'.OR.
24220     1       ICASL7.EQ.'PERL')THEN
24221        NUMVAR=6
24222      ELSEIF(ICASL7.EQ.'R1TS'.OR.ICASL7.EQ.'R1LT'.OR.
24223     1       ICASL7.EQ.'R1UT'.OR.ICASL7.EQ.'TPOI')THEN
24224        NUMVAR=7
24225      ELSEIF(ICASL7.EQ.'EEPD'.OR.ICASL7.EQ.'EECD'.OR.
24226     1       ICASL7.EQ.'EEPP'.OR.ICASL7.EQ.'INTL')THEN
24227        NUMVAR=8
24228      ELSEIF(ICASL7.EQ.'R3TS'.OR.ICASL7.EQ.'R3LT'.OR.
24229     1       ICASL7.EQ.'R3UT')THEN
24230        NUMVAR=9
24231      ELSEIF(ICASL7.EQ.'SORC'.OR.ICASL7.EQ.'STAC'.OR.
24232     1       ICASL7.EQ.'RSTA'.OR.ICASL7.EQ.'MTCH'.OR.
24233     1       ICASL7.EQ.'STAN'.OR.ICASL7.EQ.'ZSCO'.OR.
24234     1       ICASL7.EQ.'USCO'.OR.ICASL7.EQ.'LSTA'.OR.
24235     1       ICASL7.EQ.'CUMI'.OR.ICASL7.EQ.'REPL'.OR.
24236     1       ICASL7.EQ.'LSST'.OR.ICASL7.EQ.'CRTA'.OR.
24237     1       ICASL7.EQ.'CTCU'.OR.
24238     1       ICASL7.EQ.'CDCT'.OR.ICASL7.EQ.'COMB'.OR.
24239     1       ICASL7.EQ.'MOVI'.OR.ICASL7.EQ.'CUMU'.OR.
24240     1       ICASL7.EQ.'WIND'.OR.
24241     1       ICASL7.EQ.'MNRK'.OR.ICASL7.EQ.'MDRK'.OR.
24242     1       ICASL7(1:2).EQ.'CT')THEN
24243C
24244        ISTRT=ILOCV
24245        ILAST=NUMARG
24246        DO1051I=ISTRT,NUMARG
24247          IHRIGH(I)=IHARG(I)
24248          IHRIG2(I)=IHARG2(I)
24249          IF(IHRIGH(I).EQ.'SUBS'.AND.IHRIG2(I).EQ.'ET  ')THEN
24250            ILAST=I-1
24251            GOTO1054
24252          ELSEIF(IHRIGH(I).EQ.'EXCE'.AND.IHRIG2(I).EQ.'PT  ')THEN
24253            ILAST=I-1
24254            GOTO1054
24255          ELSEIF(IHRIGH(I).EQ.'FOR '.AND.IHRIG2(I).EQ.'    ')THEN
24256            ILAST=I-1
24257            GOTO1054
24258          ENDIF
24259 1051   CONTINUE
24260 1054   CONTINUE
24261        NUMVAR=ILAST-ISTRT+1
24262C
24263        IF(ICASL7.EQ.'MTCH' .OR. ICASL7.EQ.'REPL')THEN
24264          IF(NUMVAR.EQ.2)THEN
24265            ICASMT='INDE'
24266          ELSEIF(NUMVAR.EQ.3)THEN
24267            ICASMT='TRAN'
24268          ELSE
24269            IF(ICASL7.EQ.'MTCH')THEN
24270              WRITE(ICOUT,1061)
24271            ELSEIF(ICASL7.EQ.'REPL')THEN
24272              WRITE(ICOUT,1062)
24273            ENDIF
24274 1061       FORMAT('****** FOR THE MATCH COMMAND, THE NUMBER OF ',
24275     1             'VARIABLES TO THE RIGHT')
24276 1062       FORMAT('****** FOR THE REPLACE COMMAND, THE NUMBER OF ',
24277     1             'VARIABLES TO THE RIGHT')
24278            CALL DPWRST('XXX','BUG ')
24279            WRITE(ICOUT,1063)NUMVAR
24280 1063       FORMAT('       MUST BE 2 OR 3.  ',I8,' VARIABLES FOUND.')
24281            CALL DPWRST('XXX','BUG ')
24282          ENDIF
24283        ENDIF
24284      ENDIF
24285C
24286      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')THEN
24287        WRITE(ICOUT,1091)ICASL7,NUMVAR
24288 1091   FORMAT('ICASL7,NUMVAR = ',A4,2X,I8)
24289        CALL DPWRST('XXX','BUG ')
24290      ENDIF
24291C
24292C               ***************************************
24293C               **  STEP 5.1--                       **
24294C               **  EXAMINE THE VARIABLES            **
24295C               **  ON THE RIGHT.                    **
24296C               ***************************************
24297C
24298      ISTEPN='5.1'
24299      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
24300     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24301C
24302      IFLAG1=0
24303      IF(ICASL7.EQ.'JAIN'.OR.ICASL7.EQ.'AGCO'.OR.
24304     1   ICASL7.EQ.'EBLL'.OR.ICASL7.EQ.'EBUL'.OR.
24305     1   ICASL7.EQ.'EBCL'.OR.
24306     1   ICASL7.EQ.'DPCL'.OR.ICASL7.EQ.'DPTS'.OR.
24307     1   ICASL7.EQ.'DPLT'.OR.ICASL7.EQ.'DPUT'.OR.
24308     1   ICASL7.EQ.'R1TS'.OR.ICASL7.EQ.'R1LT'.OR.
24309     1   ICASL7.EQ.'R1UT'.OR.ICASL7.EQ.'INTL'.OR.
24310     1   ICASL7.EQ.'PARL'.OR.ICASL7.EQ.'PERL'.OR.
24311     1   ICASL7.EQ.'R2TS'.OR.ICASL7.EQ.'R2LT'.OR.
24312     1   ICASL7.EQ.'R2UT'.OR.ICASL7.EQ.'BRAT'.OR.
24313     1   ICASL7.EQ.'R3TS'.OR.ICASL7.EQ.'R3LT'.OR.
24314     1   ICASL7.EQ.'R3UT'.OR.ICASL7.EQ.'BPSE'.OR.
24315     1   ICASL7.EQ.'RANS'.OR.ICASL7.EQ.'RANP'.OR.
24316     1   ICASL7.EQ.'MWUF'.OR.ICASL7.EQ.'DIGI'.OR.
24317     1   ICASL7.EQ.'NEXS'.OR.ICASL7.EQ.'NEXP'.OR.
24318     1   ICASL7.EQ.'KNSE'.OR.ICASL7.EQ.'NEXC'.OR.
24319     1   ICASL7.EQ.'NEPA'.OR.ICASL7.EQ.'NEXE'.OR.
24320     1   ICASL7.EQ.'SRNP'.OR.
24321     1   ICASL7.EQ.'NEYT'.OR.ICASL7.EQ.'COMB'
24322     1   )THEN
24323         IFLAG1=1
24324      ENDIF
24325      ICASEZ=1
24326      IF(NUMVAR.GE.1)THEN
24327        CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
24328     1              IHRIGH(1),IHRIG2(1),ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
24329     1              IFLAG1,ATEMP2,ITEMP,
24330     1              IBUGA3,ISUBRO,IFOUND,IERROR)
24331        IF(IERROR.EQ.'YES')GOTO9000
24332      ENDIF
24333C
24334      IF(ICASL7.EQ.'NEXS' .OR. ICASL7.EQ.'NEXP'.OR.
24335     1   ICASL7.EQ.'NEPA' .OR. ICASL7.EQ.'NEXE')THEN
24336        IJUNK=INT(TEMPS(1)+0.01)
24337        IF(IJUNK.LE.0 .OR. IJUNK.NE.NLAST)THEN
24338          NUMVAR=1
24339        ENDIF
24340      ELSEIF(ICASL7.EQ.'KNSE' .OR. ICASL7.EQ.'NEXC')THEN
24341        IJUNK1=INT(TEMPS(1)+0.01)
24342      ELSEIF(ICASL7.EQ.'NEYT')THEN
24343        IJUNK1=INT(TEMPS(1)+0.01)
24344        IF(IJUNK1.NE.NLAST)THEN
24345          NUMVAR=2
24346        ENDIF
24347      ENDIF
24348C
24349      IF(NUMVAR.GE.2)THEN
24350        IFLAG1=0
24351        IF(ICASL7.EQ.'LMOM' .OR. ICASL7.EQ.'PWMO' .OR.
24352     1     ICASL7.EQ.'BPWM' .OR. ICASL7.EQ.'JAIN' .OR.
24353     1     ICASL7.EQ.'EXPS' .OR. ICASL7.EQ.'MTCH' .OR.
24354     1     ICASL7.EQ.'MTC2' .OR.
24355     1     ICASL7.EQ.'EBLL' .OR. ICASL7.EQ.'EBUL' .OR.
24356     1     ICASL7.EQ.'EBCL' .OR. ICASL7.EQ.'INTL' .OR.
24357     1     ICASL7.EQ.'PARL' .OR. ICASL7.EQ.'PERL'.OR.
24358     1     ICASL7.EQ.'DPCL' .OR. ICASL7.EQ.'DPTS' .OR.
24359     1     ICASL7.EQ.'DPLT' .OR. ICASL7.EQ.'DPUT' .OR.
24360     1     ICASL7.EQ.'R1TS' .OR. ICASL7.EQ.'R1LT' .OR.
24361     1     ICASL7.EQ.'R1UT' .OR. ICASL7.EQ.'IZSC' .OR.
24362     1     ICASL7.EQ.'R2TS' .OR. ICASL7.EQ.'R2LT' .OR.
24363     1     ICASL7.EQ.'R2UT' .OR. ICASL7.EQ.'BRAT' .OR.
24364     1     ICASL7.EQ.'R3TS' .OR. ICASL7.EQ.'R3LT' .OR.
24365     1     ICASL7.EQ.'R3UT' .OR. ICASL7.EQ.'BPSE' .OR.
24366     1     ICASL7.EQ.'SHIF' .OR. ICASL7.EQ.'CSHI' .OR.
24367     1     ICASL7.EQ.'LARG' .OR. ICASL7.EQ.'SMAL' .OR.
24368     1     ICASL7.EQ.'VPER' .OR. ICASL7.EQ.'SRNP' .OR.
24369     1     ICASL7.EQ.'KNSE' .OR. ICASL7.EQ.'NEXC' .OR.
24370     1     ICASL7.EQ.'COMB' .OR. ICASL7.EQ.'MWUF' .OR.
24371     1     ICASL7.EQ.'IZSC' .OR. ICASL7.EQ.'ZPRI' .OR.
24372     1     ICASL7.EQ.'PA  ' .OR. ICASL7.EQ.'DIPE' .OR.
24373     1     ICASL7.EQ.'AGCO' .OR. ICASL7.EQ.'JITT')THEN
24374          IFLAG1=1
24375        ENDIF
24376        ICASEZ=2
24377        CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
24378     1              IHRIGH(2),IHRIG2(2),ICOLR,ILISR,NIRIGH,
24379     1              ITYPA,TEMPS,
24380     1              IFLAG1,ATEMP2,ITEMP,
24381     1              IBUGA3,ISUBRO,IFOUND,IERROR)
24382        IF(IERROR.EQ.'YES')GOTO9000
24383      ENDIF
24384C
24385      IF(ICASL7.EQ.'KNSE' .OR. ICASL7.EQ.'NEXC')THEN
24386        IJUNK2=INT(TEMPS(2)+0.01)
24387        IF((IJUNK1.LE.0 .OR. IJUNK1.NE.KLAST) .OR.
24388     1     (IJUNK2.LE.0 .OR. IJUNK2.NE.NLAST))THEN
24389          NUMVAR=2
24390        ENDIF
24391      ENDIF
24392C
24393      IF(NUMVAR.GE.3)THEN
24394        IFLAG1=0
24395        IF(ICASL7.EQ.'EBLL' .OR. ICASL7.EQ.'EBUL' .OR.
24396     1     ICASL7.EQ.'EBCL' .OR. ICASL7.EQ.'SRNP' .OR.
24397     1     ICASL7.EQ.'DPCL' .OR. ICASL7.EQ.'DPTS' .OR.
24398     1     ICASL7.EQ.'DPLT' .OR. ICASL7.EQ.'DPUT' .OR.
24399     1     ICASL7.EQ.'R1TS' .OR. ICASL7.EQ.'R1LT' .OR.
24400     1     ICASL7.EQ.'R1UT' .OR. ICASL7.EQ.'INTL' .OR.
24401     1     ICASL7.EQ.'PARL' .OR. ICASL7.EQ.'PERL' .OR.
24402     1     ICASL7.EQ.'R2TS' .OR. ICASL7.EQ.'R2LT' .OR.
24403     1     ICASL7.EQ.'R2UT' .OR. ICASL7.EQ.'BRAT' .OR.
24404     1     ICASL7.EQ.'R3TS' .OR. ICASL7.EQ.'R3LT' .OR.
24405     1     ICASL7.EQ.'R3UT' .OR. ICASL7.EQ.'BPSE' .OR.
24406     1     ICASL7.EQ.'COMB' .OR. ICASL7.EQ.'EN  ' .OR.
24407     1     ICASL7.EQ.'IZSC' .OR. ICASL7.EQ.'ZPRI' .OR.
24408     1     ICASL7.EQ.'EZPL' .OR. ICASL7.EQ.'EZMI' .OR.
24409     1     ICASL7.EQ.'IZET' .OR. ICASL7.EQ.'TPOI' .OR.
24410     1     ICASL7.EQ.'PA  ' .OR. ICASL7.EQ.'GWSA' .OR.
24411     1     ICASL7.EQ.'HERG' .OR. ICASL7.EQ.'INSE' .OR.
24412     1     ICASL7.EQ.'AGCO' .OR. ICASL7.EQ.'SPF2')THEN
24413          IFLAG1=1
24414        ENDIF
24415        ICASEZ=3
24416        CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
24417     1              IHRIGH(3),IHRIG2(3),ICOLR,ILISR,NIRIGH,
24418     1              ITYPA,TEMPS,
24419     1              IFLAG1,ATEMP2,ITEMP,
24420     1              IBUGA3,ISUBRO,IFOUND,IERROR)
24421        IF(IERROR.EQ.'YES')GOTO9000
24422      ENDIF
24423C
24424      IF(NUMVAR.GE.4)THEN
24425        IFLAG1=0
24426        IF(ICASL7.EQ.'DPCL'.OR.ICASL7.EQ.'DPTS'.OR.
24427     1     ICASL7.EQ.'R1TS'.OR.ICASL7.EQ.'R1LT'.OR.
24428     1     ICASL7.EQ.'R1UT'.OR.ICASL7.EQ.'INTL'.OR.
24429     1     ICASL7.EQ.'PARL'.OR.ICASL7.EQ.'PERL'.OR.
24430     1     ICASL7.EQ.'R3TS'.OR.ICASL7.EQ.'R3LT'.OR.
24431     1     ICASL7.EQ.'R3UT'.OR.ICASL7.EQ.'BPSE'.OR.
24432     1     ICASL7.EQ.'R2TS'.OR.ICASL7.EQ.'R2LT'.OR.
24433     1     ICASL7.EQ.'R2UT'.OR.ICASL7.EQ.'BRAT'.OR.
24434     1     ICASL7.EQ.'COMB'.OR.ICASL7.EQ.'SRNP'.OR.
24435     1     ICASL7.EQ.'BFPD'.OR.ICASL7.EQ.'BFCD'.OR.
24436     1     ICASL7.EQ.'BFPP'.OR.ICASL7.EQ.'TPOI'.OR.
24437     1     ICASL7.EQ.'EEPD'.OR.ICASL7.EQ.'EECD'.OR.
24438     1     ICASL7.EQ.'EEPP'.OR.ICASL7.EQ.'EN  '.OR.
24439     1     ICASL7.EQ.'EZPL'.OR.ICASL7.EQ.'EZMI' .OR.
24440     1     ICASL7.EQ.'IZET'.OR.ICASL7.EQ.'ZPRI' .OR.
24441     1     ICASL7.EQ.'HERG'.OR.
24442     1     ICASL7.EQ.'DPLT'.OR.ICASL7.EQ.'DPUT')THEN
24443          IFLAG1=1
24444        ENDIF
24445        ICASEZ=4
24446        CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
24447     1              IHRIGH(4),IHRIG2(4),ICOLR,ILISR,NIRIGH,
24448     1              ITYPA,TEMPS,
24449     1              IFLAG1,ATEMP2,ITEMP,
24450     1              IBUGA3,ISUBRO,IFOUND,IERROR)
24451        IF(IERROR.EQ.'YES')GOTO9000
24452      ENDIF
24453C
24454C  5 OR MORE VARIABLES.
24455C
24456      IF(NUMVAR.GE.5)THEN
24457        IFLAG1=0
24458        IF(ICASL7.EQ.'DPCL'.OR.ICASL7.EQ.'DPTS'.OR.
24459     1     ICASL7.EQ.'R1TS'.OR.ICASL7.EQ.'R1LT'.OR.
24460     1     ICASL7.EQ.'R1UT'.OR.ICASL7.EQ.'INTL'.OR.
24461     1     ICASL7.EQ.'PARL'.OR.ICASL7.EQ.'PERL'.OR.
24462     1     ICASL7.EQ.'R3TS'.OR.ICASL7.EQ.'R3LT'.OR.
24463     1     ICASL7.EQ.'R3UT'.OR.ICASL7.EQ.'BPSE'.OR.
24464     1     ICASL7.EQ.'R2TS'.OR.ICASL7.EQ.'R2LT'.OR.
24465     1     ICASL7.EQ.'R2UT'.OR.ICASL7.EQ.'BRAT'.OR.
24466     1     ICASL7.EQ.'COMB'.OR.
24467     1     ICASL7.EQ.'BFPD'.OR.ICASL7.EQ.'BFCD'.OR.
24468     1     ICASL7.EQ.'BFPP'.OR.
24469     1     ICASL7.EQ.'EEPD'.OR.ICASL7.EQ.'EECD'.OR.
24470     1     ICASL7.EQ.'EEPP'.OR.ICASL7.EQ.'TPOI'.OR.
24471     1     ICASL7.EQ.'DPLT'.OR.ICASL7.EQ.'DPUT')THEN
24472          IFLAG1=1
24473        ENDIF
24474        DO1110ICASEZ=5,NUMVAR
24475          CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
24476     1                IHRIGH(ICASEZ),IHRIG2(ICASEZ),
24477     1                ICOLR,ILISR,NIRIGH,
24478     1                ITYPA,TEMPS,
24479     1                IFLAG1,ATEMP2,ITEMP,
24480     1                IBUGA3,ISUBRO,IFOUND,IERROR)
24481C
24482C         LOCATION PARAMETER OPTIONAL FOR END EFFECTS WEIBULL,
24483C         SO CHECK TO SEE IF LAST PARAMETER GIVEN.
24484C
24485          IF(ICASL7.EQ.'EEPD'.OR.ICASL7.EQ.'EECD'.OR.
24486     1       ICASL7.EQ.'EEPP'.AND.ICASEZ.EQ.8)THEN
24487             IF(IERROR.EQ.'YES')THEN
24488               NUMVAR=7
24489               IERROR='NO'
24490             ENDIF
24491          ENDIF
24492 1110   CONTINUE
24493        IF(IERROR.EQ.'YES')GOTO9000
24494      ENDIF
24495C
24496C
24497C               ******************************************************
24498C               **  STEP 6.1--                                      **
24499C               **  FOR CERTAIN 2-VARIABLE AND 3-VARIABLE CASES,    **
24500C               **  CHECK THAT VARIABLES 1 AND 2 HAVE THE SAME      **
24501C               **  NUMBER OF ELEMENTS.                             **
24502C               **  THIS CHECK IS NOT DONE FOR CONVOLUTION,         **
24503C               **  DECONVOLUTION, FREQUENCY                        **
24504C               **  AND SUM (DISTINCT)                              **
24505C               ******************************************************
24506C
24507      ISTEPN='6.1'
24508      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
24509     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24510C
24511C  CASE 1: NO VARIABLES NEED TO BE SAME LENGTH
24512C
24513      IF(ICASL7.EQ.'CONV'.OR.ICASL7.EQ.'DECO'.OR.
24514     1   ICASL7.EQ.'FREQ'.OR.ICASL7.EQ.'SUMD'.OR.
24515     1   ICASL7.EQ.'SUBS'.OR.ICASL7.EQ.'POAD'.OR.
24516     1   ICASL7.EQ.'POSU'.OR.ICASL7.EQ.'POMU'.OR.
24517     1   ICASL7.EQ.'PODI'.OR.ICASL7.EQ.'POSQ'.OR.
24518     1   ICASL7.EQ.'POSR'.OR.ICASL7.EQ.'POGC'.OR.
24519     1   ICASL7.EQ.'POLC'.OR.ICASL7.EQ.'POEV'.OR.
24520     1   ICASL7.EQ.'SEUN'.OR.ICASL7.EQ.'SEIN'.OR.
24521     1   ICASL7.EQ.'SECO'.OR.ICASL7.EQ.'SECA'.OR.
24522     1   ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'SEEL'.OR.
24523     1   ICASL7.EQ.'LONT'.OR.ICASL7.EQ.'VELE'.OR.
24524     1   ICASL7.EQ.'GEMU'.OR.ICASL7.EQ.'COCD'.OR.
24525     1   ICASL7.EQ.'KEEP'.OR.ICASL7.EQ.'OMIT'.OR.
24526     1   ICASL7.EQ.'COCP'.OR.ICASL7.EQ.'EXPS'.OR.
24527     1   ICASL7.EQ.'MTCH'.OR.ICASL7.EQ.'STAC'.OR.
24528     1   ICASL7.EQ.'MTC2'.OR.ICASL7.EQ.'STAC'.OR.
24529     1   ICASL7.EQ.'RSTA'.OR.ICASL7.EQ.'LMOM'.OR.
24530     1   ICASL7.EQ.'PWMO'.OR.ICASL7.EQ.'BPWM'.OR.
24531     1   ICASL7.EQ.'EBLL'.OR.ICASL7.EQ.'EBUL'.OR.
24532     1   ICASL7.EQ.'EBCL'.OR.ICASL7.EQ.'EXPA'.OR.
24533     1   ICASL7.EQ.'AGCO'.OR.ICASL7.EQ.'COMB'.OR.
24534     1   ICASL7.EQ.'DPCL'.OR.ICASL7.EQ.'DPTS'.OR.
24535     1   ICASL7.EQ.'DPLT'.OR.ICASL7.EQ.'DPUT'.OR.
24536     1   ICASL7.EQ.'R1TS'.OR.ICASL7.EQ.'R1LT'.OR.
24537     1   ICASL7.EQ.'R1UT'.OR.ICASL7.EQ.'INTL'.OR.
24538     1   ICASL7.EQ.'PARL'.OR.ICASL7.EQ.'PERL'.OR.
24539     1   ICASL7.EQ.'R3TS'.OR.ICASL7.EQ.'R3LT'.OR.
24540     1   ICASL7.EQ.'R3UT'.OR.ICASL7.EQ.'BPSE'.OR.
24541     1   ICASL7.EQ.'R2TS'.OR.ICASL7.EQ.'R2LT'.OR.
24542     1   ICASL7.EQ.'R2UT'.OR.ICASL7.EQ.'BRAT'.OR.
24543     1   ICASL7.EQ.'NEXS'.OR.ICASL7.EQ.'NEXP'.OR.
24544     1   ICASL7.EQ.'KNSE'.OR.ICASL7.EQ.'NEXC'.OR.
24545     1   ICASL7.EQ.'GATH'.OR.ICASL7.EQ.'SCAT'.OR.
24546     1   ICASL7.EQ.'TMIN'.OR.ICASL7.EQ.'TMAX'.OR.
24547     1   ICASL7.EQ.'SHIF'.OR.ICASL7.EQ.'CSHI'.OR.
24548     1   ICASL7.EQ.'LARG'.OR.ICASL7.EQ.'SMAL'.OR.
24549     1   ICASL7.EQ.'VPER'.OR.ICASL7.EQ.'SRNP'.OR.
24550     1   ICASL7.EQ.'INSE'.OR.
24551     1   NUMVAR.LE.1)THEN
24552        GOTO2190
24553C
24554C  CASE 1A: ALL VARIABLES NEED TO BE SAME LENGTH
24555C
24556      ELSEIF(ICASL7.EQ.'STAN' .OR. ICASL7.EQ.'ZSCO'.OR.
24557     1       ICASL7.EQ.'USCO' .OR. ICASL7.EQ.'LSTA'.OR.
24558     1       ICASL7.EQ.'LSST' .OR. ICASL7.EQ.'CRTA'.OR.
24559     1       ICASL7.EQ.'CTCU' .OR. ICASL7(1:2).EQ.'CT' .OR.
24560     1       ICASL7.EQ.'INTL' .OR. ICASL7.EQ.'SOR3' .OR.
24561     1       ICASL7.EQ.'SOR4' .OR. ICASL7.EQ.'RAN3' .OR.
24562     1       ICASL7.EQ.'WIND' .OR. ICASL7.EQ.'WSAT' .OR.
24563     1       ICASL7.EQ.'MNRK' .OR. ICASL7.EQ.'MDRK' .OR.
24564     1       ICASL7.EQ.'MOVI' .OR. ICASL7.EQ.'CUMU')THEN
24565        DO2199I=2,NUMVAR
24566          IF(NIRIGH(1).NE.NIRIGH(I))THEN
24567            IERROR='YES'
24568            WRITE(ICOUT,2191)
24569 2191       FORMAT('***** ERROR 2191 IN DPMATC--')
24570            CALL DPWRST('XXX','BUG ')
24571            WRITE(ICOUT,2192)NUMVAR
24572 2192       FORMAT('      ALL ',I8,' VARIABLES SHOULD HAVE THE SAME ',
24573     1             'NUMBER OF ELEMENTS.')
24574            CALL DPWRST('XXX','BUG ')
24575            WRITE(ICOUT,2193)NIRIGH(1)
24576 2193       FORMAT('      VARIABLE ONE HAS ',I8,' OBSERVATIONS.')
24577            CALL DPWRST('XXX','BUG ')
24578            WRITE(ICOUT,2194)I,NIRIGH(I)
24579 2194       FORMAT('      VARIABLE ',I2,' HAS ',I8,' OBSERVATIONS.')
24580            CALL DPWRST('XXX','BUG ')
24581          ENDIF
24582 2199   CONTINUE
24583C
24584        IF(IERROR.EQ.'YES')THEN
24585          IF(IWIDTH.GE.1)THEN
24586             WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24587             CALL DPWRST('XXX','BUG ')
24588           ENDIF
24589           GOTO19000
24590        ENDIF
24591C
24592C  CASE 2: SAME LENGTH REQUIRED FOR VARIABLES 1 AND 2
24593C
24594      ELSEIF(ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
24595     1       ICASL7.EQ.'CORO'.OR.
24596     1       ICASL7.EQ.'COCO'.OR.ICASL7.EQ.'CFRT'.OR.
24597     1       ICASL7.EQ.'VEAD'.OR.ICASL7.EQ.'VESU'.OR.
24598     1       ICASL7.EQ.'VEDP'.OR.ICASL7.EQ.'VECP'.OR.
24599     1       ICASL7.EQ.'VEDI'.OR.ICASL7.EQ.'VEAN'.OR.
24600     1       ICASL7.EQ.'LOAN'.OR.ICASL7.EQ.'LOOR'.OR.
24601     1       ICASL7.EQ.'LONA'.OR.ICASL7.EQ.'LONO'.OR.
24602     1       ICASL7.EQ.'LOIM'.OR.ICASL7.EQ.'LOEQ'.OR.
24603     1       ICASL7.EQ.'LOXO'.OR.ICASL7.EQ.'HCON'.OR.
24604     1       ICASL7.EQ.'KCON'.OR.ICASL7.EQ.'SRTB'.OR.
24605     1       ICASL7.EQ.'2DCH'.OR.ICASL7.EQ.'EDGV'.OR.
24606     1       ICASL7.EQ.'SPF1'.OR.ICASL7.EQ.'SPF2'.OR.
24607     1       ICASL7.EQ.'YTHL'.OR.ICASL7.EQ.'EN  '.OR.
24608     1       ICASL7.EQ.'EZPL'.OR.ICASL7.EQ.'EZMI'.OR.
24609     1       ICASL7.EQ.'IZET'.OR.ICASL7.EQ.'JSCO'.OR.
24610     1       ICASL7.EQ.'SOR2'.OR.ICASL7.EQ.'RAN2'.OR.
24611     1       ICASL7.EQ.'TPOI'.OR.ICASL7.EQ.'EXTP'.OR.
24612     1       ICASL7.EQ.'PEAK'.OR.ICASL7.EQ.'PEAR'.OR.
24613     1       ICASL7.EQ.'ENCB'.OR.ICASL7.EQ.'RAEQ'.OR.
24614     1       ICASL7.EQ.'NNE1'.OR.ICASL7.EQ.'NNE2'.OR.
24615     1       ICASL7.EQ.'NNE3'.OR.ICASL7.EQ.'NNE4'.OR.
24616     1       ICASL7.EQ.'GSQD'.OR.ICASL7.EQ.'GSQS'.OR.
24617     1       ICASL7.EQ.'GSQP'.OR.ICASL7.EQ.'GSQM'.OR.
24618     1       ICASL7.EQ.'GQMN'.OR.ICASL7.EQ.'GQMX'.OR.
24619     1       ICASL7.EQ.'GSQL'.OR.ICASL7.EQ.'GSQU'.OR.
24620     1       (ICASL7.EQ.'ZSCO'.OR.ICASL7.EQ.'LSTA'.OR.
24621     1        ICASL7.EQ.'USCO'.OR.ICASL7.EQ.'LSST'.OR.
24622     1        ICASL7.EQ.'CRTA'.OR.ICASL7.EQ.'STAN'.OR.
24623     1        ICASL7.EQ.'CTCU'.OR.ICASL7.EQ.'WIND'.OR.
24624     1        ICASL7.EQ.'MOVI'.OR.ICASL7.EQ.'CUMU'.OR.
24625     1        ICASL7.EQ.'MNRK'.OR.ICASL7.EQ.'MDRK'.OR.
24626     1        ICASL7(1:2).EQ.'CT' .AND. NUMVAR.GE.2))THEN
24627        IF(NIRIGH(1).NE.NIRIGH(2))THEN
24628          WRITE(ICOUT,2111)
24629 2111     FORMAT('***** ERROR 2111 IN DPMATC--')
24630          CALL DPWRST('XXX','BUG ')
24631          WRITE(ICOUT,2112)
24632 2112     FORMAT('      VARIABLES ONE AND TWO MUST HAVE THE SAME')
24633          CALL DPWRST('XXX','BUG ')
24634          WRITE(ICOUT,2113)
24635 2113     FORMAT('      NUMBER OF OBSERVATIONS;  SUCH WAS NOT ',
24636     1           'THE CASE HERE.')
24637          CALL DPWRST('XXX','BUG ')
24638          DO2114J=1,2
24639            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
24640 2115       FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
24641     1             ' OBSERVATIONS;')
24642            CALL DPWRST('XXX','BUG ')
24643 2114     CONTINUE
24644          WRITE(ICOUT,2118)
24645 2118     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
24646          CALL DPWRST('XXX','BUG ')
24647          IF(IWIDTH.GE.1)THEN
24648            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24649 2119       FORMAT('      ',100A1)
24650            CALL DPWRST('XXX','BUG ')
24651          ENDIF
24652          IERROR='YES'
24653          GOTO19000
24654        ENDIF
24655C
24656C  CASE 3: SAME LENGTH REQUIRED FOR VARIABLES 1, 2, AND 3
24657C
24658      ELSEIF(ICASL7.EQ.'HCO2'.OR.ICASL7.EQ.'KCO2'.OR.
24659     1       ICASL7.EQ.'GWSA'.OR.
24660     1       ICASL7.EQ.'2DIN'.OR.ICASL7.EQ.'JOIN')THEN
24661        IF(NIRIGH(1).NE.NIRIGH(2) .OR. NIRIGH(1).NE.NIRIGH(3))THEN
24662          WRITE(ICOUT,2121)
24663 2121     FORMAT('***** ERROR 2121 IN DPMATC--')
24664          CALL DPWRST('XXX','BUG ')
24665          WRITE(ICOUT,2122)
24666 2122     FORMAT('      VARIABLES ONE , TWO, AND THREE MUST HAVE ',
24667     1           'THE SAME')
24668          CALL DPWRST('XXX','BUG ')
24669          WRITE(ICOUT,2123)
24670 2123     FORMAT('      NUMBER OF OBSERVATIONS;  SUCH WAS NOT ',
24671     1           'THE CASE HERE.')
24672          CALL DPWRST('XXX','BUG ')
24673          DO2124J=1,3
24674            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
24675            CALL DPWRST('XXX','BUG ')
24676 2124     CONTINUE
24677          WRITE(ICOUT,2118)
24678          CALL DPWRST('XXX','BUG ')
24679          IF(IWIDTH.GE.1)THEN
24680            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24681            CALL DPWRST('XXX','BUG ')
24682          ENDIF
24683          IERROR='YES'
24684          GOTO19000
24685        ENDIF
24686C
24687C  CASE 4: SAME LENGTH REQUIRED FOR VARIABLES 1, 2, 3, AND 4
24688C
24689      ELSEIF(ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
24690     1       ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI')THEN
24691        IF(NIRIGH(1).NE.NIRIGH(2) .OR. NIRIGH(1).NE.NIRIGH(3) .OR.
24692     1     NIRIGH(1).NE.NIRIGH(4))THEN
24693          WRITE(ICOUT,2131)
24694 2131     FORMAT('***** ERROR 2131 IN DPMATC--')
24695          CALL DPWRST('XXX','BUG ')
24696          WRITE(ICOUT,2132)
24697 2132     FORMAT('      VARIABLES ONE , TWO, THREE, AND FOUR ',
24698     1           'MUST HAVE THE SAME')
24699          CALL DPWRST('XXX','BUG ')
24700          WRITE(ICOUT,2133)
24701 2133     FORMAT('      NUMBER OF OBSERVATIONS;  SUCH WAS NOT ',
24702     1           'THE CASE HERE.')
24703          CALL DPWRST('XXX','BUG ')
24704          DO2134J=1,4
24705            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
24706            CALL DPWRST('XXX','BUG ')
24707 2134     CONTINUE
24708          WRITE(ICOUT,2136)IHRIGH(1),IHRIG2(1),NIRIGH(1)
24709 2136     FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
24710     1           ' OBSERVATIONS;')
24711          CALL DPWRST('XXX','BUG ')
24712          WRITE(ICOUT,2136)IHARG(ILOCV+1),IHARG2(ILOCV+1),NIRIGH(2)
24713          CALL DPWRST('XXX','BUG ')
24714          WRITE(ICOUT,2136)IHARG(ILOCV+2),IHARG2(ILOCV+2),NIRIGH(3)
24715          CALL DPWRST('XXX','BUG ')
24716          WRITE(ICOUT,2136)IHARG(ILOCV+3),IHARG2(ILOCV+3),NIRIGH(4)
24717          CALL DPWRST('XXX','BUG ')
24718          WRITE(ICOUT,2118)
24719          CALL DPWRST('XXX','BUG ')
24720          IF(IWIDTH.GE.1)THEN
24721            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24722            CALL DPWRST('XXX','BUG ')
24723          ENDIF
24724          IERROR='YES'
24725          GOTO19000
24726        ENDIF
24727C
24728C  CASE 5: SAME LENGTH REQUIRED FOR VARIABLES 1, 2, AND 3 AND
24729C          FOR VARIABLES 4 AND 5
24730C
24731      ELSEIF(ICASL7.EQ.'BILI'.OR.ICASL7.EQ.'BIVA')THEN
24732        IF(NIRIGH(1).EQ.NIRIGH(2).AND.NIRIGH(2).EQ.NIRIGH(3).AND.
24733     1     NIRIGH(4).EQ.NIRIGH(5))GOTO2190
24734        WRITE(ICOUT,2141)
24735 2141   FORMAT('***** ERROR 2141 IN DPMATC--')
24736        CALL DPWRST('XXX','BUG ')
24737        WRITE(ICOUT,2142)
24738 2142   FORMAT('      FOR 2D INTERPOLATION, THE NUMBER OF ',
24739     1         'OBSERVATIONS')
24740        CALL DPWRST('XXX','BUG ')
24741        WRITE(ICOUT,2143)
24742 2143   FORMAT('     IN THE FIRST THREE VARIABLES AND IN VARIABLES')
24743        CALL DPWRST('XXX','BUG ')
24744        WRITE(ICOUT,2144)
24745 2144   FORMAT('      4 AND 5 MUST BE THE SAME; SUCH WAS NOT THE ',
24746     1         'CASE HERE.')
24747        CALL DPWRST('XXX','BUG ')
24748        DO2146J=1,5
24749          WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
24750          CALL DPWRST('XXX','BUG ')
24751 2146   CONTINUE
24752        WRITE(ICOUT,2118)
24753        CALL DPWRST('XXX','BUG ')
24754        IF(IWIDTH.GE.1)THEN
24755          WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24756          CALL DPWRST('XXX','BUG ')
24757        ENDIF
24758        IERROR='YES'
24759        GOTO19000
24760C
24761C  CASE 6: VARIABLE 1 AND VARIABLE 3 MUST HAVE SAME LENGTH
24762C
24763      ELSEIF((ICASL7.EQ.'MTCH'.AND.ICASMT.EQ.'TRAN') .OR.
24764     1       (ICASL7.EQ.'REPL'.AND.ICASMT.EQ.'TRAN'))THEN
24765        IF(NIRIGH(1).NE.NIRIGH(3))THEN
24766          WRITE(ICOUT,2151)
24767 2151     FORMAT('***** ERROR 2151 IN DPMATC--')
24768          CALL DPWRST('XXX','BUG ')
24769          WRITE(ICOUT,2152)
24770 2152     FORMAT('      VARIABLES ONE AND THREE MUST HAVE THE SAME')
24771          CALL DPWRST('XXX','BUG ')
24772          WRITE(ICOUT,2153)
24773 2153     FORMAT('      NUMBER OF OBSERVATIONS;  SUCH WAS NOT ',
24774     1           'THE CASE HERE.')
24775          CALL DPWRST('XXX','BUG ')
24776          WRITE(ICOUT,2115)IHRIGH(1),IHRIG2(1),NIRIGH(1)
24777          CALL DPWRST('XXX','BUG ')
24778          WRITE(ICOUT,2115)IHRIGH(3),IHRIG2(3),NIRIGH(3)
24779          CALL DPWRST('XXX','BUG ')
24780          WRITE(ICOUT,2158)
24781 2158     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
24782          CALL DPWRST('XXX','BUG ')
24783          IF(IWIDTH.GE.1)THEN
24784            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24785            CALL DPWRST('XXX','BUG ')
24786          ENDIF
24787          IERROR='YES'
24788          GOTO19000
24789        ENDIF
24790C
24791C  CASE 7: SAME LENGTH REQUIRED FOR VARIABLES 1 AND 2 AND
24792C          FOR VARIABLES 3 AND 4
24793C
24794      ELSEIF(ICASL7.EQ.'EDGV' .OR. ICASL7.EQ.'SPF1' .OR.
24795     1       ICASL7.EQ.'FNNE' .OR. ICASL7.EQ.'ANNE' .OR.
24796     1       ICASL7.EQ.'POPL')THEN
24797        IF(NIRIGH(1).NE.NIRIGH(2))THEN
24798          WRITE(ICOUT,2161)
24799 2161     FORMAT('***** ERROR IN DPMATC--')
24800          CALL DPWRST('XXX','BUG ')
24801          IF(ICASL7.EQ.'EDGV')THEN
24802            WRITE(ICOUT,2162)
24803 2162       FORMAT('      FOR EDGE TO VERTICES, THE NUMBER OF ',
24804     1             'OBSERVATIONS')
24805          ELSEIF(ICASL7.EQ.'SPF1')THEN
24806            WRITE(ICOUT,2168)
24807 2168       FORMAT('      FOR SPANNING FOREST, THE NUMBER OF ',
24808     1             'OBSERVATIONS')
24809          ELSEIF(ICASL7.EQ.'POPL')THEN
24810            WRITE(ICOUT,2169)
24811 2169       FORMAT('      FOR POINTS IN POLYGON, THE NUMBER OF ',
24812     1             'OBSERVATIONS')
24813          ELSEIF(ICASL7.EQ.'FNNE')THEN
24814            WRITE(ICOUT,22162)
2481522162       FORMAT('      FOR FIRST NEAREST NEIGHBOR, THE NUMBER OF ',
24816     1             'OBSERVATIONS')
24817          ELSEIF(ICASL7.EQ.'ANNE')THEN
24818            WRITE(ICOUT,22163)
2481922163       FORMAT('      FOR ALL NEAREST NEIGHBORS, THE NUMBER OF ',
24820     1             'OBSERVATIONS')
24821          ENDIF
24822          CALL DPWRST('XXX','BUG ')
24823          WRITE(ICOUT,2163)
24824 2163     FORMAT('     FOR VARIABLES ONE AND TWO MUST BE THE SAME.')
24825          CALL DPWRST('XXX','BUG ')
24826          WRITE(ICOUT,2164)
24827 2164     FORMAT('      SUCH WAS NOT THE CASE HERE.')
24828          CALL DPWRST('XXX','BUG ')
24829          DO2166J=1,2
24830            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
24831            CALL DPWRST('XXX','BUG ')
24832 2166     CONTINUE
24833          WRITE(ICOUT,2118)
24834          CALL DPWRST('XXX','BUG ')
24835          IF(IWIDTH.GE.1)THEN
24836            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24837            CALL DPWRST('XXX','BUG ')
24838          ENDIF
24839          IERROR='YES'
24840          GOTO19000
24841        ENDIF
24842C
24843        IF(NIRIGH(3).NE.NIRIGH(4))THEN
24844          WRITE(ICOUT,2171)
24845 2171     FORMAT('***** ERROR IN DPMATC--')
24846          CALL DPWRST('XXX','BUG ')
24847          IF(ICASL7.EQ.'EDGV')THEN
24848            WRITE(ICOUT,2172)
24849 2172       FORMAT('      FOR EDGE TO VERTICES, THE NUMBER OF ',
24850     1             'OBSERVATIONS')
24851          ELSE
24852            WRITE(ICOUT,2178)
24853 2178       FORMAT('      FOR SPANNING FOREST, THE NUMBER OF ',
24854     1             'OBSERVATIONS')
24855          ENDIF
24856          CALL DPWRST('XXX','BUG ')
24857          WRITE(ICOUT,2173)
24858 2173     FORMAT('     FOR VARIABLES THREE AND FOUR MUST BE THE SAME.')
24859          CALL DPWRST('XXX','BUG ')
24860          WRITE(ICOUT,2174)
24861 2174     FORMAT('      SUCH WAS NOT THE CASE HERE.')
24862          CALL DPWRST('XXX','BUG ')
24863          DO2176J=3,4
24864            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
24865            CALL DPWRST('XXX','BUG ')
24866 2176     CONTINUE
24867          WRITE(ICOUT,2118)
24868          CALL DPWRST('XXX','BUG ')
24869          IF(IWIDTH.GE.1)THEN
24870            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24871            CALL DPWRST('XXX','BUG ')
24872          ENDIF
24873          IERROR='YES'
24874          GOTO19000
24875        ENDIF
24876C
24877C  CASE 8: SAME LENGTH REQUIRED FOR VARIABLES 2 AND 3
24878C
24879      ELSEIF(ICASL7.EQ.'NEPA' .OR.
24880     1       ICASL7.EQ.'BFPD'.OR.ICASL7.EQ.'BFCD'.OR.
24881     1       ICASL7.EQ.'BFPP'.OR.
24882     1       ICASL7.EQ.'EEPD'.OR.ICASL7.EQ.'EECD'.OR.
24883     1       ICASL7.EQ.'EEPP'.OR.
24884     1       (ICASL7.EQ.'NEYT' .AND. NUMVAR.EQ.3))THEN
24885        IF(NIRIGH(2).NE.NIRIGH(3))THEN
24886          WRITE(ICOUT,2181)
24887 2181     FORMAT('***** ERROR IN DPMATC--')
24888          CALL DPWRST('XXX','BUG ')
24889          IF(ICASL7.EQ.'NEPA')THEN
24890            WRITE(ICOUT,2182)
24891 2182       FORMAT('      FOR NEXT PARTITION, THE NUMBER OF ',
24892     1             'OBSERVATIONS')
24893            CALL DPWRST('XXX','BUG ')
24894          ELSEIF(ICASL7.EQ.'NEYT')THEN
24895            WRITE(ICOUT,2183)
24896 2183       FORMAT('      FOR NEXT YOUNG TABLEAUX, THE NUMBER OF ',
24897     1             'OBSERVATIONS')
24898            CALL DPWRST('XXX','BUG ')
24899          ELSEIF(ICASL7.EQ.'BFPD' .OR. ICASL7.EQ.'BFCD' .OR.
24900     1           ICASL7.EQ.'BFPP')THEN
24901            WRITE(ICOUT,2184)
24902 2184       FORMAT('      FOR BRITTLE FIBER WEIBULL PDF/CDF/PPF, ',
24903     1             'THE NUMBER OF OBSERVATIONS')
24904            CALL DPWRST('XXX','BUG ')
24905          ELSEIF(ICASL7.EQ.'EEPD' .OR. ICASL7.EQ.'EECD' .OR.
24906     1           ICASL7.EQ.'EEPP')THEN
24907            WRITE(ICOUT,2185)
24908 2185       FORMAT('      FOR END EFFECTS WEIBULL PDF/CDF/PPF, ',
24909     1             'THE NUMBER OF OBSERVATIONS')
24910            CALL DPWRST('XXX','BUG ')
24911          ENDIF
24912          WRITE(ICOUT,2186)
24913 2186     FORMAT('     FOR VARIABLES TWO AND THREE MUST BE THE SAME.')
24914          CALL DPWRST('XXX','BUG ')
24915          WRITE(ICOUT,2187)
24916 2187     FORMAT('      SUCH WAS NOT THE CASE HERE.')
24917          CALL DPWRST('XXX','BUG ')
24918          DO2188J=2,3
24919            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
24920            CALL DPWRST('XXX','BUG ')
24921 2188     CONTINUE
24922          WRITE(ICOUT,2119)
24923          CALL DPWRST('XXX','BUG ')
24924          IF(IWIDTH.GE.1)THEN
24925            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
24926            CALL DPWRST('XXX','BUG ')
24927          ENDIF
24928          IERROR='YES'
24929          GOTO19000
24930        ENDIF
24931C
24932      ENDIF
24933C
24934 2190 CONTINUE
24935C
24936C               *******************************
24937C               **  STEP 7--                 **
24938C               **  DETERMINE THE SUBCASE    **
24939C               **  AND BRANCH ACCORDINGLY.  **
24940C               *******************************
24941C
24942      ISTEPN='7'
24943C
24944      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
24945        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
24946        WRITE(ICOUT,7003)NUMVAR,NUMARG
24947 7003   FORMAT('7008--NUMVAR,NUMARG = ',2I8)
24948        CALL DPWRST('XXX','BUG ')
24949        DO7005I=1,NUMVAR
24950        WRITE(ICOUT,7008)I,ITYPA(I),ILOCR(I)
24951 7008   FORMAT('7008-I,ITYPA(I),ILOCR(I) = ',I4,2X,A4,2X,I8)
24952        CALL DPWRST('XXX','BUG ')
24953 7005   CONTINUE
24954        WRITE(ICOUT,7006)IHARG(ILOCR(NUMVAR)),IHARG2(ILOCR(NUMVAR))
24955 7006   FORMAT('IHARG(ILOCR(NUMVAR)),IHARG2(ILOCR(NUMVAR)) = ',2A4)
24956        CALL DPWRST('XXX','BUG ')
24957        WRITE(ICOUT,7007)IHARG(ILOCR(NUMVAR)+1),
24958     1                   IHARG2(ILOCR(NUMVAR)+1)
24959 7007   FORMAT('IHARG(ILOCR(NUMVAR)+1),IHARG2(ILOCR(NUMVAR)+1) = ',
24960     1         2A4)
24961        CALL DPWRST('XXX','BUG ')
24962      ENDIF
24963C
24964CCCCC FOR EXPONENTIAL SMOOTH, SECOND ARGUMENT OPTIONAL.
24965C
24966      IF(ICASL7.EQ.'EXPS')THEN
24967        IF(ILOCR(1).EQ.NUMARG)THEN
24968          TEMPS(2)=0.0
24969          NUMVAR=1
24970          GOTO8000
24971        ELSEIF(IHARG(ILOCR(2)).EQ.'SUBS'.OR.
24972     1         IHARG(ILOCR(2)).EQ.'EXCE'.OR.
24973     1         IHARG(ILOCR(2)).EQ.'FOR ')THEN
24974          TEMPS(2)=0.0
24975          NUMVAR=1
24976          IF(IHARG(ILOCR(2)).EQ.'SUBS')GOTO9000
24977          IF(IHARG(ILOCR(2)).EQ.'EXCE')GOTO9000
24978          IF(IHARG(ILOCR(2)).EQ.'FOR ')GOTO10000
24979        ENDIF
24980      ELSEIF(ICASL7.EQ.'SORC' .OR. ICASL7.EQ.'STAC'.OR.
24981     1       ICASL7.EQ.'RSTA' .OR. ICASL7.EQ.'COMB')THEN
24982        NUMVAR=1
24983        ISTRT=4
24984        IF(ICASL7.EQ.'STAC')ISTRT=5
24985        IF(ICASL7.EQ.'RSTA')ISTRT=7
24986        IF(NUMARG.LE.ISTRT)GOTO8000
24987        DO7051I=ISTRT+1,NUMARG
24988          ILOCR7=I
24989          NUMVAR=NUMVAR+1
24990          IF(ILOCR7.GE.NUMARG)GOTO8000
24991          IF(ILOCR7.LT.NUMARG.AND.IHARG(ILOCR7+1).EQ.'SUBS'.AND.
24992     1       IHARG2(ILOCR7+1).EQ.'ET  ')GOTO9000
24993          IF(ILOCR7.LT.NUMARG.AND.IHARG(ILOCR7+1).EQ.'EXCE'.AND.
24994     1       IHARG2(ILOCR7+1).EQ.'PT  ')GOTO9000
24995          IF(ILOCR7.LT.NUMARG.AND.IHARG(ILOCR7+1).EQ.'FOR '.AND.
24996     1       IHARG2(ILOCR7+1).EQ.'    ')GOTO10000
24997 7051   CONTINUE
24998        GOTO8000
24999      ENDIF
25000C
25001      IF(ILOCR(NUMVAR).EQ.NUMARG)GOTO8000
25002      IF(NUMVAR.EQ.0)GOTO11000
25003C
25004      IF(ILOCR(NUMVAR).LT.NUMARG)THEN
25005        IT1=ILOCR(NUMVAR+1)
25006        IF(IHARG(IT1).EQ.'SUBS'.AND.IHARG2(IT1).EQ.'ET  ')GOTO9000
25007        IF(IHARG(IT1).EQ.'EXCE'.AND.IHARG2(IT1).EQ.'PT  ')GOTO9000
25008        IF(IHARG(IT1).EQ.'FOR '.AND.IHARG2(IT1).EQ.'    ')GOTO10000
25009      ENDIF
25010C
25011      WRITE(ICOUT,7081)
25012 7081 FORMAT('***** ERROR 7081 IN DPMATC--')
25013      CALL DPWRST('XXX','BUG ')
25014      WRITE(ICOUT,7082)
25015 7082 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND AT 7082--')
25016      CALL DPWRST('XXX','BUG ')
25017      WRITE(ICOUT,7083)
25018 7083 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
25019      CALL DPWRST('XXX','BUG ')
25020      WRITE(ICOUT,7084)(IANS(I),I=1,MAX(100,IWIDTH))
25021 7084 FORMAT(100A1)
25022      CALL DPWRST('XXX','BUG ')
25023      WRITE(ICOUT,7088)ILOCV,NUMARG,NUMVAR
25024 7088 FORMAT('ILOCV,NUMARG,NUMVAR = ',3I8)
25025      CALL DPWRST('XXX','BUG ')
25026      DO7089I=1,NUMVAR
25027      WRITE(ICOUT,7086)I,ILOCR(I)
25028 7086 FORMAT('I,ILOCR(I) = ',I4,2X,I8)
25029      CALL DPWRST('XXX','BUG ')
25030 7089 CONTINUE
25031      IERROR='YES'
25032      GOTO19000
25033C
25034C               ************************************************
25035C               **  STEP 8--                                  **
25036C               **  TREAT THE FULL VARIABLE CASE.             **
25037C               **  EXAMPLE--LET Y = SORT X                   **
25038C               **         --LET Y(I) = SORT X                **
25039C               **  THEN JUMP TO STEP NUMBER 10 BELOW         **
25040C               **  FOR THE LIST UPDATING AND                 **
25041C               **  FOR SOME INFORMATIVE PRINTING.            **
25042C               ************************************************
25043C
25044C
25045 8000 CONTINUE
25046      ISTEPN='8'
25047      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
25048        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25049        WRITE(ICOUT,8011)NUMVAR,NIRIGH(1)
25050 8011   FORMAT('NUMVAR,NIRIGH(1) = ',2I8)
25051        CALL DPWRST('XXX','BUG ')
25052      ENDIF
25053C
25054      ICASEQ='FULL'
25055      NIOLD=NIRIGH(1)
25056      IF(NUMVAR.GE.2)THEN
25057        DO8020I=2,NUMVAR
25058          IF(NIRIGH(I).GT.NIOLD)NIOLD=NIRIGH(I)
25059 8020   CONTINUE
25060      ENDIF
25061      NINEW=NIOLD
25062      NIFOR=NINEW
25063      DO8100I=1,NINEW
25064        ISUB(I)=1
25065 8100 CONTINUE
25066      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
25067        WRITE(ICOUT,8021)NINEW,NIRIGH(1)
25068 8021   FORMAT('NINEW,NIRIGH(1) = ',2I8)
25069        CALL DPWRST('XXX','BUG ')
25070      ENDIF
25071      GOTO11000
25072C
25073C               **************************************************
25074C               **  STEP 9--                                     *
25075C               **  TREAT THE PARTIAL VARIABLE SUBSET CASE.      *
25076C               **  EXAMPLE--LET Y = SORT X     SUBSET 2 3 5     *
25077C               **         --LET Y(I) = SORT X  SUBSET 2 3 5     *
25078C               **  JUMP TO STEP NUMBER 11 BELOW                 *
25079C               **  FOR THE ACTUAL MATHEMATICAL OPERATION,       *
25080C               **  FOR THE LIST UPDATING, AND                   *
25081C               **  FOR SOME INFORMATIVE PRINTING.               *
25082C               **************************************************
25083C
25084 9000 CONTINUE
25085      ISTEPN='9'
25086      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
25087     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25088C
25089      ICASEQ='SUBS'
25090      ILOCSV=ILOCR(NUMVAR)+2
25091      IHSET=IHARG(ILOCSV)
25092      IHSET2=IHARG2(ILOCSV)
25093      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
25094        WRITE(ICOUT,9002)ILOCSV,IHSET,IHSET2
25095 9002   FORMAT('ILOCSV,IHSET,IHSET2 = ',I8,2X,A4,A4)
25096        CALL DPWRST('XXX','BUG ')
25097      ENDIF
25098      IHWUSE='V'
25099      MESSAG='YES'
25100      CALL CHECKN(IHSET,IHSET2,IHWUSE,
25101     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
25102     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
25103      IF(IERROR.EQ.'YES')GOTO19000
25104      NIOLD=IN(ILOC)
25105      CALL DPSUBS(NIOLD,ILOCS,NSTEMP,IBUGQ,IERROR)
25106      NINEW=NIOLD
25107      NIFOR=NINEW
25108      GOTO11000
25109C
25110C               **************************************************
25111C               **  STEP 10--                                    *
25112C               **  TREAT THE PARTIAL VARIABLE FOR CASE.         *
25113C               **  EXAMPLE--LET Y = SORT X     FOR I = 1 2 10   *
25114C               **         --LET Y(I) = SORT X  FOR I = 1 2 10   *
25115C               **  JUMP TO STEP NUMBER 11 BELOW                 *
25116C               **  FOR THE ACTUAL MATHEMATICAL OPERATION,       *
25117C               **  FOR THE LIST UPDATING, AND                   *
25118C               **  FOR SOME INFORMATIVE PRINTING.               *
25119C               **************************************************
25120C
2512110000 CONTINUE
25122      ISTEPN='10'
25123      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
25124     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25125C
25126      ICASEQ='FOR'
25127      CALL DPFOR(NIOLD,NINEW,IROW1,IROWN,
25128     1NLOCAL,ILOCS,NSTEMP,IBUGQ,IERROR)
25129      NIFOR=NINEW
25130      GOTO11000
25131C
25132C               *******************************************
25133C               **  STEP 11--                            **
25134C               **  CARRY OUT THE                        **
25135C               **  MATHEMATICAL OPERATION.              **
25136C               *******************************************
25137C
2513811000 CONTINUE
25139      ISTEPN='11'
25140      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
25141        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
25142        DO11109I=1,NUMVAR
25143          WRITE(ICOUT,11101)I,ITYPA(I)
2514411101     FORMAT('11101--I,ITYPA(I) = ',I4,2X,A4)
25145          CALL DPWRST('XXX','BUG ')
2514611109   CONTINUE
25147      ENDIF
25148C
25149      NITEMX=NINEW
25150      NS1=0
25151      NS2=0
25152      NS3=0
25153      NS4=0
25154      NS5=0
25155      NS6=0
25156      NS7=0
25157      NS8=0
25158      NS9=0
25159C
25160CCCCC NOTE: FOR SCATTER, EXTRACT CURRENT VALUES OF VARIABLE
25161CCCCC       ON LEFT HAND SIDE IF VARIABLE ALREADY EXISTS:
25162CCCCC
25163      IF(ICASL7.EQ.'SCAT')THEN
25164        IF(NEWNAM(1).EQ.'NO')THEN
25165          NILEFT=IN(ILISL(1))
25166          NS99=0
25167          DO11110I=1,NILEFT
25168            IJ=MAXN*(ICOLL(1)-1)+I
25169            NS99=NS99+1
25170            IF(ICOLL(1).LE.MAXCOL)TEMP91(NS99)=V(IJ)
25171            IF(ICOLL(1).EQ.MAXCP1)TEMP91(NS99)=PRED(I)
25172            IF(ICOLL(1).EQ.MAXCP2)TEMP91(NS99)=RES(I)
25173            IF(ICOLL(1).EQ.MAXCP3)TEMP91(NS99)=YPLOT(I)
25174            IF(ICOLL(1).EQ.MAXCP4)TEMP91(NS99)=XPLOT(I)
25175            IF(ICOLL(1).EQ.MAXCP5)TEMP91(NS99)=X2PLOT(I)
25176            IF(ICOLL(1).EQ.MAXCP6)TEMP91(NS99)=TAGPLO(I)
2517711110     CONTINUE
25178        ELSE
25179          NS99=-1
25180        ENDIF
25181      ENDIF
25182C
25183      IF(NUMVAR.GE.1 .AND. ITYPA(1).EQ.'VARI')THEN
25184        DO11111I=1,NINEW
25185          IF(ISUB(I).EQ.0)GOTO11111
25186          IF(I.GT.NIRIGH(1))GOTO11119
25187          IJ=MAXN*(ICOLR(1)-1)+I
25188C
25189          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')THEN
25190            WRITE(ICOUT,11112)I,NS1,NINEW,ISUB(I),IJ,V(IJ)
2519111112       FORMAT('I,NS1,NINEW,ISUB(I),IJ,V(IJ) = ',5I8,F12.5)
25192            CALL DPWRST('XXX','BUG ')
25193          ENDIF
25194C
25195          NS1=NS1+1
25196          IF(ICOLR(1).LE.MAXCOL)TEMP1(NS1)=V(IJ)
25197          IF(ICOLR(1).EQ.MAXCP1)TEMP1(NS1)=PRED(I)
25198          IF(ICOLR(1).EQ.MAXCP2)TEMP1(NS1)=RES(I)
25199          IF(ICOLR(1).EQ.MAXCP3)TEMP1(NS1)=YPLOT(I)
25200          IF(ICOLR(1).EQ.MAXCP4)TEMP1(NS1)=XPLOT(I)
25201          IF(ICOLR(1).EQ.MAXCP5)TEMP1(NS1)=X2PLOT(I)
25202          IF(ICOLR(1).EQ.MAXCP6)TEMP1(NS1)=TAGPLO(I)
2520311111   CONTINUE
2520411119   CONTINUE
25205      ENDIF
25206C
25207C     FOR BRITTLE FIBER WEIBULL AND END EFFECTS WEIBULL CASES, IGNORE
25208C     SUBSET CLAUSE, ALSO CAN BE DIFFERENT LENGTH THAN VARIABLE 1.
25209C
25210      IF(NUMVAR.GE.2 .AND. ITYPA(2).EQ.'VARI')THEN
25211        IFLAGN=0
25212        IF(ICASL7.EQ.'BFPD' .OR. ICASL7.EQ.'BFCD' .OR.
25213     1     ICASL7.EQ.'BFPP') THEN
25214           IFLAGN=1
25215        ELSEIF(ICASL7.EQ.'EEPD' .OR. ICASL7.EQ.'EECD' .OR.
25216     1     ICASL7.EQ.'EEPP') THEN
25217           IFLAGN=1
25218        ELSEIF(ICASL7.EQ.'TMIN' .OR. ICASL7.EQ.'TMAX')THEN
25219           IFLAGN=1
25220        ENDIF
25221        DO11121I=1,NIRIGH(2)
25222          IF(ISUB(I).EQ.0 .AND. IFLAGN.EQ.0)GOTO11121
25223          IF(I.GT.NIRIGH(2))GOTO11129
25224          NS2=NS2+1
25225          IJ=MAXN*(ICOLR(2)-1)+I
25226          IF(ICOLR(2).LE.MAXCOL)TEMP2(NS2)=V(IJ)
25227          IF(ICOLR(2).EQ.MAXCP1)TEMP2(NS2)=PRED(I)
25228          IF(ICOLR(2).EQ.MAXCP2)TEMP2(NS2)=RES(I)
25229          IF(ICOLR(2).EQ.MAXCP3)TEMP2(NS2)=YPLOT(I)
25230          IF(ICOLR(2).EQ.MAXCP4)TEMP2(NS2)=XPLOT(I)
25231          IF(ICOLR(2).EQ.MAXCP5)TEMP2(NS2)=X2PLOT(I)
25232          IF(ICOLR(2).EQ.MAXCP6)TEMP2(NS2)=TAGPLO(I)
2523311121   CONTINUE
2523411129   CONTINUE
25235      ENDIF
25236C
25237C     FOR BRITTLE FIBER WEIBULL AND END EFFECT WEIBULL CASES, IGNORE
25238C     SUBSET CLAUSE, ALSO CAN BE DIFFERENT LENGTH THAN VARIABLE 1.
25239C
25240      IF(NUMVAR.GE.3 .AND. ITYPA(3).EQ.'VARI')THEN
25241        IFLAGN=0
25242        IF(ICASL7.EQ.'BFPD' .OR. ICASL7.EQ.'BFCD' .OR.
25243     1     ICASL7.EQ.'BFPP') THEN
25244           IFLAGN=1
25245        ELSEIF(ICASL7.EQ.'EEPD' .OR. ICASL7.EQ.'EECD' .OR.
25246     1     ICASL7.EQ.'EEPP') THEN
25247           IFLAGN=1
25248        ENDIF
25249        DO11131I=1,NIRIGH(3)
25250          IF(ISUB(I).EQ.0 .AND. IFLAGN.EQ.0)GOTO11131
25251          IF(I.GT.NIRIGH(3))GOTO11139
25252          NS3=NS3+1
25253          IJ=MAXN*(ICOLR(3)-1)+I
25254          IF(ICOLR(3).LE.MAXCOL)TEMP3(NS3)=V(IJ)
25255          IF(ICOLR(3).EQ.MAXCP1)TEMP3(NS3)=PRED(I)
25256          IF(ICOLR(3).EQ.MAXCP2)TEMP3(NS3)=RES(I)
25257          IF(ICOLR(3).EQ.MAXCP3)TEMP3(NS3)=YPLOT(I)
25258          IF(ICOLR(3).EQ.MAXCP4)TEMP3(NS3)=XPLOT(I)
25259          IF(ICOLR(3).EQ.MAXCP5)TEMP3(NS3)=X2PLOT(I)
25260          IF(ICOLR(3).EQ.MAXCP6)TEMP3(NS3)=TAGPLO(I)
2526111131   CONTINUE
2526211139   CONTINUE
25263      ENDIF
25264C
25265      IF(NUMVAR.GE.4 .AND. ITYPA(4).EQ.'VARI')THEN
25266        DO11141I=1,NIRIGH(4)
25267          IF(ISUB(I).EQ.0)GOTO11141
25268          IF(I.GT.NIRIGH(4))GOTO11149
25269          NS4=NS4+1
25270          IJ=MAXN*(ICOLR(4)-1)+I
25271          IF(ICOLR(4).LE.MAXCOL)TEMP4(NS4)=V(IJ)
25272          IF(ICOLR(4).EQ.MAXCP1)TEMP4(NS4)=PRED(I)
25273          IF(ICOLR(4).EQ.MAXCP2)TEMP4(NS4)=RES(I)
25274          IF(ICOLR(4).EQ.MAXCP3)TEMP4(NS4)=YPLOT(I)
25275          IF(ICOLR(4).EQ.MAXCP4)TEMP4(NS4)=XPLOT(I)
25276          IF(ICOLR(4).EQ.MAXCP5)TEMP4(NS4)=X2PLOT(I)
25277          IF(ICOLR(4).EQ.MAXCP6)TEMP4(NS4)=TAGPLO(I)
2527811141   CONTINUE
2527911149   CONTINUE
25280      ENDIF
25281C
25282      IF(NUMVAR.GE.5 .AND. ITYPA(5).EQ.'VARI')THEN
25283        DO11151I=1,NIRIGH(5)
25284          IF(ISUB(I).EQ.0)GOTO11151
25285          IF(I.GT.NIRIGH(5))GOTO11159
25286          NS5=NS5+1
25287          IJ=MAXN*(ICOLR(5)-1)+I
25288          IF(ICOLR(5).LE.MAXCOL)TEMP5(NS5)=V(IJ)
25289          IF(ICOLR(5).EQ.MAXCP1)TEMP5(NS5)=PRED(I)
25290          IF(ICOLR(5).EQ.MAXCP2)TEMP5(NS5)=RES(I)
25291          IF(ICOLR(5).EQ.MAXCP3)TEMP5(NS5)=YPLOT(I)
25292          IF(ICOLR(5).EQ.MAXCP4)TEMP5(NS5)=XPLOT(I)
25293          IF(ICOLR(5).EQ.MAXCP5)TEMP5(NS5)=X2PLOT(I)
25294          IF(ICOLR(5).EQ.MAXCP6)TEMP5(NS5)=TAGPLO(I)
2529511151   CONTINUE
2529611159   CONTINUE
25297      ENDIF
25298C
25299      IF(NUMVAR.GE.6 .AND. ITYPA(6).EQ.'VARI')THEN
25300        DO11161I=1,NIRIGH(6)
25301          IF(ISUB(I).EQ.0)GOTO11161
25302          IF(I.GT.NIRIGH(6))GOTO11169
25303          NS6=NS6+1
25304          IJ=MAXN*(ICOLR(6)-1)+I
25305          IF(ICOLR(6).LE.MAXCOL)TEMP6(NS6)=V(IJ)
25306          IF(ICOLR(6).EQ.MAXCP1)TEMP6(NS6)=PRED(I)
25307          IF(ICOLR(6).EQ.MAXCP2)TEMP6(NS6)=RES(I)
25308          IF(ICOLR(6).EQ.MAXCP3)TEMP6(NS6)=YPLOT(I)
25309          IF(ICOLR(6).EQ.MAXCP4)TEMP6(NS6)=XPLOT(I)
25310          IF(ICOLR(6).EQ.MAXCP5)TEMP6(NS6)=X2PLOT(I)
25311          IF(ICOLR(6).EQ.MAXCP6)TEMP6(NS6)=TAGPLO(I)
2531211161   CONTINUE
2531311169   CONTINUE
25314      ENDIF
25315C
25316      IF(NUMVAR.GE.7 .AND. ITYPA(7).EQ.'VARI')THEN
25317        DO11171I=1,NIRIGH(7)
25318          IF(ISUB(I).EQ.0)GOTO11171
25319          IF(I.GT.NIRIGH(6))GOTO11179
25320          NS7=NS7+1
25321          IJ=MAXN*(ICOLR(7)-1)+I
25322          IF(ICOLR(7).LE.MAXCOL)TEMP7(NS7)=V(IJ)
25323          IF(ICOLR(7).EQ.MAXCP1)TEMP7(NS7)=PRED(I)
25324          IF(ICOLR(7).EQ.MAXCP2)TEMP7(NS7)=RES(I)
25325          IF(ICOLR(7).EQ.MAXCP3)TEMP7(NS7)=YPLOT(I)
25326          IF(ICOLR(7).EQ.MAXCP4)TEMP7(NS7)=XPLOT(I)
25327          IF(ICOLR(7).EQ.MAXCP5)TEMP7(NS7)=X2PLOT(I)
25328          IF(ICOLR(7).EQ.MAXCP6)TEMP7(NS7)=TAGPLO(I)
2532911171   CONTINUE
2533011179   CONTINUE
25331      ENDIF
25332C
25333      IF(NUMVAR.GE.8 .AND. ITYPA(8).EQ.'VARI')THEN
25334        DO11181I=1,NIRIGH(8)
25335          IF(ISUB(I).EQ.0)GOTO11181
25336          IF(I.GT.NIRIGH(6))GOTO11189
25337          NS8=NS8+1
25338          IJ=MAXN*(ICOLR(8)-1)+I
25339          IF(ICOLR(8).LE.MAXCOL)TEMP8(NS8)=V(IJ)
25340          IF(ICOLR(8).EQ.MAXCP1)TEMP8(NS8)=PRED(I)
25341          IF(ICOLR(8).EQ.MAXCP2)TEMP8(NS8)=RES(I)
25342          IF(ICOLR(8).EQ.MAXCP3)TEMP8(NS8)=YPLOT(I)
25343          IF(ICOLR(8).EQ.MAXCP4)TEMP8(NS8)=XPLOT(I)
25344          IF(ICOLR(8).EQ.MAXCP5)TEMP8(NS8)=X2PLOT(I)
25345          IF(ICOLR(8).EQ.MAXCP6)TEMP8(NS8)=TAGPLO(I)
2534611181   CONTINUE
2534711189   CONTINUE
25348      ENDIF
25349C
25350      IF(NUMVAR.GE.9 .AND. ITYPA(9).EQ.'VARI')THEN
25351        DO11191I=1,NIRIGH(9)
25352          IF(ISUB(I).EQ.0)GOTO11191
25353          IF(I.GT.NIRIGH(6))GOTO11199
25354          NS9=NS9+1
25355          IJ=MAXN*(ICOLR(9)-1)+I
25356          IF(ICOLR(9).LE.MAXCOL)TEMP9(NS9)=V(IJ)
25357          IF(ICOLR(9).EQ.MAXCP1)TEMP9(NS9)=PRED(I)
25358          IF(ICOLR(9).EQ.MAXCP2)TEMP9(NS9)=RES(I)
25359          IF(ICOLR(9).EQ.MAXCP3)TEMP9(NS9)=YPLOT(I)
25360          IF(ICOLR(9).EQ.MAXCP4)TEMP9(NS9)=XPLOT(I)
25361          IF(ICOLR(9).EQ.MAXCP5)TEMP9(NS9)=X2PLOT(I)
25362          IF(ICOLR(9).EQ.MAXCP6)TEMP9(NS9)=TAGPLO(I)
2536311191   CONTINUE
2536411199   CONTINUE
25365      ENDIF
25366C
25367      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
25368        WRITE(ICOUT,11292)NINEW,ICASL7,ICASEQ
2536911292   FORMAT('11292--NINEW,ICASL7,ICASEQ = ',I8,2X,A4,2X,A4)
25370        CALL DPWRST('XXX','BUG ')
25371        WRITE(ICOUT,11293)NS1,NS2,NS3,NS4,NS5,NS6,NS7
2537211293   FORMAT('NS1,NS2,NS3,NS4,NS5,NS6,NS7 = ',7I8)
25373        CALL DPWRST('XXX','BUG ')
25374        DO11294II=1,7
25375          WRITE(ICOUT,11291)II,ICOLR(II),ITYPA(II)
2537611291     FORMAT('II,ICOLR(II),ITYPA(II) = ',I8,2X,I8,2X,A4)
25377          CALL DPWRST('XXX','BUG ')
2537811294   CONTINUE
25379        WRITE(ICOUT,11296)IMATSW,ICASL7
2538011296   FORMAT('IMATSW,ICASL7 = ',A4,2X,A4)
25381        CALL DPWRST('XXX','BUG ')
25382      ENDIF
25383C
25384C     -----BRANCH TO THE PROPER CASE-----
25385C
25386      IWRITE='ON'
25387      IF(IPRINT.EQ.'OFF')IWRITE='OFF'
25388      IF(IFEEDB.EQ.'OFF')IWRITE='OFF'
25389C
25390      IF(ICASL7.EQ.'SORT')THEN
25391        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
25392          DO11310I=1,NS1
25393            WRITE(ICOUT,11311)I,TEMP1(I)
2539411311       FORMAT('I,TEMP1(I) = ',I8,2X,F10.5)
25395            CALL DPWRST('XXX','BUG ')
2539611310     CONTINUE
25397        ENDIF
25398        CALL SORT(TEMP1,NS1,TEMP1)
25399CCCCC   CHECK DIRECTION.  JANUARY 2000.
25400        IF(ISORDI.EQ.'DESC')THEN
25401          DO11315I=1,NS1
25402            TEMP2(I)=TEMP1(I)
2540311315     CONTINUE
25404          DO11317I=1,NS1
25405            II=NS1-I+1
25406            TEMP1(I)=TEMP2(II)
2540711317     CONTINUE
25408        ENDIF
25409        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
25410          DO11312I=1,NS1
25411            WRITE(ICOUT,11311)I,TEMP1(I)
25412            CALL DPWRST('XXX','BUG ')
2541311312     CONTINUE
25414        ENDIF
25415      ELSEIF(ICASL7.EQ.'SOR2')THEN
25416        CALL SORT2(TEMP1,TEMP2,N,IWRITE,TEMP91,TEMP92,
25417     1             TEMP3,TEMP4,
25418     1             ISORDI,ISUBRO,IBUGA3,IERROR)
25419        DO11313I=1,N
25420          TEMP1(I)=TEMP91(I)
25421          TEMP2(I)=TEMP92(I)
2542211313   CONTINUE
25423      ELSEIF(ICASL7.EQ.'SOR3')THEN
25424        CALL SORT3(TEMP1,TEMP2,TEMP3,N,IWRITE,TEMP91,TEMP92,TEMP4,
25425     1             TEMP5,TEMP12(1),TEMP12(MAXOBV+1),TEMP6(1),
25426     1             TEMP6(MAXOBV+1),TEMP6(2*MAXOBV+1),
25427     1             TEMP6(3*MAXOBV+1),
25428     1             ISORDI,ISUBRO,IBUGA3,IERROR)
25429        DO11314I=1,N
25430          TEMP1(I)=TEMP91(I)
25431          TEMP2(I)=TEMP92(I)
25432          TEMP91(I)=TEMP4(I)
2543311314   CONTINUE
25434      ELSEIF(ICASL7.EQ.'SOR4')THEN
25435        CALL SORT4(TEMP1,TEMP2,TEMP3,TEMP4,N,IWRITE,
25436     1             TEMP91,TEMP92,TEMP5,TEMP6(1),
25437     1             TEMP12(1),TEMP12(MAXOBV+1),
25438     1             TEMP6(MAXOBV+1),TEMP6(2*MAXOBV+1),
25439     1             TEMP6(3*MAXOBV+1),TEMP6(4*MAXOBV+1),
25440     1             TEMP7,TEMP8,
25441     1             TEMP21,TEMP22,TEMP23,
25442     1             TEMP24,TEMP25,TEMP26,
25443     1             ISORDI,ISUBRO,IBUGA3,IERROR)
25444        DO11319I=1,N
25445          TEMP1(I)=TEMP91(I)
25446          TEMP2(I)=TEMP92(I)
25447          TEMP91(I)=TEMP5(I)
25448          TEMP92(I)=TEMP6(I)
2544911319   CONTINUE
25450      ELSEIF(ICASL7.EQ.'2DGR')THEN
25451        CALL DP2DGR(TEMP1,NS1,TEMP2,NS2,IWRITE,
25452     1              TEMP91,TEMP92,TEMP21,NITEMX,MAXOBV,
25453     1              ISUBRO,IBUGA3,IERROR)
25454        DO14323I=1,NITEMX
25455          TEMP1(I)=TEMP91(I)
25456          TEMP2(I)=TEMP92(I)
2545714323   CONTINUE
25458        IUPFLG='FULL'
25459      ELSEIF(ICASL7.EQ.'3DGR')THEN
25460        CALL DP3DGR(TEMP1,NS1,TEMP2,NS2,TEMP3,NS3,IWRITE,
25461     1              TEMP8,TEMP9,TEMP91,TEMP21,
25462     1              NITEMX,MAXOBV,ISUBRO,IBUGA3,IERROR)
25463        DO14325I=1,NITEMX
25464          TEMP1(I)=TEMP8(I)
25465          TEMP2(I)=TEMP9(I)
2546614325   CONTINUE
25467        IUPFLG='FULL'
25468      ELSEIF(ICASL7.EQ.'4DGR')THEN
25469        CALL DP4DGR(TEMP1,NS1,TEMP2,NS2,TEMP3,NS3,TEMP4,NS4,IWRITE,
25470     1              TEMP8,TEMP9,TEMP91,TEMP92,TEMP21,
25471     1              NITEMX,MAXOBV,ISUBRO,IBUGA3,IERROR)
25472        DO14327I=1,NITEMX
25473          TEMP1(I)=TEMP8(I)
25474          TEMP2(I)=TEMP9(I)
2547514327   CONTINUE
25476        IUPFLG='FULL'
25477      ELSEIF(ICASL7.EQ.'RANK')THEN
25478        CALL RANK(TEMP1,NS1,IWRITE,TEMP1,TEMP5,MAXOBV,IBUGA3,IERROR)
25479      ELSEIF(ICASL7.EQ.'DIGI')THEN
25480        CALL DIGITS(TEMPS(1),IWRITE,TEMP1,NITEMX,
25481     1              ISUBRO,IBUGA3,IERROR)
25482      ELSEIF(ICASL7.EQ.'YFRA' .OR. ICASL7.EQ.'XFRA')THEN
25483        ICASPL='Y'
25484        IF(ICASL7.EQ.'XFRA')ICASPL='X'
25485        CALL DPFRLI(ICASPL,IFRALI,TEMP1,NS1,
25486     1              GX1MIN,GX1MAX,GY1MIN,GY1MAX,
25487     1              IX1TSC,IX1TSW,IY1TSC,IY1TSW,
25488     1              IX1JSW,IY1JSW,
25489     1              NMJX1T,NMNX1T,IX1NSW,NMJY1T,NMNY1T,IY1NSW,
25490     1              PX1COO,X1COOR,NX1COO,
25491     1              PY1COO,Y1COOR,NY1COO,
25492     1              PX1CMN,X1COMN,NX1CMN,PX1TOL,PX1TOR,
25493     1              PY1CMN,Y1COMN,NY1CMN,PY1TOB,PY1TOT,
25494     1              ITICUN,PXMIN,PXMAX,PYMIN,PYMAX,
25495     1              SCAL91,SCAL92,
25496     1              IBUGA3,ISUBRO,IERROR)
25497        ITYP91='SCAL'
25498        ITYP92='SCAL'
25499      ELSEIF(ICASL7.EQ.'Y1TS' .OR. ICASL7.EQ.'Y1TD' .OR.
25500     1       ICASL7.EQ.'Y2TS' .OR. ICASL7.EQ.'Y2TD' .OR.
25501     1       ICASL7.EQ.'X1TS' .OR. ICASL7.EQ.'X1TD' .OR.
25502     1       ICASL7.EQ.'X2TS' .OR. ICASL7.EQ.'X2TD')THEN
25503        IF(ICASL7.EQ.'Y1TS')THEN
25504          ICASPL='Y1  '
25505          ICASP2='SCRE'
25506        ELSEIF(ICASL7.EQ.'Y1TD')THEN
25507          ICASPL='Y1  '
25508          ICASP2='DATA'
25509        ELSEIF(ICASL7.EQ.'Y2TS')THEN
25510          ICASPL='Y2  '
25511          ICASP2='SCRE'
25512        ELSEIF(ICASL7.EQ.'Y2TD')THEN
25513          ICASPL='Y2  '
25514          ICASP2='DATA'
25515        ELSEIF(ICASL7.EQ.'X1TS')THEN
25516          ICASPL='X1  '
25517          ICASP2='SCRE'
25518        ELSEIF(ICASL7.EQ.'X1TD')THEN
25519          ICASPL='X1  '
25520          ICASP2='DATA'
25521        ELSEIF(ICASL7.EQ.'X2TS')THEN
25522          ICASPL='X2  '
25523          ICASP2='SCRE'
25524        ELSEIF(ICASL7.EQ.'X2TD')THEN
25525          ICASPL='X2  '
25526          ICASP2='DATA'
25527        ENDIF
25528        CALL DPCOOR(ICASPL,ICASP2,TEMP1,NITEMX,
25529     1              PX1COO,X1COOR,NX1COO,
25530     1              PX2COO,X2COOR,NX2COO,
25531     1              PY1COO,Y1COOR,NY1COO,
25532     1              PY2COO,Y2COOR,NY2COO,
25533     1              IBUGA3,ISUBRO,IERROR)
25534        ITYP91='VECT'
25535        IUPFLG='FULL'
25536      ELSEIF(ICASL7.EQ.'WSAT' .OR. ICASL7.EQ.'GWSA')THEN
25537        IF(ICASL7.EQ.'GWSA')THEN
25538          IFLAG=2
25539CCCCC     UNC=TEMPS(4)
25540        ELSE
25541          IFLAG=1
25542        ENDIF
25543        UNC=0.0
25544        CALL DPWSAT(TEMP1,TEMP2,TEMP3,NS1,IFLAG,UNC,
25545     1              SCAL91,SCAL92,
25546     1              ISUBRO,IBUGA3,IERROR)
25547        ITYP91='SCAL'
25548        IF(ICASL7.EQ.'WSAT')ITYP92='SCAL'
25549      ELSEIF(ICASL7.EQ.'PERA')THEN
25550        CALL PERCRA(TEMP1,NS1,IWRITE,TEMP1,TEMP5,MAXOBV,
25551     1              IBUGA3,ISUBRO,IERROR)
25552      ELSEIF(ICASL7.EQ.'RANI')THEN
25553        CALL RANKI(TEMP1,NS1,IWRITE,TEMP1,TEMP5,ITEMP1,MAXOBV,
25554     1            IBUGA3,IERROR)
25555      ELSEIF(ICASL7.EQ.'RAN2')THEN
25556        CALL RANK2(TEMP1,TEMP2,N,IWRITE,TEMP91,
25557     1             TEMP3,TEMP4,TEMP5,ITEMP1,
25558     1             MAXOBV,ISUBRO,IBUGA3,IERROR)
25559        DO11321I=1,N
25560          TEMP1(I)=TEMP91(I)
2556111321   CONTINUE
25562        NITEMX=N
25563      ELSEIF(ICASL7.EQ.'RAN3')THEN
25564        CALL RANK3(TEMP1,TEMP2,TEMP3,N,IWRITE,TEMP91,
25565     1             TEMP4,TEMP5,TEMP12,TEMP6,ITEMP1,
25566     1             MAXOBV,ISUBRO,IBUGA3,IERROR)
25567        DO11323I=1,N
25568          TEMP1(I)=TEMP91(I)
2556911323   CONTINUE
25570        NITEMX=N
25571      ELSEIF(ICASL7.EQ.'CODE')THEN
25572        CALL CODE(TEMP1,NS1,IWRITE,TEMP1,TEMP5,MAXOBV,IBUGA3,IERROR)
25573      ELSEIF(ICASL7.EQ.'CODZ')THEN
25574        CALL CODEZ(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,ISUBRO,IERROR)
25575      ELSEIF(ICASL7.EQ.'CODX')THEN
25576        CALL CODEX(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,ISUBRO,IERROR)
25577      ELSEIF(ICASL7.EQ.'CDEX')THEN
25578        CALL CODEDX(TEMP1,NS1,IWRITE,TEMP1,TEMP5,IBUGA3,ISUBRO,IERROR)
25579      ELSEIF(ICASL7.EQ.'CDE2')THEN
25580        CALL CODED2(TEMP1,NS1,IWRITE,TEMP1,NOUT,TEMP5,
25581     1              IBUGA3,ISUBRO,IERROR)
25582        NITEMX=NOUT
25583      ELSEIF(ICASL7.EQ.'CDCT')THEN
25584        IF(NUMVAR.EQ.2)THEN
25585          CALL CODCT2(TEMP1,TEMP2,NS1,ICCTOF,ICCTG1,IWRITE,
25586     1                TEMP91,TEMP3,TEMP4,
25587     1                IBUGA3,ISUBRO,IERROR)
25588        ELSEIF(NUMVAR.EQ.3)THEN
25589          CALL CODCT3(TEMP1,TEMP2,TEMP3,NS1,ICCTOF,ICCTG1,ICCTG2,IWRITE,
25590     1                TEMP91,TEMP4,TEMP5,TEMP6,
25591     1                IBUGA3,ISUBRO,IERROR)
25592        ELSEIF(NUMVAR.EQ.4)THEN
25593          CALL CODCT4(TEMP1,TEMP2,TEMP3,TEMP4,
25594     1                NS1,ICCTOF,ICCTG1,ICCTG2,ICCTG3,IWRITE,
25595     1                TEMP91,TEMP5,TEMP6,TEMP7,TEMP8,
25596     1                IBUGA3,ISUBRO,IERROR)
25597        ELSEIF(NUMVAR.EQ.5)THEN
25598          CALL CODCT5(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,
25599     1                NS1,ICCTOF,ICCTG1,ICCTG2,ICCTG3,ICCTG4,IWRITE,
25600     1                TEMP91,TEMP6,TEMP7,TEMP8,
25601     1                TEMP12(1),TEMP12(MAXOBV+1),
25602     1                IBUGA3,ISUBRO,IERROR)
25603        ELSEIF(NUMVAR.EQ.6)THEN
25604          CALL CODCT6(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,NS1,
25605     1                ICCTOF,ICCTG1,ICCTG2,ICCTG3,ICCTG4,ICCTG5,IWRITE,
25606     1                TEMP91,TEMP7,TEMP8,TEMP21,
25607     1                TEMP12(1),TEMP12(MAXOBV+1),TEMP22,
25608     1                IBUGA3,ISUBRO,IERROR)
25609        ENDIF
25610        DO11324I=1,NS1
25611          TEMP1(I)=TEMP91(I)
2561211324   CONTINUE
25613        NITEMX=NS1
25614      ELSEIF(ICASL7.EQ.'DIST')THEN
25615        CALL DISTIN(TEMP1,NS1,IWRITE,TEMP1,NITEMX,IBUGA3,IERROR)
25616      ELSEIF(ICASL7.EQ.'BLOC' .OR. ICASL7.EQ.'FLOC' .OR.
25617     1       ICASL7.EQ.'FLEN')THEN
25618        CALL DPFRAG(TEMP1,NS1,IWRITE,TEMP2,NBREAK,TEMP3,TEMP4,NFRAG,
25619     1              ISUBRO,IBUGA3,IERROR)
25620        IF(IERROR.EQ.'YES')GOTO9000
25621        IF(ICASL7.EQ.'BLOC')THEN
25622          DO21324I=1,NBREAK
25623            TEMP1(I)=TEMP2(I)
2562421324     CONTINUE
25625          NITEMX=NBREAK
25626        ELSEIF(ICASL7.EQ.'FLOC')THEN
25627          NITEMX=NFRAG
25628          IF(NFRAG.GE.1)THEN
25629            DO21326I=1,NFRAG
25630              TEMP1(I)=TEMP3(I)
2563121326       CONTINUE
25632          ENDIF
25633        ELSEIF(ICASL7.EQ.'FLEN')THEN
25634          NITEMX=NFRAG
25635          IF(NFRAG.GE.1)THEN
25636            DO21328I=1,NFRAG
25637              TEMP1(I)=TEMP4(I)
2563821328       CONTINUE
25639          ENDIF
25640        ENDIF
25641      ELSEIF(ICASL7.EQ.'SEQD')THEN
25642        ISTAT='DIFF'
25643        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,ISTAT,
25644     1              IBUGA3,ISUBRO,IERROR)
25645      ELSEIF(ICASL7.EQ.'SEME')THEN
25646        ISTAT='MEAN'
25647        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,ISTAT,
25648     1              IBUGA3,ISUBRO,IERROR)
25649      ELSEIF(ICASL7.EQ.'SEMN')THEN
25650        ISTAT='MINI'
25651        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,ISTAT,
25652     1              IBUGA3,ISUBRO,IERROR)
25653      ELSEIF(ICASL7.EQ.'SEMX')THEN
25654        ISTAT='MAXI'
25655        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,ISTAT,
25656     1              IBUGA3,ISUBRO,IERROR)
25657      ELSEIF(ICASL7.EQ.'SEQS')THEN
25658        ISTAT='SUM '
25659        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,ISTAT,
25660     1              IBUGA3,ISUBRO,IERROR)
25661      ELSEIF(ICASL7.EQ.'SEQP')THEN
25662        ISTAT='PROD'
25663        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,ISTAT,
25664     1              IBUGA3,ISUBRO,IERROR)
25665      ELSEIF(ICASL7.EQ.'SEQL')THEN
25666        ISTAT='LOWE'
25667        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,ISTAT,
25668     1              IBUGA3,ISUBRO,IERROR)
25669      ELSEIF(ICASL7.EQ.'SEQU')THEN
25670        ISTAT='UPPE'
25671        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,ISTAT,
25672     1              IBUGA3,ISUBRO,IERROR)
25673      ELSEIF(ICASL7.EQ.'GSQD' .OR. ICASL7.EQ.'GSQS' .OR.
25674     1       ICASL7.EQ.'GSQP' .OR. ICASL7.EQ.'GSQM' .OR.
25675     1       ICASL7.EQ.'GQMN' .OR. ICASL7.EQ.'GQMX' .OR.
25676     1       ICASL7.EQ.'GSQL' .OR. ICASL7.EQ.'GSQU')THEN
25677        ISTAT='DIFF'
25678        IF(ICASL7.EQ.'GSQS')ISTAT='SUM'
25679        IF(ICASL7.EQ.'GSQP')ISTAT='PROD'
25680        IF(ICASL7.EQ.'GSQM')ISTAT='MEAN'
25681        IF(ICASL7.EQ.'GQMN')ISTAT='MINI'
25682        IF(ICASL7.EQ.'GQMX')ISTAT='MAXI'
25683        IF(ICASL7.EQ.'GSQL')ISTAT='LOWE'
25684        IF(ICASL7.EQ.'GSQU')ISTAT='UPPE'
25685        CALL SEQDI2(TEMP1,TEMP2,NS1,IWRITE,TEMP91,TEMP3,NITEMX,ISTAT,
25686     1              TEMP4,TEMP5,
25687     1              IBUGA3,ISUBRO,IERROR)
25688        DO11326I=1,NITEMX
25689          TEMP1(I)=TEMP91(I)
25690          TEMP2(I)=TEMP3(I)
2569111326   CONTINUE
25692      ELSEIF(ICASL7.EQ.'IART')THEN
25693        CALL INTARR(TEMP1,NS1,IWRITE,TEMP1,NITEMX,IBUGA3,IERROR)
25694      ELSEIF(ICASL7.EQ.'CUMS')THEN
25695        CALL CUMSUM(TEMP1,NS1,IWRITE,TEMP3,IBUGA3,IERROR)
25696        INCX=1
25697        CALL SCOPY(NS1,TEMP3,INCX,TEMP1,INCX)
25698      ELSEIF(ICASL7.EQ.'RAEQ')THEN
25699        CALL RANERR(TEMP1,TEMP2,NS1,IWRITE,TEMP3,MAXOBV,TEMP4,
25700     1              IBUGA3,ISUBRO,IERROR)
25701        INCX=1
25702        CALL SCOPY(NS1,TEMP4,INCX,TEMP1,INCX)
25703      ELSEIF(ICASL7.EQ.'CMIN')THEN
25704        CALL CUMMIN(TEMP1,NS1,IWRITE,TEMP3,IBUGA3,ISUBRO,IERROR)
25705        INCX=1
25706        CALL SCOPY(NS1,TEMP3,INCX,TEMP1,INCX)
25707      ELSEIF(ICASL7.EQ.'CMAX')THEN
25708        CALL CUMMAX(TEMP1,NS1,IWRITE,TEMP3,IBUGA3,ISUBRO,IERROR)
25709        INCX=1
25710        CALL SCOPY(NS1,TEMP3,INCX,TEMP1,INCX)
25711      ELSEIF(ICASL7.EQ.'CUMA')THEN
25712        CALL CUMAVE(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
25713      ELSEIF(ICASL7.EQ.'CUMH')THEN
25714        CALL CUMHAZ(TEMP1,TEMP2,NS1,IWRITE,TEMP1,TEMP5,MAXOBV,
25715     1              IBUGA3,IERROR)
25716      ELSEIF(ICASL7.EQ.'HAZA')THEN
25717        CALL HAZARD(TEMP1,TEMP2,NS1,IWRITE,TEMP1,TEMP5,MAXOBV,
25718     1              IBUGA3,IERROR)
25719      ELSEIF(ICASL7.EQ.'EXPS')THEN
25720        IF(TEMPS(2).GT.0.0.AND.TEMPS(2).LT.1.0)THEN
25721          CALL EXPSMO(TEMP1,TEMP2,TEMPS(2),TEMPS(3),NS1,IWRITE,TEMP1,
25722     1                IBUGA3,IERROR)
25723        ELSE
25724          CALL EXPSM2(TEMP1,TEMP2,TEMPS(2),TEMPS(3),NS1,IWRITE,TEMP3,
25725     1                IBUGA3,IERROR)
25726          DO1185I=1,NS1
25727            TEMP1(I)=TEMP3(I)
25728 1185     CONTINUE
25729        ENDIF
25730C
25731        IH='ALPH'
25732        IH2='A   '
25733        VALUE0=TEMPS(2)
25734        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
25735     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
25736     1              IANS,IWIDTH,IBUGA3,IERROR)
25737C
25738        IH='EXPS'
25739        IH2='MSE '
25740        VALUE0=TEMPS(3)
25741        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
25742     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
25743     1              IANS,IWIDTH,IBUGA3,IERROR)
25744C
25745      ELSEIF(ICASL7.EQ.'CUMP')THEN
25746        CALL CUMPRO(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
25747      ELSEIF(ICASL7.EQ.'CUMI')THEN
25748        CALL CUMINT(TEMP1,TEMP2,NS1,NUMVAR,IWRITE,TEMP1,IBUGA3,IERROR)
25749      ELSEIF(ICASL7.EQ.'FLIP')THEN
25750        CALL REVERS(TEMP1,NS1,IWRITE,TEMP1,TEMP2,IBUGA3,IERROR)
25751      ELSEIF(ICASL7.EQ.'MTCH')THEN
25752        CALL MATCH(TEMP1,TEMP3,NS1,TEMP2,NS2,IWRITE,TEMP4,ICASMT,
25753     1             IBUGA3,ISUBRO,IERROR)
25754        NITEMX=NS2
25755        DO11373I=1,NITEMX
25756          TEMP1(I)=TEMP4(I)
2575711373   CONTINUE
25758      ELSEIF(ICASL7.EQ.'MTC2')THEN
25759        CALL MATCH2(TEMP1,NS1,TEMP2,NS2,TEMP3,IWRITE,
25760     1              ISUBRO,IBUGA3,IERROR)
25761        NITEMX=NS2
25762        DO11374I=1,NITEMX
25763          TEMP1(I)=TEMP3(I)
2576411374   CONTINUE
25765      ELSEIF(ICASL7.EQ.'REPL')THEN
25766C
25767C       FOR REPLACE COMMAND, NEED TO INSERT THE CURRENTLY DEFINED
25768C       VALUES FOR THE FIRST LEFT-HAND SIDE VARIABLE IN TEMP4.
25769C
25770        NS1SAV=NS1
25771        NS1=0
25772        DO11381I=1,NINEW
25773          IF(ISUB(I).EQ.0)GOTO11381
25774          IF(I.GT.NILEF1)GOTO11389
25775          IJ=MAXN*(ICOLL(1)-1)+I
25776          NS1=NS1+1
25777          IF(ICOLL(1).LE.MAXCOL)TEMP4(NS1)=V(IJ)
25778          IF(ICOLL(1).EQ.MAXCP1)TEMP4(NS1)=PRED(I)
25779          IF(ICOLL(1).EQ.MAXCP2)TEMP4(NS1)=RES(I)
25780          IF(ICOLL(1).EQ.MAXCP3)TEMP4(NS1)=YPLOT(I)
25781          IF(ICOLL(1).EQ.MAXCP4)TEMP4(NS1)=XPLOT(I)
25782          IF(ICOLL(1).EQ.MAXCP5)TEMP4(NS1)=X2PLOT(I)
25783          IF(ICOLL(1).EQ.MAXCP6)TEMP4(NS1)=TAGPLO(I)
2578411381   CONTINUE
2578511389   CONTINUE
25786        NS1=NS1SAV
25787        CALL REPLAC(TEMP1,TEMP3,NS1,TEMP2,NS2,IWRITE,TEMP4,ICASMT,
25788     1              ISUBRO,IBUGA3,IERROR)
25789        NITEMX=NS1
25790        DO11383I=1,NITEMX
25791          TEMP1(I)=TEMP4(I)
2579211383   CONTINUE
25793C
25794      ELSEIF(ICASL7.EQ.'CONV')THEN
25795        CALL CONVOL(TEMP1,NS1,TEMP2,NS2,NUMVAR,IWRITE,MAXN,
25796     1              TEMP91,NITEMX,IBUGA3,IERROR)
25797        DO11395I=1,NITEMX
25798          TEMP1(I)=TEMP91(I)
2579911395   CONTINUE
25800      ELSEIF(ICASL7.EQ.'DECO')THEN
25801        CALL DECONV(TEMP1,NS1,TEMP2,NS2,NUMVAR,IWRITE,
25802     1              TEMP91,NITEMX,IBUGA3,IERROR)
25803        DO11405I=1,NITEMX
25804          TEMP1(I)=TEMP91(I)
2580511405   CONTINUE
25806      ELSEIF(ICASL7.EQ.'SORC')THEN
25807        CALL SORTI(TEMP1,NS1,TEMP1,TEMP91)
25808        IF(ISORDI.EQ.'DESC')THEN
25809          DO31411I=1,NS1
25810            TEMP4(I)=TEMP1(I)
2581131411     CONTINUE
25812          DO31412I=1,NS1
25813            II=NS1-I+1
25814            TEMP1(I)=TEMP4(II)
2581531412     CONTINUE
25816        ENDIF
25817C
25818        IF(IBUGA3.EQ.'ON')THEN
25819          WRITE(ICOUT,999)
25820          CALL DPWRST('XXX','BUG ')
25821          WRITE(ICOUT,11411)(TEMP1(I),TEMP91(I),I=1,NS1)
2582211411     FORMAT(F10.5,2X,F10.5)
25823          CALL DPWRST('XXX','BUG ')
25824        ENDIF
25825C
25826        IF(NUMARG.LE.4)GOTO11418
25827          DO11412ILOCRI=5,NUMARG
25828            IH1=IHARG(ILOCRI)
25829            IH2=IHARG2(ILOCRI)
25830            IF(IH1.EQ.'SUBS'.AND.IH2.EQ.'ET  ')GOTO11418
25831            IF(IH1.EQ.'EXCE'.AND.IH2.EQ.'PT  ')GOTO11418
25832            IF(IH1.EQ.'FOR '.AND.IH2.EQ.'    ')GOTO11418
25833            IHWUSE='V'
25834            MESSAG='YES'
25835            CALL CHECKN(IH1,IH2,IHWUSE,
25836     1           IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
25837     1           ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
25838            IF(IERROR.EQ.'YES')GOTO19000
25839            ICOLRI=IVALUE(ILOC)
25840            NITEMP=IN(ILOC)
25841C
25842            CALL DPSUBS(NITEMP,ILOCS,NSTEMP,IBUGQ,IERROR)
25843C
25844            NR=0
25845            DO11413I=1,NITEMP
25846              IF(ISUB(I).EQ.0)GOTO11413
25847              NR=NR+1
25848              IJ=MAXN*(ICOLRI-1)+NR
25849              IF(ICOLRI.LE.MAXCOL)TEMP2(NR)=V(IJ)
25850              IF(ICOLRI.EQ.MAXCP1)TEMP2(NR)=PRED(I)
25851              IF(ICOLRI.EQ.MAXCP2)TEMP2(NR)=RES(I)
25852              IF(ICOLRI.EQ.MAXCP3)TEMP2(NR)=YPLOT(I)
25853              IF(ICOLRI.EQ.MAXCP4)TEMP2(NR)=XPLOT(I)
25854              IF(ICOLRI.EQ.MAXCP5)TEMP2(NR)=X2PLOT(I)
25855              IF(ICOLRI.EQ.MAXCP6)TEMP2(NR)=TAGPLO(I)
2585611413       CONTINUE
25857C
25858            DO11414I=1,NR
25859              J=INT(TEMP91(I)+0.5)
25860              TEMP3(I)=TEMP2(J)
2586111414       CONTINUE
25862            IF(ISORDI.EQ.'DESC')THEN
25863              DO11416I=1,NR
25864                TEMP4(I)=TEMP3(I)
2586511416         CONTINUE
25866              DO11419I=1,NR
25867                II=NR-I+1
25868                TEMP3(I)=TEMP4(II)
2586911419         CONTINUE
25870            ENDIF
25871C
25872            J=0
25873            DO11415I=1,NITEMP
25874              IF(ISUB(I).EQ.0)GOTO11415
25875              J=J+1
25876              IJ=MAXN*(ICOLRI-1)+I
25877              IF(ICOLRI.LE.MAXCOL)V(IJ)=TEMP3(J)
25878              IF(ICOLRI.EQ.MAXCP1)PRED(I)=TEMP3(J)
25879              IF(ICOLRI.EQ.MAXCP2)RES(I)=TEMP3(J)
25880              IF(ICOLRI.EQ.MAXCP3)YPLOT(I)=TEMP3(J)
25881              IF(ICOLRI.EQ.MAXCP4)XPLOT(I)=TEMP3(J)
25882              IF(ICOLRI.EQ.MAXCP5)X2PLOT(I)=TEMP3(J)
25883              IF(ICOLRI.EQ.MAXCP6)TAGPLO(I)=TEMP3(J)
2588411415       CONTINUE
2588511412     CONTINUE
2588611418   CONTINUE
25887C
25888CCCCC THE FOLLOWING STACK SECTION ADDED MAY 2003
25889CCCCC FEBRUARY 2005: ADD SUPPORT FOR REPLICATED STACK.  IN THIS
25890CCCCC                CASE, LAST VARIABLE IS A REPLICATION NUMBER
25891CCCCC                THAT WILL BE DUPLICATED FOR EACH GROUP.
25892C
25893      ELSEIF(ICASL7.EQ.'STAC' .OR. ICASL7.EQ.'RSTA')THEN
25894        IF(NUMARG.LE.4)GOTO91499
25895        IF(ICASL7.EQ.'RSTA' .AND. NUMARG.LE.6)GOTO91499
25896C
25897        ICNT=0
25898        IVARCN=0
25899        NLAST=NUMARG
25900        NSTRT=5
25901        IF(ICASL7.EQ.'RSTA')NSTRT=7
25902        IF(ICASL7.EQ.'RSTA')THEN
25903          NLAST=NUMARG-1
25904          DO91403II=NSTRT,NUMARG
25905            IH1=IHARG(II)
25906            IH2=IHARG2(II)
25907            IF(IH1.EQ.'SUBS'.AND.IH2.EQ.'ET  ')THEN
25908              NLAST=II-1
25909              GOTO91407
25910            ELSEIF(IH1.EQ.'EXCE'.AND.IH2.EQ.'PT  ')THEN
25911              NLAST=II-1
25912              GOTO91407
25913            ELSEIF(IH1.EQ.'FOR '.AND.IH2.EQ.'    ')THEN
25914              NLAST=II-1
25915              GOTO91407
25916            ENDIF
2591791403     CONTINUE
2591891407     CONTINUE
25919          NREPL=NLAST+1
25920        ENDIF
25921C
25922        DO91412ILOCRI=NSTRT,NLAST
25923C
25924          IF(ICASL7.EQ.'RSTA')THEN
25925            IHREPL=IHARG(NREPL)
25926            IHREP2=IHARG2(NREPL)
25927            IF(IHREPL.EQ.'SUBS'.AND.IHREP2.EQ.'ET  ')GOTO91499
25928            IF(IHREPL.EQ.'EXCE'.AND.IHREP2.EQ.'PT  ')GOTO91499
25929            IF(IHREPL.EQ.'FOR '.AND.IHREP2.EQ.'    ')GOTO91499
25930            IHWUSE='V'
25931            MESSAG='YES'
25932            CALL CHECKN(IHREPL,IHREP2,IHWUSE,
25933     1                  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
25934     1                  NUMNAM,MAXNAM,
25935     1                  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
25936            IF(IERROR.EQ.'YES')GOTO19000
25937            ICOLRP=IVALUE(ILOC)
25938            NIREPL=IN(ILOC)
25939          ENDIF
25940C
25941          IHREPL=IHARG(ILOCRI)
25942          IHREP2=IHARG2(ILOCRI)
25943          IF(IHREPL.EQ.'SUBS'.AND.IHREP2.EQ.'ET  ')GOTO91499
25944          IF(IHREPL.EQ.'EXCE'.AND.IHREP2.EQ.'PT  ')GOTO91499
25945          IF(IHREPL.EQ.'FOR '.AND.IHREP2.EQ.'    ')GOTO91499
25946          IHWUSE='V'
25947          MESSAG='YES'
25948          CALL CHECKN(IHREPL,IHREP2,IHWUSE,
25949     1         IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
25950     1         ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
25951          IF(IERROR.EQ.'YES')GOTO19000
25952          ICOLRI=IVALUE(ILOC)
25953          NITEMP=IN(ILOC)
25954          IVARCN=IVARCN+1
25955C
25956          CALL DPSUBS(NITEMP,ILOCS,NSTEMP,IBUGQ,IERROR)
25957C
25958          NR=0
25959          DO91413I=1,NITEMP
25960            IF(ISUB(I).EQ.0)GOTO91413
25961            NR=NR+1
25962            IJ=MAXN*(ICOLRI-1)+NR
25963            IF(ICOLRI.LE.MAXCOL)ATEMP=V(IJ)
25964            IF(ICOLRI.EQ.MAXCP1)ATEMP=PRED(I)
25965            IF(ICOLRI.EQ.MAXCP2)ATEMP=RES(I)
25966            IF(ICOLRI.EQ.MAXCP3)ATEMP=YPLOT(I)
25967            IF(ICOLRI.EQ.MAXCP4)ATEMP=XPLOT(I)
25968            IF(ICOLRI.EQ.MAXCP5)ATEMP=X2PLOT(I)
25969            IF(ICOLRI.EQ.MAXCP6)ATEMP=TAGPLO(I)
25970C
25971            IF(ICASL7.EQ.'RSTA')THEN
25972              IJ=MAXN*(ICOLRP-1)+NR
25973              IF(ICOLRP.LE.MAXCOL)ATEMP2=V(IJ)
25974              IF(ICOLRP.EQ.MAXCP1)ATEMP2=PRED(I)
25975              IF(ICOLRP.EQ.MAXCP2)ATEMP2=RES(I)
25976              IF(ICOLRP.EQ.MAXCP3)ATEMP2=YPLOT(I)
25977              IF(ICOLRP.EQ.MAXCP4)ATEMP2=XPLOT(I)
25978              IF(ICOLRP.EQ.MAXCP5)ATEMP2=X2PLOT(I)
25979              IF(ICOLRP.EQ.MAXCP6)ATEMP2=TAGPLO(I)
25980            ENDIF
25981C
25982            ICNT=ICNT+1
25983            IF(ICNT.GT.MAXOBV)THEN
25984              WRITE(ICOUT,999)
25985              CALL DPWRST('XXX','BUG ')
25986              WRITE(ICOUT,91417)
2598791417         FORMAT('****** WARNING FROM STACK COMMAND--')
25988              CALL DPWRST('XXX','BUG ')
25989              WRITE(ICOUT,91419)
2599091419         FORMAT('       MAXIMUM NUMBER OF ROWS, ',I8,
25991     1               ' HAS BEEN EXCEEDED.')
25992              CALL DPWRST('XXX','BUG ')
25993              GOTO91418
25994            ENDIF
25995C
25996            TEMP1(ICNT)=ATEMP
25997            TEMP2(ICNT)=REAL(IVARCN)
25998            TEMP91(ICNT)=ATEMP2
2599991413     CONTINUE
26000C
26001          J=0
26002          DO91415I=1,NITEMP
26003            IF(ISUB(I).EQ.0)GOTO91415
26004            J=J+1
2600591415     CONTINUE
2600691412   CONTINUE
2600791418   CONTINUE
26008C
26009        NITEMX=ICNT
26010        IFOUND='YES'
26011        GOTO11900
26012C
2601391499   CONTINUE
26014        IERROR='YES'
26015        GOTO9000
26016C
26017C     FOR COMBINE COMMAND, ADD LIST OF VARIABLES/PARAMETERS TO
26018C     CREATE A SINGLE OUTPUT VECTOR.
26019C
26020      ELSEIF(ICASL7.EQ.'COMB')THEN
26021C
26022        ICNT=0
26023        IVARCN=0
26024        NLAST=NUMARG
26025        NSTRT=4
26026C
26027        DO91712ILOCRI=NSTRT,NLAST
26028C
26029          IHREPL=IHARG(ILOCRI)
26030          IHREP2=IHARG2(ILOCRI)
26031          ATEMPP=ARG(ILOCRI)
26032          IF(IHREPL.EQ.'SUBS'.AND.IHREP2.EQ.'ET  ')GOTO91799
26033          IF(IHREPL.EQ.'EXCE'.AND.IHREP2.EQ.'PT  ')GOTO91799
26034          IF(IHREPL.EQ.'FOR '.AND.IHREP2.EQ.'    ')GOTO91799
26035C
26036C         CHECK FOR MATRIX OR STRING (THESE NOT CURRENTLY
26037C         SUPPORTED FOR COMBINE COMMAND)
26038C
26039          IHWUSE='M'
26040          MESSAG='NO'
26041          CALL CHECKN(IHREPL,IHREP2,IHWUSE,
26042     1         IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
26043     1         ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
26044          IF(IERROR.EQ.'NO')THEN
26045            WRITE(ICOUT,91731)
2604691731       FORMAT('****** ERROR FROM COMBINE COMMAND--')
26047            CALL DPWRST('XXX','BUG ')
26048            WRITE(ICOUT,91733)IHREPL,IHREP2
2604991733       FORMAT('       MATRICES ARE NOT ALLOWED.  ',A4,A4,
26050     1             'IS A MATRIX.')
26051            CALL DPWRST('XXX','BUG ')
26052            IFOUND='YES'
26053            IERROR='YES'
26054            GOTO8000
26055          ENDIF
26056C
26057          IHWUSE='F'
26058          MESSAG='NO'
26059          CALL CHECKN(IHREPL,IHREP2,IHWUSE,
26060     1         IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
26061     1         ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
26062          IF(IERROR.EQ.'NO')THEN
26063            WRITE(ICOUT,91731)
26064            CALL DPWRST('XXX','BUG ')
26065            WRITE(ICOUT,91735)IHREPL,IHREP2
2606691735       FORMAT('       FUNCTIONS (STRINGS) ARE NOT ALLOWED.  ',
26067     1             A4,A4,'IS A FUNCTION OR A STRING.')
26068            CALL DPWRST('XXX','BUG ')
26069            IFOUND='YES'
26070            IERROR='YES'
26071            GOTO8000
26072          ENDIF
26073C
26074C         CHECK FOR PARAMETER
26075C
26076          IHWUSE='P'
26077          MESSAG='NO'
26078          CALL CHECKN(IHREPL,IHREP2,IHWUSE,
26079     1         IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
26080     1         ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
26081          IF(IERROR.EQ.'NO')THEN
26082            ICNT=ICNT+1
26083            IF(ICNT.GT.MAXOBV)GOTO91716
26084            TEMP1(ICNT)=VALUE(ILOC)
26085            GOTO91712
26086          ENDIF
26087C
26088C         CHECK FOR VARIABLE - IF NOT PARAMETER, VARIABLE, MATRIX,
26089C                              OR STRING/FUNCTION, ASSUME ARGUMENT
26090C                              IS A NUMERIC VALUE.
26091C
26092          IHWUSE='V'
26093          MESSAG='NO'
26094          CALL CHECKN(IHREPL,IHREP2,IHWUSE,
26095     1         IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
26096     1         ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
26097          IF(IERROR.EQ.'YES')THEN
26098            ICNT=ICNT+1
26099            IF(ICNT.GT.MAXOBV)GOTO91716
26100            TEMP1(ICNT)=ATEMPP
26101            GOTO91712
26102          ENDIF
26103C
26104          ICOLRI=IVALUE(ILOC)
26105          NITEMP=IN(ILOC)
26106C
26107          CALL DPSUBS(NITEMP,ILOCS,NSTEMP,IBUGQ,IERROR)
26108C
26109          NR=0
26110          DO91713I=1,NITEMP
26111            IF(ISUB(I).EQ.0)GOTO91713
26112            NR=NR+1
26113            IJ=MAXN*(ICOLRI-1)+NR
26114            IF(ICOLRI.LE.MAXCOL)ATEMP=V(IJ)
26115            IF(ICOLRI.EQ.MAXCP1)ATEMP=PRED(I)
26116            IF(ICOLRI.EQ.MAXCP2)ATEMP=RES(I)
26117            IF(ICOLRI.EQ.MAXCP3)ATEMP=YPLOT(I)
26118            IF(ICOLRI.EQ.MAXCP4)ATEMP=XPLOT(I)
26119            IF(ICOLRI.EQ.MAXCP5)ATEMP=X2PLOT(I)
26120            IF(ICOLRI.EQ.MAXCP6)ATEMP=TAGPLO(I)
26121C
26122            ICNT=ICNT+1
26123            IF(ICNT.GT.MAXOBV)GOTO91716
26124C
26125            TEMP1(ICNT)=ATEMP
2612691713     CONTINUE
26127C
2612891712   CONTINUE
26129C
26130        NITEMX=ICNT
26131        IFOUND='YES'
26132        IERROR='NO'
26133        GOTO11900
26134C
2613591799   CONTINUE
26136        IERROR='YES'
26137        GOTO9000
26138C
2613991716   CONTINUE
26140        WRITE(ICOUT,999)
26141        CALL DPWRST('XXX','BUG ')
26142        WRITE(ICOUT,91717)
2614391717   FORMAT('****** WARNING FROM COMBINE COMMAND--')
26144        CALL DPWRST('XXX','BUG ')
26145        WRITE(ICOUT,91719)
2614691719   FORMAT('       MAXIMUM NUMBER OF ROWS, ',I8,
26147     1         ' HAS BEEN EXCEEDED.')
26148        CALL DPWRST('XXX','BUG ')
26149        NITEMX=ICNT
26150        IFOUND='YES'
26151        GOTO11900
26152C
26153      ELSEIF(ICASL7.EQ.'FREQ')THEN
26154        CALL FREQUE(TEMP1,NS1,TEMP2,NS2,NUMVAR,IWRITE,
26155     1              TEMP91,NITEMX,IBUGA3,IERROR)
26156        DO11425I=1,NITEMX
26157          TEMP1(I)=TEMP91(I)
2615811425   CONTINUE
26159      ELSEIF(ICASL7.EQ.'JITT')THEN
26160        DELTA=TEMPS(2)
26161        CALL JITTER(TEMP1,NS1,DELTA,
26162     1              TEMP91,NITEMX,ISEED,IBUGA3,IERROR)
26163        DO11428I=1,NITEMX
26164          TEMP1(I)=TEMP91(I)
2616511428   CONTINUE
26166      ELSEIF(ICASL7.EQ.'COPV')THEN
26167C
26168C       NOTE 7/16/2008:
26169C       FOR VARIABLE COPY, COPY OVER CONTENTS OF VARIABLE
26170C       ON RIGHT HAND SIDE.  THE SUBSET/EXCEPT/FOR WILL BE
26171C       HANDLED WHEN WE UPDATE THE LEFT HAND SIDE VARIABLE.
26172C       DO THIS SO THAT "ROW INDEX" MAINTAINED ON SUBSET
26173C       CLAUSES.
26174C
26175C       MARCH 2009: PUT IN A CHECK FOR AN EMPTY SUBSET.
26176C                   IN THIS CASE, WE WANT TO DO NOTHING.
26177C
26178        DO11426I=1,NINEW
26179          IJ=MAXN*(ICOLR(1)-1)+I
26180          IF(ICOLR(1).LE.MAXCOL)TEMP1(I)=V(IJ)
26181          IF(ICOLR(1).EQ.MAXCP1)TEMP1(I)=PRED(I)
26182          IF(ICOLR(1).EQ.MAXCP2)TEMP1(I)=RES(I)
26183          IF(ICOLR(1).EQ.MAXCP3)TEMP1(I)=YPLOT(I)
26184          IF(ICOLR(1).EQ.MAXCP4)TEMP1(I)=XPLOT(I)
26185          IF(ICOLR(1).EQ.MAXCP5)TEMP1(I)=X2PLOT(I)
26186          IF(ICOLR(1).EQ.MAXCP6)TEMP1(I)=TAGPLO(I)
2618711426   CONTINUE
26188        NITEMX=NINEW
26189        NSX=0
26190        DO11427I=1,NITEMX
26191          IF(ISUB(I).EQ.1)NSX=NSX+1
2619211427   CONTINUE
26193        IF(NSX.EQ.0)THEN
26194          IFOUND='YES'
26195          IERROR='NO'
26196          GOTO19000
26197        END IF
26198      ELSEIF(ICASL7.EQ.'AGCO')THEN
26199C
26200C       AUGUST 2008: ALLOW P AND N TO BE EITHER VECTORS OR
26201C                    SCALARS.  NOTE THAT ALPHA WILL ALWAYS
26202C                    BE A SCALAR.
26203C
26204        ALPHAT=TEMPS(3)
26205C
26206        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA')THEN
26207          PTEMP=TEMPS(1)
26208          NTEMP=INT(TEMPS(2)+0.5)
26209          CALL DPAGCO(PTEMP,NTEMP,ALPHAT,IWRITE,
26210     1                ALOWLM,AUPPLM,IBUGA3,IERROR)
26211          SCAL91=ALOWLM
26212          ITYP91='SCAL'
26213          SCAL92=AUPPLM
26214          ITYP92='SCAL'
26215        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI')THEN
26216          DO11431I=1,NINEW
26217            IF(ITYPA(1).EQ.'VARI')THEN
26218              PTEMP=TEMP1(I)
26219            ELSE
26220              PTEMP=TEMPS(1)
26221            ENDIF
26222            IF(ITYPA(2).EQ.'VARI')THEN
26223              NTEMP=INT(TEMP2(I)+0.5)
26224            ELSE
26225              NTEMP=INT(TEMPS(2)+0.5)
26226            ENDIF
26227            CALL DPAGCO(PTEMP,NTEMP,ALPHAT,IWRITE,
26228     1                  ALOWLM,AUPPLM,IBUGA3,IERROR)
26229            TEMP1(I)=ALOWLM
26230            TEMP2(I)=AUPPLM
2623111431     CONTINUE
26232          ITYP91='VARI'
26233          ITYP92='VARI'
26234        ENDIF
26235      ELSEIF(ICASL7.EQ.'EBLL')THEN
26236C
26237C       AUGUST 2008: ALLOW P AND N TO BE EITHER VECTORS OR
26238C                    SCALARS.  NOTE THAT ALPHA WILL ALWAYS
26239C                    BE A SCALAR.
26240C
26241        ALPHAT=TEMPS(3)
26242C
26243        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA')THEN
26244          PTEMP=TEMPS(1)
26245          NTEMP=INT(TEMPS(2)+0.5)
26246          CALL DPEBLL(PTEMP,NTEMP,ALPHAT,IWRITE,
26247     1                ALOWLM,'TWOS',IBUGA3,IERROR)
26248          SCAL91=ALOWLM
26249          ITYP91='SCAL'
26250        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI')THEN
26251          DO11432I=1,NINEW
26252            IF(ITYPA(1).EQ.'VARI')THEN
26253              PTEMP=TEMP1(I)
26254            ELSE
26255              PTEMP=TEMPS(1)
26256            ENDIF
26257            IF(ITYPA(2).EQ.'VARI')THEN
26258              NTEMP=INT(TEMP2(I)+0.5)
26259            ELSE
26260              NTEMP=INT(TEMPS(2)+0.5)
26261            ENDIF
26262            CALL DPEBLL(PTEMP,NTEMP,ALPHAT,IWRITE,
26263     1                  ALOWLM,'TWOS',IBUGA3,IERROR)
26264            TEMP1(I)=ALOWLM
2626511432     CONTINUE
26266          ITYP91='VARI'
26267        ENDIF
26268      ELSEIF(ICASL7.EQ.'EBUL')THEN
26269C
26270C       AUGUST 2008: ALLOW P AND N TO BE EITHER VECTORS OR
26271C                    SCALARS.  NOTE THAT ALPHA WILL ALWAYS
26272C                    BE A SCALAR.
26273C
26274        ALPHAT=TEMPS(3)
26275C
26276        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA')THEN
26277          PTEMP=TEMPS(1)
26278          NTEMP=INT(TEMPS(2)+0.5)
26279          CALL DPEBUL(PTEMP,NTEMP,ALPHAT,IWRITE,
26280     1                AUPPLM,'TWOS',IBUGA3,IERROR)
26281          SCAL91=AUPPLM
26282          ITYP91='SCAL'
26283        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI')THEN
26284          DO11433I=1,NINEW
26285            IF(ITYPA(1).EQ.'VARI')THEN
26286              PTEMP=TEMP1(I)
26287            ELSE
26288              PTEMP=TEMPS(1)
26289            ENDIF
26290            IF(ITYPA(2).EQ.'VARI')THEN
26291              NTEMP=INT(TEMP2(I)+0.5)
26292            ELSE
26293              NTEMP=INT(TEMPS(2)+0.5)
26294            ENDIF
26295            CALL DPEBUL(PTEMP,NTEMP,ALPHAT,IWRITE,
26296     1                  AUPPLM,'TWOS',IBUGA3,IERROR)
26297            TEMP1(I)=AUPPLM
2629811433     CONTINUE
26299          ITYP91='VARI'
26300        ENDIF
26301      ELSEIF(ICASL7.EQ.'EBCL')THEN
26302C
26303C       ALLOW P AND N TO BE EITHER VECTORS OR SCALARS.  NOTE THAT
26304C       ALPHA WILL ALWAYS BE A SCALAR.
26305C
26306        ALPHAT=TEMPS(3)
26307C
26308        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA')THEN
26309          PTEMP=TEMPS(1)
26310          NTEMP=INT(TEMPS(2)+0.5)
26311          CALL DPEBLL(PTEMP,NTEMP,P2,IWRITE,
26312     1                ALOWLM,'TWOS',IBUGA3,IERROR)
26313          CALL DPEBUL(PTEMP,NTEMP,P2,IWRITE,
26314     1                AUPPLM,'TWOS',IBUGA3,IERROR)
26315          SCAL91=ALOWLM
26316          ITYP91='SCAL'
26317          SCAL92=AUPPLM
26318          ITYP92='SCAL'
26319        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI')THEN
26320          DO11443I=1,NINEW
26321            IF(ITYPA(1).EQ.'VARI')THEN
26322              PTEMP=TEMP1(I)
26323            ELSE
26324              PTEMP=TEMPS(1)
26325            ENDIF
26326            IF(ITYPA(2).EQ.'VARI')THEN
26327              NTEMP=INT(TEMP2(I)+0.5)
26328            ELSE
26329              NTEMP=INT(TEMPS(2)+0.5)
26330            ENDIF
26331            CALL DPEBLL(PTEMP,NTEMP,ALPHAT,IWRITE,
26332     1                  ALOWLM,'TWOS',IBUGA3,IERROR)
26333            TEMP1(I)=ALOWLM
26334            CALL DPEBUL(PTEMP,NTEMP,ALPHAT,IWRITE,
26335     1                  AUPPLM,'TWOS',IBUGA3,IERROR)
26336            TEMP2(I)=AUPPLM
2633711443     CONTINUE
26338          ITYP91='VARI'
26339          ITYP92='VARI'
26340        ENDIF
26341      ELSEIF(ICASL7.EQ.'DPCL')THEN
26342C
26343        ALPHAT=TEMPS(5)
26344C
26345        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA' .AND.
26346     1     ITYPA(3).EQ.'PARA' .AND. ITYPA(4).EQ.'PARA')THEN
26347          P1TEMP=TEMPS(1)
26348          N1TEMP=INT(TEMPS(2)+0.5)
26349          P2TEMP=TEMPS(3)
26350          N2TEMP=INT(TEMPS(4)+0.5)
26351          CALL DPDPCL(P1TEMP,N1TEMP,P2TEMP,N2TEMP,ALPHAT,IWRITE,
26352     1                PDIFF,ALOWLM,AUPPLM,IBUGA3,IERROR)
26353          SCAL91=PDIFF
26354          ITYP91='SCAL'
26355          SCAL92=ALOWLM
26356          ITYP92='SCAL'
26357          SCAL93=AUPPLM
26358          ITYP93='SCAL'
26359        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI' .OR.
26360     1         ITYPA(3).EQ.'VARI' .OR. ITYPA(4).EQ.'VARI')THEN
26361          DO11436I=1,NINEW
26362            IF(ITYPA(1).EQ.'VARI')THEN
26363              P1TEMP=TEMP1(I)
26364            ELSE
26365              P1TEMP=TEMPS(1)
26366            ENDIF
26367            IF(ITYPA(2).EQ.'VARI')THEN
26368              N1TEMP=INT(TEMP2(I)+0.5)
26369            ELSE
26370              N1TEMP=INT(TEMPS(2)+0.5)
26371            ENDIF
26372            IF(ITYPA(3).EQ.'VARI')THEN
26373              P2TEMP=TEMP3(I)
26374            ELSE
26375              P2TEMP=TEMPS(3)
26376            ENDIF
26377            IF(ITYPA(4).EQ.'VARI')THEN
26378              N2TEMP=INT(TEMP4(I)+0.5)
26379            ELSE
26380              N2TEMP=INT(TEMPS(4)+0.5)
26381            ENDIF
26382            CALL DPDPCL(P1TEMP,N1TEMP,P2TEMP,N2TEMP,ALPHAT,IWRITE,
26383     1                  PDIFF,ALOWLM,AUPPLM,IBUGA3,IERROR)
26384            TEMP1(I)=PDIFF
26385            TEMP2(I)=ALOWLM
26386            TEMP91(I)=AUPPLM
2638711436     CONTINUE
26388          ITYP91='VARI'
26389          ITYP92='VARI'
26390          ITYP93='VARI'
26391        ENDIF
26392      ELSEIF(ICASL7.EQ.'DPTS' .OR. ICASL7.EQ.'DPLT' .OR.
26393     1       ICASL7.EQ.'DPUT')THEN
26394C
26395        IF(ICASL7.EQ.'DPTS')THEN
26396          ICASAN='BPTS'
26397        ELSEIF(ICASL7.EQ.'DPLT')THEN
26398          ICASAN='BPLT'
26399        ELSEIF(ICASL7.EQ.'DPUT')THEN
26400          ICASAN='BPUT'
26401        ENDIF
26402C
26403        ALPHAT=TEMPS(5)
26404C
26405        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA' .AND.
26406     1     ITYPA(3).EQ.'PARA' .AND. ITYPA(4).EQ.'PARA')THEN
26407          P1TEMP=TEMPS(1)
26408          N1TEMP=INT(TEMPS(2)+0.5)
26409          P2TEMP=TEMPS(3)
26410          N2TEMP=INT(TEMPS(4)+0.5)
26411          CALL DPBNPV(P1TEMP,N1TEMP,P2TEMP,N2TEMP,ALPHAT,ICASAN,IWRITE,
26412     1                PVAL,IBUGA3,IERROR)
26413          SCAL91=PVAL
26414          ITYP91='SCAL'
26415        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI' .OR.
26416     1         ITYPA(3).EQ.'VARI' .OR. ITYPA(4).EQ.'VARI')THEN
26417          DO11437I=1,NINEW
26418            IF(ITYPA(1).EQ.'VARI')THEN
26419              P1TEMP=TEMP1(I)
26420            ELSE
26421              P1TEMP=TEMPS(1)
26422            ENDIF
26423            IF(ITYPA(2).EQ.'VARI')THEN
26424              N1TEMP=INT(TEMP2(I)+0.5)
26425            ELSE
26426              N1TEMP=INT(TEMPS(2)+0.5)
26427            ENDIF
26428            IF(ITYPA(3).EQ.'VARI')THEN
26429              P2TEMP=TEMP3(I)
26430            ELSE
26431              P2TEMP=TEMPS(3)
26432            ENDIF
26433            IF(ITYPA(4).EQ.'VARI')THEN
26434              N2TEMP=INT(TEMP4(I)+0.5)
26435            ELSE
26436              N2TEMP=INT(TEMPS(4)+0.5)
26437            ENDIF
26438            CALL DPBNPV(P1TEMP,N1TEMP,P2TEMP,N2TEMP,ALPHAT,
26439     1                  ICASAN,IWRITE,
26440     1                  PVAL,IBUGA3,IERROR)
26441            TEMP1(I)=PVAL
2644211437     CONTINUE
26443          ITYP91='VARI'
26444        ENDIF
26445      ELSEIF(ICASL7.EQ.'R1TS' .OR. ICASL7.EQ.'R1LT' .OR.
26446     1       ICASL7.EQ.'R1UT')THEN
26447C
26448        IF(ICASL7.EQ.'R1TS')THEN
26449          ICASAN='R1TS'
26450        ELSEIF(ICASL7.EQ.'R1LT')THEN
26451          ICASAN='R1LT'
26452        ELSEIF(ICASL7.EQ.'R1UT')THEN
26453          ICASAN='R1UT'
26454        ENDIF
26455C
26456        ALPHAT=TEMPS(7)
26457C
26458        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA' .AND.
26459     1     ITYPA(3).EQ.'PARA' .AND. ITYPA(4).EQ.'PARA'.AND.
26460     1     ITYPA(5).EQ.'PARA' .AND. ITYPA(6).EQ.'PARA')THEN
26461          P1TEMP=TEMPS(1)
26462          N1TEMP=INT(TEMPS(2)+0.5)
26463          P2TEMP=TEMPS(3)
26464          N2TEMP=INT(TEMPS(4)+0.5)
26465          P3TEMP=TEMPS(5)
26466          N3TEMP=INT(TEMPS(6)+0.5)
26467          CALL DPRUH1(P1TEMP,N1TEMP,P2TEMP,N2TEMP,P3TEMP,N3TEMP,
26468     1                ALPHAT,ICASAN,IWRITE,
26469     1                PVAL,ALOWLM,AUPPLM,IBUGA3,ISUBRO,IERROR)
26470          SCAL91=PVAL
26471          ITYP91='SCAL'
26472          SCAL92=ALOWLM
26473          ITYP92='SCAL'
26474          SCAL93=AUPPLM
26475          ITYP93='SCAL'
26476        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI' .OR.
26477     1         ITYPA(3).EQ.'VARI' .OR. ITYPA(4).EQ.'VARI' .OR.
26478     1         ITYPA(5).EQ.'VARI' .OR. ITYPA(6).EQ.'VARI')THEN
26479          DO11441I=1,NINEW
26480            IF(ITYPA(1).EQ.'VARI')THEN
26481              P1TEMP=TEMP1(I)
26482            ELSE
26483              P1TEMP=TEMPS(1)
26484            ENDIF
26485            IF(ITYPA(2).EQ.'VARI')THEN
26486              N1TEMP=INT(TEMP2(I)+0.5)
26487            ELSE
26488              N1TEMP=INT(TEMPS(2)+0.5)
26489            ENDIF
26490            IF(ITYPA(3).EQ.'VARI')THEN
26491              P2TEMP=TEMP3(I)
26492            ELSE
26493              P2TEMP=TEMPS(3)
26494            ENDIF
26495            IF(ITYPA(4).EQ.'VARI')THEN
26496              N2TEMP=INT(TEMP4(I)+0.5)
26497            ELSE
26498              N2TEMP=INT(TEMPS(4)+0.5)
26499            ENDIF
26500            IF(ITYPA(5).EQ.'VARI')THEN
26501              P3TEMP=TEMP5(I)
26502            ELSE
26503              P3TEMP=TEMPS(5)
26504            ENDIF
26505            IF(ITYPA(6).EQ.'VARI')THEN
26506              N3TEMP=INT(TEMP6(I)+0.5)
26507            ELSE
26508              N3TEMP=INT(TEMPS(6)+0.5)
26509            ENDIF
26510            CALL DPRUH1(P1TEMP,N1TEMP,P2TEMP,N2TEMP,P3TEMP,N3TEMP,
26511     1                  ALPHAT,ICASAN,IWRITE,
26512     1                  PVAL,ALOWLM,AUPPLM,IBUGA3,ISUBRO,IERROR)
26513            TEMP1(I)=PVAL
26514            TEMP2(I)=ALOWLM
26515            TEMP91(I)=AUPPLM
2651611441     CONTINUE
26517          ITYP91='VARI'
26518          ITYP92='VARI'
26519          ITYP93='VARI'
26520        ENDIF
26521      ELSEIF(ICASL7.EQ.'R2TS' .OR. ICASL7.EQ.'R2LT' .OR.
26522     1       ICASL7.EQ.'R2UT')THEN
26523C
26524        IF(ICASL7.EQ.'R2TS')THEN
26525          ICASAN='R2TS'
26526        ELSEIF(ICASL7.EQ.'R2LT')THEN
26527          ICASAN='R2LT'
26528        ELSEIF(ICASL7.EQ.'R2UT')THEN
26529          ICASAN='R2UT'
26530        ENDIF
26531C
26532        ALPHAT=TEMPS(5)
26533C
26534        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA' .AND.
26535     1     ITYPA(3).EQ.'PARA' .AND. ITYPA(4).EQ.'PARA')THEN
26536          P1TEMP=TEMPS(1)
26537          N1TEMP=INT(TEMPS(2)+0.5)
26538          P2TEMP=TEMPS(3)
26539          N2TEMP=INT(TEMPS(4)+0.5)
26540          CALL DPRUH2(P1TEMP,N1TEMP,P2TEMP,N2TEMP,
26541     1                ALPHAT,ICASAN,IWRITE,
26542     1                PVAL,ALOWLM,AUPPLM,IBUGA3,IERROR)
26543          SCAL91=PVAL
26544          ITYP91='SCAL'
26545          SCAL92=ALOWLM
26546          ITYP92='SCAL'
26547          SCAL93=AUPPLM
26548          ITYP93='SCAL'
26549        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI' .OR.
26550     1         ITYPA(3).EQ.'VARI' .OR. ITYPA(4).EQ.'VARI')THEN
26551          DO11446I=1,NINEW
26552            IF(ITYPA(1).EQ.'VARI')THEN
26553              P1TEMP=TEMP1(I)
26554            ELSE
26555              P1TEMP=TEMPS(1)
26556            ENDIF
26557            IF(ITYPA(2).EQ.'VARI')THEN
26558              N1TEMP=INT(TEMP2(I)+0.5)
26559            ELSE
26560              N1TEMP=INT(TEMPS(2)+0.5)
26561            ENDIF
26562            IF(ITYPA(3).EQ.'VARI')THEN
26563              P2TEMP=TEMP3(I)
26564            ELSE
26565              P2TEMP=TEMPS(3)
26566            ENDIF
26567            IF(ITYPA(4).EQ.'VARI')THEN
26568              N2TEMP=INT(TEMP4(I)+0.5)
26569            ELSE
26570              N2TEMP=INT(TEMPS(4)+0.5)
26571            ENDIF
26572            CALL DPRUH2(P1TEMP,N1TEMP,P2TEMP,N2TEMP,
26573     1                  ALPHAT,ICASAN,IWRITE,
26574     1                  PVAL,ALOWLM,AUPPLM,IBUGA3,IERROR)
26575            TEMP1(I)=PVAL
26576            TEMP2(I)=ALOWLM
26577            TEMP91(I)=AUPPLM
2657811446     CONTINUE
26579          ITYP91='VARI'
26580          ITYP92='VARI'
26581          ITYP93='VARI'
26582        ENDIF
26583      ELSEIF(ICASL7.EQ.'R3TS' .OR. ICASL7.EQ.'R3LT' .OR.
26584     1       ICASL7.EQ.'R3UT')THEN
26585C
26586        IF(ICASL7.EQ.'R3TS')THEN
26587          ICASAN='R3TS'
26588        ELSEIF(ICASL7.EQ.'R3LT')THEN
26589          ICASAN='R3LT'
26590        ELSEIF(ICASL7.EQ.'R3UT')THEN
26591          ICASAN='R3UT'
26592        ENDIF
26593C
26594        ALPHAT=TEMPS(9)
26595C
26596        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA' .AND.
26597     1     ITYPA(3).EQ.'PARA' .AND. ITYPA(4).EQ.'PARA'.AND.
26598     1     ITYPA(5).EQ.'PARA' .AND. ITYPA(6).EQ.'PARA' .AND.
26599     1     ITYPA(7).EQ.'PARA' .AND. ITYPA(8).EQ.'PARA')THEN
26600          P1TEMP=TEMPS(1)
26601          N1TEMP=INT(TEMPS(2)+0.5)
26602          P2TEMP=TEMPS(3)
26603          N2TEMP=INT(TEMPS(4)+0.5)
26604          P3TEMP=TEMPS(5)
26605          N3TEMP=INT(TEMPS(6)+0.5)
26606          P4TEMP=TEMPS(7)
26607          N4TEMP=INT(TEMPS(8)+0.5)
26608          CALL DPRUH3(P1TEMP,N1TEMP,P2TEMP,N2TEMP,P3TEMP,N3TEMP,
26609     1                P4TEMP,N4TEMP,
26610     1                ALPHAT,ICASAN,IWRITE,
26611     1                PVAL,ALOWLM,AUPPLM,IBUGA3,ISUBRO,IERROR)
26612          SCAL91=PVAL
26613          ITYP91='SCAL'
26614          SCAL92=ALOWLM
26615          ITYP92='SCAL'
26616          SCAL93=AUPPLM
26617          ITYP93='SCAL'
26618        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI' .OR.
26619     1         ITYPA(3).EQ.'VARI' .OR. ITYPA(4).EQ.'VARI' .OR.
26620     1         ITYPA(5).EQ.'VARI' .OR. ITYPA(6).EQ.'VARI' .OR.
26621     1         ITYPA(7).EQ.'VARI' .OR. ITYPA(8).EQ.'VARI')THEN
26622          DO11641I=1,NINEW
26623            IF(ITYPA(1).EQ.'VARI')THEN
26624              P1TEMP=TEMP1(I)
26625            ELSE
26626              P1TEMP=TEMPS(1)
26627            ENDIF
26628            IF(ITYPA(2).EQ.'VARI')THEN
26629              N1TEMP=INT(TEMP2(I)+0.5)
26630            ELSE
26631              N1TEMP=INT(TEMPS(2)+0.5)
26632            ENDIF
26633            IF(ITYPA(3).EQ.'VARI')THEN
26634              P2TEMP=TEMP3(I)
26635            ELSE
26636              P2TEMP=TEMPS(3)
26637            ENDIF
26638            IF(ITYPA(4).EQ.'VARI')THEN
26639              N2TEMP=INT(TEMP4(I)+0.5)
26640            ELSE
26641              N2TEMP=INT(TEMPS(4)+0.5)
26642            ENDIF
26643            IF(ITYPA(5).EQ.'VARI')THEN
26644              P3TEMP=TEMP5(I)
26645            ELSE
26646              P3TEMP=TEMPS(5)
26647            ENDIF
26648            IF(ITYPA(6).EQ.'VARI')THEN
26649              N3TEMP=INT(TEMP6(I)+0.5)
26650            ELSE
26651              N3TEMP=INT(TEMPS(6)+0.5)
26652            ENDIF
26653            IF(ITYPA(7).EQ.'VARI')THEN
26654              P4TEMP=TEMP7(I)
26655            ELSE
26656              P4TEMP=TEMPS(7)
26657            ENDIF
26658            IF(ITYPA(8).EQ.'VARI')THEN
26659              N4TEMP=INT(TEMP8(I)+0.5)
26660            ELSE
26661              N4TEMP=INT(TEMPS(8)+0.5)
26662            ENDIF
26663            CALL DPRUH3(P1TEMP,N1TEMP,P2TEMP,N2TEMP,P3TEMP,N3TEMP,
26664     1                  P4TEMP,N4TEMP,
26665     1                  ALPHAT,ICASAN,IWRITE,
26666     1                  PVAL,ALOWLM,AUPPLM,IBUGA3,ISUBRO,IERROR)
26667            TEMP1(I)=PVAL
26668            TEMP2(I)=ALOWLM
26669            TEMP91(I)=AUPPLM
2667011641     CONTINUE
26671          ITYP91='VARI'
26672          ITYP92='VARI'
26673          ITYP93='VARI'
26674        ENDIF
26675      ELSEIF(ICASL7.EQ.'BPSE')THEN
26676C
26677        ICASAN='BPSE'
26678        ALPHAT=TEMPS(5)
26679C
26680        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA' .AND.
26681     1     ITYPA(3).EQ.'PARA' .AND. ITYPA(4).EQ.'PARA')THEN
26682          P1TEMP=TEMPS(1)
26683          N1TEMP=INT(TEMPS(2)+0.5)
26684          P2TEMP=TEMPS(3)
26685          N2TEMP=INT(TEMPS(4)+0.5)
26686          CALL DPBPSE(P1TEMP,N1TEMP,P2TEMP,N2TEMP,
26687     1                ALPHAT,ICASAN,IWRITE,
26688     1                STATVA,STATSE,ALOWLM,AUPPLM,IBUGA3,ISUBRO,IERROR)
26689          SCAL91=STATSE
26690          ITYP91='SCAL'
26691          SCAL92=ALOWLM
26692          ITYP92='SCAL'
26693          SCAL93=AUPPLM
26694          ITYP93='SCAL'
26695        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI' .OR.
26696     1         ITYPA(3).EQ.'VARI' .OR. ITYPA(4).EQ.'VARI')THEN
26697          DO11651I=1,NINEW
26698            IF(ITYPA(1).EQ.'VARI')THEN
26699              P1TEMP=TEMP1(I)
26700            ELSE
26701              P1TEMP=TEMPS(1)
26702            ENDIF
26703            IF(ITYPA(2).EQ.'VARI')THEN
26704              N1TEMP=INT(TEMP2(I)+0.5)
26705            ELSE
26706              N1TEMP=INT(TEMPS(2)+0.5)
26707            ENDIF
26708            IF(ITYPA(3).EQ.'VARI')THEN
26709              P2TEMP=TEMP3(I)
26710            ELSE
26711              P2TEMP=TEMPS(3)
26712            ENDIF
26713            IF(ITYPA(4).EQ.'VARI')THEN
26714              N2TEMP=INT(TEMP4(I)+0.5)
26715            ELSE
26716              N2TEMP=INT(TEMPS(4)+0.5)
26717            ENDIF
26718            CALL DPBPSE(P1TEMP,N1TEMP,P2TEMP,N2TEMP,
26719     1                  ALPHAT,ICASAN,IWRITE,
26720     1                  STATVA,STATSE,ALOWLM,AUPPLM,
26721     1                  IBUGA3,ISUBRO,IERROR)
26722            TEMP1(I)=STATSE
26723            TEMP2(I)=ALOWLM
26724            TEMP91(I)=AUPPLM
2672511651     CONTINUE
26726          ITYP91='VARI'
26727          ITYP92='VARI'
26728          ITYP93='VARI'
26729        ENDIF
26730      ELSEIF(ICASL7.EQ.'BRAT')THEN
26731C
26732        ALPHAT=TEMPS(5)
26733C
26734        IF(ITYPA(1).EQ.'PARA' .AND. ITYPA(2).EQ.'PARA' .AND.
26735     1     ITYPA(3).EQ.'PARA' .AND. ITYPA(4).EQ.'PARA')THEN
26736          P1TEMP=TEMPS(1)
26737          N1TEMP=INT(TEMPS(2)+0.5)
26738          P2TEMP=TEMPS(3)
26739          N2TEMP=INT(TEMPS(4)+0.5)
26740          CALL DPBRAT(P1TEMP,N1TEMP,P2TEMP,N2TEMP,ALPHAT,IWRITE,
26741     1                ARATIO,ALOWLM,AUPPLM,IBUGA3,ISUBRO,IERROR)
26742          SCAL91=ARATIO
26743          ITYP91='SCAL'
26744          SCAL92=ALOWLM
26745          ITYP92='SCAL'
26746          SCAL93=AUPPLM
26747          ITYP93='SCAL'
26748        ELSEIF(ITYPA(1).EQ.'VARI' .OR. ITYPA(2).EQ.'VARI' .OR.
26749     1         ITYPA(3).EQ.'VARI' .OR. ITYPA(4).EQ.'VARI')THEN
26750          DO11456I=1,NINEW
26751            IF(ITYPA(1).EQ.'VARI')THEN
26752              P1TEMP=TEMP1(I)
26753            ELSE
26754              P1TEMP=TEMPS(1)
26755            ENDIF
26756            IF(ITYPA(2).EQ.'VARI')THEN
26757              N1TEMP=INT(TEMP2(I)+0.5)
26758            ELSE
26759              N1TEMP=INT(TEMPS(2)+0.5)
26760            ENDIF
26761            IF(ITYPA(3).EQ.'VARI')THEN
26762              P2TEMP=TEMP3(I)
26763            ELSE
26764              P2TEMP=TEMPS(3)
26765            ENDIF
26766            IF(ITYPA(4).EQ.'VARI')THEN
26767              N2TEMP=INT(TEMP4(I)+0.5)
26768            ELSE
26769              N2TEMP=INT(TEMPS(4)+0.5)
26770            ENDIF
26771            CALL DPBRAT(P1TEMP,N1TEMP,P2TEMP,N2TEMP,ALPHAT,IWRITE,
26772     1                  ARATIO,ALOWLM,AUPPLM,IBUGA3,ISUBRO,IERROR)
26773            TEMP1(I)=ARATIO
26774            TEMP2(I)=ALOWLM
26775            TEMP91(I)=AUPPLM
2677611456     CONTINUE
26777          ITYP91='VARI'
26778          ITYP92='VARI'
26779          ITYP93='VARI'
26780        ENDIF
26781      ELSEIF(ICASL7.EQ.'SRNP')THEN
26782C
26783        N1TEMP=INT(TEMPS(1)+0.5)
26784        N2TEMP=INT(TEMPS(2)+0.5)
26785        P3TEMP=TEMPS(3)
26786        N4TEMP=INT(TEMPS(4)+0.5)
26787        IDIST=1
26788        IF(ISRPDI.EQ.'OFF')IDIST=0
26789C
26790        CALL RANPE2(N1TEMP,N2TEMP,P3TEMP,N4TEMP,IDIST,MAXOBV,ISEED,
26791     1              TEMP1,TEMP2,TEMP3,NITEMX,
26792     1              ISUBRO,IBUGA3,IERROR)
26793        ITYP91='VARI'
26794        ITYP92='VARI'
26795      ELSEIF(ICASL7.EQ.'SUMD')THEN
26796CCCCC   JAN 1987--NOT DONE
26797CCCCC   CALL SUMD(TEMP1,NS1,TEMP2,NS2,NUMVAR,IWRITE,
26798CCCCC1            TEMP91,NITEMX,IBUGA3,IERROR)
26799CCCCC   DO11455I=1,NITEMX
26800CCCCC     TEMP1(I)=TEMP91(I)
26801CCCCC 11455   CONTINUE
26802      ELSEIF(ICASL7.EQ.'BFPD')THEN
26803        DO71401I=1,NS1
26804          DTEMP1(I)=DBLE(TEMP1(I))
2680571401   CONTINUE
26806        DO71403I=1,NS2
26807          DTEMP2(I)=DBLE(TEMP2(I))
26808          DTEMP2(NS2+I)=DBLE(TEMP3(I))
2680971403   CONTINUE
26810        CALL BFWPD2(DTEMP1,NS1,DTEMP2,DTEMP2(NS2+1),NS2,
26811     1              DBLE(TEMPS(4)),DBLE(TEMPS(5)),DBLE(TEMPS(6)),
26812     1              DTEMP3,
26813     1              ISUBRO,IBUGA3,IERROR)
26814        IF(IERROR.EQ.'YES')GOTO9000
26815        NITEMX=NS1
26816        DO71409I=1,NITEMX
26817          TEMP1(I)=REAL(DTEMP3(I))
2681871409   CONTINUE
26819      ELSEIF(ICASL7.EQ.'BFCD')THEN
26820        DO71411I=1,NS1
26821          DTEMP1(I)=DBLE(TEMP1(I))
2682271411   CONTINUE
26823        DO71413I=1,NS2
26824          DTEMP2(I)=DBLE(TEMP2(I))
26825          DTEMP2(NS2+I)=DBLE(TEMP3(I))
2682671413   CONTINUE
26827        CALL BFWCD2(DTEMP1,NS1,DTEMP2,DTEMP2(NS2+1),NS2,
26828     1              DBLE(TEMPS(4)),DBLE(TEMPS(5)),DBLE(TEMPS(6)),
26829     1              DTEMP3,
26830     1              ISUBRO,IBUGA3,IERROR)
26831        IF(IERROR.EQ.'YES')GOTO9000
26832        NITEMX=NS1
26833        DO71419I=1,NITEMX
26834          TEMP1(I)=REAL(DTEMP3(I))
2683571419   CONTINUE
26836      ELSEIF(ICASL7.EQ.'BFPP')THEN
26837        DO71421I=1,NS1
26838          DTEMP1(I)=DBLE(TEMP1(I))
2683971421   CONTINUE
26840        DO71423I=1,NS2
26841          DTEMP2(I)=DBLE(TEMP2(I))
26842          DTEMP2(NS2+I)=DBLE(TEMP3(I))
2684371423   CONTINUE
26844        CALL BFWPP2(DTEMP1,NS1,DTEMP2,DTEMP2(NS2+1),NS2,
26845     1              DBLE(TEMPS(4)),DBLE(TEMPS(5)),DBLE(TEMPS(6)),
26846     1              DTEMP3,
26847     1              ISUBRO,IBUGA3,IERROR)
26848        IF(IERROR.EQ.'YES')GOTO9000
26849        NITEMX=NS1
26850        DO71429I=1,NITEMX
26851          TEMP1(I)=REAL(DTEMP3(I))
2685271429   CONTINUE
26853      ELSEIF(ICASL7.EQ.'EEPD')THEN
26854        DO72401I=1,NS1
26855          DTEMP1(I)=DBLE(TEMP1(I))
2685672401   CONTINUE
26857        DO72403I=1,NS2
26858          DTEMP2(I)=DBLE(TEMP2(I))
26859          DTEMP2(NS2+I)=DBLE(TEMP3(I))
2686072403   CONTINUE
26861        IF(NUMVAR.EQ.8)THEN
26862          ALOC=TEMPS(8)
26863        ELSE
26864          ALOC=0.0
26865        ENDIF
26866        CALL EEWPD2(DTEMP1,NS1,DTEMP2,DTEMP2(NS2+1),NS2,
26867     1              DBLE(TEMPS(4)),DBLE(TEMPS(5)),DBLE(TEMPS(6)),
26868     1              DBLE(TEMPS(7)),DBLE(ALOC),
26869     1              DTEMP3,
26870     1              ISUBRO,IBUGA3,IERROR)
26871        IF(IERROR.EQ.'YES')GOTO9000
26872        NITEMX=NS1
26873        DO72409I=1,NITEMX
26874          TEMP1(I)=REAL(DTEMP3(I))
2687572409   CONTINUE
26876      ELSEIF(ICASL7.EQ.'EECD')THEN
26877        DO72411I=1,NS1
26878          DTEMP1(I)=DBLE(TEMP1(I))
2687972411   CONTINUE
26880        DO72413I=1,NS2
26881          DTEMP2(I)=DBLE(TEMP2(I))
26882          DTEMP2(NS2+I)=DBLE(TEMP3(I))
2688372413   CONTINUE
26884        IF(NUMVAR.EQ.8)THEN
26885          ALOC=TEMPS(8)
26886        ELSE
26887          ALOC=0.0
26888        ENDIF
26889        CALL EEWCD2(DTEMP1,NS1,DTEMP2,DTEMP2(NS2+1),NS2,
26890     1              DBLE(TEMPS(4)),DBLE(TEMPS(5)),DBLE(TEMPS(6)),
26891     1              DBLE(TEMPS(7)),DBLE(ALOC),
26892     1              DTEMP3,
26893     1              ISUBRO,IBUGA3,IERROR)
26894        IF(IERROR.EQ.'YES')GOTO9000
26895        NITEMX=NS1
26896        DO72419I=1,NITEMX
26897          TEMP1(I)=REAL(DTEMP3(I))
2689872419   CONTINUE
26899      ELSEIF(ICASL7.EQ.'EEPP')THEN
26900        DO72421I=1,NS1
26901          DTEMP1(I)=DBLE(TEMP1(I))
2690272421   CONTINUE
26903        DO72423I=1,NS2
26904          DTEMP2(I)=DBLE(TEMP2(I))
26905          DTEMP2(NS2+I)=DBLE(TEMP3(I))
2690672423   CONTINUE
26907        IF(NUMVAR.EQ.8)THEN
26908          ALOC=TEMPS(8)
26909        ELSE
26910          ALOC=0.0
26911        ENDIF
26912        CALL EEWPP2(DTEMP1,NS1,DTEMP2,DTEMP2(NS2+1),NS2,
26913     1              DBLE(TEMPS(4)),DBLE(TEMPS(5)),DBLE(TEMPS(6)),
26914     1              DBLE(TEMPS(7)),DBLE(ALOC),
26915     1              DTEMP3,
26916     1              ISUBRO,IBUGA3,IERROR)
26917        IF(IERROR.EQ.'YES')GOTO9000
26918        NITEMX=NS1
26919        DO72429I=1,NITEMX
26920          TEMP1(I)=REAL(DTEMP3(I))
2692172429   CONTINUE
26922      ELSEIF(ICASL7.EQ.'INTR')THEN
26923        NS3=0
26924        DO11461I=1,NIRIGH(3)
26925          NS3=NS3+1
26926          IJ=MAXN*(ICOLR(3)-1)+I
26927          IF(ICOLR(3).LE.MAXCOL)TEMP3(NS3)=V(IJ)
26928          IF(ICOLR(3).EQ.MAXCP1)TEMP3(NS3)=PRED(I)
26929          IF(ICOLR(3).EQ.MAXCP2)TEMP3(NS3)=RES(I)
26930          IF(ICOLR(3).EQ.MAXCP3)TEMP3(NS3)=YPLOT(I)
26931          IF(ICOLR(3).EQ.MAXCP4)TEMP3(NS3)=XPLOT(I)
26932          IF(ICOLR(3).EQ.MAXCP5)TEMP3(NS3)=X2PLOT(I)
26933          IF(ICOLR(3).EQ.MAXCP6)TEMP3(NS3)=TAGPLO(I)
2693411461   CONTINUE
26935        CALL INTERP(TEMP1,TEMP2,NS1,TEMP3,NS3,IWRITE,TEMP91,
26936     1              TEMP4,TEMP5,TEMP12,TEMP92,TEMP7,TEMP8,TEMP9,
26937     1              TEMP21,TEMP22,TEMP23,TEMP6,TEMP24,MAXNXT,
26938     1              IBUGA3,ISUBRO,IERROR)
26939        NITEMX=NS3
26940        DO11465I=1,NITEMX
26941          TEMP1(I)=TEMP91(I)
2694211465   CONTINUE
26943      ELSEIF(ICASL7.EQ.'LINT')THEN
26944        NS3=0
26945        DO11561I=1,NIRIGH(3)
26946          NS3=NS3+1
26947          IJ=MAXN*(ICOLR(3)-1)+I
26948          IF(ICOLR(3).LE.MAXCOL)TEMP3(NS3)=V(IJ)
26949          IF(ICOLR(3).EQ.MAXCP1)TEMP3(NS3)=PRED(I)
26950          IF(ICOLR(3).EQ.MAXCP2)TEMP3(NS3)=RES(I)
26951          IF(ICOLR(3).EQ.MAXCP3)TEMP3(NS3)=YPLOT(I)
26952          IF(ICOLR(3).EQ.MAXCP4)TEMP3(NS3)=XPLOT(I)
26953          IF(ICOLR(3).EQ.MAXCP5)TEMP3(NS3)=X2PLOT(I)
26954          IF(ICOLR(3).EQ.MAXCP6)TEMP3(NS3)=TAGPLO(I)
2695511561   CONTINUE
26956        CALL LININT(TEMP1,TEMP2,NS1,TEMP3,NS3,IWRITE,TEMP91,
26957     1              TEMP21,TEMP22,TEMP23,
26958     1              IBUGA3,ISUBRO,IERROR)
26959        NITEMX=NS3
26960        DO11565I=1,NITEMX
26961          TEMP1(I)=TEMP91(I)
2696211565   CONTINUE
26963      ELSEIF(ICASL7.EQ.'2DIN')THEN
26964        NS4=0
26965        DO11571I=1,NIRIGH(4)
26966          NS4=NS4+1
26967          IJ=MAXN*(ICOLR(4)-1)+I
26968          IF(ICOLR(4).LE.MAXCOL)TEMP4(NS4)=V(IJ)
26969          IF(ICOLR(4).EQ.MAXCP1)TEMP4(NS4)=PRED(I)
26970          IF(ICOLR(4).EQ.MAXCP2)TEMP4(NS4)=RES(I)
26971          IF(ICOLR(4).EQ.MAXCP3)TEMP4(NS4)=YPLOT(I)
26972          IF(ICOLR(4).EQ.MAXCP4)TEMP4(NS4)=XPLOT(I)
26973          IF(ICOLR(4).EQ.MAXCP5)TEMP4(NS4)=X2PLOT(I)
26974          IF(ICOLR(4).EQ.MAXCP6)TEMP4(NS4)=TAGPLO(I)
2697511571   CONTINUE
26976        NS5=0
26977        DO11572I=1,NIRIGH(5)
26978          NS5=NS5+1
26979          IJ=MAXN*(ICOLR(5)-1)+I
26980          IF(ICOLR(5).LE.MAXCOL)TEMP5(NS5)=V(IJ)
26981          IF(ICOLR(5).EQ.MAXCP1)TEMP5(NS5)=PRED(I)
26982          IF(ICOLR(5).EQ.MAXCP2)TEMP5(NS5)=RES(I)
26983          IF(ICOLR(5).EQ.MAXCP3)TEMP5(NS5)=YPLOT(I)
26984          IF(ICOLR(5).EQ.MAXCP4)TEMP5(NS5)=XPLOT(I)
26985          IF(ICOLR(5).EQ.MAXCP5)TEMP5(NS5)=X2PLOT(I)
26986          IF(ICOLR(5).EQ.MAXCP6)TEMP5(NS5)=TAGPLO(I)
2698711572   CONTINUE
26988        NS6=0
26989        CALL INT2D(TEMP1,TEMP2,TEMP3,NS1,TEMP4,NS4,TEMP5,NS5,IWRITE,
26990     1             TEMP91,NS6,
26991     1             TEMP12,TEMP12(MAXOBV+1),TEMP92,TEMPC1,
26992     1             TEMPC1(MAXOBV+1),TEMP7,TEMP8,TEMP9,TEMP21,
26993     1             TEMP22,ITEMP1,
26994     1             IBUGA3,ISUBRO,IERROR)
26995        NITEMX=NS6
26996        DO11575I=1,NITEMX
26997          TEMP1(I)=TEMP91(I)
2699811575   CONTINUE
26999      ELSEIF(ICASL7.EQ.'BILI')THEN
27000        NS4=0
27001        DO11581I=1,NIRIGH(4)
27002          NS4=NS4+1
27003          IJ=MAXN*(ICOLR(4)-1)+I
27004          IF(ICOLR(4).LE.MAXCOL)TEMP4(NS4)=V(IJ)
27005          IF(ICOLR(4).EQ.MAXCP1)TEMP4(NS4)=PRED(I)
27006          IF(ICOLR(4).EQ.MAXCP2)TEMP4(NS4)=RES(I)
27007          IF(ICOLR(4).EQ.MAXCP3)TEMP4(NS4)=YPLOT(I)
27008          IF(ICOLR(4).EQ.MAXCP4)TEMP4(NS4)=XPLOT(I)
27009          IF(ICOLR(4).EQ.MAXCP5)TEMP4(NS4)=X2PLOT(I)
27010          IF(ICOLR(4).EQ.MAXCP6)TEMP4(NS4)=TAGPLO(I)
2701111581   CONTINUE
27012        NS5=0
27013        DO11582I=1,NIRIGH(5)
27014          NS5=NS5+1
27015          IJ=MAXN*(ICOLR(5)-1)+I
27016          IF(ICOLR(5).LE.MAXCOL)TEMP5(NS5)=V(IJ)
27017          IF(ICOLR(5).EQ.MAXCP1)TEMP5(NS5)=PRED(I)
27018          IF(ICOLR(5).EQ.MAXCP2)TEMP5(NS5)=RES(I)
27019          IF(ICOLR(5).EQ.MAXCP3)TEMP5(NS5)=YPLOT(I)
27020          IF(ICOLR(5).EQ.MAXCP4)TEMP5(NS5)=XPLOT(I)
27021          IF(ICOLR(5).EQ.MAXCP5)TEMP5(NS5)=X2PLOT(I)
27022          IF(ICOLR(5).EQ.MAXCP6)TEMP5(NS5)=TAGPLO(I)
2702311582   CONTINUE
27024        CALL BILINR(TEMP1,TEMP2,TEMP3,NS1,TEMP4,TEMP5,NS4,
27025     1              IWRITE,TEMP91,
27026     1              TEMP21,TEMP22,TEMP23,TEMP24,TEMP25,
27027     1              TEMP26,TEMP7,
27028     1              IBUGA3,ISUBRO,IERROR)
27029        NITEMX=NS4
27030        DO11585I=1,NITEMX
27031          TEMP1(I)=TEMP91(I)
2703211585   CONTINUE
27033      ELSEIF(ICASL7.EQ.'BIVA')THEN
27034        NS4=0
27035        DO11591I=1,NIRIGH(4)
27036          NS4=NS4+1
27037          IJ=MAXN*(ICOLR(4)-1)+I
27038          IF(ICOLR(4).LE.MAXCOL)TEMP4(NS4)=V(IJ)
27039          IF(ICOLR(4).EQ.MAXCP1)TEMP4(NS4)=PRED(I)
27040          IF(ICOLR(4).EQ.MAXCP2)TEMP4(NS4)=RES(I)
27041          IF(ICOLR(4).EQ.MAXCP3)TEMP4(NS4)=YPLOT(I)
27042          IF(ICOLR(4).EQ.MAXCP4)TEMP4(NS4)=XPLOT(I)
27043          IF(ICOLR(4).EQ.MAXCP5)TEMP4(NS4)=X2PLOT(I)
27044          IF(ICOLR(4).EQ.MAXCP6)TEMP4(NS4)=TAGPLO(I)
2704511591   CONTINUE
27046        NS5=0
27047        DO11592I=1,NIRIGH(5)
27048          NS5=NS5+1
27049          IJ=MAXN*(ICOLR(5)-1)+I
27050          IF(ICOLR(5).LE.MAXCOL)TEMP5(NS5)=V(IJ)
27051          IF(ICOLR(5).EQ.MAXCP1)TEMP5(NS5)=PRED(I)
27052          IF(ICOLR(5).EQ.MAXCP2)TEMP5(NS5)=RES(I)
27053          IF(ICOLR(5).EQ.MAXCP3)TEMP5(NS5)=YPLOT(I)
27054          IF(ICOLR(5).EQ.MAXCP4)TEMP5(NS5)=XPLOT(I)
27055          IF(ICOLR(5).EQ.MAXCP5)TEMP5(NS5)=X2PLOT(I)
27056          IF(ICOLR(5).EQ.MAXCP6)TEMP5(NS5)=TAGPLO(I)
2705711592   CONTINUE
27058        ISPACE=5*MAXOBV
27059        CALL BIVAR(TEMP1,TEMP3,TEMP2,NS1,TEMP4,TEMP5,NS4,
27060     1             IWRITE,TEMP91,
27061     1             TEMP21,TEMP22,TEMP23,TEMP24,TEMP25,TEMP26,
27062     1             TEMP7,TEMP8,TEMP9,TEMP6,ISPACE,
27063     1             IBUGA3,ISUBRO,IERROR)
27064        NITEMX=NS4
27065        DO11595I=1,NITEMX
27066          TEMP1(I)=TEMP91(I)
2706711595   CONTINUE
27068      ELSEIF(ICASL7.EQ.'HERI' .OR. ICASL7.EQ.'HERG' .OR.
27069     1       ICASL7.EQ.'HERD')THEN
27070        NS3=0
27071        IF(ICASL7.EQ.'HERI' .OR. ICASL7.EQ.'HERD')THEN
27072          DO11596I=1,NIRIGH(3)
27073            NS3=NS3+1
27074            IJ=MAXN*(ICOLR(3)-1)+I
27075            IF(ICOLR(3).LE.MAXCOL)TEMP3(NS3)=V(IJ)
27076            IF(ICOLR(3).EQ.MAXCP1)TEMP3(NS3)=PRED(I)
27077            IF(ICOLR(3).EQ.MAXCP2)TEMP3(NS3)=RES(I)
27078            IF(ICOLR(3).EQ.MAXCP3)TEMP3(NS3)=YPLOT(I)
27079            IF(ICOLR(3).EQ.MAXCP4)TEMP3(NS3)=XPLOT(I)
27080            IF(ICOLR(3).EQ.MAXCP5)TEMP3(NS3)=X2PLOT(I)
27081            IF(ICOLR(3).EQ.MAXCP6)TEMP3(NS3)=TAGPLO(I)
2708211596     CONTINUE
27083        ENDIF
27084C
27085        ISPLINE=.FALSE.
27086        CALL PCHEZ(NS1,TEMP2,TEMP1,TEMP4,ISPLINE,TEMP5,MAXOBV,IERR)
27087        IF(IERR.LT.0)GOTO9000
27088C
27089        IF(ICASL7.EQ.'HERI')THEN
27090          CALL PCHEV(NS1,TEMP2,TEMP1,TEMP4,NS3,TEMP3,TEMP91,TEMP6,IERR)
27091          IFOUND='YES'
27092          IF(IERR.LT.0)GOTO9000
27093C
27094          NITEMX=NS3
27095          DO11597I=1,NITEMX
27096            TEMP1(I)=TEMP91(I)
2709711597     CONTINUE
27098        ELSEIF(ICASL7.EQ.'HERD')THEN
27099          CALL PCHEV(NS1,TEMP2,TEMP1,TEMP4,NS3,TEMP3,TEMP91,TEMP6,IERR)
27100          IFOUND='YES'
27101          IF(IERR.LT.0)GOTO9000
27102C
27103          NITEMX=NS3
27104          DO11598I=1,NITEMX
27105            TEMP1(I)=TEMP6(I)
2710611598     CONTINUE
27107        ELSEIF(ICASL7.EQ.'HERG')THEN
27108          ALOW=TEMPS(3)
27109          AUPP=TEMPS(4)
27110          SCAL91=PCHQA(NS1,TEMP2,TEMP1,TEMP4,ALOW,AUPP,IERR)
27111          IFOUND='YES'
27112          IF(IERR.LT.0)GOTO9000
27113          ITYP91='SCAL'
27114        ENDIF
27115      ELSEIF(ICASL7.EQ.'GRPS')THEN
27116        NS3=0
27117        DO11601I=1,NIRIGH(3)
27118          NS3=NS3+1
27119          IJ=MAXN*(ICOLR(3)-1)+I
27120          IF(ICOLR(3).LE.MAXCOL)TEMP3(NS3)=V(IJ)
27121          IF(ICOLR(3).EQ.MAXCP1)TEMP3(NS3)=PRED(I)
27122          IF(ICOLR(3).EQ.MAXCP2)TEMP3(NS3)=RES(I)
27123          IF(ICOLR(3).EQ.MAXCP3)TEMP3(NS3)=YPLOT(I)
27124          IF(ICOLR(3).EQ.MAXCP4)TEMP3(NS3)=XPLOT(I)
27125          IF(ICOLR(3).EQ.MAXCP5)TEMP3(NS3)=X2PLOT(I)
27126          IF(ICOLR(3).EQ.MAXCP6)TEMP3(NS3)=TAGPLO(I)
2712711601   CONTINUE
27128        CALL GRPSHU(TEMP1,TEMP2,NS1,TEMP3,NS3,
27129     1              IWRITE,TEMP91,TEMP4,
27130     1              ITEMP1,TEMP5,TEMP6,
27131     1              IBUGA3,ISUBRO,IERROR)
27132        NITEMX=NS1
27133        DO11605I=1,NITEMX
27134          TEMP1(I)=TEMP91(I)
2713511605   CONTINUE
27136      ELSEIF(ICASL7.EQ.'UNST')THEN
27137        IH=ILEFT(1)
27138        IH2=ILEF2(1)
27139        CALL DPUNST(TEMP1,TEMP2,NS1,IH,IH2,TEMP91,NITEMX,
27140     1              TEMP3,ITEMP1,
27141     1              ISUBRO,IBUGA3,IERROR)
27142        IF(IERROR.EQ.'YES')GOTO19000
27143        DO11477I=1,NITEMX
27144          TEMP1(I)=TEMP91(I)
2714511477   CONTINUE
27146        NS1=NITEMX
27147        IF(NEWNAM(1).EQ.'YES')THEN
27148          ICOLL(1)=ICOLL(1)+NITEMX
27149          ILISL(1)=ILISL(1)+NITEMX
27150        ENDIF
27151      ELSEIF(ICASL7.EQ.'BIWE')THEN
27152        CALL BIWEIG(TEMP1,NS1,IWRITE,TEMP91,IBUGA3,IERROR)
27153        DO11475I=1,NITEMX
27154          TEMP1(I)=TEMP91(I)
2715511475   CONTINUE
27156      ELSEIF(ICASL7.EQ.'TRIC')THEN
27157        CALL TRICUB(TEMP1,NS1,IWRITE,TEMP91,IBUGA3,IERROR)
27158        DO11485I=1,NITEMX
27159          TEMP1(I)=TEMP91(I)
2716011485   CONTINUE
27161      ELSEIF(ICASL7.EQ.'KEEP' .OR. ICASL7.EQ.'OMIT')THEN
27162        IOP='KEEP'
27163        IF(ICASL7.EQ.'OMIT')IOP='OMIT'
27164        CALL DPKEEP(TEMP1,NS1,TEMP2,NS2,IOP,TEMP91,IBUGA3,ISUBRO,IERROR)
27165        DO11493I=1,NS1
27166          TEMP1(I)=TEMP91(I)
2716711493   CONTINUE
27168      ELSEIF(ICASL7.EQ.'COCD')THEN
27169        CALL COCODE(TEMP1,NS1,TEMP2,NS2,TEMP91,IBUGA3)
27170        DO11495I=1,NS1
27171          TEMP1(I)=TEMP91(I)
2717211495   CONTINUE
27173      ELSEIF(ICASL7.EQ.'EXPA')THEN
27174        IWRITE='OFF'
27175        CALL EXPAND(TEMP1,NS1,TEMP2,NS2,IWRITE,TEMP3,TEMP4,TEMP5,
27176     1              MAXOBV,ISUBRO,IBUGA3,IERROR)
27177        DO11503I=1,NS1
27178          TEMP1(I)=TEMP3(I)
2717911503   CONTINUE
27180      ELSEIF(ICASL7.EQ.'JSCO')THEN
27181        IWRITE='OFF'
27182        CALL JSCORE(TEMP1,TEMP2,NS1,IWRITE,TEMP3,TEMP5,TEMP4,NITEMX,
27183     1              IBUGA3,ISUBRO,IERROR)
27184        DO21503I=1,NITEMX
27185          TEMP1(I)=TEMP4(I)
2718621503   CONTINUE
27187        IUPFLG='FULL'
27188      ELSEIF(ICASL7.EQ.'JSCT')THEN
27189        IWRITE='OFF'
27190        CALL JSCTAB(TEMP1,TEMP2,TEMP3,NS1,IWRITE,
27191     1              TEMP4,TEMP5,TEMP6,
27192     1              TEMP7,TEMP8,TEMP91,NITEMX,
27193     1              IBUGA3,ISUBRO,IERROR)
27194        DO21513I=1,NITEMX
27195          TEMP1(I)=TEMP7(I)
27196          TEMP2(I)=TEMP8(I)
2719721513   CONTINUE
27198        IUPFLG='FULL'
27199      ELSEIF(ICASL7.EQ.'COCP')THEN
27200        CALL COCOPY(TEMP3,NS3,TEMP1,NS1,TEMP2,TEMP91,NITEMX,IBUGA3)
27201        DO11505I=1,NITEMX
27202          TEMP1(I)=TEMP91(I)
2720311505   CONTINUE
27204      ELSEIF(ICASL7.EQ.'POPL')THEN
27205        CALL DPPOPL(TEMP1,TEMP2,NS1,
27206     1              TEMP3,TEMP4,TEMP5,TEMP92,NS3,
27207     1              TEMP91,
27208     1              ISUBRO,IBUGA3,IERROR)
27209        NITEMX=NS1
27210        DO11506I=1,NITEMX
27211          TEMP1(I)=TEMP91(I)
2721211506   CONTINUE
27213      ELSEIF(ICASL7.EQ.'GATH')THEN
27214        IERROR='NO'
27215        DO11507I=1,NS2
27216          ITEMP1(I)=INT(TEMP2(I)+0.5)
2721711507   CONTINUE
27218        CALL GATHER(NS2,TEMP91,TEMP1,ITEMP1,MAXOBV,
27219     1              ISUBRO,IBUGA3,IERROR)
27220        IF(IERROR.EQ.'YES')GOTO9000
27221        DO11508I=1,NS2
27222          TEMP1(I)=TEMP91(I)
2722311508   CONTINUE
27224        NS1=NS2
27225        NITEMX=NS1
27226      ELSEIF(ICASL7.EQ.'SCAT')THEN
27227        ISTRT=1
27228        IF(NS99.GE.1)ISTRT=NS99+1
27229        DO11496I=ISTRT,MAXOBV
27230          TEMP91(I)=CPUMIN
2723111496   CONTINUE
27232        DO11497I=1,NS2
27233          ITEMP1(I)=INT(TEMP2(I)+0.5)
2723411497   CONTINUE
27235        CALL SCATTR(NS2,TEMP91,ITEMP1,TEMP1,NOUT,MAXOBV,
27236     1                ISUBRO,IBUGA3,IERROR)
27237        IF(IERROR.EQ.'YES')GOTO9000
27238        NS1=MAX(NS99,NOUT)
27239        DO11498I=1,NS1
27240          TEMP1(I)=TEMP91(I)
2724111498   CONTINUE
27242        NITEMX=NS1
27243      ELSEIF(ICASL7.EQ.'SHIF')THEN
27244        IERROR='NO'
27245        ATEMP=TEMPS(2)
27246        IF(ATEMP.GE.0.0)THEN
27247          NSHIFT=INT(TEMPS(2)+0.1)
27248        ELSE
27249          NSHIFT=INT(TEMPS(2)-0.1)
27250        ENDIF
27251        CALL SHIFTZ(TEMP1,NS1,NSHIFT,MAXOBV,TEMP91,NITEMX,
27252     1              ISUBRO,IBUGA3,IERROR)
27253        IF(IERROR.EQ.'YES')GOTO9000
27254        DO11499I=1,NITEMX
27255          TEMP1(I)=TEMP91(I)
2725611499   CONTINUE
27257      ELSEIF(ICASL7.EQ.'CSHI')THEN
27258        IERROR='NO'
27259        ATEMP=TEMPS(2)
27260        IF(ATEMP.GE.0.0)THEN
27261          NSHIFT=INT(TEMPS(2)+0.1)
27262        ELSE
27263          NSHIFT=INT(TEMPS(2)-0.1)
27264        ENDIF
27265        CALL SHIFTC(TEMP1,NS1,NSHIFT,MAXOBV,TEMP91,NITEMX,
27266     1              ISUBRO,IBUGA3,IERROR)
27267        IF(IERROR.EQ.'YES')GOTO9000
27268        DO11501I=1,NITEMX
27269          TEMP1(I)=TEMP91(I)
2727011501   CONTINUE
27271      ELSEIF(ICASL7.EQ.'VPER')THEN
27272        IERROR='NO'
27273        ATEMP=TEMPS(2)
27274        NPERC=INT(TEMPS(2)+0.1)
27275        IF(NPERC.LT.1)THEN
27276          IF(NS1.LE.100)THEN
27277            NPERC=10
27278          ELSEIF(NS1.LE.1000)THEN
27279            NPERC=100
27280          ELSE
27281            NPERC=1000
27282          ENDIF
27283        ELSEIF(NPERC.GT.MAXOBV)THEN
27284          NPERC=MAXOBV
27285        ENDIF
27286        CALL PERCE2(NPERC,TEMP1,NS1,IWRITE,TEMP2,MAXOBV,TEMP91,
27287     1              IBUGA3,ISUBRO,IERROR)
27288        IF(IERROR.EQ.'YES')GOTO9000
27289        DO11502I=1,NPERC
27290          TEMP1(I)=TEMP91(I)
2729111502   CONTINUE
27292        NITEMX=NPERC
27293      ELSEIF(ICASL7.EQ.'LARG')THEN
27294        IERROR='NO'
27295        ATEMP=TEMPS(2)
27296        IF(ATEMP.GE.0.0)THEN
27297          NVAL=INT(TEMPS(2)+0.1)
27298        ELSE
27299          NVAL=INT(TEMPS(2)-0.1)
27300        ENDIF
27301        IF(NVAL.LT.1)NVAL=1
27302        IF(NVAL.GT.NS1)NVAL=NS1
27303        CALL DPLARG(TEMP1,NS1,NVAL,TEMP91,NITEMX,ISUBRO,IBUGA3,IERROR)
27304        IF(IERROR.EQ.'YES')GOTO9000
27305        DO21504I=1,NITEMX
27306          TEMP1(I)=TEMP91(I)
2730721504   CONTINUE
27308      ELSEIF(ICASL7.EQ.'SMAL')THEN
27309        IERROR='NO'
27310        ATEMP=TEMPS(2)
27311        IF(ATEMP.GE.0.0)THEN
27312          NVAL=INT(TEMPS(2)+0.1)
27313        ELSE
27314          NVAL=INT(TEMPS(2)-0.1)
27315        ENDIF
27316        IF(NVAL.LT.1)NVAL=1
27317        IF(NVAL.GT.NS1)NVAL=NS1
27318        CALL DPSMAL(TEMP1,NS1,NVAL,TEMP91,NITEMX,ISUBRO,IBUGA3,IERROR)
27319        IF(IERROR.EQ.'YES')GOTO9000
27320        DO21505I=1,NITEMX
27321          TEMP1(I)=TEMP91(I)
2732221505   CONTINUE
27323      ELSEIF(ICASL7.EQ.'TMIN' .OR. ICASL7.EQ.'TMAX')THEN
27324        IOP='MINI'
27325        IF(ICASL7.EQ.'TMAX')IOP='MAXI'
27326        CALL THRESH(TEMP1,TEMP2,NS1,NS2,IWRITE,TEMP91,TEMP92,NITEMX,
27327     1              IOP,MAXOBV,
27328     1              ISUBRO,IBUGA3,IERROR)
27329        DO11517I=1,NITEMX
27330          TEMP1(I)=TEMP91(I)
27331          TEMP2(I)=TEMP92(I)
2733211517   CONTINUE
27333        NS1=NITEMX
27334      ELSEIF(ICASL7.EQ.'CODH')THEN
27335        NUMINT=4
27336        CALL CODEH(TEMP1,NS1,NUMINT,IWRITE,TEMP2,TEMP5,MAXOBV,
27337     1             IBUGA3,IERROR)
27338        DO11645I=1,NS1
27339          TEMP1(I)=TEMP2(I)
2734011645   CONTINUE
27341      ELSEIF(ICASL7.EQ.'COD1'.OR.ICASL7.EQ.'COD2'.OR.
27342     1       ICASL7.EQ.'COD3'.OR.ICASL7.EQ.'COD4'.OR.
27343     1       ICASL7.EQ.'COD5'.OR.ICASL7.EQ.'COD6'.OR.
27344     1       ICASL7.EQ.'COD7'.OR.ICASL7.EQ.'COD8'.OR.
27345     1       ICASL7.EQ.'COD9'.OR.ICASL7.EQ.'CO10')THEN
27346        NUMINT=4
27347        IF(ICASL7.EQ.'COD1')NUMINT=1
27348        IF(ICASL7.EQ.'COD2')NUMINT=2
27349        IF(ICASL7.EQ.'COD3')NUMINT=3
27350        IF(ICASL7.EQ.'COD4')NUMINT=4
27351        IF(ICASL7.EQ.'COD5')NUMINT=5
27352        IF(ICASL7.EQ.'COD6')NUMINT=6
27353        IF(ICASL7.EQ.'COD7')NUMINT=7
27354        IF(ICASL7.EQ.'COD8')NUMINT=8
27355        IF(ICASL7.EQ.'COD9')NUMINT=9
27356        IF(ICASL7.EQ.'CO10')NUMINT=10
27357        CALL CODEN(TEMP1,NS1,NUMINT,IWRITE,TEMP2,TEMP5,MAXOBV,
27358     1             IBUGA3,IERROR)
27359        DO11655I=1,NS1
27360          TEMP1(I)=TEMP2(I)
2736111655   CONTINUE
27362      ELSEIF(ICASL7.EQ.'SINT')THEN
27363        CALL SINTRA(TEMP1,NS1,IWRITE,TEMP2,NITEMX,IBUGA3,IERROR)
27364        IF(IERROR.EQ.'YES')GOTO19000
27365        DO11715I=1,NITEMX
27366          TEMP1(I)=TEMP2(I)
2736711715   CONTINUE
27368      ELSEIF(ICASL7.EQ.'COST')THEN
27369        CALL COSTRA(TEMP1,NS1,IWRITE,TEMP2,NITEMX,IBUGA3,IERROR)
27370        IF(IERROR.EQ.'YES')GOTO19000
27371        DO11725I=1,NITEMX
27372          TEMP1(I)=TEMP2(I)
2737311725   CONTINUE
27374      ELSEIF(ICASL7.EQ.'FOUT'.OR.ICASL7.EQ.'FOU1'.OR.
27375     1       ICASL7.EQ.'IFOU'.OR.ICASL7.EQ.'IFO1')THEN
27376        IF(ICASL7.EQ.'FOU1'.OR.ICASL7.EQ.'IFO1')THEN
27377          DO11732I=1,NS1
27378            TEMP2(I)=0.0
2737911732     CONTINUE
27380        ENDIF
27381        ITCASE=ICASL7
27382        CALL FOUTRA(TEMP1,TEMP2,TEMPC1,TEMP6,
27383     1              NS1,ITCASE,IWRITE,TEMP12,IFTEXP,IFTORD,
27384     1              TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
27385        IF(IERROR.EQ.'YES')GOTO19000
27386        DO11735I=1,NITEMX
27387          TEMP1(I)=TEMP91(I)
27388          TEMP2(I)=TEMP92(I)
2738911735   CONTINUE
27390      ELSEIF(ICASL7.EQ.'FFT'.OR.ICASL7.EQ.'FFT1'.OR.
27391     1       ICASL7.EQ.'IFFT'.OR.ICASL7.EQ.'IFF1')THEN
27392        IF(ICASL7.EQ.'FFT1'.OR.ICASL7.EQ.'IFF1')THEN
27393          DO11742I=1,NS1
27394            TEMP2(I)=0.0
2739511742     CONTINUE
27396        ENDIF
27397        NS1NEW=NS1
27398        ITCASE=ICASL7
27399        CALL FOUTRA(TEMP1,TEMP2,TEMPC1,TEMP6,
27400     1              NS1NEW,ITCASE,IWRITE,TEMP12,IFTEXP,IFTORD,
27401     1              TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
27402         IF(IERROR.EQ.'YES')GOTO19000
27403         DO11756I=1,NITEMX
27404           TEMP1(I)=TEMP91(I)
27405           TEMP2(I)=TEMP92(I)
2740611756   CONTINUE
27407      ELSEIF(ICASL7.EQ.'NKDM')THEN
27408        CALL DPMMPD(TEMP1,TEMP2,NS1,
27409     1              TEMP91,TEMP92,NITEMX,
27410     1              IBUGA3,ISUBRO,IERROR)
27411        IF(IERROR.EQ.'YES')GOTO19000
27412        DO11758I=1,NITEMX
27413          TEMP1(I)=TEMP91(I)
27414          TEMP2(I)=TEMP92(I)
2741511758   CONTINUE
27416      ELSEIF(ICASL7.EQ.'2DCH')THEN
27417        NS1NEW=NS1
27418        CALL DP2DCH(TEMP1,TEMP2,TEMP6,NS1,IWRITE,MAXOBV,
27419     1              TEMP91,TEMP92,NITEMX,
27420     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,
27421     1              IBUGA3,IERROR)
27422         IF(IERROR.EQ.'YES')GOTO19000
27423         DO11766I=1,NITEMX
27424           TEMP1(I)=TEMP91(I)
27425           TEMP2(I)=TEMP92(I)
2742611766   CONTINUE
27427      ELSEIF(ICASL7.EQ.'TPOI')THEN
27428        TY=TEMPS(3)
27429        TX=TEMPS(4)
27430        SY=TEMPS(5)
27431        SX=TEMPS(6)
27432        THETA=TEMPS(7)
27433        CALL DPTRPO(TEMP2,TEMP1,NS1,
27434     1              TX,TY,SX,SY,THETA,
27435     1              TEMP91,TEMP92,
27436     1              ISUBRO,IBUGA3,IERROR)
27437        IF(IERROR.EQ.'YES')GOTO19000
27438        DO11767I=1,NS1
27439          TEMP1(I)=TEMP92(I)
27440          TEMP2(I)=TEMP91(I)
2744111767   CONTINUE
27442      ELSEIF(ICASL7.EQ.'EXTP')THEN
27443        CALL DPEXTP(TEMP1,TEMP2,NS1,
27444     1              TEMP91,TEMP92,NITEMX,
27445     1              ISUBRO,IBUGA3,IERROR)
27446         IF(IERROR.EQ.'YES')GOTO19000
27447         DO11763I=1,NITEMX
27448           TEMP1(I)=TEMP91(I)
27449           TEMP2(I)=TEMP92(I)
2745011763   CONTINUE
27451        NS1=NITEMX
27452      ELSEIF(ICASL7.EQ.'ENCB')THEN
27453CCCCC   CALL DPENCB(TEMP1,TEMP2,NS1,MAXOBV,
27454        CALL DPENC2(TEMP1,TEMP2,NS1,MAXOBV,
27455     1              TEMP3,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,
27456     1              TEMP91,TEMP92,NITEMX,AREA,
27457     1              ISUBRO,IBUGA3,IERROR)
27458         IF(IERROR.EQ.'YES')GOTO19000
27459         DO11764I=1,NITEMX
27460           TEMP1(I)=TEMP91(I)
27461           TEMP2(I)=TEMP92(I)
2746211764   CONTINUE
27463        NS1=NITEMX
27464      ELSEIF(ICASL7.EQ.'INTL')THEN
27465C
27466C       DETERMINE MINIMUM/MAXIMUM COLUMN LENGTH
27467C
27468        N1MIN=0
27469        DO79001II=1,8
27470          IF(ITYPA(1).EQ.'VARI')THEN
27471            N1TEMP=INT(TEMPS(II)+0.1)
27472            IF(N1MIN.EQ.0)THEN
27473              N1MIN=N1TEMP
27474            ELSE
27475              N1MIN=MIN(N1MIN,N1TEMP)
27476            ENDIF
27477          ENDIF
2747879001   CONTINUE
27479        IF(N1MIN.EQ.0)N1MIN=1
27480C
27481C       CREATE VARIABLES FOR INTLIN ROUTINE
27482C
27483        IF(ITYPA(1).EQ.'PARA')THEN
27484          DO79011II=1,N1MIN
27485            TEMP1(II)=TEMPS(1)
2748679011     CONTINUE
27487        ENDIF
27488        IF(ITYPA(2).EQ.'PARA')THEN
27489          DO79012II=1,N1MIN
27490            TEMP2(II)=TEMPS(2)
2749179012     CONTINUE
27492        ENDIF
27493        IF(ITYPA(3).EQ.'PARA')THEN
27494          DO79013II=1,N1MIN
27495            TEMP3(II)=TEMPS(3)
2749679013     CONTINUE
27497        ENDIF
27498        IF(ITYPA(4).EQ.'PARA')THEN
27499          DO79014II=1,N1MIN
27500            TEMP4(II)=TEMPS(4)
2750179014     CONTINUE
27502        ENDIF
27503        IF(ITYPA(5).EQ.'PARA')THEN
27504          DO79015II=1,N1MIN
27505            TEMP5(II)=TEMPS(5)
2750679015     CONTINUE
27507        ENDIF
27508        IF(ITYPA(6).EQ.'PARA')THEN
27509          DO79016II=1,N1MIN
27510            TEMP6(II)=TEMPS(6)
2751179016     CONTINUE
27512        ENDIF
27513        IF(ITYPA(7).EQ.'PARA')THEN
27514          DO79017II=1,N1MIN
27515            TEMP7(II)=TEMPS(7)
2751679017     CONTINUE
27517        ENDIF
27518        IF(ITYPA(8).EQ.'PARA')THEN
27519          DO79018II=1,N1MIN
27520            TEMP8(II)=TEMPS(8)
2752179018     CONTINUE
27522        ENDIF
27523C
27524        IERROR='NO'
27525        CALL INTLIN(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
27526     1              TEMP7,TEMP8,N1MIN,
27527     1              TEMP91,TEMP92,NITEMX,
27528     1              ISUBRO,IBUGA3,IERROR)
27529         IF(IERROR.EQ.'YES')GOTO19000
27530         DO79019I=1,NITEMX
27531           TEMP1(I)=TEMP91(I)
27532           TEMP2(I)=TEMP92(I)
2753379019   CONTINUE
27534        NS1=NITEMX
27535      ELSEIF(ICASL7.EQ.'PARL' .OR. ICASL7.EQ.'PERL')THEN
27536C
27537C       DETERMINE MINIMUM/MAXIMUM COLUMN LENGTH
27538C
27539        N1MIN=0
27540        DO79021II=1,6
27541          IF(ITYPA(1).EQ.'VARI')THEN
27542            N1TEMP=INT(TEMPS(II)+0.1)
27543            IF(N1MIN.EQ.0)THEN
27544              N1MIN=N1TEMP
27545            ELSE
27546              N1MIN=MIN(N1MIN,N1TEMP)
27547            ENDIF
27548          ENDIF
2754979021   CONTINUE
27550        IF(N1MIN.EQ.0)N1MIN=1
27551C
27552C       CREATE VARIABLES FOR PARALI, DPPLIN ROUTINES
27553C
27554        IF(ITYPA(1).EQ.'PARA')THEN
27555          DO79023II=1,N1MIN
27556            TEMP1(II)=TEMPS(1)
2755779023     CONTINUE
27558        ENDIF
27559        IF(ITYPA(2).EQ.'PARA')THEN
27560          DO79024II=1,N1MIN
27561            TEMP2(II)=TEMPS(2)
2756279024     CONTINUE
27563        ENDIF
27564        IF(ITYPA(3).EQ.'PARA')THEN
27565          DO79025II=1,N1MIN
27566            TEMP3(II)=TEMPS(3)
2756779025     CONTINUE
27568        ENDIF
27569        IF(ITYPA(4).EQ.'PARA')THEN
27570          DO79026II=1,N1MIN
27571            TEMP4(II)=TEMPS(4)
2757279026     CONTINUE
27573        ENDIF
27574        IF(ITYPA(5).EQ.'PARA')THEN
27575          DO79027II=1,N1MIN
27576            TEMP5(II)=TEMPS(5)
2757779027     CONTINUE
27578        ENDIF
27579        IF(ITYPA(6).EQ.'PARA')THEN
27580          DO79028II=1,N1MIN
27581            TEMP6(II)=TEMPS(6)
2758279028     CONTINUE
27583        ENDIF
27584C
27585        IERROR='NO'
27586        DO79029II=1,N1MIN
27587          X1TEMP=TEMP1(II)
27588          Y1TEMP=TEMP2(II)
27589          X2TEMP=TEMP3(II)
27590          Y2TEMP=TEMP4(II)
27591          X3TEMP=TEMP5(II)
27592          Y3TEMP=TEMP6(II)
27593          IF(ICASL7.EQ.'PARL')THEN
27594            CALL PARALI(X1TEMP,Y1TEMP,X2TEMP,Y2TEMP,X3TEMP,Y3TEMP,
27595     1                  X4TEMP,Y4TEMP,
27596     1                  ISUBRO,IBUGA3,IERROR)
27597          ELSEIF(ICASL7.EQ.'PERL')THEN
27598            CALL DPPLIN(X1TEMP,Y1TEMP,X2TEMP,Y2TEMP,X3TEMP,Y3TEMP,
27599     1                  X4TEMP,Y4TEMP,S1TEMP,S2TEMP,DISTT,
27600     1                  ISUBRO,IBUGA3)
27601          ENDIF
27602          TEMP91(II)=X4TEMP
27603          TEMP92(II)=Y4TEMP
2760479029   CONTINUE
27605C
27606        DO79030I=1,NITEMX
27607          TEMP1(I)=TEMP91(I)
27608          TEMP2(I)=TEMP92(I)
2760979030   CONTINUE
27610        NS1=NITEMX
27611      ELSEIF(ICASL7.EQ.'EDGV')THEN
27612        CALL EDGVER(TEMP1,TEMP2,NS1,TEMP3,TEMP4,NS3,IWRITE,
27613     1              TEMP91,TEMP92,TEMP5,NITEMX,
27614     1              IBUGA3,IERROR)
27615         IF(IERROR.EQ.'YES')GOTO19000
27616         DO11768I=1,NITEMX
27617           TEMP1(I)=TEMP91(I)
27618           TEMP2(I)=TEMP92(I)
27619           TEMP91(I)=TEMP5(I)
2762011768   CONTINUE
27621      ELSEIF(ICASL7.EQ.'SPF1')THEN
27622        CALL SPANF1(TEMP1,TEMP2,NS1,TEMP3,TEMP4,NS3,IWRITE,
27623     1              TEMP91,TEMP92,TEMP5,NITEMX,
27624     1              ITEMP1,ITEMP3,ITEMP4,ITEMP5,
27625     1              IBUGA3,IERROR)
27626         IF(IERROR.EQ.'YES')GOTO19000
27627         DO11769I=1,NITEMX
27628           TEMP1(I)=TEMP91(I)
27629           TEMP2(I)=TEMP92(I)
27630           TEMP91(I)=TEMP5(I)
2763111769   CONTINUE
27632      ELSEIF(ICASL7.EQ.'SPF2')THEN
27633        NVERT=INT(TEMPS(3)+0.1)
27634        CALL SPANF2(TEMP1,TEMP2,NS1,NVERT,IWRITE,
27635     1              ITEMP1,ITEMP3,ITEMP4,IK,ITEMP5,
27636     1              IBUGA3,IERROR)
27637         IF(IERROR.EQ.'YES')GOTO19000
27638         NITEMX=NS1
27639         NS3=NVERT
27640         DO11770I=1,NS3
27641           TEMP91(I)=REAL(ITEMP3(I))
2764211770    CONTINUE
27643         NS4=IK
27644         DO11771I=1,NS4
27645           TEMP92(I)=INT(ITEMP4(I))
2764611771   CONTINUE
27647      ELSEIF(ICASL7.EQ.'NEXS')THEN
27648        ILAST=0
27649        NITEMX=INT(TEMPS(1)+0.01)
27650        IF(NITEMX.EQ.0)THEN
27651          NLAST=0
27652          WRITE(ICOUT,999)
27653          CALL DPWRST('XXX','BUG ')
27654          WRITE(ICOUT,11773)
2765511773     FORMAT('****** FROM NEXT SUBSET--')
27656          CALL DPWRST('XXX','BUG ')
27657          WRITE(ICOUT,11775)
2765811775     FORMAT('       SUBSET SEQUENCE RESET.')
27659          CALL DPWRST('XXX','BUG ')
27660          GOTO11786
27661        ELSEIF(NITEMX.GT.MAXOBV)THEN
27662          WRITE(ICOUT,999)
27663          CALL DPWRST('XXX','BUG ')
27664          WRITE(ICOUT,11776)
2766511776     FORMAT('****** ERROR FROM NEXT SUBSET--')
27666          CALL DPWRST('XXX','BUG ')
27667          WRITE(ICOUT,11778)MAXOBV
2766811778     FORMAT('       SUBSET SIZE EXCEEDS MAXIMUM ALLOWABLE ',
27669     1           '(',I10,')')
27670          CALL DPWRST('XXX','BUG ')
27671          IFOUND='YES'
27672          IERROR='YES'
27673          IH='LAST'
27674          IH2='SEQU'
27675          VALUE0=REAL(ILAST)
27676          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27677     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27678     1                IANS,IWIDTH,IBUGA3,IERROR)
27679          GOTO19000
27680        ELSE
27681          IF(NITEMX.NE.NLAST)NLAST=0
27682          MTC=.TRUE.
27683          DO11781I=1,NITEMX
27684            ITEMP1(I)=INT(TEMP2(I)+0.01)
2768511781     CONTINUE
27686          CALL NEXSUB(NITEMX,ITEMP1,MTC,NCARD,JTEMP)
27687          DO11783I=1,NITEMX
27688            TEMP1(I)=REAL(ITEMP1(I))
2768911783     CONTINUE
27690          IF(.NOT.MTC)THEN
27691            ILAST=1
27692            WRITE(ICOUT,999)
27693            CALL DPWRST('XXX','BUG ')
27694            WRITE(ICOUT,11773)
27695            CALL DPWRST('XXX','BUG ')
27696            WRITE(ICOUT,11785)
2769711785       FORMAT('       THIS IS THE LAST SUBSET IN THE SEQUENCE.')
27698            CALL DPWRST('XXX','BUG ')
27699            NLAST=0
27700            ILAST=1
27701          ENDIF
27702        ENDIF
27703C
2770411786   CONTINUE
27705        IH='LAST'
27706        IH2='SEQU'
27707        VALUE0=REAL(ILAST)
27708        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27709     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27710     1              IANS,IWIDTH,IBUGA3,IERROR)
27711        IFOUND='YES'
27712        IERROR='NO'
27713C
27714      ELSEIF(ICASL7.EQ.'NEXP')THEN
27715        ILAST=0
27716        NITEMX=INT(TEMPS(1)+0.01)
27717        IF(NITEMX.EQ.0)THEN
27718          NLAST=0
27719          WRITE(ICOUT,999)
27720          CALL DPWRST('XXX','BUG ')
27721          WRITE(ICOUT,11801)
2772211801     FORMAT('****** FROM NEXT PERMUATION--')
27723          CALL DPWRST('XXX','BUG ')
27724          WRITE(ICOUT,11803)
2772511803     FORMAT('       SUBSET SEQUENCE RESET.')
27726          CALL DPWRST('XXX','BUG ')
27727          GOTO11816
27728        ELSEIF(NITEMX.GT.MAXOBV)THEN
27729          WRITE(ICOUT,999)
27730          CALL DPWRST('XXX','BUG ')
27731          WRITE(ICOUT,11806)
2773211806     FORMAT('****** ERROR FROM NEXT PERMUATION--')
27733          CALL DPWRST('XXX','BUG ')
27734          WRITE(ICOUT,11808)MAXOBV
2773511808     FORMAT('       PERMUTATION SIZE EXCEEDS MAXIMUM ALLOWABLE ',
27736     1           '(',I10,')')
27737          CALL DPWRST('XXX','BUG ')
27738          IFOUND='YES'
27739          IERROR='YES'
27740          IH='LAST'
27741          IH2='SEQU'
27742          VALUE0=REAL(ILAST)
27743          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27744     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27745     1                IANS,IWIDTH,IBUGA3,IERROR)
27746          GOTO19000
27747        ELSE
27748          IF(NITEMX.NE.NLAST)NLAST=0
27749          MTC=.TRUE.
27750          DO11811I=1,NITEMX
27751            ITEMP1(I)=INT(TEMP2(I)+0.01)
2775211811     CONTINUE
27753          CALL NEXPER(ITEMP1,NITEMX,MTC)
27754          NLAST=NITEMX
27755          DO11813I=1,NITEMX
27756            TEMP1(I)=REAL(ITEMP1(I))
2775711813     CONTINUE
27758          IF(.NOT.MTC)THEN
27759            WRITE(ICOUT,999)
27760            CALL DPWRST('XXX','BUG ')
27761            WRITE(ICOUT,11806)
27762            CALL DPWRST('XXX','BUG ')
27763            WRITE(ICOUT,11815)
2776411815       FORMAT('       THIS IS THE LAST PERMUATION IN THE ',
27765     1             'SEQUENCE.')
27766            CALL DPWRST('XXX','BUG ')
27767            NLAST=0
27768            ILAST=1
27769          ENDIF
27770        ENDIF
27771C
2777211816   CONTINUE
27773        IH='LAST'
27774        IH2='SEQU'
27775        VALUE0=REAL(ILAST)
27776        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27777     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27778     1              IANS,IWIDTH,IBUGA3,IERROR)
27779        IFOUND='YES'
27780        IERROR='NO'
27781C
27782      ELSEIF(ICASL7.EQ.'KNSE')THEN
27783        ILAST=0
27784        KCURR=INT(TEMPS(1)+0.01)
27785        NCURR=INT(TEMPS(2)+0.01)
27786        NITEMX=KCURR
27787        IF(KCURR.EQ.0 .OR. NCURR.EQ.0)THEN
27788          NLAST=0
27789          KLAST=0
27790          WRITE(ICOUT,999)
27791          CALL DPWRST('XXX','BUG ')
27792          WRITE(ICOUT,11823)
2779311823     FORMAT('****** FROM NEXT K-SET OF N-SET--')
27794          CALL DPWRST('XXX','BUG ')
27795          WRITE(ICOUT,11825)
2779611825     FORMAT('       K-SET OF N-SET SEQUENCE RESET.')
27797          CALL DPWRST('XXX','BUG ')
27798          GOTO11848
27799        ELSEIF(NCURR.LT.1 .OR. NCURR.GT.MAXOBV)THEN
27800          WRITE(ICOUT,999)
27801          CALL DPWRST('XXX','BUG ')
27802          WRITE(ICOUT,11823)
27803          CALL DPWRST('XXX','BUG ')
27804          WRITE(ICOUT,11826)MAXOBV
2780511826     FORMAT('       VALUE OF N EXCEEDS MAXIMUM ALLOWABLE ',
27806     1           '(',I10,')')
27807          CALL DPWRST('XXX','BUG ')
27808          WRITE(ICOUT,11827)
2780911827     FORMAT('       OR IS LESS THAN 1.')
27810          CALL DPWRST('XXX','BUG ')
27811          WRITE(ICOUT,11828)NCURR
2781211828     FORMAT('       THE VALUE OF N IS ',I8)
27813          CALL DPWRST('XXX','BUG ')
27814          IFOUND='YES'
27815          IERROR='YES'
27816          IH='LAST'
27817          IH2='SEQU'
27818          VALUE0=REAL(ILAST)
27819          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27820     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27821     1                IANS,IWIDTH,IBUGA3,IERROR)
27822          GOTO19000
27823        ELSEIF(KCURR.LT.1 .OR. KCURR.GT.NCURR)THEN
27824          WRITE(ICOUT,999)
27825          CALL DPWRST('XXX','BUG ')
27826          WRITE(ICOUT,11823)
27827          CALL DPWRST('XXX','BUG ')
27828          WRITE(ICOUT,11836)
2782911836     FORMAT('       VALUE OF K IS GREATER THAN THE VALUE ',
27830     1           ' OF N')
27831          CALL DPWRST('XXX','BUG ')
27832          WRITE(ICOUT,11837)
2783311837     FORMAT('       OR IS LESS THAN 1.')
27834          CALL DPWRST('XXX','BUG ')
27835          WRITE(ICOUT,11838)KCURR
2783611838     FORMAT('       THE VALUE OF K IS ',I8)
27837          CALL DPWRST('XXX','BUG ')
27838          WRITE(ICOUT,11828)NCURR
27839          CALL DPWRST('XXX','BUG ')
27840          IFOUND='YES'
27841          IERROR='YES'
27842          IH='LAST'
27843          IH2='SEQU'
27844          VALUE0=REAL(ILAST)
27845          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27846     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27847     1                IANS,IWIDTH,IBUGA3,IERROR)
27848          GOTO19000
27849        ELSE
27850          IF(KCURR.NE.KLAST .OR. NCURR.NE.NLAST)THEN
27851            CALL NEXKSB(NCURR,KCURR,ITEMP1,MTC)
27852            NITEMX=KCURR
27853            DO11840I=1,NITEMX
27854              TEMP1(I)=REAL(ITEMP1(I))
2785511840       CONTINUE
27856            NLAST=NCURR
27857            KLAST=KCURR
27858          ELSE
27859            MTC=.TRUE.
27860            DO11841I=1,KCURR
27861              ITEMP1(I)=INT(TEMP3(I)+0.01)
2786211841       CONTINUE
27863            CALL NEXKSB(NCURR,KCURR,ITEMP1,MTC)
27864            NITEMX=KCURR
27865            DO11843I=1,NITEMX
27866              TEMP1(I)=REAL(ITEMP1(I))
2786711843       CONTINUE
27868            IF(.NOT.MTC)THEN
27869              WRITE(ICOUT,999)
27870              CALL DPWRST('XXX','BUG ')
27871              WRITE(ICOUT,11823)
27872              CALL DPWRST('XXX','BUG ')
27873              WRITE(ICOUT,11845)
2787411845         FORMAT('       THIS IS THE LAST SUBSET IN THE SEQUENCE.')
27875              CALL DPWRST('XXX','BUG ')
27876              NLAST=0
27877              KLAST=0
27878              ILAST=1
27879            ENDIF
27880          ENDIF
27881        ENDIF
27882C
2788311848   CONTINUE
27884        IH='LAST'
27885        IH2='SEQU'
27886        VALUE0=REAL(ILAST)
27887        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27888     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27889     1              IANS,IWIDTH,IBUGA3,IERROR)
27890        IFOUND='YES'
27891        IERROR='NO'
27892C
27893      ELSEIF(ICASL7.EQ.'NEXC')THEN
27894        ILAST=0
27895        KCURR=INT(TEMPS(1)+0.01)
27896        NCURR=INT(TEMPS(2)+0.01)
27897        NITEMX=KCURR
27898        IF(KCURR.EQ.0 .OR. NCURR.EQ.0)THEN
27899          NLAST=0
27900          KLAST=0
27901          WRITE(ICOUT,999)
27902          CALL DPWRST('XXX','BUG ')
27903          WRITE(ICOUT,31823)
2790431823     FORMAT('****** FROM NEXT COMPOSITION--')
27905          CALL DPWRST('XXX','BUG ')
27906          WRITE(ICOUT,31825)
2790731825     FORMAT('       COMPOSITION SEQUENCE RESET.')
27908          CALL DPWRST('XXX','BUG ')
27909          GOTO31846
27910        ELSEIF(NCURR.LT.1 .OR. NCURR.GT.MAXOBV)THEN
27911          WRITE(ICOUT,999)
27912          CALL DPWRST('XXX','BUG ')
27913          WRITE(ICOUT,31823)
27914          CALL DPWRST('XXX','BUG ')
27915          WRITE(ICOUT,31826)MAXOBV
2791631826     FORMAT('       VALUE OF N EXCEEDS MAXIMUM ALLOWABLE ',
27917     1           '(',I10,')')
27918          CALL DPWRST('XXX','BUG ')
27919          WRITE(ICOUT,31827)
2792031827     FORMAT('       OR IS LESS THAN 1.')
27921          CALL DPWRST('XXX','BUG ')
27922          WRITE(ICOUT,31828)NCURR
2792331828     FORMAT('       THE VALUE OF N IS ',I8)
27924          CALL DPWRST('XXX','BUG ')
27925          IFOUND='YES'
27926          IERROR='YES'
27927          IH='LAST'
27928          IH2='SEQU'
27929          VALUE0=REAL(ILAST)
27930          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27931     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27932     1                IANS,IWIDTH,IBUGA3,IERROR)
27933          GOTO19000
27934        ELSEIF(KCURR.LT.1 .OR. KCURR.GT.NCURR)THEN
27935          WRITE(ICOUT,999)
27936          CALL DPWRST('XXX','BUG ')
27937          WRITE(ICOUT,31823)
27938          CALL DPWRST('XXX','BUG ')
27939          WRITE(ICOUT,31836)
2794031836     FORMAT('       VALUE OF K IS GREATER THAN THE VALUE ',
27941     1           ' OF N')
27942          CALL DPWRST('XXX','BUG ')
27943          WRITE(ICOUT,31837)
2794431837     FORMAT('       OR IS LESS THAN 1.')
27945          CALL DPWRST('XXX','BUG ')
27946          WRITE(ICOUT,31838)KCURR
2794731838     FORMAT('       THE VALUE OF K IS ',I8)
27948          CALL DPWRST('XXX','BUG ')
27949          WRITE(ICOUT,31828)NCURR
27950          CALL DPWRST('XXX','BUG ')
27951          IFOUND='YES'
27952          IERROR='YES'
27953          IH='LAST'
27954          IH2='SEQU'
27955          VALUE0=REAL(ILAST)
27956          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
27957     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
27958     1                IANS,IWIDTH,IBUGA3,IERROR)
27959          GOTO19000
27960        ELSE
27961          IF(KCURR.NE.KLAST .OR. NCURR.NE.NLAST)THEN
27962            MTC=.FALSE.
27963            CALL NEXCOM(NCURR,KCURR,ITEMP1,MTC)
27964            NITEMX=KCURR
27965            DO31840I=1,NITEMX
27966              TEMP1(I)=REAL(ITEMP1(I))
2796731840       CONTINUE
27968            NLAST=NCURR
27969            KLAST=KCURR
27970          ELSE
27971            MTC=.TRUE.
27972            DO31841I=1,KCURR
27973              ITEMP1(I)=INT(TEMP3(I)+0.01)
2797431841       CONTINUE
27975            CALL NEXCOM(NCURR,KCURR,ITEMP1,MTC)
27976            NITEMX=KCURR
27977            DO31843I=1,NITEMX
27978              TEMP1(I)=REAL(ITEMP1(I))
2797931843       CONTINUE
27980            NLAST=NCURR
27981            KLAST=KCURR
27982            IF(.NOT.MTC)THEN
27983              WRITE(ICOUT,999)
27984              CALL DPWRST('XXX','BUG ')
27985              WRITE(ICOUT,31823)
27986              CALL DPWRST('XXX','BUG ')
27987              WRITE(ICOUT,31845)
2798831845         FORMAT('       THIS IS THE LAST SUBSET IN THE SEQUENCE.')
27989              CALL DPWRST('XXX','BUG ')
27990              NLAST=0
27991              KLAST=0
27992              ILAST=1
27993            ENDIF
27994          ENDIF
27995        ENDIF
27996C
2799731846   CONTINUE
27998        IH='LAST'
27999        IH2='SEQU'
28000        VALUE0=REAL(ILAST)
28001        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
28002     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
28003     1              IANS,IWIDTH,IBUGA3,IERROR)
28004        IFOUND='YES'
28005        IERROR='NO'
28006C
28007      ELSEIF(ICASL7.EQ.'NEPA')THEN
28008        ILAST=0
28009        NCURR=INT(TEMPS(1)+0.01)
28010        IF(NCURR.EQ.0)THEN
28011          NLAST=0
28012          WRITE(ICOUT,999)
28013          CALL DPWRST('XXX','BUG ')
28014          WRITE(ICOUT,31853)
2801531853     FORMAT('****** FROM NEXT PARTITION--')
28016          CALL DPWRST('XXX','BUG ')
28017          WRITE(ICOUT,31855)
2801831855     FORMAT('       PARTITION SEQUENCE RESET.')
28019          CALL DPWRST('XXX','BUG ')
28020          GOTO31876
28021        ELSEIF(NCURR.LT.1 .OR. NCURR.GT.MAXOBV)THEN
28022          WRITE(ICOUT,999)
28023          CALL DPWRST('XXX','BUG ')
28024          WRITE(ICOUT,31853)
28025          CALL DPWRST('XXX','BUG ')
28026          WRITE(ICOUT,31856)MAXOBV
2802731856     FORMAT('       VALUE OF N EXCEEDS MAXIMUM ALLOWABLE ',
28028     1           '(',I10,')')
28029          CALL DPWRST('XXX','BUG ')
28030          WRITE(ICOUT,31857)
2803131857     FORMAT('       OR IS LESS THAN 1.')
28032          CALL DPWRST('XXX','BUG ')
28033          WRITE(ICOUT,31858)NCURR
2803431858     FORMAT('       THE VALUE OF N IS ',I8)
28035          CALL DPWRST('XXX','BUG ')
28036          IFOUND='YES'
28037          IERROR='YES'
28038          IH='LAST'
28039          IH2='SEQU'
28040          VALUE0=REAL(ILAST)
28041          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
28042     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
28043     1                IANS,IWIDTH,IBUGA3,IERROR)
28044          GOTO19000
28045        ELSE
28046          IF(NCURR.NE.NLAST)THEN
28047            MTC=.FALSE.
28048            CALL NEXPAR(NCURR,ITEMP1,ITEMP2,NITEMX,MTC)
28049            DO31870I=1,NITEMX
28050              TEMP1(I)=REAL(ITEMP1(I))
28051              TEMP2(I)=REAL(ITEMP2(I))
2805231870       CONTINUE
28053            NLAST=NCURR
28054          ELSE
28055            MTC=.TRUE.
28056            DO31871I=1,NS2
28057              ITEMP1(I)=INT(TEMP2(I)+0.01)
28058              ITEMP2(I)=INT(TEMP3(I)+0.01)
2805931871       CONTINUE
28060            NITEMX=NS2
28061            CALL NEXPAR(NCURR,ITEMP1,ITEMP2,NITEMX,MTC)
28062            DO31873I=1,NITEMX
28063              TEMP1(I)=REAL(ITEMP1(I))
28064              TEMP2(I)=REAL(ITEMP2(I))
2806531873       CONTINUE
28066            NLAST=NCURR
28067            IF(.NOT.MTC)THEN
28068              WRITE(ICOUT,999)
28069              CALL DPWRST('XXX','BUG ')
28070              WRITE(ICOUT,31853)
28071              CALL DPWRST('XXX','BUG ')
28072              WRITE(ICOUT,31875)
2807331875         FORMAT('       THIS IS THE LAST PARTITION IN THE ',
28074     1               'SEQUENCE.')
28075              CALL DPWRST('XXX','BUG ')
28076              NLAST=0
28077              ILAST=1
28078            ENDIF
28079          ENDIF
28080        ENDIF
28081C
2808231876   CONTINUE
28083        IH='LAST'
28084        IH2='SEQU'
28085        VALUE0=REAL(ILAST)
28086        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
28087     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
28088     1              IANS,IWIDTH,IBUGA3,IERROR)
28089        IFOUND='YES'
28090        IERROR='NO'
28091C
28092      ELSEIF(ICASL7.EQ.'NEXE')THEN
28093        ILAST=0
28094        NCURR=INT(TEMPS(1)+0.01)
28095        IF(NCURR.EQ.0)THEN
28096          NLAST=0
28097          WRITE(ICOUT,999)
28098          CALL DPWRST('XXX','BUG ')
28099          WRITE(ICOUT,31883)
2810031883     FORMAT('****** FROM NEXT EQUIVALENCE RELATION--')
28101          CALL DPWRST('XXX','BUG ')
28102          WRITE(ICOUT,31885)
2810331885     FORMAT('       EQUIVALENCE RELATION SEQUENCE RESET.')
28104          CALL DPWRST('XXX','BUG ')
28105          GOTO31896
28106        ELSEIF(NCURR.LT.1 .OR. NCURR.GT.MAXOBV)THEN
28107          WRITE(ICOUT,999)
28108          CALL DPWRST('XXX','BUG ')
28109          WRITE(ICOUT,31883)
28110          CALL DPWRST('XXX','BUG ')
28111          WRITE(ICOUT,31886)MAXOBV
2811231886     FORMAT('       VALUE OF N EXCEEDS MAXIMUM ALLOWABLE ',
28113     1           '(',I10,')')
28114          CALL DPWRST('XXX','BUG ')
28115          WRITE(ICOUT,31887)
2811631887     FORMAT('       OR IS LESS THAN 1.')
28117          CALL DPWRST('XXX','BUG ')
28118          WRITE(ICOUT,31888)NCURR
2811931888     FORMAT('       THE VALUE OF N IS ',I8)
28120          CALL DPWRST('XXX','BUG ')
28121          IFOUND='YES'
28122          IERROR='YES'
28123          IH='LAST'
28124          IH2='SEQU'
28125          VALUE0=REAL(ILAST)
28126          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
28127     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
28128     1                IANS,IWIDTH,IBUGA3,IERROR)
28129          GOTO19000
28130        ELSE
28131          IF(NCURR.NE.NLAST)THEN
28132            MTC=.FALSE.
28133            CALL NEXEQU(NCURR,NC,ITEMP2,ITEMP1,MTC)
28134            NITEMX=NCURR
28135            DO31890I=1,NITEMX
28136              TEMP1(I)=REAL(ITEMP1(I))
2813731890       CONTINUE
28138            DO31898I=1,NC
28139              TEMP2(I)=REAL(ITEMP2(I))
2814031898       CONTINUE
28141            NLAST=NCURR
28142          ELSE
28143            MTC=.TRUE.
28144            DO31891I=1,NS2
28145              ITEMP1(I)=INT(TEMP3(I)+0.01)
2814631891       CONTINUE
28147            DO31892I=1,NS3
28148              ITEMP2(I)=INT(TEMP2(I)+0.01)
2814931892       CONTINUE
28150            NITEMX=NS2
28151            CALL NEXEQU(NCURR,NC,ITEMP1,ITEMP2,MTC)
28152            NITEMX=NCURR
28153            DO31893I=1,NITEMX
28154              TEMP1(I)=REAL(ITEMP2(I))
2815531893       CONTINUE
28156            DO31894I=1,NC
28157              TEMP2(I)=REAL(ITEMP1(I))
2815831894       CONTINUE
28159            NLAST=NCURR
28160            IF(.NOT.MTC)THEN
28161              WRITE(ICOUT,999)
28162              CALL DPWRST('XXX','BUG ')
28163              WRITE(ICOUT,31883)
28164              CALL DPWRST('XXX','BUG ')
28165              WRITE(ICOUT,31895)
2816631895         FORMAT('       THIS IS THE LAST EQUIVALENCE RELATION ',
28167     1               'IN THE SEQUENCE.')
28168              CALL DPWRST('XXX','BUG ')
28169              NLAST=0
28170              ILAST=1
28171            ENDIF
28172          ENDIF
28173        ENDIF
28174C
2817531896   CONTINUE
28176        IH='LAST'
28177        IH2='SEQU'
28178        VALUE0=REAL(ILAST)
28179        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
28180     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
28181     1              IANS,IWIDTH,IBUGA3,IERROR)
28182        IFOUND='YES'
28183        IERROR='NO'
28184C
28185      ELSEIF(ICASL7.EQ.'NEYT')THEN
28186        ILAST=0
28187        NCURR=INT(TEMPS(1)+0.01)
28188        NS2=NIRIGH(2)
28189        NS3=NIRIGH(3)
28190        IF(NCURR.EQ.0)THEN
28191          NLAST=0
28192          WRITE(ICOUT,999)
28193          CALL DPWRST('XXX','BUG ')
28194          WRITE(ICOUT,31903)
2819531903     FORMAT('****** FROM NEXT YOUNG TABLEAUX--')
28196          CALL DPWRST('XXX','BUG ')
28197          WRITE(ICOUT,31905)
2819831905     FORMAT('       YOUNG TABLEAUX SEQUENCE RESET.')
28199          CALL DPWRST('XXX','BUG ')
28200          GOTO31929
28201        ELSEIF(NCURR.LT.1 .OR. NCURR.GT.MAXOBV)THEN
28202          WRITE(ICOUT,999)
28203          CALL DPWRST('XXX','BUG ')
28204          WRITE(ICOUT,31903)
28205          CALL DPWRST('XXX','BUG ')
28206          WRITE(ICOUT,31906)MAXOBV
2820731906     FORMAT('       VALUE OF N EXCEEDS MAXIMUM ALLOWABLE ',
28208     1           '(',I10,')')
28209          CALL DPWRST('XXX','BUG ')
28210          WRITE(ICOUT,31907)
2821131907     FORMAT('       OR IS LESS THAN 1.')
28212          CALL DPWRST('XXX','BUG ')
28213          WRITE(ICOUT,31908)NCURR
2821431908     FORMAT('       THE VALUE OF N IS ',I8)
28215          CALL DPWRST('XXX','BUG ')
28216          IFOUND='YES'
28217          IERROR='YES'
28218          IH='LAST'
28219          IH2='SEQU'
28220          VALUE0=REAL(ILAST)
28221          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
28222     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
28223     1                IANS,IWIDTH,IBUGA3,IERROR)
28224          GOTO19000
28225        ELSE
28226          IF(NCURR.NE.NLAST)THEN
28227            MTC=.FALSE.
28228            ISUM1=0
28229            DO31910I=1,NS2
28230              ITEMP1(I)=INT(TEMP2(I)+0.01)
28231              ISUM1=ISUM1+ITEMP1(I)
2823231910       CONTINUE
28233            IF(ISUM1.NE.NCURR)THEN
28234              WRITE(ICOUT,999)
28235              CALL DPWRST('XXX','BUG ')
28236              WRITE(ICOUT,31903)
28237              CALL DPWRST('XXX','BUG ')
28238              WRITE(ICOUT,31926)
2823931926         FORMAT('       THE SUM OF THE LAMBDA VECTOR DOES NOT ',
28240     1               'NOT EQUAL N.')
28241              CALL DPWRST('XXX','BUG ')
28242              IFOUND='YES'
28243              IERROR='YES'
28244              IH='LAST'
28245              IH2='SEQU'
28246              VALUE0=REAL(ILAST)
28247              CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
28248     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
28249     1                IANS,IWIDTH,IBUGA3,IERROR)
28250              GOTO19000
28251            ENDIF
28252            IF(NS2.LT.NCURR)THEN
28253              DO31911I=NS1+1,NCURR
28254                ITEMP1(I)=0
2825531911         CONTINUE
28256            ENDIF
28257            DO31912I=1,NCURR
28258              ITEMP2(I)=0
2825931912       CONTINUE
28260            CALL NEXYTB(NCURR,ITEMP1,ITEMP2,MTC)
28261            NITEMX=NCURR
28262            DO31913I=1,NITEMX
28263              TEMP1(I)=REAL(ITEMP2(I))
2826431913       CONTINUE
28265            NLAST=NCURR
28266          ELSE
28267            MTC=.TRUE.
28268            DO31915I=1,NS2
28269              ITEMP1(I)=INT(TEMP2(I)+0.01)
2827031915       CONTINUE
28271            DO31916I=1,NS3
28272              ITEMP2(I)=INT(TEMP3(I)+0.01)
2827331916       CONTINUE
28274            NITEMX=NS2
28275            CALL NEXYTB(NCURR,ITEMP1,ITEMP2,MTC)
28276            NITEMX=NCURR
28277            DO31918I=1,NITEMX
28278              TEMP1(I)=REAL(ITEMP2(I))
2827931918       CONTINUE
28280            NLAST=NCURR
28281            IF(.NOT.MTC)THEN
28282              WRITE(ICOUT,999)
28283              CALL DPWRST('XXX','BUG ')
28284              WRITE(ICOUT,31903)
28285              CALL DPWRST('XXX','BUG ')
28286              WRITE(ICOUT,31921)
2828731921         FORMAT('       THIS IS THE LAST YOUNG TABLEAUX ',
28288     1               'IN THE SEQUENCE.')
28289              CALL DPWRST('XXX','BUG ')
28290              NLAST=0
28291              ILAST=1
28292            ENDIF
28293          ENDIF
28294        ENDIF
28295C
2829631929   CONTINUE
28297        IH='LAST'
28298        IH2='SEQU'
28299        VALUE0=REAL(ILAST)
28300        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
28301     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
28302     1              IANS,IWIDTH,IBUGA3,IERROR)
28303        IFOUND='YES'
28304        IERROR='NO'
28305C
28306      ELSEIF(ICASL7.EQ.'CYTB')THEN
28307        NS1=NIRIGH(1)
28308        DO31931I=1,NS1
28309          ITEMP1(I)=INT(TEMP1(I)+0.01)
2831031931   CONTINUE
28311C
28312        CALL CONYTB(ITEMP1,ITEMP2,ITEMP3,NS1,
28313     1              TEMP2,TEMP3,
28314     1              IBUGA3,IERROR)
28315        IF(IERROR.EQ.'YES')THEN
28316          IFOUND='YES'
28317          GOTO9000
28318        ENDIF
28319C
28320        NITEMX=NS1
28321        DO31933I=1,NITEMX
28322          TEMP1(I)=REAL(ITEMP2(I))
28323          TEMP2(I)=REAL(ITEMP3(I))
2832431933   CONTINUE
28325C
28326      ELSEIF(ICASL7.EQ.'YTHL')THEN
28327        NS1=NIRIGH(1)
28328        DO31941I=1,NS1
28329          ITEMP1(I)=INT(TEMP1(I)+0.01)
28330          ITEMP2(I)=INT(TEMP2(I)+0.01)
2833131941   CONTINUE
28332C
28333        CALL YTBHOO(ITEMP1,ITEMP2,ITEMP3,NS1,
28334     1              ITEMP4,ITEMP5,
28335     1              IBUGA3,IERROR)
28336        IF(IERROR.EQ.'YES')THEN
28337          IFOUND='YES'
28338          GOTO9000
28339        ENDIF
28340C
28341        NITEMX=NS1
28342        DO31943I=1,NITEMX
28343          TEMP1(I)=REAL(ITEMP4(I))
2834431943   CONTINUE
28345C
28346      ELSEIF(ICASL7.EQ.'BINN'.OR.ICASL7.EQ.'BINR')THEN
28347        IRELAT='OFF'
28348        IF(ICASL7.EQ.'BINR')IRELAT='ON'
28349        CLWID=CLWIDT(1)
28350        XSTART=CLLIMI(1)
28351        XSTOP=CLLIMI(2)
28352        CALL DPBIN(TEMP1,NS1,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
28353     1             TEMP2,MAXOBV,IHSTCW,IHSTOU,
28354     1             TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
28355        IF(IERROR.EQ.'YES')GOTO19000
28356        DO11791I=1,NITEMX
28357          TEMP1(I)=TEMP91(I)
28358          TEMP2(I)=TEMP92(I)
2835911791   CONTINUE
28360      ELSEIF(ICASL7.EQ.'CBIN'.OR.ICASL7.EQ.'CBIR')THEN
28361        IRELAT='OFF'
28362        IF(ICASL7.EQ.'CBIR')IRELAT='ON'
28363        CLWID=CLWIDT(1)
28364        XSTART=CLLIMI(1)
28365        XSTOP=CLLIMI(2)
28366        CALL DPBINC(TEMP1,NS1,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
28367     1              TEMP2,MAXOBV,IHSTCW,IHSTOU,
28368     1              TEMP91,TEMP92,NITEMX,TEMP3,
28369     1              ISUBRO,IBUGA3,IERROR)
28370        IF(IERROR.EQ.'YES')GOTO19000
28371        DO11792I=1,NITEMX
28372          TEMP1(I)=TEMP91(I)
28373          TEMP2(I)=TEMP92(I)
2837411792   CONTINUE
28375        DO11793I=1,NS1
28376          TEMP91(I)=TEMP3(I)
2837711793   CONTINUE
28378      ELSEIF(ICASL7.EQ.'BINP'.OR.ICASL7.EQ.'BIRP')THEN
28379        IRELAT='OFF'
28380        IF(ICASL7.EQ.'BIRP')IRELAT='ON'
28381        CLWID=CLWIDT(1)
28382        XSTART=CLLIMI(1)
28383        XSTOP=CLLIMI(2)
28384        CALL DPBINP(TEMP1,NS1,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
28385     1             TEMP2,TEMP3,TEMP4,TEMP5,MAXOBV,IHSTCW,
28386     1             TEMP91,TEMP92,NITEMX,IBUGA3,ISUBRO,IERROR)
28387        IF(IERROR.EQ.'YES')GOTO19000
28388        DO11794I=1,NITEMX
28389          TEMP1(I)=TEMP91(I)
28390          TEMP2(I)=TEMP92(I)
2839111794   CONTINUE
28392      ELSEIF(ICASL7.EQ.'ASHR'.OR.ICASL7.EQ.'ASHC')THEN
28393        IRELAT='ON'
28394        IF(ICASL7.EQ.'ASHC')IRELAT='OFF'
28395        CLWID=CLWIDT(1)
28396        XSTART=CLLIMI(1)
28397        XSTOP=CLLIMI(2)
28398C
28399        IHP='M   '
28400        IHP2='    '
28401        IHWUSE='P'
28402        MESSAG='NO'
28403        CALL CHECKN(IHP,IHP2,IHWUSE,
28404     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
28405     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
28406        IF(IERROR.EQ.'YES')THEN
28407          M=8
28408        ELSE
28409          M=INT(VALUE(ILOCP)+0.5)
28410          IF(M.LE.0)M=1
28411          IF(M.GT.64)M=64
28412        ENDIF
28413C
28414        CALL DPBINA(TEMP1,NS1,CLWID,XSTART,XSTOP,M,
28415     1              TEMP1,MAXOBV,
28416     1              IRELAT,IASHWT,IHSTCW,
28417     1              TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
28418        IF(IERROR.EQ.'YES')GOTO19000
28419        DO11796I=1,NITEMX
28420          TEMP1(I)=TEMP91(I)
28421          TEMP2(I)=TEMP92(I)
2842211796   CONTINUE
28423      ELSEIF(ICASL7.EQ.'PEAK'.OR.ICASL7.EQ.'PEAR')THEN
28424        CALL DPPEAK(TEMP1,TEMP2,NS1,
28425     1             TEMP3,TEMP4,TEMP5,NITEMX,IBUGA3,ISUBRO,IERROR)
28426        IF(IERROR.EQ.'YES')GOTO19000
28427        IF(ICASL7.EQ.'PEAK')THEN
28428          DO11798I=1,NITEMX
28429            TEMP1(I)=TEMP3(I)
28430            TEMP2(I)=TEMP4(I)
2843111798     CONTINUE
28432        ELSE
28433          DO11799I=1,NITEMX
28434            TEMP1(I)=TEMP5(I)
2843511799     CONTINUE
28436        ENDIF
28437      ELSEIF(ICASL7.EQ.'EQUF')THEN
28438        CALL EMPQUA(TEMP1,NS1,IWRITE,TEMP91,TEMP92,NITEMX,
28439     1              IBUGA3,ISUBRO,IERROR)
28440        IF(IERROR.EQ.'YES')GOTO19000
28441        DO11701I=1,NITEMX
28442          TEMP1(I)=TEMP91(I)
28443          TEMP2(I)=TEMP92(I)
2844411701   CONTINUE
28445      ELSEIF(ICASL7.EQ.'IQUF' .OR. ICASL7.EQ.'TIQF')THEN
28446        CALL EMPTIQ(TEMP1,NS1,IWRITE,TEMP91,TEMP92,TEMP3,TEMP4,NITEMX,
28447     1              IBUGA3,ISUBRO,IERROR)
28448        IF(IERROR.EQ.'YES')GOTO19000
28449        DO11703I=1,NITEMX
28450          TEMP1(I)=TEMP91(I)
28451          IF(ICASL7.EQ.'TIQF')TEMP1(I)=TEMP92(I)
28452          TEMP2(I)=TEMP3(I)
2845311703   CONTINUE
28454      ELSEIF(ICASL7.EQ.'LAPT')THEN
28455CCCCC   ITCASE='LT'
28456CCCCC   CALL LAPTRA(TEMP1,NS1,ITCASE,IWRITE,TEMP2,NITEMX,
28457CCCCC1              IBUGA3,IERROR)
28458CCCCC   IF(IERROR.EQ.'YES')GOTO19000
28459CCCCC   DO11815I=1,NITEMX
28460CCCCC     TEMP1(I)=TEMP2(I)
28461C11815   CONTINUE
28462      ELSEIF(ICASL7.EQ.'ILAT')THEN
28463CCCCC   ITCASE='ILT'
28464CCCCC   CALL LAPTRA(TEMP1,NS1,ITCASE,IWRITE,TEMP2,NITEMX,
28465CCCCC               IBUGA3,IERROR)
28466CCCCC   IF(IERROR.EQ.'YES')GOTO19000
28467CCCCC   DO11825I=1,NITEMX
28468CCCCC     TEMP1(I)=TEMP2(I)
28469C11825  CONTINUE
28470      ELSEIF(ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
28471     1       ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI'.OR.
28472     1       ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
28473     1       ICASL7.EQ.'CORO'.OR.ICASL7.EQ.'COR1'.OR.
28474     1       ICASL7.EQ.'COCO')THEN
28475        IF(ICASL7.EQ.'COR1')THEN
28476          DO11832I=1,NS1
28477            TEMP2(I)=0.0
2847811832     CONTINUE
28479        ENDIF
28480        IACASE=ICASL7
28481        CALL COMARI(TEMP1,TEMP2,TEMP3,TEMP4,NS1,IACASE,IWRITE,
28482     1              TEMP91,TEMP92,NITEMX,SCAL91,ITYP91,
28483     1              IBUGA3,ISUBRO,IERROR)
28484        IF(IERROR.EQ.'YES')GOTO19000
28485        IF(ITYP91.EQ.'SCAL')GOTO11839
28486        DO11835I=1,NITEMX
28487          TEMP1(I)=TEMP91(I)
28488          TEMP2(I)=TEMP92(I)
2848911835   CONTINUE
28490        NITEMX=NINEW
28491        IF(ICASL7.EQ.'CORO')NITEMX=NITEMX-1
28492        IF(ICASL7.EQ.'COR1')NITEMX=NITEMX-1
2849311839   CONTINUE
28494      ELSEIF(ICASL7.EQ.'POAD'.OR.ICASL7.EQ.'POSU'.OR.
28495     1       ICASL7.EQ.'POMU'.OR.ICASL7.EQ.'PODI'.OR.
28496     1       ICASL7.EQ.'POSQ'.OR.ICASL7.EQ.'POSR'.OR.
28497     1       ICASL7.EQ.'POGC'.OR.ICASL7.EQ.'POLC'.OR.
28498     1       ICASL7.EQ.'POEV')THEN
28499        IACASE=ICASL7
28500        CALL POLARI(TEMP1,TEMP2,TEMP2,TEMP2,NS1,NS2,IACASE,IWRITE,
28501     1              TEMP91,TEMP92,NITEMX,NITE2X,SCAL91,ITYP91,
28502     1              DTEMP1,DTEMP2,DTEMP3,
28503     1              IBUGA3,ISUBRO,IERROR)
28504        IF(IERROR.EQ.'YES')GOTO19000
28505        IF(ITYP91.EQ.'SCAL')GOTO11849
28506        DO11844I=1,NITEMX
28507          TEMP1(I)=TEMP91(I)
2850811844   CONTINUE
28509        IF(ICASL7.EQ.'PODI')THEN
28510          DO11846I=1,NITE2X
28511            TEMP2(I)=TEMP92(I)
2851211846     CONTINUE
28513        ENDIF
2851411849   CONTINUE
28515      ELSEIF(ICASL7.EQ.'VEAD'.OR.ICASL7.EQ.'VESU'.OR.
28516     1       ICASL7.EQ.'VEDP'.OR.ICASL7.EQ.'VECP'.OR.
28517     1       ICASL7.EQ.'VELE'.OR.ICASL7.EQ.'VEDI'.OR.
28518     1       ICASL7.EQ.'VEAN')THEN
28519        IACASE=ICASL7
28520        CALL VECARI(TEMP1,TEMP2,NS1,IACASE,IWRITE,
28521     1              TEMP91,NITEMX,SCAL91,ITYP91,IBUGA3,ISUBRO,IERROR)
28522        IF(IERROR.EQ.'YES')GOTO19000
28523        IF(ITYP91.EQ.'SCAL')GOTO11859
28524        DO11855I=1,NITEMX
28525          TEMP1(I)=TEMP91(I)
2852611855   CONTINUE
2852711859   CONTINUE
28528      ELSEIF(ICASL7.EQ.'SEUN'.OR.ICASL7.EQ.'SEIN'.OR.
28529     1       ICASL7.EQ.'SECO'.OR.ICASL7.EQ.'SECA'.OR.
28530     1       ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'SEEL')THEN
28531        IACASE=ICASL7
28532        CALL SETARI(TEMP1,TEMP2,NS1,NS2,IACASE,IWRITE,
28533     1              TEMP91,TEMP92,NITEMX,SCAL91,ITYP91,
28534     1              TEMP21,TEMP22,
28535     1              IBUGA3,ISUBRO,IERROR)
28536        IF(IERROR.EQ.'YES')GOTO19000
28537        IF(ITYP91.EQ.'SCAL')GOTO11869
28538        DO11865I=1,NITEMX
28539          TEMP1(I)=TEMP91(I)
28540          TEMP2(I)=TEMP92(I)
2854111865   CONTINUE
2854211869   CONTINUE
28543      ELSEIF(ICASL7.EQ.'LOAN'.OR.ICASL7.EQ.'LOOR'.OR.
28544     1       ICASL7.EQ.'LONA'.OR.ICASL7.EQ.'LONO'.OR.
28545     1       ICASL7.EQ.'LOIM'.OR.ICASL7.EQ.'LOEQ'.OR.
28546     1       ICASL7.EQ.'LONT'.OR.ICASL7.EQ.'LOXO')THEN
28547        IACASE=ICASL7
28548        CALL LOGARI(TEMP1,TEMP2,NS1,IACASE,IWRITE,
28549     1              TEMP91,NITEMX,SCAL91,ITYP91,IBUGA3,ISUBRO,IERROR)
28550        IF(IERROR.EQ.'YES')GOTO19000
28551        IF(ITYP91.EQ.'SCAL')GOTO11879
28552        DO11875I=1,NITEMX
28553          TEMP1(I)=TEMP91(I)
2855411875   CONTINUE
2855511879   CONTINUE
28556      ELSEIF(ICASL7.EQ.'FRAC')THEN
28557        IPROD=4*NS1
28558        IF(IPROD.GT.MAXOBV)THEN
28559          WRITE(ICOUT,999)
28560          CALL DPWRST('XXX','BUG ')
28561          WRITE(ICOUT,11511)
2856211511     FORMAT('***** ERROR 11511 IN DPMATC--')
28563          CALL DPWRST('XXX','BUG ')
28564          WRITE(ICOUT,11512)
2856511512     FORMAT('      THE NEW FRACTAL VARIABLES WOULD BE ')
28566          CALL DPWRST('XXX','BUG ')
28567          WRITE(ICOUT,11513)
2856811513     FORMAT('      TOO LONG (THAT IS, WOULD EXCEED ',I8,')')
28569          CALL DPWRST('XXX','BUG ')
28570          IERROR='YES'
28571          GOTO9000
28572        ENDIF
28573C
28574        CALL FRACTA(TEMP1,TEMP2,NS1,IWRITE,
28575     1              TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
28576        IF(IERROR.EQ.'YES')GOTO19000
28577        DO11519I=1,NITEMX
28578          TEMP1(I)=TEMP91(I)
28579          TEMP2(I)=TEMP92(I)
2858011519   CONTINUE
28581      ELSEIF(ICASL7.EQ.'BOOT')THEN
28582        CALL BOOTSS(TEMP1,TEMP2,NS1,IWRITE,
28583     1              TEMP91,NITEMX,
28584     1              TEMP21,TEMP22,
28585     1              IBUGA3,ISUBRO,IERROR)
28586        DO11525I=1,NITEMX
28587          TEMP1(I)=TEMP91(I)
2858811525   CONTINUE
28589      ELSEIF(ICASL7.EQ.'SUBS')THEN
28590        CALL SUBSAM(TEMP1,TEMP2,NS1,NS2,IWRITE,
28591     1              TEMP91,NITEMX,IBUGA3,ISUBRO,IERROR)
28592        DO11535I=1,NITEMX
28593          TEMP1(I)=TEMP91(I)
2859411535   CONTINUE
28595      ELSEIF(ICASL7.EQ.'NNE1' .OR. ICASL7.EQ.'NNE2' .OR.
28596     1       ICASL7.EQ.'NNE3' .OR. ICASL7.EQ.'NNE4')THEN
28597        CALL NEARNE(TEMP1,TEMP2,NS1,TEMP91,TEMP92,
28598     1              IBUGA3,ISUBRO,IERROR)
28599        NITEMX=NS1
28600        IF(ICASL7.EQ.'NNE1' .OR. ICASL7.EQ.'NNE4')THEN
28601          DO11541I=1,NITEMX
28602            TEMP1(I)=TEMP91(I)
2860311541     CONTINUE
28604        ELSEIF(ICASL7.EQ.'NNE2')THEN
28605          DO11543I=1,NITEMX
28606            TEMP1(I)=TEMP92(I)
2860711543     CONTINUE
28608        ELSEIF(ICASL7.EQ.'NNE3')THEN
28609          DO11544I=1,NITEMX
28610            TEMP1(I)=TEMP91(I)
28611            TEMP2(I)=TEMP92(I)
2861211544     CONTINUE
28613        ENDIF
28614      ELSEIF(ICASL7.EQ.'FNNE' .OR. ICASL7.EQ.'ANNE')THEN
28615        ICASET=1
28616        IF(ICASL7.EQ.'ANNE')ICASET=2
28617        CALL NEARN2(TEMP1,TEMP2,NS1,TEMP3,TEMP4,NS3,ICASET,MAXOBV,
28618     1              TEMP24,TEMP5,TEMP7,TEMP8,TEMP25,
28619     1              TEMP91,TEMP92,TEMP21,TEMP22,TEMP23,NITEMX,
28620     1              IBUGA3,ISUBRO,IERROR)
28621        IF(IERROR.EQ.'YES')GOTO9000
28622        IF(ICASL7.EQ.'FNNE')THEN
28623          DO11644I=1,NITEMX
28624            TEMP1(I)=TEMP91(I)
28625            TEMP2(I)=TEMP92(I)
28626            TEMP91(I)=TEMP21(I)
2862711644     CONTINUE
28628        ELSEIF(ICASL7.EQ.'ANNE')THEN
28629          DO11646I=1,NITEMX
28630            TEMP1(I)=TEMP91(I)
28631            TEMP2(I)=TEMP92(I)
28632            TEMP91(I)=TEMP21(I)
28633            TEMP92(I)=TEMP22(I)
28634            TEMP5(I)=TEMP23(I)
2863511646     CONTINUE
28636          NS4=NITEMX
28637          NS5=NITEMX
28638        ENDIF
28639      ELSEIF(ICASL7.EQ.'GEMU')THEN
28640        IACASE=ICASL7
28641CCCCC   CALL GENARI(TEMP1,TEMP2,TEMP3,TEMP4,NS1,NS3,ICASE,MAXOBV,
28642CCCCC1              TEMP91,TEMP92,NITEMX,NITE2X,SCAL91,ITYP91,
28643CCCCC1              IBUGA3,ISUBRO,IERROR)
28644        CALL GENARI(TEMP1,TEMP2,TEMP2,TEMP2,NS1,NS2,ICASE,IWRITE,
28645     1              TEMP91,TEMP92,NITEMX,NITE2X,SCAL91,ITYP91,
28646     1              IBUGA3,ISUBRO,IERROR)
28647        IF(IERROR.EQ.'YES')GOTO19000
28648        IF(ITYP91.EQ.'SCAL')GOTO11899
28649        DO11895I=1,NITEMX
28650          TEMP1(I)=TEMP91(I)
2865111895   CONTINUE
2865211899   CONTINUE
28653      GOTO11900
28654C
28655      ELSEIF(ICASL7.EQ.'JAIN')THEN
28656        CALL JACKIN(TEMPS(1),TEMPS(2),IWRITE,
28657     1              TEMP91,NITEMX,IBUGA3,ISUBRO,IERROR)
28658        DO11545I=1,NITEMX
28659          TEMP1(I)=TEMP91(I)
2866011545   CONTINUE
28661      ELSEIF(ICASL7.EQ.'FRAW')THEN
28662        CALL DPRAW(TEMP1,TEMP2,NS1,IWRITE,MAXOBV,TEMP3,NITEMX,
28663     1             IBUGA3,IERROR)
28664        IF(IERROR.EQ.'NO')THEN
28665          DO11555I=1,NITEMX
28666            TEMP1(I)=TEMP3(I)
2866711555     CONTINUE
28668        ENDIF
28669      ELSEIF(ICASL7.EQ.'CUSA' .OR. ICASL7.EQ.'CU1A')THEN
28670        ICASE='TWOS'
28671        IF(ICASL7.EQ.'CU1A')ICASE='ONES'
28672        CALL CUSARL(TEMP1,NS1,IWRITE,TEMP2,ICASE,IBUGA3,IERROR)
28673        DO21019I=1,NS1
28674          TEMP1(I)=TEMP2(I)
2867521019   CONTINUE
28676      ELSEIF(ICASL7.EQ.'SRTB')THEN
28677        CALL SRTMEA(TEMP1,TEMP2,NS1,ICASS7,
28678     1              MAXOBV,
28679     1              TEMP12,TEMP4,TEMP5,TEMP6,TEMP92,
28680     1              TEMP6(2*MAXOBV+1),TEMP6(3*MAXOBV+1),
28681     1              TEMP91,TEMP3,NUMSE1,
28682     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
28683     1              DTEMP1,DTEMP2,DTEMP3,
28684     1              ISUBRO,IBUGA3,IERROR)
28685        DO21031I=1,NS1
28686          TEMP1(I)=TEMP91(I)
2868721031   CONTINUE
28688        DO21033I=1,NUMSE1
28689          TEMP2(I)=TEMP3(I)
2869021033   CONTINUE
28691      ELSEIF(ICASL7.EQ.'MNRK'.OR.ICASL7.EQ.'MDRK')THEN
28692        CALL GRPRNK(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,TEMP8,
28693     1              NS1,NUMVAR,MAXOBV,ICASE,
28694     1              TEMP21,TEMP22,TEMP23,TEMP24,
28695     1              TEMP25,TEMP26,TEMP12,TEMPC1,
28696     1              ITEMP1,
28697     1              TEMP92,TEMP9,TEMP6(MAXOBV+1),TEMP6(2*MAXOBV+1),
28698     1              TEMP91,NITEMX,
28699     1              ISUBRO,IBUGA3,IERROR)
28700        NS1=NITEMX
28701        DO21034II=1,NITEMX
28702          TEMP1(II)=TEMP91(II)
2870321034   CONTINUE
28704      ELSEIF(ICASL7.EQ.'STAN'.OR.ICASL7.EQ.'ZSCO'.OR.
28705     1       ICASL7.EQ.'USCO'.OR.ICASL7.EQ.'LSTA'.OR.
28706     1       ICASL7.EQ.'LSST'.OR.ICASL7.EQ.'CRTA'.OR.
28707     1       ICASL7.EQ.'CTCU'.OR.
28708     1       ICASL7(1:2).EQ.'CT')THEN
28709C
28710        IF(ICASL7.EQ.'CTCU')THEN
28711          ICASE='CTCU'
28712          ICASE2=ICASL7
28713        ELSE
28714          ICASE='STAN'
28715          ICASE2='    '
28716          IF(ICASL7.EQ.'LSTA')ICASE='LOCA'
28717          IF(ICASL7.EQ.'LSST')ICASE='SCAL'
28718          IF(ICASL7.EQ.'ZSCO')ICASE='ZSCO'
28719          IF(ICASL7.EQ.'USCO')ICASE='USCO'
28720          IF(ICASL7(1:2).EQ.'CT')THEN
28721            ICASE='CRTA'
28722            ICASE2=ICASL7
28723          ENDIF
28724        ENDIF
28725C
28726        IF(ISTANR.LE.0 .OR. ICASS7(1:3).EQ.'GRO' .OR.
28727     1     ICASS7.EQ.'NUMB')THEN
28728          IF(ICASS7(1:3).EQ.'GRO')ISTANR=0
28729          IF(ICASS7.EQ.'NUMB')ISTANR=0
28730          CALL GRPSTA(TEMP1,TEMP1,TEMP1,
28731     1                TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,NS1,
28732     1                ISTANR,NUMVAR,
28733     1                ICASE,ICASE2,ICASS7,MAXOBV,
28734     1                TEMP21,TEMP22,TEMP23,TEMP24,
28735     1                TEMP6(MAXOBV+1),TEMP6(MAXOBV+2),
28736     1                TEMP26,TEMP12,TEMP12(MAXOBV+1),
28737     1                TEMPC1,TEMP25,TEMP8,
28738     1                TEMP91,
28739     1                ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
28740     1                DTEMP1,DTEMP2,DTEMP3,
28741     1                ISUBRO,IBUGA3,IERROR)
28742        ELSEIF(ISTANR.LE.1)THEN
28743          CALL GRPSTA(TEMP1,TEMP1,TEMP1,
28744     1                TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,NS1,
28745     1                ISTANR,NUMVAR,
28746     1                ICASE,ICASE2,ICASS7,MAXOBV,
28747     1                TEMP21,TEMP22,TEMP23,TEMP24,
28748     1                TEMP6(MAXOBV+1),TEMP6(MAXOBV+2),
28749     1                TEMP26,TEMP12,TEMP12(MAXOBV+1),
28750     1                TEMPC1,TEMP25,TEMP8,
28751     1                TEMP91,
28752     1                ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
28753     1                DTEMP1,DTEMP2,DTEMP3,
28754     1                ISUBRO,IBUGA3,IERROR)
28755        ELSEIF(ISTANR.LE.2)THEN
28756          CALL GRPSTA(TEMP1,TEMP2,TEMP2,
28757     1                TEMP3,TEMP4,TEMP5,TEMP6,TEMP7,TEMP8,NS1,
28758     1                ISTANR,NUMVAR,
28759     1                ICASE,ICASE2,ICASS7,MAXOBV,
28760     1                TEMP21,TEMP22,TEMP23,TEMP24,
28761     1                TEMP6(MAXOBV+1),TEMP6(MAXOBV+2),
28762     1                TEMP26,TEMP12,TEMP12(MAXOBV+1),
28763     1                TEMPC1,TEMP25,TEMP6(MAXOBV+3),
28764     1                TEMP91,
28765     1                ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
28766     1                DTEMP1,DTEMP2,DTEMP3,
28767     1                ISUBRO,IBUGA3,IERROR)
28768        ELSEIF(ISTANR.LE.3)THEN
28769          CALL GRPSTA(TEMP1,TEMP2,TEMP3,
28770     1                TEMP4,TEMP5,TEMP6,TEMP7,TEMP8,TEMP9,NS1,
28771     1                ISTANR,NUMVAR,
28772     1                ICASE,ICASE2,ICASS7,MAXOBV,
28773     1                TEMP21,TEMP22,TEMP23,TEMP24,
28774     1                TEMP6(MAXOBV+1),TEMP6(MAXOBV+2),
28775     1                TEMP26,TEMP12,TEMP12(MAXOBV+1),
28776     1                TEMPC1,TEMP25,TEMP6(MAXOBV+3),
28777     1                TEMP91,
28778     1                ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
28779     1                DTEMP1,DTEMP2,DTEMP3,
28780     1                ISUBRO,IBUGA3,IERROR)
28781        ENDIF
28782        DO21029I=1,NS1
28783          TEMP1(I)=TEMP91(I)
2878421029   CONTINUE
28785C
28786C       2018/07: IF SUBSET CLAUSE WAS USED, WANT NITEMX TO BE SIZE OF
28787C                ORIGINAL VARIABLE.  BUT USE "SET LET CROSS TABULATE
28788C                <EXPAND/COLLAPSE>" CONTROL THIS.
28789C
28790        NITEMX=NS1
28791        IF(ICTALT.EQ.'EXPA')THEN
28792          NITEMX=NIRIGH(1)
28793        ELSEIF(ICASL7.EQ.'ZSCO' .OR. ICASL7.EQ.'USCO' .OR.
28794     1         ICASL7.EQ.'STAN' .OR. ICASL7.EQ.'LSTA' .OR.
28795     1         ICASL7.EQ.'LSST' .OR. ICASL7.EQ.'LOCA' .OR.
28796     1         ICASL7.EQ.'SCAL')THEN
28797          NITEMX=NIRIGH(1)
28798        ENDIF
28799C
28800      ELSEIF(ICASL7.EQ.'MOVI')THEN
28801        IF(FILWID.EQ.CPUMIN)IFILWI=3
28802        IF(FILWID.NE.CPUMIN)IFILWI=INT(FILWID+0.5)
28803C
28804        CALL MOVSTA(TEMP1,TEMP2,TEMP3,NS1,NUMVAR,ICASS7,MAXOBV,
28805     1              ISEED,IQUAME,IQUASE,PSTAMV,
28806     1              IMOVEP,IMOVDI,IFILWI,
28807     1              TEMP21,TEMP22,TEMP23,
28808     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
28809     1              DTEMP1,DTEMP2,DTEMP3,
28810     1              TEMP91,NOUT,
28811     1              ISUBRO,IBUGA3,IERROR)
28812        NS1=NOUT
28813        NITEMX=NOUT
28814        DO21039I=1,NS1
28815          TEMP1(I)=TEMP91(I)
2881621039   CONTINUE
28817      ELSEIF(ICASL7.EQ.'WIND')THEN
28818C
28819C       EXTRACT THE SIZE OF THE INTERVAL
28820C
28821        IHREPL='NSIZ'
28822        IHREP2='E   '
28823        IHWUSE='P'
28824        MESSAG='NO'
28825        CALL CHECKN(IHREPL,IHREP2,IHWUSE,
28826     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
28827     1              NUMNAM,MAXNAM,
28828     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
28829        IF(IERROR.EQ.'YES')THEN
28830          IF(NS1.LE.1000)THEN
28831          ELSE
28832            NSIZE=NS1/100
28833          ENDIF
28834        ELSE
28835          NSIZE=INT(VALUE(ILOC)+0.5)
28836        ENDIF
28837C
28838        CALL WINSTA(TEMP1,TEMP2,TEMP3,NS1,NUMVAR,ICASS7,MAXOBV,
28839     1              ISEED,NSIZE,
28840     1              TEMP21,TEMP22,TEMP23,
28841     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
28842     1              DTEMP1,DTEMP2,DTEMP3,
28843     1              TEMP91,NOUT,
28844     1              ISUBRO,IBUGA3,IERROR)
28845        NS1=NOUT
28846        NITEMX=NOUT
28847        DO21037I=1,NS1
28848          TEMP1(I)=TEMP91(I)
2884921037   CONTINUE
28850      ELSEIF(ICASL7.EQ.'CUMU')THEN
28851C
28852        CALL CUMSTA(TEMP1,TEMP2,TEMP3,NS1,NUMVAR,ICASS7,MAXOBV,
28853     1              ISEED,ICSTSV,
28854     1              TEMP21,TEMP22,TEMP23,
28855     1              ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
28856     1              DTEMP1,DTEMP2,DTEMP3,
28857     1              TEMP91,NOUT,
28858     1              ISUBRO,IBUGA3,IERROR)
28859        NS1=NOUT
28860        NITEMX=NOUT
28861        DO21038I=1,NS1
28862          TEMP1(I)=TEMP91(I)
2886321038   CONTINUE
28864      ELSEIF(ICASL7.EQ.'EN')THEN
28865        IWRITE='OFF'
28866        CALL EN(TEMP1,TEMP2,TEMPS(3),TEMPS(4),NS1,IWRITE,TEMP91,
28867     1          IBUGA3,ISUBRO,IERROR)
28868C
28869        DO21041I=1,NS1
28870          TEMP1(I)=TEMP91(I)
2887121041   CONTINUE
28872      ELSEIF(ICASL7.EQ.'PA')THEN
28873        IWRITE='OFF'
28874        CALL PA(TEMP1,NS1,TEMPS(2),TEMPS(3),IWRITE,TEMP91,
28875     1          IBUGA3,ISUBRO,IERROR)
28876C
28877        DO21042I=1,NS1
28878          TEMP1(I)=TEMP91(I)
2887921042   CONTINUE
28880      ELSEIF(ICASL7.EQ.'DIPE')THEN
28881        IWRITE='OFF'
28882        CALL DIPERC(TEMP1,NS1,TEMPS(2),IWRITE,TEMP91,
28883     1              IBUGA3,ISUBRO,IERROR)
28884C
28885        DO21044I=1,NS1
28886          TEMP1(I)=TEMP91(I)
2888721044   CONTINUE
28888      ELSEIF(ICASL7.EQ.'IZSC' .OR. ICASL7.EQ.'ZPRI' .OR.
28889     1       ICASL7.EQ.'IZET' .OR. ICASL7.EQ.'EZPL' .OR.
28890     1       ICASL7.EQ.'EZMI')THEN
28891        XREF=CPUMIN
28892        UREF=CPUMIN
28893        SIGMA=CPUMIN
28894        IF(ICASL7.EQ.'IZSC')THEN
28895          ICASET=1
28896          XREF=TEMPS(2)
28897          SIGMA=TEMPS(3)
28898        ELSEIF(ICASL7.EQ.'ZPRI')THEN
28899          ICASET=2
28900          XREF=TEMPS(2)
28901          SIGMA=TEMPS(3)
28902          UREF=TEMPS(4)
28903        ELSEIF(ICASL7.EQ.'IZET')THEN
28904          ICASET=3
28905          XREF=TEMPS(3)
28906          UREF=TEMPS(4)
28907        ELSEIF(ICASL7.EQ.'EZMI')THEN
28908          ICASET=4
28909          XREF=TEMPS(3)
28910          UREF=TEMPS(4)
28911        ELSEIF(ICASL7.EQ.'EZPL')THEN
28912          ICASET=5
28913          XREF=TEMPS(3)
28914          UREF=TEMPS(4)
28915        ENDIF
28916        IWRITE='OFF'
28917        CALL ZSCORE(TEMP1,TEMP2,XREF,UREF,SIGMA,NS1,ICASET,IWRITE,
28918     1              TEMP91,
28919     1              IBUGA3,ISUBRO,IERROR)
28920C
28921        DO21043I=1,NS1
28922          TEMP1(I)=TEMP91(I)
2892321043   CONTINUE
28924      ELSEIF(ICASL7.EQ.'INSE')THEN
28925        AVAL=TEMPS(3)
28926        NLOC=INT(AVAL+0.1)
28927        CALL INSERT(TEMP1,NS1,TEMP2,NS2,NLOC,IWRITE,TEMP9,NOUT,MAXOBV,
28928     1              IINSOW,IBUGA3,ISUBRO,IERROR)
28929        DO21047I=1,NOUT
28930          TEMP1(I)=TEMP9(I)
2893121047   CONTINUE
28932        NITEMX=NOUT
28933      ELSEIF(ICASL7.EQ.'WINS')THEN
28934C
28935C        2012/10: FOR WINSORIZING, CAN SPECIFY EITHER A SPECIFIC NUMBER
28936C                 TO WINSORIZE OR A PERCENTAGE TO WINSORIZE.  CHECK FOR
28937C                 SPECIFIC NUMBER FIRST AND IF NOT SPECIFIED, CHECK FOR A
28938C                 PERCENTAGE.
28939C
28940        NTRIM1=-1
28941        NTRIM2=-1
28942        P1=-99.0
28943        P2=-99.0
28944C
28945        IHP='NTRI'
28946        IHP2='M1  '
28947        IHWUSE='P'
28948        MESSAG='NO'
28949        CALL CHECKN(IHP,IHP2,IHWUSE,
28950     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
28951     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
28952        IF(IERROR.EQ.'NO')THEN
28953          NTRIM1=INT(VALUE(ILOCP)+0.1)
28954          IF(NTRIM1.LT.0)NTRIM1=0
28955        ENDIF
28956C
28957        IHP='NTRI'
28958        IHP2='M2  '
28959        IHWUSE='P'
28960        MESSAG='NO'
28961        CALL CHECKN(IHP,IHP2,IHWUSE,
28962     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
28963     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
28964        IF(IERROR.EQ.'NO')THEN
28965          NTRIM2=INT(VALUE(ILOCP)+0.1)
28966          IF(NTRIM2.LT.0)NTRIM2=0
28967        ENDIF
28968C
28969        IF(NTRIM1.LE.0)THEN
28970          IHP='P1  '
28971          IHP2='    '
28972          IHWUSE='P'
28973          MESSAG='YES'
28974          CALL CHECKN(IHP,IHP2,IHWUSE,
28975     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
28976     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
28977          IF(IERROR.EQ.'YES')GOTO9000
28978          IF(PROP1.LT.0.0 .OR. PROP1.GT.100.0)THEN
28979            WRITE(ICOUT,999)
28980            CALL DPWRST('XXX','BUG ')
28981            WRITE(ICOUT,21061)
2898221061       FORMAT('***** ERROR IN DPMATC--')
28983            CALL DPWRST('XXX','BUG ')
28984            WRITE(ICOUT,21062)
2898521062       FORMAT('      THE PROPORTION FOR WINSORIZING BELOW MUST')
28986            CALL DPWRST('XXX','BUG ')
28987            WRITE(ICOUT,21063)
2898821063       FORMAT('      BE BETWEEN 0 AND 100, BUT WAS NOT.')
28989            CALL DPWRST('XXX','BUG ')
28990            WRITE(ICOUT,21064)PROP1
2899121064       FORMAT('      PARAMETER P1 = LOWER PROPORTION = ',G15.7)
28992            CALL DPWRST('XXX','BUG ')
28993            WRITE(ICOUT,21065)
2899421065       FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P1 AS IN')
28995            CALL DPWRST('XXX','BUG ')
28996            WRITE(ICOUT,21066)
2899721066       FORMAT('      LET P1 = 25')
28998            CALL DPWRST('XXX','BUG ')
28999            IERROR='YES'
29000            GOTO9000
29001          ELSE
29002            PROP1=VALUE(ILOCP)
29003          ENDIF
29004        ENDIF
29005C
29006        IF(NTRIM2.LE.0)THEN
29007          IHP='P2  '
29008          IHP2='    '
29009          IHWUSE='P'
29010          MESSAG='YES'
29011          CALL CHECKN(IHP,IHP2,IHWUSE,
29012     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
29013     1                ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
29014          IF(IERROR.EQ.'YES')GOTO9000
29015          IF(PROP2.LT.0.0 .OR. PROP2.GT.100.0)THEN
29016            WRITE(ICOUT,999)
29017            CALL DPWRST('XXX','BUG ')
29018            WRITE(ICOUT,21061)
29019            CALL DPWRST('XXX','BUG ')
29020            WRITE(ICOUT,21072)
2902121072       FORMAT('      THE PROPORTION FOR WINSORIZING ABOVE MUST')
29022            CALL DPWRST('XXX','BUG ')
29023            WRITE(ICOUT,21063)
29024            CALL DPWRST('XXX','BUG ')
29025            WRITE(ICOUT,21074)PROP2
2902621074       FORMAT('      PARAMETER P2 = LOWER PROPORTION = ',G15.7)
29027            CALL DPWRST('XXX','BUG ')
29028            WRITE(ICOUT,21075)
2902921075       FORMAT('      USE THE LET COMMAND TO PRE-DEFINE P2 AS IN')
29030            CALL DPWRST('XXX','BUG ')
29031            WRITE(ICOUT,21076)
2903221076       FORMAT('      LET P2 = 25')
29033            CALL DPWRST('XXX','BUG ')
29034            IERROR='YES'
29035            GOTO9000
29036          ELSE
29037            PROP2=VALUE(ILOCP)
29038          ENDIF
29039        ENDIF
29040C
29041        CALL WINSOR(TEMP1,NS1,PROP1,PROP2,NTRIM1,NTRIM2,IWRITE,
29042     1              TEMP2,MAXOBV,TEMP3,
29043     1              IBUGA3,ISUBRO,IERROR)
29044C
29045        DO21059I=1,NS1
29046          TEMP1(I)=TEMP3(I)
2904721059   CONTINUE
29048      ELSEIF(ICASL7.EQ.'CFRT')THEN
29049        IHP='MINS'
29050        IHP2='IZE '
29051        IHWUSE='P'
29052        MESSAG='NO'
29053        CALL CHECKN(IHP,IHP2,IHWUSE,
29054     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
29055     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
29056        IF(IERROR.EQ.'YES')THEN
29057          MINSIZ=5
29058        ELSE
29059          MINSIZ=INT(VALUE(ILOCP)+0.5)
29060          IF(MINSIZ.LE.0)MINSIZ=5
29061        ENDIF
29062C
29063        CALL DPCOMB(TEMP1,TEMP2,NS1,MINSIZ,
29064     1              TEMP91,TEMP92,TEMP5,NITEMX,IBUGA3,IERROR)
29065        IF(IERROR.EQ.'YES')GOTO19000
29066        DO22016I=1,NITEMX
29067          TEMP1(I)=TEMP91(I)
29068          TEMP2(I)=TEMP92(I)
29069          TEMP91(I)=TEMP5(I)
2907022016   CONTINUE
29071      ELSEIF(ICASL7.EQ.'JOIN')THEN
29072        CALL JOIN(TEMP1,TEMP2,TEMP3,NS1,TEMP91,TEMP92,TEMP5,N3,MAXOBV,
29073     1            IBUGA3,ISUBRO,IERROR)
29074        IF(IERROR.EQ.'YES')GOTO19000
29075        NITEMX=N3
29076        DO22116I=1,NITEMX
29077          TEMP1(I)=TEMP91(I)
29078          TEMP2(I)=TEMP92(I)
29079          TEMP91(I)=TEMP5(I)
2908022116   CONTINUE
29081      ELSEIF(ICASL7.EQ.'MWUF')THEN
29082        NS1=INT(TEMPS(1)+0.5)
29083        NS2=INT(TEMPS(2)+0.5)
29084        CALL UDIST(NS1,NS2,TEMP2,TEMP91,MAXOBV,TEMP5,MAXOBV,IFAULT)
29085        IF(IFAULT.GT.0)GOTO19000
29086        NITEMX=NS1*NS2+1
29087        DO22017I=1,NITEMX
29088          TEMP1(I)=REAL(I-1)
2908922017   CONTINUE
29090      ELSEIF(ICASL7.EQ.'IFRT')THEN
29091        IHP='MINS'
29092        IHP2='IZE '
29093        IHWUSE='P'
29094        MESSAG='NO'
29095        CALL CHECKN(IHP,IHP2,IHWUSE,
29096     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
29097     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
29098        IF(IERROR.EQ.'YES')THEN
29099          MINSIZ=5
29100        ELSE
29101          MINSIZ=INT(VALUE(ILOCP)+0.5)
29102          IF(MINSIZ.LE.0)MINSIZ=5
29103        ENDIF
29104C
29105        CALL DPICOM(TEMP1,TEMP2,NS1,MINSIZ,
29106     1              TEMP91,TEMP92,TEMP5,NITEMX,
29107     1              ISUBRO,IBUGA3,IERROR)
29108        IF(IERROR.EQ.'YES')GOTO19000
29109        DO22216I=1,NITEMX
29110          TEMP1(I)=TEMP91(I)
29111          TEMP2(I)=TEMP92(I)
29112          TEMP91(I)=TEMP5(I)
2911322216   CONTINUE
29114      ELSEIF(ICASL7.EQ.'HCON')THEN
29115        CALL HCONS(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,NS1,IWRITE,
29116     1             TEMP91,NITEMX,ISUBRO,IBUGA3,IERROR)
29117        DO22029I=1,NITEMX
29118          TEMP1(I)=TEMP91(I)
2911922029   CONTINUE
29120      ELSEIF(ICASL7.EQ.'KCON')THEN
29121        CALL KCONS(TEMP1,TEMP2,TEMP3,TEMP4,NS1,IWRITE,
29122     1             TEMP91,NITEMX,ISUBRO,IBUGA3,IERROR)
29123        DO22039I=1,NITEMX
29124          TEMP1(I)=TEMP91(I)
2912522039   CONTINUE
29126      ELSEIF(ICASL7.EQ.'HCO2')THEN
29127        CALL HCONS2(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP12,
29128     1              NS1,IWRITE,
29129     1              TEMP91,TEMP92,TEMP9,NITEMX,ISUBRO,IBUGA3,IERROR)
29130        DO22049I=1,NITEMX
29131          TEMP1(I)=TEMP91(I)
29132          TEMP2(I)=TEMP9(I)
29133          TEMP91(I)=TEMP92(I)
2913422049   CONTINUE
29135      ELSEIF(ICASL7.EQ.'KCO2')THEN
29136        CALL KCONS2(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
29137     1              NS1,IWRITE,
29138     1              TEMP91,TEMP92,TEMP9,NITEMX,ISUBRO,IBUGA3,IERROR)
29139        DO22059I=1,NITEMX
29140          TEMP1(I)=TEMP91(I)
29141          TEMP2(I)=TEMP9(I)
29142          TEMP91(I)=TEMP92(I)
2914322059   CONTINUE
29144      ELSEIF(ICASL7.EQ.'LMOM')THEN
29145        NMOM=INT(TEMPS(2)+0.5)
29146        IF(NMOM.LE.0)NMOM=4
29147        IF(NMOM.GT.100)NMOM=100
29148        IF(NMOM.GE.NS1)NMOM=NS1
29149        DO22061I=1,NS1
29150          DTEMP1(I)=DBLE(TEMP1(I))
2915122061   CONTINUE
29152        CALL SAMLMU(DTEMP1,NS1,DTEMP2,NMOM)
29153        DO22063I=1,NMOM
29154          TEMP1(I)=REAL(DTEMP2(I))
2915522063   CONTINUE
29156        NITEMX=NMOM
29157      ELSEIF(ICASL7.EQ.'PWMO')THEN
29158        NMOM=INT(TEMPS(2)+0.5)
29159        IF(NMOM.LE.0)NMOM=4
29160        IF(NMOM.GT.20)NMOM=20
29161        IF(NMOM.GE.NS1)NMOM=NS1
29162        ATEMP=0.0D0
29163        BTEMP=0.0D0
29164        IKIND=1
29165        DO22071I=1,NS1
29166          DTEMP1(I)=DBLE(TEMP1(I))
2916722071   CONTINUE
29168        CALL SAMPWM(DTEMP1,NS1,DTEMP2,NMOM,ATEMP,BTEMP,IKIND)
29169        DO22073I=1,NMOM
29170          TEMP1(I)=REAL(DTEMP2(I))
2917122073   CONTINUE
29172        NITEMX=NMOM
29173      ELSEIF(ICASL7.EQ.'BPWM')THEN
29174        NMOM=INT(TEMPS(2)+0.5)
29175        IF(NMOM.LE.0)NMOM=4
29176        IF(NMOM.GT.20)NMOM=20
29177        IF(NMOM.GE.NS1)NMOM=NS1
29178        ATEMP=0.0D0
29179        BTEMP=0.0D0
29180        IKIND=2
29181        DO22081I=1,NS1
29182          DTEMP1(I)=DBLE(TEMP1(I))
2918322081   CONTINUE
29184        CALL SAMPWM(DTEMP1,NS1,DTEMP2,NMOM,ATEMP,BTEMP,IKIND)
29185        DO22083I=1,NMOM
29186          TEMP1(I)=REAL(DTEMP2(I))
2918722083   CONTINUE
29188        NITEMX=NMOM
29189      ELSEIF(ICASL7.EQ.'WMOM')THEN
29190        XMEAN=TEMP1(1)
29191        XSD=TEMP1(2)
29192        XSKEW=TEMP1(3)
29193        XMIN=TEMP1(4)
29194        NTEMP=INT(TEMP1(5)+0.1)
29195        CALL WEIMO1(XMEAN,XSD,XMIN,XSKEW,NTEMP,PSTAMV,
29196     1              ALOCMO,SCALMO,SHAPMO,
29197     1              ALOCMM,SCALMM,SHAPMM,
29198     1              SCALM2,SHAPM2,
29199     1              ISUBRO,IBUGA3,IERROR)
29200C
29201        TEMP1(1)=ALOCMO
29202        TEMP1(2)=SCALMO
29203        TEMP1(3)=SHAPMO
29204        TEMP1(4)=ALOCMM
29205        TEMP1(5)=SCALMM
29206        TEMP1(6)=SHAPMM
29207        TEMP1(7)=SCALM2
29208        TEMP1(8)=SHAPM2
29209        NS1=8
29210        NITEMX=NS1
29211      ELSEIF(ICASL7.EQ.'LNMO')THEN
29212        XMEAN=TEMP1(1)
29213        XSD=TEMP1(2)
29214        XSKEW=TEMP1(3)
29215        XMIN=TEMP1(4)
29216        NTEMP=INT(TEMP1(5)+0.1)
29217        CALL LGNMO1(XMEAN,XSD,XMIN,XSKEW,NTEMP,PSTAMV,
29218     1              ALOCMO,SCALMO,SHAPMO,UHATMO,
29219     1              ALOCMM,SCALMM,SHAPMM,UHATMM,
29220     1              ISUBRO,IBUGA3,IERROR)
29221C
29222        TEMP1(1)=ALOCMO
29223        TEMP1(2)=SCALMO
29224        TEMP1(3)=SHAPMO
29225        TEMP1(4)=UHATMO
29226        TEMP1(5)=ALOCMM
29227        TEMP1(6)=SCALMM
29228        TEMP1(7)=SHAPMM
29229        TEMP1(8)=UHATMM
29230        NS1=8
29231        NITEMX=NS1
29232      ELSEIF(ICASL7.EQ.'GAMO')THEN
29233        XMEAN=TEMP1(1)
29234        XSD=TEMP1(2)
29235        XSKEW=TEMP1(3)
29236        XMIN=TEMP1(4)
29237        NTEMP=INT(TEMP1(5)+0.1)
29238        CALL GAMMO1(XMEAN,XSD,XMIN,XSKEW,NTEMP,PSTAMV,
29239     1              ALOCMO,SCALMO,SHAPMO,
29240     1              ALOCMM,SCALMM,SHAPMM,
29241     1              ISUBRO,IBUGA3,IERROR)
29242C
29243        TEMP1(1)=ALOCMO
29244        TEMP1(2)=SCALMO
29245        TEMP1(3)=SHAPMO
29246        TEMP1(4)=ALOCMM
29247        TEMP1(5)=SCALMM
29248        TEMP1(6)=SHAPMM
29249        NS1=6
29250        NITEMX=NS1
29251      ELSEIF(ICASL7.EQ.'IGMO')THEN
29252        XMEAN=TEMP1(1)
29253        XSD=TEMP1(2)
29254        XSKEW=TEMP1(3)
29255        XMIN=TEMP1(4)
29256        NTEMP=INT(TEMP1(5)+0.1)
29257        CALL IGMO1(XMEAN,XSD,XMIN,XSKEW,NTEMP,PSTAMV,
29258     1             ALOCMO,AMUMO,SIGMMO,GAMMMO,
29259     1             ALOCMM,AMUMM,SIGMMM,GAMMMM,
29260     1             ISUBRO,IBUGA3,IERROR)
29261C
29262        TEMP1(1)=ALOCMO
29263        TEMP1(2)=AMUMO
29264        TEMP1(3)=SIGMMO
29265        TEMP1(4)=GAMMMO
29266        TEMP1(5)=ALOCMM
29267        TEMP1(6)=AMUMM
29268        TEMP1(7)=SIGMMM
29269        TEMP1(8)=GAMMMM
29270        NS1=8
29271        NITEMX=NS1
29272      ELSEIF(ICASL7.EQ.'LPFI' .OR. ICASL7.EQ.'HPFI')THEN
29273C
29274        IHP='FC  '
29275        IHP2='    '
29276        IHWUSE='P'
29277        MESSAG='NO'
29278        CALL CHECKN(IHP,IHP2,IHWUSE,
29279     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
29280     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
29281        IF(IERROR.EQ.'YES')THEN
29282          FC=0.05D0
29283        ELSE
29284          FC=DBLE(VALUE(ILOCP))
29285          IF(FC.LE.0.0D0 .OR. FC.GE.0.5D0)FC=0.05D0
29286        ENDIF
29287C
29288        IHP='KTER'
29289        IHP2='M   '
29290        IHWUSE='P'
29291        MESSAG='NO'
29292        CALL CHECKN(IHP,IHP2,IHWUSE,
29293     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
29294     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
29295        IF(IERROR.EQ.'YES')THEN
29296          KTERM=15
29297        ELSE
29298          KTERM=INT(VALUE(ILOCP)+0.5)
29299          IF(MOD(KTERM,2).EQ.0)KTERM=KTERM+1
29300          IF(KTERM.LT.3)KTERM=3
29301          IF(KTERM.GT.NS1)KTERM=NS1
29302        ENDIF
29303C
29304        DO22091I=1,NS1
29305          DTEMP1(I)=DBLE(TEMP1(I))
2930622091   CONTINUE
29307C
29308        IF(ICASL7.EQ.'LPFI')THEN
29309          CALL LOPASS(DTEMP1,NS1,FC,KTERM,DTEMP2,DTEMP3,NOUT,IERR2)
29310        ELSEIF(ICASL7.EQ.'LPFI')THEN
29311          CALL HIPASS(DTEMP1,NS1,FC,KTERM,DTEMP2,DTEMP3,NOUT,IERR2)
29312        ENDIF
29313C
29314        DO22093I=1,NOUT
29315          TEMP1(I)=REAL(DTEMP3(I))
2931622093   CONTINUE
29317        NS1=NOUT
29318        NITEMX=NS1
29319      ELSE
29320        WRITE(ICOUT,11301)
2932111301   FORMAT('***** INTERNAL ERROR 11301 IN DPMATC--')
29322        CALL DPWRST('XXX','BUG ')
29323        WRITE(ICOUT,11302)
2932411302   FORMAT('      NAME OF DESIRED DATA MANIPULATION OPERATION')
29325        CALL DPWRST('XXX','BUG ')
29326        WRITE(ICOUT,11303)
2932711303   FORMAT('      WAS FOUND IN INTERNAL LIST IN CKMATH, BUT JUMP')
29328        CALL DPWRST('XXX','BUG ')
29329        WRITE(ICOUT,11305)
2933011305   FORMAT('      TO APPROPRIATE SUBROUTINE DID NOT TAKE PLACE ',
29331     1         'IN DPMATC.')
29332        CALL DPWRST('XXX','BUG ')
29333        WRITE(ICOUT,11306)ICASL7
2933411306   FORMAT('ICASL7 = ',A4)
29335        CALL DPWRST('XXX','BUG ')
29336        IERROR='YES'
29337      ENDIF
29338      GOTO11900
29339C
29340C     -----BEGINNING OF MATH CALCULATIONS-----
29341C
2934211900 CONTINUE
29343      IFOUND='YES'
29344      IF(IERROR.EQ.'YES')GOTO19000
29345C
29346C
29347C               *****************************************************
29348C               **  STEP XX--                                      **
29349C               **  BRANCH TO THE PROPER CASE
29350C               **  DEPENDING ON THE TYPE OF OUTPUT--
29351C               **     1) SCALAR (= PARAMETER)
29352C               **     2) VECTOR (= VARIABLE) (THE USUAL)
29353C               **     3) MATRIX
29354C               **  UPDATE DATAPLOT'S INTERNAL WORKSPACE
29355C               **  AND HOUSEKEEPING TABLES
29356C               *****************************************************
29357C
29358C
29359C               *****************************************************
29360C               **  STEP 14--                                      **
29361C               **  TREAT THE PARAMETER (SCALAR) CASE.             **
29362C               **  EXAMPLE--LET D = DETERMINANT A                 **
29363C               **           WHERE A WAS PREVIOUSLY UNDEFINED      **
29364C               **           OR WHERE A WAS PREVIOUSLY A PARAMETER.**
29365C               **  CARRY OUT THE LIST UPDATING  AND               **
29366C               **  GENERATE THE INFORMATIVE PRINTING.             **
29367C               **  THEN EXIT.                                     **
29368C               *****************************************************
29369C
29370C     FEBRUARY 2007: AGRESTI-COULL LIMITS RETURNS TWO SCALAR
29371C                    VALUES.  CURRENTLY, LOGIC ONLY SUPPORTS
29372C                    ONE SCALAR OR TWO SCALAR OUTPUTS (I.E.,
29373C                    NO VECTOR-SCALAR).
29374      IF(ITYP91.EQ.'SCAL')THEN
29375        ISTEPN='14'
29376        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
29377     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29378C
29379        IHNAME(ILISL(1))=ILEFT(1)
29380        IHNAM2(ILISL(1))=ILEF2(1)
29381        IUSE(ILISL(1))='P'
29382        VALUE(ILISL(1))=SCAL91
29383C
29384C       2014/04: NEED TO ROUND DIFFERENTLY FOR NEGATIVE NUMBERS
29385C
29386        IF(VALUE(ILISL(1)).GE.0.0)THEN
29387          IVALUE(ILISL(1))=INT(VALUE(ILISL(1))+0.5)
29388        ELSE
29389          IVALUE(ILISL(1))=INT(VALUE(ILISL(1))-0.5)
29390        ENDIF
29391        IN(ILISL(1))=1
29392        IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
29393C
29394        IF(IPRINT.EQ.'ON' .AND. IFEEDB.EQ.'ON')THEN
29395          WRITE(ICOUT,999)
29396          CALL DPWRST('XXX','BUG ')
29397          WRITE(ICOUT,14011)ILEFT(1),ILEF2(1),SCAL91
2939814011     FORMAT('THE COMPUTED VALUE OF THE CONSTANT ',
29399     1           A4,A4,'      = ',G15.7)
29400          CALL DPWRST('XXX','BUG ')
29401          WRITE(ICOUT,999)
29402          CALL DPWRST('XXX','BUG ')
29403        ENDIF
29404C
29405        IF(ITYP92.EQ.'SCAL')THEN
29406          ISTEPN='14.B'
29407          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
29408     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29409C
29410          IHNAME(ILISL(2))=ILEFT(2)
29411          IHNAM2(ILISL(2))=ILEF2(2)
29412          IUSE(ILISL(2))='P'
29413          VALUE(ILISL(2))=SCAL92
29414CCCCC     IVALUE(ILISL(2))=VALUE(ILISL(2))+0.5
29415C
29416C       2014/04: NEED TO ROUND DIFFERENTLY FOR NEGATIVE NUMBERS
29417C
29418          IF(VALUE(ILISL(2)).GE.0.0)THEN
29419            IVALUE(ILISL(2))=INT(VALUE(ILISL(2))+0.5)
29420          ELSE
29421            IVALUE(ILISL(2))=INT(VALUE(ILISL(2))-0.5)
29422          ENDIF
29423          IN(ILISL(2))=1
29424          IF(NEWNAM(2).EQ.'YES')NUMNAM=NUMNAM+1
29425C
29426          IF(IPRINT.EQ.'ON' .AND. IFEEDB.EQ.'ON')THEN
29427            WRITE(ICOUT,999)
29428            CALL DPWRST('XXX','BUG ')
29429            WRITE(ICOUT,14011)ILEFT(2),ILEF2(2),SCAL92
29430            CALL DPWRST('XXX','BUG ')
29431            WRITE(ICOUT,999)
29432            CALL DPWRST('XXX','BUG ')
29433          ENDIF
29434        ENDIF
29435C
29436        IF(ITYP93.EQ.'SCAL')THEN
29437          ISTEPN='14.C'
29438          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
29439     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29440C
29441          IHNAME(ILISL(3))=ILEFT(3)
29442          IHNAM2(ILISL(3))=ILEF2(3)
29443          IUSE(ILISL(3))='P'
29444          VALUE(ILISL(3))=SCAL93
29445CCCCC     IVALUE(ILISL(3))=VALUE(ILISL(3))+0.5
29446C
29447C       2014/04: NEED TO ROUND DIFFERENTLY FOR NEGATIVE NUMBERS
29448C
29449          IF(VALUE(ILISL(3)).GE.0.0)THEN
29450            IVALUE(ILISL(3))=INT(VALUE(ILISL(3))+0.5)
29451          ELSE
29452            IVALUE(ILISL(3))=INT(VALUE(ILISL(3))-0.5)
29453          ENDIF
29454          IN(ILISL(3))=1
29455          IF(NEWNAM(3).EQ.'YES')NUMNAM=NUMNAM+1
29456C
29457          IF(IPRINT.EQ.'ON' .AND. IFEEDB.EQ.'ON')THEN
29458            WRITE(ICOUT,999)
29459            CALL DPWRST('XXX','BUG ')
29460            WRITE(ICOUT,14011)ILEFT(3),ILEF2(3),SCAL93
29461            CALL DPWRST('XXX','BUG ')
29462            WRITE(ICOUT,999)
29463            CALL DPWRST('XXX','BUG ')
29464          ENDIF
29465        ENDIF
29466C
29467        GOTO19000
29468      ENDIF
29469C
29470C     -----TREAT THE VECTOR AND MATRIX CASE-----
29471C
29472      ISTEPN='11.1'
29473      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
29474     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29475C
29476C     STORE FIRST VARIABLE ON THE LEFT
29477C
29478      NSX=0
29479      IF(NITEMX.LE.0)IROW1=0
29480      IF(NITEMX.LE.0)IROWN=0
29481      IF(NITEMX.LE.0)THEN
29482        IN(ILISL(1))=0
29483        GOTO12119
29484      ENDIF
29485C
29486      IF(IUPFLG.EQ.'FULL' .OR. ICASEQ.EQ.'FULL')THEN
29487        DO12105I=1,NITEMX
29488          ISUB(I)=1
2948912105   CONTINUE
29490        NIFOR=NITEMX
29491      ENDIF
29492C
29493CCCCC 5/2010: BUG IN "COPY" CASE.  FOR SYNTAX
29494CCCCC             LET Y = X  SUBSET TAG = 1
29495CCCCC         WE WANT TO MAINTAIN ORIGINAL ROWS OF Y THAT
29496CCCCC         ARE NOT AFFECTED BY THE SUBSET.
29497CCCCC
29498      IF(ICASL7.EQ.'COPV')THEN
29499        DO12115I=1,NITEMX
29500C
29501          IF(I.GT.NIFOR)GOTO12115
29502          IF(ISUB(I).EQ.0)GOTO12115
29503          NSX=NSX+1
29504C
29505          IJ=MAXN*(ICOLL(1)-1)+I
29506          IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(I)
29507          IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(I)
29508          IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(I)
29509          IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(I)
29510          IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(I)
29511          IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(I)
29512          IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(I)
29513C
2951412115   CONTINUE
29515        IROW1=1
29516        IROWN=NITEMX
29517      ELSE
29518        DO12110I=1,NITEMX
29519C
29520C         FOR SOME COMMANDS, MAY NEED TO SKIP SUBSET
29521C
29522          IF(ICASL7.EQ.'DIGI')GOTO12111
29523          IF(ICASL7.EQ.'DIST')GOTO12111
29524          IF(ICASL7.EQ.'BLOC')GOTO12111
29525          IF(ICASL7.EQ.'FLOC')GOTO12111
29526          IF(ICASL7.EQ.'FLEN')GOTO12111
29527          IF(ICASL7.EQ.'2DGR')GOTO12111
29528          IF(ICASL7.EQ.'3DGR')GOTO12111
29529          IF(ICASL7.EQ.'4DGR')GOTO12111
29530          IF(ICASL7.EQ.'CRTA' .AND. ICTALT.EQ.'COLL')GOTO12111
29531          IF(ICASL7.EQ.'CTAB' .AND. ICTALT.EQ.'COLL')GOTO12111
29532          IF(ICASL7.EQ.'MNRK' .AND. ICTALT.EQ.'COLL')GOTO12111
29533C
29534          IF(I.GT.NIFOR)GOTO12110
29535          IF(ISUB(I).EQ.0)GOTO12110
2953612111     CONTINUE
29537          NSX=NSX+1
29538C
29539          IJ=MAXN*(ICOLL(1)-1)+I
29540          IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(NSX)
29541          IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(NSX)
29542          IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(NSX)
29543          IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(NSX)
29544          IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(NSX)
29545          IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(NSX)
29546          IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(NSX)
29547C
29548          IF(NSX.EQ.1)IROW1=I
29549          IROWN=I
29550C
2955112110   CONTINUE
29552      ENDIF
29553C
29554      IN(ILISL(1))=NITEMX
29555C
2955612119 CONTINUE
29557C
29558C     STORE SECOND VARIABLE ON THE LEFT
29559C
29560      IF(ICASL7.EQ.'FOUT'.OR.ICASL7.EQ.'FOU1'.OR.
29561     1   ICASL7.EQ.'IFOU'.OR.ICASL7.EQ.'IFO1'.OR.
29562     1   ICASL7.EQ.'FFT' .OR.ICASL7.EQ.'FFT1'.OR.
29563     1   ICASL7.EQ.'IFFT'.OR.ICASL7.EQ.'IFF1'.OR.
29564     1   ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
29565     1   ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI'.OR.
29566     1   ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
29567     1   ICASL7.EQ.'CORO'.OR.ICASL7.EQ.'COR1'.OR.
29568     1   ICASL7.EQ.'COCO'.OR.ICASL7.EQ.'PODI'.OR.
29569     1   ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'FRAC'.OR.
29570     1   ICASL7.EQ.'BINN'.OR.ICASL7.EQ.'BINR'.OR.
29571     1   ICASL7.EQ.'CBIN'.OR.ICASL7.EQ.'CBIR'.OR.
29572     1   ICASL7.EQ.'BINP'.OR.ICASL7.EQ.'BIRP'.OR.
29573     1   ICASL7.EQ.'ASHC'.OR.ICASL7.EQ.'ASHR'.OR.
29574     1   ICASL7.EQ.'STAC'.OR.ICASL7.EQ.'RSTA'.OR.
29575     1   ICASL7.EQ.'CFRT'.OR.ICASL7.EQ.'HCO2'.OR.
29576     1   ICASL7.EQ.'IFRT'.OR.ICASL7.EQ.'2DCH'.OR.
29577     1   ICASL7.EQ.'EDGV'.OR.ICASL7.EQ.'NEPA'.OR.
29578     1   ICASL7.EQ.'NEXE'.OR.ICASL7.EQ.'CYTB'.OR.
29579     1   ICASL7.EQ.'SPF1'.OR.ICASL7.EQ.'SPF2'.OR.
29580     1   ICASL7.EQ.'AGCO'.OR.ICASL7.EQ.'DPCL'.OR.
29581     1   ICASL7.EQ.'R1TS'.OR.ICASL7.EQ.'R1LT'.OR.
29582     1   ICASL7.EQ.'R1UT'.OR.ICASL7.EQ.'EBCL'.OR.
29583     1   ICASL7.EQ.'R2TS'.OR.ICASL7.EQ.'R2LT'.OR.
29584     1   ICASL7.EQ.'R2UT'.OR.ICASL7.EQ.'BRAT'.OR.
29585     1   ICASL7.EQ.'R3TS'.OR.ICASL7.EQ.'R3LT'.OR.
29586     1   ICASL7.EQ.'R3UT'.OR.ICASL7.EQ.'BPSE'.OR.
29587     1   ICASL7.EQ.'SOR2'.OR.ICASL7.EQ.'SOR3'.OR.
29588     1   ICASL7.EQ.'SOR4'.OR.ICASL7.EQ.'MWUF'.OR.
29589     1   ICASL7.EQ.'TMIN'.OR.ICASL7.EQ.'TMAX'.OR.
29590     1   ICASL7.EQ.'TPOI'.OR.ICASL7.EQ.'EXTP'.OR.
29591     1   ICASL7.EQ.'ENCB'.OR.ICASL7.EQ.'INTL'.OR.
29592     1   ICASL7.EQ.'PARL'.OR.ICASL7.EQ.'PERL'.OR.
29593     1   ICASL7.EQ.'JOIN'.OR.ICASL7.EQ.'NNE3'.OR.
29594     1   ICASL7.EQ.'FNNE'.OR.ICASL7.EQ.'ANNE'.OR.
29595     1   ICASL7.EQ.'PEAK'.OR.ICASL7.EQ.'JSCT'.OR.
29596     1   ICASL7.EQ.'GSQD'.OR.ICASL7.EQ.'GSQS'.OR.
29597     1   ICASL7.EQ.'GSQP'.OR.ICASL7.EQ.'GSQM'.OR.
29598     1   ICASL7.EQ.'GQMN'.OR.ICASL7.EQ.'GQMX'.OR.
29599     1   ICASL7.EQ.'GSQL'.OR.ICASL7.EQ.'GSQU'.OR.
29600     1   ICASL7.EQ.'NKDM'.OR.ICASL7.EQ.'EQUF'.OR.
29601     1   ICASL7.EQ.'IQUF'.OR.ICASL7.EQ.'TIQF'.OR.
29602     1   ICASL7.EQ.'SRNP'.OR.ICASL7.EQ.'2DGR'.OR.
29603     1   ICASL7.EQ.'3DGR'.OR.ICASL7.EQ.'4DGR'.OR.
29604     1   ICASL7.EQ.'KCO2'.OR.ICASL7.EQ.'SRTB')THEN
29605C
29606        NSX=0
29607        NITEM2=NITEMX
29608        IF(ICASL7.EQ.'SRTB')NITEM2=NUMSE1
29609        IF(ICASL7.EQ.'PODI')NITEM2=NITE2X
29610        IF(ICASL7.EQ.'NEXE')NITEM2=NC
29611        IF(NITEM2.LE.0)IROW12=0
29612        IF(NITEM2.LE.0)IROWN2=0
29613        IF(NITEM2.LE.0)THEN
29614          IN(ILISL(2))=0
29615          GOTO12129
29616        ENDIF
29617C
29618        DO12120I=1,NITEM2
29619C
29620          IF(NITEM2.EQ.NITEMX)THEN
29621            IF(I.GT.NIFOR)GOTO12120
29622            IF(ISUB(I).EQ.0)GOTO12120
29623          ENDIF
29624          NSX=NSX+1
29625C
29626          IJ=MAXN*(ICOLL(2)-1)+I
29627          IF(ICOLL(2).LE.MAXCOL)V(IJ)=TEMP2(NSX)
29628          IF(ICOLL(2).EQ.MAXCP1)PRED(I)=TEMP2(NSX)
29629          IF(ICOLL(2).EQ.MAXCP2)RES(I)=TEMP2(NSX)
29630          IF(ICOLL(2).EQ.MAXCP3)YPLOT(I)=TEMP2(NSX)
29631          IF(ICOLL(2).EQ.MAXCP4)XPLOT(I)=TEMP2(NSX)
29632          IF(ICOLL(2).EQ.MAXCP5)X2PLOT(I)=TEMP2(NSX)
29633          IF(ICOLL(2).EQ.MAXCP6)TAGPLO(I)=TEMP2(NSX)
29634C
29635          IF(NSX.EQ.1)IROW12=I
29636          IROWN2=I
29637C
2963812120   CONTINUE
29639C
29640        IN(ILISL(2))=NITEM2
29641C
2964212129   CONTINUE
29643      ENDIF
29644C
29645      IF(ICASL7.EQ.'CFRT'.OR.ICASL7.EQ.'RSTA'.OR.
29646     1   ICASL7.EQ.'IFRT'.OR.ICASL7.EQ.'EDGV'.OR.
29647     1   ICASL7.EQ.'R1TS'.OR.ICASL7.EQ.'R1LT'.OR.
29648     1   ICASL7.EQ.'R1UT'.OR.ICASL7.EQ.'DPCL'.OR.
29649     1   ICASL7.EQ.'R2TS'.OR.ICASL7.EQ.'R2LT'.OR.
29650     1   ICASL7.EQ.'R2UT'.OR.ICASL7.EQ.'BRAT'.OR.
29651     1   ICASL7.EQ.'R3TS'.OR.ICASL7.EQ.'R3LT'.OR.
29652     1   ICASL7.EQ.'R3UT'.OR.ICASL7.EQ.'BPSE'.OR.
29653     1   ICASL7.EQ.'SOR3'.OR.ICASL7.EQ.'SOR4'.OR.
29654     1   ICASL7.EQ.'HCO2'.OR.ICASL7.EQ.'KCO2'.OR.
29655     1   ICASL7.EQ.'CBIN'.OR.ICASL7.EQ.'CBIR'.OR.
29656     1   ICASL7.EQ.'MWUF'.OR.ICASL7.EQ.'JOIN'.OR.
29657     1   ICASL7.EQ.'FNNE'.OR.ICASL7.EQ.'ANNE'.OR.
29658     1   ICASL7.EQ.'3DGR'.OR.ICASL7.EQ.'4DGR'.OR.
29659     1   ICASL7.EQ.'JSCT'.OR.
29660     1   ICASL7.EQ.'SPF1'.OR.ICASL7.EQ.'SPF2')THEN
29661C
29662        NSX=0
29663        NITEM3=NITEMX
29664        IF(ICASL7.EQ.'SPF2')NITEM3=NS3
29665        IF(ICASL7.EQ.'CBIN' .OR. ICASL7.EQ.'CBIR')NITEM3=NS1
29666        IF(NITEM3.LE.0)IROW13=0
29667        IF(NITEM3.LE.0)IROWN3=0
29668        IF(NITEM3.LE.0)THEN
29669          IN(ILISL(3))=0
29670          GOTO12139
29671        ENDIF
29672C
29673        DO12130I=1,NITEM3
29674C
29675          IF(NITEM3.EQ.NITEMX)THEN
29676            IF(I.GT.NIFOR)GOTO12130
29677            IF(ISUB(I).EQ.0)GOTO12130
29678          ENDIF
29679          NSX=NSX+1
29680C
29681          IJ=MAXN*(ICOLL(3)-1)+I
29682          IF(ICOLL(3).LE.MAXCOL)V(IJ)=TEMP91(NSX)
29683          IF(ICOLL(3).EQ.MAXCP1)PRED(I)=TEMP91(NSX)
29684          IF(ICOLL(3).EQ.MAXCP2)RES(I)=TEMP91(NSX)
29685          IF(ICOLL(3).EQ.MAXCP3)YPLOT(I)=TEMP91(NSX)
29686          IF(ICOLL(3).EQ.MAXCP4)XPLOT(I)=TEMP91(NSX)
29687          IF(ICOLL(3).EQ.MAXCP5)X2PLOT(I)=TEMP91(NSX)
29688          IF(ICOLL(3).EQ.MAXCP6)TAGPLO(I)=TEMP91(NSX)
29689C
29690          IF(NSX.EQ.1)IROW13=I
29691          IROWN3=I
29692C
2969312130   CONTINUE
29694C
29695        IN(ILISL(3))=NITEM3
29696C
2969712139   CONTINUE
29698      ENDIF
29699C
29700      IF(ICASL7.EQ.'SPF2'.OR.ICASL7.EQ.'SOR4'.OR.
29701     1   ICASL7.EQ.'4DGR'.OR.ICASL7.EQ.'ANNE')THEN
29702C
29703        NSX=0
29704        NITEM4=NS4
29705        IF(ICASL7.EQ.'4DGR')NITEM4=NITEMX
29706        IF(NITEM4.LE.0)THEN
29707          IROW14=0
29708          IROWN4=0
29709          IN(ILISL(4))=0
29710          GOTO12149
29711        ENDIF
29712C
29713        DO12140I=1,NITEM4
29714C
29715          IF(NITEM4.EQ.NITEMX)THEN
29716            IF(I.GT.NIFOR)GOTO12140
29717            IF(ISUB(I).EQ.0)GOTO12140
29718          ENDIF
29719          NSX=NSX+1
29720C
29721          IJ=MAXN*(ICOLL(4)-1)+I
29722          IF(ICOLL(4).LE.MAXCOL)V(IJ)=TEMP92(NSX)
29723          IF(ICOLL(4).EQ.MAXCP1)PRED(I)=TEMP92(NSX)
29724          IF(ICOLL(4).EQ.MAXCP2)RES(I)=TEMP92(NSX)
29725          IF(ICOLL(4).EQ.MAXCP3)YPLOT(I)=TEMP92(NSX)
29726          IF(ICOLL(4).EQ.MAXCP4)XPLOT(I)=TEMP92(NSX)
29727          IF(ICOLL(4).EQ.MAXCP5)X2PLOT(I)=TEMP92(NSX)
29728          IF(ICOLL(4).EQ.MAXCP6)TAGPLO(I)=TEMP92(NSX)
29729C
29730          IF(NSX.EQ.1)IROW14=I
29731          IROWN4=I
29732C
2973312140   CONTINUE
29734C
29735        IN(ILISL(4))=NITEM4
29736C
2973712149   CONTINUE
29738      ENDIF
29739C
29740      IF(ICASL7.EQ.'ANNE')THEN
29741C
29742        NSX=0
29743        NITEM5=NS5
29744        IF(NITEM5.LE.0)THEN
29745          IROW15=0
29746          IROWN5=0
29747          IN(ILISL(5))=0
29748          GOTO12159
29749        ENDIF
29750C
29751        DO12150I=1,NITEM5
29752C
29753          IF(NITEM5.EQ.NITEMX)THEN
29754            IF(I.GT.NIFOR)GOTO12150
29755            IF(ISUB(I).EQ.0)GOTO12150
29756          ENDIF
29757          NSX=NSX+1
29758C
29759          IJ=MAXN*(ICOLL(5)-1)+I
29760          IF(ICOLL(5).LE.MAXCOL)V(IJ)=TEMP5(NSX)
29761          IF(ICOLL(5).EQ.MAXCP1)PRED(I)=TEMP5(NSX)
29762          IF(ICOLL(5).EQ.MAXCP2)RES(I)=TEMP5(NSX)
29763          IF(ICOLL(5).EQ.MAXCP3)YPLOT(I)=TEMP5(NSX)
29764          IF(ICOLL(5).EQ.MAXCP4)XPLOT(I)=TEMP5(NSX)
29765          IF(ICOLL(5).EQ.MAXCP5)X2PLOT(I)=TEMP5(NSX)
29766          IF(ICOLL(5).EQ.MAXCP6)TAGPLO(I)=TEMP5(NSX)
29767C
29768          IF(NSX.EQ.1)IROW15=I
29769          IROWN5=I
29770C
2977112150   CONTINUE
29772C
29773        IN(ILISL(5))=NITEM5
29774C
2977512159   CONTINUE
29776      ENDIF
29777C
29778      DO12210J4=1,NUMNAM
29779        IF((IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(1)).OR.
29780     1     (IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(1)))THEN
29781          IUSE(J4)='V'
29782          IVALUE(J4)=ICOLL(1)
29783          VALUE(J4)=ICOLL(1)
29784          IN(J4)=NITEMX
29785          IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')THEN
29786            IVALUE(J4)=ICOLL(1)
29787CCCCC       IVALU2(J4)=ICOLL(1)+NC91-1
29788            IVALU2(J4)=ICOLL(1)
29789          ENDIF
29790        ENDIF
2979112210 CONTINUE
29792C
29793      IF(NUMVAL.GE.2)THEN
29794        DO12220J4=1,NUMNAM
29795          IF((IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(2)).OR.
29796     1       (IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(2)))THEN
29797            IUSE(J4)='V'
29798            IVALUE(J4)=ICOLL(2)
29799            VALUE(J4)=INT(ICOLL(2))
29800            IN(J4)=NITEM2
29801          ENDIF
2980212220   CONTINUE
29803      ENDIF
29804C
29805      IF(NUMVAL.GE.3)THEN
29806        DO12230J4=1,NUMNAM
29807          IF((IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(3)).OR.
29808     1       (IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(3)))THEN
29809            IUSE(J4)='V'
29810            IVALUE(J4)=ICOLL(3)
29811            VALUE(J4)=ICOLL(3)
29812            IN(J4)=NITEM3
29813          ENDIF
2981412230   CONTINUE
29815      ENDIF
29816C
29817      IF(NUMVAL.GE.4)THEN
29818        DO12240J4=1,NUMNAM
29819          IF((IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(4)).OR.
29820     1       (IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(4)))THEN
29821            IUSE(J4)='V'
29822            IVALUE(J4)=ICOLL(4)
29823            VALUE(J4)=ICOLL(4)
29824            IN(J4)=NITEM4
29825          ENDIF
2982612240   CONTINUE
29827      ENDIF
29828C
29829      IF(NUMVAL.GE.5)THEN
29830        DO12250J5=1,NUMNAM
29831          IF((IUSE(J5).EQ.'V'.AND.IVALUE(J5).EQ.ICOLL(5)).OR.
29832     1       (IUSE(J5).EQ.'M'.AND.IVALUE(J5).EQ.ICOLL(5)))THEN
29833            IUSE(J5)='V'
29834            IVALUE(J5)=ICOLL(5)
29835            VALUE(J5)=ICOLL(5)
29836            IN(J5)=NITEM5
29837          ENDIF
2983812250   CONTINUE
29839      ENDIF
29840C
29841C               *******************************************
29842C               **  STEP 16--                            **
29843C               **  TREAT THE VARIABLE (VECTOR) CASE--   **
29844C               **  CARRY OUT THE LIST UPDATING AND      **
29845C               **  GENERATE THE INFORMATIVE PRINTING    **
29846C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
29847C               *******************************************
29848C
29849      ISTEPN='16'
29850      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
29851     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
29852C
29853      IHNAME(ILISL(1))=ILEFT(1)
29854      IHNAM2(ILISL(1))=ILEF2(1)
29855      IUSE(ILISL(1))='V'
29856      IVALUE(ILISL(1))=ICOLL(1)
29857      VALUE(ILISL(1))=ICOLL(1)
29858      IF(NEWNAM(1).EQ.'YES')THEN
29859        NUMNAM=NUMNAM+1
29860        NUMCOL=NUMCOL+1
29861      ENDIF
29862C
29863      IF(NUMVAL.GE.2)THEN
29864        IHNAME(ILISL(2))=ILEFT(2)
29865        IHNAM2(ILISL(2))=ILEF2(2)
29866        IUSE(ILISL(2))='V'
29867        IVALUE(ILISL(2))=ICOLL(2)
29868        VALUE(ILISL(2))=ICOLL(2)
29869        IF(NEWNAM(2).EQ.'YES')THEN
29870          NUMNAM=NUMNAM+1
29871          NUMCOL=NUMCOL+1
29872        ENDIF
29873      ENDIF
29874C
29875      IF(NUMVAL.GE.3)THEN
29876        IHNAME(ILISL(3))=ILEFT(3)
29877        IHNAM2(ILISL(3))=ILEF2(3)
29878        IUSE(ILISL(3))='V'
29879        IVALUE(ILISL(3))=ICOLL(3)
29880        VALUE(ILISL(3))=ICOLL(3)
29881        IF(NEWNAM(3).EQ.'YES')THEN
29882          NUMNAM=NUMNAM+1
29883          NUMCOL=NUMCOL+1
29884        ENDIF
29885      ENDIF
29886C
29887      IF(NUMVAL.GE.4)THEN
29888        IHNAME(ILISL(4))=ILEFT(4)
29889        IHNAM2(ILISL(4))=ILEF2(4)
29890        IUSE(ILISL(4))='V'
29891        IVALUE(ILISL(4))=ICOLL(4)
29892        VALUE(ILISL(4))=ICOLL(4)
29893        IF(NEWNAM(4).EQ.'YES')THEN
29894          NUMNAM=NUMNAM+1
29895          NUMCOL=NUMCOL+1
29896        ENDIF
29897      ENDIF
29898C
29899      IF(NUMVAL.GE.5)THEN
29900        IHNAME(ILISL(5))=ILEFT(5)
29901        IHNAM2(ILISL(5))=ILEF2(5)
29902        IUSE(ILISL(5))='V'
29903        IVALUE(ILISL(5))=ICOLL(5)
29904        VALUE(ILISL(5))=ICOLL(5)
29905        IF(NEWNAM(5).EQ.'YES')THEN
29906          NUMNAM=NUMNAM+1
29907          NUMCOL=NUMCOL+1
29908        ENDIF
29909      ENDIF
29910C
29911      IF(IPRINT.EQ.'ON' .AND. IFEEDB.EQ.'ON')THEN
29912        WRITE(ICOUT,999)
29913        CALL DPWRST('XXX','BUG ')
29914C
29915        WRITE(ICOUT,16011)ILEFT(1),ILEF2(1),NSX
2991616011   FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
29917     1         'THE VARIABLE ',A4,A4,' = ',I8)
29918        CALL DPWRST('XXX','BUG ')
29919        WRITE(ICOUT,999)
29920        CALL DPWRST('XXX','BUG ')
29921        IJ=MAXN*(ICOLL(1)-1)+IROW1
29922        IF(ICOLL(1).LE.MAXCOL)THEN
29923          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),V(IJ),IROW1
29924          CALL DPWRST('XXX','BUG ')
29925        ELSEIF(ICOLL(1).EQ.MAXCP1)THEN
29926          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),PRED(IROW1),IROW1
2992716021     FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
29928     1           ' = ',E16.7,'   (ROW ',I6,')')
29929          CALL DPWRST('XXX','BUG ')
29930        ELSEIF(ICOLL(1).EQ.MAXCP2)THEN
29931          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),RES(IROW1),IROW1
29932          CALL DPWRST('XXX','BUG ')
29933        ELSEIF(ICOLL(1).EQ.MAXCP3)THEN
29934          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),YPLOT(IROW1),IROW1
29935          CALL DPWRST('XXX','BUG ')
29936        ELSEIF(ICOLL(1).EQ.MAXCP4)THEN
29937          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),XPLOT(IROW1),IROW1
29938          CALL DPWRST('XXX','BUG ')
29939        ELSEIF(ICOLL(1).EQ.MAXCP5)THEN
29940          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),X2PLOT(IROW1),IROW1
29941          CALL DPWRST('XXX','BUG ')
29942        ELSEIF(ICOLL(1).EQ.MAXCP6)THEN
29943          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),TAGPLO(IROW1),IROW1
29944          CALL DPWRST('XXX','BUG ')
29945        ENDIF
29946C
29947        IJ=MAXN*(ICOLL(1)-1)+IROWN
29948        IF(ICOLL(1).LE.MAXCOL.AND.NSX.NE.1)THEN
29949          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),V(IJ),IROWN
2995016031     FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
29951     1           ' = ',E16.7,'   (ROW ',I6,')')
29952          CALL DPWRST('XXX','BUG ')
29953        ELSEIF(ICOLL(1).EQ.MAXCP1.AND.NSX.NE.1)THEN
29954          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),PRED(IROWN),IROWN
29955          CALL DPWRST('XXX','BUG ')
29956        ELSEIF(ICOLL(1).EQ.MAXCP2.AND.NSX.NE.1)THEN
29957          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),RES(IROWN),IROWN
29958          CALL DPWRST('XXX','BUG ')
29959        ELSEIF(ICOLL(1).EQ.MAXCP3.AND.NSX.NE.1)THEN
29960          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),YPLOT(IROWN),IROWN
29961          CALL DPWRST('XXX','BUG ')
29962        ELSEIF(ICOLL(1).EQ.MAXCP4.AND.NSX.NE.1)THEN
29963          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),XPLOT(IROWN),IROWN
29964          CALL DPWRST('XXX','BUG ')
29965        ELSEIF(ICOLL(1).EQ.MAXCP5.AND.NSX.NE.1)THEN
29966          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),X2PLOT(IROWN),IROWN
29967          CALL DPWRST('XXX','BUG ')
29968        ELSEIF(ICOLL(1).EQ.MAXCP6.AND.NSX.NE.1)THEN
29969          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),TAGPLO(IROWN),IROWN
29970          CALL DPWRST('XXX','BUG ')
29971        ENDIF
29972        IF(NSX.EQ.1)THEN
29973          WRITE(ICOUT,16032)
2997416032     FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
29975          CALL DPWRST('XXX','BUG ')
29976          WRITE(ICOUT,16033)
2997716033     FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
29978          CALL DPWRST('XXX','BUG ')
29979        ENDIF
29980C
29981        IF(NUMVAL.GE.2)THEN
29982          WRITE(ICOUT,16011)ILEFT(2),ILEF2(2),NSX
29983          CALL DPWRST('XXX','BUG ')
29984          WRITE(ICOUT,999)
29985          CALL DPWRST('XXX','BUG ')
29986          IJ=MAXN*(ICOLL(2)-1)+IROW1
29987          IF(ICOLL(2).LE.MAXCOL)THEN
29988            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),V(IJ),IROW1
29989            CALL DPWRST('XXX','BUG ')
29990          ELSEIF(ICOLL(2).EQ.MAXCP1)THEN
29991            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),PRED(IROW1),IROW1
29992            CALL DPWRST('XXX','BUG ')
29993          ELSEIF(ICOLL(2).EQ.MAXCP2)THEN
29994            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),RES(IROW1),IROW1
29995            CALL DPWRST('XXX','BUG ')
29996          ELSEIF(ICOLL(2).EQ.MAXCP3)THEN
29997            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),YPLOT(IROW1),IROW1
29998            CALL DPWRST('XXX','BUG ')
29999          ELSEIF(ICOLL(2).EQ.MAXCP4)THEN
30000            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),XPLOT(IROW1),IROW1
30001            CALL DPWRST('XXX','BUG ')
30002          ELSEIF(ICOLL(2).EQ.MAXCP5)THEN
30003            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),X2PLOT(IROW1),IROW1
30004            CALL DPWRST('XXX','BUG ')
30005          ELSEIF(ICOLL(2).EQ.MAXCP6)THEN
30006            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),TAGPLO(IROW1),IROW1
30007            CALL DPWRST('XXX','BUG ')
30008          ENDIF
30009C
30010          IJ=MAXN*(ICOLL(2)-1)+IROWN
30011          IF(ICOLL(2).LE.MAXCOL.AND.NSX.NE.1)THEN
30012            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),V(IJ),IROWN
30013            CALL DPWRST('XXX','BUG ')
30014          ELSEIF(ICOLL(2).EQ.MAXCP1.AND.NSX.NE.1)THEN
30015            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),PRED(IROWN),IROWN
30016            CALL DPWRST('XXX','BUG ')
30017          ELSEIF(ICOLL(2).EQ.MAXCP2.AND.NSX.NE.1)THEN
30018            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),RES(IROWN),IROWN
30019            CALL DPWRST('XXX','BUG ')
30020          ELSEIF(ICOLL(2).EQ.MAXCP3.AND.NSX.NE.1)THEN
30021            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),YPLOT(IROWN),IROWN
30022            CALL DPWRST('XXX','BUG ')
30023          ELSEIF(ICOLL(2).EQ.MAXCP4.AND.NSX.NE.1)THEN
30024            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),XPLOT(IROWN),IROWN
30025            CALL DPWRST('XXX','BUG ')
30026          ELSEIF(ICOLL(2).EQ.MAXCP5.AND.NSX.NE.1)THEN
30027            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),X2PLOT(IROWN),IROWN
30028            CALL DPWRST('XXX','BUG ')
30029          ELSEIF(ICOLL(2).EQ.MAXCP6.AND.NSX.NE.1)THEN
30030            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),TAGPLO(IROWN),IROWN
30031            CALL DPWRST('XXX','BUG ')
30032          ENDIF
30033          IF(NSX.EQ.1)THEN
30034            WRITE(ICOUT,16032)
30035            CALL DPWRST('XXX','BUG ')
30036            WRITE(ICOUT,16033)
30037            CALL DPWRST('XXX','BUG ')
30038          ENDIF
30039C
30040        ENDIF
30041C
30042        IF(NUMVAL.GE.3)THEN
30043          WRITE(ICOUT,16011)ILEFT(3),ILEF2(3),NSX
30044          CALL DPWRST('XXX','BUG ')
30045          WRITE(ICOUT,999)
30046          CALL DPWRST('XXX','BUG ')
30047          IJ=MAXN*(ICOLL(3)-1)+IROW1
30048          IF(ICOLL(3).LE.MAXCOL)THEN
30049            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),V(IJ),IROW1
30050            CALL DPWRST('XXX','BUG ')
30051          ELSEIF(ICOLL(3).EQ.MAXCP1)THEN
30052            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),PRED(IROW1),IROW1
30053            CALL DPWRST('XXX','BUG ')
30054          ELSEIF(ICOLL(3).EQ.MAXCP2)THEN
30055            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),RES(IROW1),IROW1
30056            CALL DPWRST('XXX','BUG ')
30057          ELSEIF(ICOLL(3).EQ.MAXCP3)THEN
30058            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),YPLOT(IROW1),IROW1
30059            CALL DPWRST('XXX','BUG ')
30060          ELSEIF(ICOLL(3).EQ.MAXCP4)THEN
30061            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),XPLOT(IROW1),IROW1
30062            CALL DPWRST('XXX','BUG ')
30063          ELSEIF(ICOLL(3).EQ.MAXCP5)THEN
30064            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),X2PLOT(IROW1),IROW1
30065            CALL DPWRST('XXX','BUG ')
30066          ELSEIF(ICOLL(3).EQ.MAXCP6)THEN
30067            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),TAGPLO(IROW1),IROW1
30068            CALL DPWRST('XXX','BUG ')
30069          ENDIF
30070C
30071          IJ=MAXN*(ICOLL(3)-1)+IROWN
30072          IF(ICOLL(3).LE.MAXCOL.AND.NSX.NE.1)THEN
30073            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),V(IJ),IROWN
30074            CALL DPWRST('XXX','BUG ')
30075          ELSEIF(ICOLL(3).EQ.MAXCP1.AND.NSX.NE.1)THEN
30076            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),PRED(IROWN),IROWN
30077            CALL DPWRST('XXX','BUG ')
30078          ELSEIF(ICOLL(3).EQ.MAXCP2.AND.NSX.NE.1)THEN
30079            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),RES(IROWN),IROWN
30080            CALL DPWRST('XXX','BUG ')
30081          ELSEIF(ICOLL(3).EQ.MAXCP3.AND.NSX.NE.1)THEN
30082            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),YPLOT(IROWN),IROWN
30083            CALL DPWRST('XXX','BUG ')
30084          ELSEIF(ICOLL(3).EQ.MAXCP4.AND.NSX.NE.1)THEN
30085            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),XPLOT(IROWN),IROWN
30086            CALL DPWRST('XXX','BUG ')
30087          ELSEIF(ICOLL(3).EQ.MAXCP5.AND.NSX.NE.1)THEN
30088            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),X2PLOT(IROWN),IROWN
30089            CALL DPWRST('XXX','BUG ')
30090          ELSEIF(ICOLL(3).EQ.MAXCP6.AND.NSX.NE.1)THEN
30091            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),TAGPLO(IROWN),IROWN
30092            CALL DPWRST('XXX','BUG ')
30093          ENDIF
30094          IF(NSX.EQ.1)THEN
30095            WRITE(ICOUT,16032)
30096            CALL DPWRST('XXX','BUG ')
30097            WRITE(ICOUT,16033)
30098            CALL DPWRST('XXX','BUG ')
30099          ENDIF
30100C
30101        ENDIF
30102C
30103        WRITE(ICOUT,999)
30104        CALL DPWRST('XXX','BUG ')
30105C
30106        IF(NUMVAL.GE.4)THEN
30107          WRITE(ICOUT,16011)ILEFT(4),ILEF2(4),NS4
30108          CALL DPWRST('XXX','BUG ')
30109          WRITE(ICOUT,999)
30110          CALL DPWRST('XXX','BUG ')
30111          IJ=MAXN*(ICOLL(4)-1)+IROW1
30112          IF(ICOLL(4).LE.MAXCOL)THEN
30113            WRITE(ICOUT,16021)ILEFT(4),ILEF2(4),V(IJ),IROW1
30114            CALL DPWRST('XXX','BUG ')
30115          ELSEIF(ICOLL(4).EQ.MAXCP1)THEN
30116            WRITE(ICOUT,16021)ILEFT(4),ILEF2(4),PRED(IROW1),IROW1
30117            CALL DPWRST('XXX','BUG ')
30118          ELSEIF(ICOLL(4).EQ.MAXCP2)THEN
30119            WRITE(ICOUT,16021)ILEFT(4),ILEF2(4),RES(IROW1),IROW1
30120            CALL DPWRST('XXX','BUG ')
30121          ELSEIF(ICOLL(4).EQ.MAXCP3)THEN
30122            WRITE(ICOUT,16021)ILEFT(4),ILEF2(4),YPLOT(IROW1),IROW1
30123            CALL DPWRST('XXX','BUG ')
30124          ELSEIF(ICOLL(4).EQ.MAXCP4)THEN
30125            WRITE(ICOUT,16021)ILEFT(4),ILEF2(4),XPLOT(IROW1),IROW1
30126            CALL DPWRST('XXX','BUG ')
30127          ELSEIF(ICOLL(4).EQ.MAXCP5)THEN
30128            WRITE(ICOUT,16021)ILEFT(4),ILEF2(4),X2PLOT(IROW1),IROW1
30129            CALL DPWRST('XXX','BUG ')
30130          ELSEIF(ICOLL(4).EQ.MAXCP6)THEN
30131            WRITE(ICOUT,16021)ILEFT(4),ILEF2(4),TAGPLO(IROW1),IROW1
30132            CALL DPWRST('XXX','BUG ')
30133          ENDIF
30134C
30135          IJ=MAXN*(ICOLL(4)-1)+IROWN
30136          IF(ICOLL(4).LE.MAXCOL.AND.NSX.NE.1)THEN
30137            WRITE(ICOUT,16031)NS4,ILEFT(4),ILEF2(4),V(IJ),IROWN
30138            CALL DPWRST('XXX','BUG ')
30139          ELSEIF(ICOLL(4).EQ.MAXCP1.AND.NS4.NE.1)THEN
30140            WRITE(ICOUT,16031)NS4,ILEFT(4),ILEF2(4),PRED(IROWN),IROWN
30141            CALL DPWRST('XXX','BUG ')
30142          ELSEIF(ICOLL(4).EQ.MAXCP2.AND.NS4.NE.1)THEN
30143            WRITE(ICOUT,16031)NS4,ILEFT(4),ILEF2(4),RES(IROWN),IROWN
30144            CALL DPWRST('XXX','BUG ')
30145          ELSEIF(ICOLL(4).EQ.MAXCP3.AND.NS4.NE.1)THEN
30146            WRITE(ICOUT,16031)NS4,ILEFT(4),ILEF2(4),YPLOT(IROWN),IROWN
30147            CALL DPWRST('XXX','BUG ')
30148          ELSEIF(ICOLL(4).EQ.MAXCP4.AND.NS4.NE.1)THEN
30149            WRITE(ICOUT,16031)NS4,ILEFT(4),ILEF2(4),XPLOT(IROWN),IROWN
30150            CALL DPWRST('XXX','BUG ')
30151          ELSEIF(ICOLL(4).EQ.MAXCP5.AND.NS4.NE.1)THEN
30152            WRITE(ICOUT,16031)NS4,ILEFT(4),ILEF2(4),X2PLOT(IROWN),IROWN
30153            CALL DPWRST('XXX','BUG ')
30154          ELSEIF(ICOLL(4).EQ.MAXCP6.AND.NS4.NE.1)THEN
30155            WRITE(ICOUT,16031)NS4,ILEFT(4),ILEF2(4),TAGPLO(IROWN),IROWN
30156            CALL DPWRST('XXX','BUG ')
30157          ENDIF
30158          IF(NS4.EQ.1)THEN
30159            WRITE(ICOUT,16032)
30160            CALL DPWRST('XXX','BUG ')
30161            WRITE(ICOUT,16033)
30162            CALL DPWRST('XXX','BUG ')
30163          ENDIF
30164C
30165        ENDIF
30166C
30167        IF(NUMVAL.GE.5)THEN
30168          WRITE(ICOUT,16011)ILEFT(5),ILEF2(5),NS5
30169          CALL DPWRST('XXX','BUG ')
30170          WRITE(ICOUT,999)
30171          CALL DPWRST('XXX','BUG ')
30172          IJ=MAXN*(ICOLL(5)-1)+IROW1
30173          IF(ICOLL(5).LE.MAXCOL)THEN
30174            WRITE(ICOUT,16021)ILEFT(5),ILEF2(5),V(IJ),IROW1
30175            CALL DPWRST('XXX','BUG ')
30176          ELSEIF(ICOLL(5).EQ.MAXCP1)THEN
30177            WRITE(ICOUT,16021)ILEFT(5),ILEF2(5),PRED(IROW1),IROW1
30178            CALL DPWRST('XXX','BUG ')
30179          ELSEIF(ICOLL(5).EQ.MAXCP2)THEN
30180            WRITE(ICOUT,16021)ILEFT(5),ILEF2(5),RES(IROW1),IROW1
30181            CALL DPWRST('XXX','BUG ')
30182          ELSEIF(ICOLL(5).EQ.MAXCP3)THEN
30183            WRITE(ICOUT,16021)ILEFT(5),ILEF2(5),YPLOT(IROW1),IROW1
30184            CALL DPWRST('XXX','BUG ')
30185          ELSEIF(ICOLL(5).EQ.MAXCP4)THEN
30186            WRITE(ICOUT,16021)ILEFT(5),ILEF2(5),XPLOT(IROW1),IROW1
30187            CALL DPWRST('XXX','BUG ')
30188          ELSEIF(ICOLL(5).EQ.MAXCP5)THEN
30189            WRITE(ICOUT,16021)ILEFT(5),ILEF2(5),X2PLOT(IROW1),IROW1
30190            CALL DPWRST('XXX','BUG ')
30191          ELSEIF(ICOLL(5).EQ.MAXCP6)THEN
30192            WRITE(ICOUT,16021)ILEFT(5),ILEF2(5),TAGPLO(IROW1),IROW1
30193            CALL DPWRST('XXX','BUG ')
30194          ENDIF
30195C
30196          IJ=MAXN*(ICOLL(5)-1)+IROWN
30197          IF(ICOLL(5).LE.MAXCOL.AND.NSX.NE.1)THEN
30198            WRITE(ICOUT,16031)NS5,ILEFT(5),ILEF2(5),V(IJ),IROWN
30199            CALL DPWRST('XXX','BUG ')
30200          ELSEIF(ICOLL(5).EQ.MAXCP1.AND.NS4.NE.1)THEN
30201            WRITE(ICOUT,16031)NS5,ILEFT(5),ILEF2(5),PRED(IROWN),IROWN
30202            CALL DPWRST('XXX','BUG ')
30203          ELSEIF(ICOLL(5).EQ.MAXCP2.AND.NS5.NE.1)THEN
30204            WRITE(ICOUT,16031)NS5,ILEFT(5),ILEF2(5),RES(IROWN),IROWN
30205            CALL DPWRST('XXX','BUG ')
30206          ELSEIF(ICOLL(5).EQ.MAXCP3.AND.NS5.NE.1)THEN
30207            WRITE(ICOUT,16031)NS5,ILEFT(5),ILEF2(5),YPLOT(IROWN),IROWN
30208            CALL DPWRST('XXX','BUG ')
30209          ELSEIF(ICOLL(5).EQ.MAXCP4.AND.NS5.NE.1)THEN
30210            WRITE(ICOUT,16031)NS5,ILEFT(5),ILEF2(5),XPLOT(IROWN),IROWN
30211            CALL DPWRST('XXX','BUG ')
30212          ELSEIF(ICOLL(5).EQ.MAXCP5.AND.NS5.NE.1)THEN
30213            WRITE(ICOUT,16031)NS5,ILEFT(5),ILEF2(5),X2PLOT(IROWN),IROWN
30214            CALL DPWRST('XXX','BUG ')
30215          ELSEIF(ICOLL(5).EQ.MAXCP6.AND.NS5.NE.1)THEN
30216            WRITE(ICOUT,16031)NS5,ILEFT(5),ILEF2(5),TAGPLO(IROWN),IROWN
30217            CALL DPWRST('XXX','BUG ')
30218          ENDIF
30219          IF(NS5.EQ.1)THEN
30220            WRITE(ICOUT,16032)
30221            CALL DPWRST('XXX','BUG ')
30222            WRITE(ICOUT,16033)
30223            CALL DPWRST('XXX','BUG ')
30224          ENDIF
30225C
30226        ENDIF
30227C
30228        WRITE(ICOUT,999)
30229        CALL DPWRST('XXX','BUG ')
30230      ENDIF
30231C
30232      GOTO19000
30233C
30234C               *****************
30235C               **  STEP 90--  **
30236C               **  EXIT       **
30237C               *****************
30238C
3023919000 CONTINUE
30240      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
30241        WRITE(ICOUT,999)
30242        CALL DPWRST('XXX','BUG ')
30243        WRITE(ICOUT,19011)
3024419011   FORMAT('***** AT THE END       OF DPMATC--')
30245        CALL DPWRST('XXX','BUG ')
30246        WRITE(ICOUT,19012)IFOUND,IERROR
3024719012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
30248        CALL DPWRST('XXX','BUG ')
30249        WRITE(ICOUT,19014)ICASL7,ILOCV,ITCASE,IWRITE
3025019014   FORMAT('ICASL7,ILOCV,ITCASE,IWRITE = ',A4,2X,I8,2X,A4,2X,A4)
30251        CALL DPWRST('XXX','BUG ')
30252        WRITE(ICOUT,19016)NSX,NITEMX,NS1,NS2
3025319016   FORMAT('NSX,NITEMX,NS1,NS2 = ',4I8)
30254        CALL DPWRST('XXX','BUG ')
30255        WRITE(ICOUT,19021)ILEFT(1),ILEF2(1),ILISL(1),ICOLL(1)
3025619021   FORMAT('ILEFT(1),ILEF2(1),ILISL(1),ICOLL(1) = ',A4,2X,A4,2I8)
30257        CALL DPWRST('XXX','BUG ')
30258        WRITE(ICOUT,19022)ILEFT(2),ILEF2(2),ILISL(2),ICOLL(2)
3025919022   FORMAT('ILEFT(2),ILEF2(2),ILISL(2),ICOLL(2) = ',A4,2X,A4,2I8)
30260        CALL DPWRST('XXX','BUG ')
30261        WRITE(ICOUT,19023)NUMVAL,NEWNAM(1),NEWNAM(2),NUMVAR
3026219023   FORMAT('NUMVAL,NEWNAM(1),NEWNAM(2),NUMVAR = ',
30263     1         I8,2X,A4,2X,A4,I8)
30264        CALL DPWRST('XXX','BUG ')
30265        WRITE(ICOUT,19024)ILISR(1),ILISR(2),ILISR(3),ILISR(4)
3026619024   FORMAT('ILISR(1),ILISR(2),ILISR(3),ILISR(4) = ',4I8)
30267        CALL DPWRST('XXX','BUG ')
30268        WRITE(ICOUT,19025)ICOLR(1),ICOLR(2),ICOLR(3),ICOLR(4)
3026919025   FORMAT('ICOLR(1),ICOLR(2),ICOLR(3),ICOLR(4) = ',4I8)
30270        CALL DPWRST('XXX','BUG ')
30271        WRITE(ICOUT,19026)TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4)
3027219026   FORMAT('TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4) = ',4E15.7)
30273        CALL DPWRST('XXX','BUG ')
30274        WRITE(ICOUT,19027)ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4)
3027519027   FORMAT('ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4) = ',
30276     1         A4,2X,A4,2X,A4,2X,A4)
30277        CALL DPWRST('XXX','BUG ')
30278        WRITE(ICOUT,19031)IMATSW,NUMVAR
3027919031   FORMAT('IMATSW,NUMVAR = ',A4,I8)
30280        CALL DPWRST('XXX','BUG ')
30281        IF(ITYPA(1).EQ.'VARI')THEN
30282          WRITE(ICOUT,19033)ILISR(1),IN(ILISR(1)),IVALUE(ILISR(1)),
30283     1                      IVALU2(ILISR(1))
3028419033     FORMAT('ILISR(1),IN(ILISR(1)),IVALUE(ILISR(1)),',
30285     1           'IVALU2(ILISR(1)) = ',
30286     1           4I8)
30287          CALL DPWRST('XXX','BUG ')
30288        ENDIF
30289        WRITE(ICOUT,19034)ILOCR(3),ILOCR(4),ILOCR(5),ILOCR(6),
30290     1                    ILOCR(7)
3029119034   FORMAT('ILOCR3,...,ILOCR7 = ',5I8)
30292        CALL DPWRST('XXX','BUG ')
30293      ENDIF
30294C
3029519090 CONTINUE
30296C
30297      RETURN
30298      END
30299      SUBROUTINE DPMAT2(ICASL7,ICASS7,ILOCV,ISEED,IMSUBC,
30300     1                  IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
30301CCCCC OCTOBER 1998.  SPLIT INTO 2 FILES (LAHEY COMPILER
30302CCCCC SEEMS TO HAVE MEMORY TROUBLES WITH THE FULL ROUTINE).
30303CCCCC ESSENTIALLY, SPLIT OUT THE MATRIX AND NON-MATRIX COMMANDS.
30304CCCCC THIS ROUTINE, DPMAT2, IS THE MATRIX COMMANDS.
30305C
30306C     PURPOSE--TREAT THE TYPE 7 LET CASE--
30307C                      (FOR A FULL OR PARTIAL DATA SET)
30308C                 LET M3 = MATRIX ADDITION M1 M2
30309C                 LET M3 = MATRIX ADDITION M1 P1
30310C                 LET M3 = MATRIX SUBTRACTION M1 M2
30311C                 LET M3 = MATRIX SUBTRACTION M1 P1
30312C                 LET M3 = MATRIX MULTIPLICATION M1 M2
30313C                 LET M3 = MATRIX MULTIPLICATION M1 V1
30314C                 LET M3 = MATRIX MULTIPLICATION M1 P1
30315C                 LET M3 = MATRIX TRUNCATION M1 P1
30316C                 LET V3 = MATRIX SOLUTION M1 V2
30317C                 LET V3 = MATRIX ITERATIVE SOLUTION M1 V2
30318C                 LET M3 = MATRIX INVERSE M1
30319C                 LET P3 = MATRIX CONDITION NUMBER M1
30320C                 LET P3 = MATRIX RECIPROCAL CONDITION NUMBER M1
30321C                 LET M3 = MATRIX TRANSPOSE M1
30322C                 LET M3 = MATRIX ADJOINT M1
30323C                 LET V3 = MATRIX CHAR EQUATION M1   (NOT YET IMP)
30324C                 LET V3 = MATRIX EIGENVALUES M1
30325C                 LET M3 = MATRIX EIGENVECTORS M1
30326C                 LET M3 = MATRIX RANK M1
30327C                 LET P3 = MATRIX DETERMINANT M1
30328C                 LET P3 = MATRIX PERMANENT M1
30329C                 LET P3 = MATRIX SPECTRAL NORM M1
30330C                 LET P3 = MATRIX SPECTRAL RADIUS M1
30331C                 LET P3 = MATRIX NUMBER OF ROWS M1
30332C                 LET P3 = MATRIX NUMBER OF COLUMNS M1
30333C                 LET V4 = MATRIX SIMPLEX SOLUTION V1 M1
30334C                 LET P3 = MATRIX TRACE M1
30335C                 LET M3 = MATRIX SUBMATRIX M1 P1 P2
30336C                 LET P3 = MATRIX MINOR M1 P1 P2
30337C                 LET P3 = MATRIX COFACTOR M1 P1 P2
30338C                 LET M3 = MATRIX DEFINITION M1 P1 P2
30339C                 LET P3 = MATRIX EUCLIDEAN NORM M1
30340C                 LET P3 = MATRIX ROW M1 P1
30341C                 LET P3 = MATRIX ELEMENT M1 P2
30342C                 LET M3 = MATRIX REPACE ROW M1 V2 P3
30343C                 LET M3 = MATRIX ADD ROW M1 V1
30344C                 LET M3 = MATRIX DELETE ROW M1 S1
30345C                 LET M3 = MATRIX REPACE ELEMENT M1 V2 P3 P4
30346C                 LET M3 = MATRIX CHOLESKY DECOMPOSITION  M1
30347C                 LET M3 = MATRIX AUGMENT  M1 M2
30348C                 LET V3 = MATRIX DIAGONAL  M1
30349C                 LET M3 = DIAGONAL MATRIX V1
30350C                 LET V3 = TRIDIAGONAL SOLUTION M1 V2
30351C                 LET V3 = TRIANGULAR SOLUTION M1 V2
30352C                 LET M3 = TRIANGULAR INVERSE M1
30353C
30354C                 LET A1 = MATRIX MEAN M1
30355C                 LET A1 = MATRIX SUM  M1
30356C                 LET M2 = MATRIX GROUP MEANS M1 TAG
30357C                 LET M2 = MATRIX GROUP STANDARD DEVIATIONS M1 TAG
30358C                 LET A1 = MATRIX ROW <STAT> M1
30359C                 LET A1 = MATRIX COLUMN <STAT> M1
30360C                 LET A1 = MATRIX PARTITION <STAT> M1 NROW NCOL
30361C                 LET A1 = MATRIX GRAND <STAT> M1
30362C                 LET V1 V2 = MATRIX BIN  M1
30363C                 LET M2 = MATRIX ROW SCALE M1
30364C                 LET M2 = MATRIX COLUMN SCALE M1
30365C                 LET A1 = QUADRATIC FORM M1 Y1
30366C                 LET A1 = HOTELLING 1-SAMPLE T-SQUARE M1 U1
30367C                 LET A1 = HOTELLING 2-SAMPLE T-SQUARE M1 M2
30368C                 LET M3 = POOLED VARIANCE-COVARIANCE MATRIX M1 M2
30369C                 LET M2 = PSUEDO INVERSE M1
30370C                 LET M2 M3 = QR DECOMPOSITION M1 (NOT WORKING)
30371C                 LET M2 = EUCLIDEAN ROW DISTANCE M1
30372C                 LET M2 = EUCLIDEAN COLUMN DISTANCE M1
30373C                 LET M2 = BLOCK ROW DISTANCE M1
30374C                 LET M2 = BLOCK COLUMN DISTANCE M1
30375C                 LET M2 = MINKOWSKY ROW DISTANCE M1
30376C                 LET M2 = MINKOWSKY COLUMN DISTANCE M1
30377C                 LET M2 = CHEBYCHEV ROW DISTANCE M1
30378C                 LET M2 = CHEBYCHEV COLUMN DISTANCE M1
30379C                 LET M2 = COSINE ROW DISTANCE M1
30380C                 LET M2 = COSINE COLUMN DISTANCE M1
30381C                 LET M2 = COSINE ROW SIMILARITY M1
30382C                 LET M2 = COSINE COLUMN SIMILARITY M1
30383C                 LET M2 = ANGULAR COSINE ROW DISTANCE M1
30384C                 LET M2 = ANGULAR COSINE COLUMN DISTANCE M1
30385C                 LET M2 = ANGULAR COSINE ROW SIMILARITY M1
30386C                 LET M2 = ANGULAR COSINE COLUMN SIMILARITY M1
30387C                 LET M2 = JACCARD ROW DISTANCE M1
30388C                 LET M2 = JACCARD COLUMN DISTANCE M1
30389C                 LET M2 = JACCARD ROW SIMILARITY M1
30390C                 LET M2 = JACCARD COLUMN SIMILARITY M1
30391C                 LET M2 = PEARSON ROW DISTANCE M1
30392C                 LET M2 = PEARSON COLUMN DISTANCE M1
30393C                 LET M2 = PEARSON ROW SIMILARITY M1
30394C                 LET M2 = PEARSON COLUMN SIMILARITY M1
30395C                 LET M2 = HAMMING ROW DISTANCE M1
30396C                 LET M2 = HAMMING COLUMN DISTANCE M1
30397C                 LET M2 = JACCARD COLUMN DISTANCE M1
30398C                 LET M2 = MATRIX MAHALONOBIS ROW DISTANCE M1
30399C                 LET M2 = MATRIX MAHALONOBIS COLUMN DISTANCE M1
30400C                 LET Y1 = DISTANCE FROM MEAN M1
30401C                 LET Y2 = LINEAR COMBINATION M Y1
30402C                 LET M1 = VECTOR TIMES TRANSPOSE Y1
30403C                 LET M3 = VARIANCE-COVARIANCE MATRIX M1
30404C                 LET M3 = CORRELATION MATRIX M1
30405C                 LET M3 = CORRELATION CDF MATRIX M1
30406C                 LET M3 = CORRELATION PVALUE MATRIX M1
30407C                 LET M3 = PARTIAL CORRELATION MATRIX M1
30408C                 LET M3 = PARTIAL CORRELATION CDF MATRIX M1
30409C                 LET M3 = PARTIAL CORRELATION PVALUE MATRIX M1
30410C                 LET M3 = COMOVEMENT MATRIX M1
30411C                 LET M3 = PRINCIPLE COMPONENTS M1
30412C                 LET V3 = ... PRINCIPLE COMPONENT M1
30413C                 LET M4 V3 M3 = SINGULAR VALUE M1
30414C                 LET M4 V3 M3 = SINGULAR VALUE DECOMPOSITION M1
30415C                 LET M4 V3 M3 = SINGULAR VALUE FACTORIZATION M1
30416C                 LET M2 = CATCHER MATRIX M1
30417C                 LET M2 = INDEPENDENT UNIFORM RAND NUMB LOWL UPPL P
30418C                 LET M2 = CORRELATED UNIFORM RAND NUMB SIGMA N
30419C                 LET M2 = MULTIVARIATE NORM RAND NUMB V1 M1 N
30420C                 LET M2 = MULTIVARIATE T RAND NUMB V1 M1 NU N
30421C                 LET M2 = MULTINOMIAL RAND NUMB V1 M1 N
30422C                 LET M2 = WISHART RAND NUMB V1 M1 N
30423C                 LET M2 = DIRICHLET RAND NUMB ALPHA N
30424C                 LET A2 = DIRICHLET PDF X ALPHA
30425C                 LET A2 = DIRICHLET LOG PDF X ALPHA
30426C                 LET M2 = MULTIVARIATE NORM CDF V1 M1 N
30427C                 LET M2 = MULTIVARIATE T CDF V1 M1 N
30428C                 LET A2 = MULTINOMIAL PDF X P
30429C                 LET M2 = XTXINV MATRIX M1
30430C                 LET Y1 = VARIANCE INFLATION FACTOR M1
30431C                 LET Y1 = CONDITION INDICES M1
30432C                 LET M1 = CREATE MATRIX V1 V2 ....VK
30433C                 LET Y2 X2 TAG = MINIMUM SPANNING TREE Y1 X1
30434C                 LET EDGE1 EDGE2 = MINIMUM SPANNING TREE DIST
30435C                 LET M2 = MATRIX RENUMBER M1 V1 V2
30436C                 LET M2 = ADJACENCY MATRIX EDGE1 EDGE2 NVERT
30437C                 LET M2 = DIRECTED ADJACENCY MATRIX EDGE1 EDGE2 NVERT
30438C                 LET Y X TAG = BIPLOT X
30439C                 LET A0 A0SD A1 A1SD = MATRIX <ROW/COLUMN> FIT M X
30440C                 LET M1 = VARIABLE TO MATRIX V1 NROWS
30441C                 LET V1 = MATRIX TO VARIABLE M1
30442C                 LET M3 = MATRIX COMBINE ROWS    M1 M2
30443C                 LET M3 = MATRIX COMBINE COLUMNS M1 M2
30444C                 LET M1 = GENERATE MATRIX <STAT> V1 V2 ... VK
30445C
30446C                 LET M1 = DEX CORE X1 X2 ... XK
30447C                 LET CONFTAG1 CONFTAG2 = DEX CONFOUND X1 X2 ... XK
30448C                 LET IFLAG = DEX CHECK CLASSIC X1 X2 ... XK
30449C                 LET ITAG = DEX CHECK CENTER POINTS X1 X2 ... XK
30450C
30451C     NOTE--FOR THIS SUBROUTINE, EITHER THE VARIABLES ON THE LEFT
30452C           OF THE "=" OR ON THE RIGHT OF THE "=" (OR BOTH) INVOLVE
30453C           A MATRIX RATHER THAN A VARIABLE.
30454C     WRITTEN BY--JAMES J. FILLIBEN
30455C                 STATISTICAL ENGINEERING DIVISION
30456C                 INFORMATION TECHNOLOGY LABORATORY
30457C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
30458C                 GAITHERSBURG, MD 20899-8980
30459C                 PHONE--301-975-2855
30460C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
30461C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
30462C     LANGUAGE--ANSI FORTRAN (1977)
30463C     VERSION NUMBER--87/10
30464C     ORIGINAL VERSION--MARCH 1978.
30465C     UPDATED         --JULY      1978.
30466C     UPDATED         --NOVEMBER  1978.
30467C     UPDATED         --FEBRUARY  1979.
30468C     UPDATED         --MARCH     1979.
30469C     UPDATED         --APRIL     1979.
30470C     UPDATED         --JULY      1979.
30471C     UPDATED         --JUNE      1981.
30472C     UPDATED         --JULY      1981.
30473C     UPDATED         --SEPTEMBER 1981.
30474C     UPDATED         --OCTOBER   1981.
30475C     UPDATED         --NOVEMBER  1981.
30476C     UPDATED         --DECEMBER  1981.
30477C     UPDATED         --MAY       1982.
30478C     UPDATED         --JANUARY   1987.
30479C     UPDATED         --APRIL     1987.
30480C     UPDATED         --AUGUST    1987.       COMPLEX SQUARE ROOT
30481C     UPDATED         --AUGUST    1987.       COMPLEX ROOTS (POLYNOMIAL)
30482C     UPDATED         --AUGUST    1987.       POLYNOMIAL ARITHMETIC
30483C     UPDATED         --AUGUST    1987.       VECTOR ARITHMETIC
30484C     UPDATED         --AUGUST    1987.       SET ARITHMETIC
30485C     UPDATED         --AUGUST    1987.       LOGICAL ARITHMETIC
30486C     UPDATED         --SEPTEMBER 1987.       FFT AND INVERSE FFT
30487C     UPDATED         --SEPTEMBER 1987.       MATRIX OPERATIONS
30488C     UPDATED         --SEPTEMBER 1987.       COMPLEX CONJUGATE
30489C     UPDATED         --NOVEMBER  1987.  (EXIT OUT IF ERROR)
30490C     UPDATED         --FEBRUARY  1988.  (BIWEIGHT AND TRICUBE)
30491C     UPDATED         --JULY      1988.  FRACTAL
30492C     UPDATED         --AUGUST    1988.  LENGTH TRAP FOR FRACTAL
30493C     UPDATED         --JANAURY   1988.  BOOTSTRAP SAMPLE
30494C     UPDATED         --AUGUST    1988.  (VARIANCE-COVARIANCE MATRIX)
30495C     UPDATED         --AUGUST    1988.  (CORRELATION MATRIX)
30496C     UPDATED         --AUGUST    1988.  (PRINCIPLE COMPONENTS)
30497C     UPDATED         --AUGUST    1988.  (... PRINCIPLE COMPONENTS)
30498C     UPDATED         --JANUARY   1989.  FIX A FORMAT STATEMENT (ALAN)
30499C     UPDATED         --NOVEMBER  1989.  FIX INTERPOLATION
30500C     UPDATED         --DECEMBER  1989.  (DEX) GENERATOR MULTIPLICATION
30501C     UPDATED         --JANUARY   1990.  SUBSAMPLE
30502C     UPDATED         --JULY      1991.  COCODE ('COCD')
30503C     UPDATED         --JULY      1991.  COCOPY ('COCP')
30504C     UPDATED         --FEBRUARY  1992.  FIX COCOPY ('COCP')
30505C     UPDATED         --MARCH     1992. EXT. SORT&CARRY TO MULTI ARGS
30506C     UPDATED         --MARCH     1992. ID IN ALL ERROR STATEMENTS
30507C     UPDATED         --APRIL     1992. SPLIT LONG FORMAT STATEMENTS
30508C     UPDATED         --MAY       1992. FIX IF .AND. IF
30509C     UPDATED         --MAY       1992. FIX COMPLEX ARITH./SUBSET BUG
30510C     UPDATED         --MAY       1992. FIX COMPLEX ARITH./SUBSET BUG
30511C                     --MAY       1992.(SHOULD FOR POLARI,LOGARI,..?)
30512C     UPDATED         --JULY      1993. UPDATES FOR MATRIX CODE
30513C     UPDATED         --AUGUST    1993. UPDATES FOR MATRIX CODE
30514C     UPDATED         --SEPTEMBER 1993. UPDATES FOR MATRIX CODE
30515C     UPDATED         --SEPTEMBER 1993. FIX BUG FOR COMPLEX ROOTS
30516C     UPDATED         --OCTOBER   1993. JACNIFE INDEX
30517C     UPDATED         --OCTOBER   1993. ADDITIONAL MATRIX COMMANDS
30518C     UPDATED         --MAY       1994. LINEAR INTERPOLATE, 2D INTERPOL
30519C                                       BILINEAR INTERPOLATE, BIVARIATE
30520C                                       INTERPOLATE
30521C     UPDATED         --JUNE      1995. BUG IN MATRIX REPLACE ELEMENT
30522C     UPDATED         --AUGUST    1995. ZERO PADDING NO LONGER REQUIRED
30523C                                       FOR FFT.
30524C     UPDATED         --JANUARY   1998. RECODE MATRIX CODE TO USE FEWER
30525C                                       MATRICES (AND THUS CAN HANDLE
30526C                                       LARGER MATRICES).
30527C     UPDATED         --JANUARY   1998. RECODE MATRIX CODE TO USE
30528C                                       1-DIMENSIONAL SCRATCH ARRAYS
30529C                                       (WILL BE 2-D IN MATARI, MATAR2)
30530C     UPDATED         --MAY       1998. INTERARRIVAL TIMES CASE
30531C     UPDATED         --MAY       1998. CUMULATIVE AVERAGE CASE
30532C     UPDATED         --MAY       1998. REVERSE CASE
30533C     UPDATED         --MAY       1998. CUMULATIVE HAZARD CASE
30534C     UPDATED         --MAY       1998. HAZARD CASE
30535C     UPDATED         --SEPTEMBER 1998. EXPONENTIAL SMOOTHING
30536C     UPDATED         --JUNE      1998. SOME NEW MATRIX COMMANDS
30537C     UPDATED         --AUGUST    1998. MATRIX MEAN
30538C     UPDATED         --AUGUST    1998. MATRIX ADD ROW, MATRIX DELE ROW
30539C     UPDATED         --AUGUST    1998. DISTANCE FROM MEAN
30540C     UPDATED         --AUGUST    1998. FOR MATRIX COMMANDS, FIX HOW
30541C                                       SUBSETTING HANDLED WHEN OUTPUT
30542C                                       IS SAVED.  THE IUPFLG USED TO
30543C                                       CONTROL WHETHER OUTPUT IS SAVED
30544C                                       WITH SUBSETTING OR IS SAVED
30545C                                       AS A "FULL" MATRIX.  E.G.,
30546C                                       MATRIX ADDITION MAINTAINS THE
30547C                                       SUBSET WHEN SAVING THE OUTPUT,
30548C                                       WHILE CORRELATION MATRIX IS
30549C                                       SAVED AS A "FULL" MATRIX.
30550C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP MEANS
30551C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP SD
30552C     UPDATED         --SEPTEMBER 1998. POOLED VARIANCE-COVARIANCE
30553C                                       MATRIX (MORE THAN 2 GROUPS)
30554C     UPDATED         --OCTOBER   1998. SPLIT INTO 2 ROUTINES
30555C     UPDATED         --MAY       2002. MULTIVARIATE NORM RAND NUMB
30556C     UPDATED         --MAY       2002. MULTINOMIAL RAND NUMB
30557C     UPDATED         --MAY       2002. WISHART RAND NUMB
30558C     UPDATED         --JUNE      2002. CATCHER MATRIX
30559C     UPDATED         --JULY      2002. ESSENTIALLY REWRITE FOR
30560C                                       BETTER CLARITY (MAKE USE
30561C                                       OF SEVERAL SUBROUTINES)
30562C     UPDATED         --JULY      2002. CREATE MATRIX
30563C     UPDATED         --MAY       2003. MULTIVARIATE T RAND NUMB
30564C     UPDATED         --MAY       2003. INDEPENDENT UNIFORM RAND NUMB
30565C     UPDATED         --MAY       2003. DIRIHLET RAND NUMB
30566C     UPDATED         --MAY       2003. MULTIVARIATE NORM CDF
30567C     UPDATED         --MAY       2003. MULTIVARIATE T CDF
30568C     UPDATED         --MAY       2003. ARGUMENT LIST TO MATAR3
30569C     UPDATED         --MAY       2003. FIX MULTINOMIAL RANDOM NUMBERS
30570C     UPDATED         --SEPTEMBER 2003. CORRELATED MULTIVARIATE
30571C                                       UNIFORM RANDOM NUMBERS
30572C     UPDATED         --JUNE      2005. MATRIX SUM
30573C     UPDATED         --JUNE      2005. MATRIX PARTITION <STAT>
30574C     UPDATED         --MARCH     2006. MATRIX BIN (NEED TO MODIFY
30575C                                       CALL LIST TO MATAR3)
30576C     UPDATED         --MARCH     2006. MATRIX LOWER TRUNCATE
30577C     UPDATED         --MARCH     2006. MATRIX UPPER TRUNCATE
30578C     UPDATED         --OCTOBER   2007. COMOVEMENT MATRIX
30579C     UPDATED         --APRIL     2008. MINIMAL SPANNING TREE
30580C     UPDATED         --JUNE      2008. MATRIX RENUMBER
30581C     UPDATED         --JULY      2008. ADJACENCY MATRIX
30582C     UPDATED         --JANUARY   2009. DISTINCTION BETWEEN "DIRECTED"
30583C                                       AND "UNDIRECTED" ADJACENCY
30584C                                       MATRIX
30585C     UPDATED         --APRIL     2009. BIPLOT
30586C     UPDATED         --FEBRUARY  2010. MATRIX <ROW/COLUMN> FIT
30587C     UPDATED         --NOVEMBER  2010. VARIABLE TO MATRIX
30588C     UPDATED         --NOVEMBER  2010. MATRIX TO VARIABLE
30589C     UPDATED         --JANUARY   2011. MATRIX COMBINE ROWS
30590C     UPDATED         --JANUARY   2011. MATRIX COMBINE COLUMNS
30591C     UPDATED         --SEPTEMBER 2011. MATRIX CONDITION NUMBER
30592C     UPDATED         --SEPTEMBER 2011. MATRIX RECIPROCAL CONDITION
30593C                                       NUMBER
30594C     UPDATED         --JUNE      2012. PARTIAL CORRELATION MATRIX
30595C     UPDATED         --JUNE      2012. PARTIAL CORRELATION CDF MATRIX
30596C     UPDATED         --JUNE      2012. PARTIAL CORRELATION PVALUE MATRIX
30597C     UPDATED         --JUNE      2012. CORRELATION CDF MATRIX
30598C     UPDATED         --JUNE      2012. CORRELATION PVALUE MATRIX
30599C     UPDATED         --AUGUST    2017. GENERATE MATRIX <STAT>
30600C     UPDATED         --JANUARY   2018. DEX CORE
30601C     UPDATED         --JANUARY   2018. DEX CONFOUND
30602C     UPDATED         --FEBRUARY  2018. DEX CHECK CLASSIC
30603C     UPDATED         --AUGUST    2018. COSINE <COLUMN/ROW> DISTANCE
30604C     UPDATED         --AUGUST    2018. COSINE <COLUMN/ROW> SIMILARITY
30605C     UPDATED         --AUGUST    2018. ANGULAR COSINE <COLUMN/ROW> DISTANCE
30606C     UPDATED         --AUGUST    2018. ANGULAR COSINE <COLUMN/ROW> SIMILARITY
30607C     UPDATED         --AUGUST    2018. JACCARD <COLUMN/ROW> DISTANCE
30608C     UPDATED         --AUGUST    2018. JACCARD <COLUMN/ROW> SIMILARITY
30609C     UPDATED         --AUGUST    2018. PEARSON <COLUMN/ROW> DISTANCE
30610C     UPDATED         --AUGUST    2018. PEARSON <COLUMN/ROW> SIMILARITY
30611C     UPDATED         --AUGUST    2018. HAMMING <COLUMN/ROW> DISTANCE
30612C     UPDATED         --AUGUST    2018. CANBERRA <COLUMN/ROW> SIMILARITY
30613C     UPDATED         --SEPTEMBER 2018. DEX CHECK CENTER POINTS
30614C     UPDATED         --JULY      2019. TWEAK SCRATCH STORAGE
30615C
30616C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
30617C
30618      CHARACTER*4 ICASL7
30619      CHARACTER*4 ICASS7
30620      CHARACTER*4 IMSUBC
30621      CHARACTER*4 IBUGA3
30622      CHARACTER*4 IBUGQ
30623      CHARACTER*4 ISUBRO
30624      CHARACTER*4 IFOUND
30625      CHARACTER*4 IERROR
30626C
30627      PARAMETER(MAXCAS=30)
30628      PARAMETER(MAXCA2=4)
30629C
30630      CHARACTER*4 NEWNAM(MAXCA2)
30631      CHARACTER*4 ICASEQ
30632      CHARACTER*4 IHWUSE
30633      CHARACTER*4 MESSAG
30634      CHARACTER*4 IWRITE
30635      CHARACTER*4 ITCASE
30636      CHARACTER*4 IMCASE
30637C
30638      CHARACTER*4 IHRIGH
30639      CHARACTER*4 IHRIG2
30640C
30641      CHARACTER*4 ILEFT(MAXCA2)
30642      CHARACTER*4 ILEF2(MAXCA2)
30643      CHARACTER*4 IHSET
30644      CHARACTER*4 IHSET2
30645C
30646      CHARACTER*4 ISUBN1
30647      CHARACTER*4 ISUBN2
30648      CHARACTER*4 ISTEPN
30649C
30650      CHARACTER*4 IMATSW
30651      CHARACTER*4 ITYP91
30652C
30653      CHARACTER*4 IH1
30654      CHARACTER*4 IH2
30655      CHARACTER*4 IHMAT1
30656      CHARACTER*4 IHMAT2
30657C
30658      CHARACTER*4 ITYPA(MAXCAS)
30659C
30660      CHARACTER*4 IHCV11
30661      CHARACTER*4 IHCV12
30662      CHARACTER*4 IHCV21
30663      CHARACTER*4 IHCV22
30664      CHARACTER*4 IHCV31
30665      CHARACTER*4 IHCV32
30666C
30667      CHARACTER*4 IUPFLG
30668      CHARACTER*4 IFLGLL
30669C
30670      CHARACTER*4 IHP
30671      CHARACTER*4 IHP2
30672      CHARACTER*4 ISUBN0
30673C
30674      CHARACTER*4 IRELAT
30675C
30676      INTEGER ILISL(MAXCA2)
30677      INTEGER ICOLL(MAXCA2)
30678      INTEGER ILOCR(MAXCAS)
30679      INTEGER ILISR(MAXCAS)
30680      INTEGER ICOLR(MAXCAS)
30681      INTEGER NIRIGH(MAXCAS)
30682      INTEGER NS(MAXCAS)
30683      REAL TEMPS(MAXCAS)
30684C
30685C---------------------------------------------------------------------
30686C
30687C     TOTAL FOR THE COMMON FILES IS 20+200+200=420 (SEPT 1987)
30688      INCLUDE 'DPCOPA.INC'
30689      INCLUDE 'DPCOZZ.INC'
30690      INCLUDE 'DPCOZI.INC'
30691      INCLUDE 'DPCOZD.INC'
30692      INCLUDE 'DPCODA.INC'
30693C
30694      DIMENSION TEMP1(MAXOBV)
30695      DIMENSION TEMP2(MAXOBV)
30696      DIMENSION TEMP3(MAXOBV)
30697      DIMENSION TEMP4(MAXOBV)
30698      DIMENSION TEMP91(MAXOBV)
30699      DIMENSION TEMP92(MAXOBV)
30700      DIMENSION TEMP12(2*MAXOBV)
30701C
30702      DIMENSION INDEX(MAXOBV)
30703      DIMENSION ITEMP1(MAXOBV)
30704      DIMENSION ITEMP2(MAXOBV)
30705      DIMENSION ITEMP3(MAXOBV)
30706      DIMENSION ITEMP4(MAXOBV)
30707      DIMENSION ITEMP5(MAXOBV)
30708      DIMENSION ITEMP6(MAXOBV)
30709      DIMENSION ITEMP7(MAXOBV)
30710C
30711      DOUBLE PRECISION DTEMP1(MAXOBV)
30712      DOUBLE PRECISION DTEMP2(MAXOBV)
30713      DOUBLE PRECISION DTEMP3(MAXOBV)
30714C
30715      EQUIVALENCE (DSIZE(1),TEMP1)
30716      EQUIVALENCE (DSIZE(MAXOBV+1),TEMP2)
30717      EQUIVALENCE (DSYMB(1),TEMP3)
30718      EQUIVALENCE (DSYMB(MAXOBV+1),TEMP4)
30719      EQUIVALENCE (DCOLOR(1),TEMP91)
30720      EQUIVALENCE (DCOLOR(MAXOBV+1),TEMP92)
30721      EQUIVALENCE (DFILL(1),TEMP12)
30722C
30723      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1)
30724      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2)
30725      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3)
30726      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4)
30727      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5)
30728      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6)
30729      EQUIVALENCE (IGARBG(IIGAR7),ITEMP7)
30730      EQUIVALENCE (IGARBG(IIGAR8),INDEX)
30731C
30732      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1)
30733      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2)
30734      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3)
30735C
30736      DIMENSION TEMPM1(MAXTOM)
30737      DIMENSION TEMPM2(MAXTOM)
30738      DIMENSION TEMM91(MAXTOM)
30739      EQUIVALENCE (GARBAG(IGARB8),TEMPM1)
30740      PARAMETER (IGINC=MAXTOM)
30741      PARAMETER (IGT1=1)
30742      EQUIVALENCE (GARBAG(IGT1),TEMPM2)
30743      PARAMETER (IGT3=IGT1+IGINC)
30744      EQUIVALENCE (GARBAG(IGT3),TEMM91)
30745C
30746      DIMENSION TEMPV(20)
30747C
30748      CHARACTER*40 STME(500)
30749      CHARACTER*40 STMEC(500)
30750      CHARACTER*40 ST2T(500)
30751      CHARACTER*40 ST2TC(500)
30752      CHARACTER*40 STC(500)
30753      CHARACTER*40 STT(500)
30754      INCLUDE 'DPCOZC.INC'
30755      EQUIVALENCE (CGARBG(1),STC(1))
30756      EQUIVALENCE (CGARBG(50001),STME(1))
30757      EQUIVALENCE (CGARBG(100001),STMEC(1))
30758      EQUIVALENCE (CGARBG(150001),ST2T(1))
30759      EQUIVALENCE (CGARBG(200001),ST2TC(1))
30760      EQUIVALENCE (CGARBG(250001),STT(1))
30761C
30762C-----COMMON----------------------------------------------------------
30763C
30764      INCLUDE 'DPCOHO.INC'
30765      INCLUDE 'DPCOHK.INC'
30766      INCLUDE 'DPCOST.INC'
30767      INCLUDE 'DPCOSU.INC'
30768      INCLUDE 'DPCOP2.INC'
30769C
30770C-----START POINT-----------------------------------------------------
30771C
30772      IUPFLG='SUBS'
30773      ISUBN1='DPMA'
30774      ISUBN2='T2  '
30775      IFOUND='NO'
30776      IERROR='NO'
30777      IMATSW='NO'
30778C
30779      MAXCP1=MAXCOL+1
30780      MAXCP2=MAXCOL+2
30781      MAXCP3=MAXCOL+3
30782      MAXCP4=MAXCOL+4
30783      MAXCP5=MAXCOL+5
30784      MAXCP6=MAXCOL+6
30785C
30786      NUMVAR=0
30787      NJ=-99
30788      NIFOR=0
30789      ILOCR(1)=ILOCV
30790      DO10I=2,MAXCAS
30791        ILOCR(I)=ILOCR(I-1)+1
30792   10 CONTINUE
30793C
30794      DO12I=1,MAXCA2
30795        NEWNAM(I)='NO'
30796   12 CONTINUE
30797      NUMVAL=1
30798C
30799      ITYP91='VECT'
30800      SCAL91=(-999.0)
30801C
30802      DO14I=1,MAXCAS
30803        ITYPA(I)='VARI'
30804        TEMPS(I)=(-999.0)
30805        ILISR(I)=(-999)
30806   14 CONTINUE
30807C
30808      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
30809        WRITE(ICOUT,999)
30810  999   FORMAT(1X)
30811        CALL DPWRST('XXX','BUG ')
30812        WRITE(ICOUT,51)
30813   51   FORMAT('***** AT THE BEGINNING OF DPMAT2--')
30814        CALL DPWRST('XXX','BUG ')
30815        WRITE(ICOUT,52)IBUGA3,IBUGQ,ISUBRO,IMSUBC,ICASL7,ILOCV
30816   52   FORMAT('IBUGA3,IBUGQ,ISUBRO,IMSUBC,ICASL7,ILOCV = ',5(A4,2X),I8)
30817        CALL DPWRST('XXX','BUG ')
30818      ENDIF
30819C
30820C               **********************************
30821C               **  STEP 1--                    **
30822C               **  INITIALIZE SOME VARIABLES.  **
30823C               **********************************
30824C
30825      ISTEPN='1'
30826      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
30827     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
30828C
30829      NEWNAM(1)='NO'
30830C
30831C     ***************************************************************
30832C     **  STEP 2A--                                                 *
30833C     **  EXAMINE THE LEFT-HAND SIDE--                              *
30834C     **  IS THE VARIABLE NAME TO LEFT OF = SIGN                    *
30835C     **  ALREADY IN THE NAME LIST?    AS A VARIABLE?               *
30836C     **  NOTE THAT     ILEFT(I)   IS THE NAME OF THE VARIABLE      *
30837C     **  ON THE LEFT.                                              *
30838C     **  NOTE THAT     ILISL(I)  IS THE LINE IN THE TABLE          *
30839C     **  OF THE NAME ON THE LEFT.                                  *
30840C     **  NOTE THAT     ICOLL(I)  IS THE DATA COLUMN (1 TO 12)      *
30841C     **  FOR THE NAME OF THE LEFT.                                 *
30842C     ***************************************************************
30843C
30844      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
30845     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
30846C
30847      ICASE=1
30848      CALL DPMAT6(ICASL7,ICASE,MAXCA2,
30849     1            ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
30850     1            NUMVAL,NIOLD,
30851     1            IBUGA3,ISUBRO,IFOUND,IERROR)
30852      IF(IERROR.EQ.'YES')GOTO9000
30853C
30854      IF(ICASL7.EQ.'MASD' .OR. ICASL7.EQ.'MASF' .OR.
30855     1   ICASL7.EQ.'MQRD' .OR. ICASL7.EQ.'MATB' .OR.
30856     1   ICASL7.EQ.'MARB' .OR. ICASL7.EQ.'MSPT' .OR.
30857     1   ICASL7.EQ.'BIPL' .OR. ICASL7.EQ.'CONF' .OR.
30858     1   ICASL7.EQ.'MFTR' .OR. ICASL7.EQ.'MFTC' .OR.
30859     1   ICASL7.EQ.'MSP2' .OR. ICASL7.EQ.'JOIN')THEN
30860        ICASE=2
30861        CALL DPMAT6(ICASL7,ICASE,MAXCA2,
30862     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
30863     1              NUMVAL,NIOLD,
30864     1              IBUGA3,ISUBRO,IFOUND,IERROR)
30865        IF(IERROR.EQ.'YES')GOTO9000
30866      ENDIF
30867C
30868      IF(ICASL7.EQ.'MASD' .OR. ICASL7.EQ.'MASF' .OR.
30869     1   ICASL7.EQ.'MFTR' .OR. ICASL7.EQ.'MFTC' .OR.
30870     1   ICASL7.EQ.'MSPT' .OR. ICASL7.EQ.'BIPL')THEN
30871        ICASE=3
30872        CALL DPMAT6(ICASL7,ICASE,MAXCA2,
30873     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
30874     1              NUMVAL,NIOLD,
30875     1              IBUGA3,ISUBRO,IFOUND,IERROR)
30876        IF(IERROR.EQ.'YES')GOTO9000
30877      ENDIF
30878C
30879      IF(ICASL7.EQ.'MFTR' .OR. ICASL7.EQ.'MFTC')THEN
30880        ICASE=4
30881        CALL DPMAT6(ICASL7,ICASE,MAXCA2,
30882     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
30883     1              NUMVAL,NIOLD,
30884     1              IBUGA3,ISUBRO,IFOUND,IERROR)
30885        IF(IERROR.EQ.'YES')GOTO9000
30886      ENDIF
30887C
30888      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAT2')THEN
30889        WRITE(ICOUT,491)
30890  491   FORMAT('AT THE END OF STEP 2--')
30891        CALL DPWRST('XXX','BUG ')
30892        DO494I=1,MAXCA2
30893        WRITE(ICOUT,492)ILEFT(I),ILEF2(I),NEWNAM(I),NUMNAM,
30894     1                  ILISL(I),NUMCOL,ICOLL(I),NIOLD
30895        CALL DPWRST('XXX','BUG ')
30896  492   FORMAT('ILEFT(I),ILEFT(I),NEWNAM(I),NUMNAM,ILISL(I),',
30897     1         'NUMCOL,ICOLL(I),NIOLD = ',A4,A4,2X,A4,2X,5I8)
30898  494   CONTINUE
30899      ENDIF
30900C
30901C     ****************************************************************
30902C     **  STEP 4--                                                   *
30903C     **  EXAMINE THE RIGHT-HAND SIDE--                              *
30904C     **  HAS EACH VARIABLE ON THE RIGHT ALREADY BEEN DEFINED?       *
30905C     **  NOTE THAT     ILISR(1), ILISR(2), ILISR(3), ILISR(4)       *
30906C     **  IS THE LINE IN THE TABLE OF THE FIRST, SECOND, THIRD,      *
30907C     **  FOURTH VARIABLE ON THE RIGHT, RESPECTIVELY.                *
30908C     **  NOTE THAT     ICOLR(1), ICOLR(2), ICOLR3, ICOLR4           *
30909C     **  IS THE DATA COLUMN (1 TO 10+6) OF THE FIRST SECOND,        *
30910C     **  THIRD, FOURTH VARIABLE ON THE RIGHT, RESPECTIVELY.         *
30911C     ****************************************************************
30912C
30913      ISTEPN='4'
30914      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
30915     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
30916C
30917C               ********************************************
30918C               **  STEP 4.1--                            **
30919C               **  DETERMINE THE NUMBER OF VARIABLES     **
30920C               **  ON THE RIGHT--1, 2, 3, OR 4           **
30921C               ********************************************
30922C
30923      ISTEPN='4.1'
30924      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
30925C
30926      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
30927        WRITE(ICOUT,1021)ICASL7,NUMARG
30928 1021   FORMAT('ICASL7,NUMARG = ',A4,2X,I2)
30929        CALL DPWRST('XXX','BUG ')
30930      ENDIF
30931C
30932      IMATSW='YES'
30933      NUMVAR=1
30934C
30935      IF(ICASL7.EQ.'MAIN'.OR.ICASL7.EQ.'MATR'.OR.ICASL7.EQ.'MAEN'.OR.
30936     1   ICASL7.EQ.'MAAJ'.OR.ICASL7.EQ.'MACE'.OR.ICASL7.EQ.'MAVC'.OR.
30937     1   ICASL7.EQ.'MAEA'.OR.ICASL7.EQ.'VINF'.OR.ICASL7.EQ.'MACO'.OR.
30938     1   ICASL7.EQ.'MACC'.OR.ICASL7.EQ.'VINF'.OR.ICASL7.EQ.'MACP'.OR.
30939     1   ICASL7.EQ.'MACM'.OR.ICASL7.EQ.'BIPL'.OR.ICASL7.EQ.'MPCO'.OR.
30940     1   ICASL7.EQ.'MPCC'.OR.ICASL7.EQ.'BIPL'.OR.ICASL7.EQ.'MPCP'.OR.
30941     1   ICASL7.EQ.'CIND'.OR.ICASL7.EQ.'MAEE'.OR.ICASL7.EQ.'MAPC'.OR.
30942     1   ICASL7.EQ.'MAP1'.OR.ICASL7.EQ.'MAP2'.OR.ICASL7.EQ.'MAP3'.OR.
30943     1   ICASL7.EQ.'MAP4'.OR.ICASL7.EQ.'MAP5'.OR.ICASL7.EQ.'MAP6'.OR.
30944     1   ICASL7.EQ.'MAP7'.OR.ICASL7.EQ.'MAP8'.OR.ICASL7.EQ.'MAP9'.OR.
30945     1   ICASL7.EQ.'MA10'.OR.(ICASL7.EQ.'MARA'.AND.NUMARG.EQ.5))THEN
30946        NUMVAR=1
30947      ELSEIF(
30948     1   ICASL7.EQ.'MADE'.OR.ICASL7.EQ.'MAPE'.OR.ICASL7.EQ.'MASV'.OR.
30949     1   ICASL7.EQ.'MASN'.OR.ICASL7.EQ.'MASR'.OR.ICASL7.EQ.'MASD'.OR.
30950     1   ICASL7.EQ.'MANR'.OR.ICASL7.EQ.'MANC'.OR.ICASL7.EQ.'MATC'.OR.
30951     1   ICASL7.EQ.'MASF'.OR.ICASL7.EQ.'MACH'.OR.ICASL7.EQ.'MADI'.OR.
30952     1   ICASL7.EQ.'MAMM'.OR.ICASL7.EQ.'MADM'.OR.ICASL7.EQ.'DIMA'.OR.
30953     1   ICASL7.EQ.'MAVT'.OR.ICASL7.EQ.'MATI'.OR.ICASL7.EQ.'MPIN'.OR.
30954     1   ICASL7.EQ.'MDER'.OR.ICASL7.EQ.'MDEC'.OR.ICASL7.EQ.'MDMR'.OR.
30955     1   ICASL7.EQ.'MDMC'.OR.ICASL7.EQ.'MDBR'.OR.ICASL7.EQ.'MDBC'.OR.
30956     1   ICASL7.EQ.'MDKR'.OR.ICASL7.EQ.'MDKC'.OR.ICASL7.EQ.'MDCR'.OR.
30957     1   ICASL7.EQ.'MDCC'.OR.ICASL7.EQ.'MRSC'.OR.ICASL7.EQ.'MCSC'.OR.
30958     1   ICASL7.EQ.'MCSR'.OR.ICASL7.EQ.'MCSC'.OR.
30959     1   ICASL7.EQ.'MCDR'.OR.ICASL7.EQ.'MCDC'.OR.
30960     1   ICASL7.EQ.'MJSR'.OR.ICASL7.EQ.'MJSC'.OR.
30961     1   ICASL7.EQ.'MJDR'.OR.ICASL7.EQ.'MJDC'.OR.
30962     1   ICASL7.EQ.'MPDR'.OR.ICASL7.EQ.'MPDC'.OR.
30963     1   ICASL7.EQ.'MPSR'.OR.ICASL7.EQ.'MPSC'.OR.
30964     1   ICASL7.EQ.'MHDR'.OR.ICASL7.EQ.'MHDC'.OR.
30965     1   ICASL7.EQ.'MXDR'.OR.ICASL7.EQ.'MXDC'.OR.
30966     1   ICASL7.EQ.'MZSR'.OR.ICASL7.EQ.'MASC'.OR.
30967     1   ICASL7.EQ.'MZDR'.OR.ICASL7.EQ.'MADC'.OR.
30968     1   ICASL7.EQ.'MROW'.OR.ICASL7.EQ.'MCOL'.OR.ICASL7.EQ.'MGRA'.OR.
30969     1   ICASL7.EQ.'MATB'.OR.ICASL7.EQ.'MARB'.OR.ICASL7.EQ.'MSP2'.OR.
30970     1   ICASL7.EQ.'MACN'.OR.ICASL7.EQ.'MARC'.OR.
30971     1   ICASL7.EQ.'MDIP'.OR.ICASL7.EQ.'MQRD'.OR.ICASL7.EQ.'MSUM')THEN
30972        NUMVAR=1
30973      ELSEIF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.
30974     1       ICASL7.EQ.'MAMU'.OR.ICASL7.EQ.'MASO'.OR.
30975     1       (ICASL7.EQ.'MARA'.AND.NUMARG.EQ.6).OR.
30976     1       ICASL7.EQ.'MASS'.OR.ICASL7.EQ.'MARW'.OR.
30977     1       ICASL7.EQ.'MAAU'.OR.ICASL7.EQ.'VMAT'.OR.
30978     1       ICASL7.EQ.'MATZ'.OR.ICASL7.EQ.'MAUZ'.OR.
30979     1       ICASL7.EQ.'MAAR'.OR.ICASL7.EQ.'MADR'.OR.
30980     1       ICASL7.EQ.'MATS'.OR.ICASL7.EQ.'MAIS'.OR.
30981     1       ICASL7.EQ.'MQFO'.OR.ICASL7.EQ.'MALC'.OR.
30982     1       ICASL7.EQ.'MAGM'.OR.ICASL7.EQ.'MAGS'.OR.
30983     1       ICASL7.EQ.'MHT1'.OR.ICASL7.EQ.'MHT2'.OR.
30984     1       ICASL7.EQ.'MPDF'.OR.ICASL7.EQ.'DPDF'.OR.
30985     1       ICASL7.EQ.'INRN'.OR.ICASL7.EQ.'DLPD'.OR.
30986     1       ICASL7.EQ.'MPVC'.OR.ICASL7.EQ.'DIRN'.OR.
30987     1       ICASL7.EQ.'MFTR'.OR.ICASL7.EQ.'MFTC'.OR.
30988     1       ICASL7.EQ.'MCRO'.OR.ICASL7.EQ.'MCCO'.OR.
30989     1       ICASL7.EQ.'MSPT')THEN
30990        NUMVAR=2
30991      ELSEIF(ICASL7.EQ.'MASM'.OR.ICASL7.EQ.'MAMI'.OR.
30992     1       ICASL7.EQ.'MACF'.OR.ICASL7.EQ.'MAEL'.OR.
30993     1       (ICASL7.EQ.'MADF'.AND.NUMARG.EQ.7).OR.
30994     1       ICASL7.EQ.'MARR'.OR.ICASL7.EQ.'MVRN'.OR.
30995     1       ICASL7.EQ.'MURN'.OR.
30996     1       ICASL7.EQ.'ADMA'.OR.ICASL7.EQ.'ADMD'.OR.
30997     1       ICASL7.EQ.'WIRN'.OR.ICASL7.EQ.'IURN'.OR.
30998     1       ICASL7.EQ.'MPAR'.OR.ICASL7.EQ.'MARN')THEN
30999        NUMVAR=3
31000      ELSEIF((ICASL7.EQ.'MADF'.AND.NUMARG.EQ.8).OR.
31001     1       ICASL7.EQ.'MARE'.OR.ICASL7.EQ.'MATD'.OR.
31002     1       ICASL7.EQ.'MTRN')THEN
31003        NUMVAR=4
31004      ELSEIF(ICASL7.EQ.'CRMA' .OR. ICASL7.EQ.'CORE' .OR.
31005     1       ICASL7.EQ.'CONF' .OR. ICASL7.EQ.'CKCL' .OR.
31006     1       ICASL7.EQ.'CKCP')THEN
31007        ISTRT=5
31008        IF(ICASL7.EQ.'CONF' .OR. ICASL7.EQ.'CKCL')ISTRT=6
31009        IF(ICASL7.EQ.'CKCP')ISTRT=7
31010        ILAST=NUMARG
31011        DO1051I=ISTRT,NUMARG
31012          IHRIGH=IHARG(I)
31013          IHRIG2=IHARG2(I)
31014          IF(IHRIGH.EQ.'SUBS'.AND.IHRIG2.EQ.'ET  ')THEN
31015            ILAST=I-1
31016            GOTO1054
31017          ELSEIF(IHRIGH.EQ.'EXCE'.AND.IHRIG2.EQ.'PT  ')THEN
31018            ILAST=I-1
31019            GOTO1054
31020          ELSEIF(IHRIGH.EQ.'FOR '.AND.IHRIG2.EQ.'    ')THEN
31021            ILAST=I-1
31022            GOTO1054
31023          ENDIF
31024 1051   CONTINUE
31025 1054   CONTINUE
31026        NUMVAR=ILAST-ISTRT+1
31027      ELSEIF(ICASL7.EQ.'GMST')THEN
31028        ISTRT=ILOCV
31029        ILAST=NUMARG
31030        DO1056I=ISTRT,ILAST
31031          IHRIGH=IHARG(I)
31032          IHRIG2=IHARG2(I)
31033          IF(IHRIGH.EQ.'SUBS'.AND.IHRIG2.EQ.'ET  ')THEN
31034            ILAST=I-1
31035            GOTO1059
31036          ELSEIF(IHRIGH.EQ.'EXCE'.AND.IHRIG2.EQ.'PT  ')THEN
31037            ILAST=I-1
31038            GOTO1059
31039          ELSEIF(IHRIGH.EQ.'FOR '.AND.IHRIG2.EQ.'    ')THEN
31040            ILAST=I-1
31041            GOTO1059
31042          ENDIF
31043 1056   CONTINUE
31044 1059   CONTINUE
31045        NUMVAR=ILAST-ISTRT+1
31046      ELSEIF(ICASL7.EQ.'NCDF'.OR.ICASL7.EQ.'TCDF')THEN
31047        ISTRT=6
31048        ILAST=NUMARG
31049        DO1061I=ISTRT,NUMARG
31050          IHRIGH=IHARG(I)
31051          IHRIG2=IHARG2(I)
31052          IF(IHRIGH.EQ.'SUBS'.AND.IHRIG2.EQ.'ET  ')THEN
31053            ILAST=I-1
31054            GOTO1064
31055          ELSEIF(IHRIGH.EQ.'EXCE'.AND.IHRIG2.EQ.'PT  ')THEN
31056            ILAST=I-1
31057            GOTO1064
31058          ELSEIF(IHRIGH.EQ.'FOR '.AND.IHRIG2.EQ.'    ')THEN
31059            ILAST=I-1
31060            GOTO1064
31061          ENDIF
31062 1061   CONTINUE
31063 1064   CONTINUE
31064        NUMVAR=ILAST-ISTRT+1
31065        IF(ICASL7.EQ.'NCDF')THEN
31066          IF(NUMVAR.EQ.3)THEN
31067            IFLGLL='ON'
31068          ELSEIF(NUMVAR.EQ.2)THEN
31069            IFLGLL='OFF'
31070          ELSE
31071            WRITE(ICOUT,1066)
31072 1066       FORMAT('***** ERROR FOR MULTIVARIATE NORMAL CDF--')
31073            CALL DPWRST('XXX','BUG ')
31074            WRITE(ICOUT,1068)NUMVAR
31075 1068       FORMAT('      EITHER 2 OR 3 ARGUMENTS EXPECTED, ',I8,
31076     1             'FOUND.')
31077            CALL DPWRST('XXX','BUG ')
31078          ENDIF
31079        ELSEIF(ICASL7.EQ.'TCDF')THEN
31080          IF(NUMVAR.EQ.4)THEN
31081            IFLGLL='ON'
31082          ELSEIF(NUMVAR.EQ.3)THEN
31083            IFLGLL='OFF'
31084          ELSE
31085            WRITE(ICOUT,1076)
31086 1076       FORMAT('***** ERROR FOR MULTIVARIATE T CDF--')
31087            CALL DPWRST('XXX','BUG ')
31088            WRITE(ICOUT,1078)NUMVAR
31089 1078       FORMAT('      EITHER 3 OR 4 ARGUMENTS EXPECTED, ',I8,
31090     1             'FOUND.')
31091            CALL DPWRST('XXX','BUG ')
31092          ENDIF
31093        ENDIF
31094      ENDIF
31095C
31096      IMATSW='NO'
31097C
31098      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31099        WRITE(ICOUT,1091)ICASL7,NUMVAR
31100 1091   FORMAT('ICASL7,NUMVAR = ',A4,2X,I8)
31101        CALL DPWRST('XXX','BUG ')
31102      ENDIF
31103C
31104C               ***************************************
31105C               **  STEP 5.1--                       **
31106C               **  EXAMINE THE VARIABLES            **
31107C               **  ON THE RIGHT.                    **
31108C               ***************************************
31109C
31110C
31111      ISTEPN='5.1'
31112      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
31113     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31114C
31115      IFLAG1=0
31116      IF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.ICASL7.EQ.'MAMU'.OR.
31117     1   ICASL7.EQ.'JAIN'.OR.ICASL7.EQ.'MATZ'.OR.ICASL7.EQ.'MAUZ')THEN
31118         IFLAG1=1
31119      ENDIF
31120      ICASE=1
31121      CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
31122     1IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
31123     1IFLAG1,ATEMP,ITEMP,
31124     1IBUGA3,ISUBRO,IFOUND,IERROR)
31125      IF(ITYPA(ICASE).EQ.'MATR')IMATSW='YES'
31126      IF(IERROR.EQ.'YES')GOTO9000
31127C
31128      IF(NUMVAR.GE.2)THEN
31129        IFLAG1=0
31130        IF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.ICASL7.EQ.'MAMU'.OR.
31131     1     ICASL7.EQ.'MASM'.OR.ICASL7.EQ.'MAMI'.OR.ICASL7.EQ.'MACF'.OR.
31132     1     ICASL7.EQ.'MADF'.OR.ICASL7.EQ.'MARA'.OR.ICASL7.EQ.'MARW'.OR.
31133     1     ICASL7.EQ.'MAEL'.OR.ICASL7.EQ.'MARE'.OR.ICASL7.EQ.'JAIN'.OR.
31134     1     ICASL7.EQ.'DIRN'.OR.ICASL7.EQ.'TCDF'.OR.ICASL7.EQ.'INRN'.OR.
31135     1     ICASL7.EQ.'MPAR'.OR.ICASL7.EQ.'MATZ'.OR.ICASL7.EQ.'MAUZ'.OR.
31136     1     ICASL7.EQ.'MFTR'.OR.ICASL7.EQ.'MFTC'.OR.ICASL7.EQ.'MAUZ'.OR.
31137     1     ICASL7.EQ.'MFTR'.OR.ICASL7.EQ.'MFTC'.OR.ICASL7.EQ.'MAUZ'.OR.
31138     1     ICASL7.EQ.'VMAT'.OR.
31139     1     ICASL7.EQ.'EXPS'.OR.ICASL7.EQ.'MADR'.OR.ICASL7.EQ.'MURN')
31140     1  THEN
31141          IFLAG1=1
31142        ENDIF
31143          ICASE=2
31144          CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
31145     1                IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
31146     1                IFLAG1,ATEMP,ITEMP,
31147     1                IBUGA3,ISUBRO,IFOUND,IERROR)
31148          IF(ITYPA(ICASE).EQ.'MATR')IMATSW='YES'
31149          IF(IERROR.EQ.'YES')GOTO9000
31150      ENDIF
31151C
31152      IF(NUMVAR.GE.3)THEN
31153        IFLAG1=0
31154        IF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.ICASL7.EQ.'MAMU'.OR.
31155     1     ICASL7.EQ.'MASM'.OR.ICASL7.EQ.'MAMI'.OR.ICASL7.EQ.'MACF'.OR.
31156     1     ICASL7.EQ.'MADF'.OR.ICASL7.EQ.'MAEL'.OR.ICASL7.EQ.'MARE'.OR.
31157     1     ICASL7.EQ.'MARR'.OR.ICASL7.EQ.'MVRN'.OR.ICASL7.EQ.'MURN'.OR.
31158     1     ICASL7.EQ.'WIRN'.OR.ICASL7.EQ.'MADR'.OR.ICASL7.EQ.'MURN'.OR.
31159     1     ICASL7.EQ.'MPAR'.OR.ICASL7.EQ.'ADMA'.OR.ICASL7.EQ.'ADMD'.OR.
31160     1     ICASL7.EQ.'IURN'.OR.ICASL7.EQ.'MTRN')
31161     1  THEN
31162           IFLAG1=1
31163        ENDIF
31164        ICASE=3
31165        CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
31166     1              IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
31167     1              IFLAG1,ATEMP,ITEMP,
31168     1              IBUGA3,ISUBRO,IFOUND,IERROR)
31169        IF(ITYPA(ICASE).EQ.'MATR')IMATSW='YES'
31170        IF(IERROR.EQ.'YES')GOTO9000
31171      ENDIF
31172C
31173      IF(NUMVAR.GE.4)THEN
31174        IFLAG1=0
31175        IF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.ICASL7.EQ.'MARA'.OR.
31176     1     ICASL7.EQ.'MAMU'.OR.ICASL7.EQ.'MADF'.OR.ICASL7.EQ.'MARE'.OR.
31177     1     ICASL7.EQ.'MURN'.OR.ICASL7.EQ.'MTRN')THEN
31178           IFLAG1=1
31179        ENDIF
31180        ICASE=4
31181        CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
31182     1              IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
31183     1              IFLAG1,ATEMP,ITEMP,
31184     1              IBUGA3,ISUBRO,IFOUND,IERROR)
31185        IF(ITYPA(ICASE).EQ.'MATR')IMATSW='YES'
31186        IF(IERROR.EQ.'YES')GOTO9000
31187      ENDIF
31188C
31189C  5 VARIABLES OR MORE CURRENTLY ONLY RELEVANT FOR THE
31190C  "CREATE MATRIX", "DEX CORE", AND "DEX CONFOUND" COMMANDS.
31191C
31192      IF(NUMVAR.GE.5)THEN
31193        DO1110ICASE=5,NUMVAR
31194          IFLAG1=0
31195          CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
31196     1                IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
31197     1                IFLAG1,ATEMP,ITEMP,
31198     1                IBUGA3,ISUBRO,IFOUND,IERROR)
31199 1110   CONTINUE
31200        IF(IERROR.EQ.'YES')GOTO9000
31201      ENDIF
31202C
31203C     *******************************
31204C     **  STEP 7--                 **
31205C     **  DETERMINE THE SUBCASE    **
31206C     **  AND BRANCH ACCORDINGLY.  **
31207C     *******************************
31208C
31209      ISTEPN='7'
31210      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31211        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31212        WRITE(ICOUT,7003)NUMVAR,NUMARG
31213 7003   FORMAT('7008--NUMVAR,NUMARG = ',2I8)
31214        CALL DPWRST('XXX','BUG ')
31215        DO7005I=1,NUMVAR
31216          WRITE(ICOUT,7008)I,ITYPA(I),ILOCR(I)
31217 7008     FORMAT('7008-I,ITYPA(I),ILOCR(I) = ',I4,2X,A4,2X,I8)
31218          CALL DPWRST('XXX','BUG ')
31219 7005   CONTINUE
31220        WRITE(ICOUT,7006)IHARG(ILOCR(NUMVAR)),IHARG2(ILOCR(NUMVAR))
31221 7006   FORMAT('IHARG(ILOCR(NUMVAR)),IHARG2(ILOCR(NUMVAR)) = ',2A4)
31222        CALL DPWRST('XXX','BUG ')
31223        WRITE(ICOUT,7007)IHARG(ILOCR(NUMVAR)+1),
31224     1                   IHARG2(ILOCR(NUMVAR)+1)
31225 7007   FORMAT('IHARG(ILOCR(NUMVAR)+1),IHARG2(ILOCR(NUMVAR)+1) = ',
31226     1         2A4)
31227        CALL DPWRST('XXX','BUG ')
31228      ENDIF
31229C
31230      IF(ICASL7.NE.'CRMA'.AND.ICASL7.NE.'GMST'.AND.ICASL7.NE.'CORE'.AND.
31231     1   ICASL7.NE.'CONF'.AND.ICASL7.NE.'CKCL'.AND.ICASL7.NE.'CKCP'.AND.
31232     1   NUMVAR.GE.5)THEN
31233        WRITE(ICOUT,7011)
31234 7011   FORMAT('***** ERROR IN DPMAT2--')
31235        CALL DPWRST('XXX','BUG ')
31236        WRITE(ICOUT,7012)
31237 7012   FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND AT 7000--')
31238        CALL DPWRST('XXX','BUG ')
31239        WRITE(ICOUT,7013)
31240 7013   FORMAT('      THERE WERE 5 OR MORE VARIABLES ON THE RIGHT')
31241        CALL DPWRST('XXX','BUG ')
31242        WRITE(ICOUT,7014)
31243 7014   FORMAT('      HAND SIDE OF THE EQUAL SIGN.  THERE ARE NO')
31244        CALL DPWRST('XXX','BUG ')
31245        WRITE(ICOUT,7015)
31246 7015   FORMAT('      MATRIX  LET  SYNTAXES (EXCEPT CREATE MATRIX)')
31247        CALL DPWRST('XXX','BUG ')
31248        WRITE(ICOUT,7016)
31249 7016   FORMAT('      WITH THAT MANY VARIABLES ON THE RIGHT.')
31250        CALL DPWRST('XXX','BUG ')
31251        WRITE(ICOUT,7017)
31252 7017   FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
31253        CALL DPWRST('XXX','BUG ')
31254        WRITE(ICOUT,7019)(IANS(I),I=1,MAX(100,IWIDTH))
31255 7019   FORMAT(100A1)
31256        CALL DPWRST('XXX','BUG ')
31257        IERROR='YES'
31258        GOTO19000
31259      ENDIF
31260C
31261      IF(ILOCR(NUMVAR).EQ.NUMARG)GOTO8000
31262C
31263      IF(ILOCR(NUMVAR).LT.NUMARG)THEN
31264        IT1=ILOCR(NUMVAR+1)
31265        IF(IHARG(IT1).EQ.'SUBS'.AND.IHARG2(IT1).EQ.'ET  ')GOTO9000
31266C
31267        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31268          WRITE(ICOUT,7009)
31269 7009     FORMAT('AFTER TEST FOR SUBSET')
31270          CALL DPWRST('XXX','BUG ')
31271          WRITE(ICOUT,7006)IHARG(ILOCR(NUMVAR)),
31272     1                     IHARG2(ILOCR(NUMVAR))
31273          CALL DPWRST('XXX','BUG ')
31274          WRITE(ICOUT,7007)IHARG(ILOCR(NUMVAR)+1),
31275     1                     IHARG2(ILOCR(NUMVAR)+1)
31276          CALL DPWRST('XXX','BUG ')
31277        ENDIF
31278C
31279        IF(IHARG(IT1).EQ.'EXCE'.AND.IHARG2(IT1).EQ.'PT  ')GOTO9000
31280        IF(IHARG(IT1).EQ.'FOR '.AND.IHARG2(IT1).EQ.'    ')GOTO10000
31281      ENDIF
31282C
31283      WRITE(ICOUT,7081)
31284 7081 FORMAT('***** ERROR 7081 IN DPMAT2--')
31285      CALL DPWRST('XXX','BUG ')
31286      WRITE(ICOUT,7082)
31287 7082 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND AT 7082--')
31288      CALL DPWRST('XXX','BUG ')
31289      WRITE(ICOUT,7017)
31290      CALL DPWRST('XXX','BUG ')
31291      WRITE(ICOUT,7019)(IANS(I),I=1,MIN(100,IWIDTH))
31292      CALL DPWRST('XXX','BUG ')
31293      WRITE(ICOUT,7088)ILOCV,NUMARG,NUMVAR
31294 7088 FORMAT('ILOCV,NUMARG,NUMVAR = ',3I8)
31295      CALL DPWRST('XXX','BUG ')
31296      DO7089I=1,NUMVAR
31297        WRITE(ICOUT,7086)I,ILOCR(I)
31298 7086   FORMAT('I,ILOCR(I) = ',I4,2X,I8)
31299        CALL DPWRST('XXX','BUG ')
31300 7089 CONTINUE
31301      IERROR='YES'
31302      GOTO19000
31303C
31304C     ************************************************
31305C     **  STEP 8--                                  **
31306C     **  TREAT THE FULL VARIABLE CASE.             **
31307C     **  EXAMPLE--LET Y = COVARIANCE MATRIX X      **
31308C     **  THEN JUMP TO STEP NUMBER 10 BELOW         **
31309C     **  FOR THE LIST UPDATING AND                 **
31310C     **  FOR SOME INFORMATIVE PRINTING.            **
31311C     ************************************************
31312C
31313C
31314 8000 CONTINUE
31315      ISTEPN='8'
31316      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31317        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31318        WRITE(ICOUT,8011)NINEW,NIRIGH(1)
31319 8011   FORMAT('NINEW,NIRIGH(1) = ',2I8)
31320        CALL DPWRST('XXX','BUG ')
31321      ENDIF
31322C
31323      ICASEQ='FULL'
31324      NIOLD=NIRIGH(1)
31325      IF(NUMVAR.GE.2)THEN
31326        DO8020I=2,NUMVAR
31327          IF(NIRIGH(I).GT.NIOLD)NIOLD=NIRIGH(I)
31328 8020   CONTINUE
31329      ENDIF
31330      NINEW=NIOLD
31331      DO8100I=1,NINEW
31332      ISUB(I)=1
31333 8100 CONTINUE
31334      GOTO11000
31335C
31336C     ****************************************************************
31337C     **  STEP 9--                                                   *
31338C     **  TREAT THE PARTIAL VARIABLE SUBSET CASE.                    *
31339C     **  EXAMPLE--LET Y = SORT X     SUBSET 2 3 5                   *
31340C     **         --LET Y(I) = SORT X  SUBSET 2 3 5                   *
31341C     **  JUMP TO STEP NUMBER 11 BELOW                               *
31342C     **  FOR THE ACTUAL MATHEMATICAL OPERATION,                     *
31343C     **  FOR THE LIST UPDATING, AND                                 *
31344C     **  FOR SOME INFORMATIVE PRINTING.                             *
31345C     ****************************************************************
31346C
31347 9000 CONTINUE
31348      ISTEPN='9'
31349      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
31350     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31351C
31352      ICASEQ='SUBS'
31353      ILOCSV=ILOCR(NUMVAR)+2
31354      IHSET=IHARG(ILOCSV)
31355      IHSET2=IHARG2(ILOCSV)
31356      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31357        WRITE(ICOUT,9002)ILOCSV,IHSET,IHSET2
31358 9002   FORMAT('ILOCSV,IHSET,IHSET2 = ',I8,2X,A4,A4)
31359        CALL DPWRST('XXX','BUG ')
31360      ENDIF
31361      IHWUSE='V'
31362      MESSAG='YES'
31363      CALL CHECKN(IHSET,IHSET2,IHWUSE,
31364     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
31365     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
31366      IF(IERROR.EQ.'YES')GOTO19000
31367      NIOLD=IN(ILOC)
31368      CALL DPSUBS(NIOLD,ILOCS,NSTEMP,IBUGQ,IERROR)
31369      NINEW=NIOLD
31370      GOTO11000
31371C
31372C     ****************************************************************
31373C     **  STEP 10--                                                  *
31374C     **  TREAT THE PARTIAL VARIABLE FOR CASE.                       *
31375C     **  EXAMPLE--LET Y = SORT X     FOR I = 1 2 10                 *
31376C     **         --LET Y(I) = SORT X  FOR I = 1 2 10                 *
31377C     **  JUMP TO STEP NUMBER 11 BELOW                               *
31378C     **  FOR THE ACTUAL MATHEMATICAL OPERATION,                     *
31379C     **  FOR THE LIST UPDATING, AND                                 *
31380C     **  FOR SOME INFORMATIVE PRINTING.                             *
31381C     ****************************************************************
31382C
3138310000 CONTINUE
31384      ISTEPN='10'
31385      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
31386     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31387C
31388      ICASEQ='FOR'
31389      CALL DPFOR(NIOLD,NINEW,IROW1,IROWN,
31390     1NLOCAL,ILOCS,NSTEMP,IBUGQ,IERROR)
31391      NIFOR=NINEW
31392      GOTO11000
31393C
31394C               *******************************************
31395C               **  STEP 11--                            **
31396C               **  CARRY OUT THE                        **
31397C               **  MATHEMATICAL OPERATION.              **
31398C               *******************************************
31399C
3140011000 CONTINUE
31401      ISTEPN='11'
31402      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31403        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31404        DO11109I=1,NUMVAR
31405        WRITE(ICOUT,11101)I,ITYPA(I)
3140611101   FORMAT('11101--I,ITYPA(I) = ',I4,2X,A4)
31407        CALL DPWRST('XXX','BUG ')
3140811109   CONTINUE
31409      ENDIF
31410C
31411      NITEMX=NINEW
31412      DO11113I=1,MAXCAS
31413        NS(I)=0
3141411113 CONTINUE
31415C
31416CCCCC CREATE MATRIX, DEX CORE, DEX CONFOUND, AND DEX CHECK CLASSIC
31417CCCCC HANDLED SEPARATELY, VARIABLES ARE COPIED INTO A MATRIX.
31418C
31419      IF(ICASL7.EQ.'CRMA' .OR. ICASL7.EQ.'CORE' .OR.
31420     1   ICASL7.EQ.'CONF' .OR. ICASL7.EQ.'CKCL' .OR.
31421     1   ICASL7.EQ.'CKCP')THEN
31422        IMCASE=ICASL7
31423        IMATSW='YES'
31424        DO11010K=1,NUMVAR
31425          IF(ITYPA(K).EQ.'VARI')THEN
31426            NJ=0
31427            DO11011I=1,NINEW
31428              IJ=MAXN*(ICOLR(K)-1)+I
31429              IF(ISUB(I).EQ.0)GOTO11011
31430              IF(I.GT.NIRIGH(K))GOTO11019
31431              NJ=NJ+1
31432              IF(NJ.GT.MAXROM)GOTO11019
31433              IJ=MAXN*(ICOLR(K)-1)+I
31434              IF(ICOLR(K).LE.MAXCOL)TEMPM1((K-1)*MAXROM+NJ)=V(IJ)
31435              IF(ICOLR(K).EQ.MAXCP1)TEMPM1((K-1)*MAXROM+NJ)=PRED(I)
31436              IF(ICOLR(K).EQ.MAXCP2)TEMPM1((K-1)*MAXROM+NJ)=RES(I)
31437              IF(ICOLR(K).EQ.MAXCP3)TEMPM1((K-1)*MAXROM+NJ)=YPLOT(I)
31438              IF(ICOLR(K).EQ.MAXCP4)TEMPM1((K-1)*MAXROM+NJ)=XPLOT(I)
31439              IF(ICOLR(K).EQ.MAXCP5)TEMPM1((K-1)*MAXROM+NJ)=X2PLOT(I)
31440              IF(ICOLR(K).EQ.MAXCP6)TEMPM1((K-1)*MAXROM+NJ)=TAGPLO(I)
3144111011       CONTINUE
3144211019       CONTINUE
31443          ENDIF
3144411010   CONTINUE
31445        NR1=NJ
31446        IF(NR1.GT.MAXROM)NR1=MAXROM
31447        NR2=0
31448        NR3=0
31449        NC1=NUMVAR
31450        NC2=0
31451        NC3=0
31452        GOTO11189
31453C
31454CCCCC GENERATE MATRIX <STAT> HANDLED SEPARATELY.  COMPUTE STATISTIC
31455CCCCC FOR EACH PAIRWISE SET OF VARIABLES AND STORE THE RESULT IN A
31456CCCCC SQUARE MATRIX.  NOTE THAT NOT ALL STATISTICS ARE NECCESSARILY
31457CCCCC SYMMETRIC (E.G., SOME OF THE MATCHING STATISTICS), SO COMPUTE
31458CCCCC (I,J) AND (J,I) CASES SEPARATELY EVEN THOUGH THAT MAY BE
31459CCCCC REDUNDANT IN MOST CASES.
31460C
31461      ELSEIF(ICASL7.EQ.'GMST')THEN
31462        IMCASE=ICASL7
31463        IMATSW='YES'
31464C
31465        DO21030II=1,NUMVAR*NUMVAR
31466          TEMPM1(II)=CPUMIN
3146721030   CONTINUE
31468C
31469        DO21010KROW=1,NUMVAR
31470C
31471C         EXTRACT FIRST RESPONSE VARIABLE
31472C
31473          IF(ITYPA(KROW).EQ.'VARI')THEN
31474            NJ=0
31475            DO21011I=1,NINEW
31476              IJ=MAXN*(ICOLR(KROW)-1)+I
31477              IF(ISUB(I).EQ.0)GOTO21011
31478              IF(I.GT.NIRIGH(KROW))GOTO21019
31479              NJ=NJ+1
31480              IJ=MAXN*(ICOLR(KROW)-1)+I
31481              IF(ICOLR(KROW).LE.MAXCOL)TEMP1(NJ)=V(IJ)
31482              IF(ICOLR(KROW).EQ.MAXCP1)TEMP1(NJ)=PRED(I)
31483              IF(ICOLR(KROW).EQ.MAXCP2)TEMP1(NJ)=RES(I)
31484              IF(ICOLR(KROW).EQ.MAXCP3)TEMP1(NJ)=YPLOT(I)
31485              IF(ICOLR(KROW).EQ.MAXCP4)TEMP1(NJ)=XPLOT(I)
31486              IF(ICOLR(KROW).EQ.MAXCP5)TEMP1(NJ)=X2PLOT(I)
31487              IF(ICOLR(KROW).EQ.MAXCP6)TEMP1(NJ)=TAGPLO(I)
3148821011       CONTINUE
3148921019       CONTINUE
31490            NS1=NJ
31491          ENDIF
31492C
31493          DO21020KCOL=1,NUMVAR
31494C
31495C           EXTRACT SECOND RESPONSE VARIABLE
31496C
31497            IF(ITYPA(KCOL).EQ.'VARI')THEN
31498              NJ=0
31499              DO21021I=1,NINEW
31500                IJ=MAXN*(ICOLR(KCOL)-1)+I
31501                IF(ISUB(I).EQ.0)GOTO21021
31502                IF(I.GT.NIRIGH(KCOL))GOTO21029
31503                NJ=NJ+1
31504                IJ=MAXN*(ICOLR(KCOL)-1)+I
31505                IF(ICOLR(KCOL).LE.MAXCOL)TEMP2(NJ)=V(IJ)
31506                IF(ICOLR(KCOL).EQ.MAXCP1)TEMP2(NJ)=PRED(I)
31507                IF(ICOLR(KCOL).EQ.MAXCP2)TEMP2(NJ)=RES(I)
31508                IF(ICOLR(KCOL).EQ.MAXCP3)TEMP2(NJ)=YPLOT(I)
31509                IF(ICOLR(KCOL).EQ.MAXCP4)TEMP2(NJ)=XPLOT(I)
31510                IF(ICOLR(KCOL).EQ.MAXCP5)TEMP2(NJ)=X2PLOT(I)
31511                IF(ICOLR(KCOL).EQ.MAXCP6)TEMP2(NJ)=TAGPLO(I)
3151221021         CONTINUE
3151321029         CONTINUE
31514              NS2=NJ
31515            ENDIF
31516C
31517C           NOW COMPUTE THE STATISTIC
31518C
31519            NUMV2=2
31520            CALL CMPSTA(TEMP1,TEMP2,TEMP3,TEMP4,TEMP91,TEMP92,
31521     1                  MAXOBV,NS1,NS2,NS1,NUMV2,ICASS7,
31522     1                  ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
31523     1                  DTEMP1,DTEMP2,DTEMP3,
31524     1                  RIGHT,
31525     1                  ISUBRO,IBUGA3,IERROR)
31526             IF(IERROR.EQ.'YES')GOTO9000
31527             INDX=(KCOL-1)*MAXROM + KROW
31528             TEMPM1(INDX)=RIGHT
31529C
3153021020     CONTINUE
31531C
3153221010   CONTINUE
31533        NR1=NUMVAR
31534        IF(NR1.GT.MAXROM)NR1=MAXROM
31535        NR2=0
31536        NR3=0
31537        NC1=NUMVAR
31538        NC2=0
31539        NC3=0
31540        GOTO11189
31541      ENDIF
31542C
31543      DO11110K=1,MIN(NUMVAR,4)
31544        IF(ITYPA(K).EQ.'VARI')THEN
31545          DO11111I=1,NINEW
31546            IJ=MAXN*(ICOLR(K)-1)+I
31547CCCCC       IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31548CCCCC         WRITE(ICOUT,11112)I,NS(K),NINEW,ISUB(I),IJ,V(IJ)
31549C11112        FORMAT('I,NS(K),NINEW,ISUB(I),IJ,V(IJ) = ',5I8,F12.5)
31550CCCCC         CALL DPWRST('XXX','BUG ')
31551CCCCC       ENDIF
31552            IF(ISUB(I).EQ.0)GOTO11111
31553            IF(I.GT.NIRIGH(K))GOTO11119
31554            NS(K)=NS(K)+1
31555            IJ=MAXN*(ICOLR(K)-1)+I
31556            IF(ICOLR(K).LE.MAXCOL)TEMP4(NS(K))=V(IJ)
31557            IF(ICOLR(K).EQ.MAXCP1)TEMP4(NS(K))=PRED(I)
31558            IF(ICOLR(K).EQ.MAXCP2)TEMP4(NS(K))=RES(I)
31559            IF(ICOLR(K).EQ.MAXCP3)TEMP4(NS(K))=YPLOT(I)
31560            IF(ICOLR(K).EQ.MAXCP4)TEMP4(NS(K))=XPLOT(I)
31561            IF(ICOLR(K).EQ.MAXCP5)TEMP4(NS(K))=X2PLOT(I)
31562            IF(ICOLR(K).EQ.MAXCP6)TEMP4(NS(K))=TAGPLO(I)
3156311111     CONTINUE
3156411119     CONTINUE
31565          IF(K.EQ.1)THEN
31566            DO11126J=1,NS(K)
31567              TEMP1(J)=TEMP4(J)
31568CCCCC         IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31569CCCCC           WRITE(ICOUT,11137)K,J,TEMP1(J)
31570C11137           FORMAT('K,J,TEMP1(J) = ',2I8,E15.7)
31571CCCCC           CALL DPWRST('XXX','BUG ')
31572CCCCC         ENDIF
3157311126       CONTINUE
31574          ELSEIF(K.EQ.2)THEN
31575            DO11127J=1,NS(K)
31576              TEMP2(J)=TEMP4(J)
31577CCCCC         IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31578CCCCC           WRITE(ICOUT,11138)K,J,TEMP1(J)
31579C11138           FORMAT('K,J,TEMP1(J) = ',2I8,E15.7)
31580CCCCC           CALL DPWRST('XXX','BUG ')
31581CCCCC         ENDIF
3158211127       CONTINUE
31583          ELSEIF(K.EQ.3)THEN
31584            DO11128J=1,NS(K)
31585              TEMP3(J)=TEMP4(J)
31586CCCCC         IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31587CCCCC           WRITE(ICOUT,11139)K,J,TEMP1(J)
31588C11139           FORMAT('K,J,TEMP1(J) = ',2I8,E15.7)
31589CCCCC           CALL DPWRST('XXX','BUG ')
31590CCCCC         ENDIF
3159111128       CONTINUE
31592          ENDIF
31593        ENDIF
3159411110 CONTINUE
31595C
31596C     -----BEGIN MATRIX COPY-----
31597C
31598      IF(ICASL7.EQ.'MADF')IMATSW='YES'
31599      IF(ICASL7.EQ.'DIMA')IMATSW='YES'
31600      IF(ICASL7.EQ.'MAVT')IMATSW='YES'
31601      IF(IMATSW.EQ.'NO')GOTO11290
31602C
31603      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31604        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
31605        IF(ITYPA(1).EQ.'MATR')THEN
31606          WRITE(ICOUT,11201)ILISR(1),ICOLR(1),IVALUE(ILISR(1)),
31607     1                      IVALU2(ILISR(1))
3160811201     FORMAT('11201--ILISR(1),ICOLR(1),IVALUE(ILISR(1)),',
31609     1           'IVALU2(ILISR(1))=',14I8)
31610          CALL DPWRST('XXX','BUG ')
31611        ENDIF
31612        DO11208I=1,MIN(4,NUMVAR)
31613          WRITE(ICOUT,11202)I,ITYPA(I)
3161411202     FORMAT('11202--I,ITYPA(I) = ',I4,2X,A4)
31615          CALL DPWRST('XXX','BUG ')
31616          WRITE(ICOUT,11204)I,ILISR(I),IVALU2(ILISR(I))
3161711204     FORMAT('11204--I,ILISR(I),IVALU2(I) = ',3I8)
31618          CALL DPWRST('XXX','BUG ')
3161911208   CONTINUE
31620      ENDIF
31621C
31622      NC1=1
31623      NC2=1
31624      NC3=1
31625      IF(ITYPA(1).EQ.'MATR'.AND.NUMVAR.GE.1)
31626     1NC1=IVALU2(ILISR(1))-IVALUE(ILISR(1))+1
31627      IF(ITYPA(2).EQ.'MATR'.AND.NUMVAR.GE.2)
31628     1NC2=IVALU2(ILISR(2))-IVALUE(ILISR(2))+1
31629      IF(ITYPA(3).EQ.'MATR'.AND.NUMVAR.GE.3)
31630     1NC3=IVALU2(ILISR(3))-IVALUE(ILISR(3))+1
31631      IF(ICASL7.EQ.'MADF')NC1=INT(TEMPS(3)+0.1)
31632C
31633      IF(NUMVAR.LE.0)GOTO11219
31634      IF(ITYPA(1).EQ.'MATR'.OR.ICASL7.EQ.'MADF')THEN
31635        NLOOP=NC1
31636        IF(NLOOP.LT.1)NLOOP=1
31637        DO11211JLOOP=1,NLOOP
31638          NS(1)=0
31639          DO11212I=1,NINEW
31640          IJ=MAXN*(ICOLR(1)-1+JLOOP-1)+I
31641          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31642            WRITE(ICOUT,11213)I,JLOOP,NS(1),NINEW,ISUB(I),IJ,V(IJ)
3164311213       FORMAT('I,JLOOP,NS(1),NINEW,ISUB(I),IJ,V(IJ) = ',6I8,F12.5)
31644            CALL DPWRST('XXX','BUG ')
31645          ENDIF
31646          IF(ISUB(I).EQ.0)GOTO11212
31647          IF(I.GT.NIRIGH(1))GOTO11214
31648          NS(1)=NS(1)+1
31649          IJ=MAXN*(ICOLR(1)-1+JLOOP-1)+I
31650          IF(ICOLR(1).LE.MAXCOL)TEMPM1((JLOOP-1)*MAXROM+NS(1))=V(IJ)
31651          IF(ICOLR(1).EQ.MAXCP1)TEMPM1((JLOOP-1)*MAXROM+NS(1))=PRED(I)
31652          IF(ICOLR(1).EQ.MAXCP2)TEMPM1((JLOOP-1)*MAXROM+NS(1))=RES(I)
31653          IF(ICOLR(1).EQ.MAXCP3)TEMPM1((JLOOP-1)*MAXROM+NS(1))=YPLOT(I)
31654          IF(ICOLR(1).EQ.MAXCP4)TEMPM1((JLOOP-1)*MAXROM+NS(1))=XPLOT(I)
31655          IF(ICOLR(1).EQ.MAXCP5)TEMPM1((JLOOP-1)*MAXROM+NS(1))=X2PLOT(I)
31656          IF(ICOLR(1).EQ.MAXCP6)TEMPM1((JLOOP-1)*MAXROM+NS(1))=TAGPLO(I)
3165711212     CONTINUE
3165811214     CONTINUE
3165911211   CONTINUE
31660      ENDIF
3166111219 CONTINUE
31662C
31663      IF(NUMVAR.LE.1)GOTO11229
31664      IF(ITYPA(2).EQ.'MATR')THEN
31665        NLOOP=NC2
31666        IF(NLOOP.LT.1)NLOOP=1
31667        DO11221JLOOP=1,NLOOP
31668          NS(2)=0
31669          DO11222I=1,NINEW
31670          IJ=MAXN*(ICOLR(2)-1+JLOOP-1)+I
31671          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31672            WRITE(ICOUT,11223)I,JLOOP,NS(2),NINEW,ISUB(I),IJ,V(IJ)
3167311223       FORMAT('I,JLOOP,NS(2),NINEW,ISUB(I),IJ,V(IJ) = ',6I8,F12.5)
31674            CALL DPWRST('XXX','BUG ')
31675          ENDIF
31676          IF(ISUB(I).EQ.0)GOTO11222
31677          IF(I.GT.NIRIGH(2))GOTO11224
31678          NS(2)=NS(2)+1
31679          IJ=MAXN*(ICOLR(2)-1+JLOOP-1)+I
31680          IF(ICOLR(2).LE.MAXCOL)TEMPM2((JLOOP-1)*MAXROM+NS(2))=V(IJ)
31681          IF(ICOLR(2).EQ.MAXCP1)TEMPM2((JLOOP-1)*MAXROM+NS(2))=PRED(I)
31682          IF(ICOLR(2).EQ.MAXCP2)TEMPM2((JLOOP-1)*MAXROM+NS(2))=RES(I)
31683          IF(ICOLR(2).EQ.MAXCP3)TEMPM2((JLOOP-1)*MAXROM+NS(2))=YPLOT(I)
31684          IF(ICOLR(2).EQ.MAXCP4)TEMPM2((JLOOP-1)*MAXROM+NS(2))=XPLOT(I)
31685          IF(ICOLR(2).EQ.MAXCP5)TEMPM2((JLOOP-1)*MAXROM+NS(2))=X2PLOT(I)
31686          IF(ICOLR(2).EQ.MAXCP6)TEMPM2((JLOOP-1)*MAXROM+NS(2))=TAGPLO(I)
3168711222     CONTINUE
3168811224     CONTINUE
3168911221   CONTINUE
31690      ENDIF
3169111229 CONTINUE
31692C
31693      IF(NUMVAR.LE.2)GOTO11239
31694        IF(ITYPA(3).EQ.'MATR')THEN
31695        NLOOP=NC3
31696        IF(NLOOP.LT.1)NLOOP=1
31697        DO11231JLOOP=1,NLOOP
31698          NS(3)=0
31699          DO11232I=1,NINEW
31700          IJ=MAXN*(ICOLR(3)-1+JLOOP-1)+I
31701          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31702            WRITE(ICOUT,11233)I,JLOOP,NS(3),NINEW,ISUB(I),IJ,V(IJ)
3170311233       FORMAT('I,JLOOP,NS(3),NINEW,ISUB(I),IJ,V(IJ) = ',6I8,F12.5)
31704            CALL DPWRST('XXX','BUG ')
31705          ENDIF
31706          IF(ISUB(I).EQ.0)GOTO11232
31707          IF(I.GT.NIRIGH(3))GOTO11234
31708          NS(3)=NS(3)+1
31709          IJ=MAXN*(ICOLR(3)-1+JLOOP-1)+I
31710          IF(ICOLR(3).LE.MAXCOL)TEMM91((JLOOP-1)*MAXROM+NS(3))=V(IJ)
31711          IF(ICOLR(2).EQ.MAXCP1)TEMM91((JLOOP-1)*MAXROM+NS(3))=PRED(I)
31712          IF(ICOLR(2).EQ.MAXCP2)TEMM91((JLOOP-1)*MAXROM+NS(3))=RES(I)
31713          IF(ICOLR(2).EQ.MAXCP3)TEMM91((JLOOP-1)*MAXROM+NS(3))=YPLOT(I)
31714          IF(ICOLR(2).EQ.MAXCP4)TEMM91((JLOOP-1)*MAXROM+NS(3))=XPLOT(I)
31715          IF(ICOLR(2).EQ.MAXCP5)TEMM91((JLOOP-1)*MAXROM+NS(3))=X2PLOT(I)
31716          IF(ICOLR(2).EQ.MAXCP6)TEMM91((JLOOP-1)*MAXROM+NS(3))=TAGPLO(I)
3171711232     CONTINUE
3171811234     CONTINUE
3171911231   CONTINUE
31720      ENDIF
3172111239 CONTINUE
31722C
3172311290 CONTINUE
31724C
31725C     -----END MATRIX COPY-----
31726C
31727      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31728        WRITE(ICOUT,11291)ICOLL(1),ICOLR(1),ICOLR(2),ICOLR(3),
31729     1                    NS(1),NS(2),NS(3)
3173011291   FORMAT('11291--ICOLL(1),ICOLR(1),ICOLR(2),ICOLR(3),',
31731     1         'NS(1),NS(2),NS(3) = ',7I8)
31732        CALL DPWRST('XXX','BUG ')
31733        WRITE(ICOUT,11292)NINEW,ICASL7,ICASEQ
3173411292   FORMAT('11292--NINEW,ICASL7,ICASEQ = ',I8,2X,A4,2X,A4)
31735        CALL DPWRST('XXX','BUG ')
31736        DO11294I=1,NUMVAR
31737        WRITE(ICOUT,11293)I,ITYPA(I)
3173811293   FORMAT('11293--I,ITYPA(I) =',I4,2X,A4)
31739        CALL DPWRST('XXX','BUG ')
3174011294   CONTINUE
31741        WRITE(ICOUT,11295)NS(1),NS(2),NS(3),NS(4)
3174211295   FORMAT('11295--NS(1),NS(2),NS(3),NS(4) = ',4I8)
31743        CALL DPWRST('XXX','BUG ')
31744        WRITE(ICOUT,11296)IMATSW,ICASL7
3174511296   FORMAT('11296--IMATSW,ICASL7 = ',A4,2X,A4)
31746        CALL DPWRST('XXX','BUG ')
31747      ENDIF
31748C
31749      IWRITE='ON'
31750      IF(IPRINT.EQ.'OFF')IWRITE='OFF'
31751      IF(IFEEDB.EQ.'OFF')IWRITE='OFF'
31752C
31753C     -----MATRIX SECTION-----
31754C
31755      IMCASE=ICASL7
31756      IUPFLG='FULL'
31757      NR1=1
31758      NR2=1
31759      NR3=1
31760      IF(ITYPA(1).EQ.'MATR'.AND.NUMVAR.GE.1)NR1=NS(1)
31761      IF(ITYPA(2).EQ.'MATR'.AND.NUMVAR.GE.2)NR2=NS(2)
31762      IF(ITYPA(3).EQ.'MATR'.AND.NUMVAR.GE.3)NR3=NS(3)
31763      IF(ICASL7.EQ.'MADF')NR1=INT(TEMPS(2)+0.1)
31764      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
31765        WRITE(ICOUT,11881)NS(1),NS(2),NS(3),NR1,NC1,NR2,NC2,NR3,NC3
3176611881   FORMAT('NS(1),NS(2),NS(3),NR1,NC1,NR2,NC2,NR3,NC3 = ',9I8)
31767        CALL DPWRST('XXX','BUG ')
31768      ENDIF
31769C
3177011189 CONTINUE
31771      IF(ICASL7.EQ.'MASV'.OR.ICASL7.EQ.'MASD'.OR.ICASL7.EQ.'MASF'.OR.
31772     1   ICASL7.EQ.'MARW'.OR.ICASL7.EQ.'MAEL'.OR.ICASL7.EQ.'MACH'.OR.
31773     1   ICASL7.EQ.'MAAU'.OR.ICASL7.EQ.'MADI'.OR.ICASL7.EQ.'DIMA'.OR.
31774     1   ICASL7.EQ.'MARR'.OR.ICASL7.EQ.'MARE'.OR.ICASL7.EQ.'MATD'.OR.
31775     1   ICASL7.EQ.'BIPL'.OR.
31776     1   ICASL7.EQ.'MATS'.OR.ICASL7.EQ.'MATI'.OR.ICASL7.EQ.'MAIS')THEN
31777        CALL MATAR2(TEMPM1,NR1,NC1,TEMPM2,NR2,NC2,NR3,NC3,
31778     1  MAXROM,MAXCOM,
31779     1  TEMP1,NS(1),TEMP2,NS(2),TEMP3,NS(3),TEMP4,NS(4),
31780     1  ITEMP1,
31781     1  TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4),
31782     1  IMCASE,IUPFLG,IMSUBC,
31783     1  ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4),NUMVAR,IWRITE,
31784     1  IBPLSC,PBPLCO,
31785     1  TEMM91,NR91,NC91,TEMP91,NVECT9,SCAL91,ITYP91,
31786     1  IBUGA3,ISUBRO,IERROR)
31787      ELSEIF(ICASL7.EQ.'MPIN'.OR.ICASL7.EQ.'MQFO'.OR.
31788     1   ICASL7.EQ.'MALC'.OR.ICASL7.EQ.'MAVT'.OR.ICASL7.EQ.'MAGM'.OR.
31789     1   ICASL7.EQ.'MAGS'.OR.ICASL7.EQ.'MHT1'.OR.ICASL7.EQ.'MHT2'.OR.
31790     1   ICASL7.EQ.'MPVC'.OR.ICASL7.EQ.'MAMM'.OR.ICASL7.EQ.'MAAR'.OR.
31791     1   ICASL7.EQ.'MADR'.OR.ICASL7.EQ.'MDER'.OR.ICASL7.EQ.'MDEC'.OR.
31792     1   ICASL7.EQ.'MDMR'.OR.ICASL7.EQ.'MDMC'.OR.ICASL7.EQ.'MDBR'.OR.
31793     1   ICASL7.EQ.'MDBC'.OR.ICASL7.EQ.'MDKR'.OR.ICASL7.EQ.'MDKC'.OR.
31794     1   ICASL7.EQ.'MDCR'.OR.ICASL7.EQ.'MDCC'.OR.ICASL7.EQ.'MRSC'.OR.
31795     1   ICASL7.EQ.'MCSC'.OR.ICASL7.EQ.'MDIP'.OR.ICASL7.EQ.'MADM'.OR.
31796     1   ICASL7.EQ.'MVRN'.OR.ICASL7.EQ.'MACA'.OR.ICASL7.EQ.'XTXI'.OR.
31797     1   ICASL7.EQ.'VINF'.OR.ICASL7.EQ.'CIND'.OR.ICASL7.EQ.'MARN'.OR.
31798     1   ICASL7.EQ.'MURN'.OR.ICASL7.EQ.'WIRN'.OR.ICASL7.EQ.'MPDF'.OR.
31799     1   ICASL7.EQ.'MROW'.OR.ICASL7.EQ.'MCOL'.OR.ICASL7.EQ.'DPDF'.OR.
31800     1   ICASL7.EQ.'NCDF'.OR.ICASL7.EQ.'TCDF'.OR.ICASL7.EQ.'DLPD'.OR.
31801     1   ICASL7.EQ.'MTRN'.OR.ICASL7.EQ.'DIRN'.OR.ICASL7.EQ.'INRN'.OR.
31802     1   ICASL7.EQ.'MPAR'.OR.ICASL7.EQ.'MGRA'.OR.ICASL7.EQ.'MSP2'.OR.
31803     1   ICASL7.EQ.'MATB'.OR.ICASL7.EQ.'MARB'.OR.ICASL7.EQ.'MSPT'.OR.
31804     1   ICASL7.EQ.'ADMA'.OR.ICASL7.EQ.'ADMD'.OR.ICASL7.EQ.'CONF'.OR.
31805     1   ICASL7.EQ.'MFTR'.OR.ICASL7.EQ.'MFTC'.OR.ICASL7.EQ.'CKCL'.OR.
31806     1   ICASL7.EQ.'CKCP'.OR.
31807     1   ICASL7.EQ.'VMAT'.OR.ICASL7.EQ.'MVAR'.OR.ICASL7.EQ.'CORE'.OR.
31808     1   ICASL7.EQ.'MCRO'.OR.ICASL7.EQ.'MCCO'.OR.ICASL7.EQ.'GMST'.OR.
31809     1   ICASL7.EQ.'MCSR'.OR.ICASL7.EQ.'MCSC'.OR.
31810     1   ICASL7.EQ.'MCDR'.OR.ICASL7.EQ.'MCDC'.OR.
31811     1   ICASL7.EQ.'MZSR'.OR.ICASL7.EQ.'MASC'.OR.
31812     1   ICASL7.EQ.'MZDR'.OR.ICASL7.EQ.'MADC'.OR.
31813     1   ICASL7.EQ.'MJSR'.OR.ICASL7.EQ.'MJSC'.OR.
31814     1   ICASL7.EQ.'MJDR'.OR.ICASL7.EQ.'MJDC'.OR.
31815     1   ICASL7.EQ.'MPDR'.OR.ICASL7.EQ.'MPDC'.OR.
31816     1   ICASL7.EQ.'MPSR'.OR.ICASL7.EQ.'MPSC'.OR.
31817     1   ICASL7.EQ.'MHDR'.OR.ICASL7.EQ.'MHDC'.OR.
31818     1   ICASL7.EQ.'MXDR'.OR.ICASL7.EQ.'MXDC'.OR.
31819     1   ICASL7.EQ.'CRMA'.OR.ICASL7.EQ.'IURN'.OR.ICASL7.EQ.'MSUM')THEN
31820C
31821        IHP='P   '
31822        IHP2='    '
31823        IHWUSE='P'
31824        MESSAG='NO'
31825        CALL CHECKN(IHP,IHP2,IHWUSE,
31826     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
31827     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
31828        IF(IERROR.EQ.'YES')THEN
31829          P=2.0
31830        ELSE
31831          P=VALUE(ILOCP)
31832        ENDIF
31833C
31834        IHP='ABSE'
31835        IHP2='PS  '
31836        IHWUSE='P'
31837        MESSAG='NO'
31838        CALL CHECKN(IHP,IHP2,IHWUSE,
31839     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
31840     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
31841        IF(IERROR.EQ.'YES')THEN
31842          ABSEPS=0.00005
31843          IF(ICASL7.EQ.'TCDF')ABSEPS=0.0
31844        ELSE
31845          ABSEPS=VALUE(ILOCP)
31846        ENDIF
31847C
31848        IHP='RELE'
31849        IHP2='PS  '
31850        IHWUSE='P'
31851        MESSAG='NO'
31852        CALL CHECKN(IHP,IHP2,IHWUSE,
31853     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
31854     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
31855        IF(IERROR.EQ.'YES')THEN
31856          RELEPS=0.0
31857          IF(ICASL7.EQ.'TCDF')RELEPS=0.005
31858        ELSE
31859          RELEPS=VALUE(ILOCP)
31860        ENDIF
31861C
31862        IRELAT='OFF'
31863        IF(ICASL7.EQ.'MARB')IRELAT='ON'
31864        CLWID=CLWIDT(1)
31865        XSTART=CLLIMI(1)
31866        XSTOP=CLLIMI(2)
31867C
31868        CALL MATAR3(TEMPM1,NR1,NC1,TEMPM2,NR2,NC2,NR3,NC3,
31869     1              MAXROM,MAXCOM,MAXOBV,
31870     1              TEMP1,NS(1),TEMP2,NS(2),TEMP3,NS(3),
31871     1              TEMP4,NS(4),TEMP12,TEMP92,
31872     1              INDEX,
31873     1              DTEMP1,DTEMP2,DTEMP3,
31874     1              P,ABSEPS,RELEPS,ERRS,
31875     1              TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4),
31876     1              ASIG90,ASIG95,ASIG99,ASG995,
31877     1              IMCASE,IUPFLG,IMSUBC,
31878     1              ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4),NUMVAR,IWRITE,
31879     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,
31880     1              ITEMP5,ITEMP6,ITEMP7,
31881     1              TEMM91,NR91,NC91,TEMP91,NVECT9,SCAL91,ITYP91,
31882     1              ICASS7,
31883     1              IRELAT,CLWID,XSTART,XSTOP,
31884     1              STME,STMEC,ST2T,ST2TC,STC,STT,
31885     1              IBUGA3,ISUBRO,IERROR)
31886C
31887        IF(ICASL7.EQ.'CONF')THEN
31888          IHP='FLAG'
31889          IHP2='DCON'
31890          VALUE0=1.0
31891          IF(IERROR.EQ.'YES')THEN
31892            VALUE0=0.0
31893            CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
31894     1      IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
31895     1      IANS,IWIDTH,IBUGA3,IERROR)
31896            GOTO19000
31897          ENDIF
31898          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
31899     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
31900     1    IANS,IWIDTH,IBUGA3,IERROR)
31901        ELSEIF(ICASL7.EQ.'MHT1'.OR.ICASL7.EQ.'MHT2')THEN
31902          IHP='B90 '
31903          IHP2='    '
31904          VALUE0=ASIG90
31905          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
31906     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
31907     1    IANS,IWIDTH,IBUGA3,IERROR)
31908C
31909          IHP='B95 '
31910          IHP2='    '
31911          VALUE0=ASIG95
31912          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
31913     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
31914     1    IANS,IWIDTH,IBUGA3,IERROR)
31915C
31916          IHP='B99 '
31917          IHP2='    '
31918          VALUE0=ASIG99
31919          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
31920     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
31921     1    IANS,IWIDTH,IBUGA3,IERROR)
31922C
31923          IHP='B995'
31924          IHP2='    '
31925          VALUE0=ASG995
31926          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
31927     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
31928     1    IANS,IWIDTH,IBUGA3,IERROR)
31929        ENDIF
31930C
31931      ELSE
31932        IHP='P1  '
31933        IHP2='    '
31934        IHWUSE='P'
31935        MESSAG='NO'
31936        CALL CHECKN(IHP,IHP2,IHWUSE,
31937     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
31938     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
31939        IF(IERROR.EQ.'YES')THEN
31940          P1=10.0
31941        ELSE
31942          P1=VALUE(ILOCP)
31943          IF(P1.LT.0.0)P1=10.0
31944          IF(P1.GT.50.0)P1=50.0
31945        ENDIF
31946C
31947        IHP='P2  '
31948        IHP2='    '
31949        IHWUSE='P'
31950        MESSAG='NO'
31951        CALL CHECKN(IHP,IHP2,IHWUSE,
31952     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
31953     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
31954        IF(IERROR.EQ.'YES')THEN
31955          P2=10.0
31956        ELSE
31957          P2=VALUE(ILOCP)
31958          IF(P2.LT.0.0)P2=10.0
31959          IF(P2.GT.50.0)P2=50.0
31960        ENDIF
31961C
31962        IHP='BETA'
31963        IHP2='    '
31964        IHWUSE='P'
31965        MESSAG='NO'
31966        CALL CHECKN(IHP,IHP2,IHWUSE,
31967     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
31968     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
31969        IF(IERROR.EQ.'YES')THEN
31970          BETA=0.1
31971        ELSE
31972          BETA=VALUE(ILOCP)
31973          IF(BETA.LE.0.0)BETA=0.01
31974          IF(P2.GT.0.5)BETA=0.5
31975        ENDIF
31976C
31977        CALL MATARI(TEMPM1,NR1,NC1,TEMPM2,NR2,NC2,NR3,NC3,
31978     1  MAXROM,MAXCOM,
31979     1  TEMP1,NS(1),TEMP2,NS(2),TEMP3,NS(3),TEMP4,NS(4),
31980     1  ITEMP1,ITEMP2,ITEMP3,
31981     1  DTEMP1,DTEMP2,P1,P2,BETA,
31982     1  TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4),
31983     1  IMCASE,IUPFLG,IMSUBC,
31984     1  ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4),NUMVAR,IWRITE,
31985     1  TEMM91,NR91,NC91,TEMP91,NVECT9,SCAL91,ITYP91,
31986     1  IBUGA3,ISUBRO,IERROR)
31987C
31988      ENDIF
31989C
31990      NITEMX=NVECT9
31991      IF(IERROR.EQ.'YES')GOTO19000
31992      IF(ITYP91.EQ.'VECT')THEN
31993        DO11887I=1,NITEMX
31994          TEMP1(I)=TEMP91(I)
3199511887   CONTINUE
31996      ELSEIF(ITYP91.EQ.'MATR')THEN
31997        NITEMX=NR91
31998        DO11882J=1,NC91
31999        DO11883I=1,NITEMX
32000          TEMPM1((J-1)*MAXROM+I)=TEMM91((J-1)*MAXROM+I)
32001C
32002          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
32003            WRITE(ICOUT,11885)I,J,TEMM91((J-1)*MAXROM+I)
3200411885       FORMAT('I,J,TEMPM1((J-1)*MAXROM+I) = ',2I8,E15.7)
32005            CALL DPWRST('XXX','BUG ')
32006          ENDIF
32007C
3200811883   CONTINUE
3200911882   CONTINUE
32010        IF(ICASL7.EQ.'MASD' .OR. ICASL7.EQ.'MASF')THEN
32011          DO11886I=1,NVECT9
32012            TEMP1(I)=TEMP91(I)
3201311886     CONTINUE
32014        ENDIF
32015      ENDIF
32016      IFOUND='YES'
32017      IF(IERROR.EQ.'YES')GOTO19000
32018C
32019C
32020C               ************************************************
32021C               **  STEP XX--                                 **
32022C               **  BRANCH TO THE PROPER CASE                 **
32023C               **  DEPENDING ON THE TYPE OF OUTPUT--         **
32024C               **     1) SCALAR (= PARAMETER)                **
32025C               **     2) VECTOR (= VARIABLE) (THE USUAL)     **
32026C               **     3) MATRIX                              **
32027C               **  UPDATE DATAPLOT'S INTERNAL WORKSPACE      **
32028C               **  AND HOUSEKEEPING TABLES                   **
32029C               ************************************************
32030C
32031      IF(ITYP91.EQ.'SCAL')GOTO14000
32032C
32033C     -----TREAT THE VECTOR AND MATRIX CASE-----
32034C
32035CCCCC NOTE: FOR "MATRIX COLUMN <STAT>"
32036CCCCC CASE, TREAT AS FULL EVEN IF A SUBSET CLAUSE WAS ENTERED
32037CCCCC (NUMBER OF ROWS IN THE RETURNED VECTOR IS KEYED TO THE
32038CCCCC COLUMNS IN THE MATRIX, NOT THE ROWS IN THE MATRIX).
32039CCCCC NOTE: FURTHER CONSIDERATION SHOWED THAT WHETHER UPDATING
32040CCCCC SHOULD BE DONE AS "FULL" OR AS SUBSET CASE DEPENDDS ON THE
32041CCCCC SPECIFIC MATRIX COMMAND (E.G., MATRIX ADDITION SHOULD MAINTAIN
32042CCCCC THE SUBSET WHEN SAVING THE RESULT, WHILE A CORRELATION
32043CCCCC MATRIX SHOULD ALWAYS BE UPDATED AS A FULL MATRIX).
32044C
32045      IF(IUPFLG.EQ.'FULL' .OR. ICASEQ.EQ.'FULL')GOTO12100
32046      IF(ICASEQ.EQ.'SUBS')GOTO12300
32047      IF(ICASEQ.EQ.'FOR')GOTO12500
32048C
32049C               *******************************************
32050C               **  STEP 11.1--                          **
32051C               **  TREAT THE FULL CASE.                 **
32052C               *******************************************
32053C
3205412100 CONTINUE
32055      ISTEPN='11.1'
32056      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32057      NSX=0
32058      IF(NITEMX.LE.0)THEN
32059        IROW1=0
32060        IROWN=0
32061        GOTO12190
32062      ENDIF
32063C
32064      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')GOTO12130
32065      IF(ICASL7.EQ.'IURN'.AND.ITYP91.EQ.'MATR')GOTO12130
32066      IF(ICASL7.EQ.'DIRN'.AND.ITYP91.EQ.'MATR')GOTO12130
32067      IF(ICASL7.EQ.'MURN'.AND.ITYP91.EQ.'MATR')GOTO12130
32068      IF(ICASL7.EQ.'WIRN'.AND.ITYP91.EQ.'MATR')GOTO12130
32069      IF(ICASL7.EQ.'ADMA'.AND.ITYP91.EQ.'MATR')GOTO12130
32070      IF(ICASL7.EQ.'VMAT'.AND.ITYP91.EQ.'MATR')GOTO12130
32071C
32072      DO12110I=1,NITEMX
32073        NSX=I
32074C
32075        IJ=MAXN*(ICOLL(1)-1)+I
32076        IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(NSX)
32077        IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(NSX)
32078        IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(NSX)
32079        IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(NSX)
32080        IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(NSX)
32081        IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(NSX)
32082        IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(NSX)
3208312110 CONTINUE
32084C
32085      IF(ICASL7.EQ.'MATB' .OR. ICASL7.EQ.'MARB' .OR.
32086     1   ICASL7.EQ.'MSPT' .OR. ICASL7.EQ.'MSP2' .OR.
32087     1   ICASL7.EQ.'MFTR' .OR. ICASL7.EQ.'MFTC' .OR.
32088     1   ICASL7.EQ.'BIPL' .OR. ICASL7.EQ.'CONF')THEN
32089        DO12120I=1,NITEMX
32090          NSX=I
32091          IJ=MAXN*(ICOLL(2)-1)+I
32092          IF(ICOLL(2).LE.MAXCOL)V(IJ)=TEMP2(NSX)
32093          IF(ICOLL(2).EQ.MAXCP1)PRED(I)=TEMP2(NSX)
32094          IF(ICOLL(2).EQ.MAXCP2)RES(I)=TEMP2(NSX)
32095          IF(ICOLL(2).EQ.MAXCP3)YPLOT(I)=TEMP2(NSX)
32096          IF(ICOLL(2).EQ.MAXCP4)XPLOT(I)=TEMP2(NSX)
32097          IF(ICOLL(2).EQ.MAXCP5)X2PLOT(I)=TEMP2(NSX)
32098          IF(ICOLL(2).EQ.MAXCP6)TAGPLO(I)=TEMP2(NSX)
3209912120   CONTINUE
32100      ENDIF
32101C
32102      IF(ICASL7.EQ.'MSPT' .OR. ICASL7.EQ.'BIPL' .OR.
32103     1   ICASL7.EQ.'MFTR' .OR. ICASL7.EQ.'MFTC')THEN
32104        DO12122I=1,NITEMX
32105          NSX=I
32106          IJ=MAXN*(ICOLL(3)-1)+I
32107          IF(ICOLL(3).LE.MAXCOL)V(IJ)=TEMP3(NSX)
32108          IF(ICOLL(3).EQ.MAXCP1)PRED(I)=TEMP3(NSX)
32109          IF(ICOLL(3).EQ.MAXCP2)RES(I)=TEMP3(NSX)
32110          IF(ICOLL(3).EQ.MAXCP3)YPLOT(I)=TEMP3(NSX)
32111          IF(ICOLL(3).EQ.MAXCP4)XPLOT(I)=TEMP3(NSX)
32112          IF(ICOLL(3).EQ.MAXCP5)X2PLOT(I)=TEMP3(NSX)
32113          IF(ICOLL(3).EQ.MAXCP6)TAGPLO(I)=TEMP3(NSX)
3211412122   CONTINUE
32115      ENDIF
32116C
32117      IF(ICASL7.EQ.'MFTR' .OR. ICASL7.EQ.'MFTC')THEN
32118        DO12123I=1,NITEMX
32119          NSX=I
32120          IJ=MAXN*(ICOLL(4)-1)+I
32121          IF(ICOLL(4).LE.MAXCOL)V(IJ)=TEMP4(NSX)
32122          IF(ICOLL(4).EQ.MAXCP1)PRED(I)=TEMP4(NSX)
32123          IF(ICOLL(4).EQ.MAXCP2)RES(I)=TEMP4(NSX)
32124          IF(ICOLL(4).EQ.MAXCP3)YPLOT(I)=TEMP4(NSX)
32125          IF(ICOLL(4).EQ.MAXCP4)XPLOT(I)=TEMP4(NSX)
32126          IF(ICOLL(4).EQ.MAXCP5)X2PLOT(I)=TEMP4(NSX)
32127          IF(ICOLL(4).EQ.MAXCP6)TAGPLO(I)=TEMP4(NSX)
3212812123   CONTINUE
32129      ENDIF
32130C
32131      GOTO12190
32132C
32133C     -----BEGIN MATRIX COPY FOR FULL CASE-----
32134C
3213512130 CONTINUE
32136      ISTEPN='FULL'
32137      ISTEPN='11.3'
32138      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
32139     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32140      NLOOP=NC91
32141C
32142      ICOL=ICOLL(1)-1+NLOOP
32143      IF(ICOL.LE.MAXCOL)GOTO12139
32144      WRITE(ICOUT,999)
32145      CALL DPWRST('XXX','BUG ')
32146      WRITE(ICOUT,12131)
3214712131 FORMAT('***** ERROR 12131 IN DPMAT2--')
32148      CALL DPWRST('XXX','BUG ')
32149      WRITE(ICOUT,12132)
3215012132 FORMAT('      AN ATTEMPT WAS MADE TO CREATE')
32151      CALL DPWRST('XXX','BUG ')
32152      WRITE(ICOUT,12133)
3215312133 FORMAT('      A MATRIX WHOSE COLUMNS EXTEND')
32154      CALL DPWRST('XXX','BUG ')
32155      WRITE(ICOUT,12134)MAXCOL
3215612134 FORMAT('      BEYOND THE ALLOWABLE ',I8,' COLUMNS')
32157      CALL DPWRST('XXX','BUG ')
32158      WRITE(ICOUT,12135)
3215912135 FORMAT('      OF THE INTERNAL INTERNAL WORKSHEET.')
32160      CALL DPWRST('XXX','BUG ')
32161      IERROR='YES'
32162      GOTO19000
3216312139 CONTINUE
32164C
32165CCCCC OCTOBER 1993.  FOR MATRIX AUGMENT, NEED TO ADD NC2 BLANK
32166CCCCC COLUMNS IF LEFT HAND MATRIX IS OLD.
32167      IF(NEWNAM(1).NE.'YES'.AND.ICASL7.EQ.'MAAU')THEN
32168        NFIRST=IVALU2(ILISL(1))+1
32169        NUMADD=NC2
32170        IERROR='NO'
32171        CALL DPUPD2(NUMADD,NFIRST,IBUGA3,IERROR)
32172        IF(IERROR.EQ.'YES')GOTO19000
32173      ENDIF
32174C
32175      ISTEPN='11.4'
32176      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
32177     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32178      DO12140JLOOP=1,NLOOP
32179      NSX=0
32180      DO12150I=1,NITEMX
32181      NSX=I
32182      IJ=MAXN*(ICOLL(1)-1+JLOOP-1)+I
32183      IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMPM1((JLOOP-1)*MAXROM+NSX)
3218412150 CONTINUE
3218512140 CONTINUE
32186C
32187CCCCC JULY 1993.  IF FIRST MATRIX IS NEW, NEED TO ADJUST COLUMN
32188CCCCC             NUMBERS FOR SECOND (AND POSSIBLY THIRD) NEW VARIABLES
32189CCCCC             OR MATRICES ON LEFT.
32190      IF(NEWNAM(1).EQ.'YES')THEN
32191        IF(NEWNAM(2).EQ.'YES')THEN
32192          NADD=NLOOP-1
32193          ICOLL(2)=ICOLL(2)+NADD
32194          ILISL(2)=ILISL(2)+NADD+1
32195        ENDIF
32196        IF(NEWNAM(3).EQ.'YES')THEN
32197          NADD=NLOOP-1
32198          ICOLL(3)=ICOLL(3)+NADD
32199          ILISL(3)=ILISL(3)+NADD+1
32200        ENDIF
32201      ENDIF
32202      IF(ICASL7.EQ.'MASD')GOTO22130
32203      IF(ICASL7.EQ.'MASF')GOTO22130
32204      GOTO12190
32205C
32206CCCCC NOTE: FOR SVD, SVF, HAVE LET U S V = MATRIX SING VALUE FACT M
32207CCCCC       I.E., THE SECOND MATRIX IS IN THE THIRD ARGUMENT.
3220822130 CONTINUE
32209      NLOOP=NC2
32210C
32211      ICOL=ICOLL(3)-1+NLOOP
32212      IF(ICOL.LE.MAXCOL)GOTO22139
32213      WRITE(ICOUT,999)
32214      CALL DPWRST('XXX','BUG ')
32215      WRITE(ICOUT,22131)
3221622131 FORMAT('***** ERROR 22131 IN DPMAT2--')
32217      CALL DPWRST('XXX','BUG ')
32218      WRITE(ICOUT,22132)
3221922132 FORMAT('      AN ATTEMPT WAS MADE TO CREATE')
32220      CALL DPWRST('XXX','BUG ')
32221      WRITE(ICOUT,22133)
3222222133 FORMAT('      A MATRIX WHOSE COLUMNS EXTEND')
32223      CALL DPWRST('XXX','BUG ')
32224      WRITE(ICOUT,22134)MAXCOL
3222522134 FORMAT('      BEYOND THE ALLOWABLE ',I8,' COLUMNS')
32226      CALL DPWRST('XXX','BUG ')
32227      WRITE(ICOUT,22135)
3222822135 FORMAT('      OF THE INTERNAL INTERNAL WORKSHEET.')
32229      CALL DPWRST('XXX','BUG ')
32230      IERROR='YES'
32231      GOTO19000
3223222139 CONTINUE
32233C
32234      DO22140JLOOP=1,NLOOP
32235      NSX=0
32236      DO22150I=1,NR2
32237      NSX=I
32238      IJ=MAXN*(ICOLL(3)-1+JLOOP-1)+I
32239      IF(ICOLL(3).LE.MAXCOL)V(IJ)=TEMPM2((JLOOP-1)*MAXROM+NSX)
3224022150 CONTINUE
3224122140 CONTINUE
32242      GOTO12190
32243C
32244C     -----END MATRIX COPY FOR FULL CASE-----
32245C
3224612190 CONTINUE
32247C
32248      IF(ICASL7.NE.'MASD'.AND.ICASL7.NE.'MASF')THEN
32249        IF(NITEMX.GE.1)IROW1=1
32250        IF(NITEMX.GE.1)IROWN=NITEMX
32251        IN(ILISL(1))=NITEMX
32252        IF(NUMVAL.GE.2)IN(ILISL(2))=NITEMX
32253        IF(NUMVAL.GE.3)IN(ILISL(3))=NITEMX
32254        IF(NUMVAL.GE.4)IN(ILISL(4))=NITEMX
32255      ELSE
32256        IF(NITEMX.GE.1)IROW1=1
32257        IF(NITEMX.GE.1)IROWN=NITEMX
32258        IN(ILISL(1))=NITEMX
32259        IF(NUMVAL.EQ.2)IN(ILISL(2))=NVECT9
32260        IF(NUMVAL.EQ.3)IN(ILISL(3))=NR2
32261      ENDIF
32262C
32263      DO12210J4=1,NUMNAM
32264      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12215
32265      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12215
32266      GOTO12210
3226712215 CONTINUE
32268      IUSE(J4)='V'
32269      IVALUE(J4)=ICOLL(1)
32270      VALUE(J4)=ICOLL(1)
32271      IN(J4)=NITEMX
32272      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')THEN
32273        IVALUE(J4)=ICOLL(1)
32274        IVALU2(J4)=ICOLL(1)+NC91-1
32275      ENDIF
3227612210 CONTINUE
32277C
32278      IF(NUMVAL.LE.1)GOTO12229
32279      DO12220J4=1,NUMNAM
32280      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12225
32281      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12225
32282      GOTO12220
3228312225 CONTINUE
32284      IUSE(J4)='V'
32285      IVALUE(J4)=ICOLL(2)
32286      VALUE(J4)=ICOLL(2)
32287      IF(ICASL7.NE.'MASD'.AND.ICASL7.NE.'MASF')THEN
32288        IN(J4)=NITEMX
32289      ELSE
32290        IN(J4)=NVECT9
32291      ENDIF
3229212220 CONTINUE
3229312229 CONTINUE
32294C
32295      IF(NUMVAL.LE.2)GOTO12239
32296      DO12230J4=1,NUMNAM
32297      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(3))GOTO12235
32298      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(3))GOTO12235
32299      GOTO12230
3230012235 CONTINUE
32301      IUSE(J4)='V'
32302      IVALUE(J4)=ICOLL(3)
32303      VALUE(J4)=ICOLL(3)
32304      IF(ICASL7.NE.'MASD'.AND.ICASL7.NE.'MASF')THEN
32305        IN(J4)=NITEMX
32306      ELSE
32307        IN(J4)=NR2
32308        IVALUE(J4)=ICOLL(3)
32309        IVALU2(J4)=ICOLL(3)+NC2-1
32310      ENDIF
3231112230 CONTINUE
3231212239 CONTINUE
32313C
32314      IF(NUMVAL.LE.3)GOTO12249
32315      DO12240J4=1,NUMNAM
32316      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(4))GOTO12245
32317      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(4))GOTO12245
32318      GOTO12240
3231912245 CONTINUE
32320      IUSE(J4)='V'
32321      IVALUE(J4)=ICOLL(4)
32322      VALUE(J4)=ICOLL(4)
32323      IN(J4)=NITEMX
3232412240 CONTINUE
3232512249 CONTINUE
32326C
32327      GOTO13000
32328C
32329C               *******************************************
32330C               **  STEP 11.2--                          **
32331C               **  TREAT THE SUBSET CASE.               **
32332C               *******************************************
32333C
3233412300 CONTINUE
32335      ISTEPN='11.2'
32336      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32337      NSX=0
32338      IF(NITEMX.LE.0)IROW1=0
32339      IF(NITEMX.LE.0)IROWN=0
32340      IF(NITEMX.LE.0)GOTO12390
32341C
32342      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')GOTO12330
32343C
32344      DO12310I=1,NITEMX
32345        IF(ISUB(I).EQ.0)GOTO12310
32346        NSX=NSX+1
32347C
32348        IJ=MAXN*(ICOLL(1)-1)+I
32349        IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(NSX)
32350        IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(NSX)
32351        IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(NSX)
32352        IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(NSX)
32353        IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(NSX)
32354        IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(NSX)
32355        IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(NSX)
32356        IF(NSX.EQ.1)IROW1=I
32357        IROWN=I
32358C
3235912310 CONTINUE
32360      GOTO12390
32361C
32362C     -----BEGIN MATRIX COPY FOR SUBSET CASE-----
32363C
3236412330 CONTINUE
32365      NLOOP=NC91
32366C
32367      ICOL=ICOLL(1)-1+NLOOP
32368      IF(ICOL.LE.MAXCOL)GOTO12339
32369      WRITE(ICOUT,999)
32370      CALL DPWRST('XXX','BUG ')
32371      WRITE(ICOUT,12331)
3237212331 FORMAT('***** ERROR 12331 IN DPMAT2--')
32373      CALL DPWRST('XXX','BUG ')
32374      WRITE(ICOUT,12332)
3237512332 FORMAT('      AN ATTEMPT WAS MADE TO CREATE')
32376      CALL DPWRST('XXX','BUG ')
32377      WRITE(ICOUT,12333)
3237812333 FORMAT('      A MATRIX WHOSE COLUMNS EXTEND')
32379      CALL DPWRST('XXX','BUG ')
32380      WRITE(ICOUT,12334)MAXCOL
3238112334 FORMAT('      BEYOND THE ALLOWABLE ',I8,' COLUMNS')
32382      CALL DPWRST('XXX','BUG ')
32383      WRITE(ICOUT,12335)
3238412335 FORMAT('      OF THE INTERNAL INTERNAL WORKSHEET.')
32385      CALL DPWRST('XXX','BUG ')
32386      IERROR='YES'
32387      GOTO19000
3238812339 CONTINUE
32389C
32390      DO12340JLOOP=1,NLOOP
32391      NSX=0
32392      DO12350I=1,NITEMX
32393      IF(ISUB(I).EQ.0)GOTO12350
32394      NSX=NSX+1
32395      IJ=MAXN*(ICOLL(1)-1+JLOOP-1)+I
32396      IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMPM1((JLOOP-1)*MAXROM+NSX)
32397      IF(NSX.EQ.1)IROW1=I
32398      IROWN=I
3239912350 CONTINUE
3240012340 CONTINUE
32401      GOTO12390
32402C
32403C     -----END MATRIX COPY FOR SUBSET CASE-----
32404C
3240512390 CONTINUE
32406C
32407      IN(ILISL(1))=NITEMX
32408      IF(NUMVAL.EQ.2)IN(ILISL(2))=NITEMX
32409C
32410      DO12410J4=1,NUMNAM
32411      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12415
32412      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12415
32413      GOTO12410
3241412415 CONTINUE
32415      IUSE(J4)='V'
32416      IVALUE(J4)=ICOLL(1)
32417      VALUE(J4)=ICOLL(1)
32418      IN(J4)=NITEMX
32419      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')IVALUE(J4)=ICOLL(1)
32420      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')IVALU2(J4)=ICOLL(1)+NC91-1
3242112410 CONTINUE
32422C
32423      IF(NUMVAL.LE.1)GOTO12429
32424      DO12420J4=1,NUMNAM
32425      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12425
32426      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12425
32427      GOTO12420
3242812425 CONTINUE
32429      IUSE(J4)='V'
32430      IVALUE(J4)=ICOLL(2)
32431      VALUE(J4)=ICOLL(2)
32432      IN(J4)=NITEMX
3243312420 CONTINUE
3243412429 CONTINUE
32435C
32436      GOTO13000
32437C
32438C               *******************************************
32439C               **  STEP 11.3--                          **
32440C               **  TREAT THE FOR CASE.                  **
32441C               *******************************************
32442C
3244312500 CONTINUE
32444      ISTEPN='11.3'
32445      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32446      NSX=0
32447      IF(NITEMX.LE.0)IROW1=0
32448      IF(NITEMX.LE.0)IROWN=0
32449      IF(NITEMX.LE.0)GOTO12590
32450C
32451      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')GOTO12530
32452C
32453      DO12510I=1,NITEMX
32454        IF(I.GT.NIFOR)GOTO12590
32455        IF(ISUB(I).EQ.0)GOTO12510
32456        NSX=NSX+1
32457        IJ=MAXN*(ICOLL(1)-1)+I
32458        IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(NSX)
32459        IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(NSX)
32460        IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(NSX)
32461        IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(NSX)
32462        IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(NSX)
32463        IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(NSX)
32464        IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(NSX)
32465        IF(NSX.EQ.1)IROW1=I
32466        IROWN=I
32467C
3246812510 CONTINUE
32469      GOTO12590
32470C
32471C     -----BEGIN MATRIX COPY FOR   FOR    CASE-----
32472C
3247312530 CONTINUE
32474      NLOOP=NC91
32475C
32476      ICOL=ICOLL(1)-1+NLOOP
32477      IF(ICOL.LE.MAXCOL)GOTO12539
32478      WRITE(ICOUT,999)
32479      CALL DPWRST('XXX','BUG ')
32480      WRITE(ICOUT,12531)
3248112531 FORMAT('***** ERROR 12531 IN DPMAT2--')
32482      CALL DPWRST('XXX','BUG ')
32483      WRITE(ICOUT,12532)
3248412532 FORMAT('      AN ATTEMPT WAS MADE TO CREATE')
32485      CALL DPWRST('XXX','BUG ')
32486      WRITE(ICOUT,12533)
3248712533 FORMAT('      A MATRIX WHOSE COLUMNS EXTEND')
32488      CALL DPWRST('XXX','BUG ')
32489      WRITE(ICOUT,12534)MAXCOL
3249012534 FORMAT('      BEYOND THE ALLOWABLE ',I8,' COLUMNS')
32491      CALL DPWRST('XXX','BUG ')
32492      WRITE(ICOUT,12535)
3249312535 FORMAT('      OF THE INTERNAL INTERNAL WORKSHEET.')
32494      CALL DPWRST('XXX','BUG ')
32495      IERROR='YES'
32496      GOTO19000
3249712539 CONTINUE
32498C
32499      DO12540JLOOP=1,NLOOP
32500      NSX=0
32501      DO12550I=1,NITEMX
32502      IF(I.GT.NIFOR)GOTO12550
32503      IF(ISUB(I).EQ.0)GOTO12550
32504      NSX=NSX+1
32505      IJ=MAXN*(ICOLL(1)-1+JLOOP-1)+I
32506      IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMPM1((JLOOP-1)*MAXROM+NSX)
32507      IF(NSX.EQ.1)IROW1=I
32508      IROWN=I
3250912550 CONTINUE
3251012540 CONTINUE
32511      GOTO12590
32512C
32513C     -----END MATRIX COPY FOR   FOR    CASE-----
32514C
3251512590 CONTINUE
32516C
32517      IN(ILISL(1))=NITEMX
32518      IF(NUMVAL.EQ.2)IN(ILISL(2))=NITEMX
32519C
32520      DO12610J4=1,NUMNAM
32521      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12615
32522      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12615
32523      GOTO12610
3252412615 CONTINUE
32525      IUSE(J4)='V'
32526      IVALUE(J4)=ICOLL(1)
32527      VALUE(J4)=ICOLL(1)
32528      IN(J4)=NITEMX
32529      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')IVALUE(J4)=ICOLL(1)
32530      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')IVALU2(J4)=ICOLL(1)+NC91-1
3253112610 CONTINUE
32532C
32533      IF(NUMVAL.LE.1)GOTO12629
32534      DO12620J4=1,NUMNAM
32535      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12625
32536      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12625
32537      GOTO12620
3253812625 CONTINUE
32539      IUSE(J4)='V'
32540      IVALUE(J4)=ICOLL(2)
32541      VALUE(J4)=ICOLL(2)
32542      IN(J4)=NITEMX
3254312620 CONTINUE
3254412629 CONTINUE
32545C
32546      GOTO13000
32547C
32548C               *****************************************************
32549C               **  STEP 13--                                      **
32550C               **  BRANCH TO THE PROPER CASE
32551C               **  DEPENDING ON THE TYPE OF OUTPUT--
32552C               **     1) SCALAR (= PARAMETER)
32553C               **     2) VECTOR (= VARIABLE) (THE USUAL)
32554C               **     3) MATRIX
32555C               **  UPDATE DATAPLOT'S INTERNAL WORKSPACE
32556C               **  AND HOUSEKEEPING TABLES
32557C               *****************************************************
32558C
3255913000 CONTINUE
32560      IF(ITYP91.EQ.'SCAL')GOTO14000
32561      IF(ITYP91.EQ.'MATR')GOTO15000
32562      GOTO16000
32563C
32564C               *****************************************************
32565C               **  STEP 14--                                      **
32566C               **  TREAT THE PARAMETER (SCALAR) CASE.             **
32567C               **  EXAMPLE--LET D = DETERMINANT A                 **
32568C               **           WHERE A WAS PREVIOUSLY UNDEFINED      **
32569C               **           OR WHERE A WAS PREVIOUSLY A PARAMETER.**
32570C               **  CARRY OUT THE LIST UPDATING  AND               **
32571C               **  GENERATE THE INFORMATIVE PRINTING.             **
32572C               **  THEN EXIT.                                     **
32573C               *****************************************************
32574C
3257514000 CONTINUE
32576      ISTEPN='14'
32577      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32578C
32579      IHNAME(ILISL(1))=ILEFT(1)
32580      IHNAM2(ILISL(1))=ILEF2(1)
32581      IUSE(ILISL(1))='P'
32582      VALUE(ILISL(1))=SCAL91
32583      IVALUE(ILISL(1))=INT(VALUE(ILISL(1))+0.5)
32584      IN(ILISL(1))=1
32585      IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
32586C
32587      IF(IPRINT.EQ.'OFF')GOTO14019
32588      IF(IFEEDB.EQ.'OFF')GOTO14019
32589      WRITE(ICOUT,999)
32590      CALL DPWRST('XXX','BUG ')
32591      WRITE(ICOUT,14011)ILEFT(1),ILEF2(1),SCAL91
3259214011 FORMAT('THE COMPUTED VALUE OF THE CONSTANT ',
32593     1A4,A4,'      = ',E15.8)
32594      CALL DPWRST('XXX','BUG ')
32595      WRITE(ICOUT,999)
32596      CALL DPWRST('XXX','BUG ')
3259714019 CONTINUE
32598C
32599C  FOR MULTIVARIATE NORMAL CDF OR MULTIVARIATE T CDF, UPDATE
32600C  AN ADDITIONAL PARAMETER.  SET IT AFTER OTHER SCALAR UPDATE
32601C  TO AVOID OVERWRITE.
32602C
32603      IF(ICASL7.EQ.'NCDF'.OR.ICASL7.EQ.'TCDF')THEN
32604        IHP='NCDF'
32605        IHP2='ERRS'
32606        VALUE0=ERRS
32607        CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
32608     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
32609     1  IANS,IWIDTH,IBUGA3,IERROR)
32610      ENDIF
32611      GOTO19000
32612C
32613C               *******************************************
32614C               **  STEP 15--                            **
32615C               **  TREAT THE MATRIX CASE--              **
32616C               **  CARRY OUT THE LIST UPDATING AND      **
32617C               **  GENERATE THE INFORMATIVE PRINTING    **
32618C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
32619C               *******************************************
32620C
3262115000 CONTINUE
32622      ISTEPN='15'
32623      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32624C
32625      IHMAT1=ILEFT(1)
32626      IHMAT2=ILEF2(1)
32627      IMATNR=NR91
32628      IMATNC=NC91
32629      IMATCO=ICOLL(1)
32630C
32631      IHNAME(ILISL(1))=IHMAT1
32632      IHNAM2(ILISL(1))=IHMAT2
32633      IUSE(ILISL(1))='M'
32634      IVALUE(ILISL(1))=IMATCO
32635      IN(ILISL(1))=IMATNR
32636      IVALU2(ILISL(1))=IMATCO+IMATNC-1
32637      IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
32638CCCCC AUGUST 1993.  NUMBER OF COLUMNS UPDATED IN SUBSEQUENT LOOP
32639CCCCC IF(NEWNAM(1).EQ.'YES')NUMCOL=NUMCOL+1
32640C
32641      IF(IMATNC.LE.0)GOTO15039
32642      INAM=NUMNAM
32643      DO15010J=1,IMATNC
32644C
32645      INAM=INAM+1
32646      IF(INAM.LE.MAXNAM)GOTO15019
32647      WRITE(ICOUT,999)
32648      CALL DPWRST('XXX','BUG ')
32649      WRITE(ICOUT,15011)
3265015011 FORMAT('***** ERROR 15011 IN DPMAT2--')
32651      CALL DPWRST('XXX','BUG ')
32652      WRITE(ICOUT,15012)
3265315012 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
32654      CALL DPWRST('XXX','BUG ')
32655      WRITE(ICOUT,15013)MAXNAM
3265615013 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
32657     1I8,'  .')
32658      CALL DPWRST('XXX','BUG ')
32659      IERROR='YES'
32660      GOTO19000
3266115019 CONTINUE
32662C
32663      ICOL=IMATCO+J-1
32664      IF(ICOL.LE.MAXCOL)GOTO15029
32665      WRITE(ICOUT,999)
32666      CALL DPWRST('XXX','BUG ')
32667      WRITE(ICOUT,15021)
3266815021 FORMAT('***** ERROR 15021 IN DPMAT2--')
32669      CALL DPWRST('XXX','BUG ')
32670      WRITE(ICOUT,15022)
3267115022 FORMAT('      THE NUMBER OF WORKSHEET VARIABLES (COLUMNS)')
32672      CALL DPWRST('XXX','BUG ')
32673      WRITE(ICOUT,15023)MAXCOL
3267415023 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',
32675     1I8,'  .')
32676      CALL DPWRST('XXX','BUG ')
32677      IERROR='YES'
32678      GOTO19000
3267915029 CONTINUE
32680C
32681      CALL DPAPN2(IHMAT1,IHMAT2,J,
32682     1IH1,IH2,IBUGA3,ISUBRO,IERROR)
32683      IHNAME(INAM)=IH1
32684      IHNAM2(INAM)=IH2
32685      IUSE(INAM)='V'
32686      IVALUE(INAM)=ICOL
32687      IN(INAM)=IMATNR
32688      IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
32689      IF(NEWNAM(1).EQ.'YES')NUMCOL=NUMCOL+1
32690C
3269115010 CONTINUE
3269215039 CONTINUE
32693C
32694      IF(IPRINT.EQ.'OFF')GOTO15090
32695      IF(IFEEDB.EQ.'OFF')GOTO15090
32696C
32697      WRITE(ICOUT,999)
32698      CALL DPWRST('XXX','BUG ')
32699C
32700      WRITE(ICOUT,15041)IHMAT1,IHMAT2,IMATNR
3270115041 FORMAT('THE NUMBER OF ROWS    GENERATED FOR ',
32702     1'THE MATRIX   ',A4,A4,' = ',I8)
32703      CALL DPWRST('XXX','BUG ')
32704C
32705      WRITE(ICOUT,15042)IHMAT1,IHMAT2,IMATNC
3270615042 FORMAT('THE NUMBER OF COLUMNS GENERATED FOR ',
32707     1'THE MATRIX   ',A4,A4,' = ',I8)
32708      CALL DPWRST('XXX','BUG ')
32709C
32710      WRITE(ICOUT,999)
32711      CALL DPWRST('XXX','BUG ')
32712C
32713      WRITE(ICOUT,15051)IHMAT1,IHMAT2
3271415051 FORMAT('THE FIRST           COMPUTED ROW   OF ',A4,A4,' =')
32715      CALL DPWRST('XXX','BUG ')
32716      JMAX=IMATNC
32717      IF(JMAX.GT.10)JMAX=10
32718      DO15055J=1,JMAX
32719      IJ=MAXN*(IMATCO-1+J-1)+1
32720      TEMPV(J)=V(IJ)
3272115055 CONTINUE
32722      IF(JMAX.LE.10)WRITE(ICOUT,15056)(TEMPV(J),J=1,JMAX)
3272315056 FORMAT(10E10.3)
32724      IF(JMAX.LE.10)CALL DPWRST('XXX','BUG ')
32725      IF(JMAX.GT.10)WRITE(ICOUT,15057)(TEMPV(J),J=1,JMAX)
3272615057 FORMAT(10E10.3,' ...')
32727      IF(JMAX.GT.10)CALL DPWRST('XXX','BUG ')
32728C
32729      WRITE(ICOUT,15061)IMATNR,IHMAT1,IHMAT2
3273015061 FORMAT('THE LAST (',I5,'-TH) COMPUTED ROW   OF ',A4,A4,' =')
32731      CALL DPWRST('XXX','BUG ')
32732      JMAX=IMATNC
32733      IF(JMAX.GT.10)JMAX=10
32734      DO15065J=1,JMAX
32735      IJ=MAXN*(IMATCO-1+J-1)+IMATNR
32736      TEMPV(J)=V(IJ)
3273715065 CONTINUE
32738      IF(JMAX.LE.10)WRITE(ICOUT,15066)(TEMPV(J),J=1,JMAX)
3273915066 FORMAT(10E10.3)
32740      IF(JMAX.LE.10)CALL DPWRST('XXX','BUG ')
32741      IF(JMAX.GT.10)WRITE(ICOUT,15067)(TEMPV(J),J=1,JMAX)
3274215067 FORMAT(10E10.3,' ...')
32743      IF(JMAX.GT.10)CALL DPWRST('XXX','BUG ')
32744C
32745      IF(IMATNR.NE.1.AND.IMATNC.NE.1)GOTO15079
32746      WRITE(ICOUT,999)
32747      CALL DPWRST('XXX','BUG ')
32748      WRITE(ICOUT,15072)
3274915072 FORMAT('CAUTION--THIS MATRIX HAS ONLY 1 ROW AND 1 COLUMN')
32750      CALL DPWRST('XXX','BUG ')
3275115079 CONTINUE
32752C
32753      WRITE(ICOUT,999)
32754      CALL DPWRST('XXX','BUG ')
32755C
32756      IHCV11='    '
32757      IHCV12='    '
32758      IHCV21='    '
32759      IHCV22='    '
32760      IHCV31='    '
32761      IHCV32='    '
32762      J=1
32763      IF(IMATNC.GE.1)CALL DPAPN2(IHMAT1,IHMAT2,J,
32764     1IHCV11,IHCV12,IBUGA3,ISUBRO,IERROR)
32765      J=2
32766      IF(IMATNC.GE.2)CALL DPAPN2(IHMAT1,IHMAT2,J,
32767     1IHCV21,IHCV22,IBUGA3,ISUBRO,IERROR)
32768      J=3
32769      IF(IMATNC.GE.3)CALL DPAPN2(IHMAT1,IHMAT2,J,
32770     1IHCV31,IHCV32,IBUGA3,ISUBRO,IERROR)
32771      IF(IMATNC.LE.3)
32772     1WRITE(ICOUT,15081)IHMAT1,IHMAT2,IHCV11,IHCV12,IHCV21,IHCV22,
32773     1IHCV31,IHCV32
3277415081 FORMAT('THE COLUMN VECTOR NAMES ASSIGNED TO MATRIX ',A4,A4,
32775     1'ARE ',A4,A4,2X,A4,A4,2X,A4,A4)
32776      IF(IMATNC.LE.3)
32777     1CALL DPWRST('XXX','BUG ')
32778      IF(IMATNC.GT.3)
32779     1WRITE(ICOUT,15082)IHMAT1,IHMAT2,IHCV11,IHCV12,IHCV21,IHCV22,
32780     1IHCV31,IHCV32
3278115082 FORMAT('THE COLUMN VECTOR NAMES ASSIGNED TO MATRIX ',A4,A4,
32782     1'ARE ',A4,A4,2X,A4,A4,2X,A4,A4,' ...')
32783      IF(IMATNC.GT.3)
32784     1CALL DPWRST('XXX','BUG ')
32785C
32786      ICV1=IMATCO
32787      ICV2=IMATCO+IMATNC-1
32788      WRITE(ICOUT,15083)IHMAT1,IHMAT2,ICV1,ICV2
3278915083 FORMAT('THE WORKSHEET COLUMNS   ASSIGNED TO MATRIX ',A4,A4,
32790     1'ARE ',I8,' TO',I8)
32791      CALL DPWRST('XXX','BUG ')
32792C
3279315090 CONTINUE
32794      IF(ICASL7.EQ.'MASD' .OR. ICASL7.EQ.'MASF')GOTO25000
32795C
32796      GOTO19000
32797C
32798C               *******************************************
32799C               **  STEP 25--                            **
32800C               **  TREAT THE MATRIX CASE--              **
32801C               **  UPDATE MATRIX 2                      **
32802C               **  CARRY OUT THE LIST UPDATING AND      **
32803C               **  GENERATE THE INFORMATIVE PRINTING    **
32804C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
32805C               *******************************************
32806C
3280725000 CONTINUE
32808      ISTEPN='25'
32809CCCCC JULY 1993.  SINGULAR VALUE DECOMPOSTION USES VECTOR AS SECOND
32810CCCCC ARGUMENT ON LEFT.
32811      IHNAME(ILISL(2))=ILEFT(2)
32812      IHNAM2(ILISL(2))=ILEF2(2)
32813      IUSE(ILISL(2))='V'
32814      IVALUE(ILISL(2))=ICOLL(2)
32815      VALUE(ILISL(2))=ICOLL(2)
32816      IN(ILISL(2))=NVECT9
32817      IF(NEWNAM(2).EQ.'YES')NUMNAM=NUMNAM+1
32818CCCCC AUGUST 1993.  NUMBER OF COLUMNS UPDATED IN SUBSEQUENT LOOP
32819CCCCC IF(NEWNAM(2).EQ.'YES')NUMCOL=NUMCOL+1
32820      IF(NEWNAM(2).EQ.'YES')NUMCOL=NUMCOL+1
32821C
32822      DO25002I=1,NVECT9
32823      IJ=MAXN*(ICOLL(2)-1)+I
32824      IF(ICOLL(2).LE.MAXCOL)V(IJ)=TEMP1(I)
32825      IF(ICOLL(2).EQ.MAXCP1)PRED(I)=TEMP1(I)
32826      IF(ICOLL(2).EQ.MAXCP2)RES(I)=TEMP1(I)
32827      IF(ICOLL(2).EQ.MAXCP3)YPLOT(I)=TEMP1(I)
32828      IF(ICOLL(2).EQ.MAXCP4)XPLOT(I)=TEMP1(I)
32829      IF(ICOLL(2).EQ.MAXCP5)X2PLOT(I)=TEMP1(I)
32830      IF(ICOLL(2).EQ.MAXCP6)TAGPLO(I)=TEMP1(I)
3283125002 CONTINUE
32832C
32833      ISTEPN='25A'
32834      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
32835C
32836      IHMAT1=ILEFT(3)
32837      IHMAT2=ILEF2(3)
32838      IMATNR=NR2
32839      IMATNC=NC2
32840      IMATCO=ICOLL(3)
32841C
32842      IHNAME(ILISL(3))=IHMAT1
32843      IHNAM2(ILISL(3))=IHMAT2
32844      IUSE(ILISL(3))='M'
32845      IVALUE(ILISL(3))=IMATCO
32846      IN(ILISL(3))=IMATNR
32847      IVALU2(ILISL(3))=IMATCO+IMATNC-1
32848      IF(NEWNAM(3).EQ.'YES')NUMNAM=NUMNAM+1
32849      IF(NEWNAM(3).EQ.'YES')NUMCOL=NUMCOL+1
32850C
32851      IF(IMATNC.LE.0)GOTO25039
32852      INAM=NUMNAM
32853      DO25010J=1,IMATNC
32854C
32855      INAM=INAM+1
32856      IF(INAM.LE.MAXNAM)GOTO25019
32857      WRITE(ICOUT,999)
32858      CALL DPWRST('XXX','BUG ')
32859      WRITE(ICOUT,25011)
3286025011 FORMAT('***** ERROR 15011 IN DPMAT2--')
32861      CALL DPWRST('XXX','BUG ')
32862      WRITE(ICOUT,25012)
3286325012 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
32864      CALL DPWRST('XXX','BUG ')
32865      WRITE(ICOUT,25013)MAXNAM
3286625013 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
32867     1I8,'  .')
32868      CALL DPWRST('XXX','BUG ')
32869      IERROR='YES'
32870      GOTO19000
3287125019 CONTINUE
32872C
32873      ICOL=IMATCO+J-1
32874      IF(INAM.LE.MAXNAM)GOTO25029
32875      WRITE(ICOUT,999)
32876      CALL DPWRST('XXX','BUG ')
32877      WRITE(ICOUT,25021)
3287825021 FORMAT('***** ERROR 25021 IN DPMAT2--')
32879      CALL DPWRST('XXX','BUG ')
32880      WRITE(ICOUT,25022)
3288125022 FORMAT('      THE NUMBER OF WORKSHEET VARIABLES (COLUMNS)')
32882      CALL DPWRST('XXX','BUG ')
32883      WRITE(ICOUT,25023)MAXCOL
3288425023 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',
32885     1I8,'  .')
32886      CALL DPWRST('XXX','BUG ')
32887      IERROR='YES'
32888      GOTO19000
3288925029 CONTINUE
32890C
32891      CALL DPAPN2(IHMAT1,IHMAT2,J,
32892     1IH1,IH2,IBUGA3,ISUBRO,IERROR)
32893      IHNAME(INAM)=IH1
32894      IHNAM2(INAM)=IH2
32895      IUSE(INAM)='V'
32896      IVALUE(INAM)=ICOL
32897      IN(INAM)=IMATNR
32898      IF(NEWNAM(3).EQ.'YES')NUMNAM=NUMNAM+1
32899      IF(NEWNAM(3).EQ.'YES')NUMCOL=NUMCOL+1
32900C
3290125010 CONTINUE
3290225039 CONTINUE
32903C
32904      IF(IPRINT.EQ.'OFF')GOTO25090
32905      IF(IFEEDB.EQ.'OFF')GOTO25090
32906C
32907      WRITE(ICOUT,999)
32908      CALL DPWRST('XXX','BUG ')
32909C
32910      WRITE(ICOUT,25041)IHMAT1,IHMAT2,IMATNR
3291125041 FORMAT('THE NUMBER OF ROWS    GENERATED FOR ',
32912     1'THE MATRIX   ',A4,A4,' = ',I8)
32913      CALL DPWRST('XXX','BUG ')
32914C
32915      WRITE(ICOUT,25042)IHMAT1,IHMAT2,IMATNC
3291625042 FORMAT('THE NUMBER OF COLUMNS GENERATED FOR ',
32917     1'THE MATRIX   ',A4,A4,' = ',I8)
32918      CALL DPWRST('XXX','BUG ')
32919C
32920      WRITE(ICOUT,999)
32921      CALL DPWRST('XXX','BUG ')
32922C
32923      WRITE(ICOUT,25051)IHMAT1,IHMAT2
3292425051 FORMAT('THE FIRST           COMPUTED ROW   OF ',A4,A4,' =')
32925      CALL DPWRST('XXX','BUG ')
32926      JMAX=IMATNC
32927      IF(JMAX.GT.10)JMAX=10
32928      DO25055J=1,JMAX
32929      IJ=MAXN*(IMATCO-1+J-1)+1
32930      TEMPV(J)=V(IJ)
3293125055 CONTINUE
32932      IF(JMAX.LE.10)WRITE(ICOUT,25056)(TEMPV(J),J=1,JMAX)
3293325056 FORMAT(10E10.3)
32934      IF(JMAX.LE.10)CALL DPWRST('XXX','BUG ')
32935      IF(JMAX.GT.10)WRITE(ICOUT,25057)(TEMPV(J),J=1,JMAX)
3293625057 FORMAT(10E10.3,' ...')
32937      IF(JMAX.GT.10)CALL DPWRST('XXX','BUG ')
32938C
32939      WRITE(ICOUT,25061)IMATNR,IHMAT1,IHMAT2
3294025061 FORMAT('THE LAST (',I5,'-TH) COMPUTED ROW   OF ',A4,A4,' =')
32941      CALL DPWRST('XXX','BUG ')
32942      JMAX=IMATNC
32943      IF(JMAX.GT.10)JMAX=10
32944      DO25065J=1,JMAX
32945      IJ=MAXN*(IMATCO-1+J-1)+IMATNR
32946      TEMPV(J)=V(IJ)
3294725065 CONTINUE
32948      IF(JMAX.LE.10)WRITE(ICOUT,25066)(TEMPV(J),J=1,JMAX)
3294925066 FORMAT(10E10.3)
32950      IF(JMAX.LE.10)CALL DPWRST('XXX','BUG ')
32951      IF(JMAX.GT.10)WRITE(ICOUT,25067)(TEMPV(J),J=1,JMAX)
3295225067 FORMAT(10E10.3,' ...')
32953      IF(JMAX.GT.10)CALL DPWRST('XXX','BUG ')
32954C
32955      IF(IMATNR.NE.1.AND.IMATNC.NE.1)GOTO25079
32956      WRITE(ICOUT,999)
32957      CALL DPWRST('XXX','BUG ')
32958      WRITE(ICOUT,25072)
3295925072 FORMAT('CAUTION--THIS MATRIX HAS ONLY 1 ROW AND 1 COLUMN')
32960      CALL DPWRST('XXX','BUG ')
3296125079 CONTINUE
32962C
32963      WRITE(ICOUT,999)
32964      CALL DPWRST('XXX','BUG ')
32965C
32966      IHCV11='    '
32967      IHCV12='    '
32968      IHCV21='    '
32969      IHCV22='    '
32970      IHCV31='    '
32971      IHCV32='    '
32972      J=1
32973      IF(IMATNC.GE.1)CALL DPAPN2(IHMAT1,IHMAT2,J,
32974     1IHCV11,IHCV12,IBUGA3,ISUBRO,IERROR)
32975      J=2
32976      IF(IMATNC.GE.2)CALL DPAPN2(IHMAT1,IHMAT2,J,
32977     1IHCV21,IHCV22,IBUGA3,ISUBRO,IERROR)
32978      J=3
32979      IF(IMATNC.GE.3)CALL DPAPN2(IHMAT1,IHMAT2,J,
32980     1IHCV31,IHCV32,IBUGA3,ISUBRO,IERROR)
32981      IF(IMATNC.LE.3)
32982     1WRITE(ICOUT,25081)IHMAT1,IHMAT2,IHCV11,IHCV12,IHCV21,IHCV22,
32983     1IHCV31,IHCV32
3298425081 FORMAT('THE COLUMN VECTOR NAMES ASSIGNED TO MATRIX ',A4,A4,
32985     1'ARE ',A4,A4,2X,A4,A4,2X,A4,A4)
32986      IF(IMATNC.LE.3)
32987     1CALL DPWRST('XXX','BUG ')
32988      IF(IMATNC.GT.3)
32989     1WRITE(ICOUT,25082)IHMAT1,IHMAT2,IHCV11,IHCV12,IHCV21,IHCV22,
32990     1IHCV31,IHCV32
3299125082 FORMAT('THE COLUMN VECTOR NAMES ASSIGNED TO MATRIX ',A4,A4,
32992     1'ARE ',A4,A4,2X,A4,A4,2X,A4,A4,' ...')
32993      IF(IMATNC.GT.3)
32994     1CALL DPWRST('XXX','BUG ')
32995C
32996      ICV1=IMATCO
32997      ICV2=IMATCO+IMATNC-1
32998      WRITE(ICOUT,25083)IHMAT1,IHMAT2,ICV1,ICV2
3299925083 FORMAT('THE WORKSHEET COLUMNS   ASSIGNED TO MATRIX ',A4,A4,
33000     1'ARE ',I8,' TO',I8)
33001      CALL DPWRST('XXX','BUG ')
33002C
3300325090 CONTINUE
33004C
33005      GOTO19000
33006C
33007C
33008C               *******************************************
33009C               **  STEP 16--                            **
33010C               **  TREAT THE VARIABLE (VECTOR) CASE--   **
33011C               **  CARRY OUT THE LIST UPDATING AND      **
33012C               **  GENERATE THE INFORMATIVE PRINTING    **
33013C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
33014C               *******************************************
33015C
3301616000 CONTINUE
33017      ISTEPN='16'
33018      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33019C
33020      IHNAME(ILISL(1))=ILEFT(1)
33021      IHNAM2(ILISL(1))=ILEF2(1)
33022      IUSE(ILISL(1))='V'
33023      IVALUE(ILISL(1))=ICOLL(1)
33024      VALUE(ILISL(1))=ICOLL(1)
33025      IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
33026      IF(NEWNAM(1).EQ.'YES')NUMCOL=NUMCOL+1
33027C
33028      IF(NUMVAL.GE.2)THEN
33029        IHNAME(ILISL(2))=ILEFT(2)
33030        IHNAM2(ILISL(2))=ILEF2(2)
33031        IUSE(ILISL(2))='V'
33032        IVALUE(ILISL(2))=ICOLL(2)
33033        VALUE(ILISL(2))=ICOLL(2)
33034        IF(NEWNAM(2).EQ.'YES')NUMNAM=NUMNAM+1
33035        IF(NEWNAM(2).EQ.'YES')NUMCOL=NUMCOL+1
33036      ENDIF
33037C
33038      IF(NUMVAL.GE.3)THEN
33039        IHNAME(ILISL(3))=ILEFT(3)
33040        IHNAM2(ILISL(3))=ILEF2(3)
33041        IUSE(ILISL(3))='V'
33042        IVALUE(ILISL(3))=ICOLL(3)
33043        VALUE(ILISL(3))=ICOLL(3)
33044        IF(NEWNAM(3).EQ.'YES')NUMNAM=NUMNAM+1
33045        IF(NEWNAM(3).EQ.'YES')NUMCOL=NUMCOL+1
33046      ENDIF
33047C
33048      IF(NUMVAL.GE.4)THEN
33049        IHNAME(ILISL(4))=ILEFT(4)
33050        IHNAM2(ILISL(4))=ILEF2(4)
33051        IUSE(ILISL(4))='V'
33052        IVALUE(ILISL(4))=ICOLL(4)
33053        VALUE(ILISL(4))=ICOLL(4)
33054        IF(NEWNAM(4).EQ.'YES')NUMNAM=NUMNAM+1
33055        IF(NEWNAM(4).EQ.'YES')NUMCOL=NUMCOL+1
33056      ENDIF
33057C
33058      IF(IPRINT.EQ.'OFF')GOTO16090
33059      IF(IFEEDB.EQ.'OFF')GOTO16090
33060      WRITE(ICOUT,999)
33061      CALL DPWRST('XXX','BUG ')
33062C
33063      WRITE(ICOUT,16011)ILEFT(1),ILEF2(1),NSX
3306416011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
33065     1'THE VARIABLE ',A4,A4,' = ',I8)
33066      CALL DPWRST('XXX','BUG ')
33067      WRITE(ICOUT,999)
33068      CALL DPWRST('XXX','BUG ')
33069      IJ=MAXN*(ICOLL(1)-1)+IROW1
33070      IF(ICOLL(1).LE.MAXCOL)THEN
33071         WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),V(IJ),IROW1
33072         CALL DPWRST('XXX','BUG ')
33073      ELSEIF(ICOLL(1).EQ.MAXCP1)THEN
33074         WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),PRED(IROW1),IROW1
3307516021    FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
33076     1          ' = ',E16.7,'   (ROW ',I6,')')
33077         CALL DPWRST('XXX','BUG ')
33078      ELSEIF(ICOLL(1).EQ.MAXCP2)THEN
33079        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),RES(IROW1),IROW1
33080        CALL DPWRST('XXX','BUG ')
33081      ELSEIF(ICOLL(1).EQ.MAXCP3)THEN
33082        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),YPLOT(IROW1),IROW1
33083        CALL DPWRST('XXX','BUG ')
33084      ELSEIF(ICOLL(1).EQ.MAXCP4)THEN
33085        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),XPLOT(IROW1),IROW1
33086        CALL DPWRST('XXX','BUG ')
33087      ELSEIF(ICOLL(1).EQ.MAXCP5)THEN
33088        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),X2PLOT(IROW1),IROW1
33089        CALL DPWRST('XXX','BUG ')
33090      ELSEIF(ICOLL(1).EQ.MAXCP6)THEN
33091        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),TAGPLO(IROW1),IROW1
33092        CALL DPWRST('XXX','BUG ')
33093      ENDIF
33094C
33095      IJ=MAXN*(ICOLL(1)-1)+IROWN
3309616031 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
33097     1' = ',E16.7,'   (ROW ',I6,')')
33098      IF(ICOLL(1).LE.MAXCOL.AND.NSX.NE.1)THEN
33099        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),V(IJ),IROWN
33100        CALL DPWRST('XXX','BUG ')
33101      ELSEIF(ICOLL(1).EQ.MAXCP1.AND.NSX.NE.1)THEN
33102        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),PRED(IROWN),IROWN
33103        CALL DPWRST('XXX','BUG ')
33104      ELSEIF(ICOLL(1).EQ.MAXCP2.AND.NSX.NE.1)THEN
33105        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),RES(IROWN),IROWN
33106        CALL DPWRST('XXX','BUG ')
33107      ELSEIF(ICOLL(1).EQ.MAXCP3.AND.NSX.NE.1)THEN
33108        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),YPLOT(IROWN),IROWN
33109        CALL DPWRST('XXX','BUG ')
33110      ELSEIF(ICOLL(1).EQ.MAXCP4.AND.NSX.NE.1)THEN
33111        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),XPLOT(IROWN),IROWN
33112        CALL DPWRST('XXX','BUG ')
33113      ELSEIF(ICOLL(1).EQ.MAXCP5.AND.NSX.NE.1)THEN
33114        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),X2PLOT(IROWN),IROWN
33115        CALL DPWRST('XXX','BUG ')
33116      ELSEIF(ICOLL(1).EQ.MAXCP6.AND.NSX.NE.1)THEN
33117        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),TAGPLO(IROWN),IROWN
33118        CALL DPWRST('XXX','BUG ')
33119      ENDIF
33120      IF(NSX.NE.1)GOTO16039
33121      WRITE(ICOUT,16032)
3312216032 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
33123      CALL DPWRST('XXX','BUG ')
33124      WRITE(ICOUT,16033)
3312516033 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
33126      CALL DPWRST('XXX','BUG ')
3312716039 CONTINUE
33128C
33129      IF(NUMVAL.LE.1)GOTO16079
33130      WRITE(ICOUT,16051)ILEFT(2),ILEF2(2),NSX
3313116051 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
33132     1'THE VARIABLE ',A4,A4,' = ',I8)
33133      CALL DPWRST('XXX','BUG ')
33134      WRITE(ICOUT,999)
33135      CALL DPWRST('XXX','BUG ')
33136      IJ=MAXN*(ICOLL(2)-1)+IROW1
3313716061 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
33138     1' = ',E16.7,'   (ROW ',I6,')')
33139      IF(ICOLL(2).LE.MAXCOL)THEN
33140        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),V(IJ),IROW1
33141        CALL DPWRST('XXX','BUG ')
33142      ELSEIF(ICOLL(2).EQ.MAXCP1)THEN
33143        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),PRED(IROW1),IROW1
33144        CALL DPWRST('XXX','BUG ')
33145      ELSEIF(ICOLL(2).EQ.MAXCP2)THEN
33146        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),RES(IROW1),IROW1
33147        CALL DPWRST('XXX','BUG ')
33148      ELSEIF(ICOLL(2).EQ.MAXCP3)THEN
33149        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),YPLOT(IROW1),IROW1
33150        CALL DPWRST('XXX','BUG ')
33151      ELSEIF(ICOLL(2).EQ.MAXCP4)THEN
33152        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),XPLOT(IROW1),IROW1
33153        CALL DPWRST('XXX','BUG ')
33154      ELSEIF(ICOLL(2).EQ.MAXCP5)THEN
33155        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),X2PLOT(IROW1),IROW1
33156        CALL DPWRST('XXX','BUG ')
33157      ELSEIF(ICOLL(2).EQ.MAXCP6)THEN
33158        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),TAGPLO(IROW1),IROW1
33159        CALL DPWRST('XXX','BUG ')
33160      ENDIF
33161C
33162      IJ=MAXN*(ICOLL(2)-1)+IROWN
3316316071 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
33164     1' = ',E16.7,'   (ROW ',I6,')')
33165      IF(ICOLL(2).LE.MAXCOL.AND.NSX.NE.1)THEN
33166        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),V(IJ),IROWN
33167        CALL DPWRST('XXX','BUG ')
33168      ELSEIF(ICOLL(2).EQ.MAXCP1.AND.NSX.NE.1)THEN
33169        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),PRED(IROWN),IROWN
33170        CALL DPWRST('XXX','BUG ')
33171      ELSEIF(ICOLL(2).EQ.MAXCP2.AND.NSX.NE.1)THEN
33172        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),RES(IROWN),IROWN
33173        CALL DPWRST('XXX','BUG ')
33174      ELSEIF(ICOLL(2).EQ.MAXCP3.AND.NSX.NE.1)THEN
33175        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),YPLOT(IROWN),IROWN
33176        CALL DPWRST('XXX','BUG ')
33177      ELSEIF(ICOLL(2).EQ.MAXCP4.AND.NSX.NE.1)THEN
33178        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),XPLOT(IROWN),IROWN
33179        CALL DPWRST('XXX','BUG ')
33180      ELSEIF(ICOLL(2).EQ.MAXCP5.AND.NSX.NE.1)THEN
33181        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),X2PLOT(IROWN),IROWN
33182        CALL DPWRST('XXX','BUG ')
33183      ELSEIF(ICOLL(2).EQ.MAXCP6.AND.NSX.NE.1)THEN
33184        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),TAGPLO(IROWN),IROWN
33185        CALL DPWRST('XXX','BUG ')
33186      ENDIF
33187      IF(NSX.NE.1)GOTO16079
33188      WRITE(ICOUT,16072)
3318916072 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
33190      CALL DPWRST('XXX','BUG ')
33191      WRITE(ICOUT,16073)
3319216073 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
33193      CALL DPWRST('XXX','BUG ')
3319416079 CONTINUE
33195C
33196      IF(NUMVAL.LE.2)GOTO16179
33197      WRITE(ICOUT,16151)ILEFT(3),ILEF2(3),NSX
3319816151 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
33199     1'THE VARIABLE ',A4,A4,' = ',I8)
33200      CALL DPWRST('XXX','BUG ')
33201      WRITE(ICOUT,999)
33202      CALL DPWRST('XXX','BUG ')
33203      IJ=MAXN*(ICOLL(3)-1)+IROW1
3320416161 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
33205     1' = ',E16.7,'   (ROW ',I6,')')
33206      IF(ICOLL(3).LE.MAXCOL)THEN
33207        WRITE(ICOUT,16161)ILEFT(3),ILEF2(3),V(IJ),IROW1
33208        CALL DPWRST('XXX','BUG ')
33209      ELSEIF(ICOLL(3).EQ.MAXCP1)THEN
33210        WRITE(ICOUT,16161)ILEFT(3),ILEF2(3),PRED(IROW1),IROW1
33211        CALL DPWRST('XXX','BUG ')
33212      ELSEIF(ICOLL(3).EQ.MAXCP2)THEN
33213        WRITE(ICOUT,16161)ILEFT(3),ILEF2(3),RES(IROW1),IROW1
33214        CALL DPWRST('XXX','BUG ')
33215      ELSEIF(ICOLL(3).EQ.MAXCP3)THEN
33216        WRITE(ICOUT,16161)ILEFT(3),ILEF2(3),YPLOT(IROW1),IROW1
33217        CALL DPWRST('XXX','BUG ')
33218      ELSEIF(ICOLL(3).EQ.MAXCP4)THEN
33219        WRITE(ICOUT,16161)ILEFT(3),ILEF2(3),XPLOT(IROW1),IROW1
33220        CALL DPWRST('XXX','BUG ')
33221      ELSEIF(ICOLL(3).EQ.MAXCP5)THEN
33222        WRITE(ICOUT,16161)ILEFT(3),ILEF2(3),X2PLOT(IROW1),IROW1
33223        CALL DPWRST('XXX','BUG ')
33224      ELSEIF(ICOLL(3).EQ.MAXCP6)THEN
33225        WRITE(ICOUT,16161)ILEFT(3),ILEF2(3),TAGPLO(IROW1),IROW1
33226        CALL DPWRST('XXX','BUG ')
33227      ENDIF
33228C
33229      IJ=MAXN*(ICOLL(3)-1)+IROWN
3323016171 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
33231     1' = ',E16.7,'   (ROW ',I6,')')
33232      IF(ICOLL(3).LE.MAXCOL.AND.NSX.NE.1)THEN
33233        WRITE(ICOUT,16171)NSX,ILEFT(3),ILEF2(3),V(IJ),IROWN
33234        CALL DPWRST('XXX','BUG ')
33235      ELSEIF(ICOLL(3).EQ.MAXCP1.AND.NSX.NE.1)THEN
33236        WRITE(ICOUT,16171)NSX,ILEFT(3),ILEF2(3),PRED(IROWN),IROWN
33237        CALL DPWRST('XXX','BUG ')
33238      ELSEIF(ICOLL(3).EQ.MAXCP2.AND.NSX.NE.1)THEN
33239        WRITE(ICOUT,16171)NSX,ILEFT(3),ILEF2(3),RES(IROWN),IROWN
33240        CALL DPWRST('XXX','BUG ')
33241      ELSEIF(ICOLL(3).EQ.MAXCP3.AND.NSX.NE.1)THEN
33242        WRITE(ICOUT,16171)NSX,ILEFT(3),ILEF2(3),YPLOT(IROWN),IROWN
33243        CALL DPWRST('XXX','BUG ')
33244      ELSEIF(ICOLL(3).EQ.MAXCP4.AND.NSX.NE.1)THEN
33245        WRITE(ICOUT,16171)NSX,ILEFT(3),ILEF2(3),XPLOT(IROWN),IROWN
33246        CALL DPWRST('XXX','BUG ')
33247      ELSEIF(ICOLL(3).EQ.MAXCP5.AND.NSX.NE.1)THEN
33248        WRITE(ICOUT,16171)NSX,ILEFT(3),ILEF2(3),X2PLOT(IROWN),IROWN
33249        CALL DPWRST('XXX','BUG ')
33250      ELSEIF(ICOLL(3).EQ.MAXCP6.AND.NSX.NE.1)THEN
33251        WRITE(ICOUT,16171)NSX,ILEFT(3),ILEF2(3),TAGPLO(IROWN),IROWN
33252        CALL DPWRST('XXX','BUG ')
33253      ENDIF
33254      IF(NSX.NE.1)GOTO16179
33255      WRITE(ICOUT,16172)
3325616172 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
33257      CALL DPWRST('XXX','BUG ')
33258      WRITE(ICOUT,16173)
3325916173 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
33260      CALL DPWRST('XXX','BUG ')
3326116179 CONTINUE
33262C
33263      IF(NUMVAL.LE.3)GOTO16279
33264      WRITE(ICOUT,16251)ILEFT(4),ILEF2(4),NSX
3326516251 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
33266     1'THE VARIABLE ',A4,A4,' = ',I8)
33267      CALL DPWRST('XXX','BUG ')
33268      WRITE(ICOUT,999)
33269      CALL DPWRST('XXX','BUG ')
33270      IJ=MAXN*(ICOLL(4)-1)+IROW1
3327116261 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
33272     1' = ',E16.7,'   (ROW ',I6,')')
33273      IF(ICOLL(4).LE.MAXCOL)THEN
33274        WRITE(ICOUT,16261)ILEFT(4),ILEF2(4),V(IJ),IROW1
33275        CALL DPWRST('XXX','BUG ')
33276      ELSEIF(ICOLL(4).EQ.MAXCP1)THEN
33277        WRITE(ICOUT,16261)ILEFT(4),ILEF2(4),PRED(IROW1),IROW1
33278        CALL DPWRST('XXX','BUG ')
33279      ELSEIF(ICOLL(4).EQ.MAXCP2)THEN
33280        WRITE(ICOUT,16261)ILEFT(4),ILEF2(4),RES(IROW1),IROW1
33281        CALL DPWRST('XXX','BUG ')
33282      ELSEIF(ICOLL(4).EQ.MAXCP3)THEN
33283        WRITE(ICOUT,16261)ILEFT(4),ILEF2(4),YPLOT(IROW1),IROW1
33284        CALL DPWRST('XXX','BUG ')
33285      ELSEIF(ICOLL(4).EQ.MAXCP4)THEN
33286        WRITE(ICOUT,16261)ILEFT(4),ILEF2(4),XPLOT(IROW1),IROW1
33287        CALL DPWRST('XXX','BUG ')
33288      ELSEIF(ICOLL(4).EQ.MAXCP5)THEN
33289        WRITE(ICOUT,16261)ILEFT(4),ILEF2(4),X2PLOT(IROW1),IROW1
33290        CALL DPWRST('XXX','BUG ')
33291      ELSEIF(ICOLL(4).EQ.MAXCP6)THEN
33292        WRITE(ICOUT,16261)ILEFT(4),ILEF2(4),TAGPLO(IROW1),IROW1
33293        CALL DPWRST('XXX','BUG ')
33294      ENDIF
33295C
33296      IJ=MAXN*(ICOLL(4)-1)+IROWN
3329716271 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
33298     1' = ',E16.7,'   (ROW ',I6,')')
33299      IF(ICOLL(4).LE.MAXCOL.AND.NSX.NE.1)THEN
33300        WRITE(ICOUT,16271)NSX,ILEFT(4),ILEF2(4),V(IJ),IROWN
33301        CALL DPWRST('XXX','BUG ')
33302      ELSEIF(ICOLL(4).EQ.MAXCP1.AND.NSX.NE.1)THEN
33303        WRITE(ICOUT,16271)NSX,ILEFT(4),ILEF2(4),PRED(IROWN),IROWN
33304        CALL DPWRST('XXX','BUG ')
33305      ELSEIF(ICOLL(4).EQ.MAXCP2.AND.NSX.NE.1)THEN
33306        WRITE(ICOUT,16271)NSX,ILEFT(4),ILEF2(4),RES(IROWN),IROWN
33307        CALL DPWRST('XXX','BUG ')
33308      ELSEIF(ICOLL(4).EQ.MAXCP3.AND.NSX.NE.1)THEN
33309        WRITE(ICOUT,16271)NSX,ILEFT(4),ILEF2(4),YPLOT(IROWN),IROWN
33310        CALL DPWRST('XXX','BUG ')
33311      ELSEIF(ICOLL(4).EQ.MAXCP4.AND.NSX.NE.1)THEN
33312        WRITE(ICOUT,16271)NSX,ILEFT(4),ILEF2(4),XPLOT(IROWN),IROWN
33313        CALL DPWRST('XXX','BUG ')
33314      ELSEIF(ICOLL(4).EQ.MAXCP5.AND.NSX.NE.1)THEN
33315        WRITE(ICOUT,16271)NSX,ILEFT(4),ILEF2(4),X2PLOT(IROWN),IROWN
33316        CALL DPWRST('XXX','BUG ')
33317      ELSEIF(ICOLL(4).EQ.MAXCP6.AND.NSX.NE.1)THEN
33318        WRITE(ICOUT,16271)NSX,ILEFT(4),ILEF2(4),TAGPLO(IROWN),IROWN
33319        CALL DPWRST('XXX','BUG ')
33320      ENDIF
33321      IF(NSX.NE.1)GOTO16279
33322      WRITE(ICOUT,16272)
3332316272 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
33324      CALL DPWRST('XXX','BUG ')
33325      WRITE(ICOUT,16273)
3332616273 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
33327      CALL DPWRST('XXX','BUG ')
3332816279 CONTINUE
33329C
33330      WRITE(ICOUT,999)
33331      CALL DPWRST('XXX','BUG ')
3333216090 CONTINUE
33333C
33334        IF(ICASL7.EQ.'BIPL')THEN
33335          IHP='BIPL'
33336          IHP2='OTGF'
33337          VALUE0=SCAL91
33338          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
33339     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
33340     1                IANS,IWIDTH,IBUGA3,IERROR)
33341        ENDIF
33342C
33343      GOTO19000
33344C
33345C               *****************
33346C               **  STEP 90--  **
33347C               **  EXIT       **
33348C               *****************
33349C
3335019000 CONTINUE
33351      IF(IBUGA3.EQ.'OFF')GOTO19090
33352      WRITE(ICOUT,999)
33353      CALL DPWRST('XXX','BUG ')
33354      WRITE(ICOUT,19011)
3335519011 FORMAT('***** AT THE END       OF DPMAT2--')
33356      CALL DPWRST('XXX','BUG ')
33357      WRITE(ICOUT,19012)IFOUND,IERROR
3335819012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
33359      CALL DPWRST('XXX','BUG ')
33360      WRITE(ICOUT,19013)IBUGA3,IBUGQ,ISUBRO
3336119013 FORMAT('IBUGA3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4)
33362      CALL DPWRST('XXX','BUG ')
33363      WRITE(ICOUT,19014)ICASL7,ILOCV,ITCASE,IWRITE
3336419014 FORMAT('ICASL7,ILOCV,ITCASE,IWRITE = ',A4,2X,I8,2X,A4,2X,A4)
33365      CALL DPWRST('XXX','BUG ')
33366      WRITE(ICOUT,19016)NSX,NITEMX,NS(1),NS(2)
3336719016 FORMAT('NSX,NITEMX,NS(1),NS(2) = ',4I8)
33368      CALL DPWRST('XXX','BUG ')
33369      WRITE(ICOUT,19021)ILEFT(1),ILEF2(1),ILISL(1),ICOLL(1)
3337019021 FORMAT('ILEFT(1),ILEF2(1),ILISL(1),ICOLL(1) = ',A4,2X,A4,2I8)
33371      CALL DPWRST('XXX','BUG ')
33372      WRITE(ICOUT,19022)ILEFT(2),ILEF2(2),ILISL(2),ICOLL(2)
3337319022 FORMAT('ILEFT(2),ILEF2(2),ILISL(2),ICOLL(2) = ',A4,2X,A4,2I8)
33374      CALL DPWRST('XXX','BUG ')
33375      WRITE(ICOUT,19023)NUMVAL,NEWNAM(1),NEWNAM(2),NUMVAR
3337619023 FORMAT('NUMVAL,NEWNAM(1),NEWNAM(2),NUMVAR = ',I8,2X,A4,2X,A4,I8)
33377      CALL DPWRST('XXX','BUG ')
33378      DO19025I=1,4
33379      WRITE(ICOUT,19024)I,ILISR(I),ICOLR(I),ITYPA(I)
3338019024 FORMAT('I,ILISR(I),ICOLR(I),ITYPA(I) = ',I2,I8,I8,1X,A4)
33381      CALL DPWRST('XXX','BUG ')
3338219025 CONTINUE
33383      WRITE(ICOUT,19026)TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4)
3338419026 FORMAT('TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4) = ',4E15.7)
33385      CALL DPWRST('XXX','BUG ')
33386      WRITE(ICOUT,19031)IMATSW,NUMVAR
3338719031 FORMAT('IMATSW,NUMVAR = ',A4,I8)
33388      CALL DPWRST('XXX','BUG ')
33389      IF(IMATSW.EQ.'NO')GOTO19079
33390      WRITE(ICOUT,19032)NR1,NC1,NR2,NC2,NR91,NC91
3339119032 FORMAT('NR1,NC1,NR2,NC2,NR91,NC91 = ',6I8)
33392      CALL DPWRST('XXX','BUG ')
33393      IF(ITYPA(1).EQ.'MATR'.OR.ITYPA(1).EQ.'VARI')THEN
33394        WRITE(ICOUT,19033)ILISR(1),IN(ILISR(1)),IVALUE(ILISR(1)),
33395     1                    IVALU2(ILISR(1))
3339619033 FORMAT(
33397     1'ILISR(1),IN(ILISR(1)),IVALUE(ILISR(1)),IVALU2(ILISR(1)) = ',4I8)
33398        CALL DPWRST('XXX','BUG ')
33399      ENDIF
33400      WRITE(ICOUT,19034)(ILOCR(J),J=3,7)
3340119034 FORMAT('ILOCR(3),...,ILOCR(7) = ',5I8)
33402      CALL DPWRST('XXX','BUG ')
33403C
33404      WRITE(ICOUT,999)
33405      CALL DPWRST('XXX','BUG ')
33406      IF(NR1.LE.0 .OR. NC1.LE.0)GOTO19049
33407      JMAX=NC1
33408      IF(JMAX.GT.10)JMAX=10
33409      DO19045I=1,NR1
33410      WRITE(ICOUT,19046)I,(TEMPM1((J-1)*MAXROM+I),J=1,JMAX)
3341119046 FORMAT('I,TEMPM1(I,.) = ',I8,10E10.3)
33412      CALL DPWRST('XXX','BUG ')
3341319045 CONTINUE
3341419049 CONTINUE
33415C
33416      WRITE(ICOUT,999)
33417      CALL DPWRST('XXX','BUG ')
33418      IF(NR2.LE.0 .OR. NC2.LE.0)GOTO19059
33419      JMAX=NC2
33420      IF(JMAX.GT.10)JMAX=10
33421      DO19055I=1,NR2
33422      WRITE(ICOUT,19056)I,(TEMPM2((J-1)*MAXROM+I),J=1,JMAX)
3342319056 FORMAT('I,TEMPM2(I,.) = ',I8,10E10.3)
33424      CALL DPWRST('XXX','BUG ')
3342519055 CONTINUE
3342619059 CONTINUE
33427C
33428      WRITE(ICOUT,999)
33429      CALL DPWRST('XXX','BUG ')
33430      IF(NR91.LE.0 .OR. NC91.LE.0)GOTO19069
33431      JMAX=NC91
33432      IF(JMAX.GT.10)JMAX=10
33433      DO19065I=1,NR91
33434      WRITE(ICOUT,19066)I,(TEMM91((J-1)*MAXROM+I),J=1,JMAX)
3343519066 FORMAT('I,TEMM91(I,.) = ',I8,10E10.3)
33436      CALL DPWRST('XXX','BUG ')
3343719065 CONTINUE
3343819069 CONTINUE
3343919079 CONTINUE
3344019090 CONTINUE
33441C
33442      RETURN
33443      END
33444      SUBROUTINE DPMAT6(ICASL7,ICASE,MAXCAS,
33445     1                  ILEFT,ILEFT2,NEWNAM,ILISL,ICOLL,
33446     1                  NUMVAL,NIOLD,
33447     1                  IBUGA3,ISUBRO,IFOUND,IERROR)
33448C
33449C     NOTE--THIS SUBROUTINE IS A UTILITY ROUTINE FOR DPMATC AND
33450C           DPMAT2.  IT CHECKS A VARIABLE ON THE LEFT HAND SIDE
33451C           OF THE EQUAL SIGN.
33452C     WRITTEN BY--JAMES J. FILLIBEN
33453C                 STATISTICAL ENGINEERING DIVISION
33454C                 INFORMATION TECHNOLOGY LABORATORY
33455C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33456C                 Gaithersburg, MD 20899-8980
33457C                 PHONE--301-975-2855
33458C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33459C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33460C     LANGUAGE--ANSI FORTRAN (1977)
33461C     VERSION NUMBER--2002/6
33462C     ORIGINAL VERSION--JUNE      2002.
33463C
33464C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
33465C
33466      CHARACTER*4 ICASL7
33467      CHARACTER*4 IBUGA3
33468      CHARACTER*4 ISUBRO
33469      CHARACTER*4 IFOUND
33470      CHARACTER*4 IERROR
33471C
33472      CHARACTER*4 NEWNAM(MAXCAS)
33473      CHARACTER*4 ILEFT(MAXCAS)
33474      CHARACTER*4 ILEFT2(MAXCAS)
33475C
33476      CHARACTER*4 ISUBN1
33477      CHARACTER*4 ISUBN2
33478      CHARACTER*4 ISTEPN
33479C
33480      INTEGER ILISL(MAXCAS)
33481      INTEGER ICOLL(MAXCAS)
33482C
33483C---------------------------------------------------------------------
33484C
33485C-----COMMON----------------------------------------------------------
33486C
33487      INCLUDE 'DPCOPA.INC'
33488      INCLUDE 'DPCOHK.INC'
33489      INCLUDE 'DPCODA.INC'
33490      INCLUDE 'DPCOP2.INC'
33491C
33492C-----START POINT-----------------------------------------------------
33493C
33494      ISUBN1='DPMA'
33495      ISUBN2='T6  '
33496      IFOUND='NO'
33497      IERROR='NO'
33498C
33499      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')THEN
33500        WRITE(ICOUT,999)
33501  999   FORMAT(1X)
33502        CALL DPWRST('XXX','BUG ')
33503        WRITE(ICOUT,51)
33504   51   FORMAT('***** AT THE BEGINNING OF DPMAT6--')
33505        CALL DPWRST('XXX','BUG ')
33506        WRITE(ICOUT,52)ICASL7,IBUGA3,ISUBRO
33507   52   FORMAT('ICASL7,IBUGA3,ISUBRO = ',A4,2X,A4,2X,A4)
33508        CALL DPWRST('XXX','BUG ')
33509      ENDIF
33510C
33511C               **********************************
33512C               **  STEP 1--                    **
33513C               **  INITIALIZE SOME VARIABLES.  **
33514C               **********************************
33515C
33516      ISTEPN='1'
33517      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')
33518     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33519C
33520      NEWNAM(ICASE)='NO'
33521C
33522C               ******************************************************
33523C               **  STEP 2A--                                        *
33524C               **  EXAMINE THE LEFT-HAND SIDE--                     *
33525C               **  IS THE VARIABLE NAME TO LEFT OF = SIGN           *
33526C               **  ALREADY IN THE NAME LIST?    AS A VARIABLE?      *
33527C               **  NOTE THAT  ILEFT   IS THE NAME OF THE VARIABLE   *
33528C               **  ON THE LEFT.                                     *
33529C               **  NOTE THAT     ILISL     IS THE LINE IN THE TABLE *
33530C               **  OF THE NAME ON THE LEFT.                         *
33531C               **  NOTE THAT  ICOLL(ICASE)  IS THE DATA COLUMN      *
33532C               **  (1 TO 12)                                        *
33533C               **  FOR THE NAME OF THE LEFT.                        *
33534C               ******************************************************
33535C
33536      ISTEPN='2A'
33537      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')
33538     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33539C
33540      ILEFT(ICASE)=IHARG(ICASE)
33541      ILEFT2(ICASE)=IHARG2(ICASE)
33542      DO210I=1,NUMNAM
33543        I2=I
33544        IF(ILEFT(ICASE).EQ.IHNAME(I).AND.
33545     1     ILEFT2(ICASE).EQ.IHNAM2(I).AND.
33546     1     IUSE(I).EQ.'P')GOTO230
33547        IF(ILEFT(ICASE).EQ.IHNAME(I).AND.
33548     1    ILEFT2(ICASE).EQ.IHNAM2(I).AND.
33549     1    IUSE(I).EQ.'V')GOTO280
33550        IF(ILEFT(ICASE).EQ.IHNAME(I).AND.
33551     1     ILEFT2(ICASE).EQ.IHNAM2(I).AND.
33552     1     IUSE(I).EQ.'M')GOTO280
33553  210 CONTINUE
33554C
33555C  CASE WHERE NAME NOT FOUND IN CURRENT NAME LIST
33556C
33557      NEWNAM(ICASE)='YES'
33558      IF(ICASE.GT.1)NUMVAL=ICASE
33559C
33560      IJUNK=0
33561      DO211I=1,ICASE
33562        IF(NEWNAM(I).EQ.'YES')IJUNK=IJUNK+1
33563  211 CONTINUE
33564      ILISL(ICASE)=NUMNAM+IJUNK
33565C
33566      IF(ILISL(ICASE).GT.MAXNAM)THEN
33567        WRITE(ICOUT,999)
33568        CALL DPWRST('XXX','BUG ')
33569        WRITE(ICOUT,221)
33570  221   FORMAT('***** ERROR 221 IN DPMAT6--')
33571        CALL DPWRST('XXX','BUG ')
33572        WRITE(ICOUT,222)
33573  222   FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
33574        CALL DPWRST('XXX','BUG ')
33575        WRITE(ICOUT,223)MAXNAM
33576  223   FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
33577     1         I8,'  .')
33578        CALL DPWRST('XXX','BUG ')
33579        WRITE(ICOUT,224)
33580  224   FORMAT('      SUGGESTED ACTION--ENTER    STATUS VARIABLES')
33581        CALL DPWRST('XXX','BUG ')
33582        WRITE(ICOUT,226)
33583  226   FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
33584        CALL DPWRST('XXX','BUG ')
33585        WRITE(ICOUT,227)
33586  227   FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
33587        CALL DPWRST('XXX','BUG ')
33588        WRITE(ICOUT,228)
33589  228   FORMAT('      ALREADY-USED NAMES.  ALTERNATIVELY, USE THE')
33590        CALL DPWRST('XXX','BUG ')
33591        WRITE(ICOUT,229)
33592  229   FORMAT('      DELETE COMMAND TO FREE NO LONGER NEED NAMES.')
33593        CALL DPWRST('XXX','BUG ')
33594        IERROR='YES'
33595        GOTO19000
33596      ELSE
33597        GOTO235
33598      ENDIF
33599C
33600C  CASE WHERE NAME FOUND AS A PARAMETER
33601C
33602  230 CONTINUE
33603      IF(ICASE.GT.1)NUMVAL=ICASE
33604      ILISL(ICASE)=I2
33605      GOTO235
33606C
33607  235 CONTINUE
33608      NIOLD=0
33609      IF(ICASE.GT.1)NUMVAL=ICASE
33610      IF(ICASE.EQ.1)THEN
33611        ICOLL(ICASE)=NUMCOL+1
33612      ELSEIF(ICASE.GT.1)THEN
33613        ICOLL(ICASE)=NUMCOL
33614        DO237I=1,ICASE
33615          IF(NEWNAM(I).EQ.'YES')ICOLL(ICASE)=ICOLL(ICASE)+1
33616  237   CONTINUE
33617      ENDIF
33618      IF(ICOLL(ICASE).LE.MAXCOL)GOTO290
33619C
33620      WRITE(ICOUT,241)
33621  241 FORMAT('***** ERROR 241 IN DPMAT6--')
33622      CALL DPWRST('XXX','BUG ')
33623      WRITE(ICOUT,242)
33624  242 FORMAT('      THE NUMBER OF DATA COLUMNS HAS JUST EXCEEDED')
33625      CALL DPWRST('XXX','BUG ')
33626      WRITE(ICOUT,243)MAXCOL
33627  243 FORMAT('      THE MAX ALLOWABLE ',I8,'  .  SUGGESTED ACTION--')
33628      CALL DPWRST('XXX','BUG ')
33629      WRITE(ICOUT,245)
33630  245 FORMAT('      ENTER      STATUS VARIABLES')
33631      CALL DPWRST('XXX','BUG ')
33632      WRITE(ICOUT,246)
33633  246 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
33634      CALL DPWRST('XXX','BUG ')
33635      WRITE(ICOUT,247)
33636  247 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
33637      CALL DPWRST('XXX','BUG ')
33638      WRITE(ICOUT,248)
33639  248 FORMAT('      IF       LET X(I) = 3.14         FAILED')
33640      CALL DPWRST('XXX','BUG ')
33641      WRITE(ICOUT,249)
33642  249 FORMAT('      THEN ONE MIGHT ENTER     LET X = COLUMN 7')
33643      CALL DPWRST('XXX','BUG ')
33644      WRITE(ICOUT,250)
33645  250 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
33646      CALL DPWRST('XXX','BUG ')
33647      WRITE(ICOUT,251)
33648  251 FORMAT('      FOLLOWED BY              LET X(I) = 3.14')
33649      CALL DPWRST('XXX','BUG ')
33650      WRITE(ICOUT,252)
33651  252 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
33652      CALL DPWRST('XXX','BUG ')
33653      WRITE(ICOUT,253)
33654  253 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14).')
33655      CALL DPWRST('XXX','BUG ')
33656      WRITE(ICOUT,255)
33657  255 FORMAT('      ALTERNATIVELY, USE THE DIMENSION COMMAND TO ',
33658     1       'CREATE MORE COLUMNS.')
33659      CALL DPWRST('XXX','BUG ')
33660      IERROR='YES'
33661      GOTO19000
33662C
33663C  CASE WHERE NAME FOUND AS A VARIABLE
33664C
33665  280 CONTINUE
33666      IF(ICASE.GT.1)NUMVAL=ICASE
33667      ILISL(ICASE)=I2
33668      ICOLL(ICASE)=IVALUE(ILISL(ICASE))
33669      NIOLD=IN(ILISL(ICASE))
33670C
33671  290 CONTINUE
33672      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')THEN
33673        WRITE(ICOUT,291)
33674  291   FORMAT('AT THE END OF STEP 2--')
33675        CALL DPWRST('XXX','BUG ')
33676        WRITE(ICOUT,292)ILEFT(ICASE),ILEFT2(ICASE),NEWNAM(ICASE),
33677     1                  NUMNAM,ILISL(ICASE),
33678     1                  ICOLL(ICASE),NIOLD
33679        CALL DPWRST('XXX','BUG ')
33680  292   FORMAT('ILEFT,ILEFT2,NEWNAM,NUMNAM,ILISL(ICASE),',
33681     1         'ICOLL(ICASE),NIOLD = ',A4,A4,2X,A4,2X,4I8)
33682      ENDIF
33683
33684C
33685C               *****************
33686C               **  STEP 90--  **
33687C               **  EXIT       **
33688C               *****************
33689C
3369019000 CONTINUE
33691      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')THEN
33692        WRITE(ICOUT,999)
33693        CALL DPWRST('XXX','BUG ')
33694        WRITE(ICOUT,19011)
3369519011   FORMAT('***** AT THE END       OF DPMAT6--')
33696        CALL DPWRST('XXX','BUG ')
33697        WRITE(ICOUT,19012)IFOUND,IERROR
3369819012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
33699        CALL DPWRST('XXX','BUG ')
33700        WRITE(ICOUT,19013)IBUGA3,ISUBRO
3370119013   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
33702        CALL DPWRST('XXX','BUG ')
33703        WRITE(ICOUT,19021)ILEFT(ICASE),ILEFT2(ICASE),ILISL(ICASE),
33704     1                    ICOLL(ICASE)
3370519021   FORMAT('ILEFT,ILEFT2,ILISL(ICASE),ICOLL(ICASE) = ',
33706     1         A4,2X,A4,2I8)
33707        CALL DPWRST('XXX','BUG ')
33708        WRITE(ICOUT,19023)NEWNAM(ICASE)
3370919023   FORMAT('NEWNAM = ',A4)
33710        CALL DPWRST('XXX','BUG ')
33711      ENDIF
33712C
33713      RETURN
33714      END
33715      SUBROUTINE DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
33716     1                  IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
33717     1                  IFLAG1,ATEMP,ITEMP,
33718     1                  IBUGA3,ISUBRO,IFOUND,IERROR)
33719C
33720C     NOTE--THIS SUBROUTINE IS A UTILITY ROUTINE FOR DPMATC AND
33721C           DPMAT2.  IT CHECKS A VARIABLE ON THE RIGHT HAND SIDE
33722C           OF THE EQUAL SIGN.
33723C     WRITTEN BY--JAMES J. FILLIBEN
33724C                 STATISTICAL ENGINEERING DIVISION
33725C                 INFORMATION TECHNOLOGY LABORATORY
33726C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33727C                 GAITHERSBURG, MD 20899-8980
33728C                 PHONE--301-975-2855
33729C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33730C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33731C     LANGUAGE--ANSI FORTRAN (1977)
33732C     VERSION NUMBER--2002/6
33733C     ORIGINAL VERSION--JUNE      2002.
33734C
33735C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
33736C
33737      CHARACTER*4 ICASL7
33738      CHARACTER*4 IBUGA3
33739      CHARACTER*4 ISUBRO
33740      CHARACTER*4 IFOUND
33741      CHARACTER*4 IERROR
33742C
33743      CHARACTER*4 IHRIGH
33744      CHARACTER*4 IHRIG2
33745      CHARACTER*4 ITYPA(MAXCAS)
33746C
33747      CHARACTER*4 ISUBN1
33748      CHARACTER*4 ISUBN2
33749      CHARACTER*4 ISTEPN
33750C
33751      REAL TEMPS(MAXCAS)
33752C
33753      INTEGER ICOLR(MAXCAS)
33754      INTEGER ILISR(MAXCAS)
33755      INTEGER NIRIGH(MAXCAS)
33756      INTEGER ILOCR(MAXCAS)
33757C
33758C---------------------------------------------------------------------
33759C
33760C-----COMMON----------------------------------------------------------
33761C
33762      INCLUDE 'DPCOPA.INC'
33763      INCLUDE 'DPCODA.INC'
33764      INCLUDE 'DPCOHK.INC'
33765      INCLUDE 'DPCOP2.INC'
33766C
33767C-----START POINT-----------------------------------------------------
33768C
33769      ISUBN1='DPMA'
33770      ISUBN2='T7  '
33771      IFOUND='NO'
33772      IERROR='NO'
33773C
33774      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT7')THEN
33775        WRITE(ICOUT,999)
33776  999   FORMAT(1X)
33777        CALL DPWRST('XXX','BUG ')
33778        WRITE(ICOUT,51)
33779   51   FORMAT('***** AT THE BEGINNING OF DPMAT7--')
33780        CALL DPWRST('XXX','BUG ')
33781        WRITE(ICOUT,52)ICASL7,IBUGA3,ISUBRO
33782   52   FORMAT('ICASL7,IBUGA3,ISUBRO = ',A4,2X,A4,2X,A4)
33783        CALL DPWRST('XXX','BUG ')
33784        WRITE(ICOUT,53)ICASE
33785   53   FORMAT('ICASE = ',I8)
33786        CALL DPWRST('XXX','BUG ')
33787        WRITE(ICOUT,54)ILOCR(ICASE)
33788   54   FORMAT('ILOCR(ICASE) = ',I8)
33789        CALL DPWRST('XXX','BUG ')
33790        WRITE(ICOUT,55)ICOLR(ICASE)
33791   55   FORMAT('ICOLR(ICASE) = ',I8)
33792        CALL DPWRST('XXX','BUG ')
33793        WRITE(ICOUT,56)ILISR(ICASE)
33794   56   FORMAT('ILISR(ICASE) = ',I8)
33795        CALL DPWRST('XXX','BUG ')
33796      ENDIF
33797C
33798C               ***************************************
33799C               **  STEP 1--                         **
33800C               **  EXAMINE THE VARIABLE             **
33801C               **  ON THE RIGHT.                    **
33802C               ***************************************
33803C
33804      ISTEPN='1.0'
33805      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT7')
33806     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
33807C
33808      IHRIGH=IHARG(ILOCR(ICASE))
33809      IHRIG2=IHARG2(ILOCR(ICASE))
33810      ATEMP=ARG(ILOCR(ICASE))
33811      ITEMP=IARG(ILOCR(ICASE))
33812      DO1220I=1,NUMNAM
33813        I2=I
33814        IF(IHRIGH.EQ.IHNAME(I).AND.
33815     1     IHRIG2.EQ.IHNAM2(I).AND.
33816     1     IUSE(I).EQ.'V')GOTO1270
33817        IF(IHRIGH.EQ.IHNAME(I).AND.
33818     1     IHRIG2.EQ.IHNAM2(I).AND.
33819     1     IUSE(I).EQ.'M')GOTO1280
33820        IF(IHRIGH.EQ.IHNAME(I).AND.
33821     1     IHRIG2.EQ.IHNAM2(I).AND.
33822     1     IUSE(I).EQ.'P')GOTO1240
33823 1220 CONTINUE
33824C
33825      IF(IFLAG1.EQ.1)GOTO1250
33826C
33827      WRITE(ICOUT,999)
33828      CALL DPWRST('XXX','BUG ')
33829      WRITE(ICOUT,1221)
33830 1221 FORMAT('***** ERROR 1221 IN DPMAT7--')
33831      CALL DPWRST('XXX','BUG ')
33832      WRITE(ICOUT,1222)ICASE
33833 1222 FORMAT('      THE SPECIFIED ARGUMENT ',I3)
33834      CALL DPWRST('XXX','BUG ')
33835      WRITE(ICOUT,1223)
33836 1223 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
33837      CALL DPWRST('XXX','BUG ')
33838      WRITE(ICOUT,1224)
33839 1224 FORMAT('      ON THE RIGHT OF THE = SIGN')
33840      CALL DPWRST('XXX','BUG ')
33841      WRITE(ICOUT,1225)
33842 1225 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
33843      CALL DPWRST('XXX','BUG ')
33844      WRITE(ICOUT,1226)
33845 1226 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
33846      CALL DPWRST('XXX','BUG ')
33847      WRITE(ICOUT,999)
33848      CALL DPWRST('XXX','BUG ')
33849      WRITE(ICOUT,1227)IHRIGH,IHRIG2
33850 1227 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
33851      CALL DPWRST('XXX','BUG ')
33852      WRITE(ICOUT,999)
33853      CALL DPWRST('XXX','BUG ')
33854      WRITE(ICOUT,1228)
33855 1228 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
33856      CALL DPWRST('XXX','BUG ')
33857      IF(IWIDTH.GE.1)THEN
33858        WRITE(ICOUT,1229)(IANS(I),I=1,MIN(100,IWIDTH))
33859 1229   FORMAT(100A1)
33860        CALL DPWRST('XXX','BUG ')
33861      ENDIF
33862      IERROR='YES'
33863      GOTO19000
33864C
33865 1240 CONTINUE
33866      IF(IFLAG1.EQ.1)GOTO1260
33867C
33868      WRITE(ICOUT,999)
33869      CALL DPWRST('XXX','BUG ')
33870      WRITE(ICOUT,1241)
33871 1241 FORMAT('***** ERROR 1241 IN DPMAT7--')
33872      CALL DPWRST('XXX','BUG ')
33873      WRITE(ICOUT,1242)ICASE
33874 1242 FORMAT('      THE SPECIFIED ARGUMENT ',I4)
33875      CALL DPWRST('XXX','BUG ')
33876      WRITE(ICOUT,1243)
33877 1243 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
33878      CALL DPWRST('XXX','BUG ')
33879      WRITE(ICOUT,1244)
33880 1244 FORMAT('      ON THE RIGHT OF THE = SIGN')
33881      CALL DPWRST('XXX','BUG ')
33882      WRITE(ICOUT,1245)
33883 1245 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
33884      CALL DPWRST('XXX','BUG ')
33885      WRITE(ICOUT,1246)
33886 1246 FORMAT('      BUT AS A PARAMETER,')
33887      CALL DPWRST('XXX','BUG ')
33888      WRITE(ICOUT,1247)
33889 1247 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
33890      CALL DPWRST('XXX','BUG ')
33891      WRITE(ICOUT,1248)
33892 1248 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
33893      CALL DPWRST('XXX','BUG ')
33894      WRITE(ICOUT,1249)(IANS(I),I=1,MIN(100,IWIDTH))
33895 1249 FORMAT(100A1)
33896      CALL DPWRST('XXX','BUG ')
33897      IERROR='YES'
33898      GOTO19000
33899C
33900 1250 CONTINUE
33901      ITYPA(ICASE)='PARA'
33902      TEMPS(ICASE)=ARG(ILOCR(ICASE))
33903      NIRIGH(ICASE)=1
33904      GOTO1290
33905C
33906 1260 CONTINUE
33907      ITYPA(ICASE)='PARA'
33908      ILISR(ICASE)=I2
33909      TEMPS(ICASE)=VALUE(ILISR(ICASE))
33910      NIRIGH(ICASE)=1
33911      GOTO1290
33912C
33913 1270 CONTINUE
33914      ITYPA(ICASE)='VARI'
33915      ILISR(ICASE)=I2
33916      ICOLR(ICASE)=IVALUE(ILISR(ICASE))
33917      NIRIGH(ICASE)=IN(ILISR(ICASE))
33918      GOTO1290
33919C
33920 1280 CONTINUE
33921      ITYPA(ICASE)='MATR'
33922      ILISR(ICASE)=I2
33923      ICOLR(ICASE)=IVALUE(ILISR(ICASE))
33924      NIRIGH(ICASE)=IN(ILISR(ICASE))
33925      GOTO1290
33926C
33927 1290 CONTINUE
33928C
33929C               *****************
33930C               **  STEP 90--  **
33931C               **  EXIT       **
33932C               *****************
33933C
3393419000 CONTINUE
33935      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT7')THEN
33936        WRITE(ICOUT,999)
33937        CALL DPWRST('XXX','BUG ')
33938        WRITE(ICOUT,19011)
3393919011   FORMAT('***** AT THE END       OF DPMAT7--')
33940        CALL DPWRST('XXX','BUG ')
33941        WRITE(ICOUT,19012)IFOUND,IERROR
3394219012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
33943        CALL DPWRST('XXX','BUG ')
33944        WRITE(ICOUT,19013)IBUGA3,ISUBRO
3394519013   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
33946        CALL DPWRST('XXX','BUG ')
33947        WRITE(ICOUT,19021)IHRIGH,IHRIG2,
33948     1                    ILISR(ICASE),NIRIGH(ICASE)
3394919021   FORMAT('IHRIGH,IHRIG2,ILISR(ICASE),',
33950     1         'NIRIGH(ICASE) = ',A4,2X,A4,2I8)
33951        CALL DPWRST('XXX','BUG ')
33952        WRITE(ICOUT,19023)ITYPA(ICASE),ICOLR(ICASE)
3395319023   FORMAT('ITYPA(ICASE),ICOLR(ICASE) = ',A4,I8)
33954        CALL DPWRST('XXX','BUG ')
33955        WRITE(ICOUT,19025)TEMPS(ICASE),NIRIGH(ICASE)
3395619025   FORMAT('TEMPS(ICASE),NIRIGH(ICASE) = ',E15.7,I8)
33957        CALL DPWRST('XXX','BUG ')
33958      ENDIF
33959C
33960      RETURN
33961      END
33962      SUBROUTINE DPMATH(ICHARC,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
33963     1                  IBUGD2,IFOUND,IERROR)
33964C
33965C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
33966C              FOR MATH SYMBOLS.
33967C     WRITTEN BY--JAMES J. FILLIBEN
33968C                 STATISTICAL ENGINEERING DIVISION
33969C                 INFORMATION TECHNOLOGY LABORATORY
33970C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33971C                 Gaithersburg, MD 20899-8980
33972C                 PHONE--301-975-2855
33973C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33974C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33975C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
33976C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
33977C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
33978C     LANGUAGE--ANSI FORTRAN (1977)
33979C     VERSION NUMBER--87/4
33980C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
33981C     UPDATED         --MAY       1982.
33982C     UPDATED         --MARCH     1987.
33983C
33984C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
33985C
33986      CHARACTER*4 ICHARC
33987      CHARACTER*4 IOP
33988      CHARACTER*4 IBUGD2
33989      CHARACTER*4 IFOUND
33990      CHARACTER*4 IERROR
33991C
33992C---------------------------------------------------------------------
33993C
33994      DIMENSION IOP(*)
33995      DIMENSION X(*)
33996      DIMENSION Y(*)
33997C
33998C-----COMMON----------------------------------------------------------
33999C
34000      INCLUDE 'DPCOBE.INC'
34001      INCLUDE 'DPCOP2.INC'
34002C
34003C-----START POINT-----------------------------------------------------
34004C
34005      IFOUND='NO'
34006      IERROR='NO'
34007C
34008      NUMCO=1
34009      ISTART=1
34010      ISTOP=1
34011      NC=1
34012C
34013C               ******************************************
34014C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
34015C               **  HERSHEY CHARACTER SET CASE          **
34016C               ******************************************
34017C
34018C
34019      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MATH')GOTO90
34020      WRITE(ICOUT,999)
34021  999 FORMAT(1X)
34022      CALL DPWRST('XXX','BUG ')
34023      WRITE(ICOUT,51)
34024   51 FORMAT('***** AT THE BEGINNING OF DPMATH--')
34025      CALL DPWRST('XXX','BUG ')
34026      WRITE(ICOUT,52)ICHARC
34027   52 FORMAT('ICHARC = ',A4)
34028      CALL DPWRST('XXX','BUG ')
34029      WRITE(ICOUT,59)IBUGG4,ISUBG4,IFOUND,IERROR
34030   59 FORMAT('IBUGG4,ISUBG4,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
34031      CALL DPWRST('XXX','BUG ')
34032   90 CONTINUE
34033C
34034C               **************************************************
34035C               **  STEP 1--                                    **
34036C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
34037C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
34038C               **************************************************
34039C
34040      CALL DPCHMA(ICHARC,ICHARN,IBUGD2,IFOUND)
34041      IF(IFOUND.EQ.'NO')GOTO9000
34042C
34043      IF(ICHARN.LE.32)GOTO1010
34044      GOTO1019
34045 1010 CONTINUE
34046      CALL DMATH1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
34047     1IBUGD2,IFOUND,IERROR)
34048      GOTO9000
34049 1019 CONTINUE
34050C
34051      IF(33.LE.ICHARN.AND.ICHARN.LE.51)GOTO1020
34052      GOTO1029
34053 1020 CONTINUE
34054      CALL DMATH2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
34055     1IBUGD2,IFOUND,IERROR)
34056      GOTO9000
34057 1029 CONTINUE
34058C
34059      IF(52.LE.ICHARN.AND.ICHARN.LE.60)GOTO1030
34060      GOTO1039
34061 1030 CONTINUE
34062      CALL DMATH3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
34063     1IBUGD2,IFOUND,IERROR)
34064      GOTO9000
34065 1039 CONTINUE
34066C
34067      IF(ICHARN.GE.61)GOTO1040
34068      GOTO1049
34069 1040 CONTINUE
34070      CALL DMATH4(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
34071     1IBUGD2,IFOUND,IERROR)
34072      GOTO9000
34073 1049 CONTINUE
34074C
34075      IFOUND='NO'
34076      GOTO9000
34077C
34078C
34079C               *****************
34080C               **  STEP 90--  **
34081C               **  EXIT       **
34082C               *****************
34083C
34084 9000 CONTINUE
34085      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MATH')GOTO9090
34086      WRITE(ICOUT,999)
34087      CALL DPWRST('XXX','BUG ')
34088      WRITE(ICOUT,9011)
34089 9011 FORMAT('***** AT THE END       OF DPMATH--')
34090      CALL DPWRST('XXX','BUG ')
34091      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IFOUND,IERROR
34092 9012 FORMAT('IBUGG4,ISUBG4,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
34093      CALL DPWRST('XXX','BUG ')
34094      WRITE(ICOUT,9013)ICHARC,ICHARN
34095 9013 FORMAT('ICHARC,ICHARN = ',A4,I8)
34096      CALL DPWRST('XXX','BUG ')
34097      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
34098 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
34099      CALL DPWRST('XXX','BUG ')
34100      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
34101      DO9015I=1,NUMCO
34102      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
34103 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
34104      CALL DPWRST('XXX','BUG ')
34105 9015 CONTINUE
34106 9019 CONTINUE
34107      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
34108 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
34109      CALL DPWRST('XXX','BUG ')
34110 9090 CONTINUE
34111C
34112      RETURN
34113      END
34114      SUBROUTINE DPMATN(ICOM,IHARG,IARGT,IARG,NUMARG,
34115     1                  IX1JSW,IX2JSW,IY1JSW,IY2JSW,
34116     1                  NMJX1T,NMJX2T,NMJY1T,NMJY2T,
34117     1                  IFOUND,IERROR)
34118C
34119C     PURPOSE--DEFINE THE NUMBER OF MAJOR TIC MARKS
34120C              FOR HORIZONTAL FRAME LINES OR VERTICAL FRAME LINES OR BOTH.
34121C     INPUT  ARGUMENTS--ICOM  (A  CHARACTER VECTOR)
34122C                     --IHARG  (A  CHARACTER VECTOR)
34123C                     --IARG   (AN INTEGER VECTOR)
34124C                     --NUMARG
34125C     OUTPUT ARGUMENTS--
34126C                     --IX1JSW (A CHARACTER VARIABLE)
34127C                     --IX2JSW (A CHARACTER VARIABLE)
34128C                     --IY1JSW (A CHARACTER VARIABLE)
34129C                     --IY2JSW (A CHARACTER VARIABLE)
34130C                     --NMJX1T (AN INTEGER VARIABLE)
34131C                     --NMJX2T (AN INTEGER VARIABLE)
34132C                     --NMJY1T (AN INTEGER VARIABLE)
34133C                     --NMJY2T (AN INTEGER VARIABLE)
34134C                     --IFOUND ('YES' OR 'NO' )
34135C                     --IERROR ('YES' OR 'NO' )
34136C     WRITTEN BY--JAMES J. FILLIBEN
34137C                 STATISTICAL ENGINEERING DIVISION
34138C                 INFORMATION TECHNOLOGY LABORATORY
34139C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
34140C                 Gaithersburg, MD 20899-8980
34141C                 PHONE--301-975-2855
34142C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
34143C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
34144C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
34145C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
34146C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
34147C     LANGUAGE--ANSI FORTRAN (1977)
34148C     VERSION NUMBER--82/7
34149C     ORIGINAL VERSION--DECEMBER  1982.
34150C     UPDATED--JANUARY  1988. (OPTIONAL OMISSION OF THE WORD   MAJOR)
34151C
34152C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
34153C
34154      CHARACTER*4 ICOM
34155      CHARACTER*4 IHARG
34156      CHARACTER*4 IARGT
34157C
34158      CHARACTER*4 IX1JSW
34159      CHARACTER*4 IX2JSW
34160      CHARACTER*4 IY1JSW
34161      CHARACTER*4 IY2JSW
34162C
34163      CHARACTER*4 IFOUND
34164      CHARACTER*4 IERROR
34165C
34166      CHARACTER*4 IHHOLD
34167C
34168C---------------------------------------------------------------------
34169C
34170      DIMENSION IHARG(*)
34171      DIMENSION IARGT(*)
34172      DIMENSION IARG(*)
34173C
34174C---------------------------------------------------------------------
34175C
34176      INCLUDE 'DPCOP2.INC'
34177C
34178C-----START POINT-----------------------------------------------------
34179C
34180      IFOUND='NO'
34181      IERROR='NO'
34182C
34183      IF(ICOM.NE.'MAJO')GOTO1010
34184      GOTO1019
34185 1010 CONTINUE
34186      IF(ICOM.EQ.'XTIC')GOTO1100
34187      IF(ICOM.EQ.'X1TI')GOTO1200
34188      IF(ICOM.EQ.'X2TI')GOTO1300
34189      IF(ICOM.EQ.'YTIC')GOTO1400
34190      IF(ICOM.EQ.'Y1TI')GOTO1500
34191      IF(ICOM.EQ.'Y2TI')GOTO1600
34192      IF(ICOM.EQ.'TIC')GOTO1700
34193      IF(ICOM.EQ.'TICS')GOTO1700
34194      GOTO9000
34195 1019 CONTINUE
34196C
34197      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.1)GOTO1020
34198      GOTO1029
34199 1020 CONTINUE
34200      IF(IHARG(1).EQ.'XTIC')GOTO1100
34201      IF(IHARG(1).EQ.'X1TI')GOTO1200
34202      IF(IHARG(1).EQ.'X2TI')GOTO1300
34203      IF(IHARG(1).EQ.'YTIC')GOTO1400
34204      IF(IHARG(1).EQ.'Y1TI')GOTO1500
34205      IF(IHARG(1).EQ.'Y2TI')GOTO1600
34206      IF(IHARG(1).EQ.'TIC')GOTO1700
34207      IF(IHARG(1).EQ.'TICS')GOTO1700
34208      GOTO9000
34209 1029 CONTINUE
34210      GOTO9000
34211C
34212C               ********************************************************
34213C               **  STEP 1--
34214C               **  TREAT THE CASE WHEN
34215C               **  ONLY THE HORIZONTAL MAJOR TICS ARE TO BE CHANGED
34216C               ********************************************************
34217C
34218 1100 CONTINUE
34219      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1110
34220      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1110
34221      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1110
34222      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1110
34223C
34224      WRITE(ICOUT,999)
34225  999 FORMAT(1X)
34226      CALL DPWRST('XXX','BUG ')
34227      WRITE(ICOUT,1101)
34228 1101 FORMAT('***** ERROR IN DPMATN--')
34229      CALL DPWRST('XXX','BUG ')
34230      WRITE(ICOUT,1102)
34231 1102 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
34232      CALL DPWRST('XXX','BUG ')
34233      WRITE(ICOUT,1103)
34234 1103 FORMAT('      NUMBER OF MAJOR (HORIZONTAL) TIC MARKS.')
34235      CALL DPWRST('XXX','BUG ')
34236      WRITE(ICOUT,1104)
34237 1104 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
34238      CALL DPWRST('XXX','BUG ')
34239      WRITE(ICOUT,1105)
34240 1105 FORMAT('      (ON THE HORIZONTAL FRAME LINES)--')
34241      CALL DPWRST('XXX','BUG ')
34242      WRITE(ICOUT,1106)
34243 1106 FORMAT('      MAJOR XTIC MARK NUMBER 3')
34244      CALL DPWRST('XXX','BUG ')
34245      WRITE(ICOUT,1107)
34246 1107 FORMAT('      MAJOR XTICS NUMBER 3')
34247      CALL DPWRST('XXX','BUG ')
34248      IERROR='YES'
34249      GOTO9000
34250C
34251 1110 CONTINUE
34252      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
34253      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
34254      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
34255      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
34256      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1150
34257      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
34258      IERROR='YES'
34259      GOTO9000
34260C
34261 1150 CONTINUE
34262      IHHOLD='FLOA'
34263      IHOLD=(-1)
34264      GOTO1180
34265C
34266 1160 CONTINUE
34267      IHHOLD='FIXE'
34268      IHOLD=IARG(NUMARG)
34269      GOTO1180
34270C
34271 1180 CONTINUE
34272      IFOUND='YES'
34273      IX1JSW=IHHOLD
34274      IX2JSW=IHHOLD
34275      NMJX1T=IHOLD
34276      NMJX2T=IHOLD
34277C
34278      IF(IFEEDB.EQ.'OFF')GOTO1189
34279      WRITE(ICOUT,999)
34280      CALL DPWRST('XXX','BUG ')
34281      WRITE(ICOUT,1181)
34282 1181 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
34283      CALL DPWRST('XXX','BUG ')
34284      WRITE(ICOUT,1182)
34285 1182 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES')
34286      CALL DPWRST('XXX','BUG ')
34287      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1183)IHOLD
34288 1183 FORMAT('HAS JUST BEEN SET TO ',I8)
34289      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
34290      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1184)
34291 1184 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
34292      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
34293 1189 CONTINUE
34294      GOTO9000
34295C
34296C               ********************************************************
34297C               **  STEP 2--
34298C               **  TREAT THE CASE WHEN
34299C               **  ONLY THE BOTTOM HORIZONTAL MAJOR TICS ARE TO BE CHANGED
34300C               ********************************************************
34301C
34302 1200 CONTINUE
34303      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1210
34304      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1210
34305      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1210
34306      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1210
34307C
34308      WRITE(ICOUT,999)
34309      CALL DPWRST('XXX','BUG ')
34310      WRITE(ICOUT,1201)
34311 1201 FORMAT('***** ERROR IN DPMATN--')
34312      CALL DPWRST('XXX','BUG ')
34313      WRITE(ICOUT,1202)
34314 1202 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
34315      CALL DPWRST('XXX','BUG ')
34316      WRITE(ICOUT,1203)
34317 1203 FORMAT('      NUMBER OF MAJOR (HORIZONTAL) TIC MARKS.')
34318      CALL DPWRST('XXX','BUG ')
34319      WRITE(ICOUT,1204)
34320 1204 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
34321      CALL DPWRST('XXX','BUG ')
34322      WRITE(ICOUT,1205)
34323 1205 FORMAT('      (ON THE BOTTOM HORIZONTAL FRAME LINES)--')
34324      CALL DPWRST('XXX','BUG ')
34325      WRITE(ICOUT,1206)
34326 1206 FORMAT('      MAJOR X1TIC MARK NUMBER 3')
34327      CALL DPWRST('XXX','BUG ')
34328      WRITE(ICOUT,1207)
34329 1207 FORMAT('      MAJOR X1TICS NUMBER 3')
34330      CALL DPWRST('XXX','BUG ')
34331      IERROR='YES'
34332      GOTO9000
34333C
34334 1210 CONTINUE
34335      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
34336      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
34337      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
34338      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
34339      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1250
34340      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
34341      IERROR='YES'
34342      GOTO9000
34343C
34344 1250 CONTINUE
34345      IHHOLD='FLOA'
34346      IHOLD=(-1)
34347      GOTO1280
34348C
34349 1260 CONTINUE
34350      IHHOLD='FIXE'
34351      IHOLD=IARG(NUMARG)
34352      GOTO1280
34353C
34354 1280 CONTINUE
34355      IFOUND='YES'
34356      IX1JSW=IHHOLD
34357      NMJX1T=IHOLD
34358C
34359      IF(IFEEDB.EQ.'OFF')GOTO1289
34360      WRITE(ICOUT,999)
34361      CALL DPWRST('XXX','BUG ')
34362      WRITE(ICOUT,1281)
34363 1281 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
34364      CALL DPWRST('XXX','BUG ')
34365      WRITE(ICOUT,1282)
34366 1282 FORMAT('(FOR THE BOTTOM HORIZONTAL FRAME LINE')
34367      CALL DPWRST('XXX','BUG ')
34368      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1283)IHOLD
34369 1283 FORMAT('HAS JUST BEEN SET TO ',I8)
34370      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
34371      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1284)
34372 1284 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
34373      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
34374 1289 CONTINUE
34375      GOTO9000
34376C
34377C               ********************************************************
34378C               **  STEP 3--
34379C               **  TREAT THE CASE WHEN
34380C               **  ONLY THE TOP    HORIZONTAL MAJOR TICS ARE TO BE CHANGED
34381C               ********************************************************
34382C
34383 1300 CONTINUE
34384      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1310
34385      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1310
34386      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1310
34387      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1310
34388C
34389      WRITE(ICOUT,999)
34390      CALL DPWRST('XXX','BUG ')
34391      WRITE(ICOUT,1301)
34392 1301 FORMAT('***** ERROR IN DPMATN--')
34393      CALL DPWRST('XXX','BUG ')
34394      WRITE(ICOUT,1302)
34395 1302 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
34396      CALL DPWRST('XXX','BUG ')
34397      WRITE(ICOUT,1303)
34398 1303 FORMAT('      NUMBER OF MAJOR (HORIZONTAL) TIC MARKS.')
34399      CALL DPWRST('XXX','BUG ')
34400      WRITE(ICOUT,1304)
34401 1304 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
34402      CALL DPWRST('XXX','BUG ')
34403      WRITE(ICOUT,1305)
34404 1305 FORMAT('      (ON THE TOP HORIZONTAL FRAME LINES)--')
34405      CALL DPWRST('XXX','BUG ')
34406      WRITE(ICOUT,1306)
34407 1306 FORMAT('      MAJOR X2TIC MARK NUMBER 3')
34408      CALL DPWRST('XXX','BUG ')
34409      WRITE(ICOUT,1307)
34410 1307 FORMAT('      MAJOR X2TICS NUMBER 3')
34411      CALL DPWRST('XXX','BUG ')
34412      IERROR='YES'
34413      GOTO9000
34414C
34415 1310 CONTINUE
34416      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
34417      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
34418      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
34419      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
34420      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1350
34421      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
34422      IERROR='YES'
34423      GOTO9000
34424C
34425 1350 CONTINUE
34426      IHHOLD='FLOA'
34427      IHOLD=(-1)
34428      GOTO1380
34429C
34430 1360 CONTINUE
34431      IHHOLD='FIXE'
34432      IHOLD=IARG(NUMARG)
34433      GOTO1380
34434C
34435 1380 CONTINUE
34436      IFOUND='YES'
34437      IX2JSW=IHHOLD
34438      NMJX2T=IHOLD
34439C
34440      IF(IFEEDB.EQ.'OFF')GOTO1389
34441      WRITE(ICOUT,999)
34442      CALL DPWRST('XXX','BUG ')
34443      WRITE(ICOUT,1381)
34444 1381 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
34445      CALL DPWRST('XXX','BUG ')
34446      WRITE(ICOUT,1382)
34447 1382 FORMAT('(FOR THE TOP HORIZONTAL FRAME LINE')
34448      CALL DPWRST('XXX','BUG ')
34449      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1383)IHOLD
34450 1383 FORMAT('HAS JUST BEEN SET TO ',I8)
34451      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
34452      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1384)
34453 1384 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
34454      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
34455 1389 CONTINUE
34456      GOTO9000
34457C
34458C               ********************************************************
34459C               **  STEP 4--
34460C               **  TREAT THE CASE WHEN
34461C               **  ONLY THE VERTICAL    MAJOR TICS ARE TO BE CHANGED
34462C               ********************************************************
34463C
34464 1400 CONTINUE
34465      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1410
34466      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1410
34467      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1410
34468      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1410
34469C
34470      WRITE(ICOUT,999)
34471      CALL DPWRST('XXX','BUG ')
34472      WRITE(ICOUT,1401)
34473 1401 FORMAT('***** ERROR IN DPMATN--')
34474      CALL DPWRST('XXX','BUG ')
34475      WRITE(ICOUT,1402)
34476 1402 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
34477      CALL DPWRST('XXX','BUG ')
34478      WRITE(ICOUT,1403)
34479 1403 FORMAT('      NUMBER OF MAJOR (VERTICAL) TIC MARKS.')
34480      CALL DPWRST('XXX','BUG ')
34481      WRITE(ICOUT,1404)
34482 1404 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
34483      CALL DPWRST('XXX','BUG ')
34484      WRITE(ICOUT,1405)
34485 1405 FORMAT('      (ON THE VERTICAL FRAME LINES)--')
34486      CALL DPWRST('XXX','BUG ')
34487      WRITE(ICOUT,1406)
34488 1406 FORMAT('      MAJOR YTIC MARK NUMBER 3')
34489      CALL DPWRST('XXX','BUG ')
34490      WRITE(ICOUT,1407)
34491 1407 FORMAT('      MAJOR YTICS NUMBER 3')
34492      CALL DPWRST('XXX','BUG ')
34493      IERROR='YES'
34494      GOTO9000
34495C
34496 1410 CONTINUE
34497      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
34498      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
34499      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
34500      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
34501      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1450
34502      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
34503      IERROR='YES'
34504      GOTO9000
34505C
34506 1450 CONTINUE
34507      IHHOLD='FLOA'
34508      IHOLD=(-1)
34509      GOTO1480
34510C
34511 1460 CONTINUE
34512      IHHOLD='FIXE'
34513      IHOLD=IARG(NUMARG)
34514      GOTO1480
34515C
34516 1480 CONTINUE
34517      IFOUND='YES'
34518      IY1JSW=IHHOLD
34519      IY2JSW=IHHOLD
34520      NMJY1T=IHOLD
34521      NMJY2T=IHOLD
34522C
34523      IF(IFEEDB.EQ.'OFF')GOTO1489
34524      WRITE(ICOUT,999)
34525      CALL DPWRST('XXX','BUG ')
34526      WRITE(ICOUT,1481)
34527 1481 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
34528      CALL DPWRST('XXX','BUG ')
34529      WRITE(ICOUT,1482)
34530 1482 FORMAT('(FOR BOTH VERTICAL FRAME LINES')
34531      CALL DPWRST('XXX','BUG ')
34532      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1483)IHOLD
34533 1483 FORMAT('HAS JUST BEEN SET TO ',I8)
34534      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
34535      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1484)
34536 1484 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
34537      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
34538 1489 CONTINUE
34539      GOTO9000
34540C
34541C               ********************************************************
34542C               **  STEP 5--
34543C               **  TREAT THE CASE WHEN
34544C               **  ONLY THE LEFT VERTICAL MAJOR TICS ARE TO BE CHANGED
34545C               ********************************************************
34546C
34547 1500 CONTINUE
34548      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1510
34549      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1510
34550      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1510
34551      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1510
34552C
34553      WRITE(ICOUT,999)
34554      CALL DPWRST('XXX','BUG ')
34555      WRITE(ICOUT,1501)
34556 1501 FORMAT('***** ERROR IN DPMATN--')
34557      CALL DPWRST('XXX','BUG ')
34558      WRITE(ICOUT,1502)
34559 1502 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
34560      CALL DPWRST('XXX','BUG ')
34561      WRITE(ICOUT,1503)
34562 1503 FORMAT('      NUMBER OF MAJOR (VERTICAL) TIC MARKS.')
34563      CALL DPWRST('XXX','BUG ')
34564      WRITE(ICOUT,1504)
34565 1504 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
34566      CALL DPWRST('XXX','BUG ')
34567      WRITE(ICOUT,1505)
34568 1505 FORMAT('      (ON THE LEFT VERTICAL FRAME LINES)--')
34569      CALL DPWRST('XXX','BUG ')
34570      WRITE(ICOUT,1506)
34571 1506 FORMAT('      MAJOR Y1TIC MARK NUMBER 3')
34572      CALL DPWRST('XXX','BUG ')
34573      WRITE(ICOUT,1507)
34574 1507 FORMAT('      MAJOR Y1TICS NUMBER 3')
34575      CALL DPWRST('XXX','BUG ')
34576      IERROR='YES'
34577      GOTO9000
34578C
34579 1510 CONTINUE
34580      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
34581      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
34582      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
34583      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
34584      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1550
34585      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
34586      IERROR='YES'
34587      GOTO9000
34588C
34589 1550 CONTINUE
34590      IHHOLD='FLOA'
34591      IHOLD=(-1)
34592      GOTO1580
34593C
34594 1560 CONTINUE
34595      IHHOLD='FIXE'
34596      IHOLD=IARG(NUMARG)
34597      GOTO1580
34598C
34599 1580 CONTINUE
34600      IFOUND='YES'
34601      IY1JSW=IHHOLD
34602      NMJY1T=IHOLD
34603C
34604      IF(IFEEDB.EQ.'OFF')GOTO1589
34605      WRITE(ICOUT,999)
34606      CALL DPWRST('XXX','BUG ')
34607      WRITE(ICOUT,1581)
34608 1581 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
34609      CALL DPWRST('XXX','BUG ')
34610      WRITE(ICOUT,1582)
34611 1582 FORMAT('(FOR THE LEFT VERTICAL FRAME LINE')
34612      CALL DPWRST('XXX','BUG ')
34613      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1583)IHOLD
34614 1583 FORMAT('HAS JUST BEEN SET TO ',I8)
34615      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
34616      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1584)
34617 1584 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
34618      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
34619 1589 CONTINUE
34620      GOTO9000
34621C
34622C               ********************************************************
34623C               **  STEP 6--
34624C               **  TREAT THE CASE WHEN
34625C               **  ONLY THE RIGHT VERTICAL MAJOR TICS ARE TO BE CHANGED
34626C               ********************************************************
34627C
34628 1600 CONTINUE
34629      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1610
34630      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1610
34631      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1610
34632      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1610
34633C
34634      WRITE(ICOUT,999)
34635      CALL DPWRST('XXX','BUG ')
34636      WRITE(ICOUT,1601)
34637 1601 FORMAT('***** ERROR IN DPMATN--')
34638      CALL DPWRST('XXX','BUG ')
34639      WRITE(ICOUT,1602)
34640 1602 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
34641      CALL DPWRST('XXX','BUG ')
34642      WRITE(ICOUT,1603)
34643 1603 FORMAT('      NUMBER OF MAJOR (VERTICAL) TIC MARKS.')
34644      CALL DPWRST('XXX','BUG ')
34645      WRITE(ICOUT,1604)
34646 1604 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
34647      CALL DPWRST('XXX','BUG ')
34648      WRITE(ICOUT,1605)
34649 1605 FORMAT('      (ON THE RIGHT VERTICAL FRAME LINES)--')
34650      CALL DPWRST('XXX','BUG ')
34651      WRITE(ICOUT,1606)
34652 1606 FORMAT('      MAJOR Y2TIC MARK NUMBER 3')
34653      CALL DPWRST('XXX','BUG ')
34654      WRITE(ICOUT,1607)
34655 1607 FORMAT('      MAJOR Y2TICS NUMBER 3')
34656      CALL DPWRST('XXX','BUG ')
34657      IERROR='YES'
34658      GOTO9000
34659C
34660 1610 CONTINUE
34661      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
34662      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
34663      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
34664      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
34665      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1650
34666      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
34667      IERROR='YES'
34668      GOTO9000
34669C
34670 1650 CONTINUE
34671      IHHOLD='FLOA'
34672      IHOLD=(-1)
34673      GOTO1680
34674C
34675 1660 CONTINUE
34676      IHHOLD='FIXE'
34677      IHOLD=IARG(NUMARG)
34678      GOTO1680
34679C
34680 1680 CONTINUE
34681      IFOUND='YES'
34682      IY2JSW=IHHOLD
34683      NMJY2T=IHOLD
34684C
34685      IF(IFEEDB.EQ.'OFF')GOTO1689
34686      WRITE(ICOUT,999)
34687      CALL DPWRST('XXX','BUG ')
34688      WRITE(ICOUT,1681)
34689 1681 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
34690      CALL DPWRST('XXX','BUG ')
34691      WRITE(ICOUT,1682)
34692 1682 FORMAT('(FOR THE RIGHT VERTICAL FRAME LINE')
34693      CALL DPWRST('XXX','BUG ')
34694      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1683)IHOLD
34695 1683 FORMAT('HAS JUST BEEN SET TO ',I8)
34696      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
34697      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1684)
34698 1684 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
34699      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
34700 1689 CONTINUE
34701      GOTO9000
34702C
34703C               ********************************************************
34704C               **  STEP 7--
34705C               **  TREAT THE CASE WHEN
34706C               **  BOTH HORIZONTAL AND VERTICAL    MAJOR TICS ARE TO BE
34707C               ********************************************************
34708C
34709 1700 CONTINUE
34710      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1710
34711      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1710
34712      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1710
34713      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1710
34714C
34715      WRITE(ICOUT,999)
34716      CALL DPWRST('XXX','BUG ')
34717      WRITE(ICOUT,1701)
34718 1701 FORMAT('***** ERROR IN DPMATN--')
34719      CALL DPWRST('XXX','BUG ')
34720      WRITE(ICOUT,1702)
34721 1702 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
34722      CALL DPWRST('XXX','BUG ')
34723      WRITE(ICOUT,1703)
34724 1703 FORMAT('      NUMBER OF MAJOR TIC MARKS.')
34725      CALL DPWRST('XXX','BUG ')
34726      WRITE(ICOUT,1704)
34727 1704 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
34728      CALL DPWRST('XXX','BUG ')
34729      WRITE(ICOUT,1705)
34730 1705 FORMAT('      (ON ALL 4 FRAME LINES)--')
34731      CALL DPWRST('XXX','BUG ')
34732      WRITE(ICOUT,1706)
34733 1706 FORMAT('      MAJOR TIC MARK NUMBER 3')
34734      CALL DPWRST('XXX','BUG ')
34735      WRITE(ICOUT,1707)
34736 1707 FORMAT('      MAJOR TICS NUMBER 3')
34737      CALL DPWRST('XXX','BUG ')
34738      IERROR='YES'
34739      GOTO9000
34740C
34741 1710 CONTINUE
34742      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
34743      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
34744      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
34745      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
34746      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1750
34747      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
34748      IERROR='YES'
34749      GOTO9000
34750C
34751 1750 CONTINUE
34752      IHHOLD='FLOA'
34753      IHOLD=(-1)
34754      GOTO1780
34755C
34756 1760 CONTINUE
34757      IHHOLD='FIXE'
34758      IHOLD=IARG(NUMARG)
34759      GOTO1780
34760C
34761 1780 CONTINUE
34762      IFOUND='YES'
34763      IX1JSW=IHHOLD
34764      IX2JSW=IHHOLD
34765      IY1JSW=IHHOLD
34766      IY2JSW=IHHOLD
34767      NMJX1T=IHOLD
34768      NMJX2T=IHOLD
34769      NMJY1T=IHOLD
34770      NMJY2T=IHOLD
34771C
34772      IF(IFEEDB.EQ.'OFF')GOTO1789
34773      WRITE(ICOUT,999)
34774      CALL DPWRST('XXX','BUG ')
34775      WRITE(ICOUT,1781)
34776 1781 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
34777      CALL DPWRST('XXX','BUG ')
34778      WRITE(ICOUT,1782)
34779 1782 FORMAT('(FOR EACH FRAME LINES')
34780      CALL DPWRST('XXX','BUG ')
34781      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1783)IHOLD
34782 1783 FORMAT('HAS JUST BEEN SET TO ',I8)
34783      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
34784      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1784)
34785 1784 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
34786      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
34787 1789 CONTINUE
34788      GOTO9000
34789C
34790C               *****************
34791C               **  STEP 90--  **
34792C               **  EXIT       **
34793C               *****************
34794C
34795 9000 CONTINUE
34796      RETURN
34797      END
34798      SUBROUTINE DPMAX(ICOM,IHARG,IARGT,ARG,NUMARG,
34799     1                 GX1MAX,GY1MAX,GX2MAX,GY2MAX,
34800     1                 IX1MAX,IY1MAX,IX2MAX,IY2MAX,
34801     1                 IFOUND,IERROR)
34802C
34803C     PURPOSE--DEFINE AXIS MAXIMA
34804C              (HORIZONTAL AXIS OR VERTICAL AXIS OR BOTH)
34805C              WHICH IN TURN WILL DEFINE THE UPPER EXTREME
34806C              WHICH WILL APPEAR ON THE PLOT.
34807C              THE MAXIMA WILL BE PLACED IN THE 4 VARIABLES
34808C              GX1MAX,GY1MAX,
34809C              GX2MAX,GY2MAX,
34810C              THE STATUS (FIXED OR FLOAT) WILL BE PLACED
34811C              IN THE 4 VARIABLES
34812C              IX1MAX,IY1MAX,
34813C              IX2MAX,IY2MAX,
34814C     INPUT  ARGUMENTS--ICOM  (A  HOLLERITH VARIABLE)
34815C                     --IHARG  (A  HOLLERITH VECTOR)
34816C                     --IARGT  (A  HOLLERITH VECTOR)
34817C                     --ARG    (A  FLOATING POINT VECTOR)
34818C                     --NUMARG
34819C     OUTPUT ARGUMENTS--
34820C                     --GX1MAX = MAXIMUM FOR BOTTOM HORIZONTAL AXIS
34821C                     --GY1MAX = MAXIMUM FOR LEFT   VERTICAL   AXIS
34822C                     --GX2MAX = MAXIMUM FOR TOP    HORIZONTAL AXIS
34823C                     --GX2MAX = MAXIMUM FOR RIGHT  VERTICAL   AXIS
34824C                     --IX1MAX = STATUS FOR MAXIMUM FOR BOTTOM HORIZONTAL AXIS
34825C                     --IY1MAX = STATUS FOR MAXIMUM FOR LEFT   VERTICAL   AXIS
34826C                     --IX2MAX = STATUS FOR MAXIMUM FOR TOP    HORIZONTAL AXIS
34827C                     --IX2MAX = STATUS FOR MAXIMUM FOR RIGHT  VERTICAL   AXIS
34828C                     --IFOUND ('YES' OR 'NO' )
34829C                     --IERROR ('YES' OR 'NO' )
34830C     WRITTEN BY--JAMES J. FILLIBEN
34831C                 STATISTICAL ENGINEERING DIVISION
34832C                 INFORMATION TECHNOLOGY LABORATORY
34833C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
34834C                 Gaithersburg, MD 20899-8980
34835C                 PHONE--301-975-2855
34836C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
34837C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
34838C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
34839C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
34840C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
34841C     LANGUAGE--ANSI FORTRAN (1977)
34842C     VERSION NUMBER--82/7
34843C     ORIGINAL VERSION--NOVEMBER  1978.
34844C     UPDATED         --SEPTEMBER 1980.
34845C     UPDATED         --OCTOBER   1981.
34846C     UPDATED         --NOVEMBER  1981.
34847C     UPDATED         --MAY       1982.
34848C     UPDATED         --FEBRUARY 1992.  FIX YMAX WITH NO ARG BOMB
34849C
34850C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
34851C
34852      CHARACTER*4 ICOM
34853      CHARACTER*4 IHARG
34854      CHARACTER*4 IARGT
34855C
34856      CHARACTER*4 IX1MAX
34857      CHARACTER*4 IY1MAX
34858      CHARACTER*4 IX2MAX
34859      CHARACTER*4 IY2MAX
34860C
34861      CHARACTER*4 IFOUND
34862      CHARACTER*4 IERROR
34863C
34864C---------------------------------------------------------------------
34865C
34866      DIMENSION IHARG(*)
34867      DIMENSION IARGT(*)
34868      DIMENSION ARG(*)
34869C
34870C---------------------------------------------------------------------
34871C
34872      INCLUDE 'DPCOP2.INC'
34873C
34874C-----START POINT-----------------------------------------------------
34875C
34876      IFOUND='NO'
34877      IERROR='NO'
34878C
34879CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1992
34880CCCCC IF(IHARG(NUMARG).EQ.'?')GOTO8100
34881      IF(NUMARG.LE.0)GOTO1090
34882      IF(IHARG(NUMARG).EQ.'?')GOTO8100
34883 1090 CONTINUE
34884C
34885C               *****************************************************
34886C               **  TREAT THE CASE WHEN                           **
34887C               **  BOTH HORIZONTAL AXIS MAXIMA ARE TO BE FIXED    **
34888C               *****************************************************
34889C
34890      IF(ICOM.EQ.'XMAX')GOTO1100
34891      GOTO1199
34892C
34893 1100 CONTINUE
34894      IF(NUMARG.LE.0)GOTO1110
34895      IF(IARGT(1).EQ.'NUMB')GOTO1120
34896      GOTO1110
34897C
34898 1110 CONTINUE
34899      IFOUND='YES'
34900      GX1MAX=CPUMAX
34901      GX2MAX=CPUMAX
34902      IX1MAX='FLOA'
34903      IX2MAX='FLOA'
34904C
34905      IF(IFEEDB.EQ.'OFF')GOTO1119
34906      WRITE(ICOUT,999)
34907  999 FORMAT(1X)
34908      CALL DPWRST('XXX','BUG ')
34909      WRITE(ICOUT,1115)
34910 1115 FORMAT('THE X AXIS MAXIMUM (FOR BOTH HORIZONTAL')
34911      CALL DPWRST('XXX','BUG ')
34912      WRITE(ICOUT,1116)
34913 1116 FORMAT('FRAME LINES) HAS JUST BEEN SET')
34914      CALL DPWRST('XXX','BUG ')
34915      WRITE(ICOUT,1117)
34916 1117 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
34917      CALL DPWRST('XXX','BUG ')
34918 1119 CONTINUE
34919      GOTO9000
34920C
34921 1120 CONTINUE
34922      IFOUND='YES'
34923      A1=ARG(1)
34924      GX1MAX=A1
34925      GX2MAX=A1
34926      IX1MAX='FIXE'
34927      IX2MAX='FIXE'
34928C
34929      IF(IFEEDB.EQ.'OFF')GOTO1129
34930      WRITE(ICOUT,999)
34931      CALL DPWRST('XXX','BUG ')
34932      WRITE(ICOUT,1125)
34933 1125 FORMAT('THE X AXIS MAXIMUM (FOR BOTH HORIZONTAL')
34934      CALL DPWRST('XXX','BUG ')
34935      WRITE(ICOUT,1126)GX1MAX
34936 1126 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
34937     1E15.7)
34938      CALL DPWRST('XXX','BUG ')
34939 1129 CONTINUE
34940      GOTO9000
34941C
34942 1199 CONTINUE
34943C
34944C               *****************************************************
34945C               **  TREAT THE CASE WHEN THE                        **
34946C               **  BOTTOM HORIZONTAL AXIS MAXIMUM ARE TO BE FIXED  **
34947C               *****************************************************
34948C
34949      IF(ICOM.EQ.'X1MA')GOTO1200
34950      GOTO1299
34951C
34952 1200 CONTINUE
34953      IF(NUMARG.LE.0)GOTO1210
34954      IF(IARGT(1).EQ.'NUMB')GOTO1220
34955      GOTO1210
34956C
34957 1210 CONTINUE
34958      IFOUND='YES'
34959      GX1MAX=CPUMAX
34960      IX1MAX='FLOA'
34961C
34962      IF(IFEEDB.EQ.'OFF')GOTO1219
34963      WRITE(ICOUT,999)
34964      CALL DPWRST('XXX','BUG ')
34965      WRITE(ICOUT,1215)
34966 1215 FORMAT('THE X AXIS MAXIMUM (FOR THE BOTTOM HORIZONTAL')
34967      CALL DPWRST('XXX','BUG ')
34968      WRITE(ICOUT,1216)
34969 1216 FORMAT('FRAME LINE) HAS JUST BEEN SET')
34970      CALL DPWRST('XXX','BUG ')
34971      WRITE(ICOUT,1217)
34972 1217 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
34973      CALL DPWRST('XXX','BUG ')
34974 1219 CONTINUE
34975      GOTO9000
34976C
34977 1220 CONTINUE
34978      IFOUND='YES'
34979      A1=ARG(1)
34980      GX1MAX=A1
34981      IX1MAX='FIXE'
34982C
34983      IF(IFEEDB.EQ.'OFF')GOTO1229
34984      WRITE(ICOUT,999)
34985      CALL DPWRST('XXX','BUG ')
34986      WRITE(ICOUT,1225)
34987 1225 FORMAT('THE X AXIS MAXIMUM (FOR THE BOTTOM HORIZONTAL')
34988      CALL DPWRST('XXX','BUG ')
34989      WRITE(ICOUT,1226)GX1MAX
34990 1226 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
34991     1E15.7)
34992      CALL DPWRST('XXX','BUG ')
34993 1229 CONTINUE
34994      GOTO9000
34995C
34996 1299 CONTINUE
34997C
34998C               *****************************************************
34999C               **  TREAT THE CASE WHEN THE                        **
35000C               **  TOP    HORIZONTAL AXIS MAXIMUM ARE TO BE FIXED  **
35001C               *****************************************************
35002C
35003      IF(ICOM.EQ.'X2MA')GOTO1300
35004      GOTO1399
35005C
35006 1300 CONTINUE
35007      IF(NUMARG.LE.0)GOTO1310
35008      IF(IARGT(1).EQ.'NUMB')GOTO1320
35009      GOTO1310
35010C
35011 1310 CONTINUE
35012      IFOUND='YES'
35013      GX2MAX=CPUMAX
35014      IX2MAX='FLOA'
35015C
35016      IF(IFEEDB.EQ.'OFF')GOTO1319
35017      WRITE(ICOUT,999)
35018      CALL DPWRST('XXX','BUG ')
35019      WRITE(ICOUT,1315)
35020 1315 FORMAT('THE X AXIS MAXIMUM (FOR THE TOP    HORIZONTAL')
35021      CALL DPWRST('XXX','BUG ')
35022      WRITE(ICOUT,1316)
35023 1316 FORMAT('FRAME LINE) HAS JUST BEEN SET')
35024      CALL DPWRST('XXX','BUG ')
35025      WRITE(ICOUT,1317)
35026 1317 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
35027      CALL DPWRST('XXX','BUG ')
35028 1319 CONTINUE
35029      GOTO9000
35030C
35031 1320 CONTINUE
35032      IFOUND='YES'
35033      A1=ARG(1)
35034      GX2MAX=A1
35035      IX2MAX='FIXE'
35036C
35037      IF(IFEEDB.EQ.'OFF')GOTO1329
35038      WRITE(ICOUT,999)
35039      CALL DPWRST('XXX','BUG ')
35040      WRITE(ICOUT,1325)
35041 1325 FORMAT('THE X AXIS MAXIMUM (FOR THE TOP    HORIZONTAL')
35042      CALL DPWRST('XXX','BUG ')
35043      WRITE(ICOUT,1326)GX2MAX
35044 1326 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
35045     1E15.7)
35046      CALL DPWRST('XXX','BUG ')
35047 1329 CONTINUE
35048      GOTO9000
35049C
35050 1399 CONTINUE
35051C
35052C               *****************************************************
35053C               **  TREAT THE CASE WHEN                           **
35054C               **  BOTH VERTICAL   AXIS MAXIMUM ARE TO BE FIXED    **
35055C               *****************************************************
35056C
35057      IF(ICOM.EQ.'YMAX')GOTO1400
35058      GOTO1499
35059C
35060 1400 CONTINUE
35061      IF(NUMARG.LE.0)GOTO1410
35062      IF(IARGT(1).EQ.'NUMB')GOTO1420
35063      GOTO1410
35064C
35065 1410 CONTINUE
35066      IFOUND='YES'
35067      GY1MAX=CPUMAX
35068      GY2MAX=CPUMAX
35069      IY1MAX='FLOA'
35070      IY2MAX='FLOA'
35071C
35072      IF(IFEEDB.EQ.'OFF')GOTO1419
35073      WRITE(ICOUT,999)
35074      CALL DPWRST('XXX','BUG ')
35075      WRITE(ICOUT,1415)
35076 1415 FORMAT('THE Y AXIS MAXIMUM (FOR BOTH VERTICAL')
35077      CALL DPWRST('XXX','BUG ')
35078      WRITE(ICOUT,1416)
35079 1416 FORMAT('FRAME LINES) HAS JUST BEEN SET')
35080      CALL DPWRST('XXX','BUG ')
35081      WRITE(ICOUT,1417)
35082 1417 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
35083      CALL DPWRST('XXX','BUG ')
35084 1419 CONTINUE
35085      GOTO9000
35086C
35087 1420 CONTINUE
35088      IFOUND='YES'
35089      A1=ARG(1)
35090      GY1MAX=A1
35091      GY2MAX=A1
35092      IY1MAX='FIXE'
35093      IY2MAX='FIXE'
35094C
35095      IF(IFEEDB.EQ.'OFF')GOTO1429
35096      WRITE(ICOUT,999)
35097      CALL DPWRST('XXX','BUG ')
35098      WRITE(ICOUT,1425)
35099 1425 FORMAT('THE Y AXIS MAXIMUM (FOR BOTH VERTICAL')
35100      CALL DPWRST('XXX','BUG ')
35101      WRITE(ICOUT,1426)GY1MAX
35102 1426 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
35103     1E15.7)
35104      CALL DPWRST('XXX','BUG ')
35105 1429 CONTINUE
35106      GOTO9000
35107C
35108 1499 CONTINUE
35109C
35110C               *****************************************************
35111C               **  TREAT THE CASE WHEN THE                        **
35112C               **  LEFT   VERTICAL   AXIS MAXIMUM ARE TO BE FIXED  **
35113C               *****************************************************
35114C
35115      IF(ICOM.EQ.'Y1MA')GOTO1500
35116      GOTO1599
35117C
35118 1500 CONTINUE
35119      IF(NUMARG.LE.0)GOTO1510
35120      IF(IARGT(1).EQ.'NUMB')GOTO1520
35121      GOTO1510
35122C
35123 1510 CONTINUE
35124      IFOUND='YES'
35125      GY1MAX=CPUMAX
35126      IY1MAX='FLOA'
35127C
35128      IF(IFEEDB.EQ.'OFF')GOTO1519
35129      WRITE(ICOUT,999)
35130      CALL DPWRST('XXX','BUG ')
35131      WRITE(ICOUT,1515)
35132 1515 FORMAT('THE Y AXIS MAXIMUM (FOR THE LEFT   VERTICAL  ')
35133      CALL DPWRST('XXX','BUG ')
35134      WRITE(ICOUT,1516)
35135 1516 FORMAT('FRAME LINE) HAS JUST BEEN SET')
35136      CALL DPWRST('XXX','BUG ')
35137      WRITE(ICOUT,1517)
35138 1517 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
35139      CALL DPWRST('XXX','BUG ')
35140 1519 CONTINUE
35141      GOTO9000
35142C
35143 1520 CONTINUE
35144      IFOUND='YES'
35145      A1=ARG(1)
35146      GY1MAX=A1
35147      IY1MAX='FIXE'
35148C
35149      IF(IFEEDB.EQ.'OFF')GOTO1529
35150      WRITE(ICOUT,999)
35151      CALL DPWRST('XXX','BUG ')
35152      WRITE(ICOUT,1525)
35153 1525 FORMAT('THE Y AXIS MAXIMUM (FOR THE LEFT   VERTICAL  ')
35154      CALL DPWRST('XXX','BUG ')
35155      WRITE(ICOUT,1526)GY1MAX
35156 1526 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
35157     1E15.7)
35158      CALL DPWRST('XXX','BUG ')
35159 1529 CONTINUE
35160      GOTO9000
35161C
35162 1599 CONTINUE
35163C
35164C               *****************************************************
35165C               **  TREAT THE CASE WHEN THE                        **
35166C               **  RIGHT  VERTICAL   AXIS MAXIMUM ARE TO BE FIXED  **
35167C               *****************************************************
35168C
35169      IF(ICOM.EQ.'Y2MA')GOTO1600
35170      GOTO1699
35171C
35172 1600 CONTINUE
35173      IF(NUMARG.LE.0)GOTO1610
35174      IF(IARGT(1).EQ.'NUMB')GOTO1620
35175      GOTO1610
35176C
35177 1610 CONTINUE
35178      IFOUND='YES'
35179      GY2MAX=CPUMAX
35180      IY2MAX='FLOA'
35181C
35182      IF(IFEEDB.EQ.'OFF')GOTO1619
35183      WRITE(ICOUT,999)
35184      CALL DPWRST('XXX','BUG ')
35185      WRITE(ICOUT,1615)
35186 1615 FORMAT('THE Y AXIS MAXIMUM (FOR THE RIGHT  VERTICAL  ')
35187      CALL DPWRST('XXX','BUG ')
35188      WRITE(ICOUT,1616)
35189 1616 FORMAT('FRAME LINE) HAS JUST BEEN SET')
35190      CALL DPWRST('XXX','BUG ')
35191      WRITE(ICOUT,1617)
35192 1617 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
35193      CALL DPWRST('XXX','BUG ')
35194 1619 CONTINUE
35195      GOTO9000
35196C
35197 1620 CONTINUE
35198      IFOUND='YES'
35199      A1=ARG(1)
35200      GY2MAX=A1
35201      IY2MAX='FIXE'
35202C
35203      IF(IFEEDB.EQ.'OFF')GOTO1629
35204      WRITE(ICOUT,999)
35205      CALL DPWRST('XXX','BUG ')
35206      WRITE(ICOUT,1625)
35207 1625 FORMAT('THE Y AXIS MAXIMUM (FOR THE RIGHT  VERTICAL  ')
35208      CALL DPWRST('XXX','BUG ')
35209      WRITE(ICOUT,1626)GY2MAX
35210 1626 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
35211     1E15.7)
35212      CALL DPWRST('XXX','BUG ')
35213 1629 CONTINUE
35214      GOTO9000
35215C
35216 1699 CONTINUE
35217C
35218C               ******************************************
35219C               **  TREAT THE CASE WHEN                 **
35220C               **  BOTH AXIS MAXIMUM ARE TO BE FIXED    **
35221C               ******************************************
35222C
35223C
35224      IF(ICOM.EQ.'XYMA')GOTO1700
35225      IF(ICOM.EQ.'YXMA')GOTO1700
35226      IF(ICOM.EQ.'MAXI')GOTO1700
35227      IF(ICOM.EQ.'MAX ')GOTO1700
35228      GOTO1799
35229C
35230 1700 CONTINUE
35231      IF(NUMARG.LE.0)GOTO1710
35232      IF(IARGT(1).EQ.'NUMB')GOTO1720
35233      GOTO1710
35234C
35235 1710 CONTINUE
35236      IFOUND='YES'
35237      GX1MAX=CPUMAX
35238      GY1MAX=CPUMAX
35239      GX2MAX=CPUMAX
35240      GY2MAX=CPUMAX
35241      IX1MAX='FLOA'
35242      IY1MAX='FLOA'
35243      IX2MAX='FLOA'
35244      IY2MAX='FLOA'
35245C
35246      IF(IFEEDB.EQ.'OFF')GOTO1719
35247      WRITE(ICOUT,999)
35248      CALL DPWRST('XXX','BUG ')
35249      WRITE(ICOUT,1715)
35250 1715 FORMAT('THE X AXIS MAXIMUM (FOR ALL 4')
35251      CALL DPWRST('XXX','BUG ')
35252      WRITE(ICOUT,1716)
35253 1716 FORMAT('FRAME LINES) HAS JUST BEEN SET')
35254      CALL DPWRST('XXX','BUG ')
35255      WRITE(ICOUT,1717)
35256 1717 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
35257      CALL DPWRST('XXX','BUG ')
35258 1719 CONTINUE
35259      GOTO9000
35260C
35261 1720 CONTINUE
35262      IFOUND='YES'
35263      A1=ARG(1)
35264      GX1MAX=A1
35265      GY1MAX=A1
35266      GX2MAX=A1
35267      GY2MAX=A1
35268      IX1MAX='FIXE'
35269      IY1MAX='FIXE'
35270      IX2MAX='FIXE'
35271      IY2MAX='FIXE'
35272C
35273      IF(IFEEDB.EQ.'OFF')GOTO1729
35274      WRITE(ICOUT,999)
35275      CALL DPWRST('XXX','BUG ')
35276      WRITE(ICOUT,1725)
35277 1725 FORMAT('THE AXIS MAXIMUM (FOR ALL 4')
35278      CALL DPWRST('XXX','BUG ')
35279      WRITE(ICOUT,1726)GX1MAX
35280 1726 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
35281     1E15.7)
35282      CALL DPWRST('XXX','BUG ')
35283 1729 CONTINUE
35284      GOTO9000
35285C
35286 1799 CONTINUE
35287      GOTO9000
35288C
35289C               ********************************************
35290C               **  STEP 81--                             **
35291C               **  TREAT THE    ?    CASE--              **
35292C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
35293C               ********************************************
35294C
35295 8100 CONTINUE
35296      IFOUND='YES'
35297      WRITE(ICOUT,999)
35298      CALL DPWRST('XXX','BUG ')
35299      WRITE(ICOUT,8111)
35300 8111 FORMAT('THE CURRENT AXIS MAXIMA ARE ')
35301      CALL DPWRST('XXX','BUG ')
35302      IF(IX1MAX.NE.'FLOA')WRITE(ICOUT,8112)GX1MAX
35303 8112 FORMAT('            --X1 (BOTTOM HORIZONTAL) = ',E15.7)
35304      IF(IX1MAX.NE.'FLOA')CALL DPWRST('XXX','BUG ')
35305      IF(IX1MAX.EQ.'FLOA')WRITE(ICOUT,8113)
35306 8113 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
35307      IF(IX1MAX.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
35308      IF(IX2MAX.NE.'FLOA')WRITE(ICOUT,8114)GX2MAX
35309 8114 FORMAT('            --X2 (TOP    HORIZONTAL) = ',E15.7)
35310      IF(IX2MAX.NE.'FLOA')CALL DPWRST('XXX','BUG ')
35311      IF(IX2MAX.EQ.'FLOA')WRITE(ICOUT,8115)
35312 8115 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
35313      IF(IX2MAX.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
35314      IF(IY1MAX.NE.'FLOA')WRITE(ICOUT,8116)GY1MAX
35315 8116 FORMAT('            --Y1 (LEFT   VERTICAL  ) = ',E15.7)
35316      IF(IY1MAX.NE.'FLOA')CALL DPWRST('XXX','BUG ')
35317      IF(IY1MAX.EQ.'FLOA')WRITE(ICOUT,8117)
35318 8117 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
35319      IF(IY1MAX.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
35320      IF(IY2MAX.NE.'FLOA')WRITE(ICOUT,8118)GY2MAX
35321 8118 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = ',E15.7)
35322      IF(IY2MAX.NE.'FLOA')CALL DPWRST('XXX','BUG ')
35323      IF(IY2MAX.EQ.'FLOA')WRITE(ICOUT,8119)
35324 8119 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = FLOAT & NEAT')
35325      IF(IY2MAX.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
35326      WRITE(ICOUT,999)
35327      CALL DPWRST('XXX','BUG ')
35328      WRITE(ICOUT,8121)
35329 8121 FORMAT('THE DEFAULT AXIS MAXIMA ARE ')
35330      CALL DPWRST('XXX','BUG ')
35331      WRITE(ICOUT,8122)
35332 8122 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
35333      CALL DPWRST('XXX','BUG ')
35334      WRITE(ICOUT,8123)
35335 8123 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
35336      CALL DPWRST('XXX','BUG ')
35337      WRITE(ICOUT,8124)
35338 8124 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
35339      CALL DPWRST('XXX','BUG ')
35340      WRITE(ICOUT,8125)
35341 8125 FORMAT('            --Y2 (BOTTOM VERTICAL  ) = FLOAT & NEAT')
35342      CALL DPWRST('XXX','BUG ')
35343      GOTO9000
35344C
35345C               ******************
35346C               **   STEP 90--  **
35347C               **   EXIT       **
35348C               ******************
35349C
35350 9000 CONTINUE
35351      RETURN
35352      END
35353      SUBROUTINE DPMB10(Y,N,
35354     1                  XTEMP,XTEMP2,XTEMP3,DTEMP1,MAXNXT,
35355     1                  SHAPSV,SCALSV,
35356     1                  SHAPML,SCALML,
35357     1                  ICAPSW,ICAPTY,IFORSW,
35358     1                  ISUBRO,IBUGA3,IERROR)
35359C
35360C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
35361C              FOR THE BURR TYPE 10 DISTRIBUTION.
35362C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTION TO
35363C              THE FOLLOWING SIMULTANEOUS NONLINEAR EQUATIONS:
35364C              EQUATIONS.
35365C
35366C              (N/R) + SUM[i=1 to N][LN(1 - EXP(-(S*X(i))**2) = 0
35367C
35368C              C(2*N/S) - 2*S*SUM[i=1 to n][X(i)**2 +
35369C              2*S*(R-1)*SUM[i=1 tp n][X(i)^2*EXP(-(S*X(i))**2)/
35370C              1 - EXP(-(S*X(i))**2)) = 0
35371C
35372C              WITH R AND S DENOTING THE SHAPE PARAMETER R AND
35373C              SCALE PARAMETER S RESPECTIVELY.
35374C
35375C     EXAMPLE--BURR TYPE 10 MAXIMUM LIKELIHOOD Y
35376C     REFERENCES--JOHNSON, KOTZ, AND BALAKRISHNAN, "CONTINUOUS
35377C                 UNIVARIATE DISTRIBUTIONS--VOLUME I", SECOND EDITION,
35378C                 JOHN WILEY, 1994, PP. 53-54.
35379C               --LUC DEVROYE, "NON-UNIFORM RANDOM VARIATE
35380C                 GENERATION", 1986, SPRINGER-VERLANG, PP. 476-477.
35381C                 (NOTE: THERE IS A TYPO IN THE DEVROYE CDF EQUATION,
35382C                 CORRECT FORM TAKEN FROM JOHNSON AND KOTZ).
35383C               --KUNDU AND RAQAB, "GENERALIZED RAYLEIGH DISTRIBUTION:
35384C                 METHODS OF ESTIMATION", COMPUTATIONAL STATISTICS
35385C                 AND DATA ANALYSIS, 49, PP. 187-200.
35386C     WRITTEN BY--ALAN HECKERT
35387C                 STATISTICAL ENGINEERING DIVISION
35388C                 INFORMATION TECHNOLOGY LABORATORY
35389C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
35390C                 GAITHERSBUG, MD 20899-8980
35391C                 PHONE--301-975-2899
35392C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
35393C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
35394C     LANGUAGE--ANSI FORTRAN (1977)
35395C     VERSION NUMBER--2007/10
35396C     ORIGINAL VERSION--OCTOBER   2007.
35397C     UPDATED         --FEBRUARY  2010. EXTRACT POINT ESTIMATES TO
35398C                                       B10ML1 TO MAKE IT CALLABLE
35399C                                       FROM MULTIPLE ROUTINES
35400C     UPDATED         --FEBRUARY  2010. PRINT TABLES WITH DPDTA1
35401C     UPDATED         --APRIL     2011. ADD STANDARD ERRORS,
35402C                                       CONFIDENCE LIMITS
35403C
35404C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
35405C
35406      CHARACTER*4 ICAPSW
35407      CHARACTER*4 ICAPTY
35408      CHARACTER*4 IFORSW
35409      CHARACTER*4 ISUBRO
35410      CHARACTER*4 IBUGA3
35411      CHARACTER*4 IERROR
35412C
35413      CHARACTER*4 ILIKFL
35414      CHARACTER*4 ICASPL
35415      CHARACTER*4 ISUBN1
35416      CHARACTER*4 ISUBN2
35417      CHARACTER*4 ISTEPN
35418C
35419C---------------------------------------------------------------------
35420C
35421      DIMENSION Y(*)
35422      DIMENSION XTEMP(*)
35423      DIMENSION XTEMP2(*)
35424      DIMENSION XTEMP3(*)
35425      DIMENSION QP(1)
35426      DOUBLE PRECISION DTEMP1(*)
35427C
35428      DOUBLE PRECISION DALPH
35429      DOUBLE PRECISION DLAMB
35430      DOUBLE PRECISION DI11
35431      DOUBLE PRECISION DI12
35432      DOUBLE PRECISION DI22
35433      DOUBLE PRECISION DTERM1
35434      DOUBLE PRECISION DTERM2
35435      DOUBLE PRECISION DTERM3
35436      DOUBLE PRECISION DTERM4
35437      DOUBLE PRECISION DTERM5
35438      DOUBLE PRECISION DALPSE
35439      DOUBLE PRECISION DLAMSE
35440      DOUBLE PRECISION DPSI
35441      DOUBLE PRECISION DPSIAL
35442      DOUBLE PRECISION DPSIA2
35443      DOUBLE PRECISION DPSI1
35444      DOUBLE PRECISION DPSI2
35445      DOUBLE PRECISION DTRIAL
35446      DOUBLE PRECISION DTRI2
35447      DOUBLE PRECISION DANS(10)
35448C
35449      EXTERNAL DPSI
35450      EXTERNAL TRIGAM
35451C
35452      PARAMETER (NUMALP=6)
35453      DIMENSION ALPHA(NUMALP)
35454      DIMENSION ALOWSC(NUMALP)
35455      DIMENSION AUPPSC(NUMALP)
35456      DIMENSION ALOWGA(NUMALP)
35457      DIMENSION AUPPGA(NUMALP)
35458C
35459      INCLUDE 'DPCOST.INC'
35460C
35461      PARAMETER (MAXROW=30)
35462      PARAMETER(NUMCLI=3)
35463      PARAMETER(MAXLIN=2)
35464      CHARACTER*60 ITITLE
35465      CHARACTER*60 ITITLZ
35466      CHARACTER*40 ITEXT(MAXROW)
35467      REAL         AVALUE(MAXROW)
35468      INTEGER      NCTEXT(MAXROW)
35469      INTEGER      IDIGIT(MAXROW)
35470      INTEGER      NTOT(MAXROW)
35471      LOGICAL IFRST
35472      LOGICAL ILAST
35473C
35474C---------------------------------------------------------------------
35475C
35476      INCLUDE 'DPCOP2.INC'
35477C
35478C-----START POINT-----------------------------------------------------
35479C
35480      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
35481C
35482      ISUBN1='DPMB'
35483      ISUBN2='10  '
35484      IERROR='NO'
35485C
35486      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MB10')THEN
35487        WRITE(ICOUT,999)
35488  999   FORMAT(1X)
35489        CALL DPWRST('XXX','WRIT')
35490        WRITE(ICOUT,51)
35491   51   FORMAT('**** AT THE BEGINNING OF DPMB10--')
35492        CALL DPWRST('XXX','WRIT')
35493        WRITE(ICOUT,52)IBUGA3,ISUBRO,N
35494   52   FORMAT('IBUGA3,ISUBRO,N = ',A4,2X,A4,2X,I8)
35495        CALL DPWRST('XXX','WRIT')
35496        DO56I=1,MIN(N,100)
35497          WRITE(ICOUT,57)I,Y(I)
35498   57     FORMAT('I,Y(I) = ',I8,G15.7)
35499          CALL DPWRST('XXX','WRIT')
35500   56   CONTINUE
35501      ENDIF
35502C
35503C               ********************************************
35504C               **  STEP 21--                             **
35505C               **  CARRY OUT CALCULATIONS                **
35506C               **  FOR BURR TYPE 10 MLE ESTIMATION       **
35507C               ********************************************
35508C
35509      ISTEPN='21'
35510      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MB10')
35511     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35512C
35513      NMIN=3
35514      NPERC=0
35515      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
35516      IF(IERROR.EQ.'YES')GOTO9000
35517C
35518      CALL B10ML1(Y,N,MAXNXT,
35519     1            XTEMP,XTEMP2,XTEMP3,DTEMP1,
35520     1            XMEAN,XSD,XVAR,XMIN,XMAX,
35521     1            SCALSV,SHAPSV,SCALML,SHAPML,
35522     1            ISUBRO,IBUGA3,IERROR)
35523C
35524      ICASPL='BU10'
35525      ALOC=0.0
35526      CALL B10LI1(Y,N,ICASPL,ALOC,SCALML,SHAPML,
35527     1            ALIK,AIC,AICC,BIC,
35528     1            ISUBRO,IBUGA3,IERROR)
35529C
35530C     APRIL 2011: COMPUTE STANDARD ERRORS BASED ON FORMULAS IN
35531C                 KUNDU AND RAQAB ARTICLE.
35532C
35533C                 IN SOME CASES, I AM GETTING NEGATIVE VALUES FOR
35534C                 THE STANDARD ERRORS.  SO ONLY PRINT STANDARD
35535C                 ERRORS AND CONFIDENCE INTERVALS IF OBTAIN
35536C                 POSITIVE VALUES FOR BOTH.  EVEN WHEN BOTH
35537C                 ARE POSITIVE, THE STANDARD ERRORS DO NOT SEEM
35538C                 CREDIBLE.  SO FOR NOW, BYPASS THIS CODE.  LEAVE
35539C                 IN SO WE CAN RE-ACTIVATE IF WE FIND A CORRECTION
35540C                 FOR THE FORMULAS.
35541C
35542      IFLGSE=0
35543      GOTO199
35544C
35545      DALPH=DBLE(SHAPML)
35546      DLAMB=DBLE(1.0/SCALML)
35547      DPSIAL=DPSI(DALPH)
35548      DPSIA2=DPSI(DALPH+1.0D0)
35549      DPSI1=DPSI(1.0D0)
35550      DPSI2=DPSI(2.0D0)
35551C
35552      KODE=1
35553      NTEMP=1
35554      M=1
35555      NZ=0
35556      CALL DPSIFN(DALPH,NTEMP,KODE,M,DANS,NZ,IERR)
35557      DTRIAL=DANS(1)
35558      DTERM1=2.0D0
35559      CALL DPSIFN(DTERM1,NTEMP,KODE,M,DANS,NZ,IERR)
35560      DTRI2=DANS(1)
35561C
35562      DI11=-1.0D0/DALPH**2
35563C
35564      DTERM1=2.0D0/((DALPH-1.0D0)*DLAMB**2)
35565      DI12=DTERM1*(DPSIAL - DPSI1 - (DALPH-1.0D0)/DALPH)
35566C
35567      DTERM1=-2.0D0/DLAMB**2
35568      DTERM2=DTERM1*(DPSIA2 - DPSI1)
35569      DTERM3=(-2.0D0*DALPH/DLAMB**3)*(DPSI1 - DPSIAL)
35570      DTERM4=-2.0D0*(DALPH-1.0D0)/DLAMB**3
35571      DTERM5=(-4.0D0*DALPH/(DLAMB**3*(DALPH-2.0D0)))*
35572     1       ((DPSI2 - DPSIAL)**2 + DTRI2 - DTRIAL)
35573      DI22=DTERM1 + DTERM2 + DTERM3 + DTERM4 + DTERM5
35574C
35575      IFLGSE=1
35576      DALPSE=DBLE(CPUMIN)
35577      DLAMSE=DBLE(CPUMIN)
35578      DTERM1=DI22/(D11*DI22 - DI12**2)
35579      IF(DTERM1.GE.0.0D0)THEN
35580        DALPSE=DSQRT(DTERM1)
35581      ELSE
35582        IFLGSE=0
35583      ENDIF
35584      DTERM1=DI11/(DI11*DI22 - DI12**2)
35585      IF(DTERM1.GE.0.0D0)THEN
35586        DLAMSE=DSQRT(DTERM1)
35587      ELSE
35588        IFLGSE=0
35589      ENDIF
35590C
35591C     CONFIDENCE INTERVALS FOR PARAMETERS BASED ON NORMAL APPROXIMATION
35592C
35593  199 CONTINUE
35594C
35595      IF(IFLGSE.EQ.1)THEN
35596        DO110I=1,NUMALP
35597          ALP=ALPHA(I)
35598          P=1.0-(ALP/2.0)
35599          CALL NORPPF(P,PPF)
35600          ALOWSC(I)=SCALML - PPF*REAL(DLAMSE)
35601          AUPPSC(I)=SCALML + PPF*REAL(DLAMSE)
35602          ALOWGA(I)=SHAPML - PPF*REAL(DALPSE)
35603          AUPPGA(I)=SHAPML + PPF*REAL(DALPSE)
35604  110   CONTINUE
35605      ENDIF
35606C
35607      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MB10')THEN
35608        WRITE(ICOUT,999)
35609        CALL DPWRST('XXX','WRIT')
35610        WRITE(ICOUT,101)DALPH,DLAMB,DPSIAL,DPSIA2
35611  101   FORMAT('DALPH,DLAMB,DPSIAL,DPSIA2 =',4G15.7)
35612        CALL DPWRST('XXX','WRIT')
35613        WRITE(ICOUT,102)DPSI1,DPSI2,DTRIAL,DTRI2
35614  102   FORMAT('DPSI1,DPSI2,DTRIAL,DTRI2 =',4G15.7)
35615        CALL DPWRST('XXX','WRIT')
35616        WRITE(ICOUT,103)DI11,DI12,DI22,DALPSE,DLAMSE
35617  103   FORMAT('DI11,DI12,DI22,DALPSE,DLAMSE = ',5G15.7)
35618        CALL DPWRST('XXX','WRIT')
35619      ENDIF
35620C
35621C               ***********************************************
35622C               **   STEP 42--                               **
35623C               **   WRITE OUT EVERYTHING                    **
35624C               **   FOR BURR TYPE 10 MLE                    **
35625C               **   ESTIMATION                              **
35626C               ***********************************************
35627C
35628      ISTEPN='42'
35629      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MB10')
35630     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35631C
35632C     PRINT SUMMARY STATISTICS TABLE
35633C
35634      IF(IPRINT.EQ.'OFF')GOTO9000
35635C
35636      NUMDIG=7
35637      IF(IFORSW.EQ.'1')NUMDIG=1
35638      IF(IFORSW.EQ.'2')NUMDIG=2
35639      IF(IFORSW.EQ.'3')NUMDIG=3
35640      IF(IFORSW.EQ.'4')NUMDIG=4
35641      IF(IFORSW.EQ.'5')NUMDIG=5
35642      IF(IFORSW.EQ.'6')NUMDIG=6
35643      IF(IFORSW.EQ.'7')NUMDIG=7
35644      IF(IFORSW.EQ.'8')NUMDIG=8
35645      IF(IFORSW.EQ.'9')NUMDIG=9
35646      IF(IFORSW.EQ.'0')NUMDIG=0
35647      IF(IFORSW.EQ.'E')NUMDIG=-2
35648      IF(IFORSW.EQ.'-2')NUMDIG=-2
35649      IF(IFORSW.EQ.'-3')NUMDIG=-3
35650      IF(IFORSW.EQ.'-4')NUMDIG=-4
35651      IF(IFORSW.EQ.'-5')NUMDIG=-5
35652      IF(IFORSW.EQ.'-6')NUMDIG=-6
35653      IF(IFORSW.EQ.'-7')NUMDIG=-7
35654      IF(IFORSW.EQ.'-8')NUMDIG=-8
35655      IF(IFORSW.EQ.'-9')NUMDIG=-9
35656C
35657      ITITLE='Two-Parameter Burr Type 10 Parameter Estimation:'
35658      NCTITL=48
35659      ITITLZ='Full Sample Case'
35660      NCTITZ=16
35661      ITEXT(1)='Summary Statistics:'
35662      NCTEXT(1)=19
35663      AVALUE(1)=0.0
35664      IDIGIT(1)=0
35665      ITEXT(2)='Number of Observations:'
35666      NCTEXT(2)=23
35667      AVALUE(2)=REAL(N)
35668      IDIGIT(2)=0
35669      ITEXT(3)='Sample Mean:'
35670      NCTEXT(3)=12
35671      AVALUE(3)=XMEAN
35672      IDIGIT(3)=NUMDIG
35673      ITEXT(4)='Sample Standard Deviation:'
35674      NCTEXT(4)=26
35675      AVALUE(4)=XSD
35676      IDIGIT(4)=NUMDIG
35677      ITEXT(5)='Sample Minimum:'
35678      NCTEXT(5)=15
35679      AVALUE(5)=XMIN
35680      IDIGIT(5)=NUMDIG
35681      ITEXT(6)='Sample Maximum:'
35682      NCTEXT(6)=15
35683      AVALUE(6)=XMAX
35684      IDIGIT(6)=NUMDIG
35685      NUMROW=6
35686      NTOT(1:NUMROW)=15
35687      NTOT(2)=8
35688C
35689      IFRST=.TRUE.
35690      ILAST=.FALSE.
35691      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
35692     1            NCTEXT,AVALUE,IDIGIT,
35693     1            NTOT,NUMROW,
35694     1            ICAPSW,ICAPTY,ILAST,IFRST,
35695     1            ISUBRO,IBUGA3,IERROR)
35696      IFRST=.FALSE.
35697      ITITLE=' '
35698      NCTITL=0
35699C
35700      ITEXT(1)='Maximum Likelihood:'
35701      NCTEXT(1)=19
35702      AVALUE(1)=0.0
35703      IDIGIT(1)=-1
35704      ITEXT(2)='Estimate of Shape (R):'
35705      NCTEXT(2)=22
35706      AVALUE(2)=SHAPML
35707      IDIGIT(2)=NUMDIG
35708      ITEXT(3)='Estimate of Scale:'
35709      NCTEXT(3)=18
35710      AVALUE(3)=SCALML
35711      IDIGIT(3)=NUMDIG
35712      ICNT=3
35713C
35714      IF(IFLGSE.EQ.1)THEN
35715        ICNT=ICNT+1
35716        ITEXT(ICNT)='Standard Error of Shape (R):'
35717        NCTEXT(ICNT)=28
35718        AVALUE(ICNT)=REAL(DALPSE)
35719        IDIGIT(ICNT)=NUMDIG
35720        ICNT=ICNT+1
35721        ITEXT(ICNT)='Standard Error of Scale:'
35722        NCTEXT(ICNT)=24
35723        AVALUE(ICNT)=REAL(DLAMSE)
35724        IDIGIT(ICNT)=NUMDIG
35725      ENDIF
35726C
35727      ICNT=ICNT+1
35728      ITEXT(ICNT)='Log-likelihood:'
35729      NCTEXT(ICNT)=15
35730      AVALUE(ICNT)=ALIK
35731      IDIGIT(ICNT)=-7
35732      ICNT=ICNT+1
35733      ITEXT(ICNT)='AIC:'
35734      NCTEXT(ICNT)=4
35735      AVALUE(ICNT)=AIC
35736      IDIGIT(ICNT)=-7
35737      ICNT=ICNT+1
35738      ITEXT(ICNT)='AICc:'
35739      NCTEXT(ICNT)=5
35740      AVALUE(ICNT)=AICC
35741      IDIGIT(ICNT)=-7
35742      ICNT=ICNT+1
35743      ITEXT(ICNT)='BIC:'
35744      NCTEXT(ICNT)=4
35745      AVALUE(ICNT)=BIC
35746      IDIGIT(ICNT)=-7
35747C
35748      NUMROW=ICNT
35749      NTOT(1:NUMROW)=15
35750CCCCC DO2320I=1,NUMROW
35751CCCCC   NTOT(I)=15
35752C2320 CONTINUE
35753C
35754      IFRST=.FALSE.
35755      ILAST=.FALSE.
35756      ITITLZ=' '
35757      NCTITZ=0
35758      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
35759     1            AVALUE,IDIGIT,
35760     1            NTOT,NUMROW,
35761     1            ICAPSW,ICAPTY,ILAST,IFRST,
35762     1            ISUBRO,IBUGA3,IERROR)
35763C
35764      IF(IFLGSE.EQ.1)THEN
35765        ILIKFL='OFF'
35766        CALL DPDTA8(ALOWSC,AUPPSC,ALOWSC,AUPPSC,
35767     1              ALOWGA,AUPPGA,ALOWGA,AUPPGA,ALPHA,NUMALP,
35768     1              ICAPSW,ICAPTY,NUMDIG,ILIKFL,
35769     1              ISUBRO,IBUGA3,IERROR)
35770      ENDIF
35771C
35772C               *****************
35773C               **  STEP 90--  **
35774C               **  EXIT       **
35775C               *****************
35776C
35777 9000 CONTINUE
35778      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MB10')THEN
35779        WRITE(ICOUT,999)
35780        CALL DPWRST('XXX','WRIT')
35781        WRITE(ICOUT,9011)
35782 9011   FORMAT('***** AT THE END       OF DPMB10--')
35783        CALL DPWRST('XXX','WRIT')
35784        WRITE(ICOUT,9012)N,IBUGA3,IERROR
35785 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
35786        CALL DPWRST('XXX','WRIT')
35787        WRITE(ICOUT,9015)N
35788 9015   FORMAT('N = ',I8)
35789        CALL DPWRST('XXX','WRIT')
35790      ENDIF
35791C
35792      RETURN
35793      END
35794      SUBROUTINE DPMBCO(IHARG,NUMARG,IDEMBC,MAXMAR,IMABCO,
35795     1                  IBUGP2,IFOUND,IERROR)
35796C
35797C     PURPOSE--DEFINE THE MARKER BORDER COLORS = THE COLORS
35798C              OF THE BORDER LINE AROUND THE MARKERS.
35799C              THESE ARE LOCATED IN THE VECTOR IMABCO(.).
35800C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
35801C                     --NUMARG
35802C                     --IDEMBC
35803C                     --MAXMAR
35804C                     --IBUGP2 ('ON' OR 'OFF' )
35805C     OUTPUT ARGUMENTS--IMABCO (A CHARACTER VECTOR)
35806C                     --IFOUND ('YES' OR 'NO' )
35807C                     --IERROR ('YES' OR 'NO' )
35808C     WRITTEN BY--JAMES J. FILLIBEN
35809C                 STATISTICAL ENGINEERING DIVISION
35810C                 INFORMATION TECHNOLOGY LABORATORY
35811C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
35812C                 Gaithersburg, MD 20899-8980
35813C                 PHONE--301-975-2855
35814C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
35815C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
35816C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
35817C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
35818C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
35819C     LANGUAGE--ANSI FORTRAN (1977)
35820C     VERSION NUMBER--82/7
35821C     ORIGINAL VERSION--DECEMBER  1983.
35822C
35823C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
35824C
35825      CHARACTER*4 IHARG
35826      CHARACTER*4 IDEMBC
35827      CHARACTER*4 IMABCO
35828C
35829      CHARACTER*4 IBUGP2
35830      CHARACTER*4 IFOUND
35831      CHARACTER*4 IERROR
35832C
35833      CHARACTER*4 IHOLD1
35834      CHARACTER*4 IHOLD2
35835C
35836      CHARACTER*4 ISUBN1
35837      CHARACTER*4 ISUBN2
35838      CHARACTER*4 ISTEPN
35839C
35840      DIMENSION IHARG(*)
35841      DIMENSION IMABCO(*)
35842C
35843C---------------------------------------------------------------------
35844C
35845      INCLUDE 'DPCOP2.INC'
35846C
35847C-----START POINT-----------------------------------------------------
35848C
35849      IFOUND='NO'
35850      IERROR='NO'
35851      ISUBN1='DPMB'
35852      ISUBN2='CO  '
35853C
35854      NUMMAR=0
35855      IHOLD1='-999'
35856      IHOLD2='-999'
35857C
35858      IF(IBUGP2.EQ.'OFF')GOTO90
35859      WRITE(ICOUT,999)
35860  999 FORMAT(1X)
35861      CALL DPWRST('XXX','BUG ')
35862      WRITE(ICOUT,51)
35863   51 FORMAT('***** AT THE BEGINNING OF DPMBCO--')
35864      CALL DPWRST('XXX','BUG ')
35865      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
35866   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
35867      CALL DPWRST('XXX','BUG ')
35868      WRITE(ICOUT,53)MAXMAR,NUMMAR
35869   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
35870      CALL DPWRST('XXX','BUG ')
35871      WRITE(ICOUT,54)IHOLD1,IHOLD2
35872   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
35873      CALL DPWRST('XXX','BUG ')
35874      WRITE(ICOUT,55)IDEMBC
35875   55 FORMAT('IDEMBC = ',A4)
35876      CALL DPWRST('XXX','BUG ')
35877      WRITE(ICOUT,60)NUMARG
35878   60 FORMAT('NUMARG = ',I8)
35879      CALL DPWRST('XXX','BUG ')
35880      DO65I=1,NUMARG
35881      WRITE(ICOUT,66)IHARG(I)
35882   66 FORMAT('IHARG(I) = ',A4)
35883      CALL DPWRST('XXX','BUG ')
35884   65 CONTINUE
35885      WRITE(ICOUT,70)IMABCO(1)
35886   70 FORMAT('IMABCO(1) = ',A4)
35887      CALL DPWRST('XXX','BUG ')
35888      DO75I=1,10
35889      WRITE(ICOUT,76)I,IMABCO(I)
35890   76 FORMAT('I,IMABCO(I) = ',I8,2X,A4)
35891      CALL DPWRST('XXX','BUG ')
35892   75 CONTINUE
35893   90 CONTINUE
35894C
35895C               **************************************
35896C               **  STEP 1--                        **
35897C               **  BRANCH TO THE APPROPRIATE CASE  **
35898C               **************************************
35899C
35900      ISTEPN='1'
35901      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35902C
35903      IF(NUMARG.LE.1)GOTO9000
35904      IF(NUMARG.EQ.2)GOTO1120
35905      IF(NUMARG.EQ.3)GOTO1130
35906      IF(NUMARG.EQ.4)GOTO1140
35907      GOTO1150
35908C
35909 1120 CONTINUE
35910      GOTO1200
35911C
35912 1130 CONTINUE
35913      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
35914      IF(IHARG(3).EQ.'ALL')GOTO1300
35915      GOTO1200
35916C
35917 1140 CONTINUE
35918      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
35919      IF(IHARG(3).EQ.'ALL')GOTO1300
35920      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
35921      IF(IHARG(4).EQ.'ALL')GOTO1300
35922      GOTO1200
35923C
35924 1150 CONTINUE
35925      GOTO1200
35926C
35927C               *************************************************
35928C               **  STEP 2--                                   **
35929C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
35930C               *************************************************
35931C
35932 1200 CONTINUE
35933      ISTEPN='2'
35934      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35935C
35936      IF(NUMARG.LE.2)GOTO1210
35937      GOTO1220
35938C
35939 1210 CONTINUE
35940      NUMMAR=1
35941      IMABCO(1)=IDEMBC
35942      GOTO1270
35943C
35944 1220 CONTINUE
35945      NUMMAR=NUMARG-2
35946      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
35947      DO1225I=1,NUMMAR
35948      J=I+2
35949      IHOLD1=IHARG(J)
35950      IHOLD2=IHOLD1
35951      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMBC
35952      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMBC
35953      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMBC
35954      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMBC
35955      IMABCO(I)=IHOLD2
35956 1225 CONTINUE
35957      GOTO1270
35958C
35959 1270 CONTINUE
35960      IF(IFEEDB.EQ.'OFF')GOTO1279
35961      WRITE(ICOUT,999)
35962      CALL DPWRST('XXX','BUG ')
35963      DO1278I=1,NUMMAR
35964      WRITE(ICOUT,1276)I,IMABCO(I)
35965 1276 FORMAT('THE COLOR OF MARKER BORDER ',I6,
35966     1' HAS JUST BEEN SET TO ',A4)
35967      CALL DPWRST('XXX','BUG ')
35968 1278 CONTINUE
35969 1279 CONTINUE
35970      IFOUND='YES'
35971      GOTO9000
35972C
35973C               **************************
35974C               **  STEP 3--            **
35975C               **  TREAT THE ALL CASE  **
35976C               **************************
35977C
35978 1300 CONTINUE
35979      ISTEPN='3'
35980      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
35981C
35982      NUMMAR=MAXMAR
35983      IHOLD2=IHOLD1
35984      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMBC
35985      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMBC
35986      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMBC
35987      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMBC
35988      DO1315I=1,NUMMAR
35989      IMABCO(I)=IHOLD2
35990 1315 CONTINUE
35991      GOTO1370
35992C
35993 1370 CONTINUE
35994      IF(IFEEDB.EQ.'OFF')GOTO1319
35995      WRITE(ICOUT,999)
35996      CALL DPWRST('XXX','BUG ')
35997      I=1
35998      WRITE(ICOUT,1316)IMABCO(I)
35999 1316 FORMAT('THE COLOR OF ALL MARKER BORDERS',
36000     1' HAS JUST BEEN SET TO ',A4)
36001      CALL DPWRST('XXX','BUG ')
36002 1319 CONTINUE
36003      IFOUND='YES'
36004      GOTO9000
36005C
36006C               *****************
36007C               **  STEP 90--  **
36008C               **  EXIT       **
36009C               *****************
36010C
36011 9000 CONTINUE
36012      IF(IBUGP2.EQ.'OFF')GOTO9090
36013      WRITE(ICOUT,9011)
36014 9011 FORMAT('***** AT THE END       OF DPMBCO--')
36015      CALL DPWRST('XXX','BUG ')
36016      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
36017 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
36018      CALL DPWRST('XXX','BUG ')
36019      WRITE(ICOUT,9013)MAXMAR,NUMMAR
36020 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
36021      CALL DPWRST('XXX','BUG ')
36022      WRITE(ICOUT,9014)IHOLD1,IHOLD2
36023 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
36024      CALL DPWRST('XXX','BUG ')
36025      WRITE(ICOUT,9015)IDEMBC
36026 9015 FORMAT('IDEMBC = ',A4)
36027      CALL DPWRST('XXX','BUG ')
36028      WRITE(ICOUT,9020)NUMARG
36029 9020 FORMAT('NUMARG = ',I8)
36030      CALL DPWRST('XXX','BUG ')
36031      DO9025I=1,NUMARG
36032      WRITE(ICOUT,9026)IHARG(I)
36033 9026 FORMAT('IHARG(I) = ',A4)
36034      CALL DPWRST('XXX','BUG ')
36035 9025 CONTINUE
36036      WRITE(ICOUT,9030)IMABCO(1)
36037 9030 FORMAT('IMABCO(1) = ',A4)
36038      CALL DPWRST('XXX','BUG ')
36039      DO9035I=1,10
36040      WRITE(ICOUT,9036)I,IMABCO(I)
36041 9036 FORMAT('I,IMABCO(I) = ',I8,2X,A4)
36042      CALL DPWRST('XXX','BUG ')
36043 9035 CONTINUE
36044 9090 CONTINUE
36045C
36046      RETURN
36047      END
36048      SUBROUTINE DPMBFW(Y,AL,N,
36049     1                  TEMP1,TEMP2,DTEMP1,MAXNXT,
36050     1                  SCALSV,SHAPSV,SCALML,SHAPML,
36051     1                  AIC,AICC,BIC,ALIKE,
36052     1                  ICAPSW,ICAPTY,IFORSW,
36053     1                  ISUBRO,IBUGA3,IERROR)
36054C
36055C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD ESTIMATES
36056C              FOR THE 2-PARAMETER BRITTLE FIBER WEIBULL DISTRIBUTION
36057C              FOR THE FULL SAMPLE CASE.
36058C
36059C              NOTE THAT THIS INITIAL IMPLEMENTATION ONLY GENERATES
36060C              POINT ESTIMATES, NOT INTERVAL ESTIMATES.
36061C     EXAMPLE--BRITTLE FIBER WEIBULL MAXIMUM LIKELIHOOD Y
36062C     REFERENCES--STONER, EDIE, AND DURHAM (1994), "AN END-EFFECT MODEL
36063C                 FOR THE SINGLE-FILAMENT TENSILE TEST", JOURNAL OF
36064C                 OF MATERIALS SCIENCE, 29, PP. 6561-6574.
36065C               --NEWELL AND SAGENDORF (1999), "EXPERIMENTAL VERIFICATION
36066C                 OF THE END-EFFECT WEIBULL MODEL AS A PREDICTOR OF THE
36067C                 TENSILE STRENGTH OF KEVLAR-29 (POLY
36068C                 p-PHENYLENETEREPHTHALAMIDE) FIBRES AT DIFFERENCE GAUGE
36069C                 LENGTHS", HIGH PERFORMANCE POLYMERS, 11, PP. 297-305.
36070C     WRITTEN BY--ALAN HECKERT
36071C                 STATISTICAL ENGINEERING DIVISION
36072C                 INFORMATION TECHNOLOGY LABORATORY
36073C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
36074C                 GAITHERSBURG, MD 20899-8980
36075C                 PHONE--301-975-2899
36076C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
36077C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
36078C     LANGUAGE--ANSI FORTRAN (1977)
36079C     VERSION NUMBER--2010/11
36080C     ORIGINAL VERSION--NOVEMBER  2010.
36081C
36082C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
36083C
36084      CHARACTER*4 ICAPSW
36085      CHARACTER*4 ICAPTY
36086      CHARACTER*4 IFORSW
36087      CHARACTER*4 ISUBRO
36088      CHARACTER*4 IBUGA3
36089      CHARACTER*4 IERROR
36090C
36091      CHARACTER*4 ISUBN1
36092      CHARACTER*4 ISUBN2
36093      CHARACTER*4 ISTEPN
36094      CHARACTER*4 ICASPL
36095      CHARACTER*40 IDIST
36096C
36097C---------------------------------------------------------------------
36098C
36099      DIMENSION Y(*)
36100      DIMENSION AL(*)
36101      DIMENSION TEMP1(*)
36102      DIMENSION TEMP2(*)
36103      DOUBLE PRECISION DTEMP1(*)
36104C
36105      DIMENSION QP(1)
36106C
36107      INCLUDE 'DPCOST.INC'
36108C
36109      PARAMETER (MAXROW=50)
36110      CHARACTER*60 ITITLE
36111      CHARACTER*60 ITITLZ
36112      CHARACTER*40 ITEXT(MAXROW)
36113      REAL         AVALUE(MAXROW)
36114      INTEGER      NCTEXT(MAXROW)
36115      INTEGER      IDIGIT(MAXROW)
36116      INTEGER      NTOT(MAXROW)
36117      LOGICAL IFRST
36118      LOGICAL ILAST
36119C
36120C---------------------------------------------------------------------
36121C
36122      INCLUDE 'DPCOP2.INC'
36123C
36124C-----START POINT-----------------------------------------------------
36125C
36126      ISUBN1='DPMB'
36127      ISUBN2='FW  '
36128      IERROR='NO'
36129C
36130      IDIST='2-PARAMETER BRITTLE FIBER WEIBULL'
36131C
36132      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MBFW')THEN
36133        WRITE(ICOUT,999)
36134  999   FORMAT(1X)
36135        CALL DPWRST('XXX','WRIT')
36136        WRITE(ICOUT,51)
36137   51   FORMAT('**** AT THE BEGINNING OF DPMBFW--')
36138        CALL DPWRST('XXX','WRIT')
36139        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NUMV
36140   52   FORMAT('IBUGA3,ISUBRO,N,NUMV = ',2(A4,2X),2I8)
36141        CALL DPWRST('XXX','WRIT')
36142        DO56I=1,MIN(N,100)
36143          WRITE(ICOUT,57)I,Y(I),AL(I)
36144   57     FORMAT('I,Y(I),AL(I) = ',I8,2G15.7)
36145          CALL DPWRST('XXX','WRIT')
36146   56   CONTINUE
36147      ENDIF
36148C
36149C               ********************************************
36150C               **  STEP 11--                             **
36151C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
36152C               ********************************************
36153C
36154      ISTEPN='11'
36155      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MBFW')
36156     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36157C
36158      NMIN=3
36159      NPERC=0
36160      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
36161      IF(IERROR.EQ.'YES')GOTO9000
36162C
36163C     STEP 1: OBTAIN POINT ESTIMATES AND STANDARD ERRORS
36164C
36165      ISTEPN='12'
36166      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MBFW')
36167     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36168C
36169      CALL BFWML1(Y,AL,N,MAXNXT,
36170     1            TEMP1,TEMP2,DTEMP1,
36171     1            XMEAN,XSD,XVAR,XMIN,XMAX,
36172     1            SCALSV,SHAPSV,SCALML,SHAPML,
36173     1            ISUBRO,IBUGA3,IERROR)
36174       IF(IERROR.EQ.'YES')GOTO9000
36175C
36176      ISTEPN='13'
36177      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MBFW')
36178     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36179C
36180       ALIKE=CPUMIN
36181       AIC=CPUMIN
36182       AICC=CPUMIN
36183       BIC=CPUMIN
36184       MINMAX=1
36185       ALOC=0.0
36186       ICASPL='WEIB'
36187       CALL BFWLI1(Y,AL,N,ICASPL,MINMAX,ALOC,SCALML,SHAPML,
36188     1             ALIKE,AIC,AICC,BIC,
36189     1             ISUBRO,IBUGA3,IERROR)
36190C
36191C               ***********************************************
36192C               **   STEP 42--                              **
36193C               **   WRITE OUT EVERYTHING                   **
36194C               **   FOR 2-PARAMETER BRITTLE FIBER WEIBULL  **
36195C               **   MLE ESTIMATE                           **
36196C               **********************************************
36197C
36198      ISTEPN='42'
36199      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MBFW')
36200     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36201C
36202C     PRINT SUMMARY STATISTICS TABLE
36203C
36204      IF(IPRINT.EQ.'OFF')GOTO9000
36205C
36206      NUMDIG=7
36207      IF(IFORSW.EQ.'1')NUMDIG=1
36208      IF(IFORSW.EQ.'2')NUMDIG=2
36209      IF(IFORSW.EQ.'3')NUMDIG=3
36210      IF(IFORSW.EQ.'4')NUMDIG=4
36211      IF(IFORSW.EQ.'5')NUMDIG=5
36212      IF(IFORSW.EQ.'6')NUMDIG=6
36213      IF(IFORSW.EQ.'7')NUMDIG=7
36214      IF(IFORSW.EQ.'8')NUMDIG=8
36215      IF(IFORSW.EQ.'9')NUMDIG=9
36216      IF(IFORSW.EQ.'0')NUMDIG=0
36217      IF(IFORSW.EQ.'E')NUMDIG=-2
36218      IF(IFORSW.EQ.'-2')NUMDIG=-2
36219      IF(IFORSW.EQ.'-3')NUMDIG=-3
36220      IF(IFORSW.EQ.'-4')NUMDIG=-4
36221      IF(IFORSW.EQ.'-5')NUMDIG=-5
36222      IF(IFORSW.EQ.'-6')NUMDIG=-6
36223      IF(IFORSW.EQ.'-7')NUMDIG=-7
36224      IF(IFORSW.EQ.'-8')NUMDIG=-8
36225      IF(IFORSW.EQ.'-9')NUMDIG=-9
36226C
36227      ITITLE='Two-Parameter Brittle Fiber Weibull Parameter Estimation:'
36228      NCTITL=57
36229      ITITLZ='Full Sample Case'
36230      NCTITZ=16
36231C
36232      ICNT=1
36233      ITEXT(ICNT)='Summary Statistics:'
36234      NCTEXT(ICNT)=19
36235      AVALUE(ICNT)=0.0
36236      IDIGIT(ICNT)=0
36237      ICNT=ICNT+1
36238      ITEXT(ICNT)='Number of Observations:'
36239      NCTEXT(ICNT)=23
36240      AVALUE(ICNT)=REAL(N)
36241      IDIGIT(ICNT)=0
36242      ICNT=ICNT+1
36243      ITEXT(ICNT)='Sample Mean:'
36244      NCTEXT(ICNT)=12
36245      AVALUE(ICNT)=XMEAN
36246      IDIGIT(ICNT)=NUMDIG
36247      ICNT=ICNT+1
36248      ITEXT(ICNT)='Sample Standard Deviation:'
36249      NCTEXT(ICNT)=26
36250      AVALUE(ICNT)=XSD
36251      IDIGIT(ICNT)=NUMDIG
36252      ICNT=ICNT+1
36253      ITEXT(ICNT)='Sample Minimum:'
36254      NCTEXT(ICNT)=15
36255      AVALUE(ICNT)=XMIN
36256      IDIGIT(ICNT)=NUMDIG
36257      ICNT=ICNT+1
36258      ITEXT(ICNT)='Sample Maximum:'
36259      NCTEXT(ICNT)=15
36260      AVALUE(ICNT)=XMAX
36261      IDIGIT(ICNT)=NUMDIG
36262      ICNT=ICNT+1
36263      ITEXT(ICNT)=' '
36264      NCTEXT(ICNT)=0
36265      AVALUE(ICNT)=0.0
36266      IDIGIT(ICNT)=-1
36267C
36268      ICNT=ICNT+1
36269      ITEXT(ICNT)='Maximum Likelihood:'
36270      NCTEXT(ICNT)=19
36271      AVALUE(ICNT)=0.0
36272      IDIGIT(ICNT)=-1
36273      ICNT=ICNT+1
36274      ITEXT(ICNT)='Estimate of Scale:'
36275      NCTEXT(ICNT)=18
36276      AVALUE(ICNT)=SCALML
36277      IDIGIT(ICNT)=NUMDIG
36278      ICNT=ICNT+1
36279      ITEXT(ICNT)='Estimate of Shape (Gamma):'
36280      NCTEXT(ICNT)=26
36281      AVALUE(ICNT)=SHAPML
36282      IDIGIT(ICNT)=NUMDIG
36283C
36284      IF(ALIKE.NE.CPUMIN)THEN
36285        ICNT=ICNT+1
36286        ITEXT(ICNT)='Log-likelihood:'
36287        NCTEXT(ICNT)=15
36288        AVALUE(ICNT)=ALIKE
36289        IDIGIT(ICNT)=-7
36290        ICNT=ICNT+1
36291        ITEXT(ICNT)='AIC:'
36292        NCTEXT(ICNT)=4
36293        AVALUE(ICNT)=AIC
36294        IDIGIT(ICNT)=-7
36295        ICNT=ICNT+1
36296        ITEXT(ICNT)='AICc:'
36297        NCTEXT(ICNT)=5
36298        AVALUE(ICNT)=AICC
36299        IDIGIT(ICNT)=-7
36300        ICNT=ICNT+1
36301        ITEXT(ICNT)='BIC:'
36302        NCTEXT(ICNT)=4
36303        AVALUE(ICNT)=BIC
36304        IDIGIT(ICNT)=-7
36305      ENDIF
36306C
36307      NUMROW=ICNT
36308      DO2320I=1,NUMROW
36309        NTOT(I)=15
36310 2320 CONTINUE
36311C
36312      IFRST=.TRUE.
36313      ILAST=.TRUE.
36314      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
36315     1            AVALUE,IDIGIT,
36316     1            NTOT,NUMROW,
36317     1            ICAPSW,ICAPTY,ILAST,IFRST,
36318     1            ISUBRO,IBUGA3,IERROR)
36319C
36320C               *****************
36321C               **  STEP 90--  **
36322C               **  EXIT       **
36323C               *****************
36324C
36325 9000 CONTINUE
36326      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MBFW')THEN
36327        WRITE(ICOUT,999)
36328        CALL DPWRST('XXX','WRIT')
36329        WRITE(ICOUT,9011)
36330 9011   FORMAT('***** AT THE END       OF DPMBFW--')
36331        CALL DPWRST('XXX','WRIT')
36332        WRITE(ICOUT,9012)N,IBUGA3,IERROR
36333 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
36334        CALL DPWRST('XXX','WRIT')
36335        WRITE(ICOUT,9014)SCALML,SHAPML
36336 9014   FORMAT('SCALML,SHAPML = ',2G15.7)
36337        CALL DPWRST('XXX','WRIT')
36338      ENDIF
36339C
36340      RETURN
36341      END
36342      SUBROUTINE DPMBLI(IHARG,IHARG2,NUMARG,IDEMBL,MAXMAR,IMABLI,
36343     1                  IBUGP2,IFOUND,IERROR)
36344CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
36345CCCCC SUBROUTINE DPMBLI(IHARG,NUMARG,IDEMBL,MAXMAR,IMABLI,
36346C
36347C     PURPOSE--DEFINE THE BORDER LINES = THE LINES TYPES
36348C              OF THE BORDER AROUND THE MARKERS.
36349C              THESE ARE LOCATED IN THE VECTOR IMABLI(.).
36350C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
36351C                     --NUMARG
36352C                     --IDEMBL
36353C                     --MAXMAR
36354C                     --IBUGP2 ('ON' OR 'OFF' )
36355C     OUTPUT ARGUMENTS--IMABLI (A CHARACTER VECTOR)
36356C                     --IFOUND ('YES' OR 'NO' )
36357C                     --IERROR ('YES' OR 'NO' )
36358C     WRITTEN BY--JAMES J. FILLIBEN
36359C                 STATISTICAL ENGINEERING DIVISION
36360C                 INFORMATION TECHNOLOGY LABORATORY
36361C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
36362C                 Gaithersburg, MD 20899-8980
36363C                 PHONE--301-975-2855
36364C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
36365C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
36366C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
36367C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
36368C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
36369C     LANGUAGE--ANSI FORTRAN (1977)
36370C     VERSION NUMBER--82/7
36371C     ORIGINAL VERSION--DECEMBER  1983.
36372C     UPDATED         --AUGUST    1995.  DASH2 BUG
36373C
36374C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
36375C
36376      CHARACTER*4 IHARG
36377CCCCC AUGUST 1995.  ADD FOLLOWING LINE
36378      CHARACTER*4 IHARG2
36379      CHARACTER*4 IDEMBL
36380      CHARACTER*4 IMABLI
36381C
36382      CHARACTER*4 IBUGP2
36383      CHARACTER*4 IFOUND
36384      CHARACTER*4 IERROR
36385C
36386      CHARACTER*4 IHOLD1
36387      CHARACTER*4 IHOLD2
36388C
36389      CHARACTER*4 ISUBN1
36390      CHARACTER*4 ISUBN2
36391      CHARACTER*4 ISTEPN
36392C
36393      DIMENSION IHARG(*)
36394CCCCC AUGUST 1995.  ADD FOLLOWING LINE
36395      DIMENSION IHARG2(*)
36396      DIMENSION IMABLI(*)
36397C
36398C---------------------------------------------------------------------
36399C
36400      INCLUDE 'DPCOP2.INC'
36401C
36402C-----START POINT-----------------------------------------------------
36403C
36404      IFOUND='NO'
36405      IERROR='NO'
36406      ISUBN1='DPMB'
36407      ISUBN2='LI  '
36408C
36409      NUMMAR=0
36410      IHOLD1='-999'
36411      IHOLD2='-999'
36412C
36413      IF(IBUGP2.EQ.'OFF')GOTO90
36414      WRITE(ICOUT,999)
36415  999 FORMAT(1X)
36416      CALL DPWRST('XXX','BUG ')
36417      WRITE(ICOUT,51)
36418   51 FORMAT('***** AT THE BEGINNING OF DPMBLI--')
36419      CALL DPWRST('XXX','BUG ')
36420      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
36421   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
36422      CALL DPWRST('XXX','BUG ')
36423      WRITE(ICOUT,53)MAXMAR,NUMMAR
36424   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
36425      CALL DPWRST('XXX','BUG ')
36426      WRITE(ICOUT,54)IHOLD1,IHOLD2
36427   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
36428      CALL DPWRST('XXX','BUG ')
36429      WRITE(ICOUT,55)IDEMBL
36430   55 FORMAT('IDEMBL = ',A4)
36431      CALL DPWRST('XXX','BUG ')
36432      WRITE(ICOUT,60)NUMARG
36433   60 FORMAT('NUMARG = ',I8)
36434      CALL DPWRST('XXX','BUG ')
36435      DO65I=1,NUMARG
36436      WRITE(ICOUT,66)IHARG(I)
36437   66 FORMAT('IHARG(I) = ',A4)
36438      CALL DPWRST('XXX','BUG ')
36439   65 CONTINUE
36440      WRITE(ICOUT,70)IMABLI(1)
36441   70 FORMAT('IMABLI(1) = ',A4)
36442      CALL DPWRST('XXX','BUG ')
36443      DO75I=1,10
36444      WRITE(ICOUT,76)I,IMABLI(I)
36445   76 FORMAT('I,IMABLI(I) = ',I8,2X,A4)
36446      CALL DPWRST('XXX','BUG ')
36447   75 CONTINUE
36448   90 CONTINUE
36449C
36450C               **************************************
36451C               **  STEP 1--                        **
36452C               **  BRANCH TO THE APPROPRIATE CASE  **
36453C               **************************************
36454C
36455      ISTEPN='1'
36456      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36457C
36458      IF(NUMARG.LE.2)GOTO9000
36459      IF(NUMARG.EQ.3)GOTO1130
36460      IF(NUMARG.EQ.4)GOTO1140
36461      IF(NUMARG.EQ.5)GOTO1150
36462      GOTO1160
36463C
36464 1130 CONTINUE
36465      GOTO1200
36466C
36467 1140 CONTINUE
36468      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
36469      IF(IHARG(5).EQ.'ALL')GOTO1300
36470      GOTO1200
36471C
36472 1150 CONTINUE
36473      IF(IHARG(5).EQ.'ALL')THEN
36474        IHOLD1=IHARG(6)
36475        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
36476        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
36477        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
36478        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
36479        GOTO1300
36480      ENDIF
36481      IF(IHARG(6).EQ.'ALL')THEN
36482        IHOLD1=IHARG(5)
36483        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
36484        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
36485        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
36486        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
36487        GOTO1300
36488      ENDIF
36489      GOTO1200
36490C
36491 1160 CONTINUE
36492      GOTO1200
36493C
36494C               *************************************************
36495C               **  STEP 2--                                   **
36496C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
36497C               *************************************************
36498C
36499 1200 CONTINUE
36500      ISTEPN='2'
36501      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36502C
36503      IF(NUMARG.LE.3)GOTO1210
36504      GOTO1220
36505C
36506 1210 CONTINUE
36507      NUMMAR=1
36508      IMABLI(1)='    '
36509      GOTO1270
36510C
36511 1220 CONTINUE
36512      NUMMAR=NUMARG-3
36513      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
36514      DO1225I=1,NUMMAR
36515      J=I+3
36516      IHOLD1=IHARG(J)
36517      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
36518      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
36519      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
36520      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
36521      IHOLD2=IHOLD1
36522      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
36523      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
36524      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMBL
36525      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMBL
36526      IMABLI(I)=IHOLD2
36527 1225 CONTINUE
36528      GOTO1270
36529C
36530 1270 CONTINUE
36531      IF(IFEEDB.EQ.'OFF')GOTO1279
36532      WRITE(ICOUT,999)
36533      CALL DPWRST('XXX','BUG ')
36534      DO1278I=1,NUMMAR
36535      WRITE(ICOUT,1276)I,IMABLI(I)
36536 1276 FORMAT('THE LINE TYPE FOR MARKER BORDER ',I6,
36537     1' HAS JUST BEEN SET TO ',A4)
36538      CALL DPWRST('XXX','BUG ')
36539 1278 CONTINUE
36540 1279 CONTINUE
36541      IFOUND='YES'
36542      GOTO9000
36543C
36544C               **************************
36545C               **  STEP 3--            **
36546C               **  TREAT THE ALL CASE  **
36547C               **************************
36548C
36549 1300 CONTINUE
36550      ISTEPN='3'
36551      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36552C
36553      NUMMAR=MAXMAR
36554      IHOLD2=IHOLD1
36555      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
36556      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
36557      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMBL
36558      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMBL
36559      DO1315I=1,NUMMAR
36560      IMABLI(I)=IHOLD2
36561 1315 CONTINUE
36562      GOTO1370
36563C
36564 1370 CONTINUE
36565      IF(IFEEDB.EQ.'OFF')GOTO1319
36566      WRITE(ICOUT,999)
36567      CALL DPWRST('XXX','BUG ')
36568      I=1
36569      WRITE(ICOUT,1316)IMABLI(I)
36570 1316 FORMAT('THE LINE TYPE FOR ALL MARKER BORDERS',
36571     1' HAS JUST BEEN SET TO ',A4)
36572      CALL DPWRST('XXX','BUG ')
36573 1319 CONTINUE
36574      IFOUND='YES'
36575      GOTO9000
36576C
36577C               *****************
36578C               **  STEP 90--  **
36579C               **  EXIT       **
36580C               *****************
36581C
36582 9000 CONTINUE
36583      IF(IBUGP2.EQ.'OFF')GOTO9090
36584      WRITE(ICOUT,9011)
36585 9011 FORMAT('***** AT THE END       OF DPMBLI--')
36586      CALL DPWRST('XXX','BUG ')
36587      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
36588 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
36589      CALL DPWRST('XXX','BUG ')
36590      WRITE(ICOUT,9013)MAXMAR,NUMMAR
36591 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
36592      CALL DPWRST('XXX','BUG ')
36593      WRITE(ICOUT,9014)IHOLD1,IHOLD2
36594 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
36595      CALL DPWRST('XXX','BUG ')
36596      WRITE(ICOUT,9015)IDEMBL
36597 9015 FORMAT('IDEMBL = ',A4)
36598      CALL DPWRST('XXX','BUG ')
36599      WRITE(ICOUT,9020)NUMARG
36600 9020 FORMAT('NUMARG = ',I8)
36601      CALL DPWRST('XXX','BUG ')
36602      DO9025I=1,NUMARG
36603      WRITE(ICOUT,9026)IHARG(I)
36604 9026 FORMAT('IHARG(I) = ',A4)
36605      CALL DPWRST('XXX','BUG ')
36606 9025 CONTINUE
36607      WRITE(ICOUT,9030)IMABLI(1)
36608 9030 FORMAT('IMABLI(1) = ',A4)
36609      CALL DPWRST('XXX','BUG ')
36610      DO9035I=1,10
36611      WRITE(ICOUT,9036)I,IMABLI(I)
36612 9036 FORMAT('I,IMABLI(I) = ',I8,2X,A4)
36613      CALL DPWRST('XXX','BUG ')
36614 9035 CONTINUE
36615 9090 CONTINUE
36616C
36617      RETURN
36618      END
36619      SUBROUTINE DPMBTH(IHARG,IARGT,ARG,NUMARG,PDEMBT,MAXMAR,PMABTH,
36620     1                  IBUGP2,IFOUND,IERROR)
36621C
36622C     PURPOSE--DEFINE THE MARKER (BORDER) LINE THICKNESSES = THE THICKNESSES
36623C              OF THE BORDER LINE AROUND THE MARKERS.
36624C              THESE ARE LOCATED IN THE VECTOR PMABTH(.).
36625C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
36626C                     --IARGT  (A  CHARACTER VECTOR)
36627C                     --ARG
36628C                     --NUMARG
36629C                     --PDEMBT
36630C                     --MAXMAR
36631C                     --IBUGP2 ('ON' OR 'OFF' )
36632C     OUTPUT ARGUMENTS--PMABTH (A FLOATING POINT VECTOR)
36633C                     --IFOUND ('YES' OR 'NO' )
36634C                     --IERROR ('YES' OR 'NO' )
36635C     WRITTEN BY--JAMES J. FILLIBEN
36636C                 STATISTICAL ENGINEERING DIVISION
36637C                 INFORMATION TECHNOLOGY LABORATORY
36638C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
36639C                 Gaithersburg, MD 20899-8980
36640C                 PHONE--301-975-2855
36641C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
36642C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
36643C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
36644C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
36645C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
36646C     LANGUAGE--ANSI FORTRAN (1977)
36647C     VERSION NUMBER--82/7
36648C     ORIGINAL VERSION--DECEMBER  1983.
36649C
36650C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
36651C
36652      CHARACTER*4 IHARG
36653      CHARACTER*4 IARGT
36654C
36655      CHARACTER*4 IBUGP2
36656      CHARACTER*4 IFOUND
36657      CHARACTER*4 IERROR
36658C
36659      CHARACTER*4 IHOLD1
36660C
36661      CHARACTER*4 ISUBN1
36662      CHARACTER*4 ISUBN2
36663      CHARACTER*4 ISTEPN
36664C
36665      DIMENSION IHARG(*)
36666      DIMENSION IARGT(*)
36667      DIMENSION ARG(*)
36668      DIMENSION PMABTH(*)
36669C
36670C---------------------------------------------------------------------
36671C
36672      INCLUDE 'DPCOP2.INC'
36673C
36674C-----START POINT-----------------------------------------------------
36675C
36676      IFOUND='NO'
36677      IERROR='NO'
36678      ISUBN1='DPMB'
36679      ISUBN2='TH  '
36680C
36681      NUMMAR=0
36682      IHOLD1='-999'
36683      HOLD1=-999.0
36684      HOLD2=-999.0
36685C
36686      IF(IBUGP2.EQ.'OFF')GOTO90
36687      WRITE(ICOUT,999)
36688  999 FORMAT(1X)
36689      CALL DPWRST('XXX','BUG ')
36690      WRITE(ICOUT,51)
36691   51 FORMAT('***** AT THE BEGINNING OF DPMBTH--')
36692      CALL DPWRST('XXX','BUG ')
36693      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
36694   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
36695      CALL DPWRST('XXX','BUG ')
36696      WRITE(ICOUT,53)MAXMAR,NUMMAR
36697   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
36698      CALL DPWRST('XXX','BUG ')
36699      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
36700   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
36701      CALL DPWRST('XXX','BUG ')
36702      WRITE(ICOUT,55)PDEMBT
36703   55 FORMAT('PDEMBT = ',E15.7)
36704      CALL DPWRST('XXX','BUG ')
36705      WRITE(ICOUT,60)NUMARG
36706   60 FORMAT('NUMARG = ',I8)
36707      CALL DPWRST('XXX','BUG ')
36708      DO65I=1,NUMARG
36709      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
36710   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
36711      CALL DPWRST('XXX','BUG ')
36712   65 CONTINUE
36713      WRITE(ICOUT,70)PMABTH(1)
36714   70 FORMAT('PMABTH(1) = ',E15.7)
36715      CALL DPWRST('XXX','BUG ')
36716      DO75I=1,10
36717      WRITE(ICOUT,76)I,PMABTH(I)
36718   76 FORMAT('I,PMABTH(I) = ',I8,2X,E15.7)
36719      CALL DPWRST('XXX','BUG ')
36720   75 CONTINUE
36721   90 CONTINUE
36722C
36723C               **************************************
36724C               **  STEP 1--                        **
36725C               **  BRANCH TO THE APPROPRIATE CASE  **
36726C               **************************************
36727C
36728      ISTEPN='1'
36729      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36730C
36731      IF(NUMARG.LE.1)GOTO9000
36732      IF(NUMARG.EQ.2)GOTO1120
36733      IF(NUMARG.EQ.3)GOTO1130
36734      IF(NUMARG.EQ.4)GOTO1140
36735      GOTO1150
36736C
36737 1120 CONTINUE
36738      GOTO1200
36739C
36740 1130 CONTINUE
36741      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
36742      IF(IHARG(3).EQ.'ALL')HOLD1=PDEMBT
36743      IF(IHARG(3).EQ.'ALL')GOTO1300
36744      GOTO1200
36745C
36746 1140 CONTINUE
36747      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
36748      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
36749      IF(IHARG(3).EQ.'ALL')GOTO1300
36750      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
36751      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
36752      IF(IHARG(4).EQ.'ALL')GOTO1300
36753      GOTO1200
36754C
36755 1150 CONTINUE
36756      GOTO1200
36757C
36758C               *************************************************
36759C               **  STEP 2--                                   **
36760C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
36761C               *************************************************
36762C
36763 1200 CONTINUE
36764      ISTEPN='2'
36765      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36766C
36767      IF(NUMARG.LE.2)GOTO1210
36768      GOTO1220
36769C
36770 1210 CONTINUE
36771      NUMMAR=1
36772      PMABTH(1)=PDEMBT
36773      GOTO1270
36774C
36775 1220 CONTINUE
36776      NUMMAR=NUMARG-2
36777      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
36778      DO1225I=1,NUMMAR
36779      J=I+2
36780      IHOLD1=IHARG(J)
36781      HOLD1=ARG(J)
36782      HOLD2=HOLD1
36783      IF(IHOLD1.EQ.'ON')HOLD2=PDEMBT
36784      IF(IHOLD1.EQ.'OFF')HOLD2=PDEMBT
36785      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEMBT
36786      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEMBT
36787      PMABTH(I)=HOLD2
36788 1225 CONTINUE
36789      GOTO1270
36790C
36791 1270 CONTINUE
36792      IF(IFEEDB.EQ.'OFF')GOTO1279
36793      WRITE(ICOUT,999)
36794      CALL DPWRST('XXX','BUG ')
36795      DO1278I=1,NUMMAR
36796      WRITE(ICOUT,1276)I,PMABTH(I)
36797 1276 FORMAT('THE THICKNESS OF MARKER BORDER ',I6,
36798     1' HAS JUST BEEN SET TO ',E15.7)
36799      CALL DPWRST('XXX','BUG ')
36800 1278 CONTINUE
36801 1279 CONTINUE
36802      IFOUND='YES'
36803      GOTO9000
36804C
36805C               **************************
36806C               **  STEP 3--            **
36807C               **  TREAT THE ALL CASE  **
36808C               **************************
36809C
36810 1300 CONTINUE
36811      ISTEPN='3'
36812      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
36813C
36814      NUMMAR=MAXMAR
36815      HOLD2=HOLD1
36816      IF(IHOLD1.EQ.'ON')HOLD2=PDEMBT
36817      IF(IHOLD1.EQ.'OFF')HOLD2=PDEMBT
36818      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEMBT
36819      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEMBT
36820      DO1315I=1,NUMMAR
36821      PMABTH(I)=HOLD2
36822 1315 CONTINUE
36823      GOTO1370
36824C
36825 1370 CONTINUE
36826      IF(IFEEDB.EQ.'OFF')GOTO1319
36827      WRITE(ICOUT,999)
36828      CALL DPWRST('XXX','BUG ')
36829      I=1
36830      WRITE(ICOUT,1316)PMABTH(I)
36831 1316 FORMAT('THE THICKNESS OF ALL MARKER BORDERS',
36832     1' HAS JUST BEEN SET TO ',E15.7)
36833      CALL DPWRST('XXX','BUG ')
36834 1319 CONTINUE
36835      IFOUND='YES'
36836      GOTO9000
36837C
36838C               *****************
36839C               **  STEP 90--  **
36840C               **  EXIT       **
36841C               *****************
36842C
36843 9000 CONTINUE
36844      IF(IBUGP2.EQ.'OFF')GOTO9090
36845      WRITE(ICOUT,9011)
36846 9011 FORMAT('***** AT THE END       OF DPMBTH--')
36847      CALL DPWRST('XXX','BUG ')
36848      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
36849 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
36850      CALL DPWRST('XXX','BUG ')
36851      WRITE(ICOUT,9013)MAXMAR,NUMMAR
36852 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
36853      CALL DPWRST('XXX','BUG ')
36854      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
36855 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
36856      CALL DPWRST('XXX','BUG ')
36857      WRITE(ICOUT,9015)PDEMBT
36858 9015 FORMAT('PDEMBT = ',E15.7)
36859      CALL DPWRST('XXX','BUG ')
36860      WRITE(ICOUT,9030)PMABTH(1)
36861 9030 FORMAT('PMABTH(1) = ',E15.7)
36862      CALL DPWRST('XXX','BUG ')
36863      DO9035I=1,10
36864      WRITE(ICOUT,9036)I,PMABTH(I)
36865 9036 FORMAT('I,PMABTH(I) = ',I8,2X,E15.7)
36866      CALL DPWRST('XXX','BUG ')
36867 9035 CONTINUE
36868 9090 CONTINUE
36869C
36870      RETURN
36871      END
36872      SUBROUTINE DPMCNE(MAXNXT,ICASAN,ICAPSW,IFORSW,
36873     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
36874C
36875C     PURPOSE--COMPUTE MCNEMAR TEST.
36876C     EXAMPLE--MCNEMAR TEST Y1 Y2
36877C            --MCNEMAR TEST N11 N21 N12 N22
36878C     REFERENCE--CONOVER (1999), "PRACTICAL NONPARAMETRIC
36879C                STATISTICS", THIRD EDITION, WILEY, PP. 166-169.
36880C     WRITTEN BY--ALAN HECKERT
36881C                 STATISTICAL ENGINEERING DIVISION
36882C                 INFORMATION TECHNOLOGY LABORATORY
36883C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
36884C                 GAITHERSBURG, MD 20899-8980
36885C                 PHONE--301-975-2899
36886C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
36887C           OF THE NATIONAL BUREAU OF STANDARDS.
36888C     LANGUAGE--ANSI FORTRAN (1977)
36889C     VERSION NUMBER--2007/3
36890C     ORIGINAL VERSION--MARCH     2007.
36891C     UPDATED         --JANUARY   2011. USE DPPARS
36892C
36893C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
36894C
36895      CHARACTER*4 ICASAN
36896      CHARACTER*4 ICAPSW
36897      CHARACTER*4 IFORSW
36898C
36899      CHARACTER*4 IBUGA2
36900      CHARACTER*4 IBUGA3
36901      CHARACTER*4 IBUGQ
36902      CHARACTER*4 ISUBRO
36903      CHARACTER*4 IFOUND
36904      CHARACTER*4 IERROR
36905C
36906      CHARACTER*4 ICASEQ
36907      CHARACTER*4 ISUBN1
36908      CHARACTER*4 ISUBN2
36909      CHARACTER*4 ISTEPN
36910      CHARACTER*4 IH
36911      CHARACTER*4 IH2
36912      CHARACTER*4 IHOST1
36913      CHARACTER*4 ISUBN0
36914      CHARACTER*4 ICASE
36915      CHARACTER*40 INAME
36916C
36917      PARAMETER (MAXSPN=20)
36918      CHARACTER*4 IVARN1(MAXSPN)
36919      CHARACTER*4 IVARN2(MAXSPN)
36920      CHARACTER*4 IVARTY(MAXSPN)
36921      REAL PVAR(MAXSPN)
36922      INTEGER ILIS(MAXSPN)
36923      INTEGER NRIGHT(MAXSPN)
36924      INTEGER ICOLR(MAXSPN)
36925C
36926C-----COMMON----------------------------------------------------------
36927C
36928      PARAMETER(MAXLEV=1000)
36929C
36930      INCLUDE 'DPCOPA.INC'
36931      INCLUDE 'DPCOZZ.INC'
36932C
36933      REAL TEMP1(MAXOBV)
36934      REAL TEMP2(MAXOBV)
36935      REAL TEMP3(MAXOBV)
36936      REAL XIDTEM(MAXOBV)
36937      REAL XIDTE2(MAXOBV)
36938      REAL XMAT(MAXLEV,MAXLEV)
36939C
36940      EQUIVALENCE (GARBAG(IGARB1),TEMP1(1))
36941      EQUIVALENCE (GARBAG(IGARB2),TEMP2(1))
36942      EQUIVALENCE (GARBAG(IGARB3),TEMP3(1))
36943      EQUIVALENCE (GARBAG(IGARB4),XIDTEM(1))
36944      EQUIVALENCE (GARBAG(IGARB5),XIDTE2(1))
36945      EQUIVALENCE (GARBAG(IGARB6),XMAT(1,1))
36946C
36947C-----COMMON VARIABLES (GENERAL)--------------------------------------
36948C
36949      INCLUDE 'DPCOHK.INC'
36950      INCLUDE 'DPCOSU.INC'
36951      INCLUDE 'DPCOST.INC'
36952      INCLUDE 'DPCODA.INC'
36953      INCLUDE 'DPCOP2.INC'
36954C
36955C-----START POINT-----------------------------------------------------
36956C
36957      ISUBN1='DPMC'
36958      ISUBN2='NE  '
36959      IFOUND='NO'
36960      IERROR='NO'
36961C
36962      MAXCP1=MAXCOL+1
36963      MAXCP2=MAXCOL+2
36964      MAXCP3=MAXCOL+3
36965      MAXCP4=MAXCOL+4
36966      MAXCP5=MAXCOL+5
36967      MAXCP6=MAXCOL+6
36968C
36969      N11=(-999)
36970      N21=(-999)
36971      N12=(-999)
36972      N22=(-999)
36973C
36974      NS1=(-999)
36975      NS2=(-999)
36976      NS3=(-999)
36977      NS4=(-999)
36978C
36979      ICASE='PARA'
36980      MINN2=2
36981C
36982      IFOUND='YES'
36983      ICASEQ='UNKN'
36984C
36985C               ***************************************************
36986C               **  TREAT THE MCNEMAR TEST CASE                  **
36987C               ***************************************************
36988C
36989      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCNE')THEN
36990        WRITE(ICOUT,999)
36991  999   FORMAT(1X)
36992        CALL DPWRST('XXX','BUG ')
36993        WRITE(ICOUT,51)
36994   51   FORMAT('***** AT THE BEGINNING OF DPMCNE--')
36995        CALL DPWRST('XXX','BUG ')
36996        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ICASAN
36997   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ICASAN = ',3(A4,2X),A4)
36998        CALL DPWRST('XXX','BUG ')
36999        WRITE(ICOUT,55)MAXNXT,NUMARG
37000   55   FORMAT('MAXNXT,NUMARG = ',2I8)
37001        CALL DPWRST('XXX','BUG ')
37002        DO59I=1,NUMARG
37003          WRITE(ICOUT,57)I,IHARG(I),IHARG2(I),ARG(I)
37004   57     FORMAT('I,IHARG(I),IHARG2(I),ARG(I) = ',I5,A4,A4,G15.7)
37005   59   CONTINUE
37006      ENDIF
37007C
37008C               *********************************
37009C               **  STEP 4--                   **
37010C               **  EXTRACT THE VARIABLE LIST  **
37011C               *********************************
37012C
37013      ISTEPN='4'
37014      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCNE')
37015     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37016C
37017      INAME='MCNEMAR TEST'
37018      MINNA=1
37019      MAXNA=100
37020      MINN2=2
37021      IFLAGE=0
37022      IFLAGM=9
37023      IFLAGP=9
37024      JMIN=1
37025      JMAX=NUMARG
37026      MINNVA=1
37027      MAXNVA=4
37028C
37029      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
37030     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
37031     1            JMIN,JMAX,
37032     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
37033     1            IVARN1,IVARN2,IVARTY,PVAR,
37034     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
37035     1            MINNVA,MAXNVA,
37036     1            IFLAGM,IFLAGP,
37037     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
37038      IF(IERROR.EQ.'YES')GOTO9000
37039C
37040      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCNE')THEN
37041        WRITE(ICOUT,999)
37042        CALL DPWRST('XXX','BUG ')
37043        WRITE(ICOUT,281)
37044  281   FORMAT('***** AFTER CALL DPPARS--')
37045        CALL DPWRST('XXX','BUG ')
37046        WRITE(ICOUT,282)NQ,NUMVAR
37047  282   FORMAT('NQ,NUMVAR = ',2I8)
37048        CALL DPWRST('XXX','BUG ')
37049        IF(NUMVAR.GT.0)THEN
37050          DO285I=1,NUMVAR
37051            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
37052     1                      ICOLR(I),PVAR(I)
37053  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
37054     1             'ICOLR(I),PVAR(I) = ',I8,2X,A4,A4,2X,3I8,G15.7)
37055            CALL DPWRST('XXX','BUG ')
37056  285     CONTINUE
37057        ENDIF
37058      ENDIF
37059C
37060C               ***********************************
37061C               **  STEP 22--                    **
37062C               **  CHECK FOR PROPER VALUES FOR  **
37063C               **  INPUT PARAMETERS             **
37064C               ***********************************
37065C
37066      IF(IVARTY(1).EQ.'PARA' .OR. IVARTY(1).EQ.'NUMB')THEN
37067        N11=INT(PVAR(1)+0.5)
37068        N21=INT(PVAR(2)+0.5)
37069        N12=INT(PVAR(3)+0.5)
37070        N22=INT(PVAR(4)+0.5)
37071        AN11=REAL(N11)
37072        AN21=REAL(N21)
37073        AN12=REAL(N12)
37074        AN22=REAL(N22)
37075        ICASE='PARA'
37076C
37077        ISTEPN='22'
37078        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCNE')
37079     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37080C
37081        IF(N11.LT.0)THEN
37082          WRITE(ICOUT,999)
37083          CALL DPWRST('XXX','BUG ')
37084          WRITE(ICOUT,2201)
37085 2201     FORMAT('***** ERROR FROM MCNEMAR TEST--')
37086          CALL DPWRST('XXX','BUG ')
37087          WRITE(ICOUT,2203)
37088 2203     FORMAT('      THE VALUE OF THE FIRST PARAMETER (N11 = THE ',
37089     1           'NUMBER OF SUCCESSES')
37090          CALL DPWRST('XXX','BUG ')
37091          WRITE(ICOUT,2204)
37092 2204     FORMAT('      FOR THE FIRST VARIABLE MUST BE NON-NEGATIVE.')
37093          CALL DPWRST('XXX','BUG ')
37094          WRITE(ICOUT,2205)N11
37095 2205     FORMAT('      N11 = ',I8)
37096          CALL DPWRST('XXX','BUG ')
37097          IERROR='YES'
37098          GOTO9000
37099C
37100        ELSEIF(N21.LT.0)THEN
37101          WRITE(ICOUT,999)
37102          CALL DPWRST('XXX','BUG ')
37103          WRITE(ICOUT,2201)
37104          CALL DPWRST('XXX','BUG ')
37105          WRITE(ICOUT,2303)
37106 2303     FORMAT('      THE VALUE OF THE SECOND PARAMETER (N21 = THE ',
37107     1           'NUMBER OF FAILURES')
37108          CALL DPWRST('XXX','BUG ')
37109          WRITE(ICOUT,2304)
37110 2304     FORMAT('      FOR THE FIRST VARIABLE MUST BE NON-NEGATIVE.')
37111          CALL DPWRST('XXX','BUG ')
37112          WRITE(ICOUT,2305)N21
37113 2305     FORMAT('      N21 = ',I8)
37114          CALL DPWRST('XXX','BUG ')
37115          IERROR='YES'
37116          GOTO9000
37117C
37118        ELSEIF(N12.LT.0)THEN
37119          WRITE(ICOUT,999)
37120          CALL DPWRST('XXX','BUG ')
37121          WRITE(ICOUT,2201)
37122          CALL DPWRST('XXX','BUG ')
37123          WRITE(ICOUT,2403)
37124 2403     FORMAT('      THE VALUE OF THE THIRD PARAMETER (N12 = THE ',
37125     1           'NUMBER OF SUCCESSES')
37126          CALL DPWRST('XXX','BUG ')
37127          WRITE(ICOUT,2404)
37128 2404     FORMAT('      FOR THE SECOND VARIABLE MUST BE NON-NEGATIVE.')
37129          CALL DPWRST('XXX','BUG ')
37130          WRITE(ICOUT,2405)N12
37131 2405     FORMAT('      N12 = ',I8)
37132          CALL DPWRST('XXX','BUG ')
37133          IERROR='YES'
37134          GOTO9000
37135C
37136        ELSEIF(N22.LT.0)THEN
37137          WRITE(ICOUT,999)
37138          CALL DPWRST('XXX','BUG ')
37139          WRITE(ICOUT,2201)
37140          CALL DPWRST('XXX','BUG ')
37141          WRITE(ICOUT,2503)
37142 2503     FORMAT('      THE VALUE OF THE FOURTH PARAMETER (N22 = THE ',
37143     1           'NUMBER OF FAILURES')
37144          CALL DPWRST('XXX','BUG ')
37145          WRITE(ICOUT,2504)
37146 2504     FORMAT('      FOR THE SECOND VARIABLE MUST BE NON-NEGATIVE.')
37147          CALL DPWRST('XXX','BUG ')
37148          WRITE(ICOUT,2505)N22
37149 2505     FORMAT('      N22 = ',I8)
37150          CALL DPWRST('XXX','BUG ')
37151          IERROR='YES'
37152          GOTO9000
37153        ENDIF
37154C
37155      ELSEIF(IVARTY(1).EQ.'VARI')THEN
37156C
37157        ICASE='VARI'
37158        ICOL=1
37159        IF(NUMVAR.GT.2)THEN
37160          WRITE(ICOUT,999)
37161          CALL DPWRST('XXX','BUG ')
37162          WRITE(ICOUT,2201)
37163          CALL DPWRST('XXX','BUG ')
37164          WRITE(ICOUT,2603)
37165 2603     FORMAT('      MORE THAN TWO VARIABLES GIVEN.')
37166          CALL DPWRST('XXX','BUG ')
37167          WRITE(ICOUT,2605)NUMVAR
37168 2605     FORMAT('      THE NUMBER OF VARIABLES GIVEN  = ',I5)
37169          CALL DPWRST('XXX','BUG ')
37170          IERROR='YES'
37171          GOTO9000
37172        ENDIF
37173        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
37174     1              INAME,IVARN1,IVARN2,IVARTY,
37175     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
37176     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
37177     1              MAXCP4,MAXCP5,MAXCP6,
37178     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
37179     1              Y,X,X,NLOCAL,NLOCA2,NLOCA3,ICASE,
37180     1              IBUGA3,ISUBRO,IFOUND,IERROR)
37181        IF(IERROR.EQ.'YES')GOTO9000
37182        NS1=NLOCAL
37183        NS2=NLOCA2
37184C
37185      ELSEIF(IVARTY(1).EQ.'MATR')THEN
37186        ICASE='MATR'
37187        ICOL=1
37188        NUMVAR=1
37189        CALL DPPAR6(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
37190     1              INAME,IVARN1,IVARN2,IVARTY,
37191     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVAR,
37192     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
37193     1              MAXCP4,MAXCP5,MAXCP6,
37194     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
37195     1              XMAT,MAXLEV,NROW,NCOL,ICASE,
37196     1              IBUGA3,ISUBRO,IFOUND,IERROR)
37197        ICASE='TABL'
37198        IF(IERROR.EQ.'YES')GOTO9000
37199      ENDIF
37200C
37201C               ***********************************
37202C               **  STEP 61--                    **
37203C               **  COMPUTE THE MCNEMAR    TEST  **
37204C               ***********************************
37205C
37206      ISTEPN='61'
37207      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCNE')
37208     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37209C
37210      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MCNE')THEN
37211        WRITE(ICOUT,999)
37212        CALL DPWRST('XXX','BUG ')
37213        WRITE(ICOUT,6111)
37214 6111   FORMAT('***** FROM DPMCNE--READY TO COMPUTE TEST')
37215        CALL DPWRST('XXX','BUG ')
37216        WRITE(ICOUT,6112)AN11,AN21,AN12,AN22
37217 6112   FORMAT('AN11,AN21,AN12,AN22 = ',4G15.7)
37218        CALL DPWRST('XXX','BUG ')
37219      ENDIF
37220C
37221      CALL DPMCN2(Y,NS1,X,NS2,
37222     1            AN11,AN21,AN12,AN22,
37223     1            XMAT,MAXLEV,NROW,NCOL,
37224     1            XIDTEM,
37225     1            ICASE,ICAPSW,ICAPTY,IFORSW,
37226     1            STATVA,CDF,
37227     1            ISUBRO,IBUGA3,IERROR)
37228C
37229C               ***************************************
37230C               **  STEP 62--                        **
37231C               **  UPDATE INTERNAL DATAPLOT TABLES  **
37232C               ***************************************
37233C
37234      ISTEPN='62'
37235      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCNE')
37236     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37237C
37238      ISUBN0='MCNE'
37239C
37240      IH='STAT'
37241      IH2='VAL '
37242      VALUE0=STATVA
37243      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
37244     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
37245     1IANS,IWIDTH,IBUGA3,IERROR)
37246C
37247      IH='STAT'
37248      IH2='CDF '
37249      VALUE0=CDF
37250      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
37251     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
37252     1IANS,IWIDTH,IBUGA3,IERROR)
37253C
37254C               *****************
37255C               **  STEP 90--  **
37256C               **  EXIT       **
37257C               *****************
37258C
37259 9000 CONTINUE
37260      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCNE')THEN
37261        WRITE(ICOUT,999)
37262        CALL DPWRST('XXX','BUG ')
37263        WRITE(ICOUT,9011)
37264 9011   FORMAT('***** AT THE END       OF DPMCNE--')
37265        CALL DPWRST('XXX','BUG ')
37266        WRITE(ICOUT,9012)IBUGA2,IBUGA3
37267 9012   FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
37268        CALL DPWRST('XXX','BUG ')
37269        WRITE(ICOUT,9016)IERROR
37270 9016   FORMAT('IERROR = ',A4,2X,A4)
37271        CALL DPWRST('XXX','BUG ')
37272      ENDIF
37273C
37274      RETURN
37275      END
37276      SUBROUTINE DPMCN2(Y1,N1,Y2,N2,
37277     1                  AN11,AN21,AN12,AN22,
37278     1                  XMAT,MAXLEV,NROW,NCOL,
37279     1                  XIDTEM,
37280     1                  ICASE,ICAPSW,ICAPTY,IFORSW,
37281     1                  STATVA,CDF,
37282     1                  ISUBRO,IBUGA3,IERROR)
37283C
37284C     PURPOSE--PERFORM A MCNEMAR TEST FOR INDEPENDENCE.
37285C              THE INPUT CAN EITHER BE ENTERED AS TWO VARIABLES
37286C              CONTAINING 1's (FOR SUCCESS) AND 0's (FOR FAILURES)
37287C              OR AS FOUR PARAMETERS:
37288C                 N11 = NUMBER OF SUCCESSES FOR VARIABLE 1 = A
37289C                 N21 = NUMBER OF FAILURES  FOR VARIABLE 1 = C
37290C                 N12 = NUMBER OF SUCCESSES FOR VARIABLE 2 = B
37291C                 N22 = NUMBER OF SUCCESSES FOR VARIABLE 2 = D
37292C
37293C              WE THEN USE THE TEST STATISTIC:
37294C
37295C                 T = (B-C)**2/(B+C)    B+C >= 20
37296C
37297C                 T = B                 B+C < 20
37298C
37299C              A CONTINUITY CORRECTION CAN BE APPLIED:
37300C
37301C                 T = {|B-C| - 1}**2/(B+C)    B+C >= 20
37302C
37303C     EXAMPLE--MCNEMAR TEST Y1 Y2
37304C              SAMPLE 1 IS IN INPUT VECTOR Y1 (WITH N1 OBSERVATIONS).
37305C              SAMPLE 2 IS IN INPUT VECTOR Y2 (WITH N2 OBSERVATIONS).
37306C            --MCNEMAR TEST N11 N21 N12 N22
37307C     WRITTEN BY--ALAN HECKERT
37308C                 STATISTICAL ENGINEERING DIVISION
37309C                 INFORMATION TECHNOLOGYU LABORATORY
37310C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
37311C                 GAITHERSBURG, MD 20899-8980
37312C                 PHONE--301-975-2899
37313C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
37314C           OF THE NATIONAL BUREAU OF STANDARDS.
37315C     LANGUAGE--ANSI FORTRAN (1977)
37316C     VERSION NUMBER--2007/3
37317C     ORIGINAL VERSION--MARCH     2007.
37318C     UPDATED         --JANUARY   2011. USE DPAUFI TO OPEN/CLOSE
37319C                                       AUXILLARY FILES
37320C     UPDATED         --JANUARY   2011. USE DPDTA1, DPDT5B TO PRINT
37321C                                       TABLES
37322C
37323C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
37324C
37325      CHARACTER*4 ISUBRO
37326      CHARACTER*4 IBUGA3
37327      CHARACTER*4 IERROR
37328      CHARACTER*4 ICASE
37329      CHARACTER*4 ICAPSW
37330      CHARACTER*4 ICAPTY
37331      CHARACTER*4 IFORSW
37332C
37333      CHARACTER*4 IWRITE
37334C
37335      CHARACTER*6 ICONC1
37336      CHARACTER*6 ICONC2
37337      CHARACTER*6 ICONC3
37338      CHARACTER*6 ICONC4
37339      CHARACTER*6 ICONC5
37340      CHARACTER*6 ICONC6
37341C
37342      CHARACTER*6 KCONC1
37343      CHARACTER*6 KCONC2
37344      CHARACTER*6 KCONC3
37345      CHARACTER*6 KCONC4
37346      CHARACTER*6 KCONC5
37347      CHARACTER*6 KCONC6
37348C
37349      CHARACTER*4 ISUBN1
37350      CHARACTER*4 ISUBN2
37351      CHARACTER*4 ISTEPN
37352C
37353C---------------------------------------------------------------------
37354C
37355      DIMENSION Y1(*)
37356      DIMENSION Y2(*)
37357      DIMENSION XIDTEM(*)
37358      DIMENSION XMAT(MAXLEV,MAXLEV)
37359C
37360C
37361      PARAMETER (NUMALP=5)
37362CCCCC DIMENSION SIGVAL(NUMALP)
37363C
37364      DOUBLE PRECISION DCDF
37365      DOUBLE PRECISION DPPF
37366C
37367      PARAMETER(NUMCLI=6)
37368      PARAMETER(MAXLIN=3)
37369      PARAMETER (MAXROW=NUMALP)
37370      PARAMETER (MAXRO2=30)
37371      CHARACTER*60 ITITLE
37372      CHARACTER*60 ITITLZ
37373      CHARACTER*60 ITITL9
37374      CHARACTER*60 ITEXT(MAXRO2)
37375      CHARACTER*4  ALIGN(NUMCLI)
37376      CHARACTER*4  VALIGN(NUMCLI)
37377      REAL         AVALUE(MAXRO2)
37378      INTEGER      NCTEXT(MAXRO2)
37379      INTEGER      IDIGIT(MAXRO2)
37380      INTEGER      IDIGI2(MAXROW,NUMCLI)
37381      INTEGER      NTOT(MAXRO2)
37382      INTEGER      ROWSEP(MAXROW)
37383      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
37384      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
37385      CHARACTER*4  ITYPCO(NUMCLI)
37386      INTEGER      NCTIT2(MAXLIN,NUMCLI)
37387      INTEGER      NCVALU(MAXROW,NUMCLI)
37388      INTEGER      NCOLSP(MAXLIN,NUMCLI)
37389      INTEGER      IWHTML(NUMCLI)
37390      INTEGER      IWRTF(NUMCLI)
37391      REAL         AMAT(MAXROW,NUMCLI)
37392      LOGICAL IFRST
37393      LOGICAL ILAST
37394      LOGICAL IFLAGS
37395      LOGICAL IFLAGE
37396C
37397C-----COMMON----------------------------------------------------------
37398C
37399      INCLUDE 'DPCOST.INC'
37400      INCLUDE 'DPCOP2.INC'
37401C
37402CCCCC DATA SIGVAL /0.50, 0.80, 0.90, 0.95, 0.99, 0.999/
37403CCCCC DATA SIGVAL /0.50, 0.80, 0.90, 0.95, 0.99/
37404C
37405C-----START POINT-----------------------------------------------------
37406C
37407      ISUBN1='DPMC'
37408      ISUBN2='N2  '
37409      IERROR='NO'
37410      IWRITE='NO'
37411C
37412      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MCN2')THEN
37413        WRITE(ICOUT,999)
37414  999   FORMAT(1X)
37415        CALL DPWRST('XXX','WRIT')
37416        WRITE(ICOUT,51)
37417   51   FORMAT('**** AT THE BEGINNING OF DPMCN2--')
37418        CALL DPWRST('XXX','WRIT')
37419        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASE,IBINCC
37420   52   FORMAT('IBUGA3,ISUBRO,ICASE,IBINCC = ',4(A4,2X))
37421        CALL DPWRST('XXX','WRIT')
37422        IF(ICASE.EQ.'VARI')THEN
37423          WRITE(ICOUT,55)N1
37424   55     FORMAT('N1 = ',I8)
37425          CALL DPWRST('XXX','WRIT')
37426          DO56I=1,N1
37427            WRITE(ICOUT,57)I,Y1(I)
37428   57       FORMAT('I,Y1(I) = ',I8,G15.7)
37429            CALL DPWRST('XXX','WRIT')
37430   56     CONTINUE
37431          WRITE(ICOUT,65)N2
37432   65     FORMAT('N2 = ',I8)
37433          CALL DPWRST('XXX','WRIT')
37434          DO66I=1,N2
37435            WRITE(ICOUT,67)I,Y2(I)
37436   67       FORMAT('I,Y2(I) = ',I8,G15.7)
37437            CALL DPWRST('XXX','WRIT')
37438   66     CONTINUE
37439        ELSE
37440          WRITE(ICOUT,75)AN11,AN21,AN12,AN22
37441   75     FORMAT('AN11,AN21,AN12,AN22 = ',4G15.7)
37442          CALL DPWRST('XXX','WRIT')
37443        ENDIF
37444      ENDIF
37445C
37446C               ********************************************
37447C               **  STEP 0--                              **
37448C               **  BRANCH TO APPROPRIATE CASE (PARAMETER **
37449C               **  OR VARIABLE)                          **
37450C               ********************************************
37451C
37452      ISTEPN='00'
37453      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCN2')
37454     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37455C
37456      IF(ICASE.EQ.'PARA')GOTO1000
37457      IF(ICASE.EQ.'VARI')GOTO2000
37458      IF(ICASE.EQ.'TABL')GOTO3000
37459C
37460C               ********************************************
37461C               **  STEP 11--                             **
37462C               **  PARAMETER CASE                        **
37463C               ********************************************
37464C
37465 1000 CONTINUE
37466C
37467      ISTEPN='11'
37468      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCN2')
37469     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37470C
37471C               ********************************************
37472C               **  STEP 12--                             **
37473C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
37474C               ********************************************
37475C
37476      N11=INT(AN11+0.5)
37477      N21=INT(AN21+0.5)
37478      N12=INT(AN12+0.5)
37479      N22=INT(AN22+0.5)
37480C
37481      ISTEPN='12'
37482      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCN2')
37483     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37484C
37485      IF(N11.LT.0)THEN
37486        WRITE(ICOUT,999)
37487        CALL DPWRST('XXX','BUG ')
37488        WRITE(ICOUT,1201)
37489 1201   FORMAT('***** ERROR FROM THE MCNEMAR TEST--')
37490        CALL DPWRST('XXX','BUG ')
37491        WRITE(ICOUT,1203)
37492 1203   FORMAT('      THE VALUE OF THE FIRST PARAMETER (N11 = THE ',
37493     1         'NUMBER OF SUCCESSES')
37494        CALL DPWRST('XXX','BUG ')
37495        WRITE(ICOUT,1204)
37496 1204   FORMAT('      FOR THE FIRST VARIABLE MUST BE NON-NEGATIVE.')
37497        CALL DPWRST('XXX','BUG ')
37498        WRITE(ICOUT,1205)N11
37499 1205   FORMAT('      N11 = ',I8)
37500        CALL DPWRST('XXX','BUG ')
37501        IERROR='YES'
37502        GOTO9000
37503      ENDIF
37504C
37505      IF(N21.LT.0)THEN
37506        WRITE(ICOUT,999)
37507        CALL DPWRST('XXX','BUG ')
37508        WRITE(ICOUT,1201)
37509        CALL DPWRST('XXX','BUG ')
37510        WRITE(ICOUT,1303)
37511 1303   FORMAT('      THE VALUE OF THE SECOND PARAMETER (N21 = THE ',
37512     1         'NUMBER OF FAILURES')
37513        CALL DPWRST('XXX','BUG ')
37514        WRITE(ICOUT,1304)
37515 1304   FORMAT('      FOR THE FIRST VARIABLE MUST BE NON-NEGATIVE.')
37516        CALL DPWRST('XXX','BUG ')
37517        WRITE(ICOUT,1305)N21
37518 1305   FORMAT('      N21 = ',I8)
37519        CALL DPWRST('XXX','BUG ')
37520        IERROR='YES'
37521        GOTO9000
37522      ENDIF
37523C
37524      IF(N12.LT.0)THEN
37525        WRITE(ICOUT,999)
37526        CALL DPWRST('XXX','BUG ')
37527        WRITE(ICOUT,1201)
37528        CALL DPWRST('XXX','BUG ')
37529        WRITE(ICOUT,1403)
37530 1403   FORMAT('      THE VALUE OF THE THIRD PARAMETER (N12 = THE ',
37531     1         'NUMBER OF SUCCESSES')
37532        CALL DPWRST('XXX','BUG ')
37533        WRITE(ICOUT,1404)
37534 1404   FORMAT('      FOR THE SECOND VARIABLE MUST BE NON-NEGATIVE.')
37535        CALL DPWRST('XXX','BUG ')
37536        WRITE(ICOUT,1405)N12
37537 1405   FORMAT('      N12 = ',I8)
37538        CALL DPWRST('XXX','BUG ')
37539        IERROR='YES'
37540        GOTO9000
37541      ENDIF
37542C
37543      IF(N22.LT.0)THEN
37544        WRITE(ICOUT,999)
37545        CALL DPWRST('XXX','BUG ')
37546        WRITE(ICOUT,1201)
37547        CALL DPWRST('XXX','BUG ')
37548        WRITE(ICOUT,1503)
37549 1503   FORMAT('      THE VALUE OF THE FOURTH PARAMETER (N22 = THE ',
37550     1         'NUMBER OF FAILURES')
37551        CALL DPWRST('XXX','BUG ')
37552        WRITE(ICOUT,1504)
37553 1504   FORMAT('      FOR THE SECOND VARIABLE MUST BE NON-NEGATIVE.')
37554        CALL DPWRST('XXX','BUG ')
37555        WRITE(ICOUT,1505)N22
37556 1505   FORMAT('      N22 = ',I8)
37557        CALL DPWRST('XXX','BUG ')
37558        IERROR='YES'
37559        GOTO9000
37560      ENDIF
37561C
37562C               ********************************************
37563C               **  STEP 12--                             **
37564C               **  COMPUTE THE LOG ODDS RATIO TEST       **
37565C               ********************************************
37566C
37567C
37568      GOTO4000
37569C
37570C               ********************************************
37571C               **  STEP 20--                             **
37572C               **  VARIABLE  CASE                        **
37573C               ********************************************
37574C
37575 2000 CONTINUE
37576C
37577C               ********************************************
37578C               **  STEP 21--                             **
37579C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
37580C               ********************************************
37581C
37582      ISTEPN='21'
37583      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCN2')
37584     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37585C
37586      IF(N1.LT.2)THEN
37587        WRITE(ICOUT,999)
37588        CALL DPWRST('XXX','WRIT')
37589        WRITE(ICOUT,1201)
37590        CALL DPWRST('XXX','WRIT')
37591        WRITE(ICOUT,2101)
37592 2101   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
37593     1         'IS NON-POSITIVE')
37594        CALL DPWRST('XXX','WRIT')
37595        WRITE(ICOUT,2103)N1
37596 2103   FORMAT('SAMPLE SIZE = ',I8)
37597        CALL DPWRST('XXX','WRIT')
37598        IERROR='YES'
37599        GOTO9000
37600      ENDIF
37601C
37602      IF(N2.LT.2)THEN
37603        WRITE(ICOUT,999)
37604        CALL DPWRST('XXX','WRIT')
37605        WRITE(ICOUT,1201)
37606        CALL DPWRST('XXX','WRIT')
37607        WRITE(ICOUT,2106)
37608 2106   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 2 ',
37609     1         'IS NON-POSITIVE')
37610        CALL DPWRST('XXX','WRIT')
37611        WRITE(ICOUT,2103)N2
37612        CALL DPWRST('XXX','WRIT')
37613        IERROR='YES'
37614        GOTO9000
37615      ENDIF
37616C
37617C               ********************************************
37618C               **  STEP 22--                             **
37619C               **  CHECK THAT THE VARIABLES HAVE AT MOST **
37620C               **  TWO DISTINCT VALUES (1 INDICATES A    **
37621C               **  SUCCESS, 0 INDICATES A FAILURE).      **
37622C               ********************************************
37623C
37624      ISTEPN='22'
37625      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCN2')
37626     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37627C
37628      CALL DISTIN(Y1,N1,IWRITE,XIDTEM,NDIST,IBUGA3,IERROR)
37629      IF(NDIST.EQ.1)THEN
37630        AVAL=XIDTEM(1)
37631        IF(ABS(AVAL).LE.0.5)THEN
37632          AVAL=0.0
37633        ELSE
37634          AVAL=1.0
37635        ENDIF
37636        DO2202I=1,N1
37637          Y1(I)=1.0
37638 2202   CONTINUE
37639      ELSEIF(NDIST.EQ.2)THEN
37640        IF(XIDTEM(1).EQ.1.0 .OR. XIDTEM(2).EQ.1.0)THEN
37641          DO2203I=1,N1
37642            IF(Y1(I).NE.1.0)Y1(I)=0.0
37643 2203     CONTINUE
37644        ELSE
37645          ATEMP1=MIN(XIDTEM(1),XIDTEM(2))
37646          ATEMP2=MAX(XIDTEM(1),XIDTEM(2))
37647          DO2208I=1,N1
37648            IF(Y1(I).EQ.ATEMP1)Y1(I)=0.0
37649            IF(Y1(I).EQ.ATEMP2)Y1(I)=1.0
37650 2208     CONTINUE
37651        ENDIF
37652      ELSE
37653        WRITE(ICOUT,999)
37654        CALL DPWRST('XXX','BUG ')
37655        WRITE(ICOUT,1201)
37656        CALL DPWRST('XXX','BUG ')
37657        WRITE(ICOUT,2211)
37658 2211   FORMAT('      RESPONSE VARIABLE ONE SHOULD CONTAIN AT MOST')
37659        CALL DPWRST('XXX','BUG ')
37660        WRITE(ICOUT,2213)
37661 2213   FORMAT('      TWO DISTINCT VALUES.')
37662        CALL DPWRST('XXX','BUG ')
37663        WRITE(ICOUT,2215)NDIST
37664 2215   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
37665        CALL DPWRST('XXX','BUG ')
37666        IERROR='YES'
37667        GOTO9000
37668      ENDIF
37669C
37670      CALL SUMDP(Y1,N1,IWRITE,XSUM,IBUGA3,IERROR)
37671      AN11=XSUM
37672      N11=INT(AN11+0.5)
37673      N21=N1-N11
37674      AN21=REAL(N21)
37675C
37676      CALL DISTIN(Y2,N2,IWRITE,XIDTEM,NDIST,IBUGA3,IERROR)
37677      IF(NDIST.EQ.1)THEN
37678        AVAL=XIDTEM(1)
37679        IF(ABS(AVAL).LE.0.5)THEN
37680          AVAL=0.0
37681        ELSE
37682          AVAL=1.0
37683        ENDIF
37684        DO2302I=1,N2
37685          Y2(I)=1.0
37686 2302   CONTINUE
37687      ELSEIF(NDIST.EQ.2)THEN
37688        IF(XIDTEM(1).EQ.1.0 .OR. XIDTEM(2).EQ.1.0)THEN
37689          DO2303I=1,N2
37690            IF(Y2(I).NE.1.0)Y2(I)=0.0
37691 2303     CONTINUE
37692        ELSE
37693          ATEMP1=MIN(XIDTEM(1),XIDTEM(2))
37694          ATEMP2=MAX(XIDTEM(1),XIDTEM(2))
37695          DO2308I=1,N2
37696            IF(Y2(I).EQ.ATEMP1)Y2(I)=0.0
37697            IF(Y2(I).EQ.ATEMP2)Y2(I)=1.0
37698 2308     CONTINUE
37699        ENDIF
37700      ELSE
37701        WRITE(ICOUT,999)
37702        CALL DPWRST('XXX','BUG ')
37703        WRITE(ICOUT,1201)
37704        CALL DPWRST('XXX','BUG ')
37705        WRITE(ICOUT,2311)
37706 2311   FORMAT('      RESPONSE VARIABLE TWO SHOULD CONTAIN AT MOST')
37707        CALL DPWRST('XXX','BUG ')
37708        WRITE(ICOUT,2313)
37709 2313   FORMAT('      TWO DISTINCT VALUES.')
37710        CALL DPWRST('XXX','BUG ')
37711        WRITE(ICOUT,2315)NDIST
37712 2315   FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
37713        CALL DPWRST('XXX','BUG ')
37714        IERROR='YES'
37715        GOTO9000
37716      ENDIF
37717C
37718      CALL SUMDP(Y2,N2,IWRITE,XSUM,IBUGA3,IERROR)
37719      AN12=XSUM
37720      N12=INT(AN12+0.5)
37721      N22=N2-N12
37722      AN22=REAL(N22)
37723C
37724      GOTO4000
37725C
37726 3000 CONTINUE
37727C
37728C               ********************************************
37729C               **  STEP 31--                             **
37730C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
37731C               **  ALL TABLE ENTRIES SHOULD BE           **
37732C               **  NON-NEGATIVE INTEGERS.  NEGATIVE      **
37733C               **  VALUES WILL BE FLAGGED AS ERRORS      **
37734C               **  WHILE NON-INTEGER VALUES WILL BE      **
37735C               **  ROUNDED TO NEAREST INTEGER.           **
37736C               **  SINCE WE ARE SCANNING TABLE, COMPUTE  **
37737C               **  ROW AND COLUMN TOTALS.                **
37738C               **  NOTE THAT FOR THIS COMMAND IS         **
37739C               **  COMPUTED ON A 2X2 CONTINGENCY TABLE.  **
37740C               **  THEREFORE:                            **
37741C               **  1) IF NUMBER OF COLUMNS NOT EQUAL     **
37742C               **     TWO, FLAG AN ERROR.                **
37743C               **  2) IF NUMBER OF ROWS EQUAL TWO, THEN  **
37744C               **     EXTRACT THE RELEVANT 4 VALUES AND  **
37745C               **     GO TO THE PARAMETER CASE.          **
37746C               **  3) IF NUMBER OF ROWS GREATER THAN     **
37747C               **     TWO, THEN NEED TO CROSS-TABULATE   **
37748C               **     (I.E., HAVE THE VARIABLE CASE).    **
37749C               ********************************************
37750C
37751      ISTEPN='31'
37752      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ODR2')
37753     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37754C
37755      IERROR='NO'
37756C
37757      IF(NCOL.NE.2)THEN
37758        WRITE(ICOUT,999)
37759        CALL DPWRST('XXX','WRIT')
37760        WRITE(ICOUT,1201)
37761        CALL DPWRST('XXX','WRIT')
37762        WRITE(ICOUT,3101)
37763 3101   FORMAT('      THE NUMBER OF COLUMNS IN THE INPUT MATRIX')
37764        CALL DPWRST('XXX','WRIT')
37765        WRITE(ICOUT,3103)
37766 3103   FORMAT('      MUST BE EXACTLY TWO; SUCH WAS NOT THE CASE ',
37767     1         'HERE.')
37768        CALL DPWRST('XXX','WRIT')
37769        WRITE(ICOUT,3105)NCOL
37770 3105   FORMAT('      THE NUMBER OF COLUMNS = ',I8)
37771        CALL DPWRST('XXX','WRIT')
37772        IERROR='YES'
37773        GOTO9000
37774      ENDIF
37775C
37776      IF(NROW.EQ.2)THEN
37777        AN11=XMAT(1,1)
37778        AN21=XMAT(2,1)
37779        AN12=XMAT(1,2)
37780        AN22=XMAT(2,2)
37781        GOTO1000
37782      ELSE
37783        DO3120I=1,NROW
37784          Y1(NROW)=XMAT(I,1)
37785          Y2(NROW)=XMAT(I,2)
37786 3120   CONTINUE
37787        N1=NROW
37788        N2=NROW
37789        GOTO2000
37790      ENDIF
37791C
37792 4000 CONTINUE
37793C
37794      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCN2')
37795     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37796C
37797C     COMPUTE THE MCNEMAR TEST.
37798C
37799      NR1=N11+N12
37800      NR2=N21+N22
37801      NC1=N11+N21
37802      NC2=N12+N22
37803      NTOTZZ=NR1+NR2
37804      ANR1=REAL(NR1)
37805      ANR2=REAL(NR2)
37806      ANC1=REAL(NC1)
37807      ANC2=REAL(NC2)
37808      AN=REAL(NTOTZZ)
37809C
37810      A=REAL(N11)
37811      B=REAL(N12)
37812      C=REAL(N21)
37813      D=REAL(N22)
37814C
37815      P11=A/ANC1
37816      P21=C/ANC1
37817      P12=B/ANC2
37818      P22=D/ANC2
37819C
37820      ICONC1='REJECT'
37821      ICONC2='REJECT'
37822      ICONC3='REJECT'
37823      ICONC4='REJECT'
37824      ICONC5='REJECT'
37825      ICONC6='REJECT'
37826      KCONC1='REJECT'
37827      KCONC2='REJECT'
37828      KCONC3='REJECT'
37829      KCONC4='REJECT'
37830      KCONC5='REJECT'
37831      KCONC6='REJECT'
37832C
37833      IF(B+C.LE.20.0)THEN
37834        STATVA=B
37835        STATV2=B
37836        P=0.5
37837        NTEMP=INT(B+C+0.5)
37838        CALL BINCDF(DBLE(STATVA),DBLE(P),NTEMP,DCDF)
37839        CDF2=REAL(DCDF)
37840C
37841        ALPHA=0.50
37842        ALPHAL=(1.0 - ALPHA)/2.0
37843        ALPHAU=1.0 - ALPHAL
37844        CALL BINPPF(DBLE(ALPHAL),DBLE(P),NTEMP,DPPF)
37845        CV1L=REAL(DPPF)
37846        CALL BINPPF(DBLE(ALPHAU),DBLE(P),NTEMP,DPPF)
37847        CV1U=REAL(DPPF)
37848        IF(CDF.GE.ALPHAL.AND.CDF.LE.ALPHAU)ICONC1='ACCEPT'
37849C
37850        ALPHA=0.80
37851        ALPHAL=(1.0 - ALPHA)/2.0
37852        ALPHAU=1.0 - ALPHAL
37853        CALL BINPPF(DBLE(ALPHAL),DBLE(P),NTEMP,DPPF)
37854        CV2L=REAL(DPPF)
37855        CALL BINPPF(DBLE(ALPHAU),DBLE(P),NTEMP,DPPF)
37856        CV2U=REAL(DPPF)
37857        IF(CDF.GE.ALPHAL.AND.CDF.LE.ALPHAU)ICONC2='ACCEPT'
37858C
37859        ALPHA=0.90
37860        ALPHAL=(1.0 - ALPHA)/2.0
37861        ALPHAU=1.0 - ALPHAL
37862        CALL BINPPF(DBLE(ALPHAL),DBLE(P),NTEMP,DPPF)
37863        CV3L=REAL(DPPF)
37864        CALL BINPPF(DBLE(ALPHAU),DBLE(P),NTEMP,DPPF)
37865        CV3U=REAL(DPPF)
37866        IF(CDF.GE.ALPHAL.AND.CDF.LE.ALPHAU)ICONC3='ACCEPT'
37867C
37868        ALPHA=0.95
37869        ALPHAL=(1.0 - ALPHA)/2.0
37870        ALPHAU=1.0 - ALPHAL
37871        CALL BINPPF(DBLE(ALPHAL),DBLE(P),NTEMP,DPPF)
37872        CV4L=REAL(DPPF)
37873        CALL BINPPF(DBLE(ALPHAU),DBLE(P),NTEMP,DPPF)
37874        CV4U=REAL(DPPF)
37875        IF(CDF.GE.ALPHAL.AND.CDF.LE.ALPHAU)ICONC4='ACCEPT'
37876C
37877        ALPHA=0.98
37878        ALPHAL=(1.0 - ALPHA)/2.0
37879        ALPHAU=1.0 - ALPHAL
37880        CALL BINPPF(DBLE(ALPHAL),DBLE(P),NTEMP,DPPF)
37881        CV5L=REAL(DPPF)
37882        CALL BINPPF(DBLE(ALPHAU),DBLE(P),NTEMP,DPPF)
37883        CV5U=REAL(DPPF)
37884        IF(CDF.GE.ALPHAL.AND.CDF.LE.ALPHAU)ICONC5='ACCEPT'
37885C
37886        ALPHA=0.99
37887        ALPHAL=(1.0 - ALPHA)/2.0
37888        ALPHAU=1.0 - ALPHAL
37889        CALL BINPPF(DBLE(ALPHAL),DBLE(P),NTEMP,DPPF)
37890        CV6L=REAL(DPPF)
37891        CALL BINPPF(DBLE(ALPHAU),DBLE(P),NTEMP,DPPF)
37892        CV6U=REAL(DPPF)
37893        IF(CDF.GE.ALPHAL.AND.CDF.LE.ALPHAU)ICONC6='ACCEPT'
37894C
37895      ELSE
37896        STATVA=(B-C)**2/(B+C)
37897        STATV2=(ABS(B-C) - 1.0)**2/(B+C)
37898        NU=1
37899        CALL CHSCDF(STATVA,NU,CDF)
37900        CALL CHSCDF(STATV2,NU,CDF2)
37901        ALPHA=0.50
37902        CALL CHSPPF(ALPHA,NU,CV1)
37903        ALPHA=0.80
37904        CALL CHSPPF(ALPHA,NU,CV2)
37905        ALPHA=0.90
37906        CALL CHSPPF(ALPHA,NU,CV3)
37907        ALPHA=0.95
37908        CALL CHSPPF(ALPHA,NU,CV4)
37909        ALPHA=0.99
37910        CALL CHSPPF(ALPHA,NU,CV5)
37911C
37912        IF(0.0.LE.CDF.AND.CDF.LE.0.500)ICONC1='ACCEPT'
37913        IF(0.0.LE.CDF.AND.CDF.LE.0.800)ICONC2='ACCEPT'
37914        IF(0.0.LE.CDF.AND.CDF.LE.0.900)ICONC3='ACCEPT'
37915        IF(0.0.LE.CDF.AND.CDF.LE.0.950)ICONC4='ACCEPT'
37916        IF(0.0.LE.CDF.AND.CDF.LE.0.990)ICONC5='ACCEPT'
37917C
37918        IF(0.0.LE.CDF2.AND.CDF2.LE.0.500)KCONC1='ACCEPT'
37919        IF(0.0.LE.CDF2.AND.CDF2.LE.0.800)KCONC2='ACCEPT'
37920        IF(0.0.LE.CDF2.AND.CDF2.LE.0.900)KCONC3='ACCEPT'
37921        IF(0.0.LE.CDF2.AND.CDF2.LE.0.950)KCONC4='ACCEPT'
37922        IF(0.0.LE.CDF2.AND.CDF2.LE.0.990)KCONC5='ACCEPT'
37923C
37924      ENDIF
37925C
37926      IWRITE='OFF'
37927C
37928C               ******************************
37929C               **   STEP 42--              **
37930C               **   WRITE OUT EVERYTHING   **
37931C               **   FOR ODDS RATIO   TEST  **
37932C               ******************************
37933C
37934      ISTEPN='42'
37935      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCN2')
37936     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
37937C
37938C     PRINT SUMMARY STATISTICS TABLE
37939C
37940      IF(IPRINT.EQ.'OFF')GOTO9000
37941C
37942      NUMDIG=7
37943      IF(IFORSW.EQ.'1')NUMDIG=1
37944      IF(IFORSW.EQ.'2')NUMDIG=2
37945      IF(IFORSW.EQ.'3')NUMDIG=3
37946      IF(IFORSW.EQ.'4')NUMDIG=4
37947      IF(IFORSW.EQ.'5')NUMDIG=5
37948      IF(IFORSW.EQ.'6')NUMDIG=6
37949      IF(IFORSW.EQ.'7')NUMDIG=7
37950      IF(IFORSW.EQ.'8')NUMDIG=8
37951      IF(IFORSW.EQ.'9')NUMDIG=9
37952      IF(IFORSW.EQ.'0')NUMDIG=0
37953      IF(IFORSW.EQ.'E')NUMDIG=-2
37954      IF(IFORSW.EQ.'-2')NUMDIG=-2
37955      IF(IFORSW.EQ.'-3')NUMDIG=-3
37956      IF(IFORSW.EQ.'-4')NUMDIG=-4
37957      IF(IFORSW.EQ.'-5')NUMDIG=-5
37958      IF(IFORSW.EQ.'-6')NUMDIG=-6
37959      IF(IFORSW.EQ.'-7')NUMDIG=-7
37960      IF(IFORSW.EQ.'-8')NUMDIG=-8
37961      IF(IFORSW.EQ.'-9')NUMDIG=-9
37962C
37963      ITITLE='McNemar Test for New Better Than Old'
37964      NCTITL=36
37965      ITITLZ='(2x2 Table)'
37966      NCTITZ=11
37967C
37968      ICNT=0
37969      ICNT=ICNT+1
37970      ITEXT(ICNT)=' '
37971      NCTEXT(ICNT)=0
37972      AVALUE(ICNT)=0.0
37973      IDIGIT(ICNT)=-1
37974      ICNT=ICNT+1
37975      ITEXT(ICNT)='H0: New and Old are Equal'
37976      NCTEXT(ICNT)=25
37977      AVALUE(ICNT)=0.0
37978      IDIGIT(ICNT)=-1
37979      ICNT=ICNT+1
37980      ITEXT(ICNT)='Ha: New and Old are Not Equal'
37981      NCTEXT(ICNT)=29
37982      AVALUE(ICNT)=0.0
37983      IDIGIT(ICNT)=-1
37984      ICNT=ICNT+1
37985      ITEXT(ICNT)=' '
37986      NCTEXT(ICNT)=0
37987      AVALUE(ICNT)=0.0
37988      IDIGIT(ICNT)=-1
37989C
37990      NUMROW=ICNT
37991      DO2310I=1,NUMROW
37992        NTOT(I)=15
37993 2310 CONTINUE
37994C
37995      IFRST=.TRUE.
37996      ILAST=.TRUE.
37997      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
37998     1            NCTEXT,AVALUE,IDIGIT,
37999     1            NTOT,NUMROW,
38000     1            ICAPSW,ICAPTY,ILAST,IFRST,
38001     1            ISUBRO,IBUGA3,IERROR)
38002C
38003      ITITLE(1:13)='Summary Table'
38004      NCTITL=13
38005      ITITL9=' '
38006      NCTIT9=0
38007C
38008      NUMCOL=6
38009      NUMLIN=2
38010C
38011      ITITL2(1,1)=' '
38012      NCTIT2(1,1)=0
38013      NCOLSP(1,1)=1
38014      ITITL2(2,1)='Variable One'
38015      NCTIT2(2,1)=12
38016      NCOLSP(2,1)=1
38017      ITITL2(1,2)=' | '
38018      NCTIT2(1,2)=3
38019      NCOLSP(1,2)=1
38020      ITITL2(2,2)=' | '
38021      NCTIT2(2,2)=3
38022      NCOLSP(2,2)=1
38023C
38024      ITITL2(1,3)='Variable Two'
38025      NCTIT2(1,3)=12
38026      NCOLSP(1,3)=2
38027      ITITL2(2,3)='Successes'
38028      NCTIT2(2,3)=9
38029      NCOLSP(2,3)=1
38030      ITITL2(1,4)=' '
38031      NCTIT2(1,4)=0
38032      NCOLSP(1,4)=0
38033      ITITL2(2,4)='Failures'
38034      NCTIT2(2,4)=8
38035      NCOLSP(2,4)=1
38036C
38037      ITITL2(1,5)=' | '
38038      NCTIT2(1,5)=3
38039      NCOLSP(1,5)=1
38040      ITITL2(2,5)=' | '
38041      NCTIT2(2,5)=3
38042      NCOLSP(2,5)=1
38043C
38044      ITITL2(1,6)='Row'
38045      NCTIT2(1,6)=3
38046      NCOLSP(1,6)=1
38047      ITITL2(2,6)='Total'
38048      NCTIT2(2,6)=5
38049      NCOLSP(2,6)=1
38050C
38051      NMAX=0
38052      DO4210I=1,NUMCOL
38053        VALIGN(I)='b'
38054        ALIGN(I)='r'
38055        NTOT(I)=15
38056        IF(I.EQ.2 .OR. I.EQ.5)NTOT(I)=3
38057        NMAX=NMAX+NTOT(I)
38058        ITYPCO(I)='NUME'
38059        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)ITYPCO(I)='ALPH'
38060        DO4213J=1,MAXROW
38061          IDIGI2(J,I)=0
38062          IF(I.EQ.3 .OR. I.EQ.4)THEN
38063            IF(J.EQ.2 .OR. J.EQ.4)THEN
38064              IDIGI2(J,I)=NUMDIG
38065            ENDIF
38066          ENDIF
38067          IF(I.EQ.6)THEN
38068            IF(J.EQ.2 .OR. J.EQ.4)THEN
38069              IDIGI2(J,I)=-1
38070            ELSE
38071              IDIGI2(J,I)=0
38072            ENDIF
38073          ENDIF
38074 4213   CONTINUE
38075C
38076 4210 CONTINUE
38077C
38078      DO4289J=1,MAXROW
38079        IVALUE(J,1)=' '
38080        IVALUE(J,2)=' '
38081        IVALUE(J,3)=' '
38082        IVALUE(J,4)=' '
38083        IVALUE(J,5)=' '
38084        IVALUE(J,6)=' '
38085        NCVALU(J,1)=0
38086        NCVALU(J,2)=0
38087        NCVALU(J,3)=0
38088        NCVALU(J,4)=0
38089        NCVALU(J,5)=0
38090        NCVALU(J,6)=0
38091        AMAT(J,1)=0.0
38092        AMAT(J,2)=0.0
38093        AMAT(J,3)=0.0
38094        AMAT(J,4)=0.0
38095        AMAT(J,5)=0.0
38096        AMAT(J,6)=0.0
38097        ROWSEP(J)=0
38098 4289 CONTINUE
38099      AMAT(1,3)=REAL(N11)
38100      AMAT(1,4)=REAL(N12)
38101      AMAT(1,6)=REAL(NR1)
38102      AMAT(2,3)=P11
38103      AMAT(2,4)=P12
38104      AMAT(2,6)=CPUMIN
38105      AMAT(3,3)=REAL(N21)
38106      AMAT(3,4)=REAL(N22)
38107      AMAT(3,6)=REAL(NR2)
38108      AMAT(4,3)=P21
38109      AMAT(4,4)=P22
38110      AMAT(4,6)=CPUMIN
38111      AMAT(5,3)=REAL(NC1)
38112      AMAT(5,4)=REAL(NC2)
38113      AMAT(5,6)=REAL(NTOTZZ)
38114      IVALUE(1,1)='Successes'
38115      NCVALU(1,1)=9
38116      IVALUE(1,2)=' | '
38117      NCVALU(1,2)=3
38118      IVALUE(1,5)=' | '
38119      NCVALU(1,5)=3
38120      IVALUE(2,2)=' | '
38121      NCVALU(2,2)=3
38122      IVALUE(2,5)=' | '
38123      NCVALU(2,5)=3
38124      IVALUE(3,1)='Failures'
38125      NCVALU(3,1)=8
38126      IVALUE(3,2)=' | '
38127      NCVALU(3,2)=3
38128      IVALUE(3,5)=' | '
38129      NCVALU(3,5)=3
38130      IVALUE(4,2)=' | '
38131      NCVALU(4,2)=3
38132      IVALUE(4,5)=' | '
38133      NCVALU(4,5)=3
38134      IVALUE(5,1)='Column Total'
38135      NCVALU(5,1)=12
38136      IVALUE(5,2)=' | '
38137      NCVALU(5,2)=3
38138      IVALUE(5,5)=' | '
38139      NCVALU(5,5)=3
38140      ROWSEP(4)=1
38141C
38142      IWHTML(1)=150
38143      IWHTML(2)=25
38144      IWHTML(3)=150
38145      IWHTML(4)=150
38146      IWHTML(5)=25
38147      IWHTML(6)=150
38148      IINC=1800
38149      IINC2=200
38150      IWRTF(1)=IINC
38151      IWRTF(2)=IWRTF(1)+IINC2
38152      IWRTF(3)=IWRTF(2)+IINC
38153      IWRTF(4)=IWRTF(3)+IINC
38154      IWRTF(5)=IWRTF(4)+IINC2
38155      IWRTF(6)=IWRTF(5)+IINC
38156C
38157      ICNT=5
38158      IFRST=.TRUE.
38159      ILAST=.TRUE.
38160      IFLAGS=.TRUE.
38161      IFLAGE=.TRUE.
38162      CALL DPDT5B(ITITLE,NCTITL,
38163     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
38164     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
38165     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
38166     1            IDIGI2,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
38167     1            NCOLSP,ROWSEP,
38168     1            ICAPSW,ICAPTY,IFRST,ILAST,
38169     1            IFLAGS,IFLAGE,
38170     1            ISUBRO,IBUGA3,IERROR)
38171C
38172      ITITLE=' '
38173      NCTITL=0
38174      ITITLZ=' '
38175      NCTITZ=0
38176C
38177      ICNT=0
38178      IF(NTOTZZ.LT.20)THEN
38179        ICNT=ICNT+1
38180        ITEXT(ICNT)='Small Sample Case (N < 20)'
38181        NCTEXT(ICNT)=26
38182        AVALUE(ICNT)=0.0
38183        IDIGIT(ICNT)=-1
38184        ICNT=ICNT+1
38185        ITEXT(ICNT)='Critical Values Based on Binomial with'
38186        NCTEXT(ICNT)=38
38187        AVALUE(ICNT)=0.0
38188        IDIGIT(ICNT)=-1
38189        ICNT=ICNT+1
38190        ITEXT(ICNT)='P = 0.5 and N = '
38191        WRITE(ITEXT(ICNT)(17:18),'(I2)')N12+N21
38192        NCTEXT(ICNT)=18
38193        AVALUE(ICNT)=0.0
38194        IDIGIT(ICNT)=-1
38195        ICNT=ICNT+1
38196        ITEXT(ICNT)='Value of Test Statistic:'
38197        NCTEXT(ICNT)=24
38198        AVALUE(ICNT)=STATVA
38199        IDIGIT(ICNT)=NUMDIG
38200        ICNT=ICNT+1
38201        ITEXT(ICNT)='CDF of Test Statistic:'
38202        NCTEXT(ICNT)=22
38203        AVALUE(ICNT)=CDF
38204        IDIGIT(ICNT)=NUMDIG
38205      ELSE
38206        ICNT=ICNT+1
38207        ITEXT(ICNT)='Large Sample Case (N >= 20)'
38208        NCTEXT(ICNT)=27
38209        AVALUE(ICNT)=0.0
38210        IDIGIT(ICNT)=-1
38211        ICNT=ICNT+1
38212        ITEXT(ICNT)='Critical Values Based on Chi-Square with'
38213        NCTEXT(ICNT)=40
38214        AVALUE(ICNT)=0.0
38215        IDIGIT(ICNT)=-1
38216        ICNT=ICNT+1
38217        ITEXT(ICNT)='One Degree of Freedom'
38218        NCTEXT(ICNT)=21
38219        AVALUE(ICNT)=0.0
38220        IDIGIT(ICNT)=-1
38221        ICNT=ICNT+1
38222        ITEXT(ICNT)=' '
38223        NCTEXT(ICNT)=0
38224        AVALUE(ICNT)=0.0
38225        IDIGIT(ICNT)=-1
38226        ICNT=ICNT+1
38227        ITEXT(ICNT)='Without Continuity Correction'
38228        NCTEXT(ICNT)=29
38229        AVALUE(ICNT)=0.0
38230        IDIGIT(ICNT)=-1
38231        ICNT=ICNT+1
38232        ITEXT(ICNT)='Value of Test Statistic:'
38233        NCTEXT(ICNT)=24
38234        AVALUE(ICNT)=STATVA
38235        IDIGIT(ICNT)=NUMDIG
38236        ICNT=ICNT+1
38237        ITEXT(ICNT)='CDF of Test Statistic:'
38238        NCTEXT(ICNT)=22
38239        AVALUE(ICNT)=CDF
38240        IDIGIT(ICNT)=NUMDIG
38241        ICNT=ICNT+1
38242        ITEXT(ICNT)=' '
38243        NCTEXT(ICNT)=0
38244        AVALUE(ICNT)=0.0
38245        IDIGIT(ICNT)=-1
38246        ICNT=ICNT+1
38247        ITEXT(ICNT)='With Continuity Correction'
38248        NCTEXT(ICNT)=26
38249        AVALUE(ICNT)=0.0
38250        IDIGIT(ICNT)=-1
38251        ICNT=ICNT+1
38252        ITEXT(ICNT)='Value of Test Statistic:'
38253        NCTEXT(ICNT)=24
38254        AVALUE(ICNT)=STATV2
38255        IDIGIT(ICNT)=NUMDIG
38256        ICNT=ICNT+1
38257        ITEXT(ICNT)='CDF of Test Statistic:'
38258        NCTEXT(ICNT)=22
38259        AVALUE(ICNT)=CDF2
38260        IDIGIT(ICNT)=NUMDIG
38261      ENDIF
38262C
38263      NUMROW=ICNT
38264      DO4310I=1,NUMROW
38265        NTOT(I)=15
38266 4310 CONTINUE
38267C
38268      IFRST=.TRUE.
38269      ILAST=.TRUE.
38270      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,
38271     1            NCTEXT,AVALUE,IDIGIT,
38272     1            NTOT,NUMROW,
38273     1            ICAPSW,ICAPTY,ILAST,IFRST,
38274     1            ISUBRO,IBUGA3,IERROR)
38275C
38276      IF(NTOTZZ.LT.20)THEN
38277      ELSE
38278        ITITLE(1:30)='Without Continuity Correction:'
38279        NCTITL=30
38280        ITITL9=' '
38281        NCTIT9=0
38282C
38283        ITITL2(1,1)=' '
38284        NCTIT2(1,1)=0
38285        ITITL2(2,1)='Null'
38286        NCTIT2(2,1)=4
38287        ITITL2(3,1)='Hypothesis'
38288        NCTIT2(3,1)=10
38289        ITITL2(1,2)=' '
38290        NCTIT2(1,2)=0
38291        ITITL2(2,2)='Confidence'
38292        NCTIT2(2,2)=10
38293        ITITL2(3,2)='Level'
38294        NCTIT2(3,2)=5
38295        ITITL2(1,3)=' '
38296        NCTIT2(1,3)=0
38297        ITITL2(2,3)='Critical'
38298        NCTIT2(2,3)=8
38299        ITITL2(3,3)='Value'
38300        NCTIT2(3,3)=5
38301        ITITL2(1,4)='Null Hypothesis'
38302        NCTIT2(1,4)=15
38303        ITITL2(2,4)='Acceptance'
38304        NCTIT2(2,4)=10
38305        ITITL2(3,4)='Interval'
38306        NCTIT2(3,4)=8
38307        ITITL2(1,5)='Null'
38308        NCTIT2(1,5)=4
38309        ITITL2(2,5)='Hypothesis'
38310        NCTIT2(2,5)=10
38311        ITITL2(3,5)='Conclusion'
38312        NCTIT2(3,5)=10
38313C
38314        NMAX=0
38315        NUMCOL=5
38316        DO5210I=1,NUMCOL
38317          VALIGN(I)='b'
38318          ALIGN(I)='r'
38319          NTOT(I)=15
38320          NMAX=NMAX+NTOT(I)
38321          IF(I.EQ.3)THEN
38322            ITYPCO(I)='NUME'
38323          ELSE
38324            ITYPCO(I)='ALPH'
38325          ENDIF
38326          IF(I.EQ.2)THEN
38327            IDIGIT(I)=1
38328          ELSEIF(I.EQ.3)THEN
38329            IDIGIT(I)=2
38330          ELSE
38331            IDIGIT(I)=NUMDIG
38332          ENDIF
38333          IWHTML(1)=150
38334          IWHTML(2)=125
38335          IWHTML(3)=125
38336          IWHTML(4)=150
38337          IWHTML(5)=150
38338          IINC=1600
38339          IINC2=1400
38340          IINC3=2200
38341          IWRTF(1)=1800
38342          IWRTF(2)=IWRTF(1)+IINC
38343          IWRTF(3)=IWRTF(2)+IINC2
38344          IWRTF(4)=IWRTF(3)+IINC3
38345          IWRTF(5)=IWRTF(4)+IINC2
38346C
38347          DO5289J=1,NUMALP
38348            IF(J.EQ.1)THEN
38349              IVALUE(J,2)='50.0%'
38350              NCVALU(J,2)=5
38351              AMAT(J,3)=CV1
38352              IVALUE(J,5)(1:6)=ICONC1(1:6)
38353              NCVALU(J,5)=6
38354              IVALUE(J,4)='(0,0.500)'
38355              NCVALU(J,4)=9
38356            ELSEIF(J.EQ.2)THEN
38357              IVALUE(J,2)='80.0%'
38358              NCVALU(J,2)=5
38359              AMAT(J,3)=CV2
38360              IVALUE(J,5)(1:6)=ICONC2(1:6)
38361              NCVALU(J,5)=6
38362              IVALUE(J,4)='(0,0.800)'
38363              NCVALU(J,4)=9
38364            ELSEIF(J.EQ.3)THEN
38365              IVALUE(J,2)='90.0%'
38366              NCVALU(J,2)=5
38367              AMAT(J,3)=CV3
38368              IVALUE(J,5)(1:6)=ICONC3(1:6)
38369              NCVALU(J,5)=6
38370              IVALUE(J,4)='(0,0.900)'
38371              NCVALU(J,4)=9
38372            ELSEIF(J.EQ.4)THEN
38373              IVALUE(J,2)='95.0%'
38374              NCVALU(J,2)=5
38375              AMAT(J,3)=CV4
38376              IVALUE(J,5)(1:6)=ICONC4(1:6)
38377              NCVALU(J,5)=6
38378              IVALUE(J,4)='(0,0.950)'
38379              NCVALU(J,4)=9
38380            ELSEIF(J.EQ.5)THEN
38381              IVALUE(J,2)='99.0%'
38382              NCVALU(J,2)=5
38383              AMAT(J,3)=CV5
38384              IVALUE(J,5)(1:6)=ICONC6(1:6)
38385              NCVALU(J,5)=6
38386              IVALUE(J,4)='(0,0.990)'
38387              NCVALU(J,4)=9
38388            ENDIF
38389            AMAT(J,1)=0.0
38390            AMAT(J,2)=0.0
38391            AMAT(J,4)=0.0
38392            AMAT(J,5)=0.0
38393            IVALUE(J,1)='New/Old Equal'
38394            NCVALU(J,1)=13
38395 5289     CONTINUE
38396C
38397 5210   CONTINUE
38398C
38399        ICNT=NUMALP
38400        NUMLIN=3
38401        NUMCOL=5
38402        IFRST=.TRUE.
38403        ILAST=.TRUE.
38404        IFLAGS=.TRUE.
38405        IFLAGE=.TRUE.
38406        CALL DPDTA5(ITITLE,NCTITL,
38407     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
38408     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
38409     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
38410     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
38411     1            ICAPSW,ICAPTY,IFRST,ILAST,
38412     1            IFLAGS,IFLAGE,
38413     1            ISUBRO,IBUGA3,IERROR)
38414C
38415        ITITLE(1:30)='With Continuity Correction:'
38416        NCTITL=27
38417C
38418        NUMCOL=5
38419        DO5310I=1,NUMCOL
38420C
38421          DO5389J=1,NUMALP
38422            IF(J.EQ.1)THEN
38423              IVALUE(J,5)(1:6)=KCONC1(1:6)
38424              NCVALU(J,5)=6
38425            ELSEIF(J.EQ.2)THEN
38426              IVALUE(J,5)(1:6)=KCONC2(1:6)
38427              NCVALU(J,5)=6
38428            ELSEIF(J.EQ.3)THEN
38429              IVALUE(J,5)(1:6)=KCONC3(1:6)
38430              NCVALU(J,5)=6
38431            ELSEIF(J.EQ.4)THEN
38432              IVALUE(J,5)(1:6)=KCONC4(1:6)
38433              NCVALU(J,5)=6
38434            ELSEIF(J.EQ.5)THEN
38435              IVALUE(J,5)(1:6)=KCONC5(1:6)
38436              NCVALU(J,5)=6
38437            ELSEIF(J.EQ.6)THEN
38438              IVALUE(J,5)(1:6)=KCONC6(1:6)
38439              NCVALU(J,5)=6
38440            ENDIF
38441 5389     CONTINUE
38442C
38443 5310   CONTINUE
38444C
38445        ICNT=NUMALP
38446        NUMLIN=3
38447        NUMCOL=5
38448        IFRST=.TRUE.
38449        ILAST=.TRUE.
38450        IFLAGS=.TRUE.
38451        IFLAGE=.TRUE.
38452        CALL DPDTA5(ITITLE,NCTITL,
38453     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
38454     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
38455     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
38456     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
38457     1            ICAPSW,ICAPTY,IFRST,ILAST,
38458     1            IFLAGS,IFLAGE,
38459     1            ISUBRO,IBUGA3,IERROR)
38460      ENDIF
38461C
38462C               *****************
38463C               **  STEP 90--  **
38464C               **  EXIT       **
38465C               *****************
38466C
38467 9000 CONTINUE
38468      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MCN2')THEN
38469        WRITE(ICOUT,999)
38470        CALL DPWRST('XXX','WRIT')
38471        WRITE(ICOUT,9011)
38472 9011   FORMAT('***** AT THE END       OF DPMCN2--')
38473        CALL DPWRST('XXX','WRIT')
38474        WRITE(ICOUT,9013)AN11,AN21,AN12,AN22
38475 9013   FORMAT('AN11,AN21,AN12,AN22=',4G15.7)
38476        CALL DPWRST('XXX','WRIT')
38477        WRITE(ICOUT,9015)AN1,AN2
38478 9015   FORMAT('AN1,AN2=',2G15.7)
38479        CALL DPWRST('XXX','WRIT')
38480        WRITE(ICOUT,9017)N11,N21,N12,N22
38481 9017   FORMAT('N11,N21,N12,N22=',4I8)
38482        CALL DPWRST('XXX','WRIT')
38483      ENDIF
38484C
38485      RETURN
38486      END
38487      SUBROUTINE DPMCWE(MAXNXT,ICAPSW,IFORSW,
38488     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
38489C
38490C     PURPOSE--CARRY OUT MCCOOL WEIBULL LOCATION TEST
38491C              (TESTS FOR 2-PARAMETER WEIBULL VERSUS 3-PARAMETER WEIBULL,
38492C              I.E,, IS LOCATION PARAMETER > 0)
38493C     EXAMPLE--MCCOOL WEIBULL LOCATION TEST Y X
38494C     REFERENCE --JOHN MCCOOL (1998), "INFERENCE ON THE WEIBULL LOCATION
38495C                 PARAMETER, JOURNAL OF QUALITY TECHNOLOGY, VOL. 30,
38496C                 NO. 2, PP. 119-126.
38497C               --JOHN MCCOOL (2012), "USING THE WEIBULL DISTRIBUTION:
38498C                 RELIABILITY, MODELING, AND INFERENCE", WILEY,
38499C                 PP. 301-307.
38500C               --HORST RINNE (2009), "THE WEIBULL DISTRIBUTION: A
38501C                 HANDBOOK", CRC PRESS, PP. 640-642.
38502C     WRITTEN BY--ALAN HECKERT
38503C                 STATISTICAL ENGINEERING DIVISION
38504C                 INFORMATION TECHNOOGY LABORATORY
38505C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
38506C                 GAITHERSBURG, MD 20899-8980
38507C                 PHONE--301-975-2899
38508C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
38509C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
38510C     LANGUAGE--ANSI FORTRAN (1977)
38511C     VERSION NUMBER--2013/8
38512C     ORIGINAL VERSION--AUGUST    2013.
38513C
38514C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
38515C
38516      CHARACTER*4 ICAPSW
38517      CHARACTER*4 IFORSW
38518      CHARACTER*4 IBUGA2
38519      CHARACTER*4 IBUGA3
38520      CHARACTER*4 IBUGQ
38521      CHARACTER*4 ISUBRO
38522      CHARACTER*4 IFOUND
38523      CHARACTER*4 IERROR
38524C
38525      CHARACTER*4 IH
38526      CHARACTER*4 IH2
38527      CHARACTER*4 ISUBN0
38528      CHARACTER*4 IHOST1
38529C
38530      CHARACTER*4 ISUBN1
38531      CHARACTER*4 ISUBN2
38532      CHARACTER*4 ISTEPN
38533C
38534      CHARACTER*4 ICASE
38535      CHARACTER*40 INAME
38536      PARAMETER (MAXSPN=10)
38537      CHARACTER*4 IVARN1(MAXSPN)
38538      CHARACTER*4 IVARN2(MAXSPN)
38539      CHARACTER*4 IVARTY(MAXSPN)
38540      REAL PVAR(MAXSPN)
38541      INTEGER ILIS(MAXSPN)
38542      INTEGER NRIGHT(MAXSPN)
38543      INTEGER ICOLR(MAXSPN)
38544C
38545C-----COMMON----------------------------------------------------------
38546C
38547      INCLUDE 'DPCOPA.INC'
38548C
38549      DIMENSION        TEMP1(MAXOBV)
38550      DIMENSION        TEMP2(MAXOBV)
38551      DIMENSION        TEMP3(MAXOBV)
38552      DIMENSION        TEMP4(MAXOBV)
38553      DOUBLE PRECISION DTEMP1(MAXOBV)
38554      INTEGER          ITEMP1(MAXOBV)
38555C
38556      INCLUDE 'DPCOZZ.INC'
38557      INCLUDE 'DPCOZD.INC'
38558      INCLUDE 'DPCOZI.INC'
38559C
38560      EQUIVALENCE(GARBAG(IGARB1),TEMP1(1))
38561      EQUIVALENCE(GARBAG(IGARB2),TEMP2(1))
38562      EQUIVALENCE(GARBAG(IGARB3),TEMP3(1))
38563      EQUIVALENCE(GARBAG(IGARB4),TEMP4(1))
38564      EQUIVALENCE(DGARBG(IDGAR1),DTEMP1(1))
38565      EQUIVALENCE(IGARBG(IIGAR1),ITEMP1(1))
38566C
38567C-----COMMON VARIABLES (GENERAL)--------------------------------------
38568C
38569      INCLUDE 'DPCOHK.INC'
38570      INCLUDE 'DPCOSU.INC'
38571      INCLUDE 'DPCODA.INC'
38572      INCLUDE 'DPCOST.INC'
38573      INCLUDE 'DPCOP2.INC'
38574C
38575C-----START POINT-----------------------------------------------------
38576C
38577      ISUBN1='DPMC'
38578      ISUBN2='WE  '
38579      IFOUND='YES'
38580      IERROR='NO'
38581C
38582      MAXCP1=MAXCOL+1
38583      MAXCP2=MAXCOL+2
38584      MAXCP3=MAXCOL+3
38585      MAXCP4=MAXCOL+4
38586      MAXCP5=MAXCOL+5
38587      MAXCP6=MAXCOL+6
38588C
38589C               *****************************************************
38590C               **  TREAT THE MCCOOL WEIBULL LOCATION TEST   CASE  **
38591C               *****************************************************
38592C
38593      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MCWE')THEN
38594        WRITE(ICOUT,999)
38595  999   FORMAT(1X)
38596        CALL DPWRST('XXX','BUG ')
38597        WRITE(ICOUT,51)
38598   51   FORMAT('***** AT THE BEGINNING OF DPMCWE--')
38599        CALL DPWRST('XXX','BUG ')
38600        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO
38601   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
38602        CALL DPWRST('XXX','BUG ')
38603        WRITE(ICOUT,55)MAXNXT
38604   55   FORMAT('MAXNXT = ',I8)
38605        CALL DPWRST('XXX','BUG ')
38606      ENDIF
38607C
38608C               ****************************************
38609C               **  STEP 2--                          **
38610C               **  EXTRACT THE VARIABLE LIST         **
38611C               ****************************************
38612C
38613      ISTEPN='2'
38614      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCWE')
38615     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38616C
38617      INAME='MCCOOL WEIBULL LOCATION TEST'
38618      MINNA=1
38619      MAXNA=100
38620      MINN2=10
38621      IFLAGE=1
38622      IFLAGM=0
38623      MINNVA=2
38624      MAXNVA=2
38625      IFLAGP=0
38626      JMIN=1
38627      JMAX=NUMARG
38628C
38629      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
38630     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
38631     1            JMIN,JMAX,
38632     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
38633     1            IVARN1,IVARN2,IVARTY,PVAR,
38634     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
38635     1            MINNVA,MAXNVA,
38636     1            IFLAGM,IFLAGP,
38637     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
38638      IF(IERROR.EQ.'YES')GOTO9000
38639C
38640      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCWE')THEN
38641        WRITE(ICOUT,999)
38642        CALL DPWRST('XXX','BUG ')
38643        WRITE(ICOUT,281)
38644  281   FORMAT('***** AFTER CALL DPPARS--')
38645        CALL DPWRST('XXX','BUG ')
38646        WRITE(ICOUT,282)NQ,NUMVAR
38647  282   FORMAT('NQ,NUMVAR = ',2I8)
38648        CALL DPWRST('XXX','BUG ')
38649        IF(NUMVAR.GT.0)THEN
38650          DO285I=1,NUMVAR
38651            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
38652     1                      ICOLR(I)
38653  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
38654     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
38655            CALL DPWRST('XXX','BUG ')
38656  285     CONTINUE
38657        ENDIF
38658      ENDIF
38659C
38660C               *****************************************
38661C               **  STEP 3A--                          **
38662C               **  CASE 1: TWO RESPONSE VARIABLES     **
38663C               **          WITH NO REPLICATION        **
38664C               *****************************************
38665C
38666C     CURRENTLY, DO NOT SUPPORT EITHER "MULTIPLE" OPTION OR
38667C     "REPLICATION" OPTION.
38668C
38669      ISTEPN='3A'
38670      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCWE')
38671     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38672C
38673      ICOL=1
38674      NUMVA2=2
38675      CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
38676     1            INAME,IVARN1,IVARN2,IVARTY,
38677     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
38678     1            MAXCOL,MAXCP1,MAXCP2,MAXCP3,
38679     1            MAXCP4,MAXCP5,MAXCP6,
38680     1            V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
38681     1            Y,X,TEMP1,NS1,NLOCA2,NLOCA3,ICASE,
38682     1            IBUGA3,ISUBRO,IFOUND,IERROR)
38683      IF(IERROR.EQ.'YES')GOTO9000
38684C
38685C               *****************************************
38686C               **  STEP 52--                          **
38687C               **  DO MCCOOL WEIBULL LOCATION TEST    **
38688C               *****************************************
38689C
38690      ISTEPN='52'
38691      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MCWE')THEN
38692        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38693        WRITE(ICOUT,999)
38694        CALL DPWRST('XXX','BUG ')
38695        WRITE(ICOUT,5211)
38696 5211   FORMAT('***** FROM DPMCWE, AS WE ARE ABOUT TO CALL DPMCW2--')
38697        CALL DPWRST('XXX','BUG ')
38698        WRITE(ICOUT,5212)NS1,MAXN
38699 5212   FORMAT('NS1,MAXN = ',2I8)
38700        CALL DPWRST('XXX','BUG ')
38701        DO5215I=1,NS1
38702          WRITE(ICOUT,5216)I,Y(I),X(I)
38703 5216     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
38704          CALL DPWRST('XXX','BUG ')
38705 5215   CONTINUE
38706      ENDIF
38707C
38708      CALL DPMCW2(Y,X,NS1,
38709     1            TEMP1,TEMP2,TEMP3,TEMP4,DTEMP1,ITEMP1,MAXOBV,
38710     1            ICAPSW,ICAPTY,IFORSW,IVARN1,IVARN2,
38711     1            STATVA,STATCD,PVALUE,
38712     1            CUT50,CUT75,CUT90,CUT95,CUT975,CUT99,CUT999,
38713     1            IBUGA3,ISUBRO,IERROR)
38714C
38715C               ***************************************
38716C               **  STEP 61--                        **
38717C               **  UPDATE INTERNAL DATAPLOT TABLES  **
38718C               ***************************************
38719C
38720      ISTEPN='61'
38721      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MCWE')
38722     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38723C
38724      ISUBN0='MCWE'
38725C
38726      IH='STAT'
38727      IH2='VAL '
38728      VALUE0=STATVA
38729      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38730     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38731     1IANS,IWIDTH,IBUGA3,IERROR)
38732C
38733      IH='STAT'
38734      IH2='CDF '
38735      VALUE0=STATCD
38736      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38737     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38738     1IANS,IWIDTH,IBUGA3,IERROR)
38739C
38740      IH='PVAL'
38741      IH2='UE  '
38742      VALUE0=PVALUE
38743      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38744     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38745     1IANS,IWIDTH,IBUGA3,IERROR)
38746C
38747      IH='CUTO'
38748      IH2='FF50'
38749      VALUE0=CUT50
38750      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38751     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38752     1IANS,IWIDTH,IBUGA3,IERROR)
38753C
38754      IH='CUTO'
38755      IH2='FF75'
38756      VALUE0=CUT75
38757      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38758     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38759     1IANS,IWIDTH,IBUGA3,IERROR)
38760C
38761      IH='CUTO'
38762      IH2='FF90'
38763      VALUE0=CUT90
38764      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38765     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38766     1IANS,IWIDTH,IBUGA3,IERROR)
38767C
38768      IH='CUTO'
38769      IH2='FF95'
38770      VALUE0=CUT95
38771      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38772     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38773     1IANS,IWIDTH,IBUGA3,IERROR)
38774C
38775      IH='CUTO'
38776      IH2='FF99'
38777      VALUE0=CUT99
38778      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38779     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38780     1IANS,IWIDTH,IBUGA3,IERROR)
38781C
38782      IH='CUTO'
38783      IH2='F999'
38784      VALUE0=CUT999
38785      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
38786     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
38787     1IANS,IWIDTH,IBUGA3,IERROR)
38788C
38789C               *****************
38790C               **  STEP 90--  **
38791C               **  EXIT       **
38792C               *****************
38793C
38794 9000 CONTINUE
38795      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MCWE')THEN
38796        WRITE(ICOUT,999)
38797        CALL DPWRST('XXX','BUG ')
38798        WRITE(ICOUT,9011)
38799 9011   FORMAT('***** AT THE END       OF DPMCWE--')
38800        CALL DPWRST('XXX','BUG ')
38801        WRITE(ICOUT,9014)STATVA,STATCD,PVALUE,NS1,IERROR
38802 9014   FORMAT('STATVA,STATCD,PVALUE,NS1,IERROR = ',3G15.7,I8,2X,A4)
38803        CALL DPWRST('XXX','BUG ')
38804      ENDIF
38805C
38806      RETURN
38807      END
38808      SUBROUTINE DPMCW2(Y,TAG,N,
38809     1                  TEMP1,TEMP2,TEMP3,TEMP4,DTEMP1,ITEMP1,MAXNXT,
38810     1                  ICAPSW,ICAPTY,IFORSW,IVARID,IVARI2,
38811     1                  STATVA,STATCD,PVAL,
38812     1                  CUT50,CUT75,CUT90,CUT95,CUT975,CUT99,CUT999,
38813     1                  IBUGA3,ISUBRO,IERROR)
38814C
38815C     PURPOSE--CARRY OUT MCCOOL WEIBULL LOCATION TEST
38816C              (TESTS FOR 2-PARAMETER WEIBULL VERSUS 3-PARAMETER WEIBULL,
38817C              I.E,, IS LOCATION PARAMETER > 0)
38818C     EXAMPLE--MCCOOL WEIBULL LOCATION TEST Y TAG
38819C     REFERENCE --JOHN MCCOOL (1998), "INFERENCE ON THE WEIBULL LOCATION
38820C                 PARAMETER, JOURNAL OF QUALITY TECHNOLOGY, VOL. 30,
38821C                 NO. 2, PP. 119-126.
38822C               --JOHN MCCOOL (2012), "USING THE WEIBULL DISTRIBUTION:
38823C                 RELIABILITY, MODELING, AND INFERENCE", WILEY,
38824C                 PP. 301-307.
38825C               --HORST RINNE (2009), "THE WEIBULL DISTRIBUTION: A
38826C                 HANDBOOK", CRC PRESS, PP. 640-642.
38827C     WRITTEN BY--ALAN HECKERT
38828C                 STATISTICAL ENGINEERING DIVISION
38829C                 INFORMATIION TECHNOLOGY LABORATORY
38830C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
38831C                 GAITHERSBURG, MD 20899-8980
38832C                 PHONE--301-975-2899
38833C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
38834C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
38835C     LANGUAGE--ANSI FORTRAN (1977)
38836C     VERSION NUMBER--2013/8
38837C     ORIGINAL VERSION--AUGUST    2013.
38838C
38839C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
38840C
38841      CHARACTER*4 IBUGA3
38842      CHARACTER*4 ISUBRO
38843      CHARACTER*4 IERROR
38844      CHARACTER*4 ICAPSW
38845      CHARACTER*4 ICAPTY
38846      CHARACTER*4 IFORSW
38847      CHARACTER*4 IVARID(*)
38848      CHARACTER*4 IVARI2(*)
38849C
38850      CHARACTER*4 ICASE
38851      CHARACTER*4 ISUBN1
38852      CHARACTER*4 ISUBN2
38853      CHARACTER*4 ISTEPN
38854C
38855C---------------------------------------------------------------------
38856C
38857      DIMENSION Y(*)
38858      DIMENSION TAG(*)
38859      DIMENSION TEMP1(*)
38860      DIMENSION TEMP2(*)
38861      DIMENSION TEMP3(*)
38862      DIMENSION TEMP4(*)
38863C
38864      DOUBLE PRECISION DTEMP1(*)
38865      INTEGER          ITEMP1(*)
38866C
38867      PARAMETER (NUMALP=7)
38868      REAL ALPHA(NUMALP)
38869      REAL CVAL(NUMALP)
38870C
38871      PARAMETER(NUMCLI=5)
38872      PARAMETER(MAXLIN=3)
38873      PARAMETER (MAXROW=NUMALP)
38874      PARAMETER (MAXRO2=20)
38875      CHARACTER*60 ITITLE
38876      CHARACTER*60 ITITLZ
38877      CHARACTER*1  ITITL9
38878      CHARACTER*60 ITEXT(MAXRO2)
38879      CHARACTER*4  ALIGN(NUMCLI)
38880      CHARACTER*4  VALIGN(NUMCLI)
38881      REAL         AVALUE(MAXRO2)
38882      INTEGER      NCTEXT(MAXRO2)
38883      INTEGER      IDIGIT(MAXRO2)
38884      INTEGER      NTOT(MAXRO2)
38885      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
38886      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
38887      CHARACTER*4  ITYPCO(NUMCLI)
38888      INTEGER      NCTIT2(MAXLIN,NUMCLI)
38889      INTEGER      NCVALU(MAXROW,NUMCLI)
38890      INTEGER      IWHTML(NUMCLI)
38891      INTEGER      IWRTF(NUMCLI)
38892      REAL         AMAT(MAXROW,NUMCLI)
38893      LOGICAL IFRST
38894      LOGICAL ILAST
38895      LOGICAL IFLAGS
38896      LOGICAL IFLAGE
38897C
38898C-----COMMON----------------------------------------------------------
38899C
38900      INCLUDE 'DPCOST.INC'
38901      INCLUDE 'DPCOP2.INC'
38902C
38903      DATA ALPHA/
38904     1 50.0, 75.0, 90.0, 95.0, 97.5, 99.0, 99.9/
38905C
38906C-----START POINT-----------------------------------------------------
38907C
38908      ISUBN1='DPMC'
38909      ISUBN2='W2  '
38910      IERROR='NO'
38911C
38912      STATVA=CPUMIN
38913      STATCD=CPUMIN
38914      PVAL=CPUMIN
38915      CUT50=CPUMIN
38916      CUT75=CPUMIN
38917      CUT90=CPUMIN
38918      CUT95=CPUMIN
38919      CUT975=CPUMIN
38920      CUT99=CPUMIN
38921      CUT999=CPUMIN
38922C
38923      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MCW2')THEN
38924        WRITE(ICOUT,999)
38925  999   FORMAT(1X)
38926        CALL DPWRST('XXX','WRIT')
38927        WRITE(ICOUT,51)
38928   51   FORMAT('**** AT THE BEGINNING OF DPMCW2--')
38929        CALL DPWRST('XXX','WRIT')
38930        WRITE(ICOUT,52)IBUGA3,ISUBRO,IFORSW,N
38931   52   FORMAT('IBUGA3,ISUBRO,IFORSW,N = ',3(A4,2X),I8)
38932        CALL DPWRST('XXX','WRIT')
38933        WRITE(ICOUT,53)IVARID(1),IVARI2(1),IVARID(2),IVARI2(2)
38934   53   FORMAT('IVARID(1),IVARI2(1),IVARID(2),IVARI2(2) = ',
38935     1         A4,A4,2X,A4,A4)
38936        CALL DPWRST('XXX','WRIT')
38937        DO56I=1,N
38938          WRITE(ICOUT,57)I,Y(I),TAG(I)
38939   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
38940          CALL DPWRST('XXX','WRIT')
38941   56   CONTINUE
38942      ENDIF
38943C
38944      ICASE='CV'
38945      CALL DPMCW3(Y,TAG,N,TEMP4,TEMP1,TEMP2,TEMP3,DTEMP1,ITEMP1,
38946     1            ICASE,ISEED,MAXNXT,
38947     1            STATVA,STATCD,PVAL,CV50,CV90,CV95,
38948     1            CA,CL,IR,IR1,IMCCR1,IRANAL,
38949     1            ISUBRO,IBUGA3,IERROR)
38950      IF(IERROR.EQ.'YES')GOTO9000
38951C
38952      CUT50=CV50
38953      CUT75=TEMP3(7500)
38954      CUT90=CV90
38955      CUT95=CV95
38956      CUT975=TEMP3(9750)
38957      CUT99=TEMP3(9900)
38958      CUT999=TEMP3(9990)
38959      CVAL(1)=CUT50
38960      CVAL(2)=CUT75
38961      CVAL(3)=CUT90
38962      CVAL(4)=CUT95
38963      CVAL(5)=CUT975
38964      CVAL(6)=CUT99
38965      CVAL(7)=CUT999
38966C
38967C               ******************************************
38968C               **   STEP 43--                          **
38969C               **   WRITE OUT EVERYTHING               **
38970C               ******************************************
38971C
38972      ISTEPN='42'
38973      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCW2')
38974     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
38975C
38976      IF(IPRINT.EQ.'OFF')GOTO9000
38977C
38978      NUMDIG=7
38979      IF(IFORSW.EQ.'1')NUMDIG=1
38980      IF(IFORSW.EQ.'2')NUMDIG=2
38981      IF(IFORSW.EQ.'3')NUMDIG=3
38982      IF(IFORSW.EQ.'4')NUMDIG=4
38983      IF(IFORSW.EQ.'5')NUMDIG=5
38984      IF(IFORSW.EQ.'6')NUMDIG=6
38985      IF(IFORSW.EQ.'7')NUMDIG=7
38986      IF(IFORSW.EQ.'8')NUMDIG=8
38987      IF(IFORSW.EQ.'9')NUMDIG=9
38988      IF(IFORSW.EQ.'0')NUMDIG=0
38989      IF(IFORSW.EQ.'E')NUMDIG=-2
38990      IF(IFORSW.EQ.'-2')NUMDIG=-2
38991      IF(IFORSW.EQ.'-3')NUMDIG=-3
38992      IF(IFORSW.EQ.'-4')NUMDIG=-4
38993      IF(IFORSW.EQ.'-5')NUMDIG=-5
38994      IF(IFORSW.EQ.'-6')NUMDIG=-6
38995      IF(IFORSW.EQ.'-7')NUMDIG=-7
38996      IF(IFORSW.EQ.'-8')NUMDIG=-8
38997      IF(IFORSW.EQ.'-9')NUMDIG=-9
38998C
38999      ITITLE='McCool Weibull Location Test'
39000      NCTITL=28
39001      ITITLZ=' '
39002      NCTITZ=0
39003C
39004      ICNT=1
39005      ITEXT(ICNT)=' '
39006      NCTEXT(ICNT)=0
39007      AVALUE(ICNT)=0.0
39008      IDIGIT(ICNT)=-1
39009      ICNT=ICNT+1
39010      ITEXT(ICNT)='Response Variable: '
39011      WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
39012      WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
39013      NCTEXT(ICNT)=27
39014      AVALUE(ICNT)=0.0
39015      IDIGIT(ICNT)=-1
39016C
39017      ICNT=ICNT+1
39018      ITEXT(ICNT)='Censoring Variable: '
39019      WRITE(ITEXT(ICNT)(21:24),'(A4)')IVARID(2)(1:4)
39020      WRITE(ITEXT(ICNT)(25:28),'(A4)')IVARI2(2)(1:4)
39021      NCTEXT(ICNT)=28
39022      AVALUE(ICNT)=0.0
39023      IDIGIT(ICNT)=-1
39024C
39025      ICNT=ICNT+1
39026      ITEXT(ICNT)=' '
39027      NCTEXT(ICNT)=1
39028      AVALUE(ICNT)=0.0
39029      IDIGIT(ICNT)=-1
39030C
39031      ICNT=ICNT+1
39032      ITEXT(ICNT)='H0: mu = 0'
39033      NCTEXT(ICNT)=10
39034      AVALUE(ICNT)=0.0
39035      IDIGIT(ICNT)=-1
39036      ICNT=ICNT+1
39037      ITEXT(ICNT)='Ha: mu > 0'
39038      NCTEXT(ICNT)=10
39039      AVALUE(ICNT)=0.0
39040      IDIGIT(ICNT)=-1
39041C
39042      ICNT=ICNT+1
39043      ITEXT(ICNT)=' '
39044      NCTEXT(ICNT)=1
39045      AVALUE(ICNT)=0.0
39046      IDIGIT(ICNT)=-1
39047      ICNT=ICNT+1
39048      ITEXT(ICNT)='Summary Statistics:'
39049      NCTEXT(ICNT)=19
39050      AVALUE(ICNT)=0.0
39051      IDIGIT(ICNT)=-1
39052      ICNT=ICNT+1
39053      ITEXT(ICNT)='Total Number of Observations:'
39054      NCTEXT(ICNT)=29
39055      AVALUE(ICNT)=REAL(N)
39056      IDIGIT(ICNT)=0
39057      ICNT=ICNT+1
39058      ITEXT(ICNT)='Number of Uncensored Observations:'
39059      NCTEXT(ICNT)=34
39060      AVALUE(ICNT)=REAL(IR)
39061      IDIGIT(ICNT)=0
39062      ICNT=ICNT+1
39063      ITEXT(ICNT)='Value of R1:'
39064      NCTEXT(ICNT)=12
39065      AVALUE(ICNT)=REAL(IR1)
39066      IDIGIT(ICNT)=0
39067      ICNT=ICNT+1
39068      ITEXT(ICNT)='Value of Shape Parameter for All Data:'
39069      NCTEXT(ICNT)=38
39070      AVALUE(ICNT)=CA
39071      IDIGIT(ICNT)=NUMDIG
39072      ICNT=ICNT+1
39073      ITEXT(ICNT)='Value of Shape Parameter for R1 Data:'
39074      NCTEXT(ICNT)=37
39075      AVALUE(ICNT)=CL
39076      IDIGIT(ICNT)=NUMDIG
39077      ICNT=ICNT+1
39078      ITEXT(ICNT)=' '
39079      NCTEXT(ICNT)=1
39080      AVALUE(ICNT)=0.0
39081      IDIGIT(ICNT)=-1
39082C
39083      ICNT=ICNT+1
39084      ITEXT(ICNT)='Test Statistic Value:'
39085      NCTEXT(ICNT)=21
39086      AVALUE(ICNT)=STATVA
39087      IDIGIT(ICNT)=NUMDIG
39088      ICNT=ICNT+1
39089      ITEXT(ICNT)='CDF of Test Statistic:'
39090      NCTEXT(ICNT)=22
39091      AVALUE(ICNT)=STATCD
39092      IDIGIT(ICNT)=NUMDIG
39093      ICNT=ICNT+1
39094      ITEXT(ICNT)='P-Value for Test Statistic:'
39095      NCTEXT(ICNT)=27
39096      AVALUE(ICNT)=PVAL
39097      IDIGIT(ICNT)=NUMDIG
39098C
39099      NUMROW=ICNT
39100      DO5010I=1,NUMROW
39101        NTOT(I)=15
39102 5010 CONTINUE
39103C
39104      IFRST=.TRUE.
39105      ILAST=.TRUE.
39106C
39107      ISTEPN='42A'
39108      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCW2')
39109     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
39110C
39111      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
39112     1            AVALUE,IDIGIT,
39113     1            NTOT,NUMROW,
39114     1            ICAPSW,ICAPTY,ILAST,IFRST,
39115     1            ISUBRO,IBUGA3,IERROR)
39116C
39117      ISTEPN='42D'
39118      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MCW2')
39119     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
39120C
39121      ITITL9=' '
39122      NCTIT9=0
39123      ITITLE='Conclusions (Upper 1-Tailed Test)'
39124      NCTITL=33
39125C
39126      DO5030J=1,5
39127        DO5040I=1,3
39128          ITITL2(I,J)=' '
39129          NCTIT2(I,J)=0
39130 5040   CONTINUE
39131 5030 CONTINUE
39132C
39133      ITITL2(2,1)='Null'
39134      NCTIT2(2,1)=4
39135      ITITL2(3,1)='Hypothesis'
39136      NCTIT2(3,1)=10
39137C
39138      ITITL2(2,2)='Significance'
39139      NCTIT2(2,2)=12
39140      ITITL2(3,2)='Level'
39141      NCTIT2(3,2)=5
39142C
39143      ITITL2(2,3)='Test '
39144      NCTIT2(2,3)=4
39145      ITITL2(3,3)='Statistic'
39146      NCTIT2(3,3)=9
39147C
39148      ITITL2(2,4)='Critical'
39149      NCTIT2(2,4)=8
39150      ITITL2(3,4)='Region (>=)'
39151      NCTIT2(3,4)=11
39152C
39153      ITITL2(1,5)='Null'
39154      NCTIT2(1,5)=4
39155      ITITL2(2,5)='Hypothesis'
39156      NCTIT2(2,5)=10
39157      ITITL2(3,5)='Conclusion'
39158      NCTIT2(3,5)=10
39159C
39160      NMAX=0
39161      NUMCOL=5
39162      DO5050I=1,NUMCOL
39163        VALIGN(I)='b'
39164        ALIGN(I)='r'
39165        NTOT(I)=15
39166        IF(I.EQ.1)NTOT(I)=12
39167        NMAX=NMAX+NTOT(I)
39168        ITYPCO(I)='NUME'
39169        IDIGIT(I)=NUMDIG
39170        IF(I.EQ.1 .OR. I.EQ.2 .OR. I.EQ.5)THEN
39171          ITYPCO(I)='ALPH'
39172        ENDIF
39173        IWHTML(1)=150
39174        IWHTML(2)=125
39175        IWHTML(3)=150
39176        IWHTML(4)=150
39177        IWHTML(5)=150
39178        IINC=1600
39179        IINC2=1400
39180        IINC3=2200
39181        IWRTF(1)=IINC
39182        IWRTF(2)=IWRTF(1)+IINC
39183        IWRTF(3)=IWRTF(2)+IINC2
39184        IWRTF(4)=IWRTF(3)+IINC
39185        IWRTF(5)=IWRTF(4)+IINC
39186C
39187        DO5060J=1,NUMALP
39188C
39189          IVALUE(J,1)='mu = 0'
39190          NCVALU(J,1)=6
39191          AMAT(J,3)=STATVA
39192          AMAT(J,4)=CVAL(J)
39193          IVALUE(J,5)(1:6)='REJECT'
39194          IF(STATVA.LT.CVAL(J))THEN
39195            IVALUE(J,5)(1:6)='ACCEPT'
39196          ENDIF
39197          NCVALU(J,5)=6
39198C
39199          ALPHAT=ALPHA(J)
39200          ALPHAT=ALPHAT
39201          WRITE(IVALUE(J,2)(1:4),'(F4.1)')ALPHAT
39202          IVALUE(J,2)(5:5)='%'
39203          NCVALU(J,2)=5
39204 5060   CONTINUE
39205C
39206 5050 CONTINUE
39207C
39208      ICNT=NUMALP
39209      NUMLIN=3
39210      NUMCOL=5
39211      IFRST=.TRUE.
39212      ILAST=.TRUE.
39213      IFLAGS=.TRUE.
39214      IFLAGE=.TRUE.
39215      CALL DPDTA5(ITITLE,NCTITL,
39216     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
39217     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
39218     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
39219     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
39220     1            ICAPSW,ICAPTY,IFRST,ILAST,
39221     1            IFLAGS,IFLAGE,
39222     1            ISUBRO,IBUGA3,IERROR)
39223C
39224C               *****************
39225C               **  STEP 90--  **
39226C               **  EXIT       **
39227C               *****************
39228C
39229 9000 CONTINUE
39230      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MCW2')THEN
39231        WRITE(ICOUT,999)
39232        CALL DPWRST('XXX','WRIT')
39233        WRITE(ICOUT,9011)
39234 9011   FORMAT('***** AT THE END       OF DPMCW2--')
39235        CALL DPWRST('XXX','WRIT')
39236        WRITE(ICOUT,9012)N,IBUGA3,IERROR
39237 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2(2X,A4))
39238        CALL DPWRST('XXX','WRIT')
39239        WRITE(ICOUT,9013)STATVA,STATCD,PVAL
39240 9013   FORMAT('STATVA,STATCD,PVAL = ',3G15.7)
39241        CALL DPWRST('XXX','WRIT')
39242      ENDIF
39243C
39244      RETURN
39245      END
39246      SUBROUTINE DPMCW3(Y,TAG,N,TAG2,TEMP1,TEMP2,TEMP3,DTEMP1,ITEMP1,
39247     1                  ICASE,ISEED,MAXNXT,
39248     1                  STATVA,STATCD,PVAL,CV50,CV90,CV95,
39249     1                  CA,CL,IR,IR1,IMCCR1,IRANAL,
39250     1                  ISUBRO,IBUGA3,IERROR)
39251C
39252C     PURPOSE--THIS SUBROUTINE PERFORMS MCCOOL'S TEST FOR DISTINGUISHING
39253C              BETWEEN A 2-PARAMETER WEIBULL VERSUS A 3-PARAMETER
39254C              WEIBULL.  THIS TEST IS CURRENTLY SUPPORTED FOR SAMPLE
39255C              SIZES BETWEEN 10 AND 100.
39256C
39257C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION RESPONSE VARIABLE.
39258C                       X      = A TAG VARIABLE WHERE "1" INDICATES AN
39259C                                UNCENSORED OBSERVATION AND "0" INDICATES
39260C                                A CENSORED OBSERVATION.
39261C                     --N      = AN INTEGER PARAMETER THAT SPECIFIES THE
39262C                                NUMBER OF VALUES IN THE RESPONSE
39263C                                VARIABLE.
39264C                     --GAMMA  = THE SHAPE PARAMETER
39265C                                GAMMA SHOULD BE POSITIVE.
39266C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
39267C                                DENSITY FUNCTION VALUE.
39268C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
39269C             FUNCTION VALUE PDF FOR THE DOUBLE WEIBULL DISTRIBUTION
39270C             WITH TAIL LENGHT PARAMETER = GAMMA.
39271C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
39272C     RESTRICTIONS--GAMMA SHOULD BE POSITIVE.
39273C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
39274C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
39275C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
39276C     LANGUAGE--ANSI FORTRAN (1977)
39277C     REFERENCE --JOHN MCCOOL (1998), "INFERENCE ON THE WEIBULL LOCATION
39278C                 PARAMETER, JOURNAL OF QUALITY TECHNOLOGY, VOL. 30,
39279C                 NO. 2, PP. 119-126.
39280C               --JOHN MCCOOL (2012), "USING THE WEIBULL DISTRIBUTION:
39281C                 RELIABILITY, MODELING, AND INFERENCE", WILEY,
39282C                 PP. 301-307.
39283C               --HORST RINNE (2009), "THE WEIBULL DISTRIBUTION: A
39284C                 HANDBOOK", CRC PRESS, PP. 640-642.
39285C     WRITTEN BY--ALAN HECKERT
39286C                 STATISTICAL ENGINEERING DIVISION
39287C                 INFORMATION TECHNOLOGY LABORATORY
39288C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
39289C                 GAITHERSBURG, MD 20899
39290C                 PHONE--301-975-2899
39291C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
39292C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
39293C     LANGUAGE--ANSI FORTRAN (1977)
39294C     VERSION NUMBER--2013/8
39295C     ORIGINAL VERSION--AUGUST    2013.
39296C
39297C---------------------------------------------------------------------
39298C
39299      REAL Y(*)
39300      REAL TAG(*)
39301      REAL TAG2(*)
39302      REAL TEMP1(*)
39303      REAL TEMP2(*)
39304      REAL TEMP3(*)
39305      DOUBLE PRECISION DTEMP1(*)
39306      INTEGER ITEMP1(*)
39307C
39308      CHARACTER*4 ICASE
39309      CHARACTER*4 IRANAL
39310      CHARACTER*4 ISUBRO
39311      CHARACTER*4 IBUGA3
39312      CHARACTER*4 IERROR
39313C
39314      CHARACTER*4 IDIR
39315      CHARACTER*4 IRANSV
39316C
39317      INCLUDE 'DPCOP2.INC'
39318C
39319C-----START POINT-----------------------------------------------------
39320C
39321      IF(ISUBRO.EQ.'MCW3' .OR. IBUGA3.EQ.'ON')THEN
39322        WRITE(ICOUT,999)
39323        CALL DPWRST('XXX','BUG ')
39324        WRITE(ICOUT,51)
39325   51   FORMAT('AT THE BEGINNING OF DPMCW3')
39326        CALL DPWRST('XXX','BUG ')
39327        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASE,MAXNXT,N
39328   52   FORMAT('IBUGA3,ISUBRO,ICASE,MAXNXT,N = ',3(A4,2X),2I8)
39329        CALL DPWRST('XXX','BUG ')
39330        DO55I=1,N
39331          WRITE(ICOUT,57)I,Y(I),TAG(I)
39332   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
39333          CALL DPWRST('XXX','BUG ')
39334   55   CONTINUE
39335      ENDIF
39336C
39337      STATVA=CPUMIN
39338      STATCD=CPUMIN
39339      PVAL=CPUMIN
39340      IMCCR1=0
39341C
39342      IRANSV=IRANAL
39343      IRANAL='FINC'
39344      ISEESV=ISEED
39345      IF(ISEED.EQ.305)THEN
39346        ISEED=23709
39347      ENDIF
39348C
39349C     ESTIMATE THE SHAPE PARAMETER BASED ON ALL OF THE DATA
39350C
39351      IR=0
39352      DO100I=1,N
39353        AVAL=TAG(I)
39354        IF(ABS(AVAL).LE.0.5)THEN
39355          TAG(I)=0.0
39356        ELSE
39357          TAG(I)=1.0
39358          IR=IR+1
39359        ENDIF
39360  100 CONTINUE
39361C
39362      IERR=0
39363      IF(IMCCR1.GT.0 .AND. IMCCR1.LT.IR)THEN
39364        IR1=IMCCR1
39365        NMAX=N
39366      ELSE
39367        NMAX=100
39368        IF(N.LE.30)THEN
39369          IR1=5
39370          IF(IR.LT.6)THEN
39371            IERR=1
39372          ENDIF
39373        ELSEIF(N.GT.30 .AND. N.LT.40)THEN
39374          IR1=6
39375          IF(IR.LT.7)THEN
39376            IERR=1
39377          ENDIF
39378        ELSEIF(N.GE.40 .AND. N.LE.60)THEN
39379          IR1=7
39380          IF(IR.LT.8)THEN
39381            IERR=1
39382          ENDIF
39383        ELSEIF(N.GT.60 .AND. N.LT.80)THEN
39384          IR1=8
39385          IF(IR.LT.9)THEN
39386            IERR=1
39387          ENDIF
39388        ELSEIF(N.GE.80 .AND. N.LE.100)THEN
39389          IR1=9
39390          IF(IR.LT.10)THEN
39391            IERR=1
39392          ENDIF
39393        ENDIF
39394      ENDIF
39395C
39396      IF(IERR.EQ.1)THEN
39397        WRITE(ICOUT,999)
39398        CALL DPWRST('XXX','BUG ')
39399        WRITE(ICOUT,91)
39400        CALL DPWRST('XXX','BUG ')
39401        WRITE(ICOUT,191)
39402  191   FORMAT('      THERE ARE AN INSUFFICIENT NUMBER OF UNCENSORED ',
39403     1         'OBSERVATIONS.')
39404        CALL DPWRST('XXX','BUG ')
39405        WRITE(ICOUT,193)IR
39406  193   FORMAT('      NUMBER OF UNCENSORED OBSERVATIONS IS         ',I8)
39407        CALL DPWRST('XXX','BUG ')
39408        WRITE(ICOUT,195)IR1
39409  195   FORMAT('      MINIMUM NUMBER OF UNCENSORED OBSERVATIONS IS ',I8)
39410        CALL DPWRST('XXX','BUG ')
39411        IERROR='YES'
39412        GOTO9000
39413      ENDIF
39414C
39415      IF(N.LT.10 .OR. N.GT.NMAX)THEN
39416        WRITE(ICOUT,999)
39417  999   FORMAT(1X)
39418        CALL DPWRST('XXX','BUG ')
39419        WRITE(ICOUT,91)
39420   91   FORMAT('***** ERROR IN MCCOOL WEIBULL TEST--')
39421        CALL DPWRST('XXX','BUG ')
39422        WRITE(ICOUT,93)NMAX
39423   93   FORMAT('      THIS TEST IS CURRENTLY ONLY SUPPORTED FOR ',
39424     1         'SAMPLE SIZES BETWEEN 10 AND ',I8,'.')
39425        CALL DPWRST('XXX','BUG ')
39426        WRITE(ICOUT,95)N
39427   95   FORMAT('      THE NUMBER OF RESPONSE VALUES IS   ',I8)
39428        CALL DPWRST('XXX','BUG ')
39429        IERROR='YES'
39430        GOTO9000
39431      ENDIF
39432C
39433C     ESTIMATE BASED ON ALL DATA
39434C
39435      CALL WEIM2B(Y,TAG,N,MAXNXT,
39436     1            TEMP1,DTEMP1,ITEMP1,
39437     1            CA,
39438     1            ISUBRO,IBUGA3,IERROR)
39439C
39440C     NOW ESTIMATE BASED ON THE FIRST "R1"
39441C
39442      DO110I=1,N
39443        TAG2(I)=TAG(I)
39444  110 CONTINUE
39445C
39446      ICNT=0
39447      DO200I=1,N
39448        IF(TAG2(I).GE.0.5)THEN
39449          ICNT=ICNT+1
39450          IF(ICNT.GT.IR1)THEN
39451            TAG2(I)=0.0
39452            TEMP3(I)=Y(IR1)
39453          ELSE
39454            TEMP3(I)=Y(I)
39455          ENDIF
39456        ENDIF
39457  200 CONTINUE
39458      CALL WEIM2B(TEMP3,TAG2,N,MAXNXT,
39459     1            TEMP1,DTEMP1,ITEMP1,
39460     1            CL,
39461     1            ISUBRO,IBUGA3,IERROR)
39462C
39463      STATVA=CL/CA
39464C
39465C     NOW PERFORM SIMULATIONS TO OBTAIN CRITICAL VALUES.  GENERATE
39466C     10,000 SAMPLES FROM A 2-PARAMETER WEIBULL.  BASED ON MCCOOL'S
39467C     PAPER, USE A SHAPE PARAMETER OF 1 AND A TENTH PERCENTILE OF 1.0.
39468C     USE THE FOLLOWING FORMULA (BASED ON MENON'S ESTIMATES FOR THE
39469C     2-PARAMETER WEIBULL) FROM PP. 132-134 OF MCCOOL'S BOOK:
39470C
39471C            Xhat(p) = (k(p))**(1/BETAHAT)*SCALE
39472C
39473C     WHERE
39474C
39475C            Xhat(p)   = THE ESTIMATE OF THE p-TH PERCENTILE
39476C            k(p)      = THE DESIRED PERCENTILE (0.10 IN THIS CASE)
39477C            BETAHAT   = THE ESTIMATED SHAPE PARAMETER (WE ARE USING
39478C                        A VALUE OF 1 FOR THE PURPOSES OF THE MONTE
39479C                        CARLO SIMULATION)
39480C
39481C     THIS MEANS THAT TO OBTAIN A TENTH PERCENTILE OF 1, WE USE
39482C
39483C           SCALE = 1/0.10**(1/BETA)
39484C                 = 10 FOR BETA = 1
39485C
39486      IF(ICASE.EQ.'STAT')GOTO9000
39487      NMCSAM=10000
39488      SCALE=10.0
39489      GAMMA=1.0
39490CCCCC GAMMA=CA
39491CCCCC SCALE=1.0/0.10**(1.0/GAMMA)
39492      MINMAX=1
39493C
39494      ICNT=0
39495      DO300I=1,NMCSAM
39496        CALL WEIRAN(N,GAMMA,MINMAX,ISEED,TEMP2)
39497        CALL SORT(TEMP2,N,TEMP2)
39498        DO310J=1,N
39499          TEMP2(J)=SCALE*TEMP2(J)
39500  310   CONTINUE
39501C
39502        DO320J=1,IR
39503          TAG2(J)=1.0
39504  320   CONTINUE
39505        IF(IR.LT.N)THEN
39506          DO330J=IR+1,N
39507             TAG2(J)=0.0
39508  330     CONTINUE
39509        ENDIF
39510        CALL WEIM2B(TEMP2,TAG2,N,MAXNXT,
39511     1              TEMP1,DTEMP1,ITEMP1,
39512     1              CAT,
39513     1              ISUBRO,IBUGA3,IERROR)
39514C
39515        DO340J=1,IR1
39516          TAG2(J)=1.0
39517  340   CONTINUE
39518        DO350J=IR1+1,N
39519           TAG2(J)=0.0
39520           TEMP2(J)=TEMP2(IR1)
39521  350   CONTINUE
39522        CALL WEIM2B(TEMP2,TAG2,N,MAXNXT,
39523     1              TEMP1,DTEMP1,ITEMP1,
39524     1              CLT,
39525     1              ISUBRO,IBUGA3,IERROR)
39526C
39527        TEMP3(I)=CLT/CAT
39528C
39529  300 CONTINUE
39530C
39531C     NOW DETERMINE REFERENCE VALUES AND P-VALUE
39532C
39533      IDIR='UPPE'
39534      CALL DPGOF8(TEMP3,NMCSAM,STATVA,PVAL,IDIR,
39535     1            IBUGA3,ISUBRO,IERROR)
39536      STATCD=1.0 - PVAL
39537      CV50=TEMP3(5000)
39538      CV90=TEMP3(9000)
39539      CV95=TEMP3(9500)
39540C
39541 9000 CONTINUE
39542      IRANAL=IRANSV
39543      ISEED=ISEESV
39544C
39545      IF(ISUBRO.EQ.'MCW3' .OR. IBUGA3.EQ.'ON')THEN
39546        WRITE(ICOUT,999)
39547        CALL DPWRST('XXX','BUG ')
39548        WRITE(ICOUT,9001)
39549 9001   FORMAT('AT THE BEGINNING OF DPMCW3')
39550        CALL DPWRST('XXX','BUG ')
39551        WRITE(ICOUT,9002)IERROR,STATVA,STATCD,PVAL
39552 9002   FORMAT('IERROR,STATVA,STATCD,PVAL = ',A4,2X,3G15.7)
39553        CALL DPWRST('XXX','BUG ')
39554        WRITE(ICOUT,9003)IR,IR1,CL,CA
39555 9003   FORMAT('IR,IR1,CL,CA = ',2I8,2G15.7)
39556        CALL DPWRST('XXX','BUG ')
39557      ENDIF
39558C
39559      RETURN
39560      END
39561      SUBROUTINE DPMDCL(XMED,QUASE,N,ALPHA,IWRITE,ALOWLM,AUPPLM,
39562     1                  IBUGA3,IERROR)
39563C
39564C     PURPOSE--FOR A GIVEN MEAN, SD, N, AND ALPHA, COMPUTE THE
39565C              LOWER AND UPPER CONFIDENCE LIMITS FOR THE MEDIAN.
39566C              THIS IS PRIMARILY USED BY THE CROSS TABULATE COMMAND.
39567C     WRITTEN BY--JAMES J. FILLIBEN
39568C                 STATISTICAL ENGINEERING DIVISION
39569C                 INFORMATION TECHNOLOGY LABORATORY
39570C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
39571C                 GAITHERSBURG, MD 20899-8980
39572C                 PHONE--301-975-2855
39573C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
39574C           OF THE NATIONAL BUREAU OF STANDARDS.
39575C     LANGUAGE--ANSI FORTRAN (1977)
39576C     VERSION NUMBER--2009/5
39577C     ORIGINAL VERSION--MAY       2009.
39578C
39579C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
39580C
39581      CHARACTER*4 IWRITE
39582      CHARACTER*4 IBUGA3
39583      CHARACTER*4 IERROR
39584C
39585      CHARACTER*4 ISUBN1
39586      CHARACTER*4 ISUBN2
39587C
39588C---------------------------------------------------------------------
39589C
39590      REAL XMEAN
39591      REAL QUASE
39592      REAL ALPHA
39593      REAL ALOWLM
39594      REAL AUPPLM
39595      INTEGER N
39596C
39597C---------------------------------------------------------------------
39598C
39599      INCLUDE 'DPCOP2.INC'
39600C
39601C-----START POINT-----------------------------------------------------
39602C
39603      ISUBN1='DPMD'
39604      ISUBN2='CL  '
39605      ALOWLM=CPUMIN
39606      AUPPLM=CPUMIN
39607C
39608      IERROR='NO'
39609C
39610      IF(IBUGA3.EQ.'ON')THEN
39611        WRITE(ICOUT,999)
39612  999   FORMAT(1X)
39613        CALL DPWRST('XXX','BUG ')
39614        WRITE(ICOUT,51)
39615   51   FORMAT('***** AT THE BEGINNING OF DPMDCL--')
39616        CALL DPWRST('XXX','BUG ')
39617        WRITE(ICOUT,52)IBUGA3,IWRITE
39618   52   FORMAT('IBUGA3,IWRITE = ',A4,2X,A4)
39619        CALL DPWRST('XXX','BUG ')
39620        WRITE(ICOUT,53)XMEAN,N,ALPHA
39621   53   FORMAT('XMEAN,N,ALPHA = ',G15.7,I8,G15.7)
39622        CALL DPWRST('XXX','BUG ')
39623        WRITE(ICOUT,999)
39624        CALL DPWRST('XXX','BUG ')
39625      ENDIF
39626C
39627C               ********************************
39628C               **  STEP 1--                  **
39629C               **  CHECK FOR INPUT ERRORS    **
39630C               ********************************
39631C
39632      IF(N.LT.1)THEN
39633        IERROR='YES'
39634        WRITE(ICOUT,999)
39635        CALL DPWRST('XXX','BUG ')
39636        WRITE(ICOUT,151)
39637  151   FORMAT('***** ERROR IN DPMDCL--')
39638        CALL DPWRST('XXX','BUG ')
39639        WRITE(ICOUT,152)
39640  152   FORMAT('      THE INPUT SAMPLE SIZE FOR THE MEDIAN CONFIDENCE')
39641        CALL DPWRST('XXX','BUG ')
39642        WRITE(ICOUT,154)
39643  154   FORMAT('      LIMITS IS LESS THAN 1.')
39644        CALL DPWRST('XXX','BUG ')
39645        WRITE(ICOUT,157)N
39646  157   FORMAT('      THE INPUT SAMPLE SIZE            = ',I8)
39647        CALL DPWRST('XXX','BUG ')
39648        GOTO9000
39649      ENDIF
39650C
39651      IF(N.LT.3)THEN
39652        ALOWLM=XMED
39653        AUPPLM=XMED
39654        GOTO9000
39655      ENDIF
39656C
39657      ALPHSV=ALPHA
39658      IF(ALPHA.GT.1.0 .AND. ALPHA.LE.100.0)ALPHA=ALPHA/100.0
39659      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
39660        IERROR='YES'
39661        WRITE(ICOUT,999)
39662        CALL DPWRST('XXX','BUG ')
39663        WRITE(ICOUT,171)
39664  171   FORMAT('***** ERROR IN DPMDCL--')
39665        CALL DPWRST('XXX','BUG ')
39666        WRITE(ICOUT,172)
39667  172   FORMAT('      THE VALUE OF ALPHA IS OUTSIDE THE (0,1) ',
39668     1         'INTERVAL.')
39669        CALL DPWRST('XXX','BUG ')
39670        WRITE(ICOUT,177)ALPHA
39671  177   FORMAT('      THE VALUE OF ALPHA = ',G15.7)
39672        CALL DPWRST('XXX','BUG ')
39673        GOTO9000
39674      ENDIF
39675C
39676C               ********************************************
39677C               **  STEP 2--                              **
39678C               **  COMPUTE THE MEAN CONFIDENCE INTERVALS **
39679C               ********************************************
39680C
39681      ALP=ALPHA
39682      IF(ALP.LT.0.5)THEN
39683        ALP=1.0-ALP
39684      ENDIF
39685C
39686      ALP=1.0 - ALP
39687      P1=ALP/2.0
39688      P2=1.0-(ALP/2.0)
39689      AN=REAL(N)
39690      Q=1.0-P
39691C
39692      AN=REAL(N)
39693      CALL NORPPF(P2,ZALPHA)
39694      ALOWLM=XMED - ZALPHA*QUASE
39695      AUPPLM=XMED + ZALPHA*QUASE
39696C
39697C               *****************
39698C               **  STEP 90--  **
39699C               **  EXIT.      **
39700C               *****************
39701C
39702 9000 CONTINUE
39703C
39704      IF(IBUGA3.EQ.'ON')THEN
39705        WRITE(ICOUT,999)
39706        CALL DPWRST('XXX','BUG ')
39707        WRITE(ICOUT,9011)
39708 9011   FORMAT('***** AT THE END       OF DPMDCL--')
39709        CALL DPWRST('XXX','BUG ')
39710        WRITE(ICOUT,9014)IERROR,ALOWLM,AUPPLM
39711 9014   FORMAT('IERROR,ALOWLM,AUPPLM = ',A4,2X,2G15.7)
39712        CALL DPWRST('XXX','BUG ')
39713      ENDIF
39714C
39715      RETURN
39716      END
39717      SUBROUTINE DPMECL(XMEAN,XSD,N,ALPHA,IWRITE,ALOWLM,AUPPLM,
39718     1                  IBUGA3,IERROR)
39719C
39720C     PURPOSE--FOR A GIVEN MEAN, SD, N, AND ALPHA, COMPUTE THE
39721C              LOWER AND UPPER CONFIDENCE LIMITS FOR THE MEAN.
39722C              THIS IS PRIMARILY USED BY THE CROSS TABULATE COMMAND.
39723C     WRITTEN BY--JAMES J. FILLIBEN
39724C                 STATISTICAL ENGINEERING DIVISION
39725C                 INFORMATION TECHNOLOGY LABORATORY
39726C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
39727C                 GAITHERSBURG, MD 20899-8980
39728C                 PHONE--301-975-2855
39729C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
39730C           OF THE NATIONAL BUREAU OF STANDARDS.
39731C     LANGUAGE--ANSI FORTRAN (1977)
39732C     VERSION NUMBER--2009/5
39733C     ORIGINAL VERSION--MAY       2009.
39734C
39735C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
39736C
39737      CHARACTER*4 IWRITE
39738      CHARACTER*4 IBUGA3
39739      CHARACTER*4 IERROR
39740C
39741      CHARACTER*4 ISUBN1
39742      CHARACTER*4 ISUBN2
39743C
39744C---------------------------------------------------------------------
39745C
39746      REAL XMEAN
39747      REAL ALPHA
39748      REAL ALOWLM
39749      REAL AUPPLM
39750      INTEGER N
39751C
39752C---------------------------------------------------------------------
39753C
39754      INCLUDE 'DPCOP2.INC'
39755C
39756C-----START POINT-----------------------------------------------------
39757C
39758      ISUBN1='DPME'
39759      ISUBN2='CL  '
39760      IERROR='NO'
39761      AN=REAL(N)
39762C
39763      IF(IBUGA3.EQ.'ON')THEN
39764        WRITE(ICOUT,999)
39765  999   FORMAT(1X)
39766        CALL DPWRST('XXX','BUG ')
39767        WRITE(ICOUT,51)
39768   51   FORMAT('***** AT THE BEGINNING OF DPMECL--')
39769        CALL DPWRST('XXX','BUG ')
39770        WRITE(ICOUT,52)IBUGA3,IWRITE
39771   52   FORMAT('IBUGA3,IWRITE = ',A4,2X,A4)
39772        CALL DPWRST('XXX','BUG ')
39773        WRITE(ICOUT,53)XMEAN,N,ALPHA
39774   53   FORMAT('XMEAN,N,ALPHA = ',G15.7,I8,G15.7)
39775        CALL DPWRST('XXX','BUG ')
39776        WRITE(ICOUT,999)
39777        CALL DPWRST('XXX','BUG ')
39778      ENDIF
39779C
39780C               ********************************
39781C               **  STEP 1--                  **
39782C               **  CHECK FOR INPUT ERRORS    **
39783C               ********************************
39784C
39785      IF(N.LT.1)THEN
39786        IERROR='YES'
39787        WRITE(ICOUT,999)
39788        CALL DPWRST('XXX','BUG ')
39789        WRITE(ICOUT,151)
39790  151   FORMAT('***** ERROR IN DPMECL--')
39791        CALL DPWRST('XXX','BUG ')
39792        WRITE(ICOUT,152)
39793  152   FORMAT('      THE INPUT SAMPLE SIZE FOR THE MEAN CONFIDENCE')
39794        CALL DPWRST('XXX','BUG ')
39795        WRITE(ICOUT,154)
39796  154   FORMAT('      LIMITS IS LESS THAN 1.')
39797        CALL DPWRST('XXX','BUG ')
39798        WRITE(ICOUT,157)N
39799  157   FORMAT('      THE INPUT SAMPLE SIZE            = ',I8)
39800        CALL DPWRST('XXX','BUG ')
39801        GOTO9000
39802      ENDIF
39803C
39804      ALPHSV=ALPHA
39805      IF(ALPHA.GT.1.0 .AND. ALPHA.LE.100.0)ALPHA=ALPHA/100.0
39806      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
39807        IERROR='YES'
39808        WRITE(ICOUT,999)
39809        CALL DPWRST('XXX','BUG ')
39810        WRITE(ICOUT,171)
39811  171   FORMAT('***** ERROR IN DPMECL--')
39812        CALL DPWRST('XXX','BUG ')
39813        WRITE(ICOUT,172)
39814  172   FORMAT('      THE VALUE OF ALPHA IS OUTSIDE THE (0,1) ',
39815     1         'INTERVAL.')
39816        CALL DPWRST('XXX','BUG ')
39817        WRITE(ICOUT,177)ALPHA
39818  177   FORMAT('      THE VALUE OF ALPHA = ',G15.7)
39819        CALL DPWRST('XXX','BUG ')
39820        GOTO9000
39821      ENDIF
39822C
39823C               ********************************************
39824C               **  STEP 2--                              **
39825C               **  COMPUTE THE MEAN CONFIDENCE INTERVALS **
39826C               ********************************************
39827C
39828      ALP=ALPHA
39829      IF(ALP.LT.0.5)THEN
39830        ALP=1.0-ALP
39831      ENDIF
39832C
39833      ALP=1.0 - ALP
39834      P1=ALP/2.0
39835      P2=1.0-(ALP/2.0)
39836      AN=REAL(N)
39837C
39838      IF(N.LE.1)THEN
39839        ALOWLM=XMEAN
39840        AUPPLM=XMEAN
39841      ELSE
39842        IDF=N-1
39843        CALL TPPF(P2,REAL(IDF),ZALPHA)
39844        ALOWLM=XMEAN - ZALPHA*XSD/SQRT(AN)
39845        AUPPLM=XMEAN + ZALPHA*XSD/SQRT(AN)
39846      ENDIF
39847C
39848C               *****************
39849C               **  STEP 90--  **
39850C               **  EXIT.      **
39851C               *****************
39852C
39853 9000 CONTINUE
39854C
39855      IF(IBUGA3.EQ.'ON')THEN
39856        WRITE(ICOUT,999)
39857        CALL DPWRST('XXX','BUG ')
39858        WRITE(ICOUT,9011)
39859 9011   FORMAT('***** AT THE END       OF DPMECL--')
39860        CALL DPWRST('XXX','BUG ')
39861        WRITE(ICOUT,9012)IBUGA3,IERROR
39862 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
39863        CALL DPWRST('XXX','BUG ')
39864        WRITE(ICOUT,9013)ZALPHA,XSD,SQRT(AN)
39865 9013   FORMAT('ZALPHA,XSD,SQRT(AN) = ',3G15.7)
39866        CALL DPWRST('XXX','BUG ')
39867        WRITE(ICOUT,9014)ALOWLM,AUPPLM
39868 9014   FORMAT('ALOWLM,AUPPLM = ',G15.7,2X,G15.7)
39869        CALL DPWRST('XXX','BUG ')
39870        WRITE(ICOUT,9015)ALPHA,ALP,P1,P2
39871 9015   FORMAT('ALPHA,ALP,P1,P2 = ',4G15.7)
39872        CALL DPWRST('XXX','BUG ')
39873      ENDIF
39874C
39875      RETURN
39876      END
39877      SUBROUTINE DPMED3(X1,X2,X3,XMED3,IBUGG3,IERROR)
39878C
39879C     PURPOSE--THIS SUBROUTINE COMPUTES THE
39880C              SAMPLE MEDIAN
39881C              OF THE 3 NUMBERS X1, X2, AND X3.
39882C     OUTPUT ARGUMENTS--XMED3  = THE SINGLE PRECISION VALUE OF THE
39883C                                COMPUTED SAMPLE MEDIAN.
39884C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
39885C             SAMPLE MEDIAN.
39886C     LANGUAGE--ANSI FORTRAN (1977)
39887C     REFERENCES--MCNEIL, INTERACTIVE DATA ANALYSIS
39888C                 1977, PAGE 145
39889C                 (= SOURCE OF ALGORITHM).
39890C     WRITTEN BY--JAMES J. FILLIBEN
39891C                 STATISTICAL ENGINEERING DIVISION
39892C                 INFORMATION TECHNOLOGY LABORATORY
39893C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
39894C                 Gaithersburg, MD 20899-8980
39895C                 PHONE--301-975-2855
39896C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
39897C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
39898C     VERSION NUMBER--83.6
39899C     ORIGINAL VERSION--JULY      1983.
39900C
39901C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
39902C
39903      CHARACTER*4 IBUGG3
39904      CHARACTER*4 IERROR
39905C
39906C---------------------------------------------------------------------
39907C
39908      INCLUDE 'DPCOP2.INC'
39909C
39910C-----START POINT-----------------------------------------------------
39911C
39912      IERROR='NO'
39913C
39914      IF(IBUGG3.EQ.'OFF')GOTO90
39915      WRITE(ICOUT,999)
39916  999 FORMAT(1X)
39917      CALL DPWRST('XXX','BUG ')
39918      WRITE(ICOUT,51)
39919   51 FORMAT('***** AT THE BEGINNING OF DPMED3--')
39920      CALL DPWRST('XXX','BUG ')
39921      WRITE(ICOUT,52)IBUGG3
39922   52 FORMAT('IBUGG3 = ',A4)
39923      CALL DPWRST('XXX','BUG ')
39924      WRITE(ICOUT,53)X1,X2,X3
39925   53 FORMAT('X1,X2,X3 = ',3E15.7)
39926      CALL DPWRST('XXX','BUG ')
39927   90 CONTINUE
39928C
39929C               **********************
39930C               **  COMPUTE MEDIAN  **
39931C               **********************
39932C
39933      XMED3=X2
39934      IF(X1.LE.X2.AND.X2.LE.X3)GOTO9000
39935      IF(X3.LE.X2.AND.X2.LE.X1)GOTO9000
39936C
39937      XMED3=X1
39938      IF(X2.LE.X1.AND.X1.LE.X3)GOTO9000
39939      IF(X3.LE.X1.AND.X1.LE.X2)GOTO9000
39940C
39941      XMED3=X3
39942      GOTO9000
39943C
39944C               *****************
39945C               **  STEP 90--  **
39946C               **  EXIT.      **
39947C               *****************
39948C
39949 9000 CONTINUE
39950      IF(IBUGG3.EQ.'OFF')GOTO9090
39951      WRITE(ICOUT,999)
39952      CALL DPWRST('XXX','BUG ')
39953      WRITE(ICOUT,9011)
39954 9011 FORMAT('***** AT THE END       OF DPMED3--')
39955      CALL DPWRST('XXX','BUG ')
39956      WRITE(ICOUT,9012)IBUGG3,IERROR
39957 9012 FORMAT('IBUGG3,IERROR = ',A4,2X,A4)
39958      CALL DPWRST('XXX','BUG ')
39959      WRITE(ICOUT,9013)X1,X2,X3
39960 9013 FORMAT('X1,X2,X3 = ',3E15.7)
39961      CALL DPWRST('XXX','BUG ')
39962      WRITE(ICOUT,9014)XMED3
39963 9014 FORMAT('XMED3 = ',E15.7)
39964      CALL DPWRST('XXX','BUG ')
39965 9090 CONTINUE
39966C
39967      RETURN
39968      END
39969      SUBROUTINE DPMEDM(NLAB,AMEAN,ASD,TEMP1,TEMP2,
39970     1                  IWRITE,ICAPSW,ICAPTY,NUMDIG,MAXNXT,
39971     1                  XMEDME,SEMEK1,SEMEK2,ALOWCL,AUPPCL,
39972     1                  ISUBRO,IBUGA3,IERROR)
39973C
39974C     PURPOSE--COMPUTE A CONSENSUS VALUE BASED ON THE MEDIAN OF THE
39975C              MEANS.  THIS IS A MORE ROBUST VERSION OF THE MEAN OF
39976C              MEANS METHOD (I.E., PROTECTS AGAINST OUTLIER LABS).
39977C              THE ASSOCIATED UNCERTAINTY IS:
39978C
39979C                u(med(x)) = SQRT(PI/(2*NLAB))*MADe
39980C
39981C              WHERE MADe = 1.483*MAD WITH MAD DENOTING THE MEDIAN
39982C              ABSOLUTE DEVIATION.
39983C
39984C              THE ADVANTAGE OF THIS METHOD IS THAT IT PROTECTS AGAINST
39985C              OUTLYING LAB MEANS.  AS WITH MEAN OF MEANS METHOD, THE
39986C              DISADVANTAGE OF THIS METHOD IS THAT IT DOES NOT TAKE
39987C              WITHIN-LAB VARIANCE INTO ACCOUNT.
39988C
39989C     REFERENCE--CCQM GUIDANCE note: Estimation of a consensus KCRV and
39990C                associated Degrees of Equivalence", Version: 10,
39991C                2013-04-12, pp. 25-26.
39992C     PRINTING--YES
39993C     SUBROUTINES NEEDED--MEDIAN, MAD
39994C     WRITTEN BY--ALAN HECKERT
39995C                 STATISTICAL ENGINEERING DIVISION
39996C                 INFORMATION TECHNOLOGY LABORATORY
39997C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
39998C                 GAITHERSBURG, MD 20899-8980
39999C                 PHONE--301-975-2899
40000C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
40001C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
40002C     LANGUAGE--ANSI FORTRAN (1977)
40003C     VERSION NUMBER--2017/03
40004C     ORIGINAL VERSION--MARCH     2017.
40005C
40006C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
40007C
40008      DIMENSION AMEAN(*)
40009      DIMENSION ASD(*)
40010      DIMENSION TEMP1(*)
40011      DIMENSION TEMP2(*)
40012C
40013      CHARACTER*4 ICAPSW
40014      CHARACTER*4 ICAPTY
40015      CHARACTER*4 ISUBRO
40016      CHARACTER*4 IBUGA3
40017      CHARACTER*4 IERROR
40018C
40019      CHARACTER*4 IWRITE
40020      CHARACTER*4 ISUBN1
40021      CHARACTER*4 ISUBN2
40022C
40023C----------------------------------------------------------------
40024C
40025      INCLUDE 'DPCOST.INC'
40026C
40027      PARAMETER (MAXROW=20)
40028      CHARACTER*60 ITITLE
40029      CHARACTER*60 ITITLZ
40030      CHARACTER*60 ITITL9
40031      CHARACTER*60 ITEXT(MAXROW)
40032      REAL         AVALUE(MAXROW)
40033      INTEGER      NCTEXT(MAXROW)
40034      INTEGER      IDIGIT(MAXROW)
40035      INTEGER      NTOT(MAXROW)
40036      LOGICAL IFRST
40037      LOGICAL ILAST
40038C
40039      INCLUDE 'DPCOP2.INC'
40040C
40041      DATA PI /3.14159265/
40042C
40043C-----START POINT------------------------------------------------
40044C
40045      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MEDM')THEN
40046        WRITE(ICOUT,999)
40047  999   FORMAT(1X)
40048        CALL DPWRST('XXX','BUG ')
40049        WRITE(ICOUT,51)
40050   51   FORMAT('***** AT THE BEGINNING OF DPMEDM--')
40051        CALL DPWRST('XXX','BUG ')
40052        WRITE(ICOUT,52)NLAB
40053   52   FORMAT('NLAB = ',I8)
40054        CALL DPWRST('XXX','BUG ')
40055        DO60I=1,NLAB
40056          WRITE(ICOUT,62)I,AMEAN(I),ASD(I)
40057   62     FORMAT('I,AMEAN(I),ASD(I) = ',I8,2G15.7)
40058          CALL DPWRST('XXX','BUG ')
40059   60   CONTINUE
40060      ENDIF
40061C
40062      IERROR='NO'
40063      ISUBN1='DPME'
40064      ISUBN2='DM  '
40065C
40066C     STEP 1: COMPUTE THE MEDIAN OF THE MEANS
40067C
40068      CALL MEDIAN(AMEAN,NLAB,IWRITE,TEMP1,MAXNXT,XMEDME,IBUGA3,IERROR)
40069C
40070C     STEP 2: COMPUTE THE MADe
40071C
40072      CALL MAD(AMEAN,NLAB,IWRITE,TEMP1,TEMP2,MAXNXT,XMAD,IBUGA3,IERROR)
40073      XMADE=XMAD/0.67449
40074      SEMEK1=SQRT(PI/(2.0*REAL(NLAB)))*XMADE
40075      SEMEK2=2.0*SEMEK1
40076C
40077C     STEP 3: COMPUTE 95% CONFIDENCE INTERVAL
40078C
40079      ALPHA=0.975
40080      CALL NORPPF(ALPHA,TVAL)
40081      ALOWCL=XMEDME - TVAL*SEMEK1
40082      AUPPCL=XMEDME + TVAL*SEMEK1
40083C
40084      IF(IPRINT.EQ.'OFF')GOTO9000
40085C
40086      ITITLE=' '
40087      NCTITL=0
40088      ITITLZ=' '
40089      NCTITZ=0
40090C
40091      ICNT=1
40092      ITEXT(ICNT)='14. Method: Median of Means'
40093      NCTEXT(ICNT)=27
40094      AVALUE(ICNT)=0.0
40095      IDIGIT(ICNT)=-1
40096C
40097      ICNT=ICNT+1
40098      ITEXT(ICNT)='    Median of Lab Means:'
40099      NCTEXT(ICNT)=22
40100      AVALUE(ICNT)=XMEDME
40101      IDIGIT(ICNT)=NUMDIG
40102      ICNT=ICNT+1
40103      ITEXT(ICNT)='    Scaled Median Absolute Deviation of Lab Means:'
40104      NCTEXT(ICNT)=40
40105      AVALUE(ICNT)=XMADE
40106      IDIGIT(ICNT)=NUMDIG
40107      ICNT=ICNT+1
40108      ITEXT(ICNT)='    Standard Uncertainty (k = 1):'
40109      NCTEXT(ICNT)=33
40110      AVALUE(ICNT)=SEMEK1
40111      IDIGIT(ICNT)=NUMDIG
40112      ICNT=ICNT+1
40113      ITEXT(ICNT)='    Expanded Uncertainty (k = 2):'
40114      NCTEXT(ICNT)=33
40115      AVALUE(ICNT)=SEMEK2
40116      IDIGIT(ICNT)=NUMDIG
40117      ICNT=ICNT+1
40118      ITEXT(ICNT)='    Lower 95% (normal) Confidence Limit:'
40119      NCTEXT(ICNT)=40
40120      AVALUE(ICNT)=ALOWCL
40121      IDIGIT(ICNT)=NUMDIG
40122      ICNT=ICNT+1
40123      ITEXT(ICNT)='    Upper 95% (normal) Confidence Limit:'
40124      NCTEXT(ICNT)=40
40125      AVALUE(ICNT)=AUPPCL
40126      IDIGIT(ICNT)=NUMDIG
40127      ICNT=ICNT+1
40128      ITEXT(ICNT)='    Note: Median of Means Best Usage:'
40129      NCTEXT(ICNT)=37
40130      AVALUE(ICNT)=0.0
40131      IDIGIT(ICNT)=-1
40132      ICNT=ICNT+1
40133      ITEXT(ICNT)='          Number of Labs >= 5:'
40134      NCTEXT(ICNT)=30
40135      AVALUE(ICNT)=0.0
40136      IDIGIT(ICNT)=-1
40137C
40138      NUMROW=ICNT
40139      DO310I=1,NUMROW
40140        NTOT(I)=15
40141  310 CONTINUE
40142C
40143      IFRST=.TRUE.
40144      ILAST=.TRUE.
40145      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
40146     1            AVALUE,IDIGIT,
40147     1            NTOT,NUMROW,
40148     1            ICAPSW,ICAPTY,ILAST,IFRST,
40149     1            ISUBRO,IBUGA3,IERROR)
40150      ITITLE=' '
40151      NCTITL=0
40152      ITITLZ=' '
40153      NCTITZ=0
40154      ITITL9=' '
40155      NCTIT9=0
40156C
40157C               *****************
40158C               **  STEP 90--  **
40159C               **  EXIT       **
40160C               *****************
40161C
40162 9000 CONTINUE
40163      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MEDM')THEN
40164        WRITE(ICOUT,999)
40165        CALL DPWRST('XXX','BUG ')
40166        WRITE(ICOUT,9011)
40167 9011   FORMAT('***** AT THE END       OF DPMEDM--')
40168        CALL DPWRST('XXX','BUG ')
40169        WRITE(ICOUT,9015)XMEDME,SEMEK1,SEMEK2,ALOWCL,AUPPCL
40170 9015   FORMAT('XMEDME,SEMEK1,SEMEK2,ALOWCL,AUPPCL = ',5G15.7)
40171        CALL DPWRST('XXX','BUG ')
40172      ENDIF
40173C
40174      RETURN
40175      END
40176      SUBROUTINE DPMEPO(ICAPSW,IFORSW,
40177     1                  IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
40178C
40179C     PURPOSE--CARRY OUT A MEDIAN POLISH.
40180C     WRITTEN BY--JAMES J. FILLIBEN
40181C                 STATISTICAL ENGINEERING DIVISION
40182C                 INFORMATION TECHNOLOGY LABORATORY
40183C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
40184C                 GAITHERSBURG, MD 20899-8980
40185C                 PHONE--301-975-2855
40186C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
40187C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
40188C     LANGUAGE--ANSI FORTRAN (1977)
40189C     VERSION NUMBER--82/7
40190C     ORIGINAL VERSION--FEBRUARY  1981.
40191C     UPDATED         --SEPTEMBER 1981.
40192C     UPDATED         --DECEMBER  1981.
40193C     UPDATED         --MAY       1982.
40194C     UPDATED         --MARCH     1988. ADD LOFCDF
40195C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
40196C                                       MOVE DIMENSIONING OF Y2 AND Z
40197C     UPDATED         --MAY       2011. USE DPPARS
40198C     UPDATED         --MAY       2011. SUPPORT FOR HTML, LATEX, RTF OUTPUT
40199C     UPDATED         --JULY      2019. TWEAK SCRATCH STORAGE
40200C
40201C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
40202C
40203      CHARACTER*4 ICAPSW
40204      CHARACTER*4 IFORSW
40205      CHARACTER*4 IBUGA2
40206      CHARACTER*4 IBUGA3
40207      CHARACTER*4 IBUGQ
40208      CHARACTER*4 ISUBRO
40209      CHARACTER*4 IFOUND
40210      CHARACTER*4 IERROR
40211C
40212      CHARACTER*4 IREPU
40213      CHARACTER*4 IRESU
40214      CHARACTER*4 ISUBN1
40215      CHARACTER*4 ISUBN2
40216      CHARACTER*4 ISTEPN
40217C
40218      CHARACTER*40 INAME
40219      PARAMETER (MAXSPN=30)
40220      CHARACTER*4 IVARN1(MAXSPN)
40221      CHARACTER*4 IVARN2(MAXSPN)
40222      CHARACTER*4 IVARTY(MAXSPN)
40223      REAL PVAR(MAXSPN)
40224      INTEGER ILIS(MAXSPN)
40225      INTEGER NRIGHT(MAXSPN)
40226      INTEGER ICOLR(MAXSPN)
40227C
40228C---------------------------------------------------------------------
40229C
40230      INCLUDE 'DPCOPA.INC'
40231C
40232      PARAMETER (MAXLEV=500)
40233      PARAMETER (MAXFAC=5)
40234C
40235      DIMENSION PRED2(MAXOBV)
40236      DIMENSION RES2(MAXOBV)
40237      DIMENSION W(MAXOBV)
40238      DIMENSION Y2(MAXOBV)
40239      DIMENSION Z(MAXOBV)
40240      DIMENSION TEMP1(MAXOBV)
40241C
40242      DIMENSION F1(MAXOBV,MAXFAC)
40243      DIMENSION F1ID(MAXLEV,MAXFAC)
40244      DIMENSION F1N(MAXLEV,MAXFAC)
40245      DIMENSION F1TYP(MAXLEV,MAXFAC)
40246      DIMENSION F1MEAN(MAXLEV,MAXFAC)
40247      DIMENSION F1EFFE(MAXLEV,MAXFAC)
40248      DIMENSION F1EFSD(MAXLEV,MAXFAC)
40249C
40250      DIMENSION B(MAXLEV)
40251      DIMENSION SDB(MAXLEV)
40252      DIMENSION FCUM(MAXLEV)
40253      DIMENSION Y2MED(MAXLEV)
40254      DIMENSION N1(MAXFAC)
40255      DIMENSION ISET(MAXFAC)
40256      DIMENSION AN1(MAXFAC)
40257      DIMENSION E1(MAXFAC)
40258      DIMENSION SS1(MAXFAC)
40259      DIMENSION RESMS1(MAXFAC)
40260      DIMENSION FVAL(MAXFAC)
40261      DIMENSION F1CDF2(MAXFAC)
40262      DIMENSION RSD(MAXFAC)
40263C
40264      INCLUDE 'DPCOZZ.INC'
40265      EQUIVALENCE (GARBAG(IGARB1),F1(1,1))
40266      EQUIVALENCE (GARBAG(IGAR10),PRED2(1))
40267      EQUIVALENCE (GARBAG(JGAR11),RES2(1))
40268      EQUIVALENCE (GARBAG(JGAR12),W(1))
40269      EQUIVALENCE (GARBAG(JGAR13),Y2(1))
40270      EQUIVALENCE (GARBAG(JGAR14),B(1))
40271      EQUIVALENCE (GARBAG(JGAR15),SDB(1))
40272      EQUIVALENCE (GARBAG(JGAR16),FCUM(1))
40273      EQUIVALENCE (GARBAG(JGAR17),Y2MED(1))
40274      EQUIVALENCE (GARBAG(JGAR18),F1ID(1,1))
40275      EQUIVALENCE (GARBAG(JGAR19),F1N(1,1))
40276      EQUIVALENCE (GARBAG(IGAR11),F1TYP(1,1))
40277      EQUIVALENCE (GARBAG(IGAR12),F1MEAN(1,1))
40278      EQUIVALENCE (GARBAG(IGAR13),F1EFFE(1,1))
40279      EQUIVALENCE (GARBAG(IGAR14),F1EFSD(1,1))
40280      EQUIVALENCE (GARBAG(IGAR15),AN1(1))
40281      EQUIVALENCE (GARBAG(IGAR15+100),E1(1))
40282      EQUIVALENCE (GARBAG(IGAR15+200),SS1(1))
40283      EQUIVALENCE (GARBAG(IGAR15+300),RESMS1(1))
40284      EQUIVALENCE (GARBAG(IGAR15+400),FVAL(1))
40285      EQUIVALENCE (GARBAG(IGAR15+500),F1CDF2(1))
40286      EQUIVALENCE (GARBAG(IGAR15+600),RSD(1))
40287      EQUIVALENCE (GARBAG(IGAR16),TEMP1(1))
40288      EQUIVALENCE (GARBAG(IGAR17),Z(1))
40289C
40290C-----COMMON----------------------------------------------------------
40291C
40292      INCLUDE 'DPCOHK.INC'
40293      INCLUDE 'DPCODA.INC'
40294      INCLUDE 'DPCOSU.INC'
40295      INCLUDE 'DPCOP2.INC'
40296C
40297C-----START POINT-----------------------------------------------------
40298C
40299      ISUBN1='DPME'
40300      ISUBN2='PO  '
40301      IERROR='NO'
40302C
40303      MAXCP1=MAXCOL+1
40304      MAXCP2=MAXCOL+2
40305      MAXCP3=MAXCOL+3
40306      MAXCP4=MAXCOL+4
40307      MAXCP5=MAXCOL+5
40308      MAXCP6=MAXCOL+6
40309C
40310C               *******************************************
40311C               **  TREAT THE MEDIAN POLISH        CASE  **
40312C               *******************************************
40313C
40314      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MEPO')THEN
40315        WRITE(ICOUT,999)
40316  999   FORMAT(1X)
40317        CALL DPWRST('XXX','BUG ')
40318        WRITE(ICOUT,51)
40319   51   FORMAT('***** AT THE BEGINNING OF DPMEPO--')
40320        CALL DPWRST('XXX','BUG ')
40321        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO
40322   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
40323        CALL DPWRST('XXX','BUG ')
40324      ENDIF
40325C
40326C               ***************************
40327C               **  STEP 1--             **
40328C               **  EXTRACT THE COMMAND  **
40329C               ***************************
40330C
40331      ISTEPN='1'
40332      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MEPO')
40333     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40334C
40335      IF(ICOM.EQ.'MEDI'.AND.IHARG(1).EQ.'POLI')THEN
40336        ILASTC=1
40337      ELSE
40338        IFOUND='NO'
40339        GOTO9000
40340      ENDIF
40341C
40342      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
40343      IFOUND='YES'
40344C
40345C               *********************************
40346C               **  STEP 2--                   **
40347C               **  EXTRACT THE VARIABLE LIST  **
40348C               *********************************
40349C
40350      ISTEPN='2'
40351      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
40352     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40353C
40354      INAME='MEIDAN POLISH'
40355      MINNA=1
40356      MAXNA=100
40357      MINN2=2
40358      IFLAGE=1
40359      IFLAGM=0
40360      IFLAGP=0
40361      JMIN=1
40362      JMAX=NUMARG
40363      MINNVA=2
40364      MAXNVA=MAXFAC+1
40365C
40366      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
40367     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
40368     1            JMIN,JMAX,
40369     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
40370     1            IVARN1,IVARN2,IVARTY,PVAR,
40371     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
40372     1            MINNVA,MAXNVA,
40373     1            IFLAGM,IFLAGP,
40374     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
40375      IF(IERROR.EQ.'YES')GOTO9000
40376C
40377      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')THEN
40378        WRITE(ICOUT,999)
40379        CALL DPWRST('XXX','BUG ')
40380        WRITE(ICOUT,281)
40381  281   FORMAT('***** AFTER CALL DPPARS--')
40382        CALL DPWRST('XXX','BUG ')
40383        WRITE(ICOUT,282)NQ,NUMVAR
40384  282   FORMAT('NQ,NUMVAR = ',2I8)
40385        CALL DPWRST('XXX','BUG ')
40386        IF(NUMVAR.GT.0)THEN
40387          DO285I=1,NUMVAR
40388            WRITE(ICOUT,287)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
40389     1                      ICOLR(I)
40390  287       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
40391     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
40392            CALL DPWRST('XXX','BUG ')
40393  285     CONTINUE
40394        ENDIF
40395      ENDIF
40396C
40397      NUMFAC=NUMVAR-1
40398      J=0
40399      IMAX=NRIGHT(1)
40400      IF(NQ.LT.NRIGHT(1))IMAX=NQ
40401      DO660I=1,IMAX
40402        IF(ISUB(I).EQ.0)GOTO660
40403        J=J+1
40404C
40405        IJ=MAXN*(ICOLR(1)-1)+I
40406        IF(ICOLR(1).LE.MAXCOL)Y(J)=V(IJ)
40407        IF(ICOLR(1).EQ.MAXCP1)Y(J)=PRED(I)
40408        IF(ICOLR(1).EQ.MAXCP2)Y(J)=RES(I)
40409        IF(ICOLR(1).EQ.MAXCP3)Y(J)=YPLOT(I)
40410        IF(ICOLR(1).EQ.MAXCP4)Y(J)=XPLOT(I)
40411        IF(ICOLR(1).EQ.MAXCP5)Y(J)=X2PLOT(I)
40412        IF(ICOLR(1).EQ.MAXCP6)Y(J)=TAGPLO(I)
40413C
40414        DO659LL=1,NUMFAC
40415          ICOLT=ICOLR(LL+1)
40416          IJ=MAXN*(ICOLT-1)+I
40417          IF(ICOLT.LE.MAXCOL)F1(J,LL)=V(IJ)
40418          IF(ICOLT.EQ.MAXCP1)F1(J,LL)=PRED(I)
40419          IF(ICOLT.EQ.MAXCP2)F1(J,LL)=RES(I)
40420          IF(ICOLT.EQ.MAXCP3)F1(J,LL)=YPLOT(I)
40421          IF(ICOLT.EQ.MAXCP4)F1(J,LL)=XPLOT(I)
40422          IF(ICOLT.EQ.MAXCP5)F1(J,LL)=X2PLOT(I)
40423          IF(ICOLT.EQ.MAXCP6)F1(J,LL)=TAGPLO(I)
40424 659    CONTINUE
40425C
40426  660 CONTINUE
40427      NS=J
40428C
40429C               **************************************************
40430C               **  STEP 8--                                    **
40431C               **  PREPARE FOR ENTRANCE INTO DPMED2--          **
40432C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.  **
40433C               **************************************************
40434C
40435      ISTEPN='8'
40436      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MEPO')
40437     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40438C
40439      DO680I=1,NS
40440        W(I)=1.0
40441  680 CONTINUE
40442C
40443C               ***********************************
40444C               **  STEP 9--                     **
40445C               **  CARRY OUT THE MEDIAN POLISH  **
40446C               ***********************************
40447C
40448      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MEPO')THEN
40449        ISTEPN='9'
40450        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40451        WRITE(ICOUT,999)
40452        CALL DPWRST('XXX','BUG ')
40453        WRITE(ICOUT,711)
40454  711   FORMAT('***** FROM DPMEPO, AS WE ARE ABOUT TO CALL DPMEP2--')
40455        CALL DPWRST('XXX','BUG ')
40456        WRITE(ICOUT,712)ICOLR(1),MAXN,NS,NUMFAC
40457  712   FORMAT('ICOLR(1),MAXN,NS,NUMFAC = ',4I8)
40458        CALL DPWRST('XXX','BUG ')
40459        DO715I=1,NS
40460          WRITE(ICOUT,716)I,Y(I),(F1(I,LL),LL=1,MAXFAC),W(I)
40461  716     FORMAT('I,Y(I),F1(I),F2(I),F3(I),F4(I),F5(I),W(I) = ',
40462     1           I6,2X,7F10.5)
40463          CALL DPWRST('XXX','BUG ')
40464  715   CONTINUE
40465      ENDIF
40466C
40467      CALL DPMEP2(Y,F1,W,NS,NUMFAC,
40468     1            MAXOBV,MAXLEV,MAXFAC,
40469     1            B,SDB,FCUM,
40470     1            REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
40471     1            Y2,Z,TEMP1,
40472     1            F1ID,F1N,F1TYP,F1MEAN,F1EFFE,F1EFSD,Y2MED,
40473     1            N1,ISET,AN1,E1,SS1,RESMS1,FVAL,F1CDF2,RSD,
40474     1            ICAPSW,ICAPTY,IFORSW,
40475     1            IBUGA3,ISUBRO,IERROR)
40476C
40477C               ***************************************
40478C               **  STEP 10--                        **
40479C               **  UPDATE INTERNAL DATAPLOT TABLES  **
40480C               ***************************************
40481C
40482      ISTEPN='10'
40483      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MEPO')
40484     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40485C
40486      ICOLPR=MAXCP1
40487      ICOLRE=MAXCP2
40488      IREPU='ON'
40489      IRESU='ON'
40490      CALL UPDAPR(ICOLPR,ICOLRE,PRED2,RES2,PRED,RES,ISUB,NLEFT,
40491     1IREPU,REPSD,REPDF,IRESU,RESSD,RESDF,ALFCDF,
40492     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
40493     1IANS,IWIDTH,ILOCN,IBUGA3,IERROR)
40494C
40495C               *****************
40496C               **  STEP 90--  **
40497C               **  EXIT       **
40498C               *****************
40499C
40500 9000 CONTINUE
40501      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MEPO')THEN
40502        WRITE(ICOUT,999)
40503        CALL DPWRST('XXX','BUG ')
40504        WRITE(ICOUT,9011)
40505 9011   FORMAT('***** AT THE END       OF DPMEPO--')
40506        CALL DPWRST('XXX','BUG ')
40507        WRITE(ICOUT,9014)NS,NUMFAC
40508 9014   FORMAT('NS,NUMFAC = ',2I8)
40509        CALL DPWRST('XXX','BUG ')
40510        WRITE(ICOUT,9016)IFOUND,IERROR
40511 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
40512        CALL DPWRST('XXX','BUG ')
40513      ENDIF
40514C
40515      RETURN
40516      END
40517      SUBROUTINE DPMEP2(Y,F1,W,N,NUMFAC,
40518     1                  MAXOBV,MAXLEV,MAXFAC,
40519     1                  B,SDB,FCUM,
40520     1                  REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
40521     1                  Y2,Z,TEMP1,
40522     1                  F1ID,F1N,F1TYP,F1MEAN,F1EFFE,F1EFSD,Y2MED,
40523     1                  N1,ISET,AN1,E1,SS1,RESMS1,FVAL,F1CDF2,RSD,
40524     1                  ICAPSW,ICAPTY,IFORSW,
40525     1                  IBUGA3,ISUBRO,IERROR)
40526C
40527CCCCC JUNE, 1990.  MOVE DIMENSIONING OF Y2 AND Z TO DPMEPO.
40528C
40529C     PURPOSE--PERFORM A MULTI-WAY MEDIAN POLISH
40530C              FOR 1, 2, 3, 4, OR 5 FACTORS.
40531C              THE ASSUMED MODEL IS RESPONSE = CONSTANT + FACTOR-1 EFFECT + ...
40532C                                              FACTOR-NUMFAC EFFECT + ERROR
40533C     NOTE-- LINES NEAR 390 NEED TO BE GENERALIZED FOR
40534C            UNEQUAL NUMBER OF OBS PER CELL.
40535C     PRINTING--YES
40536C     SUBROUTINES NEEDED--FCDF
40537C     WRITTEN BY--JAMES J. FILLIBEN
40538C                 STATISTICAL ENGINEERING DIVISION
40539C                 INFORMATION TECHNOLOGY LABORATORY
40540C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
40541C                 Gaithersburg, MD 20899-8980
40542C                 PHONE--301-975-2855
40543C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
40544C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
40545C     LANGUAGE--ANSI FORTRAN (1977)
40546C     VERSION NUMBER--82/7
40547C     ORIGINAL VERSION--APRIL     1978.
40548C     UPDATED         --NOVEMBER  1978.
40549C     UPDATED         --JULY      1979.
40550C     UPDATED         --FEBRUARY  1981.
40551C     UPDATED         --JULY      1981.
40552C     UPDATED         --OCTOBER   1981.
40553C     UPDATED         --NOVEMBER  1981.
40554C     UPDATED         --MARCH     1982.
40555C     UPDATED         --MAY       1982.
40556C     UPDATED         --MARCH     1988. ADD LOFCDF
40557C     UPDATED         --JUNE      1990. MOVE DIMENSIONING OF Y2 AND Z
40558C     UPDATED         --JANUARY   1996. MAKE MAXIMUM NUMBER OF LEVELS
40559C                                       SETTABLE VIA PARAMETER
40560C                                       STATEMENT (AND PUT IN CHECKS
40561C                                       FOR EXCEEDING THIS MAXIMUM)
40562C     UPDATED         --MAY       2011. USE DPDTA1 AND DPDT5B TO PRINT
40563C                                       TABLES (ADDS SUPPORT FOR HTML,
40564C                                       LATEX, RTF OUTPUT)
40565C
40566C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
40567C
40568      CHARACTER*4 ICAPSW
40569      CHARACTER*4 ICAPTY
40570      CHARACTER*4 IFORSW
40571      CHARACTER*4 IBUGA3
40572      CHARACTER*4 ISUBRO
40573      CHARACTER*4 IERROR
40574C
40575      CHARACTER*4 IWRITE
40576      CHARACTER*4 IREP
40577      CHARACTER*4 ICASBL
40578C
40579      CHARACTER*4 ISUBN1
40580      CHARACTER*4 ISUBN2
40581      CHARACTER*4 ISTEPN
40582C
40583C---------------------------------------------------------------------
40584C
40585CCCCC JUNE, 1990.  MOVE DIMENSIONING OF Y2 AND Z TO DPMEPO
40586CCCCC       INCLUDE 'DPCOPA.INC'
40587C
40588      DIMENSION Y2(*)
40589      DIMENSION Y(*)
40590      DIMENSION Z(*)
40591      DIMENSION TEMP1(*)
40592      DIMENSION W(*)
40593      DIMENSION B(*)
40594      DIMENSION SDB(*)
40595      DIMENSION FCUM(*)
40596      DIMENSION PRED2(*)
40597      DIMENSION RES2(*)
40598      DIMENSION Y2MED(*)
40599      DIMENSION FVAL(*)
40600      DIMENSION RSD(*)
40601      DIMENSION AN1(*)
40602      DIMENSION E1(*)
40603      DIMENSION SS1(*)
40604      DIMENSION RESMS1(*)
40605      DIMENSION F1CDF2(*)
40606      DIMENSION N1(*)
40607      DIMENSION ISET(*)
40608C
40609      DIMENSION F1(MAXOBV,MAXLEV)
40610      DIMENSION F1ID(MAXLEV,MAXFAC)
40611      DIMENSION F1N(MAXLEV,MAXFAC)
40612      DIMENSION F1TYP(MAXLEV,MAXFAC)
40613      DIMENSION F1MEAN(MAXLEV,MAXFAC)
40614      DIMENSION F1EFFE(MAXLEV,MAXFAC)
40615      DIMENSION F1EFSD(MAXLEV,MAXFAC)
40616C
40617      PARAMETER(NUMCLI=5)
40618      PARAMETER(MAXLIN=2)
40619      PARAMETER (MAXROW=30)
40620      CHARACTER*60 ITITLE
40621      CHARACTER*60 ITITLZ
40622      CHARACTER*60 ITITL9
40623      CHARACTER*60 ITEXT(MAXROW)
40624      CHARACTER*4  ALIGN(NUMCLI)
40625      CHARACTER*4  VALIGN(NUMCLI)
40626      REAL         AVALUE(MAXROW)
40627      INTEGER      NCTEXT(MAXROW)
40628      INTEGER      IDIGIT(MAXROW)
40629      INTEGER      NTOT(MAXROW)
40630      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
40631      CHARACTER*30 IVALUE(MAXROW,NUMCLI)
40632      CHARACTER*4  ITYPCO(NUMCLI)
40633      INTEGER      NCTIT2(MAXLIN,NUMCLI)
40634      INTEGER      NCVALU(MAXROW,NUMCLI)
40635      INTEGER      IWHTML(NUMCLI)
40636      INTEGER      IWRTF(NUMCLI)
40637      REAL         AMAT(MAXROW,NUMCLI)
40638      LOGICAL IFRST
40639      LOGICAL ILAST
40640      LOGICAL IFLAGS
40641      LOGICAL IFLAGE
40642C
40643C---------------------------------------------------------------------
40644C
40645      INCLUDE 'DPCOP2.INC'
40646C
40647C-----START POINT-----------------------------------------------------
40648C
40649      IERROR='NO'
40650      IWRITE='OFF'
40651      ISUBN1='DPAN'
40652      ISUBN2='O2  '
40653C
40654      AN=N
40655      J1=0
40656      NIOLD=0
40657      MAXPAS=25
40658      CUTOFF=0.99
40659      GTYP=0.0
40660      FITCD2=0.0
40661C
40662      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MEP2')THEN
40663        WRITE(ICOUT,999)
40664  999   FORMAT(1X)
40665        CALL DPWRST('XXX','BUG ')
40666        WRITE(ICOUT,51)
40667   51   FORMAT('***** AT THE BEGINNING OF DPMEP2--')
40668        CALL DPWRST('XXX','BUG ')
40669        WRITE(ICOUT,52)N,NUMFAC,MAXLEV,MAXFAC
40670   52   FORMAT('N,NUMFAC,MAXLEV,MAXFAC = ',4I8)
40671        CALL DPWRST('XXX','BUG ')
40672        DO55I=1,N
40673          WRITE(ICOUT,56)I,Y(I),(F1(I,J),J=1,5),W(I)
40674   56     FORMAT('I,Y(I),F1(I),F2(I),F3(I),F4(I),F5(I),W(I) = ',
40675     1           I8,7E11.3)
40676          CALL DPWRST('XXX','BUG ')
40677   55   CONTINUE
40678        DO65I=1,N
40679          WRITE(ICOUT,66)I,(F1MEAN(I,J),J=1,5)
40680   66     FORMAT('I,(F1MEAN(I,J),J=1,5) = ',I8,5G15.7)
40681          CALL DPWRST('XXX','BUG ')
40682   65   CONTINUE
40683      ENDIF
40684C
40685C               ********************************************
40686C               **  STEP 1--                              **
40687C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
40688C               ********************************************
40689C
40690      IF(N.LT.2)THEN
40691        WRITE(ICOUT,999)
40692        CALL DPWRST('XXX','BUG ')
40693        WRITE(ICOUT,101)
40694  101   FORMAT('***** ERROR IN MEIDAN POLISH--')
40695        CALL DPWRST('XXX','BUG ')
40696        WRITE(ICOUT,102)
40697  102   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE MEDIAN POLISH')
40698        CALL DPWRST('XXX','BUG ')
40699        WRITE(ICOUT,103)
40700  103   FORMAT('      WAS LESS THAN TWO.')
40701        CALL DPWRST('XXX','BUG ')
40702        WRITE(ICOUT,104)N
40703  104   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
40704        CALL DPWRST('XXX','BUG ')
40705        WRITE(ICOUT,999)
40706        CALL DPWRST('XXX','BUG ')
40707        IERROR='YES'
40708        GOTO9000
40709      ENDIF
40710C
40711      IF(NUMFAC.LT.1.OR.NUMFAC.GT.MAXFAC)THEN
40712        WRITE(ICOUT,999)
40713        CALL DPWRST('XXX','BUG ')
40714        WRITE(ICOUT,101)
40715        CALL DPWRST('XXX','BUG ')
40716        WRITE(ICOUT,132)
40717  132   FORMAT('      THE NUMBER OF FACTORS FOR THE MEDIAN POLISH MUST')
40718        CALL DPWRST('XXX','BUG ')
40719        WRITE(ICOUT,133)MAXFAC
40720  133   FORMAT('      BE AT LEAST 1 AND AT MOST ',I6,'.')
40721        CALL DPWRST('XXX','BUG ')
40722        WRITE(ICOUT,134)NUMFAC
40723  134   FORMAT('      THE ENTERED NUMBER OF FACTORS HERE = ',I6)
40724        CALL DPWRST('XXX','BUG ')
40725        WRITE(ICOUT,999)
40726        CALL DPWRST('XXX','BUG ')
40727        IERROR='YES'
40728        GOTO9000
40729      ENDIF
40730C
40731      HOLD=Y(1)
40732      DO140I=1,N
40733        IF(Y(I).NE.HOLD)GOTO149
40734  140 CONTINUE
40735      WRITE(ICOUT,999)
40736      CALL DPWRST('XXX','BUG ')
40737      WRITE(ICOUT,101)
40738      CALL DPWRST('XXX','BUG ')
40739      WRITE(ICOUT,142)
40740  142 FORMAT('      ALL RESPONSE VARIABLE ELEMENTS FOR THE MEDIAN ',
40741     1       'POLISH')
40742      CALL DPWRST('XXX','BUG ')
40743      WRITE(ICOUT,143)HOLD
40744  143 FORMAT('      ARE IDENTICALLY EQUAL TO ',G15.7)
40745      CALL DPWRST('XXX','BUG ')
40746      WRITE(ICOUT,999)
40747      CALL DPWRST('XXX','BUG ')
40748      IERROR='YES'
40749      GOTO9000
40750  149 CONTINUE
40751C
40752      DO150J=1,NUMFAC
40753        HOLD=F1(1,J)
40754        DO155I=1,N
40755          HOLD2=F1(I,J)
40756          IF(HOLD2.NE.HOLD)GOTO150
40757  155   CONTINUE
40758        WRITE(ICOUT,999)
40759        CALL DPWRST('XXX','BUG ')
40760        WRITE(ICOUT,151)
40761  151   FORMAT('***** DIAGNOSTIC NOTE FROM MEDIAN POLISH--')
40762        CALL DPWRST('XXX','BUG ')
40763        WRITE(ICOUT,152)J
40764  152   FORMAT('      ALL ELEMENTS OF FACTOR ',I5,' IN THE ',
40765     1         'MEDIAN POLISH')
40766        CALL DPWRST('XXX','BUG ')
40767        WRITE(ICOUT,153)HOLD
40768  153   FORMAT('      ARE IDENTICALLY EQUAL TO ',G15.7)
40769        CALL DPWRST('XXX','BUG ')
40770        WRITE(ICOUT,999)
40771        CALL DPWRST('XXX','BUG ')
40772  150 CONTINUE
40773C
40774C               ***********************************************
40775C               **  STEP 1.1--                               **
40776C               **  DETERMINE THE NUMBER OF DISTINCT VALUES  **
40777C               **  FOR FACTOR 1                             **
40778C               ***********************************************
40779C
40780CCCCC JANUARY 1996.  CHECK FOR EXCEEDING MAXIMUM NUMBER OF LEVELS
40781      ISTEPN='1.1'
40782      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
40783     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40784C
40785      DO1159I=1,MAXFAC
40786        N1(I)=0
40787 1159 CONTINUE
40788C
40789      DO1160K=1,NUMFAC
40790        N1(K)=0
40791        DO160I=1,N
40792          IF(N1(K).LE.0)GOTO180
40793          DO170J=1,N1(K)
40794            IF(F1(I,K).EQ.F1ID(J,K))GOTO160
40795  170     CONTINUE
40796  180     CONTINUE
40797          N1(K)=N1(K)+1
40798          IF(N1(K).GT.MAXLEV)THEN
40799            WRITE(ICOUT,999)
40800            CALL DPWRST('XXX','BUG ')
40801            WRITE(ICOUT,101)
40802            CALL DPWRST('XXX','BUG ')
40803            WRITE(ICOUT,190)MAXLEV,K
40804            CALL DPWRST('XXX','BUG ')
40805            IERROR='YES'
40806            GOTO9000
40807          ENDIF
40808  190     FORMAT('      THE MAXIMUM NUMBER OF LEVELS, ',I10,
40809     1           ' EXCEEDED FOR FACTOR ',I5)
40810          F1ID(N1(K),K)=F1(I,K)
40811  160   CONTINUE
40812        IF(N1(K).LE.0)THEN
40813          WRITE(ICOUT,999)
40814          CALL DPWRST('XXX','BUG ')
40815          WRITE(ICOUT,101)
40816          CALL DPWRST('XXX','BUG ')
40817          WRITE(ICOUT,165)K
40818  165     FORMAT('      N = 0 FOR FACTOR ',I5)
40819          CALL DPWRST('XXX','BUG ')
40820          IERROR='YES'
40821          GOTO9000
40822        ENDIF
40823        AN1(K)=REAL(N1(K))
40824 1160 CONTINUE
40825C
40826C               **************************************
40827C               **  STEP 2--                        **
40828C               **  SORT THE LEVELS OF EACH FACTOR  **
40829C               **  SO AS TO PUT THEM IN ORDER FOR  **
40830C               **  PRESENTATION PURPOSES.          **
40831C               **************************************
40832C
40833      ISTEPN='2'
40834      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEP2')
40835     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40836C
40837      DO1900K=1,NUMFAC
40838        CALL SORT(F1ID(1,K),N1(K),F1ID(1,K))
40839 1900 CONTINUE
40840C
40841C               ********************************************
40842C               **  STEP 3--                              **
40843C               **  DETERMINE IF HAVE                     **
40844C               **  REPLICATION WITHIN CELLS.             **
40845C               **  IF SO, COMPUTE (FOR EACH CELL)--      **
40846C               **         1) NUMBER OF OBSERVATIONS;     **
40847C               **         2) MEAN;                       **
40848C               **         3) SUM OF SQUARED DEVIATIONS.  **
40849C               ********************************************
40850C
40851      ISTEPN='3'
40852      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
40853     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40854C
40855      IREP='NO'
40856      IREPDF=0
40857      REPDF=0.0
40858      REPSS=0.0
40859      REPSD=0.0
40860C
40861      K=0
40862      ICASBL='YES'
40863      DO3510ISET1=1,N1(1)
40864        ISET(1)=ISET1
40865        DO3520ISET2=1,MAX(1,N1(2))
40866        ISET(2)=ISET2
40867        DO3530ISET3=1,MAX(1,N1(3))
40868        ISET(3)=ISET3
40869        DO3540ISET4=1,MAX(1,N1(4))
40870        ISET(4)=ISET4
40871        DO3550ISET5=1,MAX(1,N1(5))
40872        ISET(5)=ISET5
40873C
40874          IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MEP2')THEN
40875            ISTEPN='3.5B'
40876            CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40877            WRITE(ICOUT,3511)ISET1,ISET2,ISET3,ISET4,ISET5
40878 3511       FORMAT('ISET1,ISET2,ISET3,ISET4,ISET5=',5I5)
40879            CALL DPWRST('XXX','BUG ')
40880          ENDIF
40881C
40882          K=K+1
40883          CELLN=0.0
40884          CELLME=0.0
40885C
40886          NI=0
40887          DO3560I=1,N
40888            DO3565L=1,NUMFAC
40889              IF(F1(I,L).NE.F1ID(ISET(L),L))GOTO3560
40890 3565       CONTINUE
40891            NI=NI+1
40892            Z(NI)=Y(I)
40893 3560     CONTINUE
40894C
40895          CELLN=REAL(NI)
40896          IF(NI.LE.0)GOTO3590
40897          IF(NI.EQ.1)THEN
40898            CELLME=Z(NI)
40899            GOTO3590
40900          ENDIF
40901          IREP='YES'
40902          SUM=0.0
40903          DO3570I=1,NI
40904            SUM=SUM+Z(I)
40905 3570     CONTINUE
40906          CELLME=SUM/CELLN
40907C
40908          IF(K.EQ.1)NIOLD=NI
40909          IF(NI.NE.NIOLD.AND.ICASBL.EQ.'YES')THEN
40910            WRITE(ICOUT,999)
40911            CALL DPWRST('XXX','BUG ')
40912CCCCC       WRITE(ICOUT,3571)
40913CCCCC       CALL DPWRST('XXX','BUG ')
40914            WRITE(ICOUT,999)
40915            CALL DPWRST('XXX','BUG ')
40916            ICASBL='NO'
40917          ENDIF
40918          NIOLD=NI
40919          SUM=0.0
40920          DO3580I=1,NI
40921            SUM=SUM+(Z(I)-CELLME)**2
40922 3580     CONTINUE
40923          CELLV=SUM/(CELLN-1.0)
40924C
40925          REPSS=REPSS+SUM
40926          IREPDF=IREPDF+NI-1
40927 3590     CONTINUE
40928C3571     FORMAT('WARNING: UNBALANCED CASE DETECTED.  SOME ',
40929CCCCC1       'COMPUTATIONS MAY NOT BE ACCURATE.')
40930 3550   CONTINUE
40931 3540   CONTINUE
40932 3530   CONTINUE
40933 3520   CONTINUE
40934 3510 CONTINUE
40935C
40936      NUMCEL=K
40937      IF(IREP.EQ.'YES')THEN
40938        REPDF=IREPDF
40939        REPMS=REPSS/REPDF
40940        IF(REPMS.LE.0.0)REPSD=0.0
40941        IF(REPMS.GT.0.0)REPSD=SQRT(REPMS)
40942      ENDIF
40943C
40944C               ******************************
40945C               **  STEP 4--                **
40946C               **  COMPUTE THE GRAND MEAN  **
40947C               ******************************
40948C
40949      ISTEPN='4'
40950      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
40951     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40952C
40953      CALL MEAN(Y,N,IWRITE,GMEAN,IBUGA3,IERROR)
40954      CALL SD(Y,N,IWRITE,GSD,IBUGA3,IERROR)
40955      GVAR=GSD**2
40956      CALL MEDIAN(Y,N,IWRITE,TEMP1,MAXOBV,GMED,IBUGA3,IERROR)
40957      YMIN=Y(1)
40958      YMAX=Y(1)
40959      DO4300I=1,N
40960        IF(Y(I).LT.YMIN)YMIN=Y(I)
40961        IF(Y(I).GT.YMAX)YMAX=Y(I)
40962 4300 CONTINUE
40963      GRANGE=YMAX-YMIN
40964C
40965C               **********************************************
40966C               **  STEP 5.01--                             **
40967C               **  INITIALIZE ROW AND COLUMN MEDIANS TO 0  **
40968C               **********************************************
40969C
40970      ISTEPN='5.01'
40971      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
40972     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40973C
40974      DO4500I=1,N
40975        RES2(I)=Y(I)
40976 4500 CONTINUE
40977C
40978      DO4510L=1,NUMFAC
40979        DO4520J=1,N1(L)
40980          F1EFFE(J,L)=0.0
40981 4520   CONTINUE
40982 4510 CONTINUE
40983C
40984C               ******************************************
40985C               **  STEP 5.02--                         **
40986C               **  COMPUTE THE NUMBER OF OBSERVATIONS  **
40987C               **  IN EACH LEVEL OF EACH VARIABLE      **
40988C               ******************************************
40989C
40990      ISTEPN='5.02'
40991      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
40992     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
40993C
40994      DO4690K=1,NUMFAC
40995        DO4600J=1,N1(K)
40996          SUM1=0.0
40997          DO4620I=1,N
40998            IF(F1(I,K).EQ.F1ID(J,K))THEN
40999              SUM1=SUM1+1.0
41000            ENDIF
41001 4620     CONTINUE
41002          F1N(J,K)=SUM1
41003 4600   CONTINUE
41004 4690 CONTINUE
41005C
41006C               *******************************************************
41007C               **  STEP 5.03--                                      **
41008C               **  DEFINE THE ITERATION LOOP FOR THE MEDIAN POLISH  **
41009C               *******************************************************
41010C
41011      ISTEPN='5.03'
41012      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41013     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41014C
41015      DO5000IPASS=1,MAXPAS
41016C
41017        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MEP2')THEN
41018          WRITE(ICOUT,999)
41019          CALL DPWRST('XXX','BUG ')
41020          WRITE(ICOUT,5011)
41021 5011     FORMAT('******************************')
41022          CALL DPWRST('XXX','BUG ')
41023          WRITE(ICOUT,5012)IPASS
41024 5012     FORMAT('AT BEGINNING OF PASS ',I8)
41025          CALL DPWRST('XXX','BUG ')
41026          WRITE(ICOUT,5011)
41027          CALL DPWRST('XXX','BUG ')
41028          WRITE(ICOUT,999)
41029          CALL DPWRST('XXX','BUG ')
41030        ENDIF
41031C
41032C               ***********************************************
41033C               **  STEP 5.1--                               **
41034C               **  FOR THIS PASS--                          **
41035C               **  DETERMINE (FOR EACH LEVEL OF FACTOR 1)   **
41036C               **      1) UPDATED MEDIAN;                   **
41037C               **      2) UPDATED RESIDUALS                 **
41038C               ***********************************************
41039C
41040        ISTEPN='5.1'
41041        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41042     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41043C
41044        DO5100L=1,NUMFAC
41045          DO5110J=1,N1(L)
41046C
41047            K=0
41048            DO5120I=1,N
41049              IF(F1(I,L).EQ.F1ID(J,L))THEN
41050                K=K+1
41051                Y2(K)=RES2(I)
41052              ENDIF
41053 5120       CONTINUE
41054            CALL MEDIAN(Y2,K,IWRITE,TEMP1,MAXOBV,Y2MED(J),IBUGA3,IERROR)
41055            F1EFFE(J,L)=F1EFFE(J,L)+Y2MED(J)
41056C
41057            DO5140I=1,N
41058              IF(F1(I,L).EQ.F1ID(J,L))THEN
41059                RES2(I)=RES2(I)-Y2MED(J)
41060              ENDIF
41061 5140       CONTINUE
41062C
41063 5110     CONTINUE
41064C
41065          IF(L.EQ.1)THEN
41066            Y3MED=0.0
41067            IF(NUMFAC.GE.2.AND.IPASS.GE.2)
41068     1      CALL MEDIAN(F1EFFE(1,2),N1(2),IWRITE,TEMP1,MAXOBV,Y3MED,
41069     1                  IBUGA3,IERROR)
41070            GTYP=GTYP+Y3MED
41071C
41072            DO5160J=1,N1(2)
41073              F1EFFE(J,2)=F1EFFE(J,2)-Y3MED
41074 5160       CONTINUE
41075          ELSE
41076            CALL MEDIAN(F1EFFE(1,1),N1(1),IWRITE,TEMP1,MAXOBV,Y3MED,
41077     1                  IBUGA3,IERROR)
41078            GTYP=GTYP+Y3MED
41079C
41080            DO5165J=1,N1(1)
41081              F1EFFE(J,1)=F1EFFE(J,1)-Y3MED
41082 5165       CONTINUE
41083          ENDIF
41084C
41085          DO5170J=1,N1(L)
41086            F1TYP(J,L)=GTYP+F1EFFE(J,L)
41087 5170     CONTINUE
41088C
41089          IF(IBUGA3.EQ.'ON'.OR. ISUBRO.EQ.'MEP2')THEN
41090            WRITE(ICOUT,999)
41091            CALL DPWRST('XXX','BUG ')
41092            WRITE(ICOUT,5181)L
41093 5181       FORMAT('***** AFTER THE SWEEP FOR FACTOR ',I1,'--')
41094            CALL DPWRST('XXX','BUG ')
41095            WRITE(ICOUT,999)
41096            CALL DPWRST('XXX','BUG ')
41097            DO5182I=1,N
41098              WRITE(ICOUT,5183)I,RES2(I)
41099 5183         FORMAT('I,RES2(I)  = ',I8,G15.7)
41100              CALL DPWRST('XXX','BUG ')
41101 5182       CONTINUE
41102            WRITE(ICOUT,999)
41103            CALL DPWRST('XXX','BUG ')
41104            DO5184J=1,N1(L)
41105              WRITE(ICOUT,5185)J,F1EFFE(J,L)
41106 5185         FORMAT('J,F1EFFE(J,L) = ',I8,G15.7)
41107              CALL DPWRST('XXX','BUG ')
41108 5184       CONTINUE
41109            NFACT=L
41110            IF(L.EQ.1)NFACT=2
41111            WRITE(ICOUT,999)
41112            CALL DPWRST('XXX','BUG ')
41113            DO5196J=1,N1(NFACT)
41114              WRITE(ICOUT,5197)J,NFACT,F1EFFE(J,NFACT)
41115 5197         FORMAT('J,FACTOR,F1EFFE(J,NFACT) = ',2I8,G15.7)
41116              CALL DPWRST('XXX','BUG ')
41117 5196       CONTINUE
41118            WRITE(ICOUT,999)
41119            CALL DPWRST('XXX','BUG ')
41120            WRITE(ICOUT,5188)GTYP
41121 5188       FORMAT('GTYP       = ',8X,G15.7)
41122            CALL DPWRST('XXX','BUG ')
41123          ENDIF
41124C
41125 5100   CONTINUE
41126C
41127C               *************************************************************
41128C               **  STEP 5.6--                                             **
41129C               **  DETERMINE IF THE CHANGE IN THE  RESIDUALS              **
41130C               **  (FROM THIS PASS AS COMPARED TO THE PREVIOUS PASS)      **
41131C               **  IS SO SMALL THAT THE ITERATIONS SHOULD BE TERMINATED.  **
41132C               *************************************************************
41133C
41134        ISTEPN='5.6'
41135        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41136     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41137C
41138        SUM=0.0
41139        DO5810I=1,N
41140          SUM=SUM+ABS(RES2(I))
41141 5810   CONTINUE
41142        AARES=SUM/AN
41143C
41144        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MEP2')THEN
41145          WRITE(ICOUT,999)
41146          CALL DPWRST('XXX','BUG ')
41147          WRITE(ICOUT,5811)IPASS
41148 5811     FORMAT('***** AT THE CLOSE OF PASS ',I8)
41149          CALL DPWRST('XXX','BUG ')
41150          WRITE(ICOUT,5812)IPASS,AN,SUM,AARES,AARESO
41151 5812     FORMAT('IPASS,AN,SUM,AARES,AARESO = ',I8,4E15.7)
41152          CALL DPWRST('XXX','BUG ')
41153        ENDIF
41154C
41155        IF(AARES.LE.0.0)GOTO5900
41156C
41157        IF(IPASS.EQ.1)THEN
41158          AARESO=AARES
41159          GOTO5000
41160        ENDIF
41161C
41162        RATIO=AARES/AARESO
41163C
41164        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MEP2')THEN
41165          WRITE(ICOUT,5816)IPASS,AARES,AARESO,RATIO,CUTOFF
41166 5816     FORMAT('IPASS,AARES,AARESO,RATIO,CUTOFF = ',I8,4E15.7)
41167          CALL DPWRST('XXX','BUG ')
41168        ENDIF
41169C
41170        IF(RATIO.GE.CUTOFF)GOTO5900
41171        AARESO=AARES
41172C
41173 5000 CONTINUE
41174C
41175 5900 CONTINUE
41176C
41177C               ******************************************
41178C               **  STEP 6--                            **
41179C               **  COMPUTE THE FOLLOWING--             **
41180C               **     1) PREDICTED VALUES;             **
41181C               **     2) RESIDUALS;                    **
41182C               **     3) RESIDUAL STANDARD DEVIATION;  **
41183C               **     4) RESIDUAL DEGREES OF FREEDOM;  **
41184C               **  IF HAVE REPLICATION,                **
41185C               **  THEN ALSO CARRY OUT                 **
41186C               **  THE LACK OF FIT F TEST.             **
41187C               ******************************************
41188C
41189      ISTEPN='6'
41190      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41191     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41192C
41193      RESSS=0.0
41194      IRESDF=0
41195      RESDF=0.0
41196      RESMS=0.0
41197      RESSD=0.0
41198      ALFCDF=(-999.99)
41199C
41200      DO6000I=1,N
41201        DO6200K=1,NUMFAC
41202          DO6100ISET1=1,N1(K)
41203            J1=ISET1
41204            IF(F1(I,K).EQ.F1ID(ISET1,K))GOTO6115
41205 6100     CONTINUE
41206 6115     CONTINUE
41207          E1(K)=F1EFFE(J1,K)
41208 6200   CONTINUE
41209C
41210        PRED2(I)=GTYP
41211        DO6310K=1,NUMFAC
41212         PRED2(I)=PRED2(I)+E1(K)
41213 6310   CONTINUE
41214C
41215 6000 CONTINUE
41216C
41217      IRESDF=N-1
41218      DO6910K=1,NUMFAC
41219        IRESDF=IRESDF-(N1(K)-1)
41220 6910 CONTINUE
41221      RESDF=IRESDF
41222C
41223      SUM=0.0
41224      DO6920I=1,N
41225        SUM=SUM+RES2(I)*RES2(I)
41226 6920 CONTINUE
41227      RESSS=SUM
41228      RESMS=RESSS/RESDF
41229      IF(RESMS.LE.0.0)RESSD=0.0
41230      IF(RESMS.GT.0.0)RESSD=SQRT(RESMS)
41231C
41232      IF(IREP.EQ.'YES')THEN
41233        IFITDF=IRESDF-IREPDF
41234        FITDF=IFITDF
41235        IF(IFITDF.LE.0)GOTO6990
41236        FITSS=RESSS-REPSS
41237        FITMS=FITSS/FITDF
41238        FITFVA=FITMS/REPMS
41239        CALL FCDF(FITFVA,IFITDF,IREPDF,FITCDF)
41240        FITCD2=100.0*FITCDF
41241        ALFCDF=FITCDF
41242      ENDIF
41243C
41244 6990 CONTINUE
41245C
41246C               ************************************************
41247C               **  STEP 7--                                  **
41248C               **  COMPUTE THE ESTIMATED STANDARD DEVIATION  **
41249C               **  OF THE GRAND MEAN                         **
41250C               **  AND THE ESTIMATED STANDARD DEVIATION      **
41251C               **  OF THE ESTIMATED EFFECTS.                 **
41252C               ************************************************
41253C
41254      ISTEPN='7'
41255      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41256     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41257C
41258      GMEASD=0.0
41259      IF(N.GT.0)GMEASD=RESSD/SQRT(AN)
41260C
41261      DO7190K=1,NUMFAC
41262        DO7100ISET1=1,N1(K)
41263          ANI=F1N(ISET1,K)
41264          CONST=((1.0/ANI)-(1.0/AN))
41265          F1EFSD(ISET1,K)=0.0
41266          IF(CONST.GT.0.0)F1EFSD(ISET1,K)=RESSD*SQRT(CONST)
41267 7100   CONTINUE
41268 7190 CONTINUE
41269C
41270C               ********************************
41271C               **  STEP 8--                  **
41272C               **  PERFORM THE F TEST        **
41273C               **  TO TEST THE SIGNIFICANCE  **
41274C               **  OF EACH FACTOR            **
41275C               ********************************
41276C
41277      ISTEPN='8'
41278      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41279     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41280C
41281      IF(IRESDF.LE.0.OR.RESMS.LE.0.0)GOTO8900
41282C
41283      DO8190K=1,NUMFAC
41284C
41285        SUM=0.0
41286        DO8100J=1,N1(K)
41287          SUM=SUM+F1N(J,K)*F1EFFE(J,K)*F1EFFE(J,K)
41288 8100   CONTINUE
41289        SS1(K)=SUM
41290        IDF1=N1(K)-1
41291        DF1=IDF1
41292        RESMS1(K)=SS1(K)/DF1
41293        IF(RESMS1(K).LE.0.0)RSD(K)=0.0
41294        IF(RESMS1(K).GT.0.0)RSD(K)=SQRT(RESMS1(K))
41295        FVAL(K)=RESMS1(K)/RESMS
41296        CALL FCDF(FVAL(K),IDF1,IRESDF,FCUM(K))
41297        F1CDF2(K)=100.0*FCUM(K)
41298 8190 CONTINUE
41299C
41300 8900 CONTINUE
41301C
41302C               *************************************************
41303C               **  STEP 9.1--                                 **
41304C               **  DETERMINE THE RESIDUAL STANDARD DEVIATION  **
41305C               **  FOR FACTOR K ONLY MODEL.                   **
41306C               *************************************************
41307C
41308      ISTEPN='9.1'
41309      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41310     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41311C
41312      DO9190K=1,NUMFAC
41313        SUM=0.0
41314        DO9100I=1,N
41315        DO9110J=1,N1(K)
41316          J1=J
41317          IF(F1(I,K).EQ.F1ID(J,K))GOTO9120
41318 9110   CONTINUE
41319 9120   CONTINUE
41320        WMEAN=F1TYP(J1,K)
41321        SUM=SUM+(Y(I)-WMEAN)**2
41322 9100   CONTINUE
41323        WSS1=SUM
41324        WDF1=AN-AN1(K)
41325        WVAR1=WSS1/WDF1
41326        IF(WVAR1.LE.0.0)WSD1=0.0
41327        IF(WVAR1.GT.0.0)WSD1=SQRT(WVAR1)
41328        RSD(K)=WSD1
41329 9190 CONTINUE
41330C
41331C               ********************************************************
41332C               **  STEP 10--                                         **
41333C               **  COPY OVER INTO THE OUTPUT VECTORS B(.) AND SDB(.)--*
41334C               **       1) THE GRAND MEAN;                           **
41335C               **       2) THE ESTIMATED EFFECTS;                    **
41336C               **       3) THE STANDARD DEVIATIONS OF GRAND MEAN AND **
41337C               **          EFFECTS.                                  **
41338C               ********************************************************
41339C
41340      ISTEPN='10'
41341      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41342     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41343C
41344      K=1
41345      B(K)=GTYP
41346      SDB(K)=GMEASD
41347C
41348      DO10190L=1,NUMFAC
41349C
41350        DO10100ISET1=1,N1(L)
41351          K=K+1
41352          B(K)=F1EFFE(ISET1,L)
41353          SDB(K)=F1EFSD(ISET1,L)
4135410100   CONTINUE
4135510190 CONTINUE
41356C
41357C               ****************************
41358C               **  STEP 11--             **
41359C               **  WRITE EVERYTHING OUT  **
41360C               ****************************
41361C
41362      ISTEPN='11'
41363      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MEPO')
41364     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41365C
41366C     PRINT TABLES
41367C
41368      NUMDIG=7
41369      IF(IFORSW.EQ.'1')NUMDIG=1
41370      IF(IFORSW.EQ.'2')NUMDIG=2
41371      IF(IFORSW.EQ.'3')NUMDIG=3
41372      IF(IFORSW.EQ.'4')NUMDIG=4
41373      IF(IFORSW.EQ.'5')NUMDIG=5
41374      IF(IFORSW.EQ.'6')NUMDIG=6
41375      IF(IFORSW.EQ.'7')NUMDIG=7
41376      IF(IFORSW.EQ.'8')NUMDIG=8
41377      IF(IFORSW.EQ.'9')NUMDIG=9
41378      IF(IFORSW.EQ.'0')NUMDIG=0
41379      IF(IFORSW.EQ.'E')NUMDIG=-2
41380      IF(IFORSW.EQ.'-2')NUMDIG=-2
41381      IF(IFORSW.EQ.'-3')NUMDIG=-3
41382      IF(IFORSW.EQ.'-4')NUMDIG=-4
41383      IF(IFORSW.EQ.'-5')NUMDIG=-5
41384      IF(IFORSW.EQ.'-6')NUMDIG=-6
41385      IF(IFORSW.EQ.'-7')NUMDIG=-7
41386      IF(IFORSW.EQ.'-8')NUMDIG=-8
41387      IF(IFORSW.EQ.'-9')NUMDIG=-9
41388C
41389      ITITLE(1:20)='  -Way Median Polish'
41390      WRITE(ITITLE(1:2),'(I2)')NUMFAC
41391      NCTITL=20
41392      ITITLZ=' '
41393      NCTITZ=0
41394C
41395      ICNT=1
41396      ITEXT(ICNT)='Summary Statistics:'
41397      NCTEXT(ICNT)=19
41398      AVALUE(ICNT)=0.0
41399      IDIGIT(ICNT)=-1
41400      ICNT=ICNT+1
41401      ITEXT(ICNT)='Number of Observations:'
41402      NCTEXT(ICNT)=23
41403      AVALUE(ICNT)=REAL(N)
41404      IDIGIT(ICNT)=0
41405      ICNT=ICNT+1
41406      ITEXT(ICNT)='Number of Factors:'
41407      NCTEXT(ICNT)=18
41408      AVALUE(ICNT)=REAL(NUMFAC)
41409      IDIGIT(ICNT)=0
41410      DO11102L=1,NUMFAC
41411        ICNT=ICNT+1
41412        ITEXT(ICNT)='Number of Levels for Factor   :'
41413        WRITE(ITEXT(ICNT)(29:30),'(I2)')L
41414        NCTEXT(ICNT)=31
41415        AVALUE(ICNT)=REAL(N1(L))
41416        IDIGIT(ICNT)=0
4141711102 CONTINUE
41418      ICNT=ICNT+1
41419      ITEXT(ICNT)='Number of Distinct Cells:'
41420      NCTEXT(ICNT)=25
41421      AVALUE(ICNT)=REAL(NUMCEL)
41422      IDIGIT(ICNT)=0
41423      ICNT=ICNT+1
41424      ITEXT(ICNT)=' '
41425      NCTEXT(ICNT)=0
41426      AVALUE(ICNT)=0.0
41427      IDIGIT(ICNT)=-1
41428C
41429      ICNT=ICNT+1
41430      ITEXT(ICNT)='Grand Mean:'
41431      NCTEXT(ICNT)=11
41432      AVALUE(ICNT)=GMEAN
41433      IDIGIT(ICNT)=NUMDIG
41434      ICNT=ICNT+1
41435      ITEXT(ICNT)='Grand Median:'
41436      NCTEXT(ICNT)=13
41437      AVALUE(ICNT)=GMED
41438      IDIGIT(ICNT)=NUMDIG
41439      ICNT=ICNT+1
41440      ITEXT(ICNT)='Median Polish Typical Value:'
41441      NCTEXT(ICNT)=28
41442      AVALUE(ICNT)=GTYP
41443      IDIGIT(ICNT)=NUMDIG
41444      ICNT=ICNT+1
41445      ITEXT(ICNT)='Grand Range:'
41446      NCTEXT(ICNT)=25
41447      AVALUE(ICNT)=GRANGE
41448      IDIGIT(ICNT)=NUMDIG
41449      ICNT=ICNT+1
41450      ITEXT(ICNT)='Grand Standard Deviation:'
41451      NCTEXT(ICNT)=25
41452      AVALUE(ICNT)=GSD
41453      IDIGIT(ICNT)=NUMDIG
41454      ICNT=ICNT+1
41455      ITEXT(ICNT)=' '
41456      NCTEXT(ICNT)=0
41457      AVALUE(ICNT)=0.0
41458      IDIGIT(ICNT)=-1
41459C
41460      ICNT=ICNT+1
41461      ITEXT(ICNT)='Residual Standard Deviation:'
41462      NCTEXT(ICNT)=28
41463      AVALUE(ICNT)=RESSD
41464      IDIGIT(ICNT)=NUMDIG
41465      ICNT=ICNT+1
41466      ITEXT(ICNT)='Residual Degrees of Freedom:'
41467      NCTEXT(ICNT)=28
41468      AVALUE(ICNT)=REAL(IRESDF)
41469      IDIGIT(ICNT)=0
41470      ICNT=ICNT+1
41471      ITEXT(ICNT)=' '
41472      NCTEXT(ICNT)=0
41473      AVALUE(ICNT)=0.0
41474      IDIGIT(ICNT)=-1
41475C
41476      IF(IREP.EQ.'NO')THEN
41477        ICNT=ICNT+1
41478        ITEXT(ICNT)='No Replication Case:'
41479        NCTEXT(ICNT)=20
41480        AVALUE(ICNT)=0.0
41481        IDIGIT(ICNT)=-1
41482      ELSE
41483        ICNT=ICNT+1
41484        ITEXT(ICNT)='Replication Case:'
41485        NCTEXT(ICNT)=17
41486        AVALUE(ICNT)=0.0
41487        IDIGIT(ICNT)=-1
41488        ICNT=ICNT+1
41489        ITEXT(ICNT)='Replication Standard Deviation:'
41490        NCTEXT(ICNT)=31
41491        AVALUE(ICNT)=REPSD
41492        IDIGIT(ICNT)=NUMDIG
41493        ICNT=ICNT+1
41494        ITEXT(ICNT)='Replication Degrees of Freedom:'
41495        NCTEXT(ICNT)=31
41496        AVALUE(ICNT)=REAL(IREPDF)
41497        IDIGIT(ICNT)=0
41498        IF(IFITDF.LT.1)THEN
41499          ICNT=ICNT+1
41500          ITEXT(ICNT)='Lack of Fit F Test cannot be done'
41501          NCTEXT(ICNT)=33
41502          AVALUE(ICNT)=0.0
41503          IDIGIT(ICNT)=-1
41504          ICNT=ICNT+1
41505          ITEXT(ICNT)='because there are 0 degrees of freedom'
41506          NCTEXT(ICNT)=38
41507          AVALUE(ICNT)=0.0
41508          IDIGIT(ICNT)=-1
41509          ICNT=ICNT+1
41510          ITEXT(ICNT)='in the numerator of the F ratio.  This'
41511          NCTEXT(ICNT)=38
41512          AVALUE(ICNT)=0.0
41513          IDIGIT(ICNT)=-1
41514          ICNT=ICNT+1
41515          ITEXT(ICNT)='happens when the number of parameters'
41516          NCTEXT(ICNT)=37
41517          AVALUE(ICNT)=0.0
41518          IDIGIT(ICNT)=-1
41519          ICNT=ICNT+1
41520          ITEXT(ICNT)='fitted is identical to the number of'
41521          NCTEXT(ICNT)=36
41522          AVALUE(ICNT)=0.0
41523          IDIGIT(ICNT)=-1
41524          ICNT=ICNT+1
41525          ITEXT(ICNT)='distinct subsets.'
41526          NCTEXT(ICNT)=17
41527          AVALUE(ICNT)=0.0
41528          IDIGIT(ICNT)=-1
41529        ELSE
41530          ICNT=ICNT+1
41531          ITEXT(ICNT)='Lack of Fit F Ratio:'
41532          NCTEXT(ICNT)=20
41533          AVALUE(ICNT)=FITFVA
41534          IDIGIT(ICNT)=NUMDIG
41535          ICNT=ICNT+1
41536          ITEXT(ICNT)='Lack of Fit F Ratio CDF (%):'
41537          NCTEXT(ICNT)=28
41538          AVALUE(ICNT)=FITCD2
41539          IDIGIT(ICNT)=NUMDIG
41540          ICNT=ICNT+1
41541          ITEXT(ICNT)='Lack of Fit Degrees of Freedom 1:'
41542          NCTEXT(ICNT)=33
41543          AVALUE(ICNT)=REAL(IFITDF)
41544          IDIGIT(ICNT)=0
41545          ICNT=ICNT+1
41546          ITEXT(ICNT)='Lack of Fit Degrees of Freedom 2:'
41547          NCTEXT(ICNT)=33
41548          AVALUE(ICNT)=REAL(IREPDF)
41549          IDIGIT(ICNT)=0
41550        ENDIF
41551      ENDIF
41552C
41553      NUMROW=ICNT
41554      DO1105I=1,NUMROW
41555        NTOT(I)=15
41556 1105 CONTINUE
41557C
41558      IFRST=.TRUE.
41559      ILAST=.TRUE.
41560      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
41561     1            AVALUE,IDIGIT,
41562     1            NTOT,NUMROW,
41563     1            ICAPSW,ICAPTY,ILAST,IFRST,
41564     1            ISUBRO,IBUGA3,IERROR)
41565C
41566      ITITLE='Estimation'
41567      NCTITL=10
41568      ITITL9=' '
41569      NCTIT9=0
41570C
41571      NUMCOL=5
41572      NUMLIN=1
41573C
41574      ITITL2(1,1)=' '
41575      NCTIT2(1,1)=0
41576      ITITL2(1,2)='Level-ID'
41577      NCTIT2(1,2)=8
41578      ITITL2(1,3)='NI'
41579      NCTIT2(1,3)=2
41580      ITITL2(1,4)='Typical Value'
41581      NCTIT2(1,4)=13
41582      ITITL2(1,5)='Effect'
41583      NCTIT2(1,5)=6
41584C
41585      NMAX=0
41586      DO23010I=1,NUMCOL
41587        VALIGN(I)='b'
41588        ALIGN(I)='r'
41589        NTOT(I)=11
41590        IF(I.EQ.1)NTOT(I)=10
41591        IF(I.EQ.2)NTOT(I)=9
41592        IF(I.EQ.3)NTOT(I)=8
41593        IF(I.EQ.4)NTOT(I)=17
41594        NMAX=NMAX+NTOT(I)
41595        ITYPCO(I)='NUME'
41596        IF(I.EQ.1)ITYPCO(I)='ALPH'
41597        IDIGIT(I)=5
41598        IF(I.LE.3)IDIGIT(I)=0
4159923010 CONTINUE
41600C
41601      ICNT=0
41602      DO11590L=1,NUMFAC
41603        DO11595I=1,N1(L)
41604          ICNT=ICNT+1
41605          IF(I.EQ.1)THEN
41606            IVALUE(ICNT,1)='Factor   '
41607            WRITE(IVALUE(ICNT,1)(8:9),'(I2)')L
41608          ELSE
41609            IVALUE(ICNT,1)='         '
41610          ENDIF
41611          NCVALU(ICNT,1)=9
41612          AMAT(ICNT,2)=F1ID(I,L)
41613          AMAT(ICNT,3)=F1N(I,L)
41614          AMAT(ICNT,4)=F1TYP(I,L)
41615          AMAT(ICNT,5)=F1EFFE(I,L)
4161611595 CONTINUE
4161711590 CONTINUE
41618C
41619      IWHTML(1)=125
41620      IWHTML(2)=125
41621      IWHTML(3)=125
41622      IWHTML(4)=125
41623      IWHTML(5)=125
41624      IINC=1800
41625      IWRTF(1)=IINC
41626      IWRTF(2)=IWRTF(1)+IINC
41627      IWRTF(3)=IWRTF(2)+IINC
41628      IWRTF(4)=IWRTF(3)+IINC
41629      IWRTF(5)=IWRTF(4)+IINC
41630C
41631      IFRST=.TRUE.
41632      ILAST=.TRUE.
41633      IFLAGS=.TRUE.
41634      IFLAGE=.TRUE.
41635      CALL DPDTA5(ITITLE,NCTITL,
41636     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
41637     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
41638     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
41639     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
41640     1            ICAPSW,ICAPTY,IFRST,ILAST,
41641     1            IFLAGS,IFLAGE,
41642     1            ISUBRO,IBUGA3,IERROR)
41643C
41644      ITITLE='Models'
41645      NCTITL=6
41646      ITITL9=' '
41647      NCTIT9=0
41648C
41649      NUMCOL=2
41650      NUMLIN=1
41651C
41652      ITITL2(1,1)='Model'
41653      NCTIT2(1,1)=5
41654      ITITL2(1,2)='Residual Standard Deviation'
41655      NCTIT2(1,2)=27
41656C
41657      NMAX=0
41658      DO24010I=1,NUMCOL
41659        VALIGN(I)='b'
41660        ALIGN(I)='l'
41661        NTOT(I)=30
41662        IF(I.EQ.2)NTOT(I)=27
41663        NMAX=NMAX+NTOT(I)
41664        ITYPCO(I)='NUME'
41665        IF(I.EQ.1)ITYPCO(I)='ALPH'
41666        IDIGIT(I)=NUMDIG
4166724010 CONTINUE
41668C
41669      ICNT=0
41670      ICNT=ICNT+1
41671      IVALUE(ICNT,1)='Constant               Only--'
41672      NCVALU(ICNT,1)=30
41673      AMAT(ICNT,2)=GSD
41674      DO12827L=1,NUMFAC
41675        ICNT=ICNT+1
41676        IVALUE(ICNT,1)='Constant and Factor    Only--'
41677        WRITE(IVALUE(ICNT,1)(21:22),'(I2)')L
41678        NCVALU(ICNT,1)=30
41679        AMAT(ICNT,2)=RSD(L)
4168012827 CONTINUE
41681      ICNT=ICNT+1
41682      IVALUE(ICNT,1)='Constant and All    Factors--'
41683      WRITE(IVALUE(ICNT,1)(18:19),'(I2)')NUMFAC
41684      NCVALU(ICNT,1)=30
41685      AMAT(ICNT,2)=RESSD
41686C
41687      IWHTML(1)=300
41688      IWHTML(2)=200
41689      IINC3=3000
41690      IWRTF(1)=IINC3
41691      IWRTF(2)=IWRTF(1)+IINC
41692C
41693      IFRST=.TRUE.
41694      ILAST=.TRUE.
41695      IFLAGS=.TRUE.
41696      IFLAGE=.TRUE.
41697      CALL DPDTA5(ITITLE,NCTITL,
41698     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
41699     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
41700     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
41701     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
41702     1            ICAPSW,ICAPTY,IFRST,ILAST,
41703     1            IFLAGS,IFLAGE,
41704     1            ISUBRO,IBUGA3,IERROR)
41705C
41706      ITITLE='Testing'
41707      NCTITL=7
41708      ITITL9=' '
41709      NCTIT9=0
41710C
41711      NUMCOL=4
41712      NUMLIN=1
41713C
41714      ITITL2(1,1)=' '
41715      NCTIT2(1,1)=0
41716      ITITL2(1,2)='Number of Levels'
41717      NCTIT2(1,2)=16
41718      ITITL2(1,3)='F Statistic'
41719      NCTIT2(1,3)=11
41720      ITITL2(1,4)='F CDF'
41721      NCTIT2(1,4)=5
41722C
41723      NMAX=0
41724      DO11610I=1,NUMCOL
41725        VALIGN(I)='b'
41726        ALIGN(I)='r'
41727        NTOT(I)=15
41728        IF(I.EQ.1)NTOT(I)=10
41729        IF(I.EQ.2)NTOT(I)=18
41730        NMAX=NMAX+NTOT(I)
41731        ITYPCO(I)='NUME'
41732        IF(I.EQ.1)ITYPCO(I)='ALPH'
41733        IF(I.EQ.4)ITYPCO(I)='ALPH'
41734        IDIGIT(I)=NUMDIG
41735        IF(I.LE.2)IDIGIT(I)=0
4173611610 CONTINUE
41737C
41738      ICNT=0
41739      DO11690L=1,NUMFAC
41740        ICNT=ICNT+1
41741        IVALUE(ICNT,1)='Factor   '
41742        WRITE(IVALUE(ICNT,1)(8:9),'(I2)')L
41743        NCVALU(ICNT,1)=9
41744        AMAT(ICNT,2)=N1(L)
41745        AMAT(ICNT,3)=FVAL(L)
41746        WRITE(IVALUE(ICNT,4)(1:8),'(F8.3)')F1CDF2(L)
41747        IVALUE(ICNT,4)(9:9)='%'
41748        NCVALU(ICNT,4)=9
4174911690 CONTINUE
41750C
41751      IWHTML(1)=125
41752      IWHTML(2)=125
41753      IWHTML(3)=125
41754      IWHTML(4)=125
41755      IINC=1800
41756      IWRTF(1)=IINC
41757      IWRTF(2)=IWRTF(1)+IINC
41758      IWRTF(3)=IWRTF(2)+IINC
41759      IWRTF(4)=IWRTF(3)+IINC
41760C
41761      IFRST=.TRUE.
41762      ILAST=.TRUE.
41763      IFLAGS=.TRUE.
41764      IFLAGE=.TRUE.
41765      CALL DPDTA5(ITITLE,NCTITL,
41766     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
41767     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
41768     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
41769     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
41770     1            ICAPSW,ICAPTY,IFRST,ILAST,
41771     1            IFLAGS,IFLAGE,
41772     1            ISUBRO,IBUGA3,IERROR)
41773C
41774C               *****************
41775C               **  STEP 90--  **
41776C               **  EXIT       **
41777C               *****************
41778C
41779 9000 CONTINUE
41780      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MEP2')THEN
41781        WRITE(ICOUT,999)
41782        CALL DPWRST('XXX','BUG ')
41783        WRITE(ICOUT,9011)
41784 9011   FORMAT('***** AT THE END       OF DPMEP2--')
41785        CALL DPWRST('XXX','BUG ')
41786        WRITE(ICOUT,9012)IERROR,IBUGA3,IREP,N,NUMFAC
41787 9012   FORMAT('IERROR,IBUGA3,IREP,N,NUMFAC = ',3(A4,2X),2I8)
41788        CALL DPWRST('XXX','BUG ')
41789        WRITE(ICOUT,9023)REPSS,REPMS,REPSD,REPDF
41790 9023   FORMAT('REPSS,REPMS,REPSD,REPDF = ',4E15.7)
41791        CALL DPWRST('XXX','BUG ')
41792        DO9025I=1,N
41793          WRITE(ICOUT,9026)I,Y(I),F1(I,1),F1(I,2),W(I),PRED2(I),RES2(I)
41794 9026     FORMAT('I,Y(I),F1(I,1),F1(I,2),W(I),PRED2(I),RES2(I) = ',
41795     1           I8,6E11.4)
41796          CALL DPWRST('XXX','BUG ')
41797 9025   CONTINUE
41798      ENDIF
41799C
41800      RETURN
41801      END
41802      SUBROUTINE DPMERG(IBUGA2,IBUGA3,ISUBRO,IFOUND,IERROR)
41803C
41804C     PURPOSE--MERGE TWO SETS OF DATA.  FOR EXAMPLE,
41805C
41806C              LET SRCN CONTN INST1N XMEAN1 XMEAN2 INST2N =
41807C                  SRC1 CONT1 INST1 XMEAN1 SRC2 CONT2 INST2 XMEAN2
41808C
41809C              WHERE INST1 SRC1 CONT1 XMEAN1 CONSTITUTE THE FIRST
41810C              DATA SET AND INST2 SRC2 CONT2 CONSTITUTE THE SECOND
41811C              DATA SET.  NOTE THAT THE FOLLOWING MERGE IS DONE:
41812C
41813C                   LOOP THROUGHT DATA SET 1.  FOR THE VALUES OF
41814C                   SRC1 AND CONT1, LOOP THROUGH DATA SET 2 AND
41815C                   FIND ALL ROWS THE VALUES OF SRC2 AND CONT2
41816C                   MATCH THE VALUES OF SRC1 AND CONT1.  THESE
41817C                   DEFINE A "MERGED" ROW.  THE VALUES OF
41818C                   INST1, XMEAN1, INST2, AND XMEAN2 ARE "CARRIED"
41819C                   ON THE MERGED ROW.
41820C
41821C              SO NOTE THAT WE DEFINE TWO TYPES OF VARIABLES:
41822C
41823C                   1) MATCH VARIABLES
41824C                   2) CARRY VARIABLES
41825C
41826C              WE ASSUME THAT BOTH SETS OF DATA HAVE THE SAME
41827C              "MATCH" AND "CARRY" VARIABLES.  THE NUMBER OF
41828C              MATCH AND CARRY VARIABLES ARE SPECIFIED BY THE
41829C              VARIABLES IMERMA AND IMERCA (THESE ARE DEFINED
41830C              BY THE "SET MERGE MATCH VARIABLES <VALUE>" AND
41831C              "SET MERGE CARRY VARIABLES <VALUE>".
41832C
41833C              THE NUMBER OF VARIABLES TO THE LEFT OF THE "="
41834C              SHOULD BE "NMATCH + 2*NCARRY" AND THE NUMBER
41835C              OF VARIABLES TO THE RIGHT OF THE "=" SHOULD BE
41836C              "2*(NMATCH + NCARRY)".
41837C
41838C     WRITTEN BY--ALAN HECKERT
41839C                 STATISTICAL ENGINEERING DIVISION
41840C                 INFORMATION TECHNOLOGY LABORATORY
41841C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
41842C                 GAITHERSBURG, MD 20899-8980
41843C                 PHONE--301-975-2899
41844C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
41845C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
41846C     LANGUAGE--ANSI FORTRAN (1977)
41847C     VERSION NUMBER--2008/8
41848C     ORIGINAL VERSION--AUGUST   2008.
41849C     UPDATED         --JUNE     2009. ALLOW THE 2 SETS OF DATA ON
41850C                                      THE RHS TO HAVE A DIFFERENT
41851C                                      NUMBER OF CARRY VARIABLES
41852C     UPDATED         --JUNE     2009. ALLOW CASE WHERE THERE ARE
41853C                                      NO MATCH VARIABLES (I.E.,
41854C                                      EACH ROW OF SET 1 IS MERGED
41855C                                      WITH EACH ROW OF SET 2)
41856C     UPDATED         --OCTOBER  2009. ALLOW MAXIMUM OF 4 MATCH
41857C                                      VARIABLES
41858C     UPDATED         --MARCH    2010. SPECIAL CASE WHERE NUMBER OF MATCH
41859C                                      AND NUMBER OF CARRY VARIABLES ARE
41860C                                      BOTH SET TO 0.  FOR THIS CASE,
41861C                                      GENERATE ALL PERMUTATIONS.
41862C     UPDATED         --JULY     2019. MODIFY USE OF SCRATCH STORAGE
41863C
41864C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
41865C
41866CCCCC PARAMETER (MAXMAT=3)
41867      PARAMETER (MAXMAT=4)
41868      PARAMETER (MAXCAR=8)
41869      PARAMETER (MAXLEF=MAXMAT + 2*MAXCAR)
41870      PARAMETER (MAXRIG=2*MAXMAT + 2*MAXCAR)
41871      PARAMETER (MAXRI2=MAXMAT + MAXCAR)
41872C
41873      CHARACTER*4 IBUGA2
41874      CHARACTER*4 IBUGA3
41875      CHARACTER*4 ISUBRO
41876      CHARACTER*4 IFOUND
41877      CHARACTER*4 IERROR
41878C
41879      CHARACTER*4 ISUBN1
41880      CHARACTER*4 ISUBN2
41881      CHARACTER*4 ISTEPN
41882C
41883      CHARACTER*4 ICASLE
41884      CHARACTER*4 ICASL7
41885      CHARACTER*4 IBUGQ
41886      CHARACTER*4 ICASEQ
41887C
41888      CHARACTER*4 NEWNAM(MAXLEF)
41889      CHARACTER*4 ILEFT(MAXLEF)
41890      CHARACTER*4 ILEF2(MAXLEF)
41891C
41892      CHARACTER*4 ITYPA(MAXRIG)
41893      CHARACTER*4 IHRIGH(MAXRIG)
41894      CHARACTER*4 IHRIG2(MAXRIG)
41895C
41896      INTEGER ILISL(MAXLEF)
41897      INTEGER ICOLL(MAXLEF)
41898      INTEGER ILOCR(MAXRIG)
41899      INTEGER ILISR(MAXRIG)
41900      INTEGER ICOLR(MAXRIG)
41901      INTEGER NIRIGH(MAXRIG)
41902      REAL TEMPS(MAXRIG)
41903C
41904C---------------------------------------------------------------------
41905C
41906      INCLUDE 'DPCOPA.INC'
41907      INCLUDE 'DPCOZZ.INC'
41908      INCLUDE 'DPCOHO.INC'
41909C
41910      REAL YLEFT(MAXOBV,MAXLEF)
41911      REAL YRIGH1(MAXOBV,MAXRI2)
41912      REAL YRIGH2(MAXOBV,MAXRI2)
41913C
41914C-----COMMON----------------------------------------------------------
41915C
41916      INCLUDE 'DPCOST.INC'
41917      INCLUDE 'DPCOMC.INC'
41918      INCLUDE 'DPCOHK.INC'
41919      INCLUDE 'DPCOSU.INC'
41920      INCLUDE 'DPCODA.INC'
41921C
41922C-----COMMON VARIABLES (GENERAL)--------------------------------------
41923C
41924      EQUIVALENCE (YRIGH1(1,1),Y(1))
41925      EQUIVALENCE (YRIGH2(1,1),GARBAG(IGAR11))
41926      EQUIVALENCE (YLEFT(1,1),GARBAG(IGARB1))
41927C
41928C---------------------------------------------------------------------
41929C
41930      INCLUDE 'DPCOP2.INC'
41931C
41932C-----START POINT-----------------------------------------------------
41933C
41934      ISUBN1='DPME'
41935      ISUBN2='RG  '
41936      IBUGQ=IBUGA3
41937      IERROR='NO'
41938C
41939      MAXCP1=MAXCOL+1
41940      MAXCP2=MAXCOL+2
41941      MAXCP3=MAXCOL+3
41942      MAXCP4=MAXCOL+4
41943      MAXCP5=MAXCOL+5
41944      MAXCP6=MAXCOL+6
41945C
41946      MINV2=2
41947      MINN2=2
41948      NQ=1
41949      ICNT=0
41950      HOLD=0.0
41951C
41952C               ******************************
41953C               **  TREAT THE MERGE CASE    **
41954C               ******************************
41955C
41956      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
41957        WRITE(ICOUT,999)
41958  999   FORMAT(1X)
41959        CALL DPWRST('XXX','BUG ')
41960        WRITE(ICOUT,51)
41961   51   FORMAT('***** AT THE BEGINNING OF DPMERG--')
41962        CALL DPWRST('XXX','BUG ')
41963        WRITE(ICOUT,53)IBUGA2,IBUGA3
41964   53   FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
41965        CALL DPWRST('XXX','BUG ')
41966        WRITE(ICOUT,56)NUMNAM,IMERMA,IMERCA,IMERC2
41967   56   FORMAT('NUMNAM,IMERMA,IMERCA,IMERC2 = ',4I8)
41968        CALL DPWRST('XXX','BUG ')
41969        DO57I=1,NUMNAM
41970          WRITE(ICOUT,58)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),
41971     1                   IVALUE(I),VALUE(I)
41972   58     FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
41973     1           'VALUE(I) = ',I8,2X,2A4,2X,A4,2I8,F15.7)
41974          CALL DPWRST('XXX','BUG ')
41975   57   CONTINUE
41976      ENDIF
41977C
41978C     ***************************************
41979C     **  STEP 1A-                         **
41980C     **  FIND THE LOCATION OF "= MERGE"   **
41981C     ***************************************
41982C
41983      ISTEPN='1A'
41984      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
41985     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
41986C
41987      MINNA=MINV2
41988      MAXNA=100
41989      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
41990     1IERROR)
41991      IF(IERROR.EQ.'YES')GOTO9000
41992C
41993      DO100I=1,NUMARG-1
41994        IF(IHARG(I).EQ.'=' .AND. IHARG(I+1).EQ.'MERG')THEN
41995          NLEFT=I-1
41996          ILOCV=I+2
41997          GOTO109
41998        ENDIF
41999  100 CONTINUE
42000C
42001      IFOUND='NO'
42002      GOTO9000
42003C
42004  109 CONTINUE
42005      IFOUND='YES'
42006C
42007C     ************************************************
42008C     **  STEP 1B-                                  **
42009C     **  FIND THE LOCATION OF THE LAST ARGUMENT OR **
42010C     **  THE SUBSET/EXPCEPT/FOR CLASUE             **
42011C     ************************************************
42012C
42013      ISTEPN='1B'
42014      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42015     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42016C
42017C
42018      IF(ILOCV.LE.NUMARG)THEN
42019        DO110J=ILOCV,NUMARG
42020          J1=J
42021          IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO111
42022          IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO111
42023          IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO111
42024  110   CONTINUE
42025        ILOCQ=NUMARG+1
42026        GOTO112
42027  111   CONTINUE
42028        ILOCQ=J1
42029        GOTO112
42030  112   CONTINUE
42031        NQ=ILOCQ-1
42032C
42033        NRIGHT=NQ-ILOCV+1
42034C
42035      ENDIF
42036C
42037C     **********************************************************
42038C     **  STEP 1B-                                            **
42039C     **  CHECK FOR AN APPROPRIATE NUMBER OF VARIABLES ON THE **
42040C     **  LEFT OF THE "=" AND TO THE RIGHT OF THE "=".        **
42041C     **********************************************************
42042C
42043      ISTEPN='1B'
42044      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42045     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42046C
42047      NMATCH=IMERMA
42048      NCARR1=IMERCA
42049      NCARR2=IMERC2
42050      IF(NMATCH.EQ.0 .AND. NCARR1.EQ.0) THEN
42051        NEXPLE=NLEFT
42052        NEXPRI=NLEFT
42053        IFLAGP=1
42054      ELSE
42055        NEXPLE=NMATCH + NCARR1 + NCARR2
42056        NEXPRI=2*NMATCH+NCARR1+NCARR2
42057        IFLAGP=0
42058      ENDIF
42059C
42060      IF(NLEFT.NE.NEXPLE)THEN
42061        WRITE(ICOUT,131)
42062  131   FORMAT('***** ERROR IN MERGE--')
42063        CALL DPWRST('XXX','BUG ')
42064        WRITE(ICOUT,132)
42065  132   FORMAT('      THE EXPECTED NUMBER OF VARIABLES TO THE LEFT')
42066        CALL DPWRST('XXX','BUG ')
42067        WRITE(ICOUT,133)
42068  133   FORMAT('      OF THE "=" DOES NOT EQUAL THE ACTUAL NUMBER OF')
42069        CALL DPWRST('XXX','BUG ')
42070        WRITE(ICOUT,134)
42071  134   FORMAT('      VARIABLES TO THE LEFT OF THE "=".')
42072        CALL DPWRST('XXX','BUG ')
42073        WRITE(ICOUT,135)NLEFT
42074  135   FORMAT('      THE NUMBER OF VARIABLES TO THE LEFT OF THE "=" ',
42075     1         'IS            ',I8)
42076        CALL DPWRST('XXX','BUG ')
42077        WRITE(ICOUT,136)NMATCH
42078  136   FORMAT('      THE NUMBER OF MATCH VARIABLES IS               ',
42079     1         '              ',I8)
42080        CALL DPWRST('XXX','BUG ')
42081        WRITE(ICOUT,137)NCARR1
42082  137   FORMAT('      THE NUMBER OF CARRY VARIABLES FOR SET 1 IS     ',
42083     1         '              ',I8)
42084        CALL DPWRST('XXX','BUG ')
42085        WRITE(ICOUT,138)NCARR2
42086  138   FORMAT('      THE NUMBER OF CARRY VARIABLES FOR SET 2 IS     ',
42087     1         '              ',I8)
42088        CALL DPWRST('XXX','BUG ')
42089        WRITE(ICOUT,139)NEXPLE
42090  139   FORMAT('      THE EXPECTED NUMBER OF VARIABLES TO THE LEFT OF',
42091     1         ' THE "=" IS   ',I8)
42092        CALL DPWRST('XXX','BUG ')
42093        IF(IWIDTH.GE.1)THEN
42094          WRITE(ICOUT,140)(IANS(J),J=1,MIN(100,IWIDTH))
42095  140     FORMAT('      COMMAND LINE--',100A1)
42096          CALL DPWRST('XXX','BUG ')
42097        ENDIF
42098        IERROR='YES'
42099        GOTO9000
42100      ENDIF
42101C
42102      IF(NRIGHT.NE.NEXPRI)THEN
42103        WRITE(ICOUT,131)
42104        CALL DPWRST('XXX','BUG ')
42105        WRITE(ICOUT,142)
42106  142   FORMAT('      THE EXPECTED NUMBER OF VARIABLES TO THE RIGHT')
42107        CALL DPWRST('XXX','BUG ')
42108        WRITE(ICOUT,143)
42109  143   FORMAT('      OF THE "=" DOES NOT EQUAL THE ACTUAL NUMBER OF')
42110        CALL DPWRST('XXX','BUG ')
42111        WRITE(ICOUT,144)
42112  144   FORMAT('      VARIABLES TO THE RIGHT OF THE "=".')
42113        CALL DPWRST('XXX','BUG ')
42114        WRITE(ICOUT,145)NLEFT
42115  145   FORMAT('      THE NUMBER OF VARIABLES TO THE RIGHT OF ',
42116     1         'THE "=" IS            ',I8)
42117        CALL DPWRST('XXX','BUG ')
42118        WRITE(ICOUT,146)NMATCH
42119  146   FORMAT('      THE NUMBER OF MATCH VARIABLES IS               ',
42120     1         '              ',I8)
42121        CALL DPWRST('XXX','BUG ')
42122        WRITE(ICOUT,147)NCARR1
42123  147   FORMAT('      THE NUMBER OF CARRY VARIABLES FOR SET 1 IS     ',
42124     1         '              ',I8)
42125        CALL DPWRST('XXX','BUG ')
42126        WRITE(ICOUT,148)NCARR2
42127  148   FORMAT('      THE NUMBER OF CARRY VARIABLES FOR SET 2 IS     ',
42128     1         '              ',I8)
42129        CALL DPWRST('XXX','BUG ')
42130        WRITE(ICOUT,149)NEXPRI
42131  149   FORMAT('      THE EXPECTED NUMBER OF VARIABLES TO THE RIGHT',
42132     1         ' OF THE "=" IS   ',I8)
42133        CALL DPWRST('XXX','BUG ')
42134        IF(IWIDTH.GE.1)THEN
42135          WRITE(ICOUT,139)(IANS(J),J=1,MIN(100,IWIDTH))
42136          CALL DPWRST('XXX','BUG ')
42137        ENDIF
42138        IERROR='YES'
42139        GOTO9000
42140      ENDIF
42141C
42142      IFOUND='YES'
42143      ICASLE='MERG'
42144C
42145C     *******************************************************
42146C     **  STEP 2--                                         **
42147C     **  CHECK THE VARIABLE NAMES ON THE LEFT HAND SIDE.  **
42148C     *******************************************************
42149C
42150      ISTEPN='2'
42151      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42152     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42153C
42154      MAXCA2=20
42155      DO200I=1,NLEFT
42156C
42157        ICASEZ=I
42158        CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
42159     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
42160     1              NUMVAL,NIOLD,
42161     1              IBUGA2,ISUBRO,IFOUND,IERROR)
42162        IF(IERROR.EQ.'YES')GOTO9000
42163C
42164        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MERG')THEN
42165          WRITE(ICOUT,211)
42166  211     FORMAT('AFTER CALL TO DPMAT6--')
42167          CALL DPWRST('XXX','BUG ')
42168          WRITE(ICOUT,212)ILEFT(I),ILEF2(I),NEWNAM(I),NUMNAM,
42169     1                  ILISL(I),NUMCOL,ICOLL(I),NIOLD
42170          CALL DPWRST('XXX','BUG ')
42171  212     FORMAT('ILEFT(I),ILEFT(I),NEWNAM(I),NUMNAM,ILISL(I),',
42172     1           'NUMCOL,ICOLL(I),NIOLD = ',A4,A4,2X,A4,2X,5I8)
42173        ENDIF
42174C
42175  200 CONTINUE
42176C
42177C     *******************************************************
42178C     **  STEP 3--                                         **
42179C     **  CHECK THE VARIABLE NAMES ON THE RIGHT HAND SIDE. **
42180C     *******************************************************
42181C
42182      ISTEPN='3'
42183      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42184     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42185C
42186      MAXCAS=2*NMATCH+NCARR1 + NCARR2
42187      IF(IFLAGP.EQ.1)MAXCAS=NRIGHT
42188      ILOCR(1)=ILOCV
42189      DO300I=2,MAXCAS
42190        ILOCR(I)=ILOCR(I-1)+1
42191        ITYPA(I)='VARI'
42192        TEMPS(I)=-999.0
42193        ILISR(I)=-999
42194        ICOLR(I)=-999
42195        NIRIGH(I)=-999
42196  300 CONTINUE
42197C
42198      IFLAG1=0
42199      IPART2=NMATCH+NCARR1+1
42200      IF(IFLAGP.EQ.1)IPART2=0
42201      DO310I=1,NRIGHT
42202        ICASEZ=I
42203        CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
42204     1              IHRIGH(ICASEZ),IHRIG2(ICASEZ),
42205     1              ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
42206     1              IFLAG1,ATEMP2,ITEMP,
42207     1              IBUGA3,ISUBRO,IFOUND,IERROR)
42208C
42209        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
42210          WRITE(ICOUT,999)
42211          CALL DPWRST('XXX','BUG ')
42212          WRITE(ICOUT,301)
42213  301     FORMAT('AFTER DPMAT7:')
42214          CALL DPWRST('XXX','BUG ')
42215          WRITE(ICOUT,302)ICASEZ,ICOLR(ICASEZ),ILISR(ICASEZ),
42216     1                    NIRIGH(ICASEZ)
42217  302     FORMAT('ICASEZ,ICOLR(ICASEZ),ILISR(ICASEZ),NIRIGH(ICASEZ)=',
42218     1           4I8)
42219          CALL DPWRST('XXX','BUG ')
42220        ENDIF
42221C
42222        IF(IERROR.EQ.'YES')GOTO9000
42223C
42224        IF(ICASEZ.GT.1 .AND. ICASEZ.LE.NMATCH+NCARR1 .AND.
42225     1     IFLAGP.EQ.0)THEN
42226          IF(NIRIGH(ICASEZ).NE.NIRIGH(1))THEN
42227            IINDX=ILOCV+I-1
42228            WRITE(ICOUT,131)
42229            CALL DPWRST('XXX','BUG ')
42230            WRITE(ICOUT,312)IHARG(IINDX),IHARG2(IINDX)
42231  312       FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE ',
42232     1             A4,A4)
42233            CALL DPWRST('XXX','BUG ')
42234            WRITE(ICOUT,313)IHARG(ILOCV),IHARG2(ILOCV)
42235  313       FORMAT('      DOES NOT EQUAL THE NUMBER OF OBSERVATIONS ',
42236     1             'FOR VARIABLE ',A4,A4,'.')
42237            CALL DPWRST('XXX','BUG ')
42238            WRITE(ICOUT,314)IHARG(IINDX),IHARG2(IINDX),NIRIGH(ICASEZ)
42239  314       FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,
42240     1             ' OBSERVATIONS.')
42241            CALL DPWRST('XXX','BUG ')
42242            WRITE(ICOUT,314)IHARG(ILOCV),IHARG2(ILOCV),NIRIGH(1)
42243            CALL DPWRST('XXX','BUG ')
42244            IF(IWIDTH.GE.1)THEN
42245              WRITE(ICOUT,139)(IANS(J),J=1,MIN(100,IWIDTH))
42246              CALL DPWRST('XXX','BUG ')
42247            ENDIF
42248            IERROR='YES'
42249            GOTO9000
42250          ENDIF
42251        ELSEIF(ICASEZ.GT.IPART2 .AND. IFLAGP.EQ.0)THEN
42252          IF(NIRIGH(ICASEZ).NE.NIRIGH(IPART2))THEN
42253            IINDX=ILOCV+I-1
42254            IINDX2=IPART2+ILOCV
42255            WRITE(ICOUT,131)
42256            CALL DPWRST('XXX','BUG ')
42257            WRITE(ICOUT,312)IHARG(IINDX),IHARG2(IINDX)
42258            CALL DPWRST('XXX','BUG ')
42259            WRITE(ICOUT,313)IHARG(IINDX2),IHARG2(IINDX2)
42260            CALL DPWRST('XXX','BUG ')
42261            WRITE(ICOUT,314)IHARG(IINDX),IHARG2(IINDX),NIRIGH(ICASEZ)
42262            CALL DPWRST('XXX','BUG ')
42263            WRITE(ICOUT,314)IHARG(IINDX2),IHARG2(IINDX2),NIRIGH(IPART2)
42264            CALL DPWRST('XXX','BUG ')
42265            IF(IWIDTH.GE.1)THEN
42266              WRITE(ICOUT,139)(IANS(J),J=1,MIN(100,IWIDTH))
42267              CALL DPWRST('XXX','BUG ')
42268            ENDIF
42269            IERROR='YES'
42270            GOTO9000
42271          ENDIF
42272        ENDIF
42273C
42274  310 CONTINUE
42275C
42276C     **********************************************
42277C     **  STEP 4--                                **
42278C     **  CHECK TO SEE THE TYPE CASE--            **
42279C     **    1) UNQUALIFIED (THAT IS, FULL);       **
42280C     **    2) SUBSET/EXCEPT; OR                  **
42281C     **    3) FOR.                               **
42282C     **********************************************
42283C
42284      ISTEPN='4'
42285      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42286     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42287C
42288      ICASEQ='FULL'
42289      ILOCQ=NUMARG+1
42290      IF(NUMARG.LT.1)GOTO490
42291      DO400J=1,NUMARG
42292      J1=J
42293      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO410
42294      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO410
42295      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO420
42296  400 CONTINUE
42297      GOTO490
42298  410 CONTINUE
42299      ICASEQ='SUBS'
42300      ILOCQ=J1
42301      GOTO490
42302  420 CONTINUE
42303      ICASEQ='FOR'
42304      ILOCQ=J1
42305      GOTO490
42306  490 CONTINUE
42307C
42308      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
42309        WRITE(ICOUT,491)NUMARG,ILOCQ,IPART2
42310  491   FORMAT('NUMARG,ILOCQ,IPART2 = ',3I8)
42311        CALL DPWRST('XXX','BUG ')
42312      ENDIF
42313C
42314C     *****************************************************
42315C     **  STEP 5--                                       **
42316C     **  BRANCH TO THE APPROPRIATE SUBCASE; THEN        **
42317C     **  CREATE THE MATRICES FOR TWO SETS OF DATA.      **
42318C     *****************************************************
42319C
42320      ISTEPN='5'
42321      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
42322        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42323        WRITE(ICOUT,501)N,ILOCQ-1
42324  501   FORMAT('N,ILOCQ-1 = ',2I8)
42325        CALL DPWRST('XXX','BUG ')
42326      ENDIF
42327C
42328      IF(IFLAGP.EQ.1)THEN
42329        NTEMP=NIRIGH(1)
42330        DO506I=1,NRIGHT
42331          NTEMP=MAX(NTEMP,NIRIGH(I))
42332  506   CONTINUE
42333        NTEMP1=NTEMP
42334        NTEMP2=0
42335        NTEMP9=NRIGHT
42336      ELSE
42337        NTEMP1=NIRIGH(1)
42338        NTEMP2=NIRIGH(IPART2)
42339        NTEMP=MAX(NTEMP1,NTEMP2)
42340        NTEMP9=NMATCH+NCARR1
42341      ENDIF
42342C
42343      IF(ICASEQ.EQ.'FULL' .OR. IFLAGP.EQ.1)GOTO510
42344      IF(ICASEQ.EQ.'SUBS')GOTO520
42345      IF(ICASEQ.EQ.'FOR')GOTO530
42346C
42347  510 CONTINUE
42348      DO515I=1,NTEMP
42349      ISUB(I)=1
42350  515 CONTINUE
42351      NQZ=NTEMP
42352      GOTO550
42353C
42354  520 CONTINUE
42355      NIOLD=NTEMP
42356CCCCC CALL DPSUB2(NIOLD,ILOCS,NSTEMP,IBUGQ,IERROR)
42357      CALL DPSUBS(NIOLD,ILOCS,NSTEMP,IBUGQ,IERROR)
42358      NQZ=NIOLD
42359      GOTO550
42360C
42361  530 CONTINUE
42362      NIOLD=NTEMP
42363      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
42364     1NLOCAL,ILOCS,NSTEMP,IBUGQ,IERROR)
42365      NQZ=NFOR
42366      GOTO550
42367C
42368  550 CONTINUE
42369      J=0
42370      DO560I=1,NTEMP1
42371        IF(ISUB(I).EQ.0)GOTO560
42372        J=J+1
42373        DO570JJ=1,NTEMP9
42374          K=ICOLR(JJ)
42375          IJ=MAXN*(K-1)+I
42376          IF(K.LE.MAXCOL)YRIGH1(J,JJ)=V(IJ)
42377          IF(K.EQ.MAXCP1)YRIGH1(J,JJ)=PRED(I)
42378          IF(K.EQ.MAXCP2)YRIGH1(J,JJ)=RES(I)
42379          IF(K.EQ.MAXCP3)YRIGH1(J,JJ)=YPLOT(I)
42380          IF(K.EQ.MAXCP4)YRIGH1(J,JJ)=XPLOT(I)
42381          IF(K.EQ.MAXCP5)YRIGH1(J,JJ)=X2PLOT(I)
42382          IF(K.EQ.MAXCP6)YRIGH1(J,JJ)=TAGPLO(I)
42383  570   CONTINUE
42384  560 CONTINUE
42385      NS1=J
42386C
42387      IF(IFLAGP.EQ.1)GOTO669
42388      J=0
42389      DO660I=1,NTEMP2
42390        IF(ISUB(I).EQ.0)GOTO660
42391        J=J+1
42392        DO670JJ=1,NMATCH+NCARR2
42393          JJTEMP=NMATCH+NCARR1+JJ
42394          K=ICOLR(JJTEMP)
42395          IJ=MAXN*(K-1)+I
42396          IF(K.LE.MAXCOL)YRIGH2(J,JJ)=V(IJ)
42397          IF(K.EQ.MAXCP1)YRIGH2(J,JJ)=PRED(I)
42398          IF(K.EQ.MAXCP2)YRIGH2(J,JJ)=RES(I)
42399          IF(K.EQ.MAXCP3)YRIGH2(J,JJ)=YPLOT(I)
42400          IF(K.EQ.MAXCP4)YRIGH2(J,JJ)=XPLOT(I)
42401          IF(K.EQ.MAXCP5)YRIGH2(J,JJ)=X2PLOT(I)
42402          IF(K.EQ.MAXCP6)YRIGH2(J,JJ)=TAGPLO(I)
42403  670   CONTINUE
42404  660 CONTINUE
42405      NS2=J
42406  669 CONTINUE
42407C
42408      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
42409        WRITE(ICOUT,999)
42410        CALL DPWRST('XXX','BUG ')
42411        WRITE(ICOUT,691)
42412  691   FORMAT('***** FROM DPMERG, AFTER FORMING RHS MATRICES')
42413        CALL DPWRST('XXX','BUG ')
42414        WRITE(ICOUT,692)NTEMP1,NTEMP2,NTEMP,NS1,NS2
42415  692   FORMAT('NTEMP1,NTEMP2,NTEMP,NS1,NS2 = ',5(I8,2X))
42416        CALL DPWRST('XXX','BUG ')
42417        NTEMP8=NMATCH+NCARR1+NCARR2
42418        IF(IFLAGP.EQ.1)NTEMP8=NRIGHT
42419        DO693I=1,NTEMP8
42420          WRITE(ICOUT,694)I,ICOLR(I),ILOCR(I)
42421  694     FORMAT('I,ICOLR(I),ILOCR(I) = ',3(I8,2X))
42422          CALL DPWRST('XXX','BUG ')
42423  693   CONTINUE
42424        DO695I=1,NS1
42425          WRITE(ICOUT,696)I,(YRIGH1(I,JJ),JJ=1,NTEMP9)
42426  696     FORMAT(I8,20(G15.7))
42427          CALL DPWRST('XXX','BUG ')
42428  695   CONTINUE
42429        IF(IFLAGP.EQ.0)THEN
42430          DO697I=1,NS2
42431            WRITE(ICOUT,696)I,(YRIGH2(I,JJ),JJ=1,NMATCH+NCARR2)
42432            CALL DPWRST('XXX','BUG ')
42433  697     CONTINUE
42434        ENDIF
42435      ENDIF
42436C
42437C               ******************************************************
42438C               **  STEP 6--                                        **
42439C               **  CARRY OUT THE MERGE                             **
42440C               ******************************************************
42441C
42442      ISTEPN='6'
42443      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42444     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42445C
42446      IF(IFLAGP.EQ.1)THEN
42447C
42448        ISTEPN='6A'
42449        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42450     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42451C
42452        IF(NRIGHT.EQ.1)THEN
42453          DO6010I=1,NIRIGH(1)
42454            YLEFT(I,1)=YRIGH1(I,1)
42455 6010     CONTINUE
42456          NINEW=NIRIGH(1)
42457        ELSEIF(NRIGHT.EQ.2)THEN
42458          ICNT=0
42459          DO6110ISET1=1,NIRIGH(1)
42460            AHOLD1=YRIGH1(ISET1,1)
42461            DO6120ISET2=1,NIRIGH(2)
42462              AHOLD2=YRIGH1(ISET2,2)
42463              ICNT=ICNT+1
42464C
42465              IF(ICNT.GT.MAXN)THEN
42466                WRITE(ICOUT,131)
42467                CALL DPWRST('XXX','BUG ')
42468                WRITE(ICOUT,6121)
42469 6121           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42470     1                 'RIGHT HAND SIDE')
42471                CALL DPWRST('XXX','BUG ')
42472                WRITE(ICOUT,6123)MAXN
42473 6123           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42474     1                 'ALLOWABLE (',I8,')')
42475                CALL DPWRST('XXX','BUG ')
42476                IERROR='YES'
42477                GOTO9000
42478              ENDIF
42479C
42480              YLEFT(ICNT,1)=AHOLD1
42481              YLEFT(ICNT,2)=AHOLD2
42482 6120       CONTINUE
42483 6110     CONTINUE
42484          NINEW=ICNT
42485        ELSEIF(NRIGHT.EQ.3)THEN
42486          ICNT=0
42487          DO6210ISET1=1,NIRIGH(1)
42488            AHOLD1=YRIGH1(ISET1,1)
42489            DO6220ISET2=1,NIRIGH(2)
42490              AHOLD2=YRIGH1(ISET2,2)
42491              DO6230ISET3=1,NIRIGH(3)
42492              AHOLD3=YRIGH1(ISET3,3)
42493              ICNT=ICNT+1
42494C
42495              IF(ICNT.GT.MAXN)THEN
42496                WRITE(ICOUT,131)
42497                CALL DPWRST('XXX','BUG ')
42498                WRITE(ICOUT,6231)
42499 6231           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42500     1                 'RIGHT HAND SIDE')
42501                CALL DPWRST('XXX','BUG ')
42502                WRITE(ICOUT,6233)MAXN
42503 6233           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42504     1                 'ALLOWABLE (',I8,')')
42505                CALL DPWRST('XXX','BUG ')
42506                IERROR='YES'
42507                GOTO9000
42508              ENDIF
42509C
42510              YLEFT(ICNT,1)=AHOLD1
42511              YLEFT(ICNT,2)=AHOLD2
42512              YLEFT(ICNT,3)=AHOLD3
42513 6230       CONTINUE
42514 6220       CONTINUE
42515 6210     CONTINUE
42516          NINEW=ICNT
42517        ELSEIF(NRIGHT.EQ.4)THEN
42518          ICNT=0
42519          DO6310ISET1=1,NIRIGH(1)
42520            AHOLD1=YRIGH1(ISET1,1)
42521            DO6320ISET2=1,NIRIGH(2)
42522              AHOLD2=YRIGH1(ISET2,2)
42523              DO6330ISET3=1,NIRIGH(3)
42524              AHOLD3=YRIGH1(ISET3,3)
42525              DO6340ISET4=1,NIRIGH(4)
42526              AHOLD4=YRIGH1(ISET4,4)
42527              ICNT=ICNT+1
42528C
42529              IF(ICNT.GT.MAXN)THEN
42530                WRITE(ICOUT,131)
42531                CALL DPWRST('XXX','BUG ')
42532                WRITE(ICOUT,6341)
42533 6341           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42534     1                 'RIGHT HAND SIDE')
42535                CALL DPWRST('XXX','BUG ')
42536                WRITE(ICOUT,6343)MAXN
42537 6343           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42538     1                 'ALLOWABLE (',I8,')')
42539                CALL DPWRST('XXX','BUG ')
42540                IERROR='YES'
42541                GOTO9000
42542              ENDIF
42543C
42544              YLEFT(ICNT,1)=AHOLD1
42545              YLEFT(ICNT,2)=AHOLD2
42546              YLEFT(ICNT,3)=AHOLD3
42547              YLEFT(ICNT,4)=AHOLD4
42548 6340       CONTINUE
42549 6330       CONTINUE
42550 6320       CONTINUE
42551 6310     CONTINUE
42552          NINEW=ICNT
42553        ELSEIF(NRIGHT.EQ.5)THEN
42554          ICNT=0
42555          DO6410ISET1=1,NIRIGH(1)
42556            AHOLD1=YRIGH1(ISET1,1)
42557            DO6420ISET2=1,NIRIGH(2)
42558              AHOLD2=YRIGH1(ISET2,2)
42559              DO6430ISET3=1,NIRIGH(3)
42560              AHOLD3=YRIGH1(ISET3,3)
42561              DO6440ISET4=1,NIRIGH(4)
42562              AHOLD4=YRIGH1(ISET3,4)
42563              DO6450ISET5=1,NIRIGH(5)
42564              AHOLD5=YRIGH1(ISET5,5)
42565              ICNT=ICNT+1
42566C
42567              IF(ICNT.GT.MAXN)THEN
42568                WRITE(ICOUT,131)
42569                CALL DPWRST('XXX','BUG ')
42570                WRITE(ICOUT,6451)
42571 6451           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42572     1                 'RIGHT HAND SIDE')
42573                CALL DPWRST('XXX','BUG ')
42574                WRITE(ICOUT,6453)MAXN
42575 6453           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42576     1                 'ALLOWABLE (',I8,')')
42577                CALL DPWRST('XXX','BUG ')
42578                IERROR='YES'
42579                GOTO9000
42580              ENDIF
42581C
42582              YLEFT(ICNT,1)=AHOLD1
42583              YLEFT(ICNT,2)=AHOLD2
42584              YLEFT(ICNT,3)=AHOLD3
42585              YLEFT(ICNT,4)=AHOLD4
42586              YLEFT(ICNT,5)=AHOLD5
42587 6450       CONTINUE
42588 6440       CONTINUE
42589 6430       CONTINUE
42590 6420       CONTINUE
42591 6410     CONTINUE
42592          NINEW=ICNT
42593        ELSEIF(NRIGHT.EQ.6)THEN
42594          ICNT=0
42595          DO6510ISET1=1,NIRIGH(1)
42596            AHOLD1=YRIGH1(ISET1,1)
42597            DO6520ISET2=1,NIRIGH(2)
42598              AHOLD2=YRIGH1(ISET2,2)
42599              DO6530ISET3=1,NIRIGH(3)
42600              AHOLD3=YRIGH1(ISET3,3)
42601              DO6540ISET4=1,NIRIGH(4)
42602              AHOLD4=YRIGH1(ISET3,4)
42603              DO6550ISET5=1,NIRIGH(5)
42604              AHOLD5=YRIGH1(ISET5,5)
42605              DO6560ISET6=1,NIRIGH(6)
42606              AHOLD6=YRIGH1(ISET6,6)
42607              ICNT=ICNT+1
42608C
42609              IF(ICNT.GT.MAXN)THEN
42610                WRITE(ICOUT,131)
42611                CALL DPWRST('XXX','BUG ')
42612                WRITE(ICOUT,6561)
42613 6561           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42614     1                 'RIGHT HAND SIDE')
42615                CALL DPWRST('XXX','BUG ')
42616                WRITE(ICOUT,6563)MAXN
42617 6563           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42618     1                 'ALLOWABLE (',I8,')')
42619                CALL DPWRST('XXX','BUG ')
42620                IERROR='YES'
42621                GOTO9000
42622              ENDIF
42623C
42624              YLEFT(ICNT,1)=AHOLD1
42625              YLEFT(ICNT,2)=AHOLD2
42626              YLEFT(ICNT,3)=AHOLD3
42627              YLEFT(ICNT,4)=AHOLD4
42628              YLEFT(ICNT,5)=AHOLD5
42629              YLEFT(ICNT,6)=AHOLD6
42630 6560       CONTINUE
42631 6550       CONTINUE
42632 6540       CONTINUE
42633 6530       CONTINUE
42634 6520       CONTINUE
42635 6510     CONTINUE
42636          NINEW=ICNT
42637        ELSEIF(NRIGHT.EQ.7)THEN
42638          ICNT=0
42639          DO6610ISET1=1,NIRIGH(1)
42640            AHOLD1=YRIGH1(ISET1,1)
42641            DO6620ISET2=1,NIRIGH(2)
42642              AHOLD2=YRIGH1(ISET2,2)
42643              DO6630ISET3=1,NIRIGH(3)
42644              AHOLD3=YRIGH1(ISET3,3)
42645              DO6640ISET4=1,NIRIGH(4)
42646              AHOLD4=YRIGH1(ISET3,4)
42647              DO6650ISET5=1,NIRIGH(5)
42648              AHOLD5=YRIGH1(ISET5,5)
42649              DO6660ISET6=1,NIRIGH(6)
42650              AHOLD6=YRIGH1(ISET6,6)
42651              DO6670ISET7=1,NIRIGH(7)
42652              AHOLD7=YRIGH1(ISET7,7)
42653              ICNT=ICNT+1
42654C
42655              IF(ICNT.GT.MAXN)THEN
42656                WRITE(ICOUT,131)
42657                CALL DPWRST('XXX','BUG ')
42658                WRITE(ICOUT,6671)
42659 6671           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42660     1                 'RIGHT HAND SIDE')
42661                CALL DPWRST('XXX','BUG ')
42662                WRITE(ICOUT,6673)MAXN
42663 6673           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42664     1                 'ALLOWABLE (',I8,')')
42665                CALL DPWRST('XXX','BUG ')
42666                IERROR='YES'
42667                GOTO9000
42668              ENDIF
42669C
42670              YLEFT(ICNT,1)=AHOLD1
42671              YLEFT(ICNT,2)=AHOLD2
42672              YLEFT(ICNT,3)=AHOLD3
42673              YLEFT(ICNT,4)=AHOLD4
42674              YLEFT(ICNT,5)=AHOLD5
42675              YLEFT(ICNT,6)=AHOLD6
42676              YLEFT(ICNT,7)=AHOLD7
42677 6670       CONTINUE
42678 6660       CONTINUE
42679 6650       CONTINUE
42680 6640       CONTINUE
42681 6630       CONTINUE
42682 6620       CONTINUE
42683 6610     CONTINUE
42684          NINEW=ICNT
42685        ELSEIF(NRIGHT.EQ.8)THEN
42686          ICNT=0
42687          DO6710ISET1=1,NIRIGH(1)
42688            AHOLD1=YRIGH1(ISET1,1)
42689            DO6720ISET2=1,NIRIGH(2)
42690              AHOLD2=YRIGH1(ISET2,2)
42691              DO6730ISET3=1,NIRIGH(3)
42692              AHOLD3=YRIGH1(ISET3,3)
42693              DO6740ISET4=1,NIRIGH(4)
42694              AHOLD4=YRIGH1(ISET3,4)
42695              DO6750ISET5=1,NIRIGH(5)
42696              AHOLD5=YRIGH1(ISET5,5)
42697              DO6760ISET6=1,NIRIGH(6)
42698              AHOLD6=YRIGH1(ISET6,6)
42699              DO6770ISET7=1,NIRIGH(7)
42700              AHOLD7=YRIGH1(ISET7,7)
42701              DO6780ISET8=1,NIRIGH(8)
42702              AHOLD8=YRIGH1(ISET8,8)
42703              ICNT=ICNT+1
42704C
42705              IF(ICNT.GT.MAXN)THEN
42706                WRITE(ICOUT,131)
42707                CALL DPWRST('XXX','BUG ')
42708                WRITE(ICOUT,6781)
42709 6781           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42710     1                 'RIGHT HAND SIDE')
42711                CALL DPWRST('XXX','BUG ')
42712                WRITE(ICOUT,6783)MAXN
42713 6783           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42714     1                 'ALLOWABLE (',I8,')')
42715                CALL DPWRST('XXX','BUG ')
42716                IERROR='YES'
42717                GOTO9000
42718              ENDIF
42719C
42720              YLEFT(ICNT,1)=AHOLD1
42721              YLEFT(ICNT,2)=AHOLD2
42722              YLEFT(ICNT,3)=AHOLD3
42723              YLEFT(ICNT,4)=AHOLD4
42724              YLEFT(ICNT,5)=AHOLD5
42725              YLEFT(ICNT,6)=AHOLD6
42726              YLEFT(ICNT,7)=AHOLD7
42727              YLEFT(ICNT,8)=AHOLD8
42728 6780       CONTINUE
42729 6770       CONTINUE
42730 6760       CONTINUE
42731 6750       CONTINUE
42732 6740       CONTINUE
42733 6730       CONTINUE
42734 6720       CONTINUE
42735 6710     CONTINUE
42736          NINEW=ICNT
42737        ELSEIF(NRIGHT.EQ.9)THEN
42738          ICNT=0
42739          DO6810ISET1=1,NIRIGH(1)
42740            AHOLD1=YRIGH1(ISET1,1)
42741            DO6820ISET2=1,NIRIGH(2)
42742              AHOLD2=YRIGH1(ISET2,2)
42743              DO6830ISET3=1,NIRIGH(3)
42744              AHOLD3=YRIGH1(ISET3,3)
42745              DO6840ISET4=1,NIRIGH(4)
42746              AHOLD4=YRIGH1(ISET3,4)
42747              DO6850ISET5=1,NIRIGH(5)
42748              AHOLD5=YRIGH1(ISET5,5)
42749              DO6860ISET6=1,NIRIGH(6)
42750              AHOLD6=YRIGH1(ISET6,6)
42751              DO6870ISET7=1,NIRIGH(7)
42752              AHOLD7=YRIGH1(ISET7,7)
42753              DO6880ISET8=1,NIRIGH(8)
42754              AHOLD8=YRIGH1(ISET8,8)
42755              DO6890ISET9=1,NIRIGH(9)
42756              AHOLD9=YRIGH1(ISET9,9)
42757              ICNT=ICNT+1
42758C
42759              IF(ICNT.GT.MAXN)THEN
42760                WRITE(ICOUT,131)
42761                CALL DPWRST('XXX','BUG ')
42762                WRITE(ICOUT,6891)
42763 6891           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42764     1                 'RIGHT HAND SIDE')
42765                CALL DPWRST('XXX','BUG ')
42766                WRITE(ICOUT,6893)MAXN
42767 6893           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42768     1                 'ALLOWABLE (',I8,')')
42769                CALL DPWRST('XXX','BUG ')
42770                IERROR='YES'
42771                GOTO9000
42772              ENDIF
42773C
42774              YLEFT(ICNT,1)=AHOLD1
42775              YLEFT(ICNT,2)=AHOLD2
42776              YLEFT(ICNT,3)=AHOLD3
42777              YLEFT(ICNT,4)=AHOLD4
42778              YLEFT(ICNT,5)=AHOLD5
42779              YLEFT(ICNT,6)=AHOLD6
42780              YLEFT(ICNT,7)=AHOLD7
42781              YLEFT(ICNT,8)=AHOLD8
42782              YLEFT(ICNT,9)=AHOLD9
42783 6890       CONTINUE
42784 6880       CONTINUE
42785 6870       CONTINUE
42786 6860       CONTINUE
42787 6850       CONTINUE
42788 6840       CONTINUE
42789 6830       CONTINUE
42790 6820       CONTINUE
42791 6810     CONTINUE
42792          NINEW=ICNT
42793        ELSEIF(NRIGHT.EQ.10)THEN
42794          ICNT=0
42795          DO6910ISET1=1,NIRIGH(1)
42796            AHOLD1=YRIGH1(ISET1,1)
42797            DO6920ISET2=1,NIRIGH(2)
42798              AHOLD2=YRIGH1(ISET2,2)
42799              DO6930ISET3=1,NIRIGH(3)
42800              AHOLD3=YRIGH1(ISET3,3)
42801              DO6940ISET4=1,NIRIGH(4)
42802              AHOLD4=YRIGH1(ISET3,4)
42803              DO6950ISET5=1,NIRIGH(5)
42804              AHOLD5=YRIGH1(ISET5,5)
42805              DO6960ISET6=1,NIRIGH(6)
42806              AHOLD6=YRIGH1(ISET6,6)
42807              DO6970ISET7=1,NIRIGH(7)
42808              AHOLD7=YRIGH1(ISET7,7)
42809              DO6980ISET8=1,NIRIGH(8)
42810              AHOLD8=YRIGH1(ISET8,8)
42811              DO6990ISET9=1,NIRIGH(9)
42812              AHOLD9=YRIGH1(ISET9,9)
42813              DO6991ISET10=1,NIRIGH(10)
42814              AHOL10=YRIGH1(ISET10,10)
42815              ICNT=ICNT+1
42816C
42817              IF(ICNT.GT.MAXN)THEN
42818                WRITE(ICOUT,131)
42819                CALL DPWRST('XXX','BUG ')
42820                WRITE(ICOUT,6996)
42821 6996           FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
42822     1                 'RIGHT HAND SIDE')
42823                CALL DPWRST('XXX','BUG ')
42824                WRITE(ICOUT,6998)MAXN
42825 6998           FORMAT('      HAS JUST EXCEEDED THE MAXIMUM ',
42826     1                 'ALLOWABLE (',I8,')')
42827                CALL DPWRST('XXX','BUG ')
42828                IERROR='YES'
42829                GOTO9000
42830              ENDIF
42831C
42832              YLEFT(ICNT,1)=AHOLD1
42833              YLEFT(ICNT,2)=AHOLD2
42834              YLEFT(ICNT,3)=AHOLD3
42835              YLEFT(ICNT,4)=AHOLD4
42836              YLEFT(ICNT,5)=AHOLD5
42837              YLEFT(ICNT,6)=AHOLD6
42838              YLEFT(ICNT,7)=AHOLD7
42839              YLEFT(ICNT,8)=AHOLD8
42840              YLEFT(ICNT,9)=AHOLD9
42841              YLEFT(ICNT,10)=AHOL10
42842 6991       CONTINUE
42843 6990       CONTINUE
42844 6980       CONTINUE
42845 6970       CONTINUE
42846 6960       CONTINUE
42847 6950       CONTINUE
42848 6940       CONTINUE
42849 6930       CONTINUE
42850 6920       CONTINUE
42851 6910     CONTINUE
42852          NINEW=ICNT
42853        ELSE
42854          WRITE(ICOUT,131)
42855          CALL DPWRST('XXX','BUG ')
42856          WRITE(ICOUT,6091)
42857 6091     FORMAT('      FOR THE SPECIAL CASE OF THE MERGE COMMAND ',
42858     1           'WITH ZERO MATCH AND')
42859          CALL DPWRST('XXX','BUG ')
42860          WRITE(ICOUT,6092)
42861 6092     FORMAT('      ZERO CARRY VARIABLES, THE MAXIMUM NUMBER OF ',
42862     1           'VARIABLES ON THE')
42863          CALL DPWRST('XXX','BUG ')
42864          WRITE(ICOUT,6093)
42865 6093     FORMAT('      RIGHT HAND SIDE IS ',I8,'.')
42866          CALL DPWRST('XXX','BUG ')
42867          WRITE(ICOUT,6094)NRIGHT
42868 6094     FORMAT('      THE NUMBER OF VARIABLES ON THE RIGHT HAND ',
42869     1           'SIDE IS ',I8,'.')
42870          CALL DPWRST('XXX','BUG ')
42871          IERROR='YES'
42872          GOTO9000
42873        ENDIF
42874        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
42875          WRITE(ICOUT,6098)NINEW
42876 6098     FORMAT('AFTER CREATING LHS: NINEW = ',I8)
42877          CALL DPWRST('XXX','BUG ')
42878        ENDIF
42879C
42880      ELSEIF(NMATCH.EQ.0)THEN
42881C
42882        ISTEPN='6A0'
42883        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42884     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42885C
42886        ICNT=0
42887        DO2010I=1,NS1
42888          DO2020J=1,NS2
42889            ICNT=ICNT+1
42890            IF(ICNT.GT.MAXN)GOTO1910
42891            YLEFT(ICNT,1)=HOLD
42892            DO2030K=1,NCARR1
42893              YLEFT(ICNT,K)=YRIGH1(I,K)
42894 2030       CONTINUE
42895            DO2035K=1,NCARR2
42896              YLEFT(ICNT,NCARR1+K)=YRIGH2(J,K)
42897 2035       CONTINUE
42898 2020     CONTINUE
42899 2010   CONTINUE
42900        NINEW=ICNT
42901C
42902      ELSEIF(NMATCH.EQ.1)THEN
42903C
42904        ISTEPN='6A'
42905        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42906     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42907C
42908        ICNT=0
42909        DO1010I=1,NS1
42910          HOLD=YRIGH1(I,1)
42911          DO1020J=1,NS2
42912            IF(YRIGH2(J,1).EQ.HOLD)THEN
42913              ICNT=ICNT+1
42914              IF(ICNT.GT.MAXN)GOTO1910
42915              YLEFT(ICNT,1)=HOLD
42916              DO1030K=1,NCARR1
42917                YLEFT(ICNT,1+K)=YRIGH1(I,K+1)
42918 1030         CONTINUE
42919              DO1035K=1,NCARR2
42920                YLEFT(ICNT,1+NCARR1+K)=YRIGH2(J,K+1)
42921 1035         CONTINUE
42922            ENDIF
42923 1020     CONTINUE
42924 1010   CONTINUE
42925        NINEW=ICNT
42926C
42927      ELSEIF(NMATCH.EQ.2)THEN
42928C
42929        ISTEPN='6B'
42930        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42931     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42932C
42933        ICNT=0
42934        DO1110I=1,NS1
42935          HOLD1=YRIGH1(I,1)
42936          HOLD2=YRIGH1(I,2)
42937          DO1120J=1,NS2
42938            IF(YRIGH2(J,1).EQ.HOLD1 .AND. YRIGH2(J,2).EQ.HOLD2)THEN
42939              ICNT=ICNT+1
42940              IF(ICNT.GT.MAXN)GOTO1910
42941              YLEFT(ICNT,1)=HOLD1
42942              YLEFT(ICNT,2)=HOLD2
42943              DO1130K=1,NCARR1
42944                YLEFT(ICNT,2+K)=YRIGH1(I,K+2)
42945 1130         CONTINUE
42946              DO1135K=1,NCARR2
42947                YLEFT(ICNT,2+NCARR1+K)=YRIGH2(J,K+2)
42948 1135         CONTINUE
42949            ENDIF
42950 1120     CONTINUE
42951 1110   CONTINUE
42952        NINEW=ICNT
42953C
42954      ELSEIF(NMATCH.EQ.3)THEN
42955C
42956        ISTEPN='6C'
42957        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42958     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42959C
42960        ICNT=0
42961        DO1210I=1,NS1
42962          HOLD1=YRIGH1(I,1)
42963          HOLD2=YRIGH1(I,2)
42964          HOLD3=YRIGH1(I,3)
42965          DO1220J=1,NS2
42966            IF(YRIGH2(J,1).EQ.HOLD1 .AND. YRIGH2(J,2).EQ.HOLD2 .AND.
42967     1         YRIGH2(J,3).EQ.HOLD3)THEN
42968              ICNT=ICNT+1
42969              IF(ICNT.GT.MAXN)GOTO1910
42970              YLEFT(ICNT,1)=HOLD1
42971              YLEFT(ICNT,2)=HOLD2
42972              YLEFT(ICNT,3)=HOLD3
42973              DO1230K=1,NCARR1
42974                YLEFT(ICNT,3+K)=YRIGH1(I,K+3)
42975 1230         CONTINUE
42976              DO1235K=1,NCARR2
42977                YLEFT(ICNT,3+NCARR1+K)=YRIGH2(J,K+3)
42978 1235         CONTINUE
42979            ENDIF
42980 1220     CONTINUE
42981 1210   CONTINUE
42982        NINEW=ICNT
42983C
42984      ELSEIF(NMATCH.EQ.4)THEN
42985C
42986        ISTEPN='6D'
42987        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
42988     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
42989C
42990        ICNT=0
42991        DO1310I=1,NS1
42992          HOLD1=YRIGH1(I,1)
42993          HOLD2=YRIGH1(I,2)
42994          HOLD3=YRIGH1(I,3)
42995          HOLD4=YRIGH1(I,4)
42996          DO1320J=1,NS2
42997            IF(YRIGH2(J,1).EQ.HOLD1 .AND. YRIGH2(J,2).EQ.HOLD2 .AND.
42998     1         YRIGH2(J,3).EQ.HOLD3 .AND. YRIGH2(J,4).EQ.HOLD4)THEN
42999              ICNT=ICNT+1
43000              IF(ICNT.GT.MAXN)GOTO1910
43001              YLEFT(ICNT,1)=HOLD1
43002              YLEFT(ICNT,2)=HOLD2
43003              YLEFT(ICNT,3)=HOLD3
43004              YLEFT(ICNT,4)=HOLD4
43005              DO1330K=1,NCARR1
43006                YLEFT(ICNT,4+K)=YRIGH1(I,K+4)
43007 1330         CONTINUE
43008              DO1335K=1,NCARR2
43009                YLEFT(ICNT,4+NCARR1+K)=YRIGH2(J,K+4)
43010 1335         CONTINUE
43011            ENDIF
43012 1320     CONTINUE
43013 1310   CONTINUE
43014        NINEW=ICNT
43015C
43016      ELSE
43017        WRITE(ICOUT,999)
43018        CALL DPWRST('XXX','BUG ')
43019        WRITE(ICOUT,131)
43020        CALL DPWRST('XXX','BUG ')
43021        WRITE(ICOUT,1401)
43022 1401   FORMAT('      CURRENTLY A MAXIMUM OF FOUR MATCH VARIABLES')
43023        CALL DPWRST('XXX','BUG ')
43024        WRITE(ICOUT,1403)
43025 1403   FORMAT('      IS SUPPORTED.')
43026        CALL DPWRST('XXX','BUG ')
43027        IERROR='YES'
43028        GOTO9000
43029      ENDIF
43030C
43031      IF(ICNT.LE.0)THEN
43032        WRITE(ICOUT,999)
43033        CALL DPWRST('XXX','BUG ')
43034        WRITE(ICOUT,131)
43035        CALL DPWRST('XXX','BUG ')
43036        WRITE(ICOUT,1811)
43037 1811   FORMAT('      NO MATCHES WERE FOUND IN THE MERGE.')
43038        CALL DPWRST('XXX','BUG ')
43039        WRITE(ICOUT,1813)
43040 1813   FORMAT('      THE MERGE WILL NOT BE DONE.')
43041        CALL DPWRST('XXX','BUG ')
43042        IERROR='YES'
43043        GOTO9000
43044      ENDIF
43045C
43046      GOTO1999
43047C
43048 1910 CONTINUE
43049      WRITE(ICOUT,999)
43050      CALL DPWRST('XXX','BUG ')
43051      WRITE(ICOUT,131)
43052      CALL DPWRST('XXX','BUG ')
43053      WRITE(ICOUT,1911)
43054 1911 FORMAT('      THE MAXIMUM NUMBER OF ROWS (',I10,') HAS BEEN')
43055      CALL DPWRST('XXX','BUG ')
43056      WRITE(ICOUT,1913)
43057 1913 FORMAT('      EXCEEDED.  THE MERGE WILL NOT BE DONE.')
43058      CALL DPWRST('XXX','BUG ')
43059      IERROR='YES'
43060      GOTO9000
43061C
43062 1999 CONTINUE
43063      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
43064        WRITE(ICOUT,1901)
43065 1901   FORMAT('***** FROM DPMERG, AFTER FORMING LHS MATRIX')
43066        CALL DPWRST('XXX','BUG ')
43067        NOUT=NMATCH+NCARR1+NCARR2
43068        IF(IFLAGP.EQ.1)NOUT=NRIGHT
43069        IF(NOUT.GT.20)NOUT=20
43070        DO1900I=1,NINEW
43071          WRITE(ICOUT,1902)I,(YLEFT(I,J),J=1,NOUT)
43072 1902     FORMAT('I,YLEFT(I,...)=',I8,20G15.7)
43073          CALL DPWRST('XXX','BUG ')
43074 1900   CONTINUE
43075      ENDIF
43076C
43077C               ***************************************
43078C               **  STEP 7--                         **
43079C               **  UPDATE INTERNAL DATAPLOT TABLES  **
43080C               ***************************************
43081C
43082      ISTEPN='7'
43083      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')
43084     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43085C
43086C     LOOP THROUGH VARIABLES ON THE LEFT
43087C
43088      NTEMP=NMATCH + NCARR1 + NCARR2
43089      IF(IFLAGP.EQ.1)NTEMP=NRIGHT
43090      IROW1=1
43091      IROWN=NINEW
43092C
43093      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
43094        WRITE(ICOUT,7011)IFLAGP,NTEMP,IROW1,IROWN,NINEW
43095 7011   FORMAT('IFLAGP,NTEMP,IROW1,IROWN,NINEW = ',5I8)
43096        CALL DPWRST('XXX','BUG ')
43097      ENDIF
43098C
43099      DO7110I=1,NINEW
43100C
43101        DO7120J=1,NTEMP
43102          IJ=MAXN*(ICOLL(J)-1)+I
43103          IF(ICOLL(J).LE.MAXCOL)V(IJ)=YLEFT(I,J)
43104          IF(ICOLL(J).EQ.MAXCP1)PRED(I)=YLEFT(I,J)
43105          IF(ICOLL(J).EQ.MAXCP2)RES(I)=YLEFT(I,J)
43106          IF(ICOLL(J).EQ.MAXCP3)YPLOT(I)=YLEFT(I,J)
43107          IF(ICOLL(J).EQ.MAXCP4)XPLOT(I)=YLEFT(I,J)
43108          IF(ICOLL(J).EQ.MAXCP5)X2PLOT(I)=YLEFT(I,J)
43109          IF(ICOLL(J).EQ.MAXCP6)TAGPLO(I)=YLEFT(I,J)
43110 7120   CONTINUE
43111C
43112 7110 CONTINUE
43113C
43114       DO7130I=1,NTEMP
43115        IN(ILISL(I))=NINEW
43116 7130  CONTINUE
43117C
43118      ISTEPN='7B'
43119      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'MERG')
43120     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43121C
43122      DO8100I=1,NTEMP
43123        IHNAME(ILISL(I))=ILEFT(I)
43124        IHNAM2(ILISL(I))=ILEF2(I)
43125        IUSE(ILISL(I))='V'
43126        IVALUE(ILISL(I))=ICOLL(I)
43127        VALUE(ILISL(I))=ICOLL(I)
43128        IF(NEWNAM(I).EQ.'YES')THEN
43129          NUMNAM=NUMNAM+1
43130          NUMCOL=NUMCOL+1
43131        ENDIF
43132C
43133        IF(IPRINT.EQ.'ON' .AND. IFEEDB.EQ.'ON')THEN
43134          WRITE(ICOUT,999)
43135          CALL DPWRST('XXX','BUG ')
43136C
43137          WRITE(ICOUT,8111)ILEFT(I),ILEF2(I),NINEW
43138 8111     FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
43139     1           'THE VARIABLE ',A4,A4,' = ',I8)
43140          CALL DPWRST('XXX','BUG ')
43141          WRITE(ICOUT,999)
43142          CALL DPWRST('XXX','BUG ')
43143          IJ=MAXN*(ICOLL(I)-1)+IROW1
43144          IF(ICOLL(I).LE.MAXCOL)THEN
43145            WRITE(ICOUT,8121)ILEFT(I),ILEF2(I),V(IJ),IROW1
43146            CALL DPWRST('XXX','BUG ')
43147          ELSEIF(ICOLL(I).EQ.MAXCP1)THEN
43148            WRITE(ICOUT,8121)ILEFT(I),ILEF2(I),PRED(IROW1),IROW1
43149 8121       FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
43150     1             ' = ',G16.7,'   (ROW ',I6,')')
43151            CALL DPWRST('XXX','BUG ')
43152          ELSEIF(ICOLL(I).EQ.MAXCP2)THEN
43153            WRITE(ICOUT,8121)ILEFT(I),ILEF2(I),RES(IROW1),IROW1
43154            CALL DPWRST('XXX','BUG ')
43155          ELSEIF(ICOLL(I).EQ.MAXCP3)THEN
43156            WRITE(ICOUT,8121)ILEFT(I),ILEF2(I),YPLOT(IROW1),IROW1
43157            CALL DPWRST('XXX','BUG ')
43158          ELSEIF(ICOLL(I).EQ.MAXCP4)THEN
43159            WRITE(ICOUT,8121)ILEFT(I),ILEF2(I),XPLOT(IROW1),IROW1
43160            CALL DPWRST('XXX','BUG ')
43161          ELSEIF(ICOLL(I).EQ.MAXCP5)THEN
43162            WRITE(ICOUT,8121)ILEFT(I),ILEF2(I),X2PLOT(IROW1),IROW1
43163            CALL DPWRST('XXX','BUG ')
43164          ELSEIF(ICOLL(I).EQ.MAXCP6)THEN
43165            WRITE(ICOUT,8121)ILEFT(I),ILEF2(I),TAGPLO(IROW1),IROW1
43166            CALL DPWRST('XXX','BUG ')
43167          ENDIF
43168C
43169          IJ=MAXN*(ICOLL(I)-1)+IROWN
43170          IF(ICOLL(I).LE.MAXCOL.AND.NINEW.NE.1)THEN
43171            WRITE(ICOUT,8131)NINEW,ILEFT(I),ILEF2(I),V(IJ),IROWN
43172 8131       FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
43173     1             ' = ',G16.7,'   (ROW ',I6,')')
43174            CALL DPWRST('XXX','BUG ')
43175          ELSEIF(ICOLL(I).EQ.MAXCP1.AND.NINEW.NE.1)THEN
43176            WRITE(ICOUT,8131)NINEW,ILEFT(I),ILEF2(I),PRED(IROWN),IROWN
43177            CALL DPWRST('XXX','BUG ')
43178          ELSEIF(ICOLL(I).EQ.MAXCP2.AND.NINEW.NE.1)THEN
43179            WRITE(ICOUT,8131)NINEW,ILEFT(I),ILEF2(I),RES(IROWN),IROWN
43180            CALL DPWRST('XXX','BUG ')
43181          ELSEIF(ICOLL(I).EQ.MAXCP3.AND.NINEW.NE.1)THEN
43182            WRITE(ICOUT,8131)NINEW,ILEFT(I),ILEF2(I),YPLOT(IROWN),IROWN
43183            CALL DPWRST('XXX','BUG ')
43184          ELSEIF(ICOLL(I).EQ.MAXCP4.AND.NINEW.NE.1)THEN
43185            WRITE(ICOUT,8131)NINEW,ILEFT(I),ILEF2(I),XPLOT(IROWN),IROWN
43186            CALL DPWRST('XXX','BUG ')
43187          ELSEIF(ICOLL(I).EQ.MAXCP5.AND.NINEW.NE.1)THEN
43188            WRITE(ICOUT,8131)NINEW,ILEFT(I),ILEF2(I),X2PLOT(IROWN),IROWN
43189            CALL DPWRST('XXX','BUG ')
43190          ELSEIF(ICOLL(I).EQ.MAXCP6.AND.NINEW.NE.1)THEN
43191            WRITE(ICOUT,8131)NINEW,ILEFT(I),ILEF2(I),TAGPLO(IROWN),IROWN
43192            CALL DPWRST('XXX','BUG ')
43193          ENDIF
43194          IF(NINEW.EQ.1)THEN
43195            WRITE(ICOUT,8132)
43196 8132       FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
43197            CALL DPWRST('XXX','BUG ')
43198            WRITE(ICOUT,8133)
43199 8133       FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
43200            CALL DPWRST('XXX','BUG ')
43201          ENDIF
43202C
43203          WRITE(ICOUT,999)
43204          CALL DPWRST('XXX','BUG ')
43205        ENDIF
43206C
43207 8100 CONTINUE
43208C
43209C               *****************
43210C               **  STEP 90--  **
43211C               **  EXIT       **
43212C               *****************
43213C
43214 9000 CONTINUE
43215      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MERG')THEN
43216        WRITE(ICOUT,999)
43217        CALL DPWRST('XXX','BUG ')
43218        WRITE(ICOUT,9011)
43219 9011   FORMAT('***** AT THE END       OF DPMERG--')
43220        CALL DPWRST('XXX','BUG ')
43221      ENDIF
43222C
43223      RETURN
43224      END
43225      SUBROUTINE DPMESS(IBUGS2,ISUBRO,IFOUND,IERROR)
43226C
43227C     PURPOSE--GENERATE DATAPLOT MESSAGES
43228C              FOR THE ANALYST'S PERUSAL UPON
43229C              SIGNING ON TO DATAPLOT.
43230C     WRITTEN BY--JAMES J. FILLIBEN
43231C                 STATISTICAL ENGINEERING DIVISION
43232C                 INFORMATION TECHNOLOGY LABORATORY
43233C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
43234C                 GAITHERSBURG, MD 20899-8980
43235C                 PHONE--301-975-2855
43236C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
43237C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
43238C     LANGUAGE--ANSI FORTRAN (1977)
43239C     VERSION NUMBER--86/1
43240C     ORIGINAL VERSION--DECEMBER  1977.
43241C     UPDATED         --JANUARY   1979.
43242C     UPDATED         --NOVEMBER  1980.
43243C     UPDATED         --JUNE      1981.
43244C     UPDATED         --NOVEMBER  1981.
43245C     UPDATED         --MAY       1982.
43246C     UPDATED         --DECEMBER  1985.
43247C
43248C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
43249C
43250      CHARACTER*4 IBUGS2
43251      CHARACTER*4 ISUBRO
43252      CHARACTER*4 IFOUND
43253      CHARACTER*4 IERROR
43254C
43255      INCLUDE 'DPCOPA.INC'
43256C
43257CCCCC CHARACTER*80 IFILE
43258      CHARACTER (LEN=MAXFNC) :: IFILE
43259      CHARACTER*12 ISTAT
43260      CHARACTER*12 IFORM
43261      CHARACTER*12 IACCES
43262      CHARACTER*12 IPROT
43263      CHARACTER*12 ICURST
43264      CHARACTER*4 IENDFI
43265      CHARACTER*4 IREWIN
43266      CHARACTER*4 ISUBN0
43267      CHARACTER*4 IERRFI
43268C
43269      CHARACTER*4 ISUBN1
43270      CHARACTER*4 ISUBN2
43271      CHARACTER*4 ISTEPN
43272C
43273      CHARACTER*80 ISTRIN
43274C
43275C-----COMMON----------------------------------------------------------
43276C
43277      INCLUDE 'DPCOF2.INC'
43278      INCLUDE 'DPCOP2.INC'
43279C
43280C-----START POINT-----------------------------------------------------
43281C
43282      ISUBN1='DPME'
43283      ISUBN2='SS  '
43284      IFOUND='YES'
43285      IERROR='NO'
43286C
43287      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')THEN
43288        WRITE(ICOUT,999)
43289  999   FORMAT(1X)
43290        CALL DPWRST('XXX','BUG ')
43291        WRITE(ICOUT,51)
43292   51   FORMAT('***** AT THE BEGINNING OF DPMESS--')
43293        CALL DPWRST('XXX','BUG ')
43294        WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR,IMESNU
43295   53   FORMAT('IBUGS2,ISUBRO,IERROR,IMESNU = ',3(A4,2X),I8)
43296        CALL DPWRST('XXX','BUG ')
43297        WRITE(ICOUT,62)IMESNA
43298   62   FORMAT('IMESNA = ',A80)
43299        CALL DPWRST('XXX','BUG ')
43300        WRITE(ICOUT,63)IMESST,IMESFO,IMESAC,IMESFO,IMESCS
43301   63   FORMAT('IMESST,IMESFO,IMESAC,IMESFO,IMESCS = ',4(A12,2X),A12)
43302        CALL DPWRST('XXX','BUG ')
43303      ENDIF
43304C
43305C               **************************
43306C               **  STEP 11--           **
43307C               **  COPY OVER VARIABLES **
43308C               **************************
43309C
43310      ISTEPN='11'
43311      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
43312     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43313C
43314      IOUNIT=IMESNU
43315      IFILE=IMESNA
43316      ISTAT=IMESST
43317      IFORM=IMESFO
43318      IACCES=IMESAC
43319      IPROT=IMESPR
43320      ICURST=IMESCS
43321C
43322      ISUBN0='MESS'
43323      IERRFI='NO'
43324C
43325      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')THEN
43326        WRITE(ICOUT,1193)ISUBN0,IERRFI,IOUNIT
43327 1193   FORMAT('ISUBN0,IERRFI,IOUNIT = ',2(A4,2X),I8)
43328        CALL DPWRST('XXX','BUG ')
43329        WRITE(ICOUT,1194)IFILE(1:80)
43330 1194   FORMAT('IFILE = ',A80)
43331        CALL DPWRST('XXX','BUG ')
43332        WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
43333 1195   FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',4(A12,2X),A12)
43334        CALL DPWRST('XXX','BUG ')
43335      ENDIF
43336C
43337C               *******************************************
43338C               **  STEP 12--                            **
43339C               **  CHECK TO SEE IF MESSAGE FILE EXISTS  **
43340C               *******************************************
43341C
43342      ISTEPN='12'
43343      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
43344     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43345C
43346      IF(ISTAT.EQ.'NONE')GOTO9000
43347C
43348C               *********************
43349C               **  STEP 31--      **
43350C               **  OPEN THE FILE  **
43351C               *********************
43352C
43353      ISTEPN='31'
43354      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
43355     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43356C
43357      IREWIN='ON'
43358      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
43359     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
43360      IF(IERRFI.EQ.'YES')GOTO9000
43361C
43362C               ******************************
43363C               **  STEP 41--               **
43364C               **  READ THE FILE.          **
43365C               **  WRITE OUT THE MESSAGES. **
43366C               ******************************
43367C
43368      ISTEPN='41'
43369      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
43370     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43371C
43372      ANUMLI=0.0
43373      READ(IOUNIT,4111,END=4190)ANUMLI
43374 4111 FORMAT(F10.0)
43375      NUMLIN=INT(ANUMLI+0.5)
43376C
43377      IF(NUMLIN.GE.1)THEN
43378        NMAX=80
43379        DO4120I=1,NUMLIN
43380          READ(IOUNIT,4121,END=4190)(ISTRIN(J:J),J=1,80)
43381 4121     FORMAT(80A1)
43382          CALL DPDB80(ISTRIN,JMAX,NMAX,IBUGS2,ISUBRO,IERROR)
43383          IF(JMAX.GE.1)THEN
43384            WRITE(ICOUT,4122)(ISTRIN(J:J),J=1,JMAX)
43385 4122       FORMAT(5X,80A1)
43386            CALL DPWRST('XXX','BUG ')
43387          ELSE
43388            WRITE(ICOUT,999)
43389            CALL DPWRST('XXX','BUG ')
43390          ENDIF
43391 4120   CONTINUE
43392      ENDIF
43393C
43394 4190 CONTINUE
43395C
43396C               ***********************
43397C               **  STEP 51--        **
43398C               **  CLOSE THE FILE.  **
43399C               ***********************
43400C
43401      ISTEPN='51'
43402      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
43403     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43404C
43405      IENDFI='OFF'
43406      IREWIN='ON'
43407      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
43408     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
43409C
43410C               ****************
43411C               **  STEP 90-- **
43412C               **  EXIT.     **
43413C               ****************
43414C
43415 9000 CONTINUE
43416      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')THEN
43417        WRITE(ICOUT,999)
43418        CALL DPWRST('XXX','BUG ')
43419        WRITE(ICOUT,9011)
43420 9011   FORMAT('***** AT THE END       OF DPMESS--')
43421        CALL DPWRST('XXX','BUG ')
43422        WRITE(ICOUT,9028)IENDFI,IREWIN,IERRFI,JMAX
43423 9028   FORMAT('IENDFI,IREWIN,IERRFI,JMAX = ',2(A4,2X),A12,2X,I8)
43424        CALL DPWRST('XXX','BUG ')
43425        IF(JMAX.GE.1)THEN
43426          WRITE(ICOUT,9042)(ISTRIN(J:J),J=1,JMAX)
43427 9042     FORMAT('ISTRIN--',80A1)
43428          CALL DPWRST('XXX','BUG ')
43429        ENDIF
43430      ENDIF
43431C
43432      RETURN
43433      END
43434      SUBROUTINE DPMETE(MAXNXT,ICAPSW,IFORSW,
43435     1                  ISUBRO,IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
43436C
43437C     PURPOSE--CARRY OUT NONPARAMETRIC MEDIAN TEST TO TEST FOR
43438C              EQUAL MEDIANS AMONG K GROUPS.
43439C     EXAMPLE--MEDIAN TEST Y X
43440C              MEDIAN TEST Y1 Y2 Y3
43441C              MEDIAN TEST Y1 TO YK
43442C     REFERENCE--CONOVER (1999), "PRACTICAL NONPARAMETRIC STATISTICS",
43443C                THIRD EDITION, WILEY, PP. 218-224.
43444C     WRITTEN BY--ALAN HECKERT
43445C                 STATISTICAL ENGINEERING DIVISION
43446C                 INFORMATION TECHNOLOGY LABORATORY
43447C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
43448C                 GAITHERSBURG, MD 20899-8980
43449C                 PHONE--301-975-2899
43450C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
43451C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
43452C     LANGUAGE--ANSI FORTRAN (1977)
43453C     VERSION NUMBER--2011/6
43454C     ORIGINAL VERSION--JUNE      2011.
43455C
43456C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
43457C
43458      CHARACTER*4 ICAPSW
43459      CHARACTER*4 IFORSW
43460      CHARACTER*4 ISUBRO
43461      CHARACTER*4 IBUGA2
43462      CHARACTER*4 IBUGA3
43463      CHARACTER*4 IBUGQ
43464      CHARACTER*4 IFOUND
43465      CHARACTER*4 IERROR
43466C
43467      CHARACTER*4 IMULT
43468      CHARACTER*4 ICASAN
43469      CHARACTER*4 ICASA2
43470      CHARACTER*4 ICASE
43471      CHARACTER*4 ISUBN1
43472      CHARACTER*4 ISUBN2
43473      CHARACTER*4 ISTEPN
43474      CHARACTER*4 ICTMP1
43475      CHARACTER*4 ICTMP2
43476      CHARACTER*4 ICTMP3
43477      CHARACTER*4 IFLAGU
43478      LOGICAL IFRST
43479      LOGICAL ILAST
43480C
43481      CHARACTER*40 INAME
43482      PARAMETER (MAXSPN=30)
43483      CHARACTER*4 IVARN1(MAXSPN)
43484      CHARACTER*4 IVARN2(MAXSPN)
43485      CHARACTER*4 IVARTY(MAXSPN)
43486      REAL PVAR(MAXSPN)
43487      INTEGER ILIS(MAXSPN)
43488      INTEGER NRIGHT(MAXSPN)
43489      INTEGER ICOLR(MAXSPN)
43490C
43491C---------------------------------------------------------------------
43492C
43493C-----COMMON----------------------------------------------------------
43494C
43495      INCLUDE 'DPCOPA.INC'
43496      INCLUDE 'DPCOZZ.INC'
43497      INCLUDE 'DPCOZD.INC'
43498C
43499      DIMENSION TEMP1(MAXOBV)
43500      DIMENSION TEMP2(MAXOBV)
43501      DIMENSION TEMP3(MAXOBV)
43502      DIMENSION TEMP4(MAXOBV)
43503      DOUBLE PRECISION DTEMP1(MAXOBV)
43504      DOUBLE PRECISION DTEMP2(MAXOBV)
43505C
43506      EQUIVALENCE(GARBAG(IGARB1),TEMP1(1))
43507      EQUIVALENCE(GARBAG(IGARB2),TEMP2(1))
43508      EQUIVALENCE(GARBAG(IGARB3),TEMP3(1))
43509      EQUIVALENCE(GARBAG(IGARB4),TEMP4(1))
43510      EQUIVALENCE(DGARBG(IDGAR1),DTEMP1(1))
43511      EQUIVALENCE(DGARBG(IDGAR2),DTEMP2(1))
43512C
43513C-----COMMON VARIABLES (GENERAL)--------------------------------------
43514C
43515      INCLUDE 'DPCOHK.INC'
43516      INCLUDE 'DPCOSU.INC'
43517      INCLUDE 'DPCODA.INC'
43518      INCLUDE 'DPCOST.INC'
43519      INCLUDE 'DPCOP2.INC'
43520C
43521C-----START POINT-----------------------------------------------------
43522C
43523      ISUBN1='DPME'
43524      ISUBN2='TE  '
43525      IFOUND='YES'
43526      IERROR='NO'
43527C
43528      MAXCP1=MAXCOL+1
43529      MAXCP2=MAXCOL+2
43530      MAXCP3=MAXCOL+3
43531      MAXCP4=MAXCOL+4
43532      MAXCP5=MAXCOL+5
43533      MAXCP6=MAXCOL+6
43534C
43535C               ******************************************
43536C               **  TREAT THE SQUARED RANKS TEST CASE  **
43537C               ******************************************
43538C
43539      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'METE')THEN
43540        WRITE(ICOUT,999)
43541  999   FORMAT(1X)
43542        CALL DPWRST('XXX','BUG ')
43543        WRITE(ICOUT,51)
43544   51   FORMAT('***** AT THE BEGINNING OF DPMETE--')
43545        CALL DPWRST('XXX','BUG ')
43546        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ,ISUBRO
43547   52   FORMAT('IBUGA2,IBUGA3,IBUGQ,ISUBRO = ',3(A4,2X),A4)
43548        CALL DPWRST('XXX','BUG ')
43549        WRITE(ICOUT,55)IMULT,IKRUGS,MAXNXT
43550   55   FORMAT('IMULT,IKRUGS,MAXNXT = ',2(A4,2X),I8)
43551        CALL DPWRST('XXX','BUG ')
43552      ENDIF
43553C
43554C               *********************************************************
43555C               **  STEP 1--                                           **
43556C               **  EXTRACT THE COMMAND                                **
43557C               *********************************************************
43558C
43559      ISTEPN='1'
43560      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')
43561     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43562C
43563      ILASTZ=9999
43564      ICASAN='METE'
43565      IMULT='OFF'
43566C
43567C     LOOK FOR:
43568C
43569C          MEDIAN TEST
43570C          MULTIPLE
43571C
43572      DO100I=0,NUMARG-1
43573C
43574        IF(I.EQ.0)THEN
43575          ICTMP1=ICOM
43576        ELSE
43577          ICTMP1=IHARG(I)
43578        ENDIF
43579        ICTMP2=IHARG(I+1)
43580        ICTMP3=IHARG(I+2)
43581C
43582        IF(ICTMP1.EQ.'=')THEN
43583          IFOUND='NO'
43584          GOTO9000
43585        ELSEIF(ICTMP1.EQ.'MEDI' .AND. ICTMP2.EQ.'TEST')THEN
43586          IFOUND='YES'
43587          ICASAN='METE'
43588          ILASTZ=I+1
43589        ELSEIF(ICTMP1.EQ.'MULT')THEN
43590          IMULT='ON'
43591          ILASTZ=MAX(ILASTZ,I+1)
43592        ENDIF
43593  100 CONTINUE
43594C
43595      IF(IFOUND.EQ.'NO')GOTO9000
43596C
43597      ISHIFT=ILASTZ
43598      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
43599     1            IBUGA2,IERROR)
43600C
43601      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')THEN
43602        WRITE(ICOUT,91)ICASAN,ICASA2,IMULT,ISHIFT
43603   91   FORMAT('DPMETE: ICASAN,ICASA2,IMULT,ISHIFT = ',
43604     1         3(A4,2X),I5)
43605        CALL DPWRST('XXX','BUG ')
43606      ENDIF
43607C
43608C               *********************************
43609C               **  STEP 2--                   **
43610C               **  EXTRACT THE VARIABLE LIST  **
43611C               *********************************
43612C
43613      ISTEPN='2'
43614      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')
43615     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43616C
43617      INAME='MEDIAN TEST'
43618      MAXNA=100
43619      MINNVA=2
43620      MAXNVA=MAXSPN
43621      MINNA=1
43622      IFLAGE=1
43623      IFLAGM=0
43624      IF(IMULT.EQ.'ON')THEN
43625        IFLAGE=0
43626        IFLAGM=1
43627        MAXNVA=MAXSPN
43628      ENDIF
43629      MINN2=2
43630      IFLAGP=0
43631      JMIN=1
43632      JMAX=NUMARG
43633C
43634      CALL DPPARS(IHARG,IHARG2,IARGT,ARG,NUMARG,IANS,IWIDTH,
43635     1            IHNAME,IHNAM2,IUSE,NUMNAM,IN,IVALUE,VALUE,
43636     1            JMIN,JMAX,
43637     1            MINN2,MINNA,MAXNA,MAXSPN,IFLAGE,INAME,
43638     1            IVARN1,IVARN2,IVARTY,PVAR,
43639     1            ILIS,NRIGHT,ICOLR,ISUB,NQ,ILOCQ,NUMVAR,
43640     1            MINNVA,MAXNVA,
43641     1            IFLAGM,IFLAGP,
43642     1            IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
43643      IF(IERROR.EQ.'YES')GOTO9000
43644C
43645      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')THEN
43646        WRITE(ICOUT,999)
43647        CALL DPWRST('XXX','BUG ')
43648        WRITE(ICOUT,181)
43649  181   FORMAT('***** AFTER CALL DPPARS--')
43650        CALL DPWRST('XXX','BUG ')
43651        WRITE(ICOUT,182)NQ,NUMVAR,IMULT
43652  182   FORMAT('NQ,NUMVAR,IMULT = ',2I8,2X,A4)
43653        CALL DPWRST('XXX','BUG ')
43654        IF(NUMVAR.GT.0)THEN
43655          DO185I=1,NUMVAR
43656            WRITE(ICOUT,187)I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),
43657     1                      ICOLR(I)
43658  187       FORMAT('I,IVARN1(I),IVARN2(I),ILIS(I),NRIGHT(I),',
43659     1             'ICOLR(I) = ',I8,2X,A4,A4,2X,3I8)
43660            CALL DPWRST('XXX','BUG ')
43661  185     CONTINUE
43662        ENDIF
43663      ENDIF
43664C
43665C               *******************************************************
43666C               **  STEP 3--                                         **
43667C               **  GENERATE THE MEDIAN         TEST FOR THE VARIOUS **
43668C               **  CASES                                            **
43669C               *******************************************************
43670C
43671      ISTEPN='3'
43672      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')
43673     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43674C
43675C               *****************************************
43676C               **  STEP 3A--                          **
43677C               **  CASE 1: TWO RESPONSE VARIABLES     **
43678C               **          WITH NO REPLICATION        **
43679C               *****************************************
43680C
43681      IF(IMULT.EQ.'OFF')THEN
43682        ISTEPN='3A'
43683        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')
43684     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43685C
43686        ICOL=1
43687        NUMVA2=2
43688        CALL DPPAR3(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
43689     1              INAME,IVARN1,IVARN2,IVARTY,
43690     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
43691     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
43692     1              MAXCP4,MAXCP5,MAXCP6,
43693     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
43694     1              Y,X,X,NLOCAL,NLOCA2,NLOCA2,ICASE,
43695     1              IBUGA3,ISUBRO,IFOUND,IERROR)
43696        IF(IERROR.EQ.'YES')GOTO9000
43697C
43698C
43699C               ******************************************************
43700C               **  STEP 3B--
43701C               **  PREPARE FOR ENTRANCE INTO DPMET2--
43702C               ******************************************************
43703C
43704        ISTEPN='3B'
43705        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')THEN
43706          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43707          WRITE(ICOUT,999)
43708          CALL DPWRST('XXX','BUG ')
43709          WRITE(ICOUT,331)
43710  331     FORMAT('***** FROM DPMETE, AS WE ARE ABOUT TO CALL DPMET2--')
43711          CALL DPWRST('XXX','BUG ')
43712          WRITE(ICOUT,332)NLOCAL
43713  332     FORMAT('NLOCAL = ',I8)
43714          CALL DPWRST('XXX','BUG ')
43715          DO335I=1,NLOCAL
43716            WRITE(ICOUT,336)I,Y(I),X(I)
43717  336       FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
43718            CALL DPWRST('XXX','BUG ')
43719  335     CONTINUE
43720        ENDIF
43721C
43722        CALL DPMET2(Y,X,NLOCAL,IVARN1,IVARN2,ICASA2,
43723     1              PMTEQU,IQUAME,MAXNXT,
43724     1              TEMP1,TEMP2,TEMP3,
43725     1              STATVA,STATCD,PVAL,IDF,NDIST,
43726     1              CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,
43727     1              CUT99,CUT999,
43728     1              ICAPSW,ICAPTY,IFORSW,IMULT,
43729     1              ISUBRO,IBUGA3,IERROR)
43730C
43731C               ***************************************
43732C               **  STEP 8C--                        **
43733C               **  UPDATE INTERNAL DATAPLOT TABLES  **
43734C               ***************************************
43735C
43736          ISTEPN='8C'
43737          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')
43738     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43739C
43740          IFLAGU='ON'
43741          IFRST=.TRUE.
43742          ILAST=.TRUE.
43743          CALL DPFRT5(STATVA,STATCD,PVAL,
43744     1                CUT0,CUT50,CUT75,CUT90,CUT95,
43745     1                CUT975,CUT99,CUT999,
43746     1                IFLAGU,IFRST,ILAST,
43747     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
43748C
43749C               *******************************************************
43750C               **  STEP 4A--                                        **
43751C               **  CASE 2: MULTIPLE RESPONSE VARIABLES.  NOTE THAT  **
43752C               **          FOR MEDIAN TEST, THE MULTIPLE LABS ARE   **
43753C               **          CONVERTED INTO A "Y X" STACKED PAIR      **
43754C               **          WHERE "X" IS THE LAB-ID VARIABLE.        **
43755C               *******************************************************
43756C
43757      ELSEIF(IMULT.EQ.'ON')THEN
43758        ISTEPN='4A'
43759        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')
43760     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43761C
43762        ICOL=1
43763        NUMVA2=NUMVAR
43764        CALL DPPAR8(ICOL,IVALUE,IVALU2,IN,MAXN,MAXOBV,
43765     1              INAME,IVARN1,IVARN2,IVARTY,
43766     1              ILIS,NRIGHT,ICOLR,ISUB,NQ,NUMVA2,
43767     1              MAXCOL,MAXCP1,MAXCP2,MAXCP3,
43768     1              MAXCP4,MAXCP5,MAXCP6,
43769     1              V,PRED,RES,YPLOT,XPLOT,X2PLOT,TAGPLO,
43770     1              TEMP1,Y,X,NLOCAL,ICASE,
43771     1              IBUGA3,ISUBRO,IFOUND,IERROR)
43772        NUMVAR=2
43773        IF(IERROR.EQ.'YES')GOTO9000
43774C
43775        IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'METE')THEN
43776          ISTEPN='4B'
43777          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43778          WRITE(ICOUT,999)
43779          CALL DPWRST('XXX','BUG ')
43780          WRITE(ICOUT,442)
43781  442     FORMAT('***** FROM THE MIDDLE  OF DPMETE--')
43782          CALL DPWRST('XXX','BUG ')
43783          WRITE(ICOUT,443)ICASAN,NUMVAR,NLOCAL
43784  443     FORMAT('ICASAN,NUMVAR,NLOCAL = ',A4,2I8)
43785          CALL DPWRST('XXX','BUG ')
43786          IF(NLOCAL.GE.1)THEN
43787            DO445I=1,NLOCAL
43788              WRITE(ICOUT,446)I,Y(I),X(I)
43789  446         FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
43790              CALL DPWRST('XXX','BUG ')
43791  445       CONTINUE
43792          ENDIF
43793        ENDIF
43794C
43795        CALL DPMET2(Y,X,NLOCAL,IVARN1,IVARN2,ICASA2,
43796     1              PMTEQU,IQUAME,MAXNXT,
43797     1              TEMP1,TEMP2,TEMP3,
43798     1              STATVA,STATCD,PVAL,IDF,NDIST,
43799     1              CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,
43800     1              CUT99,CUT999,
43801     1              ICAPSW,ICAPTY,IFORSW,IMULT,
43802     1              ISUBRO,IBUGA3,IERROR)
43803C
43804C         ***************************************
43805C         **  STEP 8C--                        **
43806C         **  UPDATE INTERNAL DATAPLOT TABLES  **
43807C         ***************************************
43808C
43809          ISTEPN='8C'
43810          IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'METE')
43811     1      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43812C
43813          IFLAGU='ON'
43814          IFRST=.TRUE.
43815          ILAST=.TRUE.
43816          CALL DPFRT5(STATVA,STATCD,PVAL,
43817     1                CUT0,CUT50,CUT75,CUT90,CUT95,
43818     1                CUT975,CUT99,CUT999,
43819     1                IFLAGU,IFRST,ILAST,
43820     1                IBUGA2,IBUGA3,ISUBRO,IERROR)
43821C
43822      ENDIF
43823C
43824C               *****************
43825C               **  STEP 90--  **
43826C               **  EXIT       **
43827C               *****************
43828C
43829 9000 CONTINUE
43830      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'METE')THEN
43831        WRITE(ICOUT,999)
43832        CALL DPWRST('XXX','BUG ')
43833        WRITE(ICOUT,9011)
43834 9011   FORMAT('***** AT THE END       OF DPMETE--')
43835        CALL DPWRST('XXX','BUG ')
43836        WRITE(ICOUT,9014)NLOCAL,STATVA,STATCD,PVAL
43837 9014   FORMAT('NLOCAL,STATVA,STATCD,PVAL = ',I8,3G15.7)
43838        CALL DPWRST('XXX','BUG ')
43839        WRITE(ICOUT,9016)IFOUND,IERROR
43840 9016   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
43841        CALL DPWRST('XXX','BUG ')
43842      ENDIF
43843C
43844      RETURN
43845      END
43846      SUBROUTINE DPMET2(Y,TAG,N,IVARID,IVARI2,ICASAN,
43847     1                  PMTEQU,IQUAME,MAXNXT,
43848     1                  TEMP1,TEMP2,XIDTEM,
43849     1                  STATVA,STATCD,PVAL,IDF,NDIST,
43850     1                  CUT0,CUT50,CUT75,CUT90,CUT95,CUT975,
43851     1                  CUT99,CUT999,
43852     1                  ICAPSW,ICAPTY,IFORSW,IMULT,
43853     1                  ISUBRO,IBUGA3,IERROR)
43854C
43855C     PURPOSE--THIS ROUTINE CARRIES OUT A NONPARAMETRIC MEDIAN
43856C              TEST FOR EQUAL MEDIANS
43857C     EXAMPLE--MEDIAN TEST Y TAG
43858C     REFERENCE--W. J. CONOVER, "PRACTICAL NONPARAMETRIC
43859C                STATISTICS", THIRD EDITION, 1999, WILEY,
43860C                PP. 218-224.
43861C     WRITTEN BY--ALAN HECKERT
43862C                 STATISTICAL ENGINEERING DIVISION
43863C                 INFORMATION TECHNOLOGY LABORATORY
43864C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
43865C                 GAITHERSBURG, MD 20899-8980
43866C                 PHONE--301-975-2899
43867C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
43868C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
43869C     LANGUAGE--ANSI FORTRAN (1977)
43870C     VERSION NUMBER--2011/6
43871C     ORIGINAL VERSION--JUNE      2011.
43872C
43873C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
43874C
43875      CHARACTER*4 ICASAN
43876      CHARACTER*4 IQUAME
43877      CHARACTER*4 ICAPSW
43878      CHARACTER*4 ICAPTY
43879      CHARACTER*4 IFORSW
43880      CHARACTER*4 IMULT
43881      CHARACTER*4 ISUBRO
43882      CHARACTER*4 IBUGA3
43883      CHARACTER*4 IERROR
43884      CHARACTER*4 IVARID(*)
43885      CHARACTER*4 IVARI2(*)
43886C
43887      CHARACTER*4 IWRITE
43888      CHARACTER*4 ISUBN0
43889      CHARACTER*4 ISUBN1
43890      CHARACTER*4 ISUBN2
43891      CHARACTER*4 ISTEPN
43892      CHARACTER*4 IOP
43893C
43894C---------------------------------------------------------------------
43895C
43896      DIMENSION Y(*)
43897      DIMENSION TAG(*)
43898      DIMENSION TEMP1(*)
43899      DIMENSION TEMP2(*)
43900      DIMENSION XIDTEM(*)
43901C
43902C---------------------------------------------------------------------
43903C
43904      PARAMETER (NUMALP=8)
43905      REAL ALPHA(NUMALP)
43906C
43907      PARAMETER(NUMCLI=4)
43908      PARAMETER(MAXLIN=3)
43909      PARAMETER (MAXROW=30)
43910      CHARACTER*60 ITITLE
43911      CHARACTER*60 ITITLZ
43912      CHARACTER*60 ITITL9
43913      CHARACTER*60 ITEXT(MAXROW)
43914      CHARACTER*4  ALIGN(NUMCLI)
43915      CHARACTER*4  VALIGN(NUMCLI)
43916      REAL         AVALUE(MAXROW)
43917      INTEGER      NCTEXT(MAXROW)
43918      INTEGER      IDIGIT(MAXROW)
43919      INTEGER      NTOT(MAXROW)
43920      CHARACTER*60 ITITL2(MAXLIN,NUMCLI)
43921      CHARACTER*15 IVALUE(MAXROW,NUMCLI)
43922      CHARACTER*4  ITYPCO(NUMCLI)
43923      INTEGER      NCTIT2(MAXLIN,NUMCLI)
43924      INTEGER      NCVALU(MAXROW,NUMCLI)
43925      INTEGER      IWHTML(NUMCLI)
43926      INTEGER      IWRTF(NUMCLI)
43927      REAL         AMAT(MAXROW,NUMCLI)
43928      LOGICAL IFRST
43929      LOGICAL ILAST
43930      LOGICAL IFLAGS
43931      LOGICAL IFLAGE
43932C
43933      INCLUDE 'DPCOP2.INC'
43934C
43935C-----START POINT-----------------------------------------------------
43936C
43937      DATA ALPHA/
43938     1 0.0, 50.0, 75.0, 90.0, 95.0, 97.5, 99.0, 99.9/
43939C
43940      ISUBN1='DPME'
43941      ISUBN2='T2  '
43942      ISUBN0='    '
43943      IWRITE='OFF'
43944      IERROR='NO'
43945C
43946      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MET2')THEN
43947        WRITE(ICOUT,999)
43948  999   FORMAT(1X)
43949        CALL DPWRST('XXX','WRIT')
43950        WRITE(ICOUT,51)
43951   51   FORMAT('**** AT THE BEGINNING OF DPMET2--')
43952        CALL DPWRST('XXX','WRIT')
43953        WRITE(ICOUT,52)IBUGA3,ISUBRO,ICASAN,N
43954   52   FORMAT('IBUGA3,ISUBRO,ICASAN,N = ',3(A4,2X),I8)
43955        CALL DPWRST('XXX','WRIT')
43956        DO56I=1,N
43957          WRITE(ICOUT,57)I,Y(I),TAG(I)
43958   57     FORMAT('I,Y(I),TAG(I) = ',I8,2G15.7)
43959          CALL DPWRST('XXX','WRIT')
43960   56   CONTINUE
43961      ENDIF
43962C
43963C               ****************************************************
43964C               **  STEP 1--                                      **
43965C               **  CARRY OUT CALCULATIONS FOR MEDIAN       TEST  **
43966C               **  (COMPUTATIONS PERFORMED IN DPMET3)            **
43967C               ****************************************************
43968C
43969      ISTEPN='1'
43970      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET2')
43971     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
43972C
43973      NSAVE=N
43974      CALL DPMET3(Y,TAG,N,
43975     1            TEMP1,TEMP2,XIDTEM,PMTEQU,IQUAME,MAXNXT,
43976     1            XMED,XA,XB,IDF,NDIST,
43977     1            STATVA,STATCD,PVAL,
43978     1            IBUGA3,ISUBRO,IERROR)
43979C
43980      CUT0=0.0
43981      CALL CHSPPF(.50,IDF,CUT50)
43982      CALL CHSPPF(.75,IDF,CUT75)
43983      CALL CHSPPF(.90,IDF,CUT90)
43984      CALL CHSPPF(.95,IDF,CUT95)
43985      CALL CHSPPF(.975,IDF,CUT975)
43986      CALL CHSPPF(.99,IDF,CUT99)
43987      CALL CHSPPF(.999,IDF,CUT999)
43988C
43989      IOP='OPEN'
43990      IFLG1=1
43991      IFLG2=0
43992      IFLG3=0
43993      IFLG4=0
43994      IFLG5=0
43995      CALL DPAUFI(IOP,IFLG1,IFLG2,IFLG3,IFLG4,IFLG5,
43996     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
43997     1            IBUGA3,ISUBRO,IERROR)
43998      IF(IERROR.EQ.'YES')GOTO9000
43999C
44000      WRITE(IOUNI1,2301)
44001 2301 FORMAT('   GROUP    OBS. ABOVE     OBS. TOTAL')
44002      DO2310I=1,NDIST
44003        WRITE(IOUNI1,2305)I,TEMP1(I),TEMP2(I)
44004 2305   FORMAT(I8,2E15.7)
44005 2310 CONTINUE
44006C
44007      IOP='CLOS'
44008      CALL DPAUFI(IOP,IFLG1,IFLG2,IFLG3,IFLG4,IFLG5,
44009     1            IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5,
44010     1            IBUGA3,ISUBRO,IERROR)
44011      IF(IERROR.EQ.'YES')GOTO9000
44012C
44013C               ********************************
44014C               **   STEP 42--                **
44015C               **   WRITE OUT EVERYTHING     **
44016C               **   FOR MEDIAN        TEST   **
44017C               ********************************
44018C
44019      ISTEPN='42'
44020      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET2')
44021     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44022C
44023      IF(IPRINT.EQ.'OFF')GOTO9000
44024C
44025      NUMDIG=7
44026      IF(IFORSW.EQ.'1')NUMDIG=1
44027      IF(IFORSW.EQ.'2')NUMDIG=2
44028      IF(IFORSW.EQ.'3')NUMDIG=3
44029      IF(IFORSW.EQ.'4')NUMDIG=4
44030      IF(IFORSW.EQ.'5')NUMDIG=5
44031      IF(IFORSW.EQ.'6')NUMDIG=6
44032      IF(IFORSW.EQ.'7')NUMDIG=7
44033      IF(IFORSW.EQ.'8')NUMDIG=8
44034      IF(IFORSW.EQ.'9')NUMDIG=9
44035      IF(IFORSW.EQ.'0')NUMDIG=0
44036      IF(IFORSW.EQ.'E')NUMDIG=-2
44037      IF(IFORSW.EQ.'-2')NUMDIG=-2
44038      IF(IFORSW.EQ.'-3')NUMDIG=-3
44039      IF(IFORSW.EQ.'-4')NUMDIG=-4
44040      IF(IFORSW.EQ.'-5')NUMDIG=-5
44041      IF(IFORSW.EQ.'-6')NUMDIG=-6
44042      IF(IFORSW.EQ.'-7')NUMDIG=-7
44043      IF(IFORSW.EQ.'-8')NUMDIG=-8
44044      IF(IFORSW.EQ.'-9')NUMDIG=-9
44045C
44046      ITITLE='Median Test'
44047      NCTITL=11
44048      ITITLZ=' '
44049      NCTITZ=0
44050      IF(PMTEQU.NE.0.5)THEN
44051        ITITLE='Median Test for User Specified Quantile'
44052         NCTITL=39
44053        ITITLZ=' '
44054        NCTITZ=0
44055      ENDIF
44056C
44057      ICNT=1
44058      ITEXT(ICNT)=' '
44059      NCTEXT(ICNT)=0
44060      AVALUE(ICNT)=0.0
44061      IDIGIT(ICNT)=-1
44062      IF(IMULT.EQ.'OFF')THEN
44063        ICNT=ICNT+1
44064        ITEXT(ICNT)='Response Variable: '
44065        WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(1)(1:4)
44066        WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(1)(1:4)
44067        NCTEXT(ICNT)=27
44068        AVALUE(ICNT)=0.0
44069        IDIGIT(ICNT)=-1
44070C
44071        ICNT=ICNT+1
44072        ITEXT(ICNT)='Group-ID Variable: '
44073        WRITE(ITEXT(ICNT)(20:23),'(A4)')IVARID(2)(1:4)
44074        WRITE(ITEXT(ICNT)(24:27),'(A4)')IVARI2(2)(1:4)
44075        NCTEXT(ICNT)=27
44076        AVALUE(ICNT)=0.0
44077        IDIGIT(ICNT)=-1
44078      ENDIF
44079C
44080      IF(PMTEQU.NE.0.5)THEN
44081        ICNT=ICNT+1
44082        ITEXT(ICNT)='H0: Samples Have Equal Quantile'
44083        NCTEXT(ICNT)=31
44084        AVALUE(ICNT)=0.0
44085        IDIGIT(ICNT)=-1
44086        ICNT=ICNT+1
44087        ITEXT(ICNT)='Ha: At Least Two Samples Have Different Quantile'
44088        NCTEXT(ICNT)=48
44089        AVALUE(ICNT)=0.0
44090        IDIGIT(ICNT)=-1
44091      ELSE
44092        ICNT=ICNT+1
44093        ITEXT(ICNT)='H0: Samples Have Equal Medians'
44094        NCTEXT(ICNT)=30
44095        AVALUE(ICNT)=0.0
44096        IDIGIT(ICNT)=-1
44097        ICNT=ICNT+1
44098        ITEXT(ICNT)='Ha: At Least Two Samples Have Different Medians'
44099        NCTEXT(ICNT)=47
44100        AVALUE(ICNT)=0.0
44101        IDIGIT(ICNT)=-1
44102      ENDIF
44103C
44104      ICNT=ICNT+1
44105      ITEXT(ICNT)=' '
44106      NCTEXT(ICNT)=1
44107      AVALUE(ICNT)=0.0
44108      IDIGIT(ICNT)=-1
44109      ICNT=ICNT+1
44110      ITEXT(ICNT)='Summary Statistics:'
44111      NCTEXT(ICNT)=19
44112      AVALUE(ICNT)=0.0
44113      IDIGIT(ICNT)=-1
44114      IF(PMTEQU.NE.0.5)THEN
44115        ICNT=ICNT+1
44116        ITEXT(ICNT)='User Specified Quantile to Test:'
44117        NCTEXT(ICNT)=32
44118        AVALUE(ICNT)=PMTEQU
44119        IDIGIT(ICNT)=NUMDIG
44120      ENDIF
44121      ICNT=ICNT+1
44122      ITEXT(ICNT)='Original Number of Observations:'
44123      NCTEXT(ICNT)=32
44124      AVALUE(ICNT)=REAL(NSAVE)
44125      IDIGIT(ICNT)=0
44126      ICNT=ICNT+1
44127      ITEXT(ICNT)='Number of Observations After Omitting'
44128      NCTEXT(ICNT)=37
44129      AVALUE(ICNT)=0.0
44130      IDIGIT(ICNT)=-1
44131      ICNT=ICNT+1
44132      ITEXT(ICNT)='Groups With Less Than Two Observations:'
44133      NCTEXT(ICNT)=39
44134      AVALUE(ICNT)=REAL(N)
44135      IDIGIT(ICNT)=0
44136      ICNT=ICNT+1
44137      ITEXT(ICNT)='Number of Groups:'
44138      NCTEXT(ICNT)=17
44139      AVALUE(ICNT)=REAL(NDIST)
44140      IDIGIT(ICNT)=0
44141      IF(PMTEQU.NE.0.5)THEN
44142        ICNT=ICNT+1
44143        ITEXT(ICNT)='Grand Quantile:'
44144        NCTEXT(ICNT)=15
44145        AVALUE(ICNT)=XMED
44146        IDIGIT(ICNT)=0
44147        ICNT=ICNT+1
44148        ITEXT(ICNT)='Number of Points > the Grand Quantile:'
44149        NCTEXT(ICNT)=38
44150        AVALUE(ICNT)=XA
44151        IDIGIT(ICNT)=0
44152        ICNT=ICNT+1
44153        ITEXT(ICNT)='Number of Points <= the Grand Quantile:'
44154        NCTEXT(ICNT)=39
44155        AVALUE(ICNT)=REAL(N) - XA
44156        IDIGIT(ICNT)=0
44157      ELSE
44158        ICNT=ICNT+1
44159        ITEXT(ICNT)='Grand Median:'
44160        NCTEXT(ICNT)=13
44161        AVALUE(ICNT)=XMED
44162        IDIGIT(ICNT)=0
44163        ICNT=ICNT+1
44164        ITEXT(ICNT)='Number of Points > the Grand Median:'
44165        NCTEXT(ICNT)=36
44166        AVALUE(ICNT)=XA
44167        IDIGIT(ICNT)=0
44168        ICNT=ICNT+1
44169        ITEXT(ICNT)='Number of Points <= the Grand Median:'
44170        NCTEXT(ICNT)=37
44171        AVALUE(ICNT)=REAL(N) - XA
44172        IDIGIT(ICNT)=0
44173      ENDIF
44174      ICNT=ICNT+1
44175      ITEXT(ICNT)=' '
44176      NCTEXT(ICNT)=1
44177      AVALUE(ICNT)=0.0
44178      IDIGIT(ICNT)=-1
44179C
44180      ICNT=ICNT+1
44181      ITEXT(ICNT)='Median Test Statistic Value:'
44182      NCTEXT(ICNT)=28
44183      AVALUE(ICNT)=STATVA
44184      IDIGIT(ICNT)=NUMDIG
44185      ICNT=ICNT+1
44186      ITEXT(ICNT)='CDF of Test Statistic:'
44187      NCTEXT(ICNT)=22
44188      AVALUE(ICNT)=STATCD
44189      IDIGIT(ICNT)=NUMDIG
44190      ICNT=ICNT+1
44191      ITEXT(ICNT)='P-Value:'
44192      NCTEXT(ICNT)=8
44193      AVALUE(ICNT)=PVAL
44194      IDIGIT(ICNT)=NUMDIG
44195C
44196      NUMROW=ICNT
44197      DO4210I=1,NUMROW
44198        NTOT(I)=15
44199 4210 CONTINUE
44200C
44201      IFRST=.TRUE.
44202      ILAST=.TRUE.
44203C
44204      ISTEPN='42A'
44205      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET2')
44206     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44207C
44208      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
44209     1            AVALUE,IDIGIT,
44210     1            NTOT,NUMROW,
44211     1            ICAPSW,ICAPTY,ILAST,IFRST,
44212     1            ISUBRO,IBUGA3,IERROR)
44213C
44214      ITITLE=' '
44215      NCTITL=0
44216      ITITL9=' '
44217      NCTIT9=0
44218      ITITLE(1:55)=
44219     1'Percent Points of the Chi-Square Reference Distribution'
44220      NCTITL=55
44221      NUMLIN=1
44222      NUMROW=NUMALP
44223      NUMCOL=3
44224      ITITL2(1,1)='Percent Point'
44225      ITITL2(1,2)=' '
44226      ITITL2(1,3)='Value'
44227      NCTIT2(1,1)=13
44228      NCTIT2(1,2)=1
44229      NCTIT2(1,3)=5
44230C
44231      NMAX=0
44232      DO4221I=1,NUMCOL
44233        VALIGN(I)='b'
44234        ALIGN(I)='r'
44235        NTOT(I)=15
44236        IF(I.EQ.2)NTOT(I)=5
44237        NMAX=NMAX+NTOT(I)
44238        IDIGIT(I)=NUMDIG
44239        ITYPCO(I)='NUME'
44240 4221 CONTINUE
44241      ITYPCO(2)='ALPH'
44242      IDIGIT(1)=1
44243      IDIGIT(3)=3
44244      DO4223I=1,NUMROW
44245        DO4225J=1,NUMCOL
44246          NCVALU(I,J)=0
44247          IVALUE(I,J)=' '
44248          NCVALU(I,J)=0
44249          AMAT(I,J)=0.0
44250          IF(J.EQ.1)THEN
44251            AMAT(I,J)=ALPHA(I)
44252          ELSEIF(J.EQ.2)THEN
44253            IVALUE(I,J)='='
44254            NCVALU(I,J)=1
44255          ELSEIF(J.EQ.3)THEN
44256            IF(I.EQ.1)THEN
44257              AMAT(I,J)=RND(CUT0,IDIGIT(J))
44258            ELSEIF(I.EQ.2)THEN
44259              AMAT(I,J)=RND(CUT50,IDIGIT(J))
44260            ELSEIF(I.EQ.3)THEN
44261              AMAT(I,J)=RND(CUT75,IDIGIT(J))
44262            ELSEIF(I.EQ.4)THEN
44263              AMAT(I,J)=RND(CUT90,IDIGIT(J))
44264            ELSEIF(I.EQ.5)THEN
44265              AMAT(I,J)=RND(CUT95,IDIGIT(J))
44266            ELSEIF(I.EQ.6)THEN
44267              AMAT(I,J)=RND(CUT975,IDIGIT(J))
44268            ELSEIF(I.EQ.7)THEN
44269              AMAT(I,J)=RND(CUT99,IDIGIT(J))
44270            ELSEIF(I.EQ.8)THEN
44271              AMAT(I,J)=RND(CUT999,IDIGIT(J))
44272            ENDIF
44273          ENDIF
44274 4225   CONTINUE
44275 4223 CONTINUE
44276C
44277      IWHTML(1)=150
44278      IWHTML(2)=50
44279      IWHTML(3)=150
44280      IWRTF(1)=2000
44281      IWRTF(2)=IWRTF(1)+500
44282      IWRTF(3)=IWRTF(2)+2000
44283      IFRST=.TRUE.
44284      ILAST=.FALSE.
44285C
44286      ISTEPN='42C'
44287      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET2')
44288     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44289C
44290      CALL DPDTA4(ITITL9,NCTIT9,
44291     1            ITITLE,NCTITL,ITITL2,NCTIT2,
44292     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
44293     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,NUMROW,
44294     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
44295     1            ICAPSW,ICAPTY,IFRST,ILAST,
44296     1            ISUBRO,IBUGA3,IERROR)
44297C
44298      ISTEPN='42D'
44299      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET2')
44300     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44301C
44302      ITITLE='Upper-Tailed Test: Chi-Square Approximation'
44303      NCTITL=43
44304      IF(PMTEQU.NE.0.5)THEN
44305        ITITL9='H0: Quantiles Are Equal; Ha: Quantiles Are Not Equal'
44306        NCTIT9=52
44307      ELSE
44308        ITITL9='H0: Medians Are Equal; Ha: Medians Are Not Equal'
44309        NCTIT9=48
44310      ENDIF
44311C
44312      DO2130J=1,NUMCLI
44313        DO2140I=1,MAXLIN
44314          ITITL2(I,J)=' '
44315          NCTIT2(I,J)=0
44316 2140   CONTINUE
44317 2130 CONTINUE
44318C
44319      NUMCOL=4
44320      ITITL2(2,1)='Significance'
44321      NCTIT2(2,1)=12
44322      ITITL2(3,1)='Level'
44323      NCTIT2(3,1)=5
44324C
44325      ITITL2(2,2)='Test '
44326      NCTIT2(2,2)=4
44327      ITITL2(3,2)='Statistic'
44328      NCTIT2(3,2)=9
44329C
44330      ITITL2(2,3)='Critical'
44331      NCTIT2(2,3)=8
44332      ITITL2(3,3)='Value (>)'
44333      NCTIT2(3,3)=9
44334C
44335      ITITL2(1,4)='Null'
44336      NCTIT2(1,4)=4
44337      ITITL2(2,4)='Hypothesis'
44338      NCTIT2(2,4)=10
44339      ITITL2(3,4)='Conclusion'
44340      NCTIT2(3,4)=10
44341C
44342      NMAX=0
44343      DO2150I=1,NUMCOL
44344        VALIGN(I)='b'
44345        ALIGN(I)='r'
44346        NTOT(I)=15
44347        NMAX=NMAX+NTOT(I)
44348        ITYPCO(I)='NUME'
44349        IDIGIT(I)=NUMDIG
44350        IF(I.EQ.1 .OR. I.EQ.4)THEN
44351          ITYPCO(I)='ALPH'
44352        ENDIF
44353 2150 CONTINUE
44354C
44355      IWHTML(1)=125
44356      IWHTML(2)=175
44357      IWHTML(3)=175
44358      IWHTML(4)=175
44359      IINC=1800
44360      IINC2=1400
44361      IWRTF(1)=IINC
44362      IWRTF(2)=IWRTF(1)+IINC
44363      IWRTF(3)=IWRTF(2)+IINC
44364      IWRTF(4)=IWRTF(3)+IINC
44365C
44366      ICNT=0
44367      DO2160J=4,NUMALP
44368C
44369        ICNT=ICNT+1
44370        AMAT(ICNT,2)=STATVA
44371        ALPHAT=ALPHA(J)
44372        ATEMP=ALPHAT/100.0
44373        CALL CHSPPF(ATEMP,IDF,CUTTMP)
44374        AMAT(ICNT,3)=CUTTMP
44375        IVALUE(ICNT,4)(1:6)='ACCEPT'
44376        IF(STATVA.GT.AMAT(ICNT,3))THEN
44377          IVALUE(ICNT,4)(1:6)='REJECT'
44378        ENDIF
44379        NCVALU(ICNT,4)=6
44380C
44381        WRITE(IVALUE(ICNT,1)(1:4),'(F4.1)')ALPHAT
44382        IVALUE(ICNT,1)(5:5)='%'
44383        NCVALU(ICNT,1)=5
44384 2160 CONTINUE
44385C
44386      NUMLIN=3
44387      IFRST=.TRUE.
44388      ILAST=.TRUE.
44389      IFLAGS=.TRUE.
44390      IFLAGE=.TRUE.
44391C
44392      CALL DPDTA5(ITITLE,NCTITL,
44393     1            ITITL9,NCTIT9,ITITL2,NCTIT2,
44394     1            MAXLIN,NUMLIN,NUMCLI,NUMCOL,
44395     1            IVALUE,NCVALU,AMAT,ITYPCO,MAXROW,ICNT,
44396     1            IDIGIT,NTOT,IWHTML,IWRTF,VALIGN,ALIGN,NMAX,
44397     1            ICAPSW,ICAPTY,IFRST,ILAST,
44398     1            IFLAGS,IFLAGE,
44399     1            ISUBRO,IBUGA3,IERROR)
44400C
44401C               *****************
44402C               **  STEP 90--  **
44403C               **  EXIT       **
44404C               *****************
44405C
44406 9000 CONTINUE
44407      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MET2')THEN
44408        WRITE(ICOUT,999)
44409        CALL DPWRST('XXX','WRIT')
44410        WRITE(ICOUT,9011)
44411 9011   FORMAT('***** AT THE END       OF DPMET2--')
44412        CALL DPWRST('XXX','WRIT')
44413        WRITE(ICOUT,9025)STATVA,STATCD,PVAL
44414 9025   FORMAT('STATVA,STATCD,PVAL = ',3G15.7)
44415        CALL DPWRST('XXX','WRIT')
44416      ENDIF
44417C
44418      RETURN
44419      END
44420      SUBROUTINE DPMET3(Y,X,N,
44421     1                  TEMP1,TEMP2,XIDTEM,PMTEQU,IQUAME,MAXNXT,
44422     1                  XMED,XA,XB,IDF,NDIST,
44423     1                  STATVA,STATCD,PVALUE,
44424     1                  IBUGA3,ISUBRO,IERROR)
44425C
44426C     PURPOSE--THIS ROUTINE COMPUTES THE MEDIAN K-SAMPLE TEST
44427C              STATISTIC FOR EQUAL MEDIANS AND ASSOCIATED CDF AND
44428C              P-VALUES.
44429C
44430C              THIS PART IS EXTRACTED FROM DPMET2 IN ORDER TO
44431C              ALLOW IT TO BE COMPUTED FROM THE "STATISTICS" ROUTINES
44432C              (E.G., STATISTIC PLOT, BOOTSTRAP).
44433C
44434C              THE TEST STATISTIC IS:
44435C
44436C                 T = (N**2/a*b)*SUM[i=1 to k][(O(1i) - n(i)*a/N)**2/n(i)]
44437C
44438C              WHERE
44439C
44440C                 N      = TOTAL SAMPLE SIZE
44441C                 O(1i)  = NUMBER OF OBSERVAIONS IN GROUP i > GRAND MEDIAN
44442C                 n(i)   = SAMPLE SIZE OF GROUP i
44443C                 a      = TOTAL NUMBER OF OBSERVATIONS GREATER THAN THE
44444C                          GRAND MEDIAN
44445C                 b      = TOTAL NUMBER OF OBSERVATIONS LESS THAN OR EQUAL
44446C                          TO THE GRAND MEDIAN
44447C
44448C              AT THE RECOMMENDATION OF CONOVER, ANY GROUPS WITH LESS THAN
44449C              TWO OBSERVATIONS ARE OMITTED FROM THE ANALYSIS AS THESE CAN
44450C              MAKE THE CHI-SQUARE APPROXIMATION INACCURATE.
44451C
44452C     EXAMPLE--MEDIAN TEST Y X
44453C     REFERENCE--CONOVER (1999), "PRACTICAL NONPARAMETRIC STATISTICS",
44454C                THIRD EDITION, WILEY, PP. 218 - 224.
44455C     WRITTEN BY--ALAN HECKERT
44456C                 STATISTICAL ENGINEERING DIVISION
44457C                 INFORMATION TECHNOLOGY LABORATORY
44458C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
44459C                 GAITHERSBURG, MD 20899-8980
44460C                 PHONE--301-975-2855
44461C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
44462C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
44463C     LANGUAGE--ANSI FORTRAN (1977)
44464C     VERSION NUMBER--2011/6
44465C     ORIGINAL VERSION--JUNE      2011.
44466C
44467C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
44468C
44469      CHARACTER*4 IQUAME
44470      CHARACTER*4 IBUGA3
44471      CHARACTER*4 ISUBRO
44472      CHARACTER*4 IERROR
44473C
44474      CHARACTER*4 IWRITE
44475      CHARACTER*4 ISUBN1
44476      CHARACTER*4 ISUBN2
44477      CHARACTER*4 ISTEPN
44478C
44479      DOUBLE PRECISION DSUM1
44480      DOUBLE PRECISION DFACT
44481C
44482C---------------------------------------------------------------------
44483C
44484      DIMENSION Y(*)
44485      DIMENSION X(*)
44486      DIMENSION TEMP1(*)
44487      DIMENSION TEMP2(*)
44488      DIMENSION XIDTEM(*)
44489C
44490C---------------------------------------------------------------------
44491C
44492      INCLUDE 'DPCOP2.INC'
44493C
44494C-----START POINT-----------------------------------------------------
44495C
44496      ISUBN1='DPME'
44497      ISUBN2='T3  '
44498      IERROR='NO'
44499      IWRITE='OFF'
44500C
44501      STATVA=CPUMIN
44502      STATCD=CPUMIN
44503      PVALUE=CPUMIN
44504      IDF=-99
44505C
44506      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET3')THEN
44507        WRITE(ICOUT,999)
44508  999   FORMAT(1X)
44509        CALL DPWRST('XXX','WRIT')
44510        WRITE(ICOUT,51)
44511   51   FORMAT('**** AT THE BEGINNING OF DPMET3--')
44512        CALL DPWRST('XXX','WRIT')
44513        WRITE(ICOUT,52)IBUGA3,ISUBRO,IQUAME,N,PMTEQU
44514   52   FORMAT('IBUGA3,ISUBRO,IQUAME,N,PMTEQU = ',3(A4,2X),I8,G15.7)
44515        CALL DPWRST('XXX','WRIT')
44516        DO56I=1,N
44517          WRITE(ICOUT,57)I,Y(I),X(I)
44518   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
44519          CALL DPWRST('XXX','WRIT')
44520   56   CONTINUE
44521      ENDIF
44522C
44523C               ********************************************
44524C               **  STEP 01--                             **
44525C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
44526C               ********************************************
44527C
44528      ISTEPN='01'
44529      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET3')
44530     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44531C
44532      IF(N.LE.1)THEN
44533        WRITE(ICOUT,999)
44534        CALL DPWRST('XXX','BUG ')
44535        WRITE(ICOUT,101)
44536  101   FORMAT('***** ERROR IN MEDIAN TEST--')
44537        CALL DPWRST('XXX','BUG ')
44538        WRITE(ICOUT,112)
44539  112   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR THE ',
44540     1         'RESPONSE')
44541        CALL DPWRST('XXX','BUG ')
44542        WRITE(ICOUT,113)
44543  113   FORMAT('      VARIABLES MUST BE 2 OR LARGER.  SUCH WAS NOT ',
44544     1         'THE CASE HERE.')
44545        CALL DPWRST('XXX','BUG ')
44546        WRITE(ICOUT,117)N
44547  117   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS   = ',I8,'.')
44548        CALL DPWRST('XXX','BUG ')
44549        IERROR='YES'
44550        GOTO9000
44551      ENDIF
44552C
44553      HOLD=Y(1)
44554      DO135I=2,N
44555        IF(Y(I).NE.HOLD)GOTO139
44556  135 CONTINUE
44557      WRITE(ICOUT,999)
44558      CALL DPWRST('XXX','WRIT')
44559      WRITE(ICOUT,101)
44560      CALL DPWRST('XXX','WRIT')
44561      WRITE(ICOUT,131)HOLD
44562  131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
44563      CALL DPWRST('XXX','WRIT')
44564      IERROR='YES'
44565      GOTO9000
44566  139 CONTINUE
44567C
44568      HOLD=X(1)
44569      DO145I=2,N
44570        IF(X(I).NE.HOLD)GOTO149
44571  145 CONTINUE
44572      WRITE(ICOUT,999)
44573      CALL DPWRST('XXX','WRIT')
44574      WRITE(ICOUT,101)
44575      CALL DPWRST('XXX','WRIT')
44576      WRITE(ICOUT,141)HOLD
44577  141 FORMAT('      THE GROUP-ID VARIABLE HAS ALL ELEMENTS = ',G15.7)
44578      CALL DPWRST('XXX','WRIT')
44579      IERROR='YES'
44580      GOTO9000
44581  149 CONTINUE
44582C
44583C               *************************************
44584C               **   STEP 11--                     **
44585C               **   COMPUTE MEDIAN   TEST         **
44586C               *************************************
44587C
44588      ISTEPN='11'
44589      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET3')
44590     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44591C
44592C     DETERMINE DISTINCT VALUES OF GROUP-ID VARIABLE.  OMIT
44593C     ANY GROUPS WITH FEWER THAN TWO OBSERVATIONS.
44594C
44595      DO1003I=1,N
44596        TEMP1(I)=1.0
44597 1003 CONTINUE
44598      CALL DISTIN(X,N,IWRITE,XIDTEM,NDIST,IBUGA3,IERROR)
44599      DO1010K=1,NDIST
44600        HOLD=XIDTEM(K)
44601        NTEMP=0
44602        DO1020I=1,N
44603          IF(X(I).EQ.HOLD)THEN
44604            NTEMP=NTEMP+1
44605          ENDIF
44606 1020   CONTINUE
44607        IF(NTEMP.LE.1)THEN
44608          DO1030I=1,N
44609            IF(X(I).EQ.HOLD)TEMP1(I)=0.0
44610 1030     CONTINUE
44611        ENDIF
44612 1010 CONTINUE
44613C
44614      ICNT=0
44615      DO1040I=1,N
44616        IF(TEMP1(I).EQ.1.0)THEN
44617          ICNT=ICNT+1
44618          Y(ICNT)=Y(I)
44619          X(ICNT)=X(I)
44620        ENDIF
44621 1040 CONTINUE
44622      N=ICNT
44623C
44624      IF(N.LT.2)THEN
44625        WRITE(ICOUT,999)
44626        CALL DPWRST('XXX','WRIT')
44627        WRITE(ICOUT,101)
44628        CALL DPWRST('XXX','WRIT')
44629        WRITE(ICOUT,1041)
44630 1041   FORMAT('      AFTER OMITTING GROUPS WITH SAMPLE SIZE = 1')
44631        CALL DPWRST('XXX','WRIT')
44632        WRITE(ICOUT,1043)
44633 1043   FORMAT('      THE NUMBER OF RESPONSE VALUES IS LESS THAN TWO.')
44634        CALL DPWRST('XXX','WRIT')
44635        IERROR='YES'
44636        GOTO9000
44637      ENDIF
44638C
44639C     COMPUTE GRAND MEDIAN AND DETERMINE COUNTS ABOVE GRAND
44640C     MEDIAN FOR EACH GROUP
44641C
44642      IF(PMTEQU.NE.0.5)THEN
44643        CALL QUANT(PMTEQU,Y,N,IWRITE,TEMP1,MAXNXT,
44644     1             IQUAME,
44645     1             XMED,IBUGA3,IERROR)
44646      ELSE
44647        CALL MEDIAN(Y,N,IWRITE,TEMP1,MAXNXT,XMED,IBUGA3,IERROR)
44648      ENDIF
44649      CALL DISTIN(X,N,IWRITE,XIDTEM,NDIST,IBUGA3,IERROR)
44650C
44651      IF(NDIST.LT.2)THEN
44652        WRITE(ICOUT,999)
44653        CALL DPWRST('XXX','WRIT')
44654        WRITE(ICOUT,101)
44655        CALL DPWRST('XXX','WRIT')
44656        WRITE(ICOUT,1046)
44657 1046   FORMAT('      AFTER OMITTING GROUPS WITH SAMPLE SIZE = 1')
44658        CALL DPWRST('XXX','WRIT')
44659        WRITE(ICOUT,1048)
44660 1048   FORMAT('      THE NUMBER OF GROUPS IS LESS THAN TWO.')
44661        CALL DPWRST('XXX','WRIT')
44662        IERROR='YES'
44663        GOTO9000
44664      ENDIF
44665C
44666      DO1050K=1,NDIST
44667        HOLD=XIDTEM(K)
44668        NTEMP=0
44669        IABOVE=0
44670        DO1060I=1,N
44671          IF(X(I).EQ.HOLD)THEN
44672            NTEMP=NTEMP+1
44673            IF(Y(I).GT.XMED)IABOVE=IABOVE+1
44674          ENDIF
44675 1060   CONTINUE
44676        TEMP1(K)=REAL(IABOVE)
44677        TEMP2(K)=REAL(NTEMP)
44678 1050 CONTINUE
44679C
44680      CALL SUMDP(TEMP1,NDIST,IWRITE,XA,IBUGA3,IERROR)
44681      AN=REAL(N)
44682      XB=AN - XA
44683      DFACT=DBLE(AN)**2/DBLE(XA*XB)
44684C
44685      DSUM1=0.0D0
44686      DO1070I=1,NDIST
44687        DSUM1=DSUM1 + (TEMP1(I) - TEMP2(I)*XA/AN)**2/TEMP2(I)
44688 1070 CONTINUE
44689      STATVA=REAL(DFACT*DSUM1)
44690C
44691C     CDF AND P-VALUES COMPUTED FROM CHI-SQUARE APPROXIMATION
44692C
44693      IDF=NDIST-1
44694      CALL CHSCDF(STATVA,IDF,STATCD)
44695      PVALUE=1.0 - STATCD
44696C
44697C               *****************
44698C               **  STEP 90--  **
44699C               **  EXIT       **
44700C               *****************
44701C
44702 9000 CONTINUE
44703      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MET3')THEN
44704        WRITE(ICOUT,999)
44705        CALL DPWRST('XXX','WRIT')
44706        WRITE(ICOUT,9011)
44707 9011   FORMAT('***** AT THE END       OF DPMET3--')
44708        CALL DPWRST('XXX','WRIT')
44709        WRITE(ICOUT,9013)STATVA,STATCD,PVALUE,IDF
44710 9013   FORMAT('STATVA,STATCD,PVALUE,IDF = ',3G15.7,I8)
44711        CALL DPWRST('XXX','WRIT')
44712        WRITE(ICOUT,9014)SBAR,D2,DSUM1,DSUM2,DSUM3
44713 9014   FORMAT('SBAR,D2,DSUM1,DSUM2,DSUM3 = ',5G15.7)
44714        CALL DPWRST('XXX','WRIT')
44715      ENDIF
44716C
44717      RETURN
44718      END
44719      SUBROUTINE DPMFCO(IHARG,NUMARG,IDEMFC,MAXMAR,IMAFCO,
44720     1                  IBUGP2,IFOUND,IERROR)
44721C
44722C     PURPOSE--DEFINE THE MARKER FILL COLORS = THE COLORS
44723C              OF THE (BACKGROUND) FILL WITHIN THE MARKERS.
44724C              THESE ARE LOCATED IN THE VECTOR IMAFCO(.).
44725C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
44726C                     --NUMARG
44727C                     --IDEMFC
44728C                     --MAXMAR
44729C                     --IBUGP2 ('ON' OR 'OFF' )
44730C     OUTPUT ARGUMENTS--IMAFCO (A CHARACTER VECTOR)
44731C                     --IFOUND ('YES' OR 'NO' )
44732C                     --IERROR ('YES' OR 'NO' )
44733C     WRITTEN BY--JAMES J. FILLIBEN
44734C                 STATISTICAL ENGINEERING DIVISION
44735C                 INFORMATION TECHNOLOGY LABORATORY
44736C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
44737C                 GAITHERSBURG, MD 20899-8980
44738C                 PHONE--301-975-2855
44739C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
44740C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
44741C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
44742C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
44743C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
44744C     LANGUAGE--ANSI FORTRAN (1977)
44745C     VERSION NUMBER--82/7
44746C     ORIGINAL VERSION--DECEMBER  1983.
44747C
44748C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
44749C
44750      CHARACTER*4 IHARG
44751      CHARACTER*4 IDEMFC
44752      CHARACTER*4 IMAFCO
44753C
44754      CHARACTER*4 IBUGP2
44755      CHARACTER*4 IFOUND
44756      CHARACTER*4 IERROR
44757C
44758      CHARACTER*4 IHOLD1
44759      CHARACTER*4 IHOLD2
44760C
44761      CHARACTER*4 ISUBN1
44762      CHARACTER*4 ISUBN2
44763      CHARACTER*4 ISTEPN
44764C
44765      DIMENSION IHARG(*)
44766      DIMENSION IMAFCO(*)
44767C
44768C---------------------------------------------------------------------
44769C
44770      INCLUDE 'DPCOP2.INC'
44771C
44772C-----START POINT-----------------------------------------------------
44773C
44774      IFOUND='NO'
44775      IERROR='NO'
44776      ISUBN1='DPMF'
44777      ISUBN2='CO  '
44778C
44779      NUMMAR=0
44780      IHOLD1='-999'
44781      IHOLD2='-999'
44782C
44783      IF(IBUGP2.EQ.'OFF')GOTO90
44784      WRITE(ICOUT,999)
44785  999 FORMAT(1X)
44786      CALL DPWRST('XXX','BUG ')
44787      WRITE(ICOUT,51)
44788   51 FORMAT('***** AT THE BEGINNING OF DPMFCO--')
44789      CALL DPWRST('XXX','BUG ')
44790      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
44791   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
44792      CALL DPWRST('XXX','BUG ')
44793      WRITE(ICOUT,53)MAXMAR,NUMMAR
44794   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
44795      CALL DPWRST('XXX','BUG ')
44796      WRITE(ICOUT,54)IHOLD1,IHOLD2
44797   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
44798      CALL DPWRST('XXX','BUG ')
44799      WRITE(ICOUT,55)IDEMFC
44800   55 FORMAT('IDEMFC = ',A4)
44801      CALL DPWRST('XXX','BUG ')
44802      WRITE(ICOUT,60)NUMARG
44803   60 FORMAT('NUMARG = ',I8)
44804      CALL DPWRST('XXX','BUG ')
44805      DO65I=1,NUMARG
44806      WRITE(ICOUT,66)IHARG(I)
44807   66 FORMAT('IHARG(I) = ',A4)
44808      CALL DPWRST('XXX','BUG ')
44809   65 CONTINUE
44810      WRITE(ICOUT,70)IMAFCO(1)
44811   70 FORMAT('IMAFCO(1) = ',A4)
44812      CALL DPWRST('XXX','BUG ')
44813      DO75I=1,10
44814      WRITE(ICOUT,76)I,IMAFCO(I)
44815   76 FORMAT('I,IMAFCO(I) = ',I8,2X,A4)
44816      CALL DPWRST('XXX','BUG ')
44817   75 CONTINUE
44818   90 CONTINUE
44819C
44820C               **************************************
44821C               **  STEP 1--                        **
44822C               **  BRANCH TO THE APPROPRIATE CASE  **
44823C               **************************************
44824C
44825      ISTEPN='1'
44826      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44827C
44828      IF(NUMARG.LE.1)GOTO9000
44829      IF(NUMARG.EQ.2)GOTO1120
44830      IF(NUMARG.EQ.3)GOTO1130
44831      IF(NUMARG.EQ.4)GOTO1140
44832      GOTO1150
44833C
44834 1120 CONTINUE
44835      GOTO1200
44836C
44837 1130 CONTINUE
44838      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
44839      IF(IHARG(3).EQ.'ALL')GOTO1300
44840      GOTO1200
44841C
44842 1140 CONTINUE
44843      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
44844      IF(IHARG(3).EQ.'ALL')GOTO1300
44845      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
44846      IF(IHARG(4).EQ.'ALL')GOTO1300
44847      GOTO1200
44848C
44849 1150 CONTINUE
44850      GOTO1200
44851C
44852C               *************************************************
44853C               **  STEP 2--                                   **
44854C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
44855C               *************************************************
44856C
44857 1200 CONTINUE
44858      ISTEPN='2'
44859      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44860C
44861      IF(NUMARG.LE.2)GOTO1210
44862      GOTO1220
44863C
44864 1210 CONTINUE
44865      NUMMAR=1
44866      IMAFCO(1)=IDEMFC
44867      GOTO1270
44868C
44869 1220 CONTINUE
44870      NUMMAR=NUMARG-2
44871      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
44872      DO1225I=1,NUMMAR
44873      J=I+2
44874      IHOLD1=IHARG(J)
44875      IHOLD2=IHOLD1
44876      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMFC
44877      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMFC
44878      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFC
44879      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFC
44880      IMAFCO(I)=IHOLD2
44881 1225 CONTINUE
44882      GOTO1270
44883C
44884 1270 CONTINUE
44885      IF(IFEEDB.EQ.'OFF')GOTO1279
44886      WRITE(ICOUT,999)
44887      CALL DPWRST('XXX','BUG ')
44888      DO1278I=1,NUMMAR
44889      WRITE(ICOUT,1276)I,IMAFCO(I)
44890 1276 FORMAT('THE FILL COLOR OF MARKER ',I6,
44891     1' HAS JUST BEEN SET TO ',A4)
44892      CALL DPWRST('XXX','BUG ')
44893 1278 CONTINUE
44894 1279 CONTINUE
44895      IFOUND='YES'
44896      GOTO9000
44897C
44898C               **************************
44899C               **  STEP 3--            **
44900C               **  TREAT THE ALL CASE  **
44901C               **************************
44902C
44903 1300 CONTINUE
44904      ISTEPN='3'
44905      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
44906C
44907      NUMMAR=MAXMAR
44908      IHOLD2=IHOLD1
44909      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMFC
44910      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMFC
44911      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFC
44912      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFC
44913      DO1315I=1,NUMMAR
44914      IMAFCO(I)=IHOLD2
44915 1315 CONTINUE
44916      GOTO1370
44917C
44918 1370 CONTINUE
44919      IF(IFEEDB.EQ.'OFF')GOTO1319
44920      WRITE(ICOUT,999)
44921      CALL DPWRST('XXX','BUG ')
44922      I=1
44923      WRITE(ICOUT,1316)IMAFCO(I)
44924 1316 FORMAT('THE FILL COLOR OF ALL MARKERS',
44925     1' HAS JUST BEEN SET TO ',A4)
44926      CALL DPWRST('XXX','BUG ')
44927 1319 CONTINUE
44928      IFOUND='YES'
44929      GOTO9000
44930C
44931C               *****************
44932C               **  STEP 90--  **
44933C               **  EXIT       **
44934C               *****************
44935C
44936 9000 CONTINUE
44937      IF(IBUGP2.EQ.'OFF')GOTO9090
44938      WRITE(ICOUT,9011)
44939 9011 FORMAT('***** AT THE END       OF DPMFCO--')
44940      CALL DPWRST('XXX','BUG ')
44941      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
44942 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
44943      CALL DPWRST('XXX','BUG ')
44944      WRITE(ICOUT,9013)MAXMAR,NUMMAR
44945 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
44946      CALL DPWRST('XXX','BUG ')
44947      WRITE(ICOUT,9014)IHOLD1,IHOLD2
44948 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
44949      CALL DPWRST('XXX','BUG ')
44950      WRITE(ICOUT,9015)IDEMFC
44951 9015 FORMAT('IDEMFC = ',A4)
44952      CALL DPWRST('XXX','BUG ')
44953      WRITE(ICOUT,9020)NUMARG
44954 9020 FORMAT('NUMARG = ',I8)
44955      CALL DPWRST('XXX','BUG ')
44956      DO9025I=1,NUMARG
44957      WRITE(ICOUT,9026)IHARG(I)
44958 9026 FORMAT('IHARG(I) = ',A4)
44959      CALL DPWRST('XXX','BUG ')
44960 9025 CONTINUE
44961      WRITE(ICOUT,9030)IMAFCO(1)
44962 9030 FORMAT('IMAFCO(1) = ',A4)
44963      CALL DPWRST('XXX','BUG ')
44964      DO9035I=1,10
44965      WRITE(ICOUT,9036)I,IMAFCO(I)
44966 9036 FORMAT('I,IMAFCO(I) = ',I8,2X,A4)
44967      CALL DPWRST('XXX','BUG ')
44968 9035 CONTINUE
44969 9090 CONTINUE
44970C
44971      RETURN
44972      END
44973      SUBROUTINE DPMFSW(IHARG,NUMARG,IDEMFS,MAXMAR,IMAFSW,
44974     1                  IBUGP2,IFOUND,IERROR)
44975C
44976C     PURPOSE--DEFINE THE MARKER FILL SWITCHES = THE ON/OFF SWITCHES
44977C              OF THE (BACKGROUND) FILL WITHIN THE MARKERS.
44978C              THESE ARE LOCATED IN THE VECTOR IMAFSW(.).
44979C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
44980C                     --NUMARG
44981C                     --IDEMFS
44982C                     --MAXMAR
44983C                     --IBUGP2 ('ON' OR 'OFF' )
44984C     OUTPUT ARGUMENTS--IMAFSW (A CHARACTER VECTOR)
44985C                     --IFOUND ('YES' OR 'NO' )
44986C                     --IERROR ('YES' OR 'NO' )
44987C     WRITTEN BY--JAMES J. FILLIBEN
44988C                 STATISTICAL ENGINEERING DIVISION
44989C                 INFORMATION TECHNOLOGY LABORATORY
44990C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
44991C                 GAITHERSBURG, MD 20899-8980
44992C                 PHONE--301-975-2855
44993C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
44994C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
44995C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
44996C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
44997C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
44998C     LANGUAGE--ANSI FORTRAN (1977)
44999C     VERSION NUMBER--82/7
45000C     ORIGINAL VERSION--DECEMBER  1983.
45001C
45002C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
45003C
45004      CHARACTER*4 IHARG
45005      CHARACTER*4 IDEMFS
45006      CHARACTER*4 IMAFSW
45007C
45008      CHARACTER*4 IBUGP2
45009      CHARACTER*4 IFOUND
45010      CHARACTER*4 IERROR
45011C
45012      CHARACTER*4 IHOLD1
45013      CHARACTER*4 IHOLD2
45014C
45015      CHARACTER*4 ISUBN1
45016      CHARACTER*4 ISUBN2
45017      CHARACTER*4 ISTEPN
45018C
45019      DIMENSION IHARG(*)
45020      DIMENSION IMAFSW(*)
45021C
45022C---------------------------------------------------------------------
45023C
45024      INCLUDE 'DPCOP2.INC'
45025C
45026C-----START POINT-----------------------------------------------------
45027C
45028      IFOUND='NO'
45029      IERROR='NO'
45030      ISUBN1='DPMF'
45031      ISUBN2='SW  '
45032C
45033      NUMMAR=0
45034      IHOLD1='-999'
45035      IHOLD2='-999'
45036C
45037      IF(IBUGP2.EQ.'OFF')GOTO90
45038      WRITE(ICOUT,999)
45039  999 FORMAT(1X)
45040      CALL DPWRST('XXX','BUG ')
45041      WRITE(ICOUT,51)
45042   51 FORMAT('***** AT THE BEGINNING OF DPMFSW--')
45043      CALL DPWRST('XXX','BUG ')
45044      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
45045   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
45046      CALL DPWRST('XXX','BUG ')
45047      WRITE(ICOUT,53)MAXMAR,NUMMAR
45048   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
45049      CALL DPWRST('XXX','BUG ')
45050      WRITE(ICOUT,54)IHOLD1,IHOLD2
45051   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
45052      CALL DPWRST('XXX','BUG ')
45053      WRITE(ICOUT,55)IDEMFS
45054   55 FORMAT('IDEMFS = ',A4)
45055      CALL DPWRST('XXX','BUG ')
45056      WRITE(ICOUT,60)NUMARG
45057   60 FORMAT('NUMARG = ',I8)
45058      CALL DPWRST('XXX','BUG ')
45059      DO65I=1,NUMARG
45060      WRITE(ICOUT,66)IHARG(I)
45061   66 FORMAT('IHARG(I) = ',A4)
45062      CALL DPWRST('XXX','BUG ')
45063   65 CONTINUE
45064      WRITE(ICOUT,70)IMAFSW(1)
45065   70 FORMAT('IMAFSW(1) = ',A4)
45066      CALL DPWRST('XXX','BUG ')
45067      DO75I=1,10
45068      WRITE(ICOUT,76)I,IMAFSW(I)
45069   76 FORMAT('I,IMAFSW(I) = ',I8,2X,A4)
45070      CALL DPWRST('XXX','BUG ')
45071   75 CONTINUE
45072   90 CONTINUE
45073C
45074C               **************************************
45075C               **  STEP 1--                        **
45076C               **  BRANCH TO THE APPROPRIATE CASE  **
45077C               **************************************
45078C
45079      ISTEPN='1'
45080      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45081C
45082      IF(NUMARG.LE.1)GOTO9000
45083      IF(NUMARG.EQ.2)GOTO1120
45084      IF(NUMARG.EQ.3)GOTO1130
45085      IF(NUMARG.EQ.4)GOTO1140
45086      GOTO1150
45087C
45088 1120 CONTINUE
45089      GOTO1200
45090C
45091 1130 CONTINUE
45092      IF(IHARG(3).EQ.'ALL')IHOLD1='ON'
45093      IF(IHARG(3).EQ.'ALL')GOTO1300
45094      GOTO1200
45095C
45096 1140 CONTINUE
45097      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
45098      IF(IHARG(3).EQ.'ALL')GOTO1300
45099      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
45100      IF(IHARG(4).EQ.'ALL')GOTO1300
45101      GOTO1200
45102C
45103 1150 CONTINUE
45104      GOTO1200
45105C
45106C               *************************************************
45107C               **  STEP 2--                                   **
45108C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
45109C               *************************************************
45110C
45111 1200 CONTINUE
45112      ISTEPN='2'
45113      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45114C
45115      IF(NUMARG.LE.2)GOTO1210
45116      GOTO1220
45117C
45118 1210 CONTINUE
45119      NUMMAR=1
45120      IMAFSW(1)='ON'
45121      GOTO1270
45122C
45123 1220 CONTINUE
45124      NUMMAR=NUMARG-2
45125      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
45126      DO1225I=1,NUMMAR
45127      J=I+2
45128      IHOLD1=IHARG(J)
45129      IHOLD2=IHOLD1
45130      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
45131      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
45132      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFS
45133      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFS
45134      IMAFSW(I)=IHOLD2
45135 1225 CONTINUE
45136      GOTO1270
45137C
45138 1270 CONTINUE
45139      IF(IFEEDB.EQ.'OFF')GOTO1279
45140      WRITE(ICOUT,999)
45141      CALL DPWRST('XXX','BUG ')
45142      DO1278I=1,NUMMAR
45143      WRITE(ICOUT,1276)I,IMAFSW(I)
45144 1276 FORMAT('THE FILL SWITCH FOR MARKER ',I6,
45145     1' HAS JUST BEEN SET TO ',A4)
45146      CALL DPWRST('XXX','BUG ')
45147 1278 CONTINUE
45148 1279 CONTINUE
45149      IFOUND='YES'
45150      GOTO9000
45151C
45152C               **************************
45153C               **  STEP 3--            **
45154C               **  TREAT THE ALL CASE  **
45155C               **************************
45156C
45157 1300 CONTINUE
45158      ISTEPN='3'
45159      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45160C
45161      NUMMAR=MAXMAR
45162      IHOLD2=IHOLD1
45163      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
45164      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
45165      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFS
45166      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFS
45167      DO1315I=1,NUMMAR
45168      IMAFSW(I)=IHOLD2
45169 1315 CONTINUE
45170      GOTO1370
45171C
45172 1370 CONTINUE
45173      IF(IFEEDB.EQ.'OFF')GOTO1319
45174      WRITE(ICOUT,999)
45175      CALL DPWRST('XXX','BUG ')
45176      I=1
45177      WRITE(ICOUT,1316)IMAFSW(I)
45178 1316 FORMAT('THE FILL SWITCH FOR ALL MARKERS',
45179     1' HAS JUST BEEN SET TO ',A4)
45180      CALL DPWRST('XXX','BUG ')
45181 1319 CONTINUE
45182      IFOUND='YES'
45183      GOTO9000
45184C
45185C               *****************
45186C               **  STEP 90--  **
45187C               **  EXIT       **
45188C               *****************
45189C
45190 9000 CONTINUE
45191      IF(IBUGP2.EQ.'OFF')GOTO9090
45192      WRITE(ICOUT,9011)
45193 9011 FORMAT('***** AT THE END       OF DPMFSW--')
45194      CALL DPWRST('XXX','BUG ')
45195      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
45196 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
45197      CALL DPWRST('XXX','BUG ')
45198      WRITE(ICOUT,9013)MAXMAR,NUMMAR
45199 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
45200      CALL DPWRST('XXX','BUG ')
45201      WRITE(ICOUT,9014)IHOLD1,IHOLD2
45202 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
45203      CALL DPWRST('XXX','BUG ')
45204      WRITE(ICOUT,9015)IDEMFS
45205 9015 FORMAT('IDEMFS = ',A4)
45206      CALL DPWRST('XXX','BUG ')
45207      WRITE(ICOUT,9020)NUMARG
45208 9020 FORMAT('NUMARG = ',I8)
45209      CALL DPWRST('XXX','BUG ')
45210      DO9025I=1,NUMARG
45211      WRITE(ICOUT,9026)IHARG(I)
45212 9026 FORMAT('IHARG(I) = ',A4)
45213      CALL DPWRST('XXX','BUG ')
45214 9025 CONTINUE
45215      WRITE(ICOUT,9030)IMAFSW(1)
45216 9030 FORMAT('IMAFSW(1) = ',A4)
45217      CALL DPWRST('XXX','BUG ')
45218      DO9035I=1,10
45219      WRITE(ICOUT,9036)I,IMAFSW(I)
45220 9036 FORMAT('I,IMAFSW(I) = ',I8,2X,A4)
45221      CALL DPWRST('XXX','BUG ')
45222 9035 CONTINUE
45223 9090 CONTINUE
45224C
45225      RETURN
45226      END
45227      SUBROUTINE DPMGET(Y,X,N,NVAR,
45228     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
45229     1                  AMUMOM,BETAMO,AMUFR,BETAFR,AMUML,BETAML,
45230     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
45231     1                  IGETDF,
45232     1                  ISUBRO,IBUGA3,IERROR)
45233C
45234C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
45235C              ESTIMATES FOR THE GEETA DISTRIBUTION.  ESTIMATES
45236C              ARE GENERATED IN TERMS OF THE MU/BETA
45237C              PARAMETERIZATION.
45238C
45239C              THE MOMENT ESTIMATES OF MU AND BETA ARE:
45240C
45241C                 MUHAT = XBAR
45242C                 BETAHAT = (S**2 - XBAR*(XBAR-1))/
45243C                           (S**2 - XBAR**2*(XBAR-1))
45244C
45245C              THE MEAN AND ONES FREQUENCY ESTIMATE OF MU IS:
45246C
45247C                  MUHAT = XBAR
45248C
45249C              THE ESTIMATE OF BETA IS THEN THE SOLUTION OF THE
45250C              EQUATION
45251C
45252C                 ((BETA-1)*XBAR/(BETA*XBAR-1))**(BETA-1) - (N1/N) = 0
45253C
45254C              THE MAXIMUM LIKELIHOOD FREQUENCY ESTIMATE OF MU IS:
45255C
45256C                  MUHAT = XBAR
45257C
45258C              THE ESTIMATE OF BETA IS THEN THE SOLUTION OF THE
45259C              EQUATION
45260C
45261C                 ((BETA-1)*XBAR/(BETA*XBAR-1))**(BETA-1) -
45262C                 (1/(N*XBAR))*
45263C                 SUM[X=2 to k][SUM[i=2 to k][X*N(x)/(BETA*X-1)]] = 0
45264C
45265C              THERE ARE TWO CASES:
45266C
45267C              1) ONE VARIABLE CASE: Y IS RAW DATA
45268C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
45269C                 MID-POINT.
45270C
45271C     EXAMPLE--GEETA MAXIMUM LIKELIHOOD Y
45272C            --GEETA MAXIMUM LIKELIHOOD Y X
45273C     REFERENCES--CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
45274C                 DISTRIBUTIONS", BIRKHAUSER, CHAPTER 8.
45275C     WRITTEN BY--ALAN HECKERT
45276C                 STATISTICAL ENGINEERING DIVISION
45277C                 INFORMATION TECHNOLOGY LABORATORY
45278C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
45279C                 GAITHERSBUG, MD 20899-8980
45280C                 PHONE--301-975-2899
45281C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
45282C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
45283C     LANGUAGE--ANSI FORTRAN (1977)
45284C     VERSION NUMBER--2006/7
45285C     ORIGINAL VERSION--JULY      2006.
45286C     UPDATED         --APRIL     2011. USE DPDTA1 TO PRINT OUTPUT
45287C
45288C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
45289C
45290      CHARACTER*4 ICAPSW
45291      CHARACTER*4 ICAPTY
45292      CHARACTER*4 IFORSW
45293      CHARACTER*4 IGETDF
45294      CHARACTER*4 ISUBRO
45295      CHARACTER*4 IBUGA3
45296      CHARACTER*4 IERROR
45297C
45298      CHARACTER*4 IWRITE
45299      CHARACTER*4 ISUBN1
45300      CHARACTER*4 ISUBN2
45301      CHARACTER*4 ISTEPN
45302      CHARACTER*4 IRELAT
45303      CHARACTER*4 IRHSTG
45304C
45305C-------------------------------------------------------------------
45306C
45307      DIMENSION Y(*)
45308      DIMENSION X(*)
45309      DIMENSION TEMP1(*)
45310      DIMENSION TEMP2(*)
45311      DIMENSION TEMP3(*)
45312      DOUBLE PRECISION DTEMP1(*)
45313C
45314      DOUBLE PRECISION TOL
45315      DOUBLE PRECISION XPAR(1)
45316      DOUBLE PRECISION FVEC(1)
45317C
45318      DOUBLE PRECISION AE
45319      DOUBLE PRECISION RE
45320      DOUBLE PRECISION XLOW
45321      DOUBLE PRECISION XUP
45322      DOUBLE PRECISION XMID
45323C
45324      DOUBLE PRECISION GETFUN
45325      DOUBLE PRECISION GETFU2
45326      EXTERNAL GETFUN
45327      EXTERNAL GETFU2
45328      DOUBLE PRECISION XBAR
45329      DOUBLE PRECISION S2
45330      DOUBLE PRECISION F1FREQ
45331      COMMON/GETCOM/XBAR,S2,F1FREQ,MAXRO2,NTOT2
45332C
45333      PARAMETER (MAXROW=30)
45334      CHARACTER*60 ITITLE
45335      CHARACTER*1  ITITLZ
45336      CHARACTER*40 IDIST
45337      CHARACTER*40 ITEXT(MAXROW)
45338      REAL         AVALUE(MAXROW)
45339      INTEGER      NCTEXT(MAXROW)
45340      INTEGER      IDIGIT(MAXROW)
45341      INTEGER      NTOT(MAXROW)
45342      LOGICAL      IFRST
45343      LOGICAL      ILAST
45344C
45345C-------------------------------------------------------------------
45346C
45347      INCLUDE 'DPCOP2.INC'
45348C
45349C-----START POINT---------------------------------------------------
45350C
45351      ISUBN1='DPMG'
45352      ISUBN2='ET  '
45353      IERROR='NO'
45354      IWRITE='OFF'
45355C
45356      AMUMOM=CPUMIN
45357      BETAMO=CPUMIN
45358      AMUFR=CPUMIN
45359      BETAFR=CPUMIN
45360      AMUML=CPUMIN
45361      BETAML=CPUMIN
45362C
45363      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGET')THEN
45364        WRITE(ICOUT,999)
45365  999   FORMAT(1X)
45366        CALL DPWRST('XXX','WRIT')
45367        WRITE(ICOUT,51)
45368   51   FORMAT('**** AT THE BEGINNING OF DPMGET--')
45369        CALL DPWRST('XXX','WRIT')
45370        WRITE(ICOUT,52)IBUGA3,ISUBRO,IGETDF,N,NVAR
45371   52   FORMAT('IBUGA3,ISUBRO,IGETDF,N,NVAR = ',3(A4,2X),2I8)
45372        CALL DPWRST('XXX','WRIT')
45373        IF(NVAR.EQ.1)THEN
45374          DO56I=1,MIN(N,100)
45375            WRITE(ICOUT,57)I,Y(I)
45376   57       FORMAT('I,Y(I) = ',I8,G15.7)
45377            CALL DPWRST('XXX','WRIT')
45378   56     CONTINUE
45379        ELSE
45380          DO61I=1,N
45381            WRITE(ICOUT,62)I,X(I),Y(I)
45382   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
45383            CALL DPWRST('XXX','WRIT')
45384   61     CONTINUE
45385        ENDIF
45386      ENDIF
45387C
45388C               ********************************************
45389C               **  STEP 11--                             **
45390C               **  1) ROUND DATA TO INTEGER VALUES       **
45391C               **  2) COMPUTE SUMMARY STATISTICS         **
45392C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
45393C               **     INSUFFICIENT SAMPLE SIZE           **
45394C               ********************************************
45395C
45396      ISTEPN='11'
45397      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGET')
45398     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45399C
45400      IDIST='GEETA'
45401C
45402      NPERC=0
45403      MAXGRP=MAXNXT/2
45404      NMIN=2
45405      IF(NVAR.EQ.1)THEN
45406        DO1105I=1,N
45407          ITEMP=INT(Y(I)+0.5)
45408          Y(I)=REAL(ITEMP)
45409 1105   CONTINUE
45410        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
45411        IF(IERROR.EQ.'YES')GOTO9000
45412C
45413        IFLAG=1
45414        CALL SUMRAW(Y,N,IDIST,IFLAG,
45415     1              XMEAN,XVAR,XSD,XMIN,XMAX,
45416     1              ISUBRO,IBUGA3,IERROR)
45417        IF(IERROR.EQ.'YES')GOTO9000
45418        NTOTZZ=N
45419C
45420C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
45421C
45422        IRELAT='OFF'
45423        IRHSTG='OFF'
45424        XSTART=XMIN-0.5
45425        XSTOP=XMAX+0.5
45426        CLWID=1.0
45427        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
45428     1              TEMP1,X,N2,IBUGA3,IERROR)
45429        ICNT=0
45430        DO1121I=1,N2
45431          Y(I)=TEMP1(I)
45432          IF(Y(I).GT.0.0)THEN
45433            ICNT=ICNT+1
45434            Y(ICNT)=Y(I)
45435            X(ICNT)=X(I)
45436          ENDIF
454371121    CONTINUE
45438        N2=ICNT
45439      ELSE
45440        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
45441     1              ISUBRO,IBUGA3,IERROR)
45442        IF(IERROR.EQ.'YES')GOTO9000
45443        IFLAG1=1
45444        IFLAG2=1
45445        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
45446     1              TEMP1,TEMP2,TEMP3,MAXNXT,
45447     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
45448     1              ISUBRO,IBUGA3,IERROR)
45449        ICNT=0
45450        NTOTZZ=0
45451        DO1211I=1,N
45452          IF(Y(I).GT.0.0)THEN
45453            ICNT=ICNT+1
45454            Y(ICNT)=Y(I)
45455            X(ICNT)=X(I)
45456            NTOTZZ=NTOTZZ + INT(Y(I)+0.01)
45457          ENDIF
454581211    CONTINUE
45459        N2=ICNT
45460      ENDIF
45461      IF(IERROR.EQ.'YES')GOTO9000
45462C
45463      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGET')THEN
45464        WRITE(ICOUT,999)
45465        CALL DPWRST('XXX','WRIT')
45466        WRITE(ICOUT,1311)
45467 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
45468        CALL DPWRST('XXX','WRIT')
45469        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
45470 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
45471        CALL DPWRST('XXX','WRIT')
45472      ENDIF
45473C
45474C               *********************************************
45475C               **  STEP 21--                              **
45476C               **  CARRY OUT CALCULATIONS                 **
45477C               **  FOR GEETA MLE                          **
45478C               **  ESTIMATION                             **
45479C               *********************************************
45480C
45481      ISTEPN='21'
45482      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGET')
45483     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45484C
45485      F1=Y(1)/REAL(NTOTZZ)
45486      IINDX=MAXNXT/2
45487      IF(N2.LE.IINDX)THEN
45488        IML=0
45489        DO2210I=1,N2
45490          TEMP3(I)=Y(I)
45491          TEMP3(IINDX+I)=X(I)
45492 2210   CONTINUE
45493        IK=N2
45494      ELSE
45495        IML=1
45496      ENDIF
45497C
45498      ACUT=XMEAN**2*(XMEAN-1.0)
45499      IF(XVAR.LE.ACUT)THEN
45500        WRITE(ICOUT,999)
45501        CALL DPWRST('XXX','WRIT')
45502        WRITE(ICOUT,1131)
45503 1131   FORMAT('***** ERROR IN GEETA MAXIMUM LIKELIHOOD--')
45504        CALL DPWRST('XXX','WRIT')
45505        WRITE(ICOUT,2223)
45506 2223   FORMAT('      IN ORDER FOR THE GEETA DISTRIBUTION TO BE ',
45507     1         'APPLICABLE,')
45508        CALL DPWRST('XXX','WRIT')
45509        WRITE(ICOUT,2225)
45510 2225   FORMAT('         S**2 > XBAR**2*(XBAR - 1)')
45511        CALL DPWRST('XXX','WRIT')
45512        WRITE(ICOUT,2227)
45513 2227   FORMAT('      SUCH WAS NOT THE CASE HERE.')
45514        CALL DPWRST('XXX','WRIT')
45515        WRITE(ICOUT,2228)XMEAN
45516 2228   FORMAT('      SAMPLE MEAN     = ',G15.7)
45517        CALL DPWRST('XXX','WRIT')
45518        WRITE(ICOUT,2229)XVAR
45519 2229   FORMAT('      SAMPLE VARIANCE = ',G15.7)
45520        CALL DPWRST('XXX','WRIT')
45521        GOTO9000
45522      ENDIF
45523C
45524      AMUMOM=XMEAN
45525      BETAMO=(XVAR - XMEAN*(XMEAN-1.0))/(XVAR - XMEAN**2*(XMEAN-1.0))
45526      AMUFR=XMEAN
45527      BETAFR=0.0
45528      AMUML=XMEAN
45529      BETAML=0.0
45530C
45531      AE=1.D-7
45532      RE=1.D-7
45533      XBAR=DBLE(XMEAN)
45534      S2=DBLE(XSD)**2
45535      F1FREQ=DBLE(F1)
45536      XMID=DBLE(BETAMO)
45537      XLOW=1.000001D0
45538      XUP=XMID + 10.0D0
45539      CALL DFZERO(GETFUN,XLOW,XUP,XMID,RE,AE,IFLAG)
45540      BETAFR=REAL(XLOW)
45541C
45542      IOPT=2
45543      TOL=1.0D-3
45544      NPAR=1
45545      NPRINT=-1
45546      INFO=0
45547      LWA=MAXNXT
45548      MAXRO2=MAXNXT
45549      NTOT2=NTOTZZ
45550C
45551      XPAR(1)=DBLE(BETAFR)
45552      XPAR(1)=1.5D0
45553      CALL DNSQE(GETFU2,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
45554     1             DTEMP1,LWA,TEMP3,IK)
45555C
45556      BETAML=REAL(XPAR(1))
45557C
45558C               ***********************************************
45559C               **   STEP 42--                               **
45560C               **   WRITE OUT EVERYTHING                    **
45561C               **   FOR GEETA MLE                           **
45562C               **   ESTIMATION                              **
45563C               ***********************************************
45564C
45565      ISTEPN='42'
45566      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGET')
45567     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45568C
45569C     PRINT SUMMARY STATISTICS TABLE
45570C
45571      NUMDIG=7
45572      IF(IFORSW.EQ.'1')NUMDIG=1
45573      IF(IFORSW.EQ.'2')NUMDIG=2
45574      IF(IFORSW.EQ.'3')NUMDIG=3
45575      IF(IFORSW.EQ.'4')NUMDIG=4
45576      IF(IFORSW.EQ.'5')NUMDIG=5
45577      IF(IFORSW.EQ.'6')NUMDIG=6
45578      IF(IFORSW.EQ.'7')NUMDIG=7
45579      IF(IFORSW.EQ.'8')NUMDIG=8
45580      IF(IFORSW.EQ.'9')NUMDIG=9
45581      IF(IFORSW.EQ.'0')NUMDIG=0
45582      IF(IFORSW.EQ.'E')NUMDIG=-2
45583      IF(IFORSW.EQ.'-2')NUMDIG=-2
45584      IF(IFORSW.EQ.'-3')NUMDIG=-3
45585      IF(IFORSW.EQ.'-4')NUMDIG=-4
45586      IF(IFORSW.EQ.'-5')NUMDIG=-5
45587      IF(IFORSW.EQ.'-6')NUMDIG=-6
45588      IF(IFORSW.EQ.'-7')NUMDIG=-7
45589      IF(IFORSW.EQ.'-8')NUMDIG=-8
45590      IF(IFORSW.EQ.'-9')NUMDIG=-9
45591C
45592      ITITLE='Geeta Parameter Estimation'
45593      NCTITL=42
45594      ITITLZ=' '
45595      NCTITZ=0
45596C
45597      ICNT=1
45598      ITEXT(ICNT)='Summary Statistics:'
45599      NCTEXT(ICNT)=19
45600      AVALUE(ICNT)=0.0
45601      IDIGIT(ICNT)=-1
45602      ICNT=ICNT+1
45603      ITEXT(ICNT)='Number of Observations:'
45604      NCTEXT(ICNT)=23
45605      AVALUE(ICNT)=REAL(NTOTZZ)
45606      IDIGIT(ICNT)=0
45607      ICNT=ICNT+1
45608      ITEXT(ICNT)='Sample Mean:'
45609      NCTEXT(ICNT)=12
45610      AVALUE(ICNT)=XMEAN
45611      IDIGIT(ICNT)=NUMDIG
45612      ICNT=ICNT+1
45613      ITEXT(ICNT)='Sample Standard Deviation:'
45614      NCTEXT(ICNT)=26
45615      AVALUE(ICNT)=XSD
45616      IDIGIT(ICNT)=NUMDIG
45617      ICNT=ICNT+1
45618      ITEXT(ICNT)='Sample Minimum:'
45619      NCTEXT(ICNT)=15
45620      AVALUE(ICNT)=XMIN
45621      IDIGIT(ICNT)=NUMDIG
45622      ICNT=ICNT+1
45623      ITEXT(ICNT)='Sample Maximum:'
45624      NCTEXT(ICNT)=15
45625      AVALUE(ICNT)=XMAX
45626      IDIGIT(ICNT)=NUMDIG
45627      ICNT=ICNT+1
45628      ITEXT(ICNT)='Sample First Frequency:'
45629      NCTEXT(ICNT)=23
45630      AVALUE(ICNT)=F1
45631      IDIGIT(ICNT)=NUMDIG
45632      ICNT=ICNT+1
45633      ITEXT(ICNT)=' '
45634      NCTEXT(ICNT)=0
45635      AVALUE(ICNT)=0.0
45636      IDIGIT(ICNT)=-1
45637C
45638      ICNT=ICNT+1
45639      ITEXT(ICNT)='Method of Moments:'
45640      NCTEXT(ICNT)=18
45641      AVALUE(ICNT)=0.0
45642      IDIGIT(ICNT)=-1
45643      ICNT=ICNT+1
45644      IF(IGETDF.EQ.'THET')THEN
45645        ITEXT(ICNT)='Estimate of Theta:'
45646        NCTEXT(ICNT)=18
45647      ELSE
45648        ITEXT(ICNT)='Estimate of Mu:'
45649        NCTEXT(ICNT)=15
45650      ENDIF
45651      AVALUE(ICNT)=AMUMOM
45652      IDIGIT(ICNT)=NUMDIG
45653      ICNT=ICNT+1
45654      ITEXT(ICNT)='Estimate of Beta:'
45655      NCTEXT(ICNT)=17
45656      AVALUE(ICNT)=BETAMO
45657      IDIGIT(ICNT)=NUMDIG
45658      ICNT=ICNT+1
45659      ITEXT(ICNT)=' '
45660      NCTEXT(ICNT)=0
45661      AVALUE(ICNT)=0.0
45662      IDIGIT(ICNT)=-1
45663C
45664      ICNT=ICNT+1
45665      ITEXT(ICNT)='Method of First Frequency and Mean:'
45666      NCTEXT(ICNT)=35
45667      AVALUE(ICNT)=0.0
45668      IDIGIT(ICNT)=-1
45669      ICNT=ICNT+1
45670      IF(IGETDF.EQ.'THET')THEN
45671        ITEXT(ICNT)='Estimate of Theta:'
45672        NCTEXT(ICNT)=18
45673      ELSE
45674        ITEXT(ICNT)='Estimate of Mu:'
45675        NCTEXT(ICNT)=15
45676      ENDIF
45677      AVALUE(ICNT)=AMUFR
45678      IDIGIT(ICNT)=NUMDIG
45679      ICNT=ICNT+1
45680      ITEXT(ICNT)='Estimate of Beta:'
45681      NCTEXT(ICNT)=17
45682      AVALUE(ICNT)=BETAFR
45683      IDIGIT(ICNT)=NUMDIG
45684      ICNT=ICNT+1
45685      ITEXT(ICNT)=' '
45686      NCTEXT(ICNT)=0
45687      AVALUE(ICNT)=0.0
45688      IDIGIT(ICNT)=-1
45689C
45690      ICNT=ICNT+1
45691      ITEXT(ICNT)='Method of Maximum Likelihood:'
45692      NCTEXT(ICNT)=29
45693      AVALUE(ICNT)=0.0
45694      IDIGIT(ICNT)=-1
45695      ICNT=ICNT+1
45696      IF(IGETDF.EQ.'THET')THEN
45697        ITEXT(ICNT)='Estimate of Theta:'
45698        NCTEXT(ICNT)=18
45699      ELSE
45700        ITEXT(ICNT)='Estimate of Mu:'
45701        NCTEXT(ICNT)=15
45702      ENDIF
45703      AVALUE(ICNT)=AMUML
45704      IDIGIT(ICNT)=NUMDIG
45705      ICNT=ICNT+1
45706      ITEXT(ICNT)='Estimate of Beta:'
45707      NCTEXT(ICNT)=17
45708      AVALUE(ICNT)=BETAML
45709      IDIGIT(ICNT)=NUMDIG
45710      ICNT=ICNT+1
45711      ITEXT(ICNT)=' '
45712      NCTEXT(ICNT)=0
45713      AVALUE(ICNT)=0.0
45714      IDIGIT(ICNT)=-1
45715C
45716      NUMROW=ICNT
45717      DO2310I=1,NUMROW
45718        NTOT(I)=15
45719 2310 CONTINUE
45720C
45721      IFRST=.TRUE.
45722      ILAST=.TRUE.
45723      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
45724     1            AVALUE,IDIGIT,
45725     1            NTOT,NUMROW,
45726     1            ICAPSW,ICAPTY,ILAST,IFRST,
45727     1            ISUBRO,IBUGA3,IERROR)
45728C
45729C               *****************
45730C               **  STEP 90--  **
45731C               **  EXIT       **
45732C               *****************
45733C
45734 9000 CONTINUE
45735      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGET')THEN
45736        WRITE(ICOUT,999)
45737        CALL DPWRST('XXX','WRIT')
45738        WRITE(ICOUT,9011)
45739 9011   FORMAT('***** AT THE END       OF DPMGET--')
45740        CALL DPWRST('XXX','WRIT')
45741        WRITE(ICOUT,9013)AMUMOM,BETAMO,AMUFR,BETAFR,AMUML,BETAML
45742 9013   FORMAT('AMUMOM,BETAMO,AMUFR,BETAFR,AMUML,BETAML = ',6G15.7)
45743        CALL DPWRST('XXX','WRIT')
45744      ENDIF
45745C
45746      RETURN
45747      END
45748      SUBROUTINE DPMGNB(Y,X,N,NVAR,
45749     1                  TEMP1,TEMP2,TEMP3,DTEMP1,
45750     1                  THETMO,BETAMO,AMMOM,
45751     1                  THETFR,BETAFR,AMFR,
45752     1                  THETF2,BETAF2,AMF2,
45753     1                  THETML,BETAML,AMML,
45754     1                  ICAPSW,ICAPTY,IFORSW,MAXNXT,
45755     1                  ISUBRO,IBUGA3,IERROR)
45756C
45757C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
45758C              ESTIMATES FOR THE GENERALIZED NEGATIVE BINOMIAL
45759C              DISTRIBUTION.
45760C
45761C              THE MOMENT ESTIMATE OF THETA IS THE SOLUTION
45762C              OF THE EQUATION:
45763C
45764C                 THETAHAT = 1 - 0.5*A + (A**2/4 - 1)**(0.5)
45765C                 A = -2 + (XBAR*S3 - 3*S2**2)**2/(XBAR*S2**3)
45766C
45767C                 BETAHAT = {1 - SQRT(XBAR*(1-THETAHAT)/S2)}/THETAHAT
45768C                 MHAT = XBAR*(1-THETAHAT*BETAHAT)/THETAHAT
45769C
45770C                 S2 = SAMPLE VARIANCE
45771C                 S3 = SAMPLE THIRD SAMPLE MOMENT
45772C                      (SUM[i=0 to k][N(i)*(i-XBAR)**3/(N-1) =
45773C                       SUM[j=1 to n][(X(j) - XBAR)**2]
45774C
45775C              THE MOMENTS AND ZERO FREQUENCY ESTIMATE OF THETA
45776C              IS THE SOLUTION OF THE EQUATION
45777C
45778C                 S2*(LOG(F0)**2/XBAR**3 -
45779C                 (1-THETA)*(LOG(1-THETA))**2/THETA**2 = 0
45780C
45781C                 MHAT = SQRT{(1-THETAHAT)*XBAR**3/S2}/THETAHAT
45782C                 BETAHAT = (1/THETAHAT) - MHAT/XBAR
45783C
45784C
45785C              THE MOMENTS AND RATIO OF FREQUENCIES ESTIMATE OF
45786C              THETA IS THE SOLUTION OF THE EQUATION
45787C
45788C                 {(2/THETA) - (2/THETA)*SQRT(XBAR*(1-THETA)/S2)-1}*
45789C                 LOG(1-THETA) - LOG(S2*F10**2/XBAR**3) = 0
45790C
45791C                 F10 = F1/F0
45792C
45793C                 MHAT = SQRT{(1-THETAHAT)*XBAR**3/S2}/THETA
45794C                 BETAHAT = (1/THETAHAT) - MHAT/XBAR
45795C
45796C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTIONS
45797C              TO THE EQUATIONS:
45798C
45799C                 (N-N0)*XBAR/M - SUM[X=2 to k][SUM[i=1 to x-1]
45800C                 [(X-XBAR)*N(x)/(M+BETA*X-i]] = 0
45801C
45802C                 N*XBAR*LOG(1-XBAR/(M+BETA*XBAR)) +
45803C                 SUM[X=2 to k][SUM[i=1 to x-1]
45804C                 [X*N(x)/(M+BETA*X-i]] = 0
45805C
45806C                 THETAHAT = XBAR/(MHAT+BETA*XBAR)
45807C
45808C              THERE ARE TWO CASES:
45809C
45810C              1) ONE VARIABLE CASE: Y IS RAW DATA
45811C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
45812C                 MID-POINT.
45813C
45814C     EXAMPLE--GENERALIZED NEGATIVE BINOMIAL MAXIMUM LIKELIHOOD Y
45815C            --GENERALIZED NEGATIVE BINOMIAL MAXIMUM LIKELIHOOD Y X
45816C     REFERENCES--CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
45817C                 DISTRIBUTIONS", BIRKHAUSER, CHAPTER 10.
45818C     WRITTEN BY--ALAN HECKERT
45819C                 STATISTICAL ENGINEERING DIVISION
45820C                 INFORMATION TECHNOLOGY LABORATORY
45821C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
45822C                 GAITHERSBUG, MD 20899-8980
45823C                 PHONE--301-975-2899
45824C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
45825C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
45826C     LANGUAGE--ANSI FORTRAN (1977)
45827C     VERSION NUMBER--2006/7
45828C     ORIGINAL VERSION--JULY      2006.
45829C     UPDATED         --APRIL     2011.
45830C
45831C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
45832C
45833      CHARACTER*4 ICAPSW
45834      CHARACTER*4 ICAPTY
45835      CHARACTER*4 IFORSW
45836      CHARACTER*4 ISUBRO
45837      CHARACTER*4 IBUGA3
45838      CHARACTER*4 IERROR
45839C
45840      CHARACTER*4 IWRITE
45841      CHARACTER*4 ISUBN1
45842      CHARACTER*4 ISUBN2
45843      CHARACTER*4 ISTEPN
45844      CHARACTER*4 IRELAT
45845      CHARACTER*4 IRHSTG
45846C
45847      PARAMETER (MAXROW=50)
45848      CHARACTER*60 ITITLE
45849      CHARACTER*1  ITITLZ
45850      CHARACTER*40 IDIST
45851      CHARACTER*40 ITEXT(MAXROW)
45852      REAL         AVALUE(MAXROW)
45853      INTEGER      NCTEXT(MAXROW)
45854      INTEGER      IDIGIT(MAXROW)
45855      INTEGER      NTOT(MAXROW)
45856      LOGICAL      IFRST
45857      LOGICAL      ILAST
45858C
45859C-------------------------------------------------------------------
45860C
45861      DIMENSION Y(*)
45862      DIMENSION X(*)
45863      DIMENSION TEMP1(*)
45864      DIMENSION TEMP2(*)
45865      DIMENSION TEMP3(*)
45866      DOUBLE PRECISION DTEMP1(*)
45867C
45868      DOUBLE PRECISION TOL
45869      DOUBLE PRECISION XPAR(3)
45870      DOUBLE PRECISION FVEC(3)
45871C
45872      DOUBLE PRECISION AE
45873      DOUBLE PRECISION RE
45874      DOUBLE PRECISION XLOW
45875      DOUBLE PRECISION XUP
45876      DOUBLE PRECISION XMID
45877      DOUBLE PRECISION DSUM
45878      DOUBLE PRECISION DTERM1
45879      DOUBLE PRECISION DTERM2
45880      DOUBLE PRECISION DA
45881C
45882      DOUBLE PRECISION GNBFUN
45883      DOUBLE PRECISION GNBFU3
45884      DOUBLE PRECISION GNBFU4
45885      DOUBLE PRECISION GNBFU5
45886      EXTERNAL GNBFUN
45887      EXTERNAL GNBFU2
45888      EXTERNAL GNBFU3
45889      EXTERNAL GNBFU4
45890      EXTERNAL GNBFU5
45891      DOUBLE PRECISION XBAR
45892      DOUBLE PRECISION S2
45893      DOUBLE PRECISION S3
45894      DOUBLE PRECISION F0FREQ
45895      DOUBLE PRECISION F1FREQ
45896      DOUBLE PRECISION F10FRE
45897      DOUBLE PRECISION DC1
45898      COMMON/GNBCOM/XBAR,S2,S3,F0FREQ,F1FREQ,F10FRE,DC1,
45899     1              MAXRO2,NTOT2
45900C
45901C-------------------------------------------------------------------
45902C
45903      INCLUDE 'DPCOP2.INC'
45904C
45905C-----START POINT---------------------------------------------------
45906C
45907      ISUBN1='DPMG'
45908      ISUBN2='NB  '
45909      IERROR='NO'
45910      IWRITE='OFF'
45911C
45912      THETMO=CPUMIN
45913      BETAMO=CPUMIN
45914      AMMOM=CPUMIN
45915      THETFR=CPUMIN
45916      BETAFR=CPUMIN
45917      AMFR=CPUMIN
45918      THETF2=CPUMIN
45919      BETAF2=CPUMIN
45920      AMF2=CPUMIN
45921      THETML=CPUMIN
45922      BETAML=CPUMIN
45923      AMML=CPUMIN
45924C
45925      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGNB')THEN
45926        WRITE(ICOUT,999)
45927  999   FORMAT(1X)
45928        CALL DPWRST('XXX','WRIT')
45929        WRITE(ICOUT,51)
45930   51   FORMAT('**** AT THE BEGINNING OF DPMGNB--')
45931        CALL DPWRST('XXX','WRIT')
45932        WRITE(ICOUT,52)IBUGA3,ISUBRO,N,NVAR
45933   52   FORMAT('IBUGA3,ISUBRO,N,NVAR = ',2(A4,2X),2I8)
45934        CALL DPWRST('XXX','WRIT')
45935        IF(NVAR.EQ.1)THEN
45936          DO56I=1,MIN(N,100)
45937            WRITE(ICOUT,57)I,Y(I)
45938   57       FORMAT('I,Y(I) = ',I8,G15.7)
45939            CALL DPWRST('XXX','WRIT')
45940   56     CONTINUE
45941        ELSE
45942          DO61I=1,N
45943            WRITE(ICOUT,62)I,X(I),Y(I)
45944   62       FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
45945            CALL DPWRST('XXX','WRIT')
45946   61     CONTINUE
45947        ENDIF
45948      ENDIF
45949C
45950C               ********************************************
45951C               **  STEP 11--                             **
45952C               **  1) ROUND DATA TO INTEGER VALUES       **
45953C               **  2) COMPUTE SUMMARY STATISTICS         **
45954C               **  3) CHECK INPUT FOR NEGATIVE VALUES,   **
45955C               **     INSUFFICIENT SAMPLE SIZE           **
45956C               ********************************************
45957C
45958      ISTEPN='11'
45959      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLAE')
45960     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
45961C
45962      IDIST='GENERALIZED NEGATIVE BINOMIAL'
45963C
45964      NPERC=0
45965      MAXGRP=MAXNXT/2
45966      NMIN=2
45967      IF(NVAR.EQ.1)THEN
45968        DO1105I=1,N
45969          ITEMP=INT(Y(I)+0.5)
45970          Y(I)=REAL(ITEMP)
45971 1105   CONTINUE
45972        CALL CKDIST(Y,N,NMIN,TEMP1,NPERC,ISUBRO,IBUGA3,IERROR)
45973        IF(IERROR.EQ.'YES')GOTO9000
45974C
45975        IFLAG=1
45976        CALL SUMRAW(Y,N,IDIST,IFLAG,
45977     1              XMEAN,XVAR,XSD,XMIN,XMAX,
45978     1              ISUBRO,IBUGA3,IERROR)
45979        IF(IERROR.EQ.'YES')GOTO9000
45980        NTOTZZ=N
45981C
45982C       NOW BIN THE DATA FOR USE BY THE ESTIMATION METHOD BELOW
45983C
45984        IRELAT='OFF'
45985        IRHSTG='OFF'
45986        XSTART=XMIN-0.5
45987        XSTOP=XMAX+0.5
45988        CLWID=1.0
45989        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
45990     1              TEMP1,X,N2,IBUGA3,IERROR)
45991        ICNT=0
45992        DO1121I=1,N2
45993          IF(TEMP1(I).GT.0.0)THEN
45994            ICNT=ICNT+1
45995            Y(ICNT)=TEMP1(I)
45996            X(ICNT)=X(I)
45997          ENDIF
459981121    CONTINUE
45999        N2=ICNT
46000      ELSE
46001        CALL CKDIS2(Y,X,TEMP1,N,MAXGRP,NMIN,TEMP2,NPERC,NTOTZZ,
46002     1              ISUBRO,IBUGA3,IERROR)
46003        IF(IERROR.EQ.'YES')GOTO9000
46004        IFLAG1=1
46005        IFLAG2=1
46006        CALL SUMGRP(Y,X,N,IDIST,IFLAG1,IFLAG2,
46007     1              TEMP1,TEMP2,TEMP3,MAXNXT,
46008     1              XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ,
46009     1              ISUBRO,IBUGA3,IERROR)
46010        ICNT=0
46011        DO1221I=1,N
46012          IF(Y(I).GT.0.0)THEN
46013            ICNT=ICNT+1
46014            Y(ICNT)=Y(I)
46015            X(ICNT)=X(I)
46016          ENDIF
460171221    CONTINUE
46018        N2=ICNT
46019      ENDIF
46020      IF(IERROR.EQ.'YES')GOTO9000
46021C
46022      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGNB')THEN
46023        WRITE(ICOUT,999)
46024        CALL DPWRST('XXX','WRIT')
46025        WRITE(ICOUT,1311)
46026 1311   FORMAT('AFTER COMPUTE SUMMARY STATISTICS--')
46027        CALL DPWRST('XXX','WRIT')
46028        WRITE(ICOUT,1312)XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ
46029 1312   FORMAT('XMEAN,XVAR,XSD,XMIN,XMAX,NTOTZZ = ',5G15.7,I10)
46030        CALL DPWRST('XXX','WRIT')
46031      ENDIF
46032C
46033C               *********************************************
46034C               **  STEP 21--                              **
46035C               **  CARRY OUT CALCULATIONS                 **
46036C               **  FOR GENERALIZED NEGATIVE BINOMIAL MLE  **
46037C               **  ESTIMATION                             **
46038C               *********************************************
46039C
46040      ISTEPN='21'
46041      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGNB')
46042     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46043C
46044      IML=0
46045      IINDX=MAXNXT/2
46046      IF(N2.LE.IINDX)THEN
46047        IWD=0
46048        DO2290I=1,N2
46049          TEMP3(I)=Y(I)
46050          TEMP3(IINDX+I)=X(I)
46051 2290   CONTINUE
46052        IK=N2
46053      ELSE
46054        IML=1
46055      ENDIF
46056C
46057      F0=Y(1)
46058      F1=Y(2)
46059      F10=F0/F1
46060C
46061      DSUM=0.0D0
46062      DO2208I=1,N2
46063        DSUM=DSUM +  DBLE(Y(I))*(DBLE(I) - DBLE(XMEAN))**3
46064 2208 CONTINUE
46065      S3=REAL(DSUM/DBLE(NTOTZZ-1))
46066C
46067      XBAR=DBLE(XMEAN)
46068      S2=DBLE(XSD)**2
46069      DA=-2.0D0 + (XBAR*S3 - 3.0D0*S2**2)**2/(XBAR*S2**3)
46070      THETMO=REAL(1.0D0 - 0.5D0*DA + DSQRT(DA**2/4.0D0 - 1.0D0))
46071      BETAMO=(1.0 - SQRT(XBAR*(1.0-THETMO)/S2))/THETMO
46072      IF(BETAMO.LE.1.0)BETAMO=1.0
46073      AMMOM=XBAR*(1.0-THETMO*BETAMO)/THETMO
46074C
46075      AE=1.D-7
46076      RE=1.D-7
46077      XLOW=0.000001D0
46078      XUP=0.999999D0
46079      XMID=0.5D0
46080      F0FREQ=DBLE(F0)
46081      F1FREQ=DBLE(F1)
46082      F10FRE=DBLE(F10)
46083      NTOT2=NTOTZZ
46084C
46085      IFR=0
46086      IF(F0.GT.0.0)THEN
46087        C1=S2*LOG(F0)**2/(XBAR**3)
46088        IF(C1.GE.1.0 .OR. C1.LE.0.0)IFR=1
46089      ELSE
46090        IFR=1
46091      ENDIF
46092      IF(IFR.EQ.0)THEN
46093        DC1=DBLE(C1)
46094        XLOW=0.000001D0
46095        XUP=0.999999D0
46096        XMID=DBLE(THETMO)
46097        CALL DFZERO(GNBFU3,XLOW,XUP,XMID,RE,AE,IFLAG)
46098        THETFR=REAL(XLOW)
46099        AMFR=SQRT((1.0-THETFR)*XMEAN**3/XVAR)/THETFR
46100        BETAFR=(1.0/THETFR) - (AMFR/XMEAN)
46101        IF(BETAFR.LE.1.0)BETAFR=1.0
46102      ENDIF
46103C
46104      IFR2=0
46105      XLOW=0.000001D0
46106      XUP=0.999999D0
46107      DTERM1=GNBFU4(XLOW)
46108      DTERM2=GNBFU4(XUP)
46109      IF(DTERM1*DTERM2.GT.0.0D0)THEN
46110        IFR2=1
46111      ENDIF
46112      IF(IFR2.EQ.0)THEN
46113        XMID=DBLE(THETMO)
46114        CALL DFZERO(GNBFU4,XLOW,XUP,XMID,RE,AE,IFLAG)
46115        THETF2=REAL(XLOW)
46116        AMF2=SQRT((1.0-THETF2)*XMEAN**3/XVAR)/THETF2
46117        BETAF2=(1.0/THETF2) - (AMF2/XMEAN)
46118        IF(BETAF2.LE.1.0)BETAF2=1.0
46119      ENDIF
46120C
46121      IF(IML.EQ.0)THEN
46122        IOPT=2
46123        TOL=1.0D-5
46124        NPAR=3
46125        NPRINT=-1
46126        INFO=0
46127        LWA=MAXNXT
46128        MAXRO2=MAXNXT
46129C
46130        IF(IFR2.EQ.0)THEN
46131          XPAR(1)=DBLE(BETAF2)
46132          XPAR(2)=DBLE(AMF2)
46133          XPAR(3)=DBLE(THETF2)
46134        ELSEIF(IFR.EQ.0)THEN
46135          XPAR(1)=DBLE(BETAFR)
46136          XPAR(2)=DBLE(AMFR)
46137          XPAR(3)=DBLE(THETFR)
46138        ELSE
46139          XPAR(1)=DBLE(BETAMO)
46140          XPAR(2)=DBLE(BETAMO)
46141          XPAR(3)=DBLE(THETMO)
46142        ENDIF
46143        CALL DNSQE(GNBFU2,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
46144     1             DTEMP1,LWA,TEMP3,IK)
46145C
46146        BETAML=REAL(XPAR(1))
46147        AMML=REAL(XPAR(2))
46148        THETML=REAL(XPAR(3))
46149      ENDIF
46150C
46151C     1/2007: NOW DO THE TRUNCATED CASE.
46152C
46153C     METHOD 1: MEAN AND RATIO OF FREQUENCIES (RATIO METHOD)
46154C
46155      AE=1.D-7
46156      RE=1.D-7
46157      XLOW=0.005D0
46158      XMID=DBLE(AMMOM)
46159      XUP=5.0D0*XMID
46160      F0FREQ=DBLE(F0)
46161      F1FREQ=DBLE(F1)
46162      F10FRE=DBLE(F10)
46163      NTOT2=NTOTZZ
46164C
46165CCCCC CALL DFZERO(GNBFU3,XLOW,XUP,XMID,RE,AE,IFLAG)
46166CCCCC AMRA=REAL(XLOW)
46167CCCCC BETARA=AMRA*F0FREQ*F2FREQ/(F1FREQ**2) - (AMRA-1.0)/2.0
46168CCCCC print *,'amra,betara=',amra,betara
46169CCCCC THETRA=
46170C
46171C
46172C               ***********************************************
46173C               **   STEP 42--                               **
46174C               **   WRITE OUT EVERYTHING                    **
46175C               **   FOR GENERALIZED NEGATIVE BINOMIAL MLE   **
46176C               **   ESTIMATION                              **
46177C               ***********************************************
46178C
46179      ISTEPN='42'
46180      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGNB')
46181     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46182C
46183C     PRINT SUMMARY STATISTICS TABLE
46184C
46185      NUMDIG=7
46186      IF(IFORSW.EQ.'1')NUMDIG=1
46187      IF(IFORSW.EQ.'2')NUMDIG=2
46188      IF(IFORSW.EQ.'3')NUMDIG=3
46189      IF(IFORSW.EQ.'4')NUMDIG=4
46190      IF(IFORSW.EQ.'5')NUMDIG=5
46191      IF(IFORSW.EQ.'6')NUMDIG=6
46192      IF(IFORSW.EQ.'7')NUMDIG=7
46193      IF(IFORSW.EQ.'8')NUMDIG=8
46194      IF(IFORSW.EQ.'9')NUMDIG=9
46195      IF(IFORSW.EQ.'0')NUMDIG=0
46196      IF(IFORSW.EQ.'E')NUMDIG=-2
46197      IF(IFORSW.EQ.'-2')NUMDIG=-2
46198      IF(IFORSW.EQ.'-3')NUMDIG=-3
46199      IF(IFORSW.EQ.'-4')NUMDIG=-4
46200      IF(IFORSW.EQ.'-5')NUMDIG=-5
46201      IF(IFORSW.EQ.'-6')NUMDIG=-6
46202      IF(IFORSW.EQ.'-7')NUMDIG=-7
46203      IF(IFORSW.EQ.'-8')NUMDIG=-8
46204      IF(IFORSW.EQ.'-9')NUMDIG=-9
46205C
46206      ITITLE='Generalized Negative Binomial Parameter Estimation'
46207      NCTITL=50
46208      ITITLZ=' '
46209      NCTITZ=0
46210C
46211      ICNT=1
46212      ITEXT(ICNT)='Summary Statistics:'
46213      NCTEXT(ICNT)=19
46214      AVALUE(ICNT)=0.0
46215      IDIGIT(ICNT)=-1
46216      ICNT=ICNT+1
46217      ITEXT(ICNT)='Number of Observations:'
46218      NCTEXT(ICNT)=23
46219      AVALUE(ICNT)=REAL(NTOTZZ)
46220      IDIGIT(ICNT)=0
46221      ICNT=ICNT+1
46222      ITEXT(ICNT)='Sample Mean:'
46223      NCTEXT(ICNT)=12
46224      AVALUE(ICNT)=XMEAN
46225      IDIGIT(ICNT)=NUMDIG
46226      ICNT=ICNT+1
46227      ITEXT(ICNT)='Sample Standard Deviation:'
46228      NCTEXT(ICNT)=26
46229      AVALUE(ICNT)=XSD
46230      IDIGIT(ICNT)=NUMDIG
46231      ICNT=ICNT+1
46232      ITEXT(ICNT)='Sample Centralized Third Moment:'
46233      NCTEXT(ICNT)=32
46234      AVALUE(ICNT)=REAL(S3)
46235      IDIGIT(ICNT)=NUMDIG
46236      ICNT=ICNT+1
46237      ITEXT(ICNT)='Sample Minimum:'
46238      NCTEXT(ICNT)=15
46239      AVALUE(ICNT)=XMIN
46240      IDIGIT(ICNT)=NUMDIG
46241      ICNT=ICNT+1
46242      ITEXT(ICNT)='Sample Maximum:'
46243      NCTEXT(ICNT)=15
46244      AVALUE(ICNT)=XMAX
46245      IDIGIT(ICNT)=NUMDIG
46246      ICNT=ICNT+1
46247      ITEXT(ICNT)='Sample Zero-Class Frequency:'
46248      NCTEXT(ICNT)=28
46249      AVALUE(ICNT)=F0
46250      IDIGIT(ICNT)=NUMDIG
46251      ICNT=ICNT+1
46252      ITEXT(ICNT)='Sample Ones-Class Frequency:'
46253      NCTEXT(ICNT)=28
46254      AVALUE(ICNT)=F1
46255      IDIGIT(ICNT)=NUMDIG
46256      IDIGIT(ICNT)=NUMDIG
46257      ICNT=ICNT+1
46258      ITEXT(ICNT)='Ratio of Ones- and Zero-Frequencies:'
46259      NCTEXT(ICNT)=36
46260      AVALUE(ICNT)=F10
46261      ICNT=ICNT+1
46262      ITEXT(ICNT)=' '
46263      NCTEXT(ICNT)=0
46264      AVALUE(ICNT)=0.0
46265      IDIGIT(ICNT)=-1
46266C
46267      ICNT=ICNT+1
46268      ITEXT(ICNT)='Method of Moments:'
46269      NCTEXT(ICNT)=18
46270      AVALUE(ICNT)=0.0
46271      IDIGIT(ICNT)=-1
46272      ICNT=ICNT+1
46273      ITEXT(ICNT)='Estimate of Theta:'
46274      NCTEXT(ICNT)=18
46275      AVALUE(ICNT)=THETMO
46276      IDIGIT(ICNT)=NUMDIG
46277      ICNT=ICNT+1
46278      ITEXT(ICNT)='Estimate of Beta:'
46279      NCTEXT(ICNT)=17
46280      AVALUE(ICNT)=BETAMO
46281      IDIGIT(ICNT)=NUMDIG
46282      ICNT=ICNT+1
46283      ITEXT(ICNT)='Estimate of M:'
46284      NCTEXT(ICNT)=14
46285      AVALUE(ICNT)=AMMOM
46286      IDIGIT(ICNT)=NUMDIG
46287      ICNT=ICNT+1
46288      ITEXT(ICNT)=' '
46289      NCTEXT(ICNT)=0
46290      AVALUE(ICNT)=0.0
46291      IDIGIT(ICNT)=-1
46292C
46293      ICNT=ICNT+1
46294      ITEXT(ICNT)='Method of Zero-Class Frequency/Moments:'
46295      NCTEXT(ICNT)=39
46296      AVALUE(ICNT)=0.0
46297      IDIGIT(ICNT)=-1
46298      ICNT=ICNT+1
46299      ITEXT(ICNT)='Estimate of Theta:'
46300      NCTEXT(ICNT)=18
46301      AVALUE(ICNT)=THETFR
46302      IDIGIT(ICNT)=NUMDIG
46303      ICNT=ICNT+1
46304      ITEXT(ICNT)='Estimate of Beta:'
46305      NCTEXT(ICNT)=17
46306      AVALUE(ICNT)=BETAFR
46307      IDIGIT(ICNT)=NUMDIG
46308      ICNT=ICNT+1
46309      ITEXT(ICNT)='Estimate of M:'
46310      NCTEXT(ICNT)=14
46311      AVALUE(ICNT)=AMFR
46312      IDIGIT(ICNT)=NUMDIG
46313      ICNT=ICNT+1
46314      ITEXT(ICNT)=' '
46315      NCTEXT(ICNT)=0
46316      AVALUE(ICNT)=0.0
46317      IDIGIT(ICNT)=-1
46318C
46319      ICNT=ICNT+1
46320      ITEXT(ICNT)='Method of Ratio of Frequencies/Moments:'
46321      NCTEXT(ICNT)=39
46322      AVALUE(ICNT)=0.0
46323      IDIGIT(ICNT)=-1
46324      ICNT=ICNT+1
46325      ITEXT(ICNT)='Estimate of Theta:'
46326      NCTEXT(ICNT)=18
46327      AVALUE(ICNT)=THETF2
46328      IDIGIT(ICNT)=NUMDIG
46329      ICNT=ICNT+1
46330      ITEXT(ICNT)='Estimate of Beta:'
46331      NCTEXT(ICNT)=17
46332      AVALUE(ICNT)=BETAF2
46333      IDIGIT(ICNT)=NUMDIG
46334      ICNT=ICNT+1
46335      ITEXT(ICNT)='Estimate of M:'
46336      NCTEXT(ICNT)=14
46337      AVALUE(ICNT)=AMF2
46338      IDIGIT(ICNT)=NUMDIG
46339      ICNT=ICNT+1
46340      ITEXT(ICNT)=' '
46341      NCTEXT(ICNT)=0
46342      AVALUE(ICNT)=0.0
46343      IDIGIT(ICNT)=-1
46344C
46345      ICNT=ICNT+1
46346      ITEXT(ICNT)='Method of Maximum Likelihood:'
46347      NCTEXT(ICNT)=29
46348      AVALUE(ICNT)=0.0
46349      IDIGIT(ICNT)=-1
46350      ICNT=ICNT+1
46351      ITEXT(ICNT)='Estimate of Theta:'
46352      NCTEXT(ICNT)=18
46353      AVALUE(ICNT)=THETML
46354      IDIGIT(ICNT)=NUMDIG
46355      ICNT=ICNT+1
46356      ITEXT(ICNT)='Estimate of Beta:'
46357      NCTEXT(ICNT)=17
46358      AVALUE(ICNT)=BETAML
46359      IDIGIT(ICNT)=NUMDIG
46360      ICNT=ICNT+1
46361      ITEXT(ICNT)='Estimate of M:'
46362      NCTEXT(ICNT)=14
46363      AVALUE(ICNT)=AMML
46364      IDIGIT(ICNT)=NUMDIG
46365      ICNT=ICNT+1
46366      ITEXT(ICNT)=' '
46367      NCTEXT(ICNT)=0
46368      AVALUE(ICNT)=0.0
46369      IDIGIT(ICNT)=-1
46370C
46371      NUMROW=ICNT
46372      DO2310I=1,NUMROW
46373        NTOT(I)=15
46374 2310 CONTINUE
46375C
46376      IFRST=.TRUE.
46377      ILAST=.TRUE.
46378      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
46379     1            AVALUE,IDIGIT,
46380     1            NTOT,NUMROW,
46381     1            ICAPSW,ICAPTY,ILAST,IFRST,
46382     1            ISUBRO,IBUGA3,IERROR)
46383C
46384C               *****************
46385C               **  STEP 90--  **
46386C               **  EXIT       **
46387C               *****************
46388C
46389 9000 CONTINUE
46390      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGNB')THEN
46391        WRITE(ICOUT,999)
46392        CALL DPWRST('XXX','WRIT')
46393        WRITE(ICOUT,9011)
46394 9011   FORMAT('***** AT THE END       OF DPMGNB--')
46395        CALL DPWRST('XXX','WRIT')
46396        WRITE(ICOUT,9012)IERROR
46397 9012   FORMAT('IERROR = ',A4)
46398        CALL DPWRST('XXX','WRIT')
46399      ENDIF
46400C
46401      RETURN
46402      END
46403      SUBROUTINE DPMGU1(Y,N,
46404     1                  XTEMP,DTEMP,MAXNXT,
46405     1                  SCALML,SCALSE,SCALMO,SCMOSE,
46406     1                  ALOCML,ALMLSE,ALOCMO,ALMOSE,COVSE,
46407     1                  NUMV,
46408     1                  ICAPSW,ICAPTY,IFORSW,MINMAX,
46409     1                  QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
46410     1                  XQPHTZ,XQPLCZ,XQPUCZ,
46411     1                  IOUNI1,IOUNI2,ALPHAP,
46412     1                  ISUBRO,IBUGA3,IERROR)
46413C
46414C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
46415C              ESTIMATES FOR GUMBEL (EXTREME VALUE TYPE 1) DISTRIBUTION
46416C              FOR THE FULL SAMPLE CASE.
46417C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
46418C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
46419C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
46420C                1999, CHAPTER 15.
46421C     WRITTEN BY--ALAN HECKERT
46422C                 STATISTICAL ENGINEERING DIVISION
46423C                 INFORMATION TECHNOLOGY LABORATORY
46424C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
46425C                 GAITHERSBURG, MD 20899-8980
46426C                 PHONE--301-975-2899
46427C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
46428C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
46429C     LANGUAGE--ANSI FORTRAN (1977)
46430C     VERSION NUMBER--2004/12
46431C     ORIGINAL VERSION--DECEMBER  2004.
46432C     UPDATED         --OCTOBER   2009. DEFAULT MINMAX CASE =
46433C                                       MAXIMUM (TO BE CONSISTENT
46434C                                       WITH EV1CDF, EV1PDF, EV1PPF)
46435C     UPDATED         --OCTOBER   2009. EXTRACT SOME CODE TO EV1ML1
46436C                                       (TO MAKE IT EASIER FOR OTHER
46437C                                       ROUTINES TO OBTAIN ML
46438C                                       ESTIMATES)
46439C     UPDATED         --JUNE      2010. USE DPDTA1 AND DPDTA7 TO
46440C                                       PRINT OUTPUT, ADD AIC AND
46441C                                       RELATED STATISTICS TO OUTPUT
46442C     UPDATED         --MARCH     2014. SUPPORT FOR ONE-SIDED PERCENTILES
46443C
46444C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
46445C
46446      CHARACTER*4 ICAPSW
46447      CHARACTER*4 ICAPTY
46448      CHARACTER*4 IFORSW
46449C
46450      CHARACTER*4 ISUBRO
46451      CHARACTER*4 IBUGA3
46452      CHARACTER*4 IERROR
46453C
46454      CHARACTER*4 IWRITE
46455      CHARACTER*4 ILIKFL
46456      CHARACTER*4 INORM
46457      CHARACTER*7 ICASE
46458C
46459      CHARACTER*4 ISUBN1
46460      CHARACTER*4 ISUBN2
46461      CHARACTER*4 ISTEPN
46462C
46463C---------------------------------------------------------------------
46464C
46465      PARAMETER (NUMALP=6)
46466      DIMENSION ALPHA(NUMALP)
46467      DIMENSION ALOWLO(NUMALP)
46468      DIMENSION AUPPLO(NUMALP)
46469      DIMENSION ALOWL2(NUMALP)
46470      DIMENSION AUPPL2(NUMALP)
46471      DIMENSION ALOWSC(NUMALP)
46472      DIMENSION AUPPSC(NUMALP)
46473      DIMENSION ALOWS2(NUMALP)
46474      DIMENSION AUPPS2(NUMALP)
46475C
46476      DIMENSION Y(*)
46477      DIMENSION XTEMP(*)
46478      DIMENSION XQPHTZ(*)
46479      DIMENSION XQPLCZ(*)
46480      DIMENSION XQPUCZ(*)
46481      DIMENSION QP(*)
46482      DIMENSION XQPHAT(*)
46483      DIMENSION XQPSE(*)
46484      DIMENSION XQPLCL(*)
46485      DIMENSION XQPUCL(*)
46486C
46487      DOUBLE PRECISION DTEMP(*)
46488C
46489      DOUBLE PRECISION EV1FU6
46490      EXTERNAL EV1FU6
46491C
46492      DOUBLE PRECISION DQ
46493      DOUBLE PRECISION SHATML
46494      COMMON/EV1CO6/DQ,SHATML
46495C
46496      DOUBLE PRECISION DAE
46497      DOUBLE PRECISION DRE
46498      DOUBLE PRECISION DXSTRT
46499      DOUBLE PRECISION DXLOW
46500      DOUBLE PRECISION DXUP
46501C
46502      INCLUDE 'DPCOST.INC'
46503C
46504      PARAMETER (MAXROW=50)
46505      CHARACTER*60 ITITLE
46506      CHARACTER*60 ITITLZ
46507      CHARACTER*60 ITEXT(MAXROW)
46508      REAL         AVALUE(MAXROW)
46509      INTEGER      NCTEXT(MAXROW)
46510      INTEGER      IDIGIT(MAXROW)
46511      INTEGER      NTOT(MAXROW)
46512      LOGICAL IFRST
46513      LOGICAL ILAST
46514C
46515C---------------------------------------------------------------------
46516C
46517      INCLUDE 'DPCOP2.INC'
46518C
46519      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
46520C
46521C-----START POINT-----------------------------------------------------
46522C
46523      ISUBN1='DPMG'
46524      ISUBN2='U1  '
46525      IERROR='NO'
46526C
46527      ICASE='Minimum'
46528      IF(MINMAX.EQ.2 .OR. MINMAX.EQ.0)ICASE='Maximum'
46529C
46530      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')THEN
46531        WRITE(ICOUT,999)
46532  999   FORMAT(1X)
46533        CALL DPWRST('XXX','WRIT')
46534        WRITE(ICOUT,51)
46535   51   FORMAT('**** AT THE BEGINNING OF DPPGU1--')
46536        CALL DPWRST('XXX','WRIT')
46537        WRITE(ICOUT,52)IBUGA3
46538   52   FORMAT('IBUGA3 = ',A4)
46539        CALL DPWRST('XXX','WRIT')
46540        WRITE(ICOUT,55)N,NUMV,IOUNI1,MAXNXT
46541   55   FORMAT('N,NUMV,IOUNI1,MAXNXT = ',4I8)
46542        CALL DPWRST('XXX','WRIT')
46543        DO56I=1,MIN(N,100)
46544          WRITE(ICOUT,57)I,Y(I)
46545   57     FORMAT('I,Y(I) = ',I8,G15.7)
46546          CALL DPWRST('XXX','WRIT')
46547   56   CONTINUE
46548      ENDIF
46549C
46550C               ********************************************
46551C               **  STEP 11--                             **
46552C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
46553C               ********************************************
46554C
46555      ISTEPN='11'
46556      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
46557     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46558C
46559      NMIN=3
46560      CALL CKDIST(Y,N,NMIN,QP,NPERC,ISUBRO,IBUGA3,IERROR)
46561      IF(IERROR.EQ.'YES')GOTO9000
46562C
46563C               **********************************
46564C               **  STEP 41--                   **
46565C               **  CARRY OUT CALCULATIONS      **
46566C               **  FOR GUMBEL MLE              **
46567C               **  ESTIMATE (FULL SAMPLE CASE) **
46568C               **********************************
46569C
46570      ISTEPN='31'
46571      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
46572     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46573C
46574      IERROR='NO'
46575      IWRITE='OFF'
46576      AN=REAL(N)
46577      ICAS2=1
46578      CALL EV1ML1(Y,N,MINMAX,IGUMBC,ICAS2,
46579     1            DTEMP,
46580     1            ALOWLO,AUPPLO,ALOWSC,AUPPSC,
46581     1            ALOWL2,AUPPL2,ALOWS2,AUPPS2,
46582     1            ALPHA,NUMALP,NUMOUT,
46583     1            XMEAN,XSD,XMIN,XMAX,
46584     1            ALOCMO,SCALMO,ALMOSE,SCMOSE,
46585     1            ALOCML,SCALML,SCA2ML,ALMLSE,SCALSE,COVSE,
46586     1            ISUBRO,IBUGA3,IERROR)
46587C
46588      IF(IGUMBC.EQ.'ON')THEN
46589        SCALML=SCA2ML
46590      ENDIF
46591C
46592      CALL EV1LI1(Y,N,MINMAX,ALOCML,SCALML,
46593     1            ALIK,AIC,AICC,BIC,
46594     1            ISUBRO,IBUGA3,IERROR)
46595C
46596C               **********************************************
46597C               **  STEP 41B--                              **
46598C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
46599C               **  PERCENTILES.  THE CONFIDENCE LIMITS ON  **
46600C               **  SIGMA ARE (SL,SU) ARE:                  **
46601C               **  (2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2),     **
46602C               **   2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2))     **
46603C               **  THEN (XpLCL,XpUCL) IS:                  **
46604C               **  ((-LN(1 - Xp))*SL,(-LN(1 - Xp))*SU)     **
46605C               **********************************************
46606C
46607      ISTEPN='41B'
46608      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
46609     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46610C
46611C  NOTE: FOR 2-PARAMETER MODEL, USE APPROXIMATION
46612C        FOR LOWER LIMIT GIVEN ON PP. 190-191 OF BURY.
46613C
46614      IF(NPERC.GE.1)THEN
46615C
46616        NUTEMP=1
46617        IF(IDTYPR.EQ.'LOWE')THEN
46618          ALP=ALPHAP
46619          P=1.0-ALP
46620        ELSEIF(IDTYPR.EQ.'UPPE')THEN
46621          ALP=ALPHAP
46622          P=1.0-ALP
46623        ELSE
46624          ALP=ALPHAP
46625          P=1.0-(ALP/2.0)
46626        ENDIF
46627C
46628        CALL NORPPF(P,ANOR)
46629        DK=DBLE(APPF)
46630        SHATML=DBLE(SCALML)
46631        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
46632C
46633        DAE=1.D-7
46634        DRE=1.D-7
46635C
46636        WRITE(IOUNI2,3131)
46637 3131   FORMAT(15X,'       POINT     ','   STANDARD    ',
46638     1         '     LOWER     ','     UPPER')
46639        WRITE(IOUNI2,3132)
46640 3132   FORMAT('    PERCENTILE ','     ESTIMATE   ','     ERROR     ',
46641     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
46642        DO3130I=1,NPERC
46643C
46644          QPTEMP=QP(I)/100.0
46645          CALL EV1PPF(QPTEMP,MINMAX,APPF)
46646C
46647          XQPHAT(I)=ALOCML + SCALML*APPF
46648          SEXQP=ALMLSE**2 + (APPF*SCALSE)**2 + 2.0*APPF*COVSE**2
46649          XQPSE(I)=SQRT(SEXQP)
46650          IF(IDTYPR.EQ.'LOWE')THEN
46651            XQPLCL(I)=XQPHAT(I) - ANOR*XQPSE(I)
46652            XQPUCL(I)=CPUMIN
46653          ELSEIF(IDTYPR.EQ.'UPPE')THEN
46654            XQPLCL(I)=CPUMIN
46655            XQPUCL(I)=XQPHAT(I) + ANOR*XQPSE(I)
46656          ELSE
46657            XQPLCL(I)=XQPHAT(I) - ANOR*XQPSE(I)
46658            XQPUCL(I)=XQPHAT(I) + ANOR*XQPSE(I)
46659          ENDIF
46660          WRITE(IOUNI2,'(6E15.7)')
46661     1         QP(I),XQPHAT(I),SEXQP,XQPLCL(I),XQPUCL(I)
46662C
46663          DQ=DBLE(QPTEMP)
46664          DPPF=DBLE(XQPHAT(I))
46665          DXSTRT=DBLE(XQPLCL(I))
46666          DXLOW=DPPF/2.0D0
46667          DXUP=DBLE(XQPHAT(I))
46668          CALL DFZER2(EV1FU6,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
46669          XQPLCZ(I)=REAL(DXLOW)
46670C
46671          DXSTRT=DBLE(XQPUCL(I))
46672          DXUP=DPPF*2.0D0
46673          DXLOW=DBLE(XQPHAT(I))
46674          CALL DFZER2(EV1FU6,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
46675          XQPUCZ(I)=REAL(DXLOW)
46676C
46677          IF(IDTYPR.EQ.'LOWE')XQPUCL(I)=CPUMIN
46678          IF(IDTYPR.EQ.'UPPE')XQPLCL(I)=CPUMIN
46679C
46680 3130   CONTINUE
46681C
46682      ENDIF
46683C
46684C               *************************************
46685C               **   STEP 42--                     **
46686C               **   WRITE OUT EVERYTHING          **
46687C               **   FOR GUMBEL MLE ESTIMATE       **
46688C               *************************************
46689C
46690      ISTEPN='42'
46691      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
46692     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
46693C
46694      IF(IPRINT.EQ.'OFF')GOTO9000
46695C
46696      NUMDIG=7
46697      IF(IFORSW.EQ.'1')NUMDIG=1
46698      IF(IFORSW.EQ.'2')NUMDIG=2
46699      IF(IFORSW.EQ.'3')NUMDIG=3
46700      IF(IFORSW.EQ.'4')NUMDIG=4
46701      IF(IFORSW.EQ.'5')NUMDIG=5
46702      IF(IFORSW.EQ.'6')NUMDIG=6
46703      IF(IFORSW.EQ.'7')NUMDIG=7
46704      IF(IFORSW.EQ.'8')NUMDIG=8
46705      IF(IFORSW.EQ.'9')NUMDIG=9
46706      IF(IFORSW.EQ.'0')NUMDIG=0
46707      IF(IFORSW.EQ.'E')NUMDIG=-2
46708      IF(IFORSW.EQ.'-2')NUMDIG=-2
46709      IF(IFORSW.EQ.'-3')NUMDIG=-3
46710      IF(IFORSW.EQ.'-4')NUMDIG=-4
46711      IF(IFORSW.EQ.'-5')NUMDIG=-5
46712      IF(IFORSW.EQ.'-6')NUMDIG=-6
46713      IF(IFORSW.EQ.'-7')NUMDIG=-7
46714      IF(IFORSW.EQ.'-8')NUMDIG=-8
46715      IF(IFORSW.EQ.'-9')NUMDIG=-9
46716C
46717      IF(MINMAX.EQ.1)THEN
46718        ITITLE='Gumbel (Minimum) Parameter Estimation'
46719        NCTITL=37
46720        ITITLZ='f(x) = (1/s)*EXP((x-u)/s)*EXP(-EXP((x-u)/x))'
46721        NCTITZ=44
46722      ELSE
46723        ITITLE='Gumbel (Maximum) Parameter Estimation'
46724        NCTITL=37
46725        ITITLZ='f(x) = (1/s)*EXP(-(x-u)/s)*EXP(-EXP(-(x-u)/s))'
46726        NCTITZ=46
46727      ENDIF
46728      ICNT=1
46729      ITEXT(ICNT)='Summary Statistics:'
46730      NCTEXT(ICNT)=19
46731      AVALUE(ICNT)=0.0
46732      IDIGIT(ICNT)=0
46733      ICNT=ICNT+1
46734      ITEXT(ICNT)='Number of Observations:'
46735      NCTEXT(ICNT)=23
46736      AVALUE(ICNT)=REAL(N)
46737      IDIGIT(ICNT)=0
46738      ICNT=ICNT+1
46739      ITEXT(ICNT)='Sample Mean:'
46740      NCTEXT(ICNT)=12
46741      AVALUE(ICNT)=XMEAN
46742      IDIGIT(ICNT)=NUMDIG
46743      ICNT=ICNT+1
46744      ITEXT(ICNT)='Sample Standard Deviation:'
46745      NCTEXT(ICNT)=26
46746      AVALUE(ICNT)=XSD
46747      IDIGIT(ICNT)=NUMDIG
46748      ICNT=ICNT+1
46749      ITEXT(ICNT)='Sample Minimum:'
46750      NCTEXT(ICNT)=15
46751      AVALUE(ICNT)=XMIN
46752      IDIGIT(ICNT)=NUMDIG
46753      ICNT=ICNT+1
46754      ITEXT(ICNT)='Sample Maximum:'
46755      NCTEXT(ICNT)=15
46756      AVALUE(ICNT)=XMAX
46757      IDIGIT(ICNT)=NUMDIG
46758      ICNT=ICNT+1
46759      ITEXT(ICNT)=' '
46760      NCTEXT(ICNT)=0
46761      AVALUE(ICNT)=0.0
46762      IDIGIT(ICNT)=-1
46763C
46764      ICNT=ICNT+1
46765      ITEXT(ICNT)='Method of Moments:'
46766      NCTEXT(ICNT)=19
46767      AVALUE(ICNT)=0.0
46768      IDIGIT(ICNT)=-1
46769      ICNT=ICNT+1
46770      ITEXT(ICNT)='Estimate of Location:'
46771      NCTEXT(ICNT)=21
46772      AVALUE(ICNT)=ALOCMO
46773      IDIGIT(ICNT)=NUMDIG
46774      ICNT=ICNT+1
46775      ITEXT(ICNT)='Standard Error of Location:'
46776      NCTEXT(ICNT)=27
46777      AVALUE(ICNT)=ALMOSE
46778      IDIGIT(ICNT)=NUMDIG
46779      ICNT=ICNT+1
46780      ITEXT(ICNT)='Estimate of Scale:'
46781      NCTEXT(ICNT)=18
46782      AVALUE(ICNT)=SCALMO
46783      IDIGIT(ICNT)=NUMDIG
46784      ICNT=ICNT+1
46785      ITEXT(ICNT)='Standard Error of Scale:'
46786      NCTEXT(ICNT)=24
46787      AVALUE(ICNT)=SCMOSE
46788      IDIGIT(ICNT)=NUMDIG
46789      ICNT=ICNT+1
46790      ITEXT(ICNT)=' '
46791      NCTEXT(ICNT)=0
46792      AVALUE(ICNT)=0.0
46793      IDIGIT(ICNT)=-1
46794C
46795      ICNT=ICNT+1
46796      IF(IGUMBC.EQ.'ON')THEN
46797        ITEXT(ICNT)='Maximum Likelihood (with Bias Correction):'
46798        NCTEXT(ICNT)=42
46799      ELSE
46800        ITEXT(ICNT)='Maximum Likelihood (without Bias Correction):'
46801        NCTEXT(ICNT)=45
46802      ENDIF
46803      AVALUE(ICNT)=0.0
46804      IDIGIT(ICNT)=-1
46805      ICNT=ICNT+1
46806      ITEXT(ICNT)='Estimate of Location:'
46807      NCTEXT(ICNT)=21
46808      AVALUE(ICNT)=ALOCML
46809      IDIGIT(ICNT)=NUMDIG
46810      ICNT=ICNT+1
46811      ITEXT(ICNT)='Standard Error of Location:'
46812      NCTEXT(ICNT)=27
46813      AVALUE(ICNT)=ALMLSE
46814      IDIGIT(ICNT)=NUMDIG
46815      ICNT=ICNT+1
46816      ITEXT(ICNT)='Estimate of Scale:'
46817      NCTEXT(ICNT)=18
46818      AVALUE(ICNT)=SCALML
46819      IDIGIT(ICNT)=NUMDIG
46820      ICNT=ICNT+1
46821      ITEXT(ICNT)='Standard Error of Scale:'
46822      NCTEXT(ICNT)=24
46823      AVALUE(ICNT)=SCALSE
46824      IDIGIT(ICNT)=NUMDIG
46825      ICNT=ICNT+1
46826      ITEXT(ICNT)='Covariance:'
46827      NCTEXT(ICNT)=11
46828      AVALUE(ICNT)=COVSE
46829      IDIGIT(ICNT)=NUMDIG
46830      ICNT=ICNT+1
46831      ITEXT(ICNT)='Log-likelihood:'
46832      NCTEXT(ICNT)=15
46833      AVALUE(ICNT)=ALIK
46834      IDIGIT(ICNT)=-7
46835      ICNT=ICNT+1
46836      ITEXT(ICNT)='AIC:'
46837      NCTEXT(ICNT)=4
46838      AVALUE(ICNT)=AIC
46839      IDIGIT(ICNT)=-7
46840      ICNT=ICNT+1
46841      ITEXT(ICNT)='AICc:'
46842      NCTEXT(ICNT)=5
46843      AVALUE(ICNT)=AICC
46844      IDIGIT(ICNT)=-7
46845      ICNT=ICNT+1
46846      ITEXT(ICNT)='BIC:'
46847      NCTEXT(ICNT)=4
46848      AVALUE(ICNT)=BIC
46849      IDIGIT(ICNT)=-7
46850C
46851      NUMROW=ICNT
46852      DO2320I=1,NUMROW
46853        NTOT(I)=15
46854 2320 CONTINUE
46855C
46856      IFRST=.TRUE.
46857      ILAST=.TRUE.
46858      NCTITZ=0
46859      CALL DPDTA1(ITITLE,NCTITL,ITITLZ,NCTITZ,ITEXT,NCTEXT,
46860     1            AVALUE,IDIGIT,
46861     1            NTOT,NUMROW,
46862     1            ICAPSW,ICAPTY,ILAST,IFRST,
46863     1            ISUBRO,IBUGA3,IERROR)
46864C
46865C     NOTE: LIKELIHOOD RATIO METHOD CURRENTLY NOT WORKING FOR
46866C           MINIMUM CASE.
46867C
46868      IF(NUMOUT.GT.1)THEN
46869        INORM='YES'
46870        IF(MINMAX.EQ.1)THEN
46871          CALL DPDTA7(ALOWLO,AUPPLO,ALOWSC,AUPPSC,ALPHA,NUMALP,
46872     1                ICAPSW,ICAPTY,NUMDIG,INORM,
46873     1                ISUBRO,IBUGA3,IERROR)
46874        ELSE
46875          CALL DPDT77(ALOWLO,AUPPLO,ALOWSC,AUPPSC,
46876     1                ALOWL2,AUPPL2,ALOWS2,AUPPS2,
46877     1                ALPHA,NUMALP,
46878     1                ICAPSW,ICAPTY,NUMDIG,
46879     1                ISUBRO,IBUGA3,IERROR)
46880        ENDIF
46881      ENDIF
46882C
46883      IF(NPERC.GE.1)THEN
46884        ILIKFL='OFF'
46885        CALL DPDTA9(QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
46886     1              ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
46887     1              ISUBRO,IBUGA3,IERROR)
46888        IF(MINMAX.EQ.2)THEN
46889          ILIKFL='ON'
46890          CALL DPDTA9(QP,XQPHAT,XQPLCZ,XQPUCZ,XQPSE,NPERC,
46891     1                ICAPSW,ICAPTY,ILIKFL,NUMDIG,ALPHAP,
46892     1                ISUBRO,IBUGA3,IERROR)
46893        ENDIF
46894      ENDIF
46895C
46896C               *****************
46897C               **  STEP 90--  **
46898C               **  EXIT       **
46899C               *****************
46900C
46901 9000 CONTINUE
46902      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')THEN
46903        WRITE(ICOUT,999)
46904        CALL DPWRST('XXX','WRIT')
46905        WRITE(ICOUT,9011)
46906 9011   FORMAT('***** AT THE END       OF DPPGU1--')
46907        CALL DPWRST('XXX','WRIT')
46908        WRITE(ICOUT,9012)N,IBUGA3,IERROR
46909 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
46910        CALL DPWRST('XXX','WRIT')
46911        DO9014I=1,N
46912          WRITE(ICOUT,9015)I,XQPHTZ(I),XTEMP(I)
46913 9015     FORMAT('I,XQPHTZ(I),XTEMP(I) = ',I8,2X,2G15.7)
46914          CALL DPWRST('XXX','WRIT')
46915 9014   CONTINUE
46916      ENDIF
46917C
46918      RETURN
46919      END
46920      SUBROUTINE DPMIN(ICOM,IHARG,IARGT,ARG,NUMARG,
46921     1                 GX1MIN,GY1MIN,GX2MIN,GY2MIN,
46922     1                 IX1MIN,IY1MIN,IX2MIN,IY2MIN,
46923     1                 IFOUND,IERROR)
46924C
46925C     PURPOSE--DEFINE AXIS MINIMA
46926C              (HORIZONTAL AXIS OR VERTICAL AXIS OR BOTH)
46927C              WHICH IN TURN WILL DEFINE THE LOWER EXTREME
46928C              WHICH WILL APPEAR ON THE PLOT.
46929C              THE MINIMA WILL BE PLACED IN THE 4 VARIABLES
46930C              GX1MIN,GY1MIN,
46931C              GX2MIN,GY2MIN,
46932C              THE STATUS (FIXED OR FLOAT) WILL BE PLACED
46933C              IN THE 4 VARIABLES
46934C              IX1MIN,IY1MIN,
46935C              IX2MIN,IY2MIN,
46936C     INPUT  ARGUMENTS--ICOM  (A  HOLLERITH VARIABLE)
46937C                     --IHARG  (A  HOLLERITH VECTOR)
46938C                     --IARGT  (A  HOLLERITH VECTOR)
46939C                     --ARG    (A  FLOATING POINT VECTOR)
46940C                     --NUMARG
46941C     OUTPUT ARGUMENTS--
46942C                     --GX1MIN = MINIMUM FOR BOTTOM HORIZONTAL AXIS
46943C                     --GY1MIN = MINIMUM FOR LEFT   VERTICAL   AXIS
46944C                     --GX2MIN = MINIMUM FOR TOP    HORIZONTAL AXIS
46945C                     --GX2MIN = MINIMUM FOR RIGHT  VERTICAL   AXIS
46946C                     --IX1MIN = STATUS FOR MINIMUM FOR BOTTOM HORIZONTAL AXIS
46947C                     --IY1MIN = STATUS FOR MINIMUM FOR LEFT   VERTICAL   AXIS
46948C                     --IX2MIN = STATUS FOR MINIMUM FOR TOP    HORIZONTAL AXIS
46949C                     --IX2MIN = STATUS FOR MINIMUM FOR RIGHT  VERTICAL   AXIS
46950C                     --IFOUND ('YES' OR 'NO' )
46951C                     --IERROR ('YES' OR 'NO' )
46952C     WRITTEN BY--JAMES J. FILLIBEN
46953C                 STATISTICAL ENGINEERING DIVISION
46954C                 INFORMATION TECHNOLOGY LABORATORY
46955C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
46956C                 GAITHERSBURG, MD 20899-8980
46957C                 PHONE--301-975-2855
46958C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
46959C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
46960C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
46961C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
46962C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
46963C     LANGUAGE--ANSI FORTRAN (1977)
46964C     VERSION NUMBER--82/7
46965C     ORIGINAL VERSION--NOVEMBER  1978.
46966C     UPDATED         --SEPTEMBER 1980.
46967C     UPDATED         --OCTOBER   1981.
46968C     UPDATED         --NOVEMBER  1981.
46969C     UPDATED         --MAY       1982.
46970C     UPDATED         --FEBRUARY 1992.  FIX YMIN WITH NO ARG BOMB
46971C
46972C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
46973C
46974      CHARACTER*4 ICOM
46975      CHARACTER*4 IHARG
46976      CHARACTER*4 IARGT
46977C
46978      CHARACTER*4 IX1MIN
46979      CHARACTER*4 IY1MIN
46980      CHARACTER*4 IX2MIN
46981      CHARACTER*4 IY2MIN
46982C
46983      CHARACTER*4 IFOUND
46984      CHARACTER*4 IERROR
46985C
46986C---------------------------------------------------------------------
46987C
46988      DIMENSION IHARG(*)
46989      DIMENSION IARGT(*)
46990      DIMENSION ARG(*)
46991C
46992C---------------------------------------------------------------------
46993C
46994      INCLUDE 'DPCOP2.INC'
46995C
46996C-----START POINT-----------------------------------------------------
46997C
46998      IFOUND='NO'
46999      IERROR='NO'
47000C
47001CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1992
47002CCCCC IF(IHARG(NUMARG).EQ.'?')GOTO8100
47003      IF(NUMARG.LE.0)GOTO1090
47004      IF(IHARG(NUMARG).EQ.'?')GOTO8100
47005 1090 CONTINUE
47006C
47007C               *****************************************************
47008C               **  TREAT THE CASE WHEN                           **
47009C               **  BOTH HORIZONTAL AXIS MINIMA ARE TO BE FIXED    **
47010C               *****************************************************
47011C
47012      IF(ICOM.EQ.'XMIN')GOTO1100
47013      GOTO1199
47014C
47015 1100 CONTINUE
47016      IF(NUMARG.LE.0)GOTO1110
47017      IF(IARGT(1).EQ.'NUMB')GOTO1120
47018      GOTO1110
47019C
47020 1110 CONTINUE
47021      IFOUND='YES'
47022      GX1MIN=CPUMIN
47023      GX2MIN=CPUMIN
47024      IX1MIN='FLOA'
47025      IX2MIN='FLOA'
47026C
47027      IF(IFEEDB.EQ.'OFF')GOTO1119
47028      WRITE(ICOUT,999)
47029  999 FORMAT(1X)
47030      CALL DPWRST('XXX','BUG ')
47031      WRITE(ICOUT,1115)
47032 1115 FORMAT('THE X AXIS MINIMUM (FOR BOTH HORIZONTAL')
47033      CALL DPWRST('XXX','BUG ')
47034      WRITE(ICOUT,1116)
47035 1116 FORMAT('FRAME LINES) HAS JUST BEEN SET')
47036      CALL DPWRST('XXX','BUG ')
47037      WRITE(ICOUT,1117)
47038 1117 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
47039      CALL DPWRST('XXX','BUG ')
47040 1119 CONTINUE
47041      GOTO9000
47042C
47043 1120 CONTINUE
47044      IFOUND='YES'
47045      A1=ARG(1)
47046      GX1MIN=A1
47047      GX2MIN=A1
47048      IX1MIN='FIXE'
47049      IX2MIN='FIXE'
47050C
47051      IF(IFEEDB.EQ.'OFF')GOTO1129
47052      WRITE(ICOUT,999)
47053      CALL DPWRST('XXX','BUG ')
47054      WRITE(ICOUT,1125)
47055 1125 FORMAT('THE X AXIS MINIMUM (FOR BOTH HORIZONTAL')
47056      CALL DPWRST('XXX','BUG ')
47057      WRITE(ICOUT,1126)GX1MIN
47058 1126 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
47059     1E15.7)
47060      CALL DPWRST('XXX','BUG ')
47061 1129 CONTINUE
47062      GOTO9000
47063C
47064 1199 CONTINUE
47065C
47066C               *****************************************************
47067C               **  TREAT THE CASE WHEN THE                        **
47068C               **  BOTTOM HORIZONTAL AXIS MINIMUM ARE TO BE FIXED  **
47069C               *****************************************************
47070C
47071      IF(ICOM.EQ.'X1MI')GOTO1200
47072      GOTO1299
47073C
47074 1200 CONTINUE
47075      IF(NUMARG.LE.0)GOTO1210
47076      IF(IARGT(1).EQ.'NUMB')GOTO1220
47077      GOTO1210
47078C
47079 1210 CONTINUE
47080      IFOUND='YES'
47081      GX1MIN=CPUMIN
47082      IX1MIN='FLOA'
47083C
47084      IF(IFEEDB.EQ.'OFF')GOTO1219
47085      WRITE(ICOUT,999)
47086      CALL DPWRST('XXX','BUG ')
47087      WRITE(ICOUT,1215)
47088 1215 FORMAT('THE X AXIS MINIMUM (FOR THE BOTTOM HORIZONTAL')
47089      CALL DPWRST('XXX','BUG ')
47090      WRITE(ICOUT,1216)
47091 1216 FORMAT('FRAME LINE) HAS JUST BEEN SET')
47092      CALL DPWRST('XXX','BUG ')
47093      WRITE(ICOUT,1217)
47094 1217 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
47095      CALL DPWRST('XXX','BUG ')
47096 1219 CONTINUE
47097      GOTO9000
47098C
47099 1220 CONTINUE
47100      IFOUND='YES'
47101      A1=ARG(1)
47102      GX1MIN=A1
47103      IX1MIN='FIXE'
47104C
47105      IF(IFEEDB.EQ.'OFF')GOTO1229
47106      WRITE(ICOUT,999)
47107      CALL DPWRST('XXX','BUG ')
47108      WRITE(ICOUT,1225)
47109 1225 FORMAT('THE X AXIS MINIMUM (FOR THE BOTTOM HORIZONTAL')
47110      CALL DPWRST('XXX','BUG ')
47111      WRITE(ICOUT,1226)GX1MIN
47112 1226 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
47113     1E15.7)
47114      CALL DPWRST('XXX','BUG ')
47115 1229 CONTINUE
47116      GOTO9000
47117C
47118 1299 CONTINUE
47119C
47120C               *****************************************************
47121C               **  TREAT THE CASE WHEN THE                        **
47122C               **  TOP    HORIZONTAL AXIS MINIMUM ARE TO BE FIXED  **
47123C               *****************************************************
47124C
47125      IF(ICOM.EQ.'X2MI')GOTO1300
47126      GOTO1399
47127C
47128 1300 CONTINUE
47129      IF(NUMARG.LE.0)GOTO1310
47130      IF(IARGT(1).EQ.'NUMB')GOTO1320
47131      GOTO1310
47132C
47133 1310 CONTINUE
47134      IFOUND='YES'
47135      GX2MIN=CPUMIN
47136      IX2MIN='FLOA'
47137C
47138      IF(IFEEDB.EQ.'OFF')GOTO1319
47139      WRITE(ICOUT,999)
47140      CALL DPWRST('XXX','BUG ')
47141      WRITE(ICOUT,1315)
47142 1315 FORMAT('THE X AXIS MINIMUM (FOR THE TOP    HORIZONTAL')
47143      CALL DPWRST('XXX','BUG ')
47144      WRITE(ICOUT,1316)
47145 1316 FORMAT('FRAME LINE) HAS JUST BEEN SET')
47146      CALL DPWRST('XXX','BUG ')
47147      WRITE(ICOUT,1317)
47148 1317 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
47149      CALL DPWRST('XXX','BUG ')
47150 1319 CONTINUE
47151      GOTO9000
47152C
47153 1320 CONTINUE
47154      IFOUND='YES'
47155      A1=ARG(1)
47156      GX2MIN=A1
47157      IX2MIN='FIXE'
47158C
47159      IF(IFEEDB.EQ.'OFF')GOTO1329
47160      WRITE(ICOUT,999)
47161      CALL DPWRST('XXX','BUG ')
47162      WRITE(ICOUT,1325)
47163 1325 FORMAT('THE X AXIS MINIMUM (FOR THE TOP    HORIZONTAL')
47164      CALL DPWRST('XXX','BUG ')
47165      WRITE(ICOUT,1326)GX2MIN
47166 1326 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
47167     1E15.7)
47168      CALL DPWRST('XXX','BUG ')
47169 1329 CONTINUE
47170      GOTO9000
47171C
47172 1399 CONTINUE
47173C
47174C               *****************************************************
47175C               **  TREAT THE CASE WHEN                           **
47176C               **  BOTH VERTICAL   AXIS MINIMUM ARE TO BE FIXED    **
47177C               *****************************************************
47178C
47179      IF(ICOM.EQ.'YMIN')GOTO1400
47180      GOTO1499
47181C
47182 1400 CONTINUE
47183      IF(NUMARG.LE.0)GOTO1410
47184      IF(IARGT(1).EQ.'NUMB')GOTO1420
47185      GOTO1410
47186C
47187 1410 CONTINUE
47188      IFOUND='YES'
47189      GY1MIN=CPUMIN
47190      GY2MIN=CPUMIN
47191      IY1MIN='FLOA'
47192      IY2MIN='FLOA'
47193C
47194      IF(IFEEDB.EQ.'OFF')GOTO1419
47195      WRITE(ICOUT,999)
47196      CALL DPWRST('XXX','BUG ')
47197      WRITE(ICOUT,1415)
47198 1415 FORMAT('THE Y AXIS MINIMUM (FOR BOTH VERTICAL')
47199      CALL DPWRST('XXX','BUG ')
47200      WRITE(ICOUT,1416)
47201 1416 FORMAT('FRAME LINES) HAS JUST BEEN SET')
47202      CALL DPWRST('XXX','BUG ')
47203      WRITE(ICOUT,1417)
47204 1417 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
47205      CALL DPWRST('XXX','BUG ')
47206 1419 CONTINUE
47207      GOTO9000
47208C
47209 1420 CONTINUE
47210      IFOUND='YES'
47211      A1=ARG(1)
47212      GY1MIN=A1
47213      GY2MIN=A1
47214      IY1MIN='FIXE'
47215      IY2MIN='FIXE'
47216C
47217      IF(IFEEDB.EQ.'OFF')GOTO1429
47218      WRITE(ICOUT,999)
47219      CALL DPWRST('XXX','BUG ')
47220      WRITE(ICOUT,1425)
47221 1425 FORMAT('THE Y AXIS MINIMUM (FOR BOTH VERTICAL')
47222      CALL DPWRST('XXX','BUG ')
47223      WRITE(ICOUT,1426)GY1MIN
47224 1426 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
47225     1E15.7)
47226      CALL DPWRST('XXX','BUG ')
47227 1429 CONTINUE
47228      GOTO9000
47229C
47230 1499 CONTINUE
47231C
47232C               *****************************************************
47233C               **  TREAT THE CASE WHEN THE                        **
47234C               **  LEFT   VERTICAL   AXIS MINIMUM ARE TO BE FIXED  **
47235C               *****************************************************
47236C
47237      IF(ICOM.EQ.'Y1MI')GOTO1500
47238      GOTO1599
47239C
47240 1500 CONTINUE
47241      IF(NUMARG.LE.0)GOTO1510
47242      IF(IARGT(1).EQ.'NUMB')GOTO1520
47243      GOTO1510
47244C
47245 1510 CONTINUE
47246      IFOUND='YES'
47247      GY1MIN=CPUMIN
47248      IY1MIN='FLOA'
47249C
47250      IF(IFEEDB.EQ.'OFF')GOTO1519
47251      WRITE(ICOUT,999)
47252      CALL DPWRST('XXX','BUG ')
47253      WRITE(ICOUT,1515)
47254 1515 FORMAT('THE Y AXIS MINIMUM (FOR THE LEFT   VERTICAL  ')
47255      CALL DPWRST('XXX','BUG ')
47256      WRITE(ICOUT,1516)
47257 1516 FORMAT('FRAME LINE) HAS JUST BEEN SET')
47258      CALL DPWRST('XXX','BUG ')
47259      WRITE(ICOUT,1517)
47260 1517 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
47261      CALL DPWRST('XXX','BUG ')
47262 1519 CONTINUE
47263      GOTO9000
47264C
47265 1520 CONTINUE
47266      IFOUND='YES'
47267      A1=ARG(1)
47268      GY1MIN=A1
47269      IY1MIN='FIXE'
47270C
47271      IF(IFEEDB.EQ.'OFF')GOTO1529
47272      WRITE(ICOUT,999)
47273      CALL DPWRST('XXX','BUG ')
47274      WRITE(ICOUT,1525)
47275 1525 FORMAT('THE Y AXIS MINIMUM (FOR THE LEFT   VERTICAL  ')
47276      CALL DPWRST('XXX','BUG ')
47277      WRITE(ICOUT,1526)GY1MIN
47278 1526 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
47279     1E15.7)
47280      CALL DPWRST('XXX','BUG ')
47281 1529 CONTINUE
47282      GOTO9000
47283C
47284 1599 CONTINUE
47285C
47286C               *****************************************************
47287C               **  TREAT THE CASE WHEN THE                        **
47288C               **  RIGHT  VERTICAL   AXIS MINIMUM ARE TO BE FIXED  **
47289C               *****************************************************
47290C
47291      IF(ICOM.EQ.'Y2MI')GOTO1600
47292      GOTO1699
47293C
47294 1600 CONTINUE
47295      IF(NUMARG.LE.0)GOTO1610
47296      IF(IARGT(1).EQ.'NUMB')GOTO1620
47297      GOTO1610
47298C
47299 1610 CONTINUE
47300      IFOUND='YES'
47301      GY2MIN=CPUMIN
47302      IY2MIN='FLOA'
47303C
47304      IF(IFEEDB.EQ.'OFF')GOTO1619
47305      WRITE(ICOUT,999)
47306      CALL DPWRST('XXX','BUG ')
47307      WRITE(ICOUT,1615)
47308 1615 FORMAT('THE Y AXIS MINIMUM (FOR THE RIGHT  VERTICAL  ')
47309      CALL DPWRST('XXX','BUG ')
47310      WRITE(ICOUT,1616)
47311 1616 FORMAT('FRAME LINE) HAS JUST BEEN SET')
47312      CALL DPWRST('XXX','BUG ')
47313      WRITE(ICOUT,1617)
47314 1617 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
47315      CALL DPWRST('XXX','BUG ')
47316 1619 CONTINUE
47317      GOTO9000
47318C
47319 1620 CONTINUE
47320      IFOUND='YES'
47321      A1=ARG(1)
47322      GY2MIN=A1
47323      IY2MIN='FIXE'
47324C
47325      IF(IFEEDB.EQ.'OFF')GOTO1629
47326      WRITE(ICOUT,999)
47327      CALL DPWRST('XXX','BUG ')
47328      WRITE(ICOUT,1625)
47329 1625 FORMAT('THE Y AXIS MINIMUM (FOR THE RIGHT  VERTICAL  ')
47330      CALL DPWRST('XXX','BUG ')
47331      WRITE(ICOUT,1626)GY2MIN
47332 1626 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
47333     1E15.7)
47334      CALL DPWRST('XXX','BUG ')
47335 1629 CONTINUE
47336      GOTO9000
47337C
47338 1699 CONTINUE
47339C
47340C               ******************************************
47341C               **  TREAT THE CASE WHEN                 **
47342C               **  BOTH AXIS MINIMUM ARE TO BE FIXED    **
47343C               ******************************************
47344C
47345C
47346      IF(ICOM.EQ.'XYMI')GOTO1700
47347      IF(ICOM.EQ.'YXMI')GOTO1700
47348      IF(ICOM.EQ.'MINI')GOTO1700
47349      IF(ICOM.EQ.'MIN ')GOTO1700
47350      GOTO1799
47351C
47352 1700 CONTINUE
47353      IF(NUMARG.LE.0)GOTO1710
47354      IF(IARGT(1).EQ.'NUMB')GOTO1720
47355      GOTO1710
47356C
47357 1710 CONTINUE
47358      IFOUND='YES'
47359      GX1MIN=CPUMIN
47360      GY1MIN=CPUMIN
47361      GX2MIN=CPUMIN
47362      GY2MIN=CPUMIN
47363      IX1MIN='FLOA'
47364      IY1MIN='FLOA'
47365      IX2MIN='FLOA'
47366      IY2MIN='FLOA'
47367C
47368      IF(IFEEDB.EQ.'OFF')GOTO1719
47369      WRITE(ICOUT,999)
47370      CALL DPWRST('XXX','BUG ')
47371      WRITE(ICOUT,1715)
47372 1715 FORMAT('THE X AXIS MINIMUM (FOR ALL 4')
47373      CALL DPWRST('XXX','BUG ')
47374      WRITE(ICOUT,1716)
47375 1716 FORMAT('FRAME LINES) HAS JUST BEEN SET')
47376      CALL DPWRST('XXX','BUG ')
47377      WRITE(ICOUT,1717)
47378 1717 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
47379      CALL DPWRST('XXX','BUG ')
47380 1719 CONTINUE
47381      GOTO9000
47382C
47383 1720 CONTINUE
47384      IFOUND='YES'
47385      A1=ARG(1)
47386      GX1MIN=A1
47387      GY1MIN=A1
47388      GX2MIN=A1
47389      GY2MIN=A1
47390      IX1MIN='FIXE'
47391      IY1MIN='FIXE'
47392      IX2MIN='FIXE'
47393      IY2MIN='FIXE'
47394C
47395      IF(IFEEDB.EQ.'OFF')GOTO1729
47396      WRITE(ICOUT,999)
47397      CALL DPWRST('XXX','BUG ')
47398      WRITE(ICOUT,1725)
47399 1725 FORMAT('THE AXIS MINIMUM (FOR ALL 4')
47400      CALL DPWRST('XXX','BUG ')
47401      WRITE(ICOUT,1726)GX1MIN
47402 1726 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
47403     1E15.7)
47404      CALL DPWRST('XXX','BUG ')
47405 1729 CONTINUE
47406      GOTO9000
47407C
47408 1799 CONTINUE
47409      GOTO9000
47410C
47411C               ********************************************
47412C               **  STEP 81--                             **
47413C               **  TREAT THE    ?    CASE--              **
47414C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
47415C               ********************************************
47416C
47417 8100 CONTINUE
47418      IFOUND='YES'
47419      WRITE(ICOUT,999)
47420      CALL DPWRST('XXX','BUG ')
47421      WRITE(ICOUT,8111)
47422 8111 FORMAT('THE CURRENT AXIS MINIMA ARE ')
47423      CALL DPWRST('XXX','BUG ')
47424      IF(IX1MIN.NE.'FLOA')WRITE(ICOUT,8112)GX1MIN
47425 8112 FORMAT('            --X1 (BOTTOM HORIZONTAL) = ',E15.7)
47426      IF(IX1MIN.NE.'FLOA')CALL DPWRST('XXX','BUG ')
47427      IF(IX1MIN.EQ.'FLOA')WRITE(ICOUT,8113)
47428 8113 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
47429      IF(IX1MIN.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47430      IF(IX2MIN.NE.'FLOA')WRITE(ICOUT,8114)GX2MIN
47431 8114 FORMAT('            --X2 (TOP    HORIZONTAL) = ',E15.7)
47432      IF(IX2MIN.NE.'FLOA')CALL DPWRST('XXX','BUG ')
47433      IF(IX2MIN.EQ.'FLOA')WRITE(ICOUT,8115)
47434 8115 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
47435      IF(IX2MIN.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47436      IF(IY1MIN.NE.'FLOA')WRITE(ICOUT,8116)GY1MIN
47437 8116 FORMAT('            --Y1 (LEFT   VERTICAL  ) = ',E15.7)
47438      IF(IY1MIN.NE.'FLOA')CALL DPWRST('XXX','BUG ')
47439      IF(IY1MIN.EQ.'FLOA')WRITE(ICOUT,8117)
47440 8117 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
47441      IF(IY1MIN.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47442      IF(IY2MIN.NE.'FLOA')WRITE(ICOUT,8118)GY2MIN
47443 8118 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = ',E15.7)
47444      IF(IY2MIN.NE.'FLOA')CALL DPWRST('XXX','BUG ')
47445      IF(IY2MIN.EQ.'FLOA')WRITE(ICOUT,8119)
47446 8119 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = FLOAT & NEAT')
47447      IF(IY2MIN.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47448      WRITE(ICOUT,999)
47449      CALL DPWRST('XXX','BUG ')
47450      WRITE(ICOUT,8121)
47451 8121 FORMAT('THE DEFAULT AXIS MINIMA ARE ')
47452      CALL DPWRST('XXX','BUG ')
47453      WRITE(ICOUT,8122)
47454 8122 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
47455      CALL DPWRST('XXX','BUG ')
47456      WRITE(ICOUT,8123)
47457 8123 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
47458      CALL DPWRST('XXX','BUG ')
47459      WRITE(ICOUT,8124)
47460 8124 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
47461      CALL DPWRST('XXX','BUG ')
47462      WRITE(ICOUT,8125)
47463 8125 FORMAT('            --Y2 (BOTTOM VERTICAL  ) = FLOAT & NEAT')
47464      CALL DPWRST('XXX','BUG ')
47465      GOTO9000
47466C
47467C               ******************
47468C               **   STEP 90--  **
47469C               **   EXIT       **
47470C               ******************
47471C
47472 9000 CONTINUE
47473      RETURN
47474      END
47475      SUBROUTINE DPMITN(IHARG,IARGT,IARG,NUMARG,
47476     1                  IX1NSW,IX2NSW,IY1NSW,IY2NSW,
47477     1                  NMNX1T,NMNX2T,NMNY1T,NMNY2T,
47478     1                  IFOUND,IERROR)
47479C
47480C     PURPOSE--DEFINE THE NUMBER OF MINOR TIC MARKS
47481C              FOR HORIZONTAL FRAME LINES OR VERTICAL FRAME LINES OR BOTH.
47482C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
47483C                     --IARG   (AN INTEGER VECTOR)
47484C                     --NUMARG
47485C     OUTPUT ARGUMENTS--
47486C                     --IX1NSW (A CHARACTER VARIABLE)
47487C                     --IX2NSW (A CHARACTER VARIABLE)
47488C                     --IY1NSW (A CHARACTER VARIABLE)
47489C                     --IY2NSW (A CHARACTER VARIABLE)
47490C                     --NMNX1T (AN INTEGER VARIABLE)
47491C                     --NMNX2T (AN INTEGER VARIABLE)
47492C                     --NMNY1T (AN INTEGER VARIABLE)
47493C                     --NMNY2T (AN INTEGER VARIABLE)
47494C                     --IFOUND ('YES' OR 'NO' )
47495C                     --IERROR ('YES' OR 'NO' )
47496C     WRITTEN BY--JAMES J. FILLIBEN
47497C                 STATISTICAL ENGINEERING DIVISION
47498C                 INFORMATION TECHNOLOGY LABORATORY
47499C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
47500C                 GAITHERSBURG, MD 20899-8980
47501C                 PHONE--301-975-2855
47502C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
47503C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
47504C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
47505C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
47506C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
47507C     LANGUAGE--ANSI FORTRAN (1977)
47508C     VERSION NUMBER--82/7
47509C     ORIGINAL VERSION--DECEMBER  1982.
47510C
47511C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
47512C
47513      CHARACTER*4 IHARG
47514      CHARACTER*4 IARGT
47515C
47516      CHARACTER*4 IX1NSW
47517      CHARACTER*4 IX2NSW
47518      CHARACTER*4 IY1NSW
47519      CHARACTER*4 IY2NSW
47520C
47521      CHARACTER*4 IFOUND
47522      CHARACTER*4 IERROR
47523C
47524      CHARACTER*4 IHHOLD
47525C
47526C---------------------------------------------------------------------
47527C
47528      DIMENSION IHARG(*)
47529      DIMENSION IARGT(*)
47530      DIMENSION IARG(*)
47531C
47532C---------------------------------------------------------------------
47533C
47534      INCLUDE 'DPCOP2.INC'
47535C
47536C-----START POINT-----------------------------------------------------
47537C
47538      IFOUND='NO'
47539      IERROR='NO'
47540C
47541      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'XTIC')GOTO1100
47542      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'X1TI')GOTO1200
47543      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'X2TI')GOTO1300
47544      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'YTIC')GOTO1400
47545      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'Y1TI')GOTO1500
47546      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'Y2TI')GOTO1600
47547      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TIC')GOTO1700
47548      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TICS')GOTO1700
47549      GOTO9000
47550C
47551C               ********************************************************
47552C               **  STEP 1--
47553C               **  TREAT THE CASE WHEN
47554C               **  ONLY THE HORIZONTAL MINOR TICS ARE TO BE CHANGED
47555C               ********************************************************
47556C
47557 1100 CONTINUE
47558      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1110
47559      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1110
47560C
47561      WRITE(ICOUT,999)
47562  999 FORMAT(1X)
47563      CALL DPWRST('XXX','BUG ')
47564      WRITE(ICOUT,1101)
47565 1101 FORMAT('***** ERROR IN DPMITN--')
47566      CALL DPWRST('XXX','BUG ')
47567      WRITE(ICOUT,1102)
47568 1102 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
47569      CALL DPWRST('XXX','BUG ')
47570      WRITE(ICOUT,1103)
47571 1103 FORMAT('      NUMBER OF MINOR (HORIZONTAL) TIC MARKS.')
47572      CALL DPWRST('XXX','BUG ')
47573      WRITE(ICOUT,1104)
47574 1104 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
47575      CALL DPWRST('XXX','BUG ')
47576      WRITE(ICOUT,1105)
47577 1105 FORMAT('      (ON THE HORIZONTAL FRAME LINES)--')
47578      CALL DPWRST('XXX','BUG ')
47579      WRITE(ICOUT,1106)
47580 1106 FORMAT('      MINOR XTIC MARK NUMBER 3')
47581      CALL DPWRST('XXX','BUG ')
47582      WRITE(ICOUT,1107)
47583 1107 FORMAT('      MINOR XTICS NUMBER 3')
47584      CALL DPWRST('XXX','BUG ')
47585      IERROR='YES'
47586      GOTO9000
47587C
47588 1110 CONTINUE
47589      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
47590      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
47591      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
47592      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
47593      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1150
47594      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
47595      IERROR='YES'
47596      GOTO9000
47597C
47598 1150 CONTINUE
47599      IHHOLD='FLOA'
47600      IHOLD=(-1)
47601      GOTO1180
47602C
47603 1160 CONTINUE
47604      IHHOLD='FIXE'
47605      IHOLD=IARG(NUMARG)
47606      GOTO1180
47607C
47608 1180 CONTINUE
47609      IFOUND='YES'
47610      IX1NSW=IHHOLD
47611      IX2NSW=IHHOLD
47612      NMNX1T=IHOLD
47613      NMNX2T=IHOLD
47614C
47615      IF(IFEEDB.EQ.'OFF')GOTO1189
47616      WRITE(ICOUT,999)
47617      CALL DPWRST('XXX','BUG ')
47618      WRITE(ICOUT,1181)
47619 1181 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
47620      CALL DPWRST('XXX','BUG ')
47621      WRITE(ICOUT,1182)
47622 1182 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES')
47623      CALL DPWRST('XXX','BUG ')
47624      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1183)IHOLD
47625 1183 FORMAT('HAS JUST BEEN SET TO ',I8)
47626      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
47627      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1184)
47628 1184 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
47629      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47630 1189 CONTINUE
47631      GOTO9000
47632C
47633C               ********************************************************
47634C               **  STEP 2--
47635C               **  TREAT THE CASE WHEN
47636C               **  ONLY THE BOTTOM HORIZONTAL MINOR TICS ARE TO BE CHANGED
47637C               ********************************************************
47638C
47639 1200 CONTINUE
47640      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1210
47641      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1210
47642C
47643      WRITE(ICOUT,999)
47644      CALL DPWRST('XXX','BUG ')
47645      WRITE(ICOUT,1201)
47646 1201 FORMAT('***** ERROR IN DPMITN--')
47647      CALL DPWRST('XXX','BUG ')
47648      WRITE(ICOUT,1202)
47649 1202 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
47650      CALL DPWRST('XXX','BUG ')
47651      WRITE(ICOUT,1203)
47652 1203 FORMAT('      NUMBER OF MINOR (HORIZONTAL) TIC MARKS.')
47653      CALL DPWRST('XXX','BUG ')
47654      WRITE(ICOUT,1204)
47655 1204 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
47656      CALL DPWRST('XXX','BUG ')
47657      WRITE(ICOUT,1205)
47658 1205 FORMAT('      (ON THE BOTTOM HORIZONTAL FRAME LINES)--')
47659      CALL DPWRST('XXX','BUG ')
47660      WRITE(ICOUT,1206)
47661 1206 FORMAT('      MINOR X1TIC MARK NUMBER 3')
47662      CALL DPWRST('XXX','BUG ')
47663      WRITE(ICOUT,1207)
47664 1207 FORMAT('      MINOR X1TICS NUMBER 3')
47665      CALL DPWRST('XXX','BUG ')
47666      IERROR='YES'
47667      GOTO9000
47668C
47669 1210 CONTINUE
47670      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
47671      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
47672      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
47673      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
47674      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1250
47675      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
47676      IERROR='YES'
47677      GOTO9000
47678C
47679 1250 CONTINUE
47680      IHHOLD='FLOA'
47681      IHOLD=(-1)
47682      GOTO1280
47683C
47684 1260 CONTINUE
47685      IHHOLD='FIXE'
47686      IHOLD=IARG(NUMARG)
47687      GOTO1280
47688C
47689 1280 CONTINUE
47690      IFOUND='YES'
47691      IX1NSW=IHHOLD
47692      NMNX1T=IHOLD
47693C
47694      IF(IFEEDB.EQ.'OFF')GOTO1289
47695      WRITE(ICOUT,999)
47696      CALL DPWRST('XXX','BUG ')
47697      WRITE(ICOUT,1281)
47698 1281 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
47699      CALL DPWRST('XXX','BUG ')
47700      WRITE(ICOUT,1282)
47701 1282 FORMAT('(FOR THE BOTTOM HORIZONTAL FRAME LINE')
47702      CALL DPWRST('XXX','BUG ')
47703      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1283)IHOLD
47704 1283 FORMAT('HAS JUST BEEN SET TO ',I8)
47705      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
47706      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1284)
47707 1284 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
47708      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47709 1289 CONTINUE
47710      GOTO9000
47711C
47712C               ********************************************************
47713C               **  STEP 3--
47714C               **  TREAT THE CASE WHEN
47715C               **  ONLY THE TOP    HORIZONTAL MINOR TICS ARE TO BE CHANGED
47716C               ********************************************************
47717C
47718 1300 CONTINUE
47719      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1310
47720      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1310
47721C
47722      WRITE(ICOUT,999)
47723      CALL DPWRST('XXX','BUG ')
47724      WRITE(ICOUT,1301)
47725 1301 FORMAT('***** ERROR IN DPMITN--')
47726      CALL DPWRST('XXX','BUG ')
47727      WRITE(ICOUT,1302)
47728 1302 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
47729      CALL DPWRST('XXX','BUG ')
47730      WRITE(ICOUT,1303)
47731 1303 FORMAT('      NUMBER OF MINOR (HORIZONTAL) TIC MARKS.')
47732      CALL DPWRST('XXX','BUG ')
47733      WRITE(ICOUT,1304)
47734 1304 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
47735      CALL DPWRST('XXX','BUG ')
47736      WRITE(ICOUT,1305)
47737 1305 FORMAT('      (ON THE TOP HORIZONTAL FRAME LINES)--')
47738      CALL DPWRST('XXX','BUG ')
47739      WRITE(ICOUT,1306)
47740 1306 FORMAT('      MINOR X2TIC MARK NUMBER 3')
47741      CALL DPWRST('XXX','BUG ')
47742      WRITE(ICOUT,1307)
47743 1307 FORMAT('      MINOR X2TICS NUMBER 3')
47744      CALL DPWRST('XXX','BUG ')
47745      IERROR='YES'
47746      GOTO9000
47747C
47748 1310 CONTINUE
47749      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
47750      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
47751      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
47752      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
47753      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1350
47754      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
47755      IERROR='YES'
47756      GOTO9000
47757C
47758 1350 CONTINUE
47759      IHHOLD='FLOA'
47760      IHOLD=(-1)
47761      GOTO1380
47762C
47763 1360 CONTINUE
47764      IHHOLD='FIXE'
47765      IHOLD=IARG(NUMARG)
47766      GOTO1380
47767C
47768 1380 CONTINUE
47769      IFOUND='YES'
47770      IX2NSW=IHHOLD
47771      NMNX2T=IHOLD
47772C
47773      IF(IFEEDB.EQ.'OFF')GOTO1389
47774      WRITE(ICOUT,999)
47775      CALL DPWRST('XXX','BUG ')
47776      WRITE(ICOUT,1381)
47777 1381 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
47778      CALL DPWRST('XXX','BUG ')
47779      WRITE(ICOUT,1382)
47780 1382 FORMAT('(FOR THE TOP HORIZONTAL FRAME LINE')
47781      CALL DPWRST('XXX','BUG ')
47782      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1383)IHOLD
47783 1383 FORMAT('HAS JUST BEEN SET TO ',I8)
47784      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
47785      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1384)
47786 1384 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
47787      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47788 1389 CONTINUE
47789      GOTO9000
47790C
47791C               ********************************************************
47792C               **  STEP 4--
47793C               **  TREAT THE CASE WHEN
47794C               **  ONLY THE VERTICAL    MINOR TICS ARE TO BE CHANGED
47795C               ********************************************************
47796C
47797 1400 CONTINUE
47798      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1410
47799      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1410
47800C
47801      WRITE(ICOUT,999)
47802      CALL DPWRST('XXX','BUG ')
47803      WRITE(ICOUT,1401)
47804 1401 FORMAT('***** ERROR IN DPMITN--')
47805      CALL DPWRST('XXX','BUG ')
47806      WRITE(ICOUT,1402)
47807 1402 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
47808      CALL DPWRST('XXX','BUG ')
47809      WRITE(ICOUT,1403)
47810 1403 FORMAT('      NUMBER OF MINOR (VERTICAL) TIC MARKS.')
47811      CALL DPWRST('XXX','BUG ')
47812      WRITE(ICOUT,1404)
47813 1404 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
47814      CALL DPWRST('XXX','BUG ')
47815      WRITE(ICOUT,1405)
47816 1405 FORMAT('      (ON THE VERTICAL FRAME LINES)--')
47817      CALL DPWRST('XXX','BUG ')
47818      WRITE(ICOUT,1406)
47819 1406 FORMAT('      MINOR YTIC MARK NUMBER 3')
47820      CALL DPWRST('XXX','BUG ')
47821      WRITE(ICOUT,1407)
47822 1407 FORMAT('      MINOR YTICS NUMBER 3')
47823      CALL DPWRST('XXX','BUG ')
47824      IERROR='YES'
47825      GOTO9000
47826C
47827 1410 CONTINUE
47828      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
47829      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
47830      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
47831      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
47832      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1450
47833      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
47834      IERROR='YES'
47835      GOTO9000
47836C
47837 1450 CONTINUE
47838      IHHOLD='FLOA'
47839      IHOLD=(-1)
47840      GOTO1480
47841C
47842 1460 CONTINUE
47843      IHHOLD='FIXE'
47844      IHOLD=IARG(NUMARG)
47845      GOTO1480
47846C
47847 1480 CONTINUE
47848      IFOUND='YES'
47849      IY1NSW=IHHOLD
47850      IY2NSW=IHHOLD
47851      NMNY1T=IHOLD
47852      NMNY2T=IHOLD
47853C
47854      IF(IFEEDB.EQ.'OFF')GOTO1489
47855      WRITE(ICOUT,999)
47856      CALL DPWRST('XXX','BUG ')
47857      WRITE(ICOUT,1481)
47858 1481 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
47859      CALL DPWRST('XXX','BUG ')
47860      WRITE(ICOUT,1482)
47861 1482 FORMAT('(FOR BOTH VERTICAL FRAME LINES')
47862      CALL DPWRST('XXX','BUG ')
47863      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1483)IHOLD
47864 1483 FORMAT('HAS JUST BEEN SET TO ',I8)
47865      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
47866      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1484)
47867 1484 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
47868      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47869 1489 CONTINUE
47870      GOTO9000
47871C
47872C               ********************************************************
47873C               **  STEP 5--
47874C               **  TREAT THE CASE WHEN
47875C               **  ONLY THE LEFT VERTICAL MINOR TICS ARE TO BE CHANGED
47876C               ********************************************************
47877C
47878 1500 CONTINUE
47879      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1510
47880      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1510
47881C
47882      WRITE(ICOUT,999)
47883      CALL DPWRST('XXX','BUG ')
47884      WRITE(ICOUT,1501)
47885 1501 FORMAT('***** ERROR IN DPMITN--')
47886      CALL DPWRST('XXX','BUG ')
47887      WRITE(ICOUT,1502)
47888 1502 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
47889      CALL DPWRST('XXX','BUG ')
47890      WRITE(ICOUT,1503)
47891 1503 FORMAT('      NUMBER OF MINOR (VERTICAL) TIC MARKS.')
47892      CALL DPWRST('XXX','BUG ')
47893      WRITE(ICOUT,1504)
47894 1504 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
47895      CALL DPWRST('XXX','BUG ')
47896      WRITE(ICOUT,1505)
47897 1505 FORMAT('      (ON THE LEFT VERTICAL FRAME LINES)--')
47898      CALL DPWRST('XXX','BUG ')
47899      WRITE(ICOUT,1506)
47900 1506 FORMAT('      MINOR Y1TIC MARK NUMBER 3')
47901      CALL DPWRST('XXX','BUG ')
47902      WRITE(ICOUT,1507)
47903 1507 FORMAT('      MINOR Y1TICS NUMBER 3')
47904      CALL DPWRST('XXX','BUG ')
47905      IERROR='YES'
47906      GOTO9000
47907C
47908 1510 CONTINUE
47909      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
47910      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
47911      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
47912      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
47913      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1550
47914      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
47915      IERROR='YES'
47916      GOTO9000
47917C
47918 1550 CONTINUE
47919      IHHOLD='FLOA'
47920      IHOLD=(-1)
47921      GOTO1580
47922C
47923 1560 CONTINUE
47924      IHHOLD='FIXE'
47925      IHOLD=IARG(NUMARG)
47926      GOTO1580
47927C
47928 1580 CONTINUE
47929      IFOUND='YES'
47930      IY1NSW=IHHOLD
47931      NMNY1T=IHOLD
47932C
47933      IF(IFEEDB.EQ.'OFF')GOTO1589
47934      WRITE(ICOUT,999)
47935      CALL DPWRST('XXX','BUG ')
47936      WRITE(ICOUT,1581)
47937 1581 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
47938      CALL DPWRST('XXX','BUG ')
47939      WRITE(ICOUT,1582)
47940 1582 FORMAT('(FOR THE LEFT VERTICAL FRAME LINE')
47941      CALL DPWRST('XXX','BUG ')
47942      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1583)IHOLD
47943 1583 FORMAT('HAS JUST BEEN SET TO ',I8)
47944      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
47945      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1584)
47946 1584 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
47947      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
47948 1589 CONTINUE
47949      GOTO9000
47950C
47951C               ********************************************************
47952C               **  STEP 6--
47953C               **  TREAT THE CASE WHEN
47954C               **  ONLY THE RIGHT VERTICAL MINOR TICS ARE TO BE CHANGED
47955C               ********************************************************
47956C
47957 1600 CONTINUE
47958      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1610
47959      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1610
47960C
47961      WRITE(ICOUT,999)
47962      CALL DPWRST('XXX','BUG ')
47963      WRITE(ICOUT,1601)
47964 1601 FORMAT('***** ERROR IN DPMITN--')
47965      CALL DPWRST('XXX','BUG ')
47966      WRITE(ICOUT,1602)
47967 1602 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
47968      CALL DPWRST('XXX','BUG ')
47969      WRITE(ICOUT,1603)
47970 1603 FORMAT('      NUMBER OF MINOR (VERTICAL) TIC MARKS.')
47971      CALL DPWRST('XXX','BUG ')
47972      WRITE(ICOUT,1604)
47973 1604 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
47974      CALL DPWRST('XXX','BUG ')
47975      WRITE(ICOUT,1605)
47976 1605 FORMAT('      (ON THE RIGHT VERTICAL FRAME LINES)--')
47977      CALL DPWRST('XXX','BUG ')
47978      WRITE(ICOUT,1606)
47979 1606 FORMAT('      MINOR Y2TIC MARK NUMBER 3')
47980      CALL DPWRST('XXX','BUG ')
47981      WRITE(ICOUT,1607)
47982 1607 FORMAT('      MINOR Y2TICS NUMBER 3')
47983      CALL DPWRST('XXX','BUG ')
47984      IERROR='YES'
47985      GOTO9000
47986C
47987 1610 CONTINUE
47988      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
47989      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
47990      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
47991      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
47992      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1650
47993      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
47994      IERROR='YES'
47995      GOTO9000
47996C
47997 1650 CONTINUE
47998      IHHOLD='FLOA'
47999      IHOLD=(-1)
48000      GOTO1680
48001C
48002 1660 CONTINUE
48003      IHHOLD='FIXE'
48004      IHOLD=IARG(NUMARG)
48005      GOTO1680
48006C
48007 1680 CONTINUE
48008      IFOUND='YES'
48009      IY2NSW=IHHOLD
48010      NMNY2T=IHOLD
48011C
48012      IF(IFEEDB.EQ.'OFF')GOTO1689
48013      WRITE(ICOUT,999)
48014      CALL DPWRST('XXX','BUG ')
48015      WRITE(ICOUT,1681)
48016 1681 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
48017      CALL DPWRST('XXX','BUG ')
48018      WRITE(ICOUT,1682)
48019 1682 FORMAT('(FOR THE RIGHT VERTICAL FRAME LINE')
48020      CALL DPWRST('XXX','BUG ')
48021      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1683)IHOLD
48022 1683 FORMAT('HAS JUST BEEN SET TO ',I8)
48023      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
48024      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1684)
48025 1684 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
48026      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
48027 1689 CONTINUE
48028      GOTO9000
48029C
48030C               ********************************************************
48031C               **  STEP 7--
48032C               **  TREAT THE CASE WHEN
48033C               **  BOTH HORIZONTAL AND VERTICAL    MINOR TICS ARE TO BE
48034C               ********************************************************
48035C
48036 1700 CONTINUE
48037      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1710
48038      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1710
48039C
48040      WRITE(ICOUT,999)
48041      CALL DPWRST('XXX','BUG ')
48042      WRITE(ICOUT,1701)
48043 1701 FORMAT('***** ERROR IN DPMITN--')
48044      CALL DPWRST('XXX','BUG ')
48045      WRITE(ICOUT,1702)
48046 1702 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
48047      CALL DPWRST('XXX','BUG ')
48048      WRITE(ICOUT,1703)
48049 1703 FORMAT('      NUMBER OF MINOR TIC MARKS.')
48050      CALL DPWRST('XXX','BUG ')
48051      WRITE(ICOUT,1704)
48052 1704 FORMAT('      EXAMPLE TO SPECIFY 3 MINOR TIC MARKS')
48053      CALL DPWRST('XXX','BUG ')
48054      WRITE(ICOUT,1705)
48055 1705 FORMAT('      (ON ALL 4 FRAME LINES)--')
48056      CALL DPWRST('XXX','BUG ')
48057      WRITE(ICOUT,1706)
48058 1706 FORMAT('      MINOR TIC MARK NUMBER 3')
48059      CALL DPWRST('XXX','BUG ')
48060      WRITE(ICOUT,1707)
48061 1707 FORMAT('      MINOR TICS NUMBER 3')
48062      CALL DPWRST('XXX','BUG ')
48063      IERROR='YES'
48064      GOTO9000
48065C
48066 1710 CONTINUE
48067      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
48068      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
48069      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
48070      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
48071      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1750
48072      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
48073      IERROR='YES'
48074      GOTO9000
48075C
48076 1750 CONTINUE
48077      IHHOLD='FLOA'
48078      IHOLD=(-1)
48079      GOTO1780
48080C
48081 1760 CONTINUE
48082      IHHOLD='FIXE'
48083      IHOLD=IARG(NUMARG)
48084      GOTO1780
48085C
48086 1780 CONTINUE
48087      IFOUND='YES'
48088      IX1NSW=IHHOLD
48089      IX2NSW=IHHOLD
48090      IY1NSW=IHHOLD
48091      IY2NSW=IHHOLD
48092      NMNX1T=IHOLD
48093      NMNX2T=IHOLD
48094      NMNY1T=IHOLD
48095      NMNY2T=IHOLD
48096C
48097      IF(IFEEDB.EQ.'OFF')GOTO1789
48098      WRITE(ICOUT,999)
48099      CALL DPWRST('XXX','BUG ')
48100      WRITE(ICOUT,1781)
48101 1781 FORMAT('THE NUMBER OF MINOR TIC MARKS ')
48102      CALL DPWRST('XXX','BUG ')
48103      WRITE(ICOUT,1782)
48104 1782 FORMAT('(FOR EACH FRAME LINES')
48105      CALL DPWRST('XXX','BUG ')
48106      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1783)IHOLD
48107 1783 FORMAT('HAS JUST BEEN SET TO ',I8)
48108      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
48109      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1784)
48110 1784 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
48111      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
48112 1789 CONTINUE
48113      GOTO9000
48114C
48115C               *****************
48116C               **  STEP 90--  **
48117C               **  EXIT       **
48118C               *****************
48119C
48120 9000 CONTINUE
48121      RETURN
48122      END
48123      SUBROUTINE DPMJTC(ICOM,IHARG,IARGT,ARG,NUMARG,
48124     1                  IX1TSW,IX2TSW,IY1TSW,IY2TSW,
48125     1                  X1COOR,X2COOR,Y1COOR,Y2COOR,
48126     1                  NX1COO,NX2COO,NY1COO,NY2COO,
48127     1                  MAXTIC,
48128     1                  IFOUND,IERROR)
48129C
48130C     PURPOSE--DEFINE THE MAJOR TIC MARK COORDINATES
48131C              FOR ANY OF THE 4 FRAME LINES.
48132C              THE MAJOR TIC MARK COORDINATES ARE GIVEN IN UNITS
48133C              OF THE PLOTTED DATA.
48134C     ALSO, A SECONDARY PURPOSE IS TO ADJUST ACCORDINGLY
48135C              THE TIC MARK SWITCHES
48136C              FOR ANY OF THE 4 FRAME LINES.
48137C              SUCH TIC MARK SWITCHES TURN ON OR OFF
48138C              THE TIC MARKS ON THE 4 FRAME LINES OF A PLOT.
48139C              THE CONTENTS OF A TIC MARK SWITCH ARE
48140C              ON   OR    OFF
48141C              THE TIC MARK SWITCHES DEFINE WHETHER
48142C              THE TIC MARKS FOR A GIVEN FRAME SHOULD
48143C              BE ON (THAT IS, APPEAR), OR BE OFF (THAT IS,
48144C              BE SUPPRESSED.
48145C              THE TIC MARK SWITCHES FOR THE 4 FRAME LINES
48146C              ARE CONTAINED IN THE 4 VARIABLES
48147C              IX1TSW,IX2TSW,IY1TSW,IY2TSW,
48148C     INPUT  ARGUMENTS--ICOM
48149C                     --IHARG  (A  HOLLERITH VECTOR)
48150C                     --IARGT  (A  HOLLERITH VECTOR)
48151C                     --ARG    (A  FLOATING POINT VECTOR)
48152C                     --NUMARG
48153C                     --MAXTIC
48154C     OUTPUT ARGUMENTS--
48155C                     --IX1TSW,IX2TSW,IY1TSW,IY2TSW,
48156C                     --X1COOR,X2COOR,Y1COOR,Y2COOR,
48157C                     --NX1COO,NX2COO,NY1COO,NY2COO,
48158C                     --IFOUND ('YES' OR 'NO' )
48159C                     --IERROR ('YES' OR 'NO' )
48160C     WRITTEN BY--JAMES J. FILLIBEN
48161C                 STATISTICAL ENGINEERING DIVISION
48162C                 INFORMATION TECHNOLOGY LABORATORY
48163C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
48164C                 GAITHERSBURG, MD 20899-8980
48165C                 PHONE--301-975-2855
48166C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
48167C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
48168C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
48169C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
48170C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
48171C     LANGUAGE--ANSI FORTRAN (1977)
48172C     VERSION NUMBER--82/7
48173C     ORIGINAL VERSION--SEPTEMBER 1980.
48174C     UPDATED         --MAY       1982.
48175C
48176C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
48177C
48178      CHARACTER*4 ICOM
48179      CHARACTER*4 IHARG
48180      CHARACTER*4 IARGT
48181C
48182      CHARACTER*4 IX1TSW
48183      CHARACTER*4 IX2TSW
48184      CHARACTER*4 IY1TSW
48185      CHARACTER*4 IY2TSW
48186C
48187      CHARACTER*4 IFOUND
48188      CHARACTER*4 IERROR
48189C
48190C---------------------------------------------------------------------
48191C
48192      DIMENSION IHARG(*)
48193      DIMENSION IARGT(*)
48194      DIMENSION ARG(*)
48195C
48196      DIMENSION X1COOR(*)
48197      DIMENSION X2COOR(*)
48198      DIMENSION Y1COOR(*)
48199      DIMENSION Y2COOR(*)
48200C
48201C---------------------------------------------------------------------
48202C
48203      INCLUDE 'DPCOP2.INC'
48204C
48205C-----START POINT-----------------------------------------------------
48206C
48207      IFOUND='NO'
48208      IERROR='NO'
48209C
48210      ILOCC=0
48211      IF(NUMARG.LE.0)GOTO1900
48212      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')ILOCC=1
48213      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')ILOCC=2
48214      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'COOR')ILOCC=3
48215      ILOCCP=ILOCC+1
48216      IF(ILOCC.EQ.0)GOTO1900
48217C
48218C               *****************************************************
48219C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON    **
48220C               **  BOTH HORIZONTAL FRAME LINES ARE TO BE DEFINED  **
48221C               *****************************************************
48222C
48223      IF(ICOM.EQ.'XTIC')GOTO1100
48224      GOTO1199
48225C
48226 1100 CONTINUE
48227      IF(ILOCC.EQ.NUMARG)GOTO1110
48228      IF(IHARG(ILOCCP).EQ.'ON')GOTO1110
48229      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1120
48230      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1110
48231      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1110
48232      GOTO1130
48233C
48234 1110 CONTINUE
48235      IFOUND='YES'
48236      IX1TSW='ON'
48237      IX2TSW='ON'
48238      NX1COO=-1
48239      NX2COO=-1
48240C
48241      IF(IFEEDB.EQ.'OFF')GOTO1119
48242      WRITE(ICOUT,999)
48243  999 FORMAT(1X)
48244      CALL DPWRST('XXX','BUG ')
48245      WRITE(ICOUT,1115)
48246 1115 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
48247     1'FRAME LINES)')
48248      CALL DPWRST('XXX','BUG ')
48249      WRITE(ICOUT,1116)
48250 1116 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
48251      CALL DPWRST('XXX','BUG ')
48252 1119 CONTINUE
48253      GOTO1900
48254C
48255 1120 CONTINUE
48256      IFOUND='YES'
48257      IX1TSW='OFF'
48258      IX2TSW='OFF'
48259C
48260      IF(IFEEDB.EQ.'OFF')GOTO1129
48261      WRITE(ICOUT,999)
48262      CALL DPWRST('XXX','BUG ')
48263      WRITE(ICOUT,1125)
48264 1125 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
48265     1'FRAME LINES)')
48266      CALL DPWRST('XXX','BUG ')
48267      WRITE(ICOUT,1126)
48268 1126 FORMAT('HAVE JUST BEEN TURNED OFF ')
48269      CALL DPWRST('XXX','BUG ')
48270      WRITE(ICOUT,1127)
48271 1127 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON THEM')
48272      CALL DPWRST('XXX','BUG ')
48273 1129 CONTINUE
48274      GOTO1900
48275C
48276 1130 CONTINUE
48277      IX1TSW='ON'
48278      IX2TSW='ON'
48279C
48280      J=0
48281      DO1131I=ILOCCP,NUMARG
48282      J=J+1
48283      IF(J.GT.MAXTIC)GOTO1800
48284      IF(IARGT(I).NE.'NUMB')GOTO1850
48285      X1COOR(J)=ARG(I)
48286      X2COOR(J)=ARG(I)
48287 1131 CONTINUE
48288      IFOUND='YES'
48289      NX1COO=J
48290      NX2COO=J
48291C
48292      IF(IFEEDB.EQ.'OFF')GOTO1139
48293      WRITE(ICOUT,999)
48294      CALL DPWRST('XXX','BUG ')
48295      WRITE(ICOUT,1135)
48296 1135 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH HORIZONTAL ',
48297     1'FRAME LINES)')
48298      CALL DPWRST('XXX','BUG ')
48299      WRITE(ICOUT,1136)
48300 1136 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
48301      CALL DPWRST('XXX','BUG ')
48302 1139 CONTINUE
48303      GOTO1900
48304C
48305 1199 CONTINUE
48306C
48307C               **************************************************************
48308C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON
48309C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE ARE TO BE DEFINED **
48310C               **************************************************************
48311C
48312      IF(ICOM.EQ.'X1TI')GOTO1200
48313      GOTO1299
48314C
48315C
48316 1200 CONTINUE
48317      IF(ILOCC.EQ.NUMARG)GOTO1210
48318      IF(IHARG(ILOCCP).EQ.'ON')GOTO1210
48319      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1220
48320      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1210
48321      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1210
48322      GOTO1230
48323C
48324 1210 CONTINUE
48325      IFOUND='YES'
48326      IX1TSW='ON'
48327      NX1COO=-1
48328C
48329      IF(IFEEDB.EQ.'OFF')GOTO1219
48330      WRITE(ICOUT,999)
48331      CALL DPWRST('XXX','BUG ')
48332      WRITE(ICOUT,1215)
48333 1215 FORMAT('THE TIC COORDINATES (FOR THE BOTTOM HORIZONTAL ',
48334     1'FRAME LINE)')
48335      CALL DPWRST('XXX','BUG ')
48336      WRITE(ICOUT,1216)
48337 1216 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
48338      CALL DPWRST('XXX','BUG ')
48339 1219 CONTINUE
48340      GOTO1900
48341C
48342 1220 CONTINUE
48343      IFOUND='YES'
48344      IX1TSW='OFF'
48345C
48346      IF(IFEEDB.EQ.'OFF')GOTO1229
48347      WRITE(ICOUT,999)
48348      CALL DPWRST('XXX','BUG ')
48349      WRITE(ICOUT,1225)
48350 1225 FORMAT('THE TIC COORDINATES (FOR THE BOTTOM HORIZONTAL ',
48351     1'FRAME LINE)')
48352      CALL DPWRST('XXX','BUG ')
48353      WRITE(ICOUT,1226)
48354 1226 FORMAT('HAVE JUST BEEN TURNED OFF ')
48355      CALL DPWRST('XXX','BUG ')
48356      WRITE(ICOUT,1227)
48357 1227 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON IT)')
48358      CALL DPWRST('XXX','BUG ')
48359 1229 CONTINUE
48360      GOTO1900
48361C
48362 1230 CONTINUE
48363      IX1TSW='ON'
48364C
48365      J=0
48366      DO1231I=ILOCCP,NUMARG
48367      J=J+1
48368      IF(J.GT.MAXTIC)GOTO1800
48369      IF(IARGT(I).NE.'NUMB')GOTO1850
48370      X1COOR(J)=ARG(I)
48371 1231 CONTINUE
48372      IFOUND='YES'
48373      NX1COO=J
48374C
48375      IF(IFEEDB.EQ.'OFF')GOTO1239
48376      WRITE(ICOUT,999)
48377      CALL DPWRST('XXX','BUG ')
48378      WRITE(ICOUT,1235)
48379 1235 FORMAT('THE TIC COORDINATES (FOR THE BOTTOM HORIZONTAL ',
48380     1'FRAME LINE)')
48381      CALL DPWRST('XXX','BUG ')
48382      WRITE(ICOUT,1236)
48383 1236 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
48384      CALL DPWRST('XXX','BUG ')
48385 1239 CONTINUE
48386      GOTO1900
48387C
48388 1299 CONTINUE
48389C
48390C               **************************************************************
48391C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON
48392C               **  ONLY THE TOP    HORIZONTAL FRAME LINE ARE TO BE DEFINED **
48393C               **************************************************************
48394C
48395      IF(ICOM.EQ.'X2TI')GOTO1300
48396      GOTO1399
48397C
48398 1300 CONTINUE
48399      IF(ILOCC.EQ.NUMARG)GOTO1310
48400      IF(IHARG(ILOCCP).EQ.'ON')GOTO1310
48401      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1320
48402      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1310
48403      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1310
48404      GOTO1330
48405C
48406 1310 CONTINUE
48407      IFOUND='YES'
48408      IX2TSW='ON'
48409      NX2COO=-1
48410C
48411      IF(IFEEDB.EQ.'OFF')GOTO1319
48412      WRITE(ICOUT,999)
48413      CALL DPWRST('XXX','BUG ')
48414      WRITE(ICOUT,1315)
48415 1315 FORMAT('THE TIC COORDINATES (FOR THE TOP HORIZONTAL ',
48416     1'FRAME LINE)')
48417      CALL DPWRST('XXX','BUG ')
48418      WRITE(ICOUT,1316)
48419 1316 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
48420      CALL DPWRST('XXX','BUG ')
48421 1319 CONTINUE
48422      GOTO1900
48423C
48424 1320 CONTINUE
48425      IFOUND='YES'
48426      IX2TSW='OFF'
48427C
48428      IF(IFEEDB.EQ.'OFF')GOTO1329
48429      WRITE(ICOUT,999)
48430      CALL DPWRST('XXX','BUG ')
48431      WRITE(ICOUT,1325)
48432 1325 FORMAT('THE TIC COORDINATES (FOR THE TOP HORIZONTAL ',
48433     1'FRAME LINE)')
48434      CALL DPWRST('XXX','BUG ')
48435      WRITE(ICOUT,1326)
48436 1326 FORMAT('HAVE JUST BEEN TURNED OFF ')
48437      CALL DPWRST('XXX','BUG ')
48438      WRITE(ICOUT,1327)
48439 1327 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON IT)')
48440      CALL DPWRST('XXX','BUG ')
48441 1329 CONTINUE
48442      GOTO1900
48443C
48444 1330 CONTINUE
48445      IX2TSW='ON'
48446C
48447      J=0
48448      DO1331I=ILOCCP,NUMARG
48449      J=J+1
48450      IF(J.GT.MAXTIC)GOTO1800
48451      IF(IARGT(I).NE.'NUMB')GOTO1850
48452      X2COOR(J)=ARG(I)
48453 1331 CONTINUE
48454      IFOUND='YES'
48455      NX2COO=J
48456C
48457      IF(IFEEDB.EQ.'OFF')GOTO1339
48458      WRITE(ICOUT,999)
48459      CALL DPWRST('XXX','BUG ')
48460      WRITE(ICOUT,1335)
48461 1335 FORMAT('THE TIC COORDINATES (FOR THE TOP HORIZONTAL ',
48462     1'FRAME LINE)')
48463      CALL DPWRST('XXX','BUG ')
48464      WRITE(ICOUT,1336)
48465 1336 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
48466      CALL DPWRST('XXX','BUG ')
48467 1339 CONTINUE
48468      GOTO1900
48469C
48470 1399 CONTINUE
48471C
48472C               ***************************************************
48473C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON  **
48474C               **  BOTH VERTICAL FRAME LINES ARE TO BE DEFINED  **
48475C               ***************************************************
48476C
48477      IF(ICOM.EQ.'YTIC')GOTO1400
48478      GOTO1499
48479C
48480 1400 CONTINUE
48481      IF(ILOCC.EQ.NUMARG)GOTO1410
48482      IF(IHARG(ILOCCP).EQ.'ON')GOTO1410
48483      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1420
48484      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1410
48485      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1410
48486      GOTO1430
48487C
48488 1410 CONTINUE
48489      IFOUND='YES'
48490      IY1TSW='ON'
48491      IY2TSW='ON'
48492      NY1COO=-1
48493      NY2COO=-1
48494C
48495      IF(IFEEDB.EQ.'OFF')GOTO1419
48496      WRITE(ICOUT,999)
48497      CALL DPWRST('XXX','BUG ')
48498      WRITE(ICOUT,1415)
48499 1415 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH VERTICAL ',
48500     1'FRAME LINES)')
48501      CALL DPWRST('XXX','BUG ')
48502      WRITE(ICOUT,1416)
48503 1416 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
48504      CALL DPWRST('XXX','BUG ')
48505 1419 CONTINUE
48506      GOTO1900
48507C
48508 1420 CONTINUE
48509      IFOUND='YES'
48510      IY1TSW='OFF'
48511      IY2TSW='OFF'
48512C
48513      IF(IFEEDB.EQ.'OFF')GOTO1429
48514      WRITE(ICOUT,999)
48515      CALL DPWRST('XXX','BUG ')
48516      WRITE(ICOUT,1425)
48517 1425 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH VERTICAL ',
48518     1'FRAME LINES)')
48519      CALL DPWRST('XXX','BUG ')
48520      WRITE(ICOUT,1426)
48521 1426 FORMAT('HAVE JUST BEEN TURNED OFF ')
48522      CALL DPWRST('XXX','BUG ')
48523      WRITE(ICOUT,1427)
48524 1427 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON THEM')
48525      CALL DPWRST('XXX','BUG ')
48526 1429 CONTINUE
48527      GOTO1900
48528C
48529 1430 CONTINUE
48530      IY1TSW='ON'
48531      IY2TSW='ON'
48532C
48533      J=0
48534      DO1431I=ILOCCP,NUMARG
48535      J=J+1
48536      IF(J.GT.MAXTIC)GOTO1800
48537      IF(IARGT(I).NE.'NUMB')GOTO1850
48538      Y1COOR(J)=ARG(I)
48539      Y2COOR(J)=ARG(I)
48540 1431 CONTINUE
48541      IFOUND='YES'
48542      NY1COO=J
48543      NY2COO=J
48544C
48545      IF(IFEEDB.EQ.'OFF')GOTO1439
48546      WRITE(ICOUT,999)
48547      CALL DPWRST('XXX','BUG ')
48548      WRITE(ICOUT,1435)
48549 1435 FORMAT('THE MAJOR TIC MARK COORDINATES (FOR BOTH VERTICAL ',
48550     1'FRAME LINES)')
48551      CALL DPWRST('XXX','BUG ')
48552      WRITE(ICOUT,1436)
48553 1436 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
48554      CALL DPWRST('XXX','BUG ')
48555 1439 CONTINUE
48556      GOTO1900
48557C
48558 1499 CONTINUE
48559C
48560C               **************************************************************
48561C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON
48562C               **  ONLY THE LEFT   VERTICAL   FRAME LINE ARE TO BE DEFINED **
48563C               **************************************************************
48564C
48565      IF(ICOM.EQ.'Y1TI')GOTO1500
48566      GOTO1599
48567C
48568 1500 CONTINUE
48569      IF(ILOCC.EQ.NUMARG)GOTO1510
48570      IF(IHARG(ILOCCP).EQ.'ON')GOTO1510
48571      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1520
48572      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1510
48573      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1510
48574      GOTO1530
48575C
48576 1510 CONTINUE
48577      IFOUND='YES'
48578      IY1TSW='ON'
48579      NY1COO=-1
48580C
48581      IF(IFEEDB.EQ.'OFF')GOTO1519
48582      WRITE(ICOUT,999)
48583      CALL DPWRST('XXX','BUG ')
48584      WRITE(ICOUT,1515)
48585 1515 FORMAT('THE TIC COORDINATES (FOR THE LEFT VERTICAL ',
48586     1'FRAME LINE)')
48587      CALL DPWRST('XXX','BUG ')
48588      WRITE(ICOUT,1516)
48589 1516 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
48590      CALL DPWRST('XXX','BUG ')
48591 1519 CONTINUE
48592      GOTO1900
48593C
48594 1520 CONTINUE
48595      IFOUND='YES'
48596      IY1TSW='OFF'
48597C
48598      IF(IFEEDB.EQ.'OFF')GOTO1529
48599      WRITE(ICOUT,999)
48600      CALL DPWRST('XXX','BUG ')
48601      WRITE(ICOUT,1525)
48602 1525 FORMAT('THE TIC COORDINATES (FOR THE LEFT VERTICAL ',
48603     1'FRAME LINE)')
48604      CALL DPWRST('XXX','BUG ')
48605      WRITE(ICOUT,1526)
48606 1526 FORMAT('HAVE JUST BEEN TURNED OFF ')
48607      CALL DPWRST('XXX','BUG ')
48608      WRITE(ICOUT,1527)
48609 1527 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON IT)')
48610      CALL DPWRST('XXX','BUG ')
48611 1529 CONTINUE
48612      GOTO1900
48613C
48614 1530 CONTINUE
48615      IY1TSW='ON'
48616C
48617      J=0
48618      DO1531I=ILOCCP,NUMARG
48619      J=J+1
48620      IF(J.GT.MAXTIC)GOTO1800
48621      IF(IARGT(I).NE.'NUMB')GOTO1850
48622      Y1COOR(J)=ARG(I)
48623 1531 CONTINUE
48624      IFOUND='YES'
48625      NY1COO=J
48626C
48627      IF(IFEEDB.EQ.'OFF')GOTO1539
48628      WRITE(ICOUT,999)
48629      CALL DPWRST('XXX','BUG ')
48630      WRITE(ICOUT,1535)
48631 1535 FORMAT('THE TIC COORDINATES (FOR THE LEFT VERTICAL ',
48632     1'FRAME LINE)')
48633      CALL DPWRST('XXX','BUG ')
48634      WRITE(ICOUT,1536)
48635 1536 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
48636      CALL DPWRST('XXX','BUG ')
48637 1539 CONTINUE
48638      GOTO1900
48639C
48640 1599 CONTINUE
48641C
48642C               **************************************************************
48643C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON
48644C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE ARE TO BE DEFINED **
48645C               **************************************************************
48646C
48647      IF(ICOM.EQ.'Y2TI')GOTO1600
48648      GOTO1699
48649C
48650 1600 CONTINUE
48651      IF(ILOCC.EQ.NUMARG)GOTO1610
48652      IF(IHARG(ILOCCP).EQ.'ON')GOTO1610
48653      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1620
48654      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1610
48655      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1610
48656      GOTO1630
48657C
48658 1610 CONTINUE
48659      IFOUND='YES'
48660      IY2TSW='ON'
48661      NY2COO=-1
48662C
48663      IF(IFEEDB.EQ.'OFF')GOTO1619
48664      WRITE(ICOUT,999)
48665      CALL DPWRST('XXX','BUG ')
48666      WRITE(ICOUT,1615)
48667 1615 FORMAT('THE TIC COORDINATES (FOR THE RIGHT VERTICAL ',
48668     1'FRAME LINE)')
48669      CALL DPWRST('XXX','BUG ')
48670      WRITE(ICOUT,1616)
48671 1616 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
48672      CALL DPWRST('XXX','BUG ')
48673 1619 CONTINUE
48674      GOTO1900
48675C
48676 1620 CONTINUE
48677      IFOUND='YES'
48678      IY2TSW='OFF'
48679C
48680      IF(IFEEDB.EQ.'OFF')GOTO1629
48681      WRITE(ICOUT,999)
48682      CALL DPWRST('XXX','BUG ')
48683      WRITE(ICOUT,1625)
48684 1625 FORMAT('THE TIC COORDINATES (FOR THE RIGHT VERTICAL ',
48685     1'FRAME LINE)')
48686      CALL DPWRST('XXX','BUG ')
48687      WRITE(ICOUT,1626)
48688 1626 FORMAT('HAVE JUST BEEN TURNED OFF ')
48689      CALL DPWRST('XXX','BUG ')
48690      WRITE(ICOUT,1627)
48691 1627 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON IT)')
48692      CALL DPWRST('XXX','BUG ')
48693 1629 CONTINUE
48694      GOTO1900
48695C
48696 1630 CONTINUE
48697      IY2TSW='ON'
48698C
48699      J=0
48700      DO1631I=ILOCCP,NUMARG
48701      J=J+1
48702      IF(J.GT.MAXTIC)GOTO1800
48703      IF(IARGT(I).NE.'NUMB')GOTO1850
48704      Y1COOR(J)=ARG(I)
48705 1631 CONTINUE
48706      IFOUND='YES'
48707      NY2COO=J
48708C
48709      IF(IFEEDB.EQ.'OFF')GOTO1639
48710      WRITE(ICOUT,999)
48711      CALL DPWRST('XXX','BUG ')
48712      WRITE(ICOUT,1635)
48713 1635 FORMAT('THE TIC COORDINATES (FOR THE RIGHT VERTICAL ',
48714     1'FRAME LINE)')
48715      CALL DPWRST('XXX','BUG ')
48716      WRITE(ICOUT,1636)
48717 1636 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
48718      CALL DPWRST('XXX','BUG ')
48719 1639 CONTINUE
48720      GOTO1900
48721C
48722 1699 CONTINUE
48723C
48724C               **************************************************
48725C               **  TREAT THE CASE WHEN MAJOR TIC MARK COORDINATES ON **
48726C               **  THE ENTIRE 4-SIDED FRAME ARE TO BE DEFINED  **
48727C               **************************************************
48728C
48729      IF(ICOM.EQ.'XYTI')GOTO1700
48730      IF(ICOM.EQ.'YXTI')GOTO1700
48731      IF(ICOM.EQ.'TICS')GOTO1700
48732      IF(ICOM.EQ.'TIC ')GOTO1700
48733      GOTO1799
48734C
48735 1700 CONTINUE
48736      IF(ILOCC.EQ.NUMARG)GOTO1710
48737      IF(IHARG(ILOCCP).EQ.'ON')GOTO1710
48738      IF(IHARG(ILOCCP).EQ.'OFF')GOTO1720
48739      IF(IHARG(ILOCCP).EQ.'AUTO')GOTO1710
48740      IF(IHARG(ILOCCP).EQ.'DEFA')GOTO1710
48741      GOTO1730
48742C
48743 1710 CONTINUE
48744      IFOUND='YES'
48745      IX1TSW='ON'
48746      IX2TSW='ON'
48747      IY1TSW='ON'
48748      IY2TSW='ON'
48749      NX1COO=-1
48750      NX2COO=-1
48751      NY1COO=-1
48752      NY2COO=-1
48753C
48754      IF(IFEEDB.EQ.'OFF')GOTO1719
48755      WRITE(ICOUT,999)
48756      CALL DPWRST('XXX','BUG ')
48757      WRITE(ICOUT,1715)
48758 1715 FORMAT('THE TIC COORDINATES (FOR ALL 4 ',
48759     1'FRAME LINES)')
48760      CALL DPWRST('XXX','BUG ')
48761      WRITE(ICOUT,1716)
48762 1716 FORMAT('HAVE JUST BEEN SET TO AUTOMATIC')
48763      CALL DPWRST('XXX','BUG ')
48764 1719 CONTINUE
48765      GOTO1900
48766C
48767 1720 CONTINUE
48768      IFOUND='YES'
48769      IX1TSW='OFF'
48770      IX2TSW='OFF'
48771      IY1TSW='OFF'
48772      IY2TSW='OFF'
48773C
48774      IF(IFEEDB.EQ.'OFF')GOTO1729
48775      WRITE(ICOUT,999)
48776      CALL DPWRST('XXX','BUG ')
48777      WRITE(ICOUT,1725)
48778 1725 FORMAT('THE TIC COORDINATES (FOR ALL 4 ',
48779     1'FRAME LINES)')
48780      CALL DPWRST('XXX','BUG ')
48781      WRITE(ICOUT,1726)
48782 1726 FORMAT('HAVE JUST BEEN TURNED OFF ')
48783      CALL DPWRST('XXX','BUG ')
48784      WRITE(ICOUT,1727)
48785 1727 FORMAT('(THUS NO MAJOR TIC MARKS WILL APPEAR ON ANY ',
48786     1'FRAME LINE)')
48787      CALL DPWRST('XXX','BUG ')
48788 1729 CONTINUE
48789      GOTO1900
48790C
48791 1730 CONTINUE
48792      IX1TSW='ON'
48793      IX2TSW='ON'
48794      IY1TSW='ON'
48795      IY2TSW='ON'
48796C
48797      J=0
48798      DO1731I=ILOCCP,NUMARG
48799      J=J+1
48800      IF(J.GT.MAXTIC)GOTO1800
48801      IF(IARGT(I).NE.'NUMB')GOTO1850
48802      X1COOR(J)=ARG(I)
48803      X2COOR(J)=ARG(I)
48804      Y1COOR(J)=ARG(I)
48805      Y2COOR(J)=ARG(I)
48806 1731 CONTINUE
48807      IFOUND='YES'
48808      NX1COO=J
48809      NX2COO=J
48810      NY1COO=J
48811      NY2COO=J
48812C
48813      IF(IFEEDB.EQ.'OFF')GOTO1739
48814      WRITE(ICOUT,999)
48815      CALL DPWRST('XXX','BUG ')
48816      WRITE(ICOUT,1735)
48817 1735 FORMAT('THE TIC COORDINATES (FOR ALL 4 FRAMES)')
48818      CALL DPWRST('XXX','BUG ')
48819      WRITE(ICOUT,1736)
48820 1736 FORMAT('HAVE JUST BEEN MANUALLY SPECIFIED')
48821      CALL DPWRST('XXX','BUG ')
48822 1739 CONTINUE
48823      GOTO1900
48824C
48825 1799 CONTINUE
48826      GOTO1900
48827C
48828 1800 CONTINUE
48829      IERROR='YES'
48830      WRITE(ICOUT,999)
48831      CALL DPWRST('XXX','BUG ')
48832      WRITE(ICOUT,1801)
48833 1801 FORMAT('***** ERROR IN DPMJTC--')
48834      CALL DPWRST('XXX','BUG ')
48835      WRITE(ICOUT,1802)
48836 1802 FORMAT('      THE NUMBER OF SPECIFIED')
48837      CALL DPWRST('XXX','BUG ')
48838      WRITE(ICOUT,1803)
48839 1803 FORMAT('      TIC COORDINATES HAS JUST EXCEEDED ')
48840      CALL DPWRST('XXX','BUG ')
48841      WRITE(ICOUT,1804)MAXTIC
48842 1804 FORMAT('      THE ALLOWABLE MAXIMUM OF ',I8)
48843      CALL DPWRST('XXX','BUG ')
48844      GOTO1900
48845C
48846 1850 CONTINUE
48847      IERROR='YES'
48848      WRITE(ICOUT,999)
48849      CALL DPWRST('XXX','BUG ')
48850      WRITE(ICOUT,1851)
48851 1851 FORMAT('***** ERROR IN DPMJTC--')
48852      CALL DPWRST('XXX','BUG ')
48853      WRITE(ICOUT,1852)
48854 1852 FORMAT('      A SPECIFICATION IN THE')
48855      CALL DPWRST('XXX','BUG ')
48856      WRITE(ICOUT,1853)
48857 1853 FORMAT('      TIC COORDINATES COMMAND HAS JUST ')
48858      CALL DPWRST('XXX','BUG ')
48859      WRITE(ICOUT,1854)
48860 1854 FORMAT('      BEEN ENCOUNTERED WHICH IS NON-NUMERIC')
48861      CALL DPWRST('XXX','BUG ')
48862      GOTO1900
48863C
48864 1900 CONTINUE
48865      RETURN
48866      END
48867